--- symmetry.pl 2007/08/26 02:53:41 1 +++ symmetry.pl 2007/08/26 14:15:26 6 @@ -6,8 +6,6 @@ use strict; -use Data::Dump qw/dump/; - my $board = << '_BOARD_'; +-+-+-+-+-+-+-+-+ | | |o| | | @@ -28,49 +26,127 @@ +-+-+-+-+-+-+-+-+ _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; +my @step_name = ( qw/right down left up/ ); +my @move_by = ( 1, $ll, -1, -$ll ); +my $step = 0; # right + +# offset 0, top-left corner +my $pos = 0; + +# 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 @board = @_; my $o = 0; - my $out; + my $out = "\n " . join('', + ('0 1 2 3 4 5 6 7 8 | ') x 3 + ) . "\n"; while ( $o < $#board ) { - $out .= join('', @board[ $o .. $o + $ll - 1 ]) . "\n"; + 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 .= " $l "; + $out .= join('', @trace[ $o .. $o + $ll - 1 ]); + $out .= " $l "; + $out .= join('', @visited[ $o .. $o + $ll - 1 ]); + $out .= " $l\n"; $o += $ll; } - return $out; -} - -print $board, draw( @board ); -my @step_name = ( qw/right down left up/ ); -my @move_by = ( 1, $ll, -1, -$ll ); -my $step = 0; # right + $out .= "\n"; -# offset 0, top-left corner -my $pos = 0; -$pos = 2; -$pos = 6; + return $out; +} -my @trace = ('x') x ( $#board + 1 ); sub trace { - warn "trace $pos\n"; + warn "## trace $pos\n"; $trace[ $pos ] = $board[ $pos ]; + $visited[$pos]++; } -warn draw( @trace ); -trace; +my ( $tr_x, $tr_y ); +my ( $bl_x, $bl_y ); + +sub x_y { + my $p = shift; + + my $update = 0; + if ( ! defined( $p ) ) { + $p = $pos; + $update = 1; + } + + my $y = int($p / ($ll*2)); + my $x = int(($p % $ll) / 2); + + warn "??? x_y($p) $x,$y tr: $tr_x,$tr_y bl: $bl_x,$bl_y\n"; + + if ( $update ) { + +# $tr_x = $x if $x > $tr_x && $y == $tr_y; +# $tr_y = $y if $y < $tr_y && $x == $tr_x; + + if ( + $y < $tr_y + || + $y <= $tr_y && $x > $tr_x + ) { + ( $tr_x, $tr_y ) = ( $x, $y ); + warn "## UPDATED tr: $tr_x,$tr_y\n"; + } + + if ( + $x < $bl_x + || + $y > $bl_y + ) { + ( $bl_x, $bl_y ) = ( $x, $y ); + warn "## UPDATED bl: $bl_x,$bl_y\n"; + } + +# $bl_x = $x if $x < $bl_x; # && $y == $bl_y; +# $bl_y = $y if $y > $bl_y; # && $x == $bl_x; + + } + + warn "## x_y($p) -> $x,$y ", + $update ? " tr: $tr_x,$tr_y bl: $bl_x,$bl_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 { @@ -82,51 +158,114 @@ my $ok_path = qr/[\|\-]/; sub can_turn { - my $step = shift; - die "no step?" unless defined $step; + my $try_step = shift; + die "no step?" unless defined $try_step; - my $turn_pos = $pos + $move_by[ $step % 4 ]; + $try_step %= 4; + + my $turn_pos = $pos + $move_by[$try_step]; 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 $step_name[$step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])"; + warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])\n"; + $step = $try_step; return 1; } else { - warn "NOPE can_turn $step_name[$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; } } -while( 1 ) { +sub show_directions { + return + join('', + map { + substr($step_name[$_],0,1) + } @directions + ) + ; +} + +sub shape { - my $next_pos = $pos + $move_by[ $step ]; - warn "in loop - pos = $pos next_pos = $next_pos step = $step $step_name[$step]\n"; + my ($x,$y) = @_; - if ( $trace[ $next_pos ] ne 'x' ) { - warn "position $next_pos re-visited, exiting\n"; - last; - } elsif ( $board[ $next_pos ] =~ $ok_path ) { - warn "OK next_pos = $next_pos b($board[$next_pos]) t($trace[$next_pos])\n"; - move; - follow( $step+1 ) if can_turn( $step+1 ); - } else { - warn "find line continuation from $step $step_name[$step]...\n"; - foreach my $o ( -1, 1 ) { - if ( can_turn( $step + $o ) ) { - $step = $step+$o; - warn "new direction: $step $step_name[$step]\n"; - follow( $step ); - last; - } + $pos = $y * $ll * 2 + $x * 2; + + @trace = ($unknown) x ( $#board + 1 ); + @directions = (); + trace; + + my $len = 0; + ( $tr_x, $tr_y ) = ( $x,$y ); + ( $bl_x, $bl_y ) = ( $x,$y ); + $step = 0; + + if ( $visited[$pos] > 3 ) { + warn "*** shape from $x,$y pos: $pos iterated 4 times, skipping\n"; + return; + } + + warn "<<< shape from $x,$y pos: $pos\n"; + + while( 1 ) { + + my $next_pos = $pos + $move_by[ $step ]; + 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"; + last; + } elsif ( $board[ $next_pos ] =~ $ok_path ) { + warn "OK next_pos = $next_pos b($board[$next_pos]) t($trace[$next_pos])\n"; + move; + $len++; + can_turn( $step + 1 ); + } else { + 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; + + warn "## tr: $tr_x,$tr_y bl: $bl_x,$bl_y\n"; + + if ( $debug ) { + print "WAIT> press enter | ",show_directions; my $foo = ; + } + } + + push @shapes_found, { x => $x, y => $y, len => $len, directions => show_directions }; + + my $tr = "$tr_x,$tr_y"; + my $bl = "$bl_x,$bl_y"; + + warn ">>> ended at $pos, line length: $len, directions traversed: ",show_directions," tr: $tr bl: $bl\n"; + + if ( ! grep( /\Q$tr\E/, @shapes_start ) && $tr_x < 8 ) { + warn "INFO: added $tr top-right\n"; + push @shapes_start, $tr; } - warn draw( @trace ); + if ( ! grep( /\Q$bl\E/, @shapes_start ) && $bl_y < 8 ) { + warn "INFO: added $bl bottom-left\n"; + push @shapes_start, $bl; + } + + print "WAIT> press enter"; my $foo = ; + return $len; } -warn "ended at $pos\n"; +foreach my $start ( @shapes_start ) { + 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}; +}