%% Birefrigence
%
% Birefringence is the optical property of a material having a refractive
% index that depends on the polarization and propagation direction of
% light. It is one of the oldest methods to determine orientations of
% crystals in thin sections of rocks.

%% Import Olivine Data
% In order to illustarte the effect of birefringence lets consider a
% olivine data set.

mtexdata olivine

% reconstruct grains
[grains,ebsd.grainId] = calcGrains(ebsd('indexed'));
ebsd(grains(grains.grainSize < 5)) = [];
[grains,ebsd.grainId] = calcGrains(ebsd('indexed'));

% some data denoising
grains = smooth(grains,5);

F = splineFilter;
ebsd = smooth(ebsd,F,'fill',grains);

%%

% plot the olivine phase
plot(ebsd('olivine'),ebsd('olivine').orientations);
hold on
plot(grains.boundary,'lineWidth',2)
hold off

gg = grains(grains.grainSize > 100);
gg = gg('o')
cS = crystalShape.olivine;
hold on
plot(gg,0.8*cS,'FaceColor','none')
hold off

%% The refractive index tensor
%
% The refractive index of a material describes the dependence of the speed
% of light with respect to the propagation direction and the polarization
% direction. In a linear world this relation ship is modeled by a symmetric
% rank 2 tensor - the so called refractive index tensor, which is usually
% given by it principle values: n_alpha, n_beta and n_gamma. In
% orthorhombic minerals such as olivine the principal values are parallel
% to the crystallographic axes. Care has to be applied when associating the
% principle values with the correct axes.

%%
% For Forsterite the priniple refractive values are
n_alpha = 1.635; n_beta = 1.651; n_gamma = 1.670;

%%
% with the largest refractive index n_gamma beeing alligned with the
% a-axis, the intermediate index n_beta with the c-axis and the smallest
% refractive index n_alpha with the b-axis. Hence, the refractive index
% tensor for Forsterite takes the form

cs = ebsd('olivine').CS;
rI_Fo = refractiveIndexTensor(diag([ n_gamma  n_alpha  n_beta]),cs)

%%
% For Fayalite the priniple refractive values

n_alpha = 1.82; n_beta = 1.869; n_gamma = 1.879;

%%
% are aligned to the crystallograhic axes in an analogous way. Which leads
% to the refractive index tensor

rI_Fa = refractiveIndexTensor(diag([ n_gamma  n_alpha  n_beta]),cs)

%%
% The refractive index of composite materials like Olivine can now be
% modelled as the weighted sum of the of the refractive index tensors of
% Forsterite and Fayalite. Lets assume that the relative Forsterite content
% (atomic percentage) is sgiven my

XFo = 0.86; % 86 percent Forsterite

%%
% Then is refractive index tensor becomes

rI = XFo*rI_Fo + (1-XFo) * rI_Fa

%% Birefringence
% The birefringence describes the difference |n| in diffraction index
% between the fastest polarization direction |pMax| and the slowest
% polarization direction |pMin| for a given propagation direction |vprop|.

% lets define a propagation direction
vprop = Miller(1,1,1,cs);

% and compute the birefringence
[dn,pMin,pMax] = rI.birefringence(vprop)

%%
% If the polarization direction is ommited the results are spherical
% functions which can be easily visualized.

% compute the birefringence as a spherical function
[dn,pMin,pMax] = rI.birefringence

% plot it
plot3d(dn,'complete')
mtexColorbar

% and on top of it the polarization directions
hold on
quiver3(pMin,'color','white')
quiver3(pMax)
hold off

%% The Optical Axis
% The optial axes are all directions where the birefringence is zero

% compute the optical axes
vOptical = rI.opticalAxis

% and check the birefringence is zero
rI.birefringence(rI.opticalAxis)

% annotate them to the birefringence plot
hold on
arrow3d(vOptical,'antipodal','facecolor','red')
hold off

%% Spectral Transmission
% If white light with a certain polarization is transmited though a crystal
% with isotropic refrative index the light changes wavelength and hence
% appears collored. The resulting color depending on the propagation
% direction, the polarization direction and the thickness can be computed
% by

vprop = Miller(1,1,1,cs);
thickness = 30000;
p =  Miller(-1,1,0,cs);
rgb = rI.spectralTransmission(vprop,thickness,'polarizationDirection',p)

%%
% Effectively, the rgb value depend only on the angle tau between the
% polariztzion direction and the slowest polarization direction |pMin|.
% Instead of the polarization direction this angle may be specified
% directly

rgb = rI.spectralTransmission(vprop,thickness,'tau',30*degree)

%%
% If the angle tau is fixed and the propagation direction is ommited as
% input MTEX returns the rgb values as a spherical function. Lets plot
% these functions for different values of tau.

newMtexFigure('layout',[1,3]);

mtexTitle('$\tau = 15^{\circ}$')
plot(rI.spectralTransmission(thickness,'tau',15*degree),'rgb')

nextAxis
mtexTitle('$\tau = 30^{\circ}$')
plot(rI.spectralTransmission(thickness,'tau',30*degree),'rgb')

nextAxis
mtexTitle('$\tau = 45^{\circ}$')
plot(rI.spectralTransmission(thickness,'tau',45*degree),'rgb')

drawNow(gcm,'figSize','normal')

%%
% Usually, the polarization direction is chosen at angle phi = 90 degree of
% the analyzer. The following plots demonstrate how to change this angle

newMtexFigure('layout',[1,3]);

mtexTitle('$\tau = 15^{\circ}$')
plot(rI.spectralTransmission(thickness,'tau',45*degree,'phi',30*degree),'rgb')

nextAxis
mtexTitle('$\tau = 30^{\circ}$')
plot(rI.spectralTransmission(thickness,'tau',45*degree,'phi',60*degree),'rgb')

nextAxis
mtexTitle('$\tau = 45^{\circ}$')
plot(rI.spectralTransmission(thickness,'tau',45*degree,'phi',90*degree),'rgb')

drawNow(gcm,'figSize','normal')

%% Spectral Transmission at Thin Sections
% All the above computations have been performed in crystal coordinates.
% However, in practical applications the direction of the polarizer as well
% as the propagation direction are given in terms of specimen coordinates.

% the propagation direction
vprop = vector3d.Z;

% the direction of the polarizer
polarizer = vector3d.X;

% the thickness of the thin section
thickness = 22800;

%%
% As usal we have two options: Either we transform the refractive index
% tensor into specimen coordinates or we transform the polarization
% direction and the propagation directions into crystal coordinates.
% Lets start with the first option:

% extract the olivine orientations
ori = ebsd('olivine').orientations;

% transform the tensor into a list of tensors with respect to specimen
% coordinates
rISpecimen = ori * rI;

% compute RGB values
rgb = rISpecimen.spectralTransmission(vprop,thickness,'polarizationDirection',polarizer);

% colorize the EBSD maps according to spectral transmission
plot(ebsd('olivine'),rgb)

%%
% and compare it with option two:

% transfom the propation direction and the polarizer direction into a list
% of directions with respect to crystal coordinates
vprop_crystal = ori \ vprop;
polarizer_crystal = ori \ polarizer;

% compute RGB values
rgb = rI.spectralTransmission(vprop_crystal,thickness,'polarizationDirection',polarizer_crystal);

% colorize the EBSD maps according to spectral transmission
plot(ebsd('olivine'),rgb)

%% Spectral Transmission as a color key
% The above computations can be automized by defining a spectral
% transmission color key.

% define the colorKey
colorKey  = spectralTransmissionColorKey(rI,thickness);

% the following are the defaults and can be ommited
colorKey.propagationDirection = vector3d.Z;
colorKey.polarizer = vector3d.X;
colorKey.phi = 90 * degree;

% compute the spectral transmission color of the olivine orientations
rgb = colorKey.orientation2color(ori);

plot(ebsd('olivine'), rgb)

%%
% As usual we me visualize the color key as a colorization of the
% orientation space, e.g., by plotting it in sigma sections:

plot(colorKey,'sigma')

%% Circular Polarizer
% In order to simulate we a circular polarizer we simply set the polarizer
% direction to empty, i.e.

colorKey.polarizer = [];

% compute the spectral transmission color of the olivine orientations
rgb = colorKey.orientation2color(ori);

plot(ebsd('olivine'), rgb)

%% Illustrating the effect of rotating polarizer and analyser simultanously

colorKey.polarizer = vector3d.X;
figure
plotHandle = plot(ebsd('olivine'),colorKey.orientation2color(ori),'micronbar','off');
hold on
plot(grains.boundary,'lineWidth',2)
hold off
textHandle = text(750,50,[num2str(0,'%10.1f') '\circ'],'fontSize',15,...
  'color','w','backGroundColor', 'k');

