# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# 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 @@
+
+
+
+
+
+
+
+