function val=evalBSplinePoly(t,x,k,idx)
%%EVALBSPLINEPOLY Given a set of knots in non-decreasing order (some can be
%                 repeated), evaluate the idx-th order-k B-spline
%                 polynomial. This is B_{idx,k}(x). The first subscript
%                 refers to the knots used in determining the polynomial.
%                 Unlike the function evalBSplinePolys, this function can
%                 handle values of x that are outside of the region
%                 t(idx+-1k)<=x<=t(idx+k).
%
%INPUTS: t A 1XnumKnots or numKnotsX1 vector containing the knots. The
%          knots must be sorted in ascending order. It is possible for the
%          knots to be repeated.
%        x The scalar or matrix set of points at which the polynomials
%          should be evaluated.
%        k Optionally, the order of the B-spline polynomials. If this
%          parameter is omitted, then the default of fix(length(t)/2)+1 is
%          used. This is the highest order that can be used with the given
%          number of knots.
%      idx This input specifies where in terms of the knots the B-spline
%          polynomials are centered. This is an integer value from 1 to
%          numKnots-k.
%
%OUTPUTS: val The value of the b-spline B_{idx,k}(x) evaluated at all of
%             the points in x. This has the same size as x.
%
%This function implements the divided difference formulation of the splines
%from Equation 1 in Chapter IX of [1]. A clearer explanation of the
%notation is given in Chapter 2.4.4 of [2], where Equation 2.4.4.3 is the
%divided difference formula.
%
%EXAMPLE:
%Here, we plot all of the b-spline basis functions from example IX.1 of
%Chapter IX of [1]. The functions only sum to one over the region from 1 to
%6. Thus, the sum is not one over the region plotted before x=1.
% t=[0;1;1;3;4;6;6;6];
% k=3;
% numPoints=500;
% x=linspace(0,6,numPoints);
%
% b1=evalBSplinePoly(t,x,k,1);
% b2=evalBSplinePoly(t,x,k,2);
% b3=evalBSplinePoly(t,x,k,3);
% b4=evalBSplinePoly(t,x,k,4);
% b5=evalBSplinePoly(t,x,k,5);
% figure(1)
% clf
% hold on
% plot(x,b1,'-k','linewidth',2)
% plot(x,b2,'--r','linewidth',2)
% plot(x,b3,'-.g','linewidth',2)
% plot(x,b4,'-b','linewidth',2)
% plot(x,b5,'--c','linewidth',2)
%
%REFERENCES:
%[1] C. de Boor, A Practical Guide to Splines. New York: Springer-Verlag,
%    1978.
%[2] J. Stoer and R. Burlisch, Introduction to Numerical Analysis, 2nd ed.
%    New York: Springer-Verlag, 1991.
%
%April 2017 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

val=zeros(size(x));
numEls=numel(x);
for curIdx=1:numEls
    xCur=x(curIdx);
    tSel=t(idx:(idx+k));
    f=max(tSel-xCur,0).^(k-1);
    fDeriv=@(ti,nd)prod((k-(1:nd)))*max(ti-xCur,0).^(k-1-nd);

    val(curIdx)=(t(idx+k)-t(idx))*evalDividedDiff(tSel,f,fDeriv);
end
end

%LICENSE:
%
%The source code is in the public domain and not licensed or under
%copyright. The information and software may be used freely by the public.
%As required by 17 U.S.C. 403, third parties producing copyrighted works
%consisting predominantly of the material produced by U.S. government
%agencies must provide notice with such work(s) identifying the U.S.
%Government material incorporated and stating that such material is not
%subject to copyright protection.
%
%Derived works shall not identify themselves in a manner that implies an
%endorsement by or an affiliation with the Naval Research Laboratory.
%
%RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF THE
%SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY THE NAVAL
%RESEARCH LABORATORY FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE ACTIONS
%OF RECIPIENT IN THE USE OF THE SOFTWARE.


function triangle_symq_rule_test05 ( degree, numnodes, vert1, vert2, vert3 )

%*****************************************************************************80
%
%% TRIANGLE_SYMQ_RULE_TEST05 calls TRIASYMQ for a quadrature rule of given order and region.
%
%  Licensing:
%
%    This code is distributed under the GNU GPL license.
%
%  Modified:
%
%    27 June 2014
%
%  Author:
%
%    Original FORTRAN77 version by Hong Xiao, Zydrunas Gimbutas.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Hong Xiao, Zydrunas Gimbutas,
%    A numerical algorithm for the construction of efficient quadrature
%    rules in two and higher dimensions,
%    Computers and Mathematics with Applications,
%    Volume 59, 2010, pages 663-676.
%
%  Parameters:
%
%    Input, integer DEGREE, the desired total polynomial degree
%    exactness of the quadrature rule.  0 <= DEGREE <= 50.
%
%    Input, integer NUMNODES, the number of nodes to be used by the rule.
%
%    Input, real VERT1(2), VERT2(2), VERT3(2), the
%    vertices of the triangle.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TRIANGLE_SYMQ_RULE_TEST05\n' );
  fprintf ( 1, '  Compute a quadrature rule for a triangle.\n' );
  fprintf ( 1, '  Check it by integrating orthonormal polynomials.\n' );
  fprintf ( 1, '  Polynomial exactness degree DEGREE = %d\n', degree );

  area = triangle_area ( vert1, vert2, vert3 );
%
%  Retrieve a symmetric quadrature rule.
%
  [ rnodes, weights ] = triasymq ( degree, vert1, vert2, vert3,  numnodes );
%
%  Construct the matrix of values of the orthogonal polynomials
%  at the user-provided nodes
%
  npols = ( ( degree + 1 ) * ( degree + 2 ) ) / 2;

  rints = zeros ( npols, 1 );

  for i = 1 : numnodes
    z(1) = rnodes(1,i);
    z(2) = rnodes(2,i);
    r = triangle_to_ref ( vert1, vert2, vert3, z );
    pols = ortho2eva ( degree, r );
    rints(1:npols) = rints(1:npols) + weights(i) * pols(1:npols);
  end

  scale = sqrt ( sqrt ( 3.0 ) ) / sqrt ( area );
  rints(1:npols) = rints(1:npols) * scale;

  d = ( rints(1) - sqrt ( area ) )^2 + sum ( rints(2:npols).^2 );
  d = sqrt ( d ) / npols;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  RMS integration error = %g\n', d );

  return
end


%% AMG TEST I: DIFFERENT MESHES
%
% We consider linear finite element discretization of the Poisson equation
% with homongenous Dirichlet boundary condition on different meshes.

