function toms655_test ( )

%*****************************************************************************80
%
%% TOMS655_TEST tests the TOMS655 library.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 February 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TOMS655_PRB\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '  Test the TOMS655 library.\n' );

  test01 ( );
  test02 ( );
  test03 ( );
  test04 ( );
  test05 ( );
  test06 ( );
  test07 ( );
  test08 ( );
  test09 ( );
%
%  Compute 15 points of an example of each rule.
%
  for kind = 1 : 9
    nt = 15;
    if ( kind == 8 )
      alpha = 1.0;
      beta = - alpha - 2 * nt - 2;
    else
      alpha = 0.0;
      beta = 0.0;
    end
    test10 ( nt, kind, alpha, beta );
  end
%
%  Compute 15 points of an example of each rule using nondefault A, B.
%
  for kind = 1 : 9

    nt = 15;

    if ( kind == 1 )
      alpha = 0.0;
      beta = 0.0;
      a = 0.0;
      b = 1.0;
    elseif ( kind == 2 )
      alpha = 0.0;
      beta = 0.0;
      a = 0.0;
      b = 1.0;
    elseif ( kind == 3 )
      alpha = 1.0;
      beta = 0.0;
      a = 0.0;
      b = 1.0;
    elseif ( kind == 4 )
      alpha = 1.5;
      beta = 0.5;
      a = 0.0;
      b = 1.0;
    elseif ( kind == 5 )
      alpha = 1.0;
      beta = 0.0;
      a = 1.0;
      b = 1.0;
    elseif ( kind == 6 )
      alpha = 1.0;
      beta = 0.0;
      a = 0.0;
      b = 0.5;
    elseif ( kind == 7 )
      alpha = 1.0;
      beta = 0.0;
      a = 0.0;
      b = 1.0;
    elseif ( kind == 8 )
      alpha = 1.0;
      beta = - alpha - 2 * nt - 2;
      a = 0.0;
      b = 1.0;
    elseif ( kind == 9 )
      alpha = 0.0;
      beta = 0.0;
      a = 0.0;
      b = 1.0;
    end

    test11 ( nt, kind, alpha, beta, a, b );

  end
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TOMS655_PRB\n' );
  fprintf ( 1, '  Normal end of TOMS655 tests.\n' );
  fprintf ( 1, '\n' );
  timestamp ( );

  return
end
function test01 ( )

%*****************************************************************************80
%
%% TEST01 tests CIQFS.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    05 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
  fprintf ( 1, '  ----------------------------------------\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST01\n' );
  fprintf ( 1, '  Test CIQFS.\n' );
%
%  Number of knots.
%
  nt = 5;
%
%  Set the knots in the default interval [-1,+1].
%
  t = zeros ( nt, 1 );
  for i = 1 : nt
    t(i) = cos ( ( 2 * i - 1 ) * pi / 2.0 / nt );
  end
%
%  Set the knot multiplicities.
%
  mlt(1:nt) = 2;
%
%  Set the size of the weights array.
%
  nwts = sum ( mlt(1:nt) );
%
%  Because KEY = 1, NDX will be set up for us.
%
  ndx = zeros(nt,1);
%
%  KEY = 1 indicates that the WTS array should hold the weights
%  in the usual order.
%
  key = 1;
%
%  Request Legendre weight function.
%
  kind = 1;
%
%  ALPHA, BETA not used in Legendre weight function but set anyway.
%
  alpha = 0.0;
  beta  = 0.0;
%
%  LU controls printing.
%  A positive value requests that we compute and print weights, and
%  conduct a moments check.
%
  lu = 6;

  [ wts, ndx ] = ciqfs ( nt, t, mlt, nwts, ndx, key, kind, alpha, beta, lu );

  return
end
function test02 ( )

%*****************************************************************************80
%
%% TEST02 tests CIQFS.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
  fprintf ( 1, '  ----------------------------------------\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST02\n' );
  fprintf ( 1, '  Test CIQF, CIQFS, CGQF and CGQFS\n' );
  fprintf ( 1, '  with all classical weight functions.\n' );
%
%  Try all weight functions.
%
  for kind = 1 : 9
%
%  Number of knots.
%
    nt = 5;
%
%  Set parameters ALPHA and BETA.
%
    alpha = 0.5;
    if ( kind ~= 8 )
      beta  = 2.0;
    else
      beta = - 16.0;
    end
%
%  Set A and B.
%
    lo = 6;
    a = - 0.5;
    b = 2.0;
%
%  Have CGQF compute the knots and weights.
%
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Knots and weights of Gauss quadrature formula\n' );
    fprintf ( 1, '  computed by CGQF.\n' );
    [ t, wts ] = cgqf ( nt, kind, alpha, beta, lo, a, b );
%
%  Now compute the weights for the same knots by CIQF.
%
%  Set the knot multiplicities.
%
    mlt = zeros(nt,1);
    mlt(1:nt) = 2;
%
%  Set the size of the weights array.
%
    nwts = sum ( mlt(1:nt) );
%
%  Because KEY = 1, NDX will be set up for us.
%
    ndx = zeros(nt,1);
%
%  KEY = 1 indicates that the WTS array should hold the weights
%  in the usual order.
%
    key = 1;
%
%  LU controls printing.
%  A positive value requests that we compute and print weights, and
%  conduct a moments check.
%
    lu = 6;

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Weights of Gauss quadrature formula computed from the\n' );
    fprintf ( 1, '  knots by CIQF.\n' );

    wts = ciqf ( nt, t, mlt, nwts, ndx, key, kind, alpha, beta, a, b, lu );

  end

  return
end
function test03 ( )

%*****************************************************************************80
%
%% TEST03 tests CEIQFS.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
  fprintf ( 1, '  ----------------------------------------\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST03\n' );
  fprintf ( 1, '  Test CEIQFS.\n' );
%
%  Number of knots.
%
  nt = 5;
%
%  Set the knots in the default interval [-1,+1].
%
  t = zeros ( nt, 1 );

  for i = 1 : nt
    t(i) = cos ( ( 2 * i - 1 ) * pi / 2.0 / nt );
  end
%
%  Set the knot multiplicities.
%
  mlt = zeros ( nt, 1 );
  mlt(1:nt) = 2;
%
%  Set KIND to the Legendre weight function.
%
  kind = 1;
%
%  ALPHA, BETA not used in Legendre weight function but set anyway.
%
  alpha = 0.0;
  beta  = 0.0;
%
%  Call CEIQFS to set up the quadrature formula and evaluate it on F.
%
  qfsum = ceiqfs ( nt, t, mlt, kind, alpha, beta, @f );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Integral of sin(x) on -1, 1 by Fejer type rule\n' );
  fprintf ( 1, '  with %d points of multiplicity 2.\n', nt );
  fprintf ( 1, '  Quadrature formula: %24.16f\n', qfsum );

  qfsx = cos ( - 1.0 ) - cos ( 1.0 );
  fprintf ( 1, '  Exact value       : %24.16f\n', qfsx );
  fprintf ( 1, '  Error             : %e\n', abs ( qfsum - qfsx ) );

  return
end
function test04 ( )

%*****************************************************************************80
%
%% TEST04 tests CEIQF.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
  fprintf ( 1, '  ----------------------------------------\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST04\n' );
  fprintf ( 1, '  Test CEIQF.\n' );
%
%  Number of knots.
%
  nt = 5;
%
%  Set the knots in the default interval [-1,+1].
%
  t = zeros ( nt, 1 );

  for i = 1 : nt
    t(i) = cos ( ( 2 * i - 1 ) * pi / 2.0 / nt );
  end
%
%  Set the knot multiplicities.
%
  mlt = zeros ( nt, 1 );
  mlt(1:nt) = 2;
%
%  Set KIND to the Legendre weight function.
%
  kind = 1;
%
%  ALPHA, BETA not used in Legendre weight function but set anyway.
%
  alpha = 0.0;
  beta  = 0.0;
%
%  Set nonstandard interval A, B.
%
  a = - 0.5;
  b = 2.0;
%
%  Shift knots from [-1,1] to [A,B].
%
  for i = 1 : nt
    t(i) = ( ( b - a ) * t(i) + ( a + b ) ) / 2.0;
  end
%
%  Call CEIQF to set up the quadrature formula and evaluate it on F.
%
  qfsum = ceiqf ( nt, t, mlt, kind, alpha, beta, a, b, @f );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Integral of sin(x) from %f to %f by Fejer type rule\n', a, b );
  fprintf ( 1, '  with %d points of multiplicity 2.\n', nt );
  fprintf ( 1, '  Quadrature formula: %24.16f\n', qfsum );

  qfsx = cos ( a ) - cos ( b );
  fprintf ( 1, '  Exact value       : %24.16f\n', qfsx );
  fprintf ( 1, '  Error             : %e\n', abs ( qfsum - qfsx ) );

  return
end
function test05 ( )

%*****************************************************************************80
%
%% TEST05 tests CLIQFS.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
  fprintf ( 1, '  ----------------------------------------\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST05\n' );
  fprintf ( 1, '  Test CLIQFS.\n' );
%
%  Number of knots.
%
  nt = 5;
%
%  Set the knots in the default interval [-1,+1].
%
  t = zeros(nt,1);

  for i = 1 : nt
    t(i) = cos ( ( 2 * i - 1 ) * pi / ( 2 * nt ) );
  end
%
%  Request Legendre weight function.
%
  kind = 1;
%
%  ALPHA, BETA not used in Legendre weight function but set anyway.
%
  alpha = 0.0;
  beta  = 0.0;
%
%  LU controls printing.
%  A positive value requests that we compute and print weights, and
%  conduct a moments check.
%
  lu = 6;
%
%  This call returns the WTS array.
%
  wts = cliqfs ( nt, t, kind, alpha, beta, lu );

  return
end
function test06 ( )

%*****************************************************************************80
%
%% TEST06 tests CLIQF and EIQFS..
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
  fprintf ( 1, '  ----------------------------------------\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST06\n' );
  fprintf ( 1, '  Test CLIQF and EIQFS.\n' );
%
%  Number of knots.
%
  nt = 5;
%
%  Set the knots in the default interval [-1,+1].
%
  t = zeros(nt,1);

  for i = 1 : nt
    t(i) = cos ( ( 2 * i - 1 ) * pi / ( 2 * nt ) );
  end
%
%  Set KIND to the Legendre weight function.
%
  kind = 1;
%
%  ALPHA, BETA not used in Legendre weight function but set anyway.
%
  alpha = 0.0;
  beta  = 0.0;
%
%  Set nonstandard interval A, B.
%
  a = - 0.5;
  b = 2.0;
%
%  Shift knots from [-1,1] to [A,B].
%
  for i = 1 : nt
    t(i) = ( ( b - a ) * t(i) + ( a + b ) ) / 2.0;
  end
%
%  LU controls printout.
%
  lu = 6;
%
%  Call CLIQF to set up the quadrature formula.
%
  wts = cliqf ( nt, t, kind, alpha, beta, a, b, lu );
%
%  Call EIQFS to evaluate the quadrature formula.
%
  qfsum = eiqfs ( nt, t, wts, @f );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Integral of sin(x) from %f to %f\n', a, b );
  fprintf ( 1, '  by Fejer type rule with %d points\n', nt );
  fprintf ( 1, '  of multiplicity 1.\n' );
  fprintf ( 1, '  Quadrature formula: %24.16f\n', qfsum );

  qfsx = cos ( a ) - cos ( b );
  fprintf ( 1, '  Exact value       : %24.16f\n', qfsx );
  fprintf ( 1, '  Error             : %e\n', abs ( qfsum - qfsx ) );

  return
end
function test07 ( )

%*****************************************************************************80
%
%% TEST07 tests CEGQF.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
  fprintf ( 1, '  ----------------------------------------\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST07\n' );
  fprintf ( 1, '  Test CEGQF.\n' );
%
%  Number of knots.
%
  nt = 12;
%
%  Request exponential weight function.
%
  kind = 7;
%
%  Set ALPHA and BETA.
%
  alpha = 1.0;
  beta  = 0.0;
%
%  Set interval [A,B].
%
  a = - 0.5;
  b = 2.0;
%
%  Call CEGQF to compute and evaluate the Gauss quadrature formula.
%
  qfsum = cegqf ( nt, kind, alpha, beta, a, b, @f );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Integral of x*sin(x) from %f to %f\n', a, b );
  fprintf ( 1, '  by Gauss-exponential rule with %d points\n', nt );
  fprintf ( 1, '  Quadrature formula: %24.16f\n', qfsum );

  qfsx = ( b - a ) * 0.5 * ( cos ( a ) - cos ( b ) ) ...
    + sin ( b ) + sin ( a ) - 2.0 * sin ( ( a + b ) / 2.0 );

  fprintf ( 1, '  Exact value       : %24.16f\n', qfsx );
  fprintf ( 1, '  Error             : %e\n', abs ( qfsum - qfsx ) );

  return
end
function test08 ( )

