% Demo for distributed (locally multivariate) HRF

close all
clear variables

% Choose basic settings for simulations
TR          = 3;                    % sampling time interval (in sec)
n_t         = 60/TR;                % number of time samples (over 40 sec)
deltat      = 5e-2;                 % micro-time resolution
decim       = max([1,round(TR./deltat)]);
u           = zeros(1,n_t*decim);         % input
u(1,1)      = 1e0;
f_fname     = @f_HRF2;               % Ballon model evolution function
g_fname     = @g_HRF_distributed;               % Balloon model observation function
disp('Extracting HRF params...')
[theta,phi] = get_HRFparams(TR,deltat);
disp('Done.')
alpha       = Inf;                  % simulated state noise precision
sigma       = 1e6;                  % simulated data noise precision

% spatial observation parameters
inG.ind_hrf = 1:length(phi);
inG.n_reg = 1;
inG.n_phi = 4;
inG.B = randn(15,inG.n_phi);
phi = [ phi
        1
        2
        -1
        -2  ];
inG.ind_profile{1} = inG.ind_hrf(end)+1:length(phi);

% Build priors for model inversion
priors.muX0         = [0;0;0;0];
priors.SigmaX0      = 0e0*eye(4);
priors.muTheta      = 0.1*ones(length(theta),1);
priors.SigmaTheta   = 1e0*eye(length(theta));
priors.muPhi        = 0*ones(length(phi),1);
priors.SigmaPhi     = 1e0*eye(length(phi));
priors.SigmaPhi(1)  = 0;
priors.a_alpha      = Inf;%1e6;
priors.b_alpha      = 0;%1e2;
priors.a_sigma      = 1e0;
priors.b_sigma      = 1e0;

% Build options and dim structures for model inversion
options.priors      = priors;
options.inF.deltat  = deltat;
options.inF.fullDCM = 0;
options.inF.linearized = 0;
options.inG.TE      = 0.04;
options.decim       = decim;
options.microU      = 1;
options.inG         = inG;
dim.n_theta         = length(theta);
dim.n_phi           = length(phi);
dim.n               = 4;
% options.checkGrads = 1;

% Simulate time series of hidden states and observations
[y,x,x0,eta,e]   = VBA_simulate (n_t,f_fname,g_fname,theta,phi,u,alpha,sigma,options);

% Display simulated time series
displaySimulations(y,x,eta,e);
% disp('--paused--')
% pause

% Call inversion routine
% [posterior,out] = VBA_onlineWrapper(y,u,f_fname,g_fname,dim,options);
[posterior,out] = VBA_NLStateSpaceModel(y,u,f_fname,g_fname,dim,options);

% Display inference results
displayResults(posterior,out,y,x,x0,theta,phi,alpha,sigma)

% Make predictions
try
    options = out.options;
    [xs,ys,xhat,vx,yhat,vy] = VBA_comparePredictions(n_t,theta,phi,u,alpha,sigma,options,posterior,dim);
catch
    disp('------!!Unable to form predictions!!------')
end


function Gc=leadlagc(G,Wc,Gam_c,Kv,key)
G=tf(G); [Gai,Pha]=bode(G,Wc);
Phi_c=sin((Gam_c-Pha-180)*pi/180);
den=G.den{1}; a=den(length(den):-1:1);
ii=find(abs(a)<=0); num=G.num{1};
G_n=num(length(num));
if length(ii)>0
   if ii(1)>1, a=a(ii(1)+1);
   else, a=a(ii(1)+1); end
else, a=a(1); end;
alpha=sqrt((1-Phi_c)/(1+Phi_c));
Zc=alpha*Wc; Pc=Wc/alpha;
Kc=sqrt((Wc*Wc+Pc*Pc)/(Wc*Wc+Zc*Zc))/Gai;
K1=G_n*Kc*alpha/a;
if nargin==4, key=1;
   if Phi_c<0, key=2;
   else, if K1<Kv, key=3; end, end
end
switch key
   case 1, Gc=tf([1 Zc]*Kc,[1 Pc]);
   case 2
      Kc=1/Gai; K1=G_n*Kc/a;
      Gc=tf([1 0.1*Wc],[1 K1*Gcn(2)/Kv]);
   case 3
      Zc2=Wc*0.1; Pc2=K1*Zc2/Kv;
      Gcn=Kc*conv([1 Zc],[1,Zc2]);
      Gcd=conv([1 Pc],[1,Pc2]);
      Gc=tf(Gcn,Gcd);
end


