function [A,B,h,k,phi]=polyEllipsForm2ScalRotTrans(coeffs)
%%POLYELLIPSFORM2SCALROTTRANS Given a 2D ellipse represented as a quadratic
%   polynomial such that f(x,y)=0 is points on the ellipse, this function
%   obtains the parameterization for a parameteric representation of the
%   points in terms of scale factors (A, and B), a rotation angle (phi) and
%   translation coordinates (h, and k). Thus, if t is a parameteric
%   parameter that runs from 0 to 2*pi, x and y coordinates of points on
%   the ellipse are given by
%   x=A*cos(phi)*cos(t)-B*sin(phi)*sin(t)+h;
%   y=A*sin(phi)*cos(t)+B*cos(phi)*sin(t)+k;
%
%INPUTS: coeffs A 3X3 matrix of the coefficients for the bivariate
%               quadratic polynomial. These are arranged such
%               that coeffs(a1,a2) corresponds to the coefficient
%               of an x1^(a1-1)*x2^(a2-1) term. This is the format used in
%               polyValMultiDim.
%
%OUTPUTS: A, B The scalar positive scale factors.
%         h, k The scalar offsets in the x and y coordinates.
%          phi The scalar rotation angle in radians.
%
%The relations here come from inverting Equation 5 in [1]. Using the
%notation of [1], we note that we can write BB=(1/A2-1/B2)*sin(2*phi)
%and also AA-CC==(1/A^2-1/B^2)*cos(2*phi), so we use an inverse transgent to
%find phi. After that, the other terms are found by substituting and
%solving each of the equations. In the final equation for FF, we repalce
%the 1 with a c that we solve for. That is a scale factor (since one can
%multiply coeffs by any constant without changing the result). Given the
%scale factor, we then replace A with A/sqrt(c) and B with B/sqrt(c) to
%undo the scaling.
%
%EXAMPLE:
%To show that this produces correct results, we plot an ellipse using the
%drawEllipse function, which uses a different parameterization. We then
%convert that parameterization into polynomial coefficients using
%quadEllipsForm2Poly. Those coefficients are then transformed into the
%parameters for the scaled, rotated, and translated parametric form of
%this function. Being in parametric form, we plot the ellipse over the
%other one. One can see that they are the same.
% A=inv([4, -1.5;
%       -1.5,1]);
% x0=[2;3]*10;
% c=2.5;
% %Plot the original ellipse
% figure(1)
% clf
% drawEllipse(x0,A,c,'-k','linewidth',4)
% hold on
% %Convert the ellipse into polynomial form.
% coeffs=quadEllipsForm2Poly(A,x0,c)/1000;
% %Convert the polynomial form into the scaled, rotated, translated form.
% [A,B,h,k,phi]=polyEllipsForm2ScalRotTrans(coeffs);
% %This is a parameteric form, so plot the points on the ellipse:
% numPoints=500;
% t=linspace(0,2*pi,numPoints);
% x=A*cos(phi)*cos(t)-B*sin(phi)*sin(t)+h;
% y=A*sin(phi)*cos(t)+B*cos(phi)*sin(t)+k;
% plot(x,y,'-y','linewidth',1)
% legend('Original Ellipse','Parametric Ellipse')
% xlabel('x')
% ylabel('y')
%
%REFERENCES:
%[1] G. B. Hughes and M. Chraibi, "Calculating ellipse overlap areas,"
%    Computing and Visualization in Science, vol. 15, no. 5, pp. 291-301,
%    Oct. 2012.
%
%January 2023 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

AA=coeffs(3,1);
BB=coeffs(2,2);
CC=coeffs(1,3);
DD=coeffs(2,1);
EE=coeffs(1,2);
FF=coeffs(1,1);

phi=atan2(BB,AA-CC)/2;
sinPhi=sin(phi);
cosPhi=cos(phi);
%Using a double angle identity:
cos2Phi=cosPhi^2-sinPhi^2;

A2=2*cos2Phi/(AA-CC+(AA+CC)*cos2Phi);
B2=2*cos2Phi/(CC-AA+(AA+CC)*cos2Phi);

h=(1/2)*(-A2*DD+(B2-A2)*cosPhi*EE*sinPhi+(A2-B2)*DD*sinPhi^2);
k=(1/2)*(-B2*EE+(B2-A2)*cosPhi*DD*sinPhi-(A2-B2)*EE*sinPhi^2);

c=(h*cosPhi+k*sinPhi)^2/A2+(h*sinPhi-k*cosPhi)^2/B2-FF;

%Adjust the scaling of everything.
A2=A2*c;
B2=B2*c;

A=sqrt(A2);
B=sqrt(B2);

end

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


function y = amexpo1s(N,t0,T);
%AMEXPO1S Generate one-sided exponential amplitude modulation.
%	Y = AMEXPO1S(N,T0,T) generates a one-sided exponential
%	amplitude modulation centered on a time T0, and with a
%	spread proportional to T.
%	This modulation is scaled such that Y(T0)=1.
%
%	N  : number of points.
%	T0 : arrival time of the exponential	(default : N/2).
%	T  : time spreading			(default : 2*sqrt(N)).
%	Y  : signal.
%
%	Examples:
%	 z=amexpo1s(160);plot(z);
%	 z=amexpo1s(160,20,40);plot(z);
%
%	See also AMEXPO2S, AMGAUSS, AMRECT, AMTRIANG.

% 	F. Auger, July 1995.
%	Copyright (c) 1996 by CNRS (France).
%
%  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 should have received a copy of the GNU General Public License
%  along with this program; if not, write to the Free Software
%  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

if (nargin == 0),
 error ( 'The number of parameters must be at least 1.' );
elseif (nargin == 1),
 t0=N/2; T=2*sqrt(N);
elseif (nargin ==2),
 T=2*sqrt(N);
end;

if (N<=0),
 error('N must be greater or equal to 1.');
else
 tmt0=(1:N)'-t0;
 y = exp(-sqrt(pi)*tmt0/T).*(tmt0>=0.0);
end;


% the following program calculates the
% Colebrool-White friction factors at various
% roughess heights for Reynolds numbers
% between 5000 and 500000
% ---------------------------------------------------------------
%  The MATLAB function was created by Tibor Balint, December 1998
% TBoreal Research Corporation, Toronto, Ont. Canada
% (tibor@netcom.ca) and also, University of Warwick, UK
% ---------------------------------------------------------------

clear
Re=linspace(5000,500000,200); % set the Reynolds numbers
Dh=0.008;  % set the hydraulic diameter in meters

rough=0.00000075;  % set the 1st EQUIVALENT ROUGHNESS HEIGHT in m

for i=1:200
   miller(i)=0.25/(log10(rough/(3.7*0.009)+5.74/Re(i)^0.9))^2;
   fcw(i)=ffcw(Re(i), Dh, rough);
end

rough=0.000001;  % EQUIVALENT ROUGHNESS HEIGHT
for i=1:200
%   miller1(i)=0.25/(log10(rough/(3.7*0.009)+5.74/Re(i)^0.9))^2;
   fcw1(i)=ffcw(Re(i), Dh, rough);
end

rough=0.00000125;  % EQUIVALENT ROUGHNESS HEIGHT
for i=1:200
%   miller2(i)=0.25/(log10(rough/(3.7*0.009)+5.74/Re(i)^0.9))^2;
   fcw2(i)=ffcw(Re(i), Dh, rough);
end

rough=0.0000015;  % EQUIVALENT ROUGHNESS HEIGHT
for i=1:200
%   miller3(i)=0.25/(log10(rough/(3.7*0.009)+5.74/Re(i)^0.9))^2;
   fcw3(i)=ffcw(Re(i), Dh, rough);
end

rough=0.00000175;  % EQUIVALENT ROUGHNESS HEIGHT
for i=1:200
%   miller4(i)=0.25/(log10(rough/(3.7*0.009)+5.74/Re(i)^0.9))^2;
   fcw4(i)=ffcw(Re(i), Dh, rough);
end

%plot the figures
figure(1)
orient landscape;
subplot(2,1,1);
plot(Re,fcw,'b',Re,miller,'r--')
legend('f_{cw}','f_{miller}');
grid on;
axis tight;
xlabel('Reynolds number');
ylabel('Friction factor');
title ('Hydraulic Diameter (D_h=8 mm), Eq. Roughness Height (\epsilon = 0.75 \mum)');

subplot(2,1,2);
plot(Re,fcw,'b',Re,fcw1,'r',Re,fcw2,'g',Re,fcw3,'m',Re,fcw4,'k')
legend('\epsilon=0.75 \mum','\epsilon=1.00 \mum','\epsilon=1.25 \mum','\epsilon=1.50 \mum','\epsilon=1.75 \mum');
grid on;
axis tight;
xlabel('Reynolds number');
ylabel('Friction factor');
title ('Colebrook-White Friction Factor (f_{cw})');


function y = tanhminus1(x)
%TANHMINUS1 Hyperbolic tangent minus one.
%
%   TANHMINUS1(X) is TANH(X)-1 calculated in a way that is numerically better
%   when X is large and positive.
%
%   This example illustrates the difference
%
%      x = 17.5:0.01:20.5;
%      plot(x, tanh(x)-1, 'y-', x, tanhminus1(x), 'r-');

%   Author:      Peter J. Acklam
%   Time-stamp:  2003-10-13 15:04:13 +0200
%   E-mail:      pjacklam@online.no
%   URL:         http://home.online.no/~pjacklam

   % check number of input arguments
   error(nargchk(1, 1, nargin));

   y = -2 ./ (1 + exp(2 * x));


function mean = normal_ms_mean ( mu, sigma )

%*****************************************************************************80
%
%% NORMAL_MS_MEAN returns the mean of the Normal PDF.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    17 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real MU, SIGMA, the parameters of the PDF.
%    0.0 < SIGMA.
%
%    Output, real MEAN, the mean of the PDF.
%
  mean = mu;

  return
end


function mean = pareto_mean ( a, b )

%*****************************************************************************80
%
%% PARETO_MEAN returns the mean of the Pareto PDF.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real A, B, the parameters of the PDF.
%    0.0 < A,
%    0.0 < B.
%
%    Output, real MEAN, the mean of the PDF.
%
  if ( b <= 1.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'PARETO_MEAN - Fatal error!\n' );
    fprintf ( 1, '  For B <= 1, the mean does not exist.\n' );
    mean = 0.0;
    return
  end

  mean = b * a / ( b - 1.0 );

  return
end


function x = r8vec_cheby1space ( n, a, b )

%*****************************************************************************80
%
%% R8VEC_CHEBY1SPACE creates a vector of Type 1 Chebyshev spaced values in [A,B].
%
%  Discussion:
%
%    An R8VEC is a vector of R8's.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 August 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of entries in the vector.
%
%    Input, real A, B, the first and last entries.
%
%    Output, real X(N,1), a vector of Chebyshev spaced data.
%
  x = zeros ( n, 1 );

  if ( n == 1 )

    x(1) = ( a + b ) / 2.0;

  else

    for i = 1 : n

      theta = ( 2 * ( n - i ) + 1 ) * pi / ( 2 * n );

      c = cos ( theta );

      if ( mod ( n, 2 ) == 1 )
        if ( 2 * i - 1 == n )
          c = 0.0;
        end
      end

      x(i) = ( ( 1.0 - c ) * a  ...
             + ( 1.0 + c ) * b ) ...
             /   2.0;

    end

  end

  return
end


function f = ecc2flat(e)
%ECC2FLAT   Convert the eccentricity of an ellipsoid to its flattening
%
%  F = ECC2FLAT(E) returns the flattening given the eccentricity.
%
%   See also FLAT2ECC.

  e2 = e.^2;
  f = e2 ./ (1 + sqrt(1 - e2));
end


%MDS_STRESS - Sammon stress between dissimilarity matrices
%
% 	E = MDS_STRESS(Q,DS,D)
%
% INPUT
% 	Q					Indicator of the Sammon stress; Q = -2,-1,0,1,2
% 	DS				Original distance matrix
% 	D 				Approximated distance matrix
%
% OUTPUT
% 	E 				Sammon stress
%
% DESCRIPTION
% Computes the Sammon stress between the original distance matrix Ds
% and the approximated distance matrix D, expressed as follows:
%
%  E = 1/(sum_{i<j} DS_{ij}^(q+2)) sum_{i<j} (DS_{ij} - D_{ij})^2 * DS_{ij}^q
%

%
% Copyright: Elzbieta Pekalska, Robert P.W. Duin, ela@ph.tn.tudelft.nl, 2000-2003
% Faculty of Applied Sciences, Delft University of Technology
%

