/[symmetry-circle]/symmetry.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /symmetry.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1 by dpavlin, Sun Aug 26 02:53:41 2007 UTC revision 4 by dpavlin, Sun Aug 26 10:59:01 2007 UTC
# Line 6  Line 6 
6    
7  use strict;  use strict;
8    
 use Data::Dump qw/dump/;  
   
9  my $board = << '_BOARD_';  my $board = << '_BOARD_';
10  +-+-+-+-+-+-+-+-+  +-+-+-+-+-+-+-+-+
11  | |   |o| |     |  | |   |o| |     |
# Line 28  my $board = << '_BOARD_'; Line 26  my $board = << '_BOARD_';
26  +-+-+-+-+-+-+-+-+  +-+-+-+-+-+-+-+-+
27  _BOARD_  _BOARD_
28    
29    my $debug = shift @ARGV || 0;
30    
31  my @board = map { split(//) } split(/\n/, $board);  my @board = map { split(//) } split(/\n/, $board);
32    my @trace;
33    
34  # line length  # line length
35  my $ll = 8 * 2 + 1;  my $ll = 8 * 2 + 1;
36    
37    my @step_name = ( qw/right down left up/ );
38    my @move_by = ( 1, $ll, -1, -$ll );
39    my $step = 0;   # right
40    
41    # offset 0, top-left corner
42    my $pos = 0;
43    
44    # unknown trace position
45    my $unknown = ' ';
46    
47    # path traversed
48    my @directions;
49    
50    my @found;
51    
52  sub draw {  sub draw {
         my @board = @_;  
53          my $o = 0;          my $o = 0;
54          my $out;          my $out;
55          while ( $o < $#board ) {          while ( $o < $#board ) {
56                  $out .= join('', @board[ $o .. $o + $ll - 1 ]) . "\n";                  $out .= join('', @board[ $o .. $o + $ll - 1 ]);
57                    $out .= '   ';
58                    $out .= join('', @trace[ $o .. $o + $ll - 1 ]);
59                    $out .= "\n";
60                  $o += $ll;                  $o += $ll;
61          }          }
62          return $out;          return $out;
63  }  }
64    
 print $board, draw( @board );  
   
 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;  
 $pos = 2;  
 $pos = 6;  
   
 my @trace = ('x') x ( $#board + 1 );  
65  sub trace {  sub trace {
66          warn "trace $pos\n";          warn "## trace $pos\n";
67          $trace[ $pos ] = $board[ $pos ];          $trace[ $pos ] = $board[ $pos ];
68  }  }
69    
 warn draw( @trace );  
 trace;  
   
70  sub move {  sub move {
71          warn "move $step $step_name[$step]\n";          warn "move $step $step_name[$step]\n";
72          $pos += $move_by[ $step ];          $pos += $move_by[ $step ];
73          trace;          trace;
74          $pos += $move_by[ $step ];          $pos += $move_by[ $step ];
75          trace;          trace;
76          warn draw( @trace );          push @directions, $step;
77  }  }
78    
79  sub follow {  sub follow {
# Line 82  sub follow { Line 85  sub follow {
85  my $ok_path = qr/[\|\-]/;  my $ok_path = qr/[\|\-]/;
86    
87  sub can_turn {  sub can_turn {
88          my $step = shift;          my $try_step = shift;
89          die "no step?" unless defined $step;          die "no step?" unless defined $try_step;
90    
91            $try_step %= 4;
92    
93          my $turn_pos = $pos + $move_by[ $step % 4 ];          my $turn_pos = $pos + $move_by[$try_step];
94    
95          my $old = $trace[ $turn_pos ];          my $old = $trace[ $turn_pos ];
96          $trace[ $turn_pos ] = '?';          $trace[ $turn_pos ] = '?';
# Line 93  sub can_turn { Line 98  sub can_turn {
98          $trace[ $turn_pos ] = $old;          $trace[ $turn_pos ] = $old;
99    
100          if ( $board[ $turn_pos ] =~ $ok_path ) {          if ( $board[ $turn_pos ] =~ $ok_path ) {
101                  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])";
102                    $step = $try_step;
103                  return 1;                  return 1;
104          } else {          } else {
105                  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])";
106                  return 0;                  return 0;
107          }          }
108  }  }
109    
110  while( 1 ) {  sub show_directions {
111            return
112                    join('',
113                            map {
114                                    substr($step_name[$_],0,1)
115                            } @directions
116                    )
117            ;
118    }
119    
120          my $next_pos = $pos + $move_by[ $step ];  sub shape {
         warn "in loop - pos = $pos next_pos = $next_pos step = $step $step_name[$step]\n";  
121    
122          if ( $trace[ $next_pos ] ne 'x' ) {          my ($x,$y) = @_;
123                  warn "position $next_pos re-visited, exiting\n";  
124                  last;          $pos = $y * $ll * 2 + $x * 2;
125          } elsif ( $board[ $next_pos ] =~ $ok_path ) {  
126                  warn "OK next_pos = $next_pos b($board[$next_pos]) t($trace[$next_pos])\n";          warn "<<< shape from $x,$y pos: $pos\n";
127                  move;          @trace = ($unknown) x ( $#board + 1 );
128                  follow( $step+1 ) if can_turn( $step+1 );          @directions = ();
129          } else {          trace;
130                  warn "find line continuation from $step $step_name[$step]...\n";  
131                  foreach my $o ( -1, 1 ) {          my $len = 0;
132                          if ( can_turn( $step + $o ) ) {  
133                                  $step = $step+$o;          while( 1 ) {
134                                  warn "new direction: $step $step_name[$step]\n";  
135                                  follow( $step );                  my $next_pos = $pos + $move_by[ $step ];
136                                  last;                  warn "# pos: $pos next_pos: $next_pos step: $step $step_name[$step] trace: ",show_directions,"\n";
137                          }  
138                    if ( $trace[ $next_pos ] ne $unknown ) {
139                            warn "position $next_pos re-visited, exiting\n";
140                            last;
141                    } elsif ( $board[ $next_pos ] =~ $ok_path ) {
142                            warn "OK next_pos = $next_pos b($board[$next_pos]) t($trace[$next_pos])\n";
143                            move;
144                            $len++;
145                            can_turn( $step + 1 );
146                    } else {
147                            warn "find line continuation from $step $step_name[$step]...\n";
148                            can_turn( $step - 1 ) || can_turn( $step + 1 ) || die "can't find new direction";
149                    }
150                    warn draw( @trace );
151    
152                    if ( $debug ) {
153                            print "WAIT> press enter | ",show_directions; my $foo = <STDIN>;
154                  }                  }
155          }          }
         warn draw( @trace );  
156    
157            push @found, { x => $x, y => $y, len => $len, directions => show_directions };
158    
159            warn ">>> ended at $pos, line length: $len, directions traversed: ",show_directions,"\n";
160            print "WAIT> press enter"; my $foo = <STDIN>;
161    
162            return $len;
163  }  }
164    
165  warn "ended at $pos\n";  my $shapes = '0,0 1,0 0,3';
166    
167    foreach my $start ( split(/\s/,$shapes) ) {
168            my $len = shape( split(/,/,$start) );
169            warn "## $start has $len elements\n";
170    }
171    
172    print ">>> RESULTS:\n";
173    foreach my $r ( @found ) {
174            printf "%2d,%-2d len: %-4d directions: %s\n", $r->{x}, $r->{y}, $r->{len}, $r->{directions};
175    }

Legend:
Removed from v.1  
changed lines
  Added in v.4

  ViewVC Help
Powered by ViewVC 1.1.26