function angout = npi2pi(angin,units,approach)

    %NPI2PI Truncates angles into the -180 deg to 180 deg range
    %
    %
    %  ang = NPI2PI(angin) transforms input angles into the
    %  -180 to 180 degree range.
    %
    %  ang = NPI2PI(angin,'units') uses the units defined by the
    %  input string 'units'.  If omitted, default units of 'degrees'
    %  are assumed.
    %
    %  ang = NPI2PI(angin,'units','method') uses the method
    %  defined by the corresponding input string.  Valid methods are:
    %  'exact' for the exact transformation; 'inward' where all angles
    %  are shifted epsilon towards the origin before the -180 to 180 degree
    %  transformation; 'outward' where all angles are shifted epsilon
    %  away from the origin before the -180 to 180 degree transformation.
    %  If omitted, default method of 'exact' is assumed.
    %
    %  See also ZERO22PI, ANGLEDIM

    %  Copyright 1996-2000 Systems Planning and Analysis, Inc. and The MathWorks, Inc.
    %  Written by:  E. Byrns, E. Brown
    %   $Revision: 1399 $    $Date: 2006-08-11 11:19:27 +0200 (Fr, 11 Aug 2006) $

    %report_this_filefun(mfilename('fullpath'));

    if nargin == 0
        error('Incorrect number of arguments')
    elseif nargin == 1
        units = [];     approach = [];
    elseif nargin == 2
        approach = [];
    end

    %  Empty argument tests

    if isempty(approach);   approach = 'exact';    end
    if isempty(units);      units    = 'degrees';  end

    %  Convert inputs to radians

    angin = angledim(angin,units,'radians');

    %  Exact approach -- Eliminates the use of ATAN2 function.

    %  Approximate approach -- Some inconsistencies with ATAN2 function
    %  across platforms when an exact multiple of -pi is used.  Some platforms
    %  atan2(-1,0) = -pi, and for some platforms atan2(-1,0) = pi;

    switch lower(approach)
        case 'exact'

            %  Exact approach is not straightforward because of this mapping behavior:
            %       -3pi maps to -pi;   -2pi maps to -pi;  -pi maps to -pi;
            %        pi  maps to pi;     2pi maps to pi;   3pi maps to pi
            %  Note that the mapping point changes when the sign on pi changes.

            angout = pi*((abs(angin)/pi) - ...
                2*ceil(((abs(angin)/pi)-1)/2)) .* sign(angin);

        case 'inward'

            %  Move data epsilon towards (inward) the origin.  Eliminates any
            %  points which start identically on a multiple of pi.  Then
            %  use the atan2 function.

            epsilon = epsm('radians');
            angin   = angin*(1 - epsilon);
            angout  = atan2(sin(angin),cos(angin));

        case 'outward'

            %  Move data epsilon towards (away from) the origin.  Eliminates any
            %  points which start identically on a multiple of pi.  Then
            %  use the atan2 function.

            epsilon = epsm('radians');
            angin   = angin * (1 + epsilon);
            angout  = atan2(sin(angin),cos(angin));

        otherwise
            error('Unrecognized approach string')
    end

    angout = angledim(angout,'radians',units);  %  Convert to the original units


function quadrule_test105 ( )

%*****************************************************************************80
%
%% TEST105 tests JACOBI_EK_COMPUTE and JACOBI_SS_COMPUTE.
%
%  Discussion:
%
%    Compare with tabular values on page 178 of Stroud and Secrest.
%
%     In particular,
%
%             X              W
%
%     1  -0.9833999115   0.4615276287E-03
%     2  -0.9447138932   0.2732249104E-02
%     3  -0.8849310847   0.8045830455E-02
%    ..  .............   ................
%    19   0.9656375637   0.7613987785E-01
%    20   0.9934477866   0.3348337670E-01
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 April 2011
%
%  Author:
%
%    John Burkardt
%
  order = 20;

  a = -1.0;
  b =  1.0;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST105\n' );
  fprintf ( 1, '  JACOBI_EK_COMPUTE sets up Gauss-Jacobi quadrature;\n' );
  fprintf ( 1, '  JACOBI_SS_COMPUTE sets up Gauss-Jacobi quadrature;\n' );
  fprintf ( 1, '  Here, we simply compute a single rule and\n' );
  fprintf ( 1, '  print it, to check for accuracy.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The integration interval is [%f, %f]\n', a, b );

  alpha = 1.5;
  beta = 0.5;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  N = %d\n', order );
  fprintf ( 1, '  ALPHA = %f\n', alpha );
  fprintf ( 1, '  BETA =  %f\n', beta );

  [ x, w ] = jacobi_ek_compute ( order, alpha, beta );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  JACOBI_EK_COMPUTE:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '     I        X(I)            W(I)\n' );
  fprintf ( 1, '\n' );

  for i = 1 : order
    fprintf ( 1, '  %4d  %14.8f  %14.8f\n', i, x(i), w(i) );
  end

  [ x, w ] = jacobi_ss_compute ( order, alpha, beta );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  JACOBI_SS_COMPUTE:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '     I        X(I)            W(I)\n' );
  fprintf ( 1, '\n' );

  for i = 1 : order
    fprintf ( 1, '  %4d  %14.8f  %14.8f\n', i, x(i), w(i) );
  end

  return
end


function DEM_demo_contact_lens
% This demo illustrates tracking under the contact lens problem:
% The contact lens refers to the non-Gaussian uncertainty induced by
% nonlinear measurements. Here it is illustrated in terms of tracking the
% motion of a target in Cartesian coordinates, given the distance to target
% (range) and direction as measurements. The problem is to accumulate
% information over time about the target location under random fluctuations
% on the velocity (technically this is a constant acceleration model).
% Comparative evaluations are made with Extended Kalman filtering.
%
% See: X. Tian, Y. Bar-Shalom, Coordinate Conversion and Tracking for
% Very Long Range Radars. IEEE Transactions on Aerospace and Electronic
% Systems, AES-45(3):1073-1088, July 2009.
%__________________________________________________________________________
% Copyright (C) 2011 Wellcome Trust Centre for Neuroimaging

% Karl Friston
% $Id: DEM_demo_contact_lens.m 7679 2019-10-24 15:54:07Z spm $

% non-linear generative model
%==========================================================================

% The problem: states = [x(1) x(2)]; causes = [v(1) v(2)]
%--------------------------------------------------------------------------
x        = [1e4 1e4 -8 -2]';   % initial states: location = 10km,  10km
                               %                 velocity = -8m/s, -2m/s
V        = [1e-2 4];           % observation precision (inverse variance)
                               % standard deviation of range: 1/sqrt(V(1)) = 10m
                               % standard deviation of angle: 1/sqrt(V(2)) = .5 mrad
s        = 1;                  % smoothness of fluctuations
w        = 8;                  % precision of fluctuations in motion
W        = [128 128 w w];      % standard deviation of velocity: 1/sqrt(w) = .3536 m/s^2

% preliminaries
%--------------------------------------------------------------------------
N        = 256;                % length of sequence
t        = 1:N;                % time (seconds)
M(1).E.s = s;                  % smoothness of fluctuations
M(1).E.n = 4;                  % order of generalised coordinates
M(1).E.K = 128;                % rate of generalized gradient descent

% Level 1: Hidden states = [x(1) x(2) v(1) v(2)];
%--------------------------------------------------------------------------
f        = '[x(3); x(4); 0; 0]';
g        = '[sqrt(x(1)^2 + x(2)^2); 1000*atan(x(2)/x(1))]';
M(1).f   = inline(f,'x','v','P');
M(1).g   = inline(g,'x','v','P');
M(1).x   = x;
M(1).V   = diag(V);            % precision of observation noise
M(1).W   = diag(W);            % precision of fluctuations on hidden states

% create data
%==========================================================================
DEM    = spm_DEM_generate(M,N);

% Comparative inversions (variants of generalised filtering)
%==========================================================================

% reset initial position and bearing
%--------------------------------------------------------------------------
DEM.M(1).x = [1e3; 1e3; 0; 0];

% DEM and EKF
%--------------------------------------------------------------------------
DEM     = spm_DEM(DEM);
[EKF S] = spm_ekf(DEM.M,DEM.Y);

spm_figure('Getwin','DEM');
spm_DEM_qU(DEM.qU,DEM.pU)

% show prediction errors
%==========================================================================
spm_figure('GetWin','Figure 1');

D(1,:) = sqrt(sum((DEM.pU.x{1}([1 2],:) - DEM.qU.x{1}([1 2],:)).^2));
D(2,:) = sqrt(sum((DEM.pU.x{1}([1 2],:) - EKF([1 2],:)).^2));
D(3,:) = sqrt(sum((DEM.pU.x{1}([3 4],:) - DEM.qU.x{1}([3 4],:)).^2));
D(4,:) = sqrt(sum((DEM.pU.x{1}([3 4],:) - EKF([3 4],:)).^2));

for i = 1:N
    E         = DEM.pU.x{1}(:,i) - DEM.qU.x{1}(:,i);
    NEES(1,i) = E'*spm_inv(DEM.qU.S{i})*E;
    E         = DEM.pU.x{1}(:,i) - EKF(:,i);
    NEES(2,i) = E'*spm_inv(S{i})*E;
end

% plot errors
%--------------------------------------------------------------------------
subplot(2,2,1)
plot(t,log(D(1:2,:)))
title('log(location error (m))','Fontsize',16)
xlabel('time (secs)')
ylabel('log distance from target')
axis square
legend('DEM','EKF')

subplot(2,2,2)
plot(t,log(D(3:4,:)))
title('log(speed error (m/s))','Fontsize',16)
xlabel('time (secs)')
ylabel('log distance from target')
axis square
legend('DEM','EKF')

% plot trajectories
%--------------------------------------------------------------------------
subplot(2,2,3)
plot(DEM.pU.x{1}(1,:),DEM.pU.x{1}(2,:)     ),hold on
plot(DEM.qU.x{1}(1,:),DEM.qU.x{1}(2,:),'-.'),hold on
plot(EKF(1,:),EKF(2,:),':'),hold off
title('location (m)','Fontsize',16)
axis([8 12 8 12]*1000)
xlabel('x')
ylabel('y')
axis square
legend('true','DEM','EKF')