%%
clear all; close all;
%% Uniform mesh
[node,elem] = squaremesh([0,1,0,1],0.1);
[node,elem] = uniformrefine(node,elem);
[node,elem] = uniformrefine(node,elem);
showmesh(node,elem);
snapnow;
[N,itStep,time,err,errHist] = amgtest(node,elem);
%%
colHeaders = {'Unknowns','Iterations','Time (sec)','Error'};
makeHtmlTable([N itStep time err],[],[],colHeaders,[],6);
%%
colHeaders = {'Iterations','Approximate Error', 'Residual'};
makeHtmlTable([(0:itStep(end))' errHist],[],[],colHeaders,[],6);
%%
r = showrate(N,time,2);
xlabel('N'); ylabel('Time');
title(['Complexity is N^{' num2str(r) '}'] ,'Fontsize', 14);

%% Circle mesh
close all;
[node,elem] = circlemesh(0,0,1,0.2);
[node,elem] = uniformrefine(node,elem);
[node,elem] = uniformrefine(node,elem);
showmesh(node,elem);
snapnow;
[N,itStep,time,err] = amgtest(node,elem);
%%
colHeaders = {'Unknowns','Iterations','Time (sec)','Error'};
makeHtmlTable([N itStep time err],[],[],colHeaders,[],6);
%%
r = showrate(N,time,2);
xlabel('N'); ylabel('Time');
title(['Complexity is N^{' num2str(r) '}'] ,'Fontsize', 14);

%% Unstructured mesh
close all;
load lakemesh
showmesh(node,elem);
snapnow;
[N,itStep,time,err] = amgtest(node,elem);
%%
colHeaders = {'Unknowns','Iterations','Time (sec)','Error'};
makeHtmlTable([N itStep time err],[],[],colHeaders,[],6);
%%
r = showrate(N,time,2);
xlabel('N'); ylabel('Time');
title(['Complexity is N^{' num2str(r) '}'],'Fontsize', 14);


function [dat, opt] = proc_pca(dat, varargin)
%PROC_PCA - Principal Component Analysis
% [dat_pca, pca_opt] = proc_pca(dat, <opt>)
%
%Synopsis for training PCA:
% [DAT_PCA_TRAIN, PCA_OPT] = proc_pca(DAT_TRAIN, <OPT>)
%
%Synopsis for applying PCA:
% DAT_PCA_TEST = proc_pca(DAT_TEST, PCA_OPT)
%
%Arguments:
% DAT_TRAIN     - data structure of continuous or epoched data
% OPT           - struct or property/value list of optional properties:
%  .whitening   - if 1, the output dimensions will all have unit variance
%                 (default 0)
% PCA_OPT       - a struct that contains: a bias vector, filters and field
%                 patterns of the sources
%
%Returns
% DAT_PCA_TRAIN,
% DAT_PCA_TEST  - updated data structure
% PCA_OPT       - a struct that contains: a bias vector, filters and field
%                 patterns of the sources
%

% Sven Daehne, 03.2011, sven.daehne@tu-berlin.de
% Matthias Schultze-Kraft, 12.2015, schultze-kraft@tu-berlin.de

props= {'whitening'         0       'BOOL'
        'filters'           []      'DOUBLE'
        'field_patterns'    []      'DOUBLE'
        'bias'              []      'DOUBLE'};

if nargin==0,
  dat = props; return
end

dat = misc_history(dat);
misc_checkType(dat, 'STRUCT(x clab y)');

opt = opt_proplistToStruct(varargin{:});
opt = opt_setDefaults(opt, props);
opt_checkProplist(opt, props);

[T,nChans,nEpos] = size(dat.x);

%% train PCA
if isempty(opt.filters) || isempty(opt.bias)
    % get the data matrix
    if ndims(dat.x)==3
        % since time structure does not matter, we can simply concatenate all
        % epochs to get one big data matrix
        X = permute(dat.x, [1,3,2]); % now channels are the last dimension
        X = reshape(X, [T*nEpos, nChans]);
    else
        X = dat.x;
    end
    % remove the mean here already
    b = mean(X,1);
    B = repmat(b, [T*nEpos, 1]);
    X = X - B;

    % perform PCA and compute whitening matrix
    C = cov(X);
    [V, D] = eig(C);
    [ev_sorted, sort_idx] = sort(diag(D), 'descend');
    V = V(:,sort_idx);
    D = diag(ev_sorted);

    if opt.whitening
        V = V * diag(diag(D).^-0.5);
    end

    opt.filters = V;
    opt.field_patterns = V';
    opt.eigenvalues = ev_sorted;
    opt.bias = b;

end

%% apply PCA
if not(length(opt.bias) == nChans)
    error('Dimension of bias must equal the number of channels!')
end
% make sure opt.bias is a row vector
if size(opt.bias, 1) > size(opt.bias,2)
    opt.bias = opt.bias';
end

% subtract bias, then apply filters
B = squeeze(repmat(opt.bias, [T,1,nEpos]));
dat.x = dat.x - B;
dat = proc_linearDerivation(dat, opt.filters);


function varargout = centerOfMass(A,varargin)
% CENTEROFMASS finds the center of mass of the N-dimensional input array
%
%   CENTEROFMASS(A) finds the gray-level-weighted center of mass of the
%   N-dimensional numerical array A. A must be real and finite. A warning
%   is issued if A contains any negative values. Any NaN elements of A will
%   automatically be ignored. CENTEROFMASS produces center of mass
%   coordinates in units of pixels. An empty array is returned if the
%   center of mass is undefined.
%
%   The center of mass is reported under the assumption that the first
%   pixel in each array dimension is centered at 1.
%
%   Also note that numerical arrays other than DOUBLE and SINGLE are
%   converted to SINGLE in order to prevent numerical roundoff error.
%
%   Examples:
%       A = rgb2gray(imread('saturn.png'));
%       C = centerOfMass(A);
%
%       figure; imagesc(A); colormap gray; axis image
%       hold on; plot(C(2),C(1),'rx')
%
%   See also:
%
%

%
%   Jered R Wells
%   2013/05/07
%   jered [dot] wells [at] gmail [dot] com
%
%   v1.0
%
%   UPDATES
%       YYYY/MM/DD - jrw - v1.1
%
%

%% INPUT CHECK
narginchk(0,1);
nargoutchk(0,1);
fname = 'centerOfMass';

% Checked required inputs
validateattributes(A,{'numeric'},{'real','finite'},fname,'A',1);

%% INITIALIZE VARIABLES
A(isnan(A)) = 0;
if ~(strcmpi(class(A),'double') || strcmpi(class(A),'single'))
    A = single(A);
end
if any(A(:)<0)
    warning('MATLAB:centerOfMass:neg','Array A contains negative values.');
end

%% PROCESS
sz = size(A);
nd = ndims(A);
M = sum(A(:));
C = zeros(1,nd);
if M==0
    C = [];
else
    for ii = 1:nd
        shp = ones(1,nd);
        shp(ii) = sz(ii);
        rep = sz;
        rep(ii) = 1;
        ind = repmat(reshape(1:sz(ii),shp),rep);
        C(ii) = sum(ind(:).*A(:))./M;
    end
end

% Assemble the VARARGOUT cell array
varargout = {C};

end % MAIN


function [ n_data, x, fx ] = cos_degree_values ( n_data )

%*****************************************************************************80
%
%% COS_DEGREE_VALUES: the cosine function with argument in degrees.
%
%  Discussion:
%
%    In Mathematica, the function can be evaluated by:
%
%      Cos[x Degree]
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    23 March 2010
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Milton Abramowitz, Irene Stegun,
%    Handbook of Mathematical Functions,
%    National Bureau of Standards, 1964,
%    ISBN: 0-486-61272-4,
%    LC: QA47.A34.
%
%    Stephen Wolfram,
%    The Mathematica Book,
%    Fourth Edition,
%    Cambridge University Press, 1999,
%    ISBN: 0-521-64314-7,
%    LC: QA76.95.W65.
%
%  Parameters:
%
%    Input/output, integer N_DATA.  The user sets N_DATA to 0
%    before the first call.  On each call, the routine increments N_DATA by 1,
%    and returns the corresponding data; when there is no more data, the
%    output value of N_DATA will be 0 again.
%
%    Output, real X, the argument of the function.
%
%    Output, real FX, the value of the function.
%
  n_max = 22;

  fx_vec = [ ...
     0.99619469809174553230, ...
     1.0000000000000000000, ...
     0.99984769515639123916, ...
     0.99939082701909573001, ...
     0.99862953475457387378, ...
     0.99756405025982424761, ...
     0.99619469809174553230, ...
     0.98480775301220805937, ...
     0.96592582628906828675, ...
     0.86602540378443864676, ...
     0.70710678118654752440, ...
     0.50000000000000000000, ...
     0.25881904510252076235, ...
     0.087155742747658173558, ...
     0.069756473744125300776, ...
     0.052335956242943832722, ...
     0.034899496702500971646, ...
     0.017452406437283512819, ...
     0.000000000000000000000, ...
    -0.017452406437283512819, ...
    -0.25881904510252076235, ...
    -1.0000000000000000000 ];
  x_vec = [ ...
     -5.0, ...
      0.0, ...
      1.0, ...
      2.0, ...
      3.0, ...
      4.0, ...
      5.0, ...
     10.0, ...
     15.0, ...
     30.0, ...
     45.0, ...
     60.0, ...
     75.0, ...
     85.0, ...
     86.0, ...
     87.0, ...
     88.0, ...
     89.0, ...
     90.0, ...
     91.0, ...
    105.0, ...
    180.0 ];

  if ( n_data < 0 )
    n_data = 0;
  end

  n_data = n_data + 1;

  if ( n_max < n_data )
    n_data = 0;
    x = 0.0;
    fx = 0.0;
  else
    x = x_vec(n_data);
    fx = fx_vec(n_data);
  end

  return
end


function hermite_polynomial_test11 ( p, e )

%*****************************************************************************80
%
%% HERMITE_POLYNOMIAL_TEST11 tests HEN_POWER_PRODUCT.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 February 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer P, the maximum degree of the polynomial factors.
%
%    Input, integer E, the exponent of X in the integrand.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'HERMITE_POLYNOMIAL_TEST11\n' );
  fprintf ( 1, '  Compute a normalized probabilist''s Hermite polynomial power product table.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Tij = integral ( -oo < X < +oo ) X^E Hen(I,X) Hen(J,X) exp(-0.5*X*X) dx\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  where Hen(I,X) = normalized probabilist''s Hermite polynomial of degree I.\n' );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Maximum degree P = %d\n', p );
  fprintf ( 1, '  Exponent of X = %d\n', e );

  table = hen_power_product ( p, e );

  r8mat_print ( p + 1, p + 1, table, '  Power weighted table:' );

  return
end


%% EXAMPLE 9: Multitaper-Welch.
%  Multitaper-Welch estimators provide lower variance estimates at a fixed
%  frequency resolution or higher frequency resolution at similar variance
%  compared to the standard algorithm. In this example, we retain the high
%  frequency resolution of a three block Welch estimate but significantly
%  reduce the variance of the SPOD spectrum by using 10 Slepian tapers.
%
%   References:
%     [1] O. T. Schmidt, Spectral proper orthogonal decomposition using
%         multitaper estimates, Theor. Comput. Fluid Dyn., 2022, 1-14,
%         DOI 10.1007/s00162-022-00626-x, https://rdcu.be/cUtP3
%
% O. T. Schmidt (oschmidt@ucsd.edu)
% Last revision: 5-Sep-2022

clc, clear variables
addpath('utils')
disp('Loading the entire test database might take a second...')
load(fullfile('jet_data','jetLES.mat'),'p','x','r','dt');

%   trapezoidal quadrature weights for cylindrical coordinates
intWeights = trapzWeightsPolar(r(:,1),x(1,:));

%% Standard SPOD
%   SPOD with a large block size to get a high frequency resolution and
%   resolve the low-frequency regime.
nFFT    = 2048;
nOvlp   = nFFT/2;
[L,P,f] = spod(p,nFFT,intWeights,nOvlp,dt);

%   Plot the SPOD spectrum and three leading modes at the frequency of
%   interest.
f_plot  = 0.24;
[~,fi]  = min(abs(f-f_plot));
nBlk    = size(L,2);

figure
subplot(5,2,[1 3])
loglog(f,L)
xlim([f(2) f(end)]), ylim([1e-9 1e-3])
xlabel('frequency'), ylabel('SPOD mode energy')
title('Welch (standard)')
hold on
plot([f(fi) f(fi)],ylim,'k:')

count   = 5;
for mi  = 1:3
    subplot(5,2,count)
    contourf(x,r,real(squeeze(P(fi,:,:,mi))),11,'edgecolor','none'), axis equal tight, caxis(max(abs(caxis))*[-1 1])
    xlabel('x'), ylabel('r'), title(['f=' num2str(f(fi),'%.2f') ', mode ' num2str(mi)])
    xlim([0 10]); ylim([0 2])
    count = count + 2;
end
drawnow

%% Multitaper-Welch SPOD
%   SPOD using a retangular window of length 256 and 50 snaphots overlap
%   10 Slapian tapers by setting the time-halfbandwidth product to 5.5.
bw      = 5.5;
[L,P,f] = spod(p,[nFFT bw],intWeights,nOvlp,dt);

%   Plot the SPOD spectrum and modes as before. Compared to the standard
%   algorithm, the variance of the spectrum has been reduced significanlty
%   and the modes are better converged.
subplot(5,2,[2 4])
loglog(f,L(:,1:nBlk)), hold on
loglog(f,L(:,nBlk+1:end),'Color',[0.75 0.75 0.75]), hold on
xlim([f(2) f(end)]), ylim([1e-9 1e-3])
xlabel('frequency'), ylabel('SPOD mode energy')
title(['Multitaper-Welch, b_w=' num2str(bw)])

hold on
plot([f(fi) f(fi)],ylim,'k:')

count = 6;
for mi = 1:3
    subplot(5,2,count)
    contourf(x,r,real(squeeze(P(fi,:,:,mi))),11,'edgecolor','none'), axis equal tight, caxis(max(abs(caxis))*[-1 1])
    xlabel('x'), ylabel('r'), title(['f=' num2str(f(fi),'%.2f') ', mode ' num2str(mi)])
    xlim([0 10]); ylim([0 2])
    count = count + 2;
end


function bsv_test06 ( )

%*****************************************************************************80
%
%% BSV_TEST06 estimates the expected value of the zero crossing.
%
%  Discussion:
%
%    We assume that the left boundary condition ALPHA can vary like
%    a Gaussian variable with mean 1 and standard deviation 0.05.
%
%    Estimate the integral:
%
%      E(X0(ALPHA)) = integral ( -oo < alpha < +oo ) x0(alpha) e^(-0.5*alpha^2/sigma^2) dalpha
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 April 2012
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'BSV_TEST06:\n' );
  fprintf ( 1, '  For the Burgers equation on [A,B] with viscosity NU and \n' );
  fprintf ( 1, '  boundary conditions U(A)=ALPHA, U(B) = BETA,\n' );
  fprintf ( 1, '  with ALPHA and BETA of opposite sign,\n' );
  fprintf ( 1, '  let X0 be the point where the solution U changes sign.\n' );
  fprintf ( 1, '  Assume ALPHA is Gaussian with mean 0 and standard deviation 0.05.\n' );
  fprintf ( 1, '  Estimate E(X0(ALPHA)) using M Gaussian samples.\n' );

  a = -1.0;
  b = +1.0;
  beta = -1.0;
  nu = 0.1;
  n = 81;
  output = 0;

  x = linspace ( a, b, n );
%
%  Monte Carlo Estimate.
%  Choose M normal random samples with the correct STD,
%  find X0 for each, and average.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '     M    E(X0(ALPHA)) estimate\n' );
  fprintf ( 1, '\n' );

  for j = 4 : 12

    m = 2^j;
    mu = 1.0;
    sigma = 0.05;
    alpha_vec = mu + 0.05 * randn ( m, 1 );

    x0_bar = 0.0;

    for i = 1 : m
      alpha = alpha_vec(i);
      print = 0;
      u = bsv ( a, b, alpha, beta, nu, n, output );
      x0 = bsv_crossing ( a, b, n, x, u );
      x0_bar = x0_bar + x0;
    end

    x0_bar = x0_bar / m;

    fprintf ( 1, '  %4d  %14.6g\n', m, x0_bar );

  end

  return
end


function [A, B] = convertHypergraphToBipartiteGraph(S, printLevel)
% Converts a hypergraph into an undirected bipartite graph
%
% USAGE:
%
%    [A, B] = convertHypergraphToBipartiteGraph(S, printLevel)
%
% INPUT:
%    S:             `m x n` matrix with `m` nodes and `n` hyperedges
%    printLevel:    timer
%
% OUTPUTS:
%    A:             `(m+n) x (m+n)` adjacency matrix for an undirected graph (symmetric)
%    B:             `(m+n) x nnz(S)` incidence matrix for a directed graph
%
% .. Author: - Ronan Fleming 2013

if ~exist('printLevel', 'var')
    printLevel = 0;
end

[nMet, nRxn] = size(S);

if printLevel
    tic
end

S = sparse(S);
nnzS = nnz(S);

[row, col, v] = find(S);
numbers = 1:nnzS;
rowIndices = zeros(2 * nnzS, 1);
colIndices = zeros(2 * nnzS, 1);

values = zeros(2 * nnzS, 1);
rowIndices(1:2:end) = row;
colIndices(1:2:end) = numbers;
values(1:2:end) = v;

rowIndices(2:2:end) = nMet + col;
colIndices(2:2:end) = numbers;
values(2:2:end) = sign(v) * -1;

% incidence matrix for a bipartite graph
B = sparse(rowIndices, colIndices, values);
if printLevel
    toc
end

if printLevel
    tic
end

% create the adjacency matrix from undirected incidence matrix
A = inc2adj(B ~= 0);
if printLevel
    toc
end

% sanity check
assert(all(sum(B ~= 0, 1) == 2))
end

% old code
% %converts to bipartite hypergraph
% A=sparse(nMet+nRxn,nMet+nRxn);
%
% for j=1:nRxn
%     for i=1:nMet
%         if S(i,j)~=0
%             A(i,nMet+j)=1;
%             A(nMet+j,i)=1;
%         end
%     end
% end

% old methods
% switch method
% case 1
%     %incidence matrix for a bipartite graph
%     B=sparse(nMet+nRxn,nnzS);
%     k=1;
%     for j=1:nRxn
%         for i=1:nMet
%             if S(i,j)~=0
%                 if S(i,j)<0
%                     B(i,k)=S(i,j);
%                     B(nMet+j,k)=1;
%                 else
%                     B(i,k)=S(i,j);
%                     B(nMet+j,k)=-1;
%                 end
%                 k=k+1;
%
%             end
%         end
%     end
% case 2
%     rowIndices=zeros(2*nnzS,1);
%     colIndices=zeros(2*nnzS,1);
%     values=zeros(2*nnzS,1);
%     k=1;
%     p=1;
%     for j=1:nRxn
%         for i=1:nMet
%             if S(i,j)~=0
%                 if S(i,j)<0
%                     rowIndices(p)=i;
%                     colIndices(p)=k;
%                     values(p)=S(i,j);
%                     p=p+1;
%                     rowIndices(p)=nMet+j;
%                     colIndices(p)=k;
%                     values(p)=1;
%                     p=p+1;
%                 else
%                     rowIndices(p)=i;
%                     colIndices(p)=k;
%                     values(p)=S(i,j);
%                     p=p+1;
%                     rowIndices(p)=nMet+j;
%                     colIndices(p)=k;
%                     values(p)=-1;
%                     p=p+1;
%                 end
%                 k=k+1;
%             end
%         end
%     end


function result=robpca(x,varargin)

