%% DEMO_febio_0055_clot_tube_slide_pressure.m
% Below is a demonstration for:
%
% * Building geometry for a spherical blob with tetrahedral elements
% which is being aspirated into a tube.
% This demo consists off:
% * Defining the boundary conditions
% * Coding the febio structure
% * Running the model
% * Importing and visualizing the displacement results

%% Keywords
%
% * febio_spec version 3.0
% * febio, FEBio
% * blood clot
% * contact, sliding, friction
% * rigid body constraints
% * hexahedral elements, hex8
% * quadrilaterl elements, quad4
% * shell elements
% * sphere
% * hyperelastic, Ogden
% * displacement logfile
% * stress logfile

%%

clear; close all; clc;

%% Plot settings
fontSize=15;
faceAlpha1=0.8;
faceAlpha2=0.3;
markerSize=40;
lineWidth=3;
cMap=[1 0.5 0.4; 0.9 0.3 0.27; 0.8 0.2 0.18; 0.7 0.1 0.09; 0.6 0 0; 0.5 0 0; 0.4 0 0;];
[cMap]=resampleColormap(cMap,250);

%% Control parameters

% Path names
defaultFolder = fileparts(fileparts(mfilename('fullpath')));
savePath=fullfile(defaultFolder,'data','temp');

% Defining file names
febioFebFileNamePart='tempModel';
febioFebFileName=fullfile(savePath,[febioFebFileNamePart,'.feb']); %FEB file name
febioLogFileName=fullfile(savePath,[febioFebFileNamePart,'.txt']); %FEBio log file name
febioLogFileName_disp=[febioFebFileNamePart,'_disp_out.txt']; %Log file name for exporting displacement
febioLogFileName_strainEnergy=[febioFebFileNamePart,'_energy_out.txt']; %Log file name for exporting strain energy density

% Sphere parameters
sphereRadius=3;%
numElementsMantel=6;

% Ground plate parameters
tubeRadius=sphereRadius.*[1 0.1];
tubeAngle=3*(pi/180);
tubeLength=abs(diff(tubeRadius))/tan(tubeAngle);

% Material parameter set
c1=1e-4; %Shear-modulus-like parameter MPa
m1=2; %Material parameter setting degree of non-linearity
k_factor=10; %Bulk modulus factor
k=c1*k_factor; %Bulk modulus
d=1e-9; %Density

% FEA control settings
max_refs=25; %Max reforms
max_ups=0; %Set to zero to use full-Newton iterations
opt_iter=15; %Optimum number of iterations
max_retries=25; %Maximum number of retires
symmetric_stiffness=0;
min_residual=1e-20;

timeTotal=1; %Analysis time
numTimeSteps=100; %Number of time steps desired
step_size=timeTotal/numTimeSteps;
dtmin=(timeTotal/numTimeSteps)/100; %Minimum time step size
dtmax=(timeTotal/numTimeSteps)*10; %Maximum time step size
analysisType='DYNAMIC';

%Contact parameters
contactPenalty=10;
laugon=0;
minaug=1;
maxaug=10;
fric_coeff=0.1;

%Specifying load
pressureValue=7.5e-5;

%% Creating model geometry and mesh
%

%Control settings
cPar.sphereRadius=sphereRadius;
cPar.coreRadius=cPar.sphereRadius/2;
cPar.numElementsMantel=numElementsMantel;
cPar.numElementsCore=round(numElementsMantel*1.5);
cPar.outputStructType=2;
cPar.makeHollow=0;
cPar.cParSmooth.n=25;

%Creating sphere
[meshOutput]=hexMeshSphere(cPar);

% Access model element and patch data
Fb_blob=meshOutput.facesBoundary;
Cb_blob=meshOutput.boundaryMarker;
V_blob=meshOutput.nodes;
E_blob=meshOutput.elements;

%%
% Visualize blob mesh

hFig=cFigure;
subplot(1,2,1); hold on;
gpatch(Fb_blob,V_blob,Cb_blob,'k',0.8);
patchNormPlot(Fb_blob,V_blob);
axisGeom(gca,fontSize);
colormap(gjet); icolorbar;
camlight headlight;

hs=subplot(1,2,2); hold on;
title('Cut view of solid mesh','FontSize',fontSize);
optionStruct.hFig=[hFig hs];
gpatch(Fb_blob,V_blob,'kw','none',0.25);
meshView(meshOutput,optionStruct);
axisGeom(gca,fontSize);
drawnow;

%% Creating tube model
%

pointSpacingBlob=mean(patchEdgeLengths(Fb_blob,V_blob));
pointSpacingTube=pointSpacingBlob;

rEnd=sphereRadius+(sphereRadius.*((sphereRadius-tubeRadius(2))/tubeLength));
V_curve_tube=[sphereRadius rEnd 0; -tubeLength tubeRadius(2) 0;];

nResample=ceil(max(pathLength(V_curve_tube))./pointSpacingTube);
V_curve_tube=evenlySampleCurve(V_curve_tube,nResample,'pchip',0);

cPar.closeLoopOpt=1;
cPar.numSteps=[]; %If empty the number of steps is derived from point spacing of input curve
cPar.w=[1 0 0];
[F_tube,V_tube]=polyRevolve(V_curve_tube,cPar);
[F_tube,V_tube]=mergeVertices(F_tube,V_tube);
center_of_mass_tube=mean(V_tube,1);

%% Join model node sets

V=[V_blob; V_tube; ];
F_tube=F_tube+size(V_blob,1);

%%
% Visualizing model

cFigure; hold on;
gtitle('Model components',fontSize);
hl(1)=gpatch(Fb_blob,V,'rw','k',0.8);
hl(2)=gpatch(F_tube,V,'kw','k',0.5);
legend(hl,{'Blob','Tube'}); clear hl;
axisGeom(gca,fontSize);
camlight headlight;
drawnow;

%% Get contact surfaces
%

F_contact_blob=Fb_blob;

%%
% Visualize contact surfaces

cFigure; hold on;
title('Tube blob contact pair','fontsize',fontSize);
hl(1)=gpatch(F_tube,V,'rw','k',0.8);
patchNormPlot(F_tube,V);
hl(2)=gpatch(F_contact_blob,V,'kw','k',0.5);
patchNormPlot(F_contact_blob,V);
legend(hl,{'Master','Slave'}); clear hl;
axisGeom(gca,fontSize);
camlight headlight;
drawnow;

%% Get pressure surface

N=patchNormal(F_contact_blob,V);
x=[1 0 0];
D=dot(N,x(ones(size(N,1),1),:),2);

logicFace=D>-1e-6; %Logic for current face set
F_pressure=F_contact_blob(logicFace,:); %The current face set

%%
% Visualizing boundary conditions. Markers plotted on the semi-transparent
% model denote the nodes in the various boundary condition lists.

cFigure; hold on;
title('Pressure surface','fontsize',fontSize);

gpatch(F_pressure,V,'kw','k',0.5);
patchNormPlot(F_pressure,V);

% legend(hl,{'Master','Slave'}); clear hl;
axisGeom(gca,fontSize);
camlight headlight;
drawnow;

%% Defining the FEBio input structure
% See also |febioStructTemplate| and |febioStruct2xml| and the FEBio user
% manual.

%Get a template with default settings
[febio_spec]=febioStructTemplate;

%febio_spec version
febio_spec.ATTR.version='3.0';

%Module section
febio_spec.Module.ATTR.type='solid';

%Control section
febio_spec.Control.analysis=analysisType;
febio_spec.Control.time_steps=numTimeSteps;
febio_spec.Control.step_size=timeTotal/numTimeSteps;
febio_spec.Control.solver.max_refs=max_refs;
febio_spec.Control.solver.max_ups=max_ups;
febio_spec.Control.solver.symmetric_stiffness=symmetric_stiffness;
febio_spec.Control.time_stepper.dtmin=dtmin;
febio_spec.Control.time_stepper.dtmax=dtmax;
febio_spec.Control.time_stepper.max_retries=max_retries;
febio_spec.Control.time_stepper.opt_iter=opt_iter;

%Material section
materialName1='Material1';
febio_spec.Material.material{1}.ATTR.name=materialName1;
febio_spec.Material.material{1}.ATTR.type='Ogden unconstrained';
febio_spec.Material.material{1}.ATTR.id=1;
febio_spec.Material.material{1}.c1=c1;
febio_spec.Material.material{1}.m1=m1;
febio_spec.Material.material{1}.c2=c1;
febio_spec.Material.material{1}.m2=-m1;
febio_spec.Material.material{1}.cp=k;
febio_spec.Material.material{1}.density=d;

materialName2='Material2';
febio_spec.Material.material{2}.ATTR.name=materialName2;
febio_spec.Material.material{2}.ATTR.type='rigid body';
febio_spec.Material.material{2}.ATTR.id=2;
febio_spec.Material.material{2}.density=1;
febio_spec.Material.material{2}.center_of_mass=center_of_mass_tube;