function [e,alpha] = mds_stress (q,Ds,D,isratio)

	if nargin < 4
		isratio = 0;
	end

	[m,k]   = size(Ds);
	if any(size(D) ~= size(Ds)),
		error ('The sizes of matrices do not match.');
	end
	mk = m*k;

	D  = +D;
	Ds = +Ds;

	% I is  the index of non-zero (> eps) values to be included
	% for the computation of the stress

	I = 1:mk;
	nanindex = find(isnan(Ds(:)) | isnan(D(:)));
	if ~isempty(nanindex),
		I(nanindex) = [];
	end
	O = [];
	if m == k & (length(intersect(find(D(:) < eps), 1:m+1:(mk))) == m),
		O  = 1:m+1:mk;
		Ds(O) = 1;
		D (O) = 1;
    mm = m - 1;
	else
		mm = k;
	end

  if isratio,
    II = setdiff(I,O);
    alpha = sum((Ds(II).^q).*D(II).^2)/sum((Ds(II).^(q+1)).*D(II));
    Ds = alpha*Ds;
	else
		alpha = 1;
	end

	c = sum(Ds(I).^(q+2)) - length(O);
	if q ~= 0,
		e = sum(Ds(I).^q .* ((Ds(I)-D(I)).^2))/c;
	else
		e = sum(((Ds(I)-D(I)).^2))/c;
	end
return;


function v = polynomialCurveDerivative(t, varargin)
%POLYNOMIALCURVEDERIVATIVE Compute derivative vector of a polynomial curve
%
%   VECT = polynomialCurveLength(T, XCOEF, YCOEF);
%   XCOEF and YCOEF are row vectors of coefficients, in the form:
%       [a0 a1 a2 ... an]
%   VECT is a 1x2 array containing direction of derivative of polynomial
%   curve, computed for position T. If T is a vector, VECT has as many rows
%   as the length of T.
%
%   VECT = polynomialCurveLength(T, COEFS);
%   COEFS is either a 2xN matrix (one row for the coefficients of each
%   coordinate), or a cell array.
%
%   Example
%   polynomialCurveDerivative
%
%   See also
%   polynomialCurves2d, polynomialCurveNormal, polynomialCurvePoint,
%   polynomialCurveCurvature
%
%
% ------
% Author: David Legland
% e-mail: david.legland@grignon.inra.fr
% Created: 2007-02-23
% Copyright 2007 INRA - BIA PV Nantes - MIAJ Jouy-en-Josas.

%% Extract input parameters

% polynomial coefficients for each coordinate
var = varargin{1};
if iscell(var)
    xCoef = var{1};
    yCoef = var{2};
elseif size(var, 1)==1
    xCoef = varargin{1};
    yCoef = varargin{2};
else
    xCoef = var(1,:);
    yCoef = var(2,:);
end

%% compute derivative

% compute derivative of the polynomial
dx = polynomialDerivate(xCoef);
dy = polynomialDerivate(yCoef);

% convert to polyval convention
dx = dx(end:-1:1);
dy = dy(end:-1:1);

% numerical integration of the Jacobian of parametrized curve
v = [polyval(dx, t) polyval(dy, t)];


function [J, grad] = linearRegCostFunction(X, y, theta, lambda)
%LINEARREGCOSTFUNCTION Compute cost and gradient for regularized linear
%regression with multiple variables
%   [J, grad] = LINEARREGCOSTFUNCTION(X, y, theta, lambda) computes the
%   cost of using theta as the parameter for linear regression to fit the
%   data points in X and y. Returns the cost in J and the gradient in grad

% Initialize some useful values
m = length(y); % number of training examples

% You need to return the following variables correctly
J = 0;
grad = zeros(size(theta));

% ====================== YOUR CODE HERE ======================
% Instructions: Compute the cost and gradient of regularized linear
%               regression for a particular choice of theta.
%
%               You should set J to the cost and grad to the gradient.
%

