回文積

Scheme 30分プログラム

30分プログラム、その262。回文積 via Project Euler。

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

では、3桁の数の積で表される回文数のうち最大のものはいくらになるか。

ちょうど読み終わったガウディ本(asin:4798113468)にも回文積が載っていた。曰く、「制約プログラミングを使えば、6桁の回文積を0.2秒でリストアップできるぜい、500MHzのCPUで」だそうです。制約プログラミングは非決定性計算に近いけれど、すべての条件を利用して枝刈りをするので速いらしい。あと、もうちょっと高速なCPUを使ってもいいと思います。

制約プログラミングはそもそも利用法が分からないので、非決定性計算でごまかす。Gaucheでamb、誰か実装してないかなーと探したら、id:Gemmaさんのコードがでてきた。

使い方

$gosh kaibun.scm
(888 737)

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-
;;
;; kaibun.scm -
;;
;; Copyright(C) 2008 by mzp
;; Author: MIZUNO Hiroki / mzpppp at gmail dot com
;; http://howdyworld.org
;;
;; Timestamp: 2008/03/14 21:44:45
;;
;; This program is free software; you can redistribute it and/or
;; modify it under MIT Lincence.
;;

;; http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3A%E6%95%B0%E9%81%8A%E3%81%B3
(use srfi-1)

;; stack of cc.
(define fail '())

;; nondeterminsm operator
(define (amb li)
  (if (null? li)
      ((pop! fail))
      (call/cc
       (lambda (cc)
         (push! fail (lambda ()
                       (cc (amb (cdr li)))))
         (car li)))))

;;; kaibun num
(define (digit)
  (amb (reverse (iota 9))))

(define (digits)
  (+ (* 100 (digit)) (* 10 (digit)) (digit)))

(define (palindrome)
  (letrec ((a (digits))
	   (b (digits))
	   (x (* a b)))
    (if (and (>= a 100) (>= b 100)
	     (eq? (modulo (quotient x 100000) 10) 
		  (modulo (quotient x 1) 10))
	     (eq? (modulo (quotient x 10000) 10) 
		  (modulo (quotient x 10) 10))
	     (eq? (modulo (quotient x 1000) 10) 
		  (modulo (quotient x 100) 10)))
	(list a b)
	(amb '()))))

(define (main _)
  (print (call/cc
	  (lambda(cc)
	    (push! fail (lambda () (cc 'no-choice)))
	    (palindrome)))))

参考