Task[edit]
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
   Wikipedia:   Sum and Product Puzzle

use List::Util qw(none);
 
sub grep_unique {
    my($by, @list) = @_;
    my @seen;
    for (@list) {
        my $x = &$by(@$_);
        $seen[$x]= defined $seen[$x] ? 0 : join ' ', @$_;
    }
    grep { $_ } @seen;
}
 
sub sums {
    my($n) = @_;
    my @sums;
    push @sums, [$_, $n - $_] for 2 .. int $n/2;
    @sums;
}
 
sub sum     { $_[0] + $_[1] }
sub product { $_[0] * $_[1] }
 
for $i (2..97) {
    push @all_pairs, map { [$i, $_] } $i + 1..98
}
 
# Fact 1:
%p_unique = map { $_ => 1 } grep_unique(\&product, @all_pairs);
for my $p (@all_pairs) {
    push @s_pairs, [@$p] if none { $p_unique{join ' ', @$_} } sums sum @$p;
}
 
# Fact 2:
@p_pairs = map { [split ' ', $_] } grep_unique(\&product, @s_pairs);
 
# Fact 3:
@final_pair = grep_unique(\&sum, @p_pairs);
 
printf "X = %d, Y = %d\n", split ' ', $final_pair[0];