Project Euler: Problem 11
In the 20x20 grid below, four numbers along a diagonal line have been marked in red.
08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08
49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00
81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65
52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91
22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80
24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50
32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70
67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21
24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72
21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95
78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92
16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57
86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58
19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40
04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66
88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69
04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36
20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16
20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54
01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48The product of these numbers is 26 x 63 x 78 x 14 = 1788696.
What is the greatest product of four adjacent numbers in any direction (up, down, left, right, or diagonally) in the 20x20 grid?
http://projecteuler.net/index.php?section=problems&id=11
20x20 のグリッドの中から縦横斜めに取り出した 4 つの数字の積のうち最大のもの求めよとのこと。
Gauche で書いてみた。最初はリストを使って繋げていこうかと思ったけど、せっかくなので Gauche.array の多次元配列を使ってグリッドを作ってみた。
#!/usr/bin/env gosh ;; Ruby で言うところの String#to_i 的なもの ;; string->number があるのに気づかず実装してた ;(define (string->integer s) ; (fold + 0 (map * ; (map (cut expt 10 <>) ; (iota 10 0)) ; acceptable places ; (reverse ; (map digit->integer ; (string->list s)))))) ;; キャンバスを初期化 (左下から (0, 0)) (define (gc-initialize xlen ylen) (make-array (shape 0 xlen 0 ylen) #f)) ;; キャンバスの x 軸の長さ (define (gc-horizontal-length gc) (array-length gc 0)) ;; キャンバスの y 軸の長さ (define (gc-vertical-length gc) (array-length gc 1)) ;; 指定されたピクセルを塗り潰す (define (gc-fill gc x y value) (array-set! gc x y value)) ;; 指定されたピクセルの値を返す (define (gc-ref gc x y) (array-ref gc x y)) ;; 指定された座標の間で線分を引く ;; * 引けなかったら #f を返す ;; * 引けたら通った座標のリストを返す (define (gc-drawline gc x_from y_from x_dest y_dest) (if (and (<= 0 x_from (- (gc-horizontal-length gc) 1)) (<= 0 y_from (- (gc-vertical-length gc) 1)) (<= 0 x_dest (- (gc-horizontal-length gc) 1)) (<= 0 y_dest (- (gc-vertical-length gc) 1))) (let [(diffx (abs (- x_from x_dest))) (diffy (abs (- y_from y_dest)))] (let [(dx (if (zero? diffy) (exact->inexact (/ 1 diffx)) (exact->inexact (/ diffx diffy)))) (dy (if (zero? diffx) (exact->inexact (/ 1 diffy)) (exact->inexact (/ diffy diffx))))] ;(print #`"(,x_from,, ,y_from) -> (,x_dest,, ,y_dest) (dx=,dx,, dy=,dy)") (let [(drawline (lambda (x_from y_from x_dest y_dest dx dy xtest ytest xinc yinc) (let loop [(x x_from) (y y_from) (l '())] (if (and (xtest x x_dest) (ytest y y_dest)) (loop (xinc x dx) (yinc y dy) (cons (cons (round->exact x) (round->exact y)) l)) (delete-duplicates l)))))] (cond [(and (= x_from x_dest) (= y_from y_dest)) (list (cons x_from y_from))] [(and (<= x_from x_dest) (<= y_from y_dest)) (drawline x_from y_from x_dest y_dest dx dy <= <= + +)] [(and (<= x_from x_dest) (> y_from y_dest)) (drawline x_from y_from x_dest y_dest dx dy <= > + -)] [(and (> x_from x_dest) (<= y_from y_dest)) (drawline x_from y_from x_dest y_dest dx dy > <= - +)] [(and (> x_from x_dest) (> y_from y_dest)) (drawline x_from y_from x_dest y_dest dx dy > > - -)] [else (error "!! BUG !!")])))) #f)) (define (gc-display gc) (display gc) (newline)) (use srfi-1) (use gauche.array) (define (main args) (define src (list "08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08" "49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00" "81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65" "52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91" "22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80" "24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50" "32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70" "67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21" "24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72" "21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95" "78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92" "16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57" "86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58" "19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40" "04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66" "88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69" "04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36" "20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16" "20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54" "01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48")) (let [(gc (gc-initialize 20 20)) (results '())] (let yloop [(y 0) (col (reverse src))] ; 左下の座標を (0, 0) にするために逆廻し (if (pair? col) (let xloop [(x 0) (row (string-split (car col) char-whitespace?))] (if (pair? row) [begin (gc-fill gc x y (string->number (car row))) ; キャンバスの値の初期化 (xloop (+ x 1) (cdr row))] (yloop (+ y 1) (cdr col)))))) (let xloop [(x 0)] (if (< x (gc-horizontal-length gc)) (let yloop [(y 0)] (if (< y (gc-vertical-length gc)) (let loop [(lines (list (gc-drawline gc x y (+ x 3) y) ; 0 degree (gc-drawline gc x y (+ x 3) (+ y 3)) ; 45 degrees (gc-drawline gc x y x (+ y 3)) ; 90 degrees (gc-drawline gc x y (- x 3) (+ y 3))))] ; 135 degrees (if (pair? lines) [begin (if (and (list? (car lines)) ; 線が引けたか? (= (length (car lines)) 4)) ; 引けた長さは 4 つ分か (set! results (cons (fold * 1 (map (lambda (p) (gc-ref gc (car p) (cdr p))) (car lines))) results))) (loop (cdr lines))] (yloop (+ y 1)))) (xloop (+ x 1)))))) (print (apply max results))) ; 最大値を表示して終了 0)
正直、もっと簡単に解く方法はいくらでもあったと思うけど、とりあえず動いたので良しとする。
