[Project Euler] Problem 28 「螺旋状に並んだ数の対角線」

1から初めて右方向に進み時計回りに数字を増やしていき, 5×5の螺旋が以下のように生成される:

21 22 23 24 25
20 07 08 09 10
19 06 01 02 11
18 05 04 03 12
17 16 15 14 13

両対角線上の数字の合計は101であることが確かめられる.
1001×1001の螺旋を同じ方法で生成したとき, 対角線上の数字の和はいくつか?

対角線上の数の増え方にパターンがあります. 一番内側が+2, その外側が+4となっています. まず, そのような数のリストを作ります.

(require srfi/1)

(define c
  (fold (lambda (n ans)
          (cons (+ (car ans) n) ans))
        '(1)
        (apply append
               (map (lambda (n) (list n n n n))
                    (iota 500 2 2)))))

計算してみます.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (take (reverse c) 20)
(1 3 5 7 9 13 17 21 25 31 37 43 49 57 65 73 81 91 101 111)
> (fold + 0 c)
669171001
> 

[Project Euler] Problem 27 「二次式素数」

オイラーは以下の二次式を考案している:

n2 + n + 41.

この式は, n を0から39までの連続する整数としたときに40個の素数を生成する. しかし, n = 40 のとき 40² + 40 + 41 = 40(40 + 1) + 41 となり41で割り切れる. また, n = 41 のときは 41² + 41 + 41 であり明らかに41で割り切れる.

計算機を用いて, 二次式 n² - 79n + 1601 という式が発見できた. これは n = 0 から 79 の連続する整数で80個の素数を生成する. 係数の積は, -79 × 1601 で -126479である.

さて, |a| < 1000, |b| < 1000 として以下の二次式を考える (ここで |a| は絶対値): 例えば |11| = 11, |-4| = 4である。

n² + an + b

n = 0 から始めて連続する整数で素数を生成したときに最長の長さとなる上の二次式の, 係数 a, b の積を答えよ.

素数の表があれば解けそうです.

1. 素数の表を作る.
2. 係数a, bから二次式を作る手続きを用意する.
3. 二次式から素数のリストを作る手続きを用意する.
4. aとbを与えられた範囲で変化させ, 素数のリストを作る.
5. 素数のリストが一番長いものを求める.

手続きは次のようになります.

(require srfi/1)

