rlm@1: 
rlm@1: (ns clojureDemo.project-euler
rlm@1: 
rlm@1: (:refer-clojure :exclude [+ - / * 
rlm@1: 			  assoc conj dissoc empty get into seq
rlm@1: 			  = < > <= >= zero?
rlm@1: 			  ])
rlm@1: 
rlm@1: (:use [clojure.contrib.generic
rlm@1: 	 arithmetic
rlm@1: 	 collection
rlm@1: 	 comparison
rlm@1: 	 ])
rlm@1: 
rlm@1: (:use [clojure.contrib
rlm@1: 	 combinatorics
rlm@1: 	 repl-utils
rlm@1: 	 def
rlm@1: 	 duck-streams
rlm@1: 	 shell-out
rlm@1: 	 import-static
rlm@1: 	 lazy-seqs
rlm@1: 	 logging
rlm@1: 	 map-utils
rlm@1: 	 math
rlm@1: 	 mock
rlm@1: 	 monads
rlm@1: 	 ns-utils
rlm@1:          seq-utils
rlm@1:          function-utils
rlm@1:        profile
rlm@1:        str-utils
rlm@1: 	 ])
rlm@1: 
rlm@1: (:use [clojure.contrib.pprint :exclude [write]])
rlm@1:   
rlm@1: (:use [clojure.contrib.pprint.examples
rlm@1: 	 hexdump
rlm@1: 	 json
rlm@1: 	 multiply
rlm@1: 	 props
rlm@1: 	 show-doc
rlm@1: 	 xml
rlm@1: 	 ])
rlm@1: 
rlm@1: (:import java.io.File)
rlm@1: (:import [java.util Calendar Date])
rlm@1: 
rlm@1: )
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn range-sum 
rlm@1:   "calculates the sum of a range.  Takes the exact same arguments
rlm@1:   as clojure.core/range equilivent to (reduce + (range start end step)), but O(1)."
rlm@1:   ([end]
rlm@1:      (/ (* end (- end 1) ) 2))
rlm@1:   
rlm@1:   ([start end]
rlm@1:      (- (range-sum end) (range-sum start)))
rlm@1: 
rlm@1:   ([start end step]
rlm@1:      (letfn [(zero-sum [end step] (* step (range-sum 0 (ceil (/ end step)))))]
rlm@1:      (+ (zero-sum (- end start) step) (* start (int (/ (- end start) step)))))))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn range-sum-squares
rlm@1:   "equivalent to (reduce + (map #(expt % 2) (range start end step))), 
rlm@1:    but runs in O(1) time."
rlm@1:   ([end]
rlm@1:      (let [n (- end 1)]
rlm@1:      (- (* (expt n 3) 1/3) ;continous volume
rlm@1: 	(+ (* -1/6 n) (* -1/2 (expt n 2)))))) ;discrete correction
rlm@1: 
rlm@1:    ([start end]
rlm@1:      (- (range-sum-squares end) (range-sum-squares start)))
rlm@1: 
rlm@1:    ([start end step]
rlm@1:       ;; (letfn [(zero-sum-squares [end step]
rlm@1:       ;; 				(* step step (range-sum-squares 0 (ceil (/ end step)))))]
rlm@1:       ;; 	(+ 
rlm@1:       ;; 	 (* 2 step (range-sum (ceil (/ (- end start) step))))
rlm@1:       ;; 	 (zero-sum end step) 
rlm@1:       ;; 	 (* start start (int (/ (- end start) step)))))))
rlm@1: ))	
rlm@1: 
rlm@1: 
rlm@1: (defn prime-factors 
rlm@1:   "all the prime factors of the number n"
rlm@1:   [n]
rlm@1:   (filter #(= 0 (rem n %)) (for [p primes :while (<= p n)] p)))
rlm@1: 
rlm@1: (defn factor? [a b] (= 0 (rem a b)))
rlm@1: 
rlm@1: (defn factor-map [a b]
rlm@1:   (if (factor? a b) 
rlm@1: 	{b (quot a b)}
rlm@1: 	nil))
rlm@1: 
rlm@1: 
rlm@1: (defn divides? [numerator divisor] (= (rem numerator divisor) 0))
rlm@1: 
rlm@1: 
rlm@1: (def != (comp not =))
rlm@1: 
rlm@1: 
rlm@1: (defn decompose [number factor]
rlm@1:     (loop [n number counter 0]
rlm@1:       (if (!= (rem n factor) 0)
rlm@1:         counter
rlm@1: 	(recur (/ n factor) (inc counter)))))
rlm@1: 
rlm@1: 	
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn single-factor [{num :current-num index :prime-index factors :prime-factors :as old-state}]
rlm@1:   (let [divisor (nth primes index)
rlm@1: 	new-index (inc index)
rlm@1: 	done? (= num 1)]
rlm@1:     (if (divides? num divisor)
rlm@1:       (let [new-num (/ num (expt divisor (decompose num divisor)))   
rlm@1: 	    factors (assoc factors divisor (decompose num divisor))]
rlm@1: 	[[factors done?] (assoc old-state
rlm@1: 		 :current-num new-num :prime-index new-index :prime-factors factors)])
rlm@1:       
rlm@1:       [[factors done?] (assoc old-state 
rlm@1: 	       :current-num num :prime-index new-index :prime-factors factors)])))
rlm@1:       
rlm@1: 
rlm@1: (defn wtf "a is not used" [a] (domonad state-m [part single-factor] part))
rlm@1: 
rlm@1: (defn fuck-it [] 
rlm@1:   (domonad state-m 
rlm@1: 	   [[factors done?]
rlm@1: 	    (state-m-until second wtf nil)]
rlm@1: 	   
rlm@1: 	   factors))
rlm@1: 
rlm@1: (defn prime-factor-map [num]
rlm@1:   
rlm@1:   (first ((fuck-it) {:prime-factors {}
rlm@1: 		     :prime-index 0
rlm@1: 		     :current-num num})))
rlm@1: 
rlm@1: (defn prime-factors-monad [num]
rlm@1:   (sort (keys (prime-factor-map num))))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
rlm@1: ;; fun with state monad
rlm@1: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
rlm@1: 
rlm@1: 
rlm@1: (defn ++ [{num :num :as world}]
rlm@1:   (let [num++ (inc num)]
rlm@1:     [num++ (assoc world :num num++)]))
rlm@1: 
rlm@1: (defn huh? []
rlm@1:   (with-monad state-m 
rlm@1:     (domonad [x ++
rlm@1: 	      y ++]
rlm@1: 	     y)))
rlm@1: 
rlm@1: 
rlm@1: (comment 
rlm@1: 
rlm@1: huh?
rlm@1: ->
rlm@1: ((let [m-bind (fn m-bind-state [mv f]
rlm@1: 		(fn [s]
rlm@1: 		  (let [[v ss] (mv s)]
rlm@1: 		    ((f v) ss))))] 
rlm@1:        (m-bind
rlm@1: 	++ (fn [x] ++))) {:num 1})
rlm@1: 
rlm@1: 
rlm@1: )
rlm@1: 
rlm@1: 
rlm@1: (defn wordify [n] (cl-format nil "~R" n))
rlm@1:     
rlm@1: (defn british-letter-count-prof [n]
rlm@1:   (prof :total
rlm@1:   (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
rlm@1: 	word (prof :wordify (wordify n))
rlm@1: 	word-seq (prof :sequence (seq word))
rlm@1: 	word-filter (prof :filter (filter #(Character/isLetter %) word-seq))
rlm@1: 	word-count (prof :count (count word-filter))
rlm@1: 	answer (prof :add (+ and? word-count))]
rlm@1:     answer)))
rlm@1: 
rlm@1: (defn british-letter-count-prof2 
rlm@1: "now this is faster, because it uses string manipulation.  go profiling!"
rlm@1: [n]
rlm@1:   (prof :total
rlm@1:   (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
rlm@1: 	word (prof :wordify (wordify n))
rlm@1: 	word-regex (prof :regex (re-gsub #"[\W-,]" "" word))
rlm@1: 	
rlm@1: 	word-count (prof :count (.length word-regex))
rlm@1: 	answer (prof :add (+ and? word-count))]
rlm@1:     answer)))
rlm@1: 
rlm@1: 
rlm@1:    
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: ;pseudo code for primes
rlm@1: 
rlm@1: ;fn prime-decomposition
rlm@1: ; [n]
rlm@1: ; map = {} 
rlm@1: ; 
rlm@1: ; for x in primes
rlm@1: ;   add to map (divide teh fick out n x)
rlm@1: ;   n = n / prime-factors
rlm@1: ;   if n == 1 BREAK;
rlm@1: ;
rlm@1: ;
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn rng [seed]
rlm@1:   (let [m      259200
rlm@1: 	value  (/ (float seed) (float m))
rlm@1: 	next   (rem (+ 54773 (* 7141 seed)) m)]
rlm@1:     [value next]))
rlm@1: 
rlm@1: 
rlm@1: (defn yeah! []
rlm@1:   (let [name sequence-m 
rlm@1: 	m-bind (:m-bind name) 
rlm@1: 	m-result (:m-result name) 
rlm@1: 	m-zero (:m-zero name) 
rlm@1: 	m-plus (:m-plus name)] 
rlm@1: 
rlm@1: 
rlm@1:     (m-bind (range 5) (fn [a] (m-bind [2 3] (fn [b] (m-result (+ a b))))))))
rlm@1: 
rlm@1: 
rlm@1: (defn ohhhh!! []
rlm@1:   
rlm@1:   (let 
rlm@1:       [name state-m 
rlm@1:        m-bind (:m-bind name) 
rlm@1:        m-result (:m-result name) ]
rlm@1:     
rlm@1:     (m-bind rng (fn [x1] (m-bind rng (fn [x2] (m-result (+ x1 x2))))))))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defmulti palindrome? class)
rlm@1:   
rlm@1: (defmethod palindrome? (class "string") [a]
rlm@1:   (= (seq a) (reverse a)))
rlm@1: 
rlm@1: (defmethod palindrome? (class 500) [a]
rlm@1:   (palindrome? (str a)))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn circulars 
rlm@1:   "returns a vector of all the circular permutations of a number"
rlm@1:   [n]
rlm@1:   (map #(Integer. (apply str %)) (rotations (seq (str n)))))
rlm@1:     
rlm@1: 
rlm@1: (defn prime-factors
rlm@1:   [n]
rlm@1:   (for [a primes :while (<= a n) :when (= (rem n a) 0)]  a)) 
rlm@1: 
rlm@1: 
rlm@1: (defmethod = [nil java.lang.Integer] [ a b ]
rlm@1:   false)
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (def mil 1000000)
rlm@1: (def bil 1000000000)
rlm@1: 
rlm@1: (defn primes-under-million [] (apply hash-set (take 78498 primes)))
rlm@1: (def primes-under-million (memoize primes-under-million))
rlm@1: 
rlm@1: 
rlm@1: (defn primes-under-billion [] (apply hash-set (take 664579 primes)))
rlm@1: (def primes-under-billion (memoize primes-under-billion))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn prime? [n] (not (nil? (get (primes-under-billion) n))))
rlm@1: 
rlm@1: 
rlm@1: (defn circular-memoize 
rlm@1:   "assumes that f is a predicate that takes in a number for which, 
rlm@1:    if the predicate is true for the number, it is also true for all
rlm@1:    of the circular permutations of the number.  Memoizes the result
rlm@1:    for all circular permutations so as to avoid subsequent computation."
rlm@1:   [f]
rlm@1:    (let [mem (atom {})]
rlm@1:     (fn [n]
rlm@1:       (if-let [e (find @mem n)]
rlm@1:         (val e)
rlm@1:         (let [ret (f n)]
rlm@1: 	  (dorun (for [circ (circulars n)]
rlm@1: 		   (swap! mem assoc n ret)))
rlm@1:           ret)))))
rlm@1: 
rlm@1: (defn circularly-prime?
rlm@1:   [n]
rlm@1:   (not (some (comp not prime?) (circulars n))))
rlm@1: 
rlm@1: (def circularly-prime? (memoize circularly-prime?))
rlm@1: 
rlm@1: 
rlm@1: (defmethod = :default  [& args]
rlm@1:   (apply clojure.core/= args))
rlm@1:   
rlm@1: (def logins 
rlm@1:      (map str
rlm@1: 	  [319 680 180 690 129 620 762 689 762 318
rlm@1: 	   368 710 720 710 629 168 160 689 716 731
rlm@1: 	   736 729 316 729 729 710 769 290 719 680
rlm@1: 	   318 389 162 289 162 718 729 319 790 680
rlm@1: 	   890 362 319 760 316 729 380 319 728 716]))
rlm@1: 
rlm@1: (defn remove-multiples [n]
rlm@1:   (reduce (fn [a b] (if (= (last a) b) a (conj a b))) [] n))
rlm@1: 
rlm@1: (defn insert [item n vect]
rlm@1:   (let [split (split-at n vect)]
rlm@1:     (apply vector (flatten [(first split) item (last split)]))))
rlm@1: 
rlm@1: (defn expand-code [old-code [c b a]]
rlm@1:   (let [main-length (count old-code)]
rlm@1:     (for [x (range (inc main-length)) y (range (inc x)) z (range (inc y))] 
rlm@1:       (insert c z (insert b y (insert a x old-code)))))) 
rlm@1: 
rlm@1: (defn domain-expand-contract [old-domain constraint]
rlm@1:   (let [new-domain 
rlm@1: 	(map remove-multiples 
rlm@1: 	     (remove-multiples 
rlm@1: 	      (sort 
rlm@1: 	       (apply concat 
rlm@1: 		      (map #(expand-code % constraint) old-domain)))))
rlm@1: 	min-code-length (apply min (map count new-domain)) ]
rlm@1:     (map #(apply str %) (filter #(= (count %) min-code-length) new-domain))))
rlm@1: (def domain-expand-contract (memoize domain-expand-contract))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn lazy-fibo 
rlm@1:   ([] (concat [0 1] (lazy-fibo 0 1)))
rlm@1:   ([a b] (let [n (+ a b)] (lazy-seq (cons n (lazy-fibo b n))))))
rlm@1: 
rlm@1: 
rlm@1: (defn collatz-seq [n]  
rlm@1:   (lazy-seq
rlm@1:   (cond (= n 1) [1]
rlm@1: 	(even? n) (lazy-seq (cons n (collatz-seq (/ n 2))))
rlm@1: 	(odd? n)  (lazy-seq (cons n (collatz-seq (+ 1 (* 3 n))))))))
rlm@1: (def collatz-seq (memoize collatz-seq))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn pythagorean-triple? [a b c]
rlm@1:   (let [[a b c] (sort [a b c])]
rlm@1:     (= (+ (* a a) (* b b) ) (* c c))))
rlm@1: 
rlm@1: 
rlm@1: (defn sum-squares [coll]
rlm@1:   (reduce +  (map #(* % %) coll)))
rlm@1: 
rlm@1: 
rlm@1: (defn british-letter-count [n]
rlm@1:   
rlm@1:   (let [and? (if (and (> n 99) (!= 0 (rem n 100))) 3 0)]
rlm@1: 
rlm@1:     (+ and? (count (filter #(Character/isLetter %) (seq (wordify n)))))))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defmacro apply-macro
rlm@1:   "This is evil.  Don't ever use it.  It makes a macro behave like a
rlm@1:   function.  Seriously, how messed up is that?
rlm@1: 
rlm@1:   Evaluates all args, then uses them as arguments to the macro as with
rlm@1:   apply.
rlm@1: 
rlm@1:   (def things [true true false])
rlm@1:   (apply-macro and things)
rlm@1:   ;; Expands to:  (and true true false)"
rlm@1:   [macro & args]
rlm@1:   (cons macro (flatten (map eval args))))
rlm@1: 
rlm@1: (defn fun1 [] (Thread/sleep 5000) 5)
rlm@1: 
rlm@1: (defn fun2 [] (Thread/sleep 30000) 5)
rlm@1: 
rlm@1: 
rlm@1: (def naturals (iterate inc 0))
rlm@1:   
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn race []
rlm@1:   (let [result (ref nil)
rlm@1: 	threads [(Thread. (fn [] (try 
rlm@1: 				  (let [answer (fun1)] 
rlm@1: 				    (dosync (ref-set result answer)))
rlm@1: 				  (catch Exception _ nil))))
rlm@1: 		 (Thread. (fn [] (try 
rlm@1: 				  (let [answer (fun2)] 
rlm@1: 				    (dosync (ref-set result answer))) 
rlm@1: 				  (catch Exception _ nil))))]]
rlm@1: 	   
rlm@1:     (dorun (map #(.start %) threads))
rlm@1:     (loop []
rlm@1:       (if (!= (deref result) nil)
rlm@1: 	(do (dorun (map #(.stop %) threads))
rlm@1: 	    (deref result))
rlm@1: 	(recur)))))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn make-date [year month day] (do (let [date (Calendar/getInstance)] (.set date year month day 0 0) date)))
rlm@1: 
rlm@1: (def jan-1-1901 (make-date 1900 0 1))
rlm@1: 
rlm@1: (defn sunday? [#^java.util.Date date] (re-matches #"^Sun.*"  (str  date)))
rlm@1: 
rlm@1: (count (filter sunday? (for [a (range 1 40000) date [(.getTime (make-date 1900 0 a)) ] :while (< (.getYear date) 100)] date )))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (comment
rlm@1: 
rlm@1: ;; ----------------------------------------------------------------------
rlm@1: ;; Answers
rlm@1: ;; ----------------------------------------------------------------------
rlm@1: 
rlm@1: ; Problem 1 
rlm@1: (+ (range-sum 0 1001 3) (range-sum 0 1001 5) (* -1 (range-sum 0 1001 15)))
rlm@1: 
rlm@1: ; Problem 2
rlm@1: (reduce + (for [a (filter even? (fibs)) :while (<= a 4000000 )] a))
rlm@1: 
rlm@1: ; Problem 3
rlm@1: (apply max (prime-factors 600851475143))
rlm@1: 
rlm@1: ; Problem 4
rlm@1: (reduce max (for [a (range 100 1000) b (range 100 1000) :when (palindrome? (* a b))] (* a b)))
rlm@1: 
rlm@1: ; Problem 5
rlm@1: (reduce lcm (range 1 21))
rlm@1: 
rlm@1: ; Problem 6
rlm@1: (- (expt (range-sum 101) 2) (range-sum-squares 101))
rlm@1: 
rlm@1: ; Problem 7
rlm@1: (nth primes 10000)
rlm@1: 
rlm@1: 
rlm@1: ; Problem 9
rlm@1: (reduce * (first (for [a (range 1 1000) b (range 1 a) c [(sqrt (sum-squares [a b]))] 
rlm@1:       :when (= (+ a b c) 1000)] [a b c])))
rlm@1: 
rlm@1: ; Problem 10 
rlm@1: (reduce + (for [a primes :while (< a 2000000)] a))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: ; Problem 14
rlm@1: (first (reduce (fn [a b] (if (> (count a) (count b)) a b)) [] (map collatz-seq (range 1 mil))))
rlm@1: 
rlm@1: 
rlm@1: ; Problem 16
rlm@1: (reduce + (map #(Character/getNumericValue %) (seq (str (expt 2 1000)))))
rlm@1: 
rlm@1: ; Problem 17
rlm@1: (reduce + (map british-letter-count (range 1 1001)))
rlm@1: 
rlm@1: 
rlm@1: ; Problem 24
rlm@1: (nth  (lex-permutations [ 0 1 2 3 4 5 6 7 8 9]) (- mil 1))
rlm@1: 
rlm@1: ; Problem 33
rlm@1: (reduce * (for [num (range 1 10) 
rlm@1:       den (range 1  10) 
rlm@1:       weird (range 1 10) 
rlm@1:       top [(+ num (* 10 weird))]
rlm@1:       bottom [(+ weird (* 10 den))]
rlm@1:       :when (and (> (/ top bottom) 1) (= (/ top bottom) (/ num den)))]
rlm@1:   (/ bottom top)))
rlm@1: 
rlm@1: ; Problem 35
rlm@1: (count (filter circularly-prime? (primes-under-million)))
rlm@1: 
rlm@1: ; Problem 40 
rlm@1: (let [fff (apply str (take 1030000 naturals))] 
rlm@1:   (reduce * (map #(Character/getNumericValue (nth fff %)) 
rlm@1: 		 (map (fn [x] (expt 10 x)) (range 7)) )))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: ; Problem 79
rlm@1: (reduce domain-expand-contract [""] logins)
rlm@1: 
rlm@1: )
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: