%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Released under the MIT License.
% If you use this code, please cite the following paper:
% Mahmoud Afifi, Abdelrahman Abdelhamed, Abdullah Abuolaim, Abhijith
% Punnappurath, and Michael S Brown. CIE XYZ Net: Unprocessing Images for
% Low-Level Computer Vision Tasks. arXiv preprint, 2020.
%
% Author: Mahmoud Afifi | Email: mafifi@eecs.yorku.ca, m.3afifi@gmail.com
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

classdef mae_cos_LossLayer < nnet.layer.RegressionLayer
    properties
        scale
    end
    methods
        function layer = mae_cos_LossLayer(name, scaleFactor)
            layer.Name = name;
            layer.Description = ...
                'Mean abs error + (negative) cos similarity';
            layer.scale = scaleFactor;
        end

        function loss = forwardLoss(layer, Y, T)
            % Calculate MAE + (negative) cos similarity.
            Y(Y<0) = 0;

            sz = size(Y);
            if length(sz) == 3
                R = 1;
                mae_srgb = sum(reshape(abs(Y(:,:,4:6) - T(:,:,4:6)),...
                    [],3),2);
                mae_xyz = sum(reshape(abs(Y(:,:,1:3) - T(:,:,1:3)),...
                    [],3),2);

                % compute cosine simialrity
                cosSim_srgb = zeros(size(mae_srgb), 'like', Y);
                cosSim_xyz = zeros(size(mae_xyz), 'like', Y);

                y_srgb = reshape(Y(:,:,3:6),[],3);
                t_srgb = reshape(T(:,:,4:6),[],3);
                y_xyz = reshape(Y(:,:,1:3),[],3);
                t_xyz = reshape(T(:,:,1:3),[],3);

                cosSim_srgb = cosSim_srgb + sum(y_srgb.*t_srgb,2)./...
                    (sqrt(sum(y_srgb.^2,2)) .* ...
                    sqrt(sum(t_srgb.^2,2)) + eps);

                cosSim_xyz = cosSim_xyz + sum(y_xyz.*t_xyz,2)./...
                    (sqrt(sum(y_xyz.^2,2)) .* ...
                    sqrt(sum(t_xyz.^2,2)) + eps);

            else
                R = sz(4);
                mae_srgb = zeros(sz(1)*sz(2),1,'like',Y);
                cosSim_srgb = zeros(size(mae_srgb),'like',mae_srgb);

                mae_xyz = zeros(sz(1)*sz(2),1,'like',Y);
                cosSim_xyz = zeros(size(mae_xyz),'like',mae_xyz);

                for j = 1 : R

                    mae_srgb = mae_srgb + sum(reshape( ...
                        abs(Y(:,:,4:6,j) - T(:,:,4:6,j)) ,...
                        [],3),2);
                    mae_xyz = mae_xyz + sum(reshape( ...
                        abs(Y(:,:,1:3,j) - T(:,:,1:3,j)) ,...
                        [],3),2);

                    % compute cosine simialrity
                    y_srgb = reshape(Y(:,:,4:6),[],3);
                    t_srgb = reshape(T(:,:,4:6),[],3);
                    y_xyz = reshape(Y(:,:,1:3),[],3);
                    t_xyz = reshape(T(:,:,1:3),[],3);

                    cosSim_srgb = cosSim_srgb + sum(y_srgb.*t_srgb,2)./...
                        (sqrt(sum(y_srgb.^2,2)) .* ...
                        sqrt(sum(t_srgb.^2,2)) + eps);

                    cosSim_xyz = cosSim_xyz + sum(y_xyz.*t_xyz,2)./...
                        (sqrt(sum(y_xyz.^2,2)) .* ...
                        sqrt(sum(t_xyz.^2,2)) + eps);
                end
            end

            loss = (sum(mae_srgb - cosSim_srgb) + ...
                layer.scale * sum(mae_xyz - cosSim_xyz))/R;

        end
    end
end


function [y] = local2globalPosM(x, X)

% SYNTAX:
%   [y] = local2globalPos(x, X);
%
% INPUT:
%   x = local position vector(s)
%   X = origin vector(s)
%
% OUTPUT:
%   y = global position vector(s)
%
% DESCRIPTION:
%   Rototraslation from local-level reference frame to Earth-fixed reference frame

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

%initialize new position vector
y = zeros(size(x));

    %geodetic coordinates
    [phi, lam] = cart2geod(X(1,i), X(2,i), X(3,i));

    %rotation matrix from global to local reference system
    R = [-sin(lam) cos(lam) 0;
         -sin(phi)*cos(lam) -sin(phi)*sin(lam) cos(phi);
         +cos(phi)*cos(lam) +cos(phi)*sin(lam) sin(phi)];

    %rototraslation
    %y(:,i) = R\x(:,i) + X(:,i);
    y = R * x' + X;

end


function [U,N,Y] = exterior_skinning_modes(V,D,H,M,k)
  % EXTERIOR_SKINNING_MODES Perform modal analysis on H,M within the subspace
  % where vertices in "linear blend skinning handle" selected by D of a mesh with
  % vertices V deform affinely.
  %
  % [U,N,Y,H,M] = exterior_skinning_modes(V,D,H,M,k)
  %
  % Inputs:
  %   V  #V by dim
  %   D  #V by #H bone-handle incidence matrix D(i,j) = 1 means vertex i belongs
  %     to bone j
  %   H  #V*dim by #V*dim stiffness matrix
  %   M  #V*dim by #V*dim mass matrix
  %   k  number of eigen modes to compute
  % Outputs:
  %   U  #V*3 by k list of eigen modes in the "maximal" space
  %   N  #V*3 by #N subspace reduction matrix
  %   Y  #N by k list of subspace modes so that U = N * Y
  %
  % Example:
  %   H = arap_hessian(V,F);
  %   M = repdiag(massmatrix(V,F),3);
  %   [~,N,Y] = exterior_skinning_modes(V,D,H,M,20);
  %

  assert(max( sum(D,2) == 1));
  assert(all( any(D,1) ));
  n = size(V,1);
  dim = size(V,2);
  assert(size(H,1) == n*dim);
  assert(size(M,1) == n*dim);
  assert(k <= n);

  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  % Build the null-space so that V = N * Y
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  int = find(~any(D,2));
  b = find(any(D,2));
  ni = numel(int);
  m = size(D,2);
  S = sparse(lbs_matrix(V(b,:),D(b,:)));
  NI = speye(dim*ni,dim*ni+size(S,2));
  vec = @(X) X(:);
  b3 = vec(b+(0:dim-1)*n);
  int3 = vec(int+(0:dim-1)*n);
  N = sparse(int3,1:numel(int)*dim,1,n*dim,dim*ni+size(S,2));
  N(b3,:) = [sparse(dim*(n-ni),dim*ni) S];

  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  % Test that applying identity transformations to handles produces V
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  %Astack = repmat([eye(3,3) zeros(3,1)],[1 1 m]);
  %% collect transformations into column
  %A = reshape(permute(Astack,[3 1 2]),m*3*(3+1),1);
  %Y = [reshape(V(int,:),[],1);A];
  %tsurf(F,reshape(N*Y,[],3),'CData',1*any(D,2),fphong)
  %axis equal;
  %view(90,0);

  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  % Handle constrained Eigen Decomposition
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  % wow, this symmetrization is important...
  smash = @(A,P) 0.5*(P'*A*P + (P'*A*P)');
  [Y,YD] = eigs(-0.5*smash(H,N),0.5*smash(M,N),k,'sm');

  U = N*Y;
end


function a = acosh(a)
%ACOSH        Gradient inverse hyperbolic cosine acosh(a)
%

% written  10/16/98     S.M. Rump
% modified 10/14/00     S.M. Rump  use Tony's trick
% modified 03/22/04     S.M. Rump  correction for complex input
% modified 04/04/04     S.M. Rump  set round to nearest for safety
%                                    accelaration for sparse input
% modified 04/06/05     S.M. Rump  rounding unchanged
% modified 09/28/08     S.M. Rump  check for rounding to nearest improved
% modified 10/08/08     S.M. Rump  improved sparse multiplication: not using intval data type
% modified 08/26/12     S.M. Rump  global variables removed
%

  e = 1e-30;
  if 1+e==1-e                           % fast check for rounding to nearest
    rndold = 0;
  else
    rndold = getround;
    setround(0)
  end

  N = getappdata(0,'INTLAB_GRADIENT_NUMVAR');

  wng = warning;
  warning off

  % use full(a.x(:)): cures Matlab V6.0 bug
  % a=7; i=[1 1]; x=a(i), b=sparse(a); y=b(i)  yields row vector x but column vector y
  % ax is full anyway
  ax = full(a.x(:));
  ax = 1 ./ ( sqrt( ax-1 ) .* sqrt( ax+1 ) );
  a.x = acosh(a.x);
  if issparse(a.dx)
    sizeax = size(a.dx,1);
    [ia,ja,sa] = find(a.dx);
    if isa(a.x,'intval')
      adx = times(ax(ia),sa,0);
      if adx.complex
        a.dx = intval( sparse(ia,ja,adx.mid,sizeax,N) , sparse(ia,ja,adx.rad,sizeax,N) , 'midrad' );
      else
        a.dx = intval( sparse(ia,ja,adx.inf,sizeax,N) , sparse(ia,ja,adx.sup,sizeax,N) , 'infsup' );
      end
    else
      a.dx = sparse(ia,ja,ax(ia).*sa,sizeax,N);
    end
  else
    a.dx = a.dx .* ax(:,ones(1,N));
  end

  warning(wng)

  if rndold
    setround(rndold)
  end


function [prob,sol,fmin] = nls_prob(varargin)
%NLS_PROB  Return an OPTI NLS
%
%   prob = nls_prob(no) return a pre-built optiprob of a saved NLS.
%
%   [prob,sol,fmin] = NLS_prob(no) returns the optimum solution and function
%   eval at the optimum
%
%   no = nls_prob() returns the number of problems available for testing.

%   (C) 2012 Jonathan Currie (I2C2)

% Functions are taken from:
% More, J. J., B. S. Garbow, and K. E. Hillstrom. "Testing Unconstrained
% Optimization Software." ACM Transactions on Mathematical Software 7,
% no. 1 (1981): 17-41.

%Check if just returning no problems
if(nargin < 1)
    prob = 20; sol = []; fmin = [];
    return;
else
    no = varargin{1};
end

%Big switch yard
switch(no)
    case 1
        fun = @(x) [10*(x(2)-x(1)^2); 1 - x(1)];
        ydata = zeros(2,1);
        x0 = [-1.2;1];
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [1,1];
        fmin = 0;

    case 2
        fun = @(x) [-13 + x(1) + ((5 - x(2))*x(2) - 2)*x(2);
                    -29 + x(1) + ((x(2) + 1)*x(2) - 14)*x(2)];
        ydata = zeros(2,1);
        x0 = [0.5;-2];
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [5,4];
        fmin = 0;

    case 3
        fun = @(x) [1e4*x(1)*x(2) - 1;
                    exp(-x(1)) + exp(-x(2)) - 1.0001];
        ydata = zeros(2,1);
        x0 = [0;1];
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [1.098e-5;9.106];
        fmin = 0;

    case 4
        fun = @(x) [x(1) - 1e6; x(2) - 2e-6; x(1)*x(2) - 2];
        ydata = zeros(3,1);
        x0 = [1;1];
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [1e6,2e-6];
        fmin = 0;

    case 5
        fun = @(x) [1.5 - x(1)*(1 - x(2)); 2.25 - x(1)*(1 - x(2)^2); 2.625 - x(1)*(1 - x(2)^3) ];
        ydata = zeros(3,1);
        x0 = [1;1];
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [3;0.5];
        fmin = 0;

    case 6
        i = (1:10)';
        fun = @(x) 2 + 2*i - (exp(0.2578*i) + exp(0.2578*i));
        ydata = zeros(10,1);
        x0 = [0.3;0.4];
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [0.2578;0.2578];
        fmin = 124.36226865;

    case 7
        fun = @more7;
        ydata = zeros(3,1);
        x0 = [-1;0;0];
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [1;0;0];
        fmin = 0;

    case 8
        u = (1:15)';
        v = 16 - u;
        w = zeros(15,1);
        for i = 1:15
            w(i) = min(u(i),v(i));
        end
        y = [0.14;0.18;0.22;0.25;0.29;0.32;0.35;0.39;0.37;0.58;0.73;0.96;1.34;2.10;4.39];
        fun = @(x) (x(1) + u ./ (v*x(2) + w*x(3)));
        x0 = [1;1;1];
        prob = optiprob('fun',fun,'ydata',y,'x0',x0);
        sol = [];
        fmin = 8.21487e-3;

    case 9
        i = (1:15)';
        y = [0.0009;0.0044;0.0175;0.0540;0.1295;0.2420;0.3521;0.3989;0.3521;0.2420;0.1295;0.0540;0.0175;0.0044;0.0009];
        t = (8 - i)./2;
        fun = @(x) x(1)*exp((-x(2)*(t - x(3)).^2)./2);
        x0 = [0.4;1;0];
        prob = optiprob('fun',fun,'ydata',y,'x0',x0);
        sol = [];
        fmin = 1.12793e-8;

    case {10,11}
        i = (1:16)';
        y = [34780;28610;23650;19630;16370;13720;11540;9744;8261;7030;6005;5147;4427;3820;3307;2872];
        t = 45 + 5*i;
        fun = @(x) x(1)*exp(x(2)./(t + x(3)));
        x0 = [0.02;4000;250];
        prob = optiprob('fun',fun,'ydata',y,'x0',x0);
        sol = [];
        fmin = 87.9458;

