Rosetta Code

P-value correction: Difference between revisions

← Older editNewer edit →
Content deleted Content added
added Ruby
→‎{{header|Perl}}: removed unused variable and unnecessary checks
Line 3,607:
 
use strict;
use warnings FATAL => 'all';
use autodie ':all';
use List::Util 'min';▼
use feature 'say';
 
sub pmin {
my $array_refarray = shift;
my $x = 1;
unless ((ref $array_ref) =~ m/ARRAY/) {
print "cummin requires an array.\n";
die;
}
my @pmin_array;
my $n = scalar @$array_refarray;
for (my $index = 0; $index < $n; $index++) {
if$pmin_array[$index] = min(@$array_refarray[$index] <, $x) {;
$pmin_array[$index] = @$array_ref[$index];
} else {
$pmin_array[$index] = $x;
}
}
return @pmin_array;
}
 
sub cummin {
my $array_ref = shift;
unless ((ref $array_ref) =~ m/ARRAY/) {
print "cummin requires an array.\n";
die;
}
my @cummin;
my $cumulative_min = @$array_ref[0];
Line 3,642 ⟶ 3,633:
push @cummin, $cumulative_min;
}
return @cummin;
}
 
sub cummax {
my $array_ref = shift;
unless ((ref $array_ref) =~ m/ARRAY/) {
print "cummin requires an array.\n";
die;
}
my @cummax;
my $cumulative_max = @$array_ref[0];
Line 3,659 ⟶ 3,646:
push @cummax, $cumulative_max;
}
return @cummax;
}
 
Line 3,675 ⟶ 3,662:
die;
}
}
unless ((ref $array_ref) =~ m/ARRAY/) {
print "You should have entered an array.\n";
die;
}
my @array;
Line 3,687 ⟶ 3,670:
@array = sort { @$array_ref[$b] <=> @$array_ref[$a] } 0..$max_index;
}
@array
}
 
▲use List::Util 'min';
 
sub p_adjust {
my $pvalues_ref = shift;
unless ((ref $pvalues_ref) =~ m/ARRAY/) {
print "p_adjust requires an array.\n";
die;
}
my $method;
if (defined $_[0]) {
$method = shift;
} else {
$method = 'Holm';
}
my %methods = (
Line 3,717 ⟶ 3,696:
$method = $key;
$method_found = 'yes';
last;
}
}
Line 3,731 ⟶ 3,710:
if ($method_found eq 'no') {
print "No method could be determined from $method.\n";
die;
}
my $lp = scalar @$pvalues_ref;
Line 3,743 ⟶ 3,722:
}
my @cummin = cummin(\@cummin_input);
undef @cummin_input;▼
my @pmin = pmin(\@cummin);
undef @cummin;
my @ro = order(\@o);
undef @o;
@qvalues = @pmin[@ro];
} elsif ($method eq 'bh') {
Line 3,756 ⟶ 3,732:
}
my @ro = order(\@o);
undef @o;
my @cummin = cummin(\@cummin_input);
undef @cummin_input;
my @pmin = pmin(\@cummin);
undef @cummin;
@qvalues = @pmin[@ro];
} elsif ($method eq 'by') {
Line 3,773 ⟶ 3,746:
$cummin_input[$index] = $q * ($n/($n-$index)) * @$pvalues_ref[$o[$index]];#PVALUES[$o[$index]] is p[o]
}
▲# undefsay join (',', @cummin_input);
# say '@cummin_input # of elements = ' . scalar @cummin_input;
my @cummin = cummin(\@cummin_input);
undef @cummin_input;
my @pmin = pmin(\@cummin);
undef @cummin;
@qvalues = @pmin[@ro];
} elsif ($method eq 'bonferroni') {
Line 3,786 ⟶ 3,760:
$qvalues[$index] = 1.0;
} else {
printsay "'Failed to get Bonferroni adjusted p."';
die;
}
Line 3,804 ⟶ 3,778:
@qvalues = @pmin[@ro];
} elsif ($method eq 'hommel') {
my @i = 1..$n;
my @o = order($pvalues_ref);
my @p = @$pvalues_ref[@o];
my @ro = order(\@o);
undef @o;
my (@q, @pa);
my @q;
my $min = $n*$p[0];
for (my $index = 0; $index < $n; $index++) {
my $temp = $n*$p[$index] / ($index + 1);
if ($tempmin <= min($min), {$temp);
$min = $temp;
}
}
for (my $index = 0; $index < $n; $index++) {
Line 3,823 ⟶ 3,793:
}
for (my $j = ($n-1); $j >= 2; $j--) {
my @ij = 10..($n - $j + 1);#ij <- seq_len(n - j + 1)▼
# printf("j = %zu\n", j);
▲ my @ij = 1..($n - $j + 1);#ij <- seq_len(n - j + 1)
for (my $i = 0; $i < $n - $j + 1; $i++) {
$ij[$i]--;#R's indices are 1-based, C's are 0-based
}
my $I2_LENGTH = $j - 1;
my @i2;
Line 3,838 ⟶ 3,804:
for (my $i = 1; $i < $I2_LENGTH; $i++) {#loop through 2:j
my $TEMP_Q1 = $j * $p[$i2[$i]] / (2 + $i);
if$q1 = min($TEMP_Q1 <, $q1) {;
$q1 = $TEMP_Q1;
}
}
 
for (my $i = 0; $i < ($n - $j + 1); $i++) {#q[ij] <- pmin(j * p[ij], q1)
$q[$ij[$i]] = min( $j*$p[$ij[$i]], $q1);
Line 3,848 ⟶ 3,811:
 
for (my $i = 0; $i < $I2_LENGTH; $i++) {#q[i2] <- q[n - j + 1]
$q[$i2[$i]] = $q[$n - $j];#subtract 1 because of starting index difference
}
 
Line 3,862 ⟶ 3,825:
} else {
print "$method doesn't fit my types.\n";
die;
}
return @qvalues;
}
my @pvalues = (4.533744e-01, 7.296024e-01, 9.936026e-02, 9.079658e-02, 1.801962e-01,
Retrieved from "https://rosettacode.org/wiki/P-value_correction"