project euler 61

pe_61.clj

;; Problem 61  : 2011/11/16
;;"Elapsed time: 1208.733513 msecs"

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; triangle, pentagonal, hexagonal, and so on.
;; 3
(require '[clojure.contrib.math :as math])

(defn triangle-num [n]
  (/ (* n (+ 1 n)) 2))

(defn triangle-num? [n]
  (zero? (rem (- (Math/sqrt (+ (* 8 n) 1)) 1) 2)))

;; 4
(defn square-num [n]
  (* n n))

(defn square-num? [n]
  (= (math/expt (int (Math/sqrt n)) 2) n))

;; 5
(defn pentagonal [n]
  (/ (* n (- (* 3 n) 1)) 2))

(defn pentagonal? [n]
  (zero? (rem (+ 1 (Math/sqrt (+ 1 (* 24 n)))) 6)))

;; 6
(defn hexagonal [n]
  (* n (- (* 2 n) 1)))

(defn hexagonal? [n]
  (zero? (rem (+ 1 (Math/sqrt (+ 1 (* 8 n)))) 4)))

;; 7
(defn heptagonal [n]
  (/ (* n (- (* 5 n) 3)) 2))

(defn heptagonal? [n]
  (zero? (rem (+ 3 (Math/sqrt (+ 9 (* 40 n)))) 10)))

;; 8
(defn octagonal [n]
  (* n (- (* 3 n) 2)))

(defn octagonal? [n]
  (zero? (rem (+ 1 (Math/sqrt (+ 1 (* 3 n)))) 3)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; main

(defn n-digit-xgonal-num [typep n]
  (filter typep (range (Math/round (Math/pow 10 (dec n)))
		       (Math/round (Math/pow 10 n)))))

(defn split-into-2digit [num-list]
  (map (fn [num]
	 (let [r (rem num 100)]
	   [(/ (- num r) 100) r]))
       num-list))

(defn remove-1digit-at-second [num-list]
  (filter (fn [[_ r]] (>= r 10)) num-list))

(defn get-pe61-xgonal-list [typep]
  (remove-1digit-at-second
   (split-into-2digit
    (n-digit-xgonal-num typep 4))))


(def get-child 
     (let [xgonal-dat {3 (get-pe61-xgonal-list triangle-num?)
		       4 (get-pe61-xgonal-list square-num?)
		       5 (get-pe61-xgonal-list pentagonal?)
		       6 (get-pe61-xgonal-list hexagonal?)
		       7 (get-pe61-xgonal-list heptagonal?)
		       8 (get-pe61-xgonal-list octagonal?)}]
       (fn [digit-set xgonal]
	 (let [tail-2digit (second digit-set)]
	   (filter #(= tail-2digit (first %)) (xgonal-dat xgonal))))))

(defn get-next-level [digit-set xgonal]
  (map #(conj digit-set %) (get-child (last digit-set) xgonal)))

(require '[clojure.contrib.combinatorics :as combx])

(defn get-pe61-all-path []
  (combx/permutations (range 7 2 -1)))

(defn search-all-path-depth [org-path]
  (loop [search-pool (map vector (get-pe61-xgonal-list octagonal?))
	 path org-path]
    (cond (empty? search-pool) '()
	  (empty? path) (filter #(= (first (first %)) (second (last %))) search-pool)
	  :else (recur
		 (mapcat #(get-next-level % (first path)) search-pool)
		 (next path)))))

(defn pe61 []
  (filter (complement empty?)
	  (mapcat search-all-path-depth (get-pe61-all-path))))