# solve the snake cube puzzle
# comes up with a brace of solutions in a matter of seconds
# prints out nicely on screen too
package Snake;

use strict;

# FUNCTIONS

# rotate a set of coordinates 90 degrees around any axis
sub rotate {
	my $method = shift;
	return [$_[0][0], -$_[0][2], $_[0][1]] if $method eq "X";
	return [-$_[0][2], $_[0][1], $_[0][0]] if $method eq "Y";
	return [-$_[0][1], $_[0][0], $_[0][2]];
}

# print out the surface of the cube as currently laid out.
# note that many interior points do not get printed out.
# these points should all be " " or "." though, unless you've
# broken the code
sub output {
#	system $^O eq 'MSWin32' ? 'cls' : 'clear';

	# output top
	print "            #===+===+===#\n";
	for(my $y = -4; $y <= 4; $y++) {
		print "            |";
		for(my $x = -4; $x <= 4; $x++) {
			my $z = 4;
			print $Snake::shaded{$x}{$y}{$z};
			if($x == 4) {
				print "|";
			} elsif(($x-1) % 3 == 0) {
				print ":";
			}
		}
		print "\n";
		if($y == 4) {
			print "#===+===+===#===+===+===#===+===+===#\n";
		} elsif(($y-1) % 3 == 0) {
			print "            #---+---+---#\n";
		}
	}

	for(my $z = 4; $z >= -4; $z--) {
		print "|";

		# output left
		for(my $y = -4; $y <= 4; $y++) {
			my $x = -4;
			print $Snake::shaded{$x}{$y}{$z};
			if($y == 4) {
				print "|";
			} elsif(($y-1) % 3 == 0) {
				print ":" if(($y-1) % 3 == 0);
			}
		}

		# output front
		for(my $x = -4; $x <= 4; $x++) {
			my $y = 4;
			print $Snake::shaded{$x}{$y}{$z};
			if($x == 4) {
				print "|";
			} elsif(($x-1) % 3 == 0) {
				print ":";
			}
		}

		# output right
		for(my $y = 4; $y >= -4; $y--) {
			my $x = 4;
			print $Snake::shaded{$x}{$y}{$z};
			if($y == -4) {
				print "|";
			} elsif(($y+1) % 3 == 0) {
				print ":";
			}
		}
		print "\n";
		if($z == -4) {
			print "#===+===+===#===+===+===#===+===+===#\n";
		} elsif(($z+1) % 3 == 0) {
			print "#---+---+---#---+---+---#---+---+---#\n";
		}
	}

	# output bottom
	for(my $y = 4; $y >= -4; $y--) {
		print "            |";
		for(my $x = -4; $x <= 4; $x++) {
			my $z = -4;
			print $Snake::shaded{$x}{$y}{$z};
			if($x == 4) {
				print "|";
			} elsif(($x-1) % 3 == 0) {
				print ":";
			}
		}
		print "\n";
		if($y == -4) {
			print "            #===+===+===#\n";
		} elsif(($y+1) % 3 == 0) {
			print "            #---+---+---#\n";
		}
	}

	# output back (upside-down)
	for(my $z = -4; $z <= 4; $z++) {
		print "            |";
		for(my $x = -4; $x <= 4; $x++) {
			my $y = -4;
			print $Snake::shaded{$x}{$y}{$z};
			if($x == 4) {
				print "|";
			} elsif(($x-1) % 3 == 0) {
				print ":";
			}
		}
		print "\n";
		if($z == 4) {
			print "            #===+===+===#\n";
		} elsif(($z-1) % 3 == 0) {
			print "            #---+---+---#\n";
		}
	}

#	<STDIN>;
}

