function [f] = spm_fx_fnirs(x,u,P,M)
% State equation for a dynamic model of fNIRS responses
% FORMAT [f] = spm_fx_nirs(x,u,P,M)
%
% x      - state vector
%--------------------------------------------------------------------------
%   x(:,1) - excitatory neuronal activity            ue
%   x(:,2) - vasodilatory signal                          s
%   x(:,3) - rCBF                                  ln(f)
%   x(:,4) - venous volume                         ln(v)
%   x(:,5) - deoxyHb                               ln(q)
%   x(:,6) - totalHb                               ln(p)
%   [x(:,7)] - inhibitory neuronal activity            ui
%--------------------------------------------------------------------------
% u     experimental inputs
% P     prior of latent variables
% M    model structure
%
% f      - dx/dt
%___________________________________________________________________________
%
% References for hemodynamic & neuronal state equations:
% 1. Friston KJ, Mechelli A, Turner R, Price CJ. Nonlinear responses in
%    fMRI: the Balloon model, Volterra kernels, and other hemodynamics.
%    Neuroimage 12:466-477, 2000.
% 2. Stephan KE, Kasper L, Harrison LM, Daunizeau J, den Ouden HE,
%    Breakspear M, Friston KJ. Nonlinear dynamic causal models for fMRI.
%    Neuroimage 42:649-662, 2008.
% 3. Marreiros AC, Kiebel SJ, Friston KJ. Dynamic causal modelling for
%    fMRI: a two-state model.
%    Neuroimage. 39(1):269-78, 2008.
% 4. Buxton RB, Uludag, K, Dubowitz, DJ, Liu, TT. Modeling the hemodynamic
%    response to brain activation. Neuroimage. 2004, 23: 220-233.
% 5. X Cui and S Bray and A Reiss. Functional near infrared spectroscopy (NIRS)
%    signal improvement based on negative correlation between oxygenated and
%    deoxygenated hemoglobin dynamics.
%    Neuroimage 49:3039-3046, 2010.
%
% This script is based on spm_fx_fmri.m written by
% Karl Friston & Klaas Enno Stephan.
%__________________________________________________________________________
% Copyright (C) 2015 Wellcome Trust Centre for Neuroimaging

% Will Penny & Sungho Tak
% $Id: spm_fx_fnirs.m 6942 2016-11-21 13:17:44Z guillaume $

% Neuronal motion
%==========================================================================
P.A   = full(P.A);                       %    linear parameters
P.B   = full(P.B);                       % bi-linear parameters
P.C   = P.C/16;                          % exogenous parameters

% implement differential state equation y = dx/dt (neuronal)
%--------------------------------------------------------------------------
f    = x;

% input dependent modulation
%--------------------------------------------------------------------------
for i = 1:size(P.B,3)
    P.A(:,:,1) = P.A(:,:,1) + u(i)*P.B(:,:,i);
end

if size(x, 2) == 6 % one neuronal state per region
    %======================================================================

    % one neuronal state per region: diag(A) is a log self-inhibition
    %----------------------------------------------------------------------
    SI     = diag(P.A);
    P.A    = P.A - diag(exp(SI)/2 + SI);

    % flow
    %----------------------------------------------------------------------
    f(:,1) = P.A*x(:,1) + P.C*u(:);

elseif size(x,2) == 7 % two neuronal states per region
    %======================================================================

    % extrinsic (two neuronal states): enforce positivity
    %----------------------------------------------------------------------
    n     = size(P.A,1);            % number of regions
    EE    = exp(P.A(:,:,1))/8;
    IE    = diag(diag(EE));         % intrinsic inhibitory to excitatory
    EE    = EE - IE;                % extrinsic excitatory to excitatory
    EI    = eye(n,n);               % intrinsic excitatory to inhibitory
    SE    = eye(n,n)/2;             % intrinsic self-inhibition (excitatory)
    SI    = eye(n,n);               % intrinsic self-inhibition (inhibitory)

    % excitatory proportion
    %----------------------------------------------------------------------
    if size(P.A,3) > 1
        phi = spm_phi(P.A(:,:,2)*2);
        EI  = EI + EE.*(1 - phi);
        EE  = EE.*phi - SE;
    else
        EE  = EE - SE;
    end

    % motion - excitatory and inhibitory: f = dx/dt
    %----------------------------------------------------------------------
    f(:,1) = EE*x(:,1) - IE*x(:, 7) + P.C*u(:);
    f(:,6 + 1) = EI*x(:,1) - SI*x(:, 7);
end

% Hemodynamic motion
%==========================================================================

% hemodynamic parameters
%--------------------------------------------------------------------------
%   H(1) - signal decay                                   d(ds/dt)/ds)
%   H(2) - autoregulation                                 d(ds/dt)/df)
%   H(3) - transit time                                      (t0)
%   H(4) - exponent for Fout(v)                           (alpha)
%   H(5) - resting oxygen extraction                      (E0)
%   H(6) - viscoelastic time constant              (tv)
%--------------------------------------------------------------------------
H = [0.64 0.32 2.00 0.32 0.32 2.00];

% exponentiation of hemodynamic state variables
%--------------------------------------------------------------------------
x(:,3:6) = exp(x(:,3:6));

% signal decay
sd = H(1)*exp(P.decay);

% autoregulatory feedback
af = H(2).*exp(P.afback);

% transit time
tt = H(3).*exp(P.transit);
% viscoelastic time constant
tv = H(6).*exp(P.tv);

% outflow f(v) (steady state)
fv_s = x(:,4).^(1/H(4));

% implement differential state equation f = dx/dt (hemodynamic)
%--------------------------------------------------------------------------
f(:,2)   = x(:,1) - sd.*x(:,2) - af.*(x(:,3) - 1);
f(:,3)   = x(:,2)./x(:,3);
f(:,4)   = (x(:,3) - fv_s)./((tt+tv).*x(:,4));

% outflow (dynamic state)
fv_d = fv_s + tv.*x(:,4).*f(:,4);

% oxygen extraction fraction
ff = (1 - (1 - H(5)).^(1./x(:,3)))/H(5);

f(:,5)   = (x(:,3).*ff - fv_d.*x(:,5)./x(:,4))./(tt.*x(:,5));
f(:,6)   = (x(:,3) - fv_d) ./ (tt.*x(:,4));

f        = f(:);


function c = times(a,b,dummy)
%TIMES        Implements  a .* b  for intervals
%

% written  10/16/98     S.M. Rump
% modified 09/02/00     S.M. Rump  rounding unchanged after use
% modified 04/04/04     S.M. Rump  set round to nearest for safety
%                                    remove check for 'double'
%                                    extra argument for non-interval output (internal use only)
%                                    take care of Matlab sparse Inf/NaN bug
% modified 04/06/05     S.M. Rump  rounding unchanged
% modified 11/20/05     S.M. Rump  fast check for rounding to nearest
% modified 02/11/06     S.M. Rump  SparseInfNanFlag removed
%                                    sparse radius for complex data
% modified 05/23/06     S.M. Rump  sparse Inf/NaN bug corrected in Version 7.2+
% modified 12/03/06     S.M. Rump  Sparse Bug global flag (thanks to Arnold)
% modified 12/05/06     S.M. Rump  0*infsup(0,inf) (thanks to Arnold)
% modified 01/19/07     S.M. Rump  zero radius for huge arrays
% modified 05/22/07     S.M. Rump  check for sparse zero factor
% modified 10/21/07     S.M. Rump  Matlab bug for sparse(0)*inf
% modified 10/18/08     S.M. Rump  abss replaced by mag, improved performance
% modified 08/26/12     S.M. Rump  global variables removed
%

  e = 1e-30;
  if 1+e==1-e                           % fast check for rounding to nearest
    rndold = 0;
  else
    rndold = getround;
  end
  huge = ( max(prod(size(a)),prod(size(b)))>1e9 );

  if ~isa(a,'intval')                     % a is double
    if ~isreal(a) | b.complex             % complex case
      if ~b.complex
        setround(1)
        b.mid = b.inf + 0.5*(b.sup-b.inf);
        b.rad = b.mid - b.inf;
      end
      c.complex = 1;
      c.inf = [];
      c.sup = [];
      if isreal(a) | ~b.complex           % R .* IC  or  C .* IC
        setround(-1)
        c1 = a .* b.mid;
        setround(1)
        c2 = a .* b.mid;
      else                                % C .* IC
        setround(-1)
        c1 = real(a) .* real(b.mid) + (-imag(a)) .* imag(b.mid) + ...
             ( real(a) .* imag(b.mid) + imag(a) .* real(b.mid) ) * j;
        setround(1)
        c2 = real(a) .* real(b.mid) + (-imag(a)) .* imag(b.mid) + ...
             ( real(a) .* imag(b.mid) + imag(a) .* real(b.mid) ) * j;
      end
      c.mid = c1 + 0.5*(c2-c1);           % R .* IC  or  C .* IC
      c.rad = abs(c.mid-c1);
      if ~isequal(b.rad,0)                % make sure c.rad remains sparse
        c.rad = c.rad + abs(a) .* b.rad;
      end
      % too rare, improvement doesn't pay
%       if huge
%         [cradi,cradj] = find(c.rad);
%         if ~any(find(cradi))              % take care of huge arrays
%           c.rad = 0;
%         end
%       else
%         if ~any(find(c.rad))
%           c.rad = 0;
%         end
%       end
    else                                  % real case  R .* IR
      c.complex = 0;
      if ( prod(size(a))==1 ) & isequal(a(1,1),0)    % careful with 0*inf and sparse a
        if isinf(b.inf) | isinf(b.sup)
          c.inf = repmat(NaN,size(b.inf));
        else
          if issparse(b.inf)
            [mb,nb] = size(b.inf);
            c.inf = sparse([],[],[],mb,nb);
          else
            c.inf = zeros(size(b.inf));
          end
        end
        c.sup = c.inf;
      else
        setround(-1)
        c.inf = min( a .* b.inf , a .* b.sup );
        setround(1)
        c.sup = max( a .* b.inf , a .* b.sup );
      end
      c.mid = [];
      c.rad = [];
    end
  elseif ~isa(b,'intval')                 % b is double
    if a.complex | ~isreal(b)             % complex case
      if ~a.complex
        setround(1)
        a.mid = a.inf + 0.5*(a.sup-a.inf);
        a.rad = a.mid - a.inf;
      end
      c.complex = 1;
      c.inf = [];
      c.sup = [];
      if ~a.complex | isreal(b)           % IC .* R  or  IC .* C
        setround(-1)
        c1 = a.mid .* b;
        setround(1)
        c2 = a.mid .* b;
      else                                % IC .* C
        setround(-1)
        c1 = real(a.mid) .* real(b) + (-imag(a.mid)) .* imag(b) + ...
             ( real(a.mid) .* imag(b) + imag(a.mid) .* real(b) ) * j;
        setround(1)
        c2 = real(a.mid) .* real(b) + (-imag(a.mid)) .* imag(b) + ...
             ( real(a.mid) .* imag(b) + imag(a.mid) .* real(b) ) * j;
      end
      c.mid = c1 + 0.5*(c2-c1);           % R .* IC  or  C .* IC
      c.rad = abs(c.mid-c1);
      if ~isequal(a.rad,0)                % make sure c.rad remains sparse
        c.rad = c.rad + a.rad .* abs(b) ;
      end
      % too rare, improvement doesn't pay
%       if huge
%         [cradi,cradj] = find(c.rad);
%         if ~any(find(cradi))              % take care of huge arrays
%           c.rad = 0;
%         end
%       else
%         if ~any(find(c.rad))
%           c.rad = 0;
%         end
%       end
    else                                  % real case  IR .* R
      c.complex = 0;
      setround(-1)
      c.inf = min( a.inf .* b , a.sup .* b );
      setround(1)
      c.sup = max( a.inf .* b , a.sup .* b );
      c.mid = [];
      c.rad = [];
    end
  else                                    % both a and b interval
    if a.complex | b.complex              % complex case
      if ~a.complex
        setround(1)
        a.mid = a.inf + 0.5*(a.sup-a.inf);
        a.rad = a.mid - a.inf;
      end
      if ~b.complex
        setround(1)
        b.mid = b.inf + 0.5*(b.sup-b.inf);
        b.rad = b.mid - b.inf;
      end
      c.complex = 1;
      c.inf = [];
      c.sup = [];
      if ~a.complex | ~b.complex          % one real factor
        setround(-1)
        c1 = a.mid .* b.mid;
        setround(1)
        c2 = a.mid .* b.mid;
      else
        setround(-1)
        c1 = real(a.mid) .* real(b.mid) + (-imag(a.mid)) .* imag(b.mid) + ...
             ( real(a.mid) .* imag(b.mid) + imag(a.mid) .* real(b.mid) ) * j;
        setround(1)
        c2 = real(a.mid) .* real(b.mid) + (-imag(a.mid)) .* imag(b.mid) + ...
             ( real(a.mid) .* imag(b.mid) + imag(a.mid) .* real(b.mid) ) * j;
      end
      c.mid = c1 + 0.5*(c2-c1);           % IR .* IC  or  IC .* IC
      c.rad = abs(c.mid-c1);
      if ~isequal(a.rad,0)                % make sure c.rad remains sparse
        if ~isequal(b.rad,0)
          c.rad = c.rad + a.rad .* ( abs(b.mid) + b.rad );
        else
          c.rad = c.rad + a.rad .* abs(b.mid);
        end
      end
      if ~isequal(b.rad,0)
        c.rad = c.rad + abs(a.mid) .* b.rad;
      end
      % too rare, improvement doesn't pay
