function u = bsv_upwind ( a, b, alpha, beta, nu, n, output )

%*****************************************************************************80
%
%% BSV_UPWIND applies Newton's method to a discretized steady viscous Burgers equation.
%
%  Discussion:
%
%    An upwind scheme is used to combat the numerical oscillations that
%    can occur otherwise.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real A, B, the left and right endpoints.
%
%    Input, real ALPHA, BETA, the Dirichlet boundary values at the left
%    and right.
%
%    Input, real NU, the viscosity.  Normally, 0 < NU.
%
%    Input, integer N, the number of nodes to use between A and B.
%
%    Input, logical OUTPUT, is TRUE if printout is desired.
%
%    Output, real U(N), the computed discretized solution.
%
  if ( n < 2 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'BSV_UPWIND - Fatal error!\n' );
    fprintf ( 1, '  N < 2.\n' );
    error ( 'BSV_UPWIND - Fatal error!\n' );
  end
%
%  Set some iteration parameters.
%
  newton_step_max = 50;
  newton_resid_tol = sqrt ( eps );
  newton_step_tol = sqrt ( eps );
%
%  Use equally spaced nodes from A to B.
%
  dx = ( b - a ) / ( n - 1 );
%
%  The initial guess will be the linear interpolant to the boundary conditions.
%
  u = ( linspace ( alpha, beta, n ) )';
%
%  Prepare for the Newton iteration.
%
  J = sparse ( [], [], [], n, n, 3 * n );
  newton_step = 0;

  if ( output )
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Step  ||F(U)||\n' );
    fprintf ( 1, '\n' );
  end

  while ( newton_step <= newton_step_max )

    f(1,1) = u(1) - alpha;

    f(2:n-1,1) = - nu * ( u(3:n) - 2.0 * u(2:n-1) + u(1:n-2) ) / ( dx^2 );
%
%  Massaging the results of FIND can be tedious.
%
    i = find ( 0.0 <= u(2:n-1) );
    i = i + 1;
    j = find ( u(2:n-1) < 0.0 );
    j = j + 1;

    f(i,1) = f(i,1) + 0.5 * ( u(i).^2 - u(i-1).^2 ) / dx;
    f(j,1) = f(j,1) + 0.5 * ( u(j+1).^2 - u(j).^2 ) / dx;

    f(n,1) = u(n) - beta;

    f_norm = norm ( f, inf );

    if ( output )
      fprintf ( 1, '  %4d  %g\n', newton_step, f_norm );
    end

    if ( f_norm < newton_resid_tol )
      break
    end
%
%  Define the Jacobian matrix.
%
    J(1,1) = 1.0;
    for i = 2 : n - 1
      if ( 0.0 <= u(i) )
        J(i,i-1) = - u(i-1) / dx        - nu / dx^2;
        J(i,i)   =   u(i)   / dx  + 2.0 * nu / dx^2;
        J(i,i+1) =                      - nu / dx^2;
      else
        J(i,i-1) =                      - nu / dx^2;
        J(i,i)   = - u(i)   / dx  + 2.0 * nu / dx^2;
        J(i,i+1) =   u(i+1) / dx        - nu / dx^2;
      end
    end
    J(n,n) = 1.0;
%
%  Solve the linear system J * du = -f to get the Newton update.
%
    du = J \ f;
    du_norm = norm ( du, inf );

    u_norm = norm ( u, inf );
    if ( du_norm < newton_step_tol * ( u_norm + 1.0 ) )
      break
    end

    u = u - du;
    newton_step = newton_step + 1;

  end

  if ( newton_step_max < newton_step )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'BSV_UPWIND - Warning!\n' );
    fprintf ( 1, '  The Newton iteration did not converge.\n' );
  end

  return
end


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Copyright (C) 1995-2020 The Octave Project Developers
%
% See the file COPYRIGHT.md in the top-level directory of this
% distribution or <https://octave.org/copyright/>.
%
% This file is part of Octave.
%
% Octave 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.
%
% Octave 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 Octave; see the file COPYING.  If not, see
% <https://www.gnu.org/licenses/>.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% -*- texinfo -*-
% @deftypefn  {} {} cov (@var{x})
% @deftypefnx {} {} cov (@var{x}, @var{opt})
% @deftypefnx {} {} cov (@var{x}, @var{y})
% @deftypefnx {} {} cov (@var{x}, @var{y}, @var{opt})
% Compute the covariance matrix.
%
% If each row of @var{x} and @var{y} is an observation, and each column is
% a variable, then the @w{(@var{i}, @var{j})-th} entry of
% @code{cov (@var{x}, @var{y})} is the covariance between the @var{i}-th
% variable in @var{x} and the @var{j}-th variable in @var{y}.
% @tex
% $$
% \sigma_{ij} = {1 \over N-1} \sum_{i=1}^N (x_i - \bar{x})(y_i - \bar{y})
% $$
% where $\bar{x}$ and $\bar{y}$ are the mean values of @var{x} and @var{y}.
% @end tex
% @ifnottex
%
% @example
% cov (@var{x}) = 1/(N-1) * SUM_i (@var{x}(i) - mean(@var{x})) * (@var{y}(i) - mean(@var{y}))
% @end example
%
% @noindent
% where @math{N} is the length of the @var{x} and @var{y} vectors.
%
% @end ifnottex
%
% If called with one argument, compute @code{cov (@var{x}, @var{x})}, the
% covariance between the columns of @var{x}.
%
% The argument @var{opt} determines the type of normalization to use.
% Valid values are
%
% @table @asis
% @item 0:
%   normalize with @math{N-1}, provides the best unbiased estimator of the
% covariance [default]
%
% @item 1:
%   normalize with @math{N}, this provides the second moment around the mean
% @end table
%
% Compatibility Note:: Octave always treats rows of @var{x} and @var{y}
% as multivariate random variables.
% For two inputs, however, @sc{matlab} treats @var{x} and @var{y} as two
% univariate distributions regardless of their shapes, and will calculate
% @code{cov ([@var{x}(:), @var{y}(:)])} whenever the number of elements in
% @var{x} and @var{y} are equal.  This will result in a 2x2 matrix.
% Code relying on @sc{matlab}'s definition will need to be changed when
% running in Octave.
% @seealso{corr}
% @end deftypefn

function c = cov (x, y, opt)

if (nargin < 2)
    y = [];
end
if (nargin < 3)
    opt = 0;
end
if (nargin < 1 || nargin > 3)
    error('Usage: c = cov (x, y = [], opt = 0)');
end

if (~(isnumeric (x) || islogical (x)) || ~(isnumeric (y) || islogical (y)))
    error ('cov: X and Y must be numeric matrices or vectors');
end

if (ndims (x) ~= 2 || ndims (y) ~= 2)
    error ('cov: X and Y must be 2-D matrices or vectors');
end

if (nargin == 2 && isscalar (y))
    opt = y;
end

if (opt ~= 0 && opt ~= 1)
    error ('cov: normalization OPT must be 0 or 1');
end

% Special case, scalar has zero covariance
if (isscalar (x))
    if (isa (x, 'single'))
        c = single (0);
    else
        c = 0;
    end
    return;
end

if (isrow (x))
    x = x.';
end
n = size(x,1);

if (nargin == 1 || isscalar (y))
    %x = center (x, 1);
    x = bsxfun(@minus, x, mean (x, 1));
    c = x' * x / (n - 1 + opt);
else
    if (isrow (y))
        y = y.';
    end
    if (size(y,1) ~= n)
        error ('cov: X and Y must have the same number of observations');
    end
    %x = center (x, 1);
    %y = center (y, 1);
    x = bsxfun(@minus, x, mean (x, 1));
    y = bsxfun(@minus, y, mean (y, 1));
    c = x' * y / (n - 1 + opt);
end

end


function [ f, g, H ] = opt15_fgh ( x, flag )

%*****************************************************************************80
%
%% OPT15_FGH evaluates F, G and H for test case #15.
%
%  Discussion:
%
%    This example, if started at X = (-1,0), seems to get stuck.
%
%  Modified:
%
%    09 January 2008
%
%  Author:
%
%    Jeff Borggaard,
%    Gene Cliff,
%    Virginia Tech.
%
%  Reference:
%
%    John Dennis, Robert Schnabel,
%    Numerical Methods for Unconstrained Optimization
%    and Nonlinear Equations,
%    SIAM, 1996,
%    ISBN13: 978-0-898713-64-0,
%    LC: QA402.5.D44.
%
%  Parameters:
%
%    Input, real X(2), the evaluation point.
%
%    Input, string FLAG, indicates what must be computed.
%    'f' means only the value of F is needed,
%    'g' means only the value of G is needed,
%    'all' means F, G and H (if appropriate) are needed.
%    It is acceptable to behave as though FLAG was 'all'
%    on every call.
%
%    Output, real F, the optimization function.
%
%    Output, real G(2,1), the gradient column vector.
%
%    Output, real H(2,2), the Hessian matrix.
%
  n = length ( x );

  if ( n ~= 2 )
    fprintf ( '\n' );
    fprintf ( 'OPT15_FGH - Fatal error!\n' );
    fprintf ( '  The input vector X should have length 2.\n'),
    fprintf ( '  Instead, it has length = %d.\n', n );
    keyboard
  end

  f = - ( x(1) + x(2) ) ...
      + 0.5 * ( 1 - ( x(1)^2 + x(2)^2 ) ) ...
      + 5.0 * ( 1 - ( x(1)^2 + x(2)^2 ) )^2;

  g(1,1) = -1 - 21 * x(1) + 20 * x(1) * ( x(1)^2 + x(2)^2 );
  g(2,1) = -1 - 21 * x(2) + 20 * x(2) * ( x(1)^2 + x(2)^2 );

  H = zeros(n,n);

  H(1,1) = - 21 + 60 * x(1)^2 + 20 * x(2)^2;
  H(1,2) = 40 * x(1) * x(2);

  H(2,1) = 40 * x(1) * x(2);
  H(2,2) =  - 21 + 20 * x(1)^2 + 60 * x(2)^2;


function coeffs = ellipseCartesianCoefficients(elli)
%ELLIPSECARTESIANCOEFFICIENTS Cartesian coefficients of an ellipse.
%
%   COEFFS = ellipseCartesianCoefficients(ELLI)
%   Computes the cartesian coefficients of the ellipse ELLI, given by:
%     COEFFS = [A B C D E F]
%   such that the points on the ellipse follow:
%     A*X^2 + B*X*Y + C*Y^2 + D*X + E*Y + F = 0
%
%   Example
%     elli = [30 20 40 20 30];
%     coeffs = ellipseCartesianCoefficients(elli)
%     elli2 = createEllipse(coeffs)
%     elli2 =
%        30.0000   20.0000   40.0000   20.0000   30.0000
%
%   See also
%     ellipses2d, createEllipse, equivalentEllipse
%

% ------
% Author: David Legland
% E-mail: david.legland@inrae.fr
% Created: 2022-09-05, using Matlab 9.12.0.1884302 (R2022a)
% Copyright 2022 INRAE - BIA Research Unit - BIBS Platform (Nantes)

% retrieve ellipse center and squared radiusses
xc = elli(1);
yc = elli(2);
a2 = elli(3)^2;
b2 = elli(4)^2;

% pre-compute trigonometric functions (angle is in degrees)
cot = cos(elli(5) * pi / 180);
sit = sin(elli(5) * pi / 180);

% identification of each parameter
A = a2 * sit * sit + b2 * cot * cot;
B = 2 * (b2 - a2) * sit * cot;
C = a2 * cot * cot + b2 * sit * sit;
D = - 2 * A * xc - B * yc;
E = - B * xc - 2 * C * yc;
F = A * xc * xc + B * xc * yc + C * yc * yc - a2 * b2;

% concatenate into a single row vector
coeffs = [A B C D E F];


function A = create_3d_linear_interp_matrix(T, varargin)
% A = create_2d_bilinear_interp_matrix(T, [szin])
% T should contain displacements in pixels
% size(T) = [N1, N2, N3, 2]
%
% x_def = A * x(:);

sz = [size(T, 1), size(T, 2), size(T, 3)];

if numel(varargin) == 1
    szin = varargin{1};
else
    szin = sz;
end

npixin = szin(1) * szin(2) * szin(3);
npixout = sz(1) * sz(2) * sz(3);

[m1, m2, m3] = ndgrid(1:sz(1), 1:sz(2), 1:sz(3));
TT = T + cat(4, m1, m2, m3);

r = cell(3, 1);
rk = cell(3, 1);
for i = 1 : 3
    r{i} = floor(TT(:, :, :, i));
    rk{i} = TT(:,:,:, i) - r{i};
end

