function [u,Du,eqn,info] = Poisson3T1(node,elem,pde,bdFlag, option)
%% POISSON3T1 Poisson equation: trilinear element.
%
%   u = Poisson3T1(node,elem,pde,bdFlag) produces the trilinear finite element
%   approximation of the Poisson equation
%
%       -div(d*grad(u))=f  in \Omega, with
%       Dirichlet boundary condition u=g_D on \Gamma_D,
%       Neumann boundary condition   d*grad(u)*n=g_N on \Gamma_N,
%       Robin boundary condition     g_R*u + d*grad(u)*n=g_N on \Gamma _R
%
% Author: Huayi Wei < huayiwei1984@gmail.com>.
%
% See also: PoissonQ1
%
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

if ~exist('option','var'), option = []; end
[N,Dim] = size(node);
[NT,NV] = size(elem);
Ndof = N;

tic;

%% Stiffness matrix and mass matrix in each direction
hx = node(elem(:,2),1) - node(elem(:,1),1);
hy = node(elem(:,4),2) - node(elem(:,1),2);
hz = node(elem(:,5),3) - node(elem(:,1),3);
volume = abs(hx.*hy.*hz);
Ax = 1./hx*[1 -1];
Mx = hx*[1/3 1/6];
Ay = 1./hy*[1 -1];
My = hy*[1/3 1/6];
Az = 1./hz*[1 -1];
Mz = hz*[1/3 1/6];

%% Assemble stiffness matrix
% generate sparse pattern
ii = zeros(36*NT,1); jj = zeros(36*NT,1);
index = 0;
for i = 1:NV
    for j = i:NV
        ii(index+1:index+NT) = double(elem(:,i));
        jj(index+1:index+NT) = double(elem(:,j));
        index = index + NT;
    end
end
% index map
itoixiyiz = [[1 2 2 1 1 2 2 1]' [1 1 2 2 1 1 2 2]' [1 1 1 1 2 2 2 2]'];

if ~isfield(pde,'d'), pde.d = []; end
sA = zeros(36*NT,1);
index = 0;
for i = 1:NV
    for j = i:NV
        ix = itoixiyiz(i,1); jx = itoixiyiz(j,1);
        iy = itoixiyiz(i,2); jy = itoixiyiz(j,2);
        iz = itoixiyiz(i,3); jz = itoixiyiz(j,3);
        Aij = Ax(:,2-(ix==jx)).*My(:,2-(iy==jy)).*Mz(:,2-(iz==jz)) ...
            + Mx(:,2-(ix==jx)).*Ay(:,2-(iy==jy)).*Mz(:,2-(iz==jz)) ...
            + Mx(:,2-(ix==jx)).*My(:,2-(iy==jy)).*Az(:,2-(iz==jz));
        if ~isempty(pde.d) && isnumeric(pde.d) % d is piecewise constant
            Aij = pde.d.*Aij;
        end
        sA(index+1:index+NT) = Aij;
        index = index + NT;
    end
end
% assemble the matrix
diagIdx = (ii == jj);   upperIdx = ~diagIdx;
A = sparse(ii(diagIdx),jj(diagIdx),sA(diagIdx),Ndof,Ndof);
AU = sparse(ii(upperIdx),jj(upperIdx),sA(upperIdx),Ndof,Ndof);
A = A + AU + AU';
clear Aij ii jj sA

%% Assemble the right hand side
b = zeros(N,1);
if ~isfield(option,'fquadorder')
    option.fquadorder = 3;   % default order
end
if ~isfield(pde,'f') || (isreal(pde.f) && (pde.f==0))
    pde.f = [];
end

if ~isempty(pde.f)
    [GaussPt, weight] = quadptscube(option.fquadorder);
    lambdax = GaussPt(:,1);
    lambday = GaussPt(:,2);
    lambdaz = GaussPt(:,3);
    nQuad = size(GaussPt,1);
    bt = zeros(NT,NV);
    for p = 1:nQuad
		% quadrature points in the x-y-z coordinate
        phi2d = kron([lambday(p) 1-lambday(p)],[lambdax(p); 1-lambdax(p)]);
        phi = transpose(kron([lambdaz(p) 1-lambdaz(p)],phi2d([1 2 4 3])));
        J = volume;
%         [phi, tempvar, J] = hexbasis(node,elem, pts(p,:));
        pxyz = zeros(NT, Dim);
        for k = 1:Dim
            xk = node(:,k);
            pxyz(:,k) = xk(elem)*phi(:);
        end
		fp = pde.f(pxyz);
        bt = bt + (weight(p)*fp.*J)*phi';
    end
    b = accumarray(elem(:),bt(:),[Ndof 1]);
end
clear pxyz bt

%% Set up boundary conditions
if ~exist('bdFlag','var'), bdFlag = []; end
[AD,b,u,freeNode,isPureNeumann] = getbd3(b);

%% Record assembling time
assembleTime = toc;
if ~isfield(option,'printlevel'), option.printlevel = 1; end
if option.printlevel >= 2
    fprintf('Time to assemble matrix equation %4.2g s\n',assembleTime);
end

%% Solve the system of linear equations
if isempty(freeNode), return; end
% Set up solver type
if isempty(option) || ~isfield(option,'solver')    % no option.solver
    if Ndof <= 2e3  % Direct solver for small size systems
        option.solver = 'direct';
    else            % MGCG  solver for large size systems
        option.solver = 'mg';
    end
end
solver = option.solver;
% solve
switch solver
    case 'direct'
        tic;
        u(freeNode) = AD(freeNode,freeNode)\b(freeNode);
        residual = norm(b - AD*u);
        info = struct('solverTime',toc,'itStep',0,'err',residual,'flag',2,'stopErr',residual);
    case 'none'
        info = struct('solverTime',[],'itStep',0,'err',[],'flag',3,'stopErr',[]);
    case 'mg'
%         option.x0 = u;
        option.solver = 'CG';
%         [u,info] = mg(AD,b,elem,option);
        [u(freeNode),info] = amg(AD(freeNode,freeNode),b(freeNode),option);
    case 'amg'
        option.solver = 'CG';
        [u(freeNode),info] = amg(AD(freeNode,freeNode),b(freeNode),option);
end
% post-process for pure Neumann problem
if isPureNeumann
    patchArea = accumarray(elem(:),[J;J;J;J;J;J;J;J]/8, [N 1]); % TODO: Here is J?
    uc = sum(u.*patchArea)/sum(J);
    u = u - uc;   % int u = 0
end

%% Output information
eqn = struct('A',AD,'b',b,'freeNode',freeNode);
info.assembleTime = assembleTime;

%% Compute Du
Du = [];

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% subfunctions getbd3
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    function [AD,b,u,freeNode,isPureNeumann] = getbd3(b)
    %% Set up of boundary conditions.
    %
    % 1) Modify the matrix for Dirichlet boundary nodes, which are not degree
    % of freedom. Values at these nodes are evaluatation of pde.g_D. The
    % original stiffness matrix A is turn into the matrix AD by enforcing
    % AD(fixedNode,fixedNode)=I, AD(fixedNode,freeNode)=0, AD(freeNode,fixedNode)=0.
    %
    % 2) Modify the right hand side b. The Neumann boundary integral is added
    % to b. For Dirichlet boundary ndoes, b(fixedNode) is the evaluation of
    % pde.g_D.
    %
    % Special attentation should be given for the pure Neumann boundary
    % condition. To enforce the compatible condition, the vector b should have
    % mean value zero. To avoid a singular matrix, the 1st node is chosen as
    % fixedNode.
    %
    % The order of assigning Neumann and Dirichlet boundary condition is
    % important to get the right setting at the intersection nodes of Dirichlet
    % and Neumann boundary edges.
    %
    % Reference: Long Chen. Finite Element Methods and its Programming. Lecture
    % Notes.

    u = zeros(Ndof,1);
    %% Initial check
    if ~isfield(pde,'g_D'), pde.g_D = []; end
    if ~isfield(pde,'g_N'), pde.g_N = []; end
    if ~isfield(pde,'g_R'), pde.g_R = []; end

    %% Part 1: Modify the matrix for Dirichlet and Robin condition
    % Robin boundary condition
    Robin = [];
    isRobin = (bdFlag(:) == 3);
    if any(isRobin)
        allFace = [elem(:,[1 4 3 2]); elem(:,[1 2 6 5]); elem(:,[5 6 7 8]);...
                   elem(:,[8 7 3 4]); elem(:,[4 1 5 8]); elem(:,[2 3 7 6])];
        Robin = allFace(isRobin,:);
    end
    if ~isempty(Robin) && ~isempty(pde.g_R) && ~(isnumeric(pde.g_R) && (pde.g_R == 0))
        %% To do: this is for tet mesh. Modify for hex mesh later.
        v12 = node(Robin(:,2),:)-node(Robin(:,1),:);
        v13 = node(Robin(:,3),:)-node(Robin(:,1),:);
        area = 0.5*sqrt(abs(sum(mycross(v12,v13,2).^2,2)));
        if ~isfield(option,'gRquadorder')
            option.gRquadorder = 3;   % default order exact for linear gR
        end
        [lambdagR,weightgR] = quadpts(option.gRquadorder);
        nQuadgR = size(lambdagR,1);
        bdphi = lambdagR;
        NR = size(Robin,1);
        ss = zeros(NR,3,3);
        % int g_R phi_i phi_j
        for pp = 1:nQuadgR
            ppxyz = lambdagR(pp,1)*node(Robin(:,1),:) ...
                  + lambdagR(pp,2)*node(Robin(:,2),:) ...
                  + lambdagR(pp,3)*node(Robin(:,3),:);
            gRp = pde.g_R(ppxyz);
            for iR = 1:3
                for jR = iR:3
                    ss(:,iR,jR) = ss(:,iR,jR) + ...
                    weightgR(pp)*gRp*bdphi(pp,iR).*bdphi(pp,jR);
                end
            end
        end
        ss(:) = ss(:).*repmat(area,9,1);
        index = 0;
        for iR = 1:3
            for jR = 1:3
                iiR(index+1:index+NR) = double(Robin(:,iR));
                jjR(index+1:index+NR) = double(Robin(:,jR));
                if jR>=iR
                    ssR(index+1:index+NR) = ss(:,iR,jR);
                else
                    ssR(index+1:index+NR) = ss(:,jR,iR);
                end
                index = index + NR;
            end
        end
        A = A + sparse(iiR,jjR,ssR,Ndof,Ndof);
    end

    % Find Dirichlet boundary nodes: fixedNode
    fixedNode = []; freeNode = [];
    if ~isempty(bdFlag) % bdFlag specifies different bd conditions
        [fixedNode,bdFace,isBdNode] = findboundary3(elem,bdFlag);
        freeNode = find(~isBdNode);
    end
    if isempty(bdFlag) && ~isempty(pde.g_D) && isempty(pde.g_N) && isempty(pde.g_R)
        % no bdFlag, only pde.g_D is given
        [fixedNode,bdFace,isBdNode] = findboundary3(elem);
        freeNode = find(~isBdNode);
    end
    isPureNeumann = false;
    if isempty(fixedNode) && isempty(Robin) % pure Neumann boundary condition
        % pde.g_N could be empty which is homogenous Neumann boundary condition
        isPureNeumann = true;
        fixedNode = 1;
        freeNode = 2:Ndof;    % eliminate the kernel by enforcing u(1) = 0;
    end
    % Modify the matrix
    % Build Dirichlet boundary condition into the matrix AD by enforcing
    % AD(fixedNode,fixedNode)=I, AD(fixedNode,freeNode)=0, AD(freeNode,fixedNode)=0.
    bdidx = zeros(Ndof,1);
    bdidx(fixedNode) = 1;
    Tbd = spdiags(bdidx,0,Ndof,Ndof);
    T = spdiags(1-bdidx,0,Ndof,Ndof);
    AD = T*A*T + Tbd;

    %% Part 2: Find boundary faces and modify the load b
    % Find boundary faces: Neumann
    Neumann = [];
    if ~isempty(bdFlag)  % bdFlag specifies different bd conditions
        Neumann = bdFace;
    end
    if isempty(bdFlag) && (~isempty(pde.g_N) || ~isempty(pde.g_R))
        % no bdFlag, only pde.g_N or pde.g_R is given in the input
        [tempvar,Neumann] = findboundary3(elem); %#ok<ASGLU>
    end

    % Neumann boundary condition
    if ~isempty(Neumann) && ~isempty(pde.g_N) && ~(isnumeric(pde.g_N) && (pde.g_N == 0))
        v12 = node(Neumann(:,2),:)-node(Neumann(:,1),:);
        v14 = node(Neumann(:,4),:)-node(Neumann(:,1),:);
        area = sqrt(abs(sum(mycross(v12,v14,2).^2,2)));
        % three middle points rule
        if ~isfield(option,'gNquadorder')
            option.gNquadorder = 3;   % default order exact for linear gN
        end
        [GaussPt,weightgN] = quadptsquad(option.gNquadorder);
        xxi = GaussPt(:,1);
        eta = GaussPt(:,2);
        nQuadgN = size(GaussPt,1);
        % barycentrical coordinate for four basis
        lambdagN = zeros(nQuadgN,4);
        lambdagN(:,1) = (1 - xxi).*(1 - eta);
        lambdagN(:,2) = xxi.*(1 - eta);
        lambdagN(:,3) = xxi.*eta;
        lambdagN(:,4) = (1 - xxi).*eta;
        ge = zeros(size(Neumann,1),4);
        for pp = 1:nQuadgN
            % quadrature points in the x-y coordinate
            ppxyz = node(Neumann(:,1),:)*lambdagN(pp,1) + node(Neumann(:,2),:)*lambdagN(pp,2)...
                  + node(Neumann(:,3),:)*lambdagN(pp,3) + node(Neumann(:,4),:)*lambdagN(pp,4);
            gNp = pde.g_N(ppxyz);
            for iN = 1:4
                ge(:,iN) = ge(:,iN) + weightgN(pp)*lambdagN(pp,iN)*gNp;
            end
        end
        ge = ge.*repmat(area,1,4);
        b = b + accumarray(Neumann(:),ge(:),[Ndof,1]);
    end
    % The case with non-empty Neumann edges but g_N=0 or g_N=[] corresponds to
    % the zero flux boundary condition on Neumann edges and no modification of
    % A,u,b is needed.

    % Dirichlet boundary condition
    if ~isPureNeumann && ~isempty(fixedNode) && ...
       ~isempty(pde.g_D) && ~(isnumeric(pde.g_D) && all(pde.g_D == 0))    % nonzero g_D
        if isnumeric(pde.g_D)
            u(fixedNode) = pde.g_D(fixedNode);
        else
            u(fixedNode) = pde.g_D(node(fixedNode,:));
        end
        b = b - A*u;
    end
    if ~isPureNeumann % non-empty Dirichlet boundary condition
        b(fixedNode) = u(fixedNode);
    end
    % The case with non-empty Dirichlet nodes but g_D=0 or g_D=[] corresponds
    % to the zero Dirichlet boundary condition and no modification of u,b is
    % needed.

    % Pure Neumann boundary condition
    if isPureNeumann
        b = b - mean(b);   % compatilbe condition: sum(b) = 0
        b(1) = 0;
    end
    end % end of getbd3
