## Copyright (C) 2022-2025 Andreas Bertsatos <abertsatos@biol.uoa.gr>
##
## This file is part of the statistics package for GNU Octave.
##
## This program is free software; you can redistribute it and/or modify it under
## the terms of the GNU General Public License as published by the Free Software
## Foundation; either version 3 of the License, or (at your option) any later
## version.
##
## This program is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
## details.
##
## You should have received a copy of the GNU General Public License along with
## this program; if not, see <http://www.gnu.org/licenses/>.

## -*- texinfo -*-
## @deftypefn  {statistics} {@var{p} =} bvncdf (@var{x}, @var{mu}, @var{sigma})
## @deftypefnx {statistics} {@var{p} =} bvncdf (@var{x}, [], @var{sigma})
##
## Bivariate normal cumulative distribution function (CDF).
##
## @code{@var{p} = bvncdf (@var{x}, @var{mu}, @var{sigma})} will compute the
## bivariate normal cumulative distribution function of @var{x} given a mean
## parameter @var{mu} and a scale parameter @var{sigma}.
##
## @itemize
## @item @var{x} must be an @math{N*2} matrix with each variable as a column
## vector.
## @item @var{mu} can be either a scalar (common mean) or a two-element row
## vector (each element corresponds to a variable).  If empty, a zero mean is
## assumed.
## @item @var{sigma} can be a scalar (common variance) or a @math{2*2}
## covariance matrix, which must be positive definite.
## @end itemize
##
## Input arguments must be @qcode{double} or @qcode{single}; integer, logical,
## and character arrays are rejected.  MATLAB accepts a character array and
## evaluates it at the character codes, which Octave deliberately does not,
## since a character array is an integer type and integers are refused too.
##
## @seealso{mvncdf}
## @end deftypefn

## Code adapted from Thomas H. Jørgensen's work in BVNcdf.m function retrieved
## from https://www.tjeconomics.com/code/

function p = bvncdf (x, mu, sigma)
  ## Check input arguments and add defaults
  ## Check for X, MU, and SIGMA being double or single
  if (! (isfloat (x) && isfloat (mu) && isfloat (sigma)))
    error ("bvncdf: X, MU, and SIGMA must be double or single.");
  endif

  if (size (x, 2) != 2)
    error (strcat ("bvncdf: X must be an Nx2 matrix with each variable", ...
                   " as a column vector."));
  endif
  if (isempty (mu))
    mu = [0, 0];
  elseif (isscalar (mu))
    mu = [mu, mu];
  elseif (numel (mu) == 2);
    mu = mu(:)';
  else
    error ("bvncdf: MU must be a scalar or a two-element vector.");
  endif
  if (numel (sigma) == 1)
    sigma = sigma * ones (2,2);
    sigma(1,1) = 1;
    sigma(2,2) = 1;
  elseif (numel (sigma) != 4)
    error (strcat ("bvncdf: the covariance matrix must be either a", ...
                   " scalar or a 2x2 matrix."));
  endif
  ## Test for symmetric positive definite covariance matrix
  [~, err] = chol (sigma);
  if (err != 0)
    error (strcat ("bvncdf: the covariance matrix is not positive", ...
                   " definite and/or symmetric."));
  endif
  dh = (x(:,1) - mu(:,1)) / sqrt (sigma(1,1));
  dk = (x(:,2) - mu(:,2)) / sqrt (sigma(2,2));
  r = sigma(1,2) / sqrt (sigma(1,1) * sigma(2,2));
  p = NaN (size (dh));
  ## Handle special cases for infinite integration limits
  p(dh == Inf & dk == Inf) = 1; ## Both limits are infinite: P(X1 ≤ ∞, X2 ≤ ∞) = 1
  p(dk == Inf & dh != Inf) = 0.5 * erfc (- dh(dk == Inf & dh != Inf) / sqrt (2)); ## x2 → +∞ (finite x1): P(X1 ≤ x1, X2 ≤ ∞) = P(X1 ≤ x1) = Φ(dh)
  p(dh == Inf & dk != Inf) = 0.5 * erfc (- dk(dh == Inf & dk != Inf) / sqrt (2)); ## x1 → +∞ (finite x2): P(X1 ≤ ∞, X2 ≤ x2) = P(X2 ≤ x2) = Φ(dk)
  p(dh == -Inf | dk == -Inf) = 0; ## x1 → -∞ or x2 → -∞: P(X1 ≤ -∞, X2 ≤ x2) = P(X1 ≤ x1, X2 ≤ -∞) = 0
  ind = (dh > -Inf & dh < Inf & dk > -Inf & dk < Inf);
  ## For p(x1 < dh, x2 < dk, r)
  if (sum (ind) > 0)
    p(ind) = calculate_bvncdf (-dh(ind), -dk(ind), r);
  endif