%*****************************************************************************80
%
%% TEST08 tests CEGQFS.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
  fprintf ( 1,'  ----------------------------------------\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST08\n' );
  fprintf ( 1, '  Test CEGQFS.\n' );
%
%  Number of knots.
%
  nt = 12;
%
%  Request exponential weight function.
%
  kind = 7;
%
%  Set ALPHA and BETA.
%
  alpha = 1.0;
  beta  = 0.0;
%
%  Call CEGQFS to compute and evaluate the Gauss quadrature formula.
%
  qfsum = cegqfs ( nt, kind, alpha, beta, @f );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Integral of x*sin(x) from -1 to +1\n' );
  fprintf ( 1, '  by Gauss-exponential rule with %d points.\n', nt )
  fprintf ( 1, '  Quadrature formula: %24.16f\n', qfsum );

  qfsx = cos ( -1.0 ) - cos ( +1.0 );

  fprintf ( 1, '  Exact value       : %24.16f\n', qfsx );
  fprintf ( 1, '  Error             : %e\n', abs ( qfsum - qfsx ) );

  return
end
function test09 ( )

%*****************************************************************************80
%
%% TEST09 calls CGQFS to compute and print generalized Gauss-Hermite rules.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    10 January 2010
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST09\n' );
  fprintf ( 1, '  Call CGQFS for a generalized Gauss Hermite rule.\n' );

  nt = 15;
  kind = 6;
  alpha = 1.0;
  beta = 0.0;
  io = - 6;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  NT = %d\n', nt );
  fprintf ( 1, '  ALPHA = %f\n', alpha );

  [ t, wts ] = cgqfs ( nt, kind, alpha, beta, io );

  return
end
function test10 ( nt, kind, alpha, beta )

%*****************************************************************************80
%
%% TEST10 calls CDGQF to compute a quadrature formula.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 January 2010
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST10\n' );
  fprintf ( 1, '  Call CDGQF to compute a quadrature formula.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  KIND = %d\n', kind );
  fprintf ( 1, '  ALPHA = %f\n', alpha );
  fprintf ( 1, '  BETA  = %f\n', beta );

  [ t, wts ] = cdgqf ( nt, kind, alpha, beta );

  fprintf ( 1, '\n' );
  fprintf ( 1, ' Index     Abscissas                 Weights\n' );
  fprintf ( 1, '\n' );
  for i = 1 : nt
    fprintf ( 1, '  %4d  %24.16e  %24.16e\n', i, t(i), wts(i) );
  end

  return
end
function test11 ( nt, kind, alpha, beta, a, b )

%*****************************************************************************80
%
%% TEST11 calls CGQF to compute a quadrature formula.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 February 2010
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST11\n' );
  fprintf ( 1, '  Call CGQF to compute a quadrature formula\n' );
  fprintf ( 1, '  with nondefault values of A and B.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  KIND = %d\n', kind );
  fprintf ( 1, '  ALPHA = %f\n', alpha );
  fprintf ( 1, '  BETA  = %f\n', beta );
  fprintf ( 1, '  A     = %f\n', a );
  fprintf ( 1, '  B     = %f\n', b );

  lo = 0;
  [ t, wts ] = cgqf ( nt, kind, alpha, beta, lo, a, b );

  fprintf ( 1, '\n' );
  fprintf ( 1, ' Index     Abscissas                 Weights\n' );
  fprintf ( 1, '\n' );
  for i = 1 : nt
    fprintf ( 1, '  %4d  %24.16e  %24.16e\n', i, t(i), wts(i) );
  end

  return
end
function value = f ( x, i )

%*****************************************************************************80
%
%% F returns values of the integrand or its derivatives.
%
%  Discussion:
%
%    This function is an example of an integrand function.
%
%    The package can generate quadrature formulas that use derivative
%    information as well as function values.  Therefore, this routine is
%    set up to provide derivatives of any order as well as the function
%    value.  In an actual application, the highest derivative needed
%    is of order one less than the highest knot multiplicity.
%
%    In other words, in the usual case where knots are not repeated,
%    this routine only needs to return function values, not any derivatives.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    05 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
%  Parameters:
%
%    Input, real X, the evaluation point.
%
%    Input, integer I, the order of the derivative of F to
%    be evaluated.
%
%    Output, real VALUE, the value of the I-th derivative of F at X.
%
  l = mod ( i, 4 );

  if ( l == 0 )
    value = sin ( x );
  elseif ( l == 1 )
    value = cos ( x );
  elseif ( l == 2 )
    value = - sin ( x );
  elseif ( l == 3 )
    value = - cos ( x );
  end

  return
end


function varargout = information(R, opts, varargin)

%INFORMATION Computes mutual information using different methods and
% different bias correction procedures.
%
%   ------
%   SYNTAX
%   ------
%       [...] = information(R, opts, output list...)
%
%   ---------
%   ARGUMENTS
%   ---------
%   R           - Response matrix.
%   opts        - Options structure.
%   output list - List of strings specifying what to compute.
%
%   -------------------
%   THE RESPONSE MATRIX
%   -------------------
%   L-dimensional responses to S distinct stimuli are stored in a response
%   matrix R of size L-by-T-by-S, T being the maximum number of trials
%   available for any of the stimuli. Emtpy trials, i.e., elements of R not
%   corresponding to a recorded response, can take any value.
%
%   ---------------------
%   THE OPTIONS STRUCTURE
%   ---------------------
%   The options structure can include any the following fields:
%
%   opts.nt
%   -------
%       This field specifies the number of trials (responses) recorded for
%       each stimulus. It can be either a scalar (for constant number of
%       trials per stimulus) or an array of length S.
%
%       NT must satisfy the following two conditions:
%       - max(nt) = T
%       - length(nt) = S (if nt is an array)
%
%   opts.method
%   -----------
%       This field specifies which estimation method to use and can be one
%       of the following strings:
%
%       --------------------------
%       | 'dr' | Direct method   |
%       | 'gs' | Gaussian method |
%       --------------------------
%
%       IMPORTANT!
%       ==========
%       The direct method requires the response values to be discretized
%       into non-negative integer values (this is meant only in a numerical
%       sense, the MATLAB variable still needs to be of type double). See
%       function BINR.M for instruction on how to discretize the responses.
%       Failing to properly discretizing the response will result in Matlab
%       crashing.
%
%   opts.bias
%   ---------
%       This field specifies the bias correction procedure. It can be one
%       of the following strings:
%
%       -------------------------------------
%       | 'qe'    | Quadratic EXtrapolation |
%       | 'pt'    | Panzeri & Treves 1996   |
%       | 'gsb'   | Gaussian bias           |
%       | 'naive' | Biased naive estimates  |
%       -------------------------------------
%
%   opts.btsp (optional)
%   --------------------
%       This field must be a (non-negative) scalar specifying how many
%       bootstrap estimates to compute.
%
%       Bootstrap estimates are performed by means of pairing stimuli and
%       responses at random and computing the entropy quantities for these
%       random pairings; each estimate corresponds to a different random
%       pairing configuration.
%
%       See the examples below for additional information on how to use
%       this option.
%
%       DEFAULT: 0.
%
%   opts.verbose (optional)
%   -----------------------
%       If this field exists and is set to true a summary of the selected
%       options is displayed and additional checks are performed on the
%       input variables. No warnings are displayed unless this options is
%       enabled.
%
%       This feature is useful to check whether INFORMATION is being called
%       correctly. It is therefore highly reccomended for new users or when
%       first running of the program with new input options. However, keep
%       in mind that these checks drammatically increases computation time
%       and are thus not reccommended for computationally intensive
%       session.
%
%       DEFAULT: false.
%
%   ---------------
%   THE OUTPUT LIST
%   ---------------
%   To specify which IT quantities need to compute, one or more of the
%   following strings has to be specified:
%
%       =================================================================
%       | Option  | Description       | Expression (in terms of ENTROPY |
%       |         |                   | output options)                 |
%       =================================================================
%       | 'I'     | I(R;S)            | I     = HR - HRS                |
%       | 'Ish'   | I(R;S) shuffle    | Ish   = HR - HiRS + HshRS - HRS |
%       |---------------------------------------------------------------|
%       | 'IX'    | I(R)              | IX    = HlR - HR                |
%       |---------------------------------------------------------------|
%       | 'ILIN'  | I_lin(S;R)        | ILIN  = HlR - HiRS              |
%       |---------------------------------------------------------------|
%       | 'SYN'   | Syn               | SYN   = HR - HRS - HlR + HiRS   |
%       | 'SYNsh' | Syn shuffle       | SYNsh = HR + HshRS - HRS - HlR  |
%       |---------------------------------------------------------------|
%       | 'ISS'   | I_sig_sim         | ISS   = HiR - HlR               |
%       |---------------------------------------------------------------|
%       | 'IC'    | I_cor             | IC    = HR - HRS + HiRS - HiR   |
%       | 'ICsh'  | I_cor shuffle     | ICsh  = HR + HshRS - HRS - HiR  |
%       |---------------------------------------------------------------|
%       | 'ICI'   | I_cor_ind         | ICI   = ChiR - HiR              |
%       |---------------------------------------------------------------|
%       | 'ICD'   | I_cor_dep         | ICD   = HR - HRS - ChiR + HiRS  |
%       | 'ICDsh' | I_cor_dep shuffle | ICDsh = HR + HshRS - HRS - ChiR |
%       |---------------------------------------------------------------|
%       | 'ILB1'  | I_LB1             | ILB1  = HR - HiRS               |
%       |---------------------------------------------------------------|
%       | 'ILB2'  | I_LB2             | ILB2  = ChiR - HiRS             |
%       =================================================================
%
%   Outputs are returned IN THE SAME ORDER as that specified in the output
%   list.
%
%   IMPORTANT: Not all combinations of method, bias and output options are
%   possible. For example, bias correction 'pt' can only be used together
%   with method 'dr'. The allowed combinations of method, bias and output
%   options are summarized in the following tables:
%
%       =============================================
%       | DIRECT METHOD                             |
%       =============================================
%       |         | 'naive' | 'qe'  | 'pt'  | 'gsb' |
%       |-------------------------------------------|
%       | 'I'     |    X    |   X   |   X   |   -   |
%       | 'Ish'   |    X    |   X   |   X   |   -   |
%       |---------|---------|-------|-------|-------|
%       | 'IX'    |    X    |   X   |   X   |   -   |
%       |---------|---------|-------|-------|-------|
%       | 'ILIN'  |    X    |   X   |   X   |   -   |
%       |---------|---------|-------|-------|-------|
%       | 'SYN'   |    X    |   X   |   X   |   -   |
%       | 'SYNsh' |    X    |   X   |   X   |   -   |
%       |---------|---------|-------|-------|-------|
%       | 'ISS'   |    X    |   X   |   -   |   -   |
%       |---------|---------|-------|-------|-------|
%       | 'IC'    |    X    |   X   |   -   |   -   |
%       | 'ICsh'  |    X    |   X   |   -   |   -   |
%       |---------|---------|-------|-------|-------|
%       | 'ICI'   |    X    |   X   |   -   |   -   |
%       |---------|---------|-------|-------|-------|
%       | 'ICD'   |    X    |   X   |   -   |   -   |
%       | 'ICDsh' |    X    |   X   |   -   |   -   |
%       |---------|---------|-------|-------|-------|
%       | 'ILB1'  |    X    |   X   |   X   |   -   |
%       |---------|---------|-------|-------|-------|
%       | 'ILB2'  |    X    |   X   |   -   |   -   |
%       =============================================
%
%   Legend: X: combination available
%           -: combination NOT permitted
%
%
%       =============================================
%       | GAUSSIAN METHOD                           |
%       =============================================
%       |         | 'naive' | 'qe'  | 'pt'  | 'gsb' |
%       |-------------------------------------------|
%       | 'I'     |    X    |  n.r. |   -   |   X   |
%       | 'Ish'   |    X    |  n.r. |   -   |   X   |
%       |---------|---------|-------|-------|-------|
%       | 'IX'    |    X    |  n.r. |   -   |   X   |
%       |---------|---------|-------|-------|-------|
%       | 'ILIN'  |    X    |  n.r. |   -   |   X   |
%       |---------|---------|-------|-------|-------|
%       | 'SYN'   |    X    |  n.r. |   -   |   X   |
%       | 'SYNsh' |    X    |  n.r. |   -   |   X   |
%       |---------|---------|-------|-------|-------|
%       | 'ISS'   |   NaN   |  NaN  |   -   |  NaN  |
%       |---------|---------|-------|-------|-------|
%       | 'IC'    |   NaN   |  NaN  |   -   |  NaN  |
%       | 'ICsh'  |   NaN   |  NaN  |   -   |  NaN  |
%       |---------|---------|-------|-------|-------|
%       | 'ICI'   |   NaN   |  NaN  |   -   |  NaN  |
%       |---------|---------|-------|-------|-------|
%       | 'ICD'   |   NaN   |  NaN  |   -   |  NaN  |
%       | 'ICDsh' |   NaN   |  NaN  |   -   |  NaN  |
%       |---------|---------|-------|-------|-------|
%       | 'ILB1'  |    X    |  n.r. |   -   |   X   |
%       |---------|---------|-------|-------|-------|
%       | 'ILB2'  |   NaN   |  NaN  |   -   |  NaN  |
%       =============================================
%
%   Legend: X   : combination available
%           -   : combination NOT permitted
%           n.r.: combination available but not recommended
%           NaN : NaN returned
%
%   --------
%   EXAMPLES
%   --------
%   In the following examples, we assume R to be a 2-by-10-by-3 matrix
%   i.e., R stores 2-dimensional responses to 3 different stimuli. We also
%   assume that, while 10 trials are available for stimulus 1 and 2, only 7
%   trials have been recorded for stimulus 3.
%
%   - Estimate I(S;R) using the direct method and no bias corrections
%
%       opts.nt = [10 10 7];
%       opts.method = 'dr';
%       opts.bias = 'naive';
%       X = information(R, opts, 'I');
%
%   - Estimate I(S;R) and I_shuffle(S;R) using direct method and the
%     quadratic extrapolation bias correction
%
%       opts.nt = [10 10 7];
%       opts.method = 'dr';
%       opts.bias = 'gsb';
%       [X, Y] = information(R, opts, 'Ish', 'I');
%
%     where the estimate of I_shuffle(S;R) is stored in the X and that of
%     I(S;R) in Y.
%
%   - Compute gaussian naive estimate of I(S;R) together with 20 bootstrap
%     estimates:
%
%       opts.nt = [10 10 7];
%       opts.method = 'gs';
%       opts.bias = 'naive';
%       opts.btsp = 20;
%       X = information(R, opts, 'I');
%
%     Note that, in this case, Y is an array of size 21-by-1: Y(1) gives
%     the estimate for I(S;R) computed using the input matrix R; Y(2:21)
%     are are 20 distinct bootstrap estimates of I(S;R).
%
%   -------
%   REMARKS
%   -------
%   - Field-names in the option structure are case-sensitive
%
%   - Ouput options are case INsensitive
%
%   - It is more efficient to call INFORMATION with several output options
%     rather than calling the function repeatedly. For example:
%
%         [X, Y] = information(R, opts, 'I', 'Ish');
%
%     is faster than
%
%         X = information(R, opts, 'I');
%         Y = information(R, opts, 'Ish');
%
%   - Some MEX files in the toolbox create static arrays which are used
%     to store computations performed in previous calls to the routines.
%     This memory is freed automatically when Matlab is quitted. However,
%     consider using
%
%         clear mex;
%
%     when needing to free all of Matlab's available memory.