end % end of Poisson3Q1


function [C,S]=fitSpherHarmonics(M,points,vals,a,c)
%%FITSPHERHARMONICS Given a number of field values at a diversity
%               of points in spherical coordinates (either range, azimuth
%               and elevation, or just azimuth and elevation), fit fully
%               normalized spherical harmonic coefficients up to a
%               particular degree to the data. The data being fitted can be
%               real or complex. One can fit multiple sets of data at once
%               as long as they share the same set of points.
%
%INPUTS: M The maximum degree of the coefficients to use.
%   points The 2XN or 3XN set of points in spherical coordinates in the
%          form [r;azimuth;elevation] or just [azimuth;elevation]. 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). Angles must be given in radians. Note the system to be
%          observable, N>=(M+1)^2.
%     vals The NXnumSets sets of real or complex values at the given
%          points.
%        a The real or complex numerator in the (a/r)^n term in the
%          spherical harmonic sum. If this parameter is omitted or an empty
%          matrix is passed, then a=1 is used.
%        c The real or complex constant value by which the spherical
%          harmonic series is multiplied. If this parameter is omitted or
%          an empty matrix is passed, then c=1 is used.
%
%OUTPUTS: C A numCoeffsXnumSets collections of arrays, one for each set of
%           values passed, holding the coefficient terms that are
%           multiplied by cosines in the spherical harmonic expansion. If
%           given to a CountingClusterSet class, C(n+1,m+1) is the
%           coefficient of degree n and order m. This and S can be given to
%           the function spherHarmonicEval.
%         S A numCoeffsXnumSets collection of arrays, one for each set of
%           values passed, holding the coefficient terms that are
%           multiplied by sines in the spherical harmonic expansion. S has
%           the same structure as C.
%
%The spherical harmonic series being fit is assumed to be of the form
%V=(c/r)*sum_{n=0}^M\sum_{m=0}^n(a/r)^n*(C(n+1,m+1)*cos(m*lambda)+S(n+1,m+1)*sin(m*lambda))*\bar{P}_{nm}(sin(theta))
%where \bar{P}_{nm} is a fully-normalized associated Legendre polynomial.
%This function uses the LegendreCos function to evaluate the Legendre
%polynomials and it them constructs a linear system to solve for the values
%of C and S. Unobservable values of S are where m=0, so S(n+1,0+1)=0 and
%those components are not part of the estimation problem.
%
%Real spherical harmonic models are often used for gravitational, magnetic
%field and some terrain modeling, as discussed in part of [1], whereas
%complex spherical harmonic models are often used for electromagnetic
%modeling.
%
%The complex spherical harmonic model that is usually used in
%electromagnetics is
%V=(c/r)*sum_{n=0}^M\sum_{m=-n}^n(a/r)^n*A(n+1,m+1)*\bar{P}_{nm}(sin(theta))*exp(1j*m*lambda)
%Initially, it just looks like one has combined the S and C values into one
%complex coefficient A and then multiplied the sin term by 1j. However, if
%that were all that had been done, one wouldn't be able to match many
%models, because if A(n+1,m+1)=AR+1j*AI, expanding the term
%A(n+1,m+1)*exp(1j*m*lambda), one gets
%aR*cos(m*lambda)-aI*sin(m*lambda)+1j*(aI*cos(m*lambda)+aR*sin(m*lambda))
%Where one can see that it is not possible to independently set the real
%and the imaginary terms. However, note that the formulation of the inner
%sum used for complex values starts at -m and not at 0. This extension of
%the sum allows one to uniquely form real and complex terms. Though such a
%symmetry does not occur at m=0, that does not actually matter, since the
%sine terms are zero, so one can still independently set the real and the
%imaginary coefficients parts. Indeed, it can be shown that the resulting
%expression allows one to fit the real and complex parts independently if a
%and c are real.
%
%EXAMPLE:
%We take the coefficients for the World Magnetic Model, evaluate the
%magnetic field values at a number of points around the globe, use this
%function to reconstruct the spherical harmonic coefficients from the field
%values and compare the computed coefficients with the coefficients used to
%generate the field values.
% [C,S,a,c]=getWMMCoeffs();
% M=(1/2)*(sqrt(1+8*length(C))-1);
%
% %Evaluate the model on a grid.
% numPoints=21;
% totalGridPoints=numPoints*numPoints;
% deltaLat=180/numPoints;
% lat=-90+(0:(numPoints-1))*deltaLat;
% lat=lat*(pi/180);%Convert latitude to radians.
%
% deltaLon=360/numPoints;
% lon=-180+(0:(numPoints-1))*deltaLon;
% lon=lon*(pi/180);%Convert longitude to radians.
% [latGrid,lonGrid]=ndgrid(lat,lon);
% latLonEllipse=[latGrid(:)';lonGrid(:)'];
% %Convert from ellipsoidal latitudes to spherical latitudes (This assumes
% %that the points are on the surface of the reference ellipsoid).
% points=ellips2Sphere([latLonEllipse;zeros(1,totalGridPoints)]);
%
% %Evaluate the magnetic field values at the given points.
% V=spherHarmonicEval(C,S,points,a,c);
%
% %Reconstruct the coefficients from the magnetic field values.
% [CFit,SFit]=fitSpherHarmonics(M,points,V,a,c);
%
% %Check how good the fit is to the original set of coefficients.
% sel1=C(:)~=0;
% max(abs(CFit(sel1)-C(sel1))./C(sel1))
% sel1=S(:)~=0;
% max(abs(SFit(sel1)-S(sel1))./S(sel1))
%In both instances, the maximum relative error should have been less than
%8e-10. The fact that there is any error stems from finite precision
%effects.
%
%REFERENCES:
%[1] D. F. Crouse, "An overview of major terrestrial, celestial, and
%    temporal coordinate systems for target tracking," Naval Research
%    Laboratory, Washington, DC, Tech. Rep. NRL/FR/5344-16-10,279, 10 Aug.
%    2016.
%
%June 2017 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

if(nargin<5||isempty(c))
    c=1;
end

if(nargin<4||isempty(a))
    a=1;
end

pointDims=size(points,1);

numEq=size(points,2);

%The total number of associated Legendre polynomials.
numPBar=(M+1)*(M+2)/2;

%The M+1 being subtracted is the number of S_{n,0} values,
%because these can just be set to zero as they are never used; they are
%always multiplied by sin(0).
numCCoeffs=numPBar;
numSCoeffs=numPBar-(M+1);

%The total number of coefficients if all values for C and S must be
%computed.
coeffsTotal=numCCoeffs+numSCoeffs;

if(coeffsTotal>numEq)
   warning('The value of M is too large for the number of values provided. The exact solution is unobservable.')
end

%The columns of Y corresponds to the C coefficients followed by the S
%coefficients.
Y=zeros(numEq,coeffsTotal);
for curEq=1:numEq
    curPoint=points(:,curEq);

    if(pointDims==3)
        r=curPoint(1);
        Az=curPoint(2);
        coLat=pi/2-curPoint(3);
    else
        r=1;
        Az=curPoint(1);
        coLat=pi/2-curPoint(2);
    end
    %We now have r, azimuth, and colatitude.

    %Get all of the associated Legendre polynomials.
    PBarVals=LegendreCos(coLat,M);
    PBarVector=PBarVals(:);

    outerCoeff=c/r;
    innerCoeff=1;
    for n=0:M
        for m=0:n
            %The index of PBarVals(n+1,m+1) in the vector PBarVector.
            idx=n*(n+1)/2+m+1;

            coeffVal=outerCoeff*innerCoeff*PBarVector(idx);

            Y(curEq,idx)=coeffVal*cos(m*Az);
            if(m>0)
                %The -(n+1) deals with the fact that there are no values of
                %S for m=0.
                Y(curEq,numCCoeffs+idx-(n+1))=coeffVal*sin(m*Az);
            end
        end
        innerCoeff=innerCoeff*(a/r);
    end
end

%If one were to use linsolve(Y,vals(:)), many systems would complain about
%Y having poor conditioning.
coeffs=lsqminnorm(Y,vals);

C=coeffs(1:numPBar,:);

%Fill in S, noting that the unused parts are left set to zero.
numSets=size(vals,2);
SData=zeros(numPBar,numSets);
curSIdx=numCCoeffs+1;
for n=1:M
    for m=1:n
        idx=n*(n+1)/2+m+1;
        SData(idx,:)=coeffs(curSIdx,:);
        curSIdx=curSIdx+1;
    end
end
S=SData;

end

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


function zCD=spherITRS2SpherCD(zSpher,param1,param2,S11)
%%SPHERITRS2SPHERCD Convert points given in spherical coordinates in the
%              International Terrestrial Reference System (ITRS), a
%              standard Earth-Cenetred-Earth-fixed (ECEF) coordinate
%              system, into centered dipole (CD) coordinates expressed in
%              spherical form, the form most commonly used in papers. CD
%              coordinates is a type of coordinate system where the z-axis
%              is aligned with the magnetic dipole of the Earth (under a
%              dipole model). This coordinate system is useful when
%              studying the ionosphere.
%
%INPUTS: zSpher One or more points given in terms of range, azimuth
%               (geocentric longitude) and elevation (geocentric latitude),
%               with the angles in radians, or in terms of just azimuth
%               and elevation if a conversion of directions is desired in
%               the ITRS. To convert N points, zSpher is a 3XN matrix with
%               each column having the format [range;azimuth; elevation] or
%               it is a 2XN matrix with each column having format [azimuth;
%               elevation]. 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).
%param1,param2,S11 These optional parameters specify the magnetic field
%               parameters from which the direction of the CD pole is
%               derived. These aprameters are impied set base don how the
%               function is called:
%               1) spherITRS2SpherCD(zSpher)
%                  If all of the other parameters are omitted, then the CD
%                  pole parameters for the latest epoch of the
%                  International Geomagnetic Reference Field (IGRF) are
%                  used; the Schmidt semi-normalized coefficients are
%                  obtained using the function getIGRFCoeffs.
%               2) spherITRS2SpherCD(zSpher, year)
%                  The parameters of the IGRF for the specified epoch year
%                  are used. The year is in the Gregorian calendar and is
%                  specified as noted in the comments to the getIGRFCoeffs
%                  function.
%               3) spherITRS2SpherCD(zSpher, year, model). This is the same
%                  as spher2CenteredDipole(zSpher, year), except model can
%                  be 'IGRF' or 'WMM' to specify which magnetic field model
%                  to use. 'WMM' refers to the World magnetic model using
%                  the function getWMMCoeffs. Note than an empty year
%                  matrix can be passed to get the latest epoch year of
%                  either model.
%               4) spherITRS2SpherCD(zSpher,C10,C11,S11). In this instance,
%                  the first few Schmidt semi-normalized coefficients for a
%                  magnetic field model are given. These are the only three
%                  coefficients used to define the orientation of the CD
%                  pole. If using the getWMMCoeffs or getIGRFCoeffs
%                  function to get the coordinates, then from the outputs
%                  of those functions (specifying in the second input that
%                  they should not be fully normalized), the outputs C and
%                  S of the functions are used here as
%                  C10=C(1+1,0+1), C11=C(1+1,1+1), S11=C(1+1,1+1).
%
%OUTPUTS: zCD The points in zSpher converted into centered dipole
%             coordinates under the selected model. If zSpher is 3XN, then
%             zCD consists of range as well as azimuth and elevation. If
%             zSpher was 2XN, then zCD just consists of azimuth and
%             elevation. All angles are in radians.
%
%The definition of centered dipole (CD) coordinates is taken from [1].
%However, as opposed to using the spherical trignonometric equations in the
%paper, the rotation is performed in Cartesian coordinates so as to avoid
%singularities.
%
%REFERENCES:
%[1] A. C. Fraser-Smith, "Centered and eccentric geomagnetic dipoles and
%    their poles 1600-1985," Reviews of Geophysics, vol. 25, no. 1, pp.
%    1-16, Feb. 1987.
%
%June 2015 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

numDim=size(zSpher,1);

