Repository List / symmetry-circle / symmetry.pl @ HEAD

#!/usr/bin/perl -w

# symmetry.pl
#
# 08/26/07 02:40:37 CEST Dobrica Pavlinusic <dpavlin@rot13.org>

use strict;

my $board = << '_BOARD_';
+-+-+-+-+-+-+-+-+
| |   |o| |     |
+ +   +-+ +-+   |
|o|   |  o  | o |
+ +   +-+ +-+   |
| |  o  | |     |
+-+-+   +-+-+-+-+
|   |   |o|     |
+-+ +   +-+-+ +-+
| |o|   |o|o|o|o|
+ + +-+-+-+-+ +-+
|o|   |   |     |
+ +-+-+-+-+-+-+-+
| |      o      |
+-+-+-+-+-+-+-+-+
|    o    |  o  |
+-+-+-+-+-+-+-+-+
_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 $o = 0;
	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 .= " $l ";
		$out .= join('', @trace[ $o .. $o + $ll - 1 ]);
		$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 {
	$pos += $move_by[ $step ];
	trace;
	$pos += $move_by[ $step ];
	trace;
	push @directions, $step;
	warn "move $step $step_name[$step] to ", x_y, "\n";
}

sub follow {
	$step = shift;
	$step %= 4;
	warn "follow $step $step_name[$step]\n";
}

my $ok_path = qr/[\|\-]/;

my @corners;
my $corners_usage;

sub can_turn {
	my $try_step = shift;
	die "no step?" unless defined $try_step;

	$try_step %= 4;

	my $turn_pos = $pos + $move_by[$try_step];

	my $old = $trace[ $turn_pos ];
	$trace[ $turn_pos ] = '?';
	$trace[ $pos ] = '*';
	warn "TEST ", x_y($turn_pos), "\n",draw;
	$trace[ $turn_pos ] = $old;

	if ( $board[ $turn_pos ] =~ $ok_path ) {
		my $xy = x_y($pos);
		warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos]) from $xy\n";
		$step = $try_step;
		push @corners, $xy;
		$corners_usage->{$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])\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;

	@trace = ($unknown) x ( $#board + 1 );
	@directions = ();
	@corners = ();
	trace;

	my $len = 0;
	$step = 0;

	my $usage = $corners_usage->{"$x,$y"} || 0;

	warn "<<< shape from $x,$y [usage: $usage] pos: $pos\n";

	if ( $usage > 4 ) {
		warn "SKIPPED, usage > 4\n";
		return 0;
	}

	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;

		if ( $debug ) {
			print "WAIT> press enter | ",show_directions; my $foo = <STDIN>;
		}
	}

	push @shapes_found, { x => $x, y => $y, len => $len, directions => show_directions };

	warn "### corners: ",join(' ', map { $_ . " [" . $corners_usage->{$_} . "]" } @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 = <STDIN>;

	return $len;
}

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";
	}
}

sub is_symmetric {
	my $path = shift || die "no path?";

	my $h = length($path)/2;
	return 0 if int($h) != $h;
	my ($l,$r) = ( substr($path,0,$h), substr($path,$h) );
	$r =~ tr/lrud/rldu/;
#	warn "$l -- $r\n";
	return 0 unless $l eq $r;
	return 1;
}

print ">>> RESULTS:\n";
foreach my $r ( @shapes_found ) {
	printf "%2d,%-2d len: %-4d directions: %s %s\n",
	$r->{x}, $r->{y}, $r->{len},
	is_symmetric($r->{directions}) ? 'OK' : '!!',
	$r->{directions},
	;
}