Gaucheで魔方陣に挑戦(順列を実装)

• http://www.cut-the-knot.org/do_you_know/AllPerm.shtml の B. Heap's algorithm で、順列を生成してみる。

(use gauche.uvector)

(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)))))

(define (u8vector-swap! vec a b)
  (let1 tmp (u8vector-ref vec a)
    (u8vector-set! vec a (u8vector-ref vec b))
    (u8vector-set! vec b tmp)))

(define (u8vector-permutation-for-each value proc)
  (define (heap-permute n)
    (if (= n 1)
      (proc value)
      (let loop ((i 0))
	(when (< i n)
	  (heap-permute (- n 1))
	  (if (odd? n)
	    (u8vector-swap! value 0 (- n 1))
	    (u8vector-swap! value i (- n 1)))
	  (loop (+ i 1))))))
  (heap-permute (u8vector-length value)))

(u8vector-permutation-for-each
 (list->u8vector '(1 2 3 4 5 6 7 8 9))
 (lambda (v)
   (let ((a (u8vector-ref v 0))
	 (b (u8vector-ref v 1))
	 (c (u8vector-ref v 2))
	 (d (u8vector-ref v 3))
	 (e (u8vector-ref v 4))
	 (f (u8vector-ref v 5))
	 (g (u8vector-ref v 6))
	 (h (u8vector-ref v 7))
	 (i (u8vector-ref v 8)))
     (when (=2 (+ a b c) (+ d e f) (+ g h i) (+ a d g) (+ b e h) (+ c f i) (+ a e i) (+ c e g))
       (print v)))))

#u8(2 9 4 7 5 3 6 1 8)
#u8(2 7 6 9 5 1 4 3 8)
#u8(4 3 8 9 5 1 2 7 6)
#u8(4 9 2 3 5 7 8 1 6)
#u8(6 7 2 1 5 9 8 3 4)
#u8(6 1 8 7 5 3 2 9 4)
#u8(8 3 4 1 5 9 6 7 2)
#u8(8 1 6 3 5 7 4 9 2)
gosh u8.scm 1.08s user 0.01s system 100% cpu 1.092 total

Gaucheで魔方陣に挑戦その５の3倍速い。

time gosh g.scm
(2 7 6 9 5 1 4 3 8)
(2 9 4 7 5 3 6 1 8)
(4 3 8 9 5 1 2 7 6)
(4 9 2 3 5 7 8 1 6)
(6 1 8 7 5 3 2 9 4)
(6 7 2 1 5 9 8 3 4)
(8 1 6 3 5 7 4 9 2)
(8 3 4 1 5 9 6 7 2)
gosh g.scm 2.97s user 0.00s system 99% cpu 2.980 total

だが、ruby1.9のワンライナーに一歩及ばない。

time ruby1.9 -e '(1..9).to_a.permutation.select{|i|x=i[0]+i[1]+i[2];x==i[3]+i[4]+i[5]&&x==i[6]+i[7]+i[8]&&x==i[0]+i[3]+i[6]&&x==i[1]+i[4]+i[7]&&x==i[2]+i[5]+i[8]&&x==i[0]+i[4]+i[8]&&x==i[2]+i[4]+i[6]}.each{|i|p i}'
[2, 7, 6, 9, 5, 1, 4, 3, 8]
[2, 9, 4, 7, 5, 3, 6, 1, 8]
[4, 3, 8, 9, 5, 1, 2, 7, 6]
[4, 9, 2, 3, 5, 7, 8, 1, 6]
[6, 1, 8, 7, 5, 3, 2, 9, 4]
[6, 7, 2, 1, 5, 9, 8, 3, 4]
[8, 1, 6, 3, 5, 7, 4, 9, 2]
[8, 3, 4, 1, 5, 9, 6, 7, 2]
ruby1.9 -e 0.80s user 0.00s system 100% cpu 0.804 total

ruby1.9はCレベルで順列を生成しているようだ。
Gaucheは、Schemeレベルで生成しているので、変身前のフリーザ様だ。
「その変身をあと2回もオレは残している・・・ その意味がわかるな？」

(shiroさんのコメントを受けて追記 12/13 22:16)
この場合はu8vectorよりvectorのほうが速くなるとのこと。

(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)))))

(define (vector-swap! vec a b)
  (let1 tmp (vector-ref vec a)
    (vector-set! vec a (vector-ref vec b))
    (vector-set! vec b tmp)))

(define (vector-permutation-for-each value proc)
  (define (heap-permute n)
    (if (= n 1)
      (proc value)
      (let loop ((i 0))
	(when (< i n)
	  (heap-permute (- n 1))
	  (if (odd? n)
	    (vector-swap! value 0 (- n 1))
	    (vector-swap! value i (- n 1)))
	  (loop (+ i 1))))))
  (heap-permute (vector-length value)))

(vector-permutation-for-each
 #(1 2 3 4 5 6 7 8 9)
 (lambda (v)
   (let ((a (vector-ref v 0))
	 (b (vector-ref v 1))
	 (c (vector-ref v 2))
	 (d (vector-ref v 3))
	 (e (vector-ref v 4))
	 (f (vector-ref v 5))
	 (g (vector-ref v 6))
	 (h (vector-ref v 7))
	 (i (vector-ref v 8)))
     (when (=2 (+ a b c) (+ d e f) (+ g h i) (+ a d g) (+ b e h) (+ c f i) (+ a e i) (+ c e g))
       (print v)))))

% time gosh perm.scm
#(2 9 4 7 5 3 6 1 8)
#(2 7 6 9 5 1 4 3 8)
#(4 3 8 9 5 1 2 7 6)
#(4 9 2 3 5 7 8 1 6)
#(6 7 2 1 5 9 8 3 4)
#(6 1 8 7 5 3 2 9 4)
#(8 3 4 1 5 9 6 7 2)
#(8 1 6 3 5 7 4 9 2)
gosh perm.scm 0.55s user 0.01s system 100% cpu 0.561 total

ruby1.9のワンライナーに勝ってしまった。さすがだ。こうでなくっちゃ。