% NOTE:
% The function also computes IXS and IXSsh according to the following
% equations:
%
%       =================================================================
%       | Option  | Description       | Expression (in terms of ENTROPY |
%       |         |                   | output options)                 |
%       =================================================================
%       | 'IXS'   | I(R|S)            | IXS   = HiRS - HRS              |
%       | 'IXSsh' | I(R|S) shuffle    | IXSsh = HshRS - HRS             |
%       =================================================================
%
% However, since this quantity is meaningful only for L=2, this feature
% is kept hidden. The combination tables for this quantity are
% as follows:
%
%       =============================================
%       | DIRECT METHOD                             |
%       =============================================
%       |         | 'naive' | 'qe'  | 'pt'  | 'gsb' |
%       |-------------------------------------------|
%       | 'IXS'   |    X    |   X   |   X   |   -   |
%       | 'IXSsh' |    X    |   X   |   X   |   -   |
%       =============================================
%
%   Legend: X: combination available
%           -: combination NOT available
%
%
%       =============================================
%       | GAUSSIAN METHOD                           |
%       =============================================
%       |         | 'naive' | 'qe'  | 'pt'  | 'gsb' |
%       |-------------------------------------------|
%       | 'IXS'   |    X    |  n.r. |   -   |   X   |
%       | 'IXSsh' |    X    |  n.r. |   -   |   X   |
%       =============================================
%
%   Legend: X   : combination available
%           -   : combination NOT available
%           n.r.: combination available but not recommended

%   Copyright (C) 2009 Cesare Magri
%   Version: 1.0.5

% -------
% LICENSE
% -------
% This software is distributed free under the condition that:
%
% 1. it shall not be incorporated in software that is subsequently sold;
%
% 2. the authorship of the software shall be acknowledged and the following
%    article shall be properly cited in any publication that uses results
%    generated by the software:
%
%      Magri C, Whittingstall K, Singh V, Logothetis NK, Panzeri S: A
%      toolbox for the fast information analysis of multiple-site LFP, EEG
%      and spike train recordings. BMC Neuroscience 2009 10(1):81;
%
% 3.  this notice shall remain in place in each source file.

% NOTE:
% In this function HiRS is indeed output option 'HiRS' of function
% entropy.m, thus corresponding to the variable HlRS in the same function.

whereI     = strcmpi(varargin, 'i');
whereIsh   = strcmpi(varargin, 'ish');
whereIX    = strcmpi(varargin, 'ix');
whereIXS   = strcmpi(varargin, 'ixs');
whereIXSsh = strcmpi(varargin, 'ixssh');
whereILIN  = strcmpi(varargin, 'ilin');
whereSYN   = strcmpi(varargin, 'syn');
whereSYNsh = strcmpi(varargin, 'synsh');
whereISS   = strcmpi(varargin, 'iss');
whereIC    = strcmpi(varargin, 'ic');
whereICsh  = strcmpi(varargin, 'icsh');
whereICI   = strcmpi(varargin, 'ici');
whereICD   = strcmpi(varargin, 'icd');
whereICDsh = strcmpi(varargin, 'icdsh');
whereILB1  = strcmpi(varargin, 'ilb1');
whereILB2  = strcmpi(varargin, 'ilb2');

whereuvar  = strcmpi(varargin, 'uvar');
if sum(whereuvar)
  Runit = varargin{find(whereuvar)+1};
  sel = find(whereuvar);
  sel = [sel sel+1];
  varargin(sel) = [];
end

doI     = any(whereI);
doIsh   = any(whereIsh);
doIX    = any(whereIX);
doIXS   = any(whereIXS);
doIXSsh = any(whereIXSsh);
doILIN  = any(whereILIN);
doSYN   = any(whereSYN);
doSYNsh = any(whereSYNsh);
doISS   = any(whereISS);
doIC    = any(whereIC);
doICsh  = any(whereICsh);
doICI   = any(whereICI);
doICD   = any(whereICD);
doICDsh = any(whereICDsh);
doILB1  = any(whereILB1);
doILB2  = any(whereILB2);

% Checks ------------------------------------------------------------------
specifiedOutputOptsVec = ...
    [doI doIsh doIX doIXS doIXSsh doILIN doSYN doSYNsh doISS doIC doICsh doICI doICD doICDsh doILB1 doILB2];
NspecifiedOutputOpts = sum(specifiedOutputOptsVec);
lengthVarargin = length(varargin);
if NspecifiedOutputOpts~=lengthVarargin
    msg = 'Unknown selection or repeated option in output list.';
    error('information:unknownOutputOpt', msg);
end

% Restrictions on possible combinantions ----------------------------------
if strcmpi(opts.method, 'dr')
    % Can't apply bias-correction gsb with method dr:
    if strcmpi(opts.bias, 'gsb')
        msg = 'Bias correction ''gsb'' can only be used in conjunction with method ''gs''.';
        error('Information:drMethodAndGsbBias', msg);
    end

    % Can't compute ISS, IC, ICsh, ICI, ICD, ICDsh or ILB2 for
    % bias-correction pt
    if strcmpi(opts.bias, 'pt') && (doISS || doIC || doICsh || doICI || doICD || doICDsh || doILB2)
        msg = 'One or more of the selected output options are not available for bias correction ''pt''.';
        error('information:ptBiasAndNonAvailableOutputOpt', msg);
    end
end

% Default verbose value:
if ~isfield(opts, 'verbose')
    opts.verbose = false;
end;

isGaussianMethod = false;
if strcmpi(opts.method, 'gs')
    isGaussianMethod = true;

    % Gaussian and QE is not recommended:
    if opts.verbose && strcmpi(opts.bias, 'qe')
        msg = 'Usage of bias correction ''qe'' in conjunction with gaussian method is not recommended.';
        warning('Information:gsMethodAndQeBias', msg);
    end

    % Gaussian and PT is not allowed:
    if strcmpi(opts.bias, 'pt')
        msg = 'Bias correction ''pt'' can only be used in conjunction with method ''dr''.';
        error('Information:gsMethodAndPtBias', msg);
    end
end

allOutputOpts = {'HR' 'HRS' 'HlR' 'HiR' 'HiRS' 'ChiR' 'HshRS'};
positionInOuputOptsList = 0;

% What needs to be computed by ENTTROPY -----------------------------------
% Need to compute H(R)?
doHR = false;
if doI || doIsh || doIX || doSYN || doSYNsh || doIC || doICsh || doICD || doICDsh || doILB1
    positionInOuputOptsList = positionInOuputOptsList + 1;
    whereHR = positionInOuputOptsList;
    doHR = true;
end

% Need to compute H(R|S)?
doHRS = false;
if doI || doIsh || doIXS || doIXSsh || doSYN || doSYNsh || doIC || doICsh || doICD || doICDsh
    positionInOuputOptsList = positionInOuputOptsList + 1;
    whereHRS = positionInOuputOptsList;
    doHRS = true;
end

% Need to compute H_lin(R)?
doHlR = false;
if doIX || doSYN || doILIN || doSYNsh || doISS
    positionInOuputOptsList = positionInOuputOptsList + 1;
    whereHlR = positionInOuputOptsList;
    doHlR = true;
end

% Need to compute H_ind(R)?
doHiR = false;
if (doISS || doIC || doICsh || doICI) && ~isGaussianMethod
    positionInOuputOptsList = positionInOuputOptsList + 1;
    whereHiR = positionInOuputOptsList;
    doHiR = true;
end

% Need to compute H_ind(R|S)?
doHiRS = false;
if doIsh || doIXS || doILIN || doSYN || doIC || doICD || doILB1 || doILB2
    positionInOuputOptsList = positionInOuputOptsList + 1;
    whereHiRS = positionInOuputOptsList;
    doHiRS = true;
end

% Need to compute Chi(R)?
doChiR = false;
if (doICI || doICD || doICDsh || doILB2) && ~isGaussianMethod
    positionInOuputOptsList = positionInOuputOptsList + 1;
    whereChiR = positionInOuputOptsList;
    doChiR = true;
end

% Need to compute H_sh(R|S)?
doHshRS = false;
if doIsh || doIXSsh || doSYNsh || doICsh || doICDsh
    positionInOuputOptsList = positionInOuputOptsList + 1;
    whereHshRS = positionInOuputOptsList;
    doHshRS = true;
end

% Computing information theoretic quantities ------------------------------
outputOptsList = allOutputOpts([doHR doHRS doHlR doHiR doHiRS doChiR doHshRS]);

H = cell(positionInOuputOptsList, 1);
if ~exist('Runit', 'var')
  [H{:}] = entropy(R, opts, outputOptsList{:});
else
  [H{:}] = entropy(R, opts, outputOptsList{:}, 'uvar', Runit);
end

% Assigning output --------------------------------------------------------
varargout = cell(length(varargin),1);

% I = HR - HRS
if doI
    varargout(whereI) = {H{whereHR} - H{whereHRS}};
end

% Ish = HR - HiRS + HshRS - HRS
if doIsh
    varargout(whereIsh) = {H{whereHR} - H{whereHiRS} + H{whereHshRS} - H{whereHRS}};
end

% IX = HlR - HR
if doIX
    varargout(whereIX) = {H{whereHlR} - H{whereHR}};
end

% IXS = HiRS - HRS
if doIXS
    varargout(whereIXS) = {H{whereHiRS} - H{whereHRS}};
end

% IXSsh = HshRS - HRS
if doIXSsh
    varargout(whereIXSsh) = {H{whereHshRS} - H{whereHRS}};
end

% ILIN = HlR - HiRS
if doILIN
    varargout(whereILIN) = {H{whereHlR} - H{whereHiRS}};
end

% SYN = HR - HRS - HlR + HiRS
if doSYN
    varargout(whereSYN) = {H{whereHR} - H{whereHRS} - H{whereHlR} + H{whereHiRS}};
end

% SYNsh = HR + HshRS - HRS - HlR
if doSYNsh
    varargout(whereSYNsh) = {H{whereHR} + H{whereHshRS} - H{whereHRS} - H{whereHlR}};
end

% ISS = HiR - HlR
if doISS
    if ~isGaussianMethod
        varargout(whereISS) = {H{whereHiR} - H{whereHlR}};
    else
        varargout(whereISS) = {NaN};
    end
end