;; エラトステネスのふるい
(define (sieve pv n)
  (define (loop i)
    (when (< i (vector-length pv))
      (vector-set! pv i #f)
      (loop (+ i n))))
  (loop (+ n n)))

(define (find-prime pv start)
  (cond ((<= (vector-length pv) start) #f)
        ((vector-ref pv start) start)
        (else (find-prime pv (+ start 1)))))

(define (eratosthenes pv)
  (define (loop n)
    (when (and n (< n (sqrt (vector-length pv))))
      (sieve pv n)
      (loop (find-prime pv (+ n 1)))))
  (loop 2))
  
(define (prime-vector n)
  (let ((pv (make-vector (+ n 1) #t)))
    (eratosthenes pv)
    (vector-set! pv 0 #f)
    (vector-set! pv 1 #f)
    pv))

(define (prime-vect-to-list pv)
  (define (loop ans n)
    (if (< n (vector-length pv))
        (let ((p (find-prime pv n)))
          (if p 
              (loop (cons p ans) (+ p 1)) 
              (reverse ans)))
        (reverse ans)))
  (loop () 2))

;; 1000万以下の素数表を作る
(define prime-vect (prime-vector 10000000))

(define (prime? n) (vector-ref prime-vect (abs n)))

(define (quadric a b)
  (lambda (n) (+ (* n n)
                 (* a n)
                 b)))

(define (make-prime-list a b)
  (define (loop rslt n)
    (let ((v ((quadric a b) n)))
      (if (prime? v)
          (loop (cons v rslt) (+ n 1))
          (list a b (reverse rslt)))))
  (loop () 0))

(define ans
  (apply append
         (map (lambda (a)
                (map (lambda (b) (make-prime-list a b))
                     (iota 1999 -999)))
              (iota 1999 -999))))
 
(define sorted 
  (sort ans 
        (lambda (x y) (> (length (list-ref x 2)) 
                         (length (list-ref y 2))))))

計算してみます. 少し時間がかかります.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (make-prime-list 1 41)
(1
 41
 (41 43 47 53 61 71 83 97 113 131 151 173 197 223 251 281
  313 347 383 421 461 503 547 593 641 691 743 797 853 911
  971 1033 1097 1163 1231 1301 1373 1447 1523 1601))
> (car sorted)
(-61
 971
 (971 911 853 797 743 691 641 593 547 503 461 421 383 347
  313 281 251 223 197 173 151 131 113 97 83 71 61 53 47 43
  41 41 43 47 53 61 71 83 97 113 131 151 173 197 223 251 281
  313 347 383 421 461 503 547 593 641 691 743 797 853 911 971
  1033 1097 1163 1231 1301 1373 1447 1523 1601))
> (* -61 971)
-59231
> 

[Fieldrunners2] HOME ON DERANGEの攻略

HOME ON DERANGEの難易度HEROICを攻略する方法を紹介します。

GATLING TOWERを設置します。

 GATLING TOWERを伸ばしていきます。2箇所、Level 3までアップグレードします。

Round 12までに通路を完成させます。Round 13終了後、GATLING TOWERを売り、FLAMETHROWERを設置します。

FLAMETHROWERをLevel 3までアップグレードし、OIL TOWERも設置します。Level 3までアップグレードします。

FLAMETHROWERとOIL TOWERを追加します。追加したOIL TOWERはLevel 2までアップグレードしたところでやめておきます。

Round 30の軽戦車に対応するために、TESLA TOWERとGLUE TOWERを設置します。

FLAMETHROWERとGLUE TOWERを設置します。Round 42で現れる飛行機を確実に仕留めるためにGLUE TOWERを設置しています。

FLAMETHROWER、TESLA TOWER、OIL TOWERを追加します。

更にTESLA TOWERを追加し、通路を伸ばします。通路の途中でGLUE TOWERを設置しています。これは、敵ユニットを分散させてTESLA TOWERに近づけるためです。

Round 70を攻略したときのTOWERの配置です。TOWERをもう一つ使えるので、ENDLESSのためにRAILGUNを用意しておいても良さそうです。

[Project Euler] Problem 26 「逆数の循環節 その1」

単位分数とは分子が1の分数である. 分母が2から10の単位分数を10進数で表記すると次のようになる.

1/2 = 0.5
1/3 = 0.(3)
1/4 = 0.25
1/5 = 0.2
1/6 = 0.1(6)
1/7 = 0.(142857)
1/8 = 0.125
1/9 = 0.(1)
1/10 = 0.1

0.1(6)は 0.166666... という数字であり, 1桁の循環節を持つ. 1/7 の循環節は6桁ある.
d < 1000 なる 1/d の中で小数部の循環節が最も長くなるような d を求めよ.

割り算の筆算をすればよさそうです.

1. 1をdで割る.
2. 余りをリストに貯めこむ.
3. 余りを10倍し, dで割る.
4. 余りがリストにあれば循環している.

手続きは次のようになります.

(require srfi/1)

(define (make r q) (cons (* r 10) q))

(define (r-of t) (car t))

(define (q-of t) (cdr t))
  
(define (cycle? ts r)
  (find (lambda (t) (= (* r 10) (r-of t))) ts))

(define (cycles d rslt r)
  (if (< r d)
      (cycles d (cons (make r 0) rslt) (* r 10))
      (let ((q2 (quotient r d))
            (r2 (remainder r d)))
        (cond ((= 0 r2) (cons #f (reverse (cons (make r2 q2) rslt))))
              ((cycle? rslt r2) (cons #t (reverse (cons (make r2 q2) rslt))))
              (else (cycles d (cons (make r2 q2) rslt) (* r2 10)))))))


(define (reciprocal-cycles d)
  (let ((ans (cycles d '() 1)))
    (if (car ans)
        (map cdr (cdr ans))
        '())))
  
(define ans
  (sort (map (lambda (d) (list d (reciprocal-cycles d))) (iota 999 1))
        (lambda (a b) (< (length (list-ref a 1)) (length (list-ref b 1))))))

テストも含めて計算してみます.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (cycles 7 '() 1)
(#t (10 . 0) (30 . 1) (20 . 4) (60 . 2) (40 . 8) (50 . 5) (10 . 7))
> (map cdr (cdr (cycles 7 '() 1)))
(0 1 4 2 8 5 7)
> (car (reverse ans))
(983
 (0 0 0 1 0 1 7 2 9 3 9 9 7 9 6 5 4 1 2 0 0 4 0 6 9 1 7 5 9 9 1 8 6 1
  6 4 8 0 1 6 2 7 6 7 0 3 9 6 7 4 4 6 5 9 2 0 6 5 1 0 6 8 1 5 8 6 9 7
  8 6 3 6 8 2 6 0 4 2 7 2 6 3 4 7 9 1 4 5 4 7 3 0 4 1 7 0 9 0 5 3 9 1
  6 5 8 1 8 9 2 1 6 6 8 3 6 2 1 5 6 6 6 3 2 7 5 6 8 6 6 7 3 4 4 8 6 2
  6 6 5 3 1 0 2 7 4 6 6 9 3 7 9 4 5 0 6 6 1 2 4 1 0 9 8 6 7 7 5 1 7 8
  0 2 6 4 4 9 6 4 3 9 4 7 1 0 0 7 1 2 1 0 5 7 9 8 5 7 5 7 8 8 4 0 2 8
  4 8 4 2 3 1 9 4 3 0 3 1 5 3 6 1 1 3 9 3 6 9 2 7 7 7 2 1 2 6 1 4 4 4
  5 5 7 4 7 7 1 1 0 8 8 5 0 4 5 7 7 8 2 2 9 9 0 8 4 4 3 5 4 0 1 8 3 1
  1 2 9 1 9 6 3 3 7 7 4 1 6 0 7 3 2 4 5 1 6 7 8 5 3 5 0 9 6 6 4 2 9 2
  9 8 0 6 7 1 4 1 4 0 3 8 6 5 7 1 7 1 9 2 2 6 8 5 6 5 6 1 5 4 6 2 8 6
  8 7 6 9 0 7 4 2 6 2 4 6 1 8 5 1 4 7 5 0 7 6 2 9 7 0 4 9 8 4 7 4 0 5
  9 0 0 3 0 5 1 8 8 1 9 9 3 8 9 6 2 3 6 0 1 2 2 0 7 5 2 7 9 7 5 5 8 4
  9 4 4 0 4 8 8 3 0 1 1 1 9 0 2 3 3 9 7 7 6 1 9 5 3 2 0 4 4 7 6 0 9 3
  5 9 1 0 4 7 8 1 2 8 1 7 9 0 4 3 7 4 3 6 4 1 9 1 2 5 1 2 7 1 6 1 7 4
  9 7 4 5 6 7 6 5 0 0 5 0 8 6 4 6 9 9 8 9 8 2 7 0 6 0 0 2 0 3 4 5 8 7
  9 9 5 9 3 0 8 2 4 0 0 8 1 3 8 3 5 1 9 8 3 7 2 3 2 9 6 0 3 2 5 5 3 4
  0 7 9 3 4 8 9 3 1 8 4 1 3 0 2 1 3 6 3 1 7 3 9 5 7 2 7 3 6 5 2 0 8 5
  4 5 2 6 9 5 8 2 9 0 9 4 6 0 8 3 4 1 8 1 0 7 8 3 3 1 6 3 7 8 4 3 3 3
  6 7 2 4 3 1 3 3 2 6 5 5 1 3 7 3 3 4 6 8 9 7 2 5 3 3 0 6 2 0 5 4 9 3
  3 8 7 5 8 9 0 1 3 2 2 4 8 2 1 9 7 3 5 5 0 3 5 6 0 5 2 8 9 9 2 8 7 8
  9 4 2 0 1 4 2 4 2 1 1 5 9 7 1 5 1 5 7 6 8 0 5 6 9 6 8 4 6 3 8 8 6 0
  6 3 0 7 2 2 2 7 8 7 3 8 5 5 5 4 4 2 5 2 2 8 8 9 1 1 4 9 5 4 2 2 1 7
  7 0 0 9 1 5 5 6 4 5 9 8 1 6 8 8 7 0 8 0 3 6 6 2 2 5 8 3 9 2 6 7 5 4
  8 3 2 1 4 6 4 9 0 3 3 5 7 0 7 0 1 9 3 2 8 5 8 5 9 6 1 3 4 2 8 2 8 0
  7 7 3 1 4 3 4 3 8 4 5 3 7 1 3 1 2 3 0 9 2 5 7 3 7 5 3 8 1 4 8 5 2 4
  9 2 3 7 0 2 9 5 0 1 5 2 5 9 4 0 9 9 6 9 4 8 1 1 8 0 0 6 1 0 3 7 6 3
  9 8 7 7 9 2 4 7 2 0 2 4 4 1 5 0 5 5 9 5 1 1 6 9 8 8 8 0 9 7 6 6 0 2
  2 3 8 0 4 6 7 9 5 5 2 3 9 0 6 4 0 8 9 5 2 1 8 7 1 8 2 0 9 5 6 2 5 6
  3 5 8 0 8 7 4 8 7 2 8 3 8 2 5 0 2 5 4 3 2 3 4 9 9 4 9 1 3 5 3))
> 

このコードでは, 循環の２回めが始まる小数点以下の桁数を求めているため正確ではありませんが, 答えが合っていたので良しとします.

[Project Euler] Problem 25 「1000桁のフィボナッチ数」

フィボナッチ数列は以下の漸化式で定義される:

F_n = F_n-1 + F_n-2 　(ただし F₁ = 1, F₂ = 1)

最初の12項は以下である.

F₁ = 1
F₂ = 1
F₃ = 2
F₄ = 3
F₅ = 5
F₆ = 8
F₇ = 13
F₈ = 21
F₉ = 34
F₁₀ = 55
F₁₁ = 89
F₁₂ = 144

12番目の項, F₁₂が3桁になる最初の項である.
1000桁になる最初の項の番号を答えよ.

フィボナッチ数を求めていけばよさそうです.

1. SICPの反復的プロセスを生成する手続きを参考にフィボナッチ数を求める.
2. フィボナッチ数を求める手続きの中で1000桁を超えたか判定する.

手続きは次のようになります.

(require srfi/1)

(define (decimal-format nbr)
  (define (loop ans n)
    (if (= 0 n)
        ans
        (loop (cons (remainder n 10) ans) (quotient n 10))))
  (loop () nbr))

(define (fib-list)
  (define (loop r a b)
    (if (<= 1000 (length (decimal-format a)))
        (reverse (cons a r))
        (loop (cons a r) b (+ a b))))
  (loop () 1 1))

計算してみます.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (length (fib-list))
4782
> 

[Project Euler] Problem 24 「辞書式順列」

順列とはモノの順番付きの並びのことである. たとえば, 3124は数 1, 2, 3, 4 の一つの順列である. すべての順列を数の大小でまたは辞書式に並べたものを辞書順と呼ぶ. 0と1と2の順列を辞書順に並べると次のようになる.

012 021 102 120 201 210

0,1,2,3,4,5,6,7,8,9からなる順列を辞書式に並べたときの100万番目はいくつか?

力技で行きます.

1. 順列を求める.
2. 100万番目の要素を求める.

順列を求める過程でソートし, 辞書順になるようにしておきます. 手続きは次のようになります.

(require srfi/1)

;; リストから要素を一つ取り除く
(define (remove-one lst obj)
  (cond ((null? lst) ())
        ((equal? (car lst) obj) (cdr lst))
        (else (cons (car lst) (remove-one (cdr lst) obj)))))

;; 順列を求める
(define (permutation items)
  (if (null? items)
      '(())
      (apply append
             (map (lambda (item)
                    (map (lambda (p) (cons item p))
                         (permutation (remove-one items item))))
                  (sort items <)))))

(define ans (permutation '(0 1 2 3 4 5 6 7 8 9)))

計算します. メモリは２GB必要です.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (list-ref ans 999999)
(2 7 8 3 9 1 5 4 6 0)
> 

[Project Euler] Problem 23 「非過剰数和」

完全数とは, その数の真の約数の和がそれ自身と一致する数のことである. たとえば, 28の真の約数の和は, 1 + 2 + 4 + 7 + 14 = 28 であるので, 28は完全数である.

真の約数の和がその数よりも少ないものを不足数といい, 真の約数の和がその数よりも大きいものを過剰数と呼ぶ.

12は, 1 + 2 + 3 + 4 + 6 = 16 となるので, 最小の過剰数である. よって2つの過剰数の和で書ける最少の数は24である. 数学的な解析により, 28123より大きい任意の整数は2つの過剰数の和で書けることが知られている. 2つの過剰数の和で表せない最大の数がこの上限よりも小さいことは分かっているのだが, この上限を減らすことが出来ていない.

2つの過剰数の和で書き表せない正の整数の総和を求めよ.

この問題も, 約数を求められれば解けそうです.

1. 28123以下の過剰数をつくる.
2. 求めた過剰数のすべての組合せの和を求める.
3. 求めた和として表せない過剰数を取り出す.

手続きは次のとおりです.

(require srfi/1)

(define (square n) (* n n))

(define (divides? a b)
  (= (remainder b a) 0))

(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (+ test-divisor 1)))))

(define (smallest-divisor n)
  (find-divisor n 2))

;; 素因数分解
(define (prime-factorization n)
  (let ((a (smallest-divisor n)))
    (if (= a n)
        (list n)
        (cons a (prime-factorization (/ n a))))))

;; sizeの数の変数を持つ真理値表を作る
(define (0-1-table size)
  (define (loop ans n)
    (if (= n 0)
        ans
        (loop (append (map (lambda (lst) (cons #f lst)) ans)
                      (map (lambda (lst) (cons #t lst)) ans))
              (- n 1))))
  (loop '(()) size))

;; リストから集合を作る. つまり重複する要素を取り除く.
(define (make-set items)
  (define (loop ans rest)
    (cond ((null? rest) ans)
          ((find (lambda (a) (= (car rest) a)) ans) (loop ans (cdr rest)))
          (else (loop (cons (car rest) ans) (cdr rest)))))
  (loop '() items))

;; すべての約数を求める.
(define (all-divisor nbr)
  (let* ((pf (prime-factorization nbr))
         (tbl (0-1-table (length pf))))
    (sort 
     (make-set (map (lambda (row) 
                      (apply * (map (lambda (a b) (if a 1 b))
                                    row 
                                    pf)))
                    tbl))
     >)))
       
(define (product list-a list-b)
  (apply append
         (map (lambda (a)
                (map (lambda (b) (list a b))
                     list-b))
              list-a)))

(define (abundant? n)
  (< n (fold + 0 (cdr (all-divisor n)))))

;; 28123以下の過剰数をつくり、そのすべての組合せから和を求め、
;; その和に現れない数を求める。
(define ab-list (filter abundant? (iota 28123 1)))

(define v (make-vector 28124 #t))

(for-each (lambda (x)
            (for-each (lambda (y)
                        (when (< (+ x y) (vector-length v))
                          (vector-set! v (+ x y) #f)))
                      ab-list))
          ab-list)

(define (loop ans i)
  (cond ((<= (vector-length v) i) (reverse ans))
        ((vector-ref v i) (loop (cons i ans) (+ i 1)))
        (else (loop ans (+ i 1)))))

(define ans (loop '() 1))

計算します.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (fold + 0 ans)
4179871
>