% plot NEES
%--------------------------------------------------------------------------
subplot(2,2,4)
plot(t,log(NEES))
title('log(NEES)','Fontsize',16)
xlabel('time (secs)')
axis square
legend('DEM','EKF')
drawnow

return

% prediction errors as a function of K
%==========================================================================
K     = -0:1/2:12;
for i = 1:length(K)

    % DEM and EKF (linear)
    %----------------------------------------------------------------------
    DEM.M(1).E.K = exp(K(i));
    DEM          = spm_DEM(DEM);

    % mean square error
    %----------------------------------------------------------------------
    kse(i,1) = mean(mean((DEM.pU.x{1} - DEM.qU.x{1}).^2));

end

% show prediction errors
%==========================================================================
spm_DEM_qU(DEM.qU,DEM.pU)

% plot trajectories
%--------------------------------------------------------------------------
subplot(2,1,2)
plot(K,log(kse))
title('log(MSE)','Fontsize',16)
xlabel('log(K)','Fontsize',12)
axis square


%
% References:
%
% C. Lu. A Library of ADMM for Sparse and Low-rank Optimization. National University of Singapore, June 2016.
% https://github.com/canyilu/LibADMM.
% C. Lu, J. Feng, S. Yan, Z. Lin. A Unified Alternating Direction Method of Multipliers by Majorization
% Minimization. IEEE Transactions on Pattern Analysis and Machine Intelligence, vol. 40, pp. 527-541, 2018
%

addpath(genpath(cd))
clear

%% Examples for testing the low-rank matrix based models
% For detailed description of the sparse models, please refer to the Manual.

%% generate toy data
d = 10;
na = 200;
nb = 100;

A = randn(d,na);
X = randn(na,nb);
B = A*X;
b = B(:,1);

opts.tol = 1e-6;
opts.max_iter = 1000;
opts.rho = 1.2;
opts.mu = 1e-3;
opts.max_mu = 1e10;
opts.DEBUG = 0;

%% RPCA
n1 = 100;
n2 = 200;
r = 10;
L = rand(n1,r)*rand(r,n2); % low-rank part

p = 0.1;
m = p*n1*n2;
temp = rand(n1*n2,1);
[~,I] = sort(temp);
I = I(1:m);
Omega = zeros(n1,n2);
Omega(I) = 1;
E = sign(rand(n1,n2)-0.5);
S = Omega.*E; % sparse part, S = P_Omega(E)

Xn = L+S;

lambda = 1/sqrt(max(n1,n2));
opts.loss = 'l1';
opts.DEBUG = 1;
tic
[Lhat,Shat,obj,err,iter] = rpca(Xn,lambda,opts);
toc
rel_err_L = norm(L-Lhat,'fro')/norm(L,'fro')
rel_err_S = norm(S-Shat,'fro')/norm(S,'fro')

err
iter

%% low rank matrix completion (lrmc) and regularized lrmc

n1 = 100;
n2 = 200;
r = 5;
X = rand(n1,r)*rand(r,n2);

p = 0.6;
omega = find(rand(n1,n2)<p);
M = zeros(n1,n2);
M(omega) = X(omega);
[Xhat,obj,err,iter] = lrmc(M, omega, opts);
rel_err_X = norm(Xhat-X,'fro')/norm(X,'fro')

E = randn(n1,n2)/100;
M = X+E;
lambda = 0.1;
[Xhat,obj,err,iter] = lrmcR(M, omega, lambda, opts);

%% low rank representation (lrr)
lambda = 0.001;
opts.loss = 'l21';
tic
[X,E,obj,err,iter] = lrr(A,A,lambda,opts);
toc
obj
err
iter

%% latent LRR (latlrr)
lambda = 0.1;
opts.loss = 'l1';
tic
[Z,L,obj,err,iter] = latlrr(A,lambda,opts);
toc
obj
err
iter

%% low rank and sparse representation (lrsr)
lambda1 = 0.1;
lambda2 = 4;
opts.loss = 'l21';
tic
[X,E,obj,err,iter] = lrsr(A,B,lambda1,lambda2,opts);
toc
obj
err
iter

%% improved graph clustering (igc)
n = 100;
r = 5;
X = rand(n,r)*rand(r,n);
C = rand(size(X));
lambda = 1/sqrt(n);
opts.loss = 'l1';
opts.DEBUG = 1;
tic
[L,S,obj,err,iter] = igc(X,C,lambda,opts);
toc
err
iter

%% multi-task low-rank affinity pursuit (mlap)
n1 = 100;
n2 = 200;
K = 10;
X = rand(n1,n2,K);
lambda = 0.1;
alpha = 0.2;
opts.loss = 'l1';
tic
[Z,E,obj,err,iter] = mlap(X,lambda,alpha,opts);
toc
err
iter

%% robust multi-view spectral clustering (rmsc)
n = 100;
r = 5;
m = 10;
X = rand(n,n,m);
lambda = 1/sqrt(n);
opts.loss = 'l1';
opts.DEBUG = 1;
tic
[L,S,obj,err,iter] = rmsc(X,lambda,opts);
toc
err
iter