%Mesh section
% -> Nodes
febio_spec.Mesh.Nodes{1}.ATTR.name='nodeSet_all'; %The node set name
febio_spec.Mesh.Nodes{1}.node.ATTR.id=(1:size(V,1))'; %The node id's
febio_spec.Mesh.Nodes{1}.node.VAL=V; %The nodel coordinates

% -> Elements
partName1='Part1';
febio_spec.Mesh.Elements{1}.ATTR.name=partName1; %Name of this part
febio_spec.Mesh.Elements{1}.ATTR.type='hex8'; %Element type
febio_spec.Mesh.Elements{1}.elem.ATTR.id=(1:1:size(E_blob,1))'; %Element id's
febio_spec.Mesh.Elements{1}.elem.VAL=E_blob; %The element matrix

partName2='Part2';
febio_spec.Mesh.Elements{2}.ATTR.name=partName2; %Name of this part
febio_spec.Mesh.Elements{2}.ATTR.type='quad4'; %Element type
febio_spec.Mesh.Elements{2}.elem.ATTR.id=size(E_blob,1)+(1:1:size(F_tube,1))'; %Element id's
febio_spec.Mesh.Elements{2}.elem.VAL=F_tube; %The element matrix

% -> Surfaces
surfaceName1='Surface1_contact';
febio_spec.Mesh.Surface{1}.ATTR.name=surfaceName1;
febio_spec.Mesh.Surface{1}.quad4.ATTR.id=(1:1:size(F_tube,1))';
febio_spec.Mesh.Surface{1}.quad4.VAL=F_tube;

surfaceName2='Surface2_contact';
febio_spec.Mesh.Surface{2}.ATTR.name=surfaceName2;
febio_spec.Mesh.Surface{2}.quad4.ATTR.id=(1:1:size(F_contact_blob,1))';
febio_spec.Mesh.Surface{2}.quad4.VAL=F_contact_blob;

surfaceName3='Surface3_pressure';
febio_spec.Mesh.Surface{3}.ATTR.name=surfaceName3;
febio_spec.Mesh.Surface{3}.quad4.ATTR.id=(1:1:size(F_pressure,1))';
febio_spec.Mesh.Surface{3}.quad4.VAL=F_pressure;

% -> Surface pairs
contactPairName='Contact1';
febio_spec.Mesh.SurfacePair{1}.ATTR.name=contactPairName;
febio_spec.Mesh.SurfacePair{1}.primary=surfaceName2;
febio_spec.Mesh.SurfacePair{1}.secondary=surfaceName1;

%MeshDomains section
febio_spec.MeshDomains.SolidDomain.ATTR.name=partName1;
febio_spec.MeshDomains.SolidDomain.ATTR.mat=materialName1;

febio_spec.MeshDomains.ShellDomain.ATTR.name=partName2;
febio_spec.MeshDomains.ShellDomain.ATTR.mat=materialName2;

%Loads
febio_spec.Loads.surface_load{1}.ATTR.type='pressure';
febio_spec.Loads.surface_load{1}.ATTR.surface=surfaceName3;
febio_spec.Loads.surface_load{1}.pressure.ATTR.lc=1;
febio_spec.Loads.surface_load{1}.pressure.VAL=pressureValue;
febio_spec.Loads.surface_load{1}.symmetric_stiffness=1;

%Rigid section
% -> Prescribed rigid body boundary conditions
febio_spec.Rigid.rigid_constraint{1}.ATTR.name='RigidFix_1';
febio_spec.Rigid.rigid_constraint{1}.ATTR.type='fix';
febio_spec.Rigid.rigid_constraint{1}.rb=2;
febio_spec.Rigid.rigid_constraint{1}.dofs='Rx,Ry,Rz,Ru,Rv,Rw';

%Contact section
febio_spec.Contact.contact{1}.ATTR.type='sliding-elastic';
febio_spec.Contact.contact{1}.ATTR.surface_pair=contactPairName;
febio_spec.Contact.contact{1}.two_pass=0;
febio_spec.Contact.contact{1}.laugon=laugon;
febio_spec.Contact.contact{1}.tolerance=0.2;
febio_spec.Contact.contact{1}.gaptol=0;
febio_spec.Contact.contact{1}.minaug=minaug;
febio_spec.Contact.contact{1}.maxaug=maxaug;
febio_spec.Contact.contact{1}.search_tol=0.01;
febio_spec.Contact.contact{1}.search_radius=0.01*sqrt(sum((max(V,[],1)-min(V,[],1)).^2,2));
febio_spec.Contact.contact{1}.symmetric_stiffness=0;
febio_spec.Contact.contact{1}.auto_penalty=1;
febio_spec.Contact.contact{1}.penalty=contactPenalty;
febio_spec.Contact.contact{1}.fric_coeff=fric_coeff;

%LoadData section
% -> load_controller
febio_spec.LoadData.load_controller{1}.ATTR.id=1;
febio_spec.LoadData.load_controller{1}.ATTR.type='loadcurve';
febio_spec.LoadData.load_controller{1}.interpolate='LINEAR';
febio_spec.LoadData.load_controller{1}.points.point.VAL=[0 0; 1 1];

%Output section
% -> log file
febio_spec.Output.logfile.ATTR.file=febioLogFileName;
febio_spec.Output.logfile.node_data{1}.ATTR.file=febioLogFileName_disp;
febio_spec.Output.logfile.node_data{1}.ATTR.data='ux;uy;uz';
febio_spec.Output.logfile.node_data{1}.ATTR.delim=',';

febio_spec.Output.logfile.element_data{1}.ATTR.file=febioLogFileName_strainEnergy;
febio_spec.Output.logfile.element_data{1}.ATTR.data='sed';
febio_spec.Output.logfile.element_data{1}.ATTR.delim=',';
febio_spec.Output.logfile.element_data{1}.VAL=1:size(E_blob,1);

%% Quick viewing of the FEBio input file structure
% The |febView| function can be used to view the xml structure in a MATLAB
% figure window.

%%
% |febView(febio_spec); %Viewing the febio file|

%% Exporting the FEBio input file
% Exporting the febio_spec structure to an FEBio input file is done using
% the |febioStruct2xml| function.

febioStruct2xml(febio_spec,febioFebFileName); %Exporting to file and domNode

%% Running the FEBio analysis
% To run the analysis defined by the created FEBio input file the
% |runMonitorFEBio| function is used. The input for this function is a
% structure defining job settings e.g. the FEBio input file name. The
% optional output runFlag informs the user if the analysis was run
% succesfully.

febioAnalysis.run_filename=febioFebFileName; %The input file name
febioAnalysis.run_logname=febioLogFileName; %The name for the log file
febioAnalysis.disp_on=1; %Display information on the command window
febioAnalysis.runMode='external';%'internal';

[runFlag]=runMonitorFEBio(febioAnalysis);%START FEBio NOW!!!!!!!!

%% Import FEBio results

if 1%runFlag==1 %i.e. a succesful run

    % Importing nodal displacements from a log file
    [time_mat, N_disp_mat,~]=importFEBio_logfile(fullfile(savePath,febioLogFileName_disp)); %Nodal displacements
    time_mat=[0; time_mat(:)]; %Time

    N_disp_mat=N_disp_mat(:,2:end,:);
    sizImport=size(N_disp_mat);
    sizImport(3)=sizImport(3)+1;
    N_disp_mat_n=zeros(sizImport);
    N_disp_mat_n(:,:,2:end)=N_disp_mat;
    N_disp_mat=N_disp_mat_n;
    DN=N_disp_mat(:,:,end);
    DN_magnitude=sqrt(sum(DN.^2,2));
    V_def=V+DN;
    V_DEF=N_disp_mat+repmat(V,[1 1 size(N_disp_mat,3)]);
    X_DEF=V_DEF(:,1,:);
    Y_DEF=V_DEF(:,2,:);
    Z_DEF=V_DEF(:,3,:);
    %     [CF]=vertexToFaceMeasure(Fb_all,DN_magnitude);

    %%
    % Importing element strain energies from a log file
    [~,E_energy,~]=importFEBio_logfile(fullfile(savePath,febioLogFileName_strainEnergy)); %Element stresses

    %Remove nodal index column
    E_energy=E_energy(:,2:end,:);

    %Add initial state i.e. zero displacement
    sizImport=size(E_energy);
    sizImport(3)=sizImport(3)+1;
    E_energy_mat_n=zeros(sizImport);
    E_energy_mat_n(:,:,2:end)=E_energy;
    E_energy=E_energy_mat_n;

    %%

    indBlob=unique(Fb_blob(:));
    t=linspace(0,2*pi,250)';

    V_def_blob=V(indBlob,:)+N_disp_mat(indBlob,:,end);

    [~,indMin]=min(V_def_blob(:,1));
    [~,indMax]=max(V_def_blob(:,1));

    xEnd=V_def_blob(indMin,1);
    xStart=V_def_blob(indMax,1);
    rEnd=sphereRadius+(xEnd.*((sphereRadius-tubeRadius(2))/tubeLength));
    rStart=sphereRadius+(xStart.*((sphereRadius-tubeRadius(2))/tubeLength));

    xMid=mean([xStart xEnd]);%sum([rStart rEnd].*[xStart xEnd])./sum([rStart rEnd]);
    rMid=sphereRadius+(xMid.*((sphereRadius-tubeRadius(2))/tubeLength));

    V_plot_xEnd=[xEnd*ones(size(t)) rEnd*cos(t) rEnd*sin(t)];
    V_plot_xMid=[xMid*ones(size(t)) rMid*cos(t) rMid*sin(t)];
    V_plot_xStart=[xStart*ones(size(t)) rStart*cos(t) rStart*sin(t)];

   %%
    % Plotting the simulated results using |anim8| to visualize and animate
    % deformations

    % Create basic view and store graphics handle to initiate animation
    hf=cFigure; hold on;
    ht=gtitle(['Radial stretch: ',num2str(rMid/sphereRadius)]);
    hp1=gpatch(Fb_blob,V_def,DN_magnitude,'none',1); %Add graphics object to animate

    hp2=plotV(V_plot_xEnd  ,'r-','LineWidth',3);
    hp3=plotV(V_plot_xMid  ,'r-','LineWidth',3);
    hp4=plotV(V_plot_xStart,'r-','LineWidth',3);

    gpatch(F_tube,V_def,'kw','none',0.25); %Add graphics object to animate
    axisGeom(gca,fontSize);
    colormap(cMap); colorbar;
    caxis([0 max(DN_magnitude(:))]); caxis manual;
    axis([min(X_DEF(:)) max(X_DEF(:)) min(Y_DEF(:)) max(Y_DEF(:)) min(Z_DEF(:)) max(Z_DEF(:))]);
    camlight headlight; lighting gouraud;
    view(0,0);
