function A11 = synA11Qmax(A00, sizeA11, cmin)
%-----------------------------------------------------------------------------
%
% For each point of colour 11 this function assigns the maximum value at the
% neighbouring gridpoints of colour 00.
%
% Design and implementation by:
% Dr. Paul M. de Zeeuw <Paul.de.Zeeuw@cwi.nl>  http://homepages.cwi.nl/~pauldz/
% Last Revision: December 12, 2001.
% (c) 1998-2002 Stichting CWI, Amsterdam
%-----------------------------------------------------------------------------
[n00, m00]=size(A00);
if nargin == 3
  o=[0 0];
  if ~all(size(o) == size(sizeA11))
    error(' synA11Qmax - unexpected dimensions of sizeA11 ')
  else
    clear o;
    n11=sizeA11(1);
    m11=sizeA11(2);
  end
elseif nargin == 2
  n11=n00-1;
  m11=m00-1;
else
  error(' synA11Qmax - number of arguments should be either 2 or 3 ')
end
%[n11, m11]=size(A11);
if m11 == m00-1
  if n11 == n00-1
    S = max(stripL(A00), stripR(A00));
    A11=max(stripD(S), stripU(S));
  elseif n11 == n00
    S = max(stripL(A00), stripR(A00));
    A11=max(S, stripU(extD(S, cmin)));
  else
    disp([' size A00 = ' int2str(size(A00)) ' size A11 = ' int2str([n11 m11])]);
    error(' synA11Qmax - A00 and target A11 do not match ');
  end
elseif m11 == m00
  if n11 == n00-1
    S = max(stripL(extR(A00, cmin)), A00);
    A11=max(stripD(S), stripU(S));
  elseif n11 == n00
    S = max(stripL(extR(A00, cmin)), A00);
    A11=max(S, stripU(extD(S, cmin)));
  else
    disp([' size A00 = ' int2str(size(A00)) ' size A11 = ' int2str([n11 m11])]);
    error(' synA11Qmax - A00 and target A11 do not match ');
  end
else
  disp([' size A00 = ' int2str(size(A00)) ' size A11 = ' int2str([n11 m11])]);
  error(' synA11Qmax - A00 and target A11 do not match ');
end
%------------------------------------------------------------------------------


% OP_FDOTN_V: assemble the vector r = [r(i)], with  r(i) = (f * n, v), with n the normal exterior vector.
%  v should be a scalar-valued function.
%
%   rhs = op_fdotn_v (spv, msh, coeff);
%
% INPUT:
%
%   spv:   structure representing the function space (see sp_vector/sp_eval_boundary_side)
%   msh:   structure containing the domain partition and the quadrature rule (see msh_cartesian/msh_eval_boundary_side)
%   coeff: source function evaluated at the quadrature points
%
% OUTPUT:
%
%   rhs: assembled right-hand side
%
% Copyright (C) 2009, 2010 Carlo de Falco, Rafael Vazquez
% Copyright (C) 2011, 2014, 2017 Rafael Vazquez
%
%    This program is free software: you can redistribute it and/or modify
%    it under the terms of the GNU General Public License as published by
%    the Free Software Foundation, either version 3 of the License, or
%    (at your option) any later version.

%    This program is distributed in the hope that it will be useful,
%    but WITHOUT ANY WARRANTY; without even the implied warranty of
%    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%    GNU General Public License for more details.
%
%    You should have received a copy of the GNU General Public License
%    along with this program.  If not, see <http://www.gnu.org/licenses/>.

function rhs = op_fdotn_v (spv, msh, coeff)

  coeff = reshape (coeff, [], msh.nqn, msh.nel);
  shpv  = reshape (spv.shape_functions, spv.ncomp, msh.nqn, spv.nsh_max, msh.nel);

  rhs = zeros (spv.ndof, 1);

  for iel = 1:msh.nel
    if (all (msh.jacdet(:,iel)))
     jacdet_weights = reshape (msh.jacdet(:, iel) .* msh.quad_weights(:, iel), 1, msh.nqn);

     shpv_iel = reshape (shpv(:, :, :, iel), spv.ncomp, msh.nqn, spv.nsh_max);
     coeff_dot_n = sum (bsxfun (@times, coeff(:,:,iel), msh.normal(:,:,iel)), 1);

     coeff_times_jw = bsxfun (@times, jacdet_weights, coeff_dot_n);

     aux_val = bsxfun (@times, coeff_times_jw, shpv_iel);
     rhs_loc = sum (sum (aux_val, 1), 2);

     indices = find (spv.connectivity(:,iel));
     rhs_loc = rhs_loc(indices); conn_iel = spv.connectivity(indices,iel);
     rhs(conn_iel) = rhs(conn_iel) + rhs_loc(:);
    else
      warning ('geopdes:jacdet_zero_at_quad_node', 'op_fdotn_v: singular map in element number %d', iel)
    end
  end

end


function [mCatDecluster, mCatAfter, vCluster, vCl, vMainCluster] = calc_decluster_ver1(mCatalog,nMethod)
% function [mCatDecluster, mCatAfter, vCluster, vCl, vMainCluster] = calc_decluster_ver1(mCatalog,nMethod)
% ----------------------------------------------------------------------------------------------------------
%
% Function to decluster earthquake catalog using the windowing technique in space and time by
% Knopoff & Gardner, GJR astr. Soc, 28, 311-313, 1972
% Gardner & Knopoff, BSSA, 64,5, 1363-1367, 1974
% using different windows
%
% Incoming variables
% mCatalog : Incoming earthquake catalog (ZMAP format)
% nMethod  : Window length for declustering (see calc_windows.m)
%            1: Gardener & Knopoff, 1974
%            2: Gruenthal pers. communication
%            3: Urhammer, 1986
%
% Outgoing variables:
% mCatDecluster : Declustered earthquake catalog
% mCatAfter     : Catalog of aftershocks (foreshocks)
% vCluster      : Vector indicating only aftershocks/foreshocls in cluster using a cluster number
% vCl           : Vector indicating all events in clusters using a cluster number
% vMainCluster  : Vector indicating mainshocks of clusters using a cluster number
%
% J. Woessner, woessner@seismo.ifg.ethz.ch
% last update: 31.07.02

%% Added:
% 31.07.02 Correction for problem of mainshocks with a cluster number as aftershocks belong to two sequences
% 31.07.02 Corrected fMaxClusterMag(nMagCount) to fMaxClusterMag, since counting variable not needed

%%% Remember: Improve zero length cluster problem, no waitbars yet, time difference mainshock-original event not implemented
%% This is the version before calc_decluster.m

%% Initialize Vectors and Matrices
mCatDecluster = [];
mCatAfter = [];
vCluster = zeros(length(mCatalog),1); % Initialize all events as mainshock
vCl = zeros(length(mCatalog),1); % Initialize all events as mainshock
vSel = zeros(length(mCatalog),1); % Initialize all events as mainshock
vMainCluster = zeros(length(mCatalog),1); % Initialize

[nXSize, nYsize] = size(mCatalog);
if nXSize == 0
    disp('Load new catalog');
    return
end

vDecDate = mCatalog(:,3);
nCount = 0;    % Variable of cluster number

fMagThreshold = min(mCatalog(:,6)); % Set Threshold to minimum magnitude of catalog
for nEvent=1:length(mCatalog(:,6))
    %nEvent
    if vCluster(nEvent) == 0
        fMagnitude(nEvent) = mCatalog(nEvent, 6);
        if fMagnitude(nEvent) >= fMagThreshold
            %% Define first aftershock zone and determine magnitude of strongest aftershock
            fMag = fMagnitude(nEvent);
            [fSpace, fTime] = calc_windows(fMagnitude(nEvent), nMethod);
            fSpaceDeg = km2deg(fSpace);
            %% This first if is for events with no location given
            if isnan(mCatalog(nEvent,1))
                %vSel = (vDecDate(:,1)-vDecDate(nEvent,1) >= 0) & (vDecDate(:,1)-vDecDate(nEvent,1) <= fTime  & vCluster(nEvent) == 0);
                vSel = (mCatalog(:,3) == mCatalog(nEvent,3));
            else
                vSel = (abs(mCatalog(:,1) - mCatalog(nEvent,1)) <= fSpaceDeg) & (abs(mCatalog(:,2) - mCatalog(nEvent,2)) <= fSpaceDeg)...
                    & (vDecDate(:,1)-vDecDate(nEvent,1) >= 0) & (vDecDate(:,1)-vDecDate(nEvent,1) <= fTime & vCluster(nEvent) == 0);
            end
            mTmp = mCatalog(vSel,:);
            %nMagCount = 1; % Variable to determine max. magnitude in a cluster
            if length(mTmp(:,1)) == 1  % Only one event thus no cluster
                fMaxClusterMag = fMag;
            else
                fMaxClusterMag = max(mTmp(:,6));
                % Search for event with bigger magnitude in cluster and resize windows if necessary
                while fMaxClusterMag-fMag > 0
                    [fSpace, fTime] = calc_windows(fMaxClusterMag, nMethod);
                    fSpaceDeg = km2deg(fSpace);
                    vSel = (abs(mCatalog(:,1) - mCatalog(nEvent,1)) <= fSpaceDeg) &...
                        (abs(mCatalog(:,2) - mCatalog(nEvent,2)) <= fSpaceDeg)...
                        & (vDecDate(:,1)-vDecDate(nEvent,1) >= 0) & (vDecDate(:,1)-vDecDate(nEvent,1) <= fTime & vSel == 1);
                    mTmp = mCatalog(vSel,:);
                    if isempty(mTmp) % no events in aftershock zone
                        break;
                    end
                    fMag = fMaxClusterMag;
                    %nMagCount = nMagCount+1;
                    fMaxClusterMag = max(mTmp(:,6));
                    if fMaxClusterMag - fMag == 0 % no bigger event in aftershock zone
                        break;
                    end
                end  % End of while
                nCount = nCount + 1; % Set cluster number
            end % End of if
            % Define final aftershock zone if different from original one
            if fMaxClusterMag > fMagnitude(nEvent)
                [fSpace, fTime] = calc_windows(fMaxClusterMag, nMethod);
                fSpaceDeg = km2deg(fSpace);
                % Select events with the Event having the number nEvent, since it is a foreshock (time condition)
                vSel = (abs(mCatalog(:,1) - mCatalog(nEvent,1)) <= fSpaceDeg) & (abs(mCatalog(:,2) - mCatalog(nEvent,2)) <= fSpaceDeg)...
                    & (vDecDate(:,1)-vDecDate(nEvent,1) >= 0) & (vDecDate(:,1)-vDecDate(nEvent,1) <= fTime & vCluster(nEvent) == 0);
            end
            [vIndice]=find(vSel); % Vector of indices with Clusters
            vTmpCluster(vIndice,:) = nCount;
            length(vTmpCluster(vIndice,:));
            nI=1; % Variable counting the length of the cluster
            % Select the right numbers for the cluster using the indice vector vIndice
            % First: Insert cluster number after check for length
            % Second: Check if it's a mainshock
            % Third: Keep the former cluster indice;
            while nI <= length(vIndice)
                if (~isempty(vTmpCluster(vIndice(nI))) & length(vTmpCluster(vIndice,:)) > 1 & vCluster(vIndice(nI)) == 0)
                    vCluster(vIndice(nI)) = vTmpCluster(vIndice(nI));
                    %vEventnr(vIndice,:) = nEvent;
                elseif  (~isempty(vTmpCluster(vIndice(nI)))  &&  length(vTmpCluster(vIndice,:)) == 1  &&  vCluster(vIndice(nI)) == 0)
                    vCluster(vIndice(nI)) = 0;
                else
                    vCluster(vIndice(nI)) = vCluster(vIndice(nI));
                end
                nI=nI+1;
            end %End of while nI
            %%% Check if the Cluster is not just one event which can happen in case of keeping the former
            %%% cluster number in preceeding while-Loop
            vSelSingle = (vCluster == nCount);
            [vIndiceSingle] = find(vSelSingle);
            %vTmpSingle(vIndiceSingle,:);
            if length(vIndiceSingle) == 1
                nCount
                vIndiceSingle
                vCluster(vIndiceSingle)=0; % Set the event as mainsock
                nCount = nCount-1; % Correct the cluster number down by one
            end
        end % End of if checking magnitude threshold fMagThreshold
    end % End of if chekcing if vCluster == 0
end % End of FOR over mCatalog
%nCount
%% vCL Cluster vector with mainshocks in it; vCluster is now modified to get rid of mainshocks
vCl = vCluster;

%% Matrix with cluster indice, magnitude and time
mTmpCat = [vCluster mCatalog(:,6) mCatalog(:,3)];
%% Delete largest event from cluster series and add to mainshock catalog
for nCevent = 1:nCount
    %nCevent
    vSel4 = (mTmpCat(:,1) == nCevent); % Select cluster
    mTmpCat2 = mCatalog(vSel4,:);
    fTmpMaxMag = max(mTmpCat2(:,6)); % Select max magnitude of cluster
    vSelMag = (mTmpCat2(:,6) == fTmpMaxMag);
    [nMag] = find(vSelMag);
    if length(nMag) == 1
        vSel5 = (mTmpCat(:,1) == nCevent & mTmpCat(:,2) == fTmpMaxMag); % Select the event
        [vIndiceMag] = find(vSel5); % Find indice
        vCluster(vIndiceMag) = 0;  % Set cluster value to zero, so it is a mainshock
        vMainCluster(vIndiceMag) = nCevent; % Set mainshock vector to cluster number
    elseif isempty(nMag)
        disp('Nothing in ')
        nCevent
    else
        vSel = (mTmpCat(:,1) == nCevent & mTmpCat(:,2) == fTmpMaxMag);
        mTmpCat3 = mCatalog(vSel,:);
        [vIndiceMag] = min(find(vSel)); % Find minimum indice of event with max magnitude in cluster
        vCluster(vIndiceMag) = 0;  % Set cluster value to zero, so it is a mainshock
        vMainCluster(vIndiceMag) = nCevent;  % Set mainshock vector to cluster number
    end
