--- symmetry.pl 2007/08/26 10:26:13 3 +++ symmetry.pl 2007/08/26 14:45:26 7 @@ -26,8 +26,11 @@ +-+-+-+-+-+-+-+-+ _BOARD_ +my $debug = shift @ARGV || 0; + my @board = map { split(//) } split(/\n/, $board); my @trace; +my @visited = (' ') x ($#board + 1); # line length my $ll = 8 * 2 + 1; @@ -42,31 +45,69 @@ # unknown trace position my $unknown = ' '; +# path traversed +my @directions; + +my @shapes_found; + +my @shapes_start = ( '0,0' ); #( qw/0,0 1,0 0,3/ ); + sub draw { my $o = 0; - my $out; + my $out = "\n " . join('', + ('0 1 2 3 4 5 6 7 8 | ') x 3 + ) . "\n"; while ( $o < $#board ) { + my $l = '|'; + if ( $o % ($ll*2) == 0) { + my $y = int($o / ($ll*2)); + $out .= "$y "; + $l = $y; + } else { + $out .= " "; + } + $out .= join('', @board[ $o .. $o + $ll - 1 ]); - $out .= ' '; + $out .= " $l "; $out .= join('', @trace[ $o .. $o + $ll - 1 ]); - $out .= "\n"; + $out .= " $l "; + $out .= join('', @visited[ $o .. $o + $ll - 1 ]); + $out .= " $l\n"; $o += $ll; } + + $out .= "\n"; + return $out; } sub trace { warn "## trace $pos\n"; $trace[ $pos ] = $board[ $pos ]; + $visited[$pos]++; +} + +sub x_y { + my $p = shift; + + $p ||= $pos; + + my $y = int($p / ($ll*2)); + my $x = int(($p % $ll) / 2); + + warn "## x_y($p) -> $x,$y\n"; + +# return ($x,$y) if wantarray; + return "$x,$y"; } sub move { - warn "move $step $step_name[$step]\n"; $pos += $move_by[ $step ]; trace; $pos += $move_by[ $step ]; trace; - warn draw( @trace ); + push @directions, $step; + warn "move $step $step_name[$step] to ", x_y, "\n"; } sub follow { @@ -77,6 +118,8 @@ my $ok_path = qr/[\|\-]/; +my @corners; + sub can_turn { my $try_step = shift; die "no step?" unless defined $try_step; @@ -87,35 +130,52 @@ my $old = $trace[ $turn_pos ]; $trace[ $turn_pos ] = '?'; - warn "TEST\n",draw( @trace ); + $trace[ $pos ] = '*'; + warn "TEST ", x_y($turn_pos), "\n",draw; $trace[ $turn_pos ] = $old; if ( $board[ $turn_pos ] =~ $ok_path ) { - warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])"; + my $xy = x_y($turn_pos); + warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos]) to $xy\n"; $step = $try_step; + push @corners, $xy; return 1; } else { - warn "NOPE can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])"; + warn "NOPE can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])\n"; return 0; } } +sub show_directions { + return + join('', + map { + substr($step_name[$_],0,1) + } @directions + ) + ; +} + sub shape { my ($x,$y) = @_; $pos = $y * $ll * 2 + $x * 2; - warn "<<< shape from $x,$y pos: $pos\n"; @trace = ($unknown) x ( $#board + 1 ); + @directions = (); + @corners = (); trace; my $len = 0; + $step = 0; + + warn "<<< shape from $x,$y pos: $pos\n"; while( 1 ) { my $next_pos = $pos + $move_by[ $step ]; - warn "in loop - pos = $pos next_pos = $next_pos step = $step $step_name[$step]\n"; + warn "# pos: $pos next_pos: $next_pos step: $step $step_name[$step] trace: ",show_directions,"\n"; if ( $trace[ $next_pos ] ne $unknown ) { warn "position $next_pos re-visited, exiting\n"; @@ -129,18 +189,41 @@ warn "find line continuation from $step $step_name[$step]...\n"; can_turn( $step - 1 ) || can_turn( $step + 1 ) || die "can't find new direction"; } - warn draw( @trace ); + warn draw; - print "WAIT> press enter"; my $foo = ; + if ( $debug ) { + print "WAIT> press enter | ",show_directions; my $foo = ; + } } - warn ">>> ended at $pos, line length: $len\n"; + push @shapes_found, { x => $x, y => $y, len => $len, directions => show_directions }; + + warn "### corners: ",join(' ', @corners),"\n"; + warn ">>> ended at $pos, line length: $len, directions traversed: ",show_directions,"\n"; + + foreach my $c ( @corners ) { + if ( ! grep( /\Q$c\E/, @shapes_start ) ) { + warn "INFO: added corner $c as shape start\n"; + push @shapes_start, $c; + } + } + + print "WAIT> press enter"; my $foo = ; + return $len; } -my $shapes = '0,0 1,0'; +foreach my $start ( @shapes_start ) { + my ($x,$y) = split(/,/,$start); + if ( $x < 8 && $y < 8 ) { + my $len = shape( split(/,/,$start) ); + warn "## $start has $len elements\n"; + } else { + warn "SKIPPED $start\n"; + } +} -foreach my $start ( split(/\s/,$shapes) ) { - my $len = shape( split(/,/,$start) ); - warn "## $start has $len elements\n"; +print ">>> RESULTS:\n"; +foreach my $r ( @shapes_found ) { + printf "%2d,%-2d len: %-4d directions: %s\n", $r->{x}, $r->{y}, $r->{len}, $r->{directions}; }