function [P,varargout] = laplace(xs,A,b,AEq,bEq,varargin)
% LAPLACE Smooth compact 1,2 or 3 dimensional atomic probability distribution subject to linear and moment constraints
%
% LAPLACE('demo') or LAPLACE() runs univariate, bivariate and trivariate examples
%
% P = LAPLACE({xs1,xs2},[],[],[],[],[mu1 mu2],[mu11,mu12,mu22]) returns an
% matrix of size length(xs1) x length(xs2). The value P(i,j) is interpreted
% as a probability assigned to lattice point (xs1(i), xs2(j)). This 2d atomic
% probability minimizes the square of the discrete laplacian assuming zero
% boundary condition, subject to moment constraints E[x1]=mu1, E[x2]=mu2,
% E[x1.*x2] = mu11, E[x1.*x2]=mu12, E[x2.*x2]=mu22 where E denotes the expectation
% operator E(f) = sum(sum(f.*P)) and x1,x2,x3 are arrays of n-d coordinates
% function generated by [x1,x2,x3] = ndgrid(xs{:}).
%
% P = LAPLACE({xs1,xs2},A,b,AEq,bEq) returns a matrix of size length(xs1) x length(xs2).
% The value P(i,j) is interpreted as a probability assigned to lattice point (xs1(i), xs2(j)).
% The 2-d atomic probability minimizes the square of the discrete laplacian subject to inequality
% constraint A*P(:) < b and/or equality constraint AEq*P(:) = bEq. Supplied vectors
% b and bEq should be of length length(xs1) x length(xs2). A,b, AEq and bEq
% may be empty. In particular ...
%
% P = LAPLACE(xs1,[],[],[f1;f2;...],[Ef1;Ef2;...]) where f1,f2,... are row vectors
% of size 1 x length(xs1) representing functions on grid points xs1, and Ef1, Ef2
% are scalars representing their means returns a smooth compact probability
% distribution with E[f1] = Ef1, E[f2] = Ef2 and so forth.
%
% P = LAPLACE(xs1,[],[],[],[],mu1,mu11,mu111,mu1111) returns a
% vector of size length(xs1) x 1. The element P(i) is interpreted
% as a probability assigned to lattice point xs1(i). The 1-d atomic
% probability minimizes the square of the discrete laplacian assuming zero
% boundary condition, subject to moment constraints E[x1]=mu1,
% E[x1.*x1]=mu11, E[x1.*x1.*x1] = mu111 and E[x1.*x1.*x1.*x1]=mu1111.
% Addtional moment constraints may be supplied.
%
% P = LAPLACE({xs1,xs2,xs3},[],[],[],[],varargin) returns an
% matrix of size length(xs1) x length(xs2) x length(xs3). The value P(i,j,k) is interpreted
% as a probability assigned to lattice point (xs1(i), xs2(j), xs3(j)). The 3d atomic
% probability minimizes the sums squares of projections of the discrete laplacian assuming zero
% boundary condition, subject to moment constraints contained in varargin.
% Each constraint should be a vector of length NCHOOSEK(K+2,2) and contain
% moment values (as defined above) for all polynomials in x1, x2 and x3 of
% degree k sorted by reverse lexicographic ordering of their coefficients.
% For example, P = LAPLACE({xs1,xs2,xs3},[],[],[],[],[mu11,mu12,mu13,mu22,mu23,mu33])
% minimizes E[x1.^2] = mu11, E[x1.x2]= mu12 and so forth. The degree of the
% implied polynomials is inferred from the length of the moment vector.
%
% P = LAPLACE(...,A,b,AEq,bEq,...) applies additional user supplied
% inequality and equality constraints on P(:), as per the convention in
% most optimization functions including QUADPROG
%
%
% ARGUMENTS:
%   xs      n x 1 cell array  of vectors  - Lattice points at which the probability distribution is supported (compatible with ndgrid(xs{:}))
%   A,b,AEq,bEq                           - Inequality and equality constraints (can be empty), as per QUADPROG
%   varargin                              - Listing of desired values for moments (see explanation below)
%   P       m1 x m2 x ... x mn            - Lattice point probabilities (n-dimensional)
%   varargout                             - Evaluation of moments inferred by P in the same order as they are supplied
%
% MOMENT CONSTRAINTS:
%   If varargin{i} has length nchoosek(k+n-1,n-1) is it intepreted as a set of moment
%   constraints on polynomials of degreee k in the n coordinate functions, listed by
%   reverse lexicographic ordering. [A shortcoming of this convention is
%   that *all* degree k moments must be supplied].
%
%           if n=2 then [0.1 0.3] means E[x1]=0.1 and E[x2]=0.3
%           if n=2 then [0.5 0.2 0.1] means E[x1.^2] = 0.5, E[x1.*x2] = 0.2 and E[x2.*x2] = 0.1
%           if n=3 then [0.5 0.2 0.1] means E[x1] = 0.5, E[x2] = 0.2 and E[x3] = 0.1
%
% LIMITATIONS:
%   The discrete laplacian and implicit boundary condition may not be the most sensible
%   objective function, especially in the 3-d case as currently implemented (I'm hoping someone
%   improves this). One might also replace the atomic measure with mixture of gaussians
%   centred at the lattice points.
%
% RELATED:
%   ksdensity.m - stats toolbox
%
% Peter Cotton

momentConstraintMultiplier = 1;

if nargin==0 || ischar(xs) && strcmpi(xs,'demo'),
    laplaceDemo;
