CUFP
Anonymous Monk
This is actually kinda gross and buggy, in more ways than one.
<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 untreated?"
#
# Written by Jason Butler, a father that was really creeped out by his
# childrens unfortunate (but quickly erradicated) head lice infestation.
use strict;
#use lib "/home/jbutler/scripts/lice";
# Using an object was not as fast as using a hash variable for spawning
# 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 through.
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 laying 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 $parent\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 $dayofdeath\n";
return $dayofdeath;
}
sub maturity {
my $maturity;
#minimum days before able to lay eggs is between 13 and 16 days
$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 and 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 properties and assumptions:\n";
print "1) The average lifespan of a louse is between 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 hatch\n";
print "6) Each nymph (hatched but not an adult) takes 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 large an infestation of a single head can grow to. This simulation also 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;
}
}
</code>
18