問題 P98 は言葉で説明するのが難しいので、問題(英語)を読んでください。
https://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html
なお、P90 の 8クイーン問題は、SICP の問 2.42 *1 で、P97 の数独問題は Euler Project の問 96 *2でやったのでパスです。週末の暇な時に気が向いたらコードを掲載するかも知れません。
閑話休題。コードはこんな感じになります。
(define (state lst) (define (iter l c result) (if (null? l) (if (> c 0) (append result `(,c)) result) (iter (cdr l) (if (= (car l) 1) (+ c 1) 0) (if (and (> c 0) (= (car l) 0)) (append result `(,c)) result)))) (iter lst 0 nil)) (define (answer? column-states r1 r2 r3 r4 r5 r6 r7 r8 r9) (let* ((rows `(,r1 ,r2 ,r3 ,r4 ,r5 ,r6 ,r7 ,r8 ,r9)) (columns1 (map (lambda (x) (list-ref x 0)) rows)) (columns2 (map (lambda (x) (list-ref x 1)) rows)) (columns3 (map (lambda (x) (list-ref x 2)) rows)) (columns4 (map (lambda (x) (list-ref x 3)) rows)) (columns5 (map (lambda (x) (list-ref x 4)) rows)) (columns6 (map (lambda (x) (list-ref x 5)) rows)) (columns7 (map (lambda (x) (list-ref x 6)) rows)) (columns8 (map (lambda (x) (list-ref x 7)) rows))) (and (equal? (state columns1) (list-ref column-states 0)) (equal? (state columns2) (list-ref column-states 1)) (equal? (state columns3) (list-ref column-states 2)) (equal? (state columns4) (list-ref column-states 3)) (equal? (state columns5) (list-ref column-states 4)) (equal? (state columns6) (list-ref column-states 5)) (equal? (state columns7) (list-ref column-states 6)) (equal? (state columns8) (list-ref column-states 7)) ))) (define (nonograms row-states column-states) (let* ((rows (repeated-permutations '(1 0) 8)) (row1 (filter (lambda(x) (equal? (state x) (list-ref row-states 0))) rows)) (row2 (filter (lambda(x) (equal? (state x) (list-ref row-states 1))) rows)) (row3 (filter (lambda(x) (equal? (state x) (list-ref row-states 2))) rows)) (row4 (filter (lambda(x) (equal? (state x) (list-ref row-states 3))) rows)) (row5 (filter (lambda(x) (equal? (state x) (list-ref row-states 4))) rows)) (row6 (filter (lambda(x) (equal? (state x) (list-ref row-states 5))) rows)) (row7 (filter (lambda(x) (equal? (state x) (list-ref row-states 6))) rows)) (row8 (filter (lambda(x) (equal? (state x) (list-ref row-states 7))) rows)) (row9 (filter (lambda(x) (equal? (state x) (list-ref row-states 8))) rows))) (call/cc (lambda (c) (map (lambda (r1) (map (lambda (r2) (map (lambda (r3) (map (lambda (r4) (map (lambda (r5) (map (lambda (r6) (map (lambda (r7) (map (lambda (r8) (map (lambda (r9) (and (answer? column-states r1 r2 r3 r4 r5 r6 r7 r8 r9) (c `(,r1 ,r2 ,r3 ,r4 ,r5 ,r6 ,r7 ,r8 ,r9))) ) row9) ) row8) ) row7) ) row6) ) row5) ) row4) ) row3) ) row2) ) row1) ))))
総当たり力技解法ならば、そんなに難しいコードではありません。
map の入れ子は気にしたら負けです。
解答は１個らしいので、見つかったら call/cc を使ってブレークします。
結果
gosh> (time (nonograms '((3) (2 1) (3 2) (2 2) (6) (1 5) (6) (1) (2)) '((1 2) (3 1) (1 5) (7 1) (5) (3) (4) (3)))) ;(time (nonograms '((3) (2 1) (3 2) (2 2) (6) (1 5) (6) (1) (2)) '((1 2) ... ; real 17.862 ; user 18.970 ; sys 0.281 ((0 1 1 1 0 0 0 0) (1 1 0 1 0 0 0 0) (0 1 1 1 0 0 1 1) (0 0 1 1 0 0 1 1) (0 0 1 1 1 1 1 1) (1 0 1 1 1 1 1 0) (1 1 1 1 1 1 0 0) (0 0 0 0 1 0 0 0) (0 0 0 1 1 0 0 0))
この程度(9 x 8 マス) の問題なら総当たりでもそれなりの時間で解けます。
少し見やすくします。
gosh> (begin (map print (nonograms '((3) (2 1) (3 2) (2 2) (6) (1 5) (6) (1) (2)) '((1 2) (3 1) (1 5) (7 1) (5) (3) (4) (3)))) 'done) (0 1 1 1 0 0 0 0) (1 1 0 1 0 0 0 0) (0 1 1 1 0 0 1 1) (0 0 1 1 0 0 1 1) (0 0 1 1 1 1 1 1) (1 0 1 1 1 1 1 0) (1 1 1 1 1 1 0 0) (0 0 0 0 1 0 0 0) (0 0 0 1 1 0 0 0) done
人間らしく解くコードも考えてみる事にします。
計算時間は総当たり方式より速くなるでしょうか？
