Sum and product puzzle

From Rosetta Code
Revision as of 17:13, 3 November 2016 by Walterpachl (talk | contribs) (→‎REXX version 3: added comments and simplified code)
Task
Sum and product puzzle
You are encouraged to solve this task according to the task description, using any language you may know.

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?

Guidance

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.

See also

AWK

<lang AWK>

  1. 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.

  1. 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.

  1. 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.

  1. Given s, for all pairs (a,b), a+b=s, 2 <= a,b <= 99, true if exactly one pair satisfies statements 1 and 2
   if (!satisfies_statement1(s)) {
     return(0)
   }
   for (a=2; a<=int(s/2); a++) {
     b = s - a
     if (satisfies_statement2(a*b)) {
       if (winner) {
         return(0)
       }
       winner = a
     }
   }
   return(winner)

} function is_prime(x, i) { 

   if (x <= 3) {
     return(1)
   }
   for (i=2; i<=int(sqrt(x)); i++) {
     if (x % i == 0) {
       return(0)
     }
   }
   return(1)

} </lang>

Output:

17 (4+13)

C#

<lang csharp>using System; using System.Linq; using System.Collections.Generic;

public class Program { 

   public static void Main()
   {
       const int maxSum = 100;
       var pairs = (
           from X in 2.To(maxSum / 2 - 1)
           from Y in (X + 1).To(maxSum - 2).TakeWhile(y => X + y <= maxSum)
           select new { X, Y, S = X + Y, P = X * Y }
           ).ToHashSet();

       Console.WriteLine(pairs.Count);
       
       var uniqueP = pairs.GroupBy(pair => pair.P).Where(g => g.Count() == 1).Select(g => g.Key).ToHashSet();
       
       pairs.ExceptWith(pairs.GroupBy(pair => pair.S).Where(g => g.Any(pair => uniqueP.Contains(pair.P))).SelectMany(g => g));
       Console.WriteLine(pairs.Count);
       
       pairs.ExceptWith(pairs.GroupBy(pair => pair.P).Where(g => g.Count() > 1).SelectMany(g => g));
       Console.WriteLine(pairs.Count);
       
       pairs.ExceptWith(pairs.GroupBy(pair => pair.S).Where(g => g.Count() > 1).SelectMany(g => g));
       Console.WriteLine(pairs.Count);
       
       foreach (var pair in pairs) Console.WriteLine(pair);
   }

}

public static class Extensions { 

   public static IEnumerable<int> To(this int start, int end) {
       for (int i = start; i <= end; i++) yield return i;
   }
   
   public static HashSet<T> ToHashSet<T>(this IEnumerable<T> source) => new HashSet<T>(source);

}</lang>

Output:
2352
145
86
1
{ X = 4, Y = 13, S = 17, P = 52 }

D

Translation of: Scala

<lang d>void main() { 

   import std.stdio, std.algorithm, std.range, std.typecons;

   const s1 = cartesianProduct(iota(1, 101), iota(1, 101))
              .filter!(p => 1 < p[0] && p[0] < p[1] && p[0] + p[1] < 100)
              .array;

   alias P = const Tuple!(int, int);
   enum add   = (P p) => p[0] + p[1];
   enum mul   = (P p) => p[0] * p[1];
   enum sumEq = (P p) => s1.filter!(q => add(q) == add(p));
   enum mulEq = (P p) => s1.filter!(q => mul(q) == mul(p));

   const s2 = s1.filter!(p => sumEq(p).all!(q => mulEq(q).walkLength != 1)).array;
   const s3 = s2.filter!(p => mulEq(p).setIntersection(s2).walkLength == 1).array;
   s3.filter!(p => sumEq(p).setIntersection(s3).walkLength == 1).writeln;

}</lang>

Output:
[const(Tuple!(int, int))(4, 13)]

With an older version of the LDC2 compiler replace the cartesianProduct line with: <lang d> 

   const s1 = iota(1, 101).map!(x => iota(1, 101).map!(y => tuple(x, y))).joiner

</lang> The .array turn the lazy ranges into arrays. This is a necessary optimization because D lazy Ranges aren't memoized as Haskell lazy lists.

Run-time: about 0.43 seconds with dmd, 0.08 seconds with ldc2.

Elixir

Translation of: Ruby

