Mercurial > rlm

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