#!/usr/bin/perl -w
#
# Solve the "Impossible Puzzle":
#
# Consider a pair of integers  X and Y such that 1 < X < Y and X+Y < 100.
#
# P and S are mathematicians, who know the above constraints and who won't
# deliberately lie.
#
# In secret, P is told only the product X*Y and S is told only the sum X+Y.
#
# P: "I can't find the numbers."
# S: "I knew you couldn't."
# P: "Then I know the numbers."
# S: "Then I do, too."
#
# Find X and Y.
#
# See also: http://en.wikipedia.org/wiki/Impossible_puzzle
#
# Aside: The second condition (X+Y < 100) turns out not to be necessary
# to the solution. I have a lovely proof of this which is too big to fit
# in the margins.
#
# Also aside: If the second condition is stated as X+Y < Z, then the
# problem as stated can't be solved (without incredibly bizarre
# interpretation of the statement) for Z < 62. This bit none other than
# Martin Gardner, who published a version "simplified" by making Z=41.
#

# Consider a pair of integers  X and Y such that 1 < X < Y and X+Y < 100.
#
# Make a list of all such possible pairs. Store the X of the i_th pair as
# $x[i]; likewise Y as $y[i].
for $x (2..49) {
   for $y ($x+1..99-$x) {
      push(@x, $x); push(@y, $y);
   }
}
print "Initial pairs: ".($#x+1)."\n";

# Claim (I):
# P knows X*Y and states: "I can't find the numbers."
#
# If P cannot uniquely identify the pair from the product, that means the
# product belongs to two or more pairs. Therefore, we need to identify all
# pairs which have a unique product.
#
# To do so, we create a hash whose keys are products and whose values are
# the number of pairs in our list with that product.
for($i = 0; $i <= $#x; $i++) { $prod{$x[$i] * $y[$i]}++; }

# Claim (II):
# S knows the sum X+Y and states: "I knew you couldn't."
#
# To know this, S must know that no pair with the given sum has a unique
# product.
#
# Create a hash %usum where the keys are sums X+Y for which there is at
# least one pair with both that sum and a unique product. At the same time,
# delete pairs with unique products from the list.
for($i = $#x; $i >= 0; $i--) {
   next if($prod{$x[$i] * $y[$i]} != 1); # skip pairs with non-unique product
   $usum{$x[$i] + $y[$i]} = 1;
   splice(@x, $i, 1); splice(@y, $i, 1);
}
undef %prod;

print "Pairs for which Claim (I) is plausible: ".($#x+1)."\n";

# Claim (III):
# P states "Then I know the numbers."
#
# This means there is only one pair with product X*Y for which Claim (II)
# can be true.
#
# Consider each product X*Y. For each, count how many pairs have that product
# AND satisfy Claim (I) AND satisfy Claim (II). At the same time, eliminate
# from the list those pairs for which for which Claim (II) is not plausible.
# (We have already eliminated those which falsify Claim (I).)
for($i = $#x; $i >= 0; $i--) {
   if(defined($usum{$x[$i] + $y[$i]})) {
      splice(@x, $i, 1); splice(@y, $i, 1);
   } else { $pcnt{$x[$i] * $y[$i]}++; }
}
undef %usum;

print "Pairs for which Claim (II) is plausible: ".($#x+1)."\n";

# Claim (IV):
# S states: "Then I do, too."
#
# This means there is only one pair with sum X+Y for which Claim (III) can
# be true.
#
# Consider each sum X+Y. For each, count how many pairs have that sum
# AND satisfy all of Claim (I), Claim (II) and Claim (III). As we go,
# delete pairs which falsify Claim (III). (We've already discarded those
# which falsify Claims (I) and Claim (II).)
for($i = $#x; $i >= 0; $i--) {
   if($pcnt{$x[$i] * $y[$i]} > 1) {
      splice(@x, $i, 1); splice(@y, $i, 1);
   } else { $scnt{$x[$i] + $y[$i]}++; }
}
undef %pcnt;

print "Pairs for which Claim (III) is plausible: ".($#x+1)."\n";

# Delete pairs which falsify Claim (IV):
for($i = $#x; $i >= 0; $i--) {
   next unless($scnt{$x[$i] + $y[$i]} > 1);
   splice(@x, $i, 1); splice(@y, $i, 1);
}

# Display whatever is left as the solution:
print "Pairs for which Claim (IV) is plausible: ".($#x+1)."\n";
print(($#x+1)." pair".($#x==0 ? "":"s").":\n");
for($i = 0; $i <= $#x; $i++) { print "$i: x=".$x[$i]." y=".$y[$i]."\n"; }