function kSpaceLow = updownsample( kSpaceHigh, lInputImage, out_size, lAAfilter)
%
% updownsample - up-sample or down-sample an input series using fourier domain
%                input series needs to be continuous of a high degree
%
%
% input:    in_m                - input matrix for up/down sampling, in fourier domain
%
%           out_size            - desired number of pixels in the output image

%
% output:   out_m               - up/down sampled image
%
% NOTE: it is important to specify if the image is REAL or COMPLEX, since
%       if the image is REAL -> we have to use ABS() on the inverse fourier
%       transform (because of roundoff errors of the transform).
%
% NOTE: since a desired amount of pixels is needed at the output, there is
%       no attempt to use matrices which are in size of power of 2. this
%       optimization can not be used in this case
%
% NOTE: input series needs to be CONTINUOUS OF A HIGH DEGREE, since the
%       upsampling is done in the frequency domain, which samples the output
%       grid with SINE-like (harmonic) functions
%
%
%
% Theory:   the upsampling is done by zero-padding in the input domain BETWEEN the samples,
%           then at the fourier domain, taking the single spectrum (out of the repetition of spectrums)
%           i.e. low pass with Fcutoff=PI/upsample_factor, zeroing the rest of the spectrum
%           and then doing ifft to the distribution.
%           since we have a zero padding operation in time, we need to multiply by the fourier gain.
%
%              +-----------+     +-------+     +---------+     +--------+     +--------+
%   y[n,m] --> | up-sample | --> |  FFT  | --> |   LPF   | --> | * Gain | --> |  IFFT  | --> interpolated
%              | factor M  |     +-------+     | Fc=PI/M |     +--------+     +--------+
%              +-----------+                   +---------+
%
%           this operation is the same as the following one (which has less operations):
%
%              +-------+     +--------+     +--------------+     +--------+
%   y[n,m] --> |  FFT  | --> | * Gain | --> | Zero Padding | --> |  IFFT  | --> interpolated
%              +-------+     +--------+     +--------------+     +--------+
%
%           NOTE THAT, the zero-padding must be such that the D.C. ferquency remains the D.C. frequency
%           and that the zero padding is applied to both positive and negative frequencies.
%           The zero padding actually condences the frequency -> which yields a longer series in the
%           image domain, but without any additional information, thus the operation must be an interpolation.

if(nargin < 4)
    lAAfilter = true;
end

% ==============================================
% get input image size, and calculate the gain
% ==============================================
out_x_sz = out_size(1); out_y_sz = out_size(2); out_z_sz = out_size(3);
[in_x_sz,in_y_sz, in_z_sz, nCha, nTime] = size( kSpaceHigh );
gain_x = out_x_sz/in_x_sz;
gain_y = out_y_sz/in_y_sz;
gain_z = out_z_sz/in_z_sz;

% upsample or downsample as needed
% ==================================
if(lInputImage)
    % image -> kSpace
    kSpaceHigh = fftnshift(kSpaceHigh,1:3);
end

% check if up/down sampling is needed at all
if(gain_x == 1 && gain_y == 1 && gain_z == 1)
    kSpaceLow = kSpaceHigh;
    dImgLow = ifftnshift(kSpaceLow,1:3);
    return;
end

% if downsampling -> apply anti-aliasing filter
if(gain_x < 1 && gain_y < 1 && gain_z < 1 && lAAfilter)
    kSpaceHigh = kSpaceHigh .* repmat(windowND(@hamming, [size(kSpaceHigh,1), size(kSpaceHigh,2), size(kSpaceHigh,3)]),[1 1 1 size(kSpaceHigh,4) size(kSpaceHigh,5)]);
end

% build grid vectors for the up/down sampling
% ============================================
% if the input is even & output is odd-> use floor for all
% if the output is even & input is odd -> use ceil for all
% other cases - don't care
% for downsampling -> the opposite
if (~mod( in_x_sz,2 ) && (out_x_sz>in_x_sz)) || (mod( in_x_sz,2 ) && (out_x_sz<in_x_sz))
    x_output_space  = max(floor((out_x_sz-in_x_sz)/2),0) + [1:min(in_x_sz,out_x_sz)];
    x_input_space   = max(floor((in_x_sz-out_x_sz)/2),0) + [1:min(in_x_sz,out_x_sz)];
else
    x_output_space  = max(ceil((out_x_sz-in_x_sz)/2),0) + [1:min(in_x_sz,out_x_sz)];
    x_input_space   = max(ceil((in_x_sz-out_x_sz)/2),0) + [1:min(in_x_sz,out_x_sz)];
end
if (~mod( in_y_sz,2 ) && (out_y_sz>in_y_sz)) || (mod( in_y_sz,2 ) && (out_y_sz<in_y_sz))
   y_output_space  = max(floor((out_y_sz-in_y_sz)/2),0) + [1:min(in_y_sz,out_y_sz)];
   y_input_space   = max(floor((in_y_sz-out_y_sz)/2),0) + [1:min(in_y_sz,out_y_sz)];
else
   y_output_space  = max(ceil((out_y_sz-in_y_sz)/2),0) + [1:min(in_y_sz,out_y_sz)];
   y_input_space   = max(ceil((in_y_sz-out_y_sz)/2),0) + [1:min(in_y_sz,out_y_sz)];
end
if (~mod( in_z_sz,2 ) && (out_z_sz>in_z_sz)) || (mod( in_z_sz,2 ) && (out_z_sz<in_z_sz))
   z_output_space  = max(floor((out_z_sz-in_z_sz)/2),0) + [1:min(in_z_sz,out_z_sz)];
   z_input_space   = max(floor((in_z_sz-out_z_sz)/2),0) + [1:min(in_z_sz,out_z_sz)];
else
   z_output_space  = max(ceil((out_z_sz-in_z_sz)/2),0) + [1:min(in_z_sz,out_z_sz)];
   z_input_space   = max(ceil((in_z_sz-out_z_sz)/2),0) + [1:min(in_z_sz,out_z_sz)];
end

% perform the up/down sampling
kSpaceLow  = zeros( out_x_sz, out_y_sz, out_z_sz, size(kSpaceHigh,4), size(kSpaceHigh,5) );
% kSpaceHigh = fftshift(fftshift(fftshift(kSpaceHigh,1),2),3); % already zero-centered
kSpaceLow(x_output_space,y_output_space, z_output_space, :, :) = kSpaceHigh(x_input_space,y_input_space, z_input_space, :, :);

end


function w = padua_weights ( l )

%*****************************************************************************80
%
%% PADUA_WEIGHTS returns quadrature weights for Padua points.
%
%  Discussion:
%
%    The order of the weights corresponds to the ordering used
%    by the companion function padua_points().
%
%    Caliari, de Marchi and Vianello supplied a MATLAB code pdwtsMM
%    which carries out this same computation in a way that makes
%    more efficient use of MATLAB's vector and matrix capabilities.
%    This version of the computation was painfully rewritten to display
%    the individual scalar computations, so that it could be translated
%    into other languages.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    11 June 2014
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Marco Caliari, Stefano de Marchi, Marco Vianello,
%    Bivariate interpolation on the square at new nodal sets,
%    Applied Mathematics and Computation,
%    Volume 165, Number 2, 2005, pages 261-274.
%
%  Parameters:
%
%    Input, integer L, the level of the set.
%    0 <= L
%
%    Output, real W((L+1)*(L+2)/2), the quadrature weights.
%
  if ( l == 0 )
    w = 4.0;
    return
  end
%
%  Relatives of L/2:
%
  lp1h = floor ( ( l + 1 ) / 2 );
  lp2h = floor ( ( l + 2 ) / 2 );
  lp3h = floor ( ( l + 3 ) / 2 );
%
%  TE1, TE2, TO1, TO2:
%  Even and odd Chebyshev polynomials on subgrids 1 and 2.
%
  te1 = zeros(lp2h,lp2h);
  for j = 1 : lp2h
    for i = 1 : lp2h
      te1(i,j) = cos ( 2 * ( i - 1 ) * ( 2 * j - 2 ) * pi / l );
    end
  end
  te1(2:lp2h,1:lp2h) = te1(2:lp2h,1:lp2h) * sqrt ( 2.0 );

  to1 = zeros(lp2h,lp1h);
  for j = 1 : lp1h
    for i = 1 : lp2h
      to1(i,j) = cos ( 2 * ( i - 1 ) * ( 2 * j - 1 ) * pi / l );
    end
  end
  to1(2:lp2h,1:lp1h) = to1(2:lp2h,1:lp1h) * sqrt ( 2.0 );

  te2 = zeros(lp2h,lp3h);
  for j = 1 : lp3h
    for i = 1 : lp2h
      te2(i,j) = ...
        cos ( 2 * ( i - 1 ) * ( 2 * j - 2 ) * pi / ( l + 1 ) );
    end
  end
  te2(2:lp2h,1:lp3h) = te2(2:lp2h,1:lp3h) * sqrt ( 2.0 );

  to2 = zeros(lp2h,lp2h);
  for j = 1 : lp2h
    for i = 1 : lp2h
      to2(i,j) = ...
        cos ( 2 * ( i - 1 ) * ( 2 * j - 1 ) * pi / ( l + 1 ) );
    end
  end
  to2(2:lp2h,1:lp2h) = to2(2:lp2h,1:lp2h) * sqrt ( 2.0 );
%
%  MOM: Moments matrix for even * even pairs.
%
  mom = zeros(lp2h,lp2h);

  for j = 1 : lp2h
    mj = 2.0 * sqrt ( 2.0 ) / ( 1.0 - ( 2 * j - 2 ) ^2 );
    for i = 1 : lp2h + 1 - j
      mi = 2.0 * sqrt ( 2.0 ) / ( 1.0 - ( 2 * i - 2 ) ^2 );
      mom(i,j) = mi * mj;
    end
  end

  mom(1,1:lp2h) = mom(1,1:lp2h) / sqrt ( 2.0 );
  mom(1:lp2h,1) = mom(1:lp2h,1) / sqrt ( 2.0 );

  if ( mod ( l, 2 ) == 0 )
    mom(lp2h,1) = mom(lp2h,1) / 2.0;
  end
%
%  TMTOE and TMTEO: matrix products.
%
  tmtoe = zeros(lp2h,lp2h);

  for j2 = 1 : lp2h
    for i2 = 1 : lp2h+1-j2
      for j = 1 : lp2h
        for i = 1 : lp2h
          tmtoe(i,j) = tmtoe(i,j) + to2(i2,i) * mom(j2,i2) * te1(j2,j);
        end
      end
    end
  end

  tmteo = zeros(lp3h,lp1h);

  for j2 = 1 : lp2h
    for i2 = 1 : lp2h+1-j2
      for j = 1 : lp1h
        for i = 1 : lp3h
          tmteo(i,j) = tmteo(i,j) + te2(i2,i) * mom(j2,i2) * to1(j2,j);
        end
      end
    end
  end
%
%  W1 and W2: Interpolation weight matrices.
%
  w1 = 2.0 * ones(lp2h,lp2h) / ( l * ( l + 1 ) );

  w1(1:lp2h,1) = w1(1:lp2h,1) / 2.0;

  if ( mod ( l, 2 ) == 0 )
    w1(1:lp2h,lp2h) = w1(1:lp2h,lp2h) / 2.0;
    w1(lp2h,1:lp2h) = w1(lp2h,1:lp2h) / 2.0;
  end

  w2 = 2.0 * ones(lp3h,lp1h) / ( l * ( l + 1 ) );
  w2(1,1:lp1h) = w2(1,1:lp1h) / 2.0;

  if ( mod ( l, 2 ) == 1 )
    w2(lp3h,1:lp1h) = w2(lp3h,1:lp1h) / 2.0;
    w2(1:lp3h,lp1h) = w2(1:lp3h,lp1h) / 2.0;
  end
%
%  Cubature weights as matrices on the subgrids.
%
  for j = 1 : lp2h
    for i = 1 : lp2h
      w1(i,j) = w1(i,j) * tmtoe(i,j);
    end
  end

  for j = 1 : lp1h
    for i = 1 : lp3h
      w2(i,j) = w2(i,j) * tmteo(i,j);
    end
  end
%
%  Pack weight matrices W1 and W2 into the vector W.
%
  n = ( ( l + 1 ) * ( l + 2 ) ) / 2;
  w = zeros(n,1);

  if ( mod ( l, 2 ) == 0 )

    for i = 1 : lp2h
      for j = 1 : lp2h
        w(i+(2*j-2)*lp2h) = w1(i,j);
      end
    end

    for i = 1 : lp3h
      for j = 1 : lp1h
        w(i+(2*j-1)*lp2h) = w2(i,j);
      end
    end

  else

    for j = 1 : lp1h
      for i = 1 : lp2h
        w(i+(j-1)*(l+2)) = w1(i,j);
      end
    end

    for j = 1 : lp1h
      for i = 1 : lp3h
        w(i+lp2h+(j-1)*(l+2)) = w2(i,j);
      end
    end

  end

  return
end


%% OPTI Toolbox Global Nonlinear Programming Examples
%
% This file contains a number of Global NLP problems and demonstrates how
% to solve them using the OPTI Toolbox. You should read and complete
% BasicUsage.m & NonlinearProgramming.m BEFORE running the below examples.
%
%   Copyright (C) 2014 Jonathan Currie (IPL)

