function DEM_demo_EM
% Dual estimation of parameters and hyperparameters; under known causes:
% This demo focuses on conditional parameter estimation with DEM and
% provides a comparative evaluation using EM.  This proceeds by removing
% uncertainly about the input so that the D-step can be discounted.

% get basic convolution model
%==========================================================================
M       = spm_DEM_M('convolution model');

% free parameters
%--------------------------------------------------------------------------
P       = M(1).pE;                            % true parameters
ip      = [2 5];                              % free parameters
pE      = spm_vec(P);
pE(ip)  = 0;
np      = length(pE);
pE      = spm_unvec(pE,P);
pC      = sparse(ip,ip,exp(8),np,np);
M(1).pE = pE;
M(1).pC = pC;

% free hyperparameters
%--------------------------------------------------------------------------
M(1).Q  = {speye(M(1).l,M(1).l)};
M(1).R  = {speye(M(1).n,M(1).n)};

% level 2
%--------------------------------------------------------------------------
M(2).l  = 1;                                  % inputs
M(2).V  = exp(16);                            % very precise causes

% and generate data
%==========================================================================
N       = 32;                                 % length of data sequence
U       = exp(-([1:N] - 12).^2/(2.^2));       % this is the Gaussian cause
DEM     = spm_DEM_generate(M,U,{P},{8,32},{32});

% invert model
%==========================================================================
DEM.U   = U;
DEM     = spm_DEM(DEM);

% overlay true values
%--------------------------------------------------------------------------
spm_DEM_qU(DEM.qU,DEM.pU)

% EM: spm_nlsi_GN
%==========================================================================
G.f   =  inline('P.f*x + P.h*u','x','u','P','M');
G.g   =  inline('P.g*x','x','u','P','M');
G.m   =  DEM.M(1).m;
G.n   =  DEM.M(1).n;
G.l   =  DEM.M(1).l;
G.x   =  DEM.M(1).x;
G.pE  =  DEM.M(1).pE;
G.pC  =  DEM.M(1).pC;
G.hE  = -DEM.M(1).hE;

% exogenous inputs
%--------------------------------------------------------------------------
GU.u  = U';
GU.dt = 1;

% data and serial correlations
%--------------------------------------------------------------------------
t     = ((1:N) - 1);
K     = toeplitz(exp(-t.^2/(2*M(1).E.s^2)));
Q     = K*K';

GY.y  = DEM.Y';
GY.X0 = DEM.X';
GY.dt = 1;
GY.Q  = {kron(speye(G.l,G.l),Q)};

% EM with a Gauss-Newton-like optimization of free energy
%==========================================================================
[Ep,Cp,Eh,F] = spm_nlsi_GN(G,GU,GY);

% parameters
%--------------------------------------------------------------------------
ip    = [2 5];
qP    = spm_vec(DEM.qP.P);
qP    = qP(ip);
tP    = spm_vec(DEM.pP.P);
tP    = tP(ip);
pP    = spm_vec(DEM.M(1).pE);
pP    = pP(ip);
eP    = spm_vec(Ep);
eP    = eP(ip);

spm_figure('GetWin','DEM');
subplot(2,2,4)
bar([tP qP eP])
axis square
legend('true','DEM','EM')
title('parameters','FontSize',16)

cq    = 1.64*sqrt(diag(DEM.qP.C(ip,ip)));
ce    = 1.64*sqrt(diag(Cp(ip,ip)));
hold on
for i = 1:length(qP)
    plot([i i],       qP(i) + [-1 1]*cq(i),'LineWidth',8,'color','r')
    plot([i i] + 1/4, eP(i) + [-1 1]*ce(i),'LineWidth',8,'color','r')
end
hold off

return

% repeat for several realizations
%==========================================================================
clear QP EP QH EH
for i = 1:8

    % generate new data and DEM
    %----------------------------------------------------------------------
    DEM     = spm_DEM_generate(M,U,{P},{8,32},{32});
    DEM.U   = U;
    DEM     = spm_DEM(DEM);

    % EM
    %----------------------------------------------------------------------
    GY.y  = DEM.Y';
    [Ep,Cp,Eh,F] = spm_nlsi_GN(G,GU,GY);

    % retain parameter estimates
    %----------------------------------------------------------------------
    qP      = spm_vec(DEM.qP.P);
    qP      = qP(ip);
    eP      = spm_vec(Ep);
    eP      = eP(ip);

    QP(:,i) = qP;
    EP(:,i) = eP;

    QH(i) = DEM.qH.h{1}(1);
    EH(i) = Eh(1);
end

spm_figure('GetWin','Figure 1');

subplot(2,1,1)
bar(tP,'FaceColor',[1 1 1]*.9,'EdgeColor',[1 1 1]*.9)
hold on
plot([1 2] - 1/8,EP,'r.',[1 2] + 1/4,QP,'k.','Markersize',16)
hold off
axis square
set(gca,'XLim',[0 3])
legend('true','EM','DEM')
title('conditional estimates','FontSize',16)


function u = tapas_datagen_categorical
% This function generates categorical input data for the hgf_categorical model
%
% --------------------------------------------------------------------------------------------------
% Copyright (C) 2015 Christoph Mathys, TNU, UZH & ETHZ
%
% This file is part of the HGF toolbox, which is released under the terms of the GNU General Public
% Licence (GPL), version 3. You can redistribute it and/or modify it under the terms of the GPL
% (either version 3 or, at your option, any later version). For further details, see the file
% COPYING or <http://www.gnu.org/licenses/>.

% First set of outcomes
u = mnrnd(1, [0.8, 0.1, 0.1], 64);

% Second set of outcomes
u = [u; mnrnd(1, [1/3, 1/3, 1/3], 64)];

% Third set of outcomes
u = [u; mnrnd(1, [0.1, 0.1, 0.8], 64)];

