classdef CEC2020_F2 < PROBLEM
% <single> <real>
% Shifted and rotated Schwefel's function

%------------------------------- Reference --------------------------------
% C .T. Yue, K. V. Price, P. N. Suganthan, J. J. Liang, M. Z. Ali, B. Y.
% Qu, N. H. Awad, and P. P Biswas, Problem definitions and evaluation
% criteria for the CEC 2020 special session and competition on single
% objective bound constrained numerical optimization, Zhengzhou University,
% China and Nanyang Technological University, Singapore, 2019.
%------------------------------- 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".
%--------------------------------------------------------------------------

    properties
        O;      % Optimal decision vector
        Mat;	% Rotation matrix
    end
    methods
        %% Default settings of the problem
        function Setting(obj)
            CallStack = dbstack('-completenames');
            load(fullfile(fileparts(CallStack(1).file),'CEC2020.mat'),'Data');
            obj.O = Data{2}.o;
            obj.M = 1;
            if isempty(obj.D) || obj.D < 10
                obj.D   = 5;
                obj.Mat = Data{2}.M_5;
            elseif obj.D < 15
                obj.D   = 10;
                obj.Mat = Data{2}.M_10;
            elseif obj.D < 20
                obj.D   = 15;
                obj.Mat = Data{2}.M_15;
            else
                obj.D   = 20;
                obj.Mat = Data{2}.M_20;
            end
            obj.lower    = zeros(1,obj.D) - 100;
            obj.upper    = zeros(1,obj.D) + 100;
            obj.encoding = ones(1,obj.D);
        end
        %% Calculate objective values
        function PopObj = CalObj(obj,PopDec)
            Z = PopDec - repmat(obj.O(1:size(PopDec,2)),size(PopDec,1),1);
            Y = 10*Z*obj.Mat';
            Z = Y + 4.2097e2;
            g         = Z.*sin(sqrt(abs(Z)));
            temp      = 500 - mod(Z(Z>500),500);
            g(Z>500)  = temp.*sin(sqrt(abs(temp))) - (Z(Z>500)-500).^2/10000/obj.D;
            temp      = mod(abs(Z(Z<-500)),500) - 500;
            g(Z<-500) = temp.*sin(sqrt(abs(temp))) - (Z(Z<-500)-500)/10000/obj.D;
            PopObj = 1100 + 418.9829*obj.D - sum(g,2);
        end
    end
end


function[sigma2, cv, mu, sig2inv, cvinv, S, lmu ] = estNoise_mask(I, w, mask, N, zoom);
%
%  Input parameters
%   I     : Input (noisy) image
%   w     : radius of analysis window
%   N     : Number of ellements to be considered (histogram) when
%           estimating sigma2 and cv2
%   zoom  : Conditional flag to improve the estimation of
%           sigma2 and cv2
%
%
%  Output parameters
%
%   sigma2  : estimation of the variance
%   cv2     : estimation of the coeficient of variation (cv2 = sigma^2 / mu^2)
%   mu      : estimation of the mean value
%   sig2inv : estimation of 1/sigma2
%   cvinv   : estimation of 1/cv2
%   S       : estimation of the local sample variance (same size as I)
%   lmu     : estimation of the local sample mean (same size as I)
%

