Y箱

針金を曲げて直角三角形を作るとき、1種類しか作れないものを見つける問題です。

ピタゴラス数の問題ですね。


75個解いたので、Level 3になったよ。年内に100を目標にしてたんだけど、届かなかったな。

この記事は、Clojure Advent Calendar 2011の20日目の記事です。



[[2012/1/6 23:00 再修正]]
最新のswank-clojure (1,3.4)では、windowsのパス名の扱いの問題が解決していました。1.3.4以降のものを使えば、特に何もしないで使えます。



[[2011/12/26 23:00 修正]]

最初の投稿では、結局うまくいかなかったのですが、いろいろ調べたり方法を変えたりしてうまく行きました。


これまで、Project EulerとかCode Jamとかやるときには、ClojureBoxを使ってました。ClojureBoxは、立ちあげるとすぐにREPLが使えて便利なのですが、だいぶ前にメンテナンスが終了していて、1.3になる可能性がありません。
自分で1.3に入れ替えるのもそれほど難しくなさそうですけど、1.2ベースで作っちゃったものもあるし、ソースの管理という意味でも、leiningenを使った環境にするのがいいかなと思ったので、やってみました。

数を構成する数字を階乗したものの和で作る数列の長さを求める問題です。

3 -(3!)> 6 -(6!)> 720 -(7!+2!+0!)> 50402 -...

これをそのままやっては終らないので、別の方法を考えたのですけど、思いつかないし、改善方法は思いついたので、それで実装。
2分ちょいかかります。

これもファレイ数列の問題です。

数えるだけなので、他にいい方法もありそうですが、70の方法で正面から解いてます。

ところが、初めに作ったものは再帰で実装して作ったデータを全部持っていたため。OutOfMemoryになってしまった
で、今ちょうど読んでいる、Joy of Clojureで、遅延評価のクイックソートのことが出ていたので、それを使ったらできた。
ついでにJoCに出ていた、名前付き引数を使ってデータ定義をしなくてもいいようにしてみたけれど、あまりよくないかな。

これもファレイ数列の問題です。

なんか、もうちょっといい方法が見つかりそうだんだけれども断念。
まあ、1分弱で解けたからいいということにしよう。




ファレイ数列の個数は、






※wikipediaの画像を勝手に拝借してみた。

と表わせるとのとのこと。 ここにでてくるφ(m)は前に出てきた、オイラーのトーシェント関数。

このまま計算すると、1から1000000までの数を全部素因数分解する必要があって、ちょっと大変なんで、最初は20分近くかかってしまった。
でも、素因数分解の関数(factors)を前のやつからちょっと工夫してやったら、1分を切った。
factorsはもうちょっと高速化できるかもしれない。

百万までの素数を作るのに、5秒くらいかるので、それを入れたら1分を切れないねぇ。





- phi-n
 φ(n)を求める関数。





このとおり。
こういうふうに書けるところがClojure(ｌｉｓｐ）が好きな理由だね。


- pe-72
  ファレイ数列の式の通りの計算。
  でも、公式の場合、0と1を含んだ個数で、PEの問題は両端を含まないので、
  公式の結果から2を引いたものが答え。  ここちょっとはまった。

ファレイ数列の問題です。

Wikipediaの解説を見たら、解きかたは一瞬でわかります。





この数列でa/bとc/dが隣りあっている場合、その間に新しい分数が加わるとすると、それは2数の中間数 (a+c)/(b+d) であるとのこと。

ということは、問題の場合、2/5と3/8 について、
 - 中間数Mを求める。
 - 中間数Mの分母が1000000を超えたら、1つまえのものが答
 - そうでなければ、Mと3/8について同様のことを続ける。

この通りの実装でございます。

これもトーシェント関数の問題です。

普通に考えたら解けないのが分っているので、ちょっと考えます。





今回は、n/φ(n)を小さくするので、問題69で考えたことからすると、素因数の種類は少ないほうがいいということになります。
素因数を1つにするには、nは素数でなくてはならないのですが、nが素数のときのφ(n)は、n-1なので、これがpermutationになることはないでしょう。

ということで、素因数を2つとしてみます。少なくとも問題にある87109の素因数は2つなので、最悪、これが答になります。

さて、素因数が2つということは、

n=p1*p2

ということになります。 また、そのときのトーシェント関数の値は、

φ(n) = φ(p1)*φ(p2) = (p1-1)*(p2-1)

なので、掛けたときに10^7未満になる素数の組を作って、φ(n)とnがpermutationになるかどうか確認します。

20秒弱で解けましたけど、終了条件が分ればもっと速く解けるんじゃないかと思うんだけど、思いつかない。

オイラーのトーシェント関数φ(n)の問題です。


まずは、普通に解いてみましがやっぱり15分もかかります。大きな数の素因数分解そのものに時間がかかるのが問題です。
答が出たので、まあこれでもいいかな...と思っていたのですが、帰りの電車で考えていたら、ひらめきまして、やり直しました。


nの素因数分解が







のようにあらわせるとき、φ(n)は、








で得られます。問題の答は、n/φ(n)を求めます。
最初のやりかたは、ここで、nを素因数分解して、この式をそのまま計算するものでした。

このあと、この式を眺めていて別の方法を思いつきました。

n/φ(n)の値はこういう値です。









nが消えるところがポイントです。
この式の値を大きくするということは、分母を小さくするということです。それには、掛け合わされているかっこの中を小さくすればすればよくて、かっこの中を小さくするには、pを小さくすればいいということがわかります。さらにその数が沢山あればなおいいですね。
ということで、求めるnは、小さな素因数を沢山持つものであることになります。
とはいっても、同じ素因数をいくら持っていても、pは増えませんので、これは、小さい素数から順に素因数として持つものということになります。

ようするに、2、3、5...と、小さいほうから順に1000000を超えないように素数を掛けていくと答が出るということです。
ただ、このやりかただと、重複している素因数がみつからないので、実際にもとめる数はこの数の倍数ということになります。



前半はだめな実装。

- get-n-slash-phi-n
  n/φ(n) を計算する関数
  素因数分解をして、式のとおりに計算しています。

- pe-69
  2からnまでの数について、上の関数を使って、n/φ(n)が最大のものを求める。

下の二つができたやつ。
- product-list
  与えられたコレクションを順に掛けてできる数のリストを返す。
  2 2 2 2 2... なら 2 4 8 16 32... が返ります。

- pe-69
  説明の通りの動作をする関数。
  上の関数で素数を順に掛けた数のリストを作って、引数以下の最大数を求めます。さらに、
  それの倍数で引数以下のものをすべて求めます。

この記事は、Clojure Advent Calendar 2011の5日目の記事です。

Clojure界隈では、というより他でもWeb系のいろいろが沢山なわけですが、仕事がそっち系でないのでそういう指向があまりないのです。
Clojureは今のところ趣味で、主にProject Eulerとか解くのに使っているわけですが、以前、デスクトップアプリ作ってみたのでその時のことを。



環境
---------------------------------------
- マシン
自宅ではLinux機メインでやってますけど、仕事ではWin機です。

- エディタ
いつもはエディタとしてxyzzyを使っているのですが、Clojureを使うには環境があまり整備されていないし(自分でなんとかしろ？ですよねぇ。)、ClojureBoxってのがあるようなので、入れちゃうことにしました。

でも、もうメンテされていないので、1.3.0にしたければ自分でやることになります。 あまり手間もかからないとは思いますけど、そろそろ自分で一から環境作ってもいいかなと思ってます。

- shell
Leiningen使うにはコマンドラインを使うのですが、Winのcommand.comはとても使えたものじゃありません。cygwinとかmsysとか入れたらいいんでしょうけど、それはちょっとだったので、PowerShell使うことにしました。PowerShellが入っていなかったので入れました。

emacsからPowerShellを使いたいので、PowerShell-modeをここを読んで入れました。
設定して起動したらと、"unrecognized shell program" って怒られます。特に問題無く動くんのでしばらく無視してたんですが、やっぱり気になって調べてみたら、ClojureBox/emacs/emacs/lisp/shell.el で出しているメッセージで、コーディングシステムを設定しているところでした。
command.comと同じ設定でいいだろうということで、PowerShell用の設定を追加して黙らせました。


587行目あたり

(cond ((w32-shell-dos-semantics) (set-process-coding-system proc cp-out-dos cp-in-unix)) ((string-match "/msys/" fullprog) (message "think it is MSYS...") (set-process-coding-system proc cp-locale-dos cp-locale-unix)) ((string-match "/cygwin/" fullprog) (message "think it is Cygwin...") (set-process-coding-system proc cp-locale-dos cp-locale-unix)) ;; 以下3行追加。 ((string-match "powershell.exe" fullprog) (message "think it is Powershell...") (set-process-coding-system proc cp-out-dos cp-in-unix)) (t (message "unrecognized shell program yosi: %s" fullprog)))))))

準備
---------------------------------------
- GUIツール
これまでJavaとか華麗にスルーして生きてきて、つい最近androidのアプリが作りたくて初めて触ったような人なので、awtとかswingとかちんぷんかんぷん。とてもそのままでは作れる気がしません。で、ちょっと調べてみたらよさそうなのがあるではないですか。

seesaw
Seesaw is a library/DSL for constructing user interfaces in Clojure. It happens to be built on Swing, but please don't hold that against it.
SeesawはUIを作るためのライブラリー/DSLで、Swingの上に構築されていますが、Swingがだめだというわけではありません。

メイン
https://github.com/daveray/seesaw

使いかた
https://github.com/daveray/seesaw/wiki


-プロジェクトの作成
1. Leiningenで新しいプロジェクトを作ります。
 lein new guitest
 cd guitest

2. project.cljを編集してseesawを追加します。

(defproject guitest "1.0"
  :description "Seesaw test project, and more."
  :dependencies [[org.clojure/clojure "1.2.1"]
[org.clojure/clojure-contrib "1.2.0"]
[seesaw "1.0.7"]]                        ;; 作ったときはこれが最新だった。
  :main guitest.core)                             ;; スタンドアロンにするにはこれが要る。


これで準備は終り。


作成
---------------------------------------
「画像処理おもしろそう」と思って作ったアプリがあるのでこれについて。
GUIが目的ではないので見た目とか適当です(なんのこっちゃ)。

  ★★
  って書いておいて、動かしてみたら動かない。
  処理を早くしようとか、保存できるようにとかしてる途中だったみたいです。
  次の番が回ってくるまでに動くようにしときます。*_*;;;;;;

  動いていたときの画像。




