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

Restart=false
logical(Restart);

if Restart==false;
close all, clear all % start from scratch and clean ...
Restart=false;
Pois_test=false, % for a test without obstacles
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,5];
%wXh_Dry=[3,0];wXh_Wet=[3,5]; % test non 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,3,1);
D=[B;B;D;B];
imshow(D,[]) ; % monitor the pore space
Channel2D=D;
Len_Channel_2D=size(Channel2D,1); % Length
Width=size(Channel2D,2); % should not be hod
Channel_2D_half_Width=Width/2,

% 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=18,
Channel_2D_half_Width=4; 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

% 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.
Obstacles([1:inb,Nr-oub:Nr],[wb+2:Mc-wb-1])=0;

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)

% porosity
porosity=nnz(Channel2D==1)/(Nr*Mc)% porosity
porosity=nnz(Channel2D( :,[(wb+1):(Mc-wb)] )==1)./(Nr*(Mc-2*wb))
% exclude the wall from counting

% 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;

% Look-up table for direct acess to the position of the ija in a wet only
% array , i.e. from a i,j position in an array (full) to the index in an arry of wet
% positions only, eg the position 5 is the 3 because 2 pixels are dry

%ija =[2 3 5 9 13]; % wet positions
Lut(:,1)=[1:1:ija(end)]'; Lut(ija,2)=[1:1:length(ija)];
% Lut use ijac=9
% from current ija (dry & wet ) to its position in an array of only wet
% Lut(ijac,2) ... % alternative find(ija==ijac)

% 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(lena,N_c); % array of fluid density distribution
feq=zeros(lena,N_c); % f at equilibrium
rho=ones(lena,1); % macro-scopic density
temp1=zeros(lena,1);
ux=zeros(lena,1);   uy=zeros(lena,1); uyout=zeros(lena,1);  % dimensionless velocities
uxsq=zeros(lena,1); uysq=zeros(lena,1);   usq=zeros(lena,1);  % higher degree velocities
% for normal 2d visualization
uy1=zeros(Nr,Mc);  ux1=zeros(Nr,Mc);

% initialization arrays : start values in the wet area
for ia=1:lena % stat values in the active cells only ; 0 outside
    f(ia,:)=1/9; % uniform density distribution for a start
end
uy(:)=uy0; ux(:)=ux0; % initialize fluid velocities
rho(:)=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=8; % 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,2); % density

    if Cur_Iter >1 % use inizialization ux uy to start
        % Moments ... Note:C_x(9)=C_y(9)=0
       % ux=zeros(lena,1); uy=zeros(lena,1);
        %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(:)=ux(:)./rho(:); uy(:)=uy(:)./rho(:);
    uxsq(:)=ux(:).^2; uysq(:)=uy(:).^2; usq(:)=uxsq(:)+uysq(:); %

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

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

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

    %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
            f(:,ic)= f(:,ic) + force(ic);
            % 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
        C_yic = C_y(ic); C_xic = C_x(ic);
        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_yic; j2 = j+C_xic; % 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)==ia2 is sure another wet location
            % therefore normal propagation from (i,j)==ijaint to (i2,j2)==ia2 on layer ic
            ia2=(j2-1)*Nr+i2; iarec2=Lut(ia2,2) ; % use lut (look up table)
            iarec1=Lut(ijaint(ia),2) ;
            f(iarec2,ic)=temp1(iarec1); % copy
        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_yic; j2 = j+C_xic; % Expected final locations to move
            i2=yi2(i2+1); % i2 corrected for PBC
            iarec1=Lut(ijobs(ia),2) ;
            if( Channel2D(i2,j2) ==0 ) % i.e the new position (i2,j2) is dry
               f(iarec1,ic2) =temp1(iarec1); % invert direction: bounce-back in the opposite direction ic2
            else % otherwise, normal propagation from (i,j) to (i2,j2) on layer ic
               ia2=(j2-1)*Nr+i2; iarec2=Lut(ia2,2) ;
               f(iarec2,ic)=temp1(iarec1); %
            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,2); % density
    % check velocity