%ROBPCA is a 'ROBust method for Principal Components Analysis'.
% It is resistant to outliers in the data. The robust loadings are computed
% using projection-pursuit techniques and the MCD method.
% Therefore ROBPCA can be applied to both low and high-dimensional data sets.
% In low dimensions, the MCD method is applied (see mcdcov.m).
%
% The ROBPCA method is described in
%  Hubert, M., Rousseeuw, P.J., Vanden Branden, K. (2005), ROBPCA: a
%  new approach to robust principal components analysis, Technometrics, 47, 64-79.
%
%
% To select the number of principal components, a robust PRESS (predicted
% residual sum of squares) curve is drawn, based on a fast algorithm for
% cross-validation. This approach is described in:
%
%    Hubert, M., Engelen, S. (2007),
%    "Fast cross-validation of high-breakdown resampling algorithms for PCA",
%    Computational Statistics and Data Analysis, 51, 5013-5024.
%
% ROBPCA is designed for normally distributed data. If the data are skewed,
% a modification of ROBPCA is available, based on the adjusted outlyingness
% (see adjustedoutlyingness.m). This method is described in:
%
%    Hubert, M., Rousseeuw, P.J., Verdonck, T. (2008),
%    "Robust PCA for skewed data and its outlier map", Computational Statistics
%    and Data Analysis, in press.
%
%  For the up-to-date reference, please consult the website:
%    wis.kuleuven.be/stat/robust.html
%
% Required input arguments:
%            x : Data matrix (observations in the rows, variables in the
%                columns)
%
% Optional input arguments:
%            k : Number of principal components to compute. If k is missing,
%                or k = 0, a scree plot and a press curve are drawn which allows you to select
%                the number of principal components.
%         kmax : Maximal number of principal components to compute (default = 10).
%                If k is provided, kmax does not need to be specified, unless k is larger
%                than 10.
%        alpha : (1-alpha) measures the fraction of outliers the algorithm should
%                resist. Any value between 0.5 and 1 may be specified (default = 0.75).
%            h : (n-h+1) measures the number of outliers the algorithm should
%                resist. Any value between n/2 and n may be specified. (default = 0.75*n)
%                Alpha and h may not both be specified.
%          mcd : If equal to one: when the number of variables is sufficiently small,
%                the loadings are computed as the eigenvectors of the MCD covariance matrix,
%                hence the function 'mcdcov.m' is automatically called. The number of
%                principal components is then taken as k = rank(x). (default)
%                If equal to zero, the robpca algorithm is always applied.
%        plots : If equal to one, a scree plot, a press curve and a robust score outlier map are
%                drawn (default). If the input argument 'classic' is equal to one,
%                the classical plots are drawn as well.
%                If 'plots' is equal to zero, all plots are suppressed (unless k is missing,
%                then the scree plot and press curve are still drawn).
%                See also makeplot.m
%        labsd : The 'labsd' observations with largest score distance are
%                labeled on the outlier map. (default = 3)
%        labod : The 'labod' observations with largest orthogonal distance are
%                labeled on the outlier map. default = 3)
%      classic : If equal to one, the classical PCA analysis will be performed
%                (see also cpca.m). (default = 0)
%        scree : If equal to one, a scree plot is drawn. If k is given as input, the default value is 0, else the default value is one.
%        press : If equal to one, a plot of robust press-values is drawn.
%                If k is given as input, the default value is 0, else the default value is one.
%                If the input argument 'skew' is equal to one, no plot is
%                drawn.
%    robpcamcd : If equal to one (default), the whole robpca procedure is run (computation of outlyingness and
%                MCD).
%                If equal to zero, the program stops after the computation of the outlyingness. The
%                robust eigenvectors then correspond with the eigenvectors of the covariance matrix
%                of the h observations with smallest outlyingness. This yields the same
%                PCA subspace as the full robpca, but not the same eigenvectors and eigenvalues.
%         skew : If equal to zero the regular robpca is run. If equal to
%                one, the adjusted robpca algorithm for skewed data is run.
%
% I/O: result=robpca(x,'k',k,'kmax',10,'alpha',0.75,'h',h,'mcd',1,'plots',1,'labsd',3,'labod',3,'classic',0);
%  The user should only give the input arguments that have to change their default value.
%  The name of the input arguments needs to be followed by their value.
%  The order of the input arguments is of no importance.
%
% Examples:
%    result=robpca(x,'k',3,'alpha',0.65,'plots',0)
%    result=robpca(x,'alpha',0.80,'kmax',15,'labsd',5)
%
% The output of ROBPCA is a structure containing
%
%    result.P        : Robust loadings (eigenvectors)
%    result.L        : Robust eigenvalues
%    result.M        : Robust center of the data
%    result.T        : Robust scores
%    result.k        : Number of (chosen) principal components
%    result.kmax     : Maximal number of principal components
%    result.alpha    : see interpretation in the list of input arguments
%    result.h        : The quantile h used throughout the algorithm
%    result.Hsubsets : A structure that contains H0, H1 and Hfreq:
%                      H0 : The h-subset that contains the h points with the smallest outlyingness.
%                      H1 : The optimal h-subset of mcdcov.
%                      Hfreq : The subset of h points which are the most frequently selected during the mcdcov
%                              algorithm.
%    result.sd       : Robust score distances within the robust PCA subspace
%    result.od       : Orthogonal distances to the robust PCA subspace
%    result.cutoff   : Cutoff values for the robust score and orthogonal distances
%    result.flag     : The observations whose score distance is larger than result.cutoff.sd (==> result.flag.sd)
%                      or whose orthogonal distance is larger than result.cutoff.od (==> result.flag.od)
%                      can be considered as outliers and receive a flag equal to zero (result.flag.all).
%                      The regular observations receive a flag 1.
%    result.class    : 'ROBPCA'
%    result.classic  : If the input argument 'classic' is equal to one, this structure
%                     contains results of the classical PCA analysis (see also cpca.m).
%
% Short description of the method:
%
% Let n denote the number of observations, and p the number of original variables,
% then ROBPCA finds a robust center (p x 1) of the data M and a loading matrix P which
% is (p x k) dimensional. Its columns are orthogonal and define a new coordinate
% system. The scores (n x k) are the coordinates of the centered observations with
% respect to the loadings: T=(X-M)*P.
% Note that ROBPCA also yields a robust covariance matrix (often singular) which
% can be computed as
%                         cov=out.P*out.L*out.P'
%
% To select the number of principal components, it is useful to look at the scree plot which
% shows the eigenvalues, and the press curve which displays a weighted sum of the squared
% cross-validated orthogonal distances.
% The outlier map visualizes the observations by plotting their orthogonal
% distance to the robust PCA subspace versus their robust distances
% within the PCA subspace. This allows to classify the data points into 4 types:
% regular observations, good leverage points, bad leverage points and
% orthogonal outliers.
%
% This function is part of LIBRA: the Matlab Library for Robust Analysis,
% available at:
%              http://wis.kuleuven.be/stat/robust
%
% Written by Mia Hubert, Sabine Verboven, Karlien Vanden Branden, Sanne Engelen, Tim Verdonck
% Last Update: 17/06/2003,  03/07/2006,  31/07/2007
% Last Revision: 27/03/2008, 09/06/2008

%
% initialization with defaults
%
data=x;
[n,p]=size(data);

% First Step: classical PCA on data
if n < p
    [P1,T1,L1,r,Xc,clm]=kernelEVD(data);
else
	[P1,T1,L1,r,Xc,clm]=classSVD(data);
end
% dim(P1): p x r

if r==0
    error('All data points collapse!')
end

niter=100;
counter=1;
kmax=min([10,floor(n/2),r]);
k=0;
alfa=0.75;
h=min(floor(2*floor((n+kmax+1)/2)-n+2*(n-floor((n+kmax+1)/2))*alfa),n);
labsd=3;
labod=3;
plots=1;
scree = 1;
press = 1;
mcd=1; % user wants the mcd approach (in case n>>p)
robpcamcd = 1;
cutoff  = 0.975;
skew=0;
% default is a structure needed for input checking
default=struct('alpha',alfa,'h',h,'labsd',labsd,'labod',labod,...
    'k',k,'plots',plots,'kmax',kmax,'mcd',mcd,'classic',0,'scree',scree,'press',press,'robpcamcd',robpcamcd,'cutoff',cutoff,'skew',0);
list=fieldnames(default);
options=default; %input by user
IN=length(list);
i=1;
%
if nargin==2
    error('Incorrect number of input arguments!')
end
dummy = 0;  %Assume we didn't get h or alpha, unless we find it below.
if nargin>2
    %
    %placing inputfields in array of strings
    %
    for j=1:nargin-2
        if rem(j,2)~=0
            chklist{i}=varargin{j};
            i=i+1;
        end
    end
    dummy=sum(strcmp(chklist,'h')+2*strcmp(chklist,'alpha')); %checking if h and alpha are provided both or not
    switch dummy
    case 0 % Take on default values
        options.alpha=alfa;
        if any(strcmp(chklist,'kmax'))
            for j=1:nargin-2 % searching the index of the accompanying field
                if rem(j,2)~=0 % fieldnames are placed on odd index
                    if strcmp('kmax',varargin{j})
                        I=j;
                    end
                end
            end
            options=setfield(options,'kmax',varargin{I+1});
            kmax = max(min([floor(options.kmax),floor(n/2),r]),1); %acceptable kmax
            options.h=min(floor(2*floor((n+kmax+1)/2)-n+2*(n-floor((n+kmax+1)/2))*alfa),n); %depends on kmax, so if kmax is given by user, get it first!
        else %kmax is not given by user
           options.h=h;
        end
    case 3
        error('Both inputarguments alpha and h are provided. Only one is required.')
    end

    %
    % Checking which default parameters have to be changed
    % and keep them in the structure 'options'.
    %
    while counter<=IN
        index=strmatch(list(counter,:),chklist,'exact');
        if ~isempty(index) % in case of similarity
            for j=1:nargin-2 % searching the index of the accompanying field
                if rem(j,2)~=0 % fieldnames are placed on odd index
                    if strcmp(chklist{index},varargin{j})
                        I=j;
                    end
                end
            end
            options=setfield(options,chklist{index},varargin{I+1});
            index=[];
        end
        counter=counter+1;
    end
    options.h=floor(options.h);
    options.kmax=floor(options.kmax);
    options.k=floor(options.k);
    kmax=max(min([options.kmax,floor(n/2),r]),1);
    labod=max(0,min(floor(options.labod),n));
    labsd=max(0,min(floor(options.labsd),n));
    k=options.k;

    if k<0
        k=0;
    elseif k > kmax
        k=kmax;
        mess=sprintf(['Attention (robpca.m): The number of principal components, k = ',num2str(options.k)...
            ,'\n is larger than kmax= ',num2str(kmax),'; k is set to ',num2str(kmax)]);
        disp(mess)
    end
    if dummy==1 % checking input variable h
        options.alpha=options.h/n;
        if k==0
            if options.h < floor((n+kmax+1)/2 )
                options.h=floor((n+kmax+1)/2);
                options.alpha=options.h/n;
                mess=sprintf(['Attention (robpca.m): h should be larger than (n+kmax+1)/2.\n',...
                        'It is set to its minimum value ',num2str(options.h)]);
                disp(mess)
            end
        else
            if options.h < floor((n+k+1)/2)
                options.h=floor((n+k+1)/2);
                options.alpha=options.h/n;
                mess=sprintf(['Attention (robpca.m): h should be larger than (n+k+1)/2.\n',...
                        'It is set to its minimum value ',num2str(options.h)]);
                disp(mess)
            end
        end
        if options.h > n
            options.alpha=0.75;
            if k==0
                options.h=floor(2*floor((n+kmax+1)/2)-n+2*(n-floor((n+kmax+1)/2))*options.alpha);
            else
                options.h=floor(2*floor((n+k+1)/2)-n+2*(n-floor((n+k+1)/2))*options.alpha);
            end
            mess=sprintf(['Attention (robpca.m): h should be smaller than n. \n',...
                    'It is set to its default value ',num2str(options.h)]);
            disp(mess)
        end
    elseif dummy==2 %checking input variable alpha
        if options.alpha < 0.5
            options.alpha=0.5;
            mess=sprintf(['Attention (robpca.m): Alpha should be larger than 0.5.\n',...
                    'It is set to 0.5.']);
            disp(mess)
        end
        if options.alpha > 1
            options.alpha=0.75;
            mess=sprintf(['Attention (robpca.m): Alpha should be smaller than 1. \n',...
                    'It is set to 0.75.']);
            disp(mess)
        end
        if k==0
            options.h=floor(2*floor((n+kmax+1)/2)-n+2*(n-floor((n+kmax+1)/2))*options.alpha);
        else
            options.h=floor(2*floor((n+k+1)/2)-n+2*(n-floor((n+k+1)/2))*options.alpha);
        end
    end
    alfa=options.alpha;
    dummyh = strcmp(chklist,'h');
    dummykmax = strcmp(chklist,'kmax');
    %     if all(dummyh == 0) & any(dummykmax) & k==0
    %         h = min(floor(2*floor((n+kmax+1)/2)-n+2*(n-floor((n+kmax+1)/2))*alfa),n);
    %     end
    if all(dummyh == 0)&& any(dummykmax) %kmax was given by the user
        if k==0
            options.h=floor(2*floor((n+kmax+1)/2)-n+2*(n-floor((n+kmax+1)/2))*options.alpha);
        else
            options.h=floor(2*floor((n+k+1)/2)-n+2*(n-floor((n+k+1)/2))*options.alpha);
        end
    elseif all(dummyh == 0) && ~any(dummykmax) %kmax is the default value
        if k==0
            options.h=floor(2*floor((n+kmax+1)/2)-n+2*(n-floor((n+kmax+1)/2))*options.alpha);
        else
            options.h=floor(2*floor((n+k+1)/2)-n+2*(n-floor((n+k+1)/2))*options.alpha);
        end
    end
    h=options.h;
    dummyscree = strcmp(chklist,'scree');
    dummypress = strcmp(chklist,'press');
    if all(dummyscree == 0)
        if k~=0
            options.scree = 0;
        end
    end
    if all(dummypress == 0)
        if k~=0
            options.press = 0;
        end
    end
    scree = options.scree;
    press = options.press;
    labsd=floor(max(0,min(options.labsd,n)));
    labod=floor(max(0,min(options.labod,n)));
    plots=options.plots;
    mcd=options.mcd;
    robpcamcd = options.robpcamcd;
    cutoff = options.cutoff;
    skew = options.skew;
    if skew==1
        press=0; %press curve not available for skewed data
    end
