#!/usr/bin/perl -T

use strict;
use warnings;
use Carp;

use constant { warn_recur => 200,
               max_recur => 1000,
               max_solutions => -1 };

my $count;
my $i;
my @bottles = ( );
my @potions = ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 );
my $pcount = 0;
my @solutions = ( );
my @sorted;
my $depth = 0;
my $depth_max = 0;
my $invalid = 0;
my %flags = ( 'split' => 0,
              'short-circuit' => 0,
              'verbose' => 0 );
my $stop_after = max_solutions;

if(@ARGV == 1 && $ARGV[0] eq '--help')
  {
  print <<"EOT";
USAGE

        flasks.pl --help
        flasks.pl [-v] [--split] [--short-circuit]

        -v              = Be verbose
        --help	        = Show this screen
        --split	        = Allow splitting of stacked layers of a potion
        --short-circuit = Stop searching upon the first solution found
EOT

  exit(0);
  }

foreach (@ARGV)
  {
my $l_flag;

  if(substr($_, 0, 1) eq '-')
    {
    if(substr($_, 0, 2) eq '--')
      {
      $l_flag = substr($_, 2);

      croak "Unknown switch: $_" if(!exists $flags{$l_flag});

      $flags{$l_flag} = 1;
      }
    else
      {
      if(length($_) != 2)
        {
        croak "Invalid argument: $_";
        }
      elsif($_ eq '-v')
        {
        $flags{'verbose'} = 1;
        }
      else
        {
        croak "Unknown switch: $_";
        }
      }
    }
  }

$stop_after = 1 if($flags{'short-circuit'});

do
  {
  print "Number of flasks: ";
  $count = <STDIN>;
  $count =~ /^([0-9]+)$/;
  $count = $1;

  if(!defined $count)
    {
    print "Invalid value: Must be a natural number!\n";
    }
  elsif($count < 2)
    {
    print "Invalid count: Mst be at least 2 flasks!\n";
    }
  }
until(defined $count && $count >= 2);

print "Please enter the vales, at most 4 values per flask:\n";
print "Please separate multiple values by blanks.\n";
print "Show potion types with t, h for additional information\n";

$i = 1;

do
  {
my $l_this;

  print "Flask $i: ";
  $l_this = <STDIN>;

  chomp($l_this);
  if($l_this eq 'H' || $l_this eq 'h')
    {
    print <<EOT
The Flask Game

This is about moving different potions from one flask to another so that ther
is just one type of potion in a particlar flask.
The contents of a flask can be moved to another if there is enogh space in the
target flask and the type of the topmost potion matches the type of the potion
to be moved. Empty flasks that provide additional space can be used as well.

You can move potions of any type to an empty flask.

Please enter the information for every flask, beginning with the bottom layer
and progressing upward, i. e. start with the first row from left to right,
then continue with the next row if present until you have processed all
flasks. In the end each potion that is present must have a number of laysers
that is evenly divisible by four or a solution cannot be found!
EOT
    }
  elsif($l_this eq 'T' || $l_this eq 't')
    {
    print <<EOT
Available color palette (it may be that not all values are used):

 1: Magenta (cross)
 2: Red (heart)
 3: Orange (circle)
 4: Yellow (crescent)
 5: Light green (five-pointed star)
 6: Green (stylized clover)
 7: Blue-green (leaf)
 8: Cyan (four-pointed star)
 9: Blue (square)
10: Light purple (triangle)
11: Purple (diamond)
12: Pink (butterfly)
EOT
    }
  else
    {
my @l_list = split(/ /, $l_this);
my $l_i;
my $l_skip = 0;

    if(@l_list > 4)
      {
      print "Invalid data! You may enter at most four values!\n";
      $l_skip = 1;
      }
    else
      {
      for($l_i = 0; $l_i < @l_list; $l_i++)
        {
        if($l_list[$l_i] !~ /^([0-9]+)$/)
          {
          print "Invalid value: Only numbers are allowed!\n";
          $l_skip = 1;
          last;
          }

        $l_list[$l_i] = $1;
        }
      }

    if($l_skip == 0)
      {
      push(@bottles, [ @l_list ]);
      for($l_i = 0; $l_i < @l_list; $l_i++)
        {
        $potions[$l_list[$l_i] - 1]++;
        }
      $i++;
      }
    }
  }
while($i <= $count);

for($i = 0; $i < @potions; $i++)
  {
  print "Units of potion type ".($i + 1).": $potions[$i]\n";
  if($potions[$i] % 4 != 0)
    {
    $invalid = 1;
    }
  elsif($potions[$i] > 0)
    {
    $pcount++;
    }
  }

if($invalid)
  {
  print "Each potion type must have a number of units that is evenly divisible by 4!\n";
  print "This isn't a given here so that a solution cannot be computed!\n";
  exit(1);
  }

if($count <= $pcount)
  {
  print "No space!\n";
  print "Gaps must be present so that the contents of flasks can be moved!\n";
  exit(2);
  }

sub comparator :prototype($$)
  {
my $p_chain1 = $_[0];
my $p_chain2 = $_[1];

  return $#{$p_chain1} <=> $#{$p_chain2};
  }

