Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Simulate a head lice infection

by Anonymous Monk
on Jan 22, 2009 at 02:03 UTC ( #738017=CUFP: 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; } }

Replies are listed 'Best First'.
Re: Simulate a head lice infection
by grinder (Bishop) on Jan 22, 2009 at 09:38 UTC

    Looking at the following part of the code:

    $min = int(rand(10)) + 15; $max = int(rand(25)); $dayofdeath = int(rand($max)) + $min;

    You're first establishing a random maximum, and then taking a random value between zero and that first random number. This skews the day of death to lower values. I pulled this out and iterated it 2000 times and found the following number of deaths per day, starting from day 15:

    44 53 66 106 116 127 128 134 145 173 133 104 90 76 67 69 55 56 50 41 30 26 21 29 24 8 13 8 5 1 2 1

    This may be construed as a feature :)

    The following block (and similar blocks):

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

    ... can be written less noisily using a heredoc:

    print <<END_OF_REPORT; DAY: $days ================ LICE: $n LIVE LICE: $living DEAD LICE: $deathtoll FEMALES: $females MALES: $males EGG LAYERS (FEMALE ADULTS): $egglayers NYMPHS (LITTLE/YOUNG): $toddlers EGGS: $eggsacks EGGS LAID TODAY: $eggslaidtoday ================ END_OF_REPORT

    Off topic information on lice removal below the fold:

    • another intruder with the mooring in the heart of the Perl

      Grinder,

      Thanks for the suggestions. I cleaned up some errors in the random functions and incorporated your suggestions. What I would really like is a clever way of getting this to actually complete 365 days of simulated growth without consuming all physical memory and swap space, and without taking 365 days to complete.

      Thanks for the side note on real life treatment also. Hopefully I will never have the misfortune of another opportunity to test treatment methods.


      Updated code:
      #!/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(11)) + 15; #maximum days to live is between 0 and 25 days $max = int(rand(26)); #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 14 and 20 day +s $maturity = int(rand(7)) + 14; 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(8)) + 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; $end = time - $start; print "\033[2J"; print <<UNTIL_END_REPORT; This data is produced based on the following properties and assumption +s: (1) The average lifespan of a louse is between 25 and 50 days, but mo +re commonly between 25 to 35 days. (2) The male to female ratio is roughly 1:1. (3) The amount of time needed to grow from an egg into a fertile adul +t is between 14 - 20 days. (4) Fertile (adult) females lay between 3 and 7 eggs per day. (5) Each egg takes between 7 to 10 days to hatch. (6) Each nymph (hatched but not an adult) takes between 7 to 10 days to mature into an adult. (7) This infection scenario was started by an adult, pregnant, female 14 days old with a lifespan of 32 days. (8) I have found no documentation about how large an infestation of a + single head can grow to. This simulation also has no limits, (other than memory storage), although I am sure there must be lim +iting factors (such as available space on the human head, hair count, hair length, environmental conditions, etc. And let me just point out that this entire crop is inbred, just like r +eal lice. GROSS!!!! ================ DAY: $days ================ LICE: $n LIVE LICE: $living DEAD LICE: $deathtoll FEMALES: $females MALES: $males EGG LAYERS (FEMALE ADULTS): $egglayers NYMPHS (LITTLE/YOUNG): $toddlers EGGS: $eggsacks EGGS LAID TODAY: $eggslaidtoday ================ RUNTIME: $end UNTIL_END_REPORT $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; } }

      Hmm, you say "less noisily using a heredoc", I say "mess up tabbing of the file making it look ugly".

      Maybe use say instead of print, and use commas instead of ; print -- that may look less noisy and save the tabs.

      Iono, its just an annoyance I have with heredoc.

      And you didn't even know bears could type.

        One way you can indent HEREDOCs is to substitute the leading spaces in a map.

        $ perl -e ' $x = 1; if( $x ) { print map { s{^ }{}gm; $_ } <<" EOT"; Line 1 Line 2 \$x is $x Line 4 EOT }' Line 1 Line 2 $x is 1 Line 4 $

        This really is not a serious suggestion. It is rather horrible, probably inefficient and it would be a nightmare to maintain in a script. It would easily break if code is moved around and logical depth (thus indentation) changes or if you use an editor that decides off its own bat to use tabs instead of spaces when auto-indenting.

        I just post the code as a curio. Downvote if nauseated.

        Cheers,

        JohnGG

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://738017]
Approved by kyle
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (5)
As of 2021-11-30 21:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?