%     view(-30,30); zoom(1.5);
    axis off;
    drawnow;

    LMid=1;

    % Set up animation features
    animStruct.Time=time_mat; %The time vector
    for qt=1:1:size(N_disp_mat,3) %Loop over time increments
        DN=N_disp_mat(:,:,qt); %Current displacement
        DN_magnitude=sqrt(sum(DN.^2,2));
        V_def=V+DN; %Current nodal coordinates

        V_def_blob=V_def(indBlob,:);
        [~,indMin]=min(V_def_blob(:,1));
        [~,indMax]=max(V_def_blob(:,1));

        xEnd=V_def_blob(indMin,1);
        xStart=V_def_blob(indMax,1);
        rEnd=sphereRadius+(xEnd.*((sphereRadius-tubeRadius(2))/tubeLength));
        rStart=sphereRadius+(xStart.*((sphereRadius-tubeRadius(2))/tubeLength));

        xMid=mean([xStart xEnd]);%sum([rStart rEnd].*[xStart xEnd])./sum([rStart rEnd]);
        rMid=sphereRadius+(xMid.*((sphereRadius-tubeRadius(2))/tubeLength));

        LMid=min(LMid,rMid/sphereRadius);

        V_plot_xEnd=[xEnd*ones(size(t)) rEnd*cos(t) rEnd*sin(t)];
        V_plot_xMid=[xMid*ones(size(t)) rMid*cos(t) rMid*sin(t)];
        V_plot_xStart=[xStart*ones(size(t)) rStart*cos(t) rStart*sin(t)];

        %Set entries in animation structure
        animStruct.Handles{qt}=[hp1 hp1 hp2 hp2 hp2 hp3 hp3 hp3 hp4 hp4 hp4 ht]; %Handles of objects to animate
        animStruct.Props{qt}={'Vertices','CData','XData','YData','ZData','XData','YData','ZData','XData','YData','ZData','String'}; %Properties of objects to animate
        animStruct.Set{qt}={V_def,DN_magnitude,...
            V_plot_xEnd(:,1),V_plot_xEnd(:,2),V_plot_xEnd(:,3),...
            V_plot_xMid(:,1),V_plot_xMid(:,2),V_plot_xMid(:,3),...
            V_plot_xStart(:,1),V_plot_xStart(:,2),V_plot_xStart(:,3),...
            ['Radial stretch: ',num2str(rMid/sphereRadius)]}; %Property values for to set in order to animate
    end
    anim8(hf,animStruct); %Initiate animation feature

    drawnow;

end

%%
%
% <<gibbVerySmall.gif>>
%
% _*GIBBON*_
% <www.gibboncode.org>
%
% _Kevin Mattheus Moerman_, <gibbon.toolbox@gmail.com>

%%
% _*GIBBON footer text*_
%
% License: <https://github.com/gibbonCode/GIBBON/blob/master/LICENSE>
%
% GIBBON: The Geometry and Image-based Bioengineering add-On. A toolbox for
% image segmentation, image-based modeling, meshing, and finite element
% analysis.
%
% Copyright (C) 2006-2022 Kevin Mattheus Moerman and the GIBBON contributors
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program.  If not, see <http://www.gnu.org/licenses/>.


function [SE_MR,SE_MR_asymptotic] = functionComputeSE_DL_MR_impairments(channelGainOverNoise,tau_c,M,K,L,p,rho,f,kappatUE,kapparBS,kappatBS,kapparUE)
%Compute DL SE for different transmit precoding schemes using Corollary
%6.6.
%
%INPUT:
%channelGainOverNoise = K x L x L matrix containing the average channel
%                       gains normalized by the noise variance of al
%                       channels (in dB). channelGainOverNoise(k,j,l) is
%                       the channel gain between between UE k in cell j
%                       and BS l
%tau_c                = Length of coherence block
%M                    = Number of antennas per BS
%K                    = Number of UEs per cell
%L                    = Number of BSs and cells
%p                    = Uplink transmit power per UE (same for everyone)
%rho                  = Downlink transmit power per UE (same for everyone)
%f                    = Pilot reuse factor
%kappatUE             = Hardware quality of the UEs' transmitters
%kapparBS             = Hardware quality of the BSs' receivers
%kappatBS             = Hardware quality of the BSs' transmitters
%kapparUE             = Hardware quality of the UEs' receivers
%
%OUTPUT:
%SE_MR            = K x L matrix where element (k,l) is the downlink SE of
%                   UE k in cell l achieved with MR precoding
%SE_MR_asymptotic = K x L matrix where element (k,l) is the asymptotic
%                   downlink SE of UE k in cell l achieved with MR precoding
%
%
%This Matlab function was developed to generate simulation results to:
%
%Emil Bjornson, Jakob Hoydis and Luca Sanguinetti (2017),
%"Massive MIMO Networks: Spectral, Energy, and Hardware Efficiency",
%Foundations and Trends in Signal Processing: Vol. 11, No. 3-4,
%pp. 154-655. DOI: 10.1561/2000000093.
%
%For further information, visit: https://www.massivemimobook.com
%
%This is version 1.0 (Last edited: 2017-11-04)
%
%License: This code is licensed under the GPLv2 license. If you in any way
%use this code for research that results in publications, please cite our
%monograph as described above.

%Initiate the hardware qualities as perfect if these are not given as input
if nargin<9
    kappatUE = 1;
end

if nargin<10
    kapparBS = 1;
end

if nargin<11
    kappatBS = 1;
end

if nargin<12
    kapparUE = 1;
end

%Transform the (normalized) average channel gains from dB to linear scale
betaValues = 10.^(channelGainOverNoise/10);

%Compute length of pilot sequences
tau_p = f*K;

%Generate pilot pattern
if f == 1

    pilotPattern = ones(L,1);

elseif f == 2 %Only works in the running example with its 16 BSs

    pilotPattern = kron(ones(2,1),[1; 2; 1; 2; 2; 1; 2; 1]);

elseif f == 4 %Only works in the running example with its 16 BSs

    pilotPattern = kron(ones(2,1),[1; 2; 1; 2; 3; 4; 3; 4]);

elseif f == 16 %Only works in the running example with its 16 BSs

    pilotPattern = (1:L)';

end

%Prepare to store signal and interference terms for all UEs
signalTerm = zeros(K,L);
interferenceTerm = zeros(K,L);

%If the asymptotic SE should be computed
if nargout>1

    signalTerm_asymptotic = zeros(K,L);
    interferenceTerm_asymptotic = zeros(K,L);

end