sub print_solution
  {
my $l_i;
my $p_chain = $_[0];

  for($l_i = 0; $l_i < @{$p_chain}; $l_i++)
    {
    print ((${${$p_chain}[$l_i]}[0] + 1)." => ".(${${$p_chain}[$l_i]}[1] + 1));

    print ", " if($l_i < $#{$p_chain});
    }
  print "\n";
  }

sub recurse
  {
my @p_bottles = @{$_[0]};
my $p_chain = $_[1];
my ($l_i, $l_j, $l_k);
my $l_layer;
my $l_lcount;
my @l_bottles;
my $l_result = 0;
my $l_complete = 0;

  carp "This requires a lot of recursion..." if(++$depth == warn_recur);
  confess "Way too much recursion!" if($depth > max_recur);

  $depth_max = $depth if($depth > $depth_max);

# Do we have a solution?
FLASKS: for($l_i = 0; $l_i < @p_bottles; $l_i++)
    {
# Empty flask: Ignore!
    next if(@{$p_bottles[$l_i]} == 0);
# Flask not full: No solution!
    last if(@{$p_bottles[$l_i]} < 4);

    $l_layer = ${$p_bottles[$l_i]}[0];

    for($l_j = 1; $l_j < 4; $l_j++)
      {
# Different potions in a flask: No solution!
      last FLASKS if(${$p_bottles[$l_i]}[$l_j] != $l_layer);
      }
    $l_complete++;
    }

  if($l_complete == $pcount)
    {
    @solutions = ( ) if(@solutions > 0 && scalar @{$p_chain} < scalar @{$solutions[0]});

    next if(@solutions > 0 && scalar @{$p_chain} > scalar @{$solutions[0]});

    push(@solutions, [ @{$p_chain} ]);
    print "Found solution #".(scalar @solutions)."...\r" if($flags{'verbose'});
    $stop_after--;
    $depth--;
    return 1;
    }

  for($l_i = 0; $l_i < @p_bottles; $l_i++)
    {
# Empty flask of origin: Skip!
    next if(@{$p_bottles[$l_i]} == 0);

    $l_layer = ${$p_bottles[$l_i]}[$#{$p_bottles[$l_i]}];
    $l_lcount = 0;
    for($l_j = $#{$p_bottles[$l_i]}; $l_j >= 0; $l_j--)
      {
      last if(${$p_bottles[$l_i]}[$l_j] != $l_layer);
      $l_lcount++;
      }

# Special case: Potion with eactly two stacked units found at the top!
#               If we can find one unit of said potion in two different flasks
#               each we can split it!
    if($l_lcount == 2 && $flags{'split'})
      {
my @l_targets = ( );

      for($l_j = 0; $l_j < @p_bottles; $l_j++)
        {
# Origin == target: Skip!
        next if($l_j == $l_i);
# Target flask empty: Skip!
        next if(@{$p_bottles[$l_j]} == 0);
# Target flask full: Skip!
        next if(@{$p_bottles[$l_j]} == 4);

        push(@l_targets, $l_j) if(${$p_bottles[$l_j]}[$#{$p_bottles[$l_j]}] == $l_layer);
        }

# Found two flasks with the desired potion: Split the double layer!
      if(@l_targets == 2)
        {
        @l_bottles = ( );
        
        foreach (@p_bottles)
          {
          push(@l_bottles, [ @{$_} ]);
          }

        push(@{$l_bottles[$l_targets[0]]}, pop(@{$l_bottles[$l_i]}));
        push(@{$p_chain}, [ $l_i, $l_targets[0] ]);
        push(@{$l_bottles[$l_targets[1]]}, pop(@{$l_bottles[$l_i]}));
        push(@{$p_chain}, [ $l_i, $l_targets[1] ]);
        $l_result = 1 if(recurse([ @l_bottles ], $p_chain) == 1);
        return $l_result if($stop_after == 0);
        pop(@{$p_chain});
        pop(@{$p_chain});
        }
      }

    for($l_j = 0; $l_j < @p_bottles; $l_j++)
      {
# Origin == target: Skip!
      next if($l_i == $l_j);
# Flask of origin contains exactly one potion and the target flask is empty: Skip!
      next if(@{$p_bottles[$l_i]} == $l_lcount && @{$p_bottles[$l_j]} == 0);
# Target flask fll: Skip!
      next if(@{$p_bottles[$l_j]} == 4);
      if(@{$p_bottles[$l_j]} != 0)
        {
# The potion in the flask of origin doesn't match the one at the target: Skip!
        next if(${$p_bottles[$l_j]}[$#{$p_bottles[$l_j]}] != $l_layer);
# Not enough space in the target flask: Skip!
        next if(@{$p_bottles[$l_j]} + $l_lcount > 4);
        }

# Copy the entire array including subarrays!
# We need an exact duplicate of the original that we can work with so that the
# original state is retained!
      @l_bottles = ( );
      foreach (@p_bottles)
        {
        push(@l_bottles, [ @{$_} ]);
        }

      for($l_k = 0; $l_k < $l_lcount; $l_k++)
        {
        push(@{$l_bottles[$l_j]}, pop(@{$l_bottles[$l_i]}));
        }
      push(@{$p_chain}, [ $l_i, $l_j ]);
      $l_result = 1 if(recurse([ @l_bottles ], $p_chain) == 1);
      return $l_result if($stop_after == 0);
      pop(@{$p_chain});
      }
    }

  $depth--;
  return $l_result;
  };

if(recurse([ @bottles ], [ ]))
  {
  print ((scalar @solutions)." solutions could be found:\n");
  @sorted = sort comparator @solutions;
  print "\n" if($flags{'verbose'});
  print "Maximum recursion: $depth_max\n";
  for($i = 0; $i < @sorted; $i++)
    {
    print (($i + 1).": ");
    print_solution($sorted[$i]);
    }
  }
else
  {
  print "\n" if($flags{'verbose'});
  print "The task doesn't compute!\n";
  }
