% MCMCSUMM - Summary Statistics
% Copyright (c) 1998, Harvard University. Full copyright in the file Copyright
%
%   [S] = mcmcsumm(A)
%
% A = r x c x s array of s samples of an r x c matrix of parameters
%
% S = structure containing returned values (mean, median, etc.)
%   select components with S.mean, S.median, etc.
%
% Note: all summary statistics are marginal, there are no multivariate
%   summaries at this time.
%
% These routines use the last dimension of an array as the
% sample index.  So an array with dimension (nr,nc,ns)
% will be a collection of ns samples of an nr by nc matrix of
% parameters.  An array with dimension (nr,nc) will
% be nc samples of an nr-vector of parameters.
% When the summary statistics are calculated, the last dimension
% is dropped.
%
% See also: MCMCTRACE, MCMCLT
%

function [S] = mcmcsumm(A)

if isnan(A),
 S.mean = NaN;
 S.min = NaN;
 S.max = NaN;
 S.std = NaN;
 S.sorted = NaN;
 S.median = NaN;
 S.meanvec = NaN;
 S.cov = NaN;
 S.acf= NaN;
 S.acf10max = NaN;
 S.acf10med = NaN;
 S.gr2 = NaN ;
 S.gr2max = NaN ;
else

dd = size(A) ;
ll = length(dd) ;
if (ll==2),
  aa = reshape(A, [dd(1),1,dd(2)]) ;
else
  aa = A ;
end

[nr,nc,ns] = size(aa) ;

maxlag = min(100,ns-1) ;

Z = zeros(nr,nc,ns) ;
S = struct('mean',Z) ;

S.mean = mean(aa,3) ;
S.min = min(aa,[],3) ;
S.max = max(aa,[],3) ;
S.std = std(aa,0,3) ;
S.sorted = NaN*zeros(nr,nc,ns) ;
S.median = NaN*zeros(nr,nc) ;

tmpvec = reshape(S.mean, nr*nc, 1) ;
sel = ~isnan(tmpvec) ;
S.meanvec = tmpvec(sel,:) ;

aavec = reshape(aa, nr*nc, ns) ;
aavec = aavec(sel,:) ;

if nr>0 & nc>0 & ns>0,
% then there's something to work with

