Y箱

これはちょっと完全に撃沈しちゃってます。
このソースは、結果を出すのに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) だねぇ。 そのうちリベンジしないと。