function [Fh,Vh]=honeyCombMesh(minV,maxV,pointSpacing)

% function [Fh,Vh]=honeyCombMesh(minV,maxV,pointSpacing)
% -----------------------------------------------------------------------
% This function creates the faces (Fh) and vertices (Vh) for a hexagon
% (honey comb) mesh. The hexagons are created between the limits minV
% (containing desired minimum X and Y coordinates) and maxV (containing
% desired maximum X and Y coordinates). The size of the hexagons is set by
% the desired point spacing.
%
% -----------------------------------------------------------------------

%% CREATE TRIANGULATION

maxV(2)=maxV(2)+pointSpacing;
[F,V]=triMeshEquilateral(minV,maxV,pointSpacing);

%% GET DUAL FOR HONEY-COMB

[Vh,Fd]=patch_dual(V,F,0);
numVert=cellfun(@(x) size(x,2),Fd);
Fh=Fd{numVert==6};

[Fh,Vh]=patchCleanUnused(Fh,Vh);

%%
% _*GIBBON footer text*_
%
% License: <https://github.com/gibbonCode/GIBBON/blob/master/LICENSE>
%
% GIBBON: The Geometry and Image-based Bioengineering add-On. A toolbox for
% image segmentation, image-based modeling, meshing, and finite element
% analysis.
%
% Copyright (C) 2006-2022 Kevin Mattheus Moerman and the GIBBON contributors
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program.  If not, see <http://www.gnu.org/licenses/>.


function R = wishrand(S,nu);
%WISHRND Random matrices from Wishard distribution.
%   R = WISHRAND(S,N) returns a matrix of random numbers chosen
%   from the central Wishard distribution with parameters S and NU.
%
%   S is a symmetric positive definite scale matrix
%   NU is degrees of freedom
%
%   Note: E[R]=S
%
%   References: Gelman, Carlin, Stern, Dunson, Vehtari, and Rubin (2013).
%                 Bayesian Data Analysis, third edition.
%               Gentle (2003), Random Number Generation and Monte Carlo
%                 Methods, 2nd ed, Springer, p. 199, Algorithm 5.8.
%               Smith & Hocking (1972), Algorithm AS 53: Wishard Variate
%                 Generator, Applied Statistics, 21(3), pp. 341-345.
%
%	See also INVWISHRAND
%
% Copyright (c) 1999-2004 Aki Vehtari

% This software is distributed under the GNU General Public
% License (version 3 or later); please refer to the file
% License.txt, included with the software, for details.

if nargin < 2
  error('Requires two input arguments.');
end;

[d d2] = size(S);
if d ~= d2
  error('Matrix S must be square');
end

% Algorithm 5.8 step 0.
[T,p]=chol(S);
if p > 0
  error('Matrix S must be positive definite.');
end

if (nu >= d) && (nu == round(nu))
  % distribution is proper and degrees of freedom is integer
  % brute-force may be used, which is surprisingly faster in Matlab
  % at least up to d>10, nu>1000
  % Algorithm described e.g. in (Gelman et al., 2013)
  Y = T'*randn(d,nu);
  R = Y*Y'./nu;
else
  % distribution is not proper or degrees of freedom is not integer
  % (Gentle, 2003) Algorithm 5.8
  % Algorithm 5.8 step 1.
  Z=zeros(d);
  for j=2:d
    Z(1:j,j)=randn(j,1);
  end
  % Algorithm 5.8 step 2. Note that there is error in the book.
  % Book says nu-i, while it should be nu+1-i
  % See errata <http://www.scs.gmu.edu/~jgentle/rngbk/errata.htm>
  % gamrand below is same as chi2rnd(nu-(1:d)+1), but much faster using c-code
  y=gamrand((nu+1-(1:d)),nu+1-(1:d));
  % Algorithm 5.8 step 3.
  Z2=Z.^2;
  sy=sqrt(y);
  B=zeros(d);
  B(1,1)=y(1);
  % In Matlab 6.5 following loop is accelerated and thus quite fast
  for j=2:d
    B(j,j)=y(j)+sum(Z2(1:(j-1),j));
    B(1,j)=Z(1,j).*sy(1);
    B(j,1)=B(1,j);
    for i=2:(j-1)
      B(i,j)=Z(i,j).*sy(i)+sum(Z(1:(i-1),i).*Z(1:(i-1),j));
      B(j,i)=B(i,j);
    end
  end
  % Algorithm 5.8 step 4.
  R=T'*B*T/nu;
end


function [mu vr] = ricestat(v, s)
%RICESTAT Mean and variance of Rice/Rician probability distribution.
%   [mu vr] = ricestat(v, s) returns the mean and variance of the Rice
%   distribution with parameters v and s.
%
%   R ~ Rice(v, s) if R = sqrt(X^2 + Y^2), where X ~ N(v*cos(a), s^2) and
%   Y ~ N(v*sin(a), s^2) are independent normal distributions (any real a).
%   Note that v and s are *not* the mean and standard deviation of R!
%
%   Reference: http://en.wikipedia.org/wiki/Rice_distribution (!)
%
%   Example:
%
%     % Compare expected and sample stats:
%     v = 5; s = 4; N = 1000;
%     r = ricernd(v*ones(1, N), s);
%     mu = mean(r), vr = var(r)
%     [Mu Vr] = ricestat(v, s)
%     % Plot histogram and mark expected mean +/- 1 stdev:
%     c = linspace(0, ceil(max(r)), 20);
%     w = c(2); % histogram bin-width
%     h = histc(r, c); bar(c, h, 'histc'); hold on
%     pk = N*w*ricepdf(Mu, v, s);
%     plot([Mu-sqrt(Vr) Mu+sqrt(Vr)], [pk pk]/2, 'ro-')
%     plot(Mu, pk/2, 'rx')
%
%   See also RICEPDF, RICERND, RICEFIT

%   Missing (?) 'See also's RICECDF, RICEINV, RICELIKE

%   Inspired by normstat from the MATLAB statistics toolbox
%   Copyright 2008 Ged Ridgway (Ged at cantab dot net)

L = Lhalf(-0.5 * v^2 / s^2);
mu = s * sqrt(pi/2) * L;
vr = 2*s^2 + v^2 - (pi * s^2 / 2) * L^2;

function l = Lhalf(x)
% Laguerre polynomial L_{1/2}(x)
% see Moments section of http://en.wikipedia.org/wiki/Rice_distribution
l = exp(x/2) * ( (1-x) * besseli(0, -x/2) - x*besseli(1, -x/2) );


function [sigma,mu,A]=mygaussfit(x,y,h)

%
% [sigma,mu,A]=mygaussfit(x,y)
% [sigma,mu,A]=mygaussfit(x,y,h)
%
% this function is doing fit to the function
% y=A * exp( -(x-mu)^2 / (2*sigma^2) )
%
% the fitting is been done by a polyfit
% the lan of the data.
%
% h is the threshold which is the fraction
% from the maximum y height that the data
% is been taken from.
% h should be a number between 0-1.
% if h have not been taken it is set to be 0.2
% as default.
%

%% threshold
if nargin==2, h=0.2; end

%% cutting
ymax=max(y);
xnew=[];
ynew=[];
for n=1:length(x)
    if y(n)>ymax*h;
        xnew=[xnew,x(n)];
        ynew=[ynew,y(n)];
    end
end

%% fitting
ylog=log(ynew);
xlog=xnew;
p=polyfit(xlog,ylog,2);
A2=p(1);
A1=p(2);
A0=p(3);
sigma=sqrt(-1/(2*A2));
mu=A1*sigma^2;
A=exp(A0+mu^2/(2*sigma^2));


function heated_plate ( epsilon, output_filename )

%*****************************************************************************80
%
%  Purpose:
%
%    MAIN is the main program for HEATED_PLATE.
%
%  Discussion:
%
%    This code solves the steady state heat equation on a rectangular region.
%
%    The sequential version of this program needs approximately
%    18/eps iterations to complete.
%
%
%    The physical region, and the boundary conditions, are suggested
%    by this diagram;
%
%                   W = 0
%             +------------------+
%             |                  |
%    W = 100  |                  | W = 100
%             |                  |
%             +------------------+
%                   W = 100
%
%    The region is covered with a grid of M by N nodes, and an N by N
%    array W is used to record the temperature.  The correspondence between
%    array indices and locations in the region is suggested by giving the
%    indices of the four corners:
%
%                  I = 0
%          [0][0]-------------[0][N-1]
%             |                  |
%      J = 0  |                  |  J = N-1
%             |                  |
%        [M-1][0]-----------[M-1][N-1]
%                  I = M-1
%
%    The steady state solution to the discrete heat equation satisfies the
%    following condition at an interior grid point:
%
%      W[Central] = (1/4) * ( W[North] + W[South] + W[East] + W[West] )
%
%    where "Central" is the index of the grid point, "North" is the index
%    of its immediate neighbor to the "north", and so on.
%
%    Given an approximate solution of the steady state heat equation, a
%    "better" solution is given by replacing each interior point by the
%    average of its 4 neighbors - in other words, by using the condition
%    as an ASSIGNMENT statement:
%
%      W[Central]  <=  (1/4) * ( W[North] + W[South] + W[East] + W[West] )
%
%    If this process is repeated often enough, the difference between successive
%    estimates of the solution will go to zero.
%
%    This program carries out such an iteration, using a tolerance specified by
%    the user, and writes the final estimate of the solution to a file that can
%    be used for graphic processing.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 July 2010
%
%  Author:
%
%    This MATLAB version by John Burkardt.
%
%  Reference:
%
%    Michael Quinn,
%    Parallel Programming in C with MPI and OpenMP,
%    McGraw-Hill, 2004,
%    ISBN13: 978-0071232654,
%    LC: QA76.73.C15.Q55.
%
%  Parameters:
%
%    Commandline argument 1, real EPSILON, the error tolerance.
%
%    Commandline argument 2, string OUTPUT_FILENAME, the name of the file into which
%    the steady state solution is written when the program has completed.
%
%  Local parameters:
%
%    Local, real DIFF, the norm of the change in the solution from
%    one iteration to the next.
%
%    Local, real MEAN, the average of the boundary values, used
%    to initialize the values of the solution in the interior.
%
%    Local, real U(M,N), the solution at the previous iteration.
%
%    Local, real W(M,N), the solution computed at the latest
%    iteration.
%
  m = 500;
  n = 500;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'HEATED_PLATE\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '  A program to solve for the steady state temperature distribution\n' );
  fprintf ( 1, '  over a rectangular plate.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Spatial grid of %d by %d points.\n', m, n );
%
%  Read EPSILON from the command line or the user.
%
  if ( nargin < 1 )
    epsilon = input ( '  Enter EPSILON, the error tolerance.' );
  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  The iteration will repeat until the change is <= %e\n', epsilon );
%
%  Read OUTPUT_FILENAME from the command line or the user.
%
  if ( nargin < 2 )
    output_filename = input ( ...
      '  Enter OUTPUT_FILENAME, the name of the output file.' );
  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  The steady state solution will be written to "%s".\n', ...
    output_filename );
%
%  Set the boundary values, which don't change.
%
  w(2:m-1,1) = 100.0;
  w(2:m-1,n) = 100.0;
  w(m,1:n) = 100.0;
  w(1,1:n) =   0.0;
%
%  Average the boundary values, to come up with a reasonable
%  initial value for the interior.
%
  mean = ( ...
      sum ( w(2:m-1,1) ) ...
    + sum ( w(2:m-1,n) ) ...
    + sum ( w(m,1:n)   ) ...
    + sum ( w(1,1:n)   ) ) ...
    / ( 2 * m + 2 * n - 4 );
%
%  Initialize the interior solution to the mean value.
%
  w(2:m-1,2:n-1) = mean;
%
%  iterate until the  new solution W differs from the old solution U
%  by no more than EPSILON.
%
  iterations = 0;
  iterations_print = 1;
  diff = epsilon;

  fprintf ( 1, '\n' );
  fprintf ( 1, ' Iteration  Change\n' );
  fprintf ( 1, '\n' );

  tic;

  while ( epsilon <= diff )

    u(1:m,1:n) = w(1:m,1:n);

    w(2:m-1,2:n-1) = 0.25 * ( ...
        u(1:m-2,2:n-1) ...
      + u(3:m,2:n-1) ...
      + u(2:m-1,1:n-2) ...
      + u(2:m-1,3:n) );

    diff = max ( max ( abs ( u(1:m,1:n) - w(1:m,1:n) ) ) );

    iterations = iterations + 1;

    if ( iterations == iterations_print )
      fprintf ( 1, '  %8d  %14f\n', iterations, diff );
      iterations_print = 2 * iterations_print;
    end

  end

  wtime = toc;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  %8d  %14f\n', iterations, diff );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Error tolerance achieved.\n' );
  fprintf ( 1, '  Wallclock time = %f\n', wtime );
%
%  Write the solution to the output file.
%
  output_unit = fopen ( output_filename, 'wt' );

  fprintf ( output_unit, '%d\n', m );
  fprintf ( output_unit, '%d\n', n );
  for i = 1 : m
    for j = 1 : n
      fprintf (output_unit, '  %f', w(i,j) );
    end
    fprintf ( output_unit, '\n' );
  end

  fclose ( output_unit );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Solution written to the output file "%s".\n', output_filename );
%
%  Terminate.
%

  fprintf ( 1, '\n' );
  fprintf ( 1, 'HEATED_PLATE:\n' );
  fprintf ( 1, '  Normal end of execution.\n' );

  return
end


