Sum and product puzzle
You are encouraged to solve this task according to the task description, using any language you may know.
- Task
Solve the "Impossible Puzzle":
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
11l
F counter(arr)
DefaultDict[Int, Int] d
L(a) arr
d[a]++
R d
F decompose_sum(s)
R (2 .< Int(s / 2 + 1)).map(a -> (a, @s - a))
Set[(Int, Int)] all_pairs_set
L(a) 2..99
L(b) a + 1 .< 100
I a + b < 100
all_pairs_set.add((a, b))
V all_pairs = Array(all_pairs_set)
V product_counts = counter(all_pairs.map((c, d) -> c * d))
V unique_products = Set(all_pairs.filter((a, b) -> :product_counts[a * b] == 1))
V s_pairs = all_pairs.filter((a, b) -> all(decompose_sum(a + b).map((x, y) -> (x, y) !C :unique_products)))
product_counts = counter(s_pairs.map((c, d) -> c * d))
V p_pairs = s_pairs.filter((a, b) -> :product_counts[a * b] == 1)
V sum_counts = counter(p_pairs.map((c, d) -> c + d))
V final_pairs = p_pairs.filter((a, b) -> :sum_counts[a + b] == 1)
print(final_pairs)
- Output:
[(4, 13)]
ALGOL 68
BEGIN # solve the sum and product puzzle: find X, Y where 1 < X < Y; X + Y <= 100 #
# mathematician S knows X + Y and P knows X * Y #
# S says P doesn't know X and Y, P says they now know X and Y which leads S #
# to also know X and Y #
# which leads to the following (from the task) #
# 1: For every possible sum decomposition of the number X+Y, #
# the product has in turn more than one product decomposition #
# 2: The number X*Y has only one product decomposition for which 1: is true #
# 3: The number X+Y has only one sum decomposition for which 2: is true #
# determine the possible sums and products and count their occurances #
INT max n = 98, min n = 2;
[ 0 : max n * max n ]INT s count, p count;
[ min n : max n, min n : max n ]BOOL candidate;
FOR x FROM LWB p count TO UPB p count DO p count[ x ] := s count[ x ] := 0 OD;
FOR x FROM min n TO max n DO FOR y FROM min n TO max n DO candidate[ x, y ] := FALSE OD OD;
FOR x FROM min n TO max n - min n DO
FOR y FROM x + 1 TO max n - x DO
s count[ x + y ] +:= 1;
p count[ x * y ] +:= 1
OD
OD;
# shows the count of the candidates #
PROC show candidates = ( STRING stage )VOID:
BEGIN
INT c count := 0;
FOR x FROM min n TO max n DO
FOR y FROM min n TO max n DO IF candidate[ x, y ] THEN c count +:= 1 FI OD
OD;
print( ( stage, " ", whole( c count, - 5 ), " candidate", IF c count = 1 THEN "" ELSE "s" FI, newline ) )
END # show candidates # ;
# checks 1: is TRUE for x plus y, returns TRUE if it is, FALSE otherwose #
PROC all sums have multiple product decompositions = ( INT x plus y )BOOL:
BEGIN
BOOL all multiple p := TRUE;
FOR x FROM min n TO x plus y OVER 2 WHILE all multiple p DO
INT y = x plus y - x;
IF y > x AND y <= max n THEN
# x, y is a sum decomposition of x plus y #
IF candidate[ x, y ] THEN all multiple p := all multiple p AND p count[ x * y ] > 1 FI
FI
OD;
all multiple p
END # all sums have multiple product decompositions # ;
# checks 2: is TRUE for x times y, returns TRUE if it is, FALSE otherwose #
PROC only one product decomposition = ( INT x times y )BOOL:
BEGIN
INT multiple p := 0;
FOR x FROM min n TO ENTIER sqrt( x times y ) DO
IF x times y MOD x = 0 THEN
INT y = x times y OVER x;
IF y > x AND y <= max n THEN
# x, y is a product decomposition of x times y #
IF candidate[ x, y ] THEN
IF all sums have multiple product decompositions( x + y ) THEN
multiple p +:= 1
FI
FI
FI
FI
OD;
multiple p = 1
END # only one product decomposition # ;
# start off with all min n .. max n as candidates #
FOR x FROM min n TO max n DO
FOR y FROM x + 1 TO max n DO
IF x + y <= 100 THEN candidate[ x, y ] := TRUE FI
OD
OD;
show candidates( "Sum and product puzzle " );
# Statement 1: S says P doesn't know X and Y #
FOR x plus y FROM min n TO max n + min n DO
IF NOT all sums have multiple product decompositions( x plus y ) THEN
FOR x FROM min n TO x plus y OVER 2 DO
INT y = x plus y - x;
IF y > x AND y <= max n THEN candidate[ x, y ] := FALSE FI
OD
FI
OD;
show candidates( "After statement 1 " );
# Statement 2: P says they now know X and Y #
FOR x times y FROM min n * ( min n + 1 ) TO max n * max n DO
IF NOT only one product decomposition( x times y ) THEN
FOR x FROM min n TO ENTIER sqrt( x times y ) DO
IF x times y MOD x = 0 THEN
INT y = x times y OVER x;
IF y > x AND y <= max n THEN candidate[ x, y ] := FALSE FI
FI
OD
FI
OD;
show candidates( "After statement 2 " );
# Statement 3: S says they now also know X and Y, check 3: #
FOR x plus y FROM min n TO max n + min n DO
INT multiple s := 0;
FOR x FROM min n TO x plus y OVER 2 DO
INT y = x plus y - x;
IF y > x AND y <= max n THEN
# x, y is a sum decomposition of x plus y #
IF candidate[ x, y ] THEN
IF only one product decomposition( x * y ) THEN multiple s +:= 1 FI
FI
FI
OD;
IF multiple s /= 1 THEN
FOR x FROM min n TO x plus y OVER 2 DO
INT y = x plus y - x;
IF y > x AND y <= max n THEN candidate[ x, y ] := FALSE FI
OD
FI
OD;
show candidates( "After statement 3 " );
print( ( newline, "solution: " ) );
FOR x FROM min n TO max n DO
FOR y FROM min n TO max n DO
IF candidate[ x, y ] THEN print( ( whole( x, 0 ), ", ", whole( y, 0 ), newline ) ) FI
OD
OD
END
- Output:
Sum and product puzzle 2352 candidates After statement 1 145 candidates After statement 2 86 candidates After statement 3 1 candidate solution: 4, 13
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 <= 1) {
return(0)
}
for (i=2; i<=int(sqrt(x)); i++) {
if (x % i == 0) {
return(0)
}
}
return(1)
}
Output:
17 (4+13)
BASIC
BASIC256
for s = 2 to 100
a = satisfies_statement3(s)
if a <> 0 then print s & " (" & a & "+" & s - a & ")"
next s
end
function is_prime(x)
if x <= 1 then return false
for i = 2 to sqr(x)
if x mod i = 0 then return false
next i
return True
end function
function satisfies_statement1(s)
for a = 2 to s \ 2
if is_prime(a) and is_prime(s - a) then return false
next a
return true
end function
function satisfies_statement2(p)
winner = 0
for i = 2 to sqr(p)
if p mod i = 0 then
j = p \ i
if j < 2 or j > 99 then continue for
if satisfies_statement1(i + j) then
if winner then return false
winner = 1
end if
end if
next i
return winner
end function
function satisfies_statement3(s)
if not satisfies_statement1(s) then return false
winner = 0
for a = 2 to s \ 2
b = s - a
if satisfies_statement2(a * b) then
if winner then return false
winner = a
end if
next a
return winner
end function
- Output:
Same as FreeBASIC entry.
Gambas
Function is_prime(x As Integer) As Boolean
If x <= 1 Then Return False
For i As Integer = 2 To Sqr(x)
If x Mod i = 0 Then Return False
Next
Return True
End Function
Function satisfies_statement1(s As Integer) As Boolean
For a As Integer = 2 To s \ 2
If is_prime(a) And is_prime(s - a) Then Return False
Next
Return True
End Function
Function satisfies_statement2(p As Integer) As Integer
Dim winner As Integer = 0
For i As Integer = 2 To Sqr(p)
If p Mod i = 0 Then
Dim j As Integer = p \ i
If j < 2 Or j > 99 Then Continue
If satisfies_statement1(i + j) Then
If winner Then Return False
winner = 1
End If
End If
Next
Return winner
End Function
Function satisfies_statement3(s As Integer) As Integer
If Not satisfies_statement1(s) Then Return False
Dim winner As Integer = 0
For a As Integer = 2 To s \ 2
Dim b As Integer = s - a
If satisfies_statement2(a * b) Then
If winner Then Return False
winner = a
End If
Next
Return winner
End Function
Public Sub Main()
For s As Integer = 2 To 100
Dim a As Integer = satisfies_statement3(s)
If a <> 0 Then Print s; " ("; a; "+"; s - a; ")"
Next
End
- Output:
Same as FreeBASIC entry.
C
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
typedef struct node_t {
int x, y;
struct node_t *prev, *next;
} node;
node *new_node(int x, int y) {
node *n = malloc(sizeof(node));
n->x = x;
n->y = y;
n->next = NULL;
n->prev = NULL;
return n;
}
void free_node(node **n) {
if (n == NULL) {
return;
}
(*n)->prev = NULL;
(*n)->next = NULL;
free(*n);
*n = NULL;
}
typedef struct list_t {
node *head;
node *tail;
} list;
list make_list() {
list lst = { NULL, NULL };
return lst;
}
void append_node(list *const lst, int x, int y) {
if (lst == NULL) {
return;
}
node *n = new_node(x, y);
if (lst->head == NULL) {
lst->head = n;
lst->tail = n;
} else {
n->prev = lst->tail;
lst->tail->next = n;
lst->tail = n;
}
}
void remove_node(list *const lst, const node *const n) {
if (lst == NULL || n == NULL) {
return;
}
if (n->prev != NULL) {
n->prev->next = n->next;
if (n->next != NULL) {
n->next->prev = n->prev;
} else {
lst->tail = n->prev;
}
} else {
if (n->next != NULL) {
n->next->prev = NULL;
lst->head = n->next;
}
}
free_node(&n);
}
void free_list(list *const lst) {
node *ptr;
if (lst == NULL) {
return;
}
ptr = lst->head;
while (ptr != NULL) {
node *nxt = ptr->next;
free_node(&ptr);
ptr = nxt;
}
lst->head = NULL;
lst->tail = NULL;
}
void print_list(const list *lst) {
node *it;
if (lst == NULL) {
return;
}
for (it = lst->head; it != NULL; it = it->next) {
int sum = it->x + it->y;
int prod = it->x * it->y;
printf("[%d, %d] S=%d P=%d\n", it->x, it->y, sum, prod);
}
}
void print_count(const list *const lst) {
node *it;
int c = 0;
if (lst == NULL) {
return;
}
for (it = lst->head; it != NULL; it = it->next) {
c++;
}
if (c == 0) {
printf("no candidates\n");
} else if (c == 1) {
printf("one candidate\n");
} else {
printf("%d candidates\n", c);
}
}
void setup(list *const lst) {
int x, y;
if (lst == NULL) {
return;
}
// numbers must be greater than 1
for (x = 2; x <= 98; x++) {
// numbers must be unique, and sum no more than 100
for (y = x + 1; y <= 98; y++) {
if (x + y <= 100) {
append_node(lst, x, y);
}
}
}
}
void remove_by_sum(list *const lst, const int sum) {
node *it;
if (lst == NULL) {
return;
}
it = lst->head;
while (it != NULL) {
int s = it->x + it->y;
if (s == sum) {
remove_node(lst, it);
it = lst->head;
} else {
it = it->next;
}
}
}
void remove_by_prod(list *const lst, const int prod) {
node *it;
if (lst == NULL) {
return;
}
it = lst->head;
while (it != NULL) {
int p = it->x * it->y;
if (p == prod) {
remove_node(lst, it);
it = lst->head;
} else {
it = it->next;
}
}
}
void statement1(list *const lst) {
short *unique = calloc(100000, sizeof(short));
node *it, *nxt;
for (it = lst->head; it != NULL; it = it->next) {
int prod = it->x * it->y;
unique[prod]++;
}
it = lst->head;
while (it != NULL) {
int prod = it->x * it->y;
nxt = it->next;
if (unique[prod] == 1) {
remove_by_sum(lst, it->x + it->y);
it = lst->head;
} else {
it = nxt;
}
}
free(unique);
}
void statement2(list *const candidates) {
short *unique = calloc(100000, sizeof(short));
node *it, *nxt;
for (it = candidates->head; it != NULL; it = it->next) {
int prod = it->x * it->y;
unique[prod]++;
}
it = candidates->head;
while (it != NULL) {
int prod = it->x * it->y;
nxt = it->next;
if (unique[prod] > 1) {
remove_by_prod(candidates, prod);
it = candidates->head;
} else {
it = nxt;
}
}
free(unique);
}
void statement3(list *const candidates) {
short *unique = calloc(100, sizeof(short));
node *it, *nxt;
for (it = candidates->head; it != NULL; it = it->next) {
int sum = it->x + it->y;
unique[sum]++;
}
it = candidates->head;
while (it != NULL) {
int sum = it->x + it->y;
nxt = it->next;
if (unique[sum] > 1) {
remove_by_sum(candidates, sum);
it = candidates->head;
} else {
it = nxt;
}
}
free(unique);
}
int main() {
list candidates = make_list();
setup(&candidates);
print_count(&candidates);
statement1(&candidates);
print_count(&candidates);
statement2(&candidates);
print_count(&candidates);
statement3(&candidates);
print_count(&candidates);
print_list(&candidates);
free_list(&candidates);
return 0;
}
- Output:
2352 candidates 145 candidates 86 candidates one candidate [4, 13] S=17 P=52
C++
#include <algorithm>
#include <iostream>
#include <map>
#include <vector>
std::ostream &operator<<(std::ostream &os, std::vector<std::pair<int, int>> &v) {
for (auto &p : v) {
auto sum = p.first + p.second;
auto prod = p.first * p.second;
os << '[' << p.first << ", " << p.second << "] S=" << sum << " P=" << prod;
}
return os << '\n';
}
void print_count(const std::vector<std::pair<int, int>> &candidates) {
auto c = candidates.size();
if (c == 0) {
std::cout << "no candidates\n";
} else if (c == 1) {
std::cout << "one candidate\n";
} else {
std::cout << c << " candidates\n";
}
}
auto setup() {
std::vector<std::pair<int, int>> candidates;
// numbers must be greater than 1
for (int x = 2; x <= 98; x++) {
// numbers must be unique, and sum no more than 100
for (int y = x + 1; y <= 98; y++) {
if (x + y <= 100) {
candidates.push_back(std::make_pair(x, y));
}
}
}
return candidates;
}
void remove_by_sum(std::vector<std::pair<int, int>> &candidates, const int sum) {
candidates.erase(std::remove_if(
candidates.begin(), candidates.end(),
[sum](const std::pair<int, int> &pair) {
auto s = pair.first + pair.second;
return s == sum;
}
), candidates.end());
}
void remove_by_prod(std::vector<std::pair<int, int>> &candidates, const int prod) {
candidates.erase(std::remove_if(
candidates.begin(), candidates.end(),
[prod](const std::pair<int, int> &pair) {
auto p = pair.first * pair.second;
return p == prod;
}
), candidates.end());
}
void statement1(std::vector<std::pair<int, int>> &candidates) {
std::map<int, int> uniqueMap;
std::for_each(
candidates.cbegin(), candidates.cend(),
[&uniqueMap](const std::pair<int, int> &pair) {
auto prod = pair.first * pair.second;
uniqueMap[prod]++;
}
);
bool loop;
do {
loop = false;
for (auto &pair : candidates) {
auto prod = pair.first * pair.second;
if (uniqueMap[prod] == 1) {
auto sum = pair.first + pair.second;
remove_by_sum(candidates, sum);
loop = true;
break;
}
}
} while (loop);
}
void statement2(std::vector<std::pair<int, int>> &candidates) {
std::map<int, int> uniqueMap;
std::for_each(
candidates.cbegin(), candidates.cend(),
[&uniqueMap](const std::pair<int, int> &pair) {
auto prod = pair.first * pair.second;
uniqueMap[prod]++;
}
);
bool loop;
do {
loop = false;
for (auto &pair : candidates) {
auto prod = pair.first * pair.second;
if (uniqueMap[prod] > 1) {
remove_by_prod(candidates, prod);
loop = true;
break;
}
}
} while (loop);
}
void statement3(std::vector<std::pair<int, int>> &candidates) {
std::map<int, int> uniqueMap;
std::for_each(
candidates.cbegin(), candidates.cend(),
[&uniqueMap](const std::pair<int, int> &pair) {
auto sum = pair.first + pair.second;
uniqueMap[sum]++;
}
);
bool loop;
do {
loop = false;
for (auto &pair : candidates) {
auto sum = pair.first + pair.second;
if (uniqueMap[sum] > 1) {
remove_by_sum(candidates, sum);
loop = true;
break;
}
}
} while (loop);
}
int main() {
auto candidates = setup();
print_count(candidates);
statement1(candidates);
print_count(candidates);
statement2(candidates);
print_count(candidates);
statement3(candidates);
print_count(candidates);
std::cout << candidates;
return 0;
}
- Output:
2352 candidates 145 candidates 86 candidates one candidate [4, 13] S=17 P=52
C#
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);
}
- Output:
2352 145 86 1 { X = 4, Y = 13, S = 17, P = 52 }
Common Lisp
Version 1
;;; Calculate all x's and their possible y's.
(defparameter *x-possibleys*
(loop for x from 2 to 49
collect (cons x (loop for y from (- 100 x) downto (1+ x)
collect y)))
"For every x there are certain y's, with respect to the rules of the puzzle")
(defun xys-operation (op x-possibleys)
"returns an alist of ((x possible-y) . (op x possible-y))"
(let ((x (car x-possibleys))
(ys (cdr x-possibleys)))
(mapcar #'(lambda (y) (cons (list x y) (funcall op x y))) ys)))
(defun sp-numbers (op x-possibleys)
"generates all possible sums or products of the puzzle"
(loop for xys in x-possibleys
append (xys-operation op xys)))
(defun group-sp (sp-numbers)
"sp: Sum or Product"
(loop for sp-number in (remove-duplicates sp-numbers :key #'cdr)
collect (cons (cdr sp-number)
(mapcar #'car
(remove-if-not
#'(lambda (sp) (= sp (cdr sp-number)))
sp-numbers
:key #'cdr)))))
(defun statement-1a (sum-groups)
"remove all sums with a single possible xy"
(remove-if
#'(lambda (xys) (= (list-length xys) 1))
sum-groups
:key #'cdr))
(defun statement-1b (x-possibleys)
"S says: P does not know X and Y."
(let ((multi-xy-sums (statement-1a (group-sp (sp-numbers #'+ x-possibleys))))
(products (group-sp (sp-numbers #'* x-possibleys))))
(flet ((sum-has-xy-which-leads-to-unique-prod (sum-xys)
;; is there any product with a single possible xy?
(some #'(lambda (prod-xys) (= (list-length (cdr prod-xys)) 1))
;; all possible xys of the sum's (* x ys)
(mapcar #'(lambda (xy) (assoc (apply #'* xy) products))
(cdr sum-xys)))))
;; remove sums with even one xy which leads to a unique product
(remove-if #'sum-has-xy-which-leads-to-unique-prod multi-xy-sums))))
(defun remaining-products (remaining-sums-xys)
"P's number is one of these"
(loop for sum-xys in remaining-sums-xys
append (loop for xy in (cdr sum-xys)
collect (apply #'* xy))))
(defun statement-2 (remaining-sums-xys)
"P says: Now I know X and Y."
(let ((remaining-products (remaining-products remaining-sums-xys)))
(mapcar #'(lambda (a-sum-unit)
(cons (car a-sum-unit)
(mapcar #'(lambda (xy)
(list (count (apply #'* xy) remaining-products)
xy))
(cdr a-sum-unit))))
remaining-sums-xys)))
(defun statement-3 (remaining-sums-with-their-products-occurrences-info)
"S says: Now I also know X and Y."
(remove-if
#'(lambda (sum-xys)
;; remove those sums which have more than 1 product, that
;; appear only once amongst all remaining products
(> (count 1 sum-xys :key #'car) 1))
remaining-sums-with-their-products-occurrences-info
:key #'cdr))
(defun solution (survivor-sum-and-its-xys)
"Now we know X and Y too :-D"
(let* ((sum (caar survivor-sum-and-its-xys))
(xys (cdar survivor-sum-and-its-xys))
(xy (second (find 1 xys :key #'car))))
(pairlis '(x y sum product)
(list (first xy) (second xy) sum (apply #'* xy)))))
(solution
(statement-3
(statement-2
(statement-1b *x-possibleys*)))) ;; => ((PRODUCT . 52) (SUM . 17) (Y . 13) (X . 4))
Version 2
;;; Algorithm of Rosetta code:
;;; All possible pairs
(defparameter *all-possible-pairs*
(loop for i from 2 upto 100
append (loop for j from (1+ i) upto 100
if (<= (+ i j) 100)
collect (list i j))))
(defun oncep (item list)
(eql 1 (count item list)))
;;; Terminology
(defun sum-decomp (n)
(loop for x from 2 below (/ n 2)
for y = (- n x)
collect (list x y)))
(defun prod-decomp (n)
(loop for x from 2 below (sqrt n)
for y = (/ n x)
if (and (>= 100 (+ x y)) (zerop (rem n x)))
collect (list x y)))
;;; For every possible sum decomposition of the number X+Y, the product has in turn more than one product decomposition:
(defun fact-1 (n)
"n = x + y"
(flet ((premise (pair)
(> (list-length (prod-decomp (apply #'* pair))) 1)))
(every #'premise (sum-decomp n))))
;;; The number X*Y has only one product decomposition for which fact 1 is true:
(defun fact-2 (n)
"n = x * y"
(oncep t (mapcar (lambda (pair) (fact-1 (apply #'+ pair))) (prod-decomp n))))
;;; The number X+Y has only one sum decomposition for which fact 2 is true:
(defun fact-3 (n)
"n = x + y"
(oncep t (mapcar (lambda (pair) (fact-2 (apply #'* pair))) (sum-decomp n))))
(defun find-xy (all-possible-pairs)
(remove-if-not
#'(lambda (p) (fact-3 (apply #'+ p)))
(remove-if-not
#'(lambda (p) (fact-2 (apply #'* p)))
(remove-if-not
#'(lambda (p) (fact-1 (apply #'+ p)))
all-possible-pairs))))
(find-xy *all-possible-pairs*) ;; => ((4 13))
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;
}
- Output:
[const(Tuple!(int, int))(4, 13)]
With an older version of the LDC2 compiler replace the cartesianProduct
line with:
const s1 = iota(1, 101).map!(x => iota(1, 101).map!(y => tuple(x, y))).joiner
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
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
- Output:
[{4, 13}]
Factor
A loose translation of D.
USING: combinators.short-circuit fry kernel literals math
math.ranges memoize prettyprint sequences sets tools.time ;
IN: rosetta-code.sum-and-product
CONSTANT: s1 $[
2 100 [a,b] dup cartesian-product concat
[ first2 { [ < ] [ + 100 < ] } 2&& ] filter
]
: quot-eq ( pair quot -- seq )
[ s1 ] 2dip tuck '[ @ _ @ = ] filter ; inline
MEMO: sum-eq ( pair -- seq ) [ first2 + ] quot-eq ;
MEMO: mul-eq ( pair -- seq ) [ first2 * ] quot-eq ;
: s2 ( -- seq )
s1 [ sum-eq [ mul-eq length 1 = not ] all? ] filter ;
: only-1 ( seq quot -- newseq )
over '[ @ _ intersect length 1 = ] filter ; inline
: sum-and-product ( -- )
[ s2 [ mul-eq ] [ sum-eq ] [ only-1 ] bi@ . ] time ;
MAIN: sum-and-product
- Output:
{ { 4 13 } } Running time: 0.241637693 seconds
FreeBASIC
Runs in 0.001s
Function is_prime(x As Integer) As Boolean
If x <= 1 Then Return False
For i As Integer = 2 To Sqr(x)
If x Mod i = 0 Then Return False
Next i
Return True
End Function
Function satisfies_statement1(s As Integer) As Boolean
For a As Integer = 2 To s \ 2
If is_prime(a) And is_prime(s - a) Then Return False
Next a
Return True
End Function
Function satisfies_statement2(p As Integer) As Integer
Dim As Integer i, j
Dim winner As Integer = 0
For i = 2 To Sqr(p)
If p Mod i = 0 Then
j = p \ i
If j < 2 Or j > 99 Then Continue For
If satisfies_statement1(i + j) Then
If winner Then Return False
winner = 1
End If
End If
Next i
Return winner
End Function
Function satisfies_statement3(s As Integer) As Integer
Dim As Integer a, b
If Not satisfies_statement1(s) Then Return False
Dim winner As Integer = 0
For a = 2 To s \ 2
b = s - a
If satisfies_statement2(a * b) Then
If winner Then Return False
winner = a
End If
Next a
Return winner
End Function
Dim As Integer s, a
For s = 2 To 100
a = satisfies_statement3(s)
If a <> 0 Then
Print s & " (" & a & "+" & s - a & ")"
End If
Next s
Sleep
- Output:
17 (4+13)
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
}
- 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
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
- Output:
[(4,13)]
Run-time: about 1.97 seconds.
Or, to illustrate some of the available variants, it turns out that we can double performance by slightly rearranging the filters in sumEq and mulEq. It also proves fractionally faster to shed some of the of outer list comprehension sugaring, using >>= or concatMap directly.
For a further doubling of performance, we can redefine add and mul as uncurried versions of (+) and (*).
The y > x condition can usefully be moved upstream – dropping it from the test, and redefining the range of y as [x + 1 .. 100] from the start. (The 1 < x test can also be moved out of the test and into the initial generator).
Finally, as we expect and need only one solution, Haskell's lazy evaluation strategy will avoid wasted tests if we request only the first item from the possible solution stream.
import Data.List (intersect)
------------------ SUM AND PRODUCT PUZZLE ----------------
s1, s2, s3, s4 :: [(Int, Int)]
s1 =
[2 .. 100]
>>= \x ->
[succ x .. 100]
>>= \y ->
[ (x, y)
| x + y < 100
]
s2 = filter (all ((1 /=) . length . mulEq) . sumEq) s1
s3 = filter ((1 ==) . length . (`intersect` s2) . mulEq) s2
s4 = filter ((1 ==) . length . (`intersect` s3) . sumEq) s3
sumEq, mulEq :: (Int, Int) -> [(Int, Int)]
sumEq p = filter ((add p ==) . add) s1
mulEq p = filter ((mul p ==) . mul) s1
add, mul :: (Int, Int) -> Int
add = uncurry (+)
mul = uncurry (*)
--------------------------- TEST -------------------------
main :: IO ()
main = print $ take 1 s4
- Output:
[(4,13)]
J
Tacit Solution
(S=. X + Y) (P=. X * Y) (X=. 0&{"1) (Y=. 1&{"1)
(sd=. S </. ]) (pd=. P </. ]) NB. sum and product decompositions
candidates=. ([ echo o (' candidates' ,~ ": (o=. @:) #))
constraints=. (([ >: S o ]) and ((1 < X) and (1 < Y) (and=. *.) (X < Y)) o ])
filter0=. candidates o (constraints # ])
patesd=. S (< o P)/. ] NB. products associated to each sum decomposition
pmtod=. P o ; o (pd #~ 1 < P #/. ]) NB. products with more than one decomposition
filter1=. candidates o ((patesd ('' -: -.)&>"0 _ < o pmtod) ; o # sd)
filter2=. candidates o ; o (pd #~ 1 = (#&>) o pd)
filter3=. candidates o ; o (sd #~ 1 = (#&>) o sd)
decompositions=. > o , o { o (;~) o i.
show=. 'X=' , ": o X ,' Y=' , ": o Y , ' X+Y=' , ": o (X+Y) , ' X*Y=' , ": o (X*Y)
solve=. show :: (''"_) o filter3 o filter2 o filter1 o (] filter0 decompositions) f.
Example use:
solve 100
2352 candidates
145 candidates
86 candidates
1 candidates
X=4 Y=13 X+Y=17 X*Y=52
solve 64
930 candidates
62 candidates
46 candidates
0 candidates
solve 1685
707281 candidates
51011 candidates
17567 candidates
2 candidates
X=4 4 Y=13 61 X+Y=17 65 X*Y=52 244
solve 1970
967272 candidates
70475 candidates
23985 candidates
3 candidates
X=4 4 16 Y=13 61 73 X+Y=17 65 89 X*Y=52 244 1168
solve 2522
1586340 candidates
116238 candidates
37748 candidates
4 candidates
X=4 4 16 16 Y=13 61 73 111 X+Y=17 65 89 127 X*Y=52 244 1168 1776
The code is tacit and fixed (in other words, it is point-free):
_80 [\ (5!:5)<'solve'
('X=' , ":@:(0&{"1) , ' Y=' , ":@:(1&{"1) , ' X+Y=' , ":@:(0&{"1 + 1&{"1) , ' X*
Y=' , ":@:(0&{"1 * 1&{"1)) ::(''"_)@:(([ 0 0&$@(1!:2&2)@:(' candidates' ,~ ":@:#
))@:;@:(((0&{"1 + 1&{"1) </. ]) #~ 1 = #&>@:((0&{"1 + 1&{"1) </. ])))@:(([ 0 0&$
@(1!:2&2)@:(' candidates' ,~ ":@:#))@:;@:(((0&{"1 * 1&{"1) </. ]) #~ 1 = #&>@:((
0&{"1 * 1&{"1) </. ])))@:(([ 0 0&$@(1!:2&2)@:(' candidates' ,~ ":@:#))@:((((0&{"
1 + 1&{"1) <@:(0&{"1 * 1&{"1)/. ]) ('' -: -.)&>"0 _ <@:((0&{"1 * 1&{"1)@:;@:(((0
&{"1 * 1&{"1) </. ]) #~ 1 < (0&{"1 * 1&{"1) #/. ]))) ;@:# (0&{"1 + 1&{"1) </. ])
)@:(] ([ 0 0&$@(1!:2&2)@:(' candidates' ,~ ":@:#))@:((([ >: (0&{"1 + 1&{"1)@:])
*. ((1 < 0&{"1) *. (1 < 1&{"1) *. 0&{"1 < 1&{"1)@:]) # ]) >@:,@:{@:(;~)@:i.)
Java
package org.rosettacode;
import java.util.ArrayList;
import java.util.List;
/**
* This program applies the logic in the Sum and Product Puzzle for the value
* provided by systematically applying each requirement to all number pairs in
* range. Note that the requirements: (x, y different), (x < y), and
* (x, y > MIN_VALUE) are baked into the loops in run(), sumAddends(), and
* productFactors(), so do not need a separate test. Also note that to test a
* solution to this logic puzzle, it is suggested to test the condition with
* maxSum = 1685 to ensure that both the original solution (4, 13) and the
* additional solution (4, 61), and only these solutions, are found. Note
* also that at 1684 only the original solution should be found!
*/
public class SumAndProductPuzzle {
private final long beginning;
private final int maxSum;
private static final int MIN_VALUE = 2;
private List<int[]> firstConditionExcludes = new ArrayList<>();
private List<int[]> secondConditionExcludes = new ArrayList<>();
public static void main(String... args){
if (args.length == 0){
new SumAndProductPuzzle(100).run();
new SumAndProductPuzzle(1684).run();
new SumAndProductPuzzle(1685).run();
} else {
for (String arg : args){
try{
new SumAndProductPuzzle(Integer.valueOf(arg)).run();
} catch (NumberFormatException e){
System.out.println("Please provide only integer arguments. " +
"Provided argument " + arg + " was not an integer. " +
"Alternatively, calling the program with no arguments " +
"will run the puzzle where maximum sum equals 100, 1684, and 1865.");
}
}
}
}
public SumAndProductPuzzle(int maxSum){
this.beginning = System.currentTimeMillis();
this.maxSum = maxSum;
System.out.println("Run with maximum sum of " + String.valueOf(maxSum) +
" started at " + String.valueOf(beginning) + ".");
}
public void run(){
for (int x = MIN_VALUE; x < maxSum - MIN_VALUE; x++){
for (int y = x + 1; y < maxSum - MIN_VALUE; y++){
if (isSumNoGreaterThanMax(x,y) &&
isSKnowsPCannotKnow(x,y) &&
isPKnowsNow(x,y) &&
isSKnowsNow(x,y)
){
System.out.println("Found solution x is " + String.valueOf(x) + " y is " + String.valueOf(y) +
" in " + String.valueOf(System.currentTimeMillis() - beginning) + "ms.");
}
}
}
System.out.println("Run with maximum sum of " + String.valueOf(maxSum) +
" ended in " + String.valueOf(System.currentTimeMillis() - beginning) + "ms.");
}
public boolean isSumNoGreaterThanMax(int x, int y){
return x + y <= maxSum;
}
public boolean isSKnowsPCannotKnow(int x, int y){
if (firstConditionExcludes.contains(new int[] {x, y})){
return false;
}
for (int[] addends : sumAddends(x, y)){
if ( !(productFactors(addends[0], addends[1]).size() > 1) ) {
firstConditionExcludes.add(new int[] {x, y});
return false;
}
}
return true;
}
public boolean isPKnowsNow(int x, int y){
if (secondConditionExcludes.contains(new int[] {x, y})){
return false;
}
int countSolutions = 0;
for (int[] factors : productFactors(x, y)){
if (isSKnowsPCannotKnow(factors[0], factors[1])){
countSolutions++;
}
}
if (countSolutions == 1){
return true;
} else {
secondConditionExcludes.add(new int[] {x, y});
return false;
}
}
public boolean isSKnowsNow(int x, int y){
int countSolutions = 0;
for (int[] addends : sumAddends(x, y)){
if (isPKnowsNow(addends[0], addends[1])){
countSolutions++;
}
}
return countSolutions == 1;
}
public List<int[]> sumAddends(int x, int y){
List<int[]> list = new ArrayList<>();
int sum = x + y;
for (int addend = MIN_VALUE; addend < sum - addend; addend++){
if (isSumNoGreaterThanMax(addend, sum - addend)){
list.add(new int[]{addend, sum - addend});
}
}
return list;
}
public List<int[]> productFactors(int x, int y){
List<int[]> list = new ArrayList<>();
int product = x * y;
for (int factor = MIN_VALUE; factor < product / factor; factor++){
if (product % factor == 0){
if (isSumNoGreaterThanMax(factor, product / factor)){
list.add(new int[]{factor, product / factor});
}
}
}
return list;
}
}
- Output:
Run with maximum sum of 100 started at 1492436207694. Found solution x is 4 y is 13 in 7ms. Run with maximum sum of 100 ended in 54ms. Run with maximum sum of 1684 started at 1492436207748. Found solution x is 4 y is 13 in 9084ms. Run with maximum sum of 1684 ended in 8234622ms. Run with maximum sum of 1685 started at 1492444442371. Found solution x is 4 y is 13 in 8922ms. Found solution x is 4 y is 61 in 8939ms. Run with maximum sum of 1685 ended in 8013991ms.
JavaScript
ES5
(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;
})();
- Output:
[[4, 13]]
(Finished in 0.69s)
ES6
(() => {
"use strict";
// ------------- SUM AND PRODUCT PUZZLE --------------
// main :: IO ()
const main = () => {
const
// xs :: [Int]
xs = enumFromTo(1)(100),
// s1 s2, s3, s4 :: [(Int, Int)]
s1 = xs.flatMap(
x => xs.flatMap(y =>
(1 < x) && (x < y) && 100 > (x + y) ? [
[x, y]
] : []
)
),
s2 = s1.filter(
p => sumEq(p, s1).every(
q => 1 < mulEq(q, s1).length
)
),
s3 = s2.filter(
p => 1 === intersectBy(pairEQ)(
mulEq(p, s1)
)(s2).length
);
return s3.filter(
p => 1 === intersectBy(pairEQ)(
sumEq(p, s1)
)(s3).length
);
};
// ---------------- PROBLEM FUNCTIONS ----------------
// add, mul :: (Int, Int) -> Int
const
add = xy => xy[0] + xy[1],
mul = xy => xy[0] * xy[1],
// sumEq, mulEq :: (Int, Int) ->
// [(Int, Int)] -> [(Int, Int)]
sumEq = (p, s) => {
const addP = add(p);
return s.filter(q => add(q) === addP);
},
mulEq = (p, s) => {
const mulP = mul(p);
return s.filter(q => mul(q) === mulP);
},
// pairEQ :: ((a, a) -> (a, a)) -> Bool
pairEQ = a => b => (
a[0] === b[0]
) && (a[1] === b[1]);
// ---------------- GENERIC FUNCTIONS ----------------
// enumFromTo :: Int -> Int -> [Int]
const enumFromTo = m =>
n => Array.from({
length: 1 + n - m
}, (_, i) => m + i);
// intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
const intersectBy = eqFn =>
// The intersection of the lists xs and ys
// in terms of the equality defined by eq.
xs => ys => xs.filter(
x => ys.some(eqFn(x))
);
// MAIN ---
return main();
})();
- Output:
[[4, 13]]
jq
Works with: jq
Works with: gojq (the Go implementation of jq)
A transcription from the problem statement, with these helper functions:
# For readability:
def collect(c): map(select(c));
# stream-oriented checks:
def hasMoreThanOne(s): [limit(2;s)] | length > 1;
def hasOne(s): [limit(2;s)] | length == 1;
def prod: .[0] * .[1];
## A stream of admissible [x,y] values
def xy:
[range(2;50) as $x # 1 < X < Y < 100
| range($x+1; 101-$x) as $y
| [$x, $y] ] ;
# The stream of [x,y] pairs matching "S knows the sum is $sum"
def sumEq($sum): select( $sum == add );
# The stream of [x,y] pairs matching "P knows the product is $prod"
def prodEq($p): select( $p == prod );
## The solver:
def solve:
xy as $s0
# S says P does not know:
| $s0
| collect(add as $sum
| all( $s0[]|sumEq($sum);
prod as $p
| hasMoreThanOne($s0[] | prodEq($p)))) as $s1
# P says: Now I know:
| $s1
| collect(prod as $prod | hasOne( $s1[]|prodEq($prod)) ) as $s2
# S says: Now I also know
| $s2[]
| select(add as $sum | hasOne( $s2[] | sumEq($sum)) ) ;
solve
- Output:
[4,13]
Julia
From the awk/sidef version. It is also possible to use filters as in the Scala solution, but although less verbose, using filters would be much slower in Julia, which often favors fast for loops over lists for speed.
using Primes
function satisfy1(x::Integer)
prmslt100 = primes(100)
for i in 2:(x ÷ 2)
if i ∈ prmslt100 && x - i ∈ prmslt100
return false
end
end
return true
end
function satisfy2(x::Integer)
once = false
for i in 2:isqrt(x)
if x % i == 0
j = x ÷ i
if 2 < j < 100 && satisfy1(i + j)
if once return false end
once = true
end
end
end
return once
end
function satisfyboth(x::Integer)
if !satisfy1(x) return 0 end
found = 0
for i in 2:(x ÷ 2)
if satisfy2(i * (x - i))
if found > 0 return 0 end
found = i
end
end
return found
end
for i in 2:99
if (j = satisfyboth(i)) > 0
println("Solution: ($j, $(i - j))")
end
end
- Output:
Solution: (4, 13)
Kotlin
// version 1.1.4-3
data class P(val x: Int, val y: Int, val sum: Int, val prod: Int)
fun main(args: Array<String>) {
val candidates = mutableListOf<P>()
for (x in 2..49) {
for (y in x + 1..100 - x) {
candidates.add(P(x, y, x + y, x * y))
}
}
val sums = candidates.groupBy { it.sum }
val prods = candidates.groupBy { it.prod }
val fact1 = candidates.filter { sums[it.sum]!!.all { prods[it.prod]!!.size > 1 } }
val fact2 = fact1.filter { prods[it.prod]!!.intersect(fact1).size == 1 }
val fact3 = fact2.filter { sums[it.sum]!!.intersect(fact2).size == 1 }
print("The only solution is : ")
for ((x, y, _, _) in fact3) println("x = $x, y = $y")
}
- Output:
The only solution is : x = 4, y = 13
Lua
function print_count(t)
local cnt = 0
for k,v in pairs(t) do
cnt = cnt + 1
end
print(cnt .. ' candidates')
end
function make_pair(a,b)
local t = {}
table.insert(t, a) -- 1
table.insert(t, b) -- 2
return t
end
function setup()
local candidates = {}
for x = 2, 98 do
for y = x + 1, 98 do
if x + y <= 100 then
local p = make_pair(x, y)
table.insert(candidates, p)
end
end
end
return candidates
end
function remove_by_sum(candidates, sum)
for k,v in pairs(candidates) do
local s = v[1] + v[2]
if s == sum then
table.remove(candidates, k)
end
end
end
function remove_by_prod(candidates, prod)
for k,v in pairs(candidates) do
local p = v[1] * v[2]
if p == prod then
table.remove(candidates, k)
end
end
end
function statement1(candidates)
local unique = {}
for k,v in pairs(candidates) do
local prod = v[1] * v[2]
if unique[prod] ~= nil then
unique[prod] = unique[prod] + 1
else
unique[prod] = 1
end
end
local done
repeat
done = true
for k,v in pairs(candidates) do
local prod = v[1] * v[2]
if unique[prod] == 1 then
local sum = v[1] + v[2]
remove_by_sum(candidates, sum)
done = false
break
end
end
until done
end
function statement2(candidates)
local unique = {}
for k,v in pairs(candidates) do
local prod = v[1] * v[2]
if unique[prod] ~= nil then
unique[prod] = unique[prod] + 1
else
unique[prod] = 1
end
end
local done
repeat
done = true
for k,v in pairs(candidates) do
local prod = v[1] * v[2]
if unique[prod] > 1 then
remove_by_prod(candidates, prod)
done = false
break
end
end
until done
end
function statement3(candidates)
local unique = {}
for k,v in pairs(candidates) do
local sum = v[1] + v[2]
if unique[sum] ~= nil then
unique[sum] = unique[sum] + 1
else
unique[sum] = 1
end
end
local done
repeat
done = true
for k,v in pairs(candidates) do
local sum = v[1] + v[2]
if unique[sum] > 1 then
remove_by_sum(candidates, sum)
done = false
break
end
end
until done
end
function main()
local candidates = setup()
print_count(candidates)
statement1(candidates)
print_count(candidates)
statement2(candidates)
print_count(candidates)
statement3(candidates)
print_count(candidates)
for k,v in pairs(candidates) do
local sum = v[1] + v[2]
local prod = v[1] * v[2]
print("a=" .. v[1] .. ", b=" .. v[2] .. "; S=" .. sum .. ", P=" .. prod)
end
end
main()
- Output:
2352 candidates 145 candidates 86 candidates 1 candidates a=4, b=13; S=17, P=52
MATLAB
function SumProductPuzzle(maxSum, m)
% SumProductPuzzle(maxSum=100, m=2)
% Efficiently solve the Sum and Product puzzle.
% No solution if maxSum < 65; multiple solutions if maxSum >= 1685.
if nargin<2
m = 2; % minimum number
if nargin<1
maxSum = 100;
end
end
%Step 1: Determine viable sums; i.e. sums for which all possibilities have
% non-unique products
productCount = zeros(1,floor((maxSum/2)^2)); % Memory hog
for i = m:(maxSum/2-1)
j = i+1:maxSum-i;
ij = i*j;
productCount(ij) = productCount(ij) +1;
end
viableSum = true(1,maxSum);
viableSum(1:2*m) = false;
for s = 2*m+1:maxSum
i = m:(s-1)/2;
j = s-i;
if any(productCount(i.*j) == 1)
viableSum(s) = false;
end
end
tmp = 1:maxSum;
sums = tmp(viableSum);
N1 = sum(floor((sums+1)/2) - m);
fprintf( 1, 'After step 1: %d viable sums (%d total possibilities).\n', length(sums), N1 );
%Step 2: Determine which possibilities now have unique products
productCount = zeros(1,floor((maxSum/2)^2));
for s = sums
i = m:(s-1)/2;
j = s-i;
ij = i.*j;
productCount(ij) = productCount(ij) +1;
end
A = zeros(2,N1); %Pre-allocate for speed
n = 1;
for s = sums
i = m:(s-1)/2;
j = s-i;
ii = productCount(i.*j) == 1;
ij = [i(ii); j(ii)];
nn = n + size(ij,2);
A(:,n:nn-1) = ij;
n = nn;
end
A(:,nn:end) = [];
fprintf( 1, 'After step 2: %d possibilities.\n', size(A,2) );
%Step 3: Narrow down to pairs that have unique sums.
% Since the values are in sum order, just check the neighbor's sum.
d = diff(sum(A))==0;
ii = [d false] | [false d];
A(:,ii) = [];
switch size(A,2)
case 0
fprintf(1,'No solution.\n');
case 1
fprintf(1,'Puzzle solved! The numbers are %d and %d.\n', A(1:2));
otherwise
fprintf(1,'After step 3 there are still multiple possibilities:');
fprintf(1,' (%d, %d)', A(1:2,:));
fprintf(1,'\n');
end
- Output:
>> tic; SumProductPuzzle; toc After step 1: 10 viable sums (145 total possibilities). After step 2: 86 possibilities. Puzzle solved! The numbers are 4 and 13. Elapsed time is 0.004797 seconds. >> tic; SumProductPuzzle(1685); toc After step 1: 235 viable sums (51011 total possibilities). After step 2: 17567 possibilities. After step 3 there are still multiple possibilities: (4, 13) (4, 61) Elapsed time is 0.038874 seconds. >> tic; SumProductPuzzle(1970); toc After step 1: 278 viable sums (70475 total possibilities). After step 2: 23985 possibilities. After step 3 there are still multiple possibilities: (4, 13) (4, 61) (16, 73) Elapsed time is 0.041495 seconds.
Nim
import sequtils, sets, sugar, tables
var
xycandidates = toSeq(2..98)
sums = collect(initHashSet, for s in 5..100: {s}) # Set of possible sums.
factors: Table[int, seq[(int, int)]] # Mapping product -> list of factors.
# Build the factor mapping.
for i in 0..<xycandidates.high:
let x = xycandidates[i]
for j in (i + 1)..xycandidates.high:
let y = xycandidates[j]
factors.mgetOrPut(x * y, @[]).add (x, y)
iterator terms(n: int): (int, int) =
## Yield the possible terms (x, y) of a given sum.
for x in 2..(n - 1) div 2:
yield (x, n - x)
# S says "P does not know X and Y."
# => For every decomposition of S, there is no product with a single decomposition.
for s in toSeq(sums):
for (x, y) in s.terms():
let p = x * y
if factors[p].len == 1:
sums.excl s
break
# P says "Now I know X and Y."
# => P has only one decomposition with sum in "sums".
for p in toSeq(factors.keys):
var sums = collect(initHashSet):
for (x, y) in factors[p]:
if x + y in sums: {x + y}
if card(sums) > 1: factors.del p
# S says "Now I also know X and Y."
# => S has only one decomposition with product in "factors".
for s in toSeq(sums):
var prods = collect(initHashSet):
for (x, y) in s.terms():
if x * y in factors: {x * y}
if card(prods) > 1: sums.excl s
# Now, combine the sums and the products.
for s in sums:
for (x, y) in s.terms:
if x * y in factors: echo (x, y)
- Output:
(4, 13)
ooRexx
version 1
for comments see REXX version 4.
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
- 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 == method (required to make the set difference work)
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"]"
- 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
use List::Util qw(none);
sub grep_unique {
my($by, @list) = @_;
my @seen;
for (@list) {
my $x = &$by(@$_);
$seen[$x]= defined $seen[$x] ? 0 : join ' ', @$_;
}
grep { $_ } @seen;
}
sub sums {
my($n) = @_;
my @sums;
push @sums, [$_, $n - $_] for 2 .. int $n/2;
@sums;
}
sub sum { $_[0] + $_[1] }
sub product { $_[0] * $_[1] }
for $i (2..97) {
push @all_pairs, map { [$i, $_] } $i + 1..98
}
# Fact 1:
%p_unique = map { $_ => 1 } grep_unique(\&product, @all_pairs);
for my $p (@all_pairs) {
push @s_pairs, [@$p] if none { $p_unique{join ' ', @$_} } sums sum @$p;
}
# Fact 2:
@p_pairs = map { [split ' ', $_] } grep_unique(\&product, @s_pairs);
# Fact 3:
@final_pair = grep_unique(\&sum, @p_pairs);
printf "X = %d, Y = %d\n", split ' ', $final_pair[0];
- Output:
X = 4, Y = 13
Phix
Runs in 0.03s
with javascript_semantics function satisfies_statement1(integer s) -- S says: P does not know the two numbers. -- Given s, for /all/ pairs (a,b), a+b=s, 2<=a,b<=99, at least one of a or b is composite for a=2 to floor(s/2) do if is_prime(a) and is_prime(s-a) then return false end if end for return true end function function satisfies_statement2(integer p) -- P says: Now I know the two numbers. -- Given p, for /all/ pairs (a,b), a*b=p, 2<=a,b<=99, exactly one pair satisfies statement 1 bool winner = false for i=2 to floor(sqrt(p)) do if mod(p,i)=0 then integer j = floor(p/i) if 2<=j and j<=99 then if satisfies_statement1(i+j) then if winner then return false end if winner = true end if end if end if end for return winner end function function satisfies_statement3(integer s) -- S says: Now I know the two numbers. -- Given s, for /all/ pairs (a,b), a+b=s, 2<=a,b<=99, exactly one pair satisfies statements 1 and 2 integer winner = 0 if satisfies_statement1(s) then for a=2 to floor(s/2) do if satisfies_statement2(a*(s-a)) then if winner then return 0 end if winner = a end if end for end if return winner end function for s=2 to 100 do integer a = satisfies_statement3(s) if a!=0 then printf(1,"%d (%d+%d)\n",{s,a,s-a}) end if end for
- Output:
17 (4+13)
Picat
main =>
N = 98,
PD = new_array(N*N), % PD[I] = no. of product decompositions of I
foreach(I in 1..N*N) PD[I] = 0 end,
foreach(X in 2..N-1, Y in X+1..N) PD[X * Y] := PD[X * Y] + 1 end,
% Fact 1: S says "P does not know X and Y.", i.e.
% For every possible sum decomposition of the number X+Y, the product has in turn more than one product decomposition:
Solutions1 = [[X,Y] : X in 2..N-1, Y in X+1..100-X, foreach(XX in 2..X+Y-3) PD[XX * (X+Y-XX)] > 1 end],
% Fact 2: P says "Now I know X and Y.", i.e.
% The number X*Y has only one product decomposition for which fact 1 is true:
Solutions2 = [[X,Y] : [X,Y] in Solutions1, foreach([XX,YY] in Solutions1, XX * YY = X * Y) XX = X, YY = Y end],
% Fact 3: S says "Now I also know X and Y.", i.e.
% The number X+Y has only one sum decomposition for which fact 2 is true.
Solutions3 = [[X,Y] : [X,Y] in Solutions2, foreach([XX,YY] in Solutions2, XX + YY = X + Y) XX = X, YY = Y end],
println(Solutions3).
Output:
[[4,13]]
Python
Based on the Python solution from Wikipedia:
#!/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)
- 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
(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)
- Output:
Max Sum: 100 Possible pairs: 2352 Initial pairs for S: 145 Pairs for P: 86 Final pairs for S: 1 ((4 13))
Raku
(formerly Perl 6)
sub grep-unique (&by, @list) { @list.classify(&by).values.grep(* == 1).map(*[0]) }
sub sums ($n) { ($_, $n - $_ for 2 .. $n div 2) }
sub product ([$x, $y]) { $x * $y }
sub sum ([$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;
- Output:
X = 4, Y = 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.
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)
wordsort: Procedure
/**********************************************************************
* Sort the list of words supplied as argument. Return the sorted list
**********************************************************************/
Parse Arg wl
wa.=''
wa.0=0
Do While wl<>''
Parse Var wl w wl
Do i=1 To wa.0
If wa.i>w Then Leave
End
If i<=wa.0 Then Do
Do j=wa.0 To i By -1
ii=j+1
wa.ii=wa.j
End
End
wa.i=w
wa.0=wa.0+1
End
swl=''
Do i=1 To wa.0
swl=swl wa.i
End
/* Say swl */
Return strip(swl)
- 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
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
- Output:
4/13 s=17 p=52 Elapsed time: 0.078000 seconds
version 3
/*---------------------------------------------------------------------
* 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
- 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 version 3.
/*---------------------------------------------------------------------
* 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
- 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
version 5, fast
This REXX version is over ten times faster than the previous REXX version.
/*REXX program solves the Sum and Product Puzzle (also known as the Impossible Puzzle).*/
@.= 0; h= 100; @.3= 1 /*assign array default; assign high P.*/
do j=5 by 2 to h /*find all odd primes ≤ 1st argument.*/
do k=3 while k*k<=j; if j//k==0 then iterate j /*J ÷ by K ? */
end /*k*/; @.j= 1 /*found a net prime number: J */
end /*j*/
@.2=1 /*assign the even prime, ex post facto.*/
do s=2 for h-1; if C1(s)==0 then iterate /*find and display the puzzle solution.*/
$= 0; do m=2 for s%2 -1 /* [↓] check for uniqueness of product*/
if C2(m * (s-m)) then do; if $>0 then iterate s; $= m; end
end /*m*/
if $>0 then say 'The numbers are: ' $ " and " s-$
end /*s*/
if $==0 then say 'No solution found.'
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
C1: procedure expose @.; parse arg s /*validate the first puzzle condition. */
do a=2 for s%2-1; if @.a then do; _= s - a; if @._ then return 0; end
end; /*a*/; return 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
C2: procedure expose @. h; parse arg p; $= 0 /*validate the second puzzle condition.*/
do j=2 while j*j<p /*perform up to the square root of P. */
if p//j==0 then do; q= p % j
if q>=2 then if q<=h then if C1(j+q) then if $ then return 0
else $= 1
end
end /*j*/; return $
- output when using the default internal input:
The numbers are: 4 and 13
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}
- Output:
[[4, 13]]
Rust
use primes::is_prime;
fn satisfy1(x: u64) -> bool {
let upper_limit = (x as f64).sqrt() as u64 + 1;
for i in 2..upper_limit {
if is_prime(i) && is_prime(x - i) {
return false;
}
}
return true;
}
fn satisfy2(x: u64) -> bool {
let mut once: bool = false;
let upper_limit = (x as f64).sqrt() as u64 + 1;
for i in 2..upper_limit {
if x % i == 0 {
let j = x / i;
if 2 < j && j < 100 && satisfy1(i + j) {
if once {
return false;
}
once = true;
}
}
}
return once
}
fn satisfyboth(x: u64) -> u64 {
if !satisfy1(x) {
return 0;
}
let mut found = 0;
for i in 2..=(x/2) {
if satisfy2(i * (x - i)) {
if found > 0 {
return 0;
}
found = i;
}
}
return found;
}
fn main() {
for i in 2..100 {
let j = satisfyboth(i);
if j > 0 {
println!("Solution: ({}, {})", j, i - j);
}
}
}
- Output:
Solution: (4, 13)
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)
}
- Output:
Vector((4,13))
Run-time: about 3.82 seconds.
Scheme
(import (scheme base)
(scheme cxr)
(scheme write)
(srfi 1))
;; utility method to find unique sum/product in given list
(define (unique-items lst key)
(let ((all-items (map key lst)))
(filter (lambda (i) (= 1 (count (lambda (p) (= p (key i)))
all-items)))
lst)))
;; list of all (x y x+y x*y) combinations with y > x
(define *xy-pairs*
(apply append
(map (lambda (i)
(map (lambda (j)
(list i j (+ i j) (* i j)))
(iota (- 98 i) (+ 1 i))))
(iota 96 2))))
;; S says "P does not know X and Y"
(define *products* ; get products which have multiple decompositions
(let ((all-products (map fourth *xy-pairs*)))
(filter (lambda (p) (> (count (lambda (i) (= i p)) all-products) 1))
all-products)))
(define *fact-1* ; every x+y has x*y in *products*
(filter (lambda (i)
(every (lambda (p) (memq (fourth p) *products*))
(filter (lambda (p) (= (third i) (third p))) *xy-pairs*)))
*xy-pairs*))
;; P says "Now I know X and Y"
(define *fact-2* ; find the unique X*Y
(unique-items *fact-1* fourth))
;; S says "Now I also know X and Y"
(define *fact-3* ; find the unique X+Y
(unique-items *fact-2* third))
(display (string-append "Initial pairs: " (number->string (length *xy-pairs*)) "\n"))
(display (string-append "After S: " (number->string (length *fact-1*)) "\n"))
(display (string-append "After P: " (number->string (length *fact-2*)) "\n"))
(display (string-append "After S: " (number->string (length *fact-3*)) "\n"))
(display (string-append "X: "
(number->string (caar *fact-3*))
" Y: "
(number->string (cadar *fact-3*))
"\n"))
- Output:
Initial pairs: 4656 After S: 145 After P: 86 After S: 1 X: 4 Y: 13
Sidef
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...) }
- Output:
X = 4, Y = 13
Wren
import "./dynamic" for Tuple
import "./seq" for Lst
var P = Tuple.create("P", ["x", "y", "sum", "prod"])
var intersect = Fn.new { |l1, l2|
var l3 = (l1.count < l2.count) ? l1 : l2
var l4 = (l3 == l1) ? l2 : l1
var l5 = []
for (e in l3) if (l4.contains(e)) l5.add(e)
return l5
}
var candidates = []
for (x in 2..49) {
for (y in x + 1..100 - x) {
candidates.add(P.new(x, y, x + y, x * y))
}
}
var sumGroups = Lst.groups(candidates) { |c| c.sum }
var prodGroups = Lst.groups(candidates) { |c| c.prod }
var sumMap = {}
for (sumGroup in sumGroups) {
sumMap[sumGroup[0]] = sumGroup[1].map { |l| l[0] }.toList
}
var prodMap = {}
for (prodGroup in prodGroups) {
prodMap[prodGroup[0]] = prodGroup[1].map { |l| l[0] }.toList
}
var fact1 = candidates.where { |c| sumMap[c.sum].all { |c| prodMap[c.prod].count > 1 } }.toList
var fact2 = fact1.where { |c| intersect.call(prodMap[c.prod], fact1).count == 1 }.toList
var fact3 = fact2.where { |c| intersect.call(sumMap[c.sum], fact2).count == 1 }.toList
System.write("The only solution is : ")
for (p in fact3) System.print("x = %(p.x), y = %(p.y)")
- Output:
The only solution is : 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.
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:=Dictionary(),Dictionary(); // 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();
[[ ]] 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))