classdef LineSegment < handle
    properties
        p1_;
        p2_;
        R_;
        obs_;
        ellipsoid_;
        polyhedron_;
        local_bbox_; % Bounding Box of map
        epsilon_;
    end
    methods
        function obj = LineSegment(p1, p2)
            obj.p1_ = p1;
            obj.p2_ = p2;
            obj.epsilon_ = 1e-10;
        end

        function dilate(obj, radius)
            obj.find_ellipsoid(radius);
            obj.find_polyhedron();
            obj.add_local_bbox(obj.polyhedron_);
        end

        function set_local_bbox(obj, local_bbox)
            obj.local_bbox_ = local_bbox;
        end

        function set_obs(obj, obs)
            Vs = Polyhedron();
            obj.add_local_bbox(Vs);
            obj.obs_ = Vs.points_inside(obs);
        end

        function add_local_bbox(obj, Vs)
            r = norm(obj.p2_ - obj.p1_)/2;
            dir = (obj.p2_ - obj.p1_)/norm(obj.p2_ - obj.p1_);
            dir_h = [dir(2) -dir(1) 0];
            if(norm(dir_h) == 0)
                    dir_h = [-1 0 0];
            end
            dir_h = dir_h/norm(dir_h);

            % along x
            pp1 = obj.p1_ + dir_h*(r);
            pp2 = obj.p1_ - dir_h*(r);
            Vs.add(Hyperplane(pp1, dir_h));
            Vs.add(Hyperplane(pp2, -dir_h));

            % along y
            pp3 = obj.p2_ + dir*(r);
            pp4 = obj.p1_ - dir*(r);
            Vs.add(Hyperplane(pp3, dir));
            Vs.add(Hyperplane(pp4, -dir));

            % along z,
            dir_v = [0 0 0];
            dir_v(1) =  dir(2) * dir_h(3) - dir(3) * dir_h(2);
            dir_v(2) =  dir(3) * dir_h(1) - dir(1) * dir_h(3);
            dir_v(3) =  dir(1) * dir_h(2) - dir(2) * dir_h(1);
            pp5 = obj.p1_ + dir_v*(r);
            pp6 = obj.p1_ - dir_v*(r);
            Vs.add(Hyperplane(pp5, dir_v));
            Vs.add(Hyperplane(pp6, -dir_v));
        end

        % 3D
        function find_ellipsoid(obj, offset_x)
            f = norm(obj.p1_ - obj.p2_)/2;
            C = [f 0 0; 0 f 0; 0 0 f];
            % f is the radius of the ellipse, the initialized ellipse is a circle
            % C =  [f  0  0]
            %      [0  f  0]
            %      [0  0  f]

            % h = (R^T)*x, (1 0 0)^T = R^T*(p2_ - p1_)  => (p2_ - p1_) = R*(1 0 0)^T
            Ri = rotationMatrix([1 0 0]', (obj.p2_ - obj.p1_)');
            C = Ri * C * (Ri');
            axes = [f f f];
            obj.R_ = Ri;

            E = Ellipsoid(C, (obj.p1_ + obj.p2_)/2 );

            obs = E.points_inside(obj.obs_);
            obs_inside = obs;

            % decide short axes-1
            while (~isempty(obs_inside))
                cp = E.closest_point(obs_inside);
                rcp = (Ri')*(cp - E.d_)';

                % Generate a new ellipse
                if(abs(rcp(1)) < axes(1))
                    newy = sqrt((rcp(2))^2 + (rcp(3))^2);
                    axes(2) = newy / sqrt(1 - (rcp(1)/axes(1))^2);
                end

                new_C = [axes(1) 0 0; 0 axes(2) 0; 0 0 axes(2)];
                E.setC(Ri * new_C * (Ri'));

                % Delete all the points outside the new ellipse
                obs_new = [];
                [len, ~] = size(obs_inside);
                for i = 1 : len
                % constexpr decimal_t epsilon_ = 1e-10;
                    if(1 - E.dist(obs_inside(i,:)) > obj.epsilon_ )
                        obs_new = [obs_new; obs_inside(i,:)];
                    end
                end
                obs_inside = obs_new;
            end

            % decide short axes-2
            C = [axes(1) 0 0; 0 axes(2) 0; 0 0 axes(3)];
            E.setC(Ri * C * (Ri'));

            obs_inside = E.points_inside(obs);
            while (~isempty(obs_inside))
                cp = E.closest_point(obs_inside);
                rcp = (Ri')*(cp - E.d_)';
                dd = sqrt( 1 - (rcp(1)/axes(1))^2 - (rcp(2)/axes(2))^2 );
                if(dd > obj.epsilon_)
                    axes(3) = abs(rcp(3)) / dd;
                end

                new_C = [axes(1) 0 0; 0 axes(2) 0; 0 0 axes(3)];
                E.setC(Ri * new_C * (Ri'));

                % Delete all the points outside the new ellipse
                obs_new = [];
                [len, ~] = size(obs_inside);
                for i = 1 : len
                % constexpr decimal_t epsilon_ = 1e-10;
                    if(1 - E.dist(obs_inside(i,:)) > obj.epsilon_ )
                        obs_new = [obs_new; obs_inside(i,:)];
                    end
                end
                obs_inside = obs_new;
            end

            E.axes_ = axes;
            obj.ellipsoid_ = E;

        end

        function find_polyhedron(obj)
            Vs = Polyhedron();
            obs_remain = obj.obs_;
            while(length(obs_remain))
                plane = obj.ellipsoid_.closest_hyperplane(obs_remain);
                Vs.add(plane);
                obs_tmp = [];
                [len, ~] = size(obs_remain);
                for i = 1 : len
                    p = obs_remain(i,:);
                    if(plane.signed_dist(p) < 0)
                        obs_tmp = [obs_tmp; p];
                    end
                end
                obs_remain = obs_tmp;
            end
            obj.polyhedron_ = Vs;
        end
    end
end


function R1f = computeR1(Param, R1obs)

kf  = Param.kf;
F  = Param.F;
R1r = Param.R1r;

R1f = R1obs - kf*(R1r - R1obs) / (R1r - R1obs + kf/F);

end


function z = Parabola(x)
    z = sum(x.^2);
end


function [fn, FnVar, FnGrad, FnGradCov, constraint, ConstraintCov, ConstraintGrad, ConstraintGradCov] = Contamination(x, runlength, seed, ~)
% function [fn, FnVar, FnGrad, FnGradCov, constraint, ConstraintCov, ConstraintGrad, ConstraintGradCov] = Contamination(x, runlength, seed, other);
% x is a vector containing binary var for yes/no to prevention efforts done
% at the stage
% runlength is the number of independent generations of simulated time
% seed is the index of the substreams to use (integer >= 1)
% other is not used
% Returns cost of prevention treatment, constraint, and ConstraintCov
% If contraints not satisfied,
% prints comparison between probabilities that the contamination fractions are within
% the thresholds versus the probabilities (1-epsilon) that need to be exceeded for each stage.
%
%Note: RandStream.setGlobalStream(stream) can only be used for Matlab
%versions 2011 and later
%For earlier versions, use the method RandStream.setDefaultStream(stream)
%
%   *************************************************************
%   ***            Code written by Danielle Lertola           ***
%   ***          dcl96@cornell.edu    June 25th, 2012         ***
%   ***     Note for future update:  Example parameters need  ***
%   ***                              to be more reasonable.   ***
%   ***            Edited by Jennifer Shih                    ***
%   ***          jls493@cornell.edu    June 18th, 2014        ***
%   *************************************************************
%
% Last updated Jun 18, 2014

FnVar=NaN;
FnGrad = NaN;
FnGradCov = NaN;
ConstraintGrad = NaN;
ConstraintGradCov = NaN;

n=length(x);
if (length(x)~=n) ||(sum(x>ones(n,1))>0) || (sum(x<zeros(n,1))>0) || (runlength <= 0) || (seed <= 0) || (round(seed) ~= seed),
    fprintf('\nx has %u elements, elements of x are binary, \nrunlength should be positive and real, seed should be a positive integer.\n',n);
    fn = NaN;
    constraint = NaN;
    ConstraintCov = NaN;
else % main simulation
    %% *********************PARAMETERS*********************
    nGen=runlength;          %number of independent generations
    u=x;                     %prevention binary decision variable
    X=zeros(n,nGen);         %fraction contaminated at each stage for each generation
    epsilon=.05*ones(n,1);   %error probability
    p=.1*ones(n,1);          %proportion limit
    cost=ones(n,1);          %cost for prevention at stage i
    %Beta parameters for initial contamination, contamination rate,
    %restoration rate
    initialAlpha=1;
    initialBeta=30;
    contamAlpha=1;
    contamBeta=17/3;
    restoreAlpha=1;
    restoreBeta=3/7;

    %% GENERATE RANDOM NUMBER STREAMS
    % Generate new streams for
    [InitialStream, ContaminationStream, RestorationStream] = RandStream.create('mrg32k3a', 'NumStreams', 3);
    % Set the substream to the "seed"
    InitialStream.Substream = seed;
    ContaminationStream.Substream = seed;
    RestorationStream.Substream = seed;

    %% Generate initial fraction of contamination
    OldStream = RandStream.setGlobalStream(InitialStream); % Temporarily store old stream, for versions 2011 and later
    %OldStream = RandStream.setDefaultStream(InitialStream);%for versions 2010 and earlier
    % Generate initial fraction of contamination for stage 1 for each
    % generation
    initialX=betarnd(initialAlpha,initialBeta,1,nGen);

    %% Generate rates of contamination
    RandStream.setGlobalStream(ContaminationStream); %for Matlab versions 2011 and later
    %RandStream.setDefaultStream(ContaminationStream); % for versions 2010 and earlier

    % Generate rates of contamination for each stage and generation
    Lambda=betarnd(contamAlpha,contamBeta,n,nGen);

    %% Generate rates of restoration
    RandStream.setGlobalStream(RestorationStream); %for Matlab versions 2011 and later
    %RandStream.setDefaultStream(RestorationStream); %for Matlab versions 2010 and earlier
    % Generate rates of restoration for each stage and generation
    Gamma=betarnd(restoreAlpha,restoreBeta,n,nGen);

    RandStream.setGlobalStream(OldStream);                   % Restore old random number stream
    %RandStream.setDefaultStream(OldStream); %for versions 2010 and earlier
    %% Determinating fraction of contamination at each stage
    X(1,:)=Lambda(1,:)*(1-u(1)).*(1-initialX) + (1-Gamma(1,:)*u(1)).*initialX;
    for i= 2:n
        X(i,:)=Lambda(i,:)*(1-u(i)).*(1-X(i-1,:)) + (1-Gamma(i,:)*u(i)).*X(i-1,:);
    end

    %mu=mean(X,2);
    %sigma=std(X,0,2);
    limit=1-epsilon;
    %prob=normcdf(p,mu,sigma);
    %cost of contamination control
    fn=sum(cost.*u);
    %if sum(limit>=prob)==0,
    %    fprintf('\nGiven starting solution all contamination fractions are less than the threshold with probability > (1-epsilon)');
    %    fprintf('\nSuccessful with cost %4.2f.\n',sum(cost.*u));
    %else
    %    string=['\nGiven starting solution the probability that the contamination fractions \n'...
    %            'are less than the threshold is <= (1-epsilon) for at least one stage.\n' ...
    %            'Therefore the constraints are not satisfied.\n\n'...
    %            'Column 1 contains the probability that the contamination fractions are less than the threshold.\n' ...
    %            'Column 1 must be greater than column 2 (1-epsilon) for each stage in order for the constraint to be satsified.\n'];
    %    fprintf(string);
    %    results=[prob limit]
    %end
    %checking probability that Xi is <=pi is less than 1-eps
    con=zeros(n,runlength); %matrix of if Xi<pi for each trial and i
    for j=1:runlength
        con(:,j)= (X(:,j)<=p);
    end
    con=con';
    le=sum(sum(con,2)==n);
    constraint=zeros(1,n);
    for k=1:n
        constraint(k)=(sum(con(:,k))/runlength)-limit(k);
    end
    ConstraintCov=cov(con);

end
end


% test the main formulation

addpath('../MALSAR/c_files/largescale_ops/');
addpath('../MALSAR/functions/pacifier/');

clear; clc;
rng(1985)
n = 12;
k = 40;
d = 1000;
t_min = 150;
t_max = 200;
density = 0.001;

X0 = cell(n, 1);
for i = 1 : n
    X0{i} = sprand(d, t_min + randi(t_max-t_min, 1), density);
end

reg_l1 = 1e-10;
reg_l2 = 1e-10;

reg_smooth = 10;

[ U1, V1, Ss1, fv1 ] = pacifier_iba( X0, k+5, reg_l1, reg_l2, reg_smooth);
[ U2, V2, Ss2, fv2 ] = pacifier_sba( X0, k+5, reg_l1, reg_l2, reg_smooth);

figure
plot(fv1)
title('Pacifier IBA Objective Value')

figure
plot(fv2)
title('Pacifier SBA Objective Value')


% TEST_THICK_RING_G_NMNN: data function for Neumann boundary condition.

function g = test_thick_ring_g_nmnn (x, y, z, ind)
  [theta, r] = cart2pol (x, y);
  switch ind
    case 1
      g = -cos (theta) .* exp (x) .* cos (z) .* (sin (x.*y) + y .* cos (x.*y)) -...
            sin (theta) .* x .* exp (x) .* cos (x.*y) .* cos (z);
    case 2
      g = cos (theta) .* exp (x) .* cos (z) .* (sin (x.*y) + y .* cos (x.*y)) +...
            sin (theta) .* x .* exp (x) .* cos (x.*y) .* cos (z);
    case 3
      g = -x .* exp (x) .* cos (x.*y) .* cos (z);
    case 4
      g = -exp (x) .* cos (z) .* (sin (x.*y) + y .* cos (x.*y));
    case 5
      g = exp (x) .* sin (x.*y) .* sin (z);
    case 6
      g = -exp (x) .* sin (x.*y) .* sin (z);
    otherwise
      error ('g_nmnn: unknown reference number');
  end
end


kNum = length(prunedStates);

if kNum > 0
    p_I_G_est = zeros(3,kNum);
    p_I_G_imu = zeros(3, kNum);
    kPlot = zeros(1,kNum);

    for k=1:kNum
        state_k = prunedStates{k}.state_k;

        C_CG = quatToRotMat(prunedStates{k}.q_CG);
        C_CI = quatToRotMat(camera.q_CI);
        p_I_G_est(:,k) = prunedStates{k}.p_C_G - C_CG' * C_CI * camera.p_C_I;
        p_I_G_imu(:,k) = msckfState_imuOnly{state_k}.imuState.p_I_G;

        kPlot(k) = state_k;
    end

    figure(1); clf; hold on;
    plot3(p_I_G_est(1,:),p_I_G_est(2,:),p_I_G_est(3,:),'-b');
    plot3(p_I_G_imu(1,:),p_I_G_imu(2,:),p_I_G_imu(3,:),'-r');
    plot3(r_i_vk_i(1,kPlot),r_i_vk_i(2,kPlot),r_i_vk_i(3,kPlot),'-g');
%     if ~isempty(map)
%         scatter3(map(1,:),map(2,:),map(3,:),'or');
%     end
    xlabel('x');ylabel('y');zlabel('z');
    legend('MSCKF','IMU integration','Ground Truth');
%     legend('MSCKF','IMU integration');
    grid on;

    drawnow;
end


function [L, U] = factor(A, rho)
    [m, n] = size(A);
    if m >= n   % assuming this case is more serious in my application
       L = chol(A'*A + rho*eye(size(A,2)), 'lower');
    else
       L = chol(speye(m) + 1/rho*(A*A'), 'lower');
    end

    U = L';
end


function [F] = mci_nmm_r2p2_dfdp (x,u,P,M)
% Parameter Jacobian for two region, two parameter NMM
% FORMAT [F] = mci_nmm_r2p2_dfdp (x,u,P,M)
%
% x         State
% u         Inputs
% P         Parameters
% M         Model structure
%
% F         F(i,j) = df(x)_i/dp_j
%__________________________________________________________________________
% Copyright (C) 2015 Wellcome Trust Centre for Neuroimaging

% Will Penny and Biswa Sengupta
% $Id: mci_nmm_r2p2_dfdp.m 6548 2015-09-11 12:39:47Z will $

% 18 state variables, 2 parameters
F=zeros(18,2);

curr_P=M.can_P; % Canonical parameter set

w21=P(1);
w12=P(2);

% 2 free parameters
curr_P.A{1}(2,1)=P(1); % Forward connection, w_21
curr_P.A{2}(1,2)=P(2); % Backward connection, w_12

P=curr_P;

% default parameters
E = [1 1/2 1/8]*32;         % extrinsic rates (forward, backward, lateral)
D = [2 16];                 % propogation delays (intrinsic, extrinsic)
H = [4 32];                 % receptor densities (excitatory, inhibitory)
T = [8 16];                 % synaptic constants (excitatory, inhibitory)
R = [2 1]/3;                % parameters of static nonlinearity

% neuronal states into matrix form; x(r,:) for region r
x = spm_unvec(x,M.x);
% extrinsic delays
De = D(2).*exp(P.D)/1000;

% delayed pyramidal cell activity
pyr_ext = presynaptic (x(:,9)-De*(x(:,5)-x(:,6)),P,R);

Te    = T(1)/1000*exp(P.T(:,1));         % excitatory time constants
He    = H(1)*exp(P.G(:,1));              % excitatory receptor density

HeTe=He/Te;

% Effect of forward connection on region 2 stellate cells
F(8,1)=HeTe*pyr_ext(1)*E(1)*w21*exp(w12);
% Effect of backward connection on region 1 pyramidal cells
F(9,2)=HeTe*pyr_ext(2)*E(2)*w12*exp(w12);
% Effect of backward connection on region 1 inhibitory cells
F(15,2)=HeTe*pyr_ext(2)*E(2)*w12*exp(w12);
end

function [S] = presynaptic (x,P,R)

% pre-synaptic inputs: s(V)
%--------------------------------------------------------------------------
R     = R.*exp(P.S);
S     = 1./(1 + exp(-R(1)*(x - R(2)))) - 1./(1 + exp(R(1)*R(2)));

end


function D = prtDistanceHamming(x,y)

[x,y] = prtUtilDistanceParseInputs(x,y);

x = logical(x);
y = logical(y);

%%
%tic
%D2 = sum(bsxfun(@xor,reshape(x,[size(x,1),1,size(x,2)]),reshape(y,[1,size(y,1),size(y,2)])),3);
%toc
%%
D = zeros(size(x,1),size(y,1));
%tic
for iY = 1:size(y,1)
    D(:,iY) = sum(bsxfun(@xor,x,y(iY,:)),2);
end
%toc


function [V, converged, i] = gausspf(Ybus, Sbus, V0, ref, pv, pq, mpopt)
%GAUSSPF  Solves the power flow using a Gauss-Seidel method.
%   [V, CONVERGED, I] = GAUSSPF(YBUS, SBUS, V0, REF, PV, PQ, MPOPT)
%   solves for bus voltages given the full system admittance matrix (for
%   all buses), the complex bus power injection vector (for all buses),
%   the initial vector of complex bus voltages, and column vectors with
%   the lists of bus indices for the swing bus, PV buses, and PQ buses,
%   respectively. The bus voltage vector contains the set point for
%   generator (including ref bus) buses, and the reference angle of the
%   swing bus, as well as an initial guess for remaining magnitudes and
%   angles. MPOPT is a MATPOWER options struct which can be used to
%   set the termination tolerance, maximum number of iterations, and
%   output options (see MPOPTION for details). Uses default options
%   if this parameter is not given. Returns the final complex voltages,
%   a flag which indicates whether it converged or not, and the number
%   of iterations performed.
%
%   See also RUNPF.

%   MATPOWER
%   Copyright (c) 1996-2016, Power Systems Engineering Research Center (PSERC)
%   by Ray Zimmerman, PSERC Cornell
%   and Alberto Borghetti, University of Bologna, Italy
%
%   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.

%% default arguments
if nargin < 7
    mpopt = mpoption;
end

%% options
tol     = mpopt.pf.tol;
max_it  = mpopt.pf.gs.max_it;

%% initialize
converged = 0;
i = 0;
V = V0;
Vm = abs(V);

%% set up indexing for updating V
npv = length(pv);
npq = length(pq);

%% evaluate F(x0)
mis = V .* conj(Ybus * V) - Sbus;
F = [   real(mis([pv; pq]));
        imag(mis(pq))   ];

%% check tolerance
normF = norm(F, inf);
if mpopt.verbose > 1
    fprintf('\n it    max P & Q mismatch (p.u.)');
    fprintf('\n----  ---------------------------');
    fprintf('\n%3d        %10.3e', i, normF);
end
if normF < tol
    converged = 1;
    if mpopt.verbose > 1
        fprintf('\nConverged!\n');
    end
end

%% do Gauss-Seidel iterations
while (~converged && i < max_it)
    %% update iteration counter
    i = i + 1;

    %% update voltage
    %% at PQ buses
    for k = pq(1:npq)'
        V(k) =  V(k) + (conj(Sbus(k) / V(k)) - Ybus(k,:) * V ) / Ybus(k,k);
    end

    %% at PV buses
    if npv
        for k = pv(1:npv)'
            Sbus(k) = real(Sbus(k)) + 1j * imag( V(k) .* conj(Ybus(k,:) * V));
            V(k) =  V(k) + (conj(Sbus(k) / V(k)) - Ybus(k,:) * V ) / Ybus(k,k);
%           V(k) = Vm(k) * V(k) / abs(V(k));
        end
        V(pv) = Vm(pv) .* V(pv) ./ abs(V(pv));
    end

    %% evalute F(x)
    mis = V .* conj(Ybus * V) - Sbus;
    F = [   real(mis(pv));
            real(mis(pq));
            imag(mis(pq))   ];

    %% check for convergence
    normF = norm(F, inf);
    if mpopt.verbose > 1
        fprintf('\n%3d        %10.3e', i, normF);
    end
    if normF < tol
        converged = 1;
        if mpopt.verbose
            fprintf('\nGauss-Seidel power flow converged in %d iterations.\n', i);
        end
    end
end

if mpopt.verbose
    if ~converged
        fprintf('\nGauss-Seidel power flow did not converge in %d iterations.\n', i);
    end
end


function pass = test_times(pref)

if ( nargin == 0 )
    pref = cheboppref();
end

dom = [-1, 1];
diffOp = operatorBlock.diff(dom);
V = chebpoly(1:6);
A = linop(diffOp);
AV = A*V;

B = linop(2*diffOp);
BV = B*V;

err(1) = norm(2*AV - BV);
tol = 1e-14;
pass(1) = err < tol;

end


% 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');


function [nstate] = tapas_mh_mc3_hier_node_sample(data, model, ...
    inference, state, node)
%% Samples for a particular node assuming there is a function for it.
%
%
% This works as the conditional independency of the level allows one to sample
% without worrying about the values in other nodes.
%
% aponteeduardo@gmail.com
% copyright (C) 2016
%

nstate = state;

% Theta is a data object
theta = inference.mh_sampler{node}.propose_sample(data, model, inference, ...
    state, node);

y = state.graph{node - 1};

nllh = model.graph{node - 1}.llh(y, theta, model.graph{node-  1}.htheta);
nlpp = model.graph{node}.llh(theta, state.graph{node + 1}, ...
    model.graph{node}.htheta);

[v] = inference.mh_sampler{node}.ar_rule(state.llh{node - 1}, ...
    state.llh{node}, nllh, nlpp, 0, model.graph{node - 1}.htheta.T);

nstate.graph{node}.y(:, v) = theta.y(:, v);
nstate.llh{node - 1}(:, v) = nllh(:, v);
nstate.llh{node}(:, v) = nlpp(:, v);

nstate.nsample = state.nsample + 1;

end


function [beta_gibbs F_gibbs L_gibbs phi_gibbs sigma_gibbs lambda_t_gibbs sigma_t_gibbs sbar]=stvol3gibbs(Xbart,Xt,yt,B0,phi0,alpha0,delta0,f0,upsilon0,betahat,sigmahat,gamma,G,I_o,omega,T,n,k,It,Bu,pick,pickf)

% preliminary elements for the algorithm
% compute the product G'*I_gamma*G (to speed up computations of deltabar)
GIG=G'*I_o*G;
% compute alphabar
alphabar=T+alpha0;

% initiate the Gibbs sampler
% initiate the counting of iterations
count=1;
pickcount=1;
% initiate the record matrices and cells
beta_gibbs=[];
F_gibbs=[];
L_gibbs=[];
phi_gibbs=[];
sigma_gibbs=[];
lambda_t_gibbs={};
sigma_t_gibbs={};

% step 1: determine initial values for the algorithm

% initial value for beta
beta=betahat;
B=reshape(beta,k,n);
% initial value for f_2,...,f_n
% obtain the triangular factorisation of sigmahat
[Fhat Lambdahat]=bear.triangf(sigmahat);
% obtain the initial value for F
F=Fhat;
% obtain the inverse of Fhat
[invFhat]=bear.invltod(Fhat,n);
% create the cell storing the different vectors of invF
Finv=cell(n,1);
% store the vectors
for ii=2:n
Finv{ii,1}=invFhat(ii,1:ii-1);
end
% initial values for L
L=zeros(T,1);
% initial values for phi
phi=1;

% step 2: determine the sbar values and Lambda
sbar=diag(Lambdahat);
Lambda=sparse(diag(sbar));
% then determine sigma^(0)
sigma=F*Lambda*F';

% step 3: recover the series of initial values for lambda_1,...,lambda_T and sigma_1,...,sigma_T
lambda_t=repmat(diag(sbar),1,1,T);
sigma_t=repmat(sigmahat,1,1,T);

hbar = bear.parfor_progressbar(It,'Progress of the Gibbs sampler');  %create the progress bar

% run the Gibbs sampler
while count<=It

   hbar.iterate(1);   % update progress by one iteration

% step 4: draw beta from its conditional posterior
% first compute the summations required for omegabar and betabar
summ1=zeros(k,k);
summ2=zeros(k,n);
   % run the summation
   for jj=1:T
   prodt=Xt{jj,1}'*exp(-L(jj,1));
   summ1=summ1+prodt*Xt{jj,1};
   summ2=summ2+prodt*yt(:,:,jj)';
   end
% then obtain the inverse of phi0
invphi0=diag(1./diag(phi0));
% obtain the inverse of phibar
invphibar=summ1+invphi0;
% recover phibar
C=chol(bear.nspd(invphibar),'Lower')';
invC=C\speye(k);
phibar=invC*invC';
% recover Bbar
Bbar=phibar*(summ2+invphi0*B0);
% draw B from its posterior
B=bear.matrixndraw(Bbar,sigma,phibar,k,n);
% finally recover beta by vectorising
beta=B(:);

% step 5: draw the series f_2,...,f_n from their conditional posteriors
   % recover first the residuals
   for jj=1:T
   epst(:,:,jj)=yt(:,:,jj)-Xbart{jj,1}*beta;
   end
   % then draw the vectors in turn
   for jj=2:n
   % first compute the summations required for upsilonbar and fbar
   summ1=zeros(jj-1,jj-1);
   summ2=zeros(jj-1,1);
      % run the summation
      for kk=1:T
      prodt=epst(1:jj-1,1,kk)*exp(-L(kk,1));
      summ1=summ1+prodt*epst(1:jj-1,1,kk)';
      summ2=summ2+prodt*epst(jj,1,kk)';
      end
   summ1=(1/sbar(jj,1))*summ1;
   summ2=(-1/sbar(jj,1))*summ2;
   % then obtain the inverse of upsilon0
   invupsilon0=diag(1./diag(upsilon0{jj,1}));
   % obtain upsilonbar
   invupsilonbar=summ1+invupsilon0;
   C=chol(bear.nspd(invupsilonbar));
   invC=C\speye(jj-1);
   upsilonbar=full(invC*invC');
   % recover fbar
   fbar=upsilonbar*(summ2+invupsilon0*f0{jj,1});
   % finally draw f_i^(-1)
   Finv{jj,1}=fbar+chol(bear.nspd(upsilonbar),'lower')*randn(jj-1,1);
   end
% recover the inverse of F
invF=eye(n);
   for jj=2:n
   invF(jj,1:jj-1)=Finv{jj,1};
   end
% eventually recover F
F=bear.invltod(invF,n);
% update sigma
sigma=F*Lambda*F';

% step 6: draw phi from its conditional posterior
% estimate deltabar
deltabar=L'*GIG*L+delta0;
% draw the value phi_i
phi=bear.igrandn(alphabar/2,deltabar/2);

% step 7: draw the series lambda_t from their conditional posteriors, t=1,...,T
   % consider periods in turn
   for kk=1:T
   % a candidate value will be drawn from N(lambdabar,phibar)
   % the definitions of lambdabar and phibar varies with the period, thus define them first
      % if the period is the first period
      if kk==1
      lambdabar=(gamma*L(2,1))/(1/omega+gamma^2);
      phibar=phi/(1/omega+gamma^2);
      % if the period is the final period
      elseif kk==T
      lambdabar=gamma*L(T-1,1);
      phibar=phi;
      % if the period is any period in-between
      else
      lambdabar=(gamma/(1+gamma^2))*(L(kk-1,1)+L(kk+1,1));
      phibar=phi/(1+gamma^2);
      end
   % now draw the candidate
   cand=lambdabar+phibar^0.5*randn;
   % compute the acceptance probability
   prob=bear.mhprob3(cand,L(kk,1),sbar,epst(:,1,kk),Finv,n);
   % draw a uniform random number
   draw=rand;
      % keep the candidate if the draw value is lower than the prob
      if draw<=prob
      L(kk,1)=cand;
      % if not, just keep the former value
      end
   end
% then recover the series of matrices lambda_t and sigma_t
for kk=1:T
lambda_t(:,:,kk)=exp(L(kk,1))*diag(sbar);
sigma_t(:,:,kk)=F*lambda_t(:,:,kk)*F';
end

% record phase
   % if the burn-in sample phase is not yet over
   if count<=Bu
   % simply add 1 to the iteration count
   count=count+1;
   % on the other hand, if the burn-in sample phase is over
   elseif count>Bu
   % adding one iteration to the count will depend on wether post-burn selection applies
      % if there is no post burn selection
      if pick==0
      % record the results
      beta_gibbs(:,count-Bu)=beta;
      F_gibbs(:,:,count-Bu)=F;
      L_gibbs(:,:,count-Bu)=L;
      phi_gibbs(count-Bu,1)=phi;
      sigma_gibbs(:,count-Bu)=sigma(:);
         for jj=1:T
         lambda_t_gibbs{jj,1}(:,:,count-Bu)=lambda_t(:,:,jj);
         sigma_t_gibbs{jj,1}(:,:,count-Bu)=sigma_t(:,:,jj);
         end
      % then add one to the count
      count=count+1;
      % if there is post burn selection, only one draw over 'fpick' draws will be retained
      elseif pick==1
         % if the iteration does not correspond to fpick, don't record the results, don't increase the regular count, but do increase pickcount by 1, and do record the acceptance rate of the Metropolis-Hastings step
         if pickcount~=pickf
         pickcount=pickcount+1;
         % on the other hand, if the iteration does correspond to fpick
         elseif pickcount==pickf
         % do record the results
         beta_gibbs(:,count-Bu)=beta;
         F_gibbs(:,:,count-Bu)=F;
         L_gibbs(:,:,count-Bu)=L;
         phi_gibbs(count-Bu,1)=phi;
         sigma_gibbs(:,count-Bu)=sigma(:);
            for jj=1:T
            lambda_t_gibbs{jj,1}(:,:,count-Bu)=lambda_t(:,:,jj);
            sigma_t_gibbs{jj,1}(:,:,count-Bu)=sigma_t(:,:,jj);
            end
         % then increase the regular count by 1 and re-initialise pickcount
         count=count+1;
         pickcount=1;
         end
      end
   end

end

close(hbar);   %close progress bar


% 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


classdef CEC2017_F2 < PROBLEM
% <single> <real> <constrained>
% CEC'2017 constrained optimization benchmark problem

%------------------------------- Reference --------------------------------
% G. Wu, R. Mallipeddi, and P. N. Suganthan, Problem definitions and
% evaluation criteria for the CEC 2017 competition on constrained real-
% parameter optimization, National University of Defense Technology, China,
% 2016.
%------------------------------- 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".
%--------------------------------------------------------------------------

    properties
        O;      % Optimal decision vector
        Mat;	% Rotation matrix
    end
    methods
        %% Default settings of the problem
        function Setting(obj)
            CallStack = dbstack('-completenames');
            load(fullfile(fileparts(CallStack(1).file),'CEC2017.mat'),'Data');
            obj.O = Data{2}.o;
            obj.M = 1;
            if isempty(obj.D) || obj.D < 30
                obj.D   = 10;
                obj.Mat = Data{2}.M_10;
            elseif obj.D < 50
                obj.D   = 30;
                obj.Mat = Data{2}.M_30;
            elseif obj.D < 100
                obj.D   = 50;
                obj.Mat = Data{2}.M_50;
            else
                obj.D   = 100;
                obj.Mat = Data{2}.M_100;
            end
            obj.lower    = zeros(1,obj.D) - 100;
            obj.upper    = zeros(1,obj.D) + 100;
            obj.encoding = ones(1,obj.D);
        end
        %% Calculate objective values
        function PopObj = CalObj(obj,PopDec)
            Z = PopDec - repmat(obj.O(1:size(PopDec,2)),size(PopDec,1),1);
            PopObj = sum(cumsum(Z,2).^2,2);
        end
        %% Calculate constraint violations
        function PopCon = CalCon(obj,PopDec)
            Z = PopDec - repmat(obj.O(1:size(PopDec,2)),size(PopDec,1),1);
            Y = Z*obj.Mat';
            PopCon = sum(Y.^2-5000*cos(0.1*pi*Y)-4000,2);
        end
    end
end


function [curImage,phImage] = mrThreshPhVol(samp,sampSize,volco,volph,volume,sagSize,numSlices,x,y,dataRange)
%
%
% PURPOSE:
%   Compute an image whose pixel values show the best phase angle of
%   the time series at each image point.
%
%
% AUTHOR:  Engel
%
%

% Variable Declarations
thr = [];			% Vector of 1s and 0s.  1 means co > thresh
				% 0 means co <= thresh.
global interpflag volslicut volslimin1 volslimax1;

if isempty(volco)
   disp ('Correlation data is not available.');
   return
end

if (interpflag)
	sinIm = mrExtractImgVol(sin(volph),sagSize,dataRange(2)-dataRange(1)+1,samp,dataRange);
	cosIm = mrExtractImgVol(cos(volph),sagSize,dataRange(2)-dataRange(1)+1,samp,dataRange);
	phImage = atan2(sinIm,cosIm);
else
	phImage = mrExtractImgVol(volph,sagSize,dataRange(2)-dataRange(1)+1,samp,dataRange);
end
phImage = phImage;

curImage = mrExtractImgVol(volume,sagSize,numSlices,samp);

co = mrExtractImgVol(volco,sagSize,dataRange(2)-dataRange(1)+1,samp,dataRange);

cutoff = get(volslicut,'value');
disp(['Cutoff = ',num2str(cutoff)]);
thr = co > cutoff;
curImage(thr) = -((phImage(thr)+pi)/(2*pi)*110);	%Scale negatives for colors

myShowImageVol(curImage,sampSize,max(curImage)*get(volslimin1,'value'),max(curImage)*get(volslimax1,'value'),x,y);


function [mPerc, mProb] =calc_zlta(mCat0,mCat1,mCat2,fTstart,fT,fTw,nTbin,nN)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Example: mLTA=calc_zlta(mCat00,mCat20,params.fTstart, fT,fTw,nTbin, nN);
%
% This function calculates the rate changes (z-value) of earthquake
% occurrencs between two periods. This function calculates rate changes for
% all the grid nodes together. Input is either a single vector or a whole
% matrix columnswise only with dates (not the whole catalog). Output is the
% z(lta)- and its probability value for each grid point.
%
% Author: van Stiphout, Thomas
% Email: vanstiphout@sed.ethz.ch
% Created: 7. Aug. 2007
% Changed: 14. Aug.2007
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Variables:
% mCat0          Catalog complete (only origin time)
% mCat1          Catalog period 1 (vector or matrix with yrs in column)
% mCat2          Catalog period 2 (vector or matrix with yrs in column)
% fTstart        Begin of time period 1
% fT             Date for which rate change is calculated
% fTw            Length of Time window of second period
% nTbin          Length of Time steps for histogram
% nN             Sampling volume
%
% Output:
% mLTA           Scalar or vector with beta values for each input column
% mProb          Scalar or vector with probability for beta values for each
%                input column. The probability is either calculated based
%                on a synthetic catalog or a real-like catalog.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% disp('~/zmap/src/thomas/seismicrates/calc_zlta.m');
% probability calculation based on synthetic catalogs.
% Synthetic catalogs either based catalog with uniform rates (o) or according to
% complete catalog (1)
bSyn=logical(0);

% calculate histogram for different time periods
% nSteps=floor((fT-fTstart)/(nTbin/365));
% vR1=histc(mCat1,  fTstart:(nTbin/365):fTstart+nSteps*(nTbin/365)  );
vR1=histc(mCat1,fTstart : nTbin/365 : fT-fTw,1);
vR1=vR1(1:end-1,:);

% vR1=histc(mCat1,fTimeStart:fTimeSteps/365:fTimeCut+fTimeWindow);
vR2=histc(mCat2,fT-fTw : nTbin/365:fT,1);
vR2=vR2(1:end-1,:);

% calculate the mean rate for different periods
mean1=mean(vR1);
mean2=mean(vR2);

var1 = var(vR1);
var2 = var(vR2);

if isempty(vR1)
    disp('Warning - Time Period 1 is without any event');
elseif isempty(vR2)
    disp('Warning - Time Period 2 is without any event');
end

% create synthetic catalogs to extimate significance level
% reset random number generator
rand('state',sum(100*clock));
if bSyn
    vPos=ceil(rand(nN,1000).*size(mCat0,1));
    mSyn1=mCat0(vPos);
 else
    mSyn1=rand(nN,1000)*(fT-fTstart)+fTstart;
end
% apply histogram to synthetic catalog
vS1=histc(mSyn1,fTstart : nTbin/365 : fT-fTw,1);
vS1=vS1(1:end-1,:);
vS2=histc(mSyn1,fT-fTw : nTbin/365:fT,1);
vS2=vS2(1:end-1,:);
% calculate the mean rate for different periods in synthetic catalog
mSynMean1=mean(vS1);
mSynMean2=mean(vS2);
% calculate z(lta) values for synthetic catalog
mSynPerc=(mSynMean2./mSynMean1.*100)-100;
% calculate values for normal distribution
% [jbt(i), jbp(i)]=jbtest(mSynLTA);
% llt(i)=lillietest(mSynLTA);
[mu,s] = normfit(mSynPerc);

% z(lta)
mPerc=(mean2./mean1.*100)-100;
% calculate the probability of z(lta)-values
[mProb] = 1-normpdf(mPerc,mu,s);
% figure;plot(mLTA,mProb,'.');


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 blas1_s_test09 ( )

%*****************************************************************************80
%
%% TEST09 tests SROT.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 May 2006
%
%  Author:
%
%    John Burkardt
%
  n = 6;

  for i = 1 : n
    x(i) = i;
  end

  for i = 1 : n
    y(i) = i * i - 12;
  end

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST09\n' );
  fprintf ( 1, '  SROT carries out a Givens rotation.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  X and Y\n' );
  fprintf ( 1, '\n' );
  for i = 1 : n
    fprintf ( 1, '  %6d  %12f  %12f\n', i, x(i), y(i) );
  end

  c = 0.5;
  s = sqrt ( 1.0 - c * c );
  [ x, y ] = srot ( n, x, 1, y, 1, c, s );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  SROT ( N, X, 1, Y, 1, %f, %f )\n', c, s );
  fprintf ( 1, '\n' );
  for i = 1 : n
    fprintf ( 1, '  %6d  %12f  %12f\n', i, x(i), y(i) );
  end

  for i = 1 : n
    x(i) = i;
  end

  for i = 1 : n
    y(i) = i * i - 12;
  end

  c = x(1) / sqrt ( x(1) * x(1) + y(1) * y(1) );
  s = y(1) / sqrt ( x(1) * x(1) + y(1) * y(1) );
  [ x, y ] = srot ( n, x, 1, y, 1, c, s );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  SROT ( N, X, 1, Y, 1, %f, %f )\n', c, s );
  fprintf ( 1, '\n' );
  for i = 1 : n
    fprintf ( 1, '  %6d  %12f  %12f\n', i, x(i), y(i) );
  end

  return
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 fact_test ( )

%*****************************************************************************80
%
%% FACT_TEST tests the use of the MEX file FACT.F
%
%  Discussion:
%
%    The file fact.F is a FORTRAN77 function which computes the factorial.
%
%    This M file "compiles" fact.F, and then shows how it can be called.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 September 2013
%
%  Author:
%
%    John Burkardt
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'FACT_TEST\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '  Demonstrate a simple use of the MEX compiler,\n' );
  fprintf ( 1, '  which allows MATLAB to call FORTRAN77 functions.\n' );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Get a directory listing.  The file "fact.F" should,\n' );
  fprintf ( 1, '  show up here.\n' );

  ls

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Compile the file "fact.F".\n' );

  mex fact.F

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Get a directory listing.  A new file should show up,\n' );
  fprintf ( 1, '  containing the compiled information.\n' );

  ls

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Now use FACT as though it were a MATLAB M-file function.\n' );

  fprintf ( 1, '\n' );
  fprintf ( 1, '   N  (N Factorial)' );
  fprintf ( 1, '\n' );

  for i = 1 : 10

    j = fact ( i );

    fprintf ( 1, '  %2d  %10d\n', i, j );

  end

  fprintf ( 1, '\n' );
  fprintf ( 1, 'FACT_TEST:\n' );
  fprintf ( 1, '  Normal end of execution.\n' );
  fprintf ( 1, '\n' );
  timestamp ( );

  return
end
function timestamp ( )

%*****************************************************************************80
%
%% TIMESTAMP prints the current YMDHMS date as a timestamp.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
  t = now;
  c = datevec ( t );
  s = datestr ( c, 0 );
  fprintf ( 1, '%s\n', s );

  return
end


function [hp] = kW2hp(kW)
% Convert power from kilowatts to mechanical horsepower.
% Chad A. Greene 2012
hp = kW*1.34102209;


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 [MPa] = hPa2MPa(hPa)
% Convert pressure from hectopascals to megapascals.
% Chad Greene 2012
MPa = hPa*0.000100000;


function b = cc_mv ( m, n, ncc, icc, ccc, acc, x )

%*****************************************************************************80
%
%% CC_MV multiplies a CC matrix by a vector
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 July 2014
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Iain Duff, Roger Grimes, John Lewis,
%    User's Guide for the Harwell-Boeing Sparse Matrix Collection,
%    October 1992
%
%  Parameters:
%
%    Input, integer M, the number of rows.
%
%    Input, integer N, the number of columns.
%
%    Input, integer NCC, the number of CC values.
%
%    Input, integer ICC(NCC), the CC rows.
%
%    Input, integer CCC(N+1), the compressed CC columns
%
%    Input, real ACC(NCC), the CC values.
%
%    Input, real X(N), the vector to be multiplied.
%
%    Output, real B(M), the product A*X.
%
  b = zeros(m,1);

  for j = 1 : n
    for k = ccc(j) : ccc(j+1) - 1
      i = icc(k);
      b(i) = b(i) + acc(k) * x(j);
    end
  end

  return
end


% Examples employing logarithms, exponentials, and entropy functions
%
%  max_entropy.m                    - Entropy maximization
%  sparse_covariance_est.m          - Sparse covariance estimation for Gaussian variables
%  sparse_covariance_est_tradeoff.m - Sparse covariance estimation for Gaussian variables
%  weighted_analytic_center.m       - Weighted analytic center of a set of linear inequalities
help Contents


function out = TreatData(data,treat,vnames,dates,DatesOpt)
% =======================================================================
% Treat data.
% =======================================================================
% [nobs, dates] = CountDate(fo_year,lo_year,frequency,fo_period,lo_period)
% -----------------------------------------------------------------------
% INPUT
%	- data: structure where the the data is stored
%	- treat: vector (of length N) with type of treatment
%	- vnames: vector (of length N) with variable names
% -----------------------------------------------------------------------
% OUTPUT
%	- out: matrix of treated data
% =======================================================================
% Ambrogio Cesa Bianchi, March 2015
% ambrogio.cesabianchi@gmail.com

% Retrieve some parameters
nobs = DatesOpt.nobs;
fo_year = DatesOpt.fo_year;
lo_year = DatesOpt.lo_year;
frequency = DatesOpt.frequency;
fo_period = DatesOpt.fo_period;
lo_period = DatesOpt.lo_period;

% Get first
if strcmp(frequency,'y')
    aux = num2str(fo_year);
else
    aux = [num2str(fo_year) frequency num2str(fo_period)];
end
fo = find(strcmp(aux,dates));

% Get last
if strcmp(frequency,'y')
    aux = num2str(lo_year);
else
    aux = [num2str(lo_year) frequency num2str(lo_period)];
end
lo = find(strcmp(aux,dates));

% Initialize matrix
nvar = length(vnames);
out = nan(nobs,nvar);

for ii=1:nvar
    % No treatment
    if treat(ii)==0
        out(:,ii) = data.(vnames{ii})(fo:lo);
    % Log
    elseif treat(ii)==1
        out(:,ii) = log(data.(vnames{ii})(fo:lo));
    % Log-diff
    elseif treat(ii)==2
        out(:,ii) = XoX(data.(vnames{ii})(fo:lo),1,'logdiff');
    % Diff
    elseif treat(ii)==3
        out(:,ii) = XoX(data.(vnames{ii})(fo:lo),1,'diff');
    end
end


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


function [B, Y] = compressSELVE(X, SELVEparam)
%function Y = compressSELVE(X, Anchor, lambda, s, sigma, tempResults)

Anchor = SELVEparam.anchor;
s = SELVEparam.s;
lambda = SELVEparam.lambda;
sigma = SELVEparam.sigma;
tempResults = SELVEparam.tempResults;

[n,dim] = size(X);
m = size(Anchor,1);

%% get Z
Z = zeros(n,m);
Dis = sqdist(X',Anchor');
clear X;
clear Anchor;

val = zeros(n,s);
pos = val;
for i = 1:s
    [val(:,i),pos(:,i)] = min(Dis,[],2);
    tep = (pos(:,i)-1)*n+[1:n]';
    Dis(tep) = 1e60;
end
clear Dis;
clear tep;
val = exp(-val/(1/1*sigma^2));
val = repmat(sum(val,2).^-1,1,s).*val; %% normalize
tep = (pos-1)*n+repmat([1:n]',1,s);
Z([tep]) = [val];
Z = sparse(Z);
clear tep;
clear val;
clear pos;
lamda1 = sum(Z);
Z = diag(lamda1.^-0.5)*Z'; %Z : fea * ins
Z = Z';

tempS = tempResults.T*Z' + repmat(tempResults.beta,1,size(Z,1));
Y = double(tempS > repmat(tempResults.Ui,1,n));
Y = Y';
B = compactbit(Y);


%% 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


%% housekeeping
clear
clc
close all
%% "rise" the model
m=rise('fs2000_rise');
%% pushing the particular vector (different from the initial estimation point)
% Note we have to declare the regime of the parameter

calibration=struct();
	calibration.alp=0.330;
	calibration.bet=0.990;
	calibration.gam=0.003;
	calibration.mst=1.011;
	calibration.rho=0.700;
	calibration.psi=0.787;
	calibration.del=0.020;
	calibration.sig_a=0.014;
	calibration.sig_m=0.005;
m=set(m,'parameters',calibration);

%% solve the model and
m=solve(m);

%% print the solution

m.print_solution

disp('This should be identical to the dynare solution (see folder dynare_version)')

%% lets do some estimation: we need the data
% get the data from the dynare_version folder

run dynare_version\fsdat_simul

% rise needs data to be passed as a ts object with dates and
% names of the variables. So we proceed to constructing the database

% we use the same start date as in the Schorfheide paper even though the
% data are not the same
startdate='1950q1';
database=ts(startdate,[gp_obs,gy_obs],{'gp_obs','gy_obs'});

%% pass the data to the rise object

% 192 observations are used in dynare
end_date= obs2date(startdate,192);
% the loglinear option of dynare implies:
% 1- we have to take the log of our data.
% 2- we have to exponentiate the corresponding variables in the rise model
% file. Dynare does this by taking the log of the steady state during
% estimation and this does not ring too transparent to me.

% In rise, we can just take the log of the whole database. This is
% what we do in passing the data. But we also need to tell ts
% that the logged variables should have the same names as the original
% ones. In order to do that, we add set the flag to true when taking the
% log.
vnames=database.varnames;
database=log(database);
database.varnames=vnames;
m=set(m,'data',database,'estim_end_date',end_date);

%% estimate the model
profile off
profile on
m=estimate(m);%,'optimizer',@csminwellwrap,'debug',true
profile off
profile viewer

%% do posterior simulation
[objective,lb,ub,x0,SIG]=pull_objective(m);

SIG=utils.cov.nearest(SIG);

draws_mcmc = 1000; % number of parameter draws through MCMC.
ndraws_burnin = floor(0.1*draws_mcmc);
mcmc_options=struct('burnin',ndraws_burnin,'N',draws_mcmc,'thin',1,...
    'nchain',2);
Results=mh_sampler(objective,lb,ub,mcmc_options,x0,SIG);

%% update the description of the parameters
m=set(m,'tex_name',...
    {
    'alp','$\alpha$'
    'bet','$\beta$'
    'gam','$\gamma$'
    'rho','$\rho$'
    'psi','$\psi$'
	'del','$\delta$'
    'sig_a','$\sigma_a$'
    'sig_m','$\sigma_m$'
    });
%% plot priors, posteriors, priors and posteriors
plot_priors(m)
plot_posteriors(m,Results)
plot_priors_and_posteriors(m,Results)
%% plot priors, posteriors, priors and posteriors for a subset of parameters
close all
myparams={'alp','gam','psi'};
plot_priors(m,myparams)
plot_posteriors(m,Results,myparams)
plot_priors_and_posteriors(m,Results,myparams)
%% check curvature at the mode
mode_curvature(m)

%% check curvature at the mode for a subset of parameters
mode_curvature(m,myparams)

%% check curvature at the mode for a subset of parameters
profile off
profile on
mode_curvature(m,myparams)
profile off
profile viewer


function f = exp(f)
%EXP  Exponential of a CHEBFUN3T object.
%   EXP(F) returns the exponential of a CHEBFUN3T object F.

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

% Empty check:
if ( isempty(f) )
    return
end

op = @(x,y,z) exp(feval(f, x, y, z));    % Resample.
f = chebfun3t(op, f.domain);             % Call constructor.

end


function Population = EnvironmentalSelection(Population,Offspring,N)
% The environmental selection of GDE3

%------------------------------- 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".
%--------------------------------------------------------------------------

    %% Select by constraint-domination
    PopObj    = Population.objs;
    PopCon    = Population.cons;
    feasibleP = all(PopCon<=0,2);
    OffObj    = Offspring.objs;
    OffCon    = Offspring.cons;
    feasibleO = all(OffCon<=0,2);
    % The offsprings which can replace its parent
    updated = ~feasibleP&feasibleO  | ...
              ~feasibleP&~feasibleO & all(PopCon>=OffCon,2) | ...
              feasibleP&feasibleO   & all(PopObj>=OffObj,2);
    % The offsprings which can add to the population
    selected = feasibleP&feasibleO & any(PopObj<OffObj,2) & any(PopObj>OffObj,2);
    % Update the population
    Population(updated) = Offspring(updated);
    Population          = [Population,Offspring(selected)];

    %% Select by non-dominated sorting and crowding distance
    PopObj   = Population.objs;
    PopCon   = Population.cons;
    feasible = all(PopCon<=0,2);
    % Non-dominated sorting based on constraint-domination
    FrontNo = inf(1,length(Population));
    [FrontNo(feasible),MaxFNo] = NDSort(PopObj(feasible,:),inf);
    FrontNo(~feasible) = NDSort(PopCon(~feasible,:),inf) + MaxFNo;
    % Determine the last front
    MaxFNo    = find(cumsum(hist(FrontNo,1:max(FrontNo)))>=N,1);
    lastFront = find(FrontNo==MaxFNo);
    % Eliminate solutions in the last front one by one
    while length(lastFront) > N - sum(FrontNo<MaxFNo)
        [~,worst] = min(CrowdingDistance(PopObj(lastFront,:)));
        lastFront(worst) = [];
    end
    Population = Population([find(FrontNo<MaxFNo),lastFront]);
end


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 [net, opts] = get_model(opts, addFC)
if nargin < 2, addFC = true; end

t0 = tic;
modelFunc = str2func(sprintf('models.%s', opts.arch));
[net, opts, in_name, in_dim] = modelFunc(opts);
logInfo('%s in %.2fs', opts.arch, toc(t0));

% + FC layer
if addFC
    convobj = dagnn.Conv('size', [1 1 in_dim opts.dim], ...
        'pad', 0, 'stride', 1, 'hasBias', true);
    params = convobj.initParams();
    net.addLayer('fc', convobj, {in_name}, {'logits'}, {'fc_w', 'fc_b'});
    p1 = net.getParamIndex('fc_w');
    p2 = net.getParamIndex('fc_b');
    net.params(p1).value = params{1};
    net.params(p2).value = params{2};
    net.params(p1).learningRate = opts.lrmult;
    net.params(p2).learningRate = opts.lrmult;

    in_name = 'logits';
    in_dim  = opts.dim;
end

% + l2 normalization layer
net.addLayer('L2norm', dagnn.LRN('param', [2*in_dim, 0, 1, 0.5]), ...
    {in_name}, {'feats_l2'});

% + loss layer
lossobj = str2func(opts.obj);
net.addLayer('loss', lossobj('opt', opts), {'feats_l2', 'labels'}, {'objective'});

% print
if 0
    net.print({'data', [opts.imageSize opts.imageSize 3 opts.batchSize]}, ...
        'MaxNumColumns', 4, 'Layers', [], 'Parameters', []);
end

end


function [out] = evap_2(p1,S,Smax,Ep,dt)
%evap_2

% Copyright (C) 2019, 2021 Wouter J.M. Knoben, Luca Trotter
% This file is part of the Modular Assessment of Rainfall-Runoff Models
% Toolbox (MARRMoT).
% MARRMoT is a free software (GNU GPL v3) and distributed WITHOUT ANY
% WARRANTY. See <https://www.gnu.org/licenses/> for details.

% Flux function
% ------------------
% Description:  Evaporation at a scaled, plant-controlled rate
% Constraints:  f <= Ep
%               f <= S/dt
% @(Inputs):    p1   - plant-controlled base evaporation rate [mm/d]
%               S    - current storage [mm]
%               Smax - maximum storage [mm]
%               Ep   - potential evapotranspiration rate [mm/d]
%               dt   - time step size [d]

out = min([p1*S/Smax,Ep,S/dt]);

end


function [ind,d] = find(v,w,epsilon,varargin)
% return index of all points in a epsilon neighborhood of a vector
%
% Syntax
%   ind = find(v,w,epsilon) % find all points out of v in a epsilon neighborhood of w
%   ind = find(v,w)         % find closest point out of v to w
%
% Input
%  v, w    - @vector3d
%  epsilon - double
%
% Options
%  antipodal - include <VectorsAxes.html antipodal symmetry>
%
% Output
%  ind     - int32

% compute distances
d = angle_outer(v,w,varargin{:});

% find neigbours
if nargin >= 3
  if epsilon == 1
    [d,ind] = min(d,[],1);
  else
    ind = d < epsilon;
  end
else
  [d,ind] = min(d,[],1);
end


classdef MyODEMR < ALGORITHM
% <multi/many> <real/integer>
% Many-objective differential evolution with mutation restriction
% nP --- 500 --- Number of reference points for IGD calculation

%------------------------------- Reference --------------------------------
% R. Denysiuk, L. Costa, and I. E. Santo, Many-objective optimization using
% differential evolution with variable-wise mutation restriction,
% Proceedings of the Annual Conference on Genetic and Evolutionary
% Computation, 2013, 591-598.
%------------------------------- 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".
%--------------------------------------------------------------------------

% This function is written by Roman Denysiuk

    methods
        function main(Algorithm,Problem)
            %% Parameter setting
            nP = Algorithm.ParameterSet(500);

            %% Generate hyperplane
            P = UniformPoint(nP,Problem.M);

            %% Generate random population
            Population = Problem.Initialization();

            %% Optimization
            while Algorithm.NotTerminated(Population)
                Offspring  = Operator(Problem,Population(1:Problem.N),Population(randi(Problem.N,1,Problem.N)),Population(randi(Problem.N,1,Problem.N)));
                Population = EnvironmentalSelection([Population,Offspring],Problem.N,P);
            end
        end
    end
end