Gaucheで魔方陣に挑戦その２

prologの魔方陣の計算速度は総当たり時間なのが分かったのでschemeでもやってみようと思った。

$ time gosh a.scm
(2 7 6 9 5 1 4 3 8)15
(2 9 4 7 5 3 6 1 8)15
(4 3 8 9 5 1 2 7 6)15
(4 9 2 3 5 7 8 1 6)15
(6 1 8 7 5 3 2 9 4)15
(6 7 2 1 5 9 8 3 4)15
(8 1 6 3 5 7 4 9 2)15
(8 3 4 1 5 9 6 7 2)15

real	0m2.237s
user	0m2.228s
sys	0m0.000s

eq?が合わないときに大域脱出すればprologと同スピード(0.5秒）になるとは思う。

(use srfi-1)
(use util.combinations)
(define-syntax f (syntax-rules () ((f x a b c) (+ (list-ref x a) (list-ref x b) (list-ref x c)))))
(define g (lambda (x y) (if (eq? x y) x 0)))
(permutations-for-each 
 (lambda (x) 
   ((lambda (y) (if (not (eq? y 0)) (print x y)))
    (g (g (g (g (g (g (g (f x 0 1 2) (f x 3 4 5))(f x 6 7 8))(f x 0 3 6))(f x 1 4 7))(f x 2 5 8))(f x 0 4 8))(f x 2 4 6))))
	  (iota 9 1))

gが汚い…
大域脱出はまた後で書く。

gは不要だった。=でやれば途中で評価が止まるはずだよな。でもスピードは0.01sしか改善しなかった。
やっぱ総当たりはprologの方が上なのか…

(use srfi-1)
(use util.combinations)
(define-syntax f (syntax-rules () ((f x a b c) (+ (list-ref x a) (list-ref x b) (list-ref x c)))))
(permutations-for-each
 (lambda (x)
   ((lambda (y) (if (not (eq? y #f)) (print x y)))
    (= (f x 0 1 2)(f x 3 4 5)(f x 6 7 8)(f x 0 3 6)(f x 1 4 7)(f x 2 5 8)(f x 0 4 8)(f x 2 4 6))))
 (iota 9 1))

まだ諦められない。

＝の性質を調べてみる。

gosh> (= (begin (print "1") 1) (begin (print "2") 2) (begin (print "3") 3))
1
2
3
#f

やっぱり全部評価する。途中で止めるのかと思ってたよ（笑

ANDと同じインプリしなきゃいけないのか。

gosh> (and (begin (write 1) #f) (begin (write 2) #f) (begin (write 3) #f))
1#f

おかしい、andとかと同じように途中で脱出しても良さそうなのに。
http://practical-scheme.net/gauche/man/gauche-refj_40.html#SEC61

R5RSをみると＝は「これらの述語は推移的であることが要求されている。」と書いてあるからこの動きがデフォルトなんだろうな。なぜなんだろう?

まあ、いいとして、関数化してみる。

(define (g x y z) (and x y z))
(g (begin (write 1) #f) (begin (write 2) #f) (begin (write 3) #f))
;=>123#t

評価してから渡すんだなorz
じゃあ、マクロ化すると。

(define-syntax g (syntax-rules () ((g x y z) (and x y z))))
(g (begin (write 1) #f) (begin (write 2) #f) (begin (write 3) #f))
;=>1#f

おお！マクロのおいしさが分かった気がする(嘘

gosh> (define-syntax =2 (syntax-rules () ((=2 x y z) (and (= x y) (= y z)))))
#<undef>
gosh> (=2 (begin (write 1) 1) (begin (write 2) 2) (begin (write 3) 1))
12#f
gosh> (=2 (begin (write 1) 1) (begin (write 2) 1) (begin (write 3) 1))
1223#t

そうか、こうやってしまうとうまくいったときに2度評価されるんだな。
変数ってすごいな（嘘

よしということで途中で諦める比較関数つくってみた。

gosh> (define-syntax =2 (syntax-rules () ((=2 a b c d e f g h) (and (= a b)(= b c)(= c d)(= d e)(= e f)(= f g)(= g h)))))
#<undef>
gosh> (=2 (begin (write 1) 1) (begin (write 2) 2) (begin (write 3) 1) (begin (write 4) 1) (begin (write 5) 1) (begin (write 6) 1) (begin (write 7) 1) (begin (write 8) 1))
12#f
gosh> (=2 (begin (write 1) 1) (begin (write 2) 1) (begin (write 3) 1) (begin (write 4) 1) (begin (write 5) 1) (begin (write 6) 1) (begin (write 7) 1) (begin (write 8) 1))
12233445566778#t

これで、かなりのスピードアップが図れるはず。2回足し算しているのが問題だけど…

(use srfi-1)
(use util.combinations)
(define-syntax f (syntax-rules () ((f x a b c) (+ (list-ref x a) (list-ref x b) (list-ref x c)))))
(define-syntax =2 (syntax-rules () ((=2 a b c d e f g h) (and (= a b)(= b c)(= c d)(= d e)(= e f)(= f g)(= g h)))))
(permutations-for-each
 (lambda (x)
   (if (=2 (f x 0 1 2)(f x 3 4 5)(f x 6 7 8)(f x 0 3 6)(f x 1 4 7)(f x 2 5 8)(f x 0 4 8)(f x 2 4 6)) (print x (f x 0 1 2))))
 (iota 9 1))
;->real	0m1.555s
;->user	0m1.544s
;->sys	0m0.012s

ということで0.7秒ほど速くできた。

追記 2008/12/04 22:41:20:

gaucheで可変引数で計算量の少ない=を作る - 計算機と戯れる日々を使って高速化を試みる。

(use srfi-1)
(use util.combinations)
(define-syntax f (syntax-rules () ((f x a b c) (+ (list-ref x a) (list-ref x b) (list-ref x c)))))
(define-syntax =2
  (syntax-rules ()
    ((=2) #f)
    ((=2 t) t)
    ((=2 t1 t2)
     (let ((x t1)(y t2)) (if (eq? x y) x #f)))
    ((=2 t1 t2 t3 ...)
     (let ((x (=2 t1 t2))) (if x (=2 x t3 ...) #f)))))
(permutations-for-each
 (lambda (x)
   (if (=2 (f x 0 1 2)(f x 3 4 5)(f x 6 7 8)(f x 0 3 6)(f x 1 4 7)(f x 2 5 8)(f x 0 4 8)(f x 2 4 6)) (print x (f x 0 1 2))))
 (iota 9 1))
;=>real	0m1.579s
;=>user	0m1.564s
;=>sys	0m0.016s

かわらない…orz

しょうがないので4桁でも計算するか。
関数fを複数桁用に拡張する

(define-syntax f
  (syntax-rules ()
    ((f x a) (list-ref x a))
    ((f x a b ...) (+ (list-ref x a) (f x b ...)))))

(print (f '(3 4 5 6 7) 0 2 4))
(print (f '(3 4 5 6 7 8 9) 0 2 4 5))
;=>15
;=>23

(use srfi-1)
(use util.combinations)
(define-syntax f
  (syntax-rules ()
    ((f x a) (list-ref x a))
    ((f x a b ...) (+ (list-ref x a) (f x b ...)))))
(define-syntax =2
  (syntax-rules ()
    ((=2) #f)
    ((=2 t) t)
    ((=2 t1 t2)
     (let ((x t1)(y t2)) (if (eq? x y) x #f)))
    ((=2 t1 t2 t3 ...)
     (let ((x (=2 t1 t2))) (if x (=2 x t3 ...) #f)))))
(permutations-for-each
 (lambda (x)
   (if (=2 (f x 0 1 2 3)(f x 4 5 6 7)(f x 8 9 10 11)(f x 12 13 14 15)(f x 0 4 8 12)(f x 1 5 9 13)(f x 2 6 10 14)(f x 3 7 11 15)(f x 0 5 10 15)(f x 3 6 9 12)) (print x (f x 0 1 2 3))))
 (iota 16 1))

あれ？いつまで待っても答えが出ない…重いのか？まちがったかなぁ。
まあ、この辺で終了。

なんだ、prologでもすぐ答えが出ないので止める。

?- permutation([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16],[A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P]),X is A+B+C+D,X is E+F+G+H,X is I+J+K+L,X is M+N+O+P,X is A+E+I+M,X is B+F+J+N,X is C+G+K+O,X is D+H+L+P,X is A+F+K+P,X is D+G+J+M.