function [CVAR] = cvar_(y,lags,options)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 'cvar_' estimates the paramters of VAR model with classical methods
% Impulse Response Function CI are computed using bootstrap methods

% Core Inputs:
% - y, data columns variables
% - lags, lag order of the VAR

% Additonal Inputs collected options:
% - options are not mandatory.
% See the Hitchhiker's guide for more details.
% https://github.com/naffe15/BVAR_/blob/master/HitchhikerGuide_.pdf

% Output:

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

if nargin < 2
    error('the cvar_ funtion needs at least two inputs: data and number of lags');
end
if lags < 1
    error('lags cannot be zero or negative');
end
% number of observable variables
ny                  = size(y, 2);

%********************************************************
%* DEFAULT SETTINGS
%********************************************************
% Control random number generator
if isOctave == 0
    isMatlab = 1;
    rng('default');
    rng(999);
else
    isMatlab = 0;
    % pkg load optim
    randn('state',999);
    rand('state',999);
end

% Default Settings (they can all be changed in 'options' see below)
K                   = 5000;         % number of draws from the posterior
hor                 = 24;           % horizon for the IRF
fhor                = 12;           % horizon for the forecasts
nethor              = 12;           % network horizon/ splioover and connectedness
firstobs            = lags+1;       % first observation
presample           = 0;            % using a presample for setting the hyper-parameter of the Minnesosta prior
noconstant          = 0;            % when 0, includes a constatn in the VAR
timetrend           = 0;            % when 1, includes a time trend in the VAR
long_run_irf        = 0;            % when 0, it does not compute long run IRF
irf_1STD            = 1;            % when 1, IRF are computed as 1SD increase. Else, IRF are compued as unitary increase in the shock
cfrcst_yes          = 0;            % no conditional forecast unless defined in options
% non_explosive_      = 0;            %
heterosked          = 0;
replacement         = 1;           % with replacement when bootstrapping
bootstrap           = 1;

signs_irf           = 0;
narrative_signs_irf = 0;
zeros_signs_irf     = 0;
proxy_irf           = 0;
heterosked_irf      = 0;
hmoments_signs_irf  = 0;
nexogenous          = 0;
exogenous           = [];
cnnctdnss_          = 0;
Ridge_              = 0;
Lasso_              = 0;
ElasticNet_         = 0;
set_irf             = 0;

if any(any(isnan(y))) %== 1
    error('cvar_ cannot handle missing observation; use bvar_ instead');

end

% declaring the names for the observable variables
for v = 1 : ny
    eval(['varnames{'   num2str(v) '} =  ''Var' num2str(v) ''';'])
end

%********************************************************
%* CUSTOMIZED SETTINGS
%********************************************************
if nargin > 2
    if isfield(options,'vnames')==1
        varnames = options.vnames;
    end
    %======================================================================
    % Inference options
    %======================================================================
    if isfield(options,'K')==1
        K = options.K;
    end
    if isfield(options,'firstobs')==1
        firstobs = options.firstobs;
        if firstobs < lags + 1
            error('firstobs need to be larger than lags +1')
        end
    end
    if isfield(options,'presample')==1
        presample = options.presample;
    end
    if isfield(options,'noconstant')==1
        noconstant = options.noconstant;
    end
    if isfield(options,'timetrend')==1
        timetrend  = options.timetrend;
        noconstant = 0;
    end
%     if isfield(options,'non_explosive_')==1
%         non_explosive_  = options.non_explosive_;
%     end
    if isfield(options,'heterosked_weights')==1
        ww  = options.heterosked_weights;
        heterosked = 1;
    end
    %======================================================================
    % Bootstrap options
    %======================================================================
    if isfield(options,'bootstrap')==1
        bootstrap = options.bootstrap;
    end
    if isfield(options,'replacement')==1
        replacement = options.replacement;
    end
    %======================================================================
    % Exogenous Variables options
    %======================================================================
    if isfield(options,'exogenous')==1 || isfield(options,'controls')==1
        if isfield(options,'controls')==1
            exogenous = options.controls;
        else
            exogenous = options.exogenous;
        end
        nexogenous = size(exogenous,2);
        if size(exogenous,1) ~= size(y,1)+ fhor && size(exogenous,1) ~= size(y,1)
            error('Size Mismatch between endogenous and exogenos variables; exo must be either T or T+fhor');
        end
        if any(isnan(exogenous(lags+1:end,:)))
            error('Exogenous variables cannnot be ''nan'' from lags+1 onward.');
        end
    end
    %======================================================================
    % IRF options
    %======================================================================
    if isfield(options,'hor') ==1
        hor = options.hor;
    end
    if isfield(options,'set_irf') ==1
        % set_irf is the # of rotations for set identified systems in wihch
        % Phi and Sigma are point estimates (e.g. OLS, Ridge, Lasso or
        % Elastic Nets); default 0
        set_irf = options.set_irf;
    end
    if isfield(options,'long_run_irf')==1
        % Activating Long run IRF
        long_run_irf = options.long_run_irf;
    end
    if isfield(options,'heterosked_regimes')==1
        % Activating identification via heteroskedasticity
        if length(options.heterosked_regimes) ~= size(y,1)
            error('heterosked_regimes must have the same time dimension of y')
        end
        heterosked_irf     = 1;
        heterosked_regimes = options.heterosked_regimes(lags+1:end);
        if any(heterosked_regimes>1) || any(heterosked_regimes<0)
            error('heterosked_regimes must contain zero (first regime) and one (second regime)')
        end
    end
    if isfield(options,'signs')==1
        % Activating IRF with sign restrictions (mulitple horizons allowed)
        signs_irf       = 1;
        signs           = options.signs;
        if iscellstr(signs) == 0
            error(['options.signs should be a cell array. Each cell must contain a string with the format'...
                '\n''y(a,b,c)<0'' or ''y(a,b,c)>0'' where a, b and c are integers.',...
                '\na = index of the variable',...
                '\nb = horizon',...
                '\nc = index of the shock'],class(zeros))
        end
    end
    if isfield(options,'narrative')==1
        if signs_irf  == 0
            warning('You did not provide any sign restrictions.')
            signs{1} = 'isempty(y(1,1,1))==0';
        end
        if signs_irf  == 1
            signs_irf       = 0;  % disactivating signs
        end
        narrative_signs_irf = 1;
        narrative           = options.narrative ;
    end
    if isfield(options,'hmoments')==1
        if signs_irf  == 0
            warning('You did not provide any sign restrictions.')
            signs{1} = 'isempty(y(1,1,1))==0';
        end
        if signs_irf  == 1
            signs_irf       = 0;  % disactivating signs
        end
        hmoments_signs_irf = 1;
        hmoments           = options.hmoments;
        [f]                = hmoments2matrix(hmoments,ny);
    end
    if isfield(options,'zeros_signs')==1
        if signs_irf  == 1
            signs_irf       = 0;  % disactivating signs
        end
        if narrative_signs_irf  == 1
            narrative_signs_irf       = 0;  % disactivating narrative
        end
        % Activating IRF with zeros and sign restrictions (mulitple horizons NOT allowed)
        zeros_signs_irf  = 1;
        zeros_signs      = options.zeros_signs;
        if iscellstr(zeros_signs) == 0
            error(['options.zeros_signs should be a cell array.'...
                '\nEach cell must contain a string with the following format'...
                '\nFor sign restrictions ''y(a,b)=1'' or ''y(a,b)=-1'',',...
                '\nFor short run zero restriction ''ys(a,b)=0'',',...
                '\nFor long run restriction ''yr(a,1,b)=0'' where a and b are integers.',...
                '\na = index of the variable',...
                '\nb = index of the shock'],class(zeros_signs))
        end
        [f,sr] = sign2matrix(zeros_signs,ny);
        if isfield(options,'var_pos')==0
            var_pos = ones(1,ny);
        else
            var_pos = options.var_pos;
        end
    end
    if isfield(options,'proxy')==1
        % Activating IRF with provy
        proxy_irf   = 1;
        in.proxies  = options.proxy;
        in.vars     = y;
        in.p        = lags;
        in.compute_F_stat = 0;
        if isfield(options,'proxy_end') == 1
            in.T_m_end  = options.proxy_end;
        else
            in.T_m_end  = 0;  %if the times series of the instrument ends when VAR data ends
        end
        in.irhor    = hor;
        if isnumeric(in.proxies) == 0
            error(['options.proxy should be a numeric array (nans or inf not allowed)'],class(in.proxies))
        end
        inols =in;
    end
    if isfield(options,'irf_1STD')==1
        % Activating of unitary IRF, i.e. a unitary increase in the shocks
        % (instead of 1 STD)
        irf_1STD = options.irf_1STD;
    end
    %======================================================================
    % (Un)Conditional Forecasts options
    %======================================================================
    if isfield(options,'fhor')==1
        fhor = options.fhor;
        if fhor < 1
            error('Forecast horizon must be positive')
        end
    end
    if isfield(options,'endo_index')==1
        % Forecast conditional on the path of an endogenous var
        cfrcst_yes      = 1;
        if isfield(options,'endo_path')== 0
            error('You need to provide the p[ath for the endogenou variable')
        end
        % rows forecasts, column variables
        endo_path       = options.endo_path;
        endo_path_index = options.endo_index;
        if length(endo_path_index) ~= size(endo_path)
            error(['Mismatch beween the number of endogenous paths and the number of conditioned variables'...
                '\nE.g. the # of conditioned variables must coincide with the # of column in ''options.endo_path'''],class(endo_path_index));
        end
        if isfield(options,'exo_index')==1
            % Forecast conditional on the path of an endo var using only a
            % subset of shocks. notice that the # of endo and # exo must coincide
            cfrcst_yes  = 2;
            exo_index   = options.exo_index;
            Omega       = eye(ny);
            %             if isfield(options,'Omegaf')==1
            %                 Omegaf = options.Omegaf;
            %             end
            if length(exo_index) ~= length(endo_path_index)
                error('the # of conditioned endogenous and # exogenous shocks used must coincide');
            end
        end

    end
    %======================================================================
    % Regularization options
    %======================================================================
    if isfield(options,'Ridge')==1
        Ridge_     = 1;%options.Ridge;
        if isfield(options.Ridge,'est') == 1
            Ridge_ = options.Ridge.est;
        end
        %cnnctdnss_ = 1;
        if isfield(options.Ridge,'lambda') == 1
            Ridge_lambda = options.Ridge.lambda;
        else
            warning('You did not specify a value for the penalization parameter (options.Ridge.lambda)')
            warning('I am using lambda = 0.02')
            Ridge_lambda = 0.02;
        end
    end
    if isfield(options,'Lasso')==1
        % (matlab stat toolbox needed)
        if exist('lasso') ~= 2
            error('Cannot estimate VAR with Lasso: matlab stat toolbox needed')
        end
        Lasso_     = 1;%options.Lasso;
        if isfield(options.Lasso,'est') == 1
            Lasso_ = options.Lasso.est;
        end
        %cnnctdnss_ = 1;
        if isfield(options.Lasso,'lambda') == 1
            Lasso_lambda = options.Lasso.lambda;
        else
            warning('You did not specify a value for the penalization parameter (options.Lasso.lambda)')
            %warning('Use the largest value of Lambda that gives a nonnull model')
            warning('I am using lambda = 0.05')
            Lasso_lambda = 0.05;
        end
    end
    if isfield(options,'ElasticNet')==1
        % (matlab stat toolbox needed)
        if  exist('lasso') ~= 2
            error('Cannot estimate VAR with ElasticNet: matlab stat toolbox needed')
        end
        ElasticNet_ = 1;%options.ElasticNet;
        if isfield(options.ElasticNet,'est') == 1
            ElasticNet_ = options.ElasticNet.est;
        end
        %cnnctdnss_  = 1;
        if isfield(options.ElasticNet,'lambda') == 1
            ElasticNet_lambda = options.ElasticNet.lambda;
        else
            warning('You did not specify a value for the penalization parameter (options.ElasticNet.lambda)')
            warning('I am using lambda = 0.05')
            ElasticNet_lambda = 0.05;
        end
        if isfield(options.ElasticNet,'alpha') == 1
            ElasticNet_alpha = options.ElasticNet.alpha;
        else
            warning('You did not specify a value for the relative penalization parameter (options.ElasticNet.alpha)')
            warning('I am using 0.5')
            ElasticNet_alpha = 0.5;
        end
    end
	%======================================================================
    % Network-Spillover-Connectedness options
    %======================================================================
    if isfield(options,'nethor')==1
        nethor = options.nethor;
    end
    if isfield(options,'connectedness')==1
        cnnctdnss_ = options.connectedness;
        if cnnctdnss_ == 2 && set_irf == 0
           set_irf = 100;
        end
    end
end

%********************************************************
%* Consistency Checks
%********************************************************
nobs = size(y,1)-firstobs+1;
if (firstobs+ nobs-1)> size(y,1)
    fprintf('Incorrect or missing specification of the number of observations. nobs can be at most %4u\n',size(y,1)-firstobs+1);
    error('Inconsistent number of observations.')
end
if firstobs + presample + lags >= nobs
    error('presample too large')
end
if firstobs + presample  <= lags
    error('firstobs+presample should be > # lags (for initializating the VAR)')
end
if cfrcst_yes ~= 0 && nexogenous > 0
    warning('I will not use exogenous variables with conditional forecasts');
    nexogenous = 0;
end
if size(exogenous,1) == size(y,1) && nexogenous > 0
    warning('For forecast purposes, I will assume that exo are zero out-of sample.')
    warning('To change this, include the exogenous forecasts in options.exogenous.')
    %fprintf('To change this, include the exogenous forecasts in options.exogenous.\n')
    exogenous = [exogenous; zeros(fhor,nexogenous)];
end
if (ElasticNet_==1 && Lasso_==1 && Ridge_==1) || ...
        (ElasticNet_==1 && Lasso_==1) || ...
        (Lasso_==1 && Ridge_==1) || ...
        (ElasticNet_==1 && Ridge_==1)
