changeset 4:12d1367cf1aa

updating various utilities
author Robert McIntyre <rlm@mit.edu>
date Thu, 01 Mar 2012 05:47:23 -0700
parents c8e35134bf8e
children fca75c0e8f40
files src/rlm/function_utils.clj src/rlm/qotd.clj src/rlm/rlm_commands.clj src/rlm/visualize.clj
diffstat 4 files changed, 139 insertions(+), 39 deletions(-) [+]
line wrap: on
line diff
     1.1 --- a/src/rlm/function_utils.clj	Wed Jan 18 05:18:57 2012 -0700
     1.2 +++ b/src/rlm/function_utils.clj	Thu Mar 01 05:47:23 2012 -0700
     1.3 @@ -65,7 +65,7 @@
     1.4  )
     1.5  
     1.6  
     1.7 -(defn mix 
     1.8 +(defn race 
     1.9    "Takes any number of mathematically equal functions with
    1.10     possibly different run-times and returns a function that
    1.11     runs each in a separate thread, returns the result from
    1.12 @@ -80,19 +80,30 @@
    1.13  	 (dorun (map future-cancel futures))
    1.14  	 answer))))
    1.15  
    1.16 -(defn mix-pred
    1.17 -  "Takes any number of mathematically equal functions with
    1.18 -   possibly different run-times and returns a function that
    1.19 -   runs each in a separate thread, returns the result from
    1.20 -   the first thread which finishes, and cancels the other threads."
    1.21 +(defn race-pred
    1.22 +  "Takes any number of mathematically equal functions with possibly
    1.23 +   different run-times and returns a function that runs each in a
    1.24 +   separate thread, and returns the first available result x for
    1.25 +   which (pred x) returns true (or not-valid, if (pred x) returns
    1.26 +   false on all the results).  Cancels the other threads upon
    1.27 +   returning early."
    1.28    {:author "Robert McIntyre"}
    1.29 -  ([pred & functions]
    1.30 +  ([pred not-valid & functions]
    1.31       (fn [& args]
    1.32         (let [result (promise)
    1.33 -	     futures (doall (for [fun functions]
    1.34 -                              (let [answer (apply fun args)]
    1.35 -                                (if (pred answer)
    1.36 -                                  (future (deliver result (apply fun args)))))))
    1.37 +             latch (java.util.concurrent.CountDownLatch.
    1.38 +                    (count functions))
    1.39 +             failure-case (future (.await latch)
    1.40 +                                  (deliver result not-valid))
    1.41 +	     futures
    1.42 +             (doall
    1.43 +              (cons failure-case
    1.44 +                    (for [fun functions]
    1.45 +                      (future
    1.46 +                        (let [answer? (apply fun args)]
    1.47 +                          (if (pred answer?)
    1.48 +                            (deliver result answer?)
    1.49 +                            (.countDown latch)))))))
    1.50  	     answer @result]
    1.51  	 (dorun (map future-cancel futures))
    1.52  	 answer))))
     2.1 --- a/src/rlm/qotd.clj	Wed Jan 18 05:18:57 2012 -0700
     2.2 +++ b/src/rlm/qotd.clj	Thu Mar 01 05:47:23 2012 -0700
     2.3 @@ -1,27 +1,28 @@
     2.4  (ns rlm.qotd)
     2.5 -(rlm.rlm-commands/help)
     2.6  
     2.7 -;;;There is a pair of integers, 1 < m < n, whose sum is less
     2.8 -;;;than 100.
     2.9 +;;; There is a pair of integers, 1 < m < n, whose sum is
    2.10 +;;; less than 100.
    2.11  
    2.12 -(def pos (fn [a]
    2.13 -           (filter (fn [[a b]] (< a b))
    2.14 -                   (map #(vector % a) (range 1 (- 100 a))))))
    2.15 +;; These constraints makes a triangular sort of pattern.
    2.16 +(defn generate-valid-numbers
    2.17 +  [n]
    2.18 +  (filter (fn [[a b]]  (< a b))
    2.19 +          (map #(vector % n) (range 2 (- 150 n)))))
    2.20  
    2.21 -(def p0 (reduce concat (map pos (range 2 99))))
    2.22 +(def squish (partial reduce concat))
    2.23 +
    2.24 +(def p0 (squish (map generate-valid-numbers (range 2 149))))
    2.25  
    2.26  ;;; Person S knows their sum, but nothing else about them.
    2.27  ;;; Person P knows their product, but nothing else about
    2.28  ;;; them.
    2.29  
    2.30 -;;; Now, Persons S and P know the above information, and each
    2.31 -;;; one knows that the other one knows it. They have the
    2.32 -;;; following conversation:
    2.33 +;;; Now, Persons S and P know the above information, and
    2.34 +;;; each one knows that the other one knows it. They have
    2.35 +;;; the following conversation:
    2.36  
    2.37  ;;; P: I can't figure out what the numbers are.
    2.38  
    2.39 -
    2.40 -
    2.41  ;; Eliminate pairs with a unique product.
    2.42  
    2.43  (defn group-by
    2.44 @@ -34,17 +35,13 @@
    2.45    "Remove all elements a,b of coll that for which
    2.46     (= (f a) (f b)) in O(n*log(n)) time."
    2.47    [f coll]
    2.48 -  (reduce
    2.49 -    concat
    2.50 -    (filter #(= (count %) 1) (group-by f coll))))
    2.51 +  (squish (filter #(= (count %) 1) (group-by f coll))))
    2.52    
    2.53  (defn multiple-by
    2.54 -  "Keep all elements a,b, a!=b of coll for which
    2.55 +  "Keep all elements a,b of coll for which
    2.56     (= (f a) (f b)) in O(n*log(n)) time."
    2.57    [f coll]
    2.58 -  (reduce
    2.59 -    concat
    2.60 -    (filter #(> (count %) 1) (group-by f coll))))
    2.61 +  (squish (filter #(> (count %) 1) (group-by f coll))))
    2.62  
    2.63  (defn prod [[a b]] (* a b))
    2.64  
    2.65 @@ -53,15 +50,16 @@
    2.66  ;;; S: I was sure you couldn't.
    2.67  
    2.68  ;; Each possible sum s has a set of possible pairs [a b]
    2.69 -;; where (= s (+ a b)). Partition p0 (since he *was* sure)
    2.70 -;; by sum, and keep those pairs that belong in partitions
    2.71 -;; where each pair in that partition is in p1.
    2.72 +;; where (= s (+ a b)). Partition p0 (since S *was* sure) by
    2.73 +;; sum, and keep those pairs that belong in partitions where
    2.74 +;; each pair in that partition is in p1. (since the only way
    2.75 +;; he could be *sure*, is if every possibility for a given
    2.76 +;; sum had an ambiguous product.
    2.77  
    2.78  (defn sum [[a b]] (+ a b))
    2.79  
    2.80  (def p2
    2.81 -  (reduce
    2.82 -   concat
    2.83 +  (squish
    2.84     (filter
    2.85      (partial every? (set p1))
    2.86      (group-by sum p0))))
    2.87 @@ -78,3 +76,92 @@
    2.88  
    2.89  ;;; S: Then I have, too.
    2.90  
    2.91 +;; Keep those pairs that have a unique sum out of the
    2.92 +;; ones that are left.
    2.93 +
    2.94 +(def p4 (unique-by sum p3))
    2.95 +
    2.96 +
    2.97 +(defn solve [limit]
    2.98 +  (let [generate-valid-numbers
    2.99 +        (fn 
   2.100 +          [n]
   2.101 +          (filter (fn [[a b]]  (< a b))
   2.102 +                  (map #(vector % n)
   2.103 +                       (range 2 (- limit n)))))
   2.104 +        p0
   2.105 +        (squish (map generate-valid-numbers
   2.106 +                     (range 2 (dec limit))))
   2.107 +        p2
   2.108 +        (squish
   2.109 +         (filter
   2.110 +          (partial every? (set p1))
   2.111 +            (group-by sum p0)))
   2.112 +
   2.113 +        p3 (unique-by prod p2)]
   2.114 +    (unique-by sum p3)))
   2.115 +
   2.116 +;;; Dylan START!
   2.117 +(defn results [beez]
   2.118 +  (let
   2.119 +      [
   2.120 +       pairs
   2.121 +       (for [m (range 2 beez)
   2.122 +             n (range (inc m) beez)]
   2.123 +         [m n])
   2.124 +       
   2.125 +       singleton? (comp zero? dec count)
   2.126 +
   2.127 +       sum (fn [[x y]] (+ x y))
   2.128 +       product (fn [[x y]] (* x y))
   2.129 +
   2.130 +       inverse-sum
   2.131 +       (fn [s]
   2.132 +         (filter #(= s (sum %)) pairs))
   2.133 +       
   2.134 +       inverse-product
   2.135 +       (fn [p]
   2.136 +         (filter #(= p (product %)) pairs))
   2.137 +       ] 
   2.138 +
   2.139 +    
   2.140 +    (->>
   2.141 +     pairs
   2.142 +     
   2.143 +     (filter #(< (sum %) beez))
   2.144 +
   2.145 +     ;; P: I cannot find the numbers.
   2.146 +     (remove (comp singleton?
   2.147 +                   inverse-product
   2.148 +                   product))
   2.149 +     set
   2.150 +     
   2.151 +     ;; S: I was sure you couldn't.
   2.152 +     ((fn [coll]
   2.153 +        (filter
   2.154 +         (comp (partial every? coll)
   2.155 +               inverse-sum
   2.156 +               sum)
   2.157 +         coll)))
   2.158 +     set
   2.159 +
   2.160 +     ;;P: Then I have.
   2.161 +     ((fn [coll]
   2.162 +        (filter
   2.163 +         (comp singleton?
   2.164 +               (partial filter coll)
   2.165 +               inverse-product
   2.166 +               product)
   2.167 +         coll)))
   2.168 +     set
   2.169 +     
   2.170 +     ;;S: Then I have, too.
   2.171 +     ((fn [coll]
   2.172 +        (filter
   2.173 +         (comp singleton?
   2.174 +               (partial filter coll)
   2.175 +               inverse-sum
   2.176 +               sum)
   2.177 +         coll)))
   2.178 +
   2.179 +     )))
   2.180 \ No newline at end of file
     3.1 --- a/src/rlm/rlm_commands.clj	Wed Jan 18 05:18:57 2012 -0700
     3.2 +++ b/src/rlm/rlm_commands.clj	Thu Mar 01 05:47:23 2012 -0700
     3.3 @@ -95,7 +95,7 @@
     3.4    []
     3.5    (use
     3.6     '[rlm
     3.7 -     [function-utils :only [mix defmix runonce]]
     3.8 +     [function-utils :only [race race-pred defmix]]
     3.9       [rlm-commands :only [undef ns-reset ns-nuke reload keymap-clojure
    3.10                            keymap-normal rlm javadoc]]
    3.11       [ns-rlm :only [ns-clear ns-clone ls]]
    3.12 @@ -104,7 +104,7 @@
    3.13       [shell-write :only [sw]]
    3.14       [classpath-utils :only [classpath add-to-classpath]]
    3.15       [dreams :only [megadef silence]]
    3.16 -     [map-utils :only [map-keys map-vals filter-keys filter-vals]]
    3.17 +     [map-utils :only [map-keys filter-keys filter-vals]]
    3.18       [visualize :only [visual]]
    3.19       [identify :only [identify]]]
    3.20     '[abomination.no-parens :only [quit]]
    3.21 @@ -126,6 +126,9 @@
    3.22     "/home/r/java/jdk6u30-docs/jre/api")
    3.23    (clojure.java.javadoc/add-local-javadoc
    3.24     "/home/r/proj/jmeCapture/docs")
    3.25 +  (clojure.java.javadoc/add-local-javadoc
    3.26 +   "/home/r/java/tritonus.sourceforge.net/apidoc")
    3.27 +
    3.28  
    3.29    nil)
    3.30  
     4.1 --- a/src/rlm/visualize.clj	Wed Jan 18 05:18:57 2012 -0700
     4.2 +++ b/src/rlm/visualize.clj	Thu Mar 01 05:47:23 2012 -0700
     4.3 @@ -19,8 +19,7 @@
     4.4  
     4.5  (defmethod visual ImagePlus
     4.6    [image]
     4.7 -  (.show image)
     4.8 -  image)
     4.9 +  (.show image) image)
    4.10      
    4.11  (defmethod visual (class 4)
    4.12    [color]