/[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

Contents of /symmetry.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5 - (show annotations)
Sun Aug 26 12:17:00 2007 UTC (11 years, 8 months ago) by dpavlin
File MIME type: text/plain
File size: 4141 byte(s)
- iterate over shapes by top-right corner
- more meaningful variable names
1 #!/usr/bin/perl -w
2
3 # symmetry.pl
4 #
5 # 08/26/07 02:40:37 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6
7 use strict;
8
9 my $board = << '_BOARD_';
10 +-+-+-+-+-+-+-+-+
11 | | |o| | |
12 + + +-+ +-+ |
13 |o| | o | o |
14 + + +-+ +-+ |
15 | | o | | |
16 +-+-+ +-+-+-+-+
17 | | |o| |
18 +-+ + +-+-+ +-+
19 | |o| |o|o|o|o|
20 + + +-+-+-+-+ +-+
21 |o| | | |
22 + +-+-+-+-+-+-+-+
23 | | o |
24 +-+-+-+-+-+-+-+-+
25 | o | o |
26 +-+-+-+-+-+-+-+-+
27 _BOARD_
28
29 my $debug = shift @ARGV || 0;
30
31 my @board = map { split(//) } split(/\n/, $board);
32 my @trace;
33
34 # line length
35 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 @shapes_found;
51
52 my @shapes_start = ( '0,0' ); #( qw/0,0 1,0 0,3/ );
53
54 sub draw {
55 my $o = 0;
56 my $out;
57 while ( $o < $#board ) {
58 $out .= join('', @board[ $o .. $o + $ll - 1 ]);
59 $out .= ' ';
60 $out .= join('', @trace[ $o .. $o + $ll - 1 ]);
61 $out .= "\n";
62 $o += $ll;
63 }
64 return $out;
65 }
66
67 sub trace {
68 warn "## trace $pos\n";
69 $trace[ $pos ] = $board[ $pos ];
70 }
71
72 my ( $tr_x, $tr_y );
73
74 sub pos_x_y {
75 my $y = int($pos / ($ll*2));
76 my $x = int(($pos % $ll) / 2);
77
78 $tr_x = $x unless defined $tr_x;
79 $tr_y = $y unless defined $tr_y;
80
81 $tr_x = $x if $x > $tr_x && $y == $tr_y;
82 $tr_y = $y if $y < $tr_y && $x == $tr_x;
83
84 warn "## pos_x_y $pos -> $x,$y\n";
85
86 return ($x,$y) if wantarray;
87 return "$x,$y";
88 }
89
90 sub move {
91 $pos += $move_by[ $step ];
92 trace;
93 $pos += $move_by[ $step ];
94 trace;
95 push @directions, $step;
96 warn "move $step $step_name[$step] to ", scalar pos_x_y, "\n";
97 }
98
99 sub follow {
100 $step = shift;
101 $step %= 4;
102 warn "follow $step $step_name[$step]\n";
103 }
104
105 my $ok_path = qr/[\|\-]/;
106
107 sub can_turn {
108 my $try_step = shift;
109 die "no step?" unless defined $try_step;
110
111 $try_step %= 4;
112
113 my $turn_pos = $pos + $move_by[$try_step];
114
115 my $old = $trace[ $turn_pos ];
116 $trace[ $turn_pos ] = '?';
117 warn "TEST\n",draw( @trace );
118 $trace[ $turn_pos ] = $old;
119
120 if ( $board[ $turn_pos ] =~ $ok_path ) {
121 warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])\n";
122 $step = $try_step;
123 return 1;
124 } else {
125 warn "NOPE can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])\n";
126 return 0;
127 }
128 }
129
130 sub show_directions {
131 return
132 join('',
133 map {
134 substr($step_name[$_],0,1)
135 } @directions
136 )
137 ;
138 }
139
140 sub shape {
141
142 my ($x,$y) = @_;
143
144 $pos = $y * $ll * 2 + $x * 2;
145
146 warn "<<< shape from $x,$y pos: $pos\n";
147 @trace = ($unknown) x ( $#board + 1 );
148 @directions = ();
149 trace;
150
151 my $len = 0;
152
153 while( 1 ) {
154
155 my $next_pos = $pos + $move_by[ $step ];
156 warn "# pos: $pos next_pos: $next_pos step: $step $step_name[$step] trace: ",show_directions,"\n";
157
158 if ( $trace[ $next_pos ] ne $unknown ) {
159 warn "position $next_pos re-visited, exiting\n";
160 last;
161 } elsif ( $board[ $next_pos ] =~ $ok_path ) {
162 warn "OK next_pos = $next_pos b($board[$next_pos]) t($trace[$next_pos])\n";
163 move;
164 $len++;
165 can_turn( $step + 1 );
166 } else {
167 warn "find line continuation from $step $step_name[$step]...\n";
168 can_turn( $step - 1 ) || can_turn( $step + 1 ) || die "can't find new direction";
169 }
170 warn draw( @trace );
171
172 if ( $debug ) {
173 warn "## tr: $tr_x,$tr_y\n";
174 print "WAIT> press enter | ",show_directions; my $foo = <STDIN>;
175 }
176 }
177
178 push @shapes_found, { x => $x, y => $y, len => $len, directions => show_directions };
179
180 warn ">>> ended at $pos, line length: $len, directions traversed: ",show_directions,"\n";
181
182 my $tr = "$tr_x,$tr_y";
183 if ( ! grep( /\Q$tr\E/, @shapes_start ) && $tr_x < 8 ) {
184 print "INFO: added top-right $tr\n";
185 push @shapes_start, $tr;
186 }
187
188 print "WAIT> press enter"; my $foo = <STDIN>;
189
190 return $len;
191 }
192
193 foreach my $start ( @shapes_start ) {
194 my $len = shape( split(/,/,$start) );
195 warn "## $start has $len elements\n";
196 }
197
198 print ">>> RESULTS:\n";
199 foreach my $r ( @shapes_found ) {
200 printf "%2d,%-2d len: %-4d directions: %s\n", $r->{x}, $r->{y}, $r->{len}, $r->{directions};
201 }

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26