1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojureDemo/project_euler.clj	Fri Aug 20 00:32:44 2010 -0400
     1.3 @@ -0,0 +1,559 @@
     1.4 +
     1.5 +(ns clojureDemo.project-euler
     1.6 +
     1.7 +(:refer-clojure :exclude [+ - / * 
     1.8 +			  assoc conj dissoc empty get into seq
     1.9 +			  = < > <= >= zero?
    1.10 +			  ])
    1.11 +
    1.12 +(:use [clojure.contrib.generic
    1.13 +	 arithmetic
    1.14 +	 collection
    1.15 +	 comparison
    1.16 +	 ])
    1.17 +
    1.18 +(:use [clojure.contrib
    1.19 +	 combinatorics
    1.20 +	 repl-utils
    1.21 +	 def
    1.22 +	 duck-streams
    1.23 +	 shell-out
    1.24 +	 import-static
    1.25 +	 lazy-seqs
    1.26 +	 logging
    1.27 +	 map-utils
    1.28 +	 math
    1.29 +	 mock
    1.30 +	 monads
    1.31 +	 ns-utils
    1.32 +         seq-utils
    1.33 +         function-utils
    1.34 +       profile
    1.35 +       str-utils
    1.36 +	 ])
    1.37 +
    1.38 +(:use [clojure.contrib.pprint :exclude [write]])
    1.39 +  
    1.40 +(:use [clojure.contrib.pprint.examples
    1.41 +	 hexdump
    1.42 +	 json
    1.43 +	 multiply
    1.44 +	 props
    1.45 +	 show-doc
    1.46 +	 xml
    1.47 +	 ])
    1.48 +
    1.49 +(:import java.io.File)
    1.50 +(:import [java.util Calendar Date])
    1.51 +
    1.52 +)
    1.53 +
    1.54 +
    1.55 +
    1.56 +
    1.57 +
    1.58 +(defn range-sum 
    1.59 +  "calculates the sum of a range.  Takes the exact same arguments
    1.60 +  as clojure.core/range equilivent to (reduce + (range start end step)), but O(1)."
    1.61 +  ([end]
    1.62 +     (/ (* end (- end 1) ) 2))
    1.63 +  
    1.64 +  ([start end]
    1.65 +     (- (range-sum end) (range-sum start)))
    1.66 +
    1.67 +  ([start end step]
    1.68 +     (letfn [(zero-sum [end step] (* step (range-sum 0 (ceil (/ end step)))))]
    1.69 +     (+ (zero-sum (- end start) step) (* start (int (/ (- end start) step)))))))
    1.70 +
    1.71 +
    1.72 +
    1.73 +(defn range-sum-squares
    1.74 +  "equivalent to (reduce + (map #(expt % 2) (range start end step))), 
    1.75 +   but runs in O(1) time."
    1.76 +  ([end]
    1.77 +     (let [n (- end 1)]
    1.78 +     (- (* (expt n 3) 1/3) ;continous volume
    1.79 +	(+ (* -1/6 n) (* -1/2 (expt n 2)))))) ;discrete correction
    1.80 +
    1.81 +   ([start end]
    1.82 +     (- (range-sum-squares end) (range-sum-squares start)))
    1.83 +
    1.84 +   ([start end step]
    1.85 +      ;; (letfn [(zero-sum-squares [end step]
    1.86 +      ;; 				(* step step (range-sum-squares 0 (ceil (/ end step)))))]
    1.87 +      ;; 	(+ 
    1.88 +      ;; 	 (* 2 step (range-sum (ceil (/ (- end start) step))))
    1.89 +      ;; 	 (zero-sum end step) 
    1.90 +      ;; 	 (* start start (int (/ (- end start) step)))))))
    1.91 +))	
    1.92 +
    1.93 +
    1.94 +(defn prime-factors 
    1.95 +  "all the prime factors of the number n"
    1.96 +  [n]
    1.97 +  (filter #(= 0 (rem n %)) (for [p primes :while (<= p n)] p)))
    1.98 +
    1.99 +(defn factor? [a b] (= 0 (rem a b)))
   1.100 +
   1.101 +(defn factor-map [a b]
   1.102 +  (if (factor? a b) 
   1.103 +	{b (quot a b)}
   1.104 +	nil))
   1.105 +
   1.106 +
   1.107 +(defn divides? [numerator divisor] (= (rem numerator divisor) 0))
   1.108 +
   1.109 +
   1.110 +(def != (comp not =))
   1.111 +
   1.112 +
   1.113 +(defn decompose [number factor]
   1.114 +    (loop [n number counter 0]
   1.115 +      (if (!= (rem n factor) 0)
   1.116 +        counter
   1.117 +	(recur (/ n factor) (inc counter)))))
   1.118 +
   1.119 +	
   1.120 +
   1.121 +
   1.122 +
   1.123 +
   1.124 +
   1.125 +(defn single-factor [{num :current-num index :prime-index factors :prime-factors :as old-state}]
   1.126 +  (let [divisor (nth primes index)
   1.127 +	new-index (inc index)
   1.128 +	done? (= num 1)]
   1.129 +    (if (divides? num divisor)
   1.130 +      (let [new-num (/ num (expt divisor (decompose num divisor)))   
   1.131 +	    factors (assoc factors divisor (decompose num divisor))]
   1.132 +	[[factors done?] (assoc old-state
   1.133 +		 :current-num new-num :prime-index new-index :prime-factors factors)])
   1.134 +      
   1.135 +      [[factors done?] (assoc old-state 
   1.136 +	       :current-num num :prime-index new-index :prime-factors factors)])))
   1.137 +      
   1.138 +
   1.139 +(defn wtf "a is not used" [a] (domonad state-m [part single-factor] part))
   1.140 +
   1.141 +(defn fuck-it [] 
   1.142 +  (domonad state-m 
   1.143 +	   [[factors done?]
   1.144 +	    (state-m-until second wtf nil)]
   1.145 +	   
   1.146 +	   factors))
   1.147 +
   1.148 +(defn prime-factor-map [num]
   1.149 +  
   1.150 +  (first ((fuck-it) {:prime-factors {}
   1.151 +		     :prime-index 0
   1.152 +		     :current-num num})))
   1.153 +
   1.154 +(defn prime-factors-monad [num]
   1.155 +  (sort (keys (prime-factor-map num))))
   1.156 +
   1.157 +
   1.158 +
   1.159 +
   1.160 +
   1.161 +
   1.162 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.163 +;; fun with state monad
   1.164 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.165 +
   1.166 +
   1.167 +(defn ++ [{num :num :as world}]
   1.168 +  (let [num++ (inc num)]
   1.169 +    [num++ (assoc world :num num++)]))
   1.170 +
   1.171 +(defn huh? []
   1.172 +  (with-monad state-m 
   1.173 +    (domonad [x ++
   1.174 +	      y ++]
   1.175 +	     y)))
   1.176 +
   1.177 +
   1.178 +(comment 
   1.179 +
   1.180 +huh?
   1.181 +->
   1.182 +((let [m-bind (fn m-bind-state [mv f]
   1.183 +		(fn [s]
   1.184 +		  (let [[v ss] (mv s)]
   1.185 +		    ((f v) ss))))] 
   1.186 +       (m-bind
   1.187 +	++ (fn [x] ++))) {:num 1})
   1.188 +
   1.189 +
   1.190 +)
   1.191 +
   1.192 +
   1.193 +(defn wordify [n] (cl-format nil "~R" n))
   1.194 +    
   1.195 +(defn british-letter-count-prof [n]
   1.196 +  (prof :total
   1.197 +  (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
   1.198 +	word (prof :wordify (wordify n))
   1.199 +	word-seq (prof :sequence (seq word))
   1.200 +	word-filter (prof :filter (filter #(Character/isLetter %) word-seq))
   1.201 +	word-count (prof :count (count word-filter))
   1.202 +	answer (prof :add (+ and? word-count))]
   1.203 +    answer)))
   1.204 +
   1.205 +(defn british-letter-count-prof2 
   1.206 +"now this is faster, because it uses string manipulation.  go profiling!"
   1.207 +[n]
   1.208 +  (prof :total
   1.209 +  (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
   1.210 +	word (prof :wordify (wordify n))
   1.211 +	word-regex (prof :regex (re-gsub #"[\W-,]" "" word))
   1.212 +	
   1.213 +	word-count (prof :count (.length word-regex))
   1.214 +	answer (prof :add (+ and? word-count))]
   1.215 +    answer)))
   1.216 +
   1.217 +
   1.218 +   
   1.219 +
   1.220 +
   1.221 +
   1.222 +
   1.223 +
   1.224 +
   1.225 +
   1.226 +
   1.227 +
   1.228 +
   1.229 +
   1.230 +
   1.231 +
   1.232 +
   1.233 +
   1.234 +
   1.235 +;pseudo code for primes
   1.236 +
   1.237 +;fn prime-decomposition
   1.238 +; [n]
   1.239 +; map = {} 
   1.240 +; 
   1.241 +; for x in primes
   1.242 +;   add to map (divide teh fick out n x)
   1.243 +;   n = n / prime-factors
   1.244 +;   if n == 1 BREAK;
   1.245 +;
   1.246 +;
   1.247 +
   1.248 +
   1.249 +
   1.250 +(defn rng [seed]
   1.251 +  (let [m      259200
   1.252 +	value  (/ (float seed) (float m))
   1.253 +	next   (rem (+ 54773 (* 7141 seed)) m)]
   1.254 +    [value next]))
   1.255 +
   1.256 +
   1.257 +(defn yeah! []
   1.258 +  (let [name sequence-m 
   1.259 +	m-bind (:m-bind name) 
   1.260 +	m-result (:m-result name) 
   1.261 +	m-zero (:m-zero name) 
   1.262 +	m-plus (:m-plus name)] 
   1.263 +
   1.264 +
   1.265 +    (m-bind (range 5) (fn [a] (m-bind [2 3] (fn [b] (m-result (+ a b))))))))
   1.266 +
   1.267 +
   1.268 +(defn ohhhh!! []
   1.269 +  
   1.270 +  (let 
   1.271 +      [name state-m 
   1.272 +       m-bind (:m-bind name) 
   1.273 +       m-result (:m-result name) ]
   1.274 +    
   1.275 +    (m-bind rng (fn [x1] (m-bind rng (fn [x2] (m-result (+ x1 x2))))))))
   1.276 +
   1.277 +
   1.278 +
   1.279 +(defmulti palindrome? class)
   1.280 +  
   1.281 +(defmethod palindrome? (class "string") [a]
   1.282 +  (= (seq a) (reverse a)))
   1.283 +
   1.284 +(defmethod palindrome? (class 500) [a]
   1.285 +  (palindrome? (str a)))
   1.286 +
   1.287 +
   1.288 +
   1.289 +
   1.290 +
   1.291 +
   1.292 +
   1.293 +
   1.294 +(defn circulars 
   1.295 +  "returns a vector of all the circular permutations of a number"
   1.296 +  [n]
   1.297 +  (map #(Integer. (apply str %)) (rotations (seq (str n)))))
   1.298 +    
   1.299 +
   1.300 +(defn prime-factors
   1.301 +  [n]
   1.302 +  (for [a primes :while (<= a n) :when (= (rem n a) 0)]  a)) 
   1.303 +
   1.304 +
   1.305 +(defmethod = [nil java.lang.Integer] [ a b ]
   1.306 +  false)
   1.307 +
   1.308 +
   1.309 +
   1.310 +(def mil 1000000)
   1.311 +(def bil 1000000000)
   1.312 +
   1.313 +(defn primes-under-million [] (apply hash-set (take 78498 primes)))
   1.314 +(def primes-under-million (memoize primes-under-million))
   1.315 +
   1.316 +
   1.317 +(defn primes-under-billion [] (apply hash-set (take 664579 primes)))
   1.318 +(def primes-under-billion (memoize primes-under-billion))
   1.319 +
   1.320 +
   1.321 +
   1.322 +
   1.323 +
   1.324 +(defn prime? [n] (not (nil? (get (primes-under-billion) n))))
   1.325 +
   1.326 +
   1.327 +(defn circular-memoize 
   1.328 +  "assumes that f is a predicate that takes in a number for which, 
   1.329 +   if the predicate is true for the number, it is also true for all
   1.330 +   of the circular permutations of the number.  Memoizes the result
   1.331 +   for all circular permutations so as to avoid subsequent computation."
   1.332 +  [f]
   1.333 +   (let [mem (atom {})]
   1.334 +    (fn [n]
   1.335 +      (if-let [e (find @mem n)]
   1.336 +        (val e)
   1.337 +        (let [ret (f n)]
   1.338 +	  (dorun (for [circ (circulars n)]
   1.339 +		   (swap! mem assoc n ret)))
   1.340 +          ret)))))
   1.341 +
   1.342 +(defn circularly-prime?
   1.343 +  [n]
   1.344 +  (not (some (comp not prime?) (circulars n))))
   1.345 +
   1.346 +(def circularly-prime? (memoize circularly-prime?))
   1.347 +
   1.348 +
   1.349 +(defmethod = :default  [& args]
   1.350 +  (apply clojure.core/= args))
   1.351 +  
   1.352 +(def logins 
   1.353 +     (map str
   1.354 +	  [319 680 180 690 129 620 762 689 762 318
   1.355 +	   368 710 720 710 629 168 160 689 716 731
   1.356 +	   736 729 316 729 729 710 769 290 719 680
   1.357 +	   318 389 162 289 162 718 729 319 790 680
   1.358 +	   890 362 319 760 316 729 380 319 728 716]))
   1.359 +
   1.360 +(defn remove-multiples [n]
   1.361 +  (reduce (fn [a b] (if (= (last a) b) a (conj a b))) [] n))
   1.362 +
   1.363 +(defn insert [item n vect]
   1.364 +  (let [split (split-at n vect)]
   1.365 +    (apply vector (flatten [(first split) item (last split)]))))
   1.366 +
   1.367 +(defn expand-code [old-code [c b a]]
   1.368 +  (let [main-length (count old-code)]
   1.369 +    (for [x (range (inc main-length)) y (range (inc x)) z (range (inc y))] 
   1.370 +      (insert c z (insert b y (insert a x old-code)))))) 
   1.371 +
   1.372 +(defn domain-expand-contract [old-domain constraint]
   1.373 +  (let [new-domain 
   1.374 +	(map remove-multiples 
   1.375 +	     (remove-multiples 
   1.376 +	      (sort 
   1.377 +	       (apply concat 
   1.378 +		      (map #(expand-code % constraint) old-domain)))))
   1.379 +	min-code-length (apply min (map count new-domain)) ]
   1.380 +    (map #(apply str %) (filter #(= (count %) min-code-length) new-domain))))
   1.381 +(def domain-expand-contract (memoize domain-expand-contract))
   1.382 +
   1.383 +
   1.384 +
   1.385 +(defn lazy-fibo 
   1.386 +  ([] (concat [0 1] (lazy-fibo 0 1)))
   1.387 +  ([a b] (let [n (+ a b)] (lazy-seq (cons n (lazy-fibo b n))))))
   1.388 +
   1.389 +
   1.390 +(defn collatz-seq [n]  
   1.391 +  (lazy-seq
   1.392 +  (cond (= n 1) [1]
   1.393 +	(even? n) (lazy-seq (cons n (collatz-seq (/ n 2))))
   1.394 +	(odd? n)  (lazy-seq (cons n (collatz-seq (+ 1 (* 3 n))))))))
   1.395 +(def collatz-seq (memoize collatz-seq))
   1.396 +
   1.397 +
   1.398 +
   1.399 +(defn pythagorean-triple? [a b c]
   1.400 +  (let [[a b c] (sort [a b c])]
   1.401 +    (= (+ (* a a) (* b b) ) (* c c))))
   1.402 +
   1.403 +
   1.404 +(defn sum-squares [coll]
   1.405 +  (reduce +  (map #(* % %) coll)))
   1.406 +
   1.407 +
   1.408 +(defn british-letter-count [n]
   1.409 +  
   1.410 +  (let [and? (if (and (> n 99) (!= 0 (rem n 100))) 3 0)]
   1.411 +
   1.412 +    (+ and? (count (filter #(Character/isLetter %) (seq (wordify n)))))))
   1.413 +
   1.414 +
   1.415 +
   1.416 +(defmacro apply-macro
   1.417 +  "This is evil.  Don't ever use it.  It makes a macro behave like a
   1.418 +  function.  Seriously, how messed up is that?
   1.419 +
   1.420 +  Evaluates all args, then uses them as arguments to the macro as with
   1.421 +  apply.
   1.422 +
   1.423 +  (def things [true true false])
   1.424 +  (apply-macro and things)
   1.425 +  ;; Expands to:  (and true true false)"
   1.426 +  [macro & args]
   1.427 +  (cons macro (flatten (map eval args))))
   1.428 +
   1.429 +(defn fun1 [] (Thread/sleep 5000) 5)
   1.430 +
   1.431 +(defn fun2 [] (Thread/sleep 30000) 5)
   1.432 +
   1.433 +
   1.434 +(def naturals (iterate inc 0))
   1.435 +  
   1.436 +
   1.437 +
   1.438 +
   1.439 +(defn race []
   1.440 +  (let [result (ref nil)
   1.441 +	threads [(Thread. (fn [] (try 
   1.442 +				  (let [answer (fun1)] 
   1.443 +				    (dosync (ref-set result answer)))
   1.444 +				  (catch Exception _ nil))))
   1.445 +		 (Thread. (fn [] (try 
   1.446 +				  (let [answer (fun2)] 
   1.447 +				    (dosync (ref-set result answer))) 
   1.448 +				  (catch Exception _ nil))))]]
   1.449 +	   
   1.450 +    (dorun (map #(.start %) threads))
   1.451 +    (loop []
   1.452 +      (if (!= (deref result) nil)
   1.453 +	(do (dorun (map #(.stop %) threads))
   1.454 +	    (deref result))
   1.455 +	(recur)))))
   1.456 +
   1.457 +
   1.458 +
   1.459 +
   1.460 +
   1.461 +
   1.462 +
   1.463 +(defn make-date [year month day] (do (let [date (Calendar/getInstance)] (.set date year month day 0 0) date)))
   1.464 +
   1.465 +(def jan-1-1901 (make-date 1900 0 1))
   1.466 +
   1.467 +(defn sunday? [#^java.util.Date date] (re-matches #"^Sun.*"  (str  date)))
   1.468 +
   1.469 +(count (filter sunday? (for [a (range 1 40000) date [(.getTime (make-date 1900 0 a)) ] :while (< (.getYear date) 100)] date )))
   1.470 +
   1.471 +
   1.472 +
   1.473 +
   1.474 +(comment
   1.475 +
   1.476 +;; ----------------------------------------------------------------------
   1.477 +;; Answers
   1.478 +;; ----------------------------------------------------------------------
   1.479 +
   1.480 +; Problem 1 
   1.481 +(+ (range-sum 0 1001 3) (range-sum 0 1001 5) (* -1 (range-sum 0 1001 15)))
   1.482 +
   1.483 +; Problem 2
   1.484 +(reduce + (for [a (filter even? (fibs)) :while (<= a 4000000 )] a))
   1.485 +
   1.486 +; Problem 3
   1.487 +(apply max (prime-factors 600851475143))
   1.488 +
   1.489 +; Problem 4
   1.490 +(reduce max (for [a (range 100 1000) b (range 100 1000) :when (palindrome? (* a b))] (* a b)))
   1.491 +
   1.492 +; Problem 5
   1.493 +(reduce lcm (range 1 21))
   1.494 +
   1.495 +; Problem 6
   1.496 +(- (expt (range-sum 101) 2) (range-sum-squares 101))
   1.497 +
   1.498 +; Problem 7
   1.499 +(nth primes 10000)
   1.500 +
   1.501 +
   1.502 +; Problem 9
   1.503 +(reduce * (first (for [a (range 1 1000) b (range 1 a) c [(sqrt (sum-squares [a b]))] 
   1.504 +      :when (= (+ a b c) 1000)] [a b c])))
   1.505 +
   1.506 +; Problem 10 
   1.507 +(reduce + (for [a primes :while (< a 2000000)] a))
   1.508 +
   1.509 +
   1.510 +
   1.511 +
   1.512 +
   1.513 +; Problem 14
   1.514 +(first (reduce (fn [a b] (if (> (count a) (count b)) a b)) [] (map collatz-seq (range 1 mil))))
   1.515 +
   1.516 +
   1.517 +; Problem 16
   1.518 +(reduce + (map #(Character/getNumericValue %) (seq (str (expt 2 1000)))))
   1.519 +
   1.520 +; Problem 17
   1.521 +(reduce + (map british-letter-count (range 1 1001)))
   1.522 +
   1.523 +
   1.524 +; Problem 24
   1.525 +(nth  (lex-permutations [ 0 1 2 3 4 5 6 7 8 9]) (- mil 1))
   1.526 +
   1.527 +; Problem 33
   1.528 +(reduce * (for [num (range 1 10) 
   1.529 +      den (range 1  10) 
   1.530 +      weird (range 1 10) 
   1.531 +      top [(+ num (* 10 weird))]
   1.532 +      bottom [(+ weird (* 10 den))]
   1.533 +      :when (and (> (/ top bottom) 1) (= (/ top bottom) (/ num den)))]
   1.534 +  (/ bottom top)))
   1.535 +
   1.536 +; Problem 35
   1.537 +(count (filter circularly-prime? (primes-under-million)))
   1.538 +
   1.539 +; Problem 40 
   1.540 +(let [fff (apply str (take 1030000 naturals))] 
   1.541 +  (reduce * (map #(Character/getNumericValue (nth fff %)) 
   1.542 +		 (map (fn [x] (expt 10 x)) (range 7)) )))
   1.543 +
   1.544 +
   1.545 +
   1.546 +
   1.547 +
   1.548 +
   1.549 +; Problem 79
   1.550 +(reduce domain-expand-contract [""] logins)
   1.551 +
   1.552 +)
   1.553 +
   1.554 +
   1.555 +
   1.556 +
   1.557 +
   1.558 +
   1.559 +
   1.560 +
   1.561 +
   1.562 +