% [INPUT]
% data = A float t-by-n matrix (-Inf,Inf) representing the model input.
% tail = A string representing the target tail:
%   - 'L' for lower tail;
%   - 'U' for upper tail.
% bw = An integer [21,252] representing the dimension of each rolling window (optional, default=252).
% f = A float [0.05,0.20] representing the percentage of observations to be included in tails (optional, default=0.10).
% pt = A float [0,1) representing the initial penantly term for underrepresented samples with respect to the bandwidth (optional, default=0.5).
%
% [OUTPUT]
% chi = A float n-by-n-by-t matrix [0,1] representing the Chi coefficients.
% chi_bar = A float n-by-n-by-t matrix [-1,1] representing the Chi Bar coefficients.
%
% [NOTES]
% The bandwidth is automatically expanded as much as possible following an optimality criteria.

function [chi,chi_bar] = asymptotic_tail_dependence(varargin)

    persistent ip;

    if (isempty(ip))
        ip = inputParser();
        ip.addRequired('data',@(x)validateattributes(x,{'double'},{'real' '2d' 'nonempty'}));
        ip.addRequired('tail',@(x)any(validatestring(x,{'L' 'U'})));
        ip.addOptional('bw',252,@(x)validateattributes(x,{'double'},{'real' 'finite' 'integer' '>=' 21 '<=' 252 'scalar'}));
        ip.addOptional('f',0.10,@(x)validateattributes(x,{'double'},{'real' 'finite' '>=' 0.05 '<=' 0.2 'scalar'}));
        ip.addOptional('pt',0.5,@(x)validateattributes(x,{'double'},{'real' 'finite' '>=' 0 '<' 1 'scalar'}));
    end

    ip.parse(varargin{:});

    ipr = ip.Results;
    [data,bw] = validate_input(ipr.data,ipr.bw);
    tail = ipr.tail;
    f = ipr.f;
    pt = ipr.pt;

    nargoutchk(1,2);

    [chi,chi_bar] = asymptotic_tail_dependence_internal(data,bw,tail,f,pt);

end