%       if huge
%         [cradi,cradj] = find(c.rad);
%         if ~any(find(cradi))              % take care of huge arrays
%           c.rad = 0;
%         end
%       else
%         if ~any(find(c.rad))
%           c.rad = 0;
%         end
%       end
    else                                  % real case  IR .* IR
      c.complex = 0;
      %setround(-1)
      c.inf = min( a.inf .* b.inf , a.inf .* b.sup );
      c.inf = min( c.inf , a.sup .* b.inf );
      c.inf = min( c.inf , a.sup .* b.sup );
      %setround(1)
      c.sup = max( a.inf .* b.inf , a.inf .* b.sup );
      c.sup = max( c.sup , a.sup .* b.inf );
      c.sup = max( c.sup , a.sup .* b.sup );
      c.mid = [];
      c.rad = [];
    end
  end

  INTLAB_SPARSE_BUG = getappdata(0,'INTLAB_SPARSE_BUG');
  if INTLAB_SPARSE_BUG
    % take care of Matlab sparse NaN bug
    if huge                                       % huge linear indices, for simplicity inf*x=NaN
      if c.complex
        [m,n] = size(c.mid);
      else
        [m,n] = size(c.inf);
      end
      if issparse(a)
        index = any( isnan(b) | isinf(b) );
        if any(index(:))                          % keep linear index small
          [indexi,indexj] = find(isnan(b));
          cNaN = sparse(indexi,indexj,NaN,m,n);
          [ia,ja,aa] = find(mag(a));
          [ib,jb,bb] = find(mag(b));
          ab = sparse([ia;ib],[ja;jb],[complex(aa(:),0);complex(0,bb(:))],m,n);
          [indexi,indexj,ab] = find(ab);
          index = isinf(imag(ab));
          ab = real(ab);
          ab(index & (ab==0)) = NaN;
          ab(~isnan(ab)) = 0;
          cNaN = cNaN + sparse(indexi,indexj,ab,m,n);
          if c.complex
            c.mid = c.mid + cNaN;
            if isequal(c.rad,0)
              c.rad = cNaN;                       % scalar + sparse = full also for scalar=0
            else
              c.rad = c.rad + cNaN;
            end
          else
            c.inf = c.inf + cNaN;
            c.sup = c.sup + cNaN;
          end
        end
      end
      if issparse(b)
        index = any( isnan(a) | isinf(a) );
        if any(index(:))                          % keep linear index small
          [indexi,indexj] = find(isnan(a));
          cNaN = sparse(indexi,indexj,NaN,m,n);
          [ia,ja,aa] = find(mag(a));
          [ib,jb,bb] = find(mag(b));
          ab = sparse([ia;ib],[ja;jb],[complex(0,aa(:));complex(bb(:),0)],m,n);
          [indexi,indexj,ab] = find(ab);
          index = isinf(imag(ab));
          ab = real(ab);
          ab(index & (ab==0)) = NaN;
          ab(~isnan(ab)) = 0;
          cNaN = cNaN + sparse(indexi,indexj,ab,m,n);
          if c.complex
            c.mid = c.mid + cNaN;
            if isequal(c.rad,0)
              c.rad = cNaN;                       % scalar + sparse = full also for scalar=0
            else
              c.rad = c.rad + cNaN;
            end
          else
            c.inf = c.inf + cNaN;
            c.sup = c.sup + cNaN;
          end
        end
      end
    else
      Index = logical(0);
      if issparse(a) & ( prod(size(a))~=1 )     % sparse scalar is handled correctly by Matlab
        Index = isnan(b);
        if any(Index(:))
          if prod(size(b))==1
            Index = find( a==0 );					      % may be almost full
          end
        end
        index = find(isinf(b));
        if any(index)
          if prod(size(b))==1                   % a is scalar
            index = find( a==0 );               % may be almost full
          else                                  % a and b not scalar, same size
            if isa(a,'intval')
              if a.complex
                if isequal(a.rad,0)
                  index( a.mid(index)~=0 ) = [];
                else
                  index( ( a.mid(index)~=0 ) | ( a.rad(index)~=0 ) ) = [];
                end
              else
                index( ( a.inf(index)~=0 ) | ( a.sup(index)~=0 ) ) = [];
              end
            else
              index( a(index)~=0 ) = [];
            end
          end
          Index(index) = 1;
        end
      end
      if issparse(b) & ( prod(size(b))~=1 )     % sparse scalar is handled correctly by Matlab
        Index = Index | isnan(a);
        if any(Index(:))
          if prod(size(a))==1
            Index = find( b==0 );					      % may be almost full
          end
        end
        index = find(isinf(a));
        if any(index)
          if prod(size(a))==1                   % a is scalar
            index = find( b==0 );               % may be almost full
          else                                  % a and b not scalar, same size
            if isa(b,'intval')
              if b.complex
                if isequal(b.rad,0)
                  index( b.mid(index)==0 ) = [];
                else
                  index( ( b.mid(index)~=0 ) | ( b.rad(index)~=0 ) ) = [];
                end
              else
                index( ( b.inf(index)~=0 ) | ( b.sup(index)~=0 ) ) = [];
              end
            else
              index( b(index)~=0 ) = [];
            end
          end
          Index(index) = 1;
        end
      end
      if any(Index(:))
        if c.complex
          c.mid(Index) = NaN;
          if isequal(c.rad,0)
            [m,n] = size(c.mid);
            c.rad = sparse([],[],[],m,n);
          end
          c.rad(Index) = NaN;
        else
          c.inf(Index) = NaN;
          c.sup(Index) = NaN;
        end
      end
    end
  end

  % non-interval output for performance improvement for hessians
  if nargin==2
    c = class(c,'intval');
  end

  setround(rndold)


 function Xk = nufft_table_adj(st, X, order, flips, om)
%function Xk = nufft_table_adj(st, X, order, flips, om)
%| adjoint of table-based nufft interpolation.
%|
%| in
%|	st		structure from nufft_init
%|	X [M,nc]	DTFT values (usually nc=1)
%|	order	0|1	0th or 1st-order interpolation
%|			default is 0 for backward compatability
%|	flips	0|1	sign flips? (for real table with even N)
%|	om [M,1]	optional (default st.om)
%|
%| out
%|	Xk [*Kd,nc]	DFT coefficients
%|
%| Copyright 2004-3-30, Jeff Fessler and Yingying Zhang, University of Michigan

if nargin < 2, ir_usage, end

if ~isvar('order') || isempty(order)
	order = 0; % default 0th order for backward compatability
end

if ~isvar('flips') || isempty(flips)
	flips = zeros(size(st.Nd)); % default no flips for backward compatability
end

if nargin < 4
	om = st.om;
end

dd = length(st.Kd);

tm = zeros(size(om)); % must be double for mex file!
for id=1:dd
	gam = 2*pi / st.Kd(id);
	tm(:,id) = om(:,id) / gam; % t = omega / gamma
end

if size(X,1) ~= size(om,1)
	fail 'X size problem'
end

nc = size(X,2);

% adjoint of phase shift
class_X = class(X);
if isfield(st, 'phase_shift') && ~isempty(st.phase_shift)
	X = X .* repmat(conj(st.phase_shift), [1 nc]);
end

% convert X to complex double for mex file
if ~isa(X, 'double'), X = double(X); end

arg = {int32(st.Jd), int32(st.Ld), double(tm), int32(st.Kd(1:dd)), ...
	int32(order), int32(flips)};

X = complexify(X);

switch dd
case 1
	Xk = interp1_table_adj_mex(X, st.h{1}, arg{:});

case 2
	Xk = interp2_table_adj_mex(X, st.h{1}, st.h{2}, arg{:});

case 3
	Xk = interp3_table_adj_mex(X, st.h{1}, st.h{2}, st.h{3}, arg{:});

case 4
	Xk = interp4_table_adj_mex(X, st.h{1}, st.h{2}, st.h{3}, st.h{4}, arg{:});

otherwise
	fail '> 4d not done'
end
Xk = cast(Xk, class_X);


function [S] = co2_sw(x)
% co2_sw.m
% Downloaded from the personal page of Professor Sigurd Skogestad
% http://www.nt.ntnu.no/users/skoge/diplom/prosjekt03/wold/MatLab/
[S] = Helmholtz_anonymous_23829804(x);

function [S] = Helmholtz_anonymous_23829804(x)

[S] = StandardState_anonymous_23817360(x);

function [S] = StandardState_anonymous_23817360(x)

[S]      = EquationOfState_anonymous_23031408(x);
i        = [3];
[S_1]    = MuT_cp_dippr_23809380(x(1));
S.g(1)   = S.g(1) + S_1.dmudT'*x(i);
S.g(i)   = S.g(i) + S_1.mu;
S.H(1,1) = S.H(1,1) + S_1.d2mudTdT'*x(i);
S.H(i,1) = S.H(i,1) + S_1.dmudT;
S.H(1,i) = S.H(i,1)';

function [S] = EquationOfState_anonymous_23031408(x)

[S]   = EquationOfState_anonymous_22908308(x);
[S_1] = ModTVN_ideal_idealgas_23028984(x);
S.g   = S.g + S_1.g;
S.H   = S.H + S_1.H;

function [S] = EquationOfState_anonymous_22908308(x)

[S] = ModTVN_sw_0_5_7_0_23818404(x);

function [S] = ModTVN_sw_0_5_7_0_23818404(x)

R               = 8.314511984;
T_c             = 304.1282;
rho_c           = 10624.90627;
tau             = T_c/x(1);
delta           = x(3)/x(2)/rho_c;
N               = x(3);
a_1             = [0.89875108;-2.1281985;-0.06819032;0.076355306;0.00022053253];
t_1             = [0.25;1.25;1.5;0.25;0.875];
d_1             = [1.0;1.0;1.0;3.0;7.0];
a_2             = [0.41541823;0.71335657;0.00030354234;-0.36643143;-0.0014407781;-0.089166707;-0.023699887];
t_2             = [2.375;2.0;2.125;3.5;6.5;4.75;12.5];
d_2             = [1.0;2.0;5.0;1.0;1.0;4.0;2.0];
p_2             = [1.0;1.0;1.0;2.0;2.0;2.0;3.0];
u_2             = d_2 - p_2.*delta.^p_2;
v_2             = exp(-delta.^p_2);
phir            = a_1'*(delta.^d_1.*tau.^t_1) + a_2'*(v_2.*delta.^d_2.*tau.^t_2);
phi_taur        = a_1'*(delta.^d_1.*t_1.*tau.^(t_1 - 1)) + a_2'*(v_2.*delta.^d_2.*t_2.*tau.^(t_2 - 1));
phi_deltar      = a_1'*(d_1.*delta.^(d_1 - 1).*tau.^t_1) + a_2'*(v_2.*delta.^(d_2 - 1).*u_2.*tau.^t_2);
phi_tautaur     = a_1'*(delta.^d_1.*t_1.*(t_1 - 1).*tau.^(t_1 - 2)) + a_2'*(v_2.*delta.^d_2.*t_2.*(t_2 - 1).*tau.^(t_2 - 2));
phi_deltadeltar = a_1'*(d_1.*(d_1 - 1).*delta.^(d_1 - 2).*tau.^t_1) + a_2'*(v_2.*delta.^(d_2 - 2).*(u_2.*(u_2 - 1) - p_2.^2.*delta.^p_2).*tau.^t_2);
phi_deltataur   = a_1'*(d_1.*delta.^(d_1 - 1).*t_1.*tau.^(t_1 - 1)) + a_2'*(v_2.*delta.^(d_2 - 1).*t_2.*u_2.*tau.^(t_2 - 1));
g_1             = N*R*(phir - tau*phi_taur);
g_2             = -R*T_c*rho_c*delta^2*phi_deltar/tau;
g_i             = R*T_c*(phir + delta*phi_deltar)/tau;
H_11            = N*R*tau^3*phi_tautaur/T_c;
H_21            = -R*delta^2*rho_c*(phi_deltar - tau*phi_deltataur);
H_i1            = R*(phir - tau*phi_taur + delta*(phi_deltar - tau*phi_deltataur));
H_22            = R*T_c*rho_c^2*delta^3*(delta*phi_deltadeltar + 2*phi_deltar)/(tau*N);
H_i2            = -R*T_c*rho_c*delta^2*(delta*phi_deltadeltar + 2*phi_deltar)/(tau*N);
H_ii            = R*T_c*delta*(delta*phi_deltadeltar + 2*phi_deltar)/(tau*N);
S.g             = [g_1;g_2;g_i];
S.H             = [H_11,H_21,H_i1;H_21,H_22,H_i2;H_i1,H_i2,H_ii];

function [S] = ModTVN_ideal_idealgas_23028984(x)

