Mercurial > rlm

     1 (ns rlm.qotd)

     2 

     3 ;;; There is a pair of integers, 1 < m < n, whose sum is

     4 ;;; less than 100.

     5 

     6 ;; These constraints makes a triangular sort of pattern.

     7 (defn generate-valid-numbers

     8   [n]

     9   (filter (fn [[a b]]  (< a b))

    10           (map #(vector % n) (range 2 (- 150 n)))))

    11 

    12 (def squish (partial reduce concat))

    13 

    14 (def p0 (squish (map generate-valid-numbers (range 2 149))))

    15 

    16 ;;; Person S knows their sum, but nothing else about them.

    17 ;;; Person P knows their product, but nothing else about

    18 ;;; them.

    19 

    20 ;;; Now, Persons S and P know the above information, and

    21 ;;; each one knows that the other one knows it. They have

    22 ;;; the following conversation:

    23 

    24 ;;; P: I can't figure out what the numbers are.

    25 

    26 ;; Eliminate pairs with a unique product.

    27 

    28 (defn group-by

    29   "Split coll into groups where the f maps each element in a

    30   group to the same value in O(n*log(n)) time."

    31   [f coll]

    32   (partition-by f (sort-by f coll)))

    33 

    34 (defn unique-by

    35   "Remove all elements a,b of coll that for which

    36    (= (f a) (f b)) in O(n*log(n)) time."

    37   [f coll]

    38   (squish (filter #(= (count %) 1) (group-by f coll))))

    39   

    40 (defn multiple-by

    41   "Keep all elements a,b of coll for which

    42    (= (f a) (f b)) in O(n*log(n)) time."

    43   [f coll]

    44   (squish (filter #(> (count %) 1) (group-by f coll))))

    45 

    46 (defn prod [[a b]] (* a b))

    47 

    48 (def p1 (multiple-by prod p0))

    49 

    50 ;;; S: I was sure you couldn't.

    51 

    52 ;; Each possible sum s has a set of possible pairs [a b]

    53 ;; where (= s (+ a b)). Partition p0 (since S *was* sure) by

    54 ;; sum, and keep those pairs that belong in partitions where

    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.

    58 

    59 (defn sum [[a b]] (+ a b))

    60 

    61 (def p2

    62   (squish

    63    (filter

    64     (partial every? (set p1))

    65     (group-by sum p0))))

    66 

    67 

    68 ;;; P: Then I have.

    69 

    70 ;; Keep those pairs that have a unique product out of the

    71 ;; ones that are left.

    72 

    73 (def p3

    74   (unique-by prod p2))

    75 

    76 

    77 ;;; S: Then I have, too.

    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      )))
author	Robert McIntyre <rlm@mit.edu>
date	Thu, 01 Mar 2012 05:47:23 -0700
parents	c8e35134bf8e
children