 function fit = de_ftab_fit(sl, fm, varargin)
%function fit = de_ftab_fit(sl, fm, [options])
%|
%| Fit to DE table fm(), suitable for subsequent interpolation / extrapolation.
%| Uses either classic polynomial basis functions,
%| or an exponential model: -log(sum_k p_k exp(-m_k . s))
%|
%| in
%|	sl	{L}		sample locations for each of L materials
%|	fm	[s1 ... sL M]	DE tables f_m(s_1,...,s_L), size [(Ns) M]
%|
%| option
%|	'type'	'poly' | 'exp'	type of fit (default 'poly') todo: change?
%|	'wt'	{M}		fit weighting for each of M energies.
%|				(default depends on 'type'; see code)
%|	'show'	1|0		plot? (default false)
%|	'ntype' ''		options for negative sl values (default '')
%|				'abs' - experimental symmetrizing option
%| options for 'poly'
%|	'order'			polynomial order (default 3)
%|	'maxdegree'		argument for poly_string() (default [])
%| options for 'exp'
%|	'kev'	[Ne 1]		kev *for fitting* (default [10:5:200]')
%|	'mac'	[Ne L]		*for fitting* (this or mtype are required)
%|	'mtype' {L}		material types
%|	'macbar' [M L]		if nonempty, use it to match derivative at s=0.
%|	'wls_simplex_arg' {}	arguments for wls_simplex (default {})
%|
%| out
%|	fit	strum		strum object for fitted f_m(s_1,...,s_L)
%|				fit.coef is [nbasis M] for 'poly'
%|	methods:
%|				(sll denotes stacked array [(Ns) L] or [*Ns L])
%|	.fmfun(sll [() L])	fm function evaluation [() L] -> [() M]
%|	.fgrad(sll)		fm gradient evaluation [() L] -> [() L M]
%|	.fhess(sll)		fm hessian evaluation [() L] -> [() L L M]
%|	.show_sp([en, sp])	plot true spectrum vs fitted spectrum
%|	.show_fm(sl, [fm])	mesh plot of fm and its fit
%|	.show_err(sl, fm)	mesh plot of fit error
%|	.mac_eff		effective mass atten coef based on fit
%|				(valid for 'exp' only)
%|
%| Copyright 2006-3-3, Jeff Fessler, University of Michigan

if nargin == 1 && streq(sl, 'test'), de_ftab_fit_test, return, end
if nargin < 2, ir_usage, end

arg.show = false;
arg.type = '';
arg.mtype = {};
arg.ntype = ''; % how to handle negatives
arg.kev = [10:5:200]';
arg.mac = [];
arg.macbar = [];
arg.wls_simplex_arg = {}; % pass to wls_simplex which passes it to lsqlin
arg.order = 3;
arg.maxdegree = [];
arg.wt = {};
arg.dc = false; % default: exclude dc (constant) from (polynomial) fit
arg = vararg_pair(arg, varargin);
if isempty(arg.type), arg.type = 'poly'; end

LL = length(sl);

if ndims(fm) == LL
	MM = 1;
elseif ndims(fm) == LL + 1
	MM = size(fm,ndims(fm)); % last dimension is number of spectra
else
	error 'invalid fm size'
end

for ll=1:LL % make sure arguments match table dimensions
	if length(sl{ll}) ~= size(fm, ll)
		fail('dim mismatch %d', ll)
	end
end

switch arg.type
case 'poly'
	[fit fmfun fgrad fhess] = de_ftab_fit_poly(sl, fm, MM, arg.wt, ...
		arg.order, arg.maxdegree, arg.dc);

case 'exp'
	fit = de_ftab_fit_exp(sl, fm, MM, arg.wt, ...
		arg.mtype, arg.mac, arg.kev, arg.macbar, arg.wls_simplex_arg);
	fmfun = @de_ftab_fit_exp_eval;
	fgrad = @de_ftab_fit_exp_grad;
	fhess = @de_ftab_fit_exp_hess;
	fit.mac_eff = zeros(MM, LL); % [M L] mac effective
	for mm=1:MM
		fit.mac_eff(mm,:) = fit.mac{mm}' * fit.coef{mm};
	end

otherwise
	fail('unknown fit type %s', arg.type)
end

fit.LL = LL;
fit.MM = MM;
fit.type = arg.type;
fit.ntype = arg.ntype;

meth = {'fmfun', fmfun, '(sll [() L]) -> [() M]'; ...
	'fgrad', fgrad, '(sll [() L]) -> [() L M]'; ...
	'fhess', fhess, '(sll [() L]) -> [() L L M]'; ...
	'show_err', @de_ftab_fit_show_err, '(sl, fm)'; ...
	'show_fm', @de_ftab_fit_show_fm, '(sl, [fm])'; ...
	'show_sp', @de_ftab_fit_show_sp, '([en, sp])'; ...
	};
fit = strum(fit, meth);

if arg.show && im
	fit.show_fm(sl, fm);
end

end % de_ftab_fit()

%
% de_ftab_fit_poly()
%
function [fit, ffun, fgrad, fhess] = ...
	 de_ftab_fit_poly(sl, fm, MM, wt, order, maxdegree, dc)

sll = ndgrid_jf('mat', sl{:});

% for fitting, up weight the no-bone part
% because soft tissue is most prevalant
if isempty(wt)
	wt{1} = 1 ./ (stackpick(sll,2) + 1);
	wt{2} = wt{1};
end

fit.basis_order = order;
fit.basis_maxdegree = maxdegree;
fit.basis_dc = dc;

[fit.basis_func fit.basis_d1 fit.basis_d2] = ...
	ir_poly2_fun(order, 'maxdegree', maxdegree, 'dc', dc);

fit.nbasis = numel(fit.basis_func(0,0));

ss1 = col(stackpick(sll,1));
ss2 = col(stackpick(sll,2));
tmp = fit.basis_func(ss1, ss2); % [*Ns nbasis]
fit.coef = zeros(fit.nbasis, MM);
for mm=1:MM
	fit.coef(:,mm) = (diag_sp(wt{mm}(:)) * tmp) ...
		\ (wt{mm}(:) .* col(fm(:,:,mm)));
end

ffun = @(fit,sl) ...
	reshape([fit.basis_func(sl{1}(:), sl{2}(:)) * fit.coef(:,1); ...
		fit.basis_func(sl{1}(:), sl{2}(:)) * fit.coef(:,2)], ...
		[size(sl{1}) 2]);
ffun = @de_ftab_fit_poly_eval;
fgrad = @() error('not done');
fhess = @() error('not done');

end % de_ftab_fit_poly()

%
% de_ftab_fit_poly_eval()
%
function fm = de_ftab_fit_poly_eval(fit, sll)

% if fit.MM ~= 2
s1 = stackpick(sll,1);
s2 = stackpick(sll,2);
fm = [	fit.basis_func(s1(:), s2(:)) * fit.coef(:,1);
	fit.basis_func(s1(:), s2(:)) * fit.coef(:,2)];
fm = reshape(fm, [size(s1) 2]);

end % de_ftab_fit_poly_eval()

%
% de_ftab_fit_exp()
% todo: more documentation
% todo: use a set of exponents, not "mac"
%
function fit = de_ftab_fit_exp(sl, fm, MM, wt, mtype, mac, kev, macbar, ...
	wls_simplex_arg)

sll = ndgrid_jf('mat', sl{:}); % [(Ns)]

if isempty(mac)
	if isempty(mtype), error 'mac or mtype required', end
	mac = xray_read_atten(mtype, kev); % [Ne L]
else
	if size(mac,1) ~= length(kev), fail 'size mismatch', end
end

LL = length(sl);

if isempty(wt), wt = num2cell(ones(MM,1)); end

Ab = exp(-reshapee(sll, [], LL) * mac'); % [*Ns Ne] "over-complete" basis

fit.kev = cell(1,MM);
fit.mac = cell(1,MM);
fit.coef = cell(1,MM);
for mm=1:MM
	warg = wls_simplex_arg;
	if LL == 1 && ~isempty(macbar) % constrain deriv. at 0
		warg = {wls_simplex_arg{:}, 'inprodv', mac' / macbar(mm,1)};
	end

	if MM == 1 % todo: kludgy
		dat = fm;
	else
		dat = stackpick(fm,mm); % [(Ns)]
	end
	y = exp(-dat);
	Wh = spdiag(sqrt(wt{mm}(:)), 'nowarn');
	% initial coefficients for each candidate energy
	x = wls_simplex(Ab, y(:), Wh, [], warg{:}); % [Ne 1]

	ie = x > 1e-6; % find key energies
	fit.kev{mm} = kev(ie);
	fit.mac{mm} = mac(ie,:); % [Ne L] (now Ne may be smaller than before)

	warg = wls_simplex_arg;
	if LL == 1 && ~isempty(macbar) % constrain derivative at 0
		warg = {wls_simplex_arg{:}, 'inprodv', fit.mac{mm}' / macbar(mm,1)};
	end

	A = exp(-reshapee(sll, [], LL) * fit.mac{mm}'); % [*Ns Ne] final basis
	% final coefficients at key enerties:
	fit.coef{mm} = wls_simplex(A, y(:), Wh, [], warg{:}); % [Ne 1]
end

end % de_ftab_fit_exp()

%
% de_ftab_fit_exp_eval()
% evaluate
% in
%	sll	[(Ns) L]	stackup of s1,s2,...,s_L
% out
%	f	[(Ns) M]	stackup of f1,f2,...,f_M
%
function f = de_ftab_fit_exp_eval(fit, sll)
LL = fit.LL;
if LL == 1
	Ns = size(sll);
	if Ns(end) == 1, Ns = Ns(1:end-1); end
else
	Ns = size(sll); if LL ~= Ns(end), fail 'bug', end; Ns = Ns(1:end-1);
end
sll = reshapee(sll, [], LL); % [*Ns L]
MM = fit.MM;

persistent warned
if ~isvar('warned') || isempty(warned)
	warned = 0;
end

f = zeros(prod(Ns),MM);
for mm=1:MM

	switch fit.ntype
	case '' % standard
		A = exp(-sll * fit.mac{mm}'); % [*Ns Ne]
		tmp = -log(A * fit.coef{mm}); % [*Ns 1]
		f(:,mm) = tmp;

	case 'abs' % trick for negatives
		if LL == 1
			A = exp(-abs(sll) * fit.mac{mm}'); % [*Ns Ne]
			tmp = -log(A * fit.coef{mm}); % [*Ns 1]
			f(:,mm) = -sign(sll) .* log(A * fit.coef{mm}); % [*Ns 1]
%			bad = sll < 0;
%			f(bad,mm) = sll(bad) * fit.mac_eff(mm,1);
		else
			if ~warned
				warned = 1;
				warn 'negative trick not done for L>1'
			end
		end

	otherwise
		fail('bad ntype: %s', fit.ntype)
	end

end
f = reshape(f, [Ns MM]);

end % de_ftab_fit_exp_eval()

%
% de_ftab_fit_exp_grad()
% evaluate gradient of f for each of the given s vectors.
% in
%	sll	[(Ns) L]	stackup of s1,s2,...,s_L
% out
%	g	[(Ns) L M]	stackup of gradients of f(s)
%
function g = de_ftab_fit_exp_grad(fit, sll)
LL = fit.LL;
Ns = size(sll);
if LL == 1
	if Ns(end) == 1, Ns = Ns(1:end-1); end
else
	if LL ~= Ns(end); error 'bug', end
	Ns = Ns(1:end-1);
end
sll = reshape(sll, [], LL); % [*Ns L]
MM = fit.MM;

persistent warned
if ~isvar('warned') || isempty(warned)
	warned = 0;
end

g = zeros(prod(Ns), LL, MM);
for mm=1:fit.MM
	alf = fit.coef{mm}; % [Ne 1]
	mac = fit.mac{mm}; % [Ne L]
	Ne = length(alf); % # exponential terms in the fit

	switch fit.ntype
%	case '' % standard
	case 'abs'
		if any(sll(:) < 0) % trick for negatives
			if LL == 1
				sll = abs(sll);
%				bad = sll < 0;
%				g(bad,1,mm) = fit.mac_eff(mm,1);
			else
				if ~warned
					warned = 1;
					warn 'negative trick not done for L>1'
				end
			end
		end
	end

	A = exp(-sll * mac'); % [*Ns Ne]
	Q = A .* repmat(alf', [prod(Ns) 1]); % [*Ns Ne]
	denom = sum(Q,2); % [*Ns 1]
	Q = Q ./ repmat(denom, [1 Ne]);
	g(:,:,mm) = Q * mac;

end
g = reshape(g, [Ns LL MM]);

end % de_ftab_fit_exp_grad()

%
% de_ftab_fit_exp_hess()
% evaluate hessian of f for each of the given s vectors.
% in
%	sll	[(Ns) L]	stackup of s1,s2,...,s_L
% out
%	h	[(Ns) L L M]	stackup of hessians of f(s)
%
function h = de_ftab_fit_exp_hess(fit, sll)
Ns = size(sll); LL = Ns(end); Ns = Ns(1:end-1);
sll = reshape(sll, [], LL); % [*Ns L]
MM = fit.MM;

persistent warned
if ~isvar('warned') || isempty(warned)
	warned = 0;
end

h = zeros(prod(Ns), LL, LL, MM);
for mm=1:fit.MM
	mac = fit.mac{mm}; % [Ne L]
	alf = fit.coef{mm}; % [Ne 1]
	Ne = length(alf); % # exponential terms in the fit

	switch fit.ntype
%	case '' % standard
	case 'abs'
		if any(sll(:) < 0) % trick for negatives
			if LL == 1
				sll_sign = sign(sll);
				sll = abs(sll);
%				bad = sll < 0;
%				hm(bad,1,1) = 0;
			else
				if ~warned
					warned = 1;
					warn 'negative trick not done for L>1'
				end
			end
		end
	end

	A = exp(-sll * fit.mac{mm}'); % [*Ns Ne]

	Q = A .* repmat(alf', [prod(Ns) 1]); % [*Ns Ne]
	denom = sum(Q,2); % [*Ns 1]
	Q = Q ./ repmat(denom, [1 Ne]);
	g = Q * mac; % [*Ns L] gradient

	% loop over LL because it is smaller than *Ns or Ne
	hm = zeros(prod(Ns), LL, LL);
	for l1=1:LL
		for l2=1:LL
			hm(:,l1,l2) = g(:,l1) .* g(:,l2) ...
				- Q * (mac(:,l1) .* mac(:,l2));
		end
	end

	switch fit.ntype
%	case '' % standard
	case 'abs'
		if any(sll(:) < 0) % trick for negatives
			if LL == 1
				hm(:,1,1) = hm(:,1,1) .* sll_sign;
%				bad = sll < 0;
%				hm(bad,1,1) = 0;
			end
		end
	end

	h(:,:,:,mm) = hm;

end
h = reshape(h, [Ns LL LL MM]);

end % de_ftab_fit_exp_hess()

%
% de_ftab_fit_show_sp()
% compare true spectra to fitted spectra
%
function out = de_ftab_fit_show_sp(fit, en, sp)
if nargin < 1, fail 'de_ftab_fit_show_sp(fit, en, sp)', end

if ~streq(fit.type, 'exp'), printm 'show_sp only done for exp', return, end
if im
	clf, pl = (fit.MM+1)*100 + 10 + 1;
	if nargin > 1
		subplot(pl)
		plot(en, sp * diag(1 ./ max(sp)))
		tmp = num2cell(char([1:fit.MM] + '0'));
		legend(tmp{:})
		axisx(minmax(en))
	end

	if isfield(fit, 'kev')
		for mm=1:fit.MM
			subplot(pl+mm)
			bar(fit.kev{mm}, fit.coef{mm})
			xtick(fit.kev{mm}(fit.coef{mm} > 0))
			axis tight
			if nargin > 1, axisx(minmax(en)), end
		end
	else
		warn 'kev unknown'
	end
end

if nargout, out = []; end

end % de_ftab_fit_show_sp()

%
% de_ftab_fit_show_fm()
% compare fit to sampled fm
%
function out = de_ftab_fit_show_fm(fit, sl, fm, sll)
if nargin < 2, error 'de_ftab_fit_show_fm(fit, sl, fm)', end

do_fm = nargin > 2;
if ~isvar('sll') || isempty(sll)
	sll = ndgrid_jf('mat', sl{:});
end

fh = fit.fmfun(sll);

if ~iscell(sl), fail 'sl must be cell', end
switch length(sl) % LL
case 1
	s1 = sl{1};
	im clf
	arg = {};
	leg = {};
	order = 'bgrcm';
	if do_fm
		for mm=1:fit.MM
			arg = {arg{:}, s1, fm(:,mm), [order(mm) '.']};
			leg = {leg{:}, sprintf('true m=%d', mm)};
		end
	end
	for mm=1:fit.MM
		arg = {arg{:}, sll, fh(:,mm), [order(mm) '-']};
		leg = {leg{:}, sprintf('fit m=%d', mm)};
	end
	plot(arg{:})
	xlabel 's1'
	ylabel 'fm(s1)'
	legend(leg{:}, 4)

case 2
	s1 = sl{1};
	s2 = sl{2};
	smax(1) = max(s1);
	smax(2) = max(s2);
	if do_fm
		fmax = max(fm(:));
	else
		fmax = max(fh(:));
	end

	ax = [0 smax(1) 0 smax(2) 0 fmax];
	cax = [0 fmax];

	im clf
	im('pl', 2, fit.MM)
	for mm=1:fit.MM
		if do_fm
		show(mm, s1, s2, fm(:,:,mm), ax, cax, sprintf('f_%d(s)', mm))
		end
		m0 = mm + fit.MM;
		show(m0, s1, s2, fh(:,:,mm), ax, cax, sprintf('f_%d fit', mm))
	end
%	% text(-60, 10, '[cm^2/g]')

case 3
	s1 = sl{1};
	s2 = sl{2};
	s3 = sl{3};
	smax(1) = max(s1);
	smax(2) = max(s2);
	smax(3) = max(s3);
	if do_fm
		fmax = max(fm(:));
	else
		fmax = max(fh(:));
	end

	ax = [0 smax(2) 0 smax(3) 0 fmax];
	cax = [0 fmax];

	im clf
	im('pl', 2, fit.MM)
	for mm=1:fit.MM
		if do_fm
		show(mm, s2, s3, fm(1,:,:,mm), ax, cax, sprintf('f_%d(s)', mm))
		end
		m0 = mm + fit.MM;
		show(m0, s2, s3, fh(1,:,:,mm), ax, cax, sprintf('f_%d fit', mm))
	end
%	% text(-60, 10, '[cm^2/g]')

otherwise
	fail 'not done'
end

if nargout, out = []; end

end % de_ftab_fit_show_fm()

%
% de_ftab_fit_show_err()
% show fit errors, and relate to HU
% f = mac s, mac(70kev,H2O) = 0.2 cm^2 / g = 1000 HU
% mh = mac * 1000 HU / (0.2 g/cm^2)
% so Df/Dmh = Df/Dmac * Dmac/Dmh = (50 g/cm^2) (0.2 cm^2/g) / 1000 HU = 1/100 HU
% so Dmh = 100 HU * Df for 50 cm of H2O.
%
function out = de_ftab_fit_show_err(fit, sl, fm)
if nargin < 3, error 'de_ftab_fit_show_err(fit, sl, fm)', end

sll = ndgrid_jf('mat', sl{:});

fh = fit.fmfun(sll);
err = fh - fm;
printm('worst model error = %g of %g', max(abs(err(:))), max(fm(:)))
printm('worst model error = %g HU over 50cm H2O', 100*max(abs(err(:))))
for mm=1:fit.MM
	ee = stackpick(err,mm);
	printm('worst error (mm=%d): %g', mm, max(abs(ee(:))))
end

if max(abs(err(:))) == 0
	if nargout, out = []; end
return
end

if 0
	e1 = err(:,:,1);
	e2 = err(:,:,2);
	disp([minmax(e1); minmax(e2)]')
	printm('worst error1 %g', max(col(abs(err(:,1,:)))))
	printm('worst error2 %g', max(col(abs(err(:,2,:)))))
end
%err = abs(err);

switch length(sl) % LL
case 1
	s1 = sl{1};
	arg = {};
	leg = {};
	order = 'bgrcm';
	for mm=1:fit.MM
		arg = {arg{:}, s1, err(:,mm), [order(mm) '-']};
		leg = {leg{:}, sprintf('m=%d', mm)};
	end
	plot(arg{:})
	xlabel 's1'
	ylabel 'error'
	legend(leg{:}, 4)

case 2
	s1 = sl{1};
	s2 = sl{2};

	elim = minmax(err(:))';
	%elim = [-1 1] * 0.01; % +/- 1 HU
	ax = [0 max(s1) 0 max(s2) elim];
	im clf, im('pl', 1, fit.MM)
	for mm=1:fit.MM
		show(mm, s1, s2, err(:,:,mm), ax, elim, sprintf('f_%d error', mm))
	end

case 3
	s1 = sl{1};
	s2 = sl{2};
	s3 = sl{3};

	elim = minmax(err(:))';
	ax = [0 max(s2) 0 max(s3) elim];
	im clf, im('pl', 1, fit.MM)
	for mm=1:fit.MM
		show(mm, s2, s3, err(1,:,:,mm), ax, elim, sprintf('f_%d error', mm))
	end

otherwise
	fail 'not done'
end

if nargout, out = []; end

end % de_ftab_fit_show_err()

%
% show()
%
function show(pl, x, y, f, ax, cax, ti)
f = squeeze(f); % for LL=3 case
if ~im, return, end
im('subplot', pl)
if 1
	mesh(x,y,f')
	colormap hsv, caxis(cax), cbar
	axis(ax)
	xtick, ytick, ztick, zwhite
else
	im(x,y,f), cbar
	xtick, ytick
end
xlabel 's_1', ylabel 's_2', title(ti)

end % show()

%
% de_ftab_fit_test()
%
function de_ftab_fit_test

%stype = 'mono,70,100,160';
%stype = 'ps1';
%stype = 'poly1,60';
stype = 'poly1,80,100,160'; % stress test
xrs = xray_read_spectra(stype);

list.sl{1} = linspace(0, 50, 26); % coarse for fast fitting
list.sl{2} = linspace(0, 30, 31);
list.sl{3} = linspace(0, 2, 11);
list.mtype = {'water', 'bone', 'iodine'};
list.wls_simplex_arg = {{'reg', 1e-16}, {'reg', 1e-9}, {'reg', 1e-4}}; % more reg for LL>1 case

if 0 % look at derivatives
	LL = 2;
	sl = {list.sl{1:LL}};
	mtype = {list.mtype{1:LL}};
	warg = list.wls_simplex_arg{LL};
	mas = xray_read_mac(mtype);
	mac = mas.mac(xrs.en);
	sll = ndgrid_jf('mat', sl{:});
	fm = de_ftab_fm(sll, mac, xrs.Ide);
	fit = de_ftab_fit(sl, fm, 'show', 1, 'type', 'exp', 'mtype', mtype, ...
		'wls_simplex_arg', warg);
	g = fit.fgrad(sll);
end

%for LL=1:3
for LL=2
	sl = {list.sl{1:LL}};
	mtype = {list.mtype{1:LL}};
	warg = list.wls_simplex_arg{LL};

	mas = xray_read_mac(mtype);
	mac = mas.mac(xrs.en);
	if im
		clf, semilogy(xrs.en, mac), legend(mtype{:})
	end
	sll = ndgrid_jf('mat', sl{:});
	fm = de_ftab_fm(sll, mac, xrs.Ide);
%	fit = de_ftab_fit(sl, fm, 'show', 1, 'type', 'poly')
	fit = de_ftab_fit(sl, fm, 'show', 1, 'type', 'exp', 'mtype', mtype, ...
		'wls_simplex_arg', warg);

	fh = fit.fmfun(sll);
	g = fit.fgrad(sll);
	h = fit.fhess(sll);

	if 1 && LL == 2 % test gradient (for yong)
		if 1 % for gradient graphically
			list.slfine{1} = linspace(0, 90, 261); % fine for evaluating
			list.slfine{2} = linspace(0, 90, 511);
		else
			list.slfine{1} = linspace(0, 5, 261); % fine for evaluating
			list.slfine{2} = linspace(0, 3, 511);
		end
%		list.slfine{3} = linspace(0, 2, 201);
		slfine = {list.slfine{1:LL}};
		slf = ndgrid_jf('mat', slfine{:});
		fh = fit.fmfun(slf);
		gr = fit.fgrad(slf); % [261 511 L M]
		if im % examine gradient values graphically
			pl = @(mm) subplot(100 + 10 * fit.MM + mm);
			for mm=1:fit.MM
				pl(mm)
				tmp = gr(:,:,:,mm);
				plot(tmp(:,:,1), tmp(:,:,2), '.')
				titlef('%d kvp', xrs.kvp(mm))
				xlabel 'g1', ylabel 'g2'
				axis([0 max(col(tmp(:,:,1))) 0 max(col(tmp(:,:,2)))])
			end
		return
		end
		i1 = 5;
		i2 = 9;
		d1 = slfine{1}(i1+1) - slfine{1}(i1);
		d2 = slfine{2}(i2+1) - slfine{2}(i2);
		gh(:,1) = (fh(i1+1,i2,:) - fh(i1,i2,:)) / d1;
		gh(:,2) = (fh(i1,i2+1,:) - fh(i1,i2,:)) / d2;
		pr transpose(gh)
		gg = squeeze(gr(i1,i2,:,:));
		pr gg
		pr transpose(fit.mac_eff) % at origin
%		gg - fit.mac_eff'
	return
	end

	if im
		fit.show_sp(xrs.en, xrs.sp);
		prompt
		fit.show_fm(sl, fm);
		prompt
		fit.show_err(sl, fm);
		prompt
	end

end

end % de_ftab_fit_test()


%
%  MODEL REDUCTION BY THE ALGORITHMS LRSRM AND DSPMR. THE GOAL IS TO
%  GENERATE A "NUMERICALLY MINIMAL REALIZATION" OF THE GIVEN SYSTEM
%  AS WELL AS A REDUCED SYSTEM OF RELATIVELY SMALL ORDER.
%
%  This demo program shows how the model reduction routines 'lp_lrsrm'
%  and 'lp_dspmr' work. Also, the use of 'lp_lradi', supplementary
%  routines, and user-supplied functions is demonstrated.

% -----------------------------------------------------------------------
% Generate test problem
% -----------------------------------------------------------------------
%
% As test example, we use an FEM-semidiscretized problem, which leads to
% a generalized system where M (the mass matrix) and N (the negative
% stiffness matrix) are sparse, symmetric, and definite.

load rail821   % load the matrices M N Btilde Ctilde of the generalized
               % system

%load rail3113   % Uncomment this to get an example of larger order.

disp('Problem dimensions:')

n = size(M,1)   % problem order (number of states)
m = size(Btilde,2)   % number of inputs
q = size(Ctilde,1)   % number of outputs

% -----------------------------------------------------------------------
% Initialization/generation of data structures used in user-supplied
% functions and computation of ADI shift parameters
% -----------------------------------------------------------------------
%
% See 'demo_u1', 'demo_u2', 'demo_u3', and 'demo_l1' for more detailed
% comments.

name = 'msns';
[M0,MU,N0,B0,C0,prm,iprm] = msns_pre(M,N,Btilde,Ctilde);  % preprocessing
msns_m_i(M0,MU,N0);   % initialization for multiplication with A0
msns_l_i;   % initialization for solving systems with A0

disp('Parameters for heuristic algorithm which computes ADI parameters:')
l0 = 20   % desired number of distinct shift parameters
kp = 50   % number of steps of Arnoldi process w.r.t. A0
km = 25   % number of steps of Arnoldi process w.r.t. inv(A0)

b0 = ones(n,1);   % This is just one way to choose the Arnoldi start
                  % vector.

p = lp_para(name,[],[],l0,kp,km,b0);   % computation of ADI shift
                                       % parameters

disp('Actual number of ADI shift parameters:');
l = length(p)

disp('ADI shift parameters:');
p

msns_s_i(p)   % initialization for shifted systems of linear equations
              % with A0+p(i)*I  (i = 1,...,l)

% -----------------------------------------------------------------------
% Solution of Lyapunov equations A0*X0+X0*A0' = -B0*B0' and
% A0'*X0+X0*A0 = -C0'*C0
% -----------------------------------------------------------------------

disp('Parameters for stopping criteria in LRCF-ADI iteration:')
max_it = 200   % (large value)
min_res = 0   % (avoided)
with_rs = 'S'   % ("activated")
min_in = 0   % (avoided)

zk = 'Z';
rc = 'C';
Bf = [];
Kf = [];
info = 3;

disp('... solving A0*XB0+XB0*A0'' = - B0*B0''...');
tp = 'B';

figure(1), hold off; clf;   % (lp_lradi will plot residual history.)

[ZB0,flag_B] = lp_lradi(tp,zk,rc,name,Bf,Kf,B0,p,max_it,min_res,...
               with_rs,min_in,info);
                                       % compute ZB0

title('LRCF-ADI for CALE  A_0X_{B0}+X_{B0}A_0^T = -B_0B_0^T')
disp('Termination flag:')
flag_B
disp('Size of ZB0:');
size_ZB0 = size(ZB0)

disp('... solving A0''*XC0+XC0*A0 = - C0''*C0...');
tp = 'C';

figure(2), hold off; clf;   % (lp_lradi will plot residual history.)

[ZC0,flag_C] = lp_lradi(tp,zk,rc,name,Bf,Kf,C0,p,max_it,min_res,...
               with_rs,min_in,info);
                                       % compute ZC0

title('LRCF-ADI for CALE  A_0^T X_{C0} + X_{C0} A_0 = -C_0^TC_0')
disp('Termination flag:')
flag_C
disp('Size of ZC0:');
size_ZC0 = size(ZC0)

% -----------------------------------------------------------------------
% Plot the transfer function of the system for a certain frequency range
% -----------------------------------------------------------------------

disp('... computing transfer function of original system ...');

freq = lp_lgfrq(1e-10,1e10,200);   % generate a set of 200 "frequency
                                   % sampling points" in the interval
                                   % [10^-10,10^+10].
G = lp_trfia(freq,N,Btilde,Ctilde,[],M);   % compute "transfer function
                                           % sample" for these frequency
                                           % points
nrm_G = lp_gnorm(G,m,q);   % compute norms of the "transfer function
                           % sample" for these frequency points

figure(3); hold off; clf;
loglog(freq,nrm_G,'k:');
xlabel('\omega');
ylabel('Magnitude');
t_text = 'dotted: ||G||';
title(t_text);
pause(1)

% -----------------------------------------------------------------------
% Generate reduced systems of high accuracy and possibly high order
% -----------------------------------------------------------------------

disp(' ')
disp('Generate reduced systems of high accuracy and possibly high order')
disp('-----------------------------------------------------------------')

disp('Parameters for model reduction:')
max_ord = []   % (avoided)
tol = 1e-14   % (This criterion determines the reduced order. The very
              % small value is chosen to generate a "numerically minimal
              % realization".)

disp('... computing reduced system by LRSRM ...');
[Ars,Brs,Crs] = lp_lrsrm(name,B0,C0,ZB0,ZC0,max_ord,tol);   % run LRSRM

disp('Reduced order:')
disp(length(Ars))

Grs = lp_trfia(freq,Ars,Brs,Crs,[],[]);   % compute "transfer function
                                          % sample" for reduced system
nrm_dGrs = lp_gnorm(G-Grs,m,q);   % compute norm of DIFFERENCE of
                                  % transfer function samples of original
                                  % and reduced system.
figure(3); hold on
loglog(freq,nrm_dGrs,'r-');
t_text = [t_text, ',    solid: ||G-G_{LRSRM}||'];
title(t_text); pause(1)

disp('... computing reduced system by DSPMR ...');
[Ard,Brd,Crd] = lp_dspmr(name,B0,C0,ZB0,ZC0,max_ord,tol);   % run DSPMR

disp('Reduced order:')
disp(length(Ard))

Grd = lp_trfia(freq,Ard,Brd,Crd,[],[]);   % compute "transfer function
                                          % sample" for reduced system
nrm_dGrd = lp_gnorm(G-Grd,m,q);   % compute norm of DIFFERENCE of
                                  % transfer function samples of original
                                  % and reduced system.
figure(3); hold on
loglog(freq,nrm_dGrd,'b--'); pause(1)
t_text = [t_text, ',    dashed: ||G-G_{DSPMR}||'];
title(t_text); pause(1)

% -----------------------------------------------------------------------
% Generate reduced systems of low order
% -----------------------------------------------------------------------

disp(' ')
disp('Generate reduced systems of low order')
disp('-------------------------------------')

disp('Parameters for model reduction:')
max_ord = 25   % (This criterion determines the reduced order.)
tol = 0    % (avoided)

disp('... computing reduced system by LRSRM ...');
[Ars,Brs,Crs] = lp_lrsrm(name,B0,C0,ZB0,ZC0,max_ord,tol);   % run LRSRM

disp('Reduced order:')
disp(length(Ars))

Grs = lp_trfia(freq,Ars,Brs,Crs,[],[]);   % compute "transfer function
                                          % sample" for reduced system
nrm_dGrs = lp_gnorm(G-Grs,m,q);   % compute norm of DIFFERENCE of
                                  % transfer function samples of original
                                  % and reduced system.
figure(3); hold on
loglog(freq,nrm_dGrs,'r-');

disp('... computing reduced system by DSPMR ...');
[Ard,Brd,Crd] = lp_dspmr(name,B0,C0,ZB0,ZC0,max_ord,tol);   % run DSPMR

disp('Reduced order:')
disp(length(Ard))

Grd = lp_trfia(freq,Ard,Brd,Crd,[],[]);   % compute "transfer function
                                          % sample" for reduced system
nrm_dGrd = lp_gnorm(G-Grd,m,q);   % compute norm of DIFFERENCE of
                                  % transfer function samples of original
                                  % and reduced system.
figure(3); hold on
loglog(freq,nrm_dGrd,'b--');

% -----------------------------------------------------------------------
% Destroy global data structures
% -----------------------------------------------------------------------

msns_m_d;
msns_l_d;
msns_s_d(p);


function [ xpoly, ypoly, zpoly, avg_resid ] = sv2poly( xpos, ypos, zpos, ...
    times, xvel, yvel, zvel )
%SV2POLY Compute best fit polynomials from 3D state vectors
%
% This function determines a polynomial order that achieves good precision
% without being unreasonably high or overfitting.  One would generally only
% use this function on state vectors from an orbital system, where the
% positions/velocity would reasonably follow a smooth path.
%
% "Optimal" polynomial order depends on both the length of the collect
% around its orbit and the noise in the state vector data.
%
% Written by: Wade Schwartzkopf, NGA/R
%
% //////////////////////////////////////////
% /// CLASSIFICATION: UNCLASSIFIED       ///
% //////////////////////////////////////////

% Check arguments
if ~isequal(size(xpos), size(ypos), size(zpos), size(times)) || ...
        (exist('zvel','var') && ...
        ~isequal(size(xvel), size(yvel), size(zvel), size(times)))
    error('SV2POLY:INVALID_INPUT_ARGS','All state vector components must be same size/shape.');
end
% Vectorize inputs to assure column vectors
times = times(:);
xpos = xpos(:);
ypos = ypos(:);
zpos = zpos(:);
if exist('zvel', 'var')
    xvel = xvel(:);
    yvel = yvel(:);
    zvel = zvel(:);
end

% Because of the scale of the values used in orbital state vectors,
% MATLAB's polyfit oftens detects them as badly conditioned, but results
% work out OK anyway for reasonable polynomail orders. We will assure in
% this function that polynomial order is reasonable.
old_state = warning('off','MATLAB:polyfit:RepeatedPointsOrRescale');

%% Method 1.  Naive approach.
% Hardcode polynomial order.  This is usually sufficient.  5th order
% generally works well for most spaceborne SAR collects of typical length
% (< 200 s), often putting evaluation of the polynomials well within 1 mm
% of error.
% polyorder = min(5, numel(times) - 1);

if exist('zvel', 'var')
    %% Method 2.  Cross check with velocity.
    % One could also find the order of polynomial that most accurately
    % describes this position, but use velocity (which is presumably
    % measured independently) as cross-validation so that the data is not
    % being overfit.
    for polyorder = 1:(numel(times)-1)
        xpoly = polyfit(times, xpos, polyorder);
        ypoly = polyfit(times, ypos, polyorder);
        zpoly = polyfit(times, zpos, polyorder);
        error_list(polyorder) = mean(sqrt(sum(([xvel, yvel, zvel] - ...
            [polyval(polyder(xpoly), times), ...
            polyval(polyder(ypoly), times), ...
            polyval(polyder(zpoly), times)]).^2, 2)));
    end
    % Increase order only as long as it results in a "significant" decrease
    % (half) in the error of the velocity.
    polyorder = find(error_list(1:(end-1))<(2*error_list(2:end)), 1, 'first');
    if isempty(polyorder), polyorder = numel(error_list); end  % All orders improve quality
else
    %% Method 3. "Significant" improvement.
    % One could also use the lowest order of polynomial that significantly
    % reduces the error of the position fit.
    for polyorder = 1:(numel(times)-2)  % polyorder of n-1 will always be exact match
        % mu term used for error computation in loop since we are
        % potentially computing high order polynomials, generally well
        % beyond what is required for a good fit, and these will likely be
        % badly conditioned. For our final fit, after the polynomial order
        % is determined, we will assume order and fit is reasonable-- even
        % if MATLAB would have thrown a warning.
        [xpoly, ~, xmu] = polyfit(times, xpos, polyorder);
        [ypoly, ~, ymu] = polyfit(times, ypos, polyorder);
        [zpoly, ~, zmu] = polyfit(times, zpos, polyorder);
        error_list(polyorder) = mean(sqrt(sum(([xpos, ypos, zpos] - ...
            [polyval(xpoly, times, [], xmu), ...
            polyval(ypoly, times, [], ymu), ...
            polyval(zpoly, times, [], zmu)]).^2, 2)));
    end
    % Increasing polynomial order by one must result in error being cut in
    % half in order to be considered "significant".
    polyorder = find(error_list(1:(end-1))<(2*error_list(2:end)), 1, 'first');
    if isempty(polyorder), polyorder = numel(error_list); end  % All orders improve quality
end

% Once optimal polynomial order is determined, do actual polynomial fit
xpoly  = polyfit(times, xpos, polyorder);
ypoly  = polyfit(times, ypos, polyorder);
zpoly  = polyfit(times, zpos, polyorder);

warning(old_state);

% Compute final residuals if requested
if nargout>3
    avg_resid = mean(sqrt(sum(([xpos, ypos, zpos] - ...
        [polyval(xpoly, times), ...
        polyval(ypoly, times), ...
        polyval(zpoly, times)]).^2, 2)));
end

% //////////////////////////////////////////
% /// CLASSIFICATION: UNCLASSIFIED       ///
% //////////////////////////////////////////


function e = R2e(R)

% R2E  Rotation matrix to Euler angles conversion.
%   R2E(R) returns the euler angles vector [roll;pitch;yaw] corresponding
%   to the orientation of the rotation matrix R. The result is such that
%   E2R(R2E(R)) = R and R2E(E2R(E)) = E.
%
%   See also E2R, FRAME.

%   Copyright 2008-2009 Joan Sola @ LAAS-CNRS.

s = whos('R');

if (strcmp(s.class,'sym'))
    roll  = atan(R(3,2)/R(3,3));
    pitch = asin(-R(3,1));
    yaw   = atan(R(2,1)/R(1,1));
else
    roll  = atan2(R(3,2),R(3,3));
    pitch = atan2(-R(3,1), sqrt(R(1,1)^2+R(2,1)^2));
    yaw   = atan2(R(2,1),R(1,1));
end

e = [roll;pitch;yaw];

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

%   # START GPL LICENSE

%---------------------------------------------------------------------
%
%   This file is part of SLAMTB, a SLAM toolbox for Matlab.
%
%   SLAMTB is free software: you can redistribute it and/or modify
%   it under the terms of the GNU General Public License as published by
%   the Free Software Foundation, either version 3 of the License, or
%   (at your option) any later version.
%
%   SLAMTB is distributed in the hope that it will be useful,
%   but WITHOUT ANY WARRANTY; without even the implied warranty of
%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%   GNU General Public License for more details.
%
%   You should have received a copy of the GNU General Public License
%   along with SLAMTB.  If not, see <http://www.gnu.org/licenses/>.
%
%---------------------------------------------------------------------

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

%   # END GPL LICENSE


function [f1,f2,DialedNum] = DecodedFrequencies(E);

%Computes the energy of the Signal
%Input Variables
%    E    = Energy Matrix of the Filtered Signals
%
% Output Variables
%    f1   = first decoded frequency
%    f2   = second decoded frequency

Fmat = [697 770 852 941 1209 1336 1477 1633];

LowEnergyMatrix = E(1:4);
HighEnergyMatrix = E(5:8);

[e1,e1Index]=max(LowEnergyMatrix);
[e2,e2Index]=max(HighEnergyMatrix);

f1 = Fmat(e1Index);
f2 = Fmat(4+e2Index);

if        f1 == Fmat(1) && f2 == Fmat(5)
   DialedNum = '1';
   elseif f1 == Fmat(1) && f2 == Fmat(6)
   DialedNum = '2';
   elseif f1 == Fmat(1) && f2 == Fmat(7)
   DialedNum = '3';
   elseif f1 == Fmat(1) && f2 == Fmat(8)
   DialedNum = 'A';
   elseif f1 == Fmat(2) && f2 == Fmat(5)
   DialedNum = '4';
   elseif f1 == Fmat(2) && f2 == Fmat(6)
   DialedNum = '5';
   elseif f1 == Fmat(2) && f2 == Fmat(7)
   DialedNum = '6';
   elseif f1 == Fmat(2) && f2 == Fmat(8)
   DialedNum = 'B';
   elseif f1 == Fmat(3) && f2 == Fmat(5)
   DialedNum = '7';
   elseif f1 == Fmat(3) && f2 == Fmat(6)
   DialedNum = '8';
   elseif f1 == Fmat(3) && f2 == Fmat(7)
   DialedNum = '9';
   elseif f1 == Fmat(3) && f2 == Fmat(8)
   DialedNum = 'C';
   elseif f1 == Fmat(4) && f2 == Fmat(5)
   DialedNum = '*';
   elseif f1 == Fmat(4) && f2 == Fmat(6)
   DialedNum = '0';
   elseif f1 == Fmat(4) && f2 == Fmat(7)
   DialedNum = '#';
   elseif f1 == Fmat(4) && f2 == Fmat(8)
   DialedNum = 'D';
else
    DialedNum = 'p';
end


function [nfm_Sharp_lunwrap, mask_sharp] = backgroundRemovalSharp(phase_lunwrap, mask_pad, filterMode)
%BACKGROUNDREMOVALSHARP Background phase removal using SHARP (Sophisticated harmonic artifact reduction for phase data)
%   Code refractored from Berkin Bilgic's scripts: "script_Laplacian_unwrap_Sharp_Fast_TV_gre3D.m"
%   and "script_Laplacian_unwrap_Sharp_Fast_TV_gre3D.m"
%   Original source: https://martinos.org/~berkin/software.html
%
%   phase_lunwrap: unwrapped phase volume
%   mask_pad: zero-padded mask volume
%   filterMode: 'once' or 'iterative'
%
%   Original reference:
%   Bilgic et al. (2014), Fast quantitative susceptibility mapping with
%   L1-regularization and automatic parameter selection. Magn. Reson. Med.,
%   72: 1444-1459. doi:10.1002/mrm.25029
%
%   ... which references:
%
%   Li W, Wu B, Liu C. Quantitative susceptibility mapping of
%   human brain reflects spatial variation in tissue composition.
%   NeuroImage 2011; 55(4): 1645?1656.
%

    if nargin < 4
        filterMode = 'once';
    end
    switch filterMode
        case 'once'
            [nfm_Sharp_lunwrap, mask_sharp] = sharp_once(phase_lunwrap, mask_pad);
        case 'iterative'
            [nfm_Sharp_lunwrap, mask_sharp] = sharp_iterative(phase_lunwrap, mask_pad);
    end

end

function [nfm_Sharp_lunwrap, mask_sharp] = sharp_once(phase_lunwrap, mask_pad)

    N = size(mask_pad);

    ksize = [9, 9, 9];                % Sharp kernel size
    threshold = .05;                  % truncation level

    % calculate del kernel and its inverse
    del_sharp = calc_del_kernel(ksize, N);

    delsharp_inv = zeros(size(del_sharp));
    delsharp_inv( abs(del_sharp) > threshold ) = 1 ./ del_sharp( abs(del_sharp) > threshold );

    % erode mask to remove convolution artifacts
    mask_sharp = erode_mask(mask_pad, ksize);

    % apply Sharp to Laplacian wrapped phase
    phase_del = ifftn(fftn(phase_lunwrap) .* del_sharp);
    Phase_Del = phase_del .* mask_sharp;

    phase_Sharp_lunwrap = real( ifftn(fftn(Phase_Del) .* delsharp_inv) .* mask_sharp );

    nfm_Sharp_lunwrap = phase_Sharp_lunwrap;
end

function [nfm_Sharp_lunwrap, mask_sharp] = sharp_iterative(phase_lunwrap, mask_pad)

    N = size(mask_pad);

    threshold = .05;                     % truncation level

    Kernel_Sizes = 9:-2:3;

    % initiate volumes
    Phase_Del = zeros(N);
    mask_prev = zeros(N);

    for k = 1:length(Kernel_Sizes)

        disp(['Kernel size: ', num2str(Kernel_Sizes(k))])

        Kernel_Size = Kernel_Sizes(k);
        ksize = [Kernel_Size, Kernel_Size, Kernel_Size];                % Sharp kernel size

        % calculate del kernel and its inverse
        del_sharp = calc_del_kernel(ksize, N);

        if k == 1
            delsharp_inv = zeros(size(del_sharp));
            delsharp_inv( abs(del_sharp) > threshold ) = 1 ./ del_sharp( abs(del_sharp) > threshold );
        end

        % erode mask to remove convolution artifacts
        mask_sharp = erode_mask(mask_pad, ksize);

        % apply Sharp to Laplacian unwrapped phase
        phase_del = ifftn(fftn(phase_lunwrap) .* del_sharp);
        Phase_Del = Phase_Del + phase_del .* (mask_sharp - mask_prev);

        mask_prev = mask_sharp;

    end

    phase_Sharp_lunwrap = real( ifftn(fftn(Phase_Del) .* delsharp_inv) .* mask_sharp );
    nfm_Sharp_lunwrap = phase_Sharp_lunwrap;

end

function del_sharp = calc_del_kernel(ksize, N)

    khsize = (ksize-1)/2;
    [a,b,c] = meshgrid(-khsize(2):khsize(2), -khsize(1):khsize(1), -khsize(3):khsize(3));

    kernel = (a.^2 / khsize(1)^2 + b.^2 / khsize(2)^2 + c.^2 / khsize(3)^2 ) <= 1;
    kernel = -kernel / sum(kernel(:));
    kernel(khsize(1)+1,khsize(2)+1,khsize(3)+1) = 1 + kernel(khsize(1)+1,khsize(2)+1,khsize(3)+1);

    Kernel = zeros(N);
    Kernel( 1+N(1)/2 - khsize(1) : 1+N(1)/2 + khsize(1), 1+N(2)/2 - khsize(2) : 1+N(2)/2 + khsize(2), 1+N(3)/2 - khsize(3) : 1+N(3)/2 + khsize(3) ) = -kernel;

    del_sharp = fftn(fftshift(Kernel));

end

function mask_sharp = erode_mask(mask_pad, ksize)

    erode_size = ksize + 1;

    mask_sharp = imerode(mask_pad, strel('line', erode_size(1), 0));
    mask_sharp = imerode(mask_sharp, strel('line', erode_size(2), 90));
    mask_sharp = permute(mask_sharp, [1,3,2]);
    mask_sharp = imerode(mask_sharp, strel('line', erode_size(3), 0));
    mask_sharp = permute(mask_sharp, [1,3,2]);

end


function [channels,overall_amplitude] = eeg_amplitudearea(EEG, channels, resrate, wstart, wend)
% EEG_AMPLITUDEAREA - Resamples an ERP average using spline interpolation
%                       at a new sample rate (resrate) in Hz to get the exact limits
%                       of the window of integration. Finely samples the window
%                       and adds together very narrow rectangles capped by
%                       right-angled triangles under the window. Output is in uV.
%                       Trade-off between speed and number of resamples and number of
%                        channels selected occurs.
% Usage:
%      >> [channels, amplitude] = eeg_amplitudearea(EEG,channels, resrate, wstart, wend);
% Inputs:
%   EEG         - EEGLAB data struct containing a (3-D) epoched data matrix
%   channels    - vector of channel indices
%   resrate     - resampling rate for window of integration in Hz
%   wstart      - start of window of integration in ms post stimulus-onset
%   wend        - end of window of integration in ms post stimulus-onset
%
% Outputs:
%   channels    - a vector of channel indices.
%   amplitude   - 1-dimensional array in uV for the channels
%
% Example
%    >> [channels, amplitude] = eeg_amplitudearea(EEG,[12 18 25 29], 2000, 90.52, 120.52);
%
% Author: Tom Campbell, Helsinki Collegium for Advanced Studies, Biomag Laboratory,
%         Engineering Centre, Helsinki University Central Hospital Helsinki Brain
%         Research Centre (tom.campbell@helsinki.fi) Spartam nanctus es: Hanc exorna.
%         Combined with AMPLITUDEAREA_MSUV by Darren Weber, UCSF 28/1/05
%         Retested and debugged Tom Campbell 2/2/05
%         Reconceived, factored somewhat, tested and debugged Tom Campbell 13:24 23.3.2005

if wstart > wend
    error ('ERROR: wstart must be greater than wend')
else
    [channels, overall_amplitude] = eeg_amplitudearea_msuV (EEG,channels, resrate, wstart, wend);
    overall_amplitude = overall_amplitude/(wend - wstart);
end

return

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [channels, overall_area] = eeg_amplitudearea_msuV (EEG, channels, resrate, wstart, wend)

%if ndim(EEG.data) ~= 3
%  error('EEG.data must be 3-D data epochs');
%end
erp = mean(EEG.data,3);

[tmp ind1] =min( abs( EEG.times - wstart ) ); % closest time index to wstart
[tmp ind2] =min( abs( EEG.times - wend ) ); % closest time index to wend
restep = 1/resrate;

if EEG.times(ind1) > wstart
    ind1= ind1 -1;
end

if EEG.times(ind2) < wend
    ind2= ind2 +1;
end

for x= ind1:ind2
    t = (x -ind1)+1;
    tim(t) = EEG.times(x);
end

tr = 1;
timr(tr) = wstart;
while timr(tr) < wend
    tr = tr + 1;
    timr(tr) = timr(tr-1)+ restep;
end

for x = 1:size(channels,2)
    channel = channels(x);
    %resamples
    rerp(x, 1:tr) = spline(tim(:),erp(channel, ind1:ind2), timr(1:tr));
    pent = timr(tr - 1);
    overall_area(x) = 0;
    for y = 1:(tr -1)
        v1 =  rerp(x,(y));
        v2 =  rerp(x,(y+1));
        if ((v1 > 0) && (v2 < 0)) || ((v1 < 0) && (v2 > 0))
            if (y == (tr-1)) && (timr(y+1)> wend)
                area1 = zero_crossing_truncated(v1, v2, restep, wend, pent);
            else
                area1 = zero_crossing(v1, v2, restep);
            end
        else
            if( y == (tr-1)) && (timr(y+1)> wend)
                area1 = rect_tri_truncated(v1, v2, restep,wend,pent);
            else
                area1 = rect_tri(v1, v2, restep);
            end
        end
        overall_area(x) = overall_area(x) + area1;
    end
end

return

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [area] = zero_crossing(v1,v2,step)
    if (v1 > v2)
        T1 = v1;
        T2 = v2;
    else
        T1 = v2;
        T2 = v1;
    end
    tantheta = (abs(T1)+ abs(T2))/step;
    if (v1 > v2)
        %decline
        z = abs(T1)/tantheta;
        tr1= abs(T1)*(z/2);
        tr2= abs(T2)*((step-z)/2);
    else
        %incline
        z = abs(T2)/tantheta;
        tr2= abs(T2)*(z/2);
        tr1= abs(T1)*((step-z)/2);
    end
    [area] = (tr1 - tr2);
return
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [area] = zero_crossing_truncated(v1,v2,step,wend,pent)
    if (v1 > v2)
        T1 = v1;
        T2 = v2;
    else
        T1 = v2;
        T2 = v1;
    end
    tantheta = (abs(T1)+ abs(T2))/step;
    s = wend - pent;
    if (v1 > v2)
        z = abs(T1)/tantheta
        if s < z
            %decline,truncated before zerocrossing
            t1 = tantheta * s;
            r1 = abs(T1)-abs(t1);
            tr1= abs(t1)*(s/2);
            tr2= 0;
            rect1 = r1*s;
            rect2 = 0;
        else
            %decline,truncated after zerocrossing
            t2= tantheta*(s-z);
            tr1= abs(T1)*(z/2);
            tr2 = abs(t2)*((s-z)/2);
            rect1 = 0;
            rect2 = 0;
        end
    else
        z = abs(T2)/tantheta;
        if s < z
            %incline,truncated before zerocrossing
            t2 = tantheta * s;
            r2 = abs(T2)-abs(t2);
            tr1= 0;
            tr2= abs(t2)*(s/2);
            rect1 = 0;
            rect2 = r2*s;
        else
            %incline,truncated after zerocrossing
            t1= tantheta*(s-z);
            tr1 = abs(t1)*((s-z)/2);
            tr2 = abs(T2) * (z/2);
            rect1 = 0;
            rect2 = 0;
        end
    end

[area] = ((rect1 + tr1) - (rect2 + tr2));
return

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [area] = rect_tri(v1,v2,step)
    if (abs(v1) > abs(v2))
        T = abs(v1)-abs(v2);
        R = abs(v2);
    else
        T = abs(v2)-abs(v1);
        R = abs(v1);
    end
    rect = R*step;
    tri = T*(step/2);
    if v1 > 0
        area = 1* (rect+tri);
    else
        area = -1 * (rect+tri);
    end
return

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [area] = rect_tri_truncated(v1,v2,step,wend,pent)
    if (abs(v1) > abs(v2))
        T = abs(v1)-abs(v2);
        R = abs(v2);
    else
        T = abs(v2)-abs(v1);
        R = abs(v1);
    end

    tantheta = abs(T)/step;
    s = wend -pent;

    if (v1>0)
        if v1 >v2
        %positive decline
            t = tantheta*s;
            e = abs(T)-abs(t);
            rect = s*R;
            exrect = s*e;
            tri = (s/2)*R;
        else
        %positive incline
            t = tantheta*s;
            rect = s*R;
            exrect = 0;
            tri = (s/2)*R;
        end
    else
       if v1 >v2
        %negative decline
            t = tantheta*s;
            rect = s*R;
            exrect = 0;
            tri = (s/2)*R;
        else
        %negative incline
            t = tantheta*s;
            e = abs(T)-abs(t);
            rect = s*R;
            exrect = s*e;
            tri = (s/2)*R;
        end
    end
    tri = T*(step/2);
    if v1 > 0
        area = 1* (rect+exrect+tri);
    else
        area = -1 * (rect+exrect+tri);
    end
return


% Compute h-step Weisfeiler-Lehman shortest path delta kernel for a set of graphs
% Author: Nino Shervashidze - nino.shervashidze@tuebingen.mpg.de
% Copyright 2010 Nino Shervashidze
% Input: Graphs - a 1xN array of graphs
% 		  Graphs(i).am is the adjacency matrix of the i'th graph,
% 		  Graphs(i).al is the adjacency list of the i'th graph,
%                 Graphs(i).nl.values is a column vector of node
%                 labels for the i'th graph.
%                 Graphs(i).sp (may be missing) is the shortest
%                 path length matrix of the i'th graph
%                 Graphs(i) may have other fields, but they will not be
%                 used here.
%	 h - a natural number: number of iterations of WL
%	 nl - a boolean: 1 if we want to use original node labels, 0 otherwise
%        spprec - a boolean: 1 if shortest paths are precomputed, 0
%        otherwise. Default: 0
% Output: K - a h+1-element cell array of NxN kernel matrices K for
%             each iter = 0,...,h
%         runtime - scalar (total runtime in seconds)

function [K,runtime] = WLspdelta(Graphs,h,nl,spprec)
% THIS SOURCE CODE IS SUPPLIED "AS IS" WITHOUT WARRANTY OF ANY KIND, AND
% ITS AUTHOR AND THE JOURNAL OF MACHINE LEARNING RESEARCH (JMLR) AND
% JMLR'S PUBLISHERS AND DISTRIBUTORS, DISCLAIM ANY AND ALL WARRANTIES,
% INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES OF MERCHANTABILITY
% AND FITNESS FOR A PARTICULAR PURPOSE, AND ANY WARRANTIES OR NON
% INFRINGEMENT. THE USER ASSUMES ALL LIABILITY AND RESPONSIBILITY FOR
% USE OF THIS SOURCE CODE, AND NEITHER THE AUTHOR NOR JMLR, NOR JMLR'S
% PUBLISHERS AND DISTRIBUTORS, WILL BE LIABLE FOR DAMAGES OF ANY KIND
% RESULTING FROM ITS USE. Without limiting the generality of the foregoing,
% neither the author, nor JMLR, nor JMLR's publishers and distributors,
% warrant that the Source Code will be error-free, will operate without
% interruption, or will meet the needs of the user.

N=size(Graphs,2);
Lists = cell(1,N);
K = cell(1,h+1);
if nargin<4 spprec=0; end
n_nodes=0;
% compute adjacency lists and n_nodes, the total number of nodes in the dataset
for i=1:N
  Lists{i}=Graphs(i).al;
  n_nodes=n_nodes+size(Graphs(i).am,1);
end
% compute/copy shortest path matrices
maxpath = 0;
if ~spprec
  disp('computing shortest paths...');
  for i=1:N
    Ds{i}=floydwarshall(Graphs(i).am);
    aux=max(Ds{i}(~isinf(Ds{i})));
    if aux > maxpath
      maxpath=aux;
    end
  end
else
  for i=1:N
    Ds{i}=Graphs(i).sp;
    aux=max(Ds{i}(~isinf(Ds{i})));
    if aux > maxpath
      maxpath=aux;
    end
  end
end
t=cputime; % for measuring runtime

%%% INITIALISATION
% initialize the node labels for each graph with their labels or
% with degrees (for unlabeled graphs).
label_lookup=containers.Map();
label_counter=uint32(1);
% label_lookup is an associative array, which will contain the
% mapping from multiset labels (strings) to short labels (integers)
if nl==1
  for i=1:N
    % the type of labels{i} is uint32, meaning that it can only handle
    % 2^32 labels and compressed labels over all iterations. If
    % more is needed, switching (all occurences of uint32) to
    % uint64 is a possibility
    labels{i}=zeros(size(Graphs(i).nl.values,1),1,'uint32');
    for j=1:length(Graphs(i).nl.values)
      str_label=num2str(Graphs(i).nl.values(j));
      % str_label is the node label of the current node of the
      % current graph converted into a string
      if ~isKey(label_lookup, str_label)
        %str_label
        %label_counter
        label_lookup(str_label)=label_counter;
        labels{i}(j)=label_counter;
        label_counter=label_counter+1;
      else
        labels{i}(j)=label_lookup(str_label);
      end
    end
  end
else
  for i=1:N
    labels{i}=uint32(full(sum(Graphs(i).am,2)));
    for j=1:length(labels{i})
      str_label=num2str(labels{i}(j));
      % str_label is the node label of the current node of the
      % current graph converted into a string
      if ~isKey(label_lookup, str_label)
        label_lookup(str_label)=label_counter;
        labels{i}(j)=label_counter;
        label_counter=label_counter+1;
      else
        labels{i}(j)=label_lookup(str_label);
      end
    end
  end
end
L=double(label_counter)-1;
clear Graphs;
disp(['Number of original labels: ',num2str(L)]);
disp(['Number of potential shortest path features: ',num2str((maxpath+1)*L*(L+1)/2)]);
sp=sparse((maxpath+1)*L*(L+1)/2,N);
for i=1:N
  labels_aux=repmat(double(labels{i}),1,length(labels{i}));
  a=min(labels_aux, labels_aux');
  b=max(labels_aux, labels_aux');
  I=triu(~(isinf(Ds{i})));
  Ind=Ds{i}(I)*L*(L+1)/2+(a(I)-1).*(2*L+2-a(I))/2+b(I)-a(I)+1;
  minind=min(Ind);
  diff=max(Ind)-minind;
  aux=accumarray(Ind,ones(nnz(I),1),[],[],[],(minind > 5000 || diff > 3000));
  % sparse of full accumarray depending on the range of values in Ind
  % (and based on empirical observations on the speed of accumarray)
  sp(Ind,i)=aux(Ind);
end
sp=sp(sum(sp,2)~=0,:);
K{1}=full(sp'*sp);

%%% MAIN LOOP
iter=1;
new_labels=labels;
while iter<=h
  disp(['iter=',num2str(iter)]);
  % create an empty lookup table
  label_lookup=containers.Map();
  label_counter=uint32(1);
  for i=1:N
    for v=1:length(Lists{i})
      % form a multiset label of the node v of the i'th graph
      % and convert it to a string
      long_label=[labels{i}(v), sort(labels{i}(Lists{i}{v}))'];
      long_label_2bytes=typecast(long_label,'uint16');
      long_label_string=char(long_label_2bytes);
      % if the multiset label has not yet occurred, add it to the
      % lookup table and assign a number to it
      if ~isKey(label_lookup, long_label_string)
        label_lookup(long_label_string)=label_counter;
        new_labels{i}(v)=label_counter;
        label_counter=label_counter+1;
      else
        new_labels{i}(v)=label_lookup(long_label_string);
      end
    end
  end
  L=double(label_counter)-1;
  disp(['Number of compressed labels: ',num2str(L)]);
  disp(['Number of potential shortest path features: ',num2str((maxpath+1)*L*(L+1)/2)]);
  labels=new_labels;
  sp=sparse((maxpath+1)*L*(L+1)/2,N);
  for i=1:N
    labels_aux=repmat(double(labels{i}),1,length(labels{i}));
    a=min(labels_aux, labels_aux');
    b=max(labels_aux, labels_aux');
    I=triu(~(isinf(Ds{i})));
    Ind=Ds{i}(I)*L*(L+1)/2+(a(I)-1).*(2*L+2-a(I))/2+b(I)-a(I)+1;
    minind=min(Ind);
    diff=max(Ind)-minind;
    aux=accumarray(Ind,ones(nnz(I),1),[],[],[],(minind > 5000 || diff > 3000));
    % sparse of full accumarray depending on the range of values in Ind
    % (and based on empirical observations on the speed of accumarray)
    sp(Ind,i)=aux(Ind);
  end
  sp=sp(sum(sp,2)~=0,:);
  K{iter+1}=K{iter}+full(sp'*sp);
  iter=iter+1;
end
runtime=cputime-t; % computation time of K
end

function [D] = floydwarshall(A, sym, w)
% Input: A - nxn adjacency matrix,
%           sym - boolean, 1 if A and w symmetric
%	    w - nxn weight matrix
% Output: D - nxn distance matrix

n = size(A,1); % number of nodes
D=zeros(n,n);

if nargin<2 % if the graph is not weighted and we have no information about sym, then
  sym=1;
  w=A;
end

if nargin<3 % if the graph is not weighted, then
  w=A;
end

D=w.*A;
D(A+diag(repmat(Inf,n,1))==0)=Inf;
D=full(D.*(ones(n)-eye(n))); % set the diagonal to zero

if sym % then it is a bit faster
  for k=1:n
    Daux=repmat(full(D(:,k)),1,n);
    Sumdist=Daux+Daux';
    D(Sumdist<D)=Sumdist(Sumdist<D);
  end
else
  for k=1:n
    Daux1=repmat(full(D(:,k)),1,n);
    Daux2=repmat(full(D(k,:)),n,1);
    Sumdist=Daux1+Daux2;
    D(Sumdist<D)=Sumdist(Sumdist<D);
  end
end
end


function [ a, ipvt, info ] = chifa ( a, lda, n )

%*****************************************************************************80
%
%% CHIFA factors a complex hermitian matrix.
%
%  Discussion:
%
%    CHIFA performs the factoring by elimination with symmetric pivoting.
%
%    To solve A*X = B, follow CHIFA by CHISL.
%
%    To compute inverse(A)*C, follow CHIFA by CHISL.
%
%    To compute determinant(A), follow CHIFA by CHIDI.
%
%    To compute inertia(A), follow CHIFA by CHIDI.
%
%    To compute inverse(A), follow CHIFA by CHIDI.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    13 May 2007
%
%  Author:
%
%    MATLAB version by John Burkardt
%
%  Reference:
%
%    Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
%    LINPACK User's Guide,
%    SIAM, (Society for Industrial and Applied Mathematics),
%    3600 University City Science Center,
%    Philadelphia, PA, 19104-2688.
%
%  Parameters:
%
%    Input, complex A(LDA,N); the hermitian matrix to be factored.
%
%    Input, integer LDA, the leading dimension of A.
%
%    Input, integer N, the order of the matrix.
%
%    Output, complex A(LDA,N); a block diagonal matrix and the multipliers which
%    were used to obtain it.  The factorization can be written
%    A = U*D*hermitian(U) where U is a product of permutation and unit upper
%    triangular matrices, hermitian(U) is the conjugate transpose of U, and
%    D is block diagonal with 1 by 1 and 2 by 2 blocks.  Only the diagonal
%    and upper triangle are used.
%
%    Output, integer IPVT(N), the pivot indices.
%
%    Output, integer INFO.
%    0, normal value.
%    K, if the K-th pivot block is singular.  This is not an error condition
%    for this subroutine, but it does indicate that CHISL or CHIDI may
%    divide by zero if called.
%

%
%  Initialize.
%
%  ALPHA is used in choosing pivot block size.
%
  alpha = ( 1.0 + sqrt ( 17.0 ) ) / 8.0;

  info = 0;
%
%  Main loop on K, which goes from N to 1.
%
  k = n;

  while ( 1 )
%
%  Leave the loop if K = 0 or K = 1.
%
    if ( k == 0 )
      break
    end

    if ( k == 1 )
      ipvt(1) = 1;
      if ( cabs1 ( a(1,1) ) == 0.0 )
        info = 1;
      end
      break
    end
%
%  This section of code determines the kind of
%  elimination to be performed.  When it is completed,
%  KSTEP will be set to the size of the pivot block, and
%  SWAP will be set to TRUE if an interchange is
%  required.
%
    km1 = k - 1;
    absakk = cabs1 ( a(k,k) );
%
%  Determine the largest off-diagonal element in column K.
%
    imax = icamax ( k-1, a(1:k-1,k), 1 );
    colmax = cabs1 ( a(imax,k) );

    if ( alpha * colmax <= absakk )

      kstep = 1;
      swap = 0;

    else
%
%  Determine the largest off-diagonal element in row IMAX.
%
      rowmax = 0.0;

      for j = imax + 1 : k
        rowmax = max ( rowmax, cabs1 ( a(imax,j) ) );
      end

      if ( imax ~= 1 )
        jmax = icamax ( imax-1, a(1:imax-1,imax), 1 );
        rowmax = max ( rowmax, cabs1 ( a(jmax,imax) ) );
      end

      if ( alpha * rowmax <= cabs1 ( a(imax,imax) )  )
        kstep = 1;
        swap = 1;
      elseif ( alpha * colmax * ( colmax / rowmax ) <= absakk )
        kstep = 1;
        swap = 0;
      else
        kstep = 2;
        swap = ( imax ~= km1 );
      end

    end
%
%  Column K is zero.  Set INFO and iterate the loop.
%
    if ( max ( absakk, colmax ) == 0.0 )
      ipvt(k) = k;
      info = k;
      k = k - kstep;
      continue
    end

    if ( kstep ~= 2 )
%
%  1 x 1 pivot block.
%
      if ( swap )

        temp           = a(1:imax,imax);
        a(1:imax,imax) = a(1:imax,k);
        a(1:imax,k)    = temp;

        for jj = imax : k
          j = k + imax - jj;
          t         = conj ( a(j,k) );
          a(j,k)    = conj ( a(imax,j) );
          a(imax,j) = t;
        end

      end
%
%  Perform the elimination.
%
      for jj = 1 : km1
        j = k - jj;
        mulk = -a(j,k) / a(k,k);
        t = conj ( mulk );
        a(1:j,j) = a(1:j,j) + t * a(1:j,k);
        a(j,j) = real ( a(j,j) );
        a(j,k) = mulk;
      end
%
%  Set the pivot array.
%
      ipvt(k) = k;

      if ( swap )
        ipvt(k) = imax;
      end

    else
%
%  2 x 2 pivot block.
%
      if ( swap )

        temp           = a(1:imax,imax);
        a(1:imax,imax) = a(1:imax,k-1);
        a(1:imax,k-1)  = temp;

        for jj = imax : km1
          j = km1 + imax - jj;
          t         = conj ( a(j,k-1) );
          a(j,k-1)  = conj ( a(imax,j) );
          a(imax,j) = t;
        end

        t         = a(k-1,k);
        a(k-1,k)  = a(imax,k);
        a(imax,k) = t;

      end
%
%  Perform the elimination.
%
      km2 = k - 2;

      if ( 0 < k - 2 )

        ak = a(k,k) / a(k-1,k);
        akm1 = a(k-1,k-1) / conj ( a(k-1,k) );
        denom = 1.0 - ak * akm1;

        for jj = 1 : k - 2

          j = km1 - jj;
          bk = a(j,k) / a(k-1,k);
          bkm1 = a(j,k-1) / conj ( a(k-1,k) );
          mulk = ( akm1 * bk - bkm1 ) / denom;
          mulkm1 = ( ak * bkm1 - bk ) / denom;
          t = conj ( mulk );
          a(1:j,j) = a(1:j,j) + t * a(1:j,k);
          t = conj ( mulkm1 );
          a(1:j,j) = a(1:j,j) + t * a(1:j,k-1);
          a(j,k) = mulk;
          a(j,k-1) = mulkm1;
          a(j,j) = real ( a(j,j) );

        end

      end
%
%  Set the pivot array.
%
      if ( swap )
        ipvt(k) = -imax;
      else
        ipvt(k) = 1 - k;
      end

      ipvt(k-1) = ipvt(k);

    end

    k = k - kstep;

  end

  return
end


function value = r8_sign_match ( r1, r2 )

%*****************************************************************************80
%
%% R8_SIGN_MATCH is TRUE if two R8's are of the same sign.
%
%  Discussion:
%
%    This test could be coded numerically as
%
%      if ( 0 <= r1 * r2 ) then ...
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 April 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real R1, R2, the values to check.
%
%    Output, logical VALUE, is TRUE if ( R1 <= 0 and R2 <= 0 )
%    or ( 0 <= R1 and 0 <= R2 ).
%
  value = ( r1 <= 0.0 && r2 <= 0.0 ) || ( 0.0 <= r1 && 0.0 <= r2 );

  return
end


classdef ABC < ALGORITHM
% <single> <real/integer> <large/none> <constrained/none>
% Artificial bee colony algorithm
% limit --- 20 --- The number of trials for releasing a food source

%------------------------------- Reference --------------------------------
% D. Karaboga, An idea based on honey bee swarm for numerical optimization,
% Erciyes University, Tech. Rep. tr06, 2005.
%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    methods
        function main(Algorithm,Problem)
            %% Parameter setting
            limit = Algorithm.ParameterSet(20);

            %% Generate random population
            Population = Problem.Initialization();
            Limit      = zeros(1,Problem.N);

            %% Optimization
            while Algorithm.NotTerminated(Population)
                % Employed bees
                Pdec      = Population.decs;
                Odec      = Pdec + (rand(size(Pdec))*2-1).*(Pdec-Pdec(randi(end,1,end),:));
                Offspring = Problem.Evaluation(Odec);
                replace             = FitnessSingle(Population) > FitnessSingle(Offspring);
                Population(replace) = Offspring(replace);
                Limit(~replace)     = Limit(~replace) + 1;

                % Onlooker bees
                Q         = RouletteWheelSelection(Problem.N,exp(Population.objs/mean(abs(Population.objs+1e-6))));
                Pdec      = Population.decs;
                Odec      = Pdec(Q,:) + (rand(size(Pdec))*2-1).*(Pdec(Q,:)-Pdec(randi(end,1,end),:));
                Offspring = Problem.Evaluation(Odec);
                replace             = FitnessSingle(Population) > FitnessSingle(Offspring);
                Population(replace) = Offspring(replace);
                Limit(~replace)     = Limit(~replace) + 1;

                % Scout bees
                Q = Limit > limit;
                if any(Q)
                    Population(Q) = Problem.Initialization(sum(Q));
                    Limit(Q)      = 0;
                end
            end
        end
    end
end


function out = EN_DistributionEntropy(y,histOrKS,numBins,olremp)
% EN_DistributionEntropy    Distributional entropy.
%
% Estimates of entropy from the distribution of a data vector. The
% distribution is estimated either using a histogram with numBins bins, or as a
% kernel-smoothed distribution, using the ksdensity function from Matlab's
% Statistics Toolbox with width parameter, w (specified as the iunput numBins).
%
% An optional additional parameter can be used to remove a proportion of the
% most extreme positive and negative deviations from the mean as an initial
% pre-processing.
%
%---INPUTS:
%
% y, the input time series
%
% histOrKS: 'hist' for histogram, or 'ks' for ksdensity
%
% numBins: (*) (for 'hist'): an integer, uses a histogram with that many bins
%          (*) (for 'ks'): a positive real number, for the width parameter for
%                       ksdensity (can also be empty for default width
%                                       parameter, optimum for Gaussian)
%
% olremp [opt]: the proportion of outliers at both extremes to remove
%               (e.g., if olremp = 0.01; keeps only the middle 98% of data; 0
%               keeps all data. This parameter ought to be less than 0.5, which
%               keeps none of the data).
%               If olremp is specified, returns the difference in entropy from
%               removing the outliers.

% ------------------------------------------------------------------------------
% Copyright (C) 2020, Ben D. Fulcher <ben.d.fulcher@gmail.com>,
% <http://www.benfulcher.com>
%
% If you use this code for your research, please cite the following two papers:
%
% (1) B.D. Fulcher and N.S. Jones, "hctsa: A Computational Framework for Automated
% Time-Series Phenotyping Using Massive Feature Extraction, Cell Systems 5: 527 (2017).
% DOI: 10.1016/j.cels.2017.10.001
%
% (2) B.D. Fulcher, M.A. Little, N.S. Jones, "Highly comparative time-series
% analysis: the empirical structure of time series and their methods",
% J. Roy. Soc. Interface 10(83) 20130048 (2013).
% DOI: 10.1098/rsif.2013.0048
%
% This function is free software: you can redistribute it and/or modify it under
% the terms of the GNU General Public License as published by the Free Software
% Foundation, either version 3 of the License, or (at your option) any later
% version.
%
% This program is distributed in the hope that it will be useful, but WITHOUT
% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
% FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
% details.
%
% You should have received a copy of the GNU General Public License along with
% this program. If not, see <http://www.gnu.org/licenses/>.
% ------------------------------------------------------------------------------

doPlot = 0; % plot outputs to figure

% ------------------------------------------------------------------------------
%% Check inputs
% ------------------------------------------------------------------------------
if nargin < 2 || isempty(histOrKS)
    histOrKS = 'hist'; % use histogram by default
end
if nargin < 3 % (can be empty for default width for ksdensity)
    numBins = 10; % use 10 bins
end
if nargin < 4
    olremp = 0;
end

% ------------------------------------------------------------------------------
% (1) Remove outliers?
% ------------------------------------------------------------------------------
if olremp ~= 0
    yHat = y(y >= quantile(y,olremp) & y <= quantile(y,1-olremp));
    if isempty(yHat)
        % removed the entire time series?!
        % shouldn't be possible for good values of olremp with equality
        % in the above inequalities
        out = NaN; return
    else
        % Return the difference in entropy from removing outliers
        out = EN_DistributionEntropy(y,histOrKS,numBins) - ...
                EN_DistributionEntropy(yHat,histOrKS,numBins);
        return
    end
end

% ------------------------------------------------------------------------------
% (2) Form the histogram
% ------------------------------------------------------------------------------
switch histOrKS
case 'hist' % Use histogram to calculate pdf
    if isnumeric(numBins)
        [px,binEdges] = histcounts(y,numBins,'Normalization','probability');
    else
        [px,binEdges] = histcounts(y,'BinMethod',numBins,'Normalization','probability');
    end
    % Compute bin centers:
    xr = mean([binEdges(1:end-1); binEdges(2:end)]);
    % Compute bin widths:
    binWidths = diff(binEdges);

case 'ks' % Use ksdensity to calculate pdf
    if isempty(numBins)
        [px, xr] = ksdensity(y,'function','pdf'); % selects optimal width
    else
        [px, xr] = ksdensity(y,'width',numBins,'function','pdf'); % uses specified width
    end
    binWidths = ones(1,length(px))*(xr(2)-xr(1));

otherwise
    error('Unknown distribution method -- specify ''ks'' or ''hist''') % error; must specify 'ks' or 'hist'
end

if doPlot
    figure('color','w'); box('on');
    plot(xr,px,'k')
end

% ------------------------------------------------------------------------------
% (3) Compute the entropy sum and return it as output
% ------------------------------------------------------------------------------
% 0*log0 = 0:
out = -sum(px(px>0).*log(px(px>0)./binWidths(px>0)));

end


function []=stvoldisp(beta_median,beta_std,beta_lbound,beta_ubound,sigma_median,sigma_t_median,sigma_t_lbound,sigma_t_ubound,gamma_median,X,Y,n,m,p,k,T,stvol,bex,ar,lambda1,lambda2,lambda3,lambda4,lambda5,gamma,alpha0,delta0,gamma0,zeta0,IRFt,const,endo,exo,startdate,enddate,stringdates1,decimaldates1,pref,PriorExcel)

% before displaying and saving the results, start estimating the evaluation measures for the model

% obtain first a point estimate betatilde of the VAR coefficients
% this is simply the median
betatilde=beta_median;
Btilde=reshape(betatilde,k,n);
% use this estimate to produce predicted values for the model, following (a.8.2)
Ytilde=X*Btilde;
% then produce the corresponding residuals, using (a.8.3)
EPStilde=Y-Ytilde;

% check first whether the model is stationary, using (a.7.2)
[stationary eigmodulus]=bear.checkstable(betatilde,n,p,k);

% Compute then the sum of squared residuals
% compute first the RSS matrix, defined in (a.8.4)
RSS=EPStilde'*EPStilde;
% retain only the diagonal elements to get the vector of RSSi values
rss=diag(RSS);

% Go on calculating R2
% generate Mbar
Mbar=eye(T)-ones(T,T)/T;
% then compute the TSS matrix, defined in (a.8.7)
TSS=Y'*Mbar*Y;
% generate the R2 matrix in (a.8.8)
R2=eye(n)-RSS./TSS;
% retain only the diagonal elements to get the vector of R2 values
r2=diag(R2);

% then calculate the adjusted R2, using (a.8.9)
R2bar=eye(n)-((T-1)/(T-k))*(eye(n)-R2);
% retain only the diagonal elements to get the vector of R2bar values
r2bar=diag(R2bar);

% now start displaying and saving the results

% preliminary task: create and open the txt file used to save the results

filelocation=fullfile(pref.results_path, [pref.results_sub '.txt']);
fid=fopen(filelocation,'wt');

% print toolbox header

fprintf('%s\n','');
fprintf(fid,'%s\n','');

% print the list of contributors
bear.printcontributors(fid);

% print then estimation results

fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');

toolboxinfo='BEAR toolbox estimates';
fprintf('%s\n',toolboxinfo);
fprintf(fid,'%s\n',toolboxinfo);

time=clock;
datestring=datestr(time);
dateinfo=['Date: ' datestring(1,1:11) '   Time: ' datestring(1,13:17)];
fprintf('%s\n',dateinfo);
fprintf(fid,'%s\n',dateinfo);

fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');

VARtypeinfo='Stochastic volatility BVAR';
fprintf('%s\n',VARtypeinfo);
fprintf(fid,'%s\n',VARtypeinfo);

if stvol==1
    modelinfo='Stochastic volatility model: standard';
elseif stvol==2
    modelinfo='Stochastic volatility model: random inertia';
elseif stvol==3
    modelinfo='Stochastic volatility model: large BVAR';
end
fprintf('%s\n',modelinfo);
fprintf(fid,'%s\n',modelinfo);

if IRFt==1
    SVARinfo='structural decomposition: none';
elseif IRFt==2
    SVARinfo='structural decomposition: choleski factorisation';
elseif IRFt==3
    SVARinfo='structural decomposition: triangular factorisation';
elseif IRFt==4
    SVARinfo='structural decomposition: sign restrictions';
end
fprintf('%s\n',SVARinfo);
fprintf(fid,'%s\n',SVARinfo);

temp='endogenous variables: ';
for ii=1:n
    temp=[temp ' ' endo{ii,1} ' '];
end
endoinfo=temp;
fprintf('%s\n',endoinfo);
fprintf(fid,'%s\n',endoinfo);

temp='exogenous variables: ';
if const==0 && m==0
    temp=[temp ' none'];
elseif const==1 && m==1
    temp=[temp ' constant '];
elseif const==0 && m>0
    for ii=1:m-1
        temp=[temp ' ' exo{ii,1} ' '];
    end
elseif const==1 && m>1
    temp=[temp ' constant '];
    for ii=1:m-1
        temp=[temp ' ' exo{ii,1} ' '];
    end
end
exoinfo=temp;
fprintf('%s\n',exoinfo);
fprintf(fid,'%s\n',exoinfo);

sampledateinfo=['estimation sample: ' startdate '-' enddate];
fprintf('%s\n',sampledateinfo);
fprintf(fid,'%s\n',sampledateinfo);

samplelengthinfo=['sample size (omitting initial conditions): ' num2str(T)];
fprintf('%s\n',samplelengthinfo);
fprintf(fid,'%s\n',samplelengthinfo);

laginfo=['number of lags included in regression: ' num2str(p)];
fprintf('%s\n',laginfo);
fprintf(fid,'%s\n',laginfo);

if PriorExcel==1
    arprint=[];
    for ii=1:n
        arprint=[arprint num2str(ar(ii,1)) '  '];
    end
    hyperparam2=['autoregressive coefficients (ar):                ' arprint];
else
    hyperparam2=['autoregressive coefficients (ar):                ' num2str(ar(1,1))];
end
fprintf('%s\n',hyperparam2);
fprintf(fid,'%s\n',hyperparam2);

hyperparam3=['overall tightness (lambda1):                    ' num2str(lambda1)];
fprintf('%s\n',hyperparam3);
fprintf(fid,'%s\n',hyperparam3);

if stvol==1||stvol==2
    hyperparam4=['cross-variable weighting (lambda2):             ' num2str(lambda2)];
    fprintf('%s\n',hyperparam4);
    fprintf(fid,'%s\n',hyperparam4);
end

hyperparam5=['lag decay (lambda3):                            ' num2str(lambda3)];
fprintf('%s\n',hyperparam5);
fprintf(fid,'%s\n',hyperparam5);

%hyperparam6=['exogenous variable tightness (lambda4):         ' num2str(lambda4)];
%fprintf('%s\n',hyperparam6);
%fprintf(fid,'%s\n',hyperparam6);

if bex==1
    hyperparam7=['block exogeneity shrinkage (lambda5):           ' num2str(lambda5)];
    fprintf('%s\n',hyperparam7);
    fprintf(fid,'%s\n',hyperparam7);
end

if stvol==1||stvol==3
    hyperparam8=['AR coefficient on residual variance (gamma):    ' num2str(gamma)];
    fprintf('%s\n',hyperparam8);
    fprintf(fid,'%s\n',hyperparam8);
end

hyperparam9=['IG shape on residual variance (alpha0):         ' num2str(alpha0)];
fprintf('%s\n',hyperparam9);
fprintf(fid,'%s\n',hyperparam9);

hyperparam10=['IG scale on residual variance (delta0):         ' num2str(alpha0)];
fprintf('%s\n',hyperparam10);
fprintf(fid,'%s\n',hyperparam10);

if stvol==2
    hyperparam11=['Prior mean on inertia (gamma0):                 ' num2str(gamma)];
    fprintf('%s\n',hyperparam11);
    fprintf(fid,'%s\n',hyperparam11);
end

if stvol==2
    hyperparam12=['Prior variance on inertia (zeta0):              ' num2str(gamma)];
    fprintf('%s\n',hyperparam12);
    fprintf(fid,'%s\n',hyperparam12);
end

% display coefficient estimates

fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');

coeffinfo=['VAR coefficients (beta): posterior estimates'];
fprintf('%s\n',coeffinfo);
fprintf(fid,'%s\n',coeffinfo);

for ii=1:n

    fprintf('%s\n','');
    fprintf(fid,'%s\n','');
    if ii~=1
        fprintf('%s\n','');
        fprintf(fid,'%s\n','');
    end

    endoinfo=['Endogenous: ' endo{ii,1}];
    fprintf('%s\n',endoinfo);
    fprintf(fid,'%s\n',endoinfo);

    coeffheader=fprintf('%25s %15s %15s %15s %15s\n','','Median','St.dev','Low.bound','Upp.bound');
    coeffheader=fprintf(fid,'%25s %15s %15s %15s %15s\n','','Median','St.dev','Low.bound','Upp.bound');

    % handle the endogenous
    for jj=1:n
        for kk=1:p
            values=[beta_median((ii-1)*k+n*(kk-1)+jj,1) beta_std((ii-1)*k+n*(kk-1)+jj,1) beta_lbound((ii-1)*k+n*(kk-1)+jj,1) beta_ubound((ii-1)*k+n*(kk-1)+jj,1)];
            fprintf('%25s %15.3f %15.3f %15.3f %15.3f\n',strcat(endo{jj,1},'(-',int2str(kk),')'),values);
            fprintf(fid,'%25s %15.3f %15.3f %15.3f %15.3f\n',strcat(endo{jj,1},'(-',int2str(kk),')'),values);
        end
    end

    % handle the exogenous
    % if there is no constant:
    if const==0
        % if there is no exogenous at all, obvioulsy, don't display anything
        if m==0
            % if there is no constant but some other exogenous, display them
        else
            for jj=1:m
                values=[beta_median(ii*k-m+jj,1) beta_std(ii*k-m+jj,1) beta_lbound(ii*k-m+jj,1) beta_ubound(ii*k-m+jj,1)];
                fprintf('%25s %15.3f %15.3f %15.3f %15.3f\n',exo{jj,1},values);
                fprintf(fid,'%25s %15.3f %15.3f %15.3f %15.3f\n',exo{jj,1},values);
            end
        end
        % if there is a constant
    else
        % display the results related to the constant
        values=[beta_median(ii*k-m+1,1) beta_std(ii*k-m+1,1) beta_lbound(ii*k-m+1,1) beta_ubound(ii*k-m+1,1)];
        fprintf('%25s %15.3f %15.3f %15.3f %15.3f\n','Constant',values);
        fprintf(fid,'%25s %15.3f %15.3f %15.3f %15.3f\n','Constant',values);
        % if there is no other exogenous, stop here
        if m==1
            % if there are other exogenous, display their results
        else
            for jj=1:m-1
                values=[beta_median(ii*k-m+jj+1,1) beta_std(ii*k-m+jj+1,1) beta_lbound(ii*k-m+jj+1,1) beta_ubound(ii*k-m+jj+1,1)];
                fprintf('%25s %15.3f %15.3f %15.3f %15.3f\n',exo{jj,1},values);
                fprintf(fid,'%25s %15.3f %15.3f %15.3f %15.3f\n',exo{jj,1},values);
            end
        end
    end

    fprintf('%s\n','');
    fprintf(fid,'%s\n','');

    % display evaluation measures
    rssinfo=['Sum of squared residuals: ' num2str(rss(ii,1),'%.2f')];
    fprintf('%s\n',rssinfo);
    fprintf(fid,'%s\n',rssinfo);

    r2info=['R-squared: ' num2str(r2(ii,1),'%.3f')];
    fprintf('%s\n',r2info);
    fprintf(fid,'%s\n',r2info);

    adjr2info=['adj. R-squared: ' num2str(r2bar(ii,1),'%.3f')];
    fprintf('%s\n',adjr2info);
    fprintf(fid,'%s\n',adjr2info);

end

fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');

% display VAR stability results
eigmodulus=reshape(eigmodulus,p,n);
stabilityinfo1=['Roots of the characteristic polynomial (modulus):'];
fprintf('%s\n',stabilityinfo1);
fprintf(fid,'%s\n',stabilityinfo1);
for ii=1:p
    temp=num2str(eigmodulus(ii,1),'%.3f');
    for jj=2:n
        temp=[temp,'  ',num2str(eigmodulus(ii,jj),'%.3f')];
    end
    fprintf('%s\n',temp);
    fprintf(fid,'%s\n',temp);
end
if stationary==1;
    stabilityinfo2=['No root lies outside the unit circle.'];
    stabilityinfo3=['The estimated VAR model satisfies the stability condition'];
    fprintf('%s\n',stabilityinfo2);
    fprintf(fid,'%s\n',stabilityinfo2);
    fprintf('%s\n',stabilityinfo3);
    fprintf(fid,'%s\n',stabilityinfo3);
else
    stabilityinfo2=['Warning: at leat one root lies on or outside the unit circle.'];
    stabilityinfo3=['The estimated VAR model will not be stable'];
    fprintf('%s\n',stabilityinfo2);
    fprintf(fid,'%s\n',stabilityinfo2);
    fprintf('%s\n',stabilityinfo3);
    fprintf(fid,'%s\n',stabilityinfo3);
end

fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');

% display posterior for sigma
sigmainfo1=['sigma (residual covariance matrix): posterior estimates'];
fprintf('%s\n',sigmainfo1);
fprintf(fid,'%s\n',sigmainfo1);
% calculate the (integer) length of the largest number in sigma, for formatting purpose
width=length(sprintf('%d',floor(max(abs(bear.vec(sigma_median))))));
% add a separator, a potential minus sign, and three digits (total=5) to obtain the total space for each entry in the matrix
width=width+5;
for ii=1:n
    temp=[];
    for jj=1:n
        % convert matrix entry into string
        number=num2str(sigma_median(ii,jj),'% .3f');
        % pad potential missing blanks
        while numel(number)<width
            number=[' ' number];
        end
        number=[number '  '];
        temp=[temp number];
    end
    fprintf('%s\n',temp);
    fprintf(fid,'%s\n',temp);
end
% notice about use of long-run values
sigmainfo2=['Note: estimates rely on long-run (homoskedastic) values'];
fprintf('%s\n',sigmainfo2);
fprintf(fid,'%s\n',sigmainfo2);

% display posterior for gamma (if random intertia model)
if stvol==2
    fprintf('%s\n','');
    fprintf(fid,'%s\n','');
    fprintf('%s\n','');
    fprintf(fid,'%s\n','');
    % display posterior for gamma
    gammainfo1=['gamma (autoregressive coefficient on stochastic volatility): posterior estimates'];
    fprintf('%s\n',gammainfo1);
    %fprintf(fid,'%s\n',gammainfo1);
    gammainfo2=[];
    for ii=1:n
        gammainfo2=[gammainfo2 repmat(' ',1,5-numel(ii)) 'gamma' num2str(ii)];
    end
    fprintf('%s\n',gammainfo2);
    %fprintf(fid,'%s\n',gammainfo2);
    gammainfo3=[];
    for ii=1:n
        % convert matrix entry into string
        temp=num2str(gamma_median(1,ii),'% .3f');
        % pad potential missing blanks and complete
        temp=[repmat(' ',1,10-numel(temp)) temp];
        gammainfo3=[gammainfo3 temp];
    end
    fprintf('%s\n',gammainfo3);
    %fprintf(fid,'%s\n',gammainfo3);
end
fclose(fid);

% Finally, display the results in terms of graph
if pref.plot
    % plot actual vs. fitted
    actualfitted=figure('Tag','BEARresults');
    set(actualfitted,'Color',[0.9 0.9 0.9]);
    set(actualfitted,'name','model estimation: actual vs fitted')
    ncolumns=ceil(n^0.5);
    nrows=ceil(n/ncolumns);
    for ii=1:n
        subplot(nrows,ncolumns,ii)
        hold on
        plot(decimaldates1,Y(:,ii),'Color',[0 0 0],'LineWidth',2);
        plot(decimaldates1,Ytilde(:,ii),'Color',[1 0 0],'LineWidth',2);
        hold off
        set(gca,'XLim',[decimaldates1(1,1) decimaldates1(end,1)],'FontName','Times New Roman');
        title(endo{ii,1},'FontName','Times New Roman','FontSize',10,'FontWeight','normal');
        if ii==1
            plotlegend=legend('actual','fitted');
            set(plotlegend,'FontName','Times New Roman');
        end
    end

    % plot the residuals
    residuals=figure('Tag','BEARresults');
    set(residuals,'Color',[0.9 0.9 0.9]);
    set(residuals,'name','model estimation: residuals')
    for ii=1:n
        subplot(nrows,ncolumns,ii)
        plot(decimaldates1,EPStilde(:,ii),'Color',[0 0 0],'LineWidth',2)
        set(gca,'XLim',[decimaldates1(1,1) decimaldates1(end,1)],'FontName','Times New Roman');
        title(endo{ii,1},'FontName','Times New Roman','FontSize',10,'FontWeight','normal');
    end

    % plot first the time-varying variance and covariance estimates
    varcov=figure('Tag','BEARresults');
    set(varcov,'Color',[0.9 0.9 0.9]);
    set(varcov,'name','model estimation: residual variance and covariance')
    for ii=1:n
        for jj=1:ii
            subplot(n,n,n*(ii-1)+jj)
            hold on
            Xpatch=[decimaldates1' fliplr(decimaldates1')];
            Ypatch=[sigma_t_lbound{ii,jj}' fliplr(sigma_t_ubound{ii,jj}')];
            HDpatch=patch(Xpatch,Ypatch,[0.7 0.78 1]);
            set(HDpatch,'facealpha',0.6);
            set(HDpatch,'edgecolor','none');
            plot(decimaldates1,sigma_t_median{ii,jj},'Color',[0.4 0.4 1],'LineWidth',2);
            plot([decimaldates1(1,1),decimaldates1(end,1)],[0 0],'k--');
            hold off
            set(gca,'XLim',[decimaldates1(1,1) decimaldates1(end,1)],'FontName','Times New Roman');
            % top labels
            if jj==ii
                title(['var(' endo{ii,1} ')'],'FontWeight','normal');
            else
                title(['cov(' endo{jj,1} ',' endo{ii,1} ')'],'FontWeight','normal');
            end
        end
    end

end % pref.plot

% finally, save the results on excel

% compute the cell for actual and fitted
% create the cell that will be saved on excel
afcell={};
% build preliminary elements: space between the tables
vertspace=repmat({''},T+3,1);
% loop over variables (horizontal dimension)
for ii=1:n
    % create cell of actual/fitted for variable ii
    temp=['actual and fitted: ' endo{ii,1}];
    af_i=[temp {''} {''};{''} {''} {''};{''} {'sample'} {'fitted'};stringdates1 num2cell(Y(:,ii)) num2cell(Ytilde(:,ii))];
    afcell=[afcell af_i vertspace];
end
% trim
afcell=afcell(:,1:end-1);
% write in excel
if pref.results==1
    bear.xlswritegeneral(fullfile(pref.results_path, [pref.results_sub '.xlsx']),afcell,'actual fitted','B2');
end

% then compute the cell for the residuals
% create the cell that will be saved on excel
horzspace=repmat({''},1,n);
rescell=[{'residuals'} horzspace;{''} horzspace;{''} endo';stringdates1 num2cell(EPStilde)];
% write in excel
if pref.results==1
    bear.xlswritegeneral(fullfile(pref.results_path, [pref.results_sub '.xlsx']),rescell,'resids','B2');
end

% finally compute the cell for the time varying variance and covariance
% create the cell that will be saved on excel
varcovcell={};
% build preliminary elements: space between the tables
horzspace=repmat({''},2,5*n);
vertspace=repmat({''},T+3,1);
% loop over variables (vertical dimension)
for ii=1:n
    tempcell={};
    % loop over shocks (horizontal dimension)
    for jj=1:ii
        % create cell of hd record for the contribution of shock jj in variable ii fluctuation
        % if a sign restriction identification scheme has been used, use the structural shock labels
        if jj==ii
            temp=['variance of ' endo{ii,1} ' residuals'];
            % otherwise, the shocks are just orthogonalised shocks from the variables: use variable names
        else
            temp=['covariance between ' endo{jj,1} ' and ' endo{ii,1} 'residuals'];
        end
        vc_ij=[temp {''} {''} {''};{''} {''} {''} {''};{''} {'lw. bound'} {'median'} {'up. bound'};stringdates1 num2cell(sigma_t_lbound{ii,jj}) num2cell(sigma_t_median{ii,jj}) num2cell(sigma_t_ubound{ii,jj})];
        tempcell=[tempcell vc_ij vertspace];
    end
    % complete with blanks (for repeated covariance values)
    for jj=1:n-ii
        tempcell=[tempcell cell(T+3,5)];
    end
    varcovcell=[varcovcell;horzspace;tempcell];
end
% trim
varcovcell=varcovcell(3:end,1:end-1);
% write in excel
if pref.results==1
    bear.xlswritegeneral(fullfile(pref.results_path, [pref.results_sub '.xlsx']),varcovcell,'time variation','B2');
end