%% Go through all cells
for j = 1:L

    %Compute the parameter in (6.50)
    G = (1 + kappatBS*(M-1))/(M*kappatBS*kapparUE);

    %Go through all UEs
    for k = 1:K

        %Extract cells that use same pilots as cell j
        groupMembers = find(pilotPattern==pilotPattern(j))';

        %Compute the parameter in (6.38)
        psi_jk = 1/( p*kappatUE*kapparBS*tau_p*sum(betaValues(k,groupMembers,j)) + p*(1-kappatUE*kapparBS)*sum(sum(betaValues(:,:,j))) + 1 );

        %Compute the numerator of (6.47)
        signalTerm(k,j) = rho*p*(betaValues(k,j,j))^2*tau_p*psi_jk*M;

        %Compute parameter in (6.49)
        Flijk = (1+p*betaValues(:,:,j)*psi_jk*( 1 - kappatUE*kapparBS + (1-kappatUE)*kappatBS*kapparBS*(M-1) ))/(kappatBS*kapparUE*kappatUE*kapparBS);

        %Compute the non-coherent interference that UE k in cell j causes
        %to all the UEs, which is a part of the first term in the
        %denominator of (6.47)
        interferenceTerm = interferenceTerm + rho*betaValues(:,:,j).*Flijk;

        %Compute the coherent interference that UE k in cell j causes to
        %all the pilot-sharing UEs, which is a part of the second term in
        %the denominator of (6.47)
        interferenceTerm(k,groupMembers) = interferenceTerm(k,groupMembers) + rho*p*(betaValues(k,groupMembers,j)).^2*tau_p*psi_jk*M*G;

        %Compute the last two terms in the denominator of (6.47)
        interferenceTerm(k,j) = interferenceTerm(k,j) - signalTerm(k,j) + 1/(kappatUE*kapparBS*kappatBS*kapparUE);

        %If the asymptotic SE in (6.51) should be computed
        if nargout>1

            %Compute the numerator of (6.51), multiplied with psi_jk
            signalTerm_asymptotic(k,j) = rho*(betaValues(k,j,j))^2*psi_jk;

            %Compute the part of the first term in the denominator of
            %(6.51) that UE k in cell j contributes to
            interferenceTerm_asymptotic = interferenceTerm_asymptotic + rho*(betaValues(:,:,j)).^2*psi_jk*(1-kappatUE)/(kappatUE*kapparUE*tau_p);

            %Compute the part of the second term in the denominator of
            %(6.51) that UE k in cell j contributes to
            interferenceTerm_asymptotic(k,groupMembers) = interferenceTerm_asymptotic(k,groupMembers) +  rho*(betaValues(k,groupMembers,j)).^2*psi_jk/kapparUE;

            %Subtract the numerator from the denominator, which is an
            %alternative way of obtaining the third term in the denominator
            interferenceTerm_asymptotic(k,j) = interferenceTerm_asymptotic(k,j) - rho*(betaValues(k,j,j))^2*psi_jk;

        end

    end

end

%Compute the prelog factor assuming only downlink transmission
prelogFactor = (tau_c-tau_p)/tau_c;

%Compute the final SE expression based on Corollary 6.6
SE_MR = prelogFactor * log2(1+signalTerm ./ real(interferenceTerm));

if nargout>1

    %Compute the final asymptotic SE expression based on Corollary 6.7
    SE_MR_asymptotic = prelogFactor * log2(1+signalTerm_asymptotic ./ real(interferenceTerm_asymptotic));

end


% tHis subroutine assigns creates a grid with
% spacing dx,dy (in degreees). The size will
% be selected interactiVELY. The bvalue in each
% volume around a grid point containing ni earthquakes
% will be calculated as well as the magnitude
% of completness
%   Stefan Wiemer 1/95

report_this_filefun(mfilename('fullpath'));

global no1 bo1 inb1 inb2

if sel == 'in'
    % get the grid parameter
    % initial values
    %
    dd = 1.00;
    dx = 1.00 ;
    ni = 100;
    ra = 5;

    % make the interface
    %
    figure_w_normalized_uicontrolunits(...
        'Name','Grid Input Parameter',...
        'NumberTitle','off', ...
        'MenuBar','none', ...
        'units','points',...
        'Visible','off', ...
        'Position',[ wex+200 wey-200 550 300]);
    axis off

    labelList2=['Weighted LS - automatic Mcomp | Weighted LS - no automatic Mcomp '];
    labelPos = [0.2 0.7  0.6  0.08];
    hndl2=uicontrol(...
        'Style','popup',...
        'Position',labelPos,...
        'Units','normalized',...
        'String',labelList2,...
        'Callback','inb2 =get(hndl2,''Value''); ');

    labelList=['Maximum likelihood - automatic Mcomp | Maximum likelihood  - no automatic Mcomp '];
    labelPos = [0.2 0.8  0.6  0.08];
    hndl1=uicontrol(...
        'Style','popup',...
        'Position',labelPos,...
        'Units','normalized',...
        'String',labelList,...
        'Callback','inb1 =get(hndl1,''Value''); ');

    % creates a dialog box to input grid parameters
    %
    freq_field=uicontrol('Style','edit',...
        'Position',[.60 .50 .22 .10],...
        'Units','normalized','String',num2str(ra),...
        'Callback','ra=str2double(get(freq_field,''String'')); set(freq_field,''String'',num2str(ra));');

    freq_field2=uicontrol('Style','edit',...
        'Position',[.60 .40 .22 .10],...
        'Units','normalized','String',num2str(dx),...
        'Callback','dx=str2double(get(freq_field2,''String'')); set(freq_field2,''String'',num2str(dx));');

    freq_field3=uicontrol('Style','edit',...
        'Position',[.60 .30 .22 .10],...
        'Units','normalized','String',num2str(dd),...
        'Callback','dd=str2double(get(freq_field3,''String'')); set(freq_field3,''String'',num2str(dd));');

    close_button=uicontrol('Style','Pushbutton',...
        'Position',[.60 .05 .15 .12 ],...
        'Units','normalized','Callback','close;done','String','Cancel');

    go_button1=uicontrol('Style','Pushbutton',...
        'Position',[.20 .05 .15 .12 ],...
        'Units','normalized',...
        'Callback','inb1 =get(hndl1,''Value'');inb2 =get(hndl2,''Value'');close,sel =''ca'', bcrossVt',...
        'String','Go');

    text(...
        'Color',[0 0 0 ],...
        'EraseMode','normal',...
        'Position',[0.20 1.0 0 ],...
        'Rotation',0 ,...
        'FontSize',ZmapGlobal.Data.fontsz.l ,...
        'FontWeight','bold',...
        'String','Automatically estimate magn. of completeness?   ');

    txt3 = text(...
        'Color',[0 0 0 ],...
        'EraseMode','normal',...
        'Position',[0.30 0.65 0 ],...
        'Rotation',0 ,...
        'FontSize',ZmapGlobal.Data.fontsz.l ,...
        'FontWeight','bold',...
        'String',' Grid Parameter');
    txt5 = text(...
        'Color',[0 0 0 ],...
        'EraseMode','normal',...
        'Position',[0. 0.42 0 ],...
        'Rotation',0 ,...
        'FontSize',ZmapGlobal.Data.fontsz.m ,...
        'FontWeight','bold',...
        'String','Spacing along projection [km]');

    txt6 = text(...
        'Color',[0 0 0 ],...
        'EraseMode','normal',...
        'Position',[0. 0.32 0 ],...
        'Rotation',0 ,...
        'FontSize',ZmapGlobal.Data.fontsz.m ,...
        'FontWeight','bold',...
        'String','Spacing in depth in km:');

    txt1 = text(...
        'Color',[0 0 0 ],...
        'EraseMode','normal',...
        'Position',[0. 0.53 0 ],...
        'Rotation',0 ,...
        'FontSize',ZmapGlobal.Data.fontsz.m,...
        'FontWeight','bold',...
        'String','Radius in km');

    set(gcf,'visible','on');
    watchoff

end   % if sel == in

% get the grid-size interactively and
% calculate the b-value in the grid by sorting
% thge seimicity and selectiong the ni neighbors
% to each grid point

if sel == 'ca'

    figure_w_normalized_uicontrolunits(xsec_fig)
    hold on

    messtext=...
        ['To select a polygon for a grid.       '
        'Please use the LEFT mouse button of   '
        'or the cursor to the select the poly- '
        'gon. Use the RIGTH mouse button for   '
        'the final point.                      '
        'Mac Users: Use the keyboard "p" more  '
        'point to select, "l" last point.      '
        '                                      '];

    zmap_message_center.set_message('Select Polygon for a grid',messtext);

    hold on
