spm_ncTcdf.m 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102
  1. function F = spm_ncTcdf(x,v,d)
  2. % Cumulative Distribution Function (CDF) of non-central t-distribution
  3. % FORMAT F = spm_ncTcdf(x,v,d)
  4. % x - T-variate (Student's t has range (-Inf,Inf))
  5. % v - degrees of freedom (v>0, non-integer d.f. accepted)
  6. % d - non-centrality parameter
  7. % F - CDF of non-central t-distribution with v d.f. at points x
  8. %
  9. % Reference:
  10. %--------------------------------------------------------------------------
  11. % Algorithm AS 243: Cumulative Distribution Function of the Non-Central t
  12. % Distribution
  13. % Russell V. Lenth
  14. % Applied Statistics, Vol. 38, No. 1 (1989), pp. 185-189
  15. %__________________________________________________________________________
  16. % Copyright (C) 2009-2018 Wellcome Trust Centre for Neuroimaging
  17. % Karl Friston, Guillaume Flandin
  18. % $Id: spm_ncTcdf.m 7263 2018-02-21 13:30:16Z guillaume $
  19. %-Format arguments, note & check sizes
  20. %--------------------------------------------------------------------------
  21. ad = [ndims(x);ndims(v);ndims(d)];
  22. rd = max(ad);
  23. as = [[size(x),ones(1,rd-ad(1))];...
  24. [size(v),ones(1,rd-ad(2))];...
  25. [size(d),ones(1,rd-ad(3))];];
  26. rs = max(as);
  27. xa = prod(as,2)>1;
  28. if all(xa) && any(any(diff(as(xa,:)),1))
  29. error('non-scalar args must match in size');
  30. end
  31. %-Computation
  32. %--------------------------------------------------------------------------
  33. %-Initialise result to zeros
  34. F = zeros(rs);
  35. %-Only defined for strictly positive v. Return NaN if undefined.
  36. md = true(size(x)) & v>0;
  37. if any(~md(:))
  38. F(~md) = NaN;
  39. warning('Returning NaN for out of range arguments');
  40. end
  41. %-Compute where defined
  42. if ~any(md(:)), return, end
  43. %-Compute
  44. Q = md & x < 0;
  45. if any(Q(:))
  46. if xa(1), Qx=Q; else Qx=1; end
  47. if xa(2), Qv=Q; else Qv=1; end
  48. if xa(3), Qd=Q; else Qd=1; end
  49. F(Q) = 1 - sub_ncTcdf(-x(Qx),v(Qv),-d(Qd));
  50. end
  51. Q = md & x >= 0;
  52. if any(Q(:))
  53. if xa(1), Qx=Q; else Qx=1; end
  54. if xa(2), Qv=Q; else Qv=1; end
  55. if xa(3), Qd=Q; else Qd=1; end
  56. F(Q) = sub_ncTcdf(x(Qx),v(Qv),d(Qd));
  57. end
  58. %==========================================================================
  59. function F = sub_ncTcdf(t,v,d)
  60. en = 1;
  61. x = t .* t ./ (t .* t + v);
  62. lambda = d .* d;
  63. p = 1/2 * exp(-1/2 * lambda);
  64. q = sqrt(2/pi) * p .* d;
  65. s = 1/2 - p;
  66. a = 1/2;
  67. b = 1/2 * v;
  68. rxb = (1 - x).^b;
  69. albeta = log(sqrt(pi)) + gammaln(b) - gammaln(a+b);
  70. xodd = betainc(x,a,b);
  71. godd = 2 .* rxb .* exp(a * log(x) - albeta);
  72. xeven = 1 - rxb;
  73. geven = b .* x .* rxb;
  74. F = p .* xodd + q .* xeven;
  75. while true
  76. a = a + 1;
  77. xodd = xodd - godd;
  78. xeven = xeven - geven;
  79. godd = godd .* x .* (a + b - 1) ./ a;
  80. geven = geven .* x .* (a + b - 1/2) ./ (a + 1/2);
  81. p = p .* lambda ./ (2 * en);
  82. q = q .* lambda ./ (2 * en + 1);
  83. s = s - p;
  84. en = en + 1;
  85. F = F + p .* xodd + q .* xeven;
  86. if en > 1024 || max(2 * s .* (xodd - godd)) < 1e-12
  87. break;
  88. end
  89. end
  90. F = F + spm_Ncdf(-d);