view src/clojureDemo/project_euler.clj @ 21:e72220627685 tip

0.002 inch discrepancy with target. going to test anyway
author Robert McIntyre <rlm@mit.edu>
date Mon, 30 Aug 2010 01:19:21 -0400
parents 6d9bdaf919f7
children
line wrap: on
line source

2 (ns clojureDemo.project-euler
4 (:refer-clojure :exclude [+ - / *
5 assoc conj dissoc empty get into seq
6 = < > <= >= zero?
7 ])
9 (:use [clojure.contrib.generic
10 arithmetic
11 collection
12 comparison
13 ])
15 (:use [clojure.contrib
16 combinatorics
17 repl-utils
18 def
19 duck-streams
20 shell-out
21 import-static
22 lazy-seqs
23 logging
24 map-utils
25 math
26 mock
27 monads
28 ns-utils
29 seq-utils
30 function-utils
31 profile
32 str-utils
33 ])
35 (:use [clojure.contrib.pprint :exclude [write]])
37 (:use [clojure.contrib.pprint.examples
38 hexdump
39 json
40 multiply
41 props
42 show-doc
43 xml
44 ])
46 (:import java.io.File)
47 (:import [java.util Calendar Date])
49 )
55 (defn range-sum
56 "calculates the sum of a range. Takes the exact same arguments
57 as clojure.core/range equilivent to (reduce + (range start end step)), but O(1)."
58 ([end]
59 (/ (* end (- end 1) ) 2))
61 ([start end]
62 (- (range-sum end) (range-sum start)))
64 ([start end step]
65 (letfn [(zero-sum [end step] (* step (range-sum 0 (ceil (/ end step)))))]
66 (+ (zero-sum (- end start) step) (* start (int (/ (- end start) step)))))))
70 (defn range-sum-squares
71 "equivalent to (reduce + (map #(expt % 2) (range start end step))),
72 but runs in O(1) time."
73 ([end]
74 (let [n (- end 1)]
75 (- (* (expt n 3) 1/3) ;continous volume
76 (+ (* -1/6 n) (* -1/2 (expt n 2)))))) ;discrete correction
78 ([start end]
79 (- (range-sum-squares end) (range-sum-squares start)))
81 ([start end step]
82 ;; (letfn [(zero-sum-squares [end step]
83 ;; (* step step (range-sum-squares 0 (ceil (/ end step)))))]
84 ;; (+
85 ;; (* 2 step (range-sum (ceil (/ (- end start) step))))
86 ;; (zero-sum end step)
87 ;; (* start start (int (/ (- end start) step)))))))
88 ))
91 (defn prime-factors
92 "all the prime factors of the number n"
93 [n]
94 (filter #(= 0 (rem n %)) (for [p primes :while (<= p n)] p)))
96 (defn factor? [a b] (= 0 (rem a b)))
98 (defn factor-map [a b]
99 (if (factor? a b)
100 {b (quot a b)}
101 nil))
104 (defn divides? [numerator divisor] (= (rem numerator divisor) 0))
107 (def != (comp not =))
110 (defn decompose [number factor]
111 (loop [n number counter 0]
112 (if (!= (rem n factor) 0)
113 counter
114 (recur (/ n factor) (inc counter)))))
122 (defn single-factor [{num :current-num index :prime-index factors :prime-factors :as old-state}]
123 (let [divisor (nth primes index)
124 new-index (inc index)
125 done? (= num 1)]
126 (if (divides? num divisor)
127 (let [new-num (/ num (expt divisor (decompose num divisor)))
128 factors (assoc factors divisor (decompose num divisor))]
129 [[factors done?] (assoc old-state
130 :current-num new-num :prime-index new-index :prime-factors factors)])
132 [[factors done?] (assoc old-state
133 :current-num num :prime-index new-index :prime-factors factors)])))
136 (defn wtf "a is not used" [a] (domonad state-m [part single-factor] part))
138 (defn fuck-it []
139 (domonad state-m
140 [[factors done?]
141 (state-m-until second wtf nil)]
143 factors))
145 (defn prime-factor-map [num]
147 (first ((fuck-it) {:prime-factors {}
148 :prime-index 0
149 :current-num num})))
151 (defn prime-factors-monad [num]
152 (sort (keys (prime-factor-map num))))
159 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
160 ;; fun with state monad
161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
164 (defn ++ [{num :num :as world}]
165 (let [num++ (inc num)]
166 [num++ (assoc world :num num++)]))
168 (defn huh? []
169 (with-monad state-m
170 (domonad [x ++
171 y ++]
172 y)))
175 (comment
177 huh?
178 ->
179 ((let [m-bind (fn m-bind-state [mv f]
180 (fn [s]
181 (let [[v ss] (mv s)]
182 ((f v) ss))))]
183 (m-bind
184 ++ (fn [x] ++))) {:num 1})
187 )
190 (defn wordify [n] (cl-format nil "~R" n))
192 (defn british-letter-count-prof [n]
193 (prof :total
194 (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
195 word (prof :wordify (wordify n))
196 word-seq (prof :sequence (seq word))
197 word-filter (prof :filter (filter #(Character/isLetter %) word-seq))
198 word-count (prof :count (count word-filter))
199 answer (prof :add (+ and? word-count))]
200 answer)))
202 (defn british-letter-count-prof2
203 "now this is faster, because it uses string manipulation. go profiling!"
204 [n]
205 (prof :total
206 (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
207 word (prof :wordify (wordify n))
208 word-regex (prof :regex (re-gsub #"[\W-,]" "" word))
210 word-count (prof :count (.length word-regex))
211 answer (prof :add (+ and? word-count))]
212 answer)))
232 ;pseudo code for primes
234 ;fn prime-decomposition
235 ; [n]
236 ; map = {}
237 ;
238 ; for x in primes
239 ; add to map (divide teh fick out n x)
240 ; n = n / prime-factors
241 ; if n == 1 BREAK;
242 ;
243 ;
247 (defn rng [seed]
248 (let [m 259200
249 value (/ (float seed) (float m))
250 next (rem (+ 54773 (* 7141 seed)) m)]
251 [value next]))
254 (defn yeah! []
255 (let [name sequence-m
256 m-bind (:m-bind name)
257 m-result (:m-result name)
258 m-zero (:m-zero name)
259 m-plus (:m-plus name)]
262 (m-bind (range 5) (fn [a] (m-bind [2 3] (fn [b] (m-result (+ a b))))))))
265 (defn ohhhh!! []
267 (let
268 [name state-m
269 m-bind (:m-bind name)
270 m-result (:m-result name) ]
272 (m-bind rng (fn [x1] (m-bind rng (fn [x2] (m-result (+ x1 x2))))))))
276 (defmulti palindrome? class)
278 (defmethod palindrome? (class "string") [a]
279 (= (seq a) (reverse a)))
281 (defmethod palindrome? (class 500) [a]
282 (palindrome? (str a)))
291 (defn circulars
292 "returns a vector of all the circular permutations of a number"
293 [n]
294 (map #(Integer. (apply str %)) (rotations (seq (str n)))))
297 (defn prime-factors
298 [n]
299 (for [a primes :while (<= a n) :when (= (rem n a) 0)] a))
302 (defmethod = [nil java.lang.Integer] [ a b ]
303 false)
307 (def mil 1000000)
308 (def bil 1000000000)
310 (defn primes-under-million [] (apply hash-set (take 78498 primes)))
311 (def primes-under-million (memoize primes-under-million))
314 (defn primes-under-billion [] (apply hash-set (take 664579 primes)))
315 (def primes-under-billion (memoize primes-under-billion))
321 (defn prime? [n] (not (nil? (get (primes-under-billion) n))))
324 (defn circular-memoize
325 "assumes that f is a predicate that takes in a number for which,
326 if the predicate is true for the number, it is also true for all
327 of the circular permutations of the number. Memoizes the result
328 for all circular permutations so as to avoid subsequent computation."
329 [f]
330 (let [mem (atom {})]
331 (fn [n]
332 (if-let [e (find @mem n)]
333 (val e)
334 (let [ret (f n)]
335 (dorun (for [circ (circulars n)]
336 (swap! mem assoc n ret)))
337 ret)))))
339 (defn circularly-prime?
340 [n]
341 (not (some (comp not prime?) (circulars n))))
343 (def circularly-prime? (memoize circularly-prime?))
346 (defmethod = :default [& args]
347 (apply clojure.core/= args))
349 (def logins
350 (map str
351 [319 680 180 690 129 620 762 689 762 318
352 368 710 720 710 629 168 160 689 716 731
353 736 729 316 729 729 710 769 290 719 680
354 318 389 162 289 162 718 729 319 790 680
355 890 362 319 760 316 729 380 319 728 716]))
357 (defn remove-multiples [n]
358 (reduce (fn [a b] (if (= (last a) b) a (conj a b))) [] n))
360 (defn insert [item n vect]
361 (let [split (split-at n vect)]
362 (apply vector (flatten [(first split) item (last split)]))))
364 (defn expand-code [old-code [c b a]]
365 (let [main-length (count old-code)]
366 (for [x (range (inc main-length)) y (range (inc x)) z (range (inc y))]
367 (insert c z (insert b y (insert a x old-code))))))
369 (defn domain-expand-contract [old-domain constraint]
370 (let [new-domain
371 (map remove-multiples
372 (remove-multiples
373 (sort
374 (apply concat
375 (map #(expand-code % constraint) old-domain)))))
376 min-code-length (apply min (map count new-domain)) ]
377 (map #(apply str %) (filter #(= (count %) min-code-length) new-domain))))
378 (def domain-expand-contract (memoize domain-expand-contract))
382 (defn lazy-fibo
383 ([] (concat [0 1] (lazy-fibo 0 1)))
384 ([a b] (let [n (+ a b)] (lazy-seq (cons n (lazy-fibo b n))))))
387 (defn collatz-seq [n]
388 (lazy-seq
389 (cond (= n 1) [1]
390 (even? n) (lazy-seq (cons n (collatz-seq (/ n 2))))
391 (odd? n) (lazy-seq (cons n (collatz-seq (+ 1 (* 3 n))))))))
392 (def collatz-seq (memoize collatz-seq))
396 (defn pythagorean-triple? [a b c]
397 (let [[a b c] (sort [a b c])]
398 (= (+ (* a a) (* b b) ) (* c c))))
401 (defn sum-squares [coll]
402 (reduce + (map #(* % %) coll)))
405 (defn british-letter-count [n]
407 (let [and? (if (and (> n 99) (!= 0 (rem n 100))) 3 0)]
409 (+ and? (count (filter #(Character/isLetter %) (seq (wordify n)))))))
413 (defmacro apply-macro
414 "This is evil. Don't ever use it. It makes a macro behave like a
415 function. Seriously, how messed up is that?
417 Evaluates all args, then uses them as arguments to the macro as with
418 apply.
420 (def things [true true false])
421 (apply-macro and things)
422 ;; Expands to: (and true true false)"
423 [macro & args]
424 (cons macro (flatten (map eval args))))
426 (defn fun1 [] (Thread/sleep 5000) 5)
428 (defn fun2 [] (Thread/sleep 30000) 5)
431 (def naturals (iterate inc 0))
436 (defn race []
437 (let [result (ref nil)
438 threads [(Thread. (fn [] (try
439 (let [answer (fun1)]
440 (dosync (ref-set result answer)))
441 (catch Exception _ nil))))
442 (Thread. (fn [] (try
443 (let [answer (fun2)]
444 (dosync (ref-set result answer)))
445 (catch Exception _ nil))))]]
447 (dorun (map #(.start %) threads))
448 (loop []
449 (if (!= (deref result) nil)
450 (do (dorun (map #(.stop %) threads))
451 (deref result))
452 (recur)))))
460 (defn make-date [year month day] (do (let [date (Calendar/getInstance)] (.set date year month day 0 0) date)))
462 (def jan-1-1901 (make-date 1900 0 1))
464 (defn sunday? [#^java.util.Date date] (re-matches #"^Sun.*" (str date)))
466 (count (filter sunday? (for [a (range 1 40000) date [(.getTime (make-date 1900 0 a)) ] :while (< (.getYear date) 100)] date )))
471 (comment
473 ;; ----------------------------------------------------------------------
474 ;; Answers
475 ;; ----------------------------------------------------------------------
477 ; Problem 1
478 (+ (range-sum 0 1001 3) (range-sum 0 1001 5) (* -1 (range-sum 0 1001 15)))
480 ; Problem 2
481 (reduce + (for [a (filter even? (fibs)) :while (<= a 4000000 )] a))
483 ; Problem 3
484 (apply max (prime-factors 600851475143))
486 ; Problem 4
487 (reduce max (for [a (range 100 1000) b (range 100 1000) :when (palindrome? (* a b))] (* a b)))
489 ; Problem 5
490 (reduce lcm (range 1 21))
492 ; Problem 6
493 (- (expt (range-sum 101) 2) (range-sum-squares 101))
495 ; Problem 7
496 (nth primes 10000)
499 ; Problem 9
500 (reduce * (first (for [a (range 1 1000) b (range 1 a) c [(sqrt (sum-squares [a b]))]
501 :when (= (+ a b c) 1000)] [a b c])))
503 ; Problem 10
504 (reduce + (for [a primes :while (< a 2000000)] a))
510 ; Problem 14
511 (first (reduce (fn [a b] (if (> (count a) (count b)) a b)) [] (map collatz-seq (range 1 mil))))
514 ; Problem 16
515 (reduce + (map #(Character/getNumericValue %) (seq (str (expt 2 1000)))))
517 ; Problem 17
518 (reduce + (map british-letter-count (range 1 1001)))
521 ; Problem 24
522 (nth (lex-permutations [ 0 1 2 3 4 5 6 7 8 9]) (- mil 1))
524 ; Problem 33
525 (reduce * (for [num (range 1 10)
526 den (range 1 10)
527 weird (range 1 10)
528 top [(+ num (* 10 weird))]
529 bottom [(+ weird (* 10 den))]
530 :when (and (> (/ top bottom) 1) (= (/ top bottom) (/ num den)))]
531 (/ bottom top)))
533 ; Problem 35
534 (count (filter circularly-prime? (primes-under-million)))
536 ; Problem 40
537 (let [fff (apply str (take 1030000 naturals))]
538 (reduce * (map #(Character/getNumericValue (nth fff %))
539 (map (fn [x] (expt 10 x)) (range 7)) )))
546 ; Problem 79
547 (reduce domain-expand-contract [""] logins)
549 )