Unnamed

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;
}