問題をどんな風に解いているのかということを、結果だけでなく途中経過もつらつらと書いてみたら おもしろいのではないかと思って、やってみることにしました。
何はともあれ問題を読みます。
" CAREの各文字に1、2、9、6を割り当てると、並べた1296は二乗数(36の二乗)になっている。CAREのアナグラムのRACEで作った数 9216も同様に二乗数(96の二乗)になっている。このようなペアを与えられた単語から探して、最大の数を答えよ。" というような問題です。
ちょっと考えて、以下のような方針で行くことにします。
- 単語一覧からアナグラムの組を見つける処理を作る。
- 二乗数の一覧を作る。桁で分類しておくといいかも。
- アナグラムの組と二乗数でマッチングさせる。 ここが肝なのだけれど、どうすべきかは後で考える。
Project Eulerを解くときは、問題ごとに環境を作ったりはしていなくて、以前書いたとおり、共通の場所に書いてます。
問題によっては大きくなってしまったりするので、別ファイルにしたり、プロジェクトを作ることもあります。
基本の環境はemacs + nrepl で、pareditとauto-complete、eldocを使っています。 ritsは入れてはみたものの、あまり使わなかったので普段は外しています。
考えながら造ります。
作るときは、nrepl-jack-inでREPLを立ち上げて、細かく動作確認しながら進めていきます。
サイトの問題を見てみると、単語が「"」でくくられて「,」区切りで並んだ長い文字列になっています。slurpで一気に読み込んで、splitして単語を取得することにします。
(defn pe98-word-list []
(let [data (slurp "http://projecteuler.net/project/words.txt")]
(clojure.string/split data #"\"?,?\"")))書いたら、C-x C-eなどとしてREPLに読み込ませて実行してみます。結果が長いリストになるはずなので、先頭をいくつかだけ見てみます。
user> (take 3 (pe98-word-list :a))
;-> ("" "A" "ABILITY")
空白文字列が先頭にあります。 たぶん、末尾にもあるはずです。取り除きます。
(defn pe98-word-list []
(let [data (slurp "http://projecteuler.net/project/words.txt")]
(filter #(not= "" %) (clojure.string/split data #"\"?,?\""))))user> (take 3 (pe98-word-list))
;->("A" "ABILITY" "ABLE")
OKです。リストが取れたので、後で使うために、取っておきます。
user> (def d1 (pe98-word-list))
;#'user/d1
次に、これをアナグラムで分類するわけですが、アナグラムというのは「同じ文字を同じだけ含んだ単語」ということですから、単語を構成する文字の昇順リストを取ると、アナグラムは同じリストを持つことになります。
CARE :-> ('A' 'C' 'E' 'R)
RACE :-> ('A' 'C' 'E' 'R)
ということで、単語を構成文字のリストをキーとしたmapに入れることにします。値は複数の単語が入るわけですから、vectorにします。
(defn create-group [word-list]
(reduce (fn [acc-map val]
(let [k (sort (seq val))]
(assoc acc-map k (conj (get acc-map k []) val))))
{} word-list))reduceを使って、単語をmapに入れていきます。キーの構成文字リストは(sort (seq val))で作ります。seqは不要だったかもしれません。
user> (take 3 (create-group d1))
;->([(\A) ["A"]] [(\A \D \D) ["ADD"]] [(\A \E \E \P \P \R \R) ["PREPARE"]])
いけてそうです。
ここで使っているgetとassocを使ったmapの更新処理はよく出てくる処理なのですが、更新にはupdate-inという関数もあります。使いかたをいつも忘れてしまうので、ついわかるやりかたをしてしまうのですが、調べて作りなおしてみました。
(defn create-group [word-list]
(reduce (fn [acc-map val]
(update-in acc-map [(sort (seq val))] (fnil conj []) val))
{} word-list))fnilを使うところがミソでしょうか。ここのところがいつもわからなくなってしまいます。キーの出現が1回になるので、letが不要になってちょっとすっきりします。
さて、できたデータの中で必要なものは、値に2つ以上の単語が入っているものです。ちょっと見てみます。
user> (take 5 (filter #(> (count (second %)) 1) (create-group d1)))
;->([(\N \O) ["NO" "ON"]] [(\O \P \S \T) ["POST" "SPOT" "STOP"]] [(\E \F \M \O \R \R) ["FORMER" "REFORM"]] [(\E \F \I \L) ["FILE" "LIFE"]] [(\A \B \D \O \R) ["BOARD" "BROAD"]])
ありますね。関数にしておきます。
(defn select-multi [word-map]
(into {} (filter #(>= (count (second %)) 2) word-map)))これで第一段階の単語データの生成はできました。上にある"ON"と"NO"のように回文(逆順)のものは対象外なのですが、2つ以上ある場合を考えて、そのままにしておきます。
今後の処理の目安に、まず数を数えてみます。
user> (count (select-multi (create-group d1)))
;->42
42個です。42って、偶然ですかね。
一番文字数の長いやつは何文字でしょう。
user> (apply max (map count (keys (select-multi (create-group d1)))))
:->9
9文字でした。
一応、処理をまとめておきます。
(defn get-word-data []
(-> (pe98-word-list)
(create-group)
(select-multi)))※ この先をやっているときに、問題に4桁の例が出ているのだから、それ以下は不要だということに 気付きました。なので、関数をちょっと修正しています。
(defn pe98-word-list []
(let [data (slurp "D:/userdata/q3197c/Desktop/words.txt")]
(filter #(>= (count %) 4) (clojure.string/split data #"\"?,?\""))))これは簡単です。
とりあえず、1から順に作ってみます。
(defn square-num-list [n]
(take-while #(< % (math/expt 10 n)) (map #(* % %) (iterate inc 1))))最後まで作るのにそこそこ時間がかかりました。それに、問題は最大のものを見つけるというものなので、 小さいものは不要です。最大文字数も分っているので、大きな方から作ることにしました。
(defn square-num-list [n]
(map #(* % %) (range (int (math/sqrt (math/expt 10 n))) 1 -1)))user> (take 3 (square-num-list 9))
:->(999950884 999887641 999824400)
さて、この先これをどう加工しようかと考えたのですが、それはこの後の処理に依存するので、 ここはこれで終りにして、マッチングのロジックを考えることにしました。
候補の数は二乗数の方が圧倒的に多いので、単語の方から攻めていくのが常套手段ですが、単語から数字を作っていくと逆に組み合わせが爆発しそうなので、二乗数を大きいほうから順に調べていくという方式でやることにします。
- ある二乗数があてはまる文字列があるかどうかチェック
- あれば、あてはめた文字列のペアで作った数が二乗数かどうか確認する
- 最初にあてはめる方法は複数あるはずなので、すべての場合について確認する。
です。
さて、「あてはまる」をうまく表現できるでしょうか。
BAKEは1234にも2468にも9876にもあてはまります。BOOKは1223にも9887にも6882にもあてはまります。
これをこのままどう実装するのかちょっと見当が付きません。すでに単語の方は、文字に分解してソートしてある状態なので、
それを使うことを考えます。
思い付いたのは、順番は無視して「何種類の数字/文字が何個ずつあるか」で判定する方法です。 BAKEは4種類が1つずつ、BOOKは3種類がそれぞれ1つと2つと1つです。この情報をtaxisと呼ぶことにしします。
こんな関数です。
(defn taxis [s]
(sort (map count (partition-by identity (sort s)))))user> (taxis '(9 9 9 9 5 0 8 8 4))
;->(1 1 1 2 4)
このように999950884は、なんらかの数字が1つ、1つ、1つ、2つ、4つでできているものということを表わしています。
二乗数にこれを順に適用して、同じtaxisを持つ文字列を探します。
数をリストにする関数をつくります。
(defn num-to-list [num]
(map #(Character/digit % 10) (str num)))user> (take 5 (map num-to-list (square-num-list 9)))
;->((9 9 9 9 5 0 8 8 4) (9 9 9 8 8 7 6 4 1) (9 9 9 8 2 4 4 0 0) (9 9 9 7 6 1 1 6 1) (9 9 9 6 9 7 9 2 4))
ここで実際のところどうなのか調べてみることにします。 今後の進めかたのヒントが出るかもしれません。
(def word-keys (keys (get-word-data)))
(def word-taxis (map taxis word-keys))
user> (->> (square-num-list 9)
(map num-to-list ,,)
(filter (fn [num]
(some (fn [word] (= (taxis num)
word)) word-taxis)) ,,)
(first ,,))
:->(9 2 3 1 8 7 4 5 6)
ありますね。9桁の数です。単語の方で9桁なのは、1ペアしかなくて、"INTRODUCE" と "REDUCTION" です。
"INTRODUCE"が923187456だとすると、"REDUCTION"は、167453982です。これは二乗数ではありません。
"REDUCTION"が923187456だとすると、"INTRODUCE"は、467953182です。これも二乗数ではありません。
ということで923187456はだめ。
こんな感じでやればよさそうです。これで進めましょう。
さて、二乗数のtaxisから値が引っかかったとき、上では目で探しましたが、そのtaxisを持つ単語を見つける必要があります。 そのために、taxisと単語リストのマップを作ります。
(defn word-taxis-group [word-data]
(reduce (fn [acc-map val]
(update-in acc-map [(taxis val)] (fnil conj []) val))
{} (keys word-data)))user> (word-taxis-group (get-word-data))
;-> {(1 1 1 1 1 1 1 1 1) [(\C \D \E \I \N \O \R \T \U)], (1 1 1 1 1 1 1 1) [(\A \C \E \I \N \O \R \T)], ...
値にある文字のリストは、単語のmapのキーになっているので、これをキーにすると単語を取り出すことができます。
この先もいくつか関数が要りそうですが、実現方法は処理に依存するのでわかりません。なので、とりあえず解答処理を作りはじめてしまいます。
(def pe98 []
(let [square-nums (map num-to-list (square-num-list 9))
word-data (get-word-data)
word-taxis (word-taxis-group word-data)]
;; Check procedure
))必要なデータはletにあるやつだけです。
処理の本体は、square-numsを順に調べて、そのtaxisがword-taxisにあれば、単語をword-dataから取ってきて数字をあてはめて、他の単語が二乗数になっているかどうかチェック。なっていたら終り。なっていなければ次。という感じ。
総当たりなので、forでやるかloopでやる感じですけど、mapでやりますか。「なっていたら終り」のところを、見付けた最初だけ取るというふうにすればいいかな。
(def pe98 []
(let [square-nums (map num-to-list (square-num-list 9))
word-data (get-word-data)]
(first (keep (map #(check-anagram % word-data) square-nums)))))こんなイメージになります。書いている途中で、word-taxisはここでは使わないことが分ったので、作る関数に入れてしまうことにしました。
ということで、check-anagram関数-ある数値のtaxisがwordのtaxisにあれば、単語をword-dataから取ってきて数字をあてはめて、他の単語が二乗数になっているかどうかチェックして、なっていたらその数値を返して、なっていなければnilを返す関数-を作りましょう。
(defn square-num? [n]
(integer? (math/sqrt n)))
(defn check-anagram [numl word-data]
(if-let [word-keys (get (word-taxis-map word-data) (taxis numl))]
(keep #(have-anagram numl (get word-data %) square-num?) word-keys)))
(defn one-and-rest [s]
(for [one s]
(vector one (remove #(= one %) s))))
(defn have-anagram [numl words check-fn]
(loop [check-list (one-and-rest words)]
(if (seq check-list)
(let [[tgt wordl] (first check-list)
char-map (zipmap tgt numl)
str-to-num (fn [st] (->> (map #(get char-map %) st)
(apply str ,,)
(Integer/parseInt ,,)))]
(if (some true? (map #(check-fn (str-to-num %)) wordl))
numl
(recur (next check-list)))))))check-anagramの方は、numlのtaxis(taxis numl)がword-dataのtaxis(word-taxis-map word-data)にあれば、単語キーのリスト(word-keys)を取ってきます。単語キーリストには、複数のキーが入っていますので、それらすべてについて単語のペアをword-dataから取ってきて(get word-data word-keys)、アナグラムになっているかどうか調べます。
アナグラムになっているかどうか調べるところが複雑になりそうだったので、関数を分けましたhave-anagram。
have-anagramはこのように動きます。
この場合、1296は、CAREに当てはめるとRACEが9216でこれが二乗数になるので数値が返り、RACEを無くすと、二乗数になるものが無いのでnilが返ります。
;; have-anagram [numl words check-fn]
user> (have-anagram [1 2 9 6] ["CARE" "ERAC" "RACE"] square-num?)
;->[1 2 9 6]
user> (have-anagram [1 2 9 6] ["CARE" "ERAC" "ERAC"] square-num?)
;->nil
user> (have-anagram [9 2 1 6] ["CARE" "ERAC" "RACE"] square-num?)
;->[9 2 1 6]
この単語リスト["CARE" "ERAC" "RACE"]などは適当です。
やっていることは、単語リストのどれかにnumlの数を割り当てて、のこりの単語を数字にしたとき、その数字がcheck-fnでtrueになるかどうかの確認です。
単語リストのどれかと残りを作るのが、one-and-restです。
user> (one-and-rest ["CARE" "ERAC" "RACE"])
;->(["CARE" ("ERAC" "RACE")] ["ERAC" ("CARE" "RACE")] ["RACE" ("CARE" "ERAC")])
これを順にループでチェックします。
["CARE" ("ERAC" "RACE")]を例にすると、tgt = "CARE" で wordl = ("ERAC" "RACE") になります。"CARE"のそれぞれの文字を、[1 2 9 6]にあてはめて他の単語を数字にしたいので、mapを作ります。
;char-map (zipmap tgt numl)
user> (zipmap "CARE" [1 2 9 6] ) ;->{\E 6, \R 9, \A 2, \C 1}
これをつかって、単語を数字にする関数を内部定義します。
str-to-num (fn [st] (->> (map #(get char-map %) st) ;; "RACE" -> (9 2 1 6)
(apply str ,,) ;; (9 2 1 6) -> "9216"
(Integer/parseInt ,,))) ;; "9216" -> 9216
処理本体で、wordl全体に適用して、check-fnがtrueになるものがあるかどうかで判定します。
判定は動きそうなので、check-anagramを動かしてみます。
user> (check-anagram [1 2 9 6] (get-word-data))
;->([1 2 9 6] [1 2 9 6] [1 2 9 6] [1 2 9 6] [1 2 9 6])
行けました。意外にたくさんあります。
出力されるのがもとの数字なのはつまらないので、単語も出すようにしておきます。
(defn have-anagram [numl words check-fn]
(loop [check-list (one-and-rest words)]
(if (seq check-list)
(let [[tgt wordl] (first check-list)
char-map (zipmap tgt numl)
str-to-num (fn [st] (->> (map #(get char-map %) st)
(apply str ,,)
(Integer/parseInt ,,)) )]
(if (some true? (map #(check-fn (str-to-num %)) wordl))
[numl tgt wordl] ; here!
(recur (next check-list)))))))user> (have-anagram [9 2 1 6] ["CARE" "ERAC" "RACE"] square-num?)
;->[[9 2 1 6] "CARE" ("ERAC" "RACE")]
現状のcheck-anagramの出力は、
user> (check-anagram [1 2 9 6] (get-word-data))
;->([[1 2 9 6] "SPOT" ("POST" "STOP")] [[1 2 9 6] "FILE" ("LIFE")] [[1 2 9 6] "SEAT" ("EAST")] [[1 2 9 6] "NOTE" ("TONE")] [[1 2 9 6] "CARE" ("RACE")])
のようになってます。ちゃんと'["CARE" ("RACE")]'が入っています。よさそうなのですが、ちょっと問題があります。 この関数の返り値に2つあることが分りまして、
user> (check-anagram [4 4 4 4] (get-word-data))
;->nil
と user> (check-anagram [1 2 3 4] (get-word-data)) ;->() です。
与えられた数字と同じtaxisを持つ単語が無ければ、if-letのところでnilになるのですが、if-let内で該当するものがなかったときに()になってしまいます。このままではpe98とI/Fが合いません。どうしましょう。
関数内で一度何かに受けて判定すればいいのですが、ちょっと癪に障ります。 pe98を書き変えてみます。
(def pe98 []
(let [square-nums (map num-to-list (square-num-list 9))
word-data (get-word-data)]
(first (filter (complement empty?) (map #(check-anagram % word-data) square-nums)))))ちょっと長いので、threadingマクロに変えます。桁数も指定できるようにしてみました。
(def pe98 [len]
(->> (map num-to-list (square-num-list len))
(map #(check-anagram % (get-word-data)) ,,)
(filter (complement empty?) ,,)
(first),,))動かしてみましょうか。まずは4桁から。
user> (time (pe98 4))
;->"Elapsed time: 616.059212 msecs"
;->([(9 6 0 4) "STOP" ("POST" "SPOT")] [(9 6 0 4) "MEAN" ("NAME")] [(9 6 0 4) "TEAR" ("RATE")])
出ますね。
じゃあ、いきなり9桁やってみましょう。
user> (time (pe98 9))
;->"Elapsed time: 417713.899741 msecs"
だいぶ時間かかってしまいましたが、出ました。
さて、登録してみると、なんと、違ってます。おやー？ 検算してみます。
うーむ。 入れかえた数字の先頭が「0」ですね。それはだめだと問題文にちゃんとあるではないですか。
ちなみに、そのときの答えは、80514729 (= で、
さて、修正します。どう考えても、have-anagramを直ことになります。
(defn have-anagram [numl words check-fn]
(loop [check-list (one-and-rest words)]
(if (seq check-list)
(let [[tgt wordl] (first check-list)
char-map (zipmap tgt numl)
str-to-num (fn [st] (->> (map #(get char-map %) st)
(#(if (zero? (first %)) [2] %) ,,) ; ADD
(apply str ,,)
(Integer/parseInt ,,)) )]
(if (some true? (map #(check-fn (str-to-num %)) wordl))
[numl tgt wordl]
(recur (next check-list)))))))あまりきれいじゃないですね。数字のリストにしたときに、先頭が0だったら、最初の非平方数「2」にしてしまうという戦略。 これでリトライです。
できましたー。10分くらいかかっちゃいますけど。
user> (time (pe98 9))
;->"Elapsed time: 590156.75635 msecs"
1分切れてないんで、本来であれば、処理速度の向上のために、
- 無駄な処理が無いか確認。
- タイプヒント入れてみる。
- 単語の方から攻めるなど、違う方式を検討する。 などしてみるべきなんですが、今回はこれでおしまい。
きれいにしたコードをpe98.cljに入れて、途中経過をpe98work.cljに入れました。