# This is our main recursive solver routine.
sub tryThis;
sub tryThis {

	# curLocation is an integer from 0 to 26 which provides a quick lookup of
	# which location we're looking at. It may be quicker to pass X, Y and Z but
	# incrementing them is a pain and who cares
	my $curLocation = shift;
	my($X, $Y, $Z) = @{ $Snake::locations[$curLocation] };

	# this is the instant list of all possible cubies and rotations which
	# can be placed at the current location
	my %cubieRotations = %{ $Snake::locationRotations{$X}{$Y}{$Z} };

	foreach my $name (sort keys %cubieRotations) {

		# There is no use trying to place a cubie which has already been placed
		# elsewhere in the cube
		next if $Snake::cubies{$name}{"used"};

		# Now we look at all the rotations of this specific cubie at this location.
		# Note that almost all cubies have multiple distinct orientations
		my @rotations = @{ $cubieRotations{$name} };

		ROTATION: for(0..@rotations-1) {

			# this is the pattern on this cubie in this rotation
			my %rotation = %{ $rotations[$_] };

			# check to make sure that if we insert this cubie, it will be
			# consistent with everything already present.
			# to do this we iterate over all of its connectors with other cubies
			# note the instant lookup here!
			my @connectors = @{ $Snake::locationConnectors{$X}{$Y}{$Z} };

			CONNECTOR: for(0..@connectors-1) {

				# a connector is just an ordered pair of points in space which
				# must agree with one another.
				my @connector = @{ $connectors[$_] };

				# commit is always OK if there is no adjoining cubie which
				# needs agreeing with
				my @that = @{ $connector[0] };
				my $that = $Snake::shaded{$that[0]}{$that[1]}{$that[2]};
				next CONNECTOR if $that eq " ";

				# commit is not OK if there is an adjoining cubie which doesn't match
				my @this = @{ $connector[1] };
				my $this = $rotation{$this[0] - $X}{$this[1] - $Y}{$this[2] - $Z};
				next ROTATION unless $this eq $that;
			}

			# if we reach this point then we are go for commit, no inconsistency will
			# arise => commit now
			foreach my $x (-1, 0, 1) {
				foreach my $y (-1, 0, 1) {
					foreach my $z (-1, 0, 1) {
						$Snake::shaded{$x + $X}{$y + $Y}{$z + $Z} = $rotation{$x}{$y}{$z};
					}
				}
			}

			# mark this cubie as used
			$Snake::cubies{$name}{"used"} = 1;

			# move on to the next location
			$curLocation++;

			# if curLocation = 27 then we have solved the entire cube!
			# otherwise there is more to do!
			if($curLocation == scalar @Snake::locations) {
				output;
#				exit;
			} else {
				tryThis $curLocation;
			}

			# if we returned here, then we have exhausted all possibilities
			# and the current situation is completely unsolvable
			# so, undo the most recent step and try again

			# uncommit
			foreach my $x (-1, 0, 1) {
				foreach my $y (-1, 0, 1) {
					foreach my $z (-1, 0, 1) {
						$Snake::shaded{$x + $X}{$y + $Y}{$z + $Z} = " ";
					}
				}
			}

			# this cubie can now be used again
			$Snake::cubies{$name}{"used"} = 0;

			# go back a step
			$curLocation--;

			# if we reach 0 then we have exhausted all possibilities
			# and the cube is totally unsolvable
			exit if $curLocation == 0;
		}
	}
}

# RAW DATA

# canonical locations and connectors
# Each cubie is connected to at least four other cubies.
# For the cube to be considered solved, these connections
# must all agree. Here we list the connectors for each
# default cubie type (we generate the rest later using rotations)
%Snake::types = (
	'EDGE' => {
		'location' => [3,0,3],
		'connectors' => [[[1,0,4],[2,0,4]],[[3,-2,4],[3,-1,4]],[[3,2,4],[3,1,4]],[[4,2,3],[4,1,3]],[[4,0,1],[4,0,2]],[[4,-2,3],[4,-1,3]]]
	},
	'VERTEX' => {
		'location' => [3,3,3],
		'connectors' => [[[1,3,4],[2,3,4]],[[1,4,3],[2,4,3]],[[3,1,4],[3,2,4]],[[3,4,1],[3,4,2]],[[4,1,3],[4,2,3]],[[4,3,1],[4,3,2]]]
	},
	'FACE' => {
		'location' => [0,0,3],
		'connectors' => [[[-2,0,4],[-1,0,4]],[[0,-2,4],[0,-1,4]],[[0,2,4],[0,1,4]],[[2,0,4],[1,0,4]]]
	},
	'CENTRE' => {
		'location' => [0,0,0],
		'connectors' => []
	}
);

