Y箱

ポツポツと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))))), )))
;;