## Copyright (C) 2026 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{r} =} pearsrnd (@var{mu}, @var{sigma}, @var{skew}, @var{kurt})
## @deftypefnx {statistics} {@var{r} =} pearsrnd (@var{mu}, @var{sigma}, @var{skew}, @var{kurt}, @var{m})
## @deftypefnx {statistics} {@var{r} =} pearsrnd (@var{mu}, @var{sigma}, @var{skew}, @var{kurt}, @var{m}, @var{n}, @dots{})
## @deftypefnx {statistics} {@var{r} =} pearsrnd (@var{mu}, @var{sigma}, @var{skew}, @var{kurt}, [@var{m}, @var{n}, @dots{}])
## @deftypefnx {statistics} {[@var{r}, @var{type}, @var{coefs}] =} pearsrnd (@dots{})
##
## Random arrays from the Pearson system of distributions.
##
## @code{@var{r} = pearsrnd (@var{mu}, @var{sigma}, @var{skew}, @var{kurt})}
## returns a random value drawn from the distribution in the Pearson system with
## mean @var{mu}, standard deviation @var{sigma}, skewness @var{skew}, and
## kurtosis @var{kurt}.  @var{kurt} is the (non-excess) kurtosis, and the
## moments must satisfy @code{@var{kurt} > @var{skew}^2 + 1}.
##
## @code{pearsrnd (@var{mu}, @var{sigma}, @var{skew}, @var{kurt}, @var{m},
## @var{n}, @dots{})} or @code{pearsrnd (@dots{}, [@var{m}, @var{n}, @dots{}])}
## returns an @var{m}-by-@var{n}-by-@dots{} array of random values, following
## the size conventions of @code{randn}.
##
## @code{[@var{r}, @var{type}, @var{coefs}] = pearsrnd (@dots{})} also returns
## the type of the Pearson distribution (an integer @code{0} to @code{7}) in
## @var{type}, and the three coefficients @var{coefs} =
## @code{[@var{c0}, @var{c1}, @var{c2}]} of the denominator quadratic of the
## Pearson differential equation for the standardized distribution, so that
## @code{@var{f}'(@var{x}) / @var{f} (@var{x}) = -(@var{x} + @var{c1}) /
## (@var{c0} + @var{c1} @var{x} + @var{c2} @var{x}^2)}.
##
## The Pearson types are: @code{0} normal, @code{1} four-parameter beta,
## @code{2} symmetric four-parameter beta, @code{3} gamma, @code{4} (not a named
## distribution), @code{5} inverse gamma, @code{6} beta prime, and @code{7}
## Student's t.  Type @code{4} is generated by numerical inversion of its
## cumulative distribution function.
##
## @seealso{johnsrnd, random, randn}
## @end deftypefn

function [r, type, coefs] = pearsrnd (mu, sigma, skew, kurt, varargin)

  if (nargin < 4)
    print_usage ();
  endif

  if (! all (cellfun (@(v) isscalar (v) && isnumeric (v) && isreal (v), ...
                      {mu, sigma, skew, kurt})))
    error ("pearsrnd: MU, SIGMA, SKEW, and KURT must be real scalars.");
  endif
  if (sigma < 0)
    error ("pearsrnd: SIGMA must be non-negative.");
  endif
  if (kurt <= skew .^ 2 + 1)
    error ("pearsrnd: KURT must be greater than SKEW^2 + 1.");
  endif

  ## Output size, following randn's conventions
  sz = size_from_args (varargin);
  n = prod (sz);

  ## Standardized Pearson coefficients and the selected type
  [type, coefs] = pearson_type (skew, kurt);

  ## Generate standardized deviates (mean 0, variance 1), then scale and shift.
  ## Asymmetric shapes are generated for a non-negative skewness and reflected,
  ## so each generator only needs the positive-skew case.
  if (n == 0)
    z = zeros (0, 1);
  else
    sgn = sign (skew);
    if (sgn == 0)
      sgn = 1;
    endif
    z = sgn .* pearson_standard (type, abs (skew), kurt, n);
  endif

  r = reshape (mu + sigma .* z, sz);

endfunction

## Standardized Pearson coefficients [c0, c1, c2] and the type (0-7)
function [type, coefs] = pearson_type (skew, kurt)
  b1 = skew .^ 2;
  b2 = kurt;
  den = 10 .* b2 - 12 .* b1 - 18;
  c0 = (4 .* b2 - 3 .* b1) ./ den;
  c1 = skew .* (b2 + 3) ./ den;
  c2 = (2 .* b2 - 3 .* b1 - 6) ./ den;
  coefs = [c0, c1, c2];

  if (b1 == 0)
    if (b2 == 3)
      type = 0;
    elseif (b2 < 3)
      type = 2;
    else
      type = 7;
    endif
  elseif (abs (c2) < 1e-12)
    type = 3;
  else
    kappa = c1 .^ 2 ./ (4 .* c0 .* c2);
    if (kappa < 0)
      type = 1;
    elseif (abs (kappa - 1) < 1e-9)
      type = 5;
    elseif (kappa < 1)
      type = 4;
    else
      type = 6;
    endif
  endif