# list of canonical cubie configurations and types
# each cubie is modelled as a 3x3x3 cube centred on (0, 0, 0),
# with 0, 1, 2 or 3 of its faces exposed. We mark off the points
# on those faces which contain pieces of snake
%Snake::cubies = (
	'tony' => {'configuration' => [[0,1,1],[0,0,1],[0,-1,1]],'type' => 'EDGE'},
	'debo' => {'configuration' => [[-1,0,1],[0,0,1],[0,-1,1]],'type' => 'VERTEX'},
	'ben2' => {'configuration' => [[0,1,1],[0,0,1],[1,0,1]],'type' => 'FACE'},
	'ben1' => {'configuration' => [[0,1,1],[0,0,1],[1,0,1]],'type' => 'FACE'},
	'midd' => {'configuration' => [],'type' => 'CENTRE'},
	'wilm' => {'configuration' => [[0,1,1],[0,0,1],[1,0,1],[1,0,0],[1,0,-1]],'type' => 'EDGE'},
	'arik' => {'configuration' => [[1,0,-1],[1,0,0],[1,0,1],[0,0,1],[-1,0,1]],'type' => 'EDGE'},
	'chul' => {'configuration' => [[-1,1,0],[0,1,0],[0,1,-1],[1,0,-1],[1,0,0],[1,-1,0]],'type' => 'VERTEX'},
	'mark' => {'configuration' => [[-1,0,1],[0,0,1],[0,-1,1]],'type' => 'VERTEX'},
	'yvet' => {'configuration' => [[0,0,1],[0,-1,1]],'type' => 'VERTEX'},
	'mike' => {'configuration' => [[1,1,0],[1,0,0],[1,0,1],[0,0,1],[0,-1,1]],'type' => 'EDGE'},
	'wilf' => {'configuration' => [[1,1,0],[1,0,0],[1,0,1],[0,0,1],[0,-1,1]],'type' => 'EDGE'},
	'hort' => {'configuration' => [[-1,0,1],[0,0,1],[0,-1,1],[0,1,-1],[0,1,0],[1,1,0],[1,0,0],[1,-1,0]],'type' => 'VERTEX'},
	'ben3' => {'configuration' => [[0,1,1],[0,0,1],[1,0,1]],'type' => 'FACE'},
	'fred' => {'configuration' => [[1,0,-1],[1,0,0],[1,-1,0],[0,1,1],[0,0,1],[-1,0,1]],'type' => 'EDGE'},
	'alas' => {'configuration' => [[0,1,1],[0,0,1],[1,0,1],[1,0,0],[1,0,-1]],'type' => 'EDGE'},
	'barr' => {'configuration' => [[0,1,1],[0,0,1],[0,-1,1],[1,1,0],[1,0,0],[1,0,-1]],'type' => 'EDGE'},
	'sall' => {'configuration' => [[1,0,-1],[1,0,0],[1,0,1],[0,0,1],[0,-1,1]],'type' => 'EDGE'},
	'ben5' => {'configuration' => [[0,1,1],[0,0,1],[1,0,1]],'type' => 'FACE'},
	'stev' => {'configuration' => [[0,1,1],[0,0,1],[1,0,1],[1,0,0],[1,0,-1]],'type' => 'EDGE'},
	'albe' => {'configuration' => [[0,1,1],[0,0,1],[1,0,1],[1,0,0],[1,0,-1]],'type' => 'EDGE'},
	'ben4' => {'configuration' => [[0,1,1],[0,0,1],[1,0,1]],'type' => 'FACE'},
	'susi' => {'configuration' => [[-1,1,0],[0,1,0],[1,1,0],[1,0,0],[1,0,-1]],'type' => 'VERTEX'},
	'geof' => {'configuration' => [[1,0,-1],[1,0,0],[1,-1,0],[-1,0,1],[0,0,1],[0,-1,1]],'type' => 'EDGE'},
	'haze' => {'configuration' => [[0,0,1],[0,-1,1]],'type' => 'VERTEX'},
	'eddi' => {'configuration' => [[0,1,-1],[0,1,0],[1,1,0],[1,0,0],[1,-1,0]],'type' => 'VERTEX'},
	'flat' => {'configuration' => [[-1,0,1],[0,0,1],[1,0,1]],'type' => 'FACE'}
);

# mark each cubie unused to begin with
$Snake::cubie{$_}{"used"} = 0 foreach sort keys %Snake::cubies;

# Right. For efficiency purposes, it would be really useful if we could
# take a location in space and then instantly look up a list of all the
# connectors to that location.
# As a first step for this, we have to generate the complete set of connectors
# using rotations on the initial canonical set.

# each element in this list is a pair of a location and a connector set
my @cons = ();

# push canonical connectors
foreach my $type (sort keys %Snake::types) {
	my $new = {
		"location"      => $Snake::types{$type}{"location"},
		"configuration" => $Snake::types{$type}{"connectors"},
	};
	push @cons, $new;
}

# Now apply rotations to each existing list element to generate more.
# Note that we can't just use a for loop because the list is growing as we iterate over it
my $i = 0;
while($i < @cons) {
	AXIS: foreach my $axis ("X", "Y", "Z") {

		# apply rotation to create a new configuration
		my $new = {
			"location"      => (rotate $axis, $cons[$i]{"location"}),
			"configuration" => [ map { [ map { rotate $axis, $_ } @{$_} ] } @{ $cons[$i]{"configuration"} } ],
		};

		# compare with all existing cons
		# if they are at all different then we're fine
		OLD: foreach my $old (@cons) {
			next OLD if ${$new}{"location"}[0] != ${$old}{"location"}[0];
			next OLD if ${$new}{"location"}[1] != ${$old}{"location"}[1];
			next OLD if ${$new}{"location"}[2] != ${$old}{"location"}[2];

			# if we get here then the new element is the same as an old one so discard it
			next AXIS;
		}

		push @cons, $new;
	}
	$i++;
}