<lang elixir>defmodule Puzzle do 

 def sum_and_product do
   s1 = for x <- 2..49, y <- x+1..99, x+y<100, do: {x,y}
   s2 = Enum.filter(s1, fn p ->
     Enum.all?(sumEq(s1,p), fn q -> length(mulEq(s1,q)) != 1 end)
   end)
   s3 = Enum.filter(s2, fn p -> only1?(mulEq(s1,p), s2) end)
   Enum.filter(s3, fn p -> only1?(sumEq(s1,p), s3) end) |> IO.inspect 
 end
 
 defp add({x,y}), do: x + y
 
 defp mul({x,y}), do: x * y
 
 defp sumEq(s, p), do: Enum.filter(s, fn q -> add(p) == add(q) end)
 
 defp mulEq(s, p), do: Enum.filter(s, fn q -> mul(p) == mul(q) end)
 
 defp only1?(a, b) do
   MapSet.size(MapSet.intersection(MapSet.new(a), MapSet.new(b))) == 1
 end

end

Puzzle.sum_and_product</lang>

Output:
[{4, 13}]

Go

<lang go>package main

import "fmt"

type pair struct{ x, y int }

func main() { //const max = 100 // Use 1685 (the highest with a unique answer) instead // of 100 just to make it work a little harder :). const max = 1685 var all []pair for a := 2; a < max; a++ { for b := a + 1; b < max-a; b++ { all = append(all, pair{a, b}) } } fmt.Println("There are", len(all), "pairs where a+b <", max, "(and a<b)") products := countProducts(all)

// Those for which no sum decomposition has unique product to are // S mathimatician's possible pairs. var sPairs []pair pairs: for _, p := range all { s := p.x + p.y // foreach a+b=s (a<b) for a := 2; a < s/2+s&1; a++ { b := s - a if products[a*b] == 1 { // Excluded because P would have a unique product continue pairs } } sPairs = append(sPairs, p) } fmt.Println("S starts with", len(sPairs), "possible pairs.") //fmt.Println("S pairs:", sPairs) sProducts := countProducts(sPairs)

// Look in sPairs for those with a unique product to get // P mathimatician's possible pairs. var pPairs []pair for _, p := range sPairs { if sProducts[p.x*p.y] == 1 { pPairs = append(pPairs, p) } } fmt.Println("P then has", len(pPairs), "possible pairs.") //fmt.Println("P pairs:", pPairs) pSums := countSums(pPairs)

// Finally, look in pPairs for those with a unique sum var final []pair for _, p := range pPairs { if pSums[p.x+p.y] == 1 { final = append(final, p) } }

// Nicely show any answers. switch len(final) { case 1: fmt.Println("Answer:", final[0].x, "and", final[0].y) case 0: fmt.Println("No possible answer.") default: fmt.Println(len(final), "possible answers:", final) } }

func countProducts(list []pair) map[int]int { m := make(map[int]int) for _, p := range list { m[p.x*p.y]++ } return m }

func countSums(list []pair) map[int]int { m := make(map[int]int) for _, p := range list { m[p.x+p.y]++ } return m }

// not used, manually inlined above func decomposeSum(s int) []pair { pairs := make([]pair, 0, s/2) for a := 2; a < s/2+s&1; a++ { pairs = append(pairs, pair{a, s - a}) } return pairs }</lang>

Output:

For x + y < 100 (max = 100): 

There are 2304 pairs where a+b < 100 (and a<b)
S starts with 145 possible pairs.
P then has 86 possible pairs.
Answer: 4 and 13

For x + y < 1685 (max = 1685): 

There are 706440 pairs where a+b < 1685 (and a<b)
S starts with 50485 possible pairs.
P then has 17485 possible pairs.
Answer: 4 and 13

Run-time ~1 msec and ~600 msec respectively. Could be slightly faster if the slices and maps were given an estimated capacity to start (e.g. (max/2)² for all pairs) to avoid re-allocations (and resulting copies).

Haskell

Translation of: D

<lang haskell>import Data.List (intersect)

s1, s2, s3, s4 :: [(Int, Int)] s1 = [(x, y) | x <- [1 .. 100], y <- [1 .. 100], 1 < x && x < y && x + y < 100]

add, mul :: (Int, Int) -> Int add (x, y) = x + y mul (x, y) = x * y

sumEq, mulEq :: (Int, Int) -> [(Int, Int)] sumEq p = filter (\q -> add q == add p) s1 mulEq p = filter (\q -> mul q == mul p) s1

s2 = filter (\p -> all (\q -> (length $ mulEq q) /= 1) (sumEq p)) s1 s3 = filter (\p -> length (mulEq p `intersect` s2) == 1) s2 s4 = filter (\p -> length (sumEq p `intersect` s3) == 1) s3

main = print s4</lang>

Output:
[(4,13)]

Run-time: about 1.97 seconds.


JavaScript

ES5

Translation of: Haskell

<lang JavaScript>(function () { 

   'use strict';

   // GENERIC FUNCTIONS

   // concatMap :: (a -> [b]) -> [a] -> [b]
   var concatMap = function concatMap(f, xs) {
           return [].concat.apply([], xs.map(f));
       },

       // curry :: ((a, b) -> c) -> a -> b -> c
       curry = function curry(f) {
           return function (a) {
               return function (b) {
                   return f(a, b);
               };
           };
       },

       // intersectBy::(a - > a - > Bool) - > [a] - > [a] - > [a]
       intersectBy = function intersectBy(eq, xs, ys) {
           return xs.length && ys.length ? xs.filter(function (x) {
               return ys.some(curry(eq)(x));
           }) : [];
       },

       // range :: Int -> Int -> Maybe Int -> [Int]
       range = function range(m, n, step) {
           var d = (step || 1) * (n >= m ? 1 : -1);
           return Array.from({
               length: Math.floor((n - m) / d) + 1
           }, function (_, i) {
               return m + i * d;
           });
       };

   // PROBLEM FUNCTIONS

   // add, mul :: (Int, Int) -> Int
   var add = function add(xy) {
           return xy[0] + xy[1];
       },
       mul = function mul(xy) {
           return xy[0] * xy[1];
       };

   // sumEq, mulEq :: (Int, Int) -> [(Int, Int)]
   var sumEq = function sumEq(p) {
           var addP = add(p);
           return s1.filter(function (q) {
               return add(q) === addP;
           });
       },
       mulEq = function mulEq(p) {
           var mulP = mul(p);
           return s1.filter(function (q) {
               return mul(q) === mulP;
           });
       };

   // pairEQ :: ((a, a) -> (a, a)) -> Bool
   var pairEQ = function pairEQ(a, b) {
       return a[0] === b[0] && a[1] === b[1];
   };

   // MAIN

   // xs :: [Int]
   var xs = range(1, 100);

   // s1 s2, s3, s4 :: [(Int, Int)]
   var s1 = concatMap(function (x) {
           return concatMap(function (y) {
               return 1 < x && x < y && x + y < 100 ? [
                   [x, y]
               ] : [];
           }, xs);
       }, xs),

       s2 = s1.filter(function (p) {
           return sumEq(p).every(function (q) {
               return mulEq(q).length > 1;
           });
       }),

       s3 = s2.filter(function (p) {
           return intersectBy(pairEQ, mulEq(p), s2).length === 1;
       }),

       s4 = s3.filter(function (p) {
           return intersectBy(pairEQ, sumEq(p), s3).length === 1;
       });

   return s4;

})(); </lang>

Output:

<lang JavaScript>4, 13</lang> (Finished in 0.69s)


ES6

Translation of: Haskell

<lang JavaScript>(() => { 

   'use strict';

   // GENERIC FUNCTIONS

   // concatMap :: (a -> [b]) -> [a] -> [b]
   let concatMap = (f, xs) => [].concat.apply([], xs.map(f)),

       // curry :: ((a, b) -> c) -> a -> b -> c
       curry = f => a => b => f(a, b),

       // intersectBy::(a - > a - > Bool) - > [a] - > [a] - > [a]
       intersectBy = (eq, xs, ys) => (xs.length && ys.length) ?
       xs.filter(x => ys.some(curry(eq)(x))) : [],

       // range :: Int -> Int -> Maybe Int -> [Int]
       range = (m, n, step) => {
           let d = (step || 1) * (n >= m ? 1 : -1);
           return Array.from({
               length: Math.floor((n - m) / d) + 1
           }, (_, i) => m + (i * d));
       };

   // PROBLEM FUNCTIONS

   // add, mul :: (Int, Int) -> Int
   let add = xy => xy[0] + xy[1],
       mul = xy => xy[0] * xy[1];

   // sumEq, mulEq :: (Int, Int) -> [(Int, Int)]
   let sumEq = p => {
           let addP = add(p);
           return s1.filter(q => add(q) === addP);
       },
       mulEq = p => {
           let mulP = mul(p)
           return s1.filter(q => mul(q) === mulP);
       };

   // pairEQ :: ((a, a) -> (a, a)) -> Bool
   let pairEQ = (a, b) => (a[0] === b[0]) && (a[1] === b[1]);



   // MAIN

   // xs :: [Int]
   let xs = range(1, 100);

   // s1 s2, s3, s4 :: [(Int, Int)]
   let s1 = concatMap(x =>
            concatMap(y =>
               ((1 < x) && (x < y) && (x + y) < 100) ? [
                   [x, y]
               ] : [],
               xs), xs),
       s2 = s1.filter(
           p => sumEq(p).every(
               q => mulEq(q).length > 1
           )
       ),
       s3 = s2.filter(
           p => intersectBy(
               pairEQ, mulEq(p), s2
           ).length === 1
       ),
       s4 = s3.filter(
           p => intersectBy(
               pairEQ, sumEq(p), s3
           ).length === 1
       );

   return s4;

})();</lang>

Output:

<lang JavaScript>4, 13</lang> (Finished in 0.77s)

Perl 6

Translation of: Python
Works with: Rakudo version 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 }