% There is also a page on the Wiki which supplements this example:
web('https://www.inverseproblem.co.nz/OPTI/index.php/Probs/GNLP');

%% Determing which Solver to Use
% OPTI Toolbox comes with a number of NLP solvers, thus to determine which
% ones are available on your system you can type:
clc
optiSolver('NLP')

% Note the columns DR and GL. A cross in DR indicates the solver requires
% 1st (and perhaps 2nd) derivatives, while a cross in GL indicates the
% solver can solve Global Optimization problems. For noisy problems unless
% you have exact derivatives, avoid solvers with a cross in DR.

%% Typical Global Optimization Problems
% Global optimization problems result from any of the following circumstances:
%
%       - Objectives containing noise / a stochastic element
%       - Non-convex functions (functions which are not a bowl / hill in 2D)
%       - Objectives that include periodic functions (sin, cos)
%       - Parameter estimation of ODEs solved with adaptive step integrators
%       - Any problem that contains multiple local minima.
%
% An extreme example from Wolfram is shown below:
clc
%Objective
fun = @(x) norm([x(1) - sin(2*x(1) + 3*x(2)) - cos(3*x(1) - 5*x(2));
          x(2) - sin(x(1) - 2*x(2)) + cos(x(1) + 3*x(2))]);
lb = [-4;-4]; ub = [4;4];
x0 = [-4;-4];

%Plot
n = 1e2;
x = linspace(-4,4,n); y = linspace(-4,4,n); Z = zeros(n,n);
for i = 1:n
    for j = 1:n
        Z(j,i) = fun([x(i),y(j)]);
    end
end
surfc(x,y,Z)
colormap summer; shading interp; lighting phong; view(-38,58);
xlabel('x1'); ylabel('x2'); zlabel('obj'); title('Wolfram Global Optimization Problem');

%% Example 1 - Basic Setup
% The main difference when solving a Global NLP is that OPTI treats Global
% and Local NLP problems identically, and therefore you will have to specify
% a Global solver. For this example we will build 4 OPTI objects with 4
% different solvers:
clc
%Build OPTI Problem
prob = optiprob('fun',fun,'bounds',lb,ub);
%Choose Global Solver
opts1 = optiset('solver','nomad');
opts2 = optiset('solver','pswarm');
opts3 = optiset('solver','nlopt','solverOpts',nloptset('algorithm','GN_DIRECT'));
opts4 = optiset('solver','ipopt','warnings','off');

%Pass to OPTI Constructor for Error Checking + Setup
Opt1 = opti(prob,opts1);
Opt2 = opti(prob,opts2);
Opt3 = opti(prob,opts3);
Opt4 = opti(prob,opts4);

% Call solve to solve the problem. Check the plot for a comparison of the
% solution points. Note NOMAD and NLOPT are deterministic with the current
% settings, PSWARM includes random elements, and IPOPT is for comparison of
% a local solution.

[x1,fval1] = solve(Opt1,x0);
[x2,fval2] = solve(Opt2,x0);
[x3,fval3] = solve(Opt3,x0);
[x4,fval4] = solve(Opt4,x0);

view(0,90); hold on;
plot3(x0(1),x0(2),10,'kx','markersize',10);
plot3(x1(1),x1(2),10,'ro'); text(x1(1)+0.1,x1(2)+0.1,10,sprintf('NOMAD: %f',fval1));
plot3(x2(1),x2(2),10,'ro'); text(x2(1)+0.1,x2(2)-0.1,10,sprintf('PSWARM: %f',fval2));
plot3(x3(1),x3(2),10,'ro'); text(x3(1)+0.1,x3(2)+0.2,10,sprintf('NLOPT: %f',fval3));
plot3(x4(1),x4(2),10,'ro'); text(x4(1)+0.1,x4(2)+0.1,10,sprintf('IPOPT: %f',fval4));
hold off;

%% Problem 2 - Quartic
% Includes Linear and Nonlinear Constraints
clc
%Problem
fun = @(x) x(1)^4 - 14*x(1)^2 + 24*x(1) - x(2)^2;

%Linear Constraints
A = [-1 1]; b = 8;
%Nonlinear Constraints
nlcon = @(x) (-x(1)^2) - 2*x(1) + x(2);
nlrhs = -2;
nle = -1;
%Bounds + Starting Guess
lb = [-8;0];
ub = [10;10];
x0 = [0;0];

% Solving a constrained global optimization problem. Note linear
% constraints will be converted to nonlinear ones for this solver
opts = optiset('solver','nomad','solverOpts',nomadset('direction_type','lt 2n'));
Opt = opti('fun',fun,'ineq',A,b,'nlmix',nlcon,nlrhs,nle,'bounds',lb,ub,'options',opts)

% This may take a few seconds...
[x,fval,exitflag,info] = solve(Opt,x0)

%% Example 3 - Solving with PSwarm
% Note x0 is on the local minima side of the saddle
clc
%Problem
fun = @(x) -2*x(1)*x(2);

%Constraints
lb = [-0.5;-0.5];
ub = [1;1];
x0 = [-0.3;-0.3];

%Plot
n = 1e2;
x = linspace(-0.5,1,n); y = linspace(-0.5,1,n); Z = zeros(n,n);
for i = 1:n
    for j = 1:n
        Z(j,i) = fun([x(i),y(j)]);
    end
end
surfc(x,y,Z); hold on; plot3(x0(1),x0(2),fun(x0),'r.','markersize',20); hold off;
colormap winter; shading flat; lighting gouraud; view(18,28);
xlabel('x1'); ylabel('x2'); zlabel('obj'); title('Saddle Point Optimization Problem');

% PSwarm solves bounded and linearly constrained global problems
Opt = opti('fun',fun,'bounds',lb,ub,'options',optiset('solver','pswarm'))

[x,fval,exitflag,info] = solve(Opt,x0)
plot(Opt,3)

%% Example 4 - White Box Quartic
% The following problem is the same as problem 2, however this time we are
% going to solve it using a white box solver (SCIP). The SCIP interface
% will parse the following functions into an algebraic description,
% allowing SCIP to find a global solution to this problem.
clc
%Problem
fun = @(x) x(1)^4 - 14*x(1)^2 + 24*x(1) - x(2)^2;

%Linear Constraints
A = [-1 1]; b = 8;
%Nonlinear Constraints
nlcon = @(x) (-x(1)^2) - 2*x(1) + x(2);
nlrhs = -2;
nle = -1;
%Bounds + Starting Guess
lb = [-8;0];
ub = [10;10];
x0 = [0;0];

% SCIP solves a subset of nonlinear and mixed integer problems, provided
% the problem is deterministics and constains a subset of allowable functions.
Opt = opti('fun',fun,'ineq',A,b,'nlmix',nlcon,nlrhs,nle,'bounds',lb,ub,...
           'options',optiset('solver','scip'))

[x,fval,exitflag,info] = solve(Opt,x0)
plot(Opt)

%% Example 5 - OPTI's Multi-Start Solver
% For simple, low dimensional problems, OPTI's mulit-start is a naive
% algorithm for searching the problem space for a global solution. See the
% following page for more examples:

web('https://www.inverseproblem.co.nz/OPTI/index.php/Advanced/MultiSolve');

clc
Opt = opti(Opt,'solver','ipopt');
[x,fval,exitflag,info] = multisolve(Opt,x0)
multiplot(Opt)

%% Summary
% While Global Optimization solvers may take longer, many real engineering
% problems result in noisy or non-convex objectives and local solvers will
% often struggle to return a result, or fall into the closest local
% optima. OPTI provides a range of competitive blackbox global optimization
% solvers which can return much better results, as well as a white box
% solver for academic users which guarantees a global solution.


classdef SimpAllInterpolationImplicit2D < SimpAllInterpolationImplicit

   methods  (Access = public)

        function obj = SimpAllInterpolationImplicit2D(cParams)
            obj.init(cParams);
            obj.computeNstre();
            obj.computeSymbolicInterpolationFunctions();
            obj.dmu0 = obj.computeDmu0();
            obj.dmu1 = obj.computeDmu1();
            obj.dk0  = obj.computeDKappa0();
            obj.dk1  = obj.computeDKappa1();
        end

   end

    methods  (Access = protected)

        function [pMu,pKappa] = computePolarizationTensorAsMuKappa(eMatrix,eInclusion,nuMatrix,nuInclusion)
            coef = obj.compute2Dcoefficients(eMatrix,eInclusion,nuMatrix,nuInclusion);
            [p1,p2] = obj.computeP1P2(coef);
            [pMu,pKappa] = obj.computePkappaPmu(p1, p2);
        end

        function dmu0 = computeDmu0(obj)
            E1  = obj.matProp.E1;
            E0  = obj.matProp.E0;
            nu1 = obj.matProp.nu1;
            nu0 = obj.matProp.nu0;
            mu0 = obj.matProp.mu0;
            [pMu0,~] = obj.computePolarizationTensorAsMuKappa(E0,E1,nu0,nu1);
            dmu0     = -mu0*pMu0;
        end

        function dmu1 = computeDmu1(obj)
            E1  = obj.matProp.E1;
            E0  = obj.matProp.E0;
            nu1 = obj.matProp.nu1;
            nu0 = obj.matProp.nu0;
            mu1 = obj.matProp.mu1;
            [pMu1,~] = obj.computePolarizationTensorAsMuKappa(E1,E0,nu1,nu0);
            dmu1     = mu1*pMu1;
        end

        function dkappa0 = computeDKappa0(obj)
            E1     = obj.matProp.E1;
            E0     = obj.matProp.E0;
            nu1    = obj.matProp.nu1;
            nu0    = obj.matProp.nu0;
            kappa0 = obj.matProp.kappa0;
            [~,pKappa0] = obj.computePolarizationTensorAsMuKappa(E0,E1,nu0,nu1);
            dkappa0     = -kappa0*pKappa0;
        end

        function dkappa1 = computeDKappa1(obj)
            E1     = obj.matProp.E1;
            E0     = obj.matProp.E0;
            nu1    = obj.matProp.nu1;
            nu0    = obj.matProp.nu0;
            kappa1 = obj.matProp.kappa1;
            [~,pKappa1] = obj.computePolarizationTensorAsMuKappa(E1,E0,nu1,nu0);
            dkappa1     = kappa1*pKappa1;
        end

    end

    methods  (Access = protected, Static)

        function coef = compute2Dcoefficients(eMatrix,eInclusion,nuMatrix,nuInclusion)
            coef.a    = (1 + nuMatrix)/(1 - nuMatrix);
            coef.b    = (3 - nuMatrix)/(1 + nuMatrix);
            coef.gam  = eInclusion/eMatrix;
            coef.tau1 = (1 + nuInclusion)/(1 + nuMatrix);
            coef.tau2 = (1 - nuInclusion)/(1 - nuMatrix);
            coef.tau3 = (nuInclusion*(3*nuMatrix - 4) + 1)/(nuMatrix*(3*nuMatrix - 4) + 1);
        end

        function [p1,p2] = computeP(s)
            a    = s.a;
            b    = s.b;
            gam  = s.gam;
            tau1 = s.tau1;
            tau2 = s.tau2;
            tau3 = s.tau3;
            p1   = 1/(b*gam+tau1)*(1+b)*(tau1-gam);
            p2   = 0.5*(a-b)/(b*gam+tau1)*(gam*(gam-2*tau3)+tau1*tau2)/(a*gam+tau2);
        end

        function [pMu,pKappa] = computePKappaMu(p1, p2)
            pMu    = p1;
            pKappa = 2*p2 + p1;
        end

    end

end


function [maxCI minCI] = calculateConfidenceInterval(tau, sPeriod, rCount,alpha,stabDev)
%This function calculates max and min confidence intervals for the XDEV
%calculation. The method used is found in the NIST Handbook of Frequency
%Stability Analysis page 37 section 5.3.1. tau is the array of tau values
%used in the stability calculation. Sample Period is used to calculate the
%number of values used in a particular tau calculation. rCount is the
%number of total readings at the sample period. alpha is an array of values
%for determine power law noise type. stabDev is the array of XDEV
%calculations.

tCount = length(tau); %get total number of calculations
maxCI = zeros(1,tCount); %initiate arrays
minCI = zeros(1,tCount);

for i = 1:tCount %for number of calculations
    avgCount = tau(i) / sPeriod; %gets count for averaging
    vCount = rCount / avgCount; %get number of loop iterations needed
    vCount = floor(vCount); %convert loopCount to integer in case it is a non int

    %perform confidence interval calculation based on noise type
    if alpha(i) >= 1.5 %dominant noise type is white PM
        temp = .99*(stabDev(i)/sqrt(vCount));
    elseif alpha(i) < 1.5 && alpha(i) >= .5 %dominant noise type is flicker PM
        temp = .99*(stabDev(i)/sqrt(vCount));
    elseif alpha(i) < .5 && alpha(i) >= -.5 %dominant noise type is white FM
        temp = .87*(stabDev(i)/sqrt(vCount));
    elseif alpha(i) < -.5 && alpha(i) >= -1.5 %dominant nosie type is flicker FM
        temp = .77*(stabDev(i)/sqrt(vCount));
    else %dominant noise type is random walk FM
        temp = .75*(stabDev(i)/sqrt(vCount));
    end

    %set min and max confidence limits
    maxCI(i) = stabDev(i) + temp;
    minCI(i) = stabDev(i) - temp;