end % End of For nCevent

%% Create a catalog of aftershocks (mCatAfter) and of declustered catalog (mCatDecluster)
vSel = (vCluster(:,1) > 0);
mCatDecluster=mCatalog(~vSel,:);
mCatAfter = mCatalog(vSel,:);


%-fanDTasia ToolBox------------------------------------------------------------------
% This Matlab script is part of the fanDTasia ToolBox: a Matlab library for Diffusion
% Weighted MRI (DW-MRI) Processing, Diffusion Tensor (DTI) Estimation, High-order
% Diffusion Tensor Analysis, Tensor ODF estimation, Visualization and more.
%
% A Matlab Tutorial on DW-MRI can be found in:
% http://www.cise.ufl.edu/~abarmpou/lab/fanDTasia/tutorial.php
%
%----------------------------------------------
%openFDT
%This function opens an image volume in fanDTasia(FDT) file format.
%fanDTasia is an on-line tool for DTI DW-MRI processing.
%
%example 1: A=openFDT('DTI.fdt')
%A is a 4-dimensional matrix that contains a set of volume images.
%
%example 2: [A,B]=openFDT('DTI.fdt')
%A is a 4-dimensional matrix that contains a set of volume images.
%B is a Nx4 matrix that contains the gradient orientations and bvalues.
%B is read from a .txt file with the same name as the fdt file. (In example2: DTI.txt)
%
%----------------------------------------------
%
%Downloaded from Angelos Barmpoutis' web-page.
%
%This program is freely distributable without
%licensing fees and is provided without guarantee
%or warrantee expressed or implied.
%
%Copyright (c) 2007 Angelos Barmpoutis.
%
%VERSION : 20110611
%
%-----------------------------------------------

function [data,bval]=openFDT(name)

fid=fopen(name,'r','b');

for i=1:4
  sz(i)=fread(fid,1,'int');
end

	data=zeros(sz(1),sz(2),sz(3),sz(4));
	for c=1:sz(4)
       for z=1:sz(3)
          for y=1:sz(2)
              data(:,y,z,c)=fread(fid,sz(1),'float');
          end
       end
	end

fclose(fid);

if nargout==2
    bname=name;
    bname(length(name))='t';
    bname(length(name)-1)='x';
    bname(length(name)-2)='t';
    bval=open_TXT(bname);
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function bval=open_TXT(fnm)
%this simple function opens a txt file that contain 4 columns of numbers
%An example of such a text file is here:
%0.1 100.23 24.3 0.334
%10.345 0.2 1.23 123.4
%... as many lines you want.

fid=fopen(fnm,'r');

if fid==-1
    fprintf(1,'ERROR: FILE CANNOT BE OPENED\n');
    return;
end

bval=[];
b=zeros(1,4);
while feof(fid)==0
    b=fscanf(fid,'%f',4)';
    bval=[bval;b];
end

fclose(fid);


%-------------------------------------------------------------------------------------------------------------------%
%
% IB2d is an Immersed Boundary Code (IB) for solving fully coupled non-linear
% 	fluid-structure interaction models. This version of the code is based off of
%	Peskin's Immersed Boundary Method Paper in Acta Numerica, 2002.
%
% Author: Nicholas A. Battista
% Email:  nick.battista@unc.edu
% Date Created: September 9th, 2016
% Institution: UNC-CH
%
% This code is capable of creating Lagrangian Structures using:
% 	1. Springs
% 	2. Beams (*torsional springs)
% 	3. Target Points
%	4. Muscle-Model (combined Force-Length-Velocity model, "HIll+(Length-Tension)")
%
% One is able to update those Lagrangian Structure parameters, e.g., spring constants, resting %%	lengths, etc
%
% There are a number of built in Examples, mostly used for teaching purposes.
%
% If you would like us %to add a specific muscle model, please let Nick (nick.battista@unc.edu) know.
%
%--------------------------------------------------------------------------------------------------------------------%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: creates the geometry and prints associated input files
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function Make_Your_Geometry_and_Input_Files()

%
% Grid Parameters (MAKE SURE MATCHES IN input2d !!!)
%
Nx =  1024;      % # of Eulerian Grid Pts. in x-Direction (MUST BE EVEN!!!)
Lx = 5.0;        % Length of Eulerian Grid in x-Direction
dx = Lx/Nx;      % Grid spatial resolution

