Welch's t-test: Difference between revisions
m (→{{header|SAS}}: syntax coloring does not work well with SAS) |
(Added FreeBASIC) |
||
(58 intermediate revisions by 15 users not shown) | |||
Line 1: | Line 1: | ||
{{draft task}} |
{{draft task|Probability and statistics}} |
||
Given two lists of data, calculate the [[wp:p-value|p-value]] used for [[wp:Welch's_t_test|Welch's t-test]] (for example, other t-tests can be used as well). This is meant to translate R's <code>t.test(vector1,vector2, alternative="two.sided", var.equal=FALSE)</code> for calculation of the p-value. |
|||
Given two lists of data, calculate the [[wp:p-value|p-value]] used for [[wp:Welch's_t_test|Welch's t-test]]. This is meant to translate R's <code>t.test(vector1, vector2, alternative="two.sided", var.equal=FALSE)</code> for calculation of the p-value. |
|||
'''Task Description'''<br> |
'''Task Description'''<br> |
||
Line 11: | Line 12: | ||
Your task is to discern whether or not the difference in means between the two sets is statistically significant and worth further investigation. P-values are significance tests to gauge the probability that the difference in means between two data sets is significant, or due to chance. A threshold level, alpha, is usually chosen, 0.01 or 0.05, where p-values below alpha are worth further investigation and p-values above alpha are considered not significant. The p-value is not considered a final test of significance, [http://www.nature.com/news/scientific-method-statistical-errors-1.14700 only whether the given variable should be given further consideration]. |
Your task is to discern whether or not the difference in means between the two sets is statistically significant and worth further investigation. P-values are significance tests to gauge the probability that the difference in means between two data sets is significant, or due to chance. A threshold level, alpha, is usually chosen, 0.01 or 0.05, where p-values below alpha are worth further investigation and p-values above alpha are considered not significant. The p-value is not considered a final test of significance, [http://www.nature.com/news/scientific-method-statistical-errors-1.14700 only whether the given variable should be given further consideration]. |
||
There is more than |
There is more than one way of calculating the [[wp:Student's_t-test|t-statistic]], and you must choose which method is appropriate for you. Here we use [[wp:Welch's_t_test|Welch's t-test]], which assumes that the variances between the two sets <code>x</code> and <code>y</code> are not equal. Welch's t-test statistic can be computed: |
||
<math>t \quad = \quad {\; \overline{X}_1 - \overline{X}_2 \; \over \sqrt{ \; {s_1^2 \over N_1} \; + \; {s_2^2 \over N_2} \quad }} </math> |
<math>t \quad = \quad {\; \overline{X}_1 - \overline{X}_2 \; \over \sqrt{ \; {s_1^2 \over N_1} \; + \; {s_2^2 \over N_2} \quad }} </math> |
||
Line 64: | Line 65: | ||
The <math>\ln(\Gamma(x))</math>, or <code>lgammal(x)</code> function is necessary for the program to work with large <code>a</code> values, as [http://rosettacode.org/wiki/Gamma_function Gamma functions] can often return values larger than can be handled by <code>double</code> or <code>long double</code> data types. The <code>lgammal(x)</code> function is standard in <code>math.h</code> with C99 and C11 standards. |
The <math>\ln(\Gamma(x))</math>, or <code>lgammal(x)</code> function is necessary for the program to work with large <code>a</code> values, as [http://rosettacode.org/wiki/Gamma_function Gamma functions] can often return values larger than can be handled by <code>double</code> or <code>long double</code> data types. The <code>lgammal(x)</code> function is standard in <code>math.h</code> with C99 and C11 standards. |
||
=={{header|11l}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="11l">F betain(x, p, q) |
|||
I p <= 0 | q <= 0 | x < 0 | x > 1 |
|||
X.throw ValueError(0) |
|||
I x == 0 | x == 1 |
|||
R x |
|||
V acu = 1e-15 |
|||
V lnbeta = lgamma(p) + lgamma(q) - lgamma(p + q) |
|||
V xx = x |
|||
V cx = 1 - x |
|||
V pp = p |
|||
V qq = q |
|||
V indx = 0B |
|||
V psq = p + q |
|||
I p < psq * x |
|||
xx = 1 - x |
|||
cx = x |
|||
pp = q |
|||
qq = p |
|||
indx = 1B |
|||
V term = 1.0 |
|||
V ai = 1.0 |
|||
V value = 1.0 |
|||
V ns = floor(qq + cx * psq) |
|||
V rx = xx / cx |
|||
V temp = qq - ai |
|||
I ns == 0 |
|||
rx = xx |
|||
L |
|||
term *= temp * rx / (pp + ai) |
|||
value += term |
|||
temp = abs(term) |
|||
I temp <= acu & temp <= acu * value |
|||
value *= exp(pp * log(xx) + (qq - 1) * log(cx) - lnbeta) / pp |
|||
R I indx {1 - value} E value |
|||
ai++ |
|||
I --ns >= 0 |
|||
temp = qq - ai |
|||
I ns == 0 |
|||
rx = xx |
|||
E |
|||
temp = psq |
|||
psq++ |
|||
F welch_ttest(a1, a2) |
|||
V n1 = a1.len |
|||
V n2 = a2.len |
|||
I n1 <= 1 | n2 <= 1 |
|||
X.throw ValueError(0) |
|||
V mean1 = sum(a1) / n1 |
|||
V mean2 = sum(a2) / n2 |
|||
V var1 = sum(a1.map(x -> (x - @mean1) ^ 2)) / (n1 - 1) |
|||
V var2 = sum(a2.map(x -> (x - @mean2) ^ 2)) / (n2 - 1) |
|||
V t = (mean1 - mean2) / sqrt(var1 / n1 + var2 / n2) |
|||
V df = (var1 / n1 + var2 / n2) ^ 2 / (var1 ^ 2 / (n1 ^ 2 * (n1 - 1)) + var2 ^ 2 / (n2 ^ 2 * (n2 - 1))) |
|||
V p = betain(df / (t ^ 2 + df), df / 2, 1 / 2) |
|||
R (t, df, p) |
|||
V a1 = [Float(3), 4, 1, 2.1] |
|||
V a2 = [Float(490.2), 340, 433.9] |
|||
print(welch_ttest(a1, a2))</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
(-9.5595, 2.00085, 0.0107516) |
|||
</pre> |
|||
=={{header|C}}== |
=={{header|C}}== |
||
Line 72: | Line 153: | ||
This program, for example, pvalue.c, can be compiled by |
This program, for example, pvalue.c, can be compiled by |
||
<code>clang -o pvalue pvalue.c -Wall -pedantic -std=c11 -lm - |
<code>clang -o pvalue pvalue.c -Wall -pedantic -std=c11 -lm -O3</code> |
||
or |
or |
||
<code>gcc -o pvalue pvalue.c -Wall -pedantic -std=c11 -lm - |
<code>gcc -o pvalue pvalue.c -Wall -pedantic -std=c11 -lm -O4</code>. |
||
This shows how pvalue can be calculated from any two arrays, using Welch's 2-sided t-test, which doesn't assume equal variance. |
This shows how pvalue can be calculated from any two arrays, using Welch's 2-sided t-test, which doesn't assume equal variance. |
||
This is the equivalent of R's<code>t.test(vector1,vector2, alternative="two.sided", var.equal=FALSE)</code> and as such, it is compared against R's pvalues with the same vectors/arrays to show that the differences are very small (here 10^-14). |
|||
<syntaxhighlight lang="c">#include <stdio.h> |
|||
Smaller p-values converge more quickly than larger p-values. |
|||
<code>const unsigned short int N = 65535</code> |
|||
ensures integral convergence of about <math>10^{-15}</math> for p-values < 0.15, about <math>10^{-7}</math> for p-values approximately 0.5, but only <math>10^{-3}</math> for p-values approaching 1. |
|||
<lang C>#include <stdio.h> |
|||
#include <math.h> |
#include <math.h> |
||
#include <stdlib.h> |
|||
double |
double Pvalue (const double *restrict ARRAY1, const size_t ARRAY1_SIZE, const double *restrict ARRAY2, const size_t ARRAY2_SIZE) {//calculate a p-value based on an array |
||
if ( |
if (ARRAY1_SIZE <= 1) { |
||
return 1.0; |
return 1.0; |
||
} else if (ARRAY2_SIZE <= 1) { |
|||
} |
|||
if (array2_size <= 1) { |
|||
return 1.0; |
return 1.0; |
||
} |
} |
||
double |
double fmean1 = 0.0, fmean2 = 0.0; |
||
for (size_t x = 0; x < |
for (size_t x = 0; x < ARRAY1_SIZE; x++) {//get sum of values in ARRAY1 |
||
if (isfinite(ARRAY1[x]) == 0) {//check to make sure this is a real numbere |
|||
mean1 += array1[x]; |
|||
puts("Got a non-finite number in 1st array, can't calculate P-value."); |
|||
exit(EXIT_FAILURE); |
|||
} |
|||
fmean1 += ARRAY1[x]; |
|||
} |
} |
||
fmean1 /= ARRAY1_SIZE; |
|||
for (size_t x = 0; x < array2_size; x++) { |
|||
for (size_t x = 0; x < ARRAY2_SIZE; x++) {//get sum of values in ARRAY2 |
|||
mean2 += array2[x]; |
|||
if (isfinite(ARRAY2[x]) == 0) {//check to make sure this is a real number |
|||
puts("Got a non-finite number in 2nd array, can't calculate P-value."); |
|||
exit(EXIT_FAILURE); |
|||
} |
|||
fmean2 += ARRAY2[x]; |
|||
} |
} |
||
fmean2 /= ARRAY2_SIZE; |
|||
if (mean1 == mean2) { |
|||
// printf("mean1 = %lf mean2 = %lf\n", fmean1, fmean2); |
|||
return 1.0; |
|||
if (fmean1 == fmean2) { |
|||
return 1.0;//if the means are equal, the p-value is 1, leave the function |
|||
} |
} |
||
double unbiased_sample_variance1 = 0.0, unbiased_sample_variance2 = 0.0; |
|||
mean1 /= array1_size; |
|||
for (size_t x = 0; x < ARRAY1_SIZE; x++) {//1st part of added unbiased_sample_variance |
|||
mean2 /= array2_size; |
|||
unbiased_sample_variance1 += (ARRAY1[x]-fmean1)*(ARRAY1[x]-fmean1); |
|||
double variance1 = 0.0, variance2 = 0.0; |
|||
for (size_t x = 0; x < array1_size; x++) { |
|||
variance1 += (array1[x]-mean1)*(array1[x]-mean1); |
|||
} |
} |
||
for (size_t x = 0; x < |
for (size_t x = 0; x < ARRAY2_SIZE; x++) { |
||
unbiased_sample_variance2 += (ARRAY2[x]-fmean2)*(ARRAY2[x]-fmean2); |
|||
} |
} |
||
// printf("unbiased_sample_variance1 = %lf\tunbiased_sample_variance2 = %lf\n",unbiased_sample_variance1,unbiased_sample_variance2);//DEBUGGING |
|||
if ((variance1 == 0.0) && (variance2 == 0.0)) { |
|||
unbiased_sample_variance1 = unbiased_sample_variance1/(ARRAY1_SIZE-1); |
|||
return 1.0; |
|||
unbiased_sample_variance2 = unbiased_sample_variance2/(ARRAY2_SIZE-1); |
|||
} |
|||
const double WELCH_T_STATISTIC = (fmean1-fmean2)/sqrt(unbiased_sample_variance1/ARRAY1_SIZE+unbiased_sample_variance2/ARRAY2_SIZE); |
|||
variance1 = variance1/(array1_size-1); |
|||
const double DEGREES_OF_FREEDOM = pow((unbiased_sample_variance1/ARRAY1_SIZE+unbiased_sample_variance2/ARRAY2_SIZE),2.0)//numerator |
|||
variance2 = variance2/(array2_size-1); |
|||
const double WELCH_T_STATISTIC = (mean1-mean2)/sqrt(variance1/array1_size+variance2/array2_size); |
|||
//End of Welch's T-Test |
|||
const double DEGREES_OF_FREEDOM = pow((variance1/array1_size+variance2/array2_size),2.0)//numerator |
|||
/ |
/ |
||
( |
( |
||
(unbiased_sample_variance1*unbiased_sample_variance1)/(ARRAY1_SIZE*ARRAY1_SIZE*(ARRAY1_SIZE-1))+ |
|||
(variance1*variance1)/(array1_size*array1_size*(array1_size-1))+ |
|||
(unbiased_sample_variance2*unbiased_sample_variance2)/(ARRAY2_SIZE*ARRAY2_SIZE*(ARRAY2_SIZE-1)) |
|||
(variance2*variance2)/(array2_size*array2_size*(array2_size-1)) |
|||
); |
); |
||
// printf("Welch = %lf DOF = %lf\n", WELCH_T_STATISTIC, DEGREES_OF_FREEDOM); |
|||
const double a = DEGREES_OF_FREEDOM/2, x = DEGREES_OF_FREEDOM/(WELCH_T_STATISTIC*WELCH_T_STATISTIC+DEGREES_OF_FREEDOM); |
|||
const double a = DEGREES_OF_FREEDOM/2; |
|||
double value = DEGREES_OF_FREEDOM/(WELCH_T_STATISTIC*WELCH_T_STATISTIC+DEGREES_OF_FREEDOM); |
|||
const double h = x/N; |
|||
if ((isinf(value) != 0) || (isnan(value) != 0)) { |
|||
double sum1 = 0.0, sum2 = 0.0; |
|||
return 1.0; |
|||
for(unsigned short int i = 0;i < N; i++) { |
|||
sum1 += (pow(h * i + h / 2.0,a-1))/(sqrt(1-(h * i + h / 2.0))); |
|||
sum2 += (pow(h * i,a-1))/(sqrt(1-h * i)); |
|||
} |
} |
||
if ((isinf(value) != 0) || (isnan(value) != 0)) { |
|||
double return_value = ((h / 6.0) * ((pow(x,a-1))/(sqrt(1-x)) + 4.0 * sum1 + 2.0 * sum2))/(expl(lgammal(a)+0.57236494292470009-lgammal(a+0.5))); |
|||
if ((isfinite(return_value) == 0) || (return_value > 1.0)) { |
|||
return 1.0; |
return 1.0; |
||
} else { |
|||
return return_value; |
|||
} |
} |
||
} |
|||
/* Purpose: |
|||
BETAIN computes the incomplete Beta function ratio. |
|||
Licensing: |
|||
This code is distributed under the GNU LGPL license. |
|||
Modified: |
|||
05 November 2010 |
|||
Author: |
|||
Original FORTRAN77 version by KL Majumder, GP Bhattacharjee. |
|||
C version by John Burkardt. |
|||
Reference: |
|||
KL Majumder, GP Bhattacharjee, |
|||
Algorithm AS 63: |
|||
The incomplete Beta Integral, |
|||
Applied Statistics, |
|||
Volume 22, Number 3, 1973, pages 409-411. |
|||
Parameters: |
|||
https://www.jstor.org/stable/2346797?seq=1#page_scan_tab_contents |
|||
Input, double X, the argument, between 0 and 1. |
|||
Input, double P, Q, the parameters, which |
|||
must be positive. |
|||
Input, double BETA, the logarithm of the complete |
|||
beta function. |
|||
Output, int *IFAULT, error flag. |
|||
0, no error. |
|||
nonzero, an error occurred. |
|||
Output, double BETAIN, the value of the incomplete |
|||
Beta function ratio. |
|||
*/ |
|||
const double beta = lgammal(a)+0.57236494292470009-lgammal(a+0.5); |
|||
const double acu = 0.1E-14; |
|||
double ai; |
|||
double cx; |
|||
int indx; |
|||
int ns; |
|||
double pp; |
|||
double psq; |
|||
double qq; |
|||
double rx; |
|||
double temp; |
|||
double term; |
|||
double xx; |
|||
// ifault = 0; |
|||
//Check the input arguments. |
|||
if ( (a <= 0.0)) {// || (0.5 <= 0.0 )){ |
|||
// *ifault = 1; |
|||
// return value; |
|||
} |
|||
if ( value < 0.0 || 1.0 < value ) |
|||
{ |
|||
// *ifault = 2; |
|||
return value; |
|||
} |
|||
/* |
|||
Special cases. |
|||
*/ |
|||
if ( value == 0.0 || value == 1.0 ) { |
|||
return value; |
|||
} |
|||
psq = a + 0.5; |
|||
cx = 1.0 - value; |
|||
if ( a < psq * value ) |
|||
{ |
|||
xx = cx; |
|||
cx = value; |
|||
pp = 0.5; |
|||
qq = a; |
|||
indx = 1; |
|||
} |
|||
else |
|||
{ |
|||
xx = value; |
|||
pp = a; |
|||
qq = 0.5; |
|||
indx = 0; |
|||
} |
|||
term = 1.0; |
|||
ai = 1.0; |
|||
value = 1.0; |
|||
ns = ( int ) ( qq + cx * psq ); |
|||
/* |
|||
Use the Soper reduction formula. |
|||
*/ |
|||
rx = xx / cx; |
|||
temp = qq - ai; |
|||
if ( ns == 0 ) |
|||
{ |
|||
rx = xx; |
|||
} |
|||
for ( ; ; ) |
|||
{ |
|||
term = term * temp * rx / ( pp + ai ); |
|||
value = value + term;; |
|||
temp = fabs ( term ); |
|||
if ( temp <= acu && temp <= acu * value ) |
|||
{ |
|||
value = value * exp ( pp * log ( xx ) |
|||
+ ( qq - 1.0 ) * log ( cx ) - beta ) / pp; |
|||
if ( indx ) |
|||
{ |
|||
value = 1.0 - value; |
|||
} |
|||
break; |
|||
} |
|||
ai = ai + 1.0; |
|||
ns = ns - 1; |
|||
if ( 0 <= ns ) |
|||
{ |
|||
temp = qq - ai; |
|||
if ( ns == 0 ) |
|||
{ |
|||
rx = xx; |
|||
} |
|||
} |
|||
else |
|||
{ |
|||
temp = psq; |
|||
psq = psq + 1.0; |
|||
} |
|||
} |
|||
return value; |
|||
} |
|||
//------------------- |
|||
int main(void) { |
int main(void) { |
||
const double d1[] = {27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4}; |
const double d1[] = {27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4}; |
||
const double d2[] = {27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4}; |
const double d2[] = {27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4}; |
||
Line 154: | Line 375: | ||
const double x[] = {3.0,4.0,1.0,2.1}; |
const double x[] = {3.0,4.0,1.0,2.1}; |
||
const double y[] = {490.2,340.0,433.9}; |
const double y[] = {490.2,340.0,433.9}; |
||
const double v1[] = {0.010268,0.000167,0.000167}; |
|||
const double v2[] = {0.159258,0.136278,0.122389}; |
|||
const double s1[] = {1.0/15,10.0/62.0}; |
|||
const double s2[] = {1.0/10,2/50.0}; |
|||
const double z1[] = {9/23.0,21/45.0,0/38.0}; |
|||
const double z2[] = {0/44.0,42/94.0,0/22.0}; |
|||
const double CORRECT_ANSWERS[] = {0.021378001462867, |
|||
0.148841696605327, |
|||
0.0359722710297968, |
|||
0.090773324285671, |
|||
0.0107515611497845, |
|||
0.00339907162713746, |
|||
0.52726574965384, |
|||
0.545266866977794}; |
|||
//calculate the pvalues and show that they're the same as the R values |
|||
double pvalue = Pvalue(d1,sizeof(d1)/sizeof(*d1),d2,sizeof(d2)/sizeof(*d2)); |
|||
double error = fabs(pvalue - CORRECT_ANSWERS[0]); |
|||
printf("Test sets 1 p-value = %g\n", pvalue); |
|||
pvalue = Pvalue(d3,sizeof(d3)/sizeof(*d3),d4,sizeof(d4)/sizeof(*d4)); |
|||
error += fabs(pvalue - CORRECT_ANSWERS[1]); |
|||
printf("Test sets 2 p-value = %g\n",pvalue); |
|||
pvalue = Pvalue(d5,sizeof(d5)/sizeof(*d5),d6,sizeof(d6)/sizeof(*d6)); |
|||
error += fabs(pvalue - CORRECT_ANSWERS[2]); |
|||
printf("Test sets 3 p-value = %g\n", pvalue); |
|||
pvalue = Pvalue(d7,sizeof(d7)/sizeof(*d7),d8,sizeof(d8)/sizeof(*d8)); |
|||
printf("Test sets 4 p-value = %g\n", pvalue); |
|||
error += fabs(pvalue - CORRECT_ANSWERS[3]); |
|||
pvalue = Pvalue(x,sizeof(x)/sizeof(*x),y,sizeof(y)/sizeof(*y)); |
|||
error += fabs(pvalue - CORRECT_ANSWERS[4]); |
|||
printf("Test sets 5 p-value = %g\n", pvalue); |
|||
pvalue = Pvalue(v1,sizeof(v1)/sizeof(*v1),v2,sizeof(v2)/sizeof(*v2)); |
|||
error += fabs(pvalue - CORRECT_ANSWERS[5]); |
|||
printf("Test sets 6 p-value = %g\n", pvalue); |
|||
pvalue = Pvalue(s1,sizeof(s1)/sizeof(*s1),s2,sizeof(s2)/sizeof(*s2)); |
|||
error += fabs(pvalue - CORRECT_ANSWERS[6]); |
|||
printf("Test sets 7 p-value = %g\n", pvalue); |
|||
pvalue = Pvalue(z1, 3, z2, 3); |
|||
error += fabs(pvalue - CORRECT_ANSWERS[7]); |
|||
printf("Test sets z p-value = %g\n", pvalue); |
|||
printf("the cumulative error is %g\n", error); |
|||
printf("Test sets 1 p-value = %lf\n",calculate_Pvalue(d1,sizeof(d1)/sizeof(*d1),d2,sizeof(d2)/sizeof(*d2))); |
|||
printf("Test sets 2 p-value = %lf\n",calculate_Pvalue(d3,sizeof(d3)/sizeof(*d3),d4,sizeof(d4)/sizeof(*d4))); |
|||
printf("Test sets 3 p-value = %lf\n",calculate_Pvalue(d5,sizeof(d5)/sizeof(*d5),d6,sizeof(d6)/sizeof(*d6))); |
|||
printf("Test sets 4 p-value = %lf\n",calculate_Pvalue(d7,sizeof(d7)/sizeof(*d7),d8,sizeof(d8)/sizeof(*d8))); |
|||
printf("Test sets 5 p-value = %lf\n",calculate_Pvalue(x,sizeof(x)/sizeof(*x),y,sizeof(y)/sizeof(*y))); |
|||
return 0; |
return 0; |
||
} |
} |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre>Test sets 1 p-value = 0.021378 |
<pre>Test sets 1 p-value = 0.021378 |
||
Test sets 2 p-value = 0.148842 |
Test sets 2 p-value = 0.148842 |
||
Test sets 3 p-value = 0. |
Test sets 3 p-value = 0.0359723 |
||
Test sets 4 p-value = 0. |
Test sets 4 p-value = 0.0907733 |
||
Test sets 5 p-value = 0. |
Test sets 5 p-value = 0.0107516 |
||
Test sets 6 p-value = 0.00339907 |
|||
Test sets 7 p-value = 0.527266 |
|||
Test sets z p-value = 0.545267 |
|||
the cumulative error is 1.06339e-14</pre> |
|||
'''If''' your computer does not have <code>lgammal</code>, add the following function before <code>main</code> and replace <code>lgammal</code> with <code>lngammal</code> in the <code>calculate_Pvalue</code> function: |
'''If''' your computer does not have <code>lgammal</code>, add the following function before <code>main</code> and replace <code>lgammal</code> with <code>lngammal</code> in the <code>calculate_Pvalue</code> function: |
||
< |
<syntaxhighlight lang="c">#include <stdio.h> |
||
#include <math.h> |
#include <math.h> |
||
Line 193: | Line 463: | ||
} |
} |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|Fortran}}== |
=={{header|Fortran}}== |
||
Line 200: | Line 470: | ||
Alternatively, the program shows the p-value computed using the IMSL '''BETAI''' function. |
Alternatively, the program shows the p-value computed using the IMSL '''BETAI''' function. |
||
< |
<syntaxhighlight lang="fortran">subroutine welch_ttest(n1, x1, n2, x2, t, df, p) |
||
use tdf_int |
use tdf_int |
||
implicit none |
implicit none |
||
Line 225: | Line 495: | ||
print *, t, df, p |
print *, t, df, p |
||
print *, betai(df / (t**2 + df), 0.5d0 * df, 0.5d0) |
print *, betai(df / (t**2 + df), 0.5d0 * df, 0.5d0) |
||
end program</ |
end program</syntaxhighlight> |
||
'''Output''' |
'''Output''' |
||
Line 233: | Line 503: | ||
=== Using SLATEC === |
=== Using SLATEC === |
||
With Absoft Pro Fortran, compile with <code>af90 pvalue.f90 %SLATEC_LINK%</code>. |
With Absoft Pro Fortran, compile with <code>af90 -m64 pvalue.f90 %SLATEC_LINK%</code>. |
||
< |
<syntaxhighlight lang="fortran">subroutine welch_ttest(n1, x1, n2, x2, t, df, p) |
||
implicit none |
implicit none |
||
integer :: n1, n2 |
integer :: n1, n2 |
||
Line 260: | Line 530: | ||
call welch_ttest(4, x, 3, y, t, df, p) |
call welch_ttest(4, x, 3, y, t, df, p) |
||
print *, t, df, p |
print *, t, df, p |
||
end program</ |
end program</syntaxhighlight> |
||
'''Output''' |
'''Output''' |
||
<pre> -9.55949772193266 2.00085234885628 1.075156114978449E-002</pre> |
<pre> -9.55949772193266 2.00085234885628 1.075156114978449E-002</pre> |
||
=== Using GSL === |
|||
{{works with|Fortran|95}} |
|||
{{libheader|GNU Scientific Library}} |
|||
Instead of implementing the t-distribution by ourselves, we bind to GNU Scientific Library: |
|||
<syntaxhighlight lang="fortran">module t_test_m |
|||
use, intrinsic :: iso_c_binding |
|||
use, intrinsic :: iso_fortran_env, only: wp => real64 |
|||
implicit none |
|||
private |
|||
public :: t_test, wp |
|||
interface |
|||
function gsl_cdf_tdist_p(x, nu) bind(c, name='gsl_cdf_tdist_P') |
|||
import |
|||
real(c_double), value :: x |
|||
real(c_double), value :: nu |
|||
real(c_double) :: gsl_cdf_tdist_p |
|||
end function gsl_cdf_tdist_p |
|||
end interface |
|||
contains |
|||
!> Welch T test |
|||
impure subroutine t_test(x, y, p, t, df) |
|||
real(wp), intent(in) :: x(:), y(:) |
|||
real(wp), intent(out) :: p !! p-value |
|||
real(wp), intent(out) :: t !! T value |
|||
real(wp), intent(out) :: df !! degrees of freedom |
|||
integer :: n1, n2 |
|||
real(wp) :: m1, m2, v1, v2 |
|||
n1 = size(x) |
|||
n2 = size(y) |
|||
m1 = sum(x)/n1 |
|||
m2 = sum(y)/n2 |
|||
v1 = sum((x - m1)**2)/(n1 - 1) |
|||
v2 = sum((y - m2)**2)/(n2 - 1) |
|||
t = (m1 - m2)/sqrt(v1/n1 + v2/n2) |
|||
df = (v1/n1 + v2/n2)**2/(v1**2/(n1**2*(n1 - 1)) + v2**2/(n2**2*(n2 - 1))) |
|||
p = 2*gsl_cdf_tdist_p(-abs(t), df) |
|||
end subroutine t_test |
|||
end module t_test_m |
|||
program main |
|||
use t_test_m, only: t_test, wp |
|||
implicit none |
|||
real(wp) :: x(4) = [3.0_wp, 4.0_wp, 1.0_wp, 2.1_wp] |
|||
real(wp) :: y(3) = [490.2_wp, 340.0_wp, 433.9_wp] |
|||
real(wp) :: t, df, p |
|||
call t_test(x, y, p, t, df) |
|||
print *, t, df, p |
|||
end program main</syntaxhighlight> |
|||
'''Output''' |
|||
<pre> -9.5594977219326580 2.0008523488562844 1.0751561149784494E-002</pre> |
|||
=={{header|FreeBASIC}}== |
|||
===Using Betain=== |
|||
{{trans|11l}} |
|||
<syntaxhighlight lang="vbnet">#include "crt\math.bi" |
|||
Function betain(x As Double, p As Double, q As Double) As Double |
|||
If p <= 0 Or q <= 0 Or x < 0 Or x > 1 Then |
|||
Print "ValueError" |
|||
End |
|||
End If |
|||
If x = 0 Or x = 1 Then Return x |
|||
Dim As Double acu = 1e-15 |
|||
'Dim As Double lnbeta = LogGamma(p) + LogGamma(q) - LogGamma(p + q) |
|||
Dim As Double lnbeta = lGamma(p) + lGamma(q) - lGamma(p + q) |
|||
Dim As Double xx = x |
|||
Dim As Double cx = 1 - x |
|||
Dim As Double pp = p |
|||
Dim As Double qq = q |
|||
Dim As Integer indx = 0 |
|||
Dim As Double psq = p + q |
|||
If p < psq * x Then |
|||
xx = 1 - x |
|||
cx = x |
|||
pp = q |
|||
qq = p |
|||
indx = 1 |
|||
End If |
|||
Dim As Double term = 1.0 |
|||
Dim As Double ai = 1.0 |
|||
Dim As Double value = 1.0 |
|||
Dim As Integer ns = Int(qq + cx * psq) |
|||
Dim As Double rx = xx / cx |
|||
Dim As Double temp = qq - ai |
|||
If ns = 0 Then rx = xx |
|||
Do |
|||
term *= temp * rx / (pp + ai) |
|||
value += term |
|||
temp = Abs(term) |
|||
If temp <= acu And temp <= acu * value Then |
|||
value *= Exp(pp * Log(xx) + (qq - 1) * Log(cx) - lnbeta) / pp |
|||
Return Iif(indx, 1 - value, value) |
|||
End If |
|||
ai += 1 |
|||
If ns > 0 Then |
|||
ns -= 1 |
|||
temp = qq - ai |
|||
If ns = 0 Then |
|||
rx = xx |
|||
Else |
|||
temp = psq |
|||
psq += 1 |
|||
End If |
|||
End If |
|||
Loop |
|||
End Function |
|||
Sub welch_ttest(a1() As Double, a2() As Double, Byref t As Double, Byref df As Double, Byref p As Double) |
|||
Dim As Integer n1 = Ubound(a1) + 1 |
|||
Dim As Integer n2 = Ubound(a2) + 1 |
|||
If n1 <= 1 Or n2 <= 1 Then |
|||
Print "ValueError" |
|||
End |
|||
End If |
|||
Dim As Double mean1 = 0 |
|||
For i As Integer = 0 To n1 - 1 |
|||
mean1 += a1(i) |
|||
Next i |
|||
mean1 /= n1 |
|||
Dim As Double mean2 = 0 |
|||
For i As Integer = 0 To n2 - 1 |
|||
mean2 += a2(i) |
|||
Next i |
|||
mean2 /= n2 |
|||
Dim As Double var1 = 0 |
|||
For i As Integer = 0 To n1 - 1 |
|||
var1 += (a1(i) - mean1) ^ 2 |
|||
Next i |
|||
var1 /= (n1 - 1) |
|||
Dim As Double var2 = 0 |
|||
For i As Integer = 0 To n2 - 1 |
|||
var2 += (a2(i) - mean2) ^ 2 |
|||
Next i |
|||
var2 /= (n2 - 1) |
|||
t = (mean1 - mean2) / Sqr(var1 / n1 + var2 / n2) |
|||
df = (var1 / n1 + var2 / n2) ^ 2 / (var1 ^ 2 / (n1 ^ 2 * (n1 - 1)) + var2 ^ 2 / (n2 ^ 2 * (n2 - 1))) |
|||
p = betain(df / (t ^ 2 + df), df / 2, 1 / 2) |
|||
End Sub |
|||
Dim As Double a1(3) = {3, 4, 1, 2.1} |
|||
Dim As Double a2(2) = {490.2, 340, 433.9} |
|||
Dim As Double t, df, p |
|||
welch_ttest(a1(), a2(), t, df, p) |
|||
Print " t: "; t |
|||
Print "df: "; df |
|||
Print " p: "; p |
|||
Sleep</syntaxhighlight> |
|||
{{out}} |
|||
<pre> t: -9.559497721932658 |
|||
df: 2.000852348856284 |
|||
p: 0.01075155600241868</pre> |
|||
=={{header|Go}}== |
=={{header|Go}}== |
||
< |
<syntaxhighlight lang="go">package main |
||
import ( |
import ( |
||
Line 358: | Line 808: | ||
func(r float64) float64 { return math.Pow(r, ν/2-1) / math.Sqrt(1-r) }) / |
func(r float64) float64 { return math.Pow(r, ν/2-1) / math.Sqrt(1-r) }) / |
||
math.Exp(g1+g2-g3) |
math.Exp(g1+g2-g3) |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 372: | Line 822: | ||
Implementation: |
Implementation: |
||
< |
<syntaxhighlight lang="j">integrate=: adverb define |
||
'a b steps'=. 3{.y,128 |
'a b steps'=. 3{.y,128 |
||
size=. (b - a)%steps |
size=. (b - a)%steps |
||
Line 395: | Line 845: | ||
hi=. v%(t^2)+v |
hi=. v%(t^2)+v |
||
(F f. simpson integrate lo,hi) % 0.5 B v%2 |
(F f. simpson integrate lo,hi) % 0.5 B v%2 |
||
)</ |
)</syntaxhighlight> |
||
<code>integrate</code> and <code>simpson</code> are from the [[Numerical_integration#J|Numerical integration]] task. |
<code>integrate</code> and <code>simpson</code> are from the [[Numerical_integration#J|Numerical integration]] task. |
||
Line 412: | Line 862: | ||
Data for task examples: |
Data for task examples: |
||
< |
<syntaxhighlight lang="j">d1=: 27.5 21 19 23.6 17 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19 21.7 21.4 |
||
d2=: 27.1 22 20.8 23.4 23.4 23.5 25.8 22 24.8 20.2 21.9 22.1 22.9 20.5 24.4 |
d2=: 27.1 22 20.8 23.4 23.4 23.5 25.8 22 24.8 20.2 21.9 22.1 22.9 20.5 24.4 |
||
d3=: 17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8 |
d3=: 17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8 |
||
Line 421: | Line 871: | ||
d8=: 29.89 29.93 29.72 29.98 30.02 29.98 |
d8=: 29.89 29.93 29.72 29.98 30.02 29.98 |
||
d9=: 3 4 1 2.1 |
d9=: 3 4 1 2.1 |
||
da=: 490.2 340 433.9</ |
da=: 490.2 340 433.9</syntaxhighlight> |
||
Task examples: |
Task examples: |
||
< |
<syntaxhighlight lang="j"> d1 p2_tail d2 |
||
0.021378 |
0.021378 |
||
d3 p2_tail d4 |
d3 p2_tail d4 |
||
Line 433: | Line 883: | ||
0.0907733 |
0.0907733 |
||
d9 p2_tail da |
d9 p2_tail da |
||
0.0107377</ |
0.0107377</syntaxhighlight> |
||
=={{header|Java}}== |
=={{header|Java}}== |
||
Using the '''[http://commons.apache.org/proper/commons-math/ Apache Commons Mathematics Library]'''. |
Using the '''[http://commons.apache.org/proper/commons-math/ Apache Commons Mathematics Library]'''. |
||
< |
<syntaxhighlight lang="java">import org.apache.commons.math3.distribution.TDistribution; |
||
public class WelchTTest { |
public class WelchTTest { |
||
Line 486: | Line 936: | ||
System.out.println("p = " + res[2]); |
System.out.println("p = " + res[2]); |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
'''Result''' |
'''Result''' |
||
Line 494: | Line 944: | ||
t = -9.559497721932658 |
t = -9.559497721932658 |
||
df = 2.0008523488562844 |
df = 2.0008523488562844 |
||
p = 0.010751561149784485<pre> |
p = 0.010751561149784485</pre> |
||
=={{header|jq}}== |
|||
# {{trans|Wren}} |
|||
{{works with|jq}} |
|||
'''Works with gojq, the Go implementation of jq''' |
|||
Notice how jq supports the closure, f, in the same way as Wren. |
|||
jq's `lgamma` returns the natural logarithm of the absolute value of the gamma function of x. |
|||
<syntaxhighlight lang="jq">def mean: add / length; |
|||
# Sample variance using division by (length-1) |
|||
def variance: |
|||
mean as $m |
|||
| (reduce .[] as $x (0; . + (($x - $m) | .*.))) / (length-1) ; |
|||
def welch(a; b): |
|||
((a|mean) - (b|mean)) / |
|||
(((a|variance/length) + (b|variance/length)) | sqrt) ; |
|||
def dof(a; b): |
|||
(a|variance) as $sva |
|||
| (b|variance) as $svb |
|||
| (a|length) as $la |
|||
| (b|length) as $lb |
|||
| ($sva/$la + $svb/$lb) as $n |
|||
| $n * $n / ($sva*$sva/($la*$la*($la-1)) + $svb*$svb/($lb*$lb*($lb-1))) ; |
|||
def simpson0(nf; upper; filter): |
|||
(upper/nf) as $dx0 |
|||
| {sum: (( (0|filter) + ($dx0 * 0.5|filter) * 4) * $dx0), |
|||
x0: $dx0 } |
|||
| reduce range(1; nf) as $i (.; |
|||
( ($i + 1) * upper / nf ) as $x1 |
|||
| ((.x0 + $x1) * 0.5) as $xmid |
|||
| ($x1 - .x0) as $dx |
|||
| .sum = .sum + ((.x0|filter)*2 + ($xmid|filter)*4) * $dx |
|||
| .x0 = $x1) |
|||
| (.sum + (upper|filter)*$dx0) / 6 ; |
|||
def pValue(a; b): |
|||
dof(a; b) as $nu |
|||
| def f: |
|||
. as $r |
|||
| pow($r; ($nu/2) - 1) / ((1 - $r)|sqrt); |
|||
welch(a; b) as $t |
|||
| (($nu/2)|lgamma) as $g1 |
|||
| (0.5|lgamma) as $g2 |
|||
| (($nu/2 + 0.5)|lgamma) as $g3 |
|||
| simpson0(2000; $nu/($t*$t + $nu); f) / (($g1 + $g2 - $g3)|exp) ; |
|||
def d1: [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4]; |
|||
def d2: [27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, 21.9, 22.1, 22.9, 20.5, 24.4]; |
|||
def d3: [17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8]; |
|||
def d4: [21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, 20.7, 21.7, 21.5, 22.5, 23.6, |
|||
21.5, 22.5, 23.5, 21.5, 21.8]; |
|||
def d5: [19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0]; |
|||
def d6: [28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, 23.2, 17.5, 20.6, 18.0, 23.9, |
|||
21.6, 24.3, 20.4, 24.0, 13.2]; |
|||
def d7: [30.02, 29.99, 30.11, 29.97, 30.01, 29.99]; |
|||
def d8: [29.89, 29.93, 29.72, 29.98, 30.02, 29.98]; |
|||
def x : [3.0, 4.0, 1.0, 2.1]; |
|||
def y : [490.2, 340.0, 433.9]; |
|||
pValue(d1; d2), |
|||
pValue(d3; d4), |
|||
pValue(d5; d6), |
|||
pValue(d7; d8), |
|||
pValue(x; y)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
0.02137800146288292 |
|||
0.1488416966053347 |
|||
0.03597227102982764 |
|||
0.09077332428566065 |
|||
0.010750673736239608 |
|||
</pre> |
|||
=={{header|Julia}}== |
=={{header|Julia}}== |
||
{{works with|Julia|0.6}} |
{{works with|Julia|0.6}} |
||
< |
<syntaxhighlight lang="julia">using HypothesisTests |
||
d1 = [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4] |
d1 = [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4] |
||
Line 519: | Line 1,048: | ||
ttest = UnequalVarianceTTest(y1, y2) |
ttest = UnequalVarianceTTest(y1, y2) |
||
println("\nData:\n y1 = $y1\n y2 = $y2\nP-value for unequal variance TTest: ", round(pvalue(ttest), 4)) |
println("\nData:\n y1 = $y1\n y2 = $y2\nP-value for unequal variance TTest: ", round(pvalue(ttest), 4)) |
||
end</ |
end</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 551: | Line 1,080: | ||
=={{header|Kotlin}}== |
=={{header|Kotlin}}== |
||
This program brings in code from other tasks for gamma functions and integration by Simpson's rule as Kotlin doesn't have these built-in: |
This program brings in code from other tasks for gamma functions and integration by Simpson's rule as Kotlin doesn't have these built-in: |
||
< |
<syntaxhighlight lang="scala">// version 1.1.4-3 |
||
typealias Func = (Double) -> Double |
typealias Func = (Double) -> Double |
||
Line 656: | Line 1,185: | ||
println(f.format(p2Tail(da7, da8))) |
println(f.format(p2Tail(da7, da8))) |
||
println(f.format(p2Tail(x, y))) |
println(f.format(p2Tail(x, y))) |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 666: | Line 1,195: | ||
0.010751 |
0.010751 |
||
</pre> |
</pre> |
||
=={{header|Nim}}== |
|||
{{trans|Kotlin}} |
|||
<syntaxhighlight lang="nim">import math, stats, strutils, sugar |
|||
func sqr(f: float): float = f * f |
|||
func degreesFreedom(da1, da2: openArray[float]): float = |
|||
let s1 = varianceS(da1) |
|||
let s2 = varianceS(da2) |
|||
let n1 = da1.len.toFloat |
|||
let n2 = da2.len.toFloat |
|||
let n = sqr(s1 / n1 + s2 / n2) |
|||
let d = sqr(s1) / (n1 * n1 * (n1 - 1)) + sqr(s2) / (n2 * n2 * (n2 - 1)) |
|||
result = n / d |
|||
func welch(da1, da2: openArray[float]): float = |
|||
let f = varianceS(da1) / da1.len.toFloat + varianceS(da2) / da2.len.toFloat |
|||
result = (mean(da1) - mean(da2)) / sqrt(f) |
|||
func simpson(a, b: float; n: int; f: float -> float): float = |
|||
let h = (b - a) / n.toFloat |
|||
var sum = 0.0 |
|||
for i in 0..<n: |
|||
let x = a + i.toFloat * h |
|||
sum += (f(x) + 4 * f(x + h / 2) + f(x + h)) / 6 |
|||
result = sum * h |
|||
func p2Tail(da1, da2: openArray[float]): float = |
|||
let ν = degreesFreedom(da1, da2) |
|||
let t = welch(da1, da2) |
|||
let g = exp(lGamma(ν / 2) + lGamma(0.5) - lGamma(ν / 2 + 0.5)) |
|||
let b = ν / (t * t + ν) |
|||
proc f(r: float): float = pow(r, ν / 2 - 1) / sqrt(1 - r) |
|||
result = simpson(0, b, 10000, f) / g # n = 10000 seems more than enough here. |
|||
when isMainModule: |
|||
const |
|||
Da1 = [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, |
|||
23.1, 19.6, 19.0, 21.7, 21.4] |
|||
Da2 = [27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, |
|||
21.9, 22.1, 22.9, 20.5, 24.4] |
|||
Da3 = [17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8] |
|||
Da4 = [21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, |
|||
20.7, 21.7, 21.5, 22.5, 23.6, 21.5, 22.5, 23.5, 21.5, 21.8] |
|||
Da5 = [19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0] |
|||
Da6 = [28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, |
|||
23.2, 17.5, 20.6, 18.0, 23.9, 21.6, 24.3, 20.4, 24.0, 13.2] |
|||
Da7 = [30.02, 29.99, 30.11, 29.97, 30.01, 29.99] |
|||
Da8 = [29.89, 29.93, 29.72, 29.98, 30.02, 29.98] |
|||
X = [3.0, 4.0, 1.0, 2.1] |
|||
Y = [490.2, 340.0, 433.9] |
|||
echo p2Tail(Da1, Da2).formatFloat(ffDecimal, 6) |
|||
echo p2Tail(Da3, Da4).formatFloat(ffDecimal, 6) |
|||
echo p2Tail(Da5, Da6).formatFloat(ffDecimal, 6) |
|||
echo p2Tail(Da7, Da8).formatFloat(ffDecimal, 6) |
|||
echo p2Tail(X, Y).formatFloat(ffDecimal, 6)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>0.021378 |
|||
0.148842 |
|||
0.035972 |
|||
0.090773 |
|||
0.010751</pre> |
|||
=={{header|Maple}}== |
|||
<syntaxhighlight lang="maple">WelschTTest:=proc(x::list(numeric),y::list(numeric)) |
|||
uses Statistics; |
|||
local n1:=nops(x),n2:=nops(y), |
|||
m1:=Mean(x),m2:=Mean(y), |
|||
v1:=Variance(x),v2:=Variance(y), |
|||
t,nu,p; |
|||
t:=(m1-m2)/sqrt(v1/n1+v2/n2); |
|||
nu:=(v1/n1+v2/n2)^2/(v1^2/(n1^2*(n1-1))+v2^2/(n2^2*(n2-1))); |
|||
p:=2*CDF(StudentTDistribution(nu),-abs(t)); |
|||
t,nu,p |
|||
end proc: |
|||
x:=[3,4,1,2.1]: |
|||
y:=[490.2,340,433.9]: |
|||
WelschTTest(x,y); |
|||
# -9.55949772193266, 2.00085234885628, 0.0107515611497845</syntaxhighlight> |
|||
=={{header|Octave}}== |
=={{header|Octave}}== |
||
{{trans|Stata}} |
{{trans|Stata}} |
||
< |
<syntaxhighlight lang="octave">x = [3.0,4.0,1.0,2.1]; |
||
y = [490.2,340.0,433.9]; |
y = [490.2,340.0,433.9]; |
||
n1 = length(x); |
n1 = length(x); |
||
Line 682: | Line 1,298: | ||
ans = |
ans = |
||
-9.559498 2.000852 0.010752</ |
-9.559498 2.000852 0.010752</syntaxhighlight> |
||
=={{header|PARI/GP}}== |
|||
<syntaxhighlight lang="parigp">B2(x,y)=exp(lngamma(x)+lngamma(y)-lngamma(x+y)) |
|||
B3(x,a,b)=a--;b--;intnum(r=0,x,r^a*(1-r)^b) |
|||
Welch2(u,v)=my(m1=vecsum(u)/#u, m2=vecsum(v)/#v, v1=var(u,m1), v2=var(v,m2), s=v1/#u+v2/#v, t=(m1-m2)/sqrt(s), nu=s^2/(v1^2/#u^2/(#u-1)+v2^2/#v^2/(#v-1))); B3(nu/(t^2+nu),nu/2,1/2)/B2(nu/2,1/2); |
|||
Welch2([3,4,1,2.1], [490.2,340,433.9])</syntaxhighlight> |
|||
{{out}} |
|||
<pre>%1 = 0.010751561149784496723954539777213062928</pre> |
|||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
=== Using Math::AnyNum === |
|||
Uses Math::AnyNum for gamma and pi. It is possible to use some other modules (e.g. Math::Cephes) if Math::AnyNum has problematic dependencies. |
|||
{{trans|Sidef}} |
{{trans|Sidef}} |
||
< |
<syntaxhighlight lang="perl">use utf8; |
||
use List::Util qw(sum); |
use List::Util qw(sum); |
||
use Math::AnyNum qw(gamma pi); |
use Math::AnyNum qw(gamma pi); |
||
sub p_value ($$) { |
sub p_value :prototype($$) { |
||
my ($A, $B) = @_; |
my ($A, $B) = @_; |
||
Line 746: | Line 1,372: | ||
my ($left, $right) = splice(@tests, 0, 2); |
my ($left, $right) = splice(@tests, 0, 2); |
||
print p_value($left, $right), "\n"; |
print p_value($left, $right), "\n"; |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 756: | Line 1,382: | ||
</pre> |
</pre> |
||
=== Using Burkhardt's 'incomplete beta' === |
|||
=={{header|Perl 6}}== |
|||
We use a slightly more accurate lgamma than the C code. Note that Perl can be compiled with different underlying floating point representations -- double, long double, or quad double. |
|||
{{works with|Rakudo|2017.08}} |
|||
{{trans|C}} |
{{trans|C}} |
||
<syntaxhighlight lang="perl">use strict; |
|||
Perhaps "inspired by C example" may be more accurate. Gamma subroutine from [[Gamma_function#Perl_6 |Gamma function task]]. |
|||
use warnings; |
|||
use List::Util 'sum'; |
|||
sub lgamma { |
|||
my $x = shift; |
|||
my $log_sqrt_two_pi = 0.91893853320467274178; |
|||
z < .5 ?? π / sin(π * z) / Γ(1 - z) !! |
|||
my @lanczos_coef = ( |
|||
τ.sqrt * (z + g - 1/2)**(z - 1/2) * |
|||
0.99999999999980993, 676.5203681218851, -1259.1392167224028, |
|||
exp(-(z + g - 1/2)) * |
|||
771.32342877765313, -176.61502916214059, 12.507343278686905, |
|||
[+] < |
|||
-0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7 ); |
|||
1.000000000000000174663 |
|||
my $base = $x + 7.5; |
|||
5716.400188274341379136 |
|||
my $sum = 0; |
|||
-14815.30426768413909044 |
|||
$sum += $lanczos_coef[$_] / ($x + $_) for reverse (1..8); |
|||
14291.49277657478554025 |
|||
$sum += $lanczos_coef[0]; |
|||
-6348.160217641458813289 |
|||
$sum = $log_sqrt_two_pi + log($sum/$x) + ( ($x+0.5)*log($base) - $base ); |
|||
1301.608286058321874105 |
|||
$sum; |
|||
-108.1767053514369634679 |
|||
2.605696505611755827729 |
|||
-0.7423452510201416151527e-2 |
|||
0.5384136432509564062961e-7 |
|||
-0.4023533141268236372067e-8 |
|||
> Z* 1, |map 1/(z + *), 0..* |
|||
} |
} |
||
sub |
sub calculate_P_value { |
||
my ($array1,$array2) = (shift, shift); |
|||
return 1 if @A <= 1 or @B <= 1; |
|||
return 1 if @$array1 <= 1 or @$array2 <= 1; |
|||
my $ |
my $mean1 = sum(@$array1); |
||
my $ |
my $mean2 = sum(@$array2); |
||
$mean1 /= scalar @$array1; |
|||
my $a-variance = @A.map( { ($a-mean - $_)² } ).sum / (@A - 1); |
|||
$mean2 /= scalar @$array2; |
|||
my $b-variance = @B.map( { ($b-mean - $_)² } ).sum / (@B - 1); |
|||
return 1 |
return 1 if $mean1 == $mean2; |
||
my ($variance1,$variance2); |
|||
$variance1 += ($mean1-$_)**2 for @$array1; |
|||
$variance2 += ($mean2-$_)**2 for @$array2; |
|||
return 1 if $variance1 == 0 and $variance2 == 0; |
|||
$variance1 = $variance1/(@$array1-1); |
|||
$variance2 = $variance2/(@$array2-1); |
|||
my $Welch_t_statistic = ($mean1-$mean2)/sqrt($variance1/@$array1+$variance2/@$array2); |
|||
my $DoF = (($variance1/@$array1+$variance2/@$array2)**2) / |
|||
( |
|||
($variance1*$variance1)/(@$array1*@$array1*(@$array1-1)) + |
|||
($variance2*$variance2)/(@$array2*@$array2*(@$array2-1)) |
|||
); |
|||
my $A = $DoF / 2; |
|||
my $value = $DoF / ($Welch_t_statistic**2 + $DoF); |
|||
return $value if $A <= 0 or $value <= 0 or 1 <= $value; |
|||
# from here, translation of John Burkhardt's C code |
|||
my \Welsh-𝒕-statistic = ($a-mean - $b-mean)/($a-variance/@A + $b-variance/@B).sqrt; |
|||
my $beta = lgamma($A) + 0.57236494292470009 - lgamma($A+0.5); # constant is lgamma(.5), but more precise than 'lgamma' routine |
|||
my $eps = 10**-15; |
|||
my($ai,$cx,$indx,$ns,$pp,$psq,$qq,$qq_ai,$rx,$term,$xx); |
|||
$psq = $A + 0.5; |
|||
$cx = 1 - $value; |
|||
if ($A < $psq * $value) { ($xx, $cx, $pp, $qq, $indx) = ($cx, $value, 0.5, $A, 1) } |
|||
else { ($xx, $pp, $qq, $indx) = ($value, $A, 0.5, 0) } |
|||
$term = $ai = $value = 1; |
|||
$ns = int $qq + $cx * $psq; |
|||
# Soper reduction formula |
|||
my $DoF = ($a-variance / @A + $b-variance / @B)² / |
|||
$qq_ai = $qq - $ai; |
|||
(($a-variance² / (@A³ - @A²)) + ($b-variance² / (@B³ - @B²))); |
|||
$rx = $ns == 0 ? $xx : $xx / $cx; |
|||
while (1) { |
|||
$term = $term * $qq_ai * $rx / ( $pp + $ai ); |
|||
$value = $value + $term; |
|||
$qq_ai = abs($term); |
|||
if ($qq_ai <= $eps && $qq_ai <= $eps * $value) { |
|||
$value = $value * exp ($pp * log($xx) + ($qq - 1) * log($cx) - $beta) / $pp; |
|||
$value = 1 - $value if $indx; |
|||
last; |
|||
} |
|||
$ai++; |
|||
$ns--; |
|||
if ($ns >= 0) { |
|||
$qq_ai = $qq - $ai; |
|||
$rx = $xx if $ns == 0; |
|||
} else { |
|||
$qq_ai = $psq; |
|||
$psq = $psq + 1; |
|||
} |
|||
} |
|||
$value |
|||
} |
|||
my @answers = ( |
|||
my $sa = $DoF / 2 - 1; |
|||
0.021378001462867, |
|||
my $x = $DoF / (Welsh-𝒕-statistic² + $DoF); |
|||
0.148841696605327, |
|||
my $N = 65355; |
|||
0.0359722710297968, |
|||
my $h = $x / $N; |
|||
0.090773324285671, |
|||
my ( $sum1, $sum2 ); |
|||
0.0107515611497845, |
|||
0.00339907162713746, |
|||
0.52726574965384, |
|||
0.545266866977794, |
|||
); |
|||
my @tests = ( |
|||
for ^$N »*» $h -> $i { |
|||
[27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4], |
|||
$sum1 += (($i + $h / 2) ** $sa) / (1 - ($i + $h / 2)).sqrt; |
|||
[27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4], |
|||
$sum2 += $i ** $sa / (1 - $i).sqrt; |
|||
} |
|||
[17.2,20.9,22.6,18.1,21.7,21.4,23.5,24.2,14.7,21.8], |
|||
(($h / 6) * ( $x ** $sa / (1 - $x).sqrt + 4 * $sum1 + 2 * $sum2)) / |
|||
[21.5,22.8,21.0,23.0,21.6,23.6,22.5,20.7,23.4,21.8,20.7,21.7,21.5,22.5,23.6,21.5,22.5,23.5,21.5,21.8], |
|||
( Γ($sa + 1) * π.sqrt / Γ($sa + 1.5) ); |
|||
} |
|||
[19.8,20.4,19.6,17.8,18.5,18.9,18.3,18.9,19.5,22.0], |
|||
# Testing |
|||
[28.2,26.6,20.1,23.3,25.2,22.1,17.7,27.6,20.6,13.7,23.2,17.5,20.6,18.0,23.9,21.6,24.3,20.4,24.0,13.2], |
|||
for ( |
|||
[<27.5 21.0 19.0 23.6 17.0 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19.0 21.7 21.4>], |
|||
[<27.1 22.0 20.8 23.4 23.4 23.5 25.8 22.0 24.8 20.2 21.9 22.1 22.9 20.5 24.4>], |
|||
[30.02,29.99,30.11,29.97,30.01,29.99], |
|||
[<17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8>], |
|||
[29.89,29.93,29.72,29.98,30.02,29.98], |
|||
[<21.5 22.8 21.0 23.0 21.6 23.6 22.5 20.7 23.4 21.8 20.7 21.7 21.5 22.5 23.6 21.5 22.5 23.5 21.5 21.8>], |
|||
[3.0,4.0,1.0,2.1], |
|||
[<19.8 20.4 19.6 17.8 18.5 18.9 18.3 18.9 19.5 22.0>], |
|||
[490.2,340.0,433.9], |
|||
[<28.2 26.6 20.1 23.3 25.2 22.1 17.7 27.6 20.6 13.7 23.2 17.5 20.6 18.0 23.9 21.6 24.3 20.4 24.0 13.2>], |
|||
[0.010268,0.000167,0.000167], |
|||
[<30.02 29.99 30.11 29.97 30.01 29.99>], |
|||
[0.159258,0.136278,0.122389], |
|||
[<29.89 29.93 29.72 29.98 30.02 29.98>], |
|||
[ |
[1.0/15,10.0/62.0], |
||
[ |
[1.0/10,2/50.0], |
||
) -> @left, @right { say p-value @left, @right }</lang> |
|||
[9/23.0,21/45.0,0/38.0], |
|||
[0/44.0,42/94.0,0/22.0], |
|||
); |
|||
my $error = 0; |
|||
while (@tests) { |
|||
my ($left, $right) = splice(@tests, 0, 2); |
|||
my $pvalue = calculate_P_value($left,$right); |
|||
$error += abs($pvalue - shift @answers); |
|||
printf("p-value = %.14g\n",$pvalue); |
|||
} |
|||
printf("cumulative error is %g\n", $error);</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre>0. |
<pre>p-value = 0.021378001462867 |
||
p-value = 0.14884169660533 |
|||
0.148841696605328 |
|||
p-value = 0.035972271029797 |
|||
0.0359722710297969 |
|||
p-value = 0.090773324285661 |
|||
0.0907733242856673 |
|||
p-value = 0.010751561149784 |
|||
0.010751534033393 |
|||
p-value = 0.0033990716271375 |
|||
p-value = 0.52726574965384 |
|||
p-value = 0.54526686697779 |
|||
cumulative error is 1.11139e-14</pre> |
|||
=={{header|Phix}}== |
|||
{{trans|Go}} |
|||
{{trans|Kotlin}} |
|||
<!--<syntaxhighlight lang="phix">(phixonline)--> |
|||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">mean</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">/</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">sv</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">integer</span> <span style="color: #000000;">la</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">m</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">mean</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">tot</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">0</span> |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">la</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">d</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">m</span> |
|||
<span style="color: #000000;">tot</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">d</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">d</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">tot</span> <span style="color: #0000FF;">/</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">la</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">welch</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">integer</span> <span style="color: #000000;">la</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">lb</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">mean</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">mean</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">))</span> <span style="color: #0000FF;">/</span> <span style="color: #7060A8;">sqrt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sv</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">la</span><span style="color: #0000FF;">+</span><span style="color: #000000;">sv</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">lb</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">dof</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">integer</span> <span style="color: #000000;">la</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">lb</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">sva</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">sv</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">svb</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">sv</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">n</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">sva</span><span style="color: #0000FF;">/</span><span style="color: #000000;">la</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">svb</span><span style="color: #0000FF;">/</span><span style="color: #000000;">lb</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">/</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">sva</span><span style="color: #0000FF;">*</span><span style="color: #000000;">sva</span><span style="color: #0000FF;">/(</span><span style="color: #000000;">la</span><span style="color: #0000FF;">*</span><span style="color: #000000;">la</span><span style="color: #0000FF;">*(</span><span style="color: #000000;">la</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">))</span> <span style="color: #0000FF;">+</span> |
|||
<span style="color: #000000;">svb</span><span style="color: #0000FF;">*</span><span style="color: #000000;">svb</span><span style="color: #0000FF;">/(</span><span style="color: #000000;">lb</span><span style="color: #0000FF;">*</span><span style="color: #000000;">lb</span><span style="color: #0000FF;">*(</span><span style="color: #000000;">lb</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)))</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">r</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">v</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #7060A8;">power</span><span style="color: #0000FF;">(</span><span style="color: #000000;">r</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">v</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">/</span> <span style="color: #7060A8;">sqrt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">-</span><span style="color: #000000;">r</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">simpson0</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">atom</span> <span style="color: #000000;">high</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">v</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">tot</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">dx0</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">high</span> <span style="color: #0000FF;">/</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">x0</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">dx0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">x1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">xmid</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">dx</span> |
|||
<span style="color: #000000;">tot</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">dx0</span> |
|||
<span style="color: #000000;">tot</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dx0</span><span style="color: #0000FF;">*.</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">dx0</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">4</span> |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #000000;">x1</span> <span style="color: #0000FF;">:=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">high</span> <span style="color: #0000FF;">/</span> <span style="color: #000000;">n</span> |
|||
<span style="color: #000000;">xmid</span> <span style="color: #0000FF;">:=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">x0</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">x1</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">*</span> <span style="color: #0000FF;">.</span><span style="color: #000000;">5</span> |
|||
<span style="color: #000000;">dx</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">x1</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">x0</span> |
|||
<span style="color: #000000;">tot</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">dx</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">2</span> |
|||
<span style="color: #000000;">tot</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xmid</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">dx</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">4</span> |
|||
<span style="color: #000000;">x0</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">x1</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">tot</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">(</span><span style="color: #000000;">high</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">)*</span><span style="color: #000000;">dx0</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">/</span> <span style="color: #000000;">6</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">constant</span> <span style="color: #000000;">p</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span> |
|||
<span style="color: #000000;">0.99999999999980993</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">676.5203681218851</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #0000FF;">-</span><span style="color: #000000;">1259.1392167224028</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">771.32342877765313</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #0000FF;">-</span><span style="color: #000000;">176.61502916214059</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">12.507343278686905</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #0000FF;">-</span><span style="color: #000000;">0.13857109526572012</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">9.9843695780195716e-6</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">1.5056327351493116e-7</span> |
|||
<span style="color: #0000FF;">}</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">gamma</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">d</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">dd</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">d</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">g</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">7</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">dd</span><span style="color: #0000FF;"><</span><span style="color: #000000;">0.5</span> <span style="color: #008080;">then</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #004600;">PI</span> <span style="color: #0000FF;">/</span> <span style="color: #0000FF;">(</span><span style="color: #7060A8;">sin</span><span style="color: #0000FF;">(</span><span style="color: #004600;">PI</span><span style="color: #0000FF;">*</span><span style="color: #000000;">dd</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">gamma</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">-</span><span style="color: #000000;">dd</span><span style="color: #0000FF;">))</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<span style="color: #000000;">dd</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">a</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">],</span> |
|||
<span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">dd</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">g</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">0.5</span> |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> <span style="color: #000000;">a</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">/</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">dd</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">i</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #7060A8;">sqrt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">2</span><span style="color: #0000FF;">*</span><span style="color: #004600;">PI</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">*</span> <span style="color: #7060A8;">power</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">dd</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">0.5</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">*</span> <span style="color: #7060A8;">exp</span><span style="color: #0000FF;">(-</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">a</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">lGamma</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">d</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #7060A8;">log</span><span style="color: #0000FF;">(</span><span style="color: #000000;">gamma</span><span style="color: #0000FF;">(</span><span style="color: #000000;">d</span><span style="color: #0000FF;">))</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">pValue</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">ab</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">sequence</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ab</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">v</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">dof</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">t</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">welch</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">g1</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">lGamma</span><span style="color: #0000FF;">(</span><span style="color: #000000;">v</span> <span style="color: #0000FF;">/</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">g2</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">lGamma</span><span style="color: #0000FF;">(.</span><span style="color: #000000;">5</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">g3</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">lGamma</span><span style="color: #0000FF;">(</span><span style="color: #000000;">v</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span> <span style="color: #0000FF;">+</span> <span style="color: #0000FF;">.</span><span style="color: #000000;">5</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">simpson0</span><span style="color: #0000FF;">(</span><span style="color: #000000;">2000</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">v</span><span style="color: #0000FF;">/(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">*</span><span style="color: #000000;">t</span><span style="color: #0000FF;">+</span><span style="color: #000000;">v</span><span style="color: #0000FF;">),</span> <span style="color: #000000;">v</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">/</span> <span style="color: #7060A8;">exp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">g1</span><span style="color: #0000FF;">+</span><span style="color: #000000;">g2</span><span style="color: #0000FF;">-</span><span style="color: #000000;">g3</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">constant</span> <span style="color: #000000;">tests</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{{</span><span style="color: #000000;">27.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">19.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">16.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">19.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">19.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.4</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">27.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">25.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">24.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">24.4</span><span style="color: #0000FF;">}},</span> |
|||
<span style="color: #0000FF;">{{</span><span style="color: #000000;">17.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">24.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">14.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.8</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">21.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.8</span><span style="color: #0000FF;">}},</span> |
|||
<span style="color: #0000FF;">{{</span><span style="color: #000000;">19.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">19.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">19.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.0</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">28.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">26.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">25.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">27.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">13.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">24.3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">24.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">13.2</span><span style="color: #0000FF;">}},</span> |
|||
<span style="color: #0000FF;">{{</span><span style="color: #000000;">30.02</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.99</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">30.11</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.97</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">30.01</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.99</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">29.89</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.93</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.72</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.98</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">30.02</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.98</span><span style="color: #0000FF;">}},</span> |
|||
<span style="color: #0000FF;">{{</span><span style="color: #000000;">3.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2.1</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">490.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">340.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">433.9</span><span style="color: #0000FF;">}}</span> |
|||
<span style="color: #0000FF;">}</span> |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">pValue</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
<!--</syntaxhighlight>--> |
|||
{{out}} |
|||
<pre> |
|||
0.0213780015 |
|||
0.1488416966 |
|||
0.035972271 |
|||
0.0907733243 |
|||
0.0107506737 |
|||
</pre> |
|||
{{trans|Python}} |
|||
The above was a bit off on the fifth test, so I also tried this.<br> |
|||
using gamma() from [[Gamma_function#Phix]] (the one from above is probably also fine, but I didn't test that) |
|||
<!--<syntaxhighlight lang="phix">(phixonline)--> |
|||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span> |
|||
<span style="color: #000080;font-style:italic;">--<copy of gamma from Gamma_function#Phix></span> |
|||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">c</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">12</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">gamma</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">z</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">accm</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">c</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">accm</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> |
|||
<span style="color: #000000;">accm</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sqrt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">2</span><span style="color: #0000FF;">*</span><span style="color: #004600;">PI</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #000000;">c</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">accm</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">k1_factrl</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span> <span style="color: #000080;font-style:italic;">-- (k - 1)!*(-1)^k with 0!==1</span> |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #000000;">12</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #000000;">c</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">exp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">13</span><span style="color: #0000FF;">-</span><span style="color: #000000;">k</span><span style="color: #0000FF;">)*</span><span style="color: #7060A8;">power</span><span style="color: #0000FF;">(</span><span style="color: #000000;">13</span><span style="color: #0000FF;">-</span><span style="color: #000000;">k</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1.5</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">k1_factrl</span> |
|||
<span style="color: #000000;">k1_factrl</span> <span style="color: #0000FF;">*=</span> <span style="color: #0000FF;">-(</span><span style="color: #000000;">k</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #000000;">12</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #000000;">accm</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">c</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]/(</span><span style="color: #000000;">z</span><span style="color: #0000FF;">+</span><span style="color: #000000;">k</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
<span style="color: #000000;">accm</span> <span style="color: #0000FF;">*=</span> <span style="color: #7060A8;">exp</span><span style="color: #0000FF;">(-(</span><span style="color: #000000;">z</span><span style="color: #0000FF;">+</span><span style="color: #000000;">12</span><span style="color: #0000FF;">))*</span><span style="color: #7060A8;">power</span><span style="color: #0000FF;">(</span><span style="color: #000000;">z</span><span style="color: #0000FF;">+</span><span style="color: #000000;">12</span><span style="color: #0000FF;">,</span><span style="color: #000000;">z</span><span style="color: #0000FF;">+</span><span style="color: #000000;">0.5</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- Gamma(z+1)</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">accm</span><span style="color: #0000FF;">/</span><span style="color: #000000;">z</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #000080;font-style:italic;">--</copy of gamma></span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">lgamma</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">d</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #7060A8;">log</span><span style="color: #0000FF;">(</span><span style="color: #000000;">gamma</span><span style="color: #0000FF;">(</span><span style="color: #000000;">d</span><span style="color: #0000FF;">))</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">betain</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">q</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">p</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">0</span> <span style="color: #008080;">or</span> <span style="color: #000000;">q</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">0</span> <span style="color: #008080;">or</span> <span style="color: #000000;">x</span><span style="color: #0000FF;"><</span><span style="color: #000000;">0</span> <span style="color: #008080;">or</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">></span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">x</span> <span style="color: #0000FF;">==</span> <span style="color: #000000;">0</span> <span style="color: #008080;">or</span> <span style="color: #000000;">x</span> <span style="color: #0000FF;">==</span> <span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #000000;">x</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">acu</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1e-15</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">lnbeta</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">lgamma</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">lgamma</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">lgamma</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">q</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">psq</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">p</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">q</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">cx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">-</span><span style="color: #000000;">x</span> |
|||
<span style="color: #004080;">bool</span> <span style="color: #000000;">indx</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;"><</span><span style="color: #000000;">psq</span><span style="color: #0000FF;">*</span><span style="color: #000000;">x</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">indx</span> <span style="color: #008080;">then</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">cx</span><span style="color: #0000FF;">,</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">p</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">-</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q</span><span style="color: #0000FF;">,</span><span style="color: #000000;">p</span><span style="color: #0000FF;">}</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">term</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">ai</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">val</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">ns</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">q</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">cx</span><span style="color: #0000FF;">*</span><span style="color: #000000;">psq</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">rx</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ns</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">?</span><span style="color: #000000;">x</span><span style="color: #0000FF;">:</span><span style="color: #000000;">x</span><span style="color: #0000FF;">/</span><span style="color: #000000;">cx</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">temp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">q</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">ai</span> |
|||
<span style="color: #008080;">while</span> <span style="color: #004600;">true</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #000000;">term</span> <span style="color: #0000FF;">*=</span> <span style="color: #000000;">temp</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">rx</span> <span style="color: #0000FF;">/</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">p</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">ai</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #000000;">val</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">term</span> |
|||
<span style="color: #000000;">temp</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">abs</span><span style="color: #0000FF;">(</span><span style="color: #000000;">term</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">temp</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">acu</span> <span style="color: #008080;">and</span> <span style="color: #000000;">temp</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">acu</span><span style="color: #0000FF;">*</span><span style="color: #000000;">val</span> <span style="color: #008080;">then</span> |
|||
<span style="color: #000000;">val</span> <span style="color: #0000FF;">*=</span> <span style="color: #7060A8;">exp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">*</span><span style="color: #7060A8;">log</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">+</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">q</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)*</span><span style="color: #7060A8;">log</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cx</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">lnbeta</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">/</span> <span style="color: #000000;">p</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">indx</span><span style="color: #0000FF;">?</span><span style="color: #000000;">1</span><span style="color: #0000FF;">-</span><span style="color: #000000;">val</span><span style="color: #0000FF;">:</span><span style="color: #000000;">val</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<span style="color: #000000;">ai</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span> |
|||
<span style="color: #000000;">ns</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">ns</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> |
|||
<span style="color: #000000;">temp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">q</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">ai</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">ns</span> <span style="color: #0000FF;">==</span> <span style="color: #000000;">0</span> <span style="color: #008080;">then</span> |
|||
<span style="color: #000000;">rx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">x</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<span style="color: #008080;">else</span> |
|||
<span style="color: #000000;">temp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">psq</span> |
|||
<span style="color: #000000;">psq</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">welch_ttest</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">ab</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">sequence</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ab</span> |
|||
<span style="color: #004080;">integer</span> <span style="color: #000000;">la</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">lb</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">ma</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">la</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">mb</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">lb</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">va</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sq_power</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sq_sub</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ma</span><span style="color: #0000FF;">),</span><span style="color: #000000;">2</span><span style="color: #0000FF;">))/(</span><span style="color: #000000;">la</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">vb</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sq_power</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sq_sub</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mb</span><span style="color: #0000FF;">),</span><span style="color: #000000;">2</span><span style="color: #0000FF;">))/(</span><span style="color: #000000;">lb</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">va</span><span style="color: #0000FF;">/</span><span style="color: #000000;">la</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">vb</span><span style="color: #0000FF;">/</span><span style="color: #000000;">lb</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">ma</span><span style="color: #0000FF;">-</span><span style="color: #000000;">mb</span><span style="color: #0000FF;">)/</span><span style="color: #7060A8;">sqrt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">),</span> |
|||
<span style="color: #000000;">df</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">*</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">/</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">va</span><span style="color: #0000FF;">*</span><span style="color: #000000;">va</span><span style="color: #0000FF;">/(</span><span style="color: #000000;">la</span><span style="color: #0000FF;">*</span><span style="color: #000000;">la</span><span style="color: #0000FF;">*(</span><span style="color: #000000;">la</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">))</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">vb</span><span style="color: #0000FF;">*</span><span style="color: #000000;">vb</span><span style="color: #0000FF;">/(</span><span style="color: #000000;">lb</span><span style="color: #0000FF;">*</span><span style="color: #000000;">lb</span><span style="color: #0000FF;">*(</span><span style="color: #000000;">lb</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)))</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">betain</span><span style="color: #0000FF;">(</span><span style="color: #000000;">df</span><span style="color: #0000FF;">/(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">*</span><span style="color: #000000;">t</span><span style="color: #0000FF;">+</span><span style="color: #000000;">df</span><span style="color: #0000FF;">),</span> <span style="color: #000000;">df</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">constant</span> <span style="color: #000000;">tests</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{{</span><span style="color: #000000;">27.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">19.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">16.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">19.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">19.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.4</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">27.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">25.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">24.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">24.4</span><span style="color: #0000FF;">}},</span> |
|||
<span style="color: #0000FF;">{{</span><span style="color: #000000;">17.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">24.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">14.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.8</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">21.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.8</span><span style="color: #0000FF;">}},</span> |
|||
<span style="color: #0000FF;">{{</span><span style="color: #000000;">19.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">19.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17.8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">19.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.0</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">28.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">26.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">25.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">22.1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">27.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">13.7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17.5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">18.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">21.6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">24.3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20.4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">24.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">13.2</span><span style="color: #0000FF;">}},</span> |
|||
<span style="color: #0000FF;">{{</span><span style="color: #000000;">30.02</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.99</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">30.11</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.97</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">30.01</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.99</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">29.89</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.93</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.72</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.98</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">30.02</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">29.98</span><span style="color: #0000FF;">}},</span> |
|||
<span style="color: #0000FF;">{{</span><span style="color: #000000;">3.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2.1</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">490.2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">340.0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">433.9</span><span style="color: #0000FF;">}},</span> |
|||
<span style="color: #0000FF;">{{</span><span style="color: #000000;">0.010268</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0.000167</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0.000167</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">0.159258</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0.136278</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0.122389</span><span style="color: #0000FF;">}},</span> |
|||
<span style="color: #0000FF;">{{</span><span style="color: #000000;">1.0</span><span style="color: #0000FF;">/</span><span style="color: #000000;">15</span><span style="color: #0000FF;">,</span><span style="color: #000000;">10.0</span><span style="color: #0000FF;">/</span><span style="color: #000000;">62.0</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">1.0</span><span style="color: #0000FF;">/</span><span style="color: #000000;">10</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">/</span><span style="color: #000000;">50.0</span><span style="color: #0000FF;">}},</span> |
|||
<span style="color: #0000FF;">{{</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">23.0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">21</span><span style="color: #0000FF;">/</span><span style="color: #000000;">45.0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">/</span><span style="color: #000000;">38.0</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">/</span><span style="color: #000000;">44.0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">42</span><span style="color: #0000FF;">/</span><span style="color: #000000;">94.0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">/</span><span style="color: #000000;">22.0</span><span style="color: #0000FF;">}}},</span> |
|||
<span style="color: #000000;">correct</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0.021378001462867</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">0.148841696605327</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">0.0359722710297968</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">0.090773324285671</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">0.0107515611497845</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">0.00339907162713746</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">0.52726574965384</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">0.545266866977794</span><span style="color: #0000FF;">}</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">cerr</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span> |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">r</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">welch_ttest</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">r</span> |
|||
<span style="color: #000000;">cerr</span> <span style="color: #0000FF;">+=</span> <span style="color: #7060A8;">abs</span><span style="color: #0000FF;">(</span><span style="color: #000000;">r</span><span style="color: #0000FF;">-</span><span style="color: #000000;">correct</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
<span style="color: #0000FF;">?{</span><span style="color: #008000;">"cumulative error"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">cerr</span><span style="color: #0000FF;">}</span> |
|||
<!--</syntaxhighlight>--> |
|||
{{out}} |
|||
<pre> |
|||
0.02137800146 |
|||
0.1488416966 |
|||
0.03597227103 |
|||
0.09077332429 |
|||
0.01075156115 |
|||
0.003399071627 |
|||
0.5272657497 |
|||
0.545266867 |
|||
{"cumulative error",1.989380882e-14} -- (32 bit/p2js) |
|||
{"cumulative error",4.915115776e-15} -- (64-bit) |
|||
</pre> |
</pre> |
||
=={{header|Python}}== |
=={{header|Python}}== |
||
<lang python>import numpy as np |
|||
=== Using NumPy & SciPy === |
|||
<syntaxhighlight lang="python">import numpy as np |
|||
import scipy as sp |
import scipy as sp |
||
import scipy.stats |
import scipy.stats |
||
Line 853: | Line 1,799: | ||
welch_ttest(np.array([3.0, 4.0, 1.0, 2.1]), np.array([490.2, 340.0, 433.9])) |
welch_ttest(np.array([3.0, 4.0, 1.0, 2.1]), np.array([490.2, 340.0, 433.9])) |
||
(-9.559497721932658, 2.0008523488562844, 0.01075156114978449)</ |
(-9.559497721932658, 2.0008523488562844, 0.01075156114978449)</syntaxhighlight> |
||
=== Using betain from AS 63 === |
|||
First, the implementation of betain (translated from the Stata program in the discussion page). The original Fortran code is under copyrighted by the Royal Statistical Society. The C translation is under GPL, written by John Burkardt. The exact statement of the RSS license is unclear. |
|||
<syntaxhighlight lang="python">import math |
|||
def betain(x, p, q): |
|||
if p <= 0 or q <= 0 or x < 0 or x > 1: |
|||
raise ValueError |
|||
if x == 0 or x == 1: |
|||
return x |
|||
acu = 1e-15 |
|||
lnbeta = math.lgamma(p) + math.lgamma(q) - math.lgamma(p + q) |
|||
psq = p + q |
|||
if p < psq * x: |
|||
xx = 1 - x |
|||
cx = x |
|||
pp = q |
|||
qq = p |
|||
indx = True |
|||
else: |
|||
xx = x |
|||
cx = 1 - x |
|||
pp = p |
|||
qq = q |
|||
indx = False |
|||
term = ai = value = 1 |
|||
ns = math.floor(qq + cx * psq) |
|||
rx = xx / cx |
|||
temp = qq - ai |
|||
if ns == 0: |
|||
rx = xx |
|||
while True: |
|||
term *= temp * rx / (pp + ai) |
|||
value += term |
|||
temp = abs(term) |
|||
if temp <= acu and temp <= acu * value: |
|||
value *= math.exp(pp * math.log(xx) + (qq - 1) * math.log(cx) - lnbeta) / pp |
|||
return 1 - value if indx else value |
|||
ai += 1 |
|||
ns -= 1 |
|||
if ns >= 0: |
|||
temp = qq - ai |
|||
if ns == 0: |
|||
rx = xx |
|||
else: |
|||
temp = psq |
|||
psq += 1</syntaxhighlight> |
|||
The Python code is then straightforward: |
|||
<syntaxhighlight lang="python">import math |
|||
def welch_ttest(a1, a2): |
|||
n1 = len(a1) |
|||
n2 = len(a2) |
|||
if n1 <= 1 or n2 <= 1: |
|||
raise ValueError |
|||
mean1 = sum(a1) / n1 |
|||
mean2 = sum(a2) / n2 |
|||
var1 = sum((x - mean1)**2 for x in a1) / (n1 - 1) |
|||
var2 = sum((x - mean2)**2 for x in a2) / (n2 - 1) |
|||
t = (mean1 - mean2) / math.sqrt(var1 / n1 + var2 / n2) |
|||
df = (var1 / n1 + var2 / n2)**2 / (var1**2 / (n1**2 * (n1 - 1)) + var2**2 / (n2**2 * (n2 - 1))) |
|||
p = betain(df / (t**2 + df), df / 2, 1 / 2) |
|||
return t, df, p</syntaxhighlight> |
|||
'''Example''' |
|||
<syntaxhighlight lang="python">a1 = [3, 4, 1, 2.1] |
|||
a2 = [490.2, 340, 433.9] |
|||
print(welch_ttest(a1, a2))</syntaxhighlight> |
|||
'''Output''' |
|||
<pre>(-9.559497721932658, 2.0008523488562844, 0.01075156114978449)</pre> |
|||
=={{header|R}}== |
=={{header|R}}== |
||
< |
<syntaxhighlight lang="r">#!/usr/bin/R |
||
printf <- function(...) cat(sprintf(...)) |
|||
#allows printing to greater number of digits #https://stackoverflow.com/questions/13023274/how-to-do-printf-in-r#13023329 |
|||
d1 <- c(27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4) |
d1 <- c(27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4) |
||
d2 <- c(27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4) |
d2 <- c(27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4) |
||
Line 866: | Line 1,901: | ||
x <- c(3.0,4.0,1.0,2.1) |
x <- c(3.0,4.0,1.0,2.1) |
||
y <- c(490.2,340.0,433.9) |
y <- c(490.2,340.0,433.9) |
||
v1 <- c(0.010268,0.000167,0.000167); |
|||
v2<- c(0.159258,0.136278,0.122389); |
|||
s1<- c(1.0/15,10.0/62.0); |
|||
s2<- c(1.0/10,2/50.0); |
|||
z1<- c(9/23.0,21/45.0,0/38.0); |
|||
z2<- c(0/44.0,42/94.0,0/22.0); |
|||
results <- t.test(d1,d2, alternative="two.sided", var.equal=FALSE) |
results <- t.test(d1,d2, alternative="two.sided", var.equal=FALSE) |
||
printf("%.15g\n", results$p.value); |
|||
results <- t.test(d3,d4, alternative="two.sided", var.equal=FALSE) |
results <- t.test(d3,d4, alternative="two.sided", var.equal=FALSE) |
||
printf("%.15g\n", results$p.value); |
|||
results <- t.test(d5,d6, alternative="two.sided", var.equal=FALSE) |
results <- t.test(d5,d6, alternative="two.sided", var.equal=FALSE) |
||
printf("%.15g\n", results$p.value); |
|||
results <- t.test(d7,d8, alternative="two.sided", var.equal=FALSE) |
results <- t.test(d7,d8, alternative="two.sided", var.equal=FALSE) |
||
printf("%.15g\n", results$p.value); |
|||
results <- t.test(x,y, alternative="two.sided", var.equal=FALSE) |
results <- t.test(x,y, alternative="two.sided", var.equal=FALSE) |
||
printf("%.15g\n", results$p.value); |
|||
results <- t.test(v1,v2, alternative="two.sided", var.equal=FALSE) |
|||
</lang> |
|||
printf("%.15g\n", results$p.value); |
|||
results <- t.test(s1,s2, alternative="two.sided", var.equal=FALSE) |
|||
printf("%.15g\n", results$p.value); |
|||
results <- t.test(z1,z2, alternative="two.sided", var.equal=FALSE) |
|||
printf("%.15g\n", results$p.value); |
|||
</syntaxhighlight> |
|||
The output here is used to compare against C's output above. |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre>0.021378001462867 |
||
0.148841696605327 |
|||
[1] 0.1488417 |
|||
0.0359722710297968 |
|||
[1] 0.03597227 |
|||
0.090773324285671 |
|||
[1] 0.09077332 |
|||
0.0107515611497845 |
|||
[1] 0.01075156 |
|||
0.00339907162713746 |
|||
0.52726574965384 |
|||
0.545266866977794 |
|||
</pre> |
</pre> |
||
=={{header|Racket}}== |
=={{header|Racket}}== |
||
{{trans|C}} |
{{trans|C}} |
||
< |
<syntaxhighlight lang="racket">#lang racket |
||
(require math/statistics math/special-functions) |
(require math/statistics math/special-functions) |
||
Line 939: | Line 1,990: | ||
(p-value (list 3.0 4.0 1.0 2.1) |
(p-value (list 3.0 4.0 1.0 2.1) |
||
(list 490.2 340.0 433.9))))</ |
(list 490.2 340.0 433.9))))</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>(0.021378001462867013 0.14884169660532798 0.035972271029796624 0.09077332428567102 0.01075139991904718)</pre> |
<pre>(0.021378001462867013 0.14884169660532798 0.035972271029796624 0.09077332428567102 0.01075139991904718)</pre> |
||
=={{header|Raku}}== |
|||
(formerly Perl 6) |
|||
=== Integration using Simpson's Rule === |
|||
{{works with|Rakudo|2019.11}} |
|||
{{trans|C}} |
|||
Perhaps "inspired by C example" may be more accurate. Gamma subroutine from [[Gamma_function#Raku|Gamma function task]]. |
|||
<syntaxhighlight lang="raku" line>sub Γ(\z) { |
|||
constant g = 9; |
|||
z < .5 ?? π / sin(π × z) / Γ(1 - z) !! |
|||
τ.sqrt × (z + g - 1/2)**(z - 1/2) × |
|||
exp(-(z + g - 1/2)) × |
|||
[+] < |
|||
1.000000000000000174663 |
|||
5716.400188274341379136 |
|||
-14815.30426768413909044 |
|||
14291.49277657478554025 |
|||
-6348.160217641458813289 |
|||
1301.608286058321874105 |
|||
-108.1767053514369634679 |
|||
2.605696505611755827729 |
|||
-0.7423452510201416151527e-2 |
|||
0.5384136432509564062961e-7 |
|||
-0.4023533141268236372067e-8 |
|||
> Z× 1, |map 1/(z + *), 0..* |
|||
} |
|||
sub p-value (@A, @B) { |
|||
return 1 if @A <= 1 or @B <= 1; |
|||
my $a-mean = @A.sum / @A; |
|||
my $b-mean = @B.sum / @B; |
|||
my $a-variance = @A.map( { ($a-mean - $_)² } ).sum / (@A - 1); |
|||
my $b-variance = @B.map( { ($b-mean - $_)² } ).sum / (@B - 1); |
|||
return 1 unless $a-variance && $b-variance; |
|||
my \Welchs-𝒕-statistic = ($a-mean - $b-mean)/($a-variance/@A + $b-variance/@B).sqrt; |
|||
my $DoF = ($a-variance / @A + $b-variance / @B)² / |
|||
(($a-variance² / (@A³ - @A²)) + ($b-variance² / (@B³ - @B²))); |
|||
my $sa = $DoF / 2 - 1; |
|||
my $x = $DoF / (Welchs-𝒕-statistic² + $DoF); |
|||
my $N = 65355; |
|||
my $h = $x / $N; |
|||
my ( $sum1, $sum2 ); |
|||
for ^$N »×» $h -> $i { |
|||
$sum1 += (($i + $h / 2) ** $sa) / (1 - ($i + $h / 2)).sqrt; |
|||
$sum2 += $i ** $sa / (1 - $i).sqrt; |
|||
} |
|||
(($h / 6) × ( $x ** $sa / (1 - $x).sqrt + 4 × $sum1 + 2 × $sum2)) / |
|||
( Γ($sa + 1) × π.sqrt / Γ($sa + 1.5) ); |
|||
} |
|||
# Testing |
|||
for ( |
|||
[<27.5 21.0 19.0 23.6 17.0 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19.0 21.7 21.4>], |
|||
[<27.1 22.0 20.8 23.4 23.4 23.5 25.8 22.0 24.8 20.2 21.9 22.1 22.9 20.5 24.4>], |
|||
[<17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8>], |
|||
[<21.5 22.8 21.0 23.0 21.6 23.6 22.5 20.7 23.4 21.8 20.7 21.7 21.5 22.5 23.6 21.5 22.5 23.5 21.5 21.8>], |
|||
[<19.8 20.4 19.6 17.8 18.5 18.9 18.3 18.9 19.5 22.0>], |
|||
[<28.2 26.6 20.1 23.3 25.2 22.1 17.7 27.6 20.6 13.7 23.2 17.5 20.6 18.0 23.9 21.6 24.3 20.4 24.0 13.2>], |
|||
[<30.02 29.99 30.11 29.97 30.01 29.99>], |
|||
[<29.89 29.93 29.72 29.98 30.02 29.98>], |
|||
[<3.0 4.0 1.0 2.1>], |
|||
[<490.2 340.0 433.9>] |
|||
) -> @left, @right { say p-value @left, @right }</syntaxhighlight> |
|||
{{out}} |
|||
<pre>0.0213780014628669 |
|||
0.148841696605328 |
|||
0.0359722710297969 |
|||
0.0907733242856673 |
|||
0.010751534033393 |
|||
</pre> |
|||
=== Using Burkhardt's 'incomplete beta' === |
|||
{{works with|Rakudo|2019.11}} |
|||
{{trans|Perl}} |
|||
This uses the Soper reduction formula to evaluate the integral, which converges much more quickly than Simpson's formula. |
|||
<syntaxhighlight lang="raku" line>sub lgamma ( Num(Real) \n --> Num ){ |
|||
use NativeCall; |
|||
sub lgamma (num64 --> num64) is native {} |
|||
lgamma( n ) |
|||
} |
|||
sub p-value (@a, @b) { |
|||
return 1 if @a.elems | @b.elems ≤ 1; |
|||
my $mean1 = @a.sum / @a.elems; |
|||
my $mean2 = @b.sum / @b.elems; |
|||
return 1 if $mean1 == $mean2; |
|||
my $variance1 = sum (@a «-» $mean1) X**2; |
|||
my $variance2 = sum (@b «-» $mean2) X**2; |
|||
return 1 if $variance1 | $variance2 == 0; |
|||
$variance1 /= @a.elems - 1; |
|||
$variance2 /= @b.elems - 1; |
|||
my $Welchs-𝒕-statistic = ($mean1-$mean2)/sqrt($variance1/@a.elems+$variance2/@b.elems); |
|||
my $DoF = ($variance1/@a.elems + $variance2/@b.elems)² / |
|||
(($variance1 × $variance1)/(@a.elems × @a.elems × (@a.elems-1)) + |
|||
($variance2 × $variance2)/(@b.elems × @b.elems × (@b.elems-1)) |
|||
); |
|||
my $A = $DoF / 2; |
|||
my $value = $DoF / ($Welchs-𝒕-statistic² + $DoF); |
|||
return $value if $A | $value ≤ 0 or $value ≥ 1; |
|||
# from here, translation of John Burkhardt's C |
|||
my $beta = lgamma($A) + 0.57236494292470009 - lgamma($A+0.5); # constant is logΓ(.5), more precise than 'lgamma' routine |
|||
my $eps = 10**-15; |
|||
my $psq = $A + 0.5; |
|||
my $cx = 1 - $value; |
|||
my ($xx,$pp,$qq,$indx); |
|||
if $A < $psq × $value { ($xx, $cx, $pp, $qq, $indx) = $cx, $value, 0.5, $A, 1 } |
|||
else { ($xx, $pp, $qq, $indx) = $value, $A, 0.5, 0 } |
|||
my $term = my $ai = $value = 1; |
|||
my $ns = floor $qq + $cx × $psq; |
|||
# Soper reduction formula |
|||
my $qq-ai = $qq - $ai; |
|||
my $rx = $ns == 0 ?? $xx !! $xx / $cx; |
|||
loop { |
|||
$term ×= $qq-ai × $rx / ($pp + $ai); |
|||
$value += $term; |
|||
$qq-ai = $term.abs; |
|||
if $qq-ai ≤ $eps & $eps×$value { |
|||
$value = $value × ($pp × $xx.log + ($qq - 1) × $cx.log - $beta).exp / $pp; |
|||
$value = 1 - $value if $indx; |
|||
last |
|||
} |
|||
$ai++; |
|||
$ns--; |
|||
if $ns ≥ 0 { |
|||
$qq-ai = $qq - $ai; |
|||
$rx = $xx if $ns == 0; |
|||
} else { |
|||
$qq-ai = $psq; |
|||
$psq += 1; |
|||
} |
|||
} |
|||
$value |
|||
} |
|||
my $error = 0; |
|||
my @answers = ( |
|||
0.021378001462867, |
|||
0.148841696605327, |
|||
0.0359722710297968, |
|||
0.090773324285671, |
|||
0.0107515611497845, |
|||
0.00339907162713746, |
|||
0.52726574965384, |
|||
0.545266866977794, |
|||
); |
|||
for ( |
|||
[<27.5 21.0 19.0 23.6 17.0 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19.0 21.7 21.4>], |
|||
[<27.1 22.0 20.8 23.4 23.4 23.5 25.8 22.0 24.8 20.2 21.9 22.1 22.9 20.5 24.4>], |
|||
[<17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8>], |
|||
[<21.5 22.8 21.0 23.0 21.6 23.6 22.5 20.7 23.4 21.8 20.7 21.7 21.5 22.5 23.6 21.5 22.5 23.5 21.5 21.8>], |
|||
[<19.8 20.4 19.6 17.8 18.5 18.9 18.3 18.9 19.5 22.0>], |
|||
[<28.2 26.6 20.1 23.3 25.2 22.1 17.7 27.6 20.6 13.7 23.2 17.5 20.6 18.0 23.9 21.6 24.3 20.4 24.0 13.2>], |
|||
[<30.02 29.99 30.11 29.97 30.01 29.99>], |
|||
[<29.89 29.93 29.72 29.98 30.02 29.98>], |
|||
[<3.0 4.0 1.0 2.1>], |
|||
[<490.2 340.0 433.9>], |
|||
[<0.010268 0.000167 0.000167>], |
|||
[<0.159258 0.136278 0.122389>], |
|||
[<1.0/15 10.0/62.0>], |
|||
[<1.0/10 2/50.0>], |
|||
[<9/23.0 21/45.0 0/38.0>], |
|||
[<0/44.0 42/94.0 0/22.0>], |
|||
) -> @left, @right { |
|||
my $p-value = p-value @left, @right; |
|||
printf("p-value = %.14g\n",$p-value); |
|||
$error += abs($p-value - shift @answers); |
|||
} |
|||
printf("cumulative error is %g\n", $error);</syntaxhighlight> |
|||
{{out}} |
|||
<pre>p-value = 0.021378001462867 |
|||
p-value = 0.14884169660533 |
|||
p-value = 0.035972271029797 |
|||
p-value = 0.090773324285667 |
|||
p-value = 0.010751561149784 |
|||
p-value = 0.0033990716271375 |
|||
p-value = 0.52726574965384 |
|||
p-value = 0.54526686697779 |
|||
cumulative error is 5.30131e-15</pre> |
|||
=={{header|Ruby}}== |
|||
{{trans|Perl}} |
|||
<syntaxhighlight lang="ruby">def calculate_p_value(array1, array2) |
|||
return 1.0 if array1.size <= 1 |
|||
return 1.0 if array2.size <= 1 |
|||
mean1 = array1.sum / array1.size |
|||
mean2 = array2.sum / array2.size |
|||
return 1.0 if mean1 == mean2 |
|||
variance1 = 0.0 |
|||
variance2 = 0.0 |
|||
array1.each do |x| |
|||
variance1 += (mean1 - x)**2 |
|||
end |
|||
array2.each do |x| |
|||
variance2 += (mean2 - x)**2 |
|||
end |
|||
return 1.0 if variance1 == 0.0 && variance2 == 0.0 |
|||
variance1 /= (array1.size - 1) |
|||
variance2 /= (array2.size - 1) |
|||
welch_t_statistic = (mean1 - mean2) / Math.sqrt(variance1 / array1.size + variance2 / array2.size) |
|||
degrees_of_freedom = ((variance1 / array1.size + variance2 / array2.size)**2) / ( |
|||
(variance1 * variance1) / (array1.size * array1.size * (array1.size - 1)) + |
|||
(variance2 * variance2) / (array2.size * array2.size * (array2.size - 1))) |
|||
a = degrees_of_freedom / 2 |
|||
value = degrees_of_freedom / (welch_t_statistic**2 + degrees_of_freedom) |
|||
beta = Math.lgamma(a)[0] + 0.57236494292470009 - Math.lgamma(a + 0.5)[0] |
|||
acu = 10**-15 |
|||
return value if a <= 0 |
|||
return value if value < 0.0 || value > 1.0 |
|||
return value if (value == 0) || (value == 1.0) |
|||
psq = a + 0.5 |
|||
cx = 1.0 - value |
|||
if a < psq * value |
|||
xx = cx |
|||
cx = value |
|||
pp = 0.5 |
|||
qq = a |
|||
indx = 1 |
|||
else |
|||
xx = value |
|||
pp = a |
|||
qq = 0.5 |
|||
indx = 0 |
|||
end |
|||
term = 1.0 |
|||
ai = 1.0 |
|||
value = 1.0 |
|||
ns = (qq + cx * psq).to_i |
|||
# Soper reduction formula |
|||
rx = xx / cx |
|||
temp = qq - ai |
|||
loop do |
|||
term = term * temp * rx / (pp + ai) |
|||
value += term |
|||
temp = term.abs |
|||
if temp <= acu && temp <= acu * value |
|||
value = value * Math.exp(pp * Math.log(xx) + (qq - 1.0) * Math.log(cx) - beta) / pp |
|||
value = 1.0 - value |
|||
value = 1.0 - value if indx == 0 |
|||
break |
|||
end |
|||
ai += 1.0 |
|||
ns -= 1 |
|||
if ns >= 0 |
|||
temp = qq - ai |
|||
rx = xx if ns == 0 |
|||
else |
|||
temp = psq |
|||
psq += 1.0 |
|||
end |
|||
end |
|||
value |
|||
end |
|||
d1 = [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4] |
|||
d2 = [27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, 21.9, 22.1, 22.9, 20.5, 24.4] |
|||
d3 = [17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8] |
|||
d4 = [21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, 20.7, 21.7, 21.5, 22.5, 23.6, 21.5, 22.5, 23.5, 21.5, 21.8] |
|||
d5 = [19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0] |
|||
d6 = [28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, 23.2, 17.5, 20.6, 18.0, 23.9, 21.6, 24.3, 20.4, 24.0, 13.2] |
|||
d7 = [30.02, 29.99, 30.11, 29.97, 30.01, 29.99] |
|||
d8 = [29.89, 29.93, 29.72, 29.98, 30.02, 29.98] |
|||
x = [3.0, 4.0, 1.0, 2.1] |
|||
y = [490.2, 340.0, 433.9] |
|||
s1 = [1.0 / 15, 10.0 / 62.0] |
|||
s2 = [1.0 / 10, 2 / 50.0] |
|||
v1 = [0.010268, 0.000167, 0.000167] |
|||
v2 = [0.159258, 0.136278, 0.122389] |
|||
z1 = [9 / 23.0, 21 / 45.0, 0 / 38.0] |
|||
z2 = [0 / 44.0, 42 / 94.0, 0 / 22.0] |
|||
CORRECT_ANSWERS = [0.021378001462867, 0.148841696605327, 0.0359722710297968, |
|||
0.090773324285671, 0.0107515611497845, 0.00339907162713746, 0.52726574965384, 0.545266866977794].freeze |
|||
pvalue = calculate_p_value(d1, d2) |
|||
error = (pvalue - CORRECT_ANSWERS[0]).abs |
|||
printf("Test sets 1 p-value = %.14g\n", pvalue) |
|||
pvalue = calculate_p_value(d3, d4) |
|||
error += (pvalue - CORRECT_ANSWERS[1]).abs |
|||
printf("Test sets 2 p-value = %.14g\n", pvalue) |
|||
pvalue = calculate_p_value(d5, d6) |
|||
error += (pvalue - CORRECT_ANSWERS[2]).abs |
|||
printf("Test sets 3 p-value = %.14g\n", pvalue) |
|||
pvalue = calculate_p_value(d7, d8) |
|||
error += (pvalue - CORRECT_ANSWERS[3]).abs |
|||
printf("Test sets 4 p-value = %.14g\n", pvalue) |
|||
pvalue = calculate_p_value(x, y) |
|||
error += (pvalue - CORRECT_ANSWERS[4]).abs |
|||
printf("Test sets 5 p-value = %.14g\n", pvalue) |
|||
pvalue = calculate_p_value(v1, v2) |
|||
error += (pvalue - CORRECT_ANSWERS[5]).abs |
|||
printf("Test sets 6 p-value = %.14g\n", pvalue) |
|||
pvalue = calculate_p_value(s1, s2) |
|||
error += (pvalue - CORRECT_ANSWERS[6]).abs |
|||
printf("Test sets 7 p-value = %.14g\n", pvalue) |
|||
pvalue = calculate_p_value(z1, z2) |
|||
error += (pvalue - CORRECT_ANSWERS[7]).abs |
|||
printf("Test sets z p-value = %.14g\n", pvalue) |
|||
printf("the cumulative error is %g\n", error) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Test sets 1 p-value = 0.021378001462867 |
|||
Test sets 2 p-value = 0.14884169660533 |
|||
Test sets 3 p-value = 0.035972271029797 |
|||
Test sets 4 p-value = 0.090773324285671 |
|||
Test sets 5 p-value = 0.010751561149784 |
|||
Test sets 6 p-value = 0.0033990716271375 |
|||
Test sets 7 p-value = 0.52726574965384 |
|||
Test sets z p-value = 0.54526686697779 |
|||
the cumulative error is 1.34961e-15 |
|||
</pre> |
|||
=={{header|SAS}}== |
=={{header|SAS}}== |
||
{{trans|Stata}} |
{{trans|Stata}} |
||
<lang> |
<syntaxhighlight lang="text">data tbl; |
||
input value group @@; |
|||
x = {3.0,4.0,1.0,2.1}; |
|||
cards; |
|||
y = {490.2,340.0,433.9}; |
|||
3 1 4 1 1 1 2.1 1 490.2 2 340 2 433.9 2 |
|||
; |
|||
run; |
|||
proc ttest data=tbl; |
|||
class group; |
|||
var value; |
|||
run;</syntaxhighlight> |
|||
'''Output''' |
|||
<table align="center" cellspacing="1" cellpadding="7" rules="all" frame="box" border="1" summary="Procedure Ttest: Statistics"> |
|||
<tr> |
|||
<th scope="col">group</th> |
|||
<th scope="col">Method</th> |
|||
<th scope="col">N</th> |
|||
<th scope="col">Mean</th> |
|||
<th scope="col">Std Dev</th> |
|||
<th scope="col">Std Err</th> |
|||
<th scope="col">Minimum</th> |
|||
<th scope="col">Maximum</th> |
|||
</tr> |
|||
<tr> |
|||
<th scope="row">1</th> |
|||
<th scope="row"> </th> |
|||
<td>4</td> |
|||
<td>2.5250</td> |
|||
<td>1.2790</td> |
|||
<td>0.6395</td> |
|||
<td>1.0000</td> |
|||
<td>4.0000</td> |
|||
</tr> |
|||
<tr> |
|||
<th scope="row">2</th> |
|||
<th scope="row"> </th> |
|||
<td>3</td> |
|||
<td>421.4</td> |
|||
<td>75.8803</td> |
|||
<td>43.8095</td> |
|||
<td>340.0</td> |
|||
<td>490.2</td> |
|||
</tr> |
|||
<tr> |
|||
<th scope="row">Diff (1-2)</th> |
|||
<th scope="row">Pooled</th> |
|||
<td> </td> |
|||
<td nowrap>-418.8</td> |
|||
<td>48.0012</td> |
|||
<td>36.6615</td> |
|||
<td> </td> |
|||
<td> </td> |
|||
</tr> |
|||
<tr> |
|||
<th scope="row">Diff (1-2)</th> |
|||
<th scope="row">Satterthwaite</th> |
|||
<td> </td> |
|||
<td nowrap>-418.8</td> |
|||
<td> </td> |
|||
<td>43.8142</td> |
|||
<td> </td> |
|||
<td> </td> |
|||
</tr> |
|||
</table> |
|||
<br/> |
|||
<table align="center" cellspacing="1" cellpadding="7" rules="all" frame="box" border="1" summary="Procedure Ttest: Confidence Limits"> |
|||
<tr> |
|||
<th scope="col">group</th> |
|||
<th scope="col">Method</th> |
|||
<th scope="col">Mean</th> |
|||
<th colspan="2" scope="colgroup">95% CL Mean</th> |
|||
<th scope="col">Std Dev</th> |
|||
<th colspan="2" scope="colgroup">95% CL Std Dev</th> |
|||
</tr> |
|||
<tr> |
|||
<th scope="row">1</th> |
|||
<th scope="row"> </th> |
|||
<td>2.5250</td> |
|||
<td>0.4898</td> |
|||
<td>4.5602</td> |
|||
<td>1.2790</td> |
|||
<td>0.7245</td> |
|||
<td>4.7688</td> |
|||
</tr> |
|||
<tr> |
|||
<th scope="row">2</th> |
|||
<th scope="row"> </th> |
|||
<td>421.4</td> |
|||
<td>232.9</td> |
|||
<td>609.9</td> |
|||
<td>75.8803</td> |
|||
<td>39.5077</td> |
|||
<td>476.9</td> |
|||
</tr> |
|||
<tr> |
|||
<th scope="row">Diff (1-2)</th> |
|||
<th scope="row">Pooled</th> |
|||
<td nowrap>-418.8</td> |
|||
<td nowrap>-513.1</td> |
|||
<td nowrap>-324.6</td> |
|||
<td>48.0012</td> |
|||
<td>29.9627</td> |
|||
<td>117.7</td> |
|||
</tr> |
|||
<tr> |
|||
<th scope="row">Diff (1-2)</th> |
|||
<th scope="row">Satterthwaite</th> |
|||
<td nowrap>-418.8</td> |
|||
<td nowrap>-607.3</td> |
|||
<td nowrap>-230.4</td> |
|||
<td> </td> |
|||
<td> </td> |
|||
<td> </td> |
|||
</tr> |
|||
</table> |
|||
<br/> |
|||
<table align="center" cellspacing="1" cellpadding="7" rules="all" frame="box" border="1" summary="Procedure Ttest: T-Tests"> |
|||
<tr> |
|||
<th scope="col">Method</th> |
|||
<th scope="col">Variances</th> |
|||
<th scope="col">DF</th> |
|||
<th scope="col">t Value</th> |
|||
<th scope="col">Pr > |t|</th> |
|||
</tr> |
|||
<tr> |
|||
<th scope="row">Pooled</th> |
|||
<td>Equal</td> |
|||
<td>5</td> |
|||
<td nowrap>-11.42</td> |
|||
<td><.0001</td> |
|||
</tr> |
|||
<tr> |
|||
<th scope="row">Satterthwaite</th> |
|||
<td>Unequal</td> |
|||
<td>2.0009</td> |
|||
<td nowrap>-9.56</td> |
|||
<td>0.0108</td> |
|||
</tr> |
|||
</table> |
|||
<br/> |
|||
<table align="center" cellspacing="1" cellpadding="7" rules="all" frame="box" border="1" summary="Procedure Ttest: Equality of Variances"> |
|||
<tr> |
|||
<th colspan="5" scope="colgroup">Equality of Variances</th> |
|||
</tr> |
|||
<tr> |
|||
<th scope="col">Method</th> |
|||
<th scope="col">Num DF</th> |
|||
<th scope="col">Den DF</th> |
|||
<th scope="col">F Value</th> |
|||
<th scope="col">Pr > F</th> |
|||
</tr> |
|||
<tr> |
|||
<th scope="row">Folded F</th> |
|||
<td>2</td> |
|||
<td>3</td> |
|||
<td>3519.81</td> |
|||
<td><.0001</td> |
|||
</tr> |
|||
</table> |
|||
Implementation in IML: |
|||
<syntaxhighlight lang="sas">proc iml; |
|||
use tbl; |
|||
read all var {value} into x where(group=1); |
|||
read all var {value} into y where(group=2); |
|||
close tbl; |
|||
n1 = nrow(x); |
n1 = nrow(x); |
||
n2 = nrow(y); |
n2 = nrow(y); |
||
Line 956: | Line 2,527: | ||
df = (v1/n1+v2/n2)**2/(v1**2/(n1**2*(n1-1))+v2**2/(n2**2*(n2-1))); |
df = (v1/n1+v2/n2)**2/(v1**2/(n1**2*(n1-1))+v2**2/(n2**2*(n2-1))); |
||
p = 2*probt(-abs(t), df); |
p = 2*probt(-abs(t), df); |
||
print |
print t df p; |
||
quit;</ |
quit;</syntaxhighlight> |
||
'''Output''' |
'''Output''' |
||
<pre>-9.559498 2.0008523 0.0107516</pre> |
<pre>-9.559498 2.0008523 0.0107516</pre> |
||
=={{header|Scala}}== |
|||
<syntaxhighlight lang="scala">import org.apache.commons.math3.distribution.TDistribution |
|||
object WelchTTest extends App { |
|||
val res = welchTtest(Array(3.0, 4.0, 1.0, 2.1), Array(490.2, 340.0, 433.9)) |
|||
def welchTtest(x: Array[Double], y: Array[Double]) = { |
|||
def square[T](x: T)(implicit num: Numeric[T]): T = { |
|||
import num._ |
|||
x * x |
|||
} |
|||
def count[A](a: Seq[A])(implicit num: Fractional[A]): A = |
|||
a.foldLeft(num.zero) { case (cnt, _) => num.plus(cnt, num.one) } |
|||
def mean[A](a: Seq[A])(implicit num: Fractional[A]): A = num.div(a.sum, count(a)) |
|||
def variance[A](a: Seq[A])(implicit num: Fractional[A]) = |
|||
num.div(a.map(xs => square(num.minus(xs, mean(a)))).sum, num.minus(count(a), num.one)) |
|||
val (nx, ny) = (x.length, y.length) |
|||
val (vx, vy) = (variance(x), variance(y)) |
|||
val qt = vx / nx + vy / ny |
|||
val t = (mean(x) - mean(y)) / math.sqrt(qt) |
|||
val df = square(qt) / (square(vx) / (square(nx) * (nx - 1)) + square(vy) / (square(ny) * (ny - 1))) |
|||
val p = 2.0 * new TDistribution(df).cumulativeProbability(-math.abs(t)) |
|||
(t, df, p) |
|||
} |
|||
println(s"t = ${res._1}\ndf = ${res._2}\np = ${res._3}") |
|||
println(s"\nSuccessfully completed without errors. [total ${scala.compat.Platform.currentTime - executionStart} ms]") |
|||
}</syntaxhighlight> |
|||
=={{header|Scilab}}== |
=={{header|Scilab}}== |
||
Line 968: | Line 2,575: | ||
Scilab will print a warning because the number of degrees of freedom is not an integer. However, the underlying implementation makes use of the [http://www.netlib.org/random/ dcdflib] Fortran library, which happily accepts a noninteger df. |
Scilab will print a warning because the number of degrees of freedom is not an integer. However, the underlying implementation makes use of the [http://www.netlib.org/random/ dcdflib] Fortran library, which happily accepts a noninteger df. |
||
<lang>x = [3.0,4.0,1.0,2.1]; |
<syntaxhighlight lang="text">x = [3.0,4.0,1.0,2.1]; |
||
y = [490.2,340.0,433.9]; |
y = [490.2,340.0,433.9]; |
||
n1 = length(x); |
n1 = length(x); |
||
Line 977: | Line 2,584: | ||
df = (v1/n1+v2/n2)^2/(v1^2/(n1^2*(n1-1))+v2^2/(n2^2*(n2-1))); |
df = (v1/n1+v2/n2)^2/(v1^2/(n1^2*(n1-1))+v2^2/(n2^2*(n2-1))); |
||
[p, q] = cdft("PQ", -abs(t), df); |
[p, q] = cdft("PQ", -abs(t), df); |
||
[t df 2*p]</ |
[t df 2*p]</syntaxhighlight> |
||
'''Output''' |
'''Output''' |
||
Line 986: | Line 2,593: | ||
=={{header|Sidef}}== |
=={{header|Sidef}}== |
||
{{trans| |
{{trans|Raku}} |
||
< |
<syntaxhighlight lang="ruby">func p_value (A, B) { |
||
[A.len, B.len].all { _ > 1 } || return 1 |
[A.len, B.len].all { _ > 1 } || return 1 |
||
Line 1,039: | Line 2,646: | ||
tests.each_slice(2, {|left, right| |
tests.each_slice(2, {|left, right| |
||
say p_value(left, right) |
say p_value(left, right) |
||
})</ |
})</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,054: | Line 2,661: | ||
Notice that here we use the option '''unequal''' of the '''ttest''' command, and not '''welch''', so that Stata uses the Welch-Satterthwaite approximation. |
Notice that here we use the option '''unequal''' of the '''ttest''' command, and not '''welch''', so that Stata uses the Welch-Satterthwaite approximation. |
||
< |
<syntaxhighlight lang="stata">mat a=(3,4,1,2.1,490.2,340,433.9\1,1,1,1,2,2,2)' |
||
clear |
clear |
||
svmat double a |
svmat double a |
||
Line 1,081: | Line 2,688: | ||
di r(p) |
di r(p) |
||
.01075156</ |
.01075156</syntaxhighlight> |
||
The computation can easily be implemented in Mata. Here is how to compute the t statistic (t), the approximate degrees of freedom (df) and the p-value (p). |
The computation can easily be implemented in Mata. Here is how to compute the t statistic (t), the approximate degrees of freedom (df) and the p-value (p). |
||
< |
<syntaxhighlight lang="stata">st_view(a=., ., .) |
||
x = select(a[., 1], a[., 2] :== 1) |
x = select(a[., 1], a[., 2] :== 1) |
||
y = select(a[., 1], a[., 2] :== 2) |
y = select(a[., 1], a[., 2] :== 2) |
||
Line 1,099: | Line 2,706: | ||
+----------------------------------------------+ |
+----------------------------------------------+ |
||
1 | -9.559497722 2.000852349 .0107515611 | |
1 | -9.559497722 2.000852349 .0107515611 | |
||
+----------------------------------------------+</ |
+----------------------------------------------+</syntaxhighlight> |
||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
Line 1,109: | Line 2,716: | ||
This is not particularly idiomatic Tcl, but perhaps illustrates some of the language's relationship with the Lisp family. |
This is not particularly idiomatic Tcl, but perhaps illustrates some of the language's relationship with the Lisp family. |
||
< |
<syntaxhighlight lang="tcl">#!/usr/bin/tclsh |
||
package require math::statistics |
package require math::statistics |
||
Line 1,184: | Line 2,791: | ||
puts [pValue $left $right] |
puts [pValue $left $right] |
||
} |
} |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
Line 1,192: | Line 2,799: | ||
0.09077332428458083 |
0.09077332428458083 |
||
0.010751399918798182 |
0.010751399918798182 |
||
</pre> |
|||
=={{header|Wren}}== |
|||
{{trans|Go}} |
|||
{{libheader|Wren-math}} |
|||
{{libheader|Wren-fmt}} |
|||
<syntaxhighlight lang="wren">import "./math" for Math, Nums |
|||
import "./fmt" for Fmt |
|||
var welch = Fn.new { |a, b| |
|||
return (Nums.mean(a) - Nums.mean(b)) / |
|||
(Nums.variance(a)/a.count + Nums.variance(b)/b.count).sqrt |
|||
} |
|||
var dof = Fn.new { |a, b| |
|||
var sva = Nums.variance(a) |
|||
var svb = Nums.variance(b) |
|||
var la = a.count |
|||
var lb = b.count |
|||
var n = sva/la + svb/lb |
|||
return n * n / (sva*sva/(la*la*(la-1)) + svb*svb/(lb*lb*(lb-1))) |
|||
} |
|||
var simpson0 = Fn.new { |nf, upper, f| |
|||
var dx0 = upper/nf |
|||
var sum = (f.call(0) + f.call(dx0*0.5)*4) * dx0 |
|||
var x0 = dx0 |
|||
for (i in 1...nf) { |
|||
var x1 = (i + 1) * upper / nf |
|||
var xmid = (x0 + x1) * 0.5 |
|||
var dx = x1 - x0 |
|||
sum = sum + (f.call(x0)*2 + f.call(xmid)*4) * dx |
|||
x0 = x1 |
|||
} |
|||
return (sum + f.call(upper)*dx0) / 6 |
|||
} |
|||
var pValue = Fn.new { |a, b| |
|||
var nu = dof.call(a, b) |
|||
var t = welch.call(a, b) |
|||
var g1 = Math.gamma(nu/2).log |
|||
var g2 = Math.gamma(0.5).log |
|||
var g3 = Math.gamma(nu/2 + 0.5).log |
|||
var f = Fn.new { |r| r.pow(nu/2-1) / (1 - r).sqrt } |
|||
return simpson0.call(2000, nu/(t*t + nu), f) / (g1 + g2 - g3).exp |
|||
} |
|||
var d1 = [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4] |
|||
var d2 = [27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, 21.9, 22.1, 22.9, 20.5, 24.4] |
|||
var d3 = [17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8] |
|||
var d4 = [21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, 20.7, 21.7, 21.5, 22.5, 23.6, |
|||
21.5, 22.5, 23.5, 21.5, 21.8] |
|||
var d5 = [19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0] |
|||
var d6 = [28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, 23.2, 17.5, 20.6, 18.0, 23.9, |
|||
21.6, 24.3, 20.4, 24.0, 13.2] |
|||
var d7 = [30.02, 29.99, 30.11, 29.97, 30.01, 29.99] |
|||
var d8 = [29.89, 29.93, 29.72, 29.98, 30.02, 29.98] |
|||
var x = [3.0, 4.0, 1.0, 2.1] |
|||
var y = [490.2, 340.0, 433.9] |
|||
Fmt.print("$0.6f", pValue.call(d1, d2)) |
|||
Fmt.print("$0.6f", pValue.call(d3, d4)) |
|||
Fmt.print("$0.6f", pValue.call(d5, d6)) |
|||
Fmt.print("$0.6f", pValue.call(d7, d8)) |
|||
Fmt.print("$0.6f", pValue.call(x, y))</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
0.021378 |
|||
0.148842 |
|||
0.035972 |
|||
0.090773 |
|||
0.010751 |
|||
</pre> |
</pre> |
||
=={{header|zkl}}== |
=={{header|zkl}}== |
||
{{trans|C}} |
{{trans|C}} |
||
< |
<syntaxhighlight lang="zkl">fcn calculate_Pvalue(array1,array2){ |
||
if (array1.len()<=1 or array2.len()<=1) return(1.0); |
if (array1.len()<=1 or array2.len()<=1) return(1.0); |
||
Line 1,246: | Line 2,925: | ||
foreach x in (cof){ ser+=(x/(y+=1)); } |
foreach x in (cof){ ser+=(x/(y+=1)); } |
||
return((2.5066282746310005 * ser / x).log() - tmp); |
return((2.5066282746310005 * ser / x).log() - tmp); |
||
}</ |
}</syntaxhighlight> |
||
< |
<syntaxhighlight lang="zkl">testSets:=T( |
||
T(T(27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4), |
T(T(27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4), |
||
T(27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4)), |
T(27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4)), |
||
Line 1,259: | Line 2,938: | ||
foreach x,y in (testSets) |
foreach x,y in (testSets) |
||
{ println("Test set 1 p-value = %f".fmt(calculate_Pvalue(x,y))); }</ |
{ println("Test set 1 p-value = %f".fmt(calculate_Pvalue(x,y))); }</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
Latest revision as of 21:58, 21 April 2024
Given two lists of data, calculate the p-value used for Welch's t-test. This is meant to translate R's t.test(vector1, vector2, alternative="two.sided", var.equal=FALSE)
for calculation of the p-value.
Task Description
Given two sets of data, calculate the p-value:
x = {3.0,4.0,1.0,2.1} y = {490.2,340.0,433.9}
Your task is to discern whether or not the difference in means between the two sets is statistically significant and worth further investigation. P-values are significance tests to gauge the probability that the difference in means between two data sets is significant, or due to chance. A threshold level, alpha, is usually chosen, 0.01 or 0.05, where p-values below alpha are worth further investigation and p-values above alpha are considered not significant. The p-value is not considered a final test of significance, only whether the given variable should be given further consideration.
There is more than one way of calculating the t-statistic, and you must choose which method is appropriate for you. Here we use Welch's t-test, which assumes that the variances between the two sets x
and y
are not equal. Welch's t-test statistic can be computed:
where
is the mean of set ,
and
is the number of observations in set ,
and
is the square root of the unbiased sample variance of set , i.e.
and the degrees of freedom, can be approximated:
The two-tailed p-value, , can be computed as a cumulative distribution function
where I is the regularized incomplete beta function. This is the same as:
Keeping in mind that
and
can be calculated in terms of gamma functions and integrals more simply:
which simplifies to
The definite integral can be approximated with Simpson's Rule but other methods are also acceptable.
The , or lgammal(x)
function is necessary for the program to work with large a
values, as Gamma functions can often return values larger than can be handled by double
or long double
data types. The lgammal(x)
function is standard in math.h
with C99 and C11 standards.
11l
F betain(x, p, q)
I p <= 0 | q <= 0 | x < 0 | x > 1
X.throw ValueError(0)
I x == 0 | x == 1
R x
V acu = 1e-15
V lnbeta = lgamma(p) + lgamma(q) - lgamma(p + q)
V xx = x
V cx = 1 - x
V pp = p
V qq = q
V indx = 0B
V psq = p + q
I p < psq * x
xx = 1 - x
cx = x
pp = q
qq = p
indx = 1B
V term = 1.0
V ai = 1.0
V value = 1.0
V ns = floor(qq + cx * psq)
V rx = xx / cx
V temp = qq - ai
I ns == 0
rx = xx
L
term *= temp * rx / (pp + ai)
value += term
temp = abs(term)
I temp <= acu & temp <= acu * value
value *= exp(pp * log(xx) + (qq - 1) * log(cx) - lnbeta) / pp
R I indx {1 - value} E value
ai++
I --ns >= 0
temp = qq - ai
I ns == 0
rx = xx
E
temp = psq
psq++
F welch_ttest(a1, a2)
V n1 = a1.len
V n2 = a2.len
I n1 <= 1 | n2 <= 1
X.throw ValueError(0)
V mean1 = sum(a1) / n1
V mean2 = sum(a2) / n2
V var1 = sum(a1.map(x -> (x - @mean1) ^ 2)) / (n1 - 1)
V var2 = sum(a2.map(x -> (x - @mean2) ^ 2)) / (n2 - 1)
V t = (mean1 - mean2) / sqrt(var1 / n1 + var2 / n2)
V df = (var1 / n1 + var2 / n2) ^ 2 / (var1 ^ 2 / (n1 ^ 2 * (n1 - 1)) + var2 ^ 2 / (n2 ^ 2 * (n2 - 1)))
V p = betain(df / (t ^ 2 + df), df / 2, 1 / 2)
R (t, df, p)
V a1 = [Float(3), 4, 1, 2.1]
V a2 = [Float(490.2), 340, 433.9]
print(welch_ttest(a1, a2))
- Output:
(-9.5595, 2.00085, 0.0107516)
C
Link with -lm
This program, for example, pvalue.c, can be compiled by
clang -o pvalue pvalue.c -Wall -pedantic -std=c11 -lm -O3
or
gcc -o pvalue pvalue.c -Wall -pedantic -std=c11 -lm -O4
.
This shows how pvalue can be calculated from any two arrays, using Welch's 2-sided t-test, which doesn't assume equal variance.
This is the equivalent of R'st.test(vector1,vector2, alternative="two.sided", var.equal=FALSE)
and as such, it is compared against R's pvalues with the same vectors/arrays to show that the differences are very small (here 10^-14).
#include <stdio.h>
#include <math.h>
#include <stdlib.h>
double Pvalue (const double *restrict ARRAY1, const size_t ARRAY1_SIZE, const double *restrict ARRAY2, const size_t ARRAY2_SIZE) {//calculate a p-value based on an array
if (ARRAY1_SIZE <= 1) {
return 1.0;
} else if (ARRAY2_SIZE <= 1) {
return 1.0;
}
double fmean1 = 0.0, fmean2 = 0.0;
for (size_t x = 0; x < ARRAY1_SIZE; x++) {//get sum of values in ARRAY1
if (isfinite(ARRAY1[x]) == 0) {//check to make sure this is a real numbere
puts("Got a non-finite number in 1st array, can't calculate P-value.");
exit(EXIT_FAILURE);
}
fmean1 += ARRAY1[x];
}
fmean1 /= ARRAY1_SIZE;
for (size_t x = 0; x < ARRAY2_SIZE; x++) {//get sum of values in ARRAY2
if (isfinite(ARRAY2[x]) == 0) {//check to make sure this is a real number
puts("Got a non-finite number in 2nd array, can't calculate P-value.");
exit(EXIT_FAILURE);
}
fmean2 += ARRAY2[x];
}
fmean2 /= ARRAY2_SIZE;
// printf("mean1 = %lf mean2 = %lf\n", fmean1, fmean2);
if (fmean1 == fmean2) {
return 1.0;//if the means are equal, the p-value is 1, leave the function
}
double unbiased_sample_variance1 = 0.0, unbiased_sample_variance2 = 0.0;
for (size_t x = 0; x < ARRAY1_SIZE; x++) {//1st part of added unbiased_sample_variance
unbiased_sample_variance1 += (ARRAY1[x]-fmean1)*(ARRAY1[x]-fmean1);
}
for (size_t x = 0; x < ARRAY2_SIZE; x++) {
unbiased_sample_variance2 += (ARRAY2[x]-fmean2)*(ARRAY2[x]-fmean2);
}
// printf("unbiased_sample_variance1 = %lf\tunbiased_sample_variance2 = %lf\n",unbiased_sample_variance1,unbiased_sample_variance2);//DEBUGGING
unbiased_sample_variance1 = unbiased_sample_variance1/(ARRAY1_SIZE-1);
unbiased_sample_variance2 = unbiased_sample_variance2/(ARRAY2_SIZE-1);
const double WELCH_T_STATISTIC = (fmean1-fmean2)/sqrt(unbiased_sample_variance1/ARRAY1_SIZE+unbiased_sample_variance2/ARRAY2_SIZE);
const double DEGREES_OF_FREEDOM = pow((unbiased_sample_variance1/ARRAY1_SIZE+unbiased_sample_variance2/ARRAY2_SIZE),2.0)//numerator
/
(
(unbiased_sample_variance1*unbiased_sample_variance1)/(ARRAY1_SIZE*ARRAY1_SIZE*(ARRAY1_SIZE-1))+
(unbiased_sample_variance2*unbiased_sample_variance2)/(ARRAY2_SIZE*ARRAY2_SIZE*(ARRAY2_SIZE-1))
);
// printf("Welch = %lf DOF = %lf\n", WELCH_T_STATISTIC, DEGREES_OF_FREEDOM);
const double a = DEGREES_OF_FREEDOM/2;
double value = DEGREES_OF_FREEDOM/(WELCH_T_STATISTIC*WELCH_T_STATISTIC+DEGREES_OF_FREEDOM);
if ((isinf(value) != 0) || (isnan(value) != 0)) {
return 1.0;
}
if ((isinf(value) != 0) || (isnan(value) != 0)) {
return 1.0;
}
/* Purpose:
BETAIN computes the incomplete Beta function ratio.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
05 November 2010
Author:
Original FORTRAN77 version by KL Majumder, GP Bhattacharjee.
C version by John Burkardt.
Reference:
KL Majumder, GP Bhattacharjee,
Algorithm AS 63:
The incomplete Beta Integral,
Applied Statistics,
Volume 22, Number 3, 1973, pages 409-411.
Parameters:
https://www.jstor.org/stable/2346797?seq=1#page_scan_tab_contents
Input, double X, the argument, between 0 and 1.
Input, double P, Q, the parameters, which
must be positive.
Input, double BETA, the logarithm of the complete
beta function.
Output, int *IFAULT, error flag.
0, no error.
nonzero, an error occurred.
Output, double BETAIN, the value of the incomplete
Beta function ratio.
*/
const double beta = lgammal(a)+0.57236494292470009-lgammal(a+0.5);
const double acu = 0.1E-14;
double ai;
double cx;
int indx;
int ns;
double pp;
double psq;
double qq;
double rx;
double temp;
double term;
double xx;
// ifault = 0;
//Check the input arguments.
if ( (a <= 0.0)) {// || (0.5 <= 0.0 )){
// *ifault = 1;
// return value;
}
if ( value < 0.0 || 1.0 < value )
{
// *ifault = 2;
return value;
}
/*
Special cases.
*/
if ( value == 0.0 || value == 1.0 ) {
return value;
}
psq = a + 0.5;
cx = 1.0 - value;
if ( a < psq * value )
{
xx = cx;
cx = value;
pp = 0.5;
qq = a;
indx = 1;
}
else
{
xx = value;
pp = a;
qq = 0.5;
indx = 0;
}
term = 1.0;
ai = 1.0;
value = 1.0;
ns = ( int ) ( qq + cx * psq );
/*
Use the Soper reduction formula.
*/
rx = xx / cx;
temp = qq - ai;
if ( ns == 0 )
{
rx = xx;
}
for ( ; ; )
{
term = term * temp * rx / ( pp + ai );
value = value + term;;
temp = fabs ( term );
if ( temp <= acu && temp <= acu * value )
{
value = value * exp ( pp * log ( xx )
+ ( qq - 1.0 ) * log ( cx ) - beta ) / pp;
if ( indx )
{
value = 1.0 - value;
}
break;
}
ai = ai + 1.0;
ns = ns - 1;
if ( 0 <= ns )
{
temp = qq - ai;
if ( ns == 0 )
{
rx = xx;
}
}
else
{
temp = psq;
psq = psq + 1.0;
}
}
return value;
}
//-------------------
int main(void) {
const double d1[] = {27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4};
const double d2[] = {27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4};
const double d3[] = {17.2,20.9,22.6,18.1,21.7,21.4,23.5,24.2,14.7,21.8};
const double d4[] = {21.5,22.8,21.0,23.0,21.6,23.6,22.5,20.7,23.4,21.8,20.7,21.7,21.5,22.5,23.6,21.5,22.5,23.5,21.5,21.8};
const double d5[] = {19.8,20.4,19.6,17.8,18.5,18.9,18.3,18.9,19.5,22.0};
const double d6[] = {28.2,26.6,20.1,23.3,25.2,22.1,17.7,27.6,20.6,13.7,23.2,17.5,20.6,18.0,23.9,21.6,24.3,20.4,24.0,13.2};
const double d7[] = {30.02,29.99,30.11,29.97,30.01,29.99};
const double d8[] = {29.89,29.93,29.72,29.98,30.02,29.98};
const double x[] = {3.0,4.0,1.0,2.1};
const double y[] = {490.2,340.0,433.9};
const double v1[] = {0.010268,0.000167,0.000167};
const double v2[] = {0.159258,0.136278,0.122389};
const double s1[] = {1.0/15,10.0/62.0};
const double s2[] = {1.0/10,2/50.0};
const double z1[] = {9/23.0,21/45.0,0/38.0};
const double z2[] = {0/44.0,42/94.0,0/22.0};
const double CORRECT_ANSWERS[] = {0.021378001462867,
0.148841696605327,
0.0359722710297968,
0.090773324285671,
0.0107515611497845,
0.00339907162713746,
0.52726574965384,
0.545266866977794};
//calculate the pvalues and show that they're the same as the R values
double pvalue = Pvalue(d1,sizeof(d1)/sizeof(*d1),d2,sizeof(d2)/sizeof(*d2));
double error = fabs(pvalue - CORRECT_ANSWERS[0]);
printf("Test sets 1 p-value = %g\n", pvalue);
pvalue = Pvalue(d3,sizeof(d3)/sizeof(*d3),d4,sizeof(d4)/sizeof(*d4));
error += fabs(pvalue - CORRECT_ANSWERS[1]);
printf("Test sets 2 p-value = %g\n",pvalue);
pvalue = Pvalue(d5,sizeof(d5)/sizeof(*d5),d6,sizeof(d6)/sizeof(*d6));
error += fabs(pvalue - CORRECT_ANSWERS[2]);
printf("Test sets 3 p-value = %g\n", pvalue);
pvalue = Pvalue(d7,sizeof(d7)/sizeof(*d7),d8,sizeof(d8)/sizeof(*d8));
printf("Test sets 4 p-value = %g\n", pvalue);
error += fabs(pvalue - CORRECT_ANSWERS[3]);
pvalue = Pvalue(x,sizeof(x)/sizeof(*x),y,sizeof(y)/sizeof(*y));
error += fabs(pvalue - CORRECT_ANSWERS[4]);
printf("Test sets 5 p-value = %g\n", pvalue);
pvalue = Pvalue(v1,sizeof(v1)/sizeof(*v1),v2,sizeof(v2)/sizeof(*v2));
error += fabs(pvalue - CORRECT_ANSWERS[5]);
printf("Test sets 6 p-value = %g\n", pvalue);
pvalue = Pvalue(s1,sizeof(s1)/sizeof(*s1),s2,sizeof(s2)/sizeof(*s2));
error += fabs(pvalue - CORRECT_ANSWERS[6]);
printf("Test sets 7 p-value = %g\n", pvalue);
pvalue = Pvalue(z1, 3, z2, 3);
error += fabs(pvalue - CORRECT_ANSWERS[7]);
printf("Test sets z p-value = %g\n", pvalue);
printf("the cumulative error is %g\n", error);
return 0;
}
- Output:
Test sets 1 p-value = 0.021378 Test sets 2 p-value = 0.148842 Test sets 3 p-value = 0.0359723 Test sets 4 p-value = 0.0907733 Test sets 5 p-value = 0.0107516 Test sets 6 p-value = 0.00339907 Test sets 7 p-value = 0.527266 Test sets z p-value = 0.545267 the cumulative error is 1.06339e-14
If your computer does not have lgammal
, add the following function before main
and replace lgammal
with lngammal
in the calculate_Pvalue
function:
#include <stdio.h>
#include <math.h>
long double lngammal(const double xx) {
unsigned int j;
double x,y,tmp,ser;
const double cof[6] = {
76.18009172947146, -86.50532032941677,
24.01409824083091, -1.231739572450155,
0.1208650973866179e-2,-0.5395239384953e-5
};
y = x = xx;
tmp = x + 5.5 - (x + 0.5) * logl(x + 5.5);
ser = 1.000000000190015;
for (j=0;j<=5;j++)
ser += (cof[j] / ++y);
return(log(2.5066282746310005 * ser / x) - tmp);
}
Fortran
Using IMSL
Using IMSL TDF function. With Absoft Pro Fortran, compile with af90 %FFLAGS% %LINK_FNL% pvalue.f90
.
Alternatively, the program shows the p-value computed using the IMSL BETAI function.
subroutine welch_ttest(n1, x1, n2, x2, t, df, p)
use tdf_int
implicit none
integer :: n1, n2
double precision :: x1(n1), x2(n2)
double precision :: m1, m2, v1, v2, t, df, p
m1 = sum(x1) / n1
m2 = sum(x2) / n2
v1 = sum((x1 - m1)**2) / (n1 - 1)
v2 = sum((x2 - m2)**2) / (n2 - 1)
t = (m1 - m2) / sqrt(v1 / n1 + v2 / n2)
df = (v1 / n1 + v2 / n2)**2 / &
(v1**2 / (n1**2 * (n1 - 1)) + v2**2 / (n2**2 * (n2 - 1)))
p = 2d0 * tdf(-abs(t), df)
end subroutine
program pvalue
use betai_int
implicit none
double precision :: x(4) = [3d0, 4d0, 1d0, 2.1d0]
double precision :: y(3) = [490.2d0, 340.0d0, 433.9d0]
double precision :: t, df, p
call welch_ttest(4, x, 3, y, t, df, p)
print *, t, df, p
print *, betai(df / (t**2 + df), 0.5d0 * df, 0.5d0)
end program
Output
-9.55949772193266 2.00085234885628 1.075156114978449E-002 1.075156114978449E-002
Using SLATEC
With Absoft Pro Fortran, compile with af90 -m64 pvalue.f90 %SLATEC_LINK%
.
subroutine welch_ttest(n1, x1, n2, x2, t, df, p)
implicit none
integer :: n1, n2
double precision :: x1(n1), x2(n2)
double precision :: m1, m2, v1, v2, t, df, p
double precision :: dbetai
m1 = sum(x1) / n1
m2 = sum(x2) / n2
v1 = sum((x1 - m1)**2) / (n1 - 1)
v2 = sum((x2 - m2)**2) / (n2 - 1)
t = (m1 - m2) / sqrt(v1 / n1 + v2 / n2)
df = (v1 / n1 + v2 / n2)**2 / &
(v1**2 / (n1**2 * (n1 - 1)) + v2**2 / (n2**2 * (n2 - 1)))
p = dbetai(df / (t**2 + df), 0.5d0 * df, 0.5d0)
end subroutine
program pvalue
implicit none
double precision :: x(4) = [3d0, 4d0, 1d0, 2.1d0]
double precision :: y(3) = [490.2d0, 340.0d0, 433.9d0]
double precision :: t, df, p
call welch_ttest(4, x, 3, y, t, df, p)
print *, t, df, p
end program
Output
-9.55949772193266 2.00085234885628 1.075156114978449E-002
Using GSL
Instead of implementing the t-distribution by ourselves, we bind to GNU Scientific Library:
module t_test_m
use, intrinsic :: iso_c_binding
use, intrinsic :: iso_fortran_env, only: wp => real64
implicit none
private
public :: t_test, wp
interface
function gsl_cdf_tdist_p(x, nu) bind(c, name='gsl_cdf_tdist_P')
import
real(c_double), value :: x
real(c_double), value :: nu
real(c_double) :: gsl_cdf_tdist_p
end function gsl_cdf_tdist_p
end interface
contains
!> Welch T test
impure subroutine t_test(x, y, p, t, df)
real(wp), intent(in) :: x(:), y(:)
real(wp), intent(out) :: p !! p-value
real(wp), intent(out) :: t !! T value
real(wp), intent(out) :: df !! degrees of freedom
integer :: n1, n2
real(wp) :: m1, m2, v1, v2
n1 = size(x)
n2 = size(y)
m1 = sum(x)/n1
m2 = sum(y)/n2
v1 = sum((x - m1)**2)/(n1 - 1)
v2 = sum((y - m2)**2)/(n2 - 1)
t = (m1 - m2)/sqrt(v1/n1 + v2/n2)
df = (v1/n1 + v2/n2)**2/(v1**2/(n1**2*(n1 - 1)) + v2**2/(n2**2*(n2 - 1)))
p = 2*gsl_cdf_tdist_p(-abs(t), df)
end subroutine t_test
end module t_test_m
program main
use t_test_m, only: t_test, wp
implicit none
real(wp) :: x(4) = [3.0_wp, 4.0_wp, 1.0_wp, 2.1_wp]
real(wp) :: y(3) = [490.2_wp, 340.0_wp, 433.9_wp]
real(wp) :: t, df, p
call t_test(x, y, p, t, df)
print *, t, df, p
end program main
Output
-9.5594977219326580 2.0008523488562844 1.0751561149784494E-002
FreeBASIC
Using Betain
#include "crt\math.bi"
Function betain(x As Double, p As Double, q As Double) As Double
If p <= 0 Or q <= 0 Or x < 0 Or x > 1 Then
Print "ValueError"
End
End If
If x = 0 Or x = 1 Then Return x
Dim As Double acu = 1e-15
'Dim As Double lnbeta = LogGamma(p) + LogGamma(q) - LogGamma(p + q)
Dim As Double lnbeta = lGamma(p) + lGamma(q) - lGamma(p + q)
Dim As Double xx = x
Dim As Double cx = 1 - x
Dim As Double pp = p
Dim As Double qq = q
Dim As Integer indx = 0
Dim As Double psq = p + q
If p < psq * x Then
xx = 1 - x
cx = x
pp = q
qq = p
indx = 1
End If
Dim As Double term = 1.0
Dim As Double ai = 1.0
Dim As Double value = 1.0
Dim As Integer ns = Int(qq + cx * psq)
Dim As Double rx = xx / cx
Dim As Double temp = qq - ai
If ns = 0 Then rx = xx
Do
term *= temp * rx / (pp + ai)
value += term
temp = Abs(term)
If temp <= acu And temp <= acu * value Then
value *= Exp(pp * Log(xx) + (qq - 1) * Log(cx) - lnbeta) / pp
Return Iif(indx, 1 - value, value)
End If
ai += 1
If ns > 0 Then
ns -= 1
temp = qq - ai
If ns = 0 Then
rx = xx
Else
temp = psq
psq += 1
End If
End If
Loop
End Function
Sub welch_ttest(a1() As Double, a2() As Double, Byref t As Double, Byref df As Double, Byref p As Double)
Dim As Integer n1 = Ubound(a1) + 1
Dim As Integer n2 = Ubound(a2) + 1
If n1 <= 1 Or n2 <= 1 Then
Print "ValueError"
End
End If
Dim As Double mean1 = 0
For i As Integer = 0 To n1 - 1
mean1 += a1(i)
Next i
mean1 /= n1
Dim As Double mean2 = 0
For i As Integer = 0 To n2 - 1
mean2 += a2(i)
Next i
mean2 /= n2
Dim As Double var1 = 0
For i As Integer = 0 To n1 - 1
var1 += (a1(i) - mean1) ^ 2
Next i
var1 /= (n1 - 1)
Dim As Double var2 = 0
For i As Integer = 0 To n2 - 1
var2 += (a2(i) - mean2) ^ 2
Next i
var2 /= (n2 - 1)
t = (mean1 - mean2) / Sqr(var1 / n1 + var2 / n2)
df = (var1 / n1 + var2 / n2) ^ 2 / (var1 ^ 2 / (n1 ^ 2 * (n1 - 1)) + var2 ^ 2 / (n2 ^ 2 * (n2 - 1)))
p = betain(df / (t ^ 2 + df), df / 2, 1 / 2)
End Sub
Dim As Double a1(3) = {3, 4, 1, 2.1}
Dim As Double a2(2) = {490.2, 340, 433.9}
Dim As Double t, df, p
welch_ttest(a1(), a2(), t, df, p)
Print " t: "; t
Print "df: "; df
Print " p: "; p
Sleep
- Output:
t: -9.559497721932658 df: 2.000852348856284 p: 0.01075155600241868
Go
package main
import (
"fmt"
"math"
)
var (
d1 = []float64{27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6,
23.1, 19.6, 19.0, 21.7, 21.4}
d2 = []float64{27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2,
21.9, 22.1, 22.9, 20.5, 24.4}
d3 = []float64{17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8}
d4 = []float64{21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8,
20.7, 21.7, 21.5, 22.5, 23.6, 21.5, 22.5, 23.5, 21.5, 21.8}
d5 = []float64{19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0}
d6 = []float64{28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7,
23.2, 17.5, 20.6, 18.0, 23.9, 21.6, 24.3, 20.4, 24.0, 13.2}
d7 = []float64{30.02, 29.99, 30.11, 29.97, 30.01, 29.99}
d8 = []float64{29.89, 29.93, 29.72, 29.98, 30.02, 29.98}
x = []float64{3.0, 4.0, 1.0, 2.1}
y = []float64{490.2, 340.0, 433.9}
)
func main() {
fmt.Printf("%.6f\n", pValue(d1, d2))
fmt.Printf("%.6f\n", pValue(d3, d4))
fmt.Printf("%.6f\n", pValue(d5, d6))
fmt.Printf("%.6f\n", pValue(d7, d8))
fmt.Printf("%.6f\n", pValue(x, y))
}
func mean(a []float64) float64 {
sum := 0.
for _, x := range a {
sum += x
}
return sum / float64(len(a))
}
func sv(a []float64) float64 {
m := mean(a)
sum := 0.
for _, x := range a {
d := x - m
sum += d * d
}
return sum / float64(len(a)-1)
}
func welch(a, b []float64) float64 {
return (mean(a) - mean(b)) /
math.Sqrt(sv(a)/float64(len(a))+sv(b)/float64(len(b)))
}
func dof(a, b []float64) float64 {
sva := sv(a)
svb := sv(b)
n := sva/float64(len(a)) + svb/float64(len(b))
return n * n /
(sva*sva/float64(len(a)*len(a)*(len(a)-1)) +
svb*svb/float64(len(b)*len(b)*(len(b)-1)))
}
func simpson0(n int, upper float64, f func(float64) float64) float64 {
sum := 0.
nf := float64(n)
dx0 := upper / nf
sum += f(0) * dx0
sum += f(dx0*.5) * dx0 * 4
x0 := dx0
for i := 1; i < n; i++ {
x1 := float64(i+1) * upper / nf
xmid := (x0 + x1) * .5
dx := x1 - x0
sum += f(x0) * dx * 2
sum += f(xmid) * dx * 4
x0 = x1
}
return (sum + f(upper)*dx0) / 6
}
func pValue(a, b []float64) float64 {
ν := dof(a, b)
t := welch(a, b)
g1, _ := math.Lgamma(ν / 2)
g2, _ := math.Lgamma(.5)
g3, _ := math.Lgamma(ν/2 + .5)
return simpson0(2000, ν/(t*t+ν),
func(r float64) float64 { return math.Pow(r, ν/2-1) / math.Sqrt(1-r) }) /
math.Exp(g1+g2-g3)
}
- Output:
0.021378 0.148842 0.035972 0.090773 0.010751
J
Implementation:
integrate=: adverb define
'a b steps'=. 3{.y,128
size=. (b - a)%steps
size * +/ u |: 2 ]\ a + size * i.>:steps
)
simpson =: adverb def '6 %~ +/ 1 1 4 * u y, -:+/y'
lngamma=: ^.@!@<:`(^.@!@(1 | ]) + +/@:^.@(1 + 1&| + i.@<.)@<:)@.(1&<:)"0
mean=: +/ % #
nu=: # - 1:
sampvar=: +/@((- mean) ^ 2:) % nu
ssem=: sampvar % #
welch_T=: -&mean % 2 %: +&ssem
nu=: nu f. : ((+&ssem ^ 2:) % +&((ssem^2:)%nu))
B=: ^@(+&lngamma - lngamma@+)
p2_tail=:dyad define
t=. x welch_T y NB. need numbers for numerical integration
v=. x nu y
F=. ^&(_1+v%2) % 2 %: 1&-
lo=. 0
hi=. v%(t^2)+v
(F f. simpson integrate lo,hi) % 0.5 B v%2
)
integrate
and simpson
are from the Numerical integration task.
lngamma
is from http://www.jsoftware.com/pipermail/programming/2015-July/042174.html -- for values less than some convenient threshold (we use 1, but we could use a modestly higher threshold), we calculate it directly. For larger values we compute the fractional part directly and rebuild the log of the factorial using the sum of the logs.
mean
is classic J - most J tutorials will include this
The initial definition of nu
(degrees of freedom of a data set), as well as the combining form (approximating degrees of freedom for two sets of data) is from Welch's t test. (Verb definitions can be forward referenced, even in J's tacit definitions, but it seems clearer to specify these definitions so they only depend on previously declared definitions.)
sampvar
is sample variance (or: standard deviation squared)
ssem
is squared standard error of the mean
Also... please ignore the highlighting of v
in the definition of p2_tail. In this case, it's F that's the verb, v is just another number (the degrees of freedom for our two data sets. (But this is a hint that in explicit conjunction definitions, v would be the right verb argument. Unfortunately, the wiki's highlighting implementation is not capable of distinguishing that particular context from other contexts.)
Data for task examples:
d1=: 27.5 21 19 23.6 17 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19 21.7 21.4
d2=: 27.1 22 20.8 23.4 23.4 23.5 25.8 22 24.8 20.2 21.9 22.1 22.9 20.5 24.4
d3=: 17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8
d4=: 21.5 22.8 21 23 21.6 23.6 22.5 20.7 23.4 21.8 20.7 21.7 21.5 22.5 23.6 21.5 22.5 23.5 21.5 21.8
d5=: 19.8 20.4 19.6 17.8 18.5 18.9 18.3 18.9 19.5 22
d6=: 28.2 26.6 20.1 23.3 25.2 22.1 17.7 27.6 20.6 13.7 23.2 17.5 20.6 18 23.9 21.6 24.3 20.4 24 13.2
d7=: 30.02 29.99 30.11 29.97 30.01 29.99
d8=: 29.89 29.93 29.72 29.98 30.02 29.98
d9=: 3 4 1 2.1
da=: 490.2 340 433.9
Task examples:
d1 p2_tail d2
0.021378
d3 p2_tail d4
0.148842
d5 p2_tail d6
0.0359723
d7 p2_tail d8
0.0907733
d9 p2_tail da
0.0107377
Java
Using the Apache Commons Mathematics Library.
import org.apache.commons.math3.distribution.TDistribution;
public class WelchTTest {
public static double[] meanvar(double[] a) {
double m = 0.0, v = 0.0;
int n = a.length;
for (double x: a) {
m += x;
}
m /= n;
for (double x: a) {
v += (x - m) * (x - m);
}
v /= (n - 1);
return new double[] {m, v};
}
public static double[] welch_ttest(double[] x, double[] y) {
double mx, my, vx, vy, t, df, p;
double[] res;
int nx = x.length, ny = y.length;
res = meanvar(x);
mx = res[0];
vx = res[1];
res = meanvar(y);
my = res[0];
vy = res[1];
t = (mx-my)/Math.sqrt(vx/nx+vy/ny);
df = Math.pow(vx/nx+vy/ny, 2)/(vx*vx/(nx*nx*(nx-1))+vy*vy/(ny*ny*(ny-1)));
TDistribution dist = new TDistribution(df);
p = 2.0*dist.cumulativeProbability(-Math.abs(t));
return new double[] {t, df, p};
}
public static void main(String[] args) {
double x[] = {3.0, 4.0, 1.0, 2.1};
double y[] = {490.2, 340.0, 433.9};
double res[] = welch_ttest(x, y);
System.out.println("t = " + res[0]);
System.out.println("df = " + res[1]);
System.out.println("p = " + res[2]);
}
}
Result
javac -cp .;L:\java\commons-math3-3.6.1.jar WelchTTest.java java -cp .;L:\java\commons-math3-3.6.1.jar WelchTTest t = -9.559497721932658 df = 2.0008523488562844 p = 0.010751561149784485
jq
Works with gojq, the Go implementation of jq
Notice how jq supports the closure, f, in the same way as Wren.
jq's `lgamma` returns the natural logarithm of the absolute value of the gamma function of x.
def mean: add / length;
# Sample variance using division by (length-1)
def variance:
mean as $m
| (reduce .[] as $x (0; . + (($x - $m) | .*.))) / (length-1) ;
def welch(a; b):
((a|mean) - (b|mean)) /
(((a|variance/length) + (b|variance/length)) | sqrt) ;
def dof(a; b):
(a|variance) as $sva
| (b|variance) as $svb
| (a|length) as $la
| (b|length) as $lb
| ($sva/$la + $svb/$lb) as $n
| $n * $n / ($sva*$sva/($la*$la*($la-1)) + $svb*$svb/($lb*$lb*($lb-1))) ;
def simpson0(nf; upper; filter):
(upper/nf) as $dx0
| {sum: (( (0|filter) + ($dx0 * 0.5|filter) * 4) * $dx0),
x0: $dx0 }
| reduce range(1; nf) as $i (.;
( ($i + 1) * upper / nf ) as $x1
| ((.x0 + $x1) * 0.5) as $xmid
| ($x1 - .x0) as $dx
| .sum = .sum + ((.x0|filter)*2 + ($xmid|filter)*4) * $dx
| .x0 = $x1)
| (.sum + (upper|filter)*$dx0) / 6 ;
def pValue(a; b):
dof(a; b) as $nu
| def f:
. as $r
| pow($r; ($nu/2) - 1) / ((1 - $r)|sqrt);
welch(a; b) as $t
| (($nu/2)|lgamma) as $g1
| (0.5|lgamma) as $g2
| (($nu/2 + 0.5)|lgamma) as $g3
| simpson0(2000; $nu/($t*$t + $nu); f) / (($g1 + $g2 - $g3)|exp) ;
def d1: [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4];
def d2: [27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, 21.9, 22.1, 22.9, 20.5, 24.4];
def d3: [17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8];
def d4: [21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, 20.7, 21.7, 21.5, 22.5, 23.6,
21.5, 22.5, 23.5, 21.5, 21.8];
def d5: [19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0];
def d6: [28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, 23.2, 17.5, 20.6, 18.0, 23.9,
21.6, 24.3, 20.4, 24.0, 13.2];
def d7: [30.02, 29.99, 30.11, 29.97, 30.01, 29.99];
def d8: [29.89, 29.93, 29.72, 29.98, 30.02, 29.98];
def x : [3.0, 4.0, 1.0, 2.1];
def y : [490.2, 340.0, 433.9];
pValue(d1; d2),
pValue(d3; d4),
pValue(d5; d6),
pValue(d7; d8),
pValue(x; y)
- Output:
0.02137800146288292 0.1488416966053347 0.03597227102982764 0.09077332428566065 0.010750673736239608
Julia
using HypothesisTests
d1 = [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4]
d2 = [27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, 21.9, 22.1, 22.9, 20.5, 24.4]
d3 = [17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8]
d4 = [21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, 20.7, 21.7, 21.5, 22.5, 23.6, 21.5, 22.5, 23.5, 21.5, 21.8]
d5 = [19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0]
d6 = [28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, 23.2, 17.5, 20.6, 18.0, 23.9, 21.6, 24.3, 20.4, 24.0, 13.2]
d7 = [30.02, 29.99, 30.11, 29.97, 30.01, 29.99]
d8 = [29.89, 29.93, 29.72, 29.98, 30.02, 29.98]
x = [ 3.0, 4.0, 1.0, 2.1]
y = [490.2, 340.0, 433.9]
for (y1, y2) in ((d1, d2), (d3, d4), (d5, d6), (d7, d8), (x, y))
ttest = UnequalVarianceTTest(y1, y2)
println("\nData:\n y1 = $y1\n y2 = $y2\nP-value for unequal variance TTest: ", round(pvalue(ttest), 4))
end
- Output:
Data: y1 = [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4] y2 = [27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, 21.9, 22.1, 22.9, 20.5, 24.4] P-value for unequal variance TTest: 0.0214 Data: y1 = [17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8] y2 = [21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, 20.7, 21.7, 21.5, 22.5, 23.6, 21.5, 22.5, 23.5, 21.5, 21.8] P-value for unequal variance TTest: 0.1488 Data: y1 = [19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0] y2 = [28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, 23.2, 17.5, 20.6, 18.0, 23.9, 21.6, 24.3, 20.4, 24.0, 13.2] P-value for unequal variance TTest: 0.036 Data: y1 = [30.02, 29.99, 30.11, 29.97, 30.01, 29.99] y2 = [29.89, 29.93, 29.72, 29.98, 30.02, 29.98] P-value for unequal variance TTest: 0.0908 Data: y1 = [3.0, 4.0, 1.0, 2.1] y2 = [490.2, 340.0, 433.9] P-value for unequal variance TTest: 0.0108
Kotlin
This program brings in code from other tasks for gamma functions and integration by Simpson's rule as Kotlin doesn't have these built-in:
// version 1.1.4-3
typealias Func = (Double) -> Double
fun square(d: Double) = d * d
fun sampleVar(da: DoubleArray): Double {
if (da.size < 2) throw IllegalArgumentException("Array must have at least 2 elements")
val m = da.average()
return da.map { square(it - m) }.sum() / (da.size - 1)
}
fun welch(da1: DoubleArray, da2: DoubleArray): Double {
val temp = sampleVar(da1) / da1.size + sampleVar(da2) / da2.size
return (da1.average() - da2.average()) / Math.sqrt(temp)
}
fun degreesFreedom(da1: DoubleArray, da2: DoubleArray): Double {
val s1 = sampleVar(da1)
val s2 = sampleVar(da2)
val n1 = da1.size
val n2 = da2.size
val temp1 = square(s1 / n1 + s2 / n2)
val temp2 = square(s1) / (n1 * n1 * (n1 - 1)) + square(s2) / (n2 * n2 * (n2 - 1))
return temp1 / temp2
}
fun gamma(d: Double): Double {
var dd = d
val p = doubleArrayOf(
0.99999999999980993,
676.5203681218851,
-1259.1392167224028,
771.32342877765313,
-176.61502916214059,
12.507343278686905,
-0.13857109526572012,
9.9843695780195716e-6,
1.5056327351493116e-7
)
val g = 7
if (dd < 0.5) return Math.PI / (Math.sin(Math.PI * dd) * gamma(1.0 - dd))
dd--
var a = p[0]
val t = dd + g + 0.5
for (i in 1 until p.size) a += p[i] / (dd + i)
return Math.sqrt(2.0 * Math.PI) * Math.pow(t, dd + 0.5) * Math.exp(-t) * a
}
fun lGamma(d: Double) = Math.log(gamma(d))
fun simpson(a: Double, b: Double, n: Int, f: Func): Double {
val h = (b - a) / n
var sum = 0.0
for (i in 0 until n) {
val x = a + i * h
sum += (f(x) + 4.0 * f(x + h / 2.0) + f(x + h)) / 6.0
}
return sum * h
}
fun p2Tail(da1: DoubleArray, da2: DoubleArray): Double {
val nu = degreesFreedom(da1, da2)
val t = welch(da1, da2)
val g = Math.exp(lGamma(nu / 2.0) + lGamma(0.5) - lGamma(nu / 2.0 + 0.5))
val b = nu / (t * t + nu)
val f: Func = { r -> Math.pow(r, nu / 2.0 - 1.0) / Math.sqrt(1.0 - r) }
return simpson(0.0, b, 10000, f) / g // n = 10000 seems more than enough here
}
fun main(args: Array<String>) {
val da1 = doubleArrayOf(
27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6,
23.1, 19.6, 19.0, 21.7, 21.4
)
val da2 = doubleArrayOf(
27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2,
21.9, 22.1, 22.9, 20.5, 24.4
)
val da3 = doubleArrayOf(
17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8
)
val da4 = doubleArrayOf(
21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8,
20.7, 21.7, 21.5, 22.5, 23.6, 21.5, 22.5, 23.5, 21.5, 21.8
)
val da5 = doubleArrayOf(
19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0
)
val da6 = doubleArrayOf(
28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7,
23.2, 17.5, 20.6, 18.0, 23.9, 21.6, 24.3, 20.4, 24.0, 13.2
)
val da7 = doubleArrayOf(30.02, 29.99, 30.11, 29.97, 30.01, 29.99)
val da8 = doubleArrayOf(29.89, 29.93, 29.72, 29.98, 30.02, 29.98)
val x = doubleArrayOf(3.0, 4.0, 1.0, 2.1)
val y = doubleArrayOf(490.2, 340.0, 433.9)
val f = "%.6f"
println(f.format(p2Tail(da1, da2)))
println(f.format(p2Tail(da3, da4)))
println(f.format(p2Tail(da5, da6)))
println(f.format(p2Tail(da7, da8)))
println(f.format(p2Tail(x, y)))
}
- Output:
0.021378 0.148842 0.035972 0.090773 0.010751
Nim
import math, stats, strutils, sugar
func sqr(f: float): float = f * f
func degreesFreedom(da1, da2: openArray[float]): float =
let s1 = varianceS(da1)
let s2 = varianceS(da2)
let n1 = da1.len.toFloat
let n2 = da2.len.toFloat
let n = sqr(s1 / n1 + s2 / n2)
let d = sqr(s1) / (n1 * n1 * (n1 - 1)) + sqr(s2) / (n2 * n2 * (n2 - 1))
result = n / d
func welch(da1, da2: openArray[float]): float =
let f = varianceS(da1) / da1.len.toFloat + varianceS(da2) / da2.len.toFloat
result = (mean(da1) - mean(da2)) / sqrt(f)
func simpson(a, b: float; n: int; f: float -> float): float =
let h = (b - a) / n.toFloat
var sum = 0.0
for i in 0..<n:
let x = a + i.toFloat * h
sum += (f(x) + 4 * f(x + h / 2) + f(x + h)) / 6
result = sum * h
func p2Tail(da1, da2: openArray[float]): float =
let ν = degreesFreedom(da1, da2)
let t = welch(da1, da2)
let g = exp(lGamma(ν / 2) + lGamma(0.5) - lGamma(ν / 2 + 0.5))
let b = ν / (t * t + ν)
proc f(r: float): float = pow(r, ν / 2 - 1) / sqrt(1 - r)
result = simpson(0, b, 10000, f) / g # n = 10000 seems more than enough here.
when isMainModule:
const
Da1 = [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6,
23.1, 19.6, 19.0, 21.7, 21.4]
Da2 = [27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2,
21.9, 22.1, 22.9, 20.5, 24.4]
Da3 = [17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8]
Da4 = [21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8,
20.7, 21.7, 21.5, 22.5, 23.6, 21.5, 22.5, 23.5, 21.5, 21.8]
Da5 = [19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0]
Da6 = [28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7,
23.2, 17.5, 20.6, 18.0, 23.9, 21.6, 24.3, 20.4, 24.0, 13.2]
Da7 = [30.02, 29.99, 30.11, 29.97, 30.01, 29.99]
Da8 = [29.89, 29.93, 29.72, 29.98, 30.02, 29.98]
X = [3.0, 4.0, 1.0, 2.1]
Y = [490.2, 340.0, 433.9]
echo p2Tail(Da1, Da2).formatFloat(ffDecimal, 6)
echo p2Tail(Da3, Da4).formatFloat(ffDecimal, 6)
echo p2Tail(Da5, Da6).formatFloat(ffDecimal, 6)
echo p2Tail(Da7, Da8).formatFloat(ffDecimal, 6)
echo p2Tail(X, Y).formatFloat(ffDecimal, 6)
- Output:
0.021378 0.148842 0.035972 0.090773 0.010751
Maple
WelschTTest:=proc(x::list(numeric),y::list(numeric))
uses Statistics;
local n1:=nops(x),n2:=nops(y),
m1:=Mean(x),m2:=Mean(y),
v1:=Variance(x),v2:=Variance(y),
t,nu,p;
t:=(m1-m2)/sqrt(v1/n1+v2/n2);
nu:=(v1/n1+v2/n2)^2/(v1^2/(n1^2*(n1-1))+v2^2/(n2^2*(n2-1)));
p:=2*CDF(StudentTDistribution(nu),-abs(t));
t,nu,p
end proc:
x:=[3,4,1,2.1]:
y:=[490.2,340,433.9]:
WelschTTest(x,y);
# -9.55949772193266, 2.00085234885628, 0.0107515611497845
Octave
x = [3.0,4.0,1.0,2.1];
y = [490.2,340.0,433.9];
n1 = length(x);
n2 = length(y);
v1 = var(x);
v2 = var(y);
t = (mean(x)-mean(y))/(sqrt(v1/n1+v2/n2));
df = (v1/n1+v2/n2)^2/(v1^2/(n1^2*(n1-1))+v2^2/(n2^2*(n2-1)));
p = betainc(df/(t^2+df),df/2,1/2);
[t df p]
ans =
-9.559498 2.000852 0.010752
PARI/GP
B2(x,y)=exp(lngamma(x)+lngamma(y)-lngamma(x+y))
B3(x,a,b)=a--;b--;intnum(r=0,x,r^a*(1-r)^b)
Welch2(u,v)=my(m1=vecsum(u)/#u, m2=vecsum(v)/#v, v1=var(u,m1), v2=var(v,m2), s=v1/#u+v2/#v, t=(m1-m2)/sqrt(s), nu=s^2/(v1^2/#u^2/(#u-1)+v2^2/#v^2/(#v-1))); B3(nu/(t^2+nu),nu/2,1/2)/B2(nu/2,1/2);
Welch2([3,4,1,2.1], [490.2,340,433.9])
- Output:
%1 = 0.010751561149784496723954539777213062928
Perl
Using Math::AnyNum
Uses Math::AnyNum for gamma and pi. It is possible to use some other modules (e.g. Math::Cephes) if Math::AnyNum has problematic dependencies.
use utf8;
use List::Util qw(sum);
use Math::AnyNum qw(gamma pi);
sub p_value :prototype($$) {
my ($A, $B) = @_;
(@$A > 1 && @$B > 1) || return 1;
my $x̄_a = sum(@$A) / @$A;
my $x̄_b = sum(@$B) / @$B;
my $a_var = sum(map { ($x̄_a - $_)**2 } @$A) / (@$A - 1);
my $b_var = sum(map { ($x̄_b - $_)**2 } @$B) / (@$B - 1);
($a_var && $b_var) || return 1;
my $Welsh_𝒕_statistic = ($x̄_a - $x̄_b) / sqrt($a_var/@$A + $b_var/@$B);
my $DoF = ($a_var/@$A + $b_var/@$B)**2 / (
$a_var**2 / (@$A**3 - @$A**2) +
$b_var**2 / (@$B**3 - @$B**2));
my $sa = $DoF / 2 - 1;
my $x = $DoF / ($Welsh_𝒕_statistic**2 + $DoF);
my $N = 65355;
my $h = $x / $N;
my ($sum1, $sum2) = (0, 0);
foreach my $k (0 .. $N - 1) {
my $i = $h * $k;
$sum1 += ($i + $h/2)**$sa / sqrt(1 - ($i + $h/2));
$sum2 += $i**$sa / sqrt(1-$i);
}
($h/6 * ($x**$sa / sqrt(1-$x) + 4*$sum1 + 2*$sum2) /
(gamma($sa + 1) * sqrt(pi) / gamma($sa + 1.5)))->numify;
}
my @tests = (
[27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4],
[27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, 21.9, 22.1, 22.9, 20.5, 24.4],
[17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8],
[21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, 20.7, 21.7, 21.5, 22.5, 23.6, 21.5, 22.5, 23.5, 21.5, 21.8],
[19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0],
[28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, 23.2, 17.5, 20.6, 18.0, 23.9, 21.6, 24.3, 20.4, 24.0, 13.2],
[30.02, 29.99, 30.11, 29.97, 30.01, 29.99],
[29.89, 29.93, 29.72, 29.98, 30.02, 29.98],
[3.0, 4.0, 1.0, 2.1],
[490.2, 340.0, 433.9],
);
while (@tests) {
my ($left, $right) = splice(@tests, 0, 2);
print p_value($left, $right), "\n";
}
- Output:
0.0213780014628667 0.148841696605327 0.0359722710297968 0.0907733242856612 0.0107515340333929
Using Burkhardt's 'incomplete beta'
We use a slightly more accurate lgamma than the C code. Note that Perl can be compiled with different underlying floating point representations -- double, long double, or quad double.
use strict;
use warnings;
use List::Util 'sum';
sub lgamma {
my $x = shift;
my $log_sqrt_two_pi = 0.91893853320467274178;
my @lanczos_coef = (
0.99999999999980993, 676.5203681218851, -1259.1392167224028,
771.32342877765313, -176.61502916214059, 12.507343278686905,
-0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7 );
my $base = $x + 7.5;
my $sum = 0;
$sum += $lanczos_coef[$_] / ($x + $_) for reverse (1..8);
$sum += $lanczos_coef[0];
$sum = $log_sqrt_two_pi + log($sum/$x) + ( ($x+0.5)*log($base) - $base );
$sum;
}
sub calculate_P_value {
my ($array1,$array2) = (shift, shift);
return 1 if @$array1 <= 1 or @$array2 <= 1;
my $mean1 = sum(@$array1);
my $mean2 = sum(@$array2);
$mean1 /= scalar @$array1;
$mean2 /= scalar @$array2;
return 1 if $mean1 == $mean2;
my ($variance1,$variance2);
$variance1 += ($mean1-$_)**2 for @$array1;
$variance2 += ($mean2-$_)**2 for @$array2;
return 1 if $variance1 == 0 and $variance2 == 0;
$variance1 = $variance1/(@$array1-1);
$variance2 = $variance2/(@$array2-1);
my $Welch_t_statistic = ($mean1-$mean2)/sqrt($variance1/@$array1+$variance2/@$array2);
my $DoF = (($variance1/@$array1+$variance2/@$array2)**2) /
(
($variance1*$variance1)/(@$array1*@$array1*(@$array1-1)) +
($variance2*$variance2)/(@$array2*@$array2*(@$array2-1))
);
my $A = $DoF / 2;
my $value = $DoF / ($Welch_t_statistic**2 + $DoF);
return $value if $A <= 0 or $value <= 0 or 1 <= $value;
# from here, translation of John Burkhardt's C code
my $beta = lgamma($A) + 0.57236494292470009 - lgamma($A+0.5); # constant is lgamma(.5), but more precise than 'lgamma' routine
my $eps = 10**-15;
my($ai,$cx,$indx,$ns,$pp,$psq,$qq,$qq_ai,$rx,$term,$xx);
$psq = $A + 0.5;
$cx = 1 - $value;
if ($A < $psq * $value) { ($xx, $cx, $pp, $qq, $indx) = ($cx, $value, 0.5, $A, 1) }
else { ($xx, $pp, $qq, $indx) = ($value, $A, 0.5, 0) }
$term = $ai = $value = 1;
$ns = int $qq + $cx * $psq;
# Soper reduction formula
$qq_ai = $qq - $ai;
$rx = $ns == 0 ? $xx : $xx / $cx;
while (1) {
$term = $term * $qq_ai * $rx / ( $pp + $ai );
$value = $value + $term;
$qq_ai = abs($term);
if ($qq_ai <= $eps && $qq_ai <= $eps * $value) {
$value = $value * exp ($pp * log($xx) + ($qq - 1) * log($cx) - $beta) / $pp;
$value = 1 - $value if $indx;
last;
}
$ai++;
$ns--;
if ($ns >= 0) {
$qq_ai = $qq - $ai;
$rx = $xx if $ns == 0;
} else {
$qq_ai = $psq;
$psq = $psq + 1;
}
}
$value
}
my @answers = (
0.021378001462867,
0.148841696605327,
0.0359722710297968,
0.090773324285671,
0.0107515611497845,
0.00339907162713746,
0.52726574965384,
0.545266866977794,
);
my @tests = (
[27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4],
[27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4],
[17.2,20.9,22.6,18.1,21.7,21.4,23.5,24.2,14.7,21.8],
[21.5,22.8,21.0,23.0,21.6,23.6,22.5,20.7,23.4,21.8,20.7,21.7,21.5,22.5,23.6,21.5,22.5,23.5,21.5,21.8],
[19.8,20.4,19.6,17.8,18.5,18.9,18.3,18.9,19.5,22.0],
[28.2,26.6,20.1,23.3,25.2,22.1,17.7,27.6,20.6,13.7,23.2,17.5,20.6,18.0,23.9,21.6,24.3,20.4,24.0,13.2],
[30.02,29.99,30.11,29.97,30.01,29.99],
[29.89,29.93,29.72,29.98,30.02,29.98],
[3.0,4.0,1.0,2.1],
[490.2,340.0,433.9],
[0.010268,0.000167,0.000167],
[0.159258,0.136278,0.122389],
[1.0/15,10.0/62.0],
[1.0/10,2/50.0],
[9/23.0,21/45.0,0/38.0],
[0/44.0,42/94.0,0/22.0],
);
my $error = 0;
while (@tests) {
my ($left, $right) = splice(@tests, 0, 2);
my $pvalue = calculate_P_value($left,$right);
$error += abs($pvalue - shift @answers);
printf("p-value = %.14g\n",$pvalue);
}
printf("cumulative error is %g\n", $error);
- Output:
p-value = 0.021378001462867 p-value = 0.14884169660533 p-value = 0.035972271029797 p-value = 0.090773324285661 p-value = 0.010751561149784 p-value = 0.0033990716271375 p-value = 0.52726574965384 p-value = 0.54526686697779 cumulative error is 1.11139e-14
Phix
with javascript_semantics function mean(sequence a) return sum(a) / length(a) end function function sv(sequence a) integer la = length(a) atom m := mean(a), tot := 0 for i=1 to la do atom d = a[i] - m tot += d * d end for return tot / (la-1) end function function welch(sequence a, b) integer la = length(a), lb = length(b) return (mean(a) - mean(b)) / sqrt(sv(a)/la+sv(b)/lb) end function function dof(sequence a, b) integer la = length(a), lb = length(b) atom sva := sv(a), svb := sv(b), n := sva/la + svb/lb return n * n / (sva*sva/(la*la*(la-1)) + svb*svb/(lb*lb*(lb-1))) end function function f(atom r, v) return power(r, v/2-1) / sqrt(1-r) end function function simpson0(integer n, atom high, v) atom tot := 0, dx0 := high / n, x0 := dx0, x1, xmid, dx tot += f(0,v) * dx0 tot += f(dx0*.5,v) * dx0 * 4 for i=1 to n-1 do x1 := (i+1) * high / n xmid := (x0 + x1) * .5 dx := x1 - x0 tot += f(x0,v) * dx * 2 tot += f(xmid,v) * dx * 4 x0 = x1 end for return (tot + f(high,v)*dx0) / 6 end function constant p = { 0.99999999999980993, 676.5203681218851, -1259.1392167224028, 771.32342877765313, -176.61502916214059, 12.507343278686905, -0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7 } function gamma(atom d) atom dd = d, g = 7 if dd<0.5 then return PI / (sin(PI*dd) * gamma(1-dd)) end if dd -= 1 atom a = p[1], t = dd + g + 0.5 for i=2 to length(p) do a += p[i] / (dd + i - 1) end for return sqrt(2*PI) * power(t, dd + 0.5) * exp(-t) * a end function function lGamma(atom d) return log(gamma(d)) end function function pValue(sequence ab) sequence {a, b} = ab atom v := dof(a, b), t := welch(a, b), g1 := lGamma(v / 2), g2 := lGamma(.5), g3 := lGamma(v/2 + .5) return simpson0(2000, v/(t*t+v), v) / exp(g1+g2-g3) end function constant tests = {{{27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4}, {27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, 21.9, 22.1, 22.9, 20.5, 24.4}}, {{17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8}, {21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, 20.7, 21.7, 21.5, 22.5, 23.6, 21.5, 22.5, 23.5, 21.5, 21.8}}, {{19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0}, {28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, 23.2, 17.5, 20.6, 18.0, 23.9, 21.6, 24.3, 20.4, 24.0, 13.2}}, {{30.02, 29.99, 30.11, 29.97, 30.01, 29.99}, {29.89, 29.93, 29.72, 29.98, 30.02, 29.98}}, {{3.0, 4.0, 1.0, 2.1}, {490.2, 340.0, 433.9}} } for i=1 to length(tests) do ?pValue(tests[i]) end for
- Output:
0.0213780015 0.1488416966 0.035972271 0.0907733243 0.0107506737
The above was a bit off on the fifth test, so I also tried this.
using gamma() from Gamma_function#Phix (the one from above is probably also fine, but I didn't test that)
with javascript_semantics --<copy of gamma from Gamma_function#Phix> sequence c = repeat(0,12) function gamma(atom z) atom accm = c[1] if accm=0 then accm = sqrt(2*PI) c[1] = accm atom k1_factrl = 1 -- (k - 1)!*(-1)^k with 0!==1 for k=2 to 12 do c[k] = exp(13-k)*power(13-k,k-1.5)/k1_factrl k1_factrl *= -(k-1) end for end if for k=2 to 12 do accm += c[k]/(z+k-1) end for accm *= exp(-(z+12))*power(z+12,z+0.5) -- Gamma(z+1) return accm/z end function --</copy of gamma> function lgamma(atom d) return log(gamma(d)) end function function betain(atom x, p, q) if p<=0 or q<=0 or x<0 or x>1 then ?9/0 end if if x == 0 or x == 1 then return x end if atom acu = 1e-15, lnbeta = lgamma(p) + lgamma(q) - lgamma(p + q), psq = p + q, cx = 1-x bool indx = (p<psq*x) if indx then {cx,x,p,q} = {x,1-x,q,p} end if atom term = 1, ai = 1, val = 1, ns = floor(q + cx*psq), rx = iff(ns=0?x:x/cx), temp = q - ai while true do term *= temp * rx / (p + ai) val += term temp = abs(term) if temp<=acu and temp<=acu*val then val *= exp(p*log(x) + (q-1)*log(cx) - lnbeta) / p return iff(indx?1-val:val) end if ai += 1 ns -= 1 if ns>=0 then temp = q - ai if ns == 0 then rx = x end if else temp = psq psq += 1 end if end while end function function welch_ttest(sequence ab) sequence {a, b} = ab integer la = length(a), lb = length(b) atom ma = sum(a)/la, mb = sum(b)/lb, va = sum(sq_power(sq_sub(a,ma),2))/(la-1), vb = sum(sq_power(sq_sub(b,mb),2))/(lb-1), n = va/la + vb/lb, t = (ma-mb)/sqrt(n), df = (n*n) / (va*va/(la*la*(la-1)) + vb*vb/(lb*lb*(lb-1))) return betain(df/(t*t+df), df/2, 1/2) end function constant tests = {{{27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4}, {27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, 21.9, 22.1, 22.9, 20.5, 24.4}}, {{17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8}, {21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, 20.7, 21.7, 21.5, 22.5, 23.6, 21.5, 22.5, 23.5, 21.5, 21.8}}, {{19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0}, {28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, 23.2, 17.5, 20.6, 18.0, 23.9, 21.6, 24.3, 20.4, 24.0, 13.2}}, {{30.02, 29.99, 30.11, 29.97, 30.01, 29.99}, {29.89, 29.93, 29.72, 29.98, 30.02, 29.98}}, {{3.0, 4.0, 1.0, 2.1}, {490.2, 340.0, 433.9}}, {{0.010268,0.000167,0.000167}, {0.159258,0.136278,0.122389}}, {{1.0/15,10.0/62.0}, {1.0/10,2/50.0}}, {{9/23.0,21/45.0,0/38.0}, {0/44.0,42/94.0,0/22.0}}}, correct = {0.021378001462867, 0.148841696605327, 0.0359722710297968, 0.090773324285671, 0.0107515611497845, 0.00339907162713746, 0.52726574965384, 0.545266866977794} atom cerr = 0 for i=1 to length(tests) do atom r = welch_ttest(tests[i]) ?r cerr += abs(r-correct[i]) end for ?{"cumulative error",cerr}
- Output:
0.02137800146 0.1488416966 0.03597227103 0.09077332429 0.01075156115 0.003399071627 0.5272657497 0.545266867 {"cumulative error",1.989380882e-14} -- (32 bit/p2js) {"cumulative error",4.915115776e-15} -- (64-bit)
Python
Using NumPy & SciPy
import numpy as np
import scipy as sp
import scipy.stats
def welch_ttest(x1, x2):
n1 = x1.size
n2 = x2.size
m1 = np.mean(x1)
m2 = np.mean(x2)
v1 = np.var(x1, ddof=1)
v2 = np.var(x2, ddof=1)
t = (m1 - m2) / np.sqrt(v1 / n1 + v2 / n2)
df = (v1 / n1 + v2 / n2)**2 / (v1**2 / (n1**2 * (n1 - 1)) + v2**2 / (n2**2 * (n2 - 1)))
p = 2 * sp.stats.t.cdf(-abs(t), df)
return t, df, p
welch_ttest(np.array([3.0, 4.0, 1.0, 2.1]), np.array([490.2, 340.0, 433.9]))
(-9.559497721932658, 2.0008523488562844, 0.01075156114978449)
Using betain from AS 63
First, the implementation of betain (translated from the Stata program in the discussion page). The original Fortran code is under copyrighted by the Royal Statistical Society. The C translation is under GPL, written by John Burkardt. The exact statement of the RSS license is unclear.
import math
def betain(x, p, q):
if p <= 0 or q <= 0 or x < 0 or x > 1:
raise ValueError
if x == 0 or x == 1:
return x
acu = 1e-15
lnbeta = math.lgamma(p) + math.lgamma(q) - math.lgamma(p + q)
psq = p + q
if p < psq * x:
xx = 1 - x
cx = x
pp = q
qq = p
indx = True
else:
xx = x
cx = 1 - x
pp = p
qq = q
indx = False
term = ai = value = 1
ns = math.floor(qq + cx * psq)
rx = xx / cx
temp = qq - ai
if ns == 0:
rx = xx
while True:
term *= temp * rx / (pp + ai)
value += term
temp = abs(term)
if temp <= acu and temp <= acu * value:
value *= math.exp(pp * math.log(xx) + (qq - 1) * math.log(cx) - lnbeta) / pp
return 1 - value if indx else value
ai += 1
ns -= 1
if ns >= 0:
temp = qq - ai
if ns == 0:
rx = xx
else:
temp = psq
psq += 1
The Python code is then straightforward:
import math
def welch_ttest(a1, a2):
n1 = len(a1)
n2 = len(a2)
if n1 <= 1 or n2 <= 1:
raise ValueError
mean1 = sum(a1) / n1
mean2 = sum(a2) / n2
var1 = sum((x - mean1)**2 for x in a1) / (n1 - 1)
var2 = sum((x - mean2)**2 for x in a2) / (n2 - 1)
t = (mean1 - mean2) / math.sqrt(var1 / n1 + var2 / n2)
df = (var1 / n1 + var2 / n2)**2 / (var1**2 / (n1**2 * (n1 - 1)) + var2**2 / (n2**2 * (n2 - 1)))
p = betain(df / (t**2 + df), df / 2, 1 / 2)
return t, df, p
Example
a1 = [3, 4, 1, 2.1]
a2 = [490.2, 340, 433.9]
print(welch_ttest(a1, a2))
Output
(-9.559497721932658, 2.0008523488562844, 0.01075156114978449)
R
#!/usr/bin/R
printf <- function(...) cat(sprintf(...))
#allows printing to greater number of digits #https://stackoverflow.com/questions/13023274/how-to-do-printf-in-r#13023329
d1 <- c(27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4)
d2 <- c(27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4)
d3 <- c(17.2,20.9,22.6,18.1,21.7,21.4,23.5,24.2,14.7,21.8)
d4 <- c(21.5,22.8,21.0,23.0,21.6,23.6,22.5,20.7,23.4,21.8,20.7,21.7,21.5,22.5,23.6,21.5,22.5,23.5,21.5,21.8)
d5 <- c(19.8,20.4,19.6,17.8,18.5,18.9,18.3,18.9,19.5,22.0)
d6 <- c(28.2,26.6,20.1,23.3,25.2,22.1,17.7,27.6,20.6,13.7,23.2,17.5,20.6,18.0,23.9,21.6,24.3,20.4,24.0,13.2)
d7 <- c(30.02,29.99,30.11,29.97,30.01,29.99)
d8 <- c(29.89,29.93,29.72,29.98,30.02,29.98)
x <- c(3.0,4.0,1.0,2.1)
y <- c(490.2,340.0,433.9)
v1 <- c(0.010268,0.000167,0.000167);
v2<- c(0.159258,0.136278,0.122389);
s1<- c(1.0/15,10.0/62.0);
s2<- c(1.0/10,2/50.0);
z1<- c(9/23.0,21/45.0,0/38.0);
z2<- c(0/44.0,42/94.0,0/22.0);
results <- t.test(d1,d2, alternative="two.sided", var.equal=FALSE)
printf("%.15g\n", results$p.value);
results <- t.test(d3,d4, alternative="two.sided", var.equal=FALSE)
printf("%.15g\n", results$p.value);
results <- t.test(d5,d6, alternative="two.sided", var.equal=FALSE)
printf("%.15g\n", results$p.value);
results <- t.test(d7,d8, alternative="two.sided", var.equal=FALSE)
printf("%.15g\n", results$p.value);
results <- t.test(x,y, alternative="two.sided", var.equal=FALSE)
printf("%.15g\n", results$p.value);
results <- t.test(v1,v2, alternative="two.sided", var.equal=FALSE)
printf("%.15g\n", results$p.value);
results <- t.test(s1,s2, alternative="two.sided", var.equal=FALSE)
printf("%.15g\n", results$p.value);
results <- t.test(z1,z2, alternative="two.sided", var.equal=FALSE)
printf("%.15g\n", results$p.value);
The output here is used to compare against C's output above.
- Output:
0.021378001462867 0.148841696605327 0.0359722710297968 0.090773324285671 0.0107515611497845 0.00339907162713746 0.52726574965384 0.545266866977794
Racket
#lang racket
(require math/statistics math/special-functions)
(define (p-value S1 S2 #:n (n 11000))
(define σ²1 (variance S1 #:bias #t))
(define σ²2 (variance S2 #:bias #t))
(define N1 (sequence-length S1))
(define N2 (sequence-length S2))
(define σ²/sz1 (/ σ²1 N1))
(define σ²/sz2 (/ σ²2 N2))
(define degrees-of-freedom
(/ (sqr (+ σ²/sz1 σ²/sz2))
(+ (/ (sqr σ²1) (* (sqr N1) (sub1 N1)))
(/ (sqr σ²2) (* (sqr N2) (sub1 N2))))))
(define a (/ degrees-of-freedom 2))
(define a-1 (sub1 a))
(define x (let ((welch-t-statistic (/ (- (mean S1) (mean S2)) (sqrt (+ σ²/sz1 σ²/sz2)))))
(/ degrees-of-freedom (+ (sqr welch-t-statistic) degrees-of-freedom))))
(define h (/ x n))
(/ (* (/ h 6)
(+ (* (expt x a-1)
(expt (- 1 x) -1/2))
(* 4 (for/sum ((i (in-range 0 n)))
(* (expt (+ (* h i) (/ h 2)) a-1)
(expt (- 1 (+ (* h i) (/ h 2))) -1/2))))
(* 2 (for/sum ((i (in-range 0 n)))
(* (expt (* h i) a-1) (expt (- 1 (* h i)) -1/2))))))
(* (gamma a) 1.77245385090551610 (/ (gamma (+ a 1/2))))))
(module+ test
(list
(p-value (list 27.5 21.0 19.0 23.6 17.0 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19.0 21.7 21.4)
(list 27.1 22.0 20.8 23.4 23.4 23.5 25.8 22.0 24.8 20.2 21.9 22.1 22.9 20.5 24.4))
(p-value (list 17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8)
(list 21.5 22.8 21.0 23.0 21.6 23.6 22.5 20.7 23.4 21.8
20.7 21.7 21.5 22.5 23.6 21.5 22.5 23.5 21.5 21.8))
(p-value (list 19.8 20.4 19.6 17.8 18.5 18.9 18.3 18.9 19.5 22.0)
(list 28.2 26.6 20.1 23.3 25.2 22.1 17.7 27.6 20.6 13.7
23.2 17.5 20.6 18.0 23.9 21.6 24.3 20.4 24.0 13.2))
(p-value (list 30.02 29.99 30.11 29.97 30.01 29.99)
(list 29.89 29.93 29.72 29.98 30.02 29.98))
(p-value (list 3.0 4.0 1.0 2.1)
(list 490.2 340.0 433.9))))
- Output:
(0.021378001462867013 0.14884169660532798 0.035972271029796624 0.09077332428567102 0.01075139991904718)
Raku
(formerly Perl 6)
Integration using Simpson's Rule
Perhaps "inspired by C example" may be more accurate. Gamma subroutine from Gamma function task.
sub Γ(\z) {
constant g = 9;
z < .5 ?? π / sin(π × z) / Γ(1 - z) !!
τ.sqrt × (z + g - 1/2)**(z - 1/2) ×
exp(-(z + g - 1/2)) ×
[+] <
1.000000000000000174663
5716.400188274341379136
-14815.30426768413909044
14291.49277657478554025
-6348.160217641458813289
1301.608286058321874105
-108.1767053514369634679
2.605696505611755827729
-0.7423452510201416151527e-2
0.5384136432509564062961e-7
-0.4023533141268236372067e-8
> Z× 1, |map 1/(z + *), 0..*
}
sub p-value (@A, @B) {
return 1 if @A <= 1 or @B <= 1;
my $a-mean = @A.sum / @A;
my $b-mean = @B.sum / @B;
my $a-variance = @A.map( { ($a-mean - $_)² } ).sum / (@A - 1);
my $b-variance = @B.map( { ($b-mean - $_)² } ).sum / (@B - 1);
return 1 unless $a-variance && $b-variance;
my \Welchs-𝒕-statistic = ($a-mean - $b-mean)/($a-variance/@A + $b-variance/@B).sqrt;
my $DoF = ($a-variance / @A + $b-variance / @B)² /
(($a-variance² / (@A³ - @A²)) + ($b-variance² / (@B³ - @B²)));
my $sa = $DoF / 2 - 1;
my $x = $DoF / (Welchs-𝒕-statistic² + $DoF);
my $N = 65355;
my $h = $x / $N;
my ( $sum1, $sum2 );
for ^$N »×» $h -> $i {
$sum1 += (($i + $h / 2) ** $sa) / (1 - ($i + $h / 2)).sqrt;
$sum2 += $i ** $sa / (1 - $i).sqrt;
}
(($h / 6) × ( $x ** $sa / (1 - $x).sqrt + 4 × $sum1 + 2 × $sum2)) /
( Γ($sa + 1) × π.sqrt / Γ($sa + 1.5) );
}
# Testing
for (
[<27.5 21.0 19.0 23.6 17.0 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19.0 21.7 21.4>],
[<27.1 22.0 20.8 23.4 23.4 23.5 25.8 22.0 24.8 20.2 21.9 22.1 22.9 20.5 24.4>],
[<17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8>],
[<21.5 22.8 21.0 23.0 21.6 23.6 22.5 20.7 23.4 21.8 20.7 21.7 21.5 22.5 23.6 21.5 22.5 23.5 21.5 21.8>],
[<19.8 20.4 19.6 17.8 18.5 18.9 18.3 18.9 19.5 22.0>],
[<28.2 26.6 20.1 23.3 25.2 22.1 17.7 27.6 20.6 13.7 23.2 17.5 20.6 18.0 23.9 21.6 24.3 20.4 24.0 13.2>],
[<30.02 29.99 30.11 29.97 30.01 29.99>],
[<29.89 29.93 29.72 29.98 30.02 29.98>],
[<3.0 4.0 1.0 2.1>],
[<490.2 340.0 433.9>]
) -> @left, @right { say p-value @left, @right }
- Output:
0.0213780014628669 0.148841696605328 0.0359722710297969 0.0907733242856673 0.010751534033393
Using Burkhardt's 'incomplete beta'
This uses the Soper reduction formula to evaluate the integral, which converges much more quickly than Simpson's formula.
sub lgamma ( Num(Real) \n --> Num ){
use NativeCall;
sub lgamma (num64 --> num64) is native {}
lgamma( n )
}
sub p-value (@a, @b) {
return 1 if @a.elems | @b.elems ≤ 1;
my $mean1 = @a.sum / @a.elems;
my $mean2 = @b.sum / @b.elems;
return 1 if $mean1 == $mean2;
my $variance1 = sum (@a «-» $mean1) X**2;
my $variance2 = sum (@b «-» $mean2) X**2;
return 1 if $variance1 | $variance2 == 0;
$variance1 /= @a.elems - 1;
$variance2 /= @b.elems - 1;
my $Welchs-𝒕-statistic = ($mean1-$mean2)/sqrt($variance1/@a.elems+$variance2/@b.elems);
my $DoF = ($variance1/@a.elems + $variance2/@b.elems)² /
(($variance1 × $variance1)/(@a.elems × @a.elems × (@a.elems-1)) +
($variance2 × $variance2)/(@b.elems × @b.elems × (@b.elems-1))
);
my $A = $DoF / 2;
my $value = $DoF / ($Welchs-𝒕-statistic² + $DoF);
return $value if $A | $value ≤ 0 or $value ≥ 1;
# from here, translation of John Burkhardt's C
my $beta = lgamma($A) + 0.57236494292470009 - lgamma($A+0.5); # constant is logΓ(.5), more precise than 'lgamma' routine
my $eps = 10**-15;
my $psq = $A + 0.5;
my $cx = 1 - $value;
my ($xx,$pp,$qq,$indx);
if $A < $psq × $value { ($xx, $cx, $pp, $qq, $indx) = $cx, $value, 0.5, $A, 1 }
else { ($xx, $pp, $qq, $indx) = $value, $A, 0.5, 0 }
my $term = my $ai = $value = 1;
my $ns = floor $qq + $cx × $psq;
# Soper reduction formula
my $qq-ai = $qq - $ai;
my $rx = $ns == 0 ?? $xx !! $xx / $cx;
loop {
$term ×= $qq-ai × $rx / ($pp + $ai);
$value += $term;
$qq-ai = $term.abs;
if $qq-ai ≤ $eps & $eps×$value {
$value = $value × ($pp × $xx.log + ($qq - 1) × $cx.log - $beta).exp / $pp;
$value = 1 - $value if $indx;
last
}
$ai++;
$ns--;
if $ns ≥ 0 {
$qq-ai = $qq - $ai;
$rx = $xx if $ns == 0;
} else {
$qq-ai = $psq;
$psq += 1;
}
}
$value
}
my $error = 0;
my @answers = (
0.021378001462867,
0.148841696605327,
0.0359722710297968,
0.090773324285671,
0.0107515611497845,
0.00339907162713746,
0.52726574965384,
0.545266866977794,
);
for (
[<27.5 21.0 19.0 23.6 17.0 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19.0 21.7 21.4>],
[<27.1 22.0 20.8 23.4 23.4 23.5 25.8 22.0 24.8 20.2 21.9 22.1 22.9 20.5 24.4>],
[<17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8>],
[<21.5 22.8 21.0 23.0 21.6 23.6 22.5 20.7 23.4 21.8 20.7 21.7 21.5 22.5 23.6 21.5 22.5 23.5 21.5 21.8>],
[<19.8 20.4 19.6 17.8 18.5 18.9 18.3 18.9 19.5 22.0>],
[<28.2 26.6 20.1 23.3 25.2 22.1 17.7 27.6 20.6 13.7 23.2 17.5 20.6 18.0 23.9 21.6 24.3 20.4 24.0 13.2>],
[<30.02 29.99 30.11 29.97 30.01 29.99>],
[<29.89 29.93 29.72 29.98 30.02 29.98>],
[<3.0 4.0 1.0 2.1>],
[<490.2 340.0 433.9>],
[<0.010268 0.000167 0.000167>],
[<0.159258 0.136278 0.122389>],
[<1.0/15 10.0/62.0>],
[<1.0/10 2/50.0>],
[<9/23.0 21/45.0 0/38.0>],
[<0/44.0 42/94.0 0/22.0>],
) -> @left, @right {
my $p-value = p-value @left, @right;
printf("p-value = %.14g\n",$p-value);
$error += abs($p-value - shift @answers);
}
printf("cumulative error is %g\n", $error);
- Output:
p-value = 0.021378001462867 p-value = 0.14884169660533 p-value = 0.035972271029797 p-value = 0.090773324285667 p-value = 0.010751561149784 p-value = 0.0033990716271375 p-value = 0.52726574965384 p-value = 0.54526686697779 cumulative error is 5.30131e-15
Ruby
def calculate_p_value(array1, array2)
return 1.0 if array1.size <= 1
return 1.0 if array2.size <= 1
mean1 = array1.sum / array1.size
mean2 = array2.sum / array2.size
return 1.0 if mean1 == mean2
variance1 = 0.0
variance2 = 0.0
array1.each do |x|
variance1 += (mean1 - x)**2
end
array2.each do |x|
variance2 += (mean2 - x)**2
end
return 1.0 if variance1 == 0.0 && variance2 == 0.0
variance1 /= (array1.size - 1)
variance2 /= (array2.size - 1)
welch_t_statistic = (mean1 - mean2) / Math.sqrt(variance1 / array1.size + variance2 / array2.size)
degrees_of_freedom = ((variance1 / array1.size + variance2 / array2.size)**2) / (
(variance1 * variance1) / (array1.size * array1.size * (array1.size - 1)) +
(variance2 * variance2) / (array2.size * array2.size * (array2.size - 1)))
a = degrees_of_freedom / 2
value = degrees_of_freedom / (welch_t_statistic**2 + degrees_of_freedom)
beta = Math.lgamma(a)[0] + 0.57236494292470009 - Math.lgamma(a + 0.5)[0]
acu = 10**-15
return value if a <= 0
return value if value < 0.0 || value > 1.0
return value if (value == 0) || (value == 1.0)
psq = a + 0.5
cx = 1.0 - value
if a < psq * value
xx = cx
cx = value
pp = 0.5
qq = a
indx = 1
else
xx = value
pp = a
qq = 0.5
indx = 0
end
term = 1.0
ai = 1.0
value = 1.0
ns = (qq + cx * psq).to_i
# Soper reduction formula
rx = xx / cx
temp = qq - ai
loop do
term = term * temp * rx / (pp + ai)
value += term
temp = term.abs
if temp <= acu && temp <= acu * value
value = value * Math.exp(pp * Math.log(xx) + (qq - 1.0) * Math.log(cx) - beta) / pp
value = 1.0 - value
value = 1.0 - value if indx == 0
break
end
ai += 1.0
ns -= 1
if ns >= 0
temp = qq - ai
rx = xx if ns == 0
else
temp = psq
psq += 1.0
end
end
value
end
d1 = [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4]
d2 = [27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, 21.9, 22.1, 22.9, 20.5, 24.4]
d3 = [17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8]
d4 = [21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, 20.7, 21.7, 21.5, 22.5, 23.6, 21.5, 22.5, 23.5, 21.5, 21.8]
d5 = [19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0]
d6 = [28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, 23.2, 17.5, 20.6, 18.0, 23.9, 21.6, 24.3, 20.4, 24.0, 13.2]
d7 = [30.02, 29.99, 30.11, 29.97, 30.01, 29.99]
d8 = [29.89, 29.93, 29.72, 29.98, 30.02, 29.98]
x = [3.0, 4.0, 1.0, 2.1]
y = [490.2, 340.0, 433.9]
s1 = [1.0 / 15, 10.0 / 62.0]
s2 = [1.0 / 10, 2 / 50.0]
v1 = [0.010268, 0.000167, 0.000167]
v2 = [0.159258, 0.136278, 0.122389]
z1 = [9 / 23.0, 21 / 45.0, 0 / 38.0]
z2 = [0 / 44.0, 42 / 94.0, 0 / 22.0]
CORRECT_ANSWERS = [0.021378001462867, 0.148841696605327, 0.0359722710297968,
0.090773324285671, 0.0107515611497845, 0.00339907162713746, 0.52726574965384, 0.545266866977794].freeze
pvalue = calculate_p_value(d1, d2)
error = (pvalue - CORRECT_ANSWERS[0]).abs
printf("Test sets 1 p-value = %.14g\n", pvalue)
pvalue = calculate_p_value(d3, d4)
error += (pvalue - CORRECT_ANSWERS[1]).abs
printf("Test sets 2 p-value = %.14g\n", pvalue)
pvalue = calculate_p_value(d5, d6)
error += (pvalue - CORRECT_ANSWERS[2]).abs
printf("Test sets 3 p-value = %.14g\n", pvalue)
pvalue = calculate_p_value(d7, d8)
error += (pvalue - CORRECT_ANSWERS[3]).abs
printf("Test sets 4 p-value = %.14g\n", pvalue)
pvalue = calculate_p_value(x, y)
error += (pvalue - CORRECT_ANSWERS[4]).abs
printf("Test sets 5 p-value = %.14g\n", pvalue)
pvalue = calculate_p_value(v1, v2)
error += (pvalue - CORRECT_ANSWERS[5]).abs
printf("Test sets 6 p-value = %.14g\n", pvalue)
pvalue = calculate_p_value(s1, s2)
error += (pvalue - CORRECT_ANSWERS[6]).abs
printf("Test sets 7 p-value = %.14g\n", pvalue)
pvalue = calculate_p_value(z1, z2)
error += (pvalue - CORRECT_ANSWERS[7]).abs
printf("Test sets z p-value = %.14g\n", pvalue)
printf("the cumulative error is %g\n", error)
- Output:
Test sets 1 p-value = 0.021378001462867 Test sets 2 p-value = 0.14884169660533 Test sets 3 p-value = 0.035972271029797 Test sets 4 p-value = 0.090773324285671 Test sets 5 p-value = 0.010751561149784 Test sets 6 p-value = 0.0033990716271375 Test sets 7 p-value = 0.52726574965384 Test sets z p-value = 0.54526686697779 the cumulative error is 1.34961e-15
SAS
data tbl;
input value group @@;
cards;
3 1 4 1 1 1 2.1 1 490.2 2 340 2 433.9 2
;
run;
proc ttest data=tbl;
class group;
var value;
run;
Output
group | Method | N | Mean | Std Dev | Std Err | Minimum | Maximum |
---|---|---|---|---|---|---|---|
1 | 4 | 2.5250 | 1.2790 | 0.6395 | 1.0000 | 4.0000 | |
2 | 3 | 421.4 | 75.8803 | 43.8095 | 340.0 | 490.2 | |
Diff (1-2) | Pooled | -418.8 | 48.0012 | 36.6615 | |||
Diff (1-2) | Satterthwaite | -418.8 | 43.8142 |
group | Method | Mean | 95% CL Mean | Std Dev | 95% CL Std Dev | ||
---|---|---|---|---|---|---|---|
1 | 2.5250 | 0.4898 | 4.5602 | 1.2790 | 0.7245 | 4.7688 | |
2 | 421.4 | 232.9 | 609.9 | 75.8803 | 39.5077 | 476.9 | |
Diff (1-2) | Pooled | -418.8 | -513.1 | -324.6 | 48.0012 | 29.9627 | 117.7 |
Diff (1-2) | Satterthwaite | -418.8 | -607.3 | -230.4 |
Method | Variances | DF | t Value | Pr > |t| |
---|---|---|---|---|
Pooled | Equal | 5 | -11.42 | <.0001 |
Satterthwaite | Unequal | 2.0009 | -9.56 | 0.0108 |
Equality of Variances | ||||
---|---|---|---|---|
Method | Num DF | Den DF | F Value | Pr > F |
Folded F | 2 | 3 | 3519.81 | <.0001 |
Implementation in IML:
proc iml;
use tbl;
read all var {value} into x where(group=1);
read all var {value} into y where(group=2);
close tbl;
n1 = nrow(x);
n2 = nrow(y);
v1 = var(x);
v2 = var(y);
t = (mean(x)-mean(y))/(sqrt(v1/n1+v2/n2));
df = (v1/n1+v2/n2)**2/(v1**2/(n1**2*(n1-1))+v2**2/(n2**2*(n2-1)));
p = 2*probt(-abs(t), df);
print t df p;
quit;
Output
-9.559498 2.0008523 0.0107516
Scala
import org.apache.commons.math3.distribution.TDistribution
object WelchTTest extends App {
val res = welchTtest(Array(3.0, 4.0, 1.0, 2.1), Array(490.2, 340.0, 433.9))
def welchTtest(x: Array[Double], y: Array[Double]) = {
def square[T](x: T)(implicit num: Numeric[T]): T = {
import num._
x * x
}
def count[A](a: Seq[A])(implicit num: Fractional[A]): A =
a.foldLeft(num.zero) { case (cnt, _) => num.plus(cnt, num.one) }
def mean[A](a: Seq[A])(implicit num: Fractional[A]): A = num.div(a.sum, count(a))
def variance[A](a: Seq[A])(implicit num: Fractional[A]) =
num.div(a.map(xs => square(num.minus(xs, mean(a)))).sum, num.minus(count(a), num.one))
val (nx, ny) = (x.length, y.length)
val (vx, vy) = (variance(x), variance(y))
val qt = vx / nx + vy / ny
val t = (mean(x) - mean(y)) / math.sqrt(qt)
val df = square(qt) / (square(vx) / (square(nx) * (nx - 1)) + square(vy) / (square(ny) * (ny - 1)))
val p = 2.0 * new TDistribution(df).cumulativeProbability(-math.abs(t))
(t, df, p)
}
println(s"t = ${res._1}\ndf = ${res._2}\np = ${res._3}")
println(s"\nSuccessfully completed without errors. [total ${scala.compat.Platform.currentTime - executionStart} ms]")
}
Scilab
Scilab will print a warning because the number of degrees of freedom is not an integer. However, the underlying implementation makes use of the dcdflib Fortran library, which happily accepts a noninteger df.
x = [3.0,4.0,1.0,2.1];
y = [490.2,340.0,433.9];
n1 = length(x);
n2 = length(y);
v1 = variance(x);
v2 = variance(y);
t = (mean(x)-mean(y))/(sqrt(v1/n1+v2/n2));
df = (v1/n1+v2/n2)^2/(v1^2/(n1^2*(n1-1))+v2^2/(n2^2*(n2-1)));
[p, q] = cdft("PQ", -abs(t), df);
[t df 2*p]
Output
ans = - 9.5594977 2.0008523 0.0107516
Sidef
func p_value (A, B) {
[A.len, B.len].all { _ > 1 } || return 1
var x̄_a = Math.avg(A...)
var x̄_b = Math.avg(B...)
var a_var = (A.map {|n| (x̄_a - n)**2 }.sum / A.end)
var b_var = (B.map {|n| (x̄_b - n)**2 }.sum / B.end)
(a_var && b_var) || return 1
var Welsh_𝒕_statistic = ((x̄_a - x̄_b) / √(a_var/A.len + b_var/B.len))
var DoF = ((a_var/A.len + b_var/B.len)**2 /
((a_var**2 / (A.len**3 - A.len**2)) + (b_var**2 / (B.len**3 - B.len**2))))
var sa = (DoF/2 - 1)
var x = (DoF/(Welsh_𝒕_statistic**2 + DoF))
var N = 65355
var h = x/N
var (sum1=0, sum2=0)
^N -> lazy.map { _ * h }.each { |i|
sum1 += (((i + h/2) ** sa) / √(1 - (i + h/2)))
sum2 += (( i ** sa) / √(1 - (i )))
}
(h/6 * (x**sa / √(1-x) + 4*sum1 + 2*sum2)) /
(gamma(sa + 1) * √(Num.pi) / gamma(sa + 1.5))
}
# Testing
var tests = [
%n<27.5 21.0 19.0 23.6 17.0 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19.0 21.7 21.4>,
%n<27.1 22.0 20.8 23.4 23.4 23.5 25.8 22.0 24.8 20.2 21.9 22.1 22.9 20.5 24.4>,
%n<17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8>,
%n<21.5 22.8 21.0 23.0 21.6 23.6 22.5 20.7 23.4 21.8 20.7 21.7 21.5 22.5 23.6 21.5 22.5 23.5 21.5 21.8>,
%n<19.8 20.4 19.6 17.8 18.5 18.9 18.3 18.9 19.5 22.0>,
%n<28.2 26.6 20.1 23.3 25.2 22.1 17.7 27.6 20.6 13.7 23.2 17.5 20.6 18.0 23.9 21.6 24.3 20.4 24.0 13.2>,
%n<30.02 29.99 30.11 29.97 30.01 29.99>,
%n<29.89 29.93 29.72 29.98 30.02 29.98>,
%n<3.0 4.0 1.0 2.1>,
%n<490.2 340.0 433.9>
]
tests.each_slice(2, {|left, right|
say p_value(left, right)
})
- Output:
0.0213780014628670325061113281387220205111519317756 0.148841696605327985083613019511085971435711697961 0.0359722710297967180871367618538977446933248150651 0.0907733242856668878840956275523536083406692525656 0.0107515340333929755465323718028856669932912031012
Stata
Here is a straightforward solution using the ttest command. If one does not want the output but only the p-value, prepend the command with qui and use the result r(p) as shown below. The t statistic is r(t). Notice the data are stored in a single variable, using a group variable to distinguish the two series.
Notice that here we use the option unequal of the ttest command, and not welch, so that Stata uses the Welch-Satterthwaite approximation.
mat a=(3,4,1,2.1,490.2,340,433.9\1,1,1,1,2,2,2)'
clear
svmat double a
rename (a1 a2) (x group)
ttest x, by(group) unequal
Two-sample t test with unequal variances
------------------------------------------------------------------------------
Group | Obs Mean Std. Err. Std. Dev. [95% Conf. Interval]
---------+--------------------------------------------------------------------
1 | 4 2.525 .6394985 1.278997 .4898304 4.56017
2 | 3 421.3667 43.80952 75.88032 232.8695 609.8638
---------+--------------------------------------------------------------------
combined | 7 182.0286 86.22435 228.1282 -28.95482 393.012
---------+--------------------------------------------------------------------
diff | -418.8417 43.81419 -607.282 -230.4014
------------------------------------------------------------------------------
diff = mean(1) - mean(2) t = -9.5595
Ho: diff = 0 Satterthwaite's degrees of freedom = 2.00085
Ha: diff < 0 Ha: diff != 0 Ha: diff > 0
Pr(T < t) = 0.0054 Pr(|T| > |t|) = 0.0108 Pr(T > t) = 0.9946
di r(t)
-9.5594977
di r(p)
.01075156
The computation can easily be implemented in Mata. Here is how to compute the t statistic (t), the approximate degrees of freedom (df) and the p-value (p).
st_view(a=., ., .)
x = select(a[., 1], a[., 2] :== 1)
y = select(a[., 1], a[., 2] :== 2)
n1 = length(x)
n2 = length(y)
v1 = variance(x)
v2 = variance(y)
t = (mean(x)-mean(y))/sqrt(v1/n1+v2/n2)
df = (v1/n1+v2/n2)^2/(v1^2/(n1^2*(n1-1))+v2^2/(n2^2*(n2-1)))
p = 2*t(df, -abs(t))
t,df,p
1 2 3
+----------------------------------------------+
1 | -9.559497722 2.000852349 .0107515611 |
+----------------------------------------------+
Tcl
This is not particularly idiomatic Tcl, but perhaps illustrates some of the language's relationship with the Lisp family.
#!/usr/bin/tclsh
package require math::statistics
package require math::special
namespace path {::math::statistics ::math::special ::tcl::mathfunc ::tcl::mathop}
proc incf {_var {inc 1.0}} {
upvar 1 $_var var
if {![info exists var]} {
set var 0.0
}
set var [expr {$inc + $var}]
}
proc sumfor {_var A B body} {
upvar 1 $_var var
set var $A
set res 0
while {$var < $B} {
incf res [uplevel 1 $body]
incr var
}
return $res
}
proc sqr {x} {expr {$x*$x}}
proc pValue {S1 S2 {n 11000}} {
set σ²1 [var $S1]
set σ²2 [var $S2]
set N1 [llength $S1]
set N2 [llength $S2]
set σ²/sz1 [/ ${σ²1} $N1]
set σ²/sz2 [/ ${σ²2} $N2]
set d1 [/ [sqr ${σ²1}] [* [sqr $N1] [- $N1 1]]]
set d2 [/ [sqr ${σ²2}] [* [sqr $N2] [- $N2 1]]]
set DoF [/ [sqr [+ ${σ²/sz1} ${σ²/sz2}]] [+ $d1 $d2]]
set a [/ $DoF 2.0]
set welchTstat [/ [- [mean $S1] [mean $S2]] [sqrt [+ ${σ²/sz1} ${σ²/sz2}]]]
set x [/ $DoF [+ [sqr $welchTstat] $DoF]]
set h [/ $x $n]
/ [* [/ $h 6] \
[+ [* [** $x [- $a 1]] \
[** [- 1 $x] -0.5]] \
[* 4 [sumfor i 0 $n {
* [** [+ [* $h $i] [/ $h 2]] [- $a 1]] \
[** [- 1 [* $h $i] [/ $h 2]] -0.5]}]] \
[* 2 [sumfor i 0 $n {
* [** [* $h $i] [- $a 1]] [** [- 1 [* $h $i]] -0.5]}]]]] \
[* [Gamma $a] 1.77245385090551610 [/ 1.0 [Gamma [+ $a 0.5]]]]
}
foreach {left right} {
{ 27.5 21.0 19.0 23.6 17.0 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19.0 21.7 21.4 }
{ 27.1 22.0 20.8 23.4 23.4 23.5 25.8 22.0 24.8 20.2 21.9 22.1 22.9 20.5 24.4 }
{ 17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8 }
{ 21.5 22.8 21.0 23.0 21.6 23.6 22.5 20.7 23.4 21.8 20.7 21.7 21.5 22.5 23.6 21.5 22.5 23.5 21.5 21.8 }
{ 19.8 20.4 19.6 17.8 18.5 18.9 18.3 18.9 19.5 22.0 }
{ 28.2 26.6 20.1 23.3 25.2 22.1 17.7 27.6 20.6 13.7 23.2 17.5 20.6 18.0 23.9 21.6 24.3 20.4 24.0 13.2 }
{ 30.02 29.99 30.11 29.97 30.01 29.99 }
{ 29.89 29.93 29.72 29.98 30.02 29.98 }
{ 3.0 4.0 1.0 2.1 }
{ 490.2 340.0 433.9 }
} {
puts [pValue $left $right]
}
- Output:
0.021378001462853034 0.148841696604164 0.035972271029770915 0.09077332428458083 0.010751399918798182
Wren
import "./math" for Math, Nums
import "./fmt" for Fmt
var welch = Fn.new { |a, b|
return (Nums.mean(a) - Nums.mean(b)) /
(Nums.variance(a)/a.count + Nums.variance(b)/b.count).sqrt
}
var dof = Fn.new { |a, b|
var sva = Nums.variance(a)
var svb = Nums.variance(b)
var la = a.count
var lb = b.count
var n = sva/la + svb/lb
return n * n / (sva*sva/(la*la*(la-1)) + svb*svb/(lb*lb*(lb-1)))
}
var simpson0 = Fn.new { |nf, upper, f|
var dx0 = upper/nf
var sum = (f.call(0) + f.call(dx0*0.5)*4) * dx0
var x0 = dx0
for (i in 1...nf) {
var x1 = (i + 1) * upper / nf
var xmid = (x0 + x1) * 0.5
var dx = x1 - x0
sum = sum + (f.call(x0)*2 + f.call(xmid)*4) * dx
x0 = x1
}
return (sum + f.call(upper)*dx0) / 6
}
var pValue = Fn.new { |a, b|
var nu = dof.call(a, b)
var t = welch.call(a, b)
var g1 = Math.gamma(nu/2).log
var g2 = Math.gamma(0.5).log
var g3 = Math.gamma(nu/2 + 0.5).log
var f = Fn.new { |r| r.pow(nu/2-1) / (1 - r).sqrt }
return simpson0.call(2000, nu/(t*t + nu), f) / (g1 + g2 - g3).exp
}
var d1 = [27.5, 21.0, 19.0, 23.6, 17.0, 17.9, 16.9, 20.1, 21.9, 22.6, 23.1, 19.6, 19.0, 21.7, 21.4]
var d2 = [27.1, 22.0, 20.8, 23.4, 23.4, 23.5, 25.8, 22.0, 24.8, 20.2, 21.9, 22.1, 22.9, 20.5, 24.4]
var d3 = [17.2, 20.9, 22.6, 18.1, 21.7, 21.4, 23.5, 24.2, 14.7, 21.8]
var d4 = [21.5, 22.8, 21.0, 23.0, 21.6, 23.6, 22.5, 20.7, 23.4, 21.8, 20.7, 21.7, 21.5, 22.5, 23.6,
21.5, 22.5, 23.5, 21.5, 21.8]
var d5 = [19.8, 20.4, 19.6, 17.8, 18.5, 18.9, 18.3, 18.9, 19.5, 22.0]
var d6 = [28.2, 26.6, 20.1, 23.3, 25.2, 22.1, 17.7, 27.6, 20.6, 13.7, 23.2, 17.5, 20.6, 18.0, 23.9,
21.6, 24.3, 20.4, 24.0, 13.2]
var d7 = [30.02, 29.99, 30.11, 29.97, 30.01, 29.99]
var d8 = [29.89, 29.93, 29.72, 29.98, 30.02, 29.98]
var x = [3.0, 4.0, 1.0, 2.1]
var y = [490.2, 340.0, 433.9]
Fmt.print("$0.6f", pValue.call(d1, d2))
Fmt.print("$0.6f", pValue.call(d3, d4))
Fmt.print("$0.6f", pValue.call(d5, d6))
Fmt.print("$0.6f", pValue.call(d7, d8))
Fmt.print("$0.6f", pValue.call(x, y))
- Output:
0.021378 0.148842 0.035972 0.090773 0.010751
zkl
fcn calculate_Pvalue(array1,array2){
if (array1.len()<=1 or array2.len()<=1) return(1.0);
mean1,mean2 := array1.sum(0.0),array2.sum(0.0);
if(mean1==mean2) return(1.0);
mean1/=array1.len();
mean2/=array2.len();
variance1:=array1.reduce('wrap(sum,x){ sum + (x-mean1).pow(2) },0.0);
variance2:=array2.reduce('wrap(sum,x){ sum + (x-mean2).pow(2) },0.0);
variance1/=(array1.len() - 1);
variance2/=(array2.len() - 1);
WELCH_T_STATISTIC:=(mean1-mean2)/
(variance1/array1.len() + variance2/array2.len()).sqrt();
DEGREES_OF_FREEDOM:=
( variance1/array1.len() + variance2/array2.len() ).pow(2) // numerator
/ (
(variance1*variance1)/(array1.len().pow(2)*(array1.len() - 1)) +
(variance2*variance2)/(array2.len().pow(2)*(array2.len() - 1))
);
a:=DEGREES_OF_FREEDOM/2;
x:=DEGREES_OF_FREEDOM/( WELCH_T_STATISTIC.pow(2) + DEGREES_OF_FREEDOM );
N,h := 65535, x/N;
sum1,sum2 := 0.0, 0.0;
foreach i in (N){
sum1+=((h*i + h/2.0).pow(a - 1))/(1.0 - (h*i + h/2.0)).sqrt();
sum2+=((h*i).pow(a - 1))/(1.0 - h*i).sqrt();
}
return_value:=((h/6.0)*( x.pow(a - 1)/(1.0 - x).sqrt() +
4.0*sum1 + 2.0*sum2) ) /
((0.0).e.pow(lngammal(a) + 0.57236494292470009 - lngammal(a + 0.5)));
if(return_value > 1.0) return(1.0); // or return_value is infinite, throws
return_value;
}
fcn lngammal(xx){
var [const] cof=List( // static
76.18009172947146, -86.50532032941677,
24.01409824083091, -1.231739572450155,
0.1208650973866179e-2,-0.5395239384953e-5
);
y:=x:=xx;
tmp:=x + 5.5 - (x + 0.5) * (x + 5.5).log();
ser:=1.000000000190015;
foreach x in (cof){ ser+=(x/(y+=1)); }
return((2.5066282746310005 * ser / x).log() - tmp);
}
testSets:=T(
T(T(27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4),
T(27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4)),
T(T(17.2,20.9,22.6,18.1,21.7,21.4,23.5,24.2,14.7,21.8),
T(21.5,22.8,21.0,23.0,21.6,23.6,22.5,20.7,23.4,21.8,20.7,21.7,21.5,22.5,23.6,21.5,22.5,23.5,21.5,21.8)),
T(T(19.8,20.4,19.6,17.8,18.5,18.9,18.3,18.9,19.5,22.0),
T(28.2,26.6,20.1,23.3,25.2,22.1,17.7,27.6,20.6,13.7,23.2,17.5,20.6,18.0,23.9,21.6,24.3,20.4,24.0,13.2)),
T(T(30.02,29.99,30.11,29.97,30.01,29.99),
T(29.89,29.93,29.72,29.98,30.02,29.98)),
T(T(3.0,4.0,1.0,2.1),T(490.2,340.0,433.9)) );
foreach x,y in (testSets)
{ println("Test set 1 p-value = %f".fmt(calculate_Pvalue(x,y))); }
- Output:
Test set 1 p-value = 0.021378 Test set 1 p-value = 0.148842 Test set 1 p-value = 0.035972 Test set 1 p-value = 0.090773 Test set 1 p-value = 0.010752