function [chi,chi_bar] = asymptotic_tail_dependence_internal(data,bw,tail,f,pt)

    up = isempty(getCurrentTask());

    [t,n] = size(data);

    c = nchoosek(1:n,2);
    c_len = size(c,1);

    dc = cell(c_len,2);

    for i = 1:c_len
        c_i = c(i,:);
        dc(i,:) = {c_i data(:,c_i)};
    end

    pt = [linspace(pt,1,bw).'; ones(t-bw,1)];

    dc_results = cell(c_len,2);

    if (up)
        parfor k = 1:c_len
            windows = extract_rolling_windows(dc{k,2},bw);

            chi_k = zeros(t,1);
            chibar_k = zeros(t,1);

            for w = 1:t
                dc_kw = windows{w};

                [chi_kw,chibar_kw] = calculate_coefficients(dc_kw,tail,f);
                chi_k(w) = chi_kw;
                chibar_k(w) = chibar_kw;
            end

            dc_results(k,:) = {(chi_k .* pt) (chibar_k .* pt)};
        end
    else
        for k = 1:c_len
            windows = extract_rolling_windows(dc{k,2},bw);

            chi_k = zeros(t,1);
            chibar_k = zeros(t,1);

            for w = 1:t
                dc_kw = windows{w};

                [chi_kw,chibar_kw] = calculate_coefficients(dc_kw,tail,f);
                chi_k(w) = chi_kw;
                chibar_k(w) = chibar_kw;
            end

            dc_results(k,:) = {(chi_k .* pt) (chibar_k .* pt)};
        end
    end

    en = eye(n);
    chi = repmat(en,1,1,t);
    chi_bar = repmat(en,1,1,t);

    for k = 1:c_len
        dc_k = dc{k,1};
        i = dc_k(1);
        j = dc_k(2);

        [chi_k,chibar_k] = deal(dc_results{k,:});
        chi(i,j,:) = chi_k;
        chi(j,i,:) = chi_k;
        chi_bar(i,j,:) = chibar_k;
        chi_bar(j,i,:) = chibar_k;
    end

    for i = 1:t
        nan_indices = isnan(data(i,:));

        if (any(nan_indices))
            chi(nan_indices,:) = NaN;
            chi(:,nan_indices) = NaN;

            chi_bar(nan_indices,:) = NaN;
            chi_bar(:,nan_indices) = NaN;
        end
    end

end

function [chi,chi_bar] = calculate_coefficients(data,tail,f)

    if (any(any(isnan(data),1)))
        chi = NaN;
        chi_bar = NaN;
        return;
    end

    t = size(data,1);
    t1 = t + 1;

    nu = max(round(t * f),1);
    nu1 = nu + 1;

    if (strcmp(tail,'L'))
        u1 = 1 - (tiedrank(data(:,1)) ./ t1);
        u2 = 1 - (tiedrank(data(:,2)) ./ t1);
    else
        u1 = tiedrank(data(:,1)) ./ t1;
        u2 = tiedrank(data(:,2)) ./ t1;
    end

    zs = -1 ./ log(u1);
    zt = -1 ./ log(u2);
    z =  sort(min(zs,zt),'descend');

    if (nu == 1)
        eta = 0;
    else
        eta = sum(log(z(1:nu) ./ z(nu1)));
    end

    chi_bar = ((2 / nu1) * eta) - 1;
    sigma = (chi_bar + 1)^2 / nu1;
    ci = chi_bar + (norminv(0.975) * sigma^0.5);

    if (ci >= 1)
        chi = z(nu1) * (nu1 / t);
    else
       chi = 0;
    end

end

function [data,bw] = validate_input(data,bw)

    [t,n] = size(data);

    if (n < 2)
        error('The value of ''data'' is invalid. Expected input to be a matrix with at least 2 columns.');
    end

    nan_counts = sum(isnan(data),1);
    nan_threshold = round(t * 0.70,0);

    if (any(nan_counts > nan_threshold))
        error(['The value of ''data'' is invalid. Expected input to contain no more than 70% of NaN values (' num2str(nan_threshold) ') for each time series.']);
    end

    for i = 2:ceil(t / bw)
        bw_i = bw * i;

        if ((bw_i / t) >= 0.3)
            bw = bw_i;
            break;
        end
    end

end


function [C, Q] = procCosp(DATA, WINDOW_TYPE, WINDOW_SIZE, OVERLAP, FREQUENCY_RANGE, PHASE_CORRECTION)
% [C, Q] = procCosp(DATA, WINDOW_TYPE, WINDOW_SIZE, OVERLAP, FREQUENCY_RANGE)
%
% This function computes cospectra and quadrature spectra on multivariate
% data using Welch's method. For a better estimation, each tappering window
% can be phase corrected according to its length and its position in data.
%
% Inputs:
% - DATA            --> matrix with the data (M samples by N channels matrix)
% - WINDOW_TYPE     --> (optionnal) string with the type of the window
% - WINDOW_SIZE     --> (optionnal) size of the window in number of samples
% - OVERLAP         --> (optionnal) percentage of the overlapping window (from 0 to 0.99)
% - FREQUENCY_RANGE --> (optionnal) range of interesting frequencies to keep,
%                                   format must be [sample_rate min_frec max_frec]
% - PHASE_CORRECTION--> (optionnal) correction of phase shift intrinsic to Welch's windows.
%                                   (1: correction, 0: no correction)
%
% Outputs:
% - C        --> cospectral matrix [N x N x f]
% - Q        --> quadrature matrix [N x N x f]
%
% History
% First version: Jonas Chatel-Goldman @ GIPSA-Lab, 01/12/2011

% default UI display
if(nargin < 9)  UIdisplay  = 0;  end
% default correction
if(nargin < 6)  PHASE_CORRECTION = 0; end
% default frequency range
if(nargin < 5)  FREQUENCY_RANGE = []; end
% default overlapping
if(nargin < 4)  OVERLAP = .75;  end
% default windows size
if(nargin < 3)  WINDOW_SIZE = 128;  end
% default windows type
if(nargin < 2)  WINDOW_TYPE = 'hanning';  end

% Adjust the window to the next pow of 2 (for the FFT)
WINDOW_SIZE = 2 ^ nextpow2(WINDOW_SIZE);
% Calculate the number of frequencies
number_freqs = (WINDOW_SIZE / 2); % +1;

s_data = size(DATA);

% UI DISPLAY
if(UIdisplay)  h= waitbar(0,'Processing cospectrum...');  end

%% Create the window from the inputs and preallocates memory
switch lower(WINDOW_TYPE)
    case 'hamming'
        win = hamming(WINDOW_SIZE);
    case 'hann'
        win = hann(WINDOW_SIZE);
    case 'hanning'
        win = hanning(WINDOW_SIZE);
    case 'blackman'
        win = blackman(WINDOW_SIZE);
    case 'barthannwin'
        win = barthannwin(WINDOW_SIZE);
    case 'blackmanharris'
        win = blackmanharris(WINDOW_SIZE);
    case 'bohmanwin'
        win = bohmanwin(WINDOW_SIZE);
    case 'chebwin'
        win = chebwin(WINDOW_SIZE);
    case 'gausswin'
        win = gausswin(WINDOW_SIZE);
    case 'kaiser'
        win = kaiser(WINDOW_SIZE);
    case 'nuttallwin'
        win = nuttallwin(WINDOW_SIZE);
    case 'parzenwin'
        win = parzenwin(WINDOW_SIZE);
    case 'tukeywin'
        win = tukeywin(WINDOW_SIZE);
    case 'rectangular'
        win = ones(WINDOW_SIZE,1);
    case 'flattopwin'
        win = flattopwin(WINDOW_SIZE);
    case 'welch'
         %win = welchwin(WINDOW_SIZE, 0);
        Nd2=(WINDOW_SIZE-1)/2;
        for i=1 : WINDOW_SIZE
            win(i)=1-((i-Nd2)/Nd2)^2;
        end
        win = win';
    otherwise
        disp('WARNING - Unknown window type!');
        disp('Switching to default window type : Hamming Window');
        win = hamming(WINDOW_SIZE);
end

if s_data(1) < WINDOW_SIZE
    error('Cospectra computation: data segment too short for this window length, consider changing frequency resolution');
end

% Calculate the number of windows because of the overlapping
if(OVERLAP == 0)
    number_windows = floor(s_data(1) / WINDOW_SIZE);
else
    nbFullWin = floor(s_data(1)/WINDOW_SIZE);
    number_windows = 1 + (nbFullWin-1)/(1-OVERLAP) + floor((s_data(1)-((nbFullWin)*WINDOW_SIZE))/((1-OVERLAP)*WINDOW_SIZE));
end

% pre-allocation of memory
S = zeros(s_data(2), s_data(2), number_freqs);

%% Loop on all frequencies
for window_ix = 1 : number_windows

    % UI display
    if(UIdisplay)  waitbar(window_ix/number_windows,h); end

    % time markers to select the data
    t1 = floor((window_ix-1) * (1-OVERLAP) * WINDOW_SIZE) +1;   % marker of the beginning of the time window
    t2 = t1 + WINDOW_SIZE -1;                           % marker of the end of the time window

    % select current window and apodize it
    cdata = DATA(t1:t2, :) .* (win*ones(1,s_data(2)));

    % FFT calculation
    fdata = fft(cdata,WINDOW_SIZE) ./ number_windows; % complex data
    if(PHASE_CORRECTION == 1)
        fdata = fdata.*(exp(-sqrt(-1)*t1*( 0:(WINDOW_SIZE-1) )'/WINDOW_SIZE*2*pi)*ones(1,s_data(2)));
    end

    % Complexe cospectrum averaging over windows
    for f = 1 : number_freqs
        S(:,:,f) = S(:,:,f) + (fdata(f,:)' * fdata(f,:));
    end
end

C = real(S);
Q = imag(S);

% Adjust Frequency range to specified range (in case it is a parameter)
if ~isempty(FREQUENCY_RANGE)
    if  FREQUENCY_RANGE(3) <= (FREQUENCY_RANGE(1) / 2)
        Faxis = [0:(1/number_freqs):1-(1/number_freqs)];
        FindexMin = find(Faxis >= FREQUENCY_RANGE(2)/(FREQUENCY_RANGE(1)/2), 1);
        FindexMax = find(Faxis >= FREQUENCY_RANGE(3)/(FREQUENCY_RANGE(1)/2), 1);
        C = C(:, :, FindexMin:FindexMax);
        Q = Q(:, :, FindexMin:FindexMax);

    else
        % Assertion on frequency, to comply with Nyquist Theorem
        error('Frequency range exceeds data sampling rate in consideration of Shannon''s limitation.')
    end
end

% UI display
if(UIdisplay) close(h); end


function ll = composite_likelihood(S,data,indices)
% Computes the negative of the composite normal loglikelihood (bivariate) for a K-dimensional array
%
% USAGE:
%   [LL] = composite_likelihood(S,DATA,INDICES)
%
% INPUTS:
%   S       - K by K covariance matrix
%   DATA    - Either a K by K matrix (e.g. outer-produces) or a 1 by K vector (e.g. returns)
%   INDICES - Q by 2 array of indices to use when computing the composite likleihood
%
% OUTPUTS:
%   LL      - Composite likelihood
%
% COMMENTS:
%  This is a helper function for various multivariate GARCH models. A MEX file version of this file
%  is available which provides a large speed-up.
%
%  See also DCC, SCALAR_VEC_VECH, BEKK, RARCH

q = size(indices,1);
[m,n] = size(data);
likConst = 3.67575413281869;
ll = 0;
if m==n
    for k=1:q
        i = indices(k,1);
        j = indices(k,2);
        s11 = S(i,i);
        s12 = S(i,j);
        s22 = S(j,j);
        det = s11*s22-s12*s12;
        x11 = data(i,i);
        x12 = data(i,j);
        x22 = data(j,j);
        ll = ll + 0.5*(likConst + log(det) + (s22*x11 - 2*s12*x12 + s11*x22)/det)/q;
    end
else
    for k=1:q
        i = indices(k,1);
        j = indices(k,2);
        s11 = S(i,i);
        s12 = S(i,j);
        s22 = S(j,j);
        det = s11*s22-s12*s12;
        x11 = data(i)*data(i);
        x12 = data(i)*data(j);
        x22 = data(j)*data(j);
        ll = ll + 0.5*(likConst + log(det) + (s22*x11 - 2*s12*x12 + s11*x22)/det)/q;
    end
end


function [fx,dfdx,dfdp] = f_gen(Xt,Theta,ut,inF)

% Generic evolution function (up to quadratic terms)

% [fx,dfdx,dfdp] = f_gen(Xt,Theta,ut,inF)

deltat = inF.deltat;
n = size(Xt,1);
nc = factorial(n)./(factorial(2)*factorial(n-2));
A = reshape(Theta(1:n^2),n,n);
B = reshape(Theta(n^2+1:n*(2*n+nc)),n,n+nc);

xij = zeros(n+nc,1);
ind = cell(n,1);
ind2 = zeros(n,1);
k = 0;
for i=1:n
    for j=1:n
        if j >= i
            k = k+1;
            xij(k) = Xt(i).*Xt(j);
            if i == j
                ind2(i) = k;
            else
                ind{i} = [ind{i},k];
                ind{j} = [ind{j},k];
            end
        end
    end
end
dbxdx = zeros(n,n);
for i=1:n
    for j=1:n
        dbxdx(i,j) = 2*B(i,ind2(j)).*Xt(j) ...
            + B(i,ind{j})*Xt(setdiff(1:n,j));
    end
end

f = A*Xt + B*xij;
fx = Xt + deltat.*f;
dfdx = eye(n) + deltat*(A + dbxdx)';

dfdp = zeros(n,n*(2*n+nc));
dfdp(:,1:n^2) = kron(Xt',eye(n));
dfdp(:,n^2+1:n*(2*n+nc)) = kron(xij',eye(n));
dfdp = deltat*dfdp';


% Two-input NAND gate sizing (GP)
% Boyd, Kim, Patil, and Horowitz, "Digital circuit optimization
% via geometric programming"
% Written for CVX by Almir Mutapcic 02/08/06
% (a figure is generated)
%
% This is an example taken directly from the paper:
%
%   Digital circuit optimization via geometrical programming
%   by Boyd, Kim, Patil, and Horowitz
%   Operations Research 53(6): 899-932, 2005.
%
% Solves the problem of choosing device widths w_i for the given
% NAND2 gate in order to achive minimum Elmore delay for different
% gate transitions, subject to limits on the device widths,
% gate area, power, and so on. The problem is a GP:
%
%   minimize   D = max( D_1, ..., D_k )  for k transitions
%       s.t.   w_min <= w <= w_max
%              A <= Amax, etc.
%
% where variables are widths w.
%
% This code is specific to the NAND2 gate shown in figure 19
% (page 926) of the paper. All the constraints and the objective
% are hard-coded for this particular circuit.

%********************************************************************
% problem data and hard-coded GP specs (evaluate all transitions)
%********************************************************************
N = 4;       % number of devices
Cload = 12;  % load capacitance
Vdd = 1.5;   % voltage

% device specs
NMOS = struct('R',0.4831, 'Cdb',0.6, 'Csb',0.6, 'Cgb',1, 'Cgs',1);
PMOS = struct('R',2*0.4831, 'Cdb',0.6, 'Csb',0.6, 'Cgb',1, 'Cgs',1);

% maximum area and power specification
wmin = 1;

% varying parameters for the tradeoff curve
Npoints = 25;
Amax = linspace(5,45,Npoints);
Dopt = [];

disp('Generating the optimal tradeoff curve...')
for k = 1:Npoints
    fprintf(1,'  Amax = %5.2f:', Amax(k));
    cvx_begin gp quiet
        % device width variables
        variable w(N)

        % device specs
        device(1:2) = PMOS; device(3:4) = NMOS;

        for num = 1:N
            device(num).R   = device(num).R/w(num); %#ok
            device(num).Cdb = device(num).Cdb*w(num); %#ok
            device(num).Csb = device(num).Csb*w(num); %#ok
            device(num).Cgb = device(num).Cgb*w(num); %#ok
            device(num).Cgs = device(num).Cgs*w(num); %#ok
        end

        % capacitances
        C1 = sum([device(1:3).Cdb]) + Cload;
        C2 = device(3).Csb + device(4).Cdb;

        % input capacitances
        Cin_A = sum([ device([2 3]).Cgb ]) + sum([ device([2 3]).Cgs ]);
        Cin_B = sum([ device([1 4]).Cgb ]) + sum([ device([1 4]).Cgs ]);

        % resistances
        R = [device.R]';

        % area definition
        area = sum(w);

        % delays and dissipated energies for all six possible transitions
        % transition 1 is A: 1->1, B: 1->0, Z: 0->1
        D1 = R(1)*(C1 + C2);
        E1 = (C1 + C2)*Vdd^2/2;
        % transition 2 is A: 1->0, B: 1->1, Z: 0->1
        D2 = R(2)*C1;
        E2 = C1*Vdd^2/2;
        % transition 3 is A: 1->0, B: 1->0, Z: 0->1
        % D3 = C1*R(1)*R(2)/(R(1) + R(2)); % not a posynomial
        E3 = C1*Vdd^2/2;
        % transition 4 is A: 1->1, B: 0->1, Z: 1->0
        D4 = C1*R(3) + R(4)*(C1 + C2);
        E4 = (C1 + C2)*Vdd^2/2;
        % transition 5 is A: 0->1, B: 1->1, Z: 1->0
        D5 = C1*(R(3) + R(4));
        E5 = (C1 + C2)*Vdd^2/2;
        % transition 6 is A: 0->1, B: 0->1, Z: 1->0
        D6 = C1*R(3) + R(4)*(C1 + C2);
        E6 = (C1 + C2)*Vdd^2/2;

        % objective is the worst-case delay
        minimize( max( [D1 D2 D4] ) )
        subject to
            area <= Amax(k); %#ok
            w >= wmin; %#ok
    cvx_end
    % display and store computed values
    fprintf(1,' delay = %3.2f\n',cvx_optval);
    Dopt = [Dopt cvx_optval]; %#ok
end

% plot the tradeoff curve
plot(Dopt,Amax);
xlabel('Dmin'); ylabel('Amax');
disp('Optimal tradeoff curve plotted.')


%% Analyzing Neural Time Series Data
% Matlab code for Chapter 2
% Mike X Cohen
%
% This code accompanies the book, titled "Analyzing Neural Time Series Data"
% (MIT Press). Using the code without following the book may lead to confusion,
% incorrect data analyses, and misinterpretations of results.
% Mike X Cohen assumes no responsibility for inappropriate or incorrect use of this code.

%% Figure 2.1

load sampleEEGdata.mat

nTrials = 6; % modifiable

figure
data = zeros(nTrials,EEG.pnts);

% wavelet... more on this in Chapters 13 and 14
wavetime   = -1:1/EEG.srate:1;
n_conv     = length(wavetime)+EEG.pnts-1;
waveletfft = fft(exp(2*1i*pi*10.*wavetime) .* exp(-wavetime.^2./(2*(5/(2*pi*10))^2))/10,n_conv);
data10hz   = zeros(nTrials,EEG.pnts);

for triali=1:nTrials

    % create single trial "ERP"
    data(triali,:) = .5*sin(2*pi*6.*EEG.times/1000 + 2*pi*triali/nTrials-pi) + randn(1,EEG.pnts)/6;
    % add non-phase-locked stimulus potential (note distributed phases in sine wave)
    data(triali,260:360) = data(triali,260:360) + sin(2*pi*10.*EEG.times(260:360)/1000 + 2*pi*triali/nTrials-pi) + randn(1,101)/5;

    % plot data from this trial
    subplot(nTrials,3,(triali-1)*3+1)
    plot(EEG.times,data(triali,:))
    set(gca,'xlim',[-250 850],'ylim',[-2.2 2.2])

    % plot ERP from trial 1 to current
    subplot(nTrials,3,(triali-1)*3+2)
    plot(EEG.times,mean(data(1:triali,:),1))
    set(gca,'xlim',[-250 850],'ylim',[-2.2 2.2])

    % convolve with 10 Hz wavelet (more on convolution in a few chapters...)
    convolution_result_fft = ifft(waveletfft.*fft(data(triali,:),n_conv)) * sqrt(5/(2*pi*10));
    convolution_result_fft = convolution_result_fft(floor(length(wavetime)/2)+1:end-floor(length(wavetime)/2));
    data10hz(triali,:) = abs(convolution_result_fft).^2;

    % plot 10 Hz power
    subplot(nTrials,3,(triali-1)*3+3)
    plot(EEG.times,mean(data10hz(1:triali,:),1))
    set(gca,'xlim',[-250 850],'ylim',[-.1 .8])
end

%% Figure 2.2
% (This code involves performing convolution with a complex Morlet wavelet,
% which you will learn about in Chapters 10-13.)

srate=1000;

time=(0:1/srate:10);

DCoffset=-.5;

% create multi-frequency signal
a = sin(2*pi*10.*time);             % part 1 of signal (high frequency)
b = .1*sin(2*pi*.3*time)+DCoffset;  % part 2 of signal (low frequency)

data = a.*b; % combined signal
data = data + (2*sin(2*pi*3*time) .* sin(2*pi*.07*time)*.1+DCoffset);

% morlet wavelet convolution (more on this in later chapters)
num_frex = 40;
min_freq =  2;
max_freq = 20;

Ldata  = length(data);
Ltapr  = length(data);
Lconv1 = Ldata+Ltapr-1;
Lconv  = pow2(nextpow2(Lconv1));

frex=logspace(log10(min_freq),log10(max_freq),num_frex);

% initialize
tf=zeros(num_frex,length(data));
datspctra = fft(data,Lconv);

s=4./(2*pi.*frex);
t=-((length(data)-1)/2)/srate:1/srate:((length(data)-2)/2)/srate+1/srate;

for fi=1:length(frex)

    wavelet=exp(2*1i*pi*frex(fi).*t).*exp(-t.^2./(2*s(fi)^2));

    m = ifft(datspctra.*fft(wavelet,Lconv),Lconv);
    m = m(1:Lconv1);
    m = m(floor((Ltapr-1)/2):end-1-ceil((Ltapr-1)/2));

    tf(fi,:) = abs(m).^2;
end

figure

subplot(221)
plot(a)
set(gca,'xlim',[1 8]*1000,'ylim',[-1 1],'xtick',0:1000:10000,'xticklabel',0:10);
title('10 Hz signal, DC=0')

subplot(222)
plot(b)
set(gca,'xlim',[1 8]*1000,'ylim',[-1 1],'xtick',0:1000:10000,'xticklabel',0:10);
title([ '.3 Hz signal, DC=' num2str(DCoffset) ])

subplot(223)
plot(data)
set(gca,'xlim',[1 8]*1000,'ylim',[-1 1],'xtick',0:1000:10000,'xticklabel',0:10);
title('Time-domain signal')

subplot(224)
imagesc(1:length(data),[],tf);
set(gca,'xlim',[1 8]*1000,'ydir','normal','ytick',1:8:num_frex,'yticklabel',round(frex(1:8:end)),'xtick',0:1000:10000,'xticklabel',0:10)
title('Time-frequency representation')

%% Figure 2.3

chan2plot = 'pz'; % you can pick any electrode (type {EEG.chanlocs.labels} for all electrodes)

% compute ERP (time-domain trial average from selected electrode)
erp = squeeze(mean(EEG.data(strcmpi(chan2plot,{EEG.chanlocs.labels}),:,:),3));

% low-pass filter data (uses signal processing toolbox; you'll learn about
% how filtering works in chapter 14. If you don't have the signal processing
% toolbox, just comment out the next eight lines; they are not necessary.)
nyquist       = EEG.srate/2;
filter_cutoff = 40;  % Hz
trans_width   = 0.1; % transition width, in fraction of 1

ffrequencies  = [ 0 filter_cutoff filter_cutoff*(1+trans_width) nyquist ]/nyquist;
idealresponse = [ 1 1 0 0 ];
filterweights = firls(100,ffrequencies,idealresponse);
filtered_erp  = filtfilt(filterweights,1,double(erp));

figure
% plot ERP
plot(EEG.times,filtered_erp,'k.-')

% now down-sample and plot
times2plot = dsearchn(EEG.times',(-200:40:1000)');
hold on
plot(EEG.times(1:5:end),filtered_erp(1:5:end),'mo-')

set(gca,'xlim',[-200 1000],'ydir','r')
xlabel('Time (ms)'), ylabel('Voltage (\muV)')
title([ 'ERP from electrode ' chan2plot ])
legend({'256 Hz';'50 Hz'})

%%


function [pnt,jac] = nrbdeval(nurbs, dnurbs, tt)
% Evaluation of the derivative NURBS curve or surface.
%
%     [pnt, jac] = nrbdeval(crv, dcrv, tt)
%     [pnt, jac] = nrbdeval(srf, dsrf, {tu tv})
%
% INPUTS:
%
%   crv    - original NURBS curve.
%
%   srf    - original NUBRS surface
%
%   dcrv   - NURBS derivative represention of crv
%
%   dsrf   - NURBS derivative represention of surface
%
%   tt     - parametric evaluation points
%            If the nurbs is a surface then tt is a cell
%            {tu, tv} are the parametric coordinates
%
%   pnt  - evaluated points.
%   jac  - evaluated first derivatives (Jacobian).
%
% Examples:
%
%   // Determine the first derivatives a NURBS curve at 9 points for 0.0 to
%   // 1.0
%   tt = linspace(0.0, 1.0, 9);
%   dcrv = nrbderiv(crv);
%   [pnts,jac] = nrbdeval(crv, dcrv, tt);

%  D.M. Spink
%  Copyright (c) 2000.

if ~isstruct(nurbs)
  error('NURBS representation is not structure!');
end

if ~strcmp(nurbs.form,'B-NURBS')
  error('Not a recognised NURBS representation');
end

[cp,cw] = nrbeval(nurbs, tt);

if iscell(nurbs.knots)

  % NURBS structure represents a surface
  temp = cw(ones(3,1),:,:);
  pnt = cp./temp;

  [cup,cuw] = nrbeval(dnurbs{1}, tt);
  tempu = cuw(ones(3,1),:,:);
  jac{1} = (cup-tempu.*pnt)./temp;

  [cvp,cvw] = nrbeval(dnurbs{2}, tt);
  tempv = cvw(ones(3,1),:,:);
  jac{2} = (cvp-tempv.*pnt)./temp;

else

  % NURBS is a curve
  temp = cw(ones(3,1),:);
  pnt = cp./temp;

  % first derivative
  [cup,cuw] = nrbeval(dnurbs,tt);
  temp1 = cuw(ones(3,1),:);
  jac = (cup-temp1.*pnt)./temp;

end


function [jj,tx,j,a,v,p,tt]=profile3(t,j,acc,plt)

% function [jj,tx,j,a,v,p,tt]=profile3(t,j,acc)
%
% Calculate symmetrical third order profiles from times:
%
%  Inputs:
%
%      t(1) = constant jerk phase duration
%      t(2) = constant acceleration phase duration (default 0)
%      t(3) = constant velocity phase duration (default 0)
%
%      j    = bound on jerk
%      acc  = continuous time: accuracy for profiles: t(1)*acc = minimal timestep
%             discrete time:   sample time
%
%  Outputs:
%
%      jj  = derivative of jerk profile suitable for simulink
%
%      tx  = time sequence for plotting profiles
%      j   = jerk profile
%      a   = acceleration profile
%      v   = velocity profile
%      p   = position profile
%
%      tt  = 8 switching times for profile:
%
%       0 1              6 7
%       .-.              .-.
%       | |              | |
%       | |  2 3    4 5  | |
%       '-'--.-.----.-.--' '--
%            | |    | |
%            | |    | |
%            '-'    '-'
%
%  Note: coinciding switching times are not removed

%
% Copyright 2004, Paul Lambrechts, The MathWorks, Inc.
%

if nargin < 3 || nargin > 4
    help profile3
    return
end
if nargin==3
    plt=1;
end

if length(t)==1  % min distance with max jerk
    tt=   [0 1 1 2 2 3 3 4 ]*t;

elseif length(t)==2 % constant acceleration phase
    tt=   [0 1 1 2 2 3 3 4 ]*t(1) ...
        + [0 0 1 1 1 1 2 2 ]*t(2);

elseif length(t)==3 % constant velocity phase
    tt=   [0 1 1 2 2 3 3 4 ]*t(1) ...
        + [0 0 1 1 1 1 2 2 ]*t(2) ...
        + [0 0 0 0 1 1 1 1 ]*t(3) ;
else
    return
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Generate Simulink look-up table
jt=[];
for i=1:8
    jt =  [jt   [1 1] * tt(i) ]  ;
end
jt  = [jt 1.5*tt(8)];

jj  = [jt ; [ 0 j j 0 0 -j -j 0 0 -j -j 0 0 j j 0 0 ] ];

if plt==0  % no plot required
    tx=[];j=[];a=[];v=[];p=[];    % dummy outputs
    return
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Generate profiles for plotting

% Determine continuous or discrete
if max(abs( round(t/acc)-t/acc )) > 1e-12 % continuous

   disp('Calculating continuous time profiles')
   step = t(1)*acc;
   tx=0:step:1.2*tt(8);
   x=[];
   for i=0:step:1.2*tt(8)
       j=find(i<=jj(1,:));
       x=[x ; jj(2,j(1))];
   end
   j=x;
   a=cumsum(j)*step;
   v=cumsum(a)*step;
   p=cumsum(v)*step;

else % discrete

   disp('Calculating discrete time profiles')
   Ts=acc;
   ttest=[tt 1.5*tt(8)];
   len = round(1.2*tt(8)/Ts + 1); % length of profiles
   xj = zeros(len,1);
   xa = xj;
   xv = xj;
   xp = xj;
   xj(1) = j;
   tx=0:Ts:1.2*tt(8)+Ts/2;
   for time=Ts:Ts:(1.2*tt(8)+Ts/2)
      i = find( (time + Ts/2) <= ttest ); i = i(1)-1;
      k = round(time/Ts);
      if i==1 || i==7
          xj(k+1) =  j;
      elseif i==3 || i==5
          xj(k+1) = -j;
      else
          xj(k+1) =  0;
      end
      xa(k+1) = xa(k) + xj(k)*Ts;
      xv(k+1) = xv(k) + xa(k)*Ts;
      xp(k+1) = xp(k) + xv(k)*Ts;
   end
   j=xj;a=xa;v=xv;p=xp;

end

%close all
%figure
subplot(411);plot(tx,j,'k','LineWidth',1.5);hold on;plot([0 0],[-1 1]*max(j),'k--',[1 1]*max(tt),[-1 1]*max(j),'k--','LineWidth',1.5);grid on; axis([ [-0.01 1]*max(tx) [-1.1 1.1]*max(j)]);
title('Third order trajectory profiles');ylabel('j [m/s3]');
subplot(412);plot(tx,a,'k','LineWidth',1.5);hold on;plot([0 0],[-1 1]*max(a),'k--',[1 1]*max(tt),[-1 1]*max(a),'k--','LineWidth',1.5);grid on; axis([ [-0.01 1]*max(tx) [-1.1 1.1]*max(a)]);
ylabel('a [m/s2]');
subplot(413);plot(tx,v,'k','LineWidth',1.5);hold on;plot([0 0],[0 1]*max(v),'k--',[1 1]*max(tt),[0 1]*max(v),'k--','LineWidth',1.5);grid on; axis([ [-0.01 1]*max(tx) [-0.1 1.1]*max(v)]);
ylabel('v [m/s]');
subplot(414);plot(tx,p,'k','LineWidth',1.5);hold on;plot([0 0],[0 1]*max(p),'k--',[1 1]*max(tt),[0 1]*max(p),'k--','LineWidth',1.5);grid on; axis([ [-0.01 1]*max(tx) [-0.1 1.1]*max(p)]);
xlabel('time [s]');ylabel('x [m]');
set(1,'position',[700 200 500 680])
set(1,'paperposition',[0 0 5 6.8])

subplot(411);
text(tt(1)+tt(8)/200,max(j)/5,'t_0');
text(tt(2)+tt(8)/200,max(j)/5,'t_1');
text(tt(3)          ,max(j)/5,'t_2');
text(tt(4)          ,max(j)/5,'t_3');
text(tt(5)          ,max(j)/5,'t_4');
text(tt(6)          ,max(j)/5,'t_5');
text(tt(7)+tt(8)/200,max(j)/5,'t_6');
text(tt(8)+tt(8)/200,max(j)/5,'t_7');


function markedElem = mark(elem,eta,theta,method)
% MARK mark element.
%
% markedElem = mark(elem,eta,theta) mark a subset of elements by Dorfler
% marking strategy. It returns an array of indices of marked elements
% markedElem such that sum(eta(markedElem)^2) > theta*sum(eta^2).
%
% markedElem = mark(elem,eta,theta,'max') choose markedElem such that
% eta(markedElem) > theta*max(eta).
%
% markedElem = mark(elem,eta,theta,'COARSEN') choose markedElem such that
% eta(markedElem) < theta*max(eta).
%
% Copyright (C) 2008 Long Chen. See COPYRIGHT.txt for details.

NT = size(elem,1); isMark = false(NT,1);
if ~exist('method','var'), method = 'L2'; end  % default marking is L2 based
switch upper(method)
    case 'MAX'
        isMark(eta>theta*max(eta))=1;
    case 'COARSEN'
        isMark(eta<theta*max(eta))=1;
    case 'L2'
        [sortedEta,idx] = sort(eta.^2,'descend');
        x = cumsum(sortedEta);
        isMark(idx(x < theta* x(NT))) = 1;
        isMark(idx(1)) = 1;
end
markedElem = uint32(find(isMark==true));


% Data File EKIN1
% Oscillations of
% a mathematical pendulum
  Ek   = '1/2*m*qt^2'; % Kinetic energy
  N    = '-(k*qt + 9.81*sin(q))*qt'; % power
  q0   = '0.1';  % initial coordinate
  qt0  = '5';    % initial velocity
  Tend = 20;     % upper bound of integration
  eps  = 1e-10;  % desirable accuracy
  np   = 2;      % number of parameters
  P{1} = 'm';    % mass of the pendulum
  P{2} = 'k';    % coefficient of resistance


function [hy,model,Sigma] = ml_gpr(X,y,model,epsilon,rbf_var,method)
%ML_GP Gaussian Process Regression
%
%   Desired structure for ml_kcv ------------------------------------------
%
%  [hy,model] = f(X_train,labels_train,model) : used to train
%
%  hy         = f(X_test,[],model) : used to predict
%
%   input -----------------------------------------------------------------
%
%       o X         : (N x D), N input samples of dimension D.
%
%       o y         : (N x 1), N output predictions of dimension 1.
%
%       o model     : struct
%
%       o epsilon   : measurement noise
%
%       o rbf_var   : kernel width
%
%   output ----------------------------------------------------------------
%
%
%

Sigma = [];

if ~exist('method','var'), method='gpml'; end

if ~isempty(y)
% Train the model
    model.X_train = X;
    model.y_train = y;

    if strcmp(method,'gdc')

        [hy,Sigma] = gaussian_process(X,y,X,epsilon,rbf_var);

    elseif strcmp(method,'gpml')

        meanfunc     = {@meanZero};
        covfunc      = {@covSEiso};
        ell          = rbf_var;     % kernel width of RBF covariance function.
        sf           = 1;           % signal variance (not measurement noise)
        sn           = epsilon;      % measurement noise
        hyp          = [];
        hyp.cov      = log([ell; sf]);
        hyp.lik      = log(sn);
        [hy,Sigma]   = gp(hyp, @infExact, meanfunc, covfunc, @likGauss, X, y, X);

    else

        error(['No such method defined: ' method]);

    end

else
% Test the model

    if strcmp(method,'gdc')

        [hy,Sigma]    = gaussian_process(model.X_train,model.y_train,X,epsilon,rbf_var);

    elseif strcmp(method,'gpml')

        meanfunc     = {@meanZero};
        covfunc      = {@covSEiso};
        ell          = rbf_var;     % kernel width of RBF covariance function.
        sf           = 1;           % signal variance (not measurement noise)
        sn           = epsilon;      % measurement noise
        hyp          = [];
        hyp.cov      = log([ell; sf]);
        hyp.lik      = log(sn);

        [hy,Sigma]   = gp(hyp, @infExact, meanfunc, covfunc, @likGauss, model.X_train,model.y_train, X);

    else

        error(['No such method defined: ' method]);

    end

end

end


%SF_TRI_P5 Fifth order Lagrange shape functions for triangles (P5).
%
%   [ VBASE, NLDOF, XLDOF, SFUN ] = SF_TRI_P5( I_EVAL, N_SDIM, N_VERT, I_DOF, XI, AINVJAC, VBASE )
%   Evaluates conforming fifth order P5 Lagrange shape functions on 2D triangular elements
%   with values defined in the nodes, edges, and center. XI are Barycentric coordinates.
%
%       Input       Value/[Size]           Description
%       -----------------------------------------------------------------------------------
%       i_eval      scalar:  1             Evaluate function values
%                           >1             Evaluate values of derivatives
%       n_sdim      scalar: 2              Number of space dimensions
%       n_vert      scalar: 3              Number of vertices per cell
%       i_dof       scalar: 1-21           Local basis function to evaluate
%       xi          array [3,1]            Local coordinates of evaluation point
%       aInvJac     [n,6]                  Inverse of transformation Jacobian
%       vBase       [n]                    Preallocated output vector
%                                                                                .
%       Output      Value/[Size]           Description
%       -----------------------------------------------------------------------------------
%       vBase       [n]                    Evaluated function values
%       nLDof       [4]                    Number of local degrees of freedom on
%                                          vertices, edges, faces, and cell interiors
%       xLDof       [3,n_ldof]             Local coordinates of local dofs
%       sfun        string                 Function name of called shape function
%
%   See also SF_TRI_P1

% Copyright 2013-2022 Precise Simulation, Ltd.


function [out] = evap_23(p1,p2,S,Smax,Ep,dt)
% evap_23 combines evap_5 (evaporation) and evap_6 (transpiration)

% Copyright (C) 2021 Clara Brandes, 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:  Transpiration from vegetation at the potential rate if
%               storage is above field capacity and scaled by relative
%               storage if not (similar to evap_6), addition of
%               Evaporation from bare soil scaled by relative storage
%               (similar to evap_5)
% Constraints:  Ea <= Ep
%               Ea <= S/dt
% @(Inputs):    p1   - fraction vegetated area [-] (0...1)
%               p2   - field capacity coefficient[-]
%               S    - current storage [mm]
%               Smax - maximum storage [mm]
%               Ep   - potential evapotranspiration rate [mm/d]
%               dt   - time step size [d]

out = min([p1.*Ep+(1-p1).*S./Smax.*Ep, p1*Ep*S./(p2*Smax)+(1-p1).*S./Smax.*Ep,S/dt]);

end


function cc_levels_minmax_animate ( )

%*****************************************************************************80
%
%% CC_LEVELS_MINMAX_ANIMATE displays the sequence of grids generated by CC_LEVELS_MINMAX.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 November 2006
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  timestamp ( );

  fprintf ( 1, '\n' );
  fprintf ( 1, 'CC_LEVELS_MINMAX_ANIMATE:\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '  Display the sequence of nested 2D Clenshaw-Curtis grids\n' );
  fprintf ( 1, '  generated by CC_LEVELS_MINMAX.\n' );

  dim_num = 2;

  while ( 1 )
%
%  Get user input.
%
    fprintf ( 1, '\n' );
    level_max = input ( 'Enter LEVEL_MAX or RETURN to exit;' );

    if ( isempty ( level_max ) )
      break
    end

    grid_points_old = [];
    grid_points_old_num = 0;

    grid_points = [];
    grid_points_num = 0;

    for level = 0 : level_max

      if ( 0 < grid_points_num )

        grid_points_old(1:2,grid_points_old_num+1:grid_points_old_num+grid_points_num) = ...
          grid_points(1:2,1:grid_points_num);

        grid_points_old_num = grid_points_old_num + grid_points_num;

      end
%
%  Compute data.
%
      [ grid_num, point_num ] = cc_levels_minmax_size ( dim_num, ...
        level, level );

      [ grid_level, grid_order, grid_points ] = cc_levels_minmax ( dim_num, ...
        level, level,  grid_num, point_num );

      [ dim_num, grid_points_num ] = size ( grid_points );

      clf
%
%  We have to name the axes in order to control the grid.
%
      axes_handle = axes;
%
%  Plot the points.
%
      handle_new = scatter ( grid_points(1,:), grid_points(2,:), 'r', 'filled' );

      hold on

      if ( 0 < grid_points_old_num )
        handle_old = scatter ( grid_points_old(1,:), grid_points_old(2,:), 'b', 'filled' );
      end
%
%  Force the plotting region to be square, not rectangular.
%
      axis square
%
%  Request grid lines.
%
      grid on
%
%  Specify the location of the grid lines, and suppress labeling.
%
      set ( axes_handle, 'xtick', [ -1, -.75, -.5, -.25, 0, .25, .50, .75, 1] );
      set ( axes_handle, 'xticklabel', [] );
      set ( axes_handle, 'ytick', [ -1, -.75, -.5, -.25, 0, .25, .50, .75, 1] );
      set ( axes_handle, 'yticklabel', [] );
%
%  Make the plotting region slightly bigger than the data.
%
      axis ( [ -1.1, 1.1, -1.1, 1.1 ] )
%
%  Title
%
      s = sprintf ( '+LEVEL %d', level );
      title ( s );

      fprintf ( 1, '+LEVEL %d, Press return\n', level );
      pause

      hold off

    end

    fprintf ( 1, 'Press return to CLEAR the grid!\n' );
    pause
    clf

  end

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

  fprintf ( 1, '\n' );
  timestamp ( );

  return
end


function [hrf,p] = spm_hrf(RT,P,T)
% Haemodynamic response function
% FORMAT [hrf,p] = spm_hrf(RT,p,T)
% RT   - scan repeat time
% p    - parameters of the response function (two Gamma functions)
%
%                                                           defaults
%                                                          {seconds}
%        p(1) - delay of response (relative to onset)          6
%        p(2) - delay of undershoot (relative to onset)       16
%        p(3) - dispersion of response                         1
%        p(4) - dispersion of undershoot                       1
%        p(5) - ratio of response to undershoot                6
%        p(6) - onset {seconds}                                0
%        p(7) - length of kernel {seconds}                    32
%
% T    - microtime resolution [Default: 16]
%
% hrf  - haemodynamic response function
% p    - parameters of the response function
%__________________________________________________________________________
%
% The parameters p(1:4) correspond to the shape and scale parameters of two
% probability density functions of the Gamma distribution (see spm_Gpdf.m),
% one corresponding to the main response and the other one to the
% undershoot.
% Note that the mean of the Gamma distribution is shape*scale and its mode
% is (shape-1)*scale.  This means that with the default values of the
% parameters the peak of the heamodynamic response function will be around
% 5 seconds.
%__________________________________________________________________________
% Copyright (C) 1996-2019 Wellcome Trust Centre for Neuroimaging

% Karl Friston
% $Id: spm_hrf.m 7721 2019-11-27 13:03:32Z guillaume $

%-Parameters of the response function
%--------------------------------------------------------------------------
try
    p = spm_get_defaults('stats.fmri.hrf');
catch
    p = [6 16 1 1 6 0 32];
end
if nargin > 1
    p(1:length(P)) = P;
end

%-Microtime resolution
%--------------------------------------------------------------------------
if nargin > 2
    fMRI_T = T;
else
    fMRI_T = spm_get_defaults('stats.fmri.t');
end

%-Modelled haemodynamic response function - {mixture of Gammas}
%--------------------------------------------------------------------------
dt  = RT/fMRI_T;
u   = [0:ceil(p(7)/dt)] - p(6)/dt;
hrf = spm_Gpdf(u,p(1)/p(3),dt/p(3)) - spm_Gpdf(u,p(2)/p(4),dt/p(4))/p(5);
hrf = hrf([0:floor(p(7)/RT)]*fMRI_T + 1);
hrf = hrf'/sum(hrf);


% kaiserbeta() - Estimate Kaiser window beta
%
% Usage:
%   >> beta = pop_kaiserbeta(dev);
%
% Inputs:
%   dev       - scalar maximum passband deviation/ripple
%
% Output:
%   beta      - scalar Kaiser window beta
%
% References:
%   [1] Proakis, J. G., & Manolakis, D. G. (1996). Digital Signal
%       Processing: Principles, Algorithms, and Applications (3rd ed.).
%       Englewood Cliffs, NJ: Prentice-Hall
%
% Author: Andreas Widmann, University of Leipzig, 2005

%123456789012345678901234567890123456789012345678901234567890123456789012

% Copyright (C) 2005-2014 Andreas Widmann, University of Leipzig, widmann@uni-leipzig.de
%
% 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 2 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program; if not, write to the Free Software
% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
%
% $Id$

function [ beta ] = kaiserbeta(dev)

devdb = -20 * log10(dev);

if devdb > 50
    beta = 0.1102 * (devdb - 8.7);
elseif devdb >= 21
    beta = 0.5842 * (devdb - 21)^0.4 + 0.07886 * (devdb - 21);
else
    beta = 0;
end

end


% This is material illustrating the methods from the book
% Financial Modelling  - Theory, Implementation and Practice with Matlab
% source
% Wiley Finance Series
% ISBN 978-0-470-74489-5
%
% Date: 02.05.2012
%
% Authors:  Joerg Kienitz
%           Daniel Wetterau
%
% Please send comments, suggestions, bugs, code etc. to
% kienitzwetterau_FinModelling@gmx.de
%
% (C) Joerg Kienitz, Daniel Wetterau
%
% Since this piece of code is distributed via the mathworks file-exchange
% it is covered by the BSD license
%
% This code is being provided solely for information and general
% illustrative purposes. The authors will not be responsible for the
% consequences of reliance upon using the code or for numbers produced
% from using the code.

function pathS = MC_VGCIR(S0,r,d,T,C,G,M,kappa,eta,...
    lambda,NTime,NSim,NBatches)
intNt = 20;                 % steps in between orginial grid points
allsteps = intNt * NTime;   % grid containing all necessary steps
dT = T / NTime;             % time step
daT = T/allsteps;           % time step
time = 0 : T/NTime : T;     % time for martingale correction

pathS = zeros(NSim,NTime+1,NBatches);% output
lnS = ones(NSim,NTime+1);            % used for each batch
lnS(:,1) = log(S0*exp(-d*T));        % set S(0) dividend adjusted

% precompute constants
psiVG = (-1i)*C*log(G*M/(G*M+(M-G)-1));   % char exp
gamma = sqrt(kappa^2-2*lambda^2*1i*psiVG);% CIR par
denom = ( cosh(0.5*gamma*time) ...        % denom
    + kappa*sinh(0.5*gamma*time)./gamma ).^(2*kappa*eta*lambda^(-2));
% coth is inf at 0
phiCIR(time>0) = kappa^2*eta*time(time>0)*lambda^(-2) ...
         + 2*1i*psiVG./(kappa+gamma.*coth(gamma*time(time>0)/2)) ...
         - log(denom(time>0));            % char func
phiCIR(1) = log(denom(1));                % char func start
omegaT = -phiCIR;                         % martingale correction
omegaT(1) = 0;                            % maringale correction in 0

deg = 4*eta*kappa/lambda^2;
fac1 = 4*kappa*exp(-kappa*daT)/lambda^2/(1-exp(-kappa*daT));
fac2 = lambda^2*(1-exp(-kappa*daT))/4/kappa;

Y = zeros(NSim,NTime);                   % Integrated clock

for l = 1 : NBatches                     % batch loop
   % Generating time change
   yy = ones(NSim,allsteps+1);              % stochastic clock
   for n = 1 : allsteps
       Nvec = poissrnd(0.5 * fac1 * yy(:,n));  % Poissonians
       yy(:,n+1) = fac2 * chi2rnd(deg+2*Nvec); % stochastic time
   end

   for m=1:NTime
        Y(:,m+1) = Y(:,m) + daT * sum(yy(:,1+(m-1)*intNt:m*intNt),2);
   end

   Intensity = C * (Y(:,2:end)-Y(:,1:end-1));           % intensity
   DGam = gamrnd(Intensity,1/M) - gamrnd(Intensity,1/G);% diff gamma proc
   diffomegaT = omegaT(2:end) - omegaT(1:end-1);        % Martingale correction

   for m=2:NTime+1                      % time loop
       lnS(:,m) = lnS(:,m-1) + (r-d)*dT + diffomegaT(m-1) + DGam(:,m-1);
   end
   pathS(:,:,1) = exp(lnS);
end


 function xs = l1_tv_restore1_fun(yi, A, varargin)
%function xs = l1_tv_restore1_fun(yi, A, varargin)
%|
%| Robust image restoration using a l1 data fit term and a TV-like regularizer.
%|
%| see l1_tv_restore1.m
%| min_x |yi - A(ti) * x|_1 + beta (|Cx x|_1 + |Cy x|_1)
%| where |.|_1 is approximated by a hyperbola
%|
%|
%| in
%|	yi	data
%|	A	system matrix
%|
%| option
%|	several - see code ...
%|
%| out
%|	xs	estimate(s)
%|
%| Copyright 2010-05-24, Jeff Fessler, University of Michigan

if nargin == 1 && streq(yi, 'test')
	l1_tv_restore1
	clear xs
return
end

if nargin < 2, help(mfilename), error(mfilename), end

arg.niter = 20;
arg.delta1 = 0.2; % round corner of |t| in data fit to approximate by hyperbola
arg.delta2 = 0.2; % round corner of |t| in penalty
arg.xinit = [];
arg.mask = [];
arg.l2b = -6;
arg.curvtype = 'oc';
arg.args = {};
arg = vararg_pair(arg, varargin);

if isempty(arg.xinit)
	arg.xinit = yi; % assume restoration
end

if isempty(arg.mask)
	arg.mask = true(size(yi));
end

% R = R_null; % null regularizer
R = Reg1(arg.mask, 'type_denom', 'matlab', ...
	'beta', 2^arg.l2b, 'pot_arg', {'hyper2', arg.delta2});

data = {yi(:), arg.delta1};
xs = pl_pcg_qs_ls(arg.xinit(:), A, data, ...
	@l1_tv_dercurv, R, 'niter', arg.niter, ...
	'curvtype', arg.curvtype, ...
	arg.args{:});

% l1_tv_dercurv()
function [deriv curv] = l1_tv_dercurv(data, yp, curvtype)
yi = data{1};
delta = data{2};
pot = potential_fun('hyper2', delta);
t = yp - yi;
switch curvtype
case 'pc'
	curv = 1;
	deriv = pot.dpot(t);
case 'oc'
	curv = pot.wpot(t);
	deriv = curv .* t;
otherwise
	fail('curvtype %s', curvtype)
end

% R_null()
function R = R_null;
R.dercurv = @R_null_dercurv;
R.C1 = 0;

% R_null_dercurv()
function [a b] = R_null_dercurv(arg1, arg2);
a = 0;
b = 0;


function [I,V,N]=integrateStochCubAdaptive(func,mu,SR,algorithm,epsVal2,NMax)
%%INTEGRATESTOCHCUBADAPTIVE Perform approximate Monte Carlo numerical
%                integration of a function times a Gaussian PDF using a
%                method that can be compared to importance sampling in that
%                random sets of approximate cubature points are generated
%                rather than more traditional Monte Carlo appraoches.
%
%INPUTS: func The handle to the function that is multiplies by a Gaussian
%             PDF before integration is performed. The function can take a
%             multidimensional input, but must produce a real univariate
%             output.
%          mu The numDimX1 mean of the Gaussian PDF.
%          SR The numDimXnumDim lower-triangular square root of the
%             covariance matrix of the Gaussian PDF.
%   algorithm An optional parameter specifying the algorithm to use.
%             Possible values are:
%             0 Use the first-order method of [1].
%             1 Use the third-order method of [1].
%             2 (The default if omitted or an empty matrix is passed) Use
%               the fifth-order method of [1].
%     epsVal2 An optional convergence bound based on the approximate
%             variance of the estimate. The default if this parameter is
%             omitted or an empty matrix is passed is 1e-2.
%        NMax The maximum number of iterations to perform. The default
%             value if this parameter is omitted or an empty matrix is
%             passed is 10e3.
%
%OUTPUTS: I The approximate scalar value of the integral.
%         V The approximate variance of the estimate.
%         N The number of iterations performed.
%
%All three algorithms arise from similar derivations in [1].
%
%EXAMPLE:
%Here, we choose a function whose true integral with a normal weighting
%function can be easily found. In this instance, we just choose a bivariate
%polynomial.
% f=@(x)(x(2)^4*(x(1)+1)^3-(x(1)+2)^2-(x(2)-4)^3);
% mu=[0;1/2];
% R=[2,-1;
%   -1, 2];
% SR=chol(R,'lower');
% algorithm=2;
% %The exact solution to the problem is known to be
% exactSol=1917/16
% [I,V,N]=integrateStochCubAdaptive(f,mu,SR,algorithm)
%One will find the result is relatively close, but not equal to the exact
%solution.
%
%REFERENCES:
%[1] A. Genz and J. Monahan, "Stochastic integration rules for infinite
%    regions," SIAM Journal on Scientific Computing, vol. 19, no. 2, pp.
%    426-439, Mar. 1998.
%
%May 2016 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

if(nargin<6||isempty(NMax))
   NMax=10e3;
end

if(nargin<5||isempty(epsVal2))
   epsVal2=1e-2;
end

if(nargin<4||isempty(algorithm))
    algorithm=2;
end

numDim=length(mu);

%Deal with the distribution not being a standard normal distribution.
f=@(x)func(SR*x+mu);

switch(algorithm)
    case 0 %Degree 1 spherical-radial integration rule
        %Step 2
        N=0;
        I=0;
        V=0;
        while(1)
           %Step 3a
           N=N+1;

           %Step3b
           x=randn(numDim,1);

           %Step 3c
           SR=(f(-x)+f(x))/2;
           D=(SR-I)/N;
           I=I+D;
           V=(N-2)*V/N+D^2;

           if(V<epsVal2||N==NMax)
               break;
           end
        end

        %V is approximate sample variance....
    case 1 %Degree 3 spherical-radial integration rule
        %Step 2
        N=0;
        I=0;
        V=0;
        F0=f(zeros(numDim,1));
        e=zeros(numDim,1);
        while(1)
            %Step 3a
            N=N+1;
            SR=0;
            %Step 3b
            Q=randOrthoMat(numDim);
            %Step 3c

            rho=ChiD.rand(1,numDim+2);

            %Step 3d
            for j=1:numDim
                e(j)=1;
                x=rho*Q*e;

                SR=SR+f(-x)+f(x);
                e(j)=0;
            end

            %Step 3e
            SR=F0*(1-numDim/rho^2)+SR/(2*rho^2);
            D=(SR-I)/N;
            I=I+D;
            V=(N-2)*V/N+D^2;

            if(V<epsVal2||N==NMax)
                break;
            end
        end
    case 2%Degree 5 spherical-radial integration rule
        m=numDim;
        %Step 2
        N=0;
        I=0;
        V=0;
        F0=f(zeros(m,1));

        v=regularNSimplexCoords(m);
        while(1)
            %Step 3a
            N=N+1;
            %Step 3b
            Q=randOrthoMat(m);
            vTilde=Q*v;
            %Step 3c
            r=ChiD.rand(1,2*m+7);
            q=BetaD.rand(1,m+2,3/2);
            rho=r*sin(asin(q)/2);
            delta=r*cos(asin(q)/2);
            Fv=0;
            Fy=0;

            %Step 3d
            for j=1:(m+1)
                x1=rho*vTilde(:,j);
                x2=delta*vTilde(:,j);

                Fv=Fv+(m+2-delta^2)*(f(-x1)+f(x1))/(rho^2*(rho^2-delta^2))...
                     +(m+2-rho^2)*(f(-x2)+f(x2))/(delta^2*(delta^2-rho^2));

                for i=1:(j-1)
                    y=(vTilde(:,j)+vTilde(:,i))/norm(vTilde(:,j)+vTilde(:,i));

                    x1=rho*y;
                    x2=delta*y;

                    Fy=Fy+(m+2-delta^2)*(f(-x1)+f(x1))/(rho^2*(rho^2-delta^2))...
                         +(m+2-rho^2)*(f(-x2)+f(x2))/(delta^2*(delta^2-rho^2));
                end
            end

            %Step 3e
            SR=F0*(1-m*(rho^2+delta^2-(m+2))/(rho^2*delta^2))+(Fv*(7-m)*m^2+4*Fy*(m-1)^2)/(2*(m+1)^2*(m+2));
            D=(SR-I)/N;
            I=I+D;
            V=(N-2)*V/N+D^2;

            if(V<epsVal2||N==NMax)
                break;
            end
        end
    otherwise
        error('Unknown algorithm specified.')
end
end

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


% DEMO_MGP ─ A practical example of the multivariate Gaussian process model
%            with different probabilistic models
%
% Description :
%
%   For many biological real-case scenarios two (or more)
%   animal populations can be strongly interwoven. The way in
%   which species dependent on each other are manifold. For instance,
%   predator-prey relationship, competition, symbiosis, etc.
%
%   It is fundamental to develop mechanistic understanding on the
%   underlying processes that governs the natural growth of the population.
%   However this goal is sometimes difficult and often the models are too
%   complex to derive from first principles. Nowadays, there are many
%   mechanistic models which are developed from first principles and that they
%   are able to describe the population dynamics in a very accurate manner
%   (system of ODEs or PDEs). Nevertheless, in many practical applications
%   it is easier to acquire data from the realization of such underlying biological
%   processes and infer their most probable form. Therefore Bayesian
%   nonparametric models become useful tools.
%
%   The example presented here uses a classical data-set from two animal
%   populations in Canada. The Lynx (Lynx canadensis) and the snowshoe hare
%   (Lepus americanus). The lynx population rise and fall according to the
%   variations in the populations of snowshoe hares over time. That is it, when
%   hares are abundant, lynx populations expand, and when the density of hares is
%   low, the population of lynx shrinks (there are many reasons why).
%   This is know as the predator-prey interaction.
%
%   In this example we want exemplify the joint modelling of the two species
%   population (abundance) aforementioned when data is missing in different
%   time intervals (for both species) and how one species can inform the
%   abundance of each another.
%
%   We assume that the number of lynx and hares follow the
%   negative-binomial distribution given unknown latent values (function
%   values of some unspecified function form for the regression), i.e.,
%
%       N1(t)|f1(t) ~ Neg-Binomial(exp(f1(t)), r1)  (hare)
%       N2(t)|f2(t) ~ Neg-Binomial(exp(f2(t)), r2)  (lynx)
%
%   and that N1(t)|f1(t) is independent of N2(t)|f2(t). The expression exp(f1(t))
%   is the expected value of N1 given f1 and exp(f2(t)) is the expected value
%   of N2 given f2. The correlation is now introduced through the multivariate
%   Gaussian process prior assuming the linear model of coregionalization, i.e.,
%
%       [f1(t), f2(t')] ~ MGP(0, K)
%
%   where K is a full covariance matrix formed by covariance function
%
%       k(fj(t), fj'(t')) = Sig_(c = 1, 2) u_c(j, j') k_c(t, t')
%
%   with u_c(j, j') the (j, j') entry of the matrix U_c = Lc Lc^T, where Lc
%   is cth column of the Cholesky decomposition of the coregionalization
%   matrix (covariance matrix) {Sig}j,j' = sig_j sig_j' rho_{j, j'}. We use the
%   analytical approximation expectation-propagation to carry out the inference
%   over the latent values f1, f2 and then calcule the unconditional expected values
%   of N1 and N2, i.e, E[N1(t)|Y1 = y1, Y2 = y2] and E[N2(t)|Y1 = y1, Y2 = y2].
%
% Additional references :
%
%   Murray, J, D (2002). Mathematical biology. Third Edition. Springer
%    Series.
%
%   Gelfand et al. (2004). Nonstationary multivariate process modelling
%     through spatially varying coregionalization.
%
%   Rasmussen, C. E. and Williams, C. K. I. (2006). Gaussian
%    Processes for Machine Learning. The MIT Press.
%
%   Bernardo, J and Smith, A (2008). Bayesian Theory. Wiley series in
%    probability and statistics
%
% -------------- Marcelo Hartmann

%%
% ------- data analysis with the multivariate Gaussian process model

% download the data
S = which('demo_multivariategp');
L = strrep(S, 'demo_multivariategp.m', 'demodata/predpreydata.txt');
data = importdata(L);

% colors;
col = [0 0 1; 1 0 0];

% all time points (yearly)
t = data.data(:, 1);

% full data
yy = [round(data.data(:, 2)); round(data.data(:, 3))];

% take sparse data (you can change the years);
yr1 = [1870, 1900];
% yr1 = [1846,  1935]; one observation
indt1 = ~logical((t >= yr1(1)) .* (t <= yr1(2)));
t1 = t(indt1);

yr2 = [1850, 1870];
% yr2 = [1845, 1934]; one observation
indt2 = ~logical((t >= yr2(1)) .* (t <= yr2(2)));
t2 = t(indt2);

% hare (thousands)
y1 = round(data.data(indt1, 2));

% lynx (thousands)
y2 = round(data.data(indt2, 3));

% predator-prey data;
y = [y1; y2];

% create species markers
c = [ones(size(t1)); 2*ones(size(t2))];

% data gp-format - species markers in the last column
x = [[t1; t2] c];
z = [ones(size(x, 1), 1) c];

% likelihood structure for each species (the likelihood can also be distinct)
lik1 = lik_negbin;
lik2 = lik_negbin;
likS = {lik1 lik2};
lik = lik_liks('likelihoods', likS, 'classVariables', 2);

% correlation function for each species (the correlation functions can also be distinct)
k1 = gpcf_sexp('magnSigma2', 1, 'magnSigma2_prior', prior_fixed, 'selectedVariables', 1);
k2 = gpcf_sexp('magnSigma2', 1, 'magnSigma2_prior', prior_fixed, 'selectedVariables', 1);

% the linear model of coregionalization (multivariate Gaussian process model)
k = gpcf_covar('numberClass', 2, 'classVariables', 2, ...
    'R_prior', prior_corrunif('nu', 3), 'corrFun', {k1 k2});

% set gp structure
% for the EP approximation
gp = gp_set('lik', lik, 'cf', k, 'latent_method', 'EP');

% For the Laplace approximation
%gp = gp_set('lik', lik, 'cf', k, 'latent_method', 'Laplace');

% optimzation options
opt = optimset('TolFun', 1e-3, 'TolX', 1e-5, 'Display', 'iter');

% random initialization (this is important ...)
% wini = 2.* randn(size(gp_pak(gp))); gp = gp_unpak(gp, wini);

% map ─ type-II maximum likelihood
gp = gp_optim(gp, x, y, 'z', z, 'opt', opt);

% check the gradient ...
% gp_g(gp_pak(gp), gp, x, y, 'z', z)';

% take the parameters, hyperparameters estimates
[th ss] = gp_pak(gp);

% correlation matrix estimate
%rho = k.fh.RealToRho(th(end - 2 - 2), 1, [])
Corr = gp.cf{1}.fh.sigma(gp.cf{1}, 'corr');
Corr{1}

% prediction
np = 200;
xp = repmat(linspace(min(x(:, 1)), max(x(:, 1)), np)', 2, 1);
xp = [xp repelem((1:2), np)'];
zp = ones(size(xp, 1), 1);

% leave-one-out
[~, ~, lpyt] = gp_loopred(gp, x, y,'z', z);

% prediction for new observations
[Ef, Varf, ~, Ey, Vary] = gp_pred(gp, x, y, xp, 'z', z, 'zt', [zp xp(:, 2)]);

% --- visualize predictions

figure; hold on;

subplt = subplot(2, 1, 1); hold on
subplt.XLim = [min(xp(:, 1)), max(xp(:, 1))];
psubplt = get(subplt, 'pos');
psubplt(4) = psubplt(4) + 0.03;
psubplt(3) = psubplt(3) + 0.04;
psubplt(1) = psubplt(1) - 0.04;
set(subplt, 'pos', psubplt);

for j = 1:2
    indj = xp(:, 2) == j;
    indX = xp(indj, 1);

    pl(j) = plot(xp(indj, 1), Ey(indj), 'color', col(j, :), 'LineWidth', 2);
 end

% visualize observed (training) predator-pray data
pl(3) = plot(t1(t1 <= yr1(1)), y1(t1 <= yr1(1)), '.', ...
    'MarkerSize', 23, 'lineWidth', 2, 'color', col(1, :));
plot(t1(t1 >= yr1(2)), y1(t1 >= yr1(1)), '.', ...
    'MarkerSize', 23, 'lineWidth', 2, 'color', col(1, :));
pl(4) = plot(t2(t2 <= yr2(1)), y2(t2 <= yr2(1)), '.', ...
    'MarkerSize', 23, 'lineWidth', 2, 'color', col(2, :));
plot(t2(t2 >= yr2(2)), y2(t2 >= yr2(2)), '.', ...
    'MarkerSize', 23, 'lineWidth', 2, 'color', col(2, :));

xlabel('years'); ylabel('Population size');
title('multivariate Gaussian process model');

legend(pl, 'E[N_1(t_*)|N_1 = n_1, N_2 = n_2]', 'E[N_2(t_*)|N_1 = n_1, N_2 = n_2]', ...
    'hare-data', 'lynx-data', 'Location', 'northeast');

%%
% -------- data analysis with independent Gaussian process model

EfI = {}; VarfI = {}; EyI = {}; VaryI = {};
gpI = {};

subplt = subplot(2, 1, 2); hold on
subplt.XLim = [min(xp(:, 1)), max(xp(:, 1))];
psubplt = get(subplt, 'pos');
psubplt(4) = psubplt(4) + 0.05;
psubplt(3) = psubplt(3) + 0.04;
psubplt(1) = psubplt(1) - 0.03;
set(subplt, 'pos', psubplt);

for j = 1:2
    inddj = x(:, 2) == j;
    cf = gpcf_sexp('selectedVariables', 1);

    gpI{j} = gp_set('lik', likS{j}, 'cf', cf);
    gpI{j} = gp_optim(gpI{j}, x(inddj, :), y(inddj), 'opt', opt);

    indj = xp(:, 2) == j;
    indX = xp(indj, 1);

    [EfI{j}, VarfI{j}, lpyt, EyI{j}, VaryI{j}] = ...
        gp_pred(gpI{j}, x(inddj, :), y(inddj), xp(indj, :));

    pl(j) = plot(xp(indj, 1), EyI{j}, 'color', col(j, :), 'LineWidth', 1.7);
end

% visualize observed (training) predator-pray data
pl(3) = plot(t1(t1 <= yr1(1)), y1(t1 <= yr1(1)), '.', ...
    'MarkerSize', 23, 'lineWidth', 2, 'color', col(1, :));
plot(t1(t1 >= yr1(2)), y1(t1 >= yr1(1)), '.', ...
    'MarkerSize', 23, 'lineWidth', 2, 'color', col(1, :));
pl(4) = plot(t2(t2 <= yr2(1)), y2(t2 <= yr2(1)), '.', ...
    'MarkerSize', 23, 'lineWidth', 2, 'color', col(2, :));
plot(t2(t2 >= yr2(2)), y2(t2 >= yr2(2)), '.', ...
    'MarkerSize', 23, 'lineWidth', 2, 'color', col(2, :));

xlabel('years'); ylabel('Population size');
title('independent Gaussian process models');

legend(pl, 'E[N1(t)|Y1 = y1, Y2 = y2]', 'E[N2(t)|Y1 = y1, Y2 = y2]', ...
    'hare-data', 'lynx-data', 'Location', 'northeast');

%%
% ------ all measurements (compare the difference ...)

figure; hold on;

for j = 1:2
    indj = x(:, 2) == j;
    plot(x(indj, 1), y(indj), '.', 'MarkerSize', 13, 'color', col(j, :))
    pd(j) =  plot(t, yy((j - 1) * 91 + [1:91]), '.-', ...
        'color', col(j, :), 'MarkerSize', 23, 'LineWidth', 2);
end

xlabel('years'); ylabel('Population size');
title('full data');

legend(pd, 'hare-data', 'lynx-data', 'Location', 'northeast');


function [y, dzdg, dzdb] = vl_nngnorm(x, g, b, varargin)
%VL_NNGNORM CNN group normalization.
%   Y = VL_NNGNORM(X,G,B) applies group normalization
%   to the input X with shape HxWxCxN. Group normalization is defined as:
%
%      Y(i,j,k,t) = G(k',t) * X_HAT(i,j,k,t) + B(k',t)
%
%   where
%      k' = group_idx(k,C,G), where N_G is the number of groups and
%        group_idx(k,C,G) := floor(k / (C/N_G)).
%      X_HAT(i,j,k,t) = (X_HAT(i,j,k,t) - mu(k',t)) / sigma(k',t)
%      mu(k',t) = mean_ijk'' X(i,j,k'',t),
%      sigma2(k',t) = mean_ijk'' (X(i,j,k'',t) - mu(k'',t))^2,
%      sigma(k',t) = sqrt(sigma2(k) + EPSILON)
%        where k'' takes values such that group_idx(k'',C,G) == group_idx(k,C,G)
%
%   VL_NNGNORM(..., 'option', value, ...) takes the following option:
%
%   `numGroups`:: 32
%    The number of groups used to split the channels when computing
%    normalization statistics.
%
%   `epsilon`:: 1e-4
%    A parameter to add stability to the normalization operation.
%
%   Notes: GroupNorm is introduced in the paper:
%      `Group Normalization, Yuxin Wu, Kaiming He,
%      arXiv preprint arXiv:1803.08494 (2018)
%
% Copyright (C) 2018 Samuel Albanie
% All rights reserved.

  opts.numGroups = 32 ;
  opts.epsilon = 1e-4 ;
  [opts,dzdy] = vl_argparsepos(opts, varargin) ;

  bsize = size(x, 4) ;
  expectedSz = [1 1 size(x,3) 1] ;
  sg = size(g) ; sb = size(b) ;
  assert(all(expectedSz(1:numel(sg)) == sg), 'GAINS have unexpected size') ;
  assert(all(expectedSz(1:numel(sb)) == sb), 'BIASES have unexpected size') ;

  szX = size(x) ; % store original shape

  % compute statistics per group for current minibatch and normalize
  x = reshape(x, size(x,1), size(x,2), [], opts.numGroups, bsize) ;

  mu = groupAvg(x) ;
  sigma2 = groupAvg(bsxfun(@minus, x, mu).^ 2) ;
  sigma = sqrt(sigma2 + opts.epsilon) ;
  x_hat = bsxfun(@rdivide, bsxfun(@minus, x, mu), sigma) ;

  if isempty(dzdy)
    x_hat_ = reshape(x_hat, szX) ;
    y = bsxfun(@times, g, x_hat_) ; % apply gain
    y = bsxfun(@plus, y, b) ; % add bias
  else
    dzdy = dzdy{1} ;
    dzdb = chanSum(dzdy) ;
    x_hat_ = reshape(x_hat, szX) ; dzdg = chanSum(x_hat_ .* dzdy) ;
    dzdy = reshape(dzdy, size(x,1), size(x,2), [], opts.numGroups, bsize) ;

    g_ = reshape(g, 1, 1, size(dzdy, 3), []) ;
    dzdx_hat = bsxfun(@times, dzdy, g_) ;
    t1 = bsxfun(@minus, x, mu) ;
    m = prod([size(x,1) size(x,2) size(x,3)]) ;
    dzdsigma = groupSum((-1/2) * dzdx_hat .* bsxfun(@rdivide, t1, sigma.^3)) ;

    dzdmu = groupSum(bsxfun(@rdivide, dzdx_hat, -sigma)) + ...
                bsxfun(@times, dzdsigma, -2 * groupAvg(t1)) ;

    t4 = bsxfun(@rdivide, dzdx_hat, sigma) + ...
         bsxfun(@times, dzdsigma,  (2 / m) * t1) ;
    dzdx = bsxfun(@plus, t4, dzdmu * (1/m)) ;
    y = reshape(dzdx, szX) ;
  end

% ----------------------------------------
function avg = groupAvg(x)
% ----------------------------------------
  avg = mean(mean(mean(x, 1), 2), 3) ;

% -----------------------
function res = groupSum(x)
% -----------------------
  res = sum(sum(sum(x, 1), 2), 3) ;

% -----------------------
function res = chanSum(x)
% -----------------------
  res = sum(sum(sum(x, 1), 2), 4) ;


function x = quasigeometric_cdf_inv ( cdf, a, b )

%*****************************************************************************80
%
%% QUASIGEOMETRIC_CDF_INV inverts the Quasigeometric CDF.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 January 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real CDF, the value of the CDF.
%    0.0 <= CDF <= 1.0
%
%    Input, real A, the probability of 0 successes.
%    0.0 <= A <= 1.0.
%
%    Input, real B, the depreciation constant.
%    0.0 <= B < 1.0.
%
%    Output, integer X, the corresponding value of X.
%
  if ( cdf < 0.0 | 1.0 < cdf )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'QUASIGEOMETRIC_CDF_INV - Fatal error!\n' );
    fprintf ( 1, '  CDF < 0 or 1 < CDF.\n' );
    error ( 'QUASIGEOMETRIC_CDF_INV - Fatal error!' );
  end

  if ( cdf < a )
    x = 0;
  elseif ( b == 0.0 )
    x = 1;
  else
    x = 1 + floor ( ( log ( 1.0 - cdf ) - log ( 1.0 - a ) ) / log ( b ) );
  end

  return
end


function ex5bvp
%EX5BVP  Example 5 of the BVP tutorial.
%   Falkner-Skan BVPs are discussed in T. Cebeci and H.B. Keller,
%   Shooting and parallel shooting methods for solving the Falkner-Skan
%   boundary-layer equation, J. Comp. Phy., 7 (1971) 289-300.  This is
%   the positive wall shear case for which the parameter beta is known
%   and the problem is to be solved for a range of the parameter.  This
%   is the hardest case of the table in the paper.
%
%   The problem is posed on [0 infinity).  As in the paper cited, the
%   boundary condition at infinity is imposed at a finite point, here
%   called 'infinity'.  It is best to start with a relatively small value
%   and increase it until consistent results are obtained.  A value of 6
%   appears to be satisfactory.  Starting with a "large" value is tempting,
%   but not a good tactic because the code will fail with the crude guess
%   and default tolerances used here.

% Copyright 1999, The MathWorks, Inc.

%  'infinity' is a variable to facilitate experimentation.
infinity = 6;

%  The constant guess for the solution satisfies the boundary conditions.
solinit = bvpinit(linspace(0,infinity,5),[0 0 1]);

options = bvpset('stats','on');

sol = bvp4c(@ex5ode,@ex5bc,solinit,options);
eta = sol.x;
f = sol.y;

fprintf('\n');
fprintf('Cebeci & Keller report f''''(0) = 0.92768.\n')
fprintf('Value computed here is f''''(0) = %7.5f.\n',f(3,1))

clf reset
plot(eta,f(2,:));
axis([0 infinity 0 1.4]);
title('Falkner-Skan equation, positive wall shear, \beta = 0.5.')
xlabel('\eta')
ylabel('df/d\eta')
shg

% --------------------------------------------------------------------------

function dfdeta = ex5ode(eta,f)
%EX5ODE  ODE function for Example 5 of the BVP tutorial.
beta = 0.5;
dfdeta = [ f(2)
           f(3)
          -f(1)*f(3) - beta*(1 - f(2)^2) ];

% --------------------------------------------------------------------------

function res = ex5bc(f0,finf)
%EX5BC  Boundary conditions for Example 5 of the BVP tutorial.
res = [f0(1)
       f0(2)
       finf(2) - 1];


function F=scarsplslda(X,y,A,K,method,num,OPT)
%+++ This is the simplified version of CARS, only retaining the EDF element.
%+++ num: the number of Monte Carlo Sampling.
%+++ A:   the maximal number of PLS components to extract.
%+++ fold: number of folds for cross validation.
%+++ method: pretreat method, 'center' or 'autoscaling'.
%+++ OPT: 1: Plot. 0: No plot.
%+++ Advisor: Yizeng Liang, yizeng_liang@263.net.
%+++ Hongdong Li, Jan.3, 2009.
%+++ Reference: Hongdong Li, Yizeng Liang, Qingsong Xu and Dongsheng Cao,
%         Key wavelengths screening using competitive adaptive reweighted sampling method
%         for multivariate calibration J?. Anal. Chim. Acta, 2009, 648 (1): 77-84

%+++ Initial settings.
if nargin<7;OPT=1;end;  %+++ OPT==1: then figure output.
if nargin<6;num=50;end
if nargin<5;method='autoscaling';end
if nargin<4;K=5;end
if nargin<3;A=2;end

[Mx,Nx]=size(X);
A=min([Mx Nx A]);
index=1:Nx;

r0=1;
r1=2/Nx;
Vsel=1:Nx;

W=zeros(num,Nx);
Ratio=zeros(1,num);

%+++ Parameter of exponentially decreasing function.
b=log(r0/r1)/(num-1);  a=r0*exp(b);

%+++ Main Loop
for iter=1:num

     LDA=plslda(X(:,Vsel),y,A,method);    %+++ PLS model
     w=zeros(Nx,1);coef=LDA.coef_lda_origin(1:end-1);
     w(Vsel)=coef;W(iter,:)=w;
     w=abs(w);                                  %+++ weights
     [ws,indexw]=sort(-w);                      %+++ sort weights

     ratio=a*exp(-b*(iter+1));                      %+++ Ratio of retained variables.
     Ratio(iter)=ratio;
     K=round(Nx*ratio);

     w(indexw(K+1:end))=0;                      %+++ Eliminate some variables with small coefficients.

     Vsel=find(w~=0);
     fprintf('The %dth variable sampling finished.\n',iter);    %+++ Screen output.
 end

%+++  Cross-Validation to choose an optimal subset;
RMSEP=zeros(1,num);
Rpc=zeros(1,num);
for i=1:num
   vsel=find(W(i,:)~=0);
   CV=plsldacv(X(:,vsel),y,A,10,method,0);
   RMSEP(i)=min(CV.cv);
   Rpc(i)=CV.optPC;
   fprintf('The %dth subset finished.\n',i);
end
Rmin=min(RMSEP);
indexOPT=find(RMSEP==Rmin);
indexOPT=indexOPT(end);

%+++ output
F.method=method;
F.nPC=A;
F.W=W;
F.vim=sum(W,2);
F.cv=RMSEP;
F.minCV=Rmin;
F.iterOPT=indexOPT;
F.optPC=Rpc(indexOPT);
F.ratio=Ratio;
F.vsel=find(W(indexOPT,:)~=0)';
F.vim=abs(sum(W));

%+++ Plot
 if OPT==1;plotcars(F);end;
%+++ END


function [x, cost, info, options] = conjugategradient(problem, x, options)
% Conjugate gradient minimization algorithm for Manopt.
%
% function [x, cost, info, options] = conjugategradient(problem)
% function [x, cost, info, options] = conjugategradient(problem, x0)
% function [x, cost, info, options] = conjugategradient(problem, x0, options)
% function [x, cost, info, options] = conjugategradient(problem, [], options)
%
% Apply the conjugate gradient minimization algorithm to the problem
% defined in the problem structure, starting at x0 if it is provided
% (otherwise, at a random point on the manifold). To specify options whilst
% not specifying an initial guess, give x0 as [] (the empty matrix).
%
% The outputs x and cost are the best reached point on the manifold and its
% cost. The struct-array info contains information about the iterations:
%   iter : the iteration number (0 for the initial guess)
%   cost : cost value
%   time : elapsed time in seconds
%   gradnorm : Riemannian norm of the gradient
%   stepsize : norm of the last tangent vector retracted
%   beta : value of the beta parameter (see options.beta_type)
%   linesearch : information logged by options.linesearch
%   And possibly additional information logged by options.statsfun.
% For example, type [info.gradnorm] to obtain a vector of the successive
% gradient norms reached.
%
% The options structure is used to overwrite the default values. All
% options have a default value and are hence optional. To force an option
% value, pass an options structure with a field options.optionname, where
% optionname is one of the following and the default value is indicated
% between parentheses:
%
%   tolgradnorm (1e-6)
%       The algorithm terminates if the norm of the gradient drops below this.
%   maxiter (1000)
%       The algorithm terminates if maxiter iterations have been executed.
%   maxtime (Inf)
%       The algorithm terminates if maxtime seconds elapsed.
%   minstepsize (1e-10)
%       The algorithm terminates if the linesearch returns a displacement
%       vector (to be retracted) smaller in norm than this value.
%   beta_type ('H-S')
%       Conjugate gradient beta rule used to construct the new search
%       direction, based on a linear combination of the previous search
%       direction and the new (preconditioned) gradient. Possible values
%       for this parameter are:
%           'S-D', 'steep' for beta = 0 (preconditioned steepest descent)
%           'F-R' for Fletcher-Reeves's rule
%           'P-R' for Polak-Ribiere's modified rule
%           'H-S' for Hestenes-Stiefel's modified rule
%           'H-Z' for Hager-Zhang's modified rule
%           'L-S' for Sato's Liu-Storey rule
%       See Hager and Zhang 2006, "A survey of nonlinear conjugate gradient
%       methods" for a description of these rules in the Euclidean case and
%       for an explanation of how to adapt them to the preconditioned case.
%       The adaption to the Riemannian case is straightforward: see in code
%       for details. Modified rules take the max between 0 and the computed
%       beta value, which provides automatic restart, except for H-Z and L-S
%       which use a different modification. Sato's Liu-Storey rule is
%       described in Sato 2021, "Riemannian conjugate gradient methods:
%       General framework and specific algorithms with convergence analyses"
%   orth_value (Inf)
%       Following Powell's restart strategy (Math. prog. 1977), restart CG
%       (that is, make a -preconditioned- gradient step) if two successive
%       -preconditioned- gradients are "too" parallel. See for example
%       Hager and Zhang 2006, "A survey of nonlinear conjugate gradient
%       methods", page 12. An infinite value disables this strategy. See in
%       code formula for the specific criterion used.
%   linesearch (@linesearch_adaptive or @linesearch_hint)
%       Function handle to a line search function. The options structure is
%       passed to the line search too, so you can pass it parameters. See
%       each line search's documentation for info. Another available line
%       search in manopt is @linesearch, in /manopt/linesearch/linesearch.m
%       If the problem structure includes a line search hint, then the
%       default line search used is @linesearch_hint.
%   statsfun (none)
%       Function handle to a function that will be called after each
%       iteration to provide the opportunity to log additional statistics.
%       They will be returned in the info struct. See the generic Manopt
%       documentation about solvers for further information.
%   stopfun (none)
%       Function handle to a function that will be called at each iteration
%       to provide the opportunity to specify additional stopping criteria.
%       See the generic Manopt documentation about solvers for further
%       information.
%   verbosity (3)
%       Integer number used to tune the amount of output the algorithm
%       generates during execution (mostly as text in the command window).
%       The higher, the more output. 0 means silent.
%   storedepth (2)
%       Maximum number of different points x of the manifold for which a
%       store structure will be kept in memory in the storedb. If the
%       caching features of Manopt are not used, this is irrelevant. For
%       the CG algorithm, a store depth of 2 should always be sufficient.
%
%
% In most of the examples bundled with the toolbox (see link below), the
% solver can be replaced by the present one if need be.
%
% See also: steepestdescent trustregions manopt/solvers/linesearch manopt/examples

% An explicit, general listing of this algorithm, with preconditioning,
% can be found in the following paper:
%     @Article{boumal2015lowrank,
%       Title   = {Low-rank matrix completion via preconditioned optimization on the {G}rassmann manifold},
%       Author  = {Boumal, N. and Absil, P.-A.},
%       Journal = {Linear Algebra and its Applications},
%       Year    = {2015},
%       Pages   = {200--239},
%       Volume  = {475},
%       Doi     = {10.1016/j.laa.2015.02.027},
%     }

% This file is part of Manopt: www.manopt.org.
% Original author: Bamdev Mishra, Dec. 30, 2012.
% Contributors: Nicolas Boumal, Nick Vannieuwenhoven
% Change log:
%
%   March 14, 2013, NB:
%       Added preconditioner support : see Section 8 in
%       https://www.math.lsu.edu/~hozhang/papers/cgsurvey.pdf
%
%   Sept. 13, 2013, NB:
%       Now logging beta parameter too.
%
%   Nov. 7, 2013, NB:
%       The search direction is no longer normalized before it is passed
%       to the linesearch. This way, it is up to the designers of the
%       linesearch to decide whether they want to use the norm of the
%       search direction in their algorithm or not. There are reasons
%       against it, but practical evidence that it may help too, so we
%       allow it. The default linesearch_adaptive used does exploit the
%       norm information. The base linesearch does not. You may select it
%       by setting options.linesearch = @linesearch;
%
%   Nov. 29, 2013, NB:
%       Documentation improved: options are now explicitly described.
%       Removed the Daniel rule for beta: it was not appropriate for
%       preconditioned CG and I could not find a proper reference for it.
%
%   April 3, 2015 (NB):
%       Works with the new StoreDB class system.
%
%   Aug. 2, 2018 (NB):
%       Now using storedb.remove() to keep the cache lean.
%
%   Feb. 7, 2022 (NV):
%       Added support for Liu-Storey rule (L-S).

M = problem.M;

% Verify that the problem description is sufficient for the solver.
if ~canGetCost(problem)
    warning('manopt:getCost', ...
        'No cost provided. The algorithm will likely abort.');
end
if ~canGetGradient(problem) && ~canGetApproxGradient(problem)
    warning('manopt:getGradient:approx', ...
           ['No gradient provided. Using an FD approximation instead (slow).\n' ...
            'It may be necessary to increase options.tolgradnorm.\n' ...
            'To disable this warning: warning(''off'', ''manopt:getGradient:approx'')']);
    problem.approxgrad = approxgradientFD(problem);
end

% Set local defaults here
localdefaults.minstepsize = 1e-10;
localdefaults.maxiter = 1000;
localdefaults.tolgradnorm = 1e-6;
localdefaults.storedepth = 20;
% Changed by NB : H-S has the "auto restart" property.
% See Hager-Zhang 2005/2006 survey about CG methods.
% The auto restart comes from the 'max(0, ...)', not so much from the
% reason stated in Hager-Zhang I think. P-R also has auto restart.
localdefaults.beta_type = 'H-S';
localdefaults.orth_value = Inf; % by BM as suggested in Nocedal and Wright

% Depending on whether the problem structure specifies a hint for
% line-search algorithms, choose a default line-search that works on
% its own (typical) or that uses the hint.
if ~canGetLinesearch(problem)
    localdefaults.linesearch = @linesearch_adaptive;
else
    localdefaults.linesearch = @linesearch_hint;
end

% Merge global and local defaults, then merge w/ user options, if any.
localdefaults = mergeOptions(getGlobalDefaults(), localdefaults);
if ~exist('options', 'var') || isempty(options)
    options = struct();
end
options = mergeOptions(localdefaults, options);

timetic = tic();

% If no initial point x is given by the user, generate one at random.
if ~exist('x', 'var') || isempty(x)
    x = M.rand();
end

% Create a store database and generate a key for the current x
storedb = StoreDB(options.storedepth);
key = storedb.getNewKey();

% Compute cost-related quantities for x
[cost, grad] = getCostGrad(problem, x, storedb, key);
gradnorm = M.norm(x, grad);
Pgrad = getPrecon(problem, x, grad, storedb, key);
gradPgrad = M.inner(x, grad, Pgrad);

% Iteration counter (at any point, iter is the number of fully executed
% iterations so far)
iter = 0;

% Save stats in a struct array info and preallocate.
stats = savestats();
info(1) = stats;
info(min(10000, options.maxiter+1)).iter = [];

if options.verbosity >= 2
    fprintf(' iter\t               cost val\t    grad. norm\n');
end

% Compute a first descent direction (not normalized)
desc_dir = M.lincomb(x, -1, Pgrad);

% Start iterating until stopping criterion triggers
while true

    % Display iteration information
    if options.verbosity >= 2
        fprintf('%5d\t%+.16e\t%.8e\n', iter, cost, gradnorm);
    end

    % Start timing this iteration
    timetic = tic();

    % Run standard stopping criterion checks
    [stop, reason] = stoppingcriterion(problem, x, options, info, iter+1);

    % Run specific stopping criterion check
    if ~stop && abs(stats.stepsize) < options.minstepsize
        stop = true;
        reason = sprintf(['Last stepsize smaller than minimum '  ...
                          'allowed; options.minstepsize = %g.'], ...
                          options.minstepsize);
    end

    if stop
        if options.verbosity >= 1
            fprintf([reason '\n']);
        end
        break;
    end

    % The line search algorithms require the directional derivative of the
    % cost at the current point x along the search direction.
    df0 = M.inner(x, grad, desc_dir);

    % If we didn't get a descent direction: restart, i.e., switch to the
    % negative gradient. Equivalent to resetting the CG direction to a
    % steepest descent step, which discards the past information.
    if df0 >= 0

        % Or we switch to the negative gradient direction.
        if options.verbosity >= 3
            fprintf(['Conjugate gradient info: got an ascent direction '...
                     '(df0 = %2e), reset to the (preconditioned) '...
                     'steepest descent direction.\n'], df0);
        end
        % Reset to negative gradient: this discards the CG memory.
        desc_dir = M.lincomb(x, -1, Pgrad);
        df0 = -gradPgrad;

    end

    % Execute line search
    [stepsize, newx, newkey, lsstats] = options.linesearch( ...
                   problem, x, desc_dir, cost, df0, options, storedb, key);

    % Compute the new cost-related quantities for newx
    [newcost, newgrad] = getCostGrad(problem, newx, storedb, newkey);
    newgradnorm = M.norm(newx, newgrad);
    Pnewgrad = getPrecon(problem, newx, newgrad, storedb, newkey);
    newgradPnewgrad = M.inner(newx, newgrad, Pnewgrad);

    % Apply the CG scheme to compute the next search direction.
    %
    % This paper https://www.math.lsu.edu/~hozhang/papers/cgsurvey.pdf
    % by Hager and Zhang lists many known beta rules. The rules defined
    % here can be found in that paper (or are provided with additional
    % references), adapted to the Riemannian setting.
    %
    if strcmpi(options.beta_type, 'steep') || ...
       strcmpi(options.beta_type, 'S-D')              % Gradient Descent

        beta = 0;
        desc_dir = M.lincomb(newx, -1, Pnewgrad);

    else

        oldgrad = M.transp(x, newx, grad);
        orth_grads = M.inner(newx, oldgrad, Pnewgrad) / newgradPnewgrad;

        % Powell's restart strategy (see page 12 of Hager and Zhang's
        % survey on conjugate gradient methods, for example)
        if abs(orth_grads) >= options.orth_value
            beta = 0;
            desc_dir = M.lincomb(x, -1, Pnewgrad);

        else % Compute the CG modification

            desc_dir = M.transp(x, newx, desc_dir);

            switch upper(options.beta_type)

                case 'F-R'  % Fletcher-Reeves
                    beta = newgradPnewgrad / gradPgrad;

                case 'P-R'  % Polak-Ribiere+
                    % vector grad(new) - transported grad(current)
                    diff = M.lincomb(newx, 1, newgrad, -1, oldgrad);
                    ip_diff = M.inner(newx, Pnewgrad, diff);
                    beta = ip_diff / gradPgrad;
                    beta = max(0, beta);

                case 'H-S'  % Hestenes-Stiefel+
                    diff = M.lincomb(newx, 1, newgrad, -1, oldgrad);
                    ip_diff = M.inner(newx, Pnewgrad, diff);
                    beta = ip_diff / M.inner(newx, diff, desc_dir);
                    beta = max(0, beta);

                case 'H-Z' % Hager-Zhang+
                    diff = M.lincomb(newx, 1, newgrad, -1, oldgrad);
                    Poldgrad = M.transp(x, newx, Pgrad);
                    Pdiff = M.lincomb(newx, 1, Pnewgrad, -1, Poldgrad);
                    deno = M.inner(newx, diff, desc_dir);
                    numo = M.inner(newx, diff, Pnewgrad);
                    numo = numo - 2*M.inner(newx, diff, Pdiff)*...
                                     M.inner(newx, desc_dir, newgrad) / deno;
                    beta = numo / deno;

                    % Robustness (see Hager-Zhang paper mentioned above)
                    desc_dir_norm = M.norm(newx, desc_dir);
                    eta_HZ = -1 / ( desc_dir_norm * min(0.01, gradnorm) );
                    beta = max(beta, eta_HZ);

                case 'L-S' % Liu-Storey+ from Sato
                    diff = M.lincomb(newx, 1, newgrad, -1, oldgrad);
                    ip_diff = M.inner(newx, Pnewgrad, diff);
                    denom = -1*M.inner(x, grad, desc_dir);
                    betaLS = ip_diff / denom;
                    betaCD = newgradPnewgrad / denom;
                    beta = max(0, min(betaLS, betaCD));

                otherwise
                    error(['Unknown options.beta_type. ' ...
                           'Should be steep, S-D, F-R, P-R, H-S, H-Z, or L-S.']);
            end

            desc_dir = M.lincomb(newx, -1, Pnewgrad, beta, desc_dir);

        end

    end

    % Transfer iterate info.
    storedb.removefirstifdifferent(key, newkey);
    x = newx;
    key = newkey;
    cost = newcost;
    grad = newgrad;
    Pgrad = Pnewgrad;
    gradnorm = newgradnorm;
    gradPgrad = newgradPnewgrad;

    % iter is the number of iterations we have accomplished.
    iter = iter + 1;

    % Make sure we don't use too much memory for the store database.
    storedb.purge();

    % Log statistics for freshly executed iteration.
    stats = savestats();
    info(iter+1) = stats;

end

info = info(1:iter+1);

if options.verbosity >= 1
    fprintf('Total time is %f [s] (excludes statsfun)\n', info(end).time);
end

% Routine in charge of collecting the current iteration stats
function stats = savestats()
    stats.iter = iter;
    stats.cost = cost;
    stats.gradnorm = gradnorm;
    if iter == 0
        stats.stepsize = nan;
        stats.time = toc(timetic);
        stats.linesearch = [];
        stats.beta = 0;
    else
        stats.stepsize = stepsize;
        stats.time = info(iter).time + toc(timetic);
        stats.linesearch = lsstats;
        stats.beta = beta;
    end
    stats = applyStatsfun(problem, x, storedb, key, options, stats);
end

end


%% Alignment of the Crystal Axes
%
% Default is $\vec c$ axis of highest symmetry.
%
% TODO: Explain the default setting in more detail.
%
%% Switching between different Alignment Options
%
% Since, especialy for lower symmetry groups, different conventions for
% aligning the crystal axes are used it might be necessary to transform
% data, e.g, orientations or tensors, from one convention into another.
% This can be done using the command <tensor.transformReferenceFrame.html
% transformReferenceFrame> as it illustrated below.
%
% First we import the stiffness tensor Forsterite with respect to the axes
% alignment

cs = crystalSymmetry('mmm',[4.7646 10.2296 5.9942],'mineral','Olivin');

% import some stiffness tensor
fname = fullfile(mtexDataPath,'tensor','Olivine1997PC.GPa');
C = stiffnessTensor.load(fname,cs)

plot(C)

%%
% Let us now consider a different setup of the Forsterite symmetry, where
% the $\vec a$ axis is the longest and the $\vec c$-axis is the shortest.

cs_new = crystalSymmetry('mmm',[10.2296 5.9942 4.7646],'mineral','Olivin')

%%
% In order to represent the stiffness tensor |C| with respect to this
% setupt we use the command <tensor.transformReferenceFrame.html
% transformReferenceFrame>.

C_new = C.transformReferenceFrame(cs_new)

nextAxis
plot(C_new)


function fx = circle ( n, x )

%*****************************************************************************80
%
%% CIRCLE evaluates the circle function.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    03 January 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of points.
%
%    Input, real X(N,2), the point coordinates.
%
%    Output, real FX(N), the function values.
%
  global c
  global r

  if ( isempty ( c ) )
    c = [ 0.0, 0.5 ];
  end

  if ( isempty ( r ) )
    r = 0.5;
  end

  nc = ones ( n, 1 ) * c;
  nr = ones ( n, 1 ) * r;

  fx = nr - sqrt ( sum ( ( x - nc ).^2, 2 ) );

  return
end


function bound = AnglesLocalMaxMin(f,N)

%================================================================
% function bound = AnglesLocalMaxMin(f,N)
%
% This function segments f into a maximum of N supports by taking
% the middle point between the N largest local maxima.
% Note: the detected boundaries are given in term of indices
%
% Inputs:
%   -f: the function to segment
%   -N: maximal number of bands
%
% Outputs:
%   -bound: list of detected boundaries
%
% Author: Jerome Gilles
% Institution: UCLA - Department of Mathematics
% Year: 2013
% Version: 1.0
%===============================================================

locmax=zeros(size(f));
locmin=max(f)*ones(size(f));
% We detect the local maxima
for i=2:length(f)-1
    if ((f(i-1)<f(i)) && (f(i)>f(i+1)))
        locmax(i)=f(i);
    end

    if ((f(i-1)>f(i)) && (f(i)<=f(i+1)))
        locmin(i)=f(i);
    end
end

% We check if the endpoint are local maxima or minima (we work on the torus)
if ((f(end)<f(1)) && (f(1)>f(2)))
    locmax(1)=f(1);
end
if ((f(end)>f(1)) && (f(1)<=f(2)))
    locmin(1)=f(1);
end

if ((f(end-1)<f(end)) && (f(end)>f(1)))
    locmax(end)=f(end);
end
if ((f(end-1)>f(end)) && (f(end)<=f(1)))
    locmin(end)=f(end);
end

% We keep the N-th highest maxima and their index
[lmax,Imax]=sort(locmax,1,'descend');
if length(lmax)>N
    Imax=sort(Imax(1:N));
else
    Imax=sort(Imax);
    N=length(lmax);
end

% We detect the lowest minima between two consecutive maxima
bound=zeros(1,N);
for i=1:N
   if i==N
       [lmin,ind]=sort([locmin(Imax(i):end);locmin(1:Imax(1))]);
       tmp=lmin(1);
       n=1;
       if n<length(lmin)
            n=2;
            while ((n<=length(lmin)) && (tmp==lmin(n)))
                n=n+1;
            end
       end
        bound(i)=Imax(i)+ind(ceil(n/2))-1;
       if bound(i)>length(f)
           bound(i)=bound(i)-length(f);
       end
   else
       [lmin,ind]=sort(locmin(Imax(i):Imax(i+1)));
       tmp=lmin(1);
       n=1;
       if n<length(lmin)
            n=2;
            while ((n<=length(lmin)) && (tmp==lmin(n)))
                n=n+1;
            end
       end
       bound(i)=Imax(i)+ind(ceil(n/2))-1;
   end
end

bound=sort(bound);


% Fig. 6.47   Feedback Control of Dynamic Systems, 5e
%             Franklin, Powell, Emami
%

clear all;
close all;

num=[20 1];
den=[1 0 0];
w=logspace(-3,1,100);
[m,p]=bode(num,den,w);
loglog(w,m);
grid;
xlabel('\omega (rad/sec)');
ylabel('Magnitude');
title('Fig. 6.47 Compensated open-loop transfer function.');


function BS2 = fit(v,varargin)
% function to fit Bingham parameters
%
% Description
% confidence ellipse for the mean direction based on Tanaka
% (1999) https://doi.org/10.1186/BF03351601
%
% Syntax
%   BS2 = BinghamS2.fit(v)
%
% Input
%  v - vector3d
%
% Output
%  BS2 - @BinghamS2
%
%
% Options
%  ConfElli - confidence level p (default at 0.95)
%
%
% Example
%
%   % simulate some directions
%   odf = unimodalODF(quaternion.id,'halfwidth',10*degree);
%   N = 100;
%   v = odf.discreteSample(N) .* ...
%     rotation.byAxisAngle(vector3d.X,rand(N,1)*2*pi) * vector3d.Y;
%
%   % fit a Bingham distribution
%   S2F = BinghamS2.fit(v)
%
%   % visualization
%   plot(S2F)
%   mtexColorMap LaboTeX
%   hold on
%   plot(t,'Markercolor','k','MarkerSize',3)
%   hold off
%

[a,kappa] = eig3(v*v);
kappa = kappa./sum(kappa);
Z =estimateZ(kappa);
BS2 = BinghamS2(Z, a);
BS2.N = BS2.normalizationConst;

% add the estimate of confidence level, given as ellipse half
% axes e.g.
% plot(v)
% ellipse(rotation('matrix',BS2.a.xyz'),BS2.cEllipse(1),BS2.cEllipse(2))
p = get_option(varargin,'ConfElli',0.95);
J = sqrt(chi2inv(p,2))/2;
BS2.cEllipse = [J/(-Z(2)*(kappa(3)-kappa(2))), ...
  J/(-Z(1)*(kappa(3)-kappa(1)))];

  function Z = estimateZ(kappa)
    % adapted from https://github.com/libDirectional/libDirectional
    % Igor Gilitschenski, Gerhard Kurz, Simon J. Julier, Uwe D. Hanebeck,
    % Efficient Bingham Filtering based on Saddlepoint Approximations, 2014
    % Proceedings of the 2014 IEEE International Conference on Multisensor Fusion and Information Integration (MFI 2014), Beijing, China, September 2014.

    f = @(z) findZ(z, kappa);
    Z = fsolve(f, -ones(2,1), optimset('display', 'off', 'algorithm', 'levenberg-marquardt'));
    Z = [Z; 0];
    [Z, ~] = sort(Z,'ascend');

    function R = findZ(Z, rhs)  % needs esternal mex
      Z=[Z;0];
      d = size(Z,1);

      % normalization constant
      A = numericalSaddlepointWithDerivatives(sort(-Z)+1)*exp(1);
      A = A(3);

      % derivative of normalization constant
      B = zeros(1,3);
      dim = size(Z,1);
      for i=1:dim
        mZ = Z([1:i i i:dim]);
        T = numericalSaddlepointWithDerivatives(sort(-mZ)+1)*exp(1)/(2*pi);
        B(i) = T(3);
      end

      R = zeros(d-1,1);
      for i=1:(d-1)
        R(i) = B(i)/A - rhs(i);
      end
    end
  end

end


% For FDSA, this code provides values of a, A, and c in the gains a_k=a/(k+1+A)^.602 and
% c_k = c/(k+1)^.101. Code does not have built-in provision for gradient averaging (unlike
% SPSA) due to the relatively large no. of loss evals. required per gradient.
%
% Specify the dimension, loss function, and i.c.
%
global p sigma
p=10;
loss='loss4thnoise';
theta=ones(10,1);
alpha=0.602;
%
% User input on measurement noise level, expected no. of iterations in the SPSA run,
% desired magnitude of change in the theta elements, the number of SPSA gradient approximations
% that will be averaged, and the no. of loss evaluations to be used in the gain calculations
% here (note this no. should be divisible by twice the no. of averaged gradients).
%
step= input('What is the initial desired magnitude of change in the theta elements? ');
A = .10*input('What is the expected number of loss evaluations per run? ')...
   /(2*p);
sigma = input('What is the standard deviation of the measurement noise at i.c.? ');
c = max(sigma, .0001);
NL = input('How many loss function evaluations do you want to use in this gain calculation? ');
%
% Calculate the NL/(2*p) FD gradient estimates
%
rand('seed',31415927)
randn('seed',111113); %used in setting seed for noise in loss measurements
gbar=0;
e=eye(p);
atemp=zeros(p,1);
for i=1:NL/(2*p)
   ghat=0;
   for j=1:p
      thetaplus = theta + c*e(:,j);
      thetaminus = theta - c*e(:,j);
      yplus=feval(loss,thetaplus);
      yminus=feval(loss,thetaminus);
      ghat(j) = (yplus - yminus)/(2*c);
   end
   gbar=gbar+abs(ghat);
end
gbar=gbar/(NL/(2*p));
for i=1:p
   atemp(i)=step*((A+1)^alpha)/gbar(i);
end
atemp
a=min(atemp);
c
A
a


classdef RankTwoLaminateHomogenizerFromAllaireTestedWebPageCode

    properties
    end

    methods (Static)
        function Chomog = ChinvOld(lambda,mu,d1,d2,m1,m2,theta,epsil)

            sqrt2 = sqrt(2);

            e1x = d1(1);
            e1y = d1(2);

            e2x = d2(1);
            e2y = d2(2);

            K = (mu+lambda)/(mu*(2*mu+lambda));

            muVoigt = mu;

            A =	m1 * ( (lambda+2*mu) - 1/mu*(lambda^2*e1y^2+(lambda+2*mu)^2*e1x^2) + K*((lambda+2*mu)*e1x^2+lambda*e1y^2)^2 ) + ...
                +m2* ( (lambda+2*mu) - 1/mu*(lambda^2*e2y^2+(lambda+2*mu)^2*e2x^2) + K*((lambda+2*mu)*e2x^2+lambda*e2y^2)^2 );
            B =	m1 * ( (lambda+2*mu) - 1/mu*(lambda^2*e1x^2+(lambda+2*mu)^2*e1y^2) + K*((lambda+2*mu)*e1y^2+lambda*e1x^2)^2 )  + ...
                +m2* ( (lambda+2*mu) - 1/mu*(lambda^2*e2x^2+(lambda+2*mu)^2*e2y^2) + K*((lambda+2*mu)*e2y^2+lambda*e2x^2)^2 );
            C =	m1 * ( 4*mu - 1/mu*(2*mu)^2 + K*(4*mu*e1x*e1y)^2 )/2  + ...
                +m2* ( 4*mu - 1/mu*(2*mu)^2 + K*(4*mu*e2x*e2y)^2 )/2;
            D = 	m1 * ( 2*lambda - 1/mu*(2*lambda*(lambda+2*mu)) + K*2*((lambda+2*mu)*e1y^2+lambda*e1x^2)*((lambda+2*mu)*e1x^2+lambda*e1y^2) )/2  + ...
                +m2* ( 2*lambda - 1/mu*(2*lambda*(lambda+2*mu)) + K*2*((lambda+2*mu)*e2y^2+lambda*e2x^2)*((lambda+2*mu)*e2x^2+lambda*e2y^2) )/2;
            E =	m1 * ( -1/mu*(4*mu*(2*lambda+2*mu)*e1x*e1y) + K*2*(4*mu*e1x*e1y*((lambda+2*mu)*e1y^2+lambda*e1x^2)) )/(2*sqrt2)  + ...
                +m2* ( -1/mu*(4*mu*(2*lambda+2*mu)*e2x*e2y) + K*2*(4*mu*e2x*e2y*((lambda+2*mu)*e2y^2+lambda*e2x^2)) )/(2*sqrt2);
            F = 	m1 * ( -1/mu*(4*mu*(2*lambda+2*mu)*e1x*e1y) + K*2*(4*mu*e1x*e1y*((lambda+2*mu)*e1x^2+lambda*e1y^2)) )/(2*sqrt2)  + ...
                +m2* ( -1/mu*(4*mu*(2*lambda+2*mu)*e2x*e2y) + K*2*(4*mu*e2x*e2y*((lambda+2*mu)*e2x^2+lambda*e2y^2)) )/(2*sqrt2);

            %// Ajout du matériau mou (qui simule le vide)
            A = epsil/(1.-epsil)*(lambda+2*mu)	+ theta*A;
            B = epsil/(1.-epsil)*(lambda+2*mu)	+ theta*B;
            C = epsil/(1.-epsil)*muVoigt		+ theta*C;
            D = epsil/(1.-epsil)*lambda		+ theta*D;
            E = epsil/(1.-epsil)*0			+ theta*E;
            F = epsil/(1.-epsil)*0			+ theta*F;

            %//Première inversion
            DET = A*B*C-A*E*E-B*F*F-C*D*D+2*D*E*F;
            A1=(B*C-E*E)/DET;
            B1=(A*C-F*F)/DET;
            C1=(A*B-D*D)/DET;
            D1=(E*F-C*D)/DET;
            E1=(D*F-A*E)/DET;
            F1=(D*E-B*F)/DET;

            A = (1-theta)*A1+(lambda+2*mu)/(4*mu*(lambda+mu));
            B = (1-theta)*B1+(lambda+2*mu)/(4*mu*(lambda+mu));
            C = (1-theta)*C1+1/(muVoigt);
            D = (1-theta)*D1-lambda/(4*mu*(lambda+mu));
            E = (1-theta)*E1;
            F = (1-theta)*F1;

            %//Deuxième inversion
            DET = A*B*C-A*E*E-B*F*F-C*D*D+2*D*E*F;
            A1=(B*C-E*E)/DET;
            B1=(A*C-F*F)/DET;
            C1=(A*B-D*D)/DET;
            D1=(E*F-C*D)/DET;
            E1=(D*F-A*E)/DET;
            F1=(D*E-B*F)/DET;
            A=A1;
            B=B1;
            C=C1;
            D=D1;
            E=E1;
            F=F1;

            Chomog = [A   D	 F;
                D   B  E;
                F   E  C];

        end

    end

end