プロジェクト

全般

プロフィール

Problem 8 » 履歴 » バージョン 8

Noppi, 2024/01/02 04:22

1 1 Noppi
[ホーム](https://redmine.noppi.jp) - [[Wiki|Project Euler]]
2
# [[Problem 8]]
3
4 4 Noppi
## Largest Product in a Series
5
The four adjacent digits in the $1000$-digit number that have the greatest product are $9 \times 9 \times 8 \times 9 = 5832$.
6
```
7
73167176531330624919225119674426574742355349194934
8
96983520312774506326239578318016984801869478851843
9
85861560789112949495459501737958331952853208805511
10
12540698747158523863050715693290963295227443043557
11
66896648950445244523161731856403098711121722383113
12
62229893423380308135336276614282806444486645238749
13
30358907296290491560440772390713810515859307960866
14
70172427121883998797908792274921901699720888093776
15
65727333001053367881220235421809751254540594752243
16
52584907711670556013604839586446706324415722155397
17
53697817977846174064955149290862569321978468622482
18
83972241375657056057490261407972968652414535100474
19
82166370484403199890008895243450658541227588666881
20
16427171479924442928230863465674813919123162824586
21
17866458359124566529476545682848912883142607690042
22
24219022671055626321111109370544217506941658960408
23
07198403850962455444362981230987879927244284909188
24
84580156166097919133875499200524063689912560717606
25
05886116467109405077541002256983155200055935729725
26
71636269561882670428252483600823257530420752963450
27
```
28
Find the thirteen adjacent digits in the $1000$-digit number that have the greatest product. What is the value of this product?
29
30
## 数字列中の最大の積
31
次の1000桁の数字のうち, 隣接する4つの数字の総乗の中で, 最大となる値は, 9 × 9 × 8 × 9 = 5832である.
32
```
33
73167176531330624919225119674426574742355349194934
34
96983520312774506326239578318016984801869478851843
35
85861560789112949495459501737958331952853208805511
36
12540698747158523863050715693290963295227443043557
37
66896648950445244523161731856403098711121722383113
38
62229893423380308135336276614282806444486645238749
39
30358907296290491560440772390713810515859307960866
40
70172427121883998797908792274921901699720888093776
41
65727333001053367881220235421809751254540594752243
42
52584907711670556013604839586446706324415722155397
43
53697817977846174064955149290862569321978468622482
44
83972241375657056057490261407972968652414535100474
45
82166370484403199890008895243450658541227588666881
46
16427171479924442928230863465674813919123162824586
47
17866458359124566529476545682848912883142607690042
48
24219022671055626321111109370544217506941658960408
49
07198403850962455444362981230987879927244284909188
50
84580156166097919133875499200524063689912560717606
51
05886116467109405077541002256983155200055935729725
52
71636269561882670428252483600823257530420752963450
53
```
54
この1000桁の数字から13個の連続する数字を取り出して, それらの総乗を計算する. では、それら総乗のうち、最大となる値はいくらか.
55
EX 6桁の数123789から5個の連続する数字を取り出す場合, 1*2*3*7*8と2*3*7*8*9の二通りとなり, 後者の2*3*7*8*9=3024が最大の総乗となる.
56
57 1 Noppi
```scheme
58
#!r6rs
59
#!chezscheme
60
61
(import (chezscheme))
62
63 6 Noppi
(define p8-number-string
64 1 Noppi
  (string-append "73167176531330624919225119674426574742355349194934"
65
                 "96983520312774506326239578318016984801869478851843"
66
                 "85861560789112949495459501737958331952853208805511"
67
                 "12540698747158523863050715693290963295227443043557"
68
                 "66896648950445244523161731856403098711121722383113"
69
                 "62229893423380308135336276614282806444486645238749"
70
                 "30358907296290491560440772390713810515859307960866"
71
                 "70172427121883998797908792274921901699720888093776"
72
                 "65727333001053367881220235421809751254540594752243"
73
                 "52584907711670556013604839586446706324415722155397"
74
                 "53697817977846174064955149290862569321978468622482"
75
                 "83972241375657056057490261407972968652414535100474"
76
                 "82166370484403199890008895243450658541227588666881"
77
                 "16427171479924442928230863465674813919123162824586"
78
                 "17866458359124566529476545682848912883142607690042"
79
                 "24219022671055626321111109370544217506941658960408"
80
                 "07198403850962455444362981230987879927244284909188"
81
                 "84580156166097919133875499200524063689912560717606"
82
                 "05886116467109405077541002256983155200055935729725"
83
                 "71636269561882670428252483600823257530420752963450"))
84
85 6 Noppi
(define erase-zero-range-vector
86
  (let* ([work (list->vector (string->list p8-number-string))]
87
         [work-length (vector-length work)])
88
    (letrec ([skip-zero-range (lambda (pos)
89
                                (cond
90
                                  ; 終端まで到達したら結果を返す
91
                                  [(<= work-length pos) work]
92
                                  ; ゼロが見つかったら
93
                                  ; 左と右をそれぞれ12文字埋める
94
                                  [(char=? (vector-ref work pos) #\0)
95
                                   (erase-left (sub1 pos))
96
                                   (erase-right (add1 pos))]
97
                                  ; ゼロ以外なら次の文字を探す
98
                                  [else (skip-zero-range (add1 pos))]))] 
99
             [erase-left (lambda (pos)
100
                           (let loop ([i 0])
101
                             (let ([current-pos (- pos i)])
102
                               (cond
103
                                 ; 先頭まで到達したら終了
104
                                 [(negative? current-pos) void]
105
                                 ; ゼロ含めて13文字埋めたら終了
106
                                 [(<= 12 i) void]
107
                                 ; #fでなかったら#fで埋めてさらに左を調べる
108
                                 [(vector-ref work current-pos)
109
                                  (vector-set! work current-pos #f)
110
                                  (loop (add1 i))]
111
                                 ; #fまで到達したら終了
112
                                 [else void]))))]
113
             [erase-right (lambda (pos)
114
                            (let loop ([i 0])
115
                              (let ([current-pos (+ pos i)])
116
                                (cond
117
                                  ; 終端まで到達したら結果を返す
118
                                  [(<= work-length current-pos) work]
119
                                  ; ゼロ含めて13文字埋めたので次の文字を探す
120
                                  [(<= 12 i) (skip-zero-range (add1 current-pos))]
121
                                  ; ゼロが見つかったらそこからさらに13文字埋める
122
                                  [(char=? (vector-ref work current-pos) #\0)
123
                                   (erase-right (add1 current-pos))]
124
                                  ; ゼロでなかったら#fで埋めてさらに右を調べる
125
                                  [else
126
                                    (vector-set! work current-pos #f)
127
                                    (loop (add1 i))]))))])
128
      (skip-zero-range 0))))
129 1 Noppi
130 6 Noppi
(define rest-substring-pos
131
  (let ([work-length (vector-length erase-zero-range-vector)])
132 8 Noppi
    (letrec ([skip-char (lambda (pos result)
133 6 Noppi
                          (if (<= work-length pos)
134 7 Noppi
                            ; 終端まで到達したら結果を返す
135 8 Noppi
                            result
136 6 Noppi
                            (let ([current-char (vector-ref erase-zero-range-vector pos)])
137
                              (case current-char
138 7 Noppi
                                ; #fまたは'0'なら次の文字をチェック
139 8 Noppi
                                [(#f #\0) (skip-char (add1 pos) result)]
140 6 Noppi
                                ; 有効な数字なら最初の位置を記憶して末尾の数字を探す
141 8 Noppi
                                [else (valid-char (add1 pos) pos result)]))))]
142
             [valid-char (lambda (pos start-pos result)
143 6 Noppi
                           ; 終端まで到達したらそれまでの数字の位置を結果に詰め込んで返す
144
                           (if (<= work-length pos)
145 8 Noppi
                             (cons (cons start-pos (sub1 pos)) result)
146 6 Noppi
                             (let ([current-char (vector-ref erase-zero-range-vector pos)])
147
                               (case current-char
148 1 Noppi
                                 ; #fまたは'0'だったらそれまでの数字の位置を結果に詰め込んで
149 7 Noppi
                                 ; 次に有効な数字までスキップする
150 6 Noppi
                                 [(#f #\0)
151
                                  (skip-char (add1 pos)
152
                                             (cons (cons start-pos (sub1 pos))
153 8 Noppi
                                                   result))]
154 7 Noppi
                                 ; 有効な数字なら末尾の数字を探す為に次の数字を調べる
155 6 Noppi
                                 [else (valid-char (add1 pos)
156
                                                   start-pos
157 8 Noppi
                                                   result)]))))])
158 6 Noppi
      (skip-char 0 '()))))
159
160 7 Noppi
;; 有効な数字の左右12文字分伸ばす
161 6 Noppi
(define valid-substring-pos
162
  (let ([p8-string-length (string-length p8-number-string)])
163
    (map
164
      (lambda (cell)
165
        (cons (max 0 (- (car cell) 12))
166
              (min (sub1 p8-string-length) (+ (cdr cell) 12))))
167
      rest-substring-pos)))
168 1 Noppi
169
(define valid-substrings
170 6 Noppi
  (map
171
    (lambda (cell)
172
      (substring p8-number-string
173
                 (car cell)
174
                 (add1 (cdr cell))))
175
    valid-substring-pos))
176
177
(define 13-length-strings
178 8 Noppi
  (fold-left
179
    (lambda (result substrings)
180
      (let ([end-pos (- (string-length substrings) 13)])
181
        (let loop ([i 0] [result result])
182
          (if (< end-pos i)
183
            result
184
            (loop (add1 i)
185
                  (cons (substring substrings i (+ i 13))
186
                        result))))))
187
    '()
188
    valid-substrings))
189 6 Noppi
190
(define number-lists
191
  (map
192
    (lambda (substrings)
193
      (map
194
        (lambda (char)
195
          (char- char #\0))
196
        (string->list substrings)))
197
    13-length-strings))
198
199
(define product-nums
200
  (map
201
    (lambda (lis) (apply * lis))
202
    number-lists))
203
204 5 Noppi
(define answer-8
205 6 Noppi
  (apply max product-nums))
206 1 Noppi
207
(printf "8: ~D~%" answer-8)
208
```