my @all-pairs = (|($_ X $_+1 .. 98) for 2..97);

  1. 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 $_) };

  1. Fact 2:

my @p-pairs = grep-unique &product, @s-pairs;

  1. Fact 3:

my @final-pairs = grep-unique &sum, @p-pairs;

printf "X = %d, Y = %d\n", |$_ for @final-pairs;</lang>

Output:
X = 4, Y = 13

Python

Based on the Python solution from Wikipedia: <lang python>#!/usr/bin/env python

from collections import Counter

def decompose_sum(s): 

   return [(a,s-a) for a in range(2,int(s/2+1))]
  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)

  1. 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))]
  1. 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]

  1. Fact 3 --> Select pairs for which the sum is unique

sum_counts = Counter(c+d for c,d in p_pairs) final_pairs = [(a,b) for a,b in p_pairs if sum_counts[a+b]==1]

print(final_pairs)</lang>

Output:
[(4, 13)]

Racket

Translation of: D

To calculate the results faster this program use memorization. So it has a modified version of sum= and mul= to increase the chances of reusing the results.

<lang Racket>#lang racket (define-syntax-rule (define/mem (name args ...) body ...) 

 (begin
   (define cache (make-hash))
   (define (name args ...)
     (hash-ref! cache (list args ...) (lambda () body ...)))))

