function s = addlogi(s)
%ADDLOGI Add the logistic adistributions.

%   Copyright 1993-2004 The MathWorks, Inc.
%   $Revision: 1.1.6.9 $  $Date: 2004/01/24 09:35:06 $

j = length(s) + 1;
s(j).name = 'Logistic';
s(j).code = 'logistic';
s(j).pnames = {'mu' 'sigma'};
s(j).pdescription = {'location' 'scale'};
s(j).prequired = [false false];
s(j).fitfunc = @logifit;
s(j).likefunc = @logilike;
s(j).cdffunc = @logicdf;
s(j).pdffunc = @logipdf;
s(j).invfunc = @logiinv;
s(j).statfunc = @logistat;
s(j).loginvfunc = [];
s(j).logcdffunc = [];
s(j).hasconfbounds = false;
s(j).censoring = true;
s(j).paramvec = true;
s(j).support = [-Inf Inf];
s(j).closedbound = [false false];
s(j).iscontinuous = true;
s(j).islocscale = true;
s(j).uselogpp = false;

j = j + 1;
s(j).name = 'Log-Logistic';
s(j).code = 'loglogistic';
s(j).pnames = {'mu' 'sigma'};
s(j).pdescription = {'log location' 'log scale'};
s(j).prequired = [false false];
s(j).fitfunc = @loglfit;
s(j).likefunc = @logllike;
s(j).cdffunc = @loglcdf;
s(j).pdffunc = @loglpdf;
s(j).invfunc = @loglinv;
s(j).statfunc = @loglstat;
s(j).loginvfunc = @logiinv;
s(j).logcdffunc = @logicdf;
s(j).hasconfbounds = false;
s(j).censoring = true;
s(j).paramvec = true;
s(j).support = [0 Inf];
s(j).closedbound = [false false];
s(j).iscontinuous = true;
s(j).islocscale = true;
s(j).uselogpp = true;

% ==== Logistic distribution functions ====

% these distribution functions do not yet handle arrays of parameters

function y = logipdf(x, mu, sigma)
%LOGIPDF Logistic probability density function (pdf).
if (nargin<2), mu=0; end
if (nargin<3), sigma=1; end
sigma(sigma <= 0) = NaN;

z = (x - mu) ./ sigma;
k = (z>350); if any(k), z(k) = -z(k); end % prevent Inf/Inf
y = exp(z) ./ ((1 + exp(z)).^2 .* sigma);

function p = logicdf(x, mu, sigma)
%LOGICDF Logistic cumulative distribution function (cdf).
if (nargin<2), mu=0; end
if (nargin<3), sigma=1; end
sigma(sigma <= 0) = NaN;

p = 1 ./ (1 + exp(-(x - mu) ./ sigma));

function x = logiinv(p, mu, sigma)
%LOGIINV Inverse of the logistic cumulative distribution function (cdf).
if (nargin<2), mu=0; end
if (nargin<3), sigma=1; end
sigma(sigma <= 0) = NaN;

x = logit(p).*sigma + mu;

function r = logirnd(mu, sigma, varargin)
%LOGIRND Random arrays from the logistic distribution.
if (nargin<1), mu=0; end
if (nargin<2), sigma=1; end
sigma(sigma <= 0) = NaN;

[err, sizeOut] = statsizechk(2,mu,sigma,varargin{:});
if err > 0
    error('stats:logirnd:InconsistentSizes','Size information is inconsistent.');
end

p = rand(sizeOut);
r = log(p./(1-p)).*sigma + mu;

function [m,v] = logistat(mu, sigma)
%LOGISTAT Mean and variance for the logistic distribution.
if (nargin<1), mu=0; end
if (nargin<2), sigma=1; end
sigma(sigma <= 0) = NaN;

m = mu;
v = sigma.^2 .* pi.^2 ./ 3;

function [nlogL,acov] = logilike(params,data,cens,freq)
%LOGILIKE Negative log-likelihood for the logistic distribution.
if nargin < 4 || isempty(freq), freq = ones(size(data)); end
if nargin < 3 || isempty(cens), cens = zeros(size(data)); end

nlogL = logi_nloglf(params, data, cens, freq);
if nargout > 1
    acov = mlecov(params, data, 'nloglf',@logi_nloglf, 'cens',cens, 'freq',freq);
end

% ==== Logistic fitting functions ====

function [phat,pci] = logifit(x,alpha,cens,freq,opts)
%LOGIFIT Parameter estimates and confidence intervals for logistic data.

if nargin < 2 || isempty(alpha), alpha = .05; end
if nargin < 3 || isempty(cens), cens = zeros(size(x)); end
if nargin < 4 || isempty(freq), freq = ones(size(x)); end
if nargin < 5, opts = []; end

% Moment estimators as starting point
xunc = x(cens == 0);
start = [mean(xunc) std(xunc).*sqrt(3)./pi];

% The default options include turning statsfminbx's display off.  This
% function gives its own warning/error messages, and the caller can turn
% display on to get the text output from statsfminbx if desired.
options = statset(statset('logifit'), opts);
tolBnd = options.TolBnd;
options = optimset(options);
dfltOptions = struct('DerivativeCheck','off', 'HessMult',[], ...
    'HessPattern',ones(2,2), 'PrecondBandWidth',Inf, ...
    'TypicalX',ones(2,1), 'MaxPCGIter',1, 'TolPCG',0.1);

% Maximize the log-likelihood with respect to mu and sigma.
funfcn = {'fungrad' 'logifit' @logi_nloglf [] []};
[phat, nll, lagrange, err, output] = ...
         statsfminbx(funfcn, start, [-Inf; tolBnd], [Inf; Inf], ...
                     options, dfltOptions, 1, x, cens, freq);
if (err == 0)
    % statsfminbx may print its own output text; in any case give something
    % more statistical here, controllable via warning IDs.
    if output.funcCount >= options.MaxFunEvals
        wmsg = 'Maximum likelihood estimation did not converge.  Function evaluation limit exceeded.';
    else
        wmsg = 'Maximum likelihood estimation did not converge.  Iteration limit exceeded.';
    end
    warning('stats:logifit:IterOrEvalLimit',wmsg);
elseif (err < 0)
    error('stats:logifit:NoSolution',...
          'Unable to reach a maximum likelihood solution.');
end

if nargout > 1
    acov = mlecov(phat, x, 'nloglf',@logi_nloglf, 'cens',cens, 'freq',freq);
    probs = [alpha/2; 1-alpha/2];
    se = sqrt(diag(acov))';

    % Compute the CI for mu using a normal approximation for muhat.
    pci(:,1) = norminv(probs, phat(1), se(1));

    % Compute the CI for sigma using a normal approximation for
    % log(sigmahat), and transform back to the original scale.
    % se(log(sigmahat)) is se(sigmahat) / sigmahat.
    logsigci = norminv(probs, log(phat(2)), se(2)./phat(2));
    pci(:,2) = exp(logsigci);
end

function [nll,ngrad] = logi_nloglf(parms, x, cens, freq)
%LOGI_NLOGLF Objective function for logistic maximum likelihood.
mu = parms(1);
sigma = parms(2);
z = (x - mu) ./ sigma;
logitz = 1 ./ (1 + exp(-z));
clogitz = 1 ./ (1 + exp(z));
logclogitz = log(clogitz);
k = (z > 700); if any(k), logclogitz(k) = z(k); end % fix intermediate overflow

L = z + 2.*logclogitz - log(sigma);
ncen = sum(freq.*cens);
if ncen > 0
    cen = (cens == 1);
    L(cen) = logclogitz(cen);
end
nll = -sum(freq .* L);

if nargout > 1
    t = (2.*logitz - 1) ./ sigma;
    dL1 = t;
    dL2 = z.*t - 1./sigma;
    if ncen > 0
        t = logitz(cen) ./ sigma;
        dL1(cen) = t;
        dL2(cen) = z(cen) .* t;
    end
    ngrad = -[sum(freq .* dL1) sum(freq .* dL2)];
end

% ==== Log-Logistic distribution functions ====

% these distribution functions do not yet handle arrays of parameters

function y = loglpdf(x, mu, sigma)
%LOGLPDF Log-logistic probability density function (pdf).
if (nargin<2), mu=0; end
if (nargin<3), sigma=1; end
sigma(sigma <= 0) = NaN;

nonpos = (x <= 0);
x(nonpos) = realmin;
z = (log(x) - mu) ./ sigma;
c = ones(size(z));
k = (z>350); % prevent Inf/Inf
if any(k)
    z(k) = -z(k);
    c(k) = -1;
end
y = exp(z.*(1-c.*sigma) - mu) ./ ((1 + exp(z)).^2 .* sigma);
y(nonpos) = 0;
% the first and third of these would happen automatically for x==0, but
% generate LogOfZero warnings.  the second would be NaN.
y(x==0 & sigma<1) = 0;
y(x==0 & sigma==1) = 1;
y(x==0 & sigma>1) = Inf;

function p = loglcdf(x, mu, sigma)
%LOGLCDF Log-logistic cumulative distribution function (cdf).
if (nargin<2), mu=0; end
if (nargin<3), sigma=1; end
sigma(sigma <= 0) = NaN;

nonpos = (x <= 0);
x(nonpos) = realmin;
p = 1 ./ (1 + exp(-(log(x) - mu) ./ sigma));
% this would happen automatically for x==0, but generates LogOfZero warnings
p(nonpos) = 0;

function x = loglinv(p, mu, sigma)
%LOGLINV Inverse of the log-logistic cumulative distribution function (cdf).
if (nargin<2), mu=0; end
if (nargin<3), sigma=1; end
sigma(sigma <= 0) = NaN;

x = exp(logit(p).*sigma + mu);

function r = loglrnd(mu, sigma, varargin)
%LOGLRND Random arrays from the log-logistic distribution.
if (nargin<1), mu=0; end
if (nargin<2), sigma=1; end
sigma(sigma <= 0) = NaN;

[err, sizeOut] = statsizechk(2,mu,sigma,varargin{:});
if err > 0
    error('stats:loglrnd:InconsistentSizes','Size information is inconsistent.');
end

p = rand(sizeOut);
r = exp(log(p./(1-p)).*sigma + mu);

function [m,v] = loglstat(mu, sigma)
%LOGLSTAT Mean and variance for the log-logistic distribution.
if (nargin<1), mu=0; end
if (nargin<2), sigma=1; end
sigma(sigma <= 0) = NaN;

if sigma < 1
    m = exp(mu + gammaln(1+sigma) + gammaln(1-sigma));
else
    m = Inf;
end
if sigma < .5
    v = exp(2.*mu + gammaln(1+2.*sigma) + gammaln(1-2.*sigma)) - m.^2;
else
    v = Inf;
end

function [nlogL,acov] = logllike(params,data,cens,freq)
%LOGLLIKE Negative log-likelihood for the log-logistic distribution.
if nargin < 4 || isempty(freq), freq = ones(size(data)); end
if nargin < 3 || isempty(cens), cens = zeros(size(data)); end

nlogL = logl_nloglf(params, data, cens, freq);
if nargout > 1
    acov = mlecov(params, data, 'nloglf',@logl_nloglf, 'cens',cens, 'freq',freq);
end

% ==== Log-Logistic fitting functions ====

function [phat,pci] = loglfit(x,alpha,cens,freq,opts)
%LOGLFIT Parameter estimates and confidence intervals for log-logistic data.

if nargin < 2 || isempty(alpha), alpha = .05; end
if nargin < 3 || isempty(cens), cens = zeros(size(x)); end
if nargin < 4 || isempty(freq), freq = ones(size(x)); end
if nargin < 5, opts = []; end

if any(x <= 0)
    error('stats:loglfit:BadData','The data in X must be positive');
end

% Moment estimators as starting point
logxunc = log(x(cens == 0));
start = [mean(logxunc) std(logxunc).*sqrt(3)./pi];

% The default options include turning statsfminbx's display off.  This
% function gives its own warning/error messages, and the caller can turn
% display on to get the text output from statsfminbx if desired.
options = statset(statset('loglfit'), opts);
tolBnd = options.TolBnd;
options = optimset(options);
dfltOptions = struct('DerivativeCheck','off', 'HessMult',[], ...
    'HessPattern',ones(2,2), 'PrecondBandWidth',Inf, ...
    'TypicalX',ones(2,1), 'MaxPCGIter',1, 'TolPCG',0.1);

% Maximize the log-likelihood with respect to mu and sigma.
funfcn = {'fungrad' 'loglfit' @logl_nloglf [] []};
[phat, nll, lagrange, err, output] = ...
         statsfminbx(funfcn, start, [-Inf; tolBnd], [Inf; Inf], ...
                     options, dfltOptions, 1, x, cens, freq);
if (err == 0)
    % statsfminbx may print its own output text; in any case give something
    % more statistical here, controllable via warning IDs.
    if output.funcCount >= options.MaxFunEvals
        wmsg = 'Maximum likelihood estimation did not converge.  Function evaluation limit exceeded.';
    else
        wmsg = 'Maximum likelihood estimation did not converge.  Iteration limit exceeded.';
    end
    warning('stats:loglfit:IterOrEvalLimit',wmsg);
elseif (err < 0)
    error('stats:loglfit:NoSolution',...
          'Unable to reach a maximum likelihood solution.');
end

if nargout > 1
    acov = mlecov(phat, x, 'nloglf',@logi_nloglf, 'cens',cens, 'freq',freq);
    probs = [alpha/2; 1-alpha/2];
    se = sqrt(diag(acov))';

    % Compute the CI for mu using a normal approximation for muhat.
    pci(:,1) = norminv(probs, phat(1), se(1));

    % Compute the CI for sigma using a normal approximation for
    % log(sigmahat), and transform back to the original scale.
    % se(log(sigmahat)) is se(sigmahat) / sigmahat.
    logsigci = norminv(probs, log(phat(2)), se(2)./phat(2));
    pci(:,2) = exp(logsigci);
end

function [nll,ngrad] = logl_nloglf(parms, x, cens, freq)
%LOGL_NLOGLF Objective function for log-logistic maximum likelihood.
mu = parms(1);
sigma = parms(2);
logx = log(x);
z = (logx - mu) ./ sigma;
logitz = 1 ./ (1 + exp(-z));
clogitz = 1 ./ (1 + exp(z));
logclogitz = log(clogitz);
k = (z > 700); if any(k), logclogitz(k) = z(k); end % fix intermediate overflow

L = z + 2.*logclogitz - log(sigma) - logx;
ncen = sum(freq.*cens);
if ncen > 0
    cen = (cens == 1);
    L(cen) = logclogitz(cen);
end
nll = -sum(freq .* L);