%% sparse spectral clustering (sparsesc)
lambda = 0.001;
n = 100;
X = rand(n,n);
W = abs(X'*X);
I = eye(n);
D = diag(sum(W,1));
L = I - sqrt(inv(D))*W*sqrt(inv(D));
k = 5;
[P,obj,err,iter] = sparsesc(L,lambda,k,opts);
obj
err
iter


% Factor analysis
% Z -> X,  Z in R^k, X in R^D, k << D (high dimensional observations explained by small source)
% Z ~ N(0,I),   X|Z ~ N(L z, Psi), where Psi is diagonal.
%
% We compare to Zoubin Ghahramani's code.

state = 0;
rand('seed', state);
randn('seed', state);
max_iter = 3;
k = 2;
D = 4;
N = 10;
X = randn(N, D);

% Initialize as in Zoubin's ffa (fast factor analysis)
X=X-ones(N,1)*mean(X);
XX=X'*X/N;
diagXX=diag(XX);
cX=cov(X);
scale=det(cX)^(1/D);
randn('seed', 0);  % must reset seed here so initial params are identical to mfa
L0=randn(D,k)*sqrt(scale/k);
W0 = L0;
Psi0=diag(cX);

[L1, Psi1, LL1] = ffa(X,k,max_iter);

ns = [k D];
dag = zeros(2,2);
dag(1,2) = 1;
bnet = mk_bnet(dag, ns, 'discrete', [], 'observed', 2);
bnet.CPD{1} = gaussian_CPD(bnet, 1, 'mean', zeros(k,1), 'cov', eye(k), 'cov_type', 'diag', ...
			   'clamp_mean', 1, 'clamp_cov', 1);
bnet.CPD{2} = gaussian_CPD(bnet, 2, 'mean', zeros(D,1), 'cov', diag(Psi0), 'weights', W0, ...
			   'cov_type', 'diag', 'cov_prior_weight', 0, 'clamp_mean', 1);

engine = jtree_inf_engine(bnet);
evidence = cell(2,N);
evidence(2,:) = num2cell(X', 1);

[bnet2, LL2] = learn_params_em(engine, evidence, max_iter);

s = struct(bnet2.CPD{2});
L2 = s.weights;
Psi2 = s.cov;

% Compare to Zoubin's code
assert(approxeq(LL2, LL1));
assert(approxeq(Psi2, diag(Psi1)));
assert(approxeq(L2, L1));


function [IdxParent, IdxChildren, Ms] = WaveTreeStructure2D(N, L);
% WaveTreeStructure: parent/children relationships for coefficients
%     of 2-dimensional wavelet transfom
% Invoked after W = @(x) midwt(x,wav);WT = @(x) mdwt(x,wav);
% It finds the relations between the coefficient images obtained by Rice
%     wavelet toolbox
%
% USAGE: [IdxParent, IdxChildren]=WaveTreeStructure2D(C, S)
%
% INPUT:  N: image with size of N x N, scaling/coefficients
%            after 2-d wavelet transform "mdwt"
%         L: denotes total decomposition levels
%         [See instruction of "mdwt" function for definition of C and L]
%
% OUTPUT: IdxParent: N^2 x 1, parent index.
%         IdxParent(i)=j means the parent of the ith coefficient is coefficient j
%
%         IdxChildren: nChildren x (M-Ms(N)), children index.
%         IdxChildren(i,2:end)=[j(1),...,j(nChildren)] means the children of
%         the ith coefficient are coefficients j(1),...,j(nChildren).
%         Since coefficients at level L (finest level) do not have any children,
%         they are not stored.
%
%         The order of coefficients in IdxParent and IdxChildren are the
%         same as the coefficient order in C(:)
%
%         Ms: 1 x N, number of wavelet coefficients for each decomposition
%             level (scaling coeff. are excluded)

%--------------------------------------------------------------------------
% Junzhou Huang, CSE, University of Texas at Arlington, Feb, 2012
%--------------------------------------------------------------------------
for i=1:L
    Ms(i,1)=3*(N/2^(L-i+1))^2;
end
%---------------------------------------------------------------------------%
% INITIALIZATIONS
IdxParent=zeros(N^2,1);
IdxChildren=zeros(N^2/4,5); %Col 1: index i; col 2-5 the 4 children of index i

IJ=zeros(N^2, 2);
%    col 1: R  (row pointer)
%    col 2: C  (column pointer)
[Isub, Jsub]=ind2sub([N, N], [1:N^2]');
IJ(:,1)=Isub;IJ(:,2)=Jsub;

%%%% Parent %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
B=zeros(N, N);
B(1:N/2^(L-1),1:N/2^(L-1)) = ones(N/2^(L-1), N/2^(L-1));
index0=find(B==1);
IdxParent(index0)=0;

index=find(B==0);
[Isub, Jsub]=ind2sub([N, N], index);

indexPar=sub2ind([N, N], ceil(Isub/2), ceil(Jsub/2));
IdxParent(index)=indexPar;

%%%%%%%% child  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
B=zeros(N, N);
B(1:N/2^(L-1),1:N/2^(L-1)) = ones(N/2^(L-1), N/2^(L-1));
index0=find(B==1);

IdxChildren(1:length(index0), 1)=index0;
IdxChildren(1:length(index0), 2:5)=0;

B(N/2+1:N, :) = ones(N/2, N);
B(:, N/2+1:N) = ones(N, N/2);

index=find(B==0);
[Isub, Jsub]=ind2sub([N, N], index);
indexChild4=sub2ind([N, N], Isub*2, Jsub*2);
indexChild3=sub2ind([N, N], Isub*2, Jsub*2-1);
indexChild2=sub2ind([N, N], Isub*2-1, Jsub*2);
indexChild1=sub2ind([N, N], Isub*2-1, Jsub*2-1);

IdxChildren(length(index0)+1:end,:)=[index, indexChild1, indexChild2, indexChild3, indexChild4];
IdxChildren2=IdxChildren;
[YY,II] = sort(IdxChildren(:,1));

IdxChildren=zeros(size(IdxChildren));
IdxChildren=IdxChildren2(II,:);


function [A,B,C,D,E,F,G] = bay_rr(X,Y,gam,level,nb,eigvals,eigvec)
% Bayesian inference of the cost on the three levels of linear ridge regression
%
% >> cost = bay_rr(X, Y, gam, level)
%
% This function implements the cost functions related to the
% Bayesian framework of linear ridge Regression [29]. Optimizing
% this criteria results in optimal model parameters W,b,
% hyperparameters. The criterion can also be used for model
% comparison.
%
% The obtained model parameters w and b are optimal on the first
% level w.r.t J = 0.5*w'*w+gam*0.5*sum(Y-X*w-b).^2.
%
% Full syntax
%
%     * OUTPUTS on the first level: Cost proportional to the posterior of the model parameters.
%
% >> [costL1, Ed, Ew] = bay_rr(X, Y, gam, 1)
%
%         costL1: Cost proportional to the posterior
%         Ed(*) : Cost of the fitting error term
%         Ew(*) : Cost of the regularization parameter
%
%     * OUTPUTS on the second level: Cost proportional to the posterior of gam.
%
% >> [costL2, DcostL2, Deff, mu, ksi, eigval, eigvec] = bay_rr(X, Y, gam, 2)
%
%         costL2    : Cost proportional to the posterior on the second level
%         DcostL2(*): Derivative of the cost proportional to the posterior
%         Deff(*)   : Effective number of parameters
%         mu(*)     : Relative importance of the fitting error term
%         ksi(*)    : Relative importance of the regularization parameter
%         eigval(*) : Eigenvalues of the covariance matrix
%         eigvec(*) : Eigenvectors of the covariance matrix
%
%     * OUTPUTS on the third level: The following commands can be
%     used to compute the level 3 cost function for different
%     models (e.g. models with different selected sets of
%     inputs). The best model can then be chosen as the model with
%     best level 3 cost (CostL3).
%
% >> [costL3, gam_optimal] = bay_rr(X, Y, gam, 3)
%
%         costL3         : Cost proportional to the posterior on the third inference level
%         gam_optimal(*) : Optimal regularization parameter obtained from optimizing the second level
%
%     * INPUTS:
%
% >> cost = bay_rr(X, Y, gam, level)
%
%         X N x d matrix with the inputs of the training data
%         Y N x 1 vector with the outputs of the training data
%         gam Regularization parameter
%         level 1, 2, 3
%
% See also:
%   ridgeregress,bay_lssvm

% -dislaimer-

  if ~exist('fminunc'),
    error('This function needs the optimization function ''fminunc''.');
  end

[N,d] = size(X);

if (level==1 || level==2),
  [W,b] = ridgeregress(X,Y,gam);
  Ew =  .5*W'*W;             % Ew
  Ed = .5*sum((X*W+b-Y).^2); % Ed
  Ewgd = Ew+gam*Ed;          % Ewgd
  A=Ewgd; C=Ed; B=Ew;

  if level==2,
    if nargin>=7,
      if numel(eigvals)>length(eigvals), v = diag(eigvals); else v=eigvals; end
      V = eigvec;
    else
      eval('[V,v] = eigs(X''*X+eye(d)*2,nb);','[V,v] = eig(X''*X+eye(d)*2);v=diag(v);');v=v-2;
      v = v*(N-1)/N;
    end
    Peff = find(v>1000*eps); Neff=length(Peff);
    v = v(Peff); V= V(:,Peff);
    vall = zeros(N-1,1);vall(1:Neff)=v;
    Deff = 1+sum(gam.*v./(1+gam.*v));                 % Deff
    CostL2 = sum(log(vall+1./gam))+(N-1)*log(Ewgd);   % CostL2
    DcostL2 = -sum(1./(gam+vall.*gam^2))+(N-1)*Ed/Ewgd; % DcostL2
    mu = 2*Ed/(N-Deff); ksi = mu*gam;                 % mu and ksi
    A=CostL2; B=DcostL2; C=Deff; D=mu; E=ksi;F=v;G=V;
  end

elseif level==3,

  % check fminunc
  resp = which('fminunc');
  %disp(' ');
  if isempty(resp),
    error(' ''fminunc'' not available');
  end

  eval('nb;','nb=''blabla'';');
  opties=optimset('MaxFunEvals', 2000,'GradObj','on', 'DerivativeCheck', 'off', 'TolFun', .0001, 'TolX', .0001, 'Display','off' );
  [CostL2,DCostL2, Deff, mu,ksi,v, V] = bay_rr(X,Y,gam,2,nb);
  gam_opt = exp(fminunc(@costL2, log(gam), opties,X,Y,nb,v,V));
  [CostL2,DCostL2, Deff, mu,ksi,v, V] = bay_rr(X,Y,gam_opt,2,nb,v,V);
  CostL3 = .5*length(v)*log(mu)+(N-1)*log(ksi) - log(Deff-1)-log(N-Deff) - sum(log(mu+ksi*v));
  A = CostL3; B = gam_opt;

else
  error('level should be ''1'', ''2'' or ''3''.');
end

function [C,Dc] = costL2(log_gam,X,Y,nb,v,V)
%
[C,Dc] = bay_rr(X,Y,exp(log_gam),2,nb,v,V);


function value = e_constant ( )

%*****************************************************************************80
%
%% E_CONSTANT returns the value of E.
%
%  Discussion:
%
%   "E" was named in honor of Euler.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    08 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Output, real E_CONSTANT, the base of the natural
%    logarithm system.
%
  value = 2.718281828459045;

  return
end


% bsearch(x,var)
% Written by Aroh Barjatya
% Binary search for values specified in vector 'var' within data vector 'x'
% The data has to be pre-sorted in ascending or decending order
% There is no way to predict how the function will behave if there
% are multiple numbers with same value.
% returns the index values of the searched numbers

function index = bsearch(x,var)

xLen = length(x);
[xRow xCol] = size(x);
if x(1) > x(xLen)	% means x is in descending order
    if xRow==1
        x = fliplr(x);
    else
        x = flipud(x);
    end
    flipped = 1;
elseif x(1) < x(xLen)	% means x is in ascending order
    flipped = 0;
else
    'badly formatted data. Type ''help bsearch\'')';
    return;
end

for i = 1:length(var)
    low = 1;
    high = xLen;
    if var(i) <= x(low)
        index(i) = low;
        continue;
    elseif var(i) >= x(high)
        index(i) = high;
        continue;
    end
    flag = 0;
    while (low <= high)
        mid = round((low + high)/2);
        if (var(i) < x(mid))
            high = mid;
        elseif (var(i) > x(mid))
            low = mid;
        else
            index(i) = mid;
            flag = 1;
            break;
        end
        if (low == high - 1)
            break
        end
    end
    if (flag == 1)
        continue;
    end
    if (low == high)
        index(i) = low;
    elseif ((x(low) - var(i))^2 > (x(high) - var(i))^2)
        index(i) = high;
    else
        index(i) = low;
    end
end

if flipped
    index = xLen - index + 1;
end


function boundary = p02_boundary_nearest ( m, n, point )

%*****************************************************************************80
%
%% P02_BOUNDARY_NEAREST returns a nearest boundary point in problem 02.
%
%  Discussion:
%
%    The given input point need not be inside the region.
%
%    In some cases, more than one boundary point may be "nearest",
%    but only one will be returned.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 April 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Per-Olof Persson and Gilbert Strang,
%    A Simple Mesh Generator in MATLAB,
%    SIAM Review,
%    Volume 46, Number 2, June 2004, pages 329-345.
%
%  Parameters:
%
%    Input, integer M, the spatial dimension.
%
%    Input, integer N, the number of points.
%
%    Input, real POINT(M,N), the coordinates
%    of the points.
%
%    Output, real BOUNDARY(M,N), points on the boundary
%    that are nearest to each point.
%
  center = [ 0.0, 0.0 ];
  r1 = 1.0;
  r2 = 0.4;

  for j = 1 : n

    if ( point(1:2,j) == center(1:2)' )

      boundary(1,j) = r2;
      boundary(2,j) = center(2);

    else

      r = sqrt ( ( point(1,j) - center(1) ).^2 ...
               + ( point(2,j) - center(2) ).^2 );

      if ( r1 - r < r - r2 )
        boundary(1,j) = center(1) + r1 * ( point(1,j) - center(1) ) / r;
        boundary(2,j) = center(2) + r1 * ( point(2,j) - center(2) ) / r;
      else
        boundary(1,j) = center(1) + r2 * ( point(1,j) - center(1) ) / r;
        boundary(2,j) = center(2) + r2 * ( point(2,j) - center(2) ) / r;
      end

    end

  end

  return
end


% test_dmatrix_sphmesh.m

% Author: Ramon Casero <rcasero@gmail.com>
% Copyright © 2013 University of Oxford
% Version: 0.1.1
%
% University of Oxford means the Chancellor, Masters and Scholars of
% the University of Oxford, having an administrative office at
% Wellington Square, Oxford OX1 2JD, UK.
%
% This file is part of Gerardus.
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details. The offer of this
% program under the terms of the License is subject to the License
% being interpreted in accordance with English Law and subject to any
% action against the University of Oxford being under the jurisdiction
% of the English Courts.
%
% You should have received a copy of the GNU General Public License
% along with this program.  If not, see
% <http://www.gnu.org/licenses/>.

%% spherical triangle with vertices in the north pole, equator at lon=0,
%% and equator at lon=90º
uv = [
    90 0
    0  0
    0  90
    ] / 180 * pi;
tri = [1 2 3];

% compute distance matrix
d = dmatrix_sphmesh(tri, uv);

% ans =
%
%          0    1.5708    1.5708
%     1.5708         0    1.5708
%     1.5708    1.5708         0

%% add another spherical triangle, this one with a common edge and touching
%% the south pole
uv = [
    90 0
    0  0
    0  90
    -90 0
    ] / 180 * pi;
tri = [
    1 2 3
    2 3 4
    ];

% plot
[x, y, z] = sph2cart(uv(:, 2), uv(:, 1), 1);
hold off
trisurf(tri, x, y, z)
axis equal

% compute distance matrix
d = dmatrix_sphmesh(tri, uv);
full(d)

% ans =
%
%          0    1.5708    1.5708         0
%     1.5708         0    1.5708    1.5708
%     1.5708    1.5708         0    1.5708
%          0    1.5708    1.5708         0


%% hex8_hex20
% Below is a demonstration of the features of the |hex8_hex20| function

%% Syntax
% |[E_HEX20,V_HEX20,V_HEX20_cell,Fb_HEX20,Fb_HEX20_QUAD8]=hex8_hex20(E_HEX8,V_HEX8,V_HEX8_cell,Fb_HEX8);|

%% Description
% The |hex8_hex20| converts 4-node tetrahedral elements to 10-node
% tetrahedral elements.

%% Examples

%%
clear; close all; clc;

% Plot settings
fontSize=15;
faceAlpha=0.5;
edgeColor='k';
edgeWidth1=2;
edgeWidth2=1;
markerSize1=75;
markerSize2=10;

%% CONVERSION FROM HEX8 TO HEX20, EXAMPLE FOR A SINGLE HEXAHEDRON
% Creating a single 4-node HEXAHEDRON
[V8,~]=platonic_solid(2,1); %q indicates solid type, r is the radius
HEX8=[1:8];
[F8,~]=element2patch(HEX8,[],'hex8');

%%
% Converting to a single 10-node HEXAHEDRON
[HEX20,V20,~]=hex8_hex20(HEX8,V8,{});
[F20,~]=element2patch(HEX20,[],'hex20');

%%
% Plotting elements
cFigure;
subplot(1,2,1); hold on;
title('A linear HEXAHEDRON','FontSize',fontSize);

hp=gpatch(F8,V8,'gw','k',faceAlpha);
hp.Marker='.';
hp.MarkerSize=markerSize1;

patchNormPlot(F8,V8,0.75); %Plotting face normals

for q=1:1:size(HEX8,2)
    text(V8(HEX8(1,q),1),V8(HEX8(1,q),2),V8(HEX8(1,q),3),['  ',num2str(q)],'FontSize',fontSize*2,'color','b');
end

axisGeom(gca,fontSize);
axis off;
camlight('headlight'); lighting flat;

subplot(1,2,2); hold on;
title('A quadratic HEXAHEDRON','FontSize',fontSize);

hp=gpatch(F20,V20,'rw','k',faceAlpha);
hp.Marker='.';
hp.MarkerSize=markerSize1;
patchNormPlot(F20,V20,0.75); %Plotting face normals

for q=1:1:size(HEX20,2)
    text(V20(HEX20(1,q),1),V20(HEX20(1,q),2),V20(HEX20(1,q),3),[' ',num2str(q)],'FontSize',fontSize*2,'color','b');
end

axisGeom(gca,fontSize);
axis off;
camlight('headlight'); lighting flat;

drawnow;

%% CONVERSION FROM HEX8 TO HEX20, EXAMPLE FOR A HEXAHEDRON MESH WITH NODAL PARAMETERS
n=3;
for q=1:1:n
    [HEX8,V8]=subHex(HEX8,V8,1);
end

[F8,~]=element2patch(HEX8,[],'hex8');

%Create nodal result e.g. displacement and color
V4d=V8;
V4d(:,1)=V4d(:,1)+0.5.*sin(pi*V4d(:,3));
V4d(:,2)=V4d(:,2)+0.5.*cos(pi*V4d(:,3));
D4=V4d-V8;

C4=V8(:,1); %Color towards X

%%
% Converting to a single 10-node HEXAHEDRON
HEX8_cell={D4,C4};
[HEX20,V20,HEX20_cell]=hex8_hex20(HEX8,V8,HEX8_cell);
[F20,~]=element2patch(HEX20,[],'hex20');
D10=HEX20_cell{1};
C10=HEX20_cell{2};
V10d=V20+D10;

%%
% Plotting elements
hf=cFigure; % Open figure for plotting
subplot(2,2,1); hold on;
title('A linear HEXAHEDRON mesh','FontSize',fontSize);

hp=gpatch(F8,V8,'gw','k',faceAlpha);
hp.Marker='.';
hp.MarkerSize=markerSize2;

axisGeom(gca,fontSize); axis off;
view([-50,12])
camlight('headlight'); lighting flat;

subplot(2,2,3); hold on;
title('Data on linear HEXAHEDRON mesh','FontSize',fontSize);

hp=gpatch(F8,V4d,C4,'k',faceAlpha);
hp.Marker='.';
hp.MarkerSize=markerSize2;

axisGeom(gca,fontSize); axis off;
view([-50,12])
camlight('headlight'); lighting flat;

subplot(2,2,2); hold on;
title('A quadratic HEXAHEDRON mesh','FontSize',fontSize);

hp=gpatch(F20,V20,'rw','k',faceAlpha);
hp.Marker='.';
hp.MarkerSize=markerSize2;

axisGeom(gca,fontSize); axis off;
view([-50,12])
camlight('headlight'); lighting flat;

subplot(2,2,4); hold on;
title('Mapped data on quadratic HEXAHEDRON mesh','FontSize',fontSize);

hp=gpatch(F20,V10d,C10,'k',faceAlpha);
hp.Marker='.';
hp.MarkerSize=markerSize2;

axisGeom(gca,fontSize); axis off;
view([-50,12])
camlight('headlight'); lighting flat;

drawnow;

%% CONVERSION FROM HEX8 TO HEX20, EXAMPLE FOR KEEPING TRACK OF BOUNDARY FACES

[F8,~]=element2patch(HEX8,[],'hex8');
[indBoundary]=tesBoundary(F8);
Fb4=F8(indBoundary,:);

[HEX20,V20,HEX20_cell,Fb10]=hex8_hex20(HEX8,V8,{},Fb4);
[F20,~]=element2patch(HEX20,[],'hex20');

% [indBoundary]=tesBoundary(F20,V20);
% Fb20=F20(indBoundary,:);

%%
%

hf=cFigure; % Open figure for plotting
subplot(1,2,1); hold on;
title('A linear HEXAHEDRON mesh','FontSize',fontSize);

gpatch(F8,V8,'gw','k',faceAlpha);

gpatch(Fb4,V8,'rw','k',faceAlpha);
axisGeom(gca,fontSize); axis off;
camlight('headlight'); lighting flat;

subplot(1,2,2); hold on;
title('A quadratic HEXAHEDRON mesh','FontSize',fontSize);

hp=gpatch(Fb10,V20,'rw','k',faceAlpha);
hp.Marker='.';
hp.MarkerSize=markerSize2;

axisGeom(gca,fontSize); axis off;
camlight('headlight'); lighting flat;

drawnow;

%%
%
% <<gibbVerySmall.gif>>
%
% _*GIBBON*_
% <www.gibboncode.org>
%
% _Kevin Mattheus Moerman_, <gibbon.toolbox@gmail.com>

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


function T_new = ExplicitScheme(T_old,alpha,dx,dy,dt,x_intervals,y_intervals)

T_new = T_old;

for x_index = 2:1:(x_intervals-1)
    for y_index = 2:1:(y_intervals-1)

         T_new(x_index,y_index) = T_old(x_index,y_index) + (alpha*dt)*((T_old(x_index+1,y_index) - 2*T_old(x_index,y_index)+ T_old(x_index-1,y_index))/dx^2 + (T_old(x_index,y_index+1) - 2*T_old(x_index,y_index)+ T_old(x_index,y_index-1))/dy^2);

    end
end

end


%% Sharp Color Keys
%
%%
% In this section we discuss color keys that are particular useful when
% analyzing data with very small deviation in orientation. Let us consider
% the following calcite data set

% plotting conventions
plotx2east, plotb2east
mtexdata sharp

ebsd = ebsd('calcite');

ipfKey = ipfColorKey(ebsd);

close all;
plot(ebsd,ipfKey.orientation2color(ebsd.orientations))

%%
% and have a look into the 100 inverse pole figure.

% compute the positions in the inverse pole figure
h = ebsd.orientations .\ vector3d.X;
h = project2FundamentalRegion(h);

% compute the azimuth angle in degree
color = h.rho ./ degree;

plotIPDF(ebsd.orientations,vector3d.X,'property',color,'MarkerSize',3,'grid')
mtexColorbar

%%
% We see that all individual orientations are clustered around azimuth
% angle 115 degrees with some outliers at 65 degree. In order to
% increase the contrast for the main group, we restrict the color range from
% 110 degree to 120 degree.

caxis([110 120]);

% by the following lines we colorcode the outliers in purple.
cmap = colormap;
cmap(end,:) = [1 0 1]; % make last color purple
cmap(1,:) = [1 0 1];   % make first color purple
colormap(cmap)

%%
% The same colorcoding we can now apply to the EBSD map.

% plot the data with the customized color
plot(ebsd,color)

% set scaling of the angles to 110 - 120 degree
caxis([110 120]);

% colorize outliers in purple.
cmap = colormap;
cmap(end,:) = [1 0 1];
cmap(1,:) = [1 0 1];
colormap(cmap)

%% Sharpening the default colorcoding
% Next, we want to apply the same ideas as above to the default MTEX color
% key, i.e. we want to stretch the colors such that they cover just the
% orientations of interest.

ipfKey = ipfHSVKey(ebsd.CS.properGroup);

% To this end, we first compute the inverse pole figure direction such that
% the mean orientation is just at the gray spot of the inverse pole figure
ipfKey.inversePoleFigureDirection = mean(ebsd.orientations,'robust') * ipfKey.whiteCenter;

close all;
plot(ebsd,ipfKey.orientation2color(ebsd.orientations))

%%
% We observe that the orientation map is almost completely gray, except for
% the  outliers which appears black. Next, we use the option |maxAngle| to
% increase contrast in the grayish part

ipfKey.maxAngle = 7.5*degree;
plot(ebsd,ipfKey.orientation2color(ebsd.orientations))

%%
% You may play around with the option |maxAngle| to obtain better
% results. As for interpretation keep in mind that white color represents
% the mean orientation and the color becomes more saturated and later dark
% as the orientation to color diverges from the mean orientation.
%
% Let's have a look at the corresponding color map.

plot(ipfKey,'resolution',0.25*degree)

% plot orientations into the color key
hold on
plotIPDF(ebsd.orientations,'points',10,'MarkerSize',1,'MarkerFaceColor','w','MarkerEdgeColor','w')
hold off
%%
% observe how in the inverse pole figure the orientations are scattered
% closely around the white center. Together with the fact that the
% transition from white to color is quite rapidly, this gives a high
% contrast.

%% The axis angle color key
%

[grains,ebsd.grainId] = calcGrains(ebsd,'angle',1.5*degree);
ebsd(grains(grains.grainSize<=3)) = [];
[grains,ebsd.grainId] = calcGrains(ebsd,'angle',1.5*degree);

grains = smooth(grains,5);

%%

ipfKey = axisAngleColorKey(ebsd('indexed'));

% use for the reference orientation the grain mean orientation
ipfKey.oriRef = grains.meanOrientation(ebsd.grainId);

plot(ebsd,ipfKey.orientation2color(ebsd.orientations))

hold on
plot(grains.boundary,'lineWidth',4)
hold off

%%

F = halfQuadraticFilter;

ebsdS = smooth(ebsd,F,'fill',grains);

% use for the reference orientation the grain mean orientation
ipfKey.oriRef = grains.meanOrientation(ebsdS('indexed').grainId);

plot(ebsdS('indexed'),ipfKey.orientation2color(ebsdS('indexed').orientations))

hold on
plot(grains.boundary,'lineWidth',4)
hold off

%%

F = infimalConvolutionFilter;
F.lambda = 0.01;
F.mu = 0.02;

ebsdS = smooth(ebsd,F);

[grains,ebsdS.grainId] = calcGrains(ebsdS,'angle',1*degree);
%ebsdS(grains(grains.grainSize<=3)) = [];
%[grains,ebsdS.grainId] = calcGrains(ebsdS,'angle',1.5*degree);

grains = smooth(grains,5);

% use for the reference orientation the grain mean orientation
ipfKey.oriRef = grains(ebsdS('indexed').grainId).meanOrientation;
%ipfKey.oriRef = mean(ebsdS('indexed').orientations);

plot(ebsdS('indexed'),ipfKey.orientation2color(ebsdS('indexed').orientations),'micronbar','off')

hold on
plot(grains.boundary,'lineWidth',4)
hold off

%%
% Another example is when analyzing the orientation distribution within
% grains

mtexdata forsterite
ebsd = ebsd('indexed');

% segment grains
[grains,ebsd.grainId] = calcGrains(ebsd);

% find largest grains
largeGrains = grains(grains.grainSize > 800)

ebsd = ebsd(largeGrains(1))

%%
% When plotting one specific grain with its orientations we see that they
% all are very similar and, hence, get the same color

% plot a grain
close all
plot(largeGrains(1).boundary,'linewidth',2)
hold on
plot(ebsd,ebsd.orientations)
hold off

%%
% when applying the option sharp MTEX colors the mean orientation as white
% and scales the maximum saturation to fit the maximum misorientation
% angle. This way deviations of the orientation within one grain can be
% visualized.

% plot a grain
plot(largeGrains(1).boundary,'linewidth',2)
hold on
ipfKey = ipfHSVKey(ebsd);
ipfKey.inversePoleFigureDirection = mean(ebsd.orientations) * ipfKey.whiteCenter;
ipfKey.maxAngle = 2*degree;
plot(ebsd,ipfKey.orientation2color(ebsd.orientations))
hold off


function [p, s, df] = myStatTest(x1, x2, type)
% [p, s, df] = myStatTest(X1, X2, 'test')
% Statistical test of two samples- gives the confidence level for
% different tests of the two samples X1 and X2.
%
%       'test'   Null hypothesis      Assumption on distributions  Type
%       -----------------------------------------------------------------
%         't'    Means are equal      The variances are equal      t-test
%         'u'    Means are equal      The variances are not equal  t-test
%         'p'    Means are equal      The data are paired          t-test
%         'f'    Variances are equal                               F-test
%         'r'    Pearson Correlation                               Z-test
%
%       TEST(X1, X2) performs a t-test (for equal variances) by default.
%
%       [P S] = TEST(X1, X2, ['test']) returns the confidence level in P
%       and the value of the statistic (t or F) in S.
%
%       Ref: Press et al. 1992. Numerical recipes in C. 14.2, Cambridge.
%
if (nargin == 2)
   type = 't' ;
end
nanInds1 = isnan(x1);
nanInds2 = isnan(x2);

if (type == 't')
  [p s df] = ttest(x1(~nanInds1), x2(~nanInds2)) ;
elseif (type == 'u')
  [p s df] = uttest(x1(~nanInds1), x2(~nanInds2)) ;
elseif (type == 'p')
  nanIndsBoth = nanInds1|nanInds2;
  [p s df] = pttest(x1(~nanIndsBoth), x2(~nanIndsBoth)) ;
elseif (type == 'f')
  [p s] = ftest(x1(~nanInds1), x2(~nanInds2)) ;
elseif (type == 'r')
  sz = max([size(x1);size(x2)]);
  for(k=1:sz(1))
    nanIndsBoth(k,:) = nanInds1(k,:)|nanInds2(k,:);
  end
  n = sum(~nanIndsBoth,1);
  df = n-2;
  if(sz(1)>1&&sz(2)>1)
    % vectorized version- assumes that x1 is Nx1 and x2 is NxM. Returns the
    % 1xM correlation coefficients.
    mn = mean(x1,1);
    sd = std(x1,0,1);
    Z1 = (x1-repmat(mn, [sz(1) 1])) ./ repmat(sd, [sz(1) 1]);
    mn = mean(x2,1);
    sd = std(x2,0,1);
    Z2 = (x2-repmat(mn, [sz(1) 1])) ./ repmat(sd, [sz(1) 1]);
    s = 0;
    for(k=1:sz(1))
        s = s + Z1(k,:).*Z2(k,:);
    end
    s = s./n;
    fZ = 0.5*(log((1+s)./(1-s)));
    p = erfc((abs(fZ).*sqrt(df))./sqrt(2));
  else
    % just use matlab's built-in
    [pearson,p] = corrcoef(x1(~nanIndsBoth), x2(~nanIndsBoth));
    s = pearson(1,2);
    p = p(1,2);
    %     t = s/sqrt((1-s^2)/df);
    %     p = betainc( df / (df + t*t), df/2, 0.5);
    % Fischer's z' method (slightly less conservative):
    %z = 0.5*(log((1+s)/(1-s)));
    %df = length(x1)-3;
    %p = erfc((abs(z)*sqrt(df))/sqrt(2));
  end
elseif(type=='k')
  % Kendall's tau
  % This is essentially a vectorized, simplfied version of the
  % implementation in Matlab's 'corr' function.
  sz = max([size(x1);size(x2)]);
  for(k=1:sz(1))
    nanIndsBoth(k,:) = nanInds1(k,:)|nanInds2(k,:);
  end
  n = sum(~nanIndsBoth,1);
  n2const = n.*(n-1)./2;
  [x1Rank,x1Adj] = tiedrank(x1,1);
  [x2Rank,x2Adj] = tiedrank(x2,1);
  K = zeros(1,sz(2));
  for(k=1:sz(1)-1)
    sgn1 = sign(repmat(x1(k,:),sz(1)-k,1)-x1(k+1:sz(1),:));
    % Zero-out Nans to effectively ignore these data points (the
    % missing values are accounted for in the DF)
    sgn1(isnan(sgn1)) = 0;
    sgn2 = sign(repmat(x2(k,:),sz(1)-k,1)-x2(k+1:sz(1),:));
    sgn2(isnan(sgn2)) = 0;
    for(j=1:size(sgn1,1))
      K = K + sgn1(j,:).*sgn2(j,:);
    end
  end
  %for(k=1:sz(1)-1)
  %  tmp = sum(sign(repmat(x1(k,:),sz(1)-k,1)-x1(k+1:sz(1),:)).*sign(repmat(x2(k,:),sz(1)-k,1)-x2(k+1:sz(1),:)),1);
  %  tmp(nanIndsBoth(k,:)) = 0;
  %  K = K + tmp;
  %end
  s = K ./ sqrt((n2const - x1Adj(1,:)).*(n2const - x2Adj(1,:)));
  ties = ((x1Adj(1,:)>0) | (x2Adj(1,:)>0));
  % Following p-value calc is probably only valid for n>=10
  df = n-2;
  nfact = factorial(n);
  stdK = n2const.*(2.*n+5)./9;
  if(any(ties))
    stdK = stdK - (x1Adj(3,:) + x2Adj(3,:))./18 + x1Adj(2,:).*x2Adj(2,:)./(18.*n2const.*(n-2)) + x1Adj(1,:).*x2Adj(1,:)./n2const;
  end
  stdK = sqrt(stdK);
  tail = 'b';
  switch tail
    case 'b' % 'both or 'ne'
        p = normcdf(-(abs(K)-1) ./ stdK);
        p = min(2*p, 1); % Don't count continuity correction at center twice
    case 'r' % 'right' or 'gt'
        p = normcdf(-(K-1) ./ stdK);
    case 'l' % 'left' or 'lt'
        p = normcdf((K+1) ./ stdK);
  end
end
return;

function [p, t, df] = uttest(d1, d2)
%UTTEST Student's t-test for unequal variances.
%       UTTEST(X1, X2) gives the probability that Student's t
%       calculated on data X1 and X2, sampled from distributions
%       with different variances, is higher than observed, i.e.
%       the "significance" level.  This is used to test whether
%       two sample have significantly different means.
%       [P, T] = UTTEST(X1, X2) gives this probability P and the
%       value of Student's t in T. The smaller P is, the more
%       significant the difference between the means.
%       E.g. if P = 0.05 or 0.01, it is very likely that the
%       two sets are sampled from distributions with different
%       means.
%
%       This works if the samples are drawn from distributions with
%       DIFFERENT VARIANCE. Otherwise, use TTEST.
%
%See also: TTEST, PTTEST.
[l1 c1] = size(d1) ;
n1 = l1 * c1 ;
x1 = reshape(d1, l1 * c1, 1) ;
[l2 c2] = size(d2) ;
n2 = l2 * c2 ;
x2 = reshape(d2, l2 * c2, 1) ;
[a1 v1] = avevar(x1) ;
[a2 v2] = avevar(x2) ;
df = (v1 / n1 + v2 / n2) * (v1 / n1 + v2 / n2) / ...
     ( (v1 / n1) * (v1 / n1) / (n1 - 1) + (v2 / n2) * (v2 / n2) / (n2 -1) ) ;
t = (a1 - a2) / sqrt( v1 / n1 + v2 / n2 ) ;
p = betainc( df / (df + t*t), df/2, 0.5) ;
return;

function [p, t, df] = pttest(d1, d2)
%PTTEST Student's paired t-test.
%       PTTEST(X1, X2) gives the probability that Student's t
%       calculated on paired data X1 and X2 is higher than
%       observed, i.e. the "significance" level. This is used
%       to test whether two paired samples have significantly
%       different means.
%       [P, T] = PTTEST(X1, X2) gives this probability P and the
%       value of Student's t in T. The smaller P is, the more
%       significant the difference between the means.
%       E.g. if P = 0.05 or 0.01, it is very likely that the
%       two sets are sampled from distributions with different
%       means.
%
%       This works for PAIRED SAMPLES, i.e. when elements of X1
%       and X2 correspond one-on-one somehow.
%       E.g. residuals of two models on the same data.
%
%See also: TTEST, UTTEST.
[l1 c1] = size(d1) ;
n1 = l1 * c1 ;
x1 = reshape(d1, l1 * c1, 1) ;
[l2 c2] = size(d2) ;
n2 = l2 * c2 ;
if (n1 ~= n2)
   error('PTTEST: paired samples must have the same number of elements !')
end
x2 = reshape(d2, l2 * c2, 1) ;
[a1 v1] = avevar(x1) ;
[a2 v2] = avevar(x2) ;
df  = n1 - 1 ;
cab = (x1 - a1)' * (x2 - a2) / (n1 - 1) ;
if (a1 ~= a2)
  % use abs to avoid numerical errors for very similar data
  % for which v1+v2-2cab may be close to 0.
  t = (a1 - a2) / sqrt(abs(v1 + v2 - 2 * cab) / n1) ;
  p = betainc( df / (df + t*t), df/2, 0.5) ;
else
  t = 0 ;
  p = 1 ;
end
return;

function [p, t, df] = ttest(d1, d2)
%TTEST Student's t-test for equal variances.
%       TTEST(X1, X2) gives the probability that Student's t
%       calculated on data X1 and X2, sampled from distributions
%       with the same variance, is higher than observed, i.e.
%       the "significance" level. This is used to test whether
%       two sample have significantly different means.
%       [P, T] = TTEST(X1, X2) gives this probability P and the
%       value of Student's t in T. The smaller P is, the more
%       significant the difference between the means.
%       E.g. if P = 0.05 or 0.01, it is very likely that the
%       two sets are sampled from distributions with different
%       means.
%
%       This works if the samples are drawn from distributions with
%       the SAME VARIANCE. Otherwise, use UTTEST.
%
%See also: UTTEST, PTTEST.
[l1 c1] = size(d1) ;
n1 = l1 * c1 ;
x1 = reshape(d1, l1 * c1, 1) ;
[l2 c2] = size(d2) ;
n2 = l2 * c2 ;
x2 = reshape(d2, l2 * c2, 1) ;
[a1 v1] = avevar(x1) ;
[a2 v2] = avevar(x2) ;
df = n1 + n2 - 2 ;
pvar = ((n1 - 1) * v1 + (n2 - 1) * v2) / df ;
t = (a1 - a2) / sqrt( pvar * (1/n1 + 1/n2)) ;
p = betainc( df / (df + t*t), df/2, 0.5) ;
return;

function [xbar, varx] = avevar(v)
%AVEVAR average and variance of sample.
%       AVEVAR(X) gives the average of the sample in X.
%       X is a vector of values.
%       [A, V] = AVEVAR(X) returns the average of X in A,
%       and the variance in V. The variance is corrected
%       using the two-pass formula.
%
%       Ref: [1] Chan, Golub and LeVeque. 1983. American
%                Statistician, vol. 37, pp. 242--247.
%            [2] Press et al. 1992. Numerical recipes in C.
%                Cambridge university press.
[n l] = size(v) ;
x = reshape(v, n*l, 1) ;
xbar = sum(x) / n / l ;
d = x - xbar ;
varx = ( sum(d .* d) - sum(d) * sum(d) / n / l) / (n * l - 1) ;
return;

function [p, f, df] = ftest(d1, d2)
%FTEST F-test for two samples.
%       FTEST(X1, X2) gives the probability that the F value
%       calculated as the rati of the variances of the two samples is
%       greater than observed, i.e. the significance level.
%       [P, F] = FTEST(X1, X2) gives the probability P and returns
%       the value of F.
%
%       A small value of P would lead to reject the hypothesis that
%       both data sets are sampled from distributions with the same
%       variances.
%
%See also : TTEST, TEST.
[l1 c1] = size(d1) ;
n1 = l1 * c1 ;
x1 = reshape(d1, l1 * c1, 1) ;
[l2 c2] = size(d2) ;
n2 = l2 * c2 ;
x2 = reshape(d2, l2 * c2, 1) ;
[a1 v1] = avevar(x1) ;
[a2 v2] = avevar(x2) ;
f = v1 / v2 ;
df1 = n1 - 1 ;
df2 = n2 - 1 ;
if (v1 > v2)
   p = 2 * betainc( df2 / (df2 + df1 * f), df2 / 2, df1 / 2) ;
else
   f = 1 / f ;
   p = 2 * betainc( df1 / (df1 + df2 * f), df1 / 2, df2 / 2) ;
end
if (p > 1)
   p = 2 - p ;
end

df = [df1,df2];
return;


function int = MITGaussLaguerre( norder, alpha )

%% LAGUERRE_COM computes the abscissa and weights for Gauss-Laguerre
%quadrature.
%
%  Discussion:
%
%    In the simplest case, ALPHA is 0, and we are approximating the
%    integral from 0 to INFINITY of EXP(-X) * F(X).  When this is so,
%    it is easy to modify the rule to approximate the integral from
%    A to INFINITY as well.
%
%    If ALPHA is nonzero, then there is no simple way to extend the
%    rule to approximate the integral from A to INFINITY.  The simplest
%    procedures would be to approximate the integral from 0 to A.
%
%    The integration interval is [ A, +Infinity ) or [ 0, +Infinity ).
%
%    The weight function w(x) = EXP ( - X ) or EXP ( - X ) * X**ALPHA.
%
%    The integral to approximate:
%
%      Integral ( A <= X < +INFINITY ) EXP ( - X ) * F(X) dX
%    or
%      Integral ( 0 <= X < +INFINITY ) EXP ( - X ) * X**ALPHA * F(X) dX
%
%    The quadrature rule:
%
%      EXP ( - A ) * Sum ( 1 <= I <= NORDER ) WEIGHT(I) * F ( A+XTAB(I) )
%    or
%      Sum ( 1 <= I <= NORDER ) WEIGHT(I) * F ( XTAB(I) )
%
%  Modified:
%
%    12 October 2005
%
%  Reference:
%
%    Arthur Stroud and Don Secrest,
%    Gaussian Quadrature Formulas,
%    Prentice Hall, 1966.
%
%  Parameters:
%
%    Input, integer NORDER, the order of the quadrature rule to be
%    computed.
%    NORDER must be at least 1.
%
%    Input, real ALPHA, the exponent of the X factor.
%    Set ALPHA = 0.0 for the simplest rule.
%    ALPHA must be nonnegative.
%
%    Output, real XTAB(NORDER), the Gauss-Laguerre abscissas.
%
%    Output, real WEIGHT(NORDER), the Gauss-Laguerre weights.
%

%
%  Set the recursion coefficients.
%
  for i = 1 : norder
    b(i) = ( alpha + 2 * i - 1 );
  end

  for i = 1 : norder
    c(i) = ( i - 1 ) * ( alpha + i - 1 );
  end

  cc = gamma ( alpha + 1.0 ) * prod ( c(2:norder) );
  int.x = zeros(norder,1);
  int.w = int.x;
  int.n =norder;
  for i = 1 : norder
%
%  Compute an estimate for the root.
%
    if ( i == 1 )

      x = ( 1.0 + alpha ) * ( 3.0+ 0.92 * alpha ) ...
        / ( 1.0 + 2.4 * norder + 1.8 * alpha );

    elseif ( i == 2 )

      x = x + ( 15.0 + 6.25 * alpha ) ...
        / ( 1.0 + 0.9 * alpha + 2.5 * norder );

    else

      r1 = ( 1.0 + 2.55 * ( i - 2 ) ) / ( 1.9 * ( i - 2 ) );

      r2 = 1.26 * ( i - 2 ) * alpha / ( 1.0 + 3.5 * ( i - 2 ) );

      ratio = ( r1 + r2 ) / ( 1.0 + 0.3 * alpha );

      x = x + ratio * ( x - xtab(i-2) );

    end
%
%  Use iteration to find the root.
%
    [ x, dp2, p1 ] = laguerre_root ( x, norder, alpha, b, c );
%
%  Set the abscissa and weight.
%
    int.x(i) = x;
    int.w(i) = ( cc / dp2 ) / p1;

  end
  int.n = norder;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function [ x, dp2, p1 ] = laguerre_root ( x, norder, alpha, b, c )

%% LAGUERRE_ROOT improves an approximate root of a Laguerre polynomial.
%
%  Modified:
%
%    12 October 2005
%
%  Reference:
%
%    Arthur Stroud and Don Secrest,
%    Gaussian Quadrature Formulas,
%    Prentice Hall, 1966.
%
%  Parameters:
%
%    Input, real X, the approximate root, which
%    should be improved on output.
%
%    Input, integer NORDER, the order of the polynomial to be computed.
%
%    Input, real ALPHA, the exponent of the X factor.
%
%    Input, real B(NORDER), C(NORDER), the recursion coefficients.
%
%    Output, real X, the approximate root, which
%    should be improved on output.
%
%    Output, real DP2, the value of L'(NORDER)(X).
%
%    Output, real P1, the value of L(NORDER-1)(X).
%
  maxstep = 10;

  eps = d_epsilon ( x );

  for i = 1 : maxstep

    [ p2, dp2, p1 ] = laguerre_recur ( x, norder, alpha, b, c );

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

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

  end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function [ p2, dp2, p1 ] = laguerre_recur ( x, norder, alpha, b, c )

%% LAGUERRE_RECUR finds the value and derivative of a Laguerre
%polynomial.
%
%  Modified:
%
%    12 October 2005
%
%  Reference:
%
%    Arthur Stroud and Don Secrest,
%    Gaussian Quadrature Formulas,
%    Prentice Hall, 1966.
%
%  Parameters:
%
%    Input, real X, the point at which polynomials are evaluated.
%
%    Input, integer NORDER, the order of the polynomial to be computed.
%
%    Input, real ALPHA, the exponent of the X factor in the
%    integrand.
%
%    Input, real B(NORDER), C(NORDER), the recursion
%    coefficients.
%
%    Output, real P2, the value of L(NORDER)(X).
%
%    Output, real DP2, the value of L'(NORDER)(X).
%
%    Output, real P1, the value of L(NORDER-1)(X).
%
  p1 = 1.0;
  dp1 = 0.0;

  p2 = x - alpha - 1.0;
  dp2 = 1.0;

  for i = 2 : norder

    p0 = p1;
    dp0 = dp1;

    p1 = p2;
    dp1 = dp2;

    p2 = ( x - b(i) ) * p1 - c(i) * p0;
    dp2 = ( x - b(i) ) * dp1 + p1 - c(i) * dp0;

  end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


function geometry_test0205 ( )

%*****************************************************************************80
%
%% TEST0205 tests DEGREES_TO_RADIANS, RADIANS_TO_DEGREES.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST0205\n' );
  fprintf ( 1, '  DEGREES_TO_RADIANS converts an angle from degrees\n' );
  fprintf ( 1, '    to radians;\n' );
  fprintf ( 1, '  RADIANS_TO_DEGREES converts an angle from radians\n' );
  fprintf ( 1, '    to degrees;\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Degrees     Radians     Degrees\n' );
  fprintf ( 1, '\n' );

  for i = -2 : 14
    angle_deg = 30 * i;
    angle_rad = degrees_to_radians ( angle_deg );
    angle_deg2 = radians_to_degrees ( angle_rad );
    fprintf ( 1, '  %10f  %10f  %10f\n', angle_deg, angle_rad, angle_deg2 );
  end

  return
end


% J. C. Spall, March 1999
% This code evaluates the basic root-finding (R-M) SA algorithm.  Computes sample mean
% and standard deviation of the mean from Navg realizations.
%
n=1000;
randn('seed',71111113)
a=0.081;
A=5.1;
alpha=.501;
s=.1;
theta_0=[1,1]';
Navg=2000;
loss_eq2_5(theta_0)
rslossavg=0;
rslossavgsq=0;
for i=1:Navg
  theta=theta_0;
  for k=1:n
    theta=theta-(a/(k+A)^alpha)*gradloss(theta,s)';
  end
  rslossavg=(i-1)*rslossavg/i+loss_eq2_5(theta)/i;
  rslossavgsq=(i-1)*rslossavgsq/i+(loss_eq2_5(theta)^2)/i;
end
mean=rslossavg
stdevmean=(((Navg/(Navg-1))*(rslossavgsq-mean^2))^.5)/(Navg^.5)


function a = rutis1_inverse ( )

%*****************************************************************************80
%
%% RUTIS1_INVERSE returns the inverse of the RUTIS1 matrix.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    20 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Joan Westlake,
%    A Handbook of Numerical Matrix Inversion and Solution of
%    Linear Equations,
%    John Wiley, 1968,
%    ISBN13: 978-0471936756,
%    LC: QA263.W47.
%
%  Parameters:
%
%    Output, real A(4,4), the matrix.
%

%
%  Note that the matrix entries are listed by row.
%
  a(1:4,1:4) = [ ...
    -2.0,  4.0,  4.0, -5.0; ...
     4.0, -2.0, -5.0,  4.0; ...
     4.0, -5.0, -2.0,  4.0; ...
    -5.0,  4.0,  4.0, -2.0 ];

  a(1:4,1:4) = a(1:4,1:4) / 15.0;

  return
end


%MESHND: creation and nested dissection of regular 2D and 3D meshes.
%
%   meshnd         - creation and nested dissection of a regular 2D or 3D mesh.
%   meshnd_quality - test the ordering quality computed by meshnd.
%   meshsparse     - convert a 2D or 3D mesh into a sparse matrix matrix.
%   meshnd_example - example usage of meshnd and meshsparse.
%
% The outputs of the meshnd example and meshnd_quality are in meshd.png,
% meshnd_quality_out.txt, and meshnd_quality.png.
%
% Example:
%   % with no inputs or outputs, meshnd runs a demo:
%   meshnd
%
%   % create the sparse matrix for a 7-by-5-by-2 mesh:
%   A = meshsparse (meshnd (7,5,2)) ;
%
%   % create a 7-by-5-by-2 mesh and find the nested dissection ordering:
%   [G p] = meshnd (7,5,2) ;
%   A = meshsparse (G) ;
%   subplot (1,2,1) ; spy (A) ;
%   subplot (1,2,2) ; spy (A (p,p)) ;
%

% Copyright 2007-2009, Timothy A. Davis, Univ. of Florida
% VERSION 1.1.1, March 30, 2009


function [ c, e ] = polynomial_sort ( o, c, e )

%*****************************************************************************80
%
%% POLYNOMIAL_SORT sorts the information in a polynomial.
%
%  Discussion;
%
%    The coefficients C and exponents E are rearranged so that
%    the elements of E are in ascending order.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 November 2013
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer O, the "order" of the polynomial.
%
%    Input/output, real C(O), the coefficients of the polynomial.
%
%    Input/output, integer E(O), the indices of the exponents of the polynomial.
%
  [ e, i ] = sort ( e );
  c = c(i);

  return
end


function b = r8col_normalize_li ( m, n, a )

%*****************************************************************************80
%
%% R8COL_NORMALIZE_LI normalizes an R8COL with the column infinity norm.
%
%  Discussion:
%
%    Each column is scaled so that the entry of maximum norm has the value 1.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    08 February 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns.
%
%    Input, real A(M,N), the array to be examined.
%
%    Output, real B(M,N), the normalize array.
%
  b(1:m,1:n) = a(1:m,1:n);

  for j = 1 : n
    c = a(1,j);
    for i = 2 : m
      if ( abs ( c ) < abs ( a(i,j) ) )
        c = a(i,j);
      end
    end
    if ( c ~= 0.0 )
      b(1:m,j) = b(1:m,j) / c;
    end
  end

  return
end


function jacobi_rule ( order, alpha, beta, a, b, filename )

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

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

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

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

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

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

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

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

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

  temp2 = 0.5;

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

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

  if ( kind == 1 )

    ab = 0.0;

    zemu = 2.0 / ( ab + 1.0 );

    aj(1:m) = 0.0;

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

  elseif ( kind == 2 )

    zemu = pi;

    aj(1:m) = 0.0;

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

  elseif ( kind == 3 )

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

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

  elseif ( kind == 4 )

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

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

  elseif ( kind == 5 )

    zemu = gamma ( alpha + 1.0 );

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

  elseif ( kind == 6 )

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

    aj(1:m) = 0.0;

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

  elseif ( kind == 7 )

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

    aj(1:m) = 0.0;

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

  elseif ( kind == 8 )

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

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

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

  end

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

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

  prec = eps;

  if ( n == 1 )
    return
  end

  e(n) = 0.0;

  for l = 1 : n

    j = 0;

    while ( 1 )

      for m = l : n

        if ( m == n )
          break
        end

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

      end

      p = d(l);

      if ( m == l )
        break
      end

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

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

      for ii = 1 : mml

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

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

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

      end

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

    end

  end

  for ii = 2 : n

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

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

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

  end

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

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

  return
end
function value = r8_sign ( x )

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

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

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

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

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

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

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

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

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

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

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

  parchk ( kind, 1, alpha, beta )

  if ( kind == 1 )

    al = 0.0;
    be = 0.0;

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

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

  elseif ( kind == 2 )

    al = -0.5;
    be = -0.5;

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

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

  elseif ( kind == 3 )

    al = alpha;
    be = alpha;

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

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

  elseif ( kind == 4 )

    al = alpha;
    be = beta;

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

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

  elseif ( kind == 5 )

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

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

  elseif ( kind == 6 )

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

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

  elseif ( kind == 7 )

    al = alpha;
    be = 0.0;

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

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

  elseif ( kind == 8 )

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

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

  elseif ( kind == 9 )

    al = 0.5;
    be = 0.5;

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

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

  end

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

  for k = 1 : nt

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

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

  end

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

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

%
%  Exit if the zero-th moment is not positive.
%
  if ( zemu <= 0.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'SGQF - Fatal error!\n' );
    fprintf ( 1, '  ZEMU <= 0.\n' );
    error ( 'SGQF - Fatal error!' );
  end
%
%  Set up vectors for IMTQLX.
%
  wts = zeros ( nt, 1 );
  wts(1) = sqrt ( zemu );
  wts(2:nt) = 0.0;
%
%  Diagonalize the Jacobi matrix.
%
  [ t, wts ] = imtqlx ( nt, aj, bj, wts );

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

  return
end
function timestamp ( )

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

  return
end


%achievability bound for AWGN channel under a long-term power constraint
%

function rate_ach_lt=awgn_ach_lt(snr_db, nn, error)

snr = 10^(snr_db);

rate_ach_lt = zeros(1,length(nn)); %achievable rate (kappa beta)

%Check whether a long-term power constraint will be beneficial
C=log(1+snr);
V = 1-1/(1+snr)^2;
n_min = ( (1+snr)/snr*sqrt(2*pi*snr)*(1-error)*exp(qfuncinv(error)^2/2) + qfuncinv(error)/(1+snr)^2/sqrt(V))^2;

n_index=find(nn <= n_min);

if length(n_index)>0
    rate_ach_lt(n_index) = kappabeta_ach(2*nn(n_index),error,snr,1)./nn(n_index); %use the kappa beta bound for short-term power constraint
end

index_large_n = find(nn>n_min);

number_taus=20; %increase this number of gain tightness (at the cost of complexity)
number_errors=20; %increase this number of gain tightness (at the cost of complexity)

for index_n= index_large_n
    n=nn(index_n);
    %tic
    disp(['ach_awgn_lt():  n=', num2str(n)]);

    temp_rate_arr=[];
    for error_n = (error/number_errors): (error /number_errors): (error * (number_errors-1)/number_errors)
        %ach SISO kappa beta bound
        P_n= snr*(1-error_n)./(1-error);
        tau_array = (error_n/number_taus) : (error_n/number_taus): (error_n*(number_taus-1)/number_taus);
        for tau = tau_array
            temp_rate = (log2(kappa_inf(tau, P_n)) - betaq_up_v2(1-error_n+tau, 2*n, P_n))/n;
            temp_rate_arr=[temp_rate_arr,temp_rate];
        end
        rate_ach_lt(index_n)=max(temp_rate_arr);
    end
end


function x = mono_upto_next_grlex ( m, n, x )

%*****************************************************************************80
%
%% MONO_UPTO_NEXT_GRLEX: grlex next monomial with total degree up to N.
%
%  Discussion:
%
%    We consider all monomials in an M dimensional space, with total
%    degree up to N.
%
%    For example:
%
%    M = 3
%    N = 3
%
%    #  X(1)  X(2)  X(3)  Degree
%      +------------------------
%    1 |  0     0     0        0
%      |
%    2 |  0     0     1        1
%    3 |  0     1     0        1
%    4 |  1     0     0        1
%      |
%    5 |  0     0     2        2
%    6 |  0     1     1        2
%    7 |  0     2     0        2
%    8 |  1     0     1        2
%    9 |  1     1     0        2
%   10 |  2     0     0        2
%      |
%   11 |  0     0     3        3
%   12 |  0     1     2        3
%   13 |  0     2     1        3
%   14 |  0     3     0        3
%   15 |  1     0     2        3
%   16 |  1     1     1        3
%   17 |  1     2     0        3
%   18 |  2     0     1        3
%   19 |  2     1     0        3
%   20 |  3     0     0        3
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 September 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, the spatial dimension.
%
%    Input, integer N, the maximum degree.
%    0 <= N.
%
%    Input, integer X(M), the current monomial.
%    To start the sequence, set X = [ 0, 0, ..., 0, 0 ].
%
%    Output, integer X(M), the next monomial.
%    The last value in the sequence is X = [ N, 0, ..., 0, 0 ].
%
  if ( n < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'MONO_UPTO_NEXT_GRLEX - Fatal error!\n' );
    fprintf ( 1, '  N < 0.\n' );
    error ( 'MONO_UPTO_NEXT_GRLEX - Fatal error!' );
  end

  if ( sum ( x(1:m) ) < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'MONO_UPTO_NEXT_GRLEX - Fatal error!\n' );
    fprintf ( 1, '  Input X sums to less than 0.\n' );
    error ( 'MONO_UPTO_NEXT_GRLEX - Fatal error!' );
  end

  if ( n < sum ( x(1:m) ) )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'MONO_UPTO_NEXT_GRLEX - Fatal error!\n' );
    fprintf ( 1, '  Input X sums to more than N.\n' );
    error ( 'MONO_UPTO_NEXT_GRLEX - Fatal error!' );
  end

  if ( n == 0 )
    return
  end

  if ( x(1) == n )
    x(1) = 0;
  else
    x = mono_next_grlex ( m, x );
  end

  return
end


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

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

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

% ====================== YOUR CODE HERE ======================
% Instructions: Fill in this function to return training errors in
%               error_train and the validation errors in error_val. The
%               vector lambda_vec contains the different lambda parameters
%               to use for each calculation of the errors, i.e,
%               error_train(i), and error_val(i) should give
%               you the errors obtained after training with
%               lambda = lambda_vec(i)
%
% Note: You can loop over lambda_vec with the following:
%
%       for i = 1:length(lambda_vec)
%           lambda = lambda_vec(i);
%           % Compute train / val errors when training linear
%           % regression with regularization parameter lambda
%           % You should store the result in error_train(i)
%           % and error_val(i)
%           ....
%
%       end
%
%
for i=1:length(lambda_vec)
	lambda=lambda_vec(i);
	[theta]=trainLinearReg(X, y, lambda);
	lambda=0;	% Set to zero when calculating error since already been trained
	% We are calc J as error not as cost. So, lambda should not be included when
	% calculating error for thetas that have been trained, else it will be biased
	% Refer to 2.1 of Exercise 5, error is computed without lambda
	[e_train]=linearRegCostFunction(X, y, theta, lambda);
	[e_val]=linearRegCostFunction(Xval, yval, theta, lambda);	% J over all CV set for new set of theta

% Accumulating error from i=1:m
	if (i==1)
		error_train=e_train;
		error_val=e_val;
	else
		error_train=[error_train; e_train];
		error_val=[error_val; e_val];
	end
end

% Above methods are also accepted when submitted, following method are also accepted

%for i=1:length(lambda_vec)
%lambda=lambda_vec(i);
%[theta] = trainLinearReg(X, y, lambda);

% For training set
%m=length(y);
%thetas=theta(2:end,1);
%h=X*theta;
%lambda=0;
%error_train(i)=(1/(2.*m))*sum((h-y).^2)+(lambda/(2.*m)).*sum(thetas.^2);

% For CV set
%n=length(yval);
%h2=Xval*theta;
%lambda=0;
%error_val(i)=(1/(2.*n))*sum((h2-yval).^2)+(lambda/(2.*n)).*sum(thetas.^2);
%end

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

end


function value = cn_jac_monomial_integral ( n, alpha, beta, expon )

%*****************************************************************************80
%
%% CN_JAC_MONOMIAL_INTEGRAL: integral of a monomial with Jacobi weight over CN.
%
%  Discussion:
%
%    value = integral ( CN )
%      product ( 1 <= i <= n ) x(I)^expon(i) (1-x(i))^alpha (1+x(i))^beta dx(i)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    27 January 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the spatial dimension.
%
%    Input, real ALPHA, the exponent of (1-X) in the weight factor.
%
%    Input, real BETA, the exponent of (1+X) in the weight factor.
%
%    Input, integer EXPON(N), the exponents.
%
%    Output, real VALUE, the value of the integral.
%
  value = 1.0;
  for i = 1 : n
    value2 = c1_jac_monomial_integral ( alpha, beta, expon(i) );
    value = value * value2;
  end

  return
end


classdef GaussianMultC
%%GAUSSIANMULTC A collection of functions for the Gaussian multivariate
%               copulae. Implemented functions are: PDF.
%
%REFERENCES:
%[1] H. Joe and D. Kurowicka, Dependence Modeling: Vine Copula Handbook.
%    World Scientific, 2011.
%
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

    methods(Static)
        function jprob = PDF(u,R)
        %PDF Generates a joint probability for column vector u or a row
        %    vector of joint probabilities for matrix u with each column as
        %    the input vector.
        %
        %INPUTS: u: A d-by-n matrix where each column represents a
        %           d-dimensional random vector and n is the number of
        %           random vectors. Entries must be in [0,1].
        %        R: A d-by-d correlation matrix.
        %
        %October 2020 Codie T. Lewis, Naval Research Laboratory, Washington D.C.
        %
        if ~exist('u','var') || isempty(u)
            jprob = [];
            return
        end

        s2 = size(u,2);
        I = eye(size(R));
        jprob = zeros(1,s2);

        for col = 1:s2
            v = GaussianD.invCDF(u(:,col));
            jprob(col) = exp(-0.5*v'*(inv(R)-I)*v)/sqrt(det(R));
        end
        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 to calculate lcm of two number a and b using gcd of two numbers.

function [ret] =  lcm(a, b)
    if b == 0
       re = a;
       ret=(a*b)/re;    % i.e zero

    else
       re = gcd(b, mod(a, b));
       ret=(a*b)/re;
    end


function [out] = percolation_3(S,Smax)
%percolation_3

% Copyright (C) 2019, 2021 Wouter J.M. Knoben, Luca Trotter
% This file is part of the Modular Assessment of Rainfall-Runoff Models
% Toolbox (MARRMoT).
% MARRMoT is a free software (GNU GPL v3) and distributed WITHOUT ANY
% WARRANTY. See <https://www.gnu.org/licenses/> for details.

% Flux function
% ------------------
% Description:  Non-linear percolation (empirical)
% Constraints:  -
% @(Inputs):    S    - current storage [mm]
%               Smax - maximum contributing storage [mm]

out = Smax^(-4)./(4)*(4/9)^(4)*S^5;

end