- ソース (github)
https://github.com/ypsilon-takai/clojure-seesaw-test001

苦しまぎれに、解説なんかを。 いや、自分用に...
こうした方がいいんじゃない？ってなことがあれば、ご指摘いただけるとうれしいです。


core.clj
----------------------
 UI部分。画像の読み込みと表示。
 画像処理部分は、別ファイル (imagetool.clj)

14行目
 * 元画像BufferedImage と 表示用画像BufferedImage と 画像処理用long-array など
   書き換えるのでmutableなデータになってます。

23-38行目
 * 入力画像の選択/結果の出力ダイアログ。
   seesawのダイアログを使ってるだけ。

43-78行目
 * 新しい画像を読み込んだときの処理関数たち。
   下の2つが、新しいデータを作る関数と、データを再表示する関数。

81-87行目
 * 画像を保存する関数たち。

91-140行目
 * 画像処理関連
   配列からBufferedImageを作る関数。
   グレースケール化とエッジ検出の処理を呼ぶ関数。

141行目からGUI関連

147-216行目
 * 各ボタンの定義。 actionはそのためのseesawの関数(マクロ？)です。
   押されたときの関数を定義したり、ボタンに表示される文字列を設定したりします。
   Clojure流に設定できるので、気持いいです。

218行目
 * ウィンドウの定義です。
   実行すると、ウィンドウのフレームを返します。
   :content で中を定義します。
   これもClojure流に設定できます。

248行目
 * このクラスのメイン関数です。
   projectファイルでこのファイルをmainとしているので、jarを実行したときに、この-main関数が呼ばれます。
   native! を呼んでおくと、見た目がプラットフォームのものになるそうな。
   上で定義したmain-windowに show!してやると表示されます。




imagetool.clj
----------------------
前半はたいしたことやっていないので割愛。

72行目からがエッジ検出のところです。
いくつかの種類のフィルタを使えるようにしてあります。

create-operationは、フィルタを与えると、どうすればいいかを返します。

transform-to-edge-imgは、画像のデータの入った配列と変換の種類を受け取って、変換後の配列を返します。

ペル方程式の問題です。

って言ってますけど、わからないので、情報を調べていてこの方程式がペル方程式という物だということを知ったんですけどね。

解く方法はわかったんですが、残念なことに、どうしてこうすれば答が出るのか理解できてません。
そういうの多いんですけど、ちょっと悔しいね。





もとのペル方程式は、

  x^2 - Dy^2 = ±1

の形をしています。

これの最小解を求めるには、二次体(Q√D)がなんたらかんたらで、結局は連分数√Dの連分数展開の結果を使ってごにょごにょであるとのこと。詳しくはペル方程式でググってください。

やりかただけ書くと、まずは√Dの連分数展開を求めます。平方根の連分数展開は、小数点以下が必ずループするので、こんな形になります。

{a0: a1, a2, ... an, ,a1, ...}

で、この、n-1番目までの結果を分数にしたものの分子と分母がそれぞれxとyの最小解になっているんだそうな。

連分数展開は前の問題で作ったのがあるけど、ちょっと改変が必要。

あと、結果は場合によっては、x^2 - Dy^2 = -1 の解が先に出る。
ペル方程式の解は無数にあって、n番目のもの xn,ynはここでもとめた最小解x0,y0と
xn - √Dyn = (x0 - √Dy0)^n
という関係があって、しかも、-1 の次は +1 であるとのことなので、2番目を求めればよい。

さて、よくわかってませんが、これを実装しました。


式の中では

 √3 + 5
----------
    4

のような形が基本データになるので、これを、

 √X + M
----------
    N

として、基本形としています。




- int-floor
引数nを超えない最大の整数を返します。

- inverse-rationalize
基本形の分数の逆数を求めます。ただの逆にするのではなく、分母を有理化します。有理化すると形は基本形になり、平方根の中身Xは変らないので、更新したMとNの組を返します。

- make-proper
基本形の分数を帯分数化します。括り出した整数と新しいMを返します。

- get-cf-list-loop
引数Xの連分数展開の結果を返します。ただし、ループの終端までで返ります。

- calc-cf-partial-fraction
連分数展開のリストをもらって、分数に戻します。

- check-norm
x^2-Dy^2が1になっているかどうかを返します。
名前のつけかたを間違えていますね、norm-is-1? だったな。

- my-numerator
- my-denominator
Clojureは分数表記を扱えて、分子と分母を求める関数がある(
numerator,denominator)のですが、引数に整数を渡すと例外を出してしまうので、整数でも動くようにしたもの。マルチメソッドにすべきだったかな。

- solv-pell-eq
問題を解くメイン関数。
Dの値を引数に取って、√Dを連分数展開。
ループの直前までの分数の値を計算。
分母と分子をペル方程式にあてはめて、1ならそれ、-1なら2番目を返す。返るのは、 x,y,D。

- square?
平方数かどうか

- pe-66
1からlimitまでの平方数以外の数について、ペル方程式が1になる解を求めて、xの値が最大になるものを返します。

18の問題と同じで、データが大きくなった問題。
18を解いたときにもそれなりに考えて作ったんだけれども、電車に乗っているとにきいい方法を思いついたので、実装してみた。

ライン数で10分の1くらいになったんじゃないかな？





基本的な考えかたは18を解いたときと同じ。
この問題は、最大の数だけわかればいいので、上からたどっていって、合計が大きくなるものを見付ければいい。たとえば下のような場面では、

  o A B o
 o o X o o

Xの値に影響するのはA、Bの2つのみ。 それぞれAとBまでのルートの和が大きくなる方からXに来るのが大きいルート。例題の場合

1:    3
2:   7 4
3:  2 4 6
4: 8 5 9 3

2列目は、それぞれ上が3なので、10と7。

3列目。

 10  7
 /\ /\
2  4  6

2のところにくるのは、10からのルートのみなので、12になる。
4のところは、10からと7からの2通りある。 大きいほうを取って、14
6のところは、7からのルートのみなので、13
結果として、3列目の大きい方の合計は、
12 14 13

4列目

  12 14 13
  /\ /\ /\
 8  5  9  3

3列目と同様にやって、

20 19 23 16

答が23っと。


18を解いたときは、全部の情報を持っているデータの構造を作って、それに対してこの操作をするようになっていました。問題にしては重量級の仕組みです。途中の情報を後で参照したければこのほうがいいのでしょうけれど、答が出ればいいのであればそんな仕組みは不要です。
今、書いたとおりに、それぞれの段の合計数のリストだけもって、つぎの段に行けばいいわけです。
で、「あ、reduce使えばいいじゃん」と思ったわけです。
そのためには、結果と次の段のリストを使って次の結果を出す方法が必要です。
こんな風にしてみました。

4列目(8 5 9 3)を例にします。前の結果は、(12 14 13)です。 これを、4列目に2回ずつ適用して結果を出すことになります。それだと面倒です。図をよくみると、 \\\ の適用と /// の適用が見えます。ずらしてあるわけです。
なら、ずれたデータを作ればいいのではないか。というわけで、

12 14 13      ：左ずらし l
   12 14 13   ：右ずらし r
8   5  9  3

あいてるところはどうしましょうか？ 手作業なら無視できますけど、計算ではそうはいきませんね。
データは足し算をするので、ここは、0を入れます。掛けるなら1かな。

12 14 13  0   ：左ずらし l
 0 12 14 13   ：右ずらし r
 8  5  9  3

こうしておいて、右ずらしと左ずらしそれぞれ足したときに大きいほうを採用する。という手順で行けば、よさそうです。





- pe-67
問題を解くのはこれだけです。
各段が1つずつのリストになった問題を受け取ります。
((3) (7 4) (2 4 6)(8 5 9 3)) という感じ。
reduceで1行ずつ取ってきて、解き方のように左右にずらし(rt-rとrt-l)て合計が大きい方をとり、新しいリストを作成するということを繰り返す。
最後のリストの最大値が答。

- pe-67-with-file
問題データをファイルから読み込んで、pe-67に渡して解く関数。
with-openでファイルを開いて、文字列を数値に変換してリスト化します。

eについて、ある段階まで連分数展開したものを分数表記したときの分子の数字の問題。

これは、問題57で使った公式ですぐに解ける。
問題57ではは√2だったけど、こんどはe。





この方式は、連分数展開したときの 数列aを求める必要がある。
64の答えを使ってもいいのだけれど、eの連分数は、 {2:1,2,1,1,4,1,1,6,1,1,8,1,....}  になることが分っているので、これをつかう。

a0 = 2 、このあと

a1 = 1, a2 = 2, a3 = 1,
a4 = 1, a5 = 4, a6 = 1,
a7 = 1 a8 = 6, a9 = 1,

のように規則的に並んでいる。これを、a[n] についての場合で分けるとこうなる。

• n=0 のときは2
• nを3で割った余りが2のときは ((n+1)/3)*2
• それ以外は1

これで実装した。





- cf-seq-of-e
  eの数列の生成関数。 説明の通り。

- cf-numerator
  n番目まで展開したときの分子を求める。
  問題57を解いたときは数列を外部参照していたけど、持っていくように変更。
  ずうっと持って回っているのがちょっと気持ち悪い。
  defn-memoは前につくったメモ化マクロ。

- cf-denominator
  使ってないけど、分母を出すやつ。

- pu-65
  n番目の分子を計算して、中の数字を全部足す。
  この方法だと、数字が大きくなるとスタックが溢れるかもしれない。
  そのときは小さい数字から攻めていこうと思ったけど、計算できたのでよしとする。

平方根の正則連分数展開のループの繰り返し数の問題です。

問題文にある通りに連分数展開をしていく処理を作りました。





連分数にする手順は、以下の通りです。
初めの数を以下の形にします。

 √X + M
--------
   N

最初は、M=0、N=1になります。
これを帯分数にします。

     √X + M'
a + ---------
        N

になります。真分数の部分を連分数にするために逆数にします。

         1
a + -----------
         N
     ---------
      √X + M'

分母にある分数を有理化します。

        1
a + ----------
      √X + O
     --------
         P

- int-floor
  foorの整数版

以下2つは

√X + M
-------
   N


- inverse-rationalize
  逆数を取って有理化する関数。 計算したものを

      √X + new-M
     ------------
        new-N

XのN乗を考えたとき、Xの桁数nがNと同じになるような、ものはいくつあるかという問題。

同じ数字でできている5組の3乗数をみつける問題。

これも全数アタック