%     case 11 %not working??
%         m = 100;
%         i = [1:m]';
%         t = i./100;
%         y = 25 + (-50 * log(t)).^(2/3);
%         fun = @(x) exp(-(abs(y*100.*i*x(2)).^x(3))./x(1)) - t;
%         x0 = [5;2.5;0.15];
%         ydata = zeros(m,1);
%         prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
%         sol = [50;25;1.5];
%         fmin = 0;

    case 12
        m = 3;
        i = (1:m)';
        t = 0.1*i;
        fun = @(x) exp(-t*x(1)) - exp(-t*x(2)) - x(3)*exp(-t) - exp(-10*t);
        x0 = [0;10;20];
        ydata = zeros(m,1);
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [1;10;1];
        fmin = 0;

    case 13
        fun = @(x) [x(1) + 10*x(2);
                    sqrt(5)*(x(3) - x(4));
                    (x(3) - 2*x(3))^2;
                    sqrt(10)*(x(1)-x(4))^2];
        x0 = [3;-1;0;1];
        ydata = zeros(4,1);
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [0;0;0;0];
        fmin = 0;

    case 14
        fun = @(x) [10*(x(2)-x(1)^2);
                    1 - x(1);
                    sqrt(90)*(x(4)-x(3)^2);
                    1 - x(3);
                    sqrt(10)*(x(2) + x(4) - 2);
                    10^(-0.5)*(x(2)-x(4))];
        x0 = [3;-1;-3;-1];
        ydata = zeros(6,1);
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [1;1;1;1];
        fmin = 0;

    case 15
        y = [0.1957;0.1947;0.1735;0.16;0.0844;0.0627;0.0456;0.0342;0.0323;0.0235;0.0246];
        u = [4;2;1;0.5;0.25;0.167;0.125;0.1;0.0833;0.0714;0.0625];
        fun = @(x) (x(1)*(u.^2 + u*x(2))) ./ (u.^2 + u*x(3) + x(4));
        x0 = [0.25;0.39;0.415;0.39];
        prob = optiprob('fun',fun,'ydata',-y,'x0',x0);
        sol = [];
        fmin = 3.07505e-4;

    case 16
        m = 20;
        i = (1:m)';
        t = i/5;
        fun = @(x) (x(1) + t*x(2) - exp(t)).^2 + (x(3) + x(4)*sin(t) - cos(t)).^2;
        x0 = [25;5;-5;-1];
        ydata = zeros(m,1);
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [];
        fmin = 85822.2016;

    case 17
        m = 33;
        i = (1:m)';
        t = 10*(i - 1);
        y = [0.844;0.908;0.932;0.936;0.925;0.908;0.881;0.850;0.818;0.784;0.751;0.718;0.685;0.658;0.628;0.603;...
             0.58;0.558;0.538;0.522;0.506;0.490;0.478;0.467;0.457;0.448;0.438;0.431;0.424;0.42;0.414;0.411;0.406];
        fun = @(x) (x(1) + x(2)*exp(-t*x(4)) + x(3)*exp(-t*x(5)));
        x0 = [0.5;1.5;-1;0.01;0.02];
        prob = optiprob('fun',fun,'ydata',-y,'x0',x0);
        sol = [];
        fmin = 5.46489e-5;

    case 18
        m = 13;
        i = (1:m)';
        t = 0.1*i;
        y = exp(-t) - 5*exp(-10*t) + 3*exp(-4*t);
        fun = @(x) x(3)*exp(-t*x(1)) - x(4)*exp(-t*x(2)) + x(6)*exp(-t*x(5));
        x0 = [1;2;1;1;1;1];
        prob = optiprob('fun',fun,'ydata',y,'x0',x0);
        sol = [];
        fmin = 0; %5.65565e-3; seems wrong?

    case 19
        m = 65;
        i = (1:m)';
        t = (i-1)/10;
        y = [1.366;1.191;1.112;1.013;0.991;0.885;0.831;0.847;0.786;0.725;0.746;0.679;0.608;0.655;0.616;0.606;0.602;0.626;0.651;0.724;0.649;0.649;...
            0.694;0.644;0.624;0.661;0.612;0.558;0.533;0.495;0.5;0.423;0.395;0.375;0.372;0.391;0.396;0.405;0.428;0.429;0.523;0.562;0.607;0.653;...
            0.672;0.708;0.633;0.668;0.645;0.632;0.591;0.559;0.597;0.625;0.739;0.710;0.729;0.720;0.636;0.581;0.428;0.292;0.162;0.098;0.054];
        fun = @(x) (x(1)*exp(-t*x(5)) + x(2)*exp(-(t-x(9)).^2*x(6)) + x(3)*exp(-(t-x(10)).^2*x(7)) + x(4)*exp(-(t-x(11)).^2*x(8)));
        x0 = [1.3;0.65;0.65;0.7;0.6;3;5;7;2;4.5;5.5];
        prob = optiprob('fun',fun,'ydata',y,'x0',x0);
        sol = [];
        fmin = 4.01377e-2;

    case 20
        m = 31; n = 12;
        fun = @more20;
        x0 = zeros(n,1);
        ydata = zeros(m,1);
        prob = optiprob('fun',fun,'ydata',ydata,'x0',x0);
        sol = [];
        fmin = 4.72238e-10;

    otherwise
        error('Problem not available or not implemented yet');
end

function j = more7(x)

if(x(1) > 0)
    theta = 1/(2*pi)*atan(x(2)/x(1));
else
    theta = 1/(2*pi)*atan(x(2)/x(1)) + 0.5;
end

j(1,1) = 10*(x(3) - 10*theta);
j(2,1) = 10*(x(1)^2 + x(2)^2)^0.5 - 1;
j(3,1) = x(3);

function f = more20(x)
n = length(x);
j = (2:n)';
j2 = (1:n)';
t = 0.1*(1:29)';
f = zeros(31,1);
for k = 1:29
    f(k) = sum( (j-1).*x(2:end).*t(k).^(j-2) ) - sum( x.*t(k).^(j2-1) ) - 1;
end
f(30) = x(1);
f(31) = x(2) - x(1)^2 - 1;


% SOLVE_KIRCHHOFF_LOVE_SHELL: Solve the Kirchhoff-Love shell model in a NURBS domain.
%
% USAGE:
%
%  [geometry, msh, space, u] = solve_kirchhoff_love_shell (problem_data, method_data)
%
% INPUT:
%
%  problem_data: a structure with data of the problem. It contains the fields:
%    - geo_name:     name of the file containing the geometry
%    - drchlt_sides: sides with Dirichlet boundary condition
%    - drchlt_components: cell-array, the components that are set to zero for each drchlt_side
%    - E_coeff:      function handle for Young's modulus
%    - nu_coeff:     function handle for Poisson's ratio
%    - thickness:    scalar value, thickness of the shell
%    - f:            source term, distributed load
%
%  method_data : a structure with discretization data. Its fields are:
%    - degree:     degree (>=2) of the spline functions.
%    - regularity: continuity (>=1) of the spline functions.
%    - nsub:       number of subelements with respect to the geometry mesh
%                   (nsub=1 leaves the mesh unchanged)
%    - nquad:      number of points for Gaussian quadrature rule
%
% OUTPUT:
%
%  geometry: geometry structure (see geo_load)
%  msh:      mesh object that defines the quadrature rule (see msh_cartesian)
%  space:    space object that defines the discrete basis functions (see sp_vector)
%  u:        the computed degrees of freedom
%
% NOTE: only homogeneous Dirichlet conditions implemented so far
%
% See also EX_KL_SHELL_SCORDELIS_LO_ROOF for an example.
%
% Copyright (C) 2017-2019 Pablo Antolin, Luca Coradello, 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 this program.  If not, see <http://www.gnu.org/licenses/>.

function [geometry, msh, space, u] = solve_kirchhoff_love_shell (problem_data, method_data)

% Extract the fields from the data structures into local variables
data_names = fieldnames (problem_data);
for iopt  = 1:numel (data_names)
  eval ([data_names{iopt} '= problem_data.(data_names{iopt});']);
end
data_names = fieldnames (method_data);
for iopt  = 1:numel (data_names)
  eval ([data_names{iopt} '= method_data.(data_names{iopt});']);
end

if (any(degree <= 1) || any(regularity == 0))
  error ('The degree must be at least two, and the regularity at least C^1')
end

geometry = geo_load (geo_name);
degelev  = max (degree - (geometry.nurbs.order-1), 0);
nurbs    = nrbdegelev (geometry.nurbs, degelev);
[rknots, ~, nknots] = kntrefine (nurbs.knots, nsub-1, nurbs.order-1, regularity);

nurbs    = nrbkntins (nurbs, nknots);
geometry = geo_load (nurbs);

% Construct msh structure
rule     = msh_gauss_nodes (nquad);
[qn, qw] = msh_set_quad_nodes (geometry.nurbs.knots, rule);
msh      = msh_cartesian (geometry.nurbs.knots, qn, qw, geometry);

% Construct space structure
sp_scalar = sp_nurbs (geometry.nurbs, msh);
scalar_spaces = repmat ({sp_scalar}, 1, msh.rdim);
space = sp_vector (scalar_spaces, msh);

% Assemble the stiffness matrix and right-hand side
K = op_KL_shells_tp (space, space, msh, E_coeff, nu_coeff, thickness);
rhs = op_f_v_tp (space, msh, f);

u = zeros (space.ndof, 1);

% Apply boundary conditions
drchlt_dofs = [];
for iside = 1:numel(drchlt_sides)
  side = drchlt_sides(iside);
  if (~exist('drchlt_components','var'))
    components = 1:3;
  else
    components = drchlt_components{iside};
  end
  for icomp = components
    drchlt_dofs = union (drchlt_dofs, space.boundary(side).dofs(space.boundary(side).comp_dofs{icomp}));
  end
end

int_dofs = setdiff (1:space.ndof, drchlt_dofs);
%rhs(int_dofs) = rhs(int_dofs) - K(int_dofs, drchlt_dofs)*u(drchlt_dofs);

% Solve the linear system
u(int_dofs) = K(int_dofs, int_dofs) \ rhs(int_dofs);

end


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

function y = sprice_4_2_fast(a, b, r, n, f, k, t,m, mu, nu, l, u, cp)
% sabr prices using the risk neutral density psabr_4
% and integrating this density with respect to the payoff
% fast version since cumsum is applied

eps = 0.001;
nl = length(k);
y = ones(1,nl);

rr = eps/10:eps:.5;

F1 = @(x) x .* psabr_4_2(a, b, r, n, f, x, t, m, mu, nu, l, u);
F2 = @(x) psabr_4_2(a, b, r, n, f, x, t, m, mu, nu, l, u);

y1 = F1(rr);
y2 = F2(rr);

y1 = cumsum(y1(end:-1:1)); y1 = y1(end:-1:1);
y2 = cumsum(y2(end:-1:1)); y2 = y2(end:-1:1);

    % call
for j = 1:nl;
    index = find(rr>=k(j),1,'first');
    y(j) = eps*(y1(index) - k(j) * y2(index));
end

if (cp ~= 1)
     y = k - f + y;
end

end


function linpack_z_test23 ( )

%*****************************************************************************80
%
%% TEST23 tests ZPPCO.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 June 2009
%
%  Author:
%
%    John Burkardt
%
  n = 3;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST23\n' );
  fprintf ( 1, '  For a double precision complex (C)\n' );
  fprintf ( 1, '  Hermitian positive definite packed matrix (PP),\n' );
  fprintf ( 1, '  ZPPCO estimates the reciprocal condition number.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The matrix order is N = %d\n', n );
%
%  Set the values of the matrix A.
%
  a(1) = complex ( 2.5281,  0.0000 );

  a(2) = complex ( 2.1341, -0.2147 );
  a(3) = complex ( 3.0371,  0.0000 );

  a(4) = complex ( 2.4187,  0.2932 );
  a(5) = complex ( 2.0905,  1.1505 );
  a(6) = complex ( 2.7638,  0.0000 );
%
%  Estimate the condition.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Estimate the condition number.\n' );

  [ a, rcond, info ] = zppco ( a, n );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Reciprocal condition number = %f\n', rcond );

  return
end


function lambda = householder_eigenvalues ( n, x )

%*****************************************************************************80
%
%% HOUSEHOLDER_EIGENVALUES returns the eigenvalues of a HOUSEHOLDER matrix.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    31 May 2002
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of A.
%
%    Input, real X(N,1), the vector that defines the
%    Householder matrix.
%
%    Output, real LAMBDA(N,1), the eigenvalues.
%
  lambda = zeros ( n, 1 );

  x = x(:);

  lambda(1,1)   = -1.0;
  lambda(2:n,1) = +1.0;

  return
end


%% This file will be used to compare identified PDE of the SINDy-PI and ground truth.
% Code By: K
% Last Updated: 2019/06/24
%% Clear all
close all;clear all;clc;
%% Add path
[fld_status, fld_msg, fld_msgID]=mkdir('Datas');
[fld_status, fld_msg, fld_msgID]=mkdir('Figures');
addpath('Datas')
addpath('Figures')
addpath('Functions')
%% Define parameters for the simulation
% Define diffusion rate
Dx=0.01;Dz=0.01;Ds=1;Du=1;

% Others
q=0.1;f=1.5;ksi=0.3;alpha=0.3;beta=0.26;gama=0.4;ksi2=1.5;ksi3=0.003;phi=0;

% Define the time horizon
dt=0.001;T=1;
tspan=0:dt:T;

