今更油売り算
前に書いたのは再帰で深さ優先探索だったけど、今度は深さ優先と幅優先を切りかえられるように書いた。スタックとキュー。
しかし、たまたま問題の10, 7, 3の場合は深さ優先と幅優先で同じ結果になってしまったので、他の例をば。
$ ./abura2.scm depth 12 7 3 init ((12 . 12) (7 . 0) (3 . 0)) ((12 . 5) (7 . 7) (3 . 0)) ((12 . 5) (7 . 4) (3 . 3)) ((12 . 8) (7 . 4) (3 . 0)) ((12 . 8) (7 . 1) (3 . 3)) ((12 . 11) (7 . 1) (3 . 0)) ((12 . 11) (7 . 0) (3 . 1)) ((12 . 4) (7 . 7) (3 . 1)) ((12 . 4) (7 . 5) (3 . 3)) ((12 . 7) (7 . 5) (3 . 0)) ((12 . 7) (7 . 2) (3 . 3)) ((12 . 10) (7 . 2) (3 . 0)) ((12 . 10) (7 . 0) (3 . 2)) ((12 . 3) (7 . 7) (3 . 2)) ((12 . 3) (7 . 6) (3 . 3)) $ ./abura2.scm breadth 12 7 3 init ((12 . 12) (7 . 0) (3 . 0)) ((12 . 9) (7 . 0) (3 . 3)) ((12 . 9) (7 . 3) (3 . 0)) ((12 . 6) (7 . 3) (3 . 3))
pretty printじゃないのは御愛嬌。
#!/usr/bin/env gosh ;; -*- coding: utf-8; -*- (use srfi-1) (use util.queue) (use util.combinations) ;; <state> ::= (<unit> ...) ;; <unit> ::= (limit . value) ;; <search-state> ::= (<state> . <step>) = (<state> from<int> to<int>) ;; <step> ::= (from<int> to<int>) ;; ;; so, initial state is '((10 . 10) (7 . 0) (3 . 0)) ;; and search state '(((10 . 10) (7 . 0) (3 . 0)) . (0 . 1)) means ;; next state is '((10 . 3) (7 . 7) (3 . 0)) (define (main args) (pretty-print-result (apply search-abura (string->symbol (cadr args)) (map x->integer (cddr args)))) 0) (define nil ()) ;; key, value := <state>, <state> ;; 'value' represents the state before 'key' ;; so you can trace the flow of states from the last state. (define *transition-pairs* #f) (define (init-states!) (set! *transition-pairs* (make-hash-table 'equal?)) #t) (init-states!) (define (register-states before after) (hash-table-put! *transition-pairs* after before)) (define (state-before state) (hash-table-get *transition-pairs* state #f)) (define appeared? state-before) (define (state-flow last-state) (let loop((ret ()) (state last-state)) (let1 before (state-before state) (if before (loop (cons state ret) before) (cons state ret))))) (define (container-of flag) (cond ((eq? flag 'depth) ()) (else ; 'breadth (make-queue)))) (define (value unit) (cdr unit)) (define (limit unit) (car unit)) ;;; if unit is (10 . 3) ;;; then room-of is 7 (define (room-of unit) (- (car unit) (cdr unit))) (define (moving-amount state from to) (min (room-of (ref state to)) (value (ref state from)))) (define (finished? state) (let1 half (/ (car (ref state 0)) 2) (call/cc (lambda (cc) (for-each (lambda (m) (for-each (lambda (combi) (if (= half (apply + 0 (map (lambda (index) (cdr (ref state index))) combi))) (cc #t) #f)) (combinations (iota (length state)) m))) (iota (- (length state) 1) 1)) (cc #f))))) (define (move state from to) (let ((to-unit (ref state to)) (from-unit (ref state from)) (arg-state state)) (let loop((i 0) (ret ()) (state state)) (if (null? state) (reverse ret) (loop (+ i 1) (let1 unit (car state) (cons (cons (limit unit) (cond ((= i from) (- (value from-unit) (moving-amount arg-state from to))) ((= i to) (+ (value to-unit) (moving-amount arg-state from to))) (else (value unit)))) ret)) (cdr state)))))) (define (init-units . args) (let1 args (sort args >) (let1 initial-unit (cons (car args) (car args)) (let loop((args (cdr args)) (ret `(,initial-unit))) (if (null? args) (reverse ret) (loop (cdr args) (cons (cons (car args) 0) ret))))))) (define (search-abura method . args) (let1 ret (search-by method (apply init-units args)) (state-flow ret))) ;; TODO: remove duplication (define (gen-next-states state) (map (cut apply move state <>) (let1 len (length state) (let loop((i 0) (j 0) (ret ())) (cond ((>= i len) ret) ((>= j len) (loop (+ i 1) 0 ret)) (else (loop i (+ j 1) (if (= i j) ret (cons `(,i ,j) ret))))))))) (define-macro (!push! container value) `(if (eq? method 'depth) (push! ,container ,value) (enqueue! ,container ,value))) (define-macro (!pop! container) `(if (eq? method 'depth) (pop! ,container) (dequeue! ,container))) (define (search-by method init-state) (let ((container (container-of method)) (empty? (if (eq? method 'depth) null? (lambda (x) (and (null? (cdr x)) (null? (car x))))))) (init-states!) (!push! container init-state) (register-states 'init init-state) (let loop() (let1 iter-ret (if (empty? container) #f (let1 state (!pop! container) (if (finished? state) state ; found solution! (begin (for-each (lambda (next-state) (if (appeared? next-state) #f (begin (register-states state next-state) (!push! container next-state)))) (gen-next-states state)) #f)))) (if iter-ret iter-ret (loop)))))) (define (head ls len) (let loop((ls ls) (ret ()) (len len)) (if (or (null? ls) (= len 0)) (reverse ret) (loop (cdr ls) (cons (car ls) ret) (- len 1))))) (define (pretty-print-result states) (for-each print states))
