水差し問題
●8 リットルと 5 リットルの容器で 4 リットルの水をはかる
http://www.geocities.jp/m_hiroi/puzzle/water_jug.html
(use srfi-1) (define *capacity-1* 8) (define *capacity-2* 5) (define *target* 4) (define *tried* (make-hash-table 'equal?)) (define (full-1? pair) (= (car pair) *capacity-1*)) (define (full-2? pair) (= (car pair) *capacity-2*)) (define (fill-1 pair) (cons *capacity-1* (cdr pair))) (define (fill-2 pair) (cons (car pair) *capacity-2*)) (define (empty-1? pair) (= 0 (car pair))) (define (empty-2? pair) (= 0 (cdr pair))) (define (make-empty-1 pair) (cons 0 (cdr pair))) (define (make-empty-2 pair) (cons (car pair) 0)) (define (move1->2 pair) (let ((q (min (car pair) (- *capacity-2* (cdr pair))))) (cons (- (car pair) q) (+ (cdr pair) q)))) (define (move2->1 pair) (let ((q (min (cdr pair) (- *capacity-1* (car pair))))) (cons (+ (car pair) q) (- (cdr pair) q)))) (define (finish? pair) (or (= (car pair) *target*) (= (cdr pair) *target*) )) (define (next-states pair) (filter (lambda (x) (not (hash-table-exists? *tried* x))) (map (lambda (func) ((eval func (interaction-environment)) pair)) '(make-empty-1 make-empty-2 fill-1 fill-2 move1->2 move2->1)))) (define (try pair history) (hash-table-put! *tried* pair #t) (let ((ns (next-states pair))) (cond ((null? ns) #f) ((null? (filter finish? ns)) (map (lambda (x) (try x (cons pair history))) ns)) (else (begin (print "Found! " (reverse (cons (find finish? ns) (cons pair history)))) ))))) (define (main args) (set! *tried* (make-hash-table 'equal?)) (try '(0 . 0) '()) 0)
結果
Found! ((0 . 0) (8 . 0) (8 . 5) (0 . 5) (5 . 0) (5 . 5) (8 . 2) (0 . 2) (2 . 0) (2 . 5) (7 . 0) (7 . 5) (8 . 4)) Found! ((0 . 0) (8 . 0) (3 . 5) (3 . 0) (0 . 3) (8 . 3) (6 . 5) (6 . 0) (1 . 5) (1 . 0) (0 . 1) (8 . 1) (4 . 5))
探索とか得意じゃないので…