(define (sum p) (+ (first p) (second p))) (define (mul p) (* (first p) (second p)))

(define (sum= p s) (filter (lambda (q) (= p (sum q))) s)) (define (mul= p s) (filter (lambda (q) (= p (mul q))) s))

(define (puzzle tot) 

 (printf "Max Sum: ~a\n" tot)
 (define s1 (for*/list ([x (in-range 2 (add1 tot))]
                        [y (in-range (add1 x) (- (add1 tot) x))])
              (list x y)))
 (printf "Possible pairs: ~a\n" (length s1))

 (define/mem (sumEq/all p) (sum= p s1))
 (define/mem (mulEq/all p) (mul= p s1))

 (define s2 (filter (lambda (p) (andmap (lambda (q)
                                          (not (= (length (mulEq/all (mul q))) 1)))
                                        (sumEq/all (sum p))))
                    s1))
 (printf "Initial pairs for S: ~a\n" (length s2))

 (define s3 (filter (lambda (p) (= (length (mul= (mul p) s2)) 1))
                  s2))
 (displayln (length s3))
 (printf "Pairs for P: ~a\n" (length s3))

 (define s4 (filter (lambda (p) (= (length (sum= (sum p) s3)) 1))
                    s3))
 (printf "Final pairs for S: ~a\n" (length s4))

 (displayln s4))

(puzzle 100)</lang>

Output:
Max Sum: 100
Possible pairs: 2352
Initial pairs for S: 145
Pairs for P: 86
Final pairs for S: 1
((4 13))

