Project Euler Problem 11
問題11: 提示された20x20の数方陣において縦横斜め連続する4つの数字の積で最大のものを求めよ。[=>問題文]
一見、問題8と似てるようにも思えますが、うまい解法が思いつかなかったのでしらみつぶしで調べることにしました。まずはデータの事前加工。
二次元 vector 作成
(defvar *field*) (setq *field* (let ((parse-line (lambda (line) (mapcar #'string-to-number (split-string line))))) (vconcat (mapcar #'vconcat (mapcar parse-line '("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"))))))
(mapcar parse-line ...) で「文字列20行」を「数値リスト20個」に変換し、(mapcar #'vconcat ...) で「数値リスト20個」を「20個のvector」に変換。その「20個のvector」を、一つの大きな vector の中に格納して、二次元 vector の出来上がり。*field* という名前に束縛しておきます。
追記：ソースに直接書くんだったら、初めから[ ] に入れてベクタにすればいいですね。無駄なことやってた。
問題11の解答
ちょっといつもと違った書き方で。
(require 'cl) (defun problem011 (field) (let* ((N 4) (v-len (length field)) (h-len (length (aref field 0))) (v-last (1- v-len)) (h-last (1- h-len)) (field-ref (lambda (x y) (aref (aref field y) x))) (helper* (lambda (x y next &optional lis) (if (= N (length lis)) (apply #'* lis) (let ((n (funcall field-ref x y))) (multiple-value-bind (x y) (funcall next x y) (funcall helper* x y next (cons n lis))))))) (horiz* (lambda (x y) (funcall helper* x y (lambda (x y) (values (1+ x) y))))) (vert* (lambda (x y) (funcall helper* x y (lambda (x y) (values x (1+ y)))))) (diago1* (lambda (x y) (funcall helper* x y (lambda (x y) (values (1+ x) (1+ y)))))) (diago2* (lambda (x y) (funcall helper* x y (lambda (x y) (values (1- x) (1+ y)))))) (next-pos (lambda (x y) (if (zerop x) (if (zerop y) (values -1 0) (values h-last (1- y))) (values (1- x) y)))) (main-loop (lambda (x y) (let* ((h-valid (<= N (- h-len x))) (v-valid (<= N (- v-len y))) (d1-valid (and h-valid v-valid)) (d2-valid (and v-valid (<= (1- N) x)))) (max (if h-valid (funcall horiz* x y) 0) (if v-valid (funcall vert* x y) 0) (if d1-valid (funcall diago1* x y) 0) (if d2-valid (funcall diago2* x y) 0) (multiple-value-bind (x y) (funcall next-pos x y) (if (> 0 x) 0 (funcall main-loop x y)))))))) (funcall main-loop (- h-len N) v-last)))
horiz* vert* diago1* diago2* は皆 4つ並びの数字の積を計算する関数(lambda)で、それぞれ水平右方向、垂直下方向、右下がり斜め方向、左下がり斜め方向の計算を担当します。これらの共通ロジックは helper* に切り出してあります。
main-loop は、現在座標 x,y を field 上で移動させながら 4つの「積計算関数」を呼び出します。main-loop も再帰によってループ処理を行っていて、「再帰呼び出し先」と「4つの積計算関数」合わせて 5つの評価値の max を取得し、「再帰呼び出し元」へと返しています。これを再帰的に行うことですべての積計算値の最大値を取得します。
端に近い座標では field からはみ出し 4つの数字が得られない場合がありますので、その判定をmain-loopの最初に行っています。はみ出す場合は「積計算関数」を評価せず強制的に値 0 としています。
座標更新は next-pos 関数で行います。field の右下から左上へ向かって走査し、最後まで移動した後コールすると x に -1 を返すのでそこでループは終了になります。
座標を戻り値とする next-pos や next は多値の絶好の使いどころになっています。
プログラムの実行
(setq max-lisp-eval-depth 10000) (setq max-specpdl-size 10000) (problem011 *field*)
おそらくデフォルト状態で実行するとエラーが発生します。max-lisp-eval-depth (再帰深度)、max-specpdl-size (局所変数の束縛数(?) )の 2変数の値を増やすことで実行できるようになります。
Emacs Lisp の局所関数
すべての局所関数を let フォームで局所変数に束縛してわざわざ funcall で呼び出しているのには訳があります。Emacs Lisp では、関数定義の内部で defun による局所関数を作ろうとしても作ることができません。関数内で関数定義はできますがその関数はグローバルスコープに作られてしまうようです。既に同名のグローバル関数があれば、後から評価された関数内定義関数で上書きされてしまいます。これはちょっと厄介な仕様です。そこで実験的に作ってみたのが今回のプログラムですが、どうやらうまくいったようです。
追記
別に defun が 局所関数を作らないのは Emacs Lisp 特有の仕様というわけではありませんでした。Common Lisp でも同じでした。Common Lispには局所関数を作る labels というフォームがあり、Emacs Lisp にも同様に labels がありました。
labels で書き直したバージョンも書いておきます。
(defun problem011-2 (field) (let* ((N 4) (v-len (length field)) (h-len (length (aref field 0))) (v-last (1- v-len)) (h-last (1- h-len))) (labels ((field-ref (x y) (aref (aref field y) x)) (helper* (x y next &optional lis) (if (= N (length lis)) (apply #'* lis) (let ((n (field-ref x y))) (multiple-value-bind (x y) (funcall next x y) (helper* x y next (cons n lis)))))) (horiz* (x y) (helper* x y (lambda (x y) (values (1+ x) y)))) (vert* (x y) (helper* x y (lambda (x y) (values x (1+ y))))) (diago1* (x y) (helper* x y (lambda (x y) (values (1+ x) (1+ y))))) (diago2* (x y) (helper* x y (lambda (x y) (values (1- x) (1+ y))))) (next-pos (x y) (if (zerop x) (if (zerop y) (values -1 0) (values h-last (1- y))) (values (1- x) y))) (main-loop (x y) (let* ((h-valid (<= N (- h-len x))) (v-valid (<= N (- v-len y))) (d1-valid (and h-valid v-valid)) (d2-valid (and v-valid (<= (1- N) x)))) (max (if h-valid (horiz* x y) 0) (if v-valid (vert* x y) 0) (if d1-valid (diago1* x y) 0) (if d2-valid (diago2* x y) 0) (multiple-value-bind (x y) (next-pos x y) (if (> 0 x) 0 (main-loop x y))))))) (main-loop (- h-len N) v-last))))
