## Copyright (C) 2016-2019 by Nir Krakauer <mail@nirkrakauer.net>
##
## 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{A}, @var{B}, @var{r}, @var{U}, @var{V}] =} canoncorr (@var{X}, @var{Y})
##
## Canonical correlation analysis.
##
## Given @var{X} (size @var{k}*@var{m}) and @var{Y} (@var{k}*@var{n}), returns
## projection matrices of canonical coefficients @var{A} (size @var{m}*@var{d},
## where @var{d} is the smallest of @var{m}, @var{n}, @var{d}) and @var{B}
## (size @var{m}*@var{d}); the canonical correlations @var{r} (1*@var{d},
## arranged in decreasing order); the canonical variables @var{U}, @var{V}
## (both @var{k}*@var{d}, with orthonormal columns); and @var{stats},
## a structure containing results from Bartlett's chi-square and Rao's F tests
## of significance.
##
## @seealso{princomp}
## @end deftypefn

function [A,B,r,U,V,stats] = canoncorr (X,Y)

  k = size (X, 1); # should also be size (Y, 1)
  m = size (X, 2);
  n = size (Y, 2);
  d = min ([k m n]);

  X = center (X);
  Y = center (Y);

  [Qx Rx] = qr (X, 0);
  [Qy Ry] = qr (Y, 0);

  [U S V] = svd (Qx' * Qy, 'econ');

  A = Rx \ U(:, 1:d);
  B = Ry \ V(:, 1:d);

  ## A, B are scaled to make the covariance matrices of the outputs U, V
  ## identity matrices
  f = sqrt (k-1);
  A .*= f;
  B .*= f;

  if (nargout > 2)
    r = max (0, min (diag (S), 1))';
  endif
  if (nargout > 3)
    U = X * A;
  endif
  if (nargout > 4)
    V = Y * B;
  endif

  if (nargout > 5)
    Wilks = fliplr (cumprod (fliplr ((1 - r .^ 2))));
    chisq = - (k - 1 - (m + n + 1)/2) * log (Wilks);
    df1 = (m - (1:d) + 1) .* (n - (1:d) + 1);
    pChisq = 1 - chi2cdf (chisq, df1);
    s = sqrt ((df1.^2 - 4) ./ ((m - (1:d) + 1).^2 + (n - (1:d) + 1).^2 - 5));
    df2 = (k - 1 - (m + n + 1)/2) * s - df1/2 + 1;
    ls = Wilks .^ (1 ./ s);
    F = (1 ./ ls  -  1) .* (df2 ./ df1);
    pF = 1 - fcdf (F, df1, df2);
    stats.Wilks = Wilks;
    stats.df1 = df1;
    stats.df2 = df2;
    stats.F = F;
    stats.pF = pF;
    stats.chisq = chisq;
    stats.pChisq = pChisq;
  endif
endfunction

%!shared X, Y, A, B, r, U, V, k, Cuv
%! k = 10;
%! X = [1:k; sin(1:k); cos(1:k)]';
%! Y = [tan(1:k); tanh((1:k)/k)]';
%! [A, B, r, U, V, stats] = canoncorr (X, Y);
%! Cuv = (U' * V) / (k - 1);
%!assert_equal (diag (Cuv)', r, 10 * eps);
%!assert_equal (diag (diag (Cuv)), Cuv, 2 * eps);
%!assert_equal (r, [0.99590, 0.26754], 1E-5);
%!assert_equal (U, center (X) * A, 10 * eps);
%!assert_equal (V, center (Y) * B, 10 * eps);
%!assert_equal (cov (U), eye (size (U, 2)), 10 * eps);
%!assert_equal (cov (V), eye (size (V, 2)), 10 * eps);
%! rand ('state', 1); [A, B, r] = canoncorr (rand (5, 10), rand (5, 20));
%!assert_equal (r, ones (1, 5), 10*eps);
