#!/usr/bin/perl -w

use strict; $|++;

my $MAX_DEPTH = 10;
my $MAX_ITEMS_IN_LEFT_CONFIGURATIONS_REPORT = 5;

# %rule { id } => { a => String, b => String }

my %rule;
my %start_rule;
my @status;
my %nloops;
my %bad;
my %bad_rule;
my %config;
my %known;
my $depth;

sub _rule  { return "(\"$rule{$_}{a}\",\"$rule{$_}{b}\")";  }
sub __rule { return "($_ => "._rule($_).")"; }
sub _count { return shift, ": ",(scalar keys %start_rule),"\n"; }

PCP: while (<>) {
  my @line    = split;
  my @reverse = map { join("", reverse split //); } @line;
  my $reverse = 0;
  @status = ();

 TREE: while (1) {
    my $id = 'A';
    %rule = %start_rule = %bad_rule = %nloops = %bad = %config = %known = ();

    while (@line) {
      $rule{$id}{a} = $start_rule{$id}{a} = shift @line;
      $rule{$id}{b} = $start_rule{$id}{b} = shift @line;
      $id++;
    }

    warn "["
    , (map { _rule($_).(((chr(ord($_)+1)) eq $id)?'':','); } keys %rule), "]\n";
    print "["
    , (map { _rule($_).(((chr(ord($_)+1)) eq $id)?'':','); } keys %rule), "] -- ";

    warn "detecting startrules...\n";

    delete_not_matching();             warn _count("possible");
    delete_simpleloops();              warn _count("no simple loops");
    next PCP if delete_dead_start();   warn _count("no dead start");

    if (!scalar keys %start_rule) {
      warn "!UNSOLVABLE, no valid start/end found, "
      , join(", ", @status), "\n";
      print "!UNSOLVABLE, no valid start/end found, "
      , join(", ", @status), "\n"; next PCP;
    }

    @line = @reverse; last TREE if $reverse++;

    warn "no simple loop in forward-tree. Tyring the reverse...\n";
    push @status, "no simple loop in forward-tree. Tyring the reverse...";
  }

  warn "? $0 to thumb to decide, ", join(", ", @status), "\n";
  print "? $0 to thumb to decide, ", join(", ", @status), "\n";
}

sub delete_not_matching {

  for my $id (keys %start_rule) {

    my $a = $start_rule{$id}{a};
    my $b = $start_rule{$id}{b};

    # startrule only if prefix-match

    unless (($b=~/^$a/)||($a=~/^$b/)) {
      warn "...impossible start: $a => $b\n";
      delete $start_rule{$id}; push @status, "impossible start: $id";
    }
  }
}


sub delete_simpleloops {

  for my $id (keys %start_rule) {

    my $a = $start_rule{$id}{a};
    my $b = $start_rule{$id}{b};

    # test if rule contains only one digit

    if ("$a$b" !~ /1/ || "$a$b" !~ /0/) {
      my $digit    = substr($a,0,1);
      my $where    = (length($a)>length($b))?"top":"bottom";
      my $config = $digit x abs(length($b)-length($a));
      warn "...($a,$b) contains only the digit $digit\n";
      warn "...this causes an config $config... at the $where\n";

      # searching for rules with matching prefix und testing if the
      # matching rule contains also the other letter, then there is
      # a N-LOOP

      my $others_match     = 0;
      my $pattern_is_mixed = 0;
      my $pattern_eq_start = 0;

      for my $test_id (grep !/$id/, keys %rule) {
	my $test = ($where =~ /top/) ? $rule{$test_id}{b} : $rule{$test_id}{a};
	if (($test =~ /^$config/)||($config =~ /^$test/)) {
	  warn "......possible matching rule is $test_id with $test\n";
	  $others_match++;

	  (my $rest = $test) =~ s/^$digit*//;
	  warn "......rest: $rest\n";

	  if (length($rest)) {
	    my $diff = length($test)-length($rest)+2;
	    $pattern_is_mixed++;
	    $pattern_eq_start = ($pattern_eq_start>$diff)?$pattern_eq_start:$diff;
	  }
	}
      }

      unless ($others_match) {
	warn "...no other rule matches this prefix\n"
	, "...this causes an infinite loop (simple loop) thus this rule is not a valid startrule.\n",
	, "...additionally we have the bad config $config$digit* at the $where\n";
	delete $start_rule{$id};
	push @status, "simple_loop: $id...";
	$bad{$digit}=[($where=~/top/)?1:0,length($config)];
      }
      elsif ($others_match == $pattern_is_mixed) {
	warn "...all matching rules are mixed\n"
	, "...this causes an $pattern_eq_start-loop\n",
	, "...additionally we have the bad config ",($digit x ($pattern_eq_start+1)),"$digit* at the $where\n";
	push @status, "$pattern_eq_start-loop: ".($id x $pattern_eq_start)."...";
        $nloops{($id x $pattern_eq_start)}++;
	$bad{$digit}=[($where=~/top/)?1:0,$pattern_eq_start+1];
      }
    }
  }
}

sub delete_dead_start {

  for my $id (keys %start_rule) {

    my $a = $start_rule{$id}{a};
    my $b = $start_rule{$id}{b};

    my $where  = (length($a)>length($b))?"top":"bottom";
    %config = ( (length($a)>length($b))?substr($a,length($b)):substr($b,length($a)) => { top => ($where eq "top")?"1":"0", seq => $id } );
    %known  = %config;

    if (_traverse()) { return 1; }

    unless (%config) {
      warn "...startrule $id causes no valid configuration\n";
      push @status, "only dead_ends: $id";
      delete $start_rule{$id};
    }

    push @status, "startrule $id leads to ".
    (scalar keys %config)." configurations";

    if ((scalar keys %config)&&(scalar keys %config)<=$MAX_ITEMS_IN_LEFT_CONFIGURATIONS_REPORT)
    {
      push @status, "left configurations: (".(scalar keys %config).") ";
      push @status, join(", ",
			 map { $config{$_}{seq}." => ".$_." (".$config{$_}{top}.")"; } keys %config
			);
    }
  }
}

# traverse works on an existing config and use all the global stuff

sub _traverse {

  $depth = 1; _out_tree();

  while (($depth <= $MAX_DEPTH) && keys %config) {

    my %new_config = ();

    for my $config (keys %config) {
      my $config_matched = 0;
      warn "...testing $config at depth $depth\n";
      for my $rule (keys %rule) {
	my $test_a = ($config{$config}{top})?$rule{$rule}{b}:$rule{$rule}{a};
	my $test_b = ($config{$config}{top})?$rule{$rule}{a}:$rule{$rule}{b};
	my $new_config = "";
	warn "......testing rule $rule ($test_a,$test_b)\n";

	if (length($config)>=length($test_a)) {
	  if ($config =~ /^$test_a/) {
	    warn ".........rule matched\n"; $config_matched++;
	    $new_config = substr($config,length($test_a)).$test_b;

	    if ((defined($known{$new_config}))
		&&
		$known{$new_config}{top} == $config{$config}{top}
	       )
	    {
	      warn ".........config $new_config ($known{$new_config}{top}) already reached after $known{$new_config}{seq}\n";
	    } else {
	      $known{$new_config}{seq} = $config{$config}{seq}.$rule;
	      $known{$new_config}{top} = $config{$config}{top};
	      $new_config{$new_config}{seq} = $config{$config}{seq}.$rule;
	      $new_config{$new_config}{top} = $config{$config}{top};
	    }
	  }
	} else {
	  if ($test_a =~ /^$config/) {
	    warn ".........rule possible matching, testing for crosspoint\n";

	    my $part_test_a = substr($test_a, length($config));
	    my $diff        = length($part_test_a)-length($test_b);

	    if ($diff < 0) {
	      warn "............diff: $diff, testing $test_b against ^$part_test_a\n";
	      if ($test_b =~ /^$part_test_a/) {
		warn "............rule matched\n"; $config_matched++;

		$new_config = substr($test_b, length($part_test_a));

		if ((defined($known{$new_config}))
		    &&
		    $known{$new_config}{top} == $config{$config}{top}
		   )
		{
		  warn ".........config $new_config ($known{$new_config}{top}) already reached after $known{$new_config}{seq}\n";
		} else {
		  $known{$new_config}{seq} = $config{$config}{seq}.$rule;
		  $known{$new_config}{top} = $config{$config}{top};
		  $new_config{$new_config}{seq} = $config{$config}{seq}.$rule;
		  $new_config{$new_config}{top} = $config{$config}{top};
		}
	      }
	    } else {
	      warn "............diff: $diff, testing $part_test_a against ^$test_b\n";
	      if ($part_test_a =~ /^$test_b/) {
		warn "............rule matched\n"; $config_matched++;
		if ($diff == 0) {
		  warn "!VALID SEQUENCE FOUND: ("
		  , length($config{$config}{seq}.$rule)
		  , ") ", $config{$config}{seq}.$rule, "\n";
		  print "!VALID SEQUENCE FOUND: ("
		  , length($config{$config}{seq}.$rule)
		  , ") ", $config{$config}{seq}.$rule, "\n";
		  return 1;
		} else {
		  $new_config = substr($part_test_a, length($test_b));

		  if ((defined($known{$new_config}))
		      &&
		      $known{$new_config}{top} != $config{$config}{top}
		     )
		  {
		    warn ".........config $new_config ($known{$new_config}{top}) already reached after $known{$new_config}{seq}\n";
		  } else {
		    $known{$new_config}{seq} = $config{$config}{seq}.$rule;
		    $known{$new_config}{top} = 1-$config{$config}{top};
		    $new_config{$new_config}{seq} = $config{$config}{seq}.$rule;
		    $new_config{$new_config}{top} = 1-$config{$config}{top};
		  }
		}
	      }
	    }
	  }
	}
	if (defined( $new_config{$new_config} )
	    &&
	    defined( $bad_rule{ substr($new_config{$new_config}{seq},-1) } )
	    &&
	    defined( $bad_rule{ substr($new_config{$new_config}{seq},-1) }
		     { $config{$config}{top} }
		   )
	   )
	{
	  warn ".........bad rule applied, deleting $new_config{$new_config}{seq}: $new_config ($new_config{$new_config}{top})\n";
	  push @status, "bad rule applied, deleting $new_config{$new_config}{seq}: $new_config ($new_config{$new_config}{top})";
	  delete $new_config{$new_config};
	}
      }
      unless ($config_matched) {
	push @status, "dead_end: $config{$config}{seq}";
      }
    }
    for my $new_config (keys %new_config) {
      if ($nloops{$new_config{$new_config}{seq}}) {
	warn "...nloop occured, node $new_config{$new_config}{seq} deleted\n";
	push @status, "found ".length($new_config{$new_config}{seq})."-loop: $new_config{$new_config}{seq}";
	delete $new_config{$new_config};
      }
      elsif ((($new_config !~ /0/)||($new_config !~ /1/))
	  &&
	  defined($bad{substr($new_config,0,1)})
	  &&
	  @{$bad{substr($new_config,0,1)}}[0] == $new_config{$new_config}{top}
	  &&
	  length($new_config) - @{$bad{substr($new_config,0,1)}}[1] >= 0
	 ) {
	warn "...bad config $new_config ($new_config{$new_config}{top}) after $new_config{$new_config}{seq}\n";
	push @status, "bad config $new_config ($new_config{$new_config}{top}) after $new_config{$new_config}{seq}";
	delete $new_config{$new_config};
      }
    }
    %config = %new_config;

    _out_tree();

    $depth++;
  }
}

sub _out_tree {
  if (1) {
    warn
    join
    ("\n",
     map { $config{$_}{seq}.": ".$_." ($config{$_}{top})" }
     keys %config
    ),"\n"
    ;
  }
  warn "nodecount: ",(scalar keys %config),", depth: $depth\n\n";
}