油売り算

LL魂の問題ページ

この記事の続き

やった!油売り算、僕にも出来たよ!

#!/usr/bin/env gosh
;; -*- coding: utf-8 mode: scheme -*-

(use util.queue)
(use util.match)
(use srfi-1)


;; node
(define (make-node state)
  (let1 x (make-vector 3 ())
    (vector-set! x 0 state)
    x))

(define (get-state x)
  (vector-ref x 0))

(define (set-child! x i child)
  (vector-set! child 1 x)
  (vector-set! child 2 i))

(define (get-parent node)
  (vector-ref node 1))

(define (get-index node)
  (vector-ref node 2))

;; utility
(define (make-cache)
  (make-hash-table 'equal?))

(define (appears-again? cache state)
  (hash-table-exists? cache state))

(define (new-state? cache state)
  (not (appears-again? cache state)))

(define (cache! c state)
  (hash-table-put! c state #t))

(define (finished? state)
  (and (= (car state) (cadr state))
       (= (caddr state) 0)))

(define (make-states state capacity)
  (match-let (((a b c) state)
              ((ca cb cc) capacity)
              (l ()))
    (if (and (not (= a 0)) (not (= b cb)))
      (let1 m (min a (- cb b))
        (set! l (cons (list (- a m) (+ b m) c) l)))
      (set! l (cons () l)))
    (if (and (not (= b 0)) (not (= c cc)))
      (let1 m (min b (- cc c))
        (set! l (cons (list a (- b m) (+ c m)) l)))
      (set! l (cons () l)))
    (if (and (not (= c 0)) (not (= a ca)))
      (let1 m (min c (- ca a))
        (set! l (cons (list (+ a m) b (- c m)) l)))
      (set! l (cons () l)))
    (if (and (not (= b 0)) (not (= a ca)))
      (let1 m (min b (- ca a))
        (set! l (cons (list (+ a m) (- b m) c) l)))
      (set! l (cons () l)))
    (if (and (not (= c 0)) (not (= b cb)))
      (let1 m (min c (- cb b))
        (set! l (cons (list a (+ b m) (- c m)) l)))
      (set! l (cons () l)))
    (if (and (not (= a 0)) (not (= c cc)))
      (let1 m (min a (- cc c))
        (set! l (cons (list (- a m) b (+ c m)) l)))
      (set! l (cons () l)))
    (reverse l)
    ))

(define (print-procedure node)
  (let1 parent (get-parent node)
    (unless (null? parent)
      (print-procedure parent))
    (case (get-index node)
      ((0) (format #t "a から b に ~d 升移す~%" (- (car (get-state parent))
                                                   (car (get-state node)))))
      ((1) (format #t "b から c に ~d 升移す~%" (- (cadr (get-state parent))
                                                   (cadr (get-state node)))))
      ((2) (format #t "c から a に ~d 升移す~%" (- (caddr (get-state parent))
                                                   (caddr (get-state node)))))
      ((3) (format #t "b から a に ~d 升移す~%" (- (cadr (get-state parent))
                                                   (cadr (get-state node)))))
      ((4) (format #t "c から b に ~d 升移す~%" (- (caddr (get-state parent))
                                                   (caddr (get-state node)))))
      ((5) (format #t "a から c に ~d 升移す~%" (- (car (get-state parent))
                                                   (car (get-state node))))))))


;; main code
(define (oil-separate init-state capacity)
  (let ((cache (make-cache))
        (queue (make-queue)))
    (let loop ((node (make-node init-state)))
      (if (finished? (get-state node))
        (print-procedure node)
        (begin
          (map (lambda (state i)
                 (if (and (not (null? state)) (new-state? cache state))
                   (let1 new-node (make-node state)
                     (cache! cache state)
                     (set-child! node i new-node)
                     (enqueue! queue new-node))))
               (make-states (get-state node) capacity) (iota 6))
          (let1 next-node (if (queue-empty? queue) #f (dequeue! queue))
            (if next-node
              (loop next-node)
              (error "failed."))))))))

(define (main args)
  (match (cdr args)
    ((n cb cc)
     (oil-separate `(,(string->number n) 0 0) `(10 ,(string->number cb) ,(string->number cc)))
     0)
    (_
     (print "invalid argument")
     1)))

• 何か…… make-states と print-procedure がださいよね……
• 幅優先探索が抽象化されてない
• 全部含めて 122 行でした
• 何か…… prolog って、素晴らしいような……
• 「全部戻して」は実装されていません

さて、これから人のコードをみて悶絶してくる。

……人のコードを見る勇気が無かった!