My first perl code was around 1995-1996, and it wasn't until 2001 that . My early code falls squarely into the catagory of:
, just how bad my code was, and began the journey to learn to write better perl (and one day, I hope I will get there).
One of my early (UGLY) pieces of code was an attempt to simulate a chain reaction in a grid. It is currently my "white whale" code that I periodically pull out, try to update or rewrite, fail, and put away until another day. (It actually was the inspiration for my
.) In all its gore (it is almost Halloween/Samhain, after all), here it is (as soon as I find my asbestos underwear...):
I CANNOT STRESS THIS ENOUGH: This is a terrible example of code. Do NOT attempt to emulate. Bad practices abound (lack of 'use strict' and 'use warnings' are just the start). Do NOT use for production code.
#!/usr/bin/perl
# ###
# ### ---- 2019-10-26: CODE FOR DEMONSTRATION ONLY
# ### ---- 2019-10-26: BAD PRACTICES ABOUND (lacks 'use strict' and
# ### 'use warnings', just to start!)
# ### ---- 2019-10-26: DO NOT USE FOR PRODUCTION CODE
# ###
#
# Please note:
# 1) This program and its author make no
# guarantees or warranties regarding this
# program, its usability, etc.-it was written
# by the author, for the author, for fun.
# 2) This program can be EXTREMELY memory and
# processor intensive, because of the number
# of items it may be processing.
# Consider yourselves warned.
#
use Tk;
use vars qw(%controllist);
$program_title = "Fission simulation";
$program_version = "v.0.1.1";
$blockcount = "";
$gencount = "";
&update_header;
$mirror = 1; # neutrons reflectable? (1 = yes)
$mirrorpercent = 10; # percentage reflected (max is 100%)
$repeattime = 15000; # repeat processing of neutrons (ms)
$dx = 4; # spacing of atoms in grid (do not set below 3)
$dy = 4; #
$a_dx =
( $dx - 1 ); # size of drawn atoms (0..$a_dx, 0..$a_dy)
$a_dy = ( $dy - 1 ); #
$maxx = 320; # size of grid
$maxy = 240; #
$maxndx = 10; # abs max speed of neutron (integer)
$maxndy = 10; #
$maxneutron = 3; # max neutron per release
$pathflag = 0; # draw neutron paths?
$generation = 0; # generation count, program maintained
$initial_atoms = 0; # atom count, program maintained
$maxnc = 0; # max neutron count, program maintained
$running = 0; # is simulation running?
$initialfissions = 1; # number of atoms to fission initially
srand();
# draw control window
my $mw = MainWindow->new();
$mw->title( $program_title . ' '
. $program_version . ' '
. '(Control)' );
my $row = 1;
$mw->Label( -textvariable => \$blockcount )
->grid( -row => $row++, -column => 1, -columnspan => 3 );
# $mw->Label( -textvariable => \$gencount )->grid( -row => $row++, -
+column => 1, -columnspan => 3 );
$controllist{'graphicx'} = $mw->Scale(
-from => 160,
-to => 1280,
-orient => 'horizontal',
-resolution => 20,
-label => 'Max X:',
-variable => \$maxx
)->grid( -row => $row, -column => 1, -columnspan => 1 );
$controllist{'graphicy'} = $mw->Scale(
-from => 120,
-to => 1020,
-orient => 'horizontal',
-resolution => 20,
-label => 'Max Y:',
-variable => \$maxy
)->grid( -row => $row, -column => 2, -columnspan => 1 );
$controllist{'initialfissions'} = $mw->Scale(
-from => 1,
-to => 15,
-orient => 'horizontal',
-label => 'Initial fissions:',
-variable => \$initialfissions
)->grid( -row => $row, -column => 3 );
$controllist{'initialfissions'}->set($initialfissions);
$row++;
$controllist{'spacingx'} = $mw->Scale(
-from => 3,
-to => 10,
-orient => 'horizontal',
-label => 'Spacing X:',
-variable => \$dx,
-command => sub {
$controllist{'drawnx'}
->configure( -to => ( $dx - 1 ) );
}
)->grid( -row => $row, -column => 1, -columnspan => 1 );
$controllist{'spacingy'} = $mw->Scale(
-from => 3,
-to => 10,
-orient => 'horizontal',
-label => 'Spacing Y:',
-variable => \$dy,
-command => sub {
$controllist{'drawny'}
->configure( -to => ( $dy - 1 ) );
}
)->grid( -row => $row, -column => 2, -columnspan => 1 );
$controllist{'neutronreflectivity'} = $mw->Scale(
-from => 0,
-to => 100,
-orient => 'horizontal',
-resolution => 1,
-label => 'Mirror effic.(%):',
-variable => \$mirrorpercent
)->grid( -row => $row, -column => 3, -columnspan => 1 );
$row++;
$controllist{'neutronx'} = $mw->Scale(
-from => 1,
-to => 20,
-orient => 'horizontal',
-resolution => 0.5,
-label => 'Max nX:',
-variable => \$maxndx
)->grid( -row => $row, -column => 1, -columnspan => 1 );
$controllist{'neutrony'} = $mw->Scale(
-from => 1,
-to => 20,
-orient => 'horizontal',
-resolution => 0.5,
-label => 'Max nY:',
-variable => \$maxndy
)->grid( -row => $row, -column => 2, -columnspan => 1 );
$controllist{'multiplicationfactor'} = $mw->Scale(
-from => 0,
-to => 5,
-orient => 'horizontal',
-resolution => 0.1,
-label => 'Neutrons per fission:',
-variable => \$maxneutron
)->grid( -row => $row, -column => 3 );
$controllist{'multiplicationfactor'}->set($maxneutron);
$row++;
$controllist{'drawnx'} = $mw->Scale(
-from => 2,
-to => ( $dx - 1 ),
-orient => 'horizontal',
-label => 'Drawn X:',
-variable => \$a_dx
)->grid( -row => $row, -column => 1, -columnspan => 1 );
$controllist{'drawny'} = $mw->Scale(
-from => 2,
-to => ( $dy - 1 ),
-orient => 'horizontal',
-label => 'Drawn Y:',
-variable => \$a_dy
)->grid( -row => $row, -column => 2, -columnspan => 1 );
$controllist{'repeattime'} = $mw->Scale(
-from => 5000,
-to => 30000,
-orient => 'horizontal',
-resolution => 500,
-label => 'Repeat time,ms:',
-command => \&adjusttime
)->grid( -row => $row, -column => 3 );
$controllist{'repeattime'}->set($repeattime);
$row++;
$controllist{'initiate'} = $mw->Button(
-text => 'Initiate',
-background => '#ff3333',
-command => sub { $running++; &start_simulation; }
)->grid( -row => $row, -column => 2 );
$mw->Checkbutton(
-text => 'Mirror',
-variable => \$mirror,
-command => sub { &update_header; }
)->grid( -row => $row, -column => 1 );
$mw->Checkbutton(
-text => 'Paths',
-variable => \$pathflag,
-command => sub { &update_header; }
)->grid( -row => $row, -column => 3 );
$row++;
$mw->Button(
-text => 'Done',
-background => '#6666ff',
-command => \&dump_header
)->grid( -row => $row, -column => 2 );
MainLoop;
#
# Subroutines
#
sub start_simulation {
# draw graphic window
my $mw2 = MainWindow->new();
$mw2->title( $program_title . ' '
. $program_version . ' '
. '(Graphic)' );
$mw->Scale->set($repeattime);
$canvas = $mw2->Canvas(
-width => $maxx + 1,
-height => $maxy + 1,
-background => 'black'
)->pack();
foreach my $i (
qw(graphicx graphicy initiate neutronx neutrony neutronreflect
+ivity spacingx spacingy drawnx drawny initialfissions)
)
{
$controllist{$i}->configure( -relief => 'sunken' );
$controllist{$i}->configure( -state => 'disabled' );
}
# initiate reaction
&first_change;
# set up process to repeat to handle neutron queue
$id = $canvas->repeat( $repeattime, \&process_neutron );
}
sub adjusttime {
$oldrepeattime = $repeattime;
$repeattime = $controllist{'repeattime'}->get();
# print( "##### Repeat time changed at ", scalar( localtime() ), " fro
+m $oldrepeattime ms to $repeattime ms.\n" );
&update_header;
if ( defined($id) ) {
$id->cancel();
$id =
$canvas->repeat( $repeattime, \&process_neutron );
}
}
# Dump results, clean up a little, and exit
sub dump_header {
$blockcount =
sprintf(
"Generation: %4d Nuclei: %8d/%8d Neutrons: %8d/%8d",
$generation, $bc, $initial_atoms, $nc, $maxnc );
$gencount =
sprintf( "Repeat time: %6d ms Mirror: %1d Path: %1d",
$repeattime, $mirror, $pathflag );
print( $blockcount, "\n", $gencount, "\n\n" );
for ( my $a = ( $maxx - 1 ) ; $a >= 0 ; $a-- ) {
for ( my $b = ( $maxy - 1 ) ; $b >= 0 ; $b-- ) {
delete( $nuclei_array[$a][$b] );
}
}
if ($running) { sleep(10); }
exit(0);
}
# Update information on control panel
sub update_header {
$blockcount =
sprintf(
"Generation: %04d Nuclei: %08d/%08d Neutrons: %08d/%08d",
$generation, $bc, $initial_atoms, $nc, $maxnc );
# $gencount = sprintf( "Repeat time: %06d ms Mirror: %1d Path: %1d", $
+repeattime, $mirror, $pathflag );
# print($blockcount, "\n");
}
# Get number of neutrons to release from fission
sub neutrons_to_release {
return ( rand() * $maxneutron );
}
# Handle initial fission in array
sub first_change {
$generation++;
my $amax = 0;
while ( ( $amax + $dx ) < $maxx ) { $amax += $dx; }
my $bmax = 0;
while ( ( $bmax + $dy ) < $maxy ) { $bmax += $dy; }
for ( $a = $amax ; $a >= 0 ; $a -= $dx ) {
for ( $b = $bmax ; $b >= 0 ; $b -= $dy ) {
&add_atom( $a, $b );
} # end for $b
} # end for $a
$initial_atoms = $bc;
foreach ( 1 .. $initialfissions ) {
$i = int( rand( $maxx / $dx ) ) * $dx;
$j = int( rand( $maxy / $dy ) ) * $dy;
$torelease = &neutrons_to_release();
for ( $a = 0 ; $a < $torelease ; $a++ ) {
push( @flux, &get_neutron( $i, $j ) );
} # end for $a
&remove_atom( $i, $j );
&update_header;
}
}
# Draw atoms
sub drawmyrect {
local ( $i, $j, $color ) = @_;
$canvas->createRectangle( $i, $j, $i + $a_dx,
$j + $a_dy, -fill => $color );
}
# Draw neutron path
sub drawmypath {
local ( $x, $y, $dx, $dy ) = @_;
$da = $x + $dx;
$da = 1 if ( $da < 0 );
$da = ( $maxx - 1 ) if ( $da > $maxx );
$db = $y + $dy;
$db = 1 if ( $db < 0 );
$db = ( $maxy - 1 ) if ( $db > $maxy );
$canvas->createLine( $x, $y, $da, $db,
-fill => 'yellow' );
}
#
# Neutrons are handled in the queue as strings,
# consisting of the form Xd+Yd+Ud+Vd+,
# where d+ indicates a number (positive or negative),
# and
# Xddd indicates the x position in the grid
# Yddd indicates the y position in the grid
# Uddd indicates the x speed of the neutron
# Vddd indicates the y speed of the neutron
#
# Convert neutron speed to list of 4 values
sub n_s2c {
local ($mystring) = @_;
my $a, $b, $c, $d, @e;
$mystring =~ s/(\w[+\-]?\d+)/$1:/g;
( $a, $b, $c, $d, @e ) = split( ':', $mystring );
$a =~ s/X//;
$b =~ s/Y//;
$c =~ s/U//;
$d =~ s/V//;
return ( $a, $b, $c, $d );
}
# Convert list of 4 values to neutron string
sub n_c2s {
local ( $a, $b, $c, $d ) = @_;
my $e = sprintf( "X%dY%dU%dV%d", $a, $b, $c, $d );
return ($e);
}
# Handle movement of neutron
sub move_neutron {
local ($mystring) = @_;
my $a, $b, $c, $d, @e;
( $a, $b, $c, $d ) = &n_s2c($mystring);
$a += $c;
$b += $d;
$mystring = &n_c2s( $a, $b, $c, $d );
return ($mystring);
}
# Check if neutron remains in grid, is reflected,
# or escapes
sub neutron_in_bounds {
local (*mystring) = @_;
my $a, $b, $c, $d, $isin;
( $a, $b, $c, $d ) = &n_s2c($mystring);
$isin = (&get_neutron_inside_axis( $a, $maxx )
&& &get_neutron_inside_axis( $b, $maxy ) );
if ( ( !($isin) ) && ($mirror) ) {
if ( int( rand() * 100 ) < $mirrorpercent ) {
$mystring =
&n_c2s( $a, $b, ( 0 - $c ), ( 0 - $d ) );
$mystring = &move_neutron($mystring);
$isin = !($isin);
print "+-neutron reflected\n";
}
}
return ($isin);
}
# Process the neutron queue
sub process_neutron {
my @processed = ();
$generation++;
print( scalar( localtime() ), "\n" );
while ( $current = shift(@flux) ) {
(
$neutron_x, $neutron_y, $neutron_dx,
$neutron_dy, @junk
) = &n_s2c($current);
&drawmypath(
$neutron_x, $neutron_y,
$neutron_dx, $neutron_dy
) if ($pathflag);
$current = &move_neutron($current);
( $neutron_x, $neutron_y, $neutron_dx, $neutron_dy )
= &n_s2c($current);
if ( &neutron_in_bounds( \$current ) ) {
if ( $nuclei_array[$neutron_x][$neutron_y] ) {
$torelease = &neutrons_to_release();
$nc--;
for ( $a = 0 ; $a < $torelease ; $a++ ) {
push(
@processed,
&get_neutron(
$neutron_x, $neutron_y
)
);
} # end for $a
&remove_atom( $neutron_x, $neutron_y );
print "\t\treleased: ", int($torelease),
"\n";
}
else {
push( @processed, $current );
} # end if $nuclei_array
}
else {
$nc--;
print "--neutron escaped\n";
&update_header;
} # end if get_neutron_inside_axis
} # end while $neutron
foreach $current (@processed) {
push( @flux, $current );
}
&update_header;
&dump_header() if ( ( $nc <= 0 ) or ( $bc <= 0 ) );
}
# Check that a value is within its bounds
sub get_neutron_inside_axis {
local ( $v, $maxv ) = @_;
return ( abs( $v - ( $maxv / 2 ) ) <= ( $maxv / 2 ) );
}
# Get x speed for a new neutron
sub get_neutron_dx {
return (
int( ( rand() * $maxndx ) - ( $maxndx / 2 ) ) );
}
# Get y speed for a new neutron
sub get_neutron_dy {
return (
int( ( rand() * $maxndy ) - ( $maxndy / 2 ) ) );
}
# Create values for a new neutron
sub get_neutron {
local ( $x, $y ) = @_;
$n_dx = 0;
$n_dy = 0;
while ( ( $n_dx == 0 ) and ( $n_dy == 0 ) ) {
$n_dx = &get_neutron_dx;
$n_dy = &get_neutron_dy;
}
$node = &n_c2s( $x, $y, $n_dx, $n_dy );
$nc++;
$maxnc++;
&update_header;
printf( "\tnew neutron (#%d)- {%s}\n", $nc, $node );
return ($node);
}
# Change status and appearance of atom
sub change_atom {
local ( $i, $j, $value ) = @_;
if ( $value == 1 ) { $color = 'red'; $bc++; }
else { $color = 'blue'; $bc--; }
$nuclei_array[$i][$j] = $value;
&update_header;
# foreach my $c ( '00', '33', '66', '99', 'cc', 'ff' ) {
# foreach my $d ( '00', '33', '66', '99', 'cc', 'ff' ) {
# foreach my $e ( '00', '33', '66', '99', 'cc', 'ff' ) {
# &drawmyrect( $i, $j, '#' . $c . $d . $e );
# }
# }
# }
# select( undef, undef, undef, 0.1 );
&drawmyrect( $i, $j, $color );
}
# Set atom to existing
sub add_atom {
local ( $i, $j ) = @_;
&change_atom( $i, $j, 1 );
$bc++;
}
# Set atom to no longer exist
sub remove_atom {
local ( $i, $j ) = @_;
printf( "\tatom %d, %d removed\n", $i, $j );
&change_atom( $i, $j, 0 );
$bc--;
}