ちょっと忙しくて

Posted by TAKAIY On 2011年5月30日月曜日 0 コメント

あれこれ忙しくて進んでない。解けないわけじゃないんだよ。

READ MORE

clojureの並列処理 デュアルコア

Posted by TAKAIY On 2011年5月25日水曜日 0 コメント
Project Euler を解いているときに、素数生成とかの細かい関数を作っているのだけれど、10個以上になってきたので、まとめることにした。
あらためて見てみると、変だったり、もう少し汎用的にしたほうがよかったりするものが目について、直し始めちゃって泥沼化寸前。

そのなかで、同じような計算をたくさんしているところで気になっていたのが、CPUの使用率が50%を超えないこと。mapなんかは自動的に並列処理してくれるのだと思っていたからちょっと意外だった。黒猫本(と呼ばれているかどうかは知らない)にも、STMとかの機能の説明はあるけど、並列化するための方法については書かれていなかった。「自分でJavaのThreadを呼ばなければならんのかい!」と思っていたら、pmapというのを見つけた。

で、実際どうなのかを調べてみた。


なんか適当に時間のかかる処理ということで、適当に2のX乗をY個足す処理にした。

mapでやるとこんな感じ。

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


"Elapsed time: 5561.606014 msecs"

5.6秒くらい。 このときのCPUの使用率は50%。


mapをpmapに変えると、


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


"Elapsed time: 3480.631756 msecs"

お、速い。 3.5秒。 36%高速化。

タスクマネージャで見ると、ちゃんと100%使用率になる。
あと、そこでjavaを片方のCPUにだけ割りあてると、もとと同じく、5秒半ぐらいかかる。


さて、これで安心してはいけない。
ここの記事を見たりすると、ただ単に1つ1つ並列化すればいいというものではないらしい。
そりゃあ当然だ。細切れにすれば、その分Over headが増えるわけだからねぇ。
どんな風に分けたらいいのかなぁ。

僕のPCはデュアルコアだから、2つに分けてみると、

(let [nums 10000]
(time
(reduce + (pmap #(reduce + (map (fn [x] (rem (expt 2 x) 100)) %))
(partition 5000 (repeat 10000 nums))))))

"Elapsed time: 3092.340227 msecs"

3.1秒。 44%高速化。 8ポイント向上。


ほかも適当にやってみると、
10分割 "Elapsed time: 3064.371031 msecs"
100分割 "Elapsed time: 3099.338324 msecs"
1000分割 "Elapsed time: 3255.111753 msecs"

今回は10分割が一番速いという結果。


並列化のための関数は、他にもfutureとかいろいろあるみたいなので、これからちょっとずつつついていこうと思っとります。
READ MORE

ああ

Posted by TAKAIY On 2011年5月22日日曜日 0 コメント
Problem27だけど、ちょっと考察をはしょったところが何かわかった気がする。
READ MORE

Euler : Problem 35

Posted by TAKAIY On 0 コメント
循環させても素数のままの素数の問題。

循環させた数のリストを作る関数を作った。0の扱いでひっかかったりして、結局文字列化して操作する方式になった。

あとは全数検査
途中に偶数とか5とかが入っていたら対象からはずすとかしたらちょっと速くなるかも。


;;
;; Problem 35 : 2011/5/19
;; "Elapsed time: 18328.781172 msecs"

(def *prime-list* (atom []))
(create-prime-list-under 1000000)