% Add next set of outcomes (...or don't)

% Turn u into a single column of natural numbers indicating outcome category
u = sum(u*diag([1 2 3]),2);


function [ a_lu, pivot, rcond, z ] = r8ge_co ( n, a )

%*****************************************************************************80
%
%% R8GE_CO factors a R8GE matrix and estimates its condition number.
%
%  Discussion:
%
%    The R8GE storage format is used for a general M by N matrix.  A storage
%    space is made for each logical entry.  The two dimensional logical
%    array is mapped to a vector, in which storage is by columns.
%
%    For the system A * X = B, relative perturbations in A and B
%    of size EPSILON may cause relative perturbations in X of size
%    EPSILON/RCOND.
%
%    If RCOND is so small that the logical expression
%      1.0E+00 + rcond == 1.0E+00
%    is true, then A may be singular to working precision.  In particular,
%    RCOND is zero if exact singularity is detected or the estimate
%    underflows.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 March 2004
%
%  Author:
%
%    Original FORTRAN77 version by Dongarra, Bunch, Moler, Stewart.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Dongarra, Bunch, Moler, Stewart,
%    LINPACK User's Guide,
%    SIAM, 1979
%
%  Parameters:
%
%    Input, integer N, the order of the matrix A.
%
%    Input, real A(N,N), a matrix to be factored.
%
%    Output, real A_LU(N,N), the LU factorization of the matrix.
%
%    Output, integer PIVOT(N), the pivot indices.
%
%    Output, real RCOND, an estimate of the reciprocal condition number of A.
%
%    Output, real Z(N), a work vector whose contents are usually unimportant.
%    If A is close to a singular matrix, then Z is an approximate null vector
%    in the sense that
%      norm ( A * Z ) = RCOND * norm ( A ) * norm ( Z ).
%

%
%  Compute the L1 norm of A.
%
  anorm = 0.0E+00;
  for j = 1 : n
    anorm = max ( anorm, sum ( abs ( a(1:n,j) ) ) );
  end
%
%  Compute the LU factorization.
%
  [ a, pivot, info ] = r8ge_fa ( n, a );
%
%  RCOND = 1 / ( norm(A) * (estimate of norm(inverse(A))) )
%
%  estimate of norm(inverse(A)) = norm(Z) / norm(Y)
%
%  where
%    A * Z = Y
%  and
%    A' * Y = E
%
%  The components of E are chosen to cause maximum local growth in the
%  elements of W, where U'*W = E.  The vectors are frequently rescaled
%  to avoid overflow.
%
%  Solve U' * W = E.
%
  ek = 1.0;
  z(1:n) = 0.0;

  for k = 1 : n

    if ( z(k) ~= 0.0 )
      ek = - r8_sign ( z(k) ) * abs ( ek );
    end

    if ( abs ( a(k,k) ) < abs ( ek - z(k) ) )
      s = abs ( a(k,k) ) / abs ( ek - z(k) );
      z(1:n) = s * z(1:n);
      ek = s * ek;
    end

    wk = ek - z(k);
    wkm = -ek - z(k);
    s = abs ( wk );
    sm = abs ( wkm );

    if ( a(k,k) ~= 0.0 )
      wk = wk / a(k,k);
      wkm = wkm / a(k,k);
    else
      wk = 1.0;
      wkm = 1.0;
    end

    if ( k + 1 <= n )

      for j = k + 1 : n
        sm = sm + abs ( z(j) + wkm * a(k,j) );
        z(j) = z(j) + wk * a(k,j);
        s = s + abs ( z(j) );
      end

      if ( s < sm )
        t = wkm - wk;
        wk = wkm;
        z(k+1:n) = z(k+1:n) + t * a(k,k+1:n);
      end

    end

    z(k) = wk;

  end

  t = sum ( abs ( z(1:n) ) );
  z(1:n) = z(1:n) / t;
%
%  Solve L' * Y = W
%
  for k = n : -1 : 1

    z(k) = z(k) + a(k+1:n,k)' * z(k+1:n)';

    t = abs ( z(k) );

    if ( 1.0E+00 < t )
      z(1:n) = z(1:n) / t;
    end

    l = pivot(k);

    t = z(l);
    z(l) = z(k);
    z(k) = t;

  end

  z(1:n) = z(1:n) / sum ( abs ( z(1:n) ) );

  ynorm = 1.0E+00;
%
%  Solve L * V = Y.
%
  for k = 1 : n

    l = pivot(k);

    t = z(l);
    z(l) = z(k);
    z(k) = t;

    z(k+1:n) = z(k+1:n) + t * a(k+1:n,k)';

    if ( 1.0E+00 < abs ( z(k) ) )
      ynorm = ynorm / abs ( z(k) );
      z(1:n) = z(1:n) / abs ( z(k) );
    end

  end

  s = sum ( abs ( z(1:n) ) );
  z(1:n) = z(1:n) / s;
  ynorm = ynorm / s;
%
%  Solve U * Z = V.
%
  for k = n : -1 : 1

    if ( abs ( a(k,k) ) < abs ( z(k) ) )
      s = abs ( a(k,k) ) / abs ( z(k) );
      z(1:n) = s * z(1:n);
      ynorm = s * ynorm;
    end

    if ( a(k,k) ~= 0.0E+00 )
      z(k) = z(k) / a(k,k);
    else
      z(k) = 1.0E+00;
    end

    z(1:k-1) = z(1:k-1) - z(k) * a(1:k-1,k)';

  end
%
%  Normalize Z in the L1 norm.
%
  s = 1.0E+00 / sum ( abs ( z(1:n) ) );
  z(1:n) = s * z(1:n);
  ynorm = s * ynorm;

  if ( anorm ~= 0.0E+00 )
    rcond = ynorm / anorm;
  else
    rcond = 0.0E+00;
  end

  return
end


function [X,mP,spmP] = tor_get_physio(varargin)
% :Usage:
% ::
%
%     [X,mP,spmP] = tor_get_physio([mP],[spmP],[nvoxels],[doortho])
% arguments are optional, but you must enter them in this order.
%
% Tor Wager 10/21/02
%
% Get nuisance covariates likely to be related to physiological noise and head motion
% The algorithm:
%
% The program extracts raw/preprocessed image data from the ventricles (CSF space), as
% defined by a mask denoting which voxels are CSF for that subject.
% Either all voxels or a randomly selected subset [nvoxels] is subjected to
% principal components analysis, to determine regular patters of drift over time
% and across voxels.  Those patterns are expected to be related to global signal drift,
% head movement, and physiological noise, and are assumed to be UNrelated to the task
% of interest, by virtue of the fact that they occur in the ventricles.
%
% PCA is done twice on the timeseries' of CSF voxels.  The first time, PCA is done
% on the sums of squared values (not the correlations) of voxel timeserieses across
% the entire experiment, mean-centered based on the whole experiment.  Most of the
% coherent variation in this case is expected to be due to head movement and changes
% in shims/gradients/etc. from run to run.  The SS values are used because we want to
% weight the voxels with the highest variation most heavily, as they are presumably
% picking up most of this signal.  The first 3 eigenvariates (canonical timeseries)
% are saved.
%
% Following, a separate, second PCA is done on the correlation matrix of data
% within each session.  Session data for each voxel are mean-centered and scaled
% relative to the session (variance of each voxel = 1).  We do this because
% physiological noise-related signals may produce periodic signals of different
% magnitudes in different voxels, and we want to extract the most coherent signals
% we can within each session.  So these eigenvariates are expected to reflect
% primarily noise related to physiology (heart rate, respiration).  Up to 5 eigenvariates
% for each session are saved (nothing with eigenvalue < 1 is saved).
%
% Next, the CSF-related nuisance covariates (eigenvariates from PCA) are combined
% with existing nuisance covariates and intercept columns from the existing
% design matrix (SPMcfg xX).  The proportion of variance in each predictor of interest
% explained by this nuisance basis set is calculated using regression, and the
% nuisance covariates are orthogonalized with respect to each predictor of interest.
% There are good and bad results of this step.  The bad is that any signal that
% tracks the predictors is attributed to the task, not to noise, even if it's actually
% caused by physiological artifact.  So the orthogonalized basis set does not
% protect you from physiology or movement-related false positives.  However,
% the nuisance covariates are also unlikely to reduce power in estimating you effects
% of interest.  More importantly, it avoids false positives created when one
% predictor (A) is more highly correlated with the nuisance covariates than another
% (B).  In practice, betas for A will tend to be smaller than B, given the same
% actual response to both, and a random effects analysis on A-B will produce
% false positive activations.  Orthogonalization of the nuisance set precludes this.
%
% :Inputs:
%
%   **mP:**
%        CSF mask image file.  *_seg3.img output from SPM is appropriate
%        should be in same space and have same dims as functionals
%        but automatic reslicing is done if necessary.
%
%   **spmP:**
%        name (full path name preferred) of SPMcfg.mat file to use
%        This contains the design matrix and raw/preproc image file names to use.
%
%   **nvoxels:**
%        Number of CSF voxels to use in PCA analysis
%        More than 100 can be very slow and memory intensive.
%        Fewer than 100 voxels loads a different way, and may be slower.
%        Best is probably between 100 - 1000.  800 runs pretty fast.
%
%   **doortho:**
%        Orthogonalize nuisance covariates with respect to regs of interest
%        This assumes that any signal that covaries with the task is, in fact,
%        due to the task, so it gives you some bias towards finding positive results.
%        However, the alternative is that nuisance covariates may soak up variance
%        related to the task, and you'll miss activations.
%        In addition, if some regressors are more colinear with the nuisance set,
%        you can create false "activations" when comparing these regressors to other
%        ones.  This problem exists whether or not we choose to model nuisance
%        covariates.  One solution is to use the ortho when doing random effects analyses,
%        as the sign and magnitude of nuisance-related activations would not be expected to be
%        the same across subjects unless the variance was really task-related.
%        Default is 1, or "yes, do orthogonalization."
%
% for functions called, see this .m file.
%
% :Examples:
% ::
%
%    % get filenames for SPMcfg files and CSF mask for each subject
%    cd C:\Tor_Documents\CurrentExperiments\intext2\RESULTS\model1
%    spmP = get_filename('sub*','SPMcfg.mat');
%    cd C:\Tor_Documents\CurrentExperiments\intext2\
%    mP = get_filename('sub*','anatomy/nscalped_f*seg3.img');
%    % Now run:
%    for i = 1:size(mP,1)
%        tor_get_physio(mP(i,:),spmP(i,:),300);  % 300 voxels
%        pause(10); close all
%    end

% :Functions called:
%   - spm functions: spm_get, etc.
%   - timeseries2.m	(for < 100 voxels)
%   - read_hdr.m	(big-little endian dependent; validate for your data)
%   - timeseries3.m	(for > 100 voxels; uses SPM's image reading)
%   - reslice_imgs.m
%   - mask2voxel.m 	(only if ind2sub.m from Matlab is not found)

CSFprob = .95;      % this is the value a voxel in the mask img must have to be considered
                    % an 'on' value.
                    % if using SPM segmentation output (e.g., *_seg3) for the mask,
                    % this is something like the prob. of being in CSF
                    % low thresholds will result in HUGE eigenvalue problems
                    % and memory difficulties.

mypwd = pwd;
t1 = clock;

% ----------------------------------------------------------------------------------
% * set up input arguments
% ----------------------------------------------------------------------------------

if length(varargin) > 0
    mP = varargin{1};
else
    % mask filename
    mP = spm_get(1,'*img','Select CSF mask for this subject.');
end
if isempty(mP), mP = spm_get(1,'*img','Select CSF mask for this subject.');, end

if length(varargin) > 1
    spmP = varargin{2};
else
    spmP = spm_get(Inf,'SPMcfg.mat','Choose SPMcfg.mat file for this subject or Done to skip.');
end

if length(varargin) > 2, srand = varargin{3};, else, srand = 0;, end

if length(varargin) > 3, doortho = varargin{4};, else, doortho = 1;, end

% ----------------------------------------------------------------------------------
% * cd to SPM results directory so we can write output file there
% ----------------------------------------------------------------------------------
d = fileparts(spmP);
eval(['cd ' d])

diary physio_nuisance_covariates.out

% ----------------------------------------------------------------------------------
% * load SPMcfg.mat file, which contains all relevant info except mask image
% ----------------------------------------------------------------------------------

        load(spmP)
        nsess = length(Sess);
        P = str2mat(VY.fname);
	if ~(exist(deblank(P(1,:))) == 2)
		disp(['Looking for: ' P(1,:)])
		disp(['Can''t find original img files!! Please specify.'])
		P = spm_get(Inf,'*.img','Select raw image files.');
		VY = spm_vol(P);
		disp(['VY has been modified!!! Using: ' P(1,:)])
	end
        for i = 1:length(Sess), nimgs(i) = size(Sess{i}.row,2);,end

%  [nsess] = spm_input_ui('Enter number of runs, or 0 to choose SPM.mat file [recommended]',.1,'i',[],1);

% ----------------------------------------------------------------------------------
% * reslice the CSF mask if necessary, to be in space of functionals!
% ----------------------------------------------------------------------------------

mV = spm_vol(mP);
pV = spm_vol(P(1,:));
if any(mV.dim(1:3) - pV.dim(1:3)) | any(any(pV.mat(1:3,1:3) - mV.mat(1:3,1:3)))
    [d f e] = fileparts(mP); reslice_imgs(P(1,:),mP,0);
    mP = fullfile(d,['r' f e]);
    disp(['Resliced mask to space of functionals: ' mP])
    mV = spm_vol(mP);
end

% ----------------------------------------------------------------------------------
% * load and check mask
% ----------------------------------------------------------------------------------

mv = spm_read_vols(mV); mv = mv > CSFprob;
fprintf(1,'\nCSF mask has %3.0f voxels out of %3.0f total.\t',sum(mv(:)),prod(size(mv)))
try
    % if we have the right toolbox...
    [x y z] = ind2sub(size(mv),find(mv)); [XYZ] = [x y z];
catch
    disp('elmat toolbox function ind2sub not found; using SLOWER version mask2voxel.m')
    XYZ = mask2voxel(mv);
end

tmp = sum(sum(mv));
if ~findobj('Tag','Graphics'), spm fmri; figure(findobj('Tag','Graphics'));,end
if ~findobj('Tag','Interactive'), spm fmri;,end
%imagesc(mv(:,:,find(tmp == max(tmp)))); colormap gray; warning off; title([mP]), warning on,;drawnow
spm_check_registration(str2mat(mP,P(1,:)));

if sum(tmp) > 100,
    disp(['More than 100 CSF voxels in mask - this may be computationally intensive!'])
    % if srand is not entered as an input argument, prompt.
    if ~srand,
        figure(findobj('Tag','Interactive'))
        srand = spm_input_ui('Enter n vox to use, or 0 for all',.1,'i',[],1);,
    end
    if srand > sum(tmp),
	disp(['More voxels requested than available at threshold ' num2str(CSFprob) ': using ' num2str(max(tmp))])
	srand = sum(tmp);
    end

else
    srand = 0;
end

if srand
    wh = rand(size(XYZ,1),1) * size(XYZ,1);
    wh2 = sort(wh); wh2 = wh2(1:srand);
    for i = 1:srand, XYZ2(i,:) = XYZ(find(wh == wh2(i)),:);, end
    XYZ = XYZ2;
end

% ----------------------------------------------------------------------------------
% * Load images and mask with CSF
% ----------------------------------------------------------------------------------
% M1 is unscaled timeseries over all sessions; eigs computed over whole experiment
% M2 is timeseries scaled within each session; (cell array)
%   eigs are computed within session

fprintf(1,'\nEigenvariates based on %3.0f voxels \t',size(XYZ,1))
fprintf(1,'\nLoading volumes, extracting voxels, and scaling \t')

wh = [0 cumsum(nimgs)];
M1 = [];
M2 = [];

if size(XYZ,1) < 101
    % this is super slow for large n!
    ts = timeseries2('multi',P,struct('coords',XYZ));
    M1 = ts.indiv;

    % adjust M2 to mean 0 var 1
    for j = 1:size(M1,2)
        for i = 1:nsess
            ind = wh(i)+1:wh(i+1);
            M2{i}(:,j) = (M1(ind,j) - mean(M1(ind,j))) ./ std(M1(ind,j));
        end
    end

else

for i = 1:nsess
    subP = P(wh(i)+1:wh(i+1),:);
    fprintf(1,'.')
    ts = timeseries3(XYZ,subP);

    % save 2 matrices, one for session-mean centered and scaled and one uncentered (until overall mean is known)
    M1 = [M1;ts.all_data];

    for j = 1:size(ts.all_data,2)
        % center and scale to variance = 1
        ts.all_data(:,j) = (ts.all_data(:,j) - mean(ts.all_data(:,j))) ./ std(ts.all_data(:,j));
    end
    M2{i} = [ts.all_data];
end

end

fprintf(1,'Done.\n')

% ----------------------------------------------------------------------------------
% * Mean-center first (unscaled) timeseries and check for NaN or Inf values
% ----------------------------------------------------------------------------------
for i = 1:size(M1,2)
    M1(:,i) = M1(:,i) - mean(M1(:,i));
end

ex = any(isnan(M1) | isinf(M1)) | all(M1 == 0);
if any(ex)
	disp(['WARNING! NaN or Inf values for ' num2str(sum(ex)) ' voxels in timeseries!!  Mis-registration of funct and anatomy?'])
	M1(:,find(ex)) = [];
end

figure;imagesc(M1); title('Overall timeseries (y) for all voxels (x)')

% ----------------------------------------------------------------------------------
% * Find Principal Components overall
% ----------------------------------------------------------------------------------
fprintf(1,'\nPrincipal components overall ')
[eigvec,eigval] = eig(M1'*M1);
eigvec = eigvec(:,end-2:end);
X = M1 * eigvec;
for i = 1:size(X,2), X(:,i) = (X(:,i) - mean(X(:,i))) ./ std(X(:,i));, end
figure;subplot 221; plot(eigvec); title('Weights on original variables (=voxels) == eigenvectors')
subplot 222; plot(X),title('Components (X * v)')
legend({'Comp 3' 'Comp 2' 'Comp 1'},0)
    subplot 223; bar(diag(eigval));, title('Scree plot for eigenvalues')

    xx = abs(fft(X)); xxx = (1:size(xx,1)) ./ (xX.RT * size(xx,1));
    subplot 224; plot(xxx(1:round(length(xx)./2)),xx(1:round(length(xx)./2),:));, title('FFT of components')
    xlabel('Frequency (Hz)')
drawnow

% ----------------------------------------------------------------------------------
% * Find Principal Components for each session
% ----------------------------------------------------------------------------------
wh = [0 cumsum(nimgs)];

for i = 1:nsess
    fprintf(1,'\nPrincipal components for session %1.0f',i)

    ex = any(isnan(M2{i}) | isinf(M2{i}));
    if any(ex)
	disp('')
	disp(['WARNING! NaN or Inf values for ' num2str(sum(ex)) ' voxels in sess ' num2str(i) '!!  Mis-registration of funct and anatomy?'])
	M2{i}(:,find(ex)) = [];
    end

    [eigvec,eigval] = eig(corrcoef(M2{i}));
    fprintf(1,'\t%3.0f eigenvalues > 1\t',sum(diag(eigval) > 1))

    num2save = min(sum(diag(eigval)>1),5);    % save at most 5 eigenvalues from this session
    eigvec = eigvec(:,end-num2save+1:end);
    X2 = M2{i} * eigvec;
    for j = 1:size(X2,2), X2(:,j) = (X2(:,j) - mean(X2(:,j))) ./ std(X2(:,j));, end

    figure;subplot 221; plot(eigvec); title(['Weights (eigenvectors) for session ' num2str(i)])
    subplot 222; plot(X2),title('Components (X * v)')
    subplot 223; bar(diag(eigval));, title('Scree plot for eigenvalues')

    xx = abs(fft(X2)); xxx = (1:size(xx,1)) ./ (xX.RT * size(xx,1));
    subplot 224; plot(xxx(1:round(length(xx)./2)),xx(1:round(length(xx)./2),:));, title('FFT of components')
    xlabel('Frequency (Hz)')

    drawnow

    % pad with zeros to get in the right session
    zbef = zeros(wh(i),size(X2,2));
    X2 = [zbef; X2];
    zaft = zeros(size(X,1) - size(X2,1),size(X2,2));
    X2 = [X2; zaft];

    X = [X X2];
end

X(:,end+1:end+length(xX.iB)) = xX.X(:,xX.iB); % add the nuisance covariates already in xX

% ----------------------------------------------------------------------------------
% * Correlate / Regress design vectors on components
% ----------------------------------------------------------------------------------
px = X * pinv(X);
fprintf(1,'\n Variation in predictors explained by nuisance covariates before orthogonalization')
fprintf(1,'\n Differences among predictors could create false activations without orthogonalization.')

for i = 1:length(xX.iC)
    r = xX.X(:,xX.iC(i)) - px * xX.X(:,xX.iC(i));       % residuals
    pve = 1 - ((r' * r) ./ (xX.X(:,xX.iC(i))' * xX.X(:,xX.iC(i)))); % percentage of variance explained
    fprintf(1,'\n%s\t%3.2f%%',xX.Xnames{xX.iC(i)},100*pve)
end

% ----------------------------------------------------------------------------------
% * Orthogonalize components (?)
% This isn't a good idea from the standpoint of misattributing noise variance to signal
% but it will prevent artifactual activations based on differential correlations with
% nuisance subspace among conditions.  Lesser of two evils?
% ----------------------------------------------------------------------------------

if doortho
	fprintf(1,'\n Orthogonalizing nuisance covariates wrt model and scaling')
	mX = xX.X(xX.iC); mX(:,end+1) = 1;
	px = mX * pinv(mX);

	for i = 1:size(X,2)
    	X(:,i) = X(:,i) - px * X(:,i);                      % residuals
    	if ~(std(X(:,i)) == 0)
    		X(:,i) = (X(:,i) - mean(X(:,i))) ./ std(X(:,i));    % re-scale
    	end
	end

	figure; imagesc(X); colormap gray; title('Found and orthogonalized nuisance covariates')
	Xn = X; save Nuisance_covariates Xn
else
	figure; imagesc(X); colormap gray; title('Found nuisance covariates')
	Xn = X; save Nuisance_covariates_ortho Xn
end

% modify SPMcfg.mat
% just don't do this, it gets messy.
% Better to just add them by loading Nuisance_covariates
% and entering as user-spec regressors.
% add_nuisance_to_SPMcfg(Xn);

fprintf(1,'\n Total running time is %3.2f s.\n',etime(clock,t1))
eval(['cd ' mypwd])

diary off
return


function varargout = drawPolyhedron(nodes, faces, varargin)
%DRAWPOLYHEDRON Draw polyhedron defined by vertices and faces
%
%   drawPolyhedron(NODES, FACES)
%   Draws the polyhedron defined by vertices NODES and the faces FACES.
%   NODES is a NV-by-3 array containing coordinates of vertices, and FACES
%   is either a NF-by3 or NF-by-4 array containing indices of vertices of
%   the triangular or rectangular faces.
%   FACES can also be a cell array, in the content of each cell is an array
%   of indices to the nodes of the current face. Faces can have different
%   number of vertices.
%
%   H = drawPolyhedron(...);
%   Also returns a handle to the created patche.
%
%   Example:
%   [n f] = createSoccerBall;
%   drawPolyhedron(n, f);
%
%   See also:
%   polyhedra, drawMesh, drawPolygon
%
%   ---------
%
%   author : David Legland
%   INRA - TPV URPOI - BIA IMASTE
%   created the 10/02/2005.
%

%   HISTORY
%   07/11/2005 update doc.
%   04/01/2007 typo
%   18/01/2007 add support for 2D polyhedra ("nodes" is N-by-2 array), and
%       make 'cnodes' a list of points instead of a list of indices
%   14/08/2007 add comment, add support for NaN in faces (complex polygons)
%   14/09/2007 rename as drawPolyhedron
%   16/10/2008 better support for colors
%   27/07/2010 copy to 'drawMesh'

%% Initialisations

% process input arguments
switch length(varargin)
    case 0
        % default color is red
        varargin = {'facecolor', [1 0 0]};
    case 1
        % use argument as color for faces
        varargin = {'facecolor', varargin{1}};
    otherwise
        % otherwise do nothing
end

% overwrites on current figure
hold on;

% if nodes are 2D points, add a z=0 coordinate
if size(nodes, 2) == 2
    nodes(1,3) = 0;
end

%% main loop : for each face

if iscell(faces)
    % array FACES is a cell array
    h = zeros(length(faces(:)), 1);

    for f = 1:length(faces(:))
        % get nodes of the cell
        face = faces{f};

        if sum(isnan(face))~=0
            % Special processing in case of multiple polygonal face.
            % each polygonal loop is separated by a NaN.

            % find indices of loops breaks
            inds = find(isnan(face));

            % replace NaNs by index of first vertex of each polygon
            face(inds(2:end))   = face(inds(1:end-1)+1);
            face(inds(1))       = face(1);
            face(length(face)+1)= face(inds(end)+1);
        end

        % draw current face
        cnodes  = nodes(face, :);
        h(f)    = patch(cnodes(:, 1), cnodes(:, 2), cnodes(:, 3), [1 0 0]);
    end

else
    % array FACES is a NC*NV indices array, with NV : number of vertices of
    % each face, and NC number of faces
    h = zeros(size(faces, 1), 1);
    for f = 1:size(faces, 1)
        % get nodes of the cell
        cnodes = nodes(faces(f,:)', :);
        h(f) = patch(cnodes(:, 1), cnodes(:, 2), cnodes(:, 3), [1 0 0]);
    end
end

% set up drawing options
if ~isempty(varargin)
    set(h, varargin{:});
end

% format output parameters
if nargout > 0
    varargout = {h};
end


%% Copyright (C) 2014, 2016, 2019 Colin B. Macdonald
%%
%% This file is part of OctSymPy.
%%
%% OctSymPy 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 software 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 software; see the file COPYING.
%% If not, see <http://www.gnu.org/licenses/>.

%% -*- texinfo -*-
%% @documentencoding UTF-8
%% @defmethod  @@sym repmat (@var{A}, @var{n}, @var{m})
%% @defmethodx @@sym repmat (@var{A}, [@var{n} @var{m}])
%% Build symbolic block matrices.
%%
%% Examples:
%% @example
%% @group
%% repmat([1 2 sym(pi)], 2, 3)
%%   @result{} (sym 2×9 matrix)
%%       ⎡1  2  π  1  2  π  1  2  π⎤
%%       ⎢                         ⎥
%%       ⎣1  2  π  1  2  π  1  2  π⎦
%%
%% repmat(sym(pi), [1 3])
%%   @result{} (sym) [π  π  π]  (1×3 matrix)
%% @end group
%% @end example
%%
%% @seealso{@@sym/vertcat, @@sym/horzcat}
%% @end defmethod

function B = repmat(A, n, m)

  if (nargin == 2)
    m = n(2);
    n = n(1);
  elseif (nargin == 3)
    % no-op
  else
    print_usage ();
  end

  cmd = { '(A, n, m) = _ins'
          'if n == 0 or m == 0:'
          '    return sp.Matrix(n, m, [])'
          'if A is None or not A.is_Matrix:'
          '    A = sp.Matrix([A])'
          'L = [A]*m'
          'B = sp.Matrix.hstack(*L)'
          'L = [B]*n'
          'B = sp.Matrix.vstack(*L)'
          'return B' };

  B = pycall_sympy__ (cmd, sym(A), int32(n), int32(m));

end

%!test
%! % simple
%! syms x
%! A = [x x x; x x x];
%! assert (isequal (repmat(x, 2, 3), A))

%!test
%! % block cf double
%! A = [1 2 3; 4 5 6];
%! B = sym(A);
%! C = repmat(A, 2, 3);
%! D = repmat(B, 2, 3);
%! assert (isequal (C, D))

%!test
%! % empty
%! A = repmat(sym([]), 2, 3);
%! assert (isempty(A));
%! assert (isequal (size(A), [0 0]))

%!test
%! % more empties
%! A = repmat(sym(pi), [0 0]);
%! assert (isequal (size(A), [0 0]))
%! A = repmat(sym(pi), [0 3]);
%! assert (isequal (size(A), [0 3]))
%! A = repmat(sym(pi), [2 0]);
%! assert (isequal (size(A), [2 0]))


function DEM_demo_ALAP
% This demonstration is essentially the same as DEM_demo_LAP - however
% here, we compare two generalised filtering schemes that are implemented
% very differently: the first integrates the generative process in
% parallel with the inversion, while the standard spm_LAP scheme inverts a
% model given pre-generated data. The advantage of generating and modelling
% data  contemporaneously is that it allows the inversion scheme to couple
% back to the generative process through action (see active inference
% schemes): spm_ALAP.
%__________________________________________________________________________
% Copyright (C) 2010 Wellcome Trust Centre for Neuroimaging

% Karl Friston
% $Id: DEM_demo_ALAP.m 7679 2019-10-24 15:54:07Z spm $

% get basic convolution model
%==========================================================================
M       = spm_DEM_M('convolution model');

% gradient functions for speed (not implemented here)
%--------------------------------------------------------------------------
% M(1).fx = inline('P.f','x','v','P');
% M(1).fv = inline('P.h','x','v','P');
% M(1).gx = inline('P.g','x','v','P');
% M(1).gv = inline('sparse(4,1)','x','v','P');

M(1).E.nN = 8;                                 % number of E steps
M(1).E.nE = 8;                                 % number of E steps
M(1).E.nD = 1;                                 % number of time steps
M(1).E.s  = 1;                                 % smoothness
G(1).E.s  = 1;                                 % smoothness
M(1).E.d  = 2;                                 % order
M(1).E.n  = 6;                                 % order

% free parameters
%--------------------------------------------------------------------------
P       = M(1).pE;                             % true parameters
ip      = [1 2 5 9];                           % free parameters
pE      = spm_vec(P);
np      = length(pE);
pE(ip)  = 0;
pE      = spm_unvec(pE,P);
pC      = sparse(ip,ip,exp(4),np,np);
M(1).pE = pE;
M(1).pC = pC;

% free hyperparameters
%--------------------------------------------------------------------------
M(1).Q  = {speye(M(1).l,M(1).l)};
M(1).R  = {speye(M(1).n,M(1).n)};
M(1).hE = 8;
M(1).gE = 6;
M(1).hC = 1/4;
M(1).gC = 1/4;

% generative process
%==========================================================================
G(1).f  = M(1).f;
G(1).g  = M(1).g;
G(1).x  = M(1).x;
G(1).V  = exp(8);
G(1).W  = exp(6);
G(1).pE = P;

G(2).v  = 0;
G(2).V  = exp(16);

% hidden cause
%--------------------------------------------------------------------------
N      = 32;
U      = exp(-((1:N) - 12).^2/(2.^2));

% invert
%==========================================================================
DEM.M  = M;
DEM.G  = G;
DEM.C  = U;

% generate and filter responses
%--------------------------------------------------------------------------
LAP    = spm_ALAP(DEM);

% filter generated responses
%--------------------------------------------------------------------------
DEM.Y  = LAP.Y;
DEM.pU = LAP.pU;
DEM.pP = LAP.pP;
DEM    = spm_LAP(DEM);

% Show results for LAP (standard scheme)
%==========================================================================
spm_figure('GetWin','Figure 1: Generalised filtering - standard scheme');

% overlay true values
%--------------------------------------------------------------------------
spm_DEM_qU(DEM.qU,DEM.pU)

% parameters
%--------------------------------------------------------------------------
qP    = spm_vec(DEM.qP.P);
qP    = qP(ip);
tP    = spm_vec(DEM.pP.P);
tP    = tP(ip);

subplot(2,2,4)
bar([tP qP])
axis square
legend('true','GF - standard')
title('parameters','FontSize',16)

cq    = 1.64*sqrt(diag(DEM.qP.C(ip,ip)));
for i = 1:length(qP),hold on
    plot([i i] + 1/8,qP(i) + [-1 1]*cq(i),'LineWidth',4,'color','r')
end, hold off

% Show results for ALAP (parallel scheme)
%==========================================================================
spm_figure('GetWin','Figure 2: Generalised filtering - parallel scheme');

% overlay true values
%--------------------------------------------------------------------------
spm_DEM_qU(LAP.qU,LAP.pU)

% parameters
%--------------------------------------------------------------------------
qP    = spm_vec(LAP.qP.P);
qP    = qP(ip);
tP    = spm_vec(LAP.pP.P);
tP    = tP(ip);

subplot(2,2,4)
bar([tP qP])
axis square
legend('true','GF - parallel')
title('parameters','FontSize',16)

cq    = 1.64*sqrt(diag(LAP.qP.C(ip,ip)));
for i = 1:length(qP),hold on
    plot([i i] + 1/8,qP(i) + [-1 1]*cq(i),'LineWidth',4,'color','r')
end, hold off

% Compare
%==========================================================================
spm_figure('GetWin','Figure 3: Comparison of integration schemes');

% hyperparameters
%--------------------------------------------------------------------------
qL    = spm_vec({LAP.qH.h LAP.qH.g});
qD    = spm_vec({DEM.qH.h DEM.qH.g});
vL    = spm_vec({LAP.qH.V LAP.qH.W});
vD    = spm_vec({DEM.qH.V DEM.qH.W});
qh    = log([G(1).V; G(1).W]);

subplot(2,2,1)
bar([qh qL qD])
axis square
legend('true','parallel','standard')
title('log-precisions','FontSize',16)

cq    = 1.64*sqrt(vL);
for i = 1:length(qL),hold on
    plot([i i] + 0,qL(i) + [-1 1]*cq(i),'LineWidth',4,'color','r')
end, hold off

cq    = 1.64*sqrt(vD);
for i = 1:length(qD),hold on
    plot([i i] + 1/4,qD(i) + [-1 1]*cq(i),'LineWidth',4,'color','r')
end, hold off

% Log-evidence
%--------------------------------------------------------------------------
subplot(2,2,2)
nL   = length(LAP.F);
nD   = length(DEM.F);
plot(1:nL,LAP.F,1:nD,DEM.F)
axis square
legend('parallel (F)','standard (F)')
title('log-evidence ','FontSize',16)
xlabel('iteration','FontSize',12)


X=randn(64,200);
Y=randn(200,20000)';

tic
XYt=mexCalcXYt(X,Y);
t=toc;
fprintf('mex-file time: %fs\n',t);

tic
XYt2=X*Y';
t=toc;
fprintf('matlab-file time: %fs\n',t);

sum((XYt(:)-XYt2(:)).^2)


function imgOut = ConvertXYZtoIPT(img, inverse)
%
%       imgOut = ConvertXYZtoIPT(img, inverse)
%
%
%        Input:
%           -img: image to convert from XYZ to IPT or from IPT to XYZ.
%           -inverse: takes as values 0 or 1. If it is set to 1 the
%                     transformation from XYZ to IPT is applied, otherwise
%                     the transformation from IPT to XYZ.
%
%        Output:
%           -imgOut: converted image in XYZ or IPT.
%
%     Copyright (C) 2011  Francesco Banterle
%
%     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/>.
%

if(inverse == 0)
    imgLMS = ConvertXYZtoLMS(img, 0);

    imgOut = ConvertLMStoIPT(imgLMS, 0);

else
    imgLMS = ConvertLMStoIPT(img, 1);

    imgOut = ConvertXYZtoLMS(imgLMS, 1);
end

end


classdef SOP_F23 < PROBLEM
% <single> <real> <expensive/none>
% Shekel's family

%------------------------------- Reference --------------------------------
% X. Yao, Y. Liu, and G. Lin, Evolutionary programming made faster, IEEE
% Transactions on Evolutionary Computation, 1999, 3(2): 82-102.
%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    methods
        %% Default settings of the problem
        function Setting(obj)
            obj.M = 1;
            obj.D = 4;
            obj.lower    = zeros(1,obj.D);
            obj.upper    = zeros(1,obj.D) + 10;
            obj.encoding = ones(1,obj.D);
        end
        %% Calculate objective values
        function PopObj = CalObj(obj,PopDec)
            a = [4 4 4 4;1 1 1 1;8 8 8 8;6 6 6 6;3 7 3 7;2 9 2 9;5 5 3 3;8 1 8 1;6 2 6 2;7 3.6 7 3.6];
            c = [0.1;0.2;0.2;0.4;0.4;0.6;0.3;0.7;0.5;0.5];
            PopObj = zeros(size(PopDec,1),1);
            for i = 1 : size(PopDec,1)
                PopObj(i) = -sum(1./(sum((repmat(PopDec(i,:),10,1)-a).^2,2)+c));
            end
        end
        %% Generate the minimum objective value
        function R = GetOptimum(obj,N)
            R = -10.54;
        end
    end
end


function [modes, weights,centerId] = calcComponents(SO3F,varargin)
% heuristic to find modal orientations
%
% Syntax
%   [modes, volume] = calcComponents(SO3F)
%   [modes, volume, centerId] = calcComponents(SO3F,'seed',ori)
%
% Input
%  SO3F - @SO3Fun
%  ori - initial list of @orientation
%
% Output
%  modes     - modal @orientation
%  volume    - volume of the component
%  centerId  - list of ids to which each initial ori converged to
%
% Options
%  resolution - search-grid resolution
%  angle      - maximum component width used for volume computation
%  exact      - do not dismiss very small modes at the end
%
% See also
% SO3Fun/max

% extract options
maxIter = get_option(varargin,'maxIter',100);
res = get_option(varargin,'resolution',0.05*degree);
omega = 1.5.^(-7:1:4) * degree;
omega(omega<res) = [];
omega = [0,omega];
tol = get_option(varargin,'tolerance',0.5*degree);
maxAngle = get_option(varargin,{'radius','angle'},inf);

% initial seed
if check_option(varargin,'seed')
  seed = reshape(get_option(varargin,'seed'),[],1);
  weights = get_option(varargin,'weights',SO3F.eval(seed));
elseif isa(SO3F,'SO3FunRBF')
  seed = SO3F.center;
  weights = SO3F.weights;
else
  seed = equispacedSO3Grid(SO3F.CS,SO3F.SS,'resolution',2.5*degree);
  weights = ones(length(seed),1) ./ length(seed);
end
id = weights>0;
seed = reshape(seed(id),[],1);
weights = weights(id);
weights = weights ./ sum(weights);

centerId = 1:length(seed);
modes = seed;

% join orientations if possible
%[modes,~,id2] = unique(modes,'tolerance',tol);
%centerId = id2(centerId);
%weights = accumarray(id2,weights);

finished = false(size(modes));

G = SO3F.grad;

for k = 1:maxIter
  progress(k,maxIter,' finding ODF components: ');

  % gradient
  g = normalize(G.eval(modes(~finished)),1);

  % prepare for linesearch
  line_ori = exp(repmat(modes(~finished),1,length(omega)),g * omega);

  % evaluate along lines
  line_v = SO3F.eval(line_ori);

  % take the maximum
  [v_max(~finished),id] = max(line_v,[],2);

  % update orientions
  modes(~finished) = line_ori(sub2ind(size(line_ori),(1:length(g)).',id));

  %nnz(id>1)
  if all(id == 1), break; end

  % join orientations if possible
  [~,~,id2] = unique(modes,'tolerance',tol);

  modes = modes(maxVote(id2,v_max(~finished)));

  centerId = id2(centerId);
  finished = accumarray(id2,finished,[],@any);
  if maxAngle == inf, weights = accumarray(id2,weights); end
  length(modes);

end

% accumulate only weights that are sufficiently close to the centers
if maxAngle < inf
  inRadius = angle(seed,modes(centerId))<maxAngle;
  weights = accumarray(centerId(inRadius), weights(inRadius));
end

% sort components according to volume
[weights,id] = sort(weights,'descend');
modes = modes(id);
iid(id) = 1:length(id);
centerId = iid(centerId);

if ~check_option(varargin,'exact')
  id = weights > min([0.01, numSym(SO3F.CS) * maxAngle^3 ./ 8*pi^2,0.5 * max(weights)]);
  weights = weights(id);
  modes = modes(id);
  ids = 1:length(id);
  centerId(ismember(centerId,ids(~id))) = 0;
end

% weights = [2 1 5 3 4] -> [1 2 3 4 5]
% id -> [2 1 5 3 4]
% centerId = 3 -> 5
end

function test
% testing code

cs = crystalSymmetry('432');
cs2 = specimenSymmetry;
center = orientation.rand(5,cs,cs2);
odf = unimodalODF(center,'halfwidth',5*degree)
ori = discreteSample(odf,2000);
odf2 = calcDensity(ori,'noFourier','exact','halfwidth',2.5*degree)

cs2 = crystalSymmetry('432')
center = orientation.rand(5,cs,cs2);
odf = unimodalODF(center,'halfwidth',2.5*degree)
ori = discreteSample(odf,1000);
odf2 = calcDensity(ori,'noFourier','exact','halfwidth',3*degree)

[modes,vol,cId] = odf2.calcComponents;

for i = 1:length(modes)
  plot(ori(cId==i),'axisAngle')
  hold on
  plot(modes(i),'MarkerFaceColor','k','MarkerSize',10)
end
hold off

min(angle_outer(modes,center) ./ degree)

end


function vl_structuredNetwork_pairwiseModel_test_derivative
%vl_structuredNetwork_pairwiseModel_test_derivative tests vl_structuredNetwork_pairwiseModel

% create the following file from the variables of cnn_train_pairwiseModel.m right before the call of vl_structuredNetwork_pairwiseModel.m
load( 'vl_structuredNetwork_pairwiseModel_test_derivative.mat', 'net', 'im', 'gradients', 'labels', 'one' );
testEps = 1e-3;

fprintf('Computing the gradient ... ');
tStart = tic;
[lossValue, gradients, predictions] = vl_structuredNetwork_pairwiseModel(net, im, gradients, labels, one, ...
    'conserveMemory', true, ...
    'sync', true, ...
    'disableDropout', true ) ;
fprintf( '%f\n', toc(tStart) );

maxGroupTests = 100;
rng(1);

% test derivatives
for iLayer = length( net.layers ) : -1 : 1
    if ~isequal( net.layers{iLayer}.type, 'conv' )
        continue;
    end
    fprintf('Layer %d: %s\n', iLayer, net.layers{iLayer}.name);

    empiricalDerivative = zeros( numel(gradients{ iLayer }.dzdw{2}), 1, 'like', gradients{ iLayer }.dzdw{2});
    fprintf('Number of bias derivatives: %d\n', numel(empiricalDerivative));

    randOrder = randperm(numel(empiricalDerivative));
    numTests = min( numel(empiricalDerivative), maxGroupTests);
    for iValueIndex = 1 : numTests
        if mod(iValueIndex, 1000) == 0
            fprintf('Derivative #%d\n', iValueIndex);
        end
        iValue = randOrder(iValueIndex);

        initValue = net.layers{iLayer}.weights{2}(iValue);
        net.layers{iLayer}.weights{2}(iValue) = initValue + testEps;

        [lossValue_test, ~, predictions_test] = vl_structuredNetwork_pairwiseModel(net, im, gradients, labels, [], ...
            'conserveMemory', true, ...
            'sync', true, ...
            'disableDropout', true) ;

        empiricalDerivative(iValue) = sum(lossValue_test - lossValue) / testEps;

        net.layers{iLayer}.weights{2}(iValue) = initValue;
    end

    testIndices = randOrder(1 : numTests);
    emphiricalGradient = empiricalDerivative(testIndices);
    computedGradient = gradients{ iLayer }.dzdw{2}(testIndices);
    derivativeError = gather( norm(emphiricalGradient(:) - computedGradient(:)) / norm(computedGradient(:)) );

    fprintf('Relative error of bias derivatives: %f\n', derivativeError );
    fprintf('Norm of tested derivatives: %f\n', norm(computedGradient(:)) );

    empiricalDerivative = zeros( numel(gradients{ iLayer }.dzdw{1}), 1, 'like', gradients{ iLayer }.dzdw{1});
    fprintf('Number of filter derivatives: %d\n', numel(empiricalDerivative));

    randOrder = randperm(numel(empiricalDerivative));
    numTests = min( numel(empiricalDerivative), maxGroupTests);
    for iValueIndex = 1 : numTests
        if mod(iValueIndex, 1000) == 0
            fprintf('Derivative #%d\n', iValueIndex);
        end

        iValue = randOrder(iValueIndex);

        initValue = net.layers{iLayer}.weights{1}(iValue);
        net.layers{iLayer}.weights{1}(iValue) = initValue + testEps;

        [lossValue_test, ~, predictions_test] = vl_structuredNetwork_pairwiseModel(net, im, gradients, labels, [], ...
            'conserveMemory', true, ...
            'sync', true, ...
            'disableDropout', true) ;

        empiricalDerivative(iValue) = sum(lossValue_test - lossValue) / testEps;

        net.layers{iLayer}.weights{1}(iValue) = initValue;
    end

    testIndices = randOrder(1 : numTests);
    emphiricalGradient = empiricalDerivative(testIndices);
    computedGradient = gradients{ iLayer }.dzdw{1}(testIndices);
    derivativeError = gather( norm(emphiricalGradient(:) - computedGradient(:)) / norm(computedGradient(:)) );

    fprintf('Relative error of filter derivatives: %f\n', derivativeError );
    fprintf('Norm of tested derivatives: %f\n', norm(computedGradient(:)) );

end

end


function PlotMesh(coordinates,nodes)
%--------------------------------------------------------------------------
% Code written by : Siva Srinivas Kolukula                                |
%                   Senior Research Fellow                                |
%                   Structural Mechanics Laboratory                       |
%                   Indira Gandhi Center for Atomic Research              |
%                   India                                                 |
% E-mail : allwayzitzme@gmail.com                                         |
%          http://sites.google.com/site/kolukulasivasrinivas/             |
%--------------------------------------------------------------------------
%--------------------------------------------------------------------------
% Purpose:
%         To plot the Finite Element Method Mesh
% Synopsis :
%           PlotMesh(coordinates,nodes)
% Variable Description:
%           coordinates - The nodal coordinates of the mesh
%           -----> coordinates = [node X Y]
%           nodes - The nodal connectivity of the elements
%           -----> nodes = [node1 node2......]
%--------------------------------------------------------------------------

nel = length(nodes) ;                  % number of elements
nnode = length(coordinates) ;          % total number of nodes in system
nnel = size(nodes,2);                % number of nodes per element
%
% Initialization of the required matrices
X = zeros(nnel,nel) ;
Y = zeros(nnel,nel) ;

for iel=1:nel
     for i=1:nnel
     nd(i)=nodes(iel,i);         % extract connected node for (iel)-th element
     X(i,iel)=coordinates(nd(i),1);    % extract x value of the node
     Y(i,iel)=coordinates(nd(i),2);    % extract y value of the node
     end
end

% Plotting the FEM mesh, diaplay Node numbers and Element numbers
     f1 = figure ;
     set(f1,'name','Mesh','numbertitle','off','Color','w') ;
     fill(X,Y,'w')

     title('Finite Element Mesh') ;
     axis off ;

% To disply the node numbers
%      k = nodes(:,1:end);
%      nd = k' ;
%     for i = 1:nel
%         text(X(:,i),Y(:,i),int2str(nd(:,i)),'fontsize',8,'color','k');
%         text(sum(X(:,i))/4,sum(Y(:,i))/4,int2str(i),'fontsize',10,'color','r') ;
%     end


function varargout=lomb(varargin)
%
% [Pxx,F]=lomb(x,dcOffset,smooth)
%
%    Wrapper to WFDB LOMB:
%         http://www.physionet.org/physiotools/wag/lomb-1.htm
%
% Transforms a real-valued time series 'x' into a power spectrum 'X', using a
% technique known as the Lomb periodogram. The input is a Nx2 matrix containing
% a sampled time series, presented as two columns of numbers (the sample times
% in the first column and the sample values in the second). The intervals between
% consecutive samples need not be uniform.
%
%Input Parameters:
% x
%       Nx2 vector of doubles. First column is sample time index (in
%       seconds), and second column is the sample value of the signal at
%       that time.
%
% dcOffset (Optional)
%       Booelan. If present add constant to input samples ( x(:,2) ), such that the mean
%       values of the time series is zero (default=1).
%
% smooth   (Optional)
%       Boolean String specifying the if the output should be smoothed (default =1).
%
%
%Output Parameters:
%
%Pxx
%       Mx1 Double. Estimated power spectrum.
%
%F
%       Mx1 Double. Frequency of the estimated power spectrum (Hz).
%
%
% CITING CREDIT: To credit this function, please cite the following paper at your work:
%
%Moody, G.B.
%    Spectral analysis of heart rate without resampling. Computers in Cardiology 1993, pp. 715-718 (IEEE Computer Society Press, 1993). http://www.physionet.org/physiotools/lomb/lomb.html .
%
%
%Additional References:
%Lomb, N.R.
%    Least-squares frequency analysis of unequally spaced data. Astrophysics and Space Science 39:447-462 (1976).
%Press, W.H, and Rybicki, G.B.
%    Fast algorithm for spectral analysis of unevenly sampled data. Astrophysical J. 338:277-280 (1989).
%Press, W.H. Teukolsky, S.A., Vetterling, W.T., and Flannery, B.P.
%    Numerical Recipes in C: the Art of Scientific Computing, pp. 575-584 (Cambridge Univ. Press, 1992).
%Moody, G.B.
%    Spectral analysis of heart rate without resampling. Computers in Cardiology 1993, pp. 715-718 (IEEE Computer Society Press, 1993). http://www.physionet.org/physiotools/lomb/lomb.html .
%
%
%
% MATLAB wrapper written by Ikaro Silva, 2013
% Last Modified: -
% Version 1.0
% Since 0.9.0
%
%
% %Example: Heart Rate Spectral Analysis:
% [tm, signal]=rdsamp('mitdb/100',1);
% [ann]=rdann('mitdb/100','atr');
% [Pxx,F]=lomb([tm(ann) signal(ann)]);
% plot(F,Pxx);grid on;hold on
%
% See also RDANN, TACH, SQRS, WQRS

%endOfHelp

persistent javaWfdbExec
if(isempty(javaWfdbExec))
    javaWfdbExec=getWfdbClass('lomb');
end

%Set default pararamter values
%[Pxx,F]
inputs={'x','dcOffset','smooth'};
dcOffset=1;
smooth=1;
for n=1:nargin
    if(~isempty(varargin{n}))
        eval([inputs{n} '=varargin{n};'])
    end
end

wfdb_argument={'-P'};

if(dcOffset)
     wfdb_argument{end+1}='-z';
end
if(smooth)
     wfdb_argument{end+1}='-s';
end

wfdb_argument{end+1}='-';
del=repmat([' '],size(x(:,1)));
data=[num2str(x(:,1)) del num2str(x(:,2))];
javaWfdbExec.setArguments(wfdb_argument);
pxx=char(javaWfdbExec.execWithStandardInput(cellstr(data)));
pxx=sscanf(pxx(2:end-1), '%f %f,');

varargout{1}=pxx(2:2:end);
varargout{2}=pxx(1:2:end);


function w = wave2gray(c, s, scale, border)
%WAVE2GRAY Display wavelet decomposition coefficients.
%   W = WAVE2GRAY(C, S, SCALE, BORDER) displays and returns a
%   wavelet coefficient image.
%
%   EXAMPLES:
%     wave2gray(c, s);                      Display w/defaults.
%     foo = wave2gray(c, s);                Display and return.
%     foo = wave2gray(c, s, 4);             Magnify the details.
%     foo = wave2gray(c, s, -4);            Magnify absolute values.
%     foo = wave2gray(c, s, 1, 'append');   Keep border values.
%
%   INPUTS/OUTPUTS:
%     [C, S] is a wavelet decomposition vector and bookkeeping
%     matrix.
%
%     SCALE       Detail coefficient scaling
%     ----------------------------------------------------------
%     0 or 1      Maximum range (default)
%     2,3...      Magnify default by the scale factor
%     -1, -2...   Magnify absolute values by abs(scale)
%
%     BORDER      Border between wavelet decompositions
%     ----------------------------------------------------------
%     'absorb'    Border replaces image (default)
%     'append'    Border increases width of image
%
%     Image W:   ------- ------ ------------ -------------------
%                |      |      |            |
%                | a(n) | h(n) |            |
%                |      |      |            |
%                ------- ------     h(n-1)  |
%                |      |      |            |
%                | v(n) | d(n) |            |        h(n-2)
%                |      |      |            |
%                ------- ------ ------------
%                |             |            |
%                |    v(n-1)   |   d(n-1)   |
%                |             |            |
%                -------------- ------------ -------------------
%                |                          |
%                |          v(n-2)          |        d(n-2)
%                |                          |
%
%     Here, n denotes the decomposition step scale and a, h, v, d are
%     approximation, horizontal, vertical, and diagonal detail
%     coefficients, respectively.

%   Copyright 2002-2004 R. C. Gonzalez, R. E. Woods, & S. L. Eddins
%   Digital Image Processing Using MATLAB, Prentice-Hall, 2004
%   $Revision: 1.6 $  $Date: 2003/11/21 15:01:44 $

% Check input arguments for reasonableness.
error(nargchk(2, 4, nargin));

if (ndims(c) ~= 2) | (size(c, 1) ~= 1)
  error('C must be a row vector.');   end

if (ndims(s) ~= 2) | ~isreal(s) | ~isnumeric(s) | (size(s,2) ~= 2)
  error('S must be a real, numeric two-column array.');   end

elements = prod(s, 2);
if (length(c) < elements(end)) | ...
      ~(elements(1) + 3 * sum(elements(2:end - 1)) >= elements(end))
   error(['[C S] must be a standard wavelet ' ...
          'decomposition structure.']);
end

if (nargin > 2) & (~isreal(scale) | ~isnumeric(scale))
   error('SCALE must be a real, numeric scalar.');
end

if (nargin > 3) & (~ischar(border))
  error('BORDER must be character string.');
end

if nargin == 2
   scale = 1;  % Default scale.
end

if nargin < 4
   border = 'absorb';  % Default border.
end

% Scale coefficients and determine pad fill.
absflag = scale < 0;
scale = abs(scale);
if scale == 0
   scale = 1;
end

[cd, w] = wavecut('a', c, s);   w = mat2gray(w);
cdx = max(abs(cd(:))) / scale;
if absflag
   cd = mat2gray(abs(cd), [0, cdx]);   fill = 0;
else
   cd = mat2gray(cd, [-cdx, cdx]);   fill = 0.5;
end

% Build gray image one decomposition at a time.
for i = size(s, 1) - 2:-1:1
   ws = size(w);

   h = wavecopy('h', cd, s, i);
   pad = ws - size(h);     frontporch = round(pad / 2);
   h = padarray(h, frontporch, fill, 'pre');
   h = padarray(h, pad - frontporch, fill, 'post');

   v = wavecopy('v', cd, s, i);
   pad = ws - size(v);     frontporch = round(pad / 2);
   v = padarray(v, frontporch, fill, 'pre');
   v = padarray(v, pad - frontporch, fill, 'post');

   d = wavecopy('d', cd, s, i);
   pad = ws - size(d);     frontporch = round(pad / 2);
   d = padarray(d, frontporch, fill, 'pre');
   d = padarray(d, pad - frontporch, fill, 'post');

   % Add 1 pixel white border.
   switch lower(border)
   case 'append'
      w = padarray(w, [1 1], 1, 'post');
      h = padarray(h, [1 0], 1, 'post');
      v = padarray(v, [0 1], 1, 'post');
   case 'absorb'
      w(:, end) = 1;   w(end, :) = 1;
      h(end, :) = 1;   v(:, end) = 1;
   otherwise
      error('Unrecognized BORDER parameter.');
   end

   w = [w h; v d];                 % Concatenate coefs.
end

if nargout == 0
   imshow(w);                      % Display result.
end


function [ X, Y ] = plot_fun ( )

%*****************************************************************************80
%
%% PLOT_FUN demonstrates MATLAB's SPMD command for parallel programming.
%
%  Discussion:
%
%    Each worker computes X and Y data for a portion of a sine curve.
%
%    The client patches the composite data into numeric arrays and
%    returns that as the function output.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    27 March 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Output, real X(N,100), Y(N,100), the data, stored as N vectors.
%

%
%  Set a list of colors that will be cycled through with each
%  plot command.
%
  spmd
    a = 2 * pi * ( labindex - 1 ) / numlabs;
    b = 2 * pi *   labindex       / numlabs;
    x = linspace ( a, b, 100 );
    y = sin ( x );
    fprintf ( 1, '  Lab %d works on [%f,%f].\n', labindex, a, b );
  end
%
%  Copy the composite data from the workers, and
%  convert it into numeric arrays.
%
%  (Only client data can be returned as output arguments!)
%
  n = matlabpool ( 'size' );

  X = [];
  Y = [];

  for i = 1 : n
    X = [ X; x{i} ];
    Y = [ Y; y{i} ];
  end

  return
end


function determ = pds_random_determinant ( n, key )

%*****************************************************************************80
%
%% PDS_RANDOM_DETERMINANT returns the determinant of the PDS_RANDOM matrix.
%
%  Discussion:
%
%    This routine will only work properly if the SAME value of SEED
%    is input that was input to PDS_RANDOM.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of A.
%
%    Input, integer KEY, a positive value that selects the data.
%
%    Output, real DETERM, the determinant.
%
  seed = key;
  [ lambda, seed ] = r8vec_uniform_01 ( n, seed );

  determ = prod ( lambda(1:n) );

  return
end


%Question No:5
%IDEAL LOW-PASS FILTER

function idealfilter(X,P)
f=imread(X);
[M,N]=size(f);
F=fft2(double(f));
u=0:(M-1);
v=0:(N-1);
idx=find(u>M/2);
u(idx)=u(idx)-M;
idy=find(v>N/2);
v(idy)=v(idy)-N;
[V,U]=meshgrid(v,u);
D=sqrt(U.^2+V.^2);
H=double(D<=P);
G=H.*F;
g=real(ifft2(double(G)));
imshow(f),figure,imshow(g,[ ]);
end


function [ts_smooth] = circ_smoothTS(varargin)
% USAGE
% [ts_smooth] = circ_smoothTS(varargin)
%
% Given a timeseries input of circular data, this function smooths over the
% desired number of bins and returns a circularly smooth timeseries
%
% INPUTS
%
%   ts         a time series of circular data
%   nBins      integer number of bins you would like to smooth over
%   method     string argument that determines the smoothing method,
%              options are 'median', 'mean' [default: 'median']
%   exclude    vector of values in ts to exclude from smoothing (can be
%              used to exclude 0 values)
%
% OUTPUTS
%
%   ts_smooth  a time series vector of smoothed circular data
%
% HELP
%
% Written by David Tingley, 2017
% TODO error handling when nBins > 1/2 ts

p = inputParser;
addRequired(p,'ts',@isvector);
addRequired(p,'nBins',@isnumeric);
addParameter(p,'method','median',@isstr)
addParameter(p,'exclude',[],@isvector);

parse(p,varargin{:});

ts = p.Results.ts;
if size(ts,1) == 1;
    ts = ts';
end

nBins = p.Results.nBins;
method = p.Results.method;
exclude = p.Results.exclude;

if length(exclude) == length(ts)
   ts_smooth = ts;
   return
end
if nBins == 1
    ts_smooth = ts;
    return
end

if ~isempty(exclude)
    list = find(ts==exclude);
    ts(list) = nan;
end

exclude = find(isnan(ts));
keep = find(~isnan(ts));

f = find(diff(keep)<nBins);
ff = find(diff(keep)>=nBins);
if ~isempty(ff)
    ff(end+1) = length(keep);  % include last ts
end
if length(keep) == 0
    ts(isnan(ts))=0;
    ts_smooth = ts;
    return
end

ts_smooth = zeros(length(ts),1);

for i =1:length(ff)  % populate list with single spikes that occur sparsely
    if keep(ff(i))>ceil(nBins/2) & keep(ff(i))+ceil(nBins/2) < length(ts) % prevents negative indices from being added
        ts_smooth(keep(ff(i))-ceil(nBins/2):keep(ff(i))+ceil(nBins/2)) = ts(keep(ff(i)));
    elseif keep(ff(i))+ceil(nBins/2) < length(ts)
        ts_smooth(1:keep(ff(i))+ceil(nBins/2)) = ts(keep(ff(i)));
    elseif keep(ff(i))>ceil(nBins/2)
        ts_smooth(keep(ff(i))-ceil(nBins/2):end) = ts(keep(ff(i)));
    end
end

for i=1:length(f) % populate list with spikes that occur within smoothing window
    ind = (keep(f(i))-ceil(nBins/2):keep(f(i))+ceil(nBins/2));
    ind(ind<1) = [];
    ind(ind>length(ts)) = [];
    keep = [keep; ind'];
%     if keep(f(i)) > ceil(nBins/2) & keep(f(i)+1)+ceil(nBins/2) < length(ts) % prevents negative indices from being added
%         keep = [keep; [keep(f(i))-ceil(nBins/2):keep(f(i)+1)+ceil(nBins/2)]'];
%     elseif ~(keep(f(i)) > ceil(nBins/2)) &  keep(f(i)+1)+ceil(nBins/2) < length(ts)
%         keep = [keep; [ceil(nBins/2) + 1:keep(f(i)+1)+ceil(nBins/2)]'];
%     elseif keep(f(i)) > ceil(nBins/2) & ~(keep(f(i)+1)+ceil(nBins/2) < length(ts))
%         keep = [keep; [keep(f(i))-ceil(nBins/2):length(ts)- ceil(nBins/2)]'];
%     end
end

keep = sort(unique(keep));
% keep(keep>0)=[];

%% start smoothing
for ii = 1:length(keep)
    i = keep(ii);
    ind = (i-ceil(nBins/2):i+ceil(nBins/2));
    ind(ind<1) = [];
    ind(ind>length(ts)) = [];
    [loc] = ~ismember(ind,exclude);

%     if ~isempty(loc) & sum(loc) > 0

        if strcmp(method,'median')
                ts_smooth(i) = circ_median(ts(ind(loc)));
        elseif strcmp(method,'mean')
                ts_smooth(i) = circ_mean(ts(ind(loc)));
        elseif strcmp(method,'gaussian')
                g = gauss(length(ind),1)';
                ts_smooth(i) = circ_mean(ts(ind(loc)),g(loc));
%                 ts_smooth(i) = circ_mean(ts(ind(loc)));
        elseif strcmp(method,'interp')
                error('interp not implented yet...')
        else
                error('couldnt find smoothing method')
        end
%     else
%         ts_smooth(ind) = ts(i);
%     end

end

ts_smooth(isnan(ts_smooth)) = 0;
% there's a lot of indexing going on, so let's double check the returned
% time series didn't change length...
if length(ts_smooth) ~= length(ts)
   error('output TS is the wrong length!')
end


% SP_L2_ERROR: Evaluate the error in L^2 norm.
%
%   errl2 = sp_l2_error (space, msh, u, uex)
%
% INPUT:
%
%   space: object defining the space of discrete functions (see sp_vector)
%   msh:   object defining the domain partition and the quadrature rule (see msh_cartesian)
%   u:     vector of dof weights
%   uex:   function handle to evaluate the exact solution
%
% OUTPUT:
%
%     errl2:  error in L^2 norm
%
% Copyright (C) 2010 Carlo de Falco
% Copyright (C) 2011, 2015 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 Octave; see the file COPYING.  If not, see
% <http://www.gnu.org/licenses/>.

function errl2 = sp_l2_error (space, msh, u, uex)

  if (numel(u) ~= space.ndof)
    error ('Wrong size of the vector of degrees of freedom')
  end

  errl2 = 0;

  for iel = 1:msh.nel_dir(1)
    msh_col = msh_evaluate_col (msh, iel);
    sp_col  = sp_evaluate_col (space, msh_col, 'value', true, 'gradient', false);

    errl2 = errl2 + (sp_l2_error (sp_col, msh_col, u, uex)).^2;
  end

  errl2 = sqrt (errl2);

end


function pde = LinearFun2HM(am,ap,bm,bp,kappa,r,x0,y0,z0)
%% USAGE: polynomial solution for Poisson equation
%  Last Modified: 02/21/2020 by Xu Zhang

%% PDE Structure
pde = struct('intf',@intf,...
    'exactu1',@exactu1,'exactu2',@exactu2,'exactu3',@exactu3,...
    'um1',@um1,'um2',@um2,'um3',@um3,'up1',@up1,'up2',@up2,'up3',@up3,...
    'Dxu',@Dxu,'Dxum',@Dxum,'Dxup',@Dxup,'Dyu',@Dyu,...
    'Dyum',@Dyum,'Dyup',@Dyup,'Dzu',@Dzu,'Dzum',@Dzum,'Dzup',@Dzup,...
    'f1',@f1,'f2',@f2,'f3',@f3,...
    'fm1',@fm1,'fm2',@fm2,'fm3',@fm3,...
    'fp1',@fp1,'fp2',@fp2,'fp3',@fp3,...
    'A',@A,'Am',@Am,'Ap',@Ap,'one',@one,...
    'B',@B,'Bm',@Bm,'Bp',@Bp);

pde.bm = bm;
pde.bp = bp;
pde.am = am;
pde.ap = ap;
pde.kappa = kappa;
%% interface function
    function u = intf(x,y,z)
        u = ((x-x0).^2 + (y-y0).^2 + (z-z0).^2).^(1/2)/r-1;
    end

%% exact solution
    function u = exactu1(x,y,z)
        u = um1(x,y,z);
        id = intf(x,y,z) > 0;
        u(id) = up1(x(id),y(id),z(id));
    end
    function u = exactu2(x,y,z)
        u = um2(x,y,z);
        id = intf(x,y,z) > 0;
        u(id) = up2(x(id),y(id),z(id));
    end
    function u = exactu3(x,y,z)
        u = um3(x,y,z);
        id = intf(x,y,z) > 0;
        u(id) = up3(x(id),y(id),z(id));
    end
    function u = um1(x,y,z)
        u = 2*(x-x0)/bm;
    end
    function u = um2(x,y,z)
        u = 2*(y-y0)/bm;
    end
    function u = um3(x,y,z)
        u = 2*(z-z0)/bm;
    end
    function u = up1(x,y,z)
        u = 2*(x-x0)/bp;
    end
    function u = up2(x,y,z)
        u = 2*(y-y0)/bp;
    end
    function u = up3(x,y,z)
        u = 2*(z-z0)/bp;
    end

%% Boundary Function
    function u = gD1(x,y,z)
        u = exactu1(x,y,z);
    end
    function u = gD2(x,y,z)
        u = exactu2(x,y,z);
    end
    function u = gD3(x,y,z)
        u = exactu3(x,y,z);
    end
%% Derivative of the exact solution
    function u = Dxu(x,y,z)
        u = Dxum(x,y,z);
        id = intf(x,y,z) > 0;
        u(id) = Dxup(x(id),y(id),z(id));
    end
    function u = Dyu(x,y,z)
        u = Dyum(x,y,z);
        id = intf(x,y,z) > 0;
        u(id) = Dyup(x(id),y(id),z(id));
    end
    function u = Dzu(x,y,z)
        u = Dzum(x,y,z);
        id = intf(x,y,z) > 0;
        u(id) = Dzup(x(id),y(id),z(id));
    end
    function u = Dxum(x,y,z)
        u = zeros(size(x));
    end
    function u = Dyum(x,y,z)
        u = zeros(size(x));
    end
    function u = Dzum(x,y,z)
        u = zeros(size(x));
    end
    function u = Dxup(x,y,z)
        u = zeros(size(x));
    end
    function u = Dyup(x,y,z)
        u = zeros(size(x));
    end
    function u = Dzup(x,y,z)
        u = zeros(size(x));
    end

    function u = Duker(x,y,z)
        u = zeros(size(x));
    end

%% right hand side function
    function u = f1(x,y,z)
        u = fm1(x,y,z);
        id = intf(x,y,z) > 0;
        u(id) = fp1(x(id),y(id),z(id));
    end
    function u = f2(x,y,z)
        u = fm2(x,y,z);
        id = intf(x,y,z) > 0;
        u(id) = fp2(x(id),y(id),z(id));
    end
    function u = f3(x,y,z)
        u = fm3(x,y,z);
        id = intf(x,y,z) > 0;
        u(id) = fp3(x(id),y(id),z(id));
    end

    function u = fm1(x,y,z)
        u = -2*(x-x0)*kappa;
    end
    function u = fm2(x,y,z)
        u = -2*(y-y0)*kappa;
    end
    function u = fm3(x,y,z)
        u = -2*(z-z0)*kappa;
    end
    function u = fp1(x,y,z)
        u = -2*(x-x0)*kappa;
    end
    function u = fp2(x,y,z)
        u = -2*(y-y0)*kappa;
    end
    function u = fp3(x,y,z)
        u = -2*(z-z0)*kappa;
    end

%% Diffusion coefficient function
    function u = A(x,y,z)
        u = Am(x,y,z);
        id = intf(x,y,z) > 0;
        u(id) = Ap(x(id),y(id),z(id));
    end
    function u = Am(x,y,z)
        u = am*ones(size(x));
    end
    function u = Ap(x,y,z)
        u = ap*ones(size(x));
    end
%% Mass coefficient function
    function u = B(x,y,z)
        u = Bm(x,y,z);
        id = intf(x,y,z) > 0;
        u(id) = Bp(x(id),y(id),z(id));
    end
    function u = Bm(x,y,z)
        u = bm*ones(size(x));
    end
    function u = Bp(x,y,z)
        u = bp*ones(size(x));
    end

%% Other function
    function u = one(x,y,z)
        u = ones(size(x));
    end
end


function [X, info] = IRirn(A, b, varargin)
% IRirn Least squares solver with 1-norm penalization term
%
% options  = IRirn('defaults')
% [X,info] = IRirn(A,b)
% [X,info] = IRirn(A,b,K)
% [X,info] = IRirn(A,b,options)
% [X,info] = IRirn(A,b,K,options)
%
% Iteratively reweighted norm algorithm for computing a 1-norm penalized
% solution.
%
% IRirn is a simplified driver for IRrestart, which uses an inner-outer
% iteration scheme. Semi-convergent or hybrid iterative solvers are used
% in the inner iterations, using one of the iterative methods in IRtools
% (e.g., IRhybrid_lsqr). In the case of IRirn, the 1-norm penalization
% is updated at each outer iteration.
%
% The regularization parameter and number of inner iterations influence
% the behavior and convergence of the outer iterations.
%
% With 'defaults' as input returns the default options.  Otherwise outputs
% the iterates specified in K, using max(K) as MaxIter, and using all other
% default options.  With options as input: uses the user-specified options
% and all the other default options.
%
% Inputs:
%  A : either (a) a full or sparse matrix
%             (b) a matrix object that performs the matrix*vector operation
%             (c) user-defined function handle
%  b : right-hand side vector
%  K : (optional) integer vector that specifies which (total) iterates are
%      returned in X; the maximum number of iterations is assumed to be max(K)
%      [ positive integer | vector of positive components ]
%  options : structure with the following fields (optional)
%      x0            - initial guess for the iterations; default = zero vector
%                      [ array | {'none'} ]
%      MaxIterIn     - maximum number of inner iterations
%      MaxIterOut    - maximum number of outer iterations
%      x_true        - true solution; allows us to returns error norms with
%                      respect to x_true at each iteration
%                      [ array | {'none'} ]
%      RegParam      - a value or a method to find the regularization used
%                      in the inner iterations:
%                      [ non-negative scalar | {'gcv'} | 'discrep' ]
%                      This also determines which stopping rule is used for
%                      the inner iterations.
%                      If 'gcv' is chosen, the inner iteration is stopped
%                        when the GCV function minimum stabilizes or increases
%                        within a certain window of iterations (see 'stopGCV',
%                        'FlatTol' and 'MinTol').
%                      If 'discrep' is chosen, and NoiseLevel is provided,
%                        then the discrepancy principle is used as stopping
%                        criterion (see 'NoiseLevel' and 'eta').
%      stopGCV       - stopping criterion for the inner iterations when
%                      GCV is used
%                      [ GCVvalues | {'resflat'} ]
%      FlatTol       - tolerance for detecting flatness (stabilization)
%                      in the GCV function as a stopping criterion for the
%                      inner iterations
%                      [ {10^-6} | non-negative scalar ]
%      MinTol        - window of iterations: if the GCV minimum continues
%                      to increase over this window, then the inner
%                      iterations are stopped
%                      [ {3} | positive integer ]
%      RegMatrix     - priorconditioner for the inner iterations
%                      [ {'identity'} | square nonsingular matrix |
%                        function handle ]
%      NoiseLevel    - norm of noise in rhs divided by norm of rhs (must be
%                      assigned if RegParam is 'discrep')
%                      [ {'none'} | nonnegative scalar ]
%      eta           - safety factor for the discrepancy principle
%                      [ {1.01} | scalar greater than (and close to) 1 ]
%      RegParam0     - first regularization parameter, used only on the
%                      very first iteration (needed if RegParam is 'discrep')
%                      [ {1} | positive scalar ]
%      stopOut       - stopping criterion for the outer iterations;
%                      [ {'xstab'} | 'Lxstab' | 'regPstab' ]
%      inSolver      - solver to be employed during the inner iterations
%                      [ 'gmres' | {'lsqr'} | 'fgmres' | 'cgls']
%      adaptConstr   - approximate constraint or regularization to be
%                      incorporated
%                      [ {'sp'} | 'spnn' | 'none' ]
%      nonnegativity - may be used to also impose nonnegativity
%                      (similarly to 'spnn')
%                      [ 'on' | {'off'} ]
%      IterBar       - shows the progress of the outer iterations
%                      [ {'on'} | 'off' ]
%      NoStopIn      - specifies whether the inner iterations should
%                      proceed after a stopping criterion has been satisfied
%                      [ 'on' | {'off'} ]
%      NoStopOut     - specifies whether the outer iterations should
%                      proceed after a stopping criterion has been satisfied
%                      [ 'on' | {'off'} ]
%      verbosity     - switch on or off the "verbosity" of the function
%                      [ {'on'} | 'off' ]
% Note: the options structure can be created using the function IRset.
%
% Outputs:
%   X : computed solutions, stored column-wise (at the iterations listed in K)
%   info: structure with the following fields:
%      its          - number of the last computed iteration
%      saved_iterations - iteration numbers of iterates stored in X
%      StopFlag_in  - string that describes the inner stopping condition:
%                       * Stopping criterion of the inner iterations is
%                         never satisfied
%                       * Stopping criterion is satisfied at least once
%                         during the inner iterations
%      StopFlag_out - string that describes the outer stopping condition;
%                     depending on the inputs it can be one of the following:
%                       * Outer stopping criterion is never satisfied
%                       * Diagonal weighting matrix is numerically zero
%                       * Solution stabilizes
%                       * Transformed solution stabilizes
%                       * Tegularization parameter stabilizes
%      Rnrm     - relative residual norms at each iteration
%      Xnrm     - solution norms at each iteration
%      Enrm     - relative error norms (requires x_true) at each iteration
%      Xout     - approximate solutions at the end of each inner cycle,
%                 stored column-wise
%      itsInOut - 3-column matrix whose the columns store
%                   1. outer iteration count
%                   2. inner iteration count (i.e., for each cycle)
%                   3. total iteration count
%      StopReg  - struct containing information about the solution that
%                 satisfies the stopping criterion.  Fields:
%                   It   : iteration where the stopping criterion is satisfied
%                   X    : solution satisfying the stopping criterion
%                   Enrm : the corresponding relative error (requires x_true)
%      BestReg  - struct containing information about the solution that
%                 minimizes Enrm (requires x_true). Fields:
%                   It   : iteration where the minimum is attained
%                   X    : best solution
%                   Enrm : best relative error
%
% See also: IRell1, IRhtv, IRhybrid_fgmres, IRrestart, IRget, IRset

% Silvia Gazzola, University of Bath
% Per Christian Hansen, Technical University of Denmark
% James G. Nagy, Emory University
% April, 2018.

% This file is part of the IR Tools package and is distributed under the
% 3-Clause BSD License. A separate license file should be provided as part
% of the package.

% Set default values for options.
defaultopt = struct('x0', 'none', 'MaxIterIn', 30 , 'MaxIterOut', 20 , ...
    'RegParam', 'gcv', 'stopGCV', 'resflat', ...
    'resflatTol', 0.05, 'GCVflatTol', 10^-6, 'GCVminTol', 3,...
    'x_true', 'none', 'IterBar', 'on', 'NoStop', 'off', 'NoStopIn', 'off',...
    'NoStopOut', 'off', 'stopOut', 'xstab', 'stabOut', 1e-6, 'thr0', 1e-10, ...
    'NoiseLevel', 'none', 'eta', 1.01, 'RegParam0', 1, 'inSolver', 'lsqr', ...
    'adaptConstr', 'sp', 'nonnegativity', 'off', 'verbosity', 'off',...
    'SparsityTrans', 'none', 'wname', 'db1', 'wlevels', 2, 'warmrestart', 'on');

% If input is 'defaults,' return the default options in X.
if nargin==1 && nargout <= 1 && isequal(A,'defaults')
    X = defaultopt;
    return;
end

% Check for acceptable number of optional input arguments.
switch length(varargin)
    case 0
        K = []; options = [];
    case 1
        if isa(varargin{1}, 'double')
            K = varargin{1}; options = [];
        else
            K = []; options = varargin{1};
        end
    case 2
        if isa(varargin{1}, 'double')
            K = varargin{1}; options = varargin{2};
        else
            K = varargin{2}; options = varargin{1};
        end
    otherwise
        error('Too many input parameters')
end

if isempty(options)
    options = defaultopt;
end

options = IRset(defaultopt, options);
nn       = IRget(options, 'nonnegativity', [], 'fast');
inSolver = IRget(options, 'inSolver',      [], 'fast');

if strcmp(nn, 'on')
    nn = 1;
    options.adaptConstr = 'spnn';
else
    nn = 0;
end

if strcmp(inSolver, 'fgmres') && ~nn
    warning(['With options.inSolver = ''fgmres'' and options.nonnegativity = ''off'' ',...
        'it is more appropriate to use IRhybrid_fgmeres than to use IRirn.'])
end

% Call IRrestart with the specified options.
% Note that nonnegativity is specified via options.adaptConstr.
options = rmfield(options, 'nonnegativity');
[X, info] = IRrestart(A, b, K, options);


% Gianni Schena  July 2005, schena@units.it
% Lattice Boltzmann LBE, geometry: D2Q9, model: BGK
% Application to permeability in porous media

Restart=false % to restart from an earlier convergence
logical(Restart);

if Restart==false;
close all, clear all % start from scratch and clean ...
Restart=false;
% type of channel geometry ;
% one of the flollowing flags == true
Pois_test=true, % no obstacles in the 2D channel
% porous systems
obs_regolare=false %
obs_irregolare=false %
tic
%   IN
% |vvvv|    + y
% |vvvv|     ^
% |vvvv|     | -> + x
%  OUT

% Pores in 2D : Wet and Dry locations (Wet ==1 , Dry ==0 )
wXh_Dry=[3,1];wXh_Wet=[3,4];

if obs_regolare, % with internal obstacles

A=repmat([zeros(wXh_Dry),ones(wXh_Wet)],[1,3]);A=[A,zeros(wXh_Dry)];
B=ones(size(A));
C=[A;B]  ; D=repmat(C,4,1);
D=[B;D]
end

if obs_irregolare, % with int obstacles
A1=repmat([zeros(wXh_Dry),ones(wXh_Wet)],[1,3]);
A1=[A1,zeros(wXh_Dry)]  ;
B=ones(size(A1));
C1=repmat([ones(wXh_Wet),zeros(wXh_Dry)],[1,3]); C1=[C1,ones(wXh_Dry)];
E=[A1;B;C1;B];
D=repmat(E,2,1);
D=[B;D]
end

if ~Pois_test
figure,imshow(D,[])
Channel2D=D;
Len_Channel_2D=size(Channel2D,1); % Length
Width=size(Channel2D,2); % should not be hod
Channel_2D_half_Width=Width/2,
end

% test without obstacles (i.e. 2D channel & no obstacles)

if Pois_test
%over-writes the definition of the pore space
clear Channel2D
Len_Channel_2D=36, % lunghezza canale 2d
Channel_2D_half_Width=8; Width=Channel_2D_half_Width*2;
Channel2D=ones(Len_Channel_2D,Width); % define wet area
%Channel2D(6:12,6:8)=0; % put fluid obstacle
imshow(Channel2D,[]);
end

[Nr Mc]=size(Channel2D); % Number rows and Munber columns

% porosity
porosity=nnz(Channel2D==1)/(Nr*Mc)

% FLUID PROPERTIES
% physical properties
cs2=1/3; %
cP_visco=0.5; % [cP] 1 CP Dinamic water viscosity 20 C
density=1.; % fluid density
Lky_visco=cP_visco/density; % lattice kinematic viscosity
omega=(Lky_visco/cs2+0.5).^-1; %  omega: relaxation frequency
%Lky_visco=cs2*(1/omega - 0.5) , % lattice kinematic viscosity
%dPdL= Pressure / dL;% External pressure gradient [atm/cm]

uy_fin_max=-0.2;
%dPdL = abs( 2*Lky_visco*uy_fin_max/(Channel_2D_half_Width.^2) );
dPdL=-0.0125;
uy_fin_max=dPdL*(Channel_2D_half_Width.^2)/(2*Lky_visco); % Poiseuille Gradient;
% max poiseuille final  velocity on the flow profile
uy0=-0.001; ux0=0.0001; %  linear vel .. inizialization

%
% uy_fin_max=-0.2; % max poiseuille final  velocity on the flow profile
% omega=0.5, cs2=1/3; % omega: relaxation frequency
% Lky_visco=cs2*(1/omega - 0.5) , % lattice kinematic viscosity
% dPdL = abs( 2*Lky_visco*uy_fin_max/(Channel_2D_half_Width.^2) ); % Poiseuille Gradient;
%

uyf_av=uy_fin_max*(2/3);; % average fluid velocity on the profile

x_profile=([-Channel_2D_half_Width:+Channel_2D_half_Width-1]+0.5);
uy_analy_profile=uy_fin_max.*(1-  ( x_profile /Channel_2D_half_Width).^2 ); % analytical velocity profile

av_vel_t=1.e+10; % inizialization (t=0)
%PixelSize= 5; % [Microns]
%dL=(Nr*PixelSize*1.0E-4); % sample hight [cm]

%
% EXPERIMENTAL SET-UP
% inlet and outlet buffers
inb=2, oub=2; % inlet and outlet buffers thickness
% add fluid at the inlet (top) and outlet (down)
inlet=ones(inb,Mc); outlet=ones(oub,Mc);
Channel2D=[ [inlet]; Channel2D ;[outlet] ] ; % add flux in and down (E to W)
[Nr Mc]=size(Channel2D); % update size
% boundaries related to the experimental set up
wb=2; % wall thickness
Channel2D=[zeros(Nr,wb), Channel2D , zeros(Nr,wb)]; % add walls (no fluid leak)
[Nr Mc]=size(Channel2D); % update size
uy_analy_profile=[zeros(1,wb), uy_analy_profile, zeros(1,wb) ] ; % take into account walls
x_pro_fig=[[x_profile(1)-[wb:-1:1]], [x_profile, [1:wb]+x_profile(end)] ];

% Figure plots analytical parabolic profile
figure(20), plot(x_pro_fig,uy_analy_profile,'-'), grid on,
title('Analytical parab. profile for Poiseuille planar flow in a channel')

% VISUALIZE PORE SPACE & FLUID OSTACLES & MEDIAL AXIS
figure, imshow(Channel2D); title('Vassel geometry');
Channel2D=logical(Channel2D);
% obstacles for Bounce Back ( in front of the grain)
Obstacles=bwperim(Channel2D,8); % perimeter of the grains for bounce back Bound.Cond.
border=logical(ones(Nr,Mc));
border([1:inb,Nr-oub:Nr],[wb+2:Mc-wb-1])=0;
Obstacles=Obstacles.*(border);
figure, imshow(Obstacles); title(' Fluid obstacles (in the fluid)' );
%
Medial_axis=bwmorph(Channel2D,'thin',Inf); %
figure, imshow(Medial_axis); title('Medial axis');
figure(10) % used to visualize evolution of rho
figure(11) % used to visualize ux
figure(12) % used to visualize uy (i.e. top -> down)

% INDICES
% Wet locations etc.
[iabw1 jabw1]=find(Channel2D==1); % indices i,j, of active lattice locations i.e. pore
lena=length(iabw1); % number of active location i.e. of pore space lattice cells
ija= (jabw1-1)*Nr+iabw1; % equivalent single index (i,j)->> ija for active locations
% absolute (single index) position of the obstacles in for bounce back in Channel2D
% Obstacles
[iobs jobs]=find(Obstacles);lenobs=length(iobs); ijobs= (jobs-1)*Nr+iobs; % as above
% Medial axis of the pore space
[ima jma]=find(Medial_axis); lenma=length(ima);  ijma= (jma-1)*Nr+ima; % as above
% Internal wet locations : wet & ~obstables
% (i.e. internal wet lattice location non in contact with dray locations)
[iawint jawint]=find(( Channel2D==1 & ~Obstacles)); % indices i,j, of active lattice locations
lenwint=length(iawint); % number of internal (i.e. not border) wet locations
ijaint= (jawint-1)*Nr+iawint; % equivalent singl
NxM=Nr*Mc;

% DIRECTIONS: E N W S NE NW SW SE ZERO (ZERO:Rest Particle)
%    y^
%  6 2 5           ^         NW  N  NE
%  3 9 1 ... +x-> +y         W   RP  E
%  7 4 8                     SW  S  SE
%   -y
% x & y components of velocities , +x is to est , +y is to nord
East=1; North=2; West=3; South=4; NE=5; NW=6; SW=7; SE=8; RP=9;
N_c=9 ; % number of directions
% versors D2Q9
C_x=[1 0 -1  0 1 -1 -1  1 0];
C_y=[0 1  0 -1 1  1 -1 -1 0]; C=[C_x;C_y]

% BOUNCE BACK SCHEME
% after collision the fluid elements densities f are sent back to the
% lattice node they come from with opposite direction
% indices opposite to 1:8 for fast inversion after bounce
ic_op = [3 4 1 2 7 8 5 6]; %   i.e. 4 is opposite to 2 etc.

% PERIODIC BOUNDARY CONDITIONS - reinjection rules
yi2=[Nr , 1:Nr , 1]; % this definition allows implemening Period Bound Cond
%yi2=[1, Nr , 2:Nr-1 , 1,Nr]; % re-inj the second last to as first
% directional weights (density weights)
w0=16/36. ; w1=4/36. ; w2=1/36.;
W=[ w1 w1 w1 w1 w2 w2 w2 w2 w0];
%c constants (sound speed related)
cs2=1/3; cs2x2=2*cs2; cs4x2=2*cs2.^2;
f1=1/cs2; f2=1/cs2x2; f3=1/cs4x2;
f1=3., f2=4.5; f3=1.5; % coef. of the f equil.

% declarative statemets
f=zeros(Nr,Mc,N_c); % array of fluid density distribution
feq=zeros(Nr,Mc,N_c); % f at equilibrium
rho=ones(Nr,Mc); % macro-scopic density
temp1=zeros(Nr,Mc);
ux=zeros(Nr,Mc);   uy=zeros(Nr,Mc); uyout=zeros(Nr,Mc);  % dimensionless velocities
uxsq=zeros(Nr,Mc); uysq=zeros(Nr,Mc);   usq=zeros(Nr,Mc);  % higher degree velocities

% initialization arrays : start values in the wet area
for ia=1:lena % stat values in the active cells only ; 0 outside
    i=iabw1(ia);  j=jabw1(ia);
    f(i,j,:)=1/9; % uniform density distribution for a start
end
uy(ija)=uy0; ux(ija)=ux0; % initialize fluid velocities
rho(ija)=density;

% EXTERNAL (Body) FORCES e.g. inlet pressure or inlet-outlet gradient
% directions: E N W S NE NW SW SE ZERO
force = -dPdL*(1/6)*1*[0 -1 0 1 -1 -1 1  1  0]'; %;
%...                   E  N E S NE NW SW SE RP ...
% the pressure pushes the fluid down i.e. N to S

% While .. MAIN TIME EVOLUTION LOOP
StopFlag=false; % i.e. logical(0)
Max_Iter=3000; % max allowed number of iteration
Check_Iter=1; Output_Every=20; % frequency of check & output
Cur_Iter=0; % current iteration counter inizialization
toler=1.0e-8; % tollerance to declare convegence
Cond_path=[]; % recording values of the convergence criterium
density_path=[]; % recording aver. density values for convergence
end % ends if restart

if(Restart==true)
 StopFlag=false;  Max_Iter=Max_Iter+3000; toler=1.0e-12;
end

while(~StopFlag)
    Cur_Iter=Cur_Iter+1 % iteration counter update

    % density and moments
    rho=sum(f,3); % density

    if Cur_Iter >1 % use inizialization ux uy to start
        % Moments ... Note:C_x(9)=C_y(9)=0
        ux=zeros(Nr,Mc); uy=zeros(Nr,Mc);
        for ic=1:N_c-1;
            ux = ux + C_x(ic).*f(:,:,ic) ; uy = uy + C_y(ic).*f(:,:,ic)  ;
        end
       % uy=f(:,:,2) +f(:,:,5)+f(:,:,6)-f(:,:,4)-f(:,:,7)-f(:,:,8); % in short !
       % ux=f(:,:,1) +f(:,:,5)+f(:,:,8)-f(:,:,3)-f(:,:,6)-f(:,:,7); % in short !
    end

    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    ux(ija)=ux(ija)./rho(ija); uy(ija)=uy(ija)./rho(ija);
    uxsq(ija)=ux(ija).^2; uysq(ija)=uy(ija).^2;
    usq(ija)=uxsq(ija)+uysq(ija); %

    % weighted densities : rest particle, principal axis, diagonals
    rt0 = w0.*rho; rt1 = w1.*rho; rt2 = w2.*rho;

    % Equilibrium distribution
    % main  directions ( + cross)
    feq(ija)= rt1(ija) .*(1 +f1*ux(ija) +f2*uxsq(ija) -f3*usq(ija));
    feq(ija+NxM*(2-1))= rt1(ija) .*(1 +f1*uy(ija) +f2*uysq(ija) -f3*usq(ija));
    feq(ija+NxM*(3-1))= rt1(ija) .*(1 -f1*ux(ija) +f2*uxsq(ija) -f3*usq(ija));
    %feq(ija+NxM*(3)=f(ija)-2*rt1(ija)*f1.*ux(ija); % much faster... !!
    feq(ija+NxM*(4-1))= rt1(ija) .*(1 -f1*uy(ija) +f2*uysq(ija) -f3*usq(ija));

    % diagonals (X diagonals) (ic-1)
    feq(ija+NxM*(5-1))= rt2(ija) .*(1 +f1*(+ux(ija)+uy(ija)) +f2*(+ux(ija)+uy(ija)).^2 -f3.*usq(ija));
    feq(ija+NxM*(6-1))= rt2(ija) .*(1 +f1*(-ux(ija)+uy(ija)) +f2*(-ux(ija)+uy(ija)).^2 -f3.*usq(ija));
    feq(ija+NxM*(7-1))= rt2(ija) .*(1 +f1*(-ux(ija)-uy(ija)) +f2*(-ux(ija)-uy(ija)).^2 -f3.*usq(ija));
    feq(ija+NxM*(8-1))= rt2(ija) .*(1 +f1*(+ux(ija)-uy(ija)) +f2*(+ux(ija)-uy(ija)).^2 -f3.*usq(ija));
    % rest particle (.) ic=9
    feq(ija+NxM*(9-1))= rt0(ija) .*(1 - f3*usq(ija));

    %Collision (between fluid elements)omega=relaxation frequency
    f=(1.-omega).*f + omega.*feq;

    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    %add external body force due to the pressure gradient prop. to dPdL
    for ic=1:N_c;%-1
        for ia=1:lena
            i=iabw1(ia);  j=jabw1(ia);
            % if Obstacles(i,j)==0 % the i,j is not aderent to the boundaries
            % if ( f(i,j,ic) + force(ic) ) >0; %! avoid negative distributions
            %i=1 ;% force only on the first row !
            f(i,j,ic)= f(i,j,ic) + force(ic);
            % end
            % end
        end
    end

    % % STREAM
    % Forward Propagation step & % Bounce Back (collision fluid with obstacles)
    %f(:,:,9) = f(:,:,9); % Rest element do not move

    feq = f; % temp storage of f in feq
        for ic=1:1:N_c-1, % select velocity layer

        ic2=ic_op(ic); % selects the layer of the velocity opposite to ic for BB
        temp1=feq(:,:,ic); %

        % from wet location that are NOT on the border to other wet locations
        for ia=1:1:lenwint % number of internal (i.e. not border) wet locations
            i=iawint(ia);  j=jawint(ia);  % so that we care for the wet space only !
            i2 = i+C_y(ic); j2 = j+C_x(ic); % Expected final locations to move
            i2=yi2(i2+1); % i2 corrected for PBC when necessary (flow out re-fed to inlet)
            % i.e the new position (i2,j2) is sure another wet location
            % therefore normal propagation from (i,j) to (i2,j2) on layer ic
            f(i2,j2,ic)=temp1(i,j); % see circshift(..) fnct for circularly shifts
        end ; % i and j single loop

        % from wet locations that ARE on the border of obstacles
        for ia=1:1:lenobs % wet border locations
            i=iobs(ia);  j=jobs(ia);  % so that we care for the wet space only !
            i2 = i+C_y(ic); j2 = j+C_x(ic); % Expected final locations to move
            i2=yi2(i2+1); % i2 corrected for PBC

            if( Channel2D(i2,j2) ==0 ) % i.e the new position (i2,j2) is dry
                f(i,j,ic2) =temp1(i,j); % invert direction: bounce-back in the opposite direction ic2
            else % otherwise, normal propagation from (i,j) to (i2,j2) on layer ic
                f(i2,j2,ic)=temp1(i,j); % see circshift(..) fnct for circularly shifts
            end ; % b.b. and propagations

        end ; % i and j single loop
        % special treatment for Corners
        %   f(1,wb+1,ic)=temp1(Nr,Mc-wb);      f(1,Mc-wb,ic)=temp1(Nr,wb+1);
        %   f(Nr,wb+1,ic)=temp1(1,Mc-wb);      f(Nr,Mc-wb,ic)=temp1(1,wb+1);

    end ; %  for ic direction

    % ends of Forward Propagation step &  Bounce Back Sections

    % re-calculate  uy as uyout for convergence
    rho=sum(f,3); % density
    % check velocity
    uyout= zeros(Nr,Mc);
    for ic=1:N_c-1;
        uyout= uyout + C_y(ic).*f(:,:,ic) ; % flow dim.less velocity out
    end
   % uyout(ija)=uyout(ija)./rho(ija); % from momentum to velocity

    % Convergence check on velocity values
    if (mod(Cur_Iter,Check_Iter)==0) ; % check for convergence every 'Check_Iter' iterations

        % variables monitored
        % mean density and
        vect=rho(ija); vect=vect(:);
        cur_density=mean(vect);
        % mean 'interstitial' velocity
        % uy(ija)=uy(ija)/rho(ija); ?
        vect=uy(ija); av_vel_int= mean(vect)  ; % seepage velocity (in the wet area)
        % on the whole cross-sectional area of flow (wet + dry)
        av_vel_int=av_vel_int*porosity, % av. vel. on the wet + dry area
        %av_vel_int=mean2(uy),
        av_vel_tp1 = av_vel_int;
        Condition=abs( abs(av_vel_t/av_vel_tp1 )-1), % should --> 0

        Cond_path=[Cond_path, Condition]; % records the convergence path (value)
        density_path=[density_path, cur_density];
        %
        av_vel_t=av_vel_tp1; % time t & t+1

        if (Condition < toler) | (Cur_Iter > Max_Iter)
            StopFlag=true;
            display( 'Stop iteration: Convergence met or iteration exeeding the max allowed' )
            display( ['Current iteration: ',num2str(Cur_Iter),...
                ' Max Number of iter: ',num2str(Max_Iter)] )
            break % Terminate execution of WHILE .. exit the time evolution loop.

        end    % if(Condition < toler

    end

    if (mod(Cur_Iter,Output_Every)==0) ;  % Output from loop every ...
        %if (Cur_Iter>60) ;  % Output from loop every ...

        rho=sum(f,3); % density
        figure(10); imshow(rho,[0.1 0.9]); title(' rho'); % visualize density evolution
        figure(11); imshow(ux,[ ]); title(' ux' ); % visualize fluid velocity horizontal
        figure(12); imshow(-uy,[ ]); title(' uy' ); % visualize fluid velocity down
        figure(14), imshow(-uyout,[]), title('uyout'); % vis vel flow out
        up=2; % linear section to visualize up from the lower row
        figure(15), hold off, feather(ux(Nr-up,:),uy(Nr-up,:)),
        figure(15), hold on , plot(uy_analy_profile,'r-')
        title('Analytical vs LB calculated, fluid velocity parabolic profile')
        pause(3); % time given to visualize properly

    end % every

   % pause(1);

end %  End main time Evolution Loop

% Output & Draw after the end of the time evolution

figure, plot(Cond_path(2:end)); title('convergence path')
%figure, plot(density_path(2:end)); title('density convergence path')
figure, plot( [uy(Nr-up,:)-uy_analy_profile] ); title('difference : LB - Analytical solution')

toc

% Permeability K

K_Darcy_Porous_Sys= (av_vel_int*porosity)/dPdL*Lky_visco ,

K_Analy_2D_Channel=(Width^2)/12


%MEDIANBLUR  Blurs an image using the median filter
%
%     dst = cv.medianBlur(src)
%     dst = cv.medianBlur(src, 'OptionName',optionValue, ...)
%
% ## Input
% * __src__ Input 1-, 3-, or 4-channel image. When `KSize` is 3 or 5, the
%   image type should be `uint8`, `uint16`, or `single`. For larger aperture
%   sizes, it can only be `uint8`.
%
% ## Output
% * __dst__ Destination array of the same size and type as `src`.
%
% ## Options
% * __KSize__ Aperture linear size. It must be odd and greater than 1, for
%   example 3, 5, 7 ... default 5
%
% The function smooths an image using the median filter with the
% `KSize x KSize` aperture. Each channel of a multi-channel image is
% processed independently.
%
% Note: The median filter uses `BorderType=Replicate` internally to cope with
% border pixels. See cv.copyMakeBorder.
%
% See also: cv.bilateralFilter, cv.blur, cv.boxFilter, cv.GaussianBlur,
%  medfilt2
%


function plotpoint(i,x1,y1,Color)

%x1=[source dest]--in x axis
%y1=[source dest]--in y axis

   %Color='r';
  % N=1000;

    if abs(x1(1)-x1(2))>=abs(y1(1)-y1(2))

     if x1(1)<=x1(2)
        %x=x1(1):x1(2);
        x=x1(1)+i;
        p=1;
     else
        %x=x1(1):-1:x1(2);
        x=x1(1)-i;
        p=0;
     end
             if ((p==1 && x<=x1(2)) || (p==0 && x>=x1(2)))

                %%
                Radius=i;%sqrt((abs(i))^2 + (abs(i))^2);
                plotcircle(x1(1),y1(1),Radius,Color)
                %%

                y=(((x-x1(1))./((x1(2)-x1(1)))).*((y1(2)-y1(1))))+y1(1);

                plot(x,y,'.','LineWidth',1,...
                    'MarkerEdgeColor','k',...
                    'MarkerFaceColor','y',...
                    'MarkerSize',8);
                hold on

             %   plot(x1,y1,'^r')

             end
    else

      if y1(1)<=y1(2)
        %x=x1(1):x1(2);
        y=y1(1)+i;
        p=1;
      else
        %x=x1(1):-1:x1(2);
        y=y1(1)-i;
        p=0;
      end

          if ((p==1 && y<=y1(2)) || (p==0 && y>=y1(2)))
                x=(((y-y1(1))./((y1(2)-y1(1)))).*((x1(2)-x1(1))))+x1(1);

                %%
                Radius=i;%sqrt((abs(i))^2 + (abs(i))^2);
                plotcircle(x1(1),y1(1),Radius,Color)

                %%
                plot(x,y,'.','LineWidth',1,...
                    'MarkerEdgeColor','k',...
                    'MarkerFaceColor','y',...
                    'MarkerSize',8);
                hold on

              %  plot(x1,y1,'^r')

          end
    end

end