changeset 6:b8bbb0dbda7b

merging
author Robert McIntyre <rlm@mit.edu>
date Thu, 01 Mar 2012 05:55:59 -0700
parents fca75c0e8f40 (diff) 8565803376a4 (current diff)
children b4395ca99822
files src/rlm/function_utils.clj src/rlm/rlm_commands.clj
diffstat 9 files changed, 415 insertions(+), 213 deletions(-) [+]
line wrap: on
line diff
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/readme.txt	Thu Mar 01 05:55:59 2012 -0700
     1.3 @@ -0,0 +1,2 @@
     1.4 +these are various special commands in clojure
     1.5 +that are near and dear to my heart
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/fanfiction/stories.clj	Thu Mar 01 05:55:59 2012 -0700
     2.3 @@ -0,0 +1,196 @@
     2.4 +(ns fanfiction.stories)
     2.5 +
     2.6 +(use 'clojure.java.io)
     2.7 +
     2.8 +(import org.htmlcleaner.HtmlCleaner)
     2.9 +(import org.htmlcleaner.TagNode)
    2.10 +(import java.io.File)
    2.11 +(import java.net.URL)
    2.12 +(use 'clojure.contrib.def)
    2.13 +
    2.14 +(def mlp
    2.15 +  (URL. "http://www.fanfiction.net/cartoon/My_Little_Pony"))
    2.16 +;; It Takes a Village 
    2.17 +;;  http://www.fanfiction.net/s/7490980/1/It_Takes_a_Village 
    2.18 +;;    Reviews:  1058 
    2.19 +;;    Chapters: 17
    2.20 +;; Progress 
    2.21 +;;  http://www.fanfiction.net/s/6982210/1/Progress 
    2.22 +;;    Reviews:  612 
    2.23 +;;    Chapters: 27
    2.24 +;; On a Cross and Arrow 
    2.25 +;;  http://www.fanfiction.net/s/7211729/1/On_a_Cross_and_Arrow 
    2.26 +;;    Reviews:  324 
    2.27 +;;    Chapters: 12
    2.28 +;; Growing Pains 
    2.29 +;;  http://www.fanfiction.net/s/7252679/1/Growing_Pains 
    2.30 +;;    Reviews:  223 
    2.31 +;;    Chapters: 23
    2.32 +;; My Little Pony: FiM The Romancing Quest 
    2.33 +;;  http://www.fanfiction.net/s/7171004/1/My_Little_Pony_FiM_The_Romancing_Quest 
    2.34 +;;    Reviews:  174 
    2.35 +;;    Chapters: 13
    2.36 +;; Don't Let the Sun Catch You Crying 
    2.37 +;;  http://www.fanfiction.net/s/7032385/1/Dont_Let_the_Sun_Catch_You_Crying 
    2.38 +;;    Reviews:  165 
    2.39 +;;    Chapters: 6
    2.40 +
    2.41 +
    2.42 +(def chobits (URL. "http://www.fanfiction.net/anime/Chobits/"))
    2.43 +;; TTTRRRRRRAAAAAAASSSSSSHHHHH!!!!!!!
    2.44 +
    2.45 +(def ccs (URL. "http://www.fanfiction.net/anime/Card_Captor_Sakura/"))
    2.46 +;; Jagged Amber 
    2.47 +;;  http://www.fanfiction.net/s/1348047/1/Jagged_Amber 
    2.48 +;;    Reviews:  4767 
    2.49 +;;    Chapters: 25
    2.50 +;; Misty Dreams 
    2.51 +;;  http://www.fanfiction.net/s/1250008/1/Misty_Dreams 
    2.52 +;;    Reviews:  4460 
    2.53 +;;    Chapters: 27
    2.54 +;; Butterflies 
    2.55 +;;  http://www.fanfiction.net/s/1667519/1/Butterflies 
    2.56 +;;    Reviews:  3029 
    2.57 +;;    Chapters: 36
    2.58 +;; Mischievous Love 
    2.59 +;;  http://www.fanfiction.net/s/1020198/1/Mischievous_Love 
    2.60 +;;    Reviews:  3013 
    2.61 +;;    Chapters: 25
    2.62 +;; Black Wings 
    2.63 +;;  http://www.fanfiction.net/s/2737015/1/Black_Wings 
    2.64 +;;    Reviews:  2822 
    2.65 +;;    Chapters: 23
    2.66 +;; Cherry, My Love 
    2.67 +;;  http://www.fanfiction.net/s/968234/1/Cherry_My_Love 
    2.68 +;;    Reviews:  2612 
    2.69 +;;    Chapters: 26
    2.70 +;; Deeper 
    2.71 +;;  http://www.fanfiction.net/s/4027405/1/Deeper 
    2.72 +;;    Reviews:  2260 
    2.73 +;;    Chapters: 26
    2.74 +;; Through A Looking Glass 
    2.75 +;;  http://www.fanfiction.net/s/2729427/1/Through_A_Looking_Glass 
    2.76 +;;    Reviews:  2009 
    2.77 +;;    Chapters: 9
    2.78 +;; Butterflies: In Spring 
    2.79 +;;  http://www.fanfiction.net/s/2284162/1/Butterflies_In_Spring 
    2.80 +;;    Reviews:  1815 
    2.81 +;;    Chapters: 17
    2.82 +;; The New Trials of Card Captor Sakura and Friends 
    2.83 +;;  http://www.fanfiction.net/s/197453/1/The_New_Trials_of_Card_Captor_Sakura_and_Friends 
    2.84 +;;    Reviews:  1794 
    2.85 +;;    Chapters: 111
    2.86 +;; Ice Queen 
    2.87 +;;  http://www.fanfiction.net/s/1927065/1/Ice_Queen 
    2.88 +;;    Reviews:  1725 
    2.89 +;;    Chapters: 38
    2.90 +;; Crystal Tears 
    2.91 +;;  http://www.fanfiction.net/s/751067/1/Crystal_Tears 
    2.92 +;;    Reviews:  1623 
    2.93 +;;    Chapters: 26
    2.94 +
    2.95 +
    2.96 +(def bible (URL. "http://www.fanfiction.net/book/Bible/"))
    2.97 +;; TTTRRRRRRAAAAAAASSSSSSHHHHH!!!!!!!
    2.98 +
    2.99 +(def dark (URL. "http://www.fanfiction.net/book/His_Dark_Materials/"))
   2.100 +;; TTTRRRRRRAAAAAAASSSSSSHHHHH!!!!!!!
   2.101 +
   2.102 +(def junjo (URL. "http://www.fanfiction.net/anime/Junjo_Romantica/"))
   2.103 +;;The Talk 
   2.104 +;; http://www.fanfiction.net/s/4351277/1/The_Talk 
   2.105 +;;   Reviews:  250 
   2.106 +;;   Chapters: 1
   2.107 +
   2.108 +(def rye (URL. "http://www.fanfiction.net/book/Catcher_in_the_Rye/"))
   2.109 +;; TTTRRRRRRAAAAAAASSSSSSHHHHH!!!!!!!
   2.110 +
   2.111 +
   2.112 +(defn tags-by-name
   2.113 +  [#^TagNode node #^String element]
   2.114 +  (seq (.getElementListByName node element true)))
   2.115 +
   2.116 +(defn-memo parse
   2.117 +  "parse a web page using HtmlCleaner"
   2.118 +  [#^URL url]
   2.119 +  (println "parsing" (.getPath url))
   2.120 +  (if (not (nil? url))
   2.121 +    (.clean (HtmlCleaner.) (input-stream url))))
   2.122 +
   2.123 +(defn attributes
   2.124 +  "get a hash map of the attributes of an element"
   2.125 +  [#^TagNode node]
   2.126 +  (into {} (.getAttributes node)))
   2.127 +
   2.128 +(def fanfiction-base "http://www.fanfiction.net")
   2.129 +
   2.130 +(defn next-fanfiction-url
   2.131 +  "get the next url to visit from the current page we are visiting"
   2.132 +  [#^URL url]
   2.133 +  (let
   2.134 +      [;; extract all links 
   2.135 +       links (tags-by-name (parse url) "a")
   2.136 +       ;; extract the "Next" link
   2.137 +       next-node (first (filter  #(re-matches #".*Next.*" (.getText %)) links))]
   2.138 +    (if (not (nil? next-node))
   2.139 +      
   2.140 +      (URL. (str fanfiction-base
   2.141 +                 ((attributes next-node) "href"))))))
   2.142 +
   2.143 +(defn get-stories [#^URL url]
   2.144 +  (filter
   2.145 +   #(= "z-list" ((attributes %) "class"))
   2.146 +   (tags-by-name (parse url) "div")))
   2.147 +
   2.148 +
   2.149 +(defn story-url [#^TagNode node]
   2.150 +  (str fanfiction-base
   2.151 +       ((attributes
   2.152 +         (first (tags-by-name node "a"))) "href")))
   2.153 +
   2.154 +(defn story-desc [#^TagNode node]
   2.155 +  (.getText (second (tags-by-name node "div"))))
   2.156 +
   2.157 +(defn story-reviews [#^TagNode node]
   2.158 +  (Integer/parseInt
   2.159 +   (get
   2.160 +    (re-matches #".*Reviews: (\d+).*"
   2.161 +                (story-desc node)) 1 "0")))
   2.162 +
   2.163 +(defn story-chapters [#^TagNode node]
   2.164 +  (Integer/parseInt
   2.165 +   (get
   2.166 +    (re-matches #".*Chapters: (\d+).*"
   2.167 +                (story-desc node)) 1 "1")))
   2.168 +
   2.169 +(defn story-title [#^TagNode node]
   2.170 +  (str (.getText (first (tags-by-name node "a")))))
   2.171 +
   2.172 +(defn all-stories [n #^URL start-url]
   2.173 +  (loop [stories []
   2.174 +         index 0
   2.175 +         current-url start-url]
   2.176 +    (let [stories* (concat stories (get-stories current-url))
   2.177 +          next (next-fanfiction-url current-url)]
   2.178 +      (if (and (not= index n)
   2.179 +               (not (nil? next)))
   2.180 +        (do
   2.181 +          (recur stories* (inc index) next))
   2.182 +        stories*))))
   2.183 +
   2.184 +(defn best-stories [n search-limit #^URL start-url]
   2.185 +  (dorun
   2.186 +   (map
   2.187 +    #(println (story-title %) "\n"
   2.188 +              (story-url %) "\n"
   2.189 +              "  Reviews: " (story-reviews %) "\n"
   2.190 +              "  Chapters:" (story-chapters %))
   2.191 +    
   2.192 +    (take n (reverse
   2.193 +             (sort-by
   2.194 +              #(/ (story-reviews %) (inc (story-chapters %)))
   2.195 +              ;;story-reviews
   2.196 +                      (all-stories search-limit start-url)))))))
   2.197 +           
   2.198 +  
   2.199 +  
   2.200 \ No newline at end of file
     3.1 --- a/src/rlm/function_utils.clj	Tue Feb 28 13:26:34 2012 -0600
     3.2 +++ b/src/rlm/function_utils.clj	Thu Mar 01 05:55:59 2012 -0700
     3.3 @@ -8,7 +8,7 @@
     3.4  
     3.5  (def void ::void)
     3.6  
     3.7 -(defn mix 
     3.8 +(defn race
     3.9    "Takes any number of mathematically equal functions with
    3.10     possibly different run-times and returns a function that
    3.11     runs each in a separate thread, returns the result from
    3.12 @@ -23,40 +23,33 @@
    3.13  	 (dorun (map future-cancel futures))
    3.14  	 answer))))
    3.15  
    3.16 -;; (defn mix-threads
    3.17 -;;   " Takes any number of pure functions that take the same arguments and
    3.18 -;;    compute the same value and returns a function that runs each in a separate
    3.19 -;;    thread, returns the result from the first thread which finshes, and cancels 
    3.20 -;;    the other threads. Explicitly uses nasty Threads.
    3.21 -
    3.22 -;;    For example: 
    3.23 -;;    (do
    3.24 -;;    (defn fun1 [] (Thread/sleep 5000) 5)
    3.25 -;;    (defn fun2 [] (Thread/sleep 700000) 5)
    3.26 -;;    (time ((mix fun1 fun2))))
    3.27 -   
    3.28 -;;    Returns: 
    3.29 -;;     | Elapsed time: 5000.66214 msecs
    3.30 -;;    5"
    3.31 -;;   [& functions]
    3.32 -;;   (fn [& args]
    3.33 -;;     (let [result (prof :create-atom (atom void))
    3.34 -;; 	  threads
    3.35 -;; 	   (prof :create-threads (map 
    3.36 -;; 	   (fn [fun] 
    3.37 -;; 	     (Thread. 
    3.38 -;; 	      (fn [] 
    3.39 -;; 		(try (let [answer (apply fun args)]
    3.40 -;; 		       (reset! result answer))
    3.41 -;; 		     (catch Exception _ nil)))))
    3.42 -;; 	   functions))]
    3.43 -      
    3.44 -;;       (prof :start-threads (dorun (map #(.start %) threads)))
    3.45 -;;       (prof :loop (loop []
    3.46 -;; 	(if (=  (deref result) void)
    3.47 -;; 	  (recur)
    3.48 -;; 	  (do (prof :kill-threads (dorun (map #(.stop %) threads)))
    3.49 -;; 	      (prof :return (deref result)))))))))
    3.50 +(defn race-pred
    3.51 +  "Takes any number of mathematically equal functions with possibly
    3.52 +   different run-times and returns a function that runs each in a
    3.53 +   separate thread, and returns the first available result x for
    3.54 +   which (pred x) returns true (or not-valid, if (pred x) returns
    3.55 +   false on all the results).  Cancels the other threads upon
    3.56 +   returning early."
    3.57 +  {:author "Robert McIntyre"}
    3.58 +  ([pred not-valid & functions]
    3.59 +     (fn [& args]
    3.60 +       (let [result (promise)
    3.61 +             latch (java.util.concurrent.CountDownLatch.
    3.62 +                    (count functions))
    3.63 +             failure-case (future (.await latch)
    3.64 +                                  (deliver result not-valid))
    3.65 +	     futures
    3.66 +             (doall
    3.67 +              (cons failure-case
    3.68 +                    (for [fun functions]
    3.69 +                      (future
    3.70 +                        (let [answer? (apply fun args)]
    3.71 +                          (if (pred answer?)
    3.72 +                            (deliver result answer?)
    3.73 +                            (.countDown latch)))))))
    3.74 +	     answer @result]
    3.75 +	 (dorun (map future-cancel futures))
    3.76 +	 answer))))
    3.77  
    3.78  (defmacro defmix
    3.79    " Defines a function from any number of pure functions that take the same 
     4.1 --- a/src/rlm/light_base.clj	Tue Feb 28 13:26:34 2012 -0600
     4.2 +++ b/src/rlm/light_base.clj	Thu Mar 01 05:55:59 2012 -0700
     4.3 @@ -162,9 +162,6 @@
     4.4      cos exp log pow rint sin tan]]
     4.5     [functor :only [fmap]]]
     4.6   
     4.7 - '[matchure :only [fn-match defn-match if-match when-match cond-match]]
     4.8 - 
     4.9 - 
    4.10  ;; '[letd :only [with-separator display-local-bindings letd]]
    4.11   
    4.12   '[clojure
     5.1 --- a/src/rlm/meditations.clj	Tue Feb 28 13:26:34 2012 -0600
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,155 +0,0 @@
     5.4 -(ns rlm.meditations)
     5.5 -
     5.6 -(defn ten-times
     5.7 -  "Why do people have to argue so much?  I feel so alone and
     5.8 -   angry. Clojure helps me to calm down.  Just today I went to pour
     5.9 -   house, and al through the walk, there was so much negativity.  Most
    5.10 -   of this comes from Mike, I think.  He himself feels insecure
    5.11 -   because Duncan and Acrefoot were talking about inodes and he didn't
    5.12 -  know what they were.  Duncan was talking about a ray tracer which
    5.13 -  would be able to cmompute new frames in real time.  I thought that
    5.14 -  sounded neat, but I don't think 20 cores would be enough to really
    5.15 -  get it right..  You probably need a whole separate computer
    5.16 -  archeticture to actualy do it, like the ray tracing FPGA setup that
    5.17 -  some peoplle in 6.375 made last semester. When we gmade it to Pour
    5.18 -  House, there seemed to be some event going on.  We went downstairs
    5.19 -  and found that it was Amnesty International, MIT division, holding a
    5.20 -  petition for the conditional release of some journalists from
    5.21 -  somewhere.  The girl wwho introduced us to the program was drunk.
    5.22 -  There were no tables,  bbut the bar was mostly empty.  I suggested
    5.23 -  to Mike that we might sit at the bar, but he said that that would
    5.24 -  kill the experience for him since then we would be unable to talk to
    5.25 -  everyone eexcept those next to us.  Then he told me that If I wanted
    5.26 -  t sit down that I could just do that.  He was saying that I didn't
    5.27 -  care about anything but food and that it woI wasn't really part of
    5.28 -  the group anyway, so it was really just up to me wherever I wanted
    5.29 -  to sit.  I found this to be very cruel and was sad.  He didn't even
    5.30 -  realize that he made me sad, which means he can't put himself in my
    5.31 -  shoes even a bit.  Then he got into an argument with acrefoot about
    5.32 -  whether there was a croud above us or not.  Acrefood had not
    5.33 -  nnoticed the croud when we walked in, so he thought we might go up
    5.34 -  thereand see if we could get a table.  Mike kept arguing about which
    5.35 -  way was the front or back of the store because he didn't remember
    5.36 -  the orientation of the upper level after we walked down the stairs.
    5.37 -  ThBoth men were missing something that the other knew, but the
    5.38 -  difference between acrefoot and Mike was that Mike in every word he
    5.39 -  said was trying to put acrefoot down and belittle his intelligence
    5.40 -  by arguing with him, while acrefoot tried to explain which way was
    5.41 -  the front many times whithout changing the subject.  Finally
    5.42 -  acrefoot found out about the croud, but by that time, he was
    5.43 -  upsetand wanted to go up to the upper level anyway just to get away
    5.44 -  from Mike.  I wanted to go too and said so.  Mike dismissively said
    5.45 -  that it was OK to go up if we wanted, and I started to follow
    5.46 -  acrefoot to the stairs.  But then acrefoot asked Chris if he wanted
    5.47 -  to go with him.  Am I invisible or something?  Acrefood did not mean
    5.48 -  this out of malice, he just literally din't see me  and so asked
    5.49 -  chris.  Still, this made me feel bad because I was already feeling
    5.50 -  bad. Acrefoot and I went upstairs and found that the croud which was
    5.51 -  there prevented us from getting a seat.  We went back down and there
    5.52 -  was Mike, sitting at a table that had just cleared.  People started
    5.53 -  to sit down at the table, and then Duncan sat next to Mike and
    5.54 -  l positioned his body in such a way that he took up the remainder of
    5.55 -  the three person booth seat.  Yen-yu told him to move but he acted
    5.56 -  like he couldn't hear her.  I was standing right next to him and
    5.57 -  obviously (to me and most people) wating for my seat, but he would
    5.58 -  not move.  This is Duncan being his normal mildly-autustic self.  I
    5.59 -  can't blame him for it, as he just gets so focoused sometimes that
    5.60 -  he doesn't know how to deal with people.  I have some of the same
    5.61 -  problems.  I like Duncan, but what he did made me feel sad even
    5.62 -  more, because I was already feeling upset at his point.  With three
    5.63 -  random acts of meanness and inconsiderateness behind me and nothing
    5.64 -  that good to look forward to, I just left.  I didn't feel like
    5.65 -  talking to anyone anymore, but wanted to be by myself. I hate how
    5.66 -  Mike dismisses me, how his personality is alined to casual meanness,
    5.67 -  and how  he doesn't even have enough self reflection to know when he
    5.68 -  is hurting others.  I hope that he matures more and becomes a very
    5.69 -  nice person, but I worry about him.  I think I think about him too
    5.70 -  much..  I'm becomming more widthdrawsn from interacting with these
    5.71 -  nerds with half-baked social programming.  It's hard living with
    5.72 -  people who can casually just ithrow insults at you  that would
    5.73 -  demand a fight anywhere else.  Where people can ignore you if they
    5.74 -  think you're less intelligent than they are.  I don't like it on
    5.75 -  tetazoo.  I don't like myself, and I don't like the people here, so
    5.76 -  what am I supposed to do? I have to learn to deal or remove myself
    5.77 -  from this situation. I think I'd be sad if I was all alone, though.
    5.78 -  I left the resturant.  I just didn't want to talk t o anyone
    5.79 -  anymore.  I wanted to be alone.  I whish Dylan was here, or even
    5.80 -  anothere copy of myself to talk to.  I'm so lonely..  They've gotten
    5.81 -  into my head.  When I type that last sentence, I hear \"oh, the poor
    5.82 -  buy is sad, no one loves him.  you're not good enough to be loved.\"
    5.83 -  That part of me is not helpful.  It's echos of people being mean to
    5.84 -  me in the past.  If I was here to talk to, what would I say?  I
    5.85 -  would say, 'what's stopping you from just finding a new life, or
    5.86 -  just being they type of person that people like and who gets along
    5.87 -  wwith everyone?
    5.88 -  I'd like to do this but it's so hard to just do a 180 on my
    5.89 -  emotions..  As I was walking down the street, I overheard arguing
    5.90 -  people and happy people in equal measure.  At the time all I
    5.91 -  processed were the angry , arguing people, but the goodness was
    5.92 -  there too.  So, it's just a matter of who you hang out with? Maybe
    5.93 -  the clojure community can be ,y community? At least I have one good
    5.94 -  friend in Pablo.  Dylan is good but he's far away and has a mountain
    5.95 -  of his owwn problems he has to work through before he can do
    5.96 -  anything with me..I feel lame, because I've been around critical
    5.97 -  people for too long. I want to change, become more affable, but I
    5.98 -  don't know how. What should I do now? I think I'll go swimming.
    5.99 -  But, I don't think they'll let me actually go.  I loaned my ID card
   5.100 -  to pablo.
   5.101 -   This is an experiment in nested closures that makes a function that
   5.102 -   must be called ten times to yield its value. It reminds me of
   5.103 -   taylor aproximations to a sin wave, which are only accurate for a
   5.104 -   finite stretch of the reals, but that stretch can be made as long
   5.105 -   as you want by adding more terms."
   5.106 -  []
   5.107 -  (let [count 10
   5.108 -	return (fn return [n]
   5.109 -		 (if (= n 0) "the end"
   5.110 -		     (fn [] (return (dec n)))))]
   5.111 -    (return (dec count))))
   5.112 -
   5.113 -(defn onion [f n] (if (zero? n) f (recur (fn[]f) (dec n))))
   5.114 -
   5.115 -(defn onion++[f n] (if (zero? n) f (recur (fn[& _]f) (dec n))))
   5.116 -
   5.117 -(defn onion+ [f n] (reduce (fn [f _] (fn [] f)) f (range n)))
   5.118 -
   5.119 -(defn onion-n [n f] (onion f n))
   5.120 -
   5.121 -
   5.122 -(defn ttt [f & knocks]
   5.123 -  (
   5.124 -  (cond (empty? knocks) f
   5.125 -	(
   5.126 -
   5.127 -
   5.128 -(defn onion++ [f & knocks]
   5.129 -  (let[forever-onion (fn g[& _]g)]
   5.130 -    (reduce (fn [g knock]
   5.131 -	      (fn[& args] (if (=(first args) knock) g forever-onion)))
   5.132 -	    f knocks)))
   5.133 -
   5.134 -
   5.135 -
   5.136 -(defn treasure
   5.137 -  ([X n]
   5.138 -     (fn[& args]
   5.139 -       (let [k (count args)]
   5.140 -       (cond
   5.141 -	(< k n) (println "It's to your right!")
   5.142 -	(> k n) (println "It's to your left!")
   5.143 -	(= k n) (do (println "Apply force here to dig!") (delay X))))))
   5.144 -  ([X n & ns]
   5.145 -     (apply treasure (treasure X n) ns)))
   5.146 -
   5.147 -
   5.148 -(def X (treasure "I'm treasure!" 5 3 2 6))
   5.149 -(defn soln []
   5.150 -  (force ((force ((force ((force (X 1 1 1 1 1 1 ))1 1  )) 1 1 1)) 1 1 1 1 1 ) ))
   5.151 -
   5.152 -
   5.153 -(defn onion* [f n]
   5.154 -  (if (zero? n)
   5.155 -    f
   5.156 -    (fn [] (onion* f (dec n)))))
   5.157 -
   5.158 -
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/rlm/qotd.clj	Thu Mar 01 05:55:59 2012 -0700
     6.3 @@ -0,0 +1,167 @@
     6.4 +(ns rlm.qotd)
     6.5 +
     6.6 +;;; There is a pair of integers, 1 < m < n, whose sum is
     6.7 +;;; less than 100.
     6.8 +
     6.9 +;; These constraints makes a triangular sort of pattern.
    6.10 +(defn generate-valid-numbers
    6.11 +  [n]
    6.12 +  (filter (fn [[a b]]  (< a b))
    6.13 +          (map #(vector % n) (range 2 (- 150 n)))))
    6.14 +
    6.15 +(def squish (partial reduce concat))
    6.16 +
    6.17 +(def p0 (squish (map generate-valid-numbers (range 2 149))))
    6.18 +
    6.19 +;;; Person S knows their sum, but nothing else about them.
    6.20 +;;; Person P knows their product, but nothing else about
    6.21 +;;; them.
    6.22 +
    6.23 +;;; Now, Persons S and P know the above information, and
    6.24 +;;; each one knows that the other one knows it. They have
    6.25 +;;; the following conversation:
    6.26 +
    6.27 +;;; P: I can't figure out what the numbers are.
    6.28 +
    6.29 +;; Eliminate pairs with a unique product.
    6.30 +
    6.31 +(defn group-by
    6.32 +  "Split coll into groups where the f maps each element in a
    6.33 +  group to the same value in O(n*log(n)) time."
    6.34 +  [f coll]
    6.35 +  (partition-by f (sort-by f coll)))
    6.36 +
    6.37 +(defn unique-by
    6.38 +  "Remove all elements a,b of coll that for which
    6.39 +   (= (f a) (f b)) in O(n*log(n)) time."
    6.40 +  [f coll]
    6.41 +  (squish (filter #(= (count %) 1) (group-by f coll))))
    6.42 +  
    6.43 +(defn multiple-by
    6.44 +  "Keep all elements a,b of coll for which
    6.45 +   (= (f a) (f b)) in O(n*log(n)) time."
    6.46 +  [f coll]
    6.47 +  (squish (filter #(> (count %) 1) (group-by f coll))))
    6.48 +
    6.49 +(defn prod [[a b]] (* a b))
    6.50 +
    6.51 +(def p1 (multiple-by prod p0))
    6.52 +
    6.53 +;;; S: I was sure you couldn't.
    6.54 +
    6.55 +;; Each possible sum s has a set of possible pairs [a b]
    6.56 +;; where (= s (+ a b)). Partition p0 (since S *was* sure) by
    6.57 +;; sum, and keep those pairs that belong in partitions where
    6.58 +;; each pair in that partition is in p1. (since the only way
    6.59 +;; he could be *sure*, is if every possibility for a given
    6.60 +;; sum had an ambiguous product.
    6.61 +
    6.62 +(defn sum [[a b]] (+ a b))
    6.63 +
    6.64 +(def p2
    6.65 +  (squish
    6.66 +   (filter
    6.67 +    (partial every? (set p1))
    6.68 +    (group-by sum p0))))
    6.69 +
    6.70 +
    6.71 +;;; P: Then I have.
    6.72 +
    6.73 +;; Keep those pairs that have a unique product out of the
    6.74 +;; ones that are left.
    6.75 +
    6.76 +(def p3
    6.77 +  (unique-by prod p2))
    6.78 +
    6.79 +
    6.80 +;;; S: Then I have, too.
    6.81 +
    6.82 +;; Keep those pairs that have a unique sum out of the
    6.83 +;; ones that are left.
    6.84 +
    6.85 +(def p4 (unique-by sum p3))
    6.86 +
    6.87 +
    6.88 +(defn solve [limit]
    6.89 +  (let [generate-valid-numbers
    6.90 +        (fn 
    6.91 +          [n]
    6.92 +          (filter (fn [[a b]]  (< a b))
    6.93 +                  (map #(vector % n)
    6.94 +                       (range 2 (- limit n)))))
    6.95 +        p0
    6.96 +        (squish (map generate-valid-numbers
    6.97 +                     (range 2 (dec limit))))
    6.98 +        p2
    6.99 +        (squish
   6.100 +         (filter
   6.101 +          (partial every? (set p1))
   6.102 +            (group-by sum p0)))
   6.103 +
   6.104 +        p3 (unique-by prod p2)]
   6.105 +    (unique-by sum p3)))
   6.106 +
   6.107 +;;; Dylan START!
   6.108 +(defn results [beez]
   6.109 +  (let
   6.110 +      [
   6.111 +       pairs
   6.112 +       (for [m (range 2 beez)
   6.113 +             n (range (inc m) beez)]
   6.114 +         [m n])
   6.115 +       
   6.116 +       singleton? (comp zero? dec count)
   6.117 +
   6.118 +       sum (fn [[x y]] (+ x y))
   6.119 +       product (fn [[x y]] (* x y))
   6.120 +
   6.121 +       inverse-sum
   6.122 +       (fn [s]
   6.123 +         (filter #(= s (sum %)) pairs))
   6.124 +       
   6.125 +       inverse-product
   6.126 +       (fn [p]
   6.127 +         (filter #(= p (product %)) pairs))
   6.128 +       ] 
   6.129 +
   6.130 +    
   6.131 +    (->>
   6.132 +     pairs
   6.133 +     
   6.134 +     (filter #(< (sum %) beez))
   6.135 +
   6.136 +     ;; P: I cannot find the numbers.
   6.137 +     (remove (comp singleton?
   6.138 +                   inverse-product
   6.139 +                   product))
   6.140 +     set
   6.141 +     
   6.142 +     ;; S: I was sure you couldn't.
   6.143 +     ((fn [coll]
   6.144 +        (filter
   6.145 +         (comp (partial every? coll)
   6.146 +               inverse-sum
   6.147 +               sum)
   6.148 +         coll)))
   6.149 +     set
   6.150 +
   6.151 +     ;;P: Then I have.
   6.152 +     ((fn [coll]
   6.153 +        (filter
   6.154 +         (comp singleton?
   6.155 +               (partial filter coll)
   6.156 +               inverse-product
   6.157 +               product)
   6.158 +         coll)))
   6.159 +     set
   6.160 +     
   6.161 +     ;;S: Then I have, too.
   6.162 +     ((fn [coll]
   6.163 +        (filter
   6.164 +         (comp singleton?
   6.165 +               (partial filter coll)
   6.166 +               inverse-sum
   6.167 +               sum)
   6.168 +         coll)))
   6.169 +
   6.170 +     )))
   6.171 \ No newline at end of file
     7.1 --- a/src/rlm/quick.clj	Tue Feb 28 13:26:34 2012 -0600
     7.2 +++ b/src/rlm/quick.clj	Thu Mar 01 05:55:59 2012 -0700
     7.3 @@ -30,7 +30,6 @@
     7.4       [map-utils :only [map-keys map-vals filter-keys filter-vals]]
     7.5       [decorators :only [preserve-meta]]]
     7.6  
     7.7 -   '[matchure :only [fn-match defn-match if-match when-match cond-match]]
     7.8    
     7.9     '[clojure.contrib
    7.10       [combinatorics :only [cartesian-product subsets selections
     8.1 --- a/src/rlm/rlm_commands.clj	Tue Feb 28 13:26:34 2012 -0600
     8.2 +++ b/src/rlm/rlm_commands.clj	Thu Mar 01 05:55:59 2012 -0700
     8.3 @@ -2,7 +2,6 @@
     8.4    (:use rlm.ns-rlm)
     8.5    (:use clojure.java.javadoc))
     8.6  
     8.7 -
     8.8  ;; (defn current-directory [] (ds/file-str "/home/r/mobius"))
     8.9  
    8.10  ;; (defn file-re [regex & {:keys [dir recurse] :or
    8.11 @@ -69,16 +68,18 @@
    8.12  ;; (defn keymap-normal []
    8.13  ;;   (rlm.shell-write/sw "xmodmap" "/home/r/.xmodmap.normal"))
    8.14  
    8.15 -;; (defn rlm []
    8.16 -;;   (clojure.core/require 'rlm.light-base)
    8.17 -;;   (rlm.ns-rlm/ns-clone rlm.light-base))
    8.18 -
    8.19 +(defn javadoc [target]
    8.20 +  (binding
    8.21 +      [clojure.java.browse/*open-url-script*
    8.22 +       "/home/r/proj/repl/get-webpage.pl"]
    8.23 +    (clojure.java.javadoc/javadoc target)))
    8.24 +     
    8.25  (defn help
    8.26    "load a bunch of really useful help functions"
    8.27    []
    8.28    (use
    8.29     '[rlm
    8.30 -     [function-utils :only [mix defmix]]
    8.31 +     [function-utils :only [race race-pred defmix]]
    8.32       [rlm-commands :only
    8.33        [undef ns-reset ns-nuke reload re]]
    8.34       [ns-rlm :only [ls]]
    8.35 @@ -87,7 +88,7 @@
    8.36       ;;[shell-write :only [sw]]
    8.37       ;;[classpath-utils :only [classpath add-to-classpath]]
    8.38       [dreams :only [megadef silence]]
    8.39 -     [map-utils :only [map-keys map-vals filter-keys filter-vals]]
    8.40 +     [map-utils :only [map-keys filter-keys filter-vals]]
    8.41       [visualize :only [visual]]
    8.42       [identify :only [identify]]]
    8.43  
    8.44 @@ -95,16 +96,19 @@
    8.45     
    8.46     ;; TODO find replacement for show
    8.47      '[clojure
    8.48 -      [repl :only [source]]]
    8.49 -    '[clojure.java
    8.50 -      [javadoc :only [javadoc add-local-javadoc]]])
    8.51 -  (clojure.java.javadoc/add-local-javadoc "/home/r/cortex/jme3/dist/javadoc")
    8.52 -  (clojure.java.javadoc/add-local-javadoc "/home/r/roBin/jdk6-docs/docs/api")
    8.53 -  (clojure.java.javadoc/add-local-javadoc 
    8.54 -   "/home/r/roBin/lpsolve-doc/lpsolve.sourceforge.net/5.5/Java/docs/api")
    8.55 -  (clojure.java.javadoc/add-local-javadoc 
    8.56 -   "/home/r/roBin/lpsolve-doc/lpsolve.sourceforge.net/5.5/Java/docs/api")
    8.57 -  
    8.58 +      [repl :only [source]]])
    8.59 +  (clojure.java.javadoc/add-local-javadoc
    8.60 +   "/home/r/proj/jMonkeyEngine3/dist/javadoc")
    8.61 +  (clojure.java.javadoc/add-local-javadoc
    8.62 +   "/home/r/java/jdk6u30-docs/api")
    8.63 +  (clojure.java.javadoc/add-local-javadoc
    8.64 +   "/home/r/java/jdk6u30-docs/jdk/api")
    8.65 +  (clojure.java.javadoc/add-local-javadoc
    8.66 +   "/home/r/java/jdk6u30-docs/jre/api")
    8.67 +  (clojure.java.javadoc/add-local-javadoc
    8.68 +   "/home/r/proj/jmeCapture/docs")
    8.69 +  (clojure.java.javadoc/add-local-javadoc
    8.70 +   "/home/r/java/tritonus.sourceforge.net/apidoc")
    8.71    nil)
    8.72  
    8.73   
     9.1 --- a/src/rlm/visualize.clj	Tue Feb 28 13:26:34 2012 -0600
     9.2 +++ b/src/rlm/visualize.clj	Thu Mar 01 05:55:59 2012 -0700
     9.3 @@ -19,8 +19,7 @@
     9.4  
     9.5  (defmethod visual ImagePlus
     9.6    [image]
     9.7 -  (.show image)
     9.8 -  image)
     9.9 +  (.show image) image)
    9.10      
    9.11  (defmethod visual (class 4)
    9.12    [color]