my $e = ['e']; my $x = ['x']; my $L = ['L']; my $R = ['R']; my @v = ( $L, $R ); # breadth first search FIFO my %prev; # for reconstructing how you got there $prev{str($L)} = $L; $prev{str($R)} = $R; my %color; # trees reachable from either side $color{str($L)} = 1; $color{str($R)} = 2; while (@v) { $t = shift @v; my @n = gen($t); foreach my $p (@n) { if (my $c = $color{str($p)}) { if ($c!=$color{str($t)}) { print "proof:\n"; print "part 1:\n"; history($t); print str($p),"\n"; print "part 2:\n"; history($p); exit; } } else { $color{str($p)} = $color{str($t)}; $prev{str($p)} = $t; push @v, $p; } } } sub history($) { my $p = shift; my $pp = $prev{str($p)}; history($pp) unless $pp==$p; print str($p),"\n"; } sub str($) { my $t = shift; if (1==@$t) { return $t->[0]; } else { return "(".str($t->[0])."*".str($t->[1]).")"; } } sub gen($) { my $t = shift; my @g; push @g, [$L,$x] if ($t==$e); push @g, [$x,$R] if ($t==$e); push @g, [$t, $e], [$e, $t]; if (2==@$t) { my $tl = $t->[0]; my $tr = $t->[1]; push @g, $e if (($tl==$L)&&($tr==$x)); push @g, $e if (($tl==$x)&&($tr==$R)); push @g, $tr if ($tl==$e); push @g, $tl if ($tr==$e); push @g, [$tl->[0], [$tl->[1],$tr]] if (2==@$tl); push @g, [[$tl,$tr->[0]], $tr->[1]] if (2==@$tr); foreach $p (gen($tl)) { push @g, [$p, $tr]; } foreach $p (gen($tr)) { push @g, [$tl, $p]; } } return @g; }