end


function wishart_test06 ( )

%*****************************************************************************80
%
%% WISHART_TEST06 compares the Wishart and Bartlett sample matrices.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 July 2013
%
%  Author:
%
%    John Burkardt
%

%
%  Access the PDFLIB and RNGLIB libraries.
%
  addpath ( '../pdflib' );
  addpath ( '../rnglib' );
%
%  Initialize the RNGLIB library.
%  Normally, we would do this just once, here at the beginning.
%  In this example, however, we really want to do it just before
%  we call each of the sampling routines, so that they both access
%  the same set of random numbers...
%
  initialize ( );

  fprintf ( 1, '\n' );
  fprintf ( 1, 'WISHART_TEST06:\n' );
  fprintf ( 1, '  Verify that, if using the same set of random numbers,\n' );
  fprintf ( 1, '    W = T'' * T,\n' );
  fprintf ( 1, '  where\n' );
  fprintf ( 1, '    W = wishart_sample ( n, df, sigma );\n' );
  fprintf ( 1, '    T = bartlett_sample ( n, df, sigma );\n' );
%
%  Set the parameters.
%
  n = 3;
  df = 5;
  r = [ 5.0, 1.0, 3.0; ...
        0.0, 4.0, 2.0; ...
        0.0, 0.0, 6.0 ];
  sigma = r' * r;
  r8mat_print ( n, n, sigma, '  Covariance SIGMA:' );
%
%  Initialize the random number package and compute W.
%
  initialize ( );
  w = wishart_sample ( n, df, sigma );
%
%  Initialize the random number package again, and compute T.
%
  initialize ( );
  t = bartlett_sample ( n, df, sigma );
%
%  Compute T' * T and compare it to W.
%
  tt = t' * t;

  diff = r8mat_norm_fro_affine ( n, n, w, tt );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Frobenius norm of error is %g\n', diff );
%
%  Release the PDFLIB and RNGLIB libraries.
%
  rmpath ( '../pdflib' );
  rmpath ( '../rnglib' );

  return
end


function D = hmm_kl (hmm_p,hmm_q)
% Computes Kullback-Leibler divergence between two Hidden Markov Model
% distributions, through an approximation (an upper bound) as proposed in
% M. Do (2003). IEEE Signal Processing Letters 10
%
% Author: Diego Vidaurre, OHBA, University of Oxford (2018)

K = length(hmm_p.Pi);
if K~=length(hmm_q.Pi)
    error(['The two HMMs must have the same number of states, ' ...
        'and their order must correspond'])
end
if (hmm_p.train.order ~= hmm_q.train.order) || ...
        (~strcmpi(hmm_p.train.covtype,hmm_q.train.covtype)) || ...
        (length(hmm_p.train.embeddedlags) ~= length(hmm_q.train.embeddedlags)) || ...
        (any(hmm_p.train.embeddedlags ~= hmm_q.train.embeddedlags)) || ...
        (hmm_p.train.zeromean ~= hmm_q.train.zeromean)
   error('The state configuration of the two HMMs must be identical')
end
hmm = hmm_p; setstateoptions;
if isfield(hmm_p.state(1),'W')
    ndim = size(hmm_p.state(1).W.Mu_W,2);
else
    ndim = size(hmm_p.state(1).Omega.Gam_rate,2);
end
S = hmm.train.S==1;
regressed = sum(S,1)>0;

D = 0;
if hmm_p.train.id_mixture
   hmm_p.P = 1/K*ones(K); hmm_q.P = 1/K*ones(K);
end
nu = compute_nu (hmm_p.Pi,hmm_p.P); % weight vector

% Non-state specific stuff
switch train.covtype
    case {'uniquediag','shareddiag'}
        for n = 1:ndim
            if ~regressed(n), continue; end
            D = D + gamma_kl(hmm_p.Omega.Gam_shape,hmm_q.Omega.Gam_shape, ...
                hmm_p.Omega.Gam_rate(n),hmm_q.Omega.Gam_rate(n));
        end
    case {'uniquefull','sharedfull'}
        D = D + wishart_kl(hmm_p.Omega.Gam_rate(regressed,regressed),...
            hmm_q.Omega.Gam_rate(regressed,regressed), ...
            hmm_p.Omega.Gam_shape,hmm_q.Omega.Gam_shape);
    case 'pca'
        D = D + gamma_kl(hmm_p.Omega.Gam_shape,hmm_q.Omega.Gam_shape, ...
                hmm_p.Omega.Gam_rate,hmm_q.Omega.Gam_rate);
end

% State specific stuff
for k = 1:K

    % Trans probabilities
    kk = hmm.train.Pstructure(k,:);
    D = D + nu(k) * dirichlet_kl(hmm_p.Dir2d_alpha(k,kk),hmm_q.prior.Dir2d_alpha(k,kk));

    % State distribution
    hs = hmm_p.state(k);
    hs0 = hmm_q.state(k);

    if ~isempty(hs.W.Mu_W)
        if train.uniqueAR || ndim==1
            if train.uniqueAR || ndim==1
                D = D + nu(k) * gauss_kl(hs.W.Mu_W, hs0.W.Mu_W, hs.W.S_W, hs0.W.S_W);
            else
                D = D + nu(k) * gauss_kl(hs.W.Mu_W, hs0.W.Mu_W, ...
                    permute(hs.W.S_W,[2 3 1]), permute(hs0.W.S_W,[2 3 1]));
            end
        elseif strcmp(train.covtype,'diag') || ...
                strcmp(train.covtype,'uniquediag') || strcmp(train.covtype,'shareddiag') || ...
                strcmp(train.covtype,'pca')
            for n = 1:ndim
                D = D + nu(k) * gauss_kl(hs.W.Mu_W(Sind(:,n),n),hs0.W.Mu_W(Sind(:,n),n), ...
                    permute(hs.W.S_W(n,Sind(:,n),Sind(:,n)),[2 3 1]),...
                    permute(hs0.W.S_W(n,Sind(:,n),Sind(:,n)),[2 3 1]));
            end
        else % full or sharedfull
            mu_w = hs.W.Mu_W';
            mu_w = mu_w(:);
            mu_w0 = hs0.W.Mu_W';
            mu_w0 = mu_w0(:);
            D = D + nu(k) * gauss_kl(mu_w,mu_w0, hs.W.S_W, hs0.W.S_W);
        end
    end

    switch train.covtype
        case 'diag'
            for n=1:ndim
                if ~regressed(n), continue; end
                D = D + nu(k) * gamma_kl(hs.Omega.Gam_shape,hs0.Omega.Gam_shape, ...
                    hs.Omega.Gam_rate(n),hs0.Omega.Gam_rate(n));
            end
        case 'full'
            try
                D = D + nu(k) * wishart_kl(hs.Omega.Gam_rate(regressed,regressed),...
                    hs0.Omega.Gam_rate(regressed,regressed), ...
                    hs.Omega.Gam_shape,hs0.Omega.Gam_shape);
            catch
                error(['Error computing kullback-leibler divergence of the cov matrix - ' ...
                    'Something strange with the data?'])
            end
    end

    if ~isempty(orders) && ~train.uniqueAR && ndim>1
        for n1=1:ndim
            for n2=1:ndim
                if (train.symmetricprior && n2<n1) || S(n1,n2)==0, continue; end
                D = D + nu(k) * gamma_kl(hs.sigma.Gam_shape(n1,n2),hs0.sigma.Gam_shape(n1,n2), ...
                    hs.sigma.Gam_rate(n1,n2),hs0.sigma.Gam_rate(n1,n2));
            end
        end
    end
    if ~isempty(orders)
        for i=1:length(orders)
            D = D + nu(k) * gamma_kl(hs.alpha.Gam_shape,hs0.alpha.Gam_shape, ...
                hs.alpha.Gam_rate(i),hs0.alpha.Gam_rate(i));
        end
    end
end

end

function nu = compute_nu (Pi,P)
eps = 1e-6;
nu = Pi * P;
while true
    nu0 = nu;
    nu = nu * P;
    if mean(nu(:)-nu0(:))<eps, break; end
end
end


% Information-Flow Matte Refinement
% This function implements the matte refinement approach described in
% Yagiz Aksoy, Tunc Ozan Aydin, Marc Pollefeys, "Designing Effective
% Inter-Pixel Information Flow for Natural Image Matting", CVPR, 2017.
% 'alphaHat' and 'confidences' parameters are typically obtained by a
% sampling-based natural matting algorithm. 'confidences' is filled by
% ones if not provided. Optional input parameter 'params' can be
% customized by editing the default values in the struct returned
% by 'getMattingParams('IFM').
% - **_K parameters represent the number of nonlocal neighbors found
%   for color mixture,  and intra-U flows, while **_xyw define the effect of
%   spatial proximity.
% - **_mult define the weight of each information flow.
% - loc_*** define the parameters for the matting Laplacian.
% - refinement_mult determines how much trust is given to the initial
%   alpha estimation

