Project Euler: Problem 4

明日から冬休みらしいんだけど、いまいち実感が湧かない。気合いを入れるために Project Euler やってみたけど、いまいちきれいに書けた気がしない。

A palindromic number reads the same both ways. The largest palindrome made from the product of two 2-digit numbers is 9009 = 91 × 99.

Find the largest palindrome made from the product of two 3-digit numbers.

http://projecteuler.net/index.php?section=problems&id=4

2つの3桁の数の積からなる、前からも後ろからもどうぞな回文の数字のうち最大のものを挙げよとのこと。

例によって Gauche で解いてみた。とりあえず動きそうだったから効率はあんまり考えずに書いてみた。範囲に含まれる回文を全て求めたうえで、それらを3桁の数字同士で因数分解した最大値を返す。

#!/usr/bin/env gosh

;; 自然数 n の桁数を求める
(define (place-of n)
;  (let loop [(n n)
;             (r 1)]
;    (if (< n 10)
;      r
;      (loop (quotient n 10) (+ r 1)))))
;; コメントで指摘してもらったものを参考に改良してみた
;; n の常用対数から桁数を求める
  (cond
    [(< 0 n)
     (+ 1 (inexact->exact (floor (/ (log n) (log 10)))))]
    [else
     (error "n must be a natural number greater than zero")]))

;; 自然数 n を一桁づつリストにした表現を返す
;; (作ったけどかっこ悪すぎるから使うのやめた)
;(define (integer->list n)
;  (if (< n 1)
;    '()
;    (let loop [(n n)
;               (lis '())]
;      (if (< n 1)
;        lis
;        (loop (quotient n 10) (cons (remainder n 10) lis))))))

;; n が回文かどうか調べる
(define (palindromic? n)
  (let [(place (place-of n))
        (reverse-integer (lambda (n)
                           (let loop [(n n)
                                      (r 0)]
                             (if (< n 1)
                               r
                               (loop (quotient n 10) (+ (* r 10) (remainder n 10)))))))]
    (let* [(mask  (expt 10 (quotient place 2)))
           (rear  (remainder n mask))
           (fore  (quotient (- n rear) (if (even? place) mask (* mask 10))))]
      (= fore (reverse-integer rear)))))

(use srfi-1) ; for filter

(define (main args)
  (define min3 100) ; 3桁の数字の最小値
  (define max3 999) ; 3桁の数字の最大値
  (define xlis '())

;; 2つの3桁の数字の最大値から最小値までをなめて回文を探す (無駄が多い)
  (let [(xmin (* min3 min3))
        (xmax (* max3 max3))]
    (let loop [(x xmax)
               (lis '())]
      (if (<= xmin x)
        (loop (- x 1) (if (palindromic? x) (cons x lis) lis))
        (set! xlis lis)))

    (for-each (lambda (p)
                (let [(a (car p))
                      (b (cdr p))]
                  (format #t "(* ~a ~a); ==> ~a\n" a b (* a b)))) ; 答えの表示
      (filter identity
        (map (lambda (x)
               (call/cc (lambda (throw)
                 (let loop [(a max3) ; x の因数である a と b をひたすら求める
                            (b (quotient x max3))]
                   (if (<= min3 a)
                     [begin
                       (if (and (= (remainder x a) 0)
                                (= (place-of b) 3)) ; 3 桁かどうか
                         (throw (cons a b))) ; ペアにしてためとく
                       (loop (- a 1) (quotient x (- a 1)))])
                   #f)))) ; 見つからなかったら #f を入れとく (あとで filter で消す)
             xlis))))
  0)