(Message perl/qotw/d:1061)
/home/mjd/bin/mailpager 1061
Received: (qmail 25224 invoked by alias); 13 Dec 2002 20:23:35 -0000
Mailing-List: contact perl-qotw-discuss-help@plover.com; run by ezmlm
Precedence: bulk
List-Post: <mailto:perl-qotw-discuss@plover.com>
List-Help: <mailto:perl-qotw-discuss-help@plover.com>
List-Unsubscribe: <mailto:perl-qotw-discuss-unsubscribe@plover.com>
List-Subscribe: <mailto:perl-qotw-discuss-subscribe@plover.com>
List-Digest-Subscribe: <mailto:perl-qotw-discuss-digest-subscribe@plover.com>
List-URL: <URL:http://perl.plover.com/qotw/>
Delivered-To: mailing list perl-qotw-discuss@plover.com
Received: (qmail 25216 invoked from network); 13 Dec 2002 20:23:34 -0000
From: sthoenna@efn.org (Yitzchak Scott-Thoennes)
To: perl-qotw-discuss@plover.com
Subject: [SPOILER] frost simulation -- a fast regex solution
Date: Fri, 13 Dec 2002 11:42:47 -0800
Organization: bs"d
Message-ID: <3gj+9gzkgePX092yn@efn.org>
Lines: 172

My design goal was to create a graphics display solution using no
loops but tr///, s///g and while(//g).  Surprisingly enough, it seems
to go pretty fast (completes a 100x100/20% grid in 4.5min)!  Since I
know nothing about Tk, Tk code is adapted from kennedy2.pl (thanks!)
including something wrong with the ticks label that causes a warning.
 
The distinction between old and new ice I added in to speed up later
low-vapor iterations, since ice doesn't need to be drawn every tick
and the great majority of time is spent in createRectangle.
 
The code that built the tr/// statement is:
sub packit { sprintf "\\x%02x", $_[0] << 6 | $_[1] << 4 | $_[2] << 2 | $_[3] }
%age = (0 => 0, 1 => 3, 2 => 2, 3 => 2);
for $i (0..3) {
for $j (0..3) {
for $k (0..3) {
for $l (0..3) {
    $was = packit($i, $j, $k, $l);
    if (grep $_>=2, $i, $j, $k, $l) {
	$now = packit(map $age{$_}, $i, $j, $k, $l);
	if ($now ne $was) {
	    $fr .= $was;
	    $to .= $now;
	}
    }
}}}}
# add the vapor-only ones that don't need rotation
$fr .= packit(0,1,1,0).packit(1,0,0,1).packit(1,1,1,1);
$to .= packit(1,0,0,1).packit(0,1,1,0).packit(1,1,1,1);
print "tr[$fr]\n  [$to]\n";
__END__
 
Without further ado:
 
use warnings;
use strict;
use Tk;
 
use constant BG => "#000044";
use constant ICE => "#EEEEEE";
use constant VAPOR => "#99CCCC";
 
our $height = (shift || 100)&~1;
our $width = (shift || 100)&~1;
our $vapor = (shift || 20)/100;
srand($ENV{SRAND}) if exists $ENV{SRAND};
our $zoom = 5;
 
our $x = $width / 2;
our $y = $height / 2;
our $area = $height * $width;
our $gridsize = $x * $y;
our $nextrow = qr/(.{$x})/s;
our $lastrow = qr/(.{$x}\z)/s;
our $evenrows = "\xf0" x $x;
our $oddrows = "\x0f" x $x;
our $evencols = "\xcc" x $x;
our $oddcols = "\x33" x $x;
 
# every byte in the grid represents a neighborhood, 2 bits per cell
# (00 = empty, 01 = vapor, 10 = old ice, 11 = new ice)
 
# In the initial grid, the high nibble of each byte is the upper row
# and the high bits of each nibble are the lefter cell
# In the shifted grid used on odd ticks, each cell is in the same
# position within a byte as it was in the initial grid
# (see shift_neighborhoods and unshift_neighborhoods).
 
# put some vapor in
($_ = "\0"x$gridsize) =~ s/./
    chr( (rand()<$vapor) << 6 | (rand()<$vapor) << 4 |
	 (rand()<$vapor) << 2 | (rand()<$vapor) )
/ge;
# and an ice crystal
substr($_, $width/2*int($height/4)+int($width/4), 1) |= "\xc0";
 
our @rot = (
    { # counter-clockwise
        "\x01"=>"\x10","\x04"=>"\x01","\x05"=>"\x11","\x10"=>"\x40",
        "\x11"=>"\x50","\x15"=>"\x51","\x40"=>"\x04","\x44"=>"\x05",
        "\x45"=>"\x15","\x50"=>"\x44","\x51"=>"\x54","\x54"=>"\x45" },
    { # clockwise
        "\x01"=>"\x04","\x04"=>"\x40","\x05"=>"\x44","\x10"=>"\x01",
        "\x11"=>"\x05","\x15"=>"\x45","\x40"=>"\x10","\x44"=>"\x50",
        "\x45"=>"\x54","\x50"=>"\x11","\x51"=>"\x15","\x54"=>"\x51" });
 
our $tick=0;
#$SIG{ALRM} = sub { warn "TICKS: $tick\n"; exit };
#alarm($ENV{TIMELIMIT} || 120);
 
our $mw = new MainWindow(-title => "Frost Simulation");
our $header = $mw->Label->pack(-fill => 'x');
our $canvas = $mw->Canvas(-width => $width * $zoom - 1,
                         -height => $height * $zoom - 1,
                         -background => BG)->pack;
 