function alpha = informationFlowMatteRefinement(image, trimap, alphaHat, confidences, params, suppressMessages)
    abmtSetup
    tic;
    if ~exist('confidences', 'var') || isempty(confidences)
        confidences = ones(size(alphaHat(:,:,1)));
    end
    if ~exist('params', 'var') || isempty(params)
        params = getMattingParams('IFM');
    end
    if ~exist('suppressMessages', 'var') || isempty(suppressMessages)
        suppressMessages = false;
    end
    if(~suppressMessages) display('Matte refinement via Information-Flow Matting...'); end

    image = im2double(image);
    trimap = im2double(trimap(:,:,1));
    alphaHat = im2double(alphaHat(:,:,1));

    % Compute L_IFM
    unk = trimap < 0.8 & trimap > 0.2;
    dilUnk = imdilate(unk, ones(3, 3));
    if(~suppressMessages) display('     Computing color mixture flow...'); end
    Lap = affinityMatrixToLaplacian(colorMixtureAffinities(image, params.cm_K, dilUnk, [], params.cm_xyw));
    Lap = params.cm_mult * (Lap' * Lap);
    if(~suppressMessages) display('     Computing matting Laplacian...'); end
    Lap = Lap + params.loc_mult * affinityMatrixToLaplacian(mattingAffinity(image, dilUnk, params.loc_win, params.loc_eps));
    if(~suppressMessages) display('     Computing intra-U flow...'); end
    Lap = Lap + params.iu_mult * affinityMatrixToLaplacian(colorSimilarityAffinities(image, params.iu_K, unk, unk, params.iu_xyw));

    if(~suppressMessages) display('     Solving for alphas...'); end
    alpha = solveForAlphas(Lap, trimap, params.lambda, params.usePCGtoSolve, alphaHat, confidences, params.refinement_mult);

    alpha = reshape(alpha, [size(image, 1), size(image, 2)]);

    dur = toc;
    if(~suppressMessages) display(['Done. It took ' num2str(dur) ' seconds.']); end
end


classdef UF5 < PROBLEM
% <multi> <real> <large/none>
% Unconstrained benchmark MOP

%------------------------------- Reference --------------------------------
% Q. Zhang, A. Zhou, S. Zhao, P. N. Suganthan, W. Liu, and S. Tiwari,
% Multiobjective optimization test instances for the CEC 2009 special
% session and competition, School of CS & EE, University of Essex, Working
% Report CES-487, 2009.
%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    methods
        %% Default settings of the problem
        function Setting(obj)
            obj.M = 2;
            if isempty(obj.D); obj.D = 30; end
            obj.lower    = [0,zeros(1,obj.D-1)-1];
            obj.upper    = ones(1,obj.D);
            obj.encoding = ones(1,obj.D);
        end
        %% Calculate objective values
        function PopObj = CalObj(obj,X)
            J1 = 3 : 2 : obj.D;
            J2 = 2 : 2 : obj.D;
            Y  = X - sin(6*pi*repmat(X(:,1),1,obj.D)+repmat(1:obj.D,size(X,1),1)*pi/obj.D);
            hY = 2*Y.^2 - cos(4*pi*Y) + 1;
            PopObj(:,1) = X(:,1)   + (1/20+0.1)*abs(sin(20*pi*X(:,1)))+2*mean(hY(:,J1),2);
            PopObj(:,2) = 1-X(:,1) + (1/20+0.1)*abs(sin(20*pi*X(:,1)))+2*mean(hY(:,J2),2);
        end
        %% Generate points on the Pareto front
        function R = GetOptimum(obj,N)
            R(:,1) = (0:1:20)'/20;
            R(:,2) = 1 - R(:,1);
        end
    end
end


% Copyright (C) 1993-2017, by Peter I. Corke
%
% This file is part of The Robotics Toolbox for MATLAB (RTB).
%
% RTB is free software: you can redistribute it and/or modify
% it under the terms of the GNU Lesser General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% RTB 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 Lesser General Public License for more details.
%
% You should have received a copy of the GNU Leser General Public License
% along with RTB.  If not, see <http://www.gnu.org/licenses/>.
%
% http://www.petercorke.com

%%begin

% A serial link manipulator comprises a series of links.  Each link is described
% by four Denavit-Hartenberg parameters.
%
% Let's define a simple 2 link manipulator.  The first link is

L1 = Link('d', 0, 'a', 1, 'alpha', pi/2)

% The Link object we created has a number of properties
L1.a
L1.d

% and we determine that it is a revolute joint
L1.isrevolute

% For a given joint angle, say q=0.2 rad, we can determine the link transform
% matrix
L1.A(0.2)

% The second link is
L2 = Link('d', 0, 'a', 1, 'alpha', 0)

% Now we need to join these into a serial-link robot manipulator

bot = SerialLink([L1 L2], 'name', 'my robot')
% The displayed robot object shows a lot of details.  It also has a number of
% properties such as the number of joints
bot.n

% Given the joint angles q1 = 0.1 and q2 = 0.2 we can determine the pose of the
% robot's end-effector

bot.fkine([0.1 0.2])
% which is referred to as the forward kinematics of the robot.  This, and the
% inverse kinematics are covered in separate demos.

% Finally we can draw a stick figure of our robot

bot.plot([0.1 0.2])


function [H2,Z2,sLen2,iter]=FGD_H(V,W,H,Z,Lpos,Lneg,tol)

% Fast gradient descent (FGD) with Newton method for NPAF
% Copyright@Naiyang Guan and Dacheng Tao
% Arguments:
%     sLen: step length

% Calculate scaled negative gradient at H
n=size(H,2);
G=H.*(W'*(V./Z)+H*Lneg)./(sum(W)'*ones(1,n)+H*Lpos)-H;
L=Lpos-Lneg;
Z1=W*G;
a=sum(sum(L.*(G'*G)));
d=sum(sum(L.*(G'*H)))+sum(sum(Z1));
C=Z./Z1;

% Newton method
sLen=1;
for iter=1:20,
    [sum1,sum2]=SumC1(V,C,sLen);
    sLen1=sLen-(a*sLen-sum1+d)/(a+sum2);
    if abs(sLen1-sLen)<tol,
        break;
    else
        sLen=sLen1;
    end
end

% Step length to boundary of positive orthant
if min(G(:))>=0
    sLen3=Inf;
else
    C=H./G;
    sLen3=min(-C(C<0));
end

% Best step length
sLen2=max(min(sLen1,0.99*sLen3),1);
H2=H+sLen2*G;
Z2=Z+sLen2*Z1;

return;


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% shanChen.m: Multi-component fluid, using a LB method,
%   based on the Shan-Chen model
% [X.Shan and H.Chen, http://dx.doi.org/10.1103/PhysRevE.47.1815].
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Lattice Boltzmann sample, written in Matlab
% Copyright (C) 2008 Orestis Malaspinas, Andrea Parmigiani, Jonas Latt
% Address: EPFL-STI-LIN Station 9
% E-mail: orestis.malaspinas@epfl.ch
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 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 2
% 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, write to the Free
% Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
% Boston, MA  02110-1301, USA.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

clear
clf

% GENERAL FLOW CONSTANTS

ly           = 201;
lx           = 201;

G = -1.2;  % Amplitude of the molecular interaction force

omega1 = 1.;  % Relaxation parameter for fluid 1
omega2 = 1.;  % Relaxation parameter for fluid 2

maxT   = 80000;    % total number of iterations
tPlot  = 40;       % iterations between successive graphical outputs

% D2Q9 LATTICE CONSTANTS
tNS   = [4/9, 1/9,1/9,1/9,1/9, 1/36,1/36,1/36,1/36];
cxNS  = [  0,   1,  0, -1,  0,    1,  -1,  -1,   1];
cyNS  = [  0,   0,  1,  0, -1,    1,   1,  -1,  -1];
oppNS = [  1,   4,  5,  2,  3,    8,   9,   6,   7];

[y,x] = meshgrid(1:ly,1:lx);

drho = 0.001;
delta_rho = -drho*(1-2.0*rand(lx));

% INITIAL CONDITION FOR BOTH DISTRIBUTION FUNCTIONS: (T=0) ==> TIn(i) = t(i)
for i=1:9
    fIn(i,1:lx,1:ly) = tNS(i).*(1.0 + delta_rho);
    gIn(i,1:lx,1:ly) = tNS(i).*(1.0 - delta_rho);
end

rho1  = reshape(sum(fIn),lx,ly);
imagesc(rho1');
colorbar
title('Fluid 1 density');
axis equal off; drawnow

% MAIN LOOP (TIME CYCLES)
Gomega1 = G/omega1;
Gomega2 = G/omega2;
for cycle = 1:maxT
    % MACROSCOPIC VARIABLES
    rho1 = sum(fIn);
    rho2 = sum(gIn);
    jx1  = reshape ( (cxNS * reshape(fIn,9,lx*ly)), 1,lx,ly);
    jy1  = reshape ( (cyNS * reshape(fIn,9,lx*ly)), 1,lx,ly);
    jx2  = reshape ( (cxNS * reshape(gIn,9,lx*ly)), 1,lx,ly);
    jy2  = reshape ( (cyNS * reshape(gIn,9,lx*ly)), 1,lx,ly);

    rhoTot_OMEGA = rho1*omega1 + rho2*omega2;
    uTotX = (jx1*omega1+jx2*omega2) ./ rhoTot_OMEGA;
    uTotY = (jy1*omega1+jy2*omega2) ./ rhoTot_OMEGA;

    rhoContrib1x = 0.0;
    rhoContrib2x = 0.0;

    rhoContrib1y = 0.0;
    rhoContrib2y = 0.0;
    for i=2:9
        rhoContrib1x = rhoContrib1x + circshift(rho1*tNS(i), [0,cxNS(i),cyNS(i)])*cxNS(i);
        rhoContrib1y = rhoContrib1y + circshift(rho1*tNS(i), [0,cxNS(i),cyNS(i)])*cyNS(i);

        rhoContrib2x = rhoContrib2x + circshift(rho2*tNS(i), [0,cxNS(i),cyNS(i)])*cxNS(i);
        rhoContrib2y = rhoContrib2y + circshift(rho2*tNS(i), [0,cxNS(i),cyNS(i)])*cyNS(i);
    end

    uTotX1 = uTotX - Gomega1.*rhoContrib2x; %POTENTIAL CONTRIBUTION OF FLUID 2 ON 1
    uTotY1 = uTotY - Gomega1.*rhoContrib2y;

    uTotX2 = uTotX - Gomega2.*rhoContrib1x; %POTENTIAL CONTRIBUTION OF FLUID 2 ON 1
    uTotY2 = uTotY - Gomega2.*rhoContrib1y;

   % COLLISION STEP FLUID 1 AND 2
   for i=1:9
      cuNS1        = 3*(cxNS(i)*uTotX1+cyNS(i)*uTotY1);
      cuNS2        = 3*(cxNS(i)*uTotX2+cyNS(i)*uTotY2);

      fEq(i,:,:)   = rho1 .* tNS(i) .* ...
                       ( 1 + cuNS1 + 0.5*(cuNS1.*cuNS1) - 1.5*(uTotX1.^2+uTotY1.^2) );

      gEq(i,:,:)   = rho2 .* tNS(i) .* ...
                       ( 1 + cuNS2 + 0.5*(cuNS2.*cuNS2) - 1.5*(uTotX2.^2+uTotY2.^2) );

      fOut(i,:,:)  = fIn(i,:,:) - omega1 .* (fIn(i,:,:)-fEq(i,:,:));
      gOut(i,:,:)  = gIn(i,:,:) - omega2 .* (gIn(i,:,:)-gEq(i,:,:));
   end

   % STREAMING STEP FLUID 1 AND 2
   for i=1:9
      fIn(i,:,:) = circshift(fOut(i,:,:), [0,cxNS(i),cyNS(i)]);
      gIn(i,:,:) = circshift(gOut(i,:,:), [0,cxNS(i),cyNS(i)]);
   end

   % VISUALIZATION
   if(mod(cycle,tPlot)==0)
       rho1     = reshape(rho1,lx,ly);
       imagesc(rho1'); colorbar
       title('Fluid 1 density');
       axis equal off; drawnow
   end
end


% [INPUT]
% va = A vector of floats [0,Inf) of length n representing the market values of assets.
% vap = Input argument representing the distributional parameters of assets whose type depends on the chosen option pricing model:
%   - for Black-Scholes-Merton, a float [0,Inf) representing the annualized volatility of assets;
%   - for Gram-Charlier, a row vector of floats (-Inf,Inf) of length 3 whose values represent respectively the annualized volatility, skewness and excess kurtosis of assets.
% cds = A vector of floats [0,Inf) of length n representing the credit default swap spreads.
% db = A float or a vector of floats [0,Inf) of length n representing the default barrier.
% r = A float or a vector of floats (-Inf,Inf) of length n representing the annualized risk-free interest rate.
% t = A float or a vector of floats (0,Inf) of length n representing the time to maturity of default barrier.
%
% [OUTPUT]
% el = A column vector of floats [0,Inf) of length n representing the expected losses.
% cl = A column vector of floats [0,Inf) of length n representing the contingent liabilities.
% a = A column vector of floats [0,1] of length n representing the contingent alphas.

function [el,cl,a] = contingent_claims_analysis(varargin)

    persistent ip;

    if (isempty(ip))
        ip = inputParser();
        ip.addRequired('va',@(x)validateattributes(x,{'double'},{'real' 'finite' 'nonnegative' '2d' 'nonempty'}));
        ip.addRequired('vap',@(x)validateattributes(x,{'double'},{'real' 'finite' 'vector' 'nonempty'}));
        ip.addRequired('cds',@(x)validateattributes(x,{'double'},{'real' 'nonnegative' 'vector' 'nonempty'}));
        ip.addRequired('db',@(x)validateattributes(x,{'double'},{'real' 'finite' 'nonnegative' 'vector' 'nonempty'}));
        ip.addRequired('r',@(x)validateattributes(x,{'double'},{'real' 'finite' 'vector' 'nonempty'}));
        ip.addRequired('t',@(x)validateattributes(x,{'double'},{'real' 'finite' '>' 0 'vector' 'nonempty'}));
    end

    ip.parse(varargin{:});

    ipr = ip.Results;
    [va,vap,cds,db,r,t] = validate_input(ipr.va,ipr.vap,ipr.cds,ipr.db,ipr.r,ipr.t);

    nargoutchk(3,3);

    [el,cl,a] = contingent_claims_analysis_internal(va,vap,cds,db,r,t);

end

function [el,cl,a] = contingent_claims_analysis_internal(va,vap,cds,db,r,t)

    s = vap(1);
    st = s * sqrt(t);

    dbd = db .* exp(-r .* t);

    d1 = (log(va ./ db) + ((r + (0.5 * s^2)) .* t)) ./ st;
    d2 = d1 - st;

    put_price = (dbd .* normcdf(-d2)) - (va .* normcdf(-d1));

    if (numel(vap) == 3)
        g = vap(2);
        k = vap(3);

        t1 = (g / 6) .* ((2 * s) - d1);
        t2 = (k / 24) .* (1 - d1.^2 + (3 .* d1 .* s) - (3 * s^2));

        put_price = put_price - (va .* normcdf(d1) .* s .* (t1 - t2));
    end

    put_price = max(0,put_price);

    rd = dbd - put_price;

    cds_put_price = dbd .* (1 - exp(-cds .* max(0.5,((db ./ rd) - 1)) .* t));
    cds_put_price = min(cds_put_price,put_price);

    a = max(0,min(1 - (cds_put_price ./ put_price),1));
    a(~isreal(a)) = 0;

    el = put_price;
    cl = el .* a;

end

function [va,vap,cds,db,r,t] = validate_input(va,vap,cds,db,r,t)

    va = va(:);
    va_len = numel(va);

    if (va_len < 5)
        error('The value of ''va'' is invalid. Expected input to be a vector containing at least 5 elements.');
    end

    vap_len = numel(vap);

    if ((vap_len ~= 1) && (vap_len ~= 3))
        error('The value of ''vap'' is invalid. Expected input to be a vector containing either 1 or 3 elements.');
    end

    if (vap(1) < 0)
        error('The value of ''vap'' is invalid. Expected input first element to be greater than or equal to 0.');
    end

    cds = cds(:);

    if (numel(va) ~= va_len)
        error(['The value of ''cds'' is invalid. Expected input to be a vector of length ' num2str(va_len) ' elements.']);
    end

    if (all(cds >= 1))
        cds = cds ./ 10000;
    end

    data = {db(:) r(:) t(:)};

    l = unique(cellfun(@numel,data));
    l_scalar = (l == 1);

    if (any(l_scalar))
        if (any(l(~l_scalar) ~= va_len))
            error(['The number of elements of ''db'', ''r'' and ''t'' must be either 1 or equal to ' num2str(va_len) '.']);
        end
    else
        if (any(l ~= va_len))
            error(['The number of elements of ''db'', ''r'' and ''t'' must be either 1 or equal to ' num2str(va_len) '.']);
        end
    end

    for i = 1:numel(data)
        data_i = data{i};

        if (numel(data_i) == 1)
            data{i} = repmat(data_i,va_len,1);
        end
    end

    [db,r,t] = deal(data{:});

end


function Ximg = preimage_rbf(Xtr,sig2,U,B,type,npcs,maxIts)
%
% function Ximg = preimage_rbf(Xtr,sig2,U,B,type,npcs,maxIts)
%   Reconstruction or denoising after kernel PCA with RBF kernels, i.e. to find the
%   approximate preimage (in the input space) of the corresponding feature space expansions
%
% Inputs
%   Xtr     : N by d matrix of the training data used to find the prinicipal components.
%   sig2    : parameter for the RBF kernel used, k(x,z)=exp(-norm(x-z)^2/sig2).
%   U       : the eigenvectors computed from the kernel PCA using RBF kernel with parameter sig2.
%   B       : for reconstruction, B is the compressed data,
%               i.e. the projections of the data on to the first n PCs;
%             for denoising, B is the Nt by d matrix of original noisy data;
%             if not specified, Xtr is denoised instead.
%   type    : 'reconstruct' or 'denoise'
%   npcs    : number of PCs used for approximation
%   maxIts  : maximum iterations allowed to update the preimage, 1000 by default.
%
% Outputs
%   Ximg    : the reconstructed or denoised data in the input space
%
% Usage e.g.
%   >> [lam,U] = kpca(Xtr,'RBF_kernel',sig2);
%   >> [lam, perm] = sort(-lam); lam = -lam; U = U(:,perm);
%   >> projections = kernel_matrix(Xtr,'RBF_kernel',sig2,Xtest)'*U;
%   >> Xr = preimage_rbf(Xtr,sig2,U,projections(:,1:npcs),'r'); % Reconstruction
%   >> Xd = preimage_rbf(Xtr,sig2,U(:,1:npcs),Xnoisy,'d');      % Denoising
%   >> Xdtr = preimage_rbf(Xtr,sig2,U(:,1:npcs));  % Denoising on the training data
%
% see also:
%    kpca, denoise_kpca, RBF_kernel
%
% Reference
%   Mika S., Schoelkopf B., Smola A., Muller K.-R., Scholz M., Ratsch G. (1999), ``Kernel
%   PCA and de-noising in feature spaces'', Advances in Neural Information Processing
%   Systems 11, 536-542, MIT Press.
%

% Copyright (c) 2011,  KULeuven-ESAT-SCD, License & help @ http://www.esat.kuleuven.be/sista/lssvmlab

MAXDX=1e-6; % Convergence criterion
[~, dim]=size(Xtr);
mX=mean(Xtr); sX=std(Xtr);

if nargin<4, B = Xtr; end
[Nt, dimB] = size(B);

if nargin<5
    if dimB==dim, type='denoise'; else type='reconstruct'; end
else
    if type(1)~='d'&type(1)~='r'| (type(1)=='d'&dimB~=dim),
        warning('Invalid type specified, default value is used!')
        if dimB==dim, type='denoise'; else type='reconstruct'; end
    end
end

if nargin<6
    if type(1)=='r'; npcs=dimB; else npcs=size(U,2); end
else
    if npcs>size(U,2) | (type(1)=='r' & npcs~=dimB),
        warning('Invalid number of PCs, default value is used!'),
        if type(1)=='r'; npcs=dimB; else npcs=size(U,2); end
    end
end

if nargin<7, maxIts=1000; end

U=U(:,1:npcs);

for n=1:Nt
    cont=1; t=0; ts=0;
    if type(1)=='r'
        % reconstuction
        rs = U*B(n,:)';
        x = zeros(1, dim); % set the initial value of approximate preimage for reconstruction
        k = RBF_kernel(x,Xtr,sig2);
    else
        % denoise
        x = B(n,:); % initial value of the approximate preimage for denoising is the noisy data
        k = RBF_kernel(x,Xtr,sig2);
        rs = U*(k'*U)';
    end

    % iteratively update the approximate preimage x
    %
    while cont,

        d=rs'*k; % the reconstruction error is (const-2d)

        if d==0;
            % choose a different starting value
%            [k,id]=min(k); x_new = Xtr(id,:);
            randn('state',cputime+ts); x_new=(randn(1,dim)+mX).*sX;
            fprintf('%5d> Starting value changed!(d=0) \n', ts);
        else
            % update approximate preimage with a linear combination of kpca training data
            x_new = sum(rs.*k*ones(1,dim).*Xtr)/d;
        end

        dx = norm(x_new - x);
        x = x_new;

        t=t+1; ts=ts+1;

        if dx<MAXDX;
            cont = 0;
         % fprintf('%5d> Converged! \n', ts);
        else
            if ts>=maxIts;
                cont=0;
                fprintf('%5d> Maximum iteration reached!\n', ts);
            elseif t>=500;
                % choose a different starting value
%                [k,id]=min(k); x = Xtr(id,:);
                randn('state',cputime+ts); x=(randn(1,dim)+mX).*sX;
                t=0;
            end
        end
        k = RBF_kernel(x,Xtr,sig2);

    end % while
    Ximg(n,:)=x_new;
end % for


function [mGal] = nmps22mGal(nmps2)
% Convert acceleration from nanometers per square-second to milligalileos
% Chad A. Greene 2012
mGal = nmps2*1e-4;


function p = square_uniform ( n )

%*****************************************************************************80
%
%% SQUARE_UNIFORM returns sample points from the unit square.
%
%  Discussion:
%
%    This routine returns N points sampled uniformly at random
%    from within the unit square.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 May 2006
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of points to generate.
%
%    Output, real P(N,2), the sample points.
%
  p = rand ( n, 2 );

  return
end


% SP_HCURL_ERROR: Evaluate the error in H(curl) norm.
%
%   [errhcurl, errl2, errcurl] = sp_hcurl_error (space, msh, u, uex, curluex);
%
% INPUT:
%
%    space:   object defining the space of discrete functions (see sp_vector)
%    msh:     object defining the domain partition and the quadrature rule (see msh_cartesian)
%    u:       vector of dof weights
%    uex:     function handle to evaluate the exact solution
%    curluex: function handle to evaluate the curl of the exact solution
%
% OUTPUT:
%
%     errhcurl: error in H(curl) norm
%     errl2:    error in L^2 norm
%     errcurl:  error of the curl in L^2 norm
%
% Copyright (C) 2010 Carlo de Falco, Rafael Vazquez
% Copyright (C) 2011, 2015 Rafael Vazquez
%
% 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 Octave; see the file COPYING.  If not, see
% <http://www.gnu.org/licenses/>.

function [errhcurl, errl2, errcurl] = sp_hcurl_error (space, msh, u, uex, curluex)

  if (numel(u) ~= space.ndof)
    error ('Wrong size of the vector of degrees of freedom')
  end

  errl2 = 0;
  errcurl = 0;

  for iel = 1:msh.nel_dir(1)
    msh_col = msh_evaluate_col (msh, iel);
    sp_col  = sp_evaluate_col (space, msh_col, 'value', true, 'curl', true);

    [~, err_l2, err_curl] = sp_hcurl_error (sp_col, msh_col, u, uex, curluex);

    errcurl = errcurl + err_curl.^2;
    errl2 = errl2 + err_l2.^2;
  end

  errhcurl = sqrt (errl2 + errcurl);
  errl2 = sqrt (errl2);
  errcurl = sqrt (errcurl);

end


function b = r8vec_bracket6 ( nd, xd, ni, xi )

%*****************************************************************************80
%
%% R8VEC_BRACKET6 brackets data between successive entries of a sorted R8VEC.
%
%  Discussion:
%
%    We assume XD is sorted.
%
%    If XI(I) is contained in the interval [XD(1),XD(N)], then the value of
%    B(I) indicates that XI(I) is contained in [ XD(B(I)), XD(B(I)+1) ].
%
%    If XI(I) is not contained in the interval [XD(1),XD(N)], then B(I) = -1.
%
%    This code implements a version of binary search which is perhaps more
%    understandable than the usual ones.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 October 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer ND, the number of data values.
%
%    Input, real XD(N,1), the sorted data.
%
%    Input, integer NI, the number of inquiry values.
%
%    Input, real XI(NI,1), the query values.
%
%    Output, integer B(NI,1), the bracket information.
%
  xd = xd(:);
  xi = xi(:);
  b = zeros ( ni, 1 );

  for i = 1 : ni

    if ( xi(i) < xd(1) || xd(nd) < xi(i) )

      b(i) = -1;

    else

      l = 1;
      r = nd;

      while ( l + 1 < r )
        m = floor ( ( l + r ) / 2 );
        if ( xi(i) < xd(m) )
          r = m;
        else
          l = m;
        end
      end

      b(i) = l;

    end

  end

  return
end


% Driver script for solving the 3D advection equations
Globals3D;

% Order of polymomials used for approximation
N = 8;

% Generate simple mesh
filename = 'cubeK6.neu'
[Nv, VX, VY, VZ, K, EToV] = MeshReaderGambit3D(filename);

% Initialize solver and construct grid and metric
StartUp3D;

% set initial conditions
u = exp(-1*(x.^2 + y.^2 + z.^2));

% Solve Problem
FinalTime = 0.8;
[u] = Advec3D(u,FinalTime);


function [thrs, fars, frrs] = slroc(scores, signs, thres, op)
%SLROC Computes the ROC
%
% $ Syntax $
%   - [thrs, fars, frrs] = slroc(scores, signs, thres, op)
%
% $ Arguments $
%   - scores:           the scores representing the signal intensities
%   - signs:            the signs representing the groundtruth (0 or 1)
%   - thres:            the descriptor indicating how to sample the
%                       thresholds at which the rate is computed
%   - op:               the option stating the attributes of the scores.
%   - thrs:             the sampled threshold values
%   - fars:             the false accept rates at the sampled thresholds
%   - frrs:             the false reject rates at the sampled thresholds
%
% $ Description $
%   - [thrs, fars, frrs] = slroc(scores, signs, thres, op) Computes the
%     ROC of a receiver from the scores and groudtruth signs. The argument
%     thres specifies the sampled thresholds at which the false accept
%     rate and false reject rate is evaluated. If thres is an integer,
%     say n, then n equal-interval integers from lowest to highest scores
%     are taken as samples. The thres can also be a vector containing the
%     sampled thresholds, which should be arranged in ascending order.
%     op states the attributes of the scores, which
%     takes either of the two values: 'high' or 'low'. If op is 'high', a
%     higher score indicates a better match; if op is 'low', a lower score
%     indicates a better match. The cumulative score will be computed
%     up to the number of all classes.
%     For output, if n thresholds are sampled, then thrs, fars, and frrs
%     for all n x 1 vectors, containing the sampled threshold values,
%     and the corresponding false accept rates, and false reject rates.
%
% $ History $
%   - Created by Dahua Lin on Jun 9th, 2005
%   - Modified by Dahua Lin on May 1st, 2006
%     - Base on the sltoolbox v4
%   - Modified by Dahua Lin on Aug 8th, 2006
%     - Base on slhistroc
%

%% parse and verify the input arguments
if nargin < 4
    raise_lackinput('slroc', 4);
end
if ~isequal(size(scores), size(signs))
    error('sltoolbox:sizmismatch', ...
        'The sizes of scores and signs are not match');
end

% the following two statements are disabled in the 2006-08-08 modification
% since scores(signs) will automatic serialize the values
% there is no need to write this statement, just a waste of time and mem
% scores = scores(:);
% signs = logical(signs(:));

if numel(thres) == 1
    n = thres;
    highscore = max(max(scores));
    lowscore = min(min(scores));
    thrs = linspace(lowscore, highscore, n)';
else
    thrs = thres(:);
end

%% compute
scores_a = scores(signs);
scores_r = scores(~signs);

hist_a = histc(scores_a, thrs);
hist_r = histc(scores_r, thrs);

[thrs, fars, frrs] = slhistroc(hist_a, hist_r, thrs, op);


function [ n_data, a, x, fx ] = jacobi_dn_values ( n_data )

%*****************************************************************************80
%
%% JACOBI_DN_VALUES returns some values of the Jacobi elliptic function DN(A,X).
%
%  Discussion:
%
%    In Mathematica, the function can be evaluated by:
%
%      JacobiDN[ x, a ]
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Milton Abramowitz and Irene Stegun,
%    Handbook of Mathematical Functions,
%    US Department of Commerce, 1964.
%
%    Stephen Wolfram,
%    The Mathematica Book,
%    Fourth Edition,
%    Wolfram Media / Cambridge University Press, 1999.
%
%  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 A, the parameter of the function.
%
%    Output, real X, the argument of the function.
%
%    Output, real FX, the value of the function.
%
  n_max = 20;

  a_vec = [ ...
     0.0E+00, ...
     0.0E+00, ...
     0.0E+00, ...
     0.0E+00, ...
     0.0E+00, ...
     0.5E+00, ...
     0.5E+00, ...
     0.5E+00, ...
     0.5E+00, ...
     0.5E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00 ];

  fx_vec = [ ...
     0.1000000000000000E+01, ...
     0.1000000000000000E+01, ...
     0.1000000000000000E+01, ...
     0.1000000000000000E+01, ...
     0.1000000000000000E+01, ...
     0.9975093485144243E+00, ...
     0.9901483195224800E+00, ...
     0.9429724257773857E+00, ...
     0.8231610016315963E+00, ...
     0.7108610477840873E+00, ...
     0.9950207489532265E+00, ...
     0.9803279976447253E+00, ...
     0.8868188839700739E+00, ...
     0.6480542736638854E+00, ...
     0.2658022288340797E+00, ...
     0.3661899347368653E-01, ...
     0.9803279976447253E+00, ...
     0.8868188839700739E+00, ...
     0.6480542736638854E+00, ...
     0.2658022288340797E+00  ];

  x_vec = [ ...
      0.1E+00, ...
      0.2E+00, ...
      0.5E+00, ...
      1.0E+00, ...
      2.0E+00, ...
      0.1E+00, ...
      0.2E+00, ...
      0.5E+00, ...
      1.0E+00, ...
      2.0E+00, ...
      0.1E+00, ...
      0.2E+00, ...
      0.5E+00, ...
      1.0E+00, ...
      2.0E+00, ...
      4.0E+00, ...
     -0.2E+00, ...
     -0.5E+00, ...
     -1.0E+00, ...
     -2.0E+00 ];

  if ( n_data < 0 )
    n_data = 0;
  end

  n_data = n_data + 1;

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

  return
end


function [g,a,fc,L,info]=audfilters(fs,Ls,varargin)
%AUDFILTERS Generates filters equidistantly spaced on auditory frequency scales
%   Usage:  [g,a,fc,L]=audfilters(fs,Ls);
%           [g,a,fc,L]=audfilters(fs,Ls,...);
%
%   Input parameters:
%      fs    : Sampling rate (in Hz).
%      Ls    : Signal length.
%   Output parameters:
%      g     : Cell array of filters.
%      a     : Downsampling rate for each channel.
%      fc    : Center frequency of each channel.
%      L     : Next admissible length suitable for the generated filters.
%
%   `[g,a,fc,L]=audfilters(fs,Ls)` constructs a set of filters *g* that are
%   equidistantly spaced on a perceptual frequency scale (see |freqtoaud|) between
%   0 and the Nyquist frequency. The filter bandwidths are proportional to the
%   critical bandwidth of the auditory filters |audfiltbw|. The filters are intended
%   to work with signals with a sampling rate of *fs*. The signal length *Ls* is
%   mandatory, since we need to avoid too narrow frequency windows.
%
%   By default the ERB scale is chosen but other frequency scales are
%   possible. Currently supported scales are 'erb', 'erb83', 'bark', 'mel'
%   and 'mel1000', and can be changed by passing the associated string as
%   an optional parameter. See |freqtoaud| for more information on the
%   supported frequency scales.
%
%   By default, a Hann window shape is chosen as prototype frequency
%   response for all filters. The prototype frequency response can be
%   changed by passing any of the window types from |firwin| or |freqwin|
%   as an optional parameter.
%
%   `[g,a,fc,L]=audfilters(fs,Ls,fmin,fmax)` constructs a set of filters
%   between *fmin* and *fmax*. The filters are equidistantly spaced on the
%   selected frequency scale. One additional filter will be positioned at
%   the 0 and Nyquist frequencies each, so as to cover the full range of
%   positive frequencies.
%   The values of *fmin* and *fmax* can be instead specified using a
%   key/value pair as::
%
%       [g,a,fc,L]=audfilters(fs,Ls,...,'fmin',fmin,'fmax',fmax)
%
%   Default values are *fmin=0* and *fmax=fs/2*.
%
%   For more details on the construction of the filters, please see the
%   given references.
%
%   Downsampling factors
%   --------------------
%
%   The integer downsampling rates of the channels must all divide the
%   signal length, |filterbank| will only work for input signal lengths
%   being multiples of the least common multiple of the downsampling rates.
%   See the help of |filterbanklength|.
%   The fractional downsampling rates restrict the filterbank to a single
%   length *L=Ls*.
%
%   `[g,a]=audfilters(...,'regsampling')` constructs a non-uniform
%   filterbank with integer subsampling factors.
%
%   `[g,a]=audfilters(...,'uniform')` constructs a uniform filterbank
%   where the integer downsampling rate is the same for all the channels. This
%   results in most redundant representation which produces nice plots.
%
%   `[g,a]=audfilters(...,'fractional')` constructs a filterbank with
%   fractional downsampling rates *a*.
%   This results in the least redundant system.
%
%   `[g,a]=audfilters(...,'fractionaluniform')` constructs a filterbank with
%   fractional downsampling rates *a*, which are uniform for all filters
%   except the "filling" low-pass and high-pass filters which can have different
%   fractional downsampling rates. This is useful when uniform subsampling
%   and low redundancy at the same time are desirable.
%
%   Additional parameters
%   ---------------------
%
%   `audfilters` accepts the following optional parameters:
%
%     'spacing',b        Specify the spacing between the filters, measured in
%                        scale units. Default value is *b=1* for the scales
%                        'erb', 'erb83' and 'bark'; the default is *b=100* for
%                        'mel' and 'mel1000'.
%
%     'bwmul',bwmul      Bandwidth of the filters relative to the bandwidth
%                        returned by |audfiltbw|. Default value is *bwmul=1* for
%                        the scales 'erb', 'erb83' and 'bark'; the default is
%                        *b=100* for 'mel' and 'mel1000'.
%
%     'redmul',redmul    Redundancy multiplier. Increasing the value of this
%                        will make the system more redundant by lowering the
%                        channel downsampling rates. It is only used if the
%                        filterbank is a non-uniform filterbank. Default
%                        value is *1*. If the value is less than one, the
%                        system may no longer be painless.
%
%     'redtar',redtar    Target redundancy. The downsampling factors will be
%                        adjusted to achieve a redundancy as close as possible
%                        to 'redtar'.
%
%     'M',M              Specify the total number of filters between *fmin* and
%                        *fmax*. If this parameter is specified, it overwrites the
%                        `'spacing'` parameter.
%
%     'symmetric'        Create filters that are symmetric around their centre
%                        frequency. This is the default.
%
%     'warped'           Create asymmetric filters that are symmetric on the
%                        auditory scale.
%
%     'complex'          Construct a filterbank that covers the entire
%                        frequency range instead of just the positive
%                        frequencies this allows the analysis of complex
%                        valued signals.
%
%     'nosubprec'        Disable subsample window positions.
%
%     'trunc_at'         When using a prototype defined in |freqwin|, a hard
%                        thresholding of the filters at the specified threshold
%                        value is performed to reduce their support size.
%                        The default value is *trunc_at=10e-5*. When no
%                        truncation is desired, *trunc_at=0* should be chosen.
%                        This value is ignored when a prototype shape from
%                        |firwin| was chosen.
%
%     'min_win',min_win  Minimum admissible window length (in samples).
%                        Default is *4*. This restrict the windows not
%                        to become too narrow when *L* is low.
%
%   Examples:
%   ---------
%
%   In the first example, we construct a highly redudant uniform
%   filterbank on the ERB scale and visualize the result:::
%
%     [f,fs]=greasy;  % Get the test signal
%     [g,a,fc,L]=audfilters(fs,length(f),'uniform','M',100);
%     c=filterbank(f,g,a);
%     plotfilterbank(c,a,fc,fs,90,'audtick');
%
%   In the second example, we construct a non-uniform filterbank with
%   fractional sampling that works for this particular signal length, and
%   test the reconstruction. The plot displays the response of the
%   filterbank to verify that the filters are well-behaved both on a
%   normal and an ERB-scale. The second plot shows frequency responses of
%   filters used for analysis (top) and synthesis (bottom). :::
%
%     [f,fs]=greasy;  % Get the test signal
%     L=length(f);
%     [g,a,fc]=audfilters(fs,L,'fractional');
%     c=filterbank(f,{'realdual',g},a);
%     r=2*real(ifilterbank(c,g,a));
%     norm(f-r)
%
%     % Plot the response
%     figure(1);
%     subplot(2,1,1);
%     R=filterbankresponse(g,a,L,fs,'real','plot');
%
%     subplot(2,1,2);
%     semiaudplot(linspace(0,fs/2,L/2+1),R(1:L/2+1));
%     ylabel('Magnitude');
%
%     % Plot frequency responses of individual filters
%     gd=filterbankrealdual(g,a,L);
%     figure(2);
%     subplot(2,1,1);
%     filterbankfreqz(gd,a,L,fs,'plot','linabs','posfreq');
%
%     subplot(2,1,2);
%     filterbankfreqz(g,a,L,fs,'plot','linabs','posfreq');
%
%
%   See also: filterbank, ufilterbank, ifilterbank, ceil23
%
%   References: ltfatnote027 nehobaprpide18

% Authors: Peter L. Søndergaard (original 'erbfilters' function)
% Modified by: Thibaud Necciari, Nicki Holighaus
% Comments updated by: Nicki Holighaus (09.05.22)

% Date: 16.12.16

complainif_notenoughargs(nargin,2,upper(mfilename));
complainif_notposscalar(fs,'fs',upper(mfilename));
complainif_notposint(Ls,'Ls',upper(mfilename));

firwinflags=getfield(arg_firwin,'flags','wintype');
freqwinflags=getfield(arg_freqwin,'flags','wintype');

definput.flags.wintype = [ firwinflags, freqwinflags];
definput.keyvals.M=[];
definput.keyvals.redmul=1;
definput.keyvals.min_win = 4;
definput.keyvals.bwmul=[];
definput.keyvals.spacing=[];
definput.keyvals.trunc_at=10^(-5);
definput.keyvals.fmin=0;
definput.keyvals.fmax=fs/2;
definput.keyvals.redtar=[];
definput.flags.subprec={'subprec','nosubprec'};
definput.flags.audscale={'erb','erb83','bark','mel','mel1000'};
definput.flags.warp     = {'symmetric','warped'};
definput.flags.real     = {'real','complex'};
definput.flags.sampling = {'regsampling','uniform','fractional',...
                           'fractionaluniform'};

[varargin,winCell] = arghelper_filterswinparser(definput.flags.wintype,varargin);

[flags,kv]=ltfatarghelper({'fmin','fmax'},definput,varargin);
if isempty(winCell), winCell = {flags.wintype}; end

switch flags.audscale
    case {'mel','mel1000'} % The mel scales are very fine, therefore default spacing is adjusted
        definput.keyvals.bwmul=100;
        definput.keyvals.spacing=100;
    otherwise
        definput.keyvals.bwmul=1;
        definput.keyvals.spacing=1;
end
[flags,kv]=ltfatarghelper({'fmin','fmax','redtar'},definput,varargin);

if flags.do_bark && (fs > 44100)
    error(['%s: Bark scale is not suitable for sampling rates higher than 44.1 kHz. ',...
    'Please choose another scale.'],upper(mfilename));
end

if ~isscalar(kv.bwmul) || kv.bwmul <= 0
    error('%s: bwmul must be a positive scalar.',upper(mfilename));
end

if ~isscalar(kv.redmul) || kv.redmul <= 0
    error('%s: redmul must be a positive scalar.',upper(mfilename));
end

if ~isempty(kv.redtar)
    if ~isscalar(kv.redtar) || kv.redtar <= 0
        error('%s: redtar must be a positive scalar.',upper(mfilename));
    end
end

if kv.redtar <= 1
    warning('%s: redtar is very low; the resulting system might be unstable.',upper(mfilename));
end

if kv.fmax <= kv.fmin || kv.fmin < 0 || kv.fmax > fs/2
    error('%s: fmax must be bigger than fmin and in the range [0,fs/2].',upper(mfilename));
end

if kv.trunc_at > 1 || kv.trunc_at < 0
    error('%s: trunc_at must be in range [0,1].',upper(mfilename));
end

if ~isscalar(kv.min_win) || rem(kv.min_win,1) ~= 0 || kv.min_win < 1
    error('%s: min_win must be an integer bigger or equal to 1.',upper(mfilename));
end

if ~isempty(kv.M)
    complainif_notposint(kv.M,'M',upper(mfilename));
    kv.spacing = (freqtoaud(kv.fmax,flags.audscale) - freqtoaud(kv.fmin,flags.audscale))/(kv.M-1);
end

% Construct function handle for filter prototype and determine its ERB-type
% bandwidth
[filterfunc,winbw] = helper_filtergeneratorfunc(...
                          flags.wintype,winCell,fs,kv.bwmul,kv.min_win,kv.trunc_at,...
                          flags.audscale,flags.do_subprec,flags.do_symmetric,flags.do_warped);

% Construct the AUD filterbank
fmin = max(kv.fmin,audtofreq(kv.spacing,flags.audscale));
fmax = min(kv.fmax,fs/2);

innerChanNum = floor((freqtoaud(fmax,flags.audscale)-freqtoaud(fmin,flags.audscale))/kv.spacing)+1;

fmax = audtofreq(freqtoaud(fmin,flags.audscale)+(innerChanNum-1)*kv.spacing,flags.audscale);

% Make sure that fmax < fs/2, and F_ERB(fmax) = F_ERB(fmin)+k/spacing, for
% some k.
count = 0;
while fmax >= fs/2
    count = count+1;
    fmax = audtofreq(freqtoaud(fmin,flags.audscale)+(innerChanNum-count-1)*kv.spacing,flags.audscale);
end
innerChanNum = innerChanNum-count;

if fmax <= fmin || fmin > fs/4 || fmax < fs/4
    error(['%s: Bad combination of fs, fmax and fmin.'],upper(mfilename));
end

% Center frequencies are given as equidistantly spaced points on auditory
% scale
fc=audspace(fmin,fmax,innerChanNum,flags.audscale).';
fc = [0;fc;fs/2];
M2 = innerChanNum+2;

ind = (2:M2-1)';
%% Compute the frequency support
% fsupp is measured in Hz

fsupp=zeros(M2,1);
aprecise=zeros(M2,1);

if flags.do_symmetric
    fsupp(ind)=audfiltbw(fc(ind),flags.audscale)/winbw*kv.bwmul;

    % Generate lowpass filter parameters
    fsupp(1) = 0; % Placeholder value
    % Determine border of passband
    fps0 = audtofreq(freqtoaud(fc(2),flags.audscale)+3*kv.spacing,flags.audscale);% f_{p,s}^{-}
    % Determine lowpass width
    fsupp_temp1 = audfiltbw(fps0,flags.audscale)/winbw*kv.bwmul;
    % Determine bandwidth-adapted decimation factor
    aprecise(1) = max(fs./(2*max(fps0,0)+fsupp_temp1*kv.redmul),1);

    % Generate highpass filter parameters
    fsupp(end) = 0; % Placeholder value
    % Determine border of passband
    fps0 = audtofreq(freqtoaud(fc(end-1),flags.audscale)-3*kv.spacing,flags.audscale);% f_{p,s}^{+}
    % Determine highpass width
    fsupp_temp1 = audfiltbw(fps0,flags.audscale)/winbw*kv.bwmul;
    % Determine bandwidth-adapted decimation factor
    aprecise(end) = max(fs./(2*(fc(end)-min(fps0,fs/2))+fsupp_temp1*kv.redmul),1);
else
    % fsupp_scale is measured on the selected auditory scale
    % The scaling is incorrect, it does not account for the warping (NH:
    % I do think it is correct.)
    fsupp_scale=1/winbw*kv.bwmul;

    % Convert fsupp into the correct widths in Hz, necessary to compute
    % "a" in the next if-statement
    fsupp(ind)=audtofreq(freqtoaud(fc(ind),flags.audscale)+fsupp_scale/2,flags.audscale)-...
               audtofreq(freqtoaud(fc(ind),flags.audscale)-fsupp_scale/2,flags.audscale);

    % Generate lowpass filter parameters
    fsupp(1) = 0; % Placeholder value
    % Determine border of passband
    fps0 = audtofreq(freqtoaud(fc(2),flags.audscale)+3*kv.spacing,flags.audscale);% f_{p,s}^{-}
    % Determine lowpass width
    fsupp_temp1 = audfiltbw(fps0,flags.audscale)/winbw*kv.bwmul;
    % Determine bandwidth-adapted decimation factor
    aprecise(1) = max(fs./(2*max(fps0,0)+fsupp_temp1*kv.redmul),1);

    % Generate highpass filter parameters
    fsupp(end) = 0; % Placeholder value
    % Determine border of passband
    fps0 = audtofreq(freqtoaud(fc(end-1),flags.audscale)-3*kv.spacing,flags.audscale);% f_{p,s}^{+}
    % Determine highpass width
    fsupp_temp1 = audfiltbw(fps0,flags.audscale)/winbw*kv.bwmul;
    % Determine bandwidth-adapted decimation factor
    aprecise(end) = max(fs./(2*(fc(end)-min(fps0,fs/2))+fsupp_temp1*kv.redmul),1);
end;

% Do not allow lower bandwidth than keyvals.min_win
fsuppmin = kv.min_win/Ls*fs;
for ii = 1:numel(fsupp)
    if fsupp(ii) < fsuppmin;
        fsupp(ii) = fsuppmin;
    end
end

% Find suitable channel subsampling rates
aprecise(ind)=fs./fsupp(ind)/kv.redmul;
aprecise=aprecise(:);

if any(aprecise<1)
    error('%s: Invalid subsampling rates. Decrease redmul.',upper(mfilename))
end

%% Compute the downsampling rate
if flags.do_regsampling
    % Shrink "a" to the next composite number
    a=floor23(aprecise);

    % Determine the minimal transform length
    L=filterbanklength(Ls,a);

    % Heuristic trying to reduce lcm(a)
    while L>2*Ls && ~(all(a)==a(1))
        maxa = max(a);
        a(a==maxa) = 0;
        a(a==0) = max(a);
        L = filterbanklength(Ls,a);
    end

% Determine true decimation factors from "aprecise" according to chosen
% subsampling scheme (see help above)
elseif flags.do_fractional
    L = Ls;
    N=ceil(Ls./aprecise);
    a=[repmat(Ls,M2,1),N];
elseif flags.do_fractionaluniform
    L = Ls;
    N=ceil(Ls./min(aprecise));
    a= repmat([Ls,N],M2,1);
elseif flags.do_uniform
    a=floor(min(aprecise));
    L=filterbanklength(Ls,a);
    a = repmat(a,M2,1);
end;

% Get an expanded "a" / Convert "a" to LTFAT 2-column fractional format
afull=comp_filterbank_a(a,M2,struct());

%% Compute the scaling of the filters
% Filters are scaled such that the energy of the subband coefficients
% remains approximately constant independent of the decimation factor
scal=sqrt(afull(:,1)./afull(:,2));

%% Construct the real or complex filterbank

if flags.do_real
    % Scale the first and last channels
    scal(1)=scal(1)/sqrt(2);
    scal(M2)=scal(M2)/sqrt(2);
else
    % Replicate the centre frequencies and sampling rates, except the first and
    % last
    a=[a;flipud(a(2:M2-1,:))];
    scal=[scal;flipud(scal(2:M2-1))];
    fc  =[fc; -flipud(fc(2:M2-1))];
    fsupp=[fsupp;flipud(fsupp(2:M2-1))];
    ind = [ind;numel(fc)+2-(M2-1:-1:2)'];
end;

%% Compute the filters
% This is actually much faster than the vectorized call.
g = cell(1,numel(fc));
for m=ind.'
    g{m}=filterfunc(fsupp(m),fc(m),scal(m));
end

% Generate lowpass filter
g{1} = audlowpassfilter(g(1:M2),a(1:M2,:),fc(1:M2),fs,scal(1),kv,flags);

% Generate highpass filter
g{M2} = audhighpassfilter(g(1:M2),a(1:M2,:),fc(1:M2),fs,scal(M2),kv,flags);

% Adjust the downsampling rates in order to achieve 'redtar' (see help
% above)
if ~isempty(kv.redtar)
    if flags.do_uniform
        % Compute and display redundancy for verification
        org_red = (M2-2)/a(1);
        a_new = floor(a*org_red/kv.redtar);
        scal_new = org_red/kv.redtar*ones(numel(g),1);
        % new_red = (M2-2)/a_new(1);
    else
        % The decimation factors of all filters except for lowpass and
        % highpass are adjusted proportional to their bandwidth. For
        % lowpass and highpass, only the tapered part is considered for
        % adjustment to better preserve stability. Please consult the
        % references for details.
        dk_old = a(:,1)./a(:,2);
        org_red = sum(2./dk_old(2:end-1));
        a_new = [a(1,:);[a(2:end-1,1),ceil(a(2:end-1,2)*kv.redtar/org_red)];a(end,:)];
        % Adjust d0 and dK to the new redundancy
        cbw = 2*sum(audfiltbw(fc(2:M2-1),flags.audscale)/winbw*kv.bwmul)/(kv.redtar*fs);
        % Low-pass
        fps0 = audtofreq(freqtoaud(fc(2),flags.audscale)+3*kv.spacing,flags.audscale);% f_{p,s}^{-}
        fsupp_temp0 = audfiltbw(fps0,flags.audscale)/winbw*kv.bwmul;
        a_new(1,2) = ceil(Ls/max(fs./(2*fps0+fsupp_temp0/cbw),1));
        % High-pass
        fps1 = audtofreq(freqtoaud(fc(end-1),flags.audscale)-3*kv.spacing,flags.audscale);% f_{p,s}^{+}
        fsupp_temp1 = audfiltbw(fps1,flags.audscale)/winbw*kv.bwmul;
        a_new(end,2) = ceil(Ls/max(fs./(2*(fc(end)-fps1)+fsupp_temp1/cbw),1));
        % Finally re-scale all filters
        dk_new = a_new(:,1)./a_new(:,2);
        scal_new = dk_new./dk_old;
        % new_red = sum(2./dk_new)-sum(1./dk_new([1,end]));
    end
    g_new = filterbankscale(g,sqrt(scal_new)'); % Perform rescaling
    a = a_new;
    g = g_new;
    if 0
        % Compute and display redundancy for verification
        fprintf('Original redundancy: %g \n', org_red);
        fprintf('Target redundancy: %g \n', kv.redtar);
        fprintf('Actual redundancy: %g \n', new_red);
    end
end

winbwrat = winbw/0.754;
basebw = 1.875657;

info.fc  = 2*fc/fs;
info.tfr = @(L)(1/L)*1./((2*fsupp*winbwrat/fs)./basebw).^2;

function glow = audlowpassfilter(g,a,fc,fs,scal,kv,flags)

% Make a probe, compute the restricted filter bank response to check if low-pass filter is needed
Lprobe = 10000;
FBresp0 = filterbankresponse(g(2:end-1),a(2:end-1,:),Lprobe,'real');
eps_thr = 1e-3;
ind_f1 = floor(fc(2)*Lprobe/fs);
ind_fK = floor(fc(end-1)*Lprobe/fs);
if ind_f1 == 0 || ...
    min(FBresp0(1:ind_f1)) >= (1-eps_thr)*min(FBresp0(ind_f1:ind_fK))
%       Not required
    glow.H = @(L) 0;
    glow.foff = @(L) 0;
    glow.realonly = 0;
    glow.delay = 0;
    glow.fs = g{2}.fs;
else

%       Required
    % Compute the transition frequencies f_{p,s}^{-} and f_{p,e}^{-}
    % Determines the width of the plateau
    fps = audtofreq(freqtoaud(fc(2),flags.audscale)+3*kv.spacing,flags.audscale);
    % Determines the cosine transition frequency
    fpe = audtofreq(freqtoaud(fc(2),flags.audscale)+4*kv.spacing,flags.audscale);
    fsupp_LP = 2*fpe;
    ratio = 2*(fpe-fps)/fsupp_LP;
    Lw = @(L) min(ceil(fsupp_LP*L/fs),L);

    P0 = blfilter({'hann','taper',ratio},fsupp_LP,'fs',fs,'inf','min_win',kv.min_win);
    temp_fbresp = @(L) filterbankresponse(g(2:end-1),a(2:end-1,:),L,'real');
    Hinv = @(L) sqrt(max(temp_fbresp(L))-temp_fbresp(L));

%     Compute the final low-pass filter
    glow.H = @(L) fftshift(long2fir(...
        filterbankfreqz(P0,a(1,:),L).*Hinv(L),Lw(L)))*scal;
    glow.foff = @(L) -floor(Lw(L)/2);
    glow.realonly = 0;
    glow.delay = 0;
    glow.fs = g{2}.fs;
end

function ghigh = audhighpassfilter(g,a,fc,fs,scal,kv,flags)

% Make a probe, compute the restricted filter bank response to check if hi-pass filter is needed
Lprobe = 10000;
FBresp0 = filterbankresponse(g(2:end-1),a(2:end-1,:),Lprobe,'real');
eps_thr = 1e-3;
ind_f1 = floor(fc(2)*Lprobe/fs);
ind_fK = floor(fc(end-1)*Lprobe/fs);
if ind_f1 == 0 ||...
    min(FBresp0(ind_fK:floor(Lprobe/2))) >= (1-eps_thr)*min(FBresp0(ind_f1:ind_fK))
%       Not required
    ghigh.H = @(L) 0;
    ghigh.foff = @(L) 0;
    ghigh.realonly = 0;
    ghigh.delay = 0;
    ghigh.fs = g{2}.fs;
else

    %     Compute the transition frequencies f_{p,s}^{+} and f_{p,e}^{+}
    % Determines the width of the plateau
    fps = audtofreq(freqtoaud(fc(end-1),flags.audscale)-3*kv.spacing,flags.audscale);
    % Determines the cosine transition frequency
    fpe = audtofreq(freqtoaud(fc(end-1),flags.audscale)-4*kv.spacing,flags.audscale);

    %     plateauWidth = 2*(fs/2-fps);
    fsupp_HP = 2*(fs/2-fpe);
    ratio = 2*(fps-fpe)/fsupp_HP;
    Lw = @(L) min(ceil(fsupp_HP*L/fs),L);

    PK = blfilter({'hann','taper',ratio},fsupp_HP,'fc',fs/2,'fs',fs,'inf','min_win',kv.min_win);
    temp_fbresp = @(L) filterbankresponse(g(2:end-1),a(2:end-1,:),L,'real');
    Hinv = @(L) sqrt(max(temp_fbresp(L))-temp_fbresp(L));

    %     Compute the final high-pass filter
    ghigh.H = @(L) fftshift(long2fir(fftshift(...
        filterbankfreqz(PK,a(1,:),L).*Hinv(L)),Lw(L)))*scal;

    ghigh.foff = @(L) ceil(L/2)-floor(Lw(L)/2)-1;
    ghigh.realonly = 0;
    ghigh.delay = 0;
    ghigh.fs = g{2}.fs;
end


function EIN = PQIntNoise (f)
% Generate the internal noise energy vector

% P. Kabal $Revision: 1.1 $  $Date: 2003/12/07 13:34:10 $

N = length (f);
for (m = 0:N-1)
    INdB = 1.456 * (f(m+1) / 1000)^(-0.8);
    EIN(m+1) = 10^(INdB / 10);
end


% explore balloon model stability

clear all
close all
clc

xg1 = [-5:0.2:5];
xg2 = xg1;
n = length(xg1);
lm = zeros(n,n);
kas = [-4:0.2:4];
kaf = [-3:0.2:3];

try

    load demo_stability_hrf.mat
    % get max eigenvalue
    P = [0;0;0;0;0;0];
    for i=1:n
        for j=1:n
            J = VBA_numericDiff(@f_HRF,1,[xg1(i);xg2(j);0;0],P,0,[]);
            lm(i,j) = max(real(eig(J)));
        end
    end

    % get separatrix
    stab = zeros(n,n);
    stab(lm>=0) = -1;
    L = del2(stab);
    sep = zeros(n,n);
    sep(L<0)=1;
    p = length(find(L==1));
    y = [];
    for i=1:n
        for j=1:n
            if sep(i,j)==1
                y = [y,[xg1(i);xg2(j)]];
            end
        end
    end
    g_fname = @g_exp;
    options.inG.x = y(2,:)';
    options.priors.muPhi = [1;1;0];
    options.priors.SigmaPhi = eye(3);
    options.priors.SigmaPhi(1,1) = 0;
    options.priors.SigmaPhi(3,3) = 0;
    options.verbose = 0;
    options.DisplayWin = 0;
    dim.n_theta         = 0;
    dim.n_phi           = 3;
    dim.n               = 0;
    [posterior,out] = VBA_NLStateSpaceModel(y(1,:)',[],[],g_fname,dim,options);

catch

    % loop over different kas/kaf
    phi = zeros(length(kaf),length(kas));
    for k=1:length(kas)
        for l=1:length(kaf)
            k,l
            % get max eigenvalue
            P = [0;0;kaf(l);kas(k);0;0];
            for i=1:n
                for j=1:n
                    J = VBA_numericDiff(@f_HRF,1,[xg1(i);xg2(j);0;0],P,0,[]);
                    lm(i,j) = max(real(eig(J)));
                end
            end

            % get separatrix
            stab = zeros(n,n);
            stab(lm>=0) = -1;
            L = del2(stab);
            sep = zeros(n,n);
            sep(L<0)=1;
            p = length(find(L==1));
            y = [];
            for i=1:n
                for j=1:n
                    if sep(i,j)==1
                        y = [y,[xg1(i);xg2(j)]];
                    end
                end
            end
            g_fname = @g_exp;
            options.inG.x = y(2,:)';
            options.priors.muPhi = [1;1;0];
            options.priors.SigmaPhi = eye(3);
            options.priors.SigmaPhi(1,1) = 0;
            options.priors.SigmaPhi(3,3) = 0;
            options.verbose = 0;
            options.DisplayWin = 0;
            dim.n_theta         = 0;
            dim.n_phi           = 3;
            dim.n               = 0;
            [posterior,out] = VBA_NLStateSpaceModel(y(1,:)',[],[],g_fname,dim,options);
            phi(l,k) = posterior.muPhi(2);

        end
    end

end

% store for display purposes
x = options.inG.x;
gx = out.suffStat.gx;
PHI = posterior.muPhi;

gkaf = kron(ones(1,length(kas)),kaf)';
gkaf = gkaf - mean(gkaf);
gkas = kron(kas,ones(1,length(kaf)))';
gkas = gkas - mean(gkas);
options = [];
g_fname = @g_exp2d;
options.inG.gkaf = gkaf;
options.inG.gkas = gkas;
options.priors.muPhi = ones(1,1);
options.priors.SigmaPhi = 1e4*eye(1);
options.verbose = 1;
options.DisplayWin = 1;
dim.n_theta         = 0;
dim.n_phi           = 1;
dim.n               = 0;
[posterior,out] = VBA_NLStateSpaceModel(...
    phi(:),[],[],g_fname,dim,options);
I = reshape(out.suffStat.gx,length(kaf),length(kas));

% display results

hf = figure('color',[1 1 1],'position',[649,40,767,1105],'menubar','none');
ha = subplot(3,2,1,'parent',hf);
hi = imagesc(flipud(lm),'parent',ha);
xlabel(ha,'x2: blood inflow')
ylabel(ha,'x1: vasodilatory signal')
title(ha,'max eigenvalue')
colorbar('peer',ha);

ha = subplot(3,2,2,'parent',hf);
hi = plot(y(2,:),y(1,:),'.','parent',ha);
xlabel(ha,'x2: blood inflow')
ylabel(ha,'x1: vasodilatory signal')
set(ha,...
    'xlim',[min(xg1),max(xg1)],...
    'ylim',[min(xg1),max(xg1)],...
    'nextplot','add')
axis(ha,'square')
grid(ha,'on')
title(ha,...
    ['separatrix: kas=',...
    num2str(P(4)),...
    ' ; kaf=',...
    num2str(P(3))])
set(ha,'nextplot','add')
[xs,is] = sort(x);
ys = gx(is);
plot(ha,xs,ys,'k','parent',ha)
plot(0,0,'r+','parent',ha);
str = ['x(1) = ',...
    'theta',...
    '*exp(',...
    'x(2)) : theta = ',...
    num2str(PHI(2))];
legend(ha,{'numerical',str,'equilibrium'})

ha = subplot(3,2,3,'parent',hf);
hi = imagesc(phi,'parent',ha);
colorbar('peer',ha);
xlabel(ha,'kas')
ylabel(ha,'kaf')
title('separatrix parameter (theta)')

ha = subplot(3,2,4,'parent',hf);
hi = plot(kas,phi','parent',ha);
xlabel(ha,'kas')
ylabel(ha,'separatrix parameter (theta)')
grid(ha,'on');
axis(ha,'tight')
for i=1:length(kaf)
    leg{i} = ['kaf=',num2str(kaf(i))];
end
legend(ha,leg)
title(ha,'separatrix parameter (theta)')

ha = subplot(3,2,5,'parent',hf);
hi = imagesc(I,'parent',ha);
colorbar('peer',ha);
xlabel(ha,'kas')
ylabel(ha,'kaf')
title('fitted separatrix parameter (theta)')

ha = subplot(3,2,6,'parent',hf);
hi = plot(phi(:),I(:),'k.','parent',ha);
mi = min([phi(:);I(:)]);
ma = max([phi(:);I(:)]);
set(ha,'nextplot','add')
plot(ha,[mi ma],[mi ma],'r')
xlabel(ha,'sep param')
ylabel(ha,'fitted sep param (theta)')
title('sep param model fit')

str = ['theta = ',...
    num2str(posterior.muPhi(1)),...
    '*exp(kaf/2 - |kas-kaf/2|)'];
legend(ha,{'numerical',str})
grid(ha,'on');
set(ha,'xlim',[mi ma],'ylim',[mi ma])


%DEMO_SPATIAL2  Demonstration for a disease mapping problem with Gaussian
%               process prior and negative binomial observation
%               model
%
%  Description
%    The disease mapping problem consist of a data with number of
%    death cases, Y, and background population, N, appointed to
%    co-ordinates, X. The goal is to find a relative risk surface,
%    which describes if the number of death cases in certain areas
%    is lower or higher than expected. The data is simulated.
%
%    The model is constructed as follows:
%
%    The number of death cases Y_i in area i is assumed to satisfy
%
%         Y_i ~ Neg-Bin(Y_i| d, E_i * r_i)
%
%    where E_i is the expected number of deaths (see Vanhatalo and
%    Vehtari (2007), how E_i is evaluated) at area i, r_i is the
%    relative risk and d is the dispersion parameter coverning the
%    variance.
%
%    We place a zero mean Gaussian process prior for log(R), R =
%    [r_1, r_2,...,r_n], which implies that at the observed input
%    locations latent values, f, have prior
%
%         f = log(R) ~ N(0, K),
%
%    where K is the covariance matrix, whose elements are given as
%    K_ij = k(x_i, x_j | th). The function k(x_i, x_j | th) is
%    covariance function and th its parameters. We place a prior
%    for parameters, p(th).
%
%    The inference is conducted first with Laplace approximation
%    and then with EP. We use compactly supported covariance
%    function which leads to sparse covariance matrix.
%
%  See also
%    DEMO_REGRESSION1, DEMO_CLASSIFIC1, DEMO_SPATIAL1
%
% Copyright (c) 2008-2010 Jarno Vanhatalo
% Copyright (c) 2010 Aki Vehtari

% This software is distributed under the GNU General Public
% License (version 3 or later); please refer to the file
% License.txt, included with the software, for details.

% =====================================
% Laplace approximation
% =====================================

% load the data
S = which('demo_spatial2');
data = load(strrep(S,'demo_spatial2.m','demodata/spatial2.txt'));

x = data(:,1:2);
ye = data(:,3);
y = data(:,4);

% Now we have loaded the following parameters
% x = co-ordinates
% y = number of deaths
% ye = the expexted number of deaths

fprintf(['GP with negative-binomial observation model, Laplace\n' ...
         'integration over the latent values and MAP estimate\n' ...
         'for the parameters\n']);

% Create the covariance functions
pl = prior_t();
pm = prior_sqrtt('s2', 0.3);
if ~exist('ldlchol')
  warning('GPstuff:SuiteSparseMissing',...
    ['SuiteSparse is not properly installed. \n' ...
    'Using gpcf_sexp (non-compact support) instead of gpcf_ppcs2 (compact support)']);
  gpcf1 = gpcf_sexp('lengthScale', 5, 'magnSigma2', 0.05);
  gpcf1 = gpcf_sexp(gpcf1, 'lengthScale_prior', pl, 'magnSigma2_prior', pm);
else
  gpcf1 = gpcf_ppcs2('nin', 2, 'lengthScale', 5, 'magnSigma2', 0.05);
  gpcf1 = gpcf_ppcs2(gpcf1, 'lengthScale_prior', pl, 'magnSigma2_prior', pm);
end

% Create the likelihood structure
lik = lik_negbin();

% Create the GP structure
gp = gp_set('lik', lik, 'cf', gpcf1, 'jitterSigma2', 1e-4);

% Set the approximate inference method to Laplace
gp = gp_set(gp, 'latent_method', 'Laplace');

% Set the options for the scaled conjugate optimization
opt=optimset('TolFun',1e-2,'TolX',1e-2,'Display','iter');
% Optimize with the scaled conjugate gradient method
gp=gp_optim(gp,x,y,'z',ye,'opt',opt);

% Visualize sparsity pattern
figure
C = gp_trcov(gp,x);
fprintf('Proportion of non-zeros is %.4f\n',nnz(C) / prod(size(C)))
p = amd(C);
spy(C(p,p))

% Make prediction to the data points
[Ef, Varf] = gp_pred(gp, x, y, x, 'z', ye);

% Define help parameters for plotting
xii=sub2ind([120 70],x(:,2),x(:,1));
[X1,X2]=meshgrid(1:70,1:120);

% Plot the figures
figure
G=repmat(NaN,size(X1));
G(xii)=exp(Ef);
pcolor(X1,X2,G),shading flat
colormap(mapcolor(G)),colorbar
set(gca, 'Clim', [0.2    1.5])
axis equal
axis([0 70 0 120])
title('Posterior median of the relative risk (Laplace)')

figure
G=repmat(NaN,size(X1));
G(xii)=(exp(Varf) - 1).*exp(2*Ef+Varf);
pcolor(X1,X2,G),shading flat
colormap(mapcolor(G)),colorbar
%set(gca, 'Clim', [0.005    0.03])
axis equal
axis([0 70 0 120])
title('Posterior variance of the relative risk (Laplace)')

% =====================================
% EP approximation
% =====================================
fprintf(['GP with negative-binomial observation model, EP\n' ...
         'integration over the latent values and MAP estimate\n' ...
         'for the parameters\n']);

% Set the approximate inference method to EP
gp = gp_set(gp, 'latent_method', 'EP');

% Set the options for the scaled conjugate optimization
opt=optimset('TolFun',1e-2,'TolX',1e-2,'Display','iter');
% Optimize with the scaled conjugate gradient method
gp=gp_optim(gp,x,y,'z',ye,'opt',opt);

% Visualize sparsity pattern
figure
C = gp_trcov(gp,x);
fprintf('Proportion of non-zeros is %.4f\n',nnz(C) / prod(size(C)))
p = amd(C);
spy(C(p,p))

% make prediction to the data points
[Ef, Varf] = gp_pred(gp, x, y, x, 'z', ye);

% Define help parameters for plotting
xii=sub2ind([120 70],x(:,2),x(:,1));
[X1,X2]=meshgrid(1:70,1:120);

% Plot the figures
figure
G=repmat(NaN,size(X1));
G(xii)=exp(Ef);
pcolor(X1,X2,G),shading flat
colormap(mapcolor(G)),colorbar
set(gca, 'Clim', [0.2    1.5])
axis equal
axis([0 70 0 120])
title('Posterior median of the relative risk (EP)')

figure
G=repmat(NaN,size(X1));
G(xii)=(exp(Varf) - 1).*exp(2*Ef+Varf);
pcolor(X1,X2,G),shading flat
colormap(mapcolor(G)),colorbar
%set(gca, 'Clim', [0.005    0.03])
axis equal
axis([0 70 0 120])
title('Posterior variance of the relative risk (EP)')