if nargout > 1
    t = (2.*logitz - 1) ./ sigma;
    dL1 = t;
    dL2 = z.*t - 1./sigma;
    if ncen > 0
        t = logitz(cen) ./ sigma;
        dL1(cen) = t;
        dL2(cen) = z(cen) .* t;
    end
    ngrad = -[sum(freq .* dL1) sum(freq .* dL2)];
end

% ==== utility functions ====

function logitp = logit(p)
%LOGIT Logistic transformation, handling edge and out of range.
logitp = repmat(NaN,size(p));
logitp(p==0) = -Inf;
logitp(p==1) = Inf;
ok = (0<p & p<1);
logitp(ok) = log(p(ok)./(1-p(ok)));


%% element2lattice
% Below is a demonstration of the features of the |element2lattice| function

%%
clear; close all; clc;

%% Syntax
% |[Es,Vs,Cs]=element2lattice(E,V,cPar);|

%% Description
% This function converts an element description (elements and vertices i.e
% nodes into a lattice structure. The lattice structure is returned as a
% hexahederal mesh.

%% Examples
%

%%
% Plot settings
cMap=gjet(4);
fontSize=15;

%% Example: Creating a lattice structure on a hexahedral element

%%
% Creating example geometry.
boxDim=[1 1 1];
boxEl=[1 1 1];
[meshStruct]=hexMeshBox(boxDim,boxEl);
E=meshStruct.E;
V=meshStruct.V;
F=meshStruct.F;
[indBoundary]=tesBoundary(F);

%%
% Create lattice structure
controlParameter.shrinkFactor=0.2; %Strut sides are formed by shrinking the input mesh faces by this factor
controlParameter.numDigitKeep=5; %used for merging nodes
controlParameter.meshType='quad'; %desired output mesh type
controlParameter.indBoundary=indBoundary; %indices of the boundary faces
controlParameter.latticeSide=1; %1=side 1 the edge lattice, 2=side 2 the dual lattice to the edge lattice
[Fs1,Vs1,Cs1]=element2lattice(E,V,controlParameter); %Get lattice structure

%%
% Visualizing input mesh and lattice structures

cFigure;
title('An edge lattice structure on a hexahedral element','fontSize',fontSize)
hold on;
hp1=gpatch(F,V,0.5*ones(1,3),'k',0.25,4);
hp2=gpatch(Fs1(Cs1==0,:),Vs1,Cs1(Cs1==0));
hp3=gpatch(Fs1(Cs1==1,:),Vs1,Cs1(Cs1==1));
legend([hp1,hp2,hp3],'Input mesh','Inner faces','Boundary faces')
colormap(cMap);
cLim=caxis;
axisGeom(gca,fontSize);
camlight headlight; lighting flat;

drawnow;

%% Example: Different lattice sides

%%
% Creating example geometry.
boxDim=[1 1 1];
boxEl=[1 1 1];
[meshStruct]=hexMeshBox(boxDim,boxEl);
E=meshStruct.E;
V=meshStruct.V;
F=meshStruct.F;
[indBoundary]=tesBoundary(F);

%%
% Compute other "lattice side"
controlParameter.shrinkFactor=0.2; %Strut sides are formed by shrinking the input mesh faces by this factor
controlParameter.numDigitKeep=5; %used for merging nodes
controlParameter.meshType='quad'; %desired output mesh type
controlParameter.indBoundary=indBoundary; %indices of the boundary faces
controlParameter.latticeSide=2; %1=side 1 the edge lattice, 2=side 2 the dual lattice to the edge lattice
[Fs2,Vs2,Cs2]=element2lattice(E,V,controlParameter); %Get lattice structure

%%
% Visualizing input mesh and lattice structures

cFigure;
hs=subplot(2,2,1);
title('The input mesh','fontSize',fontSize)
hold on;
gpatch(F,V,0.5*ones(1,3),'k',0.25,3);
axisGeom(gca,fontSize);
camlight headlight; lighting flat;
ha=axis; axis off;

subplot(2,2,2);
title('The two complementary lattice structures','fontSize',fontSize)
hold on;
gpatch(F,V,0.5*ones(1,3),'k',0.25,3);
gpatch(Fs1,Vs1,Cs1);
gpatch(Fs2,Vs2,Cs2);
colormap(cMap);
cLim=caxis;
axisGeom(gca,fontSize);
camlight headlight; lighting flat;
axis(ha); axis off;

subplot(2,2,3);
title('Lattice side 1','fontSize',fontSize)
hold on;
gpatch(F,V,0.5*ones(1,3),'k',0.25,3);
gpatch(Fs1,Vs1,Cs1);
colormap(cMap);
caxis(cLim);
axisGeom(gca,fontSize);
camlight headlight; lighting flat;
axis(ha); axis off;

subplot(2,2,4);
title('Lattice side 2','fontSize',fontSize)
hold on;
gpatch(F,V,0.5*ones(1,3),'k',0.25,3);
gpatch(Fs2,Vs2,Cs2);
colormap(cMap);
caxis(cLim);
axisGeom(gca,fontSize);
camlight headlight; lighting flat;
axis(ha); axis off;

drawnow;

%% Example: Refining the lattice structure

%%
% Refining a lattice structure by first refining the input mesh

cFigure;
gtitle('Lattice structure refinement',fontSize);

for q=1:4
    if q>1
        [E,V]=subHex(E,V,1); %Refine input mesh
        [F]=element2patch(E); %Patch data for plotting
        [indBoundary]=tesBoundary(F);
        controlParameter.indBoundary=indBoundary; %indices of the boundary faces
    end

    [Fs1,Vs1,Cs1]=element2lattice(E,V,controlParameter); %Get lattice structure

    % Visualizing input mesh and lattice structures

    subplot(2,2,q);
    hold on; title(['Split iteration ',num2str(q)]);
    gpatch(Fs1,Vs1,Cs1);
    colormap(cMap);
    axisGeom(gca,fontSize);
    camlight headlight; lighting flat;

end
drawnow;

%% Example: Creating a lattice structure on tetrahedral elements

%%
% Creating example geometry.

[V,~]=platonic_solid(1,1); %A single tetrahedron
E=[2 3 4 1]; %The element description
[E,V]=subTet(E,V,1); %Refine the tetrahedron once
[F]=element2patch(E); %Patch data for plotting
[indBoundary]=tesBoundary(F); %Get boundary face indices

%%
% Create lattice structure
controlParameter.shrinkFactor=0.2; %Strut sides are formed by shrinking the input mesh faces by this factor
controlParameter.numDigitKeep=5; %used for merging nodes
controlParameter.meshType='quad'; %desired output mesh type
controlParameter.indBoundary=indBoundary; %indices of the boundary faces

controlParameter.latticeSide=1; %1=side 1 the edge lattice, 2=side 2 the dual lattice to the edge lattice
[Fs1,Vs1,Cs1]=element2lattice(E,V,controlParameter); %Get lattice structure

%%
% Visualizing input mesh and lattice structures

cFigure;
title('An edge lattice structure on a hexahedral element','fontSize',fontSize)
hold on;
hp1=gpatch(F,V,0.5*ones(1,3),'k',0.25,4);
hp2=gpatch(Fs1(Cs1==0,:),Vs1,Cs1(Cs1==0));
hp3=gpatch(Fs1(Cs1==1,:),Vs1,Cs1(Cs1==1));
legend([hp1,hp2,hp3],'Input mesh','Inner faces','Boundary faces')
colormap(cMap);
cLim=caxis;
axisGeom(gca,fontSize);
camlight headlight; lighting flat;

drawnow;

%% Example: Different lattice sides

%%
% Compute other "lattice side"
controlParameter.latticeSide=2; %1=side 1 the edge lattice, 2=side 2 the dual lattice to the edge lattice
[Fs2,Vs2,Cs2]=element2lattice(E,V,controlParameter); %Get lattice structure

%%
% Visualizing input mesh and lattice structures

cFigure;
hs=subplot(2,2,1);
title('The input mesh','fontSize',fontSize)
hold on;
gpatch(F,V,0.5*ones(1,3),'k',0.25,3);
axisGeom(gca,fontSize);
camlight headlight; lighting flat;
ha=axis; axis off;

subplot(2,2,2);
title('The two complementary lattice structures','fontSize',fontSize)
hold on;
gpatch(F,V,0.5*ones(1,3),'k',0.25,3);
gpatch(Fs1,Vs1,Cs1);
gpatch(Fs2,Vs2,Cs2);
colormap(cMap);
cLim=caxis;
axisGeom(gca,fontSize);
camlight headlight; lighting flat;
axis(ha); axis off;

subplot(2,2,3);
title('Lattice side 1','fontSize',fontSize)
hold on;
gpatch(F,V,0.5*ones(1,3),'k',0.25,3);
gpatch(Fs1,Vs1,Cs1);
colormap(cMap);
caxis(cLim);
axisGeom(gca,fontSize);
camlight headlight; lighting flat;
axis(ha); axis off;

subplot(2,2,4);
title('Lattice side 2','fontSize',fontSize)
hold on;
gpatch(F,V,0.5*ones(1,3),'k',0.25,3);
gpatch(Fs2,Vs2,Cs2);
colormap(cMap);
caxis(cLim);
axisGeom(gca,fontSize);
camlight headlight; lighting flat;
axis(ha); axis off;

drawnow;

%% Example: Changing lattice strut thickness (and porosity)

%%
% The strut thickness of the lattice depends on the shrinkfactor.

% Create lattice structure
controlParameter.numDigitKeep=5; %used for merging nodes
controlParameter.meshType='quad'; %desired output mesh type
controlParameter.indBoundary=indBoundary; %indices of the boundary faces

shrinkFactorSet=linspace(0.1,0.5,4);

for latticeSide=1:2
    controlParameter.latticeSide=latticeSide;
    cFigure;
    gtitle('Lattice structure porosity control',fontSize);

    for q=1:4
        controlParameter.shrinkFactor=shrinkFactorSet(q); %Strut sides are formed by shrinking the input mesh faces by this facto

        [Fs1,Vs1,Cs1]=element2lattice(E,V,controlParameter); %Get lattice structure

        % Visualizing input mesh and lattice structures
        subplot(2,2,q);
        hold on; title(['Shrink factor ',num2str(pround(shrinkFactorSet(q),3))]);
        gpatch(Fs1,Vs1,Cs1);
        colormap(cMap);
        axisGeom(gca,fontSize);
        camlight headlight; lighting flat;
    end
    drawnow;
end

%% Example: Changing output surface mesh type

%%
% Different output mesh types are available i.e. quadrilateral and
% triangular faces and also hexahedral elements.

meshTypeSet={'quad','tri'};

boxDim=[1 1 1];
boxEl=[1 1 1];
[meshStruct]=hexMeshBox(boxDim,boxEl);
E=meshStruct.E;
V=meshStruct.V;
F=meshStruct.F;
[indBoundary]=tesBoundary(F);

clear controlParameter

% Create lattice structure
controlParameter.latticeSide=2;
controlParameter.numDigitKeep=5; %used for merging nodes
controlParameter.indBoundary=indBoundary; %indices of the boundary faces
controlParameter.shrinkFactor=0.3;

cFigure;
gtitle('Lattice structure mesh output type control',fontSize);

for q=1:numel(meshTypeSet)
    controlParameter.meshType=meshTypeSet{q}; %The current mesh type

    [Fs1,Vs1,Cs1]=element2lattice(E,V,controlParameter); %Get lattice structure

    % Visualizing input mesh and lattice structures
    subplot(1,numel(meshTypeSet),q);
    hold on; title(['Mesh type ',meshTypeSet{q}]);
    gpatch(Fs1,Vs1,Cs1,'k',0.8,2);
    colormap(gjet(250));
    axisGeom(gca,fontSize);
    camlight headlight; lighting flat;
end
drawnow;

%% Example: Exporting hexahedral elements instead of surface elements

%%
% The |element2patch| function can also be used to export hexahedral
% elements directly by setting the meshType parameter to 'hex'.
% Furthermore, it is possible to subdevide the ellongated hexahedral
% elements using a certain number of split iterations. Below is an example
% of hexahedral element output with increasing number of split iterations
% used for the ellongated hexahedral elements.

boxDim=[1 1 1];
boxEl=[1 1 1];
[meshStruct]=hexMeshBox(boxDim,boxEl);
E=meshStruct.E;
V=meshStruct.V;
F=meshStruct.F;
[indBoundary]=tesBoundary(F);

clear controlParameter

% Create lattice structure
controlParameter.latticeSide=2;
controlParameter.numDigitKeep=5; %used for merging nodes
controlParameter.indBoundary=indBoundary; %indices of the boundary faces
controlParameter.shrinkFactor=0.25;
controlParameter.meshType='hex';

hexSplitSet=[0 1 2];
cFigure;
gtitle('Lattice structure hex element output and element mesh refinement',fontSize);

c=1; %counter for plotting
for latticeSide=1:2
    controlParameter.latticeSide=latticeSide;
    for q=1:numel(hexSplitSet)
        controlParameter.hexSplit=hexSplitSet(q); %The current mesh type

        [Es1,Vs1,Cs1]=element2lattice(E,V,controlParameter); %Get lattice structure

        [Fs1,Cs1F]=element2patch(Es1,Cs1); %Patch data for plotting

        % Visualizing input mesh and lattice structures
        subplot(2,numel(hexSplitSet),c);
        hold on; title(['hexSplit=',num2str(hexSplitSet(q))]);
        gpatch(Fs1,Vs1,Cs1F,'k',0.8,2);
        colormap(gjet(250));
        axisGeom(gca,fontSize);
        camlight headlight; lighting flat;
        c=c+1;
    end
end
drawnow;

%%
%

[V,F]=platonic_solid(1,1);
E=[1 2 4 3];

%
% boxDim=[1 1 1];
% boxEl=[1 1 1];
% [meshStruct]=hexMeshBox(boxDim,boxEl);
% E=meshStruct.E;
% V=meshStruct.V;
% F=meshStruct.F;
[indBoundary]=tesBoundary(F);

clear controlParameter

% Create lattice structure
controlParameter.latticeSide=2;
controlParameter.numDigitKeep=5; %used for merging nodes
controlParameter.indBoundary=indBoundary; %indices of the boundary faces
controlParameter.shrinkFactor=0.25;
controlParameter.meshType='hex';

hexSplitSet=[0 1 2];
cFigure;
gtitle('Lattice structure hex element output and element mesh refinement',fontSize);

c=1; %counter for plotting
for latticeSide=1:2
    controlParameter.latticeSide=latticeSide;
    for q=1:numel(hexSplitSet)
        controlParameter.hexSplit=hexSplitSet(q); %The current mesh type

        [Es1,Vs1,Cs1]=element2lattice(E,V,controlParameter); %Get lattice structure

        [Fs1,Cs1F]=element2patch(Es1,Cs1); %Patch data for plotting

        % Visualizing input mesh and lattice structures
        subplot(2,numel(hexSplitSet),c);
        hold on; title(['hexSplit=',num2str(hexSplitSet(q))]);
        gpatch(Fs1,Vs1,Cs1F,'k',0.8,2);
        colormap(gjet(250));
        axisGeom(gca,fontSize);
        camlight headlight; lighting flat;
        c=c+1;
    end
end
drawnow;

%% Example: Creating lattice structure variations through input mesh conversion/subdevission

cPar.shrinkFactor=0.25;
cPar.numDigitKeep=5;
cPar.meshType='quad';

cParSmooth.Method='HC';
cParSmooth.n=10;

cFigure;
c=1;
for latticeSide=1:2
    for testCase=1:3

        switch testCase
            case 1
                boxEl=[1 1 1];
                [meshStruct]=hexMeshBox(boxDim,boxEl);
                E=meshStruct.E;
                V=meshStruct.V;
                F=meshStruct.F;
                Ft=F;
                Vt=V;
                [E,V]=subHex(E,V,1,1);
            case 2
                boxEl=[1 1 1];
                [meshStruct]=hexMeshBox(boxDim,boxEl);
                E=meshStruct.E;
                V=meshStruct.V;
                F=meshStruct.F;
                Ft=F;
                Vt=V;
                [E,V]=subHex(E,V,1,1);
                [E,V,~]=hex2tet(E,V,[],1);
            case 3
                boxEl=[1 1 1];
                [meshStruct]=hexMeshBox(boxDim,boxEl);
                E=meshStruct.E;
                V=meshStruct.V;
                F=meshStruct.F;
                Ft=F;
                Vt=V;
                [E,V,~]=hex2tet(E,V,[],1);
                [E,V]=tet2hex(E,V);
        end

        %Get boundary indices
        [F]=element2patch(E); %Patch data for plotting
        [indBoundary]=tesBoundary(F); %Boundary indices

        %Compute lattice
        cPar.latticeSide=latticeSide;
        cPar.indBoundary=indBoundary;
        [Fn,Vn,Cn]=element2lattice(E,V,cPar);

%         %Refine mesh
%         [Fn,Vn]=subQuad(Fn,Vn,1);
%         Cn=repmat(Cn,[4 1]); %Replicate color info
%
%         %Smoothen
%         indRigid=Fn(Cn==1,:);
%         indRigid=unique(indRigid(:)); %Indices for boundary elements to hold on to
%         cParSmooth.RigidConstraints=indRigid;
%         if cParSmooth.n>0
%             [Vn]=tesSmooth(Fn,Vn,[],cParSmooth); %Smoothen mesh
%         end

        %Visualize
        subplot(2,3,c); hold on;
        gpatch(Ft,Vt,0.5*ones(1,3),'k',0.25);
        gpatch(Fn,Vn,Cn,'k',1);
        colormap(cMap);
        axisGeom(gca,fontSize);
        camlight headlight;
        lighting flat;

        c=c+1;
    end
end
drawnow;

%% Example: Create lattice structures on arbitry input meshes
% Below is an example of a general tetrahedral mesh

%%

testCase=2;
switch testCase
    case 1
        [F,V,~]=geoSphere(2,1); % Building a geodesic dome surface model
    case 2
        [F,V]=stanford_bunny('g'); %Bunny
        V_mean=mean(V,1);
        V=V-V_mean(ones(size(V,1),1),:);
end

%%
% Using tetgen to create a tetrahedral mesh (see |HELP_runTetGen|)

stringOpt='-pq1.2AaY';

inputStruct.stringOpt=stringOpt;
inputStruct.Faces=fliplr(F);
inputStruct.Nodes=V;
inputStruct.holePoints=[];
inputStruct.faceBoundaryMarker=ones(size(F,1),1); %Face boundary markers
inputStruct.regionPoints=getInnerPoint(F,V); %region points
inputStruct.regionA=tetVolMeanEst(F,V);
inputStruct.minRegionMarker=2; %Minimum region marker

[meshOutput]=runTetGen(inputStruct); %Run tetGen

Fb=meshOutput.facesBoundary;
Cb=meshOutput.boundaryMarker;
V=meshOutput.nodes;
CE=meshOutput.elementMaterialID;
E=meshOutput.elements;
F=meshOutput.faces;
[indBoundary]=tesBoundary(F); %Boundary indices

%%
% Create lattice structure

% Define spatially varying (on nodes) shrink factor
s=V(:,1);
s=s-min(s(:));
s=s./max(s(:));
s=(s*0.6)+0.05;

clear controlParameter
controlParameter.shrinkFactor=s; %Strut sides are formed by shrinking the input mesh faces by this factor
controlParameter.numDigitKeep=5; %used for merging nodes
controlParameter.meshType='quad'; %desired output mesh type
controlParameter.indBoundary=indBoundary; %indices of the boundary faces
controlParameter.latticeSide=1; %1=side 1 the edge lattice, 2=side 2 the dual lattice to the edge lattice

[Fs1,Vs1,Cs1]=element2lattice(E,V,controlParameter); %Get lattice structure

%%
% PLOTTING MODEL

%Selecting half of the model to see interior
Y=V(:,2); YE=mean(Y(E),2);
logicCutView=YE>mean(Y);
[Fs,Cs]=element2patch(E(logicCutView,:),CE(logicCutView),'tet4');

cFigure;
hold on;
title('Cut view of tetrahedral mesh model','FontSize',fontSize);
gpatch(Fb,V,0.5*ones(1,3),'none',0.5);
gpatch(Fs,V,Cs,'k',1);
camlight headlight;
axisGeom(gca,fontSize);
axis off;
colormap(cMap);
drawnow;

%%
% Visualize lattice structure
cFigure;
hold on;
title('Lattice structure on arbitrary input mesh','FontSize',fontSize);
% gpatch(Fb,V,0.5*ones(1,3),'none',0.5);
gpatch(Fs1,Vs1,Cs1,'none',1);
camlight headlight; lighting flat;
axisGeom(gca,fontSize);
axis off;
colormap(cMap);
drawnow;

%%
%
% <<gibbVerySmall.gif>>
%
% _*GIBBON*_
% <www.gibboncode.org>
%
% _Kevin Mattheus Moerman_, <gibbon.toolbox@gmail.com>

%%
% _*GIBBON footer text*_
%
% License: <https://github.com/gibbonCode/GIBBON/blob/master/LICENSE>
%
% GIBBON: The Geometry and Image-based Bioengineering add-On. A toolbox for
% image segmentation, image-based modeling, meshing, and finite element
% analysis.
%
% Copyright (C) 2006-2022 Kevin Mattheus Moerman and the GIBBON contributors
%
% 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 [GB] = bit2GB(bit)
% Convert computery things from bits to gigabytes.
% Chad A. Greene 2012
GB = bit*2^-33;


%Corrects the navigation states using the Kalman generated error values
%if size(att)=[4,1], it assumes att=qbn else it assumes att=Cbn
%vel=Vn
%dx=corrections where position errors are defined as dr^n (order:[pos, vel, att])
%delta_x(k)=K(delta_y(k)-h(delta_x(k|k-1)))=K*delta_y(k)

function [att_new, Ve_new, ecef_new]=correctnav_eframe_v000(att, Ve, ecef, dx)

%Correct the position
ecef_new=ecef-dx(1:3);

%velocity correction
Ve_new=Ve-dx(4:6);

%attitude correction
if (size(att,1)==3) %attitude is represented as DCM
    Cet=rot2dcm_v000(dx(7:9));   %Erroneous to true navigation frame:DCM=(I+S(ang))
    att_new=Cet*att;
else %attitude is quaternion
    %Method I
    qet=rvec2quat_v000(dx(7:9));
    att_new=quatmult_v000(qet, att);

%     %Method II:
%     %Method I involves some trigonometric functions. Here is a
%     %algebraic correction method (See: Chung 1996-Eq:16) (Special thanks to Kaygisiz)
%     R=[-q(2) -q(3) -q(4);q(1) q(4) -q(3);q(-4) q(1) q(2);q(3) q(-2) q(1)];
%     dq=-0.5*R*dx(7:9);
%     att_new=att_new-dq;
%     att_new=att_new/norm(att_new);  %optional
end


function [p1,p2,dp1,dp2] = acrobotKinematics(z,p)
% [p1,p2,dp1,dp2] = acrobotKinematics(z,p)
%
% This function computes the mechanical energy of the acrobot.
%
% INPUTS:
%   z = [4,n] = state vector
%   p = parameter struct:
%       .m1 = elbow mass
%       .m2 = wrist mass
%       .g = gravitational acceleration
%       .l1 = length shoulder to elbow
%       .l2 = length elbow to wrist
%
% OUTPUTS:ls
%   p1 = [2,n] = position of the elbow joint
%   p2 = [2,n] = position of the wrist
%   dp1 = [2,n] = velocity of the elbow joint
%   dp2 = [2,n] = velocity of the wrist
%
% NOTES:
%
%   states:
%       1 = q1 = first link angle
%       2 = q2 = second link angle
%       3 = dq1 = first link angular rate
%       4 = dq2 = second link angular rate
%
%   angles: measured from negative j axis with positive convention
%

q1 = z(1,:);
q2 = z(2,:);
dq1 = z(3,:);
dq2 = z(4,:);

[p1,p2,dp1,dp2] = autoGen_acrobotKinematics(q1,q2,dq1,dq2,p.l1,p.l2);

end


function [weight]=nut_sLORETA(Lp,data,flags)
% weight=nut_sLORETA(Lp,data,flags)
% inputs for regularization contant:
% [1] data.Ryy = sample covariance, for data-dependent regularization
% [2] flags.gamma = user defined regularization constant, or 'auto' for
%     leadfield-based regularization

if nargin<3, flags.gamma=[]; end

L = reshape(Lp,size(Lp,1),size(Lp,2)*size(Lp,3));
G = L*L'; clear L

if isfield(flags,'snr')
    if ~isfield(data,'C') || isempty(data.C)
        data.C = eye(size(data.Ryy));
    end
    gamma = trace(G)/(trace(data.C)*flags.snr^2)
    InvG = inv(G+gamma*data.C);
elseif ~isfield(flags,'gamma') || isempty(flags.gamma)
    gamma = 1e0*max(eig(data.Ryy))
    InvG = inv(G+gamma*eye(size(G)));
elseif isnumeric(flags.gamma)
    gamma = flags.gamma   %* max(eig(data.Ryy))
    InvG = inv(G+gamma*eye(size(G)));
else
    % leadfield-based normalization
    doplot=false;
    x = [-20:20];
    gamma=10.^x; %.* max(eig(data.Ryy));
    numg = length(gamma);
    InvG = zeros([size(G) numg]);
    meanuptr = zeros(numg,1);
    warning('off','MATLAB:nearlySingularMatrix')
    for k=1:numg
        InvG(:,:,k) = inv(G+gamma(k)*eye(size(G)));
        uptr = abs(triu(InvG(:,:,k),1));
        meanuptr(k) = mean(uptr( find(uptr(:)) ));  % mean of matrix without diagonal
    end
    warning('on','MATLAB:nearlySingularMatrix')
    if doplot, figure; plot(x(1:end-2),-diff(diff(log10(meanuptr)))); end
    [dum,idx]=findpeaks(-diff(diff(log10(meanuptr))),'MINPEAKHEIGHT',.1);  % max of second derivation of InvG across gamma magnitudes
    idx = max(idx);
    fprintf('Optimal gamma: 1e%d\n',x(idx));
    InvG = InvG(:,:,idx);
end

Lp1 = squeeze(Lp(:,1,:));
w1 = zeros(size(Lp1));
if size(Lp,2)>1
    Lp2 = squeeze(Lp(:,2,:));
    w2 = zeros(size(Lp2));
end
if size(Lp,2)>2
    Lp3 = squeeze(Lp(:,3,:));
    w3 = zeros(size(Lp3));
end

for i=1:size(Lp,3)
    InvGLp = InvG*Lp1(:,i);
    J = inv(sqrt(Lp1(:,i)'*InvGLp));
    w1(:,i) = InvGLp * J;

    if size(Lp,2)>1
        InvGLp = InvG*Lp2(:,i);
        J = inv(sqrt(Lp2(:,i)'*InvGLp));
        w2(:,i) = InvGLp * J;
    end

    if size(Lp,2)>2
        InvGLp = InvG*Lp3(:,i);
        J = inv(sqrt(Lp3(:,i)'*InvGLp));
        w3(:,i) = InvGLp * J;
    end
end

weight(:,1,:) = w1;
if size(Lp,2)>1
    weight(:,2,:) = w2;
end
if size(Lp,2)>2
    weight(:,3,:) = w3;
end
disp('done');
% end


function [u,s,U_r,U_s,U_pk,U_pd,U_l]  = projAhmPntIntoOmniCamOnRob(Rf, Sf, Spk, Spd, l)

% PROJAHMPNTINTOOMNICAMONROB Project Ahm pnt into omnidirectional camera on robot.
%    [U,S] = PROJAHMPNTINTOOMNICAMONROB(RF, SF, SPK, SPD, L) projects 3D
%    anchored homogeneous points into a omni-cam mounted on a robot,
%    providing also the non-measurable depth. The input parameters are:
%       RF : robot frame
%       SF : omni-cam sensor frame in robot
%       SPK: omni-cam intrinsic parameters [xc yc c d e]'
%       SPD: radial distortion polynom [a0 a1 a2 ...]'
%       L  : 3D anchored homog. point [x y z vx vy vz rho]'
%    The output parameters are:
%       U  : 2D pixel [u v]'
%       S  : non-measurable depth
%
%    The function accepts an ahm points matrix L = [L1 ... Ln] as input.
%    In this case, it returns a pixels matrix  U = [U1 ... Un] and a depths
%    row-vector S = [S1 ... Sn].
%
%    [U,S,U_R,U_S,U_K,U_D,U_L] = ... gives also the jacobians of the
%    observation U wrt all input parameters. Note that this only works for
%    single points.
%
%    See also PINHOLE, TOFRAME, PROJEUCPNTINTOPINHOLEONROB.
%

%   Copyright 2012 Grigory Abuladze @ ASL-vision
%   Copyright 2008-2009 Joan Sola @ LAAS-CNRS.

if nargout <= 2  % No Jacobians requested

    p     = ahm2euc(l);
    [u,s] = projEucPntIntoOmniCamOnRob(Rf, Sf, Spk, Spd, p);

else            % Jacobians requested

    if size(l,2) == 1

        % function calls
        [p,P_l]                     = ahm2euc(l);
        [u,s,U_r,U_s,U_pk,U_pd,U_p] = projEucPntIntoOmniCamOnRob(Rf, Sf, Spk, Spd, p);

        % chain rule
        U_l = U_p*P_l;

    else
        error('??? Jacobians not available for multiple AHM points.')

    end

end

% ========== End of function - Start GPL license ==========

%   # START GPL LICENSE

%---------------------------------------------------------------------
%
%   This file is part of SLAMTB, a SLAM toolbox for Matlab.
%
%   SLAMTB 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.
%
%   SLAMTB 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 SLAMTB.  If not, see <http://www.gnu.org/licenses/>.
%
%---------------------------------------------------------------------

%   SLAMTB is Copyright:
%   Copyright (c) 2008-2010, Joan Sola @ LAAS-CNRS,
%   Copyright (c) 2010-2013, Joan Sola,
%   Copyright (c) 2014-2015, Joan Sola @ IRI-UPC-CSIC,
%   SLAMTB is Copyright 2009
%   by Joan Sola, Teresa Vidal-Calleja, David Marquez and Jean Marie Codol
%   @ LAAS-CNRS.
%   See on top of this file for its particular copyright.

%   # END GPL LICENSE


%%  kmeans algorithm for an image
%---input---------------------------------------------------------
%   Y: 2D image
%   k: number of clusters
%   g: number of GMM components
%---output--------------------------------------------------------
%   X: 2D labels
%   GMM: Gaussian mixture model parameters

function [X GMM]=image_kmeans(Y,k,g)
[m n temp]=size(Y);
y=reshape(Y,[m*n 3]);
x=kmeans(y,k);
X=reshape(x,[m n]);

GMM=get_GMM(X,Y,g);


function [k,a]=invkini(x,y,phi)
global   l1 l2 l3
 l1=1;l2=1;l3=0.5;
xx=x-l3*cos(phi);
yy=y-l3*sin(phi);
k=(xx^2+yy^2-l1^2-l2^2)/(2*l1*l2);
if k > 1
    a=[];
    return
end
t2=acos(k);
d=l1^2+l2^2+2*l1*l2*cos(t2);
cc=(xx*(l1+l2*cos(t2))+yy*l2*sin(t2))/d;
ss=(-xx*l2*sin(t2)+yy*(l1+l2*cos(t2)))/d;
t1=atan2(ss,cc);
t3=phi-t1-t2;
a=[ t1 t2 t3];


function walsh_test04 ( )

%*****************************************************************************80
%
%% WALSH_TEST04 tests FFWT.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 March 2011
%
%  Author:
%
%    John Burkardt
%
  n = 16;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'WALSH_TEST04\n' );
  fprintf ( 1, '  FFWT computes a fast Walsh transform.\n' );

  for j = 1 : 2

    if ( j == 1 )
      seed = 123456789;
      [ w, seed ] = r8vec_uniform_01 ( n, seed );
    else
      w(1:n) = 1 : n;
    end

    x(1:n) = w(1:n);
    w = ffwt ( n, w );
    y(1:n) = w(1:n) / n;
    w = ffwt ( n, w );
    z(1:n) = w(1:n) / n;

    fprintf ( 1, '\n' );
    fprintf ( 1, '     I        X(I)   Y=FFWT(X)/N  Z=FFWT(Y)/N\n' );
    fprintf ( 1, '\n' );
    for i = 1 : n
      fprintf ( 1, '  %4d  %10f  %10f  %10f\n', i, x(i), y(i), z(i) );
    end

  end

  return
end


function test_nint_test03 ( )

%*****************************************************************************80
%
%% TEST03 applies a composite midpoint rule to box regions.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    05 June 2007
%
%  Author:
%
%    John Burkardt
%
  clear

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST03\n' );
  fprintf ( 1, '  Use a simple product rule on box regions.\n' );
  fprintf ( 1, '  Use a fixed spatial dimension.\n' );

  problem_num = get_problem_num ( );

  fprintf ( 1, '\n' );
  fprintf ( 1, ...
    '  Prob   Dim  Subs       Approx          Exact          Error\n' );
  fprintf ( 1, '\n' );

  for problem = 1 : problem_num

    dim_num = 3;
%
%  Set problem data to default values.
%
    p00_default ( problem, dim_num );
%
%  Get the region type.
%
    region = p00_region ( problem );

    if ( strncmpi ( region, 'box', 3 ) )

      for sub_num = 1 : 2 : 5

        result = p00_box_gl05 ( problem, dim_num, sub_num );

        exact = p00_exact ( problem, dim_num );

        if ( exact == r8_huge ( ) )

          fprintf ( 1, '  %4d  %4d  %4d  %14f  %s  %s\n', ...
            problem, dim_num, sub_num, result, ...
            '--------------', '--------------' );

        else

          error = abs ( result - exact );

          fprintf ( 1, '  %4d  %4d  %4d  %14f  %14f  %14f\n', ...
            problem, dim_num, sub_num, result, exact, error );

        end

      end

      fprintf ( 1, '\n' );

    end

  end

  return
end


function [rResult] = relm_HypothesisTest(vRatesH, vRatesN, nNumberSimulation, fMagThreshold)
%RELMTEST
%script to test two earthqauake rate hypotheses using earthquake data
%
% park1=vRatesH;
% park2=vRatesN;
% clear test null;
%     xmin(i)=park1(j,1);
%     xmax(i)=park1(j,2);
%     ymin(i)=park1(j,3);
%     ymax(i)=park1(j,4);
%     zmin(i)=park1(j,5);
%     zmax(i)=park1(j,6);
%     magmin(i)=park1(j,7);
%     magmax(i)=park1(j,8);
%     lamda1(i)=park1(j,9);
%     weight(i)=park1(j,10);
% Get the numbers of observed earthquakes per bin
vNumberQuake = vRatesH(:,11);
% Get the lower magnitude-limits per bin
vMagMin = vRatesH(:,7);
% Get the forecasted numbers of events per bin
vLambdaH = vRatesH(:,9);
vLambdaN = vRatesN(:,9);
% Get the weightings per bins
vWeightH = vRatesH(:,10);
vWeightN = vRatesN(:,10);
vWeightCombined = vWeightH .* vWeightN .* (vMagMin > fMagThreshold);

% Remove rows of matrix for which weight is zero
[nRow, nColumn] = size(vRatesH);
nNewIndex = 0;
for nCnt = 1:nRow
  if vWeightCombined(nCnt)>0
    nNewIndex = nNewIndex + 1;
    vWeight(nNewIndex) = vWeightCombined(nCnt);
    vNumberQuakeSel(nNewIndex) = vNumberQuake(nCnt);
    vLambdaHSel(nNewIndex) = vLambdaH(nCnt);
    vLambdaNSel(nNewIndex) = vLambdaN(nCnt);
    mmin(nNewIndex) = vMagMin(nCnt);
  end
end

% Get the number of events (weighted)
vNumberQuake = vWeight .* vNumberQuakeSel;
nNumberQuake = sum(vNumberQuake);

% Weight the important columns
vLambdaH = vWeight .* vLambdaHSel;
vLambdaN = vWeight .* vLambdaNSel;
% Garbage collection
clear vRatesH vRatesN vLambdaHSel vLambdaNSel vNumberQuakeSel vMagMin vWeightCombined vWeightH vWeightN;

%make a weighted magnitude-frequency plot
%
% mf=[mmin;vNumberQuake;vLambdaH;vLambdaN]';
% mfsort=sortrows(mf);
% mag=mfsort(:,1);
%
% Fobs=flip(cumsum(flip(mfsort(:,2))));
% Fth1=flip(cumsum(flip(mfsort(:,3))));
% Fth2=flip(cumsum(flip(mfsort(:,4))));
% figure%(1)
% semilogy(mag,Fobs,'r',mag,Fth1,'g',mag,Fth2,'b');
% grid;
% axis([3,8,.0001,100]);
%
%    Evaluate whether total number of quakes is consistent with H1
%
%
Nhat=sum(vLambdaH);
peq=poisspdf(nNumberQuake, Nhat); % probability of exactly Nquake
Ple=poisscdf(nNumberQuake, Nhat); % probability of less than or equal to Nquake
Pless=Ple-peq;              % probability of less than Nquake
Pmore=1-Ple;                 % probability of more than Nquake
rResult.P_H_Equal = peq;
rResult.P_H_Less = Pless;
rResult.P_H_More = Pmore;
rResult.Nhat_H = Nhat;
lamcum1=cumsum(vLambdaH)/rResult.Nhat_H;
%   Evaluate whether total number of quakes is consistent with H2
Nhat=sum(vLambdaN);
peq=poisspdf(nNumberQuake, Nhat); % probability of exactly Nquake
Ple=poisscdf(nNumberQuake, Nhat); % probability of less than or equal to Nquake
Pless=Ple-peq;              % probability of less than Nquake
Pmore=1-Ple;                 % probability of more than Nquake
rResult.P_N_Equal = peq;
rResult.P_N_Less = Pless;
rResult.P_N_More = Pmore;
rResult.Nhat_N = Nhat;
lamcum2=cumsum(vLambdaN)/rResult.Nhat_N;
%
%   simulate catalogs according to H1,
%   and evaluate likelihood scores of nsquake1 and real catalog using lamda1 and lamda2
%
try
  nsquake=simulate(nNumberQuake, vLambdaH, nNumberSimulation);
  [rResult.LLR_H, rResult.fRank11, rResult.fRank12] = Rtest(vLambdaH, vLambdaN, vNumberQuake, nsquake, vWeight);
catch
  rResult.LLR_H = nan;
  rResult.fRank11 = nan;
  rResult.fRank12 = nan;
end
%
%   simulate catalogs according to H2,
%   and evaluate likelihood scores of nsquake1 and real catalog using lamda1 and lamda2
%
try
  nsquake=simulate(nNumberQuake, vLambdaN, nNumberSimulation);
  [rResult.LLR_N, rResult.fRank21, rResult.fRank22] = Rtest(vLambdaH, vLambdaN, vNumberQuake, nsquake, vWeight);
catch
  rResult.LLR_N = nan;
  rResult.fRank21 = nan;
  rResult.fRank22 = nan;
end
%
%Plot cumulative likelihood scores for two hypotheses
%
rResult.fAlpha = sum(rResult.LLR_N > 0)/nNumberSimulation;
rResult.fBeta = sum(rResult.LLR_H < 0)/nNumberSimulation;
%index=[1:nNumberSimulation]/nNumberSimulation;
%x=[0,0];y=[0,1];
%figure_w_normalized_uicontrolunits(2);
%plot(rResult.LLR_H,index,'g',rResult.LLR_N,index,'r',x,y,'b')';
%xlabel('Likelihood ratio (Variable b/Constant b)')';
%ylabel('Fraction of cases');
%title('Green assumes variable-b hypothesis; Red assumes constant=b hypothesis');
% nNumberQuake, Nhat1,Nhat2,P1_less,P1_more,P2_less,P2_more, alpha, beta, rank11,rank12, rank21, rank22
rResult.nNumberQuake = nNumberQuake;
rResult.nNumberSimulation = nNumberSimulation;


function [] = gsp_plot_jtv_filter(G, filters, filtertype, param)
%GSP_PLOT_JTV_FILTER  Plot a time-vertex filterbank
%   Usage:  gsp_plot_jtv_filter(G,filters);
%           gsp_plot_jtv_filter(G,filters,param);
%
%   Input parameters:
%       G          : Time-Vertex graph structure
%       filters    : Cell array of time-vertex filters
%       filtertype : Filter domain (ts,js,ts-array,js-array)
%       param      : Structure of optional parameters
%   Output parameters:
%       none
%
%   Example:::
%
%         alpha = [0.1 0.5 1 2];
%         G = gsp_sensor(100);
%         G = gsp_jtv_graph(G,100,1);
%         G = gsp_estimate_lmax(G);
%         [g, filtertype] = gsp_jtv_design_wave(G, alpha);
%         param.domain='time-spectral';
%         gsp_plot_jtv_filter(G, g, filtertype,param);
%         param.domain='joint-spectral';
%         gsp_plot_jtv_filter(G, g, filtertype,param);
%
%
%   Additional parameters
%   ---------------------
%
%   * *param.npoints*  : Number of points where the filters are evaluated if eigenvalues not available (default 100).
%   * *param.show_sum* : Extra plot showing the sum of the squared magnitudes of the filters (default 1 if there is multiple filters).
%   * *param.verbose*  : Verbosity level (1 display the warning - 0 no log) (default 1).
%   * *param.title*    : Cell array of title for subplots. (default 1:Nf)
%   * *param.domain*   : Visualize the spectrum in 'time-spectral' or 'joint-spectral' (default param.domain='joint-spectral')
%

% Author: Francesco Grassi, Nathanael Perraudin
% Date   : September 2016

% Read input parameters
if nargin < 4
    param = struct;
end

if nargin<3
    error('Invalid number of arguments: GSP_PLOT_JTV_FILTER needs the type of time-vertex filter.')
end

Nf=numel(filters);

if ~isfield(param,'show_sum'), param.show_sum = Nf>1; end
if ~isfield(param,'npoints'),  param.npoints = 100; end
if ~isfield(param,'title'),    param.title=num2cell(1:Nf); end
if ~isfield(param,'domain'),   param.domain='joint-spectral'; end
if ~isfield(param,'fftshift'), param.fftshift = 1;end
%% Define axis

if isfield(G,'e')
    lambdas = G.e;
else
    lambdas = linspace(0,G.lmax,param.npoints);
end

switch filtertype
    case  {'ts','ts-array'}
        v = gsp_jtv_ta(G);
    case  {'js','js-array'}
        v = gsp_jtv_fa(G);
    otherwise
        error('Unknown filtertype');
end

%% Evaluating filter

fid = gsp_jtv_filter_evaluate(filters,filtertype,lambdas,v,param);

if param.show_sum
    Nf = Nf+1;
    test_sum = sum(fid.^2,3);
    fid(:,:,Nf) = test_sum;
    param.title{Nf} = 'Sum squared coeff';
end

%% Plot

switch param.domain
    case 'time-spectral'
        [v,xlab] = gsp_jtv_ta(G);
        fid = real(fid);
    case 'joint-spectral'
        [v,xlab] = gsp_jtv_fa(G,param.fftshift);
        fid = abs(fid);
        if param.fftshift
            fid = fftshift(fid,2);
        end
    otherwise
        error('Unknown domain');
end

figure
r = max(1,floor(sqrt(Nf)));
c = max(1,ceil(Nf/r));
for ii=1:Nf
    subplot(r,c,ii)
    imagesc(v,lambdas,fid(:,:,ii))
    xlabel(xlab);
    ylabel('\lambda');
    title(param.title{ii})
    axis xy
end

end


function left = r8vec_bracket4 ( nt, t, ns, s )

%*****************************************************************************80
%
%% R8VEC_BRACKET4 finds the interval to each of a vector of values.
%
%  Discussion:
%
%    An R8VEC is a vector of R8's.
%
%    The routine always returns the index LEFT of the sorted array
%    T with the property that either
%    *  T is contained in the interval [ T(LEFT), T(LEFT+1) ], or
%    *  T < T(LEFT) = T(1), or
%    *  T > T(LEFT+1) = T(N).
%
%    The routine is useful for interpolation problems, where
%    the abscissa must be located within an interval of data
%    abscissas for interpolation, or the "nearest" interval
%    to the (extreme) abscissa must be found so that extrapolation
%    can be carried out.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 April 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NT, length of the input array.
%
%    Input, real T(NT), an array that has been sorted
%    into ascending order.
%
%    Input, integer NS, the number of points to be bracketed.
%
%    Input, real S(NS), values to be bracketed by entries of T.
%
%    Output, integer LEFT(NS).
%    LEFT(I) is set so that the interval [ T(LEFT(I)), T(LEFT(I)+1) ]
%    is the closest to S(I); it either contains S(I), or else S(I)
%    lies outside the interval [ T(1), T(NT) ].
%

%
%  Check the input data.
%
  if ( nt < 2 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8VEC_BRACKET4 - Fatal error!\n' );
    fprintf ( 1, '  NT must be at least 2.\n' );
    error ( 'R8VEC_BRACKET4 - Fatal error!' );
  end

  for i = 1 : ns

    left(i) = floor ( ( nt + 1 ) / 2 );
%
%  CASE 1: S < T(LEFT):
%  Search for S in [T(I), T(I+1)] for intervals I = 1 to LEFT-1.
%
    if ( s(i) < t(left(i)) )

      if ( left(i) == 1 )
        continue
      elseif ( left(i) == 2 )
        left(i) = 1;
        continue
      elseif ( t(left(i)-1) <= s(i) )
        left(i) = left(i) - 1;
        continue
      elseif ( s(i) <= t(2) )
        left(i) = 1;
        continue
      end
%
%  ...Binary search for S in [T(I), T(I+1)] for intervals I = 2 to LEFT-2.
%
      low = 2;
      high = left(i) - 2;

      while ( 1 )

        if ( low == high )
          left(i) = low;
          break
        end

        mid = floor ( ( low + high + 1 ) / 2 );

        if ( t(mid) <= s(i) )
          low = mid;
        else
          high = mid - 1;
        end

      end
%
%  CASE2: T(LEFT+1) < S:
%  Search for S in [T(I),T(I+1)] for intervals I = LEFT+1 to N-1.
%
    elseif ( t(left(i)+1) < s(i) )

      if ( left(i) == nt - 1 )
        continue
      elseif ( left(i) == nt - 2 )
        left(i) = left(i) + 1;
        continue
      elseif ( s(i) <= t(left(i)+2) )
        left(i) = left(i) + 1;
        continue
      elseif ( t(nt-1) <= s(i) )
        left(i) = nt - 1;
        continue
      end
%
%  ...Binary search for S in [T(I), T(I+1)] for intervals I = LEFT+2 to NT-2.
%
      low = left(i) + 2;
      high = nt - 2;

      while ( 1 )

        if ( low == high )
          left(i) = low;
          break
        end

        mid = floor ( ( low + high + 1 ) / 2 );

        if ( t(mid) <= s(i) )
          low = mid;
        else
          high = mid - 1;
        end

      end
%
%  CASE3: T(LEFT) <= S <= T(LEFT+1):
%  S is in [T(LEFT), T(LEFT+1)].
%
    else

    end

  end

  return
end


%% The Piezoelectricity Tensor
%
%%
% In this chapter we discuss how to compute and visualize piezoellectirc
% properties. At first, let us import some piezoelectric contents for a
% quartz specimen.

CS = crystalSymmetry('32', [4.916 4.916 5.4054], 'X||a*', 'Z||c', 'mineral', 'Quartz');

fname = fullfile(mtexDataPath,'tensor', 'Single_RH_quartz_poly.P');

P = tensor.load(fname,CS,'propertyname','piecoelectricity','unit','C/N','DoubleConvention')

%% Plotting the magnitude surface
% The default plot of the magnitude, which indicates, in which direction we
% have the most polarization. By default, we restrict ourselves to the
% unique region implied by crystal symmetry

% set some colormap well suited for tensor visualisation
setMTEXpref('defaultColorMap',blue2redColorMap);

plot(P)
mtexColorbar

%%
% but also, we can plot the whole crystal behavior

close all
plot(P,'complete','smooth','upper')
mtexColorbar

%%
% Most often, the polarization is illustrated as surface magnitude

close all
surf(P.directionalMagnitude)

%%
% Note, that for directions of negative polarization the surface is mapped
% onto the axis of positive, which then let the surface appear as a double
% coverage

%%
% Quite a famous example in various standard literature is a section through
% the surface because it can easily be described as an analytical
% solution. We just specify the plane normal vector

plotSection(P.directionalMagnitude,vector3d.Z)
xlabel('x')
ylabel('y')
drawNow(gcm)

%%
% so we are plotting the polarization in the xy-plane, or the yz-plane with

plotSection(P.directionalMagnitude,vector3d.X)
ylabel('y')
zlabel('z')
drawNow(gcm)

%% Mean Tensor Calculation
% Let us import some data, which was originally published by Mainprice, D.,
% Lloyd, G.E. and Casey , M. (1993) Individual orientation measurements in
% quartz polycrystals: advantages and limitations for texture and
% petrophysical property determinations. J. of Structural Geology, 15,
% pp.1169-1187
%

fname = fullfile(mtexDataPath,'orientation', 'Tongue_Quartzite_Bunge_Euler');

ori = orientation.load(fname,CS, 'ColumnNames', {'Euler 1' 'Euler 2' 'Euler 3'})

%%
% The figure on p.1184 of the publication

Pm = ori.calcTensor(P)

plot(Pm)
mtexColorbar

%%
%

close all
plot(Pm)
mtexColorbar

setMTEXpref('defaultColorMap',WhiteJetColorMap)


function [dfdz,dfdp,sym_dfdz,sym_dfdp] = symDynJac(ode,nstates,nparam)
%SYMJAC  Returns Symbolically Differentiated Partial Derivatives of a Dynamic System
%
%   [dfdz,dfdp] = symDynJac(ode) uses the symbolic toolbox to automatically
%   generate the sensitivity partial derivatives of the function handle ode.
%   You should supply the function handle in the form @(t,z,p) z(1)^2 + p(1)
%   noting t, z and p must be the only variables used, and are indexed in the
%   equation (no vector operations).
%
%   [dfdz,dfdp] = symDynJac(ode,nstates) specifies the number of states in
%   the equation, assuming consecutive ordering. Useful if a state is not
%   specified in the original equation to pad DFDZ with zeros.
%
%   [dfdz,dfdp] = symDynJac(ode,nstates,nparam) specifies the number of
%   parameters in the equation, assuming consecutive ordering. Useful if a
%   parameter is not specified in the original equation to pad DFDP with
%   zeros.

%   Copyright (C) 2013 Jonathan Currie (IPL)

if(nargin < 3), nparam = 0; end
if(nargin < 2), nstates = 0; end

if(~optiCheckSymTBX())
    dfdz = []; sym_dfdz = [];
    dfdp = []; sym_dfdp = [];
    return
end

if(~isa(ode,'function_handle') && ~isa(ode,'barvec'))
    error('Fun should be a function handle!');
end
if(isa(ode,'function_handle') && nargin(ode) ~= 3)
    error('ODE should only have three input arguments (t,z,p)');
end

%Convert ODE to a symbolic expression
if(isa(ode,'function_handle'))
    [symode,ind] = func2sym(ode,{'z','p','t'});
    indz = ind{1}; indp = ind{2};
else
    symode = sym(getEq(ode)); %convert from barvec to symbolic expression
    v = char(symvar(symode));
    indz = 1:length(strfind(v,'z'));
    indp = 1:length(strfind(v,'p'));
end

%Create each symbolic partial derivative
sym_dfdz = symPartialDer(symode,'z',nstates,indz);
sym_dfdp = symPartialDer(symode,'p',nparam,indp);

%Return to function handles (note order of args important and changed)
dfdz = sym2func(sym_dfdz,{'t','z','p'});
dfdp = sym2func(sym_dfdp,{'t','z','p'});


function [B0, beta0, phi0, S0, alpha0]=nwprior(ar,arvar,lambda1,lambda3,lambda4,n,m,p,k,q,prior,priorexo)

% function [B0 beta0 phi0 S0 alpha0]=nwprior(ar,arvar,lambda1,lambda3,lambda4,n,m,p,k,q,prior,bex)
% returns prior values from hyperparameters, for the normal-Wishart prior
% inputs:  - scalar 'ar': prior value of the autoregressive coefficient on own first lag (defined p 15 of technical guide)
%          - vector 'arvar': residual variance of individual AR models estimated for each endogenous variable
%          - scalar 'lambda1': overall tightness hyperparameter (defined p 16 of technical guide)
%          - scalar 'lambda2': cross-variable weighting hyperparameter(defined p 16 of technical guide)
%          - scalar 'lambda3': lag decay hyperparameter (defined p 16 of technical guide)
%          - scalar 'lambda4': exogenous variable tightness hyperparameter (defined p 17 of technical guide)
%          - integer 'n': number of endogenous variables in the BVAR model (defined p 7 of technical guide)
%          - integer 'm': number of exogenous variables in the BVAR model (defined p 7 of technical guide)
%          - integer 'p': number of lags included in the model (defined p 7 of technical guide)
%          - integer 'k': number of coefficients to estimate for each equation in the BVAR model (defined p 7 of technical guide)
%          - integer 'q': total number of coefficients to estimate for the BVAR model (defined p 7 of technical guide)
%          - integer 'prior': value to determine which prior applies to the model
% outputs: - matrix 'B0': the non-vectorised form of beta0
%          - vector 'beta0': vector of prior values for beta (defined in 1.3.4)
%          - matrix 'phi0': prior covariance matrix for the VAR coefficients in the case of a normal-Wishart prior (defined in 1.4.7)
%          - matrix 'S0': prior scale matrix for sigma (defined in 1.4.11)
%          - integer 'alpha0': prior degrees of freedom for sigma (defined in 1.4.11)

% start with beta0, defined in (1.3.4)
beta0=zeros(q,1);

idx = 1:n;
if isscalar(ar)
    beta0((idx-1)*k+idx,1) = ar;
else
    beta0((idx-1)*k+idx,1) = ar(idx,1);
end

% if a prior for the exogenous variables is selected put it in here:
for ii=1:n
    for jj=1:m
        beta0(k*ii-m+jj)=priorexo(ii,jj);
    end
end
% unvectorize (reshape) the vector to obtain the matrix B0
B0=reshape(beta0,k,n);

% next compute phi0, the variance-covariance matrix of beta, defined in (1.4.7)

% set first phi0 as a k*k matrix of zeros
phi0=zeros(k,k);

% set the variance for coefficients on lagged values, using (1.4.5)
for ii=1:n
    for jj=1:p
        phi0((jj-1)*n+ii,(jj-1)*n+ii)=(1/arvar(ii,1))*(lambda1/jj^lambda3)^2;
    end
end

% set the variance for exogenous variables, using (1.4.6)
for ii=1:m
    phi0(k-m+ii,k-m+ii)=(lambda1*lambda4(1,ii))^2;
end

% now compute alpha0 from (1.4.12)
alpha0=n+2;

% and finally compute S0, depending on which choice has been made for the prior ((1.4.13) or identity)
if prior==21
    S0=(alpha0-n-1)*diag(arvar);
elseif prior==22
    S0=eye(n);
else
end


classdef RWMOP17 < PROBLEM
% <multi> <real> <constrained>
% Bulk carriers design problem

%------------------------------- Reference --------------------------------
% A. Kumar, G. Wu, M. Ali, Q. Luo, R. Mallipeddi, P. Suganthan, and S. Das,
% A benchmark-suite of real-world constrained multi-objective optimization
% problems and some baseline results, Swarm and Evolutionary Computation,
% 2021, 67: 100961.
%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    methods
        %% Initialization
        function Setting(obj)
            obj.M        = 3;
            obj.D        = 6;
            obj.lower    = [150.0 20.0 13.0 10.0 14.0 0.63];
            obj.upper    = [274.32 32.31 25.0 11.71 18.0 0.75];
            obj.encoding = ones(1,obj.D);
        end
        %% Evaluate multiple solutions
        function Population = Evaluation(obj,varargin)
            x   = varargin{1};
            L   = x(:,1);
            B   = x(:,2);
            D   = x(:,3);
            T   = x(:,4);
            V_k = x(:,5);
            C_B = x(:,6);

            a   = 4977.06.*C_B.^2 - 8105.61.*C_B + 4456.51;
            b   = -10847.2.*C_B.^2 + 12817.*C_B - 6960.32;
            F_n = 0.5144./(9.8065 .* L).^0.5;
            P   = ((1.025.*L.*B.*T.*C_B).^(2/3).*V_k.^3)./(a + b.*F_n);

            W_s = 0.034.*L.^1.7.*B.^0.6.*D.^0.4.*C_B.^0.5;
            W_o = L.^0.8.*B.^0.6.*D.^0.3.*C_B.^0.1;
            W_m = 0.17.*P.^0.9;
            ls  = W_s+W_o+W_m;

            D_wt  = 1.025.*L.*B.*T.*C_B-ls;
            F_c   = 0.19.*24.*P./1000 + 0.2;
            D_cwt = D_wt - F_c.*((5000.*V_k)./24 + 5)-2.*D_wt.^0.5;
            R_trp = 350./((5000.*V_k)./24 + 2.*(D_cwt./8000 + 0.5));
            ac    = D_cwt.*R_trp;
            S_d   = 5000.*V_k./24;

            C_c = 0.2.*1.3 .* (2000.*W_s.^0.85 + 3500.*W_o + 2400.*P.^0.8);
            C_r = 40000.*D_wt.^0.3;
            C_v = (1.05.*100.*F_c.*S_d + 6.3.*D_wt.^0.8).*R_trp;

            % Objectives
            f(:,1) = (C_c + C_r + C_v)./ac;
            f(:,2) = ls;
            f(:,3) = -ac;

            % Constraints
            g(:,1) = L./B - 6;
            g(:,2) = 15 - L./D;
            g(:,3) = 19 - L./T;
            g(:,4) = 0.45.*D_wt.^0.31 - T;
            g(:,5) = 0.7.*D + 0.7 - T;
            g(:,6) = 0.32 - F_n;
            g(:,7) = 0.53.*T + ((0.085.*C_B - 0.002).*B.^2)./(T.*C_B)-(1 + 0.52.*D) - 0.07.*B;
            g(:,8) = D_wt - 3000;
            g(:,9) = 500000 - D_wt;
            g      = -g;
            Population = SOLUTION(varargin{1},f,g,varargin{2:end});
            obj.FE     = obj.FE + length(Population);
        end
        %% Generate a point for hypervolume calculation
        function R = GetOptimum(obj,~)
            R = [-3.1514157e+03   8.2606298e+03   8.1260004e+02];
        end
    end
end


close all; clear all
% pde = HodgeLaplacianEdata1;
pde = HodgeLaplacianFdata1;
[node,elem] = squaremesh([0,1,0,1],1/32);
% bdFlag = setboundary(node,elem,'Neumann');
% Pure Neumann boundary condition doesn't work.
% bdFlag = setboundary(node,elem,'Dirichlet');
bdFlag = setboundary(node,elem,'Dirichlet','x==0','Neumann','~(x==0)');

err = zeros(4,1); N = zeros(4,1);
option = [];
for i = 1:4
%     [sigma,u] = HodgeLaplacianE(node,elem,pde,bdFlag,option);
    [sigma,u,AD] = HodgeLaplacianF(node,elem,pde,bdFlag,option);
    err(i) = getL2error(node,elem,pde.exactsigma,sigma);
    N(i) = size(u,1);
    [node,elem,bdFlag] = uniformrefine(node,elem,bdFlag);
end
showrate(N,err,2);


function [u,sigma,eqn,info] = PoissonRT0(node,elem,pde,bdFlag,option)
%% POISSONRT0 Poisson equation: lowest order RT element.
%
%  [u,sigma] = PoissonRT0(node,elem,pde,bdFlag) produces an approximation of
%  the Poisson equation
%
%       -div(d*grad(u))=f  in \Omega, with
%       Dirichlet boundary condition u=g_D on \Gamma_D,
%       Neumann boundary condition   d*grad(u)*n=g_N on \Gamma_N
%
%  in the mixed formulation:
%
%  ------------------------------------------------------------------------
%  Find (\sigma , u) in H_{g_N,\Gamma_N}(div,\Omega)\times L^2(\Omega) s.t.
%
%  (d^-1\sigma,\tau) - (div \tau, u)  = <\tau*n,g_D>_{\Gamma_D}
%  \forall \tau in H_{0,\Gamma_N}(div,\Omega)
%    - (div \sigma, v)                =  -(f,v)
%  \forall v in L^2(\Omega)
%
%  where
%  H_{g,\Gamma}(div,\Omega) = {\sigma \in H(div,\Omega); \sigma*n = g
%  on \Gamma \subset \partial\Omega }.
%  ------------------------------------------------------------------------
%
%  The unknown sigma = d*grad(u) is approximated using the lowest order
%  Raviart-Thomas element and u by piecewise constant element (with basis 1).
%
%  [u,sigma] = PoissonRT0(node,elem,pde,bdFlag,option) specifies options
%   - option.solver
%     'direct': the built in direct solver \ (mldivide)
%     'dmg':     multigrid-type solvers mg is used.
%     'uzawapcg': PCG for the Schur complement equation
%     'none': only assemble the matrix equation but not solve
%
%   The default setting is to use the direct solver for small size problems
%   and transforming based multigrid solvers for large size problems.
%
%  Example
%
%    exampleRT0
%
% Created by Ming Wang. Reorganized by Long Chen. Change basis for u.
%
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

if ~exist('option','var'), option = []; end

%% Diffusion coefficient
if ~isfield(pde,'d'), pde.d = []; end
if isfield(pde,'d') && ~isempty(pde.d)
   if isnumeric(pde.d)
      K = pde.d;                   % d is an array
   else                            % d is a function
      center = (node(elem(:,1),:) + node(elem(:,2),:) + node(elem(:,3),:))/3;
      K = pde.d(center);  % take inverse sequencil.
   end
else
    K = [];
end

%% Data structure
elemold = elem;
[elem,bdFlag] = sortelem(elem,bdFlag);  % ascend ordering
[elem2edge,edge] = dofedge(elem);
NT = size(elem,1); NE = size(edge,1);
[Dlambda,area,elemSign] = gradbasis(node,elem);

%% Assemble matrix
Nsigma = NE; Nu = NT; Ndof = Nsigma + Nu;

% M. Mass matrix for RT0 element
M = getmassmatvec(elem2edge,area,Dlambda,'RT0',K);

% B. negative divergence operator
B = icdmat(double(elem2edge),elemSign*[1 -1 1]);

% C. zero matrix.
C = sparse(Nu,Nu);

A = [M B';B C];

%% Assemble right hand side.
fu = zeros(Nu,1);
if ~isfield(pde,'f') || (isreal(pde.f) && (pde.f==0))
    pde.f = [];
end
if ~isfield(option,'fquadorder')
    option.fquadorder = 2;   % default order
end
if ~isempty(pde.f)
	[lambda,weight] = quadpts(option.fquadorder);
	nQuad = size(lambda,1);
    for p = 1:nQuad
		% quadrature points in the x-y coordinate
		pxy = lambda(p,1)*node(elem(:,1),:) ...
			+ lambda(p,2)*node(elem(:,2),:) ...
			+ lambda(p,3)*node(elem(:,3),:);
		fp = pde.f(pxy);
		fu = fu - fp*weight(p);
    end
    fu = fu.*area;
end
clear fp area
F((Nsigma+1):(Ndof),1) = fu;

%% Boundary Conditions
if ~exist('bdFlag','var'), bdFlag = []; end
[AD,F,bigu,freeDof,isPureNeumannBC] = getbdRT0(F);
eqn = struct('M',AD(1:NE,1:NE),'B',AD(NE+1:end,1:NE),'C',AD(NE+1:end,NE+1:end),...
             'f',F(1:NE),'g',F(NE+1:end),'freeDof',freeDof);

%% Solve the linear system.
% Set up solver type
if isempty(option) || ~isfield(option,'solver')    % no option.solver
    if Ndof <= 2e3  % Direct solver for small size systems
        option.solver = 'direct';
    else         % MGCG  solver for large size systems
        option.solver = 'dmg';
    end
elseif strcmp(option.solver,'mg')
    option.solver = 'dmg';
end
solver = option.solver;
% solve
switch lower(solver);
    case 'direct'
      bigu(freeDof) = AD(freeDof,freeDof)\F(freeDof);
        sigma = bigu(1:NE);
        u = bigu(NE+1:end); info =[];
    case 'none'
        sigma = []; u = []; info =[];
    case 'dmg'
        [sigma,u] = dmg(eqn.M,eqn.B,eqn.C,eqn.f,eqn.g,elemold);
    case 'uzawapcg'
        [sigma,u] = uzawapcg(eqn.M,eqn.B,eqn.C,eqn.f,eqn.g,elemold);
end
info.solverTime = 0; info.assembleTime = 0; info.itStep = 0;
info.stopErr = 0; info.flag = 0;
if isPureNeumannBC == true % post process for u.
    ubar = sum(u.*area)/sum(area);
    u = u - ubar;
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    function [AD,F,bigu,freeDof,isPureNeumannBC] = getbdRT0(F)
    %% GETBDRT0 Boundary conditions for Poisson equation: RT0 element.
    %
    %  Created by Ming Wang. Improved the check of edgeSign by Long Chen.

    %%
    bigu = zeros(Ndof,1);

    %% Boundary conditions
    if ~isfield(pde,'g_D'), pde.g_D = []; end
    if ~isfield(pde,'g_N'), pde.g_N = []; end

    %% Set up bdFlag
    if isempty(bdFlag) % no bdFlag information
       if ~isempty(pde.g_N) % case: Neumann
           bdFlag = setboundary(node,elem,'Neumann');
       elseif ~isempty(pde.g_D) % case: Dirichlet
           bdFlag = setboundary(node,elem,'Dirichlet');
       end
    end

    %% Find Dirichlet and Neumann dofs
    if ~isempty(bdFlag)
        isDirichlet(elem2edge(bdFlag(:)==1)) = true;
        isNeumann(elem2edge(bdFlag(:)==2)) = true;
        % Direction of boundary edges may not be the outwards normal
        % direction of the domain. edgeSign is introduced to record this
        % inconsistency.
        edgeSign = ones(NE,1);
        idx = (bdFlag(:,1) ~= 0) & (elemSign == -1);% first edge is on boundary
        edgeSign(elem2edge(idx,1)) = -1;
        idx = (bdFlag(:,2) ~= 0) & (elemSign == 1); % second edge is on boundary
        edgeSign(elem2edge(idx,2)) = -1;
        idx = (bdFlag(:,3) ~= 0) & (elemSign == -1);% first edge is on boundary
        edgeSign(elem2edge(idx,3)) = -1;
    end
    Dirichlet = edge(isDirichlet,:);
    Neumann = edge(isNeumann,:);
    isBdDof = false(Ndof,1);
    isBdDof(isNeumann) = true;   % for mixed method, Neumann edges are fixed
    freeDof = find(~isBdDof);

    %% Dirichlet boundary condition (Neumann BC in mixed form)
    %   We need only modify the rhs on dof associated with Dirichlet
    %   boundary. Compute the int_e \Phi\cdot n g_D on the boundary using
    %   quadrature rules.
    if ~isempty(pde.g_D) && isnumeric(pde.g_D) && (pde.g_D==0)
        pde.g_D = [];
    end
    if ~isempty(pde.g_D) && any(isDirichlet)
        if ~isfield(option,'gNquadorder')
            option.gNquadorder = 2;   % default order exact for linear gN
        end
        [lambda,weight] = quadpts1(option.gNquadorder);
        nQuad = size(lambda,1);
        for ip = 1:nQuad
        	pxy = lambda(ip,1)*node(Dirichlet(:,1),:)+...
                  lambda(ip,2)*node(Dirichlet(:,2),:);
            F(isDirichlet) = F(isDirichlet) + weight(ip)*pde.g_D(pxy);
        end
        F(isDirichlet) = F(isDirichlet).*edgeSign(isDirichlet);
        % no edge length since the basis of sigma contains it.
    end

    %% Neumann boundary condition (Dirichlet BC in mixed form)
    if ~isempty(pde.g_N) && any(isNeumann)
        % modify the rhs to include Dirichlet boundary condition
        mid = 1/2*(node(Neumann(:,1),:)+node(Neumann(:,2),:));
        ve = node(Neumann(:,1),:)-node(Neumann(:,2),:);
        edgeLength = sqrt(sum(ve.^2,2));
        if isnumeric(pde.g_N)
            evalg_N = pde.g_N;
        else
            evalg_N = pde.g_N(mid);
        end
        bigu(isNeumann) = edgeLength.*evalg_N;
        if ~isempty(pde.d)
            bigu(isNeumann) = pde.d(mid).*bigu(isNeumann);
        end
        bigu(isNeumann) = bigu(isNeumann).*edgeSign(isNeumann);
        F = F - A*bigu;
        F(isNeumann) = bigu(isNeumann);
    end

    %% Pure Neumann boundary condition
    isPureNeumannBC = false;
    if ~any(isDirichlet) && any(isNeumann)
        freeDof = freeDof(1:end-1);  % eliminate the kernel by enforcing u(NT) = 0;
        isBdDof(end) = true;
        isPureNeumannBC = true;
%         F(end) = 0;
    end

    %% Modify the matrix
    %  Build Neumann boundary condition(Dirichlet BC in mixed form) into the
    %  matrix AD by enforcing  |AD(bdNode,bdNode)=I,
    %  AD(bdNode,FreeNode)=0, AD(FreeNode,bdNode)=0|.
    if any(isBdDof)
       bdidx = zeros(Ndof,1);
       bdidx(isBdDof) = 1;
       Tbd = spdiags(bdidx,0,Ndof,Ndof);
       T = spdiags(1-bdidx,0,Ndof,Ndof);
       AD = T*A*T + Tbd;
    else
       AD = A;
    end
    end
end


function F = asech(F, varargin)
%ASECH   Inverse hyperbolic secant of a CHEBFUN.
%   ASECH(F) computes the inverse hyperbolic secant of the CHEBFUN F.
%
%   ASECH(F, PREF) does the same but uses the CHEBFUNPREF object PREF when
%   computing the composition.
%
% See also SECH.

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

% Call the compose method:
F = compose(F, @asech, varargin{:});

end


function [ti,xi] = keepdata(x,p)
%
% Keeps arbitrary fraction p of equidistant data x at times ti.
% Output contains data xi at time ti

if p > 1, error('p must be between 0 and 1'), end

N=length(x);
Nover=floor(p.*N);

% over is the array of remaining points with value 1
over=zeros(1,N);

ti=zeros(1,Nover);
xi=zeros(1,Nover);

% Select at random Nover points
i = 0;
while (i < Nover)
   r = rand(1);
   k = round((N - 1) .* r) + 1;
   if (over(k) ~= 1)
      over(k) = 1;
      i = i + 1;
   end
end

% Generate output data
j = 1;
for i=1:N
   if (over(i) == 1)
      xi(j) = x(i);
      ti(j) = i;
      j = j + 1;
   end
end
fprintf('Over: %d\n', j-1);


function L=ishappy(n)

N=n;
L=0;
NHistory=n;
while L==0
    N=sum(str2num(num2str(N).').^2); %Sum digits
    if N==1 %n is a happy number
        L=1;
    elseif ismember(N,NHistory); %Kill we are in a loop
        break
    end
    NHistory=[NHistory N];
end
NHistory=[NHistory N];

%%
% _*GIBBON footer text*_
%
% License: <https://github.com/gibbonCode/GIBBON/blob/master/LICENSE>
%
% GIBBON: The Geometry and Image-based Bioengineering add-On. A toolbox for
% image segmentation, image-based modeling, meshing, and finite element
% analysis.
%
% Copyright (C) 2006-2022 Kevin Mattheus Moerman and the GIBBON contributors
%
% 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 [coeff, score, latent, tsquare] = princomp_largedata(x,econFlag)
% Principal Components Analysis
%
% This is a version created for large data sets by Matthew Davidson
%
% The default Matlab PRINCOMP is naive to large data sets. Out-of-memory
% errors are easily obtained on imaging data. The solution is to replace
% concise but inefficient calls to repmat with loops and to eliminate
% large, unused variables.
%
% Tested on random data sets and produces identical output as original
% PRINCOMP. Speed penalty is drastic for small data. 50% slower on
% 50x1000 element data set, but on a 50x10000, only 2% slower.
%
% COEFF = PRINCOMP(X) performs principal components analysis on the N-by-P
% data matrix X, and returns the principal component coefficients, also
% known as loadings.  Rows of X correspond to observations, columns to
% variables.  COEFF is a P-by-P matrix, each column containing coefficients
% for one principal component.  The columns are in order of decreasing
% component variance.
%
% PRINCOMP centers X by subtracting off column means, but does not
% rescale the columns of X.  To perform PCA with standardized variables,
% i.e., based on correlations, use PRINCOMP(ZSCORE(X)).  To perform PCA
% directly on a covariance or correlation matrix, use PCACOV.
%
% [COEFF, SCORE] = PRINCOMP(X) returns the principal component scores,
% i.e., the representation of X in the principal component space.  Rows
% of SCORE correspond to observations, columns to components.
%
% [COEFF, SCORE, LATENT] = PRINCOMP(X) returns the principal component
% variances, i.e., the eigenvalues of the covariance matrix of X, in
% LATENT.
%
% [COEFF, SCORE, LATENT, TSQUARED] = PRINCOMP(X) returns Hotelling's
% T-squared statistic for each observation in X.
%
% When N <= P, SCORE(:,N:P) and LATENT(N:P) are necessarily zero, and the
% columns of COEFF(:,N:P) define directions that are orthogonal to X.
%
% [...] = PRINCOMP(X,'econ') returns only the elements of LATENT that are
% not necessarily zero, i.e., when N <= P, only the first N-1, and the
% corresponding columns of COEFF and SCORE.  This can be significantly
% faster when P >> N.
%
% :See Also: BARTTEST, BIPLOT, CANONCORR, FACTORAN, PCACOV, PCARES, ROTATEFACTORS.
%
% :References:
%   1. Jackson, J.E., A User's Guide to Principal Components,
%      Wiley, 1988.
%   2. Jolliffe, I.T. Principal Component Analysis, 2nd ed.,
%      Springer, 2002.
%   3. Krzanowski, W.J., Principles of Multivariate Analysis,
%      Oxford University Press, 1988.
%   4. Seber, G.A.F., Multivariate Observations, Wiley, 1984.
%
% ..
%   Copyright 1993-2005 The MathWorks, Inc.
%   $Revision: 2.9.2.9 $  $Date: 2006/10/02 16:35:01 $
% ..

% ..
%    When X has more variables than observations, the default behavior is to
%    return all the pc's, even those that have zero variance.  When econFlag
%    is 'econ', those will not be returned.
% ..

if nargin < 2, econFlag = 0; end

[n,p] = size(x);
if isempty(x)
    pOrZero = ~isequal(econFlag, 'econ') * p;
    coeff = zeros(p,pOrZero); coeff(1:p+1:end) = 1;
    score = zeros(n,pOrZero);
    latent = zeros(pOrZero,1);
    tsquare = zeros(n,1);
    return
end

% Center X by subtracting off column means
%x0 = x - repmat(mean(x,1),n,1);
for i=1:size(x, 2)
    x(:,i) = x(:,i) - mean(x(:,i));
end
r = min(n-1,p); % max possible rank of X0

% The principal component coefficients are the eigenvectors of
% S = X0'*X0./(n-1), but computed using SVD.
[U,sigma,coeff] = svd(x,econFlag); % put in 1/sqrt(n-1) later

if nargout < 2
    % When econFlag is 'econ', only (n-1) components should be returned.
    % See comment below.
    if (n <= p) && isequal(econFlag, 'econ')
        coeff(:,n) = [];
    end

else
    % Project X0 onto the principal component axes to get the scores.
    if n == 1 % sigma might have only 1 row
        sigma = sigma(1);
    else
        sigma = diag(sigma);
    end
    score = U .* repmat(sigma',n,1); % == x*coeff
    sigma = sigma ./ sqrt(n-1);

    % When X has at least as many variables as observations, eigenvalues
    % n:p of S are exactly zero.
    if n <= p
        % When econFlag is 'econ', nothing corresponding to the zero
        % eigenvalues should be returned.  svd(,'econ') won't have
        % returned anything corresponding to components (n+1):p, so we
        % just have to cut off the n-th component.
        if isequal(econFlag, 'econ')
            sigma(n,:) = []; % make sure this shrinks as a column
            coeff(:,n) = [];
            score(:,n) = [];

        % Otherwise, set those eigenvalues and the corresponding scores to
        % exactly zero.  svd(,0) won't have returned columns of U
        % corresponding to components (n+1):p, need to fill those out.
        else
            sigma(n:p,1) = 0; % make sure this extends as a column
            score(:,n:p) = 0;
        end
    end

    % The variances of the pc's are the eigenvalues of S = X0'*X0./(n-1).
    latent = sigma.^2;

    % Hotelling's T-squared statistic is the sum of squares of the
    % standardized scores, i.e., Mahalanobis distances.  When X appears to
    % have column rank < r, ignore components that are orthogonal to the
    % data.
    if nargout == 4
        if n > 1
            q = sum(sigma > max(n,p).*eps(sigma(1)));
            if q < r
                warning('stats:princomp:colRankDefX', ...
                        ['Columns of X are linearly dependent to within machine precision.\n' ...
                         'Using only the first %d components to compute TSQUARED.'],q);
            end
        else
            q = 0;
        end
        tsquare = (n-1) .* sum(U(:,1:q).^2,2); % == sum((score*diag(1./sigma)).^2,2)
    end
end


function data = get_kernel_data(X,kernel, kernel_params, Xtrain, datatrain);
% nargin >= 4, when computations of the testing data depends on the training data (i.e., with incomplete Cholesky)

switch kernel
	case { 'polynomial','polynomial-mkl','polynomial-bimkl'}
		[n , p ] = size(X);
		q = kernel_params(1);
		data.n = n ;
		data.p = p;
		data.q = q;
		data.qs = (q+1) * ones(1,p);		  % number of kernels per directions
		data.Xs = zeros(n,sum(data.qs));      % storing all dimensions in the same vector
		data.ind_Xs = cell(1,p);
		data.d_Xs = cell(1,p);
		iK = 1;
		for i=1:p
			data.ind_Xs{i} = cell(1,data.qs(i));
			data.d_Xs{i} = zeros(1,data.qs(i));
			jK = iK;
			for j=1:data.qs(i)
				data.ind_Xs{i}{j} = iK;
				data.d_Xs{i}(j) = 1;
				if j==1
					data.Xs(:,iK) = ones(n,1);		% constant term
				else
					data.Xs(:,iK) = X(:,i).^(j-1) * sqrt( 1 / factorial(j-1) * factorial(q) / factorial(q-j+1) );
				end
				iK = iK + 1 ;
			end
			jK = jK + data.qs(i);
		end

	case {'hermite', 'hermite-mkl', 'hermite-bimkl'}
		[n , p ] = size(X);
		q = kernel_params(2);
		alpha = kernel_params(1);
		data.n = n ;
		data.p = p;
		data.q = q;
		data.qs = (q+1) * ones(1,p);		  % number of kernels per directions
		data.Xs = zeros(n,sum(data.qs));      % storing all dimensions in the same vector
		data.ind_Xs = cell(1,p);
		data.d_Xs = cell(1,p);
		iK = 1;
		for i=1:p
			data.ind_Xs{i} = cell(1,data.qs(i));
			data.d_Xs{i} = zeros(1,data.qs(i));
			jK = iK;
			for j=1:data.qs(i)
				data.ind_Xs{i}{j} = iK;
				data.d_Xs{i}(j) = 1;

				if j==1
					data.Xs(:,iK) = ones(n,1);
				else
					data.Xs(:,iK) = hermite_polynomials(j,X(:,i)) * sqrt( (alpha/2)^(j-1) / factorial(j-1) );
				end
				iK = iK + 1 ;
			end
			jK = jK + data.qs(i);
		end

	case {'gauss-hermite', 'gauss-hermite-mkl', 'gauss-hermite-bimkl'}
		[n , p ] = size(X);
		q = kernel_params(3);
		sigma = kernel_params(1);
		b = kernel_params(2);
		a = 1/4/sigma;
		c = sqrt(a*a+2*a*b);
		A = a + b + c;
		data.n = n ;
		data.p = p;
		data.q = q;
		data.qs = (q+1) * ones(1,p);		  % number of kernels per directions
		data.Xs = zeros(n,sum(data.qs));      % storing all dimensions in the same vector
		data.ind_Xs = cell(1,p);
		data.d_Xs = cell(1,p);
		iK = 1;
		for i=1:p
			data.ind_Xs{i} = cell(1,data.qs(i));
			data.d_Xs{i} = zeros(1,data.qs(i));
			jK = iK;
			for j=1:data.qs(i)
				data.ind_Xs{i}{j} = iK;
				data.d_Xs{i}(j) = 1;

				data.Xs(:,iK) =  ( 1 - (b/A)^2).^.25 * hermite_polynomials(j,X(:,i) * sqrt( 2 * c ) ) .* exp( - ( b/A*(a+c) * X(:,i).^ 2 ) ) ...
					* sqrt( (b/A)^(j-1) / ( 2^(j-1) * factorial(j-1) )) ;
				iK = iK + 1 ;
			end
			jK = jK + data.qs(i);
		end

	case {'gauss-hermite-full', 'gauss-hermite-full-mkl', 'gauss-hermite-full-bimkl'}
		% simply the same as 'gauss-hermite', but with the full kernels at
		% the end
		[n , p ] = size(X);
		q = kernel_params(3);
		sigma = kernel_params(1);
		b = kernel_params(2);
		a = 1/4/sigma;
		c = sqrt(a*a+2*a*b);
		A = a + b + c;
		data.n = n ;
		data.p = p;
		data.q = q+1;
		data.qs = (q+2) * ones(1,p);     % number of kernels per directions
		data.Xs = zeros(n,sum(data.qs));      % storing all dimensions in the same vector
		data.ind_Xs = cell(1,p);
		data.d_Xs = cell(1,p);
		iK = 1;
		for i=1:p
			data.ind_Xs{i} = cell(1,data.qs(i));
			data.d_Xs{i} = zeros(1,data.qs(i));
			jK = iK;
			fulldataloc = [];
			for j=1:data.qs(i)-1
				% first kernels as before
				data.ind_Xs{i}{j} = iK;
				data.d_Xs{i}(j) = 1;

				data.Xs(:,iK) =  ( 1 - (b/A)^2).^.25 * hermite_polynomials(j,X(:,i) * sqrt( 2 * c ) ) .* exp( - ( b/A*(a+c) * X(:,i).^ 2 ) ) ...
					* sqrt( (b/A)^(j-1) / ( 2^(j-1) * factorial(j-1) )) ;
				fulldataloc = [ fulldataloc; iK ];

				iK = iK + 1 ;
			end

			if nargin < 4
				% last kernel: first build the kernel matrix, then takes its
				% incomplete Cholesky decomposition

				K = exp( - b * sqdist(X(:,i)',X(:,i)' ) ) - data.Xs(:,fulldataloc)  * data.Xs(:,fulldataloc)';
				[Gf,Pf,mf,residualf] = icd_general(K,1e-3,kernel_params(6));
				If = Pf(1:mf);
				data.Is{i} = If;					% these two for test data

				[temp,Pif] = sort(Pf);
				Gf = Gf(Pif,1:mf);
				data.d_Xs{i}(end) = mf;
				data.ind_Xs{i}{end} = iK:iK+mf-1;
				data.Xs(:,data.ind_Xs{i}{end}) = Gf;
				iK = iK+mf;
			else
				% last kernel for test data! This compute testing data
				K = exp( - b * sqdist(X(:,i)',Xtrain(datatrain.Is{i},i)' ) ) - data.Xs(:,fulldataloc)  * datatrain.Xs(datatrain.Is{i},fulldataloc)';
				data.d_Xs{i}(end) = datatrain.d_Xs{i}(end);
				data.ind_Xs{i}{end} = datatrain.ind_Xs{i}{end};
				data.Xs(:,data.ind_Xs{i}{end}) = K * inv( datatrain.Xs(datatrain.Is{i},data.ind_Xs{i}{end})' ) ;
				iK = iK+data.d_Xs{i}(end);

			end
		end

	case {'anova', 'anova-mkl', 'anova-bimkl'}
		% simply the same as 'gauss-hermite', but with the full kernels at
		% the end
		[n , p ] = size(X);
		b = kernel_params(1);

		data.n = n ;
		data.p = p;
		data.q = 1;
		data.qs = 2 * ones(1,p);     % number of kernels per directions
		data.Xs = zeros(n,sum(data.qs));      % storing all dimensions in the same vector
		data.ind_Xs = cell(1,p);
		data.d_Xs = cell(1,p);
		iK = 1;
		for i=1:p
			% constant term
			data.ind_Xs{i} = cell(1,2);
			data.d_Xs{i} = zeros(1,2);
			data.ind_Xs{i}{1} = iK;
			data.d_Xs{i}(1) = 1;
			data.Xs(:,iK) = ones(size(X,1),1);
			iK = iK + 1 ;

			if nargin < 4
				% first build the kernel matrix, then takes it
				% incomplete Cholesky decomposition

				K = exp( - b * sqdist(X(:,i)',X(:,i)' ) );
				[Gf,Pf,mf,residualf] = icd_general(K,1e-3,kernel_params(4));
				If = Pf(1:mf);

				data.Is{i} = If;					% these two for test data
				[temp,Pif] = sort(Pf);
				Gf = Gf(Pif,1:mf);
				data.d_Xs{i}(2) = mf;
				data.ind_Xs{i}{2} = iK:iK+mf-1;
				data.Xs(:,data.ind_Xs{i}{2}) = Gf;
				iK = iK+mf;
			else
				% last kernel for test!
				K = exp( - b * sqdist(X(:,i)',Xtrain(datatrain.Is{i},i)' ) );
				data.d_Xs{i}(2) = datatrain.d_Xs{i}(2);
				data.ind_Xs{i}{2} = datatrain.ind_Xs{i}{2};
				data.Xs(:,data.ind_Xs{i}{2}) = K * inv( datatrain.Xs(datatrain.Is{i},data.ind_Xs{i}{2})' ) ;
				iK = iK+data.d_Xs{i}(2);

			end
		end

	case {'base kernels', 'base kernels-mkl', 'base kernels-bimkl'}
		p = kernel_params(1);
		if nargin<4
			% train
			n = size(X,1);
			n = floor( sqrt(2 * n) );
		else
			% test
			ntrain = size(Xtrain,1);
			ntrain = floor( sqrt(2 * ntrain) );
			n = size(X,1) / ntrain;
		end
		q = kernel_params(2);
		data.n = n ;
		data.p = p;
		data.q = kernel_params(2);
		data.qs = (q+1) * ones(1,p);			% number of kernels per directions
		data.Xs = zeros(n,sum(data.qs));		% storing all dimensions in the same vector
		data.ind_Xs = cell(1,p);
		data.d_Xs = cell(1,p);
		iK = 1;
		for i=1:p
			% constant term
			data.ind_Xs{i} = cell(1,2);
			data.d_Xs{i} = zeros(1,2);
			data.ind_Xs{i}{1} = iK;
			data.d_Xs{i}(1) = 1;
			data.Xs(:,iK) = ones(n,1);
			iK = iK + 1 ;

			if nargin < 4
				% first build the kernel matrix, then takes it
				% incomplete Cholesky decomposition
				for j=1:q
					K = double( devectorize_single(X(:,i,j)) );

					[Gf,Pf,mf,residualf] = icd_general(K,1e-3,kernel_params(5));
					If = Pf(1:mf);

					data.Is{i}{j+1} = If;					% these two for test data
					[temp,Pif] = sort(Pf);
					Gf = Gf(Pif,1:mf);
					data.d_Xs{i}(j+1) = mf;
					data.ind_Xs{i}{j+1} = iK:iK+mf-1;

					data.Xs(:,data.ind_Xs{i}{j+1}) = Gf;
					iK = iK+mf;
				end
			else
				for j=1:q

					K = double( reshape(X(:,i,j) ,n,ntrain ) );
					K = K(:,datatrain.Is{i}{j+1});
					data.d_Xs{i}(j+1) = datatrain.d_Xs{i}(j+1);
					data.ind_Xs{i}{j+1} = datatrain.ind_Xs{i}{j+1};
					data.Xs(:,data.ind_Xs{i}{j+1}) = K * inv( datatrain.Xs(datatrain.Is{i}{j+1},data.ind_Xs{i}{j+1})' ) ;
					iK = iK+data.d_Xs{i}(j+1);

				end
			end
		end

	case {'spline', 'spline-mkl', 'spline-bimkl'}
		% simply the same as 'gauss-hermite', but with the full kernels at
		% the end
		[n , p ] = size(X);
		data.n = n ;
		data.p = p;
		data.q = 2;
		data.qs = 3 * ones(1,p);     % number of kernels per directions
		data.Xs = zeros(n,sum(data.qs)*30);      % storing all dimensions in the same vector
		data.ind_Xs = cell(1,p);
		data.d_Xs = cell(1,p);
		iK = 1;
		for i=1:p
			% constant term
			data.ind_Xs{i} = cell(1,2);
			data.d_Xs{i} = zeros(1,2);

			data.ind_Xs{i}{1} = iK;
			data.d_Xs{i}(1) = 1;
			data.Xs(:,iK) = ones(size(X,1),1);
			iK = iK + 1 ;

			data.ind_Xs{i}{2} = iK;
			data.d_Xs{i}(2) = 1;
			data.Xs(:,iK) = X(:,i);
			iK = iK + 1 ;

			if nargin < 4
				% first build the kernel matrix, then takes it
				% incomplete Cholesky decomposition
				K = compute_cubic_spline_kernel(X(:,i),X(:,i));
				[Gf,Pf,mf,residualf] = icd_general(K,1e-3,kernel_params(3));
				If = Pf(1:mf);

				data.Is{i} = If;					% these two for test data
				[temp,Pif] = sort(Pf);
				Gf = Gf(Pif,1:mf);
				data.d_Xs{i}(3) = mf;
				data.ind_Xs{i}{3} = iK:iK+mf-1;
				data.Xs(:,data.ind_Xs{i}{3}) = Gf;
				iK = iK+mf;
			else
				% last kernel for test!
				K = compute_cubic_spline_kernel(X(:,i),Xtrain(datatrain.Is{i},i));
				data.d_Xs{i}(3) = datatrain.d_Xs{i}(3);
				data.ind_Xs{i}{3} = datatrain.ind_Xs{i}{3};
				data.Xs(:,data.ind_Xs{i}{3}) = K * inv( datatrain.Xs(datatrain.Is{i},data.ind_Xs{i}{3})' ) ;
				iK = iK+data.d_Xs{i}(3);

			end
		end

		data.Xs(:,iK:end) = [];

end


function y = heat2d_fun ( x )

%*****************************************************************************80
%
%% HEAT2D_FUN demonstrates MATLAB's SPMD command for parallel programming.
%
%  Discussion:
%
%    A black and white image X is input.
%
%    A copy of X is distributed across the workers.
%
%    The pixels are regarded as numeric temperatures.
%
%    Each worker applies the explicit heat equation stencil to the pixels
%    in its local part.
%
%    The client combines the results and displays them.
%
%    100 "time" steps are taken, using a CFL coefficient of 0.20.
%    (For this problem, CFL should not be more than 0.25!)
%
%    In this example, we make sure that neighboring workers can share
%    their data, and eliminate the bands that would otherwise show up
%    because of artificial boundaries.
%
%    This is a very artificial calculation, but by using an interesting
%    initial condition, we can make the point that the heat equation "blurs"
%    data, and that by treating the interfaces correctly, we can solve a
%    big problem as a connected set of small problems.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 April 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, image X, the initial black and white image.
%
%    Output, image Y, the black and white image after 100 "time" steps of blurring.
%

%
%  CFL is the Courant-Friedrichs-Loewy coefficient, which for this 2D problem
%  should not be larger than 0.25.
%
  cfl = 0.20;
%
%  Since the image is black and white, it is a 2D array.
%  Hence, it will be distributed by columns.
%
  xd = distributed ( x );
%
%  Each worker retrieves its portion of the distributed picture,
%  turn it into a numerical array, and compute the previous and
%  next worker.
%
%  We only need to do these operations once, so do them OUTSIDE the time loop.
%
  spmd

    xl = getLocalPart ( xd );

    xl = double ( xl );

    if ( labindex ~= 1 )
      previous = labindex - 1;
    else
      previous = numlabs;
    end

    if ( labindex ~= numlabs )
      next = labindex + 1;
    else
      next = 1;
    end
%
%  Do 100 steps of blurring.
%
  for i = 1 : 100

    spmd
%
%  Each worker sends its first column to the previous worker,
%  and receives corresponding data from the next worker.
%
      column = labSendReceive ( previous, next, xl(:,1) );

      if ( labindex < numlabs )
        xl = [ xl, column ];
      end
%
%  Each worker sends its last column to the next worker,
%  and receives corresponding data from the previous worker.
%
      column = labSendReceive ( next, previous, xl(:,end) );

      if ( 1 < labindex )
        xl = [ column, xl ];
      end
%
%  Now apply the stencil for the explicit heat equation
%  on the interior points.
%
%  Here, we are modeling:
%
%    dH/dt = - d/dx k ( dH/dx )
%
      [ nr, nc ] = size ( xl );

      c1 = 2:nr-1;
      c2 = 2:nc-1;

      xl(c1,c2) = ( 1 - 4 * cfl ) * xl(c1,c2) ...
        + cfl * ( xl(c1-1,c2) + xl(c1+1,c2) ...
                + xl(c1,c2-1) + xl(c1,c2+1)  );
%
%  West boundary conditions on lab #1.
%
      if ( labindex == 1 )
        xl(:,1) = xl(:,2);
      end
%
%  North and south boundary conditions occur on every lab.
%
      xl(1,:) = xl(2,:);
      xl(end,:) = xl(end-1,:);
%
%  East boundary conditions on last lab.
%
      if ( labindex == numlabs )
        xl(:,end) = xl(:,end-1);
      end
%
%  Now strip off the extra columns.
%
      if ( 1 < labindex )
        xl = xl(:,2:end);
      end

      if ( labindex < numlabs )
        xl = xl(:,1:end-1);
      end
%
%  Convert to unsigned short ints so we can make an image.
%
      yl = uint8 ( xl );

    end
%
%  We are working with a black and white image, so we can simply
%  concatenate the submatrices to get the whole object.
%
    y = [ yl{:} ];
    imshow ( y )
    pause

  end

  return
end


function [x,state] = struct_gram(z,task)
%STRUCT_GRAM Gramian matrix.
%   [x,state] = struct_gram(z,[]) computes x as the matrix-matrix product
%   z'*z. The structure state stores information which is reused in
%   computing the right and left Jacobian-vector products.
%
%   struct_gram(z,task) computes the right or left Jacobian-vector product
%   of this transformation, depending on the structure task. Use the
%   structure state and add the field 'r' of the same shape as z or the
%   field 'l' of the same shape as x to obtain the structure task for
%   computing the right and left Jacobian-vector products
%
%      (dF(:)/dz(:).')*task.r(:) and
%      (dF(:)/dz(:).')'*task.l(:) + conj((dF(:)/dconj(z(:)).')'*task.l(:)),
%
%   respectively. Here, F(z) represents this transormation, (:) signifies
%   vectorization and the derivative w.r.t. z (conj(z)) is a partial
%   derivative which treats conj(z) (z) as constant. The output has the
%   same shape as x or z for the right and left Jacobian-vector products,
%   respectively.

%   Authors: Laurent Sorber (Laurent.Sorber@cs.kuleuven.be)
%            Marc Van Barel (Marc.VanBarel@cs.kuleuven.be)
%            Lieven De Lathauwer (Lieven.DeLathauwer@kuleuven-kulak.be)
%
%   References:
%   [1] L. Sorber, M. Van Barel, L. De Lathauwer, "Structured data fusion,"
%       ESAT-SISTA Internal Report 13-177, KU Leuven, 2013.

if nargin < 2, task = []; end
state = [];

if isempty(task) || (isempty(task.l) && isempty(task.r))
    x = z'*z;
elseif ~isempty(task.r)
    if ~isreal(z) || ~isreal(task.r)
        error('struct_gram:nonanalytic',['Nonanalytic objective ' ...
            'functions are currently not supported in sdf_nls, please ' ...
            'use sdf_minf instead.']);
    end
    x = z.'*task.r+task.r.'*z;
elseif ~isempty(task.l)
    x = z*(task.l'+task.l);
end

end


% Earth Observing System Data Visualization
%
%   Part 2 (Using the Mapping Toolbox)
%
%   This M-file contains the sequence of MATLAB commands listed in
%   the November 2002 MATLAB Digest article on "Reading and Visualizing
%   Data from the Earth Observing System (EOS)," from the section that
%   requires the Mapping Toolbox.
%
%   Rob Comer and Chris Lawton
%   Copyright 2002 The MathWorks, Inc.

%== MAP PROJECTION OF COMBINED SST AND NDVI ==============================

% Set up figure, title, colormap, and map axes. Use a Mollweide projection
% with Greenwich as its central meridian.
figure('Color','k');
title({'SST from MODIS and NDVI from AVHRR, July 2001'},'Color','w')
colormap(cmap);
ax = axesm('MapProjection','mollweid','Origin',[0 0 0]);
set(ax,'Color',[0 0 0])

% Display the global NDVI on the map axes. The CDataMapping property
% must be set to 'direct' so that the data values directly index into the
% colormap. Add 1 because indexing for uint8s is zero-based but indexing
% for doubles is one-based. FLIPUD is required because columns in a
% "regular matrix map" must run from south to north.
ndviNorthwestCorner = [89.5 -179.5];  % Lat/lon of upper-left-most cell center
ndviCellSize = 1;                     % Size of grid cells in degrees
hmesh = meshm(flipud(double(ndviMapped) + 1),...  % Converting uint8 image
              [ndviCellSize ndviNorthwestCorner],... % The 'legend'
              'CDataMapping','direct');  % Go directly into the colormap

% Display the MODIS SST swath over the global NDVI grid.
hsurf = surfm(sstLat,sstLon,double(sstMapped) + 1,...
              'CDataMapping','direct');

% Show 2 color scale bars, one for SST and one for NDVI.
% Move the map to make room, then add the color scales.
set(ax,'Position',get(ax,'Position') + [0 0.12 0 0])
colorscale(sstCmapLim,sstDataLim,5,'horiz',...
    'Position',[0.1 0.10, 0.8, 0.03],'XColor','w','YColor','w')
title('Sea Surface Temperature','Color','w')
xlabel('degrees Celsius')
colorscale(ndviCmapLim,ndviDataLim,0.2,'horiz',...
    'Position',[0.1 0.28, 0.8, 0.03],'XColor','w','YColor','w')
title('Normalized Difference Vegetation Index','Color','w')


 function [yik, scalefactor] = ir_mri_field_map_reg_scale(yik, etime, varargin)
%function [yik, scalefactor] = ir_mri_field_map_reg_scale(yik, etime, varargin)
%|
%| Scale images to account for R2* effects and differences in absolute value
%| using median(ri), where ri = sum_j sum_k |yik_j yik_k|^2 (t_k - t_j)^2
%|
%| in
%|	yik	[N nset]	scan images
%|	etime	[1 nset]	echo times (units of sec if fieldmap is in Hz)
%|
%| option
%|	fmax			threshold for absolute yik value (default 0.1)
%|	dmax			threshold for absolute rj value (default 0.1)
%|	show	0|1		1 to show result (default 0)
%|
%| out
%|	yik	[N nset]	scaled scan images
%|	scalefactor		sqrt(median(rj)) * effect_of_fmax
%|
%| MJ Allison
%| 2015-06-27 JF cosmetic changes

if nargin < 4, ir_usage, end

arg.fmax = 0.1;
arg.dmax = 0.1;
arg.show = 0;
arg = vararg_pair(arg, varargin);

dim_yik = size(yik);
yik = reshapee(yik, [], dim_yik(end)); % [*N nset]

[nn, nset] = size(yik);

% Scale by median of first set of data to get rid of large mag_j
% effects (not actually needed, but left in for consistency)
if arg.fmax > 0
	y1 = abs(yik(:,1));
	scalefactor = median(y1(y1(:) > arg.fmax * max(y1(:))));
	if scalefactor == 0
		fail 'median is zero?'
	end
	yik = yik / scalefactor;
else
	scalefactor = 1;
end

% Try to compensate for R2 effects on effective regularization.

d = zeros(nn,1);
for j = 1:nset
	for k = 1:nset
		tmp = abs(yik(:,j) .* yik(:,k)).^2 * (etime(k)-etime(j)).^2;
		d = d + tmp;
	end
end

% divide by numerator of wj^mn -> sum(abs(y)^2)
d = div0(d, sum(abs(yik).^2,2));

if arg.show
	im(reshape(d, [dim_yik(1:2)]))
end

% compute dtyp
dtyp = median(d(d(:) > arg.dmax * max(d(:))));
% pr dtyp

% now uniformly scale by the square root of dtyp
yik = yik / sqrt(dtyp);

scalefactor = scalefactor * sqrt(dtyp); % 2022-11-27 fix
yik = reshape(yik, dim_yik); % [(N) nset]


function jed = ymdhms_to_jed_common ( y, m, d, h, n, s )

%*****************************************************************************80
%
%% YMDHMS_TO_JED_COMMON converts a Common YMDHMS date to a JED.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    01 March 2013
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer Y, M, D, H, N, S, the YMDHMS date.
%
%    Output, real JED, the Julian Ephemeris Date.
%
  [ y1, m1, d1, f1 ] = ymdhms_to_ymdf_common ( y, m, d, h, n, s );

  jed = ymdf_to_jed_common ( y1, m1, d1, f1 );

  return
end