Rosetta Code

Sum and product puzzle: Difference between revisions

Page Discussion

Sum and product puzzle (view source)

Revision as of 22:18, 27 February 2024

62,054 bytes added ,  3 months ago
Added various BASIC dialects (BASIC256 and Gambas)
(Added various BASIC dialects (BASIC256 and Gambas))
 
(97 intermediate revisions by 23 users not shown)
Line 1:
{{task}}
;Task:
{{task heading}}
Solve the "<i>Impossible Puzzle</i>":
 
Line 51:
* &nbsp; Wikipedia: &nbsp; [[wp:Sum and Product Puzzle|Sum and Product Puzzle]]
<hr>
 
=={{header|11l}}==
{{trans|Python}}
 
<syntaxhighlight lang="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)</syntaxhighlight>
 
{{out}}
<pre>
[(4, 13)]
</pre>
 
=={{header|ALGOL 68}}==
<syntaxhighlight lang="algol68">
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
</syntaxhighlight>
{{out}}
<pre>
Sum and product puzzle 2352 candidates
After statement 1 145 candidates
After statement 2 86 candidates
After statement 3 1 candidate
 
solution: 4, 13
</pre>
 
=={{header|AWK}}==
<syntaxhighlight lang="awk">
<lang AWK>
# syntax: GAWK -f SUM_AND_PRODUCT_PUZZLE.AWK
BEGIN {
Line 107 ⟶ 284:
}
function is_prime(x, i) {
if (x <= 31) {
return(10)
}
for (i=2; i<=int(sqrt(x)); i++) {
Line 117 ⟶ 294:
return(1)
}
</syntaxhighlight>
</lang>
<p>Output:</p>
<pre>
17 (4+13)
</pre>
 
=={{header|BASIC}}==
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">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</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
==={{header|Gambas}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">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 </syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
=={{header|C}}==
{{trans|C#}}
<syntaxhighlight lang="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;
}</syntaxhighlight>
{{out}}
<pre>2352 candidates
145 candidates
86 candidates
one candidate
[4, 13] S=17 P=52</pre>
 
=={{header|C++}}==
{{trans|C}}
<syntaxhighlight lang="cpp">#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;
}</syntaxhighlight>
{{out}}
<pre>2352 candidates
145 candidates
86 candidates
one candidate
[4, 13] S=17 P=52</pre>
 
=={{header|C sharp}}==
<langsyntaxhighlight lang="csharp">using System;
using System.Linq;
using System.Collections.Generic;
Line 162 ⟶ 917:
public static HashSet<T> ToHashSet<T>(this IEnumerable<T> source) => new HashSet<T>(source);
}</langsyntaxhighlight>
{{out}}
<pre>
Line 171 ⟶ 926:
{ X = 4, Y = 13, S = 17, P = 52 }
</pre>
 
=={{header|Common Lisp}}==
===Version 1===
<syntaxhighlight lang="lisp">
;;; 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))
</syntaxhighlight>
 
===Version 2===
<syntaxhighlight lang="lisp">
;;; 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))
</syntaxhighlight>
 
=={{header|D}}==
{{trans|Scala}}
<langsyntaxhighlight lang="d">void main() {
import std.stdio, std.algorithm, std.range, std.typecons;
 
Line 190 ⟶ 1,093:
const s3 = s2.filter!(p => mulEq(p).setIntersection(s2).walkLength == 1).array;
s3.filter!(p => sumEq(p).setIntersection(s3).walkLength == 1).writeln;
}</langsyntaxhighlight>
{{out}}
<pre>[const(Tuple!(int, int))(4, 13)]</pre>
 
With an older version of the LDC2 compiler replace the <code>cartesianProduct</code> line with:
<syntaxhighlight lang="d">
<lang d>
const s1 = iota(1, 101).map!(x => iota(1, 101).map!(y => tuple(x, y))).joiner
</syntaxhighlight>
</lang>
The <code>.array</code> turn the lazy ranges into arrays. This is a necessary optimization because D lazy Ranges aren't memoized as Haskell lazy lists.
 
