Mercurial > rlm

comparison src/rlm/qotd.clj @ 4:12d1367cf1aa

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
updating various utilities
author Robert McIntyre <rlm@mit.edu>
date Thu, 01 Mar 2012 05:47:23 -0700
parents c8e35134bf8e
children
comparison
equal deleted inserted replaced
3:c8e35134bf8e 4:12d1367cf1aa
1 (ns rlm.qotd) 1 (ns rlm.qotd)
2 (rlm.rlm-commands/help)
3 2
4 ;;;There is a pair of integers, 1 < m < n, whose sum is less 3 ;;; There is a pair of integers, 1 < m < n, whose sum is
5 ;;;than 100. 4 ;;; less than 100.
6 5
7 (def pos (fn [a] 6 ;; These constraints makes a triangular sort of pattern.
8 (filter (fn [[a b]] (< a b)) 7 (defn generate-valid-numbers
9 (map #(vector % a) (range 1 (- 100 a)))))) 8 [n]
9 (filter (fn [[a b]] (< a b))
10 (map #(vector % n) (range 2 (- 150 n)))))
10 11
11 (def p0 (reduce concat (map pos (range 2 99)))) 12 (def squish (partial reduce concat))
13
14 (def p0 (squish (map generate-valid-numbers (range 2 149))))
12 15
13 ;;; Person S knows their sum, but nothing else about them. 16 ;;; Person S knows their sum, but nothing else about them.
14 ;;; Person P knows their product, but nothing else about 17 ;;; Person P knows their product, but nothing else about
15 ;;; them. 18 ;;; them.
16 19
17 ;;; Now, Persons S and P know the above information, and each 20 ;;; Now, Persons S and P know the above information, and
18 ;;; one knows that the other one knows it. They have the 21 ;;; each one knows that the other one knows it. They have
19 ;;; following conversation: 22 ;;; the following conversation:
20 23
21 ;;; P: I can't figure out what the numbers are. 24 ;;; P: I can't figure out what the numbers are.
22
23
24 25
25 ;; Eliminate pairs with a unique product. 26 ;; Eliminate pairs with a unique product.
26 27
27 (defn group-by 28 (defn group-by
28 "Split coll into groups where the f maps each element in a 29 "Split coll into groups where the f maps each element in a
32 33
33 (defn unique-by 34 (defn unique-by
34 "Remove all elements a,b of coll that for which 35 "Remove all elements a,b of coll that for which
35 (= (f a) (f b)) in O(n*log(n)) time." 36 (= (f a) (f b)) in O(n*log(n)) time."
36 [f coll] 37 [f coll]
37 (reduce 38 (squish (filter #(= (count %) 1) (group-by f coll))))
38 concat
39 (filter #(= (count %) 1) (group-by f coll))))
40 39
41 (defn multiple-by 40 (defn multiple-by
42 "Keep all elements a,b, a!=b of coll for which 41 "Keep all elements a,b of coll for which
43 (= (f a) (f b)) in O(n*log(n)) time." 42 (= (f a) (f b)) in O(n*log(n)) time."
44 [f coll] 43 [f coll]
45 (reduce 44 (squish (filter #(> (count %) 1) (group-by f coll))))
46 concat
47 (filter #(> (count %) 1) (group-by f coll))))
48 45
49 (defn prod [[a b]] (* a b)) 46 (defn prod [[a b]] (* a b))
50 47
51 (def p1 (multiple-by prod p0)) 48 (def p1 (multiple-by prod p0))
52 49
53 ;;; S: I was sure you couldn't. 50 ;;; S: I was sure you couldn't.
54 51
55 ;; Each possible sum s has a set of possible pairs [a b] 52 ;; Each possible sum s has a set of possible pairs [a b]
56 ;; where (= s (+ a b)). Partition p0 (since he *was* sure) 53 ;; where (= s (+ a b)). Partition p0 (since S *was* sure) by
57 ;; by sum, and keep those pairs that belong in partitions 54 ;; sum, and keep those pairs that belong in partitions where
58 ;; where each pair in that partition is in p1. 55 ;; each pair in that partition is in p1. (since the only way
56 ;; he could be *sure*, is if every possibility for a given
57 ;; sum had an ambiguous product.
59 58
60 (defn sum [[a b]] (+ a b)) 59 (defn sum [[a b]] (+ a b))
61 60
62 (def p2 61 (def p2
63 (reduce 62 (squish
64 concat
65 (filter 63 (filter
66 (partial every? (set p1)) 64 (partial every? (set p1))
67 (group-by sum p0)))) 65 (group-by sum p0))))
68 66
69 67
76 (unique-by prod p2)) 74 (unique-by prod p2))
77 75
78 76
79 ;;; S: Then I have, too. 77 ;;; S: Then I have, too.
80 78
79 ;; Keep those pairs that have a unique sum out of the
80 ;; ones that are left.
81
82 (def p4 (unique-by sum p3))
83
84
85 (defn solve [limit]
86 (let [generate-valid-numbers
87 (fn
88 [n]
89 (filter (fn [[a b]] (< a b))
90 (map #(vector % n)
91 (range 2 (- limit n)))))
92 p0
93 (squish (map generate-valid-numbers
94 (range 2 (dec limit))))
95 p2
96 (squish
97 (filter
98 (partial every? (set p1))
99 (group-by sum p0)))
100
101 p3 (unique-by prod p2)]
102 (unique-by sum p3)))
103
104 ;;; Dylan START!
105 (defn results [beez]
106 (let
107 [
108 pairs
109 (for [m (range 2 beez)
110 n (range (inc m) beez)]
111 [m n])
112
113 singleton? (comp zero? dec count)
114
115 sum (fn [[x y]] (+ x y))
116 product (fn [[x y]] (* x y))
117
118 inverse-sum
119 (fn [s]
120 (filter #(= s (sum %)) pairs))
121
122 inverse-product
123 (fn [p]
124 (filter #(= p (product %)) pairs))
125 ]
126
127
128 (->>
129 pairs
130
131 (filter #(< (sum %) beez))
132
133 ;; P: I cannot find the numbers.
134 (remove (comp singleton?
135 inverse-product
136 product))
137 set
138
139 ;; S: I was sure you couldn't.
140 ((fn [coll]
141 (filter
142 (comp (partial every? coll)
143 inverse-sum
144 sum)
145 coll)))
146 set
147
148 ;;P: Then I have.
149 ((fn [coll]
150 (filter
151 (comp singleton?
152 (partial filter coll)
153 inverse-product
154 product)
155 coll)))
156 set
157
158 ;;S: Then I have, too.
159 ((fn [coll]
160 (filter
161 (comp singleton?
162 (partial filter coll)
163 inverse-sum
164 sum)
165 coll)))
166
167 )))