1.1 --- a/src/rlm/qotd.clj	Wed Jan 18 05:18:57 2012 -0700
     1.2 +++ b/src/rlm/qotd.clj	Thu Mar 01 05:47:23 2012 -0700
     1.3 @@ -1,27 +1,28 @@
     1.4  (ns rlm.qotd)
     1.5 -(rlm.rlm-commands/help)
     1.6  
     1.7 -;;;There is a pair of integers, 1 < m < n, whose sum is less
     1.8 -;;;than 100.
     1.9 +;;; There is a pair of integers, 1 < m < n, whose sum is
    1.10 +;;; less than 100.
    1.11  
    1.12 -(def pos (fn [a]
    1.13 -           (filter (fn [[a b]] (< a b))
    1.14 -                   (map #(vector % a) (range 1 (- 100 a))))))
    1.15 +;; These constraints makes a triangular sort of pattern.
    1.16 +(defn generate-valid-numbers
    1.17 +  [n]
    1.18 +  (filter (fn [[a b]]  (< a b))
    1.19 +          (map #(vector % n) (range 2 (- 150 n)))))
    1.20  
    1.21 -(def p0 (reduce concat (map pos (range 2 99))))
    1.22 +(def squish (partial reduce concat))
    1.23 +
    1.24 +(def p0 (squish (map generate-valid-numbers (range 2 149))))
    1.25  
    1.26  ;;; Person S knows their sum, but nothing else about them.
    1.27  ;;; Person P knows their product, but nothing else about
    1.28  ;;; them.
    1.29  
    1.30 -;;; Now, Persons S and P know the above information, and each
    1.31 -;;; one knows that the other one knows it. They have the
    1.32 -;;; following conversation:
    1.33 +;;; Now, Persons S and P know the above information, and
    1.34 +;;; each one knows that the other one knows it. They have
    1.35 +;;; the following conversation:
    1.36  
    1.37  ;;; P: I can't figure out what the numbers are.
    1.38  
    1.39 -
    1.40 -
    1.41  ;; Eliminate pairs with a unique product.
    1.42  
    1.43  (defn group-by
    1.44 @@ -34,17 +35,13 @@
    1.45    "Remove all elements a,b of coll that for which
    1.46     (= (f a) (f b)) in O(n*log(n)) time."
    1.47    [f coll]
    1.48 -  (reduce
    1.49 -    concat
    1.50 -    (filter #(= (count %) 1) (group-by f coll))))
    1.51 +  (squish (filter #(= (count %) 1) (group-by f coll))))
    1.52    
    1.53  (defn multiple-by
    1.54 -  "Keep all elements a,b, a!=b of coll for which
    1.55 +  "Keep all elements a,b of coll for which
    1.56     (= (f a) (f b)) in O(n*log(n)) time."
    1.57    [f coll]
    1.58 -  (reduce
    1.59 -    concat
    1.60 -    (filter #(> (count %) 1) (group-by f coll))))
    1.61 +  (squish (filter #(> (count %) 1) (group-by f coll))))
    1.62  
    1.63  (defn prod [[a b]] (* a b))
    1.64  
    1.65 @@ -53,15 +50,16 @@
    1.66  ;;; S: I was sure you couldn't.
    1.67  
    1.68  ;; Each possible sum s has a set of possible pairs [a b]
    1.69 -;; where (= s (+ a b)). Partition p0 (since he *was* sure)
    1.70 -;; by sum, and keep those pairs that belong in partitions
    1.71 -;; where each pair in that partition is in p1.
    1.72 +;; where (= s (+ a b)). Partition p0 (since S *was* sure) by
    1.73 +;; sum, and keep those pairs that belong in partitions where
    1.74 +;; each pair in that partition is in p1. (since the only way
    1.75 +;; he could be *sure*, is if every possibility for a given
    1.76 +;; sum had an ambiguous product.
    1.77  
    1.78  (defn sum [[a b]] (+ a b))
    1.79  
    1.80  (def p2
    1.81 -  (reduce
    1.82 -   concat
    1.83 +  (squish
    1.84     (filter
    1.85      (partial every? (set p1))
    1.86      (group-by sum p0))))
    1.87 @@ -78,3 +76,92 @@
    1.88  
    1.89  ;;; S: Then I have, too.
    1.90  
    1.91 +;; Keep those pairs that have a unique sum out of the
    1.92 +;; ones that are left.
    1.93 +
    1.94 +(def p4 (unique-by sum p3))
    1.95 +
    1.96 +
    1.97 +(defn solve [limit]
    1.98 +  (let [generate-valid-numbers
    1.99 +        (fn 
   1.100 +          [n]
   1.101 +          (filter (fn [[a b]]  (< a b))
   1.102 +                  (map #(vector % n)
   1.103 +                       (range 2 (- limit n)))))
   1.104 +        p0
   1.105 +        (squish (map generate-valid-numbers
   1.106 +                     (range 2 (dec limit))))
   1.107 +        p2
   1.108 +        (squish
   1.109 +         (filter
   1.110 +          (partial every? (set p1))
   1.111 +            (group-by sum p0)))
   1.112 +
   1.113 +        p3 (unique-by prod p2)]
   1.114 +    (unique-by sum p3)))
   1.115 +
   1.116 +;;; Dylan START!
   1.117 +(defn results [beez]
   1.118 +  (let
   1.119 +      [
   1.120 +       pairs
   1.121 +       (for [m (range 2 beez)
   1.122 +             n (range (inc m) beez)]
   1.123 +         [m n])
   1.124 +       
   1.125 +       singleton? (comp zero? dec count)
   1.126 +
   1.127 +       sum (fn [[x y]] (+ x y))
   1.128 +       product (fn [[x y]] (* x y))
   1.129 +
   1.130 +       inverse-sum
   1.131 +       (fn [s]
   1.132 +         (filter #(= s (sum %)) pairs))
   1.133 +       
   1.134 +       inverse-product
   1.135 +       (fn [p]
   1.136 +         (filter #(= p (product %)) pairs))
   1.137 +       ] 
   1.138 +
   1.139 +    
   1.140 +    (->>
   1.141 +     pairs
   1.142 +     
   1.143 +     (filter #(< (sum %) beez))
   1.144 +
   1.145 +     ;; P: I cannot find the numbers.
   1.146 +     (remove (comp singleton?
   1.147 +                   inverse-product
   1.148 +                   product))
   1.149 +     set
   1.150 +     
   1.151 +     ;; S: I was sure you couldn't.
   1.152 +     ((fn [coll]
   1.153 +        (filter
   1.154 +         (comp (partial every? coll)
   1.155 +               inverse-sum
   1.156 +               sum)
   1.157 +         coll)))
   1.158 +     set
   1.159 +
   1.160 +     ;;P: Then I have.
   1.161 +     ((fn [coll]
   1.162 +        (filter
   1.163 +         (comp singleton?
   1.164 +               (partial filter coll)
   1.165 +               inverse-product
   1.166 +               product)
   1.167 +         coll)))
   1.168 +     set
   1.169 +     
   1.170 +     ;;S: Then I have, too.
   1.171 +     ((fn [coll]
   1.172 +        (filter
   1.173 +         (comp singleton?
   1.174 +               (partial filter coll)
   1.175 +               inverse-sum
   1.176 +               sum)
   1.177 +         coll)))
   1.178 +
   1.179 +     )))
   1.180 \ No newline at end of file