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