else

    %% Limitations and checks
    [m,n,xs] = laplaceArgChecks(xs,A,b,AEq,bEq,varargin{:});

    %% Establish grid points
    X = cell(n,1);
    switch n
        case 1,
            if ~iscell(xs),
                error('laplace: Violation of programmer intent - xs should have been set to cell by laplaceArgChecks');
            elseif iscell(xs),
                X = xs;
            else
                error('Not sure how to interpret xs');
            end
        otherwise
            [X{:}] = ndgrid(xs{:});
    end

    %% Ensure probs add to one.
    if isempty(AEq),
        AEq = ones(1,prod(m));
        bEq = 1;
    else
        AEq = [AEq;ones(1,prod(m))];
        bEq = [bEq;1];
    end

    %% Interpret additional arguments as equality constraints
    nsumk_ = nan(n,1);
    for k=1:10,
        nsumk_(k) = nsumk(n,k);
    end
    nArgs = length(varargin);
    moments = cell(nArgs,1);
    for argNo=1:length(varargin),
        arg_ = varargin{argNo};
        if isvector(arg_),
            switch n
                case 1,
                    degree_ = argNo;
                    expon = degree_;
                    nExpon= 1;
                otherwise
                    degree_ = find(nsumk_==length(arg_),1);
                    if isempty(degree_),
                        error([num2str(k),'th argument appears to have the wrong number of moments']);
                    else
                        [~,expon] = nsumk(n,degree_); % Listing of all non-negs adding to degree_
                        nExpon = size(expon,1);
                        expon = expon(nExpon:-1:1,:); % Reverse lexicographic ordering is more natural for moments
                    end
            end
            moments_ = nan(prod(m),nExpon);
            for i=1:nExpon,
                % Tabulate pointwise value of polynomial in x1, x2 and x3
                xi = X{1}(:);
                moments_(:,i) = xi.^expon(i,1);
                for j=2:n,
                    xj = X{j}(:);
                    moments_(:,i) = moments_(:,i).*(xj.^expon(i,j));
                end
            end
            AEq = [AEq;momentConstraintMultiplier*moments_'];
            bEq = [bEq;momentConstraintMultiplier*arg_(:)];
            moments{argNo} = moments_;
        end
    end

    %% Optimize discrete laplacian
    switch n
        case 1,
            f = @(p) del(p,xs);
        otherwise
            unrol = @(P) P(:);
            f = @(p) unrol(del(reshape(p,m'),xs));
    end
    [C,shouldBeZero] = inferAffineMap(f,prod(m));
    if any(abs(shouldBeZero)),
        error('laplace: Violation of programmer intent (bug). Discrete laplacian should not have constant term');
    end
    H = full(C'*C);
    options = optimset('LargeScale','off','MaxIter',500,'TolX',1e-2,'MaxFunEvals',1000);
    lb = zeros(prod(m),1);
    ub = ones(prod(m),1);
    p = quadprog(H,zeros(prod(m),1),A,b,AEq,bEq,lb,ub,zeros(prod(m),1),options);
    if n>1,
        P = reshape(p,m');
    else
        P = p;
    end

    %% Return moments implied by the atomic measure
    vargout = cell(length(varargin),1);
    for argNo=1:length(varargin),
        if ~isempty(moments{argNo}),
            vargout{argNo} = (p'*moments{argNo})';
        end
    end
    varargout = cell(length(varargin),1);
    [varargout{:}] = vargout{:};
end

end

function L = del(P,xs)
% function L = del(P,xs)
%
% Augmented discrete laplacian for 1 or 2 dimensions
% Projected, augmented discrete laplacian for 3 dimensions

% Tabulate grid steps
hs = cell(1,length(xs));
for dimNo=1:length(xs),
    hs{dimNo} = xs{dimNo}(2)-xs{dimNo}(1);
end

if isvector(P),
    L = del1augmented(P,hs);
elseif length(size(P))==2,
    L = del2augmented(P,hs);
elseif length(size(P))==3,
    L = del3augmented(P,hs);
else
    error('laplace is not implemented for dimension four'); % TODO:
end

    function d = del1augmented(P,hs)
        d = del2([0;0;P(:);0;0],hs{:});
    end

    function d = del2augmented(P,hs)
        % Enlarges the area and then computes del2
        P_ = zeros(size(P)+4);
        P_(3:end-2,3:end-2) = P;
        d = del2(P_,hs{:});
    end

    function d = del3augmented(P,hs)
        % Enlarges the area and then computes del2
        P_ = zeros(size(P)+4);
        P_(3:end-2,3:end-2,3:end-2) = P;
        d = del3(P_,hs{:});
    end
    function L = del3(X,varargin)
        % FIXME: For now this returns the laplacians of 2-d marginals
        L = zeros(0,1);
        for k=1:3,
            idx_ = setdiff(1:3,k);
            d_ = del2(squeeze(sum(X,k)),varargin{idx_});
            if k==1,
                L = d_(:);
            else
                L = [L;d_(:)];
            end
        end
    end

end

function [m,n,xs] = laplaceArgChecks(xs,A,b,AEq,bEq,varargin)
% function [n,m,xs] = laplaceArgChecks(xs,A,b,AEq,bEq,varargin)
%
% Ensure arguments make sense, and infer dimension where necessary

%% Allow passing of single vector for lattice rather than cell array
if ~iscell(xs) && isvector(xs),
    % Try to infer dimension
    if ~isempty(A),
        n_ = log(size(A,2))/log(length(xs));
        n = round(n_);
        if abs(n-n_)>1e-6,
            error('error infering dimension of problem, A looks to be inconsistent');
        end
    elseif ~isempty(AEq),
        n_ = log(size(AEq,2))/log(length(xs));
        n = round(n_);
        if abs(n-n_)>1e-6,
            error('error infering dimension of problem, AEq looks to be inconsistent');
        end
    else
        n = length(varargin{1});
        if n>3,
            error('inferred dimension exceeds 3 - better to be explicit');
        end
    end
    oldLattice = xs;
    xs = cell(n,1);
    for k1=1:n,
        xs{k1} = oldLattice;
    end
end

%% Check dimensions
n = length(xs);
m = nan(n,1);
for k2=1:n,
    latticeValues = xs{k2};
    m(k2) = length(latticeValues);
    if ~isvector(latticeValues) || any(any(diff(latticeValues)<eps)) || any(any(abs(diff(diff(latticeValues)))>1e-6)),
        error(['laplace anticipates an evenly spaced vector of support points in increasing order: e.g. (-4:0.5:3). Problem with lattice{',num2str(k2),'}']);
    end
end
if ~isempty(A) && size(A,2)~=prod(m),
    error('laplace anticipates size(A,2)=prod(m), where m(k) is the number of lattice points in dimension k');
end
if ~isempty(AEq) && size(AEq,2)~=prod(m),
    error('laplace anticipates size(AEq,2)=prod(m), where m(k) is the number of lattice points in dimension k');
end
if ~isempty(b) && size(b,1)~=size(bEq,1),
    error('laplace anticipates size(b,1)=prod(m), where m(k) is the number of lattice points in dimension k');
end
if ~isempty(bEq) && size(bEq,1)~=size(AEq,1),
    error('laplace anticipates size(bEq,1)=prod(m), where m(k) is the number of lattice points in dimension k');
end

end

function [A,b] = inferAffineMap(f,n)
% f  function_handle
% A  m x n
%
% Deduce affine mapping given its function handle

b = feval(f,zeros(n,1));
m = length(b);
A = sparse(m,n);
for k=1:n,
    ek = zeros(n,1);
    ek(k) = 1;
    A(:,k) = feval(f,ek)-b;
end
end

function [m,x] = nsumk(n,k)
% NSUMK Number and listing of non-negative integer n-tuples summing to k
%    M = NSUMK(N,K) where N and K are positive integers returns M=nchoosek(K+N-1,N-1)
%    This is the number of ordered N-tuples of non-negative integers summing to K
%
%    [M,X] = NSUMK(N,K) produces a matrix X with
%    nchoosek(K+N-1,N-1) rows and n columns. Each row comprises
%    non-negative integers summing to k. The ordering of rows follows the
%    same convention as NCHOOSEK, which is undocumented but with some
%    reliability appears to be lexicographic. The reverse of this presumed ordering
%    is a natural way to list coefficients of polynomials in N variables of degree K.
%    As per nchoosek, this syntax is only practical for situations where N is
%    less than about 15.
%
%  EXAMPLES:   m = nsumk(5,2)
%              [~,x] = nsumk(5,2) returns a 15 x 5 matrix x in which rows sum to 2

if isscalar(n) && isscalar(k) && nargout<=1
    m = nchoosek(k+n-1,n-1);
elseif isscalar(n) && isscalar(k) && nargout==2,
    m = nchoosek(k+n-1,n-1);
    dividers = [zeros(m,1),nchoosek((1:(k+n-1))',n-1),ones(m,1)*(k+n)];
    x = diff(dividers,1,2)-1;
else
    error('nsumk anticipates scalar k and n');
end
end

function [y,expon] = kmoments(x,k)
%  KMOMENTS - Evaluate sample mean of all k'th degree polynomials in N-variables
%    Y = KMOMENTS(X,K) where X is an NSAMPLES by N matrix produces a NSUMK(N,K) x 1
%    vector Y comprising sample means for all K-degree polynomials in N variables
%    Samples for the j'th variable comprise the j'th column of X, and the
%    implied listing of k-degree polynomials follows reverse lexicographic ordering
%
%    [Y,expon] = KMOMENTS(X,K) also returns the reverse-lex ordered polynomial exponents
%    in a matrix of size NCHOOSEK(K+N-1,N-1) x N

%% Generate reverse lex ordering
n = size(x,2);
switch n
    case 1,
        expon = k; m=1;
    otherwise
        [~,expon] = nsumk(n,k);
        m = size(expon,1);
        expon = expon(m:-1:1,:);
end

y = ones(m,1);

%% Compute k-th degree polys for a sample x
for i=1:m,
    ys = ones(size(x,1),1);
    for j=1:n,
        ys = ys.*x(:,j).^expon(i,j);
    end
    y(i) = mean(ys);
end

end

function laplaceDemo
close all;

%% UNIVARIATE EXAMPLE:
% An example motivated by finance
% We are inferring a risk-neutral density from market prices
% Prices of call options are linear constraints on the atomic density
% We throw in a few moment constraints as well
% Don't take this too seriously in the tails

matchExactMoments = true;  % <-- Set to false to verify the dangers in fitting the wrong moments
compareShortAndLongSample = false; % <-- Set to true to use moments and 'prices' from 'true' distribution
xs = (-5:0.05:5)';

% Generate an imagined risk-neutral density sample
shortSample_ = [-0.1+0.2*randn(10,1);0.3*randn(50,1);0.5+0.5*randn(100,1)];
if compareShortAndLongSample,
   longSample_ = [-0.1+0.2*randn(10*10000,1);0.3*randn(50*10000,1);0.5+0.5*randn(100*10000,1)];
else
   longSample_ = shortSample_;
end
pShort = hist(shortSample_,xs);pShort = pShort/sum(pShort);
pLong = hist(longSample_,xs);pLong = pLong/sum(pLong);

% Generate imagined market prices for securities based on the risk-neutral density sample
strikes = [-1:0.5:1];
security = @(x) max(0,x*ones(1,length(strikes))-ones(size(x,1),1)*strikes); % (Call option) Takes  column vector x of length nSamples ->  nSamples x nStrikes matrix
securityMarketPrice = mean(security(longSample_))';
securityPayoff = security(xs)';

% Infer the density subject to price and moment constraints
allMoments = cell(5,1);
for mNo=1:length(allMoments),
    if matchExactMoments,
        allMoments{mNo} = kmoments(longSample_,mNo);
    else
        allMoments{mNo} = kmoments(shortSample_,mNo);
    end
end
for nMomentsUsed = 0:5,
    P = laplace(xs,[],[],securityPayoff,securityMarketPrice,allMoments{1:nMomentsUsed});
    subplot(2,3,nMomentsUsed+1);plot(xs,P,xs,pLong,xs,pShort);legend('laplace','long sample','short sample');ylabel(['Matched ',num2str(nMomentsUsed), ' moments']);
    grid; plotxs = axis;axis([-2,2,plotxs(3),plotxs(4)]);
    drawnow; pause(1);
end

%% BIVARIATE EXAMPLE
% Inferring a bivariate distribution from moments
figure;
xs = {(-4:0.5:4)',(-4:0.5:4)};
sample_ = mvnrnd([-0.1 0.3],[1.2,0.5;0.5,0.98],500);
sample_(:,1) = sample_(:,1);
sample_(:,2) = -0.5+sample_(:,2)+0.5./(1+abs(sample_(:,1)));
pEmpirical = hist3(sample_,xs);
pEmpirical = pEmpirical/sum(pEmpirical(:));
moments1 = kmoments(sample_,1);
moments2 = kmoments(sample_,2);
moments3 = kmoments(sample_,3);
moments4 = kmoments(sample_,4);
[P,m1,m2,m3,m4] = laplace(xs,[],[],[],[],moments1,moments2,moments3,moments4);
subplot(1,2,1);surf(pEmpirical);zlabel('Empirical');
subplot(1,2,2);surf(P);zlabel('Laplace minimizing');
bivariateMomentComparison = [[moments1;moments2;moments3;moments4],[m1;m2;m3;m4]],
drawnow; pause(1);

%% TRIVARIATE EXAMPLE
% Inferring a tri-variate distribution from moments
figure;
disp('Trivariate example takes a little while...');
nTrivariateMomentsToUse = 3;
xs = {(-3:1:3)',(-3:1:3),(-3:1:3)};
sample_ = mvnrnd([-0.1 0.3 0.1],[1.2,0.5,0.2;0.5,0.98,0.35;0.2,0.35,1.2],50);
triMoments = cell(nTrivariateMomentsToUse,1);
for mNo=1:length(triMoments),
   triMoments{mNo}= kmoments(sample_,mNo);
end
P = laplace(xs,[],[],[],[],triMoments{:});
Pxy = squeeze(sum(P,3));
pxyEmpirical = hist3(sample_(:,[1:2]),xs(1:2)); pxyEmpirical = pxyEmpirical/sum(pxyEmpirical(:));
subplot(1,2,1);surf(pxyEmpirical);zlabel('Empirical (xy projection)');
subplot(1,2,2);surf(Pxy);zlabel('Laplace minimizing (xy projection)');

end


function [Q,Z,QAZ,QBZ]=HessenbergTriRed(A,B)
%%HESSENBERGTRIRED Perform a Hessenberg triangular reduction. Given A and
%             B, two nXn matrices, find orthogonal matrices Q and Z such
%             that Q'*A*Z is an upper Hessenberg matrix and Q'*B*Z is an
%             upper triangular matrix.  An upper Hessenberg matrix has zero
%             entries below the first subdisgonal and is thus almost upper
%             triangular. This implementation is only for real matrices.
%
%INPUTS: A, B Two nXn real matrices.
%
%OUTPUTS Q,Z Orthogonal nXn matrices such that Q'*A*Z is upper Hessenberg
%            and Q'*B*Z is lower triangular.
%        QAZ The matrix Q'*A*Z.
%        QBZThe matrix Q'*B*Z
%
%This implements algorithm 7.7.1 in Chapter 7.7.4 of [1], modified to
%obtain the Q and Z matrices explicitly. This is similar to the hess
%function in Matlab.
%
%REFERENCES:
%[1] G. H. Golub and C. F. Van Loan, Matrix Computations, 4th ed.
%    Baltimore: Johns Hopkins University Press, 2013.
%
%November 2015 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

n=size(A,1);

%The initial upper triangularization. We are just using qr and not
%Algorithm 5.2.1.
%Make B upper triangular
[Q,B]=qr(B,0);
A=Q'*A;%Adjust A accordingly

Z=eye(n,n);
for j=1:(n-2)
    for i=n:-1:(j+2)
        %Zero A(i,j)
        [c,s]=GivensCS(A(i-1,j),A(i,j));
        A((i-1):i,j:n)=[c, s;-s,c]'*A(i-1:i,j:n);
        B((i-1):i,(i-1):n)=[c, s;-s,c]'*B(i-1:i,i-1:n);
        %Store the transformation
        Q(:,(i-1):i)=Q(:,(i-1):i)*[c,s;-s,c];
        %Zero B(i,j)
        [c,s]=GivensCS(-B(i,i),B(i,i-1));
        B(1:i,i-1:i) = B(1:i,i-1:i)*[c,s;-s,c];
        A(1:n,i-1:i) = A(1:n,i-1:i)*[c,s;-s,c];
        Z(:,(i-1):i) = Z(:,(i-1):i)*[c,s;-s,c];
    end
end

%Save the results.
QAZ=A;
QBZ=B;
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 [ x, w ] = jacobi_ek_compute ( n, alpha, beta )

%*****************************************************************************80
%
%% JACOBI_EK_COMPUTE: Elhay-Kautsky method for Gauss-Jacobi quadrature rule.
%
%  Discussion:
%
%    The integral:
%
%      integral ( -1 <= x <= 1 ) (1-x)^alpha * (1+x)^beta * f(x) dx
%
%    The quadrature rule:
%
%      sum ( 1 <= i <= n ) w(i) * f ( x(i) )
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 June 2011
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Sylvan Elhay, Jaroslav Kautsky,
%    Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of
%    Interpolatory Quadrature,
%    ACM Transactions on Mathematical Software,
%    Volume 13, Number 4, December 1987, pages 399-415.
%
%  Parameters:
%
%    Input, integer N, the order.
%
%    Input, real ALPHA, BETA, the exponents of (1-X) and
%    (1+X) in the quadrature rule.  For simple Gauss-Legendre quadrature,
%    set ALPHA = BETA = 0.0.  -1.0 < ALPHA and -1.0 < BETA are required.
%
%    Output, real X(N), the abscissas.
%
%    Output, real W(N), the weights.
%

%
%  Define the zero-th moment.
%
  zemu = 2.0^( alpha + beta + 1.0 ) ...
    * gamma ( alpha + 1.0 ) ...
    * gamma ( beta + 1.0 ) ...
    / gamma ( 2.0 + alpha + beta );
%
%  Define the Jacobi matrix.
%
  x(1) = ( beta - alpha ) / ( 2.0 + alpha + beta );

  bj(1) = 4.0 * ( 1.0 + alpha ) * ( 1.0 + beta ) ...
    / ( ( 3.0 + alpha + beta ) * ( 2.0 + alpha + beta )^2 );

  for i = 2 : n
    abi = 2.0 * i + alpha + beta;
    x(i) = ( beta + alpha ) * ( beta - alpha ) / ( ( abi - 2.0 ) * abi );
    bj(i) = 4.0 * i * ( i + alpha ) * ( i + beta ) ...
      * ( i + alpha + beta ) ...
      / ( ( abi - 1.0 ) * ( abi + 1.0 ) * abi * abi );
  end

  bj(1:n) = sqrt ( bj(1:n) );

  w = zeros(n,1);

  w(1) = sqrt ( zemu );
  w(2:n) = 0.0;
%
%  Diagonalize the Jacobi matrix.
%
  [ x, w ] = imtqlx ( n, x, bj, w );

  w(1:n) = w(1:n).^2;

  return
end


function [ res, jac ] = opt14_rj ( x, flag )

%*****************************************************************************80
%
%% OPT14_RJ evaluates RES and JAC for test case #14.
%
%  Modified:
%
%    07 January 2008
%
%  Author:
%
%    Jeff Borggaard,
%    Gene Cliff,
%    Virginia Tech.
%
%  Reference:
%
%    John Dennis, Robert Schnabel,
%    Numerical Methods for Unconstrained Optimization
%    and Nonlinear Equations,
%    SIAM, 1996,
%    ISBN13: 978-0-898713-64-0,
%    LC: QA402.5.D44.
%
%  Parameters:
%
%    Input, real X(3), the evaluation point.
%
%    Input, string FLAG, indicates what must be computed.
%    'f' means only the value of RES is needed,
%    'g' means only the value of JAC is needed,
%    'all' means RES and JAC are needed.
%    It is acceptable to behave as though FLAG was 'all'
%    on every call.
%
%    Output, real RES(3,1), the function column vector.
%
%    Output, real JAC(3,3), the Jacobian matrix.
%
  n = length ( x );

  if ( n ~= 3 )
    fprintf ( '\n' );
    fprintf ( 'OPT14_RJ - Fatal error!\n' );
    fprintf ( '  The input vector X should have length 3.\n'),
    fprintf ( '  Instead, it has length = %d.\n', n );
    keyboard
  end

  res = zeros(n,1);

  res(1,1) = x(1)^2*x(2) + x(1)*x(2)^2;
  res(2,1) = 3 * x(1) * x(2)^2 * x(3) - x(1) * x(3) - 1;
  res(3,1) = x(1)*x(3) - 2;

  jac = zeros(n,n);

  jac(1,1) = 2 * x(1) * x(2) + x(2)^2;
  jac(1,2) = x(1)^2 + 2 * x(1) * x(2);
  jac(1,3) = 0;

  jac(2,1) = 3 * x(2)^2 * x(3) - x(3);
  jac(2,2) = 3 * 2 * x(1) * x(2) * x(3);
  jac(2,3) = 3 * x(1) * x(2)^2 - x(1);

  jac(3,1) = x(3);
  jac(3,2) = 0;
  jac(3,3) = x(1);


function f=chi2pdf(x,k)

% f=chi2pdf(x,k)
%
% Return the pdf of a chi-squared distribution with k degrees of freedom
% evaluated at x.

% Copyright 2012 Evrytania LLC (http://www.evrytania.com)
%
% Written by James Peroulas <james@evrytania.com>
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program.  If not, see <http://www.gnu.org/licenses/>.

error(nargchk(2,2,nargin));
error(chk_param(x,'x','numeric','real'));
error(chk_param(k,'k','scalar','real','integer','>=',1));

f=NaN(size(x));
f(x<0)=0;
xgt0=x>=0;
f(xgt0)=x(xgt0).^(k/2-1).*exp(-x(xgt0)/2)/(2^(k/2)*gamma(k/2));


function p = predict(theta, X)
%PREDICT Predict whether the label is 0 or 1 using learned logistic
%regression parameters theta
%   p = PREDICT(theta, X) computes the predictions for X using a
%   threshold at 0.5 (i.e., if sigmoid(theta'*x) >= 0.5, predict 1)

m = size(X, 1); % Number of training examples

% You need to return the following variables correctly
p = zeros(m, 1);

% ====================== YOUR CODE HERE ======================
% Instructions: Complete the following code to make predictions using
%               your learned logistic regression parameters.
%               You should set p to a vector of 0's and 1's
%

p = round(sigmoid(X * theta))

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

end


function fx = p49_fun ( n, x )

%*****************************************************************************80
%
%% P49_FUN evaluates the integrand for problem 49.
%
%  Discussion:
%
%    The function is singular at two internal points, 1 and sqrt(2).
%
%  Interval:
%
%    0 <= x <= 3
%
%  Integrand:
%
%    x^3 * log ( abs ( ( x^2 - 1 ) * ( x^2 - 2 ) ) )
%
%  Exact Integral:
%
%    61 log ( 2 ) + (77/4) log ( 7 ) - 27 = 52.7408...
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Robert Piessens, Elise de Doncker-Kapenga,
%    Christian Ueberhuber, David Kahaner,
%    QUADPACK: A Subroutine Package for Automatic Integration,
%    Springer, 1983, page 104.
%
%  Parameters:
%
%    Input, integer N, the number of evaluation points.
%
%    Input, real X(N), the evaluation points.
%
%    Output, real FX(N), the integrand values.
%
  x = x ( : );

  fx(1:n,1) = abs ( ( x(1:n,1).^2 - 1.0 ) .* ( x(1:n,1).^2 - 2.0 ) );
  i = ( fx == 0.0 );
  fx = x.^3 .* log ( fx );
  fx(i) = 0.0;

  return
end


% Fig. 6.43   Feedback Control of Dynamic Systems, 6e
%             Franklin, Powell, Emami
%

clear all;
%close all;
clf

num=86*conv([1 1],[1 2 43.25]);
p=conv([1 2 82],[1 2 101]);
den=conv([1 0 0],p);
w=logspace(-1,2,1000);
[mag,phas]=bode(num,den,w);
figure(1)
loglog(w,mag,w,ones(size(w)));
axis([.1 100 .01 10])
xlabel('\omega (rad/sec)');
ylabel('magnitude');
title('Fig. 6.43 : Bode plot for Example 6.12 (a) magnitude');
bodegrid;
%pause;
figure(2)
semilogx(w,phas,w,-180*ones(size(w)));
xlabel('\omega (rad/sec)');
ylabel('phase (deg)');
title('Fig. 6.43 : Bode plot for Example 6.13 (b) phase');
bodegrid;

% actually, the GMs and PMs are slightly different for the system here
% than that described in the text, the differences arose from
% roundoff because the initial design was done by hand.  The ideas
% are unchanged.


function y = gskewness(x,n)
%GSKEWNESS Skewness of a grouped sample.
%  In some scientific works, once the data have been gathered from a
%  population of interest, it is often difficult to get a sense of what
%  the data indicate when they are presented in an unorganized fashion.
%  Assembling the raw data into a meaningful form, such as a frequency
%  distribution, makes the data easier to understand and interpret. It is
%  in the context of frequency distributions that the importance of
%  conveying in a succinct way numerical information contained in the data
%  is encountered.
%  So, grouped data is data that has been organized into groups known as
%  classes.  The raw dataset can be organized by constructing a table
%  showing the frequency distribution of the variable (whose values are
%  given in the raw dataset). Such a frequency table is often referred to
%  as grouped data.
%  Here, we developed a m-code to calculate the skewness of a grouped data.
%  One can input the returns or modified vectors n and xout containing the
%  frequency counts and the bin locations of the hist m-function, in a
%  column form matrix.
%  GSKEWNESS(X,0) adjusts the skewness for bias (correction by small sample
%  size). GSKEWNESS(X,1) is the same as GSKEWNESS(X), and does not adjust
%  for bias.
%  If skewness = 0, the data are perfectly symmetrical. But a skewness of
%  exactly zero is quite unlikely for real-world data. Here, we use the
%  Bulmers' rule of thumb criterium (1979), about how we can to
%  interpret the skewness number:
%  - Less than ?1 or greater than +1, the distribution is highly skewed
%  - Between ?1 and ?0.5 or between +0.5 and +1, the distribution is
%    moderately skewed
%  - Between ?0.5 and +0.5, the distribution is approximately symmetric
%
%  Skewness calculation uses the formula,
%
%           g1 =  m3/m2^1.5, do not adjusted for bias
%
%           G1 = SQRT(N*(N - 1))/(N - 2) * g1, adjusted for bias
%
%  where:
%  m2 = second moment of the sample about its mean
%  m3 = third moment of the sample about its mean
%  N  = sample size
%
%  Syntax: function y = gskewness(x,n)
%
%  Inputs:
%       x - data matrix (Size of matrix must be n-by-2; absolut frequency=
%           column 1, class mark=column 2)
%       n - adjusted for bias = 0 (default), do not adjust for bias = 1
%  Outputs:
%       y  - skewness of the values in x
%
%  Example: Suppose we have the next frequency table:
%
%                     ----------------
%                       MC         F
%                     ----------------
%                       61         5
%                       64        18
%                       67        42
%                       70        27
%                       73         8
%                     ----------------
%
%  Taken from: http://www.tc3.edu/instruct/sbrown/stat/shape.htm
%
%  Where we are interested to get the skewness value adjusted for bias.
%
%  Data input:
%  x=[61 5;64 18;67 42;70 27;73 8];
%
%  Calling on Matlab the function:
%          y = gskewness(x,0)
%
%  Answer is:
%
%  y = -0.1098
%
%  Created by A. Trujillo-Ortiz, R. Hernandez-Walls and
%             C.M. Espinosa-Lagunes
%             Facultad de Ciencias Marinas
%             Universidad Autonoma de Baja California
%             Apdo. Postal 453
%             Ensenada, Baja California
%             Mexico.
%             atrujo@uabc.edu.mx
%
%  Copyright (C)  September 24, 2012.
%
%  To cite this file, this would be an appropriate format:
%  Trujillo-Ortiz, A., R. Hernandez-Walls and C.M. Espinosa-Lagunes. (2012).
%     gskewness:Skewness of a grouped sample. [WWW document].
%     URL http://www.mathworks.com/matlabcentral/fileexchange/
%     38319-gskewness
%
%  References:
%  Bulmer, M. G. (1979), Principles of Statistics. NY:Dover Books on
%             Mathematics.
%  Jayaraman, K. (1999), A Statistical Manual for Foresty Research. Foresty
%             Research Support Programme for Asia and the Pacific. FAO-
%             Corporate Document Repository. Forestry Statistics and Data
%             Collection.
%             URL http://www.fao.org/DOCREP/003/X6831E/X6831E00.HTM
%             PDF ftp://ftp.fao.org/docrep/fao/003/X6831E/X6831E00.pdf
%

if  nargin < 2,
    n = 1; %default
end

c = size(x,2);

if c ~= 2
    error('stats:gskewness:BadData','X must have two colums.');
end

mc = x(:,1); %class mark
f = x(:,2); %absolut frequency
s = sum(f.*mc);
m1 = s/sum(f);
m2 = sum(f.*(mc - m1).^2)/sum(f);
m3 = sum(f.*(mc - m1).^3)/sum(f);
g1 = m3/m2^1.5;

if n == 0;
    y = sqrt(sum(f)*(sum(f) - 1))/(sum(f) - 2) * g1; %skewness adjusted for
                                                     %bias
else n = 1; %default
    y = g1; %skewness not adjusted for bias
end

return,


function u = fem1d_heat_implicit ( x_num, x, t, dt, k_fun, ...
  rhs_fun, bc_fun, element_num, element_node, quad_num, u_old )

%*****************************************************************************80
%
%% FEM1D_HEAT_IMPLICIT: finite element method, 1D heat, implicit time steps.
%
%  Discussion:
%
%    This program solves
%
%      dUdT - k * d2UdX2 = f(X,T)
%
%    over the interval [A,B] with boundary conditions
%
%      U(A,T) = UA(T),
%      U(B,T) = UB(T),
%
%    over the time interval [T0,T1] with initial conditions
%
%      U(X,T0) = U0(X)
%
%    and specified functions k(X,T) and f(X,T).
%
%    The code uses the finite element method to approximate the second derivative
%    in space, and an implicit backward Euler approximation to the first
%    derivative in time.
%
%    For a test function Vi, we write
%
%      dUdt Vi - k * d2Udx2 * Vi = f(x,t) * Vi
%
%      Int dUdt Vi - k d2Udx2 * Vi    = Int f(x,t) Vi
%      Int dUdt Vi + k dUdx   * dVidx = Int f(x,t) Vi
%
%    Take the backward Euler approximation to the derivative:
%
%      Int ( U(x,t) - U(x,t-dt) ) / dt Vi + k dUdx dVidx = Int ( f(x,t) Vi )
%
%    Now, assume the finite element projection:
%
%      U(x,t)    = sum ( uj     * Vj )
%      U(x,t-dt) = sum ( u_oldj * Vj )
%      F(x,t)    = sum ( fj     * Vj ):
%
%    Then the equation can be rewritten as:
%
%      Sum ( Int ( Vi Vj ) * ( uj - u_oldj ) / dt + k dVidx dVjdx * uj ) =
%        Sum ( Int ( Vi Vj * fj ) )
%
%    Carrying the old U to the right hand side, we have:
%
%      Sum ( Int ( Vi Vj ) * u / dt + k dVidx dVjdx * uj ) =
%        Sum ( Int ( Vi Vj * ( fj + u_oldj / dt ) ) )
%
%    or, written as a linear system for coefficients "u":
%
%      ( K + M/dT ) * u = b + c
%
%    where K is the usual stiffness matrix, M is the standard finite element
%    mass matrix, b is the usual right hand side, and c contains additions to
%    the right hand side from the time term.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 February 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer X_NUM, the number of points to use in the spatial dimension.
%
%    Input, real X(X_NUM,1), the coordinates of the nodes.
%
%    Input, real T, the current time.
%
%    Input, real DT, the size of the time step.
%
%    Input, real K_FUN(), a function to evaluate the heat conductivity.
%
%    Input, real RHS_FUN(), a function to evaluate the right hand side.
%
%    Input, real BC_FUN(), a function to set the Dirichlet conditions.
%
%    Input, integer ELEMENT_NUM, the number of elements.
%
%    Input, integer ELEMENT_NODE(2,ELEMENT_NUM), the nodes belonging to
%    each element.
%
%    Input, integer QUAD_NUM, the number of quadrature points to use.
%
%    Input, real U_OLD(X_NUM,1), the solution at time T - dt.
%
%    Output, real U(X_NUM,1), the solution at time T.
%
  [ a, b ] = assemble_fem ( x_num, x, element_num, element_node, ...
    quad_num, t, k_fun, rhs_fun );

  [ a, b ] = assemble_backward_euler ( x_num, x, element_num, ...
    element_node, quad_num, t, dt, u_old, a, b );

  [ a, b ] = assemble_bc ( x_num, x, t, bc_fun, a, b );

  u = a \ b;

  return
end


%% MULTIGRID FOR STOKES EQUATIONS IN 2D
%
% This example is to show the convergence of multigrid methods for various
% finite element approximation of the Stokes equation on the unit square:
%
%       -div(mu*grad u) + grad p = f in \Omega,
%                        - div u = 0  in \Omega,
%                              u = g_D  on \Gamma.
%
% with the pure Dirichlet boundary condition. The solver is based on a DGS
% type smoother and summarized in the following reference.
%
% Reference
%
% M. Wang and L. Chen. Multigrid Methods for the Stokes equations
% using Distributive Gauss-Seidel Relaxations based on the Least Squares
% Commutator. Journal of Scientific Computing. 56(2): 409-431, 2013.

clear variables;
close all;

%% Setting
% mesh
[node,elem] = squaremesh([0,1,0,1],0.25);
% [node,elem] = circlemesh(0,0,1,0.25);
showmesh(node,elem);
[node,elem] = uniformrefine(node,elem);
bdFlag = setboundary(node,elem,'Dirichlet');
mesh = struct('node',node,'elem',elem,'bdFlag',bdFlag);
figure; showmesh(node,elem); pause(0.5);
% pde
pde = Stokesdata2;
%  pde = StokesZulehnerdata;
% options
option.L0 = 0;
option.maxIt = 4;
option.printlevel = 1;
option.plotflag = 0;
option.rateflag = 0;

%% MG options
option.solver = 'mg';
option.smoothingstep = 2;
option.smootherbarSp = 'SGS';

%% RT0-P0
disp('RT0-P0')
option.elemType = 'RT0-P0';
% option.refType = 'bisect';
femStokesHdiv(mesh,pde,option);

%% BDM1B-P0
disp('BDM1B-P0')
option.elemType = 'BDM1B-P0';
femStokesHdiv(mesh,pde,option);

%% CR-P0 element
disp('CR-P0')
option.elemType = 'CRP0';
femStokes(mesh,pde,option);

%% P2-P0 element
disp('P2-P0')
option.elemType = 'P2P0';
femStokes(mesh,pde,option);

%% isoP2-P0 element
disp('isoP2-P0')
option.elemType = 'isoP2P0';
femStokes(mesh,pde,option);

%% isoP2-P1 element
disp('isoP2-P1')
option.elemType = 'isoP2P1';
femStokes(mesh,pde,option);

%% P1b-P1 element
disp('P1b-P0')
option.elemType = 'P1bP1';
option.solver = 'asmg';
femStokes(mesh,pde,option);

%% P2-P1 element
disp('P2-P1')
option.elemType = 'P2P1';
% option.smoothingStep = 3;
% option.smootherbarSp   = 'VCYCLE';
% option.smootherbarSpPara = 0.75;
femStokes(mesh,pde,option);


function [ x, seed ] = hypersphere_uniform_sample ( m, n, r, c, seed )

%*****************************************************************************80
%
%% HYPERSPHERE_SURFACE_UNIFORM samples hypersphere surface.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 May 2013
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Russell Cheng,
%    Random Variate Generation,
%    in Handbook of Simulation,
%    edited by Jerry Banks,
%    Wiley, 1998, pages 168.
%
%    George Marsaglia,
%    Choosing a point from the surface of a sphere,
%    Annals of Mathematical Statistics,
%    Volume 43, Number 2, April 1972, pages 645-646.
%
%    Reuven Rubinstein,
%    Monte Carlo Optimization, Simulation, and Sensitivity
%    of Queueing Networks,
%    Wiley, 1986, page 234.
%
%  Parameters:
%
%    Input, integer M, the dimension of the space.
%
%    Input, integer N, the number of points.
%
%    Input, real R, the radius of the sphere.
%
%    Input, real C(M,1), the center of the sphere.
%
%    Input/output, integer SEED, a seed for the random number generator.
%
%    Output, real X(M,N), the points.
%
  [ x, seed ] = r8mat_normal_01 ( m, n, seed );

  v(1,1:n) = sqrt ( sum ( x.^2, 1 ) );
  vv = repmat ( v, m, 1 );
  x = x ./ vv;
%
%  Scale by the sphere radius.
%
  x = r * x;
%
%  Shift to the sphere center.
%
  x = x + repmat ( c, 1, n );

  return
end


function [parent_pop] = srn(parent_pop)
%   This procedure implements srn (Srinivas and Deb's) function.
%   The canonical srn function is defined as below --
%       f1 = 2.0 + ((x_1 - 2.0)^2.0) + ((x_2 - 1.0)^2.0)
%       f2 = (9.0 * x_1) - ((x_2 - 1.0) ^ 2.0)
%       s.t.
%           c_1(x) = 1.0 - ((x_1^2.0) + (x_2^2.0))/225.0
%           c_2(x) = (3.0 * x_2/10.0) - (x_1/10.0) - 1.0
%       where
%           -20.0 <= x_i <= 20.0    (i = 1,2)

global nreal ;
global ncon ;
global nobj ;

cindex = nreal + nobj + 1 : nreal + nobj + ncon ;

x = parent_pop(:,1:nreal);
f1 = 2.0 + ((x(:,1) - 2.0) .^ 2.0) + ((x(:,2) - 1.0) .^ 2.0);
f2 = (9.0 .* x(:,1)) - ((x(:,2) - 1.0) .^ 2.0);

c = parent_pop(:,cindex) ;
c(:,1) = 1.0 - (((x(:,1) .^ 2.0) + (x(:,2) .^ 2.0)) ./ 225.0);
c(:,2) = (3.0 .* (x(:,2) ./ 10.0)) - (x(:,1) ./ 10.0) - 1.0 ;

parent_pop(:, (nreal+1)) = f1 ;
parent_pop(:, (nreal+2)) = f2 ;
parent_pop(:, cindex) = c ;
end


function [dSP,sp]=grShortPath(E,s,t)
% Function dSP=grShortPath(E) solve the task about
% the shortest path between any vertexes of digraph.
% Input parameter:
%   E(m,2) or (m,3) - the arrows of digraph and their weight;
%     1st and 2nd elements of each row is numbers of vertexes;
%     3rd elements of each row is weight of arrow;
%     m - number of arrows.
%     If we set the array E(m,2), then all weights is 1.
% Output parameter:
%   dSP(n,n) - the matrix of shortest path.
%   Each element dSP(i,j) is the shortest path
%   from vertex i to vertex j (may be inf,
%   if vertex j is not accessible from vertex i).
% Uses the algorithm of R.W.Floyd, S.A.Warshall.
% [dSP,sp]=grShortPath(E,s,t) - find also
% the shortest paths from vertex s (source) to vertex t (tail).
% In this case output parameter sp is vector with numbers
% of vertexes, included to shortest path from s to t.
% Author: Sergiy Iglin
% e-mail: siglin@yandex.ru
% personal page: http://iglin.exponenta.ru
% Acknowledgements to Prof. Gerard Biau
% (Universite Montpellier II, France)
% for testing of this algorithm.

% ============= Input data validation ==================
if nargin<1,
  error('There are no input data!')
end
[m,n,E] = grValidation(E); % E data validation

% ================ Initial values ===============
dSP=ones(n)*inf; % initial distances
dSP((E(:,2)-1)*n+E(:,1))=E(:,3);

% ========= The main cycle of Floyd-Warshall algorithm =========
for j=1:n,
  i=setdiff((1:n),j);
  dSP(i,i)=min(dSP(i,i),repmat(dSP(i,j),1,n-1)+repmat(dSP(j,i),n-1,1));
end
sp=[];
if (nargin<3)|(isempty(s))|(isempty(t)),
  return
end
s=s(1);
t=t(1);
if (~(s==round(s)))|(~(t==round(t)))|(s<1)|(s>n)|(t<1)|(t>n),
  error(['s and t must be integer from 1 to ' num2str(n)])
end
if isinf(dSP(s,t)), % t is not accessible from s
  return
end
dSP1=dSP;
dSP1(1:n+1:n^2)=0; % modified dSP
l=ones(m,1); % label for each arrow
sp=t; % final vertex
while ~(sp(1)==s),
  nv=find((E(:,2)==sp(1))&l); % all labeled arrows to sp(1)
  vnv=abs((dSP1(s,sp(1))-dSP1(s,E(nv,1)))'-E(nv,3))<eps*1e3; % valided arrows
  l(nv(~vnv))=0; % labels of not valided arrows
  if all(~vnv), % invalided arrows
    l(find((E(:,1)==sp(1))&(E(:,2)==sp(2))))=0;
    sp=sp(2:end); % one step back
  else
    nv=nv(vnv); % rested vaded arrows
    sp=[E(nv(1),1) sp]; % add one vertex to shortest path
  end
end
return


function fx = p33_fun ( n, x )

%*****************************************************************************80
%
%% P33_FUN evaluates the integrand for problem 33.
%
%  Discussion:
%
%    The integrand is singular at both endpoints of the interval.
%
%  Interval:
%
%    0 <= x <= 1
%
%  Integrand:
%
%    sqrt ( - ln ( x ) )
%
%  Exact Integral:
%
%    sqrt ( pi ) / 2
%
%  Approximate Integral (20 digits):
%
%    0.88622692545275801365...
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 November 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Kendall Atkinson,
%    An Introduction to Numerical Analysis,
%    Prentice Hall, 1984, page 307.
%
%  Parameters:
%
%    Input, integer N, the number of evaluation points.
%
%    Input, real X(N), the evaluation points.
%
%    Output, real FX(N), the integrand values.
%
  fx = sqrt ( - log ( x ) );

  i = find ( x == 0.0 );
  fx(i) = 0.0;

  return
end


function ROT = createRotationVector3d(A,B)
%CREATEROTATIONVECTOR3D Calculates the rotation between two vectors.
%
%   ROT = createRotationVector3d(A, B) returns the 4x4 rotation matrix ROT
%   to transform vector A in the same direction as vector B.
%
%   Example
%     A=[ .1  .2  .3];
%     B=-1+2.*rand(1,3);
%     ROT = createRotationVector3d(A,B);
%     C = transformVector3d(A,ROT);
%     figure('color','w'); hold on; view(3)
%     O=[0 0 0];
%     drawVector3d(O, A,'r');
%     drawVector3d(O, B,'g');
%     drawVector3d(O, C,'r');
%
%   See also
%   transformPoint3d, createRotationOx, createRotationOy, createRotationOz
%
%   Source
%     https://math.stackexchange.com/a/897677
%
% ---------
% Author: oqilipo
% Created: 2017-08-07
% Copyright 2017

if isParallel3d(A,B)
    if A*B'>0
        ROT = eye(4);
    else
        ROT = -1*eye(4); ROT(end)=1;
    end
else
    a=normalizeVector3d(A);
    b=normalizeVector3d(B);
    a=reshape(a,3,1);
    b=reshape(b,3,1);

    v = cross(a,b);
    ssc = [0 -v(3) v(2); v(3) 0 -v(1); -v(2) v(1) 0];
    ROT = eye(3) + ssc + ssc^2*(1-dot(a,b))/(norm(v))^2;

    ROT = [ROT, [0;0;0]; 0 0 0 1];
end

end


function Cs = subgraph_centrality(CIJ)
% SUBGRAPH_CENTRALITY     subgraph centrality of a network
%
%   Cs = subgraph_centrality(CIJ)
%
%   The subgraph centrality of a node is a weighted sum of closed walks of
%   different lengths in the network starting and ending at the node. This
%   function returns a vector of subgraph centralities for each node of the
%   network.
%
%   Inputs:     CIJ,        adjacency matrix (binary)
%
%   Outputs:     Cs,        subgraph centrality
%
%   Reference: Estrada and Rodriguez-Velasquez (2005) Phys Rev E 71, 056103
%              Estrada and Higham (2010) SIAM Rev 52, 696.
%
%   Xi-Nian Zuo, Chinese Academy of Sciences, 2010
%   Rick Betzel, Indiana University, 2012

[V,lambda] = eig(CIJ);                 % Compute the eigenvectors and
lambda     = diag(lambda);             % eigenvalues.
V2         = V.^2;                     % Matrix of squares of the eigenvectors elements.
Cs         = real(V2 * exp(lambda));   % Compute eigenvector centrality. Lop off imaginary part remaining due to precision error.


function value = c1_jac_monomial_integral ( alpha, beta, expon )

%*****************************************************************************80
%
%% C1_JAC_MONOMIAL_INTEGRAL: integral of a monomial with Jacobi weight over C1.
%
%  Discussion:
%
%    value = integral ( -1 <= x <= +1 ) x^expon (1-x)^alpha (1+x)^beta dx
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    27 January 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real ALPHA, the exponent of (1-X) in the weight factor.
%
%    Input, real BETA, the exponent of (1+X) in the weight factor.
%
%    Input, integer EXPON, the exponent.
%
%    Output, real VALUE, the value of the integral.
%
  c = expon;

  if ( mod ( expon, 2 ) == 0 )
    s = +1.0;
  else
    s = -1.0;
  end

  arg1 = - alpha;;
  arg2 =   1.0 + c;
  arg3 =   2.0 + beta + c;
  arg4 = - 1.0;

  value1 = r8_hyper_2f1 ( arg1, arg2, arg3, arg4 );

  arg1 = - beta;
  arg2 =   1.0 + c;
  arg3 =   2.0 + alpha + c;
  arg4 = - 1.0;

  value2 = r8_hyper_2f1 ( arg1, arg2, arg3, arg4 );

  value = gamma ( 1.0 + c ) ...
    * ( s * gamma ( 1.0 + beta  ) * value1 / gamma ( 2.0 + beta  + c ) ...
    +       gamma ( 1.0 + alpha ) * value2 / gamma ( 2.0 + alpha + c ) );

  return
end


function d = p02_d ( m, id, c, w, n, x )

%*****************************************************************************80
%
%% P02_D evaluates a derivative for problem p02.
%
%  Discussion:
%
%    f(x) = 1 / product ( c(1:m)^(-2) + ( x(1:m) - w(1:m) )^2 )
%
%    Default values are:
%
%    c(1:m) = 1
%    w(1:m) = 0.5
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 August 2012
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Alan Genz,
%    A Package for Testing Multiple Integration Subroutines,
%    in Numerical Integration: Recent Developments, Software
%    and Applications,
%    edited by Patrick Keast and Graeme Fairweather,
%    Reidel, 1987, pages 337-340,
%    ISBN: 9027725144,
%    LC: QA299.3.N38.
%
%  Parameters:
%
%    Input, integer M, the spatial dimension.
%
%    Input, integer ID, the spatial coordinate to be differentiated.
%
%    Input, real C(M,1), W(M,1), the problem parameters.
%
%    Input, integer N, the number of points.
%
%    Input, real X(M,N), the evaluation points.
%
%    Output, real D(N,1), the value of the ID-th derivative component at X.
%
  d = ones ( n, 1 );
  for i = 1 : m
    d = d .* ( c(i) ^ (-2) + ( x(i,:)' - w(i) ) .^ 2 );
  end
  d = 1.0 ./ d .* ( - 2.0 ) .* ( x(id,:)' - w(id) ) ./ ...
    ( c(id) ^ (-2) + ( x(id,:)' - w(id) ) .^ 2 );

  return
end


% sgwt_kernel_simple_tf : evaluates "simple" tight-frame kernel
%
% this is similar to meyer kernel, but simpler
%
% function is essentially sin^2(x) in ascending part,
% essentially cos^2 in descending part.
%
% function r= sgwt_kernel_simple_tf(x,kerneltype)
%
% Inputs
% x : array of independent variable values
% kerneltype : string, either 'sf' or 'wavelet'
%
% Ouputs
% r : array of function values, same size as x.
%
% simple tf wavelet kernel : supported on [1/4,1]
% simple tf scaling function kernel : supported on [0,1/2]
%

function r= sgwt_kernel_simple_tf(x,kerneltype)
% h : [0,1]->[0,1] must satisfy h(0)=0, h(1)=1 .
h=@(x) sin(pi*x/2).^2;

%r1ind=find(x>=0 & x<0.25);
r1ind=find(x<0.25);

r2ind=find(x>=.25 & x<0.5);
r3ind=find(x>=.5 & x<1);

r=zeros(size(x));

switch kerneltype
  case 'sf'
    r(r1ind)=1;
    r(r2ind)=sqrt(1-h(4*x(r2ind)-1).^2);
  case 'wavelet'
    r(r2ind)=h(4*(x(r2ind)-1/4));
    r(r3ind)=sqrt(1-h(2*x(r3ind)-1).^2);
end


function node_num = fem2d_bvp_serene_node_num ( nx, ny )

%*****************************************************************************80
%
%% FEM2D_BVP_SERENE_NODE_NUM counts the number of nodes.
%
%  Discussion:
%
%    The program uses the finite element method, with piecewise serendipity
%    basis functions to solve a 2D boundary value problem over a rectangle.
%
%    The grid uses NX nodes in the X direction and NY nodes in the Y direction.
%
%    Both NX and NY must be odd.
%
%    Because of the peculiar shape of the serendipity elements, counting the
%    number of nodes and variables is a little tricky.  Here is a grid for
%    the case when NX = 7 and NY = 5, for which there are 29 nodes
%    and variables.
%
%     23 24 25 26 27 28 29
%     19    20    21    22
%     12 13 14 15 16 17 18
%      8     9    10    11
%      1  2  3  4  5  6  7
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    28 June 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NX, NY, the number of X and Y grid values.
%    NX and NY must be odd and at least 3.
%
%    Output, integer NODE_NUM, the number of nodes and variables.
%
  node_num =   nx           * ( ny + 1 ) / 2 ...
           + ( nx + 1 ) / 2 * ( ny - 1 ) / 2;

  return
end


% compute squared Euclidean distance
% ||A-B||^2 = ||A||^2 + ||B||^2 - 2*A'*B
function d = L2_distance_1(a,b)
% a,b: two matrices. each column is a data
% d:   distance matrix of a and b

if (size(a,1) == 1)
  a = [a; zeros(1,size(a,2))];
  b = [b; zeros(1,size(b,2))];
end

aa=sum(a.*a); bb=sum(b.*b); ab=a'*b;
d = repmat(aa',[1 size(bb,2)]) + repmat(bb,[size(aa,2) 1]) - 2*ab;
d = real(d);
d = max(d,0);

% % force 0 on the diagonal?
d = d.*(1-eye(size(d)));
%d = d/size(a,1)^2;


function zbar = eval2dPoly( x, y, coeffs )
% Given the coefficients of a polynomial as returned by fit2dPolySVD,
% calculates the values z for input values (x,y).
% x, y are column vectors specifying the points to be calculated.
% The vectors must be the same length.
% Coeffs is the coefficients array returned by fit2dPolySVD.

[sizexR, sizexC] = size(x);
[sizeyR, sizeyC] = size(y);

if (sizexC ~= 1) || (sizeyC ~= 1)
    fprintf( 'Inputs of eval2dPoly must be column vectors' );
    return;
end

if (sizeyR ~= sizexR)
    fprintf( 'Inputs vectors of eval2dPoly must be the same length' );
    return;
end

numVals = sizexR;

order = 0.5 * (sqrt(8*length(coeffs)+1) - 3);

zbar = zeros(numVals,1);
column = 1;
for xpower = 0:order
    for ypower = 0:(order-xpower)
        zbar = zbar + (coeffs(column) .* x.^xpower .* y.^ypower);
        column = column + 1;
    end
end


function dy = diffxy(x,y,varargin)
% DIFFXY - accurate numerical derivative/differentiation of Y w.r.t X.
%
%   DY = DIFFXY(X,Y) returns the derivative of Y with respect to X using a
%        pseudo second-order accurate method. DY has the same size as Y.
%   DY = DIFFXY(X,Y,DIM) returns the derivative along the DIM-th dimension
%        of Y. The default is differentiation along the first
%        non-singleton dimension of Y.
%   DY = DIFFXY(X,Y,DIM,N) returns the N-th derivative of Y w.r.t. X.
%        The default is 1.
%
%   Y may be an array of any dimension.
%   X can be any of the following:
%       - array X with size(X) equal to size(Y)
%       - vector X with length(X) equal to size(Y,DIM)
%       - scalar X denotes the spacing increment
%   DIM and N are both integers, with 1<=DIM<=ndims(Y)
%
%   DIFFXY has been developed especially to handle unequally spaced data,
%   and features accurate treatment for end-points.
%
%   Example:
%   % Data with equal spacing
%     x = linspace(-1,2,20);
%     y = exp(x);
%
%     dy = diffxy(x,y);
%     dy2 = diffxy(x,dy);  % Or, could use >> dy2 = diffxy(x,y,[],2);
%     figure('Color','white')
%     plot(x,(y-dy)./y,'b*',x,(y-dy2)./y,'b^')
%
%     Dy = gradient(y)./gradient(x);
%     Dy2 = gradient(Dy)./gradient(x);
%     hold on
%     plot(x,(y-Dy)./y,'r*',x,(y-Dy2)./y,'r^')
%     title('Relative error in derivative approximation')
%     legend('diffxy: dy/dx','diffxy: d^2y/dx^2',...
%            'gradient: dy/dx','gradient: d^2y/dx^2')
%
%   Example:
%   % Data with unequal spacing.
%     x = 3*sort(rand(20,1))-1;
%     % Run the example above from y = exp(x)
%
%   See also DIFF, GRADIENT
%        and DERIVATIVE on the File Exchange

% for Matlab (should work for most versions)
% version 1.0 (Nov 2010)
% (c) Darren Rowland
% email: darrenjrowland@hotmail.com
%
% Keywords: derivative, differentiation

[h,dy,N,perm] = parse_inputs(x,y,varargin);
if isempty(dy)
    return
end
n = size(h,1);
i1 = 1:n-1;
i2 = 2:n;

for iter = 1:N
    v = diff(dy)./h;
    if n>1
        dy(i2,:) = (h(i1,:).*v(i2,:)+h(i2,:).*v(i1,:))./(h(i1,:)+h(i2,:));
        dy(1,:) = 2*v(1,:) - dy(2,:);
        dy(n+1,:) = 2*v(n,:) - dy(n,:);
    else
        dy(1,:) = v(1,:);
        dy(n+1,:) = dy(1,:);
    end
end

% Un-permute the derivative array to match y
dy = ipermute(dy,perm);

%%% Begin local functions %%%
function [h,dy,N,perm] = parse_inputs(x,y,v)

numvarargs = length(v);
if numvarargs > 2
    error('diffxy:TooManyInputs', ...
        'requires at most 2 optional inputs');
end

h = [];
N = [];
perm = [];

% derivative along first non-singleton dimension by default
dim = find(size(y)>1);
% Return if dim is empty
if isempty(dim)
    dy = [];
    return
end
dim = dim(1);

% Set defaults for optional arguments
optargs = {dim 1};
newVals = ~cellfun('isempty', v);
optargs(newVals) = v(newVals);
[dim, N] = optargs{:};

% Error check on inputs
if dim<1 || dim>ndims(y) || dim~=fix(dim) || ~isreal(dim)
    error('diffxy:InvalidOptionalArg',...
        'dim must be specified as a non-negative integer')
end
if N~=fix(N) || ~isreal(N)
    error('diffxy:InvalidOptionalArg',...
        'N must be an integer')
end

% permutation which will bring the target dimension to the front
perm = 1:length(size(y));
perm(dim) = [];
perm = [dim perm];
dy = permute(y,perm);

if length(x)==1  % Scalar expansion to match size of diff(dy,[],1)
    sizeh = size(dy);
    sizeh(1) = sizeh(1) - 1;
    h = repmat(x,sizeh);
elseif ndims(x)==2 && any(size(x)==1) % Vector x expansion
    if length(x)~=size(dy,1)
        error('diffxy:MismatchedXandY',...
            'length of vector x must match size(y,dim)')
    end
    x = x(:);
    sizeh = size(dy);
    sizeh(1) = 1;
    h = repmat(diff(x),sizeh);
else
    if size(y) ~= size(x)
        error('diffxy:MismatchedXandY',...
            'mismatched sizes of arrays x and y');
    end
    % Permute x as for y, then diff
    h = diff(permute(x,perm),[],1);
end


function a = ijfact1 ( n )

%*****************************************************************************80
%
%% IJFACT1 returns the IJFACT1 matrix.
%
%  Formula:
%
%    A(I,J) = (I+J)!
%
%  Example:
%
%    N = 4
%
%     2   6   24   120
%     6  24  120   720
%    24 120  720  5040
%   120 720 5040 40320
%
%  Properties:
%
%    A is symmetric: A' = A.
%
%    Because A is symmetric, it is normal.
%
%    Because A is normal, it is diagonalizable.
%
%    A is a Hankel matrix: constant along anti-diagonals.
%
%    A is integral: int ( A ) = A.
%
%    The family of matrices is nested as a function of N.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    MJC Gover,
%    The explicit inverse of factorial Hankel matrices,
%    Department of Mathematics, University of Bradford, 1993.
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%
%    Output, real A(N,N), the matrix.
%
  a = zeros ( n, n );

  fact = 1;

  for k = 2 : 2 * n

    fact = fact * k;
    ilo = max ( 1, k - n );
    ihi = min ( n, k - 1 );

    for i = ilo : ihi
      a(i,k-i) = fact;
    end

  end

  return
end


function lmax = lebesgue_constant ( n, x, xfun )

%*****************************************************************************80
%
%% LEBESGUE_CONSTANT estimates the Lebesgue constant for a set of points.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    17 January 2014
%
%  Author:
%
%    John Burkardt.
%
%  Parameters:
%
%    Jean-Paul Berrut, Lloyd Trefethen,
%    Barycentric Lagrange Interpolation,
%    SIAM Review,
%    Volume 46, Number 3, September 2004, pages 501-517.
%
%  Parameters:
%
%    Input, integer N, the number of interpolation points.
%
%    Input, real X(N), the interpolation points.
%
%    Input, real XFUN(*), the evaluation points.
%
%    Output, real LMAX, an estimate of the Lebesgue constant for the points.
%
  lfun = lebesgue_function ( n, x, xfun );

  lmax = max ( lfun );

  return
end


function [A xy] = wheel_graph(n)
% WHEEL_GRAPH Construct a wheel graph of order n
%
% The wheel graph is a cycle graph of order n-1 along with an additional
% vertex that connects all the remaining vertices.  (Run the example and it
% will be extremely clear if you are still confused.)
%
% [A xy] = wheel_graph(n) returns the adjacency matrix for the wheel graph
% of order n.  The matrix xy stores two-dimensional coordinates for each
% vertex.
%
% Example:
%   [A xy] = wheel_graph(10);
%   gplot(A,xy);
%
% See also CYCLE_GRAPH, STAR_GRAPH

% David Gleich
% Copyright, Stanford University, 2007-2008

%% History
%  2007-09-29: Changed output to double, fixed output for i=0,1
%%

if n>1
    i = 1:(n-1);
    j = [i(2:end) i(1)];
    i = [i i];
    j = [j n*ones(1,n-1)];
    A = sparse(i,j,1,n,n);
    A = A|A';
    A = double(A);
else
    i=[];
    A = sparse(n,n);
end

i = i(1:end/2);
if n>0
    xy = [ [cos(2*pi*(i./(n-1))) 0]' [sin(2*pi*(i./(n-1))) 0]' ];
else
    xy = zeros(0,2);
end


function [x, y, h, hm, xm, ym] = generate_terrain(n, mesh_size, h0, r0, rr)

% [x, y, h, hm, xm, ym] = generate_terrain(n, mesh_size, h0, r0, rr)
%
% This function generates a series of points that approximate terrain
% according to a simple algorithm and very few parameters.
%
% Inputs:
% n         - Number of iterations of algorithm to perform, akin to the
%             order of magnitudes represented by the variation. Anything
%             beyond 7 will produce detail too fine to notice, while the
%             algorithm will require ~3 times longer for every iteration.
% mesh_size - Size of the output mesh (e.g., 512 for 512-by-512)
% h0        - Initial elevation
% r0        - Initial roughness (how much terrain can vary in a step)
% rr        - Roughness roughness (how much roughness can vary in a step)
%
% For an example, see terrain_generation_introduction.m or
% html/terrain_generation_introduction.html.
%
% Outputs:
% x, y, and h    - Vectors of points comprising terrain
% xm, ym, and hm - Meshes over landscape, useful for surf(...)
%
% Tucker McClure
% Copyright 2012, The MathWorks, Inc.

    % Set some defaults if the user didn't provide inputs.
    if nargin < 1, n         = 7;            end % Iterations
    if nargin < 2, mesh_size = 513;          end % Output mesh size
    if nargin < 3, h0        = 0.1 * rand(); end % Elevation
    if nargin < 4, r0        = 0.1 * rand(); end % Roughness
    if nargin < 5, rr        = 0.1 * rand(); end % Roughness roughness

    n0 = randi(5);     % Number of initial points
    m  = 3;            % How many points grow from each old point
    nf = n0 * (m+1)^n; % Total number of points

    % Create initial x, y, and height coordinates and roughness map.
    x = [randn(n0, 1);           zeros(nf-n0, 1)];
    y = [randn(n0, 1);           zeros(nf-n0, 1)];
    h = [r0 * randn(n0, 1) + h0; zeros(nf-n0, 1)];
    r = [rr * randn(n0, 1) + r0; zeros(nf-n0, 1)];

    % Create new points from old points n times.
    for k = 1:n

        % Calculate the new variance for the x, y random draws and for the
        % h, r random draws.
        dxy = 0.75^k;
        dh  = 0.5^k;

        % Number of new points to generate
        n_new = m * n0;

        % Parents for new points
        parents = reshape(repmat(1:n0, m, 1), [n_new, 1]);

        % Calculate indices for new and existing points.
        new = (n0+1):(n0+n_new);
        old = 1:n0;

        % Generate new x/y values.
        theta  = 2*pi * rand(n_new, 1);
        radius = dxy * (rand(n_new, 1) + 1);
        x(new) = x(parents) + radius .* cos(theta);
        y(new) = y(parents) + radius .* sin(theta);

        % Interpolate to find nominal new r and h values and add noise to
        % roughness and height maps.
        r(new) =   interpolate(x(old), y(old), r(old), x(new), y(new)) ...
                 + (dh * rr) .* randn(n_new, 1);
        h(new) =   interpolate(x(old), y(old), h(old), x(new), y(new)) ...
                 + (dh/dxy) * radius .* r(new) .* randn(n_new, 1);

        % Add up the new points.
        n0 = n_new + n0;

    end

    % Normalize the distribution of the points about the median.
    x = (x - median(x))/std(x);
    y = (y - median(y))/std(y);

    % If the user wants a mesh output, we can do that too. Create a mesh
    % over the significant part and interpolate over it.
    if nargout > 3 && ~isempty(mesh_size)
        [xm, ym] = meshgrid(linspace(-1, 1, mesh_size));
        hm = interpolate(x, y, h, xm, ym);
    end

end

% Perform our particular type of interpolation.
function vn = interpolate(x0, y0, v0, xn, yn)

    % Make an interpolator for height or roughness. We'll add safe far-away
    % points so we'll always be interpolating and not extrapolating.
    int = TriScatteredInterp([100*[-1 -1 1 1]'; x0], ...
                             [100*[-1 1 -1 1]'; y0], ...
                             [zeros(4, 1);      v0], 'linear'); %#ok<R%#ok<MSNU> EMFF1>

	% Perform the actual interpolation.
	vn = int(xn, yn);

end


function dist = circle_imp_point_dist_signed_2d ( r, center, p )

%*****************************************************************************80
%
%% CIRCLE_IMP_POINT_DIST_SIGNED_2D: signed distance ( implicit circle, point ) in 2D.
%
%  Discussion:
%
%    The signed distance is zero if the point is on the circle.
%    The signed distance is negative if the point is inside the circle.
%
%    An implicit circle in 2D satisfies the equation:
%
%      ( X - CENTER(1) )**2 + ( Y - CENTER(2) )**2 = R**2
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    31 January 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real R, the radius of the circle.
%
%    Input, real CENTER(2,1), the center of the circle.
%
%    Input, real P(2,1), the point to be checked.
%
%    Output, real DIST, the signed distance of the point
%    to the circle.  If the point is inside the circle, the signed distance
%    is negative.
%
  dim_num = 2;

  r2 = sqrt ( sum ( ( p(1:dim_num,1) - center(1:dim_num,1) ).^2 ) );

  dist = r2 - r;

  return
end


function y = sinspace(d1, d2, n, factor)
%SINSPACE cosine spaced vector.
%   SINSPACE(X1, X2) generates a row vector of 100 sine spaced points
%   between X1 and X2.
%
%   SINSPACE(X1, X2, N) generates N points between X1 and X2.
%
%   A sine spaced vector clusters the elements toward X2:
%    X1 |      |      |      |     |    |   |  | || X2
%
%   Make n negative to cluster the elements toward X1:
%    X1 || |  |   |    |     |      |      |      | X2
%
%   For -2 < N < 2, SINSPACE returns X2.
%
%   SINSPACE(X1, X2, N, W) clusters the elements to a lesser degree as
%   dictated by W. W = 0 returns a normal sine spaced vector. W = 1 is the
%   same as LINSPACE(X1, X2, N). Experiment with W < 0 and W > 1 for
%   different clustering patterns.
%
%   Author:     Sky Sartorius
%
%   See also COSSPACE, LINSPACE, LOGSPACE.

if nargin == 2
    n = 100;
end
if nargin < 4
    factor = false;
end

if n<0
    n = floor(double(-n));
    y = d2 + (d1-d2)*sin(pi/2*(1-(0:(n-1))/(n-1)));
else
    n = floor(double(n));
    y = d1 + (d2-d1)*sin(pi/(2*(n-1))*(0:n-1));
end

if factor
    y = (1-factor)*y+factor*[d1+(0:n-2)*(d2-d1)/(n-1) d2];
end


function cdf = levy_cdf ( x, a, b )

%*****************************************************************************80
%
%% LEVY_CDF evaluates the Levy CDF.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    23 April 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the argument of the CDF.
%    Normally, A <= X.
%
%    Input, real A, B, the parameters of the PDF.
%    0 < B.
%
%    Output, real CDF, the value of the PDF.
%
  if ( b <= 0.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, '  LEVY_PDF - Fatal error!\n' );
    fprintf ( 1, '  Input parameter B <= 0.0\n' );
    error ( 'LEVY_PDF - Fatal error!' );
  end

  if ( x <= a )
    cdf = 0.0;
  else
    cdf = 1.0 - error_f ( sqrt ( b / ( 2.0 * ( x - a ) ) ) );
  end

  return
end


% foo.m
%
% This m-file shows an example of how to use ApEn function
%
% More specifically, it generates three simulated data with different
% complexity (sine, chirp, and Gaussian noise), and plots the ApEn values
% with varying r

%-------------------------------------------------------------------------
% coded by Kijoon Lee, kjlee@ntu.edu.sg
% Mar 21st, 2012
%-------------------------------------------------------------------------
clear all

m = 2;      % embedded dimension
tau = 1;    % time delay for downsampling
N = 1000;
t = 0.001*(1:N);

% generate simulated data
sint = sin(2*pi*10*t);      % sine curve
chirpt = chirp(t,0,1,150);  % chirp signal
whitet = randn(1,N);        % white noise

% calculate standard deviations
sd1 = std(sint);
sd2 = std(chirpt);
sd3 = std(whitet);

% specify the range of r
rnum = 30;
result = zeros(3,rnum);

% main calculation and display
figure
for i = 1:rnum
    r = i*0.02;
    result(1,i) = ApEn(m, r*sd1, sint, tau);
    result(2,i) = ApEn(m,r*sd2,chirpt, tau);
    result(3,i) = ApEn(m,r*sd3,whitet, tau);
end

r = 0.02*(1:rnum);
plot(r,result(1,:),'o-',r,result(2,:),'o-',r,result(3,:),'o-')
axis([0 rnum*0.02 0 1.05*max(result(:))])
legend('sin','chirp','white noise')
title(['ApEn, m=' num2str(m) ', \tau=' num2str(tau)],'fontsize',14)
xlabel r


function a = clement1 ( n )

%*****************************************************************************80
%
%% CLEMENT1 returns the CLEMENT1 matrix.
%
%  Formula:
%
%    if ( J = I+1 )
%      A(I,J) = sqrt(I*(N-I))
%    else if ( I = J+1 )
%      A(I,J) = sqrt(J*(N-J))
%    else
%      A(I,J) = 0
%
%  Example:
%
%    N = 5
%
%       .    sqrt(4)    .       .       .
%    sqrt(4)    .    sqrt(6)    .       .
%       .    sqrt(6)    .    sqrt(6)    .
%       .       .    sqrt(6)    .    sqrt(4)
%       .       .       .    sqrt(4)    .
%
%  Properties:
%
%    A is tridiagonal.
%
%    A is banded, with bandwidth 3.
%
%    Because A is tridiagonal, it has property A (bipartite).
%
%    A is symmetric: A' = A.
%
%    Because A is symmetric, it is normal.
%
%    Because A is normal, it is diagonalizable.
%
%    A is persymmetric: A(I,J) = A(N+1-J,N+1-I).
%
%    The diagonal of A is zero.
%
%    A is singular if N is odd.
%
%    About 64 percent of the entries of the inverse of A are zero.
%
%    The eigenvalues are plus and minus the numbers
%
%      N-1, N-3, N-5, ..., (1 or 0).
%
%    If N is even,
%
%      det ( A ) = (-1)^(N/2) * (N-1) * (N+1)^(N/2)
%
%    and if N is odd,
%
%      det ( A ) = 0
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    01 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Paul Clement,
%    A class of triple-diagonal matrices for test purposes,
%    SIAM Review,
%    Volume 1, 1959, pages 50-52.
%
%  Parameters:
%
%    Input, integer N, the order of A.
%
%    Output, real A(N,N), the matrix.
%
  for i = 1 : n
    for j = 1 : n

      if ( j == i + 1 )
        a(i,j) = sqrt ( i * ( n - i ) );
      elseif ( i == j + 1 )
        a(i,j) = sqrt ( j * ( n - j ) );
      else
        a(i,j) = 0.0;
      end

    end
  end

  return
end


% Computes log(besseli(0,x)) robustly.  Computing it directly causes
% numerical problems at high x, but the function has asymptotic linear
% behaviour, which we approximate here for high x.
%
% author: Daniel C Alexander (d.alexander@ucl.ac.uk)
%

function lb0 = logbesseli0(x)

% For very large arguments to besseli, we approximate log besseli using a
% linear model of the asymptotic behaviour.
% The linear parameters come from this command:
% app=regress(log(besseli(0,500:700))',[ones(201,1) (500:700)']);
app = [-3.61178295877576 0.99916157999904];

lb0 = zeros(length(x), 1);
exact = find(x<700);
approx = find(x>=700);
lb0(exact) = log(besseli(0, x(exact)));
%lb0(approx) = x(approx)*app(2) + app(1);

% This is a more standard approximation.  For large x, I_0(x) -> exp(x)/sqrt(2 pi x).
lb0(approx) = x(approx) - log(2*pi*x(approx))/2;


function Ahat = nearestSPD(A)
% nearestSPD - the nearest (in Frobenius norm) Symmetric Positive Definite matrix to A
% usage: Ahat = nearestSPD(A)
%
% From Higham: "The nearest symmetric positive semidefinite matrix in the
% Frobenius norm to an arbitrary real matrix A is shown to be (B + H)/2,
% where H is the symmetric polar factor of B=(A + A')/2."
%
% http://www.sciencedirect.com/science/article/pii/0024379588902236
%
% arguments: (input)
%  A - square matrix, which will be converted to the nearest Symmetric
%    Positive Definite Matrix.
%
% Arguments: (output)
%  Ahat - The matrix chosen as the nearest SPD matrix to A.

if nargin ~= 1
  error('Exactly one argument must be provided.')
end

% test for a square matrix A
[r,c] = size(A);
if r ~= c
  error('A must be a square matrix.')
elseif (r == 1) && (A <= 0)
  % A was scalar and non-positive, so just return eps
  Ahat = eps;
  return
end

% symmetrize A into B
B = (A + A')/2;

% Compute the symmetric polar factor of B. Call it H.
% Clearly H is itself SPD.
[U,Sigma,V] = svd(B);
H = V*Sigma*V';

% get Ahat in the above formula
Ahat = (B+H)/2;

% ensure symmetry
Ahat = (Ahat + Ahat')/2;

% test that Ahat is in fact PD. if it is not so, then tweak it just a bit.
p = 1;
k = 0;
while p ~= 0
  [R,p] = chol(Ahat);
  k = k + 1;
  if p ~= 0
    % Ahat failed the chol test. It must have been just a hair off,
    % due to floating point trash, so it is simplest now just to
    % tweak by adding a tiny multiple of an identity matrix.
    mineig = min(eig(Ahat));
    Ahat = Ahat + (-mineig*k.^2 + eps(mineig))*eye(size(A));
  end
end


function numgrad = computeNumericalGradient(J, theta)
% numgrad = computeNumericalGradient(J, theta)
% theta: a vector of parameters
% J: a function that outputs a real-number. Calling y = J(theta) will return the
% function value at theta.

% Initialize numgrad with zeros   2x1  这是输入X的行数，其实也就是参数W的个数
numgrad = zeros(size(theta));

%% ---------- YOUR CODE HERE --------------------------------------
% Instructions:
% Implement numerical gradient checking, and return the result in numgrad.
% (See Section 2.3 of the lecture notes.)
% You should write code so that numgrad(i) is (the numerical approximation to) the
% partial derivative of J with respect to the i-th input argument, evaluated at theta.
% I.e., numgrad(i) should be the (approximately) the partial derivative of J with
% respect to theta(i).
%
% Hint: You will probably want to compute the elements of numgrad one at a time.

epsilon = 0.000001;
% 2 x2  得到参数的个数
numW = size(theta,1);
I = eye(numW);
I =  I * epsilon;
for j = 1:numW
    numgrad(j) = (J(theta+I(:,j)) - J(theta-I(:,j))) / (2 * epsilon);
end

%% ---------------------------------------------------------------
end


function [I J] = itril(sz, k)
% function [I J] = itril(sz, k) % OR
% I = itril(sz, k)
%
% Return the subindices [I J] (or linear indices I if single output call)
% in the purpose of extracting an lower triangular part of the matrix of
% the size SZ. Input k is optional shifting. For k=0, extract from the main
% diagonal. For k>0 -> above the diagonal, k<0 -> below the diagonal
%
% This returnd same as [...] = find(tril(ones(sz),k))
% - Output is a column and sorted with respect to linear indice
% - No intermediate matrix is generated, that could be useful for large
%   size problem
% - Mathematically, A(itril(size(A)) is called (lower) "half-vectorization"
%   of A
%
% Example:
%
% A = [ 7     5     4
%       4     2     3
%       9     1     9
%       3     5     7 ]
%
% I = itril(size(A))  % gives [1 2 3 4 6 7 8 11 12]'
% A(I)                % gives [7 4 9 3 2 1 5  9  7]' OR A(tril(A)>0)
%
% Author: Bruno Luong <brunoluong@yahoo.com>
% Date: 21/March/2009

if isscalar(sz)
    sz = [sz sz];
end
m=sz(1);
n=sz(2);

% Main diagonal by default
if nargin<2
    k=0;
end

nc = min(n,m+k); % number of columns of the triangular part
lo = max((1:nc).'-k,1); % lower row indice for each column
hi = m + zeros(nc,1); % upper row indice for each column

if isempty(lo)
    I = zeros(0,1);
    J = zeros(0,1);
else
    c=cumsum([0; hi-lo]+1); % cumsum of the length
    I = accumarray(c(1:end-1), (lo-[0; hi(1:end-1)]-1), ...
                   [c(end)-1 1]);
    I = cumsum(I+1); % row indice
    J = cumsum(accumarray(c,1));
    J = J(1:end-1); % column indice
end

if nargout<2
    % convert to linear indices
    I = sub2ind([m n], I, J);
end

end % itril


function result = polygon_integral_yy ( n, v )

%*****************************************************************************80
%
%% POLYGON_INTEGRAL_YY integrates the function Y*Y over a polygon.
%
%  Discussion:
%
%    The polygon is bounded by the points (X(1:N), Y(1:N)).
%
%    INTEGRAL = (1/12) * sum ( 1 <= I <= N )
%      - ( Y(I)^3 + Y(I)^2 * Y(I-1) + Y(I) * Y(I-1)^2 + Y(I-1)^3 )
%      * ( X(I) - X(I-1) )
%
%    where X(0) and Y(0) should be replaced by X(N) and Y(N).
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    03 March 2005
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    S F Bockman,
%    Generalizing the Formula for Areas of Polygons to Moments,
%    American Mathematical Society Monthly,
%    1989, pages 131-132.
%
%  Parameters:
%
%    Input, integer N, the number of vertices of the polygon.
%    N should be at least 3 for a nonzero result.
%
%    Input, real V(2,N), the coordinates of the vertices
%    of the polygon.  These vertices should be given in
%    counter-clockwise order.
%
%    Output, real RESULT, the value of the integral.
%
  result = 0.0;

  if ( n < 3 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'POLYGON_INTEGRAL_YY - Warning!\n' );
    fprintf ( 1, '  The number of polygonal vertices must be\n' );
    fprintf ( 1, '  at least 3, but the input polygon has N = %d\n', n );
    error ( 'POLYGON_INTEGRAL_YY - Warning!' );
  end

  for i = 1 : n

    if ( i == 1 )
      im1 = n;
    else
      im1 = i - 1;
    end

    result = result - ( v(2,i).^3 + v(2,i).^2 * v(2,im1) ...
      + v(2,i) * v(2,im1).^2 + v(2,im1).^3 ) * ( v(1,i) - v(1,im1) );

  end

  result = result / 12.0;

  return
end


function x=pentsolve(A,b)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% pentsolve.m
%
% Solve a pentadiagonal system Ax=b where A is a strongly nonsingular matrix
%
% If A is not a pentadiagonal matrix, results will be wrong
%
% Reference: G. Engeln-Muellges, F. Uhlig, "Numerical Algorithms with C"
%               Chapter 4. Springer-Verlag Berlin (1996)
%
% Written by Greg von Winckel 3/15/04
% Contact: gregvw@chtm.unm.edu
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

[M,N]=size(A);

% Check dimensions
if M~=N
    error('Matrix must be square');
    return;
end

if length(b)~=M
    error('Matrix and vector must have the same number of rows');
    return;
end

x=zeros(N,1);

% Check for symmetry
if A==A'    % Symmetric Matrix Scheme

    % Extract bands
    d=diag(A);
    f=diag(A,1);
    e=diag(A,2);

    alpha=zeros(N,1);
    gamma=zeros(N-1,1);
    delta=zeros(N-2,1);
    c=zeros(N,1);
    z=zeros(N,1);

    % Factor A=LDL'
    alpha(1)=d(1);
    gamma(1)=f(1)/alpha(1);
    delta(1)=e(1)/alpha(1);

    alpha(2)=d(2)-f(1)*gamma(1);
    gamma(2)=(f(2)-e(1)*gamma(1))/alpha(2);
    delta(2)=e(2)/alpha(2);

    for k=3:N-2
        alpha(k)=d(k)-e(k-2)*delta(k-2)-alpha(k-1)*gamma(k-1)^2;
        gamma(k)=(f(k)-e(k-1)*gamma(k-1))/alpha(k);
        delta(k)=e(k)/alpha(k);
    end

    alpha(N-1)=d(N-1)-e(N-3)*delta(N-3)-alpha(N-2)*gamma(N-2)^2;
    gamma(N-1)=(f(N-1)-e(N-2)*gamma(N-2))/alpha(N-1);
    alpha(N)=d(N)-e(N-2)*delta(N-2)-alpha(N-1)*gamma(N-1)^2;

    % Update Lx=b, Dc=z

    z(1)=b(1);
    z(2)=b(2)-gamma(1)*z(1);

    for k=3:N
        z(k)=b(k)-gamma(k-1)*z(k-1)-delta(k-2)*z(k-2);
    end

    c=z./alpha;

    % Backsubstitution L'x=c
    x(N)=c(N);
    x(N-1)=c(N-1)-gamma(N-1)*x(N);

    for k=N-2:-1:1
        x(k)=c(k)-gamma(k)*x(k+1)-delta(k)*x(k+2);
    end

else        % Non-symmetric Matrix Scheme

    % Extract bands
    d=diag(A);
    e=diag(A,1);
    f=diag(A,2);
    h=[0;diag(A,-1)];
    g=[0;0;diag(A,-2)];

    alpha=zeros(N,1);
    gam=zeros(N-1,1);
    delta=zeros(N-2,1);
    bet=zeros(N,1);

    c=zeros(N,1);
    z=zeros(N,1);

    % Factor A=LR
    alpha(1)=d(1);
    gam(1)=e(1)/alpha(1);
    delta(1)=f(1)/alpha(1);
    bet(2)=h(2);
    alpha(2)=d(2)-bet(2)*gam(1);
    gam(2)=( e(2)-bet(2)*delta(1) )/alpha(2);
    delta(2)=f(2)/alpha(2);

    for k=3:N-2
        bet(k)=h(k)-g(k)*gam(k-2);
        alpha(k)=d(k)-g(k)*delta(k-2)-bet(k)*gam(k-1);
        gam(k)=( e(k)-bet(k)*delta(k-1) )/alpha(k);
        delta(k)=f(k)/alpha(k);
    end

    bet(N-1)=h(N-1)-g(N-1)*gam(N-3);
    alpha(N-1)=d(N-1)-g(N-1)*delta(N-3)-bet(N-1)*gam(N-2);
    gam(N-1)=( e(N-1)-bet(N-1)*delta(N-2) )/alpha(N-1);
    bet(N)=h(N)-g(N)*gam(N-2);
    alpha(N)=d(N)-g(N)*delta(N-2)-bet(N)*gam(N-1);

    % Update b=Lc
    c(1)=b(1)/alpha(1);
    c(2)=(b(2)-bet(2)*c(1))/alpha(2);

    for k=3:N
        c(k)=( b(k)-g(k)*c(k-2)-bet(k)*c(k-1) )/alpha(k);
    end

    % Back substitution Rx=c
    x(N)=c(N);
    x(N-1)=c(N-1)-gam(N-1)*x(N);

    for k=N-2:-1:1
        x(k)=c(k)-gam(k)*x(k+1)-delta(k)*x(k+2);
    end

end


function [ lam, mu ] = cycle_floyd ( f, x0 )

%*****************************************************************************80
%
%% CYCLE_FLOYD finds a cycle in an iterated mapping using Floyd's method.
%
%  Discussion:
%
%    Suppose we a repeatedly apply a function f(), starting with the argument
%    x0, then f(x0), f(f(x0)) and so on.  Suppose that the range of f is finite.
%    Then eventually the iteration must reach a cycle.  Once the cycle is reached,
%    succeeding values stay within that cycle.
%
%    Starting at x0, there is a "nearest element" of the cycle, which is
%    reached after MU applications of f.
%
%    Once the cycle is entered, the cycle has a length LAM, which is the number
%    of steps required to first return to a given value.
%
%    This function uses Floyd's method to determine the values of MU and LAM,
%    given F and X0.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    17 June 2012
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Donald Knuth,
%    The Art of Computer Programming,
%    Volume 2, Seminumerical Algorithms,
%    Third Edition,
%    Addison Wesley, 1997,
%    ISBN: 0201896842,
%    LC: QA76.6.K64.
%
%  Parameters:
%
%    Input, integer F( integer I ), the name of the function
%    to be analyzed.
%
%    Input, integer X0, the starting point.
%
%    Output, integer LAM, the length of the cycle.
%
%    Output, integer MU, the index in the sequence starting
%    at X0, of the first appearance of an element of the cycle.
%
  tortoise = f ( x0 );
  hare = f ( tortoise );

  while ( tortoise ~= hare )
    tortoise = f ( tortoise );
    hare = f ( f ( hare ) );
  end

  mu = 0;
  tortoise = x0;

  while ( tortoise ~= hare )
    tortoise = f ( tortoise );
    hare = f ( hare );
    mu = mu + 1;
  end

  lam = 1
  hare = f ( tortoise )
  while ( tortoise ~= hare )
    hare = f ( hare );
    lam = lam + 1;
  end

  return
end


function [auc,fpr,tpr] = fastAUC(labels,scores,plot_flag)
% function [auc,fpr,tpr] = myauc(labels,scores,plot_flag)
%
% This function calculates m AUC values for m ranked lists.
% n is the number of ranked items.
% m is the number of different rankings.
%
% Input:  labels is nXm binary logical.
%         scores is nXm real. For a high AUC the higher scores should have
%         labels==1.
%         plot_flag: binary flag, if TRUE then m ROC curves will be plotted
%         (default FALSE).
%
% Output: auc is mX1 real, the Area Under the ROC curves.
%         fpr is nXm real, the false positive rates.
%         tpr is nXm real, the true positive rates.

if ~exist('plot_flag','var')
    plot_flag = 0;
end
if ~islogical(labels)
    error('labels input should be logical');
end
if ~isequal(size(labels),size(scores))
    error('labels and scores should have the same size');
end
[n,m] = size(labels);
num_pos = sum(labels);
if any(num_pos==0)
    error('no positive labels entered');
end
if any(num_pos==n)
    error('no negative labels entered');
end

[~,scores_si] = sort(scores,'descend');
clear scores
scores_si_reindex = scores_si+ones(n,1)*(0:m-1)*n;
l = labels(scores_si_reindex);
clear scores_si labels

tp = cumsum(l==1,1);
fp = repmat((1:n)',[1 m])-tp;

num_neg = n-num_pos;
fpr = bsxfun(@rdivide,fp,num_neg); %False Positive Rate
tpr = bsxfun(@rdivide,tp,num_pos); %True Positive Rate

%Plot the ROC curve
if plot_flag==1
    plot(fpr,tpr);
    xlabel('False Positive');
    ylabel('True Positive');
end

auc = sum(tpr.*[(diff(fp)==1); zeros(1,m)])./num_neg;


function j = jacobi_symbol ( q, p )

%*****************************************************************************80
%
%% JACOBI_SYMBOL evaluates the Jacobi symbol (Q/P).
%
%  Discussion:
%
%    If P is prime, then
%
%      Jacobi Symbol (Q/P) = Legendre Symbol (Q/P)
%
%    Else
%
%      let P have the prime factorization
%
%        P = Product ( 1 <= I <= N ) P(I)**E(I)
%
%      Jacobi Symbol (Q/P) =
%
%        Product ( 1 <= I <= N ) Legendre Symbol (Q/P(I))**E(I)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    31 May 2008
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Daniel Zwillinger,
%    CRC Standard Mathematical Tables and Formulae,
%    30th Edition,
%    CRC Press, 1996, pages 86-87.
%
%  Parameters:
%
%    Input, integer Q, an integer whose Jacobi symbol with
%    respect to P is desired.
%
%    Input, integer P, the number with respect to which the Jacobi
%    symbol of Q is desired.  P should be 2 or greater.
%
%    Output, integer J, the Jacobi symbol (Q/P).
%    Ordinarily, J will be -1, 0 or 1.
%    -2, not enough factorization space.
%    -3, an error during Legendre symbol calculation.
%

%
%  P must be greater than 1.
%
  if ( p <= 1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'JACOBI_SYMBOL - Fatal error!\n' );
    fprintf ( 1, '  P must be greater than 1.\n' );
    l = -2;
    return
  end
%
%  Decompose P into factors of prime powers.
%
  [ nfactor, factor, power, nleft ] = i4_factor ( p );

  if ( nleft ~= 1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'JACOBI_SYMBOL - Fatal error!\n' );
    fprintf ( 1, '  Not enough factorization space.\n' );
    j = -2;
    error ( 'JACOBI_SYMBOL - Fatal error!' );
  end
%
%  Force Q to be nonnegative.
%
  qq = q;

  while ( qq < 0 )
    qq = qq + p;
  end
%
%  For each prime factor, compute the Legendre symbol, and
%  multiply the Jacobi symbol by the appropriate factor.
%
  j = 1;
  for i = 1 : nfactor
    pp = factor(i);
    l = legendre_symbol ( qq, pp );
    if ( l < -1 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'JACOBI_SYMBOL - Fatal error!\n' );
      fprintf ( 1, '  Error during Legendre symbol calculation.\n' );
      j = -3;
      error ( 'JACOBI_SYMBOL - Fatal error!' );
    end
    j = j * l^power(i);
  end

  return
end


function [ x, seed ] = r4_normal_01 ( seed )

%*****************************************************************************80
%
%% R4_NORMAL_01 returns a unit pseudonormal R4.
%
%  Discussion:
%
%    The standard normal probability distribution function (PDF) has
%    mean 0 and standard deviation 1.
%
%    The Box-Muller method is used, which is efficient, but
%    generates two values at a time.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 August 2013
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer SEED, a seed for the random number generator.
%
%    Output, real X, a sample of the standard normal PDF.
%
%    Output, integer SEED, an updated seed for the random number generator.
%
  [ r1, seed ] = r4_uniform_01 ( seed );
  [ r2, seed ] = r4_uniform_01 ( seed );
  x = sqrt ( -2.0 * log ( r1 ) ) * cos ( 2.0 * pi * r2 );

  return
end


function [q, pval] = ljungbox(data, lags)
% Ljung-Box tests for the presence of serial correlation in up to q lags.  Returns LAGS Ljung-Box
% statistics tests, one for tests for each lag between 1 and LAGS. Under the null of no serial
% correlation and assuming homoskedasticity, the Ljung-Box test statistic is asymptotically
% distributed X2(q)
%
% USAGE:
%  [Q,PVAL] = ljungbox(DATA,LAGS)
%
% INPUTS:
%  DATA      - A T by 1 vector of data
%  LAGS      - The maximum number of lags to compute the LB.  The statistic and pval will be
%                returned for all sets of lags up to and including LAGS
%
% OUTPUTS:
%  Q         - A LAGS by 1 vector of Q statistics
%  PVAL      - A LAGS by 1 set of appropriate pvals
%
% COMMENTS:
%  This test statistic is common but often inappropriate since it assumes homoskedasticity.  For a
%  heteroskedasticity consistent serial correlation test, see lmtest1
%
% SEE ALSO:
%  LMTEST1, SACF, SPACF

% Copyright: Kevin Sheppard
% kevin.sheppard@economics.ox.ac.uk
% Revision: 3    Date: 1/1/2007

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Input Checking
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
if nargin~=2
    error('2 inputs required.')
end
T=length(data);
if T<=lags
    error('At least LAGS observations requires')
end
if size(data,1)~=T,
    data=data';
end
if size(data,2)~=1
    error('DATA must be a column vector')
end
if ~isscalar(lags) && lags>0 && floor(lags)==lags
    error('LAGS must be a positive integer')
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Input Checking
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

ac = sacf(data,lags,0,0);

q = zeros(lags,1);
T = length(data);
for L=1:lags
    q(L)=T*(T+2)*sum(ac(1:L).^2./(T-(1:L)'));
end
pval = 1 - chi2cdf(q,(1:lags)');


function s = Simpson2(a, b)
%% Simpson Rule for a prestablished f(x)
% a: is the lower limit of integration
% b: is the upper limit of integration
% for this excersice f(x)=x^2

h=(b-a)/4;
x(1)=a;
x(2)=a+(b-a)*1/4;
x(3)=a+(b-a)*1/2;
x(4)=a+(b-a)*3/4;
x(5)=b;

f(1)=myfunction(x(1));
f(2)=myfunction(x(2));
f(3)=myfunction(x(3));
f(4)=myfunction(x(4));
f(5)=myfunction(x(5));

s=h/3*sum([1 4 2 4 1].*f);


function [P L U Q]=GaElCoPi(A)

%Gaussian Elimination with Complete Pivoting
%version 1.0

%P*A*Q=L*U
%Alvaro Moraes
%KAUST 2009

%Example of usage:
%A=randn(40);
%[P L U Q]=GaElCoPi(A);
%norm(P*A*Q-L*U)

% or this (it takes some time)
% choose the size of A and
% the number of simulations
% for k=1:1000
%  k
%  A=randn(128);
%  [P L U Q]=GaElCoPi(A);
%  N1(k) =norm(P*A*Q-L*U);
%  %compute the growth factor
%  %rho(k)=max(max(abs(U)))/max(max(abs(A)))
% end
% plot(N1)
% max(abs(N1)) %must be small xxe-014

%and also check the worst scenario for the Partial Pivoting:
% m=128; %(matrix 22.4 from Trefethen and Baum)
% A=-1*tril(ones(m))+2*eye(m);
% A(:,m)=ones(m,1);
%[P L U Q]=GaElCoPi(A);
%norm(P*A*Q-L*U)

[n n]=size(A);
L=zeros(n);
%v and w record the permutations
%of the rows and cols respect.
v=1:n; w=1:n;

for k=1:n-1
     %in the next three lines
     %we obtain  the max of abs(A(v(k:n),w(k:n)))
     %and its coordinates (imr,imc)
     [m,mc]=max(abs(A(v(k:n),w(k:n))));
     [m,c]=max(m);
     imc=c; imr=mc(c);
     %next we transform this coordinates to the
     %coordinates of A
     imr=imr+k-1;
     imc=imc+k-1;
     %now, we perform the permutations
     v([k imr])=v([imr k]);
     w([k imc])=w([imc k]);
     %next, the gaussian elimination step
    for i=k+1:n
        L(v(i),w(k))=A(v(i),w(k))/A(v(k),w(k));
        A(v(i),:)=A(v(i),:)-L(v(i),w(k))*A(v(k),:);
    end
end
%by last, we use v and w to define P, Q, L and U
P=eye(n);P=P(v,:);
Q=eye(n);Q=Q(:,w);
L=L(v,w)+ eye(n);
U=A(v,w);


function[fs]=morsespace(varargin)
%MORSESPACE  Logarithmically-spaced frequencies for generalized Morse wavelets.
%
%   F=MORSESPACE(GAMMA,BETA,N) generates a frequency array for the
%   generalized Morse wavelet transform of an N-point time series. The
%   wavelets are specified by GAMMA and BETA.
%
%   LOG(F) is uniformly spaced, following convention for wavelet analysis.
%
%   F has units of *radians* per sample point, and is a column vector with
%   the frequencies arranged in decending order.
%
%   In this usage, the frequencies F are determined using default settings,
%   described below, which should be appropriate for most applications.
%
%   Additional control over the frequency array F can be obtained using the
%   following alternate usages.
%
%   For details on this calculation, see Lilly (2016).
%   __________________________________________________________________
%
%   High- and low-frequency specification
%
%   F=MORSESPACE(GAMMA,BETA,HIGH,LOW) explicitly sets the high-frequency
%   and low-frequency cutoffs for the frequency array.
%
%   The first (largest) value of F is then just smaller than HIGH and the
%   smallest is just larger than LOW.
%
%   HIGH and LOW have units of *radian* per unit sample point.
%   __________________________________________________________________
%
%   High-frequency cutoff
%
%   The highest frequency can be set to be the minimum of a specified value
%   and a cutoff frequency based on a Nyquist overlap condition.
%
%   F=MORSESPACE(GAMMA,BETA,{ETA,HIGH},LOW) sets the highest frequency
%   to be the minimum of the specified value HIGH, and the largest
%   frequency for which the wavelet will satisfy the threshold level ETA.
%
%   Here ETA be a number between zero and one specifying the ratio of a
%   frequency-domain wavelet at the Nyquist frequency to its peak value.
%
%   Note that in this usage, {ETA,HIGH} is a cell array with two entries.
%
%   The simplified usage F=MORSESPACE(GAMMA,BETA,N) corresponds to the
%   choice ETA=0.1, so that by default, the highest-frequency wavelet
%   will decay to at least 10% of its peak value at the Nyquist frequency.
%   __________________________________________________________________
%
%   Low-frequency cutoff
%
%   The lowest frequency can be set to a cutoff frequency based on an
%   endpoint overlap condition.
%
%   F=MORSESPACE(GAMMA,BETA,HIGH,{P,N}) sets the lowest frequency such that
%   the lowest-frequency wavelet will reach some number P times its central
%   window width at the ends of the time series.
%
%   P is called the packing number.  A choice of P=1 corresponds to
%   roughly 95% of the time-domain wavelet energy being contained within
%   the time series endpoints for a wavelet at the center of the domain.
%
%   F=MORSESPACE(GAMMA,BETA,HIGH,{P,N,LOW}) alternately chooses the maximum
%   of the R-level cutoff frequency, and a specified low frequency LOW.
%
%   The simplified usage F=MORSESPACE(GAMMA,BETA,N) corresponds to the
%   default value P=5.  At the lowest frequency, five wavelets will then
%   fit into the time series, with 5% energy overlap between them.
%   __________________________________________________________________
%
%   Wavelet density
%
%   F=MORSESPACE(GAMMA,BETA,HIGH,LOW,D) controls the number of points in
%   the frequency array through the 'density' D.
%
%   Higher values of D mean more overlap in the frequency domain. The
%   default value of the density is D=4.
%
%   When D=1, the peak of one wavelet is located at the half-power points
%   of the adjacent wavelet. D=4 means that four other wavelets will occur
%   between the peak of one wavelet and its half-power point.
%   __________________________________________________________________
%
%   See also MORSEWAVE, WAVETRANS.
%
%   Usage: f=morsespace(ga,be,N);
%          f=morsespace(ga,be,high,low,D);
%          f=morsespace(ga,be,{eta,high},low,D);
%          f=morsespace(ga,be,{eta,high},{p,N},D);
%          f=morsespace(ga,be,{eta,high},{p,N,low},D);
%   __________________________________________________________________
%   This is part of JLAB --- type 'help jlab' for more information
%   (C) 2009--2016 J.M. Lilly --- type 'help jlab_license' for details

%   Note then when HIGH and LOW are explicitly input, the time series
%   length N is no longer input as the first argument.

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

if strcmpi(varargin{1},'--f')
  type makefigs_morsespace;
  makefigs_morsespace
  return
end

%/***************************************************************
%Sort out input arguments
% if ischar(varargin{end})
%     str=varargin{end};
%     varargin=varargin(1:end-1);
% else
%     str='peak';
% end

ga=varargin{1};
be=varargin{2};
D=4;

if length(varargin)==3
    N=varargin{3};

    %Default choices
    low={5,N};
    high={0.1,pi};
else
    high=varargin{3};
    low=varargin{4};
    if length(varargin)==5
        D=varargin{5};
    end
end

%\***************************************************************

if iscell(high)
    %Recall pi is Nyquist
    high=min(high{2},morsehigh(ga,be,high{1}));
    %high
end

if iscell(low)
    if length(low)==2
        low{3}=0;
    end
    low=max(low{3},morsespace_low(ga,be,low{1},low{2}));
end

r=1+frac(1,D*morseprops(ga,be));
N=floor(frac(log(frac(high,low)),log(r)));
fs=high*ones(N+1,1)./r.^[0:N]';

% if length(fs)>1000
%     warning('F is longer than 1000 points... ')
% end

% if strfind(str,'ene')
%      [fm,fe,fi] = morsefreq(ga,be);
%      fs=frac(fe,fm).*fs;
% end

function[fmin]=morsespace_low(ga,be,r,N)

p=morseprops(ga,be);
fmin=frac(2*sqrt(2)*p*r,N);

function[]=morsespace_test
morsespace_hightest;
morsespace_lowtest;

function[]=morsespace_hightest
%Test for high-frequncy cutoff

ga=3;
be=4;
eta=0.1;
ompeak=morsefreq(ga,be);
N=100;

dom=ompeak/N+zeros(4*N,1);
om=cumsum(dom,1);

%morse=frac(1,2)*morseafun(ga,be).*(om.^be).*exp(-om.^ga);

fhigh=morsehigh(ga,be,eta);
[psi,morse] = morsewave(10000,ga,be,fhigh);
reporttest('MORSESPACE high-frequency cutoff',aresame(morse(end/2)./2,eta,1e-3))

function[]=morsespace_lowtest
%Test for low-frequency cutoff

N=1001;
ga1=(1/3:1:11);
be1=(1:1:10);
%ga1=(1/3:.5:11);
%be1=(1:.5:10);

[ga,be]=meshgrid(ga1,be1);
vcolon(ga,be);
[a,sigt,sigo]=morsebox(ga,be);

psi=zeros(N,length(ga));
for i=1:length(ga)
    fs{i}=morsespace(ga(i),be(i),{0.95,pi},{1,N/10},4);
    psi(:,i)=morsewave(N,ga(i),be(i),fs{i}(end),'energy');
end
%figure,plot(sum(squared(psi((end+1)/2-50:(end+1)/2+50,:)),1))
bool=aresame(median(sum(squared(psi((end+1)/2-50:(end+1)/2+50,:)))),0.95,0.01);

reporttest('MORSESPACE low-frequency cutoff, P approximates 95% energy',bool)

%fs=morsespace(2,2,10000);
%psi=morsewave(10000,2,2,fs(end),'energy');
%Can make a figure with the wavelet shifted by 2000 points each time


function [ value, en ] = wew_a ( x )

%*****************************************************************************80
%
%% WEW_A estimates Lambert's W function.
%
%  Discussion:
%
%    For a given X, this routine estimates the solution W of Lambert's
%    equation:
%
%      X = W * EXP ( W )
%
%    This routine has higher accuracy than WEW_B.
%
%  Modified:
%
%    11 June 2014
%
%  Reference:
%
%    Fred Fritsch, R Shafer, W Crowley,
%    Algorithm 443: Solution of the transcendental equation w e^w = x,
%    Communications of the ACM,
%    October 1973, Volume 16, Number 2, pages 123-124.
%
%  Parameters:
%
%    Input, real X, the argument of W(X)
%
%    Output, real VALUE, the estimated value of W(X).
%
%    Output, real EN, the last relative correction to W(X).
%
  c1 = 4.0 / 3.0;
  c2 = 7.0 / 3.0;
  c3 = 5.0 / 6.0;
  c4 = 2.0 / 3.0;
%
%  Initial guess.
%
  f = log ( x );

  if ( x <= 6.46 )

    wn = x .* ( 1.0 + c1 * x ) ./ ( 1.0 + x .* ( c2 + c3 * x ) );
    zn = f - wn - log ( wn );

  else

    wn = f;
    zn = - log ( wn );

  end
%
%  Iteration 1.
%
  temp = 1.0 + wn;
  y = 2.0 * temp .* ( temp + c4 * zn ) - zn;
  wn = wn .* ( 1.0 + zn .* y ./ ( temp .* ( y - zn ) ) );
%
%  Iteration 2.
%
  zn = f - wn - log ( wn );
  temp = 1.0 + wn;
  temp2 = temp + c4 * zn;
  en = zn .* temp2 ./ ( temp .* temp2 - 0.5 * zn );
  wn = wn .* ( 1.0 + en );

  value = wn;

  return
end


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

for i=1:length(X)
    distance = inf;
    for j=1:K
        kDist = norm(X(i, :) - centroids(j, :));
        if (kDist < distance)
            distance = kDist;
            idx(i) = j;
        end
    end
end

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

end