% define the step size in degree
stepSize = 2.5;

for omega = 0:stepSize:90-stepSize

  % update polarsation direction
  colorKey.polarizer = rotate(vector3d.X, omega * degree);

  % update rgb values
  plotHandle.FaceVertexCData = colorKey.orientation2color(ori);

  % update text
  textHandle.String = [num2str(omega,'%10.1f') '\circ'];

  drawnow

end


function [y]=dmrg_cross(d,n,fun,eps,varargin)
%DMRG-cross method for the approximation of TT-tensors
%   [A]=DMRG_CROSS(D,N,FUN,EPS,OPTIONS) Computes the approximation of a
%   given tensor via the adaptive DMRG-cross procedure. The input is a pair
%   (D,N) which determines the size of the tensor (N can be either a
%   number, or array of mode sizes). FUN is the function to compute
%   a prescribed element of a tensor (FUN(IND)), or it can be vectorized to
%   compute series of elements of a tensor (see OPTIONS) To pass parameters
%   to FUN please use anonymous function handles. EPS is the accuracy
%   of the approximation.Options are provided in form
%   'PropertyName1',PropertyValue1,'PropertyName2',PropertyValue2 and so
%   on. The parameters are set to default (in brackets in the following)
%   The list of option names and default values are:
%       o nswp - number of DMRG sweeps [10]
%       o vec  - Fun is vectorized [ true | {false} ]
%       o verb - output debug information [ {true} | false ]
%       o y0   - initial approximation [random rank-2]
%       o radd - minimal rank change [0]
%       o rmin - minimal rank that is allows [1]
%       o kickrank - stabilization parameter [2]
%
%   Example:
%       d=10; n=2; fun = @(ind) sum(ind);
%       tt=dmrg_cross(d,n,fun,1e-7);
%
%  This code implements the algorithm from
%  D. Savostyanov, I. Oseledets, Fast adaptive interpolation of multi-dimensional arrays in tensor train format,
%  http://dx.doi.org/10.1109/nDS.2011.6076873
%  Please cite this paper if your research benefits from the use of this code.
%
%  Vectorized version contributed by Prof. Le Song (http://www.cc.gatech.edu/~lsong/)
%
%
% TT-Toolbox 2.2, 2009-2013
%
%
%This is TT Toolbox, written by Ivan Oseledets et al.
%Institute of Numerical Mathematics, Moscow, Russia
%webpage: http://spring.inm.ras.ru/osel
%
%For all questions, bugs and suggestions please mail
%ivan.oseledets@gmail.com
%---------------------------
%Default parameters
rmin=1;
verb=true;
radd=0;
kickrank=2;
nswp=10;
y=[];
vectorized=false;
maxr = 20;
for i=1:2:length(varargin)-1
    switch lower(varargin{i})
        case 'nswp'
            nswp=varargin{i+1};
        case 'y0'
            y=varargin{i+1};
        case 'verb'
            verb=varargin{i+1};
        case 'rmin'
            rmin=varargin{i+1};
        case 'radd'
            radd=varargin{i+1};
        case 'vec'
            vectorized=varargin{i+1};
        case 'kickrank'
            kickrank=varargin{i+1};
      case 'maxr'
        maxr = varargin{i+1};

        otherwise
            error('Unrecognized option: %s\n',varargin{i});
    end
end

if ( numel(n) == 1 )
   n=n*ones(d,1);
end

sz=n;
if (isempty(y) )
    y=tt_rand(sz,d,2);
end
if ( ~vectorized )
    elem=@(ind) my_vec_fun(ind,fun);
else
    elem = fun;
end
y=round(y,0); %To avoid overranks
ry=y.r;
[y,rm]=qr(y,'rl');
y=rm*y;
%Warmup procedure: orthogonalization from right to left of the initial
%approximation & computation of the index sets & computation of the
%right-to-left R matrix
swp=1;
rmat=cell(d+1,1);
rmat{d+1}=1;
rmat{1}=1; %These are R-matrices from the QR-decomposition.
index_array{d+1}=zeros(0,ry(d+1));
index_array{1}=zeros(ry(1),0);
r1=1;
for i=d:-1:2
    cr=y{i}; cr=reshape(cr,[ry(i)*n(i),ry(i+1)]);
    cr = cr*r1; cr=reshape(cr,[ry(i),n(i)*ry(i+1)]); cr=cr.';
    [cr,rm]=qr(cr,0);
    [ind]=maxvol2(cr);
    ind_old=index_array{i+1};
    rnew=min(n(i)*ry(i+1),ry(i));
    ind_new=zeros(d-i+1,rnew);
    for s=1:rnew
       f_in=ind(s);
       w1=tt_ind2sub([ry(i+1),n(i)],f_in);
       rs=w1(1); js=w1(2);
       ind_new(:,s)=[js,ind_old(:,rs)'];
    end
    index_array{i}=ind_new;
    r1=cr(ind,:);
    cr=cr/r1;
    r1=r1*rm;
    r1=r1.';

    cr=cr.';
    y{i}=reshape(cr,[ry(i),n(i),ry(i+1)]);
    cr=reshape(cr,[ry(i)*n(i),ry(i+1)]);
    cr=cr*rmat{i+1}; cr=reshape(cr,[ry(i),n(i)*ry(i+1)]);
    cr=cr.';
    [~,rm]=qr(cr,0);
    rmat{i}=rm; %The R-matrix
end
%Forgot to put r1 onto the last core
cr=y{1}; cr=reshape(cr,[ry(1)*n(1),ry(2)]);
y{1}=reshape(cr*r1,[ry(1),n(1),ry(2)]);
not_converged = true;
dir = 1; %The direction of the sweep
i=1; %Current position
er_max=0;
while ( swp < nswp && not_converged )
    % A sweep through the cores
    %Compute the current index set, compute the current supercore
    %(right now without any 2D cross inside, but it is trivial to
    %implement). The supercore is (i,i+1) now.
    %Left index set is index_array{i}, right index set is index_array{i+2}
    %We will modify ry(i+1) at this step and use rmat{i} and rmat{i+2}
    %as "weighting" matrices for the low-rank approximation. The initial
    %approximation is simply rmax{i}*u{i}*u{i+1}*rmat{i+2} (hey!)
    %We also have to store the submatrix in the current factors
    %Then the algorithm would be as follows: Computex sets, compute
    %supercore. Compute rmax{i}*Phi*rmax{i+2} = U*V by SVD, then split
    rm1=rmat{i}; rm2=rmat{i+2};
    cr1=y{i}; cr2=y{i+1};
    ind1=index_array{i};
    ind2=index_array{i+2};

%     big_index=zeros(ry(i),n(i),n(i+1),ry(i+2),d);
%     for i1=1:n(i)
%         for i2=1:n(i+1)
%             for s1=1:ry(i)
%                 for s2=1:ry(i+2)
%                     ind=[ind1(s1,:),i1,i2,ind2(:,s2)'];
%                     big_index(s1,i1,i2,s2,:)=ind;
%                 end
%             end
%         end
%     end
%     big_index=reshape(big_index,[numel(big_index)/d,d]);

    big_index = [ ...
      ind1(repmat((1:ry(i))', n(i)*n(i+1)*ry(i+2), 1),:), ...
      kron(repmat((1:n(i))', n(i+1)*ry(i+2), 1), ones(ry(i),1)), ...
      kron(repmat((1:n(i+1))', ry(i+2), 1), ones(ry(i)*n(i),1)), ...
      ind2(:, kron((1:ry(i+2))', ones(ry(i)*n(i)*n(i+1),1)))' ...
      ];

    score=elem(big_index);

    %Now plug in the rmax matrices
    score=reshape(score,[ry(i),n(i)*n(i+1)*ry(i+2)]);
    score=rmat{i}*score;
    ry(i)=size(score,1);
    score=reshape(score,[ry(i)*n(i)*n(i+1),ry(i+2)]);
    score=score*rmat{i+2};
    ry(i+2)=size(score,2);

    %Do the SVD splitting (later on we can replace it by cross for large
    %mode sizes)
    score=reshape(score,[ry(i)*n(i),n(i+1)*ry(i+2)]);

%     [u,s,v]=svd(score,'econ');
    [u,s,v]=svds(score, maxr);
    s=diag(s);
    r=my_chop2(s,norm(s)*eps/sqrt(d-1)); %Truncation
    u=u(:,1:r); v=v(:,1:r); s=diag(s(1:r));

    %Kick rank
    if ( dir == 1 )
%         v=v*diag(s);
        v = v * s';

        ur=randn(size(u,1),kickrank);
        u=reort(u,ur);
        radd=size(u,2)-r;
        if ( radd > 0 )
            vr=zeros(size(v,1),radd);
            v=[v,vr];
        end
        r=r+radd;
    else
%          u=u*diag(s);
         u = u * s;

         vr=randn(size(v,1),kickrank);
         v=reort(v,vr);
         radd=size(v,2)-r;
         if ( radd > 0 )
             ur=zeros(size(u,1),radd);
             u=[u,ur];
         end
         r=r+radd;
    end

    v=v';

%     size(v)

    %Compute the previous approximation
    appr=reshape(cr1,[numel(cr1)/ry(i+1),ry(i+1)])*reshape(cr2,[ry(i+1),numel(cr2)/ry(i+1)]);
    appr=reshape(appr,[ry(i),n(i)*n(i+1)*ry(i+2)]);
    appr=rmat{i}*appr;
    appr=reshape(appr,[ry(i)*n(i)*n(i+1),ry(i+2)]);
    appr=appr*rmat{i+2};
    er_loc=norm(score(:)-appr(:))/norm(score(:));
    er_max=max(er_max,er_loc);
    if ( verb )
        fprintf('swp=%d block=%d new_rank=%d local_er=%3.1e\n',swp,i,r,er_loc);
    end
    ry(i+1)=r;

    u = reshape(u,[ry(i),n(i)*r]);
    u = rmat{i}\u; %Hope it is stable blin
    v=reshape(v,[r*n(i+1),ry(i+2)]);
    u=reshape(u,[ry(i)*n(i),ry(i+1)]);
    v=v/rmat{i+2}; v=reshape(v,[r,n(i+1)*ry(i+2)]);
    if ( dir == 1 )
        [u,rm]=qr(u,0);
        ind=maxvol2(u);
        r1=u(ind,:);
        u=u/r1; y{i}=reshape(u,[ry(i),n(i),ry(i+1)]);
        r1=r1*rm;
        v=r1*v; y{i+1}=reshape(v,[ry(i+1),n(i+1),ry(i+2)]);
        %Recalculate rmat
        u1=reshape(u,[ry(i),n(i)*ry(i+1)]);
        u1=rmat{i}*u1;
        u1=reshape(u1,[ry(i)*n(i),ry(i+1)]);
        [~,rm]=qr(u1,0);
        rmat{i+1}=rm;
        %Recalculate index array
        ind_old=index_array{i};
        ind_new=zeros(ry(i+1),i);
        for s=1:ry(i+1)
            f_in=ind(s);
            w1=tt_ind2sub([ry(i),n(i)],f_in);
            rs=w1(1); js=w1(2);
            ind_new(s,:)=[ind_old(rs,:),js];
        end
        index_array{i+1}=ind_new;
        if ( i == d - 1 )
            dir = -dir;
        else
            i=i+1;
        end
    else %Reverse direction
         v=v.'; %v is standing
        [v,rm]=qr(v,0);
        ind=maxvol2(v);
        r1=v(ind,:);
        v=v/r1; v2=reshape(v,[n(i+1),ry(i+2),ry(i+1)]); y{i+1}=permute(v2,[3,1,2]);
        r1=r1*rm; r1=r1.';
        u=u*r1; y{i}=reshape(u,[ry(i),n(i),ry(i+1)]);
        %Recalculate rmat
        v=v.';
        v=reshape(v,[ry(i+1)*n(i+1),ry(i+2)]);
        v=v*rmat{i+2};
        v=reshape(v,[ry(i+1),n(i+1)*ry(i+2)]); v=v.';
        [~,rm]=qr(v,0);
        rmat{i+1}=rm;
        %Recalculate index array
        ind_old=index_array{i+2};
        ind_new=zeros(d-i,ry(i+1));
        for s=1:ry(i+1);
            f_in=ind(s);
            w1=tt_ind2sub([n(i+1),ry(i+2)],f_in);
            rs=w1(2); js=w1(1);
            ind_new(:,s)=[js,ind_old(:,rs)'];
        end
        index_array{i+1}=ind_new;
        if ( i == 1 )
            dir=-dir;
            swp = swp + 1;
            if ( er_max < eps )
                not_converged=false;
            else
                er_max=0;
            end
        else
            i=i-1;
        end
    end
end
return
end
function val = my_vec_fun(ind, fun)
%Trivial vectorized computation of the elements of a tensor
%   [VAL]=MY_VEC_FUN(IND,FUN) Given a function handle FUN, compute all
%   elements of a tensor given in the index array IND. IND is a M x d
%   array, where M is the number of indices to be computed.
M = size(ind, 1);
val = zeros(1, M);
for i = 1:M
    ind_loc = ind(i,:); ind_loc=ind_loc(:);
%   ind_loc = ind(:,i);
   val(i) = fun(ind_loc);
end
return
end


function T=findBaylissSubarrays(xyPoints,numLevels,sidelobedB,N,adjMat)
%%FINDBAYLISSSUBARRAYS Given a elements for a linear array or for a planar
%          array with a circular aperture, group the elements into
%          subarrays that discretize Bayliss difference patterns to a given
%          number of levels. For a planar array, both horizontal and
%          vertical difference pattern are overlapped so that the subarrays
%          can produce difference patterns in either direction. This
%          implements the basic method of determining subarrays as in [1].
%
%INPUTS: xyPoints A 2XnumPoints set of numPoints points in the aperture
%             plane corresponding to element positions. For a linear array,
%             this is a 1XnumPoints set of points. The points should be
%             shifted such that the center of the aperture is the origin.
%             The width of the aperture is the maximum distance of any
%             point from the center.
%   numLevels The number of levels to use in discretizing the Bayliss
%             pattern. If this parameter is omitted or an empty matrix is
%             passed, a default of 4 is used.
%  sidelobedB The number of decibels of the ratio of the close-in
%             sidelobe voltages to the main lobe voltage in the differnce
%             pattern. This must be a negative number. A typical value is
%             -30.
%           N The Bayliss tapering is computed using a certain number of
%             terms. Using too many terms can be undesirable as edge
%             illumination increases, as noted in [1]. If this parameter is
%             omitted or an empty matrix is passed, then the default of 17
%             is used. In [1], it is suggested that N be chosen to be
%             <2*a/lambda, where a is the radius of the aperture and
%             lambda the wavelength.
%      adjMat This parameter is only used with planar arrays and is
%             optional. This is a numPointsXnumPoints adjacency matrix such
%             that adjMat(i,j) is nonzero if element i is adjacent to
%             element j. The value of adjMat(i,i) does not matter. Only the
%             lower half of this matrix is used. If this matrix is omitted
%             or an empty matrix is passed, all elements are taken to be
%             adjacent to each other. The purpose of this matrix is to make
%             sure that no disjoint subarrays are formed. That is, a
%             subarray consists of a continuum of adjacent elements with no
%             breaks.
%
%OUTPUTS: T A numSubarraysXnumPoints boolean matrix (a matrix such that
%           T(i,:) is a set of boolean values indicating which elements are
%           in each subarray). The subarrays do not overlap.
%
%The design of subarrays is a very difficult optimization problem. This
%implements the algorithm of [1], which is based on the idea that the
%ability to form good difference beams should play a role in subarray
%design. The method presented is significatnly simpler than many of the
%genetic optimization methods in the literature.
%
%EXAMPLE 1:
%This is an example of a linear array being broken into six subarrays.
% N=17;
% sidelobedB=-30;
% Nx=41;%There are 2*Nx+1 points total.
% %Generate points symmetric about the origin.
% xPoints=(-(Nx-1)/2):1/2:((Nx-1)/2);
% numLevels=6;%Discretize into four levels.
% T=findBaylissSubarrays(xPoints,numLevels,sidelobedB,N);
%
% %Display the elements in the array with different coloring for each
% %subarray.
% figure(1)
% clf
% hold on
% els=xPoints(T(1,:));
% numEls=length(els);
% scatter(els,zeros(1,numEls),'or')
% els=xPoints(T(2,:));
% numEls=length(els);
% scatter(els,zeros(1,numEls),'xg')
% els=xPoints(T(3,:));
% numEls=length(els);
% scatter(els,zeros(1,numEls),'+b')
% els=xPoints(T(4,:));
% numEls=length(els);
% scatter(els,zeros(1,numEls),'*k')
% els=xPoints(T(5,:));
% numEls=length(els);
% scatter(els,zeros(1,numEls),'sc')
% els=xPoints(T(6,:));
% numEls=length(els);
% scatter(els,zeros(1,numEls),'dm')
%
%EXAMPLE 2:
%This is an example of a circular planar array. This requires the formation
%of two Bayliss patterns that are them discretized and overlapped. The
%elements in one row are offset by lambda/4 from those in the next, so they
%do not form a very regular grid.
% %First, we create a circular array. The element locations are given in
% %terms of the wavelength lambda, so lambda will not appear in the
% %equations for the sum beam.
% [xyVals,adjMat]=getShaped2DLattice([49;49],'circular');
%
% sidelobedB=-30;
% N=5;
% numLevels=3;
% T=findBaylissSubarrays(xyVals,numLevels,sidelobedB,N,adjMat);
%
% %Display the subarrays with different colors and symbols.
% figure(2)
% clf
% hold on
% axis square
% numSubarrays=size(T,1);
% dispOpts={'.b','og','xr','+c','*m','sy','dk','vg','^b','<r','>c','pm','hy'};
% for curSubarray=1:numSubarrays
%     points=xyVals(:,T(curSubarray,:));
%     optVal=mod(curSubarray,length(dispOpts))+1;
%     scatter(points(1,:),points(2,:),dispOpts{optVal},'linewidth',2);
% end
% h1=xlabel('x');
% h2=ylabel('y');
% title('Coloring Represents Subarrays')
% set(gca,'FontSize',14,'FontWeight','bold','FontName','Times')
% set(h1,'FontSize',14,'FontWeight','bold','FontName','Times')
% set(h2,'FontSize',14,'FontWeight','bold','FontName','Times')
%
%REFERENCES:
%[1] U. R. O. Nickel, "Subarray configurations for digital beamforming with
%    low sidelobes and adaptive interference suppression," in Record of the
%    IEEE International Radar Conference, Alexandria, VA, 8-11 May 1995,
%    pp. 714-719.
%
%August 2016 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

if(nargin<4||isempty(N))
    N=17;
end

if(nargin<3||isempty(sidelobedB))
    sidelobedB=-30;
end

if(nargin<2||isempty(numLevels))
   numLevels=4;
end

switch(size(xyPoints,1))
    case 1%Linear array
        %Bayliss weights are all imaginary.
        g=BaylissLinearTapering(sidelobedB,N,xyPoints);
        T=discretizeAndOverlapVals(imag(g),[],numLevels);
    case 2%Planar array
        numEls=size(xyPoints,2);

        if(nargin<5||isempty(adjMat))
            %If no adjacency matrix is given, then everything is adjacent.
            adjMat=ones(numEls,numEls);
        end

        %Bayliss weights are all complex.
        %Weights for horizontal differencing (in u)
        gHoriz=BaylissTapering(sidelobedB,N,xyPoints);
        %Weights for vertical differencing (in v)
        gVert=BaylissTapering(sidelobedB,N,flipud(xyPoints));

        %Bayliss weights are all imaginary.
        T=discretizeAndOverlapVals(imag(gHoriz),imag(gVert),numLevels,adjMat);
    otherwise
        error('Only linear and planar arrays are implemented.')
end
end

%LICENSE:
%
%The source code is in the public domain and not licensed or under
%copyright. The information and software may be used freely by the public.
%As required by 17 U.S.C. 403, third parties producing copyrighted works
%consisting predominantly of the material produced by U.S. government
%agencies must provide notice with such work(s) identifying the U.S.
%Government material incorporated and stating that such material is not
%subject to copyright protection.
%
%Derived works shall not identify themselves in a manner that implies an
%endorsement by or an affiliation with the Naval Research Laboratory.
%
%RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF THE
%SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY THE NAVAL
%RESEARCH LABORATORY FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE ACTIONS
%OF RECIPIENT IN THE USE OF THE SOFTWARE.


function b = r8mat_gesl ( a, n, pivot, b, job )

%*****************************************************************************80
%
%% R8MAT_GESL solves a system factored by R8MAT_GEFA.
%
%  Discussion:
%
%    This is a simplified version of the LINPACK routine DGESL.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Jack Dongarra, Cleve Moler, Jim Bunch, Pete Stewart,
%    LINPACK User's Guide,
%    SIAM, (Society for Industrial and Applied Mathematics),
%    3600 University City Science Center,
%    Philadelphia, PA, 19104-2688.
%    ISBN 0-89871-172-X
%
%  Parameters:
%
%    Input, real A(N,N), the LU factors from R8MAT_GEFA.
%
%    Input, integer N, the order of the matrix.
%    N must be positive.
%
%    Input, integer PIVOT(N), the pivot vector from R8MAT_GEFA.
%
%    Input, real B(N), the right hand side vector.
%
%    Input, integer JOB, specifies the operation.
%    0, solve A * x = b.
%    nonzero, solve A' * x = b.
%
%    Output, real B(N), the solution vector.
%

%
%  Solve A * x = b.
%
  if ( job == 0 )
%
%  Solve PL * Y = B.
%
    for k = 1 : n - 1

      l = pivot(k)

      if ( l ~= k )
        temp = b(l);
        b(l) = b(k);
        b(k) = temp;
      end

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

    end
%
%  Solve U * X = Y.
%
    for k = n : -1 : 1
      b(k) = b(k) / a(k,k);
      b(1:k-1) = b(1:k-1) - a(1:k-1,k) * b(k);
    end
%
%  Solve A' * X = B.
%
  else
%
%  Solve U' * Y = B.
%
    for k = 1 : n
      b(k) = ( b(k) - b(1:k-1) * a(1:k-1,k) ) / a(k,k);
    end
%
%  Solve ( PL )' * X = Y.
%
    for k = n - 1 : -1 : 1

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

      l = pivot(k);

      if ( l ~= k )
        temp = b(l);
        b(l) = b(k);
        b(k) = temp;
      end

    end

  end

  return
end


% SPECTRAL EFFICIENCY CURVES - UPPER BOUNDS ON RATE

if(0) % set to (1) if you wish to run the converse_mc function

    n = 1e3;
    Pe = 1e-5;
    SNRdB = -15:7;
    uno = ones(size(SNRdB));tic

    % normal approximation - expected execution time 0.5 sec
    tic; rhoNA = 2*converse_mc(n*uno,Pe*uno,SNRdB,'normal'); % spectral efficiency
    EbN0NA = SNRdB-10*log10(rhoNA); toc
    % O(n^-2) approximation - expected execution time 10 sec
    tic; rhoPPV2 = 2*converse_mc(n*uno,Pe*uno,SNRdB,'On2'); % spectral efficiency
    EbN0PPV2 = SNRdB-10*log10(rhoPPV2); toc
    % O(n^-3) approximation - expected execution time 20 sec
    tic; rhoPPV3 = 2*converse_mc(n*uno,Pe*uno,SNRdB,'On3'); % spectral efficiency
    EbN0PPV3 = SNRdB-10*log10(rhoPPV3); toc
    % full approximation - expected execution time 10 min
    tic; rhoPPV = 2*converse_mc(n*uno,Pe*uno,SNRdB,'full'); % spectral efficiency
    EbN0PPV = SNRdB-10*log10(rhoPPV); toc

    % save('example_speff.mat')
else
    load('example_speff.mat')
end

% display results
close all
figure(1)
set(0,'defaulttextinterpreter','latex')
semilogy(EbN0PPV3,rhoPPV3,'--', EbN0PPV,rhoPPV,'-',EbN0PPV2,rhoPPV2,'--',EbN0NA,rhoNA,'-.x')
xlabel('SNR $E_b/N_0$')
ylabel('spectral efficiency $\rho$ [bit/s/Hz]')
title(['n = ' num2str(n) ', Pe = ', num2str(Pe)])
legend({},'interpreter','latex')
legend('$O(n^{-3}\,)$ approx $\quad$','full approx','$O(n^{-2}\,)$ approx',...
    'normal approx','Location','Best')
grid


function [transform] = pos2transform(pos, dim)

% POS2TRANSFORM reconstructs a transformation matrix from an ordered list
% of positions.
%
% Use as
%   [transform] = pos2transform(pos, dim)
% where pos is an ordered list of positions that should specify a full 3D volume.
%
% The output transform is a 4x4 homogenous transformation matrix which transforms
% from 'voxelspace' into the positions provided in the input
%
% See also POS2DIM

% Copyright (C) 2009, Jan-Mathijs Schoffelen

if nargin>1
  % do nothing
else
  dim = pos2dim(pos);
end
x   = 1:dim(1);
y   = 1:dim(2);
z   = 1:dim(3);
[X,Y,Z] = ndgrid(x, y, z);
ind = [X(:) Y(:) Z(:)];
ind = ind'; ind(4,:) = 1;
pos = pos'; pos(4,:) = 1;

% build in some robustness against nans
sel = sum(isfinite(pos))==4;

transform = pos(:,sel)/ind(:,sel);


function varargout = smoothMesh(varargin)
%SMOOTHMESH Smooth mesh by replacing each vertex by the average of its neighbors.
%
%   V2 = smoothMesh(V, F)
%   [V2, F2] = smoothMesh(V, F)
%   Performs smoothing of the values given in V, by using adjacency
%   information given in F.
%   V is a numeric array representing either vertex coordinate, or value
%   field associated to each vertex. F is an array of faces, given either
%   as a NF-by-3 or NF-by-4 numeric array, or as a cell array.
%   Artifact adjacencies are added if faces have more than 4 vertices.
%
%   ... = smoothMesh(V, F, NITER)
%   Repeat the smoothing procedure NITER times. This is equivalent to
%   calling the smoothMesh function NITER times.
%
%
%   Example
%     [v f] = torusMesh([50 50 50 30 10 30 45]);
%     v = v + randn(size(v));
%     [v2 f] = smoothMesh(v, f, 3);
%     figure; drawMesh(v2, f);
%     l = light; lighting gouraud
%
%   See also
%     meshes3d, meshAdjacencyMatrix, triangulateFaces, drawMesh
%

% ------
% Author: David Legland
% E-mail: david.legland@inra.fr
% Created: 2013-04-29, using Matlab 7.9.0.529 (R2009b)
% Copyright 2013-2022 INRA - Cepia Software Platform

var1 = varargin{1};
if isstruct(var1)
    vertices = var1.vertices;
    faces = var1.faces;
    varargin(1) = [];
else
    vertices = varargin{1};
    faces = varargin{2};
    varargin(1:2) = [];
end

% determine number of iterations
nIter = 1;
if ~isempty(varargin)
    nIter = varargin{1};
end

% compute adjacency matrix,
% result is a Nv-by-Nv matrix with zeros on the diagonal
adj = meshAdjacencyMatrix(faces);

% ensure the size of the matrix is Nv-by-Nv
% (this can not be the case if some vertices are not referenced)
nv = size(vertices, 1);
if size(adj, 1) < nv
    adj(nv, nv) = 0;
end

% Add "self adjacencies"
adj = adj + speye(nv);

% weight each vertex by the number of its neighbors
w = spdiags(full(sum(adj, 2).^(-1)), 0, nv, nv);
adj = w * adj;

% do averaging to smooth the field
v2 = vertices;
for k = 1:nIter
    v2 = adj * v2;
end

varargout = formatMeshOutput(nargout, v2, faces);

%% Old version
% % Compute vertex adjacencies
% edges = computeMeshEdges(faces);
% v2 = zeros(size(vertices));
%
% % apply several smoothing
% for iter = 1:nIter
%
%     % replace the coords of each vertex by the average coordinate in the
%     % neighborhood
%     for i = 1:size(vertices, 1)
%         edgeInds = sum(edges == i, 2) > 0;
%         neighInds = unique(edges(edgeInds, :));
%         v2(i, :) = mean(vertices(neighInds, :));
%     end
%
%     % update for next iteration
%     vertices = v2;
% end


function out = apply_HLDA(C, X)
% APPLY_HLDA - Hierarchical linear discriminant analysis
%
%Synopsis:
%   out = apply_HLDA(C, X)
%
%Arguments:
%   C: STRUCT           - a hierarchical LDA classifier structure that
%                           contains the individual segment classifiers and
%                           the top-level classifier. Must include the
%                           fields 'seg' and 'final'.
%   X: DOUBLE [TxNxM] - Data matrix, with T temporal features, N
%                           N spatial features, and M
%                           training points/examples.
%Returns:
%   out: FLOAT[]        - an array containing the classifier score for each
%                           sample
%Description:
%   APPLY_HLDA applies a hierarchical LDA classifier given data and a
%   trained HLDA classifier.
%
%   References:Gerson, A.D., Parra, L.C., Sajda, P.: Cortically coupled
%   computer vision for rapid image search. IEEE Transactions on Neural
%   Systems and Rehabilitation Engineering 14, 174–179 (2006).
%
%Examples:
%   apply_HLDA(C, X)
%
%See also:
% train_HLDA

% validate argument types
misc_checkType(C, 'STRUCT(seg final)');
misc_checkType(X, 'DOUBLE');
if isfield(C,'nChannels')
  misc_checkType(X, 'DOUBLE[- -]');
end

nSegments = length(C.seg);

dims = size(X);

% make data matrix 3D if it has been tranformed to 2D for crossvalidation
if (length(size(X)) == 2) && isfield(C, 'nChannels')
  X = reshape(X, [], C.nChannels, dims(2));
end

dims = size(X);
%boundary indices between segments
seg_idx = round(linspace(0, dims(1), nSegments+1));

seg_scores = zeros(nSegments, dims(end));

for i = 1:nSegments
    seg = X(seg_idx(i) + 1 : seg_idx(i + 1), :, :); % i-th segment of X
    %apply LDA classifier for this segment
    seg = reshape(seg, [], dims(end));
    seg_scores(i,:) = apply_separatingHyperplane(C.seg(i), seg); %get classifier scores for segment
end

if isfield(C.final, 'B')
    %logistic regression as top-level classifier
%    exps = C.final.B(1) + C.final.B(2:end)'*seg_scores;
%    out = 1./(1 + exp(-exps));

    pihat = mnrval(C.final.B, seg_scores');

    pihat = pihat';
    out = pihat(1,:);
    %transform scores to interval [-1 1]
    out = -2*(out - 0.5);
else
    %LDA as top-level classifier
    out = apply_separatingHyperplane(C.final, seg_scores);
end


function fem1d_bvp_linear_test09 ( )

%*****************************************************************************80
%
%% FEM1D_BVP_LINEAR_TEST09 carries out test case #9.
%
%  Location:
%
%    http://people.sc.fsu.edu/~jburkardt/m_src/fem1d_bvp_linear/fem1d_bvp_linear_test09.m
%
%  Discussion:
%
%    Use A9, C9, F9, EXACT9, EXACT_UX9.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 June 2014
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Dianne O'Leary,
%    Scientific Computing with Case Studies,
%    SIAM, 2008,
%    ISBN13: 978-0-898716-66-5,
%    LC: QA401.O44.
%
  n = 11;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'FEM1D_BVP_LINEAR_TEST09\n' );
  fprintf ( 1, '  Solve -( A(x) U''(x) )'' + C(x) U(x) = F(x)\n' );
  fprintf ( 1, '  for 0 < x < 1, with U(0) = U(1) = 0.\n' );
  fprintf ( 1, '  A9(X)  = 1.0\n' );
  fprintf ( 1, '  C9(X)  = 0.0\n' );
  fprintf ( 1, '  F9(X)  = X * ( X + 3 ) * exp ( X ),   X <= 2/3\n' );
  fprintf ( 1, '         = 2 * exp ( 2/3),                   2/3 < X\n' );
  fprintf ( 1, '  U9(X)  = X * ( 1 - X ) * exp ( X ),   X <= 2/3\n' );
  fprintf ( 1, '         = X * ( 1 - X ),                    2/3 < X\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Number of nodes = %d\n', n );
%
%  Geometry definitions.
%
  x_first = 0.0;
  x_last = 1.0;
  x = linspace ( x_first, x_last, n );
  x = x(:);

  u = fem1d_bvp_linear ( n, @a9, @c9, @f9, x );

  uexact = exact9 ( x );

  fprintf ( 1, '\n' );
  fprintf ( 1, '     I    X         U         Uexact    Error\n' );
  fprintf ( 1, '\n' );

  for i = 1 : n
    fprintf ( 1, '  %4d  %8f  %8f  %8f  %8e\n', ...
      i, x(i), u(i), uexact(i), abs ( u(i) - uexact(i) ) );
  end

  e1 = l1_error ( n, x, u, @exact9 );
  e2 = l2_error_linear ( n, x, u, @exact9 );
  h1s = h1s_error_linear ( n, x, u, @exact_ux9 );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  l1 norm of error  = %g\n', e1 );
  fprintf ( 1, '  L2 norm of error  = %g\n', e2 );
  fprintf ( 1, '  Seminorm of error = %g\n', h1s  );

  return
end
function value = a9 ( x )

%*****************************************************************************80
%
%% A9 evaluates A function #9.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 June 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the evaluation point.
%
%    Output, real VALUE, the value of A(X).
%
  value = 1.0;

  return
end
function value = c9 ( x )

%*****************************************************************************80
%
%% C9 evaluates C function #9.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 June 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the evaluation point.
%
%    Output, real VALUE, the value of C(X).
%
  value = 0.0;

  return
end
function value = exact9 ( x )

%*****************************************************************************80
%
%% EXACT9 evaluates exact solution #9.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 June 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the evaluation point.
%
%    Output, real VALUE, the value of U(X).
%
  value = x .* ( 1.0 - x ) .* exp ( x )         .* ( x <= 2.0 / 3.0 ) ...
        + x .* ( 1.0 - x )                      .* ( 2.0 / 3.0 < x );

  return
end
function value = exact_ux9 ( x )

%*****************************************************************************80
%
%% EXACT_UX9 evaluates the derivative of exact solution #9.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 June 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the evaluation point.
%
%    Output, real VALUE, the value of dUdX(X).
%
  value = ( 1.0 - x - x .* x ) .* exp ( x )         .* ( x <= 2.0 / 3.0 ) ...
        + ( 1.0 - 2.0 * x )                         .* (      2.0 / 3.0 < x );

  return
end
function value = f9 ( x )

%*****************************************************************************80
%
%% F9 evaluates right hand side function #9.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 June 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the evaluation point.
%
%    Output, real VALUE, the value of F(X).
%
  value = x .* ( x + 3.0 ) .* exp ( x )         .* ( x <= 2.0 / 3.0 ) ...
        +               2.0                     .* (      2.0 / 3.0 < x );

  return
end


function jed = ymd_to_jed_common ( y, m, d )

%*****************************************************************************80
%
%% YMD_TO_JED_COMMON converts a Common YMD date to a JED.
%
%  Discussion:
%
%    The "common" calendar is meant to be the calendar which is Julian up to
%    day JED = 2299160, and Gregorian from day JED = 2299161 and after.
%
%    The Julian Ephemeris Date is essentially a count of the number
%    of days that have elapsed since noon, 1 January 4713 BC, at
%    Greenwich, England.  Strictly speaking, the Julian Ephemeris Date
%    is counted from noon, and thus day "0" began at noon on 1 January 4713 BC,
%    and ended at noon on 2 January 4713 BC.
%
%    The Julian Ephemeris Date was devised by Joseph Scaliger in 1583.
%
%    The Julian Ephemeris Date has been adopted by astronomers as
%    a convenient reference for dates.
%
%  Example:
%
%       Y   M     D         JED
%    --------------     -------
%    BC 4713 Jan  1           0
%    AD 1968 May 23     2440000
%    AD 1984 Dec 31     2446065
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 October 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer Y, M, D, the YMD date.
%
%    Output, real JED, the Julian Ephemeris Date.
%

%
%  Copy the month and year.
%
  y2 = 1582;
  m2 = 10;
  d2 = 4+1;

  cmp = ymd_compare ( y, m, d, y2, m2, d2 );

  if ( cmp == '<' )
    jed = ymd_to_jed_julian ( y, m, d );
    return
  end
%
%  Use the Gregorian calendar for dates strictly after 1752/9/13.
%
  y2 = 1582;
  m2 = 10;
  d2 = 15-1;

  cmp = ymd_compare ( y, m, d, y2, m2, d2 );

  if ( cmp == '>' )
    jed = ymd_to_jed_gregorian ( y, m, d );
    return
  end

  fprintf ( 1, '\n' );
  fprintf ( 1, 'YMD_TO_JED_COMMON - Fatal error!\n' );
  fprintf ( 1, '  Illegal date!\n' );
  error ( 'YMD_TO_JED_COMMON - Fatal error!' );

  return
end


function [snr_mean, segsnr_mean]= comp_SNR(cleanFile, enhdFile);
%
%   Segmental Signal-to-Noise Ratio Objective Speech Quality Measure
%
%     This function implements the segmental signal-to-noise ratio
%     as defined in [1, p. 45] (see Equation 2.12).
%
%   Usage:  [SNRovl, SNRseg]=comp_snr(cleanFile.wav, enhancedFile.wav)
%
%         cleanFile.wav - clean input file in .wav format
%         enhancedFile  - enhanced output file in .wav format
%         SNRovl        - overall SNR (dB)
%         SNRseg        - segmental SNR (dB)
%
%     This function returns 2 parameters.  The first item is the
%     overall SNR for the two speech signals.  The second value
%     is the segmental signal-to-noise ratio (1 seg-snr per
%     frame of input).  The segmental SNR is clamped to range
%     between 35dB and -10dB (see suggestions in [2]).
%
%   Example call:  [SNRovl,SNRseg]=comp_SNR('sp04.wav','enhanced.wav')
%
%  References:
%
%     [1] S. R. Quackenbush, T. P. Barnwell, and M. A. Clements,
%	    Objective Measures of Speech Quality.  Prentice Hall
%	    Advanced Reference Series, Englewood Cliffs, NJ, 1988,
%	    ISBN: 0-13-629056-6.
%
%     [2] P. E. Papamichalis, Practical Approaches to Speech
%	    Coding, Prentice-Hall, Englewood Cliffs, NJ, 1987.
%	    ISBN: 0-13-689019-9. (see pages 179-181).
%
%  Authors: Bryan L. Pellom and John H. L. Hansen (July 1998)
%  Modified by: Philipos C. Loizou  (Oct 2006)
%
% Copyright (c) 2006 by Philipos C. Loizou
% $Revision: 0.0 $  $Date: 10/09/2006 $
%-------------------------------------------------------------------------

if nargin ~=2
    fprintf('USAGE: [snr_mean, segsnr_mean]= comp_SNR(cleanFile, enhdFile) \n');
    return;
end

[data1, Srate1, Nbits1]= wavread(cleanFile);
[data2, Srate2, Nbits2]= wavread(enhdFile);
if (( Srate1~= Srate2) | ( Nbits1~= Nbits2))
    error( 'The two files do not match!\n');
end

len= min( length( data1), length( data2));
data1= data1( 1: len);
data2= data2( 1: len);

[snr_dist, segsnr_dist]= snr( data1, data2,Srate1);

snr_mean= snr_dist;
segsnr_mean= mean( segsnr_dist);

% =========================================================================
function [overall_snr, segmental_snr] = snr(clean_speech, processed_speech,sample_rate)

% ----------------------------------------------------------------------
% Check the length of the clean and processed speech.  Must be the same.
% ----------------------------------------------------------------------

clean_length      = length(clean_speech);
processed_length  = length(processed_speech);

if (clean_length ~= processed_length)
  disp('Error: Both Speech Files must be same length.');
  return
end

% ----------------------------------------------------------------------
% Scale both clean speech and processed speech to have same dynamic
% range.  Also remove DC component from each signal
% ----------------------------------------------------------------------

%clean_speech     = clean_speech     - mean(clean_speech);
%processed_speech = processed_speech - mean(processed_speech);

%processed_speech = processed_speech.*(max(abs(clean_speech))/ max(abs(processed_speech)));

overall_snr = 10* log10( sum(clean_speech.^2)/sum((clean_speech-processed_speech).^2));

% ----------------------------------------------------------------------
% Global Variables
% ----------------------------------------------------------------------

winlength   = round(30*sample_rate/1000); %240;		   % window length in samples for 30-msecs
skiprate    = floor(winlength/4); %60;		   % window skip in samples
MIN_SNR     = -10;		   % minimum SNR in dB
MAX_SNR     =  35;		   % maximum SNR in dB

% ----------------------------------------------------------------------
% For each frame of input speech, calculate the Segmental SNR
% ----------------------------------------------------------------------

num_frames = clean_length/skiprate-(winlength/skiprate); % number of frames
start      = 1;					% starting sample
window     = 0.5*(1 - cos(2*pi*(1:winlength)'/(winlength+1)));

for frame_count = 1: num_frames

   % ----------------------------------------------------------
   % (1) Get the Frames for the test and reference speech.
   %     Multiply by Hanning Window.
   % ----------------------------------------------------------

   clean_frame = clean_speech(start:start+winlength-1);
   processed_frame = processed_speech(start:start+winlength-1);
   clean_frame = clean_frame.*window;
   processed_frame = processed_frame.*window;

   % ----------------------------------------------------------
   % (2) Compute the Segmental SNR
   % ----------------------------------------------------------

   signal_energy = sum(clean_frame.^2);
   noise_energy  = sum((clean_frame-processed_frame).^2);
   segmental_snr(frame_count) = 10*log10(signal_energy/(noise_energy+eps)+eps);
   segmental_snr(frame_count) = max(segmental_snr(frame_count),MIN_SNR);
   segmental_snr(frame_count) = min(segmental_snr(frame_count),MAX_SNR);

   start = start + skiprate;

end


function bic = ml_bic(ll,num_para,num_data)
%ML_BIC  Bayesian information criterion
%
%   input -----------------------------------------------------------------
%
%       o ll        : (1 x 1), log-likelihood.
%
%       o num_para  : (1 x 1), number of parameters.
%
%       o num_data  : (1 x 1), number of datapoints.
%
%   output ----------------------------------------------------------------
%
%       o bic       : (1 x 1)

 bic =  -2 * ll + num_para * log(num_data);

end


function [result, t] = linfactor (arg1, arg2)
%LINFACTOR factorize a matrix, or use the factors to solve Ax=b.
% Uses LU or CHOL to factorize A, or uses a previously computed factorization to
% solve a linear system.  This function automatically selects an LU or Cholesky
% factorization, depending on the matrix.  A better method would be for you to
% select it yourself.  Note that mldivide uses a faster method for detecting
% whether or not A is a candidate for sparse Cholesky factorization (see spsym
% in the CHOLMOD package, for example).
%
% Example:
%   F = linfactor (A) ;     % factorizes A into the object F
%   x = linfactor (F,b) ;   % uses F to solve Ax=b
%   norm (A*x-b)
%
% A second output is the time taken by the method, ignoring the overhead of
% determining which method to use.  This makes for a fairer comparison between
% methods, since normally the user will know if the matrix is supposed to be
% symmetric positive definite or not, and whether or not the matrix is sparse.
% Also, the overhead here is much higher than mldivide or spsym.
%
% This function has its limitations:
%
% (1) determining whether or not the matrix is symmetric via nnz(A-A') is slow.
%     mldivide (and spsym in CHOLMOD) do it much faster.
%
% (2) MATLAB really needs a sparse linsolve.  See cs_lsolve, cs_ltsolve, and
%     cs_usolve in CSparse, for example.
%
% (3) this function really needs to be written as a mexFunction.
%
% (4) the full power of mldivide is not brought to bear.  For example, UMFPACK
%     is not very fast for sparse tridiagonal matrices.  It's about a factor of
%     four slower than a specialized tridiagonal solver as used in mldivide.
%
% (5) permuting a sparse vector or matrix is slower in MATLAB than it should be;
%     a built-in linfactor would reduce this overhead.
%
% (6) mldivide when using UMFPACK uses relaxed partial pivoting and then
%     iterative refinement.  This leads to sparser LU factors, and typically
%     accurate results.  linfactor uses sparse LU without iterative refinement.
%
% The primary purpose of this function is to answer The Perennially Asked
% Question (or The PAQ for short (*)):  "Why not use x=inv(A)*b to solve Ax=b?
% How do I use LU or CHOL to solve Ax=b?"  The full answer is below.  The short
% answer to The PAQ (*) is "PAQ=LU ... ;-) ... never EVER use inv(A) to solve
% Ax=b."
%
% The secondary purpose of this function is to provide a prototype for some of
% the functionality of a true MATLAB built-in linfactor function.
%
% Finally, the third purpose of this function is that you might find it actually
% useful for production use, since its syntax is simpler than factorizing the
% matrix yourself and then using the factors to solve the system.
%
% See also lu, chol, mldivide, linsolve, umfpack, cholmod.
%
% Oh, did I tell you never to use inv(A) to solve Ax=b?
%
% Requires MATLAB 7.3 (R2006b) or later.

% Copyright 2007, Timothy A. Davis, University of Florida
% VERSION 1.1.0, Nov 1, 2007

if (nargin < 1 | nargin > 2 | nargout > 2)          %#ok
    error ('Usage: F=linfactor(A) or x=linfactor(F,b)') ;
end

if (nargin == 1)

    %---------------------------------------------------------------------------
    % F = linfactor (A) ;
    %---------------------------------------------------------------------------

    A = arg1 ;
    [m n] = size (A) ;
    if (m ~= n)
        error ('linfactor: A must be square') ;
    end

    if (issparse (A))

        % try sparse Cholesky (CHOLMOD): L*L' = P*A*P'
        if (nnz (A-A') == 0 & all (diag (A) > 0))   %#ok
            try
                tic ;
                [L, g, PT] = chol (A, 'lower') ;
                t = toc ;
                if (g == 0)
                    result.L = L ;
                    result.LT = L' ;    % takes more memory, but solve is faster
                    result.P = PT' ;    % ditto.  Need a sparse linsolve here...
                    result.PT = PT ;
                    result.kind = 'sparse Cholesky: L*L'' = P*A*P''' ;
                    result.code = 0 ;
                    return
                end
            catch
		% matrix is symmetric, but not positive definite
		% (or we ran out of memory)
            end
        end

        % try sparse LU (UMFPACK, with row scaling): L*U = P*(R\A)*Q
        tic ;
        [L, U, P, Q, R] = lu (A) ;
        t = toc ;
        result.L = L ;
        result.U = U ;
        result.P = P ;
        result.Q = Q ;
        result.R = R ;
        result.kind = 'sparse LU: L*U = P*(R\A)*Q where R is diagonal' ;
        result.code = 1 ;

    else

        % try dense Cholesky (LAPACK): L*L' = A
        if (nnz (A-A') == 0 & all (diag (A) > 0))                           %#ok
            try
                tic ;
                L = chol (A, 'lower') ;
                t = toc ;
                result.L = L ;
                result.kind = 'dense Cholesky: L*L'' = A' ;
                result.code = 2 ;
                return
            catch
		% matrix is symmetric, but not positive definite
		% (or we ran out of memory)
            end
        end

        % try dense LU (LAPACK): L*U = A(p,:)
        tic ;
        [L, U, p] = lu (A, 'vector') ;
        t = toc ;
        result.L = L ;
        result.U = U ;
        result.p = p ;
        result.kind = 'dense LU: L*U = A(p,:)' ;
        result.code = 3 ;

    end

else

    %---------------------------------------------------------------------------
    % x = linfactor (F,b)
    %---------------------------------------------------------------------------

    F = arg1 ;
    b = arg2 ;

    if (F.code == 0)

        % sparse Cholesky: MATLAB could use a sparse linsolve here ...
        tic ;
        result = F.PT * (F.LT \ (F.L \ (F.P * b))) ;
        t = toc ;

    elseif (F.code == 1)

        % sparse LU: MATLAB could use a sparse linsolve here too ...
        tic ;
        result = F.Q * (F.U \ (F.L \ (F.P * (F.R \ b)))) ;
        t = toc ;

    elseif (F.code == 2)

        % dense Cholesky: result = F.L' \ (F.L \ b) ;
        lower.LT = true ;
        upper.LT = true ;
        upper.TRANSA = true ;
        tic ;
        result = linsolve (F.L, linsolve (F.L, b, lower), upper) ;
        t = toc ;

    elseif (F.code == 3)

        % dense LU: result = F.U \ (F.L \ b (F.p,:)) ;
        lower.LT = true ;
        upper.UT = true ;
        tic ;
        result = linsolve (F.U, linsolve (F.L, b (F.p,:), lower), upper) ;
        t = toc ;
    end
end


function scatterbar3(X,Y,Z,width)
%SCATTERBAR3   3-D scatter bar graph.
%   SCATTERBAR3(X,Y,Z,WIDTH) draws 3-D bars of height Z at locations X and Y with width WIDTH.
%
%   X, Y and Z must be of equal size.  If they are vectors, than bars are placed
%   in the same fashion as the SCATTER3 or PLOT3 functions.
%
%   If they are matrices, then bars are placed in the same fashion as the SURF
%   and MESH functions.
%
%   The colors of each bar read from the figure's colormap according to the bar's height.
%
%   NOTE:  For best results, you should use the 'zbuffer' renderer.  To set the current
%   figure renderer to 'zbuffer' use the following command:
%
%       set(gcf,'renderer','zbuffer')
%
%    % EXAMPLE 1:
%    y=[1 2 3 1 2 3 1 2 3];
%    x=[1 1 1 2 2 2 3 3 3];
%    z=[1 2 3 6 5 4 7 8 9];
%    scatterbar3(x,y,z,1)
%    colorbar
%
%    % EXAMPLE 2:
%    [X,Y]=meshgrid(-1:0.25:1);
%    Z=2-(X.^2+Y.^2);
%    scatterbar3(X,Y,Z,0.2)
%    colormap(hsv)
%
%    % EXAMPLE 3:
%    t=0:0.1:(2*pi);
%    x=cos(t);
%    y=sin(t);
%    z=sin(t);
%    scatterbar3(x,y,z,0.07)

% By Mickey Stahl - 2/25/02
% Engineering Development Group
% Aspiring Developer

[r,c]=size(Z);
for j=1:r,
    for k=1:c,
        if ~isnan(Z(j,k))
            drawbar(X(j,k),Y(j,k),Z(j,k),width/2)
        end
    end
end

zlim=[min(Z(:)) max(Z(:))];
if zlim(1)>0,zlim(1)=0;end
if zlim(2)<0,zlim(2)=0;end
axis([min(X(:))-width max(X(:))+width min(Y(:))-width max(Y(:))+width zlim])
caxis([min(Z(:)) max(Z(:))])

function drawbar(x,y,z,width)

h(1)=patch([-width -width width width]+x,[-width width width -width]+y,[0 0 0 0],'b');
h(2)=patch(width.*[-1 -1 1 1]+x,width.*[-1 -1 -1 -1]+y,z.*[0 1 1 0],'b');
h(3)=patch(width.*[-1 -1 -1 -1]+x,width.*[-1 -1 1 1]+y,z.*[0 1 1 0],'b');
h(4)=patch([-width -width width width]+x,[-width width width -width]+y,[z z z z],'b');
h(5)=patch(width.*[-1 -1 1 1]+x,width.*[1 1 1 1]+y,z.*[0 1 1 0],'b');
h(6)=patch(width.*[1 1 1 1]+x,width.*[-1 -1 1 1]+y,z.*[0 1 1 0],'b');
set(h,'facecolor','flat','FaceVertexCData',z)


function asa058_test01 ( )

%*****************************************************************************80
%
%% TEST01 tries out the ASA058 routine.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 February 2008
%
%  Author:
%
%    John Burkardt
%
  k = 5;
  m = 2;
  n = 100;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST01\n' );
  fprintf ( 1, '  Test the CLUSTR algorithm.\n' );
  fprintf ( 1, '  Applied Statistics Algorithm 58\n' );
%
%  Read the data.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Reading the data.\n' );

  input_unit = fopen ( 'points_100.txt', 'rt' );

  for i = 1 : n
    x(i,1:m) = fscanf ( input_unit, '%f', m );
  end

  fclose ( input_unit );
%
%  Print a few data values.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  First 5 data values:\n' );
  fprintf ( 1, '\n' );
  for i = 1 : 5
    fprintf ( 1, '  %8d', i );
    for j = 1 : m
      fprintf ( 1, '  %14f', x(i,j) );
    end
    fprintf ( 1, '\n' );
  end
%
%  Initialize the cluster centers arbitrarily.
%
  for i = 1 : k
    for j = 1 : m
      d(i,j) = x(i,j);
    end
  end
%
%  Compute the clusters.
%
  nz = 1;
  k2 = k;

  [ d, dev, b, e ] = clustr ( x, d, n, m, k, nz, k2 );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Cluster  Population  Energy\n' );
  fprintf ( 1, '\n' );

  for i = 1 : k
    fprintf ( 1, '  %8d  %8d  %14f\n', i, e(i), dev(i) );
  end

  e_sum = sum ( e(1:k) );
  dev_sum = sum ( dev(1:k) );
  fprintf ( 1, '\n' );
  fprintf ( 1, '     Total  %8d  %14f\n', e_sum, dev_sum );

  return
end


function r = r8pbu_resid ( m, n, mu, a, x, b )

%*****************************************************************************80
%
%% R8PBU_RESID computes the residual R = B-A*X for R8PBU matrices.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    03 June 2014
%
%  Author:
%
%    John Burkardt
%
%  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 MU, the number of superdiagonals in the matrix.
%    MU must be at least 0 and no more than N-1.
%
%    Input, real A(MU+1,N), the matrix.
%
%    Input, real X(N), the vector to be multiplied by A.
%
%    Input, real B(M), the desired result A * x.
%
%    Output, real R(M), the residual R = B - A * X.
%
  r = r8pbu_mv ( m, n, mu, a, x );

  r(1:m) = b(1:m) - r(1:m);

  return
end


function [err, errK] = getHcurlerror3ND(node,elem,curlE,Eh,markedElem)
%% GETHCURLERROR3ND Hcurl norm of approximation error for the lowest order Nedelect element in 3-D.
%
% err = GETHCURLERROR3ND(node,elem,curlE,Eh,markedElem);
%
% Example
%
%     node = [-1,-1,-1; 1,-1,-1; 1,1,-1; -1,1,-1; -1,-1,1; 1,-1,1; 1,1,1; -1,1,1];
%     elem = [1,2,3,7; 1,6,2,7; 1,5,6,7; 1,8,5,7; 1,4,8,7; 1,3,4,7];
%     maxIt = 4;
%     HcurlErr = zeros(maxIt,1);
%     N = zeros(maxIt,1);
%     for k = 1:maxIt
%         [node,elem] = uniformbisect3(node,elem);
%         [elem2dof,edge] = dof3edge(elem);
%         pde = Maxwelldata2;
%         uI = edgeinterpolate(pde.exactu,node,edge);
%         HcurlErr(k) = getHcurlerror3ND(node,elem,pde.curlu,uI);
%         N(k) = length(uI);
%     end
%     r = showrate(N,HcurlErr,1,'b-+');
%     legend('||u-u_I||_{curl}',['N^{' num2str(r) '}'],'LOCATION','Best');
%
% See also getHcurlerror3ND1, getHcurlerror3ND2, getL2error3ND
%
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

%% Sort elem to ascend ordering
elem = sort(elem,2);

%% Construct Data Structure
elem2dof = dof3edge(elem);
NT = size(elem,1);% Ndof = max(elem2dof(:)); %N = size(node,1);
% compute curl phi
[Dlambda,volume] = gradbasis3(node,elem);
% curl phi = 2*Dlambda_i cross Dlambda_j;
curlPhi(:,:,6) = 2*cross(Dlambda(:,:,3),Dlambda(:,:,4),2);
curlPhi(:,:,1) = 2*cross(Dlambda(:,:,1),Dlambda(:,:,2),2);
curlPhi(:,:,2) = 2*cross(Dlambda(:,:,1),Dlambda(:,:,3),2);
curlPhi(:,:,3) = 2*cross(Dlambda(:,:,1),Dlambda(:,:,4),2);
curlPhi(:,:,4) = 2*cross(Dlambda(:,:,2),Dlambda(:,:,3),2);
curlPhi(:,:,5) = 2*cross(Dlambda(:,:,2),Dlambda(:,:,4),2);
curlEhp = zeros(NT,3);
for k = 1:6
    curlEhp = curlEhp + ...
    repmat(Eh(elem2dof(:,k)),1,3).*curlPhi(:,:,k);
end

%% compute Hcurl error element-wise
[lambda,w] = quadpts3(2);
nQuad = size(lambda,1);
errK = zeros(NT,1);
for p = 1:nQuad
    % quadrature points in the x-y-z coordinate
    pxy = lambda(p,1)*node(elem(:,1),:) ...
        + lambda(p,2)*node(elem(:,2),:) ...
        + lambda(p,3)*node(elem(:,3),:) ...
        + lambda(p,4)*node(elem(:,4),:);
    if isnumeric(curlE) % a constant vector
        curlEp = repmat(curlE,NT,1);
    else % function handel
        curlEp = curlE(pxy);
    end
%     curlEp = curlE(pxy);
    % compute Ehp at quadrature points
    errK = errK + w(p)*sum((curlEp - curlEhp).^2,2);
end
errK = errK.*volume;
% modify the error
errK(isnan(errK)) = 0; % remove the singular part
if (nargin == 5) && ~isempty(markedElem)
    errK = errK(markedElem); % error on some marked region
end
err = sqrt(sum(errK));
%% TODO write more M-lint


% SIS模型演示程序
clear;clc;
ts = 0 : 150;

x0=[0.2];   % 最初感染率，百万分之一

% lambda   日接触率
%  miu     日治愈率，即每天治愈病人数占病人总数的比例
lambda_miu = [0.27, 0.1;...
              0.25, 0.1;...
              0.20, 0.1;...
              0.15, 0.1;...
              0.08, 0.1];
infective_matrix = zeros(length(ts),length(lambda_miu));

for i = 1 : length(lambda_miu)
  lambda = lambda_miu(i,1);
  miu = lambda_miu(i,2);
  [t,x] = ode45(@(t,y) ill_sis(t,y,lambda,miu), ts, x0);
  infective_matrix(:,i) = x(:,1);
end

plot(t, infective_matrix);
legend(num2str(lambda_miu(1,:)), num2str(lambda_miu(2,:)), num2str(lambda_miu(3,:)), num2str(lambda_miu(4,:)), num2str(lambda_miu(5,:)));
title('SIS模型');
grid;