function b = r8vm_to_r8ge ( m, n, a, b )

%*****************************************************************************80
%
%% R8VM_TO_R8GE copies a R8VM matrix to a R8GE matrix.
%
%  Discussion:
%
%    The R8VM storage format is used for an M by N Vandermonde matrix.
%    An M by N Vandermonde matrix is defined by the values in its second
%    row, which will be written here as X(1:N).  The matrix has a first
%    row of 1's, a second row equal to X(1:N), a third row whose entries
%    are the squares of the X values, up to the M-th row whose entries
%    are the (M-1)th powers of the X values.  The matrix can be stored
%    compactly by listing just the values X(1:N).
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    05 February 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns of the matrix.
%
%    Input, real A(N,1), the R8VM matrix.
%
%    Output, real B(M,N), the R8GE matrix.
%
  a = a(:);

  for i = 1 : m
    for j = 1 : n
      if ( i == 1 )
        b(i,j) = 1.0;
      else
        b(i,j) = b(i-1,j) * a(j,1);
      end
    end
  end

  return
end


function [v_0_vec, v_vec, a, e, p] = LambertBattin_v2(r_0_vec, r_vec, delta_t, t_m, N)
%
% USAGE = [v_0_vec, v_vec, a, e, p] = LambertBattin_v2(r_0_vec, r_vec, delta_t, t_m, N)
%

% Function constants
% mu = 3.986e5;
mu = 398600.4418; % Sun gravitational constant (km^3/sec^2)
tol = 1e-6;
iter_max = 500;

r_0 = norm(r_0_vec);
r = norm(r_vec);

cos_delta_nu = dot(r_0_vec, r_vec) / (r_0 * r);
sin_delta_nu = t_m * sqrt(1 - cos_delta_nu^2);
delta_nu = atan2(sin_delta_nu, cos_delta_nu);
if delta_nu < 0

    delta_nu = 2 * pi + delta_nu;

end

c = sqrt(r_0^2 + r^2 - 2 * r_0 * r * cos_delta_nu);
s = (r_0 + r + c) / 2;

epsilon = (r - r_0) / r_0;
tan_sq_2w = (epsilon^2 / 4) / (sqrt(r / r_0) + (r / r_0) * (2 + sqrt(r / r_0)));
r_0p = sqrt(r_0 * r) * ((cos(delta_nu / 4))^2 + tan_sq_2w);

sin_sq_delta_nu_4 = (sin(delta_nu / 4))^2;
cos_sq_delta_nu_4 = (cos(delta_nu / 4))^2;
cos_delta_nu_2 = cos(delta_nu / 2);
if (delta_nu > 0) && (delta_nu < pi)

    l = (sin_sq_delta_nu_4 + tan_sq_2w) / (sin_sq_delta_nu_4 + tan_sq_2w + cos_delta_nu_2);

elseif (delta_nu > pi) && (delta_nu < 2*pi)

    l = (cos_sq_delta_nu_4 + tan_sq_2w - cos_delta_nu_2) / (cos_sq_delta_nu_4 + tan_sq_2w);

else

    error('Delta_nu out of range');

end

m = (mu * delta_t^2) / (8 * r_0p^3);

if N == 0

    % Initial estimate for x
    x_new = l;

    loop_flag = 1;
    i_iter = 1;
    while loop_flag == 1

        x_old = x_new;
        [x_new, y] = original_sub(x_old, l, m, N);

        if abs(x_new - x_old) < tol

            loop_flag = 0;

        elseif i_iter < iter_max

            i_iter = i_iter + 1;

        else

            loop_flag = 0;
            x_new = NaN;
            y = NaN;

        end

    end

    x_f = x_new;
    y_f = y;

else % N > 0

    loop_flag_R = 1;
    loop_flag_L = 1;
    i_iter_R = 1;
    i_iter_L = 1;

    % Initial estimate for x_R
    x_new = l;

    while loop_flag_R == 1

        x_old = x_new;
        [x_new, y] = reverse_sub(x_old, l, m, N);

        if y < 1

            % In divergent region for the reversed successive substitution
            % Begin original successive substitution to find x_L
            x_new = l;
            x_old = x_new;
            [x_new, y] = original_sub(x_old, l, m, N);

            while loop_flag_L == 1

                x_old = x_new;
                [x_new, y] = original_sub(x_old, l, m, N);

                if abs(x_new - x_old) < tol

                    loop_flag_L = 0;

                elseif i_iter_R < iter_max

                    i_iter_R = i_iter_R + 1;

                else

                    loop_flag_L = 0;
                    x_new = NaN;
                    y = NaN;

                end

            end

            y_L = y;
            x_L = x_new;

            % Reset initial guess for x_R
            x_new = x_new / 2;
            x_old = x_new - 2 * tol;

        end

        if abs(x_new - x_old) < tol

            loop_flag_R = 0;

        elseif i_iter_R < iter_max

            i_iter_R = i_iter_R + 1;

        else

            loop_flag_R = 0;
            x_new = NaN;
            y = NaN;

        end

    end

    y_R = y;
    x_R = x_new;

    % Only continue if x_L and y_L were not found in above iteration
    if loop_flag_L == 1

        % Initial estimate for x_L & y
        x_new = 2 * x_R;

        while loop_flag_L == 1

            x_old = x_new;
            [x_new, y] = original_sub(x_old, l, m, N);

            if abs(x_new - x_old) < tol

                loop_flag_L = 0;

            elseif i_iter_L < iter_max

                i_iter_L = i_iter_L + 1;

            else

                loop_flag_L = 0;
                x_new = NaN;
                y = NaN;

            end

        end

        y_L = y;
        x_L = x_new;

    end

    y_f = [y_R; y_L];
    x_f = [x_R; x_L];

end

if N == 0

    n = 1;

else

    n = 2;

end

a = zeros(n,1);
e = zeros(n,1);
p = zeros(n,1);
v_vec = zeros(n,3);
v_0_vec = zeros(n,3);
for i = 1:n

    a(i) = mu * delta_t^2 / (16 * r_0p^2 * x_f(i) * y_f(i)^2);
    e(i) = sqrt((epsilon^2 + 4 * (r / r_0) * (sin(delta_nu / 2))^2 * ((l - x_f(i)) / (l + x_f(i)))^2) / (epsilon^2 + 4 * (r / r_0) * (sin(delta_nu / 2))^2));
    p(i) = (4 * r_0p^2 * r_0 * r * y_f(i)^2 * (1 + x_f(i))^2 * (sin(delta_nu / 2))^2) / (mu * delta_t^2);
    if a(i) > 0

        f = 1 - (r / p(i)) * (1 - cos_delta_nu);
        g = (r * r_0 * sin_delta_nu) / sqrt(mu * p(i));
        g_dot = 1 - (r_0 / p(i)) * (1 - cos_delta_nu);

    else

        alpha_h = 2 * asinh(sqrt(s / (-2 * a(i))));
        beta_h = 2 * asinh(sqrt((s - c) / (-2 * a(i))));

        delta_H = alpha_h - beta_h;

        f = 1 - a(i) * (1 - cosh(delta_H)) / r;
        g = delta_t - sqrt(-a(i)^3 / mu) * (sinh(delta_H) - delta_H);
        g_dot = 1 - a(i) * (1 - cosh(delta_H)) / r;

    end

    v_0_vec(i,:) = (1 / g) .* (r_vec - f .* r_0_vec);
    v_vec(i,:) = (1 / g) .* (g_dot .* r_vec - r_0_vec);

end

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

function [y] = cubic_solv(c1, c2, c3)

P = c2 - c1^2 / 3;
Q = c3 + (2 * c1^3 - 9 * c1 * c2) / 27;
D = Q^2 / 4 + P^3 / 27;

T = (-Q / 2 + sqrt(D))^(1/3) + (-Q/2 - sqrt(D))^(1/3);
y = T - c1 / 3;

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

function [x_new, y] = original_sub(x_old, l, m, N)

E = 2 * atan(sqrt(x_old));
c = -m * (N * pi + E - sin(E)) / (4 * (tan(E / 2))^3);
y = cubic_solv(-1, 0, c);
x_new = sqrt(((1 - l) / 2)^2 + (m / y^2)) - ((1 + l) / 2);

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

function [x_new, y] = reverse_sub(x_old, l, m, N)

y = sqrt(m / ((l + x_old) * (1 + x_old)));
E_0 = 2 * atan(sqrt(x_old));
E = y2E(E_0, y, m, N);
x_new = (tan(E / 2))^2;

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

function [E] = y2E(E_0, y, m, N)

tol = 1e-6;
iter_max = 200;

q = 4 * (y^3 - y^2) / m;
h = (N * pi + E_0 - sin(E_0)) / (tan(E_0 / 2))^3 - q;

if h < 0

    loop_flag_h = 1;
    i_iter_h = 1;
    while loop_flag_h == 1

        E_0 = E_0 / 2;
        h = (N * pi + E_0 - sin(E_0)) / (tan(E_0 / 2))^3 - q;

        if h >= 0

            loop_flag_h = 0;

        elseif i_iter_h < iter_max

            i_iter_h = i_iter_h + 1;

        else

            loop_flag_h = 0;
            E_0 = NaN;

        end

    end

end

i_iter_E = 1;
loop_flag_E = 1;
while loop_flag_E == 1

    h = (N * pi + E_0 - sin(E_0)) / (tan(E_0 / 2))^3 - q;
    h_prime = (-3 * (cos(E_0 / 2))^2) * (N * pi + E_0 - sin(E_0)) / (2 * (sin(E_0 / 2))^4) + (1 - cos(E_0)) / (tan(E_0 / 2))^3;
    E = E_0 - h / h_prime;

    if abs(E - E_0) < tol

        loop_flag_E = 0;

    elseif i_iter_E < iter_max

        i_iter_E = i_iter_E + 1;
        E_0 = E;

    else

        loop_flag_E = 0;
        E = NaN;

    end

end


function [ n_data, x, fx ] = struve_h0_values ( n_data )

%*****************************************************************************80
%
%% STRUVE_H0_VALUES returns some values of the Struve H0 function.
%
%  Discussion:
%
%    The function is defined by:
%
%      HO(x) = 2/pi * Integral ( 0 <= t <= pi/2 ) sin ( x * cos ( t ) ) dt
%
%    In Mathematica, the function can be evaluated by:
%
%      StruveH[0,x]
%
%    The data was reported by McLeod.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Milton Abramowitz and Irene Stegun,
%    Handbook of Mathematical Functions,
%    US Department of Commerce, 1964.
%
%    Allan McLeod,
%    Algorithm 757, MISCFUN: A software package to compute uncommon
%    special functions,
%    ACM Transactions on Mathematical Software,
%    Volume 22, Number 3, September 1996, pages 288-301.
%
%    Stephen Wolfram,
%    The Mathematica Book,
%    Fourth Edition,
%    Wolfram Media / Cambridge University Press, 1999.
%
%  Parameters:
%
%    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
%    first call.  On each call, the routine increments N_DATA by 1, and
%    returns the corresponding data; when there is no more data, the
%    output value of N_DATA will be 0 again.
%
%    Output, real X, the argument of the function.
%
%    Output, real FX, the value of the function.
%
  n_max = 20;

  fx_vec = [ ...
      0.12433974658847434366E-02, ...
     -0.49735582423748415045E-02, ...
      0.39771469054536941564E-01, ...
     -0.15805246001653314198E+00, ...
      0.56865662704828795099E+00, ...
      0.66598399314899916605E+00, ...
      0.79085884950809589255E+00, ...
     -0.13501457342248639716E+00, ...
      0.20086479668164503137E+00, ...
     -0.11142097800261991552E+00, ...
     -0.17026804865989885869E+00, ...
     -0.13544931808186467594E+00, ...
      0.94393698081323450897E-01, ...
     -0.10182482016001510271E+00, ...
      0.96098421554162110012E-01, ...
     -0.85337674826118998952E-01, ...
     -0.76882290637052720045E-01, ...
      0.47663833591418256339E-01, ...
     -0.70878751689647343204E-01, ...
      0.65752908073352785368E-01 ];

  x_vec = [ ...
        0.0019531250E+00, ...
       -0.0078125000E+00, ...
        0.0625000000E+00, ...
       -0.2500000000E+00, ...
        1.0000000000E+00, ...
        1.2500000000E+00, ...
        2.0000000000E+00, ...
       -4.0000000000E+00, ...
        7.5000000000E+00, ...
       11.0000000000E+00, ...
       11.5000000000E+00, ...
      -16.0000000000E+00, ...
       20.0000000000E+00, ...
       25.0000000000E+00, ...
      -30.0000000000E+00, ...
       50.0000000000E+00, ...
       75.0000000000E+00, ...
      -80.0000000000E+00, ...
      100.0000000000E+00, ...
     -125.0000000000E+00 ];

  if ( n_data < 0 )
    n_data = 0;
  end

  n_data = n_data + 1;

  if ( n_max < n_data )
    n_data = 0;
    x = 0.0;
    fx = 0.0;
  else
    x = x_vec(n_data);
    fx = fx_vec(n_data);
  end

  return
end


function W = threshold_proportional(W, p)
%THRESHOLD_PROPORTIONAL     Proportional thresholding
%
%   W_thr = threshold_proportional(W, p);
%
%   This function "thresholds" the connectivity matrix by preserving a
%   proportion p (0<p<1) of the strongest weights. All other weights, and
%   all weights on the main diagonal (self-self connections) are set to 0.
%
%   Inputs: W,      weighted or binary connectivity matrix
%           p,      proportion of weights to preserve
%                       range:  p=1 (all weights preserved) to
%                               p=0 (no weights preserved)
%
%   Output: W_thr,  thresholded connectivity matrix
%
%
%   Mika Rubinov, U Cambridge,
%   Roan LaPlante, Martinos Center, MGH
%   Zitong Zhang, Penn Engineering

%   Modification history:
%   2010: Original (MR)
%   2012: Bug fix for symmetric matrices (RLP)
%   2015: Improved symmetricity test (ZZ)

n=size(W,1);                                %number of nodes
W(1:n+1:end)=0;                             %clear diagonal