S.cov = cov(aavec') ;

for ir = 1:nr,
for ic = 1:nc,
  xx = reshape(aa(ir,ic,:),1,ns) ;
  S.sorted(ir,ic,:) = sort(xx) ;
  S.median(ir,ic) = median(xx) ;
  xx0 = xx - mean(xx) ;
  if S.max(ir,ic)-S.min(ir,ic) < .0000000001,
    xc = NaN * zeros(1,2*maxlag+1) ;
  else
    xc = xcorr(xx0,xx0,maxlag,'coeff');
  end
  S.acf(ir,ic,:) = [xc(maxlag+(1:(maxlag+1)))] ;
  S.acf1 = S.acf(:,:,2) ;
end
end

if ns>10,
  S.acf10 = S.acf(:,:,11) ;
  tmpacf = reshape(S.acf10,1,nr*nc) ;
  if any(~isnan(tmpacf)),
    tmpacf = tmpacf(~isnan(tmpacf)) ;
    S.acf10max = max(max( tmpacf )) ;
    S.acf10med = median(median( tmpacf )) ;
  else
    S.acf10max = NaN ;
    S.acf10med = NaN ;
  end
else
  S.acf10 = NaN*S.acf(:,:,1) ;
  S.acf10max = NaN ;
  S.acf10med = NaN ;
end

else
  % one of nr nc ns == 0
  S.sorted(:,:,:) = A ;
  S.median = A(:,:,1) ;
  S.acf10max = NaN ;
  S.acf10med = NaN ;
  S.acf = NaN * zeros(nr,nc,maxlag+1) ;
  S.acf1 = S.acf(:,:,2) ;
  S.acf10 = S.acf(:,:,11) ;
  S.cov = A(:,:,1) ;
end

S.gr2 = mcmcgr(A,2) ;
S.gr2max = max(max(S.gr2)) ;

end
% end of NaN branch


%% Analyzing Investment Strategies with CVaR Portfolio Optimization in MATLAB - Reality
%
% Robert Taylor
% The MathWorks, Inc.

% Copyright (C) 2012 The MathWorks, Inc.

%% Introduction

% This script illustates the simulation of a single realization for both uncovered and covered-call
% positions on a common underlying stock price realization obtained from the file
% |BuyWriteTestData.mat|.

%% Generate a Single Realization for Uncovered and Covered-Call Scenarios

% Example:
%	Assume data are sampled at 30-minute intervals over 22 days. Assume that a "year" is 252 days,
%	that a "day" is from 09:30 to 14:00, and that a "period" is 30 minutes. Consequently, a "day"
%	comprises 13 "periods" with 1 + 22*13 samples and the investment period is 22/252 years. Note
%	that the extra sample is the initial price.
%
%	X(1)				40			initial price of stock
%	numel(X)			1 + 22*13	initial price plus 13 30-minute periods in a day for 22 days
%	T					22/252		investment period has 22 days with 252 days in a year
%	volatility			0.35		35% volatility
%
%	initial_equity		1000000		$1 million initial equity invested in stock (25000 shares)
%	distribution		0.10		10% per year distribution
%
%	option_expiration	45/252		option expiration in 45 days
%	risk_free_rate		0.0015		0.15% risk-free rate
%	strike_cushion		0.05		5% strike price "cushion"
%	exercise_likelihood 0.2			probability of exercise if stock price >= strike price

%	stock_cost			0.06		5 c/share txcost + 1 c/share spread
%	option_cost			0.20		20 c/option contract

%	confirmation_delay	2			1 hour delay to confirm option assignment
%	reinvestment_delay	1*13		1 day to reinvest after confirmation of assignment
%	settlement_delay	3*13		3 days to settle after reinvestment

% fund details

distribution = 0.10;

% initial number of shares invested in stock

initial_holdings = 25000;			% initial number of shares

% investment period
%	periodicity is 30-minute periods, 13 periods in a day, 252 days in a year

T = 22/252;							% duration of investment period is 22 days
N = 22*13;							% 22 days x 13 30-minute periods in a day

% stock information

load BuyWriteTestData X				% realization of asset total return prices X

initial_price = X(1);				% initial price
mu = 0.10;							% stock drift
volatility = 0.35;					% stock volatility

initial_equity = initial_holdings*initial_price;

% option information

contract_expiration = 45/252;		% option contract expiration (45 days)
next_contract_expiration = 112/252;	% next option contract expiration (112 days)
risk_free_rate = 0.0015;			% risk-free rate
strike_cushion = 0.05;				% strike price "cushion"
% exercise_likelihood = NaN;		% period probability of exercise if stock price >= strike price
exercise_likelihood = 0.9;			% period probability of exercise if stock price >= strike price

% costs/frictions

stock_cost = 0.06;					% 5 c/share txcost + 1 c/share spread
contract_cost = 0.20;				% 20 c/option contract + 2 c/option contract spread

% delays

confirmation_delay = 2;				% 1 hour delay to confirm option assignment
reinvestment_delay = 1*13;			% 1 day to reinvest after confirmation of assignment
settlement_delay = 3*13;			% 3 days to settle after reinvestment

no_reinvestment = false;			% true if reinvestment not allowed in an investment period
% no_reinvestment = true;			% true if reinvestment not allowed in an investment period
covered_vs_uncovered = false;

% simulate scenarios

[rU, WU, CU, HU] = uncovered_engine(X, T, ...
	initial_equity, distribution, risk_free_rate, stock_cost);

[rC, WC, CC, HC, KC] = covered_engine(X, T, mu, volatility, ...
	initial_equity, distribution, no_reinvestment, covered_vs_uncovered, ...
	strike_cushion, contract_expiration, next_contract_expiration, risk_free_rate, ...
	stock_cost, contract_cost, exercise_likelihood, ...
	confirmation_delay, reinvestment_delay, settlement_delay);

fprintf('Scenario total returns ...\n');
fprintf('  Uncovered  %10.4f  Total return for uncovered strategy\n',rU);
fprintf('  Covered    %10.4f  Total return for covered strategy\n',rC);

fprintf('Mean of total returns ...\n');
fprintf('  Uncovered  %10.4f\n',N*mean(tick2ret(WU)));
fprintf('  Covered    %10.4f\n',N*mean(tick2ret(WC)));

fprintf('Standard deviation of total returns ...\n');
fprintf('  Uncovered  %10.4f\n',sqrt(N)*std(tick2ret(WU)));
fprintf('  Covered    %10.4f\n',sqrt(N)*std(tick2ret(WC)));

fprintf('Maximum drawdown of total returns ...\n');
fprintf('  Uncovered  %10.4f\n',maxdrawdown(WU));
fprintf('  Covered    %10.4f\n',maxdrawdown(WC));

%% Plot Results

t = linspace(0, T*252, N+1);

subplot(2,2,1);
plot(t, [WC/WC(1), WU/WU(1)]);
title('\bfTotal Wealth');
xlabel('Day');
ylabel('Dollars (Millions)');
h = legend('Covered', 'Uncovered', 'Location', 'SouthEast');
set(h, 'FontSize', 7, 'Box', 'off');

subplot(2,2,2);
plot(t, 1.0e-6*CC);
title('\bfCash');
xlabel('Day');
ylabel('Dollars (Millions)');

subplot(2,2,3);
plot(t, 1.0e-3*HC);
title('\bfShares');
xlabel('Day');
ylabel('Shares (Thousands)');

subplot(2,2,4);
plot(t, KC);
title('\bfStrike Price');
xlabel('Day');
ylabel('Dollars');


% The observation function:
%
%               function [F] = g_CaBBI(Xt,Phi,I_inp,inG)
%
% this function maps [Ca2+] kinetics to fluorescence observations (F)
% through a non-linear saturating function

function [F] = g_CaBBI(Xt,Phi,I_inp,inG)

ind = inG.ind;
Ca = Xt(ind);                        % [Ca2+] kinetics
d_F =  Phi(1);                       % offset parameter
Kd =  200;                           % dissociation constant
scale = inG.k_F0*exp(Phi(2));        % scale paraemeter
F =  scale*(Ca/(Ca + Kd)) + d_F;     % nonlinear mapping from [Ca2+] to F

end


function [regression_label] = fast_rcnn_bbox_transform(ex_boxes, gt_boxes)
% [regression_label] = fast_rcnn_bbox_transform(ex_boxes, gt_boxes)
% --------------------------------------------------------
% Fast R-CNN
% Reimplementation based on Python Fast R-CNN (https://github.com/rbgirshick/fast-rcnn)
% Copyright (c) 2015, Shaoqing Ren
% Licensed under The MIT License [see LICENSE for details]
% --------------------------------------------------------

    ex_widths = ex_boxes(:, 3) - ex_boxes(:, 1) + 1;
    ex_heights = ex_boxes(:, 4) - ex_boxes(:, 2) + 1;
    ex_ctr_x = ex_boxes(:, 1) + 0.5 * (ex_widths - 1);
    ex_ctr_y = ex_boxes(:, 2) + 0.5 * (ex_heights - 1);

    gt_widths = gt_boxes(:, 3) - gt_boxes(:, 1) + 1;
    gt_heights = gt_boxes(:, 4) - gt_boxes(:, 2) + 1;
    gt_ctr_x = gt_boxes(:, 1) + 0.5 * (gt_widths - 1);
    gt_ctr_y = gt_boxes(:, 2) + 0.5 * (gt_heights - 1);

    targets_dx = (gt_ctr_x - ex_ctr_x) ./ (ex_widths+eps);
    targets_dy = (gt_ctr_y - ex_ctr_y) ./ (ex_heights+eps);
    targets_dw = log(gt_widths ./ ex_widths);
    targets_dh = log(gt_heights ./ ex_heights);

    regression_label = [targets_dx, targets_dy, targets_dw, targets_dh];
end


function cvt_test02 ( )

%*****************************************************************************80
%
%% CVT_TEST02 repeats test 1, but uses twice as many iterations.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    08 November 2006
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST02\n' );
  fprintf ( 1, '  CVT computes a Centroidal Voronoi Tessellation.\n' );
  fprintf ( 1, '  Repeat test 1, but with twice the number of iterations.\n' );

  dim_num = 2;
  n = 10;
  batch = 1000;
  init = 0;
  init_string = 'uniform';
  it_max = 80;
  it_fixed = 1;
  sample = 0;
  sample_num = 10000;
  sample_string = 'uniform';
  seed = 123456789;
  r = [];

  seed_init = seed;

  [ r, seed, it_num, it_diff, energy ] = cvt ( dim_num, n, batch, init, ...
    sample, sample_num, it_max, it_fixed, seed, r );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Dimension DIM_NUM =        %12d\n', dim_num );
  fprintf ( 1, '  Number of points N =       %12d\n', n );
  fprintf ( 1, '  Initial SEED =             %12d\n', seed_init );
  fprintf ( 1, '  Current SEED =             %12d\n', seed );
  fprintf ( 1, '  INIT =                    "%s".\n', init_string );
  fprintf ( 1, '  Max iterations IT_MAX =    %12d\n', it_max );
  fprintf ( 1, '  IT_FIXED (fixed samples) = %12d\n', it_fixed );
  fprintf ( 1, '  Iterations IT_NUM =        %12d\n', it_num );
  fprintf ( 1, '  Difference IT_DIFF =       %14f\n', it_diff );
  fprintf ( 1, '  CVT ENERGY =               %14f\n', energy );
  fprintf ( 1, '  SAMPLE =                  "%s".\n', sample_string );
  fprintf ( 1, '  Samples SAMPLE_NUM    =    %12d\n', sample_num );
  fprintf ( 1, '  Sampling BATCH size =      %12d\n', batch );
  fprintf ( 1, '  EPSILON (unit roundoff) =  %12e\n', eps );

  r8mat_transpose_print ( dim_num, n, r, '  Generators (rows):' );

  return
end


function a = reduce_rows(a);
% function a = reduce_rows(a);
% reduction of inequalities of the form A*x <= b where a = [A,b] due to redundancies
%   Input:  a ... matrix of size m x n
%   Output: a ... matrix of size ... x n
%   (c) Sebastian Siegel, created: 2005/06/08, last modified: 2005/07/06

[m,n] = size(a);
a = sortrows(a);	% sort rows according to 1., 2., 3., ... column (ascending)
			% purpose: "normalize" according to first column later

% before actually reducing similar rows, let's also check if there are similarities that differ by a factor (therefore "normalize")

nneg = sum(a(:,1)<0);	% count negative entries in first column
nzer = sum(a(:,1)==0);	% count zero entries in first column
npos = sum(a(:,1)>0);	% count positive entries in first column

a = [a a]; % purpose: will work on "normalized" a and original a
% divide according to entries in first column (if not zero):
a(1:nneg,1:n) = a(1:nneg,1:n)./-(a(1:nneg,1)*ones(1,n)); % the negative part
a(nneg+nzer+1:m,1:n) = a(nneg+nzer+1:m,1:n)./(a(nneg+nzer+1:m,1)*ones(1,n)); % the positive part
% now a(:,1:n) is "normalized" and a(:,n+1:2*n) is still the original a

% sort according to "normalized" a
a = sortrows(a,1:n);

% delete similar rows (according to a(:,1:n-1)) => (save the min value of b):
nsimilar = sum(sum((a(1:m-1,1:n-1) == a(2:m,1:n-1)),2)==n-1); % ...
% (a(1:m-1,1:n-1) == a(2:m,1:n-1)) ... similar neighbored rows (disregard
%    column n which represents b) will produce [1 1 1 ...], other have entries with '0'
% sum( expression above ,2) ... add entries in a row
% expression above == n-1 ... test if all entries in a row were 1
% sum( expression above ) ... get the number of similar rows
if nsimilar > 0, % true if redundant rows exist
	a(:,n+1:2*n)=a(:,n+1:2*n).*([1;(1-(sum((a(1:m-1,1:n-1) == ...
	    a(2:m,1:n-1)),2)==n-1))]*ones(1,n)); % ...
	% [1;(1-(sum((a(1:m-1,1:n-1) == a(2:m,1:n-1)),2)==n-1))] ... column vector
	%      where each '0' represents a row which is similar to the one above
	% ( expression above *ones(1,n)) ... expand column vector to matrix where
	%      each row consists of the same entries
	% a(:,n+1:2*n).* expression above ... now each redundant row has entries with %      zeros only in the right half of a
	a = sortrows(a(:,n+1:2*n)); % sort rows according to n+1., n+2., n+3., ...
	%      column (ascending) of a and save result to a
	%      (now a has only n columns again)
	[temp,position]= max(sum(a==zeros(m,n),2)==n); % ...
	% find position of the first redundant row
	a = [a(1:position-1,:); a(position+nsimilar:m,:)]; % assemble a without
	%      redundant rows
else
	a = a(:,n+1:2*n); % reduce a to original part (right half)
end


function [Model, Info] = linear_map_sparse_cov(X,Y,Model,parm)
%  Estimate linear weight matrix for input-output mapping
%     Automatic Relevance Prior for each input dimension
%     is imposed to get sparse weight matrix
%
%   [Model, Info] = linear_map_sparse_cov(X,Y,Model,parm)
%
% --- Input
%  X  : Input data  ( M x T )
%  Y  : Output data ( N x T )
%  N  =  # of output
%  M  =  # of input
%  T  =  # of data
%
%  Model : Structure for estimated model
%  Model.SY0 :  Output data variance                 ( 1 x 1 )
%  Model.A0  :  (Output data var)/(Input data var)   ( 1 x 1 )
%
%  parm  : Structure for learning parameter
%  parm.Ntrain :  # of training
%  parm.Nskip  :  skip # for print
%  parm.a_min  :  Min value for pruning small variance component
%  parm.Prune  :  = 1 : Prune small variance & irrelevant input dimension
%
% --- Output
%  Model : Structure for estimated model
%  Model.SY  :  Noise variance         ( 1 x 1 )
%  Model.SW  :  Weight variance        ( M x M )
%  Model.W   :  Weight matrix          ( N x M )
%  Model.A   :  Prior weight variance  ( N x M ) ARD hyper parameter
%
%  Info  : Structure for learning process history
%  Info.FE  = LP + H : Free energy
%  Info.LP  = - (Log error)
%  Info.H   = - (# of effective weight parameters)
%
% 2007/1/26 Made by M. Sato

% Constants
MINVAL  = 1.0e-15;
MinCond = 1.0e-10;

% # of total training iteration
Ntrain = parm.Ntrain;

Nskip  = 100;   % skip steps for display info
a_min  = 1e-10; % Minimum value for weight pruning
Fdiff  = 1e-10; % Threshold for convergence
Ncheck = 100;   % Minimum number of training iteration
Fstep  = 5;     % Free energy convergence check step
Prune  = 1;     % Prune mode

if isfield(parm,'Nskip'), Nskip  = parm.Nskip; end;
if isfield(parm,'Fdiff'), Fdiff   = parm.Fdiff; end;
if isfield(parm,'a_min'), a_min   = parm.a_min ; end;
if isfield(parm,'Prune'), Prune = parm.Prune; end;
if isfield(parm,'Ncheck'), Ncheck = parm.Ncheck; end
if isfield(parm,'Fstep'),Fstep  = parm.Fstep ; end

% # of embedding dimension
if isfield(parm,'Dtau')
	D    = parm.Dtau;
	tau  = parm.Tau;
else
	D    = 1;
	tau  = 1;
end

% Dimension
[M ,Tx ,Nx ]= size(X); % input dim
[N ,Ty ,Ny ]= size(Y); % output dim

if Nx~=Ny, error('Trial number is different for input & output'); end
if Tx~=Ty, error('Time sample is different for input & output'); end

% Reshape into 2D matrix
T = Tx*Nx; % # of data
X = reshape(X, [M T]);
Y = reshape(Y, [N T]);

% # of stable VB-update in initial training
if isfield(parm,'Npre_train')
	Npre_train = parm.Npre_train;
else
	Npre_train = Ntrain;
end
if Npre_train > Ntrain, Npre_train = Ntrain; end;

fprintf('linear map sparse covariance start\n')
if 0 % hacked TH111005
    fprintf('--- Output Dimension  = %d\n',N)
    fprintf('--- Input  Dimension  = %d\n',M)
    fprintf('--- Embedding  Dimension  = %d\n',D)
    fprintf('--- Number of trials  = %d\n',Nx)
    fprintf('--- Number of training sample = %d\n',Tx)
    fprintf('--- Total update iteration    = %d (%d)\n',Ntrain,Npre_train)
else
    fprintf('---O:%d/I:%d/E:%d/Nt:%d/Ns:%d/Ti:%d(%d)/\n',N,M,D,Nx,Tx,Ntrain,Npre_train)
end
%
% --- Initialization
%  A  : Initial variable to use 1st update
%     : 1 x M

% Input/Output variance
sx = mean(repadd(X, - mean(X,2)).^2, 2);
sy = mean(repadd(Y, - mean(Y,2)).^2, 2);

A0  = 1./mean(sx);
SY0 = mean(sy);

if isempty(Model)
	A   = repmat(A0, [1,M]);
	W   = zeros(N,M);
	SY  = SY0;
else
	A   = Model.A ;	 % 1 x M
	W   = Model.W ;  % N x M
	SY  = mean(Model.SY);  % 1 x 1
end

if isfield(parm,'Ta0') && parm.Ta0 > 0,
	Ta0 = parm.Ta0;
	a0  = parm.a0 * A0;
else
	Ta0 = 0;
	a0  = 1;
end

%  --- Initialization by other method ---
% Model.mode = 'scalar': ARD term = alpha * W^2
% Model.mode = 'cov'   : ARD term = alpha * W^2 * SY(^-1)
%
if isfield(Model, 'mode') &&  strcmp(Model.mode,'scalar')==1,
	fprintf('Old result is used as initial value\n')
	fprintf('Old method = %s\n', Model.method)
	A  = sum(A,1)./(sum(SY));
end

A = max(A,MINVAL);

% Original input dimension
M_ALL = M;

if isfield(Model,'ix_act')
	% Active index
	IX_act = Model.ix_act;

	X = X(IX_act,:); 	% M x T
	M = length(IX_act);
else
	IX_act = 1:M;
end

% Initial active index
M_all  = M;
A_all  = A/max(A) ;
ix_act_old = 1:M;

ix_act = find( A_all > a_min );   % effective indices
Mnew   = length(ix_act);  		% # of effective input

if Mnew < M,
    % convert to relative index
    jx_act = trans_index(ix_act,ix_act_old,M_all);

    M   = Mnew;
    A   = A(jx_act) ;  			% 1 x M
    W   = W(:,jx_act) ;  		% N x M
	X 	= X(jx_act,:);			% M x T
end

% Input covariance
%XX  = (X * X')/T;   	% M x M
%YX  = (Y * X')/T;       % N x M
%YY  = sum(Y.^2,2)/T;    % N x 1

% Covariance matrix (not normalised)
YX  = (Y * X');       % N x M
YY  = sum(Y.^2,2);    % N x 1

if 0 % hacked TH111005
fprintf('a_min = %g\n', a_min)
fprintf('SY0   = %g\n', SY0)
fprintf('SY    = %g\n', SY)
end
% Working variable
if T <= M
	XX = [];
	CC = zeros(T,T);
	SW = zeros(T,T);
else
	XX = (X * X');   	  % M x M
	CC = zeros(M,M);
	SW = zeros(M,M);
end

G_A = zeros(1,M);       % 1 x M
log_a = 0;
A_old = A;

% Free energy histry
FE  = zeros(Ntrain,1);
LP  = zeros(Ntrain,1);
H   = zeros(Ntrain,1);
MM  = zeros(Ntrain,1);
Err = zeros(Ntrain,1);

% ARD hyper param. history
if isfield(parm,'Debug') & ~isempty(parm.Debug) & parm.Debug > 0
	Debug = 1;
	A_tmp = zeros(M_all, ceil(Ntrain/Nskip));
else
	Debug = 0;
end

k_save  = 0;

%%%%%% Learning Loop %%%%%%
for k=1:Ntrain
	% ARD hyper variance parameter
	% A = 1/alpha

	if T < M
	    % Weight variance
	    % inv(X*X' + 1./A) = A - A * X * inv(X'*A*X + 1) * X' * A
		%  C = ( X' *A* X + eye(T) );
		XA = repmultiply(X' , A); % T x M
	    CC = XA * X + eye(T);  % T x T

		% Weight update
	    % inv(X*X' + 1./A) = A - A * X * Cinv * X' * A
		% W0 = YX .* A;
		% W  = W0 - (((W0 * X) * Cinv) * X') .* A;
		% W  = W0 - ((W0 * X) / C ) * XA;
		W  = repmultiply(YX , A);
		XC = X / CC;
		W  = W - (W * XC) * XA;

		%  G_A = diag( X * inv(C) * X' *A )
		%      = diag( (X / C) * X') .*A
		G_A  = A .* sum(X .* XC, 2)';

		% Log variance
		log_sw  = - log_det(CC) ;
		if mod(k, Nskip)==0, fprintf('- '); end
	else
		if isempty(XX)
			% covariance matrix in reduced space
			XX = X * X';
			% save original index
			IX_act = IX_act(ix_act);
			% new active index in reduced space
			ix_act = 1:M;
			M_all  = M;
			A_all  = A;
		end

		% Weight covariance
    	SW  = XX + diag(1./A);

		% Weight update
		W  = YX / SW;

		% SW  = XX + diag(1./A)
		% G_A = diag( XX * inv(SW))
		%     = 1 - diag(inv(SW)) ./A
		G_A = diag( XX /SW )';

		log_sw  = - log_det(SW) - sum(log(A));
		if mod(k, Nskip)==0, fprintf('+ '); end
	end

	WW = sum(W.^2, 1);
    % Noise variance update
    SY = (sum(YY) - sum(sum(W.*YX)))/(N*T);

    if (SY/SY0) <= MINVAL,
	    % Error
	    dY  = Y - W * X;        % N x T
	    dYY = sum(dY.^2, 2);  	% N x 1

	    SY  = (sum(dYY) + sum( WW./A ))/(N*T);
	    % Prevent zero variance
	    SY  = max( SY, MINVAL);
	    fprintf('*')
	end

	% Log variance
    log_sy  = N * log(SY) ;

    if Ta0 > 0,
	    log_a   = Ta0 * sum( - log(A./a0) - a0./A + 1);
	end

    % Free energy
    H(k)   =   0.5*N * (log_sw - M);
    LP(k)  = - 0.5*(T * log_sy) ;
    FE(k)  = LP(k) + H(k);
    Err(k) = (SY)./(SY0);
    MM(k)  = M;

    % Estimation Gain
    %jx_act = find(G_A > a_min);
    G_A = max((G_A), MINVAL);

    % Hyper parameter for weight variance (ARD)
	if k <= Npre_train,
		% VB update rule
		% N * A  = (1./SY)' * (W.^2) + N * (A - A.*G_A)  ;
		% A  = (WW./SY + N * (A - A.*G_A) + 2*Ta0*a0)./( N + 2*Ta0 );
		% A^2 = A .* (WW./SY) ./ (G_A * N);
        try % modified by TH130111
            A2=A;
            A  = sqrt(A.*(WW./SY)./(G_A * N));
        catch
            A=A2;
        end
	else
	    % Accelerated update rule
		%	A  = (1./SY)' * (W.^2) ./ (G_A * N);
	    A  = ((WW./SY) + 2*Ta0*a0)./(G_A * N + 2*Ta0);
	end

    % Prune small variance
    if Prune == 1
	    % Find active input dimension
	    ix_act_old = ix_act;

	    % Recover all component
	    switch	Prune
	    case	1
		    A_all(ix_act) = WW/max(WW);    % Prune by Weight
	    case	2
		    A_all(ix_act) = A /max(A);	   % Prune by Alpha
	    case	3
		    A_all(ix_act) = A * (1/SX);    % Prune by Alpha
	    end

	    % Find active input dimension (absolute index)
	    ix_act = find( A_all > a_min ); % effective indices
	    Mnew   = length(ix_act);  		% # of effective input

	    if Mnew < M,
		    % convert to relative index
		    jx_act = trans_index(ix_act,ix_act_old,M_all);

		    M   = Mnew;
		    A   = A(jx_act) ;  			% 1 x M
		    W   = W(:,jx_act) ;  		% N x M
			X 	= X(jx_act,:);			% M x T
			YX  = YX(:,jx_act);  	 	% N x M
			if ~isempty(XX)
				XX	= XX(jx_act,jx_act);	% M x M
			end
		end
	else
		A = max(A,MINVAL);
    end

    if mod(k, Nskip)==0
        % Save history
		if Debug == 1
        	k_save = k_save + 1;
        	A_tmp(:,k_save) = A_all(:);
		end

        fprintf('Iter = %4d, M = %4d, err = %g, F = %g, H = %g\n', ...
               k, M, Err(k), FE(k), - H(k));
    end

	if k > Ncheck && M == MM(k-1)
		Adif = max(abs(A - A_old));
	else
		Adif = 1;
	end
	if Adif < Fdiff,
		fprintf('Converged : Alpha change = %g\n',Adif)
		break;
	end;

	A_old = A;

%		Fdif = (FE(k) - FE(k-Fstep))/abs(FE(k));
%	else
%		Fdif = Fdiff + 1;
%	end
end

% convert to relative index
ix_act = IX_act(ix_act);

% Active index
Model.ix_act = ix_act;
Model.M_all  = M_ALL ;

% Save trained variable
%  W & A is sufficient for cov-method initialization
Model.A  = A ;
Model.W  = W ;
Model.SY = SY;

Model.method = 'linear_map_sparse_cov';
Model.mode   = 'cov';
Model.sparse = 'sparse';

% Save history
Info.FE  = FE(1:k);
Info.LP  = LP(1:k);
Info.H   = H(1:k) ;
Info.Err = Err(1:k);
Info.M   = MM(1:k);

if exist('A_tmp','var')
	Info.A   = A_tmp(:,1:k_save) ;
end

%%% ---- Index transformation from old active_index to current active_index
function	jx = trans_index(ix,ix_old,M)
% ix = ix_old(jx)

N = length(ix_old);
Itrans = zeros(M,1);
Itrans(ix_old) = 1:N;

jx = Itrans(ix);


function [COU, FA_STD, ADC_STD] = wild_bootstrapping_DTI( I, bval, Mask, Nreps, DT, VectorField )
% WILD_BOOTSTRAPPING_DTI Returns uncertainty measures from diffusion tensor
% images via wild bootstrapping. See Whitcher 2008 - Using the Wild
% Bootstrap to Quantify Uncertainty in Diffusion Tensor Imaging
%
%
% Inputs:
%
%   I is the input image, of any dimensionality, with the diffusion
%   scans in the last dimension
%
%   BVAL is the b-matrix, of size [3 3 N] (same as in fit_DT)
%
%   MASK is the mask of voxels for analysis, same size as the first N-1
%   dimensions of I.
%
%   NREPS is the number of Monte Carlo repetitions (default 1000)
%
%   DT and VectorField are optional - if you have a ground truth that you
%   want to compare against, instead of the input signal.
%
% Outputs:
%
%   COU is the cone of uncertainty (in degrees) (See Jones 2003 -
%   Determining and Visualizing Uncertainty in Estimates of Fiber
%   Orientation From Diffusion Tensor MRI). Here, the 95th percentile is
%   returned. The COU of the second and third eigenvectors is concatenated
%   in the last dimension.
%
%   FA_STD is the standard deviation of the fractional anisotropy over
%   the repetitions
%
%   ADC_STD is the standard deviation of the ADC over the repetitions

% Author: Darryl McClymont <darryl.mcclymont@gmail.com>
% Copyright � 2014 University of Oxford
% Version: 0.1.2
%
% University of Oxford means the Chancellor, Masters and Scholars of
% the University of Oxford, having an administrative office at
% Wellington Square, Oxford OX1 2JD, UK.
%
% This file is part of Gerardus.
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details. The offer of this
% program under the terms of the License is subject to the License
% being interpreted in accordance with English Law and subject to any
% action against the University of Oxford being under the jurisdiction
% of the English Courts.
%
% You should have received a copy of the GNU General Public License
% along with this program.  If not, see <http://www.gnu.org/licenses/>.

% check arguments
narginchk(2,6);
nargoutchk(0, 3);

sz = size(I);

if nargin < 3
    Mask = ones(sz(1:end-1));
end

if nargin < 4
    Nreps = 1000;
end

% save memory and time by fitting in vector form
I = reshape(I, [prod(sz(1:end-1)), sz(end)]);

if isscalar(Mask)
    Mask = I(:,1) >= Mask;
end

Ivector = I(Mask(:), :);

% if we haven't been given a ground truth, fit the tensor
if nargin < 5
    [DT, ~, ~, VectorField, ~] = fit_DT(Ivector, bval);
end

% Model fitted image
Ifit = dt2image(DT, bval);
% Residuals
Resids = Ivector - Ifit;

% DT_reps = zeros([size(DT), Nreps]);
% FA_reps = zeros([size(FA), Nreps]);
% ADC_reps = zeros([size(ADC), Nreps]);
% VectorField_reps = zeros([size(VectorField), Nreps]);
% EigVals_reps = zeros([size(EigVals), Nreps]);

% for N iterations, randomly multiply the residuals by 1 or -1 and compute
% parameters
for n = Nreps:-1:1
    if rem(n, 10) == 0
        fprintf('%d, ', n);
    end

    % either 1 or -1, with 50% probability each (Rademacher)
    F = rand(size(Resids)) > 0.5;
    F = F * 2 - 1;

    Resids_to_add = Resids .* F;

    Inew = Ifit + Resids_to_add;

    [~, FA2, ADC2, VectorField2, ~] = fit_DT(Inew, bval);

    VectorField2 = real(VectorField2);

    %DT_reps(:,:,n) = DT2;
    FA_reps(:,1,n) = FA2;
    ADC_reps(:,1,n) = ADC2;
    VectorField_reps(:,:,:,n) = VectorField2;
    %EigVals_reps(:,:,n) = EigVals2;

end

fprintf('done.\n')

FA_STD = zeros(size(Mask));
FA_STD(Mask) = std(FA_reps, [], 3);

ADC_STD = zeros(size(Mask));
ADC_STD(Mask) = std(ADC_reps, [], 3);

% angle between original data and bootstrapped data
Angle_deviation_primary = zeros(size(FA_reps));
Angle_deviation_secondary = zeros(size(FA_reps));
Angle_deviation_tertiary = zeros(size(FA_reps));

for n = 1:Nreps
    % primary eigenvectors
    v1 = real(squeeze(VectorField(:,:,1)));
    v2 = real(squeeze(VectorField_reps(:,:,1,n)));

    % ensure unit magnitude
    v1 = bsxfun(@rdivide, v1, sqrt(sum(v1.^2, 2))+eps);
    v2 = bsxfun(@rdivide, v2, sqrt(sum(v2.^2, 2))+eps);

    theta = dot(v1, v2, 2);
    Angle_deviation_primary(:,1,n) = acos(theta) / pi * 180;

    % secondary eigenvectors
    v1 = real(squeeze(VectorField(:,:,2)));
    v2 = real(squeeze(VectorField_reps(:,:,2,n)));

    % ensure unit magnitude
    v1 = bsxfun(@rdivide, v1, sqrt(sum(v1.^2, 2))+eps);
    v2 = bsxfun(@rdivide, v2, sqrt(sum(v2.^2, 2))+eps);

    theta = dot(v1, v2, 2);
    Angle_deviation_secondary(:,1,n) = acos(theta) / pi * 180;

    % tertiary eigenvectors
    v1 = real(squeeze(VectorField(:,:,3)));
    v2 = real(squeeze(VectorField_reps(:,:,3,n)));

    % ensure unit magnitude
    v1 = bsxfun(@rdivide, v1, sqrt(sum(v1.^2, 2))+eps);
    v2 = bsxfun(@rdivide, v2, sqrt(sum(v2.^2, 2))+eps);

    theta = dot(v1, v2, 2);
    Angle_deviation_tertiary(:,1,n) = acos(theta) / pi * 180;

end

% bigger than 90 degrees? flip it over
Angle_deviation_primary(Angle_deviation_primary > 90) = 180 - Angle_deviation_primary(Angle_deviation_primary > 90);
Angle_deviation_secondary(Angle_deviation_secondary > 90) = 180 - Angle_deviation_secondary(Angle_deviation_secondary > 90);
Angle_deviation_tertiary(Angle_deviation_tertiary > 90) = 180 - Angle_deviation_tertiary(Angle_deviation_tertiary > 90);

% 95th percentile
COU_primary = zeros(size(Mask));
COU_primary(Mask) = prctile(Angle_deviation_primary, 95, 3);
COU_secondary = zeros(size(Mask));
COU_secondary(Mask) = prctile(Angle_deviation_secondary, 95, 3);
COU_tertiary = zeros(size(Mask));
COU_tertiary(Mask) = prctile(Angle_deviation_tertiary, 95, 3);

n = ndims(COU_primary);
if (n == 2) && (size(COU_primary,2) == 1), n = 1; end % ndims gives a vector 2

COU = cat(n+1, COU_primary, COU_secondary, COU_tertiary);


function [lat, lon, azi, rk] = cassini_inv(lat0, lon0, x, y, ellipsoid)
%CASSINI_INV  Inverse Cassini-Soldner projection
%
%   [LAT, LON] = CASSINI_INV(LAT0, LON0, X, Y)
%   [LAT, LON, AZI, RK] = CASSINI_INV(LAT0, LON0, X, Y, ELLIPSOID)
%
%   performs the inverse Cassini-Soldner projection of points (X,Y) to
%   (LAT,LON) using (LAT0,LON0) as the center of projection.  These input
%   arguments can be scalars or arrays of equal size.  The ELLIPSOID vector
%   is of the form [a, e], where a is the equatorial radius in meters, e is
%   the eccentricity.  If ellipsoid is omitted, the WGS84 ellipsoid (more
%   precisely, the value returned by DEFAULTELLIPSOID) is used.  GEODPROJ
%   defines the projection and gives the restrictions on the allowed ranges
%   of the arguments.  The forward projection is given by CASSINI_FWD.
%
%   AZI and RK give metric properties of the projection at (LAT,LON); AZI
%   is the azimuth of the easting (X) direction and RK is the reciprocal of
%   the northing (Y) scale.  The scale in the easting direction is 1.
%
%   LAT0, LON0, LAT, LON, AZI are in degrees.  The projected coordinates X,
%   Y are in meters (more precisely the units used for the equatorial
%   radius).  RK is dimensionless.
%
%   This routine depends on the MATLAB File Exchange package "Geodesics on
%   an ellipsoid of revolution":
%
%     http://www.mathworks.com/matlabcentral/fileexchange/39108
%
%   See also GEODPROJ, CASSINI_FWD, GEODRECKON, DEFAULTELLIPSOID.

% Copyright (c) Charles Karney (2012) <charles@karney.com>.
%
% This file was distributed with GeographicLib 1.29.

  if nargin < 4, error('Too few input arguments'), end
  if nargin < 5, ellipsoid = defaultellipsoid; end
  try
    [~] = lat0 + lon0 + x + y;
  catch err
    error('lat0, lon0, x, y have incompatible sizes')
  end

  [lat1, lon1, azi0] = geodreckon(lat0, lon0, y, 0, ellipsoid);
  [lat, lon, azi, ~, ~, rk] = ...
      geodreckon(lat1, lon1, x, azi0 + 90, ellipsoid);
end


%% Trend-Cycle tutorial: dating turning  points and computing cyclical statistics
% Authors:   Filippo Ferroni and  Fabio Canova
% Date:     27/05/2020, revised  15/12/2020

close all; clc; clear all;

addpath ../../cmintools/
addpath ../../bvartools/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% this program illustrates the use of BB program to  date  turning  points
% and  compute business cycle statistics
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%% exercises  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  exercise 1: Vary the censoring  rules.
%  exercise 2: Use  a  shorter  sample. Do  the  turning  points  coincide?
%  exercise 3: Change  the  thresh  parameter.
%  exercise 4: Change  the  data  set.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%=======================================================================
% LOAD DATA
%=======================================================================
lload=0; % =0 euro data, =1 US data

if lload==0
    % Euro area AWM DATABASE: Quarterly
    [a,b,~] = xlsread('awm19up18');
    % names of variables
    varnames = b(1,2:end);

    % time convention: Q1 = .00 and Q4 =0.75
    time = 1970 : .25 : 2017.75;
    time_start   = find(time==1970.50);
    time_start1  = find(time==1999.50);
    time_end     = find(time==2017.75);
    time_break   = find(time==2007.75);

    % The  CREDIT DATA: Quartely
    [e,f,~]=xlsread('ECB_Credit_gaps.xlsx');
    varnames2= f(1,2:end);

    % real GDP, real consumption, real  investment, GDP defl, HICP,
    % short and long term interest rate, commodity  prices,
    % labor  productivity, total  employment, credit to NFC to  GDP
    yy = [a(:,1) a(:,2) a(:,4) a(:,7) a(:,19) a(:,33) a(:,34) ...
        a(:,35) a(:,42) a(:,29) e(time_start-2:time_end,25)];
    % names: YER PCR ITR YED HICP STN LTN COMPR LPROD LNN

    % data transformations:
    % 1. the log of output, consumption,investment
    ddata(:,1:3) = log(yy(time_start+1 : time_end,1:3));
    % 2. the log/log difference of GDP deflator index and CPI
    %ddata(:,4:5) = log(yy(time_start+1  : time_end,4:5));
    ddata(:,4:5) = diff(log(yy(time_start : time_end,4:5)))*400;
    % 3. the level of short and long term interest rate
    ddata(:,6:7) = yy(time_start +1 : time_end,6:7);
    % 4. the log/log difference of commodity prices
    ddata(:,8) = log(yy(time_start+1  : time_end,8));
    %ddata(:,8) = diff(log(yy(time_start : time_end,8)))*400;
    % 5. the taking the log of labor  productivity and  employment
    ddata(:,9:10) = log(yy(time_start+1 : time_end,9:10));
    %ddata(:,9) = diff(log(yy(time_start+1 : time_end,9)));
    %ddata(:,10) = log(yy(time_start+1 : time_end,10));

    %  data for  credit  to  GDP starts  only  at  time_start1 (1999:25)
    ddata(:,11) = yy(time_start+1:time_end,11);
    endd=length(ddata);

    % pick log output, log consumption, log  investment, log labor
    % productivity, log employment, interest rate, inflation rate
    ddd=ddata(:,[1 2 3 9 10 6 5]);
    T=length(ddd);
    time_data = time(time_start+1:time_end);

else

    % US DATABASE: Quarterly

    % real GDP, urate, real consumption, gdp defl, real  investment,
    % capacity utilization, call rate, 10y goverment  bond  rate
    % names: RGDP, URATE, C, GDPdef, inv, capU, callrate, 10ygbond
    [c,d,~] = xlsread('USdata.xlsx');
    % names of variables
    varnames = d(1,2:end);

    % time convention: Q1 = .00 and Q4 =0.75
    time = 1969.75 : .25 : 2019.50;
    time_start   = find(time==1970.25);
    time_end     = find(time==2019.50);
    time_break   = find(time==2007.75);

    tt=length(c);

    % data transformations:

    % 1. difference log of output, consumption,investment
    yy1(1: tt,[1 2 3]) = log(c(1 : tt,[1 3 5]));
    % 2. difference the log GDP deflator index
    yy1(2: tt,6) = diff(log(c(1: tt,4)))*400;
    % 3. leave  the Urate capU unchanged
    yy1(2: tt,[4 5])= c(2:tt,[2 6]);
    % 4. leave call rate, 10 year unchanged
    yy1(2: tt,7:8)= c(2:tt,7:8);
    % 5. compute detrended C/Y, I/Y ratio
    yy1(1: tt,9) = c(1 : tt,3)./c(1: tt,1);
    yy1(1: tt,10) = c(1 : tt,5)./c(1: tt,1);
    % 6. Compute term  spread
    yy1(1: tt,11) = c(1 : tt,8)-c(1: tt,7);

    ddd=yy1;
    T=length(ddd);
    time_data = time(2:tt);
end

%% Parameters

%frequency
freq   = 'q';        % 'q' for quarterly, 'm' for monthly %
if lload==0
    tstart = [1970 3];
    tend   = [2017 3];
elseif lload==1
    tstart = [1970 3];
    tend   = [2019 3];
end

% cycle parameters
options.turnphase   = 2;
options.phase       = 2;          % censoring rules %
options.cycle       = 5;          % lenght of cycle
options.thresh      = 10.4;       % bypasses phase and cycle restriction if peak to trough is > than thresh

options.nrep     = 1;        % 1 if analyze real data
options.complete = 1;        % if= 1- use complete cycles,if =0 -use incomplete cycles (excess still on complete cycle)

dura=zeros(size(ddd,2),2);  ampl=zeros(size(ddd,2),2);
cumm=zeros(size(ddd,2),2);  excc=zeros(size(ddd,2),2);
durcv=zeros(size(ddd,2),2); ampcv=zeros(size(ddd,2),2);
exccv=zeros(size(ddd,2),2); nott=zeros(size(ddd,2),1);
turn    = time(time_start+1:time_end)';
zz      = time(time_start+1:time_end)';
% tid     = linspace(1970.75,2017.75,T)';

for qq = 1 : size(ddd,2)
    if  lload==0
        % EA
        x = ddd(:,qq);
    else
        % US
        x = ddd(time_start+1:time_end,qq);
        time_data = time(time_start+1:time_end);
    end
    % dating_mbbq
    disp('series')
    disp(qq)

    % Computes turning points and imposes restrictions in one step
    [dt_(qq)] = date_(x, time_data, freq, tstart, tend, options);

    zz      = [zz dt_(qq).st];
    turn    = [turn dt_(qq).trinary];

    dura(qq,:)  = dt_(qq).dura;
    ampl(qq,:)  = dt_(qq).ampl;
    cumm(qq,:)  = dt_(qq).cumm;
    excc(qq,:)  = dt_(qq).excc;
    durcv(qq,:) = dt_(qq).durcv;
    ampcv(qq,:) = dt_(qq).amplcv;
    exccv(qq,:) = dt_(qq).exccv;
    nott(qq,:)  = dt_(qq).notentp;
    %plot(tid,trinary,'linewidth',1)
    %title('Turning  points')

end

pause;

disp(' ')
disp('statistics on average cycle')

disp('duration contractions/duration expansions')
disp(dura)

disp('amplitudes contractions/amplitude expansions')
disp(ampl)

disp('cumulative contractions/cumulative expansions')
disp(cumm)

disp('excess movements percent of triangle area')
disp('contractions/expansions')
disp(excc)

disp('cv of durations contractions/expansions')
disp(durcv)

disp('cv of amplitudes contractions/expansions')
disp(ampcv)

disp('cv of excess movements contractions/expansions')
disp(exccv)

%disp('no of its skipped since no peaks+troughs<=2')
%disp(nott)

%disp('states indicators:contraction=0, expansion=1')
%format  short  g
%round(zz, 2)

disp('concordance index BC phases')
ma=corr(zz,'type','Spearman');
disp(ma(2,3:size(ma,2)))

disp('concordance index turning  points')
qa=corr(turn,'type','Spearman');
disp(qa(2,3:size(qa,2)))

[aa,bb]=size(turn);
tsum=zeros(aa,1);
for kk=1:aa
    ssum=0;
    for  qq=2:bb
        ssum=ssum+turn(kk,qq);
    end
    tsum(kk)=ssum;
end

if lload==0
tid     = linspace(1970.75,2017.75,T)';
else
tid     = linspace(1970.75,2019.50,T-3)';
end
plot(tid,tsum,'linewidth',2)
title('Distribution of Turning  points')

disp('Distribution of  peaks')
dp=[zz(find(tsum>=1),1) tsum(find(tsum>=1),1)];
disp(fix(dp))
disp('Distribution of  throughs')
dt=[zz(find(tsum<=-1),1) tsum(find(tsum<=-1),1)];

disp(fix(dt))

% dates
% peaks    mean 1974.00; 1980.00; 1992.00; 2001.00;  2008:00;  2011.25;
%          mode 1974.50; 1980.00; 1992.00; 2001.25;  2008.00;  2011.50;
% throughs mean 1975.25; 1984.25; 1993.75; 2002.75;  2009:50;  2013.00;
%          mode 1975.00; 1984.25; 1993.75; NaN;      2010.00;  2013.00;

% costructing a  recession indicator
recind=zeros(time_end-time_start,1);

% recession dates
rec1b = find(time==1974.00);
rec1e = find(time==1975.25);

rec2b = find(time==1980.00);
rec2e = find(time==1984.25);

rec3b = find(time==1992.00);
rec3e = find(time==1993.75);

rec4b = find(time==2001.00);
rec4e = find(time==2002.75);

rec5b = find(time==2008.00);
rec5e = find(time==2009.50);

rec6b = find(time==2011.25);
rec6e = find(time==2013.00);

for i=rec1b:rec1e
    recind(i,1)=1;
end

for i=rec2b:rec2e
    recind(i,1)=1;
end
for i=rec3b:rec3e
    recind(i,1)=1;
end

for i=rec4b:rec4e
    recind(i,1)=1;
end

for i=rec5b:rec5e
    recind(i,1)=1;
end

for i=rec6b:rec6e
    recind(i,1)=1;
end

if  lload==0
    save Eurorec recind
else
    save Usarec recind
end
return


function out_ztimes = genas(cumu,xt,totbin,bin0,bin1)
    % Uses the GenAS algorithm to determine times of maximum Z values (as given by function AS) for a cumulative time curve
    %
    %  Syntax:     ztimes = genas(cumu,xt,totbin,bin0,bin1)
    %
    %  This Matlab function uses the GenAS algorithm of Habermann
    %  to determine times of maximum Z values (as given by function AS)
    %  for a cumulative time curve.
    %
    %  cumu is a histogram of events using a predefined bin length
    %  xt is the total time vector (in decimal years)
    %  bin0 is the cutoff at the beginning and bin1 at end of the analyses
    %  totbin is the total number of bins (including those with 0 z-values)
    %  ztimes is a vector with max-zvalues, its indexes give the bin number
    %  ------------------                                  R. Zuniga, 4/94

    global ztimes
    global sumx

    report_this_filefun();
    as=zeros(1,totbin);
    % if ~exist('sumx', 'var'); sumx = sum(cumu); end
    sumx = [sumx; sum(cumu)];
    sumx = max(sumx);
    par2 = sumx*0.1;
    %
    %
    for i = bin0+3:1:bin1-3          % calculate mean and z value for AS
        mean1 = mean(cumu(bin0:i));
        mean2 = mean(cumu(i+1:bin1));
        var1 = cov(cumu(bin0:i));
        var2 = cov(cumu(i+1:bin1));
        if mean1 && mean2 ~= 0
            as(i) = (mean1 - mean2)/(sqrt(var1/(i-bin0+1)+var2/(bin1-i)));
        else
            as(i) = 0;

        end     %if mean1

    end     % for i

    %   S = sprintf('bin0 %3d bin1 %3d i  %d',bin0, bin1, i);
    %   disp(S)
    %
    % check for threshold  (z = 1.96 -> 95%,  2.57  -> 99%)
    %as
    [xmax,ixs] = max(abs(as));
    if abs(as(ixs)) >= 2.57
        zmax = as(ixs);
        as = as*0 ;
        as(ixs) = zmax;

        ztimes(ixs) = as(ixs);      % form (vector) ztimes
        %  find(ztimes)

        xsum = cumsum(cumu);

        t1(1) = xt(ixs);
        t1(2) = xsum(ixs);
        t1p = [  t1(1)  t1(2); t1(1)   t1(2)+par2 ];
        plot(t1p(:,1),t1p(:,2),'k');
        set(gca,'NextPlot','add');

        S = sprintf('bin0 %d sig-Z at %d bin1 %d ',bin0, ixs, bin1);
        disp(S)

        ztimes = genas(cumu,xt,totbin,bin0,ixs);  %call genas again for both extremes
        ztimes = genas(cumu,xt,totbin,ixs,bin1);

    end     %if abs

    ztimes(1,totbin) = 0;    %   pad the end of ztimes
    as = as*0;
    out_ztimes = ztimes; %return a version that isn't the global

    %
    %  Plot the as(t)
    %
    %figure_w_normalized_uicontrolunits(2)
    %clf
    % orient tall
    % rect = [0.2,  0.20, 0.55, 0.75];
    % axes('position',rect)
    %set(gca,'NextPlot','add')
    %%plotyy(xt,cumu2,xt,as*10,'m')
    %% y2label('z-value')
    %% plot(xt,as*10,'+m')
    %% plot(xt,as*10,'m')
    % %text(0.70,0.5,'+: AS * 10','sc')
end


function [y]=tt_exp(x, eps, varargin)
%Computation of the pointwise exponential in TT format
%   [Y]=TT_EXP(X,EPS,VARARGIN) This function computes pointwise exponential
%   using scaling and squaring method of the TT-vector X. EPS is the
%   accuracy parameter, varargins:
%       N is the number of summand for the local Taylor
%           series (N=10 by default, usually enough).
%       RMAX is the TT-rank bound.

% nrm = norm(x);
if (isa(x, 'tt_tensor'))
    nrm = tt_max_abs(x);
else
    nrm = tt_max_abs(qtttucker_to_linqtt(x, eps));
end;
n0 = floor(max(log2(nrm), 0))+1;
x = x./(2^n0);
if (isa(x, 'tt_tensor'))
    ons = tt_ones(x.n);
else
    ons = [];
    for i=1:(x.core.d)
        curons = tt_ones(x.tuck{i}.n);
        curons = qtt_tucker(curons, x.tuck{i}.d, eps);
        ons = kron(ons, curons);
    end;
end;
y = ons;

N = 10;
hdm = 'svd';
rmax = Inf;
epst = eps;
while (length(varargin)==1)
    varargin = varargin{1};
end;
for i=1:2:length(varargin)-1
    switch lower(varargin{i})
        case 'n'
            N=varargin{i+1};
        case 'rmax'
            rmax=varargin{i+1};
        case 'epst'
            epst=varargin{i+1};
        case 'hdm'
            hdm=varargin{i+1};

        otherwise
            error('Unrecognized option: %s\n',varargin{i});
    end
end

for k=(N-1):-1:1
% for k=1:N-1
    y=ons+(y.*x)/k;
    y=round(y,epst,rmax);
end

for k=1:n0
    if (strcmp(hdm, 'svd'))
        y=round(y.*y,eps*(0.5^(n0-k)),rmax);
        fprintf('squaring %d\n', k);
    else
        if (isa(x, 'tt_tensor'))
%             y = mvk3(diag(y), y, eps, 'nswp', 20, 'kickrank', 2);
            y = tt_mvk4(diag(y), y, eps, 'nswp', 20);
        else
%             y = mvrk(diag(y), y, eps, 'nswp', 20, 'kickrank', 2);
            y = mvrk2(diag(y), y, eps, 'nswp', 20);
        end;
    end;
end

end


function [yNext,didConverge]=implicitWeakRungeKStep(y,t,a,B,deltaT,algorithm,aCur,BCur,useNewton,useGaussian,maxIter,RelTol,AbsTol)
%%IMPLICITWEAKRUNGEKSTEP Perform a single step of an implicit weak
%           stochastic Runge-Kutta method under It� calculus. This
%           integrates d-dimensional stochastic differential equation of
%           the form:
%           dy=a(y,t)*dt+B(y,t)*dW
%           where dW is the differential of an m-dimensional Wiener
%           process. As the stepsize used decreases, weak methods converge
%           such that integrals with the random process are a measure are
%           correct (for example, to determine moments). However, they do
%           not converge to the optimal path, unlike strong methods.
%
%INPUTS: y The dX1 initial value of the random process.
%        t The scalar initial time of the random process. If an empty
%          matrix is passed, t=0 is used.
%        a A function handle to the drift function. This is called as
%          a(y,t) and returns a dX1 vector. If one wishes to use Newton's
%          method for the implicit iteration, then the calling format is
%          [aVal,papy]=a(y,t), where papy is the dXd matrix of partial
%          derivatives of a with respect to the elements of y papy(:,i) is
%          the derivative with respect to the ith component of y.
%        B A function handle to the diffusion matrix function. This is
%          called as B(y,t) and returns a dXm matrix.
%   deltaT The time increment over which the step is taken.
% algorithm A parameter specifying the algorithm to use. Possible values
%          are:
%          0 Use the implicit order 2.0 weak scheme for scalar noise from
%            Equation 5.12 of Chapter 15.5 of [1], which is the same as
%            Equation 4.12 of Chapter 15.4 and is the implicit form of
%            Equation 1.1 in Chapter 15.1 of [1]. This requires that m=1.
%          1 Use the autonomous implicit order 2.0 weak scheme from
%            Equation 5.14 of Chapter 15.5 of [1], which is the same as
%            Equation 4.13 of Chapter 15.4 and is the implicit form of
%            Equation 1.3 in Chapter 15.1 of [1]. This requires that a and
%            B not depend on t.
%          2 Use the autonomous explicit order 2.0 weak scheme for additive
%            noise that comes as a special case of Equation 5.14 of Chapter
%            15.5 of [1]. This requires that a and B not depend on t and
%            that B does not depend on x.
% aCur, BCur Often one might already have the values a(x,t) and B(x,t). If
%          so, then they should be provided as the dX1 and dXm aCur and
%          BCur to avoid recalculation. If unavailable, these values can be
%          omitted or empty matrices passed.
% useNewton Indicates whether the implicit iteration should be performed
%          using Newton's method or fixed-point iteration. The default if
%          omitted or an empty matrix is passed is false (fixed-point
%          iteration). If Newton's method is used, then papy must be
%          returned by the function a.
% useGaussian Algorithms 0 and 1 have a choice of how the random component
%          is generated. If useGaussian=true, then Gaussian random
%          variables will be used. Otherwise, simpler random variables
%          having the same desired moment properties will be used. the
%          default if omitted or an empty matrix is passed is true.
%  maxIter The maximum number of iterations to perform. The default if
%          omitted or an empty matrix is passed is 2.
% RelTol, AbsTol The relative and absolute tolerances on the iterations
%          before declaring convergence. If these are set to 0 (the default
%          if omitted or empty matrices are passed), then the algorithm
%          will just iterate for the maximum number of iterations. the
%          tolerances apply to each element of x. Convergence is declared
%          if all(diff<=AbsTol)||all(diff<=RelTol*abs(yNext)).
%
%OUTPUTS: yNext The estimated value of the process after taking a step of
%               deltaT. This is a random value.
%   didConverge If RelTol and/or AbsTol are not zero and maxIter>0, then
%               this indicates whether the iterations converged to the
%               desired accuracy. Otherwise, this is just an empty matrix.
%
%EXAMPLE 1:
%This is an example of a nonlinear scalar problem with non-additive noise
%where an explicit solution is available as a basis of comparison. In
%Chapter 4.4 of [1], the stochastic differential equation and its solution
%are from Equation 4.40. We compare the performance of the explicit
%solution (taking the expected value using cubature integration) and the
%implicit solution.
% rng(1)%Make exact run repeatable.
% numMC=1e3;
% numSteps=1;
% algorithm=1;
% useNewton=true;
% deltaT=1.1;
% y0=0.5;
% aDrift=@(y,t)((1/3)*y^(1/3));
% BDiff=@(y,t)(y^(2/3));
% papy=@(y)1/(9*y^(2/3));
% aFun=@(y,t)dealRobust(aDrift(y,t),papy(y));
% explSim=@(W)(y0^(1/3)+(1/3)*W)^3;
%
% %Take the expected value of the explicit solution using quadrature
% %integration.
% [xi,w]=quadraturePoints1D(6);%2*6-1=11th order.
% numPts=length(w);
% xi=sqrt(deltaT)*xi;
% muCub=0;
% for k=1:numPts
%     muCub=muCub+w(k)*explSim(xi(:,k));
% end
%
% valsRKImp=zeros(1,numMC);
% valsRK=zeros(1,numMC);
% for curMC=1:numMC
%     y=y0;
%     yExp=y0;
%     t=0;
%     for curStep=1:numSteps
%         s=rng();%Record the state prior to generating the random variables.
%         y=implicitWeakRungeKStep(y,t,aFun,BDiff,deltaT/numSteps,algorithm,[],[],useNewton);
%
%         rng(s)%Drive the explicit step with the same random process as the
%               %implicit one.
%         yExp=weakRungeKStep(yExp,t,aDrift,BDiff,deltaT/numSteps,algorithm);
%         t=t+deltaT/numSteps;
%     end
%     valsRKImp(curMC)=y;
%     valsRK(curMC)=yExp;
% end
% muRKImp=mean(valsRKImp);
% muRK=mean(valsRK);
% abs((muRKImp-muCub)./muCub)%Relative mean error, implicit.
% abs((muRK-muCub)./muCub)%Relative mean error, explicit.
%The implicit error will be about 0.0086 and the explicit error will be
%about 0.0153. Thus, the algorithm improves the explicit method in this
%instance.
%
%EXAMPLE 2:
%Here, we compare the implicit strong Taylor method to the explicit method
%on a linear model. This is done with the same noise driving both
%processes.
% algorithm=2;
% useNewton=false;
% numMC=1e3;
% deltaT=1/3;
% numSteps=5;
% y0=[1/4;-12];
% A=[1.1,0.1;
%    -0.2,2.2];
% D=[1.5,-0.4;
%    0.1,1];
% d=size(D,1);
% [F,Q]=linDynMod2Disc(deltaT,A,D);
% mu=F*y0;
% P=Q;
% aDrift=@(x,t)(A*x);
% BDiff=@(x,t)(D);
%
% aFun=@(y,t)dealRobust(aDrift(y,t),A);
%
% valsRKImp=zeros(d,numMC);
% valsRK=zeros(d,numMC);
% for curMC=1:numMC
%     yExpl=y0;
%     y=y0;
%     t=0;
%     for curStep=1:numSteps
%         s=rng();%Record the state prior to generating the random variables.
%         y=implicitWeakRungeKStep(y,t,aFun,BDiff,deltaT/numSteps,algorithm,[],[],useNewton);
%
%         rng(s)%Drive the explicit step with the same random process as the
%               %implicit one.
%         yExpl=weakRungeKStep(yExpl,t,aDrift,BDiff,deltaT/numSteps,algorithm);
%         t=t+deltaT/numSteps;
%     end
%     valsRKImp(:,curMC)=y;
%     valsRK(:,curMC)=yExpl;
% end
% [muRKImp,PRKImp]=calcMixtureMoments(valsRKImp);
% [muRK,PRK]=calcMixtureMoments(valsRK);
% norm(muRKImp-mu)./norm(mu)%Relative mean error, implicit.
% norm(PRKImp-P,'fro')./norm(P,'fro')%Relative variance error,implicit.
% norm(muRK-mu)./norm(mu)%Relative mean error, explicit.
% norm(PRK-P,'fro')./norm(P,'fro')%Relative variance error,explicit.
%One will typically see that the relative errors of the implicit method are
%notably better than the explicit method.
%
%EXAMPLE 3:
%This is an example of what is considered a "stiff" problem in Section 12.2
%of [1] with non-additive noise. The problem has an explicit solution in
%terms of the Wiener process W. We use quadrature integration to obtain the
%mean of that solution, which is used as the true moments for comparison.
%We compare this implicit method with an explicit step. This is a 2X1
%process with scalar noise.
% rng(1)%Make the exact run repeatable.
% algorithm=0;
% useNewton=false;
% useGaussian=false;
% numMC=1e3;
% a=25;
% b=2;
% deltaT=1/10;
% numSteps=10;
% A=[-a,a;
%     a,-a];
% B=[b,0;
%    0,b];
% aDrift=@(y,t)A*y;
% BDiff=@(y,t)B*y;
% d=2;
% papy=A;
% aFun=@(y,t)dealRobust(aDrift(y,t),papy);
% %The explicit solution; equation 2.5 in Chapter 12.2 of [1].
% expSol=@(W,deltaT,y0)(expm((A-(1/2)*B^2)*deltaT+B*W)*y0);
% y0=[1;0.1];
%
% %Take the expected value of the explicit solution using quadrature
% %integration.
% [xi,w]=quadraturePoints1D(6);%2*6-1=11th order.
% numPts=length(w);
% xi=sqrt(deltaT)*xi;
% muCub=zeros(d,1);
% for k=1:numPts
%     muCub=muCub+w(k)*expSol(xi(:,k),deltaT,y0);
% end
%
% valsRK=zeros(d,numMC);
% valsRKExplicit=zeros(d,numMC);
% for curMC=1:numMC
%     y=y0;
%     yExp=y0;
%     t=0;
%     for curStep=1:numSteps
%         s=rng();%Record the state prior to generating the random variables.
%         y=implicitWeakRungeKStep(y,t,aFun,BDiff,deltaT/numSteps,algorithm,[],[],useNewton,useGaussian);
%
%         rng(s)%Drive the explicit step with the same random process as the
%               %implicit one.
%         yExp=weakRungeKStep(yExp,t,aDrift,BDiff,deltaT/numSteps,algorithm,[],[],useGaussian);
%         t=t+deltaT/numSteps;
%     end
%     valsRK(:,curMC)=y;
%     valsRKExplicit(:,curMC)=yExp;
% end
% muRK=mean(valsRK,2);
% muRKExp=mean(valsRKExplicit,2);
% norm((muRK-muCub)./norm(muCub))%Relative mean error, implicit.
% norm((muRKExp-muCub)./norm(muCub))%Relative mean error, explicit.
%One will get a relative implicit error of about 0.0119 and a relative
%explicit error of about 0.0121. Getting rid of the random seed, the
%implicit solution is typically more accurate than the explicit. Using the
%Gaussian noise option also improves performance.
%
%REFERENCES:
%[1] P. E. Kloeden and E. Platen, Numerical Solution of Stochastic
%    Differential Equations. Berlin: Springer, 1999.
%
%November 2018 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

if(nargin<13||isempty(AbsTol))
    AbsTol=0;
end

if(nargin<12||isempty(RelTol))
    RelTol=0;
end

if(nargin<11||isempty(maxIter))
    maxIter=2;
end

if(nargin<10||isempty(useGaussian))
    useGaussian=true;
end

if(nargin<9||isempty(useNewton))
    useNewton=false;
end

if(nargin<8||isempty(BCur))
    BCur=B(y,t);
end

if(nargin<7||isempty(aCur))
    aCur=a(y,t);
end

if(isempty(t))
    t=0;
end

if(algorithm>=0&&algorithm<=2)
    [yNext,fixedTerm]=weakRungeKStep(y,t,a,B,deltaT,algorithm,aCur,BCur,useGaussian);

    tNext=t+deltaT;
    if(useNewton)
        [yNext,didConverge]=implicitNewtonIter(y,a,deltaT/2,yNext,tNext,fixedTerm,maxIter,RelTol,AbsTol);
    else
        [yNext,didConverge]=implicitFixedPointIter(y,a,deltaT/2,yNext,tNext,fixedTerm,maxIter,RelTol,AbsTol);
    end
else
    error('Unknown algorithm specified.')
end
end

function [yNext,didConverge]=implicitFixedPointIter(yOld,a,coeff,yNext,tNext,fixedTerm,maxIter,RelTol,AbsTol)
%IMPLICITFIXEDITER This iterates the function
%                  yNext=a(yNext,tNext)*coeff+fixedTerm
%                  Iterations continue until the RelTol and or AbsTol
%                  conditions are met or maxIter iterations have elapsed.
%
%December 2018 David F. Crouse, Naval Research Laboratory, Washington D.C.

    if(RelTol==0&&AbsTol==0)
        %Fixed point iteration for the maximum number of steps.
        for curIter=1:maxIter
            yNext=a(yNext,tNext)*coeff+fixedTerm;
        end
        didConverge=[];
    else%Iterate until meeting the convergence bound.
        didConverge=false;
        for curIter=1:maxIter
            yNext=a(yNext,tNext)*coeff+fixedTerm;

            diff=abs(yOld-yNext);
            if(all(diff<=AbsTol)||all(diff<=RelTol*abs(yNext)))
                didConverge=true;
                break;
            end

            yOld=yNext;
        end
    end
end

function [yNext,didConverge]=implicitNewtonIter(yOld,a,coeff,yNext,tNext,fixedTerm,maxIter,RelTol,AbsTol)
%%IMPLICITNEWTONITER This function uses Newton's method to try to solve
%                    a(yNext,tNext)*coeff+fixedTerm-yNext=0
%                    for yNext.Iterations continue until the RelTol and or
%                    AbsTol conditions are met or maxIter iterations have
%                    elapsed.
%
%December 2018 David F. Crouse, Naval Research Laboratory, Washington D.C.

    d=size(yNext,1);

    I=eye(d,d);
    if(RelTol==0&&AbsTol==0)
        %Newton's iteration for the maximum number of steps.
        for curIter=1:maxIter
            [aVal,papy]=a(yNext,tNext);
            F=yNext-fixedTerm-coeff*aVal;
            dF=I-coeff*papy;
            yNext=yNext-dF\F;
        end
        didConverge=[];
    else%Iterate until meeting the convergence bound.
        didConverge=false;
        for curIter=1:maxIter
            [aVal,papy]=a(yNext,tNext);
            F=aVal-fixedTerm-coeff*aVal;
            dF=I-coeff*papy;
            yNext=yNext-dF\F;

            diff=abs(yOld-yNext);
            if(all(diff<=AbsTol)||all(diff<=RelTol*abs(yNext)))
                didConverge=true;
                break;
            end

            yOld=yNext;
        end
    end
end

%LICENSE:
%
%The source code is in the public domain and not licensed or under
%copyright. The information and software may be used freely by the public.
%As required by 17 U.S.C. 403, third parties producing copyrighted works
%consisting predominantly of the material produced by U.S. government
%agencies must provide notice with such work(s) identifying the U.S.
%Government material incorporated and stating that such material is not
%subject to copyright protection.
%
%Derived works shall not identify themselves in a manner that implies an
%endorsement by or an affiliation with the Naval Research Laboratory.
%
%RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF THE
%SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY THE NAVAL
%RESEARCH LABORATORY FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE ACTIONS
%OF RECIPIENT IN THE USE OF THE SOFTWARE.


function [Ybus, Yf, Yt] = makeYbus(baseMVA, bus, branch)
%MAKEYBUS   Builds the bus admittance matrix and branch admittance matrices.
%   [YBUS, YF, YT] = MAKEYBUS(MPC)
%   [YBUS, YF, YT] = MAKEYBUS(BASEMVA, BUS, BRANCH)
%
%   Returns the full bus admittance matrix (i.e. for all buses) and the
%   matrices YF and YT which, when multiplied by a complex voltage vector,
%   yield the vector currents injected into each line from the "from" and
%   "to" buses respectively of each line. Does appropriate conversions to p.u.
%   Inputs can be a MATPOWER case struct or individual BASEMVA, BUS and
%   BRANCH values. Bus numbers must be consecutive beginning at 1
%   (i.e. internal ordering).
%
%   See also MAKEJAC, MAKESBUS, EXT2INT.

%   MATPOWER
%   Copyright (c) 1996-2016, Power Systems Engineering Research Center (PSERC)
%   by Ray Zimmerman, PSERC Cornell
%
%   This file is part of MATPOWER.
%   Covered by the 3-clause BSD License (see LICENSE file for details).
%   See https://matpower.org for more info.

%% extract from MPC if necessary
if nargin < 3
    mpc     = baseMVA;
    baseMVA = mpc.baseMVA;
    bus     = mpc.bus;
    branch  = mpc.branch;
end

%% constants
nb = size(bus, 1);          %% number of buses
nl = size(branch, 1);       %% number of lines

%% define named indices into bus, branch matrices
[PQ, PV, REF, NONE, BUS_I, BUS_TYPE, PD, QD, GS, BS, BUS_AREA, VM, ...
    VA, BASE_KV, ZONE, VMAX, VMIN, LAM_P, LAM_Q, MU_VMAX, MU_VMIN] = idx_bus;
[F_BUS, T_BUS, BR_R, BR_X, BR_B, RATE_A, RATE_B, RATE_C, ...
    TAP, SHIFT, BR_STATUS, PF, QF, PT, QT, MU_SF, MU_ST, ...
    ANGMIN, ANGMAX, MU_ANGMIN, MU_ANGMAX] = idx_brch;

%% check that bus numbers are equal to indices to bus (one set of bus numbers)
if any(bus(:, BUS_I) ~= (1:nb)')
    error('makeYbus: buses must be numbered consecutively in bus matrix; use ext2int() to convert to internal ordering')
end

%% for each branch, compute the elements of the branch admittance matrix where
%%
%%      | If |   | Yff  Yft |   | Vf |
%%      |    | = |          | * |    |
%%      | It |   | Ytf  Ytt |   | Vt |
%%
stat = branch(:, BR_STATUS);                    %% ones at in-service branches
Ys = stat ./ (branch(:, BR_R) + 1j * branch(:, BR_X));  %% series admittance
Bc = stat .* branch(:, BR_B);                           %% line charging susceptance
tap = ones(nl, 1);                              %% default tap ratio = 1
i = find(branch(:, TAP));                       %% indices of non-zero tap ratios
tap(i) = branch(i, TAP);                        %% assign non-zero tap ratios
tap = tap .* exp(1j*pi/180 * branch(:, SHIFT)); %% add phase shifters
Ytt = Ys + 1j*Bc/2;
Yff = Ytt ./ (tap .* conj(tap));
Yft = - Ys ./ conj(tap);
Ytf = - Ys ./ tap;

%% compute shunt admittance
%% if Psh is the real power consumed by the shunt at V = 1.0 p.u.
%% and Qsh is the reactive power injected by the shunt at V = 1.0 p.u.
%% then Psh - j Qsh = V * conj(Ysh * V) = conj(Ysh) = Gs - j Bs,
%% i.e. Ysh = Psh + j Qsh, so ...
Ysh = (bus(:, GS) + 1j * bus(:, BS)) / baseMVA; %% vector of shunt admittances

%% bus indices
f = branch(:, F_BUS);                           %% list of "from" buses
t = branch(:, T_BUS);                           %% list of "to" buses

%% for best performance, choose method based on MATLAB vs Octave and size
if nb < 300 || have_feature('octave')   %% small case OR running on Octave
    %% build Yf and Yt such that Yf * V is the vector of complex branch currents injected
    %% at each branch's "from" bus, and Yt is the same for the "to" bus end
    i = [1:nl 1:nl]';                           %% double set of row indices
    Yf = sparse(i, [f; t], [Yff; Yft], nl, nb);
    Yt = sparse(i, [f; t], [Ytf; Ytt], nl, nb);

    %% build Ybus
    Ybus = sparse([f;f;t;t], [f;t;f;t], [Yff;Yft;Ytf;Ytt], nb, nb) + ... %% branch admittances
            sparse(1:nb, 1:nb, Ysh, nb, nb);        %% shunt admittance
else                                %% large case running on MATLAB
    %% build connection matrices
    Cf = sparse(1:nl, f, ones(nl, 1), nl, nb);      %% connection matrix for line & from buses
    Ct = sparse(1:nl, t, ones(nl, 1), nl, nb);      %% connection matrix for line & to buses

    %% build Yf and Yt such that Yf * V is the vector of complex branch currents injected
    %% at each branch's "from" bus, and Yt is the same for the "to" bus end
    Yf = sparse(1:nl, 1:nl, Yff, nl, nl) * Cf + sparse(1:nl, 1:nl, Yft, nl, nl) * Ct;
    Yt = sparse(1:nl, 1:nl, Ytf, nl, nl) * Cf + sparse(1:nl, 1:nl, Ytt, nl, nl) * Ct;

    %% build Ybus
    Ybus = Cf' * Yf + Ct' * Yt + ...            %% branch admittances
            sparse(1:nb, 1:nb, Ysh, nb, nb);    %% shunt admittance
end


%function []=mcmc()

clear all; clc;

%% MCMC options
nloop=110; % number of iterations for mcmcm
burnin=10;  % number of initial iterations to discard
thin=10;    % save every nth iteration
M=4;        %number of group components desired

%% set starting values for Z, S_BAR, SIGMA_S B_BAR SIGMA_B MU
load real_data;
[Z_st S_BAR_st SIGMA_S_st B_BAR_st SIGMA_B_st N_k_st N_k1k2_st]=get_initial_values_new(N,M_i,S,B,Q,M);
Z=Z_st; % Mi x M matrices of group indicators
S_BAR=S_BAR_st; % cluster centroid locations
SIGMA_S=SIGMA_S_st; % cluster centroid variances
B_BAR=B_BAR_st; % group level connectivities
SIGMA_B=SIGMA_B_st; % variances of connectivities
N_k=N_k_st; % number of components that belong to each cluster
N_k1k2=N_k1k2_st; % pairwise counts of group level clusters
MU=ones(M,1)/M; %probabilities of membership in group-level clusters.

%% initialize arrays of posterior draws
keep=round((nloop-burnin)/thin);
Z_array=cell(keep,1);
S_BAR_array=cell(keep,1);
SIGMA_S_array=cell(keep,1);
B_BAR_array=cell(keep,1);
SIGMA_B_array=cell(keep,1);
MU_array=cell(keep,1);
iter_array=0;

%%Hyperparameters
c=10000;                    %'c' in the paper
eta=median(N_k_st);         % 'eta' in paper
SS=eta*mean(SIGMA_S,3);     % 'S' in the paper
p1=1;                       % 'a' in the paper
p2=1;                       % 'b' in the paper

%% run MCMC

for iter=1:nloop

    % Draw S_BAR (group centroid locations)
    for k=1:M
        mu_s_bar_k=zeros(3,1);
        Sigma_s_bar_k=inv(N_k(k)*inv(SIGMA_S(:,:,k))+inv(SS));
        for i=1:N
            if max(Z{i}(:,k))==1
                j_k=find(Z{i}(:,k)==1);
                for j=1:length(j_k)
                    mu_s_bar_k=mu_s_bar_k+S{i}(j_k(j),:)';
                end
            end
        end
        mu_s_bar_k=Sigma_s_bar_k*inv(SIGMA_S(:,:,k))*mu_s_bar_k;
        S_BAR(k,:)=mvnrnd(mu_s_bar_k,Sigma_s_bar_k);
    end

    % Draw SIGMA_S (group centoid covariance matrices)
    for k=1:M
        eta_k=eta+.5*N_k(k);
        SS_k=SS;
        for i=1:N
            if max(Z{i}(:,k))==1
                j_k=find(Z{i}(:,k)==1);
                for j=1:length(j_k)
                    SS_k=SS_k+.5*(S{i}(j_k(j),:)-S_BAR(k,:))'*(S{i}(j_k(j),:)-S_BAR(k,:));
                end
            end
        end
        SS_k=.5*(SS_k+SS_k');
        inv_SS_k=inv(SS_k);
        inv_SS_k=.5*(inv_SS_k+inv_SS_k');
        SIGMA_S(:,:,k)=inv(wishrnd(inv_SS_k,eta_k));
    end

    % Draw B_BAR (group mean connectivites)
    for k1=1:M
        for k2=1:M
            mu_b_bar_k1k2=zeros(Q,1);
            Sigma_sq_b_k1k2=1/(1/c+N_k1k2(k1,k2)/SIGMA_B(k1,k2))*eye(Q);
            for i=1:N
                n_k1=sum(Z{i}(:,k1));
                n_k2=sum(Z{i}(:,k2));
                if(and(n_k1>=1,n_k2>=1))
                    j_k1=find(Z{i}(:,k1)==1);
                    j_k2=find(Z{i}(:,k2)==1);
                    for j1=1:n_k1
                        for j2=1:n_k2
                            mu_b_bar_k1k2=mu_b_bar_k1k2+B{i}{j_k1(j1),j_k2(j2)}';
                        end
                    end
                end
            end
            mu_b_bar_k1k2=Sigma_sq_b_k1k2*mu_b_bar_k1k2/SIGMA_B(k1,k2);
            B_BAR{k1,k2}=mvnrnd(mu_b_bar_k1k2,Sigma_sq_b_k1k2);
        end
    end

    % Draw SIGMA_B (group connectivity variances)
    for k1=1:M
        for k2=1:M
            p1_k1k2=p1+.5*Q*N_k1k2(k1,k2);
            p2_k1k2=p2;
            for i=1:N
                n_k1=sum(Z{i}(:,k1));
                n_k2=sum(Z{i}(:,k2));
                if(and(n_k1>=1,n_k2>=1))
                    j_k1=find(Z{i}(:,k1)==1);
                    j_k2=find(Z{i}(:,k2)==1);
                    for j1=1:n_k1
                        for j2=1:n_k2
                            p2_k1k2=p2_k1k2+.5*sum((B{i}{j_k1(j1),j_k2(j2)}-B_BAR{k1,k2}).^2);
                        end
                    end
                end
            end
            SIGMA_B(k1,k2)=1/gamrnd(p1_k1k2,1/p2_k1k2);
        end
    end

    % Draw Z (indicators of group membership)
    ind=randperm(N);
    for i=ind
        ind_i=randperm(M_i(i));
        for j=ind_i
            Log_p_ij=zeros(M,1);
            for k=1:M
                Sigma_s_ijk=SIGMA_S(:,:,k);
                s_ijk=S{i}(j,:)-S_BAR(k,:);
                log_p_s_ijk=-.5*log(det(Sigma_s_ijk))-.5*s_ijk*inv(Sigma_s_ijk)*s_ijk';
                log_p_b_ijk=0;
                for j1=1:M_i(i)
                    if j==j1
                        log_p_b_ijk=log_p_b_ijk-.5*Q*log(det(SIGMA_B(k,k)))...
                        -.5*sum((B{i}{j,j}-B_BAR{k,k}).^2)/SIGMA_B(k,k);
                    end
                    if and(not(j==j1),find(Z{i}(j1,:)==1)==k)
                        log_p_b_ijk=log_p_b_ijk-.5*Q*log(det(SIGMA_B(k,k)))...
                        -.5*sum((B{i}{j1,j1}-B_BAR{find(Z{i}(j1,:)==1),find(Z{i}(j1,:)==1)}).^2)/...
                            SIGMA_B(find(Z{i}(j,:)==1),find(Z{i}(j,:)==1));
                    end
                    if not(find(Z{i}(j,:)==1)==find(Z{i}(j1,:)==1))
                        log_p_b_ijk=log_p_b_ijk-.5*Q*log(det(SIGMA_B(k,find(Z{i}(j1,:)==1))))...
                        -.5*sum((B{i}{j,j1}-B_BAR{k,find(Z{i}(j1,:)==1)}).^2)/...
                              SIGMA_B(k,find(Z{i}(j1,:)==1));
                    end
                end
                for j2=1:M_i(i)
                    if not(find(Z{i}(j2,:)==1)==find(Z{i}(j,:)==1))
                        log_p_b_ijk=log_p_b_ijk-.5*Q*log(det(SIGMA_B(find(Z{i}(j2,:)==1),k)))...
                        -.5*sum((B{i}{j2,j}-B_BAR{find(Z{i}(j2,:)==1),k}).^2)/...
                                SIGMA_B(find(Z{i}(j2,:)==1),k);
                    end
                end
                Log_p_ij(k)=MU(k)+log_p_s_ijk+log_p_b_ijk;
            end
            Log_p_ij=Log_p_ij-max(Log_p_ij);
            P_ij=exp(Log_p_ij)/sum(exp(Log_p_ij));
            v=rand;
            Z{i}(j,:)=0*Z{i}(j,:);
            if v<=P_ij(1)
                   Z{i}(j,1)=1;
                   log_p_ij=Log_p_ij(1);
            end
            for k=1:(M-1)
               if(and(v>sum(P_ij(1:k)),v<=sum(P_ij(1:(k+1)))))
                   Z{i}(j,k+1)=1;
                   log_p_ij=Log_p_ij(k);
               end
            end
        end
    end

    % Draw MU (probabilities of clusters)
    N_k1k2=zeros(M);
    for k1=1:M
        for k2=1:M
            for i=1:N
                n_k1=sum(Z{i}(:,k1));
                n_k2=sum(Z{i}(:,k2));
                if(and(n_k1>=1,n_k2>=1))
                    if not(k1==k2)
                        N_k1k2(k1,k2)=N_k1k2(k1,k2)+n_k1*n_k2;
                    end
                    if k1==k2
                        N_k1k2(k1,k2)=N_k1k2(k1,k2)+n_k1;
                    end
                end
            end
        end
    end
    N_k=diag(N_k1k2);
    MU=drchrnd(1/M*ones(1,M)+N_k',1);

    % Posterior Draw arrays
    if and(iter>=burnin,thin*round(iter/thin)==iter)
        iter_array=iter_array+1;
        Z_array{iter_array}=Z;
        S_BAR_array{iter_array}=S_BAR;
        SIGMA_S_array{iter_array}=SIGMA_S;
        B_BAR_array{iter_array}=B_BAR;
        SIGMA_B_array{iter_array}=SIGMA_B;
        MU_array{iter_array}=MU;

        %compute and print out intermediate estimates of source locations
        S_BAR_mean=S_BAR_array{1};
        for j=2:iter_array
            S_BAR_mean=S_BAR_mean+S_BAR_array{j};
        end
        S_BAR_mean=S_BAR_mean/iter_array;
        iter
        [S_BAR_st zeros(M,1) S_BAR_mean]

        %[sqrt(sum(min(pdist2(S_BAR_true,S_BAR_st)').^2))/M sqrt(sum(min(pdist2(S_BAR_true,S_BAR_mean)').^2))/M]

        %compute and print intermediate indicator probs for random subject
        i=discretesample(repmat(1,N,1)/N,1);
        Z_i_mean=Z_array{1}{i};
        for j=2:iter_array
           Z_i_mean=Z_i_mean+Z_array{j}{i};
        end
        Z_st{i}
        Z_i_mean=Z_i_mean/iter_array
    end

end

save mcmc_outputs nloop M Z_array S_BAR_array SIGMA_S_array B_BAR_array SIGMA_B_array MU_array iter_array


%% FUNCTION Least_Weight2FGLasso
%   Weighted Fused Group Lasso and Weighted Lasso with Least Squares Loss .
%
%% OBJECTIVE
%   argmin_W { \sum_i^t (0.5 * norm (Y{i} - X{i}' * W(:, i))^2)
%              + \sum_{i=1}^d rho1{i} * \|W(i, :)\|_1
%              + \sum_{i=1}^d rho2{i} \sum_{j=1}^{t-1}* \|W(i, j) - W(i, j+1)\|_1
%          }
%   rho1: weighted Lasso sparse.
%   rho2: weighted Fused Lasso.
%   R encodes fused structure relationship [1 -1 0 ...; 0 1 -1 ...; ...]
%      R=zeros(t,t-1);R(1:(t+1):end)=1;R(2:(t+1):end)=-1;
%
%% INPUT
% X: {d * n} * t - input matrix
% Y: {n * 1} * t - output matrix
% rho1: d * 1    - weighted Lasso.
% rho2: d * 1    - weighted fused Lasso.
%
%% OUTPUT
% W: model: d * t
% funcVal: function value vector.
%
%% LICENSE
%   This program is free software: you can redistribute it and/or modify
%   it under the terms of the GNU General Public License as published by
%   the Free Software Foundation, either version 3 of the License, or
%   (at your option) any later version.
%
%   This program is distributed in the hope that it will be useful,
%   but WITHOUT ANY WARRANTY; without even the implied warranty of
%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%   GNU General Public License for more details.
%
%   You should have received a copy of the GNU General Public License
%   along with this program.  If not, see <http://www.gnu.org/licenses/>.
%
%   Copyright (C) 2011 - 2012 Jiayu Zhou, Jun Liu and Jieping Ye
%
%   You are suggested to first read the Manual.
%   For any problem, please contact with Jiayu Zhou via jiayu.zhou@asu.edu
%
%   Last modified on June 3, 2012.
%
%% RELATED PAPERS
%
%   [1] Zhou, J., Jun, L., Narayan, A. V. and Ye, J.  Modeling Disease
%   Progression via Fused Sparse Group Lasso. KDD 2012
%
%% RELATED FUNCTIONS
%   Least_NCFGLasso, init_opts

function [W, funcVal] = Least_Weight2FGLasso(X, Y, rho1, rho2, opts)

if nargin <5
    opts = [];
end

% initialize options.
opts=init_opts(opts);

task_num  = length (X);
dimension = size(X{1}, 1);

if length(rho1) ~= dimension
    error('Size of rho1 is not correct! Should be equivalent to dimension')
end

if length(rho2) ~= dimension
    error('Size of rho2 is not correct! Should be equivalent to dimension')
end

funcVal = [];

% Relation
R=zeros(task_num,task_num-1);
R(1:(task_num+1):end)=1;
R(2:(task_num+1):end)=-1;
R = R';

% initialize a starting point
if opts.init==2
    W0 = zeros(dimension, task_num);
elseif opts.init == 0
    W0 = W0_prep;
else
    if isfield(opts,'W0')
        W0=opts.W0;
        if (nnz(size(W0)-[dimension, task_num]))
            error('\n Check the input .W0');
        end
    else
        W0=W0_prep;
    end
end

bFlag=0; % this flag tests whether the gradient step only changes a little

Wz= W0;
Wz_old = W0;

t = 1;
t_old = 0;

iter = 0;
gamma = 1;
gamma_inc = 2;

while iter < opts.maxIter
    alpha = (t_old - 1) /t;

    Ws = (1 + alpha) * Wz - alpha * Wz_old;

    % compute function value and gradients of the search point
    gWs  = gradVal_eval(Ws);
    Fs   = funVal_eval (Ws);

    while true
        Wzp = ReweightFGLasso_projection(Ws - gWs/gamma, rho1 ./ gamma, rho2 ./ gamma);
        Fzp = funVal_eval  (Wzp);

        delta_Wzp = Wzp - Ws;
        r_sum = norm(delta_Wzp, 'fro')^2;
        %         Fzp_gamma = Fs + trace(delta_Wzp' * gWs)...
        %             + gamma/2 * norm(delta_Wzp, 'fro')^2;
        Fzp_gamma = Fs + sum(sum(delta_Wzp.* gWs))...
            + gamma/2 * r_sum;

        if (Fzp <= Fzp_gamma)
            break;
        else
            gamma = gamma * gamma_inc;
        end
    end

    Wz_old = Wz;
    Wz = Wzp;

    funcVal = cat(1, funcVal, Fzp + nonsmooth_eval(Wz, rho1, rho2));

    if (bFlag)
        % fprintf('\n The program terminates as the gradient step changes the solution very small.');
        break;
    end

    % test stop condition.
    switch(opts.tFlag)
        case 0
            if iter>=2
                if (abs( funcVal(end) - funcVal(end-1) ) <= opts.tol)
                    break;
                end
            end
        case 1
            if iter>=2
                if (abs( funcVal(end) - funcVal(end-1) ) <=...
                        opts.tol* funcVal(end-1))
                    break;
                end
            end
        case 2
            if ( funcVal(end)<= opts.tol)
                break;
            end
        case 3
            if iter>=opts.maxIter
                break;
            end
    end

    iter = iter + 1;
    t_old = t;
    t = 0.5 * (1 + (1+ 4 * t^2)^0.5);

end

W = Wzp;

% private functions

    function [Wp] = ReweightFGLasso_projection (W, lambda_1, lambda_2)
        % solve it in row wise, since that
        % \sum_i^d rho1{i} * \|W(i, :)\|_1 is row coupled.
        % for each row we need to solve the proximal opterator
        % W(i, :) = argmin_w { 0.5 \|w - v\|_2^2
        %            + lambda_1{i} * \|w\|_1
        %            + lambda_2{i} * \|R * w\|_1 }
        % NOTE: Here the R is t-1 * t, the outside R is t * t-1, and
        Wp = zeros(size(W));

        for i = 1 : size(W, 1)
            v = W(i, :);

            w0 = zeros(length(v)-1, 1);
            w = flsa(v, w0,  lambda_1(i), lambda_2(i), length(v), 1000, 1e-9, 1, 6);

            Wp(i, :) = w';
        end
    end

% smooth part gradient.
    function [grad_W] = gradVal_eval(W)
        if opts.pFlag
            grad_W = zeros(size(W));
            parfor i = 1:task_num
                grad_W(:, i) = X{i}*(X{i}' * W(:,i)-Y{i});
            end
        else
            grad_W = [];
            for i = 1:task_num
                grad_W = cat(2, grad_W, X{i}*(X{i}' * W(:,i)-Y{i}) );
            end
        end
    end

% smooth part gradient.
    function [funcVal] = funVal_eval (W)
        funcVal = 0;
        if opts.pFlag
            parfor i = 1: task_num
                funcVal = funcVal + 0.5 * norm (Y{i} - X{i}' * W(:, i))^2;
            end
        else
            for i = 1: task_num
                funcVal = funcVal + 0.5 * norm (Y{i} - X{i}' * W(:, i))^2;
            end
        end
    end

    function [non_smooth_value] = nonsmooth_eval(W, rho_1, rho_2)
        non_smooth_value = 0;
        for i = 1 : size(W, 1)
            w = W(i, :);
            non_smooth_value = non_smooth_value ...
                + rho_1(i) * norm(w, 1) + rho_2(i) * norm(R * w', 1);
        end
    end

end