%
ssh =  [0, 0, 0, 0, 1, 1, 1, 1;...
        0, 1, 0, 1, 0, 1, 1, 0;...
        0, 0, 1, 1, 0, 0, 1, 1;];
A = sparse(npixout, npixin);
for i = 1 : 8
    t = 1 : npixout;
    s = ones(numel(rk{1}), 1);
    rid = cell(3, 1);
    for j = 1 : 3
        rid{j} = r{j} + ssh(j, i);
        if ssh(j, i) == 1
            tmps = rk{j};
        else
            tmps = 1 - rk{j};
        end
        s = s .* tmps(:);
    end
    idx = (rid{1} <= szin(1)) & (rid{1} >= 1) & (rid{2} <= szin(2)) & (rid{2} >= 1) & (rid{3} <= szin(3)) & (rid{3} >= 1);
    for j = 1 : 3
        rid{j} = rid{j}(idx);
    end
    s = s(idx);
    t = t(idx);
    tmp = sparse(t, rid{1} + szin(1) * (rid{2} - 1) + szin(2)*szin(1) * (rid{3} - 1), s, npixout, npixin);
    A = A + tmp;
end

end


function y0 = oddchebser0 ( x, coef, nc )

%*****************************************************************************80
%
%% ODDCHEBSER0 evaluates an odd Chebyshev series.
%
%  Discussion:
%
%    This function implements Clenshaw's modification of  his algorithm
%    for odd series.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 April 2014
%
%  Author:
%
%    Manfred Zimmer
%
%  Reference:
%
%    Charles Clenshaw,
%    Mathematical Tables, Volume 5,
%    Chebyshev series for mathematical functions,
%    London, 1962.
%
%  Parameters:
%
%    Input, real X, the evaluation point.
%    -1 <= X <= +1.
%
%    Input, real COEF(NC), the Chebyshev series.
%
%    Input, integer NC, the number of terms in the series.
%    0 < NC.
%
%    Output, real Y0, the value of the Chebyshev series at X.
%
  b0 = coef(nc);
  b1 = 0.0;
  b2 = 0.0;

  x2 = 4.0 * x * x - 2.0;

  for i = nc - 1 : -1 : 1

    b2 = b1;
    b1 = b0;
    b0 = coef(i) - b2 + x2 * b1;

  end

  y0 = ( b0 - b1 ) * x;

  return
end


function [y, Fout]=SincResample(xin, npoints, Fin, shift, mode)
% SincResample resamples signals to arbitrary lengths/frequencies and can
% timeshift them.
%
% SincResample can be faster than INTERP or RESAMPLE when X contains many
% relatively short data columns.
%
%
% Example:
% [Y, FOUT]=SincResample(X, NPOINTS, FIN, SHIFT, MODE)
%
% X is a vector or M x N  matrix where each column represents a signal.
% NPOINTS is the number of points required in each column after
% resampling.
% FIN (if supplied) is the sampling rate in X (default 1 samples/sec).
% SHIFT (if supplied) is the time (in seconds) to shift the points at which
% interpolation will be done (default 0). SHIFT should be between ą(1/Fin).
% SHIFT can be used to synchronize signals separated by up to ą(1/Fin)
% in time.
% MODE (if supplied) is a string:
%           'sinc' to use a hamming-windowed sinc function (default)
%           'lanczos' for a 3-lobed Lanczos function
%
% Y is the resulting M x NPOINTS matrix formed by resampling. The time
% of the first sample in each column of Y is shifted by SHIFT seconds
% relative to those in X.
% FOUT is the effective sample rate for output Y (normalised to FIN=1 if
% FIN is not supplied on input).
%
% If X is a bandlimited (filtered) signal containing components at
% DC - 0.5Fs where Fs is the sample rate, SincResample will return
% the signal that would have been seen with a higher sampling rate
% (and the same filter settings). The algorithm depends on the fact that
% the bandlimited signal is completely defined when sampling at Fs.
%
% SincResample returns the data convolved with a set of  time-shifted
% windowed sinc functions, one for each of the samples [1..size(x,1)]
% in the input signal. End-effects are reduced by adding a reflected
% and mirrored copy of the data at the beginning and end of each column
% before resampling.
%
% Note that points at the end of Y (and/or beginning if SHIFT is negative)
% will be extrapolated beyond the boundaries of X.
%
% SincResample is a generalization of the method used in Blanche &
% Swindale (2006).
%
% See also e.g. interp & resample (in the Signal Processing Toolbox) and
% the sinc online documentation.
%
% References:
% T.Blanche & N.V.Swindale (2006)
% Nyquist interpolation improves neuron yield in multiunit recordings
% Journal of Neuroscience Methods 155, 81-91 LinkOut
%
% also
%
% K. Turkowski, Filters for common resampling tasks LinkOut
%
% Toolboxes required: None
%
% Author: Malcolm Lidierth 07/06
% Copyright Š Kings College London 2006-8
%
% Acknowledgements: Steve Alty for comments
%
% Revisions: 10.07  Argument checks tidied (ML)
%            02.08  End-effect minimization now relects and mirrors data
%                   instead of simply reflecting it. This improves the
%                   slopes at the end and reduces the behaviour described at
%                   http://www.dsprelated.com/showmessage/79676/2.php
%                   (ML)
%            02.08  Mode option added (ML)

% Argument checks
if nargin<2
    y=[];
    Fout=0;
    return
end

if nargin<=2
    % Default
    Fin=1;
end

if nargin<=3
    % Zero shift default
    shift=0;
end

if nargin<=4
    % Set sinc as default
    mode='sinc';
end

if Fin==0
    error('SincResample: Fin specified as zero');
end

if abs(shift)>=1/Fin
    error('SincResample: shift must be less than 1/Fin');
end

if rem(npoints,1)~=0
    error('SincResample: npoints must be a whole number');
end

% Main routine
% Prepend and append a reflected and mirrored copy of the data
% to minimize end transients:
% Change 22.02.08: note change from reflected only

if isvector(xin)
    % Force column vector if row input
    xin=xin(:);
end

x=zeros(size(xin,1)*3, size(xin,2));
for k=1:size(xin,2)
    x(2:end-1,k)=[2*xin(1,k)-xin(end:-1:2,k);...
        xin(:,k);...
        2*xin(end,k)-xin(end-1:-1:1,k)];
    x(1,k)=2*x(1,k)-x(2,k);
    x(end,k)=2*x(end,k)-x(end-1,k);
end
clear('xin');
np=npoints*3;

% A column vector of sample times for x  - assume unit spacing and zero
% base
len=size(x,1);
t=(0:len-1)';

