水差し問題

●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))

探索とか得意じゃないので…