%%Determine the centered dipole location from a magnetic field model.
if(nargin==1||nargin==2||nargin==3)
    if(nargin==1||isempty(param1))
    %If only position components were given, then just use the values for
    %the reference epoch of the IGRF. The unnormalized coefficients are
    %desired.
        [C,S]=getIGRFCoeffs([],false);
    elseif(nargin==2)
    %If a reference year is given, then use that in the IGRF.
        [C,S]=getIGRFCoeffs(param1,false);
    elseif(nargin==3)%If one wishes to select the magnetic field model.
        switch(param2)
            case 'IGRF'
                if(isempty(param1))
                    [C,S]=getIGRFCoeffs([],false);
                else%If the year is given
                    [C,S]=getIGRFCoeffs(param1,false);
                end
            case 'WMM'
                if(isempty(param1))
                    [C,S]=getWMMCoeffs([],false);
                else%If the year is given
                    [C,S]=getWMMCoeffs(param1,false);
                end
            otherwise
                error('Unknown magnetic field model selected')
        end
    end

    g10=C(2);
    g11=C(3);
    h11=S(3);
elseif(nargin==4)
    %If the required coefficients are directly provided.
    g10=param1;
    g11=param2;
    h11=S11;
end

%Perform the rotation in Cartesian coordinates (avoiding the singularities
%of Equation 3 of [1])
xRot=ITRS2CartCD(spher2Cart(zSpher),g10,g11,h11);

%Convert the points back to spherical coordinates to return.
zCD=Cart2Sphere(xRot);

if(numDim<3)
%If range was not provided, discard the unit ranges that arose using the
%spher2Cart conversion.
    zCD=zCD(2:3,:);
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.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% this function solves the eigenvalue problem omega=f(epsi,kx,ky) for
%%% in-plane propagation (i.e. z=0) in a 2D-PhC; the problem can be
%%% separated in two orthogonal polarizations, E-pol & H-pol
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function [omegaE, omegaH]=eigsEH(kGx,kGy,epsi,N,bands)
eta=inv(epsi);
A=inv(eta*(kGx^2+kGy^2)); %%% matrix for E-pol
B=inv(kGx*eta*kGx+kGy*eta*kGy); %%% matrix for H-pol
%%% options used in "eigs" calculations - tolerance 1e-12, intermediate results of iterations will
%%% not be displayed
opts.tol=1e-12; opts.disp=0;
%%% calculate the largest eigs, which become the smallest after inversion
De=eigs(A,bands,'lr',opts);
Dh=eigs(B,bands,'lr',opts);
%%% eigenvalues "omega" are put in a column vector and sorted in ascending order
omegaE=sqrt(sort(1./De));
omegaH=sqrt(sort(1./Dh));


% ONE DIMENSIONAL EFG PROGRAM
% SET UP NODAL COORDINATES ALONG BAR, DETERMINE NUMBER OF CELLS
x = [0.0:.1:1.0];
nnodes = length(x);
ncells = nnodes-1;
nosDeDirichlet = 1;

% SET PARAMETERS FOR WEIGHT FUNCTION, MATERIAL PROPERITES
dmax = 2.0;
E=1.0; area=1.0;

% DETERMINE DMI FOR EACH NODE
dm = dmax*(x(2)-x(1))*ones(1,nnodes);

%SET UP GAUSS POINTS, WEIGHTS, AND JACOBIAN FOR EACH CELL
gg = zeros(1,ncells);
jac = (x(2)-x(1))/2;
weight = 2;
gg = -.05:.1:0.95; gg(1) = 0.0;

% INITIALIZE MATRICES
k = zeros(nnodes);
f = zeros(nnodes,1);
GG = zeros(nnodes,nosDeDirichlet);

% LOOP OVER GAUSS POINTS
for j = 1:length(gg)
   xg = gg(j);

% DETERMINE DISTANCE BETWEEN NODES AND GAUSS POINT
dif = xg*ones(1,nnodes)-x;

% SET UP WEIGHTS W AND DW FOR EACH NODE
clear w dw
for i=1:nnodes
drdx = sign(dif(i))/dm(i);
r = abs(dif(i))/dm(i);
if r<=0.5
  w(i) = (2/3) - 4*r*r + 4*r^3;
  dw(i) = (-8*r + 12*r^2)*drdx;
elseif r<=1.0
  w(i) = (4/3)-4*r+4*r*r -(4/3)*r^3;
  dw(i) = (-4 + 8*r-4*r^2)*drdx;
elseif r>1.0
w(i) = 0.0;
dw(i) = 0.0;
end
end

%SET UP SHAPE FUNCTIONS AND DERIVATIVES
won = ones(1,nnodes);
p = [won;x];
B = p.*[w;w];
pp = zeros(2);
A = zeros(2);
dA = zeros(2);
for i=1:nnodes
   pp = p(1:2,i)*p(1:2,i)';
   A = A+w(1,i)*pp;
   dA = dA+dw(1,i)*pp;
end
Ainv = inv(A);
pg = [1 xg];
phi(j,:) = pg*Ainv*B;
db = p.*[dw;dw];
da = -Ainv*(dA*Ainv);
dphi(j,:) = [0 1]*Ainv*B+pg*(da*B+Ainv*db);

%ASSEMBLE DISCRETE EQUATIONS
if j == 1
   GG(1:3,1) = -phi(1:3)';
