annotate src/rlm/function_utils.clj @ 1:8565803376a4

upgrading source to work with clojure 1.4
author Robert McIntyre <rlm@mit.edu>
date Tue, 28 Feb 2012 13:26:34 -0600
parents 78a630e650d2
children b8bbb0dbda7b
rev   line source
rlm@0 1 ;; Various Operators on Pure Functions
rlm@0 2 ;;
rlm@0 3 ;; Open source Liscence and all that
rlm@0 4 (ns
rlm@0 5 rlm.function-utils
rlm@0 6 "Collection of Operators on Pure Functions"
rlm@1 7 {:author "Robert McIntyre"})
rlm@0 8
rlm@0 9 (def void ::void)
rlm@0 10
rlm@0 11 (defn mix
rlm@0 12 "Takes any number of mathematically equal functions with
rlm@0 13 possibly different run-times and returns a function that
rlm@0 14 runs each in a separate thread, returns the result from
rlm@0 15 the first thread which finishes, and cancels the other threads."
rlm@0 16 {:author "Robert McIntyre"}
rlm@0 17 ([& functions]
rlm@0 18 (fn [& args]
rlm@0 19 (let [result (promise)
rlm@0 20 futures (doall (for [fun functions]
rlm@0 21 (future (deliver result (apply fun args)))))
rlm@0 22 answer @result]
rlm@0 23 (dorun (map future-cancel futures))
rlm@0 24 answer))))
rlm@0 25
rlm@1 26 ;; (defn mix-threads
rlm@1 27 ;; " Takes any number of pure functions that take the same arguments and
rlm@1 28 ;; compute the same value and returns a function that runs each in a separate
rlm@1 29 ;; thread, returns the result from the first thread which finshes, and cancels
rlm@1 30 ;; the other threads. Explicitly uses nasty Threads.
rlm@0 31
rlm@1 32 ;; For example:
rlm@1 33 ;; (do
rlm@1 34 ;; (defn fun1 [] (Thread/sleep 5000) 5)
rlm@1 35 ;; (defn fun2 [] (Thread/sleep 700000) 5)
rlm@1 36 ;; (time ((mix fun1 fun2))))
rlm@0 37
rlm@1 38 ;; Returns:
rlm@1 39 ;; | Elapsed time: 5000.66214 msecs
rlm@1 40 ;; 5"
rlm@1 41 ;; [& functions]
rlm@1 42 ;; (fn [& args]
rlm@1 43 ;; (let [result (prof :create-atom (atom void))
rlm@1 44 ;; threads
rlm@1 45 ;; (prof :create-threads (map
rlm@1 46 ;; (fn [fun]
rlm@1 47 ;; (Thread.
rlm@1 48 ;; (fn []
rlm@1 49 ;; (try (let [answer (apply fun args)]
rlm@1 50 ;; (reset! result answer))
rlm@1 51 ;; (catch Exception _ nil)))))
rlm@1 52 ;; functions))]
rlm@0 53
rlm@1 54 ;; (prof :start-threads (dorun (map #(.start %) threads)))
rlm@1 55 ;; (prof :loop (loop []
rlm@1 56 ;; (if (= (deref result) void)
rlm@1 57 ;; (recur)
rlm@1 58 ;; (do (prof :kill-threads (dorun (map #(.stop %) threads)))
rlm@1 59 ;; (prof :return (deref result)))))))))
rlm@0 60
rlm@0 61 (defmacro defmix
rlm@0 62 " Defines a function from any number of pure functions that take the same
rlm@0 63 arguments and compute the same value which:
rlm@0 64
rlm@0 65 Runs each in a separate thread.
rlm@0 66 Returns the result from the first thread which finshes.
rlm@0 67 Cancels the other threads.
rlm@0 68
rlm@0 69 Use this whenever you want to combine two pure functions that
rlm@0 70 compute the same thing, but use different algorithms with different
rlm@0 71 run times for various inputs.
rlm@0 72
rlm@0 73 For example:
rlm@0 74 (do
rlm@0 75 (defn fun1 [] (Thread/sleep 5000) 5)
rlm@0 76 (defn fun2 [] (Thread/sleep 700000) 5)
rlm@0 77 (defmix fun3 \"combination of fun1 and fun2\" fun1 fun2)
rlm@0 78 (time (fun3))
rlm@0 79
rlm@0 80 Returns:
rlm@0 81 | Elapsed time: 5000.66214 msecs
rlm@0 82 5"
rlm@0 83
rlm@0 84 {:arglists '([name doc-string? functions*])}
rlm@0 85
rlm@0 86 [name & functions]
rlm@0 87 (let [doc-string (if (string? (first functions)) (first functions) "")
rlm@0 88 functions (if (string? (first functions)) (rest functions) functions)
rlm@0 89 arglists (:arglists (meta (resolve (eval `(quote ~(first functions))))))
rlm@1 90 name (with-meta name
rlm@1 91 (assoc (meta name) :arglists `(quote ~arglists)
rlm@1 92 :doc doc-string))]
rlm@0 93 `(def ~name (mix ~@functions))))
rlm@0 94
rlm@0 95 (defn runonce
rlm@0 96 "Decorator. returns a function which will run only once. Inspired
rlm@0 97 by Halloway's version from lancet."
rlm@0 98 {:author "Robert McIntyre"}
rlm@0 99 [function]
rlm@0 100 (let [sentinel (Object.)
rlm@0 101 result (atom sentinel)]
rlm@0 102 (fn [& args]
rlm@0 103 (locking sentinel
rlm@0 104 (if (= @result sentinel)
rlm@0 105 (reset! result (apply function args))
rlm@0 106 @result)))))
rlm@0 107