if max(max(abs(W-W.'))) < 1e-10             %if symmetric matrix
    W=triu(W);                              %ensure symmetry is preserved
    ud=2;                                   %halve number of removed links
else
    ud=1;
end

ind=find(W);                                %find all links
E=sortrows([ind W(ind)], -2);               %sort by magnitude
en=round((n^2-n)*p/ud);                     %number of links to be preserved

W(E(en+1:end,1))=0;                         %apply threshold

if ud==2                                    %if symmetric matrix
    W=W+W.';                                %reconstruct symmetry
end


function X = interaction(Xa,Xb)
% Create all interaction terms from two dummy coded design matrices.
% (See Box II in Rouder et al. 2012)
%
% INPUT
% Xa, Xb = [nrObservations nrA] and [nrObservations nrB]
%           design matrices with matching number of observation (rows)
% OUTPUT
% X = Dummy coded design matrix [nrObservations nrA*nrB]
%
nA = size(Xa,2);
nB = size(Xb,2);
Xa = repmat(Xa,[1 nB]);
Xb = repmat(Xb,[1 nA]);
ix = (repmat(1:nA:nA*nB,[nA 1]) + repmat((0:nA-1)',[1 nB]))';
Xa = Xa(:,ix(:));
X= Xa.*Xb;

end


function [ x, error_norm, iter, flag ] = qmr ( A, x, b, M, max_it, tol )

%*****************************************************************************80
%
%% QMR usess the Quasi Minimal Residual Method with no preconditioning.
%
%  Modified:
%
%    27 March 2006
%
%  Reference:
%
%    Richard Barrett, Michael Berry, Tony Chan, James Demmel,
%      June Donato, Jack Dongarra, Victor Eijkhout, Roidan Pozo,
%      Charles Romine, Henk van der Vorst
%    Templates for the Solution of Linear Systems: Building Blocks for
%      Iterative Methods,
%    SIAM Publications, 1993.
%
%  Parameters:
%
%    Input, real A(N,N), the symmetric positive definite matrix.
%
%    Input, real X(N), the initial guess vector.
%
%    Input, real B(N), the right hand side vector.
%
%    Input, real M(N,N), the preconditioning matrix.  M is not used
%    by this routine, and it is included just so that the calling
%    sequence is similar to the other routines.
%
%    Input, integer MAX_IT, the maximum number of iterations.
%
%    Input, real TOL, an error tolerance.
%
%    Output, real X(N), the solution.
%
%    Output, real ERROR_NORM, the norm of the error.
%
%    Output, integer ITER, the number of iterations performed.
%
%    Output, integer FLAG, the return flag.
%    0 = the solution was found to within the specified tolerance.
%    1 = a satisfactory solution was not found.  The iteration limit
%        was exceeded.
%    -1 = breakdown caused by RHO;
%    -2 = breakdown caused by BETA;
%    -3 = breakdown caused by GAMMA;
%    -4 = breakdown caused by DELTA;
%    -5 = breakdown caused by EP;
%    -6 = breakdown caused by XI;
%
  iter = 0;

  bnrm2 = norm ( b );
  if ( bnrm2 == 0.0 )
    bnrm2 = 1.0;
  end

  r = b - A * x;
  error_norm = norm ( r ) / bnrm2;
  errorhist = [ ];
  errorhist(1) = error_norm;

  if ( error_norm < tol )
    flag = 0;
    return
  end

  flag = 1;

  v_tld = r;
  y = v_tld;
  rho = norm ( y );

  w_tld = r;
  z = w_tld;
  xi = norm ( z );

  gamma = 1.0;
  eta = -1.0;
  theta =  0.0;

  for iter = 1 : max_it

    if ( rho == 0.0 )
      flag = -1;
      break
    end

    if ( xi == 0.0 )
      flag = -6;
      break
    end

    v = v_tld / rho;
    y = y / rho;

    w = w_tld / xi;
    z = z / xi;

    delta = z' * y;

    if ( delta == 0.0 )
      flag = -4;
      break
    end

    y_tld = y;
    z_tld = z;
%
%  Compute the direction vector.
%
    if ( 1 < iter )
      p = y_tld - ( xi * delta / ep ) * p;
      q = z_tld - ( rho * delta / ep ) * q;
    else
      p = y_tld;
      q = z_tld;
    end

    p_tld = A * p;
    ep = q' * p_tld;

    if ( ep == 0.0 )
      flag = -5;
      break
    end

    beta = ep / delta;

    if ( beta == 0.0 )
      flag = -2;
      break
    end

    v_tld = p_tld - beta * v;
    y = v_tld;
    rho_1 = rho;
    rho = norm ( y );

    w_tld = ( A' * q ) - ( beta * w );
    z = w_tld;
    xi = norm ( z );
    gamma_1 = gamma;
    theta_1 = theta;

    theta = rho / ( gamma_1 * beta );
    gamma = 1.0 / sqrt ( 1.0 + theta^2 );

    if ( gamma == 0.0 )
      flag = -3;
      break
    end

    eta = -eta * rho_1 * gamma^2 / ( beta * gamma_1^2 );

    if ( 1 < iter )
      d = eta * p + ( ( theta_1 * gamma )^2 ) * d;
      s = eta * p_tld + ( ( theta_1 * gamma )^2 ) * s;
    else
      d = eta * p;
      s = eta * p_tld;
    end
%
%  Update the approximate solution.
%
    x = x + d;
    r = r - s;

    error_norm = norm ( r ) / bnrm2;
    errorhist(iter+1) = error_norm;

    if ( error_norm <= tol )
      flag = 0;
      break
    end

  end

  error_norm = errorhist;

  return
end


function [ grid_weight, grid_point ] = sparse_grid_own ( dim_num, ...
  level_max, rule, point_num )

%*****************************************************************************80
%
%% SPARSE_GRID_OWN computes a sparse grid based on an OWN 1D rule.
%
%  Discussion:
%
%    The 1D quadrature rule is assumed to be Open Weakly Nested.
%    Such rules include Gauss Hermite and Gauss Legendre rules.
%
%    A Smolyak construction is used to create a multidimensional sparse grid.
%
%    The user specifies:
%    * the spatial dimension of the quadrature region,
%    * the level that defines the Smolyak grid,
%    * the rule;
%    * the number of points.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 July 2008
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer LEVEL_MAX, controls the size of the
%    sparse grid.
%
%    Input, integer RULE, the index of the rule.
%    1, "CC", Clenshaw Curtis Closed Fully Nested rule.
%    2, "F1", Fejer 1 Open Fully Nested rule.
%    3, "F2", Fejer 2 Open Fully Nested rule.
%    4, "GP", Gauss Patterson Open Fully Nested rule.
%    5, "GL", Gauss Legendre Open Weakly Nested rule.
%    6, "GH", Gauss Hermite Open Weakly Nested rule.
%    7, "LG", Gauss Laguerre Open Non Nested rule.
%
%    Input, integer POINT_NUM, the number of points in the grid,
%    as determined by LEVELS_INDEX_SIZE_OWN.
%
%    Output, real GRID_WEIGHT(POINT_NUM), the weights.
%
%    Output, real GRID_POINT(DIM_NUM,POINT_NUM), the points.
%
  grid_weight(1:point_num) = 0.0;
  grid_point = zeros ( dim_num, point_num );
%
%  The outer loop generates LEVELs from LEVEL_MIN to LEVEL_MAX.
%
  point_num2 = 0;

  level_min = max ( 0, level_max + 1 - dim_num );

  if ( dim_num == 1 )
    level_min2 = level_min;
  else
    level_min2 = 0;
  end

  for level = level_min2 : level_max
%
%  The middle loop generates the next partition LEVEL_1D(1:DIM_NUM)
%  that adds up to LEVEL.
%
    level_1d = [];
    more = 0;
    h = 0;
    t = 0;

    while ( 1 )

      [ level_1d, more, h, t ] = comp_next ( level, dim_num, level_1d, more, h, t );
%
%  Transform each 1D level to a corresponding 1D order.
%  The relationship is the same as for other OPEN rules.
%  The GL rule differs from the other OPEN rules only in the nesting behavior.
%
      order_1d = level_to_order_open ( dim_num, level_1d );

      grid_base2(1:dim_num) = round ( ( order_1d(1:dim_num) - 1 ) / 2 );
%
%  The product of the 1D orders gives us the number of points in this subgrid.
%
      order_nd = prod ( order_1d(1:dim_num) );
%
%  Compute the weights for this product grid.
%
      grid_weight2 = product_weights ( dim_num, order_1d, order_nd, rule );
%
%  Now determine the coefficient of the weight.
%
      coeff = r8_mop ( level_max - level ) ...
        * r8_choose ( dim_num - 1, level_max - level );
%
%  The inner (hidden) loop generates all points corresponding to given grid.
%  The grid indices will be between -M to +M, where 2*M + 1 = ORDER_1D(DIM).
%
      grid_index2 = multigrid_index_own ( dim_num, order_1d, order_nd );
%
%  Determine the first level of appearance of each of the points.
%  This allows us to flag certain points as being repeats of points
%  generated on a grid of lower level.
%
%  This is SLIGHTLY tricky.
%
      grid_level = index_level_own ( level, level_max, dim_num, order_nd, ...
        grid_index2, grid_base2 );
%
%  Only keep those points which first appear on this level.
%
      for point = 1 : order_nd
%
%  Either a "new" point (increase count, create point, create weight)
%
        if ( grid_level(point) == level )

          point_num2 = point_num2 + 1;

          if ( point_num < point_num2 )
            fprintf ( 1, '\n' );
            fprintf ( 1, 'SPARSE_GRID_OWN - Fatal error!\n' );
            fprintf ( 1, ...
            '  Exceeding maximum point index POINT_NUM = %d\n', point_num );
            error ( 'SPARSE_GRID_OWN - Fatal error!' );
          end

          if ( rule == 5 )
            grid_point(1:dim_num,point_num2) = gl_abscissa ( dim_num, 1, ...
              grid_index2(1:dim_num,point), grid_base2(1:dim_num) );
          elseif ( rule == 6 )
            grid_point(1:dim_num,point_num2) = gh_abscissa ( dim_num, 1, ...
              grid_index2(1:dim_num,point), grid_base2(1:dim_num) );
          else
            fprintf ( 1, '\n' );
            fprintf ( 1, 'SPARSE_GRID_OWN - Fatal error!\n' );
            fprintf ( 1, '  Unrecognized rule number = %d\n', rule );
            error ( 'SPARSE_GRID_OWN - Fatal error!' );
          end

          if ( level_min <= level )
            grid_weight(point_num2) = coeff * grid_weight2(point);
          end
%
%  or an already existing point (create point temporarily, find match,
%  add weight to matched point's weight).
%
        else

          if ( level_min <= level )

            if ( rule == 5 )
              grid_point_temp(1:dim_num) = gl_abscissa ( dim_num, 1, ...
                grid_index2(1:dim_num,point), grid_base2(1:dim_num) );
            elseif ( rule == 6 )
              grid_point_temp(1:dim_num) = gh_abscissa ( dim_num, 1, ...
                grid_index2(1:dim_num,point), grid_base2(1:dim_num) );
            else
              fprintf ( 1, '\n' );
              fprintf ( 1, 'SPARSE_GRID_OWN - Fatal error!\n' );
              fprintf ( 1, '  Unrecognized rule number = %d\n', rule );
              error ( 'SPARSE_GRID_OWN - Fatal error!' );
            end

            point3 = -1;

            for point2 = 1 : point_num2
              if ( all ( grid_point(1:dim_num,point2) == grid_point_temp(1:dim_num)' ) )
                point3 = point2;
                break
              end
            end

            if ( point3 == -1 )
              fprintf ( 1, '\n' );
              fprintf ( 1, 'SPARSE_GRID_OWN - Fatal error!\n' );
              fprintf ( 1, '  Could not match point.\n' );
              error ( 'SPARSE_GRID_OWN - Fatal error!' );
            end

            grid_weight(point3) = grid_weight(point3) ...
              + coeff * grid_weight2(point);

          end

        end

      end

      if ( ~more )
        break
      end

    end

  end

  if ( point_num2 < point_num )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'SPARSE_GRID_OWN - Fatal error!\n' );
    fprintf ( 1,'  Set fewer points than POINT_NUM = %d\n', point_num );
    error ( 'SPARSE_GRID_OWN - Fatal error!' );
  end

  return
end


function [out] = recharge_6(p1,p2,S,dt)
%recharge_6

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

% Flux function
% ------------------
% Description:  Recharge to fulfil evaporation demand if the receiving
%               store is below a threshold
% Constraints:  f <= S/dt
%               S >= 0      prevents complex numbers
% @(Inputs):    p1   - time coefficient [d-1]
%               p2   - non-linear scaling [mm]
%               S    - current storage [mm]
%               dt   - time step size [d]

out = min(max(S/dt,0),p1.*max(S,0).^p2);

end


%% Analyzing Neural Time Series Data
% Matlab code for Chapter 34
% 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.

%% load sample data

load sampleEEGdata

% note: Most of these figures take a while to generate. Have patience!

%% extract TF power (create data that are used for the rest of this chapter)

% definitions, selections...
chan2use = 'fcz';

min_freq = 3;
max_freq = 30;
num_frex = 20;

% define wavelet parameters
time = -1:1/EEG.srate:1;
frex = logspace(log10(min_freq),log10(max_freq),num_frex);
s    = logspace(log10(3),log10(10),num_frex)./(2*pi*frex);

% definte convolution parameters
n_wavelet            = length(time);
n_data               = EEG.pnts*EEG.trials;
n_convolution        = n_wavelet+n_data-1;
n_conv_pow2          = pow2(nextpow2(n_convolution));
half_of_wavelet_size = (n_wavelet-1)/2;

% note that you don't need the wavelet itself, you need the FFT of the wavelet
wavelets = zeros(num_frex,n_conv_pow2);
for fi = 1:num_frex
    wavelets(fi,:)  = fft( sqrt(1/(s(fi)*sqrt(pi))) * exp(2*1i*pi*frex(fi).*time) .* exp(-time.^2./(2*(s(fi)^2))) , n_conv_pow2 );
end

% get FFT of data
eegfft = fft(reshape(EEG.data(strcmpi(chan2use,{EEG.chanlocs.labels}),:,:),1,EEG.pnts*EEG.trials),n_conv_pow2);

% initialize
eegpower = zeros(num_frex,EEG.pnts,EEG.trials); % frequencies X time X trials
eegphase = zeros(num_frex,EEG.pnts,EEG.trials); % frequencies X time X trials

% loop through frequencies and compute synchronization
for fi=1:num_frex

    % convolution
    eegconv = ifft(wavelets(fi,:).*eegfft);
    eegconv = eegconv(1:n_convolution);
    eegconv = eegconv(half_of_wavelet_size+1:end-half_of_wavelet_size);

    % reshape to time X trials
    eegpower(fi,:,:) = abs(reshape(eegconv,EEG.pnts,EEG.trials)).^2;
    eegphase(fi,:,:) = exp(1i*angle(reshape(eegconv,EEG.pnts,EEG.trials)));
end

% remove edge artifacts
time_s = dsearchn(EEG.times',-500);
time_e = dsearchn(EEG.times',1200);

eegpower = eegpower(:,time_s:time_e,:);
tftimes  = EEG.times(time_s:time_e);
nTimepoints = numel(tftimes);

%% Figure 34.1

voxel_pval   = 0.01;
cluster_pval = 0.05;

% note: try to use 1000 or more permutations for real data
n_permutes = 1000;

baseidx(1) = dsearchn(tftimes',-500);
baseidx(2) = dsearchn(tftimes',-100);

% compute actual t-test of difference
realbaselines = squeeze(mean(eegpower(:,baseidx(1):baseidx(2),:),2));
realmean      = 10*log10(bsxfun(@rdivide, mean(eegpower,3), mean(realbaselines,2)));

% initialize null hypothesis matrices
permuted_maxvals = zeros(n_permutes,2,num_frex);
permuted_vals    = zeros(n_permutes,num_frex,numel(tftimes));
max_clust_info   = zeros(n_permutes,1);

for permi=1:n_permutes
    cutpoint = randsample(2:nTimepoints-diff(baseidx)-2,1);
    permuted_vals(permi,:,:) = 10*log10(bsxfun(@rdivide,mean(eegpower(:,[cutpoint:end 1:cutpoint-1],:),3),mean(realbaselines,2)) );
    % btw, using bsxfun instead of repmat increases the speed
    % of this loop by a factor of ~5.
end

zmap = (realmean-squeeze(mean(permuted_vals))) ./ squeeze(std(permuted_vals));
threshmean = realmean;
threshmean(abs(zmap)<norminv(1-voxel_pval))=0;

figure
subplot(221)
contourf(tftimes,frex,realmean,40,'linecolor','none')
axis square
set(gca,'clim',[-3 3],'xlim',[-500 1200])
title('power map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

subplot(222)
contourf(tftimes,frex,zmap,40,'linecolor','none')
axis square
set(gca,'clim',[-3 3],'xlim',[-500 1200])
title('unthresholded Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

subplot(223)
contourf(tftimes,frex,threshmean,40,'linecolor','none')
axis square
set(gca,'clim',[-3 3],'xlim',[-500 1200])
title('Uncorrected power map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

% this time, the cluster correction will be done on the permuted data, thus
% making no assumptions about parameters for p-values
for permi = 1:n_permutes

    % for cluster correction, apply uncorrected threshold and get maximum cluster sizes
    fakecorrsz = squeeze((permuted_vals(permi,:,:)-mean(permuted_vals,1)) ./ std(permuted_vals,[],1) );
    fakecorrsz(abs(fakecorrsz)<norminv(1-voxel_pval))=0;

    % get number of elements in largest supra-threshold cluster
    clustinfo = bwconncomp(fakecorrsz);
    max_clust_info(permi) = max([ 0 cellfun(@numel,clustinfo.PixelIdxList) ]); % the zero accounts for empty maps
    % using cellfun here eliminates the need for a slower loop over cells
end

% apply cluster-level corrected threshold
zmapthresh = zmap;
% uncorrected pixel-level threshold
zmapthresh(abs(zmapthresh)<norminv(1-voxel_pval))=0;
% find islands and remove those smaller than cluster size threshold
clustinfo = bwconncomp(zmapthresh);
clust_info = cellfun(@numel,clustinfo.PixelIdxList);
clust_threshold = prctile(max_clust_info,100-cluster_pval*100);

% identify clusters to remove
whichclusters2remove = find(clust_info<clust_threshold);

% remove clusters
for i=1:length(whichclusters2remove)
    zmapthresh(clustinfo.PixelIdxList{whichclusters2remove(i)})=0;
end

subplot(224)
contourf(tftimes,frex,zmapthresh,40,'linecolor','none')
axis square
set(gca,'clim',[-3 3],'xlim',[-500 1200])
title('Cluster-corrected Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

%% Figure 34.3

voxel_pval = 0.05;
mcc_voxel_pval = 0.05; % mcc = multiple comparisons correction
mcc_cluster_pval = 0.05;

% note: try to use 1000 or more permutations for real data
n_permutes = 1000;

real_condition_mapping = [ -ones(1,floor(EEG.trials/2)) ones(1,ceil(EEG.trials/2)) ];

% compute actual t-test of difference (using unequal N and std)
tnum   = squeeze(mean(eegpower(:,:,real_condition_mapping==-1),3) - mean(eegpower(:,:,real_condition_mapping==1),3));
tdenom = sqrt( (std(eegpower(:,:,real_condition_mapping==-1),0,3).^2)./sum(real_condition_mapping==-1) + (std(eegpower(:,:,real_condition_mapping==1),0,3).^2)./sum(real_condition_mapping==1) );
real_t = tnum./tdenom;

% initialize null hypothesis matrices
permuted_tvals  = zeros(n_permutes,num_frex,nTimepoints);
max_pixel_pvals = zeros(n_permutes,2);
max_clust_info  = zeros(n_permutes,1);

% generate pixel-specific null hypothesis parameter distributions
for permi = 1:n_permutes
    fake_condition_mapping = sign(randn(EEG.trials,1));

    % compute t-map of null hypothesis
    tnum   = squeeze(mean(eegpower(:,:,fake_condition_mapping==-1),3)-mean(eegpower(:,:,fake_condition_mapping==1),3));
    tdenom = sqrt( (std(eegpower(:,:,fake_condition_mapping==-1),0,3).^2)./sum(fake_condition_mapping==-1) + (std(eegpower(:,:,fake_condition_mapping==1),0,3).^2)./sum(fake_condition_mapping==1) );
    tmap   = tnum./tdenom;

    % save all permuted values
    permuted_tvals(permi,:,:) = tmap;

    % save maximum pixel values
    max_pixel_pvals(permi,:) = [ min(tmap(:)) max(tmap(:)) ];

    % for cluster correction, apply uncorrected threshold and get maximum cluster sizes
    % note that here, clusters were obtained by parametrically thresholding
    % the t-maps
    tmap(abs(tmap)<tinv(1-voxel_pval,EEG.trials-1))=0;

    % get number of elements in largest supra-threshold cluster
    clustinfo = bwconncomp(tmap);
    max_clust_info(permi) = max([ 0 cellfun(@numel,clustinfo.PixelIdxList) ]); % notes: cellfun is superfast, and the zero accounts for empty maps
end

% now compute Z-map
zmap = (real_t-squeeze(mean(permuted_tvals,1)))./squeeze(std(permuted_tvals));

figure
subplot(221)
contourf(tftimes,frex,zmap,40,'linecolor','none')
axis square
set(gca,'clim',[-3 3],'xlim',[-500 1200])
title('Unthresholded Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

% apply uncorrected threshold
subplot(222)
contourf(tftimes,frex,zmap,40,'linecolor','none')
zmapthresh = zmap;
zmapthresh(abs(zmapthresh)<norminv(1-voxel_pval))=false;
zmapthresh=logical(zmapthresh);
hold on
contour(tftimes,frex,zmapthresh,1,'linecolor','k')

axis square
set(gca,'clim',[-3 3],'xlim',[-500 1200])
title('Unthresholded Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

% apply pixel-level corrected threshold
lower_threshold = prctile(max_pixel_pvals(:,1),    mcc_voxel_pval*100/2);
upper_threshold = prctile(max_pixel_pvals(:,2),100-mcc_voxel_pval*100/2);

zmapthresh = zmap;
zmapthresh(zmapthresh>lower_threshold & zmapthresh<upper_threshold)=0;
subplot(223)
contourf(tftimes,frex,zmapthresh,40,'linecolor','none')
axis square
set(gca,'clim',[-3 3],'xlim',[-500 1200])
title('Pixel-corrected Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

% apply cluster-level corrected threshold
zmapthresh = zmap;
% uncorrected pixel-level threshold
zmapthresh(abs(zmapthresh)<norminv(1-voxel_pval))=0;
% find islands and remove those smaller than cluster size threshold
clustinfo = bwconncomp(zmapthresh);
clust_info = cellfun(@numel,clustinfo.PixelIdxList);
clust_threshold = prctile(max_clust_info,100-mcc_cluster_pval*100);

% identify clusters to remove
whichclusters2remove = find(clust_info<clust_threshold);

% remove clusters
for i=1:length(whichclusters2remove)
    zmapthresh(clustinfo.PixelIdxList{whichclusters2remove(i)})=0;
end

subplot(224)
contourf(tftimes,frex,zmapthresh,40,'linecolor','none')
axis square
set(gca,'clim',[-3 3],'xlim',[-500 1200])
title('Cluster-corrected Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

%% Figure 34.4

voxel_pval = 0.01;
mcc_voxel_pval = 0.05; % mcc = multiple comparisons correction
mcc_cluster_pval = 0.05;

% note: try to use 1000 or more permutations for real data
n_permutes = 1000;

rts=zeros(1,EEG.trials);
for ei=1:EEG.trials
    % In this task, the button press always followed the stimulus at
    % time=0. Thus, finding the RT involves finding the latency of the
    % event that occurs after the time=0 event.
    % If you follow a procedure like this in your data, you may need to
    % include special exceptions, e.g., if there was no response or if
    % a non-response marker could have occurred between stimulus and response.
    time0event = find(cell2mat(EEG.epoch(ei).eventlatency)==0);
    rts(ei)    = EEG.epoch(ei).eventlatency{time0event+1};
end

% rank-transform RTs
rtsrank = tiedrank(rts);

% rank-transform power data (must be transformed)
eegpowerreshaped = reshape(eegpower,num_frex*nTimepoints,EEG.trials)';
eegpowerrank = tiedrank(eegpowerreshaped);

% technically, you want to perform a correlation, but a linear least-squares fit provides the same conceptual results
% while being ~15 times faster, and we don't care here about the actual scale of the data. For completeness,
% the following line shows you how to compute the Spearman correlation coefficient
% realcorrs = 1-6*sum((eegpowerrank-repmat(rtsrank',1,size(eegpowerrank,2))).^2)/(EEG.trials*(EEG.trials^2-1));
realcorrs = (rtsrank*rtsrank')\rtsrank*eegpowerrank;
realcorrs = reshape(realcorrs,num_frex,nTimepoints);

% initialize null hypothesis matrices
permuted_rvals  = zeros(n_permutes,num_frex,nTimepoints);
max_pixel_rvals = zeros(n_permutes,2);
max_clust_info  = zeros(n_permutes,1);

% generate pixel-specific null hypothesis parameter distributions
for permi = 1:n_permutes
    fake_rt_mapping = rtsrank(randperm(EEG.trials));

    % compute t-map of null hypothesis
    fakecorrs = (fake_rt_mapping*fake_rt_mapping')\fake_rt_mapping*eegpowerrank;

    % reshape to 2D map for cluster-correction
    fakecorrs = reshape(fakecorrs,num_frex,nTimepoints);

    % save all permuted values
    permuted_rvals(permi,:,:) = fakecorrs;

    % save maximum pixel values
    max_pixel_rvals(permi,:) = [ min(fakecorrs(:)) max(fakecorrs(:)) ];
end

% this time, the cluster correction will be done on the permuted data, thus
% making no assumptions about parameters for p-values
for permi = 1:n_permutes

    % indices of permutations to include in thresholding at this iteration
    perms2use4distribution = true(1,n_permutes);
    perms2use4distribution(permi) = 0;

    % for cluster correction, apply uncorrected threshold and get maximum cluster sizes
    fakecorrsz = squeeze((permuted_rvals(permi,:,:)-mean(permuted_rvals(perms2use4distribution,:,:),1)) ./ std(permuted_rvals(perms2use4distribution,:,:),[],1) );
    fakecorrsz(abs(fakecorrsz)<norminv(1-voxel_pval))=0;

    % get number of elements in largest supra-threshold cluster
    clustinfo = bwconncomp(fakecorrsz);
    max_clust_info(permi) = max([ 0 cellfun(@numel,clustinfo.PixelIdxList) ]); % the zero accounts for empty maps
end

% now compute Z-map
zmap = (realcorrs-squeeze(mean(permuted_rvals,1)))./squeeze(std(permuted_rvals));

figure
subplot(221)
contourf(tftimes,frex,zmap,40,'linecolor','none')
axis square
set(gca,'clim',[-4 4],'xlim',[-500 1200])
title('Unthresholded Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

% apply uncorrected threshold
zmapthresh = zmap;
zmapthresh(abs(zmapthresh)<norminv(1-voxel_pval))=0;
zmapthresh=logical(zmapthresh);
subplot(222)
contourf(tftimes,frex,zmap,40,'linecolor','none')
hold on
contour(tftimes,frex,zmapthresh,1,'linecolor','k')
axis square
set(gca,'clim',[-4 4],'xlim',[-500 1200])
title('Uncorrected thresholded Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

% apply pixel-level corrected threshold
lower_threshold = prctile(max_pixel_rvals(:,1),    mcc_voxel_pval*100/2);
upper_threshold = prctile(max_pixel_rvals(:,2),100-mcc_voxel_pval*100/2);

zmapthresh = zmap;
zmapthresh(realcorrs>lower_threshold & realcorrs<upper_threshold)=0;
subplot(223)
contourf(tftimes,frex,zmapthresh,40,'linecolor','none')
axis square
set(gca,'clim',[-4 4],'xlim',[-500 1200])
title('Pixel-corrected Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

% apply cluster-level corrected threshold
zmapthresh = zmap;
% uncorrected pixel-level threshold
zmapthresh(abs(zmapthresh)<norminv(1-voxel_pval))=0;
% find islands and remove those smaller than cluster size threshold
clustinfo = bwconncomp(zmapthresh);
clust_info = cellfun(@numel,clustinfo.PixelIdxList);
clust_threshold = prctile(max_clust_info,100-mcc_cluster_pval*100);

% identify clusters to remove
whichclusters2remove = find(clust_info<clust_threshold);

% remove clusters
for i=1:length(whichclusters2remove)
    zmapthresh(clustinfo.PixelIdxList{whichclusters2remove(i)})=0;
end

subplot(224)
contourf(tftimes,frex,zmapthresh,40,'linecolor','none')
axis square
set(gca,'clim',[-4 4],'xlim',[-500 1200])
title('Cluster-corrected Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

%% Figure 34.5

chan2use = 'o1';
time2use = dsearchn(EEG.times',[0 250]');
freq2use = dsearchn(frex',10);

eegfft = fft(reshape(EEG.data(strcmpi(chan2use,{EEG.chanlocs.labels}),:,:),1,EEG.pnts*EEG.trials),n_conv_pow2);
eegconv = ifft(wavelets(freq2use,:).*eegfft);
eegconv = eegconv(1:n_convolution);
eegconv = eegconv(half_of_wavelet_size+1:end-half_of_wavelet_size);

% reshape to time X trials
temp  = abs(reshape(eegconv,EEG.pnts,EEG.trials)).^2;
o1power = zscore(mean(temp(time2use(1):time2use(2),:),1));

% define covariates (RT and trial number)
X = [ zscore(rts') o1power' ]';
eegpowerrank = tiedrank(eegpowerreshaped)';

figure
subplot(311)
imagesc(X)

subplot(212)
imagesc(eegpowerrank)

%% Figure 34.6

voxel_pval = 0.01;
mcc_cluster_pval = 0.05;

% note: try to use 1000 or more permutations for real data
n_permutes = 1000;

realbeta = (X*X')\X*eegpowerrank';
realbeta = reshape(realbeta,[2 num_frex nTimepoints]);

% initialize null hypothesis matrices
permuted_bvals = zeros(n_permutes,2,num_frex,nTimepoints);
max_clust_info = zeros(n_permutes,2);

% generate pixel-specific null hypothesis parameter distributions
for permi = 1:n_permutes

    % randomly shuffle trial order
    fakeX = X(:,randperm(EEG.trials));

    % compute beta-map of null hypothesis
    fakebeta = (fakeX*fakeX')\fakeX*eegpowerrank';

    % reshape to 2D map for cluster-correction
    fakebeta = reshape(fakebeta,[2 num_frex nTimepoints ]);

    % save all permuted values
    permuted_bvals(permi,:,:,:) = fakebeta;
end

% this time, the cluster correction will be done on the permuted data, thus
% making no assumptions about parameters for p-values
for permi = 1:n_permutes

    for testi=1:2
        % for cluster correction, apply uncorrected threshold and get maximum cluster sizes
        fakecorrsz = squeeze((permuted_bvals(permi,testi,:,:)-mean(permuted_bvals(:,testi,:,:),1)) ./ std(permuted_bvals(:,testi,:,:),[],1) );
        fakecorrsz(abs(fakecorrsz)<norminv(1-voxel_pval))=0;
        % get number of elements in largest supra-threshold cluster
        clustinfo = bwconncomp(fakecorrsz);
        max_clust_info(permi,testi) = max([ 0 cellfun(@numel,clustinfo.PixelIdxList) ]); % the zero accounts for empty maps
    end
end

figure
for testi=1:2

    % now compute Z-map
    zmap = (squeeze(realbeta(testi,:,:))-squeeze(mean(permuted_bvals(:,testi,:,:),1))) ./ squeeze(std(permuted_bvals(:,testi,:,:),[],1));

    subplot(2,3,1+(testi-1)*3)
    contourf(tftimes,frex,zmap,40,'linecolor','none')
    axis square
    set(gca,'clim',[-3 3],'xlim',[-500 1200])
    title('Unthresholded Z map')
    xlabel('Time (ms)'), ylabel('Frequency (Hz)')

    % apply uncorrected threshold
    zmapthresh = zmap;
    zmapthresh(abs(zmapthresh)<norminv(1-voxel_pval))=0;
    subplot(2,3,2+(testi-1)*3)
    contourf(tftimes,frex,zmapthresh,40,'linecolor','none')
    axis square
    set(gca,'clim',[-3 3],'xlim',[-500 1200])
    title('Uncorrected thresholded Z map')
    xlabel('Time (ms)'), ylabel('Frequency (Hz)')

    % apply cluster-level corrected threshold
    zmapthresh = zmap;
    % uncorrected pixel-level threshold
    zmapthresh(abs(zmapthresh)<norminv(1-voxel_pval))=0;
    % find islands and remove those smaller than cluster size threshold
    clustinfo = bwconncomp(zmapthresh);
    clust_info = cellfun(@numel,clustinfo.PixelIdxList);
    clust_threshold = prctile(max_clust_info(:,testi),100-mcc_cluster_pval*100);

    % identify clusters to remove
    whichclusters2remove = find(clust_info<clust_threshold);

    % remove clusters
    for i=1:length(whichclusters2remove)
        zmapthresh(clustinfo.PixelIdxList{whichclusters2remove(i)})=0;
    end

    subplot(2,3,3+(testi-1)*3)
    contourf(tftimes,frex,zmapthresh,40,'linecolor','none')
    axis square
    set(gca,'clim',[-3 3],'xlim',[-500 1200])
    title('Cluster-corrected Z map')
    xlabel('Time (ms)'), ylabel('Frequency (Hz)')
end

%% Figure 34.7

a = rand(10000,1);
b = rand(10000,1);

figure
clear h

subplot(221)
[y,x] = hist(a,50);
h(1)=bar(x,y,'histc');
set(gca,'xlim',[-.05 1.05])

subplot(222)
[y,x] = hist(b,50);
h(2)=bar(x,y,'histc');
set(gca,'xlim',[-.05 1.05])

subplot(212)
[y,x] = hist(atanh(a-b),50);
h(3)=bar(x,y,'histc');
set(gca,'xlim',[-2 2])
title('ITPC differences')
xlabel('difference value'), ylabel('Count')

set(h,'linestyle','none','facecolor','k')

%% Figure 34.8

% The code to produce this figure is presented in chapter19.m, between the
% cells for figures 19.6 and 19.7. To generate figure 34.8, you will need to run
% the code for figures 19.2-6.

%% Figure 34.9

voxel_pval   = 0.01;
cluster_pval = 0.05;

% note: try to use 1000 or more permutations for real data
n_permutes = 1000;

% compute actual t-test of difference
realitpc = squeeze(abs(mean(eegphase,3)));

% initialize null hypothesis matrices
permuted_maxvals = zeros(n_permutes,2,num_frex);
permuted_vals    = zeros(n_permutes,num_frex,EEG.pnts);
max_clust_info   = zeros(n_permutes,1);
eegtemp          = zeros(size(realitpc));

for permi=1:n_permutes
    for triali=1:EEG.trials
        cutpoint = randsample(2:nTimepoints-2,1);
        eegtemp(:,:,triali) = eegphase(:,[cutpoint:end 1:cutpoint-1],triali);
    end
    permuted_vals(permi,:,:) = squeeze(abs(mean(eegtemp,3)));

    % note: the following lines produce fairly similar results as the loop above
    % cutpoint = randsample(2:nTimepoints-2,1);
    %permuted_vals(permi,:,:) = squeeze(abs(mean(eegphase(:,[cutpoint:end 1:cutpoint-1],:),3)));
end

zmap = (realitpc-squeeze(mean(permuted_vals))) ./ squeeze(std(permuted_vals));
threshmean = realitpc;
threshmean(abs(zmap)<norminv(1-voxel_pval))=0;

figure
subplot(221)
contourf(EEG.times,frex,realitpc,40,'linecolor','none')
axis square
set(gca,'clim',[0 .5],'xlim',[-200 1000])
title('power map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

subplot(222)
contourf(EEG.times,frex,zmap,40,'linecolor','none')
axis square
set(gca,'clim',[-5 5],'xlim',[-200 1000])
title('unthresholded Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

subplot(223)
contourf(EEG.times,frex,threshmean,40,'linecolor','none')
axis square
set(gca,'clim',[0 .5],'xlim',[-200 1000])
title('Uncorrected power map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

% this time, the cluster correction will be done on the permuted data, thus
% making no assumptions about parameters for p-values
for permi = 1:n_permutes

    % for cluster correction, apply uncorrected threshold and get maximum cluster sizes
    fakecorrsz = squeeze((permuted_vals(permi,:,:)-mean(permuted_vals,1)) ./ std(permuted_vals,[],1) );
    fakecorrsz(abs(fakecorrsz)<norminv(1-voxel_pval))=0;

    % get number of elements in largest supra-threshold cluster
    clustinfo = bwconncomp(fakecorrsz);
    max_clust_info(permi) = max([ 0 cellfun(@numel,clustinfo.PixelIdxList) ]); % the zero accounts for empty maps
    % using cellfun here eliminates the need for a slower loop over cells
end

% apply cluster-level corrected threshold
zmapthresh = realitpc;
% uncorrected pixel-level threshold
zmapthresh(abs(zmap)<norminv(1-voxel_pval))=0;
% find islands and remove those smaller than cluster size threshold
clustinfo = bwconncomp(zmapthresh);
clust_info = cellfun(@numel,clustinfo.PixelIdxList);
clust_threshold = prctile(max_clust_info,100-cluster_pval*100);

% identify clusters to remove
whichclusters2remove = find(clust_info<clust_threshold);

% remove clusters
for i=1:length(whichclusters2remove)
    zmapthresh(clustinfo.PixelIdxList{whichclusters2remove(i)})=0;
end

subplot(224)
contourf(EEG.times,frex,zmapthresh,40,'linecolor','none')
axis square
set(gca,'clim',[0 .5],'xlim',[-200 1000])
title('Cluster-corrected Z map')
xlabel('Time (ms)'), ylabel('Frequency (Hz)')

%% Figure 33.5

% The code for figures 33.5/6 are presented here and in the next cell. You
% will need first to run the code for figure 34.3 to run this code.

% compute actual t-test of difference (using unequal N and std)
tnum   = squeeze(mean(eegpower(4,400,real_condition_mapping==-1),3) - mean(eegpower(4,400,real_condition_mapping==1),3));
tdenom = sqrt( (std(eegpower(4,400,real_condition_mapping==-1),0,3).^2)./sum(real_condition_mapping==-1) + (std(eegpower(4,400,real_condition_mapping==1),0,3).^2)./sum(real_condition_mapping==1) );
real_t = tnum./tdenom;

n_permutes = round(linspace(100,3000,200));
zvals   = zeros(size(n_permutes));

for grandpermi=1:length(n_permutes)

    % initialize null hypothesis matrices
    permuted_tvals  = zeros(n_permutes(grandpermi),1);

    % generate pixel-specific null hypothesis parameter distributions
    for permi = 1:n_permutes(grandpermi)
        fake_condition_mapping = sign(randn(EEG.trials,1));
        % compute t-map of null hypothesis
        tnum   = squeeze(mean(eegpower(4,400,fake_condition_mapping==-1),3)-mean(eegpower(4,400,fake_condition_mapping==1),3));
        tdenom = sqrt( (std(eegpower(4,400,fake_condition_mapping==-1),0,3).^2)./sum(fake_condition_mapping==-1) + (std(eegpower(4,400,fake_condition_mapping==1),0,3).^2)./sum(fake_condition_mapping==1) );
        % save all permuted values
        permuted_tvals(permi) = tnum./tdenom;
    end

    zvals(grandpermi) = (real_t-mean(permuted_tvals))/std(permuted_tvals);

    % display progress
    if mod(grandpermi,20)==0, disp([ 'Metapermutation #' num2str(grandpermi) ]); end
end

figure
subplot(211)
plot(n_permutes,zvals)
xlabel('Number of iterations'), ylabel('Z-value')

subplot(212)
hist(zvals,30)
xlabel('Z-value at different runs of permutation test'), ylabel('Count')

%% Figure 33.6

% compute actual t-test of difference (using unequal N and std)
tnum   = squeeze(mean(eegpower(:,:,real_condition_mapping==-1),3) - mean(eegpower(:,:,real_condition_mapping==1),3));
tdenom = sqrt( (std(eegpower(:,:,real_condition_mapping==-1),0,3).^2)./sum(real_condition_mapping==-1) + (std(eegpower(:,:,real_condition_mapping==1),0,3).^2)./sum(real_condition_mapping==1) );
real_t = tnum./tdenom;

n_permutes = round(linspace(100,3000,200));
zvals = zeros(length(n_permutes),size(tnum,1),size(tnum,2));

for grandpermi=1:length(n_permutes)

    % initialize null hypothesis matrices
    permuted_tvals  = zeros(n_permutes(grandpermi),size(tnum,1),size(tnum,2));

    % generate pixel-specific null hypothesis parameter distributions
    for permi = 1:n_permutes(grandpermi)
        fake_condition_mapping = sign(randn(EEG.trials,1));
        % compute t-map of null hypothesis
        tnum   = squeeze(mean(eegpower(:,:,fake_condition_mapping==-1),3)-mean(eegpower(:,:,fake_condition_mapping==1),3));
        tdenom = sqrt( (std(eegpower(:,:,fake_condition_mapping==-1),0,3).^2)./sum(fake_condition_mapping==-1) + (std(eegpower(:,:,fake_condition_mapping==1),0,3).^2)./sum(fake_condition_mapping==1) );
        % save all permuted values
        permuted_tvals(permi,:,:) = tnum./tdenom;
    end

    zvals(grandpermi,:,:) = (real_t-squeeze(mean(permuted_tvals)))./squeeze(std(permuted_tvals));

    % display progress
    if mod(grandpermi,20)==0, disp([ 'Metapermutation # ' num2str(grandpermi) ]); end
end

figure
subplot(211)
plot(n_permutes,squeeze(zvals(:,4,400)))
subplot(212)
hist(squeeze(zvals(:,4,400)),30)

zvalsall = reshape(zvals,length(n_permutes),size(tnum,1)*size(tnum,2));
figure
plot(mean(zvalsall,1),std(zvalsall,[],1),'.')
set(gca,'xlim',[-3.5 3.5],'ylim',[0 .12])
xlabel('Average Z-statistic')
ylabel('Standard deviation of Z-statistics')

figure
clear h

[~,z0]=min(abs(mean(zvalsall,1)));
[x0,y0]=ind2sub(size(tnum),z0);
[yy,xx]=hist(squeeze(zvals(:,x0,y0)),30);
h(1) = bar(xx,yy,'histc');
hold on
plot([0 0],get(gca,'ylim'),'k:')

[~,z2]=min(abs(mean(zvalsall,1)-2));
[x2,y2]=ind2sub(size(tnum),z2);
[yy,xx]=hist(squeeze(zvals(:,x2,y2)),30);
h(2) = bar(xx,yy,'histc');
plot([2 2],get(gca,'ylim'),'k:')

[~,z3]=min(abs(mean(zvalsall,1)--3));
[x3,y3]=ind2sub(size(tnum),z3);
[yy,xx]=hist(squeeze(zvals(:,x3,y3)),30);
hold on
h(3) = bar(xx,yy,'histc');
plot([-3 -3],get(gca,'ylim'),'k:')

set(h,'linestyle','none')
set(gca,'xlim',[-3.5 3.5])
xlabel('Z-value')
ylabel('Count of possible z-values')

%% end.


% book : Signals and Systems Laboratory with MATLAB
% authors : Alex Palamides & Anastasia Veloni

% Discrete Fourier Transform  properties

% Parseval's Theorem

n=0:10;
x=1./(n+1);
En=sum(abs(x).^2)

N=length(x);
X=dft(x);
Edft=(1/N)*sum(abs(X).^2)


function [ points_lat, points_long ] = gen_hyperbola( doa_meters, rx1_lat, rx1_long, rx2_lat, rx2_long, geo_ref_lat, geo_ref_long)
%gen_hyperbola: calculates the points of a hyperbola from receiver positions
%               and the doa in meters

    % convert to xy coordinates
    [rx1_x, rx1_y] = latlong2xy(rx1_lat, rx1_long, geo_ref_lat, geo_ref_long);
    [rx2_x, rx2_y] = latlong2xy(rx2_lat, rx2_long, geo_ref_lat, geo_ref_long);

    % mit Kosinussatz Dreieck berechnen
    rx_x_dist = rx2_x - rx1_x;
    rx_y_dist = rx2_y - rx1_y;

    dist_12 = abs (rx_x_dist+i*rx_y_dist);  % positions in complex plane
    angle_12 = angle (rx_x_dist+i*rx_y_dist); % -pi to +pi

    hyp_x = zeros(1,1);
    hyp_y = zeros(1,1);

    hyp_x_leg1 = zeros(1,1);
    hyp_y_leg1 = zeros(1,1);
    hyp_x_leg2 = zeros(1,1);
    hyp_y_leg2 = zeros(1,1);
    hyp_point_counter = 0;

    if abs(doa_meters/1000) > dist_12
        disp(['TODA delay (' num2str(doa_meters) ' meters) larger than RX distance (' num2str(1000*  dist_12) ' meters) -> no solution possible ']);
        doa_meters = sign(doa_meters) * 0.995 * dist_12 * 1000;
        disp(['ATTENTION: Correcting TODA delay to 0.995 * RX distance (maximum possible value) = ' num2str(0.995*doa_meters) '']);
    end

    if abs(doa_meters/1000) <= dist_12

        %for r_1 = (exp(0:0.05:4)-1) / 5
        for r_1 = 0:0.05:10
            r_2 = r_1 - doa_meters/1000;
            %disp(['r_1 = ' num2str(r_1) ', r_2 = ' num2str(r_2)]);

            if ((r_2 + r_1) > dist_12)  % checks if triangle can be created

				acos_argument = (r_2^2 - r_1^2 - dist_12^2) / (-2*r_1*dist_12);

				if (acos_argument >= -1) && (acos_argument <= +1) % checks if triangle can be created

					hyp_point_counter = hyp_point_counter + 1;

					hyp_angle = acos(acos_argument); % inner angle of triangle at RX1

					abs_angle1 = wrap2pi(angle_12 + hyp_angle);  % 1st solution: hyperbola leg 1
					hyp_x_leg1(hyp_point_counter) = rx1_x + r_1 * cos(abs_angle1);
					hyp_y_leg1(hyp_point_counter) = rx1_y + r_1 * sin(abs_angle1);

					abs_angle2 = wrap2pi(angle_12 - hyp_angle);  % 2nd solution: hyperbola leg 2
					hyp_x_leg2(hyp_point_counter) = rx1_x + r_1 * cos(abs_angle2);
					hyp_y_leg2(hyp_point_counter) = rx1_y + r_1 * sin(abs_angle2);
                else
                    %disp(['acos argument ' num2str(acos_argument)]);
				end
            end

        end
    else
        disp('TODA delay larger than RX distance -> no solution possible');
    end

    if (hyp_point_counter == 0)
        disp('Hyperbola could not be constructed');
    end

    hyp_x = [fliplr(hyp_x_leg1) hyp_x_leg2];
    hyp_y = [fliplr(hyp_y_leg1) hyp_y_leg2];
    hyp_points = 2* hyp_point_counter;

    points_lat = zeros(hyp_points,1);
    points_long = zeros(hyp_points,1);

    for ii=1:1:hyp_points
        [points_lat(ii), points_long(ii)] = xy2latlong(hyp_x(ii), hyp_y(ii), geo_ref_lat, geo_ref_long);
    end

    disp(['Hyperbola with totally ' num2str(hyp_points) ' points generated.']);
end


function lik = lik_qgp(varargin)
%LIK_QGP  Create a Quantile Gaussian Process likelihood (utility) structure
%
%  Description
%    LIK = LIK_QGP('PARAM1',VALUE1,'PARAM2,VALUE2,...)
%    creates a quantile gp likelihood structure in which the named
%    parameters have the specified values. Any unspecified
%    parameters are set to default values.
%
%    LIK = LIK_QGP(LIK,'PARAM1',VALUE1,'PARAM2,VALUE2,...)
%    modify a likelihood function structure with the named
%    parameters altered with the specified values.
%
%    Parameters for QGP likelihood function [default]
%      sigma2       - variance [0.1]
%      sigma2_prior - prior for sigma2 [prior_logunif]
%      quantile     - Quantile of interest [0.5]
%
%    Note! If the prior is 'prior_fixed' then the parameter in
%    question is considered fixed and it is not handled in
%    optimization, grid integration, MCMC etc.
%
%    The likelihood is defined as follows:
%                            __ n
%      p(y|f, sigma2, tau) = || i=1 tau*(1-tau)/sigma*exp(-(y-f)/sigma*
%                                 (tau - I(t <= f)))
%
%    where tau is the quantile of interest, sigma is the standard deviation
%    of the distribution and I(t <= f) = 1 if t <= f, 0 otherwise.
%
%    Note that because the form of the likelihood, second order derivatives
%    with respect to latent values are 0. Because this, EP should be used
%    instead of Laplace approximation.
%
%  See also
%    GP_SET, PRIOR_*, LIK_*
%
%   References
%     Boukouvalas et al. (2012). Direct Gaussian Process Quantile Regression
%     Using Expectation Propagation. Appearing in Proceedings of the 29th
%     International Conference on Machine Learning, Edinburg, Scotland, UK,
%     2012.
%

% Copyright (c) 2012 Ville Tolvanen

% This software is distributed under the GNU General Public
% License (version 3 or later); please refer to the file
% License.txt, included with the software, for details.

  ip=inputParser;
  ip.FunctionName = 'LIK_QGP';
  ip.addOptional('lik', [], @isstruct);
  ip.addParamValue('sigma2',0.1, @(x) isscalar(x) && x>0);
  ip.addParamValue('sigma2_prior',prior_logunif(), @(x) isstruct(x) || isempty(x));
  ip.addParamValue('quantile',0.5, @(x) isscalar(x) && x>0 && x<1);
  ip.parse(varargin{:});
  lik=ip.Results.lik;

  if isempty(lik)
    init=true;
    lik.type = 'QGP';
  else
    if ~isfield(lik,'type') || ~isequal(lik.type,'QGP')
      error('First argument does not seem to be a valid likelihood function structure')
    end
    init=false;
  end

  % Initialize parameters
  if init || ~ismember('sigma2',ip.UsingDefaults)
    lik.sigma2 = ip.Results.sigma2;
  end
  if init || ~ismember('quantile',ip.UsingDefaults)
    lik.quantile = ip.Results.quantile;
  end
  % Initialize prior structure
  if init
    lik.p=[];
  end
  if init || ~ismember('sigma2_prior',ip.UsingDefaults)
    lik.p.sigma2=ip.Results.sigma2_prior;
  end
  if init
    % Set the function handles to the subfunctions
    lik.fh.pak = @lik_qgp_pak;
    lik.fh.unpak = @lik_qgp_unpak;
    lik.fh.lp = @lik_qgp_lp;
    lik.fh.lpg = @lik_qgp_lpg;
    lik.fh.ll = @lik_qgp_ll;
    lik.fh.llg = @lik_qgp_llg;
    lik.fh.llg2 = @lik_qgp_llg2;
    lik.fh.llg3 = @lik_qgp_llg3;
    lik.fh.tiltedMoments = @lik_qgp_tiltedMoments;
    lik.fh.siteDeriv = @lik_qgp_siteDeriv;
    lik.fh.predy = @lik_qgp_predy;
    lik.fh.invlink = @lik_qgp_invlink;
    lik.fh.recappend = @lik_qgp_recappend;
  end

end

function [w s] = lik_qgp_pak(lik)
%LIK_QGP_PAK  Combine likelihood parameters into one vector.
%
%  Description
%    W = LIK_QGP_PAK(LIK) takes a likelihood structure LIK
%    and combines the parameters into a single row vector W.
%    This is a mandatory subfunction used for example in
%    energy and gradient computations.
%
%       w = [ log(lik.sigma2)
%             (hyperparameters of lik.magnSigma2)]'
%
%  See also
%    LIK_QGP_UNPAK

  w = []; s = {};
  if ~isempty(lik.p.sigma2)
    w = [w log(lik.sigma2)];
    s = [s; 'log(qgp.sigma2)'];
    % Hyperparameters of sigma2
    [wh sh] = lik.p.sigma2.fh.pak(lik.p.sigma2);
    w = [w wh];
    s = [s; sh];
  end

end

function [lik, w] = lik_qgp_unpak(lik, w)
%LIK_QGP_UNPAK  Extract likelihood parameters from the vector.
%
%  Description
%    W = LIK_QGP_UNPAK(W, LIK) takes a likelihood structure
%    LIK and extracts the parameters from the vector W to the LIK
%    structure. This is a mandatory subfunction used for example
%    in energy and gradient computations.
%
%    Assignment is inverse of
%       w = [ log(lik.sigma2)
%             (hyperparameters of lik.magnSigma2)]'
%
%  See also
%    LIK_QGP_PAK

  if ~isempty(lik.p.sigma2)
    lik.sigma2 = exp(w(1));
    w = w(2:end);

    % Hyperparameters of sigma2
    [p, w] = lik.p.sigma2.fh.unpak(lik.p.sigma2, w);
    lik.p.sigma2 = p;
  end
end

function lp = lik_qgp_lp(lik)
%LIK_QGP_LP  Evaluate the log prior of likelihood parameters
%
%  Description
%    LP = LIK_QGP_LP(LIK) takes a likelihood structure LIK and
%    returns log(p(th)), where th collects the parameters. This
%    subfunction is needed when there are likelihood parameters.
%
%  See also
%    LIK_QGP_PAK, LIK_QGP_UNPAK, LIK_QGP_G, GP_E

  lp = 0;

  if ~isempty(lik.p.sigma2)
    likp=lik.p;
    lp = likp.sigma2.fh.lp(lik.sigma2, likp.sigma2) + log(lik.sigma2);
  end
end

function lpg = lik_qgp_lpg(lik)
%LIK_QGP_LPG  Evaluate gradient of the log prior with respect
%                  to the parameters.
%
%  Description
%    LPG = LIK_QGP_LPG(LIK) takes a QGP likelihood
%    function structure LIK and returns LPG = d log (p(th))/dth,
%    where th is the vector of parameters. This subfunction is
%    needed when there are likelihood parameters.
%
%  See also
%    LIK_QGP_PAK, LIK_QGP_UNPAK, LIK_QGP_E, GP_G

  lpg = [];

  if ~isempty(lik.p.sigma2)
    likp=lik.p;

    lpgs = likp.sigma2.fh.lpg(lik.sigma2, likp.sigma2);
    lpg = lpgs(1).*lik.sigma2 + 1;
    if length(lpgs) > 1
      lpg = [lpg lpgs(2:end)];
    end
  end
end

function ll = lik_qgp_ll(lik, y, f, z)
%LIK_QGP_LL  Log likelihood
%
%  Description
%    LL = LIK_QGP_LL(LIK, Y, F, Z) takes a likelihood
%    structure LIK, observations Y and latent values F.
%    Returns the log likelihood, log p(y|f,z). This subfunction
%    is needed when using Laplace approximation or MCMC for
%    inference with non-Gaussian likelihoods. This subfunction
%    is also used in information criteria (DIC, WAIC) computations.
%
%  See also
%    LIK_QGP_LLG, LIK_QGP_LLG3, LIK_QGP_LLG2, GPLA_E

  tau=lik.quantile;
  sigma=sqrt(lik.sigma2);
  ll = sum(log(tau*(1-tau)/sigma) - (y-f)./sigma.*(tau-(y<=f)));
end

function llg = lik_qgp_llg(lik, y, f, param, z)
%LIK_QGP_LLG  Gradient of the log likelihood
%
%  Description
%    LLG = LIK_QGP_LLG(LIK, Y, F, PARAM) takes a likelihood
%    structure LIK, observations Y and latent values F. Returns
%    the gradient of the log likelihood with respect to PARAM.
%    At the moment PARAM can be 'param' or 'latent'. This subfunction
%    is needed when using Laplace approximation or MCMC for inference
%    with non-Gaussian likelihoods.
%
%  See also
%    LIK_QGP_LL, LIK_QGP_LLG2, LIK_QGP_LLG3, GPLA_E

  tau=lik.quantile;
  sigma2=sqrt(lik.sigma2);
  switch param
    case 'param'
      llg = sum(-1/(2.*sigma2) + (y-f)./(2.*sigma2^(3/2)).*(tau-(y<=f)));

      % correction for the log transformation
      llg = llg.*lik.sigma2;
    case 'latent'
      llg = (tau-(y<=f))/sqrt(sigma2);
  end
end

function llg2 = lik_qgp_llg2(lik, y, f, param, z)
%LIK_QGP_LLG2  Second gradients of the log likelihood
%
%  Description
%    LLG2 = LIK_QGP_LLG2(LIK, Y, F, PARAM) takes a likelihood
%    structure LIK, observations Y and latent values F. Returns
%    the Hessian of the log likelihood with respect to PARAM.
%    At the moment PARAM can be 'param' or 'latent'. LLG2 is
%    a vector with diagonal elements of the Hessian matrix
%    (off diagonals are zero). This subfunction is needed
%    when using Laplace approximation or EP for inference
%    with non-Gaussian likelihoods.
%
%  See also
%    LIK_QGP_LL, LIK_QGP_LLG, LIK_QGP_LLG3, GPLA_E

  tau=lik.quantile;
  sigma2=lik.sigma2;
  switch param
    case 'param'
      llg2 = sum(1/(2*sigma2^2) - 3.*(tau-(y<=f)).*(y-f)./(4.*sigma2^(5/2)));

      % correction due to the log transformation
      llg2 = llg2.*lik.sigma2;
    case 'latent'
      llg2 = zeros(size(f));
    case 'latent+param'
      llg2 = -(tau-(y<=f))./(2*sigma2^(3/2));

      % correction due to the log transformation
      llg2 = llg2.*lik.disper;
  end
end

function llg3 = lik_qgp_llg3(lik, y, f, param, z)
%LIK_QGP_LLG3  Third gradients of the log likelihood
%
%  Description
%    LLG3 = LIK_QGP_LLG3(LIK, Y, F, PARAM) takes a likelihood
%    structure LIK, observations Y and latent values F and
%    returns the third gradients of the log likelihood with
%    respect to PARAM. At the moment PARAM can be 'param' or
%    'latent'. LLG3 is a vector with third gradients. This
%    subfunction is needed when using Laplace approximation for
%    inference with non-Gaussian likelihoods.
%
%  See also
%    LIK_QGP_LL, LIK_QGP_LLG, LIK_QGP_LLG2, GPLA_E, GPLA_G

  tau=lik.quantile;
  sigma2=lik.sigma2;
  switch param
    case 'param'
      llg3 = sum(-1/sigma2^3 + 15.*(tau-(y<=f)).*(y-f)./(8.*sigma2^(7/2)));
    case 'latent'
      llg3 = 0;
    case 'latent2+param'
      llg3 = 0;

      % correction due to the log transformation
      llg3 = llg3.*lik.sigma2;
  end
end

function [logM_0, m_1, sigm2hati1] = lik_qgp_tiltedMoments(lik, y, i1, sigm2_i, myy_i, z)
%LIK_QGP_TILTEDMOMENTS  Returns the marginal moments for EP algorithm
%
%  Description
%    [M_0, M_1, M2] = LIK_QGP_TILTEDMOMENTS(LIK, Y, I, S2,
%    MYY, Z) takes a likelihood structure LIK, observations
%    Y, index I and cavity variance S2 and mean MYY. Returns
%    the zeroth moment M_0, mean M_1 and variance M_2 of the
%    posterior marginal (see Rasmussen and Williams (2006):
%    Gaussian processes for Machine Learning, page 55). This
%    subfunction is needed when using EP for inference with
%    non-Gaussian likelihoods.
%
%  See also
%    GPEP_E

  yy = y(i1);
  sigma2 = lik.sigma2;
  tau=lik.quantile;
  logM_0=zeros(size(yy));
  m_1=zeros(size(yy));
  sigm2hati1=zeros(size(yy));

  for i=1:length(i1)
    % get a function handle of an unnormalized tilted distribution
    % (likelihood * cavity = Quantile-GP * Gaussian)
    % and useful integration limits
    [tf,minf,maxf]=init_qgp_norm(yy(i),myy_i(i),sigm2_i(i),sigma2,tau);

    % Integrate with quadrature
    RTOL = 1.e-6;
    ATOL = 1.e-10;
    [m_0, m_1(i), m_2] = quad_moments(tf, minf, maxf, RTOL, ATOL);
    sigm2hati1(i) = m_2 - m_1(i).^2;

    % If the second central moment is less than cavity variance
    % integrate more precisely. Theoretically for log-concave
    % likelihood should be sigm2hati1 < sigm2_i.
    if sigm2hati1(i) >= sigm2_i(i)
      ATOL = ATOL.^2;
      RTOL = RTOL.^2;
      [m_0, m_1(i), m_2] = quad_moments(tf, minf, maxf, RTOL, ATOL);
      sigm2hati1(i) = m_2 - m_1(i).^2;
      if sigm2hati1(i) >= sigm2_i(i)
        error('lik_qgp_tilted_moments: sigm2hati1 >= sigm2_i');
      end
    end
    logM_0(i) = log(m_0);
  end
end

function [g_i] = lik_qgp_siteDeriv(lik, y, i1, sigm2_i, myy_i, z)
%LIK_QGP_SITEDERIV  Evaluate the expectation of the gradient
%                      of the log likelihood term with respect
%                      to the likelihood parameters for EP
%
%  Description [M_0, M_1, M2] =
%    LIK_QGP_SITEDERIV(LIK, Y, I, S2, MYY, Z) takes a
%    likelihood structure LIK, observations Y, index I
%    and cavity variance S2 and mean MYY. Returns E_f
%    [d log p(y_i|f_i) /d a], where a is the likelihood
%    parameter and the expectation is over the marginal posterior.
%    This term is needed when evaluating the gradients of
%    the marginal likelihood estimate Z_EP with respect to
%    the likelihood parameters (see Seeger (2008):
%    Expectation propagation for exponential families).This
%    subfunction is needed when using EP for inference with
%    non-Gaussian likelihoods and there are likelihood parameters.
%
%  See also
%    GPEP_G

  yy = y(i1);
  sigma2=lik.sigma2;
  tau=lik.quantile;

  % get a function handle of an unnormalized tilted distribution
  % (likelihood * cavity = Quantile-GP * Gaussian)
  % and useful integration limits
  [tf,minf,maxf]=init_qgp_norm(yy,myy_i,sigm2_i,sigma2,tau);
  % additionally get function handle for the derivative
  td = @deriv;

  % Integrate with quadgk
  [m_0, fhncnt] = quadgk(tf, minf, maxf);
  [g_i, fhncnt] = quadgk(@(f) td(f).*tf(f)./m_0, minf, maxf);
  g_i = g_i.*sigma2;

  function g = deriv(f)

    g = -1/(2.*sigma2) + (yy-f)./(2.*sigma2^(3/2)).*(tau-(yy<=f));

  end
end

function [lpy, Ey, Vary] = lik_qgp_predy(lik, Ef, Varf, yt, zt)
%LIK_QGP_PREDY  Returns the predictive mean, variance and density of y
%
%  Description
%    LPY = LIK_QGP_PREDY(LIK, EF, VARF YT, ZT)
%    Returns logarithm of the predictive density PY of YT, that is
%        p(yt | zt) = \int p(yt | f, zt) p(f|y) df.
%    This subfunction is needed when computing posterior predictive
%    distributions for future observations.
%
%    [LPY, EY, VARY] = LIK_QGP_PREDY(LIK, EF, VARF) takes a
%    likelihood structure LIK, posterior mean EF and posterior
%    Variance VARF of the latent variable and returns the
%    posterior predictive mean EY and variance VARY of the
%    observations related to the latent variables. This
%    subfunction is needed when computing posterior predictive
%    distributions for future observations.
%

%
%  See also
%    GPLA_PRED, GPEP_PRED, GPMC_PRED

  sigma2=lik.sigma2;
  tau=lik.quantile;

  Ey=[];
  Vary=[];

  % Evaluate the posterior predictive densities of the given observations
  lpy = zeros(length(yt),1);
  for i1=1:length(yt)
    % get a function handle of the likelihood times posterior
    % (likelihood * posterior = Quantile-GP * Gaussian)
    % and useful integration limits
    [pdf,minf,maxf]=init_qgp_norm(...
      yt(i1),Ef(i1),Varf(i1),sigma2, tau);
    % integrate over the f to get posterior predictive distribution
    lpy(i1) = log(quadgk(pdf, minf, maxf));
  end
end

function [df,minf,maxf] = init_qgp_norm(yy,myy_i,sigm2_i,sigma2,tau)
%INIT_QGP_NORM
%
%  Description
%    Return function handle to a function evaluating
%    Quantile-GP * Gaussian which is used for evaluating
%    (likelihood * cavity) or (likelihood * posterior) Return
%    also useful limits for integration. This is private function
%    for lik_qgp. This subfunction is needed by subfunctions
%    tiltedMoments, siteDeriv and predy.
%
%  See also
%    LIK_QGP_TILTEDMOMENTS, LIK_QGP_SITEDERIV,
%    LIK_QGP_PREDY

  sigma=sqrt(sigma2);
% avoid repetitive evaluation of constant part
  ldconst = log(tau*(1-tau)/sigma) ...
            - log(sigm2_i)/2 - log(2*pi)/2;
  % Create function handle for the function to be integrated
  df = @qgp_norm;
  % use log to avoid underflow, and derivates for faster search
  ld = @log_qgp_norm;
  ldg = @log_qgp_norm_g;
%   ldg2 = @log_qgp_norm_g2;

  % Set the limits for integration
  % Quantile-GP likelihood is log-concave so the qgp_norm
  % function is unimodal, which makes things easier
  if yy==0
    % with yy==0, the mode of the likelihood is not defined
    % use the mode of the Gaussian (cavity or posterior) as a first guess
    modef = myy_i;
  else
    % use precision weighted mean of the Gaussian approximation
    % of the Quantile-GP likelihood and Gaussian
    modef = (myy_i/sigm2_i + yy/sigma2)/(1/sigm2_i + 1/sigma2);
  end
  % find the mode of the integrand using Newton iterations
  % few iterations is enough, since the first guess in the right direction
  niter=8;       % number of Newton iterations

  minf=modef-6*sigm2_i;
  while ldg(minf) < 0
    minf=minf-2*sigm2_i;
  end
  maxf=modef+6*sigm2_i;
  while ldg(maxf) > 0
    maxf=maxf+2*sigm2_i;
  end
  for ni=1:niter
%     h=ldg2(modef);
    modef=0.5*(minf+maxf);
    if ldg(modef) < 0
      maxf=modef;
    else
      minf=modef;
    end
  end
  % integrand limits based on Gaussian approximation at mode
  minf=modef-6*sqrt(sigm2_i);
  maxf=modef+6*sqrt(sigm2_i);
  modeld=ld(modef);
  iter=0;
  % check that density at end points is low enough
  lddiff=20; % min difference in log-density between mode and end-points
  minld=ld(minf);
  step=1;
  while minld>(modeld-lddiff)
    minf=minf-step*sqrt(sigm2_i);
    minld=ld(minf);
    iter=iter+1;
    step=step*2;
    if iter>100
      error(['lik_qgp -> init_qgp_norm: ' ...
             'integration interval minimun not found ' ...
             'even after looking hard!'])
    end
  end
  maxld=ld(maxf);
  step=1;
  while maxld>(modeld-lddiff)
    maxf=maxf+step*sqrt(sigm2_i);
    maxld=ld(maxf);
    iter=iter+1;
    step=step*2;
    if iter>100
      error(['lik_qgp -> init_qgp_norm: ' ...
             'integration interval maximun not found ' ...
             'even after looking hard!'])
    end
  end

  function integrand = qgp_norm(f)
  % Quantile-GP * Gaussian
    integrand = exp(ldconst ...
                    -(yy-f)./sqrt(sigma2).*(tau-(yy<=f)) ...
                    -0.5*(f-myy_i).^2./sigm2_i);
  end

  function log_int = log_qgp_norm(f)
  % log(Quantile-GP * Gaussian)
  % log_qgp_norm is used to avoid underflow when searching
  % integration interval
    log_int = ldconst...
              -(yy-f)./sqrt(sigma2).*(tau-(yy<=f)) ...
              -0.5*(f-myy_i).^2./sigm2_i;
  end

  function g = log_qgp_norm_g(f)
  % d/df log(Quantile-GP * Gaussian)
  % derivative of log_qgp_norm
    g = (tau-(yy<=f))/sqrt(sigma2) ...
        + (myy_i - f)./sigm2_i;
  end

end

function mu = lik_qgp_invlink(lik, f, z)
%LIK_QGP_INVLINK  Returns values of inverse link function
%
%  Description
%    MU = LIK_QGP_INVLINK(LIK, F) takes a likelihood structure LIK and
%    latent values F and returns the values MU of inverse link function.
%    This subfunction is needed when using function gp_predprctmu.
%
%     See also
%     LIK_QGP_LL, LIK_QGP_PREDY

  mu = f;
end

function reclik = lik_qgp_recappend(reclik, ri, lik)
%RECAPPEND  Append the parameters to the record
%
%  Description
%    RECLIK = LIK_QGP_RECAPPEND(RECLIK, RI, LIK) takes a
%    likelihood record structure RECLIK, record index RI and
%    likelihood structure LIK with the current MCMC samples of
%    the parameters. Returns RECLIK which contains all the old
%    samples and the current samples from LIK.  This subfunction
%    is needed when using MCMC sampling (gp_mc).
%
%  See also
%    GP_MC

  if nargin == 2
    % Initialize the record
    reclik.type = 'Quantile-GP';

    % Initialize parameter
    reclik.sigma2 = [];

    % Set the function handles
    reclik.fh.pak = @lik_qgp_pak;
    reclik.fh.unpak = @lik_qgp_unpak;
    reclik.fh.lp = @lik_qgp_lp;
    reclik.fh.lpg = @lik_qgp_lpg;
    reclik.fh.ll = @lik_qgp_ll;
    reclik.fh.llg = @lik_qgp_llg;
    reclik.fh.llg2 = @lik_qgp_llg2;
    reclik.fh.llg3 = @lik_qgp_llg3;
    reclik.fh.tiltedMoments = @lik_qgp_tiltedMoments;
    reclik.fh.predy = @lik_qgp_predy;
    reclik.fh.invlink = @lik_qgp_invlink;
    reclik.fh.recappend = @lik_qgp_recappend;
    reclik.p=[];
    reclik.p.sigma2=[];
    if ~isempty(ri.p.sigma2)
      reclik.p.sigma2 = ri.p.sigma2;
    end
  else

    % Append to the record
    reclik.sigma2(ri,:)=lik.sigma2;
    if ~isempty(lik.p)
      reclik.p.sigma2 = lik.p.sigma2.fh.recappend(reclik.p.sigma2, ri, lik.p.sigma2);
    end
  end
end


function [C_pos,C_neg,Ctot_pos,Ctot_neg] = clustering_coef_wu_sign(W,coef_type)
%CLUSTERING_COEF_WU_SIGN     Multiple generalizations of the clustering coefficient
%
%   [C_pos,C_neg,Ctot_pos,Ctot_neg] = clustering_coef_wu_sign(W,coef_type);
%
%   The weighted clustering coefficient is the average weight or intensity
%   of all triangles associated with each node.
%
%   Inputs:
%       W,
%           Weighted undirected connection matrix
%
%       corr_type,
%           Desired type of clustering coefficient.
%           Options:
%           1,  (default) Onnela et al. formula, used in original
%               clustering_coef_wu.m. Computed separately for positive &
%               negative weights.
%           2,  Zhang & Horvath formula, similar to Onnela formula except
%               denominator of Onnela formula relies on binarizing the
%               network whereas this denominator is based on weight value,
%               which reduces the sensitivity of this measure to the
%               weights directly connected to the node of interest.
%               Computed separately for positive & negative weights.
%           3,  Constantini & Perugini's generalization of the Zhang &
%               Horvath formula. This formula takes both positive &
%               negative weights into account simultaneously, & is
%               particularly sensitive to non-redundancy in path
%               information based on sign (i.e., when two weights are
%               positive & one negative, or all three are negative, both of
%               which indicate that the weight of the third path is not
%               redundant information). Produces only one value.
%
%
%   Outputs:
%       C_pos/C_neg,
%           Clustering coefficient vector for positive/negative weights.
%           For the third option, only one vector is outputted (as C_pos).
%       Ctot_pos/Ctot_neg,
%           Mean clustering coefficient for positive and negative weights.
%
%   References:
%       Onnela et al. (2005) Phys Rev E 71:065103
%       Zhang & Horvath (2005) Stat Appl Genet Mol Biol 41:1544-6115
%       Costantini & Perugini (2014) PLOS ONE 9:e88669
%
%
%   Contributor: Jeff Spielberg, Boston University, 2014-2015
%                (script based on clustering_coef_wu.m)

%
%   Modification History:
%   May 2014: Added computation of pos & neg weights separately &
%             computation of mean coefficient (Jeff Spielberg)
%   May 2015: Added computation of Zhang & Horvath and Constantini &
%             Perugini formulas (Jeff Spielberg)
%   May 2016: Bugfix in computation of the denominator of the Costantini &
%             Perugini (flag 3) version (Chiara Pintossi)

if ~exist('coef_type','var')
    coef_type = 1;
end

n            = length(W);                   %number of nodes
W(1:n+1:end) = 0;

switch coef_type
    case 1
        W_pos                = W.*(W>0);
        K_pos                = sum(W_pos~=0,2);
        cyc3_pos             = diag((W_pos.^(1/3))^3);
        K_pos(cyc3_pos == 0) = inf;             %if no 3-cycles exist, make C=0 (via K=inf)
        C_pos                = cyc3_pos./(K_pos.*(K_pos-1));         %clustering coefficient
        Ctot_pos             = mean(C_pos);

        W_neg                = -W.*(W<0);
        K_neg                = sum(W_neg~=0,2);
        cyc3_neg             = diag((W_neg.^(1/3))^3);
        K_neg(cyc3_neg == 0) = inf;             %if no 3-cycles exist, make C=0 (via K=inf)
        C_neg                = cyc3_neg./(K_neg.*(K_neg-1));         %clustering coefficient
        Ctot_neg             = mean(C_neg);
    case 2
        W_pos    = W.*(W>0);
        cyc3_pos = zeros(n,1);
        cyc2_pos = zeros(n,1);
        for i = 1:n
            for j = 1:n
                for q = 1:n
                    cyc3_pos(i) = cyc3_pos(i)+(W_pos(j,i)*W_pos(i,q)*W_pos(j,q));
                    if j~=q
                        cyc2_pos(i) = cyc2_pos(i)+(W_pos(j,i)*W_pos(i,q));
                    end
                end
            end
        end
        cyc2_pos(cyc3_pos == 0) = inf;             %if no 3-cycles exist, make C=0 (via K=inf)
        C_pos                   = cyc3_pos./cyc2_pos;         %clustering coefficient
        Ctot_pos                = mean(C_pos);

        W_neg    = -W.*(W<0);
        cyc3_neg = zeros(n,1);
        cyc2_neg = zeros(n,1);
        for i = 1:n
            for j = 1:n
                for q = 1:n
                    cyc3_neg(i) = cyc3_neg(i)+(W_neg(j,i)*W_neg(i,q)*W_neg(j,q));
                    if j~=q
                        cyc2_neg(i) = cyc2_neg(i)+(W_neg(j,i)*W_neg(i,q));
                    end
                end
            end
        end
        cyc2_neg(cyc3_neg == 0) = inf;             %if no 3-cycles exist, make C=0 (via K=inf)
        C_neg                   = cyc3_neg./cyc2_neg;         %clustering coefficient
        Ctot_neg                = mean(C_neg);
    case 3
        cyc3         = zeros(n,1);
        cyc2         = zeros(n,1);

        for i = 1:n
            for j = 1:n
                for q = 1:n
                    cyc3(i) = cyc3(i)+(W(j,i)*W(i,q)*W(j,q));
                    if j~=q
                        cyc2(i) = cyc2(i)+abs(W(j,i)*W(i,q));
                    end
                end
            end
        end

        cyc2(cyc3 == 0) = inf;             %if no 3-cycles exist, make C=0 (via K=inf)
        C_pos           = cyc3./cyc2;         %clustering coefficient
        Ctot_pos        = mean(C_pos);
        C_neg           = nan(size(C_pos));
        Ctot_neg        = nan(size(Ctot_pos));
end


function newFaces = minConvexHull(points, varargin)
%MINCONVEXHULL Return the unique minimal convex hull of a set of 3D points.
%
%   FACES = minConvexHull(PTS)
%   NODES is a set of 3D points  (as a Nx3 array). The function computes
%   the convex hull, and merge contiguous coplanar faces. The result is a
%   set of polygonal faces, such that there are no coplanar faces.
%   FACES is a cell array, each cell containing the vector of indices of
%   nodes given in NODES for the corresponding face.
%
%   FACES = minConvexHull(PTS, PRECISION)
%   Adjust the threshold for deciding if two faces are coplanar or
%   parallel. Default value is 1e-14.
%
%   Example
%     % extract square faces from a cube
%     [n, e, f] = createCube;
%     f2 = minConvexHull(n);
%     drawMesh(n, f2);
%
%     % Subdivides and smooths a mesh rpresenting a cube
%     [n, e, f] = createCube;
%     [n2, f2] = subdivideMesh(n, triangulateFaces(f), 4);
%     [n3, f3] = smoothMesh(n2, f2);
%     figure; drawMesh(n3, f3);
%     axis equal; view(3);
%     % merge coplanar faces, making apparent the faces of the original cube
%     f4 = minConvexHull(n3);
%     figure; drawMesh(n3, f4);
%     axis equal; view(3);
%
%
%   See also
%   meshes3d, mergeCoplanarFaces, drawMesh, convhull, convhulln
%

% ------
% Author: David Legland
% E-mail: david.legland@inra.fr
% Created: 2006-07-05
% Copyright 2006-2022 INRA - CEPIA Nantes - MIAJ (Jouy-en-Josas)

% set up precision
acc = 1e-14;
if ~isempty(varargin)
    acc = varargin{1};
end

% triangulated convex hull. It is not uniquely defined.
faces = convhulln(points);

% compute centroid of the nodes
pointsCentroid = centroid(points);

% number of base triangular faces
N = size(faces, 1);

% compute normals of given faces
normals = planeNormal(createPlane(...
    points(faces(:,1),:), points(faces(:,2),:), points(faces(:,3),:)));

% initialize empty faces
newFaces = {};

% Processing flag for each triangle
% 1 : triangle to process, 0 : already processed
% in the beginning, every triangle face need to be processed
flag = ones(N, 1);

% iterate on each triangular face of the convex hull
for iFace = 1:N

    % check if face was already performed
    if ~flag(iFace)
        continue;
    end

    % indices of faces with same normal
    ind = find(abs(vectorNorm3d(cross(repmat(normals(iFace, :), [N 1]), normals)))<acc);
    ind = ind(ind~=iFace);

    % keep only coplanar faces (test coplanarity of points in both face)
    ind2 = iFace;
    for j = 1:length(ind)
        if isCoplanar(points([faces(iFace,:) faces(ind(j),:)], :), acc)
            ind2 = [ind2 ind(j)]; %#ok<AGROW>
        end
    end

    % compute order of the vertices in current face
    faceVertices = unique(faces(ind2, :));
    [tmp, I]  = angleSort3d(points(faceVertices, :)); %#ok<ASGLU>

    % create the new face, ensuring it is a row vector
    face = faceVertices(I);
    face = face(:)';

    % ensure face has normal pointing outwards
    outerNormal = meshFaceCentroids(points, face) - pointsCentroid;
    if dot(meshFaceNormals(points, face), outerNormal, 2) < 0
        face = face([1 end:-1:2]);
    end

    % add a new face to the list
    newFaces = [newFaces {face}]; %#ok<AGROW>

    % mark processed faces
    flag(ind2) = 0;
end


function [ o, x, w ] = en_r2_05_6 ( n )

%*****************************************************************************80
%
%% EN_R2_05_6 implements the Stroud rule 5.6 for region EN_R2.
%
%  Discussion:
%
%    The rule has order O = ( N + 1 ) * 2^N.
%
%    The rule has precision P = 5.
%
%    EN_R2 is the entire N-dimensional space with weight function
%
%      w(x) = exp ( - x1^2 - x2^2 ... - xn^2 )
%
%    The rule requires 5 <= N.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 January 2010
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Arthur Stroud,
%    Approximate Calculation of Multiple Integrals,
%    Prentice Hall, 1971,
%    ISBN: 0130438936,
%    LC: QA311.S85.
%
%  Parameters:
%
%    Input, integer N, the spatial dimension.
%    5 <= N.
%
%    Output, integer O, the order.
%
%    Output, real X(N,O), the abscissas.
%
%    Output, real W(O), the weights.
%
  if ( n < 5 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'EN_R2_05_6 - Fatal error!\n' );
    fprintf ( 1, '  5 <= N is required.\n' );
    error ( 'EN_R2_05_6 - Fatal error!' );
  end

  o = 2^n * ( n + 1 );
  volume = sqrt ( pi^n );

  a = volume / 2^n / ( n + 1 );

  r = sqrt ( ( n - sqrt ( 2 ) + ( n - 1 ) * sqrt ( 2 * ( n + 1 ) ) ) / 2 / n );
  s = sqrt ( ( n - sqrt ( 2 ) -             sqrt ( 2 * ( n + 1 ) ) ) / 2 / n );
  t = sqrt ( ( 1 + sqrt ( 2 ) ) / 2 );

  x = zeros ( n, o );
  w = zeros ( o, 1 );

  k = 0;
%
%  N * 2^N points.
%
  for i = 1 : n

    k = k + 1;
    x(1:n,k) = - s;
    x(i,k)   = - r;
    w(k) = a;

    more = 1;

    while ( more )
      more = 0;
      for j = n : -1 : 1
        if ( x(j,k) < 0.0 )
          k = k + 1;
          x(1:n,k) = x(1:n,k-1);
          x(j,k)     =   abs ( x(j,k) );
          x(j+1:n,k) = - abs ( x(j+1:n,k) );
          w(k) = a;
          more = 1;
          break;
        end
      end
    end

  end
%
%  2^N points.
%
  k = k + 1;
  x(1:n,k) = - t;
  w(k) = a;
  more = 1;
  while ( more )
    more = 0;
    for j = n : -1 : 1
      if ( x(j,k) < 0.0 )
        k = k + 1;
        x(1:n,k) = x(1:n,k-1);
        x(j,k)     =   abs ( x(j,k) );
        x(j+1:n,k) = - abs ( x(j+1:n,k) );
        w(k) = a;
        more = 1;
        break;
      end
    end
  end

  return
end


%TROTX Rotation about X axis
%
% T = TROTX(THETA) is a homogeneous transformation (4x4) representing a rotation
% of THETA radians about the x-axis.
%
% T = TROTX(THETA, 'deg') as above but THETA is in degrees.
%
% Notes::
% - Translational component is zero.
%
% See also ROTX, TROTY, TROTZ, TROT2.

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

function T = trotx(t, varargin)
	T = [rotx(t, varargin{:}) [0 0 0]'; 0 0 0 1];


function x = VBA_spm_invFcdf(F,v,w)
% Inverse Cumulative Distribution (CDF) of F (Fisher-Snedecor) distribution
% FORMAT x = spm_invFpdf(F,df)
% FORMAT x = spm_invFpdf(F,v,w)
%
% F  - CDF (lower tail p-value)
% df - Degrees of freedom, concatenated along last dimension
%      Eg. Scalar (or column vector) v & w. Then df=[v,w];
% v  - Shape parameter 1 /   numerator degrees of freedom (v>0)
% w  - Shape parameter 2 / denominator degrees of freedom (w>0)
% x  - F-variate   (F has range [0,Inf) )
%__________________________________________________________________________
%
% spm_Fcdf implements the inverse Cumulative Distribution Function
% for the F-distribution.
%
% Definition:
%--------------------------------------------------------------------------
% The CDF F(x) of the F distribution with degrees of freedom v & w,
% defined for positive integer degrees of freedom v & w, is the
% probability that a realisation of an F random variable X has value
% less than x F(x)=Pr{X<x} for X~F(v,w). The F-distribution is defined
% for v>0 & w>0, and for x in [0,Inf) (See Evans et al., Ch16).
%
% Variate relationships: (Evans et al., Ch16 & 37)
%--------------------------------------------------------------------------
% The square of a Student's t variate with w degrees of freedom is
% distributed as an F-distribution with [1,w] degrees of freedom.
%
% For X an F-variate with v,w degrees of freedom, w/(w+v*X^2) has
% distribution related to a Beta random variable with shape parameters
% w/2 & v/2, as described below.
%
% Algorithm:
%--------------------------------------------------------------------------
% Using the routine spm_invBcdf for the Beta distribution, with
% appropriate parameters:  The CDF of the F-distribution with v,w
% degrees of freedom is related to the incomplete beta function by:
%       Pr(X<x) = 1 - betainc(w/(w+v*x^2),w/2,v/2)
% See Abramowitz & Stegun, 26.6.2; Press et al., Sec6.4 for
% definitions of the incomplete beta function. The relationship is
% easily verified by substituting for w/(w+v*x^2) in the integral of the
% incomplete beta function.
%
%
% References:
%--------------------------------------------------------------------------
% Evans M, Hastings N, Peacock B (1993)
%       "Statistical Distributions"
%        2nd Ed. Wiley, New York
%
% Abramowitz M, Stegun IA, (1964)
%       "Handbook of Mathematical Functions"
%        US Government Printing Office
%
% Press WH, Teukolsky SA, Vetterling AT, Flannery BP (1992)
%       "Numerical Recipes in C"
%        Cambridge
%
%__________________________________________________________________________
% Copyright (C) 1993-2011 Wellcome Trust Centre for Neuroimaging

% Andrew Holmes
% $Id: spm_invFcdf.m 4182 2011-02-01 12:29:09Z guillaume $

%-Format arguments, note & check sizes
%--------------------------------------------------------------------------
if nargin<2, error('Insufficient arguments'), end

%-Unpack degrees of freedom v & w from single df parameter (v)
if nargin<3
    vs = size(v);
    if prod(vs)==2
        %-DF is a 2-vector
        w = v(2); v = v(1);
    elseif vs(end)==2
        %-DF has last dimension 2 - unpack v & w
        nv = prod(vs);
        w  = reshape(v(nv/2+1:nv),vs(1:end-1));
        v  = reshape(v(1:nv/2)   ,vs(1:end-1));
    else
        error('Can''t unpack both df components from single argument')
    end
end

%-Check argument sizes
ad = [ndims(F);ndims(v);ndims(w)];
rd = max(ad);
as = [[size(F),ones(1,rd-ad(1))];...
      [size(v),ones(1,rd-ad(2))];...
      [size(w),ones(1,rd-ad(3))]];
rs = max(as);
xa = prod(as,2)>1;
if sum(xa)>1 && any(any(diff(as(xa,:)),1))
    error('non-scalar args must match in size');
end

%-Computation
%--------------------------------------------------------------------------
%-Initialise result to zeros
x = zeros(rs);

%-Only defined for F in [0,1] & strictly positive v & w.
% Return NaN if undefined.
md = ( F>=0  &  F<=1  &  v>0  &  w>0 );
if any(~md(:))
    x(~md) = NaN;
    warning('Returning NaN for out of range arguments');
end

%-Special cases: x=0 when F=0, x=Inf when F=1
x(md & F==1) = Inf;

%-Compute where defined & not special case
Q  = find( md  &  F>0  &  F<1 );
if isempty(Q), return, end
if xa(1), QF=Q; else QF=1; end
if xa(2), Qv=Q; else Qv=1; end
if xa(3), Qw=Q; else Qw=1; end

%-Compute
bQ   = VBA_spm_invBcdf(1-F(QF),w(Qw)/2,v(Qv)/2);
x(Q) = (w(Qw)./bQ -w(Qw))./v(Qv);


function [in3] = cc2in3(cc)
% Convert volume from cubic centimeters to cubic inches.
% Chad Greene 2012
in3 = cc*0.061023744095;


function [tt] = tt_qtoepl(x, d)

% returns the multilevel Toeplitz matrix tt generated by the multi-dimensional input vector x
% in the QTT format
%
% The size of the input vector is 2^(d(1) + 1) x ... x 2^(d(D) + 1),
% The output matrix is square of order 2^d(1) x ... x 2^d(D).
% The (i_1,...i_D)-th component of x is not used if at least one of i_1,...,i_D is equal to 1
% (e. g., in the one-dimensional case the first component of x is not used)
%
% April 20, 2011
% Vladimir Kazeev
% vladimir.kazeev@gmail.com
% INM RAS
% Moscow, Russia
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% For details please see the preprint
% http://www.mis.mpg.de/publications/preprints/2011/prepr2011-36.html
% Vladimir A. Kazeev, Boris N. Khoromskij and Eugene E. Tyrtyshnikov
% Multilevel Toeplitz matrices generated by QTT tensor-structured vectors and convolution with logarithmic complexity
% January 12, 2012
% Vladimir Kazeev,
% Seminar for Applied Mathematics, ETH Zurich
% vladimir.kazeev@sam.math.ethz.ch
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

D = numel(d);
tt = tt_qshiftstack(d);

sz=[];
for K=1:D
	sz = [sz; 4*ones(d(K),1), 2*ones(d(K),1); 1, 2];
end

tt = tt_qreshape(tt, 3, sz);
tt = tt_matrix(tt) * x;

tt1 = cell(sum(d),1);
ind = 0;
ind1 = 0;
for K = 1:D
	for k = 1:d(K)-1
		tt1{ind1 + k} = tt{ind + k};
	end

	p = size(tt{ind + d(K)}, 1);
	q = size(tt{ind + d(K)}, 3);
	r = size(tt{ind + d(K) + 1}, 3);
	tt1{ind1 + d(K)} = reshape(reshape(permute(tt{ind+d(K)},[2, 1, 3]),[4*p,q])*...
        reshape(permute(tt{ind+d(K)+1},[2, 1, 3]),[q,r]),[4,p,r]);
    tt1{ind1 + d(K)} = permute(tt1{ind1 + d(K)}, [2, 1, 3]);
	ind=ind+d(K)+1;
	ind1=ind1+d(K);
end
tt = tt1;
tt1 = tt_tensor;
tt = cell2core(tt1, tt);
tt = tt_matrix(tt);
return
end


function score = DM(Population,optimum)
% <max> <multi/many> <real/integer/label/binary/permutation> <large/none> <constrained/none> <expensive/none> <multimodal/none> <sparse/none> <dynamic/none>
% Metric for diversity

%------------------------------- Reference --------------------------------
% K. Deb and S. Jain, Running performance metrics for evolutionary
% multi-objective optimization, KanGAL Report 2002004, 2002.
%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    PopObj = Population.best.objs;
    if size(PopObj,2) ~= size(optimum,2)
        score = nan;
    else
        fmax  = max(optimum,[],1);
        fmin  = min(optimum,[],1);
        H     = calGrid(optimum(:,1:end-1),fmax(1:end-1),fmin(1:end-1),size(PopObj,1));
        h     = H & calGrid(PopObj(:,1:end-1),fmax(1:end-1),fmin(1:end-1),size(PopObj,1));
        score = calM(h,H)./calM(H,H);
    end
end

function h = calGrid(P,fmax,fmin,div)
% Determine whether each grid has at least one point

    [N,M] = size(P);
    d     = (fmax-fmin)./div;
    GLoc  = ceil((P-repmat(fmin,N,1))./repmat(d,N,1));
    GLoc  = max(1,GLoc);
    h     = zeros(M,div);
    for i = 1 : M
        h(i,:) = ismember(1:div,GLoc(:,i));
    end
end

function m = calM(h,H)
% Calculate the value function m()

    M = size(h,1);
    h = [ones(M,1),h,ones(M,1)];
    H = [ones(M,1),H,ones(M,1)];
    m = 0;
    for i = 1 : M
        for j = 2 : size(h,2)-1
            if H(i,j)
                if h(i,j)
                    if h(i,j-1)
                        if h(i,j+1)
                            m = m + 1;
                        else
                            m = m + 0.67;
                        end
                    else
                        if h(i,j+1)
                            m = m + 0.67;
                        else
                            m = m + 0.75;
                        end
                    end
                else
                    if h(i,j-1)
                        if h(i,j+1)
                            m = m + 0.75;
                        else
                            m = m + 0.5;
                        end
                    else
                        if h(i,j+1)
                            m = m + 0.5;
                        else
                            m = m + 0;
                        end
                    end
                end
            end
        end
    end
end


function [varargout] = likGumbel(sign, hyp, y, mu, s2, inf, i)

% likGumbel - Gumbel likelihood function for extremal value regression.
% The expression for the likelihood is
%   likGumbel(t) = exp(-z-exp(-z))/be, z = ga+s*(y-t)/be, be = sn*sqrt(6)/pi
% where s={+1,-1} is a sign switching between left and right skewed, ga is the
% Euler-Mascheroni constant, y is the mean, sn^2 is the variance.
% The skewness and kurtosis of likGumbel are 1.14*s and 2.4, respectively.
%
% The hyperparameters are:
%
% hyp = [ log(sn)  ]
%
% Several modes are provided, for computing likelihoods, derivatives and moments
% respectively, see likFunctions.m for the details. In general, care is taken
% to avoid numerical issues when the arguments are extreme.
%
% Copyright (c) by Hannes Nickisch, 2013-11-01.
%
% See also LIKFUNCTIONS.M.

if nargin<4, varargout = {'1'}; return; end   % report number of hyperparameters
if sign=='-', s = -1; else s = 1; end                 % extract sign of skewness

sn2 = exp(2*hyp);                                      % extract hyperparameters
ga = 0.5772156649;                                   % Euler-Mascheroni constant
be = sqrt(6*sn2)/pi;
lZ = -log(be);

if nargin<6                              % prediction mode if inf is not present
  if numel(y)==0,  y = zeros(size(mu)); end
  s2zero = 1; if nargin>4, if norm(s2)>0, s2zero = 0; end, end         % s2==0 ?
  if s2zero                                         % log probability evaluation
    lp = likGumbel(sign, hyp, y, mu, [], 'infLaplace'); s2 = 0;
  else                                                              % prediction
    lp = likGumbel(sign, hyp, y, mu, s2, 'infEP');
  end
  ymu = {}; ys2 = {};
  if nargout>1
    ymu = mu;                                                   % first y moment
    if nargout>2
      ys2 = s2 + sn2;                                          % second y moment
    end
  end
  varargout = {lp,ymu,ys2};
else
  switch inf
  case 'infLaplace'
    z = ga+s*(y-mu)/be; emz = exp(-z);
    if nargin<7                                             % no derivative mode
      dlp = {}; d2lp = {}; d3lp = {};
      lp = lZ -z -emz;
      if nargout>1
        dz = -s/be;                                                     % dz/dmu
        dlp = dz*(emz-1);                    % dlp, derivative of log likelihood
        if nargout>2                    % d2lp, 2nd derivative of log likelihood
          d2lp = -dz^2*emz;
          if nargout>3                  % d3lp, 3rd derivative of log likelihood
            d3lp = dz^3*emz;
          end
        end
      end
      varargout = {lp,dlp,d2lp,d3lp};
    else                                             % derivative w.r.t. log(sn)
      dz = -s/be;                                                       % dz/dmu
      dzs = -s*(y-mu)/be;                                          % dz/dlog(sn)
      lp_dhyp   =  dzs.*(emz-1) -1;
      dlp_dhyp  = dz*(1-emz.*(1+dzs));
      d2lp_dhyp = dz^2*emz.*(2+dzs);
      varargout = {lp_dhyp,dlp_dhyp,d2lp_dhyp};
    end

  case 'infEP'
    if nargout>1
      error('infEP not supported since likT is not log-concave')
    end
    n = max([length(y),length(mu),length(s2)]); on = ones(n,1);
    y = y(:).*on; mu = mu(:).*on; sig = sqrt(s2(:)).*on;          % vectors only
    % since we are not aware of an analytical expression of the integral,
    % we use Gaussian-Hermite quadrature
    N = 20; [t,w] = gauher(N); oN = ones(1,N);
    lZ = likGumbel(sign, hyp, y*oN, sig*t'+mu*oN, []);
    lZ = log_expA_x(lZ,w); % log( exp(lZ)*w )
    varargout = {lZ};

  case 'infVB'
    error('infVB not supported')
  end
end

%  computes y = log( exp(A)*x ) in a numerically safe way by subtracting the
%  maximal value in each row to avoid cancelation after taking the exp
function y = log_expA_x(A,x)
  N = size(A,2);  maxA = max(A,[],2);      % number of columns, max over columns
  y = log(exp(A-maxA*ones(1,N))*x) + maxA;  % exp(A) = exp(A-max(A))*exp(max(A))