Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Re: What does your old Perl code look like?

by atcroft (Abbot)
on Oct 26, 2019 at 19:50 UTC ( #11107993=note: print w/replies, xml ) Need Help??


in reply to What does your old Perl code look like?

My first perl code was around 1995-1996, and it wasn't until 2001 that . My early code falls squarely into the catagory of:

UGLY AS SIN

It wasn't until 2001 that I found the Monastery, 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 first post in SoPW.) 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--; }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://11107993]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2020-10-01 17:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (16 votes). Check out past polls.

    Notices?