Project EulerをSchemeで(31-35)

いい加減アルゴリズム勉強しなきゃ。

(use srfi-1)

(define (integer->list i)
  (letrec ((i->rl (^(i) (cons (modulo i 10)
			      (if (< i 10)
				  '()
				  (i->rl (quotient i 10)))))))
    (reverse (i->rl i))))

(define (list->integer l)
  (define (shift-d n)
    (let loop ((d 10))
      (if (< n d) d (loop (* 10 d)))))
  (fold (^(n p) (+ (* p (shift-d n)) n)) 0 l))

(define (primes n)
  (if (<= n 2)
      '()
      (let1 u (truncate (sqrt n))
	(let loop ((ps '(2))
		   (l (unfold (cut < n <>) values (cut + 2 <>) 3)))
	  (let1 m (car l)
	    (if (> m u)
		(append (reverse ps) l)
		(loop (cons m ps)
		      (remove (^(x) (zero? (modulo x m))) l))))))))

問31.

イギリスの硬貨(8種類)を使って£2を作る方法は何通りあるか求める問題。

; 動的計画法
(define (e31)
  (let ((coins '(200 100 50 20 10 5 2 1))
	(ways (make-vector 201 0)))
    (vector-set! ways 0 1)
    (for-each (^(coin)
		(for-each (^(i) (vector-set! ways i
					     (+ (vector-ref ways i)
						(vector-ref ways (- i coin)))))
			  (iota (- 201 coin) coin)))
	      coins)
    (vector-ref ways 200)))

問32.

掛けられる数/掛ける数/積に1から9の数が1回ずつ出現するような積の総和を求める問題。

; d * dddd = dddd
; dd * ddd = dddd
; のパターンのみ
(define (e32)
  (define (pandigital? l)
    (= 123456789 (list->integer (sort (integer->list (list->integer l))))))
  (define (divisors n)
    (let loop ((i (floor->exact (sqrt n))) (ans '()))
      (if (< i 2)
	  ans
	  (loop (- i 1) (if (zero? (modulo n i))
			    (cons (list i (quotient n i)) ans)
			    ans)))))
  (apply + (map
	    (^(n) (if (any
		       (^(dl) (pandigital? (list n (car dl) (cadr dl))))
		       (divisors n))
		      n 0))
	    (iota 8766 1234))))

問33.

分子、分母がともに2桁な分数の中で、共通する数字を除いた分数と元の分数が一致するようなものの積の分母を求める問題。

; 分子の10の位 = 分母の1の位 かつ 分子の1の位*分母 = 分母の10の位*分子
; もしくは
; 分子の1の位 = 分母の10の位 かつ 分子の10の位*分母 = 分母の1の位*分子
; となるような分子, 分母のペアを求めればよい
(define (e33)
  (apply * (append-map
	    (^(x)
	      (map (^(y)
		     (cond ((and (= (quotient x 10) (modulo y 10))
				 (= (* (modulo x 10) y) (* (quotient y 10) x)))
			    (/ x y))
			   ((and (= (modulo x 10) (quotient y 10))
				 (= (* (quotient x 10) y) (* (modulo y 10) x)))
			    (/ x y))
			   (else 1)))
		   (iota (- 99 x) (+ x 1))))
	    (filter (^(n) (not (zero? (modulo n 11))))
		    (iota 89 11)))))

問34.

各桁の数の階乗の和が自分自身と一致するような数の総和を求める問題。

; 正直過ぎる実装. 遅い.
(define (e34)
  (let1 v (make-vector 10 0)
    (vector-set! v 0 1)
    (for-each (^(n) (vector-set! v n (* n (vector-ref v (- n 1)))))
	      (iota 9 1))
    (apply + (filter (^(n) (= n (apply + (map (cut vector-ref v <>)
					      (integer->list n)))))
		     (iota (- (* 7 (vector-ref v 9)) 10) 11)))))

問35.

100万未満の巡回素数の個数を求める問題。

; 各桁に偶数と5を含まないような素数のみ確認する
; (2, 5も巡回素数なので後で足しておく)
(define (e35)
  (define (rotate l) (append (cdr l) (list (car l))))
  (let ((ps (primes 1000000))
	(ht (make-hash-table)))
    (for-each (^(p) (hash-table-put! ht p #t)) ps)
    (+ 2 ; 2, 5
       (length (filter
		(^(p) (let1 l (integer->list p)
			(and (not (any (^(n) (or (= 5 n) (even? n))) l))
			     (let loop ((l (rotate l))
					(cnt (- (length l) 1)))
			       (cond ((zero? cnt) #t)
				     ((hash-table-get ht (list->integer l) #f)
				      (loop (rotate l) (- cnt 1)))
				     (else #f))))))
		ps)))))