REXX

version 1

I tried hard to understand/translate the algorithms shown so far (16 Oct 2016) Unfortunately to no avail (not knowing the semantics of the used languages). Finally I was successful by implementing the rules referred to in Wikipedia http://www.win.tue.nl/~gwoegi/papers/freudenthal1.pdf which had a very clear description. <lang rexx>debug=0 If debug Then Do 

 oid='sppn.txt'; 'erase' oid
 End

Call time 'R' all_pairs= cnt.=0 i=0 /* first take all possible pairs 2<=x<y with x+y<=100 */ /* and compute the respective sums and products */ /* count the number of times a sum or product occurs */ Do x=2 To 98 

 Do y=x+1 To 100-x
   x=right(x,2,0)
   y=right(y,2,0)
   all_pairs=all_pairs x'/'y
   i=i+1
   x.i=x
   y.i=y
   sum=x+y
   prd=x*y
   cnt.0s.sum=cnt.0s.sum+1
   cnt.0p.prd=cnt.0p.prd+1
   End
 End

n=i /* now compute the possible pairs for each sum sum_d.sum */ /* and product prd_d.prd */ /* also the list of possible sums and products suml, prdl*/ sum_d.= prd_d.= suml= prdl= Do i=1 To n 

 x=x.i
 y=y.i
 x=right(x,2,0)
 y=right(y,2,0)
 sum=x+y
 prd=x*y
 cnt.0s.x.y=cnt.0s.sum
 cnt.0p.x.y=cnt.0p.prd
 sum_d.sum=sum_d.sum x'/'y
 prd_d.prd=prd_d.prd x'/'y
 If wordpos(sum,suml)=0 Then suml=suml sum
 If wordpos(prd,prdl)=0 Then prdl=prdl prd
 End

Say n 'possible pairs' Call o 'SUM' suml=wordsort(suml) prdl=wordsort(prdl) sumlc=suml si=0 pi=0 Do While sumlc> 

 Parse Var sumlc sum sumlc
 si=si+1
 sum.si=sum
 si.sum=si
 If sum=17 Then sx=si
 temp=prdl
 Do While temp>
   Parse Var temp prd temp
   If si=1 Then Do
     pi=pi+1
     prd.pi=prd
     pi.prd=pi
     If prd=52 Then px=pi
     End
   A.prd.sum='+'
   End
 End

sin=si pin=pi Call o 'SUM' Do si=1 To sin 

 Call o f5(si) f3(sum.si)
 End

Call o 'PRD' Do pi=1 To pin 

 Call o f5(pi) f6(prd.pi)
 End

a.='-' Do pi=1 To pin 

 prd=prd.pi
 Do si=1 To sin
   sum=sum.si
   Do sj=1 To words(sum_d.sum)
     If wordpos(word(sum_d.sum,sj),prd_d.prd)>0 Then
       Parse Value word(sum_d.sum,sj) with x '/' y
       prde=x*y
       sume=x+y
       pa=pi.prde
       sa=si.sume
       a.pa.sa='+'
     End
   End
 End

Call show '1'

Do pi=1 To pin 

 prow=
 cnt=0
 Do si=1 To sin
   If a.pi.si='+' Then Do
     cnt=cnt+1
     pj=pi
     sj=si
     End
   End
 If cnt=1 Then
   a.pj.sj='1'
 End

Call show '2'

Do si=1 To sin 

 Do pi=1 To pin
   If a.pi.si='1' Then Leave
   End
 If pi<=pin Then Do
   Do pi=1 To pin
     If a.pi.si='+' Then
       a.pi.si='2'
     End
   End
 End

Call show '3'

Do pi=1 To pin 

 prow=
 Do si=1 To sin
   prow=prow||a.pi.si
   End
 If count('+',prow)>1 Then Do
   Do si=1 To sin
     If a.pi.si='+' Then
       a.pi.si='3'
     End
   End
 End

Call show '4'

Do si=1 To sin 

 scol=
 Do pi=1 To pin
   scol=scol||a.pi.si
   End
 If count('+',scol)>1 Then Do
   Do pi=1 To pin
     If a.pi.si='+' Then
       a.pi.si='4'
     End
   End
 End

Call show '5'