%    fprintf('Incorrect or missing specification of the number of observations. nobs can be at most %4u\n',size(y,1)-firstobs+1);
    error('You chose more than one regularization estimator, Ridge Lasso or ElasticNet. Please chose only one.')
end

%********************************************************
%* Estimate VAR
%********************************************************

idx = firstobs+presample-lags:firstobs+nobs-1;
nx  = 1;
if noconstant
    nx = 0;
end

% organize data as  yy = XX B + E
[yy,XX] = YXB_(y(idx, :),lags,[nx timetrend]);

% preparing the data for LS estimation
ydata   = y(idx, :);
T       = size(ydata, 1);
if T-lags < lags*ny + nx %+ flat*(ny+1)
    error('Less observations than regressors: increase the # of obs or decrease the # of lags.')
end
xdata   = ones(T,nx);
if timetrend == 1
    % xdata = [xdata [1:T]'];
    xdata = [xdata [1-lags : T-lags]'];
end
if nexogenous > 0
    xdata = [xdata exogenous(idx,:)];
    XX    = [XX exogenous(idx(1)+lags : idx(end),:)];
end

% OLS estimate:
if heterosked == 0
    varols  = rfvar3(ydata, lags, xdata, [T; T], 0, 0);
else
    varols  = rfvar3(ydata, lags, xdata, [T; T], 0, 0, ww);
end

if Ridge_ == 1
    varRidge   = varols;
    varRidge.B = (eye(size(varRidge.B,1)) + Ridge_lambda*varols.xxi)\varRidge.B;
    % varRidge.B = inv(eye(size(varRidge.B,1)) + Ridge_lambda*varols.xxi)*varRidge.B;
    varRidge.u = varRidge.y - varRidge.X*varRidge.B;
end
if Lasso_ == 1
    varLasso   = varols;
    for vv = 1 : ny
        varLasso.B(:,vv) = lasso(varLasso.X,varLasso.y(:,vv),'Lambda',Lasso_lambda);
    end
    varLasso.u = varLasso.y - varLasso.X*varLasso.B;
end
if ElasticNet_ == 1
     varElasticNet   = varols;
     for vv = 1 : ny
         varElasticNet.B(:,vv) = ...
             lasso(varElasticNet.X,varElasticNet.y(:,vv),'Lambda',ElasticNet_lambda,'Alpha',ElasticNet_alpha);
     end
     varElasticNet.u = varElasticNet.y - varElasticNet.X*varElasticNet.B;
end

%**************************************************
%* Generating draws form the Posterior Distribution
%**************************************************

% Preallocation of memory
% Matrices for collecting draws from Posterior Density
% Last dimension corresponds to a specific draw
Phi_boots     = zeros(ny*lags+nx+timetrend + nexogenous, ny, K);   % Autoregressive Parameters
Sigma_boots   = zeros(ny,ny,K);                     % Shocks Covariance
ir_boots      = zeros(ny,hor,ny,K);                 % variable, horizon, shock and draws - Cholesky IRF
irlr_boots    = zeros(ny,hor,ny,K);                 % variable, horizon, shock and draws - Long Run IRF
Qlr_boots     = zeros(ny,ny,K);                     % long run impact matrix
e_boots       = zeros(size(yy,1), ny,K);                  % residuals
yhatfut_no_shocks         = NaN(fhor, ny, K);   % forecasts with shocks
yhatfut_with_shocks       = NaN(fhor, ny, K);   % forecast without the shocks
yhatfut_cfrcst            = NaN(fhor, ny, K);   % forecast conditional on endogenous path
if signs_irf == 1
    irsign_boots = ir_boots;
    Omega_boots    = Sigma_boots;
end
if nexogenous > 0
    irx_boots = zeros(ny,hor,nexogenous,K);
    % Ox_boots  = Sigma_boots;
end
if narrative_signs_irf == 1
    irnarrsign_boots = ir_boots;
    Omegan_boots     = Sigma_boots;
end
if hmoments_signs_irf == 1
    irhmomsign_boots = ir_boots;
    Omegam_boots     = Sigma_boots;
end
if zeros_signs_irf == 1
    irzerosign_boots   = ir_boots;
    Omegaz_boots       = Sigma_boots;
end
if proxy_irf == 1
    irproxy_boots = ir_boots;
end
if heterosked_irf == 1
   irheterosked_boots = ir_boots;
   Omegah_boots       = Sigma_boots;
end
if cnnctdnss_ == 1
    CnndtnssIndex         = nan(K,1);
    CnndtnssFromAlltoUnit = nan(ny,K);
    CnndtnssFromUnitToAll = nan(ny,K);
    Ctheta                = nan(ny,ny,K);
end

% Settings for the forecasts
forecast_data.xdata       = ones(fhor, nx);
if timetrend
    forecast_data.xdata = [forecast_data.xdata (T-lags+1 : T-lags+fhor)'];
end
if nexogenous>0
    forecast_data.xdata = [forecast_data.xdata exogenous(T-lags+1 : T-lags+fhor,:)];
end
forecast_data.initval     = ydata(end-lags+1:end, :);

% # of RHS variables
nk               = ny*lags+nx+timetrend + nexogenous;

waitbar_yes = 0;
if K > 99
    waitbar_yes = 1;
    wb = waitbar(0, 'Bootstrapping');
end

% LS quantities for bootstrapping
Phi_    = varols.B;
e_      = varols.u;
Sigma_  = 1/(nobs-nk) * (e_' * e_);

% use penalized LS if activated in options
if Ridge_ == 1
    Phi_    = varRidge.B;
    e_      = varRidge.u;
    Sigma_  = 1/(nobs-nk) * (e_' * e_);
end
if Lasso_ == 1
    Phi_    = varLasso.B;
    e_      = varLasso.u;
    Sigma_  = 1/(nobs-nk) * (e_' * e_);
end
if ElasticNet_ == 1
    Phi_    = varElasticNet.B;
    e_      = varElasticNet.u;
    Sigma_  = 1/(nobs-nk) * (e_' * e_);
end

% setting of the forecast
deterministic_data.xdata = ones(nobs, nx);
if timetrend
    deterministic_data.xdata = [deterministic_data.xdata [1-lags : T-lags]'];
end
if nexogenous>0
    deterministic_data.xdata = [deterministic_data.xdata exogenous(idx,:)];
end

% Start bootstrap procedure
for  d =  1 : K
    % Bootstrap residuals
    switch bootstrap
        case 1
            % sampling with replacement
            % generating K new samples by bootstrapping the VAR reduced form errors
            e_boots(:,:,d) = bootstrap_(e_, 1, replacement);
            % generating K new initial conditions
            initval     =  bootstrap_(ydata(1 : firstobs-1,:), 1, replacement);
        case 2
            % Wild bootstrap based on simple distribution (~Rademacher)
            rr = 1-2*(rand(nobs,1)>0.5);
            %T x n randomly choose the sign of the time T shocks (all)
            e_boots(:,:,d) = (e_ .* (rr*ones(1,ny)));
            initval        = ydata(1 : firstobs-1,:);
    end
    % With bootstrapped errors / intial conditions construct new data
    deterministic_data.initval = initval;
    [~,ystar0]                 = forecasts(deterministic_data,Phi_,Sigma_,nobs,lags,e_boots(:,:,d),1);
    ystar                      = [initval; ystar0];
    % Construct left and right ahnd side variables for LS methods
    [yys,XXs] = YXB_(ystar(idx, :),lags,[nx timetrend]);
    % correct for heteroskedasticity of known form (ww) if any
    if heterosked == 1
        wws = [ww; ones(length(yys)-length(ww),1) ];
        yys = yys ./ repmat(wws,1,size(y,2)) ;
        XXs = XXs ./ repmat(wws,1,size(X,2));
    end
    % Compute LS estimator
    [vl,d_,vr] = svd(XXs,0);
    di         = 1./diag(d_);
    Phi        = (vr .* repmat(di', nk, 1)) * vl' * yys;
    % Penalized the LS estimator if activated in options
    if Ridge_ == 1
        xxi        = vr .* repmat(di',nk,1);
        iXX        = xxi * xxi';
        Phi = (eye(nk) + Ridge_lambda*iXX)\Phi;
    end
    if Lasso_ == 1
        LassoPhi = nan(size(Phi));
        for vv = 1 : ny
            LassoPhi(:,vv) = lasso(XXs,yys(:,vv),'Lambda',Lasso_lambda);
        end
        Phi = LassoPhi;
    end
    if ElasticNet_ == 1
        ElasticNetPhi = nan(size(Phi));
        for vv = 1 : ny
            ElasticNetPhi(:,vv) = ...
                lasso(XXs,yys(:,vv),'Lambda',ElasticNet_lambda,'Alpha',ElasticNet_alpha);
        end
        Phi = ElasticNetPhi;
    end
    % compute residual and covariance matrix
    errors  = yys - XXs*Phi;
    Sigma   = 1/(nobs-nk)*(errors' * errors);
    % store the draw
    Phi_boots(:,:,d)   = Phi;
    Sigma_boots(:,:,d) = Sigma;

    %======================================================================
    % IRF
    % Compute the impulse response functions
    % with cholesky
    if irf_1STD == 1
        % one STD increase
        ir_boots(:,:,:,d)      = iresponse(Phi(1 : ny*lags, 1 : ny),Sigma,hor,eye(ny));
    else
        % one percent increase
        ir_boots(:,:,:,d)      = iresponse(Phi(1 : ny*lags, 1 : ny),Sigma,hor,eye(ny),0);
    end
    if nexogenous > 0
        Phi1         = Phi(1 : ny*lags + nx + timetrend, 1 : ny);
        Exo1         = zeros(ny,nexogenous);
        Exo1(:,1:nexogenous) = Phi(ny*lags + nx + timetrend +1 ....
                            : ny*lags + nx + timetrend + nexogenous, 1 : ny)';
        Sig1         = eye(ny);
        % unitary increase
        irx_boots(:,:,:,d) = iresponse(Phi1,Sig1,hor,Exo1);
    end
    % define the identity rotation
    Omega = eye(ny);

    % with long run restrictions
    if long_run_irf == 1
        [irlr,Qlr]             = iresponse_longrun(Phi(1 : ny*lags, 1 : ny),Sigma,hor,lags);
        irlr_boots(:,:,:,d)    = irlr;
        Qlr_boots(:,:,d)       = Qlr;
        Omega                  = Qlr;
    end
%     % with sign restrictions
%     if signs_irf == 1
%         [irsign,Omega]         = iresponse_sign(Phi(1 : ny*lags, 1 : ny),Sigma,hor,signs);
%         irsign_boots(:,:,:,d)  = irsign;
%         Omega_boots(:,:,d)     = Omega;
%     end
%     % with narrative and sign restrictions
%     if narrative_signs_irf == 1
%         [irnarrsign,Omega]         = iresponse_sign_narrative(errors,Phi(1 : ny*lags, 1 : ny),Sigma,hor,signs,narrative);
%         irnarrsign_boots(:,:,:,d)  = irnarrsign;
%         Omegan_boots(:,:,d)        = Omega;
%     end
%     % with higher-moments and sign restrictions
%     if hmoments_signs_irf == 1
%         [irhmomsign,Omega]         = iresponse_sign_hmoments(errors,Phi(1 : ny*lags, 1 : ny),Sigma,hor,signs,hmoments,f);
%         irhmomsign_boots(:,:,:,d)  = irhmomsign;
%         Omegam_boots(:,:,d)        = Omega;
%     end
    % with zeros and sign restrictions
    if zeros_signs_irf == 1         %= iresponse_zeros_signs( Phi,Sigma,bvar1.hor,lags,var_pos,f,sr);
        [irzerosign,Omega]          = iresponse_zeros_signs(Phi,Sigma,hor,lags,var_pos,f,sr);
        irzerosign_boots(:,:,:,d)   = irzerosign;
        Omegaz_boots(:,:,d)         = Omega;
    end
    % with proxy
    if proxy_irf == 1
        in.res                  = e_boots(:,:,d);
        in.Phi                  = Phi_boots(:,:,d)  ;
        in.Sigma                = Sigma;
        tmp_                    = iresponse_proxy(in);
        irproxy_boots(:,:,1,d)  = tmp_.irs';
        clear tmp_
    end
    % with heteroskedasticity
    if heterosked_irf == 1
        [irheterosked,Omegah]       = iresponse_heterosked(Phi(1 : ny*lags, 1 : ny),errors,hor,heterosked_regimes);
        irheterosked_boots(:,:,:,d) = irheterosked;
        Omegah_boots(:,:,d)         = Omegah;
    end

    %======================================================================
    % Forecasts
    % compute the out of sample forecast (unconditional)
    [frcst_no_shock,frcsts_with_shocks] = forecasts(forecast_data,Phi,Sigma,fhor,lags);
    yhatfut_no_shocks(:,:,d)            = frcst_no_shock;
    yhatfut_with_shocks(:,:,d)          = frcsts_with_shocks;

    if cfrcst_yes == 1
        % Forecast conditional on the path of an endo var using all shocks
        [sims_with_endopath,EPS(:,:,d)] = ...
            cforecasts(endo_path,endo_path_index,forecast_data,Phi,Sigma);
        yhatfut_cfrcst(:,:,d) = sims_with_endopath;

    elseif cfrcst_yes == 2
        % Forecast conditional on the path of an endo var using only a
        % subset of shocks. notice that the # of endo and # exo must coincide
        % Omega is the structural orthonormal matrix
        [sims_with_endopath,EPS(:,:,d)] = ...
            cforecasts2(endo_path,endo_path_index,exo_index,forecast_data,Phi,Sigma,Omega);
        yhatfut_cfrcst(:,:,d) = sims_with_endopath;
    end

    %======================================================================
    % Connectedness
    if cnnctdnss_ > 0
%         if use_omega == 1
%             [C] = connectedness(Phi,Sigma,nethor,Omega);
%         else
%         end
        if cnnctdnss_ == 2
            Sigma_lower_chol = chol(Sigma)';
            [C] = connectedness(Phi(1 : ny*lags, 1 : ny),Sigma,nethor, Sigma_lower_chol * Omega );
        elseif cnnctdnss_ == 1
            [C] = connectedness(Phi(1 : ny*lags, 1 : ny),Sigma,nethor);
        end
        CnndtnssIndex(d,1)         = C.Index;
        CnndtnssFromAlltoUnit(:,d) = C.FromAllToUnit;
        CnndtnssFromUnitToAll(:,d) = C.FromUnitToAll;
        Ctheta(:,:,d)              = C.theta;
    end

    if waitbar_yes, waitbar(d/K, wb); end
%     dd = 0; % reset
end
if waitbar_yes, close(wb); end

%********************************************************
%* Storing the resutls
%*******************************************************

%==========================================================================
% classical inference: LS estimator
CVAR.Phi_ols    = varols.B;
CVAR.e_ols      = varols.u;
CVAR.Sigma_ols  = 1/(nobs-nk)*varols.u'*varols.u;
[CVAR.InfoCrit.AIC, CVAR.InfoCrit.HQIC, CVAR.InfoCrit.BIC] = IC(CVAR.Sigma_ols, CVAR.e_ols, nobs, nk);
% the model with the lowest IC is preferred

% OLS irf
% with cholesky
CVAR.ir_ols      = iresponse(CVAR.Phi_ols(1 : ny*lags, 1 : ny),CVAR.Sigma_ols,hor,eye(ny));
% with long run
if long_run_irf == 1
    [irlr,Qlr]              = iresponse_longrun(CVAR.Phi_ols(1 : ny*lags, 1 : ny),CVAR.Sigma_ols,hor,lags);
    CVAR.irlr_ols           = irlr;
    CVAR.Qlr_ols(:,:)       = Qlr;
end
% set identified IRF
if set_irf > 0
    wb = waitbar(0, ['Generating rotations for set-identification - LS Estimator']);
    % with sign restrictions
    if signs_irf == 1
        for d1 = 1 : set_irf
            [CVAR.irsign_ols(:,:,:,d1),CVAR.Omega_ols(:,:,d1)] = ...
                iresponse_sign(CVAR.Phi_ols(1 : ny*lags, 1 : ny),CVAR.Sigma_ols,hor,signs);
            waitbar(d1/set_irf, wb);
        end
    end
    % with narrative and sign restrictions
    if narrative_signs_irf == 1
        for d1 = 1 : set_irf
            [CVAR.irnarrsign_ols(:,:,:,d1),CVAR.Omegan_ols(:,:,d1)] = ...
                iresponse_sign_narrative(CVAR.e_ols,CVAR.Phi_ols(1 : ny*lags, 1 : ny),CVAR.Sigma_ols,hor,signs,narrative);
            waitbar(d1/set_irf, wb);
        end
    end
    % with zeros and sign restrictions
    if zeros_signs_irf == 1
        for d1 = 1 : set_irf
            [CVAR.irzerosign_ols(:,:,:,d1),CVAR.Omegaz_ols(:,:,d1)] = ...
                iresponse_zeros_signs(CVAR.Phi_ols,CVAR.Sigma_ols,hor,lags,var_pos,f,sr);
            waitbar(d1/set_irf, wb);
        end
    end
    close(wb)
end
% proxy
if proxy_irf == 1
    inols.res               = CVAR.e_ols;
    inols.Phi               = CVAR.Phi_ols;
    inols.Sigma             = CVAR.Sigma_ols;
    inols.compute_F_stat    = 1;
    tmp_                    = iresponse_proxy(inols);
    CVAR.irproxy_ols(:,:,1) = tmp_.irs';
    CVAR.proxy.F_m          = tmp_.F_m;
    CVAR.proxy.F_m_rob      = tmp_.F_m_rob;
    CVAR.proxy.R2adj_m      = tmp_.R2adj_m;
    CVAR.proxy.data         = options.proxy;
    clear tmp_
end
% with heteroskedasticity
if heterosked_irf == 1
    [CVAR.irheterosked_ols,CVAR.Omegah_ols] = ...
        iresponse_heterosked(CVAR.Phi_ols(1 : ny*lags, 1 : ny),CVAR.e_ols,hor,heterosked_regimes);
end
% test the normality of the ols VAR residuals (matlab stat toolbox needed)
if  exist('kstest') ==2
    for gg = 1 : ny
        [H,Pv] = kstest(CVAR.e_ols(:,gg)/sqrt(CVAR.Sigma_ols(gg,gg)));
        CVAR.HP(gg,:) = [H,Pv];
        %      H = 0 => Do not reject the null hypothesis at the 5% significance
        %      level.
    end
else
    CVAR.HP = [];
end

%==========================================================================
% Penalized Approaches (Regularization)
penalizationstrn = {'Ridge','Lasso','ElasticNet'};
% loop across penalization approaches
for pp = 1 : 3
    Phi_ = []; Sigma_ = []; u_ = []; Omega_(:,:,1) = eye(ny);  InfoCrit_ = [];
    if eval([ penalizationstrn{pp} '_ == 1'])
        % AR param
        eval(['CVAR.' penalizationstrn{pp} '.Phi    = var' penalizationstrn{pp} '.B;']);
        eval(['Phi_   = CVAR.' penalizationstrn{pp} '.Phi;'])
        % Error term
        eval(['CVAR.' penalizationstrn{pp} '.e      = var' penalizationstrn{pp} '.u;']);
        eval(['u_ = CVAR.' penalizationstrn{pp} '.e;'])
        % Covariance Matrix
        eval(['CVAR.' penalizationstrn{pp} '.Sigma  = 1/(nobs-nk) * var' penalizationstrn{pp} '.u'' * var' penalizationstrn{pp} '.u;'])
        eval(['Sigma_ = CVAR.' penalizationstrn{pp} '.Sigma;'])
        % Recursive IRFs
        eval(['CVAR.' penalizationstrn{pp} '.ir      = iresponse(Phi_(1 : ny*lags, 1 : ny),Sigma_,hor,eye(ny));']);
        % info crit
        [InfoCrit_.AIC, InfoCrit_.HQIC, InfoCrit_.BIC] ...
            = IC(Sigma_, u_, nobs, nk);
        eval(['CVAR.' penalizationstrn{pp} '.InfoCrit      = InfoCrit_;']);
        % IRFs with different identification schemes
        % point identification: LR
        if long_run_irf == 1
            eval(['[CVAR.' penalizationstrn{pp} '.irlr,Omega_] = iresponse_longrun(Phi_(1 : ny*lags, 1 : ny),Sigma_,hor,lags);'])
        end
        % point identification: with heteroskedasticity
        if heterosked_irf == 1
            eval(['[CVAR.' penalizationstrn{pp} '.irheterosked,Omega_] = iresponse_heterosked(Phi_(1 : ny*lags, 1 : ny),u_,hor,heterosked_regimes);'])
        end
        % set identification: signs
        if set_irf > 0
            wb = waitbar(0, ['Generating rotations for set-identification - ' penalizationstrn{pp} ' Estimator']);
        end
        if signs_irf == 1
            for d1 = 1 : set_irf
                eval(['[CVAR.' penalizationstrn{pp} '.irsign_boots(:,:,:,' num2str(d1) ...
                    '),Omega_(:,:,' num2str(d1) ')] = iresponse_sign(Phi_(1 : ny*lags, 1 : ny),Sigma_,hor,signs);'])
                waitbar(d1/set_irf, wb);
            end
        end
        % set identification: narrative and sign restrictions
        if narrative_signs_irf == 1
            for d1 = 1 : set_irf
                eval(['[CVAR.' penalizationstrn{pp} '.irnarrsign_boots(:,:,:,' num2str(d1) ...
                    '),Omega_(:,:,' num2str(d1) ')] = iresponse_sign_narrative(Phi_(1 : ny*lags, 1 : ny),Sigma_,hor,signs,narrative);'])
                waitbar(d1/set_irf, wb);
            end
        end
        % set identification: zeros and sign restrictions
        if zeros_signs_irf == 1
            for d1 = 1 : set_irf
                eval(['[CVAR.' penalizationstrn{pp} 'irzerosign_boots.(:,:,:,' num2str(d1) ...
                    '),Omega_(:,:,' num2str(d1) ')] = iresponse_zeros_signs(Phi_(1 : ny*lags, 1 : ny),Sigma_,hor,lags,var_pos,f,sr);'])
                waitbar(d1/set_irf, wb);
            end
        end
        if set_irf>0, close(wb); end
    end
    if cnnctdnss_ == 1 % default identification (Pesaran and Shin)
        eval(['CVAR.' penalizationstrn{pp} '.Connectedness = connectedness(Phi_(1 : ny*lags, 1 : ny),Sigma_,nethor);']);
    elseif cnnctdnss_ == 2 % customized identification
        Sigma_lower_chol = chol(Sigma_)';
        % this part is not correct as the median orthogonal rotation is not
        % orthogonal
        Omegam           = median(Omega_,3);
        eval(['CVAR.' penalizationstrn{pp} '.Connectedness = connectedness(Phi_(1 : ny*lags, 1 : ny), Sigma_, nethor, Sigma_lower_chol * Omegam);']);
    end

end

%==========================================================================
% Store the output
% the last dimension of these objects corresponds to a bootstrapped sample

% inference and IRFs
CVAR.Phi_boots    = Phi_boots;          % draws from the autoregressive part
CVAR.Sigma_boots  = Sigma_boots;        % draws from the covarance matrix
CVAR.ir_boots     = ir_boots;           % draws from the IRF with cholesky
CVAR.irlr_boots   = irlr_boots;         % draws from the IRF with Long Run
CVAR.Qlr_boots    = Qlr_boots;          % Long Run Rotation matrix
CVAR.lags         = lags;               % lags
CVAR.N            = ny;                 % number of variables
CVAR.e_boots      = e_boots;            % residuals
CVAR.XX           = XX;                 % regressors (no dummy)
CVAR.yy           = yy;                 % dependent  (no dummy)

% prediction
CVAR.fhor         = fhor;               % forecast horizon
CVAR.hor          = hor;                % IRF horizon
CVAR.forecasts.no_shocks      = yhatfut_no_shocks;         % trajectories of forecasts without shocks
CVAR.forecasts.with_shocks    = yhatfut_with_shocks;       % trajectories of forecasts with shocks
CVAR.forecasts.conditional    = [];            % trajectories of conditional forecasts
CVAR.forecasts.EPScond        = [];            % shocks of conditional forecasts
if cfrcst_yes ~= 0
    CVAR.forecasts.conditional    = yhatfut_cfrcst;            % trajectories of forecasts
    CVAR.forecasts.EPScond        = EPS;                       % shocks of forecasts
end
CVAR.forecast_data            = forecast_data;

%
CVAR.varnames     = varnames;
CVAR.ndraws       = K;

if signs_irf == 1 && narrative_signs_irf == 0
    CVAR.irsign_boots = irsign_boots;
    CVAR.Omegas       = Omega_boots;
else
    CVAR.irsign_boots = [];
    CVAR.Omegas       = [];
end
if narrative_signs_irf == 1
    CVAR.irnarrsign_boots = irnarrsign_boots;
    CVAR.Omegan           = Omegan_boots;
else
    CVAR.irnarrsign_boots = [];
    CVAR.Omegan           = [];
end
if hmoments_signs_irf == 1
    CVAR.irhmomsign_boots = irhmomsign_boots;
    CVAR.Omegam           = Omegam_boots;
else
    CVAR.irhmomsign_boots = [];
    CVAR.Omegam           = [];
end
if zeros_signs_irf == 1
    CVAR.irzerosign_boots   = irzerosign_boots;
    CVAR.Omegaz             = Omegaz_boots;
else
    CVAR.irzerosign_boots = [];
    CVAR.Omegaz           = [];
end
if heterosked_irf == 1
    CVAR.irheterosked_boots   = irheterosked_boots;
    CVAR.Omegah_boots         = Omegah_boots;
    CVAR.Omegah               = CVAR.Omegah_boots;
else
    CVAR.irheterosked_boots   = [];
    CVAR.Omegah_boots         = [];
    CVAR.Omegah               = [];
end
if proxy_irf == 1
    CVAR.irproxy_boots = irproxy_boots;
else
    CVAR.irproxy_boots= [];
end
if nexogenous > 0
    CVAR.irx_boots = irx_boots;
else
    CVAR.irx_boots = [];
end

% connetedness computed using LS (or penalized LS if activated in options)
if cnnctdnss_
    CVAR.Connectedness.Index         = CnndtnssIndex;
    CVAR.Connectedness.FromAlltoUnit = CnndtnssFromAlltoUnit;
    CVAR.Connectedness.FromUnitToAll = CnndtnssFromUnitToAll;
    CVAR.Connectedness.theta         = Ctheta;
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% end of cvar_.m
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


function sliceThicknessV = deduceSliceWidths(planC)
%function sliceThicknessV = deduceSliceWidths(planC)
%
%This function deduces slice thicknesses when the treatment planning system
%provides only z Values.
%
%
%Created:  30 Apr 03, JOD.
%
% Copyright 2010, Joseph O. Deasy, on behalf of the CERR development team.
%
% This file is part of The Computational Environment for Radiotherapy Research (CERR).
%
% CERR development has been led by:  Aditya Apte, Divya Khullar, James Alaly, and Joseph O. Deasy.
%
% CERR has been financially supported by the US National Institutes of Health under multiple grants.
%
% CERR is distributed under the terms of the Lesser GNU Public License.
%
%     This version of CERR 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.
%
% CERR 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 CERR.  If not, see <http://www.gnu.org/licenses/>.

indexS = planC{end};

zValuesV = [planC{indexS.scan}.scanInfo(:).zValue];

sliceThicknessV = ones(size(zValuesV)) * nan;

for i = 2 : length(zValuesV) - 1

  nextDelta = abs(zValuesV(i+1) - zValuesV(i));

  sliceThicknessV(i) = nextDelta;

end

sliceThicknessV(1) = 2 * (abs(zValuesV(2) - zValuesV(1)) - 0.5 * sliceThicknessV(2));

sliceThicknessV(end) = 2 * (abs(zValuesV(end) - zValuesV(end - 1)) - 0.5 * sliceThicknessV(end - 1));


function Cd = som_cldist(D,clinds1,clinds2,cldist,q,mask)

% SOM_CLDIST Distances between two clusters.
%
%   Cd = som_cldist(Md,c1,c2,'single')
%   Cd = som_cldist(Md,c1,c2,'average')
%   Cd = som_cldist(Md,c1,c2,'complete')
%   Cd = som_cldist(Md,c1,c2,'neighf',H)
%   Cd = som_cldist(Md,c1,[],...)
%   Cd = som_cldist(D,c1,c2,'centroid',q,mask)
%   Cd = som_cldist(D,c1,c2,'ward',q,mask)
%   Cd = som_cldist(D,c1,[],...)
%
%  Input and output arguments ([]'s are optional):
%   D        (matrix) size dlen x dim, the data set
%            (struct) map or data struct
%   Md       (matrix) size dlen x dlen, mutual distance matrix, see SOM_MDIST
%   c1       (cell array) size n1 x 1, indices of clusters from which
%                     the distances should be calculated, each cell
%                     contains indices of vectors that belong to that
%                     cluster (indices are between 1...dlen)
%   c2       (cell array) size n2 x 1, same as c1 but have the clusters
%                     to which the distances should be calculated
%            (empty)  c1 is used in place of c2
%   [q]      (scalar) distance norm, default = 2
%   [mask]   (vector) size dim x 1, the weighting mask, a vector of ones
%                     by default
%   H        (matrix) size dlen x dlen, neighborhood function values
%
%   Cd       (matrix) size n1 x n2, distances between the clusters
%
% See also SOM_MDIST.

% Copyright (c) 2000 by Juha Vesanto
% Contributed to SOM Toolbox on XXX by Juha Vesanto
% http://www.cis.hut.fi/projects/somtoolbox/

% Version 2.0beta juuso 250800

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

[dlen dim] = size(D);
if nargin<5, q = 2; end
if nargin<6, mask = ones(dim,1); end
if ~iscell(clinds1), clinds1 = {clinds1}; end
if ~isempty(clinds2) && ~iscell(clinds2), clinds2 = {clinds2}; end

n1 = length(clinds1);
n2 = length(clinds2);
if n2>0, Cd = zeros(n1,n2); else Cd = zeros(n1); end
if n1==0, return; end

switch cldist,

 % centroid distance %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 case 'centroid',

  C1 = zeros(n1,dim); for i=1:n1, C1(i,:) = mean(D(clinds1{i},:),1); end
  C2 = zeros(n2,dim); for i=1:n2, C2(i,:) = mean(D(clinds2{i},:),1); end
  if n2==0,
    for i=1:n1-1,
      for j=i+1:n1,
	diff = C1(i,:)-C1(j,:);
	switch q,
	 case 1,    Cd(i,j)=abs(diff)*mask;
	 case 2,    Cd(i,j)=sqrt((diff.^2)*mask);
	 case Inf,  Cd(i,j)=max(diag(mask)*abs(diff),[],2);
	 otherwise, Cd(i,j)=((abs(diff).^q)*mask).^(1/q);
	end
      end
      Cd([(i+1):n1],i) = Cd(i,[(i+1):n1])';
    end
  else
    for i=1:n1,
      for j=1:n2,
	diff = C1(i,:)-C2(j,:);
	switch q,
	 case 1,    Cd(i,j)=abs(diff)*mask;
	 case 2,    Cd(i,j)=sqrt((diff.^2)*mask);
	 case Inf,  Cd(i,j)=max(diag(mask)*abs(diff),[],2);
	 otherwise, Cd(i,j)=((abs(diff).^q)*mask).^(1/q);
	end
      end
    end
  end

 % ward distance %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 case 'ward',

  C1 = zeros(n1,dim); nn1 = zeros(n1,dim);
  for i=1:n1, C1(i,:) = mean(D(clinds1{i},:),1); nn1(i) = length(clinds1{i}); end
  C2 = zeros(n2,dim); nn2 = zeros(n2,dim);
  for i=1:n2, C2(i,:) = mean(D(clinds2{i},:),1); nn2(i) = length(clinds2{i}); end
  if n2==0,
    for i=1:n1-1,
      for j=i+1:n1,
	diff = C1(i,:) - C1(j,:);
	f = 2*nn1(i)*nn1(j) / (nn1(i)+nn1(j));
	switch q,
	 case 1,    Cd(i,j)=f*abs(diff)*mask;
	 case 2,    Cd(i,j)=f*sqrt((diff.^2)*mask);
	 case Inf,  Cd(i,j)=f*max(diag(mask)*abs(diff),[],2);
	 otherwise, Cd(i,j)=f*((abs(diff).^q)*mask).^(1/q);
	end
      end
      Cd([(i+1):n1],i) = Cd(i,[(i+1):n1])';
    end
  else
    for i=1:n1,
      for j=1:n2,
	diff = C1(i,:) - C2(j,:);
	f = 2*nn1(i)*nn2(j) / (nn1(i)+nn2(j));
	switch q,
	 case 1,    Cd(i,j)=f*abs(diff)*mask;
	 case 2,    Cd(i,j)=f*sqrt((diff.^2)*mask);
	 case Inf,  Cd(i,j)=f*max(diag(mask)*abs(diff),[],2);
	 otherwise, Cd(i,j)=f*((abs(diff).^q)*mask).^(1/q);
	end
      end
    end
  end

 % single linkage distance %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 case 'single',

  if n2==0,
    for i=1:n1-1,
      for j=i+1:n1,
	vd = D(clinds1{i},clinds1{j});
	fi = isfinite(vd(:));
	if any(fi), Cd(i,j) = min(vd(fi)); else Cd(i,j) = Inf; end
      end
      Cd([(i+1):n1],i) = Cd(i,[(i+1):n1])';
    end
  else
    for i=1:n1,
      for j=1:n2,
	vd = D(clinds1{i},clinds2{j});
	fi = isfinite(vd(:));
	if any(fi), Cd(i,j) = min(vd(fi)); else Cd(i,j) = Inf; end
      end
    end
  end

 % average linkage distance %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 case 'average',

  if n2==0,
    for i=1:n1-1,
      for j=i+1:n1,
	vd = D(clinds1{i},clinds1{j});
	fi = isfinite(vd(:));
	if any(fi), Cd(i,j) = mean(vd(fi)); else Cd(i,j) = Inf; end
      end
      Cd([(i+1):n1],i) = Cd(i,[(i+1):n1])';
    end
  else
    for i=1:n1,
      for j=1:n2,
	vd = D(clinds1{i},clinds2{j});
	fi = isfinite(vd(:));
	if any(fi), Cd(i,j) = mean(vd(fi)); else Cd(i,j) = Inf; end
      end
    end
  end

 % complete linkage distance %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 case 'complete',

   if n2==0,
    for i=1:n1-1,
      for j=i+1:n1,
	vd = D(clinds1{i},clinds1{j});
	fi = isfinite(vd(:));
	if any(fi), Cd(i,j) = max(vd(fi)); else Cd(i,j) = Inf; end
      end
      Cd([(i+1):n1],i) = Cd(i,[(i+1):n1])';
    end
  else
    for i=1:n1,
      for j=1:n2,
	vd = D(clinds1{i},clinds2{j});
	fi = isfinite(vd(:));
	if any(fi), Cd(i,j) = max(vd(fi)); else Cd(i,j) = Inf; end
      end
    end
  end

 % neighborhood function linkage distance %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 case 'neighf',

  if n2==0,
    for i=1:n1-1,
      for j=i+1:n1,
	vd = D(clinds1{i},clinds1{j});
	fi = isfinite(vd(:));
	if any(fi),
	  hd = q(clinds1{i},clinds1{j});
	  hd = hd(fi);
	  Cd(i,j) = sum(hd.*vd(fi))/sum(hd);
	else Cd(i,j) = Inf;
	end
      end
      Cd([(i+1):n1],i) = Cd(i,[(i+1):n1])';
    end
  else
    for i=1:n1,
      for j=1:n2,
	vd = D(clinds1{i},clinds2{j});
	fi = isfinite(vd(:));
	if any(fi),
	  hd = q(clinds1{i},clinds2{j});
	  hd = hd(fi);
	  Cd(i,j) = sum(hd.*vd(fi))/sum(hd);
	else Cd(i,j) = Inf;
	end
      end
    end
  end

 otherwise, error(['Unknown cluster distance metric: ' cldist]);
end

return;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


function legendre_polynomial_plot01 ( )

%*****************************************************************************80
%
%% LEGENDRE_POLYNOMIAL_PLOT01 tests P_POLYNOMIAL_PLOT.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    13 March 2012
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'LEGENDRE_POLYNOMIAL_PLOT01:\n' );
  fprintf ( 1, '  P_POLYNOMIAL_PLOT creates a plot of one or more Legendre functions.\n' );

  index = [ 0, 1, 2, 3, 4, 5 ];
  filename = 'p_polynomial_plot.png';

  p_polynomial_plot ( index, filename );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Legendre polynomial plot stored in file "%s".\n', filename );

  return
end


function varargout = max(varargin)
% global, local and pointwise maxima of spherical functions
%
% Syntax
%   [v,pos] = max(sF) % the position where the maximum is atained
%
%   [v,pos] = max(sF,'numLocal',5) % the 5 largest local maxima
%
%   sF = max(sF, c) % maximum of a spherical functions and a constant
%   sF = max(sF1, sF2) % maximum of two spherical functions
%   sF = max(sF1, sF2, 'bandwidth', bw) % specify the new bandwidth
%
%   % compute the maximum of a multivariate function along dim
%   sF = max(sFmulti,[],dim)
%
% Input
%  sF, sF1, sF2 - @S2Fun
%  sFmulti - a multivariate @S2Fun
%  c       - double
%
% Output
%  v - double
%  pos - @vector3d
%
% Options
%  kmax - number of iterations
%  numLocal      - number of peaks to return
%  startingNodes - @vector3d
%  tolerance     - minimum distance between two peaks
%  resolution    - minimum step size
%  maxStepSize   - maximm step size
%

varargin{1} = -varargin{1};
if nargin>1 && ( ~isempty(varargin{2}) && isa(varargin{2},'double') || isa(varargin{2},'S2Fun' ))
  varargin{2} = -varargin{2};
end

[varargout{1:nargout}] = min(varargin{:});

varargout{1} = - varargout{1};

end


%% Microstrip branch line-coupler analysis using 3D FDTD code with UPML
%% absorbing borders (ABC)
%
% Again we use FDTD 3D with UPML to calculate scattering coefficients S_{11},
% S_{21}, S_{31} and S_{41} for planar microstrip branch line-coupler
% following by the original paper by D. Sheen, S. Ali, M. Abouzahra, J. Kong
% "Application of the Three-Dimensional Finite-Difference Time-Domain Method
% to the Analysis of planar Microstrip Circuits", IEEE Trans. on Microwave
% Theory and Techniques (http://dx.doi.org/10.1109/22.55775).
%% Current code includes some improvements in comparison with the original
%% calculations:
% 1) imposing UPML instead of Mur ABCs;
% 2) using real metal (copper) as a patch conductor material instead of PEC;
% 3) applying matched load at the ends of filter's transmission microstrip
%    lines to prevent physical reflections;
% 4) no "magnetic wall" or "electric wall" conditions at the Ez source
%    plane;
% 5) using real properties for dielectric with losses (Duroid).
%
function FDTD_3D_Branch_Line_Coupler
close all; clear; clc;
%% Physical constants
   epsilon0 = 8.85418782e-12; mu0 = 1.25663706e-6;
   c = 1.0/sqrt(mu0*epsilon0);

%% Gaussian half-width
   t_half = 15.0e-12;

%% Microstrip transmission lines parameters
   lineW = 2.413e-3;
   lineH = 1.0e-3;
   % Roger's 5880 Duroid parameters
   lineEr = 2.2;     % eps_r
   lineTan = 0.0009; % loss tangent
   Z0 = 49.2526; % Matched load transmission line

%% End time
   t_end = 1.5e-9;

%% Total mesh dimensions and grid cells sizes (without PML)
   nx = 60; ny = 100; nz = 16;
   dx = 0.406e-3; dy = 0.406e-3; dz = 0.265e-3;

%% Number of PML layers
   PML = 5;

%% Matrix of material's constants
   number_of_materials = 4;
   % For material of number x = 1,2,3... :
   % Material(x,1) - relative permittivity, Material(x,2) - relative permeability,
   % Material(x,3) - specific conductivity
   % Vacuum
   Material(1,1) = 1.0;   Material(1,2) = 1.0;   Material(1,3) = 0.0;
   % Metal (Copper)
   Material(2,1) = 1.0;   Material(2,2) = 1.0;   Material(2,3) = 5.88e+7;
   % Substrate material (RT/Duroid 5880)
   Material(3,1) = lineEr;   Material(3,2) = 1.0;
   % Calculate conductivity of Duroid at 20 GHz from loss tangent and eps_r
   Material(3,3) = 2*pi*20e9*lineTan*lineEr*epsilon0;
   % Matched load material is calculated from transmission line parameters
   Material(4,1) = 1.0;   Material(4,2) = 1.0;   Material(4,3) = lineH/(Z0*lineW*dy);

% Add PML layers
   nx = nx + 2*PML; ny = ny + 2*PML; nz = nz + 2*PML;
% Calculate dt
   dt = (1.0/c/sqrt( 1.0/(dx^2) + 1.0/(dy^2) + 1.0/(dz^2)))*0.9999;
   number_of_iterations = ceil(t_end/dt);

%% 3D array for geometry
   Index = ones(nx, ny, nz);

%% Define of low-pass filter geometry
   % Ground plane
   Index((1+PML):(nx-PML-1), (1+PML):(ny-PML-1), PML+1) = 2;
   % Rectangular patch (thickness is equal to one cell)
   Index((nx/2-14):(nx/2+15), (ny/2-14):(ny/2-9), PML+5) = 2;
   Index((nx/2-14):(nx/2+15), (ny/2+9):(ny/2+14), PML+5) = 2;
   Index((nx/2-14):(nx/2-9), (1+PML):(ny-PML-1), PML+5) = 2;
   Index((nx/2+10):(nx/2+15), (1+PML):(ny-PML-1), PML+5) = 2;
   Index((nx/2-16):(nx/2-7), (ny/2-12):(ny/2+12), PML+5) = 2;
   Index((nx/2+8):(nx/2+17), (ny/2-12):(ny/2+12), PML+5) = 2;
   % Dielectric substrate between ground plane and filter patch
   Index((1+PML):(nx-PML-1), (1+PML):(ny-PML-1), (PML+2):(PML+4)) = 3;
   % Matched load before port 1 and 2
   Index((nx/2-14):(nx/2-9), PML+1, (PML+2):(PML+4)) = 4;
   Index((nx/2+10):(nx/2+15), PML+1, (PML+2):(PML+4)) = 4;
   % Matched load after port 2
   Index((nx/2-14):(nx/2-9), ny-PML-1, (PML+2):(PML+4)) = 4;
   Index((nx/2+10):(nx/2+15), ny-PML-1, (PML+2):(PML+4)) = 4;

%% 3D FDTD physical (fields) and additional arrays are defined as 'single'
%% to increase performance
   Ex = zeros(nx, ny+1, nz+1, 'single');
   Gx = zeros(nx, ny+1, nz+1, 'single');
   Fx = zeros(nx, ny+1, nz+1, 'single');
   Ey = zeros(nx+1, ny, nz+1, 'single');
   Gy = zeros(nx+1, ny, nz+1, 'single');
   Fy = zeros(nx+1, ny, nz+1, 'single');
   Ez = zeros(nx+1, ny+1, nz, 'single');
   Gz = zeros(nx+1, ny+1, nz, 'single');
   Fz = zeros(nx+1, ny+1, nz, 'single');
   Hx = zeros(nx+1, ny, nz, 'single');
   Bx = zeros(nx+1, ny, nz, 'single');
   Hy = zeros(nx, ny+1, nz, 'single');
   By = zeros(nx, ny+1, nz, 'single');
   Hz = zeros(nx, ny, nz+1, 'single');
   Bz = zeros(nx, ny, nz+1, 'single');

%% FDTD PML coefficients arrays. Here they are already filled with values
%% corresponding to free space
   m = 4; ka_max = 1.0; R_err = 1.0e-16;
   eta = sqrt(mu0/epsilon0*Material(1,1)/Material(1,2));
   k_Ex_c = ones(nx, ny, nz, 'single')*2.0*epsilon0;
   k_Ex_d = ones(nx, ny, nz, 'single')*(-2.0*epsilon0);
   k_Ey_a = ones(nx+1, ny, nz, 'single');
   k_Ey_b = ones(nx+1, ny, nz, 'single')/(2.0*epsilon0);
   k_Gz_a = ones(nx+1, ny, nz, 'single');
   k_Gz_b = ones(nx+1, ny, nz, 'single');
   k_Hy_a = ones(nx, ny, nz, 'single');
   k_Hy_b = ones(nx, ny, nz, 'single')/(2.0*epsilon0);
   k_Hx_c = ones(nx+1, ny, nz, 'single')*2.0*epsilon0/mu0;
   k_Hx_d = ones(nx+1, ny, nz, 'single')*(-2.0*epsilon0/mu0);
   k_Bz_a = ones(nx, ny, nz, 'single');
   k_Bz_b = ones(nx, ny, nz, 'single')*dt;
   k_Gx_a = ones(nx, ny+1, nz, 'single');
   k_Gx_b = ones(nx, ny+1, nz, 'single');
   k_Ey_c = ones(nx, ny, nz, 'single')*2.0*epsilon0;
   k_Ey_d = ones(nx, ny, nz, 'single')*(-2.0*epsilon0);
   k_Ez_a = ones(nx, ny+1, nz, 'single');
   k_Ez_b = ones(nx, ny+1, nz, 'single')/(2.0*epsilon0);
   k_Bx_a = ones(nx, ny, nz, 'single');
   k_Bx_b = ones(nx, ny, nz, 'single')*dt;
   k_Hy_c = ones(nx, ny+1, nz, 'single')*2.0*epsilon0/mu0;
   k_Hy_d = ones(nx, ny+1, nz, 'single')*(-2.0*epsilon0/mu0);
   k_Hz_a = ones(nx, ny, nz, 'single');
   k_Hz_b = ones(nx, ny, nz, 'single')/(2.0*epsilon0);
   k_Ex_a = ones(nx, ny, nz+1, 'single');
   k_Ex_b = ones(nx, ny, nz+1, 'single')/(2.0*epsilon0);
   k_Gy_a = ones(nx, ny, nz+1, 'single');
   k_Gy_b = ones(nx, ny, nz+1, 'single');
   k_Ez_c = ones(nx, ny, nz, 'single')*2.0*epsilon0;
   k_Ez_d = ones(nx, ny, nz, 'single')*(-2.0*epsilon0);
   k_Hx_a = ones(nx, ny, nz, 'single');
   k_Hx_b = ones(nx, ny, nz, 'single')/(2.0*epsilon0);
   k_By_a = ones(nx, ny, nz, 'single');
   k_By_b = ones(nx, ny, nz, 'single')*dt;
   k_Hz_c = ones(nx, ny, nz+1, 'single')*2.0*epsilon0/mu0;
   k_Hz_d = ones(nx, ny, nz+1, 'single')*(-2.0*epsilon0/mu0);

%% General FDTD coefficients
   I = 1:number_of_materials;
   K_a(I) = (2.0*epsilon0*Material(I,1) - Material(I,3)*dt)./...
            (2.0*epsilon0*Material(I,1) + Material(I,3)*dt);
   K_b(I) = 2.0*dt./(2.0*epsilon0*Material(I,1) + Material(I,3)*dt);
   K_c(I) = Material(I,2);
   Ka = single(K_a(Index)); Kb = single(K_b(Index)); Kc = single(K_c(Index));

%% PML coefficients along x-axis
   sigma_max = -(m + 1.0)*log(R_err)/(2.0*eta*PML*dx);
   for I=0:(PML-1)
        sigma_x = sigma_max*((PML - I)/PML)^m;
        ka_x = 1.0 + (ka_max - 1.0)*((PML - I)/PML)^m;
        k_Ey_a(I+1,:,:) = (2.0*epsilon0*ka_x - sigma_x*dt)/...
                          (2.0*epsilon0*ka_x + sigma_x*dt);
        k_Ey_a(nx-I,:,:) = k_Ey_a(I+1,:,:);
        k_Ey_b(I+1,:,:) = 1.0/(2.0*epsilon0*ka_x + sigma_x*dt);
        k_Ey_b(nx-I,:,:) = k_Ey_b(I+1,:,:);
        k_Gz_a(I+1,:,:) = (2.0*epsilon0*ka_x - sigma_x*dt)/...
                          (2.0*epsilon0*ka_x + sigma_x*dt);
        k_Gz_a(nx-I,:,:) = k_Gz_a(I+1,:,:);
        k_Gz_b(I+1,:,:) = 2.0*epsilon0/(2.0*epsilon0*ka_x + sigma_x*dt);
        k_Gz_b(nx-I,:,:) = k_Gz_b(I+1,:,:);
        k_Hx_c(I+1,:,:) = (2.0*epsilon0*ka_x + sigma_x*dt)/mu0;
        k_Hx_c(nx-I,:,:) = k_Hx_c(I+1,:,:);
        k_Hx_d(I+1,:,:) = -(2.0*epsilon0*ka_x - sigma_x*dt)/mu0;
        k_Hx_d(nx-I,:,:) = k_Hx_d(I+1,:,:);

        sigma_x = sigma_max*((PML - I - 0.5)/PML)^m;
        ka_x = 1.0 + (ka_max - 1.0)*((PML - I - 0.5)/PML)^m;
        k_Ex_c(I+1,:,:) = 2.0*epsilon0*ka_x + sigma_x*dt;
        k_Ex_c(nx-I-1,:,:) = k_Ex_c(I+1,:,:);
        k_Ex_d(I+1,:,:) = -(2.0*epsilon0*ka_x - sigma_x*dt);
        k_Ex_d(nx-I-1,:,:) = k_Ex_d(I+1,:,:);
        k_Hy_a(I+1,:,:) = (2.0*epsilon0*ka_x - sigma_x*dt)/...
                          (2.0*epsilon0*ka_x + sigma_x*dt);
        k_Hy_a(nx-I-1,:,:) = k_Hy_a(I+1,:,:);
        k_Hy_b(I+1,:,:) = 1.0/(2.0*epsilon0*ka_x + sigma_x*dt);
        k_Hy_b(nx-I-1,:,:) = k_Hy_b(I+1,:,:);
        k_Bz_a(I+1,:,:) = (2.0*epsilon0*ka_x - sigma_x*dt)/...
                          (2.0*epsilon0*ka_x + sigma_x*dt);
        k_Bz_a(nx-I-1,:,:) = k_Bz_a(I+1,:,:);
        k_Bz_b(I+1,:,:) = 2.0*epsilon0*dt/(2.0*epsilon0*ka_x + sigma_x*dt);
        k_Bz_b(nx-I-1,:,:) = k_Bz_b(I+1,:,:);
   end

%% PML coefficients along y-axis
   sigma_max = -(m + 1.0)*log(R_err)/(2.0*eta*PML*dy);
   for J=0:(PML-1)
        sigma_y = sigma_max*((PML - J)/PML)^m;
        ka_y = 1.0 + (ka_max - 1.0)*((PML - J)/PML)^m;
        k_Gx_a(:,J+1,:) = (2.0*epsilon0*ka_y - sigma_y*dt)/...
                          (2.0*epsilon0*ka_y + sigma_y*dt);
        k_Gx_a(:,ny-J,:) = k_Gx_a(:,J+1,:);
        k_Gx_b(:,J+1,:) = 2.0*epsilon0/(2.0*epsilon0*ka_y + sigma_y*dt);
        k_Gx_b(:,ny-J,:) = k_Gx_b(:,J+1,:);
        k_Ez_a(:,J+1,:) = (2.0*epsilon0*ka_y - sigma_y*dt)/...
                          (2.0*epsilon0*ka_y + sigma_y*dt);
        k_Ez_a(:,ny-J,:) = k_Ez_a(:,J+1,:);
        k_Ez_b(:,J+1,:) = 1.0/(2.0*epsilon0*ka_y + sigma_y*dt);
        k_Ez_b(:,ny-J,:) = k_Ez_b(:,J+1,:);
        k_Hy_c(:,J+1,:) = (2.0*epsilon0*ka_y + sigma_y*dt)/mu0;
        k_Hy_c(:,ny-J,:) = k_Hy_c(:,J+1,:);
        k_Hy_d(:,J+1,:) = -(2.0*epsilon0*ka_y - sigma_y*dt)/mu0;
        k_Hy_d(:,ny-J,:) = k_Hy_d(:,J+1,:);

        sigma_y = sigma_max*((PML - J - 0.5)/PML)^m;
        ka_y = 1.0 + (ka_max - 1.0)*((PML - J - 0.5)/PML)^m;
        k_Ey_c(:,J+1,:) = 2.0*epsilon0*ka_y+sigma_y*dt;
        k_Ey_c(:,ny-J-1,:) = k_Ey_c(:,J+1,:);
        k_Ey_d(:,J+1,:) = -(2.0*epsilon0*ka_y-sigma_y*dt);
        k_Ey_d(:,ny-J-1,:) = k_Ey_d(:,J+1,:);
        k_Bx_a(:,J+1,:) = (2.0*epsilon0*ka_y-sigma_y*dt)/...
                          (2.0*epsilon0*ka_y+sigma_y*dt);
        k_Bx_a(:,ny-J-1,:) = k_Bx_a(:,J+1,:);
        k_Bx_b(:,J+1,:) = 2.0*epsilon0*dt/(2.0*epsilon0*ka_y+sigma_y*dt);
        k_Bx_b(:,ny-J-1,:) = k_Bx_b(:,J+1,:);
        k_Hz_a(:,J+1,:) = (2.0*epsilon0*ka_y-sigma_y*dt)/...
                          (2.0*epsilon0*ka_y+sigma_y*dt);
        k_Hz_a(:,ny-J-1,:) = k_Hz_a(:,J+1,:);
        k_Hz_b(:,J+1,:) = 1.0/(2.0*epsilon0*ka_y+sigma_y*dt);
        k_Hz_b(:,ny-J-1,:) = k_Hz_b(:,J+1,:);
   end

%% PML coefficients along z-axis
   sigma_max = -(m + 1.0)*log(R_err)/(2.0*eta*PML*dz);
   for K=0:(PML-1)
        sigma_z = sigma_max*((PML - K)/PML)^m;
        ka_z = 1.0 + (ka_max - 1.0)*((PML-K)/PML)^m;
        k_Ex_a(:,:,K+1) = (2.0*epsilon0*ka_z - sigma_z*dt)/...
                          (2.0*epsilon0*ka_z + sigma_z*dt);
        k_Ex_a(:,:,nz-K) = k_Ex_a(:,:,K+1);
        k_Ex_b(:,:,K+1) = 1.0/(2.0*epsilon0*ka_z + sigma_z*dt);
        k_Ex_b(:,:,nz-K) = k_Ex_b(:,:,K+1);
        k_Gy_a(:,:,K+1) = (2.0*epsilon0*ka_z - sigma_z*dt)/...
                          (2.0*epsilon0*ka_z + sigma_z*dt);
        k_Gy_a(:,:,nz-K) = k_Gy_a(:,:,K+1);
        k_Gy_b(:,:,K+1) = 2.0*epsilon0/(2.0*epsilon0*ka_z + sigma_z*dt);
        k_Gy_b(:,:,nz-K) = k_Gy_b(:,:,K+1);
        k_Hz_c(:,:,K+1) = (2.0*epsilon0*ka_z + sigma_z*dt)/mu0;
        k_Hz_c(:,:,nz-K) = k_Hz_c(:,:,K+1);
        k_Hz_d(:,:,K+1) = -(2.0*epsilon0*ka_z - sigma_z*dt)/mu0;
        k_Hz_d(:,:,nz-K) = k_Hz_d(:,:,K+1);

        sigma_z = sigma_max*((PML - K - 0.5)/PML)^m;
        ka_z = 1.0 + (ka_max - 1.0)*((PML - K - 0.5)/PML)^m;
        k_Ez_c(:,:,K+1) = 2.0*epsilon0*ka_z + sigma_z*dt;
        k_Ez_c(:,:,nz-K-1) = k_Ez_c(:,:,K+1);
        k_Ez_d(:,:,K+1) = -(2.0*epsilon0*ka_z - sigma_z*dt);
        k_Ez_d(:,:,nz-K-1) = k_Ez_d(:,:,K+1);
        k_Hx_a(:,:,K+1) = (2.0*epsilon0*ka_z - sigma_z*dt)/...
                          (2.0*epsilon0*ka_z + sigma_z*dt);
        k_Hx_a(:,:,nz-K-1) = k_Hx_a(:,:,K+1);
        k_Hx_b(:,:,K+1) = 1.0/(2.0*epsilon0*ka_z + sigma_z*dt);
        k_Hx_b(:,:,nz-K-1) = k_Hx_b(:,:,K+1);
        k_By_a(:,:,K+1) = (2.0*epsilon0*ka_z - sigma_z*dt)/...
                          (2.0*epsilon0*ka_z + sigma_z*dt);
        k_By_a(:,:,nz-K-1) = k_By_a(:,:,K+1);
        k_By_b(:,:,K+1) = 2.0*epsilon0*dt/(2.0*epsilon0*ka_z + sigma_z*dt);
        k_By_b(:,:,nz-K-1) = k_By_b(:,:,K+1);
   end

%% Main 3D FDTD+UPML routine (operates with 'singles' to increase speed)
   hhh = waitbar(0, 'Calculations in progress...');
   tic;
   for T=0:(number_of_iterations-1)
        %% Calculate Fx -> Gx -> Ex
        I = 1:nx; J = 2:ny; K = 2:nz;
        Fx_r = Fx(I,J,K);
        Fx(I,J,K) = Ka(I,J,K).*Fx(I,J,K) + Kb(I,J,K).*...
                    ((Hz(I,J,K) - Hz(I,J-1,K))/dy - (Hy(I,J,K) - Hy(I,J,K-1))/dz);
        Gx_r = Gx(I,J,K);
        Gx(I,J,K) = k_Gx_a(I,J,K).*Gx(I,J,K) + k_Gx_b(I,J,K).*(Fx(I,J,K) - Fx_r);
        Ex(I,J,K) = k_Ex_a(I,J,K).*Ex(I,J,K) + k_Ex_b(I,J,K).*...
                    (k_Ex_c(I,J,K).*Gx(I,J,K) + k_Ex_d(I,J,K).*Gx_r);

        %% Calculate Fy -> Gy -> Ey
        I = 2:nx; J = 1:ny; K = 2:nz;
        Fy_r = Fy(I,J,K);
        Fy(I,J,K) = Ka(I,J,K).*Fy(I,J,K) + Kb(I,J,K).*...
                    ((Hx(I,J,K) - Hx(I,J,K-1))/dz - (Hz(I,J,K) - Hz(I-1,J,K))/dx);
        Gy_r = Gy(I,J,K);
        Gy(I,J,K) = k_Gy_a(I,J,K).*Gy(I,J,K) + k_Gy_b(I,J,K).*(Fy(I,J,K) - Fy_r);
        Ey(I,J,K) = k_Ey_a(I,J,K).*Ey(I,J,K) + k_Ey_b(I,J,K).*...
                    (k_Ey_c(I,J,K).*Gy(I,J,K) + k_Ey_d(I,J,K).*Gy_r);

        %% Calculate Fz -> Gz -> Ez
        I = 2:nx; J = 2:ny; K = 1:nz;
        Fz_r = Fz(I,J,K);
        Fz(I,J,K) = Ka(I,J,K).*Fz(I,J,K) + Kb(I,J,K).*...
                    ((Hy(I,J,K) - Hy(I-1,J,K))/dx - (Hx(I,J,K) - Hx(I,J-1,K))/dy);
        Gz_r = Gz(I,J,K);
        Gz(I,J,K) = k_Gz_a(I,J,K).*Gz(I,J,K) + k_Gz_b(I,J,K).*(Fz(I,J,K) - Fz_r);
        Ez(I,J,K) = k_Ez_a(I,J,K).*Ez(I,J,K) + k_Ez_b(I,J,K).*...
                    (k_Ez_c(I,J,K).*Gz(I,J,K) + k_Ez_d(I,J,K).*Gz_r);

        %% Source of vertical electric field Ez applied to the whole face
        %% plane at the port 1
        if (T*dt<=10.0*t_half)
            Ez((nx/2-14):(nx/2-9), PML+2, (PML+2):(PML+4)) = Source(t_half, 1.0, T*dt);
        end

        %% Save reflected Ez at ports 1 and 2, as well as passed through ports 3 and 4
        Incident(T+1) = Source(t_half, 1.0, T*dt);
        % Remove incident signal from Port 1
        Port_1(T+1) = Ez(nx/2-11, PML+2, PML+3) - Incident(T+1);
        Port_2(T+1) = Ez(nx/2+13, PML+2, PML+3);
        Port_3(T+1) = Ez(nx/2+13, ny-PML-2, PML+3);
        Port_4(T+1) = Ez(nx/2-11, ny-PML-2, PML+3);
        Ez_saved(1:(ny-2*PML-1), 1:(nx-2*PML-1), T+1) = ...
                Ez((PML+1):(nx-PML-1), (PML+1):(ny-PML-1), PML+3)';

        %% Calculate Bx -> Hx
        I = 2:nx; J = 1:ny; K = 1:nz;
        Bx_r = Bx(I,J,K);
        Bx(I,J,K) = k_Bx_a(I,J,K).*Bx(I,J,K) + k_Bx_b(I,J,K).*...
                    ((Ey(I,J,K+1) - Ey(I,J,K))/dz - (Ez(I,J+1,K) - Ez(I,J,K))/dy);
        Hx(I,J,K) = k_Hx_a(I,J,K).*Hx(I,J,K) + k_Hx_b(I,J,K).*...
                    (k_Hx_c(I,J,K).*Bx(I,J,K) + k_Hx_d(I,J,K).*Bx_r)./Kc(I,J,K);

        %% Calculate By -> Hy
        I = 1:nx; J = 2:ny; K = 1:nz;
        By_r = By(I,J,K);
        By(I,J,K) = k_By_a(I,J,K).*By(I,J,K) + k_By_b(I,J,K).*...
                    ((Ez(I+1,J,K) - Ez(I,J,K))/dx - (Ex(I,J,K+1) - Ex(I,J,K))/dz);
        Hy(I,J,K) = k_Hy_a(I,J,K).*Hy(I,J,K) + k_Hy_b(I,J,K).*...
                    (k_Hy_c(I,J,K).*By(I,J,K) + k_Hy_d(I,J,K).*By_r)./Kc(I,J,K);

        %% Calculate Bz -> Hz
        I = 1:nx; J = 1:ny; K = 2:nz;
        Bz_r = Bz(I,J,K);
        Bz(I,J,K) = k_Bz_a(I,J,K).*Bz(I,J,K) + k_Bz_b(I,J,K).*...
                    ((Ex(I,J+1,K) - Ex(I,J,K))/dy - (Ey(I+1,J,K) - Ey(I,J,K))/dx);
        Hz(I,J,K) = k_Hz_a(I,J,K).*Hz(I,J,K) + k_Hz_b(I,J,K).*...
                    (k_Hz_c(I,J,K).*Bz(I,J,K) + k_Hz_d(I,J,K).*Bz_r)./Kc(I,J,K);

        %% Progress bar updates at every time percent
        if ( mod(T, ceil(number_of_iterations/100)) == 0 )
            waitbar((T+1)/number_of_iterations, hhh);
        end

    end
    toc
    close(hhh);

%% Plots: signals, scattering parameters and Ez field between plates
   figure('units','normalized','outerposition',[0 0 1 1]);
   set(gcf, 'doublebuffer', 'on');
   % Input signal, reflected (at port 1) and passed through (port 2)
     subplot(2,2,1);
     plot(1e9*dt*(0:T), Incident, 'm-', ...
          1e9*dt*(0:T), Port_1, 'k-', ...
          1e9*dt*(0:T), Port_2, 'r-', ...
          1e9*dt*(0:T), Port_3, 'b-', ...
          1e9*dt*(0:T), Port_4, 'g-', 'LineWidth', 2);
     title('Input and Port 1-4 signals', 'FontSize', 18);
     xlabel('Time, [ns]', 'FontSize', 16);
     ylabel('Strength, [V/cm]', 'FontSize', 16);
     legend('Input' ,'Port 1', 'Port 2', 'Port 3', 'Port 4');
     grid on;
   % |S_{1,2,3,4}|
     NFFT = 2^nextpow2(T);
     S_11 = fft(Port_1, NFFT)./fft(Incident, NFFT);
     S_21 = fft(Port_2, NFFT)./fft(Incident, NFFT);
     S_31 = fft(Port_3, NFFT)./fft(Incident, NFFT);
     S_41 = fft(Port_4, NFFT)./fft(Incident, NFFT);
     subplot(2,2,3);
     f = (0.5/dt)*linspace(0, 1, NFFT/2);
     plot(f*1e-9, 20*log10(abs(S_11(1:NFFT/2))), 'k', ...
          f*1e-9, 20*log10(abs(S_21(1:NFFT/2))), 'r', ...
          f*1e-9, 20*log10(abs(S_31(1:NFFT/2))), 'b', ...
          f*1e-9, 20*log10(abs(S_41(1:NFFT/2))), 'g', 'LineWidth', 2);
     title('Scattering parameters - |S_{1,2,3,4}|', 'FontSize', 18);
     xlabel('Frequency, [GHz]', 'FontSize', 16);
     ylabel('Magnitude, [dB]', 'FontSize', 16);
     legend('Port 1', 'Port 2', 'Port 3', 'Port 4', 'Location', 'SouthEast');
     xlim([0 10]);
     grid on;
   % Electric field strength Ez between electrodes
     for T=1:20:number_of_iterations
         subplot(2,2,[2 4]);
         contour(1e3*dx*(1:(nx-2*PML-1)), 1e3*dy*(1:(ny-2*PML-1)), ...
         Index((PML+1):(nx-PML-1), (PML+1):(ny-PML-1), PML+5)', 1);
         hold on;
         subplot(2,2,[2 4]);
         pcolor(1e3*dx*(1:(nx-2*PML-1)), 1e3*dy*(1:(ny-2*PML-1)), double(Ez_saved(:, :, T)));
         title(['Time t = ', num2str(round(T*dt*1e12)),' ps'], 'FontSize', 18);
         xlabel('[mm]', 'FontSize', 16);
         ylabel('[mm]', 'FontSize', 16);
         shading interp;
         axis image;
         caxis([-1 1]);
         colorbar;
         drawnow;
     end

%% Gauss function for voltage source
function [res] = Source(t_half, amplitude, t)
% Pulse delay
t0 = 3.0*t_half;
res = amplitude*exp(-0.5*((t-t0)/(t_half/2.35482))^2.0);


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Spherical Harmonic Modeling and Analysis Toolkit (SPHARM-MAT) is a 3D
% shape modeling and analysis toolkit.
% It is a software package developed at Shenlab in Center for Neuroimaging,
% Indiana University (SpharmMat@gmail.com, http://www.iupui.edu/~shenlab/)
% It is available to the scientific community as copyright freeware
% under the terms of the GNU General Public Licence.
%
% Copyright 2009, 2010, ShenLab, Center for Neuroimaging, Indiana University
%
% This file is part of SPHARM-MAT.
%
% SPHARM-MAT 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.
%
% SPHARM-MAT 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 SPHARM-MAT. If not, see <http://www.gnu.org/licenses/>.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function [vertices, sph_verts, faces, fvec, new_name]=align_FOE(filename, confs)

load(filename);
[path,name,ext] = fileparts(filename);

if ~exist('faces', 'var') | ~exist('vertices', 'var') | ~exist('sph_verts', 'var') | ~exist('fvec', 'var')
    disp('One or more of faces, vertices, spherical vertices, or SPHARM descriptor are missing');
    return;
end

switch deblank(char(confs.CPoint))
    case 'x'
        blue = 1;
    case 'y'
        blue = 2;
    case 'z'
        blue = 3;
end

switch deblank(char(confs.NPole))
    case 'x'
        yellow = 1;
    case 'y'
        yellow = 2;
    case 'z'
        yellow = 3;
end

blueyellow = [blue yellow];
degree = confs.MaxSPHARMDegree;

% rotate the parameter space
disp('<< Rotate the parameter space >>');
[fvec, sph_verts, expts] = param_rotate(fvec, vertices, sph_verts, faces, degree, blueyellow);

dirName = [confs.OutDirectory '/alignParam'];
if ~exist(dirName,'dir')
    mkdir(dirName);
end

new_name = sprintf('%s/%sFOE_prm.mat',dirName,name(1:end-3));
if exist(new_name,'file')
    prompt = {'Enter new filename:'};
    dlg_title = 'New File Name';
    num_lines = 1;
    def = {new_name};
    answer = inputdlg(prompt,dlg_title,num_lines,def);
    new_name = answer{1};
end
save(new_name, 'vertices', 'sph_verts', 'faces', 'fvec','expts');

% rotate in the object space
svs = [0 0 1; 1 0 0; 0 0 -1]; % north pole, intersection of dateline and equator, south pole
Z = calculate_SPHARM_basis(svs, 1);

disp('<< Rotate the object space >>');
vs = real(Z(:,2:4)*fvec(2:4,:));
R = object_rotate_R(vs);
% R = object_rotate_R([ellipAxes(:,1)';ellipAxes(:,3)']);
fvec = fvec*R';
vertices = vertices*R';

new_name = sprintf('%s/%sFOE_reg.mat',confs.OutDirectory,name(1:end-3));
if exist(new_name,'file')
    prompt = {'Enter new filename:'};
    dlg_title = 'New File Name';
    num_lines = 1;
    def = {new_name};
    answer = inputdlg(prompt,dlg_title,num_lines,def);
    new_name = answer{1};
end
save(new_name, 'vertices', 'sph_verts', 'faces', 'fvec','expts');

return;

%
% Factoring a Rotation Matrix as Rz*Ry*Rx (counterclockwise when looking towards the origin)
%

function [thetaX, thetaY, thetaZ] = factor_rot_xyz(R)

thetaY = asin(R(1,3));
if (thetaY < pi/2)
    if (thetaY > -pi/2)
        thetaX = atan2(-R(2,3),R(3,3));
        thetaZ = atan2(-R(1,2),R(1,1));
    else
        disp('WARNING (Factor Rotation): thetaY = -pi/2, not a unique solution, set thetaZ = 0');
        thetaX = -atan2(R(2,1),R(2,2));
        thetaZ = 0;
    end
else
    disp('WARNING (Factor Rotation): thetaY = pi/2, not a unique solution, set thetaZ = 0');
    thetaX = atan2(R(2,1),R(2,2));
    thetaZ = 0;
end

% disp(sprintf('Factor rotation xyz: %0.2f %0.2f %0.2f',thetaX/pi,thetaY/pi,thetaZ/pi));

return;

%
% rotation matrix in object space
%

function R = object_rotate_R(vs)

% fix north pole
[PHI,THETA] = cart2sph(vs(1,1),vs(1,2),vs(1,3));
ind = find(PHI<0); PHI(ind) = PHI(ind)+2*pi;
THETA = pi/2-THETA;
alpha = -PHI; beta = -THETA;
R = rotate_mat(0, beta, 0)*rotate_mat(0, 0, alpha);
vs = vs*R';
% fix intersection;
[PHI,THETA] = cart2sph(vs(2,1),vs(2,2),vs(2,3));
gamma = -PHI;
R1 = rotate_mat(0, 0, gamma); R = R1*R;
vs = vs*R1';

return;

%
% Parameter space rotation using degree 1 ellipsoid
%

function [fvec, sph_verts, expts] = param_rotate(fvec, vertices, sph_verts, faces, degree, blueyellow)

% calculate matrix A
coeffs = fvec(2:4,:);
A(:,1) = (coeffs(1,:)-coeffs(3,:))';
A(:,2) = -(coeffs(1,:)+coeffs(3,:))'*i; % there is a typo in the paper, should be - here.
A(:,3) = sqrt(2)*coeffs(2,:)';
A = real(A*sqrt(3)/(2*sqrt(2*pi)));

% SVD to find rotation and scaling matrics
%   [U,S,V] = svd(X) produces a diagonal matrix S of the same dimension as X, with
%   nonnegative diagonal elements in decreasing order, and unitary matrices U and V so
%   that X = U*S*V'.
% need to rotate object space first.
[U,S,V] = svd(A);
% extremum and saddle points
expts = U*S;

% set up rotation matrix
R = V(:,[3 2 1])';
if (det(R)<0)
    disp('WARNING (Parameter Space): rotoinversion!! Change back to pure rotation');
    R(2,:) = R(2,:)*(-1);
end

[thetaX, thetaY, thetaZ] = factor_rot_xyz(R');

% Question: why multiply thetaY by -1?
R = rotate_mat(thetaX, -thetaY, thetaZ);
disp(sprintf('Rotation xyz: %0.2f %0.2f %0.2f',thetaX/pi,thetaY/pi,thetaZ/pi));

% the parameter space rotation
sph_verts = (R*sph_verts')';
% create new spharm descriptor (degree 1 is enough)
[fvec, d, Z_tmp1, name_temp] = create_SPHARM_des_LSF(vertices, [], sph_verts, 1, '', '');

% calculate the blue point
svs = [0 0 1; 1 0 0]; % yellow (north pole), blue (intersection)
Z = calculate_SPHARM_basis(svs, 1);

vs = real(Z(:,2:4)*fvec(2:4,:));
disp(sprintf('blue: (%f, %f, %f)',vs));
% blue point and yellow point should be on the positive side of
% x (blue=1), y (blue=2), or z (blue=3) axis in the object space
% i.e., vs(blue) and vs(yellow) should be >0
blue = blueyellow(1); yellow = blueyellow(2);
if vs(2,blue)<0 | vs(1,yellow)<0
    if vs(2,blue)<0
        Rfix = rotate_mat(0, 0, pi);
    else
        Rfix = eye(3);
    end
    if vs(1,yellow)<0
        Rfix =  rotate_mat(pi, 0, 0)*Rfix;
    end
	% the parameter space rotation
	sph_verts = (Rfix*sph_verts')';
	% create new spharm descriptor (degree 1 is enough)
    [fvec, d, Z_tmp1, name_temp] = create_SPHARM_des_LSF(vertices, [], sph_verts, 1, '', '');
end

[fvec, d, Z_tmp1, name_temp] = create_SPHARM_des_LSF(vertices, [], sph_verts, degree, '', '');

return;


% //This software is licensed under the BSD 3 Clause license: http://opensource.org/licenses/BSD-3-Clause
%
%
% //Copyright (c) 2013, University of Oxford
% //All rights reserved.
%
% //Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
%
% //Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
% //Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
% //Neither the name of the University of Oxford nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
% //THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
%
%   The method implemented in this file has been patented by their original
%   authors. Commercial use of this code is thus strongly not
%   recocomended.
%
% //Authors: 	Gari D Clifford -
% //            Roberta Colloca -
% //			Julien Oster	-

function [ MAD ] = comput_MAD(data)

%comput_MAD computes the MAD value for the vector  'data'

%Input
%data RR interval series (column vector)

%Output
%MAD median of median value for heart rate deviation

len=length(data);
J=3; %number of segments
N=len/J;  % number of RR intervals per segment

%heart rates segments: J-1=seg(;,1) J=seg(;,2) J+1=seg(;,3)
data=reshape(data,N,J);
seg=1./data ;

%remove mean from each segment: J-1, J, J+1
seg_m=detrend(seg,'constant');

%remove linear trend
seg_m_lt=detrend(seg_m,'linear');

%determine absolute deviation from mean, absdev_i for i=1..N
%within segments J-1, J, J+1
abs_dev=abs(detrend(seg_m_lt,'constant'));

%determine the Median of absolute deviation from mean for each RR interval, mABSdev_j within segments J-1, J, J+1
 mABSDEV= median(abs_dev);

 %determine median absolute deviation of segment J, compared to adjacent
 %segments , J-1 and J+1
  MAD= median(mABSDEV);
end


function [label, center, bCon, sumD, D] = litekmeans(X, k, varargin)
%LITEKMEANS K-means clustering, accelerated by matlab matrix operations.
%
%   label = LITEKMEANS(X, K) partitions the points in the N-by-P data matrix
%   X into K clusters.  This partition minimizes the sum, over all
%   clusters, of the within-cluster sums of point-to-cluster-centroid
%   distances.  Rows of X correspond to points, columns correspond to
%   variables.  KMEANS returns an N-by-1 vector label containing the
%   cluster indices of each point.
%
%   [label, center] = LITEKMEANS(X, K) returns the K cluster centroid
%   locations in the K-by-P matrix center.
%
%   [label, center, bCon] = LITEKMEANS(X, K) returns the bool value bCon to
%   indicate whether the iteration is converged.
%
%   [label, center, bCon, SUMD] = LITEKMEANS(X, K) returns the
%   within-cluster sums of point-to-centroid distances in the 1-by-K vector
%   sumD.
%
%   [label, center, bCon, SUMD, D] = LITEKMEANS(X, K) returns
%   distances from each point to every centroid in the N-by-K matrix D.
%
%   [ ... ] = LITEKMEANS(..., 'PARAM1',val1, 'PARAM2',val2, ...) specifies
%   optional parameter name/value pairs to control the iterative algorithm
%   used by KMEANS.  Parameters are:
%
%   'Distance' - Distance measure, in P-dimensional space, that KMEANS
%      should minimize with respect to.  Choices are:
%            {'sqEuclidean'} - Squared Euclidean distance (the default)
%             'cosine'       - One minus the cosine of the included angle
%                              between points (treated as vectors). Each
%                              row of X SHOULD be normalized to unit. If
%                              the intial center matrix is provided, it
%                              SHOULD also be normalized.
%
%   'Start' - Method used to choose initial cluster centroid positions,
%      sometimes known as "seeds".  Choices are:
%         {'sample'}  - Select K observations from X at random (the default)
%           matrix   - A K-by-P matrix of starting locations; or a K-by-1
%                      indicate vector indicating which K points in X
%                      should be used as the initial center.  In this case,
%                      you can pass in [] for K, and KMEANS infers K from
%                      the first dimension of the matrix.
%
%   'MaxIter'  - Maximum number of iterations allowed.  Default is 100.
%
%   'Replicates' - Number of times to repeat the clustering, each with a
%                  new set of initial centroids. Default is 1. If the
%                  initial centroids are provided, the replicate will be
%                  automatically set to be 1.
%
%
%
%    Examples:
%
%       fea = rand(500,10);
%       [label, center] = litekmeans(fea, 5, 'MaxIter', 50);
%
%       fea = rand(500,10);
%       [label, center] = litekmeans(fea, 5, 'MaxIter', 50, 'Replicates', 10);
%
%       fea = rand(500,10);
%       [label, center, bCon, sumD, D] = litekmeans(fea, 5, 'MaxIter', 50);
%       TSD = sum(sumD);
%
%       fea = rand(500,10);
%       initcenter = rand(5,10);
%       [label, center] = litekmeans(fea, 5, 'MaxIter', 50, 'Start', initcenter);
%
%       fea = rand(500,10);
%       idx=randperm(500);
%       [label, center] = litekmeans(fea, 5, 'MaxIter', 50, 'Start', idx(1:5));
%
%
%   See also KMEANS
%
%   version 2.0 --December/2011
%   version 1.0 --November/2011
%
%   Written by Deng Cai (dengcai AT gmail.com)

if nargin < 2
    error('litekmeans:TooFewInputs','At least two input arguments required.');
end

[n, p] = size(X);

pnames = {   'distance' 'start'   'maxiter'  'replicates' 'onlinephase'};
dflts =  {'sqeuclidean' 'sample'       []        []      'off'  };
[eid,errmsg,distance,start,maxit,reps,online] = getargs(pnames, dflts, varargin{:});
if ~isempty(eid)
    error(sprintf('litekmeans:%s',eid),errmsg);
end

if ischar(distance)
    distNames = {'sqeuclidean','cosine'};
    j = strcmpi(distance, distNames);
    j = find(j);
    if length(j) > 1
        error('litekmeans:AmbiguousDistance', ...
            'Ambiguous ''Distance'' parameter value:  %s.', distance);
    elseif isempty(j)
        error('litekmeans:UnknownDistance', ...
            'Unknown ''Distance'' parameter value:  %s.', distance);
    end
    distance = distNames{j};
else
    error('litekmeans:InvalidDistance', ...
        'The ''Distance'' parameter value must be a string.');
end

center = [];
if ischar(start)
    startNames = {'sample','cluster'};
    j = find(strncmpi(start,startNames,length(start)));
    if length(j) > 1
        error(message('litekmeans:AmbiguousStart', start));
    elseif isempty(j)
        error(message('litekmeans:UnknownStart', start));
    elseif isempty(k)
        error('litekmeans:MissingK', ...
            'You must specify the number of clusters, K.');
    end
    if j == 2
        if floor(.1*n) < 5*k
            j = 1;
        end
    end
    start = startNames{j};
elseif isnumeric(start)
    if size(start,2) == p
        center = start;
    elseif (size(start,2) == 1 || size(start,1) == 1)
        center = X(start,:);
    else
        error('litekmeans:MisshapedStart', ...
            'The ''Start'' matrix must have the same number of columns as X.');
    end
    if isempty(k)
        k = size(center,1);
    elseif (k ~= size(center,1))
        error('litekmeans:MisshapedStart', ...
            'The ''Start'' matrix must have K rows.');
    end
    start = 'numeric';
else
    error('litekmeans:InvalidStart', ...
        'The ''Start'' parameter value must be a string or a numeric matrix or array.');
end

% The maximum iteration number is default 100
if isempty(maxit)
    maxit = 100;
end

% Assume one replicate
if isempty(reps) || ~isempty(center)
    reps = 1;
end

if ~(isscalar(k) && isnumeric(k) && isreal(k) && k > 0 && (round(k)==k))
    error('litekmeans:InvalidK', ...
        'X must be a positive integer value.');
elseif n < k
    error('litekmeans:TooManyClusters', ...
        'X must have more rows than the number of clusters.');
end

bestlabel = [];
sumD = zeros(1,k);
bCon = false;

for t=1:reps
    switch start
        case 'sample'
            center = X(randsample(n,k),:);
        case 'cluster'
            Xsubset = X(randsample(n,floor(.1*n)),:);
            [dump, center] = litekmeans(Xsubset, k, varargin{:}, 'start','sample', 'replicates',1);
        case 'numeric'
    end

    last = 0;label=1;
    it=0;

    switch distance
        case 'sqeuclidean'
            while any(label ~= last) && it<maxit
                last = label;

                bb = full(sum(center.*center,2)');
                ab = full(X*center');
                D = bb(ones(1,n),:) - 2*ab;

                [val,label] = min(D,[],2); % assign samples to the nearest centers
                ll = unique(label);
                if length(ll) < k
                    %disp([num2str(k-length(ll)),' clusters dropped at iter ',num2str(it)]);
                    missCluster = 1:k;
                    missCluster(ll) = [];
                    missNum = length(missCluster);

                    aa = sum(X.*X,2);
                    val = aa + val;
                    [dump,idx] = sort(val,1,'descend');
                    label(idx(1:missNum)) = missCluster;
                end
                E = sparse(1:n,label,1,n,k,n);  % transform label into indicator matrix
                center = full((E*spdiags(1./sum(E,1)',0,k,k))'*X);    % compute center of each cluster
                it=it+1;
            end
            if it<maxit
                bCon = true;
            end
            if isempty(bestlabel)
                bestlabel = label;
                bestcenter = center;
                if reps>1
                    if it>=maxit
                        aa = full(sum(X.*X,2));
                        bb = full(sum(center.*center,2));
                        ab = full(X*center');
                        D = bsxfun(@plus,aa,bb') - 2*ab;
                        D(D<0) = 0;
                    else
                        aa = full(sum(X.*X,2));
                        D = aa(:,ones(1,k)) + D;
                        D(D<0) = 0;
                    end
                    D = sqrt(D);
                    for j = 1:k
                        sumD(j) = sum(D(label==j,j));
                    end
                    bestsumD = sumD;
                    bestD = D;
                end
            else
                if it>=maxit
                    aa = full(sum(X.*X,2));
                    bb = full(sum(center.*center,2));
                    ab = full(X*center');
                    D = bsxfun(@plus,aa,bb') - 2*ab;
                    D(D<0) = 0;
                else
                    aa = full(sum(X.*X,2));
                    D = aa(:,ones(1,k)) + D;
                    D(D<0) = 0;
                end
                D = sqrt(D);
                for j = 1:k
                    sumD(j) = sum(D(label==j,j));
                end
                if sum(sumD) < sum(bestsumD)
                    bestlabel = label;
                    bestcenter = center;
                    bestsumD = sumD;
                    bestD = D;
                end
            end
        case 'cosine'
            while any(label ~= last) && it<maxit
                last = label;
                W=full(X*center');
                [val,label] = max(W,[],2); % assign samples to the nearest centers
                ll = unique(label);
                if length(ll) < k
                    missCluster = 1:k;
                    missCluster(ll) = [];
                    missNum = length(missCluster);
                    [dump,idx] = sort(val);
                    label(idx(1:missNum)) = missCluster;
                end
                E = sparse(1:n,label,1,n,k,n);  % transform label into indicator matrix
                center = full((E*spdiags(1./sum(E,1)',0,k,k))'*X);    % compute center of each cluster
                centernorm = sqrt(sum(center.^2, 2));
                center = center ./ centernorm(:,ones(1,p));
                it=it+1;
            end
            if it<maxit
                bCon = true;
            end
            if isempty(bestlabel)
                bestlabel = label;
                bestcenter = center;
                if reps>1
                    if any(label ~= last)
                        W=full(X*center');
                    end
                    D = 1-W;
                    for j = 1:k
                        sumD(j) = sum(D(label==j,j));
                    end
                    bestsumD = sumD;
                    bestD = D;
                end
            else
                if any(label ~= last)
                    W=full(X*center');
                end
                D = 1-W;
                for j = 1:k
                    sumD(j) = sum(D(label==j,j));
                end
                if sum(sumD) < sum(bestsumD)
                    bestlabel = label;
                    bestcenter = center;
                    bestsumD = sumD;
                    bestD = D;
                end
            end
    end
end

label = bestlabel;
center = bestcenter;
if reps>1
    sumD = bestsumD;
    D = bestD;
elseif nargout > 3
    switch distance
        case 'sqeuclidean'
            if it>=maxit
                aa = full(sum(X.*X,2));
                bb = full(sum(center.*center,2));
                ab = full(X*center');
                D = bsxfun(@plus,aa,bb') - 2*ab;
                D(D<0) = 0;
            else
                aa = full(sum(X.*X,2));
                D = aa(:,ones(1,k)) + D;
                D(D<0) = 0;
            end
            D = sqrt(D);
        case 'cosine'
            if it>=maxit
                W=full(X*center');
            end
            D = 1-W;
    end
    for j = 1:k
        sumD(j) = sum(D(label==j,j));
    end
end

function [eid,emsg,varargout]=getargs(pnames,dflts,varargin)
%GETARGS Process parameter name/value pairs
%   [EID,EMSG,A,B,...]=GETARGS(PNAMES,DFLTS,'NAME1',VAL1,'NAME2',VAL2,...)
%   accepts a cell array PNAMES of valid parameter names, a cell array
%   DFLTS of default values for the parameters named in PNAMES, and
%   additional parameter name/value pairs.  Returns parameter values A,B,...
%   in the same order as the names in PNAMES.  Outputs corresponding to
%   entries in PNAMES that are not specified in the name/value pairs are
%   set to the corresponding value from DFLTS.  If nargout is equal to
%   length(PNAMES)+1, then unrecognized name/value pairs are an error.  If
%   nargout is equal to length(PNAMES)+2, then all unrecognized name/value
%   pairs are returned in a single cell array following any other outputs.
%
%   EID and EMSG are empty if the arguments are valid.  If an error occurs,
%   EMSG is the text of an error message and EID is the final component
%   of an error message id.  GETARGS does not actually throw any errors,
%   but rather returns EID and EMSG so that the caller may throw the error.
%   Outputs will be partially processed after an error occurs.
%
%   This utility can be used for processing name/value pair arguments.
%
%   Example:
%       pnames = {'color' 'linestyle', 'linewidth'}
%       dflts  = {    'r'         '_'          '1'}
%       varargin = {{'linew' 2 'nonesuch' [1 2 3] 'linestyle' ':'}
%       [eid,emsg,c,ls,lw] = statgetargs(pnames,dflts,varargin{:})    % error
%       [eid,emsg,c,ls,lw,ur] = statgetargs(pnames,dflts,varargin{:}) % ok

% We always create (nparams+2) outputs:
%    one each for emsg and eid
%    nparams varargs for values corresponding to names in pnames
% If they ask for one more (nargout == nparams+3), it's for unrecognized
% names/values

%   Original Copyright 1993-2008 The MathWorks, Inc.
%   Modified by Deng Cai (dengcai@gmail.com) 2011.11.27

% Initialize some variables
emsg = '';
eid = '';
nparams = length(pnames);
varargout = dflts;
unrecog = {};
nargs = length(varargin);

% Must have name/value pairs
if mod(nargs,2)~=0
    eid = 'WrongNumberArgs';
    emsg = 'Wrong number of arguments.';
else
    % Process name/value pairs
    for j=1:2:nargs
        pname = varargin{j};
        if ~ischar(pname)
            eid = 'BadParamName';
            emsg = 'Parameter name must be text.';
            break;
        end
        i = strcmpi(pname,pnames);
        i = find(i);
        if isempty(i)
            % if they've asked to get back unrecognized names/values, add this
            % one to the list
            if nargout > nparams+2
                unrecog((end+1):(end+2)) = {varargin{j} varargin{j+1}};
                % otherwise, it's an error
            else
                eid = 'BadParamName';
                emsg = sprintf('Invalid parameter name:  %s.',pname);
                break;
            end
        elseif length(i)>1
            eid = 'BadParamName';
            emsg = sprintf('Ambiguous parameter name:  %s.',pname);
            break;
        else
            varargout{i} = varargin{j+1};
        end
    end
end

varargout{nparams+1} = unrecog;


function [vtoe,nne]=VertToEle(t)
np = max(t(:)); ne = size(t,1);
nne = zeros(np,1);
for ie = +1 : ne                                                            %--Go through once and find max nnz.
    %for iv = +1 : +3
    %kjr loop unrolled.
    nm1=t(ie,1);
    nm2=t(ie,2);
    nm3=t(ie,3);
    %vrtx = t(ie,iv);
    nne(nm1,1) = nne(nm1,1) + 1;
    nne(nm2,1) = nne(nm2,1) + 1;
    nne(nm3,1) = nne(nm3,1) + 1;
    %end
end
mnz  = max(nne);                                                           %--max number of non-zeros
vtoe = zeros(mnz,np);                                                      %--vertex to element connectivity
nne = zeros(np,1);                                                         %--number of neighboring elements
for ie = +1 : ne
    nm1=t(ie,1);
    nm2=t(ie,2);
    nm3=t(ie,3);

    %kjr loop unrolled.
    nne(nm1,1) = nne(nm1,1) +1;
    nne(nm2,1) = nne(nm2,1) +1;
    nne(nm3,1) = nne(nm3,1) +1;

    vtoe(nne(nm1,1),nm1) = ie;
    vtoe(nne(nm2,1),nm2) = ie;
    vtoe(nne(nm3,1),nm3) = ie;

    %vtoe(nm1,nne(nm1,1)) = ie;
    %vtoe(nm2,nne(nm2,1)) = ie;
    %vtoe(nm3,nne(nm3,1)) = ie;
end
nne  = nne';
%vtoe = vtoe';

end


% SCRIPT TO TEST THE KINEMATICS OF THE 5R robot
%
% Copyright (C) 2012, by Arturo Gil Aparicio
%
% This file is part of ARTE (A Robotics Toolbox for Education).
%
% ARTE is free software: you can redistribute it and/or modify
% it under the terms of the GNU Lesser General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% ARTE is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU Lesser General Public License for more details.
%
% You should have received a copy of the GNU Leser General Public License
% along with ARTE.  If not, see <http://www.gnu.org/licenses/>.

close all

%load the robot
%the robot is represented (interiorly) by two planar 2dof arms
robot=load_robot('example','Delta');

adjust_view(robot)

%Represent a final point in space that will be achieved by the end effector
%P=[Px, Py, Pz]=[0.6 0.4 -0.2]

T=eye(4);
T(1,4)=-0.2;%change, for example, to 0.3
T(2,4)=0.3; %change, for example to 0.6
T(3,4)=-0.5;

%find 8 solutions for the INVERSE KINEMATIC in position
q=inversekinematic(robot, T);

drawrobot3d(robot, q(:,8)), pause(2);
drawrobot3d(robot, q(:,7)), pause(2);
drawrobot3d(robot, q(:,6)), pause(2);
drawrobot3d(robot, q(:,5)), pause(2);
drawrobot3d(robot, q(:,4)), pause(2);
drawrobot3d(robot, q(:,3)), pause(2);
drawrobot3d(robot, q(:,2)), pause(2);
drawrobot3d(robot, q(:,1)), pause(2);

% now solve the DIRECTKINEMATIC problem for each of the above computed q
% In this case, only the "down" solution is returned
T=directkinematic(robot,q(:,1))
T=directkinematic(robot,q(:,2))
T=directkinematic(robot,q(:,3))
T=directkinematic(robot,q(:,4))
T=directkinematic(robot,q(:,5))
T=directkinematic(robot,q(:,6))
T=directkinematic(robot,q(:,7))
T=directkinematic(robot,q(:,8))


function [satpos,satclk,vare,varc,stat]=pephpos(time,sat,nav)

global glc
stat=1; norder=10; %polynomial fitting order
tdiff=zeros(norder+1,1); p=zeros(3,norder+1);
satpos=zeros(3,1); s=zeros(3,1); satclk=0;
varc=0;vare=0;

if nav.np<norder||timediff(time,nav.peph(1).time)<-900||...
        timediff(time,nav.peph(end).time)>900
    stat=0; return;
end

%binary search
i=0;
j=nav.np-1;
while i<j
    k=fix((i+j)/2);
    if timediff(nav.peph(k+1).time,time)<0
        i=k+1;
    else
        j=k;
    end
end

if i<=0,index=0;  else,index=i-1;  end
index=index+1;

idx=index-norder/2; %start of fitting interval
if idx<1,idx=1;  elseif idx+norder>nav.np,idx=nav.np-norder;  end

nt=1;
for j=0:norder
    tdiff(nt)=timediff(nav.peph(idx+j).time,time); %time difference
    nt=nt+1;
    if dot(nav.peph(idx+j).pos(sat,1:3),nav.peph(idx+j).pos(sat,1:3))<=0
        stat=0; return;
    end
end

for j=0:norder
    pos=nav.peph(idx+j).pos(sat,:);

    %correciton for earh rotation
    sinl=sin(glc.OMGE*tdiff(j+1));
    cosl=cos(glc.OMGE*tdiff(j+1));

    p(1,j+1)=cosl*pos(1)-sinl*pos(2);
    p(2,j+1)=sinl*pos(1)+cosl*pos(2);
    p(3,j+1)=pos(3);

end

%polynomial interpolation using Neville's algorithm
for i=1:3
    satpos(i,1)=polyinter(tdiff,p(i,:));
end

%calculate satellite position variance
for i=1:3
    s(i)=nav.peph(index).std(sat,i);
end
std=sqrt(dot(s,s)); %error caused by ephemeris
if tdiff(1)>0
    std=std+(5E-7*tdiff(1)^2)/2; %error caused by fitting
elseif tdiff(end)<0
    std=std+(5E-7*tdiff(end)^2)/2;
end
vare=std^2;

%linear interpolation for clock
t0=timediff(time,nav.peph(index).time);
t1=timediff(time,nav.peph(index+1).time);
c0=nav.peph(index).pos(sat,4);
c1=nav.peph(index+1).pos(sat,4);

if t0<=0
    satclk=c0;
    if satclk~=0
        varc=(nav.peph(index).std(sat,4)*glc.CLIGHT-1E-3*t0)^2;
    end
elseif t1>=0
    satclk=c1;
    if satclk~=0
        varc=(nav.peph(index+1).std(sat,4)*glc.CLIGHT+1E-3*t1)^2;
    end
elseif c0~=0 && c1~=0
    satclk=(c1*t0-c0*t1)/(t0-t1);
    if abs(t0)-abs(t1)>0
        varc=(nav.peph(index+1).std(sat,4)*glc.CLIGHT+1E-3*abs(t1))^2;
    else
        varc=(nav.peph(index).std(sat,4)*glc.CLIGHT+1E-3*abs(t0))^2;
    end
else
    satclk=0;
    varc=0;
end

return