Mercurial > rlm

annotate src/rlm/qotd.clj @ 3:c8e35134bf8e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
working on qotd.
author Robert McIntyre <rlm@mit.edu>
date Wed, 18 Jan 2012 05:18:57 -0700
parents
children 12d1367cf1aa
rev   line source
rlm@3 1 (ns rlm.qotd)
rlm@3 2 (rlm.rlm-commands/help)
rlm@3 3
rlm@3 4 ;;;There is a pair of integers, 1 < m < n, whose sum is less
rlm@3 5 ;;;than 100.
rlm@3 6
rlm@3 7 (def pos (fn [a]
rlm@3 8 (filter (fn [[a b]] (< a b))
rlm@3 9 (map #(vector % a) (range 1 (- 100 a))))))
rlm@3 10
rlm@3 11 (def p0 (reduce concat (map pos (range 2 99))))
rlm@3 12
rlm@3 13 ;;; Person S knows their sum, but nothing else about them.
rlm@3 14 ;;; Person P knows their product, but nothing else about
rlm@3 15 ;;; them.
rlm@3 16
rlm@3 17 ;;; Now, Persons S and P know the above information, and each
rlm@3 18 ;;; one knows that the other one knows it. They have the
rlm@3 19 ;;; following conversation:
rlm@3 20
rlm@3 21 ;;; P: I can't figure out what the numbers are.
rlm@3 22
rlm@3 23
rlm@3 24
rlm@3 25 ;; Eliminate pairs with a unique product.
rlm@3 26
rlm@3 27 (defn group-by
rlm@3 28 "Split coll into groups where the f maps each element in a
rlm@3 29 group to the same value in O(n*log(n)) time."
rlm@3 30 [f coll]
rlm@3 31 (partition-by f (sort-by f coll)))
rlm@3 32
rlm@3 33 (defn unique-by
rlm@3 34 "Remove all elements a,b of coll that for which
rlm@3 35 (= (f a) (f b)) in O(n*log(n)) time."
rlm@3 36 [f coll]
rlm@3 37 (reduce
rlm@3 38 concat
rlm@3 39 (filter #(= (count %) 1) (group-by f coll))))
rlm@3 40
rlm@3 41 (defn multiple-by
rlm@3 42 "Keep all elements a,b, a!=b of coll for which
rlm@3 43 (= (f a) (f b)) in O(n*log(n)) time."
rlm@3 44 [f coll]
rlm@3 45 (reduce
rlm@3 46 concat
rlm@3 47 (filter #(> (count %) 1) (group-by f coll))))
rlm@3 48
rlm@3 49 (defn prod [[a b]] (* a b))
rlm@3 50
rlm@3 51 (def p1 (multiple-by prod p0))
rlm@3 52
rlm@3 53 ;;; S: I was sure you couldn't.
rlm@3 54
rlm@3 55 ;; Each possible sum s has a set of possible pairs [a b]
rlm@3 56 ;; where (= s (+ a b)). Partition p0 (since he *was* sure)
rlm@3 57 ;; by sum, and keep those pairs that belong in partitions
rlm@3 58 ;; where each pair in that partition is in p1.
rlm@3 59
rlm@3 60 (defn sum [[a b]] (+ a b))
rlm@3 61
rlm@3 62 (def p2
rlm@3 63 (reduce
rlm@3 64 concat
rlm@3 65 (filter
rlm@3 66 (partial every? (set p1))
rlm@3 67 (group-by sum p0))))
rlm@3 68
rlm@3 69
rlm@3 70 ;;; P: Then I have.
rlm@3 71
rlm@3 72 ;; Keep those pairs that have a unique product out of the
rlm@3 73 ;; ones that are left.
rlm@3 74
rlm@3 75 (def p3
rlm@3 76 (unique-by prod p2))
rlm@3 77
rlm@3 78
rlm@3 79 ;;; S: Then I have, too.
rlm@3 80