## 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} =} johnsrnd (@var{quantiles})
## @deftypefnx {statistics} {@var{r} =} johnsrnd (@var{quantiles}, @var{m})
## @deftypefnx {statistics} {@var{r} =} johnsrnd (@var{quantiles}, @var{m}, @var{n}, @dots{})
## @deftypefnx {statistics} {@var{r} =} johnsrnd (@var{quantiles}, [@var{m}, @var{n}, @dots{}])
## @deftypefnx {statistics} {[@var{r}, @var{type}, @var{coefs}] =} johnsrnd (@dots{})
##
## Random arrays from the Johnson system of distributions.
##
## @code{@var{r} = johnsrnd (@var{quantiles})} returns a random value drawn from
## the distribution in the Johnson system that matches the four values in
## @var{quantiles}.  @var{quantiles} is a four-element vector of the desired
## quantiles at the standard normal quantiles @code{[-1.5, -0.5, 0.5, 1.5]}, and
## its elements must be strictly increasing.  @code{johnsrnd} fits the Johnson
## curve passing through these four points using the quantile method of Slifker
## and Shapiro.
##
## @code{johnsrnd (@var{quantiles}, @var{m}, @var{n}, @dots{})} or
## @code{johnsrnd (@var{quantiles}, [@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}] = johnsrnd (@dots{})} also returns
## the selected member of the Johnson system in @var{type}, one of @qcode{"SN"}
## (the normal distribution), @qcode{"SL"} (lognormal), @qcode{"SU"}
## (unbounded), or @qcode{"SB"} (bounded), and the coefficients @var{coefs} =
## @code{[@var{gamma}, @var{delta}, @var{xi}, @var{lambda}]} of the transform.
## A value @var{r} is generated by transforming a standard normal deviate
## @var{z} as @code{@var{r} = @var{xi} + @var{lambda} * g ((@var{z} -
## @var{gamma}) / @var{delta})}, where @code{g} is the identity, @code{exp},
## @code{sinh}, or the logistic function for @qcode{"SN"}, @qcode{"SL"},
## @qcode{"SU"}, and @qcode{"SB"}, respectively.
##
## @seealso{pearsrnd, random, randn}
## @end deftypefn

function [r, type, coefs] = johnsrnd (quantiles, varargin)

  if (nargin < 1)
    print_usage ();
  endif

  if (! (isnumeric (quantiles) && isreal (quantiles) && isvector (quantiles) ...
         && numel (quantiles) == 4))
    error ("johnsrnd: QUANTILES must be a four-element numeric vector.");
  endif
  q = quantiles(:)';
  if (any (diff (q) <= 0))
    error ("johnsrnd: QUANTILES must be strictly increasing.");
  endif

  ## Fit the Johnson curve through the four quantiles
  [type, coefs] = johnson_fit (q);

  ## Draw standard normal deviates and apply the fitted transform.  Negative
  ## dimensions are treated as zero, as in core Octave and MATLAB.
  szargs = cellfun (@(x) max (x, 0), varargin, 'UniformOutput', false);
  z = randn (szargs{:});
  u = (z - coefs(1)) ./ coefs(2);
  xi = coefs(3);
  lambda = coefs(4);
  switch (type)
    case "SN"
      r = xi + lambda .* u;
    case "SL"
      r = xi + lambda .* exp (u);
    case "SU"
      r = xi + lambda .* sinh (u);
    case "SB"
      r = xi + lambda ./ (1 + exp (-u));
  endswitch

endfunction

## Quantile-method fit (Slifker & Shapiro 1980) at the fixed standard normal
## anchors z = [-1.5, -0.5, 0.5, 1.5], i.e. z0 = 0.5 and 3*z0 = 1.5.  Returns
## the Johnson family and the transform coefficients [gamma, delta, xi, lambda].
function [type, coefs] = johnson_fit (q)

  x1 = q(1); x2 = q(2); x3 = q(3); x4 = q(4);
  m = x4 - x3;             # top gap    (x at 1.5 minus x at 0.5)
  n = x2 - x1;             # bottom gap (x at -0.5 minus x at -1.5)
  p = x3 - x2;             # middle gap (x at 0.5 minus x at -0.5)
  d = m .* n ./ p .^ 2;    # Slifker-Shapiro discriminant
  t1 = m ./ p;
  t2 = n ./ p;

  if (abs (d - 1) < 1e-9)
    if (abs (m - n) < 1e-9)
      ## Symmetric and linear in z: the normal distribution
      type = "SN";
      coefs = [0, 1 ./ p, (x2 + x3) ./ 2, 1];
    else
      ## Lognormal
      type = "SL";
      delta = 1 ./ log (t1);
      lambda = 1;
      scale = p ./ (2 .* sinh (0.5 ./ delta));
      gamma = -delta .* log (scale ./ lambda);
      xi = x2 - lambda .* exp ((-0.5 - gamma) ./ delta);
      coefs = [gamma, delta, xi, lambda];
    endif
  elseif (d > 1)
    ## Unbounded
    type = "SU";
    delta = 1 ./ acosh (0.5 .* (t1 + t2));
    gamma = delta .* asinh ((t2 - t1) ./ (2 .* sqrt (d - 1)));
    lambda = 2 .* p .* sqrt (d - 1) ./ ((t1 + t2 - 2) .* sqrt (t1 + t2 + 2));
    xi = 0.5 .* (x2 + x3) + p .* (t2 - t1) ./ (2 .* (t1 + t2 - 2));
    coefs = [gamma, delta, xi, lambda];
  else
    ## Bounded
    type = "SB";
    a = (1 + p ./ m) .* (1 + p ./ n);
    r = p .^ 2 ./ (m .* n) - 1;
    delta = 0.5 ./ acosh (0.5 .* sqrt (a));
    gamma = delta .* asinh ((p ./ n - p ./ m) .* sqrt (a - 4) ./ (2 .* r));
    lambda = p .* sqrt ((a - 2) .^ 2 - 4) ./ r;
    xi = 0.5 .* (x2 + x3) - 0.5 .* lambda + p .* (p ./ n - p ./ m) ./ (2 .* r);
    coefs = [gamma, delta, xi, lambda];
  endif