Hashを使って分類する方法を採った。
3乗数を作って、含まれている数をリストにしてソートしたものをキーにして、Hashに入れる。
Hashに入れたときに、5つたまったらそれが答え。





- num 9
  適当なところで9から始めた。 意味は無い。

- res-map
  格納用Hash

- num-key
  キー。 3乗して数字のリストにしてソートしたもの。

あとは、キーのところに望みの数-1個 ( いまのやつがあるから -1) になっているかどうか確認しながら、再帰で回す。

四桁の3～8角数を任意の順に並べて輪を作る問題。

全くいい方法を思いつかなかったので全数アタック。





・ 4桁のX角数を全部リストアップしておく。
・ 3～8の数の順列を全部リストアップしておく。
・ 順列すべてについて、あてはまるものがあるかどうかを探す。
・ 途中でみつかっても中断せず、すべて探す

だいぶ長くなってしまった。



- triangle-num ～ octagonal
- n-digit-xgonal-num
  生成する関数とチェックする関数を両方用意した。
  4桁の数が必要なので、4桁の整数からチェックする関数でフィルターする方法を採った。

- split-into-2digit
  上位と下位の2桁ずつにわけたベクタを生成

- remove-1digit-at-second
  10の位が0の数は、題意に合わないので除外する。

- get-pe61-xgonal-list
  上記の関数をつかって、x角数のリストを作る。
  [[12 34] [56 78] ....]

- get-child
  とある4桁数 [xx yy] に続くx角数のをすべて求める。

- get-pe61-all-path
  3～7の数の全ての順列を返す。
  ※ 8角数から始めることにしたので、8は入っていない。

- search-all-path-depth
  ある順列について、8角数から始めてその順に最後まで並べたときに、
  先頭の2桁と末尾の2桁が同じであればその列を返す。

- pe61
  全ての順列について、上の関数を呼び出して、解だけ出力する。


他にいいロジックがありそうだけど、思いつかない。

どの2つを取ってつないでも素数になる5つの素数の組をさがす問題

解くのにすごく手間どった。なにしろ計算が終らない。ロジックに問題があるのだとばかり思っていたら、そうではなくて、素数判定の考慮漏れだったという情無い落ち。

といっても、解くのに15分以上かかってしまっているので、情無いのには変りない。

全数アタック以外の方法を思いつかないし、出た答えを見ても、うまい枝刈りの方法も思いつかないので、現状ではこれがほぼベスト。8けた以上の数の素数判定が早くなれば、かなり減りそうだけれど、1分にはほど遠い感じ。





方法はこんな感じ。

素数の列を作る。2と5は題意から除外する。

3 7 9 11 13 17 ......

1こずつ取ってきて、組をつくる。
そのときこういうことをする。
a 自分だけの組
b もともとあった組
c もともとあった組すべてに自分を加えた組
できたものを、要素の数の多い順に並べる。

初めは(3)。 これに7を追加するには
a (7)
b (3)
c (3 7)
なので、できるのは、
(3 7) (3) (7)

9を追加すると

a (9)
b (3 7) (3) (7)
c (3 7 9) (3 9) (7 9)
よって、
(3 7 9) (3 7) (3 9) (7 9) (3) (7) (9)

また、追加するとき、その組が題意に沿っているかどうかの確認もする。
たとえば、(3 7 9)は、39が素数でないので除外する。

こうしていくと、ある素数以下の素数でつくられた、題意に沿ったすべての素数の組をつくることができる。 最初に5個になったものが答。

この方式で高速化するなら、下記のやうなことをしてみるかな。
・ 素数判定の高速化
  3の倍数を省くとか、
・ 枝刈りをする
  まったく思いつかない
・ リストの更新処理の高速化
  データの持ち方をちゃんと考えないと

勢いに乗って、予選の問題Cを解いた。
今やらないと、しばらくできないような気がしたので。


この問題、当日は時間が無くて手をつけられなくて、終了後に全数アタックで実装してSmallだけ解いた。
でも、そのやりかただと例題の最後のやつ1つも解けないわけで、全面みなおし。

かかった時間は、70msec弱。 上々かな。



何個か手で解いてみて、数字を並べて眺めていて思った。
もとの数から直接解答の数を作れないかな。
これでほぼできたに等しい。

虫食い算を解くようなもの。下の桁から繰り上がりとかを考えなから条件を詰めていって埋めていく。情報が少ないので、aとbを決定することはできないけれど、1のビットの合計を求めるのに支障はない。

考えかた
- Nのある桁が1だったときと0だったときのaとbの対応する桁がどうなるべきか、下の位からの繰り上がりの有無を加味して考える。

表にしてみる

繰り上がり  N:0    N:1
 なし           A      B
 あり           C      D

・Aの時
繰り上がりがなしで、Nの値が0になるのだから、aとbの対応する桁の数は0と0、1と1の2通り考えられる。1の個数を最大化したいのだから、ここは1と1で決まり。そして上の桁に繰り上がる。

・Bの時
繰り上がりなしで、Nの値が1になるには、aとbの対応する桁の数は1と0、0と1の2通り。どちらの場合も1の個数は同じなので、1と0に決める。上の桁には繰り上がらない。

・Cの時
繰り上がりありで、Nの値が0になるのだから、aとbの対応する桁の数は1と0、0と1の2通り。どちらの場合も1の個数は同じなので、1と0に決める。上の桁に繰り上がる。

・Dの時
繰り上がりありで、Nの値が1になるには、aとbの対応する桁の数は0と0、1と1の2通り考えられる。ここもは1と1で決まり。
というわけにはいかない。もしこれが、Nの最上位ビットだった場合には繰り上でてしまってはいけない。なので、ここは、Nの最上位ビットかどうかで振り分けなければいけない。
最上位ビットの場合は0と0、そうでなければ1と1で上の桁に繰り上がる。

ちなみに、他の場合で最上位ビットであるかどうかの判定はしなくていい。Nの最上位ビットは0でないのでAとCは考慮不要だし、Bの場合は上位に繰り上がらないので、やはり考慮不要。

このロジックで、最下位ビットから順にaとbを決めていけばいい。

あてはめてやってみる。Nが25とすると二進数では、11001。
1の位は1。繰り上がりなし。パターンB。 aとbの1の位は0と1。繰り上がらない。
2の位は0。繰り上がりなし。パターンA。 aとbの2の位は1と1。繰り上がる。
4の位は0。繰り上がりあり。パターンC。 aとbの4の位は0と1。繰り上がる。
8の位は1。繰り上がりあり。パターンD。 最上位ではない。aとbの8の位は1と1。繰り上がる。
16の位は1。繰り上がりあり。パターンD。 最上位。aとbの16の位は0と0。繰り上がらない。

ということで、aとbは

a 01010(2) = 10(10)
b 01111(2) = 15(10)

ということになる。aとbの0/1は入れ替えられるので、別解は、

a 01011(2) = 11(10)
b 01110(2) = 14(10)

当然1の数は同じで6個。


ソースはこれ



・check-one-digit
A、B、C、Dのロジックをそのまま実装したもの。
Nのビット、下位からの繰り上がり、最上位ビットかどうか を受け取って、aとbのビットの合計と、上位への繰り上がりがあるかどうかを返す。

・lsb
nの最下位ビットを返す。

・msb?
nが最上位ビットかどうかを返す。
正しい実装ではない。対象を減らしながらループしているので、nが1だったら最上位まで来たことになるのを利用している。

・gcj-pC
本体
Nの最下位ビットを取りながら再帰で回している。ビットの合計数を加算しながら回しているのでaとbがどんな数なのかは考えていない。


おまけ
Nの二進数表記を得るときに、最初のプログラムではInteger/toBinaryStringを使っていたけれども、Nがintを超えてしまうと使えない(あたりまえ)。二進化を自前で作ろうかと思ったけど、考えてみたら、最下位ビットから順に取り出せればいいだけなので、「2で割った余り」=「最下位ビット」と、右ビットシフトで次に進めるで対応できることに気づいた。よかった。

Clojure Programmingを予約してあったんだけど、発売日また延期されちゃって、どうやら年内には手に入りそうもない。
そもそも、最初に買ったプログラミングClojureはいい本なのだけれども、対応バージョンが古いのと、もうちょっと真髄みないなものに触れたいと思って、すでに発売中のThe Joy of Clojureと比べて、表紙の絵と新しさでClojure Programmingを選択していたわけだけれども、もう待てません。予約をキャンセルして、The Joy of Clojureを買っちゃいました。

届きました。
うーん。やっぱりこの表紙は怪しい。
まだ、本文は1ページも読んでない。
LOLを返したら読みはじめます。
評価が高い本なので、期待してます。

Clojure Programmingは、来年になって、評価がよかったら買います。
1.3のことが書いてあるならそうでなくても買うかな？

Code Jam Japan予選のB問題。 ふと思い出したときにちょこっと考えていたりしたんだけど、やりかた思いついたので、やってみた。 解けた。

もうちょっと効率を上げたりできそうだけど、500msちょっとで解けたんだからまあこれでいいでしょう。




予選当日に考えた方式は以下の通り。結果としてこの方式で解いた。

戦略

- 今日何を飲むかではなくて、このコーヒーはいつ飲むのかを考える。
- 満足度の高いコーヒーから飲む日を決めていく。
- 飲む日はどうやって決めるのか？

たとえば
 - 期間が5日
 - 満足度(S)10 賞味期限(T)が3日のコーヒーAが2杯(C)
 - 満足度1 賞味期限が5日のコーヒーBが5杯
の場合、
   3日目にコーヒーAが残っていたら飲むのはA
   3日目にAを飲む場合、2日目にAが残っていたら飲むのはA
このように、賞味期限の日からさかのぼって埋めていけばむだなく割り当てることができる。

- 他のコーヒーの予定がすでにが入っているときはそこをとばす。

上記のAのコーヒーは、Tが3でCが2なので、3日目と2日目に飲む。
Bのコーヒーは、Tが5でCが5なので、5日目、4日目、3日目と2日目は埋まっているからとばして、あとは1日目に飲む。

当日のアルゴリズム

当日は、これを実現するために、全体の日程を配列にして埋めていく方法を採った。
上記の場合ならこんな感じ。
 ooooo
 oAAoo
 BAABB
実際は、配列の要素には、決定したコーヒーの満足度を入れておいて、最後に全部足して答えとしていました。

でも、この方式でLargeが解けないのは明白。
日数が1兆を超えるような条件では、どんなに小さくしても配列が作れない。


改良版のアルゴリズム

