Sum and product puzzle
Solve the "Impossible Puzzle":
You are encouraged to solve this task according to the task description, using any language you may know.
X and Y are two different whole numbers greater than 1. Their sum is no greater than 100, and Y is greater than X. S and P are two mathematicians (and consequently perfect logicians); S knows the sum X+Y and P knows the product X*Y. Both S and P know all the information in this paragraph.
The following conversation occurs:
- S says "P does not know X and Y."
- P says "Now I know X and Y."
- S says "Now I also know X and Y!"
What are X and Y?
It can be hard to wrap one's head around what the three lines of dialog between S (the "sum guy") and P (the "product guy") convey about the values of X and Y.
So for your convenience, here's a break-down:
| Quote | Implied fact | |
|---|---|---|
| 1) | S says "P does not know X and Y." | For every possible sum decomposition of the number X+Y, the product has in turn more than one product decomposition. |
| 2) | P says "Now I know X and Y." | The number X*Y has only one product decomposition for which fact 1 is true. |
| 3) | S says "Now I also know X and Y." | The number X+Y has only one sum decomposition for which fact 2 is true. |
Terminology:
- "sum decomposition" of a number = Any pair of positive integers (A, B) so that A+B equals the number. Here, with the additional constraint 2 ≤ A < B.
- "product decomposition" of a number = Any pair of positive integers (A, B) so that A*B equals the number. Here, with the additional constraint 2 ≤ A < B.
Your program can solve the puzzle by considering all possible pairs (X, Y) in the range 2 ≤ X < Y ≤ 98, and then successively eliminating candidates based on the three facts. It turns out only one solution remains!
See the Python example for an implementation that uses this approach with a few optimizations.
- Wikipedia: Sum and Product Puzzle
AWK
<lang AWK>
- syntax: GAWK -f SUM_AND_PRODUCT_PUZZLE.AWK
BEGIN {
for (s=2; s<=100; s++) {
if ((a=satisfies_statement3(s)) != 0) {
printf("%d (%d+%d)\n",s,a,s-a)
}
}
exit(0)
} function satisfies_statement1(s, a) { # S says: P does not know the two numbers.
- Given s, for all pairs (a,b), a+b=s, 2 <= a,b <= 99, true if at least one of a or b is composite
for (a=2; a<=int(s/2); a++) {
if (is_prime(a) && is_prime(s-a)) {
return(0)
}
}
return(1)
} function satisfies_statement2(p, i,j,winner) { # P says: Now I know the two numbers.
- Given p, for all pairs (a,b), a*b=p, 2 <= a,b <= 99, true if exactly one pair satisfies statement 1
for (i=2; i<=int(sqrt(p)); i++) {
if (p % i == 0) {
j = int(p/i)
if (!(2 <= j && j <= 99)) { # in range
continue
}
if (satisfies_statement1(i+j)) {
if (winner) {
return(0)
}
winner = 1
}
}
}
return(winner)
} function satisfies_statement3(s, a,b,winner) { # S says: Now I know the two numbers.
- Given s, for all pairs (a,b), a+b=s, 2 <= a,b <= 99, true if exactly one pair satisfies statements 1 and 2
if (!satisfies_statement1(s)) {
return(0)
}
for (a=2; a<=int(s/2); a++) {
b = s - a
if (satisfies_statement2(a*b)) {
if (winner) {
return(0)
}
winner = a
}
}
return(winner)
} function is_prime(x, i) {
if (x <= 3) {
return(1)
}
for (i=2; i<=int(sqrt(x)); i++) {
if (x % i == 0) {
return(0)
}
}
return(1)
} </lang>
Output:
17 (4+13)
C#
<lang csharp>using System; using System.Linq; using System.Collections.Generic;
public class Program {
public static void Main()
{
const int maxSum = 100;
var pairs = (
from X in 2.To(maxSum / 2 - 1)
from Y in (X + 1).To(maxSum - 2).TakeWhile(y => X + y <= maxSum)
select new { X, Y, S = X + Y, P = X * Y }
).ToHashSet();
Console.WriteLine(pairs.Count);
var uniqueP = pairs.GroupBy(pair => pair.P).Where(g => g.Count() == 1).Select(g => g.Key).ToHashSet();
pairs.ExceptWith(pairs.GroupBy(pair => pair.S).Where(g => g.Any(pair => uniqueP.Contains(pair.P))).SelectMany(g => g));
Console.WriteLine(pairs.Count);
pairs.ExceptWith(pairs.GroupBy(pair => pair.P).Where(g => g.Count() > 1).SelectMany(g => g));
Console.WriteLine(pairs.Count);
pairs.ExceptWith(pairs.GroupBy(pair => pair.S).Where(g => g.Count() > 1).SelectMany(g => g));
Console.WriteLine(pairs.Count);
foreach (var pair in pairs) Console.WriteLine(pair);
}
}
public static class Extensions {
public static IEnumerable<int> To(this int start, int end) {
for (int i = start; i <= end; i++) yield return i;
}
public static HashSet<T> ToHashSet<T>(this IEnumerable<T> source) => new HashSet<T>(source);
}</lang>
- Output:
2352
145
86
1
{ X = 4, Y = 13, S = 17, P = 52 }
D
<lang d>void main() {
import std.stdio, std.algorithm, std.range, std.typecons;
const s1 = cartesianProduct(iota(1, 101), iota(1, 101))
.filter!(p => 1 < p[0] && p[0] < p[1] && p[0] + p[1] < 100)
.array;
alias P = const Tuple!(int, int); enum add = (P p) => p[0] + p[1]; enum mul = (P p) => p[0] * p[1]; enum sumEq = (P p) => s1.filter!(q => add(q) == add(p)); enum mulEq = (P p) => s1.filter!(q => mul(q) == mul(p));
const s2 = s1.filter!(p => sumEq(p).all!(q => mulEq(q).walkLength != 1)).array; const s3 = s2.filter!(p => mulEq(p).setIntersection(s2).walkLength == 1).array; s3.filter!(p => sumEq(p).setIntersection(s3).walkLength == 1).writeln;
}</lang>
- Output:
[const(Tuple!(int, int))(4, 13)]
With an older version of the LDC2 compiler replace the cartesianProduct line with:
<lang d>
const s1 = iota(1, 101).map!(x => iota(1, 101).map!(y => tuple(x, y))).joiner
</lang>
The .array turn the lazy ranges into arrays. This is a necessary optimization because D lazy Ranges aren't memoized as Haskell lazy lists.
Run-time: about 0.43 seconds with dmd, 0.08 seconds with ldc2.
Elixir
<lang elixir>defmodule Puzzle do
def sum_and_product do
s1 = for x <- 2..49, y <- x+1..99, x+y<100, do: {x,y}
s2 = Enum.filter(s1, fn p ->
Enum.all?(sumEq(s1,p), fn q -> length(mulEq(s1,q)) != 1 end)
end)
s3 = Enum.filter(s2, fn p -> only1?(mulEq(s1,p), s2) end)
Enum.filter(s3, fn p -> only1?(sumEq(s1,p), s3) end) |> IO.inspect
end
defp add({x,y}), do: x + y
defp mul({x,y}), do: x * y
defp sumEq(s, p), do: Enum.filter(s, fn q -> add(p) == add(q) end)
defp mulEq(s, p), do: Enum.filter(s, fn q -> mul(p) == mul(q) end)
defp only1?(a, b) do
MapSet.size(MapSet.intersection(MapSet.new(a), MapSet.new(b))) == 1
end
end
Puzzle.sum_and_product</lang>
- Output:
[{4, 13}]
Go
<lang go>package main
import "fmt"
type pair struct{ x, y int }
func main() { //const max = 100 // Use 1685 (the highest with a unique answer) instead // of 100 just to make it work a little harder :). const max = 1685 var all []pair for a := 2; a < max; a++ { for b := a + 1; b < max-a; b++ { all = append(all, pair{a, b}) } } fmt.Println("There are", len(all), "pairs where a+b <", max, "(and a<b)") products := countProducts(all)
// Those for which no sum decomposition has unique product to are // S mathimatician's possible pairs. var sPairs []pair pairs: for _, p := range all { s := p.x + p.y // foreach a+b=s (a<b) for a := 2; a < s/2+s&1; a++ { b := s - a if products[a*b] == 1 { // Excluded because P would have a unique product continue pairs } } sPairs = append(sPairs, p) } fmt.Println("S starts with", len(sPairs), "possible pairs.") //fmt.Println("S pairs:", sPairs) sProducts := countProducts(sPairs)
// Look in sPairs for those with a unique product to get // P mathimatician's possible pairs. var pPairs []pair for _, p := range sPairs { if sProducts[p.x*p.y] == 1 { pPairs = append(pPairs, p) } } fmt.Println("P then has", len(pPairs), "possible pairs.") //fmt.Println("P pairs:", pPairs) pSums := countSums(pPairs)
// Finally, look in pPairs for those with a unique sum var final []pair for _, p := range pPairs { if pSums[p.x+p.y] == 1 { final = append(final, p) } }
// Nicely show any answers. switch len(final) { case 1: fmt.Println("Answer:", final[0].x, "and", final[0].y) case 0: fmt.Println("No possible answer.") default: fmt.Println(len(final), "possible answers:", final) } }
func countProducts(list []pair) map[int]int { m := make(map[int]int) for _, p := range list { m[p.x*p.y]++ } return m }
func countSums(list []pair) map[int]int { m := make(map[int]int) for _, p := range list { m[p.x+p.y]++ } return m }
// not used, manually inlined above func decomposeSum(s int) []pair { pairs := make([]pair, 0, s/2) for a := 2; a < s/2+s&1; a++ { pairs = append(pairs, pair{a, s - a}) } return pairs }</lang>
- Output:
For x + y < 100 (max = 100):
There are 2304 pairs where a+b < 100 (and a<b) S starts with 145 possible pairs. P then has 86 possible pairs. Answer: 4 and 13
For x + y < 1685 (max = 1685):
There are 706440 pairs where a+b < 1685 (and a<b) S starts with 50485 possible pairs. P then has 17485 possible pairs. Answer: 4 and 13
Run-time ~1 msec and ~600 msec respectively. Could be slightly faster if the slices and maps were given an estimated capacity to start (e.g. (max/2)² for all pairs) to avoid re-allocations (and resulting copies).
Haskell
<lang haskell>import Data.List (intersect)
s1, s2, s3, s4 :: [(Int, Int)] s1 = [(x, y) | x <- [1 .. 100], y <- [1 .. 100], 1 < x && x < y && x + y < 100]
add, mul :: (Int, Int) -> Int add (x, y) = x + y mul (x, y) = x * y
sumEq, mulEq :: (Int, Int) -> [(Int, Int)] sumEq p = filter (\q -> add q == add p) s1 mulEq p = filter (\q -> mul q == mul p) s1
s2 = filter (\p -> all (\q -> (length $ mulEq q) /= 1) (sumEq p)) s1 s3 = filter (\p -> length (mulEq p `intersect` s2) == 1) s2 s4 = filter (\p -> length (sumEq p `intersect` s3) == 1) s3
main = print s4</lang>
- Output:
[(4,13)]
Run-time: about 1.97 seconds.
JavaScript
ES5
<lang JavaScript>(function () {
'use strict';
// GENERIC FUNCTIONS
// concatMap :: (a -> [b]) -> [a] -> [b]
var concatMap = function concatMap(f, xs) {
return [].concat.apply([], xs.map(f));
},
// curry :: ((a, b) -> c) -> a -> b -> c
curry = function curry(f) {
return function (a) {
return function (b) {
return f(a, b);
};
};
},
// intersectBy :: (a - > a - > Bool) - > [a] - > [a] - > [a]
intersectBy = function intersectBy(eq, xs, ys) {
return xs.length && ys.length ? xs.filter(function (x) {
return ys.some(curry(eq)(x));
}) : [];
},
// range :: Int -> Int -> Maybe Int -> [Int]
range = function range(m, n, step) {
var d = (step || 1) * (n >= m ? 1 : -1);
return Array.from({
length: Math.floor((n - m) / d) + 1
}, function (_, i) {
return m + i * d;
});
};
// PROBLEM FUNCTIONS
// add, mul :: (Int, Int) -> Int
var add = function add(xy) {
return xy[0] + xy[1];
},
mul = function mul(xy) {
return xy[0] * xy[1];
};
// sumEq, mulEq :: (Int, Int) -> [(Int, Int)]
var sumEq = function sumEq(p) {
var addP = add(p);
return s1.filter(function (q) {
return add(q) === addP;
});
},
mulEq = function mulEq(p) {
var mulP = mul(p);
return s1.filter(function (q) {
return mul(q) === mulP;
});
};
// pairEQ :: ((a, a) -> (a, a)) -> Bool
var pairEQ = function pairEQ(a, b) {
return a[0] === b[0] && a[1] === b[1];
};
// MAIN
// xs :: [Int] var xs = range(1, 100);
// s1 s2, s3, s4 :: [(Int, Int)]
var s1 = concatMap(function (x) {
return concatMap(function (y) {
return 1 < x && x < y && x + y < 100 ? [
[x, y]
] : [];
}, xs);
}, xs),
s2 = s1.filter(function (p) {
return sumEq(p).every(function (q) {
return mulEq(q).length > 1;
});
}),
s3 = s2.filter(function (p) {
return intersectBy(pairEQ, mulEq(p), s2).length === 1;
}),
s4 = s3.filter(function (p) {
return intersectBy(pairEQ, sumEq(p), s3).length === 1;
});
return s4;
})(); </lang>
- Output:
<lang JavaScript>4, 13</lang> (Finished in 0.69s)
ES6
<lang JavaScript>(() => {
'use strict';
// GENERIC FUNCTIONS
// concatMap :: (a -> [b]) -> [a] -> [b] let concatMap = (f, xs) => [].concat.apply([], xs.map(f)),
// curry :: ((a, b) -> c) -> a -> b -> c
curry = f => a => b => f(a, b),
// intersectBy :: (a - > a - > Bool) - > [a] - > [a] - > [a]
intersectBy = (eq, xs, ys) => (xs.length && ys.length) ?
xs.filter(x => ys.some(curry(eq)(x))) : [],
// range :: Int -> Int -> Maybe Int -> [Int]
range = (m, n, step) => {
let d = (step || 1) * (n >= m ? 1 : -1);
return Array.from({
length: Math.floor((n - m) / d) + 1
}, (_, i) => m + (i * d));
};
// PROBLEM FUNCTIONS
// add, mul :: (Int, Int) -> Int
let add = xy => xy[0] + xy[1],
mul = xy => xy[0] * xy[1];
// sumEq, mulEq :: (Int, Int) -> [(Int, Int)]
let sumEq = p => {
let addP = add(p);
return s1.filter(q => add(q) === addP);
},
mulEq = p => {
let mulP = mul(p)
return s1.filter(q => mul(q) === mulP);
};
// pairEQ :: ((a, a) -> (a, a)) -> Bool let pairEQ = (a, b) => (a[0] === b[0]) && (a[1] === b[1]);
// MAIN
// xs :: [Int] let xs = range(1, 100);
// s1 s2, s3, s4 :: [(Int, Int)]
let s1 = concatMap(x =>
concatMap(y =>
((1 < x) && (x < y) && (x + y) < 100) ? [
[x, y]
] : [],
xs), xs),
s2 = s1.filter(
p => sumEq(p)
.every(
q => mulEq(q)
.length > 1
)
),
s3 = s2.filter(
p => intersectBy(
pairEQ, mulEq(p), s2
)
.length === 1
);
return s3.filter(
p => intersectBy(
pairEQ, sumEq(p), s3
)
.length === 1
);
})();</lang>
- Output:
<lang JavaScript>4, 13</lang> (Finished in 0.77s)
ooRexx
version 1
for comments see REXX version 4. <lang oorexx>all =.set~new Call time 'R' cnt.=0 do a=2 to 100
do b=a+1 to 100-2 p=a b if a+b>100 then leave b all~put(p) prd=a*b cnt.prd+=1 End End
Say "There are" all~items "pairs where X+Y <=" max "(and X<Y)"
spairs=.set~new Do Until all~items=0
do p over all
d=decompositions(p)
If take Then
spairs=spairs~union(d)
dif=all~difference(d)
Leave
End
all=dif
end
Say "S starts with" spairs~items "possible pairs."
sProducts.=0 Do p over sPairs
Parse Var p x y prod=x*y sProducts.prod+=1 End
pPairs=.set~new Do p over sPairs
Parse Var p xb yb prod=xb*yb If sProducts.prod=1 Then pPairs~put(p) End
Say "P then has" pPairs~items "possible pairs."
Sums.=0 Do p over pPairs
Parse Var p xc yc sum=xc+yc Sums.sum+=1 End
final=.set~new Do p over pPairs
Parse Var p x y sum=x+y If Sums.sum=1 Then final~put(p) End
si=0 Do p Over final
si+=1 sol.si=p End
Select
When final~items=1 Then Say "Answer:" sol.1
When final~items=0 Then Say "No possible answer."
Otherwise Do; Say final~items "possible answers:"
Do p over final
Say p
End
End
End
Say "Elapsed time:" time('E') "seconds" Exit
decompositions: Procedure Expose cnt. take spairs
epairs=.set~new
Use Arg p
Parse Var p aa bb
s=aa+bb
take=1
Do xa=2 To s/2
ya=s-xa
pp=xa ya
epairs~put(pp)
prod=xa*ya
If cnt.prod=1 Then
take=0
End
return epairs</lang>
- Output:
There are 2352 pairs where X+Y <= MAX (and X<Y) S starts with 145 possible pairs. P then has 86 possible pairs. Answer: 4 13 Elapsed time: 0.016000 seconds
version 2
Uses objects for storing the number pairs. Note the computed hash value and the == mathod (required to make the set difference work) <lang oorexx>all =.set~new Call time 'R' cnt.=0 do a=2 to 100
do b=a+1 to 100-2 p=.pairs~new(a,b) if p~sum>100 then leave b all~put(p) prd=p~prod cnt.prd+=1 End End
Say "There are" all~items "pairs where X+Y <=" max "(and X<Y)"
spairs=.set~new Do Until all~items=0
do p over all
d=decompositions(p)
If take Then
spairs=spairs~union(d)
dif=all~difference(d)
Leave
End
all=dif
end
Say "S starts with" spairs~items "possible pairs."
sProducts.=0 Do p over sPairs
prod=p~prod sProducts.prod+=1 End
pPairs=.set~new Do p over sPairs
prod=p~prod If sProducts.prod=1 Then pPairs~put(p) End
Say "P then has" pPairs~items "possible pairs."
Sums.=0 Do p over pPairs
sum=p~sum Sums.sum+=1 End
final=.set~new Do p over pPairs
sum=p~sum If Sums.sum=1 Then final~put(p) End
si=0 Do p Over final
si+=1 sol.si=p End
Select
When final~items=1 Then Say "Answer:" sol.1~string
When final~items=0 Then Say "No possible answer."
Otherwise Do; Say final~items "possible answers:"
Do p over final
Say p~string
End
End
End
Say "Elapsed time:" time('E') "seconds" Exit
decompositions: Procedure Expose cnt. take spairs
epairs=.set~new
Use Arg p
s=p~sum
take=1
Do xa=2 To s/2
ya=s-xa
pp=.pairs~new(xa,ya)
epairs~put(pp)
prod=pp~prod
If cnt.prod=1 Then
take=0
End
return epairs
- class pairs
- attribute a -- allow access to attribute
- attribute b -- allow access to attribute
- attribute sum -- allow access to attribute
- attribute prod -- allow access to attribute
-- only the strict equality form is needed for the collection classes,
- method "=="
expose a b use strict arg other return a == other~a & b == other~b
-- not needed to make the set difference work, but added for completeness
- method "\=="
expose a b use strict arg other return a \== other~a | b \== other~b
- method hashCode
expose hash return hash
- method init -- create pair, calculate sum, product
-- and index (blank delimited values) expose hash a b sum prod oid use arg a, b hash = a~hashCode~bitxor(b~hashCode) -- create hash value sum =a+b -- sum prod=a*b -- product
- method string -- this creates the string to be shown
expose a b return "[x="||a",y="||b"]"</lang>
- Output:
There are 2352 pairs where X+Y <= MAX (and X<Y) S starts with 145 possible pairs. P then has 86 possible pairs. Answer: [x=4,y=13] Elapsed time: 0.079000 seconds
Perl 6
<lang perl6>sub grep-unique (&by, @list) { @list.classify(&by).values.grep(* == 1).map(*[0]) } sub sums ($n) { ($_, $n - $_ for 2 .. $n div 2) } sub sum ([$x, $y]) { $x + $y } sub product ([$x, $y]) { $x * $y }
my @all-pairs = (|($_ X $_+1 .. 98) for 2..97);
- Fact 1:
my %p-unique := Set.new: map ~*, grep-unique &product, @all-pairs; my @s-pairs = @all-pairs.grep: { none (%p-unique{~$_} for sums sum $_) };
- Fact 2:
my @p-pairs = grep-unique &product, @s-pairs;
- Fact 3:
my @final-pairs = grep-unique &sum, @p-pairs;
printf "X = %d, Y = %d\n", |$_ for @final-pairs;</lang>
- Output:
X = 4, Y = 13
Python
Based on the Python solution from Wikipedia: <lang python>#!/usr/bin/env python
from collections import Counter
def decompose_sum(s):
return [(a,s-a) for a in range(2,int(s/2+1))]
- Generate all possible pairs
all_pairs = set((a,b) for a in range(2,100) for b in range(a+1,100) if a+b<100)
- Fact 1 --> Select pairs for which all sum decompositions have non-unique product
product_counts = Counter(c*d for c,d in all_pairs) unique_products = set((a,b) for a,b in all_pairs if product_counts[a*b]==1) s_pairs = [(a,b) for a,b in all_pairs if
all((x,y) not in unique_products for (x,y) in decompose_sum(a+b))]
- Fact 2 --> Select pairs for which the product is unique
product_counts = Counter(c*d for c,d in s_pairs) p_pairs = [(a,b) for a,b in s_pairs if product_counts[a*b]==1]
- Fact 3 --> Select pairs for which the sum is unique
sum_counts = Counter(c+d for c,d in p_pairs) final_pairs = [(a,b) for a,b in p_pairs if sum_counts[a+b]==1]
print(final_pairs)</lang>
- Output:
[(4, 13)]
Racket
To calculate the results faster this program use memorization. So it has a modified version of sum= and mul= to increase the chances of reusing the results.
<lang Racket>#lang racket (define-syntax-rule (define/mem (name args ...) body ...)
(begin
(define cache (make-hash))
(define (name args ...)
(hash-ref! cache (list args ...) (lambda () body ...)))))
(define (sum p) (+ (first p) (second p))) (define (mul p) (* (first p) (second p)))
(define (sum= p s) (filter (lambda (q) (= p (sum q))) s)) (define (mul= p s) (filter (lambda (q) (= p (mul q))) s))
(define (puzzle tot)
(printf "Max Sum: ~a\n" tot)
(define s1 (for*/list ([x (in-range 2 (add1 tot))]
[y (in-range (add1 x) (- (add1 tot) x))])
(list x y)))
(printf "Possible pairs: ~a\n" (length s1))
(define/mem (sumEq/all p) (sum= p s1)) (define/mem (mulEq/all p) (mul= p s1))
(define s2 (filter (lambda (p) (andmap (lambda (q)
(not (= (length (mulEq/all (mul q))) 1)))
(sumEq/all (sum p))))
s1))
(printf "Initial pairs for S: ~a\n" (length s2))
(define s3 (filter (lambda (p) (= (length (mul= (mul p) s2)) 1))
s2))
(displayln (length s3))
(printf "Pairs for P: ~a\n" (length s3))
(define s4 (filter (lambda (p) (= (length (sum= (sum p) s3)) 1))
s3))
(printf "Final pairs for S: ~a\n" (length s4))
(displayln s4))
(puzzle 100)</lang>
- Output:
Max Sum: 100 Possible pairs: 2352 Initial pairs for S: 145 Pairs for P: 86 Final pairs for S: 1 ((4 13))
REXX
version 1
I tried hard to understand/translate the algorithms shown so far (16 Oct 2016) Unfortunately to no avail (not knowing the semantics of the used languages). Finally I was successful by implementing the rules referred to in Wikipedia http://www.win.tue.nl/~gwoegi/papers/freudenthal1.pdf which had a very clear description. <lang rexx>debug=0 If debug Then Do
oid='sppn.txt'; 'erase' oid End
Call time 'R' all_pairs= cnt.=0 i=0 /* first take all possible pairs 2<=x<y with x+y<=100 */ /* and compute the respective sums and products */ /* count the number of times a sum or product occurs */ Do x=2 To 98
Do y=x+1 To 100-x x=right(x,2,0) y=right(y,2,0) all_pairs=all_pairs x'/'y i=i+1 x.i=x y.i=y sum=x+y prd=x*y cnt.0s.sum=cnt.0s.sum+1 cnt.0p.prd=cnt.0p.prd+1 End End
n=i /* now compute the possible pairs for each sum sum_d.sum */ /* and product prd_d.prd */ /* also the list of possible sums and products suml, prdl*/ sum_d.= prd_d.= suml= prdl= Do i=1 To n
x=x.i y=y.i x=right(x,2,0) y=right(y,2,0) sum=x+y prd=x*y cnt.0s.x.y=cnt.0s.sum cnt.0p.x.y=cnt.0p.prd sum_d.sum=sum_d.sum x'/'y prd_d.prd=prd_d.prd x'/'y If wordpos(sum,suml)=0 Then suml=suml sum If wordpos(prd,prdl)=0 Then prdl=prdl prd End
Say n 'possible pairs' Call o 'SUM' suml=wordsort(suml) prdl=wordsort(prdl) sumlc=suml si=0 pi=0 Do While sumlc>
Parse Var sumlc sum sumlc
si=si+1
sum.si=sum
si.sum=si
If sum=17 Then sx=si
temp=prdl
Do While temp>
Parse Var temp prd temp
If si=1 Then Do
pi=pi+1
prd.pi=prd
pi.prd=pi
If prd=52 Then px=pi
End
A.prd.sum='+'
End
End
sin=si pin=pi Call o 'SUM' Do si=1 To sin
Call o f5(si) f3(sum.si) End
Call o 'PRD' Do pi=1 To pin
Call o f5(pi) f6(prd.pi) End
a.='-' Do pi=1 To pin
prd=prd.pi
Do si=1 To sin
sum=sum.si
Do sj=1 To words(sum_d.sum)
If wordpos(word(sum_d.sum,sj),prd_d.prd)>0 Then
Parse Value word(sum_d.sum,sj) with x '/' y
prde=x*y
sume=x+y
pa=pi.prde
sa=si.sume
a.pa.sa='+'
End
End
End
Call show '1'
Do pi=1 To pin
prow=
cnt=0
Do si=1 To sin
If a.pi.si='+' Then Do
cnt=cnt+1
pj=pi
sj=si
End
End
If cnt=1 Then
a.pj.sj='1'
End
Call show '2'
Do si=1 To sin
Do pi=1 To pin
If a.pi.si='1' Then Leave
End
If pi<=pin Then Do
Do pi=1 To pin
If a.pi.si='+' Then
a.pi.si='2'
End
End
End
Call show '3'
Do pi=1 To pin
prow=
Do si=1 To sin
prow=prow||a.pi.si
End
If count('+',prow)>1 Then Do
Do si=1 To sin
If a.pi.si='+' Then
a.pi.si='3'
End
End
End
Call show '4'
Do si=1 To sin
scol=
Do pi=1 To pin
scol=scol||a.pi.si
End
If count('+',scol)>1 Then Do
Do pi=1 To pin
If a.pi.si='+' Then
a.pi.si='4'
End
End
End
Call show '5'
sol=0 Do pi=1 To pin
Do si=1 To sin
If a.pi.si='+' Then Do
Say sum.si prd.pi
sum=sum.si
prd=prd.pi
sol=sol+1
End
End
End
Say sol 'solution(s)' Say ' possible pairs' Say 'Product='prd prd_d.52 Say ' Sum='sum sum_d.17 Say 'The only pair in both lists is 04/13.' Say 'Elapsed time:' time('E') 'seconds' Exit show: If debug Then Do
Call o 'show' arg(1)
Do pi=1 To 60
ol=
Do si=1 To 60
ol=ol||a.pi.si
End
Call o ol
End
Say 'a.'px'.'sx'='a.px.sx
End
Return
Exit o: Return lineout(oid,arg(1)) f3: Return format(arg(1),3) f4: Return format(arg(1),4) f5: Return format(arg(1),5) f6: Return format(arg(1),6)
count: Procedure
Parse Arg c,s
s=translate(s,c,c||xrange('00'x,'ff'x))
s=space(s,0)
Return length(s)</lang>
- Output:
2352 possible pairs
17 52
1 solution(s)
possible pairs
Product=52 02/26 04/13
Sum=17 02/15 03/14 04/13 05/12 06/11 07/10 08/09
The only pair in both lists is 04/13.
Elapsed time: 4.891000 seconds
version 2
<lang rexx>Call time 'R' Do s=2 To 100
a=satisfies_statement3(s) If a>0 Then Do p=a*(s-a) Say a'/'||(s-a) 's='s 'p='p End End
Say 'Elapsed time:' time('E') 'seconds' Exit
satisfies_statement1: Procedure
Parse Arg s
Do a=2 To s/2
If is_prime(a) & is_prime(s-a) Then
Return 0
End
Return 1
satisfies_statement2: Procedure
Parse Arg p
winner=0
Do i=2 By 1 While i**2<p
If p//i=0 Then Do
j=p%i
If 2<=j & j<=99 Then Do
if satisfies_statement1(i+j) Then Do
if winner Then
Return 0
winner=1
End
End
End
End
Return winner
satisfies_statement3: Procedure
Parse Arg s
winner=0
If satisfies_statement1(s)=0 Then
Return 0
Do a=2 To s/2
b=s-a
If satisfies_statement2(a*b) Then Do
If winner>0 Then
Return 0
winner=a
End
End
Return winner
is_prime: Procedure
call Trace 'O' Parse Arg x If x<=3 Then Return 1 i=2 Do i=2 By 1 While i**2<=x If datatype(x/i,'W') Then Return 0 End Return 1</lang>
- Output:
4/13 s=17 p=52 Elapsed time: 0.078000 seconds
version 3
<lang rexx>/*---------------------------------------------------------------------
- X and Y are two different whole numbers greater than 1.
- Their sum is no greater than 100, and Y is greater than X.
- S and P are two mathematicians (and consequently perfect logicians);
- S knows the sum X+Y and P knows the product X*Y.
- Both S and P know all the information in this paragraph.
- The following conversation occurs:
- * S says "P does not know X and Y."
- * P says "Now I know X and Y."
- * S says "Now I also know X and Y!"
- What are X and Y?
- --------------------------------------------------------------------*/
Call time 'R' max=100 Products.=0 all= Do x=2 To max
Do y=x+1 To max-2
If x+y<=100 Then Do
all=all x'/'y
prod=x*y; Products.prod=Products.prod+1
End
End
End
Say "There are" words(all) "pairs where X+Y <=" max "(and X<Y)" /*---------------------------------------------------------------------
- First eliminate all pairs where the product is unique:
- For each pair we look at the decompositions of the sum (x+y).
- If for any of these decompositions (xa/ya) the product is unique
- then x/y cannot be the solution of the puzzle and we eliminate it
- from the list of possible pairs
- --------------------------------------------------------------------*/
sPairs= Do i=1 To words(all)
xy=word(all,i)
Parse Var xy x '/' Y
Parse Var xy xx '/' Yy
s=x+y
take=1
Do xa=2 To s/2
ya=s-xa
prod=xa*ya
If products.prod=1 Then Do
take=0
Iterate i
End
End
If take Then
sPairs=sPairs xy
End
Say "S starts with" words(sPairs) "possible pairs."
/*---------------------------------------------------------------------
- From the REMAINING pairs take only these where the product is unique:
- For each pair we look at the decompositions of the known product.
- If for any of these decompositions (xb/yb) the product is unique
- then xb/yb can be the solution of the puzzle and we add it
- to the list of possible pairs.
- --------------------------------------------------------------------*/
sProducts.=0 Do i=1 To words(sPairs)
xy=word(sPairs,i) Parse Var xy x '/' y prod=x*y sProducts.prod=sProducts.prod+1 End
pPairs= Do i=1 To words(sPairs)
xy=word(sPairs,i) Parse Var xy x '/' y prod=x*y If sProducts.prod=1 Then pPairs=pPairs xy End
Say "P then has" words(pPairs) "possible pairs."
/*---------------------------------------------------------------------
- From the now REMAINING pairs take only these where the sum is unique
- Now we look at all possible pairs and find the one (xc/yc)
- with a unique sum which must be the sum we knew from the beginning.
- The pair xc/yc is then the solution
- --------------------------------------------------------------------*/
Sums.=0 Do i=1 To words(pPairs)
xy=word(pPairs,i) Parse Var xy x '/' y sum=x+y Sums.sum=Sums.sum+1 End
final= Do i=1 To words(pPairs)
xy=word(pPairs,i) Parse Var xy x '/' y sum=x+y If Sums.sum=1 Then final = final xy End
Select
When words(final)=1 Then Say "Answer:" strip(final)
When words(final)=0 Then Say "No possible answer."
Otherwise Do; Say words(final) "possible answers:"
Say strip(final)
End
End
Say "Elapsed time:" time('E') "seconds" Exit</lang>
- Output:
There are 2352 pairs where X+Y <= 100 (and X<Y) S starts with 145 possible pairs. P then has 86 possible pairs. Answer: 4/13 Elapsed time: 0.045000 seconds
version 4
Now that I have understood the logic (I am neither S nor P) I have created an alternative to verion 3. <lang rexx>/*---------------------------------------------------------------------
- X and Y are two different whole numbers greater than 1.
- Their sum is no greater than 100, and Y is greater than X.
- S and P are two mathematicians (and consequently perfect logicians);
- S knows the sum X+Y and P knows the product X*Y.
- Both S and P know all the information in this paragraph.
- The following conversation occurs:
- * S says "P does not know X and Y."
- * P says "Now I know X and Y."
- * S says "Now I also know X and Y!"
- What are X and Y?
- --------------------------------------------------------------------*/
Call time 'R' max=100 Products.=0 all= Do x=2 To max
Do y=x+1 To max-2
If x+y<=100 Then Do
all=all x'/'y
prod=x*y; Products.prod=Products.prod+1
End
End
End
Say "There are" words(all) "pairs where X+Y <=" max "(and X<Y)" /*---------------------------------------------------------------------
- First eliminate all pairs where the product is unique:
- For each pair we look at the decompositions of the sum (x+y).
- If for any of these decompositions (xa/ya) the product is unique
- then the given sum cannot be the sum of the pair we are looking for
- Otherwise all pairs in the sum's decompositions are eligible.
- --------------------------------------------------------------------*/
sPairs= done.=0 Do i=1 To words(all)
xy=word(all,i)
If done.xy Then Iterate
Parse Var xy x '/' y
s=x+y
take=1
el=
Do xa=2 To s/2
ya=s-xa
m=xa'/'ya
done.m=1
el=el m
prod=xa*ya
If products.prod=1 Then
take=0
End
If take Then
sPairs=sPairs el
End
Say "S starts with" words(sPairs) "possible pairs."
/*---------------------------------------------------------------------
- From the REMAINING pairs take only these where the product is unique:
- For each pair we look at the decompositions of the known product.
- If for any of these decompositions (xb/yb) the product is unique
- then xb/yb can be the solution of the puzzle and we add it
- to the list of possible pairs.
- --------------------------------------------------------------------*/
sProducts.=0 Do i=1 To words(sPairs)
xy=word(sPairs,i) Parse Var xy x '/' y prod=x*y sProducts.prod=sProducts.prod+1 End
pPairs= Do i=1 To words(sPairs)
xy=word(sPairs,i) Parse Var xy xb '/' yb prod=xb*yb If sProducts.prod=1 Then pPairs=pPairs xy End
Say "P then has" words(pPairs) "possible pairs."
/*---------------------------------------------------------------------
- From the now REMAINING pairs take only these where the sum is unique
- Now we look at all possible pairs and find the one (xc/yc)
- with a unique sum which must be the sum we knew from the beginning.
- The pair xc/yc is then the solution
- --------------------------------------------------------------------*/
Sums.=0 Do i=1 To words(pPairs)
xy=word(pPairs,i) Parse Var xy xc '/' yc sum=xc+yc Sums.sum=Sums.sum+1 End
final= Do i=1 To words(pPairs)
xy=word(pPairs,i) Parse Var xy x '/' y sum=x+y If Sums.sum=1 Then final = final xy End
Select
When words(final)=1 Then Say "Answer:" strip(final)
When words(final)=0 Then Say "No possible answer."
Otherwise Do; Say words(final) "possible answers:"
Say strip(final)
End
End
Say "Elapsed time:" time('E') "seconds" Exit</lang>
- Output:
There are 2352 pairs where X+Y <= 100 (and X<Y) S starts with 145 possible pairs. P then has 86 possible pairs. Answer: 4/13 Elapsed time: 0.032000 seconds
Ruby
<lang ruby>def add(x,y) x + y end def mul(x,y) x * y end
def sumEq(s,p) s.select{|q| add(*p) == add(*q)} end def mulEq(s,p) s.select{|q| mul(*p) == mul(*q)} end
s1 = (a = *2...100).product(a).select{|x,y| x<y && x+y<100} s2 = s1.select{|p| sumEq(s1,p).all?{|q| mulEq(s1,q).size != 1} } s3 = s2.select{|p| (mulEq(s1,p) & s2).size == 1} p s3.select{|p| (sumEq(s1,p) & s3).size == 1}</lang>
- Output:
[[4, 13]]
Scala
<lang scala>object ImpossiblePuzzle extends App {
type XY = (Int, Int)
val step0 = for {
x <- 1 to 100
y <- 1 to 100
if 1 < x && x < y && x + y < 100
} yield (x, y)
def sum(xy: XY) = xy._1 + xy._2
def prod(xy: XY) = xy._1 * xy._2
def sumEq(xy: XY) = step0 filter { sum(_) == sum(xy) }
def prodEq(xy: XY) = step0 filter { prod(_) == prod(xy) }
val step2 = step0 filter { sumEq(_) forall { prodEq(_).size != 1 }}
val step3 = step2 filter { prodEq(_).intersect(step2).size == 1 }
val step4 = step3 filter { sumEq(_).intersect(step3).size == 1 }
println(step4)
}</lang>
- Output:
Vector((4,13))
Run-time: about 3.82 seconds.
Sidef
<lang ruby>func grep_uniq(a, by) { a.group_by{ .(by) }.values.grep{.len == 1}.map{_[0]} } func sums (n) { 2 .. n//2 -> map {|i| [i, n-i] } }
var pairs = (2..97 -> map {|i| ([i] ~X (i+1 .. 98))... })
var p_uniq = Hash() p_uniq{grep_uniq(pairs, :prod).map { .to_s }...} = ()
var s_pairs = pairs.grep {|p| sums(p.sum).all { !p_uniq.contains(.to_s) } } var p_pairs = grep_uniq(s_pairs, :prod) var f_pairs = grep_uniq(p_pairs, :sum)
f_pairs.each { |p| printf("X = %d, Y = %d\n", p...) }</lang>
- Output:
X = 4, Y = 13
zkl
Damn it Jim, I'm a programmer, not a logician. So I translated the python code found in https://qmaurmann.wordpress.com/2013/08/10/sam-and-polly-and-python/ but I don't understand it. It does seem quite a bit more efficient than the Scala code, on par with the Python code. <lang zkl>mul:=Utils.Helpers.summer.fp1('*,1); //-->list.reduce('*,1), multiply list items var allPairs=[[(a,b); [2..100]; { [a+1..100] },{ a+b<100 }; ROList]]; // 2,304 pairs
sxys,pxys:=D(),D(); // hashes of allPairs sums and products: 95,1155 foreach xy in (allPairs){ sxys.appendV(xy.sum(),xy); pxys.appendV(xy:mul(_),xy) }
sOK:= 'wrap(s){ (not sxys[s].filter1('wrap(xy){ pxys[xy:mul(_)].len()<2 })) }; pOK:= 'wrap(p){ 1==pxys[p].filter('wrap([(x,y)]){ sOK(x+y) }).len() }; sOK2:='wrap(s){ 1==sxys[s].filter('wrap(xy){ pOK(xy:mul(_)) }).len() }; allPairs.filter('wrap([(x,y)]){ sOK(x+y) and pOK(x*y) and sOK2(x+y) }) .println();</lang> [[ ]] denotes list comprehension, filter1 returns (and stops at) the first thing that is "true", 'wrap creates a closure so the "wrapped" code/function can see local variables (read only). In a [function] prototype, the "[(x,y)]xy]" notation says xy is a list like thing, assign the parts to x & y (xy is optional), used here to just to do it both ways. The ":" says take the LHS and stuff it into the "_".
- Output:
L(L(4,13))