endfunction

%!demo
%! ## Fit a Johnson distribution to four quantiles and identify its type
%! [r, type, coefs] = johnsrnd ([-1, -0.25, 0.75, 3])

%!demo
%! ## Draw a sample and check its shape
%! r = johnsrnd ([-1, -0.25, 0.75, 3], 1, 1000);
%! hist (r, 50);

## Type and coefficients against MATLAB
%!test
%! [~, type, coefs] = johnsrnd ([-1.5, -0.5, 0.5, 1.5]);
%! assert_equal (type, "SN");
%! assert_equal (coefs, [0, 1, 0, 1], 1e-12);
%!test
%! [~, type, coefs] = johnsrnd ([-1, -0.25, 0.75, 3]);
%! assert_equal (type, "SU");
%! assert_equal (coefs, [-0.843945656908448, 1.03904346061751, ...
%!                 -0.5, 0.741619848709566], 1e-10);
%!test
%! [~, type, coefs] = johnsrnd ([0.2, 0.9, 1.4, 1.8]);
%! assert_equal (type, "SU");
%! assert_equal (coefs, ...
%!         [1.76613094093528, 2.25444447413448, 1.9, 0.845154254728516], 1e-10);
%!test
%! [~, type, coefs] = johnsrnd ([1, 2, 4, 9]);
%! assert_equal (type, "SU");
%! assert_equal (coefs, [-1.5, 1.03904346061751, 1, 0.894427190999916], 1e-10);
%!test
%! [~, type, coefs] = johnsrnd ([-3, -0.75, 0.25, 1]);
%! assert_equal (type, "SU");
%! assert_equal (coefs, [0.843945656908448, 1.03904346061751, ...
%!                 0.5, 0.741619848709566], 1e-10);

## Bounded and lognormal fits reproduce their input quantiles (unique fit)
%!test
%! q = [0.1, 0.3, 0.8, 0.95];
%! [~, type, c] = johnsrnd (q);
%! assert_equal (type, "SB");
%! z = [-1.5, -0.5, 0.5, 1.5];
%! xz = c(3) + c(4) ./ (1 + exp (-(z - c(1)) ./ c(2)));
%! assert_equal (xz, q, 1e-12);
%!test
%! q = [0, 1, 3, 7];
%! [~, type, c] = johnsrnd (q);
%! assert_equal (type, "SL");
%! z = [-1.5, -0.5, 0.5, 1.5];
%! xz = c(3) + c(4) .* exp ((z - c(1)) ./ c(2));
%! assert_equal (xz, q, 1e-10);

## Size handling follows randn; bounded draws stay within the support
%!test
%! r = johnsrnd ([-1, -0.25, 0.75, 3], 3, 4);
%! assert_equal (size (r), [3, 4]);
%! assert_equal (all (isfinite (r), 'all'), true);
%! assert_equal (size (johnsrnd ([-1, -0.25, 0.75, 3], -1)), [0, 0]);
%! assert_equal (size (johnsrnd ([-1, -0.25, 0.75, 3], 2, -1, 5)), [2, 0, 5]);
%!test
%! [r, ~, c] = johnsrnd ([0.1, 0.3, 0.8, 0.95], 1, 500);
%! assert_equal (all (r > c(3) & r < c(3) + c(4), 'all'), true);

## Test input validation
%!error <Invalid call to johnsrnd> johnsrnd ()
%!error <johnsrnd: QUANTILES must be a four-element numeric vector.> ...
%! johnsrnd ([1, 2, 3])
%!error <johnsrnd: QUANTILES must be a four-element numeric vector.> ...
%! johnsrnd ("abcd")
%!error <johnsrnd: QUANTILES must be strictly increasing.> ...
%! johnsrnd ([1, 2, 2, 3])
%!error <johnsrnd: QUANTILES must be strictly increasing.> ...
%! johnsrnd ([4, 3, 2, 1])