sol=0 Do pi=1 To pin 

 Do si=1 To sin
   If a.pi.si='+' Then Do
     Say sum.si prd.pi
     sum=sum.si
     prd=prd.pi
     sol=sol+1
     End
   End
 End

Say sol 'solution(s)' Say ' possible pairs' Say 'Product='prd prd_d.52 Say ' Sum='sum sum_d.17 Say 'The only pair in both lists is 04/13.' Say 'Elapsed time:' time('E') 'seconds' Exit show: If debug Then Do 

 Call o 'show' arg(1)
 Do pi=1 To 60
   ol=
   Do si=1 To 60
     ol=ol||a.pi.si
     End
   Call o ol
   End
 Say 'a.'px'.'sx'='a.px.sx
 End

Return

Exit o: Return lineout(oid,arg(1)) f3: Return format(arg(1),3) f4: Return format(arg(1),4) f5: Return format(arg(1),5) f6: Return format(arg(1),6)

count: Procedure 

 Parse Arg c,s
 s=translate(s,c,c||xrange('00'x,'ff'x))
 s=space(s,0)
 Return length(s)</lang>
Output:
2352 possible pairs
17 52
1 solution(s)
            possible pairs
Product=52  02/26 04/13
    Sum=17  02/15 03/14 04/13 05/12 06/11 07/10 08/09
The only pair in both lists is 04/13.
Elapsed time: 4.891000 seconds

version 2

Translation of: AWK

<lang rexx>Call time 'R' Do s=2 To 100 

 a=satisfies_statement3(s)
 If a>0 Then Do
   p=a*(s-a)
   Say a'/'||(s-a) 's='s 'p='p
   End
 End

Say 'Elapsed time:' time('E') 'seconds' Exit

satisfies_statement1: Procedure 

 Parse Arg s
 Do a=2 To s/2
   If is_prime(a) & is_prime(s-a) Then
     Return 0
   End
 Return 1

satisfies_statement2: Procedure 

 Parse Arg p
 winner=0
 Do i=2 By 1 While i**2<p
   If p//i=0 Then Do
     j=p%i
     If 2<=j & j<=99 Then Do
       if satisfies_statement1(i+j) Then Do
         if winner Then
           Return 0
         winner=1
         End
       End
     End
   End
 Return winner

satisfies_statement3: Procedure 

 Parse Arg s
 winner=0
 If satisfies_statement1(s)=0 Then
   Return 0
 Do a=2 To s/2
   b=s-a
   If satisfies_statement2(a*b) Then Do
     If winner>0 Then
       Return 0
     winner=a
     End
   End
 Return winner

is_prime: Procedure 

 call Trace 'O'
 Parse Arg x
 If x<=3 Then Return 1
 i=2
 Do i=2 By 1 While i**2<=x
   If datatype(x/i,'W') Then Return 0
   End
 Return 1</lang>
Output:
4/13 s=17 p=52
Elapsed time: 0.078000 seconds

version 3

Translation of: GO

<lang rexx>/*---------------------------------------------------------------------

  • X and Y are two different whole numbers greater than 1.
  • Their sum is no greater than 100, and Y is greater than X.
  • S and P are two mathematicians (and consequently perfect logicians);
  • S knows the sum X+Y and P knows the product X*Y.
  • Both S and P know all the information in this paragraph.
  • The following conversation occurs:
  • * S says "P does not know X and Y."
  • * P says "Now I know X and Y."
  • * S says "Now I also know X and Y!"
  • What are X and Y?
  • --------------------------------------------------------------------*/

Call time 'R' max=100 Products.=0 all= Do x=2 To max 

 Do y=x+1 To max-2
   If x+y<=100 Then Do
     all=all x'/'y
     prod=x*y; Products.prod=Products.prod+1
     End
   End
 End

Say "There are" words(all) "pairs where X+Y <=" max "(and X<Y)" /*---------------------------------------------------------------------

  • First eliminate all pairs where the product is unique
  • --------------------------------------------------------------------*/

sPairs= Do i=1 To words(all) 

 xy=word(all,i)
 Parse Var xy x '/' Y
 s=x+y
 take=1
 Do x=2 To s/2
   y=s-x
   prod=x*y
   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
  • --------------------------------------------------------------------*/

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
  • --------------------------------------------------------------------*/

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"</lang>

