Logistic curve fitting in epidemiology: Difference between revisions
Logistic curve fitting in epidemiology (view source)
Revision as of 18:01, 13 April 2020
, 4 years agoAdded Perl example
(Added Wren) |
SqrtNegInf (talk | contribs) (Added Perl example) |
||
Line 184:
Since R0 ≈ exp(G * r), and G ≈ 12 days, R0 ≈ 3.8482792820761063
</pre>
=={{header|Perl}}==
{{trans|Phix}}
<lang perl>use strict;
use warnings;
my $K = 7_800_000_000; # population
my $n0 = 27; # cases @ day 0
my @y = (
27, 27, 27, 44, 44, 59, 59, 59, 59, 59, 59, 59, 59,
60, 60, 61, 61, 66, 83, 219, 239, 392, 534, 631, 897, 1350,
2023, 2820, 4587, 6067, 7823, 9826, 11946, 14554, 17372, 20615, 24522, 28273, 31491,
34933, 37552, 40540, 43105, 45177, 60328, 64543, 67103, 69265, 71332, 73327, 75191, 75723,
76719, 77804, 78812, 79339, 80132, 80995, 82101, 83365, 85203, 87024, 89068, 90664, 93077,
95316, 98172, 102133, 105824, 109695, 114232, 118610, 125497, 133852, 143227, 151367, 167418, 180096,
194836, 213150, 242364, 271106, 305117, 338133, 377918, 416845, 468049, 527767, 591704, 656866, 715353,
777796, 851308, 928436,1000249,1082054,1174652
);
sub logistic_func {
my($r) = @_;
my $sq = 0;
for my $i (0 .. @y-1) {
my $eri = exp($r * $i);
my $dst = ($n0 * $eri) / (1 + $n0 * ($eri-1) / $K) - $y[$i];
$sq = $sq + $dst**2;
}
$sq
}
sub solve {
my($fn, $guess, $epsilon) = @_;
my($nfm,$nfp);
my $f0 = &$fn($guess);
my $delta = $guess;
my $factor = 2;
while ($delta > $epsilon) {
($nfm = &$fn($guess - $delta)) < $f0 ?
($f0 = $nfm, $guess -= $delta, $delta *= $factor)
:
($nfp = &$fn($guess + $delta)) < $f0 ?
($f0 = $nfp, $guess += $delta, $delta *= $factor)
:
$delta /= $factor
}
$guess
}
my $r = solve(\&logistic_func, 0.5, 0);
my $R0 = exp(12 * $r);
printf "r = %%(%.3f), R0 = %%(%.3f)\n", $r, $R0;</lang>
{{out}}
<pre>r = %(0.112), R0 = %(3.848)</pre>
=={{header|Phix}}==
| |||