#mitori_clj Project Euler Problem 11

problem_11.clj

(ns tnoda.projecteuler.problem-11
  [:require [clojure.string :as str]])

(def ^:private input "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")

(def ^:private grid {:width 20,
                     :numbers (->> (str/split input #"\s+")
                                   (map #(Long/parseLong %)))})

(defn- lines
  [w]
  (fn
    [s]
    (map #(take-nth % s) [1 (dec w) w (inc w)])))

(defn- fence
  [w nums]
  (->> (partition w nums)
       (interpose [0])
       (apply concat)))

(defn- muln
  [n]
  (fn
    [s]
    (if-let [nums (first (partition n s))]
      (apply * nums))))

(defn- solver*
  [{w :width nums :numbers}]
  (->> (fence w nums)
       (iterate next)
       (take-while seq)
       (mapcat (lines (inc w)))
       (keep (muln 4))
       (apply max)))

(def solver (partial solver* grid))

• http://www.zusaar.com/event/455057
• http://projecteuler.net/problem=11
• https://gist.github.com/4363494

考え方

take-nth を使います．

grid

入力のサイズが変わっても対応できるように，入力のグリッドを一行の幅 :width と，グリッドに含まれる数列 :numbers とで表現します．:numbers を :width で折り返してラスタスキャンするイメージです．

lines

数列 :numbers の n 番目の数について，一行の幅を w とすると，

• 横のラインは，
  • n, n+1, n+2, n+3, ... 番目
• 縦のラインは，
  • n, n+w, n+2w, n+3w, ... 番目
• 斜めのラインは，
  • n, n+(w-1), n+2(w-1), n+3(w-1), ... 番目
  • n, n+(w+1), n+2(w+1), n+3(w+1), ... 番目

の数ということになります．この形は take-nth で表現できます．lines は一行の幅 w を受け取り，数列が与えられたときに，数列の先頭から縦横斜めのラインを作る関数を返します．

fence

lines の方法ではグリッドに端があることを考慮していません．ちょうどグリッドを右端と左端をくっつけて円筒状にした形を考えてラインを引いています．これでは実際には引けない線も含まれてしまうので，右端と左端との間に 0 を入れて，端をまたぐ線の積が 0 になるようにします．

fence 関数は幅 w のグリッドの数列 nums を受けとり，グリッドの左端に 0 だけの列を，グリッドの下端に 0 だけの行を，それぞれくっつけた幅 w+1 のグリッドを返します．配列にマージンをつけ加えてコードをシンプルにする技法は何か名前がついていたような気がするのですが思いだせませなかったので，fence という名前にしました．

solver* 関数中ではこの fence を使って入力の幅を 1 大きくしているので，lines 関数を呼ぶときには幅を (inc w) としています．

muln

シーケンスを受けとり先頭から n 個の要素の積を返す関数を返します．シーケンスの長さが n 未満であれば nil を返します．この問題では n=4 固定なのですが気持ち汎用性を考えています．

solver*

で解き方なのですが，

• (fence w nums)
  • 入力グリッドを 0 でガードして
• (iterate next) (take-while seq)
  • 先頭からラスタスキャンして，
• (mapcat (lines (inc w))
  • 各点において線を引いて，
• (keep (muln 4))
  • 各線の先頭 4 つの積を求めて，
  • （ただし，長さが 4 未満の線は除外．）
• (apply max)
  • その中で最大のものを返す．

という関数を作っています．

速度

問題の入力 (20 x 20) で 10ms と，やはり全部遅延シーケンスだけあって遅いです．200 x 200 程度で 1 秒越えそうです．

おわりに

この solver* は今後も拡張しやすい形にすることも目指しました．この問題では「4 つの数の積」ですが，muln にこの長さを渡せるようにしているので，4 を可変にしたければ，solver* の引数に len を追加して，(muln 4) のところを (muln len) とすればできます．また積以外に和にも対応させたい場合には，muln の代わりに (calc n op) のように演算子 op を渡せるような関数を用意すればできます．その際には fence は 0 でガードするのではなく nil でガードすることになると思います．

あまり慣れないスタイルで書いているので，いろいろとおかしいところがあるかもしれません．コーディングスタイルやら値の命名やらで気になるところがありましたらご指摘よろしくお願いします．

---

Gist 移転時の更新

muln に渡す数列の長さが n 未満のときに nil を返すようにしました．これにより，fence でグリッドの底に 0 を敷く必要がなくなったので，fence 自体も cons を使ったものから interpose を使ったスッキリとしたものに変更しました．

lines はそもそも

(is (= ((lines 3) '(a b c
                    d e f
                    g h i))
       '((a b c , d e f g h i) ; right?
         (a     , c e g i)     ; left-down?
         (a d g)               ; down
         (a e i))))            ; right-down

(is (= ((lines 3) '(  b c
                    d e f
                    g h i))
       '((b c   , d e f g h i ) ; right?
         (b d   , f h)          ; left-down?
         (b e h)                ; down
         (b f  ))))             ; right-down

のような使われ方を想定して書き , で示した箇所で枠を飛び出して反対側から出て来てしまうので lines は変えずに入力の方を fence で変形して,

(is (= ((lines 4) '(a b c
                  0 d e f
                  0 g h i))
       '((a b c 0 d e f 0 g h i) ; right
         (a     0 f h)           ; left-down
         (a d g)                 ; down
         (a e i))))              ; right-down

(is (= ((lines 4) '(  b c
                  0 d e f
                  0 g h i))
       '((b c   0 d e f 0 g h i ) ; right
         (b d   0 i)              ; left-down
         (b e h)                ; down
         (b f  ))))             ; right-down

のようにして, 枠を越えて積を取ると 0 になるようにして, 使うことにしたってことですよね.

最初読んだときは, 誤解していて, 自分の解法に似てると思ったんですが, ちゃんと読んだら全然違いました.
ユニークな解法でとても参考になります.

コードだけからだと lines と fence が何のために何をするのか分かりにくいので, 上記のようなテストを付けるといいかなと思いました.

lines と muln が計算をしてしまわず, 計算する関数を返すのが, 定義を読んでるときは不思議だったのですが ->> で呼び出されているところを見て納得. すっきりしますね.

コードだけからだと lines と fence が何のために何をするのか分かりにくいので, 上記のようなテストを付けるといいかなと思いました.

おっしゃるように，例が無いと一目で何をしている関数なのか分かりにくいです > lines, fence

@kohyama の指摘どおり，きちんとテストを書くべきなのですが，Project Euler だとついつい手抜きしてしまいます．ごめんなさい．

本来ならテストと言わず docstring に利用例を書いておくほうが利用者に優しいライブラリになるのですが，この例を自動で抽出してテストできれば，テストを書く手間が省けて一石二鳥になります．どなたか，Python にある doctest の Clojure 版をご存知の方いらっしゃいませんか? あれば使ってみたいです．

どなたか，Python にある doctest の Clojure 版をご存知の方いらっしゃいませんか? あれば使ってみたいです．

と思って探していたら with-test を見つけました．