# @cons is basically useless for accessing because you need to iterate over it to find anything.
# Now to generate a more useful list, indexed by location
%Snake::locationConnectors = ();
foreach my $con (@cons) {
	my %con = %{ $con };
	my @location = @{ $con{"location"} };
	my $X = $location[0];
	my $Y = $location[1];
	my $Z = $location[2];
	my @configuration = @{ $con{"configuration"} };

	$Snake::locationConnectors{$X}{$Y}{$Z} = $con{"configuration"};
}

# Now we need to do the same thing for the cubies. Anytime we have a location,
# we want instant access to a complete list of all the possible cubies and orientations
# we can put at that location.

# generate all possible rotated positions of all cubies
my @rots = ();

# push canonical rotations
foreach my $name (sort keys %Snake::cubies) {

	my %configuration = ();

	# grey in the whole volume
	for(my $x = -1; $x <= 1; $x++) {
		for(my $y = -1; $y <= 1; $y++) {
			for(my $z = -1; $z <= 1; $z++) {
				$configuration{$x}{$y}{$z} = ".";
			}
		}
	}

	# blacken the selected areas
	$configuration{ ${$_}[0] }{ ${$_}[1] }{ ${$_}[2] } = "#" foreach @{ $Snake::cubies{$name}{"configuration"} };

	my $new = {
		"name"          => $name,
		"location"      => $Snake::types{$Snake::cubies{$name}{"type"}}{"location"},
		"configuration" => \%configuration,
	};

	push @rots, $new;
}

# now generate all possible rotations
# Again, we can't just use a for loop because the list is growing as we iterate over it
$i = 0;
while($i < @rots) {
	AXIS: foreach my $axis ("X", "Y", "Z") {

		# apply rotation to create a new configuration
		my %configuration = ();
		foreach my $x (-1, 0, 1) {
			foreach my $y (-1, 0, 1) {
				foreach my $z (-1, 0, 1) {
					my @that = @{ rotate $axis, [$x, $y, $z] };
					$configuration{ $that[0] }{ $that[1] }{ $that[2] } = $rots[$i]{"configuration"}{$x}{$y}{$z};
				}
			}
		}

		my $new = {
			"name"          => $rots[$i]{"name"},
			"location"      => (rotate $axis, $rots[$i]{"location"}),
			"configuration" => \%configuration,
		};

		# compare with all existing rots
		# if it is identical in every way to an existing rot then skip it
		OLD: foreach my $old (@rots) {
			# as soon as a discrepancy is detected we can move forward
			next OLD if ${$new}{"name"} ne ${$old}{"name"};
			next OLD if ${$new}{"location"}[0] != ${$old}{"location"}[0];
			next OLD if ${$new}{"location"}[1] != ${$old}{"location"}[1];
			next OLD if ${$new}{"location"}[2] != ${$old}{"location"}[2];
			foreach my $x (-1, 0, 1) {
				foreach my $y (-1, 0, 1) {
					foreach my $z (-1, 0, 1) {
						next OLD if ${$new}{"configuration"}{$x}{$y}{$z} ne ${$old}{"configuration"}{$x}{$y}{$z};
					}
				}
			}

			# if we reach this line then we have equality
			next AXIS;
		}

		push @rots, $new;
	}
	$i++;
}

# We can now generate a much more useful list, indexed by location and cubie
%Snake::locationRotations = ();
foreach my $rot (@rots) {
	my %rot = %{ $rot };
	my $name = $rot{"name"};
	my @location = @{ $rot{"location"} };
	my $X = $location[0];
	my $Y = $location[1];
	my $Z = $location[2];
	my %configuration = %{ $rot{"configuration"} };

	push @{ $Snake::locationRotations{$X}{$Y}{$Z}{$name} }, \%configuration;
}

# list of locations where cubies are to be placed
# in the order in which they're to be placed there
# this ordering could probably be modified for greater efficiency
# but at the moment we just fill up row by row and plane by plane
@Snake::locations = ();
for(my $x = -3; $x <= 3; $x+=3) {
	for(my $y = -3; $y <= 3; $y+=3) {
		for(my $z = -3; $z <= 3; $z+=3) {
			push @Snake::locations, [$x, $y, $z];
		}
	}
}

# create an empty cube, suitable for populating
%Snake::shaded = ();
for(my $x = -4; $x <= 4; $x++) {
	for(my $y = -4; $y <= 4; $y++) {
		for(my $z = -4; $z <= 4; $z++) {
			$Snake::shaded{$x}{$y}{$z} = " ";
		}
	}
}

# AND GO
tryThis 0;