- 日程の情報を持てないので、選んだコーヒーがどれだけ飲めるかを決定するロジックできないかどうか考えることにした。

- あるコーヒーは、T日目からさかのぼってC日間飲める。すでに飲むコーヒーが決っている日はとばす。この「とばす」のをなんとかすればいい。

で、無くしてしまえないかと考えた。

とばすのではなくて、決った日を取りのぞいてしまう。
そして、その分期間を減らす。 あと、残っているコーヒーの賞味期限も変更しないといけない。
その方法はこんな感じ。

先週の週末、娘が図書館で本を借りたいというので、ついていきました。

家から数分のところにある南部図書館という小さな出張所なので、品揃えは貧弱です。これまでも、買い物帰りにぶらっと寄ったことはあったのですが、雑誌を読むくらいのことしかしてなかったのですが、一回りしてみることにしました。コンピューター関連書籍の棚を見てみると、お約束のWordやExelの本に混って、「Let Over Lambda」が置いてあるじゃありませんか。 ちょっとびっくり。借りちゃいました。


今、仕事の行き帰りに読んでいいて、1/3くらいまで来ました。

情報によれば、後半に山場があるそうなので、まだ、感想を言うのは早いのでしょうが、「マクロはこう使え」っていう本ですね。僕にはやっぱりマクロは難しいし、今一つピンとこない。

よくある手法などを定型で効率よく扱えるようにできるのはとても便利です。
そして、ライブラリとしてくくり出すよりも、はるかに自由度が高いのはよくわかります。
新しい考えかたなんかむうまく実現できるし、さらに、DSLという概念を頭に入れてとりかかると方向性を見失わずに済む。

でも、ちょっと、Common Lisp持ちあげ過ぎじゃない？
マクロについては、Clojureくらいの距離の置きかたが僕にはちょうどいい感じかな。

10月24日にJohn McCarthyさんが亡くなりました。


僕が今この仕事をしているきっかけを作ってくれた人です。
ありがとう。





そのきっかけを久し振りに探してみました。
ありました。 1983年5月のサインス誌です。

GCJJ運営からメールが来て、予選の問題の解説が掲載されたらしい。

でも、くやしいから自分で納得できる解答ができるまで見ないよ。
見ないみない。

Code Jam Japan予選のA問題。当日終ってから考えたロジックを実装してみた。
結果は上でき。 ということで、解説です。




その方法は、逆順でのトレース。
知りたい場所のカードが初めにどこにあったのかを考えるわけ。
図を書いたので、貼りつけ。


ソースはこれ



なんと、1秒以下で答がでた。

今日は環境を調えて、6時間みっちり Code Jam やりました。

結局 AとBのSmallだけしか時間内にできなかった。
Cの問題はそれほど時間がかからなそうだったけど、順番に解くのにこだわりたくて、でも、結局だめだったけど。
時間切れ後に、いちおう、CのSmallも解いてみた。

次回は、1つぐらいLargeが解けるようになっていたい。


問題が公開されているんで、一応僕の書いたコードを。



あら。 Gistって修正すると、貼ったやつも変っちゃうんだね。便利なような不便なような。
Gistベースで修正してるので、随時更新されます。
前のを見たい人は、下の方のリンクからGistに直接アクセスしてくださいです(10/7)


問題Aです。
最初は書いてあるとおりに解いた。Smallだと数秒で解ける。
修正版は、Largeでも250ms程度で解けた。 完了。




問題Bです。
最初からいちおうしらみつぶしでないやりかたを模索した。
現在修正中。


問題 C。
時間切れ後に解いた。 問題のとおり。でも、Small解くのに1分半くらいかかってしまう。
そのうち修正。

明日は Google Code Jam Japan に挑戦です。

この週末にProject Eulerのサイトのデザインが変更になりました。

Googleの変更に似た感じになっています。
最近のトレンドなんでしょうか。

僕はまだレベル2なんですけど、レベルを表わすマークも変更されてます。
僕は前の立体の方が好きでしたね、だんだん角が増えていくので、ぱっと見てどんなだかわかるようになってました。 新しいやつは、上下が良くわからなくなってます。 それが狙いなんでしょうね。

最近別件で忙しくて手をつけてませんけど、そろそろ涼しくなってきたことだし、再開しましょうかね。

前にclojureのmemoize関数の動きがだめだっていう話を書きました。
このポストも関心のある方がいらっしゃるようなので、ちょっと追加の情報を。
べつに目新しいものではありませんけど、日本語の情報が無いみたいなので。

さて、 何がだめなのかをくりかえすと、再帰で定義されている関数をmemoizeを使ってメモ化しても、内部での 再帰呼び出しにメモ化が効かないという現象です。
実はこれ、clojureの1.2からのことで、1.1では問題なく動きます。 

これは、以下に出てくる解決策から考えると、1.2で、関数の名前の解決方法に変更があったためだと思われます。

以下ちょっと長くなります。




例によってフィボナッチ数を求める関数を再帰を使ってで定義して、1.1環境で実行してみます。

user> (clojure-version)
"1.1.0"

(defn fib [n]
  (do
     (println "Called with : " n)
     (if (<= n 1)
        n
        (+ (fib (dec n)) (fib (- n 2))))))


user> (fib 5)
Called with :  5
Called with :  4
Called with :  3
Called with :  2
Called with :  1
Called with :  0
Called with :  1
Called with :  2
Called with :  1
Called with :  0
Called with :  3
Called with :  2
Called with :  1
Called with :  0
Called with :  1
5

再帰的に呼ばれているのが分ります。 これを、memoize関数でメモ化しして、同様に呼んでみます。

(def fib (memoize fib))

user> (fib 5)
Called with :  5
Called with :  4
Called with :  3
Called with :  2
Called with :  1
Called with :  0
5

1.2で実行したときに出て来ていた(fib 1),(fib 2),(fib 3) が出てきません。メモにヒットして関数が呼ばれなくなったためです。memoizeちゃんと動いています。

同じことを1.2でやると、このようにはなりません。 (前のポスト参照)

この問題について、前回僕はマクロを作って解決したわけですが、他にこんな方法もあります。 

まず、メモ化する関数の定義を変更します。

