compact-number-list
higepon さんの d:id:higepon:20080925:1222326246 をやってみました。
こういう問題です。
整列済みの number のリストがある。
'(1 3 4 5 6 12 13 15)このようなリストで数が連続している部分は '(1 2 3) -> '(1 . 3) のように両端のみを書くような記法を導入する。
最初の例のリストであれば以下のようになる。
'(1 (3 . 6) (12 . 13) 15)このようなリストの変換をするコードを書きたい。
http://d.hatena.ne.jp/higepon/20080925/1222326246
で、わたしの書いたコードがこちら。
(use srfi-1) (define (compact-number-list lst) (define (consec? a b) (if (pair? a) (= (+ (cdr a) 1) b) (= (+ a 1) b))) (define (update-range a b) (if (pair? a) (cons (car a) b) (cons a b))) (let loop ((result (list (car lst))) (rest (cdr lst))) (if (null? rest) (reverse result) (let ((prev (car result)) (now (car rest))) (loop (if (consec? prev now) (cons (update-range prev now) (cdr result)) (cons now result)) (cdr rest)))))) (define (expand-compacted-list lst) (append-map (lambda (x) (if (pair? x) (iota (- (cdr x) (car x) (- 1)) (car x)) (list x))) lst)) (compact-number-list '(1 3 4 5 6 12 13 15)) (expand-compacted-list (compact-number-list '(1 3 4 5 6 12 13 15)))
流れは higepon さんのと同じですが、if を loop の中に入れて、苦し紛れながらもスッキリさせてみました。
逆の expand もやってみましたけど、こちらは瞬殺。
problem 37
d:id:mtsuyugu:20080815:1218805119 の prime.scm を利用しています。
結構時間がかかりました。
(use srfi-1) (load "./prime.scm") (define (keta n) (let loop ((n n) (i 0)) (if (= n 0) i (loop (quotient n 10) (+ i 1))))) (define (truncate-l-r n) (let1 k (keta n) (map (lambda (k) (modulo n (expt 10 k))) (iota k 1)))) (define (truncate-r-l n) (let1 k (keta n) (map (lambda (k) (quotient n (expt 10 (- k 1)))) (iota k 1)))) (define (truncatable? n) (and (every prime? (truncate-l-r n)) (every prime? (truncate-r-l n)))) (define (p37) (let loop ((i 11) (r '())) (if (= (length r) 11) (apply + r) (loop (+ i 2) (if (truncatable? i) (cons i r) r)))))
problem 12
約数が 500 以上ある最少の数を求める問題です。
d:id:mtsuyugu:20080815:1218805119 の prime.scm を利用しています。
(load "./prime.scm") (define (tri n) (/ (* n (+ n 1)) 2)) (define (p12) (let loop ((i 2)) (let* ((tri (tri i)) (num-div (num-of-divisor tri))) (if (>= num-div 500) tri (loop (+ i 1)))))) (print (p12))
素数関連のプログラム
素数関連の問題は次の関数群を使うことにしました。
prime.scm とでもしておきます。
(use util.stream) (define divisible? (lambda (n d) (= (modulo n d) 0))) (define square (lambda (x) (* x x))) ; n 以上の整数ストリーム (define (integers-starting-from n) (stream-cons n (integers-starting-from (+ n 1)))) ; n が素数か(sqrt(n) 以下の素数で割り切れたら素数ではない) (define (prime? n) (define (iter ps) (cond ((> (square (stream-car ps)) n) #t) ((divisible? n (stream-car ps)) #f) (else (iter (stream-cdr ps))))) (if (= n 1) #f (iter primes))) ; 素数ストリーム (define primes (stream-cons 2 (stream-filter prime? (integers-starting-from 3)))) ; ハッシュのコピー (define (copy-hash-table dst src) (hash-table-for-each src (lambda (k v) (hash-table-put! dst k v))) dst) ; メモ化用ハッシュテーブル (define factorized-ht (make-hash-table)) ; num を素因数分解。ハッシュが返る。 (define (prime-factorize num) (if (hash-table-get factorized-ht num #f) (hash-table-get factorized-ht num) ; メモ化済み (let1 ht (make-hash-table) (let loop ((n num) (p primes)) (if (= n 1) (begin (hash-table-put! factorized-ht num ht) ; メモ化しておく ht) (let* ((prime (stream-car p)) (div? (divisible? n prime)) (q (quotient n prime))) (when div? ; 素因数を発見 (let ((qhash (hash-table-get factorized-ht q #f))) (when qhash (copy-hash-table ht qhash) (set! q 1)) ; 次のループで終了させるため (hash-table-put! ht prime (+ (hash-table-get ht prime 0) 1)))) (loop (if div? q n) (if div? p (stream-cdr p))))))))) ; num の約数の数 (define (num-of-divisor num) (hash-table-fold (prime-factorize num) (lambda (k v p) (* p (+ v 1))) 1))
problem 32
39*186 = 7254 のように被乗数、乗数、積をつなげた 9 桁の数がパンデジタル数になる、積の和を求める問題。
総当たりで解きました。
9 桁のパンデジタル数に 2 カ所切り込みを入れて 3 つの数を作り、初めの 2 つの数の積が 3 つめの数になる場合を抽出しています。9 桁のパンデジタル数は順列を使って生成しています。
(use srfi-1) (use util.combinations) ; '(1 2 3) -> 123 (define (list->number l) (let loop ((l l) (r 0)) (if (null? l) r (loop (cdr l) (+ (* r 10) (car l)))))) ; 123 -> 3 (define (keta n) (let loop ((n n) (i 0)) (if (= n 0) i (loop (quotient n 10) (+ i 1))))) ; 1234 1 -> '(123 4), 1234 2 -> '(12 34) (define (split-2 n i) (let1 k (expt 10 i) (list (quotient n k) (modulo n k)))) ; 1234 -> '((1 234) (12 34) (123 4)) (define (all-splits-2 n) (map (lambda (i) (split-2 n i)) (reverse (iota (- (keta n) 1) 1)))) ; 1234 -> '((1 2 34) (1 23 4) (12 3 4)) (define (all-splits-3 n) (fold (lambda (i p) (let* ((ns (split-2 n i)) (n1 (car ns)) (n2 (all-splits-2 (cadr ns)))) (append p (map (pa$ cons n1) n2)))) '() (reverse (iota (- (keta n) 1) 1)))) ; find solutions from pandigital 9-digits number n (define (find n) (filter-map (lambda (x) (if (= (* (car x) (cadr x)) (caddr x)) (caddr x) #f)) (all-splits-3 n))) (define (p32) (let1 result '() (permutations-for-each (lambda (x) (set! result (append result (find (list->number x))))) (iota 9 1)) (apply + (delete-duplicates result))))
わかったこと
(permutaions-for-each proc list) で list の順列それぞれに対して proc を呼び出す。
problem 39
三角形の周辺長が p(< 1000) の直角三角形の辺を a, b, c としたとき各辺が整数になる a, b, c の組の数がいちばん多い p を求める問題です。
cartesian-product を使って総当たりでチェックしているために時間はかかりますが答えは求まります。
(use srfi-1) (use util.combinations) (define (square x) (* x x)) (define (right-angle? t) (= (+ (square (car t)) (square (cadr t))) (square (caddr t)))) (define (lookup n) (delete-duplicates (filter-map (lambda (t) (let* ((a (car t)) (b (cadr t)) (c (- n a b)) (t (sort (list a b c)))) (if (and (> c 0) (right-angle? t)) t #f))) (cartesian-product (list (iota (- n 1) 1) (iota (- n 1) 1)))))) (define (p39) (let loop ((i 3) (r 0) (p 0)) (if (= i 1000) p (let* ((found (lookup i)) (result (length found))) (loop (+ i 1) (if (> result r) result r) (if (> result r) i p)))))) (print (p39)
problem 63
x^n が n 桁の数になるような x はいくつあるかという問題。
10^n は n+1 桁の数だから n がどんな値であれ x が 10 未満は明らかです。
あとは 9^n ですら n-1 桁になるような n が見つかるまで n をひとつずつ増やして題意を満たす x を数え上げていけば答えは求まります。
それを scheme にしたのがこちら。
(use srfi-1) (define (keta n) (let loop ((n n) (i 0)) (if (= n 0) i (loop (quotient n 10) (+ i 1))))) (define (nth-power-1-9 n) (map (cut expt <> n) (iota 9 1))) (define (p63) (let loop ((i 1) (r 0)) (let ((result (count (lambda (x) (= i (keta x))) (nth-power-1-9 i)))) (if (= result 0) r (loop (+ i 1) (+ r result))))))
