function [der,errest,finaldelta] = derivest(fun,x0,varargin)
% DERIVEST: estimate the n'th derivative of fun at x0, provide an error estimate
% usage: [der,errest] = DERIVEST(fun,x0)  % first derivative
% usage: [der,errest] = DERIVEST(fun,x0,prop1,val1,prop2,val2,...)
%
% Derivest will perform numerical differentiation of an
% analytical function provided in fun. It will not
% differentiate a function provided as data. Use gradient
% for that purpose, or differentiate a spline model.
%
% The methods used by DERIVEST are finite difference
% approximations of various orders, coupled with a generalized
% (multiple term) Romberg extrapolation. This also yields
% the error estimate provided. DERIVEST uses a semi-adaptive
% scheme to provide the best estimate that it can by its
% automatic choice of a differencing interval.
%
% Finally, While I have not written this function for the
% absolute maximum speed, speed was a major consideration
% in the algorithmic design. Maximum accuracy was my main goal.
%
%
% Arguments (input)
%  fun - function to differentiate. May be an inline function,
%        anonymous, or an m-file. fun will be sampled at a set
%        of distinct points for each element of x0. If there are
%        additional parameters to be passed into fun, then use of
%        an anonymous function is recommended.
%
%        fun should be vectorized to allow evaluation at multiple
%        locations at once. This will provide the best possible
%        speed. IF fun is not so vectorized, then you MUST set
%        'vectorized' property to 'no', so that derivest will
%        then call your function sequentially instead.
%
%        Fun is assumed to return a result of the same
%        shape as its input x0.
%
%  x0  - scalar, vector, or array of points at which to
%        differentiate fun.
%
% Additional inputs must be in the form of property/value pairs.
%  Properties are character strings. They may be shortened
%  to the extent that they are unambiguous. Properties are
%  not case sensitive. Valid property names are:
%
%  'DerivativeOrder', 'MethodOrder', 'Style', 'RombergTerms'
%  'FixedStep', 'MaxStep'
%
%  All properties have default values, chosen as intelligently
%  as I could manage. Values that are character strings may
%  also be unambiguously shortened. The legal values for each
%  property are:
%
%  'DerivativeOrder' - specifies the derivative order estimated.
%        Must be a positive integer from the set [1,2,3,4].
%
%        DEFAULT: 1 (first derivative of fun)
%
%  'MethodOrder' - specifies the order of the basic method
%        used for the estimation.
%
%        For 'central' methods, must be a positive integer
%        from the set [2,4].
%
%        For 'forward' or 'backward' difference methods,
%        must be a positive integer from the set [1,2,3,4].
%
%        DEFAULT: 4 (a second order method)
%
%        Note: higher order methods will generally be more
%        accurate, but may also suffere more from numerical
%        problems.
%
%        Note: First order methods would usually not be
%        recommended.
%
%  'Style' - specifies the style of the basic method
%        used for the estimation. 'central', 'forward',
%        or 'backwards' difference methods are used.
%
%        Must be one of 'Central', 'forward', 'backward'.
%
%        DEFAULT: 'Central'
%
%        Note: Central difference methods are usually the
%        most accurate, but sometiems one must not allow
%        evaluation in one direction or the other.
%
%  'RombergTerms' - Allows the user to specify the generalized
%        Romberg extrapolation method used, or turn it off
%        completely.
%
%        Must be a positive integer from the set [0,1,2,3].
%
%        DEFAULT: 2 (Two Romberg terms)
%
%        Note: 0 disables the Romberg step completely.
%
%  'FixedStep' - Allows the specification of a fixed step
%        size, preventing the adaptive logic from working.
%        This will be considerably faster, but not necessarily
%        as accurate as allowing the adaptive logic to run.
%
%        DEFAULT: []
%
%        Note: If specified, 'FixedStep' will define the
%        maximum excursion from x0 that will be used.
%
%  'Vectorized' - Derivest will normally assume that your
%        function can be safely evaluated at multiple locations
%        in a single call. This would minimize the overhead of
%        a loop and additional function call overhead. Some
%        functions are not easily vectorizable, but you may
%        (if your matlab release is new enough) be able to use
%        arrayfun to accomplish the vectorization.
%
%        When all else fails, set the 'vectorized' property
%        to 'no'. This will cause derivest to loop over the
%        successive function calls.
%
%        DEFAULT: 'yes'
%
%
%  'MaxStep' - Specifies the maximum excursion from x0 that
%        will be allowed, as a multiple of x0.
%
%        DEFAULT: 100
%
%  'StepRatio' - Derivest uses a proportionally cascaded
%        series of function evaluations, moving away from your
%        point of evaluation. The StepRatio is the ratio used
%        between sequential steps.
%
%        DEFAULT: 2.0000001
%
%        Note: use of a non-integer stepratio is intentional,
%        to avoid integer multiples of the period of a periodic
%        function under some circumstances.
%
%
% See the document DERIVEST.pdf for more explanation of the
% algorithms behind the parameters of DERIVEST. In most cases,
% I have chosen good values for these parameters, so the user
% should never need to specify anything other than possibly
% the DerivativeOrder. I've also tried to make my code robust
% enough that it will not need much. But complete flexibility
% is in there for your use.
%
%
% Arguments: (output)
%  der - derivative estimate for each element of x0
%        der will have the same shape as x0.
%
%  errest - 95% uncertainty estimate of the derivative, such that
%
%        abs(der(j) - f'(x0(j))) < erest(j)
%
%  finaldelta - The final overall stepsize chosen by DERIVEST
%
%
% Example usage:
%  First derivative of exp(x), at x == 1
%   [d,e]=derivest(@(x) exp(x),1)
%   d =
%       2.71828182845904
%
%   e =
%       1.02015503167879e-14
%
%  True derivative
%   exp(1)
%   ans =
%       2.71828182845905
%
% Example usage:
%  Third derivative of x.^3+x.^4, at x = [0,1]
%   derivest(@(x) x.^3 + x.^4,[0 1],'deriv',3)
%   ans =
%       6       30
%
%  True derivatives: [6,30]
%
%
% See also: gradient
%
%
% Author: John D'Errico
% e-mail: woodchips@rochester.rr.com
% Release: 1.0
% Release date: 12/27/2006

par.DerivativeOrder = 1;
par.MethodOrder = 4;
par.Style = 'central';
par.RombergTerms = 2;
par.FixedStep = [];
par.MaxStep = 100;
% setting a default stepratio as a non-integer prevents
% integer multiples of the initial point from being used.
% In turn that avoids some problems for periodic functions.
par.StepRatio = 2.0000001;
par.NominalStep = [];
par.Vectorized = 'yes';

na = length(varargin);
if (rem(na,2)==1)
  error 'Property/value pairs must come as PAIRS of arguments.'
elseif na>0
  par = parse_pv_pairs(par,varargin);
end
par = check_params(par);

% Was fun a string, or an inline/anonymous function?
if (nargin<1)
  help derivest
  return
elseif isempty(fun)
  error 'fun was not supplied.'
elseif ischar(fun)
  % a character function name
  fun = str2func(fun);
end

% no default for x0
if (nargin<2) || isempty(x0)
  error 'x0 was not supplied'
end
par.NominalStep = max(x0,0.02);

% was a single point supplied?
nx0 = size(x0);
n = prod(nx0);

% Set the steps to use.
if isempty(par.FixedStep)
  % Basic sequence of steps, relative to a stepsize of 1.
  delta = par.MaxStep*par.StepRatio .^(0:-1:-25)';
  ndel = length(delta);
else
  % Fixed, user supplied absolute sequence of steps.
  ndel = 3 + ceil(par.DerivativeOrder/2) + ...
     par.MethodOrder + par.RombergTerms;
  if par.Style(1) == 'c'
    ndel = ndel - 2;
  end
  delta = par.FixedStep*par.StepRatio .^(-(0:(ndel-1)))';
end

% generate finite differencing rule in advance.
% The rule is for a nominal unit step size, and will
% be scaled later to reflect the local step size.
fdarule = 1;
switch par.Style
  case 'central'
    % for central rules, we will reduce the load by an
    % even or odd transformation as appropriate.
    if par.MethodOrder==2
      switch par.DerivativeOrder
        case 1
          % the odd transformation did all the work
          fdarule = 1;
        case 2
          % the even transformation did all the work
          fdarule = 2;
        case 3
          % the odd transformation did most of the work, but
          % we need to kill off the linear term
          fdarule = [0 1]/fdamat(par.StepRatio,1,2);
        case 4
          % the even transformation did most of the work, but
          % we need to kill off the quadratic term
          fdarule = [0 1]/fdamat(par.StepRatio,2,2);
      end
    else
      % a 4th order method. We've already ruled out the 1st
      % order methods since these are central rules.
      switch par.DerivativeOrder
        case 1
          % the odd transformation did most of the work, but
          % we need to kill off the cubic term
          fdarule = [1 0]/fdamat(par.StepRatio,1,2);
        case 2
          % the even transformation did most of the work, but
          % we need to kill off the quartic term
          fdarule = [1 0]/fdamat(par.StepRatio,2,2);
        case 3
          % the odd transformation did much of the work, but
          % we need to kill off the linear & quintic terms
          fdarule = [0 1 0]/fdamat(par.StepRatio,1,3);
        case 4
          % the even transformation did much of the work, but
          % we need to kill off the quadratic and 6th order terms
          fdarule = [0 1 0]/fdamat(par.StepRatio,2,3);
      end
    end
  case {'forward' 'backward'}
    % These two cases are identical, except at the very end,
    % where a sign will be introduced.

    % No odd/even trans, but we already dropped
    % off the constant term
    if par.MethodOrder==1
      if par.DerivativeOrder==1
        % an easy one
        fdarule = 1;
      else
        % 2:4
        v = zeros(1,par.DerivativeOrder);
        v(par.DerivativeOrder) = 1;
        fdarule = v/fdamat(par.StepRatio,0,par.DerivativeOrder);
      end
    else
      % par.MethodOrder methods drop off the lower order terms,
      % plus terms directly above DerivativeOrder
      v = zeros(1,par.DerivativeOrder + par.MethodOrder - 1);
      v(par.DerivativeOrder) = 1;
      fdarule = v/fdamat(par.StepRatio,0,par.DerivativeOrder+par.MethodOrder-1);
    end

    % correct sign for the 'backward' rule
    if par.Style(1) == 'b'
      fdarule = -fdarule;
    end

end % switch on par.style (generating fdarule)
nfda = length(fdarule);

% will we need fun(x0)?
if (rem(par.DerivativeOrder,2) == 0) || ~strncmpi(par.Style,'central',7)
  if strcmpi(par.Vectorized,'yes')
    f_x0 = fun(x0);
  else
    % not vectorized, so loop
    f_x0 = zeros(size(x0));
    for j = 1:numel(x0)
      f_x0(j) = fun(x0(j));
    end
  end
else
  f_x0 = [];
end

% Loop over the elements of x0, reducing it to
% a scalar problem. Sorry, vectorization is not
% complete here, but this IS only a single loop.
der = zeros(nx0);
errest = der;
finaldelta = der;
for i = 1:n
  x0i = x0(i);
  h = par.NominalStep(i);

  % a central, forward or backwards differencing rule?
  % f_del is the set of all the function evaluations we
  % will generate. For a central rule, it will have the
  % even or odd transformation built in.
  if par.Style(1) == 'c'
    % A central rule, so we will need to evaluate
    % symmetrically around x0i.
    if strcmpi(par.Vectorized,'yes')
      f_plusdel = fun(x0i+h*delta);
      f_minusdel = fun(x0i-h*delta);
    else
      % not vectorized, so loop
      f_minusdel = zeros(size(delta));
      f_plusdel = zeros(size(delta));
      for j = 1:numel(delta)
        f_plusdel(j) = fun(x0i+h*delta(j));
        f_minusdel(j) = fun(x0i-h*delta(j));
      end
    end

    if ismember(par.DerivativeOrder,[1 3])
      % odd transformation
      f_del = (f_plusdel - f_minusdel)/2;
    else
      f_del = (f_plusdel + f_minusdel)/2 - f_x0(i);
    end
  elseif par.Style(1) == 'f'
    % forward rule
    % drop off the constant only
    if strcmpi(par.Vectorized,'yes')
      f_del = fun(x0i+h*delta) - f_x0(i);
    else
      % not vectorized, so loop
      f_del = zeros(size(delta));
      for j = 1:numel(delta)
        f_del(j) = fun(x0i+h*delta(j)) - f_x0(i);
      end
    end
  else
    % backward rule
    % drop off the constant only
    if strcmpi(par.Vectorized,'yes')
      f_del = fun(x0i-h*delta) - f_x0(i);
    else
      % not vectorized, so loop
      f_del = zeros(size(delta));
      for j = 1:numel(delta)
        f_del(j) = fun(x0i-h*delta(j)) - f_x0(i);
      end
    end
  end

  % check the size of f_del to ensure it was properly vectorized.
  f_del = f_del(:);
  if length(f_del)~=ndel
    error 'fun did not return the correct size result (fun must be vectorized)'
  end

  % Apply the finite difference rule at each delta, scaling
  % as appropriate for delta and the requested DerivativeOrder.
  % First, decide how many of these estimates we will end up with.
  ne = ndel + 1 - nfda - par.RombergTerms;

  % Form the initial derivative estimates from the chosen
  % finite difference method.
  der_init = vec2mat(f_del,ne,nfda)*fdarule.';

  % scale to reflect the local delta
  der_init = der_init(:)./(h*delta(1:ne)).^par.DerivativeOrder;

  % Each approximation that results is an approximation
  % of order par.DerivativeOrder to the desired derivative.
  % Additional (higher order, even or odd) terms in the
  % Taylor series also remain. Use a generalized (multi-term)
  % Romberg extrapolation to improve these estimates.
  switch par.Style
    case 'central'
      rombexpon = 2*(1:par.RombergTerms) + par.MethodOrder - 2;
    otherwise
      rombexpon = (1:par.RombergTerms) + par.MethodOrder - 1;
  end
  [der_romb,errors] = rombextrap(par.StepRatio,der_init,rombexpon);

  % Choose which result to return

  % first, trim off the
  if isempty(par.FixedStep)
    % trim off the estimates at each end of the scale
    nest = length(der_romb);
    switch par.DerivativeOrder
      case {1 2}
        trim = [1 2 nest-1 nest];
      case 3
        trim = [1:4 nest+(-3:0)];
      case 4
        trim = [1:6 nest+(-5:0)];
    end

    [der_romb,tags] = sort(der_romb);

    der_romb(trim) = [];
    tags(trim) = [];
    errors = errors(tags);
    trimdelta = delta(tags);

    [errest(i),ind] = min(errors);

    finaldelta(i) = h*trimdelta(ind);
    der(i) = der_romb(ind);
  else
    [errest(i),ind] = min(errors);
    finaldelta(i) = h*delta(ind);
    der(i) = der_romb(ind);
  end
end

end % mainline end

% ============================================
% subfunction - romberg extrapolation
% ============================================
function [der_romb,errest] = rombextrap(StepRatio,der_init,rombexpon)
% do romberg extrapolation for each estimate
%
%  StepRatio - Ratio decrease in step
%  der_init - initial derivative estimates
%  rombexpon - higher order terms to cancel using the romberg step
%
%  der_romb - derivative estimates returned
%  errest - error estimates
%  amp - noise amplification factor due to the romberg step

srinv = 1/StepRatio;

% do nothing if no romberg terms
nexpon = length(rombexpon);
rmat = ones(nexpon+2,nexpon+1);
switch nexpon
  case 0
    % rmat is simple: ones(2,1)
  case 1
    % only one romberg term
    rmat(2,2) = srinv^rombexpon;
    rmat(3,2) = srinv^(2*rombexpon);
  case 2
    % two romberg terms
    rmat(2,2:3) = srinv.^rombexpon;
    rmat(3,2:3) = srinv.^(2*rombexpon);
    rmat(4,2:3) = srinv.^(3*rombexpon);
  case 3
    % three romberg terms
    rmat(2,2:4) = srinv.^rombexpon;
    rmat(3,2:4) = srinv.^(2*rombexpon);
    rmat(4,2:4) = srinv.^(3*rombexpon);
    rmat(5,2:4) = srinv.^(4*rombexpon);
end

% qr factorization used for the extrapolation as well
% as the uncertainty estimates
[qromb,rromb] = qr(rmat,0);

% the noise amplification is further amplified by the Romberg step.
% amp = cond(rromb);

% this does the extrapolation to a zero step size.
ne = length(der_init);
rhs = vec2mat(der_init,nexpon+2,max(1,ne - (nexpon+2)));
rombcoefs = rromb\(qromb.'*rhs);
der_romb = rombcoefs(1,:).';

% uncertainty estimate of derivative prediction
s = sqrt(sum((rhs - rmat*rombcoefs).^2,1));
rinv = rromb\eye(nexpon+1);
cov1 = sum(rinv.^2,2); % 1 spare dof
errest = s.'*12.7062047361747*sqrt(cov1(1));

end % rombextrap

% ============================================
% subfunction - vec2mat
% ============================================
function mat = vec2mat(vec,n,m)
% forms the matrix M, such that M(i,j) = vec(i+j-1)
[i,j] = ndgrid(1:n,0:m-1);
ind = i+j;
mat = vec(ind);
if n==1
  mat = mat.';
end

end % vec2mat

% ============================================
% subfunction - fdamat
% ============================================
function mat = fdamat(sr,parity,nterms)
% Compute matrix for fda derivation.
% parity can be
%   0 (one sided, all terms included but zeroth order)
%   1 (only odd terms included)
%   2 (only even terms included)
% nterms - number of terms

% sr is the ratio between successive steps
srinv = 1./sr;

switch parity
  case 0
    % single sided rule
    [i,j] = ndgrid(1:nterms);
    c = 1./factorial(1:nterms);
    mat = c(j).*srinv.^((i-1).*j);
  case 1
    % odd order derivative
    [i,j] = ndgrid(1:nterms);
    c = 1./factorial(1:2:(2*nterms));
    mat = c(j).*srinv.^((i-1).*(2*j-1));
  case 2
    % even order derivative
    [i,j] = ndgrid(1:nterms);
    c = 1./factorial(2:2:(2*nterms));
    mat = c(j).*srinv.^((i-1).*(2*j));
end

end % fdamat

% ============================================
% subfunction - check_params
% ============================================
function par = check_params(par)
% check the parameters for acceptability
%
% Defaults
% par.DerivativeOrder = 1;
% par.MethodOrder = 2;
% par.Style = 'central';
% par.RombergTerms = 2;
% par.FixedStep = [];

% DerivativeOrder == 1 by default
if isempty(par.DerivativeOrder)
  par.DerivativeOrder = 1;
else
  if (length(par.DerivativeOrder)>1) || ~ismember(par.DerivativeOrder,1:4)
    error 'DerivativeOrder must be scalar, one of [1 2 3 4].'
  end
end

% MethodOrder == 2 by default
if isempty(par.MethodOrder)
  par.MethodOrder = 2;
else
  if (length(par.MethodOrder)>1) || ~ismember(par.MethodOrder,[1 2 3 4])
    error 'MethodOrder must be scalar, one of [1 2 3 4].'
  elseif ismember(par.MethodOrder,[1 3]) && (par.Style(1)=='c')
    error 'MethodOrder==1 or 3 is not possible with central difference methods'
  end
end

% style is char
valid = {'central', 'forward', 'backward'};
if isempty(par.Style)
  par.Style = 'central';
elseif ~ischar(par.Style)
  error 'Invalid Style: Must be character'
end
ind = find(strncmpi(par.Style,valid,length(par.Style)));
if (length(ind)==1)
  par.Style = valid{ind};
else
  error(['Invalid Style: ',par.Style])
end

% vectorized is char
valid = {'yes', 'no'};
if isempty(par.Vectorized)
  par.Vectorized = 'yes';
elseif ~ischar(par.Vectorized)
  error 'Invalid Vectorized: Must be character'
end
ind = find(strncmpi(par.Vectorized,valid,length(par.Vectorized)));
if (length(ind)==1)
  par.Vectorized = valid{ind};
else
  error(['Invalid Vectorized: ',par.Vectorized])
end

% RombergTerms == 2 by default
if isempty(par.RombergTerms)
  par.RombergTerms = 2;
else
  if (length(par.RombergTerms)>1) || ~ismember(par.RombergTerms,0:3)
    error 'RombergTerms must be scalar, one of [0 1 2 3].'
  end
end

% FixedStep == [] by default
if (length(par.FixedStep)>1) || (~isempty(par.FixedStep) && (par.FixedStep<=0))
  error 'FixedStep must be empty or a scalar, >0.'
end

% MaxStep == 10 by default
if isempty(par.MaxStep)
  par.MaxStep = 10;
elseif (length(par.MaxStep)>1) || (par.MaxStep<=0)
  error 'MaxStep must be empty or a scalar, >0.'
end

end % check_params

% ============================================
% Included subfunction - parse_pv_pairs
% ============================================
function params=parse_pv_pairs(params,pv_pairs)
% parse_pv_pairs: parses sets of property value pairs, allows defaults
% usage: params=parse_pv_pairs(default_params,pv_pairs)
%
% arguments: (input)
%  default_params - structure, with one field for every potential
%             property/value pair. Each field will contain the default
%             value for that property. If no default is supplied for a
%             given property, then that field must be empty.
%
%  pv_array - cell array of property/value pairs.
%             Case is ignored when comparing properties to the list
%             of field names. Also, any unambiguous shortening of a
%             field/property name is allowed.
%
% arguments: (output)
%  params   - parameter struct that reflects any updated property/value
%             pairs in the pv_array.
%
% Example usage:
% First, set default values for the parameters. Assume we
% have four parameters that we wish to use optionally in
% the function examplefun.
%
%  - 'viscosity', which will have a default value of 1
%  - 'volume', which will default to 1
%  - 'pie' - which will have default value 3.141592653589793
%  - 'description' - a text field, left empty by default
%
% The first argument to examplefun is one which will always be
% supplied.
%
%   function examplefun(dummyarg1,varargin)
%   params.Viscosity = 1;
%   params.Volume = 1;
%   params.Pie = 3.141592653589793
%
%   params.Description = '';
%   params=parse_pv_pairs(params,varargin);
%   params
%
% Use examplefun, overriding the defaults for 'pie', 'viscosity'
% and 'description'. The 'volume' parameter is left at its default.
%
%   examplefun(rand(10),'vis',10,'pie',3,'Description','Hello world')
%
% params =
%     Viscosity: 10
%        Volume: 1
%           Pie: 3
%   Description: 'Hello world'
%
% Note that capitalization was ignored, and the property 'viscosity'
% was truncated as supplied. Also note that the order the pairs were
% supplied was arbitrary.

npv = length(pv_pairs);
n = npv/2;

if n~=floor(n)
  error 'Property/value pairs must come in PAIRS.'
end
if n<=0
  % just return the defaults
  return
end

if ~isstruct(params)
  error 'No structure for defaults was supplied'
end

% there was at least one pv pair. process any supplied
propnames = fieldnames(params);
lpropnames = lower(propnames);
for i=1:n
  p_i = lower(pv_pairs{2*i-1});
  v_i = pv_pairs{2*i};

  ind = strmatch(p_i,lpropnames,'exact');
  if isempty(ind)
    ind = find(strncmp(p_i,lpropnames,length(p_i)));
    if isempty(ind)
      error(['No matching property found for: ',pv_pairs{2*i-1}])
    elseif length(ind)>1
      error(['Ambiguous property name: ',pv_pairs{2*i-1}])
    end
  end
  p_i = propnames{ind};

  % override the corresponding default in params
  params = setfield(params,p_i,v_i); %#ok

end

end % parse_pv_pairs


function [x_sigma, x_gam] = gaussian_para_esti(x)
% x = x(:);
gam = 0.2:0.001:10;
r_gam = (gamma(1./gam).*gamma(3./gam))./((gamma(2./gam)).^2);
x_mu = mean(x);
x_sigma_sq = mean((x - x_mu).^2);
x_sigma = sqrt(x_sigma_sq);
E_x = mean(abs(x - x_mu));
rho_x = x_sigma_sq/E_x^2;
[x_diff, x_ind] = min(abs(rho_x - r_gam));
x_gam = gam(x_ind);


function varargout = interp2(varargin)
% bsarray/interp2: 2-D interpolation (table lookup)
% usage: ZI = interp2(B,XI,YI);
%    or: ZI = interp2(B,XI,YI,EXTRAPVAL);
%
% arguments:
%   B - bsarray object having tensorOrder 2. The positions of the
%       x-coordinates of the underlying data array are assumed to be
%       X = s(2).*(1:Nx), where Nx is the number of data points in the X
%       dimension (i.e., second element of get(B,'dataSize')), and s
%       is the element spacing (i.e., get(B,'elementSpacing')). The
%       positions of the y-coordinates of the underlying data array are
%       assumed to be Y = s(1).*(1:Ny).
%   XI - x-coordinates of points at which to interpolate B.
%   YI - y-coordinates of points at which to interpolate B. YI must be the
%       same size as XI.
%
%   EXTRAPVAL - value to return for points in XI and YI that are outside
%       the range of X and Y, respectively. Default EXTRAPVAL = NaN.
%
%   ZI - the values of the underlying bsarray B evaluated at the points in
%       the array XI.
%

% author: Nathan D. Cahill
% email: ndcahill@gmail.com
% date: 18 April 2008

% parse input arguments
[b,xi,yi,extrapval] = parseInputs(varargin{:});

% get flag to determine if basis functions in each dimension are centred or
% shifted
m = double(get(b,'centred'));
mx = m(2); my = m(1);

% get number of data elements and coefficients, determine amount of padding
% that has been done to create coefficients
nData = get(b,'dataSize'); nDatax = nData(2); nDatay = nData(1);
n = get(b,'coeffsSize'); nx = n(2); ny = n(1);
padNum = (n-nData-1)/2; padNumx = padNum(2); padNumy = padNum(1);

% get the spacing between elements, and then construct vectors of the
% locations of the data and of the BSpline coefficients
h = get(b,'elementSpacing'); hx = h(2); hy = h(1);
xCol = hx.*((1-padNumx):(nDatax+padNumx+1))';
xDataCol = xCol((1+padNumx):(end-padNumx));
yCol = hy.*((1-padNumy):(nDatay+padNumy+1))';
yDataCol = yCol((1+padNumy):(end-padNumy));

% turn evaluation points into a column vector, but retain original size so
% output can be returned in same size as input
siz_xi = size(xi);
siz_zi = siz_xi;

% grab the BSpline coefficients
cMat = get(b,'coeffs');

% initialize some variables for use in interpolation
numelXi = numel(xi);
ziMat = zeros(numelXi,1);
p = 1:numelXi;

% Find indices of subintervals, x(k) <= u < x(k+1),
% or u < x(1) or u >= x(m-1).
kx = min(max(1+floor((xi(:)-xCol(1))/hx),1+padNumx),nx-padNumx) + 1-mx;
ky = min(max(1+floor((yi(:)-yCol(1))/hy),1+padNumy),ny-padNumy) + 1-my;
sx = (xi(:) - xCol(kx))/hx;
sy = (yi(:) - yCol(ky))/hy;

% perform interpolation
d = get(b,'degree'); dx = d(2); dy = d(1);
xflag = (~mx && mod(dx,2));
yflag = (~my && mod(dy,2));
for j=1:ceil((dx+1)/2) % loop over BSpline degree in x dimension
    Bx1 = evalBSpline(sx+j-(1+mx)/2,dx);
    Bx2 = evalBSpline(sx-j+(1-mx)/2,dx);
    for i=1:ceil((dy+1)/2) % loop over BSpline degree in y dimension
        By1 = evalBSpline(sy+i-(1+my)/2,dy);
        By2 = evalBSpline(sy-i+(1-my)/2,dy);
        for ind = 1:numelXi % loop over evaluation points, computing interpolated value
            ziMat(ind) = ziMat(ind) + cMat(ky(ind)-i+my,kx(ind)-j+mx).*By1(ind).*Bx1(ind) + ...
                cMat(ky(ind)+i-1+my,kx(ind)-j+mx).*By2(ind).*Bx1(ind) + ...
                cMat(ky(ind)-i+my,kx(ind)+j-1+mx).*By1(ind).*Bx2(ind) + ...
                cMat(ky(ind)+i-1+my,kx(ind)+j-1+mx).*By2(ind).*Bx2(ind);
        end
    end
    if yflag % add a correction factor if BSpline in y direction is shifted and of odd degree
        By1 = evalBSpline(sy+i+1/2,dy);
        for ind = 1:numelXi
            ziMat(ind) = ziMat(ind) + By1(ind).*...
                (cMat(ky(ind)-i-1,kx(ind)-j+mx).*Bx1(ind) + cMat(ky(ind)-i-1,kx(ind)+j-1+mx).*Bx2(ind));
        end
    end
end
if xflag % add a correction factor if BSpline in x direction is shifted and of odd degree
    Bx1 = evalBSpline(sx+j+1/2,dx);
    for i=1:ceil((dy+1)/2)
        By1 = evalBSpline(sy+i-(1+my)/2,dy);
        By2 = evalBSpline(sy-i+(1-my)/2,dy);
        for ind = 1:numelXi
            ziMat(ind) = ziMat(ind) + Bx1(ind).*...
                (cMat(ky(ind)-i+my,kx(ind)-j-1).*By1(ind) + cMat(ky(ind)+i-1+my,kx(ind)-j-1).*By2(ind));
        end
    end
end

% perform extrapolation
outOfBounds = xi(:)<xDataCol(1) | xi(:)>xDataCol(nDatax) | yi(:)<yDataCol(1) | yi(:)>yDataCol(nDatay);
ziMat(p(outOfBounds)) = extrapval;

% reshape result to have same size as input xi
zi = reshape(ziMat,siz_zi);
varargout{1} = zi;

%% subfunction parseInputs
function [b,xi,yi,extrapval] = parseInputs(varargin)

nargs = length(varargin);
error(nargchk(3,4,nargs));

% Process B
b = varargin{1};
if ~isequal(b.tensorOrder,2)
    error([mfilename,'parseInputs:WrongOrder'], ...
        'bsarray/interp2 can only be used with bsarray objects having tensor order 2.');
end

% Process XI
xi = varargin{2};
if ~isreal(xi)
    error([mfilename,'parseInputs:ComplexInterpPts'], ...
        'The interpolation points XI should be real.')
end

% Process YI
yi = varargin{3};
if ~isreal(yi)
    error([mfilename,'parseInputs:ComplexInterpPts'], ...
        'The interpolation points YI should be real.')
end
if ~isequal(size(xi),size(yi))
    error([mfilename,'parseInputs:YIXINotSameSize'], ...
        'YI must be the same size as XI');
end

% Process EXTRAPVAL
if nargs > 3
    extrapval = varargin{4};
else
    extrapval = [];
end
if isempty(extrapval)
    extrapval = NaN;
end
if ~isscalar(extrapval)
    error([mfilename,':NonScalarExtrapValue'],...
        'EXTRAP option must be a scalar.')
end


%%%% calculation of field spatial distributions, starting from the eigenvectors (Fourier coefficients)
%%%% omega = normalized frequency
%%%% eta = inverse of matrix containing the Fourier coeff. of dielectric
%%%% function
%%%% Phi = matrix of column eigenvectors [hx,hy]'
%%%% kz = vector of real eigenvalues
%%%% u = index of selected eigenvalue/eigenvector
function [Ex,Ey,Ez,Hx,Hy,Hz] = rfields(omega,eta,kGx,kGy,kz,Phi,N1,N2,u)
N=N1*N2;
hx=Phi(1:N,u); hy=Phi((N+1):2*N,u);
hz=-(1/kz(u))*(kGx*hx+kGy*hy);
ex=-(1/omega)*eta*(kGy*hz-kz(u)*hy);
ey=-(1/omega)*eta*(kz(u)*hx-kGx*hz);
ez=-(1/omega)*eta*(kGx*hy-kGy*hx);

ex=reshape(ex,N1,N2); ey=reshape(ey,N1,N2); ez=reshape(ez,N1,N2);
hx=reshape(hx,N1,N2); hy=reshape(hy,N1,N2); hz=reshape(hz,N1,N2);
Ex=(N1*N2)*ifft2(ifftshift(ex'));
Ey=(N1*N2)*ifft2(ifftshift(ey'));
Ez=(N1*N2)*ifft2(ifftshift(ez'));

Hx=(N1*N2)*ifft2(ifftshift(hx'));
Hy=(N1*N2)*ifft2(ifftshift(hy'));
Hz=(N1*N2)*ifft2(ifftshift(hz'));


function ret = wrap_boundary_liu(img, img_size)
% wrap_boundary_liu.m
%
%   pad image boundaries such that image boundaries are circularly smooth
%
%     written by Sunghyun Cho (sodomau@postech.ac.kr)
%
% This is a variant of the method below:
%   Reducing boundary artifacts in image deconvolution
%     Renting Liu, Jiaya Jia
%     ICIP 2008
%
    [H, W, Ch] = size(img);
    H_w = img_size(1) - H;
    W_w = img_size(2) - W;

    ret = zeros(img_size(1), img_size(2), Ch);
    for ch = 1:Ch
        alpha = 1;
        HG = img(:,:,ch);

        r_A = zeros(alpha*2+H_w, W);
        r_A(1:alpha, :) = HG(end-alpha+1:end, :);
        r_A(end-alpha+1:end, :) = HG(1:alpha, :);
        a = ((1:H_w)-1)/(H_w-1);
        r_A(alpha+1:end-alpha, 1) = (1-a)*r_A(alpha,1) + a*r_A(end-alpha+1,1);
        r_A(alpha+1:end-alpha, end) = (1-a)*r_A(alpha,end) + a*r_A(end-alpha+1,end);

        A2 = solve_min_laplacian(r_A(alpha:end-alpha+1,:));
        r_A(alpha:end-alpha+1,:) = A2;
        A = r_A;

        r_B = zeros(H, alpha*2+W_w);
        r_B(:, 1:alpha) = HG(:, end-alpha+1:end);
        r_B(:, end-alpha+1:end) = HG(:, 1:alpha);
        a = ((1:W_w)-1)/(W_w-1);
        r_B(1, alpha+1:end-alpha) = (1-a)*r_B(1,alpha) + a*r_B(1,end-alpha+1);
        r_B(end, alpha+1:end-alpha) = (1-a)*r_B(end,alpha) + a*r_B(end,end-alpha+1);

        B2 = solve_min_laplacian(r_B(:, alpha:end-alpha+1));
        r_B(:,alpha:end-alpha+1,:) = B2;
        B = r_B;

        r_C = zeros(alpha*2+H_w, alpha*2+W_w);
        r_C(1:alpha, :) = B(end-alpha+1:end, :);
        r_C(end-alpha+1:end, :) = B(1:alpha, :);
        r_C(:, 1:alpha) = A(:, end-alpha+1:end);
        r_C(:, end-alpha+1:end) = A(:, 1:alpha);

        C2 = solve_min_laplacian(r_C(alpha:end-alpha+1, alpha:end-alpha+1));
        r_C(alpha:end-alpha+1, alpha:end-alpha+1) = C2;
        C = r_C;

        A = A(alpha:end-alpha-1, :);
        B = B(:, alpha+1:end-alpha);
        C = C(alpha+1:end-alpha, alpha+1:end-alpha);

        ret(:,:,ch) = [img(:,:,ch) B; A C];
    end

end

function [img_direct] = solve_min_laplacian(boundary_image)
% function [img_direct] = poisson_solver_function(gx,gy,boundary_image)
% Inputs; Gx and Gy -> Gradients
% Boundary Image -> Boundary image intensities
% Gx Gy and boundary image should be of same size
    [H,W] = size(boundary_image);

    % Laplacian
    f = zeros(H,W);                          clear j k

    % boundary image contains image intensities at boundaries
    boundary_image(2:end-1, 2:end-1) = 0;
    j = 2:H-1;      k = 2:W-1;      f_bp = zeros(H,W);
    f_bp(j,k) = -4*boundary_image(j,k) + boundary_image(j,k+1) + ...
        boundary_image(j,k-1) + boundary_image(j-1,k) + boundary_image(j+1,k);
    clear j k

    %f1 = f - reshape(f_bp,H,W); % subtract boundary points contribution
    f1 = f - f_bp; % subtract boundary points contribution
    clear f_bp f

    % DST Sine Transform algo starts here
    f2 = f1(2:end-1,2:end-1);                   clear f1
    % compute sine tranform
    tt = dst(f2);       f2sin = dst(tt')';      clear f2

    % compute Eigen Values
    [x,y] = meshgrid(1:W-2, 1:H-2);
    denom = (2*cos(pi*x/(W-1))-2) + (2*cos(pi*y/(H-1)) - 2);

    % divide
    f3 = f2sin./denom;                          clear f2sin x y

    % compute Inverse Sine Transform
    tt = idst(f3);      clear f3;       img_tt = idst(tt')';        clear tt

    % put solution in inner points; outer points obtained from boundary image
    img_direct = boundary_image;
    img_direct(2:end-1,2:end-1) = 0;
    img_direct(2:end-1,2:end-1) = img_tt;
end


classdef VNT4 < PROBLEM
% <multi> <real> <constrained>
% Benchmark MOP proposed by Viennet

%------------------------------- Reference --------------------------------
% R. Viennet, C. Fonteix, and I. Marc, Multicriteria optimization using a
% genetic algorithm for determining a Pareto set, International Journal of
% Systems Science, 1996, 27(2): 255-260.
%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    methods
        %% Default settings of the problem
        function Setting(obj)
            obj.M        = 3;
            obj.D        = 2;
            obj.lower    = [-4,-4];
            obj.upper    = [4,4];
            obj.encoding = ones(1,obj.D);
        end
        %% Calculate objective values
        function PopObj = CalObj(obj,PopDec)
            PopObj(:,1) = (PopDec(:,1)-2).^2/2 + (PopDec(:,2)+1).^2/13 + 3;
            PopObj(:,2) = (PopDec(:,1)+PopDec(:,2)-3).^2/175 + (2*PopDec(:,2)-PopDec(:,1)).^2/17 - 13;
            PopObj(:,3) = (3*PopDec(:,1)-2*PopDec(:,2)+4).^2/8 + (PopDec(:,1)-PopDec(:,2)+1).^2/27 + 15;
        end
        %% Calculate constraint violations
        function PopCon = CalCon(obj,PopDec)
            PopCon(:,1) = PopDec(:,2) + 4*PopDec(:,1) - 4;
            PopCon(:,2) = -1 - PopDec(:,1);
            PopCon(:,3) = PopDec(:,1) - 2 - PopDec(:,2);
        end
        %% Generate points on the Pareto front
        function R = GetOptimum(obj,N)
            N = ceil(sqrt(N));
            x = linspace(-1,1.2,N);
            X = [];
            for i = 1 : N
                X = [X;repmat(x(i),N,1),linspace(x(i)-2,-4*x(i)+4,N)'];
            end
            R = obj.CalObj(X);
            R = R(NDSort(R,1)==1,:);
        end
        %% Generate the image of Pareto front
        function R = GetPF(obj)
            x = linspace(-1,1.2,40);
            X = [];
            for i = 1 : 40
                X = [X;repmat(x(i),40,1),linspace(x(i)-2,-4*x(i)+4,40)'];
            end
            R = obj.CalObj(X);
            R(NDSort(R,1)>1,:) = nan;
            R = {reshape(R(:,1),40,40),reshape(R(:,2),40,40),reshape(R(:,3),40,40)};
        end
    end
end


function [ n_data, n, z, fx ] = polylogarithm_values ( n_data )

%*****************************************************************************80
%
%% POLYLOGARITHM_VALUES returns some values of the polylogarithm.
%
%  Discussion:
%
%    The polylogarithm of n and z is defined as
%
%      f[n,z] = Sum ( 1 <= k < infinity ) z^k / k^n
%
%    In Mathematica, the function can be evaluated by:
%
%      PolyLog[n,z]
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 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 exponent of the denominator.
%
%    Output, real Z, the base of the numerator.
%
%    Output, real FX, the value of the function.
%
  n_max = 12;

  fx_vec = [ ...
     0.1644934066848226E+01, ...
     0.1202056903159594E+01, ...
     0.1000994575127818E+01, ...
     0.5822405264650125E+00, ...
     0.5372131936080402E+00, ...
     0.5002463206060068E+00, ...
     0.3662132299770635E+00, ...
     0.3488278611548401E+00, ...
     0.3334424797228716E+00, ...
     0.1026177910993911E+00, ...
     0.1012886844792230E+00, ...
     0.1000097826564961E+00 ];

  n_vec = [ ...
     2, 3, 10, 2, 3, 10, 2, 3, 10, 2, 3, 10 ];

  z_vec = [ ...
     0.1000000000000000E+01, ...
     0.1000000000000000E+01, ...
     0.1000000000000000E+01, ...
     0.5000000000000000E+00, ...
     0.5000000000000000E+00, ...
     0.5000000000000000E+00, ...
     0.3333333333333333E+00, ...
     0.3333333333333333E+00, ...
     0.3333333333333333E+00, ...
     0.1000000000000000E+00, ...
     0.1000000000000000E+00, ...
     0.1000000000000000E+00 ];

  if ( n_data < 0 )
    n_data = 0;
  end

  n_data = n_data + 1;

  if ( n_max < n_data )
    n_data = 0;
    n = 0;
    z = 0.0;
    fx = 0.0;
  else
    n = n_vec(n_data);
    z = z_vec(n_data);
    fx = fx_vec(n_data);
  end

  return
end


function[varargout]=trajchunk(varargin)
%TRAJCHUNK  Chunks Lagrangian trajectories based on the Coriolis period.
%
%   TRAJCHUNK is used to split float or drifter data into chunks such that
%   the length of each chunk is a fixed multiple of one over the mean
%   Coriolis frequency. This can be useful in spectral analysis.
%
%   [NUMO,LATO]=TRAJCHUNK(NUM,LAT,P), where NUM and LAT are date number and
%   latitude for Lagangian float or drifter data, re-organizes these into
%   chunks such that the average Coriolis frequency f_C in each chunk is at
%   least P times the Rayleigh frequency f_R for that chunk.
%
%   The Rayleigh frequency is f_R=2*pi/(DT*N), in units of radians per unit
%   time, where DT is the sample interval and N is the number of samples.
%   The Rayleigh frequency decreases as the chunk length increases.
%
%   The input fields NUM and LAT may either be numerical arrays, or
%   cell arrays of numerical arrays, e.g. NUM{1}=NUM1, NUM{2}=NUM2, etc.
%
%   The output variables NUM and LAT are cell arrays of numerical arrays,
%   with each cell being just long enough such that f_C > P * f_R.
%
%   Trajectories that are not long enough to satisfy this criterion are
%   discarded, as are short residual segments at the end of trajectories.
%
%   Each input trajectory is thus split into zero, one, or more than one
%   cells in the output variables.
%
%   TRAJCHUNK(...,P,LMIN) additionally specifies a mininum number of points
%   LMIN for each chunk.
%   __________________________________________________________________
%
%   Multiple input / output arguments
%
%   [NUMO,LATO,Y1,Y2,...,YM]=TRAJCHUNK(NUM,LAT,X1,X2,...XM,P) chunks the M
%   input arrays X1, X2,... XM in the same manner, and returns these as Y1,
%   Y2,... YM.  The input variables may either all be numerical arrays of
%   all the same size, or cell arrays of numerical arrays.
%
%   In the case of cell array input, some of the XM may be numerical arrays
%   of the same length as the cells NUM and LAT.  The corresponding output
%   variable will then also be a numerical array.  An example of such a
%   field is the identification number used in FLOATS.MAT and DRIFTERS.MAT.
%
%   TRAJCHUNK with no output arguments overwrites the original named output
%   variables.
%   __________________________________________________________________
%
%   Optional behaviors
%
%   By default, any data in short trajectories for which f_C < P * f_R are
%   discarded, as are data segments at the end of the trajectories.
%
%   TRAJCHUNK(...,'keep') keeps these instead.  Short trajectories are
%   returned in their own chunks, and leftover segments are appended to
%   the end of the preceding chunk.
%
%   TRAJCHUNK(...,'full') instead ensures that the output cells span the
%   full duration of the input fields.  This is done by appending a final
%   cell having f_C > P * f_R, like the others, but that ends at the final
%   data point, regardless of the degree of overlap with the previous cell.
%   Data from cells shorter than the specified length are discarded.
%   __________________________________________________________________
%
%   Overlap
%
%   TRAJCHUNK(...,'overlap',PCT) outputs chunks with a percentage PCT
%   overlap.  For example, TRAJCHUNK(...,'overlap',50) outputs chunks that
%   overlap by 50%.  The default behavior gives chunks with no overlap.
%   __________________________________________________________________
%
%   See also CELLCHUNK.
%
%   'trajchunk --t' runs a test.
%
%   Usage: [num,lat]=trajchunk(num,lat,P);
%          [num,lat,lon,cv]=trajchunk(num,lat,lon,cv,P);
%          [num,lat,lon,cv]=trajchunk(num,lat,lon,cv,P,lmin);
%          [num,lat,lon,cv]=trajchunk(num,lat,lon,cv,P,'overlap',50);
%          trajchunk(num,lat,lon,cv,P);
%   __________________________________________________________________
%   This is part of JLAB --- type 'help jlab' for more information
%   (C) 2014--2019 J.M. Lilly --- type 'help jlab_license' for details

%   [...,II,KK]=TRAJCHUNK(...) in this case also outputs the indices of
%   the data locations within the input cells.  KK is not a cell array
%   like the other output arguments, but rather a row array of LENGTH(II).

%   [..,II]=TRAJCHUNK(...), with an extra final output argument,
%   outputs a cell array II of indices to the original time series.
%
%   As an example, LAT(II{1}) gives the latitudes of the data in the first
%   cell of the output, LATO{1}.

%   Equivalently, this means that the inertial period 2*pi/f_C is just less
%   than 1/M times the chunk duration DT*N, or 2*pi/f_C < (1/M) * (DT*N).
%   Thus M inertial oscillations fit into each chunk.
%   Not completely sure about the wording of this due to the definition of
%   'mean Coriolis frequency' etc.

if strcmpi(varargin{1}, '--t')
    trajchunk_test,return
end

factor=1;
opt='nokeep';     %What to do with leftover points

for i=1:2
    if ischar(varargin{end})
        if strcmpi(varargin{end}(1:3),'kee')||strcmpi(varargin{end}(1:3),'nok')||strcmpi(varargin{end}(1:3),'ful')
            opt=varargin{end};
            varargin=varargin(1:end-1);
        end
    end
    if ischar(varargin{end-1})
        if strcmpi(varargin{end-1}(1:3),'ove')
            factor=1-varargin{end}/100;
            varargin=varargin(1:end-2);
        end
    end
end

if ~iscell(varargin{end-1})&&length(varargin{end-1})==1
    N=varargin{end-1};
    M=varargin{end};
    varargin=varargin(1:end-2);
else
    N=varargin{end};
    M=0;
    varargin=varargin(1:end-1);
end

num=varargin{1};
lat=varargin{2};
%Note: leave num and lat as first two entries also
na=length(varargin);

%na,N,M,size(num),size(lat),str,opt
if ~iscell(lat)
    %Create ii index
    varargin{na+1}=[1:length(lat)]';
    index=trajchunk_index(num,lat,N,M,opt,factor);
    n=0;
    if ~isempty(index)
        for k=1:length(index)
            n=n+1;
            for j=1:na+1
                varargout{j}{n,1}=varargin{j}(index{k});
            end
        end
    end
else
    %/**************
    %Put numerical array input into cell arrays
    bid=false(size(varargin));
    for i=3:length(bid) %Lat and lon are not allowed to be arrays
        if ~iscell(varargin{i})
            bid(i)=true;
            varargin{i}=celladd(varargin{i},cellmult(0,varargin{1}));
        end
    end
    %\**************

%     %Create ii and kk indices
%     for i=1:length(lat)
%         varargin{na+1}{i}=[1:length(lat{i})]';
%         varargin{na+2}{i}=i+0*lat{i};
%     end
    index=[];
    for i=1:length(lat)
        if length(lat)>1000
            if res((i-1)/1000)==0
                disp(['TRAJCHUNK working on cells ' int2str(i) ' to ' int2str(min(i+1000,length(lat))) ' of ' int2str(length(lat)) '.'])
            end
        end
        index{i,1}=trajchunk_index(num{i},lat{i},N,M,opt,factor);
    end
    n=0;
    for i=1:length(lat)
        if ~isempty(index{i})
            for k=1:length(index{i})
                n=n+1;
                for j=1:na
                    varargout{j}{n,1}=varargin{j}{i}(index{i}{k});
                end
            end
        end
    end

    %Return numerical array input back to numerical arrays
    for i=1:length(bid)
        if bid(i)
            varargout{i}=cellfirst(varargout{i});
        end
    end

%     %i,j,k,n
%     %Convert cell array kk into numeric array
%     temp=varargout{na+2};
%     varargout{na+2}=zeros(size(varargout{na+1}));
%     for i=1:length(varargout{na+1})
%         varargout{na+2}(i)=temp{i}(1);
%     end
end

eval(to_overwrite(na));

function[index]=trajchunk_index(num,lat,N,M,opt,factor)
if length(num)<2
    index=[];
else
    dt=num(2)-num(1);

    fo=abs(corfreq(lat))*24;
    meanfo=frac(cumsum(fo),[1:length(fo)]');
    fr=frac(2*pi,dt*[1:length(fo)]');
    %aresame(meanfo(end),vmean(fo,1))

    bdone=false;
    n=0;

    x=[1:length(fo)]';
    index=[];
    while ~bdone
        ii=max(find(N*fr<meanfo,1,'first'),M);
        n=n+1;
        if isempty(ii)||ii>=length(x)
            bdone=1;
        else
            index{n}=x(1:ii);
            %N*fr(ii)<meanfo(ii)
            if ii<length(x)
                x=x(floor(ii*factor)+1:end);
                fo=fo(floor(ii*factor)+1:end);
                %fr=fr(ii+1:end)-fr(ii+1)+frac(2*pi,dt);
                meanfo=frac(cumsum(fo),[1:length(fo)]');
                fr=frac(2*pi,dt*[1:length(fo)]');
                %aresame(meanfo(end),vmean(fo,1))
            end
        end
    end

    % if ~isempty(index)
    %     if strcmpi(opt(1:3),'kee')
    %         index{end}=index{end}(1):x(end);
    %     end
    % end
    if strcmpi(opt(1:3),'kee')
        if ~isempty(index)
            index{end}=index{end}(1):x(end);  %Append leftovers
        else
            index{1}=x;  %Keep short segments
        end
    elseif strcmpi(opt(1:3),'ful')
        indexlast=trajchunk_index(num,flipud(lat),N,M,'nokeep',1);
        indexlast=length(lat)-flipud(indexlast{1})+1;
        index{end+1}=indexlast;
        %maxmax(indexlast),length(lat)
    end
end
function[]=trajchunk_test

load ebasnfloats

use ebasnfloats
dt=1;
trajchunk(num,lat,lon,32);
meanfo=vmean(abs(corfreq(col2mat(cell2col(lat)))),1)'*24*dt;
fr=frac(2*pi,dt*cellength(lat));
reporttest('TRAJCHUNK no overlap',allall(meanfo>32*fr))
%length(num),length(cell2col(num))

use ebasnfloats
dt=1;
trajchunk(num,lat,lon,32,'overlap',50);
meanfo=vmean(abs(corfreq(col2mat(cell2col(lat)))),1)'*24*dt;
fr=frac(2*pi,dt*cellength(lat));
reporttest('TRAJCHUNK overlap',allall(meanfo>32*fr))

% load drifterheyerdahl
% use drifterheyerdahl
%
% [numc,latc]=trajchunk(num,lat,60,'overlap',50);
% [~,latc2,numc2]=trajchunk(num,flipud(lat),flipud(num),60,'overlap',50);
%
% min(cellmin(numc))-min(num)
% max(cellmax(numc))-max(num)
%
% numc{end+1}=flipud(numc2{1});
% latc{end+1}=flipud(latc2{1});
%
% for i=1:length(numc)
%     P(i)=sum(abs(corfreq(latc{i}))*24.*(numc{i}-numc{i}(1))/2/pi/24);
% end
%
% plot(cellmax(numc)-cellmin(numc))
% plot(60*2*pi./(cellmean(cellabs(corfreq(latc)))*24))

%length(num),length(cell2col(num))

% with minimum length
%
%     trajchunk(num,lat,lon,32,35);
%
% load drifters
% use drifters
% %trajchunk(num,lat,lon,32,'overlap');
% trajchunk(num,lat,lon,128);
%
% %meanfo=zeros(length(num),1);
% %fr=zeros(length(num),1);
%
% %dt=1/4;
%
% %Same as below but faster
% tic
% meanfo=vmean(abs(corfreq(col2mat(cell2col(lat)))),1)'*24*dt;
% fr=frac(2*pi,dt*cellength(lat));
% toc
%
% % tic
% % for i=1:length(num)
% %     meanfo(i)=vmean(abs(corfreq(lat{i})),1)*24*dt;
% %     fr(i)=frac(2*pi,dt*length(lat{i}));
% % end
% % toc
%
% figure,plot(meanfo,'b.'),hold on,plot(32*fr,'ro')
% figure,plot(2*pi./(meanfo/32),'b.'),hold on,plot(2*pi./fr,'ro')
% figure,plot(2*pi./(meanfo/32),2*pi./fr,'ro'),axis equal


% StackExchange Signal Processing Q86094
% https://dsp.stackexchange.com/questions/86094
% Analyzing 2 2D Kernels Which Approximates a Gaussian Kernel
% References:
%   1.
% Remarks:
%   1.  B
% TODO:
% 	1.  C
% Release Notes Royi Avital RoyiAvital@yahoo.com
% - 1.0.000     10/01/2023
%   *   First release.

%% General Parameters

subStreamNumberDefault = 79;

run('InitScript.m');

figureIdx           = 0;
figureCounterSpec   = '%04d';

generateFigures = ON;

%% Constants

KERNEL_A = 1; %<! The 1st kernel
KERNEL_B = 2; %<! The 2nd Kernel

%% Parameters

mK1 = (1 / 16) * [1, 2, 1; 2, 4, 2; 1, 2, 1];
mK2 = (1 / 48) * [0, 1, 2, 1, 0; 1, 2, 4, 2, 1; 2, 4, 8, 4, 2; 1, 2, 4, 2, 1; 0, 1, 2, 1, 0];

%% Generate / Load Data

%% Analysis

% Padding the 1st array to have the same size as the 2nd
mK1 = padarray(mK1, [1, 1], 0, 'both');

% SVD Decomposition of the kernels
[mU1, mS1, mV1] = svd(mK1);
[mU2, mS2, mV2] = svd(mK2);

% Separable (Approximation)
mD1 = mS1(1, 1) * mU1(:, 1) * mV1(:, 1).';
mD2 = mS2(1, 1) * mU2(:, 1) * mV2(:, 1).';

vU1 = sqrt(mS1(1, 1)) * mU1(:, 1);
vU2 = sqrt(mS2(1, 1)) * mU2(:, 1);

vU1U2 = vU1 - vU2;
vU2U1 = vU2 - vU1;

%% Display Results

figureIdx = figureIdx + 1;

maxVal = max(max(mK1(:)), max(mK2(:)));

hF = figure('Position', [100, 100, 900, 400]);
hA   = subplot(1, 2, 1);
hImgObj = imagesc(mK1);
set(hA, 'CLim', [0, maxVal]);
set(hA, 'DataAspectRatio', [1, 1, 1]);
set(get(hA, 'Title'), 'String', {['Kernel A']}, ...
    'FontSize', fontSizeTitle);

hA   = subplot(1, 2, 2);
hImgObj = imagesc(mK2);
set(hA, 'CLim', [0, maxVal]);
set(hA, 'DataAspectRatio', [1, 1, 1]);
set(get(hA, 'Title'), 'String', {['Kernel B']}, ...
    'FontSize', fontSizeTitle);

if(generateFigures == ON)
    % saveas(hF, ['Figure', num2str(figureIdx, figureCounterSpec), '.png']);
    print(hF, ['Figure', num2str(figureIdx, figureCounterSpec), '.png'], '-dpng', '-r0'); %<! Saves as Screen Resolution
end

figureIdx = figureIdx + 1;

maxVal = max(max(mD1(:)), max(mD2(:)));

hF = figure('Position', [100, 100, 900, 400]);
hA   = subplot(1, 2, 1);
hImgObj = imagesc(mD1);
set(hA, 'CLim', [0, maxVal]);
set(hA, 'DataAspectRatio', [1, 1, 1]);
set(get(hA, 'Title'), 'String', {['Separable Approximation of Kernel A']}, ...
    'FontSize', fontSizeTitle);

hA   = subplot(1, 2, 2);
hImgObj = imagesc(mD2);
set(hA, 'CLim', [0, maxVal]);
set(hA, 'DataAspectRatio', [1, 1, 1]);
set(get(hA, 'Title'), 'String', {['Separable Approximation of Kernel B']}, ...
    'FontSize', fontSizeTitle);

if(generateFigures == ON)
    % saveas(hF, ['Figure', num2str(figureIdx, figureCounterSpec), '.png']);
    print(hF, ['Figure', num2str(figureIdx, figureCounterSpec), '.png'], '-dpng', '-r0'); %<! Saves as Screen Resolution
end

figureIdx = figureIdx + 1;

hF = figure('Position', figPosLarge);
hA   = axes(hF);
set(hA, 'NextPlot', 'add');
hLineObj = plot(-mU1(:, 1), 'DisplayName', 'Kernel A');
set(hLineObj, 'LineWidth', lineWidthNormal);
hLineObj = plot(-mU2(:, 1), 'DisplayName', 'Kernel B');
set(hLineObj, 'LineWidth', lineWidthNormal);
set(get(hA, 'Title'), 'String', {['Separable Filters of the Kernels']}, ...
    'FontSize', fontSizeTitle);
hLegend = ClickableLegend();

if(generateFigures == ON)
    % saveas(hF, ['Figure', num2str(figureIdx, figureCounterSpec), '.png']);
    print(hF, ['Figure', num2str(figureIdx, figureCounterSpec), '.png'], '-dpng', '-r0'); %<! Saves as Screen Resolution
end

figureIdx = figureIdx + 1;

hF = figure('Position', [100, 100, 1200, 800]);
hA   = subplot(1, 2, 1);
[~, ~, hLineObj] = PlotDft(vU1U2, 1, 'plotTitle', 'DFT of Kernal A - Kernel B in 1D Seprable Approximation', 'numFreqBins', 100);
set(hLineObj, 'LineWidth', lineWidthNormal);

hA   = subplot(1, 2, 2);
[~, ~, hLineObj] = PlotDft(vU2U1, 1, 'plotTitle', 'DFT of Kernal B - Kernel A in 1D Seprable Approximation', 'numFreqBins', 100);
set(hLineObj, 'LineWidth', lineWidthNormal);

if(generateFigures == ON)
    % saveas(hF, ['Figure', num2str(figureIdx, figureCounterSpec), '.png']);
    print(hF, ['Figure', num2str(figureIdx, figureCounterSpec), '.png'], '-dpng', '-r0'); %<! Saves as Screen Resolution
end

% figureIdx = figureIdx + 1;
%
% hFigure = figure('Position', figPosLarge);
% hAxes   = axes(hFigure);
% set(hAxes, 'NextPlot', 'add');
% hLineObj = plot(vTheta, 10 * log10(abs(vM)));
% set(hLineObj, 'LineWidth', lineWidthNormal);
%
% set(get(hAxes, 'Title'), 'String', {['MUSIC Pseudo Spectrum']}, ...
%     'FontSize', fontSizeTitle);
% set(get(hAxes, 'XLabel'), 'String', {['Spatial Angle [Deg]']}, ...
%     'FontSize', fontSizeAxis);
% set(get(hAxes, 'YLabel'), 'String', {['Value [dB]']}, ...
%     'FontSize', fontSizeAxis);
%
% hLineObj = plot(vTheta(vPeakIdx(1:numSig)), 10 * log10(abs(vPeakVal(1:numSig))));
% set(hLineObj, 'LineStyle', 'none', 'LineWidth', lineWidthNormal, 'Marker', 'x', 'MarkerSize', markerSizeLarge, 'Color', 'r');
% for ii = 1:numSig
%     hLineObj = xline(vTheta(vPeakIdx(ii)), '-', {['Angle: ', num2str(vTheta(vPeakIdx(ii))), ' [Deg]']});
%     set(hLineObj, 'LineStyle', ':', 'LineWidth', lineWidthThin, 'Color', 'r');
% end
%
% % hLegend = ClickableLegend({['Ground Truth'], ['Input Noisy Samples'], ['TV Estimation']});
%
% if(generateFigures == ON)
%     % saveas(hFigure, ['Figure', num2str(figureIdx, figureCounterSpec), '.png']);
%     print(hFigure, ['Figure', num2str(figureIdx, figureCounterSpec), '.png'], '-dpng', '-r0'); %<! Saves as Screen Resolution
% end

%% Auxilizary Functions

%% Restore Defaults

% set(0, 'DefaultFigureWindowStyle', 'normal');
% set(0, 'DefaultAxesLooseInset', defaultLoosInset);


function [XX,H] = projectedGrid ( P1, P2, P3, P4 , nx, ny);

% new formalism using homographies

a00 = [P1;1];
a10 = [P2;1];
a11 = [P3;1];
a01 = [P4;1];

% Compute the planart collineation:

[H] = compute_collineation (a00, a10, a11, a01);

% Build the grid using the planar collineation:

x_l = ((0:(nx-1))'*ones(1,ny))/(nx-1);
y_l = (ones(nx,1)*(0:(ny-1)))/(ny-1);

pts = [x_l(:) y_l(:) ones(nx*ny,1)]';

XX = H*pts;

XX = XX(1:2,:) ./ (ones(2,1)*XX(3,:));


function [D]=d2a2(A,B)
%D2A2 Pairwise squared L2 distance along 2nd axis.
% D = D2A2(A,B) Computes squared L2 (Euclidean) distance
% between all pairs of d-dimensional points in A and B.
%
% Inputs:
% A - m-by-d matrix of m d-dimensional points;
% B - n-by-d matrix of n d-dimensional points.
%
% Outputs:
% D - m-by-n matrix of pairwise distances.
%
% See also D2A1.
if nargin < 2
D = full(A*A');
d = diag(D);
D = bsxfun(@minus, d, 2*D);
D = bsxfun(@plus, d', D);
D = max(D, 0);
else
D = full(A*B');
D = bsxfun(@minus, sum(B.^2,2)', 2*D);
D = bsxfun(@plus, sum(A.^2,2), D);
D = max(D, 0);
end


function dt = DistanceTransform(b)

%DistanceTransform - Compute distance transform of a binary matrix (distance to nearest 1 value).
%
%  This function assigns to every point (x,y) in a binary matrix B the distance
%  to the nearest point in B with value 1. It uses the Euclidean metric for
%  computing distances. The code is based on the algorithm by Meijster et al.
%  (2000).
%
%  USAGE
%
%    dt = DistanceTransform(b)
%
%    b              binary matrix
%

% Copyright (C) 2014 by Michaël Zugaro
%
% 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.

% The code is not self explanatory, but is a direct transcription of the algorithms provided
% in Meijster et al. (2000)

[m,n] = size(b);
g = nan(m,n);

for x = 1:n,
	% Scan 1
	if b(1,x),
		g(1,x) = 0;
	else
		g(1,x) = m + n;
	end
	for y = 2:m,
		if b(y,x),
			g(y,x) = 0;
		else
			g(y,x) = 1 + g(y-1,x);
		end
	end
	% Scan 2
	for y = m-1:-1:1,
		if g(y+1,x) < g(y,x),
			g(y,x) = 1 + g(y+1,x);
		end
	end
end

for y = 1:n,
	q = 1;
	s(1) = 1;
	t(1) = 1;
	for u = 2:n,
		% Scan 3
		while true,
			x = t(q);
			i = s(q);
			f1 = (x-i)^2 + g(y,i)^2;
			i = u;
			f2 = (x-i)^2 + g(y,i)^2;
			if f1 <= f2, break; end
			q = q - 1;
			if q < 1, break; end
		end
		if q < 1,
			q = 1;
			s(1) = u;
		else
			i = s(q);
			a = (u^2-i^2+g(y,u)^2-g(y,i)^2);
			b = 2*(u-i);
			w = 1 + floor(a/b);
			if w <= n,
				q = q + 1;
				s(q) = u;
				t(q) = w;
			end
		end
	end
	for u = n:-1:1,
		% Scan 4
		x = u;
		i = s(q);
		dt(y,u) = sqrt((x-i)^2 + g(y,i)^2);
		if u == t(q),
			q = q - 1;
		end
	end
end


function point_num = cfn_e_size ( dim_num, level_max )

%*****************************************************************************80
%
%% CFN_E_SIZE: Closed Fully Nested, Exponential Growth.
%
%  Discussion:
%
%    This calculation assumes that an exponential growth rule is being used,
%    that is, that the 1D rules have orders 1, 3, 7, 15, 31, and so on.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 January 2010
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer LEVEL_MAX, the maximum value of LEVEL.
%
%    Output, integer POINT_NUM, the total number of unique
%    points in the grids.
%

%
%  Special case.
%
  if ( level_max < 0 )
    point_num = 0;
    return
  end

  if ( level_max == 0 )
    point_num = 1;
    return
  end
%
%  Construct the vector that counts the new points in the 1D rule.
%
  new_1d = zeros ( level_max+1, 1 );

  new_1d(0+1) = 1;
  new_1d(1+1) = 2;

  j = 1;
  for l = 2 : level_max
    j = j * 2;
    new_1d(l+1) = j;
  end
%
%  Count the number of points by counting the number of new points
%  associated with each level vector.
%
  level_1d = zeros ( dim_num, 1 );

  point_num = 0;

  for level = 0 : level_max

    more = 0;
    h = 0;
    t = 0;

    while ( 1 )

      [ level_1d, more, h, t ] = comp_next ( level, dim_num, level_1d, more, h, t );

      point_num = point_num + prod ( new_1d(level_1d(1:dim_num)+1) );

      if ( ~more )
        break
      end

    end

  end

  return
end


function pcomb = stat_stouffer_pcomb(p)
% Stouffer et al's (1949) unweighted method for combination of
% independent p-values via z's
% From: http://imaging.mrc-cbu.cam.ac.uk/statswiki/FAQ/CombiningPvalues

if isempty(p)
    error('pfast was passed an empty array of p-values')
    pcomb=1;
else
    pcomb = (1-erf(sum(sqrt(2) * erfinv(1-2*p))/sqrt(2*length(p))))/2;
end


function [c, mass] = masscenter(F)
%------------------------------------------------------------------------------
%
% This function computes the center of mass of gridfunction F (seen as a
% density distribution) .
%
% Beware if F assumes not mere positive values, does it make sense?
%
% See also: m00, m10, m01, mu10, mu01
%
% Design and implementation by:
% Dr. Paul M. de Zeeuw <Paul.de.Zeeuw@cwi.nl>  http://homepages.cwi.nl/~pauldz/
% Last Revision: December 11, 2000.
%  2000 Stichting CWI, Amsterdam
%------------------------------------------------------------------------------
denomina = m00(F);
if denomina == 0
  error(' masscenter - demoninator vanishes ')
else
  cx = m10(F)/denomina;
  cy = m01(F)/denomina;
end
% whether cx, cy < 0 etc. could be checked here (see above warning).
if nargout == 1
  c = [cx cy];
elseif nargout == 2
  c = [cx cy];
  mass = denomina;
else
  error(' masscenter - wrong number of output arguments ')
end
%------------------------------------------------------------------------------


function [nu, U, llh, Ezz, Ezy] = kalmanSmoother(model, X)
% Kalman smoother (forward-backward algorithm for linear dynamic system)
% NOTE: This is the exact implementation of the Kalman smoother algorithm in PRML.
% However, this algorithm is not practical. It is numerical unstable.
% Input:
%   X: d x n data matrix
%   model: model structure
% Output:
%   nu: q x n matrix of latent mean mu_t=E[z_t] w.r.t p(z_t|x_{1:T})
%   U: q x q x n latent covariance U_t=cov[z_t] w.r.t p(z_t|x_{1:T})
%   Ezz: q x q matrix E[z_tz_t^T]
%   Ezy: q x q matrix E[z_tz_{t-1}^T]
%   llh: loglikelihood
% Written by Mo Chen (sth4nth@gmail.com).
A = model.A; % transition matrix
G = model.G; % transition covariance
C = model.C; % emission matrix
S = model.S;  % emision covariance
mu0 = model.mu0; % prior mean
P0 = model.P0;  % prior covairance

n = size(X,2);
q = size(mu0,1);
mu = zeros(q,n);
V = zeros(q,q,n);
P = zeros(q,q,n); % C_{t+1|t}
Amu = zeros(q,n); % u_{t+1|t}
llh = zeros(1,n);

% forward
PC = P0*C';
R = C*PC+S;
K = PC/R;
mu(:,1) = mu0+K*(X(:,1)-C*mu0);
V(:,:,1) = (eye(q)-K*C)*P0;
P(:,:,1) = P0;  % useless, just make a point
Amu(:,1) = mu0; % useless, just make a point
llh(1) = logGauss(X(:,1),C*mu0,R);
for i = 2:n
    [mu(:,i), V(:,:,i), Amu(:,i), P(:,:,i), llh(i)] = ...
        forwardUpdate(X(:,i), mu(:,i-1), V(:,:,i-1), A, G, C, S);
end
llh = sum(llh);
% backward
nu = zeros(q,n);
U = zeros(q,q,n);
Ezz = zeros(q,q,n);
Ezy = zeros(q,q,n-1);

nu(:,n) = mu(:,n);
U(:,:,n) = V(:,:,n);
Ezz(:,:,n) = U(:,:,n)+nu(:,n)*nu(:,n)';
for i = n-1:-1:1
    [nu(:,i), U(:,:,i), Ezz(:,:,i), Ezy(:,:,i)] = ...
        backwardUpdate(nu(:,i+1), U(:,:,i+1), mu(:,i), V(:,:,i), Amu(:,i+1), P(:,:,i+1), A);
end

function [mu1, V1, Amu, P, llh] = forwardUpdate(x, mu0, V0, A, G, C, S)
k = numel(mu0);
P = A*V0*A'+G;                                               % 13.88
PC = P*C';
R = C*PC+S;
K = PC/R;                                                    % 13.92
Amu = A*mu0;
CAmu = C*Amu;
mu1 = Amu+K*(x-CAmu);                                        % 13.89
V1 = (eye(k)-K*C)*P;                                         % 13.90
llh = logGauss(x,CAmu,R);                                    % 13.91

function [nu0, U0, E00, E10] = backwardUpdate(nu1, U1, mu, V, Amu, P, A)
J = V*A'/P;                                                  % 13.102
nu0 = mu+J*(nu1-Amu);                                        % 13.100
U0 = V+J*(U1-P)*J';                                          % 13.101
E00 = U0+nu0*nu0';                                           % 13.107
E10 = U1*J'+nu1*nu0';                                        % 13.106


function K = compute_cubic_spline_kernel(x,y);
nx = size(x,1);
ny = size(y,1);
Kmax = max(repmat(abs(x),1,ny),repmat(abs(y)',nx,1) );
Kmin = min(repmat(abs(x),1,ny),repmat(abs(y)',nx,1) );
K = Kmin .* Kmin .* ( 3 * Kmax - Kmin );
K = K .* (  x*y' > 0 );


% Degree-preserving random rewiring.
% Every rewiring decreases the assortativity (pearson coefficient).
%
% Note 1: There are rare cases of neutral rewiring (pearson coefficient stays the same within numerical error).
% Note 2: Assume unweighted undirected graph.
%
% INPUTS: edge list, el and number of rewirings, k (integer)
% OUTPUTS: rewired edge list
%
% Other routines used: degrees.m, edgeL2adj.m
% GB: last updated, Sep 27 2012

function el = rewireDisassort(el,k)

[deg,~,~]=degrees(edgeL2adj(el));

rew=0;

while rew<k

    % pick two random edges
    ind = randi(length(el),1,2);
    edge1=el(ind(1),:); edge2=el(ind(2),:);

    if length(intersect(edge1(1:2),edge2(1:2)))>0; continue; end % the two edges cannot overlap

    nodes=[edge1(1) edge1(2) edge2(1) edge2(2)];
    [~,Y]=sort(deg(nodes));

    % connect nodes(Y(1))-nodes(Y(4)) and nodes(Y(2))-nodes(Y(3))
    if ismember([nodes(Y(1)),nodes(Y(4)),1],el,'rows') || ismember([nodes(Y(2)),nodes(Y(3)),1],el,'rows'); continue; end

    el(ind(1),:)=[nodes(Y(1)),nodes(Y(4)),1];
    el(ind(2),:)=[nodes(Y(2)),nodes(Y(3)),1];

    [~,inds1] = ismember([edge1(2),edge1(1),1],el,'rows');
    el(inds1,:)=[nodes(Y(4)),nodes(Y(1)),1];

    [~,inds2] = ismember([edge2(2),edge2(1),1],el,'rows');
    el(inds2,:)=[nodes(Y(3)),nodes(Y(2)),1];

    rew=rew+1;

end


function [steep] = steep(B,V,C,s,o,d)
%Steepest ascent/descent is a simple and efficient optimization method based on
% statistical design of experiments.
%  In order to optimize a response with respect to a set of quantitative variables,
%  often by using sequential experimentation, we use polynomial models to approximate
%  the response surface. The process often begins by using a 2^p factorial design with
%  additional center points, then fitting a first-order model. If curvature is detected
%  (lack of fit to the first-order model), then we conclude that we are near the optimum
%  and add points to obtain a second-order design. If curvature is not detected, we are
%  far from the optimum and use the method of steepest ascent/descent to get points
%  headed (hopefully) toward to optimum. As we recognize that we are near the optimum,
%  we use a second-order design.
%  If there is no lack-of-fit then the linear model seems to approximate the response
%  surface in this region, which means we are far from an optimum. In this case we want
%  to obtain additional responses (design points) that go closer to the optimum. To do
%  this we use the method of steepest ascent/descent, which just means that future design
%  points should increase/decrease the levels of IV's (factors) in proportion to b's until
%  we are near the optimum response (maximum or minimum).
%  We know that to maximize/minimize a response, the movement of the design center must
%  be in the direction of the directional derivatives of the response function, that is,
%  in the direction of
%
%            df/dx = df/dx_1, . . .,df/dx_p .
%
%  We then multiply by a constant A so that
%
%            Dx = A*df/dx,
%  where
%
%            A = R/sqrt(Sum(df/dx_i)^2) .
%
%  Thus,
%
%            Sum(Dx_i^2) = R^2 .
%
%  For a first order model,
%
%            df/dx_i = b_i .
%
%  So,
%
%            Dx_i = A*b_i    and     A = R/sqrt(Sum(b_i^2)) .
%
%  From this we see that the movement of x_i up the path of steepest ascent/descent
%  is proportional to b_i. Since this is the case it is easier not to pick particular
%  values of R but rather fix a value of b_i and make the other changes proportional
%  to it.
%
%                               Gradient vector
%                  |                ^
%                  |    \    \    \/   O
%                  |\    \    \   /\ New\
%                  | \    \    \ /  O trials
%              x_2 |  \    \    /    \    \
%                  |   \ O--\----\O   \    \
%                  |    \| Start  |    \    \
%                  |     | design |\    \    \
%                  |     O\----\--O \    \    \
%                  |_ _ _ _\_ _ \_ _ \_ _ \_ _ \_ _
%                                 x_1
%
%      First-order response surface and path of steepest ascent.
%
%  Thus, the goal is to optimize the response variable Y. It is assumed that the
%  factors are continuous and controllable by the experimenter with negligible error.
%  If b_1, b_2,...,b_p are the parameters and observed response is Y then the parameter
%  of the polynomial is estimated by method of least squares.
%  The method of steepest ascent/descent is followed to reach the optimun point where
%  best surface is obtained. That is direction of the maximum increase/minimum decrease
%  of the response in the case of surface finish cosiderations. Direction of steep Y is
%  increasing/decreasing. Experiments are conducted along the path of steepest
%  ascent/descent until no further decrease in response is observed. Then a new
%  first-order model may be fit, a new path of steepest ascent/descent determined the
%  procedure continues. Eventually the vicinity of optimum is arrived.
%
%  Syntax: steep(B,V,C,s,o,d)
%
%  Inputs:
%       B - vector of regression coefficients (parameters) of the fitted linear equation
%           (first order): [intercept (1), linear (p)]. It must to be enter in that
%           strictly order.
%       V - vector of the factor values at starting point (current factor setting).
%       C - vector of units increment chosen between the low and medium levels and
%           between the medium and high levels for each parameter.
%       s - number of interested steps.
%       o - change relative to one unit change regarding to the maximum absolute
%           parameter [o = 1 (default)] or parameter choice by experimenter (o = 2).
%       d - steepest ascent [d = 1 (default)] or descent (d = 2) procedure.
%
%  Outputs:
%       A complete summary of the estimation of the selected direction of the
%       selected steepest method.
%
%  To see the procedure consider the following example taken from Montgomery DOX 5E
%  (Example 11-1, pg. 431). Based on the fitted first-order model,
%                     y = 40.44 + 0.775*x1 + 0.325*x2
%  with actual factor-values on the origin of 35 and 155 for time-reaction (min) and
%  temperature (oF) and step size of 5 and 5, respectively. We are interested to obtain
%  the predicted response by the steepest ascent metod for 12 steps.
%
%  Input data must be:
%  B=[40.44 0.775 0.325];
%  V=[35 155];
%  C=[5 2];
%  s = 12;
%  o = 1;
%  d = 1;
%
%  Calling on Matlab the function:
%             steep(B,V,C,s,o,d)
%
%  Answer is:
%
%  Estimation of the selected direction of steepest ascent.
%  The interested steps were 12
%  Leading from the center of the design region the operating point for the IV, 2
%  --------------------------------------------------------------------------------------------------------------
%   Run          Operating point        Predicted response
%  --------------------------------------------------------------------------------------------------------------
%     0        35.000      155.000            40.440
%     1        40.000      157.097            41.351
%     2        45.000      159.194            42.263
%     3        50.000      161.290            43.174
%     4        55.000      163.387            44.085
%     5        60.000      165.484            44.996
%     6        65.000      167.581            45.908
%     7        70.000      169.677            46.819
%     8        75.000      171.774            47.730
%     9        80.000      173.871            48.642
%    10        85.000      175.968            49.553
%    11        90.000      178.065            50.464
%    12        95.000      180.161            51.375
%  --------------------------------------------------------------------------------------------------------------
%
%  Created by A. Trujillo-Ortiz, R. Hernandez-Walls, A. Castro-Perez and
%             F.J. Marquez-Rocha
%             Facultad de Ciencias Marinas
%             Universidad Autonoma de Baja California
%             Apdo. Postal 453
%             Ensenada, Baja California
%             Mexico.
%             atrujo@uabc.mx
%             And the special collaboration of the post-graduate students of the 2005:1
%             Multivariate Statistics Course: Cesar Orlando Chavira-Ortega, Alfredo Frias-Velasco,
%             and Herlinda Gomez-Villa.
%  Copyright (C) May 20, 2005.
%
%  To cite this file, this would be an appropriate format:
%  Trujillo-Ortiz, A., R. Hernandez-Walls, A. Castro-Perez, F.J Marquez-Rocha,
%    C.O. Chavira-Ortega, A. Frias-Velasco and H. Gomez-Villa. (2005). steep:
%    Steepest ascent/descent as a simple and efficient optimization method based
%    on statistical design of experiments. A MATLAB file. [WWW document]. URL
%    http://www.mathworks.com/matlabcentral/fileexchange/loadFile.do?objectId=7737
%
%  References:
%
%  Box, G. E. P. and Draper, N. R. (1987), Empirical Model-Building and Response Surfaces.
%          John Wiley & Sons: New York.
%  Box, G. E. P. and Wilson, K. B. (1951), On the Experimental Attainment of Optimum
%          Conditions. J. Royal Stat. Soc. Ser. B., 13:1-45.
%  Montgomery, D. C. (2001), Design and Analysis of Experiments, 5th Ed., John Wiley & Sons: New York.
%  Myers, R. H. and Montgomery, D. C. (2002),  Response Surface Methodology: Process and
%          Product Optimization Using Designed Experiments. 2nd. Ed., John Wiley & Sons: New York.
%

if nargin < 6,
   d = 1 %(deafault);
end;

if nargin < 5,
   o = 1 %(deafault);
end;

b = B(2:end);
b = b(:);  %vector of  from coded regression model
V = V(:);  %base level (center point)
C = C(:);  %unit change
s = s;     %
v = length(B)-1; %number of independent variables

if o == 1,
   f = max(abs(b));
else (o == 2),
   l = input('Give me the interested factor: ');
   f = b(l);
end;

S = [];
for i = 0:s,
    if d == 1;      %steepest ascent
        x = [V + i*diag(b./f*C')];
    else (d == 2);  %steepest descent
        x = [V - i*diag(b./f*C')];
    end;
    S = [S x];
end;

S = S';
V = V';
[m n] = size(S);
O  = (S - repmat(V,m,1))./repmat(C',m,1);

Y = B(1)+O*b;

T = [];
for i = 0:s,
   T = [T;i];
end;

if d == 1;
    d = 'ascent.';
else (d == 2);
    d = 'descent.';
end;

[nul,fs] = size(S);
form = ['%12.3f '];
form2 = [' Run '];
form3 = [' Predicted response '];
for k = 2:fs,
    form = [form '%12.3f '];
    form2 = [form2 '       '];
    form3 = ['      ' form3];
end;
RR = [T S Y];

disp(' ')
fprintf('Estimation of the selected direction of steepest %s\n',d);
fprintf('The interested steps were %i\n',s);
fprintf('Leading from the center of the design region the operating point for the IV, %i\n',v);
fprintf('--------------------------------------------------------------------------------------------------------------\n');
disp([form2 '  Operating point '  form3])
fprintf('--------------------------------------------------------------------------------------------------------------\n');
ffa=['%4i  ' form  ' %16.3f\n'];
fprintf(ffa,RR');
fprintf('--------------------------------------------------------------------------------------------------------------\n');
disp(' ')

return,


function at = auct(crit,y,z,tt)
%AUCS Compute area under curve for survival model at given time
%
%  Description
%    A = AUCT(CRIT,Z) Compute are under curve for survival model at
%    given time using criteria vector CRIT (where larger value
%    means larger risk of incidence), observed time vector Y,
%    censoring indicator matrix Z at times TT (0=event, 1=censored)
%    and a time vector TT.
%
%  Reference
%    L. E. Chambless, C. P. Cummiskey, and G. Cui (2011). Several
%    methods to assess improvement in risk prediction models:
%    Extension to survival analysis. Statistics in Medicine
%    30(1):22-38.

% Copyright (C) 2012 Ernesto Ulloa, Aki Vehtari

% 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.

ip=inputParser;
ip.addRequired('crit',@(x) ~isempty(x) && isreal(x) && all(isfinite(x(:))))
ip.addRequired('y', @(x) isreal(x) && all(isfinite(x(:))))
ip.addRequired('z', @(x) isreal(x) && all(isfinite(x(:))))
ip.addRequired('tt', @(x) isreal(x) && all(isfinite(x(:))))
ip.parse(crit,y,z,tt)

for i=1:size(tt,2)
  comp=bsxfun(@times,bsxfun(@and,y(:,i)<=tt(i),1-z(:,i)),bsxfun(@or,bsxfun(@and,y(:,i)<=tt(i),z(:,i)),y(:,i)>=tt(i))');
  conc=bsxfun(@times,bsxfun(@gt,crit(:,i),crit(:,i)'),comp);
  at(i,1)=sum(conc(:))./sum(comp(:));
end

end


function fem2d_scalar_display ( prefix )

%*****************************************************************************80
%
%% FEM2D_SCALAR_DISPLAY creates surface plots of 2D FEM scalar data.
%
%  Discussion:
%
%    This program assumes that you have computed the value of some scalar
%    quantity (such as pressure or temperature) at a set of nodes.
%
%    You may have determined an order 3 triangulation of these nodes,
%    but if you have not, the program will work that out internally.
%
%    This program can read that data, and display a color contour of the
%    solution data.
%
%  Usage:
%
%    fem2d_scalar_display ( 'prefix' )
%
%    where
%
%    * 'prefix'_nodes.txt contains the node coordinates;
%    * 'prefix'_elements.txt contains the element definitions
%      (this file is optional, and if missing, the elements will be generated
%      by the program);
%    * 'prefix'_values.txt contains the nodal values.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 November 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string PREFIX, the common file prefix.
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'FEM2D_SCALAR_DISPLAY:\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '  Surface plot of a scalar U(X,Y) on a triangulated region.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  This program expects three input files:\n' );
  fprintf ( 1, '  * a node file,      the node coordinates,\n' );
  fprintf ( 1, '  * an element file,  triples of nodes that form elements,\n' );
  fprintf ( 1, '  * a value file,     solution values.\n' );
%
%  The command line argument is the common filename prefix.
%
  if ( nargin < 1 )

    fprintf ( 1, '\n' );

    prefix = input ( ...
      'Please enter the filename prefix:' );

  end
%
%  Create the filenames.
%
  node_filename = strcat ( prefix, '_nodes.txt' );
  element_filename = strcat ( prefix, '_elements.txt' );
  value_filename = strcat ( prefix, '_values.txt' );
%
%  Read the node data.
%
  [ dim_num, node_num ] = r8mat_header_read ( node_filename );

% fprintf ( 1, '\n' );
% fprintf ( 1, '  Read the header of "%s".', node_filename );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Spatial dimension DIM_NUM = %d\n', dim_num );
  fprintf ( 1, '  Number of points NODE_NUM = %d\n', node_num );

  if ( dim_num ~= 2 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'FEM2D_SCALAR_DISPLAY - Fatal error!\n' );
    fprintf ( 1, '  Dataset must have spatial dimension 2.\n' );
    error ( 'FEM2D_SCALAR_DISPLAY - Fatal error!' );
  end

  node_xy = r8mat_data_read ( node_filename, dim_num, node_num );

% fprintf ( 1, '\n' );
% fprintf ( 1, '  Read the data in "%s".\n', node_filename );

% r8mat_transpose_print_some ( dim_num, node_num, node_xy, 1, 1, dim_num, 5, ...
%   '  First 5 nodes:' );
%
%  Read or create the element data.
%
  if ( file_exist ( element_filename ) )

    [ element_order, element_num ] = i4mat_header_read ( ...
      element_filename );

    if ( element_order ~= 3 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'FEM2D_SCALAR_DISPLAY - Fatal error!\n' );
      fprintf ( 1, '  Data is not for a 3-node triangulation.\n' );
      error ( 'FEM2D_SCALAR_DISPLAY - Fatal error!' );
    end

%   fprintf ( 1, '\n' );
%   fprintf ( 1, '  Read the header of "%s".\n', ...
%     element_filename );
%   fprintf ( 1, '\n' );
    fprintf ( 1, '  Element order = %d\n', element_order );
    fprintf ( 1, '  Number of elements ELEMENT_NUM  = %d\n', ...
      element_num );

    element_node = i4mat_data_read ( element_filename, ...
      element_order, element_num );

%   fprintf ( 1, '\n' );
%   fprintf ( 1, '  Read the data in "%s".\n', element_filename );

  else

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Creating triangulation for data.\n' );
    element_node = delaunayn ( node_xy' );
    element_node = element_node';
    [ element_order, element_num ] = size ( element_node );
    i4mat_write ( element_filename, element_order, element_num, element_node );
    fprintf ( 1, '  Triangulation data written to "%s".\n', element_filename );
  end

% i4mat_transpose_print_some ( element_order, element_num, ...
%   element_node, 1, 1, element_order, 10, ...
%   '  First 10 elements:' );
%
%  Detect and correct 0-based indexing.
%
  element_node = mesh_base_one ( node_num, element_order, element_num, ...
    element_node );
%
%  Read the values.
%
  [ value_dim, value_num ] = r8mat_header_read ( value_filename );

% fprintf ( 1, '\n' );
% fprintf ( 1, '  Read the header of "%s".', value_filename );
% fprintf ( 1, '\n' );
% fprintf ( 1, '  Spatial dimension = %d\n', value_dim );
% fprintf ( 1, '  Number of values  = %d\n', value_num );

  if ( value_dim ~= 1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'FEM2D_SCALAR_DISPLAY - Fatal error!\n' );
    fprintf ( 1, '  VALUE data must be scalar.\n' );
    error ( 'FEM2D_SCALAR_DISPLAY - Fatal error!' );
  end

  value = r8mat_data_read ( value_filename, value_dim, value_num );
%
%  Call TRISURF to plot the data.
%
  trisurf ( element_node', node_xy(1,:)', node_xy(2,:)', value', ...
    'Edgecolor', 'None' )

  xlabel ( '<---X--->', 'Fontsize', 16 );
  ylabel ( '<---Y--->', 'Fontsize', 16 );
  zlabel ( '<---U(X,Y)--->', 'Fontsize', 16 );
  title ( prefix, 'Fontsize', 24 );
%
%  Save it as a PNG file.
%
  png_filename = strcat ( prefix, '.png' );
  print ( '-dpng', png_filename );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Saving a PNG version of plot as "%s"\n', png_filename );
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'FEM2D_SCALAR_DISPLAY:\n' );
  fprintf ( 1, '  Normal end of execution.\n' );
  fprintf ( 1, '\n' );
  timestamp ( );

  return
end
function column_num = file_column_count ( input_file_name )

%*****************************************************************************80
%
%% FILE_COLUMN_COUNT counts the columns in the first line of a file.
%
%  Discussion:
%
%    The file is assumed to be a simple text file.
%
%    Most lines of the file are presumed to consist of COLUMN_NUM words,
%    separated by spaces.  There may also be some blank lines, and some
%    comment lines, which have a "#" in column 1.
%
%    The routine tries to find the first non-comment non-blank line and
%    counts the number of words in that line.
%
%    If all lines are blanks or comments, it goes back and tries to analyze
%    a comment line.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 February 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILE_NAME, the name of the file.
%
%    Output, integer COLUMN_NUM, the number of columns in the file.
%
  FALSE = 0;
  TRUE = 1;
%
%  Open the file.
%
  input_unit = fopen ( input_file_name );

  if ( input_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'FILE_COLUMN_COUNT - Error!\n' );
    fprintf ( 1, '  Could not open the file "%s".\n', input_file_name );
    error ( 'FILE_COLUMN_COUNT - Error!' );
  end
%
%  Read one line, but skip blank lines and comment lines.
%  Use FGETL so we drop the newline character!
%
  got_one = FALSE;

  while ( 1 )

    line = fgetl ( input_unit );

    if ( line == -1 )
      break;
    end

    if ( s_len_trim ( line ) == 0 )

    elseif ( line(1) == '#' )

    else
      got_one = TRUE;
      break;
    end

  end

  fclose ( input_unit );

  if ( got_one == FALSE )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'FILE_COLUMN_COUNT - Warning!\n' );
    fprintf ( 1, '  The file does not seem to contain any data.\n' );
    column_num = -1;
    return;
  end

  column_num = s_word_count ( line );

  return
end
function value = file_exist ( file_name )

%*****************************************************************************80
%
%% FILE_EXIST reports whether a file exists.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 October 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, character FILE_NAME, the name of the file.
%
%    Output, logical FILE_EXIST, is TRUE if the file exists.
%
  fid = fopen ( file_name );

  if ( fid == -1 )
    value = 0;
  else
    fclose ( fid );
    value = 1;
  end

  return
end
function row_num = file_row_count ( input_file_name )

%*****************************************************************************80
%
%% FILE_ROW_COUNT counts the number of row records in a file.
%
%  Discussion:
%
%    Each input line is a "RECORD".
%
%    The records are divided into three groups:
%
%    * BLANK LINES (nothing but blanks)
%    * COMMENT LINES (begin with a '#')
%    * DATA RECORDS (anything else)
%
%    The value returned by the function is the number of data records.
%
%    By the way, if the MATLAB routine FGETS is used, instead of
%    FGETL, then the variable LINE will include line termination
%    characters, which means that a blank line would not actually
%    have zero characters.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    31 December 2006
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILE_NAME, the name of the input file.
%
%    Output, integer ROW_NUM, the number of rows found.
%
  input_unit = fopen ( input_file_name );

  if ( input_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'FILE_ROW_COUNT - Error!\n' );
    fprintf ( 1, '  Could not open the file "%s".\n', input_file_name );
    error ( 'FILE_ROW_COUNT - Error!' );
  end

  blank_num = 0;
  comment_num = 0;
  row_num = 0;

  record_num = 0;

  while ( 1 )

    line = fgetl ( input_unit );

    if ( line == -1 )
      break;
    end

    record_num = record_num + 1;
    record_length = s_len_trim ( line );

    if ( record_length <= 0 )
      blank_num = blank_num + 1;
    elseif ( line(1) == '#' )
      comment_num = comment_num + 1;
    else
      row_num = row_num + 1;
    end

  end

  fclose ( input_unit );

  return
end
function table = i4mat_data_read ( input_filename, m, n )

%*****************************************************************************80
%
%% I4MAT_DATA_READ reads data from an I4MAT file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    27 January 2006
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILENAME, the name of the input file.
%
%    Input, integer M, N, the number of rows and columns in the data.
%
%    Output, integer TABLE(M,N), the point coordinates.
%
  table = zeros ( m, n );
%
%  Build up the format string for reading M real numbers.
%
  string = ' ';

  for i = 0 : m
    string = strcat ( string, ' %d' );
  end

  input_unit = fopen ( input_filename );

  if ( input_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'I4MAT_DATA_READ - Error!\n' );
    fprintf ( 1, '  Could not open the input file.\n' );
    error ( 'I4MAT_DATA_READ - Error!' );
  end

  i = 0;

  while ( i < n )

    line = fgets ( input_unit );

    if ( line == -1 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'I4MAT_DATA_READ - Error!\n' );
      fprintf ( 1, '  End of input while reading data.\n' );
      error ( 'I4MAT_DATA_READ - Error!' );
    end

    if ( line(1) == '#' )

    elseif ( s_len_trim ( line ) == 0 )

    else

      [ x, count ] = sscanf ( line, string );

      if ( count == m )
        i = i + 1;
        table(1:m,i) = x(1:m);
      end

    end

  end

  fclose ( input_unit );

  return
end
function [ m, n ] = i4mat_header_read ( input_filename )

%*****************************************************************************80
%
%% I4MAT_HEADER_READ reads the header from an I4MAT file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 October 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILENAME, the name of the input file.
%
%    Output, integer M, the spatial dimension.
%
%    Output, integer N, the number of points.
%
  m = file_column_count ( input_filename );

  if ( m <= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'I4MAT_HEADER_READ - Fatal error!\n' );
    fprintf ( 1, '  There was some kind of I/O problem while trying\n' );
    fprintf ( 1, '  to count the number of data columns in\n' );
    fprintf ( 1, '  the file %s.\n', input_filename );
  end

  n = file_row_count ( input_filename );

  if ( n <= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'I4MAT_HEADER_READ - Fatal error!\n' );
    fprintf ( 1, '  There was some kind of I/O problem while trying\n' );
    fprintf ( 1, '  to count the number of data rows in\n' );
    fprintf ( 1, '  the file %s\n', input_filename );
  end

  return
end
function i4mat_transpose_print_some ( m, n, a, ilo, jlo, ihi, jhi, title )

%*****************************************************************************80
%
%% I4MAT_TRANSPOSE_PRINT_SOME prints some of an I4MAT, transposed.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 June 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns.
%
%    Input, integer A(M,N), an M by N matrix to be printed.
%
%    Input, integer ILO, JLO, the first row and column to print.
%
%    Input, integer IHI, JHI, the last row and column to print.
%
%    Input, string TITLE, a title.
%
  incx = 10;

  fprintf ( 1, '\n' );
  fprintf ( 1, '%s\n', title );

  for i2lo = max ( ilo, 1 ) : incx : min ( ihi, m )

    i2hi = i2lo + incx - 1;
    i2hi = min ( i2hi, m );
    i2hi = min ( i2hi, ihi );

    inc = i2hi + 1 - i2lo;

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Row: ' );
    for i = i2lo : i2hi
      fprintf ( 1, '%7d  ', i );
    end
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Col\n' );
    fprintf ( 1, '\n' );

    j2lo = max ( jlo, 1 );
    j2hi = min ( jhi, n );

    for j = j2lo : j2hi

      fprintf ( 1, '%5d  ', j );
      for i2 = 1 : inc
        i = i2lo - 1 + i2;
        fprintf ( 1, '%7d  ', a(i,j) );
      end
      fprintf ( 1, '\n' );

    end

  end

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

%*****************************************************************************80
%
%% I4MAT_WRITE writes an I4MAT file.
%
%  Discussion:
%
%    An I4MAT is an array of I4's.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 August 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string OUTPUT_FILENAME, the output filename.
%
%    Input, integer M, the spatial dimension.
%
%    Input, integer N, the number of points.
%
%    Input, integer TABLE(M,N), the points.
%
%    Input, logical HEADER, is TRUE if the header is to be included.
%

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

  if ( output_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'I4MAT_WRITE - Error!\n' );
    fprintf ( 1, '  Could not open the output file.\n' );
    error ( 'I4MAT_WRITE - Error!' );
  end
%
%  Write the data.
%
  for j = 1 : n
    for i = 1 : m
      fprintf ( output_unit, '  %12d', round ( table(i,j) ) );
    end
    fprintf ( output_unit, '\n' );
  end
%
%  Close the file.
%
  fclose ( output_unit );

  return
end
function element_node = mesh_base_one ( node_num, element_order, ...
  element_num, element_node )

%*****************************************************************************80
%
%% MESH_BASE_ONE ensures that the element definition is one-based.
%
%  Discussion:
%
%    The ELEMENT_NODE array contains nodes indices that form elements.
%    The convention for node indexing might start at 0 or at 1.
%    Since a MATLAB program will naturally assume a 1-based indexing, it is
%    necessary to check a given element definition and, if it is actually
%    0-based, to convert it.
%
%    This function attempts to detect 0-based node indexing and correct it.
%
%    Thanks to Feifei Xu for pointing out that I was subtracting 1 when I
%    should have been adding 1!  29 November 2012.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 November 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NODE_NUM, the number of nodes.
%
%    Input, integer ELEMENT_ORDER, the order of the elements.
%
%    Input, integer ELEMENT_NUM, the number of elements.
%
%    Input/output, integer ELEMENT_NODE(ELEMENT_ORDE,ELEMENT_NUM), the element
%    definitions.
%
  node_min = min ( min ( element_node(1:element_order,1:element_num) ) );
  node_max = max ( max ( element_node(1:element_order,1:element_num) ) );

  if ( node_min == 0 && node_max == node_num - 1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'MESH_BASE_ONE:\n' );
    fprintf ( 1, '  The element indexing appears to be 0-based!\n' );
    fprintf ( 1, '  This will be converted to 1-based.\n' );
    element_node(1:element_order,1:element_num) = ...
      element_node(1:element_order,1:element_num) + 1;
  elseif ( node_min == 1 && node_max == node_num )
%   fprintf ( 1, '\n' );
%   fprintf ( 1, 'MESH_BASE_ONE:\n' );
%   fprintf ( 1, '  The element indexing appears to be 1-based!\n' );
%   fprintf ( 1, '  No conversion is necessary.\n' );
  else
    fprintf ( 1, '\n' );
    fprintf ( 1, 'MESH_BASE_ONE - Warning!\n' );
    fprintf ( 1, '  The element indexing is not of a recognized type.\n' );
    fprintf ( 1, '  NODE_MIN = %d\n', node_min );
    fprintf ( 1, '  NODE_MAX = %d\n', node_max );
    fprintf ( 1, '  NODE_NUM = %d\n', node_num );
  end

  return
end
function table = r8mat_data_read ( input_filename, m, n )

%*****************************************************************************80
%
%% R8MAT_DATA_READ reads data from an R8MAT file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    27 January 2006
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILENAME, the name of the input file.
%
%    Input, integer M, N, the number of rows and columns of data.
%
%    Output, real TABLE(M,N), the point coordinates.
%
  table = zeros ( m, n );
%
%  Build up the format string for reading M real numbers.
%
  string = ' ';

  for i = 0 : m
    string = strcat ( string, ' %f' );
  end

  input_unit = fopen ( input_filename );

  if ( input_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8MAT_DATA_READ - Error!\n' );
    fprintf ( 1, '  Could not open the file.\n' );
    error ( 'R8MAT_DATA_READ - Error!' );
  end

  i = 0;

  while ( i < n )

    line = fgets ( input_unit );

    if ( line == -1 )
      break;
    end

    if ( line(1) == '#' )

    elseif ( s_len_trim ( line ) == 0 )

    else

      [ x, count ] = sscanf ( line, string );

      if ( count == m )
        i = i + 1;
        table(1:m,i) = x(1:m);
      end

    end

  end

  fclose ( input_unit );

  return
end
function [ m, n ] = r8mat_header_read ( input_filename )

%*****************************************************************************80
%
%% R8MAT_HEADER_READ reads the header from an R8MAT file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 October 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILENAME, the name of the input file.
%
%    Output, integer M, the spatial dimension.
%
%    Output, integer N, the number of points.
%
  m = file_column_count ( input_filename );

  if ( m <= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8MAT_HEADER_READ - Fatal error!\n' );
    fprintf ( 1, '  There was some kind of I/O problem while trying\n' );
    fprintf ( 1, '  to count the number of data columns in\n' );
    fprintf ( 1, '  the file %s.\n', input_filename );
  end

  n = file_row_count ( input_filename );

  if ( n <= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8MAT_HEADER_READ - Fatal error!\n' );
    fprintf ( 1, '  There was some kind of I/O problem while trying\n' );
    fprintf ( 1, '  to count the number of data rows in\n' );
    fprintf ( 1, '  the file %s\n', input_filename );
  end

  return
end
function r8mat_transpose_print_some ( m, n, a, ilo, jlo, ihi, jhi, title )

%*****************************************************************************80
%
%% R8MAT_TRANSPOSE_PRINT_SOME prints some of an R8MAT, transposed.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    23 May 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns.
%
%    Input, real A(M,N), an M by N matrix to be printed.
%
%    Input, integer ILO, JLO, the first row and column to print.
%
%    Input, integer IHI, JHI, the last row and column to print.
%
%    Input, string TITLE, an optional title.
%
  incx = 5;

  if ( 0 < s_len_trim ( title ) )
    fprintf ( 1, '\n' );
    fprintf ( 1, '%s\n', title );
  end

  for i2lo = max ( ilo, 1 ) : incx : min ( ihi, m )

    i2hi = i2lo + incx - 1;
    i2hi = min ( i2hi, m );
    i2hi = min ( i2hi, ihi );

    inc = i2hi + 1 - i2lo;

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Row: ' );
    for i = i2lo : i2hi
      fprintf ( 1, '%7d       ', i );
    end
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Col\n' );

    j2lo = max ( jlo, 1 );
    j2hi = min ( jhi, n );

    for j = j2lo : j2hi

      fprintf ( 1, '%5d ', j );
      for i2 = 1 : inc
        i = i2lo - 1 + i2;
        fprintf ( 1, '%12f', a(i,j) );
      end
      fprintf ( 1, '\n' );

    end

  end

  return
end
function len = s_len_trim ( s )

%*****************************************************************************80
%
%% S_LEN_TRIM returns the length of a character string to the last nonblank.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 June 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string S, the string to be measured.
%
%    Output, integer LEN, the length of the string up to the last nonblank.
%
  len = length ( s );

  while ( 0 < len )
    if ( s(len) ~= ' ' )
      return
    end
    len = len - 1;
  end

  return
end
function word_num = s_word_count ( s )

%*****************************************************************************80
%
%% S_WORD_COUNT counts the number of "words" in a string.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 January 2006
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string S, the string to be examined.
%
%    Output, integer WORD_NUM, the number of "words" in the string.
%    Words are presumed to be separated by one or more blanks.
%
  FALSE = 0;
  TRUE = 1;

  word_num = 0;
  s_length = length ( s );

  if ( s_length <= 0 )
    return;
  end

  blank = TRUE;

  for i = 1 : s_length

    if ( s(i) == ' ' )
      blank = TRUE;
    elseif ( blank == TRUE )
      word_num = word_num + 1;
      blank = FALSE;
    end

  end

  return
end
function timestamp ( )

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

  return
end