Y箱

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

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

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

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

;;

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

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

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

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

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

;;

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

;;

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

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

;;

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

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

;;

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

;;

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

;;

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

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


;;

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

;;