% Define the spatial domain
L=20; % Total length of each dimension
n=128; % Discretization point of each dimension
N=n*n; % Total points used, n^2

x2=linspace(-L/2,L/2,n+1); x=x2(1:n);
y=x;dx=x(2)-x(1);

kx=(2*pi/L)*[0:(n/2-1) -n/2:-1];
ky=kx;

% Get n-dimensional grid
[X,Y]=meshgrid(x,y);
[KX,KY]=meshgrid(kx,ky);
K2=KX.^2+KY.^2; K22=reshape(K2,N,1);
Kx=reshape(KX,N,1);Ky=reshape(KY,N,1);Kxx=reshape(KX,N,1);Kyy=reshape(KY,N,1);

% Create a time matrix
r_t=zeros(n,n,length(tspan));r=zeros(n,n,length(tspan));r_x=zeros(n,n,length(tspan));r_xx=zeros(n,n,length(tspan));r_y=zeros(n,n,length(tspan));r_yy=zeros(n,n,length(tspan));
z_t=zeros(n,n,length(tspan));z=zeros(n,n,length(tspan));z_x=zeros(n,n,length(tspan));z_xx=zeros(n,n,length(tspan));z_y=zeros(n,n,length(tspan));z_yy=zeros(n,n,length(tspan));
s_t=zeros(n,n,length(tspan));s=zeros(n,n,length(tspan));s_x=zeros(n,n,length(tspan));s_xx=zeros(n,n,length(tspan));s_y=zeros(n,n,length(tspan));s_yy=zeros(n,n,length(tspan));
u_t=zeros(n,n,length(tspan));u=zeros(n,n,length(tspan));u_x=zeros(n,n,length(tspan));u_xx=zeros(n,n,length(tspan));u_y=zeros(n,n,length(tspan));u_yy=zeros(n,n,length(tspan));
r_lap=zeros(n,n,length(tspan));z_lap=zeros(n,n,length(tspan));s_lap=zeros(n,n,length(tspan));u_lap=zeros(n,n,length(tspan));
%% Set a Guassian for the initial condition
r0=cos(sqrt(X.^2+Y.^2)).^2+GaussianFilter(X,Y,0.05,0.05,0,0)+GaussianFilter(X,Y,1,0.01,0,0)+GaussianFilter(X,Y,0.01,1,0,0)+GaussianFilter(X,Y,0.25,0.25,5,5)+GaussianFilter(X,Y,0.25,0.25,5,-5)+GaussianFilter(X,Y,0.25,0.25,-5,5)+GaussianFilter(X,Y,0.25,0.25,-5,-5)+0.1;
z0=sin(0.1*sqrt(X.^2+Y.^2)).^2+GaussianFilter(X,Y,0.05,0.01,0,0)+GaussianFilter(X,Y,0.25,0.25,5,5)+GaussianFilter(X,Y,0.25,0.25,5,-5)+GaussianFilter(X,Y,0.25,0.25,-5,5)+GaussianFilter(X,Y,0.25,0.25,-5,-5)+0.1;
s0=sin(sqrt(X.^2+Y.^2)).^2+GaussianFilter(X,Y,0.5,0.5,0,5)+GaussianFilter(X,Y,0.5,0.5,5,0)+GaussianFilter(X,Y,0.5,0.5,0,-5)+GaussianFilter(X,Y,0.5,0.5,-5,0)+0.1;
u0=cos(sqrt(X.^2+Y.^2)).^2+GaussianFilter(X,Y,0.5,0.01,0,0)+GaussianFilter(X,Y,0.01,0.5,0,0)+GaussianFilter(X,Y,0.25,0.25,5,5)+GaussianFilter(X,Y,0.25,0.25,5,-5)+GaussianFilter(X,Y,0.25,0.25,-5,5)+GaussianFilter(X,Y,0.25,0.25,-5,-5)+0.01;

%% Plot the initial conditions
figure(1)
surf(x,y,r0)
set(gca,'FontSize',18);
set(gcf,'Position',[100 100 600 600]);
set(gcf,'PaperPositionMode','auto');
view(-18,35)
box('off')
axis('off')

figure(2)
surf(x,y,z0)
set(gca,'FontSize',18);
set(gcf,'Position',[100 100 600 600]);
set(gcf,'PaperPositionMode','auto');
view(-18,35)
box('off')
axis('off')

figure(3)
surf(x,y,s0)
set(gca,'FontSize',18);
set(gcf,'Position',[100 100 600 600]);
set(gcf,'PaperPositionMode','auto');
view(-18,35)
box('off')
axis('off')

figure(4)
surf(x,y,u0)
set(gca,'FontSize',18);
set(gcf,'Position',[100 100 600 600]);
set(gcf,'PaperPositionMode','auto');
view(-18,35)
box('off')
axis('off')
%%
close all
% Transfer the initial guess to fourier domain
xzsu0t=[reshape(fft2(r0),1,N) reshape(fft2(z0),1,N) reshape(fft2(s0),1,N) reshape(fft2(u0),1,N)].';

%% Simulate the original equation
tic
opts = odeset('RelTol',1e-12,'AbsTol',1e-13);
NeedDev=0;
[time,xzsusol]=ode45(@(time,xzsut)BZ_Reaction_PDE(time,xzsut,Kx,Kxx,Ky,Kyy,K22,n,N,Dx,Dz,Ds,Du,q,f,ksi,alpha,beta,gama,ksi2,ksi3,phi,NeedDev),tspan,xzsu0t,opts);
toc

% Simulate the DL-SINDy discovered equation
tic
opts = odeset('RelTol',1e-12,'AbsTol',1e-13);
NeedDev=0;
[time,xzsusol_DL]=ode45(@(time,xzsut)BZ_Reaction_DL_SINDy_PDE(time,xzsut,Kx,Kxx,Ky,Kyy,K22,n,N,NeedDev),tspan,xzsu0t,opts);
toc

%% Extract values
% After simulation, we extract the derivative
NeedDev=1;