% times at which to interpolate data - based on spacing in t.
% ts will be a [npoints by size(x,1)] matrix
ts=(0:(max(t)+1)/np:(np-1)/(np/len))';
ts=(ts(:,ones(size(t)))-t(:,ones(size(ts)))');

% Hamming window
N=size(ts,2);
if N==1 || strcmp(mode, 'lanczos');
    w=1;
else
    th=ts+N-1;
    w=0.54-0.46*cos((2*pi*th/max(th(:)))) ;
end

% Add shift in multiples of a sampling interval i.e. shift/(1/Fin)
ts=ts+(shift*Fin);

switch mode
    case 'lanczos'
        % Generate Lanczos functions and calculate output
        y=lanczos(ts)*x;
    case 'sinc'
        % Generate sinc functions, apply Hamming window if w~=1 and
        % calculate output.
        y=sinc(ts).*w*x;
    otherwise
        error('mode should be ''sinc'' or ''lanczos''');
end

% Throw away what is not needed
y=y(size(y,1)/3+1:(size(y,1)/3)+(size(y,1)/3),:);
Fout=Fin*npoints/(len/3);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% DEBUG Display the data - UNCOMMENT text below to display results
% x=x(size(x,1)/3+1:(size(x,1)/3)+(size(x,1)/3),:);
% debugdisplay(x, y, Fin, Fout, shift)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
return
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function y=sinc(x)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
i=find(x==0);
x(i)=1;
y=sin(pi*x)./(pi*x);
y(i)=1;
return
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function y=lanczos(x)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
n=3;
y=sinc(x).*sinc(x/n);
y(abs(x)>=n)=0;
return
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function debugdisplay(x, y, Fin, Fout, shift) %#ok<DEFNU>
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Interp requires the Signal Processing Toolbox. The output of interp will
% be shown if Fout is an integer multiple of Fin.
% Note that shift is not applied to interp
% Sample times in seconds
t1= 0 : 1/Fin : (size(x,1)-1)/Fin;
t2= 0 : 1/Fout : (size(y,1)-1)/Fout;
if rem(Fout,Fin)==0
    y3=interp(x(:,1),Fout/Fin);
    t3=linspace(0,max(t2),size(y3,1));
end
t2=t2+shift;
handle=gca(figure);
xlabel(handle,'Time (seconds)');
for i=1:size(x,2)
    if ~ishandle(handle)
        break;
    end
    if rem(Fout,Fin)==0
        y3=interp(x(:,i),Fout/Fin);
        plot(handle,t1,x(:,i),'-bo',t2,y(:,i),'r-x',t3,y3,'g:s');
        xlim([min([0;min(t2)]) max([max(t3);max(t2);max(t1)])]);
    else
        plot(handle,t1,x(:,i),'-bo',t2,y(:,i),'r-x');
        xlim([min([0;min(t2)]) max([max(t2);max(t1)])]);
    end
    xlabel(handle,'Time (seconds)');
    title('Close the figure window to exit this loop');
    if rem(Fout,Fin)==0
        legend('Original','SincResample','MATLAB Interp (no shift)');
    else
        legend('Original','SincResample');
    end
    drawnow();
    pause(.1);
end
return
end


function [ a, b ] = assemble_fem ( x_num, x, element_num, element_node, ...
  quad_num, t, k_fun, rhs_fun )

%*****************************************************************************80
%
%% ASSEMBLE_FEM assembles the finite element stiffness matrix.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 February 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer X_NUM, the number of nodes.
%
%    Input, real X(X_NUM), the coordinates of nodes.
%
%    Input, integer ELEMENT_NUM, the number of elements.
%
%    Input, integer ELEMENT_NODE(2,ELEMENT_NUM);
%    ELEMENT_NODE(I,J) is the global index of local node I in element J.
%
%    Input, integer QUAD_NUM, the number of quadrature points used in assembly.
%
%    Input, real T, the current time.
%
%    Input, real K_FUN(), a function to evaluate the heat conductivity.
%
%    Input, real RHS_FUN(), a function to evaluate the right hand side.
%
%    Output, sparse real A(X_NUM,X_NUM), the finite element stiffness matrix.
%
%    Output, real B(X_NUM), the right hand side.
%
%  Local parameters:
%
%    Local, real BI, DBIDX, the value of some basis function
%    and its first derivative at a quadrature point.
%
%    Local, real BJ, DBJDX, the value of another basis
%    function and its first derivative at a quadrature point.
%

%
%  Initialize the arrays.
%
  b = zeros ( x_num, 1 );
  a = sparse ( x_num, x_num );
%
%  Get the quadrature weights and nodes.
%
  [ reference_w, reference_q ] = quadrature_set ( quad_num );
%
%  Consider each ELEMENT.
%
  for element = 1 : element_num

    element_x(1:2,1) = x(element_node(1:2,element));

    element_q(1:quad_num,1) = reference_to_physical ( element, element_node, ...
      x, quad_num, reference_q );

    element_area = element_x(2) - element_x(1);

    element_w(1:quad_num,1) = ( element_area / 2.0 ) * reference_w(1:quad_num);
%
%  Consider the QUAD-th quadrature point in the element.
%
    k_value = k_fun ( quad_num, element_q, t );
    rhs_value = rhs_fun ( quad_num, element_q, t );

    for quad = 1 : quad_num
%
%  Consider the TEST-th test function.
%
%  We generate an integral for every node associated with an unknown.
%
      for i = 1 : 2

        test = element_node(i,element);

        [ bi, dbidx ] = basis_function ( test, element, x, 1, element_q(quad) );

        b(test) = b(test) + element_w(quad) * rhs_value(quad) * bi;
%
%  Consider the BASIS-th basis function, which is used to form the
%  value of the solution function.
%
        for j = 1 : 2

          basis = element_node(j,element);

          [ bj, dbjdx ] = basis_function ( basis, element, x, 1, element_q(quad) );

          a(test,basis) = a(test,basis) + element_w(quad) * ( ...
            + k_value(quad) * dbidx * dbjdx );

        end

      end

    end

  end

  return
end


function val=perm(A,boolRowsSkip,boolColsSkip)
%%PERM Calculate the matrix permanent allowing for rows and columns to be
%      skipped if desired (operate on a submatrix). The permanent is
%      equivalent to calculating the determininant in the standard
%      summation manner taught in school, except all of the minus signs are
%      replaced with plus signs. Permanents play a role in combinatorics
%      and the ability to skip rows and columns can be useful when using
%      permanents to compute target-measurement association probabilities.
%
%INPUTS: A An mXn matrix. If m<=n, then the standard matrix permanent is
%         found. If m>n, then the permanent of A' is found to be consistent
%         with the permanents of A and A' being equal in square matrices.
%         Empty matrices have a permanent of one by definition.
% boolRowsSkip An optional list of rows in A that should be skipped when
%         computing the matrix permanent. This is an mX1 or 1Xm boolean
%         vector where a 1 means that row should be skipped. If omitted or
%         an empty matrix is passed, no rows are skipped.
% boolColsSkip An optional list of columns in A that should be skipped when
%         computing the matrix permanent. This is an nX1 or 1Xn boolean
%         vector where a 1 means that column should be skipped. If omitted
%         or an empty matrix is passed, no columns are skipped.
%
%OUTPUTS: val The matrix permanent of A, omitting any rows or columns as
%             necessary.
%
%Whereas polynomial-time algorithms exist for calculating determinants, it
%was proven in [1] that matrix permanents can not be computed in polynomial
%time unless P=NP. However, efficient non-polynomial time algorithms exist.
%This file implements the method in theorem 4.1 on page 26 in Chapter 2 of
%[2] when dealing with general rectangular matrices. When dealing with
%square matrices, an algorithm based on PERMAN from Chapter 23 of [3] is
%used, because it is more efficient and appears to be less susceptible to
%finite precision errors. When skipping rows or columns, only Ryser's
%algorithm is used.
%
%EXAMPLE 1:
%Suppose that one is given a boolean matrix where 1 indicates that a target
%gates with a measurement and a 0 indicates that it does not gate. To deal
%with the possibility of missed detections, one often adds dummy
%measurements, one per target, each gating with only one target. The total
%number of possible target-measurement (and missed detection) assignments
%equals the permanent of the matrix.
% %For 5 targets, 5 measurements (everything gates) and no missed
% %detections
% perm(ones(5,5))
% %One gets 120, there are 120 possible assignments (factorial(5)).
% %For 5 targets target where everything gates with the possibility of
% %missed detections, one has
% perm([ones(5,5),eye(5)])
% %Leading to 1546 possible assignments to measurements and missed
% %detections.
%
%EXAMPLE 2:
%This is an example with skip lists.
% numRow=12;
% numCol=4;
% A=magic(max(numRow,numCol));
% A=A(1:numRow,1:numCol);
% boolRowsSkip=false(numRow,1);
% boolColsSkip=false(numCol,1);
% boolRowsSkip(3)=true;
% boolColsSkip([1,4])=true;
% perm(A,boolRowsSkip,boolColsSkip)
% perm(A',boolColsSkip,boolRowsSkip)
% %The permanent values should both be 494938.
%
%REFERENCES:
%[1] L. G. Valiant, "The complexity of computing the permanent,"
%    Theoretical Computer Science, vol. 8, no. 2, pp. 189-201, 1979.
%[2] H. J. Ryser, Combinatorial Mathematics, ser. The Carus Mathematical
%    Monographs. The Mathematical Association of America, 1963, no. 14.
%[3] A. Nijenhuis and H. S. Wilf, Combinatorial Algorithms for Computers
%    and Calculators, 2nd ed. New York: Academic press, 1978.
%
%October 2014 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

    if(isempty(A))
        %Empty matrices have a permanent of 1 by definition.
        val=1;
        return;
    elseif(numel(A)==1)
        %Scalar values have a permanent equal to that value.
        val=A;
        return;
    end

    m=size(A,1);
    n=size(A,2);

    %Use a modified version of Ryser's algorithm if skip lists are
    %provided.
    if(nargin>1)
        mTotal=m;
        nTotal=n;
        if(nargin<3||isempty(boolColsSkip))
            boolColsSkip=false(nTotal,1);
        end

        if(isempty(boolRowsSkip))
            boolRowsSkip=false(mTotal,1);
        end

        numRowsSkipped=sum(boolRowsSkip);
        numColsSkipped=sum(boolColsSkip);

        m=mTotal-numRowsSkipped;
        n=nTotal-numColsSkipped;

        %Empty matrices have a permanent of 1 by definition.
        if(isempty(A)||m==0||n==0)
            val=1;
            return;
        end

        if(m>n)
            A=A';
            temp=m;
            m=n;
            n=temp;

            temp=mTotal;
            mTotal=nTotal;
            nTotal=temp;

            temp=boolRowsSkip;
            boolRowsSkip=boolColsSkip;
            boolColsSkip=temp;
        end

        %Set the mapping of indices of the rows in the submatrix to indices in
        %the full matrix.
        rows2Keep=zeros(m,1);%Allocate space
        cumSkip=0;
        curIdx=1;
        for curRow=1:mTotal
            if(boolRowsSkip(curRow)==true)
                cumSkip=cumSkip+1;
                continue;
            else
                rows2Keep(curIdx)=curIdx+cumSkip;
                curIdx=curIdx+1;
            end
        end

        %Set the mapping of indices of the columns in the submatrix to indices in
        %the full matrix.
        cols2Keep=zeros(n,1);%Allocate space
        cumSkip=0;
        curIdx=1;
        for curCol=1:nTotal
            if(boolColsSkip(curCol)==true)
                cumSkip=cumSkip+1;
                continue;
            else
                cols2Keep(curIdx)=curIdx+cumSkip;
                curIdx=curIdx+1;
            end
        end

        binomTerm=1;
        val=0;
        for x=0:(m-1)
            val=val+SigmaSSkip(A,n-m+x,rows2Keep,cols2Keep)*binomTerm;

            binomTerm=binomTerm*(1-m+n+x)/(1+x)*(-1);
        end

        return;
    end

    if(m~=n)%Use Ryser's algorithm
        if(m>n)
            A=A';
            temp=m;
            m=n;
            n=temp;
        end

        binomTerm=1;
        val=0;
        for x=0:(m-1)
            val=val+SigmaS(A,n-m+x)*binomTerm;

            binomTerm=binomTerm*(1-m+n+x)/(1+x)*(-1);
        end
    else%If the matrix is square, use the PERMAN algorithm.
        x=zeros(n,1);%Temporary storage space.
        p=0;

        for i=1:n
            sumVal=sum(A(i,:));
            x(i)=A(i,n)-sumVal/2;
        end

        sgn=-1;
        code=[];
        nCard=n-1;
        while(1)
            sgn=-sgn;
            prodVal=sgn;
            [code,nCard,isLast,j]=getNextGrayCode(code,nCard);

            if(nCard~=0)
                z=2*code(j)-1;
                x=x+z*A(:,j);
            end
            for i=1:n
                prodVal=prodVal*x(i);
            end
            p=p+prodVal;

            if(isLast)
                break;
            end
        end
        val=2*(2*mod(n,2)-1)*p;
    end
end

function val=S(A)
%This function gives us the product of the row sums of A.
    val=prod(sum(A,2));
end

function val=SigmaS(A,r)
    %This adds up all of the possible values of S(A) where r columns of A
    %have been replaced by zeros. We shall choose the
    %n-r columns of A that are NOT zero.
    n=size(A,2);
    combLen=n-r;
    curComb=1:combLen;
    val=0;
    while(~isempty(curComb))
        val=val+S(A(:,curComb));
        curComb=getNextCombo(curComb,n,1);
    end
end

function val=SigmaSSkip(A,r,rows2Keep,cols2Keep)
    %This adds up all of the possible values of S(A) where r columns of A
    %have been replaced by zeros. We shall choose the
    %n-r columns of A that are NOT zero.
    n=length(cols2Keep);
    combLen=n-r;
    curComb=0:(combLen-1);

    val=0;
    while(~isempty(curComb))
        val=val+S(A(rows2Keep,cols2Keep(curComb+1)));
        curComb=getNextCombo(curComb,n);
    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 [H,S]=create_CHS(A,B,C,N,M);
% CREATE_CHS Internal function to define matrices for MPC problem

% How many states
n=length(A);p=size(C,1);
[dummy,m]=size(B);

H=zeros(N*p,length(A));
S=zeros(N*p,N*m);

Acum=A;
for j=1:N,
  H(1+p*(j-1):p*j,:)=C*Acum;
  Acum=Acum*A;
end;

for j=1:N,
  Acum=eye(n);
  for k=j:-1:1,
    S(1+p*(j-1):p*j,1+m*(k-1):k*m)=C*Acum*B;
    Acum=Acum*A;
  end;
end;


function kcoeff = kwiener_train(X,Y,s)
% FUNCTION kcoeff = kwiener_train(X,Y,param)
%   AUTHOR:    Makoto Yamada
%              (myamada@ism.ac.jp)
%   DATE:       12/25/07
%
%  DESCRIPTION:
%
%   This function compute the kernel Wiener filter (kernel Dependency
%   Estimation) using Canonical Correlation Analysis (CCA)
%   and outputs it in the abstract object "kcoeff".
%   The "kcoeff" object can then be used for finding pre-images.
%
%  INPUTS:
%
%            X:     "X" is a (n times N) dimensional input matrix,
%                   where "n" is the vector dimension and N is the number
%                    of samples.
%
%            Y:     "Y" is a (m times N) dimensional output matrix.
%                    where "m" is the vector dimension and N is the number
%                    of samples.
%
%            s:      "s" is a parameter for Gaussian kernel,
%                    exp(-norm(x - y)^2/s).
%
%  OUTPUTS:
%
%    kcoeff   :     The Kernel Wiener Filter object.
%
%
%  Example:
%              load usps; %loading USPS data
%              s = 256*0.7; %Gaussian Kernel Parameter
%              %Training Kernel Wiener Filter
%              kcoeff = kwiener_train(X,Y,s);
%
%  Reference:  1. J. Weston et.al. ``Kernel Dependency Estimation,'' NIPS
%                 2003
%
%              2. M. Yamada and M. R. Azimi-Sadjadi, ``Kernel Wiener Filter
%                 using Canonical Correlation Analysis Framework,''
%                 IEEE SSP'05, Bordeaux, France, July 17-20, 2005.
%
%              3. C. Cortes et.al. ``A General Regression Technique for
%                 Learning Transductions,'' ICML, Bonn, Germany, Aug 7-11.
%
%              4. M. Yamada and M. R. Azimi-Sadjadi, ``Kernel Wiener Filter
%                 with Distance Constraint,'' ICASSP,  Toulouse, France,
%                 May 14-19, 2006
%
%              5. Zhe Chen et.al, ``Correlative Learning: A Basis for Brain and Adaptive
%                 Systems,'' Wiley, Oct. 2007 (Section 4.6)

n = size(X,2); %Number of Training samples

%Kernel Computation (Gaussian Kernel)
disp('Computing the Gram Matrix of X');
Kx = kernelg(X,X,s);
disp('Computing the Gram Matrix of Y');
Ky = kernelg(Y,Y,s);

%Centering Matrix
J = eye(n) - 1/n*ones(n);
%Centering Kernel Gram Matrix
A = J*Kx*J;

%Computing the Kernel Wiener Filter (Kernel Dependency Estimation)
%Computing the first kernel Canonical Coordinate.
[F D] = eig(A);
Lambda = sqrt(abs(real(diag(D))));
[YY I]  = sort(-Lambda);

%Normalizing Eigenvectors.
for k = 1:n
    if Lambda(k) ~= 0
        F(:,k)=F(:,k)/Lambda(k);
    end
end

Lambda = -YY;
F      = F(:,I);
kcoeff.Df   = F;                 %First kernel Canonical mapping function.
kcoeff.lambda = Lambda;          %Eigenvalue of kernel CCA.

%Computing the second kernel Canonical Coordinate.
ry = rank(Ky);
[Uy Wy Vy] = svd(Ky);
invKy = Vy(:,1:ry)*inv(Wy(1:ry, 1:ry))*Uy(:,1:ry)';
kcoeff.Dg = invKy*Kx*J*kcoeff.Df; %Second kernel Canonical mapping function.

kcoeff.Kxt = kcoeff.Df'*Kx;

%Computing rank of kernel Wiener filter.
[temp1,temp2] = find(kcoeff.lambda > 0);

if sum(temp2) == size(kcoeff.Kxt,2)
    kcoeff.rnk = sum(temp2) -1;
else
    kcoeff.rnk = sum(temp2);
end

disp('Finished Kernel Wiener Estimation');


function de00 = deltaE2000(Labstd,Labsample)
% Based on the article:
% "The CIEDE2000 Color-Difference Formula: Implementation Notes,
% Supplementary Test Data, and Mathematical Observations,", G. Sharma,
% W. Wu, E. N. Dalal, Color Research and Application, vol. 30. No. 1, pp.
% 21-30, February 2005.
% available at http://www.ece.rochester.edu/~/gsharma/ciede2000/
kl = 1; kc=1; kh =1;
Lstd = Labstd(:,1)';
astd = Labstd(:,2)';
bstd = Labstd(:,3)';
Cabstd = sqrt(astd.^2+bstd.^2);
Lsample = Labsample(:,1)';
asample = Labsample(:,2)';
bsample = Labsample(:,3)';
Cabsample = sqrt(asample.^2+bsample.^2);
Cabarithmean = (Cabstd + Cabsample)/2;
G = 0.5* (1 - sqrt( (Cabarithmean.^7)./(Cabarithmean.^7 + 25^7)));
apstd = (1+G).*astd;
apsample = (1+G).*asample;
Cpsample = sqrt(apsample.^2+bsample.^2);
Cpstd = sqrt(apstd.^2+bstd.^2);
Cpprod = (Cpsample.*Cpstd);
zcidx = find(Cpprod == 0);
hpstd = atan2(bstd,apstd);
hpstd = hpstd+2*pi*(hpstd < 0);
hpstd((abs(apstd)+abs(bstd))== 0) = 0;
hpsample = atan2(bsample,apsample);
hpsample = hpsample+2*pi*(hpsample < 0);
hpsample((abs(apsample)+abs(bsample))==0) = 0;
dL = (Lsample-Lstd);
dC = (Cpsample-Cpstd);
dhp = (hpsample-hpstd);
dhp = dhp - 2*pi* (dhp > pi );
dhp = dhp + 2*pi* (dhp < (-pi) );
dhp(zcidx ) = 0;
dH = 2*sqrt(Cpprod).*sin(dhp/2);
Lp = (Lsample+Lstd)/2;
Cp = (Cpstd+Cpsample)/2;
hp = (hpstd+hpsample)/2;
hp = hp - ( abs(hpstd-hpsample)  > pi ) *pi;
hp = hp+ (hp < 0) *2*pi;
hp(zcidx) = hpsample(zcidx)+hpstd(zcidx);
Lpm502 = (Lp-50).^2;
Sl = 1 + 0.015*Lpm502./sqrt(20+Lpm502);
Sc = 1+0.045*Cp;
T = 1 - 0.17*cos(hp - pi/6 ) + 0.24*cos(2*hp) + 0.32*cos(3*hp+pi/30) ...
    -0.20*cos(4*hp-63*pi/180);
Sh = 1 + 0.015*Cp.*T;
delthetarad = (30*pi/180)*exp(- ( (180/pi*hp-275)/25).^2);
Rc =  2*sqrt((Cp.^7)./(Cp.^7 + 25^7));
RT =  - sin(2*delthetarad).*Rc;
klSl = kl*Sl;
kcSc = kc*Sc;
khSh = kh*Sh;
de00 = sqrt( (dL./klSl).^2 + (dC./kcSc).^2 + (dH./khSh).^2 + ...
    RT.*(dC./kcSc).*(dH./khSh) );
return


function [tm,T]=loctime(sig);
%LOCTIME Time localization caracteristics.
%	[TM,T]=LOCTIME(SIG) computes the time localization
%	caracteristics of signal SIG.
%
%	SIG is the signal.
%	TM  is the averaged time center.
%	T   is the time spreading.
%
%	Example :
%	 z=amgauss(160,80,50); [tm,T]=loctime(z)
%
%	See also LOCFREQ.

%	F. Auger, July 1995.
%	Copyright (c) 1996 by CNRS (France).
%
%  This program is free software; you can redistribute it and/or modify
%  it under the terms of the GNU General Public License as published by
%  the Free Software Foundation; either version 2 of the License, or
%  (at your option) any later version.
%
%  This program is distributed in the hope that it will be useful,
%  but WITHOUT ANY WARRANTY; without even the implied warranty of
%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%  GNU General Public License for more details.
%
%  You should have received a copy of the GNU General Public License
%  along with this program; if not, write to the Free Software
%  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

[sigr,sigc]=size(sig);
if (sigc~=1),
 error('The signal must have 1 column');
else
 sig2=abs(sig).^2; sig2=sig2/mean(sig2);
 t=(1:sigr)';
 tm=mean(t.*sig2);
 T=2*sqrt(pi*mean((t-tm).^2 .* sig2));
end;


function quadrule_test096 ( )

%*****************************************************************************80
%
%% QUADRULE_TEST096 tests HERMITE_GK**_SET.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 May 2011
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'QUADRULE_TEST096\n' );
  fprintf ( 1, '  HERMITE_GK**_SET sets up a nested rule\n' );
  fprintf ( 1, '  for the Hermite integration problem.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The integration interval is ( -oo, +oo ).\n' );
  fprintf ( 1, '  The weight function is exp ( - x * x )\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  HERMITE_INTEGRAL determines the exact value of\n' );
  fprintf ( 1, '  the integal when f(x) = x^m.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Here, we just test the highest order rule.\n' );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  HERMITE_GK16_SET:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '         M         N       Estimate       Exact            Error\n' );
  fprintf ( 1, '\n' );

  n = 35;
  p = 51;

  [ x, w ] = hermite_gk16_set ( n );

  for m = 0 : 2 : min ( p + 2, 20 )

    exact = hermite_integral ( m );

    if ( m == 0 )
      f = ones ( n, 1 );
    else
      f = zeros ( n, 1 );
      f = x.^m;
    end

    estimate = w(1:n)' * f(1:n);

    error = abs ( exact - estimate );

    fprintf ( 1, '  %8d  %8d  %14.6e  %14.6e  %14.6e\n', ...
      m, n, estimate, exact, error );

  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  HERMITE_GK18_SET:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '         M         N       Estimate       Exact            Error\n' );
  fprintf ( 1, '\n' );

  n = 37;
  p = 55;

  [ x, w ] = hermite_gk18_set ( n );

  for m = 0 : 2 : min ( p + 2, 20 )

    exact = hermite_integral ( m );

    if ( m == 0 )
      f = ones ( n, 1 );
    else
      f = zeros ( n, 1 );
      f = x.^m;
    end

    estimate = w(1:n)' * f(1:n);

    error = abs ( exact - estimate );

    fprintf ( 1, '  %8d  %8d  %14.6e  %14.6e  %14.6e\n', ...
      m, n, estimate, exact, error );

  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  HERMITE_GK22_SET:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '         M         N       Estimate       Exact            Error\n' );
  fprintf ( 1, '\n' );

  n = 41;
  p = 63;

  [ x, w ] = hermite_gk22_set ( n );

  for m = 0 : 2 : min ( p + 2, 20 )

    exact = hermite_integral ( m );

    if ( m == 0 )
      f = ones ( n, 1 );
    else
      f = zeros ( n, 1 );
      f = x.^m;
    end

    estimate = w(1:n)' * f(1:n);

    error = abs ( exact - estimate );

    fprintf ( 1, '  %8d  %8d  %14.6e  %14.6e  %14.6e\n', ...
      m, n, estimate, exact, error );

  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  HERMITE_GK24_SET:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '         M         N       Estimate       Exact            Error\n' );
  fprintf ( 1, '\n' );

  n = 43;
  p = 67;

  [ x, w ] = hermite_gk24_set ( n );

  for m = 0 : 2 : min ( p + 2, 20 )

    exact = hermite_integral ( m );

    if ( m == 0 )
      f = ones ( n, 1 );
    else
      f = zeros ( n, 1 );
      f = x.^m;
    end

    estimate = w(1:n)' * f(1:n);

    error = abs ( exact - estimate );

    fprintf ( 1, '  %8d  %8d  %14.6e  %14.6e  %14.6e\n', ...
      m, n, estimate, exact, error );

  end

  return