%     uyout= zeros(lena,1);
%     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(:); vect=vect(:);
        cur_density=mean(vect);
        % mean 'interstitial' velocity
        % uy(ija)=uy(ija)/rho(ija); ?
        vect=uy(:); 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,2); % density
       % figure(10); imshow(rho,[0.1 0.9]); title(' rho'); % visualize density evolution
        uy1(ija)=uy;  ux1(ija)=ux;
        %figure(11); imshow(ux1,[ ]); title(' ux' ); % visualize fluid velocity horizontal
        %figure(12); imshow(-uy1,[ ]); 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(ux1(Nr-up,:),uy1(Nr-up,:)),
        figure(15), hold on , plot(uy_analy_profile,'r-')
        title('Analytical (i.e. no obstacles) vs LB calculated (Blue), fluid velocity profile')
        pause(1); % 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( [uy1(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


function [ft3] = l2ft3(l)
% Convert volume from liters to cubic feet.
% Chad Greene 2012
ft3 = l*0.035314666721;


function err = getL2error3RT0(node,elem,sigma,sigmah,markedElem)
%% GETL2ERROR3RT0  L2 norm of RT0 element in 3D.
%
%  err = getL2error3RT0(node,elem,sigma,sigmah,markedElem)
%
%  The input sigma can just be a function boundle. sigmah is the flux
%  through faces. markedElem is used to compute the error in certain region
%  only.
%
%  Note that the ascend ordering of elem is used.
%
% Example
%
%   [node,elem] = cubemesh([-1,1,-1,1,-1,1],1);
%   maxIt = 3;
%   pde = mixBCdata3;
%   err = zeros(maxIt,1);
%   h = zeros(maxIt,1);
%   for i = 1:maxIt
%      [node,elem] = uniformrefine3(node,elem);
%      uI = faceinterpolate3(pde.Du,node,elem);
%      err(i) = getL2error3RT0(node,elem,pde.Du,uI);
%      h(i) = 2^(-i);
%   end
%   figure;
%   showrateh(h,err,2,'-+','|| u - u_I ||');
%
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

%% Construct Data Structure
elem = sortelem3(elem);
elem2face = dof3face(elem);
% [elem2face,dofSign] = dof3RT0(elem);
NT = size(elem,1);% Ndof = max(elem2dof(:)); %N = size(node,1);
[Dlambda,volume] = gradbasis3(node,elem);
locFace = [2 3 4; 1 3 4; 1 2 4; 1 2 3];

%% Compute square of the L2 error element-wise
[lambda,w] = quadpts3(3); % quadrature order is 3
nQuad = size(lambda,1);
err = zeros(NT,1);
for p = 1:nQuad
    % quadrature points in the x-y-z coordinate
    pxyz = lambda(p,1)*node(elem(:,1),:) ...
         + lambda(p,2)*node(elem(:,2),:) ...
         + lambda(p,3)*node(elem(:,3),:) ...
         + lambda(p,4)*node(elem(:,4),:);
    sigmap = sigma(pxyz);
    sigmahp = zeros(NT,3);
    for l = 1:4 % for each basis
        i = locFace(l,1); j = locFace(l,2); k = locFace(l,3);
        % phi_l = 2(lambda_i Dlambda_j x Dlambda_k +
        %           lambda_j Dlambda_k x Dlambda_i +
        %           lambda_k Dlambda_i x Dlambda_j)
        sigmahp = sigmahp + repmat(2*sigmah(elem2face(:,l)),1,3).*...
                   (lambda(p,i)*mycross(Dlambda(:,:,j),Dlambda(:,:,k)) + ...
                    lambda(p,j)*mycross(Dlambda(:,:,k),Dlambda(:,:,i)) + ...
                    lambda(p,k)*mycross(Dlambda(:,:,i),Dlambda(:,:,j)));
    end
    err = err + w(p)*sum((sigmap - sigmahp).^2,2);
end
err = err.*volume;
% modify the error
err(isnan(err)) = 0;
if (nargin == 5) && ~isempty(markedElem)
    err = err(markedElem); % L2 err on some marked region
end
err = sqrt(sum(err));


function T = tprod1(S, U, n)
%TPROD1 Tensor Product of a tensor and a matrix
%	T = TPROD1(S, U, n)
%
%	S  - tensor (multidimensional array)
%	U  - matrix compatible with the nth size of S ie. size(S,n)==size(U,1)
%	n  - execute tprod in this dimension
%
%	T  - result of the product
%
%	eg. tprod1(ones(2,3,4), [1 0 0; 0 1 0], 2)
%
%	See also TPROD.

% TODO: n > dimensions of S -> ndim_expand

siz = size(S);
siz(n) = size(U,1);
H = ndim_unfold(S, n);
T = ndim_fold(U*H, n, siz);


function [phw,stat]=model_phw(time,sat,type,opt,rs,rr,vs,phw0)

stat=1; ds=zeros(1,3); dr=zeros(1,3);
if opt==0,phw=phw0;stat=0;return;end

%satellite yaw attitude model
[exs,eys]=sat_yaw(time,sat,type,opt,rs,vs);

%unit vector satellite to receiver
r=rr-rs;
ek=r/norm(r);

%unit vectors of receiver antenna
[~,E]=xyz2blh(rr);
exr(1)= E(2); exr(2)= E(5); exr(3)= E(8); %x = north
eyr(1)=-E(1); eyr(2)=-E(4); eyr(3)=-E(7); %y = west

%phase windup effect
eks=cross(ek,eys);
ekr=cross(ek,eyr);
for i=1:3
    ds(i)=exs(i)-ek(i)*dot(ek,exs')-eks(i);
    dr(i)=exr(i)-ek(i)*dot(ek,exr')+ekr(i);
end
cosp=dot(ds,dr)/norm(ds)/norm(dr);
if cosp<-1
    cosp=-1;
elseif cosp>1
    cosp=1;
end

ph=acos(cosp)/2/pi;
drs=cross(ds,dr);
tmp=dot(ek,drs);
if tmp<0
    ph=-ph;
end
phw=ph+floor(phw0-ph+0.5);

return


% data1: sea-water Pc
% Written by Ali A. Eftekhari
% Last checked: June 2021
data{1}=[0.073 249
0.085 45
0.09 15
0.131 8
0.197 3.33
0.23 2.22
0.25 1.79
0.328 0.6
0.38 0
0.5 -0.1
0.6 -0.3
0.7 -0.7
0.8 -2.5
0.831 -5.8
0.84 -10
0.856 -20
0.863 -32.2
0.867 -43
0.869 -49.1
0.87 -54.3
0.882 -92.8
0.893 -126.9
0.895 -142.5
0.899 -167.7
0.901 -250];
% zero sulphate Pc, table 3
data{2}=[0.056 200
0.058 36.9
0.073 9.3
0.112 5.06
0.137 3.56
0.176 1.46
0.232 0.5
0.28 0
0.503 -0.8
0.606 -1.13
0.698 -2
0.768 -3
0.793 -4
0.81 -5
0.827 -13
0.84 -31.4
0.857 -79.3];
% JCR library for cretaceous chalk
data{3}=[0.079 0.1
0.1 0.02
0.3 0.015
0.54 0.0
0.68 -0.4
0.747 -0.7];
% fit model to data
pc1=data{3}(:,2)*1e5; % Pa
sw1=data{3}(:,1);
sw_plot=linspace(min(sw1),max(sw1),5000);
% pc_plot=interp1(sw, pc, sw_plot, 'linear', 'extrap');
% plot(sw, pc, 'o', sw_plot, pc_plot)
% plot(diff(pc_plot)./diff(sw_plot))
% log(pc)=log(pce)-(1/labda)*log((sw-sw0)/(1-sw0-sor))
% ind0=find(pc==0, 1);
% p1=polyfit(sw(1:ind0-1), log(pc(1:ind0-1)), 1)
% plot(sw(1:ind0-1), log(pc(1:ind0-1)), 'o')

pc=@(sw, cwi, coi, awi, aoi, swc, sor)(cwi./((sw-swc)/(1-swc)).^awi+coi./((1-sw-sor)/(1-sor)).^aoi);
swc0=0.0789;
sor0=0.2529;
labda=2.4;
f=@(x, sw)pc(sw, x(1), x(2), 1/labda, 1/labda, swc0, sor0);
fw=@(x, sw)pc(sw, x(1), 0.0 , x(3), x(4), swc0, sor0);
fo=@(x, sw)pc(sw, 0.0, x(2), x(3), x(4), swc0, sor0);
x=lsqcurvefit(f, [1e3, -1e3],sw1, pc1)
x=patternsearch(@(x)(sum(abs(f(x, sw1)-pc1))), x)
plot(sw1, pc1, 'o', sw_plot, f(x, sw_plot))%, ...
% sw_plot, fw(x, sw_plot), '--', ...
% sw_plot, fo(x, sw_plot), '-.');
grid;


function [logp,logq1,logq2] = spm_mci_switch (Pr,M,U,Y,beta)
% Return log probability of tempered model switch
% FORMAT [logp,logq1,logq2] = spm_mci_switch (Pr,M,U,Y,beta)
%
% Pr        parameters (vectorised and in M.V subspace)
% M,U,Y     as usual
% beta      inverse temperature (set to 1 to get usual posterior)
%
% logp      log prob of model switch
% logq1     log joint of model 1
% logq2     log joint of model 2
%__________________________________________________________________________
% Copyright (C) 2015 Wellcome Trust Centre for Neuroimaging

% Will Penny
% $Id: spm_mci_switch.m 6548 2015-09-11 12:39:47Z will $

logq1 = spm_mci_joint(Pr,M{1},U{1},Y);

% Parameters in original space
P = M{1}.V*Pr+M{1}.vpE;
[L2,tmp,st] = feval(M{2}.L,P,M{2},U{2},Y);
e = P-M{2}.vpE;
L1 = - e'*M{2}.ipC*e/2 + M{2}.log_prior_t2;
logq2 = L1+L2;

logp=(1-beta)*logq1+beta*logq2;


%  Figure 3.16      Feedback Control of Dynamic Systems, 6e
%                        Franklin, Powell, Emami
% script to generate Fig. 3.16
%  fig3_14.m
%  Example 3.23
clf;
num=[2 1];
den=[1 3 2];
t=0:0.1:6;
y=impulse(num,den,t);
plot(t,y,'-')
grid
title('Fig. 3.16  Example 3.23 system impulse response.')
xlabel('Time (sec)')
ylabel('h(t)')
% grid
nicegrid


function A = frand (n,nel,s)
% A = frand (n,nel,s) creates an n-by-n sparse matrix consisting of nel finite
% elements, each of which are of size s-by-s with random symmetric nonzero
% pattern, plus the identity matrix.
%
% Example:
%   A = frand (100, 100, 4) ; cspy (A)
% See also: cs_demo

%   Copyright 2006-2007, Timothy A. Davis.
%   http://www.cise.ufl.edu/research/sparse
ss = s^2 ;
nz = nel*ss ;
ii = zeros (nz,1) ;
jj = zeros (nz,1) ;
xx = zeros (nz,1) ;
k = 1 ;
for e = 1:nel
    i = 1 + fix (n * rand (s,1)) ;
    i = repmat (i, 1, s) ;
    j = i' ;
    x = rand (s,s) ;
    ii (k:k+ss-1) = i (:) ;
    jj (k:k+ss-1) = j (:) ;
    xx (k:k+ss-1) = x (:) ;
    k = k + ss ;
end
A = sparse (ii,jj,xx,n,n) + speye (n) ;


function [bar] = Torr2bar(Torr)
% Convert pressure from torr (same as mmHg) to bar
% Chad Greene 2012
bar = Torr*0.00133322;


function r8col_sorted_tol_undex_test ( )

%*****************************************************************************80
%
%% R8COL_SORTED_TOL_UNDEX_TEST tests R8COL_SORTED_TOL_UNDEX.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    17 July 2010
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'R8COL_SORTED_TOL_UNDEX_TEST\n' );
  fprintf ( 1, '  R8COL_SORTED_TOL_UNDEX produces index vectors which \n' );
  fprintf ( 1, '  create a sorted list of the tolerably unique columns of \n' );
  fprintf ( 1, '  a sorted R8COL and a map from the original R8COL to the \n' );
  fprintf ( 1, '  (implicit) R8COL of sorted tolerably unique elements.\n' );

  m = 3;
  n = 22;

  a = [ ...
    1.9,  0.0, 10.0; ...
    2.0,  6.0, 10.0; ...
    4.0,  8.0, 12.0; ...
    1.0,  5.0,  9.0; ...
    3.0,  7.0, 11.0; ...
    2.0,  6.0,  0.0; ...
    2.0,  0.0, 10.1; ...
    2.0,  0.1, 10.0; ...
    3.0,  4.0, 18.0; ...
    1.9,  8.0, 10.0; ...
    0.0,  0.0,  0.0; ...
    0.0,  6.0, 10.0; ...
    2.1,  0.0, 10.0; ...
    2.0,  6.0, 10.0; ...
    3.0,  7.0, 11.0; ...
    2.0,  0.0, 10.0; ...
    2.0,  0.0, 10.0; ...
    2.0,  6.0, 10.0; ...
    1.0,  5.0,  9.0; ...
    2.0,  0.0, 10.1; ...
    1.0,  5.0,  9.1; ...
    1.0,  5.1,  9.0 ]';

  r8mat_transpose_print ( m, n, a, '  The unsorted R8COL (transposed):' );

  a = r8col_sort_heap_a ( m, n, a );

  r8mat_transpose_print ( m, n, a, '  The sorted R8COL (transposed):' );

  tol = 0.25;
  n_unique = r8col_sorted_tol_unique_count ( m, n, a, tol );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Tolerance for equality is %e\n', tol );
  fprintf ( 1, '  Number of unique entries in X is %d\n', n_unique );

  [ undx, xdnu ] = r8col_sorted_tol_undex ( m, n, a, n_unique, tol );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  XDNU points to the representative for each item.\n' );
  fprintf ( 1, '  UNDX selects the representatives..\n' );
  fprintf ( 1, '\n' );

  for i = 1 : n_unique
    fprintf ( 1, '  %4d  %4d  %4d\n', i, xdnu(i), undx(i) );
  end
  for i = n_unique + 1 : n
    fprintf ( 1, '  %4d  %4d\n', i, xdnu(i) );
  end

  for j = 1 : n_unique
    au(1:m,j) = a(1:m,undx(j));
  end

  r8mat_transpose_print ( m, n_unique, au, ...
    '  The tolerably unique R8COL (transposed):' );

  return
end


function b = r8gb_mxv ( m, n, ml, mu, a, x )

%*****************************************************************************80
%
%% R8GB_MXV multiplies a R8GB matrix times a vector.
%
%  Discussion:
%
%    An M by N banded matrix A with lower bandwidth ML and upper bandwidth MU
%    is assumed to be entirely zero, except for the main diagonal, and
%    entries in the ML nearest subdiagonals, and MU nearest superdiagonals.
%
%    LINPACK and LAPACK "R8GB" storage for such a matrix generally includes
%    room for ML extra superdiagonals, which may be required to store
%    nonzero entries generated during Gaussian elimination.
%
%    The original M by N matrix is "collapsed" downward, so that diagonals
%    become rows of the storage array, while columns are preserved.  The
%    collapsed array is logically 2*ML+MU+1 by N.
%
%    LINPACK and LAPACK storage of general band matrices requires
%    an extra ML upper diagonals for possible fill in entries during
%    Gauss elimination.  This routine does not access any entries
%    in the fill in diagonals, because it assumes that the matrix
%    has NOT had Gauss elimination applied to it.  If the matrix
%    has been Gauss eliminated, then the routine R8GB_MU must be
%    used instead.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 November 2003
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Dongarra, Bunch, Moler, Stewart,
%    LINPACK User's Guide,
%    SIAM, 1979.
%
%  Parameters:
%
%    Input, integer M, the number of rows of the matrix.
%    M must be positive.
%
%    Input, integer N, the number of columns of the matrix.
%    N must be positive.
%
%    Input, integer ML, MU, the lower and upper bandwidths.
%    ML and MU must be nonnegative, and no greater than min(M,N)-1.
%
%    Input, real A(2*ML+MU+1,N), the R8GB matrix.
%
%    Input, real X(N), the vector to be multiplied by A.
%
%    Output, real B(M), the product A * x.
%
  b(1:m) = 0.0;

  for i = 1 : m
    jlo = max ( 1, i - ml );
    jhi = min ( n, i + mu );
    for j = jlo : jhi
      b(i) = b(i) + a(i-j+ml+mu+1,j) * x(j);
    end
  end

  return
end


function s = resampwor(p,m,n)
%RESAMWOR Random resampling without replacement
%
%   Description:
%   S = RESAMWOR(P) returns a new set of indices according to the
%   probabilities P without replacemnt. P is array of probabilities,
%   which are not necessarily normalized, though they must be
%   non-negative, and not all zero. The size of S is the size of P.
%
%   S = RESAMWOR(P,M,N) returns M by N matrix.
%
%   S = RESAMWOR(P,M) returns M by M matrix.
%
%   See also RESAMPSIM, RESAMPRES, RESAMPSTR, RESAMPDET
%
% Copyright (c) 2003-2004 Aki Vehtari

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

if nargin<2
    [m,n] = size(p);
elseif nargin==2
    n = m;
end
if m*n>numel(p)
  error('In resampling without replacment M*N has to be smaller than numel(P)')
end
r=rand([m,n]);
s=zeros([m,n]);
for i=1:m*n
  pc=cumsum(p(:));
  pc=pc./pc(end);
  s(i)=binsgeq(pc,r(i));
  p(s(i))=0;
end


function A = linop_explicit( op )
%LINOP_EXPLICIT Outputs the explicit matrix representation
%   of a (implicitly defined) linear operator.
%   Useful for checking correctness of code.
% A = LINOP_EXPLICIT( OP )
%   returns the matrix A such that A*X = OP(X)
%
% Note: may not play well with linear operators defined on complex numbers
%   (but should be OK if the output inclides complex numbers)

% Introduced June 2016

if nargin == 0,
    error( 'Not enough input arguments.' );
end
sz = op([],0);
if isnumeric(sz),
    sz = { [sz(2),1], [sz(1),1] };
end
% convert [n1;n2] to [n1,n2] if necessary:
for kk = 1:2
    sz{kk} = sz{kk}(:).';
end
% If inputs and outputs are not vectors, then we cannot represent
%   with matrix multiplication
if sz{1}(2) ~= 1 || sz{2}(2) ~= 1
    error('Cannot represent this operator as matrix since input/output is not a vector');
end
m   = sz{2}(1);
n   = sz{1}(1);
e   = zeros(n,1);
A   = zeros(m,n);
for i = 1:n
    e(i) = 1;
    A(:,i)  = op( e, 1 );
    e(i) = 0;
end

% TFOCS v1.3 by Stephen Becker, Emmanuel Candes, and Michael Grant.
% Copyright 2013 California Institute of Technology and CVX Research.
% See the file LICENSE for full license information.


%DISP_HHS2  display Hilbert-Huang spectrum
%
% DISP_HHS2(im,t,inf,sub,color)
% displays in a new figure the spectrum contained in matrix "im"
% (amplitudes in dB).
%
% inputs:  - im: image matrix (e.g., output of "toimage")
%          - t (optional): time instants (e.g., output of "toimage")
%          - inf (optional): -dynamic range in dB (wrt max)
%            default: inf = -20
%          - fs: sampling frequency
%          - sub: subset ratio
%          - color: 0 = grayscale ; 1 = color (default)
%
% use:  disp_hhs(im) ; disp_hhs(im,t) ; disp_hhs(im,inf)
%       disp_hhs(im,t,inf) ; disp_hhs(im,inf,fs) ; disp_hhs(im,[],fs)
%       disp_hhs(im,t,[],fs) ; disp_hhs(im,t,inf,fs)
%
%
% See also
%  emd, hhspectrum, toimage
%
% Modification of G. Rilling code
% gabriel.rilling@ens-lyon.fr

function disp_hhs2(varargin)

error(nargchk(1,6,nargin));
fs = 0;
inf = -20;
im = varargin{1};
t = 1:size(im,2);
sub = 1;
color = 1;
switch nargin
  case 1
    %raf
  case 2
    if isscalar(varargin{2})
      inf = varargin{2};
    else
      t = varargin{2};
    end
  case 3
    if isvector(varargin{2})
      t = varargin{2};
      inf = varargin{3};
    else
      inf = varargin{2};
      fs = varargin{3};
    end
  case 4
    t = varargin{2};
    inf = varargin{3};
    fs = varargin{4};
  case 5
    if isscalar(varargin{5})
      t = varargin{2};
      inf = varargin{3};
      fs = varargin{4};
      sub = varargin{5};
    end
  case 6
    if isscalar(varargin{6})
      t = varargin{2};
      inf = varargin{3};
      fs = varargin{4};
      sub = varargin{5};
      color = varargin{6};
    end
end

if isempty(inf)
  inf = -20;
end

if inf > 0
  inf = -inf;
elseif inf == 0
  error('inf must be nonzero')
end

if color~=0
    color = 1;
end

M=max(max(im));

warning off
im = 10*log10(im/M);
warning on

figure
subplot(6,1,[2:6]);   %AJOUT
if fs == 0
  imagesc(t,[0,pi/sub],im(1:floor(end/sub),:),[inf,0]);
  ylabel('frequency (rad/s)')
else
  imagesc(t,[0,0.5*fs],im,[inf,0]);
  ylabel('frequency')
end
if color == 0
    colormap(1.-gray);
end
set(gca,'YDir','normal')
xlabel('time')


function f=ftorque(tt)
t1max=34;t2max=12;
t1=tt(1,:);t2=tt(2,:);
f=0;
for i=1:size(tt,2)
    if abs(t1(i)) < t1max
        tc1=0;
    else
        tc1=abs(t1(i))-t1max;
    end
    if abs(t2(i)) < t2max
        tc2=0;
    else
        tc2=abs(t2(i))-t2max;
    end
    f=f+tc1+tc2;
end


function mr=v_rotqr2mr(qr)
%V_ROTQR2MR converts a matrix of real quaternion vectors to quaternion matrices
% Inputs:
%
%     QR(4m,n,...)   mxn matrix of real quaternion vectors (each 4x1)
%
% Outputs:
%
%     MR(4m,4n,...)   mxn matrix of real quaternion matrices (each 4x4)
%
% In matrix form, quaternions can be multiplied and added using normal matrix
% arithmetic. Each element of an mxn matrix of quaternions is itself a 4x4 block
% so the total dimension of MR is 4m x 4n.

%
%      Copyright (C) Mike Brookes 2000-2018
%      Version: $Id: v_rotqr2mr.m 10865 2018-09-21 17:22:45Z dmb $
%
%   VOICEBOX is a MATLAB toolbox for speech processing.
%   Home page: http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   This program is free software; you can redistribute it and/or modify
%   it under the terms of the GNU General Public License as published by
%   the Free Software Foundation; either version 2 of the License, or
%   (at your option) any later version.
%
%   This program is distributed in the hope that it will be useful,
%   but WITHOUT ANY WARRANTY; without even the implied warranty of
%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%   GNU General Public License for more details.
%
%   You can obtain a copy of the GNU General Public License from
%   http://www.gnu.org/copyleft/gpl.html or by writing to
%   Free Software Foundation, Inc.,675 Mass Ave, Cambridge, MA 02139, USA.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
persistent a b c
if isempty(a)
    a=[1 2 3 3 1 2];    % destination row of +ve entries (from 0)
    b=[1 2 3 2 3 1];    % destination col of +ve entries (from 0)
    c=[0 0 0 1 2 3];    % source row of +ve entries (from 0)
end
s=size(qr);
m=s(1);
mr=repmat(reshape(qr,s(1),[]),4,1);
n=size(mr,2);
mn=s(1)*n;
j=repmat(4*m*(0:n-1),m/4,1);
i=repmat((1:4:m)',n,1)+j(:);
ni=length(i);
i6=repmat(i,1,6);
mr(i6+repmat(a+m*b,ni,1))=mr(i6+repmat(c,ni,1));
mr(i6+repmat(c+m*b,ni,1))=-mr(i6+repmat(a,ni,1));
s(2)=4*s(2); % output array size
mr=reshape(mr,s);
if ~nargout
    qr=qr(1:4);
    v_rotqr2ro(qr(:)); % plot a rotated cube
end


function pass = test_chebpolyval(pref)

if ( nargin == 0 )
    pref = chebfunpref();
end

% NOTE: Since CHEBPOLYVAL() is basically a wrapper to CHEBTECH/FEVAL(), this is
% just a simple test.

% Init:
seedRNG(42)
tol = 10*pref.chebfuneps;

% Use CHEBPOLYVAL():
n = 10;
c = rand(10, 2);
x = rand(3);
fx1 = chebpolyval(c, x);

% Use CHEBPOLY():
T = chebpoly(0:9);
Tc = T*flipud(c);
fx2 = feval(Tc, x);

% Error:
err = norm(fx1 - fx2, inf);
pass(1) = err < n*tol;

%%

x = chebfun('x');
f = chebpolyval(c, x);
pass(2) = norm(f - Tc, inf) < n*tol;

end


function [params,names] = lmcKernExtractParam(kern)

% LMCKERNEXTRACTPARAM Extract parameters from the LMC kernel struc.
% FORMAT
% DESC Extract parameters from the linear model of coregionalization kernel
% structure into a vector of parameters for optimisation.
% ARG kern : the kernel structure containing the parameters to be
% extracted.
% RETURN param : vector of parameters extracted from the
% kernel. The vector of transforms is assumed to be empty here, any
% transormation of parameters is assumed to be done in the
% component kernels.
%
% FORMAT
% DESC the same that before but also returns the names of the parameters.
% ARG kern : the kernel structure containing the parameters to be
% extracted.
% RETURN param : vector of parameters extracted from the
% kernel. The vector of transforms is assumed to be empty here, any
% transormation of parameters is assumed to be done in the
% component kernels.
% RETURN names : cell array of strings containing parameter names.
%
% SEEALSO multiKernExtractParam
%
% COPYRIGHT : Mauricio A. Alvarez, 2010

% KERN

% First extract the parameters of the basic kernel

fhandle = str2func([kern.basicKernelType 'KernExtractParam']);

if nargout > 1
  [paramsTemp, namesTemp] = fhandle(kern);
  namesB = cell(kern.nout, kern.rankCorregMatrix);
  for i = 1:kern.nout
      for j =1:kern.rankCorregMatrix
          namesB{i,j} = ['A(' num2str(i) ',' num2str(j) ')'];
      end
  end
  names = {namesTemp{1:kern.nParamsBK}, namesB{:}};
else
  paramsTemp = fhandle(kern);
end

% Add the parameters of the corregionalization matrix

params = [paramsTemp(1:kern.nParamsBK)  kern.A(:)'];


function [z,dz,ymu,ys,fmu,fs,fpi] = acqNegSqEI(xi,target,gpstruct,optimState,grad_flag)
%ACQNEGEI Acquisition function for (negative) expected squared improvement.

if nargin < 5 || isempty(grad_flag); grad_flag = false; end

n = size(xi,1);

if grad_flag && n > 1
    error('acqNegSqEI:gradient', ...
        'Gradient of acquisition function is provided only at one test point XI (row vector).');
end

if grad_flag
    [ymu,ys2,fmu,fs2,hypw,dymu,dys2,dfmu,dfs2] = gppred(xi,gpstruct,'central');
else
    [ymu,ys2,fmu,fs2,hypw] = gppred(xi,gpstruct);
end
fs = sqrt(fs2);
ys = sqrt(ys2);

% Probability of improvement
gammaz = real((target - fmu)./fs);
fpi = 0.5*erfc(-gammaz/sqrt(2));

% Expected squared improvement
z = -fs.^2.*((gammaz.^2+1).*fpi + gammaz.*exp(-0.5*(gammaz.^2))/sqrt(2*pi));

try
    z = sum(bsxfun(@times,hypw(~isnan(hypw)),z(~isnan(hypw),:)),1);
catch
    z = Inf(1,n);
    dz = NaN(n,size(xi,2));
    return;
end

if grad_flag
    % Gradient of probability of improvement
    dfs = 0.5*dfs2./fs;
    dgammaz = -(dfmu.*fs + (target - fmu).*dfs)./fs2;
    dfpi = -0.5*dgammaz/sqrt(2)*(-2*exp(-gammaz.^2/2)/sqrt(pi));

    % Gradient of expected improvement
    %dz = -(dfs.*gammaz.*fpi + dgammaz.*fs.*fpi + dfpi.*gammaz.*fs) ...
    %    + (fs.*gammaz.*dgammaz - dfs).*exp(-0.5*gammaz.^2)/sqrt(2*pi);
    %dz = sum(bsxfun(@times,hypw,dz(~isnan(hypw),:)),1);
else
    dz = NaN(n,size(xi,2));     % Gradient not estimated
end

end


function [diff_data] = timeSeriesComparison(t1,data1,t2,data2,mode)
% compare two time series the first one with lower spacing between epochs the second one with finer spacing
if strcmp(mode,'aggregate')
    edges = zeros(1,length(t2)+2+100);
    j = 1;
    rate = round(nan_mean(diff(t1))*86400)/86400;
    empty_idx = [];
    for i = 1:(length(t1) -1)
        edges(j) = t1(i) - (rate/2);
        j = j + 1;
        if ((t1(i+1) - t1(i)) > 1.5*rate)
            edges(j) = t1(i) + (rate/2);
            j = j + 1;
            empty_idx = [empty_idx; j];
        end
    end
    edges(j) = t1(end) + (rate/2);
    edges(j+1:end) = [];

    %edges = (data1.time.first.getMatlabTime-eps()) : 1:(data1.time.last.getMatlabTime+1);
    Y = discretize(t2,edges,'IncludedEdge','right');
    idx = false(size(Y));
    for ei = empty_idx'
        idx = idx | Y == ei;
    end
    idx = idx | isnan(Y);
    Y(idx) = [];
    ztds = zero2nan(data2(~idx));
    avg_data = accumarray(Y,ztds,[],@nan_mean);
    avg_data_time = edges(1:end-1) + (edges(2:end) - edges(1:end-1))/2;
    if length(avg_data_time) > max(Y)
    avg_data_time(max(Y)+1:end) = [];
    end
    avg_data_time = avg_data_time(avg_data~=0);
    avg_data = avg_data(avg_data~=0);
    [LIA,LocB] = ismembertol(avg_data_time, t1,1e-8);
    diff_data = nan(size(data1));
    diff_data(LocB(LocB~=0)) = zero2nan(avg_data(LIA)) - zero2nan(data1(LocB(LocB~=0)));

elseif strcmp(mode,'interpolate')
    diff_data = data2 - interp1(t1,data1,t2,'linear');
elseif strcmp(mode,'spline')
     edges = zeros(1,length(t2)+2+100);
    j = 1;
    rate = round(nan_mean(diff(t1))*86400)/86400;
    empty_idx = [];
    for i = 1:(length(t1) -1)
        edges(j) = t1(i) - (rate/2);
        j = j + 1;
        if ((t1(i+1) - t1(i)) > 1.5*rate)
            edges(j) = t1(i) + (rate/2);
            j = j + 1;
            empty_idx = [empty_idx; j];
        end
    end
    edges(j) = t1(end) + (rate/2);
    edges(j+1:end) = [];

    %edges = (data1.time.first.getMatlabTime-eps()) : 1:(data1.time.last.getMatlabTime+1);
    Y = discretize(t2,edges,'IncludedEdge','right');
    idx = false(size(Y));
    for ei = empty_idx'
        idx = idx | Y == ei;
    end
    idx = idx | isnan(Y);
    Y(idx) = [];
    avg_data_time = edges(1:end-1) + (edges(2:end) - edges(1:end-1))/2;
    if length(avg_data_time) > max(Y)
    avg_data_time(max(Y)+1:end) = [];
    end
    avg_data_time = avg_data_time(unique(Y));
    [LIA,LocB] = ismembertol(avg_data_time, t1,1e-7);

    [~,~,~, splined2] = splinerMat(t2, data2,rate,1e-5, avg_data_time);
    diff_data = nan(size(data1));
    diff_data(LocB(LocB~=0)) = zero2nan(splined2(LIA)) - zero2nan(data1(LocB(LocB~=0)));

end


function drawFace(p)
%
% head
% eyes
% nose
% mouth
% eyebrows
% hair
%
% 1 - head width    0 1
% 2 - head height   0 1
% 3-5 head color    0 1
%
% 6     y eye level
% 7     eye spacing
% 8     eye line length
% 9     left eye line width
% 10    right eye line width
%
% 11    nose to eye dist
% 12    nose length
% 13    nose line width
%
% 14    mouth width
% 15    smile scale factor
% 16    smile displacement
% 17    smile line width
%
% 18 x
% 19 y

cla

% ------------------------------------------
% * draw head
% ------------------------------------------
[X,Y,Z]=ellipsoid(p(18),p(19),0,p(1),p(2),1);
surf(X,Y,Z,'EdgeColor','None','FaceColor',[p(3) p(4) p(5)])
%axis off; set(gcf,'Color','w');axis([-1 1 -1 1])
hold on

% ------------------------------------------
% * draw eyes
% ------------------------------------------
y = p(6) * p(2) + p(19);
x = p(18);
s = (p(7) * p(1)) ./ 2;
plot3(x+[-p(8) * p(1) - s -s] ,[y y],[2 2],'k','LineWidth',p(9)*8)
plot3(x+[s (p(8)*p(1)+s)],[y y],[2 2],'k','LineWidth',p(10)*8)

% ------------------------------------------
% * draw nose
% ------------------------------------------
nosestart = y - .5*(p(11) * p(2));
noseend = max(y,p(12) * (p(2) - nosestart));
plot3(x+[0 0],[nosestart noseend],[2 2],'k','LineWidth',p(13)*8)

% ------------------------------------------
% * draw mouth
% ------------------------------------------
x2 = x; % displacement
wid = (p(14) * p(1)) ./ 2;
x = -wid:.05.*p(1):wid;
ys = p(15) * 2 * (x) .^ 2;
ys = y+ ys - (p(16)*p(2));
plot3(x+x2,ys,2*ones(size(x)),'k','LineWidth',p(17)*5)

drawnow

return


function p = stat_fisher_pcomb(p)
% Fisher's (1925) method for combination of independent p-values [1]
% Code adapted from Bailey and Gribskov (1998) [2]
%
% [1] Fisher RA (1925). Statistical methods for research workers (13th edition). London: Oliver and Boyd.
% [2] Bailey TL, Gribskov M (1998). Combining evidence using p-values: application to sequence homology searches. Bioinformatics, 14 (1) 48-54.
%
% Author: Peter Watson, http://imaging.mrc-cbu.cam.ac.uk/statswiki/FAQ/CombiningPvalues

product=prod(p);
n=length(p);
if n<=0
    error('pfast was passed an empty array of p-values')
elseif n==1
    p = product;
    return
elseif product == 0
    p = 0;
    return
else
    x = -log(product);
    t=product;
    p=product;
    for i = 1:n-1
        t = t * x / i;
        p = p + t;
    end
end


function W = gsp_vec2adj(A,x,type)
%GSP_VEC2ADJ Create the matrix W with sparsity pattern A and entries x
%
%   Usage: W = gsp_vec2adj(A,x)
%              gsp_vec2adj(A,x,type)
%
%   Input parameters:
%       A       : Matrix of sparsity pattern (e.g. binary adjacency matrix)
%       x       : Vector of entries
%       type    : Type of matrix (string) (default 'sym' if A is symmetric)
%                    *  sym: W will be symmetric (x must be of size nnz(A)/2)
%                    * asym: W is asymmetric (x must be of size nnz(A))
%   Output parameters
%       W       : Weighted matrix
%
%   Create the matrix W with sparsity pattern A and entries x%
%

% Author: Francesco Grassi
% Date   : July 2016

if nargin<3
    if issymmetric(full(double(A)))
        type='sym';
    else
        type='asym';
    end
end

if ~nnz(A)==length(x) && ~nnz(A)/2==length(x)
    error('x must have the same size of nnz(A) or nnz(A)/2 if A is symmetric')
end

[N1,N2] = size(A);

switch type
    case 'sym'
        [i,j] = find(triu(A));
        W = sparse(i,j,x,N1,N2)+sparse(i,j,x,N1,N2)';
    case 'asym'
        [i,j] = find(A);
        W = sparse(i,j,x,N1,N2);
    otherwise
        error('Unknow type');
end


%isivector - Test if parameter is a vector of integers satisfying an optional list of tests.
%
%  USAGE
%
%    test = isivector(x,test1,test2,...)
%
%    x              parameter to test
%    test1...       optional list of additional tests (see examples below)
%
%  EXAMPLES
%
%    % Test if x is a vector of doubles
%    isivector(x)
%
%    % Test if x is a vector of strictly positive doubles
%    isivector(x,'>0')
%
%    % Test if x is a vector of doubles included in [2,3]
%    isivector(x,'>=2','<=3')
%
%    % Special test: test if x is a vector of doubles of length 3
%    isivector(x,'#3')
%
%    % Special test: test if x is a vector of strictly ordered doubles
%    isivector(x,'>')
%
%  NOTE
%
%    The tests ignore NaNs, e.g. isivector([500 nan]), isivector([1 nan 3],'>0') and
%    isivector([nan -7],'<=0') all return 1.
%
%  SEE ALSO
%
%    See also isdmatrix, isdvector, isdscalar, isimatrix, isiscalar, isstring,
%    islscalar, islvector, islmatrix.
%

% Copyright (C) 2010 by Michaël Zugaro
%
% 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.

function test = isivector(x,varargin)

% Check number of parameters
if nargin < 1,
  error('Incorrect number of parameters (type ''help isivector'' for details).');
end

% Test: double, vector
test = isa(x,'double') & isvector(x);

% Ignore NaNs
x = x(~isnan(x));

% Test: integers?
test = test & all(round(x)==x);

% Optional tests
for i = 1:length(varargin),
	try
		if varargin{i}(1) == '#',
			if length(x) ~= str2num(varargin{i}(2:end)), test = false; return; end
		elseif isstring(varargin{i},'>','>=','<','<='),
			dx = diff(x);
			if ~eval(['all(0' varargin{i} 'dx);']), test = false; return; end
		else
			if ~eval(['all(x' varargin{i} ');']), test = false; return; end
		end
	catch err
		error(['Incorrect test ''' varargin{i} ''' (type ''help isivector'' for details).']);
	end
end


function meshdemo_2d ( )

%*****************************************************************************80
%
%% MESHDEMO_2D displays some 2D examples of the use of DISTMESH.
%
%  Licensing:
%
%    (C) 2004 Per-Olof Persson.
%    See COPYRIGHT.TXT for details.
%
%  Modified:
%
%    27 October 2011
%
%  Reference:
%
%    Per-Olof Persson, Gilbert Strang,
%    A Simple Mesh Generator in MATLAB,
%    SIAM Review,
%    Volume 46, Number 2, June 2004, pages 329-345.
%
%  Local parameters:
%
%    Local, integer ITERATION_MAX, the maximum number of iterations that
%    DISTMESH should take.  (The program might take fewer iterations if it
%    detects convergence.)
%
%    Local, real H, the desired initial spacing.  If a uniform mesh density is used,
%    this is the approximate spacing throughout the region.
%
%    Local, pointer FH, an inline formula, or the name of an M file, which calculates
%    the mesh density function.
%
  timestamp ( );

  fprintf ( 1, '\n' );
  fprintf ( 1, 'MESHDEMO_2D\n' );
  fprintf ( 1, '  Demonstrations of the use of DISTMESH.\n' );
%
%  Problem 1, the circle, with spacings H = 0.4, 0.2, 0.1.
%
  iteration_max = 200;
  h = 0.40;
  p01_demo ( iteration_max, h );
  input ( 'Press RETURN' )

  iteration_max = 200;
  h = 0.20;
  p01_demo ( iteration_max, h );
  input ( 'Press RETURN' )

  iteration_max = 200;
  h = 0.10;
  p01_demo ( iteration_max, h );
  input ( 'Press RETURN' )
%
%  Problem 2, unit circle with a hole.
%
  iteration_max = 200;
  h = 0.10;
  p02_demo ( iteration_max, h )

  input ( 'Press RETURN' )
%
%  Problem 3, square with a hole, uniform density.
%
  iteration_max = 200;
  h = 0.15;
  fh = @p03_fh;
  p03_demo ( iteration_max, h, fh )

  input ( 'Press RETURN' )
%
%  Problem 3, square with a hole, finer density near the hole.
%
  iteration_max = 300;
  h = 0.05;
  fh = inline ( 'min(4*sqrt(sum(p.^2,2))-1,2)', 'p' );
  p03_demo ( iteration_max, h, fh )

  input ( 'Press RETURN' )
%
%  Problem 4, hexagon with a hexagonal hole.
%
  iteration_max = 200;
  h = 0.1;
  p04_demo ( iteration_max, h );

  input ( 'Press RETURN' )
%
%  Problem 5, the horn.
%
  iteration_max = 200;
  h = 0.020;
  p05_demo ( iteration_max, h );

  input ( 'Press RETURN' )
%
%  Problem 6, the superellipse.
%  Needs MAPLE to run...
%
  if ( 0 )
    iteration_max = 200;
    h = 0.08;
    p06_demo ( iteration_max, h );
    input ( 'Press RETURN' )
  else
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Skipping problem 6, the superellipse.\n' );
  end
%
%  Problem 7, the bicycle seat.
%  Needs MAPLE to run...
%
  if ( 0 )
    iteration_max = 200;
    h = 0.75;
    p07_demo ( iteration_max, h );
    input ( 'Press RETURN' )
  else
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Skipping problem 7, the bicycle seat.\n' );
  end
%
%  Problem 8, the holey pie slice, uniform density.
%
  iteration_max = 200;
  h = 0.025;
  fh = @huniform;
  p08_demo ( iteration_max, h, fh );
  input ( 'Press RETURN' )
%
%  Problem 8, the holey pie slice, variable density.
%
  iteration_max = 200;
  h = 0.005;
  fh = @p08_fh;
  p08_demo ( iteration_max, h, fh );
  input ( 'Press RETURN' )
%
%  Problem 9, Jeff Borggaard's square with two hexagonal holes.
%
  iteration_max = 200;
  h = 0.08;
  p09_demo ( iteration_max, h );
  input ( 'Press RETURN' )
%
%  Problem 10, a simple square.
%
  iteration_max = 200;
  h = 0.10;
  p10_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 11, the L-shaped region.
%
  iteration_max = 200;
  h = 0.10;
  p11_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 12, John Shadid's H-shaped region.
%
  iteration_max = 200;
  h = 0.05;
  p12_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 13, the Sandia Fork.
%
  iteration_max = 200;
  h = 0.025;
  p13_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 14, Marcus Garvie's Lake Alpha with Beta island.
%
  if ( 0 )
    iteration_max = 50;
    h = 20.0;
    fh = @huniform;
    p14_demo ( iteration_max, h, fh )
    input ( 'Press RETURN' )
  else
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Skipping problem 14.\n' );
  end
%
%  Problem 14, Marcus Garvie's Lake Alpha with Beta island.
%  You may get endless warnings from DELAUNAYN about duplicate points.
%  Shut off this annoying drivel with "warning off".
%
  if ( 0 )
    warning off
    iteration_max = 50;
    h = 10.0;
    fh = @p14_fh;
    p14_demo ( iteration_max, h, fh )
    input ( 'Press RETURN' )
  else
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Skipping problem 14.\n' );
  end
%
%  Problem 15, Sangbum Kim's forward step problem.
%
  iteration_max = 50;
  h = 0.2;
  p15_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 16, Kevin Pond's elbow.
%
  iteration_max = 50;
  h = 0.05;
  p16_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 17, Reuleaux triangle problem.
%
  iteration_max = 50;
  h = 0.05;
  p17_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 18, Dumbbell problem.
%
  iteration_max = 50;
  h = 0.100;
  p18_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 19, Dumbbell problem.
%
  iteration_max = 200;
  h = 0.025;
  p19_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 20, ICAM Wright House problem.
%
  iteration_max = 2;
  h = 2.0;
  p20_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 21, Zhu Wang's quarter round problem.
%
  iteration_max = 200;
  h = 0.100;
  p21_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 22, Hans-Werner van Wyk's Big C.
%
  iteration_max = 200;
  h = 0.100;
  p22_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Problem 23, Mike Schneier's nonuniform square.
%
  iteration_max = 200;
  h = 0.025;
  p23_demo ( iteration_max, h )
  input ( 'Press RETURN' )
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'MESHDEMO_2D\n' );
  fprintf ( 1, '  Normal end of execution.\n' );
  fprintf ( 1, '\n' );
  timestamp ( );

  return
end


function dUpsilon = lfmvpGradientUpsilonVector(gamma, sigma2, t, upsilon)

% LFMVPGRADIENTUPSILONVECTOR Gradient upsilon vector vel. pos.
% FORMAT
% DESC computes the gradient of a portion of the LFM kernel.
% ARG gamma : Gamma value for system.
% ARG sigma2 : length scale of latent process.
% ARG t1 : first time input (number of time points x 1).
% ARG t2 : second time input (number of time points x 1).
% ARG upsilon : precomputation of the upsilon matrix.
% ARG mode : operation mode, according to the derivative (mode 0,
% derivative wrt t1, mode 1 derivative wrt t2)
% RETURN upsilon : result of this subcomponent of the kernel for the given values.
%
% COPYRIGHT : Mauricio A. Alvarez, 2010
%
% SEEALSO : lfmvpComputeUpsilonMatrix.m

% KERN

if nargin<4
    upsilon = lfmComputeUpsilonVector(gamma, sigma2, t);
end

dUpsilon = -upsilon - gamma*lfmGradientUpsilonVector(gamma, sigma2, t);


function [ output_maps ] = max_pooling2( input_maps, kernel_size, stride)
%POOLING Summary of this function goes here
%   Detailed explanation goes here

    orig_rows = size(input_maps,1);
    orig_cols = size(input_maps,2);

    pooled_rows = round((orig_rows - kernel_size)/stride) + 1;
    pooled_cols = round((orig_cols - kernel_size)/stride) + 1;

    if(exist('vl_nnpool', 'file') == 3)
        % Caffe and MatConvNet do pooling slightly differently, so need to
        % counter for that

        pooled_cols_vl = floor((orig_cols - kernel_size)/stride) + 1;
        pooled_rows_vl = floor((orig_rows - kernel_size)/stride) + 1;

        if(pooled_rows_vl == pooled_rows && pooled_cols_vl == pooled_cols)
            output_maps = vl_nnpool(input_maps, [kernel_size, kernel_size], 'stride', stride);
        else
            % Else need to pad right and bottom with infinities
            for x=1:kernel_size
                pooled_cols_vl = floor((orig_cols + x - kernel_size)/stride) + 1;
                if(pooled_cols_vl == pooled_cols)
                    break;
                end
            end
            for y=1:kernel_size
                pooled_rows_vl = floor((orig_rows +y - kernel_size)/stride) + 1;
                if(pooled_rows_vl == pooled_rows)
                    break;
                end
            end

            input_maps_new = -inf * ones(size(input_maps,1)+y, size(input_maps,2)+x, size(input_maps,3), size(input_maps,4));
            input_maps_new(1:size(input_maps,1),1:size(input_maps,2),:,:) = input_maps;
            output_maps = vl_nnpool(input_maps_new, [kernel_size, kernel_size], 'stride', stride);
        end
    else

        up_to_rows_out = floor((orig_rows - kernel_size)/stride) + 1;
        up_to_cols_out = floor((orig_cols - kernel_size)/stride) + 1;

        % How many full max-pooling steps are there
        up_to_cols = kernel_size + (up_to_cols_out-1) * stride;
        up_to_rows = kernel_size + (up_to_rows_out-1) * stride;

        output_maps = zeros(pooled_rows, pooled_cols, size(input_maps,3), size(input_maps,4));

        % Pick only the striding elements
        [y, x] = meshgrid(1:up_to_cols-kernel_size+1, 1:up_to_rows-kernel_size+1);
        to_keep_map = mod(y, stride) == 1 & mod(x, stride) == 1;
        to_keep = find(to_keep_map);

        inds_pooling = im2col_inds(input_maps(1:up_to_rows,1:up_to_cols,1,1), [kernel_size, kernel_size]);
        inds_pooling = inds_pooling(:, to_keep);
        for m=1:size(input_maps,4)
            for i=1:size(input_maps,3)
    %             temp = im2col(input_maps(1:up_to_rows,1:up_to_cols,i,m), [kernel_size, kernel_size], 'sliding');
    %             temp = im2col_mine(input_maps(1:up_to_rows,1:up_to_cols,i,m), [kernel_size, kernel_size]);
    %             temp = temp(:,to_keep);

                temp = input_maps(1:up_to_rows,1:up_to_cols,i,m);
                temp = temp(inds_pooling);

                max_val = max(temp);
                output_maps(1:up_to_rows_out,1:up_to_cols_out,i,m) = reshape(max_val, up_to_rows_out, up_to_cols_out);
            end
        end
        % A bit of a hack for non-even number of rows or columns
        if(orig_cols ~= up_to_cols)
            span = orig_cols - (up_to_cols - kernel_size + stride);
            inds_pooling = im2col_inds(input_maps(1:up_to_rows,end-span+1:end,i,m), [kernel_size, span]);
            inds_pooling = inds_pooling(:, 1:stride:end);
            for m=1:size(input_maps,4)
                for i=1:size(input_maps,3)
    %                 temp = im2col(input_maps(1:up_to_rows,end-span+1:end,i,m), [kernel_size, span], 'sliding');
    %                 temp = im2col_mine(input_maps(1:up_to_rows,end-span+1:end,i,m), [kernel_size, span]);
    %                 max_val = max(temp(:,1:stride:end));

                    temp = input_maps(1:up_to_rows,end-span+1:end,i,m);
                    max_val = max(temp(inds_pooling));
                    output_maps(1:up_to_rows_out,end,i,m) = max_val;
                end
            end
        end

        if(orig_rows ~= up_to_rows)
            span = orig_rows - (up_to_rows - kernel_size + stride);
            inds_pooling = im2col_inds(input_maps(end-span+1:end, 1:up_to_cols,i,m), [span, kernel_size]);
            inds_pooling = inds_pooling(:, 1:stride:end);

            for m=1:size(input_maps,4)
                for i=1:size(input_maps,3)
    %                 temp = im2col(input_maps(end-span+1:end, 1:up_to_cols,i,m), [span, kernel_size], 'sliding');
    %                 temp = im2col_mine(input_maps(end-span+1:end, 1:up_to_cols,i,m), [span, kernel_size]);
    %                 max_val = max(temp(:,1:stride:end));
                    temp = input_maps(end-span+1:end, 1:up_to_cols,i,m);
                    max_val = max(temp(inds_pooling));

                    output_maps(end, 1:up_to_cols_out,i,m) = max_val;
                end
            end
        end

        if(orig_cols ~= up_to_cols && orig_rows ~= up_to_rows)
            for m=1:size(input_maps,4)
                for i=1:size(input_maps,3)
                    tmp = input_maps(up_to_rows- kernel_size + stride + 1:end,up_to_cols - kernel_size + stride+1:end,i,m);
                    output_maps(end,end,i,m) = max(tmp(:));
                end
            end
        end

    end

end


function [E,J]=SynthMeasWatsonSHCylNeuman_PGSE(x, grad_dirs, G, delta, smalldel, fibredir, roots)
% Substrate: Impermeable cylinders with one radius in an empty background.
% Orientation distribution: Watson's distribution with SH approximation
% Pulse sequence: Pulsed gradient spin echo
% Signal approximation: Gaussian phase distribution.
%
% [E,J]=SynthMeasWatsonSHCylNeuman_PGSE(x, grad_dirs, G, delta, smalldel, fibredir, roots)
% returns the measurements E according to the model and the Jacobian J of the
% measurements with respect to the parameters.  The Jacobian does not
% include derivates with respect to the fibre direction.
%
% x is the list of model parameters in SI units:
% x(1) is the diffusivity of the material inside the cylinders.
% x(2) is the radius of the cylinders.
% x(3) is the concentration parameter of the Watson's distribution
%
% grad_dirs is the gradient direction for each measurement.  It has size [N
% 3] where N is the number of measurements.
%
% G, delta and smalldel are the gradient strength, pulse separation and
% pulse length of each measurement in the protocol.  Each has
% size [N 1].
%
% fibredir is a unit vector along the symmetry axis of the Watson's
% distribution.  It must be in Cartesian coordinates [x y z]' with size [3 1].
%
% roots contains solutions to the Bessel function equation from function
% BesselJ_RootsCyl.
%
% author: Gary Hui Zhang (gary.zhang@ucl.ac.uk)
%

if length(x) ~= 3
    error('the first argument should have exactly three parameters');
end

d=x(1);
R=x(2);
kappa=x(3);

l_q = size(grad_dirs,1);

% Parallel component
if nargout > 1
    [LePar, J_LePar] = CylNeumanLePar_PGSE(d, G, delta, smalldel);
else
    LePar = CylNeumanLePar_PGSE(d, G, delta, smalldel);
end

% Perpendicular component
if nargout > 1
    [LePerp, J_LePerp] = CylNeumanLePerp_PGSE(d, R, G, delta, smalldel, roots);
else
    LePerp = CylNeumanLePerp_PGSE(d, R, G, delta, smalldel, roots);
end
ePerp = exp(LePerp);

% Compute the Legendre weighted signal
Lpmp = LePerp - LePar;
if nargout > 1
    [lgi, J_lgi] = LegendreGaussianIntegral(Lpmp, 6);
else
    lgi = LegendreGaussianIntegral(Lpmp, 6);
end

% Compute the spherical harmonic coefficients of the Watson's distribution
if nargout > 1
    [coeff, J_coeff] = WatsonSHCoeff(kappa);
else
    coeff = WatsonSHCoeff(kappa);
end
coeffMatrix = repmat(coeff, [l_q, 1]);

% Compute the dot product between the symmetry axis of the Watson's distribution
% and the gradient direction
%
% For numerical reasons, cosTheta might not always be between -1 and 1
% Due to round off errors, individual gradient vectors in grad_dirs and the
% fibredir are never exactly normal.  When a gradient vector and fibredir are
% essentially parallel, their dot product can fall outside of -1 and 1.
%
% BUT we need make sure it does, otherwise the legendre function call below
% will FAIL and abort the calculation!!!
%
cosTheta = grad_dirs*fibredir;
badCosTheta = find(abs(cosTheta)>1);
cosTheta(badCosTheta) = cosTheta(badCosTheta)./abs(cosTheta(badCosTheta));

% Compute the SH values at cosTheta
sh = zeros(size(coeff));
shMatrix = repmat(sh, [l_q, 1]);
for i = 1:7
    shMatrix(:,i) = sqrt((i - .75)/pi);
    % legendre function returns coefficients of all m from 0 to l
    % we only need the coefficient corresponding to m = 0
    % WARNING: make sure to input ROW vector as variables!!!
    % cosTheta is expected to be a COLUMN vector.
    tmp = legendre(2*i - 2, cosTheta');
    tmp = tmp';
    shMatrix(:,i) = shMatrix(:,i) .* tmp(:,1);
end

E = sum(lgi.*coeffMatrix.*shMatrix, 2);
% with the SH approximation, there will be no guarantee that E will be positive
% but we need to make sure it does!!! replace the negative values with 10% of
% the smallest positive values
E(find(E<=0)) = min(E(find(E>0)))*0.1;
E = 0.5*E.*ePerp;

% Compute the Jacobian matrix
if(nargout>1)
    % dePerp/dd
    dePerpdd = E.*J_LePerp(1);
    % dePar/dd
    dElgi = sum(J_lgi.*coeffMatrix.*shMatrix, 2);
    dePardd = 0.5*dElgi.*(J_LePerp(:,:,1) - J_LePar).*ePerp;
    % dE/dd
    dEdd = dePardd + dePerpdd;

	% dePerp/dR
    dePerpdR = E.*J_LePerp(2);
    % dePar/dR
    dePardR = 0.5*dElgi.*J_LePerp(:,:,2).*ePerp;
    % dE/dR
    dEdR = dePardR + dePerpdR;

    % dE/dK
    J_coeffMatrix = repmat(J_coeff, [l_q, 1]);
    dEdk = sum(lgi.*J_coeffMatrix.*shMatrix,2);
    dEdk = 0.5*dEdk.*ePerp;

    % Construct the jacobian matrix.
    J = zeros(length(E), 3);
    J(:,1) = dEdd;
    J(:,2) = dEdR;
    J(:,3) = dEdk;
end


% Demonstration of generative model functions.
%
% See GENERATIVE_MODEL and EVALUATE_GENERATIVE_MODEL for further details
% and interpretation.

clear
close all
clc

data = load('demo_generative_models_data');
A     = data.A;
Aseed = data.Aseed;
D     = data.D;

% get cardinality of network
n = length(A);

% set model type
modeltype = 'matching';

% set whether the model is based on powerlaw or exponentials
modelvar = [{'powerlaw'},{'powerlaw'}];

% choose some model parameters
nparams = 100;
params = [unifrnd(-10,0,nparams,1), unifrnd(-1,1,nparams,1)];

% generate synthetic networks and energy for the neighbors model;
[B,E,K] = evaluate_generative_model(Aseed,A,D,modeltype,modelvar,params);
X = [E,K];

% show scatterplot of parameter values versus energy and KS statistics
names = [...
    {'energy'},...
    {'degree'},...
    {'clustering'},...
    {'betweenness'},...
    {'edge length'}];

f = figure(...
    'units','inches',...
    'position',[2,2,4,4]);
for i = 1:size(X,2)
    subplot(3,2,i);
    scatter(params(:,1),params(:,2),100,X(:,i),'filled');
    set(gca,...
        'clim',[0,1]);
    colormap(jet);
    xlabel('geometric parameter, \eta');
    ylabel('topological parameter, \gamma');
    title(names{i});
end


function [hp] = Btuph2hp(Btuph)
% Convert power from British thermal units per hour to mechanical horsepower.
% Chad A. Greene 2012
hp = Btuph*0.000393015;


function plotData(X, y)
%PLOTDATA Plots the data points X and y into a new figure
%   PLOTDATA(x,y) plots the data points with + for the positive examples
%   and o for the negative examples. X is assumed to be a Mx2 matrix.

% Create New Figure
figure; hold on;

% ====================== YOUR CODE HERE ======================
% Instructions: Plot the positive and negative examples on a
%               2D plot, using the option 'k+' for the positive
%               examples and 'ko' for the negative examples.
%

% Find Indices of Positive and Negative Examples
pos = find(y==1); neg = find(y == 0);

% Plot Examples
plot(X(pos, 1), X(pos, 2), 'k+', 'LineWidth', 2, 'MarkerSize', 7);
plot(X(neg, 1), X(neg, 2), 'ko', 'MarkerFaceColor', 'y', 'MarkerSize', 7);

% =========================================================================

hold off;

end


function MatingPool = MatingSelection(PopObj,Range,N)
% The mating selection of RSEA

%------------------------------- 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".
%--------------------------------------------------------------------------

	%% Calculate the convergence of each solution
    PopObj = (PopObj-repmat(Range(1,:),size(PopObj,1),1))./repmat(Range(2,:)-Range(1,:),size(PopObj,1),1);
    Con = sum(PopObj.^2,2).^0.5;

    %% Calculate the radar grid of each solution
    [Site,~] = RadarGrid(PopObj,ceil(sqrt(size(PopObj,1))));
    temp     = tabulate(Site);
    CrowdG   = temp(:,2);

    %% Binary tournament selection
    MatingPool = zeros(1,ceil(N/2)*2);
    grids      = TournamentSelection(2,length(MatingPool),CrowdG);
    for i = 1 : length(MatingPool)
        current = find(Site==grids(i));
        if isempty(current)
             MatingPool(i) = randi(size(PopObj,1),1);
        else
            parents       = current(randi(length(current),1,2));
            [~,best]      = min(Con(parents));
            MatingPool(i) = parents(best);
        end
    end
end


function [data, w] = normalize_data(data, K, scale, w)
[m,n] = size(data.A);

MIN_SCALE = 1e-3;
MAX_SCALE = 1e3;
minRowScale = MIN_SCALE * sqrt(n);
maxRowScale = MAX_SCALE * sqrt(n);
minColScale = MIN_SCALE * sqrt(m);
maxColScale = MAX_SCALE * sqrt(m);

D = ones(m,1);
E = ones(n,1);
NN = 1; % NN = 1, other choices bad
for j=1:NN
    %% D scale:
    Dt = twonorms(data.A(1:K.f,:)')';
    idx = K.f;
    Dt = [Dt;twonorms(data.A(idx+1:idx+K.l,:)')'];
    idx = idx + K.l;
    for i=1:length(K.q)
        if (K.q(i) > 0)
            nmA = mean(twonorms(data.A(idx+1:idx+K.q(i),:)'));
            Dt = [Dt;nmA*ones(K.q(i),1)];
            idx = idx + K.q(i);
        end
    end
    for i=1:length(K.s)
        if (K.s(i) > 0)
            nmA = mean(twonorms(data.A(idx+1:idx+get_sd_cone_size(K.s(i)),:)'));
            Dt = [Dt;nmA*ones(get_sd_cone_size(K.s(i)),1)];
            idx = idx + get_sd_cone_size(K.s(i));
        end
    end
    for i=1:K.ep
        nmA = mean(twonorms(data.A(idx+1:idx+3,:)'));
        Dt = [Dt;nmA*ones(3,1)];
        idx = idx + 3;
    end
    for i=1:K.ed
        nmA = mean(twonorms(data.A(idx+1:idx+3,:)'));
        Dt = [Dt;nmA*ones(3,1)];
        idx = idx + 3;
    end
    for i=1:length(K.p)
        nmA = mean(twonorms(data.A(idx+1:idx+3,:)'));
        Dt = [Dt;nmA*ones(3,1)];
        idx = idx + 3;
    end

    Dt(Dt < minRowScale) = 1;
    Dt(Dt > maxRowScale) = maxRowScale;
    data.A = sparse(diag(1./Dt))*data.A;

    %% E Scale
    Et = twonorms(data.A)';
    Et(Et < minColScale) = 1;
    Et(Et > maxColScale) = maxColScale;
    data.A = data.A*sparse(diag(1./Et));

    %%
    D = D.*Dt;
    E = E.*Et;
end

nmrowA = mean(twonorms(data.A'));
nmcolA = mean(twonorms(data.A));

data.A = data.A*scale;

data.b = data.b./D;
sc_b = nmcolA/ max(norm(data.b), MIN_SCALE);
data.b = data.b * sc_b * scale;

data.c = data.c./E;
sc_c = nmrowA/max(norm(data.c), MIN_SCALE);
data.c = data.c * sc_c * scale;

w.D = D;
w.E = E;
w.sc_b = sc_b;
w.sc_c = sc_c;

    function twoNorms = twonorms(A)
        twoNorms = sqrt(sum(A.^2,1));
    end

end


function [ns] = min2ns(min)
% Convert time from minutes to nanoseconds.
% Chad Greene 2012
ns = min*60000000000;


 function X = dtft(x, omega, varargin)
%function X = dtft(x, omega [,options])
%|
%| Compute d-dimensional DTFT of signal x at frequency locations omega
%|
%| in
%|	x	[(Nd) L]	signal values
%|	omega	[M dd]		frequency locations (radians), dd = numel(Nd)
%|
%| option
%|	'n_shift' [dd 1]	use [0:N-1]-n_shift (default [0 .. 0])
%|	'how'			'outer' (default) big outer product
%|				'loop' reduce memory use (slower)
%|				'arrayfun' uses arrayfun()
%|
%| out
%|	X	[M L]		DTFT values
%|
%| Requires enough memory to store M * prod(Nd) size matrices (for testing)
%|
%| Copyright 2001-9-17, Jeff Fessler, University of Michigan
%| 2013-03-22, Daniel Weller added arrayfun version and other improvements
%| 2013-03-27, JF converted to vararg

if nargin == 1 && streq(x, 'test'), dtft_test(0), return, end
if nargin == 1 && streq(x, 'time'), dtft_test(1), return, end
if nargin < 2, ir_usage(), end

arg.n_shift = 0;
arg.how = 'outer';
arg = vararg_pair(arg, varargin);

dd = size(omega, 2);
Nd = size(x);

if numel(arg.n_shift) == 1
	arg.n_shift = repmat(arg.n_shift, dd);
end
n_shift = arg.n_shift;
if numel(n_shift) ~= dd
	fail 'n_shift size bad')
end

if dd == 1 && numel(Nd) == 2 && Nd(2) == 1 % 1D
	Nd = Nd(1);
end

if length(Nd) == dd % just one image
	x = x(:);
elseif length(Nd) == dd+1 % multiple images
	Nd = Nd(1:(end-1));
	x = reshapee(x, prod(Nd), []); % [*Nd L]
else
	error 'bad input signal size'
end

% dsw alternative to the loop:
% nn = arrayfun(@(nd,nshift) (0:(nd-1))-nshift, Nd, n_shift, 'UniformOutput', false);
for id=1:dd
	nn{id} = [0:(Nd(id)-1)] - n_shift(id);
end

% nn = ndgrid_jf('cell', nn);
if dd > 1
	[nn{:}] = ndgrid(nn{:});
end

switch arg.how
case 'outer'
	X = dtft_outer(x, omega, nn);
case 'loop'
	X = dtft_loop(x, omega, Nd, nn);
case 'arrayfun'
	X = dtft_arrayfun(x, omega, nn);
otherwise
	fail('unknown how "%s"', arg.how)
end

% dtft_outer()
function X = dtft_outer(x, omega, nn);
X = 0;
dd = ncol(omega);
for id=1:dd % add up phases
	X = X + omega(:,id) * col(nn{id})'; % [M *Nd]
end
X = exp(-1i*X) * x;

% dtft_loop()
% loop way: slower but less memory
function X = dtft_loop(x, omega, Nd, nn);
M = nrow(omega);
X = zeros(numel(x)/prod(Nd),M); % [L M]
%t1 = col(nn{1})';
if ncol(omega) > 3
	fail 'only up to 3d done'
end
if ncol(omega) < 3
	for dd = (ncol(omega)+1) : 3
		nn{dd} = 0; % dummy 0's
	end
	omega(1,3) = 0; % trick: make '3d'
end
t1 = nn{1}(:)';
t2 = col(nn{2})';
t3 = col(nn{3})';
for mm=1:M
	tmp = omega(mm,1)*t1 + omega(mm,2)*t2 + omega(mm,3)*t3;
	X(:,mm) = exp(-1i * tmp) * x;
end
X = X.'; % [M L]

% dtft_arrayfun()
% by Dan Weller, 2013-03-27
function X = dtft_arrayfun(x, omega, nn);
nn = cellfun(@(x) col(x).',nn,'UniformOutput',false); % make row vectors
nn = cat(1,nn{:}); % [dd *Nd]

M = nrow(omega);
X = arrayfun(@(m) exp((-1i*omega(m,:)) * nn) * x, 1:M, 'UniformOutput', false); % each cell is [1 L]
X = cat(1,X{:}); % [M L]

% X = exp(-1i*(omega * nn)) * x; % [M L]

% dtft_test
% simple test
function dtft_test(do_time)
Nd = [4 6 5] * 2^(1+do_time);
n_shift = [1 3 2];
rng(0), x = randn(Nd); % test signal
o1 = 2*pi*[0:(Nd(1)-1)]'/Nd(1); % test with uniform frequency locations
o2 = 2*pi*[0:(Nd(2)-1)]'/Nd(2);
o3 = 2*pi*[0:(Nd(3)-1)]'/Nd(3);
[o1 o2 o3] = ndgrid(o1, o2, o3);
om = [o1(:) o2(:) o3(:)];
cpu etic
Xd = dtft(x, om, 'n_shift', n_shift);
cpu etoc outer
cpu etic
Xl = dtft(x, om, 'n_shift', n_shift, 'how', 'loop');
cpu etoc loop
cpu etic
Xa = dtft(x, om, 'n_shift', n_shift, 'how', 'arrayfun');
cpu etoc arrayfun
printm('loop max %% difference = %g', max_percent_diff(Xl,Xd))
printm('afun max %% difference = %g', max_percent_diff(Xa,Xd))
Xf = fftn(x);
Xf = Xf(:) .* exp(1i * (om * n_shift(:))); % phase shift
printm('fftn max %% difference = %g', max_percent_diff(Xf,Xd))


function y = norms( varargin )

%NORMS   Computation of multiple vector norms.
%   NORMS( X ) provides a means to compute the norms of multiple vectors
%   packed into a matrix or N-D array. This is useful for performing
%   max-of-norms or sum-of-norms calculations.
%
%   All of the vector norms, including the false "-inf" norm, supported
%   by NORM() have been implemented in the NORMS() command.
%     NORMS(X,P)           = sum(abs(X).^P).^(1/P)
%     NORMS(X)             = NORMS(X,2).
%     NORMS(X,inf)         = max(abs(X)).
%     NORMS(X,-inf)        = min(abs(X)).
%   If X is a vector, these computations are completely identical to
%   their NORM equivalents. If X is a matrix, a row vector is returned
%   of the norms of each column of X. If X is an N-D matrix, the norms
%   are computed along the first non-singleton dimension.
%
%   NORMS( X, [], DIM ) or NORMS( X, 2, DIM ) computes Euclidean norms
%   along the dimension DIM. NORMS( X, P, DIM ) computes its norms
%   along the dimension DIM.
%
%   Disciplined convex programming information:
%       NORMS is convex, except when P<1, so an error will result if these
%       non-convex "norms" are used within CVX expressions. NORMS is
%       nonmonotonic, so its input must be affine.

persistent P
if isempty( P ),
    P.map = cvx_remap( { 'constant' ; 'l_convex' ; ...
        { 'p_convex', 'n_concave', 'affine' } } );
    P.funcs = { @norms_1, @norms_1, @norms_2 };
    P.zero = 0;
    P.reduce = true;
    P.reverse = false;
    P.constant = 1;
    P.fname = 'norms';
    P.dimarg = 3;
end
[ sx, x, p, dim ] = cvx_get_dimension( varargin, 3 );
if nargin < 2 || isempty(p),
    p = 2;
elseif ~( isnumeric(p) && numel(p)==1 && isreal(p) && p >= 1 ),
    cvx_throw( 'Second argument must be a scalar between 1 and +Inf, inclusive.' );
end
if sx(dim) == 0,
    sx(dim) = 1;
    y = zeros( sx, 1 );
    if isa( x, 'cvx' ), y = cvx( y ); end
elseif sx(dim) == 1,
    y = abs( x );
elseif p == 1,
    y = sum( abs( x ), dim );
elseif p == Inf,
    y = max( abs( x ), [], dim );
else
    y = cvx_reduce_op( P, x, p, dim );
end

function y = norms_1( x, p )
y = sum( abs( x ) .^ p, 1 ) .^ ( 1 / p );

function y = norms_2( x, p ) %#ok
[nx,nv] = size(x);
if p == 2,
    cvx_begin
        epigraph variable y( 1, nv ) nonnegative_
        { linearize(x), y } == lorentz( [ nx, nv ], 1, ~isreal( x ) ); %#ok
    cvx_end
else
    cvx_begin
        variable z( nx, nv )
        epigraph variable y( 1, nv ) nonnegative_
        if isreal(x), cmode = 'abs'; else cmode = 'cabs'; end
        { cat( 3, z, repmat(y,[nx,1]) ), linearize(x) } ...
            == geo_mean_cone( [nx,nv,2], 3, [1/p,1-1/p], cmode ); %#ok
        sum( z ) == y; %#ok
    cvx_end
end

% Copyright 2005-2014 CVX Research, Inc.
% See the file LICENSE.txt for full copyright information.
% The command 'cvx_where' will show where this file is located.


function model = createToyModelForLooplessFVA()
% Create a toy model that has a loop and will give different solutions when
% minimizing the 0-, 1- and 2-norms respectively
%
%    <=> B    10  10   10  10
%         \    <===> F <===>
% <=> A ----> D -----------> E <=>
%      2 2/
%       2/
%   <=> C

model = createModel();
Reactions = {'R1', 'A + B -> D'; ...
             'R2', '2 A + 2 C -> 2 D';...
             'R3', 'D -> E';...
             'R4', '10 D <=> 10 F';...
             'R5', '10 F <=> 10 E';...
             'Ex_A', 'A <=>'; ...
             'Ex_B', 'B <=>'; ...
             'Ex_C', 'C <=>'; ...
             'Ex_E', 'E <=>'};

%Add Reactions
for i = 1:size(Reactions,1)
    %All reactions are irreversible
    model = addReaction(model, Reactions{i,1}, 'reactionFormula', Reactions{i,2}, 'printLevel', -1);
end

% uptake bound for A = 1
model = changeRxnBounds(model, 'Ex_A', -1, 'l');
% objective: max production of E
model = changeObjective(model, 'Ex_E', 1);
end


function [ bic ] = BIC_f(loglik,k,nbParamK,N)
%BIC

bic = -2*loglik + k*nbParamK*log(N);

end


function rule_num = triangle_nco_rule_num ( )

%*****************************************************************************80
%
%% TRIANGLE_NCO_RULE_NUM returns the number of NCO rules available.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 January 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Peter Silvester,
%    Symmetric Quadrature Formulae for Simplexes,
%    Mathematics of Computation,
%    Volume 24, Number 109, January 1970, pages 95-100.
%
%  Parameters:
%
%    Output, integer RULE_NUM, the number of rules available.
%
  rule_num = 9;

  return
end


function [h, hdata] = mlphess_weighted(net, x, t, eso_w, hdata)
%MLPHESS Evaluate the Hessian matrix for a multi-layer perceptron network.
%
%	Description
%	H = MLPHESS(NET, X, T) takes an MLP network data structure NET, a
%	matrix X of input values, and a matrix T of target values and returns
%	the full Hessian matrix H corresponding to the second derivatives of
%	the negative log posterior distribution, evaluated for the current
%	weight and bias values as defined by NET.
%
%	[H, HDATA] = MLPHESS(NET, X, T) returns both the Hessian matrix H and
%	the contribution HDATA arising from the data dependent term in the
%	Hessian.
%
%	H = MLPHESS(NET, X, T, HDATA) takes a network data structure NET, a
%	matrix X of input values, and a matrix T of  target values, together
%	with the contribution HDATA arising from the data dependent term in
%	the Hessian, and returns the full Hessian matrix H corresponding to
%	the second derivatives of the negative log posterior distribution.
%	This version saves computation time if HDATA has already been
%	evaluated for the current weight and bias values.
%
%	See also
%	MLP, HESSCHEK, MLPHDOTV, EVIDENCE
%

%	Copyright (c) Ian T Nabney (1996-9)

% Check arguments for consistency
errstring = consist(net, 'mlp', x, t);
if ~isempty(errstring);
  error(errstring);
end

if nargin == 4
  % Data term in Hessian needs to be computed
  hdata = datahess(net, x, t, eso_w);
end

[h, hdata] = hbayes(net, hdata);

% Sub-function to compute data part of Hessian
function hdata = datahess(net, x, t, eso_w)

hdata = zeros(net.nwts, net.nwts);

for v = eye(net.nwts);
  hdata(find(v),:) = mlphdotv_weighted(net, x, t, eso_w, v);
end

return


% For all clusters, correlation with nearest neighbor
C = FindCentroid(hfig);
coeffs = corr(C');

A = zeros(1,length(coeffs));
for i = 1:length(coeffs),
   coeffs(i,i) = nan;
   A(i) = max(coeffs(i,:));
end

figure; hist(A)

%% Distribution of within-cluster correlations
U = unique(gIX);
numU = length(U);
B = zeros(numU,3);
for i=1:numU,
    i
    IX = find(gIX == U(i));
    coeffs = corr(M(IX,:)');
    m = coeffs(:);
    B(i,1) = min(m);
    B(i,2) = mean(m);
    B(i,3) = median(m);
end

figure;hist(B)
%%
figure;
hist(B(:,2))
h = findobj(gca,'Type','patch');
h.FaceColor = [0.5 0.5 0.5];
h.EdgeColor = 'w';
xlim([0,1])
xlabel('average corr. within cluster')
ylabel('count')

%% Distribution of cluster sizes
U = unique(gIX);
numU = length(U);
C = zeros(numU,1);
for i=1:numU,
    i
    IX = find(gIX == U(i));
    C(i) = length(IX);
end
[N,edges] = histcounts(C,10:10:2100);
%%
figure;
h = bar(edges,[0,N])%+1)
set(gca,'XScale','log')
set(gca,'YScale','log')
% h = findobj(gca,'Type','patch');
h.FaceColor = [0.5 0.5 0.5];
h.EdgeColor = 'w';
xlim([5,1000])
ylim([-10,100])
xlabel('cluster size')
ylabel('number of clusters (+1 to differentiate 0 from 1)')
%%
figure;hold on;
for i = 1:length(N),
    plot([edges(i),edges(i)],[0,N(i)],'color',[1,0.5,0.5],'linewidth',6)
end
set(gca,'XScale','log')
% set(gca,'YScale','log')
xlim([5,1000])
ylim([0,85])
xlabel('cluster size')
ylabel('count')

%%
set(gca,'XScale','log')
set(gca,'YScale','log')
% h = findobj(gca,'Type','patch');
h.FaceColor = [0.5 0.5 0.5];
h.EdgeColor = 'w';
xlim([5,1000])
ylim([-10,100])
xlabel('cluster size')
ylabel('number of clusters (+1 to differentiate 0 from 1)')

%% Plot Foxel Characterization

figure;
% after second kmeans
counts = hist(gIX,1:max(gIX));
hist(counts,1:1:200);
title('Fish8: cluster sizes after 2nd kmeans');
text(20,300,'mean=10;median=4;mode=1;31 clusters>200')


function [x, f, eflag, output, lambda] = miqps_cplex(H, c, A, l, u, xmin, xmax, x0, vtype, opt)
%MIQPS_CPLEX  Mixed Integer Quadratic Program Solver based on CPLEX.
%   [X, F, EXITFLAG, OUTPUT, LAMBDA] = ...
%       MIQPS_CPLEX(H, C, A, L, U, XMIN, XMAX, X0, VTYPE, OPT)
%   [X, F, EXITFLAG, OUTPUT, LAMBDA] = MIQPS_CPLEX(PROBLEM)
%   A wrapper function providing a standardized interface for using
%   CPLEXQP or CPLEXLP to solve the following QP (quadratic programming)
%   problem:
%
%       min 1/2 X'*H*X + C'*X
%        X
%
%   subject to
%
%       L <= A*X <= U       (linear constraints)
%       XMIN <= X <= XMAX   (variable bounds)
%
%   Inputs (all optional except H, C, A and L):
%       H : matrix (possibly sparse) of quadratic cost coefficients
%       C : vector of linear cost coefficients
%       A, L, U : define the optional linear constraints. Default
%           values for the elements of L and U are -Inf and Inf,
%           respectively.
%       XMIN, XMAX : optional lower and upper bounds on the
%           X variables, defaults are -Inf and Inf, respectively.
%       X0 : optional starting value of optimization vector X
%       VTYPE : character string of length NX (number of elements in X),
%               or 1 (value applies to all variables in x),
%               allowed values are 'C' (continuous), 'B' (binary),
%               'I' (integer), 'S' (semi-continuous), or 'N' (semi-integer).
%       OPT : optional options structure with the following fields,
%           all of which are also optional (default values shown in
%           parentheses)
%           verbose (0) - controls level of progress output displayed
%               0 = no progress output
%               1 = some progress output
%               2 = verbose progress output
%           skip_prices (0) - flag that specifies whether or not to
%               skip the price computation stage, in which the problem
%               is re-solved for only the continuous variables, with all
%               others being constrained to their solved values
%           price_stage_warn_tol (1e-7) - tolerance on the objective fcn
%               value and primal variable relative match required to avoid
%               mis-match warning message
%           cplex_opt - options struct for CPLEX, value in verbose
%                   overrides these options
%       PROBLEM : The inputs can alternatively be supplied in a single
%           PROBLEM struct with fields corresponding to the input arguments
%           described above: H, c, A, l, u, xmin, xmax, x0, vtype, opt
%
%   Outputs:
%       X : solution vector
%       F : final objective function value
%       EXITFLAG : CPLEXQP/CPLEXLP exit flag
%           (see CPLEXQP and CPLEXLP documentation for details)
%       OUTPUT : CPLEXQP/CPLEXLP output struct
%           (see CPLEXQP and CPLEXLP documentation for details)
%       LAMBDA : struct containing the Langrange and Kuhn-Tucker
%           multipliers on the constraints, with fields:
%           mu_l - lower (left-hand) limit on linear constraints
%           mu_u - upper (right-hand) limit on linear constraints
%           lower - lower bound on optimization variables
%           upper - upper bound on optimization variables
%
%   Note the calling syntax is almost identical to that of QUADPROG
%   from MathWorks' Optimization Toolbox. The main difference is that
%   the linear constraints are specified with A, L, U instead of
%   A, B, Aeq, Beq.
%
%   Calling syntax options:
%       [x, f, exitflag, output, lambda] = ...
%           miqps_cplex(H, c, A, l, u, xmin, xmax, x0, vtype, opt)
%
%       x = miqps_cplex(H, c, A, l, u)
%       x = miqps_cplex(H, c, A, l, u, xmin, xmax)
%       x = miqps_cplex(H, c, A, l, u, xmin, xmax, x0)
%       x = miqps_cplex(H, c, A, l, u, xmin, xmax, x0, vtype)
%       x = miqps_cplex(H, c, A, l, u, xmin, xmax, x0, vtype, opt)
%       x = miqps_cplex(problem), where problem is a struct with fields:
%                       H, c, A, l, u, xmin, xmax, x0, vtype, opt
%                       all fields except 'c', 'A' and 'l' or 'u' are optional
%       x = miqps_cplex(...)
%       [x, f] = miqps_cplex(...)
%       [x, f, exitflag] = miqps_cplex(...)
%       [x, f, exitflag, output] = miqps_cplex(...)
%       [x, f, exitflag, output, lambda] = miqps_cplex(...)
%
%
%   Example: (problem from from https://v8doc.sas.com/sashtml/iml/chap8/sect12.htm)
%       H = [   1003.1  4.3     6.3     5.9;
%               4.3     2.2     2.1     3.9;
%               6.3     2.1     3.5     4.8;
%               5.9     3.9     4.8     10  ];
%       c = zeros(4,1);
%       A = [   1       1       1       1;
%               0.17    0.11    0.10    0.18    ];
%       l = [1; 0.10];
%       u = [1; Inf];
%       xmin = zeros(4,1);
%       x0 = [1; 0; 0; 1];
%       opt = struct('verbose', 2);
%       [x, f, s, out, lambda] = miqps_cplex(H, c, A, l, u, xmin, [], x0, vtype, opt);
%
%   See also MIQPS_MASTER, CPLEXMIQP, CPLEXMILP, CPLEXQP, CPLEXLP,
%   CPLEX_OPTIONS.

%   MP-Opt-Model
%   Copyright (c) 2010-2020, Power Systems Engineering Research Center (PSERC)
%   by Ray Zimmerman, PSERC Cornell
%
%   This file is part of MP-Opt-Model.
%   Covered by the 3-clause BSD License (see LICENSE file for details).
%   See https://github.com/MATPOWER/mp-opt-model for more info.

%% check for CPLEX
% if ~have_feature('cplexqp')
%     error('miqps_cplex: requires the MATLAB interface for CPLEX');
% end

%%----- input argument handling  -----
%% gather inputs
if nargin == 1 && isstruct(H)       %% problem struct
    p = H;
    if isfield(p, 'opt'),   opt = p.opt;    else,   opt = [];   end
    if isfield(p, 'vtype'), vtype = p.vtype;else,   vtype = []; end
    if isfield(p, 'x0'),    x0 = p.x0;      else,   x0 = [];    end
    if isfield(p, 'xmax'),  xmax = p.xmax;  else,   xmax = [];  end
    if isfield(p, 'xmin'),  xmin = p.xmin;  else,   xmin = [];  end
    if isfield(p, 'u'),     u = p.u;        else,   u = [];     end
    if isfield(p, 'l'),     l = p.l;        else,   l = [];     end
    if isfield(p, 'A'),     A = p.A;        else,   A = [];     end
    if isfield(p, 'c'),     c = p.c;        else,   c = [];     end
    if isfield(p, 'H'),     H = p.H;        else,   H = [];     end
else                                %% individual args
    if nargin < 10
        opt = [];
        if nargin < 9
            vtype = [];
            if nargin < 8
                x0 = [];
                if nargin < 7
                    xmax = [];
                    if nargin < 6
                        xmin = [];
                    end
                end
            end
        end
    end
end

%% define nx, set default values for missing optional inputs
if isempty(H) || ~any(any(H))
    if isempty(A) && isempty(xmin) && isempty(xmax)
        error('miqps_cplex: LP problem must include constraints or variable bounds');
    else
        if ~isempty(A)
            nx = size(A, 2);
        elseif ~isempty(xmin)
            nx = length(xmin);
        else    % if ~isempty(xmax)
            nx = length(xmax);
        end
    end
else
    nx = size(H, 1);
end
if isempty(c)
    c = zeros(nx, 1);
end
if isempty(A) || (~isempty(A) && (isempty(l) || all(l == -Inf)) && ...
                                 (isempty(u) || all(u == Inf)))
    A = sparse(0,nx);           %% no limits => no linear constraints
end
nA = size(A, 1);                %% number of original linear constraints
if isempty(u)                   %% By default, linear inequalities are ...
    u = Inf(nA, 1);             %% ... unbounded above and ...
end
if isempty(l)
    l = -Inf(nA, 1);            %% ... unbounded below.
end
if isempty(xmin)                %% By default, optimization variables are ...
    xmin = -Inf(nx, 1);         %% ... unbounded below and ...
end
if isempty(xmax)
    xmax = Inf(nx, 1);          %% ... unbounded above.
end
if isempty(x0)
    x0 = zeros(nx, 1);
end

%% default options
if ~isempty(opt) && isfield(opt, 'verbose') && ~isempty(opt.verbose)
    verbose = opt.verbose;
else
    verbose = 0;
end

%% split up linear constraints
ieq = find( abs(u-l) <= eps );          %% equality
igt = find( u >=  1e10 & l > -1e10 );   %% greater than, unbounded above
ilt = find( l <= -1e10 & u <  1e10 );   %% less than, unbounded below
ibx = find( (abs(u-l) > eps) & (u < 1e10) & (l > -1e10) );
Ae = A(ieq, :);
be = u(ieq);
Ai  = [ A(ilt, :); -A(igt, :); A(ibx, :); -A(ibx, :) ];
bi  = [ u(ilt);    -l(igt);    u(ibx);    -l(ibx)];

%% grab some dimensions
nlt = length(ilt);      %% number of upper bounded linear inequalities
ngt = length(igt);      %% number of lower bounded linear inequalities
nbx = length(ibx);      %% number of doubly bounded linear inequalities

%% set up options struct for CPLEX
if ~isempty(opt) && isfield(opt, 'cplex_opt') && ~isempty(opt.cplex_opt)
    cplex_opt = cplex_options(opt.cplex_opt);
else
    cplex_opt = cplex_options;
end

vstr = have_feature('cplex', 'vstr');
vnum = have_feature('cplex', 'vnum');
vrb = max([0 verbose-1]);
if vrb && vnum > 12.002 && vnum < 12.007
    cplex_opt.diagnostics   = 'on';
end
if verbose > 2
    cplex_opt.display = 'iter';
elseif verbose > 1
    cplex_opt.display = 'on';
elseif verbose > 0
    cplex_opt.display = 'off';
end

if isempty(Ai) && isempty(Ae)
    unconstrained = 1;
    Ae = sparse(1, nx);
    be = 0;
else
    unconstrained = 0;
end

%% call the solver
if verbose
    alg_names = {
        'default',
        'primal simplex',
        'dual simplex',
        'network simplex',
        'barrier',
        'sifting',
        'concurrent'
    };
end
if isempty(vtype) || isempty(find(vtype == 'B' | vtype == 'I' | ...
        vtype == 'S' | vtype == 'N'))
    mi = 0;
else
    mi = 1;
    %% expand vtype to nx elements if necessary
    if length(vtype) == 1 && nx > 1
        vtype = char(vtype * ones(1,nx));
    end
end

if mi
    if isempty(H) || ~any(any(H))
        if verbose
            fprintf('CPLEX Version %s -- %s MILP solver\n', ...
                vstr, alg_names{cplex_opt.lpmethod+1});
        end
        [x, f, eflag, output] = ...
            cplexmilp(c, Ai, bi, Ae, be, [], [], [], xmin, xmax, vtype, x0, cplex_opt);
        lam = [];
    else
        if verbose
            fprintf('CPLEX Version %s --  %s MIQP solver\n', ...
                vstr, alg_names{cplex_opt.qpmethod+1});
        end
        %% ensure H is numerically symmetric
        if ~isequal(H, H')
            H = (H + H')/2;
        end
        [x, f, eflag, output] = ...
            cplexmiqp(H, c, Ai, bi, Ae, be, [], [], [], xmin, xmax, vtype, x0, cplex_opt);
    end
    lam = [];
else
    if isempty(H) || ~any(any(H))
        if verbose
            fprintf('CPLEX Version %s -- %s LP solver\n', ...
                vstr, alg_names{cplex_opt.lpmethod+1});
        end
        [x, f, eflag, output, lam] = ...
            cplexlp(c, Ai, bi, Ae, be, xmin, xmax, x0, cplex_opt);
    else
        if verbose
            fprintf('CPLEX Version %s --  %s QP solver\n', ...
                vstr, alg_names{cplex_opt.qpmethod+1});
        end
        %% ensure H is numerically symmetric
        if ~isequal(H, H')
            H = (H + H')/2;
        end
        [x, f, eflag, output, lam] = ...
            cplexqp(H, c, Ai, bi, Ae, be, xmin, xmax, x0, cplex_opt);
    end
end

%% workaround for eflag == 5 (which we have seen return infeasible results)
%%          cplexstatus: 6
%%    cplexstatusstring: 'non-optimal'
%%              message: 'Solution with numerical issues'
if eflag > 1
    warning('qps_cplex: Undocumented ''exitflag'' value (%d)\n          cplexstatus: %d\n    cplexstatusstring: ''%s''\n              message: ''%s''', eflag, output.cplexstatus, output.cplexstatusstring, output.message);
    if eflag == 5 && mi
        eflag = 1;      %% give it a try for the MI phase
    else
        eflag = -100 - eflag;
    end
end

%% check for empty results (in case optimization failed)
if isempty(x)
    x = NaN(nx, 1);
end
if isempty(f)
    f = NaN;
end
if isempty(lam)
    lam.ineqlin = NaN(length(bi), 1);
    lam.eqlin   = NaN(length(be), 1);
    lam.lower   = NaN(nx, 1);
    lam.upper   = NaN(nx, 1);
    mu_l        = NaN(nA, 1);
    mu_u        = NaN(nA, 1);
else
    mu_l        = zeros(nA, 1);
    mu_u        = zeros(nA, 1);
end
if unconstrained
    lam.eqlin = [];
end

%% negate prices depending on version
if vnum < 12.003
    lam.eqlin   = -lam.eqlin;
    lam.ineqlin = -lam.ineqlin;
end

%% repackage lambdas
kl = find(lam.eqlin < 0);   %% lower bound binding
ku = find(lam.eqlin > 0);   %% upper bound binding

mu_l(ieq(kl)) = -lam.eqlin(kl);
mu_l(igt) = lam.ineqlin(nlt+(1:ngt));
mu_l(ibx) = lam.ineqlin(nlt+ngt+nbx+(1:nbx));

mu_u(ieq(ku)) = lam.eqlin(ku);
mu_u(ilt) = lam.ineqlin(1:nlt);
mu_u(ibx) = lam.ineqlin(nlt+ngt+(1:nbx));

lambda = struct( ...
    'mu_l', mu_l, ...
    'mu_u', mu_u, ...
    'lower', lam.lower, ...
    'upper', lam.upper ...
);

if mi && eflag == 1 && (~isfield(opt, 'skip_prices') || ~opt.skip_prices)
    if verbose
        fprintf('--- Integer stage complete, starting price computation stage ---\n');
    end
    if isfield(opt, 'price_stage_warn_tol') && ~isempty(opt.price_stage_warn_tol)
        tol = opt.price_stage_warn_tol;
    else
        tol = 1e-7;
    end
    k = find(vtype == 'I' | vtype == 'B' | vtype == 'N' | ...
            (vtype == 'S' & x' == 0));
    x(k) = round(x(k));
    xmin(k) = x(k);
    xmax(k) = x(k);
    x0 = x;
    opt.cplex_opt.lpmethod = 1;     %% primal simplex
    opt.cplex_opt.qpmethod = 1;     %% primal simplex

    [x_, f_, eflag_, output_, lambda] = qps_cplex(H, c, A, l, u, xmin, xmax, x0, opt);
    if eflag ~= eflag_
        error('miqps_cplex: EXITFLAG from price computation stage = %d', eflag_);
    end
    if abs(f - f_)/max(abs(f), 1) > tol
        warning('miqps_cplex: relative mismatch in objective function value from price computation stage = %g', abs(f - f_)/max(abs(f), 1));
    end
    xn = x;
    xn(abs(xn)<1) = 1;
    [mx, k] = max(abs(x - x_) ./ xn);
    if mx > tol
        warning('miqps_cplex: max relative mismatch in x from price computation stage = %g (%g)', mx, x(k));
    end
    output.price_stage = output_;
end


function [P] = spm_mci_update_cov (P)
% Update covariance matrix of proposal density using Robbins-Monro
% FORMAT [P] = spm_mci_update_cov (P)
%
% See e.g.
% H. Haario, E. Saksman, and J. Tamminen. An adaptive Metropolis algorithm.
% Bernoulli, 7(2):223-242, 2001.
%__________________________________________________________________________
% Copyright (C) 2015 Wellcome Trust Centre for Neuroimaging

% Will Penny
% $Id: spm_mci_update_cov.m 7679 2019-10-24 15:54:07Z spm $

Np=size(P.theta,1);
gamma=1/P.adapt_its;

x=P.theta(:,end);
dx=x-P.mu;

P.mu=P.mu+gamma*dx;
P.Ct=P.Ct+gamma*(dx*dx'-P.Ct);


function d = bpdhe(im)

im = im2uint8(im);

hsv = rgb2hsv(im);
h = hsv(:,:,1);
s = hsv(:,:,2);
i = uint8(hsv(:,:,3).*255);
% i = uint8(20+rand(512).*(200));
ma = double(max(i(:)));
mi = double(min(i(:)));
bins = (ma-mi)+1;
hist_i = hist(double(i(:)),bins);
gausFilter = fspecial('gaussian',[1 9],1.0762);
blur_hist = (imfilter(hist_i,gausFilter,'replicate'));
derivFilter = [-1 1];
deriv_hist = imfilter(blur_hist,derivFilter,'replicate');
sign_hist = sign(deriv_hist);
meanFilter = [1/3 1/3 1/3];
smooth_sign_hist = sign(imfilter(sign_hist,meanFilter,'replicate'));
cmpFilter = [1 1 1  -1 -1 -1 -1 -1];
index = zeros([1,3]);
index(1) = 0;
p = 2;
for n = 1:bins-7
    C = smooth_sign_hist(n:n+7) == cmpFilter;
    if sum(C) ==8
        index(p) = n+3;
        p = p+1;
    end
end
index(p) = bins;
factor = zeros([length(index)-1,1]);
span = factor;
M = factor;
range = factor;
start = factor;
endd = factor;
sub_hist = cell([length(index)-1,1]);
for m = 1:length(index)-1;
    sub_hist{m} = hist_i(index(m)+1:index(m+1));
    M(m) = sum(sub_hist{m});
    low = mi + index(m);
    high = mi + index(m+1)-1;
    span(m) = high-low+1;
    factor(m) = span(m)*log10(M(m));
end
factor_sum = sum(factor);
for m = 1:length(index)-1;
    range(m) = round((256-mi)*factor(m)/factor_sum);
end
start(1) = mi;
endd(1) = mi+range(1)-1;
for m = 2:length(index)-1;
    start(m) = start(m-1)+range(m-1);
    endd(m) = endd(m-1)+range(m);
end
y = cell([length(index)-1,1]);
s_r = zeros([1,mi]);
for m = 1:length(index)-1;
    hist_cum = cumsum(sub_hist{m});
    c = hist_cum./M(m);
    y{m} = round(start(m)+(endd(m)-start(m)).*c);
    s_r = [s_r,y{m}];
end
i_s = zeros(size(i));
for n = mi:ma
    lc = i == n;
    i_s(lc) = double(s_r(n+1))/255;
end
% hist_is = hist(double(i_s(:)),bins);
hsi_o = cat(3,h,s,i_s);
d = uint8(hsv2rgb(hsi_o).*255);


function combo_test21 ( )

%*****************************************************************************80
%
%% COMBO_TEST21 tests NPART_TABLE and PART_TABLE.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 January 2011
%
%  Author:
%
%    John Burkardt
%
  maxn = 10;
  maxpart = 5;

  fprintf ( 1, ' \n' );
  fprintf ( 1, 'COMBO_TEST21\n' );
  fprintf ( 1, '  NPART_TABLE tabulates partitions\n' );
  fprintf ( 1, '  of N with NPART parts;\n' );
  fprintf ( 1, '  PART_TABLE tabulates partitions of N.\n' );

  offset = 1;

  p = npart_table ( maxn, maxpart );

  p2 = part_table ( maxn );

  fprintf ( 1, ' \n' );
  fprintf ( 1, '    I P(I)  P(I,0) P(I,1) P(I,2) P(I,3) P(I,4) P(I,5)\n' );
  fprintf ( 1, ' \n' );

  for i = 0 : maxn
    fprintf ( 1, '%5d%5d', i, p2(i+offset) );
    for j = 0 : maxpart
      fprintf ( 1, '%5d', p(i+offset,j+offset) );
    end
    fprintf ( 1, '\n' );
  end

  return
end


close all;
clear all;
clc;
png_export = true;
pdf_export = false;

load('bin/rand_dict_bp_omp_success_with_k_figure_1.mat');

mf = spx.graphics.Figures();

mf.new_figure('Recovery probability with K');
hold all;
plot(Ks, bp_success_with_k);
plot(Ks, omp_success_with_k);
xlabel('Sparsity level');
ylabel('probability of successful recovery');
legend('BP', 'OMP');
grid on;