function X=solveSylvesterEq(A,B,C)
%%SOLVESYLVESTEREQ Solve the Sylester equation A*X+X*B=C for X, where A, B,
%           and C can be real or complex. This implementation only works
%           when a unique solution for X exists, which is the case when
%           none of the eigenvalues of A and B when summed together equals
%           0.
%
%INPUTS: A A pXp matrix.
%        B An rXr matrix.
%        C A pXr matrix.
%
%OUTPUTS: X The pXr matrix solving A*X+X*B=C.
%
%This function implements the Bartels-Stewart algorithm of [1]. The back
%substitution algorithm of Algorithm 7.6.2 in [2] is used for the second
%half of the algorithm, which also means that upper-triangular Schur
%decompositions are used for the first half of the algorithm.
%
%EXAMPLE:
%In this example, we solve a Sylvester equation and show that the result
%Tolerance is about 7e-14, which is good agreement.
% A=[3,  0,   0, 23;
%   -2,  5, -14, -6;
%   11, 11,  -7,  7;
%  -10, 15, -10, -1];
% B=[8,  4,   2,  6;
%   -7, -1,   1,  8;
%  -14, -1,  15, -2;
%  -14, 14,  -8,  2];
% C=[16,  3,  6,  8;
%     3, 11,  8, 11;
%     6,  8,  6, 13;
%     8, 11, 13,  1];
% X=solveSylvesterEq(A,B,C);
% AbsTol=max(max(abs(A*X+X*B-C)))
%
%REFERENCES
%[1] R. H. Bartels and G. W. Stewart, "Algorithm 432: Solution of the
%    matrix equation AX+XB=C [F4]," Communications of the ACM, pp. 820-826,
%    Sep. 1972.
%[2] G. H. Golub and C. F. Van Loan, Matrix Computations, 4th ed.
%    Baltimore: The Johns Hopkins Press, 2013.
%
%December 2022 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

%We use the complex Schur decomposition. If we used the real one, then
%Ap and Bp are not guaranteed to be upper triangular if the matrices have
%complex eigenvalues.
[U,Ap]=schur(A,'complex');
[V,Bp]=schur(B,'complex');
Cp=U'*C*V;

%Solve the transformed system using Algorithm 6.7.2 of [1].
Bp=-Bp;

r=size(Ap,1);
p=size(Bp,1);

I=eye(r,r);

for k=1:r
    Cp(1:p,k)=Cp(1:p,k)+Cp(1:p,1:(k-1))*Bp(1:(k-1),k);
    z=(Ap-Bp(k,k)*I)\Cp(1:p,k);
    Cp(1:p,k)=z;
end

%Cp hold the transformed result. Now undo the transformation.
X=U*Cp*V';

if(isreal(A)&&isreal(B)&&isreal(C))
    %If all of the inputs are real, then Cp should be real, not accounting
    %for finite precision limits.
    X=real(X);
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 w = Lambert_W(x,branch)
% Lambert_W  Functional inverse of x = w*exp(w).
% w = Lambert_W(x), same as Lambert_W(x,0)
% w = Lambert_W(x,0)  Primary or upper branch, W_0(x)
% w = Lambert_W(x,-1)  Lower branch, W_{-1}(x)
%
% See: http://blogs.mathworks.com/cleve/2013/09/02/the-lambert-w-function/

% Copyright 2013 The MathWorks, Inc.

% Effective starting guess
if nargin < 2 || branch ~= -1
   w = ones(size(x));  % Start above -1
else
   w = -2*ones(size(x));  % Start below -1
end
v = inf*w;

% Haley's method
while any(abs(w - v)./abs(w) > 1.e-8)
   v = w;
   e = exp(w);
   f = w.*e - x;  % Iterate to make this quantity zero
   w = w - f./((e.*(w+1) - (w+2).*f./(2*w+2)));
end


function x = Adj_Evaluate_FT(y,shift,boxlen,center,w)
% Adj_Evaluate_FT -- 1d unequispaced adjoint Fourier transform
% (with windowing). Adjoint of Evaluate_FT.
% Usage:
%   x = Evaluate_FT(y,shift,boxlen,center,w)
% Inputs:
%   y	      vector of length 2n
%   shift     vector of shifts
%   boxlen    half length of interval around each value of shift
%   center    boolean variable: 0/1 = unbiased/biased FT
%   w         tapering window of size 2*boxlen
% Outputs:
%   x      vector of length: n
% Description:
%  For w = 1, evaluates the Adj FT of a signal irregularly
%  sampled in frequency omega(j,k) = shift(j) + k, -boxlen <= k
%  <boxlen If center = 0,
%
%  x(t) = sum_m exp(i 2pi omega(m) t/n) y(k), -n/2 <= t < n/2
%
%  If center = 1,
%
%  x(t) = sum_m exp(i 2pi omega(m) t/n) y(k), 0 <= t < n
%
%  For arbitrary windows, y is first tapered with w.
%
%  Adj_Evaluate_FT uses two different methods for computing the
%  unesquispaced Fourier transform. If the number of shifts is less
%  than 8, it uses an exact method, otherwise it uses the
%  accelerated Adjoint USFFT.
%  See Also
%    Evaluate_FT, Adj_USFFT, Adj_USFT_simple
%
% By Emmanuel candes, 2003-2004

if nargin < 5,
  w = ones(1,2*boxlen);
end

if nargin < 4,
  center = 0;
end

n  = length(y)/2;
boxcnt = length(shift);

if (boxcnt <= 16)
  x = Adj_USFT_simple(y,shift,boxlen,center,w);
else
  % Make frequency grid
  k = (-boxlen):(boxlen -1);
  omega = meshgrid(shift,k) + meshgrid(k,shift).';
  omega = 2*pi*(omega(:))./n;

  y = repmat(w(:),boxcnt,1) .* y; % Tapering
  x = Adj_USFFT(n,y,omega,16,6,center)./sqrt(n); % Take Adjoint USFFT
end


function [x,y,w] = gqcircsegm ( n, omega, r )

%
%% GQCIRCSEGM computes the nodes and weights of a product gaussian formula
% on a circle segment of a disk centered at the origin
% with angles in [0,omega]

