Sum and product puzzle: Difference between revisions

From Rosetta Code
Content added Content deleted
mNo edit summary
(→‎{{header|Perl 6}}: some more clean-up)
Line 328: Line 328:
{{trans|Python}}
{{trans|Python}}
{{works with|Rakudo|2016.07}}
{{works with|Rakudo|2016.07}}
<lang perl6>sub sums (Int $n) { ($_, $n - $_ for 2 .. $n div 2) }
<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 grep-unique (&by, @list) { @list.classify(&by).values.grep(* == 1).map(*[0]) }
sub sum ([$x, $y]) { $x + $y }
sub product ([$x, $y]) { $x * $y }

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

# Fact 1:
# Fact 1:
my %products-unique := set map ~*, grep-unique { [*] |$_ }, @all-pairs;
my %p-unique := Set.new: map ~*, grep-unique &product, @all-pairs;
my @s-pairs = @all-pairs.grep: { none (%products-unique{~$_} for sums [+] $_) };
my @s-pairs = @all-pairs.grep: { none (%p-unique{~$_} for sums sum $_) };

# Fact 2:
# Fact 2:
my @p-pairs = grep-unique { [*] |$_ }, @s-pairs;
my @p-pairs = grep-unique &product, @s-pairs;

# Fact 3:
# Fact 3:
my @final-pairs = grep-unique { [+] |$_ }, @p-pairs;
my @final-pairs = grep-unique &sum, @p-pairs;

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



Revision as of 08:43, 6 August 2016

Sum and product puzzle is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

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)

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
   Set.size(Set.intersection(Enum.into(a, HashSet.new), Enum.into(b, HashSet.new))) == 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.

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))

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.

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))