lasercutter: src/clojureDemo/project

comparison src/clojureDemo/project_euler.clj @ 1:6d9bdaf919f7

added clojureDemo source

author	Robert McIntyre <rlm@mit.edu>
date	Fri, 20 Aug 2010 00:32:44 -0400
parents
children

comparison

equal deleted inserted replaced

-:163bf9b2fd13
+:6d9bdaf919f7
+(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)
+)

Mercurial > lasercutter

comparison src/clojureDemo/project_euler.clj @ 1:6d9bdaf919f7