% uses the routines:
%
% r_jacobi.m, gauss.m from
% www.cs.purdue.edu/archives/2002/wxg/codes/OPQ.html
%
% trigauss.m
% http://www.math.unipd.it/~marcov/mysoft/trigauss.m
%
%  Modified:
%
%    16 May 2013
%
%  Author:
%
%    Gaspare Da Fies, Marco Vianello,
%    University of Padova
%
%  Parameters:
%
%    Input, integer n: algebraic degree of exactness.
%
%    Input, real omega: half-length of the angular interval, 0<omega<=pi
%
%    Input, r: radius of the disk
%
%    Output, xyw: (ceil((n+1)/2) x ceil((n+2)/2) x 3 array of (xnodes,ynodes,weights)

%
%  Compute the trigonometric gaussian formula on the arc.
%
  tw = trigauss ( n + 2, 0, omega );
%
%  Compute the algebraic gaussian formula on [-1,1];
%
  ab = r_jacobi ( ceil((n+1)/2), 0, 0 );
  xw = gauss ( ceil((n+1)/2), ab );
%
%  Create the grid.
%
  [ t, theta ] = meshgrid ( xw(:,1), tw(:,1) );
  [ w1, w2 ]   = meshgrid ( xw(:,2), tw(:,2) );
%
%  Nodal cartesian coordinates and weights.
%
  s = sin ( theta(:) );
  x = (r * cos ( theta(:) ))';
  y = (r * t(:) .* s)';
  w = (r^2 * s.^2 .* w1(:) .* w2(:))';

  return
end


function [nll,g,H,T] = LogisticLoss(w,X,y)
% w(feature,1)
% X(instance,feature)
% y(instance,1)

[n,p] = size(X);

Xw = X*w;
yXw = y.*Xw;

nll = sum(	([zeros(n,1) -yXw]));

if nargout > 1
    if nargout > 2
        sig = 1./(1+exp(-yXw));
        g = -X.'*(y.*(1-sig));
    else
        g = -X.'*(y./(1+exp(yXw)));
    end
end

if nargout > 2
    H = X.'*diag(sparse(sig.*(1-sig)))*X;
end

if nargout > 3
    T = zeros(p,p,p);
    for j1 = 1:p
        for j2 = 1:p
            for j3 = 1:p
                T(j1,j2,j3) = sum(y(:).^3.*X(:,j1).*X(:,j2).*X(:,j3).*sig.*(1-sig).*(1-2*sig));
            end
        end
    end
end


% Mathematics Q2791227
% https://math.stackexchange.com/questions/2301266
% Proximal Operator of Huber Loss Function (For L1 Regularized Huber Loss)
% References:
%   1.  aa
% Remarks:
%   1.  sa
% TODO:
% 	1.  ds
% Release Notes
% - 1.0.000     20/03/2020
%   *   First release.

%% General Parameters

subStreamNumberDefault = 0; %<! Set to 0 for Random

run('InitScript.m');

figureIdx           = 0; %<! Continue from Question 1
figureCounterSpec   = '%04d';

generateFigures = ON;

%% Parameters

numElements = 25;

outOfSetThr     = 1e-6;
outOfSetCost    = 1e9;

paramLambda = rand(1);
paramDelta = 3;

%% Load / Generate Data

vY      = 2 * randn(numElements, 1);
hObjFun = @(vX) 0.5 * sum((vX - vY) .^ 2) + (paramLambda * HuberLoss(vX, paramDelta));
% From https://math.stackexchange.com/a/1650535
% This is the Proximal Operator for the case paramDelta = 1.
hProxHuberLoss1 = @(vX, paramLambda) vX - ((paramLambda * vX) ./ (max(abs(vX), paramLambda + 1)));
% Supporting any Huber Loss Function by Scaling of the Prox
% HuberLoss(vY, paramDelta) = paramDelta * paramDelta * HuberLoss(vY / paramDelta, 1)
hProxHuberLoss = @(vX, paramDelta, paramLambda) paramDelta * hProxHuberLoss1(vX / paramDelta, paramLambda);

%% Solution by CVX

solverString = 'CVX';

tic();

cvx_begin('quiet')
    % cvx_precision('best');
    variable vX(numElements, 1);
    minimize( 0.5 * sum_square(vX - vY) + (0.5 * paramLambda * sum(huber(vX, paramDelta))) );
cvx_end

toc();

disp([' ']);
disp([solverString, ' Solution Summary']);
disp(['The ', solverString, ' Solver Status - ', cvx_status]);
% disp(['The Optimal Value Is Given By - ', num2str(cvx_optval)]);
disp(['The Optimal Value Is Given By - ', num2str(hObjFun(vX))]);
disp(['The Optimal Argument Is Given By - [ ', num2str(vX.'), ' ]']);
disp([' ']);

%% Solution by Analytic

solverString = 'Analytic';

tic();

% From https://math.stackexchange.com/a/1650535/33
vX = hProxHuberLoss(vY, paramDelta, paramLambda);

toc();

disp([' ']);
disp([solverString, ' Solution Summary']);
disp(['The Optimal Value Is Given By - ', num2str(hObjFun(vX))]);
disp(['The Optimal Argument Is Given By - [ ', num2str(vX.'), ' ]']);
disp([' ']);

%% Solution by Analytic

solverString = 'Analytic';

tic();

% By Boyd's Book
vX = ProxHuberLossBoyd(vY, paramDelta, paramLambda);

toc();

disp([' ']);
disp([solverString, ' Solution Summary']);
disp(['The Optimal Value Is Given By - ', num2str(hObjFun(vX))]);
disp(['The Optimal Argument Is Given By - [ ', num2str(vX.'), ' ]']);
disp([' ']);

%% Restore Defaults

% set(0, 'DefaultFigureWindowStyle', 'normal');
% set(0, 'DefaultAxesLooseInset', defaultLoosInset);


function [dimension standard_dev] = fractalvol(data)
%[DIMENSION STANDARD_DEV] = fractalvol(DATA) calculates the fractal
%dimension of the 1 dimensional random walk, DATA. DATA is assumed to be a
%function of its indices.
%   Finds fractal volatility by embedding in the unit square and box
%   counting. Y axis will be rescaled values of DATA, x axis is
%   (1:length(DATA))/length(DATA).
%
%   Uncomment the else construction if you have the parallel computing
%   toolbox and wish to run the code in parallel (it scales linearly in instances).

if size(data,1) < size(data,2)
    data = data';
end

if size(data,2) == 1
    data = [(1:length(data))' data];
end

max1 = max(data(:,1));
min1 = min(data(:,1));
max2 = max(data(:,2));
min2 = min(data(:,2));

%normalize all to unit square
normdata = data;
normdata(:,1) = normdata(:,1)-min1;
normdata(:,1) = normdata(:,1)./(max1-min1);
normdata(:,2) = normdata(:,2)-min2;
normdata(:,2) = normdata(:,2)./(max2-min2);

%make sure nothing falls through the x axis
minwidth = min(diff(normdata(:,1)));
minwidth = log2(minwidth);
minwidth = abs(ceil(minwidth));
minwidth = minwidth-1;

n = zeros(minwidth,1);

% parallcntrl = matlabpool('size');

% if parallcntrl == 0
    for j = 1:minwidth
        width = 2^-j;
        xaxis_pos = 0;
        boxcount = 0;
        while xaxis_pos<1
            indx = (xaxis_pos <= normdata(:,1) &...
                normdata(:,1)<xaxis_pos+width);
            if 1-xaxis_pos == width
                indx(end) = true;
            end

            vertical_column = normdata(indx,2);

            if length(vertical_column) == 1
                boxcount = boxcount + 1;
            else
                rawcount = (max(vertical_column)-min(vertical_column))/width;
                rawcount = rawcount + rem(min(vertical_column),width);
                count = ceil(rawcount);
                boxcount = boxcount + count;
            end
            xaxis_pos = xaxis_pos + width; %advance on x axis
        end
        n(j) = boxcount;
    end
% else
%     parfor j = 1:minwidth
%         width = 2^-j;
%         xaxis_pos = 0;
%         boxcount = 0;
%         while xaxis_pos<1
%             indx = (xaxis_pos <= normdata(:,1) &...
%                 normdata(:,1)<xaxis_pos+width);
%             if 1-xaxis_pos == width
%                 indx(end) = true;
%             end
%
%             vertical_column = normdata(indx,2);
%
%             if length(vertical_column) == 1
%                 boxcount = boxcount + 1;
%             else
%                 rawcount = (max(vertical_column)-min(vertical_column))/width;
%                 rawcount = rawcount + rem(min(vertical_column),width);
%                 count = ceil(rawcount);
%                 boxcount = boxcount + count;
%             end
%             xaxis_pos = xaxis_pos + width; %advance on x axis
%         end
%         n(j) = boxcount;
%     end
% end

r = 2.^-(1:minwidth);
r = r';

s=-gradient(log(n))./gradient(log(r));
IQR = iqr(s);

indx2 = abs(s-median(s)) > IQR/2;

x2 = log(r);
y2 = log(n);

s(indx2)= [];
x2(indx2) = [];
y2(indx2) = [];

%std is the variance of the slope according to OLS theory

X = [ones(size(x2)) x2];
beta = pinv(X)*y2;
C = pinv(X'*X);
e=y2-X*pinv(X)*y2;
sigma = e'*e*C;
sigma = sqrt(sigma);

dimension = -beta(2);
standard_dev = sigma(2,2);


function toms446_test04 ( )

%*****************************************************************************80
%
%% TOMS446_TEST04 tests EDCHEB, which evaluates the derivative of a Chebyshev series.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 September 2011
%
%  Author:
%
%    John Burkardt
%
  nf = 5;
  npl = 10;

  nx = 6;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TOMS446_TEST04\n' );
  fprintf ( 1, '  Test EDCHEB, which evaluates the \n' );
  fprintf ( 1, '  derivative of a Chebyshev series.\n' );

  x = cheby ( nf, npl, @functn );

  for j = 1 : nf

    x2(1:npl) = x(1:npl,j);

    fprintf ( 1, '\n' );
    if ( j == 1 )
      fprintf ( 1, '  d/dx Sin(x)\n' );
    elseif ( j == 2 )
      fprintf ( 1, '  d/dx Cos(x)\n' );
    elseif ( j == 3 )
      fprintf ( 1, '  d/dx Sin(2x)\n' );
    elseif ( j == 4 )
      fprintf ( 1, '  d/dx Cos(2x)\n' );
    elseif ( j == 5 )
      fprintf ( 1, '  d/dx x^5\n' );
    end

    fprintf ( 1, '\n' );

    for k = 1 : nx

      xval = 2.0 * ( k - 1 ) / ( nx - 1 ) - 1.0;

      fxj = functn_d ( xval );

      fval = edcheb ( xval, x2, npl );

      fprintf ( 1, '  %10.4f  %10.4f  %10.4f\n', xval, fxj(j), fval );

    end

  end

  return
end


function p=v_normcdflog(x,m,s)
%V_NORMCDFLOG calculates log of Normal Cumulative Distribution function p=(x,m,s)
%
% Inputs:
%
%     X        Input data (vector or matrix)
%     M        Mean of Normal distribution [default 0]
%     S        Std deviation of Normal distribution [default 1]
%
% Outputs:
%
%     P        P = log(normcdf(X)); same size as X
%
% The routine gives accurate values even if X is large and negative

%      Copyright (C) Mike Brookes 2016
%      Version: $Id: v_normcdflog.m 10865 2018-09-21 17:22:45Z dmb $
%
%   VOICEBOX is a MATLAB toolbox for speech processing.
%   Home page: http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   This program is free software; you can redistribute it and/or modify
%   it under the terms of the GNU General Public License as published by
%   the Free Software Foundation; either version 2 of the License, or
%   (at your option) any later version.
%
%   This program is distributed in the hope that it will be useful,
%   but WITHOUT ANY WARRANTY; without even the implied warranty of
%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%   GNU General Public License for more details.
%
%   You can obtain a copy of the GNU General Public License from
%   http://www.gnu.org/copyleft/gpl.html or by writing to
%   Free Software Foundation, Inc.,675 Mass Ave, Cambridge, MA 02139, USA.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
persistent a b
if isempty(a)
    a=0.996;
%   f=@(x) -0.5*(x.^2+log(2*pi))-real(log(-(a+x.^2)./x))-real(log(normcdf(x)));
%   b=fzero(f,-22);         % cutoff value for conventional formula
    b=-22.2491306156561;    % precalculated value
end
if nargin>2
    x=(x-m)/s;
elseif nargin>1
    x=x-m;
end
t=x<b;                                                  % mask for large negative values
p=zeros(size(x));
p(~t)=real(log(0.5*erfc(-x(~t).*sqrt(0.5))));           % use this formula normally
p(t)=-0.5*(x(t).^2+log(2*pi))-real(log(-x(t)-a./x(t))); % use this approximation for large negative x


function result = sphere_unit_07_3d ( func )

%*****************************************************************************80
%
%% SPHERE_UNIT_07_3D approximates surface integrals on the unit sphere in 3D.
%
%  Integration region:
%
%    Points (X,Y,Z) such that:
%
%      X**2 + Y**2 + Z**2 = 1.
%
%  Discussion:
%
%    A 32 point 7-th degree formula is used.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 May 2004
%
%  Author:
%
%    MATLAB version by John Burkardt
%
%  Reference:
%
%    Arthur H Stroud,
%    Approximate Calculation of Multiple Integrals,
%    Prentice Hall, 1971.
%
%  Parameters:
%
%    Input, external FUNC, the name of the user supplied
%    function which evaluates F(X,Y,Z), of the form
%      function value = func ( x, y, z )
%
%    Output, real RESULT, the approximate integral of the function.
%
  norder1 = 2;
  norder2 = 4;
  norder3 = 4;
%
%  Set XTAB1 and WATE1.
%
  xtab1(1) = -1.0E+00;
  xtab1(2) =  1.0E+00;
  weight1(1) = 1.0E+00;
  weight1(2) = 1.0E+00;
%
%  Set XTAB2 and WATE2.
%
  for j = 1 : norder2
    angle = pi * ( 2 * j - 1 ) / ( 2 * norder2 );
    xtab2(j) = cos ( angle );
  end

  weight2(1:norder2) = 1.0E+00 / ( 4 * norder2 );
%
%  Set XTAB3 and WATE3.
%
  [ xtab3, weight3 ] = legendre_set ( norder3 );

  quad = 0.0E+00;
  for i = 1 : norder1
    for j = 1 : norder2
      for k = 1 : norder3

        x = xtab1(i) * sqrt ( 1.0E+00 - xtab2(j)^2 ) ...
                     * sqrt ( 1.0E+00 - xtab3(k)^2 );
        y = xtab1(i) * xtab2(j) * sqrt ( 1.0E+00 - xtab3(k)^2 );
        z = xtab1(i) * xtab3(k);

        quad = quad + weight1(i) * weight2(j) * weight3(k) ...
          * feval ( func, x, y, z );

      end
    end
  end

  volume = sphere_unit_area_3d ( );
  result = quad * volume;

  return
end


function [ x, w ] = j_quadrature_rule ( n, alpha, beta )

%*****************************************************************************80
%
%% J_QUADRATURE_RULE: Gauss-Jacobi quadrature based on J(n,a,b,x).
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 March 2012
%
%  Author:
%
%    John Burkardt.
%
%  Reference:
%
%    Sylvan Elhay, Jaroslav Kautsky,
%    Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of
%    Interpolatory Quadrature,
%    ACM Transactions on Mathematical Software,
%    Volume 13, Number 4, December 1987, pages 399-415.
%
%  Parameters:
%
%    Input, integer N, the order.
%
%    Input, real ALPHA, BETA, the parameters.
%    -1 < ALPHA, BETA.
%
%    Output, real X(N), the abscissas.
%
%    Output, real W(N), the weights.
%
  ab = alpha + beta;
  abi = 2.0 + ab;
%
%  Define the zero-th moment.
%
  zemu = 2.0^( ab + 1.0 ) * gamma ( alpha + 1.0 ) ...
    * gamma ( beta + 1.0 ) / gamma ( abi );
%
%  Define the Jacobi matrix.
%
  x = zeros ( n, 1 );
  bj = zeros ( n, 1 );

  x(1) = ( beta - alpha ) / abi;
  bj(1) = 4.0 * ( 1.0 + alpha ) * ( 1.0 + beta ) ...
    / ( ( abi + 1.0 ) * abi * abi );
  a2b2 = beta * beta - alpha * alpha;

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

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

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

  return
end


function [ x, w ] = bdfp_set ( n )

%*****************************************************************************80
%
%% BDFP_SET sets weights for backward differentiation predictor quadrature.
%
%  Discussion:
%
%    A backward differentiation predictor formula is defined for a set
%    of evenly spaced abscissas X(I) with X(1) = 1 and X(2) = 0.  Assuming
%    that the values of the function to be integrated are known at the
%    abscissas, the formula is written in terms of the function value at
%    X(2), and the backward differences at X(2) that approximate the
%    derivatives there.  A backward differentiation predictor formula
%    is equivalent to an Adams-Bashforth formula of the same order.
%
%    The integral:
%
%      Integral ( 0 <= X <= 1 ) F(X) dX
%
%    The quadrature rule:
%
%      Sum ( 1 <= I <= N ) W(I) * BD**(I-1) F ( 0 ),
%
%    Here, "BD**(I-1) F ( 0 )" denotes the (I-1)st backward difference
%    of F at X = 0, using a spacing of 1.  In particular,
%
%    BD**0 F(0) = F(0)
%    BD**1 F(0) = F(0) - F(-1)
%    BD**2 F(0) = F(0) - 2 * F(-1) + F(-2 )
%
%    The relationship between a backward difference predictor and the
%    corresponding Adams-Bashforth formula may be illustrated for the
%    BDF predictor of order 3:
%
%      BD**0 F(0) + 0.5 * BD**1 F(0) + 5/12 * BD**2 F(0)
%      =            F(0)
%        + 1/2  * ( F(0) -         F(1) )
%        + 5/12 * ( F(0) - 2     * F(-1) +      F(-2) )
%      =  23/12 *   F(0) - 16/12 * F(-1) + 5/12 F(-2)
%
%    which is the Adams-Bashforth formula of order 3.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 October 2005
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Simeon Fatunla,
%    Numerical Methods for Initial Value Problems in Ordinary Differential
%    Equations,
%    Academic Press, 1988.
%
%  Parameters:
%
%    Input, integer N, the order.
%    1 <= N <= 19.
%
%    Output, real X(N), the abscissas.
%
%    Output, real W(N), the weights.
%
  x = zeros ( n, 1 );
  w = zeros ( n, 1 );

  n_max = 19;

  w_save(1) =                       1.0;
  w_save(2) =                       1.0 /                2.0;
  w_save(3) =                       5.0 /               12.0;
  w_save(4) =                       3.0 /                8.0;
  w_save(5) =                     251.0 /              720.0;
  w_save(6) =                      95.0 /              288.0;
  w_save(7) =                   19087.0 /            60480.0;
  w_save(8) =                    5257.0 /            17280.0;
  w_save(9) =                 1070017.0 /          3628800.0;
  w_save(10) =                  25713.0 /            89600.0;
  w_save(11) =               26842253.0 /         95800320.0;
  w_save(12) =                4777223.0 /         17418240.0;
  w_save(13) =           703604254357.0 /    2615348736000.0;
  w_save(14) =           106364763817.0 /     402361344000.0;
  w_save(15) =          1166309819657.0 /    4483454976000.0;
  w_save(16) =               25221445.0 /         98402304.0;
  w_save(17) =       8092989203533249.0 /    3201186852864.0;
  w_save(18) =         85455477715379.0 /      34237292544.0;
  w_save(19) =   12600467236042756559.0 / 5109094217170944.0;

  if ( n_max < n )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'BDFP_SET - Fatal error!\n' );
    fprintf ( 1, '  N = %d exceeds N_MAX = %d\n', n, n_max );
    error ( 'BDFP_SET - Fatal error!' );
  end

  w(1:n) = w_save(1:n);

  for i = 1 : n
    x(i) = 1 - i;
  end

  return
end


function z = logMn(x, p)
% Compute log pdf of a multinomial distribution.
% Input:
%   x: d x 1 integer vector
%   p: d x 1 probability
% Output:
%   z: probability density in logrithm scale z=log p(x)
% Written by Mo Chen (sth4nth@gmail.com).
z = gammaln(sum(x)+1)-sum(gammaln(x+1))+dot(x,log(p));


clear all, close all, clc

xC = [2; 1;];                           % Center of data (mean)
sig = [2; .5;];                         % Principal axes

theta = pi/3;                           % Rotate cloud by pi/3
R = [cos(theta) -sin(theta);            % Rotation matrix
    sin(theta) cos(theta)];

nPoints = 10000;                        % Create 10,000 points
X = R*diag(sig)*randn(2,nPoints) + diag(xC)*ones(2,nPoints);

subplot(1,2,1)                          % Plot cloud of noisy data
scatter(X(1,:),X(2,:),'k.','LineWidth',2)
hold on, box on, grid on
axis([-6 8 -6 8])

%% f_ch01_ex03_1b

Xavg = mean(X,2);                       % Compute mean
B = X - Xavg*ones(1,nPoints);           % Mean-subtracted Data
[U,S,V] = svd(B/sqrt(nPoints),'econ');  % Find principal components (SVD)

subplot(1,2,2)
scatter(X(1,:),X(2,:),'k.','LineWidth',2)  % Plot data to overlay PCA
hold on, box on, grid on
axis([-6 8 -6 8])

theta = (0:.01:1)*2*pi;
[Xstd] = U*S*[cos(theta); sin(theta)];  % 1-std confidence interval
plot(Xavg(1)+Xstd(1,:),Xavg(2) + Xstd(2,:),'r-','LineWidth',1.5)
plot(Xavg(1)+2*Xstd(1,:),Xavg(2) + 2*Xstd(2,:),'r-','LineWidth',1.5)
plot(Xavg(1)+3*Xstd(1,:),Xavg(2) + 3*Xstd(2,:),'r-','LineWidth',1.5)

% Plot principal components U(:,1)S(1,1) and U(:,2)S(2,2)
plot([Xavg(1) Xavg(1)+U(1,1)*S(1,1)],[Xavg(2) Xavg(2)+U(2,1)*S(1,1)],'c-','LineWidth',2)
plot([Xavg(1) Xavg(1)+U(1,2)*S(2,2)],[Xavg(2) Xavg(2)+U(2,2)*S(2,2)],'c-','LineWidth',2)

set(gcf,'Position',[100 100 600 300])


function [HotellingT2] = HotellingT2(X,alpha)
%Hotelling T-Squared testing procedures for multivariate samples.
%
%   Syntax: function [HotellingT2] = HotellingT2(X,alpha)
%
%     Inputs:
%          X - multivariate data matrix.
%      alpha - significance level (default = 0.05).
%
%     Outputs:
%          It depends of the Hotelling's T-Squared multivariate test of interest,
%          being able to be:
%
%            |-One-sample
%            |                          |-Homoskedasticity (to test)
%            |            |-Independent |
%            |            |             |-Heteroskedasticity (to test)
%            |-Two-sample |
%                         |
%                         |-Dependent
%
%          Each case calls to a corresponding function that contains a complete
%          explanation.
%
%  Created by A. Trujillo-Ortiz and R. Hernandez-Walls
%             Facultad de Ciencias Marinas
%             Universidad Autonoma de Baja California
%             Apdo. Postal 453
%             Ensenada, Baja California
%             Mexico.
%             atrujo@uabc.mx
%             And the special collaboration of the post-graduate students of the 2002:2
%             Multivariate Statistics Course: Karel Castro-Morales, Alejandro Espinoza-Tenorio,
%             Andrea Guia-Ramirez.
%
%  Copyright (C) December 2002.
%

if nargin < 2,
    alpha = 0.05; %(default)
end;

if nargin < 1,
   error('Requires at least one input argument.');
end;

sam = input('Do you have one multivariate sample (1) or two multivariate samples (2)?: ');
if sam == 1;
   T2Hot1(X,alpha)
else
   id = input('They are independent (1) or dependent (2)?: ');
   if id == 1;
      disp('The covariance matrix homogeneity will be testing.:');
      MBoxtest(X,alpha);
      disp(' ')
      dc = input('Do they were significant? (y/n): ','s');
      if dc == 'y'
         T2Hot2ihe(X,alpha);
      else
         T2Hot2iho(X,alpha);
      end;
   else
      T2Hot2d(X,alpha);
   end;
end;

return;


% DIRECT JACOBIAN DEMO
function jacobian_planar_3gdl

%a)
q1=0
q2 = pi/2
q3 = pi/2
J = [-sin(q1)-sin(q1+q2)-sin(q1+q2+q3)  -sin(q1+q2)-sin(q1+q2+q3) -sin(q1+q2+q3);
     cos(q1)+cos(q1+q2)+cos(q1+q2+q3)    cos(q1+q2)+cos(q1+q2+q3)  cos(q1+q2+q3);
      0 0 0;
      0 0 0;
      0 0 0;
      1 1 1];
 f = [ 1 1 1 1 1 1]';

 tau = J'*f

 %b)
q1=pi/4
q2 = pi/4
q3 = pi/4
J = [-sin(q1)-sin(q1+q2)-sin(q1+q2+q3)  -sin(q1+q2)-sin(q1+q2+q3) -sin(q1+q2+q3);
     cos(q1)+cos(q1+q2)+cos(q1+q2+q3)    cos(q1+q2)+cos(q1+q2+q3)  cos(q1+q2+q3);
      0 0 0;
      0 0 0;
      0 0 0;
      1 1 1];

 tau = [1 1 1]';

 f = J*inv(J'*J)*tau

%c)
q1=pi/2
q2 = pi/2
q3 = pi/2
syms q1 q2 q3 real
J = [-sin(q1)-sin(q1+q2)-sin(q1+q2+q3)  -sin(q1+q2)-sin(q1+q2+q3) -sin(q1+q2+q3);
     cos(q1)+cos(q1+q2)+cos(q1+q2+q3)    cos(q1+q2)+cos(q1+q2+q3)  cos(q1+q2+q3)];

 %Jp = pinv(J);
 Jp = J'*inv(J*J');
 P = (eye(3) - Jp*J)
 P = simplify(P)
 qdn = P*[0 0 1]'
 qdn = simplify(qdn)


function value = gen_hermite_integral ( expon, alpha )

%*****************************************************************************80
%
%% GEN_HERMITE_INTEGRAL evaluates a monomial generalized Hermite integral.
%
%  Discussion:
%
%    The integral:
%
%      integral ( -oo < x < +oo ) x^n |x|^alpha exp(-x^2) dx
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 February 2008
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, int EXPON, the exponent of the monomial.
%
%    Input, real ALPHA, the exponent of |X| in the integral.
%    -1.0 < ALPHA.
%
%    Output, real VALUE, the value of the integral.
%
  if ( mod ( expon, 2 ) == 1 )

    value = 0.0;

  else

    a = alpha + expon;

    if ( a <= -1.0 )

      value = - r8_huge ( );

    else

      value = gamma ( ( a + 1.0 ) / 2.0 );

    end

  end

  return
end


function T=transitivity_bd(A)
%TRANSITIVITY_BD    Transitivity
%
%   T = transitivity_bd(A);
%
%   Transitivity is the ratio of 'triangles to triplets' in the network.
%   (A classical version of the clustering coefficient).
%
%   Input:      A       binary directed connection matrix
%
%   Output:     T       transitivity scalar
%
%   Reference:  Rubinov M, Sporns O (2010) NeuroImage 52:1059-69
%               based on Fagiolo (2007) Phys Rev E 76:026107.
%
%
%   Contributors:
%   Mika Rubinov, UNSW/University of Cambridge
%   Christoph Schmidt, Friedrich Schiller University Jena
%   Andrew Zalesky, University of Melbourne
%   2007-2015

%   Modification history:
%   2007: original (MR)
%   2013, 2015: removed tests for absence of nodewise 3-cycles (CS,AZ)

%   Methodological note: In directed graphs, 3 nodes generate up to 8
%   triangles (2*2*2 edges). The number of existing triangles is the main
%   diagonal of S^3/2. The number of all (in or out) neighbour pairs is
%   K(K-1)/2. Each neighbour pair may generate two triangles. "False pairs"
%   are i<->j edge pairs (these do not generate triangles). The number of
%   false pairs is the main diagonal of A^2. Thus the maximum possible
%   number of triangles = (2 edges)*([ALL PAIRS] - [FALSE PAIRS])
%                       = 2 * (K(K-1)/2 - diag(A^2))
%                       = K(K-1) - 2(diag(A^2))

S    = A+A.';                           % symmetrized input graph
K    = sum(S,2);                        % total degree (in + out)
cyc3 = diag(S^3)/2;                     % number of 3-cycles (ie. directed triangles)
CYC3 = K.*(K-1)-2*diag(A^2);            % number of all possible 3-cycles
T    = sum(cyc3)./sum(CYC3);            % transitivity


 function [fun, d1, d2] = ir_poly2_fun(order, varargin)
%function [fun, d1, d2] = ir_poly2_fun(order, [options])
%|
%| create anonymous functions @(x,y) with all the terms in a 2d polynomial
%| up to given order, e.g. [1+0*x x y ...]
%| also return partial derivatives w.r.t. x and y
%|
%| in
%|	order
%|
%| options
%|	maxdegree	maximum of sum of degrees (default: 2*order)
%|	dc		set to 1 to include dc (constant) term (default: 1)
%|
%| out
%|	fun		use fun(x, y) to evaluate the polynomial
%|	d1,d2		likewise, for 1st partial derivatives thereof
%|
%| Copyright 2005-6-18, Jeff Fessler, The University of Michigan

if nargin < 1, ir_usage, end
if nargin == 1 && streq(order, 'test'), ir_poly2_fun_test, return, end

arg.maxdegree = []; % se below
arg.dc = true;
arg = vararg_pair(arg, varargin);

if isempty(arg.maxdegree), arg.maxdegree = 2 * order; end

str = '';
d1 = '';
d2 = '';
for i2=0:order
	for i1=0:order
		if i1+i2 == 0 && ~arg.dc
			continue
		end
		if i1 + i2 > arg.maxdegree
			continue
		end

		str = [str sprintf(' (x.^%d).*(y.^%d)', i1, i2)];
		if i1 == 0
			s1 = '0*x';
		else
			s1 = sprintf('%d*x.^%d', i1, i1-1);
		end
		if i2 == 0
			s2 = '0*y';
		else
			s2 = sprintf('%d*y.^%d', i2, i2-1);
		end
		d1 = [d1 sprintf(' (%s).*(y.^%d)', s1, i2)];
		d2 = [d2 sprintf(' (x.^%d).*(%s)', i1, s2)];
	end
end
str = ['[ ' str ' ]'];
d1 = ['[ ' d1 ' ]'];
d2 = ['[ ' d2 ' ]'];

% create appropriate anonymous functions
fun = ir_str2func(['@(x,y) ' str]);
d1 = ir_str2func(['@(x,y) ' d1]);
d2 = ir_str2func(['@(x,y) ' d2]);

% ir_poly2_fun_test()
function ir_poly2_fun_test
[fun d1 d2] = ir_poly2_fun(1, 'dc', 0);
x = 1:5; y = 2:6; fun(x,y); d1(x,y); d2(x,y);
[fun d1 d2] = ir_poly2_fun(2, 'maxdegree', 3);
fun(x,y); d1(x,y); d2(x,y);
if im
	pr fun
end


function [PErrorOutput, PErrorOutputmean, PErrorOutputvar] = PError(N,Ptrue,Pestimate)

% This function computes the proportion erros per pixel per endmember
%       given true and estimated proportion values.
%
% SYNTAX : [PErrorOutput, PErrorOutputmean, PErrorOutputvar] = PError(N,Ptrue,Pestimate)
%
% INPUTS
%     N:             Total number of data points. N=N1*N2 in hyperspectral
%                    image data.
%     Ptrue:         True proportion values. N*M, where M is the number of
%                    endmembers.
%     Pestimate:     Estimated proportion values. N*M.
% OUTPUTS
%     PErrorOutput:       PError per pixel
%     PErrorOutputmean:   Mean of PErrorOutput, PError per pixel per
%                         endmember. (This is the result in the Tables in the paper)
%     PErrorOutputvar:    Variance of PErrorOutput across endmembers.
%
% This product is Copyright (c) 2014 University of Missouri
% All rights reserved.
%
% Redistribution and use in source and binary forms, with or without
% modification, are permitted provided that the following conditions
% are met:
%
%   1. Redistributions of source code must retain the above copyright
%      notice, this list of conditions and the following disclaimer.
%   2. Redistributions in binary form must reproduce the above copyright
%      notice, this list of conditions and the following disclaimer in the
%      documentation and/or other materials provided with the distribution.
%   3. Neither the name of the University nor the names of its contributors
%      may be used to endorse or promote products derived from this software
%      without specific prior written permission.
%
% THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY OF MISSOURI AND
% CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
% INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
% MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
% DISCLAIMED.  IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS
% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
% EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
% LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES,
% LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
% HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

  M = size(Ptrue,2);
  t =   (Ptrue- Pestimate).^2;
  PErrorOutput = sum(sum(t)) / N; % PError per pixel

PErrorOutputmean = PErrorOutput/M; %Mean of PErrorOutput, PError per pixel per endmember
PErrorOutputvar= var(PErrorOutput); %Variance of PErrorOutput

%%Plot histogram across iterations for one N. FOR DEMO PURPOSES.
% figure(100);
% plot(PErrorOutput);
% xlabel('N');ylabel('PError');
% title('Plot of PErrorOutput');
% figure(200);
% hist(PErrorOutput);
% xlabel('PError');ylabel('# of Data Points');
% title('Histogram of PErrorOutput');

end


%demo for affine_fit
%Author: Adrien Leygue
%Date: December 3 2014
close all
clear all
figure;
%generate points that lie approximately in the Z=0 plane
N = 10;
[X,Y] = meshgrid(linspace(0,1,N));
XYZ_1 = [X(:) Y(:) 0.05*randn(N^2,1)];
plot3(XYZ_1(:,1),XYZ_1(:,2),XYZ_1(:,3),'r.');
hold on
%compute the normal to the plane and a point that belongs to the plane
[n_1,~,p_1] = affine_fit(XYZ_1);

%generate points that lie approximately in the Z=X plane
%the normal vector is
n_2_exact = [-sqrt(2)/2 0 sqrt(2)/2];
N = 12;
[X,Y] = meshgrid(linspace(0,1,N));
XYZ_2 = [X(:) Y(:) X(:)] + bsxfun(@times,0.05*randn(N^2,1),n_2_exact);
plot3(XYZ_2(:,1),XYZ_2(:,2),XYZ_2(:,3),'b.');

%compute the normal to the plane and a point that belongs to the plane
[n_2,V_2,p_2] = affine_fit(XYZ_2);

%plot the two points p_1 and p_2
plot3(p_1(1),p_1(2),p_1(3),'ro','markersize',15,'markerfacecolor','red');
plot3(p_2(1),p_2(2),p_2(3),'bo','markersize',15,'markerfacecolor','blue');

%plot the normal vector
quiver3(p_1(1),p_1(2),p_1(3),n_1(1)/3,n_1(2)/3,n_1(3)/3,'r','linewidth',2)
h = quiver3(p_2(1),p_2(2),p_2(3),n_2(1)/3,n_2(2)/3,n_2(3)/3,'b','linewidth',2)

%plot the two adjusted planes
[X,Y] = meshgrid(linspace(0,1,3));

%first plane
surf(X,Y, - (n_1(1)/n_1(3)*X+n_1(2)/n_1(3)*Y-dot(n_1,p_1)/n_1(3)),'facecolor','red','facealpha',0.5);

%second plane
%NB: if the plane is vertical the above method cannot be used, one should
%use the secont output of affine_fit which contains a base of the plane.
%this is illustrated below
%S1 and S2 are the coordinates of the plane points in the basis made of the
%columns ov V_2
[S1,S2] = meshgrid([-1 0 1]);
%generate the pont coordinates
X = p_2(1)+[S1(:) S2(:)]*V_2(1,:)';
Y = p_2(2)+[S1(:) S2(:)]*V_2(2,:)';
Z = p_2(3)+[S1(:) S2(:)]*V_2(3,:)';
%plot the plane
surf(reshape(X,3,3),reshape(Y,3,3),reshape(Z,3,3),'facecolor','blue','facealpha',0.5);

xlabel('x');
ylabel('y');
zlabel('z');
axis equal
%compute the angle between the planes in [0 90] degrees
angle = acosd(dot(n_1,n_2));
if angle>90
    angle = 180-angle;
end
angle


function y = huber_circ( x, DIM, varargin )

%HUBER_CIRC   Huber penalty function with circular symmetry.
%   For a vector X, HUBER_CIRC(X) computes the Huber penalty function
%
%       HUBER_CIRC(X) =   NORM(X,2)^2 if NORM(X,2)<=1,
%                       2*NORM(X,2)-1 if NORM(X,2)>=1.
%
%   For matrices and N-D arrays, the penalty function is applied to the
%   first dimens
%
%   HUBER_CIRC(X,[],M) computes the penalty function with halfwidth M,
%   M.^2.*HUBER_CIRC(X./M). M must be real and positive.
%
%   HUBER_CIRC(X,[],M,T) computes the penalty function with halfwidth M
%   and concomitant scale T:
%
%       HUBER_CIRC(X,[],M,T) = T.*HUBER_CIRC(X./T,[],M) if T > 0
%                              +Inf                     if T <= 0
%
%   See the help file for HUBER for information about this usage.
%
%   If X is a matrix, the penalty function is applied to the columns of the
%   matrix X, and a row vector is returned. If X is an N-D matrix, the
%   penalties are computed along the first non-singleton dimension.
%
%   HUBER_CIRC(X,DIM), HUBER_CIRC(X,DIM,M), and HUBER_CIRC(X,DIM,M,T)
%   computes the penalty along the dimension DIM.
%
%   Disciplined convex programming information:
%       HUBER_CIRC is jointly convex in X and T. It is nonomonotonic in X
%       and nonincreasing in T. Therefore, when used in CVX specifications,
%       X must be affine and T must be concave (or affine). T must be real.
%       X, on the other hand, may be real or complex.

if ~cvx_isaffine( x ),
    error( 'Disciplined convex programming error:\n    HUBER_CIRC is nonmonotonic in X, so X must be affine.', 1 ); %#ok
end
if nargin < 2, DIM = []; end
y = huber_pos( norms( x, DIM ), varargin{:} );

% Copyright 2005-2016 CVX Research, Inc.
% See the file LICENSE.txt for full copyright information.
% The command 'cvx_where' will show where this file is located.


function h = ksizeHall(npd)
%
% Find kernel size according to "plug-in" method of
%     Hall, Marron, Sheather, Jones (91)
%
%

% Copyright (C) 2003 Alexander Ihler; distributable under GPL -- see README.txt

  x = getPoints(npd);
  [N1,N2] = size(x);
  sig = std(x,0,2);                     % estimate sigma (standard)
  lamS= .7413 * iqr(x')';               % find sigma by interquartile range lam
  if (max(lamS)==0) lamS=sig; end;      % replace sigma est. if possible
  BW = 1.0592 * lamS * N2^(-1/(4+N1));
  BW = repmat(BW,[1,N2]);

  dX = repmat(permute(x,[1,3,2]),[1,N2,1]);  % compute Xi-Xj for all i,j
  for i=1:N2,
    dX(:,:,i) = (dX(:,:,i)-x)./BW;
  end;
  for i=1:N2, dX(:,i,i) = 2e22; end;
  dX = reshape(dX,[N1,N2*N2]);

%  use that to find I2 and I3
  I2=h_findI2(N2,dX,BW(:,1));      % I2 = \hat R( f^(2) ) = \int f^(2)^2 dx
  I3=h_findI3(N2,dX,BW(:,1));      % I3 = \hat R( f^(3) )

% for Gaussian Kernel, we evaluate to find:
%  RK = 1.0/(2^N1) * 1.0/pi^(N1/2.0);    % R(K) = \int K^2(x) dx
%  mu2 = 1.0;                            % \mu_i = \int x^i K(x) dx
%  mu4 = 3.0^N1;
  switch (npd.type)
    case 0, RK = 0.282095;   mu2 = 1.000000;   mu4 = 3.000000; % Gauss
    case 1, RK = 0.600000;   mu2 = 0.199994;   mu4 = 0.085708; % Epanetch
    case 2, RK = 0.250002;   mu2 = 1.994473;   mu4 = 23.299070;% Laplace
  end;

  J1 = RK/mu2^2 .* 1./I2;
  J2 = (mu4 * I3) ./ (20 * mu2) .* 1./I2;
  h  = (J1/N2).^(1.0/5) + J2.*(J1/N2).^(3.0/5);

% Let us estimate R(f^(p)) by R( \hat f^(p) )
%   (f is the original density to be est'd;  f^(p) is its pth derivative)
%   Let L be the kernel function for this second estimator, with bandwidth alpha
%
% Ip = \int f^(p)^2_\alpha(x) dx
%    = [(-1)^p/n^2] \sum_i \sum_j L^(p)_\alpha * L^(p)_\alpha
%    = [(-1)^p/(n^2 \alpha^(2p+1))]  \sum_i \sum_j (L^(p) * L^(p))( (Xi-Xj)/\alpha )
%
% Take L to be a Gaussian kernel; we then evaluate L^(p) by:
%
  % L^(p)(x) = (-1)^p H_p(x) L(x)
  % H_p(x) = x H_{p-1}(x) - (p-1)H_{p-2}(x)
  % p=2 =>
  %   H_2(x) = x H_1(x) - H_0(x) = x * x - 1
  %   =>  L^(2)(x) = (x^2 - 1) * L(x)
  % p=3 =>
  %   H_3(x) = x H_2(x) - 2*H_1(x) = x*(x^2-1) - 2*x
  %   =>  L^(3)(x) = (x^3 - 3x) * L(x)
  %

function I2 = h_findI2(n,dXa,alpha)
%%  load ksizeHSJM.mat;
%%  xInd = fix(Nquant * (dXa-Xmin) / (Xmax-Xmin));
%%  xInd = max(xInd,1); xInd = min(xInd,Nquant);
%%  s = sum( L2data(xInd) ,2);
%  s = sum( (dXa.^2 -1) .* 1/sqrt(2*pi) .* exp(-.5*dXa.^2) , 2);
  s = sum( (dXa.^2 -1) .* 1/sqrt(2*pi) .* repmat(exp(-.5*sum(dXa.^2,1)),[size(dXa,1),1]) , 2);
  I2=s./((n*(n-1))*alpha.^5);

function I3 = h_findI3(n,dXb,beta)
%%  load ksizeHSJM.mat;
%%  xInd = fix(Nquant * (dXb-Xmin) / (Xmax-Xmin));
%%  xInd = max(xInd,1); xInd = min(xInd,Nquant);
%%  s = sum( L3data(xInd) , 2);
%  s = sum( (dXb.^3 -3*dXb) .* 1/sqrt(2*pi) .* exp(-.5*dXb.^2) , 2);
  s = sum( (dXb.^3 -3*dXb) .* 1/sqrt(2*pi) .* repmat(exp(-.5*sum(dXb.^2,1)),[size(dXb,1),1]) , 2);
  I3  = -s./((n*(n-1))*beta.^7);


function [lambda_vec, error_train, error_val] = ...
    validationCurve(X, y, Xval, yval)
%VALIDATIONCURVE Generate the train and validation errors needed to
%plot a validation curve that we can use to select lambda
%   [lambda_vec, error_train, error_val] = ...
%       VALIDATIONCURVE(X, y, Xval, yval) returns the train
%       and validation errors (in error_train, error_val)
%       for different values of lambda. You are given the training set (X,
%       y) and validation set (Xval, yval).
%

% Selected values of lambda (you should not change this)
lambda_vec = [0 0.001 0.003 0.01 0.03 0.1 0.3 1 3 10]';

% You need to return these variables correctly.
error_train = zeros(length(lambda_vec), 1);
error_val = zeros(length(lambda_vec), 1);

% ====================== YOUR CODE HERE ======================
% Instructions: Fill in this function to return training errors in
%               error_train and the validation errors in error_val. The
%               vector lambda_vec contains the different lambda parameters
%               to use for each calculation of the errors, i.e,
%               error_train(i), and error_val(i) should give
%               you the errors obtained after training with
%               lambda = lambda_vec(i)
%
% Note: You can loop over lambda_vec with the following:
%
%       for i = 1:length(lambda_vec)
%           lambda = lambda_vec(i);
%           % Compute train / val errors when training linear
%           % regression with regularization parameter lambda
%           % You should store the result in error_train(i)
%           % and error_val(i)
%           ....
%
%       end
%
%

for i = 1:length(lambda_vec)
    lambda = lambda_vec(i);
    [theta] = trainLinearReg(X, y, lambda);
    error_train(i) = linearRegCostFunction(X, y, theta, 0);
    error_val(i) = linearRegCostFunction(Xval, yval, theta, 0);
end

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

end


function chebyshev1_rule ( order, a, b, filename )

%*****************************************************************************80
%
%% CHEBYSHEV1_RULE generates a Gauss-Chebyshev type 1 quadrature rule.
%
%  Discussion:
%
%    This program computes a standard Gauss-Chebyshev type 1 quadrature rule
%    and writes it to a file.
%
%    The user specifies:
%    * the ORDER (number of points) in the rule;
%    * A, the left endpoint;
%    * B, the right endpoint;
%    * FILENAME, the root name of the output files.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    28 February 2010
%
%  Author:
%
%    John Burkardt
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'CHEBYSHEV1_RULE\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Compute a Gauss-Chebyshev type 1 rule for approximating\n' );
  fprintf ( 1, '    Integral ( A <= x <= B ) f(x) / sqrt ( ( x - A ) * ( B - x ) ) dx\n' );
  fprintf ( 1, '  of order ORDER.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The user specifies ORDER, A, B, and FILENAME.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  ORDER is the number of points;\n' );
  fprintf ( 1, '  A is the left endpoint;\n' );
  fprintf ( 1, '  B is the right endpoint;\n' );
  fprintf ( 1, '  FILENAME is used to generate 3 files:\n' );
  fprintf ( 1, '    filename_w.txt - the weight file\n' );
  fprintf ( 1, '    filename_x.txt - the abscissa file.\n' );
  fprintf ( 1, '    filename_r.txt - the region file.\n' );
%
%  Initialize the parameters.
%
  alpha = 0.0;
  beta = 0.0;
%
%  Get ORDER.
%
  if ( nargin < 1 )
    order = input ( '  Enter the rule order ORDER:  ' );
  elseif ( ischar ( order ) )
    order = str2num ( order );
  end
%
%  Get A.
%
  if ( nargin < 2 )
    a = input ( '  Enter the left endpoint A:  ' );
  elseif ( ischar ( a ) )
    a = str2num ( a );
  end
%
%  Get B.
%
  if ( nargin < 3 )
    b = input ( '  Enter the right endpoint B:  ' );
  elseif ( ischar ( b ) )
    b = str2num ( b );
  end
%
%  Get FILENAME.
%
  if ( nargin < 4 )
    fprintf ( 1,  '\n' );
    fprintf ( 1,  '  FILENAME specifies the ''root name'' of the quadrature files).\n' );
    filename = input ( '  Enter the value of FILENAME as a quoted string:  ' );
  end
%
%  Input summary.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  ORDER = %d\n', order );
  fprintf ( 1, '  A = %f\n', a );
  fprintf ( 1, '  B = %f\n', b );
  fprintf ( 1, '  FILENAME = "%s".\n', filename );
%
%  Construct the rule.
%
  kind = 2;
  alpha = 0.0;
  beta = 0.0;
  [ x, w ] = cgqf ( order, kind, alpha, beta, a, b );
%
%  Write the rule.
%
  r = [ a, b ]';
  rule_write ( order, filename, x, w, r );
%
%  Terminate.
%
  fprintf ( 1,  '\n' );
  fprintf ( 1,  'CHEBYSHEV1_RULE:\n' );
  fprintf ( 1,  '  Normal end of execution.\n' );
  fprintf ( 1,  '\n' );
  timestamp ( );

  return
end
function [ t, wts ] = cdgqf ( nt, kind, alpha, beta )

%*****************************************************************************80
%
%% CDGQF computes a Gauss quadrature formula with default A, B and simple knots.
%
%  Discussion:
%
%    This routine computes all the knots and weights of a Gauss quadrature
%    formula with a classical weight function with default values for A and B,
%    and only simple knots.
%
%    There are no moments checks and no printing is done.
%
%    Use routine EIQFS to evaluate a quadrature computed by CGQFS.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Sylvan Elhay, Jaroslav Kautsky,
%    Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of
%    Interpolatory Quadrature,
%    ACM Transactions on Mathematical Software,
%    Volume 13, Number 4, December 1987, pages 399-415.
%
%  Parameters:
%
%    Input, integer NT, the number of knots.
%
%    Input, integer KIND, the rule.
%    1, Legendre,             (a,b)       1.0
%    2, Chebyshev Type 1,     (a,b)       ((b-x)*(x-a))^(-0.5)
%    3, Gegenbauer,           (a,b)       ((b-x)*(x-a))^alpha
%    4, Jacobi,               (a,b)       (b-x)^alpha*(x-a)^beta
%    5, Generalized Laguerre, (a,inf)     (x-a)^alpha*exp(-b*(x-a))
%    6, Generalized Hermite,  (-inf,inf)  |x-a|^alpha*exp(-b*(x-a)^2)
%    7, Exponential,          (a,b)       |x-(a+b)/2.0|^alpha
%    8, Rational,             (a,inf)     (x-a)^alpha*(x+b)^beta
%
%    Input, real ALPHA, the value of Alpha, if needed.
%
%    Input, real BETA, the value of Beta, if needed.
%
%    Output, real T(NT), the knots.
%
%    Output, real WTS(NT), the weights.
%
  parchk ( kind, 2 * nt, alpha, beta );
%
%  Get the Jacobi matrix and zero-th moment.
%
  [ aj, bj, zemu ] = class_matrix ( kind, nt, alpha, beta );
%
%  Compute the knots and weights.
%
  [ t, wts ] = sgqf ( nt, aj, bj, zemu );

  return
end
function [ t, wts ] = cgqf ( nt, kind, alpha, beta, a, b )

%*****************************************************************************80
%
%% CGQF computes knots and weights of a Gauss quadrature formula.
%
%  Discussion:
%
%    The user may specify the interval (A,B).
%
%    Only simple knots are produced.
%
%    The user may request that the routine print the knots and weights,
%    and perform a moment check.
%
%    Use routine EIQFS to evaluate this quadrature formula.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 February 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Sylvan Elhay, Jaroslav Kautsky,
%    Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of
%    Interpolatory Quadrature,
%    ACM Transactions on Mathematical Software,
%    Volume 13, Number 4, December 1987, pages 399-415.
%
%  Parameters:
%
%    Input, integer NT, the number of knots.
%
%    Input, integer KIND, the rule.
%    1, Legendre,             (a,b)       1.0
%    2, Chebyshev Type 1,     (a,b)       ((b-x)*(x-a))^(-0.5)
%    3, Gegenbauer,           (a,b)       ((b-x)*(x-a))^alpha
%    4, Jacobi,               (a,b)       (b-x)^alpha*(x-a)^beta
%    5, Generalized Laguerre, (a,+oo)     (x-a)^alpha*exp(-b*(x-a))
%    6, Generalized Hermite,  (-oo,+oo)   |x-a|^alpha*exp(-b*(x-a)^2)
%    7, Exponential,          (a,b)       |x-(a+b)/2.0|^alpha
%    8, Rational,             (a,+oo)     (x-a)^alpha*(x+b)^beta
%    9, Chebyshev Type 2,     (a,b)       ((b-x)*(x-a))^(+0.5)
%
%    Input, real ALPHA, the value of Alpha, if needed.
%
%    Input, real BETA, the value of Beta, if needed.
%
%    Input, real A, B, the interval endpoints.
%
%    Output, real T(NT), the knots.
%
%    Output, real WTS(NT), the weights.
%

%
%  Compute the Gauss quadrature formula for default values of A and B.
%
  [ t, wts ] = cdgqf ( nt, kind, alpha, beta );
%
%  All knots have multiplicity = 1.
%
  mlt = zeros(nt,1);
  mlt(1:nt) = 1;
%
%  NDX(I) = I.
%
  ndx = ( 1 : nt );
%
%  Scale the quadrature rule.
%
  [ t, wts ] = scqf ( nt, t, mlt, wts, nt, ndx, kind, alpha, beta, a, b );

  return
end
function [ aj, bj, zemu ] = class_matrix ( kind, m, alpha, beta )

%*****************************************************************************80
%
%% CLASS_MATRIX computes the Jacobi matrix for a quadrature rule.
%
%  Discussion:
%
%    This routine computes the diagonal AJ and subdiagonal BJ
%    elements of the order M tridiagonal symmetric Jacobi matrix
%    associated with the polynomials orthogonal with respect to
%    the weight function specified by KIND.
%
%    For weight functions 1-7, M elements are defined in BJ even
%    though only M-1 are needed.  For weight function 8, BJ(M) is
%    set to zero.
%
%    The zero-th moment of the weight function is returned in ZEMU.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Sylvan Elhay, Jaroslav Kautsky,
%    Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of
%    Interpolatory Quadrature,
%    ACM Transactions on Mathematical Software,
%    Volume 13, Number 4, December 1987, pages 399-415.
%
%  Parameters:
%
%    Input, integer KIND, the rule.
%    1, Legendre,             (a,b)       1.0
%    2, Chebyshev Type 1,     (a,b)       ((b-x)*(x-a))^(-0.5)
%    3, Gegenbauer,           (a,b)       ((b-x)*(x-a))^alpha
%    4, Jacobi,               (a,b)       (b-x)^alpha*(x-a)^beta
%    5, Generalized Laguerre, (a,inf)     (x-a)^alpha*exp(-b*(x-a))
%    6, Generalized Hermite,  (-inf,inf)  |x-a|^alpha*exp(-b*(x-a)^2)
%    7, Exponential,          (a,b)       |x-(a+b)/2.0|^alpha
%    8, Rational,             (a,inf)     (x-a)^alpha*(x+b)^beta
%
%    Input, integer M, the order of the Jacobi matrix.
%
%    Input, real ALPHA, the value of Alpha, if needed.
%
%    Input, real BETA, the value of Beta, if needed.
%
%    Output, real AJ(M), BJ(M), the diagonal and subdiagonal
%    of the Jacobi matrix.
%
%    Output, real ZEMU, the zero-th moment.
%
  temp = eps;

  parchk ( kind, 2 * m - 1, alpha, beta );

  temp2 = 0.5;

  if ( 500.0 * temp < abs ( ( gamma ( temp2 ) )^2 - pi ) )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'CLASS - Fatal error!\n' );
    fprintf ( 1, '  Gamma function does not match machine parameters.\n' );
    error ( 'CLASS - Fatal error!' );
  end

  bj = zeros(m,1);
  aj = zeros(m,1);

  if ( kind == 1 )

    ab = 0.0;

    zemu = 2.0 / ( ab + 1.0 );

    aj(1:m) = 0.0;

    for i = 1 : m
      abi = i + ab * mod ( i, 2 );
      abj = 2 * i + ab;
      bj(i) = abi * abi / ( abj * abj - 1.0 );
    end
    bj(1:m) =  sqrt ( bj(1:m) );

  elseif ( kind == 2 )

    zemu = pi;

    aj(1:m) = 0.0;

    bj(1) =  sqrt ( 0.5 );
    bj(2:m) = 0.5;

  elseif ( kind == 3 )

    ab = alpha * 2.0;
    zemu = 2.0^( ab + 1.0 ) * gamma ( alpha + 1.0 )^2 ...
      / gamma ( ab + 2.0 );

    aj(1:m) = 0.0;
    bj(1) = 1.0 / ( 2.0 * alpha + 3.0 );
    for i = 2 : m
      bj(i) = i * ( i + ab ) / ( 4.0 * ( i + alpha )^2 - 1.0 );
    end
    bj(1:m) =  sqrt ( bj(1:m) );

  elseif ( kind == 4 )

    ab = alpha + beta;
    abi = 2.0 + ab;
    zemu = 2.0^( ab + 1.0 ) * gamma ( alpha + 1.0 ) ...
      * gamma ( beta + 1.0 ) / gamma ( abi );
    aj(1) = ( beta - alpha ) / abi;
    bj(1) = 4.0 * ( 1.0 + alpha ) * ( 1.0 + beta ) ...
      / ( ( abi + 1.0 ) * abi * abi );
    a2b2 = beta * beta - alpha * alpha;

    for i = 2 : m
      abi = 2.0 * i + ab;
      aj(i) = a2b2 / ( ( abi - 2.0 ) * abi );
      abi = abi^2;
      bj(i) = 4.0 * i * ( i + alpha ) * ( i + beta ) * ( i + ab ) ...
        / ( ( abi - 1.0 ) * abi );
    end
    bj(1:m) =  sqrt ( bj(1:m) );

  elseif ( kind == 5 )

    zemu = gamma ( alpha + 1.0 );

    for i = 1 : m
      aj(i) = 2.0 * i - 1.0 + alpha;
      bj(i) = i * ( i + alpha );
    end
    bj(1:m) =  sqrt ( bj(1:m) );

  elseif ( kind == 6 )

    zemu = gamma ( ( alpha + 1.0 ) / 2.0 );

    aj(1:m) = 0.0;

    for i = 1 : m
      bj(i) = ( i + alpha * mod ( i, 2 ) ) / 2.0;
    end
    bj(1:m) =  sqrt ( bj(1:m) );

  elseif ( kind == 7 )

    ab = alpha;
    zemu = 2.0 / ( ab + 1.0 );

    aj(1:m) = 0.0;

    for i = 1 : m
      abi = i + ab * mod(i,2);
      abj = 2 * i + ab;
      bj(i) = abi * abi / ( abj * abj - 1.0 );
    end
    bj(1:m) =  sqrt ( bj(1:m) );

  elseif ( kind == 8 )

    ab = alpha + beta;
    zemu = gamma ( alpha + 1.0 ) * gamma ( - ( ab + 1.0 ) ) ...
      / gamma ( - beta );
    apone = alpha + 1.0;
    aba = ab * apone;
    aj(1) = - apone / ( ab + 2.0 );
    bj(1) = - aj(1) * ( beta + 1.0 ) / ( ab + 2.0 ) / ( ab + 3.0 );
    for i = 2 : m
      abti = ab + 2.0 * i;
      aj(i) = aba + 2.0 * ( ab + i ) * ( i - 1 );
      aj(i) = - aj(i) / abti / ( abti - 2.0 );
    end

    for i = 2 : m - 1
      abti = ab + 2.0 * i;
      bj(i) = i * ( alpha + i ) / ( abti - 1.0 ) * ( beta + i ) ...
        / ( abti^2 ) * ( ab + i ) / ( abti + 1.0 );
    end

    bj(m) = 0.0;
    bj(1:m) =  sqrt ( bj(1:m) );

  end

  return
end
function [ d, z ] = imtqlx ( n, d, e, z )

%*****************************************************************************80
%
%% IMTQLX diagonalizes a symmetric tridiagonal matrix.
%
%  Discussion:
%
%    This routine is a slightly modified version of the EISPACK routine to
%    perform the implicit QL algorithm on a symmetric tridiagonal matrix.
%
%    The authors thank the authors of EISPACK for permission to use this
%    routine.
%
%    It has been modified to produce the product Q' * Z, where Z is an input
%    vector and Q is the orthogonal matrix diagonalizing the input matrix.
%    The changes consist (essentialy) of applying the orthogonal transformations
%    directly to Z as they are generated.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Sylvan Elhay, Jaroslav Kautsky,
%    Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of
%    Interpolatory Quadrature,
%    ACM Transactions on Mathematical Software,
%    Volume 13, Number 4, December 1987, pages 399-415.
%
%    Roger Martin, James Wilkinson,
%    The Implicit QL Algorithm,
%    Numerische Mathematik,
%    Volume 12, Number 5, December 1968, pages 377-383.
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%
%    Input, real D(N), the diagonal entries of the matrix.
%
%    Input, real E(N), the subdiagonal entries of the
%    matrix, in entries E(1) through E(N-1).
%
%    Input, real Z(N), a vector to be operated on.
%
%    Output, real D(N), the diagonal entries of the diagonalized matrix.
%
%    Output, real Z(N), the value of Q' * Z, where Q is the matrix that
%    diagonalizes the input symmetric tridiagonal matrix.
%
  itn = 30;

  prec = eps;

  if ( n == 1 )
    return
  end

  e(n) = 0.0;

  for l = 1 : n

    j = 0;

    while ( 1 )

      for m = l : n

        if ( m == n )
          break
        end

        if ( abs ( e(m) ) <= prec * ( abs ( d(m) ) + abs ( d(m+1) ) ) )
          break
        end

      end

      p = d(l);

      if ( m == l )
        break
      end

      if ( j == itn )
        fprintf ( 1, '\n' );
        fprintf ( 1, 'IMTQLX - Fatal error!\n' );
        fprintf ( 1, '  Iteration limit exceeded.\n' );
        error ( 'IMTQLX - Fatal error!' );
      end

      j = j + 1;
      g = ( d(l+1) - p ) / ( 2.0 * e(l) );
      r =  sqrt ( g * g + 1.0 );
      g = d(m) - p + e(l) / ( g + r8_sign ( g ) * abs ( r ) );
      s = 1.0;
      c = 1.0;
      p = 0.0;
      mml = m - l;

      for ii = 1 : mml

        i = m - ii;
        f = s * e(i);
        b = c * e(i);

        if ( abs ( f ) >= abs ( g ) )
          c = g / f;
          r =  sqrt ( c * c + 1.0 );
          e(i+1) = f * r;
          s = 1.0 / r;
          c = c * s;
        else
          s = f / g;
          r =  sqrt ( s * s + 1.0 );
          e(i+1) = g * r;
          c = 1.0 / r;
          s = s * c;
        end

        g = d(i+1) - p;
        r = ( d(i) - g ) * s + 2.0 * c * b;
        p = s * r;
        d(i+1) = g + p;
        g = c * r - b;
        f = z(i+1);
        z(i+1) = s * z(i) + c * f;
        z(i) = c * z(i) - s * f;

      end

      d(l) = d(l) - p;
      e(l) = g;
      e(m) = 0.0;

    end

  end

  for ii = 2 : n

     i = ii - 1;
     k = i;
     p = d(i);

     for j = ii : n
       if ( d(j) < p )
         k = j;
         p = d(j);
       end
     end

     if ( k ~= i )
       d(k) = d(i);
       d(i) = p;
       p = z(i);
       z(i) = z(k);
       z(k) = p;
     end

  end

  return
end
function parchk ( kind, m, alpha, beta )

%*****************************************************************************80
%
%% PARCHK checks parameters ALPHA and BETA for classical weight functions.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 January 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Sylvan Elhay, Jaroslav Kautsky,
%    Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of
%    Interpolatory Quadrature,
%    ACM Transactions on Mathematical Software,
%    Volume 13, Number 4, December 1987, pages 399-415.
%
%  Parameters:
%
%    Input, integer KIND, the rule.
%    1, Legendre,             (a,b)       1.0
%    2, Chebyshev Type 1,     (a,b)       ((b-x)*(x-a))^(-0.5)
%    3, Gegenbauer,           (a,b)       ((b-x)*(x-a))^alpha
%    4, Jacobi,               (a,b)       (b-x)^alpha*(x-a)^beta
%    5, Generalized Laguerre, (a,inf)     (x-a)^alpha*exp(-b*(x-a))
%    6, Generalized Hermite,  (-inf,inf)  |x-a|^alpha*exp(-b*(x-a)^2)
%    7, Exponential,          (a,b)       |x-(a+b)/2.0|^alpha
%    8, Rational,             (a,inf)     (x-a)^alpha*(x+b)^beta
%
%    Input, integer M, the order of the highest moment to
%    be calculated.  This value is only needed when KIND = 8.
%
%    Input, real ALPHA, BETA, the parameters, if required
%    by the value of KIND.
%
  if ( kind <= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'PARCHK - Fatal error!\n' );
    fprintf ( 1, '  KIND <= 0.\n' );
    error ( 'PARCHK - Fatal error!' );
  end
%
%  Check ALPHA for Gegenbauer, Jacobi, Laguerre, Hermite, Exponential.
%
  if ( 3 <= kind && alpha <= -1.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'PARCHK - Fatal error!\n' );
    fprintf ( 1, '  3 <= KIND and ALPHA <= -1.\n' );
    error ( 'PARCHK - Fatal error!' );
  end
%
%  Check BETA for Jacobi.
%
  if ( kind == 4 && beta <= -1.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'PARCHK - Fatal error!\n' );
    fprintf ( 1, '  KIND == 4 and BETA <= -1.0.\n' );
    error ( 'PARCHK - Fatal error!' );
  end
%
%  Check ALPHA and BETA for rational.
%
  if ( kind == 8 )
    tmp = alpha + beta + m + 1.0;
    if ( 0.0 <= tmp || tmp <= beta )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'PARCHK - Fatal error!\n' );
      fprintf ( 1, '  KIND == 8 but condition on ALPHA and BETA fails.\n' );
      error ( 'PARCHK - Fatal error!' );
    end
  end

  return
end
function value = r8_sign ( x )

%*****************************************************************************80
%
%% R8_SIGN returns the sign of an R8.
%
%  Discussion:
%
%    The value is +1 if the number is positive or zero, and it is -1 otherwise.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 March 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the number whose sign is desired.
%
%    Output, real VALUE, the sign of X.
%
  if ( 0 <= x )
    value = +1.0;
  else
    value = -1.0;
  end

  return
end
function r8mat_write ( output_filename, m, n, table )

%*****************************************************************************80
%
%% R8MAT_WRITE writes an R8MAT file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    11 August 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string OUTPUT_FILENAME, the output filename.
%
%    Input, integer M, the spatial dimension.
%
%    Input, integer N, the number of points.
%
%    Input, real TABLE(M,N), the points.
%

%
%  Open the file.
%
  output_unit = fopen ( output_filename, 'wt' );

  if ( output_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8MAT_WRITE - Error!\n' );
    fprintf ( 1, '  Could not open the output file.\n' );
    error ( 'R8MAT_WRITE - Error!' );
  end
%
%  Write the data.
%
%  For smaller data files, and less precision, try:
%
%     fprintf ( output_unit, '  %14.6f', table(i,j) );
%
  for j = 1 : n
    for i = 1 : m
      fprintf ( output_unit, '  %24.16f', table(i,j) );
    end
    fprintf ( output_unit, '\n' );
  end
%
%  Close the file.
%
  fclose ( output_unit );

  return
end
function rule_write ( order, filename, x, w, r )

%*****************************************************************************80
%
%% RULE_WRITE writes a quadrature rule to a file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 February 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer ORDER, the order of the rule.
%
%    Input, string FILENAME, specifies the output files.
%    write files 'filename_w.txt', 'filename_x.txt', 'filename_r.txt' defining
%    weights, abscissas, and region.
%
%    Input, real X(ORDER), the abscissas.
%
%    Input, real W(ORDER), the weights.
%
%    Input, real R(2), the region.
%
  filename_x = strcat ( filename, '_x.txt' );
  filename_w = strcat ( filename, '_w.txt' );
  filename_r = strcat ( filename, '_r.txt' );

  fprintf ( 1, '\n' );
  fprintf ( 1,'  Creating quadrature files.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  "Root" file name is   "%s".\n', filename );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Weight file will be   "%s".\n', filename_w );
  fprintf ( 1, '  Abscissa file will be "%s".\n', filename_x );
  fprintf ( 1, '  Region file will be   "%s".\n', filename_r );

  r8mat_write ( filename_w, 1, order, w' );
  r8mat_write ( filename_x, 1, order, x' );
  r8mat_write ( filename_r, 1, 2,     r' );

  return
end
function [ t, wts ] = scqf ( nt, t, mlt, wts, nwts, ndx, kind, alpha, ...
  beta, a, b )

%*****************************************************************************80
%
%% SCQF scales a quadrature formula to a nonstandard interval.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    24 February 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Sylvan Elhay, Jaroslav Kautsky,
%    Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of
%    Interpolatory Quadrature,
%    ACM Transactions on Mathematical Software,
%    Volume 13, Number 4, December 1987, pages 399-415.
%
%  Parameters:
%
%    Input, integer NT, the number of knots.
%
%    Input, real T(NT), the original knots.
%
%    Input, integer MLT(NT), the multiplicity of the knots.
%
%    Input, real WTS(NWTS), the weights.
%
%    Input, integer NWTS, the number of weights.
%
%    Input, integer NDX(NT), used to index the array WTS.
%    For more details see the comments in CAWIQ.
%
%    Input, integer KIND, the rule.
%    1, Legendre,             (a,b)       1.0
%    2, Chebyshev Type 1,     (a,b)       ((b-x)*(x-a))^(-0.5)
%    3, Gegenbauer,           (a,b)       ((b-x)*(x-a))^alpha
%    4, Jacobi,               (a,b)       (b-x)^alpha*(x-a)^beta
%    5, Generalized Laguerre, (a,+oo)     (x-a)^alpha*exp(-b*(x-a))
%    6, Generalized Hermite,  (-oo,+oo)   |x-a|^alpha*exp(-b*(x-a)^2)
%    7, Exponential,          (a,b)       |x-(a+b)/2.0|^alpha
%    8, Rational,             (a,+oo)     (x-a)^alpha*(x+b)^beta
%    9, Chebyshev Type 2,     (a,b)       ((b-x)*(x-a))^(+0.5)
%
%    Input, real ALPHA, the value of Alpha, if needed.
%
%    Input, real BETA, the value of Beta, if needed.
%
%    Input, real A, B, the interval endpoints.
%
%    Output, real T(NT), the scaled knots.
%
%    Output, real WTS(NWTS), the scaled weights.
%
  temp = eps;

  parchk ( kind, 1, alpha, beta )

  if ( kind == 1 )

    al = 0.0;
    be = 0.0;

    if ( abs ( b - a ) <= temp )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'SCQF - Fatal error!\n' );
      fprintf ( 1, '  |B - A| too small.\n' );
      fprintf ( 1, '  A = %f\n', a );
      fprintf ( 1, '  B = %f\n', b );
      error ( 'SCQF - Fatal error!' );
    end

    shft = ( a + b ) / 2.0;
    slp = ( b - a ) / 2.0;

  elseif ( kind == 2 )

    al = -0.5;
    be = -0.5;

    if ( abs ( b - a ) <= temp )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'SCQF - Fatal error!\n' );
      fprintf ( 1, '  |B - A| too small.\n' );
      fprintf ( 1, '  A = %f\n', a );
      fprintf ( 1, '  B = %f\n', b );
      error ( 'SCQF - Fatal error!' );
    end

    shft = ( a + b ) / 2.0;
    slp = ( b - a ) / 2.0;

  elseif ( kind == 3 )

    al = alpha;
    be = alpha;

    if ( abs ( b - a ) <= temp )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'SCQF - Fatal error!\n' );
      fprintf ( 1, '  |B - A| too small.\n' );
      fprintf ( 1, '  A = %f\n', a );
      fprintf ( 1, '  B = %f\n', b );
      error ( 'SCQF - Fatal error!' );
    end

    shft = ( a + b ) / 2.0;
    slp = ( b - a ) / 2.0;

  elseif ( kind == 4 )

    al = alpha;
    be = beta;

    if ( abs ( b - a ) <= temp )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'SCQF - Fatal error!\n' );
      fprintf ( 1, '  |B - A| too small.\n' );
      fprintf ( 1, '  A = %f\n', a );
      fprintf ( 1, '  B = %f\n', b );
      error ( 'SCQF - Fatal error!' );
    end

    shft = ( a + b ) / 2.0;
    slp = ( b - a ) / 2.0;

  elseif ( kind == 5 )

    if ( b <= 0.0 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'SCQF - Fatal error!\n' );
      fprintf ( 1, '  B <= 0.\n' );
      fprintf ( 1, '  A = %f\n', a );
      fprintf ( 1, '  B = %f\n', b );
      error ( 'SCQF - Fatal error!' );
    end

    shft = a;
    slp = 1.0 / b;
    al = alpha;
    be = 0.0;

  elseif ( kind == 6 )

    if ( b <= 0.0 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'SCQF - Fatal error!\n' );
      fprintf ( 1, '  B <= 0.\n' );
      fprintf ( 1, '  A = %f\n', a );
      fprintf ( 1, '  B = %f\n', b );
      error ( 'SCQF - Fatal error!' );
    end

    shft = a;
    slp = 1.0 / sqrt ( b );
    al = alpha;
    be = 0.0;

  elseif ( kind == 7 )

    al = alpha;
    be = 0.0;

    if ( abs ( b - a ) <= temp )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'SCQF - Fatal error!\n' );
      fprintf ( 1, '  |B - A| too small.\n' );
      fprintf ( 1, '  A = %f\n', a );
      fprintf ( 1, '  B = %f\n', b );
      error ( 'SCQF - Fatal error!' );
    end

    shft = ( a + b ) / 2.0;
    slp = ( b - a ) / 2.0;

  elseif ( kind == 8 )

    if ( a + b <= 0.0 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'SCQF - Fatal error!\n' );
      fprintf ( 1, '  A + B <= 0.\n' );
      fprintf ( 1, '  A = %f\n', a );
      fprintf ( 1, '  B = %f\n', b );
      error ( 'SCQF - Fatal error!' );
    end

    shft = a;
    slp = a + b;
    al = alpha;
    be = beta;

  elseif ( kind == 9 )

    al = 0.5;
    be = 0.5;

    if ( abs ( b - a ) <= temp )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'SCQF - Fatal error!\n' );
      fprintf ( 1, '  |B - A| too small.\n' );
      fprintf ( 1, '  A = %f\n', a );
      fprintf ( 1, '  B = %f\n', b );
      error ( 'SCQF - Fatal error!' );
    end

    shft = ( a + b ) / 2.0;
    slp = ( b - a ) / 2.0;

  end

  p = slp^( al + be + 1.0 );

  for k = 1 : nt

    t(k) = shft + slp * t(k);
    l = abs ( ndx(k) );

    if ( l ~= 0 )
      tmp = p;
      for i = l : l + mlt(k) - 1
        wts(i) = wts(i) * tmp;
        tmp = tmp * slp;
      end
    end

  end

  return
end
function [ t, wts ] = sgqf ( nt, aj, bj, zemu )

%*****************************************************************************80
%
%% SGQF computes knots and weights of a Gauss Quadrature formula.
%
%  Discussion:
%
%    This routine computes all the knots and weights of a Gauss quadrature
%    formula with simple knots from the Jacobi matrix and the zero-th
%    moment of the weight function, using the Golub-Welsch technique.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 February 2010
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Sylvan Elhay, Jaroslav Kautsky,
%    Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of
%    Interpolatory Quadrature,
%    ACM Transactions on Mathematical Software,
%    Volume 13, Number 4, December 1987, pages 399-415.
%
%  Parameters:
%
%    Input, integer NT, the number of knots.
%
%    Input, real AJ(NT), the diagonal of the Jacobi matrix.
%
%    Input, real BJ(NT), the subdiagonal of the Jacobi
%    matrix, in entries 1 through NT-1.  On output, BJ has been overwritten.
%
%    Input, real ZEMU, the zero-th moment of the weight function.
%
%    Output, real T(NT), the knots.
%
%    Output, real WTS(NT), the weights.
%

%
%  Exit if the zero-th moment is not positive.
%
  if ( zemu <= 0.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'SGQF - Fatal error!\n' );
    fprintf ( 1, '  ZEMU <= 0.\n' );
    error ( 'SGQF - Fatal error!' );
  end
%
%  Set up vectors for IMTQLX.
%
  wts = zeros ( nt, 1 );

  wts(1) = sqrt ( zemu );
  wts(2:nt) = 0.0;
%
%  Diagonalize the Jacobi matrix.
%
  [ t, wts ] = imtqlx ( nt, aj, bj, wts );

  wts(1:nt) = wts(1:nt).^2;

  return
end
function timestamp ( )

%*****************************************************************************80
%
%% TIMESTAMP prints the current YMDHMS date as a timestamp.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
  t = now;
  c = datevec ( t );
  s = datestr ( c, 0 );
  fprintf ( 1, '%s\n', s );

  return
end


function value = r8_exponential_01_pdf ( rval )

%*****************************************************************************80
%
%% R8_EXPONENTIAL_01_PDF: PDF of a standard exponential distribution.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 June 2013
%
%  Author:
%
%    John Burkardt.
%
%  Parameters:
%
%    Input, real RVAL, the point where the PDF is evaluated.
%
%    Output, real VALUE, the value of the PDF.
%
  if ( rval < 0.0 )
    value = 0.0;
  else
    value = exp ( - rval );
  end

  return
end


function square_monte_carlo_test01 ( )

%*****************************************************************************80
%
%% SQUARE_MONTE_CARLO_TEST01 estimates integrals over the unit square in 2D.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 January 2014
%
%  Author:
%
%    John Burkardt
%
  e_test = [ ...
    0, 0; ...
    2, 0; ...
    0, 2; ...
    4, 0; ...
    2, 2; ...
    0, 4; ...
    6, 0 ]';

  fprintf ( 1, '\n' );
  fprintf ( 1, 'SQUARE_MONTE_CARLO_TEST01\n' );
  fprintf ( 1, '  Use SQUARE01_SAMPLE to estimate integrals \n' );
  fprintf ( 1, '  along the interior of the unit square in 2D.\n' );

  seed = 123456789;

  fprintf ( 1, '\n' );
  fprintf ( 1, '         N' );
  fprintf ( 1, '           1' );
  fprintf ( 1, '              X^2' );
  fprintf ( 1, '             Y^2' );
  fprintf ( 1, '             X^4' );
  fprintf ( 1, '           X^2Y^2' );
  fprintf ( 1, '             Y^4' );
  fprintf ( 1, '           X^6\n' );
  fprintf ( 1, '\n' );

  n = 1;

  while ( n <= 65536 )

    [ x, seed ] = square01_sample ( n, seed );
    fprintf ( 1, '  %8d', n );

    for j = 1 : 7

      e(1:2) = e_test(1:2,j);

      value = monomial_value ( 2, n, e, x );

      result = square01_area ( ) * sum ( value(1:n) ) / n;

      fprintf ( 1, '  %14.6g', result );

    end

    fprintf ( 1, '\n' );

    n = 2 * n;

  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '     Exact' );

  for j = 1 : 7

    e(1:2) = e_test(1:2,j);

    result = square01_monomial_integral ( e );
    fprintf ( 1, '  %14.6g', result );

  end

  fprintf ( 1, '\n' );

  return
end


function dz = cartPoleDynamicsHumanReadable(z,u,p)
% dz = cartPoleDynamicsHumanReadable(z,u,p)
%
% This function computes the first-order dynamics of the cart-pole.
%
% INPUTS:
%   z = [4, n] = [x;q;dx;dq] = state of the system
%   u = [1, n] = horizontal force applied to the cart
%   p = parameter struct
%       .g = gravity
%       .m1 = cart mass
%       .m2 = pole mass
%       .l = pendulum length
% OUTPUTS:
%   dz = dz/dt = time derivative of state
%
%

% x = z(1,:);   %Cart position (Not used in dynamics)
q = z(2,:);   % pendulum (pole) angle, measure from gravity vector
dx = z(3,:);  % cart velocity
dq = z(4,:);  %pendulum angle rate

% Unpack the physical parameters
l = p.l;  %Pendulum length
m1 = p.m1; % cart mass
m2 = p.m2; % pole mass
g = p.g;  %Gravity acceleration

% The following expressions were derived using the symbolic math toolbox,
% in the script: Derive_cartPole.m
% Typically I use the automatically generated code, but I've written out
% the code in a more readable way here for tutorial purposes.

mEff = m1 + m2 - m2.*cos(q).^2;
centr = dq.^2.*l.*m2.*sin(q);
ddx = (u + centr + g.*m2.*cos(q).*sin(q))./mEff;
ddq = -(u.*cos(q) + (m1 + m2)*g*sin(q) + centr.*cos(q))./(l.*mEff);

dz = [dx;dq;ddx;ddq];

end


function [ vX ] = ProxL1NormSum( vY, paramGamma, paramB )
% ----------------------------------------------------------------------------------------------- %
% [ vX ] = ProxL1NormSum( vY, paramGamma, paramB )
%   Solving the Least Squares Problem with L1 Regualarization (LASOO) with
%   Linear Equality Constraints (Sum of Elements) - Prox Operator.
% Input:
%   - vY            -   Input Vector.
%                       Structure: Vector (Column).
%                       Type: 'Single' / 'Double'.
%                       Range: (-inf, inf).
%   - paramGamma    -   Parameter Gamma - L2 Regularization Factor.
%                       Sets the coefficient of the L1 Term.
%                       Structure: Scalar.
%                       Type: 'Single' / 'Double'.
%                       Range: [0, inf).
%   - paramB        -   Parameter B - Equality Constarint Parameter.
%                       Sets the scalar constarint of the equality
%                       condition.
%                       Structure: Scalar.
%                       Type: 'Single' / 'Double'.
%                       Range: (-inf, inf).
% Output:
%   - vX            -   Output Vector.
%                       The vector whichi minizes teh objective function
%                       and its sum of elements equals to paramB.
%                       Structure: Vector (Column).
%                       Type: 'Single' / 'Double'.
%                       Range: (-inf, inf).
% References
%   1.  Efficient Solvers for Sparse Subspace Clustering - https://arxiv.org/abs/1804.06291.
%   2.  https://math.stackexchange.com/a/2886715/33.
% Remarks:
%   1.  S
% TODO:
%   1.  U.
% Release Notes:
%   -   1.0.000     18/08/2018  Royi Avital
%       *   First release version.
% ----------------------------------------------------------------------------------------------- %

FALSE   = 0;
TRUE    = 1;

OFF     = 0;
ON      = 1;

debugMode = OFF;

numElements = size(vY, 1);

vB      = sort([vY - paramGamma; vY + paramGamma], 'ascend');
iMin    = 1; %<! Bisection Lower Bound
iMax    = (2 * numElements) + 1; %<! Bisection Upper Bound
maxItr  = ceil(log2(iMax)) + 1;

if(debugMode == ON)
    vParamBeta = linspace(vB(1), vB(end), 1000);

    for ii = 1:length(vParamBeta)
        vZ(ii) = sum( ProxL1Norm(vY - vParamBeta(ii), paramGamma) ) - paramB;
    end
    for ii = 1:length(vB)
        vT(ii) = sum( ProxL1Norm(vY - vB(ii), paramGamma) ) - paramB;
    end

    figure();
    plot(vParamBeta, vZ);
    hold('on');
    plot(vB, vT, '*');
end

% Bisection
for ii = 1:maxItr
    if((iMax - iMin) <= 1)
        break;
    end
    idxJ = round((iMin + iMax) / 2);
    idxJ = min(max(idxJ, iMin + 1), iMax - 1);

    vX = ProxL1Norm(vY - vB(idxJ), paramGamma);
    if(sum(vX) > paramB)
        iMin = idxJ;
    else
        iMax = idxJ;
    end
end

if(debugMode == ON)
    plot(vB(iMin), sum( ProxL1Norm(vY - vB(iMin), paramGamma) ) - paramB, 'o');
    plot(vB(iMax), sum( ProxL1Norm(vY - vB(iMax), paramGamma) ) - paramB, 'o');
end

% Once the section is found there a closed form solution.
% Within the section [vB(iMin), vB(iMax)] the function has constant slope
% and for any paramBeta \in (vB(iMin), vB(iMax)) the function sign(vY -
% paramBeta) is constant.
% Hence sign(vY - paramBeta) .* max(abs(vY - paramBeta) - paramGamma), 0)
% equals to (Only at the support, where max(abs(vY - paramBeta) -
% paramGamma), 0) doesn't vanish) vY - paramBeta - paramGamam * sign().
% Looking when this sum equals to paramB happens:
% 1 / length(vSupport) * sumvY(vSupport) -

