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)))))))