ax = findobj('Tag','main_map_ax');
[x,y, mouse_points_overlay] = select_polygon(ax);
    zmap_message_center.set_info('Message',' Thank you .... ')

    plos2 = plot(x,y,'b-','era','xor');        % plot outline
    sum3 = 0.;
    pause(0.3)

    %create a rectangular grid
    xvect=[min(x):dx:max(x)];
    yvect=[min(y):dd:max(y)];
    gx = xvect;gy = yvect;
    tmpgri=zeros((length(xvect)*length(yvect)),2);
    n=0;
    for i=1:length(xvect)
        for j=1:length(yvect)
            n=n+1;
            tmpgri(n,:)=[xvect(i) yvect(j)];
        end
    end
    %extract all gridpoints in chosen polygon
    XI=tmpgri(:,1);
    YI=tmpgri(:,2);

    ll = polygon_filter(x,y, XI, YI, 'inside');
    %grid points in polygon
    newgri=tmpgri(ll,:);

    % Plot all grid points
    plot(newgri(:,1),newgri(:,2),'+k')

    if length(xvect) < 2 || length(yvect) < 2
        errordlg('Selection too small! (not a matrix)');
        return
    end

    itotal = length(newgri(:,1));

    zmap_message_center.set_info(' ','Running... ');think
    %  make grid, calculate start- endtime etc.  ...
    %
    t0b = min(newa.Date)  ;
    n = newa.Count;
    teb = newa(n,3) ;
    tdiff = round((teb - t0b)*365/par1);
    loc = zeros(3, length(gx)*length(gy));

    % loop over  all points
    %
    i2 = 0.;
    i1 = 0.;
    bvg = [];
    allcount = 0.;
    wai = waitbar(0,' Please Wait ...  ');
    set(wai,'NumberTitle','off','Name','b-value grid - percent done');;
    drawnow
    %
    % loop

    % overall b-value
    [bv magco stan av me mer me2,  pr] =  bvalca3(newa,inb1,inb2);
    bo1 = bv; no1 = newa.Count;
    %
    for i= 1:length(newgri(:,1))
        x = newgri(i,1);y = newgri(i,2);
        allcount = allcount + 1.;
        i2 = i2+1;

        % calculate distance from center point and sort wrt distance
        l = sqrt(((xsecx' - x)).^2 + ((xsecy + y)).^2) ;
        %[s,is] = sort(l);
        %b = newa(is(:,1),:) ;       % re-orders matrix to agree row-wise

        % take first ni points
        l = l <= ra;
        b = newa.subset(l);      % new data per grid point (b) is sorted in distance

        if isempty(b) == 1; b = newa.subset(1); end
        if length(b(:,1)) >= 50;
            % call the b-value function
            lt =  b(:,3) >= t1 &  b(:,3) <t2 ;
            if  length(b(lt,1)) > 20;
                [bv magco stan av me mer me2,  pr] =  bvalca3(b(lt,:),inb1,inb2);
                bo1 = bv; no1 = newa.Count;
            else
                bv = NaN; pr = 50;
            end
            lt = b(:,3) >= t3 &  b(:,3) < t4 ;
            if  length(b(lt,1)) > 20;
                [bv2 magco stan av me mer me2,  pr] =  bvalca3(b(lt,:),inb1,inb2);
            else
                bv2 = NaN; pr = 50;
            end
            lt = b(:,3) >= t4 &  b(:,3) < t5 ;
            if  length(b(lt,1)) > 20;
                [bv3 magco stan av me mer me2,  pr2] =  bvalca3(b(lt,:),inb1,inb2);
            else
                bv3 = NaN; pr = 50;
            end

            l2 = sort(l);

            l2 = sort(l);
            b2 = b;
            if inb2 ==  1
                l = b(:,6) >= magco;
                b2 = b(l,:);
            end
            [av2 bv2 stan2 ] =  bmemag(b2);
            if pr >=90
                bvg = [bvg ; bv magco x y length(b(:,1)) bv2 pr av stan  max(b(:,6)) bv-bv2 bv-bv3 bv2-bv3 pr];
            else
                bvg = [bvg ; NaN NaN x y NaN NaN NaN NaN NaN  NaN NaN NaN NaN NaN];
            end
        else
            bvg = [bvg ; NaN NaN x y NaN NaN NaN NaN NaN  NaN NaN NaN NaN NaN];
        end
        waitbar(allcount/itotal)
    end  % for  newgri

    % save data
    %
    %  set(txt1,'String', 'Saving data...')
    drawnow
    gx = xvect;gy = yvect;

    catSave3 =...
        [ 'zmap_message_center.set_info(''Save Grid'',''  '');think;',...
        '[file1,path1] = uiputfile(fullfile(hodi, ''eq_data'', ''*.mat''), ''Grid Datafile Name?'') ;',...
        ' sapa2 = [''save '' path1 file1 '' ll tmpgri bvg xvect yvect gx gy ni dx dd par1 ni newa maex maey maix maiy ''];',...
        ' if length(file1) > 1, eval(sapa2),end , done']; eval(catSave3)

    close(wai)
    watchoff

    % reshape a few matrices
    %
    normlap2=ones(length(tmpgri(:,1)),1)*nan;
    normlap2(ll)= bvg(:,1);
    re3=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,5);
    r=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,6);
    meg=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,2);
    old1 =reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,7);
    pro=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,8);
    avm=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,9);
    stanm=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,10);
    maxm=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,11);
    db12=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,12);
    db13=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,13);
    db23=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,14);
    dp=reshape(normlap2,length(yvect),length(xvect));

    old = re3;

    % View the b-value map
    view_bvt

end   %  if sel = ca

% Load exist b-grid
if sel == 'lo'
    load_existing_bgrid_version_A
end


% THIS SOFTWARE AND ANY ACCOMPANYING DOCUMENTATION IS RELEASED "AS IS."  THE U.S. GOVERNMENT MAKES NO WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, CONCERNING THIS SOFTWARE AND ANY ACCOMPANYING DOCUMENTATION, INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT WILL THE U.S. GOVERNMENT BE LIABLE FOR ANY DAMAGES, INCLUDING ANY LOST PROFITS, LOST SAVINGS OR OTHER INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE, OR INABILITY TO USE, THIS SOFTWARE OR ANY ACCOMPANYING DOCUMENTATION, EVEN IF INFORMED IN ADVANCE OF THE POSSIBILITY OF SUCH DAMAGES.
%
% file: get_rate_diff_ci1.m
% one-sided confidence intervals for the difference of rates

% 030113 tdr created

function ci = get_rate_diff_ci1(x1,A1,x2,A2,alpha,method,verbose)

r1_hat = x1/A1; r2_hat = x2/A2; delta_r_hat = r1_hat - r2_hat;
a = find_lower_limit(x1,A1,x2,A2, alpha);
b = find_upper_limit(x1,A1,x2,A2, alpha);
ci = [delta_r_hat a b];

% ------------------------------------------------------------
% find lower limit

function limit = find_lower_limit(x1,A1,x2,A2,alpha)
% alpha is 1-Pr{delta_r >= a}
r1_hat = x1/A1; r2_hat = x2/A2; delta_r_hat = r1_hat - r2_hat;

% set limits of search
too_big = 1e12; too_small = -1e12;

%check that too_big is indeed too big etc.
alpha_too_big = 1 - rate_diff(x1,A1,x2,A2,too_big);
alpha_too_small = 1 - rate_diff(x1,A1,x2,A2,too_small);
if (alpha_too_big < alpha | alpha_too_small > alpha), error('Failure to set bounds for search'); end;

tolerance = 1e-6;
max_count = 50;
count = 0;

% initial guess for search
guess = (too_big + too_small)/2;
alpha_guess = 1- rate_diff(x1,A1,x2,A2,guess);

% binary search
while (abs(alpha_guess - alpha) > tolerance & (count < max_count))
    if (alpha_guess > alpha)
        too_big = guess;
        guess = (too_small + guess)/2;
    else
        too_small=guess;
        guess = (too_big + guess)/2;
    end;
    count = count+1;
    alpha_guess = 1 - rate_diff(x1,A1,x2,A2,guess);
end;

limit = guess;

% ------------------------------------------------------------
% find upper limit

function limit = find_upper_limit(x1,A1,x2,A2,alpha, bounds)
% alpha is Pr{delta_r >= b}
r1_hat = x1/A1; r2_hat = x2/A2; delta_r_hat = r1_hat - r2_hat;

% set limits for search
too_big = 1e12;  too_small = -1e12;

%check that too_big is indeed too big etc.
alpha_too_big = rate_diff(x1,A1,x2,A2,too_big);
alpha_too_small = rate_diff(x1,A1,x2,A2,too_small);
if (alpha_too_big > alpha | alpha_too_small < alpha), error('Failure to set bounds for search'); end;

tolerance = 1e-6;
max_count = 50;
count = 0;

% initial guess for search
guess = (too_big + too_small)/2;
alpha_guess = rate_diff(x1,A1,x2,A2,guess);

% binary search
while (abs(alpha_guess - alpha) > tolerance & (count < max_count))
    if (alpha_guess < alpha)
        too_big = guess;
        guess = (too_small + guess)/2;
    else
        too_small=guess;
        guess = (too_big + guess)/2;
    end;
    count = count+1;
    alpha_guess = rate_diff(x1,A1,x2,A2,guess);
end;

limit = guess;


function [ n_data, p, q, n, d ] = dedekind_sum_values ( n_data )

