Selection bias in clinical sciences: Difference between revisions
Content added Content deleted
m (→{{header|Raku}}: insignificant changes) |
SqrtNegInf (talk | contribs) (Added Perl) |
||
Line 199: | Line 199: | ||
adjustment for ties: 0.417533 |
adjustment for ties: 0.417533 |
||
</pre> |
</pre> |
||
=={{header|Perl}}== |
|||
{{trans|Raku}} |
|||
<syntaxhighlight lang="perl" line>use v5.036; |
|||
use List::AllUtils <sum indexes firstidx>; |
|||
use enum qw<False True UNTREATED REGULAR IRREGULAR>; |
|||
use constant DOSE_FOR_REGULAR => 100; |
|||
my ($nSubjects,$duration,$interval) = (10000, 180, 30); |
|||
my (@dosage) = (0) x $nSubjects; |
|||
my (@category) = (UNTREATED) x $nSubjects; |
|||
my (@hadcovid) = (False) x $nSubjects; |
|||
sub update { |
|||
my $pCovid = 1e-3; |
|||
my $pStartTreatment = 5e-3; |
|||
my $pRedose = 1/4; |
|||
my @dRange = <3 6 9>; |
|||
for my $i (0 .. $nSubjects-1) { |
|||
unless ($hadcovid[$i]) { |
|||
if (rand() < $pCovid) { |
|||
$hadcovid[$i] = True |
|||
} else { |
|||
my $dose = $dosage[$i]; |
|||
if ($dose==0 && rand() < $pStartTreatment or $dose > 0 && rand() < $pRedose) { |
|||
$dosage[$i] = $dose += $dRange[3*rand()]; |
|||
$category[$i] = ($dose > DOSE_FOR_REGULAR) ? REGULAR : IRREGULAR |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
sub kruskal (@sets) { |
|||
my @ranked = sort @{$sets[0]}, @{$sets[1]}, @{$sets[2]}; |
|||
my $n = @ranked; |
|||
my @sr = (0) x @sets; |
|||
my $ix = firstidx { $_ == 1 } @ranked; |
|||
my ($arf,$art) = ($ix/2, ($ix+$n)/2); |
|||
for my $i (0..2) { |
|||
$sr[$i] += $_ ? $art : $arf for @{$sets[$i]} |
|||
} |
|||
my $H = sum map { my $s = $sr[$_]; $s**2 / @{$sets[$_]} } 0..$#sr; |
|||
12/($n*($n+1)) * $H - 3 * ($n + 1) |
|||
} |
|||
my($unt,$irr,$reg,$hunt,$hirr,$hreg,@sunt,@sirr,@sreg); |
|||
my $midpoint = int $duration / 2; |
|||
say "Total subjects: $nSubjects\n"; |
|||
for my $day (1 .. $duration) { |
|||
update(); |
|||
if (0 == $day % $interval or $day == $duration or $day == $midpoint) { |
|||
@sunt = @hadcovid[ indexes { $_ == UNTREATED } @category]; |
|||
@sirr = @hadcovid[ indexes { $_ == IRREGULAR } @category]; |
|||
@sreg = @hadcovid[ indexes { $_ == REGULAR } @category]; |
|||
( $unt, $irr, $reg) = (scalar(@sunt), scalar(@sirr), scalar(@sreg) ); |
|||
($hunt,$hirr,$hreg) = ( sum(@sunt), sum(@sirr), sum(@sreg) // 0); |
|||
} |
|||
if (0 == $day % $interval) { |
|||
printf "Day %d:\n", $day; |
|||
printf "Untreated: N = %4d, with infection = %4d\n", $unt,$hunt; |
|||
printf "Irregular Use: N = %4d, with infection = %4d\n", $irr,$hirr; |
|||
printf "Regular Use: N = %4d, with infection = %4d\n\n",$reg,$hreg; |
|||
} |
|||
if ($day == $midpoint or $day == $duration) { |
|||
my $stage = $day == $midpoint ? 'midpoint' : 'study end'; |
|||
printf "At $stage, Infection case percentages are:\n"; |
|||
printf " Untreated : %6.2f\n", 100*$hunt/$unt; |
|||
printf " Irregulars: %6.2f\n", 100*$hirr/$irr; |
|||
printf " Regulars : %6.2f\n\n", 100*$hreg/$reg; |
|||
} |
|||
} |
|||
printf "Final statistics: H = %.2f\n", kruskal ( \@sunt, \@sirr, \@sreg ); |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Total subjects: 10000 |
|||
Day 30: |
|||
Untreated: N = 8640, with infection = 283 |
|||
Irregular Use: N = 1360, with infection = 18 |
|||
Regular Use: N = 0, with infection = 0 |
|||
Day 60: |
|||
Untreated: N = 7499, with infection = 532 |
|||
Irregular Use: N = 2338, with infection = 75 |
|||
Regular Use: N = 163, with infection = 1 |
|||
Day 90: |
|||
Untreated: N = 6537, with infection = 709 |
|||
Irregular Use: N = 2382, with infection = 144 |
|||
Regular Use: N = 1081, with infection = 12 |
|||
At midpoint, Infection case percentages are: |
|||
Untreated : 10.85 |
|||
Irregulars: 6.05 |
|||
Regulars : 1.11 |
|||
Day 120: |
|||
Untreated: N = 5739, with infection = 855 |
|||
Irregular Use: N = 2102, with infection = 216 |
|||
Regular Use: N = 2159, with infection = 52 |
|||
Day 150: |
|||
Untreated: N = 5091, with infection = 1012 |
|||
Irregular Use: N = 1792, with infection = 270 |
|||
Regular Use: N = 3117, with infection = 134 |
|||
Day 180: |
|||
Untreated: N = 4468, with infection = 1126 |
|||
Irregular Use: N = 1669, with infection = 315 |
|||
Regular Use: N = 3863, with infection = 243 |
|||
At study end, Infection case percentages are: |
|||
Untreated : 25.20 |
|||
Irregulars: 18.87 |
|||
Regulars : 6.29 |
|||
Final statistics: H = 218.74</pre> |
|||
=={{header|Phix}}== |
=={{header|Phix}}== |