% IC = HR - HRS + HiRS - HiR
if doIC
    if ~isGaussianMethod
        varargout(whereIC) = {H{whereHR} - H{whereHRS} + H{whereHiRS} - H{whereHiR}};
    else
        varargout(whereIC) = {NaN};
    end
end

% ICsh  = HR + HshRS - HRS - HiR
if doICsh
    if ~isGaussianMethod
        varargout(whereICsh) = {H{whereHR} + H{whereHshRS} - H{whereHRS} - H{whereHiR}};
    else
        varargout(whereICsh) = {NaN};
    end
end

% ICI= ChiR - HiR
if doICI
    if ~isGaussianMethod
        varargout(whereICI) = {H{whereChiR} - H{whereHiR}};
    else
        varargout(whereICI) = {NaN};
    end
end

% ICD = HR - HRS - ChiR + HiRS
if doICD
    if ~isGaussianMethod
        varargout(whereICD) = {H{whereHR} - H{whereHRS} - H{whereChiR} + H{whereHiRS}};
    else
        varargout(whereICD) = {NaN};
    end
end

% ICDsh = HR + HshRS - HRS - ChiR
if doICDsh
    if ~isGaussianMethod
        varargout(whereICDsh) = {H{whereHR} + H{whereHshRS} - H{whereHRS} - H{whereChiR}};
    else
        varargout(whereICDsh) = {NaN};
    end
end

% ILB1 = HR - HiRS
if doILB1
    varargout(whereILB1) = {H{whereHR} - H{whereHiRS}};
end

% ILB2 = ChiR - HiRS
if doILB2
    if ~isGaussianMethod
        varargout(whereILB2) = {H{whereChiR} - H{whereHiRS}};
    else
        varargout(whereILB2) = {NaN};
    end
end


function Solution = GhiaSolution
%GhiaSolution returns a benchmark solution for lid-driven cavity flow
%   The data is taken from:
%     Ghia, U. K. N. G., Kirti N. Ghia, and C. T. Shin.
%     "High-Re solutions for incompressible flow using the Navier-Stokes
%     equations and a multigrid method."
%     Journal of computational physics 48.3 (1982): 387-411.

Solution.Re=[100 400 1000];

Solution.y = [1.0000,...
              0.9766,...
              0.9688,...
              0.9609,...
              0.9531,...
              0.8516,...
              0.7344,...
              0.6172,...
              0.5000,...
              0.4531,...
              0.2813,...
              0.1719,...
              0.1016,...
              0.0703,...
              0.0625,...
              0.0547,...
              0.0000];
% Re=100
Solution.u{1}=   [1.0000,...
                  0.84123,...
                  0.78871,...
                  0.73722,...
                  0.68717,...
                  0.23151,...
                  0.00332,...
                 -0.13641,...
                 -0.20581,...
                 -0.21090,...
                 -0.15662,...
                 -0.10150,...
                 -0.06434,...
                 -0.04775,...
                 -0.04192,...
                 -0.03717,...
                  0.00000];
% Re=400
Solution.u{2}=   [1.00000,...
                  0.75837,...
                  0.68439,...
                  0.61756,...
                  0.55892,...
                  0.29093,...
                  0.16256,...
                  0.02135,...
                 -0.11477,...
                 -0.17119,...
                 -0.32726,...
                 -0.24299,...
                 -0.14612,...
                 -0.10338,...
                 -0.09266,...
                 -0.08186,...
                  0.00000];
%Re=1000
Solution.u{3}=   [1.0000,...
                  0.65928,...
                  0.57492,...
                  0.51117,...
                  0.46604,...
                  0.33304,...
                  0.18719,...
                  0.05702,...
                 -0.06080,...
                 -0.10648,...
                 -0.27805,...
                 -0.38289,...
                 -0.29730,...
                 -0.22220,...
                 -0.20196,...
                 -0.18109,...
                  0.00000];

Solution.x = [1.0000,...
              0.9688,...
              0.9609,...
              0.9531,...
              0.9453,...
              0.9063,...
              0.8594,...
              0.8047,...
              0.5000,...
              0.2344,...
              0.2266,...
              0.1563,...
              0.0938,...
              0.0781,...
              0.0703,...
              0.0625,...
              0.0000];
%Re=100
Solution.v{1}=[0.00000,...
              -0.05906,...
              -0.07391,...
              -0.08864,...
              -0.10313,...
              -0.16914,...
              -0.22445,...
              -0.24533,...
               0.05454,...
               0.17527,...
               0.17507,...
               0.16077,...
               0.12317,...
               0.10890,...
               0.10091,...
               0.09233,...
               0.00000];
% Re=400
Solution.v{2}=[0.00000,...
              -0.12146,...
              -0.15663,...
              -0.19254,...
              -0.22847,...
              -0.23827,...
              -0.44993,...
              -0.38598,...
               0.05186,...
               0.30174,...
               0.30203,...
               0.28124,...
               0.22965,...
               0.20920,...
               0.19713,...
               0.18360,...
               0.00000];
%Re=1000
Solution.v{3}=[0.00000,...
              -0.21388,...
              -0.27669,...
              -0.33714,...
              -0.39188,...
              -0.51550,...
              -0.42665,...
              -0.31966,...
               0.02526,...
               0.32235,...
               0.33075,...
               0.37095,...
               0.32627,...
               0.30353,...
               0.29012,...
               0.27485,...
               0.00000];

end


function life3D(action)
%LIFE3D   MATLAB's version of Conway's Game of Life.
%   "Life" is a cellular automaton invented by John
%   Conway that involves live and dead cells in a
%   rectangular, two-dimensional universe. In
%   MATLAB, the universe is a sparse matrix that
%   is initially all zero.
%
%   Whether cells stay alive, die, or generate new
%   cells depends upon how many of their eight
%   possible neighbors are alive. By using sparse
%   matrices, the calculations required become
%   astonishingly simple. We use periodic (torus)
%   boundary conditions at the edges of the
%   universe. Pressing the "Start" button
%   automatically seeds this universe with several
%   small random communities. Some will succeed
%   and some will fail.
%
%   Expanded to 3D by:
%       Leandro Barajas 06-20-2002 L.G.Barajas@ieee.org
%
%   C. Moler, 7-11-92, 8-7-92.
%   Adapted by Ned Gulley, 6-21-93
%

%   Copyright 1984-2001 The MathWorks, Inc.
%   $Revision: 5.9 $  $Date: 2001/04/15 12:03:02 $

% Possible actions:
% initialize
% start

% Information regarding the play status will be held in
% the axis user data according to the following table:
play= 1;
stop=-1;

if nargin<1,
   action='initialize';
end;

if strcmp(action,'initialize'),
   figNumber=figure( ...
      'Name','Life3D: Conway''s Game of Life in 3-Dimesions', ...
      'NumberTitle','off', ...
      'DoubleBuffer','on', ...
      'Visible','off', ...
      'Color','white', ...
      'BackingStore','off');
   axes( ...
      'Units','normalized', ...
      'Position',[0.05 0.05 0.75 0.90], ...
      'Visible','off', ...
      'DrawMode','fast', ...
      'Color','none',...
      'NextPlot','add');
%      'NextPlot','replace' );

   text(0,0,{'Press the "Start" button to see the Game of Life demo' 'Use the slider to change the number of initial cells.'}, ...
      'HorizontalAlignment','center');
   axis([-1 1 -1 1]);

   %===================================
   % Information for all buttons
   labelColor=[0.8 0.8 0.8];
   yInitPos=0.90;
   xPos=0.85;
   btnLen=0.10;
   btnWid=0.10;
   % Spacing between the button and the next command's label
   spacing=0.05;

   %====================================
   % The CONSOLE frame
   frmBorder=0.02;
   yPos=0.05-frmBorder;
   frmPos=[xPos-frmBorder yPos btnLen+2*frmBorder 0.9+2*frmBorder];
   h=uicontrol( ...
      'Style','frame', ...
      'Units','normalized', ...
      'Position',frmPos, ...
      'BackgroundColor',[0.50 0.50 0.50]);

   %====================================
   % The START button
   btnNumber=1;
   yPos=0.90-(btnNumber-1)*(btnWid+spacing);
   labelStr='Start';
   cmdStr='start';
   callbackStr='life3D(''start'');';

   % Generic button information
   btnPos=[xPos yPos-spacing btnLen btnWid];
   startHndl=uicontrol( ...
      'Style','pushbutton', ...
      'Units','normalized', ...
      'Position',btnPos, ...
      'String',labelStr, ...
      'Interruptible','on', ...
      'Callback',callbackStr);

   %====================================
   % The STOP button
   btnNumber=2;
   yPos=0.90-(btnNumber-1)*(btnWid+spacing);
   labelStr='Stop';
   % Setting userdata to -1 (=stop) will stop the demo.
   callbackStr='set(gca,''Userdata'',-1)';

   % Generic button information
   btnPos=[xPos yPos-spacing btnLen btnWid];
   stopHndl=uicontrol( ...
      'Style','pushbutton', ...
      'Units','normalized', ...
      'Position',btnPos, ...
      'Enable','off', ...
      'String',labelStr, ...
      'Callback',callbackStr);

   %====================================
   % The NumberOfCell Slider
   labelStr='# Cells';

   callbackStr='h=findobj(gcf,''Tag'',''StartCells'');set(h,''Tooltip'',sprintf(''Initial Cells: %4d'',floor(get(h,''Value''))));';
   infoHndl=uicontrol( ...
      'Style','slider', ...
      'Units','normalized', ...
      'Position',[xPos btnWid+btnWid*2+0.05 btnLen/4 0.10*3], ...
      'String',labelStr, ...
      'SliderStep',[.01 .1], ...
      'Max',100, ...
      'Min',1, ...
      'Value',20, ...
      'Tooltip','Initial Cells:  20',...
      'Tag','StartCells', ...
      'Callback',callbackStr);

  %====================================
   % The INFO button
   labelStr='Info';
   callbackStr='life3D(''info'')';
   infoHndl=uicontrol( ...
      'Style','push', ...
      'Units','normalized', ...
      'Position',[xPos 0.20 btnLen 0.10], ...
      'String',labelStr, ...
      'Callback',callbackStr);

   %====================================
   % The CLOSE button
   labelStr='Close';
   callbackStr='close(gcf)';
   closeHndl=uicontrol( ...
      'Style','push', ...
      'Units','normalized', ...
      'Position',[xPos 0.05 btnLen 0.10], ...
      'String',labelStr, ...
      'Callback',callbackStr);

   % Uncover the figure
   hndlList=[startHndl stopHndl infoHndl closeHndl];
   set(figNumber,'Visible','on', ...
      'UserData',hndlList);

   view(3);
   StartCells = 20;
   m = 19;
   colormap(jet(m));
   colorbar;

elseif strcmp(action,'start'),
   objh=findobj(gcf,'Tag','StartCells');
   StartCells = get(objh,'Value');
   m = 19;
   cla;
   axHndl=gca;
   figNumber=gcf;
   hndlList=get(figNumber,'Userdata');
   startHndl=hndlList(1);
   stopHndl=hndlList(2);
   infoHndl=hndlList(3);
   closeHndl=hndlList(4);
   set([startHndl closeHndl infoHndl],'Enable','off');
   set(stopHndl,'Enable','on');

   % ====== Start of Demo
   set(axHndl, ...
      'UserData',play, ...
      'DrawMode','fast', ...
      'Visible','on');
   box off

   X = zeros(m,m,m);

   p = -1:1;
   for count=1:StartCells,
      kx=floor(rand*(m-4))+2;
      ky=floor(rand*(m-4))+2;
      kz=floor(rand*(m-4))+2;
      X(kx+p,ky+p,kz+p)=(rand(3,3,3)>0.5);
   end;

   % The following statements plot the initial configuration.
   % The "find" function returns the indices of the nonzero elements.
   plothandle=[];
   figure(gcf);
   hold on
   colour=jet(m);
   for k=1:m
       [i,j] = find(X(:,:,k));