;;get all ratate num
(require '[clojure.contrib.string :as ccstr])

(defn rotate-num-str [num-str]
(str (ccstr/drop (dec (.length num-str)) num-str)
(ccstr/butlast 1 num-str) ))

(defn get-all-rotate-num [n]
(loop [new-num (rotate-num-str (str n))
res-list [n]]
(if (= new-num (str n))
res-list
(recur (rotate-num-str new-num)
(conj res-list (Integer/valueOf new-num))))))

(count
(map first
(filter #(every? true? (map is-prime? %))
(map get-all-rotate-num @*prime-list*))))
;;
READ MORE

Euler : Problem 37

Posted by TAKAIY On 0 コメント
1ケタになるまで最上位や最下位の数を取っていっても素数のままの素数の問題。

数字をリスト化して操作

最上位や最下位が素数でないものと、途中に偶数を含んでいるものものははずしてチェックした。

member?関数を作った、every?とかを使って代用できたかも。



;;
;; Problem 37 : 2011/5/19
;; "Elapsed time: 5385.057877 msecs"

(defn member? [n col]
(not-every? false? (map #(= n %) col)))

(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 all-prime-left? [numlist]
(cond (empty? numlist) true
((complement is-prime?) (list-to-num numlist)) false
:else (recur (rest numlist))))

(defn all-prime-right? [numlist]
(cond (empty? numlist) true
((complement is-prime?) (list-to-num numlist)) false
:else (recur (butlast numlist))))

(defn prob37? [n]
(let [numlist (num-to-list n)]
(cond (< n 10) false
(member? (first numlist) [1 4 6 8 9]) false
(member? (last numlist) [1 5 9])) false
(some even? (rest numlist)) false
:else
(and (all-prime-left? numlist)
(all-prime-right? numlist)))))

(reduce + (filter prob37? @*prime-list*))

;;
READ MORE

Euler : Problem 36

Posted by TAKAIY On 0 コメント
十進でも二進でも回文数になっているなっている数をさがす問題。

そのまま解いちゃってるけど、一応、奇数じゃないと二進で回文にならないからそこだけ考慮してる。

;;
;; Problem 36 : 2011/5/19
;; "Elapsed time: 4715.235037 msecs"

(defn palindromic? [str]
(= str (ccstr/join "" (reverse str))))

(reduce + (filter #(and (palindromic? (str %))
(palindromic? (Integer/toBinaryString %)))
(range 1 1000000 2)))

;;
READ MORE

Euler : Problem 34

Posted by TAKAIY On 0 コメント
それぞれの桁の数の階乗の和が元の数と同じになるような数についての問題。

全数アタックで30秒くらいかかってる。
数をリストで生成したけど、数として作って分解したほうが速かったかどうか?


;;
;; Problem 34 : 2011/5/18
;; "Elapsed time: 29005.216026 msecs"

;; (fact 0) ->
(def fact (memoize
(fn [n] (if (< n 2) 1
(* n (fact (dec n)))))))

(reduce +
(map (fn [n]
(let [x (reduce + (map fact (drop-while zero? n)))
y (list-to-num n)]
(cond (< x 3) 0
(= x y) x
:else 0)))
(for [a1 (range 10) a2 (range 10) a3 (range 10)
a4 (range 10) a5 (range 10) a6 (range 10)]
[a1 a2 a3 a4 a5 a6])))
;;
READ MORE

Euler : Problem 33

Posted by TAKAIY On 0 コメント
分数の上下からおなじ数字を取り除いても値が変らないものについての問題。

調べてみると、2パターンしかなくて、
[ax]/[ya] = x/y
[xa]/[ay] = x/y
片方計算すれば、其を逆数にしたものがもう一方になるはず。
また、aとxとyは全部異なる数であることもわかる。

ということで、1から9の数字からa,x,yの3つの数字を選んで分数を作って、あてはまるかどうか計算する。

;
;; Problem 33 : 2011/5/18
;; "Elapsed time: 12.869792 msecs"
;; type
;; [ax]/[ay] = x/y
;; a=0 or x=y :: not allowed
;; [xa]/[ya/ = x/y
;; x=y :: not allowed
;;
;; [ax]/[ya] = x/y
;; [xa]/[ay] = x/y

(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-list []
(for [a (range 9) x (range 8) y (range 7)]
(select-nums [a x y] [1 2 3 4 5 6 7 8 9])))

(reduce *
(map (fn [[a x y]]
(let [n (+ (* 10 x) a)
m (+ (* 10 a) y)]
(if (and (= (/ n m) (/ x y)) (< n m))
(/ n m)
1)))
(num-list)))

;;
READ MORE

Euler : Problem 32

Posted by TAKAIY On 0 コメント
pandigitalな数字=全ての数字を1つ以上含んだ数字についての問題。

pandigitalな数字を作る関数を作った。1つ選んで、残りから1つ選んでっていう感じ。
1から5の数字で、0 0 0 0 0 を選ぶと
[1 2 3 4 5]
1 [2 3 4 5]
12 [3 4 5]
123 [4 5]
1234 [5]
12345 []

2 2 2 0 0 だと

[1 2 3 4 5]
3 [1 2 4 5]
32 [1 4 5]
325 [1 4]
3251 [4]
32514 []

まあ、たぶん、これを使わないで、普通に数字でやったほうが早かったとおもわれる。

問題の方は、1桁×4桁=4桁 と 2桁×3桁=4桁のパターンしかないので、1~9の数の全部の順列を作り、それぞれを2パターンに分解してあてはまるかどうか確認した。

全数検索の方法になってしまった。うまく候補を生成できるといいんだけど、直接値を作っていないので、スクリーニングしてもあまり時間の短縮が望めないので、やらなかった。

;;
;; Problem 32 : 2011/5/18
;; "Elapsed time: 41476.85055 msecs"

;; there is only two type.
;; 1digit * 4digit = 4digit
;; 2digit * 3digit = 4digit

(use 'clojure.contrib.math)

(defn num-list []
(for [a1 (range 9) a2 (range 8) a3 (range 7) a4 (range 6)
b1 (range 5) b2 (range 4) b3 (range 3)
c1 (range 2)]
(select-nums [a1 a2 a3 a4 b1 b2 b3 c1 0] [1 2 3 4 5 6 7 8 9])))

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

(defn create-nums [col]
(let [[p pp] (split-at 4 col)
[mpcand4 mplir1] (map list-to-num (split-at 4 pp))
[mpcand3 mplir2] (map list-to-num (split-at 3 pp))
prod (list-to-num p)]
(if (< prod mpcand4)
nil
[[prod mpcand4 mplir1] [prod mpcand3 mplir2]])))

(reduce +
(distinct (map first
(filter #(= (first %) (* (second %) (last %)))
(filter (complement empty?)
(mapcat create-nums (num-list)))))))
;;
READ MORE

Euler : Problem 31

Posted by TAKAIY On 0 コメント
金種を組みあわせて2ポンドを作る問題。
金額の大きい順に個数を割りあてて樹形図を作るイメージ。

2£  1£  ... 

0 0
1
2

1 0
1

2

データ構造体は、
 <残りの金額> <金種ごとの枚数のリスト>
という感じ。


;;
;; Problem 31 : 2011/5/16
;; "Elapsed time: 604.414248 msecs"

;;data structure
(defstruct coin-table
:rest-amount
:coin-list)

(defn next-list [in-table coin]
(for [num (take-while #(<= (* % coin) (:rest-amount in-table)) (iterate inc 0))]
(struct coin-table
(- (:rest-amount in-table) (* coin num))
(assoc (:coin-list in-table) coin num))))

(loop [mid-flow (list (struct coin-table 200 {}))
coin-list [200 100 50 20 10 5 2]
result-list ()]
(if (empty? coin-list)
(concat result-list mid-flow)
(let [new-list (mapcat #(next-list % (first coin-list)) mid-flow)]
(recur (filter #(> (:rest-amount %) 0) new-list)
(rest coin-list)
(concat result-list (filter #(<= (:rest-amount %) 0) new-list))))))

;;
READ MORE

Lisp-1とLisp-2

Posted by TAKAIY On 2011年5月21日土曜日 0 コメント
なんか、「ClojureはLisp-1だから名前空間が無い」っていう記述をよく見るなぁ、と思っていたら、Wikipediaの日本語版の説明もそうなっていた。

なおした。


でも、基本 Lisp-2 の道を歩いてきたので、関数名の前に #' って書かなくていいのは便利だなぁと思う反面、なんかムズムズする。  あと、つい、変数名に string とか list とか使っちゃって、「あー」とかなる。

Lisp-1とは関係ないけど、[]がリストでない = 評価されない のは地味に便利。 (list xx xx) でなくて [xx xx]って書ける。

そろそろちょっと実用的なものでも作ってみようかなぁ。

いやいや。 とりあえず、50まで行ってからだ。
READ MORE

Euler : Problem 30

Posted by TAKAIY On 2011年5月14日土曜日 0 コメント

30番まで来た。

6桁のときの各桁の5乗の合計は、9^5*6 = 354294 で6桁
7桁のときは、9^5*7 = 413343 6桁になっちゃうので、7桁以上の数で条件にあてはまるものは無い。

全部計算して条件に合うのものだけ抽出して計算。

;;
;; Problem 30 : 2011/5/
;; "Elapsed time: 24452.933823 msecs"

(reduce #(+ %1 (first %2)) 0
(drop 2
(filter #(= (first %) (second %))
(for [a1 (range 10) a2 (range 10) a3 (range 10)
a4 (range 10) a5 (range 10) a6 (range 10)]
[(+ (expt a1 5) (expt a2 5) (expt a3 5)
(expt a4 5) (expt a5 5) (expt a6 5))
(+ (* a1 (expt 10 5)) (* a2 (expt 10 4)) (* a3 (expt 10 3))
(* a4 (expt 10 2)) (* a5 (expt 10 1)) (* a6 (expt 10 0)))]))))
;;

このやりかただと、0と1が候補に入っちゃうので、 「drop 2」 してる。

READ MORE

Euler : Problem 29

Posted by TAKAIY On 0 コメント

全部作って重複を省いて足す。それだけ。

;;
;; Problem 29 : 2011/5/13
;; "Elapsed time: 98.855302 msecs"

(count (distinct (for [a (range 2 101) b (range 2 101)] (expt a b))))

;;


READ MORE

Euler : Problem 28

Posted by TAKAIY On 0 コメント
四角形にならべた数の対角線の合計の問題

中心から出る4つの対角線の数列の差分をとってみると2階差分が全部8

1  3  13  31  57  91
2 10 18 26 34
8 8 8 8

だから、n番目の数はan^2+bn+c の形で表わせる。
2階差分が8だから a=1、nを0始まりにすると、 c=1 に決って、bだけ対角線ごとに異なって、
右下方向 -2
左下方向 0
左上方向 2
右上方向 4

結局、1周分の角の合計は 16n^2+4n+4

あとはnの値が出れば、任意のところの合計が計算できる。。
対応する辺の長さは1,3,5... と増えていくから L=2n-1になり、n=(L+1)/2

この通りに式にする。

;;
;; Problem 28 : 2011/5/13
;; "Elapsed time: 1.278934 msecs"

(defn prob28 [len]
(let [n (/ (+ len 1) 2)]
(+ 1
(reduce +
(map #(+ (* 16 (expt % 2)) (* 4 %) 4)
(range 1 n))))))
;;


始め、「1001までの数を並べた」たと勘違いしていたので、数列を作る関数を作っちゃったから載せておく。
使わないけど。

;;
(defn sq-corner
([] (cons 1 (sq-corner 1)))
([num]
(lazy-seq
(concat
(list
(+ (* 4 (expt num 2)) (* -2 num) 1)
(+ (* 4 (expt num 2)) 1)
(+ (* 4 (expt num 2)) (* 2 num) 1)
(+ (* 4 (expt num 2)) (* 4 num) 1))
(sq-corner (inc num))))))
;;
READ MORE

Euler : Problem 27

Posted by TAKAIY On 2011年5月12日木曜日 0 コメント

この問題はちょっと気合が入った。

まず、f(n) = n2 + an + b とすると、
2階微分 f''(n) = 2 なので、nが1増えると、増分が2ずつ増えることになります。
n2+n+41でできる数列はたしかにそうなってます。
元 41 43 47 53 61 71 83 97 113 ...
増分 2 4 6 8 10 12 14 16 ...

n2-79n+1601 のほうは、
元 1601 1523 1447 1373 1301 1231 1163 1097 1033 ...
増分 -78 -76 -74 -72 -70 -68 -66 -64 ...
ちゃんと2づつ増えてます。

あと、こっちの数列を良く見てみると
1601 1523 1447 ...省略... 47 43 41 41 43 47 ...省略... 1447 1523 1601
のように、41で折りかえしていて、ここに出てくる数字は、オイラーの公式のものと
全く同じです。

この「41」は魔法の数字かなと思って、他の素数を調べてみました。
nは0から始まらなくてはならないので、最初の増分の増分はかならず2で、4、6、8..と続かなくてはだめです。
1000までの素数にそのような数字はあるのかな?と思って全部調べてみると他にはないことがわかります。ということはこの41の系列がかならず登場するということです。

ということは、答えは、
(1) 41からはじまるもの (n2+n+41のパターン)
(2) 41の両側に広がっているもの (n2-79n+1601のパターン)
のどちらかです。

さて、(1)の41からはじまるパターンの場合n=0のときに41にならなくてはならないのでb=41に決まりです。また、n=1のときには43にならなくてはならないので、a=1に決まってしまいます。結局、これしかないということです。

そんなわけで解は(2)のパターンでだけみつかるはずです。
このパターンは、始めに減っていく必要があるので、bは負の数です。
また、増分の増分が2になる数列は41の系列しかありませんので、bはこの数列の中にあるはずです。

こまででしらみつぶそうかと思ったのですが、もうちょっと考えました。

f(n)を変形すると、
f(n) = (n + a)2 + b - a2/4
で、この後ろのb - a2/4に注目すると、
n2+n+41 は 41-1/4 = 163/4
n2-79n+1601 は 1601-(-79)2/4 = 163/4
おー。
よくわからんのだけれど、始めのころにこの公式を調べていたら、「虚二次体 Q(sqrt (-163)) の類数が 1 であることと関係している」というのを見付けていたのだけど、こんなところに 163 が出てきてびっくり。

ともあれ、いつでも b - a2/4 の値が 163/4 であるということにしてしまって、
- bは数列(41 43 47...)の中にある
- そのbについて b - a2/4 の値が 163/4 になるようなaを見つける
という方針でいくことにします。

b - a2/4 = 163/4 なので
a = sqrt ( 4b-163)

bの大きいほうから順にチェックして最初に出てきたのが答えでしょう。

;;
;; Problem 27 : 2011/5/12
;;"Elapsed time: 0.776914 msecs"

(def num-list (reverse (map #(+ (expt % 2) % 41) (range 40))))

(first (filter #(integer? (second %))
(map #(list % (sqrt (- (* 4 %) 163)))
(drop-while #(> 999) num-list)))))
;;
READ MORE

Euler : Problem 26

Posted by TAKAIY On 2011年5月11日水曜日 0 コメント
循環小数の循環列の問題。

なにしろわからなかったから、調べてみると、おもしろいねぇ。

・循環列の長さは最大でも「最大の約数-1」らしい。
   ってことは、素数だけ気にしてればいい。

・素数nの場合、1/nの循環列の長さkは
   10^kをnで割ったあまりが1である最小のk

ということで効率よく求められそう。

今回の答えは、下のloopの length-prime-list に束縛したリストを
10個ぐらい計算してみたところで分っていたので、本来はこれだけでOK。
ちゃんとたしかめようとするとちょっと面倒ってところ。

;;
;; Problem 26 : 2011/5/11
;; "Elapsed time: 63.869011 msecs"
(def *prime-list* (atom []))
(create-prime-list-under 1000)


(loop [length-prime-list (for [n (reverse @*prime-list*)]
(list (first (filter #(= 1 (rem (expt 10 %) n)) (range 1 n)))
n))
old-len 0
old-prim 0]
(let [[length prime] (first length-prime-list)]
(cond (> old-len prime) [old-len old-prim]
(< old-len length) (recur (rest length-prime-list) length prime)
:else (recur (rest length-prime-list) old-len old-prim))))

;;
READ MORE

Euler : Problem 25

Posted by TAKAIY On 0 コメント
最初に1000桁になるフィボナッチ数は?って問題だけど、順に計算してみたらできたからそのまま。
遅延評価の恩恵ですかねぇ。

かなりclojureらしいソースになってんじゃないかと自画自賛。

;;
;; Problem 25 : 2011/5/10
;; "Elapsed time: 0.373232 msecs"
(defn fibo
([]
(concat [1 1] (fibo 1 1)))
([x y]
(let [next-num (+ x y)]
(lazy-seq
(cons next-num (fibo y next-num))))))

(take 1 (drop-while #(< (first %) (expt 10 999))
(map list (my-fibo) (iterate inc 1))))

;;
25問解いたのでレベルが1になったよ。
READ MORE

Euler : Probllem 24

Posted by TAKAIY On 0 コメント

順列の1000000番目はなに?って問題だけど、樹形図を考えてこんな手順にした。

先頭に0があるやつは、 9! で 362880通り。1000000をこえない
先頭に1があるやつも、 9! で 362880通り。1000000をこえない
先頭に2があるやつは、 9! で 362880通りで、1000000をこえてしまうから、先頭は2
次は20で始まるやつは、8! で 40320通りで1000000をこえない
....って順に求めていく。

;;
;; Problem 24 : 2011/5/10
;; "Elapsed time: 1.543492 msecs"
(def fact-tree
[362880 40320 5040 720 120 24 6 2 1])

(use 'clojure.contrib.math)

(loop [fact-tree fact-tree
num-list [0 1 2 3 4 5 6 7 8 9]
remains (dec 1000000)
res-list ()]
(if (empty? fact-tree)
(concat (reverse res-list) num-list)
(let [div (floor (/ remains (first fact-tree)))
tgt-num (nth num-list div)]
(recur (rest fact-tree)
(remove #(= % tgt-num) num-list)
(rem remains (first fact-tree))
(cons tgt-num res-list)))))
;;


READ MORE

Euler : Problem 23

Posted by TAKAIY On 0 コメント

これはちょっと完全に撃沈しちゃってます。
このソースは、結果を出すのに2時間もかかってる。

とりあえずは、過剰数のリスト作成。

;;
;; Problem 23 : 2011/5/10
;; step1 : "Elapsed time: 7139855.954877 msecs" (ouch!)

(def *prime-list* (atom []))
(create-prime-list-under 100000)

;; factors
;;(defn factors [n]
;; (foctors 12) => (2 2 3)

(defn multi-plus [lst]
;; multi-plus : (2 2 2) -> (+ 8 4 2 1)
(if (empty? lst)
1
(+ (apply * lst) (multi-plus (rest lst)))))

(defn sum-of-divisor [n]
(let [ ftr (factors n)]
(- (reduce *
(for [tgt (distinct ftr)]
(multi-plus (filter #(= % tgt) ftr))))
n)))

(def *all-abandant-num*
(filter #(> (sum-of-divisor %) %) (range 2 28123)))

;;


で、1から順に過剰数の和かどうかチェックするようにした。
これで2時間。

;;
;; bruto force!
(defn member [n col]
(cond (empty? col) false
(= n (first col)) true
:else (recur n (rest col))))

(defn sum-of-abandant-num? [n]
(loop [all-abandant-num *all-abandant-num*]
(cond (empty? all-abandant-num) false
(> (first all-abandant-num) n) false
(member (- n (first all-abandant-num)) all-abandant-num) true
:else (recur (rest all-abandant-num)))))

(reduce + (filter #(not (sum-of-abandant-num? %)) (range 1 28123)))



時間短縮になるかな?と思って、結果をmapに入れるようにしたけど、だめ。
1時間経っても終らないからやめた。


;;
;; is this better?
(def soa-map (atom {}))

(loop [all-abandant-num *all-abandant-num*]
(let [one (first all-abandant-num)]
(do
(doseq (for [tgt all-abandant-num]
(swap! soa-set conj (+ one tgt))))
(recur (rest all-abandant-num)))))


(loop [all-abandant-num *all-abandant-num*]
(let [one (first all-abandant-num)]
(do
(for [tgt all-abandant-num]
(if (< (+ one tgt) 28123)
(swap! soa-map assoc (+ one tgt) 1)))
(recur (rest all-abandant-num)))))

;;
どっちにしても O(n^2) だねぇ。 そのうちリベンジしないと。
READ MORE

Euler : Problem 22

Posted by TAKAIY On 0 コメント


こんな問題もあるんだねって感じ。

ただ順に処理するぐらいしか方法はなさそうなのでその通りにやったんだけれど、
文字->数字変換のところで、文字の16進表現から直接値を出そうかと思ったけど、
そういうのに依存するのってどうなの?と思ったので、mapで表を作ったのが
工夫といえば工夫かな。

Javaの関数をいくつか呼んでる。


;;
;; Problem 22 : 2011/5/9
;; "Elapsed time: 49.662736 msecs"

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

(def char-val '{
\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 [list]
(let [[word num] list]
(* (reduce + (map char-val word)) num)))


(let [file-data (with-open [] (read-lines "D:/xxx/names.txt"))
name-list (.split (.replaceAll (first file-data) "\"" "") ",")]
(reduce +
(map calc-words
(map list (sort name-list) (iterate inc 1)))))

;;

READ MORE

Euler : Problem 21

Posted by TAKAIY On 0 コメント
自分以外の約数の和がお互いの値になっているようなものの和を求める問題です。

約数の和は、約数を求めて足すのかなと思って調べてみたら、公式があった。
たとえば、ある数の素因数表示が
a^n * b^m
であったとすると、約数の和は
(1 + a + a^2 + .. + a^n) * (1 + b + b^2 + .. + b^m)
で表わせるんだそうな。 なるほどね。
この式を展開してみるとたしかにすべての約数が出てくるよね。

ってことで、1から順に数xを取って
xの約数の和 y
yの約数の和 z
x = z かつ、x != y
であるようなものだけ残してやるわけです。

で、前に作った、素数のリスト生成と素因数分解処理を持ってきて、
素因数分解の結果から、約数の和を求める関数を作った。

;;
;; Problem 21 : 2011/5/5
;;"Elapsed time: 1260.253748 msecs"

;; prime list

(def *prime-list* (atom []))

(create-prime-list-under 100000)

;; factors
;; (foctors 12) => (2 2 3)


(defn multi-plus [lst]
;; multi-plus : (2 2 2) -> (+ 8 4 2 1)
(if (empty? lst)
1
(+ (apply * lst) (multi-plus (rest lst)))))

(defn sum-of-divisor [n]
(let [ ftr (factors n)]
(- (reduce *
(for [tgt (distinct ftr)]
(multi-plus (filter #(= % tgt) ftr))))
n)))


(reduce +
(filter (fn [x] (let [y (sum-of-divisor x)
z (sum-of-divisor y)]
(and (= x z) (not (= x y)))))
(range 2 10000)))

;;

READ MORE

Euler : Problem 20

Posted by TAKAIY On 2011年5月4日水曜日 0 コメント

やっと20番目まで来た。

100!を計算して各ケタ足したんだけど、他のやりかたあるんだろうか。



;;
;; Problem 20 : 2011/4/27
;; "Elapsed time: 7.363226 msecs"

;; momoise : from clojure.org
(use 'clojure.contrib.math)

(defn memoize [f]
(let [mem (atom {})]
(fn [& args]
(if-let [e (find @mem args)]
(val e)
(let [ret (apply f args)]
(swap! mem assoc args ret)
ret)))))

(defn fact [n]
(if (= n 1)
1
(* n (fact (dec n)))))

(def fact (memoize fact))
(map fact (range 1 100))

(loop [num (fact 100)
result 0]
(if (< num 1)
result
(recur (floor (/ num 10))
(+ result (rem num 10)))))
;;
READ MORE

Euler : Problem 19

Posted by TAKAIY On 0 コメント

公式とかつかってもよさそうだったけど、順にやってみることにした。
1年の最初の曜日を与えると、各月の1日の曜日を返す処理を作って、1900年1月1日から順に1日が何曜日か計算してます。

もっと汎用的な処理を作るべきかなぁ。


;;
;; Problem 19 : 2011/4/27
;; "Elapsed time: 0.492521 msecs" 1900-1900
;; "Elapsed time: 1.898565 msecs" 1900-2000

(def month-non-leap [31 28 31 30 31 30 31 31 30 31 30 31])
(def month-leap [31 29 31 30 31 30 31 31 30 31 30 31])

(defn leap-year? [year]
(cond (not (zero? (rem year 4))) false
(zero? (rem year 400)) true
(zero? (rem year 100)) false
:else true))

(defn get-month [is-leap]
(if is-leap
month-leap
month-non-leap))

(defn first-days [is-leap first-day]
(loop [month-list (get-month is-leap)
res-list (list first-day)]
(if (empty? month-list)
res-list
(let [month-day (first month-list)]
(recur (rest month-list)
(cons (rem (+ (first res-list) month-day) 7) res-list))))))

(defn count-sunday [start-year end-year first-day]
(loop [year-list (range start-year (inc end-year))
first-day first-day
sunday-count 0]
(if (empty? year-list)
sunday-count
(let [[next-first & data] (first-days (leap-year? (first year-list)) first-day)]
(recur (rest year-list)
next-first
(+ sunday-count (count (filter #(= % 0) data))))))))

(-
(count-sunday 1900 2000 1)
(count-sunday 1900 1900 1))


;;

READ MORE

Euler : Problem 18

Posted by TAKAIY On 0 コメント

あとから巨大版が出てくるから、ここで工夫をしないとだめだよみたいなことが書いてある。
これも動的計画法って感じでしょうか。一応、O(n)だし。

;;
;; Problem 18 : 2011/4/27
;; "Elapsed time: 9.528585 msecs"
(def org-data '((75)
(95 64)
(17 47 82)
(18 35 87 10)
(20 4 82 47 65)
(19 1 23 75 3 34)
(88 2 77 73 7 63 67)
(99 65 4 28 6 16 70 92)
(41 41 26 56 83 40 80 70 33)
(41 48 72 33 47 32 37 16 94 29)
(53 71 44 65 25 43 91 52 97 51 14)
(70 11 33 28 77 73 17 78 39 68 17 57)
(91 71 52 38 17 14 91 43 58 50 27 29 48)
(63 66 4 68 89 53 67 30 73 16 69 87 40 31)
( 4 62 98 27 23 9 70 98 73 93 38 53 60 4 23)))


(defstruct grid-node
:weight :val)

(defn make-line-data [node-list target-list res-map]
(if (empty? node-list)
res-map
(let [node (first node-list) target-data (first target-list)]
(recur (rest node-list) (rest target-list)
(assoc res-map node (struct grid-node target-data (atom target-data)))))))

(defn create-node-data [n]
(for [i (range n)]
[i (dec (- n i))]))

(def *nodes*
(loop [grid-data org-data
res-map {}]
(if (empty? grid-data)
res-map
(let [target-list (first grid-data)
node-data (create-node-data (count target-list))]
(recur (rest grid-data) (make-line-data node-data target-list res-map))))))

(defn show-data []
(loop [stage (range (count org-data) 0 -1)
res-list ()]
(if (empty? stage)
res-list
(recur
(rest stage)
(cons (map #(deref (:val (*nodes* %))) (create-node-data (first stage))) res-list)))))
;;

ここまでがデータ定義

上の列から順に合計を作っていく、作った合計が小ければ書きこまないので大きいのが残ると。


;;

(defn update-child [point]
(let [value @(:val (*nodes* point))
child-1 [(inc (first point)) (second point)]
ch-1-weight (:weight (*nodes* child-1))
child-2 [(first point) (inc (second point))]
ch-2-weight (:weight (*nodes* child-2))
]
(do
(swap! (:val (*nodes* child-1)) #(max (+ value %2) %1) ch-1-weight)
(swap! (:val (*nodes* child-2)) #(max (+ value %2) %1) ch-2-weight))))


(loop [stage (range 1 15)]
(if (empty? stage)
nil
(do
(dorun (for [target (create-node-data (first stage))]
(update-child target)))
(recur (rest stage)))))

;;

READ MORE