/
Mr-S-P.clj
104 lines (83 loc) · 2.76 KB
/
Mr-S-P.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
;; Copyright (C) 2009 Michel Alexandre Salim.
;; see LICENSE.TXT for licensing
;; Solving the "Mr.S and Mr.P" puzzle by John McCarthy:
" Formalization of two Puzzles Involving Knowledge
McCarthy, John (1987).
http://www-formal.stanford.edu/jmc/puzzles.html
We pick two numbers a and b, so that a>=b and both numbers are within
the range [2,99]. We give Mr.P the product a*b and give Mr.S the sum
a+b.
The following dialog takes place:
Mr.P: I don't know the numbers
Mr.S: I knew you didn't know. I don't know either.
Mr.P: Now I know the numbers
Mr.S: Now I know them too
Can we find the numbers a and b?
The code is a direct translation of Oleg Kiselyov's Haskell solution:
http://okmij.org/ftp/Haskell/Mr-S-P.lhs
"
;; The good numbers
(def good-nums (range 2 100))
;; Given a number p, find all good factors a and b s.t. a >= b
;; Using memoization, this "table" is a lazy sequence containing
;; all possible products
(def good-factors-table
(letfn [(gf [p]
(for [a good-nums
b good-nums
:when (and (>= a b)
(= (* a b) p))]
[a b]))]
(pmap gf (iterate inc 0))))
;; To find all good factors for p, just index into the table
(defn good-factors [p]
(nth good-factors-table p))
;; Given a number s, find all good summands a and b s.t. a >= b
;; Same technique as before
(def good-summands-table
(letfn [(gs [s]
(for [a good-nums
b good-nums
:when (and (>= a b)
(= (+ a b) s))]
[a b]))]
(pmap gs (iterate inc 0))))
;; To find all good summands for s, index into the table
(defn good-summands [s]
(nth good-summands-table s))
(defn singleton?
"true iff xs contains a single element"
[xs]
(and (not (empty? xs))
(empty? (next xs))))
(defn fact1?
"Mr.P does not know the numbers, therefore the product does *not*
have a unique factorization"
[[a b]]
(not (singleton? (good-factors (* a b)))))
(defn fact2?
"Mr.S does not know the numbers, ditto with the sum"
[[a b]]
(not (singleton? (good-summands (+ a b)))))
(defn fact3?
"Mr.S knows Mr.P does not know. All the good summands must not
have unique factorizations"
[[a b]]
(every? fact1? (good-summands (+ a b))))
(defn fact4?
"Mr.P *now* knows fact3 is true, and can find the numbers. Thus
only one factorization makes fact3 true"
[[a b]]
(singleton? (filter fact3? (good-factors (* a b)))))
(defn fact5?
"Mr.S knows Mr.P found the numbers, therefore only one decomposition
of a+b makes fact4 true"
[[a b]]
(singleton? (filter fact4? (good-summands (+ a b)))))
;; the list of all numbers such that fact1..fact5 holds
(def result (for [a good-nums
b good-nums
:when (and (>= a b)
(every? #(% [a b])
[fact1? fact2? fact3? fact4? fact5?]))]
[a b]))