(ns clojureDemo.project-euler

 

 (:refer-clojure :exclude [+ - / * 

 			  assoc conj dissoc empty get into seq

 			  = < > <= >= zero?

 			  ])

 

 (:use [clojure.contrib.generic

 	 arithmetic

 	 collection

 	 comparison

 	 ])

 

 (:use [clojure.contrib

 	 combinatorics

 	 repl-utils

 	 def

 	 duck-streams

 	 shell-out

 	 import-static

 	 lazy-seqs

 	 logging

 	 map-utils

 	 math

 	 mock

 	 monads

 	 ns-utils

          seq-utils

          function-utils

        profile

        str-utils

 	 ])

 

 (:use [clojure.contrib.pprint :exclude [write]])

   

 (:use [clojure.contrib.pprint.examples

 	 hexdump

 	 json

 	 multiply

 	 props

 	 show-doc

 	 xml

 	 ])

 

 (:import java.io.File)

 (:import [java.util Calendar Date])

 

 )

 

 

 

 

 

 (defn range-sum 

   "calculates the sum of a range.  Takes the exact same arguments

   as clojure.core/range equilivent to (reduce + (range start end step)), but O(1)."

   ([end]

      (/ (* end (- end 1) ) 2))

   

   ([start end]

      (- (range-sum end) (range-sum start)))

 

   ([start end step]

      (letfn [(zero-sum [end step] (* step (range-sum 0 (ceil (/ end step)))))]

      (+ (zero-sum (- end start) step) (* start (int (/ (- end start) step)))))))

 

 

 

 (defn range-sum-squares

   "equivalent to (reduce + (map #(expt % 2) (range start end step))), 

    but runs in O(1) time."

   ([end]

      (let [n (- end 1)]

      (- (* (expt n 3) 1/3) ;continous volume

 	(+ (* -1/6 n) (* -1/2 (expt n 2)))))) ;discrete correction

 

    ([start end]

      (- (range-sum-squares end) (range-sum-squares start)))

 

    ([start end step]

       ;; (letfn [(zero-sum-squares [end step]

       ;; 				(* step step (range-sum-squares 0 (ceil (/ end step)))))]

       ;; 	(+ 

       ;; 	 (* 2 step (range-sum (ceil (/ (- end start) step))))

       ;; 	 (zero-sum end step) 

       ;; 	 (* start start (int (/ (- end start) step)))))))

 ))	

 

 

 (defn prime-factors 

   "all the prime factors of the number n"

   [n]

   (filter #(= 0 (rem n %)) (for [p primes :while (<= p n)] p)))

 

 (defn factor? [a b] (= 0 (rem a b)))

 

 (defn factor-map [a b]

   (if (factor? a b) 

 	{b (quot a b)}

 	nil))

 

 

 (defn divides? [numerator divisor] (= (rem numerator divisor) 0))

 

 

 (def != (comp not =))

 

 

 (defn decompose [number factor]

     (loop [n number counter 0]

       (if (!= (rem n factor) 0)

         counter

 	(recur (/ n factor) (inc counter)))))

 

 	

 

 

 

 

 

 (defn single-factor [{num :current-num index :prime-index factors :prime-factors :as old-state}]

   (let [divisor (nth primes index)

 	new-index (inc index)

 	done? (= num 1)]

     (if (divides? num divisor)

       (let [new-num (/ num (expt divisor (decompose num divisor)))   

 	    factors (assoc factors divisor (decompose num divisor))]

 	[[factors done?] (assoc old-state

 		 :current-num new-num :prime-index new-index :prime-factors factors)])

       

       [[factors done?] (assoc old-state 

 	       :current-num num :prime-index new-index :prime-factors factors)])))

       

 

 (defn wtf "a is not used" [a] (domonad state-m [part single-factor] part))

 

 (defn fuck-it [] 

   (domonad state-m 

 	   [[factors done?]

 	    (state-m-until second wtf nil)]

 	   

 	   factors))

 

 (defn prime-factor-map [num]

   

   (first ((fuck-it) {:prime-factors {}

 		     :prime-index 0

 		     :current-num num})))

 

 (defn prime-factors-monad [num]

   (sort (keys (prime-factor-map num))))

 

 

 

 

 

 

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; fun with state monad

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 

 (defn ++ [{num :num :as world}]

   (let [num++ (inc num)]

     [num++ (assoc world :num num++)]))

 

 (defn huh? []

   (with-monad state-m 

     (domonad [x ++

 	      y ++]

 	     y)))

 

 

 (comment 

 

 huh?

 ->

 ((let [m-bind (fn m-bind-state [mv f]

 		(fn [s]

 		  (let [[v ss] (mv s)]

 		    ((f v) ss))))] 

        (m-bind

 	++ (fn [x] ++))) {:num 1})

 

 

 )

 

 

 (defn wordify [n] (cl-format nil "~R" n))

     

 (defn british-letter-count-prof [n]

   (prof :total

   (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))

 	word (prof :wordify (wordify n))

 	word-seq (prof :sequence (seq word))

 	word-filter (prof :filter (filter #(Character/isLetter %) word-seq))

 	word-count (prof :count (count word-filter))

 	answer (prof :add (+ and? word-count))]

     answer)))

 

 (defn british-letter-count-prof2 

 "now this is faster, because it uses string manipulation.  go profiling!"

 [n]

   (prof :total

   (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))

 	word (prof :wordify (wordify n))

 	word-regex (prof :regex (re-gsub #"[\W-,]" "" word))

 	

 	word-count (prof :count (.length word-regex))

 	answer (prof :add (+ and? word-count))]

     answer)))

 

 

    

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 ;pseudo code for primes

 

 ;fn prime-decomposition

 ; [n]

 ; map = {} 

 ; 

 ; for x in primes

 ;   add to map (divide teh fick out n x)

 ;   n = n / prime-factors

 ;   if n == 1 BREAK;

 ;

 ;

 

 

 

 (defn rng [seed]

   (let [m      259200

 	value  (/ (float seed) (float m))

 	next   (rem (+ 54773 (* 7141 seed)) m)]

     [value next]))

 

 

 (defn yeah! []

   (let [name sequence-m 

 	m-bind (:m-bind name) 

 	m-result (:m-result name) 

 	m-zero (:m-zero name) 

 	m-plus (:m-plus name)] 

 

 

     (m-bind (range 5) (fn [a] (m-bind [2 3] (fn [b] (m-result (+ a b))))))))

 

 

 (defn ohhhh!! []

   

   (let 

       [name state-m 

        m-bind (:m-bind name) 

        m-result (:m-result name) ]

     

     (m-bind rng (fn [x1] (m-bind rng (fn [x2] (m-result (+ x1 x2))))))))

 

 

 

 (defmulti palindrome? class)

   

 (defmethod palindrome? (class "string") [a]

   (= (seq a) (reverse a)))

 

 (defmethod palindrome? (class 500) [a]

   (palindrome? (str a)))

 

 

 

 

 

 

 

 

 (defn circulars 

   "returns a vector of all the circular permutations of a number"

   [n]

   (map #(Integer. (apply str %)) (rotations (seq (str n)))))

     

 

 (defn prime-factors

   [n]

   (for [a primes :while (<= a n) :when (= (rem n a) 0)]  a)) 

 

 

 (defmethod = [nil java.lang.Integer] [ a b ]

   false)

 

 

 

 (def mil 1000000)

 (def bil 1000000000)

 

 (defn primes-under-million [] (apply hash-set (take 78498 primes)))

 (def primes-under-million (memoize primes-under-million))

 

 

 (defn primes-under-billion [] (apply hash-set (take 664579 primes)))

 (def primes-under-billion (memoize primes-under-billion))

 

 

 

 

 

 (defn prime? [n] (not (nil? (get (primes-under-billion) n))))

 

 

 (defn circular-memoize 

   "assumes that f is a predicate that takes in a number for which, 

    if the predicate is true for the number, it is also true for all

    of the circular permutations of the number.  Memoizes the result

    for all circular permutations so as to avoid subsequent computation."

   [f]

    (let [mem (atom {})]

     (fn [n]

       (if-let [e (find @mem n)]

         (val e)

         (let [ret (f n)]

 	  (dorun (for [circ (circulars n)]

 		   (swap! mem assoc n ret)))

           ret)))))

 

 (defn circularly-prime?

   [n]

   (not (some (comp not prime?) (circulars n))))

 

 (def circularly-prime? (memoize circularly-prime?))

 

 

 (defmethod = :default  [& args]

   (apply clojure.core/= args))

   

 (def logins 

      (map str

 	  [319 680 180 690 129 620 762 689 762 318

 	   368 710 720 710 629 168 160 689 716 731

 	   736 729 316 729 729 710 769 290 719 680

 	   318 389 162 289 162 718 729 319 790 680

 	   890 362 319 760 316 729 380 319 728 716]))

 

 (defn remove-multiples [n]

   (reduce (fn [a b] (if (= (last a) b) a (conj a b))) [] n))

 

 (defn insert [item n vect]

   (let [split (split-at n vect)]

     (apply vector (flatten [(first split) item (last split)]))))

 

 (defn expand-code [old-code [c b a]]

   (let [main-length (count old-code)]

     (for [x (range (inc main-length)) y (range (inc x)) z (range (inc y))] 

       (insert c z (insert b y (insert a x old-code)))))) 

 

 (defn domain-expand-contract [old-domain constraint]

   (let [new-domain 

 	(map remove-multiples 

 	     (remove-multiples 

 	      (sort 

 	       (apply concat 

 		      (map #(expand-code % constraint) old-domain)))))

 	min-code-length (apply min (map count new-domain)) ]

     (map #(apply str %) (filter #(= (count %) min-code-length) new-domain))))

 (def domain-expand-contract (memoize domain-expand-contract))

 

 

 

 (defn lazy-fibo 

   ([] (concat [0 1] (lazy-fibo 0 1)))

   ([a b] (let [n (+ a b)] (lazy-seq (cons n (lazy-fibo b n))))))

 

 

 (defn collatz-seq [n]  

   (lazy-seq

   (cond (= n 1) [1]

 	(even? n) (lazy-seq (cons n (collatz-seq (/ n 2))))

 	(odd? n)  (lazy-seq (cons n (collatz-seq (+ 1 (* 3 n))))))))

 (def collatz-seq (memoize collatz-seq))

 

 

 

 (defn pythagorean-triple? [a b c]

   (let [[a b c] (sort [a b c])]

     (= (+ (* a a) (* b b) ) (* c c))))

 

 

 (defn sum-squares [coll]

   (reduce +  (map #(* % %) coll)))

 

 

 (defn british-letter-count [n]

   

   (let [and? (if (and (> n 99) (!= 0 (rem n 100))) 3 0)]

 

     (+ and? (count (filter #(Character/isLetter %) (seq (wordify n)))))))

 

 

 

 (defmacro apply-macro

   "This is evil.  Don't ever use it.  It makes a macro behave like a

   function.  Seriously, how messed up is that?

 

   Evaluates all args, then uses them as arguments to the macro as with

   apply.

 

   (def things [true true false])

   (apply-macro and things)

   ;; Expands to:  (and true true false)"

   [macro & args]

   (cons macro (flatten (map eval args))))

 

 (defn fun1 [] (Thread/sleep 5000) 5)

 

 (defn fun2 [] (Thread/sleep 30000) 5)

 

 

 (def naturals (iterate inc 0))

   

 

 

 

 (defn race []

   (let [result (ref nil)

 	threads [(Thread. (fn [] (try 

 				  (let [answer (fun1)] 

 				    (dosync (ref-set result answer)))

 				  (catch Exception _ nil))))

 		 (Thread. (fn [] (try 

 				  (let [answer (fun2)] 

 				    (dosync (ref-set result answer))) 

 				  (catch Exception _ nil))))]]

 	   

     (dorun (map #(.start %) threads))

     (loop []

       (if (!= (deref result) nil)

 	(do (dorun (map #(.stop %) threads))

 	    (deref result))

 	(recur)))))

 

 

 

 

 

 

 

 (defn make-date [year month day] (do (let [date (Calendar/getInstance)] (.set date year month day 0 0) date)))

 

 (def jan-1-1901 (make-date 1900 0 1))

 

 (defn sunday? [#^java.util.Date date] (re-matches #"^Sun.*"  (str  date)))

 

 (count (filter sunday? (for [a (range 1 40000) date [(.getTime (make-date 1900 0 a)) ] :while (< (.getYear date) 100)] date )))

 

 

 

 

 (comment

 

 ;; ----------------------------------------------------------------------

 ;; Answers

 ;; ----------------------------------------------------------------------

 

 ; Problem 1 

 (+ (range-sum 0 1001 3) (range-sum 0 1001 5) (* -1 (range-sum 0 1001 15)))

 

 ; Problem 2

 (reduce + (for [a (filter even? (fibs)) :while (<= a 4000000 )] a))

 

 ; Problem 3

 (apply max (prime-factors 600851475143))

 

 ; Problem 4

 (reduce max (for [a (range 100 1000) b (range 100 1000) :when (palindrome? (* a b))] (* a b)))

 

 ; Problem 5

 (reduce lcm (range 1 21))

 

 ; Problem 6

 (- (expt (range-sum 101) 2) (range-sum-squares 101))

 

 ; Problem 7

 (nth primes 10000)

 

 

 ; Problem 9

 (reduce * (first (for [a (range 1 1000) b (range 1 a) c [(sqrt (sum-squares [a b]))] 

       :when (= (+ a b c) 1000)] [a b c])))

 

 ; Problem 10 

 (reduce + (for [a primes :while (< a 2000000)] a))

 

 

 

 

 

 ; Problem 14

 (first (reduce (fn [a b] (if (> (count a) (count b)) a b)) [] (map collatz-seq (range 1 mil))))

 

 

 ; Problem 16

 (reduce + (map #(Character/getNumericValue %) (seq (str (expt 2 1000)))))

 

 ; Problem 17

 (reduce + (map british-letter-count (range 1 1001)))

 

 

 ; Problem 24

 (nth  (lex-permutations [ 0 1 2 3 4 5 6 7 8 9]) (- mil 1))

 

 ; Problem 33

 (reduce * (for [num (range 1 10) 

       den (range 1  10) 

       weird (range 1 10) 

       top [(+ num (* 10 weird))]

       bottom [(+ weird (* 10 den))]

       :when (and (> (/ top bottom) 1) (= (/ top bottom) (/ num den)))]

   (/ bottom top)))

 

 ; Problem 35

 (count (filter circularly-prime? (primes-under-million)))

 

 ; Problem 40 

 (let [fff (apply str (take 1030000 naturals))] 

   (reduce * (map #(Character/getNumericValue (nth fff %)) 

 		 (map (fn [x] (expt 10 x)) (range 7)) )))

 

 

 

 

 

 

 ; Problem 79

 (reduce domain-expand-contract [""] logins)

 

 )