for pin=1:length(tspan)
    % Get the derivative data
    [~,r_t(:,:,pin),z_t(:,:,pin),s_t(:,:,pin),u_t(:,:,pin),r(:,:,pin),z(:,:,pin),s(:,:,pin),u(:,:,pin),r_x(:,:,pin),z_x(:,:,pin),s_x(:,:,pin),u_x(:,:,pin),r_y(:,:,pin),z_y(:,:,pin),s_y(:,:,pin),u_y(:,:,pin),r_xx(:,:,pin),z_xx(:,:,pin),s_xx(:,:,pin),u_xx(:,:,pin),r_yy(:,:,pin),z_yy(:,:,pin),s_yy(:,:,pin),u_yy(:,:,pin),r_lap(:,:,pin),z_lap(:,:,pin),s_lap(:,:,pin),u_lap(:,:,pin)]=...
        BZ_Reaction_PDE(0,xzsusol(pin,:).',Kx,Kxx,Ky,Kyy,K22,n,N,Dx,Dz,Ds,Du,q,f,ksi,alpha,beta,gama,ksi2,ksi3,phi,NeedDev);

    % Do the same for the DL-SINDy
    [~,~,~,~,~,r_DL(:,:,pin),z_DL(:,:,pin),s_DL(:,:,pin),u_DL(:,:,pin),~,~,~,~,~,~,~,~,~,~,~,~,~,~,~,~,~,~,~,~]=...
        BZ_Reaction_SINDy_PI_PDE(0,xzsusol_DL(pin,:).',Kx,Kxx,Ky,Kyy,K22,n,N,NeedDev);
end

%% Plot the result for original data
for pin=2:4
    if pin==1
        Animate=r;
        limits=[0 1];
    elseif pin==2
        Animate=z;
        limits=[0 1];
    elseif pin==3
        Animate=s;
        limits=[0 1];
    elseif pin==4
        Animate=u;
        limits=[0 1];
    end
    % Normalize it
    Dummy=Animate(:,:,1);
    Max=max(max(Dummy))
    Animate=Animate/Max;
    %
    for j=1:200:length(tspan)
        clf
        surf(x,y,Animate(:,:,j))
        colormap(cool)
        %shading interp
        %caxis([0,1])
        %Make plot propotional
        %zlim([0,1.1])
        %set(gca,'FontSize',18);
        set(gcf,'Position',[100 100 600 600]);
        set(gcf,'PaperPositionMode','auto');
        view(-18,35)
        box('off')
        axis('off')
        drawnow limitrate
    end
end

%% Plot the result for DL-SINDy simulation
for pin=2:4
    if pin==1
        Animate=r_DL;
        limits=[0 1];
    elseif pin==2
        Animate=z_DL;
        limits=[0 1];
    elseif pin==3
        Animate=s_DL;
        limits=[0 1];
    elseif pin==4
        Animate=u_DL;
        limits=[0 1];
    end
    % Normalize it
    Dummy=Animate(:,:,1);
    Max=max(max(Dummy))
    Animate=Animate/Max;
    %
    for j=1:200:length(tspan)
        clf
        surf(x,y,Animate(:,:,j))
        colormap(cool)
        %caxis([0,1])
        %Make plot propotional
        %zlim([0,1.1])
        %set(gca,'FontSize',18);
        set(gcf,'Position',[100 100 600 600]);
        set(gcf,'PaperPositionMode','auto');
        view(-18,35)
        box('off')
        axis('off')
        drawnow limitrate
    end
end


%   getBox:  Given the current state, returns a number from 1 to 162
%             designating the region of the state space encompassing the current state.
%             Returns a value of -1 if a failure state is encountered.

function box = getBox5(theta,thetaDot,x,xDot)
theta = rad2deg(theta);
thetaDot = rad2deg(thetaDot);
if (x < -2.4 || x > 2.4  || theta < -12 || theta > 12)
    box = 379;
else

if(theta>=-12 && theta<=-10)
    thetaBucket = 1;
elseif(theta>-10 && theta<=-8)
    thetaBucket = 2;
elseif(theta>-8 && theta<=-6)
    thetaBucket = 3;
elseif(theta>-6 && theta<=-4)
    thetaBucket = 4;
elseif(theta>-4 && theta<=-2)
    thetaBucket = 5;
elseif(theta>-2 && theta<=-1)
    thetaBucket = 6;
elseif(theta>-1 && theta<=0)
    thetaBucket = 7;
elseif(theta>0 && theta<=1)
    thetaBucket = 8;
elseif(theta>1 && theta<=2)
    thetaBucket = 9;
elseif(theta>2 && theta<=4)
    thetaBucket = 10;
elseif(theta>4 && theta<=6)
    thetaBucket = 11;
elseif(theta>6 && theta<=8)
    thetaBucket = 12;
elseif(theta>8 && theta<=10)
    thetaBucket = 13;
elseif(theta>10 && theta<=12)
    thetaBucket = 14;
end

if (x<-0.8&&x>=-2.4)
	xBucket = 1;
elseif (x<=0.8&&x>=-0.8)
	xBucket = 2;
elseif (x<=2.4&&x>0.8)
	xBucket = 3;
end

if (xDot<-0.5)
	xDotBucket = 1;
elseif (xDot>=-0.5&&xDot<=0.5)
	xDotBucket = 2;
else
	xDotBucket = 3;
end

if (thetaDot<-50)
	thetaDotBucket = 1;
elseif (thetaDot>=-50&&thetaDot<=50)
	thetaDotBucket = 2;
else
	thetaDotBucket = 3;
end

box = sub2ind([14,3,3,3],thetaBucket, thetaDotBucket,xBucket,xDotBucket);
end
return;


% Copyright (C) 1993-2014, 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

% Our SLAM system requires a number of components:
% * a vehicle
% * a map that defines the positions of some known landmarks in the world
% * a sensor, a range-bearing sensor in this case
% * a SLAM filter

% Creating the vehicle.  First we define the covariance of the vehicles's odometry
% which reports distance travelled and change in heading angle

V = diag([0.005, 0.5*pi/180].^2);

% then use this to create an instance of a Vehicle class
veh = Vehicle(V);

% and then add a "driver" to move it between random waypoints in a square
% region with dimensions from -10 to +10

veh.add_driver( RandomPath(10) );

% Creating the map.  The map covers a square region with dimensions from
% -10 to +10 and contains 20 randomly placed landmarks
map = Map(20, 10);

% Creating the sensor.  We firstly define the covariance of the sensor measurements
% which report distance and bearing angle
W = diag([0.1, 1*pi/180].^2);

% and then use this to create an instance of the Sensor class.
sensor = RangeBearingSensor(veh, map, W, 'animate');
% Note that the sensor is mounted on the moving robot and observes the features
% in the world so it is connected to the already created Vehicle and Map objects.

% Create the filter.  First we need to determine the initial covariance of the
% vehicle, this is our uncertainty about its pose (x, y, theta)
P0 = diag([0.005, 0.005, 0.001].^2);

% Now we create an instance of the EKF filter class
ekf = EKF(veh, V, P0, sensor, W, []);
% and connect it to the vehicle and the sensor and give estimates of the vehicle
% and sensor covariance (we never know this is practice).

% Now we will run the filter for 1000 time steps.  At each step the vehicle
% moves, reports its odometry and the sensor measurements and the filter updates
% its estimate of the vehicle's pose
ekf.run(1000);
% all the results of the simulation are stored within the EKF object

% First let's plot the map
clf; map.plot()
% and then overlay the path actually taken by the vehicle
veh.plot_xy('b');
% and then overlay the path estimated by the filter
ekf.plot_xy('r');
% which we see are pretty close

% Now let's plot the error in estimating the pose
ekf.plot_error()
% and this is overlaid with the estimated covariance of the error.

% Remember that the SLAM filter has not only estimated the robot's pose, it has
% simultaneously estimated the positions of the landmarks as well.  How well did it
% do at that task?  We will show the landmarks in the map again
map.plot();
% and this time overlay the estimated landmark (with a +) and the 3sigma
% uncertainty bounds as green ellipses
ekf.plot_map(3,'g');


%kkstats 'Compute Statistics of Data Object'
% This MatLab function was automatically generated by a converter (KhorosToMatLab) from the Khoros kstats.pane file
%
% Parameters:
% InputFile: i 'Input ', required: 'Input object'
% InputFile: igate 'Gating Input', optional: 'Gating input data object'
% OutputFile: f 'ASCII Output ', optional: 'Formatted ASCII output file'
% OutputFile: o 'Binary Output', optional: 'Binary output statistics file'
% Toggle: whole 'Whole Data Set', default: 0: 'compute single set of statistics for entire data set'
% Toggle: w 'Width ', default: 0: 'include width in processing unit'
% Toggle: h 'Height ', default: 0: 'include height in processing unit'
% Toggle: d 'Depth ', default: 0: 'include depth in processing unit'
% Toggle: t 'Time ', default: 0: 'include time in processing unit'
% Toggle: e 'Element', default: 0: 'include elements in processing unit'
% Toggle: all 'Calculate ALL Statistics', default: 0: 'compute and store all statistics information'
% Toggle: mean 'mean', default: 0: 'compute mean'
% Toggle: sum 'total integral', default: 0: 'compute total integral'
% Toggle: var 'variance', default: 0: 'compute variance'
% Toggle: wmin 'width coordinate', default: 0: 'store width coordinate of the minimum value'
% Toggle: psum 'pos part of integral', default: 0: 'compute positive part of integral'
% Toggle: sd 'std deviation', default: 0: 'compute standard deviation'
% Toggle: hmin 'height coordinate', default: 0: 'store height coordinate of the minimum value'
% Toggle: nsum 'neg part of integral', default: 0: 'compute negative part of integral'
% Toggle: rms 'rms', default: 0: 'compute root mean square'
% Toggle: dmin 'depth coordinate', default: 0: 'store depth coordinate of the minimum value'
% Toggle: pts 'total contributing pts', default: 0: 'compute total number of contributing points'
% Toggle: skew 'skewness', default: 0: 'compute skewness'
% Toggle: tmin 'time coordinate', default: 0: 'store time coordinate of the minimum value'
% Toggle: ppts 'positive points', default: 0: 'compute number of positive contributing points'
% Toggle: kur 'kurtosis', default: 0: 'compute kurtosis'
% Toggle: emin 'elements coordinate', default: 0: 'store elements coordinate of the minimum value'
% Toggle: npts 'negative points', default: 0: 'compute number of negative contributing points'
% Toggle: minval 'minimum', default: 0: 'compute minimum value'
% Toggle: zpts 'zero points', default: 0: 'compute number of zero-valued contributing pts'
% Toggle: maxval 'maximum', default: 0: 'compute maximum value'
% Toggle: wmax 'width coordinate', default: 0: 'store width coordinate of the maximum value'
% Toggle: wsize 'data width', default: 0: 'store size of objects width dimension'
% Toggle: hmax 'height coordinate', default: 0: 'store height coordinate of the maximum value'
% Toggle: hsize 'data height', default: 0: 'store size of objects height dimension'
% Toggle: dmax 'depth coordinate', default: 0: 'store depth coordinate of the maximum value'
% Toggle: dsize 'data depth', default: 0: 'store size of objects depth dimension'
% Toggle: tmax 'time coordinate', default: 0: 'store time coordinate of the maximum value'
% Toggle: tsize 'time size', default: 0: 'store size of objects time dimension'
% Toggle: emax 'elements coordinate', default: 0: 'store elements coordinate of the maximum value'
% Toggle: esize 'elements size', default: 0: 'store size of objects elements dimension'
%
% Example: [f, o] = kkstats({i, igate}, {'i','';'igate','';'f','';'o','';'whole',0;'w',0;'h',0;'d',0;'t',0;'e',0;'all',0;'mean',0;'sum',0;'var',0;'wmin',0;'psum',0;'sd',0;'hmin',0;'nsum',0;'rms',0;'dmin',0;'pts',0;'skew',0;'tmin',0;'ppts',0;'kur',0;'emin',0;'npts',0;'minval',0;'zpts',0;'maxval',0;'wmax',0;'wsize',0;'hmax',0;'hsize',0;'dmax',0;'dsize',0;'tmax',0;'tsize',0;'emax',0;'esize',0})
%
% Khoros helpfile follows below:
%
%  PROGRAM
% kstats - Compute Statistics of Data Object
%
%  DESCRIPTION
% .I kstats
% computes the mean, variance, standard deviation, RMS level, skew, kurtosis,
% minimum value, maximum value, and integral (positive, negative, and total
% sums) of the Input data object (i).  Information such as the number of
% unmasked or ungated points (positive, negative, zero-valued, and total counts),
% the coordinates of the minimum and maximum values, and the dimensions of the
% data object are also provided.
% .so $DATAMANIP/repos/shared/man/sections/mask_stats
% .so $DATAMANIP/repos/shared/man/sections/map_force
% All statistics and information will reflect the mapping.  For example,
% if the dimensions of the data are requested (wsize, hsize, etc), kstats
% returns the dimensionality after mapping.
% .cI $DATAMANIP/repos/shared/man/sections/fail_1input
% All statistics are calculated as double, and the Binary Output data type
% is double.
%
% Location and time data do not affect the statistics calculations, and are
% not transferred to the output object.
%
% A flag can be set for each statistic and information option so that a
% subset of all available options can be calculated and stored or printed.
% The flags are mutually exclusive with the "Calculate All Statistics"
% flag (all).  (The command line flag names are: mean, var, sd, rms, skew,
% kur, minval, maxval, wmin, hmin, dmin, tmin, emin, wmax, hmax, dmax, tmax,
% emax, sum, psum, nsum, pts, ppts, npts, zpts, wsize, hsize, dsize, tsize,
% and esize.) If no flag is specified when running kstats from the command
% line, all statistics and information will be stored.
%
% Statistics are computed according to the equations given below.  In the
% equations, N is the number of samples, SUM is the sum from i=0 to i=N-1,
% and x(i) is the sample value of x at i.
%
%  "Mean (-mean)"
% mean = (1/N) * SUM(x(i))  i=0..N-1
%
%  "Variance (-var)"
% variance = (1/(N-1)) * (SUM (x(i) - mean)**2)  i=0..N-1
%
%  "Standard Deviation (-sd)"
% standard deviation = sqrt(variance)
%
%  "RMS (-rms)"
% RMS  = sqrt(1/N * SUM(x(i)**2))  i=0..N-1
%
%  "Skewness (-skew)"
% Skewness is a measure of the tendency of the deviations from the mean to be
% larger in one direction than in the other.  It is a measure of the asymmetry
% of a distribution about its mean.  A positive skew value signifies a
% distribution whose tail extends out towards more positive x, and a negative
% tail signifies a distribution whose tail extends out towards more negative x.
% Population skewness is unitless and is defined as:
% E[((x-mean)/(stddev))**3],
% where stddev is the standard deviation of the data.
% .I kstats
% computes the sample skewness as:
% skew = 1/N * SUM( ((x(i) - mean)/stddev) **3 )  i=0..N-1
% If the variance is equal to zero, skewness will be set to 0.0.
%
%  "Kurtosis"
% Kurtosis is a unitless measure of the tail heaviness of a distribution
% and is defined as:
% E[((x-mean)/(stddev))^4] - 3,
% where stddev is the standard deviation of the data.
% .I kstats
% computes the sample kurtosis as:
% kurtosis= (1/N * SUM( ((x(i) - mean)/stddev) **4)) - 3  i=0..N-1
% If the variance is equal to zero, kurtosis will be set to 0.0.
%
%  "Sums or Integrals (-sum, -psum, -nsum)"
% total integral = SUM x(i)
% positive part of integral = SUM x(i),  for all x(i) > 0
% negative part of integral = SUM x(i),  for all x(i) < 0
%
%  "Define Processing Unit"
% To support analysis of subregions within the data object, such as lines,
% planes, volumes, and vectors, an option for defining processing units, or
% regions, is provided.  These regions are defined by the settings of the
% Processing Unit options, which can be either the Whole Data Set (whole),
% or any combination of Width (w), Height (h), Depth (d), Time (t), and
% Elements (e).  Statistics for each region will be computed and printed
% separately. If none of these flags are supplied, then a single set of
% statistics will be computed for the entire data object.
%
%  "Gating Input"
% .so $DATAMANIP/repos/shared/man/sections/gate_simple
%
%  "ASCII Output"
% The "ASCII Output" (f) option allows the user to specify a device or file
% for printing the specified information in formatted ASCII.  A filename
% of # will send the output to stderr.  If neither an "ASCII Output"
% or a "Binary Output" is supplied, the formatted ASCII will automatically
% go to stdout.
%
%  "Binary Output"
% If the "Binary Output" (-o) is selected, the selected statistics and
% information are stored in as double float data in the given file.
% Each statistic is stored as an element of a N-D vector defined along the
% "elements" dimension of the output object.  N is the number of statistics
% and information specified by the user.  The order in which the information
% is stored in the statistics vector is given in the output object's comment
% attribute.
% When M sets of statistics are calculated for M multiple regions of the
% input data object (see discussion on independent region analysis above),
% the statistics vectors are incremented along the width dimension of the
% output statistics object - the output object would have a resulting
% dimensionality of width=M, elements=N (height = depth = time = 1).  For
% example, if the input data object had the dimensionality width = 256,
% height = 256, elements = 7 (depth = time = 1), and the user defined the
% analysis regions to be width-height, the output statistics object would
% have dimensionality width = 7, elements = N (height = depth = time = 1).
% Where the vector at w=0 would contain information pertaining to the first
% region (starting at w=0, h=0, d=0, t=0, e=0), the vector at w=1 would
% contain information about the second region (starting at w=0, h=0, d=0, t=0,
% e=1), and so forth.
%
%
%
%  EXAMPLES
% kstats -i object.xv -f ascii -all
%
% Will create an ASCII statitics file.  Since the -region option is not specified,
% kstats defaults to calculating statistical information for the object
% as a whole.
% kstats -i object.xv -f ascii_file -region -e
%
% Will create an ASCII statistics file. The statistical information is now
% calculated by slicing the object along the element dimension. For example,
% on a 3-band RGB color image, this would compute the statistics for each
% RGB vector.
%
%  "SEE ALSO"
%
%  RESTRICTIONS
% kstats cannot compute complex statistics at this time.  If you wish to
% process the real and imaginary components of a complex data set
% independently, first separate components using kcmplx2real.
%
% In the current implementation, the statistics are accumulated.  This
% can result in overflow.  kstats will be rewritten in the future
% to better handle large values and large data sets.
%
%  REFERENCES
%
%  COPYRIGHT
% Copyright (C) 1993 - 1997, Khoral Research, Inc. ("KRI")  All rights reserved.
%

function varargout = kkstats(varargin)
if nargin ==0
  Inputs={};arglist={'',''};
elseif nargin ==1
  Inputs=varargin{1};arglist={'',''};
elseif nargin ==2
  Inputs=varargin{1}; arglist=varargin{2};
else error('Usage: [out1,..] = kkstats(Inputs,arglist).');
end
if size(arglist,2)~=2
  error('arglist must be of form {''ParameterTag1'',value1;''ParameterTag2'',value2}')
 end
narglist={'i', '__input';'igate', '__input';'f', '__output';'o', '__output';'whole', 0;'w', 0;'h', 0;'d', 0;'t', 0;'e', 0;'all', 0;'mean', 0;'sum', 0;'var', 0;'wmin', 0;'psum', 0;'sd', 0;'hmin', 0;'nsum', 0;'rms', 0;'dmin', 0;'pts', 0;'skew', 0;'tmin', 0;'ppts', 0;'kur', 0;'emin', 0;'npts', 0;'minval', 0;'zpts', 0;'maxval', 0;'wmax', 0;'wsize', 0;'hmax', 0;'hsize', 0;'dmax', 0;'dsize', 0;'tmax', 0;'tsize', 0;'emax', 0;'esize', 0};
maxval={0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
minval={0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
istoggle=[0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1];
was_set=istoggle * 0;
paramtype={'InputFile','InputFile','OutputFile','OutputFile','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle','Toggle'};
% identify the input arrays and assign them to the arguments as stated by the user
if ~iscell(Inputs)
Inputs = {Inputs};
end
NumReqOutputs=0; nextinput=1; nextoutput=1;
  for ii=1:size(arglist,1)
  wasmatched=0;
  for jj=1:size(narglist,1)
   if strcmp(arglist{ii,1},narglist{jj,1})  % a given argument was matched to the possible arguments
     wasmatched = 1;
     was_set(jj) = 1;
     if strcmp(narglist{jj,2}, '__input')
      if (nextinput > length(Inputs))
        error(['Input ' narglist{jj,1} ' has no corresponding input!']);
      end
      narglist{jj,2} = 'OK_in';
      nextinput = nextinput + 1;
     elseif strcmp(narglist{jj,2}, '__output')
      if (nextoutput > nargout)
        error(['Output nr. ' narglist{jj,1} ' is not present in the assignment list of outputs !']);
      end
      if (isempty(arglist{ii,2}))
        narglist{jj,2} = 'OK_out';
      else
        narglist{jj,2} = arglist{ii,2};
      end

      nextoutput = nextoutput + 1;
      if (minval{jj} == 0)
         NumReqOutputs = NumReqOutputs - 1;
      end
     elseif isstr(arglist{ii,2})
      narglist{jj,2} = arglist{ii,2};
     else
        if strcmp(paramtype{jj}, 'Integer') & (round(arglist{ii,2}) ~= arglist{ii,2})
            error(['Argument ' arglist{ii,1} ' is of integer type but non-integer number ' arglist{ii,2} ' was supplied']);
        end
        if (minval{jj} ~= 0 | maxval{jj} ~= 0)
          if (minval{jj} == 1 & maxval{jj} == 1 & arglist{ii,2} < 0)
            error(['Argument ' arglist{ii,1} ' must be bigger or equal to zero!']);
          elseif (minval{jj} == -1 & maxval{jj} == -1 & arglist{ii,2} > 0)
            error(['Argument ' arglist{ii,1} ' must be smaller or equal to zero!']);
          elseif (minval{jj} == 2 & maxval{jj} == 2 & arglist{ii,2} <= 0)
            error(['Argument ' arglist{ii,1} ' must be bigger than zero!']);
          elseif (minval{jj} == -2 & maxval{jj} == -2 & arglist{ii,2} >= 0)
            error(['Argument ' arglist{ii,1} ' must be smaller than zero!']);
          elseif (minval{jj} ~= maxval{jj} & arglist{ii,2} < minval{jj})
            error(['Argument ' arglist{ii,1} ' must be bigger than ' num2str(minval{jj})]);
          elseif (minval{jj} ~= maxval{jj} & arglist{ii,2} > maxval{jj})
            error(['Argument ' arglist{ii,1} ' must be smaller than ' num2str(maxval{jj})]);
          end
        end
     end
     if ~strcmp(narglist{jj,2},'OK_out') &  ~strcmp(narglist{jj,2},'OK_in')
       narglist{jj,2} = arglist{ii,2};
     end
   end
   end
   if (wasmatched == 0 & ~strcmp(arglist{ii,1},''))
        error(['Argument ' arglist{ii,1} ' is not a valid argument for this function']);
   end
end
% match the remaining inputs/outputs to the unused arguments and test for missing required inputs
 for jj=1:size(narglist,1)
     if  strcmp(paramtype{jj}, 'Toggle')
        if (narglist{jj,2} ==0)
          narglist{jj,1} = '';
        end;
        narglist{jj,2} = '';
     end;
     if  ~strcmp(narglist{jj,2},'__input') && ~strcmp(narglist{jj,2},'__output') && istoggle(jj) && ~ was_set(jj)
          narglist{jj,1} = '';
          narglist{jj,2} = '';
     end;
     if strcmp(narglist{jj,2}, '__input')
      if (minval{jj} == 0)  % meaning this input is required
        if (nextinput > size(Inputs))
           error(['Required input ' narglist{jj,1} ' has no corresponding input in the list!']);
        else
          narglist{jj,2} = 'OK_in';
          nextinput = nextinput + 1;
        end
      else  % this is an optional input
        if (nextinput <= length(Inputs))
          narglist{jj,2} = 'OK_in';
          nextinput = nextinput + 1;
        else
          narglist{jj,1} = '';
          narglist{jj,2} = '';
        end;
      end;
     else
     if strcmp(narglist{jj,2}, '__output')
      if (minval{jj} == 0) % this is a required output
        if (nextoutput > nargout & nargout > 1)
           error(['Required output ' narglist{jj,1} ' is not stated in the assignment list!']);
        else
          narglist{jj,2} = 'OK_out';
          nextoutput = nextoutput + 1;
          NumReqOutputs = NumReqOutputs-1;
        end
      else % this is an optional output
        if (nargout - nextoutput >= NumReqOutputs)
          narglist{jj,2} = 'OK_out';
          nextoutput = nextoutput + 1;
        else
          narglist{jj,1} = '';
          narglist{jj,2} = '';
        end;
      end
     end
  end
end
if nargout
   varargout = cell(1,nargout);
else
  varargout = cell(1,1);
end
global KhorosRoot
if exist('KhorosRoot') && ~isempty(KhorosRoot)
w=['"' KhorosRoot];
else
if ispc
  w='"C:\Program Files\dip\khorosBin\';
else
[s,w] = system('which cantata');
w=['"' w(1:end-8)];
end
end
[varargout{:}]=callKhoros([w 'kstats"  '],Inputs,narglist);


function [dynpcm2] = Pa2dynpcm2(Pa)
% Convert units of pressure from pascals to dynes per centimeter squared.
% Chad A Greene 2012
dynpcm2 = Pa*10;


function out = optPriceVal(type, Price, Strike, Rate, Time, Vol, Yield, Strike2, Spread)
% OPTPRICE: Pricing function for basic and composite European options.
%
% OPTPRICE provides the means to calculate the price of certian options for
% which a closed-form solution via the Black-Scholes model is known.  It is
% meant to be called using the GUI in one of the following syntaxes:
%

% Sanitize the inputs
if any(isnan(Price(:))) || ~isnumeric(Price) || isempty(Price) || ~isreal(Price) || any(Price(:) < 0)
    error('optPriceVal:InvalidPrice', ...
        'Spot price must be a positive number')
elseif any(isnan(Strike(:))) || ~isnumeric(Strike) || isempty(Strike) || ~isreal(Strike) || any(Strike(:) < 0)
    error('optPriceVal:InvalidStrike', ...
        'Strike price must be a positive number')
elseif any(isnan(Rate(:))) ||~isnumeric(Rate) || isempty(Rate) || ~isreal(Rate) || any(Rate(:) < 0)
    error('optPriceVal:InvalidRate', ...
        'Risk free rate must be a positive number')
elseif any(isnan(Time(:))) ||~isnumeric(Time) || isempty(Time) || ~isreal(Time) || any(Time(:) < 0)
    error('optPriceVal:InvalidTime', ...
        'Time to expiration must be a positive number')
elseif any(isnan(Vol(:))) ||~isnumeric(Vol) || isempty(Vol) || ~isreal(Vol) || any(Vol(:) < 0)
    error('optPriceVal:InvalidVol', ...
        'Volatility must be a positive number')
elseif any(isnan(Yield(:))) ||~isnumeric(Yield) || isempty(Yield) || ~isreal(Yield) || any(Yield(:) < 0)
    error('optPriceVal:InvalidYield', ...
        'Yield must be a positive number')
end
% Optional sanitation of inputs, depending on the option:
switch type
    case {'Strangle', 'Bull Spread', 'Bear Spread'}
        if isnan(Strike2) || ~isnumeric(Strike2) || isempty(Strike2) || ~isreal(Strike2) || Strike2 < 0
            error('optPriceVal:InvalidStrike', ...
                'Strike price must be a positive number')
        end
    case 'Butterfly'
        if isnan(Spread) || ~isnumeric(Spread) || isempty(Spread) || ~isreal(Spread) || Spread < 0 || Spread > 1
            error('optPriceVal:InvalidSpread', ...
                'Spread must be a positive number between 0 and 1')
        end
end

switch type
    case 'Call'
        out = blsprice(Price, Strike, Rate, Time, Vol, Yield);
    case 'Put'
        [dummy, out] = blsprice(Price, Strike, Rate, Time, Vol, Yield);
    case 'Straddle'
        % A Straddle is just a Call and Put option bought at the same
        % strike price and with the same dates involved.
        [Call, Put] = blsprice(Price, Strike, Rate, Time, Vol, Yield);
        out = Call + Put;
    case 'Strangle'
        % A strangle is similar to the straddle, except that there are two
        % strike prices involved: one for the put, and the other for the
        % call.
        Call = blsprice(Price, Strike2, Rate, Time, Vol, Yield);
        [dummy, Put] = blsprice(Price, Strike, Rate, Time, Vol, Yield);
        out = Call + Put;
    case 'Bull Spread'
        % A Bull Spread is formed by buying a call option with a given
        % strike price and then selling another call option with a higher
        % strike price.
        Call1 = blsprice(Price, Strike, Rate, Time, Vol, Yield);
        Call2 = blsprice(Price, Strike2, Rate, Time, Vol, Yield);
        out = Call1 - Call2;
        % Strike2 should be larger than Strike; if not, we'll just
        % tacitly invert them rather than giving an error message.
        if Strike2 < Strike
            out = -out;
        end
    case 'Bear Spread'
        % A Bear Spread is formed by buying a call option with a given
        % strike price and then selling another call option with a lower
        % strike price.
        Call1 = blsprice(Price, Strike, Rate, Time, Vol, Yield);
        Call2 = blsprice(Price, Strike2, Rate, Time, Vol, Yield);
        out = Call2 - Call1;
        % Strike2 should be larger than Strike; if not, we'll just
        % tacitly invert them rather than giving an error message.
        if Strike2 < Strike
            out = -out;
        end
    case 'Butterfly'
        % A Butterfly option involves 4 call options at differing strike
        % prices:
        % Long 1 call at (1 - Spread)*Strike
        % Short 2 calls at Strike
        % Long 1 call at (1 + Spread)*Strike
        Call1 = blsprice(Price, (1-Spread)*Strike, Rate, Time, Vol, Yield);
        Call2 = blsprice(Price, Strike, Rate, Time, Vol, Yield);
        Call3 = blsprice(Price, (1+Spread)*Strike, Rate, Time, Vol, Yield);
        out = Call1 - 2*Call2 + Call3;
    otherwise
        error('optPriceVal:UnknownOption', ...
        ['Invalid option type.  Valid choices are Call, Put, Straddle, '...
        'Strangle, Bull Spread, Bear Spread, or Butterfly'])
end


function r8po_print_some ( n, a, ilo, jlo, ihi, jhi, title )

%*****************************************************************************80
%
%% R8PO_PRINT_SOME prints some of a R8PO matrix.
%
%  Discussion:
%
%    The R8PO storage format is appropriate for a symmetric positive definite
%    matrix and its inverse.  (The Cholesky factor of a R8PO matrix is an
%    upper triangular matrix, so it will be in R8GE storage format.)
%
%    Only the diagonal and upper triangle of the square array are used.
%    This same storage scheme is used when the matrix is factored by
%    R8PO_FA, or inverted by R8PO_INVERSE.  For clarity, the lower triangle
%    is set to zero.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    07 April 2006
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%
%    Input, real A(N,N), the R8PO matrix.
%
%    Input, integer ILO, JLO, IHI, JHI, the first row and
%    column, and the last row and column to be printed.
%
%    Input, string TITLE, a title.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '%s\n', title );

  incx = 5;
%
%  Print the columns of the matrix, in strips of 5.
%
  for j2lo = jlo : incx : jhi

    j2hi = j2lo + incx - 1;
    j2hi = min ( j2hi, n );
    j2hi = min ( j2hi, jhi );

    inc = j2hi + 1 - j2lo;

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Col: ' );

    for j = j2lo : j2hi
      fprintf ( 1, '%7d       ', j );
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Row\n' );
    fprintf ( 1, '  ---\n' );
%
%  Determine the range of the rows in this strip.
%
    i2lo = max ( ilo, 1 );
    i2hi = min ( ihi, n );

    for i = i2lo : i2hi

      fprintf ( 1, '%4d  ', i );
%
%  Print out (up to) 5 entries in row I, that lie in the current strip.
%
      for j2 = 1 : inc

        j = j2lo - 1 + j2;

        if ( i <= j )
          aij = a(i,j);
        else
          aij = a(j,i);
        end

        fprintf ( 1, '%12g  ', aij );

      end

      fprintf ( 1, '\n' );

    end

  end

  return
end


function dr=tide_pl(eu,rp,GMp,pos)

global glc
GME=3.986004415E+14; %earth gravitational constant
H3=0.292; L3=0.015;
dr=zeros(3,1);

r=norm(rp);
if r<=0,return;end

ep=rp/r;

K2=GMp/GME*glc.RE_WGS84^4/r^3;
K3=K2*glc.RE_WGS84/r;
latp=asin(ep(3)); lonp=atan2(ep(2),ep(1));
cosp=cos(latp); sinl=sin(pos(1)); cosl=cos(pos(1));

%step1 in phase (degree2)
p=(3*sinl*sinl-1)/2;
H2=0.6078-0.0006*p;
L2=0.0847+0.0002*p;
a=dot(ep,eu);
dp=K2*3*L2*a;
du=K2*(H2*(1.5*a^2-0.5)-3*L2*a^2);

%step1 in phase (degree3)
dp=dp+K3*L3*(7.5*a^2-1.5);
du=du+K3*(H3*(2.5*a^3-1.5*a)-L3*(7.5*a^2-1.5)*a);

%step1 out-of-phase (only radial)
du=du+3.0/4.0*0.0025*K2*sin(2.0*latp)*sin(2.0*pos(1))*sin(pos(2)-lonp);
du=du+3.0/4.0*0.0022*K2*cosp*cosp*cosl*cosl*sin(2.0*(pos(2)-lonp));

dr(1)=dp*ep(1)+du*eu(1);
dr(2)=dp*ep(2)+du*eu(2);
dr(3)=dp*ep(3)+du*eu(3);

return


function score = HV(Population,optimum)
% <max> <multi/many> <real/integer/label/binary/permutation> <large/none> <constrained/none> <expensive/none> <multimodal/none> <sparse/none> <dynamic/none> <robust/none>
% Hypervolume

%------------------------------- Reference --------------------------------
% E. Zitzler and L. Thiele, Multiobjective evolutionary algorithms: A
% comparative case study and the strength Pareto approach, IEEE
% Transactions on Evolutionary Computation, 1999, 3(4): 257-271.
%------------------------------- 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".
%--------------------------------------------------------------------------

    PopObj = Population.best.objs;
    if size(PopObj,2) ~= size(optimum,2)
        score = nan;
    else
        [N,M]  = size(PopObj);
        fmin   = min(min(PopObj,[],1),zeros(1,M));
        fmax   = max(optimum,[],1);
        PopObj = (PopObj-repmat(fmin,N,1))./repmat((fmax-fmin)*1.1,N,1);
        PopObj(any(PopObj>1,2),:) = [];
        RefPoint = ones(1,M);
        if isempty(PopObj)
            score = 0;
        elseif M < 4
            % Calculate the exact HV value
            pl = sortrows(PopObj);
            S  = {1,pl};
            for k = 1 : M-1
                S_ = {};
                for i = 1 : size(S,1)
                    Stemp = Slice(cell2mat(S(i,2)),k,RefPoint);
                    for j = 1 : size(Stemp,1)
                        temp(1) = {cell2mat(Stemp(j,1))*cell2mat(S(i,1))};
                        temp(2) = Stemp(j,2);
                        S_      = Add(temp,S_);
                    end
                end
                S = S_;
            end
            score = 0;
            for i = 1 : size(S,1)
                p     = Head(cell2mat(S(i,2)));
                score = score + cell2mat(S(i,1))*abs(p(M)-RefPoint(M));
            end
        else
            % Estimate the HV value by Monte Carlo estimation
            SampleNum = 1e6;
            MaxValue  = RefPoint;
            MinValue  = min(PopObj,[],1);
            Samples   = unifrnd(repmat(MinValue,SampleNum,1),repmat(MaxValue,SampleNum,1));
            for i = 1 : size(PopObj,1)
                drawnow('limitrate');
                domi = true(size(Samples,1),1);
                m    = 1;
                while m <= M && any(domi)
                    domi = domi & PopObj(i,m) <= Samples(:,m);
                    m    = m + 1;
                end
                Samples(domi,:) = [];
            end
            score = prod(MaxValue-MinValue)*(1-size(Samples,1)/SampleNum);
        end
    end
end

function S = Slice(pl,k,RefPoint)
    p  = Head(pl);
    pl = Tail(pl);
    ql = [];
    S  = {};
    while ~isempty(pl)
        ql  = Insert(p,k+1,ql);
        p_  = Head(pl);
        cell_(1,1) = {abs(p(k)-p_(k))};
        cell_(1,2) = {ql};
        S   = Add(cell_,S);
        p   = p_;
        pl  = Tail(pl);
    end
    ql = Insert(p,k+1,ql);
    cell_(1,1) = {abs(p(k)-RefPoint(k))};
    cell_(1,2) = {ql};
    S  = Add(cell_,S);
end

function ql = Insert(p,k,pl)
    flag1 = 0;
    flag2 = 0;
    ql    = [];
    hp    = Head(pl);
    while ~isempty(pl) && hp(k) < p(k)
        ql = [ql;hp];
        pl = Tail(pl);
        hp = Head(pl);
    end
    ql = [ql;p];
    m  = length(p);
    while ~isempty(pl)
        q = Head(pl);
        for i = k : m
            if p(i) < q(i)
                flag1 = 1;
            else
                if p(i) > q(i)
                    flag2 = 1;
                end
            end
        end
        if ~(flag1 == 1 && flag2 == 0)
            ql = [ql;Head(pl)];
        end
        pl = Tail(pl);
    end
end

function p = Head(pl)
    if isempty(pl)
        p = [];
    else
        p = pl(1,:);
    end
end

function ql = Tail(pl)
    if size(pl,1) < 2
        ql = [];
    else
        ql = pl(2:end,:);
    end
end

function S_ = Add(cell_,S)
    n = size(S,1);
    m = 0;
    for k = 1 : n
        if isequal(cell_(1,2),S(k,2))
            S(k,1) = {cell2mat(S(k,1))+cell2mat(cell_(1,1))};
            m = 1;
            break;
        end
    end
    if m == 0
        S(n+1,:) = cell_(1,:);
    end
    S_ = S;
end


function [bic, loglik, penalty] = computebic(pathname, filename, ncomp_vec, dpixc, penalty_type)
% [bic, loglik, penalty] = computebic(pathname, filename, ncomp_vec, dpixc, penalty_type)
% penalty_type = 1 : original NMF
% penalty_type = 2 : original NMF + multidimensinoal data
% penalty_type = 3 : hidden + multidimensinoal data

if ~exist('penalty_type','var')
    penalty_type = 1;
end

for ii=1:length(ncomp_vec)
%     if strcmp(pathname(end), '/')
%         load ([pathname filename num2str(ncomp_vec(ii))])
%     else
%         load ([pathname '/' filename num2str(ncomp_vec(ii))])
%     end
%     load ([pathname filename num2str(ncomp_vec(ii)) '/' filename num2str(ncomp_vec(ii))]);
    load ([pathname '/' filename num2str(ncomp_vec(ii))]);
    loglik(ii) = -ddivergence(reshape(dpixc,peval.numpix, peval.nt),res.w*res.h);
    switch penalty_type
        case 1 % orig
            if ii==1 fprintf ('Penalty: original NMF\n'); end
            penalty(ii) = 0.5*peval.ncomp*(peval.nt+peval.numpix)*log(peval.nt*peval.numpix); %orig
        case 2 % orig + multidiensional data
            if ii==1 fprintf ('Penalty: original NMF + multidimensional data\n'); end
            penalty(ii) = 0.5*peval.ncomp*(peval.nt+peval.numpix)*log(peval.nt);
        case 3 % hidden + multidimensional data
            if ii==1 fprintf ('Penalty: multidimensional + hidden\n'); end
            penalty(ii) = 0.5*peval.ncomp*(peval.numpix)*log(peval.nt);
    end

% penalty(ii) = 0.5*peval.ncomp*(peval.nt+peval.numpix)*log(peval.nt*peval.numpix);
% penalty(ii) = 0.5*peval.ncomp*(peval.nt+peval.numpix)*log(peval.nt*peval.numpix); %orig
% penalty(ii) = 0.5*peval.ncomp*(peval.numpix)*log(peval.nt); %hidden +
% multidimensional data
% penalty(ii) = 0.5*peval.ncomp*(peval.nt+peval.numpix)*log(peval.nt); % orig + multidiensional data

%     bic(ii) = -ddivergence(reshape(dpixc,peval.numpix, peval.nt),res.w*res.h) - 0.5*peval.ncomp*peval.nt*log(peval.nt*peval.numpix);
end
bic =  loglik - penalty;


%DTC Verzakov Tree - Trainable Decision Tree Classifier
%
%   W = DTC(A, CRIT, CHISQSTOPVAL, PRUNE, T, NFEAT)
%
% INPUT
%   A       Training dataset.
%           Object weights and class priors:
%             It is possible to assign individual weights to dataset
%             objects by using 'weights' identifier:
%
%             A = SETIDENT(A, WEIGHTS, 'weights')
%
%             If weights are not defined they assumed to be equal to 1 for
%             all objects. The actual weights used by the training routine
%             are computed by using supplied weights along with the class
%             priors (if priors are not set then the apparent priors are used):
%
%             ACTUAL_WEIGHTS(I) = M*(WEIGHTS(I)/CW(C))*(PRIOR(C)/SUM(PRIOR))
%
%             where M is the total amount of (labelled) objects in A,
%             CW is the vector weights sums for each class, and C is
%             the class of the object I. The sum of all actual weights is M.
%
%           Feature types:
%             Features are treated diffrently based on their domain information.
%             If the feature domain is empty or is the interval/collection of intervals
%             then this feature is considered to be the continuous one and
%             branches are created by splitting at the threshold value.
%             Otherwise (feature domain specifies a set of values or set of
%             names), the feature is considered to be the nominal one and
%             branches corresponding to all present feature values are
%             created.
%
%           Unknown and 'non-applicable' values:
%           If the feature value is NaN then it is assumed that its value
%           is unknown. In such a situation the object with unknown value
%           is split into fractions and sent down all branches.
%           The concept of the 'non-applicable' feature value is different
%           from the concept of the unknown (missing) value.
%           ...
%           The 'non-applicable' values for the continues features are
%           encoded as INF. If feature domain is the (set of) interval(s),
%           then INF value has to be explicitly added to the domain
%           defintion. The 'non-applicable' value of nominal features
%           does not have predefined encoding. If it is necessary user
%           have to include such value into domain definition.
%
%   CRIT   Splitting citerion name.
%          'igr' Information Gain Ratio (default):
%          As defined by Quinlan. The penalty on the number of the distinct
%          values of the continues feature is used. If the gain is zero or
%          negative due to such penalization, the split is not performed.
%          This leads to smaller trees and may give non-zero training error.
%          This criterion does not use costs. (Costs are used only at the classification step).
%
%          'gini' Gini impurity index. More precisely, the change in this
%          index. GINI index can be interpreted as a misclassification rate
%          for the stochastic prior based classifier, so costs are
%          naturally embedded. If the change in the (absolute) error less
%          or equal to 0.1 (change in the cost less or equal to 0.1 of minimal
%          absolute value of non-zero costs) the split is not performed.
%          This leads to smaller trees and may give non-zero training error.
%
%          'miscls' Classification error criterion.
%          To be used only for educational puposes because
%          it gives rather inferior results. Costs are naturally embedded.
%
%   CHISQSTOPVAL Early stopping crtitical value for the chi-squared test
%          on the difference between the original node class distribution and
%          branches class distributions. CHISQSTOPVAL is 0 by default.
%          Which means that branches will be discarded only if they bring no
%          change in class distribution.
%
%   PRUNE  Pruning type name
%          'prunep' - pessimistic (top-down) pruning as defined by Quinlan.
%          Pessimistic pruning be perfromed if cost matrix is defined.
%          'prunet' - test set (bottom-up) pruning using the (required)
%          dataset T.
%          These implementations of both pruning algorithms may be not
%          exactly correct if there are unknown values in datastes.
%
%   T      Test test for the test set pruning
%
% OUTPUT
%   W      Classifier mapping
%
% DESCRIPTION
%    If (full grown) branches of (sub)tree do not improve classification error
%    (misclassification cost) they are immediatley discarded.
%    This may happen because we use regularized posteriors. As a result
%    the algorithm is more stable, trees are smaller, but split on
%    the training set may be not perfect.
%
% REFERENCES
% [1] J.R. Quinlan, Simplifying Decision Trees, International Journal of
%     Man-Machine Studies, 27(3), pp. 221-234, 1987.
% [2] J.R. Quinlan, Improved use of continuous attributes in C4.5. Journal
%     of AI Research, 4(96), pp. 77-90, 1996.
%
% see also DATASETS, MAPPINGS, TREEC

% Copyright: S. Verzakov, s.verzakov@gmail.com
% Based on prtools' treec, tree_map, and their subroutines
% by Guido te Brake and R.P.W Duin

function w = dtc(a, crit, chisqstopval, prune, t, nfeat)

		% When no input data is given, an empty tree is defined:
	if (nargin == 0) || isempty(a)

    if nargin < 2 || isempty(crit)
			crit = 'igr';
    end

    if nargin < 3 || isempty(chisqstopval)
      chisqstopval = 0;
    end

    if nargin < 4 || isempty(prune)
      prune = '';
    end

    if nargin < 5
      t = [];
    end

    if nargin < 6
      nfeat = [];
    end

    w = prmapping('dtc', {crit, chisqstopval, prune, t, nfeat});
    w = setname(w, ['DecTree' upper(crit)]);

  elseif (nargin == 2) && ismapping(crit)
    % Execution
    w = crit;
    tree = +w;

    % B contains posteriors.
    % We do not need to convert posteriors to costs.
    % PRTools will do it automatically

    b = mapdt(tree, +a);
    b = setdat(a,b,w);
%    b = setfeatlab(b, getlabels(w));

    w = b;

  else
    % Training

    if nargin < 2 || isempty(crit)
      crit = 'igr';
    end

    if nargin < 3 || isempty(chisqstopval)
      chisqstopval = 0;
    end

    if nargin < 4 || isempty(prune)
      prune = '';
    end

    if nargin < 5
      t = [];
    end

    if nargin < 6
      nfeat = [];
    end

    if ~any(strcmpi(crit, {'igr', 'gini', 'miscls'}))
      error('Unknown splitting criterion');
    end

    islabtype(a,'crisp');
    isvaldfile(a, 1, 2); % at least 1 object per class, 2 classes
    a = seldat(prdataset(a)); % get rid of all unlabelled objects

    m = size(a,1);
    % Get weights (if defined)
    weights = getident(a, 'weights');
    if isempty(weights)
      weights = ones([m 1]);
    else
     idx = (weights > 0);
     if nnz(idx) < m
       a = a(idx, :);
       weights = weights(idx);
     end
     isvaldset(a, 1, 2);
    end

    % First get some useful parameters:

    % Sizes
    [m, k, c] = getsize(a);
    cs = classsizes(a);

    % Determine if features are categorical
    featdom = getfeatdom(a);
    featdom = featdom(:)';
    if isempty(featdom)
      feattype = zeros(1, k);
    else
      feattype = cellfun(@(x) ischar(x) || (size(x,1)==1), featdom);
    end

    % Features to use
    usefeat = true([1, k]);
    if ~isempty(nfeat)
      nfeat = min(nfeat, k);
    end

    % Labelling
    nlab = getnlab(a);

    % Get priors
    prior = getprior(a);
    prior = prior/sum(prior);

    % Define weights:
    % the total sum of weights is equal to m
    % Compute class weights
    cw = zeros(size(cs));
    for i=1:c
      cw(i) = sum(weights(nlab == i));
    end
    % Rescale objects weights
    % by class weight factors derived from priors
    cwf = m*prior./cw;
    weights = weights.*(cwf(nlab)).';

    % Miscalssification cost
    cost = a.cost;

    % Now the training can really start:
    tree = makedt(+a, feattype, usefeat, nfeat, c, nlab, weights, cost, crit, chisqstopval);

    if ~isempty(prune)
      if strcmpi(prune, 'prunep')
        if ~isempty(cost)
          error('Pessimistic prunning based on misclassification costs is not implemented');
        end
        tree = prunep(tree);
      elseif strcmpi(prune, 'prunet')
        if isempty(t)
          error('Test set is not specified for the test set prunning');
        end
         tree = prunet(tree, t, cost);
      else
        error('Unkown prunning method');
      end

      tree = cleandt(tree);
    end

    % Store the results:
    w = prmapping('dtc', 'trained', {tree}, getlablist(a), k, c);
    w = setname(w, ['DecTree' upper(crit)]);
    w = setcost(w, cost);
  end

  return

%MAKEDT General tree building algorithm
%
%   TREE = MAKEDT(A, FEATTYPE, USEFEAT, NFEAT, C, NLAB, WEIGHTS, COST, CRIT, CHISQSTOPVAL)
%
% INPUT
%   A      Data matrix
%
%   FEATTYPE Row defining the feature types (0 - continues, 1 - nominal)
%
%   USEFEAT Row defining the features to be used for splitting
%
%   NFEAT  The maximum number of features for which splitting has to be
%          attempted. If the number of the available features is geater
%          than NFEAT the random subset of NFEAT features will be used for
%          splitting.
%
%  C       Total number of classes in the initial dataset
%
%  NLAB    Numeric class labels of objects in A
%
%  WEIGHTS Weights of objects in A
%
%  COST    Misclassification costs
%
%  CRIT    Name of splitting criterion to be used
%
%  CHISQSTOPVAL Crtitical value for the chi-squared test
%
% OUTPUT
%   TREE   Structure containing arrays defining decision tree.
%          .NSMP The number of samples. NSMP(J) is the sum of weights of objects
%          which reached the node J.
%
%          .POST Posterior probabilities. POST(J, :) is the class
%          distribution at the node J. Object weights are taken into
%          account. 0 and 1 probablities are avoided by perfroming Bayes
%          uniform priors regularization.
%
%          .CIDX Class index. CIDX(J) is the class corresponding to the
%          node J if it considered as a leaf.
%
%          .ERRL Leaf error. ERRL(J) is the misclassification error (cost)
%          on training samples which reached the node J if this node is
%          considered to be a leaf.
%
%          .ERRT Leaf error. ERRT(J) is the misclassification error (cost)
%          on training samples which reached the node J if this node is
%          considered to be a root of the (sub)tree.
%
%          .SIZE Tree size. SIZE(J) is the (sub)tree size with root at the
%          node J.
%
%          .FIDX Feature index. FIDX(J) is the index of the feature on
%          which node J is split. FIDX(J) == 0 means that J is a leaf.
%
%          .FVAL Feature value(s). For nominal features FVAL{J} is the set
%          of feature values observed at the node J (LENGTH(FVAL{J} == 0
%          for the leaf, otherwise it is > 1).
%          For continues features, if LENGTH(FVAL{J}) == 1 then it contains
%          threshold THR for splitting into the left (<= THR) and the
%          right (> THR) branches. If FVAL{J} == [] (and J is not a leaf)
%          then it means that split is perfromed between applicable and
%          non-applicable values.
%
%          .NIDX Branch node indices. For nominal features NIDX{J,K} is
%          the index of branch node of node J with value FVAL{J,K}
%          of feature FIDX(J). For continues features (if LENGTH(FVAL{J}) == 1)
%          NIDX{J,1} is the index of the left branch node, NIDX{J,2} is the
%          index of the right branch node. If FVAL{J} == []
%          (and J is not a leaf) then NIDX{J,1} is the index of branch node
%          containing objects with applicable values of feature FIDX(J) and
%          NIDX{J,2} is the index of branch node containing objects with
%          non-applicable values of the same feature.
%
% This is a low-level routine called by DTC.
%
% See also IGR, GINI, MISCLS

function tree = makedt(a, feattype, usefeat, nfeat, c, nlab, weights, cost, crit, chisqstopval)

  % Construct the tree:

  % Find (absolute) class frequencies
  C = zeros(1, c);
  for j=1:c
    C(j) = sum(weights(nlab == j));
  end

  NC = nnz(C);
  tree.nsmp = sum(C);

  % regularization by 'uniform' Bayesian priors;
  C0 = C;
  C = C + 1;
  p = C/sum(C);

  if isempty(cost)
    [maxpost, cidx] = max(p);
    errc = tree.nsmp*(1-maxpost);
    %errc = tree.nsmp - C0(cidx);
  else
    costp = p*cost;
    [mincost, cidx] = min(costp);
    errc = mincost;
  end

  tree.post = p;
  tree.cidx = cidx;
  tree.errl = errc;
  tree.errt = errc;
  tree.size = 1;

  if NC ~= 1 % not a pure class dataset
    % now the tree is recursively constructed further:
		% use desired split criterion
    [fidx, fval, nb, bidx, chisqval] = findsplit(+a, feattype, usefeat, nfeat, c, nlab, weights, cost, crit);

    % When the stop criterion is not reached yet, we recursively split
		% further:
    if ~isempty(fidx) && (chisqval > chisqstopval)
      tree.fidx = fidx;
      tree.fval = {fval};

      if feattype(fidx) > 0
        usefeat(fidx) = 0;
      end

      uidx = bidx == 0;
      nu = nnz(uidx);
      if nu > 0
        knsmp = tree.nsmp - sum(weights(uidx));
      end

      tree.nidx = {zeros(1, nb)};
      tree.errt(1) = 0;
      for j=1:nb
        tree.nidx{1}(j) = tree.size(1) + 1;

        J = bidx == j;
        if nu == 0
          bweights = weights(J);
        else
          J = J | uidx;
          bweights = weights(J);
          buidx = uidx(J);
          bknsmp = sum(bweights(~buidx));
          bweights(buidx) = (bknsmp/knsmp)*bweights(buidx);
        end

        branch = makedt(+a(J, :), feattype, usefeat, nfeat, c, nlab(J), bweights, cost, crit, chisqstopval);

        branch.nidx = cellfun(@(x) x + tree.size(1)*(x>0), branch.nidx, 'UniformOutput', false);
        tree.errt(1) = tree.errt(1) + branch.errt(1);
        tree.size(1) = tree.size(1) + size(branch.nidx, 1);

        tree.nsmp = [tree.nsmp; branch.nsmp];
        tree.post = [tree.post; branch.post];
        tree.cidx = [tree.cidx; branch.cidx];
        tree.errl = [tree.errl; branch.errl];
        tree.errt = [tree.errt; branch.errt];
        tree.size = [tree.size; branch.size];
        tree.fidx = [tree.fidx; branch.fidx];
        tree.fval = [tree.fval; branch.fval];
        tree.nidx = [tree.nidx; branch.nidx];
      end
    end
  end

  % no improvement in error (cost), rollback
  if (tree.size(1) > 1) && (tree.errt(1) >= tree.errl(1))
    tree.nsmp = tree.nsmp(1);
    tree.post = tree.post(1,:);
    tree.cidx = tree.cidx(1);
    tree.errl = tree.errl(1);
    tree.errt = tree.errl(1); % sic!
    tree.size = 1;
  end

  if tree.size(1) == 1
    % We reached the stop criterion or no further split is possible
    % so we make a leaf node:
    tree.fidx = 0;
    tree.fval = {[]};
    tree.nidx = {[]};
  end

	return

%MAPDT Tree mapping and node statistic calculation
%
% 	[P, S] = MAPDT(TREE, A, NLAB, WEIGHTS)
%

function [p, s] = mapdt(tree, a, nlab, weights)

  persistent dt st

  if isstruct(tree)
    dt = tree;

    if nargin < 4
      weights = [];
    end

    if nargin < 3
      nlab = [];
    end

    m = size(a, 1);
    [n, c] = size(dt.post);
    p = zeros([m, c]);

    if (nargout < 2) || isempty(nlab)
      st = [];

      for i=1:m
        p(i, :) = mapdt(1, +a(i, :));
      end

    else
      st = zeros([n, c]);
      nlab (nlab > c) = 0;
      if isempty(weights)
        weights = ones(m, 1);
      end

      for i=1:m
        p(i, :) = mapdt(1, +a(i, :), nlab(i), weights(i));
      end
    end

    s = st;
    clear dt st

  else
    j = tree;

    while j > 0
      if ~isempty(st) && (nlab > 0)
        st(j, nlab) = st(j, nlab) + weights;
      end

      k = 0;
      fidx = dt.fidx(j);

      if fidx ~= 0
        nidx = dt.nidx{j};
        aval = a(fidx);

        if ~isnan(aval)
          fval = dt.fval{j};

          if isempty(fval)
            k = nidx(2 - (aval ~= inf));
          elseif length(fval) == 1
            if aval ~= inf
              k = nidx(2 - (aval <= fval));
            elseif length(nidx) == 3
              k = nidx(3);
            end;
          else
            k = nidx(aval == fval);
            if isempty(k)
              k = 0;
            end
          end

        else
          p = zeros([1, size(dt.post, 2)]);
          if isempty(st) || (nlab <= 0)
            for b=1:length(nidx)
              k = nidx(b);
              f = (dt.nsmp(k)/dt.nsmp(j));
              p = p + f*mapdt(nidx(b), a);
            end
          else
            for b=1:length(nidx)
              k = nidx(b);
              f = (dt.nsmp(k)/dt.nsmp(j));
              p = p + f*mapdt(nidx(b), a, nlab, f*weights);
            end
          end
          k = -1;
        end
      end

      if k == 0
        p = dt.post(j, :);
      end

      j = k;
    end
  end

  return

%FINDSPLIT General routine for finding the best split
%
% 	[FIDX, FVAL, NB, BIDX, CHISQVAL, CRITVAL] = FINDSPLI(A, FEATTYPE, USEFEAT, NFEAT, C, NLAB, WEIGHTS, COST, CRIT)
%

function [fidx, fval, nb, bidx, chisqval, critval] = findsplit(a, feattype, usefeat, nfeat, c, nlab, weights, cost, crit)

  selfeatidx = find(usefeat);
  nf = length(selfeatidx);
  if ~isempty(nfeat) && (nfeat < nf)
    permidx = randperm(length(selfeatidx));
    selfeatidx = selfeatidx(permidx(1:nfeat));
    nf = nfeat;
  end

  fval = cell([1, nf]);
  chisqval = zeros([1, nf]);
  critval = nan([1, nf]);

  % repeat for all selected features
  for f=1:nf
    fidx = selfeatidx(f);
    af = a(:, fidx);

    kidx = ~isnan(af); % known values index
    if nnz(kidx) == 0
      continue
    end

    MU = sum(weights(~kidx)) + realmin;

    af = af(kidx);
    wk = weights(kidx);
    nlabk = nlab(kidx);

    switch feattype(fidx)
      case 0 % continous/ordered feature
        naidx = af == inf;
        NA = repmat(realmin, [1 c]);
        MNA = c*realmin;
        nlabna = nlabk(naidx);
        nna = length(nlabna);
        if nna > 0
          for j = 1:c
            NA(1,j) = sum(wk(nlabna == j)) + realmin;
          end
          MNA = sum(NA);
        end

        apidx = find(~naidx);
        af = af(apidx);
        wap = wk(apidx);
        nlabap = nlabk(apidx);
        [af, sortidx] = sort(af);
        wap = wap(sortidx);
        nlabap = nlabap(sortidx);

        if length(af) == 1
          uv = af;
          ns = 0;
          sli = [];
        else
          labchngcount = cumsum([1; double(diff(nlabap) ~= 0)]);
          uniquevallowidx = find([true; ((diff(af)./(0.5*abs(af(1:end-1) + af(2:end)) + realmin)) > 1e-8)]);
          uniquevalhighidx = [(uniquevallowidx(2:end) - 1); length(af)];
          % unique values
          uv = af(uniquevalhighidx);

          % split low indices in unique values
          sli = find(labchngcount(uniquevalhighidx(2:end)) - labchngcount(uniquevallowidx(1:end-1)) > 0);
          % split low indices in af
          splitlowidx = uniquevalhighidx(sli);
          ns = length(splitlowidx);
        end

        if (ns == 0) && (nna == 0)
          continue
        end

        % applicable, left, and right branch class counts
        AP = zeros(1, c);
        L = zeros(ns, c);
        R = zeros(ns, c);

        for j = 1:c
          J = find(nlabap == j);
          mj = length(J);
          AP(j) = sum(wap(J));
          if (ns > 0) && (mj > 0)
            L(:, j) = (repmat(splitlowidx, [1, mj]) >= repmat(J.', [ns, 1]))*wap(J) + realmin;
            R(:, j) = AP(j) - L(:, j) + realmin;
          end
        end
        AP = AP + 2*realmin;

        % total count of applicable
        MAP = sum(AP);

        % known
        K = AP + NA;
        MK = MNA + MAP;

        % object counts for branches
        ML = sum(L, 2);
        MR = sum(R, 2);

        [cv, i] = feval(crit, 0, MU, MK, K, MNA, NA, MAP, AP, ML, L, MR, R, cost, weights, uv, sli);
        critval(f) = cv;

        if ~isnan(cv) && (cv > -inf)
          if (ns > 0) && ~isempty(i)
            t = splitlowidx(i);
            fval{f} = 0.5*(af(t) + af(t+1));

            if nna == 0
              APL = AP*(ML(i)/MAP);
              APR = AP*(MR(i)/MAP);
              chisqval(f) = sum(((L(i, :) - APL).^2)./APL + ((R(i, :) - APR).^2)./APR);
            else
              KNA = K*(MNA/MK);
              KL = K*(ML(i)/MK);
              KR = K*(MR(i)/MK);
              chisqval(f) = sum(((NA - KNA).^2)./KNA + ((L(i, :) - KL).^2)./KL + ((R(i, :) - KR).^2)./KR);
            end
          else
            fval{f} = [];
            KNA = K*(MNA/MK);
            KAP = K*(MAP/MK);
            chisqval(f) = sum(((NA - KNA).^2)./KNA + ((AP(i, :) - KAP).^2)./KAP);
          end
        end

      case 1 % nominal feature
        vf = unique(af);
        v = length(vf);

        B = zeros(v, c);
        for j=1:c
          J = find(j == nlab);
          mj = length(J);
          if mj > 0
            B(:, j) = (repmat(vf, [1, mj]) ==  repmat(af(J).', [v 1]))*weights(J);
          end
        end

        B = B + realmin;

        % class counts for known
        K = sum(B, 1);

        % total known count
        MK = sum(K);

        % object counts for branches
        MB = sum(B, 2);

        cv = feval(crit, 1, MU, MK, K, MB, B, cost, weights);
        critval(f) = cv;

        if ~isnan(cv) && (cv > -inf)
          KB = MB.*K/MK;
          chisqval(f) = sum(sum(((B - KB).^2)./KB));
          fval{f} = bf;
        end
    end
  end

  % best criterion over all features
  testfeatidx = find(~isnan(critval) & (critval > -inf));
  if isempty(testfeatidx)
    fidx = [];
    fval = [];
    nb = [];
    bidx = [];
    chisqval = [];
    critval = [];

  else
    [critval, fidx] = max(critval(testfeatidx));
    fidx = testfeatidx(fidx);
    fval = fval{fidx};
    chisqval = chisqval(fidx);
    fidx = selfeatidx(fidx);

    af = a(:, fidx);
    m = size(af, 1);
    bidx = zeros(m, 1);

    switch feattype(fidx)
      case 0
        apidx = af < inf;

        if ~isempty(fval)
          lidx = af <= fval;
          ridx = apidx & ~lidx;
          bidx(lidx) = 1;
          bidx(ridx) = 2;
          nb = 2;
        else
          bidx(apidx) = 1;
          nb = 1;
        end

        naidx = ~isnan(af) & ~apidx;
        if nnz(naidx) > 0
          nb = nb + 1;
          bidx(naidx) = nb;
        end

      case 1
        nb = length(fval);
        for i=1:nb
          bidx(af == fval(i)) = i;
        end
    end
  end

  return

%IGR The information gain ratio
%
% 	[CRITVAL, IDX] = IGR(FEATTYPE, MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, COST, WEIGHTS, UV, SLI)
%   [CRITVAL, IDX] = IGR(FEATTYPE,MU, MK, K, MB, B, COST, WEIGHTS

function [critval, idx] = igr(feattype, varargin)

  switch feattype
    case 0
      [MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, cost, weights, uv, sli] = deal(varargin{:});

      M = MK + MU;

      infoold = - K * log2(K.'/MK);
      infonew = - NA * log2(NA.'/MNA);
      infosplit = - MU * log2(MU/M) - MNA * log2(MNA/M);

      if ~isempty(R)
        infolr = - ( ...
          sum(L .* log2(L./(repmat(ML, [1 size(L, 2)]))), 2) + ...
          sum(R .* log2(R./(repmat(MR, [1 size(R, 2)]))), 2) ...
        );

        % best criterion value over all thresholds
        [infolr, idx] = min(infolr);

        infonew = infonew + infolr;
        infosplit = infosplit - [ML(idx), MR(idx)] * log2([ML(idx); MR(idx)]/M);

      else
        idx = [];
        infonew = infonew - AP * log2(AP.'/MAP);
        infosplit = infosplit - MAP * log2(MAP/M);
      end

      infothresh = log2(max(length(uv) - 1, 1));
      infogain = (infoold - infonew - infothresh);

    case 1
      idx = [];
       [MU, MK, K, MB, B, cost, weights] = deal(varargin{:});

      M = MK + MU;

      infoold = - K * log2(K.'/MK);
      infosplit = - MU.' * log2(MU/M);

      infonew = - sum(sum(B .* log2(B./(repmat(MB, [1 size(B, 2)]))), 2), 1);
      infosplit = infosplit - MB.' * log2(MB/M);

      infogain = (infoold - infonew);
  end

  % infogain = infogain / M;
  % infosplit = infospit / M;

  if infogain > 0
    critval = infogain / infosplit;
  else
    critval = -inf;
  end

  return

%GINI
%
% 	[CRITVAL, IDX] = GINI(FEATTYPE, MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, COST, WEIGHTS, UV, SLI)
%   [CRITVAL, IDX] = GINI(FEATTYPE,MU, MK, K, MB, B, COST, WEIGHTS%

function [critval, idx] = gini(feattype, varargin)

  switch feattype
    case 0
      [MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, cost, weights, uv, sli] = deal(varargin{:});

      if isempty(cost)
        purityold = K * (K.'/MK);
        %impurityold = MK - purityold;

        if ~isempty(R)
          puritylr = ( ...
            sum(L .* (L./(repmat(ML, [1 size(L, 2)]))), 2) + ...
            sum(R .* (R./(repmat(MR, [1 size(R, 2)]))), 2) ...
          );

          % best criterion value over all thresholds
          [puritylr, idx] = max(puritylr);
          puritynew = puritylr + NA * (NA.'/MNA);

        else
          idx = [];
          puritynew = AP * (AP.'/ MAP) + NA * (NA.'/MNA);
        end

        %impuritynew = MK - puritynew;
        deltaimpurity = puritynew - purityold;

      else
        impurityold = K * cost * (K.'/MK);

        if ~isempty(R)
          impuritylr = ...
            sum((L*cost) .* (L./(repmat(ML, [1 size(L, 2)]))), 2) + ...
            sum((R*cost) .* (R./(repmat(MR, [1 size(R, 2)]))), 2);

          [impuritylr, idx] = min(impuritylr);
          impuritynew = impuritylr + NA * cost * (NA.'/MNA);

        else
          idx = [];
          impuritynew = AP * cost* (AP.'/ MAP) + NA * cost *(NA.'/MNA);
        end

        deltaimpurity = impurityold - impuritynew;
      end

    case 1
      idx = [];
      [MU, MK, K, MB, B, cost, weights] = deal(varargin{:});

      if isempty(cost)
        purityold = K * (K.'/MK);
        %impurityold = MK - purityold;
        puritynew = sum(sum(B .* (B./(repmat(MB, [1 size(B, 2)]))), 2));
        %impuritynew = MK - puritynew;
        deltaimpurity = puritynew - purityold;

      else
        impurityold = K * cost * (K.'/MK);
        impuritynew = ( ...
          sum(sum((B*cost) .* (B./(repmat(MB, [1 size(B, 2)]))), 2), 1) ...
        );

        deltaimpurity = impurityold - impuritynew;
      end
  end

  if isempty(cost)
    deltamin = 0.1;
  else
    deltamin = 0.1*min(abs(cost(abs(cost) > 0)));
  end

  if deltaimpurity > deltamin
    critval = deltaimpurity/(MU+MK);
  else
    critval = -inf;
  end

  return

%MISCLS Miscalssification error
%
% 	[CRITVAL, IDX] = MISCLS(FEATTYPE, MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, COST, WEIGHTS, UV, SLI)
%   [CRITVAL, IDX] = MISCLS(FEATTYPE,MU, MK, K, MB, B, COST, WEIGHTS
%

function [critval, idx] = miscls(feattype, varargin)

  switch feattype
    case 0
      [MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, cost, weights, uv, sli] = deal(varargin{:});

      if isempty(cost)
        ccold = max(K, [], 2);
        if ~isempty(R)
          ccnew = max(L, [], 2) + max(R, [], 2);
          [ccnew, idx] = max(ccnew);
          ccnew = ccnew + max(NA, [], 2);
        else
          idx = [];
          ccnew = max(AP, [], 2) + max(NA, [], 2);
        end

        deltamc = ccnew - ccold;

      else
        mcold = min(K*cost, [], 2);
        if ~isempty(R)
          mcnew = min(L*cost, [], 2) + min(R*cost, [], 2);
          [mcnew, idx] = min(mcnew);
           mcnew = mcnew + min(NA*cost, [], 2);
        else
          idx = [];
          mcnew = min(AP*cost, [], 2) + min(NA*cost, [], 2);
        end

        deltamc = mcold - mcnew;
      end

    case 1
      idx = [];
      [MU, MK, K, MB, B, cost, weights] = deal(varargin{:});

      if isempty(cost)
        ccold = max(K, [], 2);
        ccnew = sum(max(B, [], 2), 1);
        deltamc = ccnew - ccold;
      else
        mcold = min(K*cost, [], 2);
        mcnew  = sum(min(B*cost, [], 2), 1);
        deltamc = mcold - mcnew;
      end
  end

  %if isempty(cost)
  %  deltamin = min(weights(weights > 0));
  %else
  %  deltamin = min(weights(weights > 0))*min(cost(cost > 0));
  %end
  %
  %if ~isempty(deltamin)
  %  deltamin = 0.5*deltamin;
  %else
  %  deltamin = 0;
  %end
  %
  %if deltamc <= deltamin
  %  critval = -inf;
  %else
  %  critval = deltamc / (MU+MK);
  %end

  critval = deltamc / (MU+MK);

  return

%PRUNEP Pessimistic pruning of a decision tree
%
% 	TREE = PRUNEP(TREE,NODE)
%
% Pessimistic pruning defined by Quinlan.

function tree = prunep(tree, node)

  persistent pt;

  if (nargout ~= 0) || (nargin ~= 1) || ~isscalar(tree) || ~isnumeric(tree) || ~isint(tree)
    if nargin < 2 || isempty(node)
      node = 1;
    end

    pt = tree;
    prunep(node);
    tree = pt;
    clear pt;

  else
    node = tree;
    if pt.fidx(node) > 0
      tnidx = (node+1):(node + pt.size(node) - 1);

      nleaves = nnz(pt.fidx(tnidx) == 0);
      errt = pt.errt(node) + 0.5*nleaves;
      errl = pt.errl(node) + 0.5;
      nsmp = pt.nsmp(node);
      sd = sqrt(errt*(1-errt/nsmp));

      if errl < (errt + sd)
        pt.fidx(tnidx) = -1;

        pt.errt(node) = pt.errl(node);
        pt.size(node) = 1;
        pt.fidx(node) = 0;
        pt.fval(node) = {[]};
        pt.nidx(node) = {[]};

      else
        errt = 0;
        for i=1:length(pt.nidx{node})
          idx = pt.nidx{node}(i);
          prunep(idx);
          errt = errt + pt.errt(idx);
        end
        pt.errt(idx) = errt;
      end
    end
  end

  return

%PRUNET Prune tree by testset
%
% 	TREE = PRUNET(TREE,T,COST)
%
% The test set a is used to prune a decision tree.

function tree = prunet(tree, t, cost)

  persistent pt;

  if (nargout ~= 0) || (nargin ~= 1) || ~isscalar(tree) || ~isnumeric(tree) || ~isint(tree)
    if nargin < 3
      cost = [];
    end

    [m, k, c] = getsize(t);

    cs = classsizes(t);
    prior = getprior(t);
    prior = prior/sum(prior);
    weights = m*prior./cs;

    pt = tree;
    mt = size(pt.post,1);
    [p, s] = mapdt(pt, +t, getnlab(t), weights);

    % error (cost) in each node as if there were leafs
    if isempty(cost)
      idx = sub2ind([mt, c], (1:mt).', pt.cidx);
      pt.test_errl = sum(s,2) - s(idx);
    else
      pt.test_errl = sum(s .* cost(:, pt.cidx).', 2);
    end

    pt.test_errt = pt.test_errl;

    prunet(1);
    tree = pt;
    clear pt;

  else
    node = tree;
    if pt.fidx(node) > 0
      test_errt = 0;
      errt = 0;

      for i=1:length(pt.nidx{node})
        idx = pt.nidx{node}(i);
        prunet(idx);
        test_errt = test_errt + pt.test_errt(idx);
        errt = errt + pt.errt(idx);
      end

      if pt.test_errl(node) <= test_errt
        pt.fidx(pt.nidx{node}) = -1;

        pt.errt(node) = pt.errl(node);
        pt.size(node) = 1;
        pt.fidx(node) = 0;
        pt.fval(node) = {[]};
        pt.nidx(node) = {[]};

      else
        pt.test_errt(node) = test_errt;
        pt.errt(node) = errt;
      end
    end
  end;

  return

function tree = cleandt(tree)

  rnidx = tree.fidx == -1;
  if nnz(rnidx) == 0
    return
  end

  rncount = cumsum(rnidx);
  fn = fieldnames(tree);
  for i=1:length(fn)
    tree.(fn{i})(rnidx, :) = [];
  end

  tree.nidx = cellfun(@(x) x - rncount(x).', tree.nidx, 'UniformOutput', false);

  idx = (1:length(rnidx)).';
  idx(rnidx) = [];
  tree.size = tree.size - (rncount(idx) - rncount(idx + tree.size - 1));

 	return