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;
}
}
-
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.
|