function pass = test_roots( )
% Test the chebfun2/roots command.

tol = 1e-12;  % rank 1 curves
tol2 = 1e-8;  % rank >1 curves, disjoint
tol3 = 1e-4;  % rank >1 curves, noncircular
tol4 = 1e-2;  % intersecting curves, not properly disentangled

% First we check separable functions, i.e., rank 1:

f = chebfun2( @(x,y) 1/2-y);
r = roots( f );
exact = chebfun( @(x) x + 1i/2 );
pass(1) = ( norm( r - exact ) < tol );

f = chebfun2( @(x,y) 1/2-x);
r = roots( f );
exact = chebfun( @(x) 1i*x + 1/2 );
pass(2) = ( norm( r - exact ) < tol );

f = chebfun2( @(x,y) x.*y);
r = roots( f );
exact = chebfun( @(x) [x, 1i*x]  );
pass(3) = ( norm( r - exact ) < tol );

f = chebfun2( @(x,y) cos(5*pi*x));
s = roots( squeeze( f ) );
r = roots( f );
exact = chebfun;
for j = 1:numel(s)
    exact = [ exact chebfun(@(x) s(j) + 1i*x )];
end
pass(4) = ( norm( r - exact ) < tol );

f = chebfun2( @(x,y) x.*(y-1/2), [-2 2 -3 5]);
r = roots( f );
exact = [chebfun( @(x) 2*x + 1i/2 ) chebfun(@(x) 1i*(4*(x+1)-3) )];
pass(5) = ( norm( r - exact ) < tol );

% Next we move to functions of rank > 1

f = chebfun2( @(x,y) x.^2 + y.^2 - 1/4 );
c = roots(f);
arclength = sum(abs(diff(c)));
err = arclength - pi;
pass(6) = abs(err) < tol2;
%disp([int2str(pass(6)) '  circle  ' int2str(length(c))])

area = abs(sum(real(c).*diff(imag(c))));
err = area - pi/4;
pass(7) = abs(err) < tol2;
%disp([int2str(pass(7)) '  area of circle  ' int2str(length(c))])

f = chebfun2( @(x,y) x.^2 + (10*y).^2 - 1/4 );
c = roots(f);
arclength = sum(abs(diff(c)));
err = arclength - 2.031987090050447;
pass(8) = abs(err) < tol3;
%disp([int2str(pass(8)) '  ellipse  ' int2str(length(c))])

area = abs(sum(real(c).*diff(imag(c))));
err = area - pi/40;
pass(9) = abs(err) < tol3;
%disp([int2str(pass(9)) '  area of ellipse  ' int2str(length(c))])

f = chebfun2( @(x,y) (x-1).^2 + y.^2 - 1/4 );
c = roots(f);
arclength = sum(abs(diff(c)));
err = arclength - pi/2;
pass(10) = abs(err) < tol2;
%disp([int2str(pass(10)) '  semicircle at boundary  ' int2str(length(c))])

f = chebfun2( @(x,y) (x-1).^2 + (y+1).^2 - 1/4 );
c = roots(f);
arclength = sum(abs(diff(c)));
err = arclength - pi/4;
pass(11) = abs(err) < tol2;
%disp([int2str(pass(11)) '  quarter-circle at corner  ' int2str(length(c))])

r = 1/pi;  % this radius gives circumference 2
x = chebfun2(@(x,y) x);
y = chebfun2(@(x,y) y);

%% One circle
f = x.^2 + y.^2 - r^2;
c = roots(f); arclength = sum(abs(diff(c)));
err = arclength - 2;
pass(12) = abs(err) < tol2;
%disp([int2str(pass(12)) '  another circle  ' int2str(length(c))])

%% Two circles
f = x.^2 + y.^2 - r^2;
g = (x-.6).^2 + (y-.5).^2 - r^2;
c = roots(f.*g); arclength = sum(abs(diff(c)));
err = arclength - [2 2];
pass(13) = norm(err,inf) < tol2;
%disp([int2str(pass(13)) '  two circles  ' int2str(length(c))])

%% Intersecting circles
f = x.^2 + y.^2 - r^2;
g = (x-.2).^2 + (y-.5).^2 - r^2;
c = roots(f.*g); arclength = sum(abs(diff(c)));
err = sum(arclength) - 4;
pass(14) = abs(err) < tol4;
%disp([int2str(pass(14)) '  intersecting circles  ' int2str(length(c))])

%% A circle and a line
f = x.^2 + y.^2 - r^2;
w = exp(x)-1.2;
c = roots(f.*w); arclength = sum(abs(diff(c)));
err = sum(arclength) - 4;
pass(15) = abs(err) < tol4;
%disp([int2str(pass(15)) '  intersecting circle and line  ' int2str(length(c))])

%% Concentric circles (well separated)
f = chebfun2(@(x,y) (x.^2 + y.^2 - .25).*(x.^2+y.^2-0.300));
c = roots(f); arclength = sum(abs(diff(c)));
err = arclength - pi*[sqrt(.300/.250) 1];
pass(16) = norm(err,inf) < tol2;
%disp([int2str(pass(16)) '  concentric circles  ' int2str(length(c))])

%% Concentric circles (less well separated)
f = chebfun2(@(x,y) (x.^2 + y.^2 - .25).*(x.^2+y.^2-0.260));
c = roots(f); arclength = sum(abs(diff(c)));
err = arclength - pi*[sqrt(.260/.250) 1];
pass(17) = norm(err,inf) < tol2;
%disp([int2str(pass(17)) '  close concentric circles  ' int2str(length(c))])

f = chebfun2( @(x,y) (x.^2+y.^2-1/4).*((x-1.1).^2+(y-3).^2-1/4),[-1.3 1.1 -.9 3]);
c = roots(f);
arclength = sum(abs(diff(c)));
err = sum(arclength) - 1.25*pi;
pass(18) = abs(err) < tol2;
%disp([int2str(pass(18)) '  different domain  ' int2str(length(c))])

f = chebfun2( @(x,y) 1e100*(x.^2 + y.^2 - 1/4) );
c = roots(f);
arclength = sum(abs(diff(c)));
err = arclength - pi;
pass(19) = abs(err) < tol2;
%disp([int2str(pass(19)) '  vertical scaling 1  ' int2str(length(c))])

f = chebfun2( @(x,y) 1e100*(x.^2 + y.^2 - 1/4) );
area = abs(sum(real(c).*diff(imag(c))));
err = area - pi/4;
pass(20) = abs(err) < tol2;
%disp([int2str(pass(20)) '  vertical scaling 2  ' int2str(length(c))])

f = chebfun2( @(x,y) y-sin(x),[-pi pi,-1.1 1.3]);
c = roots(f);
arclength = sum(abs(diff(c)));
err = arclength - 7.640395578055424035;
pass(21) = abs(err) < tol2;

f = chebfun2( @(x,y) x-tanh(y));
c = roots(f);
arclength = sum(abs(diff(c)));
err = arclength - 2.53182746833076;
pass(22) = abs(err) < tol2;

f = chebfun2( @(x,y) y-x.^2);
c = roots(f);
arclength = sum(abs(diff(c)));
err = arclength - 2.957885715089195;
pass(23) = abs(err) < tol2;

f = chebfun2( @(x,y) y.^2-x.^2-.1,[-1 1 -1.5 1.5]);  % hyperbola
c = roots(f);
arclength = sum(abs(diff(c)));
err = arclength - [1 1]*2.51829399795912;
pass(24) = norm(err,inf) < tol2;

f = chebfun2( @(x,y) y.^2-x.^2);  % cross
c = roots(f);
arclength = sum(abs(diff(c)));
err = arclength - [1 1]*sqrt(8);
pass(25) = norm(err,inf) < tol4;

end


function [m,q]=qrabs(q1)
%QRABS absoloute value and normalization of a real quaternions [m,q]=[q1]
%
% Inputs:
%
%     q1(4,1)  A real quaternion in the form [r, i, j, k]' where i^2=j^2=k^2=ijk=-1
%
% Outputs:
%
%     m   Magnitude of the quaternion, q1.
%     q   Normalized version of q1 with unit magnitude.

