Project Euler 11番

euler011.clj

(ns euler.problem011
  (:require [clojure.string :as string]))

(defn parse-numbers
  [input]
  (for [line (->> (string/split-lines input)
                  (map #(re-seq #"\d+" %)))
        :when (not-empty line)]
    (map #(Long/parseLong %) line)))

(def zip (partial map list))

(defn zip-partition
  [n shift coll]
  (->> (partition n shift (repeat 0) coll)
       (apply zip)))

(defn count-short?
  [n coll]
  (> n (count coll)))

(defn slice-by
  [pred coll]
  (->> (partition-by pred coll)
       (remove (comp pred first))))

(defn solver*
  [n input]
  (let [grid (parse-numbers input)
        w (-> grid first count inc)
        nums-all (-> (mapcat #(cons 0 %) grid)
                     (concat (repeat w 0)))]
    (->> (concat grid
                 (apply zip grid)
                 (zip-partition w (inc w) nums-all)
                 (zip-partition w (dec w) nums-all))
         (mapcat (fn [line] (->> (slice-by zero? line)
                                 (remove #(count-short? n %)))))
         (mapcat #(partition n 1 %))
         (map #(apply * %))
         (apply max))))

(def solver (partial solver* 4))

(def 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")

(println (solver input))

@kohyama さんへ

ありがとうございます。
今回は一種の頭の体操で、zipとpartitionメインで使っていますが、そのために0を足したり引いたりのつじつま合わせが発生しています。シーケンス処理は無限の問題の方がシンプルですよね。

partition の「ズラシて切り取る性質」

を図を使って説明してみます．

例として 5x5 行列 grid を考えてみます．grid は各行を concat した一次元シーケンスで表現します．この grid を一行の長さである 5で partition すると，

user> (def grid (->> (range 11 61) (partition 10) (mapcat #(take 5 %))))
#'user/grid

user> (->> grid (partition 5) (map prn) dorun)
(11 12 13 14 15)
(21 22 23 24 25)
(31 32 33 34 35)
(41 42 43 44 45)
(51 52 53 54 55)
nil

のように 5x5 の行列になります．このとき縦の列の下一桁が同じ数になるように grid を調整しました．ちなみに (partition 5) は (partition 5 5) と同じ意味なので，この場合の step は一行の長さと同じ 5 です．

次に，step を一行の長さより 1 小さい 4 にして partition してみます．

user> (->> grid (partition 5 4) (map prn) dorun)
(11 12 13 14 15)
(15 21 22 23 24)
(24 25 31 32 33)
(33 34 35 41 42)
(42 43 44 45 51)
(51 52 53 54 55)
nil

このとき，縦の列を見ていくと，ちょうど元の 5x5 行列で右上から左下に向かう線になっていることがわかります．ただし 12->21, 25->34->43->52 のように，本来は別々の線であるのに右端と左端とでつながっている線が含まれてしまうので， @mnzk の解答では端に 0 を入れて後で切れるようにしています．

また，step を一行の長さより 1 短い 6 にして partition すると，

user> (->> grid (partition 5 6) (map prn) dorun)
(11 12 13 14 15)
(22 23 24 25 31)
(33 34 35 41 42)
(44 45 51 52 53)
nil

今度は縦の列は，元の 5x5 行列で左上から右下に向かう線になっています．つながっている線が含まれてしまうのも同様です．

説明終わり．

---

partition の padding 美味しいです．久しぶりに見ました．partition の step を使ってずらして線を引く方法は take-nth 使うより速そうですね．とくに行列のサイズが大きいときには差が大きそうです．

---

余談ですが，

実は最初read-stringでパースさせようと考えました。

(->> (string/split-lines input)
     (map #(read-string (str "[" % "]"))))

これならトークン切出しと数値への変換が一発でできると思ったのですが、ゼロで始まる数字は８進数と解釈され08,09がエラーになってしまいました。残念。

あるある

実は最初read-string で

私もやりました :-p)

slice-byという関数を作りました。
[...]
partition-byを使って実装していますが、ちょっと効率は悪いかもしれません。

pred に対して true となる coll の要素の割合が 1/2 から大きく離れていれば，それほど悪くない実装だと思います．で，1/2 に近い場合，slice-by がシーケンスを 2 回スキャンしているのを 1 回にすれば，数割速くなりそうだと思い書いたのがこの pred-split 関数です．

(defn- pred-split
  [pred coll]
  (if-let [s (->> coll (drop-while pred) seq)]
    (let [[fs others] (split-with (complement pred) s)]
      (lazy-seq (cons fs (falses-seq pred others))))))

で，

user> (def s (shuffle (range 1000000)))
#'user/s

user> (defn slice-by
          [pred coll]
        (->> (partition-by pred coll)
             (remove (comp pred first))))
#'user/slice-by

user> (time (count (slice-by even? s)))
"Elapsed time: 791.023 msecs"
250465

user> (time (count (pred-split even? s)))
"Elapsed time: 380.16 msecs"
250465

予想どおり速くなりましたが，関数の中身は slice-by のほうが分かりやすいので，実用上は slice-by のほうを道具箱に入れておくのが良さそうです．