#!/usr/bin/perl -w

# Note for the english speaking audience: This program solves a quiz problem
# I have found in "Spektrum der Wissenschaft" 07/2002, p. 111. "Spektrum der
# Wissenschaft" is the german translation of "Scientific American". I don't
# know if the problem can also be found in the original english magazine.

# JANS ESELIN ----- Written by Clifford Wolf (clifford@clifford.at), 10.7.2002
#                              Please have a look at http://www.rocklinux.org/
#
# Programm zur Loesung des Raetsels "Jans Eselin" von Pierre Tougne aus
# "Spektrum der Wissenschaft" 07/2002, S. 111:
#
####
# Bauer Jan will Eselsmilch auf dem Markt feilbieten. Die schoene Cleo kauft
# ihm dort zwischen einem und zwoelf (ganzen) Litern als Badezusatz ab; er
# weiss aber nicht, wie viele.
#
# Um die Milch zu transportieren und durch Umschuetten abzumessen besitzt
# Jan drei leere Tonkruege mit 7, 8 und 9 Litern und zwei volle mit 12 und 13
# Litern Inhalt. Seine Eselin kann aber nur einen der vollen und zwei der
# leeren Kruege zu Markt tragen.
#
# Welche Gefaesse muss Jan mitnehmen, um Cleos Wunsch auf jeden Fall
# erfuellen zu koennen?
####
#
# Die Richtige Loesung Lautet: den vollen 13 Liter fassenden Krug sowie die
# beiden leeren 7 und 8 Liter fassenden Kruege. Das folgende Programm
# errechnet, wie zwischen den Kruegen hin und hergeschuettet werden muss um
# eine menge von zwischen einem und zwoelf (ganzen) Litern zu erhalten.
#
# Ein solches System mit 3 Behaeltern kann (abh. von der jew. Configuration)
# nur etwa 1000 Zustaende annehmen, wobei nur ein exterm kleiner Bruchteil von
# der gegebenen Ausgangssituation aus tatsaechlich erreicht werden kann. Das
# Programm merkt sich die bereits analysierten Zustaende und durchlaeft einen
# bereits analysierten Baum nur dann, wenn ein schnellerer Weg zum erreichen
# der Wurzel des Baumes gefunden wurde. Damit ist es moeglich den gesammten
# Baum sinnvoller Aktionen selbst auf einem vergleichsweise kleinem
# Computersystem in einem Sekundenbruchteil abzuarbeiten. Es waere sogar
# mit vertretbarem Aufwand moeglich den hier verwendeten Algorithmus ohne
# Computer haendisch durchzurechnen.

use strict;
use English;


## Begin Of Configuration ##

my @result_list     = (  1 .. 12 );	# What we are searching for
my @data_list       = (  0 ..  2 );	# How many glasses do we have
my @data_value      = ( 13, 0, 0 );	# The inital content of the glasses
my @data_max        = ( 13, 7, 8 );	# The size of glasses

my $verbose   = 0;			# Create debug/status output
my $superfast = 0;			# Faster, but non-optimal results

## End Of Configuration ##


my %result_value;	# How good are the stored results
my %result_text;	# The textdescribing the result

my %recursion_trace;	# Don't evaluate the same sub-tree twice

my $constelation_c=0;	# Counter for reached constelations
my $constelation_p=1;	# Number of possible constelations
my $interation_c=0;	# Number of interations of recursion()

# The recursive function itself
#
sub recursion($$);
sub recursion($$) {
	my ($a, $b);	# Source and dest. positions in $data_value for trans.
	my $trans;	# Value which is transfered from $a to $b
	my $thisid="";	# Unique id for current situation (for %recursion_trace)

	$interation_c++;

	# Create a value for $thisid and check if the current situation is
	# a searched solution.
	#
	for $a (@data_list) {
		$thisid .= $data_value[$a] . "-";
		if (defined $result_value{$data_value[$a]} and
		    $result_value{$data_value[$a]} > $_[0] ) {
			$result_value{$data_value[$a]} = $_[0];
			$result_text{$data_value[$a]}  = "$_[1]$data_max[$a]";
			printf "%4d: %s\n", $data_value[$a],
			       $result_text{$data_value[$a]} if $verbose;
		}
	}

	# Don't evaluate the same sub-tree twice
	#
	# Setting $superfast will result in a much faster execution, but the
	# results will usually be longer than required. This option is usefull
	# to find out if there is a solution at all.
	#
	if (defined $recursion_trace{ $thisid }) {
		return if $superfast || $recursion_trace{ $thisid } <= $_[0];
	} else {
		$constelation_c++;
	}
	$recursion_trace{ $thisid } = $_[0];

	# Make all possible transfers for $a to $b and evaluate the
	# sub-trees.
	#
	my @data_oldval = @data_value;
	for $a (@data_list) {
	    for $b (@data_list) {
		$trans = $data_value[$a] > ($data_max[$b] - $data_value[$b]) ? 
			($data_max[$b] - $data_value[$b]) : $data_value[$a];
		if ($a != $b && $trans > 0) {
			$data_value[$a] -= $trans;
			$data_value[$b] += $trans;

			recursion($_[0] + 1, $_[1] .
			     sprintf("%-6s", "$data_max[$a]-$data_max[$b], "));
			@data_value=@data_oldval;
		}
	} }
}

print << 'EOT';

  JANS ESELIN ----- Written by Clifford Wolf (clifford@clifford.at), 10.7.2002
                               Please have a look at http://www.rocklinux.org/

  Programm zur Loesung des Raetsels "Jans Eselin" von Pierre Tougne aus
  "Spektrum der Wissenschaft" 07/2002, S. 111.
EOT

# Initalize the result hash with 99999 (very bad) so we can easily
# check for searched results in the recursion loop.
#
for (@result_list) { $result_value{$_} = 99999; }

# Calculate number of possible constelations
#
for (@data_list) { $constelation_p *= $data_max[$_]+1; }

# Run the recursion loop
#
recursion(0, "");

# Nice formatted output of the results
#
$_= "Results for " . (join ", ", @data_max);
$_= "Results for "; my $x;
for $x (@data_list) { $_ .= "$data_max[$x] ($data_value[$x]), "; }
s/, $//; s/, ([^,]*$)/ and $1/;
printf "\n+------=[ %s ]=---%s---+\n", $_, "-" x (60-length($_));
printf "|    %s    |\n", " " x 70;
for (@result_list) {
	$result_text{$_} = "No solution found!"
				unless defined $result_text{$_};
	printf "| %4d: %-70s%s\n", $_, $result_text{$_},
			length($result_text{$_}) > 70 ? "" : " |";
}
$_= sprintf "Reached %d of %d possible constelations in %d interations",
			$constelation_c, $constelation_p, $interation_c;
printf "|    %s    |\n", " " x 70;
printf "+------=[ %s ]=---%s---+\n\n", $_, "-" x (60-length($_));