end


function [e1, e2, E1_l, E2_l] = ahmLinEndpoints(l,t1,t2)

% AHMLINENDPOINTS  AHM line endpoints.
%   AHMLINENDPOINTS(L,T) returns the 3D Euclidean endpoint of the
%   AHM line L at abscissa T.
%
%   [E1,E2] = AHMLINENDPOINTS(L,T1,T2) returns two 3D Euclidean endpoints
%   at abscissas T1 and T2.
%
%   [e1,e2,E1_l,E2_l] = AHMLINENDPINTS(...) returns the Jacobians of the
%   endopints wrt L.
%
%   See also AHMLINSEGMENT, AHMLIN2SEG, AHMLIN2IDPPNTS.

%   Copyright 2009 Teresa Vidal.

if nargout <= 2

    % support segment
    s  = ahmLin2seg(l);

    % support points
    p1 = s(1:3);
    p2 = s(4:6);

    % endpoints
    e1 = (1-t1)*p1 + t1*p2;
    e2 = (1-t2)*p1 + t2*p2;

else

    [s, S_l] = ahmLin2seg(l);       % support segment

    p1 = s(1:3);                    % support points
    p2 = s(4:6);

    P1_l = S_l(1:3,:);              % jacobians of sup points
    P2_l = S_l(4:6,:);

    e1 = (1-t1)*p1 + t1*p2;         % endpoints
    e2 = (1-t2)*p1 + t2*p2;

    E1_p1 = 1-t1;                   % jacobians of endpoints
    E1_p2 = t1;
    E2_p1 = 1-t2;
    E2_p2 = t2;

    E1_l = E1_p1*P1_l + E1_p2*P2_l; % chain rule
    E2_l = E2_p1*P1_l + E2_p2*P2_l;

end

% ========== End of function - Start GPL license ==========

%   # START GPL LICENSE

%---------------------------------------------------------------------
%
%   This file is part of SLAMTB, a SLAM toolbox for Matlab.
%
%   SLAMTB 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.
%
%   SLAMTB 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 SLAMTB.  If not, see <http://www.gnu.org/licenses/>.
%
%---------------------------------------------------------------------

%   SLAMTB is Copyright:
%   Copyright (c) 2008-2010, Joan Sola @ LAAS-CNRS,
%   Copyright (c) 2010-2013, Joan Sola,
%   Copyright (c) 2014-2015, Joan Sola @ IRI-UPC-CSIC,
%   SLAMTB is Copyright 2009
%   by Joan Sola, Teresa Vidal-Calleja, David Marquez and Jean Marie Codol
%   @ LAAS-CNRS.
%   See on top of this file for its particular copyright.

%   # END GPL LICENSE


function d = p09_fd ( p )

%*****************************************************************************80
%
%% P09_FD is a signed distance function for problem 9.
%
%  Discussion:
%
%    Notice that the V1 and V2 arrays, which define hexagons, contain SEVEN
%    points, not six.  This is necessary in order for DPOLY to carry out its
%    calculations correctly.
%
%  Licensing:
%
%    (C) 2004 Per-Olof Persson.
%    See COPYRIGHT.TXT for details.
%
%  Modified:
%
%    11 March 2006
%
%  Parameters:
%
%    Input, real P, one or more points.
%
%    Output, real D, the signed distance of each point to the boundary of the region.
%
  v1 = [ 0.15, 0.75;
         0.20, 0.6634;
         0.30, 0.6634;
         0.35, 0.75;
         0.30, 0.8366;
         0.20, 0.8366;
         0.15, 0.75 ];

  d1 = dpoly ( p, v1 );

  v2 = [ 0.50, 0.40;
         0.55, 0.3134;
         0.65, 0.3134;
         0.70, 0.40;
         0.65, 0.4866;
         0.55, 0.4866;
         0.50, 0.40 ];

  d2 = dpoly ( p, v2 );

  d3 = dunion ( d1, d2 );

  d4 = drectangle ( p, 0.0, 1.0, 0.0, 1.0 );

  d = ddiff ( d4, d3 );

  return
end


function gb=gabor_fn(sigma,theta,lambda,psi,gamma)

sigma_x = sigma;
sigma_y = sigma/gamma;

% Bounding box
nstds = 3;
xmax = max(abs(nstds*sigma_x*cos(theta)),abs(nstds*sigma_y*sin(theta)));
xmax = ceil(max(1,xmax));
ymax = max(abs(nstds*sigma_x*sin(theta)),abs(nstds*sigma_y*cos(theta)));
ymax = ceil(max(1,ymax));
xmin = -xmax; ymin = -ymax;
[x,y] = meshgrid(xmin:xmax,ymin:ymax);

% Rotation
x_theta=x*cos(theta)+y*sin(theta);
y_theta=-x*sin(theta)+y*cos(theta);

gb= 1/(2*pi*sigma_x *sigma_y) * exp(-.5*(x_theta.^2/sigma_x^2+y_theta.^2/sigma_y^2)).*cos(2*pi/lambda*x_theta+psi);


function x = triangle_cdf_inv ( cdf, a, b, c )

