Euler : Problem 50

Posted by TAKAIY On 2011年6月29日水曜日 0 コメント
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)))))
;;
READ MORE

Euler : Problem 49

Posted by TAKAIY On 0 コメント
同じ間隔で並んでいる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))))
)
;;
READ MORE

Euler : Problem 48

Posted by TAKAIY On 0 コメント
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)))
;;
READ MORE

Euler : Problem 47

Posted by TAKAIY On 0 コメント
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)))))
;;
READ MORE

Euler : Problem 46

Posted by TAKAIY On 0 コメント
奇数の合成数のうち、「素数と、何かの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))))
;;
READ MORE

Euler: Problem 45

Posted by TAKAIY On 0 コメント
三角数で五角数で六角数であるようなもので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))))

;;
READ MORE

Euler : Problem 44

Posted by TAKAIY On 0 コメント
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))))

READ MORE

Euler : Problem 43

Posted by TAKAIY On 0 コメント
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)))))
;;
READ MORE

Euler : Problem 42

Posted by TAKAIY On 0 コメント
文字のアルファベット順での位置(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))))
;;
READ MORE

Euler : Problem 41

Posted by TAKAIY On 0 コメント
最大のパンデジタルな素数を求める問題。
ここでのパンデジタルな数というのは、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))))))

;;
READ MORE

Clojureの関数のメモ化 >> だめだめmemoizeの巻

Posted by TAKAIY On 2011年6月21日火曜日 0 コメント
 
これまでもPEを解いていて、memoize関数によるメモ化が効いていないなぁと思うことが何度かあったのだけれど、そのままにしてあった。
でも、Problem 57 を解いているときにこれを解決しないと問題が解けないことが判明。
ちょっと調べてみたら、memoizeが思ったようなmemoizeをしていないことがわかって、僕の思うようなmemoizeをしてくれる関数を作る新しいマクロを作って解決。

なので、そのことについて。


たとえば、フィボナッチ数を求める関数。(実験のためにプリント文を仕込んである。)

;;
(defn fib [n]
(do
(println "-->" n)
(if (<= n 1)
n
(+ (fib (dec n)) (fib (- n 2))))))
;;

メモ化する前に実行するとこんな感じ

user> (fib 4)
--> 4
--> 3
--> 2
--> 1
--> 0
--> 1
--> 2
--> 1
--> 0
3

行き着くところまでネストしていく様子が見えます。 さて、これを、memoize関数でメモ化します。

(def fib (memoize fib))

で、実行してみます。

user> (fib 4)
--> 4
--> 3
--> 2 ※
--> 1
--> 0
--> 1
--> 2 ★
--> 1
--> 0
3

続けて (fib 4) を実行すると、

user> (fib 4)
3

ちゃんとメモ化してるじゃん....じゃない!

ってことで、長くなるので
続きました。


最初のときの出力を見てほしい。★のところは、(fib 2) が呼ばれているんだけど、これは※のところですでに一度呼ばれているからメモ化が効くべきで、この先には行って欲しくない。ほかの (fib 1) (fib 0)も同様。

さらに(fib 5)をやってみるともっとがっかり。

user> (fib 5)
--> 5
--> 4
--> 3
--> 2
--> 1
…略…

おいおい。(fib 4) も (fib 3)もわかってるんだから、ぱっと出せよ…。

計算を始めちゃうと、それまでにメモされている情報にアクセスできていないってことですね。
これじゃあメモ化っていってもねぇ。だめじゃん。

ということで、この実装では、フィボナッチ数列のような漸化式型のテータの生成には使えないってことがわかりました。

素数判定みたいに、前の結果が関係ないものについてなら有効でしょうけど。

これじゃあ問題が解けないんで、ソースを見て考えた。 原因は、メモ化のためのメモ領域が関数の外にあることだと推測した。

memoizeのソースは下のもので、メモ化したい関数を引数「f」で与えるとメモ化された関数が返る。


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

memoizeは「あ」のところで新しい関数をつくって、メモ領域の処理と「f」をラップして返している。
さて、再帰は「い」の「f」の中で行なわれているわけだけど、その中で呼びだされるのはあくまで「f」であって、memoizeで作成された関数ではないわけ。「f」からこいつを呼べればいいのだけれど、そんなことは不可能。

解決するには、メモ化したい関数とメモ領域を同じクロージャに入れればよい。

