function [ X ] = hyperFcls( M, U )
%HYPERFCLS Performs fully constrained least squares on pixels of M.
% hyperFcls performs fully constrained least squares of each pixel in M
% using the endmember signatures of U.  Fully constrained least squares
% is least squares with the abundance sum-to-one constraint (ASC) and the
% abundance nonnegative constraint (ANC).
%
% Usage
%   [ X ] = hyperFcls( M, U )
% Inputs
%   M - HSI data matrix (p x N)
%   U - Matrix of endmembers (p x q)
% Outputs
%   X - Abundance maps (q x N)
%
% References
%   "Fully Constrained Least-Squares Based Linear Unmixing." Daniel Heinz,
% Chein-I Chang, and Mark L.G. Althouse. IEEE. 1999.
%
% Written by
%    Matlab Hyperspectral Toolbox - Toolbox of advanced algorithms for
%    hyperspectral processing and exploitation.
%    http://sourceforge.net/apps/mediawiki/matlabhyperspec/index.php?title=Main_Page.
%    Toolbox Available at http://sourceforge.net/projects/matlabhyperspec/.

if (ndims(U) ~= 2)
    error('M must be a p x q matrix.');
end

[p1, N] = size(M);
[p2, q] = size(U);
if (p1 ~= p2)
    error('M and U must have the same number of spectral bands.');
end