%
% Immersed Structure Geometric / Dynamic Parameters %
%
ds = 0.45*dx;               % Lagrangian Pt. Spacing (2x resolution of Eulerian grid)
struct_name = 'insect_HT'; % Name for .vertex, .spring, etc files. (must match what's in 'input2d')

% Call function to construct geometry
[xLag,yLag] = give_Me_Immsersed_Boundary_Geometry(ds,Nx,Lx);
yLag = yLag - 2+0.125;

% Plot Geometry to test
plot(xLag,yLag,'r-'); hold on;
plot(xLag,yLag,'*'); hold on;
xlabel('x'); ylabel('y');
axis([0 Lx 0 Lx]);

% Prints .vertex file!
print_Lagrangian_Vertices(xLag,yLag,struct_name);

% Prints .spring file!
%k_Spring = 2.5e4;                    % Spring stiffness (does not need to be equal for all springs)
%ds_Rest = 0.0;                       % Spring resting length (does not need to be equal for all springs)
%print_Lagrangian_Springs(xLag,yLag,k_Spring,ds_Rest,struct_name);

% Prints .beam file!
% k_Beam = 0.5;                      % Beam Stiffness (does not need to be equal for all beams)
% C = compute_Curvatures(xLag,yLag)  % Computes curvature of initial configuration
%print_Lagrangian_Beams(xLag,yLag,k_Beam,C,struct_name);

% Prints .target file!
k_Target = 2e5;
print_Lagrangian_Target_Pts(xLag,k_Target,struct_name);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: prints VERTEX points to a file called 'struct_name'.vertex
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function print_Lagrangian_Vertices(xLag,yLag,struct_name)

    N = length(xLag); % Total # of Lag. Pts

    vertex_fid = fopen([struct_name '.vertex'], 'w');

    fprintf(vertex_fid, '%d\n', N );

    %Loops over all Lagrangian Pts.
    for s = 1:N
        X_v = xLag(s);
        Y_v = yLag(s);
        fprintf(vertex_fid, '%1.16e %1.16e\n', X_v, Y_v);
    end

    fclose(vertex_fid);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: prints TARGET points to a file called 'struct_name'.target
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function print_Lagrangian_Target_Pts(xLag,k_Target,struct_name)

    N = length(xLag);

    target_fid = fopen([struct_name '.target'], 'w');

    fprintf(target_fid, '%d\n', N );

    %Loops over all Lagrangian Pts.
    for s = 1:N
        fprintf(target_fid, '%d %1.16e\n', s, k_Target);
    end

    fclose(target_fid);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: prints SPRING points to a file called 'struct_name'.spring
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function print_Lagrangian_Springs(xLag,yLag,k_Spring,ds_Rest,struct_name)

    N = length(xLag);

    spring_fid = fopen([struct_name '.spring'], 'w');

    fprintf(spring_fid, '%d\n', N );    % Print # of springs

    %SPRINGS BETWEEN VERTICES
    for s = 1:N
            if s < N
                fprintf(spring_fid, '%d %d %1.16e %1.16e\n', s, s+1, k_Spring, ds_Rest);
            else
                %Case s=N
                fprintf(spring_fid, '%d %d %1.16e %1.16e\n', s, 1,   k_Spring, ds_Rest);
            end
    end
    fclose(spring_fid);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: prints BEAM (Torsional Spring) points to a file called 'struct_name'.beam
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function print_Lagrangian_Beams(xLag,yLag,k_Beam,C,struct_name)

    % k_Beam: beam stiffness
    % C: beam curvature

    N = length(xLag); % NOTE: Total number of beams = Number of Total Lag Pts. - 2

    beam_fid = fopen([struct_name '.beam'], 'w');

    fprintf(beam_fid, '%d\n', N );

    %spring_force = kappa_spring*ds/(ds^2);

    %BEAMS BETWEEN VERTICES
    for s = 2:N-1
            if  s <= N-1
                fprintf(beam_fid, '%d %d %d %1.16e %1.16e\n',s-1, s, s+1, k_Beam, C(s) );
            else
                %Case s=N
                fprintf(beam_fid, '%d %d %d %1.16e %1.16e\n',s-1, s, 1,   k_Beam, C(s) );
            end
    end
    fclose(beam_fid);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: computes "curvature" of starting configuration
%
% NOTE: not curvature in the traditional geometric sense, in the 'discrete'
% sense through cross product.
%
% NOTE: assumes a CLOSED structure
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function C = compute_Curvatures(xLag,yLag)

N = length(xLag);
C = zeros( N );

%Note: needs to be done same order as you print .beam file!
for i=1:N

   % Pts Xp -> Xq -> Xr (same as beam force calc.)

   if ( (i > 1) && (i < N) )

        Xp = xLag(i-1); Xq = xLag(i); Xr = xLag(i+1);
        Yp = yLag(i-1); Yq = yLag(i); Yr = yLag(i+1);

   elseif (i==1)

        Xp = xLag(N); Xq = xLag(i); Xr = xLag(i+1);
        Yp = yLag(N); Yq = yLag(i); Yr = yLag(i+1);

   elseif (i==N)

        Xp = xLag(N-1); Xq = xLag(N); Xr = xLag(1);
        Yp = yLag(N-1); Yq = yLag(N); Yr = yLag(1);

   end

   C(i) = (Xr-Xq)*(Yq-Yp) - (Yr-Yq)*(Xq-Xp); %Cross product btwn vectors

end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: creates the Lagrangian structure geometry
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function [xLag,yLag] = give_Me_Immsersed_Boundary_Geometry(ds,Nx,Lx)

% ds: Lagrangian pt. spacing
% Nx: Eulerian grid resolution

% Gives elliptical subset for tube side
a = 0.5;    % semi-major axis (horizontal)
b = 0.45;   % semi-minor axis (vertical)
ang = pi/6; % angle start/cuttoff for ellipse
[xE,yE] = give_Me_Elliptical_Geometry(ds,a,b,ang);
xOff = 2*xE(1);

% Gives top and bottom portion of one section of tube
d = 0.2;                  % separation distance
xTube = [xE+3*xOff xE+3*xOff xE+2*xOff xE+2*xOff xE+xOff xE+xOff xE xE];          % top first, then bottom
xTube = xTube + 1;
xTube = xTube(end:-1:1);  % reverse it!
yTube = [yE+d/2 -yE-d/2 yE+d/2 -yE-d/2 yE+d/2 -yE-d/2 yE+d/2 -yE-d/2]; % top first, then bottom
yTube = yTube + Lx/2;

% Give indices for to attach valves
ind_Top = 1;                 % node index for first point on top (on RHS)
ind_Bot = length(xTube)/8+1; % node index for first point on bottom (on RHS)

xFlat = xTube(ind_Top)-Lx/20:ds:xTube(ind_Top);
yFlatTop = yTube(ind_Top)*ones(1,length(xFlat));
yFlatBot = yTube(ind_Bot)*ones(1,length(xFlat));

xLag = [xTube xFlat xFlat];
yLag = [yTube yFlatTop yFlatBot];

% Gives valve geometry
[xV,yV] = give_Valve_Geometry(d,ds);

% TESTING (i.e., PLOT IT, yo!)
%plot(xTube,yTube,'b*'); hold on
%len = length(xTube);
%plot(xTube(len/8+1),yTube(len/8+1),'r*'); hold on
%plot(xTube(1),yTube(1),'k*'); hold on;
%axis([0 5 0 5]);
%pause();

%plot(xV,yV,'g*'); hold on;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: gives valve geometry inside a distance, d, between the edges of
% the tube
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function [xV,yV] = give_Valve_Geometry(d,ds)

% for A*x^2 geometry -> 2 eqns and 2 unknowns
%y(0) = 0 = 0
%y(0.9d/2) = A(0.9/2)^2*d^2 = 1.5*d
%
% ----> A = 1.5 / ( (0.45)^2 * d )
%
A = 1.0 / ( (0.45)^2 * d );

yV = -0:ds/2:0.9/2*d;
xV = -A*yV.^2;

%figure(2)
%plot(xV,yV,'b*'); hold on;
%pause();

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: gives elliptical geometry
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function [xE,yE] = give_Me_Elliptical_Geometry(ds,a,b,ang)

dtheta = ds/max(a,b); % use minimum of axis lengths

n = 1;
xE(n) = a*cos(ang); yE(n) = b*sin(ang);
ang_n = ang + dtheta;

while ang_n < (pi/2)

    n = n+1;                % update counter
    xE(n) = a*cos(ang_n);   % next xVal along ellipse
    yE(n) = b*sin(ang_n);   % next yVal along ellipse
    ang_n = ang_n + dtheta; % update angle

end
xE(n+1) = a*cos(pi/2);
yE(n+1) = b*sin(pi/2);

xE = [xE -xE(end-1:-1:1)];
yE = [yE yE(end-1:-1:1)];

yE = yE - yE(1);           % Translate down

%plot(xE,yE,'*'); hold on;
%axis([-a a -a a]);

xLength = abs( 2*xE(1) );
fprintf('\nThe x-Length of the tube section is: %d\n',xLength);


function adjList = meshFaceAdjacency(vertices, edges, faces)
%MESHFACEADJACENCY Compute adjacency list of face around each face.
%
%
%   Example
%     % Create a sample 3D mesh
%     [v, e, f] = createDodecahedron;
%     adjList = meshFaceAdjacency(v, e, f);
%     figure; hold on; axis equal; view([100 40]);
%     drawMesh(v, f);
%     % draw sample face in a different color
%     drawMesh(v, f(1, :), 'faceColor', 'b');
%     % draw the neighbors of a sample face
%     drawMesh(v, f(adjList{1}, :), 'faceColor', 'g')
%
%

% ------
% Author: David Legland
% e-mail: david.legland@grignon.inra.fr
% Created: 2010-10-04,    using Matlab 7.9.0.529 (R2009b)
% Copyright 2010 INRA - Cepia Software Platform.

edgeFaceList = meshEdgeFaces(vertices, edges, faces);

% allocate memory for adjacency list
nFaces = max(edgeFaceList(:));
adjList = cell(1, nFaces);

% iterate over edges to populate adjacency list
for iEdge = 1:size(edgeFaceList)
    f1 = edgeFaceList(iEdge, 1);
    f2 = edgeFaceList(iEdge, 2);
    adjList{f1} = [adjList{f1} f2];
    adjList{f2} = [adjList{f2} f1];
end


% @Author: amishkin
% @Date:   2018-07-10T13:36:34-07:00
% @Email:  amishkin@cs.ubc.ca
% @Last modified by:   aaronmishkin
% @Last modified time: 2018-07-25T13:18:48-07:00

% #################################################
% ############# Reproduce Figure 2(c) #############
% #################################################

% Load the dataset with a fixed seed.
addpath(genpath('.'))

output_dir = './breast_cancer_experiment_data'
mkdir(output_dir)

dataset_name = 'breast_cancer_scale';
[y, X, y_te, X_te] = get_data_log_reg(dataset_name, 1);
[N,D] = size(X);

% Set initial conditions. These will be the same for all methods and restarts.
mu_start = zeros(D,1);
s = 1.*ones(D,1);
sigma_start = diag(1./s);

% Use the same split of the dataset for each random restart.
random_split = 0;

% Run MF_Exact.
method = 'mf_exact'
num_restarts = 1;

% List batch sizes and epochs for each batch size.
% In the case of mf-exact (which is a batch method), the number of epochs controls the number of function
% evaluations L-BFGS is allowed.
epoch_list = [500];
% M_list does not matter for mf-exact because it is a batch method.
M_list = [1]

run_experiment(dataset_name, method, M_list, epoch_list, 0, 0, 0, 0, num_restarts, mu_start, sigma_start, random_split, output_dir)

% Run Vadam with different minibatch sizes:
method = 'Vadam'

% Define the experiment parameters:
num_samples = 1
beta = 0.01;
alpha = 0.01;
decay_rate = 0.55   % controls the rate at which alpha and beta decay during training.

num_restarts = 20;

%  List batch sizes and epochs for each batch size.
M_list = [1,8,16,32,64];
epoch_list = [10000, 10000, 10000, 10000, 10000];

run_experiment(dataset_name, method, M_list, epoch_list, alpha, beta, decay_rate, num_samples, num_restarts, mu_start, sigma_start, random_split, output_dir);

% Run VOGN with a minibatch size of one:
method = 'VOGN'
num_samples = 1
beta = 0.0005;
alpha = 0.0005;
decay_rate = 0;

num_restarts = 20;

%  List batch sizes and epochs for each batch size.
M_list = [1];
epoch_list = [2000];

run_experiment(dataset_name, method, M_list, epoch_list, alpha, beta, decay_rate, num_samples, num_restarts, mu_start, sigma_start, random_split, output_dir);

% generate figure 2(c) using the data from this experiment:
make_fig_two_c


function DCM  = spm_dcm_nvc(P)
% Specify and estimate a DCM for multimodal fMRI and M/EEG
% FORMAT [DCM] = spm_dcm_nvc(P)
%
% Input:
% -------------------------------------------------------------------------
% P{1} - SPM structure or location of SPM.mat
% P{2} - Cell array of VOI filenames (the same order as sources in EEG DCM)
% P{3} - Location of DCM for M/EEG .mat file or DCM structure
% P{4} - Model specification for neurovascular coupling (NVC) mechanisms
% P{5} - Which neuronal populations should drive haemodynamics
% P{6} - Which fMRI experimental conditions to include
% P{7} - DCM options
%
% Where:
%
% P{4} - A cell array of strings with three elements:
%
%   P{4}{1} - 'pre', 'post' or decomposed ('de') neuronal signals excite
%              NVC. Decomposed means activity is grouped into intrinsic-
%              inhibitory, intrinisic-excitatory and extrinsic-excitatory.
%   P{4}{2} - NVC has the same ('s') or different ('d') parameters for all
%              regions.
%   P{4}{3} - extrinsic and intrinsic ('ext') or only intrinsic ('int')
%              neuronal activity contributes to regional BOLD
%              (for 'post', this should be 'na').
%
%   Supported options:
%   {'pre','d','int'},{'pre','s','int'}, {'pre','d','ext'},{'pre','s','ext'},
%   {'de','d', 'int'},{'de','d','exc'},  {'de','s','int'}, {'de','s','exc'},
%   {'post','d','na'},{'post','s','na'};
%
%   Example: P{4} = {'pre', 's', 'int'} means presynaptic neuronal drive
%   (from intrinsic connections only) inputs to a model of neurovascular
%   coupling that has the same parameters for all regions.
%
% P{5} - Which neuronal populations should drive haemodynamics, by setting
%   ones or zeros in a vector ordered:
%   [superficial pyramidal, inhibitory, excitatory, deep pyramidal]
%   (default is [1 1 1 1]).
%
%   Example: [1 0 1 1] means no NVC drive from inhibitory populations.
%
% P{6} - Binary vector indicating which experimental conditions to include.
%
% P{7} - options structure for DCM for fMRI:
%    options.name                   % name for the DCM
%    options.maxit                  % maximum number of iterations
%    options.hE                     % expected precision of the noise
%    options.hC                     % variance of noise expectation
%    options.TE                     % echo time (default: 0.04)
%
% Evaluates:
% -------------------------------------------------------------------------
% DCM.M                              % Model structure
% DCM.Ep                             % Condition means (parameter structure)
% DCM.Cp                             % Conditional covariances
% DCM.Vp                             % Conditional variances
% DCM.Pp                             % Conditional probabilities
% DCM.H1                             % 1st order hemodynamic kernels
% DCM.H2                             % 2nd order hemodynamic kernels
% DCM.K1                             % 1st order neuronal kernels
% DCM.K2                             % 2nd order neuronal kernels
% DCM.R                              % residuals
% DCM.y                              % predicted data
% DCM.T                              % Threshold for Posterior inference
% DCM.Ce                             % Error variance for each region
% DCM.F                              % Free-energy bound on log evidence
% DCM.ID                             % Data ID
% DCM.AIC                            % Akaike Information criterion
% DCM.BIC                            % Bayesian Information criterion
%
% Notes on parameters:
% -------------------------------------------------------------------------
% This scheme estimates DCM.H (haemodynamic parameters) and DCM.J
% (neurovascular coupling parameters):
%
% DCM.Ep.H.transit - transit time (t0)
% DCM.Ep.H.decay   - signal decay d(ds/dt)/ds)
% DCM.Ep.H.epsilon - ratio of intra- to extra-vascular components of the
%                    gradient echo signal
%
% DCM.Ep.J - neurovascular coupling parameters. The dimension depends upon
% the requested model specification. For p populations and n regions:
%
% P{7} (DCM.model)        dim(J)   notes
% =========================================
% {'pre'  'd' 'int'}      [p n]
% {'pre'  's' 'int'}      [p 1]
% {'pre'  'd' 'ext'}      [p n]
% {'pre'  's' 'ext'}      [p 1]
% {'de'   's' 'int}       [p 2]    dim2: intrinsic inhibitory, excitatory
% {'de'   's' 'ext'}      [p 3]    dim2: intrinsic inhibitory, excitatory, extrinsic
% {'de'   'd' 'int}       [p 2 n]  dim2: intrinsic inhibitory, excitatory
% {'de'   'd' 'ext'}      [p 3 n]  dim2: intrinsic inhibitory, excitatory, extrinsic
% {'post' 's' 'na'}       [p 1]
% {'post' 'd' 'na'}       [p n]
%
%__________________________________________________________________________
% Jafarian, A., Litvak, V., Cagnan, H., Friston, K.J. and Zeidman, P., 2019.
% Neurovascular coupling: insights from multi-modal dynamic causal modelling
% of fMRI and MEG. arXiv preprint arXiv:1903.07478.
%
% Friston, K.J., Preller, K.H., Mathys, C., Cagnan, H., Heinzle, J., Razi, A.
% and Zeidman, P., 2017. Dynamic causal modelling revisited. Neuroimage.
%__________________________________________________________________________
% Copyright (C) 2019 Wellcome Trust Centre for Neuroimaging

% Amirhossein Jafarian
% $Id: spm_dcm_nvc.m 7735 2019-12-02 09:15:27Z peter $

% Prepare input
%--------------------------------------------------------------------------
SPM                 =  P{1};
xY                  =  P{2};
MEEG                =  P{3};
try model           =  P{4}; catch, model        = {'pre','d','int'}; end
try n_exclude       =  P{5}; catch, n_exclude    = ones(1,4)        ; end
try sess_exclude    =  P{6}; catch, sess_exclude = 'not defined'    ; end
try options         =  P{7}; catch, options = struct()              ; end

try options.centre;    catch, options.centre      =  1;      end
try options.hE;        catch, options.hE          =  6;      end
try options.hC;        catch, options.hC          =  1/128;  end
try options.maxit;     catch, options.maxit       =  128;    end
try options.TE;        catch, options.TE          =  0.04;   end
try name=options.name; catch, name = sprintf('DCM_%s',date); end

% Set defaults
%--------------------------------------------------------------------------
if (length(n_exclude) < 4 || isempty(n_exclude))
    n_exclude     = ones(1,4);
end
if isempty(sess_exclude)
    sess_exclude = 'not defined';
end

% Specify haemodynamic model
%--------------------------------------------------------------------------
DCM    = spm_dcm_nvc_specify(SPM,xY,MEEG,model,n_exclude,sess_exclude,options);
n      = DCM.n;
v      = DCM.v;
U.dt   = DCM.U.dt;
U.u    = [];

% Prepare fMRI signals
%--------------------------------------------------------------------------
Y       = DCM.Y;
Y.y     = spm_detrend(Y.y);
scale   = max(max(Y.y)) - min(min(Y.y));
scale   = 4/max(scale,4);
Y.y     = Y.y*scale;
Y.scale = scale;
if ~isfield(Y,'X0'),Y.X0 = ones(v,1); end
if ~size(Y.X0,2),   Y.X0 = ones(v,1); end

% Set fMRI slice time sampling and echo time
%--------------------------------------------------------------------------
try M.delays = DCM.delays; catch, M.delays = ones(n,1); end
M.TE = options.TE;

% Set priors
%--------------------------------------------------------------------------
[pE,pC,x] = spm_dcm_nvc_priors(DCM);

% Prepare neuronal drive functions
%--------------------------------------------------------------------------
input     = spm_dcm_nvc_nd(DCM);

% Set hyperpriors over precision - expectation and covariance
%--------------------------------------------------------------------------
hE       = sparse(n,1) + DCM.options.hE;
hC       = speye(n,n)  * DCM.options.hC;

% Prepare model structure
%--------------------------------------------------------------------------
M.IS = @spm_nvc_gen;
M.x  = x;
M.pE = pE;
M.pC = pC;
M.hE = hE;
M.hC = hC;
M.m  = n;
M.n  = size(spm_vec(x),1);
M.l  = n;
M.ns = v;
M.Nmax = options.maxit ;
M.TE  = DCM.TE;
M.input = input;
M.Model = model;
M.nograph = spm('CmdLine');

% Model Identification methods
% =========================================================================
[Ep,Cp,Eh,F] = spm_nlsi_GN(M,U,Y);

% Compute the prediction, residuals and error variance
%--------------------------------------------------------------------------
yhat     = feval(M.IS,Ep,M,U);
R        = Y.y - yhat;
R        = R - Y.X0*spm_inv(Y.X0'*Y.X0)*(Y.X0'*R);
Ce       = exp(-Eh);

% Compute variance that is captured by the data
%--------------------------------------------------------------------------
PSS      = sum(yhat.^2);
RSS      = sum(R.^2);
D        = 100.*PSS./(PSS + RSS);

% Compute kernels
%--------------------------------------------------------------------------
H.f      = @spm_fx_hdm;
H.g      = @spm_gx_hdm;
H.x      = M.x;
H.m      = n;
[H0,H1]  = spm_kernels(H,Ep.H,64,1/2);

% Compute posterior probabilities per parameter
%--------------------------------------------------------------------------
T        = full(spm_vec(pE));
sw       = warning('off','SPM:negativeVariance');
Pp       = spm_unvec(1 - spm_Ncdf(T,abs(spm_vec(Ep)),diag(Cp)),Ep);
Vp       = spm_unvec(full(diag(Cp)),Ep);
warning(sw);
try  M = rmfield(M,'nograph'); end

% Store parameter estimates
%--------------------------------------------------------------------------
DCM.M       = M;
DCM.Y       = Y;
DCM.U       = U;
DCM.Ce      = Ce;
DCM.Ep      = Ep;
DCM.Cp      = Cp;
DCM.Pp      = Pp;
DCM.Vp      = Vp;
DCM.H1      = H1;
DCM.D       = D;
DCM.R       = R;
DCM.y       = yhat;
DCM.t       = (1:size(yhat,1))*DCM.Y.dt;

% Compute data ID
%--------------------------------------------------------------------------
if isfield(M,'FS')
    try
        ID = spm_data_id(feval(M.FS,Y.y,M));
    catch
        ID = spm_data_id(feval(M.FS,Y.y));
    end
else
    ID     = spm_data_id(Y.y);
end

% Store evidence
%--------------------------------------------------------------------------
DCM.F      = F;
DCM.ID     = ID;

%-Save DCM
%--------------------------------------------------------------------------
DCM.name = name;
save(DCM.name, 'DCM', spm_get_defaults('mat.format'));


function [g1, g2] = simwhiteXsimwhiteKernGradient(simKern1, simKern2, t1, varargin)

% SIMWHITEXSIMWHITEKERNGRADIENT Compute a cross gradient between two
% SIM-WHITE kernels.
% FORMAT
% DESC computes cross gradient of parameters of a cross kernel
% between two SIM-WHITE kernels for the multiple output kernel.
% ARG simKern1 : the kernel structure associated with the first SIM-WHITE
% kernel.
% ARG simKern2 : the kernel structure associated with the second SIM-WHITE
% kernel.
% ARG t1 : inputs for which kernel is to be computed.
% ARG covGrad : gradient of the objective function with respect to
% the elements of the cross kernel matrix.
% RETURN g1 : gradient of the parameters of the first kernel, for
% ordering see simwhiteKernExtractParam.
% RETURN g2 : gradient of the parameters of the second kernel, for
% ordering see simwhiteKernExtractParam.
%
% FORMAT
% DESC computes cross kernel terms between two SIM-WHITE kernels for
% the multiple output kernel.
% ARG simKern1 : the kernel structure associated with the first SIM-WHITE
% kernel.
% ARG simKern2 : the kernel structure associated with the second SIM-WHITE
% kernel.
% ARG t1 : row inputs for which kernel is to be computed.
% ARG t2 : column inputs for which kernel is to be computed.
% ARG covGrad : gradient of the objective function with respect to
% the elements of the cross kernel matrix.
% RETURN g1 : gradient of the parameters of the first kernel, for
% ordering see simwhiteKernExtractParam.
% RETURN g2 : gradient of the parameters of the second kernel, for
% ordering see simwhiteKernExtractParam.
%
% SEEALSO : multiKernParamInit, multiKernCompute, simwhiteKernParamInit,
% simwhiteKernExtractParam
%
% COPYRIGHT : David Luengo, 2009

% KERN

if nargin < 5
    t2 = t1;
else
    t2 = varargin{1};
end
covGrad = varargin{end};

if size(t1, 2) > 1 | size(t2, 2) > 1
  error('Input can only have one column');
end
if simKern1.variance ~= simKern2.variance
  error('Kernels cannot be cross combined if they have different variances.')
end

% Parameters of the kernels required in the computation
variance = simKern1.variance;
sensitivity1 = simKern1.sensitivity;
sensitivity2 = simKern2.sensitivity;
decay1 = simKern1.decay;
decay2 = simKern2.decay;

isStationary = (simKern1.isStationary == true) & (simKern2.isStationary == true);

% Auxiliary constants, vectors and matrices
g1 = zeros(1,3);
g2 = zeros(1,3);

T1 = repmat(t1, 1, size(t2, 1));
T2 = repmat(t2.', size(t1, 1), 1);
ind1 = (T1 < T2);
ind2 = ~ind1;
Dv = decay2 .* ind1 + decay1 .* ind2;
K1 = exp(-Dv.*abs(T1-T2));
if (isStationary == false)
    K2 = exp(-(decay1 * T1 + decay2 * T2));
end

if (isStationary == false)
    % Gradient w.r.t. the decays (D_p and D_q)
    g1(1) = (variance * sensitivity1 * sensitivity2 / (decay1 + decay2)) ...
        * sum(sum((-(K1 - K2)/(decay1 + decay2) ...
            - abs(T1 - T2) .* K1 .* ind2 + T1 .* K2) .* covGrad));
    g2(1) = (variance * sensitivity1 * sensitivity2 / (decay1 + decay2)) ...
        * sum(sum((-(K1 - K2)/(decay1 + decay2) ...
            - abs(T1 - T2) .* K1 .* ind1 + T2 .* K2) .* covGrad));
    % Gradient w.r.t. the variance of the driving process
    g1(2) = (sensitivity1 * sensitivity2 / (decay1 + decay2)) ...
        * sum(sum((K1-K2) .* covGrad));
    g2(2) = 0; % Otherwise it is counted twice
    % Gradient w.r.t. the sensitivities
    g1(3) = (variance * sensitivity2 / (decay1 + decay2)) ...
        * sum(sum((K1-K2) .* covGrad));
    g2(3) = (variance * sensitivity1 / (decay1 + decay2)) ...
        * sum(sum((K1-K2) .* covGrad));
else
    % Gradient w.r.t. the decays (D_p and D_q)
    g1(1) = - (variance * sensitivity1 * sensitivity2 / (decay1 + decay2)) ...
        * sum(sum((K1/(decay1 + decay2) + abs(T1 - T2) .* K1 .* ind2) .* covGrad));
    g2(1) = - (variance * sensitivity1 * sensitivity2 / (decay1 + decay2)) ...
        * sum(sum((K1/(decay1 + decay2) + abs(T1 - T2) .* K1 .* ind1) .* covGrad));
    % Gradient w.r.t. the variance of the driving process
    g1(2) = (sensitivity1 * sensitivity2 / (decay1 + decay2)) ...
        * sum(sum(K1 .* covGrad));
    g2(2) = 0; % Otherwise it is counted twice
    % Gradient w.r.t. the sensitivities
    g1(3) = (variance * sensitivity2 / (decay1 + decay2)) ...
        * sum(sum(K1 .* covGrad));
    g2(3) = (variance * sensitivity1 / (decay1 + decay2)) ...
        * sum(sum(K1 .* covGrad));
end


 function st = nufft_table_init(om, Nd, Jd, Kd, n_shift, Ld, varargin)
%function st = nufft_table_init(om, Nd, Jd, Kd, n_shift, Ld, ...)
%|
%| Initialize structure for d-dimension NUFFT using table-based interpolator,
%| This should be called only by nufft_init with its 'table' argument!
%| (So this m-file belongs in the private directory.)
%|
%| in
%|	om, Nd, Jd, Kd, n_shift		see nufft_init.m
%|	Ld [d]				table over-sampling factor(s)
%|
%| optional arguments (same as nufft_init.m, to specify interp type)
%| out
%|	st.interp_table		function: X = st.interp_table(st, Xk);
%|	st.interp_table_adj	function: Xk = st.interp_table_adj(st, Xk);
%|	st.phase_shift		phase shift due to n_shift
%|	st.*			same as in nufft_init.m
%|
%| Copyright 2004-3-30, Jeff Fessler and Yingying Zhang, University of Michigan

if nargin < 5, help(mfilename), error args, end

% dimensionality of input space (usually 2 or 3)
dd = length(Nd);
if dd > 1 && length(Ld) == 1
	Ld = Ld * ones(1,dd); % allow scalar L to be used for all dimensions
end
if dd ~= length(Jd) || dd ~= length(Kd) || dd ~= length(Ld)
	printm('dd:'), disp(dd)
	printm('Jd:'), disp(Jd)
	printm('Kd:'), disp(Kd)
	printm('Ld:'), disp(Ld)
	error 'inconsistent dim'
end
if dd ~= size(om,2), error('omega needs %d columns', dd), end

% D-dim NUFFT structure with desired scaling factors, using fake omega=0
st = nufft_init(zeros(size(Nd)), Nd, Jd, Kd, 0*n_shift, varargin{:});
st.p = [];
st.om = om;
st.Ld = Ld;
st.M = size(om,1);
st.n_shift = n_shift; % trick: store it in structure for history

% phase shift associated with indexing n_shift
% trick: because we put this phase shift here, we use "0" for n_shift below
% when building the tables.  in fact, n_shift definitely cannot be in table.
if any(n_shift ~= 0)
	st.phase_shift = exp(1i * (om * n_shift(:))); % [M 1]
end

% 1D tables for each dimension
for id = 1:dd
	J = Jd(id);
	L = Ld(id);
	K = Kd(id);

	% This is a slow and inefficient way to get the table
	% since it builds a huge sparse matrix but only uses 1 column!
	t0 = [-J*L/2:J*L/2]' / L; % [J*L+1]
	if 0
		om0 = t0 * 2*pi/K; % gam(id)
		s1 = nufft_init(om0, Nd(id), J, K, ...
			0*n_shift(id), varargin{:}); % user's interpolator
		h0 = full(s1.p(:,1));
	end

	% This efficient way uses only "J" columns of sparse matrix!
	% The trick to this is to use fake small values for N and K,
	% which works for interpolators that depend only on the ratio K/N.
	ktype = varargin{1};
	if 0 && (streq(ktype, 'minmax:kb') || streq(ktype, 'kaiser'))

		if streq(ktype, 'minmax:kb')
			args = {'minmax:user', {st.alpha{id}}, {st.beta{id}}};
		elseif streq(ktype, 'kaiser')
			args = {'kaiser'};
			if length(varargin) > 1, warning 'bug?', end
		else
			error 'bug'
		end

		Nfake = J;
		Kfake = Nfake * K/Nd(id);
		t1 = J/2-1 + [0:(L-1)]' / L;	% [L]
		om1 = t1 * 2*pi/Kfake;		% "gam"
		s1 = nufft_init(om1, Nfake, J, Kfake, 0, args{:});

		h = [];
		for jj=J:-1:1
			h = [h; full(s1.p(:,jj))]; % stack up pieces
		end
		h = [h; 0]; % finally J*L+1 long.
		h = h .* exp(1i * pi * t0 * (1/K - 1/Kfake)); % fix phase

		if 0	% testing
			clf, subplot(211)
			plot(t0, real(h0), 'c-', t0, real(h), 'y.')
			plot(t0, real(h0-h), 'y.')
			subplot(212)
			plot(t0, imag(h0), 'c-', t0, imag(h), 'y.')
			plot(t0, imag(h0-h), 'y.')
			printf('diff=%g', max_percent_diff(h0, h))
			keyboard
		end
		st.h{id} = double(h); % table mex files want double

	% This way is "J times faster" than the slow way, but still not ideal.
	% It works for any user-specified interpolator.
	else
		t1 = J/2-1 + [0:(L-1)]' / L; % [L]
		om1 = t1 * 2*pi/K; % gam(id)

		% trick: handle {'kaiser', [kb_alf], [kb_m]} in multidim case
		if streq(varargin{1}, 'kaiser') && length(varargin) == 3
			kb_alf = varargin{2};
			kb_m = varargin{3};
			if any(kb_alf ~= kb_alf(1)) || any(kb_m ~= kb_m(1))
				error 'table based needs identical interpolator for each dimension'
			end
			varargin{2} = kb_alf(1);
			varargin{3} = kb_m(1);
		end

		s1 = nufft_init(om1, Nd(id), J, K, 0*n_shift(id), varargin{:});

		h = [];
		for jj=J:-1:1
			h = [h; full(s1.p(:,jj))];
		end
		h = [h; 0];

		st.h{id} = double(h); % table mex files want double
		if 0	% testing
			clf, subplot(211)
			plot(t0, real(h0), 'c-', t0, real(h), 'y.')
			subplot(212)
			plot(t0, imag(h0), 'c-', t0, imag(h), 'y.')
			printf('diff=%g', max_percent_diff(h0, h))
			keyboard
		end
	end

	if isreal(st.h{id})
		if J == 1
			st.h{id} = complex(st.h{id});
		else
			whos
			warning 'real kernel?'
			keyboard
		end
	end

end

% interface routines
% st.interp_table = inline('nufft_table_interp(st, Xk)', 'st', 'Xk');
st.interp_table		= @nufft_table_interp;
st.interp_table_adj	= @nufft_table_adj;


classdef linop
%linop A class for linear operators

% written by M. Storath
% $Date: 2015-10-15 15:07:43 +0200 (Do, 15. Okt 2015) $	$Revision: 132 $

    properties
        % function handle for evaluation A * x
        eval;
        % function handle for evaluation A' * x
        ctrans;
        % A'A
        normalOp;
        % true if A'A positive definite
        posdef;
        % true if A'A positive definite
        lseSolver;
    end

    methods
        % constructor
        function A = linop(eval, ctrans, varargin)
            % if it is a matrix
            if ~isa(eval, 'function_handle')
                A.eval = @(x) eval * x;
                A.ctrans = @(x) eval' * x;
                M = eval' * eval;
                A.normalOp = @(x) M * x;
            else
                A.eval = eval;
                A.ctrans = ctrans;
                A.normalOp = @(x) A.ctrans(A.eval(x));
            end
            ip = inputParser;
            addParamValue(ip, 'posdef', false);
            addParamValue(ip, 'lseSolver', []);
            parse(ip, varargin{:});
            par = ip.Results;
            A.posdef = par.posdef;
            A.lseSolver = par.lseSolver;
        end

        % ctranspose (')
        function C = ctranspose(A)
            C =  linop(A.ctrans, A.eval);
        end

        % mtimes (*)
        function C = mtimes( A, B )
            if isa(B, 'linop')
                C = linop( @(x) A.eval(B.eval(x)), @(x) B.ctrans(A.ctrans(x)));
            else
                C = A.eval(B);
            end
        end

        % size
        function s = size(A)
            %warning('Size is deprecated for class linop');
            s = [1 1];
        end

    end
end


%% Copyright (C) 2006 Sylvain Pelissier <sylvain.pelissier@gmail.com>
%% Copyright (C) 2015-2016 Colin B. Macdonald <cbm@m.fsf.org>
%%
%% This program is free software; you can redistribute it and/or modify it under
%% the terms of the GNU General Public License as published by the Free Software
%% Foundation; either version 3 of the License, or (at your option) any later
%% version.
%%
%% This program is distributed in the hope that it will be useful, but WITHOUT
%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
%% details.
%%
%% You should have received a copy of the GNU General Public License along with
%% this program; if not, see <http://www.gnu.org/licenses/>.

%% -*- texinfo -*-
%% @documentencoding UTF-8
%% @defun dirac (@var{x})
%% Compute the Dirac delta (generalized) function.
%%
%% The Dirac delta ``function'' is a generalized function (or distribution)
%% which is zero almost everywhere, except at the origin where it is
%% infinite.
%%
%% Examples:
%% @example
%% @group
%% dirac (0)
%%   @result{} Inf
%% dirac (1)
%%   @result{} 0
%% dirac ([-10 -1 0 1 inf])
%%   @result{} 0     0   Inf     0     0
%% @end group
%% @end example
%% @seealso{heaviside, @@sym/dirac}
%% @end defun

function y = dirac(x)
  if (nargin ~= 1)
    print_usage ();
  end

  if (~isreal (x))
    error ('dirac: X must not contain complex values');
  end

  y = zeros (size (x), class (x));
  y(x == 0) = Inf;

  y(isnan (x)) = NaN;
end

%!assert (isinf (dirac (0)))
%!assert (dirac (1) == 0)
%!assert (isnan (dirac (nan)))
%!assert (isequaln (dirac ([-1 1 0 eps inf -inf nan]), [0 0 inf 0 0 0 nan]))
%!error <complex values> dirac (1i)
%!assert (isa (dirac (single (0)), 'single'))


function hmm = updateOmega(hmm,Gamma,residuals,XX,XXGXX,XW,Tfactor,rangeK)

is_gaussian = hmm.train.order == 0; % true if Gaussian observation model is being used
K = hmm.K; ndim = hmm.train.ndim;
if nargin < 8 || isempty(rangeK), rangeK = 1:K; end
if nargin < 7, Tfactor = 1; end
setstateoptions
T = size(residuals,1);
if isfield(hmm.train,'B'), Q = size(hmm.train.B,2);
else Q = ndim; end

if (strcmp(hmm.train.covtype,'uniquediag') || strcmp(hmm.train.covtype,'shareddiag')) ...
        && hmm.train.uniqueAR
    % all are AR and there's a single covariance matrix
    hmm.Omega.Gam_rate = hmm.prior.Omega.Gam_rate;
    for k = rangeK
        if ~isempty(XW)
            XWk = XW(:,:,k);
        else
            XWk = zeros(size(residuals));
        end
        e = (residuals - XWk).^2;
        swx2 = zeros(T,ndim);
        for n=1:ndim
            ind = n:ndim:size(XX,2);
            tmp = XX(:,ind) * hmm.state(k).W.S_W;
            swx2(:,n) = sum(tmp .* XX(:,ind),2);
        end
        hmm.Omega.Gam_rate = hmm.Omega.Gam_rate + ...
            0.5 * Tfactor * sum( bsxfun(@times, e + swx2, Gamma(:,k)) );
    end
    hmm.Omega.Gam_shape = hmm.prior.Omega.Gam_shape + 0.5 * Tfactor * T;

elseif strcmp(hmm.train.covtype,'uniquediag') || strcmp(hmm.train.covtype,'shareddiag')
    hmm.Omega.Gam_rate(regressed) = hmm.prior.Omega.Gam_rate(regressed);
    for k = rangeK
        if ~isempty(XW)
            XWk = XW(:,:,k);
        else
            XWk = zeros(size(residuals));
        end
        e = (residuals(:,regressed) - XWk(:,regressed)).^2;
        swx2 = zeros(T,ndim);
        if ~isempty(hmm.state(k).W.Mu_W)
            for n = 1:ndim
                if ~regressed(n), continue; end
                if ndim==1
                    tmp = XX(:,Sind(:,n)) * hmm.state(k).W.S_W;
                else
                    tmp = XX(:,Sind(:,n)) * permute(hmm.state(k).W.S_W(n,Sind(:,n),Sind(:,n)),[2 3 1]);
                end
                swx2(:,n) = sum(tmp .* XX(:,Sind(:,n)),2);
            end
        end
        hmm.Omega.Gam_rate(regressed) = hmm.Omega.Gam_rate(regressed) + ...
            0.5 * Tfactor * sum( bsxfun(@times, e + swx2(:,regressed), Gamma(:,k)));
    end
    hmm.Omega.Gam_shape = hmm.prior.Omega.Gam_shape + 0.5 * Tfactor * T;

elseif strcmp(hmm.train.covtype,'uniquefull') || strcmp(hmm.train.covtype,'sharedfull')
    hmm.Omega.Gam_rate(regressed,regressed) = hmm.prior.Omega.Gam_rate(regressed,regressed);
    for k = rangeK
        if ~isempty(XW)
            XWk = XW(:,:,k);
        else
            XWk = zeros(size(residuals));
        end
        e = (residuals(:,regressed) - XWk(:,regressed));
        e = (bsxfun(@times,e,Gamma(:,k)))' * e;
        if all(S(:)==1)
            swx2 =  zeros(ndim,ndim);
            if ~isempty(hmm.state(k).W.Mu_W)
                for n1=find(regressed)
                    for n2=find(regressed)
                        if n2<n1, continue, end
                        if hmm.train.pcapred>0
                            index1 = (0:hmm.train.pcapred+(~hmm.train.zeromean)-1) * ndim + n1;
                            index2 = (0:hmm.train.pcapred+(~hmm.train.zeromean)-1) * ndim + n2;
                        else
                            index1 = (0:length(orders)*Q+(~hmm.train.zeromean)-1) * ndim + n1;
                            index2 = (0:length(orders)*Q+(~hmm.train.zeromean)-1) * ndim + n2;
                            index1 = index1(Sind(:,n1)); index2 = index2(Sind(:,n2));
                        end
                        swx2(n1,n2) = sum(sum(hmm.state(k).W.S_W(index1,index2) .* XXGXX{k}(Sind(:,n1),Sind(:,n2))));
                        swx2(n2,n1) = swx2(n1,n2);
                    end
                end
            end
            hmm.Omega.Gam_rate(regressed,regressed) = hmm.Omega.Gam_rate(regressed,regressed) ...
                + Tfactor * (e + swx2(regressed,regressed));
        else % multivariate regression model
            index_iv = sum(S,2)>0; % the independent variables
            xdim = sum(index_iv);
            ydim = sum(regressed);
            S_W = hmm.state(k).W.S_W(logical(S(:)),logical(S(:)));
            L = chol(S_W)';
            XGX = (bsxfun(@times,residuals(:,index_iv),Gamma(:,k)))' * residuals(:,index_iv);
            tracesum = zeros(ydim,ydim);
            for iL = 1:xdim*ydim
                vecinvL = reshape(L(:,iL),xdim,ydim);
                tracesum = tracesum + vecinvL'*XGX*vecinvL;
            end
            hmm.Omega.Gam_rate(regressed,regressed) = hmm.Omega.Gam_rate(regressed,regressed) + tracesum + e;
        end
    end
    hmm.Omega.Gam_rate(regressed,regressed) = (hmm.Omega.Gam_rate(regressed,regressed) + ...
        hmm.Omega.Gam_rate(regressed,regressed)') / 2;
    hmm.Omega.Gam_irate(regressed,regressed) = inv(hmm.Omega.Gam_rate(regressed,regressed));
    hmm.Omega.Gam_shape = hmm.prior.Omega.Gam_shape + Tfactor * T;

else % state dependent

    Gammasum = sum(Gamma);
    for k = rangeK
        if ~hmm.train.active, continue; end
        if ~isempty(XW)
            XWk = XW(:,:,k);
        else
            XWk = zeros(size(residuals));
        end
        if train.uniqueAR
            e = (residuals - XWk).^2;
            swx2 = zeros(T,ndim);
            for n = 1:ndim
                ind = n:ndim:size(XX,2);
                swx2(:,n) = sum(XX(:,ind) * hmm.state(k).W.S_W .* XX(:,ind),2);
            end
            hmm.state(k).Omega.Gam_rate = hmm.state(k).prior.Omega.Gam_rate + ...
                0.5 * Tfactor * sum( bsxfun(@times, e + swx2, Gamma(:,k)) );
            hmm.state(k).Omega.Gam_shape = hmm.state(k).prior.Omega.Gam_shape ...
                + 0.5 * Tfactor * Gammasum(k);

        elseif strcmp(train.covtype,'diag')
            e = (residuals(:,regressed) - XWk(:,regressed)).^2;
            swx2 = zeros(T,ndim);
            if ~isempty(hmm.state(k).W.Mu_W)
                for n=1:ndim
                    if ~regressed(n), continue; end
                    if ndim==1
                        swx2(:,n) = sum(XX(:,Sind(:,n)) * hmm.state(k).W.S_W(Sind(:,n),Sind(:,n)) ...
                            .* XX(:,Sind(:,n)),2);
                    else
                        swx2(:,n) = sum(XX(:,Sind(:,n)) * permute(hmm.state(k).W.S_W(n,Sind(:,n),Sind(:,n)),[2 3 1]) ...
                            .* XX(:,Sind(:,n)),2);
                    end
                end
            end
            hmm.state(k).Omega.Gam_rate(regressed) = hmm.state(k).prior.Omega.Gam_rate(regressed) + ...
                0.5 * Tfactor * sum( bsxfun(@times, e + swx2(:,regressed), Gamma(:,k)) );
            hmm.state(k).Omega.Gam_shape = hmm.state(k).prior.Omega.Gam_shape + 0.5 * Tfactor * Gammasum(k);

        else % full
            if is_gaussian
                if hmm.train.zeromean % If zeromean == 1 for Gaussian model, then XWk=0 and we don't need to subtract at all
                    e = residuals(:,regressed);
                else % If zeromean == 0 for Gaussian model, then XWk has all the same rows, and bsxfun() is a fair bit faster
                    e = bsxfun(@minus,residuals(:,regressed),XWk(1,regressed));
                end
            else
                e = (residuals(:,regressed) - XWk(:,regressed));
            end
            e = (bsxfun(@times,e,Gamma(:,k)))' * e;
            if all(S(:)==1)
                swx2 =  zeros(ndim,ndim);
                if ~isempty(hmm.state(k).W.Mu_W)
                    orders = formorders(train.order,train.orderoffset,train.timelag,train.exptimelag);
                    if isempty(orders)
                        swx2 = hmm.state(k).W.S_W * XXGXX{k};
                    else
                        for n1=find(regressed)
                            for n2=find(regressed)
                                if n2<n1, continue, end
                                if hmm.train.pcapred>0
                                    index1 = (0:hmm.train.pcapred+(~train.zeromean)-1) * ndim + n1;
                                    index2 = (0:hmm.train.pcapred+(~train.zeromean)-1) * ndim + n2;
                                else
                                    index1 = (0:length(orders)*Q+(~train.zeromean)-1) * ndim + n1;
                                    index2 = (0:length(orders)*Q+(~train.zeromean)-1) * ndim + n2;
                                    index1 = index1(Sind(:,n1)); index2 = index2(Sind(:,n2));
                                end
                                swx2(n1,n2) = sum(sum(hmm.state(k).W.S_W(index1,index2) .* XXGXX{k}(Sind(:,n1),Sind(:,n2))));
                                swx2(n2,n1) = swx2(n1,n2);
                            end
                        end
                    end
                end
                hmm.state(k).Omega.Gam_rate(regressed,regressed) = hmm.state(k).prior.Omega.Gam_rate(regressed,regressed) + ...
                    Tfactor * (e + swx2(regressed,regressed));
            else % multivariate regression model
                index_iv = sum(S,2)>0; % the independent variables
                xdim = sum(index_iv);
                ydim = sum(regressed);
                S_W = hmm.state(k).W.S_W(logical(S(:)),logical(S(:)));
                L = chol(S_W)';
                XGX = (bsxfun(@times,residuals(:,index_iv),Gamma(:,k)))' * residuals(:,index_iv);
                tracesum = zeros(ydim,ydim);
                for iL = 1:xdim*ydim
                    vecinvL = reshape(L(:,iL),xdim,ydim);
                    tracesum = tracesum + vecinvL'*XGX*vecinvL;
                end

                hmm.state(k).Omega.Gam_rate(regressed,regressed) = tracesum + e + ...
                    hmm.state(k).prior.Omega.Gam_rate(regressed,regressed);
            end

            hmm.state(k).Omega.Gam_shape = hmm.state(k).prior.Omega.Gam_shape + Tfactor * Gammasum(k);
            hmm.state(k).Omega.Gam_irate(regressed,regressed) = inv(hmm.state(k).Omega.Gam_rate(regressed,regressed));

            %if train.FC
            %    C0 = hmm.state(k).Omega.Gam_rate(regressed,regressed) / hmm.state(k).Omega.Gam_shape;
            %    C = hmm.train.A' * corrcov(hmm.train.A * C0 * hmm.train.A',1) * hmm.train.A;
            %    %iC = hmm.train.A' * pinv(corrcov(hmm.train.A * C0 * hmm.train.A'),1e-10) * hmm.train.A;
            %    iC = hmm.train.A' * ( (corrcov(hmm.train.A * C0 * hmm.train.A',1)+1e-4*eye(size(hmm.train.A,1))) ...
            %           \ hmm.train.A);
            %    hmm.state(k).Omega.Gam_rate(regressed,regressed) = C * hmm.state(k).Omega.Gam_shape;
            %    hmm.state(k).Omega.Gam_irate(regressed,regressed) = iC / hmm.state(k).Omega.Gam_shape;
            %end

            % ensuring symmetry
            hmm.state(k).Omega.Gam_rate(regressed,regressed) = (hmm.state(k).Omega.Gam_rate(regressed,regressed) + ...
                hmm.state(k).Omega.Gam_rate(regressed,regressed)') / 2;
            hmm.state(k).Omega.Gam_irate(regressed,regressed) = (hmm.state(k).Omega.Gam_irate(regressed,regressed) + ...
                hmm.state(k).Omega.Gam_irate(regressed,regressed)') / 2;

        end
    end

end

end


function [f, energ, diagn] = scaled_mh(f, opt, gp, x, y, z)
%SCALED_MH  A scaled Metropolis-Hastings sampling for latent values
%
%  Description
%    [F, ENERG, DIAG] = SCALED_MH(F, OPT, GP, X, Y) takes the
%    current latent values F, options structure OPT, Gaussian
%    process structure GP, inputs X and outputs Y. Samples new
%    latent values and returns also energies ENERG and diagnostics
%    DIAG. The latent values are sampled from their conditional
%    posterior p(f|y,th).
%
%    The latent values are whitened with the prior covariance
%    before the sampling. This reduces the autocorrelation and
%    speeds up the mixing of the sampler. See (Neal, 1998) for
%    details on implementation.
%
%    The options structure should include the following fields:
%      repeat              - the number of MH-steps before
%                            returning a single sample (default 10)
%      sample_latent_scale - the scale for the MH-step (default 0.5)
%
%    OPT = SCALED_MH() Returns default options
%
%    OPT = SCALED_MH(OPT) Returns default options for fields not
%    yet set in OPT
%
%   Reference:
%
%    Neal, R. M. (1998) Regression and classification using
%    Gaussian process priors (with discussion), in J. M. Bernardo,
%    et al (editors) Bayesian Statistics 6, Oxford University
%    Press, pp. 475-501:
%
%  See also
%    GP_MC
%
% Copyright (c) 1999,2011 Aki Vehtari
% Copyright (c) 2006-2010 Jarno Vanhatalo

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

% set default options using hmc2_opt
  if nargin<=1
    if nargin==0
      f=scaled_mh_opt();
    else
      f=scaled_mh_opt(f);
    end
    return
  end

  [n,nout] = size(y);
  if isfield(gp.lik, 'nondiagW')
    switch gp.lik.type
      case {'LGP', 'LGPC'}
        % Do nothing
      case {'Softmax', 'Multinom'}
        % Do nothing
      otherwise
        nout=length(gp.comp_cf);
    end
    if isfield(gp, 'comp_cf')  % own covariance for each ouput component
      multicf = true;
      if length(gp.comp_cf) ~= nout
        error('SCALED_MH: the number of component vectors in gp.comp_cf must be the same as number of outputs.')
      end
    else
      multicf = false;
    end
  end
  f = reshape(f,n,nout);

  maxcut = -log(eps);
  mincut = -log(1/realmin - 1);
  lvs=opt.sample_latent_scale;
  a = max(min(f, maxcut),mincut);

  switch gp.type
    case {'FULL'}

      if ~isfield(gp.lik, 'nondiagW') || ismember(gp.lik.type, {'LGP' 'LGPC'})
        [K,C]=gp_trcov(gp, x);
        if isfield(gp,'meanf')
          [H_m,b_m,B_m]=mean_prep(gp,x,[]);
          C = C + H_m'*B_m*H_m;
        end
        L=chol(C)';
      else
        L = zeros(n,n,nout);
        if multicf
          for i1=1:nout
            [tmp, C] = gp_trcov(gp, x, gp.comp_cf{i1});
            L(:,:,i1)=chol(C, 'lower');
          end
        else
          for i1=1:nout
            [tmp, C] = gp_trcov(gp, x);
            L(:,:,i1)=chol(C, 'lower');
          end
        end
      end
      e = -gp.lik.fh.ll(gp.lik, y, f, z);
      ft = zeros(size(y));

      % Adaptive control algorithm to find such a value for lvs
      % that the rejection rate of Metropolis is optimal.
      slrej = 0;
      for li=1:100
        for i1 =1:nout
          ft(:,i1)=sqrt(1-lvs.^2).*f(:,i1)+lvs.*L(:,:,i1)*randn(n,1);
        end
        ed = -gp.lik.fh.ll(gp.lik, y, ft, z);
        a=e-ed;
        if exp(a) > rand(1)
          f=ft;
          e=ed;
          lvs=min(1,lvs*1.1);
        else
          lvs=max(1e-8,lvs/1.05);
        end
      end
      opt.sample_latent_scale=lvs;
      % Do the actual sampling
      for li=1:(opt.repeat)
        for i1 =1:nout
          ft(:,i1)=sqrt(1-lvs.^2).*f(:,i1)+lvs.*L(:,:,i1)*randn(n,1);
        end
        ed = -gp.lik.fh.ll(gp.lik, y, ft, z);
        a=e-ed;
        if exp(a) > rand(1)
          f=ft;
          e=ed;
        else
          slrej=slrej+1;
        end
      end
      diagn.rej = slrej/opt.repeat;
      diagn.lvs = lvs;
      diagn.opt=opt;
      energ=[];
      f = f(:)';

    case 'FIC'
      u = gp.X_u;
      m = size(u,1);
      % Turn the inducing vector on right direction
      if size(u,2) ~= size(x,2)
        u=u';
      end
      % Calculate some help matrices
      [Kv_ff, Cv_ff] = gp_trvar(gp, x);
      K_fu = gp_cov(gp, x, u);
      K_uu = gp_trcov(gp, u);
      Luu = chol(K_uu)';

      % Evaluate the Lambda (La)
      B=Luu\(K_fu');
      Qv_ff=sum(B.^2)';
      Lav = Cv_ff-Qv_ff;
      sLav = sqrt(Lav);

      n=length(y);
      e = -gp.lik.fh.ll(gp.lik, y, f, z);

      % Adaptive control algorithm to find such a value for lvs
      % so that the rejection rate of Metropolis is optimal.
      slrej = 0;
      for li=1:100
        ft=sqrt(1-lvs.^2).*f + lvs.*(sLav.*randn(n,1) + B'*randn(m,1));
        ed = -gp.lik.fh.ll(gp.lik, y, ft, z);
        a=e-ed;
        if exp(a) > rand(1)
          f=ft;
          e=ed;
          lvs=min(1,lvs*1.1);
        else
          lvs=max(1e-8,lvs/1.05);
        end
      end
      opt.sample_latent_scale=lvs;
      % Do the actual sampling
      for li=1:(opt.repeat)
        ft=sqrt(1-lvs.^2).*f + lvs.*(sLav.*randn(n,1) + B'*randn(m,1));
        ed = -gp.lik.fh.ll(gp.lik, y, ft, z);
        a=e-ed;
        if exp(a) > rand(1)
          f=ft;
          e=ed;
        else
          slrej=slrej+1;
        end
      end
      diagn.rej = slrej/opt.repeat;
      diagn.lvs = lvs;
      diagn.opt=opt;
      energ=[];
      f = f';

    case 'PIC'
      u = gp.X_u;
      m = size(u,1);
      ind = gp.tr_index;
      if size(u,2) ~= size(x,2)
        u=u';
      end

      % Calculate some help matrices
      [Kv_ff, Cv_ff] = gp_trvar(gp, x);  % 1 x f  vector
      K_fu = gp_cov(gp, x, u);         % f x u
      K_uu = gp_trcov(gp, u);    % u x u, noiseles covariance K_uu
      Luu = chol(K_uu)';

      % Evaluate the Lambda (La) for specific model
      % Q_ff = K_fu*inv(K_uu)*K_fu'
      % Here we need only the diag(Q_ff), which is evaluated below
      B=Luu\K_fu';
      iLaKfu = zeros(size(K_fu));  % f x u
      for i=1:length(ind)
        Qbl_ff = B(:,ind{i})'*B(:,ind{i});
        [Kbl_ff, Cbl_ff] = gp_trcov(gp, x(ind{i},:));
        La{i} = Cbl_ff - Qbl_ff;
        CLa{i} = chol(La{i})' ;
      end

      n=length(y);
      e = -gp.lik.fh.ll(gp.lik, y, f, z);

      % Adaptive control algorithm to find such a value for lvs
      % so that the rejection rate of Metropolis is optimal.
      slrej = 0;
      for li=1:100
        sampf = randn(size(f));
        for i=1:length(ind)
          sampf(ind{i},:) = CLa{i}*sampf(ind{i},:);
        end
        ft=sqrt(1-lvs.^2).*f + lvs.*(sampf + B'*randn(m,1));
        at = max(min(ft, maxcut),mincut);
        ed = -gp.lik.fh.ll(gp.lik, y, ft, z);
        a=e-ed;
        if exp(a) > rand(1)
          f=ft;
          e=ed;
          lvs=min(1,lvs*1.1);
        else
          lvs=max(1e-8,lvs/1.05);
        end
      end
      opt.sample_latent_scale=lvs;
      % Do the actual sampling
      for li=1:(opt.repeat)
        sampf = randn(size(f));
        for i=1:length(ind)
          sampf(ind{i},:) = CLa{i}*sampf(ind{i},:);
        end
        ft=sqrt(1-lvs.^2).*f + lvs.*(sampf + B'*randn(m,1));
        at = max(min(ft, maxcut),mincut);
        ed = -gp.lik.fh.ll(gp.lik, y, ft, z);
        a=e-ed;
        if exp(a) > rand(1)
          f=ft;
          e=ed;
        else
          slrej=slrej+1;
        end
      end
      diagn.rej = slrej/opt.repeat;
      diagn.lvs = lvs;
      diagn.opt=opt;
      energ=[];
      f = f';

    case 'CS+FIC'
      u = gp.X_u;
      cf_orig = gp.cf;
      ncf = length(gp.cf);
      n = size(x,1); m = size(u,1);

      cf1 = {};
      cf2 = {};
      j = 1;
      k = 1;
      for i = 1:ncf
        if ~isfield(gp.cf{i},'cs')
          cf1{j} = gp.cf{i};
          j = j + 1;
        else
          cf2{k} = gp.cf{i};
          k = k + 1;
        end
      end
      gp.cf = cf1;

      % First evaluate the needed covariance matrices
      % if they are not in the memory
      % v defines that parameter is a vector
      [Kv_ff, Cv_ff] = gp_trvar(gp, x);  % 1 x f  vector
      K_fu = gp_cov(gp, x, u);         % f x u
      K_uu = gp_trcov(gp, u);          % u x u, noiseles covariance K_uu
      K_uu = (K_uu+K_uu')./2;          % ensure the symmetry of K_uu
      Luu = chol(K_uu)';

      B=Luu\(K_fu');
      Qv_ff=sum(B.^2)';
      Lav = Cv_ff-Qv_ff;   % 1 x f, Vector of diagonal elements
      gp.cf = cf2;
      K_cs = gp_trcov(gp,x);
      La = sparse(1:n,1:n,Lav,n,n) + K_cs;
      gp.cf = cf_orig;

      LD = ldlchol(La);
      sLa = chol(La)';

      n=length(y);
      e = -gp.lik.fh.ll(gp.lik, y, f, z);

      % Adaptive control algorithm to find such a value for lvs
      % so that the rejection rate of Metropolis is optimal.
      slrej = 0;
      for li=1:100
        ft=sqrt(1-lvs.^2).*f + lvs.*(sLa*randn(n,1) + B'*randn(m,1));
        ed = -gp.lik.fh.ll(gp.lik, y, ft, z);
        a=e-ed;
        if exp(a) > rand(1)
          f=ft;
          e=ed;
          lvs=min(1,lvs*1.1);
        else
          lvs=max(1e-8,lvs/1.05);
        end
      end
      opt.sample_latent_scale=lvs;
      % Do the actual sampling
      for li=1:(opt.repeat)
        ft=sqrt(1-lvs.^2).*f + lvs.*(sLa*randn(n,1) + B'*randn(m,1));
        ed = -gp.lik.fh.ll(gp.lik, y, ft, z);
        a=e-ed;
        if exp(a) > rand(1)
          f=ft;
          e=ed;
        else
          slrej=slrej+1;
        end
      end
      diagn.rej = slrej/opt.repeat;
      diagn.lvs = lvs;
      diagn.opt=opt;
      energ=[];
      f = f';

  end
end

function opt = scaled_mh_opt(opt)
%SCALED_MH_OPT  Default options for scaled Metropolis-Hastings sampling
%
%  Description
%    OPT = SCALED_MH_OPT
%      return default options
%    OPT = SCALED_MH_OPT(OPT)
%      fill empty options with default values
%
%  The options and defaults are
%      repeat              - the number of MH-steps before
%                            returning a single sample (default 10)
%      sample_latent_scale - the scale for the MH-step (default 0.5)

  if nargin < 1
    opt=[];
  end

  if ~isfield(opt,'repeat')
    opt.repeat=10;
  end
  if ~isfield(opt,'sample_latent_scale')
    opt.sample_latent_scale=0.5;
  end

end


function [qrs_pos,sign,en_thres] = qrs_detect2(ecg,varargin)
% QRS detector based on the P&T method. This is an offline implementation
% of the detector.
%
% inputs
%   ecg:            one ecg channel on which to run the detector (required)
%                   in [mV]
%   varargin
%       THRES:      energy threshold of the detector (default: 0.6)
%                   [arbitrary units]
%       REF_PERIOD: refractory period in sec between two R-peaks (default: 0.250)
%                   in [ms]
%       fs:         sampling frequency (default: 1KHz) [Hz]
%       fid_vec:    if some subsegments should not be used for finding the
%                   optimal threshold of the P&Tthen input the indices of
%                   the corresponding points here
%       SIGN_FORCE: force sign of peaks (positive value/negative value).
%                   Particularly usefull if we do window by window detection and want to
%                   unsure the sign of the peaks to be the same accross
%                   windows (which is necessary to build an FECG template)
%       debug:      1: plot to bebug, 0: do not plot
%
% outputs
%   qrs_pos:        indexes of detected peaks (in samples)
%   sign:           sign of the peaks (a pos or neg number)
%   en_thres:       energy threshold used
%
%
%
% Physionet Challenge 2014, version 1.0
% Released under the GNU General Public License
%
% Copyright (C) 2014  Joachim Behar
% Oxford university, Intelligent Patient Monitoring Group
% joachim.behar@gmail.com
%
% Last updates:
%
% 13-09-2014
% Joachim Behar
% - bug on refrac period fixed
% - code a bit more tidy
% - condition added on flatline detection for overall segment (if flatline
% then returns empty matrices rather than some random stuff)
%
% 15-09-2014
% Julien Oster
% Sombrero hat instead of band-pass filter as the prefiltering step.
%
%
% When using this code, please reference the following papers:
%
% [1] Behar Joachim, Jonhson Alistair, Clifford Gari D., Oster Julien A
% Comparison of Single Channel Foetal ECG Extraction Methods.
% Annals of Biomedical Engineering. 42(6), 1340-53. 2014
%
% [2] Johnson Alistair E W, Behar Joachim, Oster Julien and Clifford Gari
% D. R-Peak Estimation using Multimodal Lead Switching.
% Accepted for Computing in Cardiology conference 2014.
%
%
% This program is free software; you can redistribute it and/or modify it
% under the terms of the GNU General Public License as published by the
% Free Software Foundation; either version 2 of the License, or (at your
% option) any later version.
% This program is distributed in the hope that it will be useful, but
% WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
% Public License for more details.

% == managing inputs
REF_PERIOD = 0.250;
THRES = 0.6;
fs = 1000;
fid_vec = [];
SIGN_FORCE = [];
debug = 0;

switch nargin
    case 2
        REF_PERIOD=varargin{1};
    case 3
        REF_PERIOD=varargin{1};
        THRES=varargin{2};
    case 4
        REF_PERIOD=varargin{1};
        THRES=varargin{2};
        fs=varargin{3};
    case 5
        REF_PERIOD=varargin{1};
        THRES=varargin{2};
        fs=varargin{3};
        fid_vec=varargin{4};
    case 6
        REF_PERIOD=varargin{1};
        THRES=varargin{2};
        fs=varargin{3};
        fid_vec=varargin{4};
        SIGN_FORCE=varargin{5};
    case 7
        REF_PERIOD=varargin{1};
        THRES=varargin{2};
        fs=varargin{3};
        fid_vec=varargin{4};
        SIGN_FORCE=varargin{5};
        debug=varargin{6};
    otherwise
        error('qrs_detect: wrong number of input arguments \n');
end

[a b] = size(ecg);
if(a>b); NB_SAMP=a; elseif(b>a); NB_SAMP=b; ecg=ecg'; end;
tm = 1/fs:1/fs:ceil(NB_SAMP/fs);

% == constants
MED_SMOOTH_NB_COEFF = round(fs/100);
INT_NB_COEFF = round(7*fs/256); % length is 7 for fs=256Hz
SEARCH_BACK = 1; % perform search back (FIXME: should be in function param)
MAX_FORCE = []; % if you want to force the energy threshold value (FIXME: should be in function param)
MIN_AMP = 0.1; % if the median of the filtered ECG is inferior to MINAMP then it is likely to be a flatline
               % note the importance of the units here for the ECG (mV)
NB_SAMP = length(ecg); % number of input samples

try
    % == Bandpass filtering for ECG signal
    % this sombrero hat has shown to give slightly better results than a
    % standard band-pass filter. Plot the frequency response to convince
    % yourself of what it does
    b1 = [-7.757327341237223e-05  -2.357742589814283e-04 -6.689305101192819e-04 -0.001770119249103 ...
         -0.004364327211358 -0.010013251577232 -0.021344241245400 -0.042182820580118 -0.077080889653194...
         -0.129740392318591 -0.200064921294891 -0.280328573340852 -0.352139052257134 -0.386867664739069 ...
         -0.351974030208595 -0.223363323458050 0 0.286427448595213 0.574058766243311 ...
         0.788100265785590 0.867325070584078 0.788100265785590 0.574058766243311 0.286427448595213 0 ...
         -0.223363323458050 -0.351974030208595 -0.386867664739069 -0.352139052257134...
         -0.280328573340852 -0.200064921294891 -0.129740392318591 -0.077080889653194 -0.042182820580118 ...
         -0.021344241245400 -0.010013251577232 -0.004364327211358 -0.001770119249103 -6.689305101192819e-04...
         -2.357742589814283e-04 -7.757327341237223e-05];

    b1 = resample(b1,fs,250);
    bpfecg = filtfilt(b1,1,ecg)';

    if (length(find(abs(bpfecg)>MIN_AMP))/NB_SAMP)>0.20
        % if 20% of the samples have an absolute amplitude which is higher
        % than MIN_AMP then we are good to go.

        % == P&T operations
        dffecg = diff(bpfecg');  % (4) differentiate (one datum shorter)
        sqrecg = dffecg.*dffecg; % (5) square ecg
        intecg = filter(ones(1,INT_NB_COEFF),1,sqrecg); % (6) integrate
        mdfint = medfilt1(intecg,MED_SMOOTH_NB_COEFF);  % (7) smooth
        delay  = ceil(INT_NB_COEFF/2);
        mdfint = circshift(mdfint,-delay); % remove filter delay for scanning back through ECG

        % look for some measure of signal quality with signal fid_vec? (FIXME)
        if isempty(fid_vec); mdfintFidel = mdfint; else mdfintFidel(fid_vec>2) = 0; end;

        % == P&T threshold
        if NB_SAMP/fs>90; xs=sort(mdfintFidel(fs:fs*90)); else xs = sort(mdfintFidel(fs:end)); end;

        if isempty(MAX_FORCE)
           if NB_SAMP/fs>10
                ind_xs = ceil(98/100*length(xs));
                en_thres = xs(ind_xs); % if more than ten seconds of ecg then 98% CI
            else
                ind_xs = ceil(99/100*length(xs));
                en_thres = xs(ind_xs); % else 99% CI
            end
        else
           en_thres = MAX_FORCE;
        end

        % build an array of segments to look into
        poss_reg = mdfint>(THRES*en_thres);

        % in case empty because force threshold and crap in the signal
        if isempty(poss_reg); poss_reg(10) = 1; end;

        % == P&T QRS detection & search back
        if SEARCH_BACK
            indAboveThreshold = find(poss_reg); % ind of samples above threshold
            RRv = diff(tm(indAboveThreshold));  % compute RRv
            medRRv = median(RRv(RRv>0.01));
            indMissedBeat = find(RRv>1.5*medRRv); % missed a peak?
            % find interval onto which a beat might have been missed
            indStart = indAboveThreshold(indMissedBeat);
            indEnd = indAboveThreshold(indMissedBeat+1);

            for i=1:length(indStart)
                % look for a peak on this interval by lowering the energy threshold
                poss_reg(indStart(i):indEnd(i)) = mdfint(indStart(i):indEnd(i))>(0.5*THRES*en_thres);
            end
        end

        % find indices into boudaries of each segment
        left  = find(diff([0 poss_reg'])==1);  % remember to zero pad at start
        right = find(diff([poss_reg' 0])==-1); % remember to zero pad at end

        % looking for max/min?
        if SIGN_FORCE
            sign = SIGN_FORCE;
        else
            nb_s = length(left<30*fs);
            loc  = zeros(1,nb_s);
            for j=1:nb_s
                [~,loc(j)] = max(abs(bpfecg(left(j):right(j))));
                loc(j) = loc(j)-1+left(j);
            end
            sign = mean(ecg(loc));  % FIXME: change to median?
        end

        % loop through all possibilities
        compt=1;
        NB_PEAKS = length(left);
        maxval = zeros(1,NB_PEAKS);
        maxloc = zeros(1,NB_PEAKS);
%%%%%%%% add two lines
        max_inv_val = zeros(1,NB_PEAKS);
        max_inv_loc = zeros(1,NB_PEAKS);
        for i=1:NB_PEAKS
            if sign>0
                % if sign is positive then look for positive peaks
                [maxval(compt) maxloc(compt)] = max(ecg(left(i):right(i)));
%%%%%%%%%%%%%%%% add 1 line
                [max_inv_val(compt) max_inv_loc(compt)] = min(ecg(left(i):right(i)));
            else
                % if sign is negative then look for negative peaks
                [maxval(compt) maxloc(compt)] = min(ecg(left(i):right(i)));
%%%%%%%%%%%%%%%% add 1 line
                [max_inv_val(compt) max_inv_loc(compt)] = max(ecg(left(i):right(i)));
            end
            maxloc(compt) = maxloc(compt)-1+left(i); % add offset of present location
%%%%%%%%%%%% add 1 line
            max_inv_loc(compt) = max_inv_loc(compt)-1+left(i); % add offset of present location

            % refractory period - has proved to improve results
            if compt>1
%%%%%%%%%%%%%%%%                if maxloc(compt)-maxloc(compt-1)<fs*REF_PERIOD && abs(maxval(compt))<abs(maxval(compt-1))
                if maxloc(compt)-maxloc(compt-1)<fs*REF_PERIOD && max(abs(maxval(compt)),abs(max_inv_val(compt)))<max(abs(maxval(compt-1)),abs(max_inv_val(compt-1)))
%%%%%%%%%%%%%%%% add 4 lines and modify the next one
                    if abs(maxval(compt-1))<abs(max_inv_val(compt-1))
                        maxloc(compt-1)=max_inv_loc(compt-1);
                        maxval(compt-1)=max_inv_val(compt-1);
                    end
                    maxloc(compt)=[]; maxval(compt)=[];max_inv_loc(compt)=[]; max_inv_val(compt)=[];
%%%%%%%%%%%%%%%%                elseif maxloc(compt)-maxloc(compt-1)<fs*REF_PERIOD && abs(maxval(compt))>=abs(maxval(compt-1))
                elseif maxloc(compt)-maxloc(compt-1)<fs*REF_PERIOD && max(abs(maxval(compt)),abs(max_inv_val(compt)))>=max(abs(maxval(compt-1)),abs(max_inv_val(compt-1)))
%%%%%%%%%%%%%%%% add 4 lines and modify the next one
                    if abs(maxval(compt))<abs(max_inv_val(compt))
                        maxloc(compt)=max_inv_loc(compt);
                        maxval(compt)=max_inv_val(compt);
                    end
                    maxloc(compt-1)=[]; maxval(compt-1)=[];max_inv_loc(compt-1)=[]; max_inv_val(compt-1)=[];
                else
                    compt=compt+1;
                end
            else
                % if first peak then increment
                compt=compt+1;
            end
        end

        qrs_pos = maxloc; % datapoints QRS positions
        R_t = tm(maxloc); % timestamps QRS positions
        R_amp = maxval; % amplitude at QRS positions
        hrv = 60./diff(R_t); % heart rate
    else
        % this is a flat line
        qrs_pos = [];
        R_t = [];
        R_amp = [];
        hrv = [];
        sign = [];
        en_thres = [];
    end
catch ME
    rethrow(ME);
    for enb=1:length(ME.stack); disp(ME.stack(enb)); end;
    qrs_pos = [1 10 20]; sign = 1; en_thres = 0.5;
end

% == plots
if debug
    figure;
    FONTSIZE = 20;
    ax(1) = subplot(4,1,1); plot(tm,ecg); hold on;plot(tm,bpfecg,'r')
        title('raw ECG (blue) and zero-pahse FIR filtered ECG (red)'); ylabel('ECG');
        xlim([0 tm(end)]);  hold off;
    ax(2) = subplot(4,1,2); plot(tm(1:length(mdfint)),mdfint);hold on;
        plot(tm,max(mdfint)*bpfecg/(2*max(bpfecg)),'r',tm(left),mdfint(left),'og',tm(right),mdfint(right),'om');
        title('Integrated ecg with scan boundaries over scaled ECG');
        ylabel('Int ECG'); xlim([0 tm(end)]); hold off;
    ax(3) = subplot(4,1,3); plot(tm,bpfecg,'r');hold on;
        plot(R_t,R_amp,'+k');
        title('ECG with R-peaks (black) and S-points (green) over ECG')
        ylabel('ECG+R+S'); xlim([0 tm(end)]); hold off;
    ax(4) = subplot(4,1,4); plot(R_t(1:length(hrv)),hrv,'r+')
        hold on, title('HR')
        ylabel('RR (s)'); xlim([0 tm(end)]);

    %linkaxes(ax,'x');
    set(gca,'FontSize',FONTSIZE);
    allAxesInFigure = findall(gcf,'type','axes');
    set(allAxesInFigure,'fontSize',FONTSIZE);
end

% NOTES
%   Finding the P&T energy threshold: in order to avoid crash due to local
%   huge bumps, threshold is choosen at 98-99% of amplitude distribution.
%   first sec removed for choosing the thres because of filter init lag.
%
%   Search back: look for missed peaks by lowering the threshold in area where the
%   RR interval variability (RRv) is higher than 1.5*medianRRv
%
%   Sign of the QRS (signForce): look for the mean sign of the R-peak over the
%   first 30sec when looking for max of abs value. Then look for the
%   R-peaks over the whole record that have this given sign. This allows to
%   not alternate between positive and negative detections which might
%   happen in some occasion depending on the ECG morphology. It is also
%   better than forcing to look for a max or min systematically.


function [elem] = subsref(tt,s)
% SUBSREF V2
% Evaluate elements, cores of TT-formats and fields of the TT-structure
%   A=TT{I} computes I-th core of the TT-representation
%
%   ELEM=TT(IND) computes element with index IND of the tensor TT
%
% TT-Toolbox 2.2.1, 2009-2016
%
%This is TT Toolbox, written by Ivan Oseledets et al.
%Institute of Numerical Mathematics, Moscow, Russia
%webpage: http://spring.inm.ras.ru/osel
%
%For all questions, bugs and suggestions please mail
%ivan.oseledets@gmail.com

% Possibility to extract subtensor added by Alexey Boyko,
% Skolkovo Institute of Science and Technology
% For questions email alexey.boyko@skolkovotech.ru or a.boyko@skoltech.ru

% Example 1
% y =tt_x(2,10)
% y2=y(1,2,1,2,2,:,:,:,:,:), or, alternatively,
% y2=y(1,2,1,2,2) or
% y2=y([1,2,1,2,2]) or
% y2=y({1,2,1,2,2,':',':',':',':',':'}) or
% y2=y({1,2,1,2,2}) or
% will return 5-dimensional tt_tensor, corresponding to
% fist 5 modes\harmonics being frozen to indices 1,2,1,2,2 respectively

% Example 2
% y =tt_x(2,10)
% y2=y(1,:,1,2,2,:,:,1,:,:), or, alternatively,
% y2=y({1,':',1,2,2,':',':',1}) or
% y2=y({1,':',1,2,2,':',':',1,':',':'}) or

% will also return 5-dimensional tt_tensor, corresponding to freezing
% respective modes\harmonics

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

switch s(1).type
    case '()'
    %Evaluate element of a tensor in position s
    d=tt.d; n=tt.n; ps=tt.ps; cr=tt.core; r=tt.r;

    %ind=double(s);
    pp=s.subs;
    mn=numel(pp);

    if mn == 1
        if iscell( pp{1})
            %one argument, cell array
            pp=pp{1};
        else
            % one argument, ordinary array
            pp=num2cell(pp{1});
        end
    end
    mn=numel(pp);

    if ( mn > d )
        error('Invalid number of indices specified: given %d, need no more than %d \n',mn,d);
    end

    idxs=[];
    vals=[];
    for i=1:mn
        if isnumeric(pp{i})
            idxs=[idxs,i];
            vals=[vals,pp{i}];
        end
    end

    mn=numel(idxs);
    if(mn < d)
        elem=tt_subtensor(tt,idxs,vals);
    else

        %               if ( mn == 1 ) %Special case
        %                  ind=pp{1};
        %                  if ( is_array(ind) )
        %                    for i=1:d
        %                      pp{i}=ind(i);
        %                    end
        %                  else
        %                     pp=ind; %Supposedly it was a cell array of index subsets
        %                  end
        %               end

        elem=tt_tensor;
        elem.r=r;
        elem.d=d;
        n0=zeros(d,1);
        for i=1:d
            ind=pp{i};
            if ( strcmp(ind, ':'))
                pp{i}=1:n(i);
                ind=pp{i};
            end
            n0(i)=numel(ind);
        end
        ps1=cumsum([1;n0.*r(1:d).*r(2:d+1)]);
        cr1=zeros(ps1(d+1)-1,1);

        for i=1:d
            ind=pp{i};
            crx=cr(ps(i):ps(i+1)-1);
            crx=reshape(crx,[r(i),n(i),r(i+1)]);
            crx=crx(:,ind,:);
            cr1(ps1(i):ps1(i+1)-1)=crx(:);
        end

        if ( prod(n0) == 1 ) %single element
            v=1;
            for i=1:d
                crx=cr1(ps1(i):ps1(i+1)-1); crx=reshape(crx,[r(i),r(i+1)]);
                v=v*crx;
            end
            elem=v;
        else
            elem.n=n0;
            elem.core=cr1;
            elem.ps=ps1;
        end

    end

    case '.'
        switch s(1).subs
            case 'r'
                elem = tt.r;
                if (numel(s)>1)
                    s = s(2:end);
                    elem = subsref(elem, s);
                end;
%                 if (numel(s)>1)&&(strcmp(s(2).type,'()'))
%                     elem = tt.r(s(2).subs{1});
%                 else
%                     elem=tt.r;
%                 end;
            case 'over'
                elem = tt.over;
                if (numel(s)>1)
                    s = s(2:end);
                    elem = subsref(elem, s);
                end;
            case 'core'
                if (numel(s)>1)&&(strcmp(s(2).type,'()'))
                    elem = tt.core(s(2).subs{1});
                else
                    elem=tt.core;
                end;
            case 'd'
                elem=tt.d;
            case 'ps'
                elem = tt.ps;
                if (numel(s)>1)
                    s = s(2:end);
                    elem = subsref(elem, s);
                end;

%                 if (numel(s)>1)&&(strcmp(s(2).type,'()'))
%                     elem = tt.ps(s(2).subs{1});
%                 else
%                     elem=tt.ps;
%                 end;
            case 'n'
                elem = tt.n;
                if (numel(s)>1)
                    s = s(2:end);
                    elem = subsref(elem, s);
                end;

%                 if (numel(s)>1)&&(strcmp(s(2).type,'()'))
%                     elem = tt.n(s(2).subs{1});
%                 else
%                     elem=tt.n;
%                 end;
            otherwise
                error(['No field ', s.subs, ' is here.']);
        end

    case '{}'
        %Return the core in the old (not exactly!!! r1-n-r2 here) format
        pp=s.subs;
        mn=numel(pp);
        if ( mn > 1 )
          error('Invalid number of cores asked');
        end
        elem=core(tt,pp{1});

        if (numel(s)>1)
            s = s(2:end);
            elem = subsref(elem, s);
        end;
%         if (pp{1}~=1)
%             elem=permute(elem,[2,1,3]);
%         end;

    otherwise
        error('Invalid subsref.');
end
end


function [ClusterID,EventType,AlgoInfo] =  clusterSLIDERmag(ShortCat,MainMag,BackTime,ForeTime,MinRad,MagRadScale,MagRadConst)

	% Example [mCatclus] =  clusterSTEPmag(mCatalog, 1.95, 1.95, 1984, 1, 1);

	% code to cluster catalog with spatial windows according to STEP forecasting model
	% with sliding windows of t1 backwards in time and t2 forward in time
	% starting with the largest earthquake in the catalog

	%
	% Input parameters:
	%   mCatalog        Earthquake catalog
	%   Mainmag         minimum mainmag magnitude
	%   Mc              Completeness magnitude
	%   startyear
	%   t1              time before an earthquake in days
	%   t2              time window following an earthquake in days
	%
	% Output parameters:
	%   fBValue         mCatclus: The clustered catalog for further anaysis
	%
	% Annemarie Christophersen, 31. January 2008

	% Code written for catalogue under zmap, thus the input
	% catalogue is in the variable a, where
	% column 1: longitude
	% column 2: latitude
	% column 3: year (decimal year, including seconds)
	% column 4: month
	% column 5: day
	% column 6: magnitude
	% column 7: depth
	% column 8: hour
	% column 9: minute
	% column 10: seconds
	% column 11-23 not important for clustering and cluster analysis
	% column 24: SCSN flag for event type (l=local, r=regional, q=quarry)

	% variables used
	% mc completeness magnitude
	% twindow duration in time in which to look for related events

	%Converted for MapSeis by DE 21.6.2012

	%may make this switchable if needed
	Rounding=true;

	%init work arrays
	numEvents = length(ShortCat);
	WorkArray=zeros(numEvents,4);
	WorkArray(:,1)= (1:numEvents)'; %introduce column 11 with row number

	%init output
	ClusterID=nan(numEvents,1);
	%EventType=ones(numEvents,1);
	EventType = categorical(ones(numEvents,1),...
		[0 1 2 3],...
        {'unclassified','single event','mainshock','aftershock'});
	InitEvent=false(numEvents,1);
	AlgoInfo=[];

	%InitEvent is currently not directly supported by mapseis, but will be
	%added to AlgoInfo, so it can be used by specialiced algorithms

	clusterno = 1;

	%Dtafter = t2/365; %30 days in decimal years
	%Dtbefore = t1/365; %2 days in decimal years
	clusterno = 1;

	while any(WorkArray(:,2)==0)
		notClustered=WorkArray(:,2)==0;

		[maxmag IDX]=max(ShortCat(notClustered,5)); %the magnitude of the largest earthquake not yet clustered
		maxmag=maxmag(1); %could have mor than one maximum afterall
		NrInGame=WorkArray(notClustered,1);
		ActualIndex=NrInGame(IDX(1));

	   	lino = ActualIndex;
	   	WorkArray(lino,2)=clusterno; %write cluster number into column 12
	   	searchradius=max(MinRad, 10^(MagRadScale*maxmag-MagRadConst)); %calculate search radius

		%get data of the new event
		tref = ShortCat(lino,4); %set reference time
		latref = ShortCat(lino,2); %set reference latitude
		lonref = ShortCat(lino,1); %set reference longitude

		%search for earthquakes before, extend by sliding time windows of t1
		eventsDtbefore=(ShortCat(:,4) > tref-BackTime & ShortCat(:,4) < tref);
		eventsbefore = sum(eventsDtbefore);
		linobefore = lino-eventsbefore;

		%%That did not work like it was intended
		%%--------------------------------------

		% for i=linobefore:lino
			% if (b(i,12) == 0) % don't bother if event already clustered
			    % edist = deg2km(distance(latref,lonref,ShortCat(i,2),ShortCat(i,1))); %calculate distance to mainshock
			    % if (edist <= searchradius)
				% WorkArray(i,2)=clusterno;
				% %make this event new tref and search for events before
				% tref=ShortCat(i,4);
				% eventsDtbefore=(ShortCat(:,4) > tref-BackTime & ShortCat(:,4) < tref);
				% eventsbefore = length(b(eventsDtbefore,1));
				% linobefore = max(1, i-eventsbefore);
				% i=linobefore; %is this the right way to restart loop at linobefore?
			    % end
			% end
		% end %this could now have an earlier linebefore and will loop up to lino
		% % where lino remains the number of mainshoc
		% % now look for later earthquakes

		%old version whould not work, for "borders" once set, will stay as the are;
		i=linobefore;
		while i<=lino
			if WorkArray(i,2)==0
				edist = deg2km(distance(latref,lonref,ShortCat(i,2),ShortCat(i,1))); %calculate distance to mainshock
				if (edist <= searchradius)
					WorkArray(i,2)=clusterno;
					%make this event new tref and search for events before
					tref=ShortCat(i,4);
					eventsDtbefore=(ShortCat(:,4) > tref-BackTime & ShortCat(:,4) < tref);
					eventsbefore = sum(eventsDtbefore);
					linobefore = max(1, i-eventsbefore);
					i=linobefore; %Now it does restart

				else
					i=i+1;
				end
			else
				i=i+1;
			end

		end

		tref=ShortCat(lino,4); %reset reference time to mainshock

		while (lino < numEvents+1) && ShortCat(lino,4) < (tref+ForeTime)
			if WorkArray(lino,2) == 0
				edist = deg2km(distance(latref,lonref,ShortCat(lino,2),ShortCat(lino,1)));
				if (edist <= searchradius)
					WorkArray(lino,2)=clusterno;

					%Not needed already cutted
					%if (ShortCat(lino,6) > Mc)
					tref=ShortCat(lino,4); %set reference time to new earthquake in cluster

				end
				lino=lino+1;
			end
		end

		clusterno=clusterno+1;

	end

	%Output clustered matrix
	% column 1: longitude
	% column 2: latitude
	% column 3: year (decimal year, including seconds)
	% column 4: month
	% column 5: day
	% column 6: magnitude
	% column 7: depth
	% column 8: hour
	% column 9: minute
	% column 10: seconds
	% column 11: line number
	% column 12: cluster number
	% column 13: mainshock with its cluster number
	% column 14: initiating event cluster number

	if Rounding
		ShortCat(:,5)=round(ShortCat(:,5)*10)/10;%  round magnitudes to 0.1
	end

	%may not be needed anymore -> it is needed
	WorkArray(:,1)= 1:length(ShortCat)'; %introduce column 1 with row number

	%WorkArray(WorkArray(:,2)==0,2)=nan;
	UsedCluster=unique(WorkArray(~isnan(WorkArray(:,2))&WorkArray(:,2)~=0,2));
	clusterno=1;

	disp(numel(UsedCluster));

	for i=UsedCluster'
		inCluster = WorkArray(:,2)==i;

		if sum(inCluster) >1
			%A real cluster

			%First mark all as Events of the cluster and as Aftershocks
			ClusterID(inCluster)=clusterno;
			EventType(inCluster)='aftershock';

			%find the first of the largest events label it as mainshock
			[MaxMag IDX] = max(ShortCat(inCluster,5));
			availIndex=WorkArray(inCluster,1);
			MrMaxMag=availIndex(IDX(1));
			EventType(MrMaxMag)='mainshock';

			%Mark initial event
			[MinTime IDX] = min(ShortCat(inCluster,4));
			availIndex=WorkArray(inCluster,1);
			MrInit=availIndex(IDX(1));
			InitEvent(MrInit)=true;

			clusterno=clusterno+1;

		elseif sum(inCluster)==1
			%only one event
			ClusterID(inCluster)=nan;
			EventType(inCluster)='single event';

			%clusterno=clusterno+1;

		end

	end

	%And set all not assign clusters to NaN and 1
	notInClust=WorkArray(:,2)==0;
	ClusterID(notInClust)=nan;
	EventType(notInClust)='single event'

	%And finally the AlgoInfo
	ParamInput=struct(	'MainMag',MainMag,...
				'BackTime',BackTime,...
				'ForeTime',ForeTime,...
				'MinRad',MinRad,...
				'MagRadScale',MagRadScale,...
				'MagRadConst',MagRadConst);

	AlgoInfo.Type='SLIDER-Magnitude-mapseis-v1';
	AlgoInfo.UsedConfig=ParamInput;
	AlgoInfo.CalculationDate=date;
	AlgoInfo.InitialEvents=InitEvent;
	AlgoInfo.WorkArray=WorkArray;

end