# do a tick, returning count of neighborhoods that changed or had vapor
sub tick {
++$tick;
 
tr[\x03\x06\x07\x09\x0b\x0c\x0d\x0e\x0f\x12\x13\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x21\x23\x24\x25\x26\x27\x29\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x42\x43\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x52\x53\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x81\x83\x84\x85\x86\x87\x89\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa1\xa3\xa4\xa5\xa6\xa7\xa9\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff\x14\x41\x55]
  [\x02\x0e\x0e\x0b\x0a\x08\x0b\x0a\x0a\x32\x32\x3e\x3e\x38\x3b\x3a\x3a\x38\x3b\x3a\x3a\x23\x22\x2c\x2f\x2e\x2e\x2b\x2a\x28\x2b\x2a\x2a\x20\x23\x22\x22\x2c\x2f\x2e\x2e\x28\x2b\x2a\x2a\x28\x2b\x2a\x2a\xc2\xc2\xce\xce\xc8\xcb\xca\xca\xc8\xcb\xca\xca\xf2\xf2\xfe\xfe\xf8\xfb\xfa\xfa\xf8\xfb\xfa\xfa\xe0\xe3\xe2\xe2\xec\xef\xee\xee\xe8\xeb\xea\xea\xe8\xeb\xea\xea\xe0\xe3\xe2\xe2\xec\xef\xee\xee\xe8\xeb\xea\xea\xe8\xeb\xea\xea\x83\x82\x8c\x8f\x8e\x8e\x8b\x8a\x88\x8b\x8a\x8a\xb0\xb3\xb2\xb2\xbc\xbf\xbe\xbe\xb8\xbb\xba\xba\xb8\xbb\xba\xba\xa3\xa2\xac\xaf\xae\xae\xab\xaa\xa8\xab\xaa\xaa\xa0\xa3\xa2\xa2\xac\xaf\xae\xae\xa8\xab\xaa\xaa\xa8\xab\xaa\xaa\x80\x83\x82\x82\x8c\x8f\x8e\x8e\x88\x8b\x8a\x8a\x88\x8b\x8a\x8a\xb0\xb3\xb2\xb2\xbc\xbf\xbe\xbe\xb8\xbb\xba\xba\xb8\xbb\xba\xba\xa0\xa3\xa2\xa2\xac\xaf\xae\xae\xa8\xab\xaa\xaa\xa8\xab\xaa\xaa\xa0\xa3\xa2\xa2\xac\xaf\xae\xae\xa8\xab\xaa\xaa\xa8\xab\xaa\xaa\x41\x14\x55] +
s/([\x01\x04\x05\x10\x11\x15\x40\x44\x45\x50\x51\x54])/$rot[rand(2)]{$1}/seg;
}
 
my %xlat = ("\x00" => "",
	    "\x01" => VAPOR, "\x04" => VAPOR, "\x10" => VAPOR, "\x40" => VAPOR,
	    "\x02" => "", "\x08" => "", "\x20" => "", "\x80" => "",
	    "\x03" => ICE, "\x0c" => ICE, "\x30" => ICE, "\xc0" => ICE);
sub draw {
    $header->configure(-text => "Time index: ".$tick);
    $canvas->delete(VAPOR);
    my $px = 0;
    my $maxpx = $width * $zoom;
    my $py = 0;
    my $fill;
    my $zm1 = $zoom-1;
    my $zz = 2 * $zoom;
    my $zzm1 = $zz - 1;
    while (/(.)/gs) {
	$fill = $xlat{$1&"\xc0"} and
	    $canvas->createRectangle($px, $py, $px+$zm1, $py+$zm1,
				     -fill => $fill, -outline => undef,
				     -tags => $fill);
	$fill = $xlat{$1&"\x30"} and
	    $canvas->createRectangle($px+$zoom, $py, $px+$zzm1, $py+$zm1,
				     -fill => $fill, -outline => undef,
				     -tags => $fill);
	$fill = $xlat{$1&"\x0c"} and
	    $canvas->createRectangle($px, $py+$zoom, $px+$zm1, $py+$zzm1,
				     -fill => $fill, -outline => undef,
				     -tags => $fill);
	$fill = $xlat{$1&"\x03"} and
	    $canvas->createRectangle($px+$zoom, $py+$zoom, $px+$zzm1, $py+$zzm1,
				     -fill => $fill, -outline => undef,
				     -tags => $fill);
	$px = 0, $py += $zz if $maxpx == ($px += $zz);
    }
    $mw->update;
}
 
# prepare for an odd tick
# all odd rows shift down and odd columns shift right
sub shift_neighborhoods {
    my ($prev) = /$lastrow/o;
    s/$nextrow/
	my $comb = $prev & $oddrows | ($prev=$1) & $evenrows;
	$comb & $evencols | (chop($comb).$comb) & $oddcols;
    /geo;
}
 
# restore to even-tick neighborhoods
sub unshift_neighborhoods {
    my ($first) = /$nextrow/o;
    s/$nextrow(?:(?=$nextrow)|)/
	my $comb = $1 & $evenrows | ($2 || $first) & $oddrows;
	$comb & $evencols | (substr($comb,1).substr($comb,0,1)) & $oddcols;
    /geo;
}
 
Loop: {
draw;
tick or last Loop;
draw;
shift_neighborhoods;
unshift_neighborhoods, redo Loop if tick;
}
 
$mw->Button(-text => 'Done',
	    -command => sub { $mw->destroy })->pack;
Tk::MainLoop();
__END__