R     = 8.314511984;
pcirc = [101325.0];
xcirc = [1.0];
T     = x(1);
V     = x(2);
i     = [3];
n     = x(i);
NR    = sum(n)*R;
NRT   = NR*T;
e     = [1];
p     = R*log(R*T*(n./pcirc)/V);
g_1   = n'*p;
g_2   = -NRT/V;
g_i   = T*p;
H_11  = NR/T;
H_21  = -NR/V;
H_i1  = p + R*e;
H_22  = NRT/V^2;
H_i2  = -R*(T/V)*e;
H_ii  = R*T*diag(e./n);
S.g   = [g_1;g_2;g_i];
S.H   = [H_11,H_21',H_i1';H_21,H_22,H_i2';H_i1,H_i2,H_ii];

function [S] = MuT_cp_dippr_23809380(T)

t_0        = [298.15];
t_min      = [50.0];
t_max      = [5000.0];
C          = [29.37,34.54,1428.0,26.4,588.0];
c_1        = C(:,1);
c_2        = C(:,2);
c_3        = C(:,3);
c_4        = C(:,4);
c_5        = C(:,5);
c_p        = c_1 + c_2.*c_3.^2./(T^2*sinh(c_3/T).^2) + c_4.*c_5.^2./(T^2*cosh(c_5/T).^2);
h          = c_1*T + c_2.*c_3.*cosh(c_3/T)./sinh(c_3/T) - c_4.*c_5.*sinh(c_5/T)./cosh(c_5/T) - c_1.*t_0 - c_2.*c_3.*cosh(c_3./t_0)./sinh(c_3./t_0) + c_4.*c_5.*sinh(c_5./t_0)./cosh(c_5./t_0);
s          = c_1*log(T) + c_4.*(log(cosh(c_5/T)) - c_5.*sinh(c_5/T)./cosh(c_5/T)/T) + c_2.*(c_3.*cosh(c_3/T)./sinh(c_3/T)/T - log(sinh(c_3/T))) - c_1.*log(t_0) - c_4.*(log(cosh(c_5./t_0)) - c_5.*sinh(c_5./t_0)./cosh(c_5./t_0)./t_0) - c_2.*(c_3.*cosh(c_3./t_0)./sinh(c_3./t_0)./t_0 - log(sinh(c_3./t_0)));
S.mu       = h - T*s;
S.dmudT    = -s;
S.d2mudTdT = -(c_p/T);
i          = [1];
[S_1]      = MuT_hs_h0_23796420(T);
S.mu(i)    = S.mu(i) + S_1.mu;
S.dmudT(i) = S.dmudT(i) + S_1.dmudT;

function [S] = MuT_hs_h0_23796420(T)

hcirc   = [-393510.0];
[S]     = MuT_hs_s0_23790264(T);
S.mu    = S.mu + hcirc;
S.dmudT = S.dmudT + [0];

function [S] = MuT_hs_s0_23790264(T)

scirc   = [213.677];
S.mu    = -(T*scirc);
S.dmudT = -scirc;


% DESCRIPTION:
%       subscript to scale source terms to the correct units
%
% ABOUT:
%       author      - Bradley Treeby
%       date        - 15th February 2012
%       last update - 20th January 2014
%
% This function is part of the k-Wave Toolbox (http://www.k-wave.org)
% Copyright (C) 2009-2014 Bradley Treeby and Ben Cox

% This file is part of k-Wave. k-Wave 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.
%
% k-Wave 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 Lesser General Public License
% along with k-Wave. If not, see <http://www.gnu.org/licenses/>.

% get the dimension size
N = kgrid.dim;

% check for non-uniform grid and give error for source terms that haven't
% yet been implemented
if (nonuniform_grid && ( uy_source || uz_source || transducer_source))
    disp('WARNING: source scaling not implemented for non-uniform grids with given source condition');
    return
end

% Scale the input pressure by 1/c^2 (to convert to units of density), then
% by 1/N (to split the input across the split density field). If the
% pressure is injected as a mass source, also scale the pressure by
% 2*dt*c/dx to account for the time step and convert to units of
% [kg/(m^3 s)]
if p_source
    if strcmp(source.p_mode, 'dirichlet')
        if numel(c) == 1
            % compute the scale parameter based on the homogeneous
            % sound speed
            source.p = source.p ./ (N*c^2);
        else
            % compute the scale parameter seperately for each source
            % position based on the sound speed at that position
            for p_index = 1:length(source.p(:,1))
                source.p(p_index, :) = source.p(p_index, :) ./ (N*c(p_source_index(p_index))^2);
            end
        end
    else
        if nonuniform_grid

            % create empty matrix
            grid_point_sep = zeros(size(kgrid.x));

            % compute averaged grid point seperation map, the interior
            % points are calculated using the average distance to all
            % connected grid points (the edge values are not calculated
            % assuming there are no source points in the PML)
            switch kgrid.dim
                case 1
                    grid_point_sep(2:end-1) = kgrid.x_size*(kgrid.xn(3:end, 1) - kgrid.xn(1:end-2, 1))/2;
                case 2
                    grid_point_sep(2:end-1, 2:end-1) = ...
                        kgrid.x_size*(kgrid.xn(3:end, 2:end-1) - kgrid.xn(1:end-2, 2:end-1))/4 + ...
                        kgrid.y_size*(kgrid.yn(2:end-1, 3:end) - kgrid.yn(2:end-1, 1:end-2))/4;
                case 3
                    grid_point_sep(2:end-1, 2:end-1, 2:end-1) = ...
                        kgrid.x_size*(kgrid.xn(3:end, 2:end-1, 2:end-1) - kgrid.xn(1:end-2, 2:end-1, 2:end-1))/6 + ...
                        kgrid.y_size*(kgrid.yn(2:end-1, 3:end, 2:end-1) - kgrid.yn(2:end-1, 1:end-2, 2:end-1))/6 + ...
                        kgrid.z_size*(kgrid.zn(2:end-1, 2:end-1, 3:end) - kgrid.zn(2:end-1, 2:end-1, 1:end-2))/6;
            end

            % compute and apply scale parameter
            for p_index = 1:length(source.p(:,1))
                if numel(c) == 1
                    % compute the scale parameter based on the homogeneous sound speed
                    source.p(p_index, :) = source.p(p_index, :) .* (2.*dt./(N*c*grid_point_sep(p_source_index(p_index))));
                else
                    % compute the scale parameter based on the sound speed at that position
                    source.p(p_index, :) = source.p(p_index, :) .* (2.*dt./(N*c(p_source_index(p_index)).*grid_point_sep(p_source_index(p_index))));
                end
            end

            % clear unused variables
            clear grid_point_sep;

        else
            if numel(c) == 1
                % compute the scale parameter based on the homogeneous
                % sound speed
                source.p = source.p .* (2*dt./(N*c*kgrid.dx));
            else
                % compute the scale parameter seperately for each source
                % position based on the sound speed at that position
                for p_index = 1:length(source.p(:,1))
                    source.p(p_index, :) = source.p(p_index, :) .* (2.*dt./(N*c(p_source_index(p_index)).*kgrid.dx));
                end
            end
        end
    end
end

% scale the stress source by 1/N to divide amoungst the split field
% components, and if source.s_mode is not set to 'dirichlet', also scale by
% 2*dt*c/dx to account for the time step and convert to units of
% [kg/(m^3 s)]
if sxx_source
    if strcmp(source.s_mode, 'dirichlet') || p0_source
        source.sxx = source.sxx ./ N;
    else
        if numel(c) == 1
            % compute the scale parameter based on the homogeneous sound
            % speed
            source.sxx = source.sxx .* (2*dt*c./(N*kgrid.dx));
        else
            % compute the scale parameter seperately for each source
            % position based on the sound speed at that position
            for s_index = 1:length(source.sxx(:,1))
                source.sxx(s_index, :) = source.sxx(s_index, :) .* (2.*dt.*c(s_source_index(s_index))./(N*kgrid.dx));
            end
        end
    end
end
if syy_source
    if strcmp(source.s_mode, 'dirichlet') || p0_source
        source.syy = source.syy ./ N;
    else
        if numel(c) == 1
            % compute the scale parameter based on the homogeneous sound
            % speed
            source.syy = source.syy .* (2*dt*c./(N*kgrid.dx));
        else
            % compute the scale parameter seperately for each source
            % position based on the sound speed at that position
            for s_index = 1:length(source.syy(:,1))
                source.syy(s_index, :) = source.syy(s_index, :) .* (2.*dt.*c(s_source_index(s_index))./(N*kgrid.dx));
            end
        end
    end
end
if szz_source
    if strcmp(source.s_mode, 'dirichlet') || p0_source
        source.szz = source.szz ./ N;
    else
        if numel(c) == 1
            % compute the scale parameter based on the homogeneous sound
            % speed
            source.szz = source.szz .* (2*dt*c./(N*kgrid.dx));
        else
            % compute the scale parameter seperately for each source
            % position based on the sound speed at that position
            for s_index = 1:length(source.szz(:,1))
                source.szz(s_index, :) = source.szz(s_index, :) .* (2.*dt.*c(s_source_index(s_index))./(N*kgrid.dx));
            end
        end
    end
end
if sxy_source
    if strcmp(source.s_mode, 'dirichlet')
        source.sxy = source.sxy ./ N;
    else
        if numel(c) == 1
            % compute the scale parameter based on the homogeneous sound
            % speed
            source.sxy = source.sxy .* (2*dt*c./(N*kgrid.dx));
        else
            % compute the scale parameter seperately for each source
            % position based on the sound speed at that position
            for s_index = 1:length(source.sxy(:,1))
                source.sxy(s_index, :) = source.sxy(s_index, :) .* (2.*dt.*c(s_source_index(s_index))./(N*kgrid.dx));
            end
        end
    end
end
if sxz_source
    if strcmp(source.s_mode, 'dirichlet')
        source.sxz = source.sxz ./ N;
    else
        if numel(c) == 1
            % compute the scale parameter based on the homogeneous sound
            % speed
            source.sxz = source.sxz .* (2*dt*c./(N*kgrid.dx));
        else
            % compute the scale parameter seperately for each source
            % position based on the sound speed at that position
            for s_index = 1:length(source.sxz(:,1))
                source.sxz(s_index, :) = source.sxz(s_index, :) .* (2.*dt.*c(s_source_index(s_index))./(N*kgrid.dx));
            end
        end
    end
end
if syz_source
    if strcmp(source.s_mode, 'dirichlet')
        source.syz = source.syz ./ N;
    else
        if numel(c) == 1
            % compute the scale parameter based on the homogeneous sound
            % speed
            source.syz = source.syz .* (2*dt*c./(N*kgrid.dx));
        else
            % compute the scale parameter seperately for each source
            % position based on the sound speed at that position
            for s_index = 1:length(source.syz(:,1))
                source.syz(s_index, :) = source.syz(s_index, :) .* (2.*dt.*c(s_source_index(s_index))./(N*kgrid.dx));
            end
        end
    end
end

% if source.u_mode is not set to 'dirichlet', scale the x-direction
% velocity source terms by 2*dt*c/dx to account for the time step and
% convert to units of [m/s^2]
if ux_source && ~strcmp(source.u_mode, 'dirichlet')

    if nonuniform_grid

        % create empty matrix
        grid_point_sep = zeros(size(kgrid.x));

        % compute averaged grid point seperation map, the interior
        % points are calculated using the average distance to all
        % connected grid points (the edge values are not calculated
        % assuming there are no source points in the PML)
        grid_point_sep(2:end-1, :, :) = kgrid.x_size*(kgrid.xn(3:end, :, :) - kgrid.xn(1:end-2, :, :))/2;

        % compute and apply scale parameter
        for u_index = 1:length(source.ux(:,1))
            if numel(c) == 1
                % compute the scale parameter based on the homogeneous sound speed
                source.ux(u_index, :) = source.ux(u_index, :) .* (2*c*dt./(grid_point_sep(u_source_index(u_index))));
            else
                % compute the scale parameter based on the sound speed at that position
                source.ux(u_index, :) = source.ux(u_index, :) .* (2*c(u_source_index(u_index))*dt./(grid_point_sep(u_source_index(u_index))));
            end
        end

        % clear unused variables
        clear grid_point_sep;

    else

        if numel(c) == 1
            % compute the scale parameter based on the homogeneous sound speed
            source.ux = source.ux .* (2*c*dt./kgrid.dx);
        else
            % compute the scale parameter seperately for each source position
            % based on the sound speed at that position
            for u_index = 1:length(source.ux(:,1))
                source.ux(u_index, :) = source.ux(u_index, :) .* (2.*c(u_source_index(u_index)).*dt./kgrid.dx);
            end
        end
    end
end

% if source.u_mode is not set to 'dirichlet', scale the y-direction
% velocity source terms by 2*dt*c/dy to account for the time step and
% convert to units of [m/s^2]
if uy_source && ~strcmp(source.u_mode, 'dirichlet')
    if numel(c) == 1
        % compute the scale parameter based on the homogeneous sound speed
        source.uy = source.uy .* (2*c*dt./kgrid.dy);
    else
        % compute the scale parameter seperately for each source position
        % based on the sound speed at that position
        for u_index = 1:length(source.uy(:,1))
            source.uy(u_index, :) = source.uy(u_index, :) .* (2.*c(u_source_index(u_index)).*dt./kgrid.dy);
        end
    end
end

% if source.u_mode is not set to 'dirichlet', scale the z-direction
% velocity source terms by 2*dt*c/dz to account for the time step and
% convert to units of [m/s^2]
if uz_source && ~strcmp(source.u_mode, 'dirichlet')
    if numel(c) == 1
        % compute the scale parameter based on the homogeneous sound speed
        source.uz = source.uz .* (2*c*dt./kgrid.dz);
    else
        % compute the scale parameter seperately for each source position
        % based on the sound speed at that position
        for u_index = 1:length(source.uz(:,1))
            source.uz(u_index, :) = source.uz(u_index, :) .* (2.*c(u_source_index(u_index)).*dt./kgrid.dz);
        end
    end
end

% scale the transducer source term by 2*dt*c/dx to account for the time
% step and convert to units of [m/s^2]
if transducer_source
    if numel(c) == 1
        transducer_input_signal = transducer_input_signal .* (2*c*dt./kgrid.dx);
    else
        % compute the scale parameter based on the average sound speed at the
        % transducer positions (only one input signal is used to drive the
        % transducer)
        transducer_input_signal = transducer_input_signal.* (2*(mean(c(u_source_index)))*dt./kgrid.dx);
    end
end

% clear subscript variables
clear N;


%%%
%
% For attention-based models, given:
%   grad_contextVecs: lstmSize * batchSize
%   alignWeights: numPositions * batchSize.
%   srcHidVecs: lstmSize * batchSize * numPositions.
% compute the following grads:
%   grad_srcHidVecs: lstmSize * batchSize * numPositions
%   grad_alignWeights: numPositions * batchSize
%
% Thang Luong @ 2015, <lmthang@stanford.edu>
%
%%%
function [grad_alignWeights, grad_srcHidVecs] = contextLayerBackprop(grad_contextVecs, alignWeights, srcHidVecs, unmaskedIds, params)
  % change from grad_contextVecs lstmSize*batchSize -> lstmSize*batchSize*1
  grad_contextVecs = permute(grad_contextVecs, [1, 2, 3]);

  %% Grad formulae:
  %   contextVecs = H_src* a_t
  %   grad_srcHidVecs: outGrad * alignWeights'
  %   grad_alignWeights = H_src' * contexGrad (per example, to scale over multiple examples, i.e., batchSize, need to use bsxfun)

  %% grad_srcHidVecs
  grad_srcHidVecs = zeroMatrix(size(srcHidVecs), params.isGPU, params.dataType);
  grad_srcHidVecs(:, unmaskedIds, :) = bsxfun(@times, grad_contextVecs(:, unmaskedIds), permute(alignWeights(:, unmaskedIds), [3, 2, 1])); % change alignWeights -> 1 * batchSize * numPositions

  %% grad_alignWeights
  grad_alignWeights = zeroMatrix(size(alignWeights), params.isGPU, params.dataType);
  if size(srcHidVecs, 3)==1
    grad_alignWeights(:, unmaskedIds) = sum(bsxfun(@times, srcHidVecs(:, unmaskedIds, :), grad_contextVecs(:, unmaskedIds)), 1); % sum across lstmSize: numPositions * batchSize
  else
    grad_alignWeights(:, unmaskedIds) = squeeze(sum(bsxfun(@times, srcHidVecs(:, unmaskedIds, :), grad_contextVecs(:, unmaskedIds)), 1))'; % sum across lstmSize: numPositions * batchSize
  end

  %% assert
  if params.assert
    assert(isequal(size(grad_alignWeights), size(alignWeights)));

    % compute grad_srcHidVec in a different way
    grad_srcHidVecs1 = zeroMatrix(size(grad_srcHidVecs), params.isGPU, params.dataType);
    for jj=1:length(unmaskedIds)
      ii = unmaskedIds(jj);
      grad_srcHidVecs1(:, ii, :) = grad_contextVecs(:, ii, 1) * alignWeights(:, ii)';
    end
    assert(computeSum(grad_srcHidVecs1-grad_srcHidVecs, params.isGPU)==0);
  end
end


%==================================================================
%                        General Data File
% Title: Default_title
% Units: SI
% Dimensions: 2D
% Type of problem: Plane_Stress
% Type of Phisics: Stokes
% Micro/Macro: MACRO
%
%==================================================================

%% Data

Data_prb = {
'TRIANGLE';
'SI';
'2D';
'Plane_Stress';
'Stokes';
'MACRO';
};

%% Coordinates
% Node                X                Y                Z

coord = [
1            0            0            0
2            0         0.25            0
3         0.25            0            0
4         0.25         0.25            0
5            0          0.5            0
6          0.5            0            0
7         0.25          0.5            0
8          0.5         0.25            0
9          0.5          0.5            0
10         0.75            0            0
11            0         0.75            0
12         0.75         0.25            0
13         0.25         0.75            0
14         0.75          0.5            0
15          0.5         0.75            0
16            1            0            0
17            0            1            0
18            1         0.25            0
19         0.25            1            0
20         0.75         0.75            0
21            1          0.5            0
22          0.5            1            0
23         0.75            1            0
24            1         0.75            0
25            1            1            0
];

%% Conectivities
% Element        Node(1)                Node(2)                Node(3)                Material

connec = [
1 6 8 3 0
2 8 9 4 0
3 3 4 1 0
4 8 4 3 0
5 9 7 4 0
6 7 5 2 0
7 4 2 1 0
8 7 2 4 0
9 16 18 10 0
10 18 21 12 0
11 10 12 6 0
12 18 12 10 0
13 21 14 12 0
14 14 9 8 0
15 12 8 6 0
16 14 8 12 0
17 9 15 7 0
18 15 22 13 0
19 7 13 5 0
20 15 13 7 0
21 22 19 13 0
22 19 17 11 0
23 13 11 5 0
24 19 11 13 0
25 21 24 14 0
26 24 25 20 0
27 14 20 9 0
28 24 20 14 0
29 25 23 20 0
30 23 22 15 0
31 20 15 9 0
32 23 15 20 0
];

%% Variable Prescribed
% Node            Dimension                Value

velocity = [
1 1 0
1 2 0
5 1 0
5 2 0
6 1 0
6 2 0
16 1 0
16 2 0
17 1 0
17 2 0
21 1 0
21 2 0
22 1 0
22 2 0
25 1 0
25 2 0
];

pressure = [
25 1 0
];

nu=1;
Vol_force = @(x,y){nu*4*(x^3*((6 - 12*y)) + x^4*((-3 + 6*y)) + y*(1 - 3*y + 2*y^2)-6*x*y*(1 - 3*y + 2*y^2)...
+ 3*x^2*((-1 + 4*y - 6*y^2 + 4*y^3)))+(2*x-1)*(y-1);
-4*nu*(-3*((-1 + y)^2)*y^2 - 3*x^2*((1 - 6*y + 6*y^2))+2*x^3*((1 - 6*y + 6*y^2)) +...
x*(1 - 6*y + 12*y^2 - 12*y^3 + 6*y^4))+x*(x-1)};

% nu=1;
% Vol_force = @(x,y){nu*4*(x^3*((6 - 12*y)) + x^4*((-3 + 6*y)) + y*(1 - 3*y + 2*y^2)-6*x*y*(1 - 3*y + 2*y^2)...
% + 3*x^2*((-1 + 4*y - 6*y^2 + 4*y^3)))+nu*y*(1 - y)*(1 - 2*x);
% -4*nu*(-3*((-1 + y)^2)*y^2 - 3*x^2*((1 - 6*y + 6*y^2))+2*x^3*((1 - 6*y + 6*y^2)) +...
% x*(1 - 6*y + 12*y^2 - 12*y^3 + 6*y^4)+x*(1 - x)*(1 - 2*y))};

%% Group Elements
% Element        Group_num

Group = [
];

%% Initial Holes
% Elements that are considered holes initially
% Element

Initial_holes = [
];

%% Boundary Elements
% Elements that can not be removed
% Element

Boundary_elements = [
];

%% Micro gauss post
%
% Element

Micro_gauss_post = [
];

%% Micro Slave-Master
% Nodes that are Slaves
% Nodes             Value (1-Slave,0-Master)

Micro_slave = [
];

%% Nodes solid
% Nodes that must remain
% Nodes

% nodesolid = unique(pointload_complete(:,1));

%% External border Elements
% Detect the elements that define the edge of the domain
% Element               Node(1)           Node(2)

External_border_elements = [
1 3 6
3 1 3
6 5 2
7 2 1
9 16 18
9 10 16
10 18 21
11 6 10
21 22 19
22 17 11
22 19 17
23 11 5
25 21 24
26 24 25
29 25 23
30 23 22
];

%% External border Nodes
% Detect the nodes that define the edge of the domain
% Node

External_border_nodes = [
];

%% Materials
% Materials that have been used
% Material_Num              Mat_density        Young_Modulus        Poisson

Materials = [
];


function [pdc, pdcvar, n] = ft_connectivity_pdc(input, varargin)

% FT_CONNECTIVITY_PDC computes partial directed coherence. This function implements
% the metrices described in Baccala et al., Biological Cybernetics 2001, 84(6),
% 463-74. and in Baccala et al., 15th Int.Conf.on DSP 2007, 163-66.
%
% The implemented algorithm has been tested against the implementation in the
% SIFT-toolbox. It yields numerically identical results to what is known there as
% 'nPDC' (for PDC) and 'GPDC' for generalized pdc.
%
% Use as
%   [p, v, n] = ft_connectivity_pdc(h, key1, value1, ...)
%
% The input argument H should be a spectral transfer matrix organized as
%   Nrpt x Nchan x Nchan x Nfreq (x Ntime),
% where Nrpt can be 1.
%
% Additional optional input arguments come as key-value pairs:
%   'hasjack'  = 0 (default) is a boolean specifying whether the input
%                contains leave-one-outs, required for correct variance
%                estimate
%   'feedback' = string, determining verbosity (default = 'none'), see FT_PROGRESS
%   'invfun'   = 'inv' (default) or 'pinv', the function used to invert the
%                transfer matrix to obtain the fourier transform of the
%                MVAR coefficients. Use 'pinv' if the data are
%                poorly-conditioned.
%   'noisecov' = matrix containing the covariance of the residuals of the
%                MVAR model. If this matrix is defined, the function
%                returns the generalized partial directed coherence.
%
% Output arguments:
%   p = partial directed coherence matrix Nchan x Nchan x Nfreq (x Ntime).
%       If multiple observations in the input, the average is returned.
%   v = variance of p across observations.
%   n = number of observations.
%
% Typically, nrpt should be 1 (where the spectral transfer matrix is
% computed across observations. When nrpt>1 and hasjack is true the input
% is assumed to contain the leave-one-out estimates of H, thus a more
% reliable estimate of the relevant quantities.
%
% See also FT_CONNECTIVITYANALYSIS

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

hasjack  = ft_getopt(varargin, 'hasjack', 0);
feedback = ft_getopt(varargin, 'feedback', 'none');
invfun   = ft_getopt(varargin, 'invfun', 'inv');
noisecov = ft_getopt(varargin, 'noisecov');

switch invfun
  case {'inv' 'pinv'}
    invfun = str2func(invfun);
  otherwise
    ft_error('unknown specification of inversion-function for the transfer matrix');
end

% crossterms are described by chan_chan_therest
siz = [size(input) 1];
n   = siz(1);

if ~isempty(noisecov)
  ft_progress('init', feedback, 'computing generalized partial directed coherence...');
  scale = diag(sqrt(1./diag(noisecov))); % get the 1./sqrt(var) of the signals
else
  ft_progress('init', feedback, 'computing partial directed coherence...');
  scale = eye(siz(2));
end

% pre-allocate some variables
outsum = zeros(siz(2:end));
outssq = zeros(siz(2:end));

% the mathematics for pdc is most straightforward using the inverse of the
% transfer function
pdim     = prod(siz(4:end));
tmpinput = reshape(input, [siz(1:3) pdim]);
ft_progress('init', feedback, 'inverting the transfer function...');
for k = 1:n
  ft_progress(k/n, 'inverting the transfer function for replicate %d from %d\n', k, n);
  tmp = reshape(tmpinput(k,:,:,:), [siz(2:3) pdim]);
  for m = 1:pdim
    tmp(:,:,m) = scale*invfun(tmp(:,:,m));
  end
  tmpinput(k,:,:,:) = tmp;
end
ft_progress('close');
input = reshape(tmpinput, siz);

for j = 1:n
  ft_progress(j/n, 'computing metric for replicate %d from %d\n', j, n);
  invh   = reshape(input(j,:,:,:,:), siz(2:end));

  den    = sum(abs(invh).^2,1);
  tmppdc = abs(invh)./sqrt(repmat(den, [siz(2) 1 1 1 1]));

  outsum = outsum + tmppdc;
  outssq = outssq + tmppdc.^2;
end
ft_progress('close');

pdc = outsum./n;

if n>1
  if hasjack
    bias = (n-1).^2;
  else
    bias = 1;
  end
  pdcvar = bias*(outssq - (outsum.^2)./n)./(n - 1);
else
  pdcvar = [];
end

% this is to achieve the same convention for all connectivity metrics:
% row -> column
for k = 1:prod(siz(4:end))
  pdc(:,:,k)    = transpose(pdc(:,:,k));
  if ~isempty(pdcvar)
    pdcvar(:,:,k) = transpose(pdcvar(:,:,k));
  end
end


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

function [c,fc] = FInvSABR4_1(x, f)
% This function computes the inverse of a SABR cumulative distribution
% Since it is based on FSABR2 it is very fast and works for vectors!
f2 = @(t) (x - FSABR2_1(t,f));

% Use simple bisection
a = 0.00001 * ones(1,length(x)); % left starting points
b = 1*ones(1,length(x));        % right starting points

eps = 1e-3;                     % accuracy level
k = 0;                          % init iteration counter

c=(b+a)/2;
fc = f2(c);
% Ind = -eps <= fc & fc <= eps;
while(k <= 200)
    k = k+1;                            % increase iteration counter
%     if sum(Ind) == length(x)
%         break;
%     else
%         b(fc(Ind)<0) = 0.5*(b(fc(Ind)<0)+a(fc(Ind)<0));               % update right boundary
%         a(fc(Ind)>=0) = 0.5*(b(fc(Ind)>=0)+a(fc(Ind)>=0));            % update left boundary
%     end
%     c(Ind) = 0.5*(b(Ind)+a(Ind));
%     fc = f2(c);
%     Ind = -eps <= fc & fc <= eps;

    if( (-eps <= min(fc)) & (max(fc) <= eps))
        break;                          % end if all values have been found
    else
        b(fc<0) = 0.5*(b(fc<0)+a(fc<0));               % update right boundary
        a(fc>=0) = 0.5*(b(fc>=0)+a(fc>=0));            % update left boundary
    end
    c = 0.5*(b+a);
    fc = f2(c);                         % evaluate function at new c
end

end


function HamilExp = DoublePendulumEnergy(in1,in2)
%DOUBLEPENDULUMENERGY
%    HAMILEXP = DOUBLEPENDULUMENERGY(IN1,IN2)

%    This function was generated by the Symbolic Math Toolbox version 8.2.
%    21-Sep-2019 22:29:59

dz1 = in2(:,1);
dz2 = in2(:,2);
z1 = in1(:,1);
z2 = in1(:,2);
HamilExp = cos(z1).*(2.09e2./2.0e2)+cos(z2).*3.268e-1+dz1.^2.*1.376e-2+dz2.^2.*3.272e-3+dz1.*dz2.*cos(z1-z2).*8.885000000000001e-3;


function [ok, pns_norm, pns_comp, t_axis]=calcPNS(obj,hardware,doPlots)
% calculate PNS using safe model implementation by Szczepankiewicz and Witzel
% assumes safe_pns_prediction package has been downloaded and installed in
% Matlab path. See http://github.com/filip-szczepankiewicz/safe_pns_prediction
%
% returns pns levels due to respective axes (normalized to 1 and not to 100%)
%
% inputs:
%     hardware - hardware specifications. see safe_example_hw() from
%                the safe_pns_prediction package. Alternatively a text file
%                in the .asc format (Siemens) can be passed, e.g. for Prisma
%                it is MP_GPA_K2309_2250V_951A_AS82.asc (we leave it as an
%                exercise to the interested user to find were these files
%                can be acquired from);
%     doPlots  - optional parameter (defaluts to true)

if nargin < 3
    doPlots=true;
end

% acquire the entire gradient wave form
gw=obj.waveforms_and_times();
if doPlots
    figure;
    plot(gw{1}(1,:),gw{1}(2,:),gw{2}(1,:),gw{2}(2,:),gw{3}(1,:),gw{3}(2,:)); % plot the entire gradient shape
    title('gradient wave form, in T/m');
end

% find beginning and end times and resample GWs to a regular sampling raster
tf=[];
tl=[];
for i=1:3
    if size(gw{i},2)>0
        tf(end+1)=gw{i}(1,1);
        tl(end+1)=gw{i}(1,end);
    end
end
nt_min=floor(min(tf)/obj.gradRasterTime+eps);
nt_max=ceil(max(tl)/obj.gradRasterTime-eps);
% shift raster positions to the centers of the raster periods
nt_min = nt_min + 0.5;
nt_max = nt_max - 0.5;
if (nt_min<0.5)
    nt_min=0.5
end
t_axis=(nt_min:nt_max)*obj.gradRasterTime;
gwr=zeros(length(t_axis),3);
for i=1:3
    if size(gw{i},2)>0
        gwr(:,i)=interp1(gw{i}(1,:),gw{i}(2,:),t_axis,'linear',0);
    end
end

if ischar(hardware)
    % this loads the parameters from the provided text file
    asc=mr.Siemens.readasc(hardware);
    hardware=asc_to_hw(asc);
end

% use the Szczepankiewicz' and Witzel's implementation
[pns_comp,res]=safe_gwf_to_pns(gwr/obj.sys.gamma, NaN*ones(length(t_axis),1), obj.gradRasterTime, hardware); % the RF vector is unused in the code inside but it is zeropaded and exported ...
% use the exported RF vector to detect and undo zerpopadding
pns_comp=0.01*pns_comp(~isfinite(res.rf),:)';
% calc pns_norm and the final ok/not_ok
pns_norm=vecnorm(pns_comp);
ok=all(pns_norm<1);
% ready
if doPlots
    % plot results
    figure;safe_plot(pns_comp'*100, obj.gradRasterTime);
end

end

% local utility functions

function hw = asc_to_hw(asc)
% function hw = asc_to_hw(asc)
%
% SAFE model parameters for the asc structure as read from the asc file.
% See comments for units.
%
% Maxim Zaitsev 08/10/2019

if isfield(asc,'asCOMP') && isfield(asc.asCOMP,'tName')
    hw.name          = asc.asCOMP(1).tName;
else
    hw.name          = 'unknown';
end
%hw.look_ahead    =  1.0; % MZ: this is not a real hardware parameter but a coefficient, with which the final result is multiplied

hw.x.tau1        = asc.flGSWDTauX(1);  % ms
hw.x.tau2        = asc.flGSWDTauX(2);  % ms
hw.x.tau3        = asc.flGSWDTauX(3);  % ms
hw.x.a1          = asc.flGSWDAX(1);
hw.x.a2          = asc.flGSWDAX(2);
hw.x.a3          = asc.flGSWDAX(3);
hw.x.stim_limit  = asc.flGSWDStimulationLimitX;  % T/m/s
hw.x.stim_thresh = asc.flGSWDStimulationThresholdX;  % T/m/s
hw.x.g_scale     = asc.asGPAParameters.sGCParameters.flGScaleFactorX;

hw.y.tau1        = asc.flGSWDTauY(1);  % ms
hw.y.tau2        = asc.flGSWDTauY(2);  % ms
hw.y.tau3        = asc.flGSWDTauY(3);  % ms
hw.y.a1          = asc.flGSWDAY(1);
hw.y.a2          = asc.flGSWDAY(2);
hw.y.a3          = asc.flGSWDAY(3);
hw.y.stim_limit  = asc.flGSWDStimulationLimitY;  % T/m/s
hw.y.stim_thresh = asc.flGSWDStimulationThresholdY;  % T/m/s
hw.y.g_scale     = asc.asGPAParameters.sGCParameters.flGScaleFactorY;

hw.z.tau1        = asc.flGSWDTauZ(1);  % ms
hw.z.tau2        = asc.flGSWDTauZ(2);  % ms
hw.z.tau3        = asc.flGSWDTauZ(3);  % ms
hw.z.a1          = asc.flGSWDAZ(1);
hw.z.a2          = asc.flGSWDAZ(2);
hw.z.a3          = asc.flGSWDAZ(3);
hw.z.stim_limit  = asc.flGSWDStimulationLimitZ;  % T/m/s
hw.z.stim_thresh = asc.flGSWDStimulationThresholdZ;  % T/m/s
hw.z.g_scale     = asc.asGPAParameters.sGCParameters.flGScaleFactorZ;
end


function linpack_bench_backslash ( n, lda )

%*****************************************************************************80
%
%% LINPACK_BENCH_BACKSLASH drives the "backslash" LINPACK benchmark program.
%
%  Discussion:
%
%    This version of the program uses the MATLAB "backslash" operator
%    to factor and solve the linear system.
%
%    The standard LINPACK benchmark uses N = 1000, LDA = N + 1.
%
%  Modified:
%
%    22 May 2008
%
%  Author:
%
%    MATLAB version by John Burkardt.
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.  If no value is supplied,
%    the default value of 1000 is used.
%
%    Input, integer LDA, the leading dimension of the matrix.
%    If no value is supplied, the default value of N+1 is used.
%
  timestamp ( );

  if ( nargin < 1 )
    n = 1000;
  end

  if ( nargin < 2 )
    lda = n + 1;
  end

  cray = 0.056;
  ops = ( 2 * n * n * n ) / 3.0 + 2.0 * n * n;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'LINPACK_BENCH_BACKSLASH\n' );
  fprintf ( 1, '  The LINPACK benchmark (using the MATLAB "backslash" operator).\n' );
  fprintf ( 1, '  Language: MATLAB\n' );
  fprintf ( 1, '  Datatype: Real Double Precision\n' );
  fprintf ( 1, '  Matrix order N        = %d\n', n );
  fprintf ( 1, '  Leading dimension LDA = %d\n', lda );

  a = r8_matgen ( n, n );

  a_max = max ( max ( a(1:n,1:n) ) );

  x_true(1:n,1) = 1.0;
  b(1:n,1) = a(1:n,1:n) * x_true(1:n,1);

  t1 = cputime;

  x = a \ b;

  t2 = cputime;
  time(1) = t2 - t1;
  time(2) = 0;

  total = time(1) + time(2);
%
%  Compute a residual to verify results.
%
  a = r8_matgen ( n, n );

  resid(1:n,1) = a(1:n,1:n) * x(1:n,1) - b(1:n,1);
  resid_max = max ( abs ( resid(1:n,1) ) );

  x_max = max ( abs ( x(1:n,1) ) );

  residn = resid_max /  ( n * a_max * x_max * eps );

  time(3) = total;
  time(4) = ops / ( 1000000 * total );
  time(5) = 2.0 / time(4);
  time(6) = total / cray;

  fprintf ( 1, '\n' );
  fprintf ( 1, '     Norm. Resid      Resid           MACHEP' );
  fprintf ( 1, '         X(1)          X(N)\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  %14e  %14e  %14e  %14f  %14f\n', ...
    residn, resid_max, eps, x(1,1), x(n,1) );
  fprintf ( 1, '\n' );
  fprintf ( 1, '      Factor     Solve      Total     MFLOPS' );
  fprintf ( 1, '       Unit      Cray-Ratio\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  %9f  %9f  %9f  %9f  %9f  %9f\n', time(1:6) );

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

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

  return
end
function a = r8_matgen ( lda, n )

%*****************************************************************************80
%
%% R8_MATGEN generates a random matrix.
%
%  Modified:
%
%    08 June 2005
%
%  Author:
%
%    MATLAB version by John Burkardt
%
%  Parameters:
%
%    Input, integer LDA, the leading dimension of the matrix.
%
%    Input, integer N, the order of the matrix.
%
%    Output, real A(LDA,N), the N by N matrix.
%
  a = zeros ( lda, n );

  init(1:4) = [ 1, 2, 3, 1325 ];

  for j = 1 : n
     for i = 1 : n
       [ a(i,j), init ] = r8_random ( init );
    end
  end

  a(1:n,1:n) = a(1:n,1:n) - 0.5;

  return
end
function [ value, seed ] = r8_random ( seed )

%*****************************************************************************80
%
%% R8_RANDOM returns a uniformly distributed random number between 0 and 1.
%
%  Discussion:
%
%    This routine uses a multiplicative congruential method with modulus
%    2**48 and multiplier 33952834046453.
%
%    48-bit integers are stored in 4 integer array elements with 12 bits
%    per element.  Hence the routine is portable across machines with
%    integers of 32 bits or more.
%
%  Modified:
%
%    08 June 2005
%
%  Author:
%
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    George Fishman,
%    Multiplicative congruential random number generators with modulus 2**b:
%    an exhaustive analysis for b = 32 and a partial analysis for b = 48,
%    Mathematics of Computation,
%    Volume 189, 1990, pages 331-344.
%
%  Parameters:
%
%    Input, integer SEED(4), the seed of the random number generator; the array
%    elements must be between 0 and 4095, and SEED(4) must be odd.
%
%    Output, real VALUE, the next pseudorandom number.
%
%    Output, integer SEED(4), the updated seed.
%
  ipw2 = 4096;
  m1 = 494;
  m2 = 322;
  m3 = 2508;
  m4 = 2549;
  one = 1.0;
  r = 1.0 / 4096.0;
%
%  Multiply the seed by the multiplier modulo 2**48.
%
  it4 = seed(4) * m4;
  it3 = floor ( it4 / ipw2 );
  it4 = it4 - ipw2 * it3;
  it3 = it3 + seed(3) * m4 + seed(4) * m3;
  it2 = floor ( it3 / ipw2 );
  it3 = it3 - ipw2 * it2;
  it2 = it2 + seed(2) * m4 + seed(3) * m3 + seed(4) * m2;
  it1 = floor ( it2 / ipw2 );
  it2 = it2 - ipw2 * it1;
  it1 = it1 + seed(1) * m4 + seed(2) * m3 + seed(3) * m2 + seed(4) * m1;
  it1 = mod ( it1, ipw2 );
%
%  Return updated seed
%
  seed(1) = it1;
  seed(2) = it2;
  seed(3) = it3;
  seed(4) = it4;
%
%  Convert 48-bit integer to a real number in the interval (0,1)
%
  value = ...
      r * ( it1  ...
    + r * ( it2  ...
    + r * ( it3  ...
    + r * ( it4 ) ) ) );

  return
end
function timestamp ( )

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

  return
end


classdef ParadigmRSSD2 < ParadigmDataflowSimplified
    % Advanced paradigm for time-varying oscillatory processes.
    %
    % This paradigm allows to learn the joint space/time/frequency structure in EEG, under the
    % assumption that an overcomplete ICA decomposition can produce a reasonably complete coverage
    % of potentially relevant sources. For each of the resulting (more or less independent) source
    % signals, a full time/freq decomposition is computed in the time epoch of interest, and a
    % regression model is learned which maps from the (very high-dimensional) space of these
    % features onto the desired output variable. The regression is by default logistic, and is
    % "rank-sparse" (using the trace norm regularization), meaning that the time/freq weights
    % learned for each signal component will tend to have low rank (reducing the effective
    % # of parameters) and also a sparse set of component signals will have non-zero weights.
    %
    % In addition, a prior can be imposed on the weights, which is parameterized in space (brain area), time, and
    % frequency. This makes the overall model a fairly general-purpose approach to time-varying / non-stationary
    % oscillations.
    %
    % References:
    %  [1] Ryota Tomioka and Klaus-Robert Mueller, "A regularized discriminative framework for EEG analysis with application to brain-computer interface",
    %      Neuroimage, 49 (1) pp. 415-432, 2010.
    %  [2] Ryota Tomioka & Masashi Sugiyama, "Dual Augmented Lagrangian Method for Efficient Sparse Reconstruction",
    %      IEEE Signal Procesing Letters, 16 (12) pp. 1067-1070, 2009.
    %  [3] Makeig S, Debener S, Onton J, Delorme A, "Mining event-related brain dynamics"
    %      Trends in Cognitive Science, 8(5):204-210, 2004.
    %
    % Name:
    %   Regularized Spatio-Spectral Dynamics v2
    %
    %                                Christian Kothe, Swartz Center for Computational Neuroscience, UCSD
    %                                2011-01-28

    methods
        function defaults = preprocessing_defaults(self)
            defaults = { ...
                'Resampling',128, ...
                'FIRFilter',{[0.5 1],'highpass'}, ...
                'EpochExtraction',[-2 2], ...
                'ICA','beamica', ...
                ...%'DipoleFitting',{'ConfusionRange',7}, ...
                'Projection','on', ...
                'ERSPTransform',{'WindowStep',1/15,'SpectralMap','sqrt'}, ...
                };
        end

        function defaults = machine_learning_defaults(self)
            defaults = {'dal', 2.^(4:-0.25:-3), 'scaling','none'};
            %defaults = {'logreg', 'variant',{'lars','ElasticMixing',0.5}};
        end

        function model = feature_adapt(self,varargin)
            args = arg_define(varargin, ...
                    arg_norep('signal'), ...
                    arg({'spectral_prior','SpectralPrior'},@(f)1,[],'Spectral prior. Likelihood function of frequency in Hz.','guru',true), ...
                    arg({'temporal_prior','TemporalPrior'},@(t)1,[],'Temporal prior. Likelihood function of time in s.','guru',true), ...
                    arg({'spatial_prior','SpatialPrior'},@(p)1,[],'Spatial prior. Likelihood function of MNI coordinate vector.','guru',true), ...
                    arg({'anatomical_prior','AnatomicalPrior'},{'Left Cerebrum','Right Cerebrum','Left Cerebellum','Right Cerebellum','Left Brainstem','Right Brainstem','Inter-Hemispheric'},{'-- Hemispheres --','Left Cerebrum','Right Cerebrum','Left Cerebellum','Right Cerebellum','Left Brainstem','Right Brainstem','Inter-Hemispheric','-- Lobes --','Anterior Lobe','Frontal Lobe','Frontal-Temporal Space','Limbic Lobe','Medulla','Midbrain','Occipital Lobe','Parietal Lobe','Pons','Posterior Lobe','Sub-lobar','Temporal Lobe','-- Gyri --','Angular Gyrus','Anterior Cingulate','Caudate','Cerebellar Lingual','Cerebellar Tonsil','Cingulate Gyrus','Claustrum','Culmen','Culmen of Vermis','Cuneus','Declive','Declive of Vermis','Extra-Nuclear','Fastigium','Fourth Ventricle','Fusiform Gyrus','Inferior Frontal Gyrus','Inferior Occipital Gyrus','Inferior Parietal Lobule','Inferior Semi-Lunar Lobule','Inferior Temporal Gyrus','Insula','Lateral Ventricle','Lentiform Nucleus','Lingual Gyrus','Medial Frontal Gyrus','Middle Frontal Gyrus','Middle Occipital Gyrus','Middle Temporal Gyrus','Nodule','Orbital Gyrus','Paracentral Lobule','Parahippocampal Gyrus','Postcentral Gyrus','Posterior Cingulate','Precentral Gyrus','Precuneus','Pyramis','Pyramis of Vermis','Rectal Gyrus','Subcallosal Gyrus','Sub-Gyral','Superior Frontal Gyrus','Superior Occipital Gyrus','Superior Parietal Lobule','Superior Temporal Gyrus','Supramarginal Gyrus','Thalamus','Third Ventricle','Transverse Temporal Gyrus','Tuber','Tuber of Vermis','Uncus','Uvula','Uvula of Vermis'}, 'Anatomical prior. Select anatomical structures that are likely to contain processes of interest.'),...
                    arg({'vectorize_features','VectorizeFeatures'},true,[],'Vectorize feature tensors. This is for classifiers that cannot handle matrix or tensor-shaped features.'),...
                    arg({'normalize_features','NormalizeFeatures'},true,[],'Normalize time/frequency features. If enabled, features will be normalized by a rank-1 normalization matrix (rather than pixelwise).'));
%
            model = rmfield(args,'signal');
            % determine data rescaling factors
            if args.normalize_features
                tdata = permute(args.signal.data,[1 2 4 3]);
                sdata = permute(args.signal.data,[1 4 2 3]);
                for c=size(args.signal.data,1):-1:1
                    % temporal scale vector
                    temp = 1./median(abs(bsxfun(@minus,tdata(c,:,:),median(tdata(c,:,:),3))),3);
                    % spectral scale vector
                    spec = 1./median(abs(bsxfun(@minus,sdata(c,:,:),median(sdata(c,:,:),3))),3);
                    % time/freq scaling matrix
                    model.scaling(c,:,:) = sqrt(temp')*sqrt(spec);
                end
            end
            % determine model shape
            model.shape = size(args.signal.data);
            model.shape = model.shape([2 4 1]);
        end

        function [features,shape] = feature_extract(self,signal,featuremodel)
            signal.data = permute(signal.data,[1 2 4 3]);
            % optionally apply normalization
            if featuremodel.normalize_features
                features = bsxfun(@times,signal.data,featuremodel.scaling);
            else
                features = signal.data;
            end
            features = permute(features,[2 3 1 4]);
            % determine feature shape
            siz = size(features);
            shape = siz(1:3);
            % do final vectorization if desired
            if featuremodel.vectorize_features
                features = reshape(features,[],signal.trials)'; end
        end

        function layout = dialog_layout_defaults(self)
            layout = {'SignalProcessing.Resampling.SamplingRate','SignalProcessing.FIRFilter.Frequencies', '', ...
                'SignalProcessing.ICA.DataCleaning.DataSetting', '', 'SignalProcessing.ICA.Variant', ...
                'SignalProcessing.EpochExtraction','', ...
                'SignalProcessing.ERSPTransform','', ...
                'Prediction.FeatureExtraction.SpectralPrior', 'Prediction.FeatureExtraction.TemporalPrior', ...
                'Prediction.FeatureExtraction.SpatialPrior','Prediction.FeatureExtraction.AnatomicalPrior', '', ...
                'Prediction.MachineLearning.Learner.Lambdas', 'Prediction.MachineLearning.Learner.LossFunction','Prediction.MachineLearning.Learner.Regularizer'};
        end
    end
end

% TODO: reimplement priors

%         function [featuremodel,conditioningmodel,predictivemodel] = calibrate_prediction_function(self,varargin)
%             args = arg_define(varargin, ...
%                 arg_norep('signal'), ...
%                 arg_sub({'fex','FeatureExtraction'},{},...
%                     {arg({'spectral_prior','SpectralPrior'},@(f)1,[],'Spectral prior. Likelihood function of frequency in Hz.','guru',true), ...
%                      arg({'temporal_prior','TemporalPrior'},@(t)1,[],'Temporal prior. Likelihood function of time in s.','guru',true), ...
%                      arg({'spatial_prior','SpatialPrior'},@(p)1,[],'Spatial prior. Likelihood function of MNI coordinate vector.','guru',true), ...
%                      arg({'anatomical_prior','AnatomicalPrior'},{'Left Cerebrum','Right Cerebrum','Left Cerebellum','Right Cerebellum','Left Brainstem','Right Brainstem','Inter-Hemispheric'},{'-- Hemispheres --','Left Cerebrum','Right Cerebrum','Left Cerebellum','Right Cerebellum','Left Brainstem','Right Brainstem','Inter-Hemispheric','-- Lobes --','Anterior Lobe','Frontal Lobe','Frontal-Temporal Space','Limbic Lobe','Medulla','Midbrain','Occipital Lobe','Parietal Lobe','Pons','Posterior Lobe','Sub-lobar','Temporal Lobe','-- Gyri --','Angular Gyrus','Anterior Cingulate','Caudate','Cerebellar Lingual','Cerebellar Tonsil','Cingulate Gyrus','Claustrum','Culmen','Culmen of Vermis','Cuneus','Declive','Declive of Vermis','Extra-Nuclear','Fastigium','Fourth Ventricle','Fusiform Gyrus','Inferior Frontal Gyrus','Inferior Occipital Gyrus','Inferior Parietal Lobule','Inferior Semi-Lunar Lobule','Inferior Temporal Gyrus','Insula','Lateral Ventricle','Lentiform Nucleus','Lingual Gyrus','Medial Frontal Gyrus','Middle Frontal Gyrus','Middle Occipital Gyrus','Middle Temporal Gyrus','Nodule','Orbital Gyrus','Paracentral Lobule','Parahippocampal Gyrus','Postcentral Gyrus','Posterior Cingulate','Precentral Gyrus','Precuneus','Pyramis','Pyramis of Vermis','Rectal Gyrus','Subcallosal Gyrus','Sub-Gyral','Superior Frontal Gyrus','Superior Occipital Gyrus','Superior Parietal Lobule','Superior Temporal Gyrus','Supramarginal Gyrus','Thalamus','Third Ventricle','Transverse Temporal Gyrus','Tuber','Tuber of Vermis','Uncus','Uvula','Uvula of Vermis'}, 'Anatomical prior. Select anatomical structures that are likely to contain processes of interest.'),...
%                     }, 'Parameters for the feature-adaptation function. These parameters control how features are statistically adapted and extracted from the filtered data before they are passed int othe machine learning stage.'), ...
%                 arg_sub({'cond','Conditioning'},{},@self.feature_adapt_conditioning,'Feature conditioning parameters. Allows to further process features for better usability with classifiers.'), ...
%                 arg_sub({'ml','MachineLearning'},{'Learner',self.machine_learning_defaults()},@ml_train,'Machine learning stage of the paradigm. Operates on the feature vectors that are produced by the feature-extraction stage.'));
%
%             try
%                 data = self.rssd_load_overcomplete(args.signal);
%                 % read out component dipole fits
%                 if ~isempty(data.dipfit)
%                     if isfield(data.dipfit,'multimodel')
%                         dipfits = [data.dipfit.multimodel{:}];
%                     else
%                         dipfits = data.dipfit.model;
%                     end
%                 else
%                     dipfits = [];
%                 end
%                 if ~isempty(args.fex.anatomical_prior) && ~isequal(args.fex.anatomical_prior,false) && ~isempty(dipfits)
%                     % if an anatomical prior was given, we can pre-prune the potenial ERSPs
%                     ersprange = [];
%                     for k=1:size(data.icaweights,1)
%                         matches{k} = intersect(dipfits(k).structures,args.fex.anatomical_prior);
%                         if ~isempty(matches{k})
%                             ersprange(end+1) = k; end
%                     end
%                 else
%                     % otherwise we need to compute them all
%                     ersprange = 1:size(data.icaweights,1);
%                 end
%
%                 % compute ERSPs
%                 disp('Now computing time/frequency decompositions...');
%                 [T,X,freqs,times] = evalc('self.ersp_compute(data,args,ersprange)'); %#ok<ASGLU>
%                 retain_ics = [];
%                 structures = {};
%                 probabilities = [];
%                 summed_probabilities = [];
%                 for k = ersprange
%                     % get left/right normalization vectors lhs/rhs
%                     lhs = args.fex.spectral_prior(freqs) .* sum(reshape(var(X{k},[],2),size(X{k},1),[]),2).^-0.25;
%                     rhs = args.fex.temporal_prior(times) .* sum(reshape(var(X{k},[],1),[],size(X{k},3)),2).^-0.25;
%                     % make sure that they are well-behaved
%                     lhs(~isfinite(lhs)) = 0; medlhs = median(lhs); lhs(lhs>3*medlhs) = medlhs;
%                     rhs(~isfinite(rhs)) = 0; medrhs = median(rhs); rhs(rhs>3*medrhs) = medrhs;
%                     % turn into a scaling matrix
%                     prior{k} =  diag(lhs) * ones(length(freqs),length(times)) * diag(rhs);
%                     % incorporate the spatial prior
%                     if ~isempty(dipfits)
%                         prior{k} = prior{k} * args.fex.spatial_prior(dipfits(k).posxyz); end
%                 end
%                 for k = ersprange
%                     % incorporate the anatomical prior
%                     if ~isempty(args.fex.anatomical_prior) && ~isequal(args.fex.anatomical_prior,false) && ~isempty(dipfits)
%                         [matches,idx] = intersect(dipfits(k).structures,args.fex.anatomical_prior); %#ok<ASGLU>
%                         % sum the probabilities for being in each of the accepted structures (can be > 1 as the structures are highly overlapping)
%                         prior{k} = sum(dipfits(k).probabilities(idx)) * prior{k};
%                         structures{k} = dipfits(k).structures(idx);
%                         probabilities{k} = dipfits(k).probabilities(idx);
%                         summed_probabilities(k) = sum(dipfits(k).probabilities(idx));
%                         % figure; topoplot(data.icawinv(:,k),data.chanlocs(data.icachansind),'electrodes','labels'); title([hlp_tostring(xdipfits(k).structures(idx)) ' - ' hlp_tostring(dipfits(k).probabilities(idx))]);
%                     end
%                     if ~all(all(prior{k}==0))
%                         retain_ics(end+1) = k; end
%                 end
%                 featuremodel.prior = prior;
%                 featuremodel.retain_ics = retain_ics;
%                 featuremodel.args = args;
%                 blocksizes = cellfun(@size,featuremodel.prior,'UniformOutput',false);
%
%                 % update machine learning parameters
%                 args.ml.learner.shape = vertcat(blocksizes{retain_ics}); %vertcat(blocksizes{cellfun(@prod,blocksizes)});
%
%         end
%
%         function features = feature_extract(self,signal,featuremodel)
%             try
%                 data = self.rssd_load_overcomplete(signal);
%                 % compute ERSP features
%                 [T,features] = evalc('self.ersp_compute(data,featuremodel.args,featuremodel.retain_ics)'); %#ok<ASGLU>
%                 % scale each component-ERSP by the respective prior & sparsify
%                 for c=featuremodel.retain_ics
%                     features{c} = bsxfun(@times,features{c},featuremodel.prior{c}); end
%                 % generate block-compressed version of the data
%                 features = reshape([features{featuremodel.retain_ics}],[],data.trials)';
%             catch
%                 disp('Glitch in para_rssd. halting...');
%                 keyboard;
%             end
%         end


function [K] = kv0v0(x, xp, hyp, ubar, vbar, ubarp, vbarp, dt, i)

logsigmau = hyp(1);
logthetau = hyp(2);
logsigmav = hyp(3);
logthetav = hyp(4);

a1 = hyp(5);
a2 = hyp(6);

n_x = size(x,1);
n_xp = size(xp,1);

x = repmat(x,1,n_xp);
xp = repmat(xp',n_x,1);

ubar = repmat(ubar,1,n_xp);
vbar = repmat(vbar,1,n_xp);
ubarp = repmat(ubarp',n_x,1);
vbarp = repmat(vbarp',n_x,1);

switch i

case 0

K=exp(1).^(logsigmav+(-1/2).*exp(1).^((-1).*logthetav).*(x+(-1).*xp).^2)+ ...
  dt.^2.*exp(1).^(logsigmau+(-4).*logthetau+(-1/2).*exp(1).^((-1).* ...
  logthetau).*(x+(-1).*xp).^2).*(a2.*exp(1).^(2.*logthetau).*(ubar.^2+ ...
  vbar.^2).*(a2.*exp(1).^(2.*logthetau).*(ubarp.^2+vbarp.^2)+a1.*((-1).* ...
  exp(1).^logthetau+(x+(-1).*xp).^2))+(-1).*a1.*(a2.*exp(1).^(2.* ...
  logthetau).*(ubarp.^2+vbarp.^2).*(exp(1).^logthetau+(-1).*(x+(-1).*xp) ...
  .^2)+(-1).*a1.*(3.*exp(1).^(2.*logthetau)+(-6).*exp(1).^logthetau.*(x+( ...
  -1).*xp).^2+(x+(-1).*xp).^4)));

case 1 % logsigmau

K=dt.^2.*exp(1).^(logsigmau+(-4).*logthetau+(-1/2).*exp(1).^((-1).* ...
  logthetau).*(x+(-1).*xp).^2).*(a2.*exp(1).^(2.*logthetau).*(ubar.^2+ ...
  vbar.^2).*(a2.*exp(1).^(2.*logthetau).*(ubarp.^2+vbarp.^2)+a1.*((-1).* ...
  exp(1).^logthetau+(x+(-1).*xp).^2))+(-1).*a1.*(a2.*exp(1).^(2.* ...
  logthetau).*(ubarp.^2+vbarp.^2).*(exp(1).^logthetau+(-1).*(x+(-1).*xp) ...
  .^2)+(-1).*a1.*(3.*exp(1).^(2.*logthetau)+(-6).*exp(1).^logthetau.*(x+( ...
  -1).*xp).^2+(x+(-1).*xp).^4)));

case 2 % logthetau

K=dt.^2.*exp(1).^(logsigmau+(-4).*logthetau+(-1/2).*exp(1).^((-1).* ...
  logthetau).*(x+(-1).*xp).^2).*(a2.*exp(1).^(3.*logthetau).*(ubar.^2+ ...
  vbar.^2).*((-1).*a1+2.*a2.*exp(1).^logthetau.*(ubarp.^2+vbarp.^2))+(-1) ...
  .*a1.*exp(1).^logthetau.*(a2.*exp(1).^logthetau.*(ubarp.^2+vbarp.^2).*( ...
  3.*exp(1).^logthetau+(-2).*(x+(-1).*xp).^2)+(-6).*a1.*(exp(1) ...
  .^logthetau+(-1).*(x+(-1).*xp).^2))+2.*a2.*exp(1).^(2.*logthetau).*( ...
  ubar.^2+vbar.^2).*(a2.*exp(1).^(2.*logthetau).*(ubarp.^2+vbarp.^2)+a1.*( ...
  (-1).*exp(1).^logthetau+(x+(-1).*xp).^2))+(a2.*exp(1).^(2.*logthetau).*( ...
  ubar.^2+vbar.^2).*(a2.*exp(1).^(2.*logthetau).*(ubarp.^2+vbarp.^2)+a1.*( ...
  (-1).*exp(1).^logthetau+(x+(-1).*xp).^2))+(-1).*a1.*(a2.*exp(1).^(2.* ...
  logthetau).*(ubarp.^2+vbarp.^2).*(exp(1).^logthetau+(-1).*(x+(-1).*xp) ...
  .^2)+(-1).*a1.*(3.*exp(1).^(2.*logthetau)+(-6).*exp(1).^logthetau.*(x+( ...
  -1).*xp).^2+(x+(-1).*xp).^4))).*((-4)+(1/2).*exp(1).^((-1).*logthetau).* ...
  (x+(-1).*xp).^2));

case 3 % logsigmav

K=exp(1).^(logsigmav+(-1/2).*exp(1).^((-1).*logthetav).*(x+(-1).*xp).^2); ...

case 4 % logthetav

K=(1/2).*exp(1).^(logsigmav+(-1).*logthetav+(-1/2).*exp(1).^((-1).* ...
  logthetav).*(x+(-1).*xp).^2).*(x+(-1).*xp).^2;

case 5 % a1

K=dt.^2.*exp(1).^(logsigmau+(-4).*logthetau+(-1/2).*exp(1).^((-1).* ...
  logthetau).*(x+(-1).*xp).^2).*((-1).*a2.*exp(1).^(2.*logthetau).*( ...
  ubarp.^2+vbarp.^2).*(exp(1).^logthetau+(-1).*(x+(-1).*xp).^2)+a2.*exp(1) ...
  .^(2.*logthetau).*(ubar.^2+vbar.^2).*((-1).*exp(1).^logthetau+(x+(-1).* ...
  xp).^2)+(-1).*a1.*((-3).*exp(1).^(2.*logthetau)+6.*exp(1).^logthetau.*( ...
  x+(-1).*xp).^2+(-1).*(x+(-1).*xp).^4)+a1.*(3.*exp(1).^(2.*logthetau)+( ...
  -6).*exp(1).^logthetau.*(x+(-1).*xp).^2+(x+(-1).*xp).^4));

case 6 % a2

K=dt.^2.*exp(1).^(logsigmau+(-2).*logthetau+(-1/2).*exp(1).^((-1).* ...
  logthetau).*(x+(-1).*xp).^2).*(a2.*exp(1).^(2.*logthetau).*(ubar.^2+ ...
  vbar.^2).*(ubarp.^2+vbarp.^2)+(ubar.^2+vbar.^2).*(a2.*exp(1).^(2.* ...
  logthetau).*(ubarp.^2+vbarp.^2)+a1.*((-1).*exp(1).^logthetau+(x+(-1).* ...
  xp).^2))+(-1).*a1.*(ubarp.^2+vbarp.^2).*(exp(1).^logthetau+(-1).*(x+(-1) ...
  .*xp).^2));

otherwise

        K = zeros(n_x, n_xp);
end

if K == 0

    K = zeros(n_x, n_xp);

end

end


%% Find a bipolar colormap, linear in grayscale, close to a template map.

%%
% Linearity in gray is important for a colormap to look reasonable when
% printed in grayscale ("black and white"), but note that precise linearity
% depends on the particular (non-unique) choice for conversion from RGB
% values to grayscale brightness/luminance, which would ideally be
% (printing-) device-dependent in this context, and using ICC color
% profiles, etc. In practice, we use a simpler conversion, like rgb2gray,
% (see code comments in colormap_optimization for further details).

%%
% We explore a range of template colormaps, but note that others could be
% better still... In particular, a colormap "dusk" has recently been added
% to real2rgb (see below), which I have not had time to investigate...
% Another area for future work would be a CIELAB-based investigation, see:
%%
% <http://www.mathworks.com/matlabcentral/fileexchange/11037-lab-color-scale>
%%
% <http://en.wikipedia.org/wiki/Lab_color_space>

%% CMRmap from Carey Rappaport
% http://www.mathworks.com/matlabcentral/fileexchange/2662
cmr = [
    0         0         0
    0.1500    0.1500    0.5000
    0.3000    0.1500    0.7500
    0.6000    0.2000    0.5000
    1.0000    0.2500    0.1500
    0.9000    0.5000    0
    0.9000    0.7500    0.1000
    0.9000    0.9000    0.5000
    1.0000    1.0000    1.0000
    ];
cmr = colormap_optimization(cmr); display(cmr)
colormap_visualization(cmr, 1)

%%
% This is nice, but I would argue it is perceptually asymmetric in that
% there is a relatively smooth transition in the positive half, while the
% negative half has a more distinct mauve band around -0.2 to -0.3.

%% Thermal from Oliver Woodford's real2rgb
% http://www.mathworks.com/matlabcentral/fileexchange/23342
therm = thermal(inf); display(therm)
therm = colormap_optimization(therm); display(therm)
colormap_visualization(therm, 1)

%%
% I think this is a really nice bipolar colormap. My only minor quibble
% is that the off-white and off-black ends are not very appealing (to me).
% Note that they are pure white and pure black in Oliver's original thermal
% scheme, but I don't like that, since I want hardcopy to be distinguished
% from any black lines or text labels and from a white background.

%% Based on recommendations in Brewer (1996), but with gray central color
% http://www.ingentaconnect.com/content/maney/caj/1996/00000033/00000002/art00002
brew1 = [
    0.2500         0    0.3333 % purple
    0.5000    0.5000    0.5000 % grey
    1.0000    1.0000    0.1667 % yellow
    ];
brew1 = colormap_optimization(brew1); display(brew1)
colormap_visualization(brew1, 1)

%%
% Although academically well-motivated, I find the single-color transitions
% away from the origin don't seem to make as good use of color to aid
% visualisation compared to some of the other maps here.

%% Based on my adaption of Brewer's (1996) recommendations
% with a neutral central colour, and two colours on each side, which I feel
% better discriminates between values within each of the two halves.
% Brewer (1996) considers issues such as colorblindness, etc. She
% recommends (separately) blue-red and purple-yellow schemes (but not
% blue-purple or red-yellow). The following seems like a reasonable
% compromise given that Brewer's table 2 shows no ideal paths through four
% colors (only a few ideal color-pairs, which sadly cannot be linked up).
brew2 = [
    0.2500         0    0.3333 % purple
    0.0000    0.2500    1.0000 % blue
    0.5000    0.5000    0.5000 % grey
    1.0000    0.2500    0.3333 % red
    1.0000    1.0000    0.1667 % yellow
    ];
brew2 = colormap_optimization(brew2); display(brew2)
brew2fine = colormap_visualization(brew2, 1);

%%
% I am probably biased, but I think the two-color transitions here are
% helpful, and there is reasonable (though not perfect) perceptual symmetry
% between the orange-yellow and blue-purple transitions (if anything, the
% purple transitions a little too sharply near the end, around -0.95). It
% could undoubtedly be improved further, but seems good enough to me...

%% Check linearity in grayscale luminance of raw and interpolated maps
colormap_visualization(brew2, 2)
colormap_visualization(brew2fine, 2)

%%
% See also: colormap_visualization, colormap_optimization, bipolar
%%
% Example:
%  map = bipolar(m, 0.5); % (gives the optimized brew2 that we get here)
%%
% Copyright 2009 Ged Ridgway at gmail com


function M = fixedrankfactory_3factors_preconditioned(m, n, k)
% Manifold of m-by-n matrices of rank k with three factor quotient geometry.
%
% function M = fixedrankfactory_3factors_preconditioned(m, n, k)
%
% This geometry is tuned to least squares problems such as low-rank matrix
% completion with ell-2 loss.
%
% A point X on the manifold is represented as a structure with three
% fields: L, S and R. The matrices L (mxk) and R (nxk) are orthonormal,
% while the matrix S (kxk) is a full rank matrix such that X = L*S*R'.
%
% Tangent vectors are represented as a structure with three fields: L, S
% and R.
%
% Please cite the Manopt paper as well as the research paper:
%     @InProceedings{mishra2014r3mc,
%       Title        = {{R3MC}: A {R}iemannian three-factor algorithm for low-rank matrix completion},
%       Author       = {Mishra, B. and Sepulchre, R.},
%       Booktitle    = {{53rd IEEE Conference on Decision and Control}},
%       Year         = {2014},
%       Organization = {{IEEE CDC}}
%     }
%
%
% See also: fixedrankfactory_3factors fixedrankfactory_2factors_preconditioned

% This file is part of Manopt: www.manopt.org.
% Original author: Bamdev Mishra, Dec. 30, 2012.
% Contributors:
% Change log:
%
%	April 04, 2015 (BM):
%       Cosmetic changes including avoiding storing the inverse of a kxk matrix.

    M.name = @() sprintf('LSR'' (tuned for least square problems) quotient manifold of %dx%d matrices of rank %d', m, n, k);

    M.dim = @() (m+n-k)*k;

    % Some precomputations at the point X that are to be used in the inner product (and
    % pretty much everywhere else).
    function X = prepare(X)
        if ~all(isfield(X,{'StS','SSt'}) == 1)
            X.SSt = X.S*X.S';
            X.StS = X.S'*X.S;
        end
    end

    % The choice of metric is motivated by symmetry and tuned to least square
    % objective function.
    M.inner = @iproduct;
    function ip = iproduct(X, eta, zeta)
        X = prepare(X);

        ip = trace(X.SSt*(eta.L'*zeta.L)) + trace(X.StS*(eta.R'*zeta.R)) ...
            + trace(eta.S'*zeta.S);
    end

    M.norm = @(X, eta) sqrt(M.inner(X, eta, eta));

    M.dist = @(x, y) error('fixedrankfactory_3factors_preconditioned.dist not implemented yet.');

    M.typicaldist = @() 10*k;

    skew = @(X) .5*(X-X');
    symm = @(X) .5*(X+X');

    M.egrad2rgrad = @egrad2rgrad;
    function rgrad = egrad2rgrad(X, egrad)
        X = prepare(X);

        SSL = X.SSt;
        ASL = 2*symm(SSL*(egrad.S*X.S'));

        SSR = X.StS;
        ASR = 2*symm(SSR*(egrad.S'*X.S));

        [BL, BR] = tangent_space_lyap(X.S, ASL, ASR); % It computes the solution without calling Matlab's Lyap.

        rgrad.L = (egrad.L - X.L*BL)/X.SSt;
        rgrad.R = (egrad.R - X.R*BR)/X.StS;
        rgrad.S = egrad.S;

        % Debug
        %         BL1 = lyap(SSL, -ASL); % Alternate way
        %         BR1 = lyap(SSR, -ASR);
        %         norm(skew(X.SSt*(rgrad.L'*X.L) + rgrad.S*X.S'), 'fro')
        %         norm(skew(X.StS*(rgrad.R'*X.R) - X.S'*rgrad.S), 'fro')

    end

    M.ehess2rhess = @ehess2rhess;
    function Hess = ehess2rhess(X, egrad, ehess, eta)
        X = prepare(X);

        % Riemannian gradient.
        SSL = X.SSt;
        ASL = 2*symm(SSL*(egrad.S*X.S'));
        SSR = X.StS;
        ASR = 2*symm(SSR*(egrad.S'*X.S));
        [BL, BR] = tangent_space_lyap(X.S, ASL, ASR);

        rgrad.L = (egrad.L - X.L*BL)/X.SSt;
        rgrad.R = (egrad.R - X.R*BR)/X.StS;
        rgrad.S = egrad.S;

        % Directional derivative of the Riemannian gradient.
        ASLdot = 2*symm((2*symm(X.S*eta.S')*(egrad.S*X.S')) + X.SSt*(ehess.S*X.S' + egrad.S*eta.S')) - 4*symm(symm(eta.S*X.S')*BL);
        ASRdot = 2*symm((2*symm(X.S'*eta.S)*(egrad.S'*X.S)) + X.StS*(ehess.S'*X.S + egrad.S'*eta.S)) - 4*symm(symm(eta.S'*X.S)*BR);

        %         SSLdot = X.SSt;
        %         SSRdot = X.StS;
        %         BLdot = lyap(SSLdot, -ASLdot);
        %         BRdot = lyap(SSRdot, -ASRdot);

        [BLdot, BRdot] = tangent_space_lyap(X.S, ASLdot, ASRdot);

        Hess.L = (ehess.L - eta.L*BL - X.L*BLdot - 2*rgrad.L*symm(eta.S*X.S'))/X.SSt;
        Hess.R = (ehess.R - eta.R*BR - X.R*BRdot - 2*rgrad.R*symm(eta.S'*X.S))/X.StS;
        Hess.S = ehess.S;

        % BM: Till this, everything seems correct.
        % We still need a correction factor for the non-constant metric
        % that is imposed.
        % The computation of the correction factor owes itself to the Koszul formula.
        % This corresponds to the Riemannian connection in the Euclidean space with the
        % scaled metric.
        Hess.L = Hess.L + (eta.L*symm(rgrad.S*X.S') + rgrad.L*symm(eta.S*X.S'))/X.SSt;
        Hess.R = Hess.R + (eta.R*symm(rgrad.S'*X.S) + rgrad.R*symm(eta.S'*X.S))/X.StS;
        Hess.S = Hess.S - symm(rgrad.L'*eta.L)*X.S - X.S*symm(rgrad.R'*eta.R);

        % The Riemannian connection on the quotient space is the
        % projection of the Riemmian connection in the ambient space onto the tangent space of the total space and
        % then onto the horizontal space.
        % This is accomplished by the following operation.
        Hess = M.proj(X, Hess);

        % Debug
        %         norm(skew(X.SSt*(Hess.L'*X.L) + Hess.S*X.S'))
        %         norm(skew(X.StS*(Hess.R'*X.R) - X.S'*Hess.S))

    end

    M.proj = @projection;
    function etaproj = projection(X, eta)
        X = prepare(X);

        % First, projection onto the tangent space of the total space.
        SSL = X.SSt;
        ASL = 2*symm(X.SSt*(X.L'*eta.L)*X.SSt);
        BL = lyap(SSL, -ASL);
        eta.L = eta.L - X.L*(BL/X.SSt);

        SSR = X.StS;
        ASR = 2*symm(X.StS*(X.R'*eta.R)*X.StS);
        BR = lyap(SSR, -ASR);
        eta.R = eta.R - X.R*(BR/X.StS);

        % Project onto the horizontal space
        PU = skew((X.L'*eta.L)*X.SSt) + skew(X.S*eta.S');
        PV = skew((X.R'*eta.R)*X.StS)  + skew(X.S'*eta.S);
        [Omega1, Omega2] = coupled_lyap(X.S, PU, PV);
        %         norm(2*skew(Omega1*X.SSt) - PU -(X.S*Omega2*X.S'),'fro' )
        %         norm(2*skew(Omega2*X.StS) - PV -(X.S'*Omega1*X.S),'fro' )
        %

        etaproj.L = eta.L - (X.L*Omega1);
        etaproj.S = eta.S - (X.S*Omega2 - Omega1*X.S) ;
        etaproj.R = eta.R - (X.R*Omega2);

        % Debug
        %         norm(skew(X.SSt*(etaproj.L'*X.L) + etaproj.S*X.S'))
        %         norm(skew(X.StS*(etaproj.R'*X.R) - X.S'*etaproj.S))
        %
        %         norm(skew(X.SSt*(etaproj.L'*X.L) - X.S*etaproj.S'))
        %         norm(skew(X.StS*(etaproj.R'*X.R) + etaproj.S'*X.S))

    end

    M.tangent = M.proj;
    M.tangent2ambient = @(X, eta) eta;

    M.retr = @retraction;
    function Y = retraction(X, eta, t)
        if nargin < 3
            t = 1.0;
        end

        Y.S = (X.S + t*eta.S);
        Y.L = uf((X.L + t*eta.L));
        Y.R = uf((X.R + t*eta.R));

        Y = prepare(Y);
    end

    M.exp = @exponential;
    function Y = exponential(X, eta, t)
        if nargin < 3
            t = 1.0;
        end
        Y = retraction(X, eta, t);
        warning('manopt:fixedrankfactory_3factors_preconditioned:exp', ...
            ['Exponential for fixed rank ' ...
            'manifold not implemented yet. Used retraction instead.']);
    end

    M.hash = @(X) ['z' hashmd5([X.L(:) ; X.S(:) ; X.R(:)])];

    M.rand = @random;
    % Factors L and R live on Stiefel manifolds, hence we will reuse
    % their random generator.
    stiefelm = stiefelfactory(m, k);
    stiefeln = stiefelfactory(n, k);
    function X = random()
        X.L = stiefelm.rand();
        X.R = stiefeln.rand();
        X.S = diag(1+rand(k, 1));

        X = prepare(X);
    end

    M.randvec = @randomvec;
    function eta = randomvec(X)
        % A random vector on the horizontal space
        eta.L = randn(m, k);
        eta.R = randn(n, k);
        eta.S = randn(k, k);
        eta = projection(X, eta);
        nrm = M.norm(X, eta);
        eta.L = eta.L / nrm;
        eta.R = eta.R / nrm;
        eta.S = eta.S / nrm;
    end

    M.lincomb = @lincomb;

    M.zerovec = @(X) struct('L', zeros(m, k), 'S', zeros(k, k), ...
        'R', zeros(n, k));

    M.transp = @(x1, x2, d) projection(x2, d);

    % vec and mat are not isometries, because of the unusual inner metric.
    M.vec = @(X, U) [U.L(:) ; U.S(:); U.R(:)];
    M.mat = @(X, u) struct('L', reshape(u(1:(m*k)), m, k), ...
        'S', reshape(u((m*k+1): m*k + k*k), k, k), ...
        'R', reshape(u((m*k+ k*k + 1):end), n, k));
    M.vecmatareisometries = @() false;

end

% Linear combination of tangent vectors
function d = lincomb(x, a1, d1, a2, d2) %#ok<INUSL>

    if nargin == 3
        d.L = a1*d1.L;
        d.R = a1*d1.R;
        d.S = a1*d1.S;
    elseif nargin == 5
        d.L = a1*d1.L + a2*d2.L;
        d.R = a1*d1.R + a2*d2.R;
        d.S = a1*d1.S + a2*d2.S;
    else
        error('Bad use of fixedrankfactory_3factors_preconditioned.lincomb.');
    end

end

function A = uf(A)
    [L, unused, R] = svd(A, 0); %#ok
    A = L*R';
end

function[BU, BV] = tangent_space_lyap(R, E, F)
    % We intent to solve a linear system    RR^T  BU + BU RR^T  = E
    %                                       R^T R BV + BV R^T R = F
    % for BU and BV.
    %
    % This can be solved using two calls to the Matlab's lyap.
    % However, we can still have a more efficient implementation
    % that does not require the full functionaliyt of Matlab's lyap.

    [U, Sigma, V] = svd(R);
    E_mod = U'*E*U;
    F_mod = V'*F*V;
    b1 = E_mod(:);
    b2 = F_mod(:);

    r = size(Sigma, 1);
    sig = diag(Sigma); % all the singular values in a vector
    sig1 = sig*ones(1, r); % columns repeat
    sig1t = sig1'; % rows repeat
    s1 = sig1(:);
    s2 = sig1t(:);

    % The block elements
    a =  s1.^2 + s2.^2; % a column vector

    % Solve the linear system of equations
    cu = b1./a; %a.\b1;
    cv = b2./a; %a.\b2;

    % Matricize
    CU = reshape(cu, r, r);
    CV = reshape(cv, r, r);

    % Do the similarity transforms
    BU = U*CU*U';
    BV = V*CV*V';

    % %% Debug
    %
    % norm(R*R'*BU + BU*R*R' - E, 'fro');
    % norm((Sigma.^2)*CU + CU*(Sigma.^2) - E_mod, 'fro');
    % norm(a.*cu - b1, 'fro');
    %
    % norm(R'*R*BV + BV*R'*R - F, 'fro');
    %
    % BU1 = lyap(R*R', - E);
    % norm(R*R'*BU1 + BU1*R*R' - E, 'fro');
    %
    % BV1 = lyap(R'*R, - F);
    % norm(R'*R*BV1 + BV1*R'*R - F, 'fro');
    %
    % % as accurate as the lyap
    % norm(BU - BU1, 'fro')
    % norm(BV - BV1, 'fro')
end

function[Omega1, Omega2] = coupled_lyap(R, E, F)
    % We intent to solve the coupled system of Lyapunov equations
    %
    % RR^T Omega1 + Omega1 RR^T  - R Omega2 R^T = E
    % R^T R Omega2 + Omega1 R^T R  - R^T Omega2 R = F,
    %
    % for Omega1 and Omega2, both are skew symmetric matrices.
    %
    % Below is an efficient implementation

    [U, Sigma, V] = svd(R);
    E_mod = U'*E*U;
    F_mod = V'*F*V;
    b1 = E_mod(:);
    b2 = F_mod(:);

    r = size(Sigma, 1);
    sig = diag(Sigma); % All the singular values in a vector
    sig1 = sig*ones(1, r); % Columns repeat
    sig1t = sig1'; % Rows repeat
    s1 = sig1(:);
    s2 = sig1t(:);

    % The block elements
    a =  s1.^2 + s2.^2; % A column vector
    c = s1.*s2;

    % Solve directly using the formula
    % A = diag(a);
    % C = diag(c);
    % Y1_sol = (A*(C\A) - C) \ (b2 + A*(C\b1));
    % Y2_sol = A\(b2 + C*Y1_sol);

    Y1_sol = (b2 + (a./c).*b1) ./ ((a.^2)./c - c);
    Y2_sol = (b2 + c.*Y1_sol)./a;

    % Matricize
    Omega1 = reshape(Y1_sol, r, r);
    Omega2 = reshape(Y2_sol, r, r);

    % Do the similarity transforms
    Omega1 = U*Omega1*U';
    Omega2 = V*Omega2*V';

    % %% Debug: whether we have the right solution.
    % norm(R*R'*Omega1 + Omega1*R*R'  - R*Omega2*R' - E, 'fro')
    % norm(R'*R*Omega2 + Omega2*R'*R  - R'*Omega1*R - F, 'fro')
end