function value = r8_lngam ( x )

%*****************************************************************************80
%
%% R8_LNGAM evaluates the log of the absolute value of gamma of an R8 argument.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 September 2011
%
%  Author:
%
%    Original FORTRAN77 version by Wayne Fullerton.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Wayne Fullerton,
%    Portable Special Function Routines,
%    in Portability of Numerical Software,
%    edited by Wayne Cowell,
%    Lecture Notes in Computer Science, Volume 57,
%    Springer 1977,
%    ISBN: 978-3-540-08446-4,
%    LC: QA297.W65.
%
%  Parameters:
%
%    Input, real X, the argument.
%
%    Output, real VALUE, the logarithm of the absolute value of
%    the gamma function of X.
%
  persistent dxrel
  persistent sq2pil
  persistent sqpi2l
  persistent xmax

  sq2pil = 0.91893853320467274178032973640562;
  sqpi2l = +0.225791352644727432363097614947441;

  if ( isempty ( xmax ) )
    xmax = r8_mach ( 2 ) / log ( r8_mach ( 2 ) );
    dxrel = sqrt ( r8_mach ( 4 ) );
  end

  y = abs ( x );

  if ( y <= 10.0 )
    value = log ( abs ( r8_gamma ( x ) ) );
    return
  end

  if ( xmax < y )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8_LNGAM - Fatal error!\n' );
    fprintf ( 1, '  Result overflows, |X| too big.\n' );
    error ( 'R8_LNGAM - Fatal error!' )
  end

  if ( 0.0 < x )
    value = sq2pil + ( x - 0.5 ) * log ( x ) - x + r8_lgmc ( y );
    return
  end

  sinpiy = abs ( sin ( pi * y ) )

  if ( sinpiy == 0.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8_LNGAM - Fatal error!\n' );
    fprintf ( 1, '  X is a negative integer.\n' );
    error ( 'R8_LNGAM - Fatal error!' )
  end

  value = sqpi2l + ( x - 0.5 ) * log ( y ) - x - log ( sinpiy ) ...
    - r8_lgmc ( y );

  if ( abs ( ( x - r8_aint ( x - 0.5 ) ) * r8_lngam / x ) < dxrel )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8_LNGAM - Warning!\n' );
    fprintf ( 1, '  Result is half precision because\n' );
    fprintf ( 1, '  X is too near a negative integer.\n' );
  end

  return
end


function J=spherAngGradient(xG,systemType,lRx,M)
%%SPHERANGGRADIENT Determine the gradient of a 3D spherical azimuth and
%          elevation measurement with respect to 3D position. Relativity
%          and atmospheric effects are not taken into account.
%
%INPUTS: xG The 3XN position vectors in the global coordinate system, each
%          with [x;y;z] components.
% systemType An optional parameter specifying the axes from which the
%          angles are measured in radians. Possible vaues are
%          0 (The default if omitted) Azimuth is measured counterclockwise
%            from the x-axis in the x-y plane. Elevation is measured up
%            from the x-y plane (towards the z-axis). This is consistent
%            with common spherical coordinate systems for specifying
%            longitude (azimuth) and geocentric latitude (elevation).
%          1 Azimuth is measured counterclockwise from the z-axis in the
%            z-x plane. Elevation is measured up from the z-x plane
%            (towards the y-axis). This is consistent with some spherical
%            coordinate systems that use the z axis as the boresight
%            direction of the radar.
%          2 This is the same as 0 except instead of being given
%            elevation, one desires the angle away from the z-axis, which
%            is (pi/2-elevation).
%          3 This is the same as 0 except azimuth is measured clockwise
%            from the y-axis in the x-y plane instead of counterclockwise
%            from the x-axis. This coordinate system often arises when
%            given "bearings" in a local East-North-Up coordinate system,
%            where the bearing directions are measured East of North.
%      lRx The 3X1 position vector of the receiver. If omitted, the
%          receiver is placed at the origin. All vectors in x are assumed
%          to be from the same receiver.
%        M A 3X3 rotation matrix from the global Coordinate system to the
%          orientation of the coordinate system at the receiver. If
%          omitted, it is assumed to be the identity matrix. All vectors in
%          x are assumed to have the same rotation matrix.
%
%OUTPUTS: J A 2X3XN set of N Jacobian matrices where the rows are
%           [azimuth;elevation] in that order and the columns take the
%           partial derivative of the row components with respect to
%           [x,y,z] in that order.
%
%The derivatives can be computed in a straightforward manner from
%the basic relation between spherical and Cartesian coordinates, which is
%given in Chapter 14.4.4.1 of [1], among other sources, for systemType=0.
%
%Note that singularities exist at the poles; that is when the elevation is
%+/-(pi/2).
%
%EXAMPLE:
%The results can be verified by comparing the value from numerical
%differentiation to the value returned by this function.
% x=[100;10;-80];
% systemType=0;
% f=@(x)getSpherAngle(x,systemType);
% fDim=2;
% numDiffVal=numDiff(x,f,fDim)
% funcVal=spherAngGradient(x,systemType)
%One will see that within reasonable finite precision bounds, the two
%values are equal.
%
%REFERENCES:
%[1] R. L. Duncombe, "Computational techniques," in Explanatory Supplement
%    to the Astronomical Almanac, 3rd ed., S. E. Urban and P. K.
%    Seidelmann, Eds. Mill Valley, CA: University Science Books, 2013.
%
%February 2017 David F.Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

if(nargin<4||isempty(M))
   M=eye(3,3);
end

if(nargin<3||isempty(lRx))
   lRx=zeros(3,1);
end

if(nargin<2||isempty(systemType))
   systemType=0;
end

N=size(xG,2);

%Transform from global coordinates to local coordinates.
xLocal=M*bsxfun(@minus,xG(1:3,:),lRx(1:3));

JTotal=zeros(2,3,N);
for curPoint=1:N
    x=xLocal(1,curPoint);
    y=xLocal(2,curPoint);
    z=xLocal(3,curPoint);

    r=norm(xLocal(:,curPoint));
    J=zeros(2,3);
    switch(systemType)
        case 0
            %Derivatives with respect to x.
            J(1,1)=-y/(x^2+y^2);
            J(2,1)=-x*z/(r^2*sqrt(x^2+y^2));

            %Derivatives with respect to y.
            J(1,2)=x/(x^2+y^2);
            J(2,2)=-y*z/(r^2*sqrt(x^2+y^2));

            %Derivatives with respect to z.
            J(1,3)=0;
            J(2,3)=sqrt(x^2+y^2)/r^2;
        case 1
            %Derivatives with respect to x.
            J(1,1)=z/(z^2+x^2);
            J(2,1)=-x*y/(r^2*sqrt(z^2+x^2));

            %Derivatives with respect to y.
            J(1,2)=0;
            J(2,2)=sqrt(z^2+x^2)/r^2;

            %Derivatives with respect to z.
            J(1,3)=-x/(z^2+x^2);
            J(2,3)=-z*y/(r^2*sqrt(z^2+x^2));
        case 2
            %Derivatives with respect to x.
            J(1,1)=-y/(x^2+y^2);
            J(2,1)=x*z/(r^2*sqrt(x^2+y^2));

            %Derivatives with respect to y.
            J(1,2)=x/(x^2+y^2);
            J(2,2)=y*z/(r^2*sqrt(x^2+y^2));

            %Derivatives with respect to z.
            J(1,3)=0;
            J(2,3)=-sqrt(x^2+y^2)/r^2;
        case 3
            %Derivatives with respect to x.
            J(1,1)=y/(x^2+y^2);
            J(2,1)=-x*z/(r^2*sqrt(x^2+y^2));

            %Derivatives with respect to y.
            J(1,2)=-x/(x^2+y^2);
            J(2,2)=-y*z/(r^2*sqrt(x^2+y^2));

            %Derivatives with respect to z.
            J(1,3)=0;
            J(2,3)=sqrt(x^2+y^2)/r^2;
        otherwise
            error('Invalid system type specified.')
    end

    %Rotate from local back to global coordinates.
    JTotal(:,:,curPoint)=J*M;
end
J=JTotal;
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.


% This is material illustrating the methods from the book
% Financial Modelling  - Theory, Implementation and Practice with Matlab
% source
% Wiley Finance Series
% ISBN 978-0-470-74489-5
%
% Date: 02.05.2012
%
% Authors:  Joerg Kienitz
%           Daniel Wetterau
%
% Please send comments, suggestions, bugs, code etc. to
% kienitzwetterau_FinModelling@gmx.de
%
% (C) Joerg Kienitz, Daniel Wetterau
%
% Since this piece of code is distributed via the mathworks file-exchange
% it is covered by the BSD license
%
% This code is being provided solely for information and general
% illustrative purposes. The authors will not be responsible for the
% consequences of reliance upon using the code or for numbers produced
% from using the code.

function pathS = MC_M(S0,r,d,T,sigma,muj,sigj,lambda,...
    NTime,NSim,NBatches)
% discretization of Merton model
pathS = zeros(NSim,NTime+1,NBatches);

dT = T/NTime;                        % time step

lnS1 = zeros(NSim,NTime+1);          % used in batch
lnS1(:,1) = log(S0*exp(-d*T));       % set S(0) dividend adjusted

omega = (r-d-0.5 * sigma^2) * dT;    % martingale adjustment

for l = 1:NBatches                   % batch loop
    dW = randn(NSim,NTime);          % Gaussians
    Z = randn(NSim,NTime);           % Gaussians
    for i=2:NTime+1                  % time loop
        % Jumps
        P = poissrnd(lambda*dT,NSim,1);        % Poissonians
        lnY = muj*P + sigj*sqrt(P).* Z(:,i-1); % log jumps

        lnS1(:,i) = lnS1(:,i-1) + omega + sigma* sqrt(dT)*dW(:,i-1)...
            + lnY - dT*lambda*(exp(muj+0.5*sigj^2)-1);
    end
    pathS(:,:,l) = exp(lnS1);
end


%  Multivariate Squarefree factorization that is capable of identifying
%  squarefree factors and multiplicities accurately even if the polynomial
%  is perturbed
%
%   Syntax:  >>[F,res,cond] = SquarefreeFactor(p,tol);
%
%   Input   p -- a multivariate polynomial (as a coeff. matrix) to be factored
%         tol -- (optional) backward error tolerance
%
%  Output   F -- cell of size kx2. For each j = 1, 2, ..., k, F{j,1}, F{j,2}
%                    are a squarefree factor and its multiplicity respectively
%         res -- residual
%        cond -- condition number of the factorization


function TDOAshell

wave = wavread('sample.wav');
wave = wave(:,1);
scale = 0.8/max(wave);
wave = scale*wave;
Trials = 10;
Radius = 50;
N = 8;
Theta = linspace(0,2*pi,N+1);
X = Radius * cos(Theta(1:end-1));
Y = Radius * sin(Theta(1:end-1));
Z = [1:N];
Z = (-1).^Z;
Z = 5*Z+5;
Sen_position = [X.',Y.',Z.'];
Sen_position = [Sen_position];
True_position = zeros(Trials, 3);
Est_position = zeros(Trials,3);

% Generate position of source

for i=1:Trials
    r = rand(1)*50;
    t = rand(1)*2*pi;
    x = r*cos(t);
    y = r*sin(t);
    z = rand(1)*20;
    True_position(i,1) = x;
    True_position(i,2) = y;
    True_position(i,3) = z;
end

% Generate distances

Distances = zeros(Trials,8);
for i=1:Trials
    for j=1:8
        x1 = True_position(i,1);
        y1 = True_position(i,2);
        z1 = True_position(i,3);
        x2 = Sen_position(j,1);
        y2 = Sen_position(j,2);
        z2 = Sen_position(j,3);
        Distances(i,j) = sqrt((x1-x2)^2 + (y1-y2)^2 + (z1-z2)^2);
    end
end

Distances;
TimeDelay = Distances./340.29;
Padding = TimeDelay*44100;

% Generate the signals
for i=1:Trials
   x = True_position(i,1);
   y = True_position(i,2);
   z = True_position(i,3);
   xstr = num2str(round(x));
   ystr = num2str(round(y));
   zstr = num2str(round(z));
   istr = num2str(i);
   name = strcat( 'Trial_', istr, '_', xstr, '_', ystr, '_', zstr, '_mdove.wav');
   mic1 = [zeros(round(Padding(i,1)),1) ; wave];
   mic2 = [zeros(round(Padding(i,2)),1) ; wave];
   mic3 = [zeros(round(Padding(i,3)),1) ; wave];
   mic4 = [zeros(round(Padding(i,4)),1) ; wave];
   mic5 = [zeros(round(Padding(i,5)),1) ; wave];
   mic6 = [zeros(round(Padding(i,6)),1) ; wave];
   mic7 = [zeros(round(Padding(i,7)),1) ; wave];
   mic8 = [zeros(round(Padding(i,8)),1) ; wave];
   l1 = length(mic1);
   l2 = length(mic2);
   l3 = length(mic3);
   l4 = length(mic4);
   l5 = length(mic5);
   l6 = length(mic6);
   l7 = length(mic7);
   l8 = length(mic8);
   lenvec = [l1 l2 l3 l4 l5 l6 l7 l8];
   m = max(lenvec);
   c = [m-l1, m-l2, m-l3, m-l4, m-l5,m-l6, m-l7, m-l8];
   mic1 = [mic1; zeros(c(1),1)];
   mic2 = [mic2; zeros(c(2),1)];
   mic3 = [mic3; zeros(c(3),1)];
   mic4 = [mic4; zeros(c(4),1)];
   mic5 = [mic5; zeros(c(5),1)];
   mic6 = [mic6; zeros(c(6),1)];
   mic7 = [mic7; zeros(c(7),1)];
   mic8 = [mic8; zeros(c(8),1)];

   mic1 = mic1./Distances(i,1);
   mic2 = mic2./Distances(i,2);
   mic3 = mic3./Distances(i,3);
   mic4 = mic4./Distances(i,4);
   mic5 = mic5./Distances(i,5);
   mic6 = mic6./Distances(i,6);
   mic7 = mic7./Distances(i,7);
   mic8 = mic8./Distances(i,8);

multitrack = [mic1, mic2, mic3, mic4, mic5, mic6, mic7, mic8];
%   wavwrite(multitrack, 44100, name);

[x y z] = Locate(Sen_position, multitrack);
Est_position(i,1) = x;
Est_position(i,2) = y;
Est_position(i,3) = z;

end

plot(True_position(:,1),True_position(:,2),'bd',Est_position(:,1),Est_position(:,2),'r+','LineWidth',2);
legend('True Position','Estimated Position');
xlabel('X coordinate of target');
ylabel('Y coordinate of target');
title('TDOA Hyperbolic Localization');
axis([-50 50 -50 50]);

end

function [x y z] = Locate(Sen_position, multitrack)
% sensor index shift of 1 occurrs here

s = size(Sen_position);
len = s(1);
timedelayvec = zeros(len,1);
for i=1:len
   timedelayvec(i) = timedelayfunc(multitrack(:,1),multitrack(:,i));
end

timedelayvec;

Amat = zeros(len,1);
Bmat = zeros(len,1);
Cmat = zeros(len,1);
Dmat = zeros(len,1);
for i=3:len
    x1 = Sen_position(1,1);
    y1 = Sen_position(1,2);
    z1 = Sen_position(1,3);
    x2 = Sen_position(2,1);
    y2 = Sen_position(2,2);
    z2 = Sen_position(2,3);
    xi = Sen_position(i,1);
    yi = Sen_position(i,2);
    zi = Sen_position(i,3);
   Amat(i) = (1/(340.29*timedelayvec(i)))*(-2*x1+2*xi) - (1/(340.29*timedelayvec(2)))*(-2*x1+2*x2);
   Bmat(i) = (1/(340.29*timedelayvec(i)))*(-2*y1+2*yi) - (1/(340.29*timedelayvec(2)))*(-2*y1+2*y2);
   Cmat(i) = (1/(340.29*timedelayvec(i)))*(-2*z1+2*zi) - (1/(340.29*timedelayvec(2)))*(-2*z1+2*z2);
   Sum1 = (x1^2)+(y1^2)+(z1^2)-(xi^2)-(yi^2)-(zi^2);
   Sum2 = (x1^2)+(y1^2)+(z1^2)-(x2^2)-(y2^2)-(z2^2);
   Dmat(i) = 340.29*(timedelayvec(i) - timedelayvec(2)) + (1/(340.29*timedelayvec(i)))*Sum1 - (1/(340.29*timedelayvec(2)))*Sum2;
end

M = zeros(len,3);
D = zeros(len,1);
for i=1:len
    M(i,1) = Amat(i);
    M(i,2) = Bmat(i);
    M(i,3) = Cmat(i);
    D(i) = Dmat(i);
end

M = M(3:len,:);
D = D(3:len);

D = D.*-1;

Minv = pinv(M);
T = Minv*(D);
x = T(1);
y = T(2);
z = T(3);

end

function out = timedelayfunc(x,y)
% suppose sampling rate is 44100
% Let Tx be transit time for x
% Let Ty be transit time for y
% out is Ty - Tx

c = xcorr(x, y);
[C I] = max(c);
out = ((length(c)+1)/2 - I)/44100;

end


%% Schmid Factor Analysis
% This script describes how to analyze Schmid factors.
%
% Let us assume a Nickel crystal

CS = crystalSymmetry('cubic',[3.523,3.523,3.523],'mineral','Nickel')

%%
% Since Nickel is fcc a dominant slip system is given by the slip plane
% normal

n = Miller(1,1,1,CS,'hkl')

%%
% and the slip direction (which needs to be orthogonal)

d = Miller(0,-1,1,CS,'uvw')

%%
% For tension in direction 123
r = normalize(vector3d(1,2,3))

%%
% the Schmid factor for the slip system [0-11](111) is defined by
%
tau = dot(d,r,'noSymmetry') * dot(n,r,'noSymmetry')

%%
% The same computation can be performed by defining the slip system as an
% MTEX variable

sS = slipSystem(d,n)

%%
% and using the command <slipSystem.SchmidFactor.html SchmidFactor>

sS.SchmidFactor(r)

%%
% Ommiting the tension direction r the command
% <slipSystem.SchmidFactor.html SchmidFactor> returns the Schmid factor as
% a <S2FunHarmonic.S2FunHarmonic.html spherical function>

SF = sS.SchmidFactor

% plot the Schmid factor in dependency of the tension direction
plot(SF)

% find the tension directions with the maximum Schmid factor
[SFMax,pos] = max(SF)

% and annotate them
annotate(pos)

%% Stress Tensor
% Instead by the tension direction the stress might be specified by a
% stress tensor

sigma = stressTensor.uniaxial(vector3d.Z)

%%
% Then the Schmid factor for the slip system |sS| and the stress tensor
% |sigma| is computed by

sS.SchmidFactor(sigma)

%% Active Slip System
% In general a crystal contains not only one slip system but at least all
% symmetrically equivalent ones. Those can be computed with

sSAll = sS.symmetrise('antipodal')

%%
% The option |antipodal| indicates that Burgers vectors in oposite
% direction should not be distinguished.
% Now

tau = sSAll.SchmidFactor(r)

%%
% returns a list of Schmid factors and we can find the slip system with the
% largest Schmid factor using

[tauMax,id] = max(abs(tau))

sSAll(id)

%%
% The above computation can be easily extended to a list of tension
% directions

% define a grid of tension directions
r = plotS2Grid('resolution',0.5*degree,'upper');

% compute the Schmid factors for all slip systems and all tension
% directions
tau = sSAll.SchmidFactor(r);

% tau is a matrix with columns representing the Schmid factors for the
% different slip systems. Lets take the maximum rhowise
[tauMax,id] = max(abs(tau),[],2);

% vizualize the maximum Schmid factor
contourf(r,tauMax)
mtexColorbar

%%
% We may also plot the index of the active slip system
pcolor(r,id)

mtexColorMap black2white

%%
% and observe that within the fundamental sectors the active slip system
% remains the same. We can even visualize the the plane normal and the slip
% direction

% if we ommit the option antipodal we can distinguish
% between the oposite burger vectors
sSAll = sS.symmetrise

% take as directions the centers of the fundamental regions
r = symmetrise(CS.fundamentalSector.center,CS);

% compute the Schmid factor
tau = sSAll.SchmidFactor(r);

% here we do not need to take the absolut value since we consider both
% burger vectors +/- b
[~,id] = max(tau,[],2);

% plot active slip plane in red
hold on
quiver(r,sSAll(id).n,'LineWidth',2,'Color','r');

% plot active slip direction in green
hold on
quiver(r,sSAll(id).b.normalize,'LineWidth',2,'Color','g');
hold off

%%
% If we perform this computation in terms of spherical functions we obtain

% ommiting |r| gives us a list of 12 spherical functions
tau = sSAll.SchmidFactor

% now we take the max of the absolute value over all these functions
contourf(max(abs(tau),[],1),'upper')
mtexColorbar

%% The Schmid factor for EBSD data
% So far we have always assumed that the stress tensor is already given
% relatively to the crystal coordinate system. Next, we want to examine the
% case where the stress is given in specimen coordinates and we know the
% orientation of the crystal. Lets import some EBSD data and computet the
% grains

mtexdata csl

% take some subset
ebsd = ebsd(ebsd.inpolygon([0,0,200,50]))

grains = calcGrains(ebsd);
grains = smooth(grains,5);

plot(ebsd,ebsd.orientations,'micronbar','off')
hold on
plot(grains.boundary,'linewidth',2)
hold off

%%
% We want to consider the following slip systems

sS = slipSystem.fcc(ebsd.CS)
sS = sS.symmetrise;

%%
% Since, those slip systems are in crystal coordinates but the stress
% tensor is in specimen coordinates we either have to rotate the slip
% systems into specimen coordinates or the stress tensor into crystal
% coordinates. In the following sections we will demonstrate both ways.
% Lets start with the first one

% rotate slip systems into specimen coordinates
sSLocal = grains.meanOrientation * sS

%%
% These slip systems are now arranged in matrix form
% where the rows corrspond to the crystal reference frames of the different
% grains and the rows are the symmetrically equivalent slip systems.
% Computing the Schmid faktor we end up with a matrix of the same size

% compute Schmid factor
sigma = stressTensor.uniaxial(vector3d.X)
SF = sSLocal.SchmidFactor(sigma);

% take the maxium allong the rows
[SFMax,active] = max(SF,[],2);

% plot the maximum Schmid factor
plot(grains,SFMax,'micronbar','off','linewidth',2)
mtexColorbar location southoutside

%%
% Next we want to visualize the active slip systems.

% take the active slip system and rotate it in specimen coordinates
sSactive = grains.meanOrientation .* sS(active);

hold on
% visualize the trace of the slip plane
quiver(grains,sSactive.trace,'color','b')

% and the slip direction
quiver(grains,sSactive.b,'color','r')
hold off

%%
% We observe that the Burgers vector is in most case aligned with the
% trace. In those cases where trace and Burgers vector are not aligned the
% slip plane is not perpendicular to the surface and the Burgers vector
% sticks out of the surface.

%%
% Next we want to demonstrate the alternative route

% rotate the stress tensor into crystal coordinates
sigmaLocal = inv(grains.meanOrientation) * sigma

%%
% This becomes a list of stress tensors with respect to crystal coordinates
% - one for each grain. Now we have both the slip systems as well as the
% stress tensor in crystal coordiantes and can compute the Schmid factor

% the resulting matrix is the same as above
SF = sS.SchmidFactor(sigmaLocal);

% and hence we may proceed analogously
% take the maxium allong the rows
[SFMax,active] = max(SF,[],2);

% plot the maximum Schmid factor
plot(grains,SFMax)
mtexColorbar

% take the active slip system and rotate it in specimen coordinates
sSactive = grains.meanOrientation .* sS(active);

hold on
% visualize the trace of the slip plane
quiver(grains,sSactive.trace,'color','b')

% and the slip direction
quiver(grains,sSactive.b,'color','r')

hold off

%% Strain based analysis on the same data set

eps = strainTensor(diag([1,0,-1]))

epsCrystal = inv(grains.meanOrientation) * eps

[M, b, W] = calcTaylor(epsCrystal, sS);

plot(grains,M,'micronbar','off')
mtexColorbar southoutside

%%

[ bMax , bMaxId ] = max( b , [ ] , 2 ) ;
sSGrains = grains.meanOrientation .* sS(bMaxId) ;
hold on
quiver ( grains , sSGrains.b)
quiver ( grains , sSGrains.trace)
hold off


function model = LogisticRegressionTrain(dataPos, dataNeg, opt, model)

featPos         = dataPos.feat;
featNeg         = dataNeg.feat;
numPos          = size(featPos, 2);
numNeg          = size(featNeg, 2);
featDim         = size(featPos, 1);
num             = numPos + numNeg;

feat            = [featPos, featNeg];
data.feat       = feat;

feat            = [feat; ones(1, num)];     % add bias term

label           = zeros(1, num);
label(1:numPos) = 1;

if nargin <= 3
    model.w     = randn(featDim + 1, 1) / (featDim + 1);
    maxIter         = 1000;
else
    maxIter = 20;
end

lambda          = 1e-2;
iter            = 0;
lr              = 1 / num;
alpha           = 0.99; % Parameter for momentum
deltaW          = 0;
while (iter < maxIter)
    iter        = iter + 1;

    loss        = label - LogisticRegressionTest(data, model);
    deltaW       = lr * (feat * loss' - lambda * model.w) + alpha * deltaW;
%     deltaW       = lr * (feat * loss' - lambda * model.w);
    model.w     = model.w + deltaW;
%     disp(norm(loss));
end

end


function value = he_triple_product_integral ( i, j, k )

%*****************************************************************************80
%
%% HE_TRIPLE_PRODUCT_INTEGRAL: integral of He(i,x)*He(j,x)*He(k,x)*e^(-x^2/2).
%
%  Discussion:
%
%    VALUE = integral ( -oo < x < +oo ) He(i,x)*He(j,x)*He(k,x) exp(-x^2/2) dx
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 March 2012
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Dongbin Xiu,
%    Numerical Methods for Stochastic Computations: A Spectral Method Approach,
%    Princeton, 2010,
%    ISBN13: 978-0-691-14212-8,
%    LC: QA274.23.X58.
%
%  Parameters:
%
%    Input, integer I, J, K, the polynomial indices.
%
%    Output, real VALUE, the value of the integral.
%
  s = floor ( ( i + j + k ) / 2 );

  if ( s < i || s < j || s < k )
    value = 0.0;
  elseif ( mod ( i + j + k, 2 ) ~= 0 )
    value = 0.0;
  else
    value = r8_factorial ( i ) / r8_factorial ( s - i ) ...
          * r8_factorial ( j ) / r8_factorial ( s - j ) ...
          * r8_factorial ( k ) / r8_factorial ( s - k );
  end

  return
end


function ival = r8mat_is_adjacency ( m, n, a )

%*****************************************************************************80
%
%% R8MAT_IS_ADJACENCY checks whether A is an adjacency matrix.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    01 November 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the row and column dimensions of
%    the matrix.  M and N must be positive.
%
%    Input, real A(M,N), the matrix.
%
%    Output, integer IVAL:
%    -1, the matrix is not an adjacency matrix.
%    1, the matrix is an adjacency matrix.
%
  tol = 0.00001;

  if ( m ~= n )
    ival = -1;
    return
  end

  error_frobenius = r8mat_is_symmetric ( m, n, a );

  if ( tol < error_frobenius )
    ival = -1;
    return
  end

  jval = r8mat_is_zero_one ( m, n, a );

  if ( jval ~= 1 )
    ival = -1;
    return
  end

  return
end


function [handle]  = ml_plot_rvm_boundary( data, labels, model, varargin)
% ML_PLOT_RVM_BOUNDARY plots the training data
%   and decision boundary, given a model produced by LIBSVM
%   input ----------------------------------------------------------------
%
%       o data      : (1 x 1), number of data points to generate.
%
%       o labels    : (1 x 1), dimension of the data. [2 or 3]
%
%       o model     : (1 x 1), number of classes.
%
%       o options   : struct
%
%       o varargin  : string, if 'draw' draw contours otherwise, don't
%
%%  Plot function
handle = figure('Color', [1 1 1]);
labels(find(labels==-1)) = 0;

% Parse model params
weights = model.weights;
kernel_ = model.kernel_;
width   = model.width;
bias    = model.bias;
RVs     = model.RVs;
acc     = model.predict_accuracy;
N_RVs   = model.N_RVs;

% Make classification predictions over a grid of values
xplot = linspace(min(data(:,1)), max(data(:,1)), 100)';
yplot = linspace(min(data(:,2)), max(data(:,2)), 100)';
[grid1, grid2] = meshgrid(xplot, yplot);
Xgrid = [grid1(:),grid2(:)];

% Evaluate RVM
PHI		= SB1_KernelFunction(Xgrid,RVs,kernel_,width);
y_grid  = PHI*weights + bias;

% apply sigmoid for probabilities (option)
p_grid	= 1./(1+exp(-y_grid));

% Plot the RVM Contours
colormap hot
if (size(varargin, 2) == 1) && strcmp(varargin{1}, 'draw')
    contourf(grid1,grid2, reshape(p_grid,size(grid1)), 50, 'LineStyle', 'none');
    legend_names = {'Decision values (p(x))', 'Class 1','Class 0', 'p=0.5', 'p=0.75', 'p=0.25'};
    colorbar
elseif (size(varargin, 2) == 1) && strcmp(varargin{1}, 'surf')
    surf(grid1,grid2, reshape(p_grid,size(grid1))); shading interp;
    legend_names = {'Decision Values f(x)','f(x)=0', 'f(x)= +1','f(x)=-1','Class 1','Class -1'};
    colorbar
else
    legend_names = {'Class 1','Class 0', 'p=0.5', 'p=0.75', 'p=0.25'};
end
hold on;

% Plot the training data on top of the boundary
pos = find(labels == 1);
neg = find(labels == 0);
plot(data(pos,1), data(pos,2), 'ko', 'MarkerFaceColor', 'r'); hold on;
plot(data(neg,1), data(neg,2), 'ko', 'MarkerFaceColor', 'g'); hold on;

% Show decision boundaries p=0.5 (y=0) and illustrate p=0.75(y=1) and p=0.25(y=-1)
contour(grid1,grid2,reshape(y_grid,size(grid1)),[0.5 0.5],'-', 'LineWidth', 2,  'Color', 'k');
contour(grid1,grid2,reshape(y_grid,size(grid1)),[0.75 0.75],'-', 'LineWidth',0.5, 'Color', 'r');
contour(grid1,grid2,reshape(y_grid,size(grid1)),[0.25 0.25],'-', 'LineWidth',0.5, 'Color', 'g');

% Show relevance vectors
scatter(RVs(:,1),RVs(:,2),70,'o','MarkerEdgeColor', [1 1 1], 'LineWidth', 2);
legend(legend_names,'Location','NorthWest')
hold off
title(sprintf('RVM \\sigma = %g, RV = %d, Acc = %g', width, N_RVs, acc), 'Interpreter','tex','FontSize', 20, 'FontWeight', 'Normal');

axis tight
grid on
box on

end


% File: logsumexp.m
%
% Copyright (C) Daphne Koller, Stanford Univerity, 2012

function out = logsumexp(A)

% LOGSUMEXP
% Computes log( sum( exp( ) ) ) of each row in A in a way that avoids underflow.
% If A is an N x M matrix, then out is a N x 1 vector.

pi_max = max(A, [], 2);
out = pi_max + log(sum(exp(bsxfun(@minus, A, pi_max)), 2));


% ir_denoise_admm1_test
% illustrate using "ADMM" for image denoising (aka Split Bregman algorithm)

if ~isvar('yi'), printm 'generate noisy image'
%	xt = single(imread('cameraman.tif')');
%	sig = 6; clim = [0 250];
	xt = ellipse_im(2^7);
	sig = 2^-1; clim = [0 9];

	snr = @(x) -20*log(norm(x(:)-xt(:)) / norm(xt));

	rng(7)
	yi = xt + sig * randn(size(xt));
	im plc 2 2
	im(1, xt, clim, 'True')
	im(2, yi, clim, 'Noisy')
	xlabelf('SNR = %4.1f dB', snr(yi))
end

if ~isvar('xs'), printm 'run admm'
	[xs, snrs] = ir_denoise_admm1(yi, 'beta', 2^-1, ...
		'stop_diff_tol', 1e-4, 'chat', 0, ...
		'isave', 'all', ...
		'userfun', @(x, iter) snr(x), ...
		'niter', 2^5, 'shrink', [], 'rho', 1);
	xh = xs(:,:,end);
end

if 1 % figures
%	im plc 1 3
%	im(1, xt, clim)
%	im(2, yi, clim)
	im(3, xh, clim, 'Denoised')
	xlabelf('SNR = %4.1f dB', snr(xh))

	im subplot 4
	iters = 0:numel(snrs)-1;
	if im
		plot(iters, snrs, '-o')
		axis([0 20 20 55])
		xlabel 'ADMM iteration'
		ylabel 'SNR (dB)'
		ytick([25 53])
	end
%	ir_savefig cw ir_denoise_admm1_test
end

if 0 % movie of iterates
	tmp = xs(:,:,[1:20 end]);
	niter = size(tmp,3);
	bar = size(tmp,2) / niter;
	for ii=1:niter
                tmp(1:3, floor([1:bar]+(ii-1)*bar), ii) = 8;
        end
	clf, im(tmp)
%	movie2(tmp, 'clim', clim, 'fps', 10)
end


% Plot the per-pixel KL divergence when one 2D distribution is used to
% approximate another.

% Zoya Bylinskii, April 2016
% linked to: "What do different evaluation metrics tell us about saliency models?"

% Note: if comparing multiple saliency maps, compute the resMap for each of
% the saliency maps using this function, but then normalize them jointly
% before plotting (to make range of values comparable across plots).

function [resMap,figtitle] = visualize_KL(salMap, fixMap, toplot)
% salMap is the saliency model prediction (distribution)
% fixMap is the ground truth fixation map (distribution)
% if only plotting one map, set toplot=1; but if comparing multiple maps,
% see note above

if nargin < 3
    toplot = 1;
end

figtitle = 'KL divergence';

% create the red color map, brighter red corresponds to higher KL
% divergence values
G = linspace(0,1,20)';
fpmap = horzcat(G,zeros(size(G)),zeros(size(G)));

% format, resize, and normalize maps
map1 = im2double(fixMap);
map2 = im2double(imresize(salMap, size(fixMap)));
map1 = map1/sum(map1(:));
map2 = map2/sum(map2(:));

% compute per-pixel KL divergence
resMap = map1 .* log(eps + map1./(map2+eps)); % map 1 is the target distribution, map 2 the prediction

% plot the visualization
if toplot
    figure;
    resMap_norm = resMap/max(resMap(:));
    imshow(resMap_norm);
    colormap(fpmap); colorbar;
    title(figtitle,'fontsize',14);
end


function vectarrow(p0,p1)
%Arrowline 3-D vector plot.
%   vectarrow(p0,p1) plots a line vector with arrow pointing from point p0
%   to point p1. The function can plot both 2D and 3D vector with arrow
%   depending on the dimension of the input
%
%   Example:
%       3D vector
%       p0 = [1 2 3];   % Coordinate of the first point p0
%       p1 = [4 5 6];   % Coordinate of the second point p1
%       vectarrow(p0,p1)
%
%       2D vector
%       p0 = [1 2];     % Coordinate of the first point p0
%       p1 = [4 5];     % Coordinate of the second point p1
%       vectarrow(p0,p1)
%
%   See also Vectline

%   Rentian Xiong 4-18-05
%   $Revision: 1.0

  if max(size(p0))==3
      if max(size(p1))==3
          x0 = p0(1);
          y0 = p0(2);
          z0 = p0(3);
          x1 = p1(1);
          y1 = p1(2);
          z1 = p1(3);
          plot3([x0;x1],[y0;y1],[z0;z1]);   % Draw a line between p0 and p1

          p = p1-p0;
          alpha = 0.1;  % Size of arrow head relative to the length of the vector
          beta = 0.1;  % Width of the base of the arrow head relative to the length

          hu = [x1-alpha*(p(1)+beta*(p(2)+eps)); x1; x1-alpha*(p(1)-beta*(p(2)+eps))];
          hv = [y1-alpha*(p(2)-beta*(p(1)+eps)); y1; y1-alpha*(p(2)+beta*(p(1)+eps))];
          hw = [z1-alpha*p(3);z1;z1-alpha*p(3)];

          hold on
          plot3(hu(:),hv(:),hw(:))  % Plot arrow head
          grid on
          xlabel('x')
          ylabel('y')
          zlabel('z')
          hold off
      else
          error('p0 and p1 must have the same dimension')
      end
  elseif max(size(p0))==2
      if max(size(p1))==2
          x0 = p0(1);
          y0 = p0(2);
          x1 = p1(1);
          y1 = p1(2);
          plot([x0;x1],[y0;y1]);   % Draw a line between p0 and p1

          p = p1-p0;
          alpha = 0.1;  % Size of arrow head relative to the length of the vector
          beta = 0.1;  % Width of the base of the arrow head relative to the length

          hu = [x1-alpha*(p(1)+beta*(p(2)+eps)); x1; x1-alpha*(p(1)-beta*(p(2)+eps))];
          hv = [y1-alpha*(p(2)-beta*(p(1)+eps)); y1; y1-alpha*(p(2)+beta*(p(1)+eps))];

          hold on
          plot(hu(:),hv(:))  % Plot arrow head
          grid on
          xlabel('x')
          ylabel('y')
          hold off
      else
          error('p0 and p1 must have the same dimension')
      end
  else
      error('this function only accepts 2D or 3D vector')
  end


% SIGNAL SYNTHESIS
%
% Estimates the time-domain signal from a given time-frequency distribution.
%
%
% The signal synthesis routine is limited to the following
% time-frequency distributions:
%
%    (i)   Short-Time Fourier Transform (STFT)
%    (ii)  Spectrogram
%    (iii) Wigner-Ville Distribution
%
% PARAMETERS:
%
%   TIME-FREQUENCY MATRIX
%
%	Input matrix containing the time-frequency distribution.
%
%   SIGNAL
%
%       Output synthesised (complex) signal from given time-frequency distribution.
%
%   WINDOW LENGTH
%
%      Length of the smoothing window used in the given distribution (or in the case of
%      of the WVD the lag window length).
%
%   ANALYSIS TYPE
%
%      Specifies which type of signal synthesis will be applied to the given TFD
%      matrix. The following analysis types are valid:
%
%      (i) STFT:
%
%         (a) Inverse Discrete Fourier Transform method.
%         (b) Overlap-Add method.
%         (c) Modified Short-Time Fourier Transform method.
%
%      (ii) Spectrogram:
%
%         Modified Spectrogram method
%
%      (iii) Wigner Ville Distribution:
%
%         Wigner Ville Distribution method. The original signal can be
%         specified to correct the phase of the synthesised signal.
%
%
%
%  See Also:  wvd, spec


function [U,S,V] = pca(A,k,its,l)
%PCA  Low-rank approximation in SVD form.
%
%
%   [U,S,V] = PCA(A)  constructs a nearly optimal rank-6 approximation
%             USV' to A, using 2 full iterations of a block Lanczos method
%             of block size 6+2=8, started with an n x 8 random matrix,
%             when A is m x n; the ref. below explains "nearly optimal."
%             The smallest dimension of A must be >= 6 when A is
%             the only input to PCA.
%
%   [U,S,V] = PCA(A,k)  constructs a nearly optimal rank-k approximation
%             USV' to A, using 2 full iterations of a block Lanczos method
%             of block size k+2, started with an n x (k+2) random matrix,
%             when A is m x n; the ref. below explains "nearly optimal."
%             k must be a positive integer <= the smallest dimension of A.
%
%   [U,S,V] = PCA(A,k,its)  constructs a nearly optimal rank-k approx. USV'
%             to A, using its full iterations of a block Lanczos method
%             of block size k+2, started with an n x (k+2) random matrix,
%             when A is m x n; the ref. below explains "nearly optimal."
%             k must be a positive integer <= the smallest dimension of A,
%             and its must be a nonnegative integer.
%
%   [U,S,V] = PCA(A,k,its,l)  constructs a nearly optimal rank-k approx.
%             USV' to A, using its full iterates of a block Lanczos method
%             of block size l, started with an n x l random matrix,
%             when A is m x n; the ref. below explains "nearly optimal."
%             k must be a positive integer <= the smallest dimension of A,
%             its must be a nonnegative integer,
%             and l must be a positive integer >= k.
%
%
%   The low-rank approximation USV' is in the form of an SVD in the sense
%   that the columns of U are orthonormal, as are the columns of V,
%   the entries of S are all nonnegative, and the only nonzero entries
%   of S appear in non-increasing order on its diagonal.
%   U is m x k, V is n x k, and S is k x k, when A is m x n.
%
%   Increasing its or l improves the accuracy of the approximation USV'
%   to A; the ref. below describes how the accuracy depends on its and l.
%
%
%   Note: PCA invokes RAND. To obtain repeatable results,
%         invoke RAND('seed',j) with a fixed integer j before invoking PCA.
%
%   Note: PCA currently requires the user to center and normalize the rows
%         or columns of the input matrix A before invoking PCA (if such
%         is desired).
%
%   Note: The user may ascertain the accuracy of the approximation USV'
%         to A by invoking DIFFSNORM(A,U,S,V).
%
%
%   inputs (the first is required):
%   A -- matrix being approximated
%   k -- rank of the approximation being constructed;
%        k must be a positive integer <= the smallest dimension of A,
%        and defaults to 6
%   its -- number of full iterations of a block Lanczos method to conduct;
%          its must be a nonnegative integer, and defaults to 2
%   l -- block size of the block Lanczos iterations;
%        l must be a positive integer >= k, and defaults to k+2
%
%   outputs (all three are required):
%   U -- m x k matrix in the rank-k approximation USV' to A,
%        where A is m x n; the columns of U are orthonormal
%   S -- k x k matrix in the rank-k approximation USV' to A,
%        where A is m x n; the entries of S are all nonnegative,
%        and its only nonzero entries appear in nonincreasing order
%        on the diagonal
%   V -- n x k matrix in the rank-k approximation USV' to A,
%        where A is m x n; the columns of V are orthonormal
%
%
%   Example:
%     A = rand(1000,2)*rand(2,1000);
%     A = A/normest(A);
%     [U,S,V] = pca(A,2,0);
%     diffsnorm(A,U,S,V)
%
%     This code snippet produces a rank-2 approximation USV' to A such that
%     the columns of U are orthonormal, as are the columns of V, and
%     the entries of S are all nonnegative and are zero off the diagonal.
%     diffsnorm(A,U,S,V) outputs an estimate of the spectral norm
%     of A-USV', which should be close to the machine precision.
%
%
%   Reference:
%   Nathan Halko, Per-Gunnar Martinsson, and Joel Tropp,
%   Finding structure with randomness: Stochastic algorithms
%   for constructing approximate matrix decompositions,
%   arXiv:0909.4061 [math.NA; math.PR], 2009
%   (available at http://arxiv.org).
%
%
%   See also PCACOV, PRINCOMP, SVDS.
%

%   Copyright 2009 Mark Tygert.

%
% Check the number of inputs.
%
if(nargin < 1)
  error('MATLAB:pca:TooFewIn',...
        'There must be at least 1 input.')
end

if(nargin > 4)
  error('MATLAB:pca:TooManyIn',...
        'There must be at most 4 inputs.')
end

%
% Check the number of outputs.
%
if(nargout ~= 3)
  error('MATLAB:pca:WrongNumOut',...
        'There must be exactly 3 outputs.')
end

%
% Set the inputs k, its, and l to default values, if necessary.
%
if(nargin == 1)
  k = 6;
  its = 2;
  l = k+2;
end

if(nargin == 2)
  its = 2;
  l = k+2;
end

if(nargin == 3)
  l = k+2;
end

%
% Check the first input argument.
%
if(~isfloat(A))
  error('MATLAB:pca:In1NotFloat',...
        'Input 1 must be a floating-point matrix.')
end

if(isempty(A))
  error('MATLAB:pca:In1Empty',...
        'Input 1 must not be empty.')
end

%
% Retrieve the dimensions of A.
%
[m n] = size(A);

%
% Check the remaining input arguments.
%
if(size(k,1) ~= 1 || size(k,2) ~= 1)
  error('MATLAB:pca:In2Not1x1',...
        'Input 2 must be a scalar.')
end

if(size(its,1) ~= 1 || size(its,2) ~= 1)
  error('MATLAB:pca:In3Not1x1',...
        'Input 3 must be a scalar.')
end

if(size(l,1) ~= 1 || size(l,2) ~= 1)
  error('MATLAB:pca:In4Not1x1',...
        'Input 4 must be a scalar.')
end

if(k <= 0)
  error('MATLAB:pca:In2NonPos',...
        'Input 2 must be > 0.')
end

if((k > m) || (k > n))
  error('MATLAB:pca:In2TooBig',...
        'Input 2 must be <= the smallest dimension of Input 1.')
end

if(its < 0)
  error('MATLAB:pca:In3Neg',...
        'Input 3 must be >= 0.')
end

if(l < k)
  error('MATLAB:pca:In4ltIn2',...
        'Input 4 must be >= Input 2.')
end

%
% SVD A directly if (its+1)*l >= m/1.25 or (its+1)*l >= n/1.25.
%
if(((its+1)*l >= m/1.25) || ((its+1)*l >= n/1.25))

  if(~issparse(A))
    [U,S,V] = svd(A,'econ');
  end

  if(issparse(A))
    [U,S,V] = svd(full(A),'econ');
  end
%
% Retain only the leftmost k columns of U, the leftmost k columns of V,
% and the uppermost leftmost k x k block of S.
%
  U = U(:,1:k);
  V = V(:,1:k);
  S = S(1:k,1:k);

  return

end

if(m >= n)

%
% Apply A to a random matrix, obtaining H.
%

  if(isreal(A))
    H = A*(2*rand(n,l)-ones(n,l));
  end

  if(~isreal(A))
    H = A*( (2*rand(n,l)-ones(n,l)) + i*(2*rand(n,l)-ones(n,l)) );
  end

%
% Initialize F to its final size and fill its leftmost block with H.
%
  F = zeros(m,(its+1)*l);
  F(1:m, 1:l) = H;

%
% Apply A*A' to H a total of its times,
% augmenting F with the new H each time.
%
  for it = 1:its
    H = (H'*A)';
    H = A*H;
    F(1:m, (1+it*l):((it+1)*l)) = H;
  end

  clear H;

%
% Form a matrix Q whose columns constitute an orthonormal basis
% for the columns of F.
%
  [Q,R,E] = qr(F,0);

  clear F R E;

%
% SVD Q'*A to obtain approximations to the singular values
% and right singular vectors of A; adjust the left singular vectors
% of Q'*A to approximate the left singular vectors of A.
%
  [U2,S,V] = svd(Q'*A,'econ');
  U = Q*U2;

  clear Q U2;

%
% Retain only the leftmost k columns of U, the leftmost k columns of V,
% and the uppermost leftmost k x k block of S.
%
  U = U(:,1:k);
  V = V(:,1:k);
  S = S(1:k,1:k);

end

if(m < n)

%
% Apply A' to a random matrix, obtaining H.
%

  if(isreal(A))
    H = ((2*rand(l,m)-ones(l,m))*A)';
  end

  if(~isreal(A))
    H = (( (2*rand(l,m)-ones(l,m)) + i*(2*rand(l,m)-ones(l,m)) )*A)';
  end

%
% Initialize F to its final size and fill its leftmost block with H.
%
  F = zeros(n,(its+1)*l);
  F(1:n, 1:l) = H;

%
% Apply A'*A to H a total of its times,
% augmenting F with the new H each time.
%
  for it = 1:its
    H = A*H;
    H = (H'*A)';
    F(1:n, (1+it*l):((it+1)*l)) = H;
  end

  clear H;

%
% Form a matrix Q whose columns constitute an orthonormal basis
% for the columns of F.
%
  [Q,R,E] = qr(F,0);

  clear F R E;

%
% SVD A*Q to obtain approximations to the singular values
% and left singular vectors of A; adjust the right singular vectors
% of A*Q to approximate the right singular vectors of A.
%
  [U,S,V2] = svd(A*Q,'econ');
  V = Q*V2;

  clear Q V2;

%
% Retain only the leftmost k columns of U, the leftmost k columns of V,
% and the uppermost leftmost k x k block of S.
%
  U = U(:,1:k);
  V = V(:,1:k);
  S = S(1:k,1:k);

end


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  In this script, we perform phase transition analysis
%  of Orthogonal matching pursuit.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
close all;
clear all;
clc;
rng('default');
% Create the directory for storing results
[status_code,message,message_id] = mkdir('bin');
target_file_path = 'bin/mmv_phase_transition_snr_30db_s_8.mat';
N = 256;
S = 8;
pta = spx.pursuit.PhaseTransitionAnalysis(N);
pta.SNR = 30;
% pta.NumTrials = 100;
dict_model = @(M, N) spx.dict.simple.gaussian_dict(M, N);
data_model = @(N, K) spx.data.synthetic.SparseSignalGenerator(N, K, S).gaussian;
recovery_solver = @(Phi, K, y) spx.pursuit.joint.CoSaMP(Phi, K).solve(y).Z;
pta.run(dict_model, data_model, recovery_solver);
pta.save_results(target_file_path);


function [xf, S, cnt] = LMFsolveOLD(varargin)
% Solve a Set of Overdetermined Nonlinear Equations in Least-Squares Sense.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% A solution is obtained by a Fletcher version of the Levenberg-Maquardt
% algoritm for minimization of a sum of squares of equation residuals.
%
% [Xf, Ssq, CNT] = LMFsolveOLD(FUN,Xo,Options)
% FUN     is a function handle or a function M-file name that evaluates
%         m-vector of equation residuals,
% Xo      is n-vector of initial guesses of solution,
% Options is an optional set of Name/Value pairs of control parameters
%         of the algorithm. It may be also preset by calling:
%         Options = LMFsolveOLD('default'), or by a set of Name/Value pairs:
%         Options = LMFsolveOLD('Name',Value, ... ), or updating the Options
%                   set by calling
%         Options = LMFsolveOLD(Options,'Name',Value, ...).
%
%    Name   Values {default}         Description
% 'Display'     integer     Display iteration information
%                            {0}  no display
%                             k   display initial and every k-th iteration;
% 'Jacobian'    handle      Jacobian matrix function handle; {@finjac}
% 'FunTol'      {1e-7}      norm(FUN(x),1) stopping tolerance;
% 'XTol'        {1e-7}      norm(x-xold,1) stopping tolerance;
% 'MaxIter'     {100}       Maximum number of iterations;
% 'ScaleD'                  Scale control:
%               value        D = eye(m)*value;
%               vector       D = diag(vector);
%                {[]}        D(k,k) = JJ(k,k) for JJ(k,k)>0, or
%                                   = 1 otherwise,
%                                     where JJ = J.'*J
% Not defined fields of the Options structure are filled by default values.
%
% Output Arguments:
% Xf        final solution approximation
% Ssq       sum of squares of residuals
% Cnt       >0          count of iterations
%           -MaxIter,   did not converge in MaxIter iterations

% Example:
% The general Rosenbrock's function has the form
%    f(x) = 100(x(1)-x(2)^2)^2 + (1-x(1))^2
% Optimum solution gives f(x)=0 for x(1)=x(2)=1. Function f(x) can be
% expressed in the form
%    f(x) = f1(x)^2 =f2(x)^2,
% where f1(x) = 10(x(1)-x(2)^2) and f2(x) = 1-x(1).
% Values of the functions f1(x) and f2(x) can be used as residuals.
% LMFsolveOLD finds the solution of this problem in 5 iterations. The more
% complicated problem sounds:
% Find the least squares solution of the Rosenbrock valey inside a circle
% of the unit diameter centered at the origin. It is necessary to build
% third function, which is zero inside the circle and increasing outside it.
% This property has, say, the next function:
%    f3(x) = sqrt(x(1)^2 + x(2)^2) - r, where r is a radius of the circle.
% Its implementation using anonymous functions has the form
%    R  = @(x) sqrt(x'*x)-.5;    %   A distance from the radius r=0.5
%    ros= @(x) [10*(x(2)-x(1)^2); 1-x(1); (R(x)>0)*R(x)*1000];
%    [x,ssq,cnt]=LMFsolveOLD(ros,[-1.2,1],'Display',1,'MaxIter',50)
% Solution: x = [0.4556; 0.2059],  |x| = 0.5000
% sum of squares: ssq = 0.2966,
% number of iterations: cnt = 18.
%
% Note:
% Users with older MATLAB versions, which have no anonymous functions
% implemented, have to call LMFsolveOLD with named function for residuals.
% For above example it is
%
%   [x,ssq,cnt]=LMFsolveOLD('rosen',[-1.2,1]);
%
% where the function rosen.m is of the form
%
%   function r = rosen(x)
%%  Rosenbrock valey with a constraint
%   R = sqrt(x(1)^2+x(2)^2)-.5;
%%  Residuals:
%   r = [ 10*(x(2)-x(1)^2)  %   first part
%         1-x(1)            %   second part
%         (R>0)*R*1000.     %   penalty
%       ];

% Reference:
% Fletcher, R., (1971): A Modified Marquardt Subroutine for Nonlinear Least
% Squares. Rpt. AERE-R 6799, Harwell

% M. Balda,
% Institute of Thermomechanics,
% Academy of Sciences of The Czech Republic,
% balda AT cdm DOT cas DOT cz
% 2007-07-02
% 2007-10-08    formal changes, improved description
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%   OPTIONS
    %%%%%%%
%               Default Options
if nargin==1 && strcmpi('default',varargin(1))
   xf.Display  = 0;         %   no print of iterations
   xf.Jacobian = @finjac;   %   finite difference Jacobian approximation
   xf.MaxIter  = 100;       %   maximum number of iterations allowed
   xf.ScaleD   = [];        %   automatic scaling by D = diag(diag(J'*J))
   xf.FunTol   = 1e-7;      %   tolerace for final function value
   xf.XTol     = 1e-4;      %   tolerance on difference of x-solutions
   return

%               Updating Options
elseif isstruct(varargin{1}) % Options=LMFsolveOLD(Options,'Name','Value',...)
    if ~isfield(varargin{1},'Jacobian')
        error('Options Structure not Correct for LMFsolveOLD.')
    end
    xf=varargin{1};          %   Options
    for i=2:2:nargin-1
        name=varargin{i};     %   option to be updated
        if ~ischar(name)
            error('Parameter Names Must be Strings.')
        end
        name=lower(name(isletter(name)));
        value=varargin{i+1};  %   value of the option
        if strncmp(name,'d',1), xf.Display  = value;
        elseif strncmp(name,'f',1), xf.FunTol   = value(1);
        elseif strncmp(name,'x',1), xf.XTol     = value(1);
        elseif strncmp(name,'j',1), xf.Jacobian = value;
        elseif strncmp(name,'m',1), xf.MaxIter  = value(1);
        elseif strncmp(name,'s',1), xf.ScaleD   = value;
        else   disp(['Unknown Parameter Name --> ' name])
        end
    end
    return

%               Pairs of Options
elseif ischar(varargin{1})  % check for Options=LMFsolveOLD('Name',Value,...)
   Pnames=char('display','funtol','xtol','jacobian','maxiter','scaled');
   if strncmpi(varargin{1},Pnames,length(varargin{1}))
      xf=LMFsolveOLD('default');  % get default values
      xf=LMFsolveOLD(xf,varargin{:});
      return
   end
end

%   LMFSOLVEOLD(FUN,Xo,Options)
    %%%%%%%%%%%%%%%%%%%%%%%%%%%

FUN=varargin{1};            %   function handle
if ~(isvarname(FUN) || isa(FUN,'function_handle'))
   error('FUN Must be a Function Handle or M-file Name.')
end

xc=varargin{2};             %   Xo

if nargin>2                 %   OPTIONS
    if isstruct(varargin{3})
        options=varargin{3};
    else
        if ~exist('options','var')
            options = LMFsolveOLD('default');
        end
        for i=3:2:size(varargin,2)-1
            options=LMFsolveOLD(options, varargin{i},varargin{i+1});
        end
    end
else
    if ~exist('options','var')
        options = LMFsolveOLD('default');
    end
end

x=xc(:);
lx=length(x);

r=feval(FUN,x);             % Residuals at starting point
%~~~~~~~~~~~~~~
S=r'*r;
epsx=options.XTol(:);
epsf=options.FunTol(:);
if length(epsx)<lx, epsx=epsx*ones(lx,1); end
J=options.Jacobian(FUN,r,x,epsx);
%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A=J.'*J;                    % System matrix
v=J.'*r;

D = options.ScaleD;
if isempty(D)
    D=diag(diag(A));        % automatic scaling
    for i=1:lx
        if D(i,i)==0, D(i,i)=1; end
    end
else
    if numel(D)>1
        D=diag(sqrt(abs(D(1:lx)))); % vector of individual scaling
    else
        D=sqrt(abs(D))*eye(lx);     % scalar of unique scaling
    end
end

Rlo=0.25; Rhi=0.75;
l=1;      lc=.75;     is=0;
cnt=0;
ipr=options.Display;
printit(-1);                %   Table header
d=options.XTol;             %   vector for the first cycle
maxit = options.MaxIter;    %   maximum permitted number of iterations

while cnt<maxit && ...      %   MAIN ITERATION CYCLE
    any(abs(d)>=epsx) && ...    %%%%%%%%%%%%%%%%%%%%
    any(abs(r)>=epsf)
    d=(A+l*D)\v;            % negative solution increment
    xd=x-d;
    rd=feval(FUN,xd);
%   ~~~~~~~~~~~~~~~~~
    Sd=rd.'*rd;
    dS=d.'*(2*v-A*d);       % predicted reduction
    R=(S-Sd)/dS;

    if R>Rhi
        l=l/2;
        if l<lc, l=0; end
    elseif R<Rlo
        nu=(Sd-S)/(d.'*v)+2;
        if nu<2
            nu=2;
        elseif nu>10
            nu=10;
        end
        if l==0
            lc=1/max(abs(diag(inv(A))));
            l=lc;
            nu=nu/2;
        end
        l=nu*l;
    end
    cnt=cnt+1;
    if ipr>0 && (rem(cnt,ipr)==0 || cnt==1)
        printit(cnt,[S,l,R,x(:).'])
        printit(0,[lc,d(:).'])
    end
    if Sd>S && is==0
        is=1;
        St=S; xt=x; rt=r; Jt=J; At=A; vt=v;
    end
    if Sd<S || is>0
        S=Sd; x=xd; r=rd;
        J=options.Jacobian(FUN,r,x,epsx);
%       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        A=J.'*J;   v=J.'*r;
    else
        S=St; x=xt; r=rt; J=Jt; A=At; v=vt;
    end
    if Sd<S, is=0; end
end
xf = x;                         %   finat solution
if cnt==maxit, cnt=-cnt; end    %   maxit reached
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%   PRINTIT     Printing of intermediate results
%   %%%%%%%
function printit(cnt,mx)
%        ~~~~~~~~~~~~~~~
%  cnt	=  -1  print out the header
%           0  print out second row of results
%          >0  print out first row of results

if ipr>0
   if cnt<0                 %   table header
      disp('')
      disp(char('*'*ones(1,100)))
      disp(['  cnt   SUM(r^2)        l            R' blanks(21) 'x(i) ...'])
      disp([blanks(24) 'lc' blanks(32) 'dx(i) ...'])
      disp(char('*'*ones(1,100)))
      disp('')
   else                     %   iteration output
      if cnt>0 || rem(cnt,ipr)==0
          f='%12.4e ';
          form=[f f f f '\n' blanks(49)];
          if cnt>0
              fprintf(['%4.0f ' f f f ' x = '],[cnt,mx(1:3)])
              fprintf(form,mx(4:length(mx)))
          else
              fprintf([blanks(18) f blanks(13) 'dx = '], mx(1))
              fprintf(form,mx(2:length(mx)))
          end
          fprintf('\n')
      end
   end
end
end

%   FINJAC       numerical approximation to Jacobi matrix
%   %%%%%%
function J = finjac(FUN,r,x,epsx)
%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
lx=length(x);
J=zeros(length(r),lx);
for k=1:lx
    dx=.25*epsx(k);
    xd=x;
    xd(k)=xd(k)+dx;
    rd=feval(FUN,xd);
%   ~~~~~~~~~~~~~~~~
    J(:,k)=((rd-r)/dx);
end
end
end


function value = digamma ( x )

%*****************************************************************************80
%
%% DIGAMMA calculates the digamma or Psi function = d ( LOG ( GAMMA ( X ) ) ) / dX
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    07 September 2004
%
%  Author:
%
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    J Bernardo,
%    Psi ( Digamma ) Function,
%    Algorithm AS 103,
%    Applied Statistics,
%    Volume 25, Number 3, pages 315-317, 1976.
%
%  Parameters:
%
%    Input, real X, the argument of the digamma function.
%    0 < X.
%
%    Output, real VALUE, the value of the digamma function at X.
%
  c = 8.5;
  d1 = -0.5772156649;
  s = 0.00001;
  s3 = 0.08333333333;
  s4 = 0.0083333333333;
  s5 = 0.003968253968;
%
%  The argument must be positive.
%
  if ( x <= 0.0 )

    value = 0.0;
    fprintf ( 1, '\n' );
    fprintf ( 1, 'DIGAMMA - Fatal error!\n' );
    fprintf ( 1, '  X <= 0.\n' );
    error ( 'DIGAMMA - Fatal error!' );
%
%  Use approximation if argument <= S.
%
  elseif ( x <= s )

    value = d1 - 1.0 / x;
%
%  Reduce the argument to DIGAMMA(X + N) where C <= (X + N).
%
  else

    value = 0.0;
    y = x;

    while ( y < c )
      value = value - 1.0 / y;
      y = y + 1.0;
    end
%
%  Use Stirling's (actually de Moivre's) expansion if C < argument.
%
    r = 1.0 / ( y * y );
    value = value + log ( y ) - 0.5 / y - r * ( s3 - r * ( s4 - r * s5 ) );

  end

  return
end


function value = cn_geg_monomial_integral ( n, alpha, expon )

%*****************************************************************************80
%
%% CN_GEG_MONOMIAL_INTEGRAL: integral of monomial with Gegenbauer weight on CN.
%
%  Discussion:
%
%    CN_GEG is the cube [-1,+1]^N with the Gegenbauer weight function
%
%      w(alpha;x) = product ( 1 <= i <= n ) (1-x(i)^2)^alpha.
%
%    with -1.0 < alpha.
%
%    value = integral ( CN )
%      product ( 1 <= i <= n ) x(I)^expon(i) (1-x(i)^2)^alpha dx(i)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 January 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the spatial dimension.
%
%    Input, real ALPHA, the exponent of (1-X).
%    -1.0 < ALPHA.
%
%    Input, integer EXPON(N), the exponents.
%
%    Output, real VALUE, the value of the integral.
%
  if ( alpha <= -1.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'CN_GEG_MONOMIAL_INTEGRAL - Fatal error!\n' );
    fprintf ( 1, '  ALPHA <= -1.0\n' );
    error ( 'CN_GEG_MONOMIAL_INTEGRAL - Fatal error!' );
  end

  value = 1.0;
  for i = 1 : n
    value2 = c1_geg_monomial_integral ( alpha, expon(i) );
    value = value * value2;
  end

  return

end


function a = wilk04 ( )

%*****************************************************************************80
%
%% WILK04 returns the WILK04 matrix.
%
%  Formula:
%
%    0.9143D-04  0.0         0.0         0.0
%    0.8762      0.7156D-04  0.0         0.0
%    0.7943      0.8143      0.9504D-04  0.0
%    0.8017      0.6123      0.7165      0.7123D-04
%
%  Properties:
%
%    A is lower triangular.
%
%    LAMBDA = ( 0.9143D-04, 0.7156D-04, 0.9504D-04, 0.7123D-04 ).
%
%  Discussion:
%
%    Since the matrix is already in lower triangular form, errors can
%    occur only in the backsubstitution.  However, even a double
%    precision calculation will show a significant degradation in the
%    solution.  It is also instructive to compare the actual error in
%    the solution to the residual error, A*x-b.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    James Wilkinson,
%    Rounding Errors in Algebraic Processes,
%    Prentice Hall, 1963, page 105.
%
%  Parameters:
%
%    Output, real A(4,4), the matrix.
%

%
%  Note that the matrix entries are listed by row.
%
  a(1:4,1:4) = [ 0.9143E-04, 0.8762,     0.7943,     0.8017; ...
                 0.0000,     0.7156E-04, 0.8143,     0.6123; ...
                 0.0000,     0.0000,     0.9504E-04, 0.7165; ...
                 0.0000,     0.0000,     0.0000,     0.7123E-04 ];

  return
end


function jed = ymdf_to_jed_eg_civil ( y, m, d, f )

%*****************************************************************************80
%
%% YMDF_TO_JED_EG_CIVIL converts an Egyptian Civil YMDF date to a JED.
%
%  Discussion:
%
%    The Egyptian Civil calendar used a year of 365 days.  The year comprised
%    12 months of 30 days, with 5 epagomenal days occurring at the end of
%    the year.  Since the observed year is about 365.25 days long, and no
%    attempt was made to adjust the Egyptian Civil year to the observed year,
%    the calendar dates gradually drifted with respect to the observed dates.
%
%    The epoch or first day of the Egyptian Civil calendar is taken as
%    JED = 1448638.5.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 March 2013
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Edward Richards,
%    Algorithm E,
%    Mapping Time, The Calendar and Its History,
%    Oxford, 1999, pages 323-324.
%
%  Parameters:
%
%    Input, integer Y, M, D, real F, the YMDF date.
%
%    Output, real JED, the corresponding Julian Ephemeris Date.
%

%
%  Convert the calendar date to a computational date.
%
  y_prime = y + 3968 - floor ( ( 13 - m ) / 13 );
  m_prime = mod ( m + 12, 13 );
  d_prime = d - 1;
%
%  Convert the computational date to a JED.
%
  jed = 365 * y_prime + 30 * m_prime + d_prime - 47 + 1 - 0.5;
  jed = jed + f;

  return
end


function [mWalkout, fR95, fProb, PHI, R] = calc_Schusterwalk(mCatalog)
% function  [mWalkout, fR95, fProb, PHI, R] = calc_Schusterwalk(mCatalog)
% ------------------------------------------------------------------------
% Calculate random walkout (Schuster's method). See Rydelek & Sacks, Nature
% 1989.
%
% Incoming variables:
% mCatalog : EQ catalog
%
% Outgoing variables:
% mWalkout : Random walkout phases
% fR95     : Critical radius at 95% level
% fProb    : Probability to obtain vector of length >= R
% PHI      : Sum of phase angles
% R        : Possible maximum length of vector
%
% J. Woessner, woessner@seismo.ifg.ethz.ch
% last update: 13.03.03

% Get hours and minutes, calculate minutes
vH = mCatalog(:,8);
vMin = mCatalog(:,9);
vTime = vH*60+vMin;

% Calculate degrees and radians
vThetaDegree = vTime*180/720;
vThetaRad = vTime*pi/720;

mWalkout(1,1)=0;
mWalkout(1,2)=0;
for i=1:length(mCatalog(:,8))
    mWalkout(i+1,1)=mWalkout(i,1)+sin(vThetaRad(i));
    mWalkout(i+1,2)=mWalkout(i,2)+cos(vThetaRad(i));
end

A=sum(sin(vThetaRad));
B=sum(cos(vThetaRad));
R=sqrt(A^2+B^2);
PHI=atan(B/A);
% length(mCatalog(:,8))
% if mWalkout(length(mCatalog(:,8)),2)<0
%     PHI=PHI+pi;
% end

N=length(mCatalog(:,8));
% Critical radius at 95% confidence level
fR95=1.73*sqrt(N); % Rydelek & Sacks, Nature 1989
% Probability to obtain vector of length >= R from a random walkout
fProb=exp(-R^2/N);


function [y, sigma, p] = rvmRegPred(model, X, t)
% Compute RVM regression model reponse y = w'*X+w0 and likelihood
% Input:
%   model: trained model structure
%   X: d x n testing data
%   t (optional): 1 x n testing response
% Output:
%   y: 1 x n prediction
%   sigma: variance
%   p: 1 x n likelihood of t
% Written by Mo Chen (sth4nth@gmail.com).
index = model.index;
w = model.w;
w0 = model.w0;

X = X(index,:);
y = w'*X+w0;
%% probability prediction
if nargout > 1
    beta = model.beta;
    U = model.U;        % 3.54
    Xo = bsxfun(@minus,X,model.xbar);
    XU = U'\Xo;
    sigma = sqrt((1+dot(XU,XU,1))/beta);   %3.59
end

if nargin == 3 && nargout == 3
    p = exp(-0.5*(((t-y)./sigma).^2+log(2*pi))-log(sigma));
end


function [x1] = simulate_CRP(alpha,n)
% simulate labels from CRP process with concentration alpha
% IN:
%   - alpha: concentration parameter of the CRP
%   - n: size of the time series
% OUT:
%   - x1: CRP-label process (vector of size 1Xn)

% initial condition
x1 = zeros(1,n);
x1(1) = 1;

% loop over time samples
for i=2:n
   Ki = max(x1(1:i-1)); % number of classes so far
   nk = zeros(Ki,1);
   for k=1:Ki
       nk(k) = sum(x1(1:i-1)==k);
   end
   p = [nk;alpha]./(alpha+i-1);
   x1(i) = VBA_random ('Categorical', p);

end


function ar=v_lpcls2ar(ls)
%V_LPCLS2AR convert line spectrum pair frequencies to ar polynomial AR=(LS)
% input vector elements should be in the range 0 to 0.5

%      Copyright (C) Mike Brookes 1997
%      Version: $Id: v_lpcls2ar.m 10865 2018-09-21 17:22:45Z dmb $
%
%   VOICEBOX is a MATLAB toolbox for speech processing.
%   Home page: http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   This program is free software; you can redistribute it and/or modify
%   it under the terms of the GNU General Public License as published by
%   the Free Software Foundation; either version 2 of the License, or
%   (at your option) any later version.
%
%   This program is distributed in the hope that it will be useful,
%   but WITHOUT ANY WARRANTY; without even the implied warranty of
%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%   GNU General Public License for more details.
%
%   You can obtain a copy of the GNU General Public License from
%   http://www.gnu.org/copyleft/gpl.html or by writing to
%   Free Software Foundation, Inc.,675 Mass Ave, Cambridge, MA 02139, USA.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

[nf,p]=size(ls);
p1=p+1;
p2 = p1*2;
ar=zeros(nf,p1);
for k=1:nf
  le=exp(ls(k,:)*pi*2i);
  lf=[1 le -1 conj(fliplr(le))];
  y=real(poly(lf(1:2:p2)));
  x=real(poly(lf(2:2:p2)));
  ar(k,:)=(x(1:p1)+y(1:p1))/2;
end


function X = bartelsStewart(A, B, C, D, E, xsplit, ysplit)
%BARTELSSTEWART   Solution to generalized Sylvester matrix equation.
%
% Computes the solution to the Sylvester equation
%
%         AXB^T + CXD^T = E
%
% by using the Bartels--Stewart algorithm, see
%
% J. D. Gardiner, A. J. Laub, J. J. Amato, & C. B. Moler, Solution of
% the Sylvester matrix equation AXB^T+ CXD^T= E, ACM Transactions on
% Mathematical Software (TOMS), 18(2), 223-231.
%
% This Bartels--Stewart solver also takes information xsplit, ysplit so
% that if possible it decouples the even and odd modes.

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

tol = eps();

% If the RHS is zero then the solution is the zero solution (assuming
% uniqueness).
if ( norm(E) < 10*tol )
    X = zeros(size(E));
    return
end

% If the equation is even/odd in the x-direction then we can split the problem
% into two subproblems. We enforce P and S as upper triangular because they
% are up to rounding errors, and we need to do back substitution with
% them.
if ( ysplit )
    % This is equivalent to qz(full(A),full(C)), but faster.
    [P, S, Q1, Z1] = qzsplit(A, C);
    P = triu(P);
    S = triu(S);
else
    [P, S, Q1, Z1] = qz(full(A), full(C));
    P = triu(P);
    S = triu(S);
end

% If the PDE is even/odd in the y-direction then we can split (further)
% into double as many subproblems.
if ( xsplit )
    % Faster QZ when even/odd modes decouple in x-direction:
    [T, R, Q2, Z2] = qzsplit(D, B);
else
    % QZ does not take matrices in sparse format:
    [T, R, Q2, Z2] = qz(full(D), full(B));
end

% Now use the generalised Bartels--Stewart solver found in Gardiner et al.
% (1992).  The Sylvester matrix equation now contains quasi upper-triangular
% matrices and we can do a backwards substitution.

% transform the righthand side.
F = Q1*E*Q2.';

% Solution will be a m by n matrix.
m = size(A, 1);
n = size(B, 1);
Y = zeros(m, n);

% Do a backwards substitution type algorithm to construct the solution.
k=n;
PY = zeros(m);
SY = zeros(m);

% Construct columns n,n-1,...,3,2 of the transformed solution.  The first
% column is treated as special at the end.
while k > 1
    % There are two cases, either the subdiagonal contains a zero
    % T(k,k-1)=0 and then it is a backwards substitution, or T(k,k-1)~=0
    % and then we solve a 2x2 system instead.

    if ( T(k,k-1) == 0 )
        % Simple case (almost always end up here).
        rhs = F(:,k);
        if ( k < n )

            PY(:,k+1) = P*Y(:,k+1);
            SY(:,k+1) = S*Y(:,k+1);

            for jj = k+1:n
                rhs = rhs - R(k,jj)*PY(:,jj) - T(k,jj)*SY(:,jj);
            end

        end

        % find the kth column of the transformed solution.
        Y(:,k) = (R(k,k)*P + T(k,k)*S) \ rhs;

        % go to next column
        k = k-1;

    else
        % This is a straight copy from the Gardiner et al. paper, and just
        % solves for two columns at once. (works because of
        % quasi-triangular matrices.

        % Operator reduction.
        rhs1 = F(:,k-1);
        rhs2 = F(:,k);

        for jj = k+1:n
            yj = Y(:,jj);
            rhs1 = rhs1 - R(k-1,jj)*P*yj - T(k-1,jj)*S*yj;
            rhs2 = rhs2 - R(k,jj)*P*yj - T(k,jj)*S*yj;
        end

        % 2 by 2 system.
        SM = zeros(2*n);
        up = 1:n;
        down = n+1:2*n;

        SM(up,up) = R(k-1,k-1)*P + T(k-1,k-1)*S;
        SM(up,down) = R(k-1,k)*P + T(k-1,k)*S;
        SM(down,up) = R(k,k-1)*P + T(k,k-1)*S;
        SM(down,down) = R(k,k)*P + T(k,k)*S;

        % Permute the columns and rows:
        Spermuted = zeros(2*n);
        Spermuted(1:2:2*n,1:2:2*n) = SM(1:n,1:n);
        Spermuted(2:2:2*n,2:2:2*n) = SM(n+1:2*n,n+1:2*n);

        % Solve.
        UM = Spermuted \ [rhs1; rhs2];

        Y(:,k-1) = UM(up);
        Y(:,k) = UM(down);

        PY(:,k) = P*Y(:,k);
        PY(:,k-1) = P*Y(:,k-1);
        SY(:,k) = S*Y(:,k);
        SY(:,k-1) = S*Y(:,k-1);

        % We solved for two columns so go two columns further.
        k=k-2;

    end

end

if ( k == 1 )
    % Now we have just the first column to compute.
    rhs = F(:,1);
    PY(:,2) = P*Y(:,2);
    SY(:,2) = S*Y(:,2);
    for jj = 2:n
        rhs = rhs - R(1,jj)*PY(:,jj) - T(1,jj)*SY(:,jj);
    end
    Y(:,1) = (R(1,1)*P + T(1,1)*S) \ rhs;
end

% We have now computed the transformed solution so we just transform it
% back.
X = Z1*Y*Z2.';

end

function [P, S, Q1, Z1] = qzsplit(A, C)
%QZSPLIT   A faster qz factorisation for problems that decouple.
%
% This is equivalent to standard qz, except we take account of symmetry to
% reduce the computational requirements of the QZ factorisation.

% Do the QZ by splitting the problem into two subproblems.
A = full(A);

A1 = A(1:2:end,1:2:end);
C = full(C);
C1 = C(1:2:end,1:2:end);
[P1, S1, Q1, Z1] = qz(A1, C1);

A2 = A(2:2:end,2:2:end);
C2 = C(2:2:end,2:2:end);
[P2, S2, Q2, Z2] = qz(A2, C2);

[P, S, Q1, Z1] = reform(P1, P2, S1, S2, Q1, Q2, Z1, Z2);

end

function [P, S, Q, Z] = reform(P1, P2, S1, S2, Q1, Q2, Z1, Z2)
%REFORM   Recombine subproblems to form the QZ factorization.

% Initialise all the variables.
hf1 = size(P1, 1);
n = 2*hf1 - 1;
P = zeros(n);
S = zeros(n);
Q = zeros(n);
Z = zeros(n);

% Push the subproblem back together.
P(1:hf1,1:hf1) = P1;
P(hf1+1:end,hf1+1:end) = P2;

S(1:hf1,1:hf1) = S1;
S(hf1+1:end,hf1+1:end) = S2;

Q(1:hf1,1:2:end) = Q1;
Q(hf1+1:end,2:2:end) = Q2;

Z(1:2:end,1:hf1) = Z1;
Z(2:2:end,hf1+1:end) = Z2;

end


function lik = ml_gauss_lik(y,X,w,e_var)
%ML_GAUSS_LIK Gaussian Likelihood
%
%   input -----------------------------------------------------------------
%
%       o y     : (N x 1), output.
%
%       o X     : (N x D), input, N samples of dimension D.
%
%       o w     : (D+1 x 1), linear regressor weights.
%
%       o e_var : (1 x 1), noise variance.
%
%   output ----------------------------------------------------------------
%
%       o lik   : (N x 1),
%

[N,D] = size(X);

% (N x 1) - (N x D+1) (D+1 x 1)
% (N x 1) - (N x 1)

diff = y - [X,ones(N,1)] * w';
z     = sum(diff .* diff);

lik  = 1.0/( (2 * pi * e_var)^(D/2)) * exp(-1/(2*e_var) *  z);

end


function [esTheta, esPhi] = mieScatteredField(An, Bn, theta, phi, frequency)

% Compute the complex-value scattered electric far field of a sphere
% using pre-computed coefficients An and Bn. Based on the treatment in:
%
% Ruck, et. al. "Radar Cross Section Handbook", Plenum Press, 1970.
%
% The incident electric field is in the -z direction (theta = 0) and is
% theta-polarized. The time-harmonic convention exp(jwt) is assumed, and
% the Green's function is of the form exp(-jkr)/r.
%
% Inputs:
%   An: Array of Mie solution constants
%   Bn: Array of Mie solution constants
%       (An and Bn should have the same length)
%   theta: Scattered field theta angle (radians)
%   phi: Scattered field phi angle (radians)
% Outputs:
%   esTheta: Theta-polarized electric field at the given scattering angles
%   esPhi: Phi-polarized electric field at the given scattering angles
%
%   Output electric field values are normalized such that the square of the
%   magnitude is the radar cross section (RCS) in square meters.
%
%   Author: Walton C. Gibson, email: kalla@tripoint.org

% speed of light
c = 299792458.0;

% wavenumber
k = 2.0*pi*frequency/c;

sinTheta = abs(sin(theta)); % note: theta only defined from from 0 to pi
cosTheta = cos(theta); % ok for theta > pi

% first two values of the Associated Legendre Polynomial
plm(1) = -sinTheta;
plm(2) = -3.0*sinTheta*cosTheta;

S1 = 0.0;
S2 = 0.0;

p = plm(1);

% compute coefficients for scattered electric far field
for iMode = 1:length(An)

        % derivative of associated Legendre Polynomial
    if abs(cosTheta) < 0.999999
        if iMode == 1
            dp = cosTheta*plm(1)/sqrt(1.0 - cosTheta*cosTheta);
        else
            dp = (iMode*cosTheta*plm(iMode) - (iMode + 1)*plm(iMode - 1))/sqrt(1.0 - cosTheta*cosTheta);
        end
    end

    if abs(sinTheta) > 1.0e-6
        term1 = An(iMode)*p/sinTheta;
        term2 = Bn(iMode)*p/sinTheta;
    end

    if cosTheta > 0.999999
        % Ruck, et. al. (3.1-12)
        val = ((i)^(iMode-1))*(iMode*(iMode+1)/2)*(An(iMode) - i*Bn(iMode));
        S1 = S1 + val;
        S2 = S2 + val;
    elseif cosTheta < -0.999999
        % Ruck, et. al. (3.1-14)
        val = ((-i)^(iMode-1))*(iMode*(iMode+1)/2)*(An(iMode) + i*Bn(iMode));
        S1 = S1 + val;
        S2 = S2 - val;
    else
        % Ruck, et. al. (3.1-6)
        S1 = S1 + ((i)^(iMode+1))*(term1 - i*Bn(iMode)*dp);
        % Ruck, et. al. (3.1-7)
        S2 = S2 + ((i)^(iMode+1))*(An(iMode)*dp - i*term2);
    end

    % recurrence relationship for next Associated Legendre Polynomial
    if iMode > 1
        plm(iMode + 1) = (2.0*iMode + 1)*cosTheta*plm(iMode)/iMode - (iMode + 1)*plm(iMode - 1)/iMode;
    end
    p = plm(iMode + 1);
end

% complex-value scattered electric far field, Ruck, et. al. (3.1-5)
esTheta = S1*cos(phi);
esPhi = -S2*sin(phi);

% normalize electric field so square of magnitude is RCS in square meters
esTheta = esTheta*sqrt(4.0*pi)/k;
esPhi = esPhi*sqrt(4.0*pi)/k;

return


function r=rot4z(theta,xscale,yscale,zscale)
    % r = rot4z(theta)
    %
    % rotz produces a 4x4 rotation matrix representing
    % a rotation by theta radians about the z axis.
    %
    %	Argument definitions:
    %
    %	theta = rotation angle in radians
    if nargin == 1
        c = cos(theta);
        s = sin(theta);
        r = [c -s  0 0;
            s  c  0 0;
            0  0  1 0;
            0  0  0 1];
    else
        c = cos(theta);
        s = sin(theta);
        r = [c -s  0 xscale;
            s  c  0 yscale;
            0  0  1 zscale;
            0 0 0  1];
    end


%% Script for the Birthday Paradox simulation

% Define paramenters for simulation

  numtrials = 2e5;
  groupsize = 30;

% Preallocate some memory for the matches

  matches = zeros(1, numtrials);

  parfor trial = 1:numtrials

    matches(trial) = birthday(groupsize);

  end

% Probability is the sum of matches divided by number of trials

  prob = sum ( matches ) / numtrials;


function expected_scale =  spm_expected_scale(min_img_sz, boxes, spm_params)
% expected_scale =  spm_expected_scale(min_img_sz, boxes, spm_params)
%
%   min_img_sz      min(size(im, 1), size(im, 2))
%   boxes           in rows with (l, t, r, b)
%
% AUTORIGHTS
% ---------------------------------------------------------
% Copyright (c) 2014, Shaoqing Ren
%
% This file is part of the SPP code and is available
% under the terms of the Simplified BSD License provided in
% LICENSE. Please retain this notice and LICENSE if you use
% this file (or any portion of it) in your project.
% ---------------------------------------------------------

area = (boxes(:, 3) - boxes(:, 1) + 1) .* (boxes(:, 4) - boxes(:, 2) + 1);

expected_scale = spm_params.sz_conv_standard * spm_params.step_standard * min_img_sz ./ sqrt(area);
%     scale_expected = standard_img_size * min_img_sz ./ sqrt(area);
expected_scale = round(expected_scale(:));

end


% getFWHM_uhe(r)
%
%   Get FWHM (mm) of the ultra-high-energy collimator PSF
%   at some distances 'r' (mm) from the collimator
%
% Qiang (Victor) Lin
% Modified by A. Yendiki, 2/5/02

function FWHM = getFWHM_uhe(r)

r(r < 0) = 0;

%  Radius (mm) FWHM (mm?)
%   20          5.6135
%   75         13.8277
%   130        18.2010
%   185        22.2908
%   245        26.9498

fw20  = 5.6135;
fw75  = 13.8277;
fw130 = 18.2010;
fw185 = 22.2908;
fw245 = 26.9498;

FWHM = (fw75 - (75-r) * ((fw75-fw20)/(75-20))) .* (r <= 75) ...
     + (fw130 - (130-r) * ((fw130-fw75)/(130-75))) .* (r <= 130 & r > 75) ...
     + (fw185 - (185-r) * ((fw185-fw130)/(185-130))) .* (r <= 185 & r > 130) ...
     + (fw185 - (185-r) * ((fw245-fw185)/(245-185))) .* (r > 185);


%%  Introduction to *image_scat*
% *image_scat* is a function to visualize scattering coefficients. It will
% display the output of every path of the scattering.
%
%% Usage
% output_image = *image_scat*(S); where *S* is the output of *scat*.
%
%% Example
% The following code will produce 3 images.
x = mandrill;
[Wop,filters] = wavelet_factory_2d(size(x));
[S,U] = scat(x,Wop);
image_scat(S);

% They correspond to the resulting scattering coefficients of each paths
% for each layer and each rotation. The legend indicates the path and the resolution.
% These filters are normalized but the normalization can be removed by
% modifying the option of image_scat. The caption can also be removed with
% a specific option.
%
% To improve legibility, the image background behind the caption is
% artificially enlightened.
%
% On the Figure 2 for instance, there is 2 different j. The first one
% corresponds to the scale of the used wavelets whereas the second one
% corresponds to the scale of the low-pass filter which is thus constant.


function [all_theta] = oneVsAll(X, y, num_labels, lambda)
%ONEVSALL trains multiple logistic regression classifiers and returns all
%the classifiers in a matrix all_theta, where the i-th row of all_theta
%corresponds to the classifier for label i
%   [all_theta] = ONEVSALL(X, y, num_labels, lambda) trains num_labels
%   logisitc regression classifiers and returns each of these classifiers
%   in a matrix all_theta, where the i-th row of all_theta corresponds
%   to the classifier for label i

% Some useful variables
m = size(X, 1);
n = size(X, 2);

% You need to return the following variables correctly
all_theta = zeros(num_labels, n + 1);

% Add ones to the X data matrix
X = [ones(m, 1) X];

% ====================== YOUR CODE HERE ======================
% Instructions: You should complete the following code to train num_labels
%               logistic regression classifiers with regularization
%               parameter lambda.
%
% Hint: theta(:) will return a column vector.
%
% Hint: You can use y == c to obtain a vector of 1's and 0's that tell use
%       whether the ground truth is true/false for this class.
%
% Note: For this assignment, we recommend using fmincg to optimize the cost
%       function. It is okay to use a for-loop (for c = 1:num_labels) to
%       loop over the different classes.
%
%       fmincg works similarly to fminunc, but is more efficient when we
%       are dealing with large number of parameters.
%
% Example Code for fmincg:
%
%     % Set Initial theta
%     initial_theta = zeros(n + 1, 1);
%
%     % Set options for fminunc
%     options = optimset('GradObj', 'on', 'MaxIter', 50);
%
%     % Run fmincg to obtain the optimal theta
%     % This function will return theta and the cost
%     [theta] = ...
%         fmincg (@(t)(lrCostFunction(t, X, (y == c), lambda)), ...
%                 initial_theta, options);
%

	for c = 1 : num_labels,
		initial_theta = zeros(n + 1 , 1);
		options = optimset('GradObj' , 'on' , 'MaxIter' , 50);
		[theta] = ...
			fmincg(@(t)(lrCostFunction(t , X , (y == c) , lambda)), ...
					initial_theta , options);
		all_theta(c,:) = theta';

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

end


function [X,Y,beta_c,noise] = GenDataLinear(m,beta,v)

X         = randn(m, length(beta));
X         = X./repmat(sqrt(sum(X.^2,1)),size(X,1),1);
noise     = randn(m,1)/sqrt(v);
beta_c    = beta(:);
Y         = X*beta_c+noise;


function [x,label] = spm_samp_mix (mix, N)
% Sample from a Gaussian Mixture PDF
% FORMAT [x,label] = spm_samp_mix (mix, N)
%
% mix   Data structure for mixture model (see spm_mix for info)
% N     Number of samples
%
% x     [N x d] matrix of samples
% label [N x 1] vector of sample labels
%___________________________________________________________________________
% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging

% Will Penny
% $Id: spm_samp_mix.m 1143 2008-02-07 19:33:33Z spm $

priors = rand(1, N);
cum_prior = 0;
total_samples = 0;
label = zeros(N, 1);
for j=1:mix.m,
    num_samples = sum(priors >= cum_prior & ...
        priors < cum_prior + mix.state(j).prior);
    m=mix.state(j).m;
    C=squeeze(mix.state(j).C);
    x(total_samples+1:total_samples+num_samples, :) = ...
        spm_samp_gauss(m, C, num_samples);
    cum_prior = cum_prior + mix.state(j).prior;
    total_samples = total_samples + num_samples;
    label(total_samples+1:total_samples+num_samples) = j;
end


function tests = test_spm_ncFpdf
% Unit Tests for spm_ncFpdf
%__________________________________________________________________________
% Copyright (C) 2018 Wellcome Trust Centre for Neuroimaging

% $Id: test_spm_ncFpdf.m 7263 2018-02-21 13:30:16Z guillaume $

tests = functiontests(localfunctions);

function test_spm_ncFpdf_1(testCase)
exp = 0.230361989229139; % ncfpdf(1,1,10,0) = fpdf(1,1,10)
act = spm_ncFpdf(1,[1,10],0);
tol = 1e-12;
testCase.verifyEqual(act, exp,'AbsTol',tol);

exp = 0.339916677089114; % ncfpdf(1,2,12,0)
act = spm_ncFpdf(1,[2,12],0);
tol = 1e-12;
testCase.verifyEqual(act, exp,'AbsTol',tol);

exp = 0.187052298433871; % ncfpdf(2,2,10,2)
act = spm_ncFpdf(2,[2,10],2);
tol = 1e-12;
testCase.verifyEqual(act, exp,'AbsTol',tol);

function test_spm_ncFpdf_2(testCase)
exp = [0 % ncfpdf(0:0.3:5,3,24,pi)
   0.237214867508572
   0.305378558226511
   0.326510412867316
   0.320250126742450
   0.298516612369365
   0.269121488384202
   0.237061968288903
   0.205374511459040
   0.175766182458195
   0.149074704100068
   0.125592498668479
   0.105287389552812
   0.087948186675270
   0.073277611204176
   0.060949393292047
   0.050641638818210]';
act = spm_ncFpdf(0:0.3:5,[3,24],pi);
tol = 1e-12;
testCase.verifyEqual(act, exp,'AbsTol',tol);


function [P,f,alpha] = fastlomb(x,t,varargin)
% FASTLOMB caculates the Lomb normalized periodogram (aka Lomb-Scargle, Gauss-Vanicek or Least-Squares spectrum) of a vector x with coordinates in t.
%   The coordinates need not be equally spaced. In fact if they are, it is
%   probably preferable to use PWELCH or SPECTRUM. For more details on the
%   Lomb normalized periodogram, see the excellent section 13.8 in [1], pp.
%   569-577.
%
%   This code is a transcription of the Fortran subroutine fasper in [1]
%   (pp.575-577), so it is a really fast (albeit not really exact)
%   implementation of the Lomb periodogram. Also Matlab's characteristics
%   have been taken into account in order to make it even faster for
%   Matlab. For an exact calculation of the Lomb periodogram use LOMB,
%   which is however about 100 times slower.
%
%   If the 'fig' flag is on, the periodogram is created, along with some
%   default statistical significance levels: .001, .005, .01, .05, .1, .5.
%   If the user wants more significance levels, they can give them as input
%   to the function. Those will be red.
%
% SYNTAX
%   [P,f,alpha] = fastlomb(x,t,fig,hifac,ofac,a);
%   [P,f,alpha] = fastlomb(x,t,fig,hifac,ofac);
%   [P,f,alpha] = fastlomb(x,t,fig,hifac);
%   [P,f,alpha] = fastlomb(x,t,fig);
%   [P,f,alpha] = fastlomb(x,t);
%
% INPUTS
%   x:     the vector whose spectrum is wanted.
%   t:     coordinates of x (should have the same length).
%   fig:   if 0 (default), no figure is created.
%   hifac: the maximum frequency returned is
%               (hifac) x (average Nyquist frequency)
%          See "THE hifac PARAMETER" in the NOTES section below for more
%          details on the hifac parameter. Default is 1 (i.e. max frequency
%          is the Nyquist frequency).
%   ofac:  oversampling factor. Typically it should be 4 or larger. Default
%          is 4. See "INTERPRETATION AND SELECTION OF THE ofac PARAMETER"
%          in the NOTES section below for more details on the choice of
%          ofac parameter.
%   a:     additional significance levels to be drawn on the figure.
%
% OUTPUTS
%   P:     the Lomb normalized periodogram
%   f:     respective frequencies
%   alpha: statistical significance for each value of P
%
% NOTES
% A. INTERPRETATION AND SELECTION OF THE ofac PARAMETER [1]
%    The lowest independent frequency f to be examined is the inverse of
%    the span of the input data,
%               1/(tmax-tmin)=1/T.
%    This is the frequency such that the data can include one complete
%    cycle. In an FFT method, higher independent frequencies would be
%    integer multiples of 1/T . Because we are interested in the
%    statistical significance of ANY peak that may occur, however, we
%    should over-sample more finely than at interval 1/T, so that sample
%    points lie close to the top of ANY peak. This oversampling parameter
%    is the ofac. A value ofac >~4 might be typical in use.
%
% B. THE hifac PARAMETER [1]
%    Let fhi be the highest frequency of interest. One way to choose fhi is
%    to compare it with the Nyquist frequency, fc, which we would obtain, if
%    the N data points were evenly spaced over the same span T, that is
%               fc = N/(2T).
%    The input parameter hifac, is defined as fhi/fc. In other words, hifac
%    shows how higher (or lower) that the fc we want to go.
%
% REFERENCES
%   [1] W.H. Press, S.A. Teukolsky, W.T. Vetterling and B.P. Flannery,
%       "Numerical recipes in Fortran 77: the art of scientific computing",
%       2nd ed., vol. 1, Cambridge University Press, NY, USA, 2001.
%
% C. Saragiotis, Nov 2008

%% Inputs check and initialization
if nargin < 2, error('%s: there must be at least 2 inputs.',mfilename); end
MACC = 10;   % Number of interpolation points per 1/4 cycle of the highest frequency

[x,t,hifac,ofac,a_usr,f,fig] = init(x,t,varargin{:});
nt = length(t);

mx = mean(x);
x  = x-mx;
vx = var(x);
if vx==0, error('x has zero variance'); end

nf = length(f);
nfreq  = 2^nextpow2(ofac*hifac*nt*MACC);
% ndim = 2*nfreq;

tmin = t(1);
tmax = t(end);
T = tmax-tmin;

%% Extirpolation
fac = 2*nfreq/(T*ofac);
[wk1,wk2] = extirpolate(t-tmin,x,fac,nfreq,MACC);

%% Take the FFT's
W = fft(wk1);
reft1 = real(W(2:nf+1)); % only positive frequencies, without f=0
imft1 = imag(W(2:nf+1));

W = fft(wk2);
reft2 = real(W(2:nf+1));
imft2 = imag(W(2:nf+1));

%% Main
hypo  = sqrt(reft2.^2+imft2.^2);
hc2wt = 0.5*reft2./hypo;
hs2wt = 0.5*imft2./hypo;
cwt   = sqrt(0.5+hc2wt);
swt   = (sign(hs2wt)+(hs2wt==0)).*(sqrt(0.5-hc2wt));
den   = 0.5*nt + hc2wt.*reft2 + hs2wt.*imft2;
cterm = (cwt.*reft1 + swt.*imft1).^2./den;
sterm = (cwt.*imft1 - swt.*reft1).^2./(nt-den);
P  = (cterm+sterm)/(2*vx);
P  = P(:);

%% Significance
M = 2*nf/ofac;
alpha = 1 - (1-exp(-P)).^M;              % statistical significance
alpha(alpha<0.1) = M*exp(-P(alpha<0.1)); % (to avoid round-off errors)

%% Figure
if fig
    figure
    styles = {':','-.','--'};

    a = [0.001 0.005 0.01 0.05 0.1 0.5];
    La = length(a);
    z = -log(1-(1-a).^(1/M));
%     widths = [.5*ones(1,floor(La/3)) 1*ones(1,La-2*floor(La/3)) 2*ones(1,floor(La/3))];
    hold on;
    for i=1:La
        line([f(1),0.87*f(end)],[z(i),z(i)],'Color','k','LineStyle',styles{ceil(i*3/La)});%,'LineWidth',widths(i));
        text(0.9*f(end),z(i),strcat('\alpha = ',num2str(a(i))),'fontsize',8); %,'fontname','symbol');
%         lgd{i}=strcat('\alpha=',num2str(a(i)));
    end
    if ~isempty(a_usr)
        [tmp,ind] = intersect(a_usr,a);
        a_usr(ind)=[];
        La_usr = length(a_usr);
        z_usr  = -log(1-(1-a_usr).^(1/M));
        for i = 1:La_usr
            line([f(1),0.87*f(end)],[z_usr(i),z_usr(i)],'Color','r','LineStyle',styles{ceil(i*3/La_usr)});%,'LineWidth',widths(i));
            text(0.9*f(end),z_usr(i),strcat('\alpha = ',num2str(a_usr(i))),'fontsize',8); %,'fontname','symbol');
    %         lgd{La+i}=strcat('\alpha=',num2str(a_usr(i)));
        end
    z = [z z_usr];
    end
%     legend(lgd);
    plot(f,P,'k');
    title('Lomb-Scargle normalized periodogram')
    xlabel('f (Hz)'); ylabel('P(f)')
    xlim([0 f(end)]); ylim([0,1.2*max([z'; P])]);
    hold off;
end

end

%% #### Local functions

%% init (initialize)
function [x,t,hifac,ofac,a,f,fig] = init(x,t,varargin)
    if nargin < 6, a = [];    % set default value for a
    else           a = sort(varargin{4});
                   a = a(:)';
    end
    if nargin < 5, ofac = 4;  % set default value for ofac
    else           ofac = varargin{3};
    end
    if nargin < 4, hifac = 1; % set default value for hifac
    else           hifac = varargin{2};
    end
    if nargin < 3, fig = 0;   % set default value for hifac
    else           fig = varargin{1};
    end

    if isempty(ofac),  ofac  = 4; end
    if isempty(hifac), hifac = 1; end
    if isempty(fig),   fig   = 0; end

    if ~isvector(x) ||~isvector(t),
        error('%s: inputs x and t must be vectors',mfilename);
    else
        x = x(:); t = t(:);
        nt = length(t);
        if length(x)~=nt
            error('%s: Inputs x and t must have the same length',mfilename);
        end
    end

    [t,ind] = unique(t);    % discard double entries and sort t
    x = x(ind);
    if length(x)~=nt, disp(sprintf('WARNING %s: Double entries have been eliminated',mfilename)); end

    T = t(end) - t(1);
    nf = round(0.5*ofac*hifac*nt);
    f = (1:nf)'/(T*ofac);
end

%% extirpolation
function [wk1,wk2] = extirpolate(t,x,fac,nfreq,MACC)
    nt = length(x);
    wk1 = zeros(2*nfreq,1);
    wk2 = zeros(2*nfreq,1);

    for j = 1:nt
        ck  = 1 + mod(fix(t(j)*fac),2*nfreq);
        ckk = 1 + mod(2*(ck-1),     2*nfreq);
        wk1 = spread(x(j),wk1,ck, MACC);
        wk2 = spread(1   ,wk2,ckk,MACC);
    end
end

%% spread
function yy = spread(y,yy,x,m)

    nfac = [1 1 2 6 24 120 720 5040 40320 362880];
    n = length(yy);

    if x == round(x)  % Original Fortran 77 code: ix=x
                      %                           if(x.eq.float(ix)) then...
        yy(x) = yy(x) + y;
    else
        % Original Fortran 77 code: i1 = min(  max( int(x-0.5*m+1.0),1 ), n-m+1  )
        i1 = min([  max([ floor(x-0.5*m+1),1 ]),  n-m+1  ]);
        i2 = i1+m-1;
        nden = nfac(m);
        fac = x-i1;

        fac = fac*prod(x - (i1+1:i2));
        yy(i2) = yy(i2) + y*fac/(nden*(x-i2));

        for j = i2-1:-1:i1
            nden = (nden/(j+1-i1))*(j-i2);
            yy(j) = yy(j) + y*fac/(nden*(x-j));
        end

    end
end


function[varargout]=maternimp(varargin)
%MATERNIMP  Impulse response function for the Matern random process.
%
%   [T,G]=MATERNIMP(N,ALPHA,LAMBDA) returns first N points for the impulse
%   response function G for a *unit-variance* complex-valued Matern process
%   with slope parameter ALPHA and damping or range parameter LAMBDA.
%
%   The impulse response function is also known as the Green's function.
%
%   T is an array of times T=[EPSILON 1:1:N] where the first point is set to
%   a very small number, set to EPSILON=1e-6 to avoid the potential for
%   infinite values at T=0 for some parameter settings.
%
%   The sample interval is taken to be unity.  The damping parameter LAMBDA
%   is understood to have units of the inverse of the sample interval.
%
%   Note that for LAMBDA=0, the case of fractional Brownian motion, G is
%   formally defined but is not useful because it does not decay.
%
%   The input parameters ALPHA and LAMBDA may either be scalars or arrays
%   of the same length M.  If the latter, then the output autocovariance
%   function R will be a matrix with N rows and M columns.
%
%   See MATERNSPEC for a more thorough discussion of the Matern process.
%
%   For details on the Matern process and impulse response function, see:
%
%     Lilly, Sykulski, Early, and Olhede, (2017).  Fractional Brownian
%        motion, the Matern process, and stochastic modeling of turbulent
%        dispersion.  Nonlinear Processes in Geophysics, 24: 481--514.
%   __________________________________________________________________
%
%   Oscillatory Matern
%
%   MATERNIMP(N,ALPHA,C), where C is complex, uses LAMBDA=REAL(C) for the
%   damping parameter and also sets a rotation frequency to OMEGA=-IMAG(C).
%
%   The associated oscillatory process undergoes rotations at frequency
%   OMEGA in addition to the damping at timescale 1/LAMBDA.
%   __________________________________________________________________
%
%   Specified times
%
%   G=MATERNIMP(T,ALPHA,LAMBDA) where the first argument is an *array*
%   rather than a scalar, will alternately return the impulse response at
%   the specified times T.  Note T is not output again in this case.
%   __________________________________________________________________
%
%   Use in fast generation
%
%   [T,G]=MATERNIMP([],ALPHA,LAMBDA) where the first argument is the empty
%   set, evaluates the Green's function at the points T = [0:1:N-1]'+1/2.
%   This form is utilized in the fast generation method implemented by
%   MATERNOISE and discussed in Section 5 of Lilly et al. (2017).
%   __________________________________________________________________
%
%   See also MATERNSPEC, MATERNCOV, MATERNOISE, MATERNFIT.
%
%   'maternimp --t' runs some tests.
%
%   Usage:    [t,G]=maternimp(N,alpha,lambda);
%             G=maternimp(t,alpha,lambda);
%   __________________________________________________________________
%   This is part of JLAB --- type 'help jlab' for more information
%   (C) 2013--2017 J.M. Lilly --- type 'help jlab_license' for details

if strcmpi(varargin{1}, '--t')
    maternimp_test,return
end

N=[];
tau=[];

if length(varargin)==3
    if length(varargin{1})==1
        N=varargin{1};
    else
        tau=varargin{1};
    end
end

if isempty(tau)
    tau=[0:1:N-1]'+1/2;
end

alpha=varargin{2};
lambda=real(varargin{3});
omegao=-imag(varargin{3});
arrayify(alpha,omegao,lambda);

G=zeros(size(tau,1),length(lambda));
if size(tau,2)~=length(lambda)
    tau=vrep(tau,length(lambda),2);
end
for i=1:length(lambda)
    U=frac(1,2).*(1+sign(tau(:,i)));
    d=sqrt(frac(lambda(i).^(2*alpha(i)-1),materncfun(alpha(i))));
    G(:,i)=d.*U.*(tau(:,i).^(alpha(i)-1)).*exp(-tau(:,i).*lambda(i)).*exp(sqrt(-1)*omegao(i)*tau(:,i)).*frac(1,gamma(alpha(i)));
end

if ~isempty(N)
    varargout{1}=tau;
    varargout{2}=G;
else
    varargout{1}=G;
end

function[]=maternimp_test
alpha=[1 1.5 2 3 4];
h=[.01 .02 .05 .2 1]/10;
[alpha,h]=meshgrid(alpha,h);
vcolon(alpha,h);
[tau,g]=maternimp(15000,alpha,h);
d=sqrt(frac(h.^(2*alpha-1),materncfun(alpha)));
for i=1:size(g,2)
    g(:,i)=g(:,i)./d(i);
end
reporttest('MATERNIMP integral of Green''s function matches analytic form',aresame((sum(g,1)'.*(h.^alpha))'-1,zeros(size(h')),2.5e-2))

t=[0:1:150]';
alpha=1.4;h=1/10;
g=maternimp(t,alpha,h);
R1=conv(g,flipud(g));
[tau,R2]=materncov(1,length(t),1,alpha,h,'full');
eps=sum(squared(R1-R2))./sum(squared(R1));
reporttest('MATERNIMP Green''s function convolves to autocovariance sample rate',eps<1e-3)

N=1000;
alpha=1.4;h=1/10;
[tau,g]=maternimp(N,alpha,h);
R1=conv(g,flipud(g));
[tau,R2]=materncov(1,N,1,alpha,h,'full');
eps=sum(squared(R1-R2))./sum(squared(R1));
reporttest('MATERNIMP Green''s function convolves to autocovariance without time input',eps<1e-3)


function h = p32_h ( n, x )

%*****************************************************************************80
%
%% P32_H evaluates the Hessian for problem 32.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 January 2001
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of variables.
%
%    Input, real X(N), the values of the variables.
%
%    Output, real H(N,N), the N by N Hessian matrix.
%
  h = zeros ( n, n );

  m = 7;
  a = [
    4.0, 4.0, 4.0, 4.0; ...
    1.0, 1.0, 1.0, 1.0; ...
    8.0, 8.0, 8.0, 8.0; ...
    6.0, 6.0, 6.0, 6.0; ...
    3.0, 7.0, 3.0, 7.0; ...
    2.0, 9.0, 2.0, 9.0; ...
    5.0, 5.0, 3.0, 3.0 ]';

  c = [ 0.1, 0.2, 0.2, 0.4, 0.6, 0.6, 0.3 ]';

  for ii = 1 : n
    for jj = 1 : n
      for j = 1 : m
        d = c(j) + sum ( ( x(1:n) - a(1:n,j) ).^2 );
        h(ii,jj) = h(ii,jj) - 8.0 * ( x(ii) - a(ii,j) ) * ( x(jj) - a(jj,j) ) / d^3;
        if ( ii == jj )
          h(ii,jj) = h(ii,jj) + 2.0 / d^2;
        end
      end
    end
  end

  return
end


function y=roundTies2EvenOdd(x,mode)
%%ROUNDTIES2EVENODD Round the values in x to the nearest integer. Ties will
%                   either round to even or odd integers.
%
%INPUTS:   x A scalar, vector, matrix of values to round to the nearest
%            integer.
%       mode A parameter specifying how ties (when the value is an integer
%           +0.5) are handled. Possible values are
%           0 (The default if omitted or an empty matrix is passed) Round
%             ties to even integers.
%           1 Round ties to odd integers.
%
%OUTPUTS: y x rounded with the selected handling of ties.
%
%EXAMPLE:
%As an example of rounding to even versus odd integers, consider:
% x=[-1.5,-2.5,-3.5,-1.1,-1.9,-2.1,-2.9,0,1.5,2.5,3.5,1.1,1.9,2.1,2.9];
% y1=roundTies2EvenOdd(x,0)
% y2=roundTies2EvenOdd(x,1)
%One will find that
%y1=[-2,-2,-4,-1,-2,-2,-3,0,2,2,4,1,2,2,3]
%y2=[-1,-3,-3,-1,-2,-2,-3,0,1,3,3,1,2,2,3]
%
%November 2015 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

    if(nargin<2||isempty(mode))
        mode=0;
    end

    switch(mode)
        case 0%Round with ties going to even
            y=round(x);
            sel1=abs(x-fix(x))==0.5 & mod(fix(x),2)==0;
            y(sel1)=fix(x(sel1));
        case 1%Round with ties going to odd.
            y=round(x);
            sel1=abs(x-fix(x))==0.5 & mod(fix(x),2)==1;
            y(sel1)=fix(x(sel1));
        otherwise
            error('Wrong Mode specified')
    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.