paramBeta   = (vB(iMin) + vB(iMax)) / 2;
vX          = ProxL1Norm(vY - paramBeta, paramGamma);
vS          = (vX ~= 0);
paramBeta   = (sum(vY(vS) - paramGamma * sign(vX(vS))) - paramB) / sum(vS);
vX          = ProxL1Norm(vY - paramBeta, paramGamma);

end

function [ vX ] = ProxL1Norm( vY, paramLambda )

vX = sign(vY) .* max(abs(vY) - paramLambda, 0);

end


function pdf = pearson_05_pdf ( x, a, b, c )

%*****************************************************************************80
%
%% PEARSON_05_PDF evaluates the Pearson 5 PDF.
%
%  Formula:
%
%    PDF(X)(A,B) = A**B * ( X - C )**(-B-1)
%      * exp ( - A / ( X - C ) ) / Gamma ( B )
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the argument of the PDF.
%    C < X
%
%    Input, real A, B, C, the parameters of the PDF.
%    0.0 < A, 0.0 < B.
%
%    Output, real PDF, the value of the PDF.
%
  if ( x <= c )
    pdf = 0.0;
  else
    pdf = a^b * ( x - c )^( - b - 1.0 ) * exp ( - a / ( x - c ) ) / gamma ( b );
  end

  return