Line 204 ⟶ 1,107:
=={{header|Elixir}}==
{{trans|Ruby}}
<langsyntaxhighlight 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}
Line 227 ⟶ 1,130:
end
 
Puzzle.sum_and_product</langsyntaxhighlight>
 
{{out}}
Line 233 ⟶ 1,136:
[{4, 13}]
</pre>
 
=={{header|Factor}}==
A loose translation of D.
<syntaxhighlight lang="factor">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</syntaxhighlight>
{{out}}
<pre>
{ { 4 13 } }
Running time: 0.241637693 seconds
</pre>
 
=={{header|FreeBASIC}}==
{{trans|AWK}}
Runs in 0.001s
<syntaxhighlight lang="vbnet">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</syntaxhighlight>
{{out}}
<pre>17 (4+13)</pre>
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 329 ⟶ 1,325:
}
return pairs
}</langsyntaxhighlight>
{{out}}
For x + y < 100 (<code>max = 100</code>):
Line 352 ⟶ 1,348:
=={{header|Haskell}}==
{{trans|D}}
<langsyntaxhighlight lang="haskell">import Data.List (intersect)
 
s1, s2, s3, s4 :: [(Int, Int)]
Line 369 ⟶ 1,365:
s4 = filter (\p -> length (sumEq p `intersect` s3) == 1) s3
 
