use strict;
use Data::Dumper;

my $solved = 0;
my $n = 1;
my %sq = ();
my %pe = ();
my %hx = ();
my %hp = ();
my %oc = ();
my %num = ();

print "Generating numbers...\n";
for ($n = 1; $n < 10000; $n++)
{
	my $sqr = $n * $n;
	my $pen = $n * (3 * $n - 1) / 2;
	my $hex = $n * (2 * $n - 1);
	my $hep = $n * (5 * $n - 3) / 2;
	my $oct = $n * (3 * $n - 2);
	my $tri = $n * ($n + 1) / 2;
	push (@{$num{substr($tri,0,2)}}, "$tri:3:$n" ) if (length($tri) == 4);
	push (@{$num{substr($sqr,0,2)}}, "$sqr:4:$n" ) if (length($sqr) == 4);
	push (@{$num{substr($pen,0,2)}}, "$pen:5:$n" ) if (length($pen) == 4);
	push (@{$num{substr($hex,0,2)}}, "$hex:6:$n" ) if (length($hex) == 4);
	push (@{$num{substr($hep,0,2)}}, "$hep:7:$n" ) if (length($hep) == 4);
	push (@{$num{substr($oct,0,2)}}, "$oct:8:$n" ) if (length($oct) == 4);
}

$| = 0;
$n = 1;
while (! $solved)
{
	my ($sqr, $pen, $hex, $hep, $oct);
	$oct = $n * (3 * $n - 2);
	$n++;
	next if ($oct < 1000);
	$solved = 1 if ($oct > 10000);
	my ($a, $b, $c, $d, $e, $l, $m, $o, $p, $q);
	#print "Checking $oct...\n";
	#print Dumper(%num);
	my @t;
	
	foreach $l (@{$num{substr($oct,-2)}})
	{
		@t = split(':',$l);
		$a = { n => $t[0], t => $t[1] };
		if ($a->{'t'} != 8)
		{
			foreach $m (@{$num{substr($a->{'n'},-2)}})
			{
				@t = split(':',$m);
				$b = { n => $t[0], t => $t[1] };
				if ($b->{'t'} != $a->{'t'} && $b->{'t'} != 8)
				{
					foreach $o (@{$num{substr($b->{'n'},-2)}})
					{
						@t = split(':',$o);
						$c = { n => $t[0], t => $t[1] };
						if ($c->{'t'} != $b->{'t'} && $c->{'t'} != $a->{'t'} && $c->{'t'} != 8)
						{
							foreach $p (@{$num{substr($c->{'n'},-2)}})
							{
								@t = split(':',$p);
								$d = { n => $t[0], t => $t[1] };
								if ($d->{'t'} != $c->{'t'} && $d->{'t'} != $b->{'t'} && $d->{'t'} != $a->{'t'} && $d->{'t'} != 8)
								{
									foreach $q (@{$num{substr($d->{'n'},-2)}})
									{
										@t = split(':',$q);
										$e = { n => $t[0], t => $t[1] };
										if ($e->{'t'} != $d->{'t'} && $e->{'t'} != $c->{'t'} && $e->{'t'} != $b->{'t'} && $e->{'t'} != $a->{'t'} && $e->{'t'} != 8)
										{
											if (substr($e->{'n'},-2) eq substr($oct,0,2))
											{
												my %z = ();
												$z{8} = 1;
												$z{$a->{'n'}} = 1;
												$z{$b->{'n'}} = 1;
												$z{$c->{'n'}} = 1;
												$z{$d->{'n'}} = 1;
												$z{$e->{'n'}} = 1;
												if (scalar(keys(%z)) == 6)
												{
													print "$l -> $m -> $o -> $p -> $q -> $oct:8:$n\n";
													print (($oct + $a->{'n'} + $b->{'n'} + $c->{'n'} + $d->{'n'} + $e->{'n'}) . "\n");
													#$solved = 1;
													last;
												}
											}
										}
									}
								}
							}
						}
					}
				}
			}
		}
	}
}