(defn fib2 [n]
  (do
     (println "Called with | " n)
     (if (<= n 1)
        n
        (+ (#'fib2 (dec n)) (#'fib2 (- n 2))))))

このように再帰で呼ばれる関数名に「#'」をつけます。(なんでこうするのかについての考察は後で) そして1.1の時と同様にメモ化すればOKです。

やってみます。

user> (clojure-version)
"1.2.1"

(defn fib2 [n]
  (do
     (println "Called with : " n)
     (if (<= n 1)
        n
        (+ (#'fib2 (dec n)) (#'fib2 (- n 2))))))

user> (fib2 5)
Called with :  5
Called with :  4
Called with :  3
Called with :  2
Called with :  1
Called with :  0
Called with :  1
Called with :  2
Called with :  1
Called with :  0
Called with :  3
Called with :  2
Called with :  1
Called with :  0
Called with :  1
5

(def fib2 (memoize fib2))

user> (fib2 5)
Called with :  5
Called with :  4
Called with :  3
Called with :  2
Called with :  1
Called with :  0
5

この通り 

さて、じゃあ、これはなんでうまく行くんでしょう
 以下の説明は僕の推測です。1.2の変分を見てもよくわからなくて、 なんとなくしか理解できてなくて、今一つ現象を性格に捉えられていない。 
 間違っていたら指摘ください 


 関数が再帰的に呼ばれるとき、1.1では、「関数が評価される時点でこの名前を持っている関数を呼ぶ」という仕組みだったものが、1.2では「定義時点この名前が差している関数を呼ぶ」という方式に変更になった。
そのため、1.2では、初めの関数そのものが再帰で呼ばれてしまい、memoizeがうまく動かなくなってしまった。 

この解決策でつかった「#'」はリーダーマクロで(var xxx)の略。「この名前のvarを取得する」ということを意味している。 なので、1.1の時と同じ定義をさせることができるのです。

推測ここまで


 さて、この方式はちょっと気に入らない。
だって、メモ化するつもりの関数はあらかじめ定義をそれ用に書いておけってことになってしまうわけで、 たとえば、あとから、「あ、これメモ化してほうがいいな」と思った場合、関数定義に手を入れることになってしまう。
だったら、僕の作ったマクロで再定義しちゃったほうが手間は少ない。 

ということで、僕はこの方法は却下。
勉強にはなったけどね。

clojure関連のサイトを見ていたら、ソースコードの表示にgist使っているような感じのものがあった。
調べてみたら、gistでそんな機能を提供してるらしい。 しらなかった。

んで、使ってみた。



どうだろ？ あれ？ シンタックスハイライトは無いのかな？

と思ったら、ファイル名に拡張子、この場合cljを指定してやったら、出た。

これ、いいじゃない。
ProjectEulerはこっちでやろうかな。

前に書いたreduceのポストのトラフィックが意外に高くて気をよくしたのでもうちょっと書いてみる。


reduceの使いかたは

その1 (reduce f coll)
その2 (reduce f val coll)

fは2つの引数を採って1番目の引数と同じ形の値を返す関数。どちらの場合でも、collの要素を一つずつ2番目の引数にしながら、collが無くなるまで、fを呼び出していくけれど、一番最初に違いがある。

その1の書式では、最初の引数は、collの1番目と2番目の要素になる。ということは、reduceの結果は要素と同じ形のものしか作れないことになる。

しかし、その2では、最初の引数はvalと1番目の引数になる。これはreduceの結果がvalと同じ形になることを意味しているので、好きな結果を得ることができるのだ。


さて、こんなデータがあるとする。

(def sample-data [:a :b 11 22 :c :d 33 :e :f])

まずは、この中の数字の数を数える関数を作ってみる。

(reduce f val coll)
collはsample-dataですね。
欲しいデータは数字の個数で、その初期値だからvalに入れるのは0にします。
fは2つの引数(count tgt)を受け取って、tgtが数字ならcountを1増やした値を返す関数ということになります。
こんな感じ

(reduce <数字だったら1増やす> 0 sample-data)

作るとこうなります。

(defn count-num [lst]

  (reduce (fn [count tgt]              ;; 2つの引数を採って

	    (if (number? tgt)          ;; 数字だったら

	      (inc count)              ;; 1増やしたもの

	      count))                  ;; そうでなかったら、そのまま

	  0 lst))



(count-num sample-data)

3

この例は、filter と countを使えば簡単にできてしまうけれど、数字だけじゃなくて、それ以外のものの個数も数えたかったらちょっと面倒じゃないかな。 でも、reduceを使うと簡単。

(reduce f val coll)

valに入れるのは、やっぱり欲しいデータの初期値。こんどは2つの値が必要です。それをまとめるのであれば、ベクタを使うのがいいですね。数字もそれ以外のものも0個なので、0が2つだから[0 0] とします。

関数はこう。

(reduce <数字だったら左を+1、そうでなかったら右を+1> [0 0] sample-data)

作ると、

(defn count-num-other [lst]

  (reduce (fn [count tgt]

	    (if (number? tgt)

	      [(inc (first count)) (last count)]     ;; 数字だったら左を+1

	      [(first count) (inc (last count))]))   ;; そうでなかったら右を+1

	  [0 0] lst))



(count-num-other sample-data)

[3 6]

ここまでは、使ったデータを全部捨てていましたが、当然、使うこともできます。こんどは分類してみます。
結果として、数字とそれ意外のものそれぞれリストが欲しい。、初期値はからなので、valは [[] []].

関数はこう。

(reduce <数字だったら左に入れる、そうでなかったら右に入れる> [[] []] sample-data)

(defn num-or-other [lst]

  (reduce (fn [[nlist olist] tgt]

	    (if (number? tgt)

	      [(conj nlist tgt) olist]        ;;数字だったら左に追加

	      [nlist (conj olist tgt)]))      ;;それでなかったら右に追加

	  [[] []] lst))



 (num-or-other sample-data)

[[11 22 33] [:a :b :c :d :e :f]]

さて、最後は、ちょっと毛色を替えて、数字を出現順の番号に入れかえてみる。google groupのclojure-jaにあった問題。

[:a :b 11 22 :c :d 33 :e :f] を [:a :b 1 2 :c :d 3 :e :f]) のようにしたい。
数字は、11 22 33 の順に出てくるので、11 を 1、22 を 2、33 を 3に置き替えるということ。

カウンターとしてmutableな変数を使ってしまう手もあるけれど、それはだめ。つまらない。でも、カウンターが無いと、番号を振れない。そこで、最初にやった個数を数える問題を改めて見てみると、立派にカウントしているではないですか。リストを順に処理して、33が来たときにちゃんと3を生成していて、これが最終的な答えになっている。今回、このカウンターは最終結果には不要だけれども、途中では必要。最後に捨ててしまうことにする。

(reduce f val coll)
valは、カウンターと結果の初期値 [] を入れるので、 [1 []] になる。 1じゃなくて0でもOKだけれども、処理がちょっと変わる。
関数はこう。

(reduce

   <数字だったらカウンタを+1して、リストにカウンタを入れる、

    そうでなかったら、データをリストに入れる>

   [1 []] sample-data)

(defn seq-num [lst]

  (second                                           ;; 結果のリストだけ抜きだす。

   (reduce (fn [[counter lst] tgt]

	     (if (number? tgt)

	       [(inc counter) (conj lst counter)]   ;; 数字だったら、カウンタを+1して、

	                                            ;; カウンタをリストに入れる

	       [counter (conj lst tgt)]))           ;; そうでなかったら、カウンタはそのまま

	                                            ;; データをリストに入れる

	   [1 []] data)))





(seq-num data)

[:a :b 1 2 :c :d 3 :e :f]

このときの second に入る前のデータは、

[3 [:a :b 1 2 :c :d 3 :e :f]]

のようになっています。

自宅のパソコンが壊れちゃったので、新しいノートPCを買った。
最近はいいやつが安く買えるので、思いきってCore i7のを買ってしまった。
で、前に仕事パソコンでやった並列処理の速度を測ってみた。

新PC
  Core i7 2630
  クロック 2.00GHz
  コア数 4
  MEM: 4GB

旧PC
  Core?2 Duo SL9300
  クロック 1.60GHz
  コア数 2
  MEM: 2GB

さらにi7はハイパースレッディングで仮想コアがあるのでOSからは8つのコアに見える。

処理は 2の10000乗を10000個計算して、下2桁の合計を求めるもの。
コードはこれ。

(let [nums 10000]

  (time 

   (reduce + (map (fn [x] (rem (expt 2 x) 100)) (repeat 10000 nums)))))

結果は
旧 5562 msecs
新 4251 msecs

クロックを比較すると、2.0GHzは1.6GHzの1.25倍なので所用時間が反比例するとしたら、 5562 / 1.25 = 4449 になる。 実際はもうちょっと速いけど、まあ、コア単体ではそれほど性能が上っているわけではないことがわかる。


次に、pmapを使って10000個をそれぞれ並列に処理してみる。

コード

(let [nums 10000]

  (time 

   (reduce + (pmap (fn [x] (rem (expt 2 x) 100)) (repeat 10000 nums)))))

結果
旧 3480 msecs
新 1150 msecs

半分以下の時間になった。単一スレッドとの時間で比較しても、旧では36%減だけど、新では、73%減。

タスクマネージャの表示をキャプチャしたのが下の画像。



また、前にも書いたとおり、上の並列処理は10000個を全部別のスレッドに割りあてていて、オーバーヘッドが大きくなってしまっている。適当なサイズに分割することで、もう少し速度が向上するはず。
以下のようにいくつかずつに分割して割り当てて実行してみた。

2分割の場合の処理がこれ。

(let [nums 10000]

  (time 

   (reduce + (pmap #(reduce + (map (fn [x] (rem (expt 2 x) 100)) %))

                   (partition 5000 (repeat 10000 nums))))))

全部の結果をまとめてみた。
単位はmsec。

            旧     新

1分割      5562   4251

2分割      3092   2157

10分割     3064   1132

100分割    3099   1106

1000分割   3255   1129

10000分割  3480   1150

2コアに比べて、分割数を大くしても性能の低下が少ない感じです。
スレッド(タスク)の切りかえが高速なのかもしれませんね。

ポツポツとPEを解いてきたのですが、思いついたなりに処理を作っていっているので、ロジックの先については、あまり外の情報を見ていない。

それで、こうやってブログに上げるときにコードを見直してみたりすると、なんか、もっといいやりかたができなかったのかなぁとか思って、ちょっとWebで調べてみると唖然とすることが何度もあるわけです。しかも、contribの中にあるよって情報は、さらに愕然とする。

でも自分で探そうとすると、grepしてみようにも単語が出てこないのでうまく探せないし、上から順に見ていくしかないとなったら、面倒になってやっぱり自分で下手な処理を作ってしまう。

でも、そろそろちゃんと一通り見ておいたほうがよさそうな気がしてきたので、ちょっとここいらで手を止めて、いろいろ調べてみることにする。

ということで、PEは少しお休み。

60番で詰ってしまった言い訳でもある。

reduceの使いどころ

(その2も書きました)

reduceって全部足すとかそんな使い方しかしてなかったんだけど、コレクションを全部なめて何かをつくる。という捉えかたをするツールであると捉えると、かなり強力なツールであることがちょっとわかってきた。

たとえば、下の2つの処理は同じことをしている。

  (reduce #(conj (* 2 %1) %2) [] [1 2 3])
  (map #(* 2 %) [1 2 3])

これならmapでやればいいわけだけれども、
でも、逆に言えば、reduceの方がやりたいことを細かく指定できるということなわけ。ここでは、「2倍したものをベクターにつっこむ」ということを指定している。ここは好きにいじることができるので、いろいろなことができる。
特にmapを作るような場合に有効なのではないかと思う。

たとえば、下のような処理。
ポーカーの問題のときに作ったんだけど、個数の多い順に数字を並べたいわけ。
単目的ならもう少しすっきりできたと思うけど、group-sameがあったからこうなってる。

(defn poker-sort [hand]
  "Sort cand num. set letf according to card count.
   ex. [2 2 3 7 7 8] -> (7 2 8 3) : 7 and 2 are two cards."
  (map first
  (sort (fn [a b]
          (if (= (count a) (count b))
            (> (first a) (first b))
            (> (count a) (count b))))
        (group-same (map first hand)))))

(defn group-same
  "Split into same value group
    ex. (2 3 1 3 1 3 3) -> [(1 1) (2) (3 3 3 3)]"
  ([col] (group-same (sort col) []))
  ([col res]
     (if (empty? col)
       res
       (let [[head tail] (split-with #(= (first col) %) col)]
         (recur tail (conj res head ))))))

これをreduceをつかってやってみると、

(let [col [2 3 1 3 1 3 3]]
  (map first
       (sort-by second >
           (reduce #(assoc %1 %2 (inc (get %1 %2 0))) {} col)))

こんな風に書けてしまいます。

reduceの初期値に空のmapを食わせるところがミソ。(常識？)
reduceで1つずつ取り出し数字をキーにして、配列に入っている数を1増やすことでカウントしてるわけ。
最初に出現しとときのために、get関数には無かった場合に0を返すように指定してある。
すると、こんなmapが返ってくる。
   {1 2, 3 4, 2 1}
これをsortで2番目の数字で大きい順に並び替えると、
   ([3 4] [1 2] [2 1])
こうなる。で、これの先頭だけ取り出すと、
   (3 1 2)

どうですかね？

PE 59

XORで暗号化された暗号を解く問題。

コードは長いけどたいしたことやってない。

キーは3文字だと分っているので、暗号文を3文字ずつで分解して、1番目 2番目 3番目だけからなるリストを作る。
それぞれのリストは同じ文字でエンコードされているので、元の文章の文字の出現頻度と同じ頻度になっているはず。
リストに含まれる数を出現頻度順に並べると先頭が最頻の文字。
さて、英語の文章の最頻文字は「e」、かというとそうではなくて「スペース」です。スペースでデコードしたものを出してみると、それらしきものが現われました。

文章をデコードする関数も作って調べてみると当り。

;;
;; Problem 59  : 2011/6/22
;;"Elapsed time: 37.556729 msecs"

(defn group-same
  "Split into same value group
    ex. (2 3 1 3 1 3 3) -> [(1 1) (2) (3 3 3 3)]"
  ([col] (group-same (sort col) []))
  ([col res]
     (if (empty? col)
       res
       (let [[head tail] (split-with #(= (first col) %) col)]
         (recur tail (conj res head ))))))

(defn transpose-grid 
  "Transpose grid.
     [[1 2]
      [3 4]] ->
     [[1 3]
      [2 4]]"
  [grid]
  (apply map list grid))


(defn sort-by-count [num-list]
  "Sort num. set letf according to the count of the number.
   ex. [2 2 3 7 7 8] -> (7 2 8 3) : 7 and 2 are two occurense."
  (map first
       (sort (fn [a b]
               (if (= (count a) (count b))
                 (> (first a) (first b))
                 (> (count a) (count b))))
             (group-same num-list))))


;;;

(def *pe59-file-name* "http://projecteuler.net/project/cipher1.txt")

(use '[clojure.contrib.io :only (slurp*)])
(use '[clojure.contrib.str-utils :only (re-split chomp)])

(defn get-num-seq [file-name]
  (let [file-data (slurp* file-name)]
    (map #(Integer/valueOf %) (re-split #"," (chomp file-data)))))

(defn encdec-char [key val]
  (if (neg? val)
    0
    (bit-xor key val)))

(let [most-frequent-char \space]
  (reduce str
          (map #(char (encdec-char % (int most-frequent-char)))
               (map first
                    (map sort-by-count
                         (transpose-grid
                             (partition 3 3 (repeat -1)
                                (get-num-seq *pe59-file-name*))))))))
;;

デコード関数

;;
(defn pe59 [key]
  (let [[k1 k2 k3] (map int (seq key))]
            (map #(+ (encdec-char k1 (first %))
                     (encdec-char k2 (second %))
                     (encdec-char k3 (last %)))
                 (partition 3 3 (repeat -1) (get-num-seq *pe59-file-name*)))))
;;

数字をぐるぐる四角に並べたときに、中心から角に向う線上にある数が素数である確率が10%を下まわるのは何周並べたときかという問題。

n周めの角にくる数字は、nで表わせるので素数かどうか判定する。あと、n週での対象となる数の数もnで表わせるので計算して、割合を出す。

;;
;; Problem 58  : 2011/6/21
"Elapsed time: 3646.419866 msecs"

(defn corner-set [n]
  (let [side-len (- (* n 2) 1)
        bottom-right (expt side-len 2)
        bottom-left (- bottom-right (- side-len 1))
        top-left (- bottom-right (* 2 (- side-len 1)))
        top-right (- bottom-right (* 3 (- side-len 1)))]
    [top-right top-left bottom-left bottom-right]))



(loop [n 2
       prime-count 0]
  (let [new-prime-count (+ prime-count
                           (count (filter is-prime? (butlast (corner-set n)))))
        corner-count (- (* n 4) 3)
        prime-ratio (/ new-prime-count corner-count)]
    (if (< prime-ratio 1/10)
      [n (- (* n 2) 1)]
      (recur (inc n) new-prime-count))))
;;

2の平方根の連分数を1000段まで順に展開したときの分数表現の分子の桁数がが分母の桁数を超えるのは何回あるかっていう問題。

連分数の展開には一般項の公式があるのでそれをあてはめて計算。

と、ここで、分母と分子の式が漸化式になっているんだが、大きくなるとメモリが足りなくなるので、memoizeを使ってメモ化したのだか効果なし。
なんでだーって調べて分ったのがちょっと前のポスト。

defn-memoを使って再定義したらちゃんとできた。

;;
;; Problem 57  : 2011/6/21
;; "Elapsed time: 4859.538293 msecs"
(defn cf-seq [n]
  (if (zero? n)
    1
    2))

(defn cf-numerator [n]
  (cond (zero? n) 1
        (= 1 n) (cf-seq 0)
        :else (+ (* (cf-seq (dec n))
                    (cf-numerator (dec n))) 
                 (cf-numerator (- n 2)))))

(defn cf-denominator [n]
  (cond (zero? n) 0
        (= 1 n) 1
        :else (+ (* (cf-seq (dec n))
                    (cf-denominator (dec n))) 
                 (cf-denominator (- n 2)))))

(def cf-numerator (memoize cf-numerator))
(def cf-denominator (memoize cf-denominator))

;;

memoizeじゃあだめ。計算おわらない。

;;
(defn-memo cf-numerator [n]
  (cond (zero? n) 1
        (= 1 n) (cf-seq 0)
        :else (+ (* (cf-seq (dec n))
                    (cf-numerator (dec n))) 
                 (cf-numerator (- n 2)))))

(defn-memo cf-denominator [n]
  (cond (zero? n) 0
        (= 1 n) 1
        :else (+ (* (cf-seq (dec n))
                    (cf-denominator (dec n))) 
                 (cf-denominator (- n 2)))))


(defn pe57? [n]
  (> (count (num-to-list (cf-numerator n)))
     (count (num-to-list (cf-denominator n)))))


(count (filter true? (pmap pe57? (range 1000))))
;;

1の1乗から100の100乗までの数で、各桁の数を足したものが一番大きくなるものを求める問題。

そのまま計算したのでございます。

;;
;; Problem 56  : 2011/6/20
;; "Elapsed time: 15482.925064 msecs"

(reduce max
        (for [a (range 1 100) b (range 1 100)]
          (reduce + (num-to-list (expt a b)))))
;;

ある数に対して逆順にした数を足すという操作を繰りかえしたとき、何回か後に回文数になる数を求める問題。

そのまま実装。
あ、最初の数が回文数でもそれはあてはまらないという条件があるので、ループの最初の1回だけ生で計算してる。

;;
;; Problem 55  : 2011/6/20
;; "Elapsed time: 9821.708625 msecs"

(defn reverse-and-add-if-not-palindrome [n]
  (let [revnum (list-to-num (reverse (num-to-list n)))]
    (if (= revnum n)
      true
      (+ n revnum))))

(defn lychrel? [n]
  (loop [depth 1 num (+ n (list-to-num (reverse (num-to-list n))))]
    (let [next-data (reverse-and-add-if-not-palindrome num)]
      (cond (>= depth 50) false
            (true? next-data) true
            :else (recur (inc depth) next-data)))))x


(count (filter false? (map lychrel? (range 1 10000))))
;;

ポーカーの勝敗を判定する問題。

やたら長いけど身は少ない。

まず、ファイルを読み込んで、扱いやすくする。
  [[8 :club] [10 :spade] [13 :club] [8 :heart] [4 :spade]]

役を判定する関数(rank-hand)を使って、役で判定。
同じ役ならのところがちょっと考えた。
結局、同じ役なんだから、手札を枚数の多い順に並べて、
 2 3 1 3 1 3 3  ->  (3 3 3 3) (1 1) (2)
1つだけにして
 (3 3 3 3) (1 1) (2)  -> 3 1 2
頭から大小比較すればいいということに気づいた。


ところで、A,1,2.3.4 をストレートと判定していないことに、今、気づいたんだけど、
答えはあってたみたい。

;;
;; Problem 54  : 2011/6/20
;; "Elapsed time: 430.744131 msecs"

(use '[clojure.contrib.duck-streams :only (reader read-lines)])
(use '[clojure.contrib.str-utils :only (re-split)])

(defn group-same
  "Split into same value group
    ex. (2 3 1 3 1 3 3) -> [(1 1) (2) (3 3 3 3)]"
  ([col] (group-same (sort col) []))
  ([col res]
     (if (empty? col)
       res
       (let [[head tail] (split-with #(= (first col) %) col)]
         (recur tail (conj res head ))))))


(def card-value
     {\2 2, \3 3, \4 4, \5 5, \6 6, \7 7, \8 8, 
      \9 9, \T 10, \J 11, \Q 12, \K 13, \A 14})

(def suite-value
     {\C :club, \H :heart, \D :diamond, \S :spade})

(def hand-rank
     {:high-card 0 :one-pair 1 :two-pairs 2 :three-ofa-kind 3 :straight 4 :flush 5
      :full-house 6 :four-ofa-kind 7 :straight-flush 8 :royal-flush 9})

(defn expand-card [note]
  "extract notation to data 8C -> [8 :club]"
  (let [[n s] (seq note)]
    [(card-value n) (suite-value s)]))


(defn how-many-pairs [hand]
  (count (filter #(= % 2) (map count (group-same (map first hand))))))

(defn how-many-3ok [hand]
  (count (filter #(= % 3) (map count (group-same (map first hand))))))

(defn how-many-4ok [hand]
  (count (filter #(= % 4) (map count (group-same (map first hand))))))

(defn one-pair? [hand]
  (= 1 (how-many-pairs hand)))

(defn two-pair? [hand]
  (= 2 (how-many-pairs hand)))

(defn three-of-kind? [hand]
  (= 1 (how-many-3ok hand)))

(defn straight? [hand]
  (apply = (map #(- %1 %2) (sort (map first hand)) (range 5))))

(defn flush? [hand]
  (apply = (map second hand)))

(defn full-house? [hand]
  (and (= 1 (how-many-pairs hand))
       (= 1 (how-many-3ok hand))))

(defn four-of-kind? [hand]
  (= 1 (how-many-4ok hand)))

(defn straight-flush? [hand]
  (and (straight? hand)
       (flush? hand)))

(defn royal-flush? [hand]
  (and (flush? hand)
       (= (sort (map first hand)) '(10 11 12 13 14))))

(defn rank-hand [hand]
  (cond (royal-flush? hand) :royal-flush
        (straight-flush? hand) :straight-flush
        (four-of-kind? hand) :four-ofa-kind
        (full-house? hand) :full-house
        (flush? hand) :flush
        (straight? hand) :straight
        (three-of-kind? hand) :three-ofa-kind
        (two-pair? hand) :two-pairs
        (one-pair? hand) :one-pair
        :else :high-card))

(defn poker-sort [hand]
  "Sort cand num. set letf according to card count.
   ex. [2 2 3 7 7 8] -> (7 2 8 3) : 7 and 2 are two cards."
  (map first
  (sort (fn [a b]
          (if (= (count a) (count b))
            (> (first a) (first b))
            (> (count a) (count b))))
        (group-same (map first hand)))))

(defn compare-poker [p1 p2]
  "compare porker-sorted cards." 
  (if (= (first p1) (first p2))
    (recur (rest p1) (rest p2))
    (if (> (first p1) (first p2))
      :p1
      :p2)))
         

(defn which-is-win [[p1-hand p2-hand]]
  (let [p1-rank (hand-rank (rank-hand p1-hand))
        p2-rank (hand-rank (rank-hand p2-hand))]
    (cond (> p1-rank p2-rank) :p1
          (< p1-rank p2-rank) :p2
          :else
          (let [p1-sort (poker-sort p1-hand)
                p2-sort (poker-sort p2-hand)]
            (compare-poker p1-sort p2-sort)))))

;; one hand data
;;[[8 :club] [10 :spade] [13 :club] [8 :heart] [4 :spade]]

(count (filter #(= :p1 %)
(let [file-data (read-lines "poker_test.txt")
      input-datas (map #(split-at 5 (map expand-card (re-split #"\s+" %))) file-data)]
  (map which-is-win input-datas))))
;;

100桁以下の数について、含まれる数字を幾つか選んで作られる新しい数の種類が百万個を超えるのは幾つあるかという問題。

言われた通りに計算しちゃったけど、nCrの答えって、rがnの真ん中にあるときが極大だから、それを使うともうちょっと速いはず。
やらなかったけど。

;;
;; Problem 53  : 2011/6/16
;; "Elapsed time: 473.81832 msecs"

(defn fact [n]
  (reduce * (range 1 (inc n))))

(defn composision [n r]
  (/ (fact n) (* (fact r) (fact (- n r)))))


(count
 (filter #(> % 1000000)
         (for [n (range 2 101) r (range 1 100) :when (> n r)]
           (composision n r)))))
;;

1から6までの数を掛けてできる数が同じ数字で構成されている数字を見つける問題。

-6を掛けても桁数が変らないということは、たとえば、3桁なら166まで、
  6桁なら16666までということになる
-最上位が1なので、1から6倍した場合、最上位の数は全て異なる数になるので、
  桁数は6以上のはず。

あとは全数チェック。

答を見て、「あー。なんだよ。これかよ」と思った。 ちょっとくやしい。

;;
;; Problem 52  : 2011/6/15
;; "Elapsed time: 3178.80848 msecs"

(defn same-digits? [n m]
  (= (sort (num-to-list n))
     (sort (num-to-list m))))

(defn pe52-end-num [digit]
  (+ (expt 10 digit)
     (list-to-num (repeat digit 6))))

(take 1
(drop-while empty?
(for [digits (iterate inc 5)]
  (filter #(and (same-digits? % (* 2 %))
                (same-digits? % (* 3 %))
                (same-digits? % (* 4 %))
                (same-digits? % (* 5 %))
                (same-digits? % (* 6 %)))
          (range (+ (expt 10 digits) 2) (inc (pe52-end-num digits)))))))
;;

素数のうち、表われる全ての同じ数字をいれかえてできる組を作ったとき、8つ素数の組ができるものを探す問題。

* 8つの組ができるということは、置き換えるところに 10個の数字(0123456789)のうちの
  8つを入れることができなければならない。

このことから、

- 1の位は入れ替え対象にならない。
  <== 10個のなかに偶数が5つありすべて取り除くことができない。
      1の位が偶数のとき2以外は素数ではない。

- 入れ替える数は1つではない。
  <== 10個の数字には3を法とすると0,1.2になるものがそれぞれ3つ以上あるため、
      2つを取り除いても、かならず0,1.2になるものが含まれる。
      また、対象の数を構成する残りの各桁の数の和は、3を法とすると0,1.2のいずれかになる。
      結局、数字を入れかえてできる数のなかには、各桁の数の和が3を法とすると0になるものが
      必ずできてしまうことになる。
      ある数の各桁の数の和が3を法として0の場合その数は3で割り切れるので、素数ではない。

- 入れ替える数は2つではない。
  <== 2つを同じ数に入れ替える場合、入れ替えた数字の合計は、 0->0, 1->2, 2->4... であり、
      それぞれ3を法とすると、 0,2,1,0,2,1... となり、0,1.2になるものがそれぞれ3つ以上ある。
      以下、1つの場合と同様の理由で、素数でなくなるものが出てしまう。

- 3つの数を入れ替えることは可能、
  <== 3つの数字の合計は3を法とするとすべて0であるため、もとが素数であればどの数字に入れ替えても、
      3の倍数にはならない。

- 4つは1つ、5つは2つのときと同様の理由でできない。 6つは可能である。
  ところが、4つ以上入れ替えてできる数列は3つの入れ替えとも考えられるので、3つ入れ替えたものより
  前に4つ以上入れ替えたものが現れることはない。

ということで、同じ数字が1の位以外の場所に3つある素数だけが調査対象になる。

3つに限定することで、ロジックを簡単にすることができるが、次のような問題がある。それぞれ検討した結果問題ないと考えた。
- 初めにみつかったものが組の中で最小でない可能性がある。
  全ての数列を作って最小のものを取ることにすれば回避できる。
- 12桁以上の数であった場合、どの数も4こ以上の同じ数字を含んでいるかもしれず、ひっかからない可能性がある。
  それより小さな数であることを期待する。(というか、そんなにでかい素数は扱えない)

1つだけ出そうとしたら、出た答えの最上位から幾つかが0になるものだった。問題文ではこのような場合の扱いが明確でないので、計算しなおしになった。

手順は、
- 4桁以上の素数の列に、どの数字が何回出てくるかという情報をくっつける。
- 同じ数を3つだけ含むものを抽出する。
- 3つある数字を0～9の数字に置き換えて、それぞれ素数かどうか判定する。
- 8つ以上が素数になるものを抽出。

;;
;; Problem 51  : 2011/6/15
;; "Elapsed time: 2729.218378 msecs"

(def tgt-prime (drop-while #(< % 1000) (prime-nums-under 1000000)))

(defn replace-digits [num digit]
  (for [rep (range 0 10)]
    (list-to-num (map #(if (= % digit) rep %) (num-to-list num)))))

(defn list-to-num [digit-list]
  (apply + (map #(* %1 (expt 10 %2)) (reverse digit-list) (iterate inc 0))))

(defn num-to-list [num]
  (map #(Character/digit % 10) (str num)))

(defn group-same
  "Split into same value group
    ex. (2 3 1 3 1 3 3) -> [(1 1) (2) (3 3 3 3)]"
  ([col] (group-same (sort col) []))
  ([col res]
     (if (empty? col)
       res
       (let [[head tail] (split-with #(= (first col) %) col)]
         (recur tail (conj res head ))))))

;;; original
(filter (fn [[digit-of-three num]]
          (> (count (filter is-prime?
                    (replace-digits num digit-of-three))) 7))
        (map (fn [[count-list num]]
               [(last (first count-list)) num])
             (filter (fn [[tst _]] (some #(= 3 (first %)) tst))
                     (map (fn [prime]
                            (list (map #(list (count %) (first %))
                                       (group-same (butlast 
                                                     (num-to-list prime))))
                                  prime))
                          tgt-prime))))
;;

なんかごたごたしててわかりにくいので、「->>」まくろを使ったバージョンを書いてみた。
見やすいけど、lispっぽくないね。

;;
;; macro version
(take 1
(->> tgt-prime
     (map (fn [prime]
            (list (map #(list (count %) (first %)) 
                       (group-same (butlast (num-to-list prime))))
                  prime)), )

     (filter (fn [[tst _]] (some #(= 3 (first %)) tst)), )     

     (map (fn [[count-list num]]
            [(last (first count-list)) num]), )

     (filter (fn [[digit-of-three num]]
               (< 7 (count 
                        (filter is-prime? 
                                (replace-digits num digit-of-three))))), )))
;;

100万以下の素数で、もっとも大くの連続する素数の和で表わされるものを求める問題。

そのまま解いた。
素数のリストについて、初めから順に足していって、結果が素数になるかどうか都度判定する。
素数でなくなったら、素数のリストの先頭をとりのぞいてまた同様のことをする。
素数でなくなったときの情報を、前の結果と比べて結果を更新する。

時間かかりすぎ。

;;
;; Problem 50  : 2011/6/14
;; "Elapsed time: 276190.732342 msecs"

(defn longest-seq [coll max-val]
  (loop [forward-coll []
         rest-coll coll
         max-seq []]
    (if (empty? rest-coll)
      max-seq
      (let [next-foward (conj forward-coll (first rest-coll))
            sum-of-coll (reduce + next-foward)]
        (cond (> sum-of-coll max-val) max-seq
              (is-prime? sum-of-coll)
                 (recur next-foward (rest rest-coll) next-foward)
              :else
                 (recur next-foward (rest rest-coll) max-seq ))))))


(loop [primes (prime-nums-under 1000000)
       max-count 0
       res-seq []]
  (if (< (count primes) max-count)
    res-seq
    (let [new-long-coll (longest-seq primes 1000000)
          new-count (count new-long-coll)]
      (if (< new-count max-count)
        (recur (rest primes) max-count res-seq)
        (recur (rest primes) new-count new-long-coll)))))
;;

同じ間隔で並んでいる3つの4桁の素数で、同じ数字で構成されているものを求める問題。

まず、4桁の素数を全てについて、構成する数字をキーにしたmapに入れる。同じ数字で構成されているものは同じキーに関連付けられる。
([1 4 8 7] , (1487 4817 8147))
のような感じ。

そして、その中の3つ以上の数が入っているものについて、等間隔にならんだ3数があれば取り出す。

;;
;; Problem 49  : 2011/6/14
;; "Elapsed time: 93.160443 msecs"

(defn seq-of-3 [coll]
  (for [a coll b coll c coll :when (= (- (* b 2) a) c) 
                             :when (< a b) 
                             :when (< b c)]
    [a b c]))


(let [four-digit-primes (drop-while #(< % 1000) (prime-nums-under 10000))
      *digits-map* (atom {})]

(dorun
  (map (fn [n]
         (let [key (sort (num-to-list n))]
           (swap! *digits-map* assoc key (cons n (@*digits-map* key)))))
       four-digit-primes))

(mapcat seq-of-3
        (for [key (keys @*digits-map*) :when (>= (count (@*digits-map* key)) 3)]
          (sort (@*digits-map* key))))
)
;;

1から1000までの数nについてnのn乗の和を求める問題。

そのまま解いただけ。
最後の10桁だけ求めればいいので、足す前に11桁め以上を消してます。

;;
;; Problem 48  : 2011/6/13
;; "Elapsed time: 217.941386 msecs"

(reduce + (map #(rem (expt % %) 10000000000)(range 1 1001)))
;;

4つの連続駿数で、全てが4種類の素数に因数分解できるようなものをみつける問題。

1から順に全ての数を素因数分解して出てくる数字の種類を数え、もとの数とのペアにしたデータを作る。
あたまから順に4つずつ取って、全部の数字の種類が4になった最初のものが答え。

factorsは前に作った、素因数分解したものをリストで返す関数。

時間かかりすぎ。

;;
;; Problem 47  : 2011/6/13
;; "Elapsed time: 162902.866705 msecs"

(take 1
      (filter
       (fn [coll] (every? #(= 4 (first %)) coll))
       (partition 4 1
                  (map #(vector (count (distinct (factors %))) %)
                       (range 1 1000000)))))
;;

奇数の合成数のうち、「素数と、何かの2乗の2倍の和」で表わされない最小の数を求める問題。

なんか、全然エレガントじゃないけど、素数じゃない奇数について、その数以下の素数を引いた残りが平方数になっているかどうか判定した。

;;
;; Problem 46  : 2011/6/13
;; "Elapsed time: 841.523433 msecs"

(defn square? [n]
  (= (sqrt n) (int (sqrt n))))

(defn not-prime-plus-double-sq [n]
    (every? false?
          (map (fn [pnum]
                 (let [tstval (- n pnum)]
                    (and (even? tstval)
                         (square? (/ tstval 2 )))))
               (prime-nums-under n))))

(take 1 (filter not-prime-plus-double-sq
                (filter (complement is-prime?) (range 1 1000000 2))))
;;

三角数で五角数で六角数であるようなもので40755の次の数をみつける問題。

三角数かどうかと五角数かどうかの判定は作ってある。
六角数を順に作って三角数で五角数かどうかの確認をした。

hexagonal?は使わないけど、作っておいた。

;;
;; Problem 45  : 2011/6/13
;; "Elapsed time: 248.191879 msecs"

(defn hexagonal [n]
  (* n (- (* 2 n) 1)))

(defn hexagonal? [n]
  (zero? (rem (+ 1 (sqrt (+ 1 (* 8 n)))) 4)))


(take 3
(filter (fn [x]
          (and (triangle-num? n)
               (pentagonal? n)))
        (map hexagonal (iterate inc 1))))

;;

2つの五角数の和も差もまた五角数になるような組のうち、最小のものを求める問題。

基本的にしらみつぶし。
n番目の五角数について、(n-1)番目以前のそれぞれの五角数が条件に合うかどうか確認して、
最初にみつかったものを答えにしている。

五角数かどうかの判定は、n番目の五角数をxとすると
x=n(3n-1)/2
3n^2-n-2x=0
n=(1+sqrt(24x+1))/2
だから、24倍して1を足したものの平方根に1を足したものが2で割りきれるかどうかで判定。

;;
;; Problem 44  : 2011/6/13
;;"Elapsed time: 10744.530939 msecs"
;;
;; Memoized!!??
;; "Elapsed time: 38270.006104 msecs"           

(use 'clojure.contrib.math)

(defn pentagonal [n]
  (/ (* n (- (* 3 n) 1)) 2))

(defn pentagonal? [n]
  (zero? (rem (+ 1 (sqrt (+ 1 (* 24 n)))) 6)))

(take 1
(filter #(true? (first %))
        (mapcat (fn [num] 
                  (let [tgt (pentagonal num)]
                    (for [child-num (range (dec num) 0 -1)]
                      (let [child (pentagonal child-num)]
                        [(and (pentagonal? (+ tgt child))
                              (pentagonal? (- tgt child)))
                         tgt
                         child]))))
                (iterate inc 5))))

0から9の10桁のパンデジタルの数で、条件に合うものの総和を求める問題。

条件から
- d4 が偶数であること
- d3 + d4 + d5 が3で割りきれること。
- d6 が 0 か 5 であること。
がわかる。

また、[d6d7d8]が11で割りきれるとき、d6が0だと、d7とd8が同じ数字でなければならなくなるので、
d6は0でない。なので、d6は 5。
そして、5ではじまる3桁(5[d7d8])の11の倍数は
506 517 528 539 561 572 583 594 の8つ (550もだけれどは5が2回でてきちゃうのでだめ)
それと、d4が偶数という条件も入れて、全ての数列を作成して、残りの条件に合うかどうか確認した。

;;
;; Problem 43  : 2011/6/10
;; "Elapsed time: 724.777311 msecs"

;; d2d3d4=406 is divisible by 2  => d4 is even.
;; d3d4d5=063 is divisible by 3  => d3+d4+d5 is divisible by 3
;; d4d5d6=635 is divisible by 5  => d6 is 0 or 5
;; d5d6d7=357 is divisible by 7
;; d6d7d8=572 is divisible by 11 => !
;; d7d8d9=728 is divisible by 13 
;; d8d9d10=289 is divisible by 17
;;
;; if d6 == 0 := d7 and d8 should same. no way.
;; d6 = 5
;; d6d7d8 -> [5]d7d8 is a multiple of 11
;;   ->   506 517 528 539 561 572 583 594  (550 is not match the criteria)
;;
;; d678 [5 0 6] [5 1 7] [5 2 8] [5 3 9] [5 6 1] [5 7 2] [5 8 3] [5 9 4]
;; d4 [0 2 4 6 8]

(use 'clojure.set)
(use 'clojure.contrib.math)

(defn list-diff [base col]
    (vec (difference (set base) (set col))))

(defn create-digits [[d6 d7 d8 d4 :as col]]
  (let [rest-list (list-diff (range 10) col)]
    (for [d1 (range 6) d2 (range 5) d3 (range 4) d5 (range 3) d9 (range 2) ]
      (let [[d1 d2 d3 d5 d9 d10] (select-nums [d1 d2 d3 d5 d9 0] rest-list)]
        [d1 d2 d3 d4 d5 d6 d7 d8 d9 d10]))))

(defn list-to-num [digit-list]
  (apply + (map #(* %1 (expt 10 %2)) (reverse digit-list) (iterate inc 0))))

(defn filter-43 [[d1 d2 d3 d4 d5 d6 d7 d8 d9 d10]]
  (and (zero? (rem (+ d3 d4 d5) 3))
       (zero? (rem (list-to-num [d5 d6 d7]) 7))
       (zero? (rem (list-to-num [d7 d8 d9]) 13))
       (zero? (rem (list-to-num [d8 d9 d10]) 17))))

(let [d6784 (for [d678 [[5 0 6] [5 1 7] [5 2 8] [5 3 9] 
                        [5 6 1] [5 7 2] [5 8 3] [5 9 4]]
                  d4 [0 2 4 6 8]
                  :when (not-any? #(= % d4) d678)]
              (conj d678 d4))]
  (reduce + (map list-to-num (filter filter-43 (mapcat create-digits  d6784)))))
;;

文字のアルファベット順での位置(A=1として)をその文字の値として、単語の文字の値の和が三角数になるものの個数を数える問題。

三角数かどうかの判定は、n番目の三角数xの式を変形して

x = n(n+1)/2
n^2 + n - 2x = 0
n = ( 1 +/- sqrt(8x + 1)) / 2
負の数にならないから、
n = ( 1 + sqrt(8x + 1)) / 2

ということで、8倍の平方根に1を足したものが2で割りきれるかどうかで判断します。

文字->数値変換は、文字コードを使うといいのかもしれないけど、換算表を使った。

ファイルからの読みこみのところは、今見るとwith-openの使いかたが間違ってるけど、動いたのでこのまま。

;;
;; Problem 42  : 2011/6/9
"Elapsed time: 22.138288 msecs"

(use '[clojure.contrib.duck-streams :only (reader read-lines)])

(def alpha-pos
     '{\A 1 \B 2 \C 3 \D 4 \E 5 \F 6 \G 7 \H 8 \I 9 \J 10
       \K 11 \L 12 \M 13 \N 14 \O 15 \P 16 \Q 17 \R 18 \S 19 \T 20
       \U 21 \V 22 \W 23 \X 24 \Y 25 \Z 26})

(defn calc-words [st]
  (reduce + (map #(alpha-pos %) st)))

(defn triangle-num? [n]
  (zero? (rem (- (sqrt (+ (* 8 n) 1)) 1) 2)))

(count (let [file-data (with-open [] (read-lines *filename*))
             word-list (.split (.replaceAll (first file-data) "\"" "") ",")]
         (filter triangle-num? (map calc-words word-list))))
;;

最大のパンデジタルな素数を求める問題。
ここでのパンデジタルな数というのは、1からnまでの全ての数を使った数ということなので、最大でも9桁(1から9)ということになります。

また、1から9まで全部足すと45になるので、9桁のパンデジタルな数は必ず3の倍数になっちゃいます。計算すると、3の倍数にならないのは、7桁と4桁(と1桁だけど、1は素数じゃない)だけ。


あとは、7桁以下の素数の大きなほうから順にパンデジタルかどうか確認していけばいいのでしょうけど、あえて、パンデジタルな数を作って素数かどうか判定する方式にした。
最初のコードは、あえてした割にはエレガントじゃないコードになっちゃった。

select-numsとnum-listx関数で、1からxまでの数の順列を作ろうとしてるんだけど、一般化できなかった。 マクロしかないような気がするけど、どうなんだろうと思って調べたら、contrib.combinatorics にあるみたい。permutations。
これを使ったら簡単だね。
短かいけど、そんなに速さは変らない。

;;
;; Problem 41  : 2011/6/9
;; "Elapsed time: 5.017956 msecs"

(use 'clojure.contrib.combinatorics)

(take 1
      (flatten 
       (for [n [7 4]]
         (filter is-prime? (map list-to-num 
                                (permutations (range n 0 -1)))))))
;;

初めにつくったのがこれ。

select-numsは、[col digit-list]を受けとって、colで指定された順にdigit-listの数字を取っていく関数。

(select-nums [0 0 0 0] [1 2 3 4]) -> [1 2 3 4]
(select-nums [3 2 1 0] [1 2 3 4]) -> [4 3 2 1]
(select-nums [1 1 1 0] [1 2 3 4]) -> [2 3 4 1]

;;
;; Problem 41  : 2011/6/9
;;"Elapsed time: 5.947124 msecs"

(use 'clojure.contrib.math)

(defn select-nums 
  ([col] (select-nums col [1 2 3 4 5 6 7 8 9]))
  ([col digit-list]
     (loop [num-list digit-list
            coll col
            res-list []]
       (if (empty? coll)
         res-list
         (let [tgt-num (nth num-list (first coll))]
           (recur (vec (remove #(= % tgt-num) num-list))
                  (rest coll)
                  (conj res-list tgt-num )))))))

(defn num-list7 []
  (for [a3 (range 7) a4 (range 6)
        a5 (range 5) a6 (range 4) a7 (range 3) a8 (range 2)]
    (select-nums [a3 a4 a5 a6 a7 a8 0]  [7 6 5 4 3 2 1])))

(defn list-to-num [digit-list]
  (apply + (map #(* %1 (expt 10 %2)) 
                (reverse digit-list) (iterate inc 0))))

(time (doall (take 1 (filter is-prime? 
                             (map list-to-num (num-list7))))))

;;