%*****************************************************************************80
%
%% TRIANGLE_CDF_INV inverts the Triangle CDF.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real CDF, the value of the CDF.
%    0.0 <= CDF <= 1.0.
%
%    Input, real A, B, C, the parameters of the PDF.
%    A <= B <= C and A < C.
%
%    Output, real X, the corresponding argument.
%
  if ( cdf < 0.0 | 1.0 < cdf )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'TRIANGLE_CDF_INV - Fatal error!\n' );
    fprintf ( 1, '  CDF < 0 or 1 < CDF.\n' );
    error ( 'TRIANGLE_CDF_INV - Fatal error!' );
  end

  d = 2.0 / ( c - a );
  cdf_mid = 0.5 * d * ( b - a );

  if ( cdf <= cdf_mid )
    x = a + sqrt ( cdf * ( b - a ) * ( c - a ) );
  else
    x = c - sqrt ( ( c - b ) * ( ( c - b ) - ( cdf - cdf_mid ) * ( c - a ) ) );
  end

  return
end


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

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

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


function C=tprod(A,B)
% Computes the tensor-product of two P dimensional tensors (A & B)
% All dimensions of the inputed tensor except for the 2nd must be the same.
% The algorithm follows from paper by ...
%
% INPUTS:
%
% A - n1 x n2 x n3 .... nP tensor
% B - n2 x n4 x n3 .... nP tensor
%
% OUTPUTS:
%
% C - n1 x n4 x n3 .... nP tensor
%
% Original author :  Misha Kilmer, Ning Hao
% Edited by       :  G. Ely, S. Aeron, Z. Zhang, ECE, Tufts Univ. 03/16/2015

sa = size(A);
sb = size(B);

faces = length(sa);

nfaces = prod(sb(3:end));

for i = 3:faces
    A = fft(A,[],i);
    B = fft(B,[],i);
end
sc = sa;
sc(2) = sb(2);
C = zeros(sc);
for i = 1:nfaces
    C(:,:,i) = A(:,:,i)*B(:,:,i);
end
for i = 3:faces
    C = ifft(C,[],i);
end


function [mappedX, mapping] = charting(X, no_dims, no_analyzers, max_iterations, eig_impl)
%CHARTING Performs manifold charting on dataset X
%
%   [mappedX, mapping] = charting(X, no_dims, no_analyzers, max_iterations, eig_impl)
%
% Performs manifold charting on dataset X to reduce its dimensionality to
% no_dims dimensions. The variable no_analyzers determines the number of
% local factor analyzers that is used in the mixture of factor analyzers
% (default = 40). The variable max_iterations sets the maximum number of
% iterations that is employed in the EM algorithm (default = 200).
%