end
%else
    k = k+(weight*E*area*jac)*(dphi(j,:)'*dphi(j,:));
    fbody = area*xg;
    f = f+(weight*fbody*jac)*phi(j,:)';
%end
end

% ENFORCE BOUNDARY CONDITIONS USING LAGRANGE MULTIPLIERS
q = [0];
m = [k GG;GG' zeros(1)];

% SOLVE FOR NODAL PARAMETERS
d = m\[f' q]';
u = d(1:nnodes);

result = phi*u;
for i=1:length(x)
    exact(i) =  0.5*(x(i)) - x(i)^3/6.0;
end
%%
plot(x,u);
title('valores u');
figure();
plot(x,result);
title('valores u*phi');
figure();
plot(x,exact);
title('valores exatos');


function [DI, k] = detectChange(obj, t1, t2)
% A naive implementation of the Multivariate Alteration Detection Algorithm
% Partially refer to http://people.compute.dtu.dk/alan/software.html
% and https://github.com/mortcanty/earthengine
[rows, cols, chns1] = size(t1);
chns2 = size(t2, 3);
chns = min(chns1, chns2);
x1 = reshape(double(t1), cols*rows, chns1);
x1 = x1 - mean(x1, 1);  % Subtract mean
x2 = reshape(double(t2), cols*rows, chns2);
x2 = x2 - mean(x2, 1);
sigma = cov([x1 x2]);
sigma11 = sigma(1:chns1, 1:chns1);
sigma12 = sigma(1:chns1, chns1+1:end);
sigma21 = sigma(chns1+1:end, 1:chns1);
sigma22 = sigma(chns1+1:end, chns1+1:end);

[a, e1] = eig(sigma12 / sigma22 * sigma21, sigma11);
e1 = sqrt(diag(e1));
[b, e2] = eig(sigma21 / sigma11 * sigma12, sigma22);
e2 = sqrt(diag(e2));
[~, idx1] = sort(e1, 'descend');
a = a(:,idx1);
a = a(:,chns:-1:1); % My choice is simply to drop the part of (q-p)
[~, idx2] = sort(e2, 'descend');
b = b(:,idx2);
b = b(:,chns:-1:1);

% Normalize a for unit dispersion
% Ensure that a'*s11*a=I to meet the constraints
vars1 = (a'*sigma11*a);
a = a ./ sqrt(diag(vars1))';
% Similiar operations on b
vars2 = (b'*sigma22*b);
b = b ./ sqrt(diag(vars2))';

% Ensure sum of positive correlations between x1 and x1*a is positive
% I have no idea what this is used for???
invStd1 = diag(1./std(x1));
sgn = diag(sign(sum(invStd1*sigma11*a)));
a = a*sgn;

% Assure positive correlation between pair of canonical variates
b = b .* diag(sign(a'*sigma12*b))';

mad = x1*a - x2*b;

% Normalize mad
% This is no regular operation, yet appears to improve the result
mad = (mad - mean(mad)) ./ (std(mad)+eps);

chi2 = sum(mad.^2, 2);
prob = chi2cdf(chi2, chns);
DI = reshape(abs(mad), rows, cols, chns);

% Select bands
k = min(chns, obj.nMADUsed);
DI = DI(:,:,1:k);
end


function can = mpot_to_cpot(mom)
% MPOT_TO_CPOT Convert a moment potential to canonical form.
% mom = mpot_to_cpot(can)

[g, h, K] = moment_to_canonical(mom.logp, mom.mu, mom.Sigma);
can = cpot(mom.domain, mom.sizes, g, h, K);

%%%%%%%%%%%

function [g, h, K] = moment_to_canonical(logp, mu, Sigma)
% MOMENT_TO_CANONICAL Convert moment characteristics to canonical form.
% [g, h, K] = moment_to_canonical(logp, mu, Sigma)

K = inv(Sigma);
h = K*mu;
n = length(K);
if isempty(mu)
  g = logp + 0.5*(log(det(K)) - n*log(2*pi));
else
  g = logp + 0.5*(log(det(K)) - n*log(2*pi) - mu'*K*mu);
end


% Author: Ricardo Baptista and Matthias Poloczek
% Date:   June 2018
%
% See LICENSE.md for copyright information
%

function ising_mom = ising_model_moments(Q)

n_vars = size(Q,1);

% Generate all binary vectors
bin_vals = dec2bin(0:2^n_vars-1)-'0';
bin_vals(bin_vals == 0) = -1;
n_vectors = size(bin_vals,1);

% Compute values of PDF
pdf_vals = zeros(n_vectors,1);
for i=1:n_vectors
	pdf_vals(i) = exp(bin_vals(i,:)*Q*bin_vals(i,:)');
end

% Compute normalizing constant
norm_const = sum(pdf_vals);

% Generate matrix to store moments
ising_mom = zeros(n_vars,n_vars);

% Compute second moment for each pair of values
for i=1:n_vars
	for j=1:n_vars
		bin_pair = bin_vals(:,i).*bin_vals(:,j);
		ising_mom(i,j) = sum(bin_pair.*pdf_vals)/norm_const;
	end
end


function [P1,P2]=mg_ellblock(nelx,nely,x,y)
%mg_ellblock   prolongation for part of L-shaped and step domains
%   [P1,P2] = mg_ellblock(nelx,nely,x,y);
%   input
%          nelx    number of elements in x-direction
%          nely    number of elements in y-direction
%          x       x coordinate vector for coarse grid
%          y       y coordinate vector for coarse grid
%   output
%          P1      component of prolongation operator for upper left of
%                  step [-1,h]x[0,1]
%          P2      component of prolngation operator for border between
%                  upper left of step and right part of step
%
%   IFISS function: AR; 19 November, 2001.
% Copyright (c) 2005 D.J. Silvester, H.C. Elman, A. Ramage
ecx=nelx/2; ecy=nely/2;
tx = x(2:nelx+1) - x(1:nelx);
bx = zeros(nelx,1);
bx(1:2:nelx-1) = x(3:2:nelx+1) - x(1:2:nelx-1);
bx(2:2:nelx)   = bx(1:2:nelx-1);
dx = tx./bx;
%
ty = y(2:nely+1) - y(1:nely);
by = zeros(nely,1);
by(1:2:nely-1) = y(3:2:nely+1) - y(1:2:nely-1);
by(2:2:nely)   = by(1:2:nely-1);
dy = ty./by;
%
p = spalloc(2*ecx+1,ecx+1,3*ecx+1);
for j=2:ecx
   p(2*j-2,j) = dx(2*j-3);
   p(2*j-1,j) = 1.0;
   p(2*j  ,j) = dx(2*j);
end
j=1;
   p(2*j-1,1) = 1.0;
   p(2*j  ,1) = dx(2*j);
j=ecx+1;
   p(2*j-2,j) = dx(2*j-3);
   p(2*j-1,j) = 1.0;
%
% main block (last row/column omitted)
P1=spalloc( (2*ecy+1)*(2*ecx), (ecy+1)*(ecx), (3*ecy+1)*(3*ecx+1) );
%
sp=p(1:end-1,1:end-1);
for j=2:ecy,
    cols = (j-1)*(ecx)+[1:ecx];
    P1((2*j-3)*(2*ecx)+[1:2*ecx],cols) = dy(2*j-3)*sp;
    P1((2*j-2)*(2*ecx)+[1:2*ecx],cols) = sp;
    P1((2*j-1)*(2*ecx)+[1:2*ecx],cols) = dy(2*j)*sp;
end
j=1;
    cols = (j-1)*(ecx)+[1:ecx];
    P1((2*j-2)*(2*ecx)+[1:2*ecx],cols) = sp;
    P1((2*j-1)*(2*ecx)+[1:2*ecx],cols) = dy(2*j)*sp;
j=ecy+1;
    cols = (j-1)*(ecx)+[1:ecx];
    P1((2*j-3)*(2*ecx)+[1:2*ecx],cols) = dy(2*j-3)*sp;
    P1((2*j-2)*(2*ecx)+[1:2*ecx],cols) = sp;
%
% coupling with large block
P2=spalloc((2*ecy+1)*(2*ecx),(ecy+1)*(ecx+1),(3*ecy+1)*(3*ecx+1) );
entry=p(2*ecx,ecx+1);
for j=2:ecy,
    cols = (j-1)*(ecx+1)+1;
    P2((2*j-3)*(2*ecx)+[2*ecx],cols) = dy(2*j-3)*entry;
    P2((2*j-2)*(2*ecx)+[2*ecx],cols) = entry;
    P2((2*j-1)*(2*ecx)+[2*ecx],cols) = dy(2*j)*entry;
end
j=1;
    cols = (j-1)*(ecx+1)+1;
    P2((2*j-2)*(2*ecx)+[2*ecx],cols) = entry;
    P2((2*j-1)*(2*ecx)+[2*ecx],cols) = dy(2*j)*entry;
j=ecy+1;
    cols = (j-1)*(ecx+1)+1;
    P2((2*j-3)*(2*ecx)+[2*ecx],cols) = dy(2*j-3)*entry;
    P2((2*j-2)*(2*ecx)+[2*ecx],cols) = entry;
return


% This is a demonstration of Radon inversion from few angles using the Potts model.
% Tested on Mac OS 10.9, Matlab 2015a,
% If everything worked correctly a result as
% in results/plFigPottsRec7Angles.fig should appear
% Warning: This experiment can take more than one hour

% load Shepp-Logan
img = phantom(256);

% Radon transform with 7 equidistant projection angles
nAngles = 7;
theta = (1:nAngles)/nAngles * 180;
A = radonop(theta, size(img,1));
data = A * img;

% raw filtered backprojection and a regularized one
uFbp = iradon(data, theta, 'Linear', 'Ram-Lak', 1, size(img, 1));
uFbpReg = iradon(data, theta, 'Linear', 'Hamming', 0.3, size(img, 1));

% joint reconstruction and segmentation using the Potts model
gamma = 0.04;
uPotts = minL2iPotts2DADMM(data, gamma, A, 'verbose', 1, 'groundTruth', img, 'isotropic', 1 );

% show results
subplot(2,3,1)
imshow(img)
title('Original')
subplot(2,3,2)
imagesc(data)
title('Data (Sinogram)')
subplot(2,3,4)
imshow(uFbp)
title('FBP result')
subplot(2,3,5)
imshow(uFbpReg)
title('FBP with Hamming window')
subplot(2,3,6)
imshow(uPotts)
title('Potts result')


function gbasis=groebner(polyset,ord,varnames,tol)
% GROEBNER - calculate the reduced Groebner basis of a set of polynomials
%  usage: gbasis = groebner(polyset,ord)
%         gbasis = groebner(polyset,ord,varnames)
%         gbasis = groebner(polyset,ord,varnames,tol)
%
% INPUTS: polyset, ord, varnames, tol
%  polyset is a cell array of multivariate polynomial coefficients
%    the cell elements can be all strings or all arrays.
%    If the polynomials are specified with arrays, each row of the array
%    represents a single term.  The first element is the coefficient and
%    the others are the degrees of each unknown in the term.
%    e.g. [-1,2,1;1,0,1] represents -x1^2*x2+x2
%    If the polynomials are specified as strings, they must use variable
%    names 'x1','x2',... (unless varnames is provided) and be valid inputs
%    for str2poly.m
%  ord is a string specifying the monomial ordering:
%    'lex': lexicographical, order by highest power of most significant
%      indeterminate, e.g. x1>x2^2, x1*x2>x1.
%    'grlex': graded lex, order by total degree then lex,
%      e.g. x1^2*x2 > x1*x2^2 > x1^2
%    'grevlex': graded reverse lex, order by total degree then by lowest
%      power of least significant indeterminate, e.g. x1*x2^2 > x1*x2*x3
%    (for all cases have x1>x2>...>xn)
%    note: revlex is not a well-ordering because 1>x1>x1^2>...
%  varnames (optional) is a cell array of variable names if polyset is a
%    cell array of strings and the variable names are not 'x1', 'x2', etc.
%    If specified, there must always be at least 2 variables.
%  tol (optional) is the zero tolerance for coefficients, otherwise
%    catastrophic cancellation may occur.  Default value is 0
%
% OUTPUTS: gbasis
%  gbasis is the reduced Groebner basis of the set of polynomials, in the
%    same format (strings or matrices) as polyset{1}.
%
% ALGORITHM:
%  A modified Buchberger's algorithm is used.  In Buchberger's algorithm,
%  at each step calculate Sij = (Lij/ai)*Pi - (Lij/aj)*Pj, for all pairs of
%  polynomials Pi, Pj, where ai and aj are the leading terms of Pi and Pj,
%  and Lij is the least common multiple of ai and aj; then reduce Sij with
%  respect to the polynomials and add it to the set (note that Sij always
%  reduces to zero if ai and aj have no variables in common).  The
%  algorithm terminates when no new polynomials can be added to the set.
%  This function reduces the polynomials at each step in order to find the
%  reduced Groebner basis.
%
% EXAMPLE: simplify equations x^2+2xy^2=0, xy+2y^3=1
%  A1=[1,2,0;2,1,2]; % 1*x^2*y^0 + 2*x^1*y^2
%  A2=[-1,0,0;1,1,1;2,0,3]; % -1*x^0*y^0 + 1*x^1*y^1 + 2*x^0*y^3
%  y=groebner({A1,A2},'lex');
%  poly2str(y) % returns {'x2^3-0.5', 'x1'}
%
% EXAMPLE: same, but with equations specified as strings:
%  groebner({'x^2+2*x*y^2','x*y+2*y^3-1'},'lex',{'x','y'})
%  % returns {'y^3-0.5','x'}
%
% EXAMPLE: show that a set of equations is inconsistent
%  groebner({'x + y', 'x^2 - 1', 'y^2 - 2*x'}, 'lex', {'x', 'y'})
%  % returns {'1'}
%
%
% KNOWN ISSUES
%
%  0. GENERAL: while a significant effort has been made to ensure that the
%    program works as described, unidentified bugs may remain and the results
%    should be regarded with caution.  In particular, the suite of tests
%    performed was by no means comprehensive.
%
%  1. ACCURACY: the algorithm by default works in floating-point which
%    ultimately cannot perform exact arithmetic, so unexpected silent errors may
%    occur even when the coefficients are specified as integers.  A workaround
%    is to use other data types but this has its own issues (see below).
%
%  1a. EXAMPLE (roundoff - linearly independent polynomials)
%    eps % returns 2.2204e-16 (32-bit PC windows machine epsilon)
%    groebner({'x1+x2','x1+1.000000000000001*x2'},'lex') % ok, returns {'x2','x1'}
%    groebner({'x1+x2','x1+1.0000000000000001*x2'},'lex') % not ok, returns {'x2+x1'}
%
%  1b. EXAMPLE (roundoff - linearly dependent polynomials)
%    2/sqrt(2)-sqrt(2) % expect 0, returns -2.2204e-016
%    poly2str(groebner({[1,1,0;sqrt(2),0,1],[1/sqrt(2),1,0;1,0,1]},'lex')) % ok, returns {'1.41421*x2+x1'}
%    poly2str(groebner({[1,1,0;sqrt(2),0,1],[sqrt(2),1,0;2,0,1]},'lex')) % not ok, returns {'x2','x1'}
%    poly2str(groebner({[1,1,0;sqrt(2),0,1],[sqrt(2),1,0;2,0,1]},'lex',{},1e-14)) % ok, returns {'1.41421*x2+x1'}
%
%  1c. EXAMPLE (courtesy of Christophe Lauwerys - catastrophic cancellation & tolerance bug)
%    groebner({'t^3+x+y','t^2+0.5*x^2-x-z^2','t^2+y-z^2'},'lex',{'t','x','y','z'}) % ans{1} contains Inf
%
%  1d. EXAMPLE (from Mathematica documentation - catastrophic cancellation because of large intermediate coefficients)
%    % expect 3 polynomials returns, one of degree 8 in z; instead can get '1'
%    groebner({'x^2 + y^2 + z^2 - 1', 'x*y - z + 2', 'z^2 - 2*x + 3*y'}, 'lex', {'x', 'y','z'})
%
%  2. NON-DOUBLE INPUTS: use of non-double coefficients is not supported.  While
%    it may be tempting to introduce symbolic coefficients, it is not clear how
%    they should be consistently treated - for example 'A*x' could reduce to '0'
%    or 'x' or both, depending upon the assumptions on the coefficient A.
%
%  3. EFFICIENCY: The reduction algorithms aren't terribly efficient.  One of
%    the major bottlenecks at present is the calculation of the leading term,
%    which currently involves a call to sortrows each time.  It could be more
%    efficient to maintain an ordered list or even a priority queue (e.g.
%    implemented as a heap).  Also lattice reduction algorithms such as LLL
%    might speed things up.
%
%
% SEE ALSO:
%  poly2str, str2poly, polynsolve

% Author: Ben Petschel 19/6/2009
%
% Change history:
%  19/6/2009 - first release (ord='grlex' and ord='grevlex' not
%    implemented yet)
%  22/6/2009 - implemented ord='grlex' and ord='grevlex'
%    reduction algorithm now reduces lower-order terms as well
%  23/6/2009 - removed ord='revlex' because it is not a well-ordering
%  17/7/2009 - fixed bug in handling polynomials with >=3 variables
%  20/3/2010 - changed polynomial representation from multidimensional
%    arrays to 2d arrays (more memory efficient with large number of vars)
%  11/10/2010 - bugfix for handling error tolerance

if (numel(polyset)>0) && ischar(polyset{1}),
  charout = true;
  if nargin<3,
    polyset = str2poly(polyset);
  else
    polyset = str2poly(polyset,varnames);
  end;
else
  charout = false;
end;

if nargin<4,
  tol = 0;
end;

% determine the number of degrees
nd=max(cellfun(@(x)size(x,2)-1,polyset)); % error if = 0
if nd == 0
  error('number of variables must be >= 1');
end;

gbasis = fullreduce(polyset,ord,tol,nd);
oldgbasis = {};

while ~isequal(oldgbasis,gbasis),
  oldgbasis = gbasis;
  Qset = SPoly(gbasis,ord,tol,nd);
  gbasis = fullreduce([gbasis,Qset],ord,tol,nd);
end;

if charout,
  if nargin<3,
    gbasis = poly2str(gbasis);
  else
    gbasis = poly2str(gbasis,varnames);
  end;
end;

end % main function groebner(...)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Qset = SPoly(Pset,ord,tol,nd)
% calculates all reduced S-polynomials of Pset (Pset must be reduced)
%   Sij = (Lij/ai)*Pi - (Lij/aj)*Pj,
% for all pairs of polynomials Pi, Pj, where ai and aj are the leading
% terms of Pi and Pj, and Lij is the least common multiple of ai and aj
% then reduces Sij wrt Pset

Qset = {};
for i=1:numel(Pset)-1,
  for j=i+1:numel(Pset),
    [c1,d1] = leadterm(Pset{i},ord,tol,nd);
    [c2,d2] = leadterm(Pset{j},ord,tol,nd);
    if any(and(d1>0,d2>0)),
      % leading terms have a variable in common, so S-poly is nontrivial
      L = max(d1,d2); % LCM of leading terms
      S = addpolys(multiplyterm(Pset{i},L-d1),multconst(multiplyterm(Pset{j},L-d2),-1));
      S = reduceset(S,Pset,ord,tol,nd);
      %if any(S(:)~=0),
      if abs(leadterm(S,ord,tol,nd))>tol
        Qset{end+1}=S; % add S to the list
      end;
    end;
  end;
end;

end % helper function SPoly(...)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Qset = fullreduce(Pset,ord,tol,nd)
% reduces all polynomials wrt each other
Qset = Pset;
oldQset = {};

while ~isequal(oldQset,Qset),
  oldQset = Qset;
  for i=1:numel(Qset)-1,
    for j=i+1:numel(Qset),
      Qset{i}=reduce(Qset{i},Qset{j},ord,tol,nd);
      Qset{j}=reduce(Qset{j},Qset{i},ord,tol,nd);
    end;
  end;
end;

% keep only the nonzero results (to within zero tolerance tol)
Qset = Qset(cellfun(@(x)abs(leadterm(x,ord,tol,nd))>tol,Qset));

if numel(Qset)==1,
  % special case, a single equation can slip through without being reduced
  c = leadterm(Qset{1},ord,tol,nd);
  % coefficients occupy first column of the array
  Qset{1} = multconst(Qset{1},1/c); % know c~=0 because have already removed zero eqns
end;

end % helper function fullreduce(...)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Q = reduceset(P,Pset,ord,tol,nd)
% reduces P wrt all polynomials in Pset
Q = P;
oldQ = [];

while ~isequal(oldQ,Q),
  oldQ = Q;
  for i=1:numel(Pset),
    Q=reduce(Q,Pset{i},ord,tol,nd);
  end;
end;

end % helper function reduceset(...)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Q1=reduce(P1,P2,ord,tol,nd)
% reduces a polynomial P1 by subtracting multiples of P2 so that leading
% term coefficient is 1 and leading term of P2 does not divide that of P1

Q2=P2;
[c2,d2] = leadterm(Q2,ord,tol,nd);
if abs(c2)<=tol,
  % ignore terms less than tol
  keepgoing = false;
  Q1 = P1;
else
  keepgoing = true;
  Q2 = multconst(Q2,1/c2);
  Q1 = 0; % will successively add terms to Q
  % remove the leading terms, in order to reduce wrt lower terms
  remain = P1;
end;

while keepgoing,
  [c1,d1] = leadterm(remain,ord,tol,nd);
  if abs(c1)<=tol,
    % ignore terms less than tol
    keepgoing = false;
  else
    %reduce remain by Q2, if possible, or remove leading term
    if d1>=d2,
      % can reduce Q1 by Q2, so subtract a multiple of Q2 from Q1
      remain = addpolys(remain,multconst(multiplyterm(Q2,d1-d2),-c1));
    else
      % cannot reduce any further wrt leading term, but try lower terms
      lead = multiplyterm(c1,d1);
      remain = addpolys(remain,multconst(lead,-1));
      Q1 = addpolys(Q1,lead); % add irreducible terms to Q1
    end;
  end;
end;

% reduce leading coefficient, if possible
c1 = leadterm(Q1,ord,tol,nd);
if abs(c1)>tol,
  Q1 = multconst(Q1,1/c1);
end;

end % helper function reduce(...)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Q=multconst(P,c)
% returns c*P where c is a constant

Q = P;
Q(:,1)=Q(:,1)*c;

end % helper function multconst(...)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Q=addpolys(P1,P2)
% adds two polynomials

s1 = size(P1,2);
s2 = size(P2,2);

if s1>s2
  Q = [P1;P2,zeros(size(P2,1),s1-s2)];
else
  Q = [P1,zeros(size(P1,1),s2-s1);P2];
end;

Q = sortrows(Q,2:size(Q,2));
i=1;
while i<size(Q,1)
  % merge rows representing terms with the same exponents
  if Q(i,1)==0,
    Q(i,:)=[];
  elseif all(Q(i,2:end)==Q(i+1,2:end))
    Q(i,1)=Q(i,1)+Q(i+1,1);
    Q(i+1,:)=[];
    if Q(i,1)==0
      % remove terms that add to zero
      Q(i,:)=[];
    end;
  else
    i=i+1;
  end;
end;

end % helper function addpolys

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Q=multiplyterm(P,d)
% multiplies a polynomial by a term (no coefficient)

% padding a matrix at the end is same as multiplying by x
d=d(:).';
sP = size(P,2);
sd = size(d,2)+1; % d doesn't include coefficient
if sP<sd,
  Q=[P,zeros(size(P,1),sd-sP)];
else
  Q=P;
  d=[(d(:)).',zeros(1,sP-sd)];
end;
Q=Q+repmat([0,d],size(Q,1),1);

end % helper function multiplyterm

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [coeff,deg]=leadterm(P,ord,tol,nd)
% returns the leading term of P
% deg is a row vector of length size(P,2)-1
% coeff is the leading coefficient, deg(i) is the degree of xi
% ignores terms with coefficients <= tol
% nd is the minimum number of degrees (in order to handle cases where deg=0)

d=size(P,2);

if all(abs(P(:,1))<=tol),
  % P=0
  coeff=0;
  deg=zeros(1,d-1);
else
  switch ord
    case 'lex'
      P=sortrows(P,2:d);

    case 'revlex'
      error('revlex is not a well-ordering');

    case 'grlex'
      P = [P,sum(P(:,2:d),2)];
      P = sortrows(P,[d+1,2:d]);
      P = P(:,1:d);

    case 'grevlex'
      P = [P,sum(P(:,2:d),2)];
      P = sortrows(P,[d+1,-(d:-1:2)]);
      P = P(:,1:d);

    otherwise
      error('ordering %s not recognized',ord);

  end; % switch ord

  ind = find(abs(P(:,1))>tol,1,'last');
  if isempty(ind),
    coeff = 0;
    deg = zeros(1,d-1);
  else
    coeff = P(ind,1);
    deg = P(ind,2:end);
  end;

end; % if all(P(:)==0)

if nd>d-1,
  deg = [deg,zeros(1,nd-d+1)];
end;

end % helper function leadterm(...)


function heat_oned_test01 ( )

%*****************************************************************************80
%
%% HEAT_ONED_TEST01 runs Jeff Borggaard's test case.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 December 2012
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'HEAT_ONED_TEST01:\n' );
  fprintf ( 1, '  Run Jeff Borggaard''s test case.\n' );
%
%  Set up the problem.
%
  mu = 0.1;
  h = 100.0;
  rho = 40.0;
  degree = 2;
  xa = 0.0;
  xb = 1.0;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Viscosity parameter MU = %g\n', mu );
  fprintf ( 1, '  Heat transfer coefficient H = %g\n', h );
  fprintf ( 1, '  Mesh density RHO = %g\n', rho );
  fprintf ( 1, '  Requesting finite elements of degree %d\n', degree );
  fprintf ( 1, '  Spatial interval is [%g,%g].\n', xa, xb );

  [ A, B, M, n_nodes, x ] = heat_oned_setup ( mu, h, rho, degree, xa, xb );
%
%  Compute the solution over time.
%
  t_initial = 0.0;
  t_step    = 0.001;
  t_save    = 0.01;
  t_final   = 5.0;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Initial time =   %g\n', t_initial );
  fprintf ( 1, '  Final time =     %g\n', t_final );
  fprintf ( 1, '  Time step =      %g\n', t_step );
  fprintf ( 1, '  Data save step = %g\n', t_save );

  w_save = heat_oned ( A, B, M, n_nodes, x, t_initial, t_final, t_step, t_save );
%
%  Plot the results.
%
  t_plot = [ t_initial : t_save : t_final ];

  figure ( 1 )
  mesh ( t_plot, x, w_save )
  xlabel ( '<---Time--->' )
  ylabel ( '<---X--->' )
  zlabel ( '<--U(X,T)-->' )
  title ( 'U(X,T) as computed by HEAT\_ONED' )

  filename = 'heat_oned_test01.png';
  print ( '-dpng', filename );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Plot saved as "%s".\n', filename );

  return
end


function [ n_data, x, fx ] = erf_values ( n_data )

%*****************************************************************************80
%
%% ERF_VALUES returns some values of the ERF or "error" function.
%
%  Discussion:
%
%    The error function is defined by:
%
%      ERF(X) = ( 2 / sqrt ( PI ) * integral ( 0 <= T <= X ) exp ( - T^2 ) dT
%
%    In Mathematica, the function can be evaluated by:
%
%      Erf[x]
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Milton Abramowitz, Irene Stegun,
%    Handbook of Mathematical Functions,
%    National Bureau of Standards, 1964,
%    ISBN: 0-486-61272-4,
%    LC: QA47.A34.
%
%    Stephen Wolfram,
%    The Mathematica Book,
%    Fourth Edition,
%    Cambridge University Press, 1999,
%    ISBN: 0-521-64314-7,
%    LC: QA76.95.W65.
%
%  Parameters:
%
%    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
%    first call.  On each call, the routine increments N_DATA by 1, and
%    returns the corresponding data; when there is no more data, the
%    output value of N_DATA will be 0 again.
%
%    Output, real X, the argument of the function.
%
%    Output, real FX, the value of the function.
%
  n_max = 21;

  fx_vec = [ ...
     0.0000000000000000E+00, ...
     0.1124629160182849E+00, ...
     0.2227025892104785E+00, ...
     0.3286267594591274E+00, ...
     0.4283923550466685E+00, ...
     0.5204998778130465E+00, ...
     0.6038560908479259E+00, ...
     0.6778011938374185E+00, ...
     0.7421009647076605E+00, ...
     0.7969082124228321E+00, ...
     0.8427007929497149E+00, ...
     0.8802050695740817E+00, ...
     0.9103139782296354E+00, ...
     0.9340079449406524E+00, ...
     0.9522851197626488E+00, ...
     0.9661051464753107E+00, ...
     0.9763483833446440E+00, ...
     0.9837904585907746E+00, ...
     0.9890905016357307E+00, ...
     0.9927904292352575E+00, ...
     0.9953222650189527E+00 ];

  x_vec = [ ...
     0.0E+00, ...
     0.1E+00, ...
     0.2E+00, ...
     0.3E+00, ...
     0.4E+00, ...
     0.5E+00, ...
     0.6E+00, ...
     0.7E+00, ...
     0.8E+00, ...
     0.9E+00, ...
     1.0E+00, ...
     1.1E+00, ...
     1.2E+00, ...
     1.3E+00, ...
     1.4E+00, ...
     1.5E+00, ...
     1.6E+00, ...
     1.7E+00, ...
     1.8E+00, ...
     1.9E+00, ...
     2.0E+00 ];

  if ( n_data < 0 )
    n_data = 0;
  end

  n_data = n_data + 1;

  if ( n_max < n_data )
    n_data = 0;
    x = 0.0;
    fx = 0.0;
  else
    x = x_vec(n_data);
    fx = fx_vec(n_data);
  end

  return
end


function [kx, ky] = gradientKernels(sigma)
% Create kernels for computing gradient within 2D images.
%
%   KX = gradientKernels(SIGMA)
%   [KX, KY] = gradientKernels(SIGMA)
%   Generates the gradient kernel(s) used for computing gradients within 2D
%   images.
%   This is a low-level function that is called by the functions that
%   compute gradients.
%
%
%   Example
%   [kx, ky] = gradientKernels(2);
%
%   See also
%     imGradient, imGradientFilter, orientedGaussianKernel
%

% ------
% Author: David Legland
% e-mail: david.legland@inrae.fr
% INRAE - BIA Research Unit - BIBS Platform (Nantes)
% Created: 2022-06-01,    using Matlab 9.9.0.1570001 (R2020b) Update 4
% Copyright 2022 INRAE.

if nargin == 0 || sigma == 0
    % Default case: normalised sobel matrix
    kx = fspecial('sobel')' / 8;

else
    % compute size according to sigma
    Nx = ceil((3*sigma));
    lx = -Nx:Nx;
    ky = exp(-((lx / sigma) .^2) * .5);
    kx = -(lx / sigma) .* ky;
    kx = ky' * kx;
    kx = kx / sum(kx(kx > 0));
end

% optional kernel for gradient in Y-direction
if nargout > 1
    ky = kx';
end


function [x, c, funVal, ValueL]=LogisticR(A, y, z, opts)
%
%%
% Function LogisticR
%      Logistic Loss with the L1-norm Regularization
%
%% Problem
%
%  min  f(x,c) = - weight_i * log (p_i) + 1/2 rsL2 * ||x||_2^2
%                 + z * \|x\|_1
%
%  By default, rsL2=0.
%
%  a_i denotes a training sample,
%      and a_i' corresponds to the i-th row of the data matrix A
%
%  y_i (either 1 or -1) is the response
%
%  p_i= 1/ (1+ exp(-y_i (x' * a_i + c) ) ) denotes the probability
%
%  weight_i denotes the weight for the i-th sample
%
%% Input parameters:
%
%  A-         Matrix of size m x n
%                A can be a dense matrix
%                         a sparse matrix
%                         or a DCT matrix
%  y -        Response vector (of size mx1)
%  z -        Lq/L1 norm regularization parameter (z >=0)
%  opts-      Optional inputs (default value: opts=[])
%
%% Output parameters:
%  x-         The obtained weight of size n x 1
%  c-         The obtained intercept (scalar)
%  funVal-    Function value during iterations
%
%% Copyright (C) 2009-2010 Jun Liu, and Jieping Ye
%
% You are suggested to first read the Manual.
%
% For any problem, please contact with Jun Liu via j.liu@asu.edu
%
% Last modified on February 18, 2010.
%
%% Related papers
%
% [1]  Jun Liu, Jianhui Chen, and Jieping Ye, Large-Scale Sparse Logistic
%      Regression, KDD09
%
% [2]  Jun Liu and Jieping Ye, Efficient Euclidean Projections
%      in Linear Time, ICML 2009.
%
%% Related functions
%
%  sll_opts, initFactor, pathSolutionLeast
%  LogisticC, nnLogisticR, nnLogisticC
%
%%

%% Verify and initialize the parameters
%%
if (nargin <3)
    error('\n Inputs: A, y, and z should be specified!\n');
end

[m,n]=size(A);

if (length(y) ~=m)
    error('\n Check the length of y!\n');
end

if (z<=0)
    error('\n z should be positive!\n');
end

opts=sll_opts(opts); % run sll_opts to set default values (flags)

%% Detailed initialization
%% Normalization

% Please refer to sll_opts for the definitions of mu, nu and nFlag
%
% If .nFlag =1, the input matrix A is normalized to
%                     A= ( A- repmat(mu, m,1) ) * diag(nu)^{-1}
%
% If .nFlag =2, the input matrix A is normalized to
%                     A= diag(nu)^{-1} * ( A- repmat(mu, m,1) )
%
% Such normalization is done implicitly
%     This implicit normalization is suggested for the sparse matrix
%                                    but not for the dense matrix
%

if (opts.nFlag~=0)
    if (isfield(opts,'mu'))
        mu=opts.mu;
        if(size(mu,2)~=n)
            error('\n Check the input .mu');
        end
    else
        mu=mean(A,1);
    end

    if (opts.nFlag==1)
        if (isfield(opts,'nu'))
            nu=opts.nu;
            if(size(nu,1)~=n)
                error('\n Check the input .nu!');
            end
        else
            nu=(sum(A.^2,1)/m).^(0.5); nu=nu';
        end
    else % .nFlag=2
        if (isfield(opts,'nu'))
            nu=opts.nu;
            if(size(nu,1)~=m)
                error('\n Check the input .nu!');
            end
        else
            nu=(sum(A.^2,2)/n).^(0.5);
        end
    end

    ind_zero=find(abs(nu)<= 1e-10);    nu(ind_zero)=1;
    % If some values in nu is typically small, it might be that,
    % the entries in a given row or column in A are all close to zero.
    % For numerical stability, we set the corresponding value to 1.
end

if (~issparse(A)) && (opts.nFlag~=0)
    fprintf('\n -----------------------------------------------------');
    fprintf('\n The data is not sparse or not stored in sparse format');
    fprintf('\n The code still works.');
    fprintf('\n But we suggest you to normalize the data directly,');
    fprintf('\n for achieving better efficiency.');
    fprintf('\n -----------------------------------------------------');
end

%% Group & others

% The parameter 'weight' contains the weight for each training sample.
% See the definition of the problem above.
% The summation of the weights for all the samples equals to 1.
if (isfield(opts,'sWeight'))
    sWeight=opts.sWeight;

    if ( length(sWeight)~=2 || sWeight(1) <=0 || sWeight(2) <= 0)
        error('\n Check opts.sWeight, which contains two positive values');
    end

    % we process the weight, so that the summation of the weights for all
    % the samples is 1.

    p_flag=(y==1);                  % the indices of the postive samples
    m1=sum(p_flag) * sWeight(1);    % the total weight for the positive samples
    m2=sum(~p_flag) * sWeight(2);   % the total weight for the positive samples

    weight(p_flag,1)=sWeight(1)/(m1+m2);
    weight(~p_flag,1)=sWeight(2)/(m1+m2);
else
    weight=ones(m,1)/m;             % if not specified, we apply equal weight
end

%% Starting point initialization

% process the regularization parameter

% L2 norm regularization
if isfield(opts,'rsL2')
    rsL2=opts.rsL2;
    if (rsL2<0)
        error('\n opts.rsL2 should be nonnegative!');
    end
else
    rsL2=0;
end

p_flag=(y==1);                  % the indices of the postive samples
m1=sum(weight(p_flag));         % the total weight for the positive samples
m2=1-m1;                        % the total weight for the positive samples

% L1 norm regularization
if (opts.rFlag==0)
    lambda=z;
else % z here is the scaling factor lying in [0,1]
    if (z<0 || z>1)
        error('\n opts.rFlag=1, and z should be in [0,1]');
    end

    % we compute ATb for computing lambda_max, when the input z is a ratio

    b(p_flag,1)=m2;  b(~p_flag,1)=-m1;
    b=b.*weight;

    % compute AT b
    if (opts.nFlag==0)
        ATb =A'*b;
    elseif (opts.nFlag==1)
        ATb= A'*b - sum(b) * mu';  ATb=ATb./nu;
    else
        invNu=b./nu;               ATb=A'*invNu-sum(invNu)*mu';
    end

    lambda_max=max(abs(ATb));
    lambda=z*lambda_max;

    rsL2=rsL2*lambda_max; % the input rsL2 is a ratio of lambda_max
end

% initialize a starting point
if opts.init==2
    x=zeros(n,1); c=log(m1/m2);
else
    if isfield(opts,'x0')
        x=opts.x0;
        if (length(x)~=n)
            error('\n Check the input .x0');
        end
    else
        x=zeros(n,1);
    end

    if isfield(opts,'c0')
        c=opts.c0;
    else
        c=log(m1/m2);
    end
end

% compute A x
if (opts.nFlag==0)
    Ax=A* x;
elseif (opts.nFlag==1)
    invNu=x./nu; mu_invNu=mu * invNu;
    Ax=A*invNu -repmat(mu_invNu, m, 1);
else
    Ax=A*x-repmat(mu*x, m, 1);    Ax=Ax./nu;
end

%% The main program

%% The Armijo Goldstein line search scheme + accelearted gradient descent

if (opts.mFlag==0 && opts.lFlag==0)

    bFlag=0; % this flag tests whether the gradient step only changes a little

    L=1/m + rsL2; % the intial guess of the Lipschitz continuous gradient

    weighty=weight.*y;
    % the product between weight and y

    % assign xp with x, and Axp with Ax
    xp=x; Axp=Ax; xxp=zeros(n,1);
    cp=c;         ccp=0;

    alphap=0; alpha=1;

    for iterStep=1:opts.maxIter
        % --------------------------- step 1 ---------------------------
        % compute search point s based on xp and x (with beta)
        beta=(alphap-1)/alpha;    s=x + beta* xxp;  sc=c + beta* ccp;

        % --------------------------- step 2 ---------------------------
        % line search for L and compute the new approximate solution x

        % compute As=A*s
        As=Ax + beta* (Ax-Axp);

        % aa= - diag(y) * (A * s + sc)
        aa=- y.*(As+ sc);

        % fun_s is the logistic loss at the search point
        bb=max(aa,0);
        fun_s= weight' * ( log( exp(-bb) +  exp(aa-bb) ) + bb )+...
            rsL2/2 * s'*s;

        % compute prob=[p_1;p_2;...;p_m]
        prob=1./( 1+ exp(aa) );

        % b= - diag(y.* weight) * (1 - prob)
        b= -weighty.*(1-prob);

        gc=sum(b); % the gradient of c

        % compute g= AT b, the gradient of x
        if (opts.nFlag==0)
            g=A'*b;
        elseif (opts.nFlag==1)
            g=A'*b - sum(b) * mu';  g=g./nu;
        else
            invNu=b./nu;              g=A'*invNu-sum(invNu)*mu';
        end

        g=g+ rsL2 * s;  % add the squared L2 norm regularization term

        % copy x and Ax to xp and Axp
        xp=x;    Axp=Ax;
        cp=c;

        while (1)
            % let s walk in a step in the antigradient of s to get v
            % and then do the Lq/L1-norm regularized projection
            v=s-g/L;  c= sc- gc/L;

            % L1-norm regularized projection
            x=sign(v).*max(abs(v)-lambda / L,0);

            v=x-s;  % the difference between the new approximate solution x
            % and the search point s

            % compute A x
            if (opts.nFlag==0)
                Ax=A* x;
            elseif (opts.nFlag==1)
                invNu=x./nu; mu_invNu=mu * invNu;
                Ax=A*invNu -repmat(mu_invNu, m, 1);
            else
                Ax=A*x-repmat(mu*x, m, 1);     Ax=Ax./nu;
            end

            % aa= - diag(y) * (A * x + c)
            aa=- y.*(Ax+ c);

            % fun_x is the logistic loss at the new approximate solution
            bb=max(aa,0);
            fun_x= weight'* ( log( exp(-bb) +  exp(aa-bb) ) + bb ) +...
                rsL2/2 * x'*x;

            r_sum= (v'*v + (c-sc)^2) / 2;
            l_sum=fun_x - fun_s - v'* g - (c-sc)* gc;

            if (r_sum <=1e-20)
                bFlag=1; % this shows that, the gradient step makes little improvement
                break;
            end

            % the condition is fun_x <= fun_s + v'* g + c * gc
            %                           + L/2 * (v'*v + (c-sc)^2 )
            if(l_sum <= r_sum * L)
                break;
            else
                L=max(2*L, l_sum/r_sum);
                %fprintf('\n L=%e, r_sum=%e',L, r_sum);
            end
        end

        % --------------------------- step 3 ---------------------------
        % update alpha and alphap, and check whether converge
        alphap=alpha; alpha= (1+ sqrt(4*alpha*alpha +1))/2;

        ValueL(iterStep)=L;
        % store values for L

        xxp=x-xp;    ccp=c-cp;
        funVal(iterStep)=fun_x + lambda* sum(abs(x));

        if (bFlag)
            % fprintf('\n The program terminates as the gradient step changes the solution very small.');
            break;
        end

        switch(opts.tFlag)
            case 0
                if iterStep>=2
                    if (abs( funVal(iterStep) - funVal(iterStep-1) ) <= opts.tol)
                        break;
                    end
                end
            case 1
                if iterStep>=2
                    if (abs( funVal(iterStep) - funVal(iterStep-1) ) <=...
                            opts.tol* funVal(iterStep-1))
                        break;
                    end
                end
            case 2
                if ( funVal(iterStep)<= opts.tol)
                    break;
                end
            case 3
                norm_xxp=sqrt(xxp'*xxp);
                if ( norm_xxp <=opts.tol)
                    break;
                end
            case 4
                norm_xp=sqrt(xp'*xp);    norm_xxp=sqrt(xxp'*xxp);
                if ( norm_xxp <=opts.tol * max(norm_xp,1))
                    break;
                end
            case 5
                if iterStep>=opts.maxIter
                    break;
                end
        end
    end
end

%% Reformulated problem + Nemirovski's line search scheme

% Original problem:           min  f(x,c) = - weight_i * log (p_i) + 1/2 rsL2 * ||x||_2^2
%                                                      + z * \|x\|_1
%
% Reformulated problem:   min  f(x,c) = - weight_i * log (p_i) + 1/2 rsL2 * ||x||_2^2
%                                                      + z * 1^T t
%                                   s.t., |x| <=t

if (opts.mFlag==1 && opts.lFlag==0)

    bFlag=0; % this flag tests whether the gradient step only changes a little

    L=1/m + rsL2; % the intial guess of the Lipschitz continuous gradient

    weighty=weight.*y;
    % the product between weight and y

    % assign xp with x, and Axp with Ax
    xp=x;         Axp=Ax;     xxp=zeros(n,1);
    cp=c;         ccp=0;

    t=abs(x); tp=t;
    % t is the upper bound of absolute value of x

    alphap=0; alpha=1;

    for iterStep=1:opts.maxIter
        % --------------------------- step 1 ---------------------------
        % compute search point s based on xp and x (with beta)
        beta=(alphap-1)/alpha;    s=x + beta* xxp;  sc=c + beta* ccp; s_t= t + beta * (t -tp);

        % --------------------------- step 2 ---------------------------
        % line search for L and compute the new approximate solution x

        % compute As=A*s
        As=Ax + beta* (Ax-Axp);

        % aa= - diag(y) * (A * s + sc)
        aa=- y.*(As+ sc);

        % fun_s is the logistic loss at the search point
        bb=max(aa,0);
        fun_s= weight' * ( log( exp(-bb) +  exp(aa-bb) ) + bb )+...
            rsL2/2 * s'*s;

        % compute prob=[p_1;p_2;...;p_m]
        prob=1./( 1+ exp(aa) );

        % b= - diag(y.* weight) * (1 - prob)
        b= -weighty.*(1-prob);

        gc=sum(b); % the gradient of c

        % compute g= AT b, the gradient of x
        if (opts.nFlag==0)
            g=A'*b;
        elseif (opts.nFlag==1)
            g=A'*b - sum(b) * mu';  g=g./nu;
        else
            invNu=b./nu;              g=A'*invNu-sum(invNu)*mu';
        end

        g=g+ rsL2 * s;  % add the squared L2 norm regularization term

        % copy x and Ax to xp and Axp
        xp=x;    Axp=Ax;
        cp=c;    tp=t;

        while (1)
            % let s walk in a step in the antigradient of s to get v
            % and then do the Lq/L1-norm regularized projection
            c= sc- gc/L;
            u=s-g/L;
            v= s_t - lambda / L;

            % projection
            [x, t]=ep1R(u,v,n);

            v=x-s;  % the difference between the new approximate solution x
            % and the search point s
            v_t=t-s_t;

            % compute A x
            if (opts.nFlag==0)
                Ax=A* x;
            elseif (opts.nFlag==1)
                invNu=x./nu; mu_invNu=mu * invNu;
                Ax=A*invNu -repmat(mu_invNu, m, 1);
            else
                Ax=A*x-repmat(mu*x, m, 1);     Ax=Ax./nu;
            end

            % aa= - diag(y) * (A * x + c)
            aa=- y.*(Ax+ c);

            % fun_x is the logistic loss at the new approximate solution
            bb=max(aa,0);
            fun_x= weight'* ( log( exp(-bb) +  exp(aa-bb) ) + bb ) +...
                rsL2/2 * x'*x;

            r_sum= (v'*v + (c-sc)^2 + v_t'*v_t) / 2;
            l_sum=fun_x - fun_s - v'* g - (c-sc)* gc;

            if (r_sum <=1e-20)
                bFlag=1; % this shows that, the gradient step makes little improvement
                break;
            end

            % the condition is fun_x <= fun_s + v'* g + c * gc
            %                           + L/2 * (v'*v + (c-sc)^2 )
            if(l_sum <= r_sum * L)
                break;
            else
                L=max(2*L, l_sum/r_sum);
                %fprintf('\n L=%e, r_sum=%e',L, r_sum);
            end
        end

        % --------------------------- step 3 ---------------------------
        % update alpha and alphap, and check whether converge
        alphap=alpha; alpha= (1+ sqrt(4*alpha*alpha +1))/2;

        ValueL(iterStep)=L;
        % store values for L

        xxp=x-xp;    ccp=c-cp;
        funVal(iterStep)=fun_x + lambda* sum(t);

        if (bFlag)
            % fprintf('\n The program terminates as the gradient step changes the solution very small.');
            break;
        end

        switch(opts.tFlag)
            case 0
                if iterStep>=2
                    if (abs( funVal(iterStep) - funVal(iterStep-1) ) <= opts.tol)
                        break;
                    end
                end
            case 1
                if iterStep>=2
                    if (abs( funVal(iterStep) - funVal(iterStep-1) ) <=...
                            opts.tol* funVal(iterStep-1))
                        break;
                    end
                end
            case 2
                if ( funVal(iterStep)<= opts.tol)
                    break;
                end
            case 3
                norm_xxp=sqrt(xxp'*xxp + norm(t-tp)^2 + (c-cp)^2);
                if ( norm_xxp <=opts.tol)
                    break;
                end
            case 4
                norm_xp=sqrt(xp'*xp + cp^2 + tp'*tp);    norm_xxp=sqrt(xxp'*xxp + norm(t-tp)^2 + (c-cp)^2);
                if ( norm_xxp <=opts.tol * max(norm_xp,1))
                    break;
                end
            case 5
                if iterStep>=opts.maxIter
                    break;
                end
        end
    end
end

%% Reformulated problem + adaptive line search scheme

% Original problem:           min  f(x,c) = - weight_i * log (p_i) + 1/2 rsL2 * ||x||_2^2
%                                                      + z * \|x\|_1
%
% Reformulated problem:   min  f(x,c) = - weight_i * log (p_i) + 1/2 rsL2 * ||x||_2^2
%                                                      + z * 1^T t
%                                   s.t., |x| <=t

if (opts.mFlag==1 && opts.lFlag==1)

    bFlag=0; % this flag tests whether the gradient step only changes a little

    L=1/m + rsL2; % the intial guess of the Lipschitz continuous gradient

    weighty=weight.*y;
    % the product between weight and y

    gamma=1;
    % we shall set the value of gamma = L,
    % and L is appropriate for the starting point

    % assign xp with x, and Axp with Ax
    xp=x; Axp=Ax; xxp=zeros(n,1);
    cp=c;         ccp=0;
    t=abs(x); tp=t;
    % t is the upper bound of absolute value of x

    for iterStep=1:opts.maxIter
        while (1)
            if (iterStep~=1)
                alpha= (-gamma+ sqrt(gamma*gamma + 4* L * gamma)) / (2*L);
                beta= (gamma - gamma* alphap) / (alphap * gamma + alphap* L * alpha);
                % beta is the coefficient for generating search point s

                s=x + beta* xxp;   s_t= t + beta * (t -tp); sc=c + beta* ccp;
                As=Ax + beta* (Ax-Axp);
            else
                alpha= (-1+ sqrt(5)) / 2;  beta=0;
                s=x; s_t=t; sc= c;
                As=Ax;
            end

            % aa= - diag(y) * (A * s + sc)
            aa=- y.*(As+ sc);

            % fun_s is the logistic loss at the search point
            bb=max(aa,0);
            fun_s= weight' * ( log( exp(-bb) +  exp(aa-bb) ) + bb )+...
                rsL2/2 * s'*s;

            % compute prob=[p_1;p_2;...;p_m]
            prob=1./( 1+ exp(aa) );

            % b= - diag(y.* weight) * (1 - prob)
            b= -weighty.*(1-prob);

            gc=sum(b); % the gradient of c

            % compute g= AT b, the gradient of x
            if (opts.nFlag==0)
                g=A'*b;
            elseif (opts.nFlag==1)
                g=A'*b - sum(b) * mu';  g=g./nu;
            else
                invNu=b./nu;              g=A'*invNu-sum(invNu)*mu';
            end

            g=g+ rsL2 * s;  % add the squared L2 norm regularization term

            % let s walk in a step in the antigradient of s to get v
            % and then do the Lq/L1-norm regularized projection
            cnew= sc- gc/L;
            u=s-g/L;
            v= s_t - lambda / L;

            % projection
            [xnew, tnew]=ep1R(u,v,n);

            v=xnew-s;  % the difference between the new approximate solution x
            % and the search point s
            v_t=tnew-s_t;

            % compute A xnew
            if (opts.nFlag==0)
                Axnew=A* xnew;
            elseif (opts.nFlag==1)
                invNu=xnew./nu; mu_invNu=mu * invNu;
                Axnew=A*invNu -repmat(mu_invNu, m, 1);
            else
                Axnew=A*xnew-repmat(mu*xnew, m, 1);     Axnew=Axnew./nu;
            end

            % aa= - diag(y) * (A * x + c)
            aa=- y.*(Axnew+ cnew);

            % fun_x is the logistic loss at the new approximate solution
            bb=max(aa,0);
            fun_x= weight'* ( log( exp(-bb) +  exp(aa-bb) ) + bb ) +...
                rsL2/2 * xnew'*xnew;

            r_sum= (v'*v + (cnew-sc)^2 + v_t'*v_t) / 2;
            l_sum=fun_x - fun_s - v'* g - (cnew-sc)* gc;

            if (r_sum <=1e-20)
                bFlag=1; % this shows that, the gradient step makes little improvement
                break;
            end

            % the condition is fun_x <= fun_s + v'* g + c * gc
            %                           + L/2 * (v'*v + (c-sc)^2 )
            if(l_sum <= r_sum * L)
                break;
            else
                L=max(2*L, l_sum/r_sum);
                %fprintf('\n L=%e, r_sum=%e',L, r_sum);
            end
        end

        gamma=L* alpha* alpha;    alphap=alpha;
        % update gamma, and alphap

        ValueL(iterStep)=L;
        % store values for L

        tao=L * r_sum / l_sum;
        if (tao >=5)
            L=L*0.8;
        end
        % decrease the value of L

        xp=x;  x=xnew; xxp=x-xp;
        Axp=Ax; Ax=Axnew;
        tp=t; t=tnew;
        cp=c; c=cnew; ccp=c-cp;
        % update x, t, c, and Ax

        funVal(iterStep)=fun_x + lambda* sum(t);

        if (bFlag)
            % fprintf('\n The program terminates as the gradient step changes the solution very small.');
            break;
        end

        switch(opts.tFlag)
            case 0
                if iterStep>=2
                    if (abs( funVal(iterStep) - funVal(iterStep-1) ) <= opts.tol)
                        break;
                    end
                end
            case 1
                if iterStep>=2
                    if (abs( funVal(iterStep) - funVal(iterStep-1) ) <=...
                            opts.tol* funVal(iterStep-1))
                        break;
                    end
                end
            case 2
                if ( funVal(iterStep)<= opts.tol)
                    break;
                end
            case 3
                norm_xxp=sqrt(xxp'*xxp + norm(t-tp)^2 + (c-cp)^2);
                if ( norm_xxp <=opts.tol)
                    break;
                end
            case 4
                norm_xp=sqrt(xp'*xp + cp^2 + tp'*tp);    norm_xxp=sqrt(xxp'*xxp + norm(t-tp)^2 + (c-cp)^2);
                if ( norm_xxp <=opts.tol * max(norm_xp,1))
                    break;
                end
            case 5
                if iterStep>=opts.maxIter
                    break;
                end
        end
    end
end

%%
if(opts.mFlag==0 && opts.lFlag==1)
    error('\n The function does not support opts.mFlag=0 & opts.lFlag=1!');
end


function [x,err,it] = perform_conjugate_gradient(A,y,options)

% perform_conjugate_gradient - perform (bi)-conjugate gradient
%
%     [x,err,k] = perform_conjugate_gradient(A,y,options);
%
%   Solves for A*x=y.
%   Works both for vector x,y and matrix x,y (parralel soving of many
%   linear equations).
%
%   Important: the algorithm assumes that the matrix is symmetric definite
%   positive. If it is not the case, then you must set options.is_sdp=0,
%   and the algorithm will use a bi-conjugate gradient descent (x2 slower).
%
%   A can be a matrix or a callback function y=A(x,options).
%   In this case, you have to set options.ncols as the number of columns of
%   A (if it is a callback).
%   In the non-symmetric case, then options.transpose=1 for the computation
%   of A*x and options.transpose=-1 for the computation of A'*x.
%
%   err monitors the decreasing of |A*x-y|.
%   k is the total number of iterations.
%
%   You can set:
%       options.x is an initial guess
%       options.epsilon is maximum error
%       options.niter_max is maximum number of iterations
%
%   Copyright (c) 2007 Gabriel Peyre

options.null = 0;
niter = getoptions(options, 'niter_max', 100);
epsilon = getoptions(options, 'epsilon', 1e-5);
is_sdp = getoptions(options, 'is_sdp', 1);

use_callback = 0;
if not(isnumeric(A))
    use_callback = 1;
end
if isfield(options, 'x')
    x = options.x;
else
    if use_callback==0
        x = zeros(size(A,2),1);
    else
        if isfield(options, 'ncols')
            x = zeros(options.ncols, 1);
        else
            error('You have to specify options.ncols');
        end
    end
end

if norm(y(:), 'fro') == 0
    normb = epsilon;
else
    normb = epsilon; % * sum(y(:).^2);
end

if use_callback==0
    r  = y - A*x;
else
    options.transpose = 1;
    r  = y - feval(A,x,options);
end
p = r;
if is_sdp==0
    rr = r;
    pp = p;
end
r0 = sum(r(:).^2);

err = [sum(r0)];
for it=1:niter

    % auxiliary vector
    if use_callback==0
        w  = A*p;
    else
        options.transpose = 1;
        % options.transpose = -1;
        w  = feval(A,p,options);
    end

    if is_sdp==1
        d = sum(p(:) .* w(:));
    else
        d = sum(pp(:) .* w(:));
    end
    I = find(abs(d)<eps); d(I) = 1;
    alpha = repmat( r0 ./ d, [size(x,1) 1] );              % found optimal alpha in line search
    x = x + alpha.*p;                       % new guess
    r = r - alpha.*w;                       % the residual is in fact r=b-A*x
    if is_sdp==0
        if use_callback==0
            w  = A'*pp;
        else
            options.transpose = -1;
            w  = feval(A,pp,options);
        end
        rr = rr-alpha.*w;
    end

    rprev = r0;                             % save norm of the old residual
    if is_sdp==0
        r0 = sum(r.*rr);
    else
        r0 = sum(r.^2);                         % compute norm of new residual
    end

    err(end+1) = sqrt( sum(r.^2) );
    if err(end)<normb
        return;
    end

    % search direction
    beta = r0./rprev;
    p = r + repmat(beta, [size(x,1) 1]).*p;
    if is_sdp==0
        pp = rr + repmat(beta, [size(x,1) 1]).*pp;
    end

end


function z = he_polynomial_zeros ( nt )

%*****************************************************************************80
%
%% HE_POLYNOMIAL_ZEROS zeros of He(i,x).
%
%  Discussion:
%
%    He(i,x) represents the probabilist's Hermite polynomial.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    13 February 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NT, the degree of the polynomial.
%
%    Output, real Z(NT,1), the zeros of the polynomial.
%
  aj = zeros ( nt, 1 );
  bj = sqrt ( ( 1 : nt )' / 2.0 );
  wts = zeros ( nt, 1 );
  wts(1,1) = sqrt ( sqrt ( pi ) );

  [ z, wts ] = imtqlx ( nt, aj, bj, wts );
%
%  Adjust for probabilist.
%
  z(1:nt,1) = z(1:nt,1) * sqrt ( 2.0 );

  return
end


function [ back, sigma ] = image_background( im, make_plot )
% IMAGE_BRACKGROUND Automatically find the pixel-value of the background,
% for images that are predominantly black
%
% [ back, sigma ] = image_background( im )
% [ back, sigma ] = image_background( im, make_plot )
%
% Automatically find the pixel-value of the background, for images that are
% predominantly black.
%
% In that case, the histogram of the image has a peak in the low values,
% of Gaussian shape which correspond to the background pixels.
% image_background returns the mean and the sigma of this peak
%
% if 'make_plot' is set and true, an histogram and detected values is displayed
%
% TODO: automatically detect when the method fails

% F. Nedelec, 2005 - April 2008
%
% Ramon Casero <rcasero@gmail.com>: Minor edits

%compatibility with tiffread
if ( isfield( im, 'data') )
    filename = im.filename;
    im = im(1).data;
else
    filename = inputname(1);
end

% add a plot:
if nargin < 2
    make_plot = 0;
end

h = image_histogram( im );
%remove under-exposed pixels, where there might be a peak:
h(1) = 0;

%% calculate a Gaussian filter:

filt_sig = 20;
filt = exp( -( (-2*filt_sig:2*filt_sig) / filt_sig ) .^ 2 );
filt = filt ./ sum( filt );

% convolve by the filter to get a smooth profile:

hs = double( conv( h, filt ) );

%crop to the same size as h
hs = hs( 2*filt_sig+(1:numel(h)) );

%% find the maximum in the smoothed histogram

%[ hsmax, upper ] = max(hs);

% iteratively search for the first maximum
%back = 1;
%while  back < upper  &&  hs(back+1) >= hs(back)
%    back = back + 1;
%end

[ hsmax, back ] = max(hs);
upper = back;

if sum( h(1:back) ) < numel(im) / 5
    fprintf(['  Background detection might have failed for ', filename, '\n']);
end

%% Make a figure to debug things
if make_plot

    x = (0:size(h)-1)';
    figure('Name','image_background', 'Position', [100 150 800 300]);
    axes('Position', [0.05 0.1 0.9 0.8] );
    hold on;
    xlim([0 size(h,1)]);
    set(gca, 'ytick', [])

    plot(x, h, 'g.' );
    plot(x, hs, 'k:', 'linewidth', 1);

    plot([back, back], ylim, 'b-', 'linewidth', 2);
    plot([upper, upper], ylim, 'k:');

    text(back, hsmax, sprintf(' %i', back), 'FontSize', 18 );
    title('Histogram of pixel values');

end

%% Gaussian fit of the distribution of dark pixels

    function f = gauss(x, a)
        f = exp( -(x-a(1)).^2 / a(2) );
    end

    function err = gauss_err(a)
        f = gauss(rx, a);
        s = sum(ry.*f) / sum(f.*f);
        err = sum( abs(f*s-ry) );   %robust fitting
        %err = norm( f*s-ry );      %least-square fitting
    end

if nargout > 1

    % Gaussian fit to obtain the variance of the black pixel values

    rwd = fix(back*0.8);
    ri = max(back-rwd, 1) : min(back+rwd, length(hs));
    rh = h(ri);

    rx = (ri-1)';
    ry = rh / sum(rh);
    esp = sum(rx.*ry);
    var = sum(rx.*rx.*ry);
    sigma = sqrt(var-esp*esp);

    if nargin > 1
        fprintf('Histogram  : mean %.2f, sigma %.2f\n', back, sigma);
    end

    [ pamG, pval, flag ] = fminsearch(@gauss_err, [ esp, 2*(var-esp*esp) ]);

    %if the fit is successful, we change our estimate of sigma:
    if flag == 1
        f     = gauss(rx, pamG);
        fitG  = f * ( sum(rh) * sum(ry.*f) / sum(f.*f) );

        backG = pamG(1);
        sigma = sqrt(pamG(2)/2);

        if nargin > 1
            fprintf('Gauss   fit: mean %.2f, sigma %.2f\n', backG, sigma);
        end
    end

    if make_plot
        %make an inset figure:
        axes('Position', [0.5 0.25 0.4 0.62]);
        plot( rx, h(1+rx), 'g.');
        hold on;
        plot( rx, hs(1+rx), 'b--');
        if exist('fitG', 'var')
            plot( rx, fitG, 'k-');
        end
        plot([back, back], ylim, 'k-');
        if exist('sigma', 'var')
            w = sqrt(2) * sigma;
            plot([back-w, back-w], ylim, 'k:');
            plot([back+w, back+w], ylim, 'k:');
        end
    end
end

%% Gamma fit (could be appropriate for low photon counts)

    function g = gamma_dis(x, a)
        %a is of dimension 2: a = { k, theta }
        %gamma density function
        g = exp( (a(1)-1)*log(x) - x/a(2) - a(1)*log(a(2)) ) / gamma(a(1));
    end

    function err = gamma_err(a)
        f = gamma_dis(rx, a);
        s = sum(ry.*f) / sum(f.*f);
        err = sum( abs(f*s-ry) );   %robust fitting
        %err = norm( f*s-ry );      %least-square fitting
    end

if nargout > 1

    [ pamP, pval, flag ] = fminsearch(@gamma_err, [ 5, esp/5 ]);

    if flag == 1

        f      = gamma_dis(rx, pamP);
        fitP   = f * ( sum(rh) * sum(ry.*f) / sum(f.*f) );

        %backP  = pamP(1) * pamP(2);  %mean-value
        sigmaP = sqrt(pamP(1)) * pamP(2); %sigma
        [v, id] = max(f);
        backP  = rx(id);  %position of peak

        if nargin > 1
            fprintf('Gamma   fit: mean %.2f, sigma %.2f\n', backP, sigmaP);
        end

        if make_plot
            plot( rx, fitP, 'r-');
        end

    end

end

%% Poisson fit

    function p = poisson(x, a)
        n = x ./ a(2);
        % discrete poisson distribution over n,
        p = exp( n .* ( 1 - log( n ./ a(1) ) ) + 0.5*log(n) );
    end

    function err = poisson_err(a)
        f = poisson(rx, a);
        s = sum(ry.*f) / sum(f.*f);
        err = sum( abs(f*s-ry) );   %robust fitting
        %err = norm( f*s-ry );      %least-square fitting
    end

if nargout > 1

    [ pamS, pval, flag ] = fminsearch(@poisson_err, [ esp / 10, 10 ]);

    if flag == 1

        grain  = pamS(2);
        backS  = pamS(2) * pamS(1);      %mean
        sigmaS = pamS(2) * sqrt(pamS(1));

        f      = poisson(rx, pamS);
        fitS   = f * ( sum(rh) * sum(ry.*f) / sum(f.*f) );

        if nargin > 1
            fprintf('Poisson fit: mean %.2f, sigma %.2f, grain %.2f\n', backS, sigmaS, grain);
        end

        if make_plot
            plot( rx, fitS, 'b-');
        end

    end

end

end


function [s, lam] = shcovft(x, shrinkvar)
% Shrinkage estimate of a covariance matrix, using optimal shrinkage coefficient.
% INPUT:
% x is n*p data matrix
% shrinkvar :
% 0: corshrink (default)
% 1: varshrink
%
% OUTPUT:
% s is the posdef p*p cov matrix
% lam is the shrinkage coefficient
%
% See  J. Schaefer and K. Strimmer.  2005.  A shrinkage approach to
%   large-scale covariance matrix estimation and implications
%   for functional genomics. Statist. Appl. Genet. Mol. Biol. 4:32.
% This code is based on their original code http://strimmerlab.org/software.html
% but has been vectorized and simplified by Kevin Murphy.
% Adapted by Marcel van Gerven

if nargin < 2, shrinkvar = 0; end

[n p] = size(x);
if p==1, s=var(x); return; end

switch num2str(shrinkvar)

  case '1' % Eqns 10 and 11 of Opgen-Rhein and Strimmer (2007)
    [v, lam] = varshrink(x);
    dsv = diag(sqrt(v));
    r = corshrink(x);
    s = dsv*r*dsv;

  otherwise % case 'D' of Schafer and Strimmer
    v = var(x);
    dsv = diag(sqrt(v));
    [r, lam] = corshrink(x);
    s = dsv*r*dsv;

end

%%%%%%%%

function [sv, lambda] = varshrink (x)
% Eqns 10 and 11 of Opgen-Rhein and Strimmer (2007)
[v, vv] = varcov(x);
v = diag(v); vv = diag(vv);
vtarget = median(v);
numerator = sum(vv);
denominator = sum((v-vtarget).^2);
lambda = numerator/denominator;
lambda = min(lambda, 1); lambda = max(lambda, 0);
sv = (1-lambda)*v + lambda*vtarget;

function [Rhat, lambda] = corshrink(x)
% Eqn on p4 of Schafer and Strimmer 2005
[n, p] = size(x);
sx = makeMeanZero(x); sx = makeStdOne(sx); % convert S to R
[r, vr] = varcov(sx);
offdiagsumrij2 = sum(sum(tril(r,-1).^2));
offdiagsumvrij = sum(sum(tril(vr,-1)));
lambda = offdiagsumvrij/offdiagsumrij2;
lambda = min(lambda, 1); lambda = max(lambda, 0);
Rhat = (1-lambda)*r;
Rhat(logical(eye(p))) = 1;

function [S, VS] = varcov(x)
% s(i,j) = cov X(i,j)
% vs(i,j) = est var s(i,j)
[n,p] = size(x);
xc = makeMeanZero(x);
S = cov(xc);
XC1 = repmat(reshape(xc', [p 1 n]), [1 p 1]); % size p*p*n !
XC2 = repmat(reshape(xc', [1 p n]),  [p 1 1]); % size p*p*n !
VS = var(XC1 .* XC2, 0,  3) * n/((n-1)^2);

function xc = makeMeanZero(x)
% make column means zero
[n,p] = size(x);
m = mean(x);
xc = x - ones(n, 1)*m;

function xc = makeStdOne(x)
% make column  variances one
[n,p] = size(x);
sd = ones(n, 1)*std(x);
xc = x ./ sd;


function idx = findClosestCentroids(X, centroids)
%FINDCLOSESTCENTROIDS computes the centroid memberships for every example
%   idx = FINDCLOSESTCENTROIDS (X, centroids) returns the closest centroids
%   in idx for a dataset X where each row is a single example. idx = m x 1
%   vector of centroid assignments (i.e. each entry in range [1..K])
%

% Set K
K = size(centroids, 1);

% You need to return the following variables correctly.
idx = zeros(size(X,1), 1);

% ====================== YOUR CODE HERE ======================
% Instructions: Go over every example, find its closest centroid, and store
%               the index inside idx at the appropriate location.
%               Concretely, idx(i) should contain the index of the centroid
%               closest to example i. Hence, it should be a value in the
%               range 1..K
%
% Note: You can use a for-loop over the examples to compute this.
%
m = size(X,1);
for i = 1:m,
  minDistance = 10^6; % randomly chosen large enough value
  for j = 1:K,
    distance = sum((X(i,:) - centroids(j,:)).^2);
    if distance < minDistance,
      minDistance = distance;
      idx(i) = j;
    end
  end
end

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

end


function A = matrix(k, n)
%MATRIX  Test matrices accessed by number.
%        MATRIX(K, N) is the N-by-N instance of matrix number K in
%        a set of test matrices comprising those in MATLAB plus those
%        in the Matrix Computation Toolbox,
%        with all other parameters set to their default.
%        N.B. - Only those matrices which are full and take an arbitrary
%               dimension N are included.
%             - Some of these matrices are random.
%        MATRIX(K) is a string containing the name of the K'th matrix.
%        MATRIX(0) is the number of matrices, i.e. the upper limit for K.
%        Thus to set A to each N-by-N test matrix in turn use a loop like
%             for k=1:matrix(0)
%                 A = matrix(k, N);
%                 Aname = matrix(k);   % The name of the matrix
%             end
%        MATRIX(-1) returns the version number and date of the
%        Matrix Computation Toolbox.
%        MATRIX with no arguments lists the names and numbers of the M-files in the
%        collection.

%         References:
%         N. J. Higham, Accuracy and Stability of Numerical Algorithms,
%            Second edition, Society for Industrial and Applied Mathematics,
%            Philadelphia, PA, 2002; sec. 20.5.

% Matrices from gallery:
matrices = [%
'cauchy  '; 'chebspec'; 'chebvand'; 'chow    ';
'circul  '; 'clement '; 'condex  ';
'cycol   '; 'dramadah'; 'fiedler ';
'forsythe'; 'frank   '; 'gearmat '; 'grcar   ';
'invhess '; 'invol   '; 'ipjfact '; 'jordbloc';
'kahan   '; 'kms     '; 'krylov  '; 'lehmer  ';
'lesp    '; 'lotkin  '; 'minij   '; 'moler   ';
'orthog  '; 'parter  '; 'pei     '; 'prolate ';
'randcolu'; 'randcorr'; 'rando   '; 'randsvd ';
'redheff '; 'riemann '; 'ris     '; 'smoke   ';
'toeppd  '; 'triw    ';];
n_gall = length(matrices);

% Other MATLAB matrices:
matrices = [matrices;
'hilb    '; 'invhilb '; 'magic   '; 'pascal  ';
'rand    '; 'randn   ';];
n_MATLAB = length(matrices);

% Matrices from Matrix Computation Toolbox:
matrices = [matrices;
'augment '; 'gfpp    '; 'magic   '; 'makejcf ';
'rschur  '; 'vand    '];
n_mats = length(matrices);

if nargin == 0

   rows = ceil(n_mats/5);
   temp = zeros(rows,5);
   temp(1:n_mats) = 1:n_mats;

   for i = 1:rows
      for j = 1:5
        if temp(i,j) == 0, continue, end
        fprintf(['%2.0f: ' sprintf('%s',matrices(temp(i,j),:)) '  '], ...
                temp(i,j))
      end
      fprintf('\n')
   end
   fprintf('Matrices 1 to %1.0f are from MATLAB\.', n_MATLAB)

elseif nargin == 1
   if k == 0
      A = length(matrices);
   elseif k > 0
      A = deblank(matrices(k,:));
   else
      % Version number and date of collection.
      A = 'Version 1.2, September 5 2002';
   end
else
   if k <= n_gall
      A = eval( ['gallery(''' deblank(matrices(k,:)) ''',n)'] );
   else
      A = eval( [deblank(matrices(k,:)) '(n)'] );
   end
end


function [ x, dp2, p1 ] = jacobi_ss_root ( x, n, alpha, beta, b, c )

%*****************************************************************************80
%
%% JACOBI_SS_ROOT improves an approximate root of a Jacobi polynomial.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 October 2005
%
%  Author:
%
%    Original FORTRAN77 version by Arthur Stroud, Don Secrest.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Arthur Stroud, Don Secrest,
%    Gaussian Quadrature Formulas,
%    Prentice Hall, 1966,
%    LC: QA299.4G3S7.
%
%  Parameters:
%
%    Input, real X, the approximate root.
%
%    Input, integer N, the order of the polynomial to be computed.
%
%    Input, real ALPHA, BETA, the exponents of (1-X) and
%    (1+X) in the quadrature rule.
%
%    Input, real B(N), C(N), the recursion coefficients.
%
%    Output, real X, the improved approximate root.
%
%    Output, real DP2, the value of J'(N)(X).
%
%    Output, real P1, the value of J(N-1)(X).
%
  maxstep = 10;

  for i = 1 : maxstep

    [ p2, dp2, p1 ] = jacobi_ss_recur ( x, n, alpha, beta, b, c );

    d = p2 / dp2;
    x = x - d;

    if ( abs ( d ) <= eps * ( abs ( x ) + 1.0 ) )
      return
    end

  end

  return
end


function rs = corrdim(s, bins)

%tstoolbox/@signal/corrdim
%   Syntax:
%     * rs = corrdim(s, bins)
%
%   Input arguments:
%     * s - data points (row vectors)
%     * bins - maximal number of partition per axis (optional)
%
%   Compute the correlation dimension of a time-delay reconstructed
%   timeseries s for dimensions from 1 to D, where D is the dimension of
%   the input vectors using boxcounting approach. The default number of
%   bins is 100.
%
% Copyright 1997-2001 DPI Goettingen, License http://www.physik3.gwdg.de/tstool/gpl.txt

narginchk(1,2);

if ndim(s) ~= 2
    error('Signal must contain vector data');
end

if nargin<2
    bins = 100;
end

points = data(s);
[N,dim] = size(points);

% scale data to be within 0 and 1
points = points - min(min(points));
points = points / max(max(points));

% give a sortiment of (integer) partitionsizes with almost exponential behaviour
par = [2 3 4 5 6 7 8 10 12 14 16 20 23 27 32 39 46 54 64 77 91 108 128 153 182 216 256 ...
      305 363 431 512 609 725 862 1024 1218 1449 1723 2048 2436 2897 3445 4096 4871 ...
	  5793 6889 8192 9742 11586 13778 16384 19484 23171 27555 32768 38968 46341 55109 65536];

partitions = par(find(par<=bins));	% use no sizes greater than bins

[dummy,dummy2,e] = boxcount(points, partitions);

e = [zeros(1,dim) ; e];             % add zeros for partition size 1
partitions = [1 ; partitions(:)];	% add partition size 1

rs = signal(core(e), s);
a = achse(-log2(partitions));     		% create axis with arbitrary spacing
a = setname(a, 'ld r');
a2 = setname(achse(unit, 1, 1), 'Embedding dimension');
rs = setaxis(rs, 1, a);
rs = setaxis(rs, 2, a2);
rs = setplothint(rs, 'multigraph');
rs = addhistory(rs,  ['Computed correlation dimension']);
rs = addcommandlines(rs, 's = corrdim(s', bins);
rs = setyname(rs, 'ld C(r)');
rs = setlabel(rs, 'Scaling of D2');