main = print s4</langsyntaxhighlight>
{{out}}
<pre>[(4,13)]</pre>
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'''. For some reason itIt also proves fractionally faster to delegateshed thesome outerof layerthe of theouter list comprehension tosugaring, using foldMap'''>>=''' or '''concatMap''' directly.
 
For a further doubling of performance, we can can redefine '''add''' and '''mul''' as uncurried versions of '''(+)''' and '''(*)'''.
<lang Haskell>import Data.List (intersect)
 
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).
mx :: Int
mx = 100
 
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.
ns :: [Int]
<syntaxhighlight lang="haskell">import Data.List (intersect)
ns = [1 .. mx]
 
------------------ SUM AND PRODUCT PUZZLE ----------------
 
s1, s2, s3, s4 :: [(Int, Int)]
s1 =
[2 .. 100]
foldMap
(>>= \x ->
[succ x foldMap.. 100]
>>= (\y ->
[ (x, y)
| 1 < x && x < y && x + y < mx ])100
ns)]
ns
 
s2 = filter (all ((1 /=) . length . mulEq) . sumEq) s1
add, mul :: (Int, Int) -> Int
add = uncurry (+)
 
s3 = filter ((1 ==) . length . (`intersect` s2) . mulEq) s2
mul = uncurry (*)
 
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
s2 = filter (all ((1 /=) . length . mulEq) . sumEq) s1
add = uncurry (+)
 
mul = uncurry (*)
s3 = filter ((1 ==) . length . (`intersect` s2) . mulEq) s2
 
s4 = filter ((1 ==) . length . (`intersect` s3) . sumEq) s3
 
--------------------------- TEST -------------------------
main :: IO ()
main = print $ take 1 s4</langsyntaxhighlight>
{{Out}}
<pre>[(4,13)]</pre>
 
=={{header|J}}==
'''Tacit Solution'''
<syntaxhighlight lang="j">(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.
</syntaxhighlight>
 
Example use:
<syntaxhighlight lang="j"> 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</syntaxhighlight>
 
The code is tacit and fixed (in other words, it is point-free):
<syntaxhighlight lang="j"> _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.)</syntaxhighlight>
 
=={{header|Java}}==
 
<syntaxhighlight lang="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;
}
}</syntaxhighlight>
 
{{Out}}
<pre>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.</pre>
 
=={{header|JavaScript}}==
Line 421 ⟶ 1,649:
 
{{Trans|Haskell}}
<langsyntaxhighlight JavaScriptlang="javascript">(function () {
'use strict';
 
Line 516 ⟶ 1,744:
return s4;
})();
</syntaxhighlight>
</lang>
 
{{Out}}
<syntaxhighlight lang JavaScript="javascript">[[4, 13]]</langsyntaxhighlight>
(Finished in 0.69s)
 
 
===ES6===
 
{{Trans|Haskell}}
<langsyntaxhighlight JavaScriptlang="javascript">(() => {
'"use strict'";
 
// ------------- SUM AND PRODUCT PUZZLE --------------
// GENERIC FUNCTIONS
 
// concatMapmain :: IO (a -> [b]) -> [a] -> [b]
letconst concatMapmain = (f, xs) => [].concat.apply([], xs.map(f)),{
const
// xs :: [Int]
xs = enumFromTo(1)(100),
 
// currys1 s2, s3, s4 :: [((aInt, bInt) -> c) -> a -> b -> c]
curry = f => as1 => b => fxs.flatMap(a, b),
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(
// intersectBy :: (a - > a - > Bool) - > [a] - > [a] - > [a]
intersectBy = (eq, xs, ys)p => (xs.length1 &&=== ys.lengthintersectBy(pairEQ) ?(
xs.filter(x => ys.some(curry(eq)(x))) : [] sumEq(p, s1)
)(s3).length
);
};
 
// ---------------- PROBLEM FUNCTIONS ----------------
// 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
const
let add = xy => xy[0] + xy[1],
muladd = xy => xy[0] *+ xy[1];,
mul = xy => xy[0] * xy[1],
 
// sumEq, mulEq :: (Int, Int) -> [(Int, Int)]
let sumEq = p =// [(Int, Int)] -> {[(Int, Int)]
sumEq = (p, let addPs) => add(p);{
returnconst s1.filter(qaddP => add(q) === addPp);
 
return s.filter(q => add(q) === addP);
},
mulEq = (p, s) => {
letconst mulP = mul(p);
return s1.filter(q => mul(q) === mulP);
};
 
// pairEQ :: ((a, a) -> return s.filter(a,q a)=> mul(q) ->=== BoolmulP);
},
let pairEQ = (a, b) => (a[0] === b[0]) && (a[1] === b[1]);
 
// pairEQ :: ((a, a) -> (a, a)) -> Bool
pairEQ = a => b => (
a[0] === b[0]
) && (a[1] === b[1]);
 
// MAIN
 
// ---------------- GENERIC FUNCTIONS ----------------
// xs :: [Int]
let xs = range(1, 100);
 
// s1 s2, s3, s4enumFromTo :: [(Int, -> Int -> [Int)]
letconst s1enumFromTo = concatMap(xm =>
n => concatMapArray.from(y =>{
length: ((1 < x) && (x < y) && (x + y) < 100)n ?- [m
}, (_, i) => m + [x, y]i);
] : [],
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
);
 
// intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
})();</lang>
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();
})();</syntaxhighlight>
{{Out}}
<syntaxhighlight lang JavaScript="javascript">[[4, 13]]</langsyntaxhighlight>
 
(Finished in 0.77s)
=={{header|jq}}==
'''Works with: jq'''
 
'''Works with: gojq''' (the Go implementation of jq)
 
A transcription from the problem statement, with these helper functions:
<syntaxhighlight lang="jq">
# 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
</syntaxhighlight>
{{out}}
<pre>[4,13]</pre>
 
=={{header|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.
 
<syntaxhighlight lang="julia">
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</syntaxhighlight>
 
{{out}}
<pre>Solution: (4, 13)</pre>
 
=={{header|Kotlin}}==
<syntaxhighlight lang="scala">// 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")
}</syntaxhighlight>
 
{{out}}
<pre>
The only solution is : x = 4, y = 13
</pre>
 
=={{header|Lua}}==
{{trans|C++}}
<syntaxhighlight lang="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()</syntaxhighlight>
{{out}}
<pre>2352 candidates
145 candidates
86 candidates
1 candidates
a=4, b=13; S=17, P=52</pre>
 
=={{header|MATLAB}}==
<syntaxhighlight lang="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
</syntaxhighlight>
{{out}}
<pre>
>> 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.
</pre>
 
=={{header|Nim}}==
<syntaxhighlight lang="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)</syntaxhighlight>
 
{{out}}
<pre>(4, 13)</pre>
 
=={{header|ooRexx}}==
Line 612 ⟶ 2,276:
{{trans|REXX}}
for comments see REXX version 4.
<langsyntaxhighlight lang="oorexx">all =.set~new
Call time 'R'
cnt.=0
Line 701 ⟶ 2,365:
take=0
End
return epairs</langsyntaxhighlight>
{{out}}
<pre>There are 2352 pairs where X+Y <= MAX (and X<Y)
Line 709 ⟶ 2,373:
Elapsed time: 0.016000 seconds</pre>
===version 2===
Uses objects for storing the number pairs. Note the computed hash value and the == mathodmethod
(required to make the set difference work)
<langsyntaxhighlight lang="oorexx">all =.set~new
Call time 'R'
cnt.=0
Line 829 ⟶ 2,493:
::method string -- this creates the string to be shown
expose a b
return "[x="||a",y="||b"]"</langsyntaxhighlight>
{{out}}
<pre>There are 2352 pairs where X+Y <= MAX (and X<Y)
Line 837 ⟶ 2,501:
Elapsed time: 0.079000 seconds</pre>
 
=={{header|Perl 6}}==
{{trans|PythonRaku}}
<syntaxhighlight lang="perl">use List::Util qw(none);
{{works with|Rakudo|2016.07}}
<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 }
 
sub grep_unique {
my @all-pairs = (|($_ X $_+1 .. 98) for 2..97);
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:
my %p-uniquep_unique := Set.new: map ~*,{ $_ => 1 grep-unique} grep_unique(\&product, @all-pairsall_pairs);
for my $p (@all_pairs) {
my @s-pairs = @all-pairs.grep: { none (%p-unique{~$_} for sums sum $_) };
push @s_pairs, [@$p] if none { $p_unique{join ' ', @$_} } sums sum @$p;
}
 
# Fact 2:
my @p-pairsp_pairs = grep-uniquemap { [split ' ', $_] } grep_unique(\&product, @s-pairss_pairs);
 
# Fact 3:
my @final-pairsfinal_pair = grep-unique grep_unique(\&sum, @p-pairsp_pairs);
 
printf "X = %d, Y = %d\n", |$_ for @final-pairs;</lang>
 
printf "X = %d, Y = %d\n", split ' ', $final_pair[0];</syntaxhighlight>
{{out}}
<pre>X = 4, Y = 13</pre>
 
=={{header|Phix}}==
{{trans|AWK}}
Runs in 0.03s
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">satisfies_statement1</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- S says: P does not know the two numbers.
-- Given s, for /all/ pairs (a,b), a+b=s, 2&lt;=a,b&lt;=99, at least one of a or b is composite</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">is_prime</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">and</span> <span style="color: #7060A8;">is_prime</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">-</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">false</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">true</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">satisfies_statement2</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- P says: Now I know the two numbers.
-- Given p, for /all/ pairs (a,b), a*b=p, 2&lt;=a,b&lt;=99, exactly one pair satisfies statement 1</span>
<span style="color: #004080;">bool</span> <span style="color: #000000;">winner</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">false</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sqrt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">))</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">mod</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">j</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">/</span><span style="color: #000000;">i</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">2</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">j</span> <span style="color: #008080;">and</span> <span style="color: #000000;">j</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">99</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">satisfies_statement1</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">j</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">winner</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #004600;">false</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">winner</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">true</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">winner</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">satisfies_statement3</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- S says: Now I know the two numbers.
-- Given s, for /all/ pairs (a,b), a+b=s, 2&lt;=a,b&lt;=99, exactly one pair satisfies statements 1 and 2</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">winner</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">satisfies_statement1</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">satisfies_statement2</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">*(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">-</span><span style="color: #000000;">a</span><span style="color: #0000FF;">))</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">winner</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">winner</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">a</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">winner</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #000000;">100</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">a</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">satisfies_statement3</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%d (%d+%d)\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">-</span><span style="color: #000000;">a</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
17 (4+13)
</pre>
=={{header|Picat}}==
<syntaxhighlight lang="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).
</syntaxhighlight>
Output:
<pre>[[4,13]]</pre>
 
=={{header|Python}}==
 
Based on the Python solution from [[wp:Sum_and_Product_Puzzle#Python_code|Wikipedia]]:
<langsyntaxhighlight lang="python">#!/usr/bin/env python
 
from collections import Counter
Line 889 ⟶ 2,657:
final_pairs = [(a,b) for a,b in p_pairs if sum_counts[a+b]==1]
 
print(final_pairs)</langsyntaxhighlight>
 
{{out}}
Line 896 ⟶ 2,664:
=={{header|Racket}}==
{{trans|D}}To calculate the results faster this program use memorization. So it has a modified version of <code>sum=</code> and <code>mul=</code> to increase the chances of reusing the results.
<langsyntaxhighlight Racketlang="racket">#lang racket
(define-syntax-rule (define/mem (name args ...) body ...)
(begin
Line 936 ⟶ 2,704:
(displayln s4))
 
(puzzle 100)</langsyntaxhighlight>
{{out}}
<pre>Max Sum: 100
Line 944 ⟶ 2,712:
Final pairs for S: 1
((4 13))</pre>
 
=={{header|Raku}}==
(formerly Perl 6)
{{trans|Python}}
{{works with|Rakudo|2016.07}}
<syntaxhighlight lang="raku" line>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;</syntaxhighlight>
 
{{out}}
<pre>X = 4, Y = 13</pre>
 
=={{header|REXX}}==
 
===version 1===
I tried hard to understand/translate the algorithms shown so far (16 Oct 2016)
Line 952 ⟶ 2,747:
http://www.win.tue.nl/~gwoegi/papers/freudenthal1.pdf
which had a very clear description.
<langsyntaxhighlight lang="rexx">debug=0
If debug Then Do
oid='sppn.txt'; 'erase' oid
Line 1,151 ⟶ 2,946:
s=translate(s,c,c||xrange('00'x,'ff'x))
s=space(s,0)
Return length(s)</lang>
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)</syntaxhighlight>
{{out}}
<pre>2352 possible pairs
Line 1,161 ⟶ 2,983:
The only pair in both lists is 04/13.
Elapsed time: 4.891000 seconds</pre>
 
===version 2===
{{trans|AWK}}
<langsyntaxhighlight lang="rexx">Call time 'R'
Do s=2 To 100
a=satisfies_statement3(s)
Line 1,222 ⟶ 3,045:
If datatype(x/i,'W') Then Return 0
End
Return 1</langsyntaxhighlight>
{{out}}
<pre>4/13 s=17 p=52
Line 1,229 ⟶ 3,052:
===version 3===
{{trans|GO}}
<langsyntaxhighlight 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.
Line 1,337 ⟶ 3,160:
End
Say "Elapsed time:" time('E') "seconds"
Exit</langsyntaxhighlight>
{{out}}
<pre>There are 2352 pairs where X+Y <= 100 (and X<Y)
Line 1,346 ⟶ 3,169:
 
===version 4===
Now that I have understood the logic (I am neither S nor P) I have created an alternative to verionversion 3.
<langsyntaxhighlight 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.
Line 1,458 ⟶ 3,281:
End
Say "Elapsed time:" time('E') "seconds"
Exit</langsyntaxhighlight>
{{out}}
<pre>There are 2352 pairs where X+Y <= 100 (and X<Y)
Line 1,466 ⟶ 3,289:
Elapsed time: 0.032000 seconds</pre>
 
===version 5, fast ===
This REXX version is over &nbsp; '''ten''' &nbsp; times faster than the previous REXX version.
<lang rexx>/*REXX program solves the Sum and Product Puzzle (also known as the Impossible Puzzle).*/
<syntaxhighlight lang="rexx">/*REXX program solves the Sum and Product Puzzle (also known as the Impossible Puzzle).*/
parse arg H; if H=='' | H=="," then H=98 /*obtain optional HIGH number from CL*/
@.= 0; @.2=1; do j=3 by 2 to H h= 100; @.3= 1 /*generateassign array default; prime listassign forhigh optimizationP.*/
do j=5 by 2 to h do/*find k=3all odd untilprimes k*k>j; ≤ 1st if @argument.k==0 then iterate*/
do k=3 while k*k<=j; if j//k==0 then iterate j /*J ÷ by K ? if j*//k==0 then iterate j
end /*k*/; @.j= 1 /*found a net prime number: J end /*k*/
@.j=1 end /*a slow & inefficient prime generator.j*/
@.2=1 end /*jassign 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 sm=2 for H s%2 -1; if C1(s)==0 /* [↓] check for uniqueness thenof iterateproduct*/
$=0; if C2(m * (s-m)) then do; m=2 if to$>0 then iterate s%2; $= m; end
end if C2(/*m*(s-m)) then do; if $>0 then iterate s/
if $>0 then say 'The numbers are: ' $ " and " s-$=m
end /*s*/
end
if $==0 then say 'No solution found.'
end /*m*/
exit 0 if $>0 then say "numbers are: " $ /*stick a fork "in andit, " we're all done. s-$*/
end /*s*/
exit
/*──────────────────────────────────────────────────────────────────────────────────────*/
C1: procedure expose @. H; parse arg s /*validate the first puzzle condition. */
do a=2 tofor s%2-1; z=s-a; if @.a then do; _= s - a; if @.z_ then return 0; end /*a*/
end; /*a*/; return 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
C2: procedure expose @. Hh; 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<=Hh then if C1(j+_q) then do; if $ then return 0
else $= 1
end
end
end /*j*/; return $</syntaxhighlight>
{{out|output|text=&nbsp; when using the default internal input:}}
return $</lang>
'''output'''
<pre>
The numbers are: 4 and 13
</pre>
 
=={{header|Ruby}}==
{{trans|D}}
<langsyntaxhighlight lang="ruby">def add(x,y) x + y end
def mul(x,y) x * y end
 
Line 1,515 ⟶ 3,334:
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}</langsyntaxhighlight>
 
{{out}}
<pre>
[[4, 13]]
</pre>
 
=={{header|Rust}}==
{{trans|Julia}}
<syntaxhighlight lang="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);
}
}
}
</syntaxhighlight>{{out}}
<pre>
Solution: (4, 13)
</pre>
 
=={{header|Scala}}==
<langsyntaxhighlight lang="scala">object ImpossiblePuzzle extends App {
type XY = (Int, Int)
val step0 = for {
Line 1,540 ⟶ 3,419:
val step4 = step3 filter { sumEq(_).intersect(step3).size == 1 }
println(step4)
}</langsyntaxhighlight>
{{out}}
<pre>Vector((4,13))</pre>
Line 1,547 ⟶ 3,426:
=={{header|Scheme}}==
 
<langsyntaxhighlight lang="scheme">
(import (scheme base)
(scheme cxr)
Line 1,598 ⟶ 3,477:
(number->string (cadar *fact-3*))
"\n"))
</syntaxhighlight>
</lang>
 
{{out}}
Line 1,610 ⟶ 3,489:
 
=={{header|Sidef}}==
{{trans|Perl 6Raku}}
<langsyntaxhighlight 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] } }
 
Line 1,623 ⟶ 3,502:
var f_pairs = grep_uniq(p_pairs, :sum)
 
f_pairs.each { |p| printf("X = %d, Y = %d\n", p...) }</langsyntaxhighlight>
{{out}}
<pre>
X = 4, Y = 13
</pre>
 
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-dynamic}}
{{libheader|Wren-seq}}
<syntaxhighlight lang="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)")</syntaxhighlight>
 
{{out}}
<pre>
The only solution is : x = 4, y = 13
</pre>
 
=={{header|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.
<langsyntaxhighlight 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
 
Line 1,641 ⟶ 3,565:
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();</langsyntaxhighlight>
[[ ]] 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 "_".
{{out}}<pre>L(L(4,13))</pre>
Jjuanhdez
2,131

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/256916...360953"