function [D]=d2a1(A,B)
%D2A1 Pairwise squared L2 distance along 1st axis.
% D = D2A1(A,B) Computes squared L2 (Euclidean) distance
% between all pairs of d-dimensional points in A and B.
%
% Inputs:
% A - d-by-m matrix of m d-dimensional points;
% B - d-by-n matrix of n d-dimensional points.
%
% Outputs:
% D - m-by-n matrix of pairwise distances.
%
% See also D2A2.

if nargin < 2
    D = full(A'*A);
    d = diag(D);
    D = bsxfun(@minus, d, 2*D);
    D = bsxfun(@plus, d', D);
    D = max(D, 0);
else
    D = full(A'*B);
    D = bsxfun(@minus, sum(B.^2,1), 2*D);
    D = bsxfun(@plus, sum(A.^2,1)', D);
    D = max(D, 0);
end


%% Sobel Derivatives
%
% In this demo, we show how to:
%
% * Use the OpenCV function |cv.Sobel| to calculate the derivatives of an
%   image
% * Use the OpenCV function |cv.Scharr| to calculate a more accurate
%   derivative for a kernel of size 3x3
%
% Sources:
%
% * <https://docs.opencv.org/3.2.0/d2/d2c/tutorial_sobel_derivatives.html>
% * <https://github.com/opencv/opencv/blob/3.2.0/samples/cpp/tutorial_code/ImgTrans/Sobel_Demo.cpp>
%

%% Theory
%
% NOTE: The explanation below belongs to the book *Learning OpenCV* by
% Bradski and Kaehler.
%
% We have previously seen applicative examples of convolutions. One of the
% most important convolutions is the computation of derivatives in an image
% (or an approximation to them). Why may be important the calculus of the
% derivatives in an image? Let's imagine we want to detect the _edges_ present
% in the image. For instance:
%
% <<https://docs.opencv.org/3.2.0/Sobel_Derivatives_Tutorial_Theory_0.jpg>>
%
% You can easily notice that in an _edge_, the pixel intensity _changes_ in a
% notorious way. A good way to express _changes_ is by using _derivatives_. A
% high change in gradient indicates a major change in the image.
%
% To be more graphical, let's assume we have a 1D-image. An edge is shown by
% the "jump" in intensity in the plot below:
%
% <<https://docs.opencv.org/3.2.0/Sobel_Derivatives_Tutorial_Theory_Intensity_Function.jpg>>
%
% The edge "jump" can be seen more easily if we take the first derivative
% (actually, here appears as a maximum)
%
% <<https://docs.opencv.org/3.2.0/Sobel_Derivatives_Tutorial_Theory_dIntensity_Function.jpg>>
%
% So, from the explanation above, we can deduce that a method to detect edges
% in an image can be performed by locating pixel locations where the gradient
% is higher than its neighbors (or to generalize, higher than a threshold).
%
%% Sobel Operator
%
% The Sobel Operator is a discrete differentiation operator. It computes an
% approximation of the gradient of an image intensity function. The Sobel
% Operator combines Gaussian smoothing and differentiation.
%
% Assuming that the image to be operated is $I$, we calculate two derivatives:
%
% * *Horizontal changes*: This is computed by convolving $I$ with a kernel
%   $G_{x}$ with odd size. For example for a kernel size of 3, $G_{x}$ would
%   be computed as:
%
% $$G_{x} = \left[{\matrix{
%               -1 & 0 & +1 \cr
%               -2 & 0 & +2 \cr
%               -1 & 0 & +1
%           }}\right] * I$$
%
% * *Vertical changes*: This is computed by convolving $I$ with a kernel
%   $G_{y}$ with odd size. For example for a kernel size of 3, $G_{y}$ would
%   be computed as:
%
% $$G_{y} = \left[{\matrix{
%               -1 & -2 & -1 \cr
%                0 &  0 &  0 \cr
%               +1 & +2 & +1
%           }}\right] * I$$
%
% At each point of the image we calculate an approximation of the _gradient_
% in that point by combining both results above:
%
% $$G = \sqrt{ G_{x}^{2} + G_{y}^{2} }$$
%
% Although sometimes the following simpler equation is used:
%
% $$G = |G_{x}| + |G_{y}|$$
%
% Note: When the size of the kernel is |3|, the Sobel kernel shown above may
% produce noticeable inaccuracies (after all, Sobel is only an approximation
% of the derivative). OpenCV addresses this inaccuracy for kernels of size 3
% by using the |cv.Scharr| function. This is as fast but more accurate than
% the standard Sobel function. It implements the following kernels:
%
% $$G_{x} = \left[{\matrix{
%                -3 & 0 &  +3 \cr
%               -10 & 0 & +10 \cr
%                -3 & 0 &  +3
%           }}\right]$$
%
% $$G_{y} = \left[{\matrix{
%               -3 & -10 & -3 \cr
%                0 &   0 &  0 \cr
%               +3 & +10 & +3
%           }}\right]$$
%
% Note: You can check out more information of this function in the OpenCV
% reference (|cv.Scharr|). Also, in the sample code below, you will notice
% that above the code for |cv.Sobel| function there is also code for the
% |cv.Scharr| function commented. Enabling it should give you an idea of how
% this function works.
%

%% Code
%
% The program below applies the _Sobel Operator_ and generates as output an
% image with the detected _edges_ bright on a darker background.
%

%%
% load source image
src = cv.imread(fullfile(mexopencv.root(),'test','lena.jpg'), 'Color',true);

%%
% apply a Gaussian blur to reduce the noise
src = cv.GaussianBlur(src, 'KSize',[3 3]);

%%
% convert filtered image to grayscale
gray = cv.cvtColor(src, 'RGB2GRAY');

%%
% calculate the derivatives in x and y directions
% (input is 8-bit, we set the output image depth to 16-bit to avoid overflow)
if true
    gradx = cv.Sobel(gray, 'XOrder',1, 'YOrder',0, 'DDepth','int16');
    grady = cv.Sobel(gray, 'XOrder',0, 'YOrder',1, 'DDepth','int16');
else
    gradx = cv.Scharr(gray, 'XOrder',1, 'YOrder',0, 'DDepth','int16');
    grady = cv.Scharr(gray, 'XOrder',0, 'YOrder',1, 'DDepth','int16');
end

%%
% take absolute value and convert our partial results back to 8-bit
gradxabs = cv.convertScaleAbs(gradx);
gradyabs = cv.convertScaleAbs(grady);

%%
% approximate the gradient by adding both directional gradients
% (this is not an exact calculation, but it is good for our purposes)
grad = cv.addWeighted(gradxabs,0.5, gradyabs,0.5, 0.0);

%%
% show result
imshow(grad)
title('Sobel Demo - Simple Edge Detector')


function bratubvp
%BRATUBVP  Exercise for Example 1 of the BVP tutorial.
%   The BVP  y'' + exp(y) = 0, y(0) = 0 = y(1) is a standard example
%   of a problem with two solutions.  It is easy enough to solve, but
%   some experimentation with the guess may be necessary to get both.

% Copyright 2002, The MathWorks, Inc.

options = bvpset('stats','on');
solinit = bvpinit(linspace(0,1,5),[0.1 0]);
sol1 = bvp4c(@bratuode,@bratubc,solinit,options);

fprintf('\n');

% Change the initial guess to converge to a different solution.
solinit = bvpinit(linspace(0,1,5),[3 0]);
sol2 = bvp4c(@bratuode,@bratubc,solinit,options);

figure
plot(sol1.x,sol1.y(1,:),sol2.x,sol2.y(1,:))
title('Bratu''s equation has two solutions when \lambda = 1.')
xlabel('x')
ylabel('y')

% --------------------------------------------------------------------------

function dydx = bratuode(x,y)
%BRATUODE  ODE function for the exercise of Example 1 of the BVP tutorial.
dydx = [  y(2)
         -exp(y(1))];

% --------------------------------------------------------------------------

function res = bratubc(ya,yb)
%BRATUBC  Boundary conditions for the exercise of Example 1 of the BVP tutorial.
res = [ya(1)
       yb(1)];


%VL_NNBNORM CNN batch normalisation.
%   Y = VL_NNBNORM(X,G,B) applies batch normalization to the input
%   X. Batch normalization is defined as:
%
%      Y(i,j,k,t) = G(k) * (X(i,j,k,t) - mu(k)) / sigma(k) + B(k)
%
%   where:
%
%      mu(k) = mean_ijt X(i,j,k,t),
%      sigma2(k) = mean_ijt (X(i,j,k,t) - mu(k))^2,
%      sigma(k) = sqrt(sigma2(k) + EPSILON)
%
%   are respectively the per-channel mean, variance, and standard
%   deviation of each feature channel in the data X. The parameters
%   G(k) and B(k) are multiplicative and additive constants use to
%   scale each data channel.
%
%   Means and variances are accumulated across all the data items
%   (images) stored in the 4D tensor X (from which the name batch
%   normalization is derived). The constant EPSILON is used to
%   regularize the computation of sigma(k) and to avoid division by
%   zero.
%
%   [DZDX,DZDG,DZDB] = VL_NNBNORM(X,G,B,DZDY) computes the derviatives
%   of the block projected onto DZDY. DZDX, DZDG, DZDB and DZDY have
%   the same dimensions as X, G, B, and Y respectivey.
%
%   Optionally, [Y,MOMENTS] = VL_NNBNORM(...) and
%   [DZDX,DZDG,DZDB,MOMENTS] = VL_NNBNORM(...,DZDY) return the values
%   of the vectors mu and sigma in the formulas above. Here, MOMENTS
%   is a DEPTH x 2 array [MU, SIGMA].
%
%   VL_NNBNROM(..., 'Option', value) takes the following options:
%
%   `Epsilon`:: 1e-4
%       Specifies the constant EPSILON in the formuals above.
%
%   `Moments`:: unspecified
%       Specifies an array MOMENTS with the values of mu and sigma to
%       use instead of computing them according to the equations
%       above. This is useful to disable batch normalization during
%       testing.
%
%   See also: VL_NNNORMALIZE().

% Copyright (C) 2015 Sébastien Ehrhardt, Karel Lenc and Andrea Vedaldi.
% All rights reserved.
%
% This file is part of the VLFeat library and is made available under
% the terms of the BSD license (see the COPYING file).


function [I, J] = ind2sub4up(IND)
%IND2SUB4UP Subscripts from linear index for upper triangular matrix (only
%elements above diagonal)
%   IND2SUB4UP determines the equivalent subscript values corresponding to
%   a given single index into a 2D upper triangular matrix, excluded all
%   elements over the diagonal.
%
%   [I, J] = IND2SUB4UP(IND) returns vectors I and J containing equivalent
%   row and column subscripts corresponding to the index vector IND.
%
%   Let ind be a vector of indexes for entries of some upper triangular
%   matrix. The entries are selected vertically so that:
%
%       ind = 1                is associated to entry      (1, 2)
%       ind = 2                is associated to entry      (1, 3)
%       ind = 3                is associated to entry      (2, 3)
%       ind = 4                is associated to entry      (1, 4)
%       ...
%       ind = N * (N - 1) / 2  is associated to entry      (N - 1, N)
%
% % ======================================================================
%
%    EXAMPLE
%
%       % Note that if
%             A = rand(10);
%       % and
%             b = A(find(triu(A, 1)));
%       % then, given indices
%             IND = [1:45];
%       % for vector b, these are equivalent to subscripts
%             [I, J] = ind2sub4up(IND);
%       % for matrix A. In fact:
%             all(A(sub2ind(size(A), I, J)) == b(IND))
%
%       %    ans =
%       %           1
%
%       % This is obtained without even knowing about size(A)
%
% % ======================================================================
%
%   See also SUB2IND, IND2SUB, FIND.
%
% % ======================================================================
%
%-*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-*%
%                                                                                %
%            Author: Liber Eleutherios                                             %
%            E-Mail: libereleutherios@gmail.com                             %
%            Date: 1 May 2010                                                       %
%                                                                                %
%-*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-* -*-*%
%
% % ======================================================================
%

% Check input
ctrl1 = isnumeric(IND) & isreal(IND);
if ctrl1
  IND = ceil(IND(:));
  ctrl2 = ~any(isnan(IND)) & ~any(isinf(IND)) & all(IND > 0);
  if ~ctrl2
  error('Check indexes: they need to be positive integers!')
  end
else
  error('Check indexes: they need to be positive integers!')
end

J = round(floor(-.5 + .5 * sqrt(1 + 8 * (IND - 1))) + 2);
I = round(J .* (3 - J) / 2 + IND - 1);


function Y = VBA_quantile(X,p)
% Y = VBA_QUANTILE(X,P) returns quantiles of the values in the vector X.
% VBA alternative to the quantile function from the statistics toolbox.
% P is a scalar or a vector of cumulative probability values.
% Y is the same size as P, and Y(i) contains the P(i)-th quantile.

% check inputs
if isempty(X)
    Y = nan(numel(p));
    return
end

X(isnan(X)) = [];
X = VBA_vec(X);

% compute quantiels
n = numel(X);

if n==1
    Y = X*ones(1,numel(p));
    return
end
q = [0 (0.5:1:(n-0.5))/n 1];
SX = sort(X);
Y = interp1(q,SX([1 1:n n]),p,'linear');


function RF = rfGaussian2d(X,Y,sigmaMajor,sigmaMinor,theta, x0,y0)
% rfGaussian2d - Create a two dimensional Gaussian receptive field
%
%  RF = rfGaussian2d(X,Y,sigmaMajor,sigmaMinor,theta,x0,y0);
%
%    X,Y        : Sample positions in deg
%    sigmaMajor : standard deviation longest direction
%    sigmaMinor : standard deviation shortest direction
%                 [default: sigmaMinor = sigmaMajor]
%    theta      : angle of sigmaMajor (radians, 0=vertical)
%                 [default = 0];
%    x0         : x-coordinate of center of RF [default = 0];
%    y0         : y-coordinate of center of RF [default = 0];
%
%
% Example:
% To make one rf:
%    fieldRange = 20;  % Deg
%    sampleRate = 0.2; % Deg
%    x = [-fieldRange:sampleRate:fieldRange];
%    y = x;
%    [X,Y] = meshgrid(x,y);
%    sigma = 5;  % Deg
%    rf = rfGaussian2d(X,Y,sigma);
%

% Programming notes:
%  Maybe we should always make sure we use an odd number of samples and
%  have a sample at the origin

% According to profile half of the executing time for the function
% is spend at notDefined, and this functions is called lots (it
% is the slowest part in rmMain together with rfMakePrediction),   so
% if it seems that all arguments are given just skip it.
% ras 08/06: well, we can do what Bob does: not call it at all anyway.
if nargin ~= 7,
    if ~exist('X', 'var') || isempty(X),
        error('Must define X grid');
    end;

    if ~exist('Y', 'var') || isempty(Y),
        error('Must define Y grid');
    end;

    if ~exist ('sigmaMajor', 'var') || isempty(sigmaMajor),
        error('Must scale on major axis');
    end;

    if ~exist ('sigmaMinor', 'var') || isempty(sigmaMinor),
        sigmaMinor = sigmaMajor;
    end;

    if ~exist ('theta', 'var') || isempty(theta), theta = false; end;
    if ~exist ('x0', 'var') || isempty(x0),       x0 = 0;    end;
    if ~exist ('y0', 'var') || isempty(y0),       y0 = 0;    end;
end;

% Allow sigma, x,y to be a matrix so that the final output will be
% size(X,1) by size(x0,2). This way we can make many RFs at the same time.
% Here I assume that all parameters are given.
if numel(sigmaMajor)~=1,
    sz1 = numel(X);
    sz2 = numel(sigmaMajor);

    X   = repmat(X(:),1,sz2);
    Y   = repmat(Y(:),1,sz2);

    sigmaMajor = repmat(sigmaMajor(:)',sz1,1);
    sigmaMinor = repmat(sigmaMinor(:)',sz1,1);

    if any(theta(:)),
        theta = repmat(theta(:)',sz1,1);
    end;

    x0 = repmat(x0(:)',sz1,1);
    y0 = repmat(y0(:)',sz1,1);
end;

% Translate grid so that center is at RF center
X = X - x0;   % positive x0 moves center right
Y = Y - y0;   % positive y0 moves center up

% Rotate grid around the RF center, positive theta rotates the
% grid to the right. No need for this if theta is 0.
if any(theta(:)),
    Xold = X;
    Yold = Y;
    X = Xold .* cos(theta) - Yold .* sin(theta);
    Y = Xold .* sin(theta) + Yold .* cos(theta);
end;

% make gaussian on current grid
RF = exp( -.5 * ((Y ./ sigmaMajor).^2 + (X ./ sigmaMinor).^2));

% Normalize the Gaussian.
% The idea is that if you stimulate the entire RF you will
% always get the same activation, independent of the RF parameters.
% RF = RF ./ (sigmaMajor.*2.*pi.*sigmaMinor);
% Decided not to do this. The fitting will deal with this.
% Thus amplitude will always be the same.

return;


function vec=getPermIndices(rank,n,dim)
%%GETPERMINDICES Get a vector of indices that can be used to rearrange the
%                subvectors in a vector consisting of n subvectors of
%                dimensionality dim according to the permutation of the
%                given rank in lexicographic ordering.
%
%INPUTS: rank The order of the desired permutation of 0:(n-1) (or 1:n) in
%             lexicographic order. Note  that 0<=rank<=(n!-1).
%           n The number of stacked vectors that are to be permuted.
%         dim The dimensionality of the n subvectors being permutated.
%
%OUTPUTS: vec A vector of indices that can be used to reorder the
%             subvectors of a vector of n subvectors of dimensionality dim.
%
%Given an (n*dim)X1 vector v of n stacked subvectors of dimension dim,
%v(vec) rearranges the subvectors in v according to the given permutation.
%This rearrangement can also be performed in a less computationally
%efficient manner using a permutation matrix generated by the function
%rank2PermMatrix.
%
%September 2013 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

    perm=unrankPermutation(rank,n);
    vec=zeros(dim*n,1);

    for curPerm=1:n
        baseVec=(curPerm-1)*dim;
        basePerm=(perm(curPerm)-1)*dim;

        for off=1:dim
           vec(baseVec+off)=basePerm+off;
        end
    end
end

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


function score = nmi_onmf(true_labels, cluster_labels)
%NMI Compute normalized mutual information (NMI) using the true and cluster
%   labels and return the value in 'score'.
%
%   Input    : true_labels    : N-by-1 vector containing true labels
%              cluster_labels : N-by-1 vector containing cluster labels
%
%   Output   : score          : NMI value
%
%   Reference: Shi Zhong, 2003.
%              http://www.cse.fau.edu/~zhong/software/textclust.zip

% Compute the confusion matrix 'cmat', where
%   col index is for true label (CAT),
%   row index is for cluster label (CLS).
n = length(true_labels);
cat = spconvert([(1:n)' true_labels ones(n,1)]);
cls = spconvert([(1:n)' cluster_labels ones(n,1)]);
cls = cls';
cmat = full(cls * cat);

n_i = sum(cmat, 1); % Total number of data for each true label (CAT), n_i
n_j = sum(cmat, 2); % Total number of data for each cluster label (CLS), n_j

% Calculate n*n_ij / n_i*n_j
[row, col] = size(cmat);
product = repmat(n_i, [row, 1]) .* repmat(n_j, [1, col]);
index = find(product > 0);
n = sum(cmat(:));
product(index) = (n*cmat(index)) ./ product(index);
% Sum up n_ij*log()
index = find(product > 0);
product(index) = log(product(index));
product = cmat .* product;
score = sum(product(:));
% Divide by sqrt( sum(n_i*log(n_i/n)) * sum(n_j*log(n_j/n)) )
index = find(n_i > 0);
n_i(index) = n_i(index) .* log(n_i(index)/n);
index = find(n_j > 0);
n_j(index) = n_j(index) .* log(n_j(index)/n);
denominator = sqrt(sum(n_i) * sum(n_j));

% Check if the denominator is zero
if denominator == 0
  score = 0;
else
  score = score / denominator;
end


% Nonnegative matrix factorization
% Argyris Zymnis, Joelle Skaf, Stephen Boyd
%
% We are given a matrix A in R^{m*n}
% and are interested in solving the problem:
%
% minimize    ||A - Y*X||_F
% subject to  Y >= 0, X >= 0
%
% where Y in R{m*k} and X in R{k*n}.
% This script generates a random matrix A and obtains an
% *approximate* solution to the above problem by first generating
% a random initial guess for Y and the alternatively minimizing
% over X and Y for a fixed number of iterations.

% Generate data matrix A
rstate = rand('state');
m = 10; n = 10; k = 5;
A = rand(m,k)*rand(k,n);

% Initialize Y randomly
Y = rand(m,k);

% Perform alternating minimization
MAX_ITERS = 30;
residual = zeros(1,MAX_ITERS);
for iter = 1:MAX_ITERS
    cvx_begin quiet
        if mod(iter,2) == 1
            variable X(k,n)
            X >= 0;
        else
            variable Y(m,k)
            Y >= 0;
        end
        minimize(norm(A - Y*X,'fro'));
    cvx_end
    fprintf(1,'Iteration %d, residual norm %g\n',iter,cvx_optval);
    residual(iter) = cvx_optval;
end

% Plot residuals
plot(residual);
xlabel('Iteration Number');
ylabel('Residual Norm');

% Display results
disp( 'Original matrix:' );
disp( A );
disp( 'Left factor Y:' );
disp( Y );
disp( 'Right factor X:' );
disp( X );
disp( 'Residual A - Y * X:' );
disp( A - Y * X );
fprintf( 'Residual after %d iterations: %g\n', iter, cvx_optval );


function [mu, b, se, LR_chi2, convState] = drxlr_logistic_regression(x,y,iterlim,convcrit)
% regression by logistic model
% discrete reponse and different types of explanatory variables
% x: column vector of explanatory variables
% y: column vector of observations
% solved by maximum likelihood estimates using iterative  weighted
% least-squared.
% written by Issam El Naqa Spring 2003
% Extracted for generalized use 2005, AJH
% LM: APA 07/13/2006, added convState as output parameter to represent the
% state of convergence. convState is a 1x3 vector with 1st element being
% converged Yes or no, second element being number of iterations for
% convergence and third element being convergence criteria condition
%
% Copyright 2010, Joseph O. Deasy, on behalf of the DREES development team.
%
% This file is part of the Dose Response Explorer System (DREES).
%
% DREES development has been led by:  Issam El Naqa, Aditya Apte, Gita Suneja, and Joseph O. Deasy.
%
% DREES has been financially supported by the US National Institutes of Health under multiple grants.
%
% DREES is distributed under the terms of the Lesser GNU Public License.
%
%     This version of DREES 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.
%
% DREES 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 DREES.  If not, see <http://www.gnu.org/licenses/>.

% Initialize parameters
%warning('off');
x = [x ones(size(x,1),1)]; % constant factor
iter = 0;
[n p] = size(x);
seps = sqrt(eps);
eta = drxlr_rlogit((y + 0.5)/2); % initialize
b = zeros(p,1);
b0 = b+1;
% Start iterating
while(1)
    iter = iter+1;
    mu = drxlr_invlogit(eta);
    mu = max(0, min(1, mu));
    % Check stopping conditions
    if (~any(abs(b-b0) > convcrit * max(seps, abs(b0))))
        convState = [1 iter-1 max(abs(b-b0))];
        break;
    end
    if (iter>iterlim)
        warning('drxlr_logistic_regression: Number of iterations exceeded without convergence (convergence tolerance = %e', convcrit)
        convState = [2 iter-1 max(abs(b-b0))];
        break;  % iteration limit reached, exit!
    end
    deta = drxlr_d_logit(mu);
    z = eta + (y - mu) .* deta;
    vy=drxlr_binomial_variance(mu);
    w = 1 ./ max(eps, (deta .^ 2) .* vy);
    b0 = b;
    [b,R,se] = drxlr_wfit(z, x, w, p);
    eta = x * b;
end

%%% calculate likelihood ratio test
LR_chi2=drxlr_get_lrt(y,mu);
return


function d = distanz(x,y,algtype)
% DISTANZ : calculates the distances between all vectors in x and y.
%
% usage:
%    d = distanz(x,y);
%
% inputs:
%    x      matrix with col vectors
%    y      matrix with col vectors (default == x)
%    algtype   the type of algorithm that is used (default==3)
%
% outputs:
%    d      distance matrix, not squared
%
% note:
%    part of the code is inspired by dist.m of the nntoolbox, other
%    part adapted from Francis Bach who took it from Roland
%    Bunschoten.
%
% sth * 19apr2002
% Adapted from create.m, originally written by
% (c) Stefan Harmeling, 2006

if exist('algtype')~=1 || isempty(algtype), algtype = 3; end
switch algtype
 case 1  % inspired by dist.m
  if exist('y')~=1 || isempty(y)
    % here comes code just for x
    [rx,cx] = size(x);
    d = zeros(cx,cx);
    nuller = zeros(cx,1);
    for c = 1:cx
      d(c,:) = sum((x-x(:,c+nuller)).^2,1);
    end
  else
    % here comes code for x and y
    [rx,cx] = size(x);
    [ry,cy] = size(y);
    if rx~=ry, error('x and y do not fit'), end
    d = zeros(cx,cy);
    if cx>cy
      nuller = zeros(cx,1);
      for c = 1:cy
	d(:,c) = sum((x-y(:,c+nuller)).^2,1)';
      end
    else
      nuller = zeros(cy,1);
      for c = 1:cx
	d(c,:) = sum((x(:,c+nuller)-y).^2,1);
      end
    end
  end

 case 2  % same as case 1, but with repmat instead of nuller
  if exist('y')~=1 || isempty(y)
    % here comes code just for x
    [rx,cx] = size(x);
    d = zeros(cx,cx);
    nuller = zeros(cx,1);
    for c = 1:cx
      d(c,:) = sum((x-repmat(x(:,c),[1 cx])).^2,1);
    end
  else
    % here comes code for x and y
    [rx,cx] = size(x);
    [ry,cy] = size(y);
    if rx~=ry, error('x and y do not fit'), end
    d = zeros(cx,cy);
    if cx>cy
      nuller = zeros(cx,1);
      for c = 1:cy
	d(:,c) = sum((x-repmat(y(:,c),[1 cx])).^2,1)';
      end
    else
      nuller = zeros(cy,1);
      for c = 1:cx
	d(c,:) = sum((repmat(x(:,c),[1 cy])-y).^2,1);
      end
    end
  end

 case 3  % inspired by Roland Bunschoten
  if exist('y')~=1 || isempty(y)
    % here comes code just for x
    cx = size(x,2);
    xx = sum(x.*x,1); xz = x'*x;
    d = abs(repmat(xx',[1 cx]) - 2*xz + repmat(xx,[cx 1]));
  else
    % here comes code for x and y
    [rx,cx] = size(x);
    [ry,cy] = size(y);
    if rx~=ry, error('x and y do not fit'), end
    xx = sum(x.*x,1); yy = sum(y.*y,1);  xy = x'*y;
    d = abs(repmat(xx',[1 cy]) + repmat(yy,[cx 1]) - 2*xy);
  end
end

d = sqrt(d);


function y = barycentricInterpolate(Y,Idx,W)
% y = barycentricInterpolate(Y,Idx,W)
%
% This function interpolates a point y, based on the data in Y and the
% weights (W) on the verticies Y(Idx)
%
% INPUTS:
%   Y = [N, 1] data set.
%   W = [d+1, n] weight to apply to each index
%   Idx = [d+1, n] linear index corresponding to each weight
%
% OUTPUTS:
%   y = [n,d] = function value at query points
%
% NOTES:
%   --> y = f(x), where x is d-dimensional, and y is scalar
%   --> Y = Y(x1,x2,...,xd)
%   --> n = size(Y);
%   --> y(X(:,i)) = W(i,:)*Y(Idx(:,i));
%
% See Also: barycentricWeights

n = size(Idx,2);
y = zeros(n,1);

for query=1:n
    y(query) = dot(W(:,query),Y(Idx(:,query)));
end

end


%% check Clebsch Gordan Tensor

%% the reference

% some arbitrary rotation
g = rotation.byEuler(-72*degree,88*degree,134*degree);

% we want to express the product of two wigner D functions
D1 = WignerD(g,'order',1);
D1D1_ref = D1(:) * D1(:).'

%% expansion into Wigner functions of lower order

% zero order component
D0 = WignerD(g,'order',0);
CG0 = ClebschGordanTensor(0);
C0 = D0*EinsteinSum(CG0,[1 3],CG0,[2 4])

% first order component
D1 = WignerD(g,'order',1);
CG1 = ClebschGordanTensor(1);
C1 = EinsteinSum(CG1,[1 3 -1],D1,[-1 -2],CG1,[2 4 -2])

% second order component
D2 = WignerD(g,'order',2);
CG2 = ClebschGordanTensor(2);
C2 = EinsteinSum(CG2,[1 3 -1],D2,[-1 -2],CG2,[2 4 -2])

a = reshape(matrix(C0 + C1 + C2),[9,9]) ./ D;
A = round(a)

imagesc(A)

assert(norm(A.* D - reshape(matrix(C0 + C1 + C2),[9,9]))<=1e-10,'Clebsch Gordan check failed')


function unique_num = r8col_tol_unique_count ( m, n, a, tol )

%*****************************************************************************80
%
%% R8COL_TOL_UNIQUE_COUNT counts tolerably unique entries in an R8COL.
%
%  Discussion:
%
%    Because the array is unsorted, this algorithm is O(N^2).
%
%    If the tolerance is large enough, then the concept of uniqueness
%    can become ambiguous.  If we have a tolerance of 1.5, then in the
%    list ( 1, 2, 3, 4, 5, 6, 7, 8, 9 ) is it fair to say we have only
%    one unique entry?  That would be because 1 may be regarded as unique,
%    and then 2 is too close to 1 to be unique, and 3 is too close to 2 to
%    be unique and so on.
%
%    This seems wrongheaded.  So I prefer the idea that an item is not
%    unique under a tolerance only if it is close to something that IS unique.
%    Thus, the unique items are guaranteed to cover the space if we include
%    a disk of radius TOL around each one.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    17 July 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, the number of rows.
%
%    Input, integer N, the number of columns.
%
%    Input, real A(M,N), the unsorted array.
%
%    Input, real TOL, a tolerance for equality.
%
%    Output, integer UNIQUE_NUM, the number of unique columns of A.
%
  undx = zeros ( n, 1 );
%
%  Implicitly sort the array.
%
  indx = r8col_sort_heap_index_a ( m, n, a );
%
%  Consider entry I = 1.
%  It is unique, so set the number of unique items to K.
%  Set the K-th unique item to I.
%  Set the representative of item I to the K-th unique item.
%
  i = 1;
  k = 1;
  undx(k) = indx(i);
%
%  Consider entry I.
%
%  If it is unique, increase the unique count K, set the
%  K-th unique item to I, and set the representative of I to K.
%
%  If it is not unique, set the representative of item I to a
%  previously determined unique item that is close to it.
%
  for i = 2 : n

    unique = 1;

    for j = 1 : k
      diff = max ( abs ( a(1:m,indx(i)) - a(1:m,undx(j)) ) );
      if ( diff <= tol )
        unique = 0;
        break
      end
    end

    if ( unique )
      k = k + 1;
      undx(k) = indx(i);
    end

  end

  unique_num = k;

  return
end


function value = alnfac ( n )

%*****************************************************************************80
%
%% ALNFAC computes the logarithm of the factorial of N.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the argument of the factorial.
%
%    Output, real VALUE, the logarithm of the factorial of N.
%
  value = alngam ( n + 1 );

  return
end


function length = circle01_length ( )

%*****************************************************************************80
%
%% CIRCLE01_LENGTH: length of the circumference of the unit circle in 2D.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    11 January 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Output, real LENGTH, the length.
%
  r = 1.0;
  length = 2.0 * pi * r;

  return
end


function [ss, dist_map] = makeSphericalSection(radius, height, width, plot_section, binary)
%MAKESPHERICALSECTION     Create a binary map of a sphere segment within a 3D grid.
%
% DESCRIPTION:
%       makeSphericalSection creates a binary map of a section of a
%       spherical surface within a three-dimensional matrix. The sphere is
%       created using an extension of the midpoint circle algorithm. A
%       single grid point is taken as the sphere center so the total
%       diameter will always be an odd number of grid points. The sphere is
%       then truncated based on the values for height and width (a diagram
%       of the input sizes is given below). The face of the spherical
%       section faces in the positive x-direction and the optional width
%       parameter truncates the size in the y-direction.
%
%       If the optional input parameter "binary" is set to false (the
%       default), the section map is returned as a double precision matrix.
%       If it is set to true, the map is returned as a logical matrix. The
%       average distance between each grid point in the spherical section
%       and its contiguous neighbours can also be returned. This is given
%       as a ratio compared to the average neighbour distance for a flat
%       surface.
%
% SYNTAX:
%       ss = makeSphericalSection(radius, height)
%       ss = makeSphericalSection(radius, height, width)
%       ss = makeSphericalSection(radius, height, width, plot_section)
%       ss = makeSphericalSection(radius, height, [], plot_section)
%       ss = makeSphericalSection(radius, height, width, plot_section, binary)
%       ss = makeSphericalSection(radius, height, [], [] binary)
%
%       [ss, dist_map] = makeSphericalSection(radius, height)
%       [ss, dist_map] = makeSphericalSection(radius, height, width)
%       [ss, dist_map] = makeSphericalSection(radius, height, [], plot_section)
%       [ss, dist_map] = makeSphericalSection(radius, height, width, plot_section)
%       [ss, dist_map] = makeSphericalSection(radius, height, width, plot_section, binary)
%       [ss, dist_map] = makeSphericalSection(radius, height, [], [] binary)
%
% INPUTS:
%       radius          - radius of curvature [grid points]
%       height          - transducer height [grid points]
%
% OPTIONAL INPUTS:
%       width           - section width (must be specified as an odd
%                         number) [grid points]
%       plot_section    - Boolean controlling whether the spherical section
%                         is plotted using voxelPlot (default = false)
%       binary          - Boolean controlling whether the spherical section
%                         is returned as a double precision matrix (false)
%                         or a logical matrix (true) (default = false)
%
% OUTPUTS:
%       ss              - binary matrix containing spherical section
%       dist_map        - ratio of average neighbour distance for each grid
%                         point within the spherical section compared to a
%                         flat surface
%
% ABOUT:
%       author          - Bradley Treeby
%       date            - 3rd February 2012
%       last update     - 20th August 2014
%
% This function is part of the k-Wave Toolbox (http://www.k-wave.org)
% Copyright (C) 2009-2014 Bradley Treeby and Ben Cox
%
% See also makeBall, makeSphere

% This file is part of k-Wave. k-Wave is free software: you can
% redistribute it and/or modify it under the terms of the GNU Lesser
% General Public License as published by the Free Software Foundation,
% either version 3 of the License, or (at your option) any later version.
%
% k-Wave 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 Lesser General Public License for
% more details.
%
% You should have received a copy of the GNU Lesser General Public License
% along with k-Wave. If not, see <http://www.gnu.org/licenses/>.

%#ok<*UNRCH>

% option to use the spherical sections or square sections of the sphere
% returned by makeSphere (true by default)
use_spherical_sections = true;

% force inputs to be integers
radius = round(radius);
height = round(height);

% check for width input
if nargin < 3 || (nargin == 4 && isempty(width))

    % set width truncation flag to false
    use_width = false;

else

    % set width truncation flag to true
    use_width = true;

    % force input to an integer
    width = round(width);

    % check that it's an odd number
    if ~rem(width, 2)
        error('width must be an odd number');
    end

end

% check for plot input
if nargin < 4 || isempty(plot_section)
    plot_section = false;
end

% check for data type input
if nargin < 5 || isempty(binary)
    binary = false;
end

% calculate minimum grid dimensions to fit entire sphere
Nx = 2*radius + 1;

% create sphere
ss = makeSphere(Nx, Nx, Nx, radius, [], binary);

% truncate to given height
if use_spherical_sections
    ss = ss(1:height, :, :);
else
    ss = permute(ss(:, 1:height, :), [2, 3, 1]);
end

% flatten transducer and store the maximum and indices
mx = squeeze(max(ss, [], 1));

% calculate the total length/width of the transducer
length = sum(mx(ceil(end/2), :), 2);

% truncate transducer grid based on length (removes empty rows and columns)
offset = (Nx - length)/2;
ss = ss(:, 1 + offset:end - offset, 1 + offset:end - offset);

% also truncate to given width if defined by user
if use_width

    % check the value is appropriate
    if width > length
        error('input for width must be less than or equal to transducer length');
    end

    % calculate offset
    offset = (length - width)/2;

    % truncate transducer grid
    ss = ss(:, 1 + offset:end - offset, :);

end

% compute average distance between each grid point and it's contiguous
% neighbours if dist_map output is defined
if nargout == 2

    % calculate x-index of each grid point in the spherical section, create
    % mask and remove singleton dimensions
    [mx, mx_ind] = max(ss, [], 1);
    mask = squeeze(mx ~= 0);
    mx_ind = squeeze(mx_ind).*mask;

    % double check there there is only one value of spherical section in
    % each matrix column
    if sum(mx(:)) ~= sum(ss(:))
        error('mean neighbour distance cannot be calculated uniquely due to overlapping points in the x-direction');
    end

    % calculate average distance to grid point neighbours in the flat case
    x_dist = repmat([1 0 1], 3, 1);
    y_dist = x_dist.';
    flat_dist = sqrt(x_dist.^2 + y_dist.^2);
    flat_dist = mean(flat_dist(:));

    % compute distance map
    dist_map = zeros(size(mx_ind));
    sz = size(mx_ind);
    for m = 1:sz(1)
        for n = 1:sz(2)

            % clear map
            local_heights = zeros(3, 3);

            % extract the height (x-distance) of the 8 neighbouring grid
            % points
            if m == 1 && n == 1
                local_heights(2:3, 2:3) = mx_ind(m:m + 1, n:n + 1);
            elseif m == sz(1) && n == sz(2)
                local_heights(1:2, 1:2) = mx_ind(m - 1:m, n - 1:n);
            elseif m == 1 && n == sz(2)
                local_heights(2:3, 1:2) = mx_ind(m:m + 1, n - 1:n);
            elseif m == sz(1) && n == 1
                local_heights(1:2, 2:3) = mx_ind(m - 1:m, n:n + 1);
            elseif m == 1
                local_heights(2:3, :) = mx_ind(m:m + 1, n - 1:n + 1);
            elseif m == sz(1)
                local_heights(1:2, :) = mx_ind(m - 1:m, n - 1:n + 1);
            elseif n == 1
                local_heights(:, 2:3) = mx_ind(m - 1:m + 1, n:n + 1);
            elseif n == sz(2)
                local_heights(:, 1:2) = mx_ind(m - 1:m + 1, n - 1:n);
            else
                local_heights = mx_ind(m - 1:m + 1, n - 1:n + 1);
            end

            % compute average variation from center
            local_heights_var = abs(local_heights - local_heights(2, 2));

            % threshold no neighbours
            local_heights_var(local_heights == 0) = 0;

            % calculate total distance from centre
            dist = sqrt(x_dist.^2 + y_dist.^2 + local_heights_var.^2);

            % average and store as a ratio
            dist_map(m, n) = 1 + (mean(dist(:)) - flat_dist)./flat_dist;

        end
    end

    % threshold out the non-transducer grid points
    dist_map(mask ~= 1) = 0;

    % flattened plot and distance values
    if plot_section
        figure;
        subplot(2, 1, 1);
        imagesc(mx_ind);
        axis image;
        colorbar;
        title('Height of Transducer Face');
        subplot(2, 1, 2);
        dist_map_plot = dist_map;
        dist_map_plot(dist_map_plot ~= 0) = dist_map_plot(dist_map_plot ~= 0) -1;
        imagesc(100*dist_map_plot);
        axis image;
        colorbar;
        title('Percentage Increase in Average Neighbour Distance Compared to a Flat Surface');
    end

end

% plot if required
if plot_section

    voxelPlot(double(ss));
    view(150, 20);

%     % create surface plot
%     figure;
%     sz = size(ss);
%     [x, y] = meshgrid(1:sz(3),1:sz(2));
%     surface_ind = find(mx ~= 0);
%     plot3(x(surface_ind), y(surface_ind), mx_ind(mx ~= 0), 'k.');
%     axis image;

end


function nearest = find_closest3 ( m, nr, r, ns, s )

%*****************************************************************************80
%
%% FIND_CLOSEST3 finds the nearest R point to each S point.
%
%  Discussion:
%
%    We are given R, a set of NR points in M dimensions.
%
%    We are given S, a set of NS points in M dimensions.
%
%    For each S(I) in S, we seek the index J of the point R(J)
%    which is nearest to S(I) over all points in R.
%
%    Modified in accordance with suggestions by Gene Cliff, 08 July 2010.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    08 July 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, the spatial dimension.
%
%    Input, integer NR, the number of cell generators.
%
%    Input, real R(M,NR), the cell generators.
%
%    Input, integer NS, the number of sample points.
%
%    Input, real S(M,NS), the points to be checked.
%
%    Output, integer NEAREST(NS), the index of the cell generator nearest
%    to the sample point.
%
  ones_k = ones ( 1, nr );
  nearest = NaN ( 1, ns );

  for i = 1 : ns
    d1 = r - s(:,i) * ones_k;
    d2 = sum ( d1 .* d1 );
    [ min_val, min_loc ] = min ( d2 );
    nearest(i) = min_loc;
  end

  return
end


function [ x, seed ] = sphere01_sample ( n, seed )

%*****************************************************************************80
%
%% SPHERE01_SAMPLE picks random points on the unit sphere.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    20 April 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of samples.
%
%    Input/output, integer SEED, a seed for the random
%    number generator.
%
%    Output, real X(3,N), the sample points.
%
  x = zeros ( 3, n );

  for j = 1 : n
%
%  Pick a uniformly random VDOT, which must be between -1 and 1.
%  This represents the dot product of the random vector with the Z unit vector.
%
%  Note: this works because the surface area of the sphere between
%  Z and Z + dZ is independent of Z.  So choosing Z uniformly chooses
%  a patch of area uniformly.
%
    [ vdot, seed ] = r8_uniform_01 ( seed );
    vdot = 2.0 * vdot - 1.0;

    phi = r8_acos ( vdot );
%
%  Pick a uniformly random rotation between 0 and 2 Pi around the
%  axis of the Z vector.
%
    [ theta, seed ] = r8_uniform_01 ( seed );
    theta = 2.0 * pi * theta;

    x(1,j) = cos ( theta ) * sin ( phi );
    x(2,j) = sin ( theta ) * sin ( phi );
    x(3,j) = cos ( phi );

  end

  return
end


function [R] = ipsrf(varargin)
%IPSRF Interval Potential Scale Reduction Factor
%
%   [R] = IPSRF(X) or
%   [R] = IPSRF(x1,x2,...,xs)
%   returns "Potential Scale Reduction Factor" (PSRF) for
%   collection of MCMC-simulations. X is a NxDxM matrix
%   which contains M MCMC simulations of length N, each with
%   dimension D. MCMC-simulations can be given as separate
%   arguments x1,x2,... which should have the same length.
%
%   Returns
%     R     PSRF in a row vector of length D
%
%   The idea of the PSRF is that if R is not near 1 (below 1.1 for
%   example) one may conclude that the tested samples were not from
%   the same distribution (chain might not have been converged
%   yet). Instead of normality assumption, 80% empirical intervals
%   are used to compute R.
%
%   If only one simulation is given, the factor is calculated
%   between first and last third of the chain. Note that use of
%   only one chain will produce over-optimistic result.
%
%   Method is from:
%      Brooks, S.P. and Gelman, A. (1998) General methods for
%      monitoring convergence of iterative simulations. Journal of
%      Computational and Graphical Statistics. 7, 434-455.
%
%   See also
%     CIPSRF, PSRF

% Copyright (C) 1999 Simo S�rkk�
% Copyright (C) 2004 Aki Vehtari
%
% This software is distributed under the GNU General Public
% Licence (version 3 or later); please refer to the file
% Licence.txt, included with the software, for details.

% In case of one argument split to two halves (first and last thirds)
onechain=0;
if nargin==1
  X = varargin{1};
  if size(X,3)==1
    n = floor(size(X,1)/3);
    x = zeros([n size(X,2) 2]);
    x(:,:,1) = X(1:n,:);
    x(:,:,2) = X((end-n+1):end,:);
    X = x;
    onechain=1;
  end
elseif nargin==0
  error('Cannot calculate PSRF of scalar');
else
  X = zeros([size(varargin{1}) nargin]);
  for i=1:nargin
    X(:,:,i) = varargin{i};
  end
end

[N,D,M]=size(X);

if N<1
  error('Too few samples');
end

W = zeros(1,D);
V = zeros(1,D);
for d=1:D
  x=X(:,d,:);
  W(1,d)=mean(diff(prctile(x,[10 90])));
  V(1,d)=diff(prctile(x(:),[10 90]));
end
R = V./W;


function sparse_test04 ( )

%*****************************************************************************80
%
%% SPARSE_TEST04 demonstrates incrementing a sparse matrix.
%
%  Discussion:
%
%    For this example, we show that you don't need to have the entire
%    sparse matrix data available in order to start defining the matrix.
%    (Of course, it is more efficient to make fewer calls, with more data,
%    but it is not the only way to work.)
%
%    For simplicity, we assume the matrix is 10 x 10, and we
%    generate 50 random coordinate pairs (I,J), and increment them by 1.
%    Initially, the sparse matrix is empty, but each time we call,
%    we are either creating a new entry, or incrementing an existing one.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    13 April 2014
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    George Lindfield, John Penny,
%    Numerical Methods Using MATLAB,
%    Prentice Hall, 1999
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'SPARSE_TEST04:\n' );
  fprintf ( 1, '  Demonstrate the use of MATLAB''s SPARSE facility\n' );
  fprintf ( 1, '  to set or increment a matrix one entry at a time.\n' );
%
%  This defines an "empty" sparse matrix.
%
  i = [];
  j = [];
  v = [];
  m = 10;
  n = 10;

  a = sparse ( i, j, v, m, n );

  fprintf ( 1, '\n' );
  fprintf ( 1, '     I     J  New A(I,J)\n' );
  fprintf ( 1, '\n' );

  for test = 1 : 50

    i = round ( 10.0 * rand ( ) + 0.5 );
    j = round ( 10.0 * rand ( ) + 0.5 );
    a(i,j) = a(i,j) + 1;
%
%  FPRINTF won't print a sparse matrix reference,
%  so you have to convert it to FULL first.
%
    fprintf ( 1, '  %4d  %4d  %g\n', i, j, full ( a(i,j) ) );

  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Number of nonzero entries is %d\n', nnz ( a ) );
%
%  FPRINT won't print the SUM SUM of A,
%  so you have to convert it to FULL first.
%
  fprintf ( 1, '  Sum of entries is %f\n', full ( sum ( sum ( a ) ) ) );
%
%  Typing "a" will list the sparse triplet form of the matrix.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Matrix printed in sparse triplet form:\n' );
  fprintf ( 1, '\n' );

  a
%
%  To see the usual layout, you must convert it to FULL.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Matrix printed in usual full matrix form:\n' );
  fprintf ( 1, '\n' );

  full ( a )

  return
end


function linplus_test1566 ( )

%*****************************************************************************80
%
%% TEST1566 tests R8BUT_MXV, R8BUT_PRINT, R8BUT_RANDOM, R8BUT_SL, R8BUT_VXM.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 March 2009
%
%  Author:
%
%    John Burkardt
%
  mu = 3;
  n = 10;
  seed = 123456789;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST1566\n' );
  fprintf ( 1, '  For a band matrix in upper triangular storage,\n' );
  fprintf ( 1, '  R8BUT_RANDOM sets a random value;\n' );
  fprintf ( 1, '  R8BUT_SL solves systems;\n' );
  fprintf ( 1, '  R8BUT_MXV computes matrix-vector products;\n' );
  fprintf ( 1, '  R8BUT_VXM computes vector-matrix products;\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Matrix order N =     %d\n', n );
  fprintf ( 1, '  Upper bandwidth MU = %d\n', mu );

  [ a, seed ] = r8but_random ( n, mu, seed );

  r8but_print ( n, mu, a, '  The R8BUT matrix:' );

  for job = 0 : 1
%
%  Set the desired solution.
%
    x = r8vec_indicator ( n );
%
%  Compute the corresponding right hand side.
%
    if ( job == 0 )
      b = r8but_mxv ( n, mu, a, x );
    else
      b = r8but_vxm ( n, mu, a, x );
    end

    r8vec_print ( n, b, '  The right hand side:' );
%
%  Solve the linear system.
%
    x = r8but_sl ( n, mu, a, b, job );

    if ( job == 0 )
      r8vec_print ( n, x, '  Solution to the untransposed system:' );
    else
      r8vec_print ( n, x, '  Solution to the transposed system:' );
    end

  end

  return
end


function M=minMatOverDim(C,minIdx)
%%MINMATOVERDIM Given a multidimensional matrix C, this function returns
%           matrix M that is obtained by minimizing C over the given
%           dimension and removing the given dimension. This is equivalent
%           to using a call to min(C,[],minIdx) in Matlab. However, here,
%           we do it without using any matrix/ vector commands so that it
%           can mirror how one might implement such a function in C.
%
%INPUTS: C A real n1Xn2Xn3..XnS S-dimensional hypermatrix.
%   minIdx The real index from 1 to S over which the minimization should be
%          performed.
%
%OUTPUTS: M An n1X...n(minIdx-1)X1Xn(minIdx+1)X...nS matrix holding the
%           minimum values over the specified dimension.
%
%The algorithm consists of two types of steps. First, a step in the linear
%indexation of C to go from one value of an index in spot minIdx is
%prod(nVals(1:(minIdx-1))), where nVals=size(C). Thus, we can go from one
%element to the next for the minimization. For a 3D matrix, the step to go
%from C(i1,1,i2) to C(i1+1,1,i2) increments by 1. However, to go from
%C(n1,1,i2) to C(1,1,i2+1) is a step of prod(nVals(1:minIdx)). The same
%type of thing applies to a matrix with more dimensions, since all
%dimensions before the one in question and after can be collapsed into 1
%dimension. Thus, this function puts the above rules together to go
%minimize the matrix.
%
%EXAMPLE:
%Here, we just show that the results are equivalent to using the min
%command with a resize.
% C=randn(13,18,11,6,9);
% minIdx=3;
% M=minMatOverDim(C,minIdx);
% MAlt=min(C,[],minIdx);
% all(M(:)==MAlt(:))
%The result is 1, indicating that the two values are equal.
%
%March 2018 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

nVals=size(C);
S=numel(nVals);

if(minIdx<1)
    error('Invalid value of minIdx given.')
end

if(minIdx>S)
    M=C;
    return;
end

MDims=nVals;
MDims(minIdx)=1;
M=zeros(MDims);

totalNumElsM=prod(MDims);

%Note that prod([])=1
incrMinIdx=prod(nVals(1:(minIdx-1)));

incrBigStep=incrMinIdx*nVals(minIdx);

CStartIdx=0;
curMCol=0;
for curEl=0:(totalNumElsM-1)
    curIdx=CStartIdx;
    minVal=C(curIdx+1);

    curIdx=curIdx+incrMinIdx;
    for i=2:nVals(minIdx)
        curVal=C(curIdx+1);

        if(curVal<minVal)
            minVal=curVal;
        end

        curIdx=curIdx+incrMinIdx;
    end
    M(curEl+1)=minVal;

    %If a big step has to be taken.
    if(mod(curEl+1,incrMinIdx)==0)
        curMCol=curMCol+1;

        CStartIdx=incrBigStep*curMCol;
    else
        CStartIdx=CStartIdx+1;
    end
end
end

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


function fx = p02_fun ( n, x )

%*****************************************************************************80
%
%% P02_FUN evaluates the integrand for problem 2.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    17 January 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Gwynne Evans,
%    Practical Numerical Integration,
%    Wiley, 1993,
%    ISBN: 047193898X,
%    LC: QA299.3E93.
%
%  Parameters:
%
%    Input, integer N, the number of evaluation points.
%
%    Input, real X(2,N), the evaluation points.
%
%    Output, real FX(N,1), the integrand values.
%
  fx(1:n,1) = 1.0 ./ sqrt ( 1.0 - x(1,1:n).^2 .* x(2,1:n).^2 );

  return
end


function moc_display ( a, b, n, f )

%*****************************************************************************80
%
%% MOC_DISPLAY plots data related to the modulus of continuity of a function.
%
%  Discussion:
%
%    Three graphs will be shown:
%    1) A plot of F(X) from A to B.
%    2) A plot of the function MC1(X) for 0 <= T <= B-A, where
%       MC1(T) = max | F(X+DX) - F(X) |, for DX = T, X and X+DX in [A,B].
%    3) A plot of the function MC(X) for 0 <= T <= B-A, where
%       MC(T) = max | F(X+DX) - F(X) |, for DX <= T, X and X+DX in [A,B].
%
%    The functions MC1 and MC are estimated by evaluating F(X) at N
%    equally spaced points in [A,B].
%
%    MC(T) is known as the "modulus of continuity" for F(X);
%    MC1(T) has no special name.
%
%    The exact function MC(T) should be a monotone increasing function.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 October 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real A, B, the left and right endpoints of the interval.
%
%    Input, integer N, the number of equally spaced sample points used to
%    estimate MC1(T) and MC(T).
%
%    Input, function F(x), a handle to the function whose modulus of
%    continuity function is to be estimated and plotted.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'MOC_DISPLAY:\n' );
  fprintf ( 1, '  Estimate and plot the Modulus of Continuity function\n' );
  fprintf ( 1, '  over an interval [A,B], using N sample points, and a\n' );
  fprintf ( 1, '  user-specified function F(X).\n' );

  if ( nargin < 1 )
    a = 0.0;
  end

  if ( nargin < 2 )
    b = a + 1.0;
  end

  if ( nargin < 3 )
    n = 501;
  end
%
%  Compute discrete data for given N.
%
  x = linspace ( a, b, n );
  dx = linspace ( 0, b - a, n );
  fx = f ( x );

  mc1 = zeros ( n, 1 );
  for i = 0 : n - 1
    mc1(i+1) = max ( abs ( fx(1+i:n) - fx(1:n-i) ) );
  end

  mc = zeros ( n, 1 );
  for i = 1 : n - 1
    mc(i+1) = max ( mc(i), mc1(i+1) );
  end
%
%  Display the plots.
%
  subplot ( 3, 1, 1 )
  n_fine = 1000;
  x_fine = linspace ( a, b, n_fine );
  fx_fine = f ( x_fine );
  plot ( x_fine, fx_fine, 'LineWidth', 2 )
  grid on
  title ( 'F(X)' );

  subplot ( 3, 1, 2 )
  plot ( dx, mc1, 'LineWidth', 2 );
  grid on
  title ( sprintf ( 'MC1(DX): max |F(X+DX)-F(X)|, N = %d', n ) )

  subplot ( 3, 1, 3 )
  plot ( dx, mc, 'LineWidth', 2 );
  grid on
  title ( sprintf ( 'MC(T): max |F(X+DX)-F(X)| for DX <= T, N = %d', n ) )

  return
end


function c_nm = sphMultiplication(a_nm, b_nm, G)
%SPHMULTIPLICATION Computes coefficients of a product spherical function
%
%   The coefficients of a product function of two spherical functions can
%   be given directly as a linear combination of the coefficients of the
%   original functions, by employing Gaunt coefficients
%
%   a_nm: (N+1)^2 coefficients of spherical function a(\theta,\phi)
%   b_nm: (N+1)^2 coefficients of spherical function b(\theta,\phi)
%
%   c_nm:  (N+1)^2 coefficients of the product function
%           c(\theta,\phi) = a(\theta,\phi)*b(\theta,\phi)
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%   Archontis Politis, 10/10/2013
%   archontis.politis@aalto.fi
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% order
Na = sqrt(length(a_nm)) - 1;
Nb = sqrt(length(b_nm)) - 1;
Nc = Na+Nb;

c_nm = zeros((Nc+1)^2, 1);
% evaluate the coefficients of the product through the gaunt coefficients
if nargin<3
    G = gaunt_mtx(Na, Nb, Nc);
end
for n=0:Nc
    for m=-n:n
        q = n*(n+1)+m;
        c_nm(q+1) = a_nm.' * G(:,:,q+1) * b_nm;

    end
end

end


function m = imMoment(img, p, q)
%IMMOMENT  Compute simple moment(s) of an image
%
%   M_PQ = imMoment(IMG, P, Q)
%   P is order for x coord, Q is order for y coord.
%
%   Example
%   % generate image
%   img = zeros([5 6]);
%   img(2:3, 2:5) = 1;
%   % compute total mass of image
%   m00  = imMoment(img, 0, 0);
%   % compute centroid
%   cx  = imMoment(img, 1, 0)/m00;
%   cy  = imMoment(img, 0, 1)/m00;
%
%
%   See also
%     imEquivalentEllipse, imPrincipalAxes
%

% ------
% Author: David Legland
% e-mail: david.legland@inra.fr
% Created: 2008-10-08,    using Matlab 7.4.0.287 (R2007a)
% Copyright 2008 INRA - BIA PV Nantes - MIAJ Jouy-en-Josas.

% image dimension
dim = size(img);
Dx = dim(2);
Dy = dim(1);

% compute x and y for each pixel
Ix = repmat((1:Dx), [Dy 1]);
Iy = repmat((1:Dy)', [1 Dx]);

% compute moment
m = zeros(size(p));
for i=1:length(p(:))
    m(i) = sum(Ix(:).^p(i) .* Iy(:).^q(i) .* img(:));
end


function [W, R, P] = miso_firwiener(N, X, y)
%MISO_FIRWIENER Optimal FIR Wiener filter for multiple inputs.
%   MISO_FIRWIENER(N, X, Y) computes the optimal FIR Wiener filter of
%   order N, given any number of (stationary) random input signals as
%   the columns of matrix X, and one output signal in column vector Y.

%   Author: Keenan Pepper
%   Last modified: 2007-12-21

%   References:
%     [1] Y. Huang, J. Benesty, and J. Chen, Acoustic MIMO Signal
%     Processing, Springer−Verlag, 2006, page 48

% Number of input channels.
M = size(X, 2);

% Input covariance matrix, in abbreviated block Toeplitz form.
R = zeros(M*(N+1), M);
for m = 1:M
    for i = 1:M
         rmi = xcorr(X(:,m), X(:,i), N);
         Rmi = flipud(rmi(1:N+1));
         top = (m-1) * (N+1) + 1;
         bottom = m * (N+1);
         R(top:bottom,i) = Rmi;
    end
end

R = reshape(R, [N+1,M,M]);      % This just permutes the indices to
R = permute(R, [2,1,3]);        % change R from Toeplitz-block to
R = reshape(R, [M*(N+1),M]);    % block-Toeplitz.

% Cross−correlation vector.
P = zeros(1, M*(N+1));
for i = 1:M
    top = (i-1)*(N+1)+1;
    bottom = i * (N+1);
    p = xcorr(y, X(:,i), N);
    P(top:bottom) = p(N+1:2*N+1)';
end

P = reshape(P, [N+1,M]);        % More index rearrangement.
P = reshape(P', [M*(N+1),1]);

W = block_levinson(P, R);

W = reshape(W, [M,N+1]);        % Make output compatible with earlier
W = reshape(W', [1, M*(N+1)]);  % version.


%  追赶法 分解的紧凑方式
function [x] = my_forward_backward(A,f)

[m,n]=size(A);
if (m~=n)
    fprintf('\n Error: A 不是方阵!\n'); return;
end

a = diag(A, -1);
a(2:n) = a;
a(1) = 0;
b = diag(A);
c = diag(A, 1);

% 判断是否三对角矩阵
if sum(any(tril(A, -2))) > 0 | sum(any(triu(A, 2))) > 0
    fprintf('\n Error: A 不是三对角矩阵!\n'); x = [];  return;
end

% 判断是否对角占优
if (abs(b(1)) <= abs(c(1)) | abs(c(1)) == 0 | find(abs(b(2:n-1)) < abs(a(2:n-1)) + abs(c(2:n-1))) > 0 | abs(b(n)) <= abs(a(n))) | abs(a(n)) == 0
  fprintf('\n Error: A 不是对角占优矩阵!\n'); x = [];  return;
end

alpha = zeros(n, 1);
beda = zeros(n-1, 1);
gamma = a;   % gamma直接等于a，无需计算

alpha(1) = b(1);
for i = 1 : n - 1
    beda(i) = c(i) / alpha(i);
    alpha(i + 1) = b(i + 1) - a(i + 1) * beda(i);
end

% 求解Ly=b 和 Ux=y
y(1) = f(1) / b(1);
for i=2:n
    y(i)=(f(i) - a(i)*y(i-1)) / alpha(i);
end
x(n) = y(n);
for i = n-1 : -1 : 1
    x(i)=y(i) - beda(i) * x(i+1);
end

% END


 function X = dtft1(x, omega, n_shift)
%function X = dtft1(x, omega, n_shift)
%| Compute DTFT of 1D signal x at frequency locations wx
%| In
%|	x	[N,ncol]	signal values
%|	omega	[M,1]		frequency locations
%|	n_shift	[1,1]		use [0:(N-1)]-n_shift indices
%| Out
%|	X	[M,ncol]	DTFT values
%|
%| This needs enough memory to store M * N size matrices
%| Copyright 2000-1-9, Jeff Fessler, University of Michigan

if nargin == 1 && streq(x, 'test'), dtft1_test, return, end
if nargin < 2, ir_usage(), end

N = size(x,1);
if ~isvar('n_shift') || isempty(n_shift), n_shift = 0; end
nn = [0:(N-1)] - n_shift;

X = exp(-1i*omega*nn) * x; % compute 1D DTFT

function dtft1_test()
N = 4;
x = [[1:N]', [1 1 2 2]'];	% two test signal
omega = 2*pi*[0:(N-1)]'/N;	% test with uniform frequency locations
Xd = dtft1(x, omega);
Xf = fft(x);
%disp([Xd Xf])
printm('max %% difference = %g', max_percent_diff(Xf,Xd))


%
% Perform minmax norm
%
function [output, input_min, input_max, scale] = MinMaxNorm(input,min_val, max_val)
if nargin==1
    min_val = -1;
    max_val = 1;
end

input_min = min(input(:));
input_max = max(input(:));

input_range = input_max-input_min;
target_range = max_val - min_val;
scale = target_range ./ input_range;

output = bsxfun(@plus, input, -input_min);
output = bsxfun(@times, output, scale);
output = bsxfun(@plus, output, min_val);

end


function p = MS_fnn(y,de,tau,th,kth);
% function nfnn = MS_fnn(y,de,tau,th,kth)
%
% determine the number of false nearest neighbours for the time
% series y embedded in dimension de with lag tau.
%
% for each pair of values (de,tau) the data y is embeded and the
% nearest neighbour to each point (excluding the immediate
% neighbourhood of n points) is determined. If the ratio of the
% distance of the next (kth) points and these points is greater than
% th then they are counted as false nearest neighbours.
%
% default:
% th=5
% kth=1
%
% p(i,j) is the proportion of false nearest neighbours for de(i)
% and tau(j).
%
% Michael Small
% michael.small@uwa.edu.au, http://school.maths.uwa.edu.au/~small/
% 3/3/2005
% For further details, please see M. Small. Applied Nonlinear Time Series
% Analysis: Applications in Physics, Physiology and Finance. Nonlinear Science
% Series A, vol. 52. World Scientific, 2005. (ISBN 981-256-117-X) and the
% references therein.
% (minor cosmetic changes made by Ben Fulcher, 2010)

if nargin < 5
  kth = 1;
  disp(['th = ',int2str(kth)]);
end
if nargin < 4
  th = 5;
  disp(['th = ',int2str(th)]);
end
if nargin < 3
  tau = MS_firstzero(y);
  disp(['tau = ',int2str(tau)]);
end
if nargin < 2
  de = [1:10];
  disp(['de = ',int2str(de(1)),':',int2str(de(end))]);
end

p=[];
for t=tau,
  px=[];
  for d=de
    %embed the data
    X=MS_embed(y,d,t);
    [dx,nx]=size(X);

    %find the nearest neighbours of each point
    ind=MS_nearest(X(:,1:(nx-kth)),tau); %whooh hooo!

    %distance between each point and its nearest neighbour
    d0=MS_rms(X(:,(1:(nx-kth)))'-X(:,ind)');
    %... and after one time step
    d1=MS_rms(X(:,(kth+1):nx)'-X(:,ind+1)');

    %exclude any coincident points
    d1(d0==0)=[];
    d0(d0==0)=[];

    %calculate the proportion fnn
    ifnn=sum((d1./d0)>th)/length(d0);

    %disp
    % disp(['tau = ', int2str(t),', de = ',int2str(d),', nfnn = ',num2str(ifnn*100),'%']);

    px=[px ifnn];
  end;

  p=[p;px];

end;

p=p';


function geometry_test0183 ( )

%*****************************************************************************80
%
%% TEST0183 tests CIRCLE_LLR2IMP_2D.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 December 2010
%
%  Author:
%
%    John Burkardt
%
  p_hi =  10.0;
  p_lo = -10.0;
  test_num = 5;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST0183\n' );
  fprintf ( 1, '  CIRCLE_LLR2IMP_2D is given:\n' );
  fprintf ( 1, '  a line through P1 and P2,\n' );
  fprintf ( 1, '  a line through Q1 and Q2,\n' );
  fprintf ( 1, '  and a radius R,\n' );
  fprintf ( 1, '  and determines the centers C of 4 circles\n' );
  fprintf ( 1, '  of the given radius, tangent to both lines.\n' );

  seed = 123456789;

  for test = 1 : test_num

    [ p1(1:2,1), seed ] = r8vec_uniform ( 2, p_lo, p_hi, seed );
    [ p2(1:2,1), seed ] = r8vec_uniform ( 2, p_lo, p_hi, seed );
    [ q1(1:2,1), seed ] = r8vec_uniform ( 2, p_lo, p_hi, seed );
    [ q2(1:2,1), seed ] = r8vec_uniform ( 2, p_lo, p_hi, seed );

    r_lo = 1.0;
    r_hi = 5.0;
    [ r, seed ] = r8_uniform ( r_lo, r_hi, seed );

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Radius R = %f\n', r );

    fprintf ( 1, '  Point #P1: %f  %f\n', p1(1:2,1) );
    fprintf ( 1, '  Point #P2: %f  %f\n', p2(1:2,1) );
    fprintf ( 1, '  Point #Q1: %f  %f\n', q1(1:2,1) );
    fprintf ( 1, '  Point #Q2: %f  %f\n', q2(1:2,1) );

    pc = circle_llr2imp_2d ( p1, p2, q1, q2, r );

    fprintf ( 1, '  Center #1: %f  %f\n', pc(1:2,1) );
    fprintf ( 1, '  Center #2: %f  %f\n', pc(1:2,2) );
    fprintf ( 1, '  Center #1: %f  %f\n', pc(1:2,3) );
    fprintf ( 1, '  Center #2: %f  %f\n', pc(1:2,4) );

    d1 = line_exp_point_dist_2d ( p1, p2, pc(1:2,1) );
    d2 = line_exp_point_dist_2d ( p1, p2, pc(1:2,2) );
    d3 = line_exp_point_dist_2d ( p1, p2, pc(1:2,3) );
    d4 = line_exp_point_dist_2d ( p1, p2, pc(1:2,4) );

    fprintf ( 1, '  %f  %f  %f  %f\n', d1, d2, d3, d4 );

    d1 = line_exp_point_dist_2d ( q1, q2, pc(1:2,1) );
    d2 = line_exp_point_dist_2d ( q1, q2, pc(1:2,2) );
    d3 = line_exp_point_dist_2d ( q1, q2, pc(1:2,3) );
    d4 = line_exp_point_dist_2d ( q1, q2, pc(1:2,4) );

    fprintf ( 1, '  %f  %f  %f  %f\n', d1, d2, d3, d4 );

  end

  return
end


function [X, info] = dominant_invariant_subspace_complex(A, p)
% Returns a unitary basis of the dominant invariant p-subspace of A.
%
% function X = dominant_invariant_subspace_complex(A, p)
%
% Input: A complex, Hermitian matrix A of size nxn and an integer p < n.
% Output: A complex, unitary matrix X of size nxp such that trace(X'*A*X)
%         is maximized. That is, the columns of X form a unitary basis
%         of a dominant subspace of dimension p of A.
%
% The optimization is performed on the complex Grassmann manifold, since
% only the space spanned by the columns of X matters.
%
% See dominant_invariant_subspace for more details in the real case.
%
% See also: dominant_invariant_subspace grassmanncomplexfactory

% This file is part of Manopt and is copyrighted. See the license file.
%
% Main author: Nicolas Boumal, June 30, 2015
% Contributors:
%
% Change log:
%
%   Xiaowen Jiang Aug. 31, 2021
%       Added AD to compute the egrad and the ehess

    % Generate some random data to test the function
    if ~exist('A', 'var') || isempty(A)
        A = randn(128) + 1i*randn(128);
        A = (A+A')/2;
    end
    if ~exist('p', 'var') || isempty(p)
        p = 3;
    end

    % Make sure the input matrix is Hermitian
    n = size(A, 1);
    assert(size(A, 2) == n, 'A must be square.');
    assert(norm(A-A', 'fro') < n*eps, 'A must be Hermitian.');
	assert(p<=n, 'p must be smaller than n.');

    % Define the cost and its derivatives on the complex Grassmann manifold
    Gr = grassmanncomplexfactory(n, p);
    problem.M = Gr;
    problem.cost  = @(X)    -real(trace(X'*A*X));
    problem.egrad = @(X)    -2*A*X;
    problem.ehess = @(X, H) -2*A*H;

    % An alternative way to compute the egrad and the ehess is to use
    % automatic differentiation provided in the deep learning toolbox
    % (slower). AD does not support complex numbers if the Matlab version
    % is R2021a or earlier. The cost function should be defined differently
    % In this case. See complex_example_AD.m and manoptADhelp.m for more
    % information.
    % problem.cost = @cost_complex;
    %    function f = cost_complex(X)
    %        AX = cprod(A,X);
    %        Xtransp = ctransp(X);
    %        product = cprod(Xtransp,AX);
    %        f = -creal(ctrace(product));
    %    end
    % call manoptAD to automatically obtain the egrad and the ehess
    % problem = manoptAD(problem);

    % If the version of Matlab installed is R2021b or later, specify the
    % cost function in the normal way and call manoptAD. Notice that
    % the function trace is not supported for AD so far. Replace it with
    % ctrace described in the file manoptADhelp.m
    % problem.cost  = @(X)    -real(ctrace(X'*A*X));
    % problem = manoptAD(problem);

    % Execute some checks on the derivatives for early debugging.
    % These can be commented out.
    % checkgradient(problem);
    % pause;
    % checkhessian(problem);
    % pause;

    % Issue a call to a solver. A random initial guess will be chosen and
    % default options are selected except for the ones we specify here.
    options.Delta_bar = 8*sqrt(p);
    [X, costX, info, options] = trustregions(problem, [], options); %#ok<ASGLU>

    fprintf('Options used:\n');
    disp(options);

    % For our information, Manopt can also compute the spectrum of the
    % Riemannian Hessian on the tangent space at (any) X. Computing the
    % spectrum at the solution gives us some idea of the conditioning of
    % the problem. If we were to implement a preconditioner for the
    % Hessian, this would also inform us on its performance.
    %
    % Notice that (typically) all eigenvalues of the Hessian at the
    % solution are positive, i.e., we find an isolated minimizer. If we
    % replace the Grassmann manifold by the Stiefel manifold, hence still
    % optimizing over orthonormal matrices but ignoring the invariance
    % cost(XQ) = cost(X) for all Q orthogonal, then we see
    % dim O(p) = p(p-1)/2 zero eigenvalues in the Hessian spectrum, making
    % the optimizer not isolated anymore.
    if Gr.dim() < 512
        evs = hessianspectrum(problem, X);
        stairs(sort(evs));
        title(['Eigenvalues of the Hessian of the cost function ' ...
               'at the solution']);
        xlabel('Eigenvalue number (sorted)');
        ylabel('Value of the eigenvalue');
    end

end


function [q] = MeshQuality(EToV,VX,VY)
%
% Purpose: Assess the triangle mesh quality using a mesh quality indicators.
%          q=2r/R, where r is the inradius and R is the circumradius of a
%          triangle.
%
%          Function is useful for detecting degenerate triangles.
%
%          EToV : Element-To-Vertice table
%          VX   : x-table for vertices
%          VY   : y-table for vertices
%
% By Allan P. Engsig-Karup, apek@imm.dtu.dk.

% Compute side lengths of triangles
lx = VX(EToV(:,[1 2 3])) - VX(EToV(:,[3 1 2]));
ly = VY(EToV(:,[1 2 3])) - VY(EToV(:,[3 1 2]));
l = sqrt(lx.^2+ly.^2);
a = l(:,1); b = l(:,2); c = l(:,3);
q = (b+c-a).*(c+a-b).*(a+b-c)./(a.*b.*c);

N = 100;
x = linspace(0,1,N+1);
dx = x(2)-x(1);
subdivision = x(1:N)+dx/2;
count = zeros(1,N);
K = size(EToV,1);
for i = 1 : length(subdivision)
    count(i) = length(find(q>subdivision(i)-dx/2 & q<=subdivision(i)+dx/2))/K*100;
end
figure
bar(subdivision,count,1)
minlimit = find(q<0.7);
if isempty(minlimit)
    axis([0.7 1 -1 max(count)*1.05])
else
    axis([min(q) 1 -1 max(count)*1.05])
    hold on
    plot([0.7 0.7],[0 100],'r--')
end
xlabel('Mesh quality')
ylabel('Percentage of elements')
colormap(cool)


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

%*****************************************************************************80
%
%% FRESNEL_SIN_VALUES returns some values of the Fresnel sine integral function.
%
%  Discussion:
%
%    The Fresnel sine integral is defined by
%
%      S(X) = integral ( 0 <= T <= X ) sin ( pi * T^2 / 2 ) / T dT
%
%    In Mathematica, the function can be evaluated by:
%
%      FresnelS[x]
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Milton Abramowitz and Irene Stegun,
%    Handbook of Mathematical Functions,
%    US Department of Commerce, 1964.
%
%    Stephen Wolfram,
%    The Mathematica Book,
%    Fourth Edition,
%    Wolfram Media / Cambridge University Press, 1999.
%
%  Parameters:
%
%    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
%    first call.  On each call, the routine increments N_DATA by 1, and
%    returns the corresponding data; when there is no more data, the
%    output value of N_DATA will be 0 again.
%
%    Output, real X, the argument of the function.
%
%    Output, real FX, the value of the function.
%
  n_max = 16;

  fx_vec = [ ...
     0.0000000000000000E+00, ...
     0.4187609161656762E-02, ...
     0.3335943266061318E-01, ...
     0.1105402073593870E+00, ...
     0.2493413930539178E+00, ...
     0.4382591473903548E+00, ...
     0.6234009185462497E+00, ...
     0.7135250773634121E+00, ...
     0.6388876835093809E+00, ...
     0.4509387692675831E+00, ...
     0.3434156783636982E+00, ...
     0.4557046121246569E+00, ...
     0.6196899649456836E+00, ...
     0.5499893231527195E+00, ...
     0.3915284435431718E+00, ...
     0.4963129989673750E+00 ];

  x_vec = [ ...
     0.0E+00, ...
     0.2E+00, ...
     0.4E+00, ...
     0.6E+00, ...
     0.8E+00, ...
     1.0E+00, ...
     1.2E+00, ...
     1.4E+00, ...
     1.6E+00, ...
     1.8E+00, ...
     2.0E+00, ...
     2.2E+00, ...
     2.4E+00, ...
     2.6E+00, ...
     2.8E+00, ...
     3.0E+00 ];

  if ( n_data < 0 )
    n_data = 0;
  end

  n_data = n_data + 1;

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

  return
end


% Algorithm for finding connected components in a graph
% Note: Valid for undirected graphs only.
%
% INPUTS: adj - adjacency matrix, nxn
% OUTPUTS: a list of the components comp{i}=[j1,j2,...jk]
%
% Other routines used: findConnCompI.m, degrees.m
% GB: last updated, September 22, 2012

function comp_mat = findConnComp(adj)

[deg,~,~]=degrees(adj);            % degrees
comp_mat={};                       % initialize components matrix

for i=1:length(deg)
    if deg(i)>0
        done=0;
        for x=1:length(comp_mat)
            if length(find(comp_mat{x}==i))>0   % i in comp_mat(x).mat
                done=1;
                break
            end
        end
        if not(done)
            comp=findConnCompI(adj,i);
            comp_mat{length(comp_mat)+1}=comp;
        end

    elseif deg(i)==0
        comp_mat{length(comp_mat)+1}=[i];
    end

end


function [pvalue Vlstar Vl] = WhiteRealityCheck( alternative , flag, benchmark , n , display)

%% This file contains the White reality check for data snooping
%  -   This can be used to test whether atleast one of the created models
%  outperforms a benchmark model
%  - This can also be used to test whether you have found atleast one profitable
%  trading strategy, or test whether you have found atleast one trading
%  strategy that outperforms the benchmark.

%  The H0 hypothesis is always  that you have not found an outperforming
%  strategy or model

% input:
% 'Alternative' is a matrix with  Returns ==> [-1 , +Inf ]
%  or residuals of predictions with a model ==> [ -Inf ; +Inf]
% Important, the rows stand for new observation the columns for the models
%  'Flag'  indicates which loss function you want to use
%  Flag = 1 test for model superiority vs benchmark by mean squared error
%  Flag = 2 test for trading return superiorty vs benchmark
%  Flag = 3 test for model superiority vs benchmark by absolute error
% 'Benchmark' contains a vector with - (1) The residuals from the predictions
% of the benchmark model , (2) The returns of your benchmark trading
% strategy, (3) Special case where Benchmark is the single number 0 where
% your benchmark is zero.
%  'n' is the number of bootstrapped series you want to create aka the
%  number of simulations. In academic papers this is usually  set
%  to atleast 500 for reasonable results
% 'display' is a number [ 0, 1] if 0 then display is set off if 1 then
% display is on

% Examples of possibles testing can be found in help.txt file

[r,~]=size(alternative);

%  condition whether you have a benchmark or you want to test vs 0
if benchmark ~=0|| numel(benchmark)>1
    mat = repmat(benchmark,1,c);
else
    mat = benchmark; % mat = 0 benchmark is zero
end

% %  loss functions
if flag ==1
     f = - alternative.^2 + mat.^2;
elseif flag==2
    f = log(1+alternative)-log(1+mat);
elseif flag ==3
    f = - abs (alternative) + abs(mat);
end

%  input for average block size for P&R bootstrap (geometric distribution)
input = inputdlg('What do you want as average block size for the Politis Romano stationary bootstrap?');
blockparam = 1/(str2num(input{1})+1);

% Actual Politis Romano bootstrap as described in Politis& Romano (1994)
fstarroof =  PolitisRomanoBootstrap( alternative , n , blockparam,display,flag,mat);

froof = mean(f,1);
Vl = max(sqrt(r)*froof);

delta = fstarroof - repmat(froof,n,1);
Vlstar = max(sqrt(r)*delta,[],2);

Vlstar = sort(Vlstar);

% 'Vl' and 'Vlstar' are the same as in the paper of
% Sullivan, Timmermann and White (1999) or White(2000)

better = Vlstar>Vl;

pvalue = sum(better)/n;

% compare Vl and Vlstar to get the p-value


function a = pds_random ( n, key )

%*****************************************************************************80
%
%% PDS_RANDOM returns a random positive definite symmetric matrix.
%
%  Discussion:
%
%    The matrix returned will have eigenvalues in the range [0,1].
%
%  Properties:
%
%    A is symmetric: A' = A.
%
%    A is positive definite: 0 < x'*A*x for nonzero x.
%
%    The eigenvalues of A will be real.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    17 March 2015
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of A.
%
%    Input, integer KEY, a positive value that selects the data.
%
%    Output, real A(N,N), the matrix.
%

%
%  Get a random set of eigenvalues.
%
  seed = key;
  [ lambda, seed ] = r8vec_uniform_01 ( n, seed );
%
%  Get a random orthogonal matrix Q.
%
  q = orth_random ( n, key );
%
%  Set A = Q * Lambda * Q'.
%
  a = zeros ( n, n );

  for i = 1 : n
    for j = 1 : n
      a(i,j) = 0.0;
      for k = 1 : n
        a(i,j) = a(i,j) + q(i,k) * lambda(k) * q(j,k);
      end
    end
  end

  return
end


function ph=phase4(cp,mode)
% PHASE4 4 Quadrant arctangent.
%        PHASE4 provides a 4 quadrant arctangent of a complex number such
%        that -360 < PH <= 0.  It also takes care of wrapping when
%        necessary.

% Author: Craig Borghesani
% Date: 8/17/94
% Revised: 10/24/94
% Copyright (c) 1999, Prentice-Hall

ph = atan2(imag(cp),real(cp));

if nargin == 1, % normal phase computation for frequency response plots

 ph = ph - 2*pi*(ph>1e-5);

else % unwrap phase values for gain (phase) plot

 [r,c] = size(ph);
 for k = 1:c,
  dph = diff(ph(:,k));
  loc_brk = find(abs(dph)>pi);
  if length(loc_brk),
   brks = loc_brk;
   if dph(loc_brk(1)) > 0, brks = [0;brks]; end
   if dph(loc_brk(length(loc_brk))) < 0, brks = [brks;length(ph)]; end
   for k2 = 1:2:length(brks),
    ph((brks(k2)+1):(brks(k2+1)),k) = ph((brks(k2)+1):(brks(k2+1)),k) + 2*pi;
   end
  end
 end

end


function A = construct_incidence_matrix(measurements)
%function A = construct_incidence_matrix(measurements)
%
% This function computes and returns the oriented incidence matrix of the
% underlying directed graph of measurements:
%
% A_{ie} =  -1, if edge e *leaves* node i,
%           +1, if edge e *enters* node i,
%           0, otherwise.
%
% (see eq. (7) in the paper).

% Copyright (C) 2016 by David M. Rosen

N = max(max(measurements.edges));  % Number of nodes in the pose graph
M = size(measurements.edges, 1);  % Number of edges in the pose graph

out_nodes = measurements.edges(:, 1)';  %out_nodes(e) = i if edge e leaves node i
in_nodes = measurements.edges(:, 2)';  %out_nodes(e) = j if edge e enters node i

node_indices = [out_nodes, in_nodes];
edge_indices = [ [1:M], [1:M] ];
vals = [-ones(1, M), ones(1, M)];

A = sparse(node_indices, edge_indices, vals, N, M);

end


% Mesh spectrum

function [L,H,d] = mesh_spectrum(S,n,mode)

%[L,H,d] = ct_mesh_spectrum(S,n,mode)
% Compute the mesh laplace matrix and its spectrum
% input,
% S: mesh file, it has to have a pnt and a tri field
% n: number of mesh harmonic functions
% mode: 'full' for the full graph, 'half' if you want to do the first and
% the second half independently (this is useful if your graph is composed
% by two connected components) -> JM note: I don't understand this
% output,
% L: mesh laplacian matrix
% H: matrix containing a mesh harmonic functions per column
% d: spectrum of the negative Laplacian matrix, its units are 1/space^2
% (spatial frequencies are obtained as sqrt(d))

if isempty(mode)
  mode=1;
end

if mode==1
    pnt{1} = S.pos;
    tri{1} = S.tri;
elseif mode==2
    pnt{1} = S.pos(1:end/2,:);
    tri{1} = S.tri(1:end/2,:);
    pnt{2} = S.pos(end/2+1:end,:);
    tri{2} = S.tri(end/2+1:end,:) - size(pnt{1},1);
end

for j = 1:length(pnt)
    if length(pnt)==2&&j == 1
        disp('Computing the spectrum of the the first hemisphere')
    elseif length(pnt)==2&&j == 2
        disp('Computing the spectrum of the the second hemisphere')
    end
    L{j} = mesh_laplacian(pnt{j},tri{j});
    L{j} = (L{j} + L{j}')/2;
    disp('Computing the spectrum of the negative Laplacian matrix')
    [H{j},D] = eigs(L{j},n,'sm');
    d{j} = diag(D);
    disp('Diagonalization completed')
end


%  generate a pair of nxn integer matrices that are inverse to each other
%
%  syntax  >> [X,Y] = IntegerInverse(n)
%          >> [X,Y] = IntegerInverse(n,m)  % entries in interval [-m,m]


function varargout = kochsnow(iters,varargin)
% varargout = kochsnow(iters,varargin)
% makes a picture of the Koch snowflake(utilizing draw_bndry and draw_circ)
% made of code from http://www.mathworks.de/matlabcentral/newsreader/view_thread/138798
% credits for the snowflake calculation go to Maarten van Reeuwijk
% varargin examples:
% varargin = 'm', m
% varargin = 'save', 'kochsnow%.bmp'  % is replaced by iters
% varargin = 'show', false
% varargout:
% can be called with one or no argument as an output

    angle = [0, -2/3*pi, -2/3*pi];
    l = 1; m = 1024;
    fileout = false;
    show = true;

    % varargin
    j = 1;
    while j <= nargin-1
        switch varargin{j}
            case 'm'
                m = varargin{j+1}; j = j+2;
            case 'save'
                fileout = varargin{j+1};
                incliters = strfind(fileout,'%');
                sz = size(incliters,2);
                for i = sz:-1:1
                    fileout = strcat(fileout(1:incliters(i)-1), num2str(iters), fileout(incliters(i)+1:end));
                end
                extout = fileout(end-2:end);
                j = j+2;
            case 'show'
                show = varargin{j+1}; j = j+2;
            otherwise
                error('Argument not acceptable!');
        end
    end

    % snowflake calculation by Maarten van Reeuwijk
    for i=1:iters
        l = l/3;
        angle1 = zeros([4*length(angle),1]);
        for j=1:length(angle)
          angle1(4*j-3:4*j) = [angle(j), pi/3, -2*pi/3, pi/3];
        end
        angle = angle1;
    end

    x = zeros([length(angle)+1, 1]);
    y = zeros([length(angle)+1, 1]);

    x(1) = 0; y(1) = 0;
    phi=0;
    for i=1:length(angle);
        phi = phi+angle(i);
        x(i+1) = x(i) + l * cos(phi);
        y(i+1) = y(i) + l * sin(phi);
    end
    % end of snowflake calculation by Maarten van Reeuwijk

    I = false(m*(max(y)-min(y)),m);
    x = (x+min(x))*m; y = (y-min(y))*m;
    I = draw_clline(I, [y,x], 1, 0);
    I = imfill(I,sub2ind(size(I),m/2,m/2),4);

    if show == true, imshow(I,'Border','tight'); end
    if fileout ~= false
        imwrite(I,fileout, extout);
    end
    if nargout == 1, varargout = {I}; end
end


% function generating toy dataset of 3 manifolds in the 2D space
% X = banana3(n);
% n: number of points per manifold
% X: [3N x 2] matrix of data points
%
% Authors: A. Iscen, G. Tolias, Y. Avrithis, T. Furon, O. Chum. 2017.
% Use rng(155); n = 100; to identically fit our Figure 1 in the CVPR 2017 paper.
function X = banana3(n)

	if nargin < 1, n = 100; end

	a = .25;
	s = 1:n;
	m = n + 1;
	R = [1 0; 0 -1];
	A = banana(m) + repmat([1-a, 0], [m 1]);
	B = banana(m) + repmat([3+a, 0], [m 1]);
	C = banana(n) * R + repmat([2, a], [n 1]);
	X = [A(s+1,:); B(s,:); C];
end

function X = banana(n, a, b)

	if nargin < 2, a = .12; end
	if nargin < 3, b = .1; end

	t = linspace(0, pi, n)';
	u = (1 - 2 * b) * t + b * pi;
	r = a * randn(n, 1) .* sin(u) + 1;
	X = [r .* cos(t) r .* sin(t)];

end


function zInterp=biquadraticInterp(xyPts,x0,y0,deltaX,deltaY,zGrid)
%%BIQUADRATICINTERP Biquadratic interpolation is interpolation of a
%       function that depends on two independent variables, by first
%       performing quadratic interpolation across one dimension, and then
%       performing quadratic interpolation across the next dimension. This
%       function assumes that in x and y generating the values in zGrid is
%       uniform.
%
%INPUTS: xyPts A 2XnumPts set of [x;y] pairs at which the value of z should
%              be interpolated.
%       x0, y0 These are values of the independent variables corresponding
%              to the entry in zGrid(1,1).
% deltaX, deltaY The uniform spacings between the independent variables for
%              gridded elements in zGrid. Thus, zGrid(i,j) holds the z
%              value associated with x=x0+deltaX*(i-1) and
%              y=y0+deltaY*(i-1).
%        zGrid A numXXnumY matrix of values of the independent variable
%              for different values of the dependent variables. The first
%              index selects the x value and the second index the y value.
%              numX>=3 and numY>=3.
%
%OUTPUTS: zInterp A 1XnumPts vector of interpolated values.
%
%Biquadratic interpolation is described in [1]. However, this function does
%not use the implementation that is given at the end of [1].
%
%EXAMPLE:
%A 2D function is evaluated and plotted. Then, the function is evaluated at
%a much smaller number of points and those are used to interpolate and plot
%the function again. The basis points are ploted in black. The
%small discontinuities between interpolation regions can be seen.
% numXPts=400;
% numYPts=401;
% plotXPts=linspace(-1,1,numXPts);
% plotYPts=linspace(-1,1,numYPts);
% z=@(xy)sum(sin(1-(16/15)*xy).^2-(1/50)*sin(4-(64/15)*xy)-sin(1-(16/15)*xy),1);
% [Y,X]=meshgrid(plotYPts,plotXPts);
% xy=[X(:).';Y(:).'];
% Z=reshape(z(xy),[numXPts,numYPts]);
%
% figure(1)
% clf
% hold on
% surface(X,Y,Z,'edgeColor','None')
%
% %Get a small number of points to use for interpolation and mark the
% %points on the plot.
% numXBasis=10;
% numYBasis=11;
% x0=-1;
% y0=-1;
% xBasis=linspace(x0,1,numXBasis);
% yBasis=linspace(y0,1,numYBasis);
% deltaX=xBasis(2)-xBasis(1);
% deltaY=yBasis(2)-yBasis(1);
% [YB,XB]=meshgrid(yBasis,xBasis);
% xyB=[XB(:).';YB(:).'];
% ZGrid=reshape(z(xyB),[numXBasis,numYBasis]);
% scatter3(XB(:),YB(:),ZGrid(:),200,'.k')
% view(25,50)
%
% %Now, interpolate the surface using the above basis points.
% ZInterp=biquadraticInterp(xy,x0,y0,deltaX,deltaY,ZGrid);
% ZInterp=reshape(ZInterp,[numXPts,numYPts]);
%
% %Plot the biquadratically interpolated surface and the control points.
% figure(2)
% clf
% hold on
% surface(X,Y,ZInterp,'edgeColor','None')
% scatter3(XB(:),YB(:),ZGrid(:),200,'.k')
% view(25,50)
%
%REFERENCES:
%[1] D. Smith, "NOAA technical memorandum NOS NGS 84: Biquadratic
%    interpolation," National Oceanic and Atmospheric Administration,
%    National Geodetic Survey, Silver Spring, MD, Tech. Rep., Sep. 2020.
%
%July 2021 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

numPts=size(xyPts,2);
zInterp=zeros(1,numPts);

numX=size(zGrid,1);
numY=size(zGrid,2);

for curPt=1:numPts
    xCur=xyPts(1,curPt);
    yCur=xyPts(2,curPt);

    idxX=round((xCur-x0)/deltaX)+1;
    idxY=round((yCur-y0)/deltaY)+1;

    %The points cannot be endpoints.
    idxX=idxX+(idxX==1)-(idxX==numX);
    idxY=idxY+(idxY==1)-(idxY==numY);

    %First, interpolate across X for each Y.
    x0Cur=x0+deltaX*(idxX-2);
    y0Cur=y0+deltaY*(idxY-2);

    zInterp1=quadraticInterpUnif3Pt(xCur,x0Cur,deltaX,zGrid(idxX-1,idxY-1),zGrid(idxX,idxY-1),zGrid(idxX+1,idxY-1));
    zInterp2=quadraticInterpUnif3Pt(xCur,x0Cur,deltaX,zGrid(idxX-1,idxY),zGrid(idxX,idxY),zGrid(idxX+1,idxY));
    zInterp3=quadraticInterpUnif3Pt(xCur,x0Cur,deltaX,zGrid(idxX-1,idxY+1),zGrid(idxX,idxY+1),zGrid(idxX+1,idxY+1));

    zInterp(curPt)=quadraticInterpUnif3Pt(yCur,y0Cur,deltaY,zInterp1,zInterp2,zInterp3);
end
end

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


function [y] = l1median_VaZh_z(X, maxiter, tol, zerotol, medIn )
%To calculate the L1_median of X  with the l1median_VaZh method
%INput:
%     X       ---the number of the records is the number of rows
%     maxiter ---the max number of iteration
%     tol     ---the tolerance of iteration
%     zerotol ---the tolerance of vector to zero
%     medIn   ---a row vector representing initial median of X
%output:
%     y       ---the median of X

    %To discuss the parameters
    if (nargin > 5)
        error ('Too many input arguments.') ;
    elseif (nargin < 5)
        medIn = median(X);
        if(nargin < 4)
            zerotol = 1e-15 ;
            if (nargin < 3)
                tol = 1e-9 ;
                if (nargin < 2)
                    maxiter = 200 ;
                    if (nargin < 1)
                        error ('Data matrix X is missing.') ;
                    end
                end
            end
        end
    end

    [rn,vn] = size(X);
    iterdis = 1;
    iter = 0;
    y = medIn;

    %Begin the iteration
    while (iterdis > 0) && (iter < maxiter)
        Tnum=zeros(1,vn);
        R = zeros(1,vn);
        Tden=0;
        yita = 0;
        for i=1:rn
            dist = norm(X(i,:)-y);
            if dist >= zerotol
                Tnum = Tnum + X(i,:)/dist;
                Tden=Tden + 1/dist;
                R = R + (X(i,:)-y)/dist;
            else
                yita = 1;
            end
        end

        if Tden == 0
            T=0;
        else
           T=Tnum/Tden;
        end

        if norm(R) == 0
            r = 0;
        else
            r = min(1,yita/norm(R));
        end

        Ty = (1-r)*T + r*y;

        iterdis = norm((Ty-y),1) - tol*norm(y,1);
        iter = iter + 1;
        y=Ty;

    end

    %End the iteration


function [f] = poch(z,n)
%Pochhammer function (z)n = z(z+1)(z+2)...(z+n-1)
%
%usage:  f = poch(z,n)
%
%tested on version 5.3.1
%
%        z and n may be complex but must be equal in size.
%
%see also: Gamma, Fact

%Paul Godfrey
%pgodfrey@conexant.com
%8-24-00

f = gamma(z+n)./gamma(z);

p=find(z==0 & n==0);
if ~isempty(p)
    f(p)=0;
end

return


function [X_poly] = polyFeatures(X, p)
%POLYFEATURES Maps X (1D vector) into the p-th power
%   [X_poly] = POLYFEATURES(X, p) takes a data matrix X (size m x 1) and
%   maps each example into its polynomial features where
%   X_poly(i, :) = [X(i) X(i).^2 X(i).^3 ...  X(i).^p];
%

% You need to return the following variables correctly.
X_poly = zeros(numel(X), p);

% ====================== YOUR CODE HERE ======================
% Instructions: Given a vector X, return a matrix X_poly where the p-th
%               column of X contains the values of X to the p-th power.
%
%
for i=1:numel(X)
    for j=1:p
        X_poly(i,j)=X(i,:).^j;
    end
end

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

end


function result=cpcr(x,y,varargin)

%CPCR performs a classical principal components regression.
% First, classical PCA is applied to the predictor variables x (see cpca.m) and
% k components are retained. Then a multiple linear regression method (see mlr.m)
% is performed of the response variable y on the k principal components.
%
% I/O: result=cpcr(x,y,'k',2);
%
% Required input arguments:
%      x : Data matrix of the explanatory variables
%          (n observations in rows, p variables in columns)
%      y : Data matrix of the response variables
%          (n observations in rows, q variables in columns)
%
% Optional input argument:
%      k : Number of principal components to compute. If k is missing,
%          a scree plot is drawn which allows to select
%          the number of principal components.
%  plots : If equal to one (default), a menu is shown which allows to draw several plots,
%          such as a score outlier map and a regression outlier map.
%          If 'plots' is equal to zero, all plots are suppressed.
%          See also makeplot.m
%
% The output is a structure containing
%
%   result.slope      : Classical slope
%   result.int        : Classical intercept
%   result.fitted     : Classcial prediction vector
%   result.res        : Classical residuals
%   result.sigma      : Estimated variance-covariance matrix of the residuals
%   result.rsquared   : R-squared value
%   result.k          : Number of components used in the regression
%   result.sd         : Classical score distances
%   result.od         : Classical orthogonal distances
%   result.resd       : Residual distances (when there are several response variables).
%                       If univariate regression is performed, it contains the standardized residuals.
%   result.cutoff     : Cutoff values for the score, orthogonal and residual distances.
%   result.flag      : The observations whose orthogonal distance is larger than result.cutoff.od
%                      (orthogonal outliers => result.flag.od) and/or whose residual distance is
%                      larger than result.cutoff.resd (bad leverage points/vertical outliers => result.flag.resd)
%                      can be considered as outliers and receive a flag equal to zero (=> result.flag.all).
%                      The regular observations, including the good leverage points, receive a flag 1.
%   result.class      : 'CPCR'
%   result.cpca       : Full output of the classical PCA part (see cpca.m)
%
% This function is part of LIBRA: the Matlab Library for Robust Analysis,
% available at:
%              http://wis.kuleuven.be/stat/robust.html
%
% Written by S. Verboven
% Last Update: 05/04/2003

default=struct('plots',1,'k',0);
list=fieldnames(default);
options=default;
IN=length(list);
i=1;
counter=1;
if nargin>2
    %
    % placing inputfields in array of strings
    %
    for j=1:nargin-2
        if rem(j,2)~=0
            chklist{i}=varargin{j};
            i=i+1;
        end
    end
    % Checking which default parameters have to be changed
    % and keep them in the structure 'options'.
    while counter<=IN
        index=strmatch(list(counter,:),chklist,'exact');
        if ~isempty(index) % in case of similarity
            for j=1:nargin-2 % searching the index of the accompanying field
                if rem(j,2)~=0 % fieldnames are placed on odd index
                    if strcmp(chklist{index},varargin{j})
                        I=j;
                    end
                end
            end
            options=setfield(options,chklist{index},varargin{I+1});
            index=[];
        end
        counter=counter+1;
    end
end

%classical PCA
if options.k==0
    out.cpca=cpca(x,'plots',0);
else
    out.cpca=cpca(x,'plots',0,'k',options.k);
end
%model with intercept
T=[out.cpca.T(:,1:out.cpca.k) ones(size(out.cpca.T,1),1)];
%Multivariate linear regression
out.a=inv(T'*T)*T'*y;
out.fitted=T*out.a;
len=size(out.a,1);
p=size(T,2);
q=size(y,2);
geg=[T,y];
[n,m]=size(geg);
S=cov(geg);
Sx=S(1:p-1,1:p-1);
Sxy=S(1:p-1,p+1:m);
Syx=Sxy';
Sy=S(p+1:m,p+1:m);
Se=Sy-out.a(1:p-1,1:q)'*Sx*out.a(1:p-1,1:q); %variance of errors
%regression coefficients slope and intercept ([\beta \alpha])
out.coeffs=[out.cpca.P(:,1:out.cpca.k)*out.a(1:len-1,:); out.a(len,:)-out.cpca.M*out.cpca.P(:,1:out.cpca.k)*out.a(1:len-1,:)];    %%coefficients in the original space;
out.slope=out.cpca.P(:,1:out.cpca.k)*out.a(1:len-1,:);
out.int=out.a(len,:)-out.cpca.M*out.cpca.P(:,1:out.cpca.k)*out.a(1:len-1,:);
out.res=y-out.fitted;
out.sigma=Se;
if q==1
    out.stdres=out.res./sqrt(diag(out.sigma));
end
out.k=out.cpca.k;
STTm=sum((y-repmat(mean(y),length(y),1)).^2);
SSE=sum(out.res.^2);
out.rsquared=1-SSE/STTm;
out.class='CPCR';

%calculating residual distances
if q>1
    if (-log(det(Se)/(m-1)))>50
        out.resd='singularity';
    else
       cen=zeros(q,1);
       out.resd=sqrt(libra_mahalanobis(out.res,cen','cov',Se))';
   end
else % q==1
    out.resd=out.stdres; %standardized residuals
end
out.cutoff=out.cpca.cutoff;
out.cutoff.resd=sqrt(chi2inv(0.975,size(y,2)));
%computing flags
out.flag.od=out.cpca.flag.od;
out.flag.sd=out.cpca.flag.sd;
out.flag.resd=abs(out.resd)<=out.cutoff.resd;
out.flag.all=(out.flag.od & out.flag.resd);

result=struct( 'slope',{out.slope}, 'int',{out.int},'fitted',{out.fitted},'res',{out.res},...
    'cov',{out.sigma},'rsquared',{out.rsquared},...
    'k',{out.k},'sd', {out.cpca.sd},'od',{out.cpca.od},'resd',{out.resd},...
    'cutoff',{out.cutoff},'flag',{out.flag},'class',{out.class},...
    'cpca',{out.cpca});

try
    if options.plots
        makeplot(result)
    end
catch %output must be given even if plots are interrupted
    %> delete(gcf) to get rid of the menu
    end