Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
This is actually kinda gross and buggy, in more ways than one.
#!/usr/bin/perl -w # # # This program attempts to model the process of an ongoing head lice # infestation. # It attempts to answer the question: # "How many lice will there be in X days of infection if left untreate +d?" # # Written by Jason Butler, a father that was really creeped out by his # childrens unfortunate (but quickly erradicated) head lice infestatio +n. use strict; #use lib "/home/jbutler/scripts/lice"; # Using an object was not as fast as using a hash variable for spawnin +g # and looping through each louse (object). #use lice_obj_pkg; use Data::Dumper; # Change this number to how many days you want iterate the infection t +hrough. my $daysofinfection = 365; my $debug = 0; my %louse; sub createlice { my $rlouse = shift; #ref to %louse my $parent = shift; #parent louse my $n = keys %$rlouse; #if first louse then make it a female adult in prime egg layin +g status if ($n == 0) { print "CREATED FIRST LOUSE, SOURCE OF INFECTION\n" if +($debug > 0); $rlouse->{$n}->{'agedays'} = 14; $rlouse->{$n}->{'deathday'} = 32; $rlouse->{$n}->{'agetolay'} = 14; $rlouse->{$n}->{'sex'} = "female"; #else, create a louse with random, yet realistic properties } else { my $dayofdeath=death_day(); my $layday=maturity(); my $gender=gender(); print "CREATED ADDITIONAL LOUSE FROM louse number $par +ent\n" if ($debug > 0); $rlouse->{$n}->{'agedays'} = 0; $rlouse->{$n}->{'deathday'} = $dayofdeath; $rlouse->{$n}->{'agetolay'} = $layday; $rlouse->{$n}->{'sex'} = "$gender"; } } sub death_day { my $min; my $max; my $dayofdeath; #minimum days to live is between 15 and 25 days $min = int(rand(10)) + 15; #maximum days to live is between 0 and 25 days $max = int(rand(25)); #days to live = between 15 and 50 days. $dayofdeath = int(rand($max)) + $min; #print "DEBUG: day of death for louse will be on day $dayofdea +th\n"; return $dayofdeath; } sub maturity { my $maturity; #minimum days before able to lay eggs is between 13 and 16 day +s $maturity = int(rand(14)) + 6; return $maturity; } sub gender { my $gender; # 50/50 chance, male or female, is that accurate? Don't know. if (int(rand(2)) == 1) { $gender = "female"; } else { $gender = "male"; } return $gender; } sub laid { my $eggs; # Lay between 1 and 7 eggs per day. $eggs = int(rand(300)) + 1; return $eggs; } my @louse; my $userinput; my $bugs = 0; my $n = 0; my $daystolive = 0; my $age = 0; my $agelay = 0; my $deathtoll = 0; my $living = 0; my $laythismany = 0; my $eggslaid = 0; my $gender = ""; my $females = 0; my $males = 0; my $egglayers = 0; my $eggslaidtoday = 0; my $toddlers = 0; my $eggsacks = 0; my $start; my $end; for (my $days=1; $days != 0; $days++) { $n = keys %louse; $start = time; #create another louse if criteria are met #iterate through each bug to handle any needed reproduction an +d update their attributes while ($bugs <= ($n-1)) { #print "DEBUG: BUGS: $bugs\n"; $daystolive = $louse{$bugs}{'deathday'}; $age = $louse{$bugs}{'agedays'}; $age++; $louse{$bugs}{'agedays'} = $age; $age = $louse{$bugs}{'agedays'}; if ($age >= $daystolive) { $bugs++; $deathtoll++; next; } $gender = $louse{$bugs}{'sex'}; if ($gender eq "male") { $males++; print "DEBUG: Gender: $gender\n" if ($debug > +0); } else { $females++; print "DEBUG: Gender: $gender\n" if ($debug > +0); } $agelay = $louse{$bugs}{'agetolay'}; if ( ($age >= $agelay) && ($gender eq "female") ) { $egglayers++; $eggslaid = 0; $laythismany = laid(); while ($eggslaid < $laythismany) { createlice(\%louse,$bugs); $eggslaid++; $eggslaidtoday++; } } elsif ( $age <= ($agelay/2) ) { $eggsacks++; } else { $toddlers++; } $bugs++; print "DEBUG: Louse " . ($bugs+1) . " will die on day +$daystolive of its life.\n" if ($debug > 0); print "DEBUG: Louse " . ($bugs+1) . " is now $age days + old\n" if ($debug > 0); } $bugs = 0; $userinput = " "; $n = keys %louse; $living = $n - $deathtoll; print "\033[2J"; print "This data is based on the following propertie +s and assumptions:\n"; print "1) The average lifespan of a louse is betwee +n 25 and 50 days\n"; print "2) The male to female ratio is roughly 50/50 +\n"; print "3) The amount of time needed to grow from an + egg into a fertile adult is between 14 - 20 days\n"; print "4) Fertile (adult) females lay between 3 and + 7 eggs per day.\n"; print "5) Each egg takes between 7 to 10 days to ha +tch\n"; print "6) Each nymph (hatched but not an adult) tak +es between 7 to 10 days to mature into an adult\n"; print "7) This infection scenario was started by an + adult, pregnant, female 14 days old with a lifespan of 32 days\n"; print "8) I have found no documentation about how l +arge an infestation of a single head can grow to. This simulation al +so has no limits although I am sure there must be limiting factors.\n +\n\n"; print "================\n"; print "DAY: $days\n"; print "================\n"; print "LICE: $n\n"; print "LIVE LICE: $living\n"; print "DEAD LICE: $deathtoll\n"; print "FEMALES: $females\n"; print "MALES: $males\n"; print "EGG LAYERS (FEMALE ADULTS): $egglayers\n"; print "NYMPHS (LITTLE/YOUNG): $toddlers\n"; print "EGGS: $eggsacks\n"; print "EGGS LAID TODAY: $eggslaidtoday\n"; print "================\n"; $end = time - $start; print "RUNTIME: $end\n"; $egglayers = 0; $females = 0; $males = 0; $eggslaidtoday = 0; $toddlers = 0; $eggsacks = 0; #while ($userinput ne '') { # $userinput = <STDIN>; # chomp ($userinput); #} # create first louse; infection source. if ($n == 0) { $females++; createlice(\%louse,$n); } if ($days == $daysofinfection) { last; } }

In reply to Simulate a head lice infection by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (7)
As of 2024-03-28 10:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found