Output:
There are 2352 pairs where X+Y <= 100 (and X<Y)
S starts with 145 possible pairs.
P then has 86 possible pairs.
Answer: 4/13
Elapsed time: 0.045000 seconds

Ruby

Translation of: D

<lang ruby>def add(x,y) x + y end def mul(x,y) x * y end

def sumEq(s,p) s.select{|q| add(*p) == add(*q)} end def mulEq(s,p) s.select{|q| mul(*p) == mul(*q)} end

s1 = (a = *2...100).product(a).select{|x,y| x<y && x+y<100} s2 = s1.select{|p| sumEq(s1,p).all?{|q| mulEq(s1,q).size != 1} } s3 = s2.select{|p| (mulEq(s1,p) & s2).size == 1} p s3.select{|p| (sumEq(s1,p) & s3).size == 1}</lang>

Output:
[[4, 13]]

Scala

<lang scala>object ImpossiblePuzzle extends App { 

 type XY = (Int, Int)
 val step0 = for {
   x <- 1 to 100
   y <- 1 to 100
   if 1 < x && x < y && x + y < 100
 } yield (x, y)

 def sum(xy: XY) = xy._1 + xy._2
 def prod(xy: XY) = xy._1 * xy._2
 def sumEq(xy: XY) = step0 filter { sum(_) == sum(xy) }
 def prodEq(xy: XY) = step0 filter { prod(_) == prod(xy) }

 val step2 = step0 filter { sumEq(_) forall { prodEq(_).size != 1 }}
 val step3 = step2 filter { prodEq(_).intersect(step2).size == 1 }
 val step4 = step3 filter { sumEq(_).intersect(step3).size == 1 }
 println(step4)

}</lang>

Output:
Vector((4,13))

Run-time: about 3.82 seconds.

Sidef

Translation of: Perl 6

<lang ruby>func grep_uniq(a, by) { a.group_by{ .(by) }.values.grep{.len == 1}.map{_[0]} } func sums (n) { 2 .. n//2 -> map {|i| [i, n-i] } }

var pairs = (2..97 -> map {|i| ([i] ~X (i+1 .. 98))... })

var p_uniq = Hash() p_uniq{grep_uniq(pairs, :prod).map { .to_s }...} = ()

var s_pairs = pairs.grep {|p| sums(p.sum).all { !p_uniq.contains(.to_s) } } var p_pairs = grep_uniq(s_pairs, :prod) var f_pairs = grep_uniq(p_pairs, :sum)

f_pairs.each { |p| printf("X = %d, Y = %d\n", p...) }</lang>

Output:
X = 4, Y = 13

zkl

Damn it Jim, I'm a programmer, not a logician. So I translated the python code found in https://qmaurmann.wordpress.com/2013/08/10/sam-and-polly-and-python/ but I don't understand it. It does seem quite a bit more efficient than the Scala code, on par with the Python code. <lang zkl>mul:=Utils.Helpers.summer.fp1('*,1); //-->list.reduce('*,1), multiply list items var allPairs=[[(a,b); [2..100]; { [a+1..100] },{ a+b<100 }; ROList]]; // 2,304 pairs

sxys,pxys:=D(),D(); // hashes of allPairs sums and products: 95,1155 foreach xy in (allPairs){ sxys.appendV(xy.sum(),xy); pxys.appendV(xy:mul(_),xy) }

sOK:= 'wrap(s){ (not sxys[s].filter1('wrap(xy){ pxys[xy:mul(_)].len()<2 })) }; pOK:= 'wrap(p){ 1==pxys[p].filter('wrap([(x,y)]){ sOK(x+y) }).len() }; sOK2:='wrap(s){ 1==sxys[s].filter('wrap(xy){ pOK(xy:mul(_)) }).len() }; allPairs.filter('wrap([(x,y)]){ sOK(x+y) and pOK(x*y) and sOK2(x+y) }) .println();</lang> [[ ]] denotes list comprehension, filter1 returns (and stops at) the first thing that is "true", 'wrap creates a closure so the "wrapped" code/function can see local variables (read only). In a [function] prototype, the "[(x,y)]xy]" notation says xy is a list like thing, assign the parts to x & y (xy is optional), used here to just to do it both ways. The ":" says take the LHS and stuff it into the "_".

Output:
L(L(4,13))
Retrieved from "https://rosettacode.org/wiki/Sum_and_product_puzzle?oldid=256902"