letとletrecが必要なのはなぜか
letとletrecの違い
そもそもletrecのrecは再帰のこと。なので下のように再帰する定義を書くことができる。
(letrec ((fact (^n (if (zero? n) 1 (* n (fact (- n 1))))))) (fact 10))
逆にletは非再帰なのでこうは書けない。
代わりに
(let ((x 1)) (let ((x (+ x 1))) x))
のように以前の定義をshadowingすることができる。
そしてこれが非再帰のletが必要な理由みたい。
どこでshadowingが必要か
ある identifier を、その値を使いつつ再定義する際に必要です
{中略}
リファレンス参照した上で、結果を同じ identifier に束縛しています。{中略}間違って元のリファレンスセルを参照できなくなりますからより安全。let が再帰がデフォルトだとするとこういう定義は書けません。どうしても別の identifier を使わなければならないので、元のリファレンスセルも参照できたままになってしまう。名前が面倒だし、リファレンスを隠せないので、不便かつ不安全
let が再帰でない理由というかメリット - camlspotter’s blog
簡単な例をSchemeで書くと
(let* ((hoge-lst (iota 10)) (hoge-vec (list->vector hoge-lst))))
を下のように書けた方が嬉しいということかな。
(let* ((hoge (iota 10)) (hoge (list->vector hoge))))
まあ、本質的に必要なのはletとletrecだけで、それを統合できない(したくない)理由はOCamlのそれとほとんど同じ。
もうひとつScheme特有な事情を挙げると、マクロがあるために「変数を確実にシャドウする手段」が必要ってことがある。 (aif) で、 を評価して真だったらその値を暗黙の変数itに束縛して を評価する、なんて非健全なマクロを書いた場合、その展開は束縛フォームを挿入するが (簡略のためlegacy macroな表記で): `(let ((it ,<test>)) (if it ,<then> ,<else>))
の中にitが含まれていたら、それは確実に外側のitを参照してもらわないと困る。「再帰参照があったらletrecとみなす」みたいに勝手に切り替わっちゃうとまずい。
http://blog.practical-scheme.net/shiro?20110509-too-many-lets
Project Eulerの問題をiPhoneでサクサク読みたい
です。
方針はとりあえず全問題をまとめて1つのhtmlファイルにして、それをpdfにすればいいかなっという感じ。
なのでまず、下のスクリプトで全問題をまとめた1つのhtmlファイルを作る。
(※ マルチスレッドじゃないので遅い(要学習)。エラーチェックも皆無なのでアレです)
ちなみにhtmlpragはここからDL。
で、出来たファイルからpdfを作る。(Macでやったので以下はMacの場合の話)
ブラウザで開いて"印刷"→"PDFで保存"的なことをすればおk。
(Chromeだと File→Print...と進んでDestinationをSave as PDFにしてSaveを実行)
※ 他にもターミナル(もしくはスクリプト内)から
/System/Library/Printers/Libraries/convert -f problems.html -o problems.pdf
としても作れるけど見た目がイマイチだったので今回は前者で。
Project EulerをSchemeで(46-50)
そろそろProject Euler用のモジュールつくったほうがいいかな。
(use util.combinations) (use gauche.sequence) (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)))))))) ; 試し割り (define (prime? n) (cond ((= n 2) #t) ((or (< n 2) (zero? (modulo n 2))) #f) (else (let1 m (floor->exact (sqrt n)) (let loop ((i 3)) (cond ((< m i) #t) ((zero? (modulo n i)) #f) (else (loop (+ i 2)))))))))
問46.
平方数の2倍と素数の和で表せない最小の奇合成数を求める問題。
; 総当り (define (e46) (let* ((ps (primes 10000)) (prime? ((^h (dolist (p ps) (hash-table-put! h p #t)) (^n (hash-table-get h n #f))) (make-hash-table))) (twice-a-square? ((^h (dolist (n (iota 100 1)) (hash-table-put! h (* 2 n n) #t)) (^n (hash-table-get h n #f))) (make-hash-table)))) (let loop ((n 3)) (if (prime? n) (loop (+ n 2)) (let loop2 ((ps ps)) (cond ((null? ps) n) ((twice-a-square? (- n (car ps))) (loop (+ n 2))) (else (loop2 (cdr ps)))))))))
問47.
連続する4つの数がそれぞれ4つの異なる素因数を持つ場合を考え, 連続する数の中で最小のものを求める問題。
; 連続する4数で素因数の個数が全て4となっているものを探す ; 遅い (define (e47) (define (factor-count n ps) (let loop ((ans 0) (n n) (ps ps)) (cond ((or (< n (car ps)) (null? ps)) ans) ((zero? (modulo n (car ps))) (loop (+ ans 1) (/ n (car ps)) (cdr ps))) (else (loop ans n (cdr ps)))))) (let1 ps (primes 200000) (let loop ((i 210) (fc '())) (cond ((< i 214) (loop (+ i 1) (cons (factor-count i ps) fc))) ((= 4 (car fc) (cadr fc) (caddr fc) (cadddr fc)) (- i 4)) (else (loop (+ i 1) (cons (factor-count i ps) fc)))))))
問48.
1^1 + 2^2 + 3^3 + ... + 1000^1000 の最後の10桁を求める問題。
; 全て足して下10桁のみ取り出す (define (e48) (mod (apply + (map (^n (expt n n)) (iota 1000 1))) (expt 10 10)))
問49.
それぞれ素数で各項は他の項の置換で表せ、等差数列となるような3数を求める問題。
; 1000<p<10000 なる素数pと同じ数字の組み合わせで作られる数iが ; 素数かつ p<i で ; さらにp i j が等差数列となるようにjをとったとき ; jが素数かつpと同じ数の組み合わせで作られていれば ; そのp i jが求める答えになる (define (e49) (call/cc (^(return) (for-each (^p (for-each (^i (when (and (< p i) (prime? i)) (let1 j (+ i (- i p)) (when (and (< j 10000) (prime? j) (= (list->integer (sort (integer->list p))) (list->integer (sort (integer->list j))))) (return (list->integer (list p i j))))))) (map list->integer (permutations* (integer->list p))))) ($ delete 1487 $ filter (cut < 1000 <>) $ primes 10000)))))
問50.
連続する素数の和で表したときに最長になる100万未満の素数を求める問題。
; 最長は2以降の素数を100万を超えないように順番に足していったときの長さなので ; そこから素数が見つかるまで長さを縮めていく (define (e50) (let* ((ps (primes 5000)) (v (make-vector (+ (length ps) 1) 0))) (for-each-with-index (^(i p) (vector-set! v (+ i 1) (+ p (vector-ref v i)))) ps) (let1 max-len (let loop ((i 0)) (if (< 1000000 (vector-ref v (+ i 1))) i (loop (+ i 1)))) (call/cc (^(return) (for-each (^l (call/cc (^(break) (for-each (^i (let1 s (- (vector-ref v (+ i l)) (vector-ref v i)) (cond ((< 1000000 s) (break)) ((prime? s) (return s))))) (iota (- (+ max-len 1) l) 1))))) (iota max-len max-len -1)))))))
Project EulerをSchemeで(41-45)
一週間ほどプログラムから離れてたら、括弧が恋しくなってきちゃって。
(use srfi-1) (use util.combinations) (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 (make-polygonal-test solver) (let1 ht (make-hash-table) (^(y) (if (hash-table-get ht y #f) #t (let1 x (solver y) (if (= x (floor->exact x)) (begin (hash-table-put! ht y #t) #t) #f))))))
問41.
n桁Pandigitalな素数の中で最大の数を求める問題。
; 各桁の和が3の倍数になる数は3の倍数なので ; (apply + (iota 4 1)) = 10 ; (apply + (iota 5 1)) = 15 ; (apply + (iota 6 1)) = 21 ; (apply + (iota 7 1)) = 28 ; (apply + (iota 8 1)) = 36 ; (apply + (iota 9 1)) = 45 ; より, 7桁と4桁のときのみを調べればよい (define (e41) (define (prime? n) ; 試し割り (cond ((= n 2) #t) ((or (< n 2) (zero? (modulo n 2))) #f) (else (let1 m (floor->exact (sqrt n)) (let loop ((i 3)) (cond ((< m i) #t) ((zero? (modulo n i)) #f) (else (loop (+ i 2))))))))) (define (seek digit) (let1 l (reverse (sort (map list->integer (permutations (iota digit 1))))) (let loop ((l l)) (cond ((null? l) #f) ((prime? (car l)) (car l)) (else (loop (cdr l))))))) (or (seek 7) (seek 4)))
問42.
指定のファイル中に三角語はいくつあるかを求める問題。
; words.txtに含まれる単語の最大長は15なので, 1000(> 15*26)以下の三角数を判定出来れば十分 (define (e42) (define (word-value w) (apply + (map (^(c) (- (char->integer c) 64)) (string->list w)))) (define triangle? (let1 v (make-vector 1000 #f) (let loop ((n 1) (val 1)) (when (< val 1000) (vector-set! v val #t) (loop (+ n 1) (* (/ n 2) (+ n 1))))) (^(n) (vector-ref v n)))) (let1 ans 0 (for-each (^(w) (when (triangle? (word-value w)) (set! ans (+ 1 ans)))) (map (^(s) (substring s 1 (- (string-length s) 1))) (string-split (call-with-input-file "./words.txt" read-line) ","))) ans))
問43.
指定の性質をもつ0から9のPandigital数の総和を求める問題。
; 後ろからチェックしていく (define (e43) (define (make-pandigital-test d) (^(l) (= d (length (delete-duplicates l))))) (define (add-digit l) (map (^(d) (cons d l)) (iota 10))) (let loop ((l (map integer->list (iota 90 10))) (ps '(17 13 11 7 5 3 2)) (d 3)) (if (null? ps) (apply + (map list->integer (filter (make-pandigital-test d) (append-map add-digit l)))) (let1 next (filter (make-pandigital-test d) (filter (^(k) (zero? (modulo (list->integer (list (car k) (cadr k) (caddr k))) (car ps)))) (append-map add-digit l))) (loop next (cdr ps) (+ d 1))))))
問44.
差と和が五角数になる五角数のペアについて差の最小値を求める問題。
; 五角数に対して, それ以下の五角数全てとの和, 差をチェックする (define (e44) (define pentagonal? (make-polygonal-test (^(y) (/ (+ 1 (sqrt (+ 1 (* 24 y)))) 6)))) (let loop ((n 2) (l '(1))) (let1 p (/ (* n (- (* 3 n) 1)) 2) (let loop2 ((pl l)) (cond ((null? pl) (loop (+ n 1) (cons p l))) ((and (pentagonal? (+ p (car pl))) (pentagonal? (- p (car pl)))) (- p (car pl))) (else (loop2 (cdr pl))))))))
問45.
40755の次の三角数かつ五角数かつ六角数な数を求める問題。
; 六角数をチェックしていくだけ (define (e45) (define triangle? (make-polygonal-test (^(y) (/ (- (sqrt (+ 1 (* 8 y))) 1) 2)))) (define pentagonal? (make-polygonal-test (^(y) (/ (+ 1 (sqrt (+ 1 (* 24 y)))) 6)))) (let loop ((n 144) (v 41328)) (if (and (triangle? v) (pentagonal? v)) v (loop (+ n 1) (* (+ n 1) (+ (* 2 n) 1))))))
Project EulerをSchemeで(36-40)
Schemeらしい書き方も勉強しなきゃ。
(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))))))))
問36.
100万未満で10進でも2進でも回文数になるような数の総和を求める問題。
; そのまんま (define (e36) (define (palindrome? i) (= i (list->integer (reverse (integer->list i))))) (let1 ans 0 (for-each (^(n) (when (and (palindrome? n) (palindrome? (string->number (number->string n 2)))) (set! ans (+ ans n)))) (iota 1000000 1)) ans))
問37.
右から切り詰めても左から切り詰めても素数になるような素数の総和を求める問題。
; 偶数と5が含まれていると, それらが1の位に来たときに割り切れる ; 9, 1が先頭や末尾にあると, 1桁のときに素数でなくなってしまう ; 39が先頭や末尾にあると, 2桁のときに素数でなくなってしまう ; 他に11, 33, 77, 99が含まれていてもダメだが, 面倒なので省略 (define (e37) (let ((ps (primes 1000000)) (ht (make-hash-table))) (for-each (^(p) (hash-table-put! ht p #t)) ps) (let1 truncatable? (^(p) (let* ((prime? (^(p) (hash-table-get ht p #f))) (l (integer->list p))) (and (< 10 p) (or (< p 100) (not (any (^(n) (or (even? n) (= 5 n))) l))) ; !/[024568]/ (not (or (= 9 (car l)) (= 1 (car l)) ; !/^[91]/ (= 9 (last l)) (= 1 (last l)) ; !/[91]$/ (and (= 3 (car l)) (= 9 (cadr l))) ; !/^39/ (and (= 3 (car (reverse l))) ; !/39$/ (= 9 (cadr (reverse l)))))) (let l-loop ((l (cdr l))) (cond ((null? l) #t) ((not (prime? (list->integer l))) #f) (else (l-loop (cdr l))))) (let r-loop ((p (quotient p 10))) (cond ((zero? p) #t) ((not (prime? p)) #f) (else (r-loop (quotient p 10)))))))) (let loop ((ps ps) (ans '())) (if (null? ps) (apply + ans) (loop (cdr ps) (if (truncatable? (car ps)) (cons (car ps) ans) ans)))))))
問38.
整数と(1,2,...,n) (n > 1) との連結積として得られる9桁のPandigital数の中で最大のものを求める問題。
; (連結数) -> (許容される整数の範囲) とすると ; 9 -> 1 ; 8 -> 無 ; 7 -> 無 ; 6 -> 3 ; 5 -> 5 - 9 ; 4 -> 25 - 33 ; 3 -> 100 - 333 ; 2 -> 5000 - 9999 ; よって, 9182 - 9999 の範囲を調べればよい. (define (e38) (define (pandigital? i) (= 123456789 (list->integer (sort (integer->list i))))) (fold (^(n p) (let1 i (+ (* n 100000) (* n 2)) (if (and (pandigital? i) (< p i)) i p))) 918273645 (iota 818 9182)))
問39.
直角三角形の周囲の長さをpとして、p<=1000の範囲でもっとも多くの直角三角形を持つpを求める問題。
; 直角三角形の各辺の長さをa, b, cとする(c: 斜辺)と, ; a^2 + b^2 = c^2 と ; a + b + c = p より ; p(p - 2a) = 2b(p - a) が成り立つので ; aは, mod p(p - 2a) 2(p - a) = 0 を満たす (define (e39) (define (solutions p) (let1 ans 0 (for-each (^(a) (when (zero? (modulo (* p (- p (* 2 a))) (* 2 (- p a)))) (set! ans (+ ans 1)))) (iota (- (quotient p 3) 1) 1)) ans)) (cadr (fold (^(n p) (let1 s (solutions n) (if (< (car p) s) (list s n) p))) '(0 0) (iota 499 4 2))))
問40.
1234567891011...と無限に続く数列のなかで、特定の項の積を求める問題。
; 1000000 < 1*10 + 2*90 + 3*900 + 4*9000 + 5*90000 + 6* 100000 ; なので200000までで十分 (define (e40) (let loop ((cnt 0) (next 1) (ans 1) (l (iota 200000))) (if (< 1000000 cnt) ans (let* ((il (integer->list (car l))) (hit? (< next (+ cnt (length il))))) (loop (+ cnt (length il)) (* next (if hit? 10 1)) (* ans (if hit? (list-ref il (- next cnt)) 1)) (cdr l))))))
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)))))