%       kd = sub2ind(size(X(i,j,k)),i,j)
       kd = k(ones(size(i)));
       if isempty(i)
           i = 1;
           j = 1;
           kd = NaN;
       end
       plothandle(k) = line(i,j,kd);
       set(plothandle(k),'linestyle','none',...
                      'Marker','.',...
                      'MarkerSize',20*2,...
                      'MarkerFaceColor',colour(k,:),...
                      'MarkerEdgeColor',colour(k,:),...
                      'EraseMode','normal');

   end
   drawnow
   axis([0 m+1 0 m+1 0 m+1]);

   hold off

   % Whether cells stay alive, die, or generate new cells depends
   % upon how many of their eight possible neighbors are alive.
   % Here we generate index vectors for four of the eight neighbors.
   % We use periodic (torus) boundary conditions at the edges of the universe.

   n = [m 1:m-1];
   e = [2:m 1];
   s = [2:m 1];
   w = [m 1:m-1];
   u = [m 1:m-1];
   d = [2:m 1];

   rotate3d on
   while get(axHndl,'UserData')==play,
    % How many of eight+5+5 neighbors are alive. (only the ones that share at least one border
    %      N = X(n,:,:) + X(s,:,:) + X(:,e,:) + X(:,w,:) + ...
    %          X(n,e,:) + X(n,w,:) + X(s,e,:) + X(s,w,:);

    % 3D Version

    % Use Euclidean distance
    d1 = 1/1;           % Adjacent cells (Share 4 vertix)
    d2 = 1/sqrt(2);     % Diagonal cells (Share 2 vertix)
    d3 = 1/sqrt(3);     % Double Diagonal cells (Share 1 vertix)

    % How many of 9+9+8 neighbors are alive. (Only the ones that share at least one vertix)
      N = X(n,:,:)*d1 + X(s,:,:)*d1 + X(:,e,:)*d1 + X(:,w,:)*d1 + ...
          X(n,e,:)*d2 + X(n,w,:)*d2 + X(s,e,:)*d2 + X(s,w,:)*d2 + ...
          X(n,:,u)*d2 + X(s,:,u)*d2 + X(:,e,u)*d2 + X(:,w,u)*d2 + ...
          X(n,:,d)*d2 + X(s,:,d)*d2 + X(:,e,d)*d2 + X(:,w,d)*d2 + ...
          X(n,e,u)*d3 + X(s,e,u)*d3 + X(s,w,u)*d3 + X(n,w,u)*d3 + ...
          X(n,e,d)*d3 + X(s,e,d)*d3 + X(s,w,d)*d3 + X(n,w,d)*d3 + ...
          X(:,:,u)*d1 + X(:,:,d)*d1;

      % A live cell with two live neighbors, or any cell with three
      % neigbhors, is alive at the next time step.
      Xold = X;

      CL = 3.0;             % Minimun # cells to create a new one
      CH = 4.0;             % Maximum # cells to create a new one
      KL = 4.0;             % Minimun # cells to kill one

      X = ( (    ((N >= CL) & (N <= CH)) ) &...    % Create cells
         ~(  X & ((N >  KL)           )) ) ;       % Kill cells by overpopulation

      Xsum = sum(X(:));
      if (Xsum>prod(size(X))/8);
         X = ( X & (rand(size(X))>0.1) ); % Expontaneous cell annihilation
      end

      if Xold==X   % if no change the exit
         break;
      end

      % Update plot.
      for k=1:m
          [i,j] = find(X(:,:,k));
          set(plothandle(k),'xdata',i,'ydata',j,'zdata',k(ones(size(i))));
      end

      set(plothandle,'Visible','on');
      box on
      title( sprintf('Total Cells: %d',Xsum))
      xlabel(sprintf('Density: %5.2f%%',mean(X(:))*100))
      ylabel(sprintf('Rate: %5.2f%%',(mean(X(:))-mean(Xold(:)))*100))

      drawnow
      pause(0.2)
   end

   % ====== End of Demo

   set([startHndl closeHndl infoHndl],'Enable','on');
   set(stopHndl,'Enable','off');

elseif strcmp(action,'info');
   helpwin(mfilename);

end;    % if strcmp(action, ...


function x = project_box(v, l, u)
% PROJECT_BOX    Project a point onto a box (hyper-rectangle).
%
%   project_box(v,l,u) is the projection of v onto
%   the set { x | l <= x <= u }.

    x = max(l, min(v, u));
end


function nMC=grMinEdgeCover(E)
% Function nMC=grMinEdgeCover(E) solve the minimal edge cover problem.
% Input parameter:
%   E(m,2) or (m,3) - the edges of graph and their weight;
%     1st and 2nd elements of each row is numbers of vertexes;
%     3rd elements of each row is weight of edge;
%     m - number of edges.
%     If we set the array E(m,2), then all weights is 1.
% Output parameter:
%   nMC - the list of the numbers of edges included
%     in the minimal (weighted) edge cover.
% Uses the reduction to integer LP-problem.
% Required the Optimization Toolbox v.3.0.1 or over.
% Author: Sergiy Iglin
% e-mail: siglin@yandex.ru
% personal page: http://iglin.exponenta.ru

% ============= Input data validation ==================
if nargin<1,
  error('There are no input data!')
end
[m,n,E] = grValidation(E); % E data validation

% ============= Parameters of integer LP problem ==========
A=zeros(n,m); % for incidence matrix
A(E(:,1:2)+repmat(([1:m]'-1)*n,1,2))=1; % we fill the incidence matrix
options=optimset('bintprog'); % the default options
options.Display='off'; % we change the output

% ============= We solve the integer LP problem ==========
xmin=bintprog(E(:,3),-A,-ones(n,1),[],[],[],options);
nMC=find(round(xmin)); % the answer - numbers of edges
return


% Kernel Affine Projection Subgradient Method
%
% K. Slavakis, S. Theodoridis, and I. Yamada, "Online kernel-based
% classification using adaptive projection algorithms," IEEE Transactions
% on Signal Processing, Vol. 56, No. 7, pp. 2781-2796, 2008.
% http://dx.doi.org/10.1109/TSP.2008.917376
%
% Remark: implemented with L2-ball forgetting. Code contributed by
% Pantelis Bouboulis.
%
% This file is part of the Kernel Adaptive Filtering Toolbox for Matlab.
% https://github.com/steven2358/kafbox/

classdef kapsm < kernel_adaptive_filter

    properties (GetAccess = 'public', SetAccess = 'private') % parameters
        M = 200; % dictionary size
        Delta = 10; % L2-ball forgetting radius
        mu = 1.8, % learning rate
        Q = 10; % number of subgradients
        loss = 'l2'; % loss function type
        loss_param = 2; % Huber loss parameter
        kerneltype = 'gauss'; % kernel type
        kernelpar = .5; % kernel parameter
    end

    properties (GetAccess = 'public', SetAccess = 'private') % variables
        dict = []; % dictionary
        alpha = []; % expansion coefficients
        norm_f = []; % function norm for L2-ball forgetting
        xmem = []; % input memory
        ymem = []; % output memory
    end

    methods
        function kaf = kapsm(parameters) % constructor
            if (nargin > 0) % copy valid parameters
                for fn = fieldnames(parameters)'
                    if ismember(fn,fieldnames(kaf))
                        kaf.(fn{1}) = parameters.(fn{1});
                    end
                end
            end
        end

        function y_est = evaluate(kaf,x) % evaluate the algorithm
            if size(kaf.dict,1)>0
                k = kernel(kaf.dict,x,kaf.kerneltype,kaf.kernelpar);
                y_est = k'*kaf.alpha;
            else
                y_est = zeros(size(x,1),1);
            end
        end

        function train(kaf,x,y) % train the algorithm
            if size(kaf.xmem,1)<kaf.Q
                % grow memory
                kaf.xmem = [kaf.xmem; x];
                kaf.ymem = [kaf.ymem; y];
            else
                % slide memory
                kaf.xmem = [kaf.xmem(2:kaf.Q,:); x];
                kaf.ymem = [kaf.ymem(2:kaf.Q); y];
            end
            q = size(kaf.xmem,1);

            d_hat = kaf.evaluate(kaf.xmem);
            e = kaf.ymem - d_hat;

            L_n = kaf.loss_fun(e,kaf.loss,kaf.loss_param);
            subgrad = kaf.compute_subgrad_coef(e,kaf.loss,kaf.loss_param);
            norm_subgrad = subgrad.^2 .* ...
                kernel(kaf.xmem(end-q+1:end,:),...
                kaf.xmem(end-q+1:end,:),...
                [kaf.kerneltype '-diag'],kaf.kernelpar);

            omega = 1/q*ones(q,1); % convex weights

            beta = omega.*L_n.*subgrad./(norm_subgrad+eps);

            % % extrapolation parameter
            % nominator = (omega.*L_n)'*(L_n./(norm_subgrad+eps));
            % K = kernel(kaf.xmem,kaf.xmem,kaf.kerneltype,kaf.kernelpar);
            % denominator = beta'*K*beta;
            % Mn = nominator/(denominator+eps);
            % mu = .5*Mn;

            kaf.alpha = [kaf.alpha; 0];
            kaf.alpha(end-q+1:end) = kaf.alpha(end-q+1:end) - kaf.mu*beta;
            kaf.dict = [kaf.dict; x];

            % L2-ball forgetting: update function norm
            K = kernel(kaf.xmem,kaf.xmem,kaf.kerneltype,kaf.kernelpar);
            R_sum = beta(end-q+1:end)'*K*beta(end-q+1:end);
            sum2 = beta(1:end-q)'*d_hat(1:end-q);
            kaf.norm_f = sqrt(kaf.norm_f*kaf.norm_f + 2*sum2 + R_sum);
            if kaf.norm_f > kaf.Delta
                kaf.alpha = kaf.Delta/kaf.norm_f * kaf.alpha;
                kaf.norm_f = kaf.Delta;
            end

            % sliding-window pruning
            if length(kaf.alpha)>kaf.M
                k = kernel(kaf.dict,kaf.dict(1,:),...
                    kaf.kerneltype,kaf.kernelpar);
                kaf.norm_f = sqrt(kaf.norm_f.^2 + kaf.alpha(1)^2*k(1) - ...
                    2*kaf.alpha(1)*k'*kaf.alpha);
                kaf.dict(1,:) = [];
                kaf.alpha(1) = [];
            end
        end

    end

    methods (Static = true)

        function loss = loss_fun(ksi,loss_type,loss_param)
            switch loss_type
                case 'l2'
                    loss = ksi.^2;
                case 'l1'
                    loss = abs(ksi);
                case 'huber'
                    sigma = loss_param;
                    loss = zeros(length(ksi),1);
                    for i=1:length(ksi)
                        if abs(ksi(i)) <= sigma
                            loss(i) = ksi(i)^2/(2*sigma);
                        else
                            loss(i) = abs(ksi(i)) - sigma/2;
                        end
                    end
            end
        end

        function subgrad_coef = ...
                compute_subgrad_coef(e,loss_type,loss_param)
            subgrad_coef = zeros(length(e),1);
            for i=1:length(e)
                switch loss_type
                    case 'l2'
                        subgrad_coef(i) = -2*e(i);
                    case 'l1'
                        subgrad_coef(i) = -sign(e(i));
                    case 'huber'
                        sigma = loss_param;
                        if abs(e(i)) <= sigma
                            subgrad_coef(i) = -e(i)/sigma;
                        else
                            subgrad_coef(i) = -sign(e(i));
                        end
                end
            end
        end
    end
end


function value = r8_mach ( i )

%*****************************************************************************80
%
%% R8_MACH returns double precision real machine constants.
%
%  Discussion:
%
%    Assume that double precision real numbers are stored with a mantissa
%    of T digits in base B, with an exponent whose value must lie
%    between EMIN and EMAX.  Then for values of I between 1 and 5,
%    D1MACH will return the following values:
%
%      D1MACH(1) = B^(EMIN-1), the smallest positive magnitude.
%      D1MACH(2) = B^EMAX*(1-B^(-T)), the largest magnitude.
%      D1MACH(3) = B^(-T), the smallest relative spacing.
%      D1MACH(4) = B^(1-T), the largest relative spacing.
%      D1MACH(5) = log10(B)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 April 2007
%
%  Author:
%
%    Original FORTRAN77 version by Phyllis Fox, Andrew Hall, Norman Schryer
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Phyllis Fox, Andrew Hall, Norman Schryer,
%    Algorithm 528,
%    Framework for a Portable Library,
%    ACM Transactions on Mathematical Software,
%    Volume 4, Number 2, June 1978, page 176-188.
%
%  Parameters:
%
%    Input, integer I, chooses the parameter to be returned.
%    1 <= I <= 5.
%
%    Output, real VALUE, the value of the chosen parameter.
%
  if ( i < 1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8_MACH - Fatal error!\n' );
    fprintf ( 1, '  The input argument I is out of bounds.\n' );
    fprintf ( 1, '  Legal values satisfy 1 <= I <= 5.\n' );
    fprintf ( 1, '  I = %d\n', i );
    value = 0.0;
    error ( 'R8_MACH - Fatal error!' );
  elseif ( i == 1 )
    value = 1.112536929253601E-308;
  elseif ( i == 2 )
    value = 4.494232837155789E+307;
  elseif ( i == 3 )
    value = 1.110223024625157E-016;
  elseif ( i == 4 )
    value = 2.220446049250313E-016;
  elseif ( i == 5 )
    value = 0.301029995663981;
  elseif ( 5 < i )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8_MACH - Fatal error!\n' );
    fprintf ( 1, '  The input argument I is out of bounds.\n' );
    fprintf ( 1, '  Legal values satisfy 1 <= I <= 5.\n' );
    fprintf ( 1, '  I = %d\n', i );
    value = 0.0;
    error ( 'R8_MACH - Fatal error!' );
  end

  return
end


function c = c8mat_add ( m, n, alpha, a, beta, b )

%*****************************************************************************80
%
%% C8MAT_ADD combines two C8MAT's with scalar factors.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    03 March 2013
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the order of A.
%
%    Input, complex ALPHA, the first scale factor.
%
%    Input, complex A(M,N), the first matrix.
%
%    Input, complex BETA, the second scale factor.
%
%    Input, complex B(M,N), the second matrix.
%
%    Output, complex C(M,N), the result.
%
  c(1:m,1:n) = alpha * a(1:m,1:n) + beta * b(1:m,1:n);

  return
end


function [y, s2, fmu, fs2] = simulGPnaive(hyp, inf, mean, cov, lik, input, target, test, lag)
% simulGPnaive - 'Naive' (i.e. without propagation of variance) simulation of the GP
% ARX and AR model.
%
%% Syntax
%   [y, s2] = simulGPnaive(hyp, inf, mean, cov, lik, input, target, test, lag)
%
%% Description
% GP-NARX model is used to predict a further step ahead by replacing the data at
% present time instant with the data at one time instant before and using the mean
% value of prediction from the previous prediction step instead of the measured
% output value. This is then repeated as many times as there are test samples.
%
% Input:
% * hyp    ... the column vector of hyperparameters
% * inf    ... the function specifying the inference method
% * cov    ... the prior covariance function (see below)
% * mean   ... the prior mean function
% * lik    ... the likelihood function
% * input  ... the input part of the training data,  NxD matrix
% * target ... the output part of the training data (ie. target), Nx1 vector
% * test   ... the input matrix, kxD matrix, see construct.m for more info
% * lag    ... the order of the model (number of used lagged outputs)
%
% Output:
% * y    ... the mean predicted output
% * s2   ... associated variances
% * fmu  ... the mean predicted output without noise
% * fs2  ... associated variances without noise
%
% See also:
% gpx.m, simulGPmc, construct.m
%
% Examples:
% demo_example_gp_simulation.m
%
%%
% Written by K. Azman in J. Kocijan, 2007

[NN,D] = size(test); % D - input space dimension, NN - number or test samples

% allocate memory
y = zeros(1,D);
s2 = y;
fmu = y;
fs2 = y;

% first step: k=1
xt = test(1,:);
[y(1), s2(1) ,fmu(1), fs2(1), post] = gpx(hyp, inf, mean, cov, lik, input, target, xt);

% future steps ...
for k=2:NN

    if (mod(k,100) == 0)  % remark on every 100th step
        disp(['simulGPnaive, step: ', int2str(k), '/', int2str(NN)]);
    end
        % For the next prediction prepare the input vector ...
        if D > lag
            if (k>lag)
                xt = [y(k-lag:k-1) test(k, lag+1:end)];
            elseif (k<=lag)
                xt = [test(k, 1:lag-k+1) y(1:k-1) test(k, lag+1:end)];
            end
        else                                            % if D <= lag
            if (k>lag)
                xt = y(k-lag:k-1);
            elseif (k<=lag)
                xt = [test(k, 1:lag-k+1) y(1:k-1)];
            end
        end
        % ... and calculate the one-step-ahead prediction
    [y(k), s2(k) ,fmu(k), fs2(k), post] = gpx(hyp, inf, mean, cov, lik, input, target, xt, post);

end

% transform into column vectors
y = y';
s2 = s2';
fmu = fmu';
fs2 = fs2';


function [V,E,I] = spline_to_poly(P,C,tol)
  % SPLINE_TO_POLY Evaluate a cubic Bezier spline as a polyline where each
  % segment corresponds to a locally flat segment of the curve up to given
  % tolerance
  %
  % [V,E] = spline_to_poly(P,C,tol)
  %
  % Inputs:
  %   P  #P by dim list of control point locations
  %   C  #C by 4 list of indices into P of cubic Bezier curves
  %   tol  tolerance
  % Outputs:
  %   V  #V by dim list of vertex locations
  %   E  #E by dim list of edge indices into V
  %   I  #E list of indices into 1:#C
  %

  V = P;
  E = [];
  I = [];
  % consider each cubic
  for c = 1:size(C,1)
    Pc = cubic_flat_eval(P(C(c,:),:),tol);
    J = [C(c,1) size(V,1)+(1:size(Pc,1)-2) C(c,4)];
    Ec = [J(1:end-1);J(2:end)]';
    E = [E; Ec];
    V = [V;Pc(2:end-1,:)];
    I = [I;repmat(c,size(Ec,1),1)];
  end
  [V,~,~,E] = remove_unreferenced(V,E);

end


function [ qy, qty, b, rsd, xb, info ] = zqrsl ( x, ldx, n, k, qraux, y, job )

%*****************************************************************************80
%
%% ZQRSL solves, transforms or projects systems factored by ZQRDC.
%
%  Discussion:
%
%    The routine applies the output of ZQRDC to compute coordinate
%    transformations, projections, and least squares solutions.
%
%    For K <= min ( N, P ), let XK be the matrix
%
%      XK = ( X(IPVT(1)), X(IPVT(2)), ... ,X(IPVT(k)) )
%
%    formed from columnns IPVT(1), ... ,IPVT(K) of the original
%    N by P matrix X that was input to ZQRDC (if no pivoting was
%    done, XK consists of the first K columns of X in their
%    original order).  ZQRDC produces a factored unitary matrix Q
%    and an upper triangular matrix R such that
%
%      XK = Q * ( R )
%               ( 0 )
%
%    This information is contained in coded form in the arrays
%    X and QRAUX.
%
%    The parameters QY, QTY, B, RSD, and XB are not referenced
%    if their computation is not requested and in this case
%    can be replaced by dummy variables in the calling program.
%
%    To save storage, the user may in some cases use the same
%    array for different parameters in the calling sequence.  A
%    frequently occuring example is when one wishes to compute
%    any of B, RSD, or XB and does not need Y or QTY.  In this
%    case one may identify Y, QTY, and one of B, RSD, or XB, while
%    providing separate arrays for anything else that is to be
%    computed.  Thus the calling sequence
%
%      call zqrsl ( x, ldx, n, k, qraux, y, dum, y, b, y, dum, 110, info )
%
%    will result in the computation of B and RSD, with RSD
%    overwriting Y.  More generally, each item in the following
%    list contains groups of permissible identifications for
%    a single callinng sequence.
%
%    1. ( Y, QTY, B )   ( RSD )      ( XB )  ( QY )
%    2. ( Y, QTY, RSD ) ( B )        ( XB )  ( QY )
%    3. ( Y, QTY, XB )  ( B )        ( RSD ) ( QY )
%    4. ( Y, QY )       ( QTY, B )   ( RSD ) ( XB )
%    5. ( Y, QY )       ( QTY, RSD ) ( B )   ( XB )
%    6. ( Y, QY )       ( QTY, XB )  ( B )   ( RSD )
%
%    In any group the value returned in the array allocated to
%    the group corresponds to the last member of the group.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 May 2007
%
%  Author:
%
%    MATLAB version by John Burkardt
%
%  Reference:
%
%    Jack Dongarra, Jim Bunch, Cleve Moler, Pete Stewart,
%    LINPACK User's Guide,
%    SIAM, 1979,
%    ISBN13: 978-0-898711-72-1,
%    LC: QA214.L56.
%
%  Parameters:
%
%    Input, complex X(LDX,P), the output of ZQRDC.
%
%    Input, integer LDX, the leading dimension of X.
%
%    Input, integer N, the number of rows of the matrix XK, which
%    must have the same value as N in ZQRDC.
%
%    Input, integer K, the number of columns of the matrix XK.  K must not
%    be greater than min ( N, P), where P is the same as in the calling
%    sequence to ZQRDC.
%
%    Input, complex QRAUX(P), the auxiliary output from ZQRDC.
%
%    Input, complex Y(N), a vector that is to be manipulated by ZQRSL.
%
%    Input, integer JOB, specifies what is to be computed.  JOB has
%    the decimal expansion ABCDE, meaning:
%    if A /= 0, compute QY.
%    if B, D, D, or E /= 0, compute QTY.
%    if C /= 0, compute B.
%    if D /= 0, compute RSD.
%    if E /= 0, compute XB.
%    A request to compute B, RSD, or XB automatically triggers the
%    computation of QTY, for which an array must be provided in the
%    calling sequence.
%
%    Output, complex QY(N), contains Q*Y, if it has been requested.
%
%    Output, complex QTY(N), contains hermitian(Q)*Y, if it has
%    been requested.  Here hermitian(Q) is the conjugate transpose
%    of the matrix Q.
%
%    Output, complex B(K), the solution of the least squares problem
%      minimize norm2 ( Y - XK * B ),
%    if it has been requested.  If pivoting was requested in ZQRDC,
%    the J-th component of B will be associated with column IPVT(J)
%    of the original matrix X that was input into ZQRDC.
%
%    Output, complex RSD(N), the least squares residual Y - XK*B,
%    if it has been requested.  RSD is also the orthogonal projection
%    of Y onto the orthogonal complement of the column space of XK.
%
%    Output, complex XB(N), the least squares approximation XK*N,
%    if its computation has been requested.  XB is also the orthogonal
%    projection of Y onto the column space of X.
%
%    Output, integer INFO, is zero unless the computation of B has
%    been requested and R is exactly singular.  In this case, INFO is the
%    index of the first zero diagonal element of R and B is left unaltered.
%
  qy = [];
  qty = [];
  b = [];
  rsd = [];
  xb = [];
  info = 0;
%
%  Determine what is to be computed.
%
  cqy =  ( floor (       job / 10000        ) ~= 0 );
  cqty = (         mod ( job,  10000 )        ~= 0 );
  cb =   ( floor ( mod ( job,   1000 ) /100 ) ~= 0 );
  cr =   ( floor ( mod ( job,    100 ) / 10 ) ~= 0 );
  cxb =  (         mod ( job,     10 )        ~= 0 );

  ju = min ( k, n - 1 );
%
%  Special action when N=1.
%
  if ( ju == 0 )

    if ( cqy )
      qy(1) = y(1);
    end

    if ( cqty )
      qty(1) = y(1);
    end

    if ( cxb )
      xb(1) = y(1);
    end

    if ( cb )
      if ( zabs1 ( x(1,1) ) == 0.0 )
        info = 1;
      else
        b(1) = y(1) / x(1,1);
      end
    end

    if ( cr )
      rsd(1) = 0.0;
    end

    return

  end
%
%  Set up to compute QY or QTY.
%
  if ( cqy )
    qy(1:n) = y(1:n);
  end

  if ( cqty )
    qty(1:n) = y(1:n);
  end
%
%  Compute QY.
%
  if ( cqy )

    for jj = 1 : ju

      j = ju - jj + 1;

      if ( zabs1 ( qraux(j) ) ~= 0.0 )
        temp = x(j,j);
        x(j,j) = qraux(j);
        t = - ( qy(j:n) * conj ( x(j:n,j) ) ) / x(j,j);
        qy(j:n) = qy(j:n) + t * transpose ( x(j:n,j) );
        x(j,j) = temp;
      end

    end

  end
%
%  Compute hermitian ( A ) * Y.
%
  if ( cqty )
    for j = 1 : ju
      if ( zabs1 ( qraux(j) ) ~= 0.0 )
        temp = x(j,j);
        x(j,j) = qraux(j);
        t = - ( qty(j:n) * conj ( x(j:n,j) ) ) / x(j,j);
        qty(j:n) = qty(j:n) + t * x(j:n,j);
        x(j,j) = temp;
      end
    end
  end
%
%  Set up to compute B, RSD, or XB.
%
  if ( cb )
    b(1:k) = qty(1:k);
  end

  kp1 = k + 1;

  if ( cxb )
    xb(1:k) = qty(1:k);
  end

  if ( cr & k < n )
    rsd(k+1:n) = qty(k+1:n);
  end

  if ( cxb )
    xb(k+1:n) = 0.0;
  end

  if ( cr )
    rsd(1:k) = 0.0;
  end
%
%  Compute B.
%
  if ( cb )

    for jj = 1 : k

      j = k - jj + 1;

      if ( zabs1 ( x(j,j) ) == 0.0 )
        info = j;
        break
      end

      b(j) = b(j) / x(j,j);

      if ( j ~= 1 )
        t = -b(j);
        b(1:j-1) = b(1:j-1) + t * x(1:j-1,j);
      end

    end

  end

  if ( cr | cxb )
%
%  Compute RSD or XB as required.
%
    for jj = 1 : ju

      j = ju - jj + 1;

      if ( zabs1 ( qraux(j) ) ~= 0.0 )

        temp = x(j,j);
        x(j,j) = qraux(j);

        if ( cr )
          t = - ( rsd(j:n) * conj ( x(j:n,j) ) ) / x(j,j);
          rsd(j:n) = rsd(j:n) + t * x(j:n,j);
        end

        if ( cxb )
          t = - ( xb(j:n) * conj ( x(j:n,j) ) ) / x(j,j);
          xb(j:n) = xb(j:n) + t * x(j:n,j);
        end

        x(j,j) = temp;

      end

    end

  end

  return
end


function [centers,mincenter,mindist,q2,quality] = kmeansFast(data,initcenters,method)
% output: final centers
% input: data points and initial centers
% if initcenters is a number k, create k centers and start with these
% otherwise, use centers given as input
% method = 0: unoptimized, using n by k matrix of distances O(nk) space
%          1: vectorized, using only O(n+k) space
%          2: like 1, in addition using distance inequalities (default)
% URL: http://cseweb.ucsd.edu/~elkan/fastkmeans.html

tic
if nargin < 3 method = 2; end
[n,dim] = size(data);

if max(size(initcenters)) == 1
    k = initcenters;
    [centers, mincenter, mindist, lower, computed] = anchors(mean(data),k,data);
    total = computed;
    skipestep = 1;
else
    centers = initcenters;
    mincenter = zeros(n,1);
    total = 0;
    skipestep = 0;
    [k,dim2] = size(centers);
    if dim ~= dim2 error('dim(data) ~= dim(centers)'); end;
end

nchanged = n;
iteration = 0;
oldmincenter = zeros(n,1);

while nchanged > 0
    % do one E step, then one M step
    computed = 0;

    if method == 0 && ~skipestep
        for i = 1:n
            for j = 1:k
                distmat(i,j) = calcdist(data(i,:),centers(j,:));
            end
        end
        [mindist,mincenter] = min(distmat,[],2);
        computed = k*n;

    elseif (method == 1 || (method == 2 && iteration == 0)) && ~skipestep
        mindist = Inf*ones(n,1);
        lower = zeros(n,k);
        for j = 1:k
           jdist = calcdist(data,centers(j,:));
           lower(:,j) = jdist;
           track = find(jdist < mindist);
           mindist(track) = jdist(track);
           mincenter(track) = j;
        end
        computed = k*n;

    elseif method == 2 && ~skipestep
        computed = 0;

% for each center, nndist is half the distance to the nearest center
% if d(x,center) < nndist then x cannot belong to any other center
% mindist is an upper bound on the distance of each point to its nearest center

        nndist = min(centdist,[],2);
% the following usually is not faster
%        ldist = min(lower,[],2);
%        mobile = find(mindist > max(nndist(mincenter),ldist));
        mobile = find(mindist > nndist(mincenter));

% recompute distances for point i and center j
%       only if j can possibly be the new nearest center
% for speed, the first check has been optimized by modifying centdist
% swapping the order of the checks is slower for data with natural clusters

        mdm = mindist(mobile);
        mcm = mincenter(mobile);

        for j = 1:k
% the following is incorrect: for j = unique(mcm)'
            track = find(mdm > centdist(mcm,j));
            if isempty(track) continue; end
            alt = find(mdm(track) > lower(mobile(track),j));
            if isempty(alt) continue; end
            track1 = mobile(track(alt));

% calculate exact distances to the mincenter
% recalculate separately for each jj to avoid copying too much of data
% redo may be empty, but we don't need to check this
            redo = find(~recalculated(track1));
            redo = track1(redo);
            c = mincenter(redo);
            computed = computed + size(redo,1);
            for jj = unique(c)'
                rp = redo(find(c == jj));
                udist = calcdist(data(rp,:),centers(jj,:));
                lower(rp,jj) = udist;
                mindist(rp) = udist;
            end
            recalculated(redo) = 1;

            track2 = find(mindist(track1) > centdist(mincenter(track1),j));
            track1 = track1(track2);
            if isempty(track1) continue; end

            % calculate exact distances to center j
            track4 = find(lower(track1,j) < mindist(track1));
            if isempty(track4) continue; end
            track5 = track1(track4);
            jdist = calcdist(data(track5,:),centers(j,:));
            computed = computed + size(track5,1);
            lower(track5,j) = jdist;

            % find which points really are assigned to center j
            track2 = find(jdist < mindist(track5));
            track3 = track5(track2);
            mindist(track3) = jdist(track2);
            mincenter(track3) = j;
        end % for j=1:k
    end % if method

    oldcenters = centers;

% M step: recalculate the means for each cluster
% if a cluster is empty, its mean is left unchanged
% we minimize computations for clusters with little changed membership

    diff = find(mincenter ~= oldmincenter);
    diffj = unique([mincenter(diff);oldmincenter(diff)])';
    diffj = diffj(diffj > 0);

    if size(diff,1) < n/3 && iteration > 0
         for j = diffj
            plus = find(mincenter(diff) == j);
            minus = find(oldmincenter(diff) == j);
            oldpop = pop(j);
            pop(j) = pop(j) + size(plus,1) - size(minus,1);
            if pop(j) == 0 continue; end
            centers(j,:) = (centers(j,:)*oldpop + sum(data(diff(plus),:),1) - sum(data(diff(minus),:),1))/pop(j);
        end
    else
        for j = diffj
            track = find(mincenter == j);
            pop(j) = size(track,1);
            if pop(j) == 0 continue; end
% it's correct to have mean(data(track,:),1) but this can make answer worse!
            centers(j,:) = mean(data(track,:),1);
        end
    end

    if method == 2
        for j = diffj
            offset = calcdist(centers(j,:),oldcenters(j,:));
            computed = computed + 1;
            if offset == 0 continue; end
            track = find(mincenter == j);
            mindist(track) = mindist(track) + offset;
            lower(:,j) = max(lower(:,j) - offset,0);
        end

% compute distance between each pair of centers
% modify centdist to make "find" using it faster
        recalculated = zeros(n,1);
        realdist = alldist(centers);
        centdist = 0.5*realdist + diag(Inf*ones(k,1));
        computed = computed + k + k*(k-1)/2;
    end

    nchanged = size(diff,1) + skipestep;
    iteration = iteration+1;
    skipestep = 0;
    oldmincenter = mincenter;

%   difference = max(max(abs(oldcenters - centers)));
%   [iteration toc nchanged computed size(diffj,2)]
    %[iteration toc nchanged computed]
    total = total + computed;
end % while nchanged > 0

udist = calcdist(data,centers(mincenter,:));
quality = mean(udist);
q2 = mean(udist.^2);
%[iteration toc quality q2 total]


function [t]=tt_heaviside(n,L,ind)
% Heaviside vector in the TT format
% function [t]=tt_heaviside(n,L,ind)
% Returns the tt_tensor with elements
%   theta(i-ind), i=1:N, ind=1,...,N, N=prod(n), theta(0)=1.
%
% See also: tt_unit, tt_shift
%
% TT-Toolbox 2.2, 2009-2012
%
%This is TT Toolbox, written by Ivan Oseledets et. al.
%Institute of Numerical Mathematics, Moscow, Russia
%webpage: http://spring.inm.ras.ru/osel
%
%For all questions, bugs and suggestions please mail
%ivan.oseledets@gmail.com
%---------------------------

if (numel(n)==1)
    n = n*ones(1,L);
end;

if (numel(ind)==1)
    ind = tt_ind2sub(reshape(n, 1, []), ind);
end;

t = cell(L,1);

t{1} = zeros(1,n(1),2);
t{1}(1,:,1) = heaviside((1:n(1))-ind(1));
t{1}(1,:,2) = 1;

for i=2:L-1
    t{i} = zeros(2,n(i),2);
    t{i}(1,:,1)=[zeros(ind(i)-1,1); 1; zeros(n(i)-ind(i), 1)];
    t{i}(2,:,1)=heaviside((1:n(i))-ind(i)-1);
    t{i}(2,:,2)=1;
end;

t{L} = zeros(2,n(L),1);
t{L}(1,:,1)=[zeros(ind(L)-1,1); 1; zeros(n(L)-ind(L), 1)];
t{L}(2,:,1)=heaviside((1:n(L))-ind(L)-1);

if (L==1)
    t{1} = sum(t{1}, 1);
end;

t = cell2core(tt_tensor,t);
end

function [y]=heaviside(x)
% Heaviside function of a _real_ array
% function [y]=heaviside(x)
% Zeroes strictly negative values in x, all others are cast to 1

y = sign(x)+1;
y(y==1)=2;
y = y*0.5;
end


function [U,Usteps] = conformalized_mean_curvature_flow(V,F,varargin)
  % CONFORMALIZED_MEAN_CURVATURE_FLOW Flow a surface according to "Can mean
  % curvature flow be made non-singular?" [Kazhdan et al. 2012]
  %
  % Inputs:
  %   V  #V by dim list of vertex positions
  %   F  #F by 3 list of triangle indices into V
  %   Optional:
  %     'MaxIter' followed by maximum number of iterations {100}
  %     'MinDiff' followed by minimum difference between iterations {1e-13}
  %     'Conformalize' followed by whether to rebuild _just_ the mass
  %       matrix each step {true}
  %     'delta' followed by delta value, should roughly be in range
  %       [1e-13,1e13] {1}
  %     'LaplacianType' followed by 'cotangent' of 'uniform'.
  %     'V0' followed by #V by 3 mesh positions to treat as initial mesh (to
  %       build laplacian from)
  %     'RescaleOutput' followed by whether to scale output to match input
  %       (otherwise scaled to unit surface area and moved to origin for
  %       numerical robustness) {false}
  % Outputs:
  %   U  #V by dim list of new vertex positions
  %   Usteps  #V by dim by iterations list of vertex positions during flow
  %
  function L = laplacian(V,F)
    switch laplacian_type
    case 'cotangent'
      L = cotmatrix(V,F);
    case 'uniform'
      A = adjacency_matrix(F);
      L = A - diag(sparse(sum(A,2)));
    end
  end

  % default values
  delta = 1;
  max_iter = 100;
  laplacian_type = 'cotangent';
  until_self_intersection_free = false;
  V0 = V;
  rescale_output = false;
  min_diff = 1e-13;
  conformalize = true;
  % Map of parameter names to variable names
  params_to_variables = containers.Map( ...
    {'MaxIter','Conformalize','delta','LaplacianType','V0', ...
      'RescaleOutput', 'UntilSelfIntersectionFree','MinDiff'}, ...
    {'max_iter','conformalize','delta','laplacian_type','V0', ...
      'rescale_output', 'until_self_intersection_free','min_diff'});
  v = 1;
  while v <= numel(varargin)
    param_name = varargin{v};
    if isKey(params_to_variables,param_name)
      assert(v+1<=numel(varargin));
      v = v+1;
      % Trick: use feval on anonymous function to use assignin to this workspace
      feval(@()assignin('caller',params_to_variables(param_name),varargin{v}));
    else
      error('Unsupported parameter: %s',varargin{v});
    end
    v=v+1;
  end

  L = laplacian(V,F);

  switch size(F,2)
  case 3
    SF = F;
  case 4
    SF = boundary_faces(F);
  end

  if nargout > 1
    Usteps = zeros([size(V) max_iter]);
  end
  U = V;
  iter = 1;
  while true
    if nargout > 1
      Usteps(:,:,iter) = U;
    end
    if until_self_intersection_free
      [~,~,IF] = selfintersect(U,SF,'DetectOnly',true,'FirstOnly',true);
      if isempty(IF)
        break;
      end
    end
    U_prev = U;
    % 'full' seems slight more stable than 'barycentric' which is more stable
    % than 'voronoi'
    M = massmatrix(U,F,'barycentric');
    if ~conformalize
      L = laplacian(V,F);
    end
    U = (M-delta(min(iter,end))*L)\(M*U);
    area = sum(doublearea(U,SF)*0.5);
    c = sum(bsxfun(@times,0.5*doublearea(U,SF)/area,barycenter(U,SF)));
    U = bsxfun(@minus,U,c);
    U = U/sqrt(area);
    % Use difference from previous as stopping criterion
    % Better would be to look for convergence while factoring out M??bius
    % transformation.
    % Q: Stop when no change in angles?
    d = trace(((U-U_prev)'*M*(U-U_prev)).^2);
    if d < min_diff
      warning('converged...');
      break;
    end
    % Volume of unit area sphere: pi^-0.5/6
    %[c,vol] = centroid(U,F);
    %tsurf(F,U);
    %%[vol pi^-0.5/6]
    %title(sprintf('%g',sum(doublearea(U,F)*0.5)));
    %drawnow;
    if iter >= max_iter
      warning('Max iterations (%d) exceeded without convergence',max_iter);
      break;
    end
    iter = iter + 1;
  end

  if nargout > 1
    Usteps = Usteps(:,:,1:iter);
  end

  if rescale_output
    area = sum(doublearea(V,SF)*0.5);
    c = sum(bsxfun(@times,0.5*doublearea(V,SF)/area,barycenter(V,SF)));
    U = U*sqrt(area);
    U = bsxfun(@plus,U,c);
    if nargout > 1
      for iter = 2:size(Usteps,3)
        Usteps(:,:,iter) = Usteps(:,:,iter)*sqrt(area);
        Usteps(:,:,iter) = bsxfun(@plus,Usteps(:,:,iter),c);
      end
    end
  end

end


classdef MOEADSTM < ALGORITHM
% <multi/many> <real/integer>
% MOEA/D with stable matching

%------------------------------- Reference --------------------------------
% K. Li, Q. Zhang, S. Kwong, M. Li, and R. Wang, Stable matching-based
% selection in evolutionary multiobjective optimization, IEEE Transactions
% on Evolutionary Computation, 2014, 18(6): 909-923.
%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    methods
        function main(Algorithm,Problem)
            %% Generate the weight vectors
            [W,Problem.N] = UniformPoint(Problem.N,Problem.M);
            % Size of neighborhood
            T  = ceil(Problem.N/10);

            %% Detect the neighbours of each solution
            B = pdist2(W,W);
            [~,B] = sort(B,2);
            B = B(:,1:T);

            %% Generate random population
            Population = Problem.Initialization();
            z          = min(Population.objs,[],1);
            % Utility for each subproblem
            Pi = ones(Problem.N,1);
            % Old Tchebycheff function value of each solution on its subproblem
            oldObj = max(abs((Population.objs-repmat(z,Problem.N,1))./W),[],2);

            %% Optimization
            while Algorithm.NotTerminated(Population)
                for subgeneration = 1 : 5
                    % Choose I
                    Bounday = find(sum(W<1e-3,2)==Problem.M-1)';
                    I = [Bounday,TournamentSelection(10,floor(Problem.N/5)-length(Bounday),-Pi)];
                    % Generate an offspring for each solution in I
                    P = zeros(length(I),3);
                    for i = 1 : length(I)
                        % Choose the parents
                        if rand < 0.9
                            P(i,:) = B(I(i),randperm(size(B,2),3));
                        else
                            P(i,:) = randperm(Problem.N,3);
                        end
                    end
                    Offspring = OperatorDE(Problem,Population(P(:,1)),Population(P(:,2)),Population(P(:,3)));
                    z         = min([z;Offspring.objs],[],1);

                    % STM selection
                    Population = STM([Population,Offspring],W,z,max(Population.objs,[],1));
                end
                if ~mod(ceil(Problem.FE/Problem.N),10)
                    % Update Pi for each solution
                    newObj    = max(abs((Population.objs-repmat(z,Problem.N,1))./W),[],2);
                    DELTA     = oldObj - newObj;
                    Temp      = DELTA < 0.001;
                    Pi(~Temp) = 1;
                    Pi(Temp)  = (0.95+0.05*DELTA(Temp)/0.001).*Pi(Temp);
                    oldObj    = newObj;
                end
            end
        end
    end
end


%converts frequency to bark
%>
%> @param fInHz: frequency
%> @param cModel: 'Schroeder','Terhardt', 'Zwicker', or 'Traunmuller'
%>
%> @retval bark value
% ======================================================================
function [bark] = ToolFreq2Bark(fInHz, cModel)

    if (nargin < 2)
        cModel = 'Schroeder';
    end

    % set function handle
    hPitchFunc = str2func (['aca' cModel '_I']);

    bark = hPitchFunc(fInHz);
end

function [bark] = acaSchroeder_I(f)
    bark    = 7 * asinh(f/650);
end

function [bark] = acaTerhardt_I(f)
    bark    = 13.3 * atan(0.75 * f/1000);
end

function [bark] = acaZwicker_I(f)
    bark    = 13 * atan(0.76 * f/1000) + 3.5 * atan(f/7500);
end

function [bark] = acaTraunmuller_I(f)
    bark    = 26.81/(1+1960./f) - 0.53;
end


function [Kd] = arap_linear_block(varargin)
  % ARAP_LINEAR_BLOCK constructs a block of the matrix which constructs the
  % linear terms of a given arap energy. When treating rotations as knowns
  % (arranged in a column) then this constructs Kd of K such that the linear
  % portion of the energy is as a column:
  %   K * R = [Kx Z  ... Ky Z  ...
  %            Z  Kx ... Z  Ky ...
  %            ... ]
  % These blocks are also used to build the "covariance scatter matrices". Here
  % we want to build a scatter matrix that multiplies against positions
  % (treated as known) producing covariance matrices to fit each rotation.
  % Notice that in the case of the RHS of the poisson solve the rotations are
  % known and the positions unknown, and vice versa for rotation fitting. These
  % linear block just relate the rotations to the positions, linearly in each.
  %
  % Kd = arap_linear_block(V,F,d)
  % Kd = arap_linear_block(V,F,d,'ParameterName','ParameterValue,...)
  %
  % Inputs:
  %   V  #V by dim list of initial domain positions
  %   F  #F by #simplex size list of triangle indices into V
  %   d  coordinate of linear constructor to build
  %   Optional:
  %     'Energy'
  %       followed by a string specifying which arap energy definition to use.
  %       One of the following:
  %         'spokes'  "As-rigid-as-possible Surface Modeling" by [Sorkine and
  %           Alexa 2007], rotations defined at vertices affecting incident
  %           edges, default
  %         'elements'  "A local-global approach to mesh parameterization" by
  %           [Liu et al.  2010] or "A simple geometric model for elastic
  %           deformation" by [Chao et al.  2010], rotations defined at
  %           elements (triangles or tets)
  %         'spokes-and-rims'  Adapted version of "As-rigid-as-possible Surface
  %           Modeling" by [Sorkine and Alexa 2007] presented in section 4.2 of
  %           or "A simple geometric model for elastic deformation" by [Chao et
  %           al.  2010], rotations defined at vertices affecting incident
  %           edges and opposite edges
  % Outputs:
  %   Kd  #V by #V/#F block of the linear constructor matrix corresponding to
  %     coordinate d
  %
  % See also: arap, arap_rhs, covariance_scatter_matrix
  %

  % default is Sorkine and Alexa style local rigidity energy
  energy = 'spokes';
  V = varargin{1};
  F = varargin{2};
  d = varargin{3};
  % number of vertices
  n = size(V,1);
  % number of elements
  m = size(F,1);
  % simplex size
  simplex_size = size(F,2);
  assert(simplex_size == 3 || simplex_size == 4);
  % number of dimensions
  dim = size(V,2);
  assert(d <= dim);

  ii = 4;
  while(ii <= nargin)
    switch varargin{ii}
    case 'Energy'
      ii = ii + 1;
      assert(ii<=nargin);
      energy = varargin{ii};
    otherwise
      error(['Unsupported parameter: ' varargin{ii}]);
    end
    ii = ii + 1;
  end

  switch energy
  case 'spokes'
    Kd = spokes_linear_block(V,F,d);
  case 'spokes-and-rims'
    Kd = spokes_and_rims_linear_block(V,F,d);
  case 'elements'
    Kd = elements_linear_block(V,F,d);
  otherwise
    error(['Unsupported energy type: ' energy]);
  end

  function K = spokes_linear_block(V,F,d)
    % Computes a matrix K such that V'* K * R computes
    %  ∑ wij * 0.5 * (V(i,d)-V(j,d)) * (Ri + Rj)
    % j∈N(i)
    %
    % Inputs:
    %   V  #V by dim list of coordinates
    %   F  #F by 3 list of triangle indices into V
    %   d  index into columns of V
    % Output:
    %   K  #V by #V matrix
    %
    E = edges(F);
    % Build upper part of adjacency matrix where instead of a 1 for edge from i
    % to j we have the difference of position in dimension d
    A = sparse(E(:,1),E(:,2),V(E(:,1),d)-V(E(:,2),d),size(V,1),size(V,1));
    % anti-symmetric, or considers direction of edges
    A = A-A';
    % Multiply with cotangent weights (don't worry about diagonal begin wrong
    % since in A it's all zeros
    L = cotmatrix(V,F);
    K = L.*A;
    % correct the diagonal (notice that the sign is positive
    K = K + diag(sum(K,2));
    K = 0.5*K;
  end

  function K = spokes_and_rims_linear_block(V,F,d)
    % Computes a matrix K such that V' * K * R computes
    %  ∑    -2*(cot(aij) + cot(bij) * (V(i,d)-V(j,d)) * (Ri + Rj) +
    %       -2*cot(aij) * (V(i,d)-V(j,d)) * Raij +
    %       -2*cot(bij) * (V(i,d)-V(j,d)) * Rbij
    % j∈N(i)
    %
    % where:          vj
    %              /  |  \
    %             /   |   \
    %            /    |    \
    %           /     |     \
    %          aij    |    bij
    %           \     |     /
    %            \    |    /
    %             \fij|gij/
    %              \  |  /
    %                 vi
    %
    % Inputs:
    %   V  #V by dim list of coordinates
    %   F  #F by 3 list of triangle indices into V
    %   d  index into columns of V
    % Output:
    %   K  #V by #F matrix
    %
    if simplex_size == 3
      % triangles
      C = cotangent(V,F);
      i1 = F(:,1); i2 = F(:,2); i3 = F(:,3);
      I = [i1;i2;i2;i3;i3;i1;i1;i2;i3];
      J = [i2;i1;i3;i2;i1;i3;i1;i2;i3];
      v = [ ...
         C(:,3).*(V(i1,d)-V(i2,d)) + C(:,2).*(V(i1,d)-V(i3,d)); ...
        -C(:,3).*(V(i1,d)-V(i2,d)) + C(:,1).*(V(i2,d)-V(i3,d)); ...
         C(:,1).*(V(i2,d)-V(i3,d)) + C(:,3).*(V(i2,d)-V(i1,d)); ...
        -C(:,1).*(V(i2,d)-V(i3,d)) + C(:,2).*(V(i3,d)-V(i1,d)); ...
         C(:,2).*(V(i3,d)-V(i1,d)) + C(:,1).*(V(i3,d)-V(i2,d)); ...
        -C(:,2).*(V(i3,d)-V(i1,d)) + C(:,3).*(V(i1,d)-V(i2,d)); ...
         ... % diagonal
        C(:,3).*(V(i1,d)-V(i2,d)) - C(:,2).*(V(i3,d)-V(i1,d)); ...
        C(:,1).*(V(i2,d)-V(i3,d)) - C(:,3).*(V(i1,d)-V(i2,d)); ...
        C(:,2).*(V(i3,d)-V(i1,d)) - C(:,1).*(V(i2,d)-V(i3,d)); ...
        ];
      % construct and divide by 3 so laplacian can be used as is
      K = sparse(I,J,v,n,n)/3;
    elseif simplex_size == 4
      % tetrahedra
      assert(false)
    end
  end

  function K = elements_linear_block(V,F,d)
    % Computes a matrix K such that V' * K * R computes
    %  ∑    -2*cot(aij) * (V(i,d)-V(j,d)) * Raij +
    %       -2*cot(bij) * (V(i,d)-V(j,d)) * Rbij
    % j∈N(i)
    %
    % where:        vj
    %              / |\
    %             /  | \
    %            aij | bij
    %             \  | /
    %              \ |/
    %               vi
    %
    % Inputs:
    %   V  #V by dim list of coordinates
    %   F  #F by 3 list of triangle indices into V
    %   d  index into columns of V
    % Output:
    %   K  #V by #F matrix
    %
    if simplex_size == 3
      % triangles, #T by 3
      C = cotangent(V,F);
      i1 = F(:,1); i2 = F(:,2); i3 = F(:,3);
      I = [i2;i3;i3;i1;i1;i2];
      J = repmat((1:m)',3*2,1);
      v = [ ...
         C(:,1).*(V(i2,d)-V(i3,d)); ...
        -C(:,1).*(V(i2,d)-V(i3,d)); ...
         C(:,2).*(V(i3,d)-V(i1,d)); ...
        -C(:,2).*(V(i3,d)-V(i1,d)); ...
         C(:,3).*(V(i1,d)-V(i2,d)); ...
        -C(:,3).*(V(i1,d)-V(i2,d))];
      K = sparse(I,J,v,n,m);
    elseif simplex_size == 4
      % tetrahedra, #T by 6
      C = cotangent(V,F);
      i1 = F(:,1); i2 = F(:,2); i3 = F(:,3); i4 = F(:,4);
      I = [i2;i3;i3;i1;i1;i2;i4;i1;i4;i2;i4;i3];
      J = repmat((1:m)',6*2,1);
      v = [ ...
         C(:,1).*(V(i2,d)-V(i3,d)); ...
        -C(:,1).*(V(i2,d)-V(i3,d)); ...
         C(:,2).*(V(i3,d)-V(i1,d)); ...
        -C(:,2).*(V(i3,d)-V(i1,d)); ...
         C(:,3).*(V(i1,d)-V(i2,d)); ...
        -C(:,3).*(V(i1,d)-V(i2,d)); ...
         C(:,4).*(V(i4,d)-V(i1,d)); ...
        -C(:,4).*(V(i4,d)-V(i1,d)); ...
         C(:,5).*(V(i4,d)-V(i2,d)); ...
        -C(:,5).*(V(i4,d)-V(i2,d)); ...
         C(:,6).*(V(i4,d)-V(i3,d)); ...
        -C(:,6).*(V(i4,d)-V(i3,d))];
      K = sparse(I,J,v,n,m);
    end
  end

end