problem 79
問題の本質は、集合の要素間の部分的な順序関係が複数与えられたときに要素全体の順序を見つける問題です。
これを解くのはトポロジカルソートです。とはいっても、この問題を解くまでトポロジカルソートについては名前と何をするものかぐらいしかしりませんでした。幸い gauche には topological-sort があることがわかりましたので、僕がするのは入力データを topological-sort の引数に与えられる形にすることだけでした。 topological-sort がなかったら、Topological sorting - Wikipedia を参考にして実装するはめになってました。
(use srfi-1) (use util.toposort) (define (p79) (call-with-input-file "p79_dat.txt" (lambda (p) (let loop ((nodes '())) (let1 line (read-line p) (if (not (eof-object? line)) (let* ((nums (string->list line)) (key (car nums)) (value (cdr nums)) (found (assq key nodes))) (if found (set-cdr! found (delete-duplicates (append found value))) ; update (set! nodes (acons key value nodes))) ; new (loop nodes)) (list->string (topological-sort (map cdr nodes))))))))) (print (p79))
project euler には珍しく、この問題はプログラムを書くよりも紙と手で直接解いた方が速くすませられる問題です。実際私は初めは紙と手で解きました。
problem 31
金額が 1, 2, 5, 10, 20, 50, 100, 200 のコインがあるときに 200 の作り方は何通りあるかという問題です。
(use srfi-1) (define kinds (list 200 100 50 20 10 5 2 1)) ; k 以下のコインを使って n を作る方法は何通りあるか（ k のコインは最低一枚以上は使う） (define (f k n) (let ((found (member k kinds))) (cond ((= k 1) 1) (found (let ((k1 (car found)) ; k1 = k (k2 (cadr found))) ; k1 の次のコイン (fold (lambda (x p) ; k1 を x 枚使ったため残りの金額を k2 以下のコインで組みあわせる (+ (F k2 (- n (* k1 x))) p)) 0 (iota (quotient n k1) 1)))) ; k1 は 1 〜 n/k1 枚使える (else 0)))) ; k のコインがない場合はエラー ; k 以下のコインを使って n を作る方法は何通りあるか(使用コインの制限なし) (define (F k n) (fold (lambda (x p) (+ (f x n) p)) 0 (member k kinds))) (define (p31) (F 200 200)) (print (p31))
problem 59
キーと平文との xor を取ることで作成された暗号をブルートフォースで解く問題です。キーは小文字のアルファベット 3 文字を平文の長さだけ繰り返したものです。
(use srfi-1) (use util.combinations) (define encrypted (list 79 59 12 ..(省略)...16 15 10 22 73)) ; all possible combinations of three lower case characters. (define key-list (let ((ca (char->integer #\a)) (cz (char->integer #\z))) (cartesian-product (make-list 3 (iota (- cz ca -1) ca))))) ;generate infinite encryption key (define (key-gen key) (set! (cdddr key) key) key) (define (p59) (fold (lambda (c p) (+ p (char->integer c))) 0 (string->list (any (lambda (x) (let1 str (apply string (map (lambda (e k) (integer->char (logxor e k))) ; decrypt encrypted (key-gen x))) (if (string-scan str " this ") str #f))) key-list)))) (print (p59))
正しく復号できたかどうかは " this " があるかどうかでチェックしていますが、これは後付けです。全てのキーに関して復号した文字列を見てチェックして正しく復号できた文字列には " this " があることを確認してからコードに追加しました。
problem 33
49/98 は 1/2 ですが、49/98 の 9 を消しても 4/8 = 1/2 になるという面白い性質を持っています。
問題 33 は二桁の分母分子からなる 1 未満の分数で先の例のような分数をすべてかけたときの分母の値はいくつか？ というものです。 30/40 の 0 を消して 3/4 のような trivial なものは除外します。
gauche は正数の除算を既約分数の形で表してくれるため、約分の処理を書かなくて済みました。
(use srfi-1) (use util.combinations) (define (pseudo-cancel n d) ; (12 23) -> (/ 1 3) (define (num->digits n) ; 12 -> (1 2) (map (cut <> n 10) (list quotient modulo))) (define (same-digits? n1 n2) ; (same-digits? 12 23) -> 2 (let* ((d1 (num->digits n1)) (d2 (num->digits n2))) (any (lambda (x) (if (apply = x) (car x) #f)) (cartesian-product (list d1 d2))))) (define (del-digits n d) ; (del-digits 23 2) -> 3 (let ((q (quotient n 10)) (m (modulo n 10))) (cond ((= q d) m) ((= m d) q) (else 0)))) (let ((found (same-digits? n d))) (if found (/ (del-digits n found) (del-digits d found)) 0))) (define (p33) (define (gen-rational) (fold (lambda (d p) (append p (map (lambda (n) (list n d)) (iota (- d 9) 10)))) '() (iota 90 10))) (denominator (apply * (filter-map (lambda (num) (let* ((n (car num)) (d (cadr num)) (p (pseudo-cancel n d))) (cond ((= n d) #f) ; trivial (ex. 12/12 = 1) ((every (lambda (x) (= 0 (modulo x 10))) num) #f) ; trivial (ex. 10/20 = 1/2) ((= p (apply / num)) p) (else #f)))) (gen-rational)))))
problem 81
80*80 の行列の左上から右下まで要素を辿っていったときの経路となった要素の和が最少になるときの値はいくつかを求める問題です。
各要素の値を、ひとつ上とひとつ右の要素の値を比べて小さい方の値と自分自身の値の和に置き換える、という操作を左上から右下まで行っていけば最終的に右下の要素に求める値が入っているという仕組みです。ひとつ上やひとつ右の要素がない場合は maxnum を返しています。
(define maxnum 9999999999999) ; return vector of vectors (define (input-file fname) (call-with-input-file fname (lambda (p) (let loop ((r '())) (let1 line (read-line p) (if (eof-object? line) (list->vector (reverse r)) (loop (cons ((compose list->vector (map$ string->number)) (string-split line #\,)) r)))))))) (define (vector2d-at v i j) (let1 vi (vector-ref v i #f) (if vi (vector-ref vi j maxnum) maxnum))) (define (vector2d-set! v i j obj) (let1 vi (vector-ref v i #f) (if vi (vector-set! vi j obj) #f))) (define (p81) (let* ((h 80) (w 80) (v (input-file "p81_data.txt"))) (let loop ((i 0) (j 1)) (cond ((> i h) (vector2d-at v (- w 1) (- h 1))) (else (vector2d-set! v i j (+ (vector2d-at v i j) (min (vector2d-at v (- i 1) j) (vector2d-at v i (- j 1))))) (loop (if (= j (- w 1)) (+ i 1) i) (if (= j (- w 1)) 0 (+ j 1)))))))) (print (p81))
problem 99
1000 個ある 基数とべき数のペア（ファイルの各行にコンマ区切りで列挙されている）からべき乗数のうち、最大になるものは何番目かという問題です。
基数、べき数ともに大きな数なので、べき乗数で比較せずに対数で比較します。比較に使うだけなので対数の底は dont' care です。
(define (p99) (call-with-input-file "p99_data.txt" (lambda (p) (let loop ((tmp '(0 0)) (i 1)) (let1 line (read-line p) (if (eof-object? line) (cadr tmp) (let1 value (apply (lambda (b e) (* e (log b))) (map string->number (string-split line #\,))) (loop (if (> (car tmp) value) tmp (list value i)) (+ i 1))))))))) (print (p99))
問題 99 にしては簡単な問題でした。
problem 57
2 の平方根を連分数で近似するとき、 1000 段までの近似値のなかで、分子の桁数が分母の桁数より多いものはいくつあるかという問題です。
初めは桁数を求めるために
(floor (+ 1 (/ (log n) (log 10)))
としてましたが、n = 1000 のとき演算誤差のために (/ (log 1000) (log 10)) が 2.99999... になってしまい全ての場合で正しい桁数が得られないことが分かったので、10 で割っていく方法にしました。
(use srfi-1) (define root2 (let ((r '())) ; lookup-table for memomization (define (root-2-iter n) (let1 found (assq n r) (cond ((= n 0) (/ 1 2)) (found (cdr found)) (else (let1 v (/ 1 (+ 2 (root-2-iter (- n 1)))) (set! r (acons n v r)) v))))) (compose (pa$ + 1) root-2-iter))) (define (keta n) (let loop ((n n) (i 0)) (if (= n 0) i (loop (quotient n 10) (+ i 1))))) (define (p57) (count (lambda (x) (let* ((r2 (root2 x)) (n (keta (numerator r2))) (d (keta (denominator r2)))) (> n d))) (iota 1000))) (print (p57))
分かったこと
numerator, denominator で有理数のそれぞれ分子、分母を得ることができる。