endfunction

function p = calculate_bvncdf (dh,dk,r)
  if (abs (r) < 0.3)
    lg = 3;
    ## Gauss Legendre points and weights, n =  6
    w = [0.1713244923791705, 0.3607615730481384, 0.4679139345726904];
    x = [0.9324695142031522, 0.6612093864662647, 0.2386191860831970];
  elseif (abs (r) < 0.75)
    lg = 6;
    ## Gauss Legendre points and weights, n = 12
    w = [.04717533638651177, 0.1069393259953183, 0.1600783285433464, ...
         0.2031674267230659, 0.2334925365383547, 0.2491470458134029];
    x = [0.9815606342467191, 0.9041172563704750, 0.7699026741943050, ...
         0.5873179542866171, 0.3678314989981802, 0.1252334085114692];
  else
    lg = 10;
    ## Gauss Legendre points and weights, n = 20
    w = [.01761400713915212, .04060142980038694, .06267204833410906, ...
         .08327674157670475, 0.1019301198172404, 0.1181945319615184, ...
         0.1316886384491766, 0.1420961093183821, 0.1491729864726037, ...
         0.1527533871307259];
    x = [0.9931285991850949, 0.9639719272779138, 0.9122344282513259, ...
         0.8391169718222188, 0.7463319064601508, 0.6360536807265150, ...
         0.5108670019508271, 0.3737060887154196, 0.2277858511416451, ...
         0.07652652113349733];
  endif
  dim1 = ones (size (dh, 1), 1);
  dim2 = ones (1, lg);
  hk = dh .* dk;
  bvn = dim1 * 0;
  phi_dh =  0.5 * erfc (dh / sqrt (2));
  phi_dk =  0.5 * erfc (dk / sqrt (2));
  if (abs (r) < 0.925)
    hs = (dh .* dh + dk .* dk) / 2;
    asr = asin (r);
    sn1 = sin (asr * (1 - x) / 2);
    sn2 = sin (asr * (1 + x) / 2);
    bvn = sum ((dim1 * w) .* exp (((dim1 * sn1) .* (hk * dim2) - ...
              hs * dim2) ./ (1 - dim1 * (sn1 .^ 2))) + ...
              (dim1 * w) .* exp (((dim1 * sn2) .* (hk * dim2) - ...
              hs * dim2) ./ (1 - dim1 * (sn2 .^ 2))), 2) * ...
              asr / (4 * pi) + phi_dh .* phi_dk;
  else
    twopi = 2 * pi;
    if r < 0
      dk = -dk;
      hk = -hk;
    endif
    if abs (r) < 1
      as = (1 - r) * (1 + r);
      a = sqrt (as);
      bs = (dh - dk) .^ 2;
      c = (4 - hk) / 8;
      d = (12 - hk) / 16;
      asr = - (bs ./ as + hk) / 2;
      ind = asr > -100;
      bvn(ind) = a * exp (asr(ind)) .* (1 - (c(ind) .* (bs(ind) - as)) ...
                  .* (1 - d(ind) .* bs(ind) / 5) /3 ...
                  + (c(ind) .* d(ind)) .* as .^ 2 / 5 );
      ind = hk > -100;
      b = sqrt (bs);
      phi_ba = 0.5 * erfc ((b/a) / sqrt (2));
      sp = sqrt (twopi) * phi_ba;
      bvn(ind) = bvn(ind) - (exp (-hk(ind) / 2) .* sp(ind)) ...
                 .* b(ind) .* (1 - c(ind) .* bs(ind) ...
                 .* (1 - d(ind) .* bs(ind) / 5) /3);
      a = a/2;
      for is = -1:2:1
        xs = (a + a * is * x) .^ 2;
        rs = sqrt (1 - xs);
        asr1 = - ((bs * dim2) ./ (dim1 * xs) + hk * dim2) / 2;
        ind1 = (asr1 > -100);
        sp1 = (1 + (c * dim2) .* (dim1 * xs) .* ...
              (1 + (d * dim2) .* (dim1 * xs)));
        ep1 = exp (- (hk * dim2) .* (1 - dim1 * rs) ./ ...
                  (2 * (1 + dim1 * rs))) ./ (dim1 * rs);
        bvn = bvn + sum (a .* (dim1 * w) .* exp (asr1 .* ind1) ...
                           .* (ep1 .* ind1 - sp1 .* ind1), 2);
      endfor
      bvn = -bvn/twopi;
    endif
    if (r > 0)
      tmp = max (dh, dk);
      bvn =  bvn + 0.5 * erfc (tmp / sqrt (2));
    elseif (r < 0)
      phi_dh =  0.5 * erfc (dh / sqrt (2));
      phi_dk =  0.5 * erfc (dk / sqrt (2));
      bvn = - bvn + max (0, phi_dh - phi_dk);
    endif
  endif
  p = max (0, min (1, bvn));