% Based on
%   S. Aja-Fernandez, G. Vegas-Sanchez-Ferrero,
%   M. Martin-Fernandez, C. Alberola-Lopez
%   "Automatic noise estimation in images using local statistics.
%   Additive and multiplicative cases",
%   Image and Vision Computing 27 (2009) 756-770
%
% Legal:
%   estNoise.m is part of the INMD software
%   (http://sites.google.com/a/istec.net/prodrig/Home/sw). INMD is free
%   software, you can redistribute it and/or modify it under the terms of
%   the GNU General Public License (version 2).
%
% Authors
%   Paul Rodriguez    prodrig@pucp.edu.pe

if(nargin < 5)
  zoom = 0;
  if(nargin < 4)
    N = 100;
  end
end

  L=1;
  b = 0.5*( 1 - cos(pi*(0:2*L)/L) );

  [Nrows, Ncols, depth] = size(I);

for d = 1:depth,

  % Local noise estimation
  [S(:,:,d) lmu(:,:,d)] = localnoise_mask(I(:,:,d),w, mask);

  sigma2(d) = estimateMode(S(:,:,d), N, zoom, b, L, w, 0, 1);
  sig2inv(d) = estimateMode(1./S, N, zoom, b, L, w, 1, 1);

  mu(d) = estimateMode(lmu(:,:,d), N, zoom, b, L, w, 0, 1);

  cv(d) = estimateMode(S(:,:,d)./(lmu(:,:,d).*lmu(:,:,d)), N, zoom, b, L, w, 0, 0);
  cvinv(d) = estimateMode((lmu(:,:,d).*lmu(:,:,d))./S(:,:,d), N, zoom, b, L, w, 1, 0);

end

%    sigma2 = estimateMode(S, N, zoom, b, L, w, 0, 1);
%    sig2inv = estimateMode(1./S, N, zoom, b, L, w, 1, 1);
%
%    mu = estimateMode(lmu, N, zoom, b, L, w, 0, 1);
%
%    cv = estimateMode(S./(lmu.*lmu), N, zoom, b, L, w, 0, 0);
%    cvinv = estimateMode((lmu.*lmu)./S, N, zoom, b, L, w, 1, 0);

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

function[sigma2] = estimateMode(S, N, zoom, b, L, w, inv, factor)

v = S(:);

vmin = min(v);
vmax = max(v);
res = (vmax - vmin)/N;

[h bin] = hist(v, N);

if(inv == 1)
  tmp = conv(b, h) / (2*L+1);
  hs = tmp(L:N+L-1);
%    [dummy pos] = max(hs(end:-1:1));
  posvec = findmaxima( hs(end:-1:1) );
  if(length(posvec) >= 1)
    pos = posvec(1);
  else
    [dummy pos] = max(h(end:-1:1));
  end
else
  [dummy pos] = max(h(end:-1:1));
end

if(zoom)

  ind = find( abs( (v - bin(N-pos+1))  ) < 2*res );

  [h bin] = hist(v(ind), N);

  tmp = conv(b, h) / (2*L+1);
  hs = tmp(L:N+L-1);

  maxpos = findmaxima(hs);

  if( length(maxpos) >= 2 )
    sval = bin( maxpos(1) );
  else
    [dummy pos] = max(h(end:-1:1));
    sval = bin(N-pos+1);
  end

else
  sval = bin(N-pos+1);
end

if factor == 1,
  w_size = (2*w + 1)*(2*w + 1);
  sigma2 = (w_size - 3)/(w_size - 1)*sval;
else
  sigma2 = sval;
end

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

function minima = findminima(x)

minima = findmaxima(-x);

function maxima = findmaxima(x)

% Unwrap to vector
x = x(:);
% Identify whether signal is rising or falling
upordown = sign(diff(x));
% Find points where signal is rising before, falling after
maxflags = [upordown(1)<0; diff(upordown)<0; upordown(end)>0];
maxima   = find(maxflags);


function s = allsubs(x)
%ALLSUBS Generate all possible subscripts for a sparse tensor X.
%
%   See also SPTENSOR.
%
%MATLAB Tensor Toolbox.
%Copyright 2012, Sandia Corporation.

% This is the MATLAB Tensor Toolbox by T. Kolda, B. Bader, and others.
% http://www.sandia.gov/~tgkolda/TensorToolbox.
% Copyright (2012) Sandia Corporation. Under the terms of Contract
% DE-AC04-94AL85000, there is a non-exclusive license for use of this
% work by or on behalf of the U.S. Government. Export of this data may
% require a license from the United States Government.
% The full license terms can be found in the file LICENSE.txt

%% Generate all possible indicies

% Preallocate (discover any memory issues here!)
s = zeros(prod(x.size),ndims(x));

% Generate appropriately sized ones vectors.
o = cell(ndims(x),1);
for n = 1:ndims(x)
    o{n} = ones(size(x,n),1);
end

% Generate each column of the subscripts in turn
for n = 1:ndims(x)
    i = o;
    i{n} = (1:size(x,n))';
    s(:,n) = khatrirao(i);
end


function f = flops_spmul(a,b)
% FLOPS_SPMUL    Flops for sparse matrix multiplication.
% FLOPS_SPMUL(a,b) returns the number of flops for a*b, where multiplication
% and addition of zero doesn't count.
% For example:
%   flops_spmul(0,4) is 0.
%   flops_spmul([1 0 1], [2;3;4]) is 3.
%   flops_spmul(eye(3), [2;3;4]) is 3.

nza = (a ~= 0);
nzb = (b ~= 0);
f = nza*nzb;
f = 2*f - (f ~= 0);
f = sum(sum(f));


% Script demonstrating usage of the bpdn function.
%
% Author: Brendt Wohlberg <brendt@lanl.gov>  Modified: 2015-03-05
%
% This file is part of the SPORCO library. Details of the copyright
% and user license can be found in the 'Copyright' and 'License' files
% distributed with the library.

% Signal and dictionary size
N = 512;
M = 4*N;
% Number of non-zero coefficients in generator
L = 32;
% Noise level
sigma = 0.5;

% Construct random dictionary and random sparse coefficients
D = randn(N, M);
x0 = zeros(M, 1);
si = randperm(M);
si = si(1:L);
x0(si) = randn(L, 1);
% Construct reference and noisy signal
s0 = D*x0;
s = s0 + sigma*randn(N,1);

% BPDN for recovery of sparse representation
lambda = 20;
opt = [];
opt.Verbose = 1;
opt.rho = 100;
opt.RelStopTol = 1e-6;
[x1, optinf] = bpdn(D, s, lambda, opt);

figure('position', [100, 100, 1200, 300]);
subplot(1,4,1);
plot(optinf.itstat(:,2));
xlabel('Iterations');
ylabel('Functional value');
subplot(1,4,2);
semilogy(optinf.itstat(:,5));
xlabel('Iterations');
ylabel('Primal residual');
subplot(1,4,3);
semilogy(optinf.itstat(:,6));
xlabel('Iterations');
ylabel('Dual residual');
subplot(1,4,4);
semilogy(optinf.itstat(:,9));
xlabel('Iterations');
ylabel('Penalty parameter');

figure;
plot(x0,'r');
hold on;
plot(x1,'b');
hold off;
legend('Reference', 'Recovered', 'Location', 'SouthEast');
title('Dictionary Coefficients');

% Illustrate restart capability: do 40 iterations and compare with
% 20 iterations and then restart for an additional 20 iterations
opt2 = opt;
opt2.MaxMainIter = 40;
[x2, optinf2] = bpdn(D, s, lambda, opt2);

opt3 = opt2;
opt3.MaxMainIter = 20;
[x3, optinf3] = bpdn(D, s, lambda, opt3);

opt4 = opt3;
opt4.Y0 = optinf3.Y;
opt4.U0 = optinf3.U;
opt4.rho = optinf3.rho;
[x4, optinf4] = bpdn(D, s, lambda, opt4);

figure;
plot(optinf2.itstat(:,1), optinf2.itstat(:,2), 'r');
hold on;
plot(optinf3.itstat(:,1), optinf3.itstat(:,2), 'g');
plot(optinf4.itstat(:,1) + optinf3.itstat(end,1), optinf4.itstat(:,2), 'b');
xlabel('Iterations');
ylabel('Functional value');
legend('Uninterrupted', 'Stop at 20 iterations', 'Restart at 20 iterations');

% Construct ensemble of L-sparse coefficients and corresponding signals
K = 8;
X0 = zeros(M, K);
for l = 1:K,
  si = randperm(M);
  si = si(1:L);
  X0(si,l) = randn(L, 1);
end
S0 = D*X0;
S = S0 + sigma*randn(N, K);

% BPDN for simultaneous recovery of sparse coefficient matrix
lambda = 20;
opt = [];
opt.Verbose = 1;
opt.rho = 100;
opt.RelStopTol = 1e-6;
[X1, optinf] = bpdn(D, S, lambda, opt);

figure;
subplot(1,2,1);
imagesc(X0);
title('Reference');
subplot(1,2,2);
imagesc(X1);
title('Recovered');


function r = reval(zz, zj, fj, wj)
%REVAL   Evaluate rational function in barycentric form.
%   R = REVAL(ZZ, ZJ, FJ, WJ) returns R (vector of floats), the values of the
%   barycentric rational function with support points ZJ, function values FJ,
%   and barycentric weights WJ evaluated at the points ZZ.
%
% See also AAA, MINIMAX, PRZ.

% Copyright 2018 by The University of Oxford and The Chebfun Developers.
% See http://www.chebfun.org/ for Chebfun information.

zv = zz(:);                             % vectorize zz if necessary
CC = 1./bsxfun(@minus, zv, zj.');       % Cauchy matrix
r = (CC*(wj.*fj))./(CC*wj);             % vector of values

% Deal with input inf: r(inf) = lim r(zz) = sum(w.*f) / sum(w):
r(isinf(zv)) = sum(wj.*fj)./sum(wj);

% Deal with NaN:
ii = find(isnan(r));
for jj = 1:length(ii)
    if ( isnan(zv(ii(jj))) || ~any(zv(ii(jj)) == zj) )
        % r(NaN) = NaN is fine.
        % The second case may happen if r(zv(ii)) = 0/0 at some point.
    else
        % Clean up values NaN = inf/inf at support points.
        % Find the corresponding node and set entry to correct value:
        r(ii(jj)) = fj(zv(ii(jj)) == zj);
    end
end

% Reshape to input format:
r = reshape(r, size(zz));

end % End of REVAL().


function [x,varargout] = ZeroToOne(x,varargin)

%ZeroToOne - Normalize values in [0,1].
%
%  USAGE
%
%    [y,b0,b1...] = ZeroToOne(x,a0,a1,...)
%
%    x              array to normalize (vector OR matrix)
%    a0...          additional inputs to transform using the same
%                   scale as x

% Copyright (C) 2008-2011 by Michaël Zugaro, modified GG 2015
%
% 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.

if nargin < 1,
	error('Incorrect number of parameters (type ''help ZeroToOne'' for details).');
end

if nargin ~= nargout,
	error('Different numbers of input and output parameters (type ''help ZeroToOne'' for details).');
end

if isvector(x)
    m = min(x);
    M = max(x);
    x = (x-m)/(M-m);
elseif ismatrix(x)
    m = min(min(x));
    M = max(max(x));
    x = (x-m)./(M-m);
end

for i = 1:nargin-1,
	varargout{i} = (varargin{i}-m)/(M-m);
end


function [c,l] = fix_wavedec(x,n)
% Does a haar wavelet decomposition with n scales.
% Avoids using wavelet toolbox

Lo_D = [ 0.7071 0.7071];
Hi_D = [-0.7071 0.7071];

s = size(x); x = x(:)';
c = [];
l = [length(x)];

dwtEXTM = 'sym';
shift = 0;

for k = 1:n
    lf = length(Lo_D);
    lx = length(x);
    lenEXT = lf-1; lenKEPT = lx+lf-1;

    I = getSymIndices(lx,1);
    y  = x(I);

    x = convdown(y,Lo_D,lenKEPT,shift);
    d = convdown(y,Hi_D,lenKEPT,shift);

    c     = [d c];            % store detail
    l     = [length(d) l];    % store length
end

% Last approximation.
c = [x c];
l = [length(x) l];

if s(1)>1, c = c'; l = l'; end

%-----------------------------------------------------%
% Internal Function(s)
%-----------------------------------------------------%
function y = convdown(x,f,lenKEPT,shift)

y = conv2(x(:)',f(:)'); if size(x,1)>1 , y = y'; end

sx = length(y);
begInd = 1;
[first,last,ok] = GetFirstLast(sx,begInd,lenKEPT);
if ok , y = y(first(1):last(1)); end

y = y(2-rem(shift,2):2:end);

%-----------------------------------------------------%
%----------------------------------------------------------------------------%
function I = getSymIndices(lx,lf)

I = [lf:-1:1 , 1:lx , lx:-1:lx-lf+1];
if lx<lf
    K = (I<1);
    I(K) = 1-I(K);
    J = (I>lx);
    while any(J)
        I(J) = 2*lx+1-I(J);
        K = (I<1);
        I(K) = 1-I(K);
        J = (I>lx);
    end
end
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
function [first,last,ok] = GetFirstLast(sx,begInd,varargin)

oneDIM = isequal(begInd,1);
s = varargin{1}(:)';
if ~oneDIM
    K  = find(s>sx);
    s(K) = sx(K);
    m = find((s < 0) | (s ~= fix(s)));
    ok = isempty(m);
else
    ok = (s>=0) & (s<sx) & (s == fix(s));
end
if ok==0 , first = begInd; last = s; return; end

nbarg = length(varargin);
if nbarg<2, o = 'c'; else , o = lower(varargin{2}); end

err = 0;
if ischar(o(1))
    switch o(1)
        case 'c'
            d = (sx-s)/2;
            if nbarg<3
                if length(o)>1 , side = o(2:end); else , side = 'l'; end
            else
                side = varargin{3};
            end
            if oneDIM
                [first,last] = GetFirst1D(side,sx,d);
            else
                if length(side)<2 , side(2) = 0; end
                for k = 1:2
                    [first(k),last(k)] = GetFirst1D(side(k),sx(k),d(k));
                end
            end

        case {'l','u'} , first = begInd; last = s;
        case {'r','d'} , first = sx-s+1; last = sx;
        otherwise      , err = 1;
    end
else
    first = o; last = first+s-1;
    if ~isequal(first,fix(first)) | any(first<1) | any(last>sx)
        err = 1;
    end
end
if err
    errargt(mfilename,'invalid argument','msg');
    error('*');
end
%----------------------------------------------------------------------------%
function [first,last] = GetFirst1D(side,s,d)

switch side
  case {'u','l','0',0} , first = 1+floor(d); last = s-ceil(d);
  case {'d','r','1',1} , first = 1+ceil(d);  last = s-floor(d);
  otherwise    , first = 1+floor(d); last = s-ceil(d);  % Default is left side
end
%----------------------------------------------------------------------------%


function newval=meshremap(fromval,elemid,elembary,toelem,nodeto)
%
% newval=meshremap(fromval,elemid,elembary,toelem,nodeto)
%
% Redistribute nodal values from the source mesh to the target mesh so that
% the sum of each property on each mesh is the same
%
% author: Qianqian Fang (q.fang at neu.edu)
%
% input:
%	 fromval: values defined at the source mesh nodes, the row or column
%	          number must be the same as the source mesh node number, which
%	          is the same as the elemid length
%	 elemid: the IDs of the target mesh element that encloses the nodes of
%            the source mesh nodes; a vector of length of src mesh node
%            count; elemid and elembary can be generated by calling
%
%           [elemid,elembary]=tsearchn(node_target, elem_target, node_src);
%
%           note that the mapping here is inverse to that in meshinterp()
%
%	 elembary: the bary-centric coordinates of each source mesh nodes
%	         within the target mesh elements, sum of each row is 1, expect
%	         3 or 4 columns (or can be N-D)
%    toelem: the element list of the target mesh
%    nodeto: the total number of target mesh nodes
%
%
% output:
%	 newval: a 2D array with rows equal to the target mesh nodes (nodeto),
%            and columns equals to the value numbers defined at each source
%            mesh node
% example:
%
%    [n1,f1,e1]=meshabox([0 0 0],[10 20 5],1); % src mesh
%    [n2,f2,e2]=meshabox([0 0 0],[10 20 5],2); % target mesh
%    [id, ww]=tsearchn(n2,e2,n1);              % project src to target mesh
%    value_src=n1(:,[2 3 1]);             % create dummy values at src mesh
%    newval=meshremap(value_src,id,ww,e2,size(n2,1)); % map to target
%
% -- this function is part of iso2mesh toolbox (http://iso2mesh.sf.net)
%

if(size(fromval,1)==1)
    fromval=fromval(:);
end

if(size(fromval,2)==length(elemid))
    fromval=fromval.';
end

newval=zeros(nodeto,size(fromval,2));

idx=~isnan(elemid);
fromval=fromval(idx,:);
elembary=elembary(idx,:);
idx=elemid(idx);

nodeval=repmat(fromval,[1,1,size(elembary,2)]).*repmat(permute(elembary,[1,3,2]),[1,size(fromval,2),1]);

for i=1:size(elembary,2)
    [ix,iy]=meshgrid(toelem(idx,i),1:size(fromval,2));
    nval=nodeval(:,:,i).';
    newval=newval + accumarray([ix(:),iy(:)],nval(:), size(newval));
end


function f = flops_solve_tri(T,b,c)
% FLOPS_SOLVE_TRI   Flops for triangular left division.
% FLOPS_SOLVE_TRI(T,b) returns the number of flops for solve_tri(T,b).
% FLOPS_SOLVE_TRI(n,n,m) returns the number of flops for
% solve_tri(eye(n),ones(n,m)).

if nargin == 2
  f = flops_solve_tri(rows(T),cols(T),cols(b));
  return;
end
% number of multiplies+adds is
% sum(i=1..n) sum(k=i-1..1) 2 = sum(i=1..n) 2*(i-1) = n^2-n
% number of divides is n
f = (T*b + b*(flops_div-1))*c;


function [ a_lu, info ] = r8cbb_fa ( n1, n2, ml, mu, a )

%*****************************************************************************80
%
%% R8CBB_FA factors a R8CBB matrix.
%
%  Discussion:
%
%    Note that in C++ and FORTRAN, we can look at A as an abstract
%    vector, but then look at parts of A as storing a two dimensional
%    array.  MATLAB assigns an inherent dimensionality to a data object,
%    and gets very unhappy when you try to manipulate the data yourself.
%    This means that the MATLAB implementation of this routine requires
%    the use of temporary 2D arrays.
%
%    The R8CBB storage format is for a compressed border banded matrix.
%    Such a matrix has the logical form:
%
%      A1 | A2
%      ---+---
%      A3 | A4
%
%    with A1 a (usually large) N1 by N1 banded matrix, while A2, A3 and A4
%    are dense rectangular matrices of orders N1 by N2, N2 by N1, and N2 by N2,
%    respectively.
%
%    The R8CBB format is the same as the DBB format, except that the banded
%    matrix A1 is stored in compressed band form rather than standard
%    banded form.  In other words, we do not include the extra room
%    set aside for fill in during pivoting.
%
%    A should be defined as a vector.  The user must then store
%    the entries of the four blocks of the matrix into the vector A.
%    Each block is stored by columns.
%
%    A1, the banded portion of the matrix, is stored in
%    the first (ML+MU+1)*N1 entries of A, using the obvious variant
%    of the LINPACK general band format.
%
%    The following formulas should be used to determine how to store
%    the entry corresponding to row I and column J in the original matrix:
%
%    Entries of A1:
%
%      1 <= I <= N1, 1 <= J <= N1, (J-I) <= MU and (I-J) <= ML.
%
%      Store the I, J entry into location
%      (I-J+MU+1)+(J-1)*(ML+MU+1).
%
%    Entries of A2:
%
%      1 <= I <= N1, N1+1 <= J <= N1+N2.
%
%      Store the I, J entry into location
%      (ML+MU+1)*N1+(J-N1-1)*N1+I.
%
%    Entries of A3:
%
%      N1+1 <= I <= N1+N2, 1 <= J <= N1.
%
%      Store the I, J entry into location
%      (ML+MU+1)*N1+N1*N2+(J-1)*N2+(I-N1).
%
%    Entries of A4:
%
%      N1+1 <= I <= N1+N2, N1+1 <= J <= N1+N2
%
%      Store the I, J entry into location
%      (ML+MU+1)*N1+N1*N2+(J-1)*N2+(I-N1).
%      (same formula used for A3).
%
%
%    Once the matrix has been factored by R8CBB_FA, R8CBB_SL may be called
%    to solve linear systems involving the matrix.
%
%    R8CBB_FA uses special non-pivoting versions of LINPACK routines to
%    carry out the factorization.  The special version of the banded
%    LINPACK solver also results in a space saving, since no entries
%    need be set aside for fill in due to pivoting.
%
%    The linear system must be border banded, of the form:
%
%      ( A1 A2 ) (X1) = (B1)
%      ( A3 A4 ) (X2)   (B2)
%
%    where A1 is a (usually big) banded square matrix, A2 and A3 are
%    column and row strips which may be nonzero, and A4 is a dense
%    square matrix.
%
%    The algorithm rewrites the system as:
%
%         X1 + inverse(A1) A2 X2 = inverse(A1) B1
%
%      A3 X1 +             A4 X2 = B2
%
%    and then rewrites the second equation as
%
%      ( A4 - A3 inverse(A1) A2 ) X2 = B2 - A3 inverse(A1) B1
%
%    The algorithm will certainly fail if the matrix A1 is singular,
%    or requires pivoting.  The algorithm will also fail if the A4 matrix,
%    as modified during the process, is singular, or requires pivoting.
%    All these possibilities are in addition to the failure that will
%    if the total matrix A is singular.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    24 March 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N1, N2, the order of the banded and dense blocks.
%    N1 and N2 must be nonnegative, and at least one must be positive.
%
%    Input, integer ML, MU, the lower and upper bandwidths.
%    ML and MU must be nonnegative, and no greater than N1-1.
%
%    Input, real A( (ML+MU+1)*N1 + 2*N1*N2 + N2*N2), the compact
%    border-banded coefficient matrix.
%
%    Output, real A_LU( (ML+MU+1)*N1 + 2*N1*N2 + N2*N2).
%    information describing a partial factorization
%    of the original coefficient matrix.
%
%    Output, integer INFO, singularity flag.
%    0, no singularity detected.
%    nonzero, the factorization failed on the INFO-th step.
%
  nband = (ml+mu+1)*n1;

  a_lu(1:nband+2*n1*n2+n2*n2) = a(1:nband+2*n1*n2+n2*n2);
%
%  Factor the A1 band matrix, overwriting A1 by its factors.
%
  if ( 0 < n1 )

    a1(1:ml+mu+1,1:n1) = r8vec_to_r8cb ( n1, n1, ml, mu, a(1:nband) );

    [ a1_lu, info ] = r8cb_np_fa ( n1, ml, mu, a1 );

    if ( info ~= 0 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'R8CBB_FA - Fatal error!\n' );
      fprintf ( 1, '  R8CB_NP_FA returned INFO = %d\n', info );
      fprintf ( 1, '  Factoring failed for column INFO.\n' );
      fprintf ( 1, '  The band matrix A1 is singular.\n' );
      fprintf ( 1, '  This algorithm cannot continue!\n' );
      error ( 'R8CBB_FA - Fatal error!' );
    end

    a_lu(1:nband) = r8cb_to_r8vec ( n1, n1, ml, mu, a1_lu );

  end

  if ( 0 < n1 & 0 < n2 )
%
%  Set A2 := -inverse(A1) * A2.
%
    job = 0;

    for j = 1 : n2
      b2(1:n1) = -a(nband+(j-1)*n1+1:nband+(j-1)*n1+n1);
      x2 = r8cb_np_sl ( n1, ml, mu, a1_lu, b2, job );
      a_lu(nband+(j-1)*n1+1:nband+(j-1)*n1+n1) = x2(1:n1);
    end
%
%  Set A4 := A4 + A3*A2
%
    for i = 1 : n2
      for j = 1 : n1
        ij = nband + n1*n2 + (j-1)*n2 + i;
        for k = 1 : n2
          ik = nband + 2*n1*n2 + (k-1)*n2 + i;
          jk = nband + (k-1)*n1 + j;
          a_lu(ik) = a_lu(ik) + a_lu(ij) * a_lu(jk);
        end
      end
    end

  end
%
%  Factor A4.
%
  if ( 0 < n2 )

    a4 = r8vec_to_r8ge ( n2, n2, a_lu(nband+2*n1*n2+1:nband+2*n1*n2+n2*n2) );

    [ a4_lu, info ] = r8ge_np_fa ( n2, a4 );

    if ( info ~= 0 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'R8CBB_FA - Fatal error!\n' );
      fprintf ( 1, '  R8GE_NP_FA returned INFO = %d\n',info );
      fprintf ( 1, '  This indicates singularity in column INFO\n' );
      info = n1 + info;
      fprintf ( 1, '  of the A4 submatrix, which is column %d\n', info );
      fprintf ( 1, '  of the full matrix.\n' );
      fprintf ( 1, '\n' );
      fprintf ( 1, '  It is possible that the full matrix is \n' );
      fprintf ( 1, '  nonsingular, but the algorithm R8CBB_FA may\n' );
      fprintf ( 1, '  not be used for this matrix.\n' );
      return
    end

    a_lu(nband+2*n1*n2+1:nband+2*n1*n2+n2*n2) = r8ge_to_r8vec ( n2, n2, a4_lu );

  end

  return
end


% Script to test INSIDEPOLY

n = 3e2; % number of points
m = 5; % number of vertices

xv = zeros(m,1);
yv = zeros(m,1);

fprintf('Use the mouse and enter %d points of the polygonal\n', m);

figure;
axis equal
axis([0 1 0 1]);
hold on
k = 1;
while k<=m
    [xv(k) yv(k)] = ginput(1);
    if k>1
        plot(xv(k+[-1 0]),yv(k+[-1 0]),'-r');
    else
        plot(xv(1),yv(1),'.r');
    end
    axis([0 1 0 1]);
    k = k+1;
end
plot(xv([end 1]),yv([end 1]),'-r');

x = rand(n,1);
y = rand(n,1);

% xv = [-1 -1 1 1];
% yv = [-1 1 1 -1];
% x=linspace(-2,2,33);
% y=linspace(-2,2,33);
% [x y]=meshgrid(x,y);

in = insidepoly(x, y, xv, yv);

plot(xv([1:end 1]),yv([1:end 1]),'-r');
linestyle={'b.' 'ro'};
hold on
for k=1:numel(x)
    plot(x(k),y(k),linestyle{in(k)+1});
end
drawnow;

%% benchmark
%t = benchinpoly(xv, yv, 100);


clear all; close all; clc

% training & testing set sizes
n1=100;  % training set size
n2=50;   % test set size

% random ellipse 1 centered at (0,0)
x=randn(n1+n2,1)-2;
y=0.5*randn(n1+n2,1);

x5=2*randn(n1+n2,1)+1;
y5=0.5*randn(n1+n2,1);

% random ellipse 2 centered at (1,-2)
x2=randn(n1+n2,1)+2;
y2=0.2*randn(n1+n2,1)-2;

% rotate ellipse 2 by theta
theta=pi/4;
A=[cos(theta) -sin(theta); sin(theta) cos(theta)];
x3=A(1,1)*x2+A(1,2)*y2;
y3=A(2,1)*x2+A(2,2)*y2;

subplot(2,2,1)
plot(x(1:n1),y(1:n1),'ro','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.8 0.8 0.8],...
                'MarkerSize',8), hold on   % [0.49 1 .63]
plot(x3(1:n1),y3(1:n1),'bo','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.8 0.8 0.8],...
                'MarkerSize',8)
axis([-6 6 -2 2]), set(gca,'Fontsize',[14])

subplot(2,2,2)
plot(x(1:70),y(1:70),'ro','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.8 0.8 0.8],...
                'MarkerSize',8), hold on   % [0.49 1 .63]
plot(x3(1:70),y3(1:70),'bo','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.8 0.8 0.8],...
                'MarkerSize',8)
plot(x(71:100),y(71:100),'ro','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0 1 0.2],...
                'MarkerSize',8), hold on   % [0.49 1 .63]
plot(x3(71:100),y3(71:100),'bo','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.9 0 1],...
                'MarkerSize',8)
axis([-6 6 -2 2]), set(gca,'Fontsize',[14])

subplot(2,2,3)
plot(x5(1:n1),y5(1:n1),'ro','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.8 0.8 0.8],...
                'MarkerSize',8), hold on   % [0.49 1 .63]
plot(x3(1:n1),y3(1:n1),'bo','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.8 0.8 0.8],...
                'MarkerSize',8)
axis([-6 6 -2 2]), set(gca,'Fontsize',[14])

subplot(2,2,4)
plot(x5(1:70),y5(1:70),'ro','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.8 0.8 0.8],...
                'MarkerSize',8), hold on   % [0.49 1 .63]
plot(x3(1:70),y3(1:70),'bo','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.8 0.8 0.8],...
                'MarkerSize',8)
plot(x5(71:100),y5(71:100),'ro','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0 1 0.2],...
                'MarkerSize',8), hold on   % [0.49 1 .63]
plot(x3(71:100),y3(71:100),'bo','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.9 0 1],...
                'MarkerSize',8)
axis([-6 6 -2 2]), set(gca,'Fontsize',[14])

%%
figure(2)
% random ellipse 1 centered at (0,0)
subplot(2,2,1)
n1=300;  % training set size
x1=1.5*randn(n1,1)-1.5;
y1=1.2*randn(n1,1)+(x1+1.5).^2-7;
x2=1.5*randn(n1,1)+1.5;
y2=1.2*randn(n1,1)-(x2-1.5).^2+7;

plot(x1,y1,'ro','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0 1 0.2],...
                'MarkerSize',8), hold on
plot(x2,y2,'ro','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.9 0 1],...
                'MarkerSize',8)
axis([-6 6 -12 12]), set(gca,'Fontsize',[14])

subplot(2,2,2)
r=7+randn(n1,1);
th=2*pi*rand(n1,1);
xr=r.*cos(th);
yr=r.*sin(th);
x5=randn(n1,1);
y5=randn(n1,1);
plot(xr,yr,'ro','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0 1 0.2],...
                'MarkerSize',8), hold on
plot(x5,y5,'ro','Linewidth',[1],'MarkerEdgeColor','k',...
                'MarkerFaceColor',[0.9 0 1],...
                'MarkerSize',8)
axis([-10 10 -10 10]), set(gca,'Fontsize',[14])


classdef RankAwareOMP < handle
    % Implements Rank Aware OMP algorithm for sparse approximation in MMV case

    properties
        % Maximum residual norm
        MaxResNorm = 1e-4
        % Indicates if we should stop on exceeding residual norm
        StopOnResidualNorm = true
        % Indicates if we should stop when residual norm stops improving
        StopOnResNormStable = true
        % Maximum number of iterations for approximation
        MaxIters
        % Indicates if log messages should be printed at each iteration
        Verbose = false
        % Minimum Sparsity
        MinK = 4
        % Ignored atom (which won't be considered in identification step)
        IgnoredAtom = -1
        % The norm to be chosen for rows
        P
    end

    properties(SetAccess=private)
        % The dictionary
        Dict
        % Ambient signal dimensions
        N
        % Number of atoms in dictionary
        D
        % Sparsity level of representations (may be negative)
        K
        % Result of a solver
        result
    end

    methods
        function self  = RankAwareOMP(Dict, K)
            % We assume that all the columns in dictionary are normalized.
            if isa(Dict, 'spx.dict.Operator')
                self.Dict = Dict;
            elseif ismatrix(Dict)
                self.Dict = spx.dict.MatrixOperator(Dict);
            else
                error('Unsupported operator.');
            end
            [self.N, self.D] = size(Dict);
            if ~exist('K', 'var')
                % No sparsity level has been pre-specified.
                K = -1;
            end
            self.K = K;
            % Maximum number of iterations
            maxIter = self.N;
            if K > 0
                % We have to consider pre-specified sparsity level
                maxIter = K;
            end
            self.MaxIters = maxIter;
            if K > 0 && self.MinK >= K
                self.MinK = 0;
            end
        end

        function result  = solve(self, Y)
            % Initialization
            % Solves approximation problem using OMP
            d = self.D;
            n = self.N;
            % The number of signals being approximated.
            s = size(Y, 2);
            % Initial residual
            R = Y;
            dict = self.Dict;
            % Active indices
            omega = [];
            % Estimate
            Z = zeros(d, s);
            if self.StopOnResNormStable
                oldResNorm = norm(R, 'fro');
            end
            maxIter = self.MaxIters;
            P = self.P;
            for iter=1:maxIter
                % Orthonormalize Residual
                U = orth(R); % R is n x s. U is n x r.
                % Compute inner products (DxN  * N x r = D x r )
                innerProducts = apply_ctranspose(dict, U);
                % Compute absolute values of inner products
                innerProducts = abs(innerProducts);
                % Compute l2 norm inner products over each row
                innerProducts = spx.norm.norms_l2_rw(innerProducts);
                % Mark the inner products of already selected columns as 0.
                innerProducts(omega) = 0;
                % Find the highest inner product
                [~, index] = max(innerProducts);
                % Add this index to support
                omega = [omega, index];
                % Solve least squares problem
                subdict = columns(dict, omega);
                tmp = linsolve(subdict, Y);
                % Updated solution
                Z(omega, :) = tmp;
                % Let us update the residual.
                R = Y - dict.apply(Z);
                resNorm = norm(R, 'fro');
                if self.StopOnResidualNorm || self.StopOnResNormStable
                    if resNorm < self.MaxResNorm
                        break;
                    end
                    if self.StopOnResNormStable
                        change = abs(oldResNorm  - resNorm);
                        if change/oldResNorm < .01
                            % No improvement
                            break;
                        end
                    end
                end
            end

            % Solution vector
            result.Z = Z;
            % Residual obtained
            result.R = R;
            % Number of iterations
            result.iterations = iter;
            % Solution support
            result.support = omega;
            % residual Frobenius norm
            result.residual_frobenius_norm = resNorm;
            self.result = result;
        end

    end
end


function[lat,lon]=uv2latlon(varargin)
%UV2LATLON  Integrates horizontal velocity to give latitude and longitude.
%
%   [LAT,LON]=UV2LATLON(NUM,U,V,LATO,LONO) where NUM is the data in DATENUM
%   format, integates velocities U and V from intial location (LATO,LONO)
%   to form a trajectory on the earth described by LAT and LON.
%
%   LATO and LONO are an initial latitude and longitude in degrees,
%   and U and V are eastward and northward velocity components in cm/s.
%
%   NUM, U, and V may be column vectors, in which case LATO and LONO are
%   both scalars.  Alternatively U and V may be matrices with time oriented
%   in rows.  NUM is then either an array of length SIZE(U,1), or a matrix
%   of the same size as U and V, while LATO and LONO are either scalars or
%   arrays of length SIZE(U,2).
%
%   [LAT,LON]=UV2LATLON(NUM,CV,LATO,LONO), where CV is the complex-valued
%   velocity CV=U+SQRT(-1)*V, also works.
%
%   UV2LATLON is inverted by LATLON2UV.
%   ___________________________________________________________________
%
%   Cell array input / output
%
%   UV2LATLON returns cell array output given cell array input.
%
%   That is, if NUM, U, and V, are all cell arrays of length K, containing
%   K different numerical arrays, then the output will also be cell arrays
%   of length K.
%
%   In this case LATO and LONO are either scalars, or arrays of length K.
%   ___________________________________________________________________
%
%   Algorithm
%
%   UV2LATLON works by converting the velocity at the current point into
%   a vector in 3D Cartesian coordinates, using SPHERE2UVW, finding the new
%   location in 3D space, and then converting this back into latitude
%   and longitude using XYZ2LATLON, and then interating for the next point.
%
%   By default, UV2LATLON uses a forward integration from an initial point.
%   This inverts LATLON2UV(...,'forward') to a high degree of precision for
%   typical drifter and float velocity values and sampling intervals.
%
%   UV2LATLON(NUM,CV,LATF,LONF,'backward') instead uses a *backward*
%   integration, and LATF and LONF are now the *final* points rather than
%   the initial points.  This inverts LATLON2UV(...,'backward').
%   ___________________________________________________________________
%
%   See also XY2LATLON, LATLON2XY, LATLON2UV.
%
%   'uv2latlon --t' runs a test.
%
%   Usage: [lat,lon]=uv2latlon(num,u,v,lato,lono);
%   __________________________________________________________________
%   This is part of JLAB --- type 'help jlab' for more information
%   (C) 2014 J.M. Lilly --- type 'help jlab_license' for details

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

if ischar(varargin{end})
    str=varargin{end};
    varargin=varargin(1:end-1);
else
    str='forward';
end

na=length(varargin);
num=varargin{1};
if na==4
    if iscell(varargin{2})
        u=cellreal(varargin{2});
        v=cellimag(varargin{2});
    else
        u=real(varargin{2});
        v=imag(varargin{2});
    end
    varargin=varargin(3:end);
else
    u=varargin{2};
    v=varargin{3};
    varargin=varargin(4:end);
end
lato=varargin{1};
lono=varargin{2};

if ~iscell(num)
    if ~aresame(size(num),size(u))
        num=vrep(num(:),size(u,2),2);
    end
    if length(lato)==1
        lato=lato+zeros(size(u(1,:)));
    end
    if length(lono)==1
        lono=lono+zeros(size(u(1,:)));
    end
    %vsize(num,lato,lono,u,v)
    [lat,lon]=uv2latlon_one(num,lato,lono,u,v,str);
else
    if length(lato)==1
        lato=lato+zeros(size(u));
    end
    if length(lono)==1
        lono=lono+zeros(size(u));
    end
    for i=1:length(num)
        [lat{i,1},lon{i,1}]=uv2latlon_one(num{i},lato(i),lono(i),u{i},v{i},str);
    end
end

function[lat,lon]=uv2latlon_one(num,lato,lono,u,v,str)

switch str(1:3)
    case 'for'
        [lat,lon]=uv2latlon_integrator(num,lato,lono,u,v);
    case 'bac'
        [lat,lon]=uv2latlon_integrator(num,lato,lono,-flipud(u),-flipud(v));
        lat=flipud(lat);
        lon=flipud(lon);
%     case 'cen'
%         [lat1,lon1]=uv2latlon_integrator(num,lato(1),lono(1),u,v);
%         [lat2,lon2]=uv2latlon_integrator(num,lato(2),lono(2),-flipud(u),-flipud(v));
%         lat2=flipud(lat2);
%         lon2=flipud(lon2);
%         [x1,y1,z1]=latlon2xyz(lat1,lon1);
%         [x2,y2,z2]=latlon2xyz(lat2,lon2);
%         [lat,lon]=xyz2latlon((x1+x2)/2,(y1+y2)/2,(z1+z2)/2);
end

function[lat,lon]=uv2latlon_integrator(num,lato,lono,u,v)

dt=num(2)-num(1);
[xo,yo,zo]=latlon2xyz(lato,lono);
[lat,lon]=vzeros(size(u));
lat(1,:)=lato;
lon(1,:)=lono;

u=u(1:end-1,:);
v=v(1:end-1,:);

% if strcmpi(str(1:3),'for')
%     u=u(1:end-1,:);
%     u=u(1:end-1,:);
% elseif strcmpi(str(1:3),'for')
%     u=u(1:end-1,:);
%     u=u(1:end-1,:);
%
% u=1/2*(u+circshift(u,-1));
% u=u(1:end-1,:);
%
% v=1/2*(v+circshift(v,-1));
% v=v(1:end-1,:);

u=u*(dt*24*3600)/100/1000;%Now it's km
v=v*(dt*24*3600)/100/1000;%Now it's km

%vsize(lat,lon,u,v)
for i=1:size(u,1)
    [dx,dy,dz]=sphere2uvw(lat(i,:),lon(i,:),0,u(i,:),v(i,:));
    xo=xo+dx;
    yo=yo+dy;
    zo=zo+dz;
    [lat(i+1,:),lon(i+1,:)]=xyz2latlon(xo,yo,zo);
end

function[]=uv2latlon_test
load npg2006

use npg2006
vindex(num,lat,lon,1:max(find(~isnan(lat))),1);
cv=latlon2uv(num,lat,lon,'forward');
[lat2,lon2]=uv2latlon(num,cv,lat(1),lon(1),'forward');

bool1=allall(abs(frac(lon-lon2,lon))<5e-6);
bool2=allall(abs(frac(lat-lat2,lat))<5e-6);
reporttest('UV2LATLON inverts LATLON2UV to within 5e-6 for NPG2006 data, forward algorithm',bool1&&bool2)

[lat2,lon2]=uv2latlon([num num],[cv cv],[lat(1) lat(1)],[lon(1) lon(1)],'forward');
bool1=allall(abs(frac([lon lon]-lon2,[lon lon]))<5e-6);
bool2=allall(abs(frac([lat lat]-lat2,[lat lat]))<5e-6);
reporttest('UV2LATLON inverts LATLON2UV to within 5e-6 for NPG2006 data, forward algorithm, matrix input',bool1&&bool2)

use npg2006
vindex(num,lat,lon,1:max(find(~isnan(lat))),1);
cv=latlon2uv(num,lat,lon,'backward');
[lat3,lon3]=uv2latlon(num,cv,lat(end),lon(end),'backward');

bool1=allall(abs(frac(lon-lon3,lon))<5e-6);
bool2=allall(abs(frac(lat-lat3,lat))<5e-6);
reporttest('UV2LATLON inverts LATLON2UV to within 5e-6 for NPG2006 data, backward algorithm',bool1&&bool2)

% use npg2006
% vindex(num,lat,lon,1:max(find(~isnan(lat))),1);
% cv=latlon2uv(num,lat,lon);
% [lat4,lon4]=uv2latlon(num,cv,[lat(1) lat(end)],[lon(1) lon(end)],'central');
%
% bool1=allall(abs(frac(lon-lon4,lon))<5e-6);
% bool2=allall(abs(frac(lat-lat4,lat))<5e-6);
% reporttest('UV2LATLON inverts LATLON2UV to within 5e-6 for NPG2006 data, central algorithm',bool1&&bool2)


function [C, L] = wave_cross_cov(X, Y, LMAX)
%%
%% Compute wavelet cross-correlations for arbitrary lag
%% -----------------------------------------------------------------------
%% Input: X     Matrix containing wavelet coefficients with appropriate
%%              boundary condition
%%        Y     Matrix containing wavelet coefficients with appropriate
%%              boundary condition
%%        LMAX  Maximum lag to compute
%%
%% Output: C  Matrix containing the wavelet cross-correlation (same
%%            number of columns as X and Y)
%%         L  Vector of lags (for plotting)
%%
[I J] = size(X);
L = (-LMAX+1):(LMAX-1);

XYCrossCov = []; C = [];
for j = 1:J
  XNaN = X(~isnan(X(:,j)),j)';
  ZNaN = XNaN;
  YNaN = Y(~isnan(Y(:,j)),j)';
  NX = length(XNaN);
  NXX = min(length(XNaN) - 1, LMAX);
  XNaNVar = mean(XNaN.^2);
  YNaNVar = mean(YNaN.^2);

  LAG1 = []; LAG2 = [];
  for i = 1:NXX
    XYNaN = XNaN .* YNaN;
    ZYNaN = ZNaN .* YNaN;
    LAG1 = [LAG1 sum(XYNaN(~isnan(XYNaN))) / sqrt(XNaNVar * YNaNVar) / NX];
    LAG2 = [LAG2 sum(ZYNaN(~isnan(ZYNaN))) / sqrt(XNaNVar * YNaNVar) / NX];
    XNaN = [XNaN(2:NX) NaN];
    ZNaN = [NaN ZNaN(1:(NX-1))];
  end
  XYCrossCov = [fliplr(LAG2) LAG1(2:LMAX)];
  C = [C XYCrossCov'];
end


function [kcal] = Nm2kcal(Nm)
% Convert energy or work from newton-meters to kilocalories.
% Chad A. Greene 2012
kcal = Nm*0.00023884589663;


function y = daub6_scale ( n, x )

%*****************************************************************************80
%
%% DAUB6_SCALE recursively evaluates the DAUB6 scaling function.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    31 July 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the recursion level.
%
%    Input, real X, the point at which the function is to be evaluated.
%
%    Output, real Y, the estimated value of the function.
%
  c = [  0.3326705529500826E+00; ...
         0.8068915093110925E+00; ...
         0.4598775021184915E+00; ...
       - 0.1350110200102545E+00; ...
       - 0.08544127388202666E+00; ...
         0.03522629188570953E+00 ];

  c = c * sqrt ( 2.0 );

  if ( 0 < n )
    y = c(1) * daub6_scale ( n - 1, 2 * x     ) ...
      + c(2) * daub6_scale ( n - 1, 2 * x - 1 ) ...
      + c(3) * daub6_scale ( n - 1, 2 * x - 2 ) ...
      + c(4) * daub6_scale ( n - 1, 2 * x - 3 ) ...
      + c(5) * daub6_scale ( n - 1, 2 * x - 4 ) ...
      + c(6) * daub6_scale ( n - 1, 2 * x - 5 );
  else
    y = ( 0 <= x & x < 1 );
  end

  return
end


function ccvt_reflect ( )

%*****************************************************************************80
%
%% CCVT_REFLECT generates and animates a CVT dataset.
%
%  Discussion:
%
%    This program is meant to be used interactively.  It's also
%    possible to prepare a simple input file beforehand and use it
%    in batch mode.
%
%    The program requests input values from the user:
%
%    * NDIM, the spatial dimension,
%    * N, the number of points to generate,
%    * SEED, a seed to use for random number generation;
%    * INIT, initialize the points:
%      ** file, by reading data from file;
%      ** 'GRID', picking points from a grid;
%      ** 'HALTON', from a Halton sequence;
%      ** 'RAND', using MATLAB's RAND function;
%      ** 'UNIFORM', using a simple uniform RNG;
%    * IT_MAX, the maximum number of iterations;
%    * IT_FIXED, the number of iterative steps to take
%      using a fixed set of sampling points.
%    * SAMPLE, how to conduct the sampling:
%      ** 'GRID', picking points from a grid;
%      ** 'HALTON', from a Halton sequence;
%      ** 'RAND', using MATLAB's RAND function;
%      ** 'UNIFORM', using a simple uniform RNG;
%    * SAMPLE_NUM, the number of sampling points;
%    * BATCH, the number of sampling points to create at one time;
%    * OUTPUT, a file into which the data can be stored.
%
%    To indicate that no further computations are desired, it is
%    enough to input a nonsensical value, such as -1.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    08 December 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Qiang Du, Vance Faber, and Max Gunzburger,
%    Centroidal Voronoi Tessellations: Applications and Algorithms,
%    SIAM Review, Volume 41, 1999, pages 637-676.
%
  DEBUG = 1;

  timestamp ( );

  fprintf ( 1, '\n' );
  fprintf ( 1, 'CCVT_REFLECT\n' );
  fprintf ( 1,   MATLAB version\n' );
  fprintf ( 1, '  Generate and animate a CVT dataset.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  This program is meant to be used interactively.\n' );
  fprintf ( 1, '  It is also possible to prepare a simple input \n' );
  fprintf ( 1, '  file beforehand and use it in batch mode.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The program requests input values from the user:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  * NDIM, the spatial dimension,\n' );
  fprintf ( 1, '  * N, the number of points to generate,\n' );
  fprintf ( 1, '  * SEED, a seed to use for random number generation,\n' );
  fprintf ( 1, '  * INIT, initialize the points:\n' );
  fprintf ( 1, '    ** file, read data from a file;\n' );
  fprintf ( 1, '    ** ''GRID'', by picking points from a grid;\n' );
  fprintf ( 1, '    ** ''HALTON'', from a Halton sequence;\n' );
  fprintf ( 1, '    ** ''RAND'', using MATLAB''s RAND function;\n' );
  fprintf ( 1, '    ** ''UNIFORM'', using a simple uniform RNG;\n' );
  fprintf ( 1, '  * IT_MAX, the maximum number of iterations.\n' );
  fprintf ( 1, '  * IT_FIXED, the number of iterative steps to take\n' );
  fprintf ( 1, '    using a fixed set of sampling points.\n' );
  fprintf ( 1, '  * SAMPLE, how to conduct the sampling.\n' );
  fprintf ( 1, '    ** ''GRID'', by picking points from a grid;\n' );
  fprintf ( 1, '    ** ''HALTON'', from a Halton sequence;\n' );
  fprintf ( 1, '    ** ''RAND'', using MATLAB''s RAND function;\n' );
  fprintf ( 1, '    ** ''UNIFORM'', using a simple uniform RNG;\n' );
  fprintf ( 1, '  * SAMPLE_NUM, the number of sample points;\n' );
  fprintf ( 1, '  * BATCH, the number of sampling points to create at one time;\n' );
  fprintf ( 1, '  * OUTPUT, a file into which the data is stored.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  To indicate that no further computations are \n' );
  fprintf ( 1, '  desired, it is enough to input a nonsensical value, \n' );
  fprintf ( 1, '  such as -1.\n' );

  while ( 1 )

    fprintf ( 1, '  *\n' );
    fprintf ( 1, ' *\n' );
    fprintf ( 1, '*  Ready to generate a new dataset:\n' );
    fprintf ( 1, ' *\n' );
    fprintf ( 1, '  *\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  NDIM is the spatial dimension.\n' );
    fprintf ( 1, '  (Try ''2'' if you have no preference.)\n' );
    fprintf ( 1, '  (Any value less than 1 terminates execution.)\n' );
    ndim = [];
    ndim = input ( '  Enter NDIM:  ' );

    fprintf ( 1, '  NDIM = %12d\n', ndim );

    if ( ndim < 1 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of NDIM = %12d\n', ndim );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  N is the number of points to generate.\n' );
    fprintf ( 1, '  (Try ''25'' if you have no preference.)\n' );
    fprintf ( 1, '  (Any value less than 1 terminates execution.)\n' );
    n = [];
    n = input ( '  Enter N:  ' );

    fprintf ( 1, '  User input N = %12d\n', n );

    if ( n < 1 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of N = %12d\n', n );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  NPP is the number of boundary sample points.\n' );
    fprintf ( 1, '  (Try ''1000'' if you have no preference.)\n' );
    fprintf ( 1, '  (Any value less than 1 terminates execution.)\n' );
    npp = [];
    npp = input ( '  Enter NPP:  ' );

    fprintf ( 1, '  User input NPP = %12d\n', npp );

    if ( npp < 1 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of NPP = %12d\n', npp );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  SEED is a seed for the random number generation.\n' );
    fprintf ( 1, '  (Try ''123456789'' if you have no preference.)\n' );
    fprintf ( 1, '  (Any value less than 0 terminates execution.)\n' );
    seed = [];
    seed = input ( '  Enter SEED:  ' );

    fprintf ( 1, '  User input SEED = %d\n', seed );

    if ( seed < 0 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of SEED = %12d\n', seed );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    seed_init = seed;

    fprintf ( 1, '\n' );
    fprintf ( 1, '  INIT is the method of initializing the data:\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  file       read data from a file;\n' );
    fprintf ( 1, '  ''GRID''     by picking points from a grid;\n' );
    fprintf ( 1, '  ''HALTON''   from a Halton sequence;\n' );
    fprintf ( 1, '  ''RAND''     using MATLAB''s RAND function;\n' );
    fprintf ( 1, '  ''UNIFORM''  using a simple uniform RNG;\n' );
    fprintf ( 1, ' \n' );
    fprintf ( 1, '  (Try ''RAND'' if you have no preference.)\n' );
    fprintf ( 1, '  (A blank value terminates execution).\n' );
    fprintf ( 1, '  (Be sure to INCLUDE QUOTES around the string!\n' );
    fprintf ( 1, ' \n' );

    init_string = [];
    init_string = input ( '  Enter INIT:  ' );

    fprintf ( 1, '  User input INIT = "%s".\n', init_string );

    if ( s_len_trim ( init_string ) <= 0 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of INIT \n' );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    if ( s_eqi ( init_string, 'RAND'  ) )
      init = -1;
    elseif ( s_eqi ( init_string, 'RANDOM' ) )
      init_string = 'RAND';
      init = -1;
    elseif ( s_eqi ( init_string, 'UNIFORM' ) )
      init = 0;
    elseif ( s_eqi ( init_string, 'HALTON'  ) )
      init = 1;
    elseif ( s_eqi ( init_string, 'GRID'    ) )
      init = 2;
    elseif ( 0 < s_len_trim ( init_string ) )
      init = 3;
    else
      fprintf ( 1, '\n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of INIT \n' );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  IT_MAX is the maximum number of iterations.\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  An iteration carries out the following steps:\n' );
    fprintf ( 1, '  * the Voronoi region associated with each\n' );
    fprintf ( 1, '    generator is estimated by sampling;\n' );
    fprintf ( 1, '  * the centroid of each Voronoi region is estimated.\n' );
    fprintf ( 1, '  * the generator is replaced by the centroid.\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  If "enough" sampling points are used,\n' );
    fprintf ( 1, '  and "enough" iterations are taken, this process\n' );
    fprintf ( 1, '  will converge.\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  (Try ''50'' if you have no preference.)\n' );
    fprintf ( 1, '  (A negative value terminates execution).\n' );
    fprintf ( 1, '\n' );
    it_max = [];
    it_max = input ( '  Enter IT_MAX:  ' );

    fprintf ( 1, '  User input IT_MAX = %12d\n', it_max );

    if ( it_max < 0 )
      fprintf ( 1, ' \n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of IT_MAX = %12d\n', it_max );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  IT_FIXED is the number of consecutive iterations\n' );
    fprintf ( 1, '  to take with a fixed set of sample points.\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Setting IT_FIXED to 1 means a new set of sample\n' );
    fprintf ( 1, '  points is generated on every iterative step;\n' );
    fprintf ( 1, '  Setting IT_FIXED equal to IT_MAX means a single set\n' );
    fprintf ( 1, '  of sample points is used for the entire iteration.\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Any value between 1 and IT_MAX is reasonable.\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  (Try "%d" if you do not have a preference).\n', it_max );
    fprintf ( 1, '  (A 0 or negative value terminates execution).\n' );
    fprintf ( 1, '\n' );
    it_fixed = [];
    it_fixed = input ( '  Enter IT_FIXED:  ' );

    fprintf ( 1, '  User input IT_FIXED = %12d\n', it_fixed );

    if ( it_max < 0 )
      fprintf ( 1, ' \n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of IT_FIXED = %12d\n', it_fixed );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  SAMPLE is the method of sampling the region:\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  ''GRID''     by picking points from a grid;\n' );
    fprintf ( 1, '  ''HALTON''   from a Halton sequence;\n' );
    fprintf ( 1, '  ''RAND''     using MATLAB''s RAND function;\n' );
    fprintf ( 1, '  ''UNIFORM''  using a simple uniform RNG;\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  (Try ''RAND'' if you have no preference.)\n' );
    fprintf ( 1, '  (A blank value terminates execution).\n' );
    fprintf ( 1, '  (Be sure to INCLUDE QUOTES around the string!\n' );
    fprintf ( 1, '\n' );

    sample_string = [];
    sample_string = input ( '  Enter SAMPLE:  ' );

    fprintf ( 1, '  User input SAMPLE = "%s".\n', sample_string );

    if ( s_len_trim ( sample_string ) <= 0 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of SAMPLE \n' );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    if ( s_eqi ( sample_string, 'RAND'  ) )
      sample = -1;
    elseif ( s_eqi ( sample_string, 'RANDOM' ) )
      sample = -1;
      sample_string = 'RAND';
    elseif ( s_eqi ( sample_string, 'UNIFORM' ) )
      sample = 0;
    elseif ( s_eqi ( sample_string, 'HALTON'  ) )
      sample = 1;
    elseif ( s_eqi ( sample_string, 'GRID'    ) )
      sample = 2;
    else
      fprintf ( 1, '\n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of SAMPLE \n' );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  SAMPLE_NUM is the number of sample points.\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  The Voronoi regions will be explored by generating\n' );
    fprintf ( 1, '  SAMPLE_NUM points.  For each sample point, the\n' );
    fprintf ( 1, '  nearest generator is found.  Using more points\n' );
    fprintf ( 1, '  gives a better estimate of these regions.\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  SAMPLE_NUM should be much larger than N, the\n' );
    fprintf ( 1, '  number of generators.\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  (Try ''10000'' if you have no preference.)\n' );
    fprintf ( 1, '  (A zero or negative value terminates execution.)\n' );
    fprintf ( 1, '\n' );

    sample_num = [];
    sample_num = input ( '  Enter SAMPLE_NUM:  ' );

    fprintf ( 1, '  User input SAMPLE_NUM = %12d\n', sample_num );

    if ( sample_num <= 0 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of SAMPLE_NUM = %12d\n', sample_num );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  BATCH is the number of sample points to create\n' );
    fprintf ( 1, '  at one time\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  BATCH should be between 1 and SAMPLE_NUM.\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  It is FASTER to set BATCH to SAMPLE_NUM;\n' );
    fprintf ( 1, '  setting BATCH to 1 requires the least memory.\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  (Try ''%d'' if you have no preference.)\n', ...
      min ( 1000, sample_num ) );
    fprintf ( 1, '  (A zero or negative value terminates execution.)\n' );
    fprintf ( 1, '\n' );

    batch = [];
    batch = input ( '  Enter BATCH:  ' );

    fprintf ( 1, '  User input BATCH = %12d\n', batch );

    if ( batch <= 0 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'CCVT_REFLECT\n' );
      fprintf ( 1, '  The input value of BATCH = %12d\n', batch );
      fprintf ( 1, '  is interpreted as a request for termination.\n' );
      fprintf ( 1, '  Normal end of execution.\n' );
      break
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  MOVIE_NAME is the name of the file in which the movie is stored;\n' );
    fprintf ( 1, '\n' );
    fprintf ( 1, '  (Try ''movie.avi'' if you have no preference.)\n' );
    fprintf ( 1, '  (A blank value terminates execution).\n' );
    fprintf ( 1, '  (Be sure to INCLUDE QUOTES around the string!\n' );
    fprintf ( 1, ' \n' );

    movie_name = [];
    movie_name = input ( '  Enter MOVIE_NAME:  ' );

    fprintf ( 1, '  User input MOVIE_NAME = %s\n', movie_name );
%
%  Initialize some movie information.
%
    if ( file_exist ( movie_name ) )
      file_delete ( movie_name )
    end

    num_frames_per_second = 10;
    aviobj = avifile ( movie_name, 'fps', num_frames_per_second );
%
%  Print the header for output.
%
    if ( DEBUG )
      fprintf ( 1, '\n' );
      fprintf ( 1, '  Step    SEED          L2-Change     Energy\n' );
      fprintf ( 1, '\n' );
    end
%
%  Initialize the generators.
%
    if ( init == 3 )

      r = data_read ( sample_string, ndim, n );

    else

      seed = seed_init;
      initialize = 1;

      [ r, seed ] = cvt_sample ( ndim, n, n, init, initialize, seed );

    end
%
%  If the initialization and sampling steps use the same random number
%  scheme, then the sampling scheme does not have to be initialized.
%
    if ( init == sample )
      initialize = 0;
    else
      initialize = 1;
    end
%
%  Compute the initial energy.
%
    seed_init2 = seed_init;

    [ energy, seed ] = cvt_energy ( ndim, n, batch, sample, initialize, ...
      sample_num, seed, r );

    initialize = 0;

    it_num = 0;

    if ( DEBUG )
      fprintf ( 1, '  %4d  %12d  %14e\n', ...
        it_num, seed_init2, energy );
    end
%
%  Write out the initial points.
%
    cvt_write ( ndim, n, batch, seed_init, seed, init_string, it_max, ...
      it_fixed, it_num, energy, sample_string, sample_num, ...
      r, 'initial.txt' );

    points_eps ( 'initial.eps', ndim, n, r, 'Initial points' );

    while ( it_num < it_max )
%
%  Once every IT_FIXED steps, update the base value of SEED,
%  either to SEED_INIT before the first call to CVT_ITERATE, or to the
%  output value of SEED from the previous call to CVT_ITERATE.
%
%  Otherwise, reset the value of SEED to SEED_BASE.
%
      if ( mod ( it_num, it_fixed ) == 0 )
        seed_base = seed;
      else
        seed = seed_base;
      end

      it_num = it_num + 1;
%
%  Sample the region.
%
      seed_init2 = seed;

      r2(1:ndim,1:n) = 0.0;
      count(1:n) = 0;

      outside = 0;

      [ s, seed ] = cvt_sample ( ndim, sample_num, sample_num, sample, ...
        initialize, seed );

      initialize = 0;
      energy = 0.0;

      for js = 1 : sample_num

        distance = Inf;
        nearest = -1;

        for jr = 1 : n

          dist_sq = 0.0E+00;
          for i = 1 : ndim
            dist_sq = dist_sq + ( r(i,jr) - s(i,js) )^2;
          end

          if ( dist_sq < distance )
            distance = dist_sq;
           nearest = jr;
          end

        end

        s2(1:ndim,1) = 2.0 * r(1:ndim,nearest) - s(1:ndim,js);

        if ( ...
          0.0 <= s2(1,1) & s2(1,1) <= 1.0 & ...
          0.0 <= s2(2,1) & s2(2,1) <= 1.0 )
          r2(1:ndim,nearest) = r2(1:ndim,nearest) + s(1:ndim,js);
          count(nearest) = count(nearest) + 1;
        else
          r2(1:ndim,nearest) = r2(1:ndim,nearest) + r(1:ndim,nearest);
          count(nearest) = count(nearest) + 1;
        end

        energy = energy + sum ( ( r(1:ndim,nearest) - s(1:ndim,js) ).^2 );

      end

      energy = energy / sample_num;

      for j = 1 : n
        r2(1:ndim,j) = r2(1:ndim,j) / count(j);
      end

      r(1:ndim,1:n) = r2(1:ndim,1:n);

      handle = scatter ( r(1,1:n), r(2,1:n), [],'r', 'filled' );
      line ( [ 0.0, 1.0, 1.0, 0.0, 0.0 ], [ 0.0, 0.0, 1.0, 1.0, 0.0 ] );
      axis ( [ -0.05, 1.05, -0.05, 1.05 ] );
      axis square
%
%  Label the axes and the plot.
%
      xlabel ( 'X', 'FontName', 'Helvetica', 'FontWeight', 'bold', ...
        'FontSize', 16 );

      ylabel ( 'Y', 'FontName', 'Helvetica', 'FontWeight', 'bold', ...
        'FontSize', 16, 'Rotation', 0 );

      it_string = sprintf ( 'Step %4d', it_num );

      title ( it_string, 'FontName', 'Helvetica', 'FontWeight', ...
        'bold', 'FontSize', 16 );

      frame = getframe ( gca );
      aviobj = addframe ( aviobj, frame );

      initialize = 0;
      if ( DEBUG )
        fprintf ( 1, '  %4d  %12d  %14e\n', ...
          it_num, seed_init2, energy );
      end

    end

    aviobj = close ( aviobj );
%
%  Write the final data to a file.
%
    cvt_write ( ndim, n, batch, seed_init, seed, init_string, it_max, ...
      it_fixed, it_num, energy, sample_string, sample_num, ...
      r, 'final.txt' );

    points_eps ( 'final.eps', ndim, n, r, 'Final points' );

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Press RETURN to proceed.\n' );

    pause

  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Final value of SEED = %d\n', seed );
  fprintf ( 1, '\n' );
  timestamp ( );

  return
end


function cvx_optval = norm_largest( x, k )

%NORM_LARGEST Sum of the k largest magnitudes of a vector.
%   NORM_LARGEST( X, k ) computes the 'largest-k' norm; that is, it computes
%   the sum of the magnitudes of the k largest elements in X. X must
%   be a vector, and k must be a real scalar.
%
%   Disciplined convex programming information:
%       NORM_LARGEST is convex and nonmonotonic of X, though it is monotonic for
%       positive values of X. So when used in CVX expressions, X must be affine,
%       monomial, or posynomial. k must be a real scalar constant.

error( nargchk( 2, 2, nargin ) );
if ~any( size( x ) ~= 1 ),
    error( 'The first argument must be a vector.' );
elseif ~isnumeric( k ) || ~isreal( k ) || length( k ) ~= 1,
    error( 'Third argument must be a scalar.' );
else
    cvx_optval = sum_largest( abs( x ), k );
end

% Copyright 2010 Michael C. Grant and Stephen P. Boyd.
% See the file COPYING.txt for full copyright information.
% The command 'cvx_where' will show where this file is located.


%% Setting of the problem
global s
pde = checkboarddata; % f = (x1^2-1)*(x2^2-1); Kellogg problem
pde.L = 1;
option.theta = 0.3;
option.estType = 'star';
option.maxIt = 25;
option.maxN = 2e4;
option.solver = 'mg';
option.tol = 1e-6;
[node,elem] = squaremesh([-1,1,-1,1],0.5);
bdFlag = setboundary(node,elem,'Dirichlet');

%% s = 0.2
s = 0.2; %#ok<*NASGU>
err1 = afemfracLap(node,elem,pde,bdFlag,option);

%% s = 0.4
s = 0.4;
err2 = afemfracLap(node,elem,pde,bdFlag,option);

%% s = 0.6
s = 0.6;
err3 = afemfracLap(node,elem,pde,bdFlag,option);

%% s = 0.8
s = 0.8;
err4 = afemfracLap(node,elem,pde,bdFlag,option);

%% save data and plot the table
save Kelloggcf err1 err2 err3 err4
load Kelloggcf
figure;
plot_error_table(err1.N,err1.energyError,err2.N,err2.energyError,...
                 err3.N,err3.energyError,err4.N,err4.energyError);
%Save figure
saveas(gcf, 'error_Kellogg_cf', 'pdf')
figure;
plot_error_table(err1.N,err1.eta,err2.N,err2.eta,err3.N,err3.eta,err4.N,err4.eta);
ylabel('Estimator','interpreter','latex', 'FontSize', 22)
saveas(gcf, 'eta_Kellogg_cf', 'pdf')


% FRONTIER Rolling efficient frontier.
%    [PORTWGTS,ALLMEAN,ALLCOV] = FRONTIER(UNIVERSE,WINDOW,OFFSET,NPORTS,ACTIVEMAP,CONSET,NUMNONNAN)
%    generates a surface of efficient frontiers given data indicating which
%    stocks are active at each date, portfolio constraints and the number of
%    non missing data points needed for each window showing how asset
%    allocation influences risk and return over time.
%
%    [PW,AM,AC] = FRONTIER(UNIVERSE,WINDOW,OFFSET,NPORTS)
%    generates a surface of efficient frontiers showing how asset allocation
%    influences risk and return over time.
%
%    Inputs:
%
%       UNIVERSE - Portfolio matrix containing the total return data for a
%                  group of securities.  It is an Mx(N+1) matrix where column 1
%                  contains MATLAB date numbers and the remaining columns
%                  are the total return data for each security.  N is the
%                  number of securities.
%       WINDOW - Number of periods of data to use to calculate each frontier.
%       OFFSET - Increment in number of periods between each frontier.
%       NPORTS - The number of portfolios to calculate on each frontier.
%
%    Optional inputs:
%
%
%       ACTIVEMAP - An MxN matrix with boolean elements that correspond to
%                   the UNIVERSE where each element indicates if the asset
%                   is part of the UNIVERSE on the corresponding date.  The
%                   default map is an MxN matrix of ones indicating that all
%                   assets are active at all dates.   Note if constraints,
%                   CONSET, other than the default values are used,
%                   the default ACTIVEMAP must be used.
%       CONSET - Portfolio constraints.  Default constraints are generated by
%                PORTCONS('Default',NumAssets).  This single constraint
%                matrix is applied to each frontier.  Note if an ACTIVEMAP
%                other than the default map, the default constraints must be
%                used.
%       NUMNONNAN - Minimum number of non NaN points for each active asset
%                   in each window of data needed to perform the
%                   optimization.  The default value is WINDOW - N.
%
%    Outputs:
%
%      PORTWGTS - A (Number of Curves)x1 cell array where each element is an
%      NPORTSx(Number of Assets) matrix of weights allocated to each
%      asset.  Number of Assets = length(UNIVERSE).
%
%      ALLMEAN - A (Number of Curves)x1 cell array where each element is an
%      1 x (Number of Assets) vector of the expected asset returns used to
%      generate each curve on the surface.
%
%      ALLCOV - A (Number of Curves)x1 cell array where each element is an
%      (Number of Assets) x (Number of Assets) vector of the covariance
%      matrix used to generate each curve on the surface.
%
%    See also PORTCONS, PORTOPT.
%
%    Reference page in Doc Center
%       doc frontier
%
%    Other functions named frontier
%
%       dsge/frontier
%


%% BEARING FAULT ANALYSIS
% This program demonstrates how you can analyze the operation of a bearing,
% and how faults can be found by means of Signal Processing.
%
% _Created by Roni Peer_, Last Revision: *December 30th, 2011*
%%

%% Why to use this program
% In order to fully leverage this program, I recommend reading some theory,
% as can be found on Wikipedia or other textbooks. This program takes a
% ball-bearing, simulates a fault in its inner or outer ring, and tries to
% show how you can view the fault, by means of finding the resonance
% frequencies.

%% Menus and Options
% There are several key options you can select with this program.
%% Bearing Fault type:
% On the right popup menu select between the *"Inner Ring"* or *"Outer
% Ring"*
% fault. An inner ring fault would generate a sinewave-like signal, an
% Outer ring fault would generate a pulsing signal.
%
%% Rotation Speed
% A slider of the Rotation Speed (in RPM), in which the bearing is
% operating. Input range is between 1 and 2000.
%
%% Analysis Type
% A pop-up menu to choose between 4 types of analysis: *Spectral Analysis,
% Kurtosis, Envelope, and Time/Frequency*.
%
%% Kurtosis Option
% The Kurtosis option on the pop-up menu will generate 3 Kurtosis numbers
% (compatible with the 3 different resonances, of 120, 500, 1500
% [rad/sec]), which will be shown below.
%
%% Filter for Envelope
% The 'Filter For Envelope' button enables a band pass filter over a preset
% bandwidth of the envelope. To set the bandwidth press the *'Filter For
% Envelope'* button.  set the first band limit by dragging the cursor on the
% graph. press "Enter", a 2nd cursor will appear, set it up to the 2nd
% limit of the desired bandwidth.  press "Enter" again to get the filtered signal.
%
%% Run Button
% The 'Run' button is needed to be pressed so that the changes we made will
% effect the calculations and graphs of the program.
%
%% Plots and Axes
% You can view several different aspects of the bearing system at hand.
%
%% Top Left Graph
% This graph shows the input signal - the signal measured at the faulty
% bearing.
%
%% Top Right Graph
% This graph shows the BODE frequency-Magnitude plot of the system.
%
%% Central Graph
% This graph shows the system response.
%
%% Bottom Graph
% This graph shows the output of the selected analysis plot.
%


% StackExchange Signal Processing Q61273
% https://dsp.stackexchange.com/questions/61273
% Estimate Noise Variance Given Multiple Realization of the Same Image
% References:
%   1.  A
% Remarks:
%   1.  B
% TODO:
% 	1.  C
% Release Notes
% - 1.0.000     15/10/2019
%   *   First release.

%% General Parameters

subStreamNumberDefault = 12;

run('InitScript.m');

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

generateFigures = ON;

%% Simulation Parameters

inputImageFileName  = 'InputImage.png';

vNumRealizations    = 2:60;
noiseStd            = 0.1;

%% Generate Data

mI = im2double(imread(inputImageFileName));

numRows = size(mI, 1);
numCols = size(mI, 2);

tI              = mI + (noiseStd * randn(numRows, numCols, vNumRealizations(end)));
mMeanImage      = zeros(numRows, numCols);
tN              = zeros(numRows, numCols, vNumRealizations(end));
mEstNoiseStd    = zeros(length(vNumRealizations), 2);
vN              = zeros(numRows * numCols * vNumRealizations(end), 1);

for ii = 1:length(vNumRealizations)
    numRealizations             = vNumRealizations(ii);
    mMeanImage(:)               = mean(tI(:, :, 1:numRealizations), 3);
    tN(:, :, 1:numRealizations) = tI(:, :, 1:numRealizations) - mMeanImage;
    numNoiseSamples             = numRows * numCols * numRealizations;
    vN(1:numNoiseSamples)       = reshape(tN(:, :, 1:numRealizations), numNoiseSamples, 1); %<! In MATLAB R2018b and above can use 'all' to skip this
    mEstNoiseStd(ii, 1)         = sqrt(mean(vN(1:numNoiseSamples) .^ 2)); % std(vN);
    mEstNoiseStd(ii, 2)         = mean(reshape(std(tI(:, :, 1:numRealizations), 0, 3), numRows * numCols, 1));
    mEstNoiseStd(ii, 3)         = sqrt(mean(reshape(var(tI(:, :, 1:numRealizations), 0, 3), numRows * numCols, 1)));
end

%% Analysis

figureIdx = figureIdx + 1;

hFigure     = figure('Position', figPosLarge);
hAxes       = axes();
hLineObj    = line(vNumRealizations, [mEstNoiseStd, noiseStd * ones(length(vNumRealizations), 1)]);
set(hLineObj, 'LineWidth', lineWidthNormal);
set(hLineObj(end), 'LineStyle', ':');
set(get(hAxes, 'Title'), 'String', {['Estimation of the Noise STD as a Function of Number of Realizations']}, ...
    'FontSize', fontSizeTitle);
set(get(hAxes, 'XLabel'), 'String', {['Number of Realizations']}, ...
    'FontSize', fontSizeAxis);
set(get(hAxes, 'YLabel'), 'String', {['STD']}, ...
    'FontSize', fontSizeAxis);
hLegend = ClickableLegend({['Estimated STD - Method 1'], ['Estimated STD - Method 2'], ['Estimated STD - Method 3'], ['Ground Truth']});

if(generateFigures == ON)
    saveas(hFigure,['Figure', num2str(figureIdx, figureCounterSpec), '.png']);
end

%% Restore Defaults

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


function v_leg = chebcoeffs2legvals(c_cheb)
%CHEBCOEFFS2LEGVALS  Convert Chebyshev coefficients to Legendre values.
%   V_LEG = CHEBCOEFFS2LEGVALS(C_CHEB) converts the vector C_CHEB of Chebyshev
%   coefficients to a vector V_LEG of Legendre values such that
%       C_CHEB(1)*T0(X_k) + ... + C_CHEB(N)*T{N-1} = V_LEG_k, k = 0, ... N-1,
%   where X_k are the Legendre nodes returned by LEGPTS().
%
% See also LEGPTS.

% Copyright 2017 by The University of Oxford and The Chebfun Developers.
% See http://www.chebfun.org/ for Chebfun information.

% This command is a wrapper for chebfun.ndct.
v_leg = chebfun.ndct(c_cheb);

end


% This is material illustrating the methods from the book
% Financial Modelling  - Theory, Implementation and Practice with Matlab
% source
% Wiley Finance Series
% ISBN 978-0-470-74489-5
%
% Date: 02.05.2012
%
% Authors:  Joerg Kienitz
%           Daniel Wetterau
%
% Please send comments, suggestions, bugs, code etc. to
% kienitzwetterau_FinModelling@gmx.de
%
% (C) Joerg Kienitz, Daniel Wetterau
%
% Since this piece of code is distributed via the mathworks file-exchange
% it is covered by the BSD license
%
% This code is being provided solely for information and general
% illustrative purposes. The authors will not be responsible for the
% consequences of reliance upon using the code or for numbers produced
% from using the code.

%-----------------------------------------------------------------------
% This script demonstrates the use of function QUADPROG on the basis of
% the Markowitz mean-variance portfolio optimization problen

clear
close all
clc
warning 'off'

% load matrix data
% of annualized linear stock returns
load 'LinRetMat'

% M: number of samples
% N: number of assets
[~,N] = size(data);
% sample mean
mu = mean(data)';
% sample covariance
Sigma = cov(data);

% Objective function 0.5*x'Hx + c'x
%---------------------------
H = 2.0*Sigma;
c = zeros(N,1);

% Constraints
%---------------------------
% weights sum to one
Aeq = ones(1,N);
beq = 1.0;
% no short-sales
A = -eye(N);
b = zeros(N,1);

% Minimum Variance Portfolio
%---------------------------
[weightsP,sigmaP2] = quadprog(H,c,A,b,Aeq,beq);
muP = weightsP'*mu;

% maximum return
muMax = max(mu);

% number portfolios
M = 50;
% stepsize of returns
delta = (muMax - muP)/(M-1);

% preallocate cache
weightsMat = zeros(N,M);    % matrix of portfolio weights
sigmaVec = zeros(M,1);      % expected volatility of portfolios
muVec = zeros(M,1);         % expected return of portfolios

% add minimum variance portfolio
weightsMat(:,1) = weightsP;
sigmaVec(1) = sqrt(sigmaP2);
muVec(1) = muP;

% compute efficient portfolios
for i = 2:M
    % set equality constraints w1 + w2 +...+ wN = 1 and w'*mu = R
    Aeq = [ones(1,N); mu'];
    beq = [1.0; muP + (i-1)*delta];
    % start optimization
    [weightsMat(:,i),sig2] = quadprog(H,c,A,b,Aeq,beq);

    sigmaVec(i) = sqrt(sig2);
    muVec(i) = weightsMat(:,i)'*mu;
end

weightsMat(weightsMat < 0.001) = 0.0;

% Create figure
figure1 = figure('Color',[1 1 1]);
colormap('gray');

% plot efficient frontier
subplot(1,2,1)
plot(sigmaVec,muVec,'k','LineWidth',1.5)
legend('Efficient Frontier','Location','NorthWest')
set(gca,'xlim',[0 sigmaVec(end)],'ylim',[0 muVec(end)])
title('Mean-Variance Efficient Frontier','FontSize',17)
xlabel('$\sigma$','Interpreter','latex','FontName','Helvetia','FontSize',16)
ylabel('$\mu$','Interpreter','latex','FontName','Helvetia','FontSize',16,'Rotation',0)
ticks = get(gca,'YTick');
set(gca,'YTickLabel',[num2str(ticks'*100),repmat('%',length(ticks),1)])
ticks = get(gca,'XTick');
set(gca,'XTickLabel',[num2str(ticks'*100),repmat('%',length(ticks),1)])
% plot portfolio weights
subplot(1,2,2)
Data = cumsum(weightsMat,1);
step = (0.8-0.3)/(N-1);
colMat = repmat((0.3:step:0.8)',1,3);
for k = 1:N
    hold on
    fill([sigmaVec(1);sigmaVec;sigmaVec(end)],[0,Data(N-k+1,:),0]',colMat(k,:));
end
set(gca,'xlim',[sigmaVec(1) sigmaVec(end)],'ylim',[0 max(max(Data))])
title('Weights of the Efficient Portfolios','FontSize',17)
xlabel('$\sigma$','Interpreter','latex','FontName','Helvetia','FontSize',16)
ylabel('$w$','Interpreter','latex','FontName','Helvetia','FontSize',16,'Rotation',0)
ticks = get(gca,'YTick');
set(gca,'YTickLabel',[num2str(ticks'*100),repmat('%',length(ticks),1)])
ticks = get(gca,'XTick');
set(gca,'XTickLabel',[num2str(ticks'*100),repmat('%',length(ticks),1)])
legend([repmat('w_{',N,1),num2str((1:N)'),repmat('}',N,1)])


% Uniform on a Moebius'string
function [data] = mobius_rotate(N)
 r = 3; R = 10;
%r = 5; R = 15;
%np = 100; nr = 20;
%N = 2000;

xi = rand(N,1);
eta = rand(N,1);
rho = (1-2*xi)*r;
theta = pi*eta;
%for k=1:10
theta = pi*eta+rho./R.*cos(theta);
%end
x = (R+rho.*sin(theta)).*cos(2*theta);
y = (R+rho.*sin(theta)).*sin(2*theta);
z = rho.*cos(theta);
x_r=x+8;
y_r=y+8;
z_r=z;

% figure;
% plot3(x,y,z,'b.')
% hold on
% plot3(x_r,y_r,z_r,'r.')
% axis('equal');
X1=[x';y';z'];
X2=[x_r';y_r';z_r'];
X_P=[X1,X2];
data=X_P;


% PCA Assignment
% clc
% clear all;
% close all;
function [recp,rectime,TDS,DS]= PCA_NEW(TrNum);

TsNum=10-TrNum; % Remained Number of Images for training, out of 400

[Tr,irow,icol,DS]=CDTr(TrNum);
[Ts,irow,icol,TDS]=CDTs(TrNum);

Tr=double(Tr);
Ts=double(Ts);
M=mean(Tr,2);
A=Tr-repmat(M,1,size(Tr,2));

 L=cov(A); % surogate Matrix of mean subtracted
 [U D]=eig(L);% Eigen Vectors of Surogate Matrix

 L_eig_vec = [];
 for i = 1 : size(U,2)
        if( D(i,i)>4500 )
         L_eig_vec = [L_eig_vec U(:,i)];
        end
 end

Eigenfaces = A * L_eig_vec;% Eigenvectors of Mean Subtracted Matrix

%%%%%%%%%%%%%%%%%%%%
ProjectedImages = [];
Train_Number = size(Tr,2);
for i = 1 : Train_Number
    temp = Eigenfaces'*A(:,i); % Projection of centered images into facespace
    ProjectedImages = [ProjectedImages temp];
end
ProjectedTestImages=[];
rec=[];

for j=1:size(Ts,2)
Difference = Ts(:,j)-M; % Centered test image
ProjectedTestImages = [ProjectedTestImages Eigenfaces'*Difference]; % Test image feature vector
end
%%%%%%%%%%%%%%%%%%%%%%%% Calculating Euclidean distances
% Euclidean distances between the projected test image and the projection
% of all centered training images are calculated. Test image is
% supposed to have minimum distance with its corresponding image in the
% training database.
%tic

tic
for j=1:size(Ts,2)
Euc_dist = [];
for i = 1 : Train_Number
    %q = ProjectedImages(:,i);
    temp = ( norm( ProjectedTestImages(:,j) - ProjectedImages(:,i) ) )^2;
    Euc_dist = [Euc_dist temp];
end
%toc
%stem(Euc_dist);

[Euc_dist_min , Recognized_index] = min(Euc_dist);
rec=[rec Recognized_index];
end
rectime=toc;
recd=ceil(rec/TrNum);
%%%

 outd=[];
 for i = 1:DS/TrNum
     for j=1:TsNum
         outd=[outd i];
     end
 end

recp=1-(size(find((recd-outd)>0),2)/size(Ts,2));
sprintf('Recognition Percentage %1.2f%%  and recognition time is %1.3f sec for %d out of %d number of images',recp*100,rectime,TDS,DS)
end


% Fig. 6.25   Feedback Control of Dynamic Systems, 5e
%             Franklin, Powell, Emami
%

clear all;
close all;

num=1;
den=conv([1 0],[1 2 1]);
w=logspace(-2,3,100);
[m,p]=bode(num,den,w);
subplot(2,1,1)
loglog(w,m);
axis([.01 100 .0001 100])
hold on;
ii=[11 21 47 61];
loglog(w([ii]),m([ii]),'*');
loglog(1,.5,'*')
grid;
ylabel('Magnitude');
title('Fig. 6.25 Bode Plot for G=1/(s+1)^2 (a) magnitude');
hold off;
subplot(2,1,2)
semilogx(w,p);
axis([.01 100 -270 -90])
hold on;
w180=[.01 100];
p180=[-180 -180];
semilogx(w([11 21 47 61]),p([11 21 47 61]),'*');
semilogx(1,-180,'*')
semilogx(w180,p180)
grid;
xlabel('\omega (rad/sec)');
ylabel('Phase (deg)');
title('(b) phase ');
hold off;


% a tutorial adapted from the fipy diffusion 1D example
% see: http://www.ctcms.nist.gov/fipy/examples/diffusion/index.html
% How to convert a PDE into an ODE and solve it using a matlab ode solver
% needs more documentation
% If you want to have better time-stepping with Matlab ODE solver, use this example
% Written by Ali A. Eftekhari
% Last checked: June 2021
clc
clear

%% define the domain
L = 50;  % domain length
Nx = 20; % number of cells
meshstruct = createMesh1D(Nx, L);
BC = createBC(meshstruct); % all Neumann boundary condition structure
BC.left.a = 0; BC.left.b=1; BC.left.c=1; % left boundary
BC.right.a = 0; BC.right.b=1; BC.right.c=0; % right boundary
x = meshstruct.cellcenters.x;
%% define the transfer coeffs
D_val = 1;
D = createFaceVariable(meshstruct, D_val);
alfa = createCellVariable(meshstruct, 1);
%% define initial values
c_old = createCellVariable(meshstruct, 0); % initial values
c_value = c_old;
%% loop
dt = 0.1; % time step
final_t = 100;
Mdiff = diffusionTerm(D);
[M, RHS] = combineBC(BC, Mdiff, zeros(Nx+2,1));
% eq: dcdt = D d2c/dx2
dcdt = @(t,c)(M*c-RHS);
[t_temp, c_temp] = ode45(dcdt, [0 final_t], internalCells(c_old));
c_analytical = 1-erf(x./(2*sqrt(D_val*final_t)));
plot(x, c_temp(end,:), x, c_analytical, 'o')


function [ dPriors ] = log_gmm_div_prior(W,Priors)
%LOG_GMM_DIV_PRIOR
%
%   input -----------------------------------------------------------------
%
%       o X         : (D x N),      Samples
%
%       o W         : (N x K),      Responsibility factor
%
%       o Priors    : (1 x K),      Weights
%
%   output ----------------------------------------------------------------
%
%       o dPriors   : (1 x K),      Derivative of weights
%
%
%

K       = length(Priors);
dPriors = zeros(1,K);

for k=1:K
                    %(N x 1)
    dPriors(k) = mean(W(:,k) ./ Priors(k));

end

 dPriors =  dPriors./sum(dPriors);

end


% Multistage omega scheme.

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

% Theory in Section 5.10 of:

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

% This program generates Figs. 5.23, 5.24 in the book

% Solution of (5.89)
% dy/dt + u dy/dx - D d^2u/dx^2 = (hom-1)*beta^2*D*cos(beta*(x-ut))
%	x = 0: Dirichlet,  x = 1: Neumann or absorbing boundary conditions
% Central or upwind differences
% Defect correction optional
% Uniform cell-centered grid

% Functions called: exact_solution, fL, fR

		% ...............Input.........................................
u = 1.1;	% Velocity
D = 0.0005;	% Diffusion coefficient
dt = 1/10;	% Time step
n = 100;	% Number of time steps
J = 30;		% Number of grid cells
central = 1;	% Enter 1 for central scheme or something else for upwind scheme
bc = 2;		% Enter 1 for inhomogeneous Neumann or 2 for homogeneous Neumann
hom = 1;	% Enter 1 for   homogeneous right-hand side
		%    or 2 for inhomogeneous right-hand side
defcor = 1;	% Enter 1 for defect correction or else something else
nalpha = 3;	% Parameter in exact solution: alpha = nalpha*pi
nbeta = 2;	% Parameter in exact solution: beta  = nbeta*pi
		%...............End of input...............................

omega = 1 - sqrt(0.5);			% Parameters in multistage omega scheme
palpha = (1 - 2*omega)/(1 - omega);
palphap = 1 - palpha;
omegap = 1 - 2*omega;

T = n*dt;	% Final time

		% Definition of indexing
%     x=0
% grid |---o---|---o---|---o---|---o---|
%      1   1   2   2   3           J

h = 1.0/J;			% Cell size
d = D*dt/(h*h);			% Diffusion number
sigma = u*dt/h;			% Courant number
meshpeclet = sigma/d;		% Mesh Peclet number

	% Preallocation of J*J tridiagonal matrix A
Ac = spdiags([ ones(J,1)  ones(J,1)  ones(J,1)], [-1 0 1]',J,J);  % Central
Au = spdiags([ ones(J,1)  ones(J,1)  ones(J,1)], [-1 0 1]',J,J);  % Upwind

% Central scheme
Ac(1,1) = sigma/2 + 3*d;  Ac(1,2) = sigma/2 - d;
for j = 2:J-1,
  Ac(j,j-1) = -sigma/2 - d;    Ac(j,j+1) = sigma/2 - d;
  Ac(j,j)   = - Ac(j,j-1) - Ac(j,j+1);
end
j = J; Ac(j,j-1) = -sigma/2 - d; Ac(j,j) = sigma/2 + d;

% Upwind scheme
Au(1,1) = sigma + 3*d;  Au(1,2) =  - d;
for j = 2:J-1,
  Au(j,j-1) = -sigma - d;  Au(j,j+1) = - d;
  Au(j,j)   = - Au(j,j-1) - Au(j,j+1);
end
j = J; Au(j,j-1) = -sigma - d;  Au(j,j) = sigma + d;

	% System to be solved is E*ynew = C*yold + rhs
z = zeros(J,1); e = ones(J,1);   ID = spdiags([z e z],[-1 0 1],J,J);
Ec1 = ID + palpha*omega*Ac;	Cc1 = ID - palphap*omega*Ac;
Ec2 = ID + palphap*omegap*Ac;	Cc2 = ID - palpha*omegap*Ac;
Eu1 = ID + palpha*omega*Au;	Cu1 = ID - palphap*omega*Au;
Eu2 = ID + palphap*omegap*Au;	Cu2 = ID - palpha*omegap*Au;

if defcor ~= 1		% No defect correction
  if central == 1		% Central scheme
    E1 = Ec1;    C1 = Cc1;    E2 = Ec2;    C2 = Cc2;
  else				% Upwind scheme
    E1 = Eu1;    C1 = Cu1;    E2 = Eu2;    C2 = Cu2;
  end
end

	% Preallocations
yold = zeros(J,1);		% Numerical solution at previous time
ynew = zeros(J,1);		% Numerical solution at new time

x = [1:J]'*h - h/2;		% Coordinates of cell centers

%for j = 1:J,  x(j)=(j-0.5)*h; end

t = 0; yold = exact_solution(t,x,D,nalpha,nbeta,u,hom-1);
rhs = zeros(J,1);		% Right-hand side
beta = nbeta*pi;

if defcor ~= 1		% No defect correction
for i = 1:n

% Stage 1
  rhs = (hom-1)*beta*beta*D*dt*omega*cos(beta*(x-u*t));
  rhs(1) = rhs(1) +  palphap*omega*(sigma + 2*d)*fL(t,D,nalpha,nbeta,u,hom-1)...
   + palpha*omega*(sigma + 2*d)*fL(t+omega*dt,D,nalpha,nbeta,u,hom-1);
  if central == 1		% Central scheme
    rhs(J) = rhs(J) -...
     palphap*omega*(sigma/2 - d)*h*fR(t,D,nalpha,nbeta,u,bc,hom-1)...
     - palpha*omega*(sigma/2 - d)*fR(t+omega*dt,D,nalpha,nbeta,u,bc,hom-1);
  else				% Upwind scheme
    rhs(J) = rhs(J) - palphap*omega*( - d)*h*fR(t,D,nalpha,nbeta,u,bc,hom-1)...
     - palpha*omega*( - d)*fR(t+ omega*dt,D,nalpha,nbeta,u,bc,hom-1);
  end
  rhs = rhs + C1*yold;  ynew = E1\rhs;

% Stage 2
  yold = ynew;
  rhs = (hom-1)*beta*beta*D*dt*omegap*cos(beta*(x-u*(t + dt - omega*dt)));
  rhs(1) = rhs(1) + ...
     palpha*omegap*(sigma + 2*d)*fL(t + omega*dt,D,nalpha,nbeta,u,hom-1)...
   + palphap*omegap*(sigma + 2*d)*fL(t + dt - omega*dt,D,nalpha,nbeta,u,hom-1);
  if central == 1		% Central scheme
    rhs(J) = rhs(J) -...
     palpha*omegap*(sigma/2 - d)*h*fR(t + omega*dt,D,nalpha,nbeta,u,bc,hom-1)...
     - palphap*omegap*(sigma/2 - d)*fR(t+dt-omega*dt,D,nalpha,nbeta,u,bc,hom-1);
  else				% Upwind scheme
    rhs(J) = rhs(J) -...
      palpha*omegap*( - d)*h*fR(t + omega*dt,D,nalpha,nbeta,u,bc,hom-1)...
     - palphap*omegap*( - d)*fR(t + dt- omega*dt,D,nalpha,nbeta,u,bc,hom-1);
  end
  rhs = rhs + C2*yold;  ynew = E2\rhs;

% Stage 3
  yold = ynew;
  rhs = (hom-1)*beta*beta*D*dt*omega*cos(beta*(x - u*(t + dt)));
  rhs(1) = rhs(1) +...
    palphap*omega*(sigma + 2*d)*fL(t+ dt- omega*dt,D,nalpha,nbeta,u,hom-1)...
   + palpha*omega*(sigma + 2*d)*fL(t+dt,D,nalpha,nbeta,u,hom-1);
  if central == 1		% Central scheme
    rhs(J) = rhs(J) -...
    palphap*omega*(sigma/2-d)*h*fR(t+ dt- omega*dt,D,nalpha,nbeta,u,bc,hom-1)...
     - palpha*omega*(sigma/2 - d)*fR(t+dt,D,nalpha,nbeta,u,bc,hom-1);
  else				% Upwind scheme
    rhs(J) = rhs(J) -...
   palphap*omega*( - d)*h*fR(t+ dt- omega*dt,D,nalpha,nbeta,u,bc,hom-1)...
     - palpha*omega*( - d)*fR(t+ dt,D,nalpha,nbeta,u,bc,hom-1);
  end
  rhs = rhs + C1*yold;  ynew = E1\rhs;
  t = t + dt;  yold = ynew;
end
else		% One step of defect correction
  dy = zeros(J,1);		% Correction
  drhs = zeros(J,1);		% Correction of right-hand side

  for i = 1:n
		% Stage 1: upwind step
    rhs = (hom-1)*beta*beta*D*dt*omega*cos(beta*(x-u*t));
    rhs(1) = rhs(1) +  palphap*omega*(sigma + 2*d)*fL(t,D,nalpha,nbeta,u,hom-1)...
     + palpha*omega*(sigma + 2*d)*fL(t+omega*dt,D,nalpha,nbeta,u,hom-1);

    drhs = rhs;		% Preparation of rhs for correction step
    drhs(J) = drhs(J) -...
     palphap*omega*(sigma/2 - d)*h*fR(t,D,nalpha,nbeta,u,bc,hom-1)...
     - palpha*omega*(sigma/2 - d)*fR(t+omega*dt,D,nalpha,nbeta,u,bc,hom-1);
    rhs(J) = rhs(J) - palphap*omega*( - d)*h*fR(t,D,nalpha,nbeta,u,bc,hom-1)...
       - palpha*omega*( - d)*fR(t+ omega*dt,D,nalpha,nbeta,u,bc,hom-1);
    rhs = rhs + Cu1*yold;    ynew = Eu1\rhs;

		% Stage 1: correction step
    drhs = drhs - Ec1*ynew + Cc1*yold;    dy = Eu1\drhs;    ynew = ynew + dy;

		% Stage 2: upwind step
    yold = ynew;
    rhs = (hom-1)*beta*beta*D*dt*omegap*cos(beta*(x-u*(t + dt - omega*dt)));
    rhs(1) = rhs(1) + ...
      palpha*omegap*(sigma + 2*d)*fL(t + omega*dt,D,nalpha,nbeta,u,hom-1)...
    + palphap*omegap*(sigma + 2*d)*fL(t + dt - omega*dt,D,nalpha,nbeta,u,hom-1);

    drhs = rhs;		% Preparation of rhs for correction step
    drhs(J) = drhs(J) -...
       palpha*omegap*(sigma/2 - d)*h*fR(t + omega*dt,D,nalpha,nbeta,u,bc,hom-1)...
       - palphap*omegap*(sigma/2 - d)*fR(t+dt-omega*dt,D,nalpha,nbeta,u,bc,hom-1);
    rhs(J) = rhs(J) -...
       palpha*omegap*( - d)*h*fR(t + omega*dt,D,nalpha,nbeta,u,bc,hom-1)...
       - palphap*omegap*( - d)*fR(t + dt- omega*dt,D,nalpha,nbeta,u,bc,hom-1);
    rhs = rhs + Cu2*yold;    ynew = Eu2\rhs;

		% Stage 2: correction step
    drhs = drhs - Ec2*ynew + Cc2*yold;    dy = Eu2\drhs;    ynew = ynew + dy;

		% Stage 3: upwind step
    yold = ynew;
    rhs = (hom-1)*beta*beta*D*dt*omega*cos(beta*(x - u*(t + dt)));
    rhs(1) = rhs(1) +...
    palphap*omega*(sigma + 2*d)*fL(t+ dt- omega*dt,D,nalpha,nbeta,u,hom-1)...
    + palpha*omega*(sigma + 2*d)*fL(t+dt,D,nalpha,nbeta,u,hom-1);

    drhs = rhs;		% Preparation of rhs for correction step
    drhs(J) =drhs(J) -...
      palphap*omega*(sigma/2-d)*h*fR(t+ dt- omega*dt,D,nalpha,nbeta,u,bc,hom-1)...
       - palpha*omega*(sigma/2 - d)*fR(t+dt,D,nalpha,nbeta,u,bc,hom-1);
      rhs(J) = rhs(J) -...
      palphap*omega*( - d)*h*fR(t+ dt- omega*dt,D,nalpha,nbeta,u,bc,hom-1)...
       - palpha*omega*( - d)*fR(t+ dt,D,nalpha,nbeta,u,bc,hom-1);
    rhs = rhs + Cu1*yold;
    ynew = Eu1\rhs;

		% Stage 3: correction step
    drhs = drhs - Ec1*ynew + Cc1*yold;    dy = Eu1\drhs;    ynew = ynew + dy;
    t = t + dt;    yold = ynew;
  end
end

solex =  exact_solution(t,x,D,nalpha,nbeta,u,hom-1);

error = ynew - solex;		% Compute error norms
norm1 = norm(error,1)/J
norm2 = norm(error,2)/sqrt(J)
norminf = norm(error,inf)

figure(1), clf, hold on
xx = 0:0.02:1; plot (xx,exact_solution(t,xx,D,nalpha,nbeta,u,hom-1),'-');
axis([0 1 -1 1]); plot (x,ynew,'o');
if central == 1,  s1 = ['Central fractional step omega-scheme'];
else,             s1 = ['Upwind fractional step omega-scheme'];
end
if defcor == 1
  s1 = ['Fractional step omega-scheme with defect correction'];
end
if bc == 1,  s1 = [s1, ', inhomogeneous Neumann'];
else         s1 = [s1, ', homogeneous Neumann'];
end
title(s1,'fontsize',12);
if hom ==1,  s2 = ['Homogeneous differential equation']
else,        s2 = ['Inhomogeneous differential equation']
end
s3 = ['omega=',num2str(omega),'  D=',num2str(D),' u=',num2str(u),...
 ' h=',num2str(h),'  dt=',num2str(dt),'  t=',num2str(T),'  n=',num2str(n)]
s4 = ['meshpeclet=',num2str(meshpeclet),' Courant=',num2str(sigma),...
 '  d=',num2str(2*d) ]


function [v,t]=histndim(x,b,mode)
%HISTNDIM - generates and/or plots an n-dimensional histogram
%
%  Inputs:  X(m,d)   is the input data: each row is one d-dimensiona data point
%           B(3,d)   specifies the histogram bins.
%                         B(1,:) gives the number of bins in each dmension [default 10]
%                         B(2,:) gives the minimum of the first bin in each dimension [default min(X)]
%                         B(3,:) gives the maximum of the last bin in each dimension [default max(X)]
%                    If B has only one column, the same values are use for al dimensions
%                    If B(1,i)=0 then that dimension will be ignored (and excluded from V)
%           MODE     is a character string containing a combination of the following:
%                        'z' for zero base in the 2D plot [default base = min(V)]
%                        'p' to scale V as probabilities [default actual counts]
%                        'h' to plot a histogam even if output arguments are present
%
% Outputs:  V        d-dimensional array containing the histogram counts
%           T        d-element cell array. d{i} contains the bin boundary values for
%                    the i'th dimension. The length of d{i} is one more than the number of bins
%                    in that dimension.
%
%                    Note that if any of B(1,:) are zero then the number of dimensions in V and elements
%                    of T will be correspondingly reduced.
%
% Example: histndim(randn(100000,2),[20 -3 3]','pz');

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

[n,d]=size(x);
if nargin<3
    mode=' ';
    if(nargin<2)
        b=repmat(10,1,d);
    end
end

if size(b,2)==1
    b=repmat(b,1,d);
end
if size(b,1)<3
    mi=min(x,[],1);
    ma=max(x,[],1);
    w=(ma-mi)./(b(1,:)-0.001);  % nudge slightly to make sure al points included
    b(3,:)=ma+0.0005*w;
    b(2,:)=mi-0.0005*w;
end

acd=find(b(1,:)>0);
sv=b(1,acd);
nbt=prod(sv);
t=cell(length(acd),1);

% loop through each dimension
k=1;        % indexing factor
ok=repmat(1>0,n,1);
ix=repmat(nbt-sum(cumprod(sv)),n,1);
for i=1:length(acd)
    j=acd(i);
    bw=b(1,j)/(b(3,j)-b(2,j));
    bi=ceil((x(:,j)-b(2,j))*bw);
    ok=ok & (bi>0) & (bi<=b(1,j));
    ix(ok)=ix(ok)+k*bi(ok);
    k=k*b(1,j);
    t{i}=b(2,j)+(0:b(1,j))/bw;
end
v=full(sparse(ix(ok),1,1,nbt,1));
if length(sv)>1
    v=reshape(v,sv);
end
if any(mode=='p')
    v=v/n;
end

if ~nargout | any(mode=='h')
    svg=find(sv>1);
    if length(svg)==1
        j=acd(svg);
        bar(b(2,j)+(0.5:sv(svg)-0.5)*(b(3,j)-b(2,j))/b(1,j),v(:));
    elseif length(svg)==2
        j=acd(svg(1));
        k=acd(svg(2));
        bj=b(1,j);
        bk=b(1,k);
        %     imagesc(b(2:3,k),b(2:3,j),reshape(v,b(1,j),b(1,k)));
        vda=kron(reshape(v,bj,bk),[1 1;1 1]);
        if any(mode=='z')
            ba=0;
        else
            ba=min(vda(:));
        end
        vda=[repmat(ba,1,2*bk+2);repmat(ba,2*bj,1) vda repmat(ba,2*bj,1);repmat(ba,1,2*bk+2)];
        jda=kron(t{svg(1)},[1 1]);
        jda=jda-(jda(3)-jda(2))*0.01*[-0.5 (-1).^(1:2*bj) 0.5]; % nudge slightly to avoid MATLAB plotting bug
        kda=kron(t{svg(2)},[1 1]);
        kda=kda-(kda(3)-kda(2))*0.01*[-0.5 (-1).^(1:2*bk) 0.5];
        surf(jda,kda,vda');
        ylabel(sprintf('Axis %d',k));
        xlabel(sprintf('Axis %d',j));
        colorbar;
    else
        fprintf(2,'Error in %s: Cannot plot 3-D histogram\n',mfilename);
    end
end


function varargout = plot_cubic(C,pe,p)
  % PLOT_CUBIC  Plot a cubic Bezier curve
  %
  % [pe,p] = plot_cubic(C)
  %
  % Inputs:
  %   C  4 by dim list of control points
  % Outputs:
  %   pe  plot handles for UI
  %   p  plot handle for curve
  %
  % Example:
  %   clf;hold on;arrayfun(@(c) set(plot_cubic(P(C(c,:),:)),'Color','b'),1:size(C,1));hold off;
  t = linspace(0,1)';
  P = cubic_eval(C,t);
  if ~exist('p','var') || isempty(p)
    p = plt(P,'-k','LineWidth',2);
  else
    set(p,'XData',P(:,1),'YData',P(:,2));
  end
  ish = ishold;
  hold on;
  aiblue = hex2dec(['4D';'80';'FF'])'/255;
  if ~exist('pe','var') || isempty(pe)
    pe = plot_edges(C,[1 2;3 4],'-o','Color',aiblue,'LineWidth',1);
  else
    set(pe(1),'XData',C(1:2,1),'YData',C(1:2,2));
    set(pe(2),'XData',C(3:4,1),'YData',C(3:4,2));
  end
  hold off;
  if ish
    hold on
  end
  if nargout>=1
    varargout{1} = pe;
    if nargout >= 2
      varargout{2} = p;
    end
  end
end