8パズルを解くプログラムを作ってみた
もっと効率の良い方法とかあるかも><。
(use srfi-1) (use gauche.sequence) ;;[1 2 3] ;;[4 5 6] ;;[7 8 ()]という形にしたら終了 ;;※空白は'()で表す。 ;;※上の表の状態はプログラム上では「(1 2 3 4 5 6 7 8 ())」と表す。 (define (make-state l) (if (= 9 (length l)) l (error "list size is must be 9"))) (define (search-index x l) (fold-with-index (lambda (i e it) (if (eq? x e) i it)) 'None l)) (define (search-empty l) (search-index '() l)) (define (get-swaped-point l) (let* ((n (search-empty l)) (cands (list (+ n 1) (- n 1) (+ n 3) (- n 3)))) (values (filter (lambda (n) (and (>= n 0) (<= n 8))) cands) n))) (define (swap idx1 idx2 l) (map-with-index (lambda (i e) (cond ((= i idx1) (ref l idx2)) ((= i idx2) (ref l idx1)) (else e))) l)) (define goal (make-state (append (iota 8 1) (list '())))) ;; ;;一つみつかればいい程度でいいかも ;; (define (run state) ;; (let ((find-path? #f)) ;; (let ((end (lambda (re) ;; (set! find-path? #t) ;; (print re)))) ;; (let iter ((state state) (history '())) ;; (unless find-path? ;; (unless (member state history) ;; (receive (cands empty-pos) ;; (get-swaped-point state) ;; (dolist (n (select cands)) ;; (let1 next (swap n empty-pos state) ;; (if (equal? next goal) ;; (end (reverse (cons next (cons state history)))) ;; (iter next (cons state history)))))))))))) ;;これだと、1度の探索で1つの候補しか判断してない。 (use srfi-27) (use srfi-42) ;;いろんな状態を渡せるようにしよう。 (define (shuffle-list l) (let1 lst (list-ec (: e l) (list (random-real) e)) (map cadr (sort! lst (lambda (x y) (> (car x) (car y))))))) ;;goalに近い状態を選んでみよう。 (define (count-matching-element state) (fold (lambda (x y count) (if (eqv? x y) (+ count 1) count)) 0 goal state)) ;; (define (select states) ;; (find-max states :key count-matching-element)) (define (run state) (let ((find-path? #f) (result '())) (define (end re) (set! find-path? #t) (set! result re)) (define (next-cands state) (receive (ns empty-pos) (get-swaped-point state) (sort (map (cut swap <> empty-pos state) ns) (lambda (x y) (> (count-matching-element x) (count-matching-element y)))))) (let iter ((state state) (history '())) (unless find-path? (unless (member state history) (dolist (next (next-cands state)) (if (equal? next goal) (end (reverse (cons next (cons state history)))) (iter next (cons state history))))))) result) ) ;;shuffle-listを使って初期状態を作ると解けない問題がでてくる(のかなー?いつまでたっても計算が終わらない)。 ;;必ず解ける問題を作るにはgoalから問題をつくる必要があるかも。 (define (make-problem n) (define (choose-state state) (receive (ns empty-pos) (get-swaped-point state) (let1 n (car (shuffle-list ns)) (swap empty-pos n state)))) (let iter ((state goal) (n n)) (if (zero? n) state (iter (choose-state state) (- n 1)))))
時間とか計ってみる
(use gauche.time) (define (bench thunk) (let1 t (make <real-time-counter>) (with-time-counter t (thunk)) (print (time-counter-value t)))) (let1 ls (list-ec (: i 10) (make-problem 100)) (for-each (lambda (p) (bench (lambda () (run p)))) ls)) (let1 p (make-problem 100) (print p) (print (count-matching-element p)) (print (length (run p))) )
ファイルを指定して実行
gosh -I ./ -l 8puzzle.scm 8puzzle.tmp.scm
結果
0.017354 0.13862300000000005 0.001147 0.033938 0.125614 0.395092 0.121132 0.185637 0.026089 0.22393799999999997 (3 6 4 5 () 7 1 2 8) 0 935
935回の移動とか多すぎ><。