endfunction

## Draw n standardized (mean 0, variance 1) deviates for a non-negative skew
function z = pearson_standard (type, skew, kurt, n)
  b1 = skew .^ 2;
  b2 = kurt;
  den = 10 .* b2 - 12 .* b1 - 18;
  c0 = (4 .* b2 - 3 .* b1) ./ den;
  c1 = skew .* (b2 + 3) ./ den;
  c2 = (2 .* b2 - 3 .* b1 - 6) ./ den;

  switch (type)
    case 0
      z = randn (n, 1);

    case 7
      nu = 4 + 6 ./ (b2 - 3);
      z = trnd (nu, n, 1) ./ sqrt (nu ./ (nu - 2));

    case 2
      a = (6 ./ (3 - b2) - 3) ./ 2;
      z = (betarnd (a, a, n, 1) - 0.5) .* 2 .* sqrt (2 .* a + 1);

    case 3
      k = 4 ./ b1;
      z = (gamrnd (k, 1, n, 1) - k) ./ sqrt (k);

    case {1, 6}
      [r1, r2, p1, p2] = pearson_roots (c0, c1, c2);
      if (type == 1)
        ## Bounded: a beta distribution on [lo, hi]
        lo = min (r1, r2);
        hi = max (r1, r2);
        if (lo == r1)
          shapes = [p1, p2];
        else
          shapes = [p2, p1];
        endif
        z = lo + (hi - lo) .* betarnd (shapes(1) + 1, shapes(2) + 1, n, 1);
      else
        ## Beta prime, supported on (b, Inf) with b the root nearest the mass
        b = max (r1, r2);
        o = min (r1, r2);
        if (b == r1)
          pb = p1;
          po = p2;
        else
          pb = p2;
          po = p1;
        endif
        y = betarnd (pb + 1, -pb - po - 1, n, 1);
        y = y ./ (1 - y);
        z = b + (b - o) .* y;
      endif

    case 5
      ## Inverse gamma: x = r0 + 1 / w, with w gamma-distributed
      r0 = -c1 ./ (2 .* c2);
      k = 1 ./ c2 - 1;
      rate = -(r0 + c1) ./ c2;
      z = r0 + 1 ./ gamrnd (k, 1 ./ rate, n, 1);

    case 4
      ## Pearson IV: numerical inversion of the cdf
      z = pearson4_invcdf (c0, c1, c2, kurt, n);
  endswitch
endfunction

## Real roots and partial-fraction exponents of the Pearson denominator, using
## the numerator (x + c1) (i.e. the mode-centring constant a = -c1).
function [r1, r2, p1, p2] = pearson_roots (c0, c1, c2)
  sq = sqrt (c1 .^ 2 - 4 .* c0 .* c2);
  r1 = (-c1 - sq) ./ (2 .* c2);
  r2 = (-c1 + sq) ./ (2 .* c2);
  a = -c1;
  p1 = -(r1 - a) ./ (c2 .* (r1 - r2));
  p2 = -(r2 - a) ./ (c2 .* (r2 - r1));
endfunction

## Pearson type IV standardized deviates by numerical inversion of the cdf built
## from the closed-form density (complex denominator roots).
function z = pearson4_invcdf (c0, c1, c2, kurt, n)
  L = max (40, 6 .* kurt);
  x = linspace (-L, L, 400001)';
  D = c2 .* x .^ 2 + c1 .* x + c0;
  s = sqrt (4 .* c0 .* c2 - c1 .^ 2);
  logf = -(1 ./ (2 .* c2)) .* log (D) ...
         - c1 .* (1 - 1 ./ (2 .* c2)) .* (2 ./ s) ...
             .* atan ((2 .* c2 .* x + c1) ./ s);
  f = exp (logf - max (logf));
  F = cumtrapz (x, f);
  F = F ./ F(end);
  [F, ia] = unique (F);
  z = interp1 (F, x(ia), rand (n, 1), "linear");
endfunction

## Output size vector from the trailing size arguments, as randn accepts them
function sz = size_from_args (args)
  if (numel (args) == 0)
    sz = [1, 1];
  elseif (numel (args) == 1)
    a = args{1};
    if (isscalar (a))
      sz = [a, a];
    else
      sz = a(:)';
    endif
  else
    sz = [args{:}];
  endif
  if (! all (sz == fix (sz)))
    error ("pearsrnd: dimensions must be integers.");
  endif

  ## Negative dimensions are treated as zero, as in core Octave and MATLAB
  sz = max (sz, 0);
endfunction

%!demo
%! ## Identify the Pearson type matching a set of moments
%! [r, type, coefs] = pearsrnd (0, 1, 0.75, 4)

