# HG changeset patch # User Robert McIntyre # Date 1282279190 14400 # Node ID 5ed873917c34aa8d672ecd646f36b6726897500c # Parent 6d9bdaf919f715d32a46a31fc575f3468fd38189 enabled display diff -r 6d9bdaf919f7 -r 5ed873917c34 src/clojureDemo/librlm.clj~ --- a/src/clojureDemo/librlm.clj~ Fri Aug 20 00:32:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -(ns clojureDemo.librlm) - -; (defmethod* - java.lang.Boolean [x] (not x)) - -; (defmethod + [java.lang.Boolean java.lang.Boolean] -; [a b] (or a b)) - -; (defmethod * [java.lang.Boolean java.lang.Boolean] -; [a b] (and a b)) - -; (defmethod / java.lang.Boolean [x] x) diff -r 6d9bdaf919f7 -r 5ed873917c34 src/clojureDemo/project-euler.clj~ --- a/src/clojureDemo/project-euler.clj~ Fri Aug 20 00:32:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ - - -(ns clojureDemo.project-euler) - - -(use 'clojureDemo.rlm) -(rlm-base-load) - -(defn range-sum -"calculates the sum of a range. Takes the exact same arguments - as clojure.core/range" -([end] - (/ (* end (- end 1) ) 2))) - - - diff -r 6d9bdaf919f7 -r 5ed873917c34 src/clojureDemo/project_euler.clj~ --- a/src/clojureDemo/project_euler.clj~ Fri Aug 20 00:32:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,559 +0,0 @@ - -(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.Calendar date] (= 7 (.getDay (.getTime 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) - -) - - - - - - - - - - diff -r 6d9bdaf919f7 -r 5ed873917c34 src/clojureDemo/rlm.clj~ --- a/src/clojureDemo/rlm.clj~ Fri Aug 20 00:32:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,67 +0,0 @@ -(ns clojureDemo.rlm - -(:refer-clojure :exclude [+ - / * - assoc conj dissoc empty get into seq - = < > <= >= zero? - ]) - -(:use [clojure.contrib.generic - arithmetic - collection - comparison - ]) - -(:use [clojure.contrib - accumulators - combinatorics - repl-utils - def - duck-streams - shell-out - import-static - lazy-seqs - logging - map-utils - math - mock - monads - ns-utils - ]) - -(:use [clojure.contrib.pprint :exclude [write]]) - -(:use [clojure.contrib.pprint.examples - hexdump - json - multiply - props - show-doc - xml - ]) - -(:import java.io.File) - - - -) - - - - - - - -(defn rlm-extra-load [] - (use :reload-all - '[ clojureDemo - rlm - project-euler - ])) - - -(defn rlm-switch [] - (in-ns 'rlm) - (rlm-extra-load)) - -(defn switch-rlm [] - (rlm-switch)) diff -r 6d9bdaf919f7 -r 5ed873917c34 src/clojureDemo/sys-utils.clj~ --- a/src/clojureDemo/sys-utils.clj~ Fri Aug 20 00:32:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,49 +0,0 @@ -(ns clojureDemo.sys-utils - -:use [clojure.contrib duck-streams str-utils shell-out] -:import java.io.File -) - - - - -(defn escape-spaces - [string] - (re-gsub #" " (str \-) string)) - - -(defn view - [string] - (seq (char-array string))) - -(defn parent-source [target file] - (File. (str target "/" (.getName (.getParentFile file))"-" (.getName file)))) - - -(defn rsync [file1 file2] - (let [*out* nil] - (sh "rsync" "-avz" (str file1) (escape-spaces(str file2))))) - -(defn shunt-file [target file] - (rsync (str file) (str (parent-source target file)))) - - - -(defn extract-files - [regex source destination] - - (map (partial shunt-file destination) - (filter (comp not nil? (partial re-matches regex) str) (file-seq source)))) - -(defn test-extract - [] - ((partial extract-files #".*\.JPG" - (file-str " /home/r/Desktop/judy_yates_computer_archive/MyDocuments/dallas townhome") - (file-str "/home/r/Desktop/judyates_admin/archive-source-images/")))) - - -(defn judy-jpg-extract - [] - ((partial extract-files #".*\.JPG" - (file-str "/home/r/Desktop/judy_yates_computer_archive") - (file-str "/home/r/Desktop/judyates_admin/archive-source-images/")))) diff -r 6d9bdaf919f7 -r 5ed873917c34 src/clojureDemo/sys_utils.clj~ --- a/src/clojureDemo/sys_utils.clj~ Fri Aug 20 00:32:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,61 +0,0 @@ - -(ns clojureDemo.sys-utils - -(:use [clojure.contrib duck-streams str-utils shell-out]) -(:import java.io.File) -) - - - - -(defn escape-spaces - [string] - (re-gsub #" " (str \-) string)) - - -(defn view - [string] - (seq (char-array string))) - -(defn parent-source [target file] - (File. (str target "/" (.getName (.getParentFile file))"-" (.getName file)))) - - -(defn rsync [file1 file2] - (let [*out* nil] - (sh "rsync" "-avz" (str file1) (escape-spaces(str file2))))) - -(defn shunt-file [target file] - (rsync (str file) (str (parent-source target file)))) - - - -(defn extract-files - [regex source destination] - - (dorun (map (partial shunt-file destination) - (filter (comp not nil? (partial re-matches regex) str) (file-seq source))))) - - -(defn file-count [#^java.io.File file] - (count (file-seq file))) - - - - -(comment - -(defn test-extract - [] - ((partial extract-files #".*\.JPG" - (file-str " /home/r/Desktop/judy_yates_computer_archive/MyDocuments/dallas townhome") - (file-str "/home/r/Desktop/judyates_admin/archive-source-images/")))) - - -(defn judy-jpg-extract - [] - ((partial extract-files #".*\.JPG" - (file-str "/home/r/Desktop/judy_yates_computer_archive") - (file-str "/home/r/Desktop/judyates_admin/archive-source-images/")))) - -) diff -r 6d9bdaf919f7 -r 5ed873917c34 src/laser/.#rasterize.clj --- a/src/laser/.#rasterize.clj Fri Aug 20 00:32:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -r@RLM.3097:1282277171 \ No newline at end of file diff -r 6d9bdaf919f7 -r 5ed873917c34 src/laser/rasterize.clj --- a/src/laser/rasterize.clj Fri Aug 20 00:32:44 2010 -0400 +++ b/src/laser/rasterize.clj Fri Aug 20 00:39:50 2010 -0400 @@ -7,7 +7,7 @@ (import '(java.awt Color BorderLayout)) (import '(ij ImagePlus IJ)) (import '(java.lang Math)) - +(import '(java.awt Graphics2D Panel)) (import '(ij Macro)) (import '(java.io BufferedReader InputStreamReader)) @@ -38,7 +38,30 @@ (def cut_feed 20) (def corner_radius 0) +(defmulti display "Creates a JFrame and displays a buffered image" class) +(defn- makePanel [image] (proxy [Panel] [] (paint [g] (.drawImage g image 0 0 nil)))) + +(defmethod display + BufferedImage [image] + (let [panel (makePanel image) + frame (JFrame. "Oh Yeah!")] + (.add frame panel) + (.pack frame) + (.setVisible frame true ) + (.setSize frame(.getWidth image) (.getHeight image)))) + +(defmethod display + ImagePlus [image] + (display (.getBufferedImage image))) + +(defmethod display + clojure.lang.PersistentHashMap [frame-hash] + (display (frame-hash->bufferedImage frame-hash))) + +(defmethod display + clojure.lang.PersistentArrayMap [frame-hash] + (display (frame-hash->bufferedImage frame-hash))) (defn raster-preamble [] @@ -48,8 +71,6 @@ "M101" "M3 S1"])) - - (defn frame-hash "yields a convienent representation for the pixles in an image. Because of the size of the structvre generated, this must only be used @@ -97,6 +118,14 @@ + + + + + + + +