%*****************************************************************************80
%
%% DEDEKIND_SUM_VALUES returns some values of the Dedekind sum.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 July 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Hans Rademacher, Emil Grosswald,
%    Dedekind Sums,
%    Mathematics Association of America, 1972,
%    LC: QA241.R2.
%
%  Parameters:
%
%    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
%    first call.  On each call, the routine increments N_DATA by 1, and
%    returns the corresponding data; when there is no more data, the
%    output value of N_DATA will be 0 again.
%
%    Output, integer P, Q, the arguments of the function.
%
%    Output, integer N, D, the numerator and denominator of the function value.
%
  n_max = 95;

  p_vec = [ ...
     1,  1,  1,  1,  1,  1,  1,  1,  1,  1, ...
     1,  1,  1,  1,  1,  1,  1,  1,  1,  1, ...
     2,  2,  2,  2,  2,  2,  2,  2,  2,  2, ...
     3,  3,  3,  3,  3,  3,  3,  3,  3,  3, ...
     3,  3,  3,  3,  4,  4,  4,  4,  4,  4, ...
     4,  4,  4,  4,  5,  5,  5,  5,  5,  5, ...
     5,  5,  5,  5,  5,  5,  5,  5,  5,  5, ...
     6,  6,  6,  6,  6,  6,  6,  7,  7,  7, ...
     7,  7,  7,  7,  7,  7,  7,  7,  7,  7, ...
     7,  7,  7,  7,  7 ...
  ];

  q_vec = [ ...
     1,  2,  3,  4,  5,  6,  7,  8,  9, 10, ...
    11, 12, 13, 14, 15, 16, 17, 18, 19, 20, ...
     1,  3,  5,  7,  9, 11, 13, 15, 17, 19, ...
     1,  2,  4,  5,  7,  8, 10, 11, 13, 14, ...
    16, 17, 19, 20,  1,  3,  5,  7,  9, 11, ...
    13, 15, 17, 19,  1,  2,  3,  4,  6,  7, ...
     8,  9, 11, 12, 13, 14, 16, 17, 18, 19, ...
     1,  5,  7, 11, 13, 17, 19,  1,  2,  3, ...
     4,  5,  6,  8,  9, 10, 11, 12, 13, 15, ...
    16, 17, 18, 19, 20 ...
  ];

  n_vec = [ ...
     0,  0,  1,  1,  1,  5,  5,  7, 14,  3, ...
    15, 55, 11, 13, 91, 35, 20, 34, 51, 57, ...
     0, -1,  0,  1,  4,  5,  4,  7,  8, 21, ...
     0,  0, -1,  0, -1,  1,  0,  3,  1,  3, ...
     5,  5,  9,  3,  0,  1, -1,  1, -4,  3, ...
    -1, 19,  0, 11,  0,  0, -1,  1, -5, -1, ...
    -1,  4, -5, -1,  0,  3, -5,  1,  2, 11, ...
     0,  1, -5,  5, -4,  5, -9,  0,  0,  1, ...
    -1,  0,  5, -7, -4,  0, -3,  1,  4, -7, ...
    -3,  1, -2,  3,  3 ...
  ];

  d_vec = [ ...
     1,  1, 18,  8,  5, 18, 14, 16, 27,  5, ...
    22, 72, 13, 14, 90, 32, 17, 27, 38, 40, ...
     1, 18,  1, 14, 27, 22, 13, 18, 17, 38, ...
     1,  1,  8,  1, 14, 16,  1, 22, 13, 14, ...
    32, 17, 38,  8,  1, 18,  5, 14, 27, 22, ...
    13, 90,  1, 38,  1,  1, 18,  8, 18, 14, ...
    16, 27, 22, 72,  1, 14, 32, 17, 27, 38, ...
     1,  5, 14, 22, 13, 17, 38,  1,  1, 18, ...
     8,  1, 18, 16, 27,  1, 22, 72, 13, 18, ...
    32, 17, 27, 38,  8 ...
  ];

  if ( n_data < 0 )
    n_data = 0;
  end

  n_data = n_data + 1;

  if ( n_max < n_data )
    n_data = 0;
    p = 0;
    q = 0;
    n = 0;
    d = 0;
  else
    p = p_vec(n_data);
    q = q_vec(n_data);
    n = n_vec(n_data);
    d = d_vec(n_data);
  end

  return
end