p = p1;
X = zeros(q, N);
Mbckp = U;
for n1 = 1:N
    count = q;
    done = 0;
    ref = 1:q;
    r = M(:, n1);
    U = Mbckp;
    while not(done)
        als_hat = inv(U.'*U)*U.'*r;
        s = inv(U.'*U)*ones(count, 1);

        % IEEE Magazine method (http://www.planetary.brown.edu/pdfs/3096.pdf)
        % Contains correction to sign.  Error in original paper.
        afcls_hat = als_hat - inv(U.'*U)*ones(count, 1)*inv(ones(1, count)*inv(U.'*U)*ones(count, 1))*(ones(1, count)*als_hat-1);

        % See if all components are positive.  If so, then stop.
        if (sum(afcls_hat>0) == count)
            alpha = zeros(q, 1);
            alpha(ref) = afcls_hat;
            break;
        end
        % Multiply negative elements by their counterpart in the s vector.
        % Find largest abs(a_ij, s_ij) and remove entry from alpha.
        idx = find(afcls_hat<0);
        afcls_hat(idx) = afcls_hat(idx) ./ s(idx);
        [val, maxIdx] = max(abs(afcls_hat(idx)));
        maxIdx = idx(maxIdx);
        alpha(maxIdx) = 0;
        keep = setdiff(1:size(U, 2), maxIdx);
        U = U(:, keep);
        count = count - 1;
        ref = ref(keep);
    end
    X(:, n1) = alpha;
end

return;


% DEMO  --  Chebyshev Polynomial Multivariate Interpolation
% UPDATED  --  October 28, 2013
% Written by Matthew Kelly, Cornell University
%
% This script demonstrates how to approximate a multivariable function with
% a chebyshev polynomial interpolant. Here we use it to approximate the
% position and velocity of a simple harmonic oscillator.
%

%What order chebyshev polynomial to use?
order = 25;

%set up the time span for the system integration using ode45
tspan = [0,1];
nTime = 1001;

%Initial conditions for the simple harmonic oscillator
z0 = [0.25;0];   %[Position, Velocity]

%Physical parameters for the simple harmonic osciallator
P.m = 0.1;
P.c = 0.4;
P.k = 100;

%Function handle for the simple harmonic oscillator
userFunc = @(t,z)simpleHarmonicOscillator(z,P);

%Use ode45 to get the solution
Options = odeset(...
    'RelTol',1e-10,...   %ode45 complains if reltol is much smaller
    'AbsTol',1e-10);
sol = ode45(userFunc,tspan,z0,Options);

%Get the "exact" solution at each point in tspan
time = linspace(tspan(1),tspan(2),nTime);
z = deval(sol,time);
pos = z(1,:);
vel = z(2,:);

%Plot ode45 stuff
figure(404); clf
subplot(2,1,1); hold on
    plot(time,pos,'r-','LineWidth',2)
    title('Position')
    xlabel('Time')
    ylabel('Position')
subplot(2,1,2); hold on
    plot(time,vel,'r-','LineWidth',2)
    title('Velocity')
    xlabel('Time')
    ylabel('Velocity')

%% Chebyshev Stuff

IO.input = time;
IO.output = z;

%Check the grid points
[f,d,x] = chebyshevFit(IO, order);
subplot(2,1,1);
    plot(x,f(1,:),'ko','MarkerSize',7,'LineWidth',1)
subplot(2,1,2);
    plot(x,f(2,:),'ko','MarkerSize',7,'LineWidth',1)

%Check the interpolation
tic
y = chebyshevInterpolate(f,time,d);
toc
posCheck = y(1,:);
velCheck = y(2,:);

%Plots for the chebyshev interpolant
subplot(2,1,1);
    plot(time,posCheck,'k:','LineWidth',1)
    legend('ode45','chebPts','cheb-pos')
subplot(2,1,2);
    plot(time,velCheck,'k:','LineWidth',1)
legend('ode45','chebPts','cheb-vel')


classdef linear_svm
% This file defines l2-regularized SVM problem
%
% Inputs:
%       x_train     train data matrix of x of size dxn.
%       y_train     train data vector of y of size 1xn.
%       x_test      test data matrix of x of size dxn.
%       y_test      test data vector of y of size 1xn.
%       lambda      l2-regularized parameter.
% Output:
%       Problem     problem instance.
%
%
% The problem of interest is defined as
%
%           min f(w) = 1/n * sum_i^n f_i(w),
%           where
%           f_i(w) = 1/2 * (max(0.0, 1 - y_i .* (w'*x_i) )^2 + lambda/2 * w^2.
%
% "w" is the model parameter of size d vector.
%
%
% This file is part of GDLibrary and SGDLibrary.
%
% Created by H.Kasai on Feb. 17, 2016
% Modified by H.Kasai on Mar. 23, 2018

    properties
        name;
        dim;
        samples;
        lambda;
        classes;
        hessain_w_independent;
        d;
        n_train;
        n_test;
        x_train;
        y_train;
        x_test;
        y_test;
        x_norm;
        x;
    end

    methods
        function obj = linear_svm(x_train, y_train, x_test, y_test, varargin)

            obj.x_train = x_train;
            obj.y_train = y_train;
            obj.x_test = x_test;
            obj.y_test = y_test;

            if nargin < 5
                obj.lambda = 0.1;
            else
                obj.lambda = varargin{1};
            end

            obj.d = size(x_train, 1);
            obj.n_train = length(y_train);
            obj.n_test = length(y_test);

            obj.name = 'linear_svm';
            obj.dim = obj.d;
            obj.samples = obj.n_train;
            obj.classes = 2;
            obj.hessain_w_independent = false;
            obj.x_norm = sum(obj.x_train.^2,1);
            obj.x = obj.x_train;
        end

        function f = cost(obj, w)

            f_sum = 0.5 * sum(max(0.0, 1 - obj.y_train' .*(w'*obj.x_train)').^2);
            f = f_sum/obj.n_train + obj.lambda/2 * w(:)'*w(:);

        end

        function g = grad(obj, w, indices)

            alpha = w' * obj.x_train(:,indices);
            flag = obj.y_train(indices) .* alpha;
            flag(flag<1.0) = 1;
            flag(flag>1.0) = 0;

            coeff = flag' .* (1 - obj.y_train(indices)' .* alpha') .* obj.y_train(indices)';
            coeff = coeff';
            coeff = repmat(coeff,[obj.d 1]);
            g = obj.lambda * w - sum(coeff .* obj.x_train(:,indices),2)/length(indices);

        end

        function g = full_grad(obj, w)

            g = obj.grad(w, 1:obj.n_train);

        end

        function h = hess(obj, w, indices)

            alpha = w' * obj.x_train(:,indices);
            flag = obj.y_train(indices) .* alpha;
            flag_indices = flag<1.0;

            x_part_new = obj.x_train(:,indices);
            x_part_new = x_part_new(:,flag_indices);

            h = obj.lambda * eye(obj.d) + x_part_new * x_part_new'/length(indices);
        end

        function hv = hess_vec(obj, w, v, indices)

            alpha = w' * obj.x_train(:,indices);
            flag = obj.y_train(indices) .* alpha;
            flag_indices = flag<1.0;

            x_part_new = obj.x_train(:,indices);
            x_part_new = x_part_new(:,flag_indices);

            hv = obj.lambda * v + (x_part_new * (x_part_new'*v) )/length(indices);
        end

        function p = prediction(obj, w)

            p = w' * obj.x_test;

            class1_idx = p>0;
            class2_idx = p<=0;
            p(class1_idx) = 1;
            p(class2_idx) = -1;

        end

        function a = accuracy(obj, y_pred)

            a = sum(y_pred == obj.y_test) / obj.n_test;

        end

        function w_opt = calc_solution(obj, maxiter, method)

            if nargin < 3
                method = 'lbfgs';
            end

            options.max_iter = maxiter;
            options.verbose = true;
            options.tol_optgap = 1.0e-24;
            options.tol_gnorm = 1.0e-16;
            options.step_alg = 'backtracking';

            if strcmp(method, 'sd')
                [w_opt,~] = sd(obj, options);
            elseif strcmp(method, 'cg')
                [w_opt,~] = ncg(obj, options);
            elseif strcmp(method, 'newton')
                options.sub_mode = 'INEXACT';
                options.step_alg = 'non-backtracking';
                [w_opt,~] = newton(obj, options);
            else
                options.step_alg = 'backtracking';
                options.mem_size = 5;
                [w_opt,~] = lbfgs(obj, options);
            end
        end
    end

end


function dist = imDistance(varargin)
%IMDISTANCE Distance map computed from a set of points
%
%   DIST = imDistance(DIM, POINTS);
%   Create a distance map of the point given by POINTS, in the image with
%   size given by DIM = [NY NX].
%   POINTS is a N-by-2 array of double containing point coordinates
%
%   DIST = imDistance(LX, LY, POINTS)
%   Specify the position of vertices along each axis. See meshgrid for
%   details.
%
%   DIST = imDistance(..., N)
%   Use N point randomly and independently created inside the image bounds.
%
%   DIST = imDistance(..., EDGE)
%   Also specify edge condition. EDGE can be one of:
%   - 'free': regions touching image borders are removed
%   - 'periodic': copy the set of points to simulate periodic set
%   - 'remove': image edges will be set to distance 0, and neighbor pixels
%       set accordingly.
%
%   TODO: manage different types of distance (now is only euclidian).
%
%   Example
%   % basic example with integer coordinates
%     img = imDistance([100 100], [10 10;90 90;90 10;10 90;50 50]);
%     imshow(img, [0 max(img(:))]);
%
%   % specify floating coordinates, with periodic edge conditions
%     lx = 1:100;
%     ly = 1:100;
%     pts = [10.2 10.3;90.4 90.5; 10.8 90.8;50.1 50.0]
%     img = imDistance(lx, ly, pts, 'periodic');
%     figure; imshow(img, [0 max(img(:))]);
%

%   ---------
%   author : David Legland
%   INRA - TPV URPOI - BIA IMASTE
%   created the 16/06/2004.
%

%   HISTORY
%   28/06/2004 use faster algorithm
%   22/05/2006 allocate d1 and d2 only once (should be faster)
%   29/05/2009 add possibility to specify grid with meshgrid-like syntax

%% Extract input arguments

% default parameters values
points      = [];       % points array
N           = 20;       % default number of germs
edgecond    = 'free';   % edge condition
lx = 1:100;
ly = 1:100;

% extraction of image dimensions
if ~isempty(varargin)
    var = varargin{1};
    if size(var, 1) > 1 && size(var, 2) > 2
        % case of a 2x3 matrix with starting position, increment, end
        % position for each coordinate
        lx = var(1,1):var(1,2):var(1,3);
        ly = var(2,1):var(2,2):var(2,3);
        varargin(1) = [];

    elseif size(var, 1) == 1 && size(var, 2) == 2
        % first argument contains the size of the output image
        lx = 1:var(2);
        ly = 1:var(1);
        varargin(1) = [];

    elseif length(varargin) > 1
        % first and second arguments contain vector for each coordinate
        % respectively
        lx = varargin{1};
        ly = varargin{2};
        varargin(1:2) = [];

    else
        error('wrong input arguments in imDistance');
    end
end

% extraction of points, or number of points
if ~isempty(varargin)
    var = varargin{1};

    if length(var)>1    % use an array of germs
        points = var;
    else                % get number of germs
        N = var;
    end

    varargin(1) = [];
end

% extraction of edge condition
if ~isempty(varargin)
    edgecond = varargin{1};
end

%% Initialisations

% create array of points, if does not exist
if isempty(points)
    % generation of germs array
    points = zeros(N, 2);
    for i = 1:N
        points(i,1) = rand * lx(end) + lx(1);
        points(i,2) = rand * ly(end) + ly(1);
    end
end

% number of points
N = size(points, 1);

% size of output image
Nx = length(lx);
Ny = length(ly);

% create periodic conditions if needed
if strcmp(edgecond, 'periodic')
    % compute size of the box
    wx = lx(end)  + lx(2) - 2*lx(1);
    wy = ly(end)  + ly(2) - 2*ly(1);

    points = repmat(points, [9 1]);
    for i = [1 2 3]
        points((i-1)*N+1:i*N, 1) = points((i-1)*N+1:i*N, 1) - wx;
    end

    for i = [7 8 9]
        points((i-1)*N+1:i*N, 1) = points((i-1)*N+1:i*N, 1) + wx;
    end

    for i = [1 4 7]
        points((i-1)*N+1:i*N, 2) = points((i-1)*N+1:i*N, 2) - wy;
    end

    for i = [3 6 9]
        points((i-1)*N+1:i*N, 2) = points((i-1)*N+1:i*N, 2) + wy;
    end

    % re-compute number of points
    N = size(points, 1);
end

%% Generation of distance function

% allocate memory
dist = Nx * Ny * ones([Ny Nx]);

% pixels coordinates
[x, y] = meshgrid(lx, ly);

% update distance for each point
for p = 1:N
    dist = min(dist, hypot(x - points(p,1), y - points(p,2)));
end

%old algorithm, slower
%dist = zeros(dim);
%for i=1:dim(1)
    %disp (int2str(x));
    %for j=1:dim(2)
        %mat = points - ones(N,1)*[i j];
        %dist(i, j) = min(sqrt(diag(mat*mat')));
        % end
    %end

%% Optional processing for borders

% distance from borders of image
if strcmp(edgecond, 'remove')
    d1 = min(repmat((1:Ny)'-1, [1 Nx]), repmat((Ny:-1:1)'-1, [1 Nx]));
    dist = min(dist, d1);
    d1 = min(repmat((1:Nx)-1,  [Ny 1]), repmat((Nx:-1:1)-1,  [Ny 1]));
    dist = min(dist, d1);
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);

  % Compute train / val errors when training linear
  theta = trainLinearReg(X, y, lambda);

  error_train(i) = linearRegCostFunction(X, y, theta, 0);
  error_val(i) = linearRegCostFunction(Xval, yval, theta, 0);
end

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

end


% Draw various graphs obtained from the same point set.
%
%   output = drawSampleGraphs(input)
%
%   Example
%   drawSampleGraphs
%
%   See also
%

% ------
% Author: David Legland
% e-mail: david.legland@inrae.fr
% INRAE - BIA Research Unit - BIBS Platform (Nantes)
% Created: 2020-06-04,    using Matlab 9.8.0.1323502 (R2020a)
% Copyright 2020 INRAE.

%% Read input points

% read a set of 16 points within a [10 28]^2 bounding box
pts = load('sedgewick_points.txt');

% display the sample points
figure; axis equal; axis([10 28 10 28]); hold on;
drawPoint(pts, 'bo');
title('Sample points');

%% Delaunay Graph

% compute the graph
[nodes, edges] = delaunayGraph(pts);

% display the sample points
figure; axis equal; axis([10 28 10 28]); hold on;
drawPoint(pts, 'bo');

% display the graph
drawGraphEdges(nodes, edges);
title('Delaunay Graph');

%% Minimal Spanning Tree

% compute the graph
edges = euclideanMST(pts);

% display the sample points
figure; axis equal; axis([10 28 10 28]); hold on;
drawPoint(pts, 'bo');

% display the graph
drawGraphEdges(pts, edges);
title('Minimal Spanning Tree');

%% Relative Neighborhood Graph

% compute the graph
edges = relativeNeighborhoodGraph(pts);

% display the sample points
figure; axis equal; axis([10 28 10 28]); hold on;
drawPoint(pts, 'bo');

% display the graph
drawGraphEdges(pts, edges);
title('Relative Neighborhood Graph');

%% Gabriel Graph

% compute the graph
edges = gabrielGraph(pts);

% display the sample points
figure; axis equal; axis([10 28 10 28]); hold on;
drawPoint(pts, 'bo');

% display the graph
drawGraphEdges(pts, edges);
title('Gabriel Graph');


function [fx,dF_dX,dF_dTheta] = f_doubleWell(Xt,Theta,ut,inF)
% damped double Well Lyapunov evolution function
% function [f,J] = f_doubleWell(t,x,theta)
%
% This function computes the evolution function that comes from a .
% IN:
%   - t: time index (not used here)
%   - x: the current state of the system
%   - theta: a 2x1 vector parameter (containing the position of the two
%   wells.
% OUT:
%   - f: the current value of the evolution function
%   - J: the jacobbian of the system

deltat = inF.deltat;

a   = Theta(1);
b   = Theta(2);
k   = Theta(3);
x1  = Xt(1);
x2  = Xt(2);

f   = [ x2  ;  -2*(x1-a)*(x1-b)^2-2*(x1-a)^2*(x1-b)-k.*x2 ];
J   = [ 0                                               1
        -2*(x1-b)^2-8*(x1-a)*(x1-b)-2*(x1-a)^2        -k ];

fx                  = deltat.*f + Xt;
dF_dX               = deltat.*J' + eye(2);
dF_dTheta           = deltat.*[ 0 2*(x1-b)^2+4*(x1-a)*(x1-b)
                                0 4*(x1-a)*(x1-b)+2*(x1-a)^2
                                0 -x2                        ];


function Speciation
% Speciation
%    using MATLAB
%
%   $Ekkehard Holzbecher  $Date: 2006/05/03 $
%--------------------------------------------------------------------------
toll = 1.e-15;                    % tolerance
nmax = 50;                        % max. no. of iterations
Se = [-1 -1 1];                   % reaction matrix
logc = [1.e-10; 1.e-10; 0];       % initial guess (log)
logK = [-0.93];                   % equilibrium constants (log)
logu = [-0.301; 0];               % total concentrations (log)

ln10 = 2.3026;
n=size(Se,1); m=size(Se,2);
S1 = Se(:,1:m-n);
S2 = Se(:,m-n+1:m);
S1star = -S2\S1;
U = [eye(m-n),S1star'];

c=exp(ln10*logc);
u(1:m-n,1) = exp(ln10*logu);
err = toll+1; nit = 0;
while (nit < nmax & err > toll),
    nit = nit+1;
    F = [U*c-u; Se*log10(c)-logK];
    DF = [U; Se*diag((1/ln10)./c)];
    dc = -DF\F;
    cn = max(c+dc,0.005*abs(c));
    err = max(abs(cn-c));
    c = cn;
    logc = log10(c);
end
display (['Species concentrations obtained after ' num2str(nit) ' iterations:']);
c
exp(ln10*logK)-c(3)/c(1)/c(2)


function Ri = get_Ri(r_i, theta_i, sigma_r, sigma_theta)
% computes the covariance of the point p_i = r_i*[cos(theta_i); sin(theta_i)
% in cartesian coordinates

% first we compute the matrix square root of R, which consists of the
% Jacobian * sqrt(R_in_polar_coords)
Ri = [cos(theta_i) -r_i*sin(theta_i)
      sin(theta_i)  r_i*cos(theta_i) ] * diag([sigma_r sigma_theta]);

% and then we get the entire Ri
Ri = Ri * Ri';


function [Xco Tau MT] = HC_explicit_nh (Tin,TC,DE,HC,SE,DI,TS,TT,TBC,BC)
%
% DESCRIPTION:
%
% Explicit numerical method for one dimensional unsteady state
% heat transfer by conduction for non-homogenous material
%
% Basic PDE equation :
%
%     dT         d^2 T
%   ------ = TD ------             for 0 < x < DI  and  tau > 0
%    dtau        dx^2
%
% Principle of method :
%       ^
%  time |
%       |      m-1     m     m+1
%       |       |      |      |
%       |    ---+------x------+-----   p+1
%       |  dtau |      |      |
%       |    ---o------o------o-----   p
%       |  dtau |      |      |
%       |    ---+------+------+-----   p-1
%       |       |  dx  |  dx  |
%       |
%       +-------------------------------->
%                                        x
% Space description:
%                  DI
%   |<------------------------------>|
%   +   +   +   +   +  . . .     +   +
%   1   2   3   4   5           n-1  n
%   |<->|
%     SE
%
% Difference equation :
%
%   T(m,p+1) - T(m,p)      TD
%  ------------------- = ------- (T(m-1,p) - 2.T(m,p) + T(m+1,p))
%          TS             SE.SE
%
%       TD.TS
%  M = -------- <= 0,5
%       SE.SE
%
%  T(m,p+1) = M.T(m-1,p) + (1 - 2.M)T(m,p) + M.T(m+1,p)
%
%  T(m,p+1) = M(m-1).T(m-1,p) + (1 - (M(m-1)+M(m)))T(m,p) + M(m).T(m+1,p)
%  for m <2;n-1>
%
%  First-type boundary condition:
%    - temperatures T(1,p) and T(n,p) are given
%    - temperatures T(m,p) for m = 2, n-1 :
%      T(m,p+1) = M (T(m-1,p) + T(m+1,p)) + T(m,p).(1 - 2.M)
%
%  Second-type boundary condition:
%    - heat flux iQ(1,p) and iQ(n,p) are given
%    - temperature T(1,p) :
%                                   SE
%      T(1,p) = T(2,p-1) - iQ(1,p) ----
%                                   TC
%    - temperature T(n,p) :
%                                       SE
%      T(end,p) = T(n-1,p-1) - iQ(n,p) ----
%                                       TC
%    - temperatures T(m,p) for m = 2, n-1 :
%      T(m,p+1) = M (T(m-1,p) + T(m+1,p)) + T(m,p).(1 - 2.M)
%
%
% INPUTS:
%
% Tin  - initialization temperatures                        [ K           ]
% TC   - thermal conductivity                               [ W.m^-1.K^-1 ]
% DE   - density                                            [ kg.m^-3     ]
% HC   - specific heat capacity                             [ kg.m^-3     ]
% SE   - size of element                                    [ m           ]
% DI   - distance                                           [ m           ]
% TS   - time step                                          [ s           ]
% TT   - total time of simulation                           [ s           ]
% TBC  - type of boundary condition
%        (1 = first-type, 2 = second-type)                  [ -           ]
% BC   - boundary condition
%         - first-type : BC(1) = T(1),  BC(2) = T(n)        [ K           ]
%         - second-type: BC(1) = iQ(1), BC(2) = iQ(n)       [ W.m^-2      ]
%
% OUTPUTS:
%
% Xco  - vector of X coordinate                             [ m           ]
% Tau  - vector of time                                     [ s           ]
% MT   - matrix of temperatures                             [ K           ]
%
% AUXILIARY VARIABLE:
%
% r    - time  step  number                                 [ -           ]
% n    - space point number                                 [ -           ]
% TD   - thermal diffusivity                                [ m^2.m^-1    ]
% M    - modul (Fourier number)                             [ -           ]
%
% Copyright (C) 2013, Technical University of Kosice
% Author  : Zecova Monika, Terpak Jan
% Revision: 27.08.2013
%
  r = round(TT/TS) + 1;
  n = round(DI/SE) + 1;

  Xco = 0.0:SE:DI;
  Tau = 0.0:TS:TT;
  MT  = zeros(r,n);
  MT(1,:) = Tin;

  for j=2:r
    [T]     = explicit_nh (Tin,TC,DE,HC,SE,TS,TBC,BC);
    Tin     = T;
    MT(j,:) = Tin;
  end

end
function [T] = explicit_nh (Tin,TC,DE,HC,SE,TS,TBC,BC)

  n  = length(Tin);
  TD = zeros(1,n-1);
  for i=1:n-1
    TD(i)= TC(i)/(DE(i)*HC(i));
  end
  M  = TD*TS/(SE*SE);

  T  = Tin;

  if (M <= 0.5)

     if TBC == 1
        T(1)   = BC(1);
        T(end) = BC(2);
     end

     if TBC == 2
        T(1)   = T(2)   - BC(1)*SE/TC(1);
        T(end) = T(end-1) - BC(2)*SE/TC(end);
     end

     for m=2:length(Tin)-1
       T(m) = M(m-1)*Tin(m-1) + (1 - (M(m-1)+M(m)))*Tin(m) + M(m)*Tin(m+1);
     end
  else
     disp(['error: unstable solution, M must be <= 0,5; M = ' num2str(M)]);
  end
end


function isInside = bst_intriangle(A, B, C, P)
% BST_INTRIANGLE: Test if the orthogonal projection of points P on a triangle (A,B,C) are inside the triangle.

% @=============================================================================
% This function is part of the Brainstorm software:
% https://neuroimage.usc.edu/brainstorm
%
% Copyright (c) University of Southern California & McGill University
% This software is distributed under the terms of the GNU General Public License
% as published by the Free Software Foundation. Further details on the GPLv3
% license can be found at http://www.gnu.org/copyleft/gpl.html.
%
% FOR RESEARCH PURPOSES ONLY. THE SOFTWARE IS PROVIDED "AS IS," AND THE
% UNIVERSITY OF SOUTHERN CALIFORNIA AND ITS COLLABORATORS DO NOT MAKE ANY
% WARRANTY, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO WARRANTIES OF
% MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, NOR DO THEY ASSUME ANY
% LIABILITY OR RESPONSIBILITY FOR THE USE OF THIS SOFTWARE.
%
% For more information type "brainstorm license" at command prompt.
% =============================================================================@
%
% Authors: Francois Tadel, 2013

% Compute vectors
v0 = repmat(C - A, size(P,1), 1);
v1 = repmat(B - A, size(P,1), 1);
v2 = bst_bsxfun(@minus, P, A);

% Compute dot products
dot00 = sum(v0.^2, 2);
dot01 = sum(v0.*v1, 2);
dot02 = sum(v0.*v2, 2);
dot11 = sum(v1.^2, 2);
dot12 = sum(v1.*v2, 2);

% Compute barycentric coordinates
invDenom = 1 ./ (dot00 .* dot11 - dot01 .* dot01);
u = (dot11 .* dot02 - dot01 .* dot12) .* invDenom;
v = (dot00 .* dot12 - dot01 .* dot02) .* invDenom;

% Check if point is in triangle
isInside = (u >= 0) & (v >= 0) & (u + v < 1);


function value = r8_si ( x )

%*****************************************************************************80
%
%% R8_SI computes an approximation to the value of the sine integral.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2009
%
%  Author:
%
%    Original FORTRAN77 version by Wayne Fullerton.
%    MATLAB version by John Burkardt.
%
%  Parameters:
%
%    Input, real X, the argument of the sine integral.
%
%    Output, real VALUE, the value of the sine integral.
%
  nsics = 12;
  sics = [ ...
    -0.1315646598184841929, -0.2776578526973601892, ...
     0.0354414054866659180, -0.0025631631447933978, ...
     0.0001162365390497009, -0.0000035904327241606, ...
     0.0000000802342123706, -0.0000000013562997693, ...
     0.0000000000179440722, -0.0000000000001908387, ...
     0.0000000000000016670, -0.0000000000000000122 ];

  eta = 0.1 * eps;
  nsi = inits ( sics, nsics, 0.1 * eps );

  i = find ( abs ( x ) < sqrt ( eps ) );
  value(i) = x(i);

  j = find ( abs ( x ) <= 4.0 );
  value(j) = csevl ( ( x(j).^2 - 8.0 ) * 0.125, sics, nsi );
  value(j) = x(j) .* ( 0.75 + value(j) );

  k = find ( 4.0 < abs ( x ) );
  [ f, g ] = r89sifg ( abs ( x(k) ) );
  value(k) = 0.5 * pi - f .* cos ( abs ( x(k) ) ) - g .* sin ( x(k) );
  l = find ( x(k) < 0.0 );
  value(l) = - value(l);

  return
end


function result = square_unit_sum ( func, norder, xtab, ytab, weight )

%*****************************************************************************80
%
%% SQUARE_UNIT_SUM carries out a quadrature rule over the unit square.
%
%  Integration region:
%
%    Points (X,Y) such that
%
%      -1 <= X <= 1, and
%      -1 <= Y <= 1.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 May 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, external FUNC, the name of the function to be
%    integrated.  The user must declare the name an EXTERNAL
%    parameter in the calling program, pass the name of the
%    function in FUNC, and write a function of the form
%      function value = func ( x, y )
%    which evaluates the function at the point (X,Y).
%
%    Input, integer NORDER, the order of the rule.
%
%    Input, real XTAB(NORDER), YTAB(NORDER), the abscissas of
%    the rule.
%
%    Input, real WEIGHT(NORDER), the weights of the rule.
%
%    Output, real RESULT, the approximate integral of the function.
%
  quad = 0.0E+00;
  for i = 1 : norder
    quad = quad + weight(i) * feval ( func, xtab(i), ytab(i) ) / 4.0E+00;
  end

  volume = 1.0E+00;
  result = quad * volume;

  return
end


% NMFLAB for Signal Processing written by A. Cichocki and R. Zdunek
% in cooperation with other members of Laboratory for Advanced Brain Signal
% Processing, BSI, RIKEN, Saitama, JAPAN

function [x,grad_x,k] = nmf_proj_grad(b,A,x,tol,no_iter,beta_dec,loss_fun,beta)

% Projected Gradient Algorithm based on the Armijo rule
%
% [x, grad_x, k]=nmf_proj_grad(b,A,x,tol,no_iter,beta_dec,loss_fun,beta) finds
% such x that solves the equation Ax = b.
%
% INPUTS:
% b - data matrix of dimension [m by T]
% A - fixed matrix of dimension [m by r]
% x - initial guess
% tol - tolerance
% no_iter - maximum number of iterations
% beta_dec - multiplier of learning rate in descent gradient direction
% loss_fun - index for the loss function (1--4)
% beta - parameter "alpha" in the Amari alpha-divergence
%
% OUTPUTS:
% x - estimated matrix of dimension [r by T]
% grad_x - gradient of x
% k - number of performed iterations
%
% #########################################################################

if beta == 0
   loss_fun = 2;
end

sigma = 0.01; alpha = 1; kinc = 1;

for k=1:no_iter

 switch loss_fun

      case 1 % Frobenius

           res = b - A*x;
           grad_x = -A'*res;
           F = .5*norm(res,'fro')^2;
           lower_bound = 0;

      case 2 % KL

           bx = A*x;
           grad_x = A'*(1 - b./(bx + eps));
           F = sum(sum(b.*log(b./(bx + eps)) + bx - b));
           lower_bound = 0.1;

      case 3 % Dual KL

           bx = A*x;
           grad_x = A'*log(bx./b);
           F = sum(sum(bx.*log(bx./b) + b - bx));
           lower_bound = 1E-4;

      case 4 % Amari alpha divergence

           bx = A*x;
           grad_x = (1/beta)*A'*(1 - (b./bx).^beta);
           F = sum(sum(b.*((b./bx).^(beta - 1) - 1)/(beta^2 - beta) + (bx - b)/beta));
           lower_bound = 1E-2;

  end  % switch

  tol_grad = norm(grad_x(grad_x < lower_bound | x > lower_bound));
  if tol_grad < tol,
     break
  end

%  alpha = 1;
  s = 0;

% search step size
while (alpha > 1E-15) & (alpha < 1E8)

  s = s + 1;

  xn = max(x - alpha*grad_x,lower_bound);
  delta = xn-x;

   switch loss_fun

      case 1 % Frobenius

           Fn = .5*norm(b - A*xn,'fro')^2;

      case 2 % KL

           bx = A*xn;
           Fn = sum(sum(b.*log(b./(bx + eps)) + bx - b));

      case 3 % Dual KL

           bx = A*xn;
           Fn = sum(sum(bx.*log(bx./b) + b - bx));

      case 4 % Amari alpha divergence

           bx = A*xn;
           Fn = sum(sum(b.*((b./bx).^(beta - 1) - 1)/(beta^2 - beta) + (bx - b)/beta));

  end  % switch

  cond_alpha = ((Fn - F) <= sigma*grad_x(:)'*delta(:));

  if cond_alpha | (xn == x)
   % Increase
     if ~kinc & (s > 1), x = xn; break; end
     alpha = alpha/beta_dec;
     kinc = 1; xp = xn;
  else
   % Decrease
     if kinc & (s > 1), x = xp; alpha = alpha*beta_dec; break; end
     alpha = alpha*beta_dec;
     kinc = 0;
  end

end % while

end % for k
%


function [E1 E2] = cao_deneme(x,tao,mmax)
%x : time series
%tao : time delay
%mmax : maximum embedding dimension
%reference:Cao, L. (1997), ``Practical method for determining the minimum
%embedding dimension of a scalar time series'', Physcai D, 110, pp. 43-50.
%author:"Merve Kizilkaya"
N=length(x);
for m=1:mmax
    M=N-m*tao;
    Y=psr_deneme(x,m,tao,M);
    for n=1:M
        y0=ones(M,1)*Y(n,:);
        distance=max(abs(Y-y0),[],2);
        [neardis nearpos]=sort(distance);

        newpoint=[Y(n,:) x(n+m*tao)];
        newneig=[Y(nearpos(2),:) x(nearpos(2)+m*tao)];
        R1=max(abs(newpoint-newneig),[],2);

        a(n)=R1/neardis(2);
        d(n)=abs(x(n+m*tao)-x(nearpos(2)+m*tao));
    end
    E(m)=sum(a)/M;
    Ey(m)=sum(d)/M;
end
figure
E1=E(2:end)./E(1:end-1);
E2=Ey(2:end)./Ey(1:end-1);
plot(1:length(E1),E1,'k')
hold on
plot(1:length(E2),E2)
grid on
title('embedding dimension with cao method')
legend('E1','E2',4);

function Y=psr_deneme(x,m,tao,npoint)
%Phase space reconstruction
%x : time series
%m : embedding dimension
%tao : time delay
%npoint : total number of reconstructed vectors
%Y : M x m matrix
% author:"Merve Kizilkaya"
N=length(x);
if nargin == 4
    M=npoint;
else
    M=N-(m-1)*tao;
end

Y=zeros(M,m);

for i=1:m
    Y(:,i)=x((1:M)+(i-1)*tao)';
end


function [Ax,Ay,b,K] = convexhullConvex(varargin)
% Two lower bounds from tangents
% y > f(xL) + (x-xL)*df(xL)
% y > f(xU) + (x-xL)*df(xU)
% Upper bound from connecting extreme points
% y < f(xU)(x-xL)/(xU-xL) +  f(xL)(xU-x)/(xU-xL)
% can be written as
% Ax*x + Ay*y <= b

if rem(nargin,3)
    error('The convex hull generator assumes n triplets (x,f,df).')
end
m = nargin/3;
x = [varargin{(1:m)}]';
f = [varargin{(1:m)+m}]';
df = [varargin{(1:m)+2*m}]';

if df(1) == df(end)
    % This is a linear function
    % return y = f(1) + df*(x-x(1))
    Ax = df(1);
    Ay = -1;
    b = df(1)*x(1)-f(1);
    K.f = 1;
    K.l = 0;
    return
end

if all(diff(x)>=0) | all(diff(x(~isinf(x))))>=0 % Support [0 inf inf]
    Ay = [-ones(m,1);1];
    b  = [-f + x.*df; -f(end)*x(1)/(x(end)-x(1)) +  f(1)*x(end)/(x(end)-x(1))];
    Ax  = [df;-f(end)/(x(end)-x(1)) + f(1)/(x(end)-x(1))];

     % Don't use ill-conditioned cuts
    if df(1)<-1000
        Ax(1)=[];
        Ay(1) = [];
        b(1) = [];
    end
    if df(end-1)>1000
        Ax(end-1)=[];
        Ay(end-1) = [];
        b(end-1) = [];
    end
else
    Ax = [];
    Ay = [];
    b = [];
end
j = find(any(isnan([Ax Ay b]),2));
if ~isempty(j)
    b(j)=[];
    Ax(j,:)=[];
    Ay(j,:)=[];
end
K.f = 0;
K.l = length(b);
if 0
  sdpvar x y;plot(Ax*x+Ay*y <= b);
end


% Combined wire sizing and spacing
% Section 5.5,  L. Vandenberghe, S. Boyd, and A. El Gamal
% "Optimizing dominant time constant in RC circuits"
% Original by Lieven Vandenberghe
% Adapted for CVX by Joelle Skaf - 11/27/05
% Modified by Michael Grant - 3/8/06
%
% The problem is to determine the optimal sizes of interconnect wires and
% the optimal distances between them. We will consider an example with 3
% wires, each consisting of 5 segments (see paper, fig.21). The variables
% are the widths wij , and the distances s1 and s2 between the wires.
% The difference with the models used in other scripts is that we include a
% parasitic capacitance between the wires.
% The objective is to minimize the total width s1+s2.
% The problem can be formulated with the following SDP:
%               mimimize    s1 + s2
%                    s.t.   Tmax*G(w11,..,w35)-C(w11,..,w35,t11,..,t23) >=0
%                           1/t1j <= s1 - w1j - 0.5*w2j     , j = 1,..,5
%                           1/t2j <= s2 - w3j - 0.5*w2j     , j = 1,..,5
%                           0 <= tij <= 1         , i = 1,2 , j = 1,..,5
%                           t1 >=0, t2 >= 0, s1 >=smin, s2>=smin
%                           0 <= wij <= wmax
% the 2nd and 3rd constraints are nonlinear convex constraints that can be
% cast as 3 x 3-LMIs (Please refer to the paper for more details).

%
% Circuit parameters
%

n = 6;           % number of nodes per wire
N = 3*n;         % total number of nodes
m = n-1;         % number of segments per wire
alpha = 1;       % conductance per segment is is alpha*size
beta = 0.5;      % capacitance per segment is twice beta*size
gamma = 2;       % coupling capacitance is twice gamma*distance
G0 = 100;        % source conductance
C0 = [10,20,30]; % loads of first, second, third wires
wmin = 0.1;      % minimum width
wmax = 2.0;      % maximum width
smin = 1.0;      % minimum distance between wires
smax = 50;       % upper bound on s1 and s2  (meant to be inactive)

%
% Construct the capacitance and conductance matrices
%   C(x) = C0 + w11 * C1 + w21 * C2 + ...
%   G(x) = G0 + w11 * G1 + w21 * G2 + ...
% and we assemble the coefficient matrices together as follows:
%   CC = [ C0(:) C1(:) C2(:) ... ]
%   GG = [ G0(:) G1(:) G2(:) ... ]
%

CC = zeros(N,N,5*m+1);
GG = zeros(N,N,3*m+1);
for w = 0 : 2,
    % Constant terms
    CC(w*n+n,w*n+n,1) = C0(w+1);
    GG(w*n+1,w*n+1,1) = G0;
    for i = 1 : m,
        % capacitances to ground
        CC(w*n+[i,i+1],w*n+[i,i+1],w*m+i+1) = beta*[1,0;0,1];
        if w < 2,
            % coupling capacitors
            CC(w*n+[i,  n+i  ],w*n+[i,  n+i  ],(w+3)*m+i+1) = gamma*[1,-1;-1,1];
            CC(w*n+[i+1,n+i+1],w*n+[i+1,n+i+1],(w+3)*m+i+1) = gamma*[1,-1;-1,1];
        end
        % segment conductances
        GG(w*n+[i,i+1],w*n+[i,i+1],w*m+i+1) = alpha*[1,-1;-1,1];
    end
end
% Reshape for Matlab use
CC = reshape(CC,N*N,5*m+1);
GG = reshape(GG,N*N,3*m+1);

%
% Compute points the tradeoff curve and the two desired points
%

npts    = 50;
delays  = linspace( 85, 200, npts );
xdelays = [ 130, 90 ];
xnpts   = length(xdelays);
areas   = zeros(1,npts);
xareas  = zeros(1,xnpts);
for j = 1 : npts + xnpts,

    if j > npts,
        xj = j - npts;
        delay = xdelays(xj);
        disp( sprintf( 'Particular solution %d of %d (Tmax = %g)', xj, xnpts, delay ) );
    else,
        delay = delays(j);
        disp( sprintf( 'Point %d of %d on the tradeoff curve (Tmax = %g)', j, npts, delay ) );
    end

    %
    % Construct and solve the convex model
    %

    cvx_begin sdp quiet
        variables w(m,3) t(m,2) s(1,2)
        variable G(N,N) symmetric
        variable C(N,N) symmetric
        minimize( sum(s) )
        subject to
            G == reshape( GG * [ 1 ; w(:) ], N, N );
            C == reshape( CC * [ 1 ; w(:) ; t(:) ], N, N );
            delay * G - C >= 0;
            wmin <= w(:) <= wmax;
            t( : ) <= 1 / smin;
            s( : ) <= smax;
            inv_pos( t(:,1) ) <= s(1) - w(:,1) - 0.5 * w(:,2);
            inv_pos( t(:,2) ) <= s(2) - w(:,3) - 0.5 * w(:,2);
    cvx_end
    ss = cvx_optval;

    if j <= npts,
        areas(j) = ss;
    else,
        xareas(xj) = ss;

        %
        % Draw the wires
        %

        figure(4*xj-2);
        m2 = 2 * m;
        x1 = reshape( [ 1 : m ; 1 : m ], 1, m2 );
        x2 = x1( 1, end : -1 : 1 );
        y  = [ ss*ones(m2,1), s(2) + 0.5*w(x1,2), zeros(m2,1) ; ...
               ss-w(x2,1),    s(2) - 0.5*w(x2,2), w(x2,3)     ; ...
               ss,            s(2) + 0.5*w(1,2),  0           ];
        x1 = reshape( [ 0 : m - 1 ; 1 : m ], m2, 1 );
        x2 = x1( end : -1 : 1, 1 );
        x  = [ x1 ; x2 ; 0 ];
        hold off;
        fill( x, y, 0.9 * ones(size(y)) );
        hold on
        plot( x, y, '-' );
        axis( [-0.1, m+0.1,-0.1, ss+0.1]);
        colormap(gray);
        caxis([-1,1])
        title(sprintf('Solution (%d), Tmax = %g',xj,delay));

        %
        % Build the state space models and plot step responses
        %

        A = -inv(C)*G;
        T = linspace(0,2*delay,1000);
        B = -A * kron( eye(3), ones(n,1) );
        for inp = 1 : 3,
            figure(4*xj-2+inp);
            Y1 = simple_step(A,B(:,inp),T(2),length(T));
            hold off;
            plot(T,Y1([n,2*n,3*n],:),'-');
            hold on;
            text(T(1000),Y1(  n,1000),'v1');
            text(T(1000),Y1(2*n,1000),'v2');
            text(T(1000),Y1(3*n,1000),'v3');
            axis([0 2*delay -0.1 1.1]);
            % show dominant time constant
            plot(delay*[1;1], [-0.1;1.1], '--');
            title(sprintf('Solution (%d), Tmax = %g, step applied to wire %d',xj,delay,inp));
        end

    end

end

%
% Plot the tradeoff curve
%

figure(1);
ind = isfinite(areas);
plot(areas(ind), delays(ind));
xlabel('total width s_1 + s_2');
ylabel('dominant time constant');
title('Width-delay tradeoff curve')
hold on;
for k = 1 : xnpts,
    text( xareas(k), xdelays(k), sprintf( '(%d)', k ) );
end


function K = covMaternard(d, hyp, x, z, i)

% Matern covariance function with nu = d/2 and with Automatic Relevance
% Determination (ARD) distance measure. For d=1 the function is also known as
% the exponential covariance function or the Ornstein-Uhlenbeck covariance
% in 1d. The covariance function is:
%
%   k(x^p,x^q) = sf^2 * f( sqrt(d)*r ) * exp(-sqrt(d)*r)
%
% with f(t)=1 for d=1, f(t)=1+t for d=3 and f(t)=1+t+t²/3 for d=5.
% Here r is the distance sqrt((x^p-x^q)'*inv(P)*(x^p-x^q)), where the P matrix
% is diagonal with ARD parameters ell_1^2,...,ell_D^2, where D is the dimension
% of the input space and sf2 is the signal variance. The hyperparameters are:
%
% hyp = [ log(ell_1)
%         log(ell_2)
%          ..
%         log(ell_D)
%         log(sf) ]
%
% Copyright (c) by Hannes Nickisch, 2013-10-13.
%
% See also COVFUNCTIONS.M.

if nargin<3, K = '(D+1)'; return; end              % report number of parameters
if nargin<4, z = []; end                                   % make sure, z exists
xeqz = isempty(z); dg = strcmp(z,'diag');                       % determine mode

[n,D] = size(x);
ell = exp(hyp(1:D));
sf2 = exp(2*hyp(D+1));
if all(d~=[1,3,5]), error('only 1, 3 and 5 allowed for d'), end         % degree

switch d
  case 1, f = @(t) 1;               df = @(t) 1./t;     % df(t) = (f(t)-f'(t))/t
  case 3, f = @(t) 1 + t;           df = @(t) 1;
  case 5, f = @(t) 1 + t.*(1+t/3);  df = @(t) (1+t)/3;
end
          m = @(t,f) f(t).*exp(-t); dm = @(t,f) df(t).*exp(-t);

% precompute distances
if dg                                                               % vector kxx
  K = zeros(size(x,1),1);
else
  if xeqz                                                 % symmetric matrix Kxx
    K = sq_dist(diag(sqrt(d)./ell)*x');
  else                                                   % cross covariances Kxz
    K = sq_dist(diag(sqrt(d)./ell)*x',diag(sqrt(d)./ell)*z');
  end
end

if nargin<5                                                        % covariances
  K = sf2*m(sqrt(K),f);
else                                                               % derivatives
  if i<=D                                               % length scale parameter
    if dg
      Ki = zeros(size(x,1),1);
    else
      if xeqz
        Ki = sq_dist(sqrt(d)/ell(i)*x(:,i)');
      else
        Ki = sq_dist(sqrt(d)/ell(i)*x(:,i)',sqrt(d)/ell(i)*z(:,i)');
      end
    end
    K = sf2*dm(sqrt(K),f).*Ki;
    K(Ki<1e-12) = 0;                                    % fix limit case for d=1
  elseif i==D+1                                            % magnitude parameter
    K = 2*sf2*m(sqrt(K),f);
  else
    error('Unknown hyperparameter')
  end
end


function [Texp,Lexp]=lyapunov(n,rhs_ext_fcn,fcn_integrator,tstart,stept,tend,ystart,ioutp);
%
%    Lyapunov exponent calcullation for ODE-system.
%
%    The alogrithm employed in this m-file for determining Lyapunov
%    exponents was proposed in
%
%         A. Wolf, J. B. Swift, H. L. Swinney, and J. A. Vastano,
%        "Determining Lyapunov Exponents from a Time Series," Physica D,
%        Vol. 16, pp. 285-317, 1985.
%
%    For integrating ODE system can be used any MATLAB ODE-suite methods.
% This function is a part of MATDS program - toolbox for dynamical system investigation
%    See:    http://www.math.rsu.ru/mexmat/kvm/matds/
%
%    Input parameters:
%      n - number of equation
%      rhs_ext_fcn - handle of function with right hand side of extended ODE-system.
%              This function must include RHS of ODE-system coupled with
%              variational equation (n items of linearized systems, see Example).
%      fcn_integrator - handle of ODE integrator function, for example: @ode45
%      tstart - start values of independent value (time t)
%      stept - step on t-variable for Gram-Schmidt renormalization procedure.
%      tend - finish value of time
%      ystart - start point of trajectory of ODE system.
%      ioutp - step of print to MATLAB main window. ioutp==0 - no print,
%              if ioutp>0 then each ioutp-th point will be print.
%
%    Output parameters:
%      Texp - time values
%      Lexp - Lyapunov exponents to each time value.
%
%    Users have to write their own ODE functions for their specified
%    systems and use handle of this function as rhs_ext_fcn - parameter.
%
%    Example. Lorenz system:
%               dx/dt = sigma*(y - x)     = f1
%               dy/dt = r*x - y - x*z = f2
%               dz/dt = x*y - b*z     = f3
%
%    The Jacobian of system:
%        | -sigma  sigma  0 |
%    J = |   r-z    -1   -x |
%        |    y      x   -b |
%
%    Then, the variational equation has a form:
%
%    F = J*Y
%    where Y is a square matrix with the same dimension as J.
%    Corresponding m-file:
%        function f=lorenz_ext(t,X)
%         SIGMA = 10; R = 28; BETA = 8/3;
%         x=X(1); y=X(2); z=X(3);
%
%         Y= [X(4), X(7), X(10);
%             X(5), X(8), X(11);
%             X(6), X(9), X(12)];
%         f=zeros(9,1);
%         f(1)=SIGMA*(y-x); f(2)=-x*z+R*x-y; f(3)=x*y-BETA*z;
%
%         Jac=[-SIGMA,SIGMA,0; R-z,-1,-x; y, x,-BETA];
%
%         f(4:12)=Jac*Y;
%
%    Run Lyapunov exponent calculation:
%
%    [T,Res]=lyapunov(3,@lorenz_ext,@ode45,0,0.5,200,[0 1 0],10);
%
%    See files: lorenz_ext, run_lyap.
%
% --------------------------------------------------------------------
% Copyright (C) 2004, Govorukhin V.N.
% This file is intended for use with MATLAB and was produced for MATDS-program
% http://www.math.rsu.ru/mexmat/kvm/matds/
% lyapunov.m is free software. lyapunov.m is distributed in the hope that it
% will be useful, but WITHOUT ANY WARRANTY.
%

%
%       n=number of nonlinear odes
%       n2=n*(n+1)=total number of odes
%

n1=n; n2=n1*(n1+1);

%  Number of steps

nit = round((tend-tstart)/stept);

% Memory allocation

y=zeros(n2,1); cum=zeros(n1,1); y0=y;
gsc=cum; znorm=cum;

% Initial values

y(1:n)=ystart(:);

for i=1:n1 y((n1+1)*i)=1.0; end;

t=tstart;

% Main loop

for ITERLYAP=1:nit

% Solutuion of extended ODE system

  [T,Y] = feval(fcn_integrator,rhs_ext_fcn,[t t+stept],y);

  t=t+stept;
  y=Y(size(Y,1),:);

  for i=1:n1
      for j=1:n1 y0(n1*i+j)=y(n1*j+i); end;
  end;

%
%       construct new orthonormal basis by gram-schmidt
%

  znorm(1)=0.0;
  for j=1:n1 znorm(1)=znorm(1)+y0(n1*j+1)^2; end;

  znorm(1)=sqrt(znorm(1));

  for j=1:n1 y0(n1*j+1)=y0(n1*j+1)/znorm(1); end;

  for j=2:n1
      for k=1:(j-1)
          gsc(k)=0.0;
          for l=1:n1 gsc(k)=gsc(k)+y0(n1*l+j)*y0(n1*l+k); end;
      end;

      for k=1:n1
          for l=1:(j-1)
              y0(n1*k+j)=y0(n1*k+j)-gsc(l)*y0(n1*k+l);
          end;
      end;

      znorm(j)=0.0;
      for k=1:n1 znorm(j)=znorm(j)+y0(n1*k+j)^2; end;
      znorm(j)=sqrt(znorm(j));

      for k=1:n1 y0(n1*k+j)=y0(n1*k+j)/znorm(j); end;
  end;

%
%       update running vector magnitudes
%

  for k=1:n1 cum(k)=cum(k)+log(znorm(k)); end;

%
%       normalize exponent
%

  for k=1:n1
      lp(k)=cum(k)/(t-tstart);
  end;

% Output modification

  if ITERLYAP==1
     Lexp=lp;
     Texp=t;
  else
     Lexp=[Lexp; lp];
     Texp=[Texp; t];
  end;

  if (mod(ITERLYAP,ioutp)==0)
     fprintf('t=%6.4f',t);
     for k=1:n1 fprintf(' %10.6f',lp(k)); end;
     fprintf('\n');
  end;

  for i=1:n1
      for j=1:n1
          y(n1*j+i)=y0(n1*i+j);
      end;
  end;

end;


function [yData,betas,P,errors] = tsne_d(D, parameters)
%TSNE_D Performs symmetric t-SNE on the pairwise Euclidean distance matrix D
%
%   [yData,betas,P,errors] = tsne_d(D, parameters)
%
% The function performs symmetric t-SNE on the NxN pairwise
% distance matrix D to construct an embedding with no_dims dimensions
% (default = 2). An initial solution obtained from an other dimensionality
% reduction technique may be specified in initial_solution.
% The perplexity of the Gaussian kernel that is employed can be specified
% through perplexity.
%
%
%   Input variables:
%
%       D -> NxN distance matrix
%       parameters -> structure containing non-default parameters
%
%
%   Output variables:
%
%       yData -> Nx2 (or Nx3) array of embedded values
%       betas -> list of individual area parameters
%       P -> sparse transition matrix
%       errors -> D_{KL}(P || Q) as a function of iteration
%
%
% (C) Laurens van der Maaten, 2010
% University of California, San Diego
%
%  Modified by Gordon J. Berman, 2014
%  Princeton University

    no_dims = parameters.num_tsne_dim;
    perplexity = parameters.perplexity;
    sigmaTolerance = parameters.sigmaTolerance;
    relTol = parameters.relTol;

    if numel(no_dims) > 1
        initial_solution = true;
        yData = no_dims;
        no_dims = size(ydata, 2);
    else
        initial_solution = false;
    end

    D = D / max(D(:));
    [P,betas] = d2p_sparse(D .^ 2, perplexity, sigmaTolerance);
    P(isnan(P)) = 0;

    clear D

    % Run t-SNE
    if initial_solution
        [yData,errors] = tsne_p_sparse(P, parameters, yData, relTol);
    else
        [yData,errors] = tsne_p_sparse(P, parameters, no_dims, relTol);
    end


function edge_length = tetrahedron_edge_length_3d ( tetra )

%*****************************************************************************80
%
%% TETRAHEDRON_EDGE_LENGTH_3D returns edge lengths of a tetrahedron in 3D.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 May 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real TETRA(3,4), the tetrahedron vertices.
%
%    Output, real EDGE_LENGTH(6,1), the length of the edges.
%
  dim_num = 3;
  edge_length = zeros ( 6, 1 );

  k = 0;
  for j1 = 1 : 3
    for j2 = j1+1 : 4
      k = k + 1;
      edge_length(k) = r8vec_length ( dim_num, ...
        tetra(1:dim_num,j2) - tetra(1:dim_num,j1) );
    end
  end

  return
end


% Copyright (c) Technische Universität München, 2012
% All rights reserved.
%
% Author: Clemens Hage
% Contact: hage@tum.de
% Date: 2012-11-12
%
% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
% POSSIBILITY OF SUCH DAMAGE.

% This script runs a quick numerical demo on Robust PCA (batch mode with
% incomplete observation)

% Dimension of the data set
m = 400;

% Number of samples
n = 400;

% Dimension of the underlying subspace
k = 40; % i.e. relative rank of 0.1

% Relative density of outliers
rho = 0.1; % i.e. 10% of the matrix entries are corrupted

% Max. magnitude of the outliers
amplitude = 5;

% Create test data
[X,L_0]=testdata(m,n,k,rho,amplitude,0);

support=0.5; % 50% of the entries are observed

% Create support set

% number of observed entries
nentries = ceil(support * m * n);

% random positions
indices = randperm(m*n,nentries);

% convert to indices
[i,j]=ind2sub([m n],indices);

% create sparse matrix
Omega = sparse(i,j,true(nentries,1),m,n,nentries);

% run Robust PCA
L=robustpca_batch(X,k,'atansquare','L_0',L_0,'Omega',Omega);

% Compute relative subspace reconstruction error
err = norm(Omega.*L-Omega.*L_0,'fro') / norm(Omega.*L_0,'fro');
display(['Relative subspace reconstruction error (robust method): ' num2str(err)])

% % Compare to common PCA approach
X_sampled = Omega.*X;
[U,~,~]=svds(X_sampled,k);

L_PCA = U * (U' * X_sampled);

err_PCA = norm(Omega.*L_PCA-Omega.*L_0,'fro') / norm(Omega.*L_0,'fro');
display(['Relative subspace reconstruction error (common PCA): ' num2str(err_PCA)])


%  DemoTV_UP.m
%
%  This is a short script that performs TV minimization recovery
%   from partial Fourier measurements
%
%  min Lambda ||x||_TV +1/2||b - A x||_2
%
%  Here A*A is assumed to be an orthogonal projector
%
%  Parameters to set : 1) n : the size of the image to reconstruct (default: 128)
%                      2) Dyna : the dynamic range of the original image (in dB) (default : 40)
%                      3) Lambda : value of the Lagrange multiplier (default: 0.05)
%
%  Created entities : I : original image
%                     Xnesta : image recovered with Nesta
%                     NA_nesta = number of calls of A or A* for the method
%
% Written by: Jerome Bobin, Caltech
% Email: bobin@acm.caltech.edu
% Created: May 2009
%
% NESTA Version 1.1
%   See also NESTA_UP and Core_Nesterov_UP
clear; clc;
n = 128;   %--- The data are n*n images
Dyna = 40; %--- Dynamic range in dB
Lambda = 0.05;
Setup_Nesta % -- add the solvers to the path
%% Setting up the experiment

N = n*n;
I=MakeRDSquares(n,7,Dyna);
x = reshape(I,n*n,1);
L = floor(55*(n/256)); %--- so as to get a compression ratio ~10
[M,Mh,mi,mhi] = LineMask(L,n);
OMEGA = mhi;
OMEGA = [OMEGA];
K = length(OMEGA);
A = @(z) A_fhp(z,OMEGA);
At = @(z) At_fhp(z,OMEGA,n);
b0 = A(x);
sigma = 0.1;
noise = sigma*randn(size(b0));
b = b0+noise;

fprintf('##############################################\n\n');
fprintf('NESTA: Total Variation minimization experiment\n\n');
fprintf('##############################################\n\n');
fprintf('Image size = %g x %g / Dynamic range : %g / Noise level : %g\n\n',n,n,Dyna,sigma);

%% Setting up the experiment for NESTA

fprintf(' NESTA starts\n\n');
U = @(z) z;
Ut = @(z) z;
mu = 0.2; %--- can be chosen to be small
opts = [];
opts.maxintiter = 5;
opts.TOlVar = 1e-4;
opts.verbose = 25;
opts.maxiter = 5000;
opts.U = U;
opts.Ut = Ut;
opts.stoptest = 1;
opts.typemin = 'tv';
counter();
Ac = @(z) counter(A,z);
Atc = @(z) counter(At,z);
tic;
[x_nesta,niter,resid,err] = NESTA_UP(Ac,Atc,b,Lambda,1,mu,opts);
t.NESTA = toc;
NA_nesta = counter();
tvnesta = calctv(n,n,reshape(x_nesta,n,n));
Xnesta = reshape(x_nesta,n,n);

% -- Print results

fprintf('\nNESTA: TV: %g -- ||b-Ax|| = %g -- # calls : %g\n\n',tvnesta,norm(b - A(Xnesta(:))),NA_nesta);
fprintf('relative l2 error compared to original signal: %.2e\n',norm(Xnesta-I,'fro')/norm(I,'fro') );
%% Plot results
figure(1); clf;

subplot(1,2,1);
image( I );  title('Original image');
map = colormap(hsv);
map(1,:) = [1,1,1];
colormap(map);
% colorbar('westoutside');
axis square; axis off

subplot(1,2,2);
image(Xnesta); title(sprintf(...
    'Reconstruction via NESTA\n%.1f sec',t.NESTA));
axis square; axis off


function hermite_rule ( n, a, b, scale, filename )

%*****************************************************************************80
%
%% HERMITE_RULE generates a Gauss-Hermite rule.
%
%  Discussion:
%
%    This program computes a Gauss-Hermite quadrature rule
%    and writes it to a file.
%
%    The integral to be approximated has the form
%
%      C * integral ( -oo < x < +oo ) f(x) rho(x) dx
%
%    where the weight rho(x) is:
%
%      rho(x) = exp ( - b * ( x - a )^2 ) * sqrt ( b / pi ) dx
%
%    and A and B are parameters.
%
%    The user specifies:
%    * N, the number of points in the rule;
%    * A, the center point;
%    * B, the scale factor in the exponential;
%    * SCALE, is 1 if the weights are to be normalized;
%    * FILENAME, the root name of the output files.
%
%    If SCALE = 0, then the factor C in front of the integrand is 1.
%    If SCALE is nonzero, then the factor C is sqrt ( B ) / sqrt ( PI ).
%    which means that the function f(x)=1 will integrate to 1.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 February 2014
%
%  Author:
%
%    John Burkardt
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'HERMITE_RULE\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Compute a Gauss-Hermite rule for approximating\n' );
  fprintf ( 1, '    integral ( -oo < x < +oo ) f(x) rho(x) dx\n' );
  fprintf ( 1, '  where the weight rho(x) is:\n' );
  fprintf ( 1, '    exp ( - b * ( x - a )^2 ) * sqrt ( b / pi ) dx\n' );
  fprintf ( 1, '  using N points.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The user specifies N, A, B, SCALE, FILENAME.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  N is the number of points;\n' );
  fprintf ( 1, '  A is the center point (typically 0).\n' );
  fprintf ( 1, '  B is the exponential scale factor (typically 1).\n' );
  fprintf ( 1, '  SCALE is 1 if the weights are to be normalized.\n');
  fprintf ( 1, '  FILENAME is used to generate 3 files:\n' );
  fprintf ( 1, '    filename_w.txt - the weight file\n' );
  fprintf ( 1, '    filename_x.txt - the abscissa file.\n' );
  fprintf ( 1, '    filename_r.txt - the region file.\n' );
%
%  Initialize the parameters.
%
  alpha = 0.0;
  beta = 0.0;
%
%  Get N.
%
  if ( nargin < 1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, '  N is the number of points in the rule, such as 5.\n' );
    n = input ( '  Enter N: ' );
  elseif ( ischar ( n ) )
    n = str2num ( n );
  end
%
%  Get A.
%
  if ( nargin < 2 )
    fprintf ( 1, '\n' );
    fprintf ( 1, '  A is the center point, typically 0.\n' );
    fprintf ( 1, '\n' );
    a = input ( '  Enter A: ' );
  elseif ( ischar ( a ) )
    a = str2num ( a );
  end
%
%  Get B.
%
  if ( nargin < 3 )
    fprintf ( 1, '\n' );
    fprintf ( 1, '  B is the scale factor, typically 0.5 or 1.0.\n' );
    fprintf ( 1, '\n' );
    b = input ( '  Enter B: ' );
  elseif ( ischar ( b ) )
    b = str2num ( b );
  end
%
%  Get SCALE.
%
  if ( nargin < 4 )
    fprintf ( 1, '\n' );
    fprintf ( 1, '  SCALE is 1 to normalize the weights, 0 otherwise.\n' );
    fprintf ( 1, '\n' );
    b = input ( '  Enter SCALE (0/1): ' );
  elseif ( ischar ( scale ) )
    scale = str2num ( scale );
  end
%
%  Get FILENAME.
%
  if ( nargin < 5 )
    fprintf ( 1, '\n' );
    fprintf ( 1, '  FILENAME is the ''root name'' of the quadrature files).\n' );
    filename = input ( '  Enter FILENAME as a quoted string:' );
  end
%
%  Input summary.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Input summary:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  N = %d\n', n );
  fprintf ( 1, '  A = %f\n', a );
  fprintf ( 1, '  B = %f\n', b );
  fprintf ( 1, '  SCALE = %d\n', scale );
  fprintf ( 1, '  FILENAME = "%s".\n', filename );
%
%  Construct the rule.
%
  kind = 6;
  [ x, w ] = cgqf ( n, kind, alpha, beta, a, b );
%
%  Normalize the rule.
%  This way, the weights add up to 1.
%
  if ( scale == 1.0 )
    w(1:n) = w(1:n) * sqrt ( b ) / sqrt ( pi );
  end
%
%  Set the R values to suggest an infinite interval.
%
  r = zeros ( 2, 1 );
  r(1) = - r8_huge ( );
  r(2) =   r8_huge ( );
%
%  Write the rule.
%
  rule_write ( n, filename, x, w, r );
%
%  Terminate.
%
  fprintf ( 1,  '\n' );
  fprintf ( 1,  'HERMITE_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_huge ( )

%*****************************************************************************80
%
%% R8_HUGE returns a "huge" real number.
%
%  Discussion:
%
%    The value returned by this function is NOT required to be the
%    maximum representable R8.  This value varies from machine to machine,
%    from compiler to compiler, and may cause problems when being printed.
%    We simply want a "very large" but non-infinite number.
%
%    MATLAB provides a built-in symbolic constant "inf" that can be used
%    if a huge number is really what you want!
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    27 January 2008
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Output, real VALUE, a huge number.
%
  value = 1.0E+30;

  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


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% % Simple Low Rank Tensor Completion (SiLRTC)
% Time: 03/11/2012
% Reference: "Tensor Completion for Estimating Missing Values
% in Visual Data", PAMI, 2012.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [X, errList] = SiLRTC(T, Omega, alpha, gamma, maxIter, epsilon, X)
%%%%%%%%%%%%%%%%%%%%%%%%%%
% min(X, M1, M2, M3,... Mn): (\gamma1||X_(1)-M1||^2 + \gamma2||X_(2)-T2||^2 + \gamma3||X_(3)-T3||^2 + ...)/2 +
%               \alpha1||M1||_* + \alpha2||M2||_* + \alpha3||M3||_* + ....
%         s.t.  X_\Omega = T_\Omega
%%%%%%%%%%%%%%%%%%%%%%%%%%
if nargin < 7
    X = T;
    X(logical(1-Omega)) = mean(T(Omega));
end

errList = zeros(maxIter, 1);
normT = norm(T(:));
%L = errList;
dim = size(T);
M = cell(ndims(T), 1);
gammasum = sum(gamma);
tau = alpha./ gamma;

%normT = norm(T(:));
for k = 1:maxIter
    if mod(k, 20) == 0
        fprintf('SiLRTC: iterations = %d   difference=%f\n', k, errList(k-1));
    end
    Xsum = 0;
    for i = 1:ndims(T)
        M{i} = Fold(Pro2TraceNorm(Unfold(X, dim, i), tau(i)), dim, i);
        Xsum = Xsum + gamma(i) * M{i};
    end
    Xlast = X;
    X = Xsum / gammasum;
    X(Omega) = T(Omega);
    errList(k) = norm(X(:)-Xlast(:)) / normT;
    if (errList(k) < epsilon)
        errList = errList(1:k);
        break;
    end
    %L(k) = norm(X(:)-T(:)) / normT;
end
fprintf('SiLRTC ends: total iterations = %d   difference=%f\n\n', k, errList(k));


function [ xstar, seed ] = rk2_ti_step ( x, t, h, q, fi, gi, seed )

%*****************************************************************************80
%
%% RK2_TI_STEP takes one step of a stochastic Runge Kutta scheme.
%
%  Discussion:
%
%    The Runge-Kutta scheme is second-order, and suitable for time-invariant
%    systems.
%
%    d/dx X(t,xsi) = F ( X(t,xsi) ) + G ( X(t,xsi) ) * w(t,xsi)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 June 2010
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Jeremy Kasdin,
%    Runge-Kutta algorithm for the numerical integration of
%    stochastic differential equations,
%    Journal of Guidance, Control, and Dynamics,
%    Volume 18, Number 1, January-February 1995, pages 114-120.
%
%    Jeremy Kasdin,
%    Discrete Simulation of Colored Noise and Stochastic Processes
%    and 1/f^a Power Law Noise Generation,
%    Proceedings of the IEEE,
%    Volume 83, Number 5, 1995, pages 802-827.
%
%  Parameters:
%
%    Input, real X, the value at the current time.
%
%    Input, real T, the current time.
%
%    Input, real H, the time step.
%
%    Input, real Q, the spectral density of the input white noise.
%
%    Input, external real FI, the name of the deterministic
%    right hand side function.
%
%    Input, external real GI, the name of the stochastic
%    right hand side function.
%
%    Input/output, integer SEED, a seed for the random
%    number generator.
%
%    Output, real XSTAR, the value at time T+H.
%
  a21 = 1.0;
  a31 = 0.5;
  a32 = 0.5;

  q1 = 2.0;
  q2 = 2.0;

  t1 = t;
  x1 = x;
  [ n1, seed ] = r8_normal_01 ( seed );
  w1 = n1 * sqrt ( q1 * q / h );
  k1 = h * fi ( x1 ) + h * gi ( x1 ) * w1;

  t2 = t1 + a21 * h;
  x2 = x1 + a21 * k1;
  [ n2, seed ] = r8_normal_01 ( seed );
  w2 = n2 * sqrt ( q2 * q / h );
  k2 = h * fi ( x2 ) + h * gi ( x2 ) * w2;

  xstar = x1 + a31 * k1 + a32 * k2;

  return
end


%
% This code creates the plot of the D-value versus the b-value.
% The code is called from view_Dv.
%
%
[bvg5, ord] = sort(bvg(:,5));
bvg1 = bvg(ord,1);
bx = [bvg5(3):0.05: bvg5(end-1)]';
Dy = 2*bx;
clear ord;

figure_w_normalized_uicontrolunits('Numbertitle','off','Name','D versus b');
plot(bvg(:,5),bvg(:,1),'o');
hold on;
plot(bx, Dy, 'k-');
xlabel('b-value');
ylabel('D-value');
title('D-value versus b-value');

reg = [ones(size(bvg,1),1), bvg(:,5)];
[sl, cint, res, resint, stat] = regress(bvg(:,1), reg, 0.25);

sl
stat

rsl = [sl(2,1) sl(1,1)];
coef1 = [cint(2,1), cint(1,1)];
coef2 = [cint(2,2), cint(1,2)];
deltar = sl(2,1) - cint(2,1);
[line] = polyval(rsl,bx);
[line1] = polyval(coef1, bx);
[line2] = polyval(coef2, bx);

hold on;
plot(bx, line, 'r');
plot(bx, line1, 'g');
plot(bx, line2, 'g');

str2 = ['Correlation factor (D=xb): x =  ' sprintf('%.2f',sl(2,1)) '  +/- ' sprintf('%.2f', deltar)];
axes('pos',[0 0 1 1]); axis off; hold on;
te1 = text(0.15, 0.85, str2,'Fontweight','bold');


function x = blend_ij_w_1d1 ( x, r, s, m1, m2 )

%*****************************************************************************80
%
%% BLEND_IJ_W_1D1 extends weighted indexed scalar data along edges into a table.
%
%  Diagram:
%
%    Instead of assuming that the data in the table is equally spaced,
%    the arrays R and S are supplied, which should behave as
%    "coordinates" for the data.
%
%            S(1)  S(2)  S(3)  S(4)  S(5)  S(6)  S(M2)
%
%    R(1)  ( X11,  X12,  X13,  X14,  X15,  X16,  X1M2  )
%    R(2)  ( X21,  ...,  ...,  ...,  ...,  ...,  X2M2  )
%    R(3)  ( X31,  ...,  ...,  ...,  ...,  ...,  X3M2  )
%    R(4)  ( X41,  ...,  ...,  ...,  ...,  ...,  X4M2  )
%    R(M1) ( XM11, XM12, XM13, XM14, XM15, XM16, XM1M2 )
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    23 October 2008
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    William Gordon,
%    Blending-Function Methods of Bivariate and Multivariate Interpolation
%    and Approximation,
%    SIAM Journal on Numerical Analysis,
%    Volume 8, Number 1, March 1971, pages 158-177.
%
%    William Gordon and Charles Hall,
%    Transfinite Element Methods: Blending-Function Interpolation over
%    Arbitrary Curved Element Domains,
%    Numerische Mathematik,
%    Volume 21, Number 1, 1973, pages 109-129.
%
%    William Gordon and Charles Hall,
%    Construction of Curvilinear Coordinate Systems and Application to
%    Mesh Generation,
%    International Journal of Numerical Methods in Engineering,
%    Volume 7, 1973, pages 461-477.
%
%    Joe Thompson, Bharat Soni, Nigel Weatherill,
%    Handbook of Grid Generation,
%    CRC Press, 1999.
%
%  Parameters:
%
%    Input, real X(M1,M2).
%    On input, data is contained in the "edge entries" X(1,J), X(I,1),
%    X(M1,J) and X(I,M2), for I = 1 to M1, and J = 1 to M2.
%
%    Input, real R(M1), S(M2), are "coordinates" for the rows and
%    columns of the array.  The values in R, and the values in S, should
%    be strictly increasing or decreasing.
%
%    Input, integer M1, M2, the number of rows and columns in X.
%
%    Output, real X(M1,M2), all entries in X have been assigned a value.
%

%
%  Interpolate values in the interior.
%
  for i = 2 : m1 - 1

    rr = ( r(i) - r(1) ) / ( r(m1) - r(1) );

    for j = 2 : m2 - 1

      ss = ( s(j) - s(1) ) / ( s(m2) - s(1) );

      x(i,j) = blend_112 ( rr, ss, x(1,1), x(1,m2), x(m1,1), x(m1,m2), ...
        x(i,1), x(i,m2), x(1,j), x(m1,j) );

    end

  end

  return
end


function value = square_volume ( a, b )

%*****************************************************************************80
%
%% SQUARE_VOLUME: volume of a square in 2D.
%
%  Discussion:
%
%    The integration region is defined as:
%      A(1) <= X <= B(1)
%      A(2) <= Y <= B(2)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    07 September 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real A(2), B(2), the lower and upper limits.
%
%    Output, real VALUE, the volume.
%
  value = ( b(1) - a(1) ) * ( b(2) - a(2) );

  return
end


function c = l1pp_cholesky ( n, h )

%*****************************************************************************80
%
%% L1PP_CHOLESKY computes the Cholesky factor of the 1D PP Laplacian.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 October 2013
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of points.
%    N must be at least 3.
%
%    Input, real H, the spacing between points.
%
%    Output, real C(N,N), the Cholesky factor.
%
  if ( n < 3 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'L1PP_CHOLESKY - Fatal error!\n' );
    fprintf ( 1, '  N < 3.\n' );
    error ( 'L1PP_CHOLESKY - Fatal error!' );
  end

  c = zeros ( n, n );

  for i = 1 : n - 1
    c(i,i) = sqrt ( i + 1.0 ) / sqrt ( i );
  end

  for i = 1 : n - 2
    c(i,i+1) = - i / ( i + 1.0 ) * sqrt ( i + 1.0 ) / sqrt ( i );
  end

  for i = 1 : n - 2
    c(i,n) = - 1.0 / ( i + 1.0 ) * sqrt ( i + 1.0 ) / sqrt ( i );
  end

  i = n - 1;
  c(i,n) = - n / ( i + 1.0 ) * sqrt ( i + 1.0 ) / sqrt ( i );

  c(1:n,1:n) = c(1:n,1:n) / h;

  return
end


%% To plot Basin of Attraction for a given set of equations using Newton
% Raphson Method
% Governing Equations are:
% x^3-y = 0 ; y^3 - x = 0
%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
% Warning : On running this the workspace memory will be deleted. Save if
% any data present before running the code !!
%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
%--------------------------------------------------------------------------
% Code written by : Siva Srinivas Kolukula, PhD                           |
%                   Structural Mechanics Laboratory                       |
%                   Indira Gandhi Center for Atomic Research              |
%                   India                                                 |
% E-mail : allwayzitzme@gmail.com                                         |
% web-link: https://sites.google.com/site/kolukulasivasrinivas/           |
%--------------------------------------------------------------------------
% Version 1 : 19 September 2013

clc ; clear all
warning('off') % To off the warning which shows "Matrix is close to singular
               % badly scaled" when algorithm passes through a point where the Jacobian
               % matrix is singular

% The roots of the given governing equations
r1 = [-1 ;-1] ;
r2 = [0 ;0] ;
r3 = [1 ;1] ;
% Initial conditions
x = linspace(-2,2,200) ;
y = linspace(-2,2,200) ;
% Initialize the required matrices
Xr1 = [] ; Xr2 = [] ; Xr3 = [] ; Xr4 = [] ;
tic
for i = 1:length(x)
     for j = 1:length(y)
          X0 = [x(i);y(j)] ;
          % Solve the system of Equations using Newton's Method
          X = NewtonRaphson(X0) ;
          % Locating the initial conditions according to error
          if norm(X-r1)<1e-8
             Xr1 = [X0 Xr1]  ;
          elseif norm(X-r2)<1e-8
             Xr2 = [X0 Xr2] ;
          elseif norm(X-r3)<1e-8
             Xr3 = [X0 Xr3] ;
          else               % if not close to any of the roots
             Xr4 = [X0 Xr4] ;
          end

     end
end
toc
warning('on') % Remove the warning off constraint

% Initialize figure
figure
set(gcf,'color','w')
hold on
plot(Xr1(1,:),Xr1(2,:),'.','color','r') ;
plot(Xr2(1,:),Xr2(2,:),'.','color','b') ;
plot(Xr3(1,:),Xr3(2,:),'.','color','g') ;
plot(Xr4(1,:),Xr4(2,:),'.','color','k') ;
title('Basin of attraction for f(x,y) = x^3-y = 0 and y^3-x=0')


function value = r8_scinvchi_sample ( df, s )

%*****************************************************************************80
%
%% R8_SCINVCHI_SAMPLE: sample a scaled inverse chi-squared distribution.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 June 2013
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real DF, the degrees of freedom.
%    0.0 < DF.
%
%    Input, real S, the scale factor.
%    0.0 < S.
%
%    Input, real VALUE, a sample value.
%
  a = 0.5 * df * s;
  b = 0.5 * df;

  value = r8_gamma_sample ( a, b );

  if ( value ~= 0.0 )
    value = 1.0 / value;
  end

  return
end


% Stability domain of Adams-Bashforth_Euler scheme

% Copyright 2001 P. Wesseling
% This program and its subprograms may be freely used, modified and distributed
% under the GNU General Public License: http://www.gnu.org/copyleft/gpl.html

% Theory is given in Section 5.8 of
% 	P. Wesseling: Principles of Computational Fluid Dynamics
% 	Springer, Heidelberg, 2000 ISBN 3-5453-0. XII, 642 pp.
% See http://ta.twi.tudelft.nl/nw/users/wesseling/cfdbook.html

% This program generates Fig. 5.5  in the book

figure(1), clf, hold on

		% Plot of stability domain
theta = 0:0.01:1; theta = theta*pi;
z = - 2*(1-cos(theta)).^2./(3-cos(theta)) + i*2*sin(theta)./(3-cos(theta));
plot(z)

		% Stability domain of second order Adams-Bashforth scheme
z = exp(2*i*theta) - exp(i*theta); z = z./(1.5*exp(i*theta) - 0.5); plot(z,'-.')

		% Plot of oval
b = 1; a = 1; z =  - a*(1-cos(theta)) + i*b*(sin(theta)).^0.5; plot(z,'--')

		% Plot of half ellipse
a = 2.0; b = sqrt(1/3); theta = -pi/2 +0.5*theta;
z = - a*cos(theta) - i*b*sin(theta); plot(z,'.')