% This file is part of the Matlab Toolbox for Dimensionality Reduction.
% The toolbox can be obtained from http://homepage.tudelft.nl/19j49
% You are free to use, change, or redistribute this code in any way you
% want for non-commercial purposes. However, it is appreciated if you
% maintain the name of the original author.
%
% (C) Laurens van der Maaten, Delft University of Technology

    if ~exist('no_dims', 'var')
        no_dims = 2;
    end
    if ~exist('no_analyzers', 'var')
        no_analyzers = 40;
    end
    if ~exist('max_iterations', 'var')
        max_iterations = 200;
    end

    % Initialize some parameters
    tol = 1e-10;                        % regularization parameter
    min_std = 1e-3;                     % minimum STD of Gaussians
    kf = no_analyzers * (no_dims + 1);

    % Construct MFA model on the data
    disp('Running EM algorithm and compute local factor analyzers...');
    [LX, MX, PX] = mppca(X', no_dims, no_analyzers, tol, max_iterations, min_std);
    [R, Z] = infermfa(X', LX, MX, PX);

    % Adds last entry = 1 in posterior mean to handle means of factor analyzers
    Z(no_dims + 1,:,:) = 1;
    Z = permute(Z, [1 3 2]);

    % Construct blockdiagonal matrix D
    disp('Performing manifold charting...');
    D = zeros((no_dims + 1) * no_analyzers, (no_dims + 1) * no_analyzers);
    for i=1:no_analyzers
        Ds = zeros(no_dims + 1, no_dims + 1);
        for j=1:size(X, 1)
            Ds = Ds + R(i, j) .* (Z(:,i,j) * Z(:,i,j)');
        end
        D((i - 1) * (no_dims + 1) + 1:i * (no_dims + 1), (i - 1) * (no_dims + 1) + 1:i * (no_dims + 1)) = Ds;
    end

    % Construct responsibility weighted local representation matrix U
    R = reshape(R, [1 no_analyzers size(X, 1)]);
    U = reshape(bsxfun(@times, R, Z), [kf size(X, 1)])';

    % Solve generalized eigenproblem
    if strcmp(eig_impl, 'Matlab')
        options.disp = 0;
        options.isreal = 1;
        options.issym = 1;
        [V, lambda] = eigs(D - U' * U, U' * U, no_dims + 1, 'SM', options);
    else
        options.Disp = 0;
        options.LSolver = 'bicgstab';
        [V, lambda] = jdqz(D - U' * U, U' * U, no_dims + 1, 'SM', options);
    end
    [lambda, ind] = sort(diag(lambda));
    V = V(:,ind(2:end));

    % Compute final lowdimensional data representation
    mappedX = U * V;

    % Store mapping data for out-of-sample extension
    if nargout > 1
        mapping.LX = LX;
        mapping.MX = MX;
        mapping.PX = PX;
        mapping.V = V;
    end


function [parent_pop] = osy(parent_pop)
%   This procedure implements Osyczka and Kundu's function.
%   The canonical zdt1 function is defined as below --
%   f_1 = -25.0 * ((x_1 - 2)^2 - (x_2 - 2)^2 - (x_3 - 1)^2
%                           - (x_4 - 4)^2 - (x_5 - 1)^2)
%   f_2 = sum_{i=1}^n x_i^2.0
%   s.t.
%       c_1(x) = x_1 + x_2 - 2 >= 0
%       c_2(x) = 6 - x_1 - x_2 >= 0
%       c_3(x) = 2 - x_2 + x_1 >= 0
%       c_4(x) = 2 - x_1 + 3x_2 >= 0
%       c_5(x) = 4 - (x_3 - 3)^2 - x_4 >= 0
%       c_6(x) = (x_5 - 3)^2 + x_6 - 4 >= 0
%   where,
%       0 <= x_1 <= 10.0
%       0 <= x_2 <= 10.0
%       1 <= x_3 <= 5.0
%       0 <= x_4 <= 6.0
%       1 <= x_5 <= 5.0
%       0 <= x_6 <= 10.0

global nreal ;
global ncon ;
global nobj ;

cindex = nreal + nobj + 1 : nreal + nobj + ncon ;

% disp(parent_pop(1,:))

x = parent_pop(:,1:nreal);
f1 = -(25.0 .* ((x(:,1) - 2.0) .^ 2.0) + ((x(:,2) - 2.0) .^ 2.0) ...
             + ((x(:,3) - 1.0) .^ 2.0) + ((x(:,4) - 4.0) .^ 2.0) ...
             + ((x(:,5) - 1.0) .^ 2.0));
f2 = sum((x .^ 2.0), 2) ;

c = parent_pop(:,cindex) ;
% disp(c(1,:))
c(:,1) = ((x(:,1) + x(:,2)) ./ 2.0) - 1.0 ;
c(:,2) = 1.0 - ((x(:,1) + x(:,2)) ./ 6.0);
c(:,3) = 1.0 - (x(:,2) ./ 2.0) + (x(:,1) ./ 2.0);
c(:,4) = 1.0 - (x(:,1) ./ 2.0) + (3.0 .* (x(:,2) ./ 2.0));
c(:,5) = 1.0 - (((x(:,3) - 3.0) .^ 2.0) ./ 4.0) - (x(:,4) ./ 4.0);
c(:,6) = (((x(:,5) - 3.0) .^ 2.0) ./ 4.0) + (x(:,6) ./ 4.0) - 1.0;
parent_pop(:, (nreal+1)) = f1;
parent_pop(:, (nreal+2)) = f2;
parent_pop(:,cindex) = c ;
end


function k = calcWaveNumber(omega,waterDepth,g,deepWater)
% Solves the wave dispersion relation :math:`\omega^2 = g k*tanh(k h)` for
% the wave number
%
% Parameters
% ----------
%     omega : float
%         Wave frequency [rad/s]
%
%     waterDepth : float
%         Water depth [m]
%
%     g : float
%         Gravitational acceleration [m/s^2]
%
%     deepWater : integar
%         waveClass flag inidicating a deep water wave [-]
%
% Returns
% ------------
%    k : float
%        Wave number [m]
%

arguments
    omega
    waterDepth
    g = 9.81;
    deepWater = 0;
end

% Deep water approximation, initial guess
k = omega.^2./g;

% Iterate for shallow and intermediate water, full dispersion relationship
if deepWater == 0
    for i = 1:100
        k = omega.^2./g./tanh(k.*waterDepth);
    end
end

end


function op = proj_l1( q, d )
%PROJ_L1   Projection onto the scaled 1-norm ball.
%    OP = PROJ_L1( Q ) returns an operator implementing the
%    indicator function for the 1-norm ball of radius q,
%    { X | norm( X, 1 ) <= q }. Q is optional; if omitted,
%    Q=1 is assumed. But if Q is supplied, it must be a positive
%    real scalar.
%
%    OP = PROJ_L1( Q, D ) uses a scaled 1-norm ball of radius q,
%    { X | norm( D.*X, 1 ) <= 1 }. D should be the same size as X
%    and non-negative (some zero entries are OK).
%
% Dual: prox_linf.m
% See also: prox_linf, prox_l1, proj_linf

if nargin == 0,
	q = 1;
elseif ~isnumeric( q ) || ~isreal( q ) || numel( q ) ~= 1 || q <= 0,
	error( 'Argument must be positive.' );
end
if nargin < 2 || isempty(d) || numel(d)==1
    if nargin>=2 && ~isempty(d)
        % d is a scalar, so norm( d*x ) <= q is same as norm(x)<=q/d
        if d==0
            error('If d==0 in proj_l1, the set is just {0}, so use proj_0');
        elseif d < 0
            error('Require d >= 0');
        end
        q = q/d;
    end
    op = @(varargin)proj_l1_q(q, varargin{:} );
else
    if any(d<0)
        error('All entries of d must be non-negative');
    end
    op = @(varargin)proj_l1_q_d(q, d, varargin{:} );
end

function [ v, x ] = proj_l1_q( q, x, t )
v = 0;
switch nargin,
case 2,
	if nargout == 2,
		error( 'This function is not differentiable.'  );
	elseif norm( x(:), 1 ) > q,
		v = Inf;
	end
case 3,
    s      = sort(abs(nonzeros(x)),'descend');
    cs     = cumsum(s);
    % ndx    = find( cs - (1:numel(s))' .* [ s(2:end) ; 0 ] >= q, 1 );
    ndx    = find( cs - (1:numel(s))' .* [ s(2:end) ; 0 ] >= q+2*eps(q), 1 ); % For stability
    if ~isempty( ndx )
        thresh = ( cs(ndx) - q ) / ndx;
        x      = x .* ( 1 - thresh ./ max( abs(x), thresh ) ); % May divide very small numbers
    end
otherwise,
    error( 'Not enough arguments.' );
end

% Allows scaling. Added Feb 21 2014
function [ v, x ] = proj_l1_q_d( q, d,  x, t )
v = 0;
switch nargin,
case 3,
	if nargout == 2,
		error( 'This function is not differentiable.'  );
	elseif norm( d(:).*x(:), 1 ) > q,
		v = Inf;
	end
case 4,
    [lambdas,srt]      = sort(abs(nonzeros(x./d)),'descend');
    s   = abs(x(:).*d(:));  s = s(srt);
    dd  = d(:).^2;          dd= dd(srt);
    cs  = cumsum(s);
    cd  = cumsum(dd);
    ndx    = find( cs - lambdas.*cd >= q+2*eps(q), 1, 'first');
    if ~isempty( ndx )
        ndx     = ndx - 1;
        lambda  = ( cs(ndx) - q )/cd(ndx);
        x       = sign(x).*max( 0, abs(x) - lambda*d );
    end
otherwise,
    error( 'Not enough arguments.' );
end

% TFOCS v1.3 by Stephen Becker, Emmanuel Candes, and Michael Grant.
% Copyright 2013 California Institute of Technology and CVX Research.
% See the file LICENSE for full license information.


function [ n_data, x, fx ] = psi_values ( n_data )

%*****************************************************************************80
%
%% PSI_VALUES returns some values of the Psi or Digamma function.
%
%  Discussion:
%
%    In Mathematica, the function can be evaluated by:
%
%      PolyGamma[x]
%
%    or
%
%      PolyGamma[0,x]
%
%    PSI(X) = d ln ( Gamma ( X ) ) / d X = Gamma'(X) / Gamma(X)
%
%    PSI(1) = -Euler's constant.
%
%    PSI(X+1) = PSI(X) + 1 / X.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 June 2013
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Milton Abramowitz and Irene Stegun,
%    Handbook of Mathematical Functions,
%    US Department of Commerce, 1964.
%
%    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, real X, the argument of the function.
%
%    Output, real FX, the value of the function.
%
  n_max = 20;

  fx_vec = [ ...
    -10.42375494041108E+00, ...
     -5.289039896592188E+00, ...
     -3.502524222200133E+00, ...
     -2.561384544585116E+00, ...
     -1.963510026021423E+00, ...
     -1.540619213893190E+00, ...
     -1.220023553697935E+00, ...
     -0.9650085667061385E+00, ...
     -0.7549269499470514E+00, ...
     -0.5772156649015329E+00, ...
     -0.4237549404110768E+00, ...
     -0.2890398965921883E+00, ...
     -0.1691908888667997E+00, ...
     -0.6138454458511615E-01, ...
      0.3648997397857652E-01, ...
      0.1260474527734763E+00, ...
      0.2085478748734940E+00, ...
      0.2849914332938615E+00, ...
      0.3561841611640597E+00, ...
      0.4227843350984671E+00 ];

  x_vec = [ ...
     0.1E+00, ...
     0.2E+00, ...
     0.3E+00, ...
     0.4E+00, ...
     0.5E+00, ...
     0.6E+00, ...
     0.7E+00, ...
     0.8E+00, ...
     0.9E+00, ...
     1.0E+00, ...
     1.1E+00, ...
     1.2E+00, ...
     1.3E+00, ...
     1.4E+00, ...
     1.5E+00, ...
     1.6E+00, ...
     1.7E+00, ...
     1.8E+00, ...
     1.9E+00, ...
     2.0E+00 ];

  if ( n_data < 0 )
    n_data = 0;
  end

  n_data = n_data + 1;

  if ( n_max < n_data )
    n_data = 0;
    x = 0.0;
    fx = 0.0;
  else
    x = x_vec(n_data);
    fx = fx_vec(n_data);
  end

  return
end


function out =  bicubic_interpolation_cell(p, x, y)
v(1) = cubic_interpolation_cell(p(1,:), y);
v(2) = cubic_interpolation_cell(p(2,:), y);
    v(3) = cubic_interpolation_cell(p(3,:), y);
    v(4) = cubic_interpolation_cell(p(4,:), y);
   out =  cubic_interpolation_cell(v, x);

end


function [cc,c0]=lpcpf2cc(pf,np,f)
%LPCPF2CC Convert power spectrum to complex cepstrum CC=(PF,NP)
%
%  Inputs: pf(nf,n)    Power spectrum, uniformly spaced DC to Nyquist
%          np          Number of cepstral coefficients to calculate [n-1]
%          f(1,n)      Frequencies of pf columns [linspace(0,0.5,n)]
%
% Outputs: cc(nf,np)  Complex spectrum from DC to Nyquist
%          c0(nf,1)   The zeroth cepstral coefficient, c(0)
%
% Note since the log spectrum is not normally bandlimited, this conversion is not exact unless n >> np

%      Copyright (C) Mike Brookes 1998-2014
%      Version: $Id: lpcpf2cc.m 5025 2014-08-22 17:07:24Z 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.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
[nf,nq]=size(pf);
if nargin<2 || ~numel(np) np=nq-1; end
if nargin<3 || ~numel(f)
    cc=rsfft(log(pf.')).'/(2*nq-2);
    c0=cc(:,1)*0.5;
    cc(:,nq)=cc(:,nq)*0.5;
    if np>nq-1
        cc=[cc(:,2:nq) zeros(nf,np-nq+1)];
    else
        cc=cc(:,2:np+1);
    end
else
    cc=0.5*(log(pf)/cos(2*pi*f(:)*(0:min(np,nq-1))));
    c0=cc(:,1);
    cc=cc(:,2:end);
    if np>nq-1
        cc(1,np)=0;
    end
end


function [stats, TABLE] = SummStats(TEMP,p)
% =======================================================================
% Computes descriptive stats of a time series (or a matrix of time series)
% =======================================================================
% [stats, TABLE] = SummStats(TEMP,p)
% -----------------------------------------------------------------------
% INPUT
%   - TEMP  : T obs (rows) x N series (columns)
%   - p = order of time polynomial in the ADF null-hypothesis.
%         p ~exist, does not perform ADF test
%         p = -1, no deterministic part
%         p =  0, for constant term
%         p =  1, for constant plus time-trend
%         p >  1, for higher order polynomial
% -----------------------------------------------------------------------
% OUTPUT
%   - stats: [Obs, mean, median, max, min, StDev, AutoCorr, Skew, Kurt,...
%       ADF(4), ADF(4) Conf, ADF(8), ADF(8) Conf]
%   - TABLE: cell, matrix with the names of the stats & the stats
% =======================================================================
% Ambrogio Cesa Bianchi, March 2015

[~, c] = size(TEMP);

% Compute summary statistics NaN are not considered (like in Excel)
mean    = nanmean(TEMP);
median  = nanmedian(TEMP);
max     = nanmax(TEMP);
min     = nanmin(TEMP);
StDev   = nanstd(TEMP);
CV      = StDev./mean;

% Compute autocorrelation coefficient AutoCorr on the maximum number of
% observation available per series
for i=1:c
    X = TEMP(:,i);
    if isnan(X)==1
        Obs(1,i)  = NaN;
        AutoCorr(1,i)  = NaN;
        Skew(1,i) = NaN;
        Kurt(1,i) = NaN;
        ADF4(1,i) = NaN;
        ADF4conf(1,i) = NaN;
        ADF8(1,i) = NaN;
        ADF8conf(1,i) = NaN;
    else
        X(any(isnan(X),2),:) = [];
        size_X    = size(X);
        Obs(1,i)  = size_X(1);
        AutoCorr(1,i)  = corr(X(2:end),X(1:end-1));
        Skew(1,i) = skewness(X);
        Kurt(1,i) = kurtosis(X);
        % If less than 20 observations don't do ADF4
        if length(X)<20 || ~exist('p','var')
            ADF4(1,i) = NaN;
            ADF4conf(1,i) = NaN;
        else
            test = adf(X,p,4);
            ADF4(1,i) = test.adf;
            if test.adf<test.crit(1)    % cannot reject the null of I(0)
                ADF4conf(1,i) = 0.01;
            elseif test.adf<test.crit(2)
                ADF4conf(1,i) = 0.05;
            elseif test.adf<test.crit(3)
                ADF4conf(1,i) = 0.10;
            else                        % reject the null of I(0) => I(1)
                ADF4conf(1,i) = 0;
            end
        end
        % If less than 40 observations don't do ADF8
        if length(X)<40 || ~exist('p','var')
            ADF8(1,i) = NaN;
            ADF8conf(1,i) = NaN;
        else
            test = adf(X,p,8);
            ADF8(1,i) = test.adf;
            if test.adf<test.crit(1)
                ADF8conf(1,i) = 0.01;
            elseif test.adf<test.crit(2)
                ADF8conf(1,i) = 0.05;
            elseif test.adf<test.crit(3)
                ADF8conf(1,i) = 0.10;
            else
                ADF8conf(1,i) = 0;
            end
        end
    end
end

% Create matrix with all summary stats
stats = [Obs; mean; median; max; min; StDev; AutoCorr; Skew; Kurt; ADF4; ADF4conf; ADF8; ADF8conf; CV];

% Create titles
titles ={'Obs'; 'Mean'; 'Median'; 'Max'; 'Min'; 'St. Dev.'; 'Auto Corr.'; 'Skew.'; 'Kurt.'; 'ADF(4)'; 'ADF(4) Conf.'; 'ADF(8)'; 'ADF(8) Conf.'; 'Coeff. Variation'};

% Create cell
TABLE = TabPrint(stats,[],titles);


function Cont=Contingency(Mem1,Mem2)
%CONTINGENCY Form contigency matrix for two vectors
% C=Contingency(Mem1,Mem2) returns contingency matrix for two
% column vectors Mem1, Mem2. These define which cluster each entity
% has been assigned to.
%
% See also RANDINDEX.
%

%(C) David Corney (2000)   		D.Corney@cs.ucl.ac.uk

if nargin < 2 | min(size(Mem1)) > 1 | min(size(Mem2)) > 1
   error('Contingency: Requires two vector arguments')
   return
end

Cont=zeros(max(Mem1),max(Mem2));

for i = 1:length(Mem1);
   Cont(Mem1(i),Mem2(i))=Cont(Mem1(i),Mem2(i))+1;
end


function b = isPointOnRay(point, ray, varargin)
%ISPOINTONRAY Test if a point belongs to a ray.
%
%   B = isPointOnRay(PT, RAY);
%   Returns 1 if point PT belongs to the ray RAY.
%   PT is given by [x y] and RAY by [x0 y0 dx dy].
%
%   If PT is a N-by-2 array, and RAY is a M-by-4 array, then the result is
%   a N-by-M array containing the result of each pair-wise test.
%
%   B = isPointOnRay(PT, RAY, TOL);
%   Specifies the tolerance to use for testing if point is on the ray.
%
%   Example
%     ray = [10 20 3 4];
%     % test for a point on the ray
%     p1 = [16 28];
%     isPointOnRay(p1, ray)
%     ans =
%       logical
%        0
%     % test for a point on the supporting line but "before" the origin
%     p2 = [7 16];
%     isPointOnRay(p1, ray)
%     ans =
%       logical
%        0
%
%   See also
%   rays2d, points2d, isPointOnLine, isPointOnEdge
%

% ------
% Author: David Legland
% E-mail: david.legland@inrae.fr
% Created: 2003-10-31
% Copyright 2003-2022 INRA - TPV URPOI - BIA IMASTE

% extract computation tolerance
tol = 1e-14;
if ~isempty(varargin)
    tol = varargin{1};
end

% number of rays and points
Nr = size(ray, 1);
Np = size(point, 1);

% if several rays or several points, adapt sizes of arrays
x0 = repmat(ray(:,1)', Np, 1);
y0 = repmat(ray(:,2)', Np, 1);
dx = repmat(ray(:,3)', Np, 1);
dy = repmat(ray(:,4)', Np, 1);
xp = repmat(point(:,1), 1, Nr);
yp = repmat(point(:,2), 1, Nr);

% test if points belongs to the supporting line
b1 = abs((xp-x0).*dy - (yp-y0).*dx) ./ (dx.*dx + dy.*dy) < tol;

% check if points lie the good direction on the rays
ind     = abs(dx) > abs(dy);
t       = zeros(size(b1));
t(ind)  = (xp(ind) - x0(ind)) ./ dx(ind);
t(~ind) = (yp(~ind) - y0(~ind)) ./ dy(~ind);

% combine the two tests
b = b1 & (t >= 0);


function t = bal_seq_unrank ( rank, n )

%*****************************************************************************80
%
%% BAL_SEQ_UNRANK unranks a balanced sequence.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 January 2011
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Donald Kreher, Douglas Simpson,
%    Combinatorial Algorithms,
%    CRC Press, 1998,
%    ISBN: 0-8493-3988-X,
%    LC: QA164.K73.
%
%  Parameters:
%
%    Input, integer RANK, the rank of the balanced sequence.
%
%    Input, integer N, the number of 0's (and 1's) in the sequence.
%    N must be positive.
%
%    Output, integer T(2*N), a balanced sequence.
%

%
%  Check.
%
  if ( n < 1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'BAL_SEQ_UNRANK - Fatal error!\n' );
    fprintf ( 1, '  Input N is illegal.\n' );
    error ( 'BAL_SEQ_UNRANK - Fatal error!' );
  end

  nseq = bal_seq_enum ( n );

  if ( rank < 0 || nseq < rank )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'BAL_SEQ_UNRANK - Fatal error!\n' );
    fprintf ( 1, '  The input rank is illegal.\n' );
    error ( 'BAL_SEQ_UNRANK - Fatal error!' );
  end

  y = 0;
  low = 0;

  for x = 1 : 2 * n

    m = mountain ( n, x, y + 1 );

    if ( rank <= low + m - 1 )
      y = y + 1;
      t(x) = 0;
    else
      low = low + m;
      y = y - 1;
      t(x) = 1;
    end

  end

  return
end


function btv_test09 ( )

%*****************************************************************************80
%
%% BTV_TEST09 tests BURGERS_TIME_VISCOUS with the spike initial condition.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    23 April 2012
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'BTV_TEST09\n' );
  fprintf ( 1, '  Test BURGERS_TIME_VISCOUS with the spike initial condition.\n' );

  nx = 81;
  nt = 400;
  t_max = 4.0;
  nu = 0.01;
  bc = 4;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Initial condition: spike\n' );
  fprintf ( 1, '  Number of space nodes = %d\n', nx );
  fprintf ( 1, '  Number of time steps = %d\n', nt );
  fprintf ( 1, '  Final time T_MAX = %g\n', t_max );
  fprintf ( 1, '  Viscosity = %g\n', nu );
  fprintf ( 1, '  Boundary condition = %d\n', bc );

  U = burgers_time_viscous ( @ic_spike, nx, nt, t_max, nu, bc );

  x = linspace ( -1.0, +1.0, nx );

  figure ( 9 )

  plot ( x, U(1:50:(nt+1),:), 'Linewidth', 3 )
  grid on
  xlabel ( '<-- X -->' )
  ylabel ( '<-- U(X,T) -->' )
  title ( 'Burgers equation solutions over time, initial condition spike' )

  filename = 'btv_test09.png';
  print ( '-dpng', filename )
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Saved plot as "%s"\n', filename );

  return
end


function [Du,area,Dlambda] = gradu(node,elem,u,Dlambda)
%% GRADU gradient of a finite element function.
%
% Du = GRADU(node,elem,u) compute the gradient of a finite element function
% u on a mesh representing by (node,elem).
%
% [Du,area,Dlambda] = GRADU(node,elem,u) also outputs area and Dlambda
% which is the gradient of P1 basis.
%
% Du = GRADU(node,elem,u,Dlambda) compute the gradient with Dlambda. It
% will save time when Dlambda is available. See recovery.m
%
% See also gradu3, gradbasis
%
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

if ~exist('Dlambda','var')
    [Dlambda,area] = gradbasis(node,elem);
end
dudx =  u(elem(:,1)).*Dlambda(:,1,1) + u(elem(:,2)).*Dlambda(:,1,2) ...
      + u(elem(:,3)).*Dlambda(:,1,3);
dudy =  u(elem(:,1)).*Dlambda(:,2,1) + u(elem(:,2)).*Dlambda(:,2,2) ...
      + u(elem(:,3)).*Dlambda(:,2,3);
Du = [dudx, dudy];


function [p P_u P_pol] = omni_retro(u, pol)
%
% OMNI_RETRO  Retroproject pixel into 3D space.
%   P = OMNI_RETRO(UP, pol) retro-projects the point UP of the image
%   plane into the point P at depth S in 3D space
%
%   based on M=cam2world(m, ocam_model) from DAVIDE SCARAMUZZA
%   "Omnidirectional camera calibration toolbox" CAM2WORLD Project a give
%   pixel point onto the unit sphere M=CAM2WORLD=(m, ocam_model) returns
%   the 3D coordinates of the vector emanating from the single effective
%   viewpoint on the unit sphere
%
%
% Notes
% - pol: polynom coeff (vec)  -> "distortion" parametes in a0..an order, not polyval() order
%                                 we have 4th order polynome
%
%   Author: Davide Scaramuzza - email: davide.scaramuzza@ieee.org
%   Author: Grigory Abuladze - email: ryhor.a@google.com

%   Copyright (C) 2012 Grigory Abuladze @ ASL-vision.
%   Copyright (C) 2008 DAVIDE SCARAMUZZA, ETH Zurich

  if nargout == 1  % only points
    % Given an image point it returns the 3D coordinates of its correspondent optical ray
    r = (u(1,:).^2 + u(2,:).^2).^0.5;
    p = [u(1,:);
         u(2,:);
         polyval(pol(end:-1:1), r)];
    p = normc(p); % normalizes coordinates so that they have unit length (projection onto the unit sphere)

  else %  nargout > 2  ->  Jacobians

    if size(u,2) > 1
      error('Jacobians not available for multiple points');
    end

    r   = (u(1)^2 + u(2)^2)^0.5;
    n   = numel(pol);
    nn  = 0:n-1;     % orders vector
    r2n = r.^nn;     % powers vector
    p3  = r2n*pol;   %
    p   = [u(1);
           u(2);
           p3];

    [p,P_p] = normvec(p,1);

    a0 = pol(1); a1 = pol(2); a2 = pol(3); a3 = pol(4); a4 = pol(5);
    u1 = u(1);
    u2 = u(2);
    r2 = (u1^2 + u2^2);
    r  = r2^(1/2);

    % all before normalization
    P_u = [...
            [                                            1,                                            0]
            [                                            0,                                            1]
            [ 2*a2*u1 + 4*a4*u1*r2 + (a1*u1)/r + 3*a3*u1*r, 2*a2*u2 + 4*a4*u2*r2 + (a1*u2)/r + 3*a3*u2*r]
          ];

    P_pol = [...
              [ 0, 0,  0,        0,    0]
              [ 0, 0,  0,        0,    0]
              [ 1, r, r2, r2^(3/2), r2^2]
            ];

    % add normalization
    % f = norm(g()) -> use chain rule
    P_u = P_p * P_u;

  end

return

%% Jacobian
syms a0 a1 a2 a3 a4 real
syms u1 u2 s real

u   = [u1 u2]';
pol = [a0 a1 a2 a3 a4]';

p     = omni_retro(u, s, pol);

P_u   = simplify(jacobian(p,u))
P_s   = simplify(jacobian(p,s))
P_pol = simplify(jacobian(p,pol))

% ========== End of function - Start GPL license ==========

%   # START GPL LICENSE

%---------------------------------------------------------------------
%
%   This file is part of SLAMTB, a SLAM toolbox for Matlab.
%
%   SLAMTB 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.
%
%   SLAMTB 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 SLAMTB.  If not, see <http://www.gnu.org/licenses/>.
%
%---------------------------------------------------------------------

%   SLAMTB is Copyright:
%   Copyright (c) 2008-2010, Joan Sola @ LAAS-CNRS,
%   Copyright (c) 2010-2013, Joan Sola,
%   Copyright (c) 2014-2015, Joan Sola @ IRI-UPC-CSIC,
%   SLAMTB is Copyright 2009
%   by Joan Sola, Teresa Vidal-Calleja, David Marquez and Jean Marie Codol
%   @ LAAS-CNRS.
%   See on top of this file for its particular copyright.

%   # END GPL LICENSE


%ZSSD Sum of squared differences
%
% M = ZSSD(I1, I2) is the zero-mean sum of squared differences between the
% two equally sized image patches I1 and I2.  The result M is a scalar that
% indicates image similarity, a value of 0 indicates identical pixel patterns
% and is increasingly positive as image dissimilarity increases.
%
% Notes::
% - The ZSSD similarity measure is invariant to changes in image brightness
%   offset.
%
% See also SDD, SAD, NCC, ISIMILARITY.

% Copyright (C) 1993-2011, by Peter I. Corke
%
% This file is part of The Machine Vision Toolbox for Matlab (MVTB).
%
% MVTB 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.
%
% MVTB 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 MVTB.  If not, see <http://www.gnu.org/licenses/>.

function m = zssd(w1, w2)

	w1 = w1 - mean(w1(:));
	w2 = w2 - mean(w2(:));

	m = (w1-w2).^2;
    m = sum(m(:));


function c=ref_dft(f)
%REF_DFT  Reference Discrete Fourier Transform
%   Usage:  c=ref_dft(f);
%
%   REF_DFT(f) computes the unitary discrete Fourier transform of f.
%
%   AUTHOR: Jordy van Velthoven

L=size(f,1);
W=size(f,2);
c= zeros(L,W);

for w=1:W
for k=0:L-1
  for l=0:L-1
    c(k+1,w) = c(k+1,w) + f(l+1,w) * exp(-2*pi*i*k*l/L);
  end;
end;
end

c = c./sqrt(L);


function result = cone_unit_3d ( func )

%*****************************************************************************80
%
%% CONE_UNIT_3D approximates an integral inside a unit cone in 3D.
%
%  Integration Region:
%
%    X**2 + Y**2 <= 1 - Z
%    0 <= Z <= 1.
%
%  Discussion:
%
%    An 48 point degree 7 formula, Stroud CN:S2:7-1, is used.
%
%    (There is a typographical error in the S2:7-1 formula for B3.)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 May 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Arthur Stroud,
%    Approximate Calculation of Multiple Integrals,
%    Prentice Hall, 1971, page 339.
%
%  Parameters:
%
%    Input, external FUNC, the name of the user supplied function which
%    evaluates F(X,Y,Z), of the form
%      function value = func ( x, y, z )
%
%    Output, real RESULT, the approximate integral of the function.
%
  u = [ 0.04850054945E+00, 0.2386007376E+00, 0.5170472951E+00,  0.7958514179E+00 ];
  w1 = [ 0.1108884156E+00,  0.1434587878E+00, 0.06863388717E+00, 0.01035224075E+00 ];

  a = sqrt ( 3.0E+00 ) / 2.0E+00;
  b = sqrt ( ( 27.0E+00 - 3.0E+00 * sqrt ( 29.0E+00 ) ) / 104.0E+00 );
  c = sqrt ( ( 27.0E+00 + 3.0E+00 * sqrt ( 29.0E+00 ) ) / 104.0E+00 );
  w2(1:3) = 3.0E+00 * [ ...
    2.0E+00 / 27.0E+00, ...
    ( 551.0E+00 + 4.0E+00 * sqrt ( 29.0E+00 ) ) / 6264.0E+00, ...
    ( 551.0E+00 - 4.0E+00 * sqrt ( 29.0E+00 ) ) / 6264.0E+00 ];

  quad = 0.0E+00;

  for i = 1 : 4

    x = a * ( 1.0E+00 - u(i) );
    y = 0.0E+00;
    z = u(i);
    quad = quad + w1(i) * w2(1) * feval ( func, x, y, z );

    x = - a * ( 1.0E+00 - u(i) );
    y = 0.0E+00;
    z = u(i);
    quad = quad + w1(i) * w2(1) * feval ( func, x, y, z );

    x = 0.0E+00;
    y = a * ( 1.0E+00 - u(i) );
    z = u(i);
    quad = quad + w1(i) * w2(1) * feval ( func, x, y, z );

    x = 0.0E+00;
    y = - a * ( 1.0E+00 - u(i) );
    z = u(i);
    quad = quad + w1(i) * w2(1) * feval ( func, x, y, z );

  end

  for i = 1 : 4

    x =   b * ( 1.0E+00 - u(i) );
    y =   b * ( 1.0E+00 - u(i) );
    z =   u(i);
    quad = quad + w1(i) * w2(2) * feval ( func, x, y, z );

    x = - b * ( 1.0E+00 - u(i) );
    y =   b * ( 1.0E+00 - u(i) );
    z =   u(i);
    quad = quad + w1(i) * w2(2) * feval ( func, x, y, z );

    x = - b * ( 1.0E+00 - u(i) );
    y = - b * ( 1.0E+00 - u(i) );
    z =   u(i);
    quad = quad + w1(i) * w2(2) * feval ( func, x, y, z );

    x =   b * ( 1.0E+00 - u(i) );
    y = - b * ( 1.0E+00 - u(i) );
    z =   u(i);
    quad = quad + w1(i) * w2(2) * feval ( func, x, y, z );

    x =   c * ( 1.0E+00 - u(i) );
    y =   c * ( 1.0E+00 - u(i) );
    z =   u(i);
    quad = quad + w1(i) * w2(3) * feval ( func, x, y, z );

    x = - c * ( 1.0E+00 - u(i) );
    y =   c * ( 1.0E+00 - u(i) );
    z =   u(i);
    quad = quad + w1(i) * w2(3) * feval ( func, x, y, z );

    x = - c * ( 1.0E+00 - u(i) );
    y = - c * ( 1.0E+00 - u(i) );
    z =   u(i);
    quad = quad + w1(i) * w2(3) * feval ( func, x, y, z );

    x =   c * ( 1.0E+00 - u(i) );
    y = - c * ( 1.0E+00 - u(i) );
    z =   u(i);
    quad = quad + w1(i) * w2(3) * feval ( func, x, y, z );

  end

  r = 1.0E+00;
  h = 1.0E+00;

  volume = cone_volume_3d ( r, h );
  result = quad * volume;

  return
end


function PoiseuilleFlow( varargin )
%POISOILLEFLOW Summary of this function goes here
%   Detailed explanation goes here
close all; % closes all figures
addpath('../Functions');

h=4; % height of the channel
dPdx=-0.01; % pressure gradient in x direction
mu=0.001; % dynamic viscosity

% function for the analytical solution
u_analFunc=@(y) -0.5*h^2/mu*dPdx*(1-(y/h).^2);

% create mesh
m=createMesh2D(20,20,2*h,2*h);

%% Boundary Conditions
U_BC = createBC(m); % all Neumann boundary condition structure

% Assign boundary conditions
U_BC.left.a(:) = 1; U_BC.left.b(:)=0; U_BC.left.c(:)=0; % Dirichlet for the left boundary
U_BC.right.a(:) = 1; U_BC.right.b(:)=0; U_BC.right.c(:)=0; % Dirichlet for the left boundary
U_BC.top.a(:) = 0; U_BC.top.b(:)=1; U_BC.top.c(:)=0; % Dirichlet for the left boundary
U_BC.bottom.a(:) = 0; U_BC.bottom.b(:)=1; U_BC.bottom.c(:)=0; % Dirichlet for the left boundary

V_BC = createBC(m); % all Neumann boundary condition structure

% Assign boundary conditions
V_BC.top.a(:) = 0; V_BC.top.b(:)=1; V_BC.top.c(:)=0; % Dirichlet for the left boundary
V_BC.bottom.a(:) = 0; V_BC.bottom.b(:)=1; V_BC.bottom.c(:)=0; % Dirichlet for the left boundary
V_BC.left.a(:) = 0; V_BC.left.b(:)=1; V_BC.left.c(:)=0; % Dirichlet for the left boundary
V_BC.right.a(:) = 0; V_BC.right.b(:)=1; V_BC.right.c(:)=0; % Dirichlet for the left boundary

BC_pressureCorrection = createBC(m);
BC_pressureCorrection.left.a(:) = 1; BC_pressureCorrection.left.b(:)=0; BC_pressureCorrection.left.c(:)=0;
BC_pressureCorrection.right.a(:) = 1; BC_pressureCorrection.right.b(:)=0; BC_pressureCorrection.right.c(:)=0;
BC_pressureCorrection.bottom.a(:) = 1; BC_pressureCorrection.bottom.b(:)=0; BC_pressureCorrection.bottom.c(:)=0;
BC_pressureCorrection.bottom.a(end/2) = 0; BC_pressureCorrection.bottom.b(end/2)=1; BC_pressureCorrection.bottom.c(end/2)=1;
BC_pressureCorrection.top.a(:) = 1; BC_pressureCorrection.top.b(:)=0; BC_pressureCorrection.top.c(:)=0;

% constant pressure - so there is no gradient
p_cellVar=createCellVariable(m,1,BC_pressureCorrection);

mu_cellVar=createCellVariable(m,0.001);
mu_faceVar=createFaceVariable(m,0.001);

rho=1000;
rho_cellVar=createCellVariable(m,rho);
rho_faceVar=createFaceVariable(m,rho);

U_cellVar=createCellVariable(m,0,U_BC);
V_cellVar=createCellVariable(m,0,V_BC);
faceVelocity=createFaceVariable(m,[0 0]);

pGradMat = gradientCellTerm(p_cellVar);
helpVarx = createCellVariable(m,dPdx);
helpVary = createCellVariable(m,0);
pGradMat.xvalue=helpVarx.value(2:end-1,2:end-1);
pGradMat.yvalue=helpVary.value(2:end-1,2:end-1);

% solve momentum equation Momentum equation
[U_cellVar,~,~,~]=MomentumEq(1,m,pGradMat,mu_faceVar,faceVelocity,U_cellVar,V_cellVar,U_BC,V_BC,rho,'SIMPLE');

y_anal=linspace(0,h,100);
u_anal=u_analFunc(y_anal);

figure;
plot(u_anal,y_anal); % plot analytical solution
hold on;
plot(U_cellVar.value(3,2:end-1),U_cellVar.domain.cellcenters.y-h,'o');
hold off;
figure;
visualizeCells(U_cellVar);

end


function stats = grayrlprops(varargin)

%GRAYCOPROPS Properties of gray-level run-length matrix.
%  -------------------------------------------
%  STATS = GRAYCOPROPS(GLRLM,PROPERTIES) Each element in  GLRLM, (r,c),
%   is the probability occurrence of pixel having gray level values r, run-length c in the image.
%   GRAYCOPROPS is to calculate PROPERTIES.
%  -------------------------------------------
%  Requirements:
%  -------------------------------------------
%   GLRLM mustbe an cell array of valid gray-level run-length
%   matrices.Recall that a valid glrlm must be logical or numerical.
%  -------------------------------------------
%  Current supported statistics include:
%  -------------------------------------------
%   Short Run Emphasis (SRE)
%   Long Run Emphasis (LRE)
%   Gray-Level Nonuniformity (GLN)
%   Run Length Nonuniformity (RLN)
%   Run Percentage (RP)
%   Low Gray-Level Run Emphasis (LGRE)
%   High Gray-Level Run Emphasis (HGRE)
%   Short Run Low Gray-Level Emphasis (SRLGE)
%   Short Run High Gray-Level Emphasis (SRHGE)
%   Long Run Low Gray-Level Emphasis (LRLGE)
%   Long Run High Gray-Level Emphasis (LRHGE)
%  --------------------------------------------
%  Reference:
%  --------------------------------------------
%   Xiaoou Tang,Texture Information in Run-Length Matrices
%   IEEE TRANSACTIONS ON IMAGE PROCESSING, VOL.7, NO.11,NOVEMBER 1998
% ---------------------------------------------
%  See also GRAYRLMATRIX.
% ---------------------------------------------
% Author:
% ---------------------------------------------
%    (C)Xunkai Wei <xunkai.wei@gmail.com>
%    Beijing Aeronautical Technology Research Center
%    Beijing %9203-12,10076
% ---------------------------------------------
% History:
% ---------------------------------------------
% Creation: beta         Date: 01/10/2007
% Revision: 1.0          Date: 12/11/2007
% 1.Accept cell input now
% 2.Using MATLAB file style
% 3.Fully vectorized programming
% 4.Fully support the IEEE reference
% 5. ...

% Check GLRLM
[GLRLM numGLRLM] = ParseInputs(varargin{:});

% Initialize output stats structure.
% 11 statistics for each GLRLM
numStats = 11;

% % count number of GLRLM
% numGLRLM = length(GLRLM);

% Initialization default 4*11 matrix
stats = zeros(numGLRLM,numStats);

for p = 1 : numGLRLM
    %N-D indexing not allowed for sparse.

    if numGLRLM ~= 1
        % transfer to double matrix
        tGLRLM = GLRLM{p};
    else
        tGLRLM = GLRLM;
    end
    %     if numGLRLM ~= 1
    %         % transfer to double matrix
    %         tGLRLM = normalizeGLRL(GLRLM{p});
    %     else
    %         tGLRLM = normalizeGLRL(GLRLM);
    %     end
    % Get row and column subscripts of GLRLM.  These subscripts correspond to the
    % pixel values in the GLRLM.
    s = size(tGLRLM);
    % colum indicator
    c_vector =1:s(1);
    % row indicator
    r_vector =1:s(2);
    % matrix element indicator
    % Matrix form col and row: using meshgrid, you should transpose before using
    % i.e. if tGLRLM is m*n, then this function return c_matrix n*m,
    % r_matrix n*m.
    [c_matrix,r_matrix] = meshgrid(c_vector,r_vector);

    % Total number of runs
    N_runs = sum(sum(tGLRLM));

    % total number of elements
    N_tGLRLM = s(1)*s(2);

    %--------------------Prepare four matrix for speedup--------------
    % 1.Gray Level Run-Length Pixel Number Matrix
    %     p_p = calculate_p_p(tGLRLM,c_matrix');

    % 2.Gray-Level Run-Number Vector
    %   This vector represents the sum distribution of the number of runs
    %   with gray level i.
    p_g = sum(tGLRLM);

    % 3.Run-Length Run-Number Vector
    %   This vector represents the sum distribution of the number of runs
    %   with run length j.
    p_r = sum(tGLRLM,2)';

    % 4.Gray-Level Run-Length-One Vector
    %
    % p_o = tGLRLM(:,1); % Not used yet
    % ----------------------End four matrix---------------------------
    %
    %------------------------Statistics-------------------------------
    % 1. Short Run Emphasis (SRE)
    SRE = sum(p_r./(c_vector.^2))/N_runs;
    % 2. Long Run Emphasis (LRE)
    LRE = sum(p_r.*(c_vector.^2))/N_runs;
    % 3. Gray-Level Nonuniformity (GLN)
    GLN = sum(p_g.^2)/N_runs;
    % 4. Run Length Nonuniformity (RLN)
    RLN = sum(p_r.^2)/N_runs;
    % 5. Run Percentage (RP)
    RP = N_runs/N_tGLRLM;
    % 6. Low Gray-Level Run Emphasis (LGRE)
    LGRE = sum(p_g./(r_vector.^2))/N_runs;
    % 7. High Gray-Level Run Emphasis (HGRE)
    HGRE = sum(p_g.*r_vector.^2)/N_runs;
    % 8. Short Run Low Gray-Level Emphasis (SRLGE)
    SGLGE =calculate_SGLGE(tGLRLM,r_matrix',c_matrix',N_runs);
    % 9. Short Run High Gray-Level Emphasis (SRHGE)
    SRHGE =calculate_SRHGE(tGLRLM,r_matrix',c_matrix',N_runs);
    % 10. Long Run Low Gray-Level Emphasis (LRLGE)
    LRLGE =calculate_LRLGE(tGLRLM,r_matrix',c_matrix',N_runs);
    % 11.Long Run High Gray-Level Emphasis (LRHGE
    LRHGE =calculate_LRHGE(tGLRLM,r_matrix',c_matrix',N_runs);
    %----------------insert statistics----------------------------
    stats(p,:)=[SRE LRE GLN RLN  RP LGRE HGRE SGLGE SRHGE LRLGE  LRHGE ];
end % end all run length matrixs

%   ----------------------Utility functions--------------------
%-----------------------------------------------------------------------------
% function glrl = normalizeGLRL(glrl)
%
% % Normalize glcm so that sum(glcm(:)) is one.
% if any(glrl(:))
%   glrl = glrl ./ sum(glrl(:));
% end
% function p_p = calculate_p_p(GLRLM,c) % Note: currently not used
%
% % p_p(i; j) = GLRLM(i,j)*j
% % Each element of the matrix represents the number of pixels of run length
% % j and gray-level i. Compared to the original matrix, the new matrix gives
% % equal emphasis to all length of runs in an image.
%
% term1 =  c; % j index in matrix size
% term2 = GLRLM;
% p_p = term1 .* term2;
%---------------------------------
function SGLGE =calculate_SGLGE(tGLRLM,r_matrix,c_matrix,N_runs)
% Short Run Low Gray-Level Emphasis (SRLGE):

term = tGLRLM./((r_matrix.*c_matrix).^2);
SGLGE= sum(sum(term))./N_runs;

%------------------------------------
function  SRHGE =calculate_SRHGE(tGLRLM,r_matrix,c_matrix,N_runs)
% Short Run High Gray-Level Emphasis (SRHGE):
%
term  = tGLRLM.*(r_matrix.^2)./(c_matrix.^2);
SRHGE = sum(sum(term))/N_runs;
%------------------------------------
function   LRLGE =calculate_LRLGE(tGLRLM,r_matrix,c_matrix,N_runs)
% Long Run Low Gray-Level Emphasis (LRLGE):
%
term  = tGLRLM.*(c_matrix.^2)./(r_matrix.^2);
LRLGE = sum(sum(term))/N_runs;
%---------------------------------------
function  LRHGE =calculate_LRHGE(tGLRLM,r_matrix,c_matrix,N_runs)
% Long Run High Gray-Level Emphasis (LRHGE):
%
term  = tGLRLM.*(c_matrix.^2).*(r_matrix.^2);
LRHGE = sum(sum(term))/N_runs;
%----------------------------------------

%-----------------------------------------------------------------------------
function [glrlm num_glrlm] = ParseInputs(varargin)
% check stability of inputs
%
% first receive all inputs
glrlm = varargin{:};
% get numbers total
num_glrlm=length(glrlm);
% then for each element, check its stability
for i=1:num_glrlm
    % The 'nonnan' and 'finite' attributes are not added to iptcheckinput because the
    % 'integer' attribute takes care of these requirements.
    % iptcheckinput(glrlm,{'cell'},{'real','nonnegative','integer'}, ...
    % mfilename,'GLRLM',1);
    iptcheckinput(glrlm{i},{'logical','numeric'},{'real','nonnegative','integer'},...
        mfilename,'GLRLM',1);
    % Cast GLRLM to double to avoid truncation by data type. Note that GLRLM is not an
    % image.
    if ~isa(glrlm,'double')
        glrlm{i}= double(glrlm{i});
    end
end