30分プログラム回文積(Project Euler)

左右どちらから読んでも同じ値になる数を回文数という。 2桁の数の積で表される回文数のうち、最大のものは 9009 = 91 * 99 である。
では、3桁の数の積で表される回文数のうち最大のものはいくらになるか。

Haskellの遅延評価砲が火を吹きそうな問題だけど、Gaucheで。
id:mzpがambでやったので、じゃあappend-mapでやるべと思ってこんなコードを書いたけど・・・。

(use srfi-1)
(define (test)
  (fold (lambda (a b) (if (> (car a) (car b)) a b)) '(0 0 0)
	(append-map (lambda (x)
		      (append-map (lambda (y)
				    (let* ((z (* x y))
					   (zl (map digit->integer (string->list (x->string z))))
					   (zr (reverse zl)))
				      (if (every = zl zr)
					  (list (list z x y))
					  '())))
				  (iota 900 100)))
		    (iota 900 100))))

=>(906609 913 993)
11秒@ThinkpadX60

ガウディ本にも回文積が載っていた。曰く、「制約プログラミングを使えば、6桁の回文積を0.2秒でリストアップできるぜい、500MHzのCPUで」だそうです。

じゃあ高速にしてやんよ
副作用使ってやる。あと、123456->"123456"->("1" "2" "3" "4" "5" "6")->(1 2 3 4 5 6)の処理は文字列操作を挟んで遅いので、ちゃんとquotientとmoduloを使うまっとうなものを。z=x*y で 100 * 300 も 300 * 100 も同じだから省ける。

(use srfi-1)
(define (integer->list n)
  (cons (modulo n 10)
	(if (< n 10)
	    '()
	    (integer->list (quotient n 10)))))

(define (test2)
  (define result '(0 0 0))
  (define digit (iota 900 100))
  (for-each (lambda (x)
	      (for-each (lambda (y)
			  (and-let* ((z (* x y))
				     ((< (car result) z))
				     (zl (integer->list z))
				     (zr (reverse zl))
				     ((every = zl zr)))
			    (set! result (list z x y))))
			(iota (- x 99) 100)))
	    digit)
  result)

=>(906609 913 993)
0.6秒になった。

(use srfi-1)
(define (integer->list n)
  (cons (modulo n 10)
	(if (< n 10)
	    '()
	    (integer->list (quotient n 10)))))
(define (test3)
  (define result '(0 0 0))
  (let loop ((x 100)
	     (y 100))
    (cond ((> y 999) (loop (+ x 1) 100))
	  ((> x 999) result)
	  ((< x y) (loop (+ x 1) 100))
	  ((>= x y)
	   (and-let* ((z (* x y))
		      ((< (car result) z))
		      (zl (integer->list z))
		      (zr (reverse zl))
		      ((every = zl zr)))
	     (set! result (list z x y)))
	   (loop x (+ y 1))))))

0.5秒になった。
はじめはリストだけでサクッとつくっておいて、あとでデータ構造なり副作用なりループに開くなりで高速化する、これがLisp脳だぜっ