end


function [x y] = BipolarCoordinates(Xi,Eta,a)

% a is radii that defies height of the domain
% a > 0

% Check the input arguments and set default values

if nargin == 2
    a = 1. ;
end
r = Xi ;
s = pi*(Eta-1/2) ;

x = (a*sinh(r))/(cosh(r)+cos(s)) ;
y = (a*sin(s))/(cosh(r)+cos(s)) ;


function a_cum = i4vec_cum ( n, a )

%*****************************************************************************80
%
%% I4VEC_CUM computes the cumulative sum of the entries of an I4VEC.
%
%  Discussion:
%
%    An I4VEC is a vector of I4's.
%
%  Example:
%
%    Input:
%
%      A = (/ 1, 2, 3, 4 /)
%
%    Output:
%
%      A_CUM = (/ 1, 3, 6, 10 /)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 December 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of entries in the vector.
%
%    Input, integer A(N), the vector to be summed.
%
%    Output, integer A_CUM(1:N), the cumulative sum of the entries of A.
%
  a_cum(1) = a(1);

  for i = 2 : n
    a_cum(i) = a_cum(i-1) + a(i);
  end

  return
end


function qwv_2d_test02 ( )

%*****************************************************************************80
%
%% QWV_2D_TEST02 tests QWV_2D for Padua points.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 May 2014
%
%  Author:
%
%    John Burkardt
%
  a = -1.0;
  b = +1.0;
  c = -1.0;
  d = +1.0;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'QWV_2D_TEST02:\n' );
  fprintf ( 1, '  Compute the weights associated with an interpolatory\n' );
  fprintf ( 1, '  quadrature rule defined by N=(T+1)*(T+2)/2 points,\n' );
  fprintf ( 1, '  exact for polynomials of total degree T or less.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  X Interval = [%g,%g]\n', a, b );
  fprintf ( 1, '  Y Interval = [%g,%g]\n', c, d );

  for t = 0 : 10

    n = ( ( t + 1 ) * ( t + 2 ) ) / 2;

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Degree T = %d\n', t );
    fprintf ( 1, '  Number of points N = %d\n', n );

    [ x, y ] = padua_point_set ( t );
%
%  Compute the weights.
%
    w = qwv_2d ( t, n, a, b, c, d, x, y );

    r8vec_print_16 ( n, w, '  Weights:' );

  end

  return
end


function [xi,w]=firstOrder3DCubPoints()
%%FIRSTORDER3DCUBPOINTS Generate first-order cubature points
%               for integration over a 3-dimensional cube with vertices of
%               (1,-1,-1), (-1,-1,-1), (-1,1,-1), (1,1,-1), (1,-1,1),
%               (-1,-1,1), (-1,1,1), and (1,1,1).
%
%INPUTS: None
%
%OUTPUTS: xi This is a 3XnumCubPoints set of points for the standard
%            cube.
%          w A 1XnumCubPoints set of cubature weights. This sums to the
%            volume of the standard cube (8).
%
%This function implements the points given in [1] (1 point). This point is
%just the origin with a weight of 8.
%
%REFERENCES:
%[1] F. D. Witherden and P. E. Vincent, "On the identification of symmetric
%    quadrature rules for finite element methods," Computer and Mathematics
%    with Applications, vol. 69, no. 10, pp. 1232-1241, May 2015.
%
%October 2022 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

w=8;
xi=[0;0;0];

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.