h_theta = X*theta;
J = (1/(2*m))*sum((h_theta - y).^2) + (lambda/(2*m))*(theta(2:end)'*theta(2:end));
grad = (1/m)*((h_theta - y)'*X)'
grad = grad + (lambda/m)*[0;theta(2:end,:)]

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

grad = grad(:);

end


%
% lellipe(phi, k, errtol)
%
% Inputs:
%
%   phi     Input angle vector size 1xN.
%   k       Input parameter vector size 1 or 1xN.
%   errtol  Error tolerance for Carlson's algorithms.
%
% Matlab function to compute Legendre's (incomplete) elliptic integral
% E(phi, k).  Uses a vectorized implementation of Carlson's Duplication Algorithms
% for symmetric elliptic integrals as found in "Computing Elliptic
% Integrals by Duplication," by B. C. Carlson, Numer. Math. 33, 1-16 (1979)
% and also found in ACM TOMS Algorithm 577.  Section 4 in the paper cited
% here describes how to convert between the symmetric elliptic integrals
% and Legendre's elliptic integrals.
%
% Returns NaN's for any argument values outside input range.
%

function f = lellipe(phi, k, errtol)

% Argument checking for vectorization:
lphi = length(phi);
lk = length(k);
errflag = logical(0);
if (lphi ~= lk)
    if (lphi==1)
        phivec = phi * ones(1,lk);
        kvec = k;
    elseif (lk==1)
        kvec = k * ones(1,lphi);
        phivec = phi;
    else
        disp('Incompatible input vector dimensions in lellipf!');
        errflag = logical(1);
    end
else
    phivec = phi;
    kvec = k;
end

if (~errflag)
    snphi = sin(phivec);
    csphi = cos(phivec);
    snphi2 = snphi.^2;
    csphi2 = csphi.^2;
    k2 = kvec.^2;
    y = 1.0 - k2.*snphi2;
    onesvec = ones(1,length(phivec));
    f = snphi .* rf(csphi2,  y, onesvec, errtol) - ...
        k2 .* snphi .* snphi2 .* rd(csphi2, y, onesvec, errtol)/3.0;
else
    f = NaN;
end


function [AF, u, v, w] = arrayFactor(xPos, yPos, zPos, elementWeights, f, c, thetaScanAngles, phiScanAngles, thetaSteerAngle, phiSteerAngle)
%arrayFactor - Calculate array factor of 1D, 2D or 3D array
%
%This matlab function calculates the array factor of a 1D, 2D or 3D array based
%on the position of the elements/sensors and the weight associated with
%each sensor. If no angle is given as input, the scanning angle is theta
%from -90 to 90, and phi from 0 to 360 degrees with 1 degree resolution
%
%[AF, u, v, w] = arrayFactor(xPos, yPos, zPos, elementWeights, f, c, thetaScanAngles, phiScanAngles, thetaSteerAngle, phiSteerAngle)
%
%IN
%xPos            - 1xP vector of x-positions
%yPos            - 1xP vector of y-positions
%zPos            - 1xP vector of z-positions
%elementWeights  - 1xP vector of element weights
%f               - Wave frequency
%c               - Speed of sound
%thetaScanAngles - 1xM vector or MxN matrix of theta scanning angles in degrees (optional)
%phiScanAngles   - 1XN vector or MxN matrix of phi scanning angles in degrees (optional)
%thetaSteerAngle - Theta steering angle in degrees (optional)
%phiSteerAngle   - Phi steering angle in degrees (optional)
%
%OUT
%AF              - Calculated array factor
%u               - MxN matrix of u coordinates in UV space [sin(theta)*cos(phi)]
%v               - MxN matrix of v coordinates in UV space [sin(theta)*sin(phi)]
%w               - MxN matrix of w coordinates in UV space [cos(theta)]
%
%
%Created by J?rgen Grythe
%Last updated 2017-02-27

if ~isvector(xPos)
    error('X-positions of array elements must be a 1xP vector where P is number of elements')
end

if ~isvector(yPos)
    error('Y-positions of array elements must be a 1xP vector where P is number of elements')
end

if ~isvector(elementWeights)
    error('Weighting of array elements must be a 1xP vector where P is number of elements')
end

if ~isscalar(f)
    error('The input frequency must be a single value')
end

%theta is the elevation and is the normal incidence angle from -90 to 90
if ~exist('thetaScanAngles', 'var')
    thetaScanAngles = -pi/2:pi/180:pi/2;
else
    thetaScanAngles = thetaScanAngles*pi/180;
end

%phi is the azimuth, and is the angle in the XY-plane from 0 to 360
if ~exist('phiScanAngles', 'var')
    phiScanAngles = 0:pi/180:2*pi;
else
    phiScanAngles = phiScanAngles*pi/180;
end

%theta, phi steering angles
if ~exist('thetaSteerAngle', 'var')
    thetaSteerAngle = 0;
else
    thetaSteerAngle = thetaSteerAngle*pi/180;
end

if ~exist('phiSteerAngle', 'var')
    phiSteerAngle = 0;
else
    phiSteerAngle = phiSteerAngle*pi/180;
end

%Wavenumber
k = 2*pi*f/c;

%Number of elements/sensors in the array
P = length(xPos);

%Calculating wave vector in spherical coordinates
if isvector(thetaScanAngles)

    %Size of vectors containing theta and phi angles
    M = length(thetaScanAngles);
    N = length(phiScanAngles);

    %Calculate UV coordinates
    u = sin(thetaScanAngles)'*cos(phiScanAngles);
    v = sin(thetaScanAngles)'*sin(phiScanAngles);
    w = repmat(cos(thetaScanAngles)', 1, N);

    % Apply steering
    us = u - sin(thetaSteerAngle)*cos(phiSteerAngle);
    vs = v - sin(thetaSteerAngle)*sin(phiSteerAngle);
    ws = w - cos(thetaSteerAngle);
else

    %Size of matrix containing theta and phi angles
    [M, N] = size(thetaScanAngles);

    %Calculate UV coordinates
    u = sin(thetaScanAngles).*cos(phiScanAngles);
    v = sin(thetaScanAngles).*sin(phiScanAngles);
    w = cos(thetaScanAngles);

    % Apply steering
    us = u - sin(thetaSteerAngle).*cos(phiSteerAngle);
    vs = v - sin(thetaSteerAngle).*sin(phiSteerAngle);
    ws = w - cos(thetaSteerAngle);
end

%Calculate array factor
uu = bsxfun(@times, us, reshape(xPos, 1, 1, P));
vv = bsxfun(@times, vs, reshape(yPos, 1, 1, P));
ww = bsxfun(@times, ws, reshape(zPos, 1, 1, P));

g = repmat(reshape(elementWeights, 1, 1, P), M, N);

AF = sum(g.*exp(1j*k*(uu + vv + ww)), 3);

%Normalising
AF = abs(AF)./max(max(abs(AF)));

%
%                 N
%AF(theta, phi) = sum [ g_n * exp{jk(u*x_n + v*y_n + w*z_n)} ]
%                n=1
%
%u =
%|sin(theta_0)*cos(phi_0) sin(theta_0)*cos(phi_1) .. sin(theta_0)*cos(phi_N)|
%|sin(theta_1)*cos(phi_0) sin(theta_1)*cos(phi_1) .. sin(theta_1)*cos(phi_N)|
%|    .                           .                         .               |
%|sin(theta_M)*cos(phi_0) sin(theta_M)*cos(phi_1) .. sin(theta_M)*cos(phi_N)|

%v =
%|sin(theta_0)*sin(phi_0) sin(theta_0)*sin(phi_1) .. sin(theta_0)*sin(phi_N)|
%|sin(theta_1)*sin(phi_0) sin(theta_1)*sin(phi_1) .. sin(theta_1)*sin(phi_N)|
%|    .                           .                         .               |
%|sin(theta_M)*sin(phi_0) sin(theta_M)*sin(phi_1) .. sin(theta_M)*sin(phi_N)|

%w =
%|cos(theta_0) cos(theta_0) .. cos(theta_0)|
%|cos(theta_1) cos(theta_1) .. cos(theta_1)|
%|    .            .                .      |
%|cos(theta_N) cos(theta_N) .. cos(theta_N)|

%uu =
%   --------
%  /       /|
% / xPos  / |
%---------  | M (length theta)
%|       |  |
%|   u   |  /
%|       | / P (# elements)
%---------/
%   N (length phi)

%g =
%   --------
%  / g_P   /|
% /       / |
%---------  | M
%|g1   g1|  |
%|   g1  |  /
%|g1   g1| / P (# elements)
%---------/
%   N


function x=choosenk(n,k)
%CHOOSENK All choices of K elements taken from 1:N [X]=(N,K)
% The output X is a matrix of size (N!/(K!*(N-K)!),K) where each row
% contains a choice of K elements taken from 1:N without duplications.
% The rows of X are in lexically sorted order.
%
% To choose from the elements of an arbitrary vector V use
% V(CHOOSENK(LENGTH(V),K)).

% CHOOSENK(N,K) is the same as the MATLAB5 function NCHOOSEK(1:N,K) but is
% much faster for large N and most values of K.

%   Copyright (c) 1998 Mike Brookes,  mike.brookes@ic.ac.uk
%      Version: $Id: choosenk.m,v 1.4 2007/05/04 07:01:38 dmb Exp $
%
%   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.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

kk=min(k,n-k);
if kk<2
   if kk<1
      if k==n
         x=1:n;
      else
         x=[];
      end
   else
      if k==1
         x=(1:n)';
      else
         x=1:n;
         x=reshape(x(ones(n-1,1),:),n,n-1);
      end
   end
else
   n1=n+1;
   m=prod(n1-kk:n)/prod(1:kk);
   x=zeros(m,k);
   f=n1-k;
   x(1:f,k)=(k:n)';
   for a=k-1:-1:1
      d=f;
      h=f;
      x(1:f,a)=a;
      for b=a+1:a+n-k
         d=d*(n1+a-b-k)/(n1-b);
         e=f+1;
         f=e+d-1;
         x(e:f,a)=b;
         x(e:f,a+1:k)=x(h-d+1:h,a+1:k);
      end
   end
end


function [c,delta,cash] = BlackScholesCall(spot,K,r,vol,T)
% Black-Scholes price of a European call
% Inputs:
%   spot = spot price of underlying
%   K = strike of the call optioon
%   r = risk free rate as a fraction
%   vol = volatility of the underlying as a fraction
%   T = time to maturity in years
% Outputs:
%   c = price of European call(s)
%   delta = delta of the call(s)
%   cash = cash held in a replicating portfolio
%
d1 = (log(spot./K) + (r + vol.*vol/2).*T)./(vol.*sqrt(T));
d2 = d1 - vol.*sqrt(T);
delta = normcdf(d1);
cash =  -K.*exp(-r.*T).*normcdf(d2);
c = spot.*delta + cash;


function M = nfchoa_order(nls,conf)
%NFCHOA_ORDER maximum order of spatial band-limited NFC-HOA
%
%   Usage: M = nfchoa_order(nls,conf)
%
%   Input parameters:
%       nls     - number of secondary sources
%
%   Output parameters:
%       M       - spherical harmonics order
%       conf    - configuration struct (see SFS_config)
%
%   NFCHOA_ORDER(nls,conf) returns the maximum order of spherical harmonics for
%   the given number of secondary sources in order to avoid spectral repetitions
%   (spatial aliasing) of the dirving signals. The order is
%
%        / nls/2 - 1,   even nls
%   M = <
%        \ (nls-1)/2    odd nls
%
%   for a circular array and
%         _____
%   M = \|nls/2
%
%   for a spherical array.
%
%   See also: driving_function_imp_nfchoa, driving_function_mono_nfchoa
%
%   References:
%       Ahrens (2012) - "Analytic Methods of Sound Field Synthesis", Springer,
%       ISBN 978-3-642-25743-8

%*****************************************************************************
% The MIT License (MIT)                                                      *
%                                                                            *
% Copyright (c) 2010-2019 SFS Toolbox Developers                             *
%                                                                            *
% Permission is hereby granted,  free of charge,  to any person  obtaining a *
% copy of this software and associated documentation files (the "Software"), *
% to deal in the Software without  restriction, including without limitation *
% the rights  to use, copy, modify, merge,  publish, distribute, sublicense, *
% and/or  sell copies of  the Software,  and to permit  persons to whom  the *
% Software is furnished to do so, subject to the following conditions:       *
%                                                                            *
% The above copyright notice and this permission notice shall be included in *
% all copies or substantial portions of the Software.                        *
%                                                                            *
% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *
% IMPLIED, INCLUDING BUT  NOT LIMITED TO THE  WARRANTIES OF MERCHANTABILITY, *
% FITNESS  FOR A PARTICULAR  PURPOSE AND  NONINFRINGEMENT. IN NO EVENT SHALL *
% THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
% LIABILITY, WHETHER  IN AN  ACTION OF CONTRACT, TORT  OR OTHERWISE, ARISING *
% FROM,  OUT OF  OR IN  CONNECTION  WITH THE  SOFTWARE OR  THE USE  OR OTHER *
% DEALINGS IN THE SOFTWARE.                                                  *
%                                                                            *
% The SFS Toolbox  allows to simulate and  investigate sound field synthesis *
% methods like wave field synthesis or higher order ambisonics.              *
%                                                                            *
% https://sfs.readthedocs.io                            sfstoolbox@gmail.com *
%*****************************************************************************

%% ===== Checking input parameters =======================================
nargmin = 2;
nargmax = 2;
narginchk(nargmin,nargmax);
isargpositivescalar(nls);
isargstruct(conf);

%% ===== Configuration ===================================================
if conf.nfchoa.order
    M = conf.nfchoa.order;
    return;
end
dimension = conf.dimension;

%% ===== Computation =====================================================
% Get maximum order of spherical harmonics to avoid spatial aliasing
if strcmp('2D',dimension) || strcmp('2.5D',dimension)
    % Ahrens (2012), p. 132
    if isodd(nls)
        M = (nls-1)/2;
    else
        M = nls/2 - 1;
    end
elseif strcmp('3D',dimension)
    % Ahrens (2012), p. 125
    M = floor(sqrt(nls/2));
end


%  Generating a Givens' (2x2) matrix T such that
%            T*v = [d; 0]
%
%   Input:  v -- a vector of dimension 2
%
%  Output:  T -- Givens' matrix
%           d -- the 2-norm of v
%
%  syntax  >> [T,d] = GivensMatrix(v)


function uI = faceinterpolate3(u,node,elem,quadOrder)
%% FACEINTERPOLATE3 interpolate to face elements RT0.
%
% uI = faceinterpolate3(u,node,face) interpolates a given function u
% into the lowest order RT0. The coefficient is given by the face integral
% int_f u*n ds.
%
% uI = faceinterpolate3(u,node,elem) when |face| is not given, the function
% will generate the face by |[elem2face,face] = dof3face(elem)| and the
% ascend order is used |elem = sortelem3(elem)|.
%
% uI = faceinterpolate3(u,node,face,6) the last input is the quadrature
% order; see quadpts.
%
% Example
%
%   [node,elem] = cubemesh([-1,1,-1,1,-1,1],1);
%   maxIt = 3;
%   pde = mixBCdata3;
%   err = zeros(maxIt,1);
%   h = zeros(maxIt,1);
%   for i = 1:maxIt
%      [node,elem] = uniformrefine3(node,elem);
%      [elem2face,face] = dof3face(elem);
%      uI = faceinterpolate3(pde.Du,node,face);
%      err(i) = getL2error3RT0(node,elem,pde.Du,uI);
%      h(i) = 2^(-i);
%   end
%   figure;
%   showrateh(h,err,2,'-+','|| u - u_I ||');
%
% See also edgeinterpolate, edgeinterpolate1, edgeinterpolate2
%
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

% if ~exist('elemType','var'), elemType = 'RT0'; end

%% Construct Data Structure
if size(elem,2) == 3 % the input elem is face
    face = elem;
else
    elem = sortelem3(elem);
    [~,face] = dof3face(elem);
end

%% normal vector of each face
NF = size(face,1);
v12 = node(face(:,2),:) - node(face(:,1),:);
v13 = node(face(:,3),:) - node(face(:,1),:);
nVec = mycross(v12,v13); % |nVec| = 2*area;

%% assemble the right hand side
if ~exist('quadOrder','var'), quadOrder = 3; end
[lambda,weight] = quadpts(quadOrder);
nQuad = size(lambda,1);
uI = zeros(NF,1);
for p = 1:nQuad
    pxyz = lambda(p,1)*node(face(:,1),:) ...
		 + lambda(p,2)*node(face(:,2),:) ...
		 + lambda(p,3)*node(face(:,3),:);
    flux = u(pxyz);
    uI = uI + weight(p)*dot(flux,nVec,2)/2;
end
% if strcmp(elemType,'BDM1')
% end


%% Harmonic Representation of Rotational Functions
%

%%
% Similarly as periodic functions may be represented as weighted sums of
% sines and cosines a rotational function $f\colon \mathcal{SO}(3)\to\mathbb C$
% can be written as a series of the form
%
% $$ f({\bf R}) = \sum_{n=0}^N \sum_{k,l = -n}^n \hat f_n^{k,l} \, \mathrm{D}_n^{k,l}({\bf R}) $$
%
% with respect to Fourier coefficients $\hat f_n^{k,l}$ and the so called
% <WignerFunctions.html Wigner-D functions> $D_n^{k,l}$.
%
% There exists various normalizations for the <WignerFunctions.html Wigner-D functions>.
% In MTEX they are $L_2$ normalized, which means
%
% $$\| D_n^{k,l} \|_2 = 1$$
%
% for all $n,k,l$. For more information take a look on
% <WignerFunctions.html Wigner-D functions> and
% <SO3FunOperations.html#6 Integration of SO3Fun's>.
%
%%
%
% We construct an arbitrary ODF which generally is an SO3Fun:
mtexdata dubna
odf = calcODF(pf,'resolution',5*degree,'zero_Range')
%%
% Now we may transform an arbitrary SO3Fun into its Fourier representation
% using the command <SO3FunHarmonic.SO3FunHarmonic.html SO3FunHarmonic>

f = SO3FunHarmonic(odf,'bandwidth',32)

%% Fourier Coefficients
%
% Within the class |@SO3FunHarmonic| rotational functions are represented by
% their complex valued Fourier coefficients which are stored in the field
% |fun.fhat|.
% They are stored in a linear order, which means |f.fhat(1)| is the
% zero order Fourier coefficient, |f.fhat(2:10)| are the first order
% Fourier coefficients that form a 3x3 matrix and so on.
% Accordingly, we can extract the second order Fourier coefficients by

reshape(f.fhat(11:35),5,5)

%%
% As an additional example lets define a harmonic function by its Fourier
% coefficients $\hat f_0^{0,0} = 0.5$ and
% $\hat f_1 = \begin{array}{rrr}
% 1 & 4 & 7 \\
% 2 & 5 & 8 \\
% 3 & 6 & 9 \\
% \end{array}$

f2 = SO3FunHarmonic([0.5,1:9]')

plot(f2)
%%
% The Fourier coefficients $\hat f_n^{k,l}$ allow us a complete
% characterization of the rotational function. They are of particular
% importance for the calculation of mean macroscopic properties e.g.
% the second order Fourier coefficients characterize thermal expansion,
% optical refraction index, and electrical conductivity whereas the
% fourth order Fourier coefficients characterize the elastic properties
% of the specimen.
%
% Moreover, the decay of the Fourier coefficients is directly related to
% the smoothness of the SO3Fun. The decay of the Fourier coefficients might
% also hint for the presents of a ghost effect. See
% <PoleFigure2ODFGhostCorrection.html Ghost Correction>.

%%
% The decay of the Fourier coefficients is shown in the plot
close all;
plotSpektra(f)

%% ODFs given by Fourier coefficients
%
% In order to define an ODF by it *Fourier coefficients* ${\bf \hat{f}}$,
% they has to be given as a literally ordered, complex valued
% vector of the form
%
% $$ {\bf \hat{f}} = [\hat{f}_0^{0,0},\hat{f}_1^{-1,-1},\ldots,\hat{f}_1^{1,1},\hat{f}_2^{-2,-2},\ldots,\hat{f}_N^{N,N}] $$
%
% where $n=0,\ldots,N$ denotes the order of the Fourier coefficients.

cs   = crystalSymmetry('1');    % crystal symmetry
fhat = [1;reshape(eye(3),[],1);reshape(eye(5),[],1)]; % Fourier coefficients
odf = SO3FunHarmonic(fhat,cs)

plot(odf,'sections',6,'silent','sigma')

%%

plotPDF(odf,[Miller(1,0,0,cs),Miller(1,1,0,cs)],'antipodal')

%% TODO: Add some non ODF example for an SO3Fun
%
%


function mbasis = basis_matrix_hermite ( )

%*****************************************************************************80
%
%% BASIS_MATRIX_HERMITE sets up the Hermite spline basis matrix.
%
%  Discussion:
%
%    This basis matrix assumes that the data points are stored as
%    ( P1, P2, P1', P2' ), with P1 and P1' being the data value and
%    the derivative dP/dT at T = 0, while P2 and P2' apply at T = 1.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    13 February 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Foley, van Dam, Feiner, Hughes,
%    Computer Graphics: Principles and Practice,
%    page 484.
%
%  Parameters:
%
%    Output, real MBASIS(4,4), the basis matrix.
%
  mbasis(1,1) =  2.0;
  mbasis(1,2) = -2.0;
  mbasis(1,3) =  1.0;
  mbasis(1,4) =  1.0;

  mbasis(2,1) = -3.0;
  mbasis(2,2) =  3.0;
  mbasis(2,3) = -2.0;
  mbasis(2,4) = -1.0;

  mbasis(3,1) =  0.0;
  mbasis(3,2) =  0.0;
  mbasis(3,3) =  1.0;
  mbasis(3,4) =  0.0;

  mbasis(4,1) =  1.0;
  mbasis(4,2) =  0.0;
  mbasis(4,3) =  0.0;
  mbasis(4,4) =  0.0;

  return
end


function x = L4Pinv(cf,y)
%L4PINV The inverse of the 4 parameters logistic equation.
% The Four Parameters Logistic Regression or 4PL nonlinear regression model
% is commonly used for curve-fitting analysis in bioassays or immunoassays
% such as ELISAs or dose-response curves.
%
% Syntax: x=L4Pinv(cf,y)
%
% Inputs:
%           cf is the object containing the 4 parameters of logistic
%           equation computed by L4P function. Alternatively, it can be a
%           1x4 array.
%
%           y is the array of the response that you want to iterpolate.
%
% Outputs:
%           x is the vector of interpolated data.
%
% Example:
%
% xs=[0 4.5 10.6 19.7 40 84 210]; ys=[0.0089 0.0419 0.0873 0.2599 0.7074 1.528 2.7739];
%
% Calling on MatLab the function: [cf G]=L4P(x,y);
%
% you will find the 5 parameters of this curve.
%
% Calling on MatLab the function L4Pinv(cf,1.782315);
%
%           Answer is:
% ans =
%
%  99.9982
%
% Alternatively, you can do:
%
% P=[0.0010 1.5153 108.0035 3.7841]; L4Pinv(P,1.782315);
%
% with the same result.
%
%           Created by Giuseppe Cardillo
%           giuseppe.cardillo-edta@poste.it
%
% See also L4P, L5P, L5Pinv, L3P, L3Pinv
%
% To cite this file, this would be an appropriate format:
% Cardillo G. (2012) Four parameters logistic regression - There and back again
%

%--------------------Input errors handling section-------------------------
if nargin < 2
    error('Almost two inputs are required')
end
if isobject(cf)
    p=coeffvalues(cf);
else
    p=cf;
    if ~isvector(p) || length(p)~=4 || ~all(isfinite(p))
        error('cf must be a fit object or a 1x4 vector of real and finite numbers')
    end
end

%-------------------------Interpolate--------------------------------------
x=NaN(size(y)); ok=isfinite(y);
x(ok)=p(3).*(((p(1)-p(4))./(y(ok)-p(4)))-1).^(1/p(2));


%% check Clebsch Gordan Tensor

%% the reference

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

% the rotation matrix
R = matrix(g);

% we want to express the product of two of those rotation matrice

RR_ref = R(:) * R(:).'

%% Express R by D

D1 = WignerD(g,'order',1);
D = D1(:) * D1(:).';

EinsteinSum(U,[1 -1],D1,[-1 -2],conj(U),[2 -2])

%% expansion into Wigner functions of lower order

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

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

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

C = EinsteinSum(C0 + C1 + C2,[-1 -2 -3 -4],U,[1 -1],conj(U),[2 -2],U,[3 -3],conj(U),[4 -4]);
real(reshape(matrix(C),[9 9]))

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

%%

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

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

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

C = C0 + C1 + C2;
TT_ref ./ real(reshape(matrix(C),[9 9]))

assert(norm(TT_ref - reshape(matrix(C),[9,9]))<=1e-10,'Clebsch Gordan check failed')


function b = r85_vxm ( n, a, x )

%*****************************************************************************80
%
%% R85_VXM multiplies a vector by a R85 matrix.
%
%  Discussion:
%
%    The R85 storage format represents a pentadiagonal matrix as a 5
%    by N array, in which each row corresponds to a diagonal, and
%    column locations are preserved.  Thus, the original matrix is
%    "collapsed" vertically into the array.
%
%  Example:
%
%    Here is how a R85 matrix of order 6 would be stored:
%
%       *   *  A13 A24 A35 A46
%       *  A12 A23 A34 A45 A56
%      A11 A22 A33 A44 A55 A66
%      A21 A32 A43 A54 A65  *
%      A31 A42 A53 A64  *   *
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    03 February 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the linear system.
%
%    Input, real A(5,N), the R85 matrix.
%
%    Input, real X(N), the vector to be multiplied by A'.
%
%    Output, real B(N), the product A' * x.
%
  b(1:n)   =            a(3,1:n)   * x(1:n);
  b(2:n)   = b(2:n)   + a(4,1:n-1) * x(1:n-1);
  b(3:n)   = b(3:n)   + a(5,1:n-2) * x(1:n-2);
  b(1:n-1) = b(1:n-1) + a(2,2:n)   * x(2:n);
  b(1:n-2) = b(1:n-2) + a(1,3:n)   * x(3:n);

  return
end


function [ x, w ] = ccfi_1 ( n, ell )

%*****************************************************************************80
%
%% CCFI_1 returns a Boyd quadrature rule for the Laguerre integral.
%
%  Discussion:
%
%    The Laguerre integral I(f) is:
%      I(f) = integral ( 0 <= x < +oo ) f(x) dx
%    and the quadrature rule which approximates I(f) is
%      Q(f) = sum ( 1 <= i <= n ) w(i) * f(x(i))
%
%    The parameter ELL controls the mapping between [-1,+1] and [0,+oo),
%    and can be initially chosen to be 1.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 May 2014
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    John Boyd,
%    Exponentially convergent Fourier-Chebyshev quadrature schemes on
%    bounded and infinite intervals,
%    Journal of Scientific Computing,
%    Volume 2, Number 2, 1987, pages 99-109.
%
%  Parameters:
%
%    Input, integer N, the number of points to use in the rule.
%
%    Input, real ELL, the mapping parameter.
%
%    Output, real X(N), W(N), the points and weights for the quadrature rule.
%
  t = ( pi * ( 1 : n ) / ( n + 1 ) )';
  x = ell * ( cot ( 0.5 * t ) ) .^ 2;

  w = zeros ( n, 1 );
  for i = 1 : n
    for j = 1 : n
      w(i) = w(i) + sin ( j * t(i) ) * ( 1.0 - cos ( j * pi ) ) / j;
    end
  end
  w = w * 2.0 * ell .* sin ( t ) ./ ( 1.0 - cos ( t ) ) .^ 2 * 2.0 / ( n + 1 );

  return
end


function a = hilbert_inverse ( n )

%*****************************************************************************80
%
%% HILBERT_INVERSE returns the inverse of the Hilbert matrix.
%
%  Formula:
%
%    A(I,J) =  (-1)**(I+J) * (N+I-1)! * (N+J-1)! /
%           [ (I+J-1) * ((I-1)!*(J-1)!)**2 * (N-I)! * (N-J)! ]
%
%  Example:
%
%    N = 5
%
%       25    -300     1050    -1400     630
%     -300    4800   -18900    26880  -12600
%     1050  -18900    79380  -117600   56700
%    -1400   26880  -117600   179200  -88200
%      630  -12600    56700   -88200   44100
%
%  Properties:
%
%    A is symmetric.
%
%    Because A is symmetric, it is normal, so diagonalizable.
%
%    A is almost impossible to compute accurately by general routines
%    that compute the inverse.
%
%    A is integral.
%
%    The sum of the entries of A is N**2.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 March 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of A.
%
%    Output, real A(N,N), the inverse Hilbert matrix.
%

%
%  Set the (1,1) entry.
%
  a(1,1) = n * n;
%
%  Define Row 1, Column J by recursion on Row 1 Column J-1
%
  i = 1;
  for j = 2 : n
    a(i,j) = -a(i,j-1) * ( ( n + j - 1 ) * ( i + j - 2 ) * ...
      ( n + 1 - j ) ) /( ( i + j - 1 ) * ( j - 1 ) * ( j - 1 ) );
  end
%
%  Define Row I by recursion on row I-1
%
  for i = 2 : n
    for j = 1 : n

      a(i,j) = -a(i-1,j) * ( ( n + i - 1 ) * ( i + j - 2 ) * ( n + 1 - i ) ) ...
        / ( (i+j-1) * ( i - 1 ) * ( i - 1 ) );

    end
  end

  return
end


function cpv_test01 ( )

%*****************************************************************************80
%
%% CPV_TEST01 seeks the CPV of Integral ( -1 <= t <= 1 ) exp(t) / t dt
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    31 March 2015
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'CPV_TEST01:\n' );
  fprintf ( 1, '  CPV of Integral ( -1 <= t <= 1 ) exp(t) / t dt\n' );

  fprintf ( 1, '\n' );
  fprintf ( 1, '   N           Estimate             Error\n' );
  fprintf ( 1, '\n' );
  exact = 2.11450175075;
  a = -1.0;
  b = +1.0;
  for n = 2 : 2 : 8
    value = cpv ( @f01, a, b, n );
    fprintf ( 1, '  %2d  %24.16g  %14.6g\n', n, value, abs ( value - exact ) );
  end

  return
end
function value = f01 ( t )

%*****************************************************************************80
%
%% F01 evaluates the integrand of Integral ( -1 <= t <= 1 ) exp(t) / t dt
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 March 2015
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real T, the argument.
%
%    Output, real VALUE, the value of the integrand.
%
  value = exp ( t );

  return
end


function C = augment(A, alpha)
%AUGMENT  Augmented system matrix.
%         AUGMENT(A, ALPHA) is the square matrix
%         [ALPHA*EYE(m) A; A' ZEROS(n)] of dimension m+n, where A is m-by-n.
%         It is the symmetric and indefinite coefficient matrix of the
%         augmented system associated with a least squares problem
%         minimize NORM(A*x-b).  ALPHA defaults to 1.
%         Special case: if A is a scalar, n say, then AUGMENT(A) is the
%                       same as AUGMENT(RANDN(p,q)) where n = p+q and
%                       p = ROUND(n/2), that is, a random augmented matrix
%                       of dimension n is produced.
%         The eigenvalues of AUGMENT(A,ALPHA) are given in terms of the
%         singular values s(i) of A (where m>n) by
%           ALPHA/2 +/- SQRT( s(i)^2*ALPHA^2 + 1/4 ),  i=1:n  (2n eigenvalues),
%           ALPHA,  (m-n eigenvalues).
%         If m < n then the first expression provides 2m eigenvalues and the
%         remaining n-m eigenvalues are zero.
%
%         See also SPAUGMENT.

%         References:
%         G. H. Golub and C. F. Van Loan, Matrix Computations, third
%            Edition, Johns Hopkins University Press, Baltimore, Maryland,
%            1996; sec. 5.6.4.
%         N. J. Higham, Accuracy and Stability of Numerical Algorithms,
%            Second edition, Society for Industrial and Applied Mathematics,
%            Philadelphia, PA, 2002; sec. 20.5.

[m, n] = size(A);
if nargin < 2, alpha = 1; end

if max(m,n) == 1
   n = A;
   p = round(n/2);
   q = n - p;
   A = randn(p,q);
   m = p; n = q;
end

C = [alpha*eye(m) A; A' zeros(n)];


function g=TaylorLinearTapering(nBar,sidelobedB,xPoints,a)
%%TAYLORLINEARTAPERING The Taylor tapering is a set of amplitude weights
%          for a continuous linear (narrowband) aperture antenna that will
%          reduce the height of nBar of the close-in sidelobes at a cost of
%          widening the beam. Such a tapering can be discretized and
%          applied to the elements in a linear phased array (An array of
%          antenna elements can be viewed as a discrete approximation to a
%          continuous aperture). This function will provide the tapering
%          values at a set of discrete points given by xPoints (the origin
%          is taken to be the center of the aperture). The radius of the
%          aperture can either be provided or is taken as value of the
%          farthest point provided.
%
%INPUTS: nBar The number of terms to use in the expansion. High values can
%             produce undesirable results.
%  sidelobedB The number of decibels of the ratio of the close-in sidelobe
%             voltages to the main lobe voltage. This must be a negative
%             number. A typical value is -30.
%    xyPoints An NX1 or 1XN set of N points at which the tapering values
%             should be evaluated. The center of the aperture is taken to
%             be the origin.
%           a The radius of the aperture. Tapering weights for points in
%             xPoints outside of the aperture are taken to be zero. If
%             this parameter is omitted or an empty matrix is passed, then
%             the radius is taken to be the distance of the farthest point
%             from the origin in xPoints.
%
%OUTPUTS: g The NX1 set of discretized Taylor tapering values evaluated at
%           the points given in xPoints. All Taylor tapering values are
%           positive and real. The coefficients are not normalized.
%
%This function implements the algorithm in [1].
%
%EXAMPLE 1:
%Here, we evaluate the tapering values for 30dB down on a large array of
%points to see what the tapering looks like.
% nBar=4;
% sidelobedB=-30;
% numPoints=100;
% %Generate points symmetric about the origin. This makes the aperture size
% %1.
% k=0:(numPoints-1);
% xPoints=(k-(1/2)*numPoints+1/2)/numPoints;
% g=TaylorLinearTapering(nBar,sidelobedB,xPoints);
%
% figure(1)
% clf
% plot(xPoints,g)
% h1=xlabel('x');
% h2=ylabel('y');
% title('Taylor Tapering Weight')
% set(gca,'FontSize',14,'FontWeight','bold','FontName','Times')
% set(h1,'FontSize',14,'FontWeight','bold','FontName','Times')
% set(h2,'FontSize',14,'FontWeight','bold','FontName','Times')
%
%EXAMPLE 2:
%Here, we consider the array response when using tapering values for 30dB
%sidelobes on a linear array with lambda/2 spacing between elements.
% nBar=4;
% sidelobedB=-30;
% numPoints=30;
% %Generate points symmetric about the origin.
% k=0:(numPoints-1);
% xPoints=(k-(1/2)*numPoints+1/2)/2;
% g=TaylorLinearTapering(nBar,sidelobedB,xPoints);
%
% %Tapering matrix
% T=diag(g);
%
% %Now, display the response with the tapering
% [Rsp,U]=standardUVBeamPattern(T,xPoints,'NormPowGain');
%
% figure(2)
% clf
% plot(U,10*log10(Rsp),'-b','LineWidth',2);
% axis([-1, 1, -40 1])
% h1=xlabel('u');
% h2=ylabel('Amplitude Response (decibels)');
% title('Taylor Weighted Array Response')
% set(gca,'FontSize',14,'FontWeight','bold','FontName','Times')
% set(h1,'FontSize',14,'FontWeight','bold','FontName','Times')
% set(h2,'FontSize',14,'FontWeight','bold','FontName','Times')
%
%REFERENCES:
%[1] T. T. Taylor, "Design of line-source antennas for narrow beamwidth and
%    low side lobes," IRE Transactions on Antennas and Propagation, vol. 3,
%    no. 1, pp. 16-28, Jan. 1955.
%
%August 2016 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

%After Equation 35 in [1], it is noted that cosh(pi*A) is the side-lobe
%ratio. Thus, we get the following expression for A in terms of the
%sidelobe level in decibels:
eta=10^(sidelobedB/(-20));
A=acosh(eta)/pi;

%The square of Sigma in Equation 41 in [1].
sigma2=nBar^2/(A^2+(nBar-1/2)^2);

%The suggestion for C after Equation 48 in [1].
C=cosh(pi*A);

%Fm holds values of F in Equation 48 for z being an integer>=1.
Fm=zeros(nBar-1,1);
for m=1:(nBar-1)
%Equation 48 contains singularities when z=m is an integer. To evaluate it
%when z is an integer, we first simplify Q in Equation 47 to eliminate the
%singularity.

    %Equation 47 in [1], taking the limit of z to an integer to eliminate
    %the singularity.
    np=[1:(m-1),(m+1):(nBar-1)];
    Qm=(-1)^(m+1)/(2*prod(1-(m./np).^2));

    n=1:(nBar-1);
    Fm(m)=C*Qm*prod(1-m^2./(sigma2*(A^2+(n-1/2).^2)));
end
F0=C;%The case where z=0.

numPoints=length(xPoints);

if(nargin<4||isempty(a))
    %The maximum distance from the origin to a point is taken to be the
    %radius of the aperture.
    a=sqrt(max(sum(xPoints.^2,1)));
end

%The loop below implements Equation 63 in [1].
g=zeros(numPoints,1);
g(:)=F0/(2*pi);
for curPoint=1:numPoints
    rho=norm(xPoints(curPoint));

    if(rho<=a)
        %The normalized radius at this point.
        p=pi*rho/a;

        m=(1:(nBar-1))';
        g(curPoint)=g(curPoint)+(1/pi)*sum(Fm.*cos(m*p));
    end
end
end

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


function a = upshift ( n )

%*****************************************************************************80
%
%% UPSHIFT returns the UPSHIFT matrix.
%
%  Formula:
%
%    if ( J-I == 1 mod ( n ) )
%      A(I,J) = 1
%    else
%      A(I,J) = 0
%
%  Example:
%
%    N = 4
%
%    0 1 0 0
%    0 0 1 0
%    0 0 0 1
%    1 0 0 0
%
%  Rectangular properties:
%
%    A is integral: int ( A ) = A.
%
%    A is a zero/one matrix.
%
%  Square Properties:
%
%    A is generally not symmetric: A' /= A.
%
%    A is nonsingular.
%
%    A is a permutation matrix.
%
%    If N is even, det ( A ) = -1.
%    If N is odd,  det ( A ) = +1.
%
%    A is unimodular.
%
%    A is persymmetric: A(I,J) = A(N+1-J,N+1-I).
%
%    A is a Hankel matrix: constant along anti-diagonals.
%
%    A is an N-th root of the identity matrix.
%
%    The inverse of A is the downshift matrix.
%
%    A circulant matrix C, whose first row is (c1, c2, ..., cn), can be
%    written as a polynomial in A:
%
%      C = c1 * I + c2 * A + c3 * A**2 + ... + cn * A**n-1.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    07 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of rows and columns
%    of the matrix.
%
%    Output, real A(N,N), the matrix.
%
  a = zeros ( n, n );

  for i = 1 : n
    for j = 1 : n
      if ( i4_modp ( j - i, n ) == 1 )
        a(i,j) = 1.0;
      else
        a(i,j) = 0.0;
      end
    end
  end

  return
end


function [mantissa,exponent,signBit]=decomposeFloat(x,decodeExp,addLeading1)
%%DECOMPOSEFLOAT Given a floating point number, extract the sign but, the
%          mantissa and the exponent as three separate integer quantities.
%          Unlike the function [F,E]=log2(x), this provies the raw bits of
%          the mantissa rather than another float as in the F returned by
%          log2. The floating point value is assumed to be in IEEE 754
%          format, which is documented in [1].
%
%INPUTS: x The real, scalar floating point value to decompose. This can be
%          of class 'single' or 'double'.
% decodeExp The raw exponent of the floating point number is biased by 1023
%          for a double and by 127 for a single. The bits are shifted (from
%          the original double) so that the first bit in the return value
%          exponent is the least significant bit in the exponent. If this
%          is true, then the bias is removed. The default if this parameter
%          is omitted or an empty matrix is passed is true. Note that when
%          decoded, the exponent for 1 is 0, but for 0 it is actually -1023
%          for a double and is -127 for a single.
% addLeading1 For mantissas of normalized numbers, if this is true (the
%          default), then the leading 1 that is implied but not expressly
%          stored in the floating point register will be added. No 1 will
%          be added for subnormal numbers, where it is not implied that
%          there is a leading 1. Note that "leading" means that it is added
%          past the last bit in the mantissa.
%
%OUTPUTS: mantissa The mantissa of the float as a uint64 if x is a double
%                  or uint32 if x is a single. If addLeading1=true, then
%                  there are 53 significant bits for double and 24
%                  significant bits for a single. Otherwise, there are
%                  respectively 52 and 23 significant bits for a double or
%                  for a single.
%         exponent The exponent value. If decodeExp is false, then this is
%                  a uint64 if x is a double or a uint32 if x is a single.
%                  If decodeExp is true, then this is respectively an int64
%                  or an int32 for a double or for a single.
%          signBit This is 1 if the sign bit in x is 1 (negative) and 0 if
%                  the sign bit in x is zero. This is a uint64 if x is a
%                  double or a uint32 if x is a single.
%
%The IEEE 754 standard for floating point arithmetic in [1] formats a
%double as a 64-bit floating point data type as
%[mantissa (52 bits)] [exponent (11 bits)] [sign (1 bit)]
%where bit numbering starts at 0 in the mantissa and goes through 63 with
%the sign bit. For a 32-bit floating point single, the bit ordering is
%[mantissa (23 bits)] [exponent (8 bits)] [sign (1 bit)]
%If exponent is all ones and the mantissa is zero, then the value Inf is
%represented with the sign given by the sign bit. If the exponent is all
%ones and the mantissa is any nonzero value, then a NaN is given.
%
%To interpret the mantissa, consider that there is an implied binary point
%after the highest bit and if exponent is nonzero, then an implied 1. If
%exponent is zero, then it is implied that a 0 leads the binary point.
%Thus, the mantissa represents a fraction >=0 and < 0.5. If one reverses
%the order of the bits in the mantissa (because we wrtie numbers in big-
%endian format), then the number represented by the float is of the form
%1.mantissa*2^(exponent-bias) for a nonzero exponent and
%0.mantissa*2^(-bias) for a zero exponent. The bias is 1023 for a double
%and is 127 for a single.
%
%EXAMPLE:
% [mantissa,exponent,signBit]=decomposeFloat(4568.321)
%One gets mantissa=5022922058913284, exponent=12, signBit=0
%
%EXAMPLE:
%When dealing with integers, the mantissa with the leading 1 added
%multiplied by a power of two (shifted) is the integer value. Consider
% [mantissa,exponent,signBit]=decomposeFloat(11)
% %One gets mantissa=6192449487634432, exponent=3, signBit=0
% %Now, shift until the first nonzero bit is at the start.
% mantissaShifted=bitshift(mantissa,-findPosOfMin1Bit(mantissa)+1)
%One will see that the shifted mantissa is the orignal value, 11. The
%actual amount one has to shift the mantissa also depends on the exponent.
%
%REFERENCES:
%[1] IEEE Standard for Floating Point Arithmetic, Institute for Electrical
%    and Electronics Engineers Std. IEEE Std 754-2008, 29 Aug. 2008.
%
%January 2018 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

if(nargin<2||isempty(decodeExp))
    decodeExp=true;
end

if(nargin<3||isempty(addLeading1))
    addLeading1=true;
end

if(~isreal(x)||~isscalar(x))
   error('x must be a real, scalar, floating point value.')
end

if(isa(x,'double'))
    N=typecast(x,'uint64');

    %Get the sign bit.
    theMask=getBitMask(63,'uint64');
    signBit=bitshift(bitand(N,theMask),-63);

    %Select the bits that make up the exponent.
    expMask=getBitMask([52,62],'uint64');
    exponent=bitshift(bitand(N,expMask),-52);

    %Select the bits that make up the mantissa.
    theMask=getBitMask([0,51],'uint64');
    mantissa=bitand(N,theMask);
    if(addLeading1&&exponent~=0&&exponent~=expMask)
        %If a leading 1 is implied by the floating point number, then add
        %it. No leading 1 is added if theExp is the value indicating an INf
        %or a NaN.

        mantissa=bitor(mantissa,bitshift(uint64(1),52));
    end

    if(decodeExp)
        %Get rid of the bias. Note that two exceptions are that +/-0 maps
        %to -1023 instead of 0 and +/-Inf and NaN map to 1024.
        exponent=int64(exponent)-1023;
    end
elseif(isa(x,'single'))
    N=typecast(x,'uint32');

    %Get the sign bit.
    theMask=getBitMask(31,'uint32');
    signBit=bitshift(bitand(N,theMask),-31);

    %Select the bits that make up the exponent.
    expMask=getBitMask([23,30],'uint32');
    exponent=bitshift(bitand(N,expMask),-23);

    %Select the bits that make up the mantissa.
    theMask=getBitMask([0,22],'uint32');
    mantissa=bitand(N,theMask);
    if(addLeading1&&exponent~=0&&exponent~=expMask)
        %If a leading 1 is implied by the floating point number, then add
        %it. No leading 1 is added if theExp is the value indicating an INf
        %or a NaN.

        mantissa=bitor(mantissa,bitshift(uint32(1),23));
    end

    if(decodeExp)
        %Get rid of the bias. Note that two exceptions are that +/-0 maps
        %to -127 instead of 0 and +/-Inf and NaN map to 127.
        exponent=int32(exponent)-127;
    end
else
    error('x must be a single or double floating point value.')
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 [ resultg, resultk, error_est ] = sum_sub_gk ( func, a, b, nsub, ...
  ng, wg, nk, xk, wk )

%*****************************************************************************80
%
%% SUM_SUB_GK carries out a composite Gauss-Kronrod rule.
%
%  Discussion:
%
%    The integral:
%
%      integral ( a <= x <= b ) f(x) dx
%
%    The quadrature rule:
%
%      H = ( B - A ) / NSUB
%      XMID(J) = A + 0.5 * H * ( 2 * J - 1 )
%
%      Sum ( 1 <= J <= NSUB )
%        Sum ( 1 <= I <= NK )
%          WK(I) * F ( XMID(J) + 0.5 * H * XK(I) )
%
%    The Gauss-Legendre weights should be computed by LEGCOM or LEGSET.
%    The Kronrod abscissas and weights should be computed by KRONSET.
%
%    The orders of the Gauss-Legendre and Kronrod rules must satisfy
%    NK = 2 * NG + 1.
%
%    The Kronrod rule uses the abscissas of the Gauss-Legendre rule,
%    plus more points, resulting in an efficient and higher order estimate.
%
%    The difference between the Gauss-Legendre and Kronrod estimates
%    is taken as an estimate of the error in the approximation to the
%    integral.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 October 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, external FUNC, the name of the function which
%    evaluates the integrand.  The function must have the form
%      function func ( x ).
%
%    Input, real A, B, the lower and upper limits of integration.
%
%    Input, integer NSUB, the number of equal subintervals into
%    which the finite interval (A,B) is to be subdivided for
%    higher accuracy.  NSUB must be at least 1.
%
%    Input, integer NG, the order of the Gauss-Legendre rule.
%    NG must be at least 1.
%
%    Input, real WG(NG), the weights of the
%    Gauss-Legendre rule.
%
%    Input, integer NK, the order of the Kronrod rule.
%    NK must be at least 1.
%
%    Input, real XK(NK), the abscissas of the
%    Kronrod rule.
%
%    Input, real WK(NK), the weights of the
%    Kronrod rule.
%
%    Output, real RESULTG, the approximate value of the
%    integral based on the Gauss-Legendre rule.
%
%    Output, real RESULTK, the approximate value of the
%    integral based on the Kronrod rule.
%
%    Output, real ERROR_EST, an estimate of the approximation
%    error.  This is computed by taking the sum of the absolute values of
%    the differences between the Gauss-Legendre and Kronrod rules
%    over each subinterval.  This is usually a good estimate of
%    the error in the value RESULTG.  The error in the Kronrod
%    estimate RESULTK is usually much smaller.
%
  resultg = 0.0;
  resultk = 0.0;
  error_est = 0.0;

  if ( a == b )
    return
  end

  if ( nk ~= 2 * ng + 1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'SUM_SUB_GK - Fatal error!\n' );
    fprintf ( 1, '  NK must equal 2 * NG + 1.\n' );
    fprintf ( 1, '  The input value was NG = %d\n', ng );
    fprintf ( 1, '  The input value was NK = %d\n', nk );
    error (  'SUM_SUB_GK - Fatal error!' );
  end

  h = ( b - a ) / nsub;

  for j = 1 : nsub

    xmid = a + 0.5 * h * ( 2 * j - 1 );

    partg = 0.0;
    partk = 0.0;

    for i = 1 : nk

      xval = xmid + 0.5 * h * xk(i);
      fk = func ( xval );
      partk = partk + 0.5 * h * wk(i) * fk;

      if ( mod ( i, 2 ) == 0 )
        partg = partg + 0.5 * h * wg(i/2) * fk;
      end

    end

    resultg = resultg + partg;
    resultk = resultk + partk;
    error_est = error_est + abs ( partk - partg );

  end

  return
end


function node_xyz = sphere_grid_q9_node_xyz ( nelemx, nelemy )

%*****************************************************************************80
%
%% SPHERE_GRID_Q9_NODE_XYZ produces node coordinates for a Q9 sphere grid.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 September 2006
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NELEMX, NELEMY, the number of elements along the
%    X and Y directions.
%
%    Output, real NODE_XYZ(3,4*NELEMX*NELEMY-2*NELEMX+2),
%    the node coordinates.
%
  node = 0;

  node = node + 1;
  node_xyz(1,node) =  0.0;
  node_xyz(2,node) =  0.0;
  node_xyz(3,node) = -1.0;

  for j = 2 * nelemy : -1 : 2

    phi = ( j - 1 ) * pi / ( 2 * nelemy );

    for i = 1 : 2 * nelemx

      theta = ( i - 1 ) * 2.0 * pi / ( 2 * nelemx );

      node = node + 1;
      node_xyz(1,node) = cos ( theta ) * sin ( phi );
      node_xyz(2,node) = sin ( theta ) * sin ( phi );
      node_xyz(3,node) =                 cos ( phi );

    end
  end

  node = node + 1;
  node_xyz(1,node) =  0.0;
  node_xyz(2,node) =  0.0;
  node_xyz(3,node) =  1.0;

  return
end


function p = predictOneVsAll(all_theta, X)
%PREDICT Predict the label for a trained one-vs-all classifier. The labels
%are in the range 1..K, where K = size(all_theta, 1).
%  p = PREDICTONEVSALL(all_theta, X) will return a vector of predictions
%  for each example in the matrix X. Note that X contains the examples in
%  rows. all_theta is a matrix where the i-th row is a trained logistic
%  regression theta vector for the i-th class. You should set p to a vector
%  of values from 1..K (e.g., p = [1; 3; 1; 2] predicts classes 1, 3, 1, 2
%  for 4 examples)

m = size(X, 1);
num_labels = size(all_theta, 1);

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

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

% ====================== YOUR CODE HERE ======================
% Instructions: Complete the following code to make predictions using
%               your learned logistic regression parameters (one-vs-all).
%               You should set p to a vector of predictions (from 1 to
%               num_labels).
%
% Hint: This code can be done all vectorized using the max function.
%       In particular, the max function can also return the index of the
%       max element, for more information see 'help max'. If your examples
%       are in rows, then, you can use max(A, [], 2) to obtain the max
%       for each row.
%

z = X * all_theta';

h = sigmoid(z);

[pval p] = max(h, [], 2);

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

end


function gnuplot_taylor_test ( )

%*****************************************************************************80
%
%% GNUPLOT_TAYLOR_TEST generates a field on a regular grid and plots it.
%
%  Location:
%
%    http://people.sc.fsu.edu/~jburkardt/m_src/navier_stokes_2d_exact/gnuplot_taylor_test.m
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 January 2015
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'GNUPLOT_TAYLOR_TEST:\n' );
  fprintf ( 1, '  Taylor Vortex Flow:\n' );
  fprintf ( 1, '  Generate a velocity field on a regular grid.\n' );
  fprintf ( 1, '  Store in GNUPLOT data and command files.\n' );

  x_lo = 0.5;
  x_hi = 2.5;
  x_num = 21;

  y_lo = 0.5;
  y_hi = 2.5;
  y_num = 21;

  [ x, y ] = grid_2d ( x_num, x_lo, x_hi, y_num, y_lo, y_hi );

  nu = 1.0;
  rho = 1.0;
  n = x_num * y_num;
  t = 0.0;

  [ u, v ] = uvp_taylor ( nu, rho, n, x, y, t );

  header = 'taylor';
  s = 0.10;
  ns2de_gnuplot ( header, n, x, y, u, v, s );

  return
end


function [A, b, x, ProbInfo] = PRdiffusion(varargin)
% PRdiffusion Generates data for use in an inverse diffusion problems
%
% [A, b, x, ProbInfo] = PRdiffusion
% [A, b, x, ProbInfo] = PRdiffusion(n)
% [A, b, x, ProbInfo] = PRdiffusion(n, options)
%
% This function generates a 2D inverse diffusion problem on a uniform
% finite-element mesh with 2*(n-1)^2 triangular elements; think of the
% domain as an n-by-n pixel grid with two triangular elements in each pixel.
%
% The data represents a function u(t) on the grid at time t = Tfinal.
% The goal of the inverse problem is to compute the function u(t) at
% time t = 0 which, when diffused, produces the data.
%
% The forward problem is a very simple diffusion problem
%    du/dt = u_xx + u_yy,   0 < t < Tfinal
% with homogenous Neumann boundary conditions.  It is solved by means of
% the Crank-Nicolson-Galerkin finite-element method.  The inverse problem
% is to compute the initial condition, the function u(0) at time t = 0,
% from the solution u(t) at time t = Tfinal.
%
% The functions u(0) and u(Tfinal) are represented by the vecors x and b,
% resp., which hold the values at the corners of the finite elements.
% Both vectors have a total of n^2 elements.
%
% The severity of the problem increases with Tfinal and does not depend on
% Tsteps.
%
% Input:
%  n       - The grid has n-1 pixels in each direction, and n must be an
%            integer.  Default: n = 128.  There are 2*(n-1)^2 finite
%            elements, and the number of unknowns is n^2.
%  options - Parameters that define the problem
%              Tfinal : diffusion time; default Tfinal = 0.01.
%              Tsteps : number of time steps; default Tsteps = 100.
%
% Output:
%  A -  Function handle for the forward and adjoint problem.
%  b -  Vector that represents the solution u(t) at t = Tfinal.
%  x -  Vector that represents the initial condition u(t) at t = 0.
%  ProbInfo -  Structure containing some information about problem
%                problemType : type of test problem generated
%                              (in this case: 'diffusion')
%                xType       : solution type (in this case 'fem')
%                bType       : data type (in this case 'fem')
%                elmtab      : table of FEM elements
%                elmX        : X-coordinates of element grid
%                elmY        : Y-coordinates of element grid
%
% See also: PRblur, PRinvinterp2, PRnmr, PRseismic, PRspherical, PRtomo,
% PRnoise, PRshowb, PRshowx

% Silvia Gazzola, University of Bath
% Per Christian Hansen, Technical University of Denmark
% James G. Nagy, Emory University
% April, 2018.

% Based on original code by Allan P. Engsig-Karup, DTU Compute.

% This file is part of the IR Tools package and is distributed under the
% 3-Clause BSD Licence. A separate license file should be provided as part
% of the package.

% Set default values for options.
defaultopt = struct('Tfinal', 0.01, 'Tsteps', 100);

% If input is 'defaults,' return the default options in A.
if nargin == 1 && nargout <= 1 && strcmp(varargin,'defaults')
    A = defaultopt;
    return;
end

% Check for acceptable number of optional input arguments.
switch length(varargin)
    case 0
        n = []; options = [];
    case 1
        if isa(varargin{1}, 'double')
            n = varargin{1}; options = [];
        else
            n = []; options = varargin{1};
        end
    case 2
        if isa(varargin{1}, 'double')
            n = varargin{1}; options = varargin{2};
        else
            n = varargin{2}; options = varargin{1};
        end
    otherwise
        error('Too many input parameters')
end

if isempty(options)
    options = defaultopt;
end

options = PRset(defaultopt, options);
Tfinal = PRget(options, 'Tfinal', [], 'fast');
Tsteps = PRget(options, 'Tsteps', [], 'fast');

if isempty(n), n = 128; end

% Create rectangular mesh consisting of uniformly distributed triangles.
[elmX,elmY] = meshgrid(linspace(0,1,n));
elmX = elmX(:);
elmY = elmY(:);

% Element table for uniformly distributed triangles in a rectangular domain.
elmtab = zeros(2*(n-1)^2,3);
count = 0;
for j = 1:n-1
    for i = 1:n-1
        elmtab(count+(1:2),:) = [i   i+1+n i+n;
                                 i+1 i+1+n i     ] + (j-1)*n;
        count = count+2;
    end
end

% Initial condition.
x = 0.7*exp( -((elmX-0.4)/0.12).^2 - ((elmY-0.5)/0.15).^2) + ...
        exp( -((elmX-0.7)/0.1 ).^2 - ((elmY-0.4)/0.08).^2);

% Create the matrices.
dt = Tfinal/Tsteps;
[AA,CC] = assembly(elmX,elmY,elmtab);
S = CC - 0.5*dt*AA;
R = CC + 0.5*dt*AA;

% A is a function handle to the function that carries out the forward
% operation, i.e., interpolates from the regular grid to the randon points,
% or the corresponding adjoint operation (representing A').
A = @(xx,tflag) OPdiffusion(xx,R,S,Tsteps,tflag);

% The right-hand side (the data) ...
b = A(x,'notransp');

ProbInfo.problemType = 'diffusion';
ProbInfo.bType = 'fem';
ProbInfo.xType = 'fem';
ProbInfo.elmtab = elmtab;
ProbInfo.elmX = elmX;
ProbInfo.elmY = elmY;
ProbInfo.R = R;                  %PCH
ProbInfo.S = S;

% SUBFUNCTIONS -----------------------------------------------------------

function [A,C] = assembly(x,y,elmtab)
% Generate linear system coefficient matrix and right hand side vector.
% Symmetry is not exploited.

P = size(elmtab,1);
iL = zeros(3*3*P,1);
jL = iL;
AL = iL;
CL = iL;
count = 0;
for p = 1:P
    [delta,abc] = basfun(p,x,y,elmtab);
    for r = 1:3
        i = elmtab(p,r);
        for s = 1:3   % Does not exploit symmetry.
            j = elmtab(p,s);
            Ars = 1/(4*abs(delta))*(abc(r,2)*abc(s,2) + abc(r,3)*abc(s,3));
            if r == s
                Crs = abs(delta)/6;
            else
                Crs = abs(delta)/12;
            end
            count = count + 1;
            iL(count) = i;
            jL(count) = j;
            AL(count) = Ars;
            CL(count) = Crs;
        end
    end
end
iL = iL(1:count);
jL = jL(1:count);
AL = AL(1:count);
A = sparse(iL,jL,AL);
C = sparse(iL,jL,CL);

function [delta,abc] = basfun(p,x,y,elmtab)
% For a given element compute the geometric properties of the element.

xc = x(elmtab(p,:));
yc = y(elmtab(p,:));
delta = 0.5*( xc(2)*yc(3) - yc(2)*xc(3) - (xc(1)*yc(3) - ...
              yc(1)*xc(3)) + xc(1)*yc(2) - yc(1)*xc(2)      );

% Vectorized output.
j   = [2 3 1]';
k   = [3 1 2]';
at  = xc(j).*yc(k) - xc(k).*yc(j);
bt  = yc(j) - yc(k);
ct  = xc(k) - xc(j);
abc = [at bt ct];


 function ni = trl_curvature(yi, bi, ri, li, ctype)
%function ni = trl_curvature(yi, bi, ri, li, ctype)
%|
%| Compute surrogate parabola curvatures for Poisson transmission model
%| ctype:
%|	oc	erdogan's optimal curvatures
%|	pc	precomputed curvatures, ala trpl3
%|	nc	newton curvatures
%|
%| fix: align with C version of trpl2,3
%| The minimum returned curvature will be zero.
%| It is the user's responsibility to impose additional bounds
%| if desired for certain algorithms.
%|
%| Copyright 2002-1-28, Jeff Fessler, University of Michigan

if nargin == 1 && streq(yi, 'test'), trl_curvature_test, return, end
if nargin < 4, ir_usage, end

[h dh] = trl_h_dh;

if ~isvar('ctype') || isempty(ctype)
	ctype = 'oc'
end

% Compute optimal surrogate parabola curvatures
% for Poisson transmission model based on Erdogan's formula.
switch ctype
case 'oc'

	% compute curvature at l=0
	ni_max = zeros(size(yi));
	if numel(bi) == 1 % scalar bi (must be positive!)
		ni_max = bi .* (1 - yi .* ri ./ (bi + ri).^2);
	else
		i0 = bi > 0;
		if numel(ri) == 1
			rii = 1;
		else
			rii = ri(i0);
		end
		ni_max(i0) = bi(i0) .* (1 - yi(i0) .* rii ./ (bi(i0) + rii).^2);
	end
	ni_max = max(ni_max, 0);
	ni = ni_max;

	if 0
		il0 = li <= 0;
	else % trick in C program due to numerical precision issues
		il0 = li < 0.1;
	end

	tmp = h(yi,bi,ri,li) - h(yi,bi,ri,0) - li .* dh(yi,bi,ri,li);
	i = ~il0;
	ni(i) = 2 ./ li(i).^2 .* max(tmp(i),0);

	if any(ni > ni_max)
	%	plot([ni_max(:) ni(:) ni(:)>ni_max(:)])
		warning 'large ni'
	end

% Precomputed approximating parabola curvatures
% for Poisson transmission model.
% The minimum returned curvature will be zero.
% This is compatible with trpl/trp_init_der02_sino() in aspire.
case 'pc'

	% ni = (yi-ri)^2 / yi, if yi > ri >= 0 and bi > 0
	ii = (yi > ri) & (ri >= 0) & (bi > 0); % good rays
	ni = zeros(size(yi));
	ni(ii) = (yi(ii) - ri(ii)).^2 ./ yi(ii);

% newton curvatures (current 2nd derivative)
case 'nc'
	bel = bi .* exp(-li);
	yb = bel + ri;
	ni = (1 - ri.*yi./yb.^2) .* bel;

otherwise
	fail 'bug'
end

% trl_h_dh()
% transmission Poisson likelihood function
function [h, dh] = trl_h_dh
h = @(y,b,r,l) y .* log(b.*exp(-l)+r) - (b.*exp(-l)+r);
dh = @(y,b,r,l) (1 - y ./ (b.*exp(-l)+r)) .* b.*exp(-l);

% trl_curvature_test()
% demonstrate an example surrogate parabola!
function trl_curvature_test
[h dh] = trl_h_dh;
if 0
	l = linspace(0,2,101)';
	n = trl_curvature(2+0*l, 3, 3, l, 'oc');
	plot(l, n, '-o'), xlabel l, ylabel n
else
%	y = 4; b = 3; r = 1; ln = 3.8;
%	y = 2; b = 3; r = 3; ln = 0.05;
	y = 2; b = 3; r = 1; ln = 1;
	n.oc = trl_curvature(y, b, r, ln, 'oc');
	n.pc = trl_curvature(y, b, r, ln, 'pc');
	l = linspace(-0.2,5,101)';
	hn = h(y,b,r,ln);
	dhn = dh(y, b, r, ln);%
	hl = h(y,b,r,l);
	q.oc = hn + dhn * (l-ln) - 0.5 * n.oc * (l-ln).^2;
	q.pc = hn + dhn * (l-ln) - 0.5 * n.pc * (l-ln).^2;
	if im
		clf, plot(l, hl, '-', l, q.oc, '--', l, q.pc, '-.', ln, hn, 'o')
		grid
		axis([minmax(l)' minmax(hl)'])
		legend('h(l)',	sprintf('q_o(l) n_i=%g', n.oc), ...
				sprintf('q_p(l) n_i=%g', n.pc))
	end
end


function value = ellipse_circumference_2d ( r1, r2 )

%*****************************************************************************80
%
%% ELLIPSE_CIRCUMFERENCE_2D returns the circumference of an ellipse in 2D.
%
%  Discussion:
%
%    There is no closed formula for the circumference of an ellipse.
%
%    Defining the eccentricity by
%
%      E = sqrt ( 1 - ( r2 / r1 )**2 )
%
%    where R1 and R2 are the major and minor axes, then
%
%      circumference
%        = 4 * R1 * E(K,2*PI)
%        = R1 * Integral ( 0 <= T <= 2*PI ) sqrt ( 1 - E**2 * sin**2 ( T ) ) dT
%
%    This integral can be approximated by the Gauss-Kummer formula.
%
%  Integration region:
%
%    Points (X,Y) such that
%
%      ( ( X - XC ) / R1 )**2 + ( ( Y - YC ) / R2 )**2 <= 1
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 November 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    John Harris and Horst Stocker,
%    Handbook of Mathematics and Computational Science,
%    Springer, 1998.
%
%  Parameters:
%
%    Input, real R1, R2, the major and minor semi-axes.
%
%    Output, real VALUE, the circumference of the ellipse.
%
  if ( r1 == r2 ) then
    value = 2.0 * pi * r1;
    return
  end
%
%  Compute the eccentricity of the ellipse.
%
  e = sqrt ( 1.0 - ( min ( r1, r2 ) / max ( r1, r2 ) )^2 );

  value = 1.0;
  term = value;
  i = 0;

  while ( 1 )

    i = i + 1;
    term = term * ( 2 * i - 3 ) * ( 2 * i - 1 ) * e * e / ( 2 * 2 * i * i );

    if ( abs ( term ) <= eps * ( abs ( value ) + 1.0 ) )
      break
    end

    value = value + term;

  end

  value = 2.0 * pi * max ( r1, r2 ) * value;

  return
end


classdef spaces
% Utility functions to work with vector spaces

    methods(Static)

        function result  = insersection_space(A, B)
            % Let A and B represent vector spaces
            % The function returns basis for their intersection
            if size(A, 1) ~= size(B, 1)
                error('The ambient space must be same.');
            end

            % Orthogonalize the two bases
            A = orth(A);  % A is n x a
            B = orth(B);  % B is n x b
            % Count the rank of each of them
            % After orthogonalization number of columns may have reduced
            rank_a = size(A, 2);
            rank_b = size(B, 2);
            % Combine them
            C = [A B]; % C is n x (ra + rb)
            % Compute the null space of the whole thing
            D = null(C); % C * D = 0. D is (ra + rb) x  m
            % m is the nullity of C
            % Pick up the first rank_a rows from D
            D2 = D(1:rank_a, :); % ra * m
            % Multiply with A
            result = A * D2 ; % n * m.
            % We get the basis we were looking for
        end

        function result = orth_complement(A, B)
            % Find orthogonal complement of A in B.
            if size(A, 1) ~= size(B, 1)
                error('The ambient space must be same.');
            end
            % Orthogonalize A to make sure that it is full rank.
            A  = orth(A);
            rank_a = size(A,2);
            C = [A B];
            [Q, R] = qr(C, 0);
            % Leave the first rank_a columns from A
            result = Q(:, rank_a+ 1:end);
        end

        function result = principal_angles_orth_cos(A, B)
            % assumes that A and B are orthonormal bases
            % Compute the matrix of inner products of bases of A and B.
            M = A' * B;
            % Compute the SVD of M. The singular values are the cosine of principal angles
            result = svd(M);
            % make sure that result is bounded by 1.
            result = min(1, result);
        end

        function result = principal_angles_cos(A, B)
            % Finds the principal angles between the subspaces spanned by A and B
            % References
            % - http://in.mathworks.com/matlabcentral/newsreader/view_thread/284282
            if size(A, 1) ~= size(B, 1)
                error('The ambient space must be same.');
            end
            A = orth(A);
            B = orth(B);
            result = spx.la.spaces.principal_angles_orth_cos(A, B);
        end

        function result = principal_angles_radian(A, B)
            % Returns the principal angles in radians
            s = spx.la.spaces.principal_angles_cos(A, B);
            % Return the angles as cos inverse of singular values
            % ensure that cos-theta values are <= 1. Otherwise complex numbers may appear.
            result = acos(min(1, s));
        end

        function result = principal_angles_degree(A, B)
            % Returns the principal angles in degrees
            radians = spx.la.spaces.principal_angles_radian(A, B);
            % Return the angles as cos inverse of singular values
            result = rad2deg(radians);
        end

        function result = smallest_angle_cos(A, B)
            % Returns the smallest angle between two subspaces as cos(theta)
            s = spx.la.spaces.principal_angles_cos(A, B);
            result = s(1);
        end

        function result = smallest_angle_orth_cos(A, B)
            % Returns the smallest angle between two subspaces as cos(theta)
            % assumes A and B are orthonormal bases
            s = spx.la.spaces.principal_angles_orth_cos(A, B);
            result = s(1);
        end

        function result = smallest_angle_rad(A, B)
            % Returns the smallest angle between two subspaces in radians
            cos_theta = spx.la.spaces.smallest_angle_cos(A, B);
            result = acos(cos_theta);
        end

        function result = smallest_angle_deg(A, B)
            % Returns the smallest angle between two subspaces in degree
            theta = spx.la.spaces.smallest_angle_rad(A, B);
            result = rad2deg(theta);
        end

        function result = smallest_angles_cos(subspaces, d)
            % subspaces is either a cell array of bases or a concatenated matrix.
            % d is the dimension of each subspace [needed only if all bases are concatenated]
            if iscell(subspaces)
                bases = subspaces;
                % number of subspaces
                s = numel(subspaces);
                % the ambient dimension
                m = size(bases{1}, 1);
            else
                if nargin < 2
                    error('Dimension of each subspace must be specified.');
                end
                [m, n] = size(subspaces);
                if mod(n, d) ~= 0
                    error('n must be multiple of d');
                end
                % number of subspaces
                s = n /d;
                % create the cell array for bases
                bases = cell(s, 1);
                for i=0:s-1
                    %i-th subspace basis
                    si = subspaces(:, i*d + (1:d));
                    bases{i+1} = si;
                end
            end
            % Orthogonalize all subspaces
            for i=1:s
                bases{i} = orth(bases{i});
            end
            % The smallest angles result matrix
            result = eye(s);
            for i=1:s
                si = bases{i};
                for j=i+1:s
                    % j-th subspace
                    sj = bases{j};
                    result(i, j) = spx.la.spaces.smallest_angle_orth_cos(si, sj);
                    result(j, i) = result(i, j);
                end
            end
        end

        function result = smallest_angles_rad(subspaces, d)
            if nargin < 2
                % subspace dimensions are unspecified
                d = -1;
            end
            result = spx.la.spaces.smallest_angles_cos(subspaces, d);
            result = acos(result);
        end

        function result = smallest_angles_deg(subspaces, d)
            if nargin < 2
                % subspace dimensions are unspecified
                d = -1;
            end
            result = spx.la.spaces.smallest_angles_rad(subspaces, d);
            result = rad2deg(result);
        end

        function result = subspace_distance(A, B)
            % The distance between two subspaces based on Grassmannian
            % References
            % - http://math.stackexchange.com/questions/198111/distance-between-real-finite-dimensional-linear-subspaces
            if size(A, 1) ~= size(B, 1)
                error('The ambient space must be same.');
            end
            A = orth(A);
            B = orth(B);
            if size(A, 2) ~= size(B, 2)
                error('The two subspaces must be of same dimensions');
            end
            % Compute the projection matrices for the two spaces
            PA = A*A';
            PB = B*B';
            D = PA  - PB;
            % We return the operator norm of D as the distance between the two subspaces.
            result = norm(D);
        end

        function result = is_in_range_orth(v, U)
            % Returns if v is in the range of U where U is a unitary matrix
            nv = norm(v);
            if nv == 0
                % zero vector is always in the column space of U
                result = true;
                return;
            end
            % Compute the projection of v into the space spanned by U.
            pv = U (U' * v);
            % Compute the difference [projection to the orthogonal complement of U]
            d = v - pv;
            % Compute it's norm
            nd = norm(d);
            % Verify that the norm of difference is indeed very small
            result = nd <= 1e-6 * nv;
        end

        function result = is_in_range(v, A)
            % Returns if v is in the range of an arbitrary matrix A
            result = is_in_range_orth(v, orth(A));
        end

        function result = find_basis(A)
            % Returns a (not necessarily orthogonal) basis of A from columns of A
            [R, pivot_cols] = rref(A);
            [m, n] = size(A);
            i = 1;
            %pivot_cols = false(n, 1);
            %for j=1:n
            %    if R(i, j) == 1
            %        % Add the column containing the leading one
            %        pivot_cols(j) = true;
            %        % Move on to find the 1 in next row
            %        i = i + 1;
            %    end
            %end
            % Return a basis
            result = A (:, pivot_cols);
        end

        function [E, R] = elim(A)
            % References
            % - http://web.mit.edu/18.06/www/Course-Info/Mfiles/elim.m
            % Factorize: E R  = A
            % where E is a product of elementary matrices and
            % R is the row reduced echelon form
            [m, n] = size(A);
            I = eye(m);
            RE = rref([A I]);
            R = RE(:, 1:n);
            E = RE(:, (n+1):m+n);
        end

        function N = null_basis(A)
            % Returns a null basis for A
            % References
            % - http://web.mit.edu/18.06/www/Course-Info/Mfiles/nulbasis.m
            [m, n] = size(A);
            [R, pivot_cols] = rref(A, sqrt(eps));
            r = length(pivot_cols);
            % The columns of A which are not part of pivots
            freecol = 1:n;
            freecol(pivot_cols) = [];
            % Create space for storing the null basis
            N = zeros(n, n-r);
            N(freecol, : ) = eye(n-r);
            N(pivot_cols,  : ) = -R(1:r, freecol);
        end

        function [col_space, null_space, row_space, left_null_space] = four_bases(A)
            % Returns bases for the four spaces associated with the matrix A
            % These are not necessarily orthonormal bases
            [m, n] = size(A);
            [R, pivot_cols] = rref(A, sqrt(eps));
            rank_a = length(pivot_cols);
            % The first rank_a rows of the echelon matrix form the row space
            row_space = R(1:rank_a, :)';
            % The columns of A indexed by the pivot columns form the column space
            col_space = A(:, pivot_cols);

            % Computation of the null space
            % The columns of A which are not part of pivots
            freecol = 1:n;
            freecol(pivot_cols) = [];
            % Allocate memory for the null space basis
            null_space = zeros(n, n-r);
            null_space(freecol, : ) = eye(n-r);
            null_space(pivot_cols,  : ) = -R(1:r, freecol);

            left_null_space = E((r+1):m, :)';
        end

        function [col_space, null_space, row_space, left_null_space] = four_orth_bases(A)
            % Prepares the four bases using SVD
            [U, S, V] = svd(A);
            % Finding the rank of A
            s = diag(S);
            tol = max(size(A))*eps(max(s));
            r = sum(s > tol);
            col_space = U(:, 1:r);
            null_space = U(:, r+1:m);
            row_space = V(:, 1:r);
            left_null_space = V(:, r+1:n);
        end

        function Y = k_dim_to_n_dim(X, n, indices)
            % Maps the data in K dimensions to N-dimensions.
            [k, d] = size(X);
            if nargin < 2
                error('Target dimension must be specified');
            end
            if n < k
                error('n must be larger than k');
            end
            if nargin < 3
                indices = 1:k;
            end
            if ~isvector(indices)
                error('indices must be a vector.');
            end
            if numel(indices) > k
                error('Number of indices must be k');
            end
            if length(unique(indices))<length(indices)
                error('There must be exactly k unique entries in indices');
            end
            if max(indices) > n || min(indices) < 1
                error('Indices cannot point outside 1:n ');
            end
            Y = zeros(n, d);
            Y(indices, :) = X;
        end

        function [A, B, C] = three_spaces_at_angle(N, theta)
            if ~mod(N, 3) == 0
                error('N must be divisible by 3');
            end
            % First create two random orthonormal vectors
            X = orth(randn(N, 3));
            % Then tilt the second one w.r.t. first
            a1 = X(:, 1);
            a2 = X(:, 2);
            a3 = X(:, 3);
            p = cos(theta);
            % first vector for second space
            b1 = sqrt(1 - p^2) * a2 + p * a1;
            % first vector for third space
            c1_1 = p;
            c1_2 = p * (1 - p) / sqrt(1 - p^2);
            c1_3 = sqrt(1 - c1_1^2 - c1_2^2);
            c1 = c1_1 * a1 + c1_2 * a2 + c1_3 * a3;
            X = [a1 b1 c1];
            % Find the orthogonal complement of X
            [U S V] = svd(X);
            Y = U(:, 4:end);
            [~, n] = size(Y);
            % Distribute vectors from Y into A and B
            A = [a1 Y(:, 1:n/3)];
            B = [b1 Y(:, n/3 + (1:n/3))];
            C = [c1 Y(:, 2*n/3 + (1:n/3))];
        end

        function [A, B, C] = three_disjoint_spaces_at_angle(N, theta)
            X = eye(4);
            R1 = [cos(theta) -sin(theta); sin(theta) cos(theta)];
            a1 = [1 ; 0];
            a2 = R1*a1;
            a3 = R1*a2;
            theta2 = deg2rad(59);
            R2 = [cos(theta2) -sin(theta2); sin(theta2) cos(theta2)];
            b1 = [1 ; 0];
            b2 = R2*b1;
            b3 = R2*b2;
            z = zeros(2, 1);
            A = [a1 z; z b1];
            B = [a2 z; z b2];
            C = [a3 z; z b3];
            A =kron(A , eye(N / 2));
            B =kron(B , eye(N / 2));
            C =kron(C , eye(N / 2));
        end

        function describe_three_spaces(A, B, C)
            % Compute principal angles between the subspaces
            fprintf('Ranks: [A]: %d, [B]: %d, [A]: %d\n', ...
                rank(A), rank(B), rank(C));
            fprintf('Cols: [A]: %d, [B]: %d, [A]: %d\n', ...
                size(A, 2), size(B, 2), size(C, 2));
            fprintf('Ranks: [A B]: %d, [B C]: %d, [A C]: %d, \n', ...
                rank([A B]), rank([B C]), rank([A C]));
            D = [A B C];
            fprintf('Rank [A B C]: %d\n', rank(D));
            fprintf('Angle between A and B: %.4f deg\n', spx.la.spaces.smallest_angle_deg(A, B));
            fprintf('Angle between B and C: %.4f deg\n', spx.la.spaces.smallest_angle_deg(B, C));
            fprintf('Angle between A and C: %.4f deg\n', spx.la.spaces.smallest_angle_deg(A, C));
            fprintf('Column wise norms: \n');
            fprintf(' %.2f', spx.norm.norms_l2_cw(A));
            fprintf('\n');
            fprintf(' %.2f', spx.norm.norms_l2_cw(B));
            fprintf('\n');
            fprintf(' %.2f', spx.norm.norms_l2_cw(C));
            fprintf('\n');
        end

        function [A, B, C] = abc_spaces_junk_1(N, theta)
            if ~mod(N, 2) == 0
                error('N must be divisible by 2');
            end
            d = N / 2;
            % First create three random orthonormal vectors
            X = orth(randn(N, 2));
            % Then tilt the second one w.r.t. first
            a1 = X(:, 1);
            a2 = X(:, 2);
            p = cos(theta);
            % first vector for second space
            b1 = sqrt(1 - p^2) * a2 + p * a1;
            X = [a1 b1];
            % Find the orthogonal complement of X
            [U S V] = svd(X);
            Y = U(:, 3:end);
            [~, n] = size(Y);
            % Distribute vectors from Y into A and B
            A = [a1 Y(:, 1:n/2)];
            B = [b1 Y(:, n/2 + 1:end)];

            % choose a vector a3 which is orthogonal to A and b1
            X = [A B(:, 1:d-1)];
            [U S V] = svd(X);
            a3 = U(:, size(X, 2) + 1);
            % first vector for third space
            c1_1 = p;
            c1_2 = p * (1 - p) / sqrt(1 - p^2);
            c1_3 = sqrt(1 - c1_1^2 - c1_2^2);
            c1 = c1_1 * a1 + c1_2 * a2 + c1_3 * a3;

            X = [A c1];
            % Find the orthogonal complement of X
            [U S V] = svd(X);
            Y = U(:, size(X, 2)+1:end);
            C = [c1 Y];
        end

        function result = have_same_column_spans(A, B)
            % Checks if the column spans of two matrices are same.
            r1 = rank(A);
            r2 = rank(B);
            if r1 ~= r2
                result = false;
                return;
            end
            r3 = rank([A B]);
            if r3 ~= r1
                result = false;
                return;
            end
            result = true;
        end

    function result =  bases(X, counts)
        % bases for individual subspaces
        K = length(counts);
        % bases cell array
        result = cell(1, K);
        [start_indices, end_indices] = spx.cluster.start_end_indices(counts);
        for k=1:K
            ss = start_indices(k);
            ee = end_indices(k);
            XX = X(:, ss:ee);
            basis = orth(XX);
            result{k} = basis;
        end
    end

    end

end


addpath(genpath('/dartfs-hpc/rc/home/m/f0042vm/software/fdaM'))

% create a basis set

dt = 0.0288;
order = 3;
l = 25;
degree = 8;

basis = create_bspline_basis([0,l/dt], degree+4, order);
bf = full(eval_basis((1:l/dt),basis));
bf = bf(:,3:end-2);

obf = spm_orth(bf); % orthogonalize bf

figure(1);
subplot(3,1,1);
cla
h1 = plot(bf,'r');
title('Spline Basis Set');
subplot(3,1,2);
h2 = plot(obf,'b');
title('SPM orthogonalized splines');

% compute inverse orthogonal transform

iO = (obf'*obf)\obf'*bf;
iO(iO < 0) = 0;

% generate a random walk;

rand_walk = sum(triu(repmat(randn(length(bf),1),1,length(bf))));

figure(1);
subplot(3,1,3);
cla
h1=plot(rand_walk,'bla');
hold on;

% fit both basis fnuctions to the random walk

B = (bf'*bf)\bf'*rand_walk';
orth_B = (obf'*obf)\obf'*rand_walk';

h2=plot(obf*orth_B,'*b');
h3=plot(bf*B,'r');
h4=plot(bf.*repmat(B',size(bf,1),1),'g')

legend([h1(1),h2(1),h3(1),h4(1)],'Random Walk','spm spline model','spline model','weighted splines','location','southeast');
title('Spline model can be obtained with either basis set');

% so now we have the following
% splineModel = bf*B
% splineModel = obf*orth_B
% obf*iO = bf
% so we can rearrange
% obf*iO*b = obf*orth_B
% iO*b = orth_B
% b = inv(iO)*orth_B

i0 = (bf'*obf)'\obf'*obf;
iO(iO<0) = 0;

sum(inv(iO)*orth_B)
sum(B)


function [ y, m, d, f ] = jed_to_ymdf_republican ( jed )

%*****************************************************************************80
%
%% JED_TO_YMDF_REPUBLICAN converts a JED to a Republican YMDF date.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    23 April 2013
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Edward Richards,
%    Algorithm F,
%    Mapping Time, The Calendar and Its History,
%    Oxford, 1999, pages 324-325.
%
%  Parameters:
%
%    Input, real JED, the Julian Ephemeris Date.
%
%    Output, integer Y, M, D, real F,
%    the YMDF date.
%

%
%  Determine the computational date (Y'/M'/D').
%
  j = floor ( jed + 0.5 );
  f = ( jed + 0.5 ) - j;

  g =floor ( ( 4 * j + 578797 ) / 146097 );
  g = floor ( ( 3 * g ) / 4 ) - 51;
  j_prime = j + 111 + g;

  y_prime =     floor ( ( 4 * j_prime + 3 ) / 1461 );
  t_prime = floor ( mod ( 4 * j_prime + 3, 1461 ) / 4 );
  m_prime = floor ( t_prime / 30 );
  d_prime =   mod ( t_prime, 30 );
%
%  Convert the computational date to a calendar date.
%
  d = d_prime + 1;
  m = mod ( m_prime, 13 ) + 1;
  y = y_prime - 6504 + floor ( ( 13 - m ) / 13 );

  return
end