endfunction

%!demo
%! mu = [1, -1];
%! sigma = [0.9, 0.4; 0.4, 0.3];
%! [X1, X2] = meshgrid (linspace (-1, 3, 25)', linspace (-3, 1, 25)');
%! x = [X1(:), X2(:)];
%! p = bvncdf (x, mu, sigma);
%! Z = reshape (p, 25, 25);
%! surf (X1, X2, Z);
%! title ('Bivariate Normal Distribution');
%! ylabel 'X1'
%! xlabel 'X2'

## Test output
%!test
%! mu = [1, -1];
%! sigma = [0.9, 0.4; 0.4, 0.3];
%! [X1,X2] = meshgrid (linspace (-1, 3, 25)', linspace (-3, 1, 25)');
%! x = [X1(:), X2(:)];
%! p = bvncdf (x, mu, sigma);
%! p_out = [0.00011878988774500, 0.00034404112322371, ...
%!          0.00087682502191813, 0.00195221905058185, ...
%!          0.00378235566873474, 0.00638175749734415, ...
%!          0.00943764224329656, 0.01239164888125426, ...
%!          0.01472750274376648, 0.01623228313374828]';
%! assert_equal (p([1:10]), p_out, 1e-16);
%!test
%! mu = [1, -1];
%! sigma = [0.9, 0.4; 0.4, 0.3];
%! [X1,X2] = meshgrid (linspace (-1, 3, 25)', linspace (-3, 1, 25)');
%! x = [X1(:), X2(:)];
%! p = bvncdf (x, mu, sigma);
%! p_out = [0.8180695783608276, 0.8854485749482751, ...
%!          0.9308108777385832, 0.9579855743025508, ...
%!          0.9722897881414742, 0.9788150170059926, ...
%!          0.9813597788804785, 0.9821977956568989, ...
%!          0.9824283794464095, 0.9824809345614861]';
%! assert_equal (p([616:625]), p_out, 3e-16);
%!test
%! ## Test infinite limits
%! mu = [0, 0];
%! sigma = [1 0.5; 0.5 1];
%! assert_equal (bvncdf ([Inf, Inf], mu, sigma), 1);
%! assert_equal (bvncdf ([-Inf, 2], mu, sigma), 0);
%! assert_equal (bvncdf ([1, -Inf], mu, sigma), 0);
%! assert_equal (bvncdf ([0.5, Inf], mu, sigma), normcdf (0.5), eps);
%! assert_equal (bvncdf ([Inf, 0.5], mu, sigma), normcdf (0.5), eps);
%!error<bvncdf: X, MU, and SIGMA must be double or single.> bvncdf (int32 ([0, 0]), [0, 0], eye (2))
%!error<bvncdf: X, MU, and SIGMA must be double or single.> bvncdf ([true, true], [0, 0], eye (2))
%!error<bvncdf: X, MU, and SIGMA must be double or single.> bvncdf ('ab', [0, 0], eye (2))
%!error bvncdf (randn (25,3), [], [1, 1; 1, 1]);
%!error bvncdf (randn (25,2), [], [1, 1; 1, 1]);
%!error bvncdf (randn (25,2), [], ones (3, 2));