%      Copyright (C) Mike Brookes 2000-2008
%      Version: $Id: qrabs.m,v 1.1 2008/12/03 10:07:53 dmb Exp $
%
%   VOICEBOX is a MATLAB toolbox for speech processing.
%   Home page: http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   This program is free software; you can redistribute it and/or modify
%   it under the terms of the GNU General Public License as published by
%   the Free Software Foundation; either version 2 of the License, or
%   (at your option) any later version.
%
%   This program is distributed in the hope that it will be useful,
%   but WITHOUT ANY WARRANTY; without even the implied warranty of
%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%   GNU General Public License for more details.
%
%   You can obtain a copy of the GNU General Public License from
%   http://www.gnu.org/copyleft/gpl.html or by writing to
%   Free Software Foundation, Inc.,675 Mass Ave, Cambridge, MA 02139, USA.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
m=sqrt(q1'*q1);
if m>0
    q=q1/m;
else
    q=[1 0 0 0]';
end


%% Transient diffusion equation
%% PDE and boundary conditions
% The transient diffusion equation reads
%
% $$\alpha\frac{\partial c}{\partial t}+\nabla.\left(-D\nabla c\right)=0,$$
%
% where $c$ is the independent variable (concentration, temperature, etc)
% , $D$ is the diffusion coefficient, and $\alpha$ is a constant.
% Written by Ali A. Eftekhari
% Last checked: June 2021
clc

%% Define the domain and create a mesh structure
L = 50;  % domain length
Nx = 20; % number of cells
m = createMesh2D(Nx,Nx, L,L);
%% Create the boundary condition structure
BC = createBC(m); % all Neumann boundary condition structure
BC.left.a(:) = 0; BC.left.b(:)=1; BC.left.c(:)=0; % left boundary
BC.right.a(:) = 0; BC.right.b(:)=1; BC.right.c(:)=0; % right boundary
BC.top.a(:) = 0; BC.top.b(:)=1; BC.top.c(:)=0; % top boundary
BC.bottom.a(:) = 0; BC.bottom.b(:)=1; BC.bottom.c(:)=0; % bottom boundary
%% define the transfer coeffs
D_val = 1;
D = createCellVariable(m, D_val);
alfa = createCellVariable(m, 1);
%% define initial values
c_init = 1;
c_old = createCellVariable(m, c_init,BC); % initial values
c = c_old; % assign the old value of the cells to the current values
%% loop
dt = 1; % time step
final_t = 100;
for t=dt:dt:final_t
    [M_trans, RHS_trans] = transientTerm(c_old, dt, alfa);
    Dave = harmonicMean(D);
    Mdiff = diffusionTerm(Dave);
    [Mbc, RHSbc] = boundaryCondition(BC);
    M = M_trans-Mdiff+Mbc;
    RHS = RHS_trans+RHSbc;
    c = solvePDE(m,M, RHS);
    c_old = c;
    figure(1);visualizeCells(c);drawnow;
end


%  Figure 3.26      Feedback Control of Dynamic Systems, 6e
%                        Franklin, Powell, Emami
% script to generate Fig. 3.26

clf;
zeta=.5;
k=1/zeta;
den=[1 1 1];

a=10;
num=[k/a 1];
t=0:.1:10;
y1=step(num,den,t);

a=4;
num=[k/a 1];
t=0:.1:10;
y2=step(num,den,t);

a=2;
num=[k/a 1];
t=0:.1:10;
y3=step(num,den,t);

a=1;
num=[k/a 1];
t=0:.1:10;
y4=step(num,den,t);

plot(t,y1,'-',t,y2,'-',t,y3,'-',t,y4,'-'),grid
title('Fig. 3.26 Step response with \xi = 0.5')
xlabel('\omega_n t')
ylabel('Step response of H(s)')
text(.1,.9,'\alpha=')
text(.6,.9,'1')
text(1.1,.9,'2')
text(1.5,.85,'4')
text(1.8,.8,'100')
% grid
nicegrid


function f = f_function ( x, y1, y2, Md, Nd, L )

%*****************************************************************************80
%
%% F_FUNCTION: RHS function from exact coefficient Q and the exact solution U.
%
%  Discussion:
%
%    The differential equation has the form:
%
%      ( q(x) u_x(x) )_x = f(x)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Parameters:
%
%    x = physical space point of length one
%
%    y1 = stochastic vector of length Md (from the expansion for u)
%
%    y2 = stochastic vector of length Nd (from the expansion for q)
%
%    Md = dimension of the probability space for u
%
%    Nd = dimension of the probability space for q
%
%    L = the correlation length of the random variables
%
  [n_nodes, dim] = size(x);
  f = zeros( n_nodes, 1 );

  for n=1:Nd

  	for m=1:Md

  	 f = f + qn(n) * um( m ) * pn(y2, n) * pm(y1, m) * ...
  	 ( -(pi/L)^2 * m^2 .* sin((m*pi*x)/L) .* cos((n*pi*x)/L) ...
  	 -n*m * (pi/L)^2 * cos((m*pi*x)/L) .* sin((n*pi*x)/L) );

 	end

  end

  return
end
function p_m = pm( y, m )

%*****************************************************************************80
%
%% PM
%
  p_m = y(m);

  return
end
function p_n = pn( y, n )

%*****************************************************************************80
%
%% PN
%
  p_n = y(n);

  return
end
function q_n = qn( n )

%*****************************************************************************80
%
%% QN
%
  q_n = 1;

  return
end
function u_m = um( m )

%*****************************************************************************80
%
%% UM
%
 u_m = 1;

 return
end


function [P1, P2, spectrum] = slcopca(X1, X2, d, varargin)
%SLCOPCA Performs Coupled PCA Learning
%
% $ Syntax $
%   - [P1, P2] = slcopca(X1, X2, sch, ...)
%   - [P1, P2, spectrum] = slcopca(...)
%
% $ Arguments $
%   - X1:       The samples in the first modality
%   - X2:       The samples in the second modality
%   - d:        The target space dimension
%   - P1:       The projection matrix (bases) of the first modality space
%   - P2:       The projection matrix (bases) of the second modality space
%   - spectrum: The covariance energy along dimensions of target space
%
% $ Description $
%   - [P1, P2] = slcopca(X1, X2, sch, ...) performs coupled PCA learning
%     for two correlated sample spaces. The learning objective is to
%     pursue two subspaces such that they are maximally correlated. The
%     objective function is formulated as
%
%       maximize trace( P1^T * C_12 * P2 * P2^T * C_21 * P1 ) / n
%           s.t. P1^T * P1 = I, and  P2^T * P2 = I
%       where C_12 is the covariance between X1 and X2,
%             C_21 is the covariance between X2 and X1
%
%     Suppose the dimensions for the two spaces are d1 and d2 respectively,
%     and n pairs of corresponding samples are given in X1 and X2. Then X1
%     and X2 should be d1 x n and d2 x n matrices respectively.
%     You can further specify the following properties to control the
%     learning procedure:
%       - 'weights':    The weights of the samples, default = []
%       - 'mean1':      The pre-computed mean vector for X1, default = []
%                       if mean1 is set as 0, then it means that X1 has
%                       been centralized.
%       - 'mean2':      The pre-computed mean vector for X2, default = []
%
%   - [P1, P2, spectrum] = slcopca(...) also outputs the spectrum. You
%     can specify the following properties to control the type of the
%     output spectrum:
%       - 'spectype':   The type of output spectrum
%                       - 'normal': The average energies along target
%                                   dimensions.
%                       - 'ratio':  The ratio of preserved energy along
%                                   target dimensions to the total
%                                   energy.
%                       default = 'normal'.
%
% $ History $
%   - Created by Dahua Lin, on Sep 16, 2006
%

%% parse and verify input arguments

if nargin < 3
    raise_lackinput('slcopca', 3);
end

if ~isnumeric(X1) || ~isnumeric(X2) || ndims(X1) ~= 2 || ndims(X2) ~= 2
    error('sltoolbox:invalidarg', ...
        'X1 and X2 should be 2D numeric matrices');
end

[d1, n] = size(X1);
[d2, n2] = size(X2);
if n ~= n2
    error('sltoolbox:sizmismatch', ...
        'The numbers of samples in X1 and X2 do not match');
end

dmax = min(d1, d2);
if d > dmax
    error('sltoolbox:invalidarg', ...
        'The target dimension d should not exceed d1 or d2');
end

opts.weights = [];
opts.mean1 = [];
opts.mean2 = [];
opts.spectype = 'normal';
opts = slparseprops(opts, varargin{:});

w = opts.weights;
if ~isempty(w)
    if ~isequal(size(w), [1, n])
        error('sltoolbox:sizmismatch', ...
            'w should be a 1 x n row vector');
    end
end

vmean1 = opts.mean1;
vmean2 = opts.mean2;
if ~isempty(vmean1) && ~isequal(vmean1, 0) && ~isequal(size(vmean1), [d1, 1])
    error('sltoolbox:sizmismatch', ...
        'The size of mean1 is illegal');
end
if ~isempty(vmean2) && ~isequal(vmean2, 0) && ~isequal(size(vmean2), [d2, 1])
    error('sltoolbox:sizmismatch', ...
        'The size of mean1 is illegal');
end

%% main skeleton

% preprocess sample matrices

X1 = preprocess_samples(X1, vmean1, w);
X2 = preprocess_samples(X2, vmean2, w);

% construct problem
S = X1 * X2';

switch opts.spectype
    case 'normal'
        if isempty(w)
            tw = n;
        else
            tw = sum(w);
        end
    case 'ratio'
        tw = trace(S * S');
    otherwise
        error('sltoolbox:invalidarg', ...
            'Invalid spectrum type: %s', opts.spectype);
end

if d > dmax / 3;
    [P1, D, P2] = svd(S, 'econ');
    spectrum = diag(D);
    spectrum = spectrum(1:d);
    P1 = P1(:, 1:d);
    P2 = P2(:, 1:d);
else
    [P1, D, P2] = svds(S, d);
    spectrum = diag(D);
end

% post-process spectrum
if nargout >= 3
    spectrum = spectrum .* spectrum / tw;
end

%% Auxiliary functions

function Xp = preprocess_samples(X, vmean, w)

if ~isequal(vmean, 0)
    if isempty(vmean)
        vmean = slmean(X, w, true);
    end
    Xp = sladdvec(X, -vmean, 1);
else
    Xp = X;
end

if ~isempty(w)
    Xp = slmulvec(Xp, w, 2);
end


function prob_test032 ( )

%*****************************************************************************80
%
%% TEST032 tests CHI_SQUARE_CDF, CHI_SQUARE_CDF_VALUES.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 April 2009
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST032:\n' );
  fprintf ( 1, '  CHI_SQUARE_CDF evaluates the cumulative\n' );
  fprintf ( 1, '    distribution function for the chi-square central\n' );
  fprintf ( 1, '    probability density function.\n' );
  fprintf ( 1, '  CHI_SQUARE_CDF_VALUES returns some exact values.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  A    X       Exact F     CHI_SQUARE_CDF(A,X)\n' );
  fprintf ( 1, '\n' );

  n_data = 0;

  while ( 1 )

    [ n_data, a, x, fx ] = chi_square_cdf_values ( n_data );

    if ( n_data == 0 );
      break
    end

    fx2 = chi_square_cdf ( x, a );

    fprintf ( 1, '  %4d  %8f  %14f  %14f\n', a, x, fx, fx2 );

  end

  return
end


function [ n_data, n, k, x, b ] = bernstein_poly_01_values ( n_data )

%*****************************************************************************80
%
%% BERNSTEIN_POLY_01_VALUES returns some values of the Bernstein polynomials.
%
%  Discussion:
%
%    The Bernstein polynomials are assumed to be based on [0,1].
%
%    The formula for the Bernstein polynomials is
%
%      B(N,I)(X) = [N!/(I!*(N-I)!)] * (1-X)**(N-I) * X**I
%
%    In Mathematica, the function can be evaluated by:
%
%      Binomial[n,i] * (1-x)^(n-i) * x^i
%
%  First values:
%
%    B(0,0)(X) = 1
%
%    B(1,0)(X) =      1-X
%    B(1,1)(X) =                X
%
%    B(2,0)(X) =     (1-X)**2
%    B(2,1)(X) = 2 * (1-X)    * X
%    B(2,2)(X) =                X**2
%
%    B(3,0)(X) =     (1-X)**3
%    B(3,1)(X) = 3 * (1-X)**2 * X
%    B(3,2)(X) = 3 * (1-X)    * X**2
%    B(3,3)(X) =                X**3
%
%    B(4,0)(X) =     (1-X)**4
%    B(4,1)(X) = 4 * (1-X)**3 * X
%    B(4,2)(X) = 6 * (1-X)**2 * X**2
%    B(4,3)(X) = 4 * (1-X)    * X**3
%    B(4,4)(X) =                X**4
%
%  Special values:
%
%    B(N,I)(X) has a unique maximum value at X = I/N.
%
%    B(N,I)(X) has an I-fold zero at 0 and and N-I fold zero at 1.
%
%    B(N,I)(1/2) = C(N,K) / 2**N
%
%    For a fixed X and N, the polynomials add up to 1:
%
%      Sum ( 0 <= I <= N ) B(N,I)(X) = 1
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Stephen Wolfram,
%    The Mathematica Book,
%    Fourth Edition,
%    Wolfram Media / Cambridge University Press, 1999.
%
%  Parameters:
%
%    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
%    first call.  On each call, the routine increments N_DATA by 1, and
%    returns the corresponding data; when there is no more data, the
%    output value of N_DATA will be 0 again.
%
%    Output, integer N, the degree of the polynomial.
%
%    Output, integer K, the index of the polynomial.
%
%    Output, real X, the argument of the polynomial.
%
%    Output, real B, the value of the polynomial B(N,K)(X).
%
  n_max = 15;

  b_vec = [ ...
     0.1000000000000000E+01, ...
     0.7500000000000000E+00, ...
     0.2500000000000000E+00, ...
     0.5625000000000000E+00, ...
     0.3750000000000000E+00, ...
     0.6250000000000000E-01, ...
     0.4218750000000000E+00, ...
     0.4218750000000000E+00, ...
     0.1406250000000000E+00, ...
     0.1562500000000000E-01, ...
     0.3164062500000000E+00, ...
     0.4218750000000000E+00, ...
     0.2109375000000000E+00, ...
     0.4687500000000000E-01, ...
     0.3906250000000000E-02 ];

  k_vec = [ ...
    0, ...
    0, 1, ...
    0, 1, 2, ...
    0, 1, 2, 3, ...
    0, 1, 2, 3, 4 ];

  n_vec = [ ...
    0, ...
    1, 1, ...
    2, 2, 2, ...
    3, 3, 3, 3, ...
    4, 4, 4, 4, 4 ];

  x_vec = [ ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00, ...
     0.25E+00 ];

  if ( n_data < 0 )
    n_data = 0;
  end

  n_data = n_data + 1;

  if ( n_max < n_data )
    n_data = 0;
    n = 0;
    k = 0;
    x = 0.0;
    b = 0.0;
  else
    n = n_vec(n_data);
    k = k_vec(n_data);
    x = x_vec(n_data);
    b = b_vec(n_data);
  end

  return
end


function binv = beta_inv (x, a, b)
%  BETA_INV Inverse of the beta cumulative distribution function (cdf).
%     X = BETA_INV(P,A,B) returns the inverse of the beta cdf with
%     parameters A and B at the values in P.

% Copyright (c) 1995-1997, 2005-2007 Kurt Hornik

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

if (nargin ~= 3)
  error('must provide 3 parameters')
end

if (~isscalar (a) || ~isscalar(b))
  if ((size(a,1) ~= size(b,1)) || (size(b,1) ~= size(x,1)))
    error ('betainv: x, a and b must be of common size or scalars');
  end
end

[n,nin] = size(x);
binv = zeros(n,nin);

k = find ((x<0) || (x>1) || (a<0) || (b<0) || isnan(x));
if (any(k))
  binv(k) = NaN;
end

k = find ((x==1) && (a>0) && (b>0));
if (any (k))
  binv(k) = 1;
end

k = find ((x > 0) & (x < 1) & (a > 0) & (b > 0));
if (any (k))
  if (~isscalar(a) || ~isscalar(b))
    a = a(k);
    b = b(k);
    y = a./(a+b);
  else
    y = a/(a + b)*ones(size(k));
  end
  x = x(k);
  l = find (y < eps);
  if (any (l))
    y(l) = sqrt (eps) * ones (length (l), 1);
  end
  l = find (y > 1 - eps);
  if (any (l))
    y(l) = 1 - sqrt (eps) * ones (length (l), 1);
  end

  y_old = y;
  for i = 1 : 10000
    h     = (beta_cdf (y_old, a, b) - x) ./ beta_pdf (y_old, a, b);
    y_new = y_old - h;
    ind   = find (y_new <= eps);
    if (any (ind))
      y_new (ind) = y_old (ind) / 10;
    end
    ind = find (y_new >= 1 - eps);
    if (any (ind))
      y_new (ind) = 1 - (1 - y_old (ind)) / 10;
    end
    h = y_old - y_new;
    if (max (abs (h)) < sqrt (eps))
      break;
    end
    y_old = y_new;
  end

  binv(k) = y_new;
end

end


% Laplacian Smoothing Transform for face recognition

function [gammak,lambda]=lst_basis(M,N,k)
% By Suicheng Gu at Peking University, Jan. 5, 2009
% Email: gusuch@gmail.com

% Output: v: basis. vv: k minimal eigenvalues
% Input:
% N: width of input image, or columns of a matrix
% M: height of input image, or rows of a matrix
% k: Number of low frequency features

%************ An Example ************
% To extract 30 LST low frequency coefficients of an grey image:
%  Im=rand(50,40); [M,N]=size(Im);
%  v=lst_basis(M,N,30);
%  temp=zeros(1,M*N);temp(:)=Im(:);
%  Im_feature=temp*v;
%*********** End ******************

W = sparse([],[],[],M*N,M*N,4*M*N-2*M-2*N);
for x=0:N-2;
    for y=0:M-1;
        W(x*M+y+1,x*M+M+y+1)=1;
        W(x*M+M+y+1,x*M+y+1)=1;
    end;
end;
for x=0:N-1;
    for y=0:M-2;
        W(x*M+y+1,x*M+y+2)=1;
        W(x*M+y+2,x*M+y+1)=1;
    end;
end;
L=sparse(diag(sum(W)))-W;
options.disp = 0; options.isreal = 1; options.issym = 1;
[v,lambda]=eigs(L,k,0,options);
[vv,index] = sort(diag(lambda));
gammak = v(:,index);


function img = discreteTrefoil(varargin)
%DISCRETETREFOIL  Discretize a trefoil curve
%
%   IMG = discreteTrefoil(LX, LY, TREFOIL);
%   Computes the discretisation of a trefoil curve. Inputs are LX and LY,
%   two row vectors specifying pixel positions along each direction, and
%   TREFOIL = [XC YC ROUT RIN THETA], where (XC YC) is the center of the
%   trefoil, ROUT and RIN are the outer and the inner radius, and THETA is
%   the orientation of the first lobe, in degrees counted counter
%   clockwise.
%
%   Example
%     trefoil = [50.12 50.23 45 15 10];
%     img = discreteTrefoil(1:100, 1:100, trefoil);
%     imshow(img)
%
%   See also
%   imShapes, discreteEllipse, discreteStarfish
%

% ------
% Author: David Legland
% e-mail: david.legland@grignon.inra.fr
% Created: 2011-07-13,    using Matlab 7.9.0.529 (R2009b)
% Copyright 2011 INRA - Cepia Software Platform.

% compute coordinate of image pixels
[lx, ly, varargin] = parseGridArgs(varargin{:});
[x, y]   = meshgrid(lx, ly);

% process input parameters
var = varargin{1};
center  = var(:, 1:2);
rOut    = var(:, 3);
rIn     = var(:, 4);
theta   = var(:, 5);

% compute middle radius, and radius extent
rc = (rOut + rIn) / 2;
dr = (rOut - rIn) / 2;

% transforms pixels according to shape position
tra     = createTranslation(-center);
rot     = createRotation(-deg2rad(theta));

[x, y]   = transformPoint(x, y, rot*tra);

% convert to polar coordinates
[th, rho] = cart2pol(x(:), y(:));

% compute theoretical polar distance
rhoTh = rc + dr * cos(3 * th);

% create image
img = false(size(x));
img(rho < rhoTh) = 1;


function [varargout]=ellipsoidFit_centered(varargin)

% function [M,s,R,MU]=ellipsoidFit_centered(X,MU)
% ------------------------------------------------------------------------
%
% Kevin Mattheus Moerman
% kevinmoerman@hotmail.com
% 2014/11/11
%------------------------------------------------------------------------

%%

switch nargin
    case 1
        X=varargin{1};
        MU=mean(X,1); %Point set mean
    case 2
        X=varargin{1};
        MU=varargin{2};
end

if isempty(MU)
    MU=mean(X,1); %Point set mean
end

%%

%Centre on mean
X=X-MU(ones(size(X,1),1),:); %Centre points around mean

%Compute singular value decomposition to get principal directions
[~,D,V]=svd(X,0);

%Compute input radii
r = sqrt(sum(X.^2,2));

%Create sphere coordinates
Xr=(V\X')'; %Rotate back
Xc=(D\Xr')'; %Scale back to unit sphere
[theta,phi,~] = cart2sph(Xc(:,1),Xc(:,2),Xc(:,3));
[Xc(:,1),Xc(:,2),Xc(:,3)]=sph2cart(theta,phi,ones(size(theta)));

%Transforming sphere to ellipsoid according to fit
X_fit=Xc;
X_fit=(D*X_fit')'; %Scale
X_fit=(V*X_fit')'; %Rotate
[~,~,r_fit] = cart2sph(X_fit(:,1),X_fit(:,2),X_fit(:,3));

w=mean(r./r_fit); %Determine SVD weight factor

D=D*w; %Scale singular values using weight to convert to ellipsoid semi-axis constants

%Identity
I=eye(4,4);

%Rotation
R=I;
R(1:3,1:3)=V;

%Stretch factors

s=diag(D)';

S=I;
S(1:3,1:3)=D; %Stretch

T=I;
T(1:3,4)=MU(:); %Translation

M  = T * R * S; %The transformation matrix

%%
varargout{1}=M;
varargout{2}=s;
varargout{3}=R;
varargout{4}=MU;

%%

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


function idx = findClosestCentroids(X, centroids)
%FINDCLOSESTCENTROIDS computes the centroid memberships for every example
%   idx = FINDCLOSESTCENTROIDS (X, centroids) returns the closest centroids
%   in idx for a dataset X where each row is a single example. idx = m x 1
%   vector of centroid assignments (i.e. each entry in range [1..K])
%

% Set K
K = size(centroids, 1);

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

% ====================== YOUR CODE HERE ======================
% Instructions: Go over every example, find its closest centroid, and store
%               the index inside idx at the appropriate location.
%               Concretely, idx(i) should contain the index of the centroid
%               closest to example i. Hence, it should be a value in the
%               range 1..K
%
% Note: You can use a for-loop over the examples to compute this.
%

for i = 1:size(X, 1),
  min_d = inf;
  for k = 1:K,
    dis = X(i, :)' - centroids(k, :)';
    dis_sq = dis' * dis;
    if min_d > dis_sq,
      idx(i) = k;
      min_d = dis_sq;
    endif
  endfor
endfor

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

end


function result = bdf_sum ( func, n, x, w )

%*****************************************************************************80
%
%% BDF_SUM carries out an explicit backward difference quadrature rule for [0,1].
%
%  Discussion:
%
%    The integral:
%
%      Integral ( 0 <= X <= 1 ) F(X) dX
%
%    The quadrature rule:
%
%      sum ( 1 <= I <= N ) W(I) * BDF^(I-1) FUNC ( 0 )
%
%    The integral from 0 to 1 is approximated using data at X = 0,
%    -1, -2, ..., -N+1.  This is a form of extrapolation, and
%    the approximation can become poor as N increases.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 June 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, external FUNC, the function which evaluates
%    the integrand.  The function must have the form
%      function value = func ( x ).
%
%    Input, integer N, the order.
%
%    Input, real X(N), the abscissas.
%
%    Input, real W(N), the weights.
%
%    Output, real RESULT, the approximate value of the integral.
%
  diftab = zeros ( n, 1 );

  for i = 1 : n
    diftab(i) = func ( x(i) );
  end

  for i = 2 : n
    for j = i : n
      diftab(n+i-j) = ( diftab(n+i-j-1) - diftab(n+i-j) );
    end
  end

  result = w(1:n)' * diftab(1:n);

  return
end


function [Q, maxIter] = powerMethodMatComp( U, V, spa, R, maxIter, tol)
% low rank (U*V') + sparse term (data)

if(isempty(R))
    maxIter = 0;
    Q = randn(size(U,1), 1);
    return;
end

Y = (R'*spa')';
Y = U*(V'*R) + Y;
[Q, ~] = qr(Y, 0);
err = zeros(maxIter, 1);
for i = 1:maxIter
    % Y = A*(A'*Q);
    AtQ = (Q'*spa)';
    AtQ = V*(U'*Q) + AtQ;
    Y = (AtQ'*spa')';
    Y = U*(V'*AtQ) + Y;
    [iQ, ~] = qr(Y, 0);

    err(i) = norm(iQ(:,1) - Q(:,1), 2);
    Q = iQ;

    if(err(i) < tol)
        break;
    end
end

maxIter = i;

end


function [M_Gamma2] = gamma_square (Gamma)

M_Gamma2 = zeros(size(Gamma));
for k=1:size(Gamma,2)
    M_Gamma2(:,k) = Gamma(:,k).^2 + Gamma(:,k).*(1-Gamma(:,k));
end;


function x=complexBarycentricCoords2Pt(c,v)
%%COMPLEXBARYCENTRICCOORDS2PT Given a set of complex barycentric
%   coordinates and a st of vertices, get the real 2D point that is
%   specified by the coordinates.
%
%INPUTS: c A numVertXnumPts set of complex coordinate vectors to convert.
%        v This is either a 2XN set of real vertices, or a length N vctor
%          of complex scalar vertices (x coordinate is real and y
%          coordinate is imaginery). These define the polygon over which
%          the vertices are specified.
%
%OUTPUTS: x The 2XnumPts set of the points given by the complex barycentric
%           coordinates.
%
%Complex barycentric coordinates are discussed in [1].
%
%REFERENCES:
%[1] O. Weber, M. Ben-Chen, C. Gotsman, and K. Hormann, "A complex view of
%    barycentric mappings," Computer Graphics Forum, vol. 30, no. 5, pp.
%    1533-1542, Aug. 2011.
%
%October 2021 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

numPts=size(c,2);

if(isvector(v))
    zj=v;
else
    zj=v(1,:).'+1j*v(2,:).';
end

x=zeros(2,numPts);
for curPt=1:numPts
    xComplex=sum(c(:,curPt).*zj);
    x(:,curPt)=[real(xComplex);imag(xComplex)];
end
end

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


function y = nanstd(varargin)
%NANSTD Standard deviation, ignoring NaNs.
%   Y = NANSTD(X) returns the sample standard deviation of the values in X,
%   treating NaNs as missing values.  For a vector input, Y is the standard
%   deviation of the non-NaN elements of X.  For a matrix input, Y is a row
%   vector containing the standard deviation of the non-NaN elements in
%   each column of X. For N-D arrays, NANSTD operates along the first
%   non-singleton dimension of X.
%
%   NANSTD normalizes Y by (N-1), where N is the sample size.  This is the
%   square root of an unbiased estimator of the variance of the population
%   from which X is drawn, as long as X consists of independent, identically
%   distributed samples and data are missing at random.
%
%   Y = NANSTD(X,1) normalizes by N and produces the square root of the
%   second moment of the sample about its mean.  NANSTD(X,0) is the same as
%   NANSTD(X).
%
%   Y = NANSTD(X,FLAG,DIM) takes the standard deviation along dimension
%   DIM of X.
%
%   See also STD, NANVAR, NANMEAN, NANMEDIAN, NANMIN, NANMAX, NANSUM.

%   Copyright 1993-2006 The MathWorks, Inc.
%   $Revision: 1.1.8.1 $  $Date: 2010/03/16 00:15:53 $

% Call nanvar(x,flag,dim) with as many inputs as needed
y = sqrt(nanvar(varargin{:}));


function draw_mandelbrot(x0, x1, y0, y1)

n_grid = 1000;

[x,y] = meshgrid(linspace(x0,x1,n_grid), linspace(y0,y1,n_grid));

c = x + 1i*y;
z = c;
n_iter = 100;
M = zeros(size(c));

for i = 1:n_iter
    z = z.^2 + c;
    M(M==0 & abs(z)>2) = n_iter-i;
end

imagesc(x(1,:), y(:,1),M)
colormap jet


function [phi, Dphi, J] = hexbasis(node,elem,GaussPt)
%% HEXBASIS the basis and their derivatives and the det of Jacobi.
%
%   [phi, Dphi, J] = hexbasis(node,elem,GaussPts) compute the values of
%   bilinear basis and their derivatives and Jacobi det at a gauss point GaussPt in a
%   hex.
%
% Author: Huayi Wei < huayiwei1984@gmail.com>
%
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

NT = size(elem,1);

xi = GaussPt(1);
eta = GaussPt(2);
theta = GaussPt(3);

%% basis function and their derivatives
% for a point (x, y) in real element,  there exist a point in reference
% element (xi, eta), satisfy
%    x = x_1*phi_1 + x_2*phi_2 + x_3*phi_3 + x_4 *phi_4 +
%        x_5*phi_5 +x_6*phi_6 + x_7*phi_7 + x_8 *phi_8
%    y = y_1*phi_1 + y_2*phi_2 + y_3*phi_3 + y_4 *phi_4+
%        y_5*phi_5 +y_6*phi_6 + y_7*phi_7 + y_8 *phi_8
%    z = z_1*phi_1 + z_2*phi_2 + z_3*phi_3 + z_4 *phi_4+
%        z_5*phi_5 +z_6*phi_6 + z_7*phi_7 + z_8 *phi_8

g1 = [xi, 1 - xi];
g2 = [eta, 1 - eta];
g3 = [theta, 1 - theta];

phi = zeros(8,1);
phi(1) = g1(2)*g2(2)*g3(2);
phi(2) = g1(1)*g2(2)*g3(2);
phi(3) = g1(1)*g2(1)*g3(2);
phi(4) = g1(2)*g2(1)*g3(2);
phi(5) = g1(2)*g2(2)*g3(1);
phi(6) = g1(1)*g2(2)*g3(1);
phi(7) = g1(1)*g2(1)*g3(1);
phi(8) = g1(2)*g2(1)*g3(1);

rDphi = zeros(8,3);
rDphi(1,:) = [ -g2(2)*g3(2), -g1(2)*g3(2), -g1(2)*g2(2)];
rDphi(2,:) = [  g2(2)*g3(2), -g1(1)*g3(2), -g1(1)*g2(2)];
rDphi(3,:) = [  g2(1)*g3(2),  g1(1)*g3(2), -g1(1)*g2(1)];
rDphi(4,:) = [ -g2(1)*g3(2),  g1(2)*g3(2), -g1(2)*g2(1)];
rDphi(5,:) = [ -g2(2)*g3(1), -g1(2)*g3(1),  g1(2)*g2(2)];
rDphi(6,:) = [  g2(2)*g3(1), -g1(1)*g3(1),  g1(1)*g2(2)];
rDphi(7,:) = [  g2(1)*g3(1),  g1(1)*g3(1),  g1(1)*g2(1)];
rDphi(8,:) = [ -g2(1)*g3(1),  g1(2)*g3(1),  g1(2)*g2(1)];

X = node(:,1);
Y = node(:,2);
Z = node(:,3);

JM = zeros(NT,3,3);
JM(:,:,1) = X(elem)*rDphi;
JM(:,:,2) = Y(elem)*rDphi;
JM(:,:,3) = Z(elem)*rDphi;

J = JM(:,1,1).*JM(:,2,2).*JM(:,3,3) + JM(:,2,1).*JM(:,3,2).*JM(:,1,3)+ ...
    JM(:,3,1).*JM(:,1,2).*JM(:,2,3) - JM(:,3,1).*JM(:,2,2).*JM(:,1,3)- ...
    JM(:,1,1).*JM(:,3,2).*JM(:,2,3) - JM(:,2,1).*JM(:,1,2).*JM(:,3,3);

InvJM = zeros(NT,3,3);
InvJM(:,:,1) = [JM(:,2,2).*JM(:,3,3) - JM(:,3,2).*JM(:,2,3), JM(:,3,1).*JM(:,2,3)-JM(:,2,1).*JM(:,3,3), JM(:,2,1).*JM(:,3,2) - JM(:,3,1).*JM(:,2,2)];
InvJM(:,:,2) = [JM(:,3,2).*JM(:,1,3) - JM(:,1,2).*JM(:,3,3), JM(:,1,1).*JM(:,3,3)-JM(:,3,1).*JM(:,1,3), JM(:,3,1).*JM(:,1,2) - JM(:,1,1).*JM(:,3,2)];
InvJM(:,:,3) = [JM(:,1,2).*JM(:,2,3) - JM(:,2,2).*JM(:,1,3), JM(:,2,1).*JM(:,1,3)-JM(:,1,1).*JM(:,2,3), JM(:,1,1).*JM(:,2,2) - JM(:,2,1).*JM(:,1,2)];

InvJM(:,:,1) = InvJM(:,:,1)./[J,J,J];
InvJM(:,:,2) = InvJM(:,:,2)./[J,J,J];
InvJM(:,:,3) = InvJM(:,:,3)./[J,J,J];

Dphi = zeros(NT, 3, 8);

for i = 1:8
  Dphi(1:NT,:,i) = [InvJM(:,:,1)*rDphi(i,:)', InvJM(:,:,2)*rDphi(i,:)', InvJM(:,:,3)*rDphi(i,:)'];
end


function phiFaceAverage = geometricMean(phi)
% This function gets the value of the field variable phi defined
% over the MeshStructure and calculates the geometric average on
% the cell faces, for a uniform mesh.
%
% SYNOPSIS:
%   phiFaceAverage = geometricMean(phi)
%
% PARAMETERS:
%
%
% RETURNS:
%
%
% EXAMPLE:
%
% SEE ALSO:
%

% Written by Ali A. Eftekhari
% See the license file

% extract data from the mesh structure

d = phi.domain.dimension;
if (d ==1) || (d==1.5) || (d==1.8)
    dx = phi.domain.cellsize.x;
    xvalue=exp((dx(1:end-1).*log(phi.value(1:end-1))+dx(2:end).*log(phi.value(2:end)))./(dx(2:end)+dx(1:end-1)));
    yvalue=[];
    zvalue=[];
elseif (d == 2) || (d == 2.5) || (d == 2.8)
    Nx = phi.domain.dims(1);
    Ny = phi.domain.dims(2);
    dx = repmat(phi.domain.cellsize.x, 1, Ny);
    dy = repmat(phi.domain.cellsize.y', Nx, 1);
	xvalue=exp((dx(1:end-1,:).*log(phi.value(1:end-1,2:end-1))+...
        dx(2:end,:).*log(phi.value(2:end,2:end-1)))./(dx(2:end,:)+dx(1:end-1,:)));
    yvalue=exp((dy(:,1:end-1).*log(phi.value(2:end-1,1:end-1))+...
        dy(:,2:end).*log(phi.value(2:end-1,2:end)))./(dy(:,2:end)+dy(:,1:end-1)));
    zvalue=[];
elseif (d == 3) || (d==3.2)
    Nx = phi.domain.dims(1);
    Ny = phi.domain.dims(2);
    Nz = phi.domain.dims(3);
    dx = repmat(phi.domain.cellsize.x, 1, Ny, Nz);
    dy = repmat(phi.domain.cellsize.y', Nx, 1, Nz);
    DZ = zeros(1,1,Nz+2);
    DZ(1,1,:) = phi.domain.cellsize.z;
    dz=repmat(DZ, Nx, Ny, 1);
    xvalue=exp((dx(1:end-1,:,:).*log(phi.value(1:end-1,2:end-1,2:end-1))+...
        dx(2:end,:,:).*log(phi.value(2:end,2:end-1,2:end-1)))./(dx(2:end,:,:)+dx(1:end-1,:,:)));
    yvalue=exp((dy(:,1:end-1,:).*log(phi.value(2:end-1,1:end-1,2:end-1))+...
        dy(:,2:end,:).*log(phi.value(2:end-1,2:end,2:end-1)))./(dy(:,1:end-1,:)+dy(:,2:end,:)));
    zvalue=exp((dz(:,:,1:end-1).*log(phi.value(2:end-1,2:end-1,1:end-1))+...
        dz(:,:,2:end).*log(phi.value(2:end-1,2:end-1,2:end)))./(dz(:,:,1:end-1)+dz(:,:,2:end)));
end
phiFaceAverage=FaceVariable(phi.domain, xvalue, yvalue, zvalue);


function b = symm_random_inverse ( n, d, key )

%*****************************************************************************80
%
%% SYMM_RANDOM_INVERSE returns the inverse of the SYMM_RANDOM matrix.
%
%  Discussion:
%
%    The input value of SEED must be the same as the input value used
%    when defining the original matrix.
%
%    For the inverse to exist, no entry of D may be zero.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    10 March 2015
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%
%    Input, real D(N), the desired eigenvalues for the matrix.
%
%    Input, integer KEY, a positive integer that selects the data.
%
%    Output, real B(N,N), the matrix.
%

%
%  Get a random orthogonal matrix Q.
%
  q = orth_random ( n, key );
%
%  Set B = Q * 1/Lambda * Q'.
%
  l_inv = diag ( 1.0 ./ d );

  b = q * l_inv * q';

  return
end


function [T, Y]=FOChuaNR(parameters, orders, TSim, Y0)
%
% Numerical Solution of the Fractional-Order Chua's System
% with piecewise linear nonlinearity defined in function f_x()
%
%   D^q1 x(t) = alpha(y(t) - x(t) - f(x))
%   D^q2 y(t) = x(t) - y(t) + z(t)
%   D^q3 z(t) = -beta y(t) - gamma z(t)
%   where  f(x) is defined as f_x(m0, m1, x);
%
% function [T, Y] = FOChuaNR(parameters, orders, TSim, Y0)
%
% Input:    parameters - model parameters [alpha, beta, gamma, m0, m1]
%           orders - derivatives orders [q1, q2, q3]
%           TSim - simulation time (0 - TSim) in sec
%           Y0 - initial conditions [Y0(1), Y0(2), Y0(3)]
%
% Output:   T - simulation time (0 : Tstep : TSim)
%           Y - solution of the system (x=Y(1), y=Y(2), z=Y(3))
%
% Author:  (c) Ivo Petras (ivo.petras@tuke.sk), 2010.
%

% time step:
h=0.005;
% number of calculated mesh points:
n=round(TSim/h);
%orders of derivatives, respectively:
q1=orders(1); q2=orders(2); q3=orders(3);
% constants of Volta's system:
alpha=parameters(1); beta=parameters(2); gamma=parameters(3);
m0=parameters(4); m1=parameters(5);
% binomial coefficients calculation:
cp1=1; cp2=1; cp3=1;
for j=1:n
    c1(j)=(1-(1+q1)/j)*cp1;
    c2(j)=(1-(1+q2)/j)*cp2;
    c3(j)=(1-(1+q3)/j)*cp3;
    cp1=c1(j); cp2=c2(j); cp3=c3(j);
end
% initial conditions setting:
x(1)=Y0(1); y(1)=Y0(2); z(1)=Y0(3);
% calculation of phase portraits /numerical solution/:
for i=2:n
    x(i)=(alpha*(y(i-1)-x(i-1)-f_x(m1,m0,x(i-1))))*h^q1 - memo(x, c1, i);
    y(i)=(x(i)-y(i-1)+z(i-1))*h^q2 - memo(y, c2, i);
    z(i)=(-beta*y(i)-gamma*z(i-1))*h^q3 - memo(z, c3, i);
end
for j=1:n
    Y(j,1)=x(j);
    Y(j,2)=y(j);
    Y(j,3)=z(j);
end
T=h:h:TSim;
%


function legendre_2d_exactness ( a, b, n, x, y, w, t )

%*****************************************************************************80
%
%% LEGENDRE_2D_EXACTNESS: monomial exactness for the 2D Legendre integral.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 May 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real A(2), the lower limits of integration.
%
%    Input, real B(2), the upper limits of integration.
%
%    Input, integer N, the number of points in the rule.
%
%    Input, real X(N), Y(N), the quadrature points.
%
%    Input, real W(N), the quadrature weights.
%
%    Input, integer T, the maximum total degree.
%    0 <= T.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Quadrature rule for the 2D Legendre integral.\n' );
  fprintf ( 1, '  Number of points in rule is %d\n', n );
  fprintf ( 1, '\n' );
  fprintf ( 1, '   D   I       J          Relative Error\n' );

  for tt = 0 : t

    fprintf ( 1, '  %2d\n', tt );

    for j = 0 : tt

      i = tt - j;

      p(1) = i;
      p(2) = j;

      s = legendre_2d_monomial_integral ( a, b, p );

      v(1:n,1) = x(1:n,1) .^ p(1) .* y(1:n,1) .^ p(2);

      q = w' * v;

      if ( s == 0.0 )
        e = abs ( q );
      else
        e = abs ( q - s ) / abs ( s );
      end

      fprintf ( 1, '  %6d  %6d  %24.16g\n', p(1), p(2), e );

    end
  end

  return
end


function quadrule_test12 ( )

%*****************************************************************************80
%
%% TEST12 tests FEJER2_INTEGRATE_FAST.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    05 March 2007
%
%  Author:
%
%    John Burkardt
%
  order_max = 16;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST12\n' );
  fprintf ( 1, '  FEJER2_INTEGRATE_FAST applies a Fejer Type 2 rule;\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The integration interval is [-1,1].\n' );
  fprintf ( 1, '  Quadrature order will vary.\n' );
  fprintf ( 1, '  Integrand will vary.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '   Order          F1              F2              F3\n' );
  fprintf ( 1, '\n' );

  for order = 1 : order_max

    result(1) = fejer2_integrate_fast ( @f1, order );
    result(2) = fejer2_integrate_fast ( @f2, order );
    result(3) = fejer2_integrate_fast ( @f3, order );

    fprintf ( 1, '  %6d  %14f  %14f  %14f\n', order, result(1:3) );

  end

  fprintf ( 1, '\n' );

  result(1) = 46.0 * sinh ( 1.0 ) / 25.0 - 2.0 * sin ( 1.0 );
  result(2) = 1.5822329637296729331;
  result(3) = ( sqrt ( 2.0 ) + 3.0 * sqrt ( 6.0 ) ) / 6.0;

  fprintf ( 1, '  Exact   %14f  %14f  %14f\n', result(1:3) );

  return
end


function X = positive_definite_karcher_mean(A)
% Computes a Karcher mean of a collection of positive definite matrices.
%
% function X = positive_definite_karcher_mean(A)
%
% Input:  A 3D matrix A of size nxnxm such that each slice A(:,:,k) is a
%         positive definite matrix of size nxn.
%
% Output: A positive definite matrix X of size nxn which is a Karcher mean
%         of the m matrices in A, that is, X minimizes the sum of squared
%         Riemannian distances to the matrices in A:
%            f(X) = sum_k=1^m .5*dist^2(X, A(:, :, k))
%         The distance is defined by the natural metric on the set of
%         positive definite matrices: dist(X,Y) = norm(logm(X\Y), 'fro').
%
% This simple example is not the best way to compute Karcher means. Its
% purpose it to serve as base code to explore other algorithms. In
% particular, in the presence of large noise, this algorithm seems to not
% be able to reach points with a very small gradient norm. This may be
% caused by insufficient accuracy in the gradient computation.

% This file is part of Manopt and is copyrighted. See the license file.
%
% Main author: Nicolas Boumal, Sept. 3, 2013
% Contributors:
%
% Change log:
%

    % Generate some random data to test the function if none is given.
    if ~exist('A', 'var') || isempty(A)
        n = 5;
        m = 10;
        A = zeros(n, n, m);
        ref = diag(max(.1, 1+.1*randn(n, 1)));
        for i = 1 : m
            noise = 0.01*randn(n);
            noise = (noise + noise')/2;
            [V, D] = eig(ref + noise);
            A(:, :, i) = V*diag(max(.01, diag(D)))*V';
        end
    end

    % Retrieve the size of the problem:
    % There are m matrices of size nxn to average.
    n = size(A, 1);
    m = size(A, 3);
    assert(n == size(A, 2), ...
           ['The slices of A must be square, i.e., the ' ...
	        'first and second dimensions of A must be equal.']);

    % Our search space is the set of positive definite matrices of size n.
    % Notice that this is the only place we specify on which manifold we
    % wish to compute Karcher means. Replacing this factory for another
    % geometry will yield code to compute Karcher means on that other
    % manifold, provided that manifold is equipped with a dist function and
    % a logarithmic map log.
    M = sympositivedefinitefactory(n);

    % Define a problem structure, specifying the manifold M, the cost
    % function and its gradient.
    problem.M = M;
    problem.cost = @cost;
    problem.grad = @grad;

    % Explicitly pick an approximate Hessian for the trust-region method
    problem.approxhess = approxhessianFD(problem, struct('stepsize', 1e-4));

    % The functions below make many redundant computations. This
    % performance hit can be alleviated by using the caching system. We go
    % for a simple implementation here, as a tutorial example.

    % Cost function
    function f = cost(X)
        f = 0;
        for k = 1 : m
            f = f + M.dist(X, A(:, :, k))^2;
        end
        f = f/(2*m);
    end

    % Riemannian gradient of the cost function
    function g = grad(X)
        g = M.zerovec(X);
        for k = 1 : m
            % Update g in a linear combination of the form
            % g = g - [something]/m.
            g = M.lincomb(X, 1, g, -1/m, M.log(X, A(:, :, k)));
        end
    end

    % Execute some checks on the derivatives for early debugging.
    % These things can be commented out of course.
    % The slopes should agree on part of the plot at least. In this case,
    % it is sometimes necessary to inspect the plot visually to make the
    % call, but it is indeed correct.
    % checkgradient(problem);
    % pause;

    % Execute this if you want to force using a proper parallel vector
    % transport. This is not necessary. If you omit this, the default
    % vector transport is the identity map, which is (of course) cheaper
    % and seems to perform well in practice.
    % M.transp = M.paralleltransp;

    % Issue a call to a solver. Default options are selected.
    % Our initial guess is the first data point.
    X = trustregions(problem, A(:, :, 1));

end


function U = unionHull(varargin)
%unionHull - computes the convex hull of the union of other bounded convex polyhedra.
%Any number of polyhedra can be input to the union operation. They can
%be expressed using either vertices or linear in/equalities, according to
%the input scheme,
%
%
%   I = intersectionHull('vert', V1, 'lcon', A2,b2,...,'qlcon', x3,A3,b3,...)
%
%The arguments specifying different polyhedra are separated using labels
%'vert', 'lcon', or 'qlcon'. The label 'vert' signifies that an input polyhedron will
%be expressed using vertices and is to be followed by any string of input arguments
%accepted by vert2lcon(). The label 'lcon' signifies that an input polyhedron will
%be expressed using linear constraints and is to be followed by any string of
%input arguments accepted by lcon2vert(). The label 'qlcon' signifies that an input
%polyhedron will be expressed using linear constraints and a known interior point and
%is to be followed by  input arguments accepted by qlcon2vert().
%
%The output, U, is a struct containing fields
%
%   U.vert: A matrix whose rows are the vertices of the output polyhedron.
%   U.lcon: The quadruplet of linear constraint data {A,b,Aeq,beq}
%           describing the output polyhedron.
%
%EXAMPLE 1: The unit simplex in 3D is formed as the convex hull of the union
%of a cube and a triangle, both expressed in terms of their vertices.
%
%     V1=(dec2bin(0:2^3-1,3)-'0')/3.0001;    %vertices of 3D cube
%     V2=eye(3);  %vertices of triangle
%
%     U=unionHull('vert',V1,'vert',V2);   %compute the union
%
%One can verify that the vertices of the result are those of the unit
%simplex,
%
%       >> U.vert
%
%             ans =
%
%                  0     0     0
%                  0     0     1
%                  0     1     0
%                  1     0     0
%
%We also demonstrate the use of separateBounds() to convert the result to
%Optimization Toolbox representation. The tolerance parameter 0.99 is used
%to deal with residual floating point noise.
%
%         >> [A,b,Aeq,beq,lb,ub]=separateBounds(U.lcon{:},.99)
%
%             A =
%
%                 0.5774    0.5774    0.5774
%
%
%             b =
%
%                 0.5774
%
%
%             Aeq =
%
%                  []
%
%
%             beq =
%
%                Empty matrix: 0-by-1
%
%
%             lb =
%
%                  0
%                  0
%                  0
%
%
%             ub =
%
%                Inf
%                Inf
%                Inf
%
%
%
%EXAMPLE 2: The unit cube is formed as the union of a simplex, a square,
%and a single 3D point. The simplex and square are both represented using
%equalites and inequalities. For convenience, we use the addBounds() utility
%to compose the in/equality matrices. The representation of the square illustrates
%the use of the 'qlcon' label, when a known interior point is available.
%
%
%     [A1,b1,Aeq1,beq1] = addBounds([1 1 1],1,[],[],[0;0;0]); %unit simplex
%
%     [A2,b2,Aeq2,beq2] = addBounds([],[],[],[],[1;0;0],[1;1;1]); %a square face of the unit cube
%
%                    x2 = [1,0.5,0.5];%a point in the relative interior of the square
%
%     V3 = [0,1,1]; %one vertex of the unit cube
%
%
%     U=unionHull('lcon',A1,b1,Aeq1,beq1,...         %compute the union
%                 'qlcon',x2,A2,b2,Aeq2,beq2,...
%                  'vert',V3);
%
%One can verify that the result contains the 8 vertices of the unit cube,
%
%       >> U.vert
%
%         ans =
%
%                  0   -0.0000   -0.0000
%             0.0000   -0.0000    1.0000
%            -0.0000    1.0000   -0.0000
%                  0    1.0000    1.0000
%             1.0000    0.0000    0.0000
%             1.0000    0.0000    1.0000
%             1.0000    1.0000    0.0000
%             1.0000    1.0000    1.0000
%
%As before, we can use separateBounds() to convert to Optimization Toolbox
%form,
%
%     >>  [A,b,Aeq,beq,lb,ub]=separateBounds(U.lcon{:},.99)
%
%which results in A=b=Aeq=beq=[] and
%
%    lb =
%
%          0
%          0
%          0
%
%
%     ub =
%
%         1.0000
%         1.0000
%         1.0000

%%%%begin parsing

if isnumeric(varargin{1})
   TOLcell=varargin(1);
   varargin(1)=[];
else
    TOLcell={};
end

N=length(varargin);
idxType = [find(cellfun(@ischar,varargin)),N+1];

L=length(idxType)-1;
S(L).type=[];
S(L).args={};

for i=1:L

    j=idxType(i);
    k=idxType(i+1);
    S(i).type=varargin{j};
    S(i).args=varargin(j+1:k-1);

    if isempty(S(i).args)
     error 'Syntax error - arguments missing'
    end

     switch S(i).type

        case 'lcon'

             S(i).V = lcon2vert(S(i).args{:});

        case 'qlcon'

            S(i).V = qlcon2vert(S(i).args{:});

        case 'vert'

            S(i).V = S(i).args{1};

        otherwise

            error(['Unrecognized representation label of polyhedron ' num2str(i)]);

      end

 end

%%%%end parsing

    V=vertcat(S.V);

    x0=mean(V,1);

   [U.lcon{1:4}]=vert2lcon(V,TOLcell{:});

   U.vert=qlcon2vert(x0,U.lcon{:},TOLcell{:});


function mb_lbfgs

% 2010 m.bangert@dkfz.de
% fitting a gaussian distribution to data with a quasi newton method using
% a lbfgs update for the inverse hessian matrix
%
% example : mb_bfgs (function does not take any argument)

% options
visLineSearch = 1;
visBool       = 1;

% sample data from a gaussian distribution
randn('seed',12345); %set the seed of the random number generator - if you do not want to do that comment...
numOfSamples = 250;
data(:,1)    = linspace(-2,4,numOfSamples) + 6/numOfSamples*randn(1,numOfSamples);
data(:,2)    = exp(-(linspace(-2,4,250)-1.5).^2) + .05*randn(1,250);

% plot data
if visBool
    close all
    figure
    hold on
    plot(data(:,1),data(:,2),'b+')
    xlabel('X')
    ylabel('Y')
    visHandle = [];
end

% specify input
mem          = 10;        % number of past gradients and function values used for inverse hessian contruction
x            = NaN*ones(3,mem);
x(:,1)       = [1 1 1]';  % starting value for parameters
objFuncValue = NaN*ones(1,mem);
dx           = NaN*ones(3,mem);

s_k = ones(3,mem-1);
y_k = ones(3,mem-1);
r_k = ones(mem-1,1);
a_k = ones(1,mem-1);

fprintf(['\nFitting a gaussian distribution to data with an L-BFGS-B algorithm...\n\n']);

% 1st calculation of objective function and gradient
objFunc         = @(x) sum((x(3,1).*exp(-(data(:,1)-x(1,1)).^2./x(2,1))-data(:,2)).^2);
objFuncValue(1) = objFunc(x(:,1));
objFuncValue(2) = objFuncValue(1) + 1;
dx(:,1)          = mb_numDiff(objFunc,x(:,1));

% iterate
iter      = 0;
numOfIter = 100;
prec      = 1e-5;

% convergence if gradient smaller than prec, change in objective function
% smaller than prec or maximum number of iteration reached...
while iter < numOfIter && abs((objFuncValue(2)-objFuncValue(1))/objFuncValue(1))>prec && norm(dx(:,1))>prec

    % implementation of L-BFGS according to
    % http://en.wikipedia.org/wiki/L-BFGS

    % inverse hessian update
    q = dx(:,1);
    for i = 1:min(iter,mem-1)
        a_k(i) = r_k(i)*s_k(:,i)'*q;
        q      = q - a_k(i)*y_k(:,i);
    end
    z = s_k(:,1)'*y_k(:,1)/(y_k(:,1)'*y_k(:,1))*q; % this corresponds to H*q where H is approximated as described in Nocedal 9.1
    for i = min(iter,mem-1):-1:1
        b = r_k(i)*y_k(:,i)'*z;
        z = z + s_k(:,i)*(a_k(i)-b);
    end

    % obtain search direction
    dir = -z;

    % 2.1 armijo linesearch to to find acceptable stepsize alpha
    alpha = mb_backtrackingLineSearch(objFunc,objFuncValue(1),x(:,1),dx(:,1),dir);

    % 3
    p = alpha*dir;

        % visualize the line search (optional) used for debugging
        if visLineSearch
            figure
            hold on
            alphas   = linspace(0,2*alpha,100);
            alphaVis = NaN*alphas;
            for i = 1:100
                alphaVis(i) = objFunc(x(:,1)+alphas(i)*dir);
            end
            plot(alphas,alphaVis,'b') % function in direction of line search
            plot(alpha,objFunc(x(:,1)+alpha*dir),'r.') % the steplength found
            plot(alphas,objFuncValue(1) + 1e-1*alphas*(dir'*dx(:,1)),'g') % constraint
            pause(.5)
            close
        end

    % 2.2 update x
    x(:,2:end) = x(:,1:end-1);
    x(:,1)     = x(:,1) + p;
    s_k        = -diff(x,[],2);

    % update objective function (and remember old objective function to
    % check for convergence)
    objFuncValue(2) = objFuncValue(1);
    objFuncValue(1) = objFunc(x(:,1));

    % increment iteration counter
    iter = iter + 1;

    fprintf(1,'Iteration %d: alpha_min=%f, OF=%f\n',iter,alpha,objFuncValue(1));

    % calculate difference of gradients
    dx(:,2:end) = dx(:,1:end-1);
    dx(:,1)     = mb_numDiff(objFunc,x(:,1));
    y_k         = -diff(dx,[],2);

    r_k = 1./diag(y_k'*s_k);

    % update function with new x and plot
    if visBool
        pause(0.5)
        fitFunc = @(t) x(3).*exp(-(t-x(1)).^2./x(2));
        delete(visHandle);
        visHandle = plot(data(:,1),fitFunc(data(:,1)),'r','LineWidth',4);
        drawnow;
    end

end

fprintf(['\n' num2str(iter) ' iteration(s) performed to converge\n'])

fprintf(1,'Final solution: x=(%f,%f,%f)\n',x(1),x(2),x(3));

end


function R = Rroll(phi)

c = cos(phi); s = sin(phi);
R = [1 0 0; 0 c -s; 0 s c];


function value = i4_modp ( i, j )

%*****************************************************************************80
%
%% I4_MODP returns the nonnegative remainder of I4 division.
%
%  Discussion:
%
%    If
%      NREM = I4_MODP ( I, J )
%      NMULT = ( I - NREM ) / J
%    then
%      I = J * NMULT + NREM
%    where NREM is always nonnegative.
%
%    The MOD function computes a result with the same sign as the
%    quantity being divided.  Thus, suppose you had an angle A,
%    and you wanted to ensure that it was between 0 and 360.
%    Then mod(A,360) would do, if A was positive, but if A
%    was negative, your result would be between -360 and 0.
%
%    On the other hand, I4_MODP(A,360) is between 0 and 360, always.
%
%  Example:
%
%        I     J     MOD  I4_MODP    Factorization
%
%      107    50       7       7    107 =  2 *  50 + 7
%      107   -50       7       7    107 = -2 * -50 + 7
%     -107    50      -7      43   -107 = -3 *  50 + 43
%     -107   -50      -7      43   -107 =  3 * -50 + 43
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 August 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer I, the number to be divided.
%
%    Input, integer J, the number that divides I.
%
%    Output, integer VALUE, the nonnegative remainder when I is
%    divided by J.
%
  if ( j == 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'I4_MODP - Fatal error!\n' );
    fprintf ( 1, '  Illegal divisor J = %d\n', j );
    error ( 'I4_MODP - Fatal error!' );
  end

  value = mod ( i, j );

  if ( value < 0 )
    value = value + abs ( j );
  end

  return
end


function sftpack_test02 ( )

%*****************************************************************************80
%
%% TEST02 tests R8VEC_SFTB and R8VEC_SFTF.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    27 February 2010
%
%  Author:
%
%    John Burkardt
%
  n = 36;
  alo = 0.0;
  ahi = 5.0;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST02\n' );
  fprintf ( 1, '  For real slow Fourier transforms,\n' );
  fprintf ( 1, '  R8VEC_SFTF computes the forward transform.\n' );
  fprintf ( 1, '  R8VEC_SFTB computes the backward transform.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The number of data values, N = %d\n', n );

  seed = 123456789;

  [ x, seed ] = r8vec_uniform ( n, alo, ahi, seed );

  r8vec_print_part ( n, x, 10, '  The original data:' );
%
%  Compute the slow Fourier transform of the data.
%
  [ azero, a, b ] = r8vec_sftf ( n, x );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  A (cosine) coefficients:\n' );
  fprintf ( 1, '\n' );

  fprintf ( 1, '  %4d  %f\n', 0, azero );

  for i = 1 : floor ( n / 2 )
   fprintf ( 1, '  %4d  %f\n', i, a(i) );
  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  B (sine) coefficients:\n' );
  fprintf ( 1, '\n' );

  for i = 1 : floor ( n / 2 )
    fprintf ( 1, '  %4d  %f\n', i, b(i) );
  end
%
%  Now try to retrieve the data from the coefficients.
%
  x = r8vec_sftb ( n, azero, a, b );

  r8vec_print_part ( n, x, 10, '  The retrieved data:' );

  return
end


function spline_test125 ( )

%*****************************************************************************80
%
%% TEST125 tests LEAST_SET_OLD, LEAST_VAL_OLD.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 January 2007
%
%  Author:
%
%    John Burkardt
%
  maxdeg = 6;
  ntab = 21;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST125\n' );
  fprintf ( 1, '  LEAST_SET_OLD sets a least squares polynomial,\n' );
  fprintf ( 1, '  LEAST_VAL_OLD evaluates it.\n' );

  for i = 1 : ntab
    xtab(i) = ( ( ntab - i     ) * ( -1.0 )   ...
              + (        i - 1 ) * ( +1.0 ) ) ...
              / ( ntab     - 1 );
    ytab(i) = ( floor ( exp ( xtab(i) ) * 100.0 + 0.5 ) ) / 100.0;
  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  The data to be interpolated:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Number of data values = %d\n', ntab );
  fprintf ( 1, '\n' );
  fprintf ( 1, '       X             Y\n' );
  fprintf ( 1, '\n' );

  for i = 1 : ntab
    fprintf ( 1, '%14f  %14f\n', xtab(i), ytab(i) );
  end

  for ndeg = 1 : maxdeg

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Use a polynomial of degree: %d\n', ndeg );
    fprintf ( 1, '\n' );

    [ ptab, b, c, d, eps, ierror ] = least_set_old ( ntab, xtab, ytab, ndeg );

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Total approximation error = %f\n', eps );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  X, F(X), P(X), Error\n' );
    fprintf ( 1, '\n' );

    for i = 1 : ntab

      if ( i < ntab )
        jhi = 2;
      else
        jhi = 0;
      end

      for j = 0 : jhi

        if ( i < ntab )

          xval = ( ( 3 - j ) * xtab(i)     ...
                 + (     j ) * xtab(i+1) ) ...
                 / ( 3     );

        else

          xval = xtab(i);

        end

        yval = least_val_old ( xval, ndeg, b, c, d );

        ytrue = ( floor ( exp ( xval ) * 100.0 + 0.5 ) ) / 100.0;

        fprintf ( 1, '%14f  %14f  %14f  %14f\n', xval, yval, ytrue, ...
          yval - ytrue );

      end

    end

  end

  return
end


function [B1, C1, c1, B2, C2, c2] = ssad(a, b, A)
%SSAD  gives both solutions to the side-side-angle problem, in degrees.
%
%   SSAD(a, b, A) will result in NaNs if the existence condition
%   |sin b * sin A| <= | sin a |  is not met.
%
%   See also SSA, MALD, MSLD.

% Rody P.S. Oldenhuis
% Delft University of Technology
% oldenhuis@gmail.com
%
% Crated     : 23/Feb/2009
% Last edited: 30/Nov/2012

    % find both solutions by calling ssa directly
    r2d = 180/pi;
    d2r = 1/r2d;
    [B1, C1, c1, B2, C2, c2] = ssa(a*d2r, b*d2r, A*d2r);
    [B1, C1, c1, B2, C2, c2] = deal(B1*r2d, C1*r2d, c1*r2d, B2*r2d, C2*r2d, c2*r2d);

end


% Chapter 17 - Neural Networks.
% Programs_17a - The Generalized Delta Learning Rule (Figure 17.7).
% Copyright Birkhauser 2013. Stephen Lynch.

function Programs_17a
% Load Boston housing data.
load housing.txt
X = housing(:,[6 9 13]);
t = housing(:,14);

% Scale to zero mean, unit variance and introduce bias on input.
xmean = mean(X);
xstd = std(X);
X = (X-ones(size(X,1),1)*xmean)./(ones(size(X,1),1)*xstd);
X = [ones(size(X,1),1) X];
tmean = (max(t)+min(t))/2;
tstd = (max(t)-min(t))/2;
t = (t-tmean)/tstd;

% Initialise random weight vector.
randn('seed', 123456);
w(:,1) = 0.1*randn(size(X,2),1);
y1 = tanh(X*w(:,1));
e1 = t-y1;
mse(1) = var(e1);

% Do numEpochs iterations.
numEpochs = 10;
numPatterns = size(X,1);
eta = 0.001;
k = 1;
for m=1:numEpochs
  for n=1:numPatterns
	% Calculate feedforward output, error, and gradient.
	yk = tanh(X(n,:)*w(:,k));
	err = yk-t(n);
	g = X(n,:)'*((1-yk^2)*err);
	% Update the weight.
	w(:,k+1) = w(:,k) - eta*g;
	k = k+1;
  end
end

for m=1:size(w,1)
plot(1:k, w(m,:))
hold on
end

fsize=15;
set(gca,'XTick',0:2000:6000,'FontSize',fsize)
set(gca,'YTick',-0.3:0.1:0.3,'FontSize',fsize)
xlabel('Number of Iterations','FontSize',fsize)
ylabel('Weights','FontSize',fsize)
hold off

% End of Programs_17a.


function [x, fval, exitflag, output, lambda] = cplexlp (f, Aineq, bineq, Aeq, beq, lb, ub, x0, options)
%%
% Purpose
% Solve linear programming problems.
%
% Syntax
%    x = cplexlp(f, Aineq, bineq)
%    x = cplexlp(f, Aineq, bineq, Aeq, beq)
%    x = cplexlp(f, Aineq, bineq, Aeq, beq, lb, ub)
%    x = cplexlp(f, Aineq, bineq, Aeq, beq, lb, ub, x0)
%    x = cplexlp(f, Aineq, bineq, Aeq, beq, lb, ub, x0, options)
%    x = cplexlp(problem)
%    [x, fval] = cplexlp(...)
%    [x, fval, exitflag] = cplexlp(...)
%    [x, fval, exitflag, output] = cplexlp(...)
%    [x, fval, exitflag, output, lambda] = cplexlp(...)
%
% Description
% Finds the minimum of a problem specified by
%    min      f*x
%    st.      Aineq*x <= bineq
%             Aeq*x    = beq
%             lb <= x <= ub
%
% f, bineq, beq, lb, and ub are column vectors.
% Aineq and Aeq are matrices.
%
% x = cplexlp(f,Aineq,bineq) solves the linear programming problem min f*x
% such that Aineq*x <= bineq.
%
% x = cplexlp(f,Aineq,bineq,Aeq,beq) solves the preceding problem with the
% additional equality constraints Aeq*x = beq. If no inequalities exist,
% set Aineq=[] and bineq=[].
%
% x = cplexlp(f,Aineq,bineq,Aeq,beq,lb,ub) defines a set of lower and upper
% bounds on the design variables, x, so that the solution is always in the
% range lb <= x <= ub. If no equalities exist, set Aeq=[] and beq=[].
%
% x = cplexlp(f,Aineq,bineq,Aeq,beq,lb,ub,x0) sets the starting point for
% the algorithm to x0. If no bounds exist, set lb=[] and ub=[].
%
% x = cplexlp(f,Aineq,bineq,Aeq,beq,lb,ub,x0,options) minimizes with the
% default optimization options replaced by values in the structure options,
% which can be created using the function cplexoptimset. If you do not wish
% to give an initial point, set x0=[].
%
% x = cplexlp(problem) where problem is a structure.
%
% [x,fval] = cplexlp(...) returns the value of the objective function at
% the solution x: fval = f*x.
%
% [x,fval,exitflag] = cplexlp(...) returns a value exitflag that describes
% the exit condition of cplexlp.
%
% [x,fval,exitflag,output] = cplexlp(...) returns a structure output that
% contains information about the optimization.
%
% [x,fval,exitflag,output,lambda] = cplexlp(...) returns a structure lambda
% whose fields contain the Lagrange multipliers at the solution x.
%
% Input Arguments
% problem   Structure containing the following fields:
%           f         Double column vector for objective function
%           Aineq     Double matrix for linear inequality constraints
%           bineq     Double column vector for linear inequality
%                     constraints
%           Aeq       Double matrix for linear equality constraints
%           beq       Double column vector for linear equality constraints
%           lb        Double column vector of lower bounds
%           ub        Double column vector of upper bounds
%           x0        Double column vector of initial point of x
%           options   Options structure created with cplexoptimset
%
% Output Arguments
% x         Solution found by the optimization function. If exitflag > 0,
%           then x is a solution; otherwise, x is the value of the
%           optimization routine when it terminated prematurely.
% fval      Value of the objective function at the solution x
% exitflag  Integer identifying the reason the optimization algorithm
%           terminated
% output    Structure containing information about the optimization. The
%           fields of the structure are:
%           iterations         Number of iterations
%           algorithm          Optimization algorithm used
%           message            Exit message
%           time               Execution time of the algorithm
%           cplexstatus        Status code of the solution
%           cplexstatusstring  Status string of the solution
% lambda    Structure containing the Lagrange multipliers at the solution x
%           (separated by constraint type). The fields of the structure
%           are:
%           lower              Lower bounds lb
%           upper              Upper bounds ub
%           ineqlin            Linear inequalities
%           eqlin              Linear equalities
%
%
%  See also cplexoptimset
%

% ---------------------------------------------------------------------------
% File: cplexlp.m
% ---------------------------------------------------------------------------
% Licensed Materials - Property of IBM
% 5725-A06 5725-A29 5724-Y48 5724-Y49 5724-Y54 5724-Y55
% Copyright IBM Corporation 2008, 2010. All Rights Reserved.
%
% US Government Users Restricted Rights - Use, duplication or
% disclosure restricted by GSA ADP Schedule Contract with
% IBM Corp.
% ---------------------------------------------------------------------------


function [W, Zhat] = ica(X,Nsources,Wprev)
%ICA  Perform independent component analysis
%  [W, ZHAT] = ICA(X) performs independent component analysis on data
%  observation matrix X of physiological observations.
%
%   Inputs:
%       X               = Observation matrix: rows should be observations, cols samples.
%       Nsources        = Number of source signals (optional).
%       Wprev           = Timepoint at which to start process (default = 0 seconds).
%
%   Outputs:
%       W               = Demixing matrix.
%       Zhat            = Source signal matrix.
%
%  This approach uses Cardoso's ICA
%  algorithm to estimate sources (ZHAT) and the de-mixing matrix W, an
%  approximation to A^{-1}, the original (unknown) mixing matrix.
%
% Daniel McDuff, Ethan Blackford, Justin Estepp, December 2018
% Based on an implementation by: G D Clifford (2004) gari AT mit DOT edu
% Licensed under the MIT License and the RAIL AI License.

[nRows, nCols] = size(X);
if nRows > nCols
    fprintf('Warning - The number of rows is cannot be greater than the number of columns.\n');
    error('Please transpose input.');
end

if Nsources > min([nRows nCols])
    Nsources = min([nRows nCols]);
    fprintf('Warning - The number of soures cannot exceed number of observation channels. \n')
    fprintf('The number of sources will be reduced to the number of observation channels (%i) \n',Nsources)
end

if exist('Vprev','var')
    [Winv, Zhat] = jade(X,Nsources,Wprev);
else
    [Winv, Zhat] = jade(X,Nsources);
end
W = pinv(Winv);


% Simulation of Simple Pendulum
%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
% 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                                |
%                   Senior Research Fellow                                |
%                   Structural Mechanics Laboratory                       |
%                   Indira Gandhi Center for Atomic Research              |
%                   India                                                 |
% E-mail : allwayzitzme@gmail.com                                         |
%          http://sites.google.com/site/kolukulasivasrinivas/             |
%-------------------------------------------------------------------------
clear ;clc ;
% Properties of Pendulum (Can be altered)
g = 9.81 ;           % Acceleration due to gravity
M = 10 ;              % Mass of the pendulum
L = 1 ;              % Length of the Pendulum
C = 0.7 ;             % Damping

% Initial Boundary Conditions (Can be altered)
Phi = 0.5;            % Position
dtPhi = 1.0;        % Velocity

duration = 60;      % Duration of the Simulation
fps = 10;           % Frames per second
%movie = true;         % true if wanted to save animation as avi file
movie = false ;         % false if only want to view animation
arrow = 'ShowArrow' ; % Shows the direction of phase plane plot
%arrow = 'NoNoArrow' ;   % Will not show the direction of phase plane plot
interval = [0, duration];               % Time span
ivp=[Phi; dtPhi; g; M; L ; C];     % Initial value's for the problem
% Simulation of Simple Pendulum
Animation(ivp, duration, fps, movie,arrow);


function varargout = sphereMesh(sphere, varargin)
%SPHEREMESH Create a 3D mesh representing a sphere.
%
%   [V, F] = sphereMesh(S)
%   Creates a 3D mesh representing the sphere S given by [xc yc zy r].
%
%   [V, F] = sphereMesh();
%   Assumes sphere is the unit sphere centered at the origin.
%
%   [V, F] = sphereMesh(S, 'nTheta', NT, 'nPhi', NP);
%   Specifies the number of discretisation steps for the meridians and the
%   parallels. Default values are nTheta = 16 and nPhi = 32.
%
%
%   Example
%     s = [10 20 30 40];
%     [v, f] = sphereMesh(s);
%     drawMesh(v, f);
%     view(3); axis equal; light; lighting gouraud;
%
%   See also
%     meshes3d, drawSphere, ellipsoidMesh, cylinderMesh, surfToMesh
%

% ------
% Author: David Legland
% E-mail: david.legland@inra.fr
% Created: 2012-10-25, using Matlab 7.9.0.529 (R2009b)
% Copyright 2012-2022 INRA - Cepia Software Platform

if nargin == 0
    sphere = [0 0 0 1];
end

% number of meridians
nPhi    = 32;

% number of parallels
nTheta  = 16;

% process input arguments
while length(varargin) > 1
    paramName = varargin{1};
    switch lower(paramName)
        case 'ntheta', nTheta = varargin{2};
        case 'nphi', nPhi = varargin{2};
        otherwise
            error(['Could not recognise parameter: ' paramName]);
    end
    varargin(1:2) = [];
end

% extract sphere data
xc = sphere(:,1);
yc = sphere(:,2);
zc = sphere(:,3);
r  = sphere(:,4);

% compute spherical coordinates
theta   = linspace(0, pi, nTheta+1);
phi     = linspace(0, 2*pi, nPhi+1);

% convert to cartesian coordinates
sintheta = sin(theta);
x = xc + cos(phi') * sintheta * r;
y = yc + sin(phi') * sintheta * r;
z = zc + ones(length(phi),1) * cos(theta) * r;

% convert to FV mesh
[vertices, faces] = surfToMesh(x, y, z, 'yperiodic', true);

% format output
varargout = formatMeshOutput(nargout, vertices, faces);


function [f, finv, pol, polinv] = conformal(C, varargin)
%% CONFORMAL  Conformal map to unit disk
%   [F, FINV] = CONFORMAL(C, ctr) computes a conformal map F of the region
%   bounded by the complex periodic chebfun C to the unit disk and its inverse
%   FINV, with F(ctr) = 0 and F'(ctr) > 0.  Both maps are represented by
%   function handles evaluating rational functions.  If ctr is omitted it is
%   set to 0.
%
%   CONFORMAL(..., 'tol', tol) uses tolerance tol instead of the default 1e-5.
%
%   CONFORMAL(..., 'plots') produces plots of the map and its inverse.
%
%   CONFORMAL(..., 'numbers') prints various quantities.
%
%   CONFORMAL(..., 'poly') uses a less robust algorithm based on polynomials
%                          instead of the Kerzman-Stein integral equation.
%
%   [F, FINV, POL, POLINV] = CONFORMAL(...) returns the poles of F and FINV.
%
%   This experimental code is good for smooth simple regions, but easy to break.
%
%   Examples:
%
%   C = chebfun('exp(pi*1i*t)','trig')*(1+.15*randnfun(.2,'trig'));
%   [f, finv] = conformal(C, 'plots');                               % random
%
%   C = chebfun('2*cos(t)+1i*(sin(t)+2*cos(t).^3)',[0 2*pi],'trig'); % Ellacott
%   conformal(C, 'poly', 'plots');                                   % blade
%
%   C = chebfun('exp(pi*1i*t)*(1+.3*cos(6*pi*t))','trig');
%   conformal(C, 'plots', 'tol', 1e-8, 'numbers');                   % snowflake
%
%   s = chebfun('s'); C = join(s-.5i,1+.5i*s,.5i-s,-1-.5i*s);
%   conformal(C, 'poly', 'plots');                                   % rectangle
%
% References:
%
% A. Gopal and L. N. Trefethen, Representation of conformal maps by
% rational functions, Numer. Math. 142 (2019), 359--382.
%
% L. N. Trefethen, Numerical conformal mapping with rational
% functions, Comp. Meth. Funct. Th. 20 (2020), 369-387.
%
% See also CONFORMAL2.

%%
%   Default algorithm:
%     (1) Solve discretized Kerzman-Stein integral equation
%     (2) Use AAA to approximate f and its inverse by rational functions
%
%   Alternative algorithm if 'poly' is specified:
%     (1) Use least-squares to find harmonic u s.t. u(z) = -log(abs(z-ctr)) on C
%     (2) Set w = u+iv (v = harmonic conjugate of u)
%     (3) Set f = z*exp(w(z-ctr));
%     (4) Use AAA to approximate f and its inverse by rational functions
%
%   Although in principle these algorithms should be embedded in the
%   Chebfun constructor, for simplicity in this numerically challenging
%   area we have not done that.
%
% This code was written by L. N. Trefethen in September 2019.  The
% Kerzman-Stein part originates with Anne Greenbaum and Trevor Caldwell.

t1 = tic;
[ctr, tol, plots, numbers, poly] = parseinputs(C, varargin{:});
err = Inf;
scl = norm(C-ctr, inf);

if poly == 0               % DEFAULT ALGORITHM: KERZMAN-STEIN INTEGRAL EQUATION

    M = 300;
    while err > tol
        M = M + 300;
        [g, Z, W] = kerzstein((C-ctr)/scl, M, 0);
        Z = Z*scl + ctr;
        gc = trigcoeffs(g);
        err = norm(gc([1:10 end-9:end]));           % a crude error measure
        if (err > tol) && (M >= 1200)
            warning('CONFORMAL did not converge')
            break
        end
    end

else                       % ALTERNATIVE ALGORITHM: POLYNOMIAL EXPANSION

    w1 = warning('off', 'MATLAB:rankDeficientMatrix');
    logn = 4;
    dom = domain(C);
    dom = dom([1 end]);
    while err > tol
        n = round(2^logn);                    % degree of polynomial
        M = 8*n;                              % number of sample points
        logn = logn + 1/2;
        Z = C(dom(1) + (1:M)'*diff(dom)/M);   % sample points
        Zscl = (Z-ctr)/scl;                   % rescale to improve conditioning
        G = -log(abs(Zscl));                  % RHS for Dirichlet problem
        n1 = 0:n;                             % exponents for real part
        n2 = 1:n;                             % of exponents for imag part
        Q = ones(size(Zscl));                 % Arnoldi.  Q has orthog cols of norm sqrt(M).
        H = zeros(n+1,n);
        for k = 1:n
            v = Zscl.*Q(:,k);
            v = v - Q*(Q'*v)/M;               % or execute twice for better orthogonality!
            H(k+1,k) = norm(v)/sqrt(M);       % At end, Zscl.*Q(:,1:n)/M = Q*H
            Q = [Q v/H(k+1,k)];               % Q has orthog cols of norm sqrt(M)
        end
        A = [real(Q) imag(Q(:,2:end))];
        c = A\G;                              % soln of least-squares problem
        err = norm(A*c-G, inf);               % max error
        cc = c(n1+1)-1i*[0; c(n+1+n2)];       % coeffs for harmonic -> analytic
        W = Zscl.*exp(Q*cc);                  % images on boundary
        if (err > tol) && (logn >= 9.5)
            warning('CONFORMAL did not converge')
            break
        end
    end
    warning(w1.state, 'MATLAB:rankDeficientMatrix')

end

w2 = warning('off', 'CHEBFUN:aaa:Froissart');
[f0, pol] = aaa(W, Z, 'tol', tol);            % forward map
zz  = 1e-4*scl*[1 1i -1 -1i];                 % finite diff for simplicity
dwdz = sum(f0(ctr+zz)./zz);                   % derivative at ctr
rot = exp(-1i*angle(dwdz));                   % rotation for f'(ctr) > 0
f = @(z) rot*f0(z);                           % rotate mapping function
W = rot*W;                                    % rotate points on circle
[finv, polinv] = aaa(Z, W, 'tol', tol);       % inverse map
warning(w2.state, 'CHEBFUN:aaa:Froissart')

inC = inpolygon(real(pol), imag(pol), ...     % check for poles of f in region
	real(Z), imag(Z));
if max(inC) > 0
warning('CONFORMAL: pole in region')
end
if min(abs(polinv)) < 1                       % check for poles of finv in disk
    warning('CONFORMAL: pole in disk')
end
tcomp = toc(t1);

% Plot solution if requested
if plots
    t2 = tic;
    clf
    LW = 'linewidth'; PO = 'position'; MS = 'markersize';
    FW = 'fontweight'; NO = 'normal'; XT = 'xtick'; YT = 'ytick';
    circ = exp(2i*pi*(0:300)/300);

    h1 = axes(PO, [.04 .38 .45 .53]);         % plot C and poles of f
    plot(C, 'b', LW, 1)
    axis([real(ctr)+1.4*scl*[-1 1] imag(ctr)+1.4*scl*[-1 1]])
    axis square, hold on, plot(pol, '.r', MS, 8)
    title([num2str(length(pol)) ' poles'],FW,NO)

    h2 = axes(PO, [.52 .38 .45 .53]);         % plot disk and poles of finv
    plot(circ, 'b', LW, 1), axis(1.6*[-1 1 -1 1])
    axis square, hold on, set(gca,XT,-1:1,YT,-1:1)
    plot(polinv, '.r', MS, 8)
    title([num2str(length(polinv)) ' poles'],FW,NO)

    ncirc = 8;                  % plot concentric circles and their images
    for r = (1:ncirc-1)/ncirc
        axes(h1), plot(finv(r*circ), '-k', LW, .5)
        axes(h2), plot(r*circ, '-k', LW, .5)
    end

    nrad = 16;                  % plot radii and their images
    ray = chebpts(301);
    ray = ray(ray>=0);
    for k = 1:nrad
        axes(h1), plot(finv(ray*exp(2i*pi*k/nrad)), '-k', LW, .5)
        axes(h2), plot(ray*exp(2i*pi*k/nrad), '-k', LW, .5)
    end

    axes(h1), hold off
    axes(h2), hold off
    tplot = toc(t2);

end

% Print various quantities if requested
if numbers
    disp(' ')
    fprintf('                         computation time in seconds:%6.2f\n', tcomp)
    if plots
        fprintf('                            plotting time in seconds:%6.2f\n', tplot)
    end
    fprintf('            number of sample points Z on boundary, M:  %d\n', M)
    fprintf('                      numbers of poles of f and finv:  %d, %d\n', ...
        length(pol), length(polinv))
    fprintf('back-and-forth boundary error norm(Z-finv(f(Z)),inf):  %6.1e\n',...
        norm(Z-finv(f(Z)), inf))
    fprintf(' inverse back-and-forth error norm(W-f(finv(W)),inf):  %6.1e\n',...
        norm(W-f(finv(W)), inf))
    fprintf(' interior inverse error norm(.9*W-f(finv(.9*W)),inf):  %6.1e\n',...
        norm(.9*W-f(finv(.9*W)), inf))
    if poly
        fprintf('             max error of least-squares problem, err:  %6.1e\n', err)
        fprintf('                                polynomial degree, n:  %d\n', n)
        fprintf('                number of real degrees of freedom, N:  %d\n', 2*n+1)
        fprintf('          condition number of least-squares matrix A:  %6.1e\n', cond(A))
    else
        fprintf('                            rough error measure, err:  %6.1e\n', err)
    end
    disp(' ')
end

end   % of conformal

function [ctr, tol, plots, numbers, poly] = parseinputs(C, varargin)
ctr = 0;                        % defaults
tol = 1e-5;
plots = 0;
numbers = 0;
poly = 0;
j = 1;
while j < nargin
    j = j+1;
    v = varargin{j-1};
    if isnumeric(v)
        ctr = v;
    elseif strcmp(v, 'tol')
        j = j+1;
        tol = varargin{j-1};
    elseif strcmp(v, 'plots')
        plots = 1;
    elseif strcmp(v, 'numbers')
        numbers = 1;
    elseif strcmp(v, 'poly')
        poly = 1;
    end
end
winding_number = sum(diff(C)/(C-ctr))/(2i*pi);
if abs(winding_number - 1) > tol
    error('CONFORMAL:parseinputs','C must wind once counterclockwise around ctr')
end
end   % end of parseinputs

function [g, Z, W] = kerzstein(C, M, ctr)
%
% Given a smooth periodic chebfun C defining the boundary of a region Omega
% in the counterclockwise direction, this function computes the boundary
% correspondence function g for a conformal mapping from Omega to the unit
% disk, mapping ctr to 0.  It first finds M points (Z) on C that are equally
% spaced in arclength.  It then solves an integral equation to determine the
% images of these points (W) on the unit circle.  Finally, a periodic
% chebfun g is defined to map the arclengths associated with Z to their
% images on the unit circle.  The original version of this code cones
% from Anne Greenbaum and Trevor Caldwell.
% Reference:  Kerzman and Trummer, "Numerical conformal mapping via the Szego
% kernel," Journal of Computational and Applied Mathematics 14 (1986), 111-123.

% Express C as a function of arclength and compute its derivative

S = arcLength(C);
s = cumsum(abs(diff(C)));
dC_arg = angle(diff(C));
dC_arg = unwrap(dC_arg - dC_arg(0));
u = inv(s);
C = newDomain(C, minandmax(u));
D = C(u);
Dprime = diff(D);

%  Set up and solve the integral equation

ds = S/M;
svec = [0:M-1]'*ds;
Dvec = D(svec);
Z = Dvec;
Dprimevec = Dprime(svec);
gamdotvec = Dprimevec ./ abs(Dprimevec);   % unit tangents
d = 1/(2i*pi);
gvec = d*conj(gamdotvec./(ctr - Dvec));
A = eye(M);
for j = 1:M
    w = Dvec(j);
    for i = 1:M
        z = Dvec(i);
        if i ~= j
            A(i,j) = A(i,j) - d*(conj(gamdotvec(i)/(z-w)) + gamdotvec(j)/(w-z))*ds;
        end
    end
end
fvec = A\gvec;

%  Compute boundary correspondence function g

Rprimevec = fvec.^2;
Rvec = -1i*gamdotvec.*(Rprimevec./abs(Rprimevec));
W = Rvec;
g = chebfun(Rvec, [0,S], 'trig');

end   % of kerzstein


function thePartition=unrankPartition(rank,n)
%%UNRANKPARTITION Given the rank of a partiion of the integer n, when
%                 considering the partitions given in reverse lexicographic
%                 order, find the partition of the given rank. A partition
%                 of the integer n is a set of integers that sum to n.
%
%INPUTS: rank The integer rank of the partition. rank>0.
%           n The integer being partitioned.
%
%OUTPUTS: thePartition A numElementsX1  partition of n of the given rank.
%
%Let p(n,m) be the number of partitions of n with up to m parts. It is
%known that p(n,m)=p(n,m-1)+p(n-m,m). This relation is given in Chapter
%7.2.1.4 of [1]. The rank obtained here is derived using that recurrence
%relation.
%
%EXAMPLE:
%Here, we demonstrate that the unrankPartition function is consistent with
%the rankPartition function.
% n=20;
% [thePartition,theData]=getNextPartition(n);
% while(~isempty(thePartition))
%     assert(all(unrankPartition(rankPartition(thePartition),n)==thePartition))
%     [thePartition,theData]=getNextPartition(n,theData);
% end
%There should be no error indicating that the unranked partitions are all
%the same as the ranked partitions.
%
%REFERENCES:
%[1] D. E. Knuth, The Art of Computer Programming. Vol. 4, Fascicle 3:
%    Generating all Combinations and Partitions, Upper Saddle River, NJ:
%    Addison-Wesley, 2009.
%
%September 2018 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

thePartition=zeros(n,1);%We do not know how many parts to have...

rank=numberOfPartitions(n)-rank;

if(rank<0)
    error('The rank given is more than the total number of partitions of n')
end

curIdx=0;
nLeft=n;
while(rank>0)
    parts=1;
    numParts=numMPartitions(nLeft,parts,true);
    while(numParts<rank)
        parts=parts+1;
        numParts=numMPartitions(nLeft,parts,true);
    end
    if(numParts>rank)
        parts=parts-1;
        numParts=numMPartitions(nLeft,parts,true);
    end

    curIdx=curIdx+1;
    thePartition(curIdx)=parts+1;
    rank=rank-numParts;
    nLeft=nLeft-thePartition(curIdx);
end

while(nLeft>0)
    curIdx=curIdx+1;
    thePartition(curIdx)=1;
    nLeft=nLeft-1;
end

%Shrink to fit.
thePartition=thePartition(1:curIdx);

end

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


function [gk] = tapas_trans_mv2gk(mu, sigma2)
%% Transforms to the scaling of the gamma distribution%
% Input
%   mu          -- Means
%   sigma2      -- Variance
%
% Output
%   gk          -- K parameter of an inverse gamma distribution

% aponteeduardo@gmail.com
% copyright (C) 2015
%

gk = mu.^2 ./ sigma2;

end


function [label, R] = mixGaussPred(model, X)
% Predict label and responsibility for Gaussian mixture model.
% Input:
%   X: d x n data matrix
%   model: trained model structure outputed by the EM algirthm
% Output:
%   label: 1 x n cluster label
%   R: k x n responsibility
% Written by Mo Chen (sth4nth@gmail.com).
mu = model.mu;
Sigma = model.Sigma;
w = model.w;

n = size(X,2);
k = size(mu,2);
logRho = zeros(n,k);

for i = 1:k
    logRho(:,i) = loggausspdf(X,mu(:,i),Sigma(:,:,i));
end
logRho = bsxfun(@plus,logRho,log(w));
T = logsumexp(logRho,2);
logR = bsxfun(@minus,logRho,T);
R = exp(logR);
[~,label(1,:)] = max(R,[],2);

function y = loggausspdf(X, mu, Sigma)
d = size(X,1);
X = bsxfun(@minus,X,mu);
[U,p]= chol(Sigma);
if p ~= 0
    error('ERROR: Sigma is not PD.');
end
Q = U'\X;
q = dot(Q,Q,1);  % quadratic term (M distance)
c = d*log(2*pi)+2*sum(log(diag(U)));   % normalization constant
y = -(c+q)/2;


% Copyright (C) 2016, by Arturo Gil Aparicio
%
% This file is part of ARTE (A Robotics Toolbox for Education).
%
% ARTE is free software: you can redistribute it and/or modify
% it under the terms of the GNU Lesser General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% ARTE is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU Lesser General Public License for more details.
%
% You should have received a copy of the GNU Leser General Public License
% along with ARTE.  If not, see <http://www.gnu.org/licenses/>.
function jacobian_symbolic_3dof_planar

syms q1 q2 q3
% matrices DH
A01 = dh_sym(q1, 0, 0.5, 0);
A12 = dh_sym(q2, 0, 0.5, 0);
A23 = dh_sym(q3, 0, 0.5, 0);

A02 = A01*A12;
A03 = A01*A12*A23;
A03 = simplify(A03);

z0 = [0 0 1]';

p03=A03(1:3,4);
p13=A03(1:3,4)-A01(1:3,4);
p23=A03(1:3,4)-A02(1:3,4);

Jv = [cross(z0, p03) cross(z0, p13) cross(z0, p23)];
Jv = simplify(Jv)

Jw = [z0 z0 z0];
J = [Jv; Jw]
% transform to valid dimensions
J = [J(1:2,:); J(6,:)]

J = simplify(J)

singularities = det(J)
singularities = simplify(singularities)

%Redefine J
J = [J(1:2,:)]
% compute moore-penrose pseudo inverse
Jp = J'*inv(J*J')
Jp = simplify(Jp)

% compute projector P
P = eye(3)-Jp*J

function A = dh_sym(theta, d, a, alpha)
syms q1 q2 q3 q4
% avoid almost zero elements in cos(alpha) and sin(alpha)
ca = cos(alpha);
sa = sin(alpha);
if abs(ca) < 1e-6
    ca = 0;
end
if abs(sa) < 1e-6
    sa = 0;
end

A=[cos(theta)  -ca*sin(theta)   sa*sin(theta)   a*cos(theta);
   sin(theta)   ca*cos(theta)  -sa*cos(theta)   a*sin(theta);
            0              sa             ca             d;
            0         0                     0              1];


% MatrixUser, a multi-dimensional matrix analysis software package
% https://sourceforge.net/projects/matrixuser/
%
% The MatrixUser is a matrix analysis software package developed under Matlab
% Graphical User Interface Developing Environment (GUIDE). It features
% functions that are designed and optimized for working with multi-dimensional
% matrix under Matlab. These functions typically includes functions for
% multi-dimensional matrix display, matrix (image stack) analysis and matrix
% processing.
%
% Author:
%   Fang Liu <leoliuf@gmail.com>
%   University of Wisconsin-Madison
%   Aug-30-2014

function MU_funcNoise(Temp,Event,handles)
handles=guidata(handles.MU_matrix_display);

[Type,ok] = listdlg('ListString',{'Gaussian white noise','Salt & Pepper','Multiplicative noise (speckle)'}, ...
                         'SelectionMode','single',...
                         'PromptString','Noise Type',...
                         'Name','Type');
if ok==0
    warndlg('Adding noise is cancelled.');
    return;
end

switch Type
    case 1 % gaussian
        f = inputdlg({'Mean:', 'Variance:'},'Gaussian White Noise',1,{'0' ,'1'});
        if isempty(f)
            warndlg('Adding noise is cancelled.');
            return;
        end
    case 2 % salt & pepper
        f = inputdlg({'Noise percent (%):'},'Salt & Pepper',1,{'5'});
        if isempty(f)
            warndlg('Adding noise is cancelled.');
            return;
        end
    case 3 % speckle
        f = inputdlg({'Noise variance:'},'Multiplicative Noise',1,{'0.04'});
        if isempty(f)
            warndlg('Adding noise is cancelled.');
            return;
        end
end

choice = questdlg('Apply to all slices?','All Slices','No','Yes','No');
if isempty(choice)
    warndlg('Adding noise is cancelled.');
    return;
end
% Handle response
switch choice
    case 'No'
        TMatrix = handles.BMatrix;
    case 'Yes'
        TMatrix = handles.TMatrix;
end

TMatrix = double(TMatrix); % convert to double

switch Type
    case 1
        TMatrix = TMatrix + str2double(f{1}) + sqrt(str2double(f{2})) * randn(size(TMatrix));
    case 2
        [row,col,layer] = size(TMatrix);
        maxT=max(TMatrix(:));
        minT=min(TMatrix(:));
        numPx = str2double(f{1}) * row * col *layer /100;
        Idx = randi(row * col * layer, [round(numPx), 1]);
        TMatrix(Idx(1:floor(end/2))) = maxT;
        TMatrix(Idx(ceil(end/2):end)) = minT;
    case 3
        TMatrix = TMatrix + ((2*sqrt(3)*sqrt(str2double(f{1})))*rand(size(TMatrix)) + (-sqrt(3)*sqrt(str2double(f{1})))) .* TMatrix;
end

TMatrix = cast(TMatrix, class(handles.BMatrix)); % convert back to whatever original

switch choice
    case 'No'
        handles.TMatrix(:,:,handles.V.Slice) = TMatrix;
    case 'Yes'
        handles.TMatrix = TMatrix;
end

MergeM=get(handles.Matrix_name_edit,'String');
set(handles.Matrix_name_edit,'String',[MergeM '_noi']);

% update current display matrix
handles=MU_update_image(handles.Matrix_display_axes,{handles.TMatrix,handles.Mask},handles,0);
guidata(handles.MU_matrix_display, handles);

end


function x=irdct(y,n,a,b)
%IRDCT    Inverse discrete cosine transform of real data X=(Y,N)
% Data is truncated/padded to length N.
%
% This routine is equivalent to multiplying by the matrix
%
%    irdct(eye(n)) = cos((0.5:n)'*(0:n-1)*pi/n)*diag([sqrt(0.5)*a/b repmat(a,1,n-1)])/n
%
%
% Default values of the scaling factors are A=sqrt(2N) and B=1 which
% results in an orthogonal matrix. Other common values are A=1 or N and/or B=1 or sqrt(2).
% If b~=1 then the columns are no longer orthogonal.
% See also RCDT

%      Copyright (C) Mike Brookes 1998
%      Version: $Id: irdct.m 713 2011-10-16 14:45:43Z dmb $
%
%   VOICEBOX is a MATLAB toolbox for speech processing.
%   Home page: http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   This program is free software; you can redistribute it and/or modify
%   it under the terms of the GNU General Public License as published by
%   the Free Software Foundation; either version 2 of the License, or
%   (at your option) any later version.
%
%   This program is distributed in the hope that it will be useful,
%   but WITHOUT ANY WARRANTY; without even the implied warranty of
%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%   GNU General Public License for more details.
%
%   You can obtain a copy of the GNU General Public License from
%   http://www.gnu.org/copyleft/gpl.html or by writing to
%   Free Software Foundation, Inc.,675 Mass Ave, Cambridge, MA 02139, USA.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

fl=size(y,1)==1;
if fl y=y(:); end
[m,k]=size(y);
if nargin<4 b=1;
    if nargin<3 a=sqrt(2*m);
        if nargin<2 n=m;
        end
    end
end
if n>m y=[y; zeros(n-m,k)];
elseif n<m y(n+1:m,:)=[];
end

x=zeros(n,k);
w=ones(1,k);
m=fix((n+1)/2);
p=n-m;
z=0.5*exp((0.5i*pi/n)*(1:p)).';
u=(y(2:p+1,:)-1i*y(n:-1:m+1,:)).*z(:,w)*a;
y=[y(1,:)*sqrt(0.5)*a/b; u(1:m-1,:)];
if m==p
    z=-0.5i*exp((2i*pi/n)*(0:m-1)).';
    y=(z(:,w)+0.5).*(conj(flipud(u))-y)+y;
    z=ifft(y,[],1);
    u=real(z);
    y=imag(z);
    q=m/2;
    h=rem(m,2)/2;
    x(1:4:n,:)=u(1:q+h,:);
    x(2:4:n,:)=y(m:-1:q+1-h,:);
    x(3:4:n,:)=y(1:q-h,:);
    x(4:4:n,:)=u(m:-1:q+1+h,:);
else
    z=real(ifft([y; conj(flipud(u))]));
    x(1:2:n,:)=z(1:m,:);
    x(2:2:n,:)=z(n:-1:m+1,:);
end

if fl x=x.'; end