ということで、どっかを探せば誰かが作ってるとは思うけど、メモ化した関数を定義するマクロを作ってみた。実験のために、メモを消去する関数とメモの中身を表示する関数も一緒につくるようにした。


;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; create memoised func

(defmacro defn-memo
"Creates memoised function, and accessor of the memo which named -data,
memo deletion function named -clear"
[name arg-list & body]
`(let [mem# (atom {})]

(defn ~(symbol (str (str name) "-data")) []
@mem#)

(defn ~(symbol (str (str name) "-clear")) []
(reset! mem# {}))

(defn ~name ~arg-list
(if-let [e# (find @mem# ~arg-list)]
(val e#)
(let [ret# ~@body]
(swap! mem# assoc ~arg-list ret#)
ret#))))))
;;

最後のやつが関数の実体。
このように、関数が呼び出されたあとにメモの中を見るようにしておけば、再帰的に呼ばれたときにも、過去の情報にアクセスできる。

使いかたは普通のdefnと同じ。単にdefnをdefn-memoに書き替える。


;;
(defn-memo mem-fib [n]
(do
(println "-->" n)
(if (<= n 1)
n
(+ (mem-fib (dec n)) (mem-fib (- n 2))))))


使ってみる


user> (mem-fib 4)
--> 4
--> 3
--> 2
--> 1
--> 0
3

変っていないようだけど、メモ化してないバージョンと比べると、
 
user> (fib 4)
--> 4
--> 3
--> 2
--> 1
--> 0
--> 1 ★
--> 2
--> 1
--> 0
3

mem-fibは★以降の計算で前の値にヒットしているからその先を計算していないことがわかる。 さらに(fib 5) とかやってみると、 差は歴然。

user> (mem-fib 5)
--> 5
5
user> (fib 5)
--> 5
--> 4
--> 3
--> 2
--> 1
--> 0
--> 1
--> 2
--> 1
--> 0
--> 3
--> 2
--> 1
--> 0
--> 1
5

めでたしめでたし。


メモの中身は、mem-fib-data でアクセスできます。 atomなので、その気になれば変更できます。

user> (mem-fib-data)
{[5] 5, [4] 3, [3] 2, [2] 1, [0] 0, [1] 1}
消すこともできます。

user> (mem-fib-clear)
{}
user> (mem-fib-data)
{}

消しちゃうと、

user> (mem-fib 5)
--> 5
--> 4
--> 3
--> 2
--> 1
--> 0
5

計算しなおす。

ただ、メモ化したとはいえ、未計算のところは計算しなくちゃならなくて、定義が末尾再帰になってないから、このまま大きな数を求めようとするとスタックを食いつぶしてエラーになったりします。


(mem-fib 10000) ;; やっちゃだめ

こういう場合は、

(last (map mem-fib (range 10001)))

みたいにやる。(printlnを取っておかないと...)

user> (time (last (map mem-fib (range 10001))))
"Elapsed time: 60.550712 msecs"
33644764876431783266 … 7366875

たぶん、memoizeしたfibで同じことをやっても思ったようにはうごかない。


(last (map fib (range 10001)))



データはatomだから、pmapでも大丈夫。

user> (time (last (pmap mem-fib (range 10001))))
"Elapsed time: 227.005108 msecs"
33644764876431783266 …

でも、早くない。前に書いたように、1つずつ別プロセスでやってしまうとオーバーヘッドが増えちゃってだめ。
READ MORE

Euler : Problem 40

Posted by TAKAIY On 2011年6月5日日曜日 0 コメント
ここのところ忙しくてすすんでない。

1ケタが9こで 9ケタ分
2けたが90こで180ケタ分
3けたが900こで2700ケタ分
っていう具合になっていることを利用して求めようかと思ったけど、めんどくさくなって、普通に解いちゃった。

;;
;; Problem 40 : 2011/6/5
;; "Elapsed time: 6926.687051 msecs"
(use 'clojure.contrib.math)

(defn fractional-part-of-irrational []
(mapcat #(seq (str %)) (iterate inc 1)))

(loop [seq (map list (fractional-part-of-irrational) (iterate inc 1))
tgt (map #(expt 10 %) (range 7))
res 1]
(if (empty? tgt)
res
(let [[digit num] (first seq)]
(if (= num (first tgt))
(recur (rest seq) (rest tgt) (* (Character/digit digit 10) res))
(recur (rest seq) tgt res)))))

;;
READ MORE