end
%
% MAIN PART
%
X=T1;
center=clm;
rot=P1;
% Depending on n and p, perform MCD or ROBPCA:
% p << n => MCD
p1=size(X,2);
if p1<=min(floor(n/5),kmax) && mcd && (skew==0)
    options.h=h;
    [res,raw]=mcdcov(X,'h',h,'plots',0);
    [U,S,P]=svd(res.cov,0);
    L=diag(S);
    if k~=0
        options.k=min(k,p1);
    else
        bdwidth=5;
        topbdwidth=30;
        set(0,'Units','pixels');
        scnsize=get(0,'ScreenSize');
        pos1=[bdwidth, 1/3*scnsize(4)+bdwidth, scnsize(3)/2-2*bdwidth, scnsize(4)/2-(topbdwidth+bdwidth)];
        pos2=[pos1(1)+scnsize(3)/2, pos1(2), pos1(3), pos1(4)];
        if press == 1
            outcvMcd = cvMcd(X,p1,res,h);
            figure('Position',pos1)
            set(gcf,'Name', 'PRESS curve','NumberTitle', 'off');
            plot(1:p1,outcvMcd.press,'o-')
            title('MCD')
            xlabel('number of LV')
            ylabel('R-PRESS')
        end
        if scree == 1
            figure('Position',pos2)
            screeplot(L,'MCD');
        end
        if (scree == 1) || (press == 1)
            cumperc = cumsum(L)./sum(L);
            disp(['The cumulative percentage of variance explained by the first ',num2str(kmax),' components is:']);
            disp(num2str(cumperc'));
            disp(['How many principal components would you like to retain? Max = ',num2str(kmax),'. ']);
            k=input('');
        end
        % to close the figures.
        if scree == 1
            close
        end
        if press == 1
            close
        end
    end
    options.k = k;
    T=(X-repmat(res.center,size(X,1),1))*U;
    out.M=center+res.center*rot';
    out.L=L(1:options.k)';
    out.P=rot*U(:,1:options.k);
    out.T=T(:,1:options.k);
    out.h=h;
    out.k=options.k;
    out.alpha=alfa;
    out.Hsubsets.H0 = res.Hsubsets.Hopt;
    out.Hsubsets.H1 = [];
    out.Hsubsets.Hfreq = res.Hsubsets.Hfreq;
    out.skew=skew;
else
    % p > n => ROBPCA
    niter=100;
    seed=0;
    if h~=n
        if skew==0
            B=twopoints(T1,250,seed); %n*ri
            for i=1:size(B,1)
                Bnorm(i)=norm(B(i,:),2);
            end
            Bnormr=Bnorm(Bnorm > 1.e-12); %ndirect*1
            B=B(Bnorm > 1.e-12,:);       %ndirect*n
            A=diag(1./Bnormr)*B;         %ndirect*n
            %projected points in columns
            Y=T1*A';%n*ndirect
            m=length(Bnormr);
            Z=zeros(n,m);
            for i=1:m
                [tmcdi,smcdi,weights]=unimcd(Y(:,i),h);
                if smcdi<1.e-12
                    r2=rank(data(weights,:));
                    if r2==1
                        error(['At least ',num2str(sum(weights)),' obervations are identical.']);
                    end
                else
                    Z(:,i)=abs(Y(:,i)-tmcdi)/smcdi;
                end
            end
            d=max(Z,[],2);
        else %adjusted robpca for skewed data
            outAO=adjustedoutlyingness(T1,'ndir',min(250*p,2500));
            d=outAO.adjout;
        end
        [ds,is]=sort(d);
        Xh=T1(is(1:h),:); % Xh contains h (good) points out of Xcentr
        [P2,T2,L2,r2,Xm,clmX]=classSVD(Xh);
        out.Hsubsets.H0 = is(1:h);
        Tn=(T1-repmat(clmX,n,1))*P2;
    else
        P2=eye(r);
        Tn=T1;
        L2=L1;
        r2=r;
        out.Hsubsets.H0=1:n;
        Xm=T1;
        clmX=zeros(1,size(T1,2));
    end

    %dim(P2) = r x r2
    L=L2;
    kmax=min(r2,kmax);

    % choice of k:
    %-------------
    bdwidth=5;
    topbdwidth=30;
    set(0,'Units','pixels');
    scnsize=get(0,'ScreenSize');
    pos1=[bdwidth, 1/3*scnsize(4)+bdwidth, scnsize(3)/2-2*bdwidth, scnsize(4)/2-(topbdwidth+bdwidth)];
    pos2=[pos1(1)+scnsize(3)/2, pos1(2), pos1(3), pos1(4)];

    if press == 1
        disp('The robust press curve based on cross-validation is now computed.')
        outprMCDkmax = projectMCD(Tn,L,kmax,h,niter,rot,P1,P2,center,cutoff);
        if size(out.Hsubsets.H0,2)==1
            out.Hsubsets.H0=out.Hsubsets.H0';
        end
        outprMCDkmax.Hsubsets.H0 = out.Hsubsets.H0;
        outpress = cvRobpca(data,kmax,outprMCDkmax,0,h);
        figure('Position',pos1)
        set(gcf,'Name', 'PRESS curve','NumberTitle', 'off');
        plot(1:kmax,outpress.press,'o-')
        title('ROBPCA')
        xlabel('Number of LV')
        ylabel('R-PRESS')
    else
        if size(out.Hsubsets.H0,2)==1
            out.Hsubsets.H0=out.Hsubsets.H0';
        end
    end

    if scree == 1
        figure('Position',pos2)
        screeplot(L(1:kmax),'ROBPCA')
    end

    if (scree == 1)||(press == 1)
        cumperc = (cumsum(L(1:kmax))./sum(L))';
        disp(['The cumulative percentage of variance explained by the first ',num2str(kmax),' components is:']);
        disp(num2str(cumperc));
        disp(['How many principal components would you like to retain? Max = ',num2str(kmax),'.']);
        k=input('');
        k=max(min(min(r2,k),kmax),1);
        % we compute again the robpca results for a specific k value. alpha
        % and h can change again, because until now they were based on the kmax
        % value.
        if dummy == 2
            options.h=floor(2*floor((n+k+1)/2)-n+2*(n-floor((n+k+1)/2))*alfa);
            %if dummy == 1 no changes needed
        elseif dummy~=1
            options.h=floor(2*floor((n+k+1)/2)-n+2*(n-floor((n+k+1)/2))*options.alpha);
        end
        h=options.h;
        % to close the figures.
        if scree == 1
            close
        end
        if press == 1
            close
        end
    else
        k=min(min(r2,k),kmax);
    end

    if k~=r % extra reweighting step
        XRc=T1-repmat(clmX,n,1);
        Xtilde=XRc*P2(:,1:k)*P2(:,1:k)';
        Rdiff = XRc-Xtilde;
        for i=1:n
            odh(i,1)=norm(Rdiff(i,:));
        end
        if skew==0
            [m,s]=unimcd(odh.^(2/3),h);
            cutoffodh = sqrt(norminv(cutoff,m,s).^3);
        else %adjusted robpca for skewed data
            mcodh=mc(odh);
            if mcodh>0
                cutoffodh = prctile(odh,75)+1.5*exp(3*mcodh)*iqr(odh);
            else
                cutoffodh = prctile(odh,75)+1.5*iqr(odh);
            end
            ttup = sort(-odh(odh<cutoffodh));
            cutoffodh = -ttup(1);
        end
        indexset = find(odh<=cutoffodh)';
        [P2,Th,Lh,rh,Xm,clmX]=classSVD(T1(indexset,:));
        if k>rh
            k = rh;
        end
    end
    center=center+clmX*rot';
    rot=rot*P2(:,1:k);
    Tn=(T1-repmat(clmX,n,1))*P2;

    % if only the subspace is important, not the PC themselves: do not
    % perform MCD anymore.
    if ~robpcamcd
        out.P = rot; %=P1*P2(:,1:k);
        out.T = Tn(:,1:k);
        out.M = center;
        out.L = Lh;
        out.k = k;
        out.h = h;
        out.alpha = alfa;
        out.kmax=kmax;
        out.skew=skew;
    end

    % projection, mcd
    %-----------------
    if skew==0
        outpr = projectMCD(Tn,L,k,h,niter,rot,P1,P2,center,cutoff);
    else %adjusted robpca for skewed data
        outpr = projectAO(Tn,k,h,rot,center);
    end
    out.T = outpr.T;
    out.P = outpr.P;
    out.M = outpr.M;
    out.L = outpr.L;
    out.k = k;
    out.kmax=kmax;
    out.h = h;
    out.alpha = alfa;
    out.skew = skew;
    if skew==0
        out.Hsubsets.H1 = outpr.Hsubsets.H1;
        out.Hsubsets.Hfreq = outpr.Hsubsets.Hfreq;
    else
        out.AO=outpr.AO;
        out.cutoff.AO=outpr.cutoff.AO;
    end
end

% Classical analysis
if options.classic==1
    out.classic.P=P1(:,1:out.k);
    out.classic.L=L1(1:out.k)';
    out.classic.M=clm;
    out.classic.T=T1(:,1:out.k);
    out.classic.k=out.k;
    out.classic.Xc=Xc;
end

outpr = out;

% Calculation of the distances, flags
%-------------------------------------

if options.classic == 1
    outDist = CompDist(data,r,outpr,cutoff,robpcamcd,out.classic);
else
    outDist = CompDist(data,r,outpr,cutoff,robpcamcd);
end

out.sd = outDist.sd;
out.cutoff.sd = outDist.cutoff.sd;
out.od = outDist.od;
out.cutoff.od = outDist.cutoff.od;
out.flag = outDist.flag;
out.class = outDist.class;
out.classic = outDist.classic;
if options.classic == 1
    out.classic.sd = outDist.classic.sd;
    out.classic.od = outDist.classic.od;
    out.classic.cutoff.sd = outDist.classic.cutoff.sd;
    out.classic.cutoff.od = outDist.classic.cutoff.od;
    out.classic.class = outDist.classic.class;
    out.classic.flag = outDist.classic.flag;
end

result=struct('P',{out.P},'L',{out.L},'M',{out.M},'T',{out.T},'k',{out.k},'kmax',{kmax},'alpha',{out.alpha},...
    'h',{out.h},'Hsubsets',{out.Hsubsets},'sd', {out.sd},'od',{out.od},'cutoff',{out.cutoff},'flag',out.flag',...
    'class',{out.class},'classic',{out.classic});

% Plots
try
    if plots && options.classic
        makeplot(result,'classic',1,'labsd',labsd,'labod',labod)
    elseif plots
        makeplot(result,'labsd',labsd,'labod',labod)
    end
catch %output must be given even if plots are interrupted
    %> delete(gcf) to get rid of the menu
end

%--------------------------------------------------------------------------
function outprMCD = projectMCD(Tn,L,k,h,niter,rot,P1,P2,center,cutoff)

% this function performs the last part of ROBPCA when k is determined.
% input :
%   Tn : the projected data
%   L  : the matrix of the eigenvalues
%   k  : the number of components
%   h  : lower bound for regular observations
%   niter : the number of iterations
%   rot : the rotation matrix
%   P1, P2: the different eigenvector matrices after each transformation
%   center : the classical center of the data

X2=Tn(:,1:k);
n = size(X2,1);
rot=rot(:,1:k);
% first apply c-step with h points from first step,i.e. those that
% determine the covariance matrix after the c-steps have converged.
mah=libra_mahalanobis(X2,zeros(size(X2,2),1),'cov',L(1:k));
oldobj=prod(L(1:k));
P4=eye(k);
korig=k;
for j=1:niter
    [mahs,is]=sort(mah);
    Xh=X2(is(1:h),:);
    [P,T,L,r3,Xm,clmX]=classSVD(Xh);
    obj=prod(L);
    X2=(X2-repmat(clmX,n,1))*P;
    center=center+clmX*rot';
    rot=rot*P;
    mah=libra_mahalanobis(X2,zeros(size(X2,2),1),'cov',diag(L));
    P4=P4*P;
    if ((r3==k) && (abs(oldobj-obj) < 1.e-12))
        break;
    else
        oldobj=obj;
        j=j+1;
        if r3 < k
            j=1;
            k=r3;
        end
    end
end
% dim(P4): k x k0 with k0 <= k but denoted as k
% dim X2: n x k0
% perform mcdcov on X2
[zres,zraw]= mcdcov(X2,'plots',0,'ntrial',250,'h',h,'file',0);
out.resMCD = zres;
if zraw.objective < obj
    z = zres;
    out.Hsubsets.H1 = zres.Hsubsets.Hopt;
else
    sortmah = sort(mah);
    if h==n
        factor=1;
    else
        factor = sortmah(h)/chi2inv(h/n,k);
    end
    mah = mah/factor;
    weights = mah <= chi2inv(cutoff,k);
    [center_noMCD,cov_noMCD] = weightmecov(X2,weights);
    mah = libra_mahalanobis(X2,center_noMCD,'cov',cov_noMCD);
    z.flag = (mah <= chi2inv(cutoff,k));
    z.center = center_noMCD;
    z.cov = cov_noMCD;
    out.Hsubsets.H1 = is(1:h);
end
covf=z.cov;
centerf=z.center;
[P6,L]=eig(covf);
[L,I]=greatsort(diag(real(L)));
P6=P6(:,I);
out.T=(X2-repmat(centerf,n,1))*P6;
P=P1*P2;
out.P=P(:,1:korig)*P4*P6;
centerfp=center+centerf*rot';
out.M=centerfp;
out.L=L';
out.k=k;
out.h=h;

% creation of Hfreq
out.Hsubsets.Hfreq = zres.Hsubsets.Hfreq(1:h);

outprMCD = out;
%----------------------------------------------------------------------------
function outprAO = projectAO(Tn,k,h,rot,center)

% this function performs the last part of ROBPCA when k is determined.
% input :
%   Tn : the projected data
%   k  : the number of components
%   h  : lower bound for regular observations
%   rot : the rotation matrix
%   center : the classical center of the data

seed=0;
X2=Tn(:,1:k);
[n,p]=size(X2);
outAO=adjustedoutlyingness(X2,'ndir',min(250*p,2500));
AO=outAO.adjout;
cutoffAO=outAO.cutoff;
indexset = find(AO<=cutoffAO)';
%SVD
[P6,T6,L6,r6,Xm6,clmX6]=classSVD(X2(indexset,:));
out.T = (X2-repmat(clmX6,n,1))*P6;
out.P = rot*P6;
out.M = center+clmX6*rot';
out.L = L6;
out.k = k;
out.h = h;
out.AO=AO;
out.cutoff.AO=cutoffAO;
outprAO=out;

%--------------------------------------------------------------------------------
function outDist = CompDist(data,r,out,cutoff,robpcamcd,classic)

% Calculates the distances.
% input: data : the original data
%           r : the rank of the data
%        out is a structure that contains the results of the PCA.
%        classic: an optional structure:
%               classic.P1
%               classic.T1
%               classic.L1
%               classic.clm
%               classic.Xc

if nargin < 6
    options.classic = 0;
else
    options.classic = 1;
end

n = size(data,1);
p = size(data,2);
k = out.k;
skew=out.skew;

% Computing distances
% Robust score distances in robust PCA subspace
if robpcamcd
    if skew==0
        out.sd=sqrt(libra_mahalanobis(out.T,zeros(size(out.T,2),1),'cov',out.L))';
        out.cutoff.sd=sqrt(chi2inv(cutoff,out.k));
    else
        out.sd=out.AO;
        out.cutoff.sd=out.cutoff.AO;
    end
else
    out.sd=zeros(n,1);
    out.cutoff.sd=0;
end
% Orthogonal distances to robust PCA subspace
XRc=data-repmat(out.M,n,1);
Xtilde=out.T*out.P';
Rdiff=XRc-Xtilde;
for i=1:n
    out.od(i,1)=norm(Rdiff(i,:));
end
% Robust cutoff-value for the orthogonal distance
if k~=r
    if skew==0
        [m,s]=unimcd(out.od.^(2/3),out.h);
        out.cutoff.od = sqrt(norminv(cutoff,m,s).^3);
    else
        mcod=mc(out.od);
        if mcod>0
            out.cutoff.od = prctile(out.od,75)+1.5*exp(3*mcod)*iqr(out.od);
        else
            out.cutoff.od = prctile(out.od,75)+1.5*iqr(out.od);
        end
        ttup = sort(-out.od(out.od<out.cutoff.od));
        out.cutoff.od = -ttup(1);
    end
else
    out.cutoff.od=0;
end
if options.classic==1
    % Mahalanobis distance in classical PCA subspace
    Tclas=classic.Xc*classic.P(:,1:out.k);
    out.classic.sd=sqrt(libra_mahalanobis(Tclas,zeros(size(Tclas,2),1),'invcov',1./classic.L(1:out.k)))';
    % Orthogonal distances to classical PCA subspace
    Xtilde=Tclas*classic.P(:,1:out.k)';
    Cdiff=classic.Xc-Xtilde;
    for i=1:n
        out.classic.od(i,1)=norm(Cdiff(i,:));
    end
    out.classic.cutoff.sd=sqrt(chi2inv(cutoff,out.k)); % should be defined after od to have the output in the correct order
    % Classical cutoff-values
    if k~=r
        m=mean(out.classic.od.^(2/3));
        s=sqrt(var(out.classic.od.^(2/3)));
        out.classic.cutoff.od = sqrt(norminv(cutoff,m,s)^3);
    else
        out.classic.cutoff.od=0;
    end
    out.classic.cutoff.sd=sqrt(chi2inv(cutoff,out.k));
    out.classic.flag.od=(out.classic.od<=out.classic.cutoff.od);
    out.classic.flag.sd=(out.classic.sd<=out.classic.cutoff.sd);
    out.classic.flag.all=(out.classic.flag.od)&(out.classic.flag.sd);
    out.classic.class='CPCA';
else
    out.classic=0;
end

out.class='ROBPCA';

if k~=r
    out.flag.od=(out.od<=out.cutoff.od);
    out.flag.sd=(out.sd<=out.cutoff.sd);
    out.flag.all=(out.flag.od)&(out.flag.sd);
else
    out.flag.od=(out.od<=out.cutoff.od);
    out.flag.sd=(out.sd<=out.cutoff.sd);
    out.flag.all=(out.sd<=out.cutoff.sd);
end

outDist = out;


function bc = specific_bc(xbd,ybd)
%solution4_bc   Reference problem 1.4  boundary condition
%   bc = specific_bc(xbd,ybd);
%   input
%          xbd          x boundary coordinate vector
%          ybd          y boundary coordinate vector
%   IFISS function: DJS; 28 February 2005.
% Copyright (c) 2005 D.J. Silvester, H.C. Elman, A. Ramage
bc=(xbd.^2+ybd.^2).^(1/3) .*sin((pi+2*atan2(ybd,xbd))/3);
return


      function [A, phi, f] = amplitude_spectrum(td)
         %amplitude_spectrum   Simple method to compute amplitude
         %   spectrum for a trace. Uses the MATLAB fft function.
         %   [A, phi, f] = amplitude_spectrum(td)
         %
         %   Inputs:
         %       td - a single TraceData
         %
         %   Outputs:
         %       A - the amplitude coefficients
         %       phi - the phase coefficients
         %       f - the frequency values corresponding to elements of A and phi
         %
         %   Example:
         %       [A phi, f] = amplitude_spectrum(td)
         %       plot(f,A);
         %       xlabel('Frequency (Hz)')
         %       ylabel('Amplitude');
         %
         %   See also fft
         %   Glenn Thompson, November 21, 2014

         %TODO: Rename this to amplitudespectrum or move it elsewhere

         N = length(td.data);
         NFFT = 2 ^ nextpow2(N); % Next power of 2 from length of y
         Y = fft(td.data, NFFT); % X will have same length as signal, and will be complex with a magnitude and phase
         A = 2 * abs(Y(1:NFFT/2+1)) / N;
         phi = angle(Y);
         f = td.samplerate / 2 * linspace(0,1,NFFT/2+1);
      end


function R = p2p_rcu(a, n_vals, eps)
% Compute the achievable sum rate (at the symmetrical rate point) from the point-to-point RCU bound
% for the joint source distribution: [a 1/3*(1-a); 1/3*(1-a) 1/3*(1-a)].

% Input:
% a: parameter to define the joint source distribution, should be in range [0.25, 1)
% n_vals: a vector containing the blocklengths
% eps: target error probability
% Output:
% R: the achievable rates for the blocklengths specified in n_vals.

    p = [a 1/3*(1-a); 1/3*(1-a) 1/3*(1-a)];
    H = sum(sum(p.*log(1./p)));  % Source joint entropy

    % Compute log binomial coefficients
    log_b = binomial_coeff(max(n_vals));

    R = zeros(length(n_vals),1);

    for i = 1:length(n_vals)
        n = n_vals(i);
        m = 0:n;  % Number of occurrence of the largest joint probability mass
        % log_Pr stores all the log probabilities in descending order
        log_Pr = m*log(a)+(n-m)*log(1/3*(1-a));

        % [x, y]: initial range for the bisection algorithm
        x = H;
        y = H + 2;
        %%%%%%%%%% Use this part to check if the range is valid for bisection algorithm %%%%%%%%%%
        c = x;
        log_indicator = zeros(1,n+1);
        for j = 0:n
            log_indicator(j+1) = min(0, my_logsumexp(log_b{n+1}(j+1:n+1)+(n-(j:n))*log(3))-n*c);
        end
        err = exp(my_logsumexp(log_Pr + log_b{n+1} + (n-m)*log(3) + log_indicator));
        %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

        % Start of bisection iteration
        iter = 0;
        while abs(x - y) > 0.00001 && iter <= 25
            c = (x+y)/2;
            %%%%%%%%%%%%%%%% body of iteration %%%%%%%%%%%%%%%%
            log_indicator = zeros(1,n+1);
            for j = 0:n
                log_indicator(j+1) = min(0, my_logsumexp(log_b{n+1}(j+1:n+1)+(n-(j:n))*log(3))-n*c);
            end
            err = exp(my_logsumexp(log_Pr + log_b{n+1} + (n-m)*log(3) + log_indicator));
            %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
            if err - eps < 0
                y = c;
            else
                x = c;
            end
            iter = iter + 1;
        end
        R(i) = c;
    end
end


function [F, p, resid, df_model, df_error] = F_test_full_vs_red(y, X, Xred, px, pxred)
% :Usage:
% ::
%
%     [F, p, resid, df_model, df_error] = F_test_full_vs_red(y, X, Xred, px, pxred)
%
% :Examples:
% ::
%
%    X = randn(100, 3); Xred = X(:,1); y = X(:,2) + randn(100, 1);
%    px = pinv(X); pxred = pinv(Xred);
%    [F, p, resid] = F_test_full_vs_red(y, X, Xred, px, pxred);
%
%
%    % Test full-model F-value against regress.m
%    Xred = X(:,end); % intercept only
%    px = pinv(X);
%    pxred = pinv(Xred);
%    [F, p, resid, dfm, dfe] = F_test_full_vs_red(y, X, Xred, px, pxred); % full model F-test
%    [b, bint, r, rint, stats] = regress(y, X);
%
% ..
%    Tested OK on 11/27/07, by tor
% ..

    T = length(y);      % Length of time course

    k = size(px, 1);        % predictors: full model
    kred = size(pxred, 1);  % predictors: reduced model

    % Degrees of freedom: model: Full - reduced
    df_model = k - kred;                        % degrees of freedom for model (param - 1)
    df_error = T - k;                           % error DF, full model

    % Step 1: Find the OLS solution for the FULL model
    % ---------------------------------------------------
    beta = px * y;                             % Beta values
    resid = y - X * beta;                       % Residuals

    % Sums of squares
    %SST = y' * y;
    SSE = resid' * resid;
    %SSfull = SST - SSE;
    var_est = SSE / df_error;                   % Estimate of Sigma^2

    % Step 2: Find the OLS solution for the REDUCED model
    % F-test for full vs. reduced
    % ---------------------------------------------------
    betared = pxred * y;                          % Beta values
    residred = y - Xred * betared;
    SSEred = residred' * residred;
    %SSred = betared' * Xred' * y;                      % Full model sum of squares

    % F stat
    % (SSred - SSfull) ./ (var * df_model)
    F = (SSEred - SSE) / (var_est * df_model);         % F-statistic - compare with F-distribution with (param-1, df) degrees of freedom

    p = 1 - fcdf(F, df_model, df_error);
end


function d=jensen_shannon_divergence(XI,XJ)
  % Implementation of the Jensen-Shannon Divergence to use with pdist
  % (cf. "The Earth Movers' Distance as a Metric for Image Retrieval",
  %      Y. Rubner, C. Tomasi, L.J. Guibas, 2000)
  %
  % @author: B. Schauerte
  % @date:   2009
  % @url:    http://cvhci.anthropomatik.kit.edu/~bschauer/

  % Copyright 2009 B. Schauerte. All rights reserved.
  %
  % Redistribution and use in source and binary forms, with or without
  % modification, are permitted provided that the following conditions are
  % met:
  %
  %    1. Redistributions of source code must retain the above copyright
  %       notice, this list of conditions and the following disclaimer.
  %
  %    2. Redistributions in binary form must reproduce the above copyright
  %       notice, this list of conditions and the following disclaimer in
  %       the documentation and/or other materials provided with the
  %       distribution.
  %
  % THIS SOFTWARE IS PROVIDED BY B. SCHAUERTE ''AS IS'' AND ANY EXPRESS OR
  % IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  % WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  % DISCLAIMED. IN NO EVENT SHALL B. SCHAUERTE OR CONTRIBUTORS BE LIABLE
  % FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  % CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  % SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  % BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  % WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  % OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  % ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  %
  % The views and conclusions contained in the software and documentation
  % are those of the authors and should not be interpreted as representing
  % official policies, either expressed or implied, of B. Schauerte.

  d=jeffrey_divergence(XI,XJ);
  d=d / 2;


function popDist = totaldistance(pop,dis)
% TOTALDISTANCE
% popDist = TOTALDISTANCE(pop, dis) calculate total distance of pop(routes)
% with the distance matrix dis. Evaluate Each Population Member (Calculate
% Total Distance)

[popSize, numberofcities] = size(pop);
for i = 1:popSize
    d = dis(pop(i,end),pop(i,1)); % Closed Path
    for k = 2:numberofcities
        d = d + dis(pop(i,k-1),pop(i,k));
    end
    popDist(i) = d;
end


% This is material illustrating the methods from the book
% Financial Modelling  - Theory, Implementation and Practice with Matlab
% source
% Wiley Finance Series
% ISBN 978-0-470-74489-5
%
% Date: 02.05.2012
%
% Authors:  Joerg Kienitz
%           Daniel Wetterau
%
% Please send comments, suggestions, bugs, code etc. to
% kienitzwetterau_FinModelling@gmx.de
%
% (C) Joerg Kienitz, Daniel Wetterau
%
% Since this piece of code is distributed via the mathworks file-exchange
% it is covered by the BSD license
%
% This code is being provided solely for information and general
% illustrative purposes. The authors will not be responsible for the
% consequences of reliance upon using the code or for numbers produced
% from using the code.

% Discretization of a 2d Variance Gamma process

% Monte Carlo parameters
NBatches = 1;           % Number of batches
NSim = 10000;%100000;           % Number of paths per batch
Nt = 250;                 % Number of time steps until T!

% Asset parameters
S0 = [1.0 1.0];             % spot price of stock index
r =  0.042;              % risk free rate
d =  [0.00 0.00];              % dividend yield
T = 0.5;                % Time horizon (in years)
rho = 0.5;
lnS1 = zeros(NSim, Nt+1); % log spot prices asset 1
lnS2 = zeros(NSim, Nt+1); % log spot prices asset 2

% Model parameters (theta, sigma, nu representation)
theta = [-0.6094 -0.8301];      % parameter of VG
sigma = [0.0325 0.9406];        % parameter of VG
nu = 0.2570;                    % parameter of VG
omegaT = -1/nu * [log(1-theta(1)*nu - nu*sigma(1)^2/2) log(1-theta(2)*nu - nu*sigma(2)^2/2)];
drift = [r-d(1) r-d(2)];       % parameter of VG

%Corr = [1 .6495; .6495 1];
Corr = [1 rho; rho 1];
%Corr = [1 .9; .9 1];
%Corr = [1 -.9; -.9 1];
R = chol(Corr);

% Option parameters
value = ones(NBatches,1);   % Stores the option value per batch

% precomputed constants
deltaT = T / Nt;                            % delta for time discretization
lnS1(:,1) = log(S0(1));                         % Set the starting spot price
lnS2(:,1) = log(S0(2));

%oNt = ones(Nt,1);                       % used during simulation
oNs = ones(NSim,1);
% Start Monte Carlo here
tic;
for number = 1 : NBatches
    % Time discretization

    for m=1:Nt
        %G = nu*gamrnd(deltaT/nu, oNt);      % Gamma Subordinator
        G = nu * gamrnd(deltaT/nu,oNs);
        W = randn(NSim,2);
        W = W*R;
        lnS1(:,m+1) = lnS1(:,m) + (drift(1)-omegaT(1)) * deltaT ...
                       + theta(1) * G + sqrt(G) * sigma(1) .* W(:,1);
        lnS2(:,m+1) = lnS2(:,m) + (drift(2)-omegaT(2))* deltaT ...
                      + theta(2) * G + sqrt(G) * sigma(2) .* W(:,2);
    end

    S1 = exp(lnS1);         % Simulated prices for asset 1
    S2 = exp(lnS2);         % Simulated prices for asset 2

    if(NSim ==1)
        figure1 = figure;
        axes1 = axes('Parent',figure1);
        hold on;
        plot1 = plot(S1,'Parent',axes1,'MarkerSize',4,'Marker','o','Color',[0 0 1],'DisplayName','Asset 1');
        plot1 = plot(S2, 'Marker','.','Color',[1 0 0],'DisplayName','Asset 2');
        %plot(S1,'b');
        %plot(S2,'r');

        % Create xlabel
        xlabel('step');

        % Create ylabel
        ylabel('S(t)');

        % Create title
        title({'2d Variance Gamma Process','- zero correlation -'},...
        'FontWeight','bold','FontSize',12,'FontName','Arial');

        % Create legend
        legend1 = legend(axes1,'show');
        set(legend1,'Position',[0.8206 0.831 0.08047 0.06204]);

    end

    % Option Pricing
    value(number) = exp(-r*T)* WorstOfCall(S1,S2);
    %value(number) = exp(-r*T)* BestOfCall(S1,S2);
    %value(number) = exp(-r*T)* Spread(S1,S2);

end

mean(value)      % Output of Option price
%Elapsed_Time = toc              % Time spend on MC simulation


function kernel = MimNormalisedGaussianKernel(voxel_size_mm, filter_size_mm, minimum_grid_size_mm)
    % MimNormalisedGaussianKernel.
    %
    %
    %     The input and output images are of class PTKImage.
    %
    %
    %     Licence
    %     -------
    %     Part of the TD MIM Toolkit. https://github.com/tomdoel
    %     Author: Tom Doel, Copyright Tom Doel 2014.  www.tomdoel.com
    %     Distributed under the MIT licence. Please see website for details.
    %

    if nargin < 3
        minimum_grid_size_mm = [];
    end

    if numel(minimum_grid_size_mm) == 1
        minimum_grid_size_mm = repmat(minimum_grid_size_mm, [1, 3]);
    end

    sigma_mm = filter_size_mm;

    epsilon = 1e-3;
    sigma_voxels = sigma_mm./voxel_size_mm;
    grid_size = 2*(ceil((sigma_voxels).*sqrt(-2*log(sqrt(2*pi).*(sigma_voxels)*epsilon)))) + 1;

    if ~isempty(minimum_grid_size_mm)
        minimum_grid_size = 2*(ceil((minimum_grid_size_mm./voxel_size_mm)/2));
        grid_size = max(grid_size, minimum_grid_size);
    end

    grid_size_i = grid_size(1);
    grid_size_j = grid_size(2);
    grid_size_k = grid_size(3);

    center_i = grid_size_i/2 + 0.5;
    center_j = grid_size_j/2 + 0.5;
    center_k = grid_size_k/2 + 0.5;

    n_i = 1 : grid_size_i;
    n_j = 1 : grid_size_j;
    n_k = 1 : grid_size_k;

    sigmai = sigma_voxels(1);
    sigmaj = sigma_voxels(2);
    sigmak = sigma_voxels(3);

    keri = zeros(1, 1, grid_size_i, 'single');
    kerj = zeros(1, 1, grid_size_j, 'single');
    kerk = zeros(1, 1, grid_size_k, 'single');

    keri(1,1,:) = (1/((2*pi*sigmai.^2).^(1/2))) * exp(-((n_i - center_i).^2)/(2*sigmai.^2));
    kerj(1,1,:) = (1/((2*pi*sigmaj.^2).^(1/2))) * exp(-((n_j - center_j).^2)/(2*sigmaj.^2));
    kerk(1,1,:) = (1/((2*pi*sigmak.^2).^(1/2))) * exp(-((n_k - center_k).^2)/(2*sigmak.^2));

    % Normalise
    keri = keri./sum(keri);
    kerj = kerj./sum(kerj);
    kerk = kerk./sum(kerk);

    ker1 = repmat(shiftdim(keri, 2), [1, grid_size_j, grid_size_k]);
    ker2 = repmat(shiftdim(kerj, 1), [grid_size_i, 1, grid_size_k]);
    ker3 = repmat(kerk, [grid_size_i, grid_size_j, 1]);
    kernel = ker1.*ker2.*ker3;

    kernel = kernel/max(kernel(:));
end


function lambda = chow_eigenvalues ( alpha, beta, n )

%*****************************************************************************80
%
%% CHOW_EIGENVALUES returns the eigenvalues of the CHOW matrix.
%
%  Example:
%
%    ALPHA = 2, BETA = 3, N = 5
%
%    9.49395943
%    6.10991621
%    3.0
%    3.0
%    3.0
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    28 September 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real ALPHA, the ALPHA value.  A typical value is 1.0.
%
%    Input, real BETA, the BETA value.  A typical value is 0.0.
%
%    Input, integer N, the order of A.
%
%    Output, real LAMBDA(N,1), the eigenvalues of A.
%
  lambda = zeros ( n, 1 );

  k = n - round ( ( n + 1 ) / 2 );

  for i = 1 : k
    angle = i * pi / ( n + 2 );
    lambda(i,1) = beta + 4.0 * alpha * ( cos ( angle ) )^2;
  end

  lambda(k+1:n,1) = beta;

  return
end


% This is material illustrating the methods from the book
% Financial Modelling  - Theory, Implementation and Practice with Matlab
% source
% Wiley Finance Series
% ISBN 978-0-470-74489-5
%
% Date: 02.05.2012
%
% Authors:  Joerg Kienitz
%           Daniel Wetterau
%
% Please send comments, suggestions, bugs, code etc. to
% kienitzwetterau_FinModelling@gmx.de
%
% (C) Joerg Kienitz, Daniel Wetterau
%
% Since this piece of code is distributed via the mathworks file-exchange
% it is covered by the BSD license
%
% This code is being provided solely for information and general
% illustrative purposes. The authors will not be responsible for the
% consequences of reliance upon using the code or for numbers produced
% from using the code.

% Script chap::2::script
% Density NIG Model with Gamma Ornstein Uhlenbeck stochastic clock
%
%
%
T = 5;                                      % maturity
f0 = 100;                                  % spot value
r=0;
d=0;
ad = 600;                            % spot value
N = 1024;                            % number of grid points
x = ( (0:N-1) - N/2 ) / ad;          % range

%f = 90:.01:110;                            % range

alpha = 2;
beta = 0;                            % CEV exponent base scenario
delta = .3;
lambda = 3;
a = 1;
b = 1;

legend = 'Base';
title_plot = 'NIG-OU Density';

func = @(x)  cf_nigou(x,T,0,r,d,alpha, beta, delta, lambda,a,b);
y = fftdensity(func,ad,N);
%% Changing a
a_low = .5;
a_high = 2;

func_low = @(x) cf_nigou(x,T,0,r,d,alpha, beta, delta, lambda, a_low,b);
y_low = fftdensity(func_low,ad,N);
func_high = @(x) cf_nigou(x,T,0,r,d,alpha, beta, delta, lambda, a_high,b);
y_high = fftdensity(func_high,ad,N);
legend_low = 'Changing a low';
legend_high = 'Changing a high';

createfigure_density(x,y,y_low,y_high,title_plot,legend,legend_low,legend_high);

%% Changing b
b_low = .5;
b_high = 2;

func_low = @(x) cf_nigou(x,T,0,r,d,alpha, beta, delta, lambda, a,b_low);
y_low = fftdensity(func_low,ad,N);
func_high = @(x) cf_nigou(x,T,0,r,d,alpha, beta, delta, lambda, a,b_high);
y_high = fftdensity(func_high,ad,N);
legend_low = 'Changing b low';
legend_high = 'Changing b high';

createfigure_density(x,y,y_low,y_high,title_plot,legend,legend_low,legend_high);

%% Changing lambda
lambda_low = 1;
lambda_high = 20;

func_low = @(x) cf_nigou(x,T,0,r,d,alpha, beta, delta, lambda_low, a,b);
y_low = fftdensity(func_low,ad,N);
func_high = @(x) cf_nigou(x,T,0,r,d,alpha, beta, delta, lambda_high, a,b);
y_high = fftdensity(func_high,ad,N);
legend_low = 'Changing \lambda low';
legend_high = 'Changing \lambda high';

createfigure_density(x,y,y_low,y_high,title_plot,legend,legend_low,legend_high);


function out = cov(f, g, varargin)
%COV   Covariance of a CHEBFUN.
%   COV(F) is the same as VAR(F) if F is a scalar-valued CHEBFUN.
%   COV(F) returns the covariance of the array-valued CHEBFUN F.
%   COV(F, G) returns the covariance matrix of the columns of F and G.
%
% See also VAR, MEAN.

% Copyright 2017 by The University of Oxford and The Chebfun Developers.
% See http://www.chebfun.org/ for Chebfun information.

% Empty case:
if ( isempty(f) )
    out = NaN;
    return
end

% Error checking:
if ( (nargin == 2) && ~all(size(f) == size(g)) )
    error('CHEBFUN:CHEBFUN:cov:size',' CHEBFUN dimensions do not agree.');
end
if ( nargin == 3 )
    error('CHEBFUN:CHEBFUN:cov:nargin', ...
        'CHEBFUN/COV does not support normalization.');
end

% Deal with row CHEBFUN objects:
if ( f(1).isTransposed )
    if ( nargin == 1 )
        out = transpose(cov(transpose(f)));
    else
        out = transpose(cov(transpose(f), transpose(g)));
    end
    return
end

% Conditional on COV(f) and COV(f, g).
if ( nargin == 1 ) % COV(f)

    if ( numColumns(f) == 1 )
        % The covariance of a scalar-valued CHEBFUN is the same as the variance:
        out = var(f);
        return

    else
        % Array-valued CHEBFUN or quasimatrix.

        Y = f - mean(f);
        out = diag(mean(Y.*conj(Y)));
        % Convert Y to a cell array of scalar-valued CHEBFUN objects.
        Y = mat2cell(Y);
        % Loop over each of the columns:
        for j = 1:numel(Y)
            for k = j+1:numel(Y)
                % Compute the scaled inner product of the jth and kth columns:
                out(j,k) = mean(Y{j}.*conj(Y{k}));
                % Use symmetry:
                out(k,j) = conj(out(j,k));
            end
        end

    end

else               % COV(f, g)

    % Convert to cell arrays of scalar-valued CHEBFUN objects:
    Y = cheb2cell(f - mean(f));
    Z = cheb2cell(g - mean(g));
    % Initialise output matrix:
    out = zeros(numel(f));
    % Loop over each of the columns:
    for j = 1:numel(Y)
        for k = 1:numel(Y)
            out(j,k) = mean(Y{j}.*conj(Z{k}));
        end
    end

end

end


function az = azimuth(varargin)

    report_this_filefun(mfilename('fullpath'));

    %AZIMUTH  Calculates azimuth between points on a geoid
    %
    %  az = AZIMUTH(lat1,lon1,lat2,lon2) computes the great circle
    %  bearing between the two points on the globe.  The inputs
    %  can be matrices of equal size.  The azimuth is reported from
    %  0 to 360 degrees, clockwise from north, by convention.
    %
    %  az = AZIMUTH(lat1,lon1,lat2,lon2,geoid) computes the great circle
    %  bearing assuming that the points lie on the ellipsoid defined by
    %  the input geoid.  The geoid vector is of the form
    %  [semimajor axes, eccentricity].  If omitted, the unit sphere,
    %  geoid = [1 0], is assumed.
    %
    %  az = AZIMUTH(lat1,lon1,lat2,lon2,'units') uses the input string 'units'
    %  to define the angle units of the input and output data.  If
    %  'units' is omitted, 'degrees' is assumed.
    %
    %  az = AZIMUTH(lat1,lon1,lat2,lon2,geoid,'units') is a valid calling form.
    %
    %  az = AZIMUTH('track',...) uses the input string 'track' to define
    %  either a great circle bearing or rhumb line heading.  If 'track' = 'gc',
    %  then the great circle bearings are computed.  If 'track' = 'rh', then
    %  the rhumb line headings are computed.  If omitted, 'gc' is assumed.
    %
    %  az = AZIMUTH(pt1,pt2) uses the input form pt1 = [lat1 lon1] and
    %  pt2 = [lat2 lon2], where lat1, lon1, lat2 and lon2 are column vectors.
    %
    %  az = AZIMUTH(pt1,pt2,geoid), az = AZIMUTH(pt1,pt2,'units'),
    %  az = AZIMUTH(pt1,pt2,geoid,'units') and az = AZIMUTH('track',pt1,...)
    %  are all valid calling forms.
    %
    %  See also DISTANCE, RECKON

    %  Copyright (c)  1995 by Systems Planning and Analysis, Inc.
    %  Written by:  E. Byrns, E. Brown
    %   $Revision: 1399 $    $Date: 2006-08-11 11:19:27 +0200 (Fr, 11 Aug 2006) $

    if nargin < 1
        error('Incorrect number of arguments')
    else
        if ischar(varargin{1})
            str = varargin{1};    varargin(1) = [];
        else
            str = [];
        end
    end

    %  Test the track string and call the appropriate function

    if isempty(str)
        [az,msg] = bearing(varargin{:});
    else
        validstr = ['gc';'rh'];
        indx     = strmatch(lower(str),validstr);
        if length(indx) ~= 1
            error('Unrecognized track string')
        elseif indx == 1
            [az,msg] = bearing(varargin{:});
        elseif indx == 2
            [az,msg] = heading(varargin{:});
        end
    end

    %  Error out if necessary

    if ~isempty(msg);   error(msg);   end

    %************************************************************************
    %************************************************************************
    %************************************************************************

function [az,msg] = bearing(in1,in2,in3,in4,in5,in6)

    %BEARING:  Calculates great circle azimuth between points on a geoid
    %
    %  Purpose
    %
    %  Computes the great circle bearing between two
    %  points on a globe.  The default angle input
    %  is degrees.  The default output is in degrees.
    %  The default geoid is a sphere, but this can be
    %  redefined to an ellipsoid using the geoid input.
    %
    %  Synopsis
    %
    %       az = bearing(pt1,pt2)
    %       az = bearing(pt1,pt2,geoid)
    %       az = bearing(pt1,pt2,'units')
    %       az = bearing(pt1,pt2,geoid,'units')
    %
    %       az = bearing(lat1,lon1,lat2,lon2)
    %       az = bearing(lat1,lon1,lat2,lon2,geoid)
    %       az = bearing(lat1,lon1,lat2,lon2,'units')
    %       az = bearing(lat1,lon1,lat2,lon2,geoid,'units')
    %
    %       [az,errmsg] = bearing(....
    %            If two output arguments are supplied, then error condition
    %            messages are returned to the calling function for processing.

    %   REFERENCES:
    %   For the ellipsoid:  D. H. Maling, Coordinate Systems and
    %   Map Projections, 2nd Edition Pergamon Press, 1992, pp. 74-76.
    %   This forumula can be shown to be equivalent for a sphere to
    %   J. P. Snyder,  "Map Projections - A Working Manual,"  US Geological
    %   Survey Professional Paper 1395, US Government Printing Office,
    %   Washington, DC, 1987,  pp. 29-32.

    %  Copyright (c)  1995 by Systems Planning and Analysis, Inc.
    %  Written by:  E. Byrns, E. Brown
    %  Revision 1.0:  11/7/95
    %  Revision 1.1:  11/26/95  elliptical calcs added   EVB

    %  Initialize outputs

    if nargout ~= 0;  az = [];   msg = [];  end

    %  Test inputs

    if nargin == 2
      if size(in1,2) == 2  && size(in2,2) == 2  && ...
                ndims(in1) == 2 & ndims(in2) == 2
            lat1 = in1(:,1);	lon1 = in1(:,2);
            lat2 = in2(:,1);	lon2 = in2(:,2);
        else
            msg = 'Incorrect latitude and longitude data matrices';
            if nargout < 2;  error(msg);  end
            return
        end

        geoid = [];      units  = [];

    elseif nargin == 3
      if size(in1,2) == 2  && size(in2,2) == 2  && ...
                ndims(in1) == 2 & ndims(in2) == 2
            lat1 = in1(:,1);	lon1 = in1(:,2);
            lat2 = in2(:,1);	lon2 = in2(:,2);
        else
            msg = 'Incorrect latitude and longitude data matrices';
            if nargout < 2;  error(msg);  end
            return
        end

        if ischar(in3)
            units  = in3;               geoid = [];
        else
            units  = [];                geoid = in3;
        end

    elseif nargin == 4

        if ischar(in4)
          if size(in1,2) == 2  && size(in2,2) == 2  && ...
                    ndims(in1) == 2 & ndims(in2) == 2
                lat1 = in1(:,1);	lon1 = in1(:,2);
                lat2 = in2(:,1);	lon2 = in2(:,2);
            else
                msg = 'Incorrect latitude and longitude data matrices';
                if nargout < 2;  error(msg);  end
                return
            end

            geoid = in3;     units  = in4;

        else
            lat1 = in1;	             lon1 = in2;
            lat2 = in3;	             lon2 = in4;
            geoid = [];              units = [];
        end

    elseif nargin == 5

        lat1 = in1;	    lon1 = in2;
        lat2 = in3;	    lon2 = in4;
        if ischar(in5)
            units  = in5;             geoid = [];
        else
            units  = [];              geoid = in5;
        end

    elseif nargin == 6

        lat1 = in1;	    lon1 = in2;
        lat2 = in3;	    lon2 = in4;
        geoid = in5;    units  = in6;

    else
        msg = 'Incorrect number of arguments';
        if nargout < 2;  error(msg);  end
        return
    end

    %  Empty argument tests.  Allows users to pass in an empty argument
    %  and still not crash.

    if isempty(units);   units = 'degrees';   end
    if isempty(geoid)         %  Unlike related functions reckongc
        geoid = [1 0];     %  and distgc, the first argument of geoid
    elseif geoid(1) == 0      %  can not be zero.  Calculations blow up
        geoid(1) = 1;     %  (1/0) if geoid(1) = 0
    end

    %  Dimension tests

    if ~isequal(size(lat1),size(lon1),size(lat2),size(lon2))
        msg = 'Inconsistent dimensions for latitude and longitude';
        if nargout < 2;  error(msg);  end
        return
    end

    %  Angle unit conversion

    lat1 = angledim(lat1,units,'radians');
    lon1 = angledim(lon1,units,'radians');
    lat2 = angledim(lat2,units,'radians');
    lon2 = angledim(lon2,units,'radians');

    %  Test the geoid parameter

    [geoid,msg] = geoidtst(geoid);
    if ~isempty(msg)
        if nargout < 2;  error(msg);  end
        return
    end

    az = zeros(size(lat1));     % Preallocate memory for output
    epsilon = epsm('radians');      % Set tolerance to the pole

    % Identify those cases where a pole is a starting
    % point or a destination, and those cases where it is not

    indx1 = find(lat1 >= pi/2-epsilon); % north pole starts
    indx2 = find(lat1 <= epsilon-pi/2); % south pole starts
    indx3 = find(lat2 >= pi/2-epsilon); % north pole ends
    indx4 = find(lat2 <= epsilon-pi/2); % south pole ends

    indx=1:numel(az);           % All cases,
    indx([indx1;indx2;indx3;indx4])=[];  %   less the special ones

    % Handle the special cases.  For example, anything starting
    % at the north pole must go south (pi).  Starting point
    % has priority in degenerate cases; i.e. when going from
    % north pole to north pole, result will be pi, not zero.

    if ~isempty(indx4);  az(indx4) = pi;   end  %  Arrive going south
    if ~isempty(indx3);  az(indx3) = 0;    end  %  Arrive going north
    if ~isempty(indx2);  az(indx2) = 0;    end  %  Depart going north
    if ~isempty(indx1);  az(indx1) = pi;   end  %  Depart going south

    %  Compute the bearing for either a spherical or elliptical geoid.
    %  Note that for a sphere, ratio = 1, par1 = lat1, par2 = lat2
    %  and fact4 = 0.

    if ~isempty(indx)
        par1 = geod2par(lat1(indx),geoid,'radians');    %  Parametric latitudes
        par2 = geod2par(lat2(indx),geoid,'radians');

        ratio = minaxis(geoid) / geoid(1);  %  Semiminor/semimajor (b/a)
        ratio = ratio^2;

        fact1 = cos(lat2(indx)) .* sin(lon2(indx)-lon1(indx));
        fact2 = ratio * cos(lat1(indx)) .* sin(lat2(indx));
        fact3 = sin(lat1(indx)) .* cos(lat2(indx)) .* cos(lon2(indx)-lon1(indx));
        fact4 = (1-ratio) * sin(lat1(indx)) .* cos(lat2(indx)) .* ...
            cos(par1) ./ cos(par2);

        az(indx) = atan2(fact1,fact2-fact3+fact4);
    end

    %  Transform the bearing data to the proper range and units

    az = zero22pi(az,'radians','exact');
    az = angledim(az,'radians',units);

    %************************************************************************
    %************************************************************************
    %************************************************************************

function [course,msg] = heading(in1,in2,in3,in4,in5,in6)

    %HEADING:  Calculates rhumb-line direction between points on a geoid
    %
    %  Purpose
    %
    %  Computes the rhumb line direction between two
    %  points on a globe.  The rhumb line is a line of
    %  constant angular direction, a "course to steer".
    %  The default angle input is degrees.  The default output
    %  is in degrees. The default geoid is a sphere, but this
    %  can be redefined to an ellipsoid using the geoid input.
    %
    %  Synopsis
    %
    %       course = heading(pt1,pt2)
    %       course = heading(pt1,pt2,geoid)
    %       course = heading(pt1,pt2,'units')
    %       course = heading(pt1,pt2,geoid,'units')
    %
    %       course = heading(lat1,lon1,lat2,lon2)
    %       course = heading(lat1,lon1,lat2,lon2,geoid)
    %       course = heading(lat1,lon1,lat2,lon2,'units')
    %       course = heading(lat1,lon1,lat2,lon2,geoid,'units')
    %
    %       [course,errmsg] = heading(....
    %            If two output arguments are supplied, then error condition
    %            messages are returned to the calling function for processing.

    %  Copyright (c)  1995 by Systems Planning and Analysis, Inc.
    %  Written by:  E. Brown, E. Byrns
    %  Revision 1.0:  11/7/95
    %  Revision 1.1:  11/28/95  V5 matrix assignment.  Mercalc calls.  EVB

    %  Initialize outputs

    if nargout ~= 0;  course = [];   msg = [];  end

    %  Test inputs

    if nargin == 2
        if size(in1,2) == 2 && size(in2,2) == 2 && ...
                ndims(in1) == 2 && ndims(in2) == 2
            lat1 = in1(:,1);	lon1 = in1(:,2);
            lat2 = in2(:,1);	lon2 = in2(:,2);
        else
            msg = 'Incorrect latitude and longitude data matrices';
            if nargout < 2;  error(msg);  end
            return
        end

        geoid = [];    units  = [];

    elseif nargin == 3
        if size(in1,2) == 2 && size(in2,2) == 2 && ...
                ndims(in1) == 2 && ndims(in2) == 2
            lat1 = in1(:,1);	lon1 = in1(:,2);
            lat2 = in2(:,1);	lon2 = in2(:,2);
        else
            msg = 'Incorrect latitude and longitude data matrices';
            if nargout < 2;  error(msg);  end
            return
        end

        if ischar(in3)
            units  = in3;      geoid = [];
        else
            units  = [];       geoid = in3;
        end

    elseif nargin == 4

        if ischar(in4)
            if size(in1,2) == 2 && size(in2,2) == 2 && ...
                    ndims(in1) == 2 && ndims(in2) == 2
                lat1 = in1(:,1);	lon1 = in1(:,2);
                lat2 = in2(:,1);	lon2 = in2(:,2);
            else
                msg = 'Incorrect latitude and longitude data matrices';
                if nargout < 2;  error(msg);  end
                return
            end

            geoid = in3;    units  = in4;

        else
            lat1 = in1;	              lon1 = in2;
            lat2 = in3;	              lon2 = in4;
            geoid = [];               units = [];
        end

    elseif nargin == 5

        lat1 = in1;	    lon1 = in2;
        lat2 = in3;	    lon2 = in4;
        if ischar(in5)
            units  = in5;         geoid = [];
        else
            units  = [];          geoid = in5;
        end

    elseif nargin == 6

        lat1 = in1;	    lon1 = in2;
        lat2 = in3;	    lon2 = in4;
        geoid = in5;    units  = in6;

    else
        msg = 'Incorrect number of arguments';
        if nargout < 2;  error(msg);  end
        return
    end

    %  Empty argument tests.  Allows users to pass in an empty argument
    %  and still not crash.

    if isempty(units);   units = 'degrees';   end
    if isempty(geoid)         %  Unlike related functions reckonrh
        geoid = [1 0];     %  and distrh, the first argument of geoid
    elseif geoid(1) == 0      %  can not be zero.  Merccalc always returns
        geoid(1) = 1;     %  [x,y] = 0 if geoid(1) = 0
    end

    %  Dimension tests

    if  ~isequal(size(lat1),size(lon1),size(lat2),size(lon2))
        msg = 'Inconsistent dimensions for latitude and longitude';
        if nargout < 2;  error(msg);  end
        return
    end

    %  Angle unit conversion

    lat1 = angledim(lat1,units,'radians');
    lon1 = angledim(lon1,units,'radians');
    lat2 = angledim(lat2,units,'radians');
    lon2 = angledim(lon2,units,'radians');

    %  Test the geoid parameter

    [geoid,msg] = geoidtst(geoid);
    if ~isempty(msg)
        if nargout < 2;  error(msg);  end
        return
    end

    course=zeros(size(lat1));     % Preallocate memory for output
    epsilon=epsm('radians');      % Set tolerance to the pole

    % Identify those cases where a pole is a starting
    % point or a destination, and those cases where it is not

    indx1 = find(lat1 >= pi/2-epsilon); % north pole starts
    indx2 = find(lat1 <= epsilon-pi/2); % south pole starts
    indx3 = find(lat2 >= pi/2-epsilon); % north pole ends
    indx4 = find(lat2 <= epsilon-pi/2); % south pole ends

    indx=1:numel(course);           % All cases,
    indx([indx1;indx2;indx3;indx4])=[];  %   less the special ones

    % Handle the special cases.  For example, anything starting
    % at the north pole must go south (pi).  Starting point
    % has priority in degenerate cases; i.e. when going from
    % north pole to north pole, result will be pi, not zero.

    if ~isempty(indx4);  course(indx4) = pi;   end  %  Arrive going south
    if ~isempty(indx3);  course(indx3) = 0;    end  %  Arrive going north
    if ~isempty(indx2);  course(indx2) = 0;    end  %  Depart going north
    if ~isempty(indx1);  course(indx1) = pi;   end  %  Depart going south

    %  Now find the course for the general cases by calculating the
    %  heading angle in a Mercator coordinate system.  The function
    %  MERCCALC handles both spherical and elliptical geoids

    if ~isempty(indx)
        [x1,y1] = merccalc(lat1(indx),lon1(indx),'forward','radians',geoid);
        [x2,y2] = merccalc(lat2(indx),lon2(indx),'forward','radians',geoid);

        %  Find points greater than 180 deg apart.  Take shorter distance route
        %  Allow for some roundoff error

        epsilon = 1E-10;
        shift = find( abs((x2-x1)) > pi*geoid(1)-epsilon);
        if ~isempty(shift)
            x1(shift) = x1(shift) + sign(x2(shift))*2*pi*geoid(1);
        end

        course(indx) = atan2(x2-x1, y2-y1);
    end

    %  Transform the heading data to the proper range and units

    course = zero22pi(course,'radians','exact');
    course = angledim(course,'radians',units);


function [varargout]=tubeplot(x,y,z,varargin)

% TUBEPLOT - plots a tube r along the space curve x,y,z.
%
% tubeplot(x,y,z) plots the basic tube with radius 1
% tubeplot(x,y,z,r) plots the basic tube with variable radius r (either a vector or a value)
% tubeplot(x,y,z,r,v) plots the basic tube with coloring dependent on the values in the vector v
% tubeplot(x,y,z,r,v,s) plots the tube with s tangential subdivisions
% (default is 6)
%
% [X,Y,Z]=tubeplot(x,y,z) returns [Nx3] matrices suitable for mesh or surf
%
% Note that the tube may pinch at points where the normal and binormal
% misbehaves. It is suitable for general space curves, not ones that
% contain straight sections. Normally the tube is calculated using the
% Frenet frame, making the tube minimally twisted except at inflexion points.
%
% To deal with this problem there is an alternative frame:
% tubeplot(x,y,z,r,v,s,vec) calculates the tube by setting the normal to
% the cross product of the tangent and the vector vec. If it is chosen so
% that it is always far from the tangent vector the frame will not twist unduly
%
% Example:
%
%  t=0:(2*pi/100):(2*pi);
%  x=cos(t*2).*(2+sin(t*3)*.3);
%  y=sin(t*2).*(2+sin(t*3)*.3);
%  z=cos(t*3)*.3;
%  tubeplot(x,y,z,0.14*sin(t*5)+.29,t,10)
%
% Written by Anders Sandberg, asa@nada.kth.se, 2005

  subdivs = 6;

  N=size(x,1);
  if (N==1)
    x=x';
    y=y';
    z=z';
    N=size(x,1);
  end

  if (nargin == 3)
    r=x*0+1;
  else
    r=varargin{1};
    if (size(r,1)==1 & size(r,2)==1)
      r=r*ones(N,1);
    end
  end
  if (nargin > 5)
    subdivs=varargin{3}+1;
  end
  if (nargin > 6)
    vec=varargin{4};
    [t,n,b]=frame(x,y,z,vec);
  else
    [t,n,b]=frenet(x,y,z);
  end

  X=zeros(N,subdivs);
  Y=zeros(N,subdivs);
  Z=zeros(N,subdivs);

  theta=0:(2*pi/(subdivs-1)):(2*pi);

  for i=1:N
    X(i,:)=x(i) + r(i)*(n(i,1)*cos(theta) + b(i,1)*sin(theta));
    Y(i,:)=y(i) + r(i)*(n(i,2)*cos(theta) + b(i,2)*sin(theta));
    Z(i,:)=z(i) + r(i)*(n(i,3)*cos(theta) + b(i,3)*sin(theta));
  end

  if (nargout==0)
    if (nargin > 4)
      V=varargin{2};
      if (size(V,1)==1)
	V=V';
      end
      V=V*ones(1,subdivs);
      surf(X,Y,Z,V);
    else
      surf(X,Y,Z);
    end
  else
    varargout(1) = {X};
    varargout(2) = {Y};
    varargout(3) = {Z};
  end


function [logp, yhat, res] = tapas_cdfgaussian_obs(r, infStates, ptrans)
% Calculates the log-probability of response y under a cumulative Gaussian distribution. This
% model has no free parameters.
%
% --------------------------------------------------------------------------------------------------
% Copyright (C) 2012-2015 Christoph Mathys, TNU, UZH & ETHZ
%
% This file is part of the HGF toolbox, which is released under the terms of the GNU General Public
% Licence (GPL), version 3. You can redistribute it and/or modify it under the terms of the GPL
% (either version 3 or, at your option, any later version). For further details, see the file
% COPYING or <http://www.gnu.org/licenses/>.

% Initialize returned log-probabilities as NaNs so that NaN is
% returned for all irregualar trials
n = size(infStates,1);
logp = NaN(n,1);
yhat = NaN(n,1);
res  = NaN(n,1);

% Weed irregular trials out from inferred states and responses
mu2 = infStates(:,2,3);
mu2(r.irr) = [];
sa2 = infStates(:,2,4);
sa2(r.irr) = [];
y = r.y(:,1);
y(r.irr) = [];

% Probability mass for x2 < 0
x2lt0 = 0.5*(1 +erf((0 -mu2)./(sa2.*sqrt(2))));

% Probability of observed choice
probc = y.*(1 -x2lt0) +(1 -y).*x2lt0;

% Calculate log-probabilities for non-irregular trials
% Note: 8*atan(1) == 2*pi (this is used to guard against
% errors resulting from having used pi as a variable).
reg = ~ismember(1:n,r.irr);
logp(reg) = log(probc);
yh = 1 -x2lt0;
yhat(reg) = yh;
res(reg) = (y -yh)./sqrt(yh.*(1 -yh));

return;


function [interp_value] = grid_bilin_interp(X_approx, Y_approx, grid, ncols, nrows, cellsize, Xll, Yll, nodata)

% SYNTAX:
%   [interp_value] = grid_bilin_interp(X_approx, Y_approx, grid, ncols, nrows, cellsize, Xll, Yll, nodata);
%
% INPUT:
%   X_approx = X coordinate of the interpolation point
%   Y_approx = Y coordinate of the interpolation point
%   grid = matrix containing the grid
%   ncols = number of columns of the grid
%   nrows = number of rows of the grid
%   cellsize = ground size of a cell
%   Xll = X coordinate of the center of the lower left cell
%   Yll = Y coordinate of the center of the lower left cell
%   nodata = value used for cells not containing data
%
% OUTPUT:
%   interp_value = interpolated value
%
% DESCRIPTION:
%   Function that applies a bilinear interpolation of the four nearest nodes
%   of a georeferenced grid in correspondence of a point of given coordinates.

%--- * --. --- --. .--. ... * ---------------------------------------------
%               ___ ___ ___
%     __ _ ___ / __| _ | __|
%    / _` / _ \ (_ |  _|__ \
%    \__, \___/\___|_| |___/
%    |___/                    v 1.0RC1
%
%--------------------------------------------------------------------------
%  Copyright (C) 2021 Geomatics Research & Development srl (GReD)
%  Written by:       Mirko Reguzzoni
%  Contributors:     ...
%  A list of all the historical goGPS contributors is in CREDITS.nfo
%--------------------------------------------------------------------------
%
%   This program is free software: you can redistribute it and/or modify
%   it under the terms of the GNU General Public License as published by
%   the Free Software Foundation, either version 3 of the License, or
%   (at your option) any later version.
%
%   This program is distributed in the hope that it will be useful,
%   but WITHOUT ANY WARRANTY; without even the implied warranty of
%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%   GNU General Public License for more details.
%
%   You should have received a copy of the GNU General Public License
%   along with this program.  If not, see <http://www.gnu.org/licenses/>.
%
%--------------------------------------------------------------------------
% 01100111 01101111 01000111 01010000 01010011
%--------------------------------------------------------------------------

%preparation of the grid axes
X = (Xll : cellsize : Xll + (ncols - 1) * cellsize)';
Y = (Yll : cellsize : Yll + (nrows - 1) * cellsize)';

if (X_approx <= X(1) | X_approx >= X(end) | Y_approx <= Y(1) | Y_approx >= Y(end))
    interp_value = nodata;
    return
end

%detection of the grid node nearest to the interpolation point
[mX, posX] = min(abs(X - X_approx));
[mY, posY] = min(abs(Y - Y_approx));

%definition of the four grid nodes that sorround the interpolation point
% (i,j) image coordinates (upper-left origin)
% (X,Y) ground coordinates (bottom-left origin)
if (X(posX) > X_approx) | (mX ==0)
    j_left = posX - 1;
    j_right = posX;
    X_left = X(posX - 1);
else
    j_left = posX;
    j_right = posX + 1;
    X_left = X(posX);
end

if (Y(posY) > Y_approx) | (mY ==0)
    i_up = nrows + 1 - posY;
    i_down = i_up + 1;
    Y_down = Y(posY - 1);
else
    i_down = nrows + 1 - posY;
    i_up = i_down - 1;
    Y_down = Y(posY);
end

%if one of the interp_value values of the four sorrounding points is a nodata value, do not interpolate and return nodata value
if (grid(i_up,j_left) == nodata | grid(i_up,j_right) == nodata | grid(i_down,j_left) == nodata | grid(i_down,j_right) == nodata)
    interp_value = nodata;
    return
end

%computation of the parameters of the bilinear function
%f(X, Y) = a*X*Y + b*X + c*Y + d

A = [0 0 cellsize 1; ...
     cellsize^2 cellsize cellsize 1; ...
     0 0 0 1; ...
     0 cellsize 0 1];

B = [grid(i_up,j_left);...
     grid(i_up,j_right);...
     grid(i_down,j_left);...
     grid(i_down,j_right)];

bilin_param = A\B;

i_approx = Y_approx - Y_down;
j_approx = X_approx - X_left;

%computation of the interpolated value
interp_value = bilin_param(1) * j_approx * i_approx + bilin_param(2) * j_approx + bilin_param(3) * i_approx + bilin_param(4);
interp_value = double(interp_value);