%!demo
%! ## Draw a sample with a target mean, sd, skewness, and kurtosis
%! r = pearsrnd (10, 2, 1, 5, 1, 1000);
%! [mean(r), std(r)]

## Type and coefficients against MATLAB
%!test
%! [~, type, coefs] = pearsrnd (0, 1, 0, 3);
%! assert_equal (type, 0);
%! assert_equal (coefs, [1, 0, 0], 1e-12);
%!test
%! [~, type, coefs] = pearsrnd (0, 1, 0, 4.5);
%! assert_equal (type, 7);
%! assert_equal (coefs, [0.666666666666667, 0, 0.111111111111111], 1e-12);
%!test
%! [~, type, coefs] = pearsrnd (0, 1, 0, 2.5);
%! assert_equal (type, 2);
%! assert_equal (coefs, [1.42857142857143, 0, -0.142857142857143], 1e-12);
%!test
%! [~, type, coefs] = pearsrnd (0, 1, 0.5, 3.5);
%! assert_equal (type, 4);
%! assert_equal (coefs, ...
%!         [0.946428571428571, 0.232142857142857, 0.0178571428571429], 1e-12);
%!test
%! [~, type, coefs] = pearsrnd (0, 1, 0.75, 4);
%! assert_equal (type, 6);
%! assert_equal (coefs, ...
%!         [0.938524590163934, 0.344262295081967, 0.0204918032786885], 1e-12);
%!test
%! [~, type, coefs] = pearsrnd (2, 3, 1, 5);
%! assert_equal (type, 4);
%! assert_equal (coefs, [0.85, 0.4, 0.05], 1e-12);
%!test
%! [~, type, coefs] = pearsrnd (0, 1, 1, 4.5);
%! assert_equal (type, 3);
%! assert_equal (coefs, [1, 0.5, 0], 1e-12);
%!test
%! [~, type, coefs] = pearsrnd (0, 1, 2, 9);
%! assert_equal (type, 3);
%! assert_equal (coefs, [1, 1, 0], 1e-12);

## Generated samples reproduce the target moments (each type is exercised)
%!test
%! cases = [0 1 0 3; 0 1 0 4.5; 0 1 0 2.5; 0 1 0.5 3.5; 0 1 0.75 4; ...
%!          2 3 1 5; 0 1 1 4.5; 0 1 2 9];
%! ## Seed per case, not once for the run: a single seed at the top leaves each
%! ## case starting wherever the ones before it left the stream, so the sample
%! ## moments below are only as reproducible as the number of draws every
%! ## earlier case happens to take.  randg needs seeding too: the Pearson
%! ## types are drawn through betarnd, gamrnd and trnd, and seeding rand and
%! ## randn alone leaves that stream running on from wherever it was.
%! for i = 1:rows (cases)
%!   rand ("state", 42); randn ("state", 42); randg ("state", 42);
%!   m = cases(i,1); s = cases(i,2); sk = cases(i,3); ku = cases(i,4);
%!   r = pearsrnd (m, s, sk, ku, 200000, 1);
%!   mr = mean (r); sr = std (r);
%!   g1 = mean (((r - mr) ./ sr) .^ 3); g2 = mean (((r - mr) ./ sr) .^ 4);
%!   assert_equal (mr, m, 0.05 .* s + 0.02);
%!   assert_equal (sr, s, 0.05 .* s + 0.02);
%!   assert_equal (g1, sk, 0.1);
%!   assert_equal (g2, ku, 0.4);
%! endfor

## Negative skewness reflects the positive-skew shape
%!test
%! rand ("state", 7); randn ("state", 7);
%! r = pearsrnd (0, 1, -1, 5, 100000, 1);
%! assert_equal (mean (((r - mean (r)) ./ std (r)) .^ 3), -1, 0.1);

## Size handling follows randn
%!test
%! assert_equal (size (pearsrnd (0, 1, 0, 3, 3, 4)), [3, 4]);
%! assert_equal (size (pearsrnd (0, 1, 0, 3, [2, 5])), [2, 5]);
%! assert_equal (isscalar (pearsrnd (0, 1, 0, 3)), true);
%! assert_equal (size (pearsrnd (0, 1, 0, 3, -1)), [0, 0]);
%! assert_equal (size (pearsrnd (0, 1, 0, 3, 2, -1, 5)), [2, 0, 5]);

## Test input validation
%!error <Invalid call to pearsrnd> pearsrnd (0, 1, 0)
%!error <pearsrnd: MU, SIGMA, SKEW, and KURT must be real scalars.> ...
%! pearsrnd (0, 1, 0, [3, 4])
%!error <pearsrnd: SIGMA must be non-negative.> pearsrnd (0, -1, 0, 3)
%!error <pearsrnd: KURT must be greater than SKEW\^2 \+ 1.> ...
%! pearsrnd (0, 1, 1, 1.5)