classdef hmx
%+========================================================================+
%|                                                                        |
%|         OPENHMX - LIBRARY FOR H-MATRIX COMPRESSION AND ALGEBRA         |
%|           openHmx is part of the GYPSILAB toolbox for Matlab           |
%|                                                                        |
%| COPYRIGHT : Matthieu Aussal (c) 2017-2018.                             |
%| PROPERTY  : Centre de Mathematiques Appliquees, Ecole polytechnique,   |
%| route de Saclay, 91128 Palaiseau, France. All rights reserved.         |
%| LICENCE   : This program is free software, distributed in the hope that|
%| it will be useful, but WITHOUT ANY WARRANTY. Natively, you can use,    |
%| redistribute and/or modify it under the terms of the GNU General Public|
%| License, as published by the Free Software Foundation (version 3 or    |
%| later,  http://www.gnu.org/licenses). For private use, dual licencing  |
%| is available, please contact us to activate a "pay for remove" option. |
%| CONTACT   : matthieu.aussal@polytechnique.edu                          |
%| WEBSITE   : www.cmap.polytechnique.fr/~aussal/gypsilab                 |
%|                                                                        |
%| Please acknowledge the gypsilab toolbox in programs or publications in |
%| which you use it.                                                      |
%|________________________________________________________________________|
%|   '&`   |                                                              |
%|    #    |   FILE       : hmx.m                                         |
%|    #    |   VERSION    : 0.61                                          |
%|   _#_   |   AUTHOR(S)  : Matthieu Aussal                               |
%|  ( # )  |   CREATION   : 14.03.2017                                    |
%|  / 0 \  |   LAST MODIF : 05.09.2019                                    |
%| ( === ) |   SYNOPSIS   : H-Matrix class definition and functions       |
%|  `---'  |                                                              |
%+========================================================================+

properties
    typ = [];            % LEAF TYPE (0=H-MATRIX ; 1=COMPRESSED ; 2=FULL/SPARSE)
    pos = [];            % COORDINATES POSITIONS (X,Y)
    row = cell(1,4);     % CHILDREN ROWS INDICES (M11,M12,M21,M22)
    col = cell(1,4);     % CHILDREN COLUMNS INDICES
    chd = cell(1,4);     % CHILDREN
    dat = [];            % LEAF DATA
    tol = [];            % COMPRESSORS ACCURACY
end

methods
    %%%%%%%%%%%%%%%%%%%%%%%%%%%%% CONSTRUCTOR %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    % CONSTRUCTOR
    function Mh = hmx(varargin)
        % Empty object
        if (nargin == 0)

        % Initialization other H-matrix
        elseif (nargin == 2)
            Mh = hmxCopy(varargin{1},varargin{2});

        % Initialization with dimension and accuracy
        elseif (nargin == 3)
            Mh     = hmx();
            Mh.pos = {varargin{1},varargin{2}};
            Mh.tol = varargin{3};

        % Particles builder with partial and total pivoting
        elseif (nargin == 4)
            X     = varargin{1};
            Y     = varargin{2};
            green = varargin{3};
            acc   = varargin{4};
            Mh    = hmxBuilder(X,Y,green,acc);

        % Compressed builder
        elseif (nargin == 5)
            X      = varargin{1};
            Y      = varargin{2};
            A      = varargin{3};
            B      = varargin{4};
            acc    = varargin{5};
            Mh     = hmx(X,Y,acc);
            Mh.typ = 1;
            Mh.dat = {A,B};

       % Finite element builder
        elseif (nargin == 8)
            Xunk  = varargin{1};
            Yunk  = varargin{2};
            Mx    = varargin{3};
            X     = varargin{4};
            green = varargin{5};
            Y     = varargin{6};
            My    = varargin{7};
            acc   = varargin{8};
            Mh    = hmxBuilderFem(Xunk,Yunk,Mx,X,green,Y,My,acc);

        else
            error('hmx.m : undefined constructor case')
        end
    end

    %%%%%%%%%%%%%%%%%%%%%%%%%%%%% GLOBAL DATA %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    % SIZE
    function s = size(varargin)
        Mh = varargin{1};
        s  = [size(Mh.pos{1},1),size(Mh.pos{2},1)];
        if (nargin == 2)
            s = s(varargin{2});
        end
    end

    % LENGTH
    function l = length(Mh)
        l = max(size(Mh));
    end

    % ISLOWER
    function b = islower(Mh)
        if (Mh.typ == 0)
            b = (Mh.chd{2}.typ == 1) && isempty(Mh.chd{2}.dat{1});
        elseif (Mh.typ == 2)
            b = 1;
        else
            error('hmx.m : unavailable case.')
        end
    end

    % ISUPPER
    function b = isupper(Mh)
        if (Mh.typ == 0)
            b = (Mh.chd{3}.typ == 1) && isempty(Mh.chd{3}.dat{1});
        elseif (Mh.typ == 2)
            b = 1;
        else
            error('hmx.m : unavailable case.')
        end
    end

    %%%%%%%%%%%%%%%%%%%%%%%%%%%% VISUALISATION %%%%%%%%%%%%%%%%%%%%%%%%%%%%
    % STRUCTURE VISUALISATION
    function spy(Mh)
        hmxSpy(Mh);
    end

    % PLOT POSITIONS
    function plot3(Mh)
        plot3(Mh.pos{1}(:,1),Mh.pos{1}(:,2),Mh.pos{1}(:,3),'bo',...
            Mh.pos{2}(:,1),Mh.pos{2}(:,2),Mh.pos{2}(:,3),'*r');
    end

    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CONVERSION %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    % FULL
    function M = full(varargin)
        if (nargin == 1)
            M = hmxFull(varargin{1});
        else
            M = hmxFullSub(varargin{1},varargin{2},varargin{3});
        end
    end

    % SPARSE
    function M = sparse(varargin)
        if (nargin == 1)
            M = hmxSparse(varargin{1});
        elseif (nargin == 2)
            M = hmxSparsify(varargin{1},varargin{2});
        else
            M = hmxSparseSub(varargin{1},varargin{2},varargin{3});
        end
    end

    % LOW-RANK
    function [A,B] = lowrank(varargin)
        if (nargin == 1)
            [A,B] = hmxLowrank(varargin{1});
        else
            [A,B] = hmxLowrankSub(varargin{1},varargin{2},varargin{3});
        end
    end

    % DIAGONAL
    function D = diag(Mh)
        D = hmxDiag(Mh,(1:size(Mh,1))',(1:size(Mh,2))');
        D = full(diag(D));
    end

    % ZEROS
    function Mh = zeros(Mh)
        Mh.typ = 1;
        Mh.row = cell(1,4);
        Mh.col = cell(1,4);
        Mh.chd = cell(1,4);
        Mh.dat = {zeros(size(Mh,1),0),zeros(0,size(Mh,2))};
    end

    % ONES
    function Mh = ones(Mh)
        Mh.typ = 1;
        Mh.row = cell(1,4);
        Mh.col = cell(1,4);
        Mh.chd = cell(1,4);
        Mh.dat = {ones(size(Mh,1),1),ones(1,size(Mh,2))};
    end

    % SINGLE
    function Mh = single(Mh)
        Mh = hmxSingle(Mh);
    end

    % DOUBLE
    function Mh = double(Mh)
        Mh = hmxDouble(Mh);
    end

    % TRANSPOSITION
    function Mh = transpose(Mh)
        Mh = hmxTranspose(Mh);
    end

    % TRANSPOSITION CONJUGATE
    function Mh = ctranspose(Mh)
        Mh = hmxCtranspose(Mh);
    end

    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ALGEBRA %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    % SCALAR PRODUCT
    function Mh = times(Ml,Mr)
        Mh = hmxTimes(Ml,Mr);
    end

    % UMINUS
    function Mh = uminus(Mh)
        Mh = (-1).*Mh;
    end

    % ADDITION
    function Mh = plus(Ml,Mr)
        Mh = hmxPlus(Ml,Mr);
    end

    % SUBSTRACTION
    function Mh = minus(Ml,Mr)
       Mh = Ml + (-Mr);
    end

    % MATRIX PRODUCT
    function Mh = mtimes(Ml,Mr)
        if isnumeric(Ml) && (numel(Ml) == 1)
            Mh = Ml .* Mr;
        elseif isnumeric(Mr) && (numel(Mr) == 1)
            Mh = Ml .* Mr;
        else
            Mh = hmxMtimes(Ml,Mr);
        end
    end

    % ADDITION WITH MATRIX PRODUCT
    function Mh = plusmtimes(Mh,alpha,Ml,Mr)
        Mh = hmxPlusMtimes(Mh,alpha,Ml,Mr);
    end

    % INVERSION
    function Mh = inv(Mh)
        Mh = hmxInv(Mh);
    end

    % CHOLESKY FACTORISATION
    function Mh = chol(Mh)
        Mh = hmxChol(Mh);
    end

    % LDLt FACTORISATION
    function [Mh,Dh] = ldl(Mh)
        [Mh,Dh] = hmxLdl(Mh);
    end

    % LU FACTORISATION
    function [Lh,Uh] = lu(Mh)
        [Lh,Uh] = hmxLU(Mh);
    end

    % MLDIVIDE
    function B = mldivide(Mh,B)
       B = hmxMldivide(Mh,B);
    end

    % MRDIVIDE
    function B = mrdivide(B,Mh)
        B = (Mh.'\B.').';
    end

    % VERTICAL CONCATENATION
    function Mh = vertcat(varargin)
        Mh = varargin{1}.';
        for i = 2:nargin
            Mh = hmxHorzcat(Mh,varargin{i}.');
        end
        Mh = Mh.';
    end

    % HORIZONTAL CONCATENATION
    function Mh = horzcat(varargin)
        Mh = varargin{1};
        for i = 2:nargin
            Mh = hmxHorzcat(Mh,varargin{i});
        end
    end
end
end


function h = conv(f, g, varargin)
%CONV   Convolution of CHEBFUN objects.
%   H = CONV(F, G) produces the convolution of CHEBFUN objects F and G:
%                     -
%                    /
%           H(x) =   |    F(t) G(x-t) dt,  x in [a + c, b + d]
%                    /
%                   -
%   where domain(F) is [a, b] and domain(G) is [c, d]. The integral is taken
%   over all t for which the integrand is defined: max(a, x - d) <= t <= min(b,
%   x - c).  The breakpoints of H are all pairwise sums of the breakpoints of F
%   and G.
%
%   H = CONV(F, G, 'same') will truncate the domain of H so that it is the same
%   as F. This is useful when F and G represent rapidly decaying functions on
%   large but finite intervals which are used to approximate infinity.
%
%   If F and G are simple, in the sense that their FUNS are CHEBTECH objects, a
%   fast algorithm due to Hale and Townsend is used [1]. Otherwise, the integral
%   is computed by brute force. CONV(F, G, 'old') forces the brute force
%   approach, even when the fast algorithm may be used.
%
%   Note that CONV only supports piecewise-smooth functions on bounded domains.
%
% Examples:
%     cheb.x; f = 0.8 - abs(x-0.2);
%     phi = @(t) chebfun(@(x) exp(-x^2/(4*t))/sqrt(4*pi*t));
%     fsmooth = conv(f,phi(1e-2),'same');
%     plot(f,'b',fsmooth','r')
%
%     f = chebfun(1/2); g = f;
%     subplot(2, 2, 1), plot(f)
%     for j = 2:4, g = conv(f, g); subplot(2, 2, j), plot(g), end
%     figure, for j = 1:4, subplot(2,2,j), plot(g), g = diff(g); end
%
% Reference:
%   [1] N. Hale and A. Townsend, "An algorithm for the convolution of Legendre
%   series", SIAM Journal on Scientific Computing, Vol. 36, No. 3,
%   pp. A1207-A1220, 2014.

% Copyright 2017 by The University of Oxford and The Chebfun Developers.
% See http://www.chebfun.org/ for Chebfun information.

%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Check transpose state:
if ( xor(f(1).isTransposed, g(1).isTransposed) )
    error('CHEBFUN:CHEBFUN:conv:transposed', ...
        'CHEBFUN dimensions do not agree.');
end
transState = f(1).isTransposed;

% Support for quasimatrices:
nf = numColumns(f);
ng = numColumns(g);
if ( nf > 1 || ng > 1 )
    if ( nf == ng )
        f = mat2cell(f);
        g = mat2cell(g);
        h = f;
        for k = 1:nf
            h{k} = conv(f{k}, g{k}, varargin{:});
        end
    elseif ( nf == 1 )
        g = mat2cell(g);
        h = g;
        for k = 1:ng
            h{k} = conv(f, g{k}, varargin{:});
        end
    elseif ( ng == 1 )
        f = mat2cell(f);
        h = f;
        for k = 1:nf
            h{k} = conv(f{k}, g, varargin{:});
        end
    else
        error('CHEBFUN:CHEBFUN:conv:dimagree', 'CHEBFUN dimensions must agree.');
    end
    if ( ~transState )
        h = horzcat(h{:});
    else
        h = vertcat(h{:});
    end
    return
end

% Return empty for an empty input:
if ( isempty(f) || isempty(g) )
    h = chebfun();
    return
end

% Parse inputs:
oldMethod = false;
same = false;
for k = 1:numel(varargin)
    vk = varargin{k};
    if ( strcmpi(vk, 'old') )
        oldMethod = true;
    elseif ( strcmpi(vk, 'same') )
        same = true;
    elseif ( strcmpi(vk, 'full') )
        % Do nothing.
    elseif ( strcmpi(vk, 'valid') )
        % TODO: Supoprt 'valid'. Presumably where domains of f and g overlap?
        error('CHEBFUN:CHEBFUN:conv:validFlag', '''valid'' is not yet supprted.');
    else
        error('CHEBFUN:CHEBFUN:conv:badInput', 'Unknown input option %s.', vk);
    end
end

% Return a warning if F and G have too many pieces (the computation is probably
% going to be very slow):
if ( ( numel(f.funs) + numel(g.funs) ) > 50 )
    % Give a warning and proceed.
   warning('CHEBFUN:CHEBFUN:conv:piecewise',...
       ['Convolving CHEBFUNs with many pieces can be very slow.\n', ...
        'Try calling MERGE() on the inputs before calling CONV().']);
end

% Extract the domain:
[a, b] = domain(f);
[c, d] = domain(g);

% No support for unbounded domains:
if ( any(isinf([a b c d])) )
    error('CHEBFUN:CHEBFUN:conv:bounded', ...
        'CONV only supports CHEBFUN objects on bounded domains.');
end

if ( oldMethod || issing(f) || issing(g) )
    % Call the old (and slow) version of CONV if we are not based on CHEBTECHS.
    h = oldConv(f, g);

else

    % Ensure g is the signal (i.e., on the larger domain) and f is the filter:
    if ( (b - a) > (d - c) )
        h = conv(g, f);
        return
    end

    % Initialize the output:
    h = chebfun(0, [a + c, b + d]);
    % Deal with piecewise CHEBFUN objects by looping over each interaction:
    for j = 1:numel(f.funs)
        for k = 1:numel(g.funs)
            % Compute the contribution of jth fun of f with kth fun of g:
            hjk = conv(f.funs{j}, g.funs{k});
            % Add this contribution:
            h = myplus(h, chebfun(hjk));
        end
    end

    % Make sure that point values are not added twice:
    dom = domain(h);
    intDom = dom(2:end-1);
    h.pointValues(2:end-1) = 1/2*(feval(h, intDom.', 'left') + ...
        feval(h, intDom.', 'right'));

end

% Truncate:
if ( same )
    h = restrict(h, [a, b]);
end

% Transpose:
if ( transState )
    h = h.';
end

% Simplify the result.
h = simplify(h);

end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function h = myplus(f, g)
% Modified PLUS() which pads with zeros to fulfil domain requirements.
%  Note f is always on the largest possible domain. g is on a subdomain of f

% Tidy the domains:
[f, g] = tweakDomain(f, g);
[c, d] = domain(g);

fTmp = restrict(f, [c, d]); % f{c, d}
hTmp = fTmp + g;            % h{c, d} = f{c, d} + g;
h = defineInterval(f, [c, d], hTmp);

end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function h = oldConv(f, g)
% The old convolution algorithm based on quadrature. See section 2 of [1] for a
% description of the algorithm.

% Find all breakpoints in the convolution:
[A, B] = meshgrid(f.domain, g.domain);
dom = unique(A(:) + B(:)).';

% Coalesce breaks that are close due to roundoff:
dom(diff(dom) < 10*eps*max(abs(dom([1,end])))) = [];
dom(isnan(dom)) = [];

% Combine vertical and horizontal scales:
hs = max(hscale(f), hscale(g));
vs = 2*max([vscale(f), vscale(g)]);

% Set preferences:
%
% TODO:  CHEBFUN is not supposed to set the refinementFunction preference
% because it doesn't belong to the list of "abstract" preferences required of
% all techs.  Do we really need to alter it here?
p = chebfunpref();
p.splitting = false;
p.blowup = false;
p.techPrefs.extrapolate = true;
p.techPrefs.refinementFunction = 'nested';
p.techPrefs.sampleTest = false;

% Construct FUNS:
funs = cell(1, length(dom)-1);
for k = 1:length(dom)-1
    data.domain = dom(k:k+1);
    data.vscale = vs;
    data.hscale = hs;
    newFun = bndfun(@(x) convIntegral(x, f, g), data, p);
    vs = max(get(newFun, 'vscale'), vs);
    funs{k} = newFun;
end

% Construct CHEBFUN:
h = chebfun(funs);
h.isTransposed = f.isTransposed;

end

function out = convIntegral(x, f, g)
%CONVINTEGRAL   Evaluate convolution integral.
%   Y = CONVINTEGRAL(X, F, G) evaluates the convolution of the CHEBFUNs F and G
%   at the points X.

a = f.domain(1);
b = f.domain(end);
c = g.domain(1);
d = g.domain(end);

out = 0*x;
for k = 1:length(x)
    A = max(a, x(k) - d);
    B = min(b, x(k) - c);
    if ( A < B )
        ends = union(x(k) - g.domain, f.domain);
        dom = [A, ends((A < ends) & (ends < B)), B];
        for j = 1:length(dom)-1
            % INTEGRAL is not available in versions of MATLAB prior to R2012a,
            % so if we're running on an older version, fall back to QUADGK.
            integrand = @(t) feval(f, t).*feval(g, x(k) - t);
            if ( verLessThan('matlab', '7.14') )
                out(k) = out(k) + quadgk(integrand, dom(j), dom(j+1), ...
                    'AbsTol', 1e-15, 'RelTol', 100*eps);
            else
                out(k) = out(k) + integral(integrand, dom(j), dom(j+1), ...
                    'AbsTol', 1e-15, 'RelTol', 1e-15);
            end
        end
    end
end

end


function varargout = sameDeltaLocs(f, g, tol)
%SAMEDELTALOCS   Find common locations of delta functions in F and G.
%   IDX1 = SAMEDELTALOCS(F, G) returns a logical vector of of same length as
%   that of F.DELTALOCS indicating which locations are shared with G.
%   [IDX1, IDX2] = SAMEDELTALOCS(F, G) does the same but also returns the
%   vector IDX2 locations of G.
%
%   SAMEDELTALOCS(F, G, TOL) uses the user-specified tolerance TOL for testing.
%
% See also SIMPLIFY, CLEANROWS, CLEANCOLUMNS

% Copyright 2017 by The University of Oxford and The Chebfun Developers.
% See http://www.chebfun.org/ for Chebfun information.

% Deal with the empty cases:
if ( isempty(f) || isempty(g) )
    if ( nargout == 2 )
        varargout{1} = [];
        varargout{2} = [];
    else
        varargout{1} = [];
    end
    return
end

% Get preferences:
if ( nargin < 3 )
    pref = chebfunpref();
    tol = pref.deltaPrefs.proximityTol;
end

% Initialize variables:
loc1 = f.deltaLoc;
idx1 = zeros(size(loc1));
loc2 = g.deltaLoc;
idx2 = zeros(size(loc2));

% Loop and compare locations:
for i = 1:length(loc1)
    for j = 1:length(loc2)
        % If both entries are equal to zero:
        p = ( (loc1(i) == 0) && (loc2(j) == 0) );
        % Or if they are very close to each other:
        maxLoc = max(abs([loc1(i), loc2(j)]));
        p = p | ( abs((loc1(i) - loc2(j)))/maxLoc < tol );
        if ( p )
            % Mark the indices:
            idx1(i) = 1;
            idx2(j) = 1;
        end
    end
end

% Convert to logical indices:
idx1 = logical(idx1);
idx2 = logical(idx2);

% Output based on the number of outputs:
if ( nargout == 2 )
    varargout{1} = idx1;
    varargout{2} = idx2;
else
    varargout{1} = idx1;
end

end


function a = wishart_sample ( m, df, sigma )

%*****************************************************************************80
%
%% WISHART_SAMPLE samples the Wishart distribution.
%
%  Discussion:
%
%    This function requires functions from the PDFLIB and RNGLIB libraries.
%
%    The "initialize()" function from RNGLIB must be called before using
%    this function.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 July 2013
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Patrick Odell, Alan Feiveson,
%    A numerical procedure to generate a sample covariance matrix,
%    Journal of the American Statistical Association,
%    Volume 61, Number 313, March 1966, pages 199-203.
%
%    Stanley Sawyer,
%    Wishart Distributions and Inverse-Wishart Sampling,
%    Washington University,
%    30 April 2007, 12 pages.
%
%  Parameters:
%
%    Input, integer M, the order of the matrix.
%
%    Input, integer DF, the number of degrees of freedom.
%    M <= DF.
%
%    Input, real SIGMA(M,M), the covariance matrix, which should be
%    a symmetric positive definite matrix.
%
%    Output, real A(M,M), the sample matrix from the Wishart distribution.
%
  if ( df < m )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'WISHART_SAMPLE - Fatal error!\n' );
    fprintf ( 1, '  DF = %d < M = %d.\n', df, m );
    error ( 'WISHART_SAMPLE - Fatal error!\n' );
  end
%
%  Get R, the upper triangular Cholesky factor of SIGMA.
%
  r = chol ( sigma );
%
%  Get AU, a sample from the unit Wishart distribution.
%
  au = wishart_unit_sample ( m, df );
%
%  Construct the matrix A = R' * AU * R.
%
  a = r' * au * r;

  return
end