function FPDF = TabulatedPDF (x, p)
% Return function handles to routines to calculate the area, mean, and
% second moment of a unit-variance, zero-mean, uniform probability
% density function.
%                 b
%   Farea(a,b) = Int p(x) dx
%                 a
%                 b
%   Fmean(a,b) = Int x p(x) dx
%                 a
%                b
%   Fvar(a,b) = Int x^2 p(x) dx
%                a
% where p(x) is a tabulated function. The PDF is assumed to be zero outside
% of the limits, and defined by linear interpolation between points. The
% tabulated function need not be initially normalized to unit area.
%
% x - Abscissa values (in increasing order)
% p - Vector of probability values at the corresponding abscissa values.
%     The PDF is assumed to be zero outside of [x(1), x(end)] and to be
%     linearly interpolated between abscissa points.

% global xpdf pdf

% Test for increasing x
if (any(diff(x) < 0))
  error('TabulatedPDF - Non-increasing abscissa values');
end
if (any(p < 0))
  error('TabulatedPDF - Negative probability value');
end
if (length(x) ~= length(p) || length(x) <= 1)
  error('TabulatedPDF - Invalid table length');
end

% Normalize the tabulated data
xpdf = x;
pdf = p;
A = Tarea(-Inf, Inf);
pdf = pdf / A;

FPDF = {@Tarea, @Tmean, @Tvar};

return

%----- ----- begin nested functions
function v = Tarea (a, b)

% global xpdf pdf

v = TabulatedPDFInt(@TLarea, a, b, xpdf, pdf);

return
end

% ----- ------
function v = Tmean (a, b)

% global xpdf pdf

v = TabulatedPDFInt(@TLmean, a, b, xpdf, pdf);

return
end

% ----- ------
function v = Tvar (a, b)

% global xpdf pdf

v = TabulatedPDFInt(@TLvar, a, b, xpdf, pdf);

return
end

% ----- -----
function v = TabulatedPDFInt (Fn, a, b, x, p)
% The abscissa values are assumed to be in increasing order

% Limit the evaluation interval and flip the limits if a > b
br = min(x(end), max(a, b));
ar = max(x(1), min(a, b));

if (br <= ar)
  v = 0;
  return
end

% Search for the intervals included in the integral
iL = max(find(x <= ar));
iU = min(find(x >= br));
if (iL == iU)
  error('TabulatedPDFInt - iL == iU');
end
x = x(iL:iU);       % Keep only intervals of interest
p = p(iL:iU);

% Lop off the end intervals
p(1) = Alin(ar, x(1:2), p(1:2));
x(1) = ar;
p(end) = Alin(br, x(end-1:end), p(end-1:end));
x(end) = br;

% Integrate
v = feval(Fn, x, p);

% Negate the integral if a > b
if (a > b)
  v = -v;
end

return
end

% ----- -----
function v = TLarea (x, p)

xl = x(1:end-1);
xu = x(2:end);
pl = p(1:end-1);
pu = p(2:end);
% syms p pl pu xl xu x
% p = pl+(x-xl)*(pu-pl)/(xu-xl)
% factor(int(p,xl,xu)
% ans = -1/2*(pl+pu)*(-xu+xl)
A = (xu-xl) .* (pl+pu);

v = 0.5 * sum(A);

return
end

% ----- ------
function v = TLmean (x, p)

xl = x(1:end-1);
xu = x(2:end);
pl = p(1:end-1);
pu = p(2:end);
% syms p pl pu xl xu x
% p = pl+(x-xl)*(pu-pl)/(xu-xl)
% factor(int(x*p,xl,xu)
% ans = -1/6*(-xu+xl)*(2*pl*xl+pu*xl+pl*xu+2*pu*xu)
A = (xu-xl) .* ((xl+xu) .* (pl+pu) + pl.*xl + pu.*xu);

v = sum(A) / 6;

return
end

% ----- -----
function v = TLvar (x, p)

xl = x(1:end-1);
xu = x(2:end);
pl = p(1:end-1);
pu = p(2:end);
% syms p pl pu xl xu x
% p = pl+(x-xl)*(pu-pl)/(xu-xl)
% factor(int(x^2*p,xl,xu)
% ans = -1/12*(-xu+xl)
%          *(3*pl*xl^2+pu*xl^2+2*xl*pu*xu+2*pl*xu*xl+pl*xu^2+3*pu*xu^2)
A =  (xu-xl) .* ((pu+pl) .* (xu+xl).^2 + 2*(pu.*xu.^2 + pl.*xl.^2));

v = sum(A) / 12;

return
end

% ----- -----
function pa = Alin(a, x, p)

slope = (p(2) - p(1)) / (x(2) - x(1));
pa = (a - x(1)) * slope + p(1);

return
end

% ---- end of the nested functions
end


function [inpC,p] = regCorrContrast(inp,Limit,pinit);
% regCorrContrast - removes mean and normalizes by the standard deviation,
%                both estimated by minimizing a robust error measure
%                between the sampled histogram and a mixture of 2 gaussians.
%
% [inpC,p] = regCorrContrast(inp, <pinit>);
%
% INPUT:
% - inp: set of original inplanes
% - pinit: initial parameters of the two best fitting Gaussians (optional)
%          (pinit = [mu1 sigma1^2 mu2 sigma2^2 p1 p2])
%
% Oscar Nestares - 5/99
%

if nargin<2
   Limit = 2;
end

% building the histogram
II = find(~isnan(inp));
[h x] = regHistogram(double(inp(II)), 256);

% normalizing the histogram
h = h/(sum(h)*mean(diff(x)));

% initial parameters: if they are not specified, chosoe the first
% gaussian with the actual mean and variance, and the second gaussian
% around 1 and with 1/10 of the actual variance, both with weights of 0.5
if nargin<3
   pinit = [mean(inp(II)) var(inp(II)) 1 var(inp(II))/10 0.5 0.5];
end

% minimizing the robust measure of the error
%p=fmins('regErrGaussRob', pinit, [], [], x, h);
p = fminsearch('regErrGaussRob', double(pinit), [], x, h);

% selecting the mean closer to 1
if abs(p(1)-1)>abs(p(3)-1)
   mu = p(3); sigma2 = p(4);
else
   mu = p(1); sigma2 = p(2);
end

% renormalizing
inpC = (inp - mu)/sqrt(sigma2);

% saturating for low and high values
%Limit = 4;  %%% This is a reasonable value, 2*std (now std=1)
Low = inpC < -Limit;
High = inpC > Limit;
inpC = inpC .*((~Low) & (~High)) + (-Limit)*Low + Limit*High;

return


function [s,d,S_k,S_si] = pinHoleSegment(k,si)

% PINHOLESEGMENT  Pin hole projection of a segment.
%   [S,D] = PINHOLESEGMENT(K,SI) projects into a pinhole camera with
%   intrinsic aprameters K the segment SI. It returns the projected segment
%   S and the non-observable depths D of the two endpoints.
%
%   SI is a 6-vector containing the two endpoints of the 3D segment.
%   S is a 4-vector conteining the two endpoints of the 2D segment.
%
%   SI can also be a 6-by-N matrix with N segments. In such case S is a
%   4-by-N matrix with N projected segments.
%
%   [S,D,S_k,S_si] = POINHOLESEGMENT(...) returns the Jacobians of S wrt K
%   and SI. It only works for single segments.
%
%   See also PINHOLE.

%   Copyright 2008-2009 Joan Sola @ LAAS-CNRS.

p1 = si(1:3,:);
p2 = si(4:6,:);

if nargout <= 2

    [e1,d1] = pinHole(p1,k);
    [e2,d2] = pinHole(p2,k);
    s       = [e1;e2];
    d       = [d1;d2];

else % Jacobians

    if size(si,2) == 1

        [e1,d1,E1_p1,E1_k] = pinHole(p1,k);
        [e2,d2,E2_p2,E2_k] = pinHole(p2,k);
        s       = [e1;e2];
        d       = [d1;d2];

        S_k = [...
            E1_k
            E2_k];

        Z23 = zeros(2,3);

        S_si = [...
            E1_p1 Z23
            Z23   E2_p2];

    else

        error('Jacobians not available for multiple segments.')

    end

end

return

%% test
syms p1 p2 p3 q1 q2 q3 u0 v0 au av real
k  = [u0;v0;au;av];
si = [p1;p2;p3;q1;q2;q3];

[s,d,S_k,S_si] = pinHoleSegment(k,si);

simplify(S_k - jacobian(s,k))
simplify(S_si - jacobian(s,si))

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

%   # START GPL LICENSE

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

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

%   # END GPL LICENSE


function value = r4_li ( x )

%*****************************************************************************80
%
%% R4_LI evaluates the logarithmic integral for an R4 argument.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 September 2011
%
%  Author:
%
%    Original FORTRAN77 version by Wayne Fullerton.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Wayne Fullerton,
%    Portable Special Function Routines,
%    in Portability of Numerical Software,
%    edited by Wayne Cowell,
%    Lecture Notes in Computer Science, Volume 57,
%    Springer 1977,
%    ISBN: 978-3-540-08446-4,
%    LC: QA297.W65.
%
%  Parameters:
%
%    Input, real X, the argument.
%
%    Output, real VALUE, the logarithmic integral evaluated at X.
%
  persistent sqeps

  if ( isempty ( sqeps ) )
    sqeps = sqrt ( r4_mach ( 3 ) );
  end

  if ( x < 0.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R4_LI - Fatal error!\n' );
    fprintf ( 1, '  Function undefined for X <= 0.\n' );
    error ( 'R4_LI - Fatal error!' )
  end

  if ( x == 0.0 )
    value = 0.0;
    return
  end

  if ( x == 1.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R4_LI - Fatal error!\n' );
    fprintf ( 1, '  Function undefined for X = 1.\n' );
    error ( 'R4_LI - Fatal error!' )
  end

  if ( abs ( 1.0 - x ) < sqeps )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R4_LI - Warning!\n' );
    fprintf ( 1, '  Answer less than half precision.\n' );
    fprintf ( 1, '  X is too close to 1.\n' );
  end

  value = r4_ei ( log ( x ) );

  return
end


function [x,m,e] = RunningAverage(X,Y,varargin)

%RunningAverage - Compute running linear or angular average.
%
% Computes the running average of y=f(x). Variable y can be linear or circular
% (use radians). The error bars are standard errors of the mean for linear
% data, or 95% confidence intervals for circular data.
%
%  USAGE
%
%    [x,m,e] = RunningAverage(x,y,<options>)
%
%    x              x variable (e.g., time)
%    y              values at x
%    <options>      optional list of property-value pairs (see table below)
%
%    =========================================================================
%     Properties    Values
%    -------------------------------------------------------------------------
%     'window'      averaging window size (default (max-min)/10)
%     'overlap'     overlap between successive windows (default = 0.8*window)
%     'limits'      x limits to use instead of min and max
%     'type'        either 'linear' or 'circular' (default 'linear')
%    =========================================================================
%
%  OUTPUT
%
%    x              new x variable
%    m              running average
%    e              sem for linear variables, otherwise 95% confidence intervals

% Copyright (C) 2004-2011 by Michaël Zugaro
%
% This program is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 3 of the License, or
% (at your option) any later version.

% Default values
type = 'linear';
limits = [min(X) max(X)];
nBins = 10;
window = 0;
overlap = [];

if nargin < 2 | mod(length(varargin),2) ~= 0,
  error('Incorrect number of parameters (type ''help RunningAverage'' for details).');
end

% Parse parameter list
for i = 1:2:length(varargin),
	if ~ischar(varargin{i}),
		error(['Parameter ' num2str(i+2) ' is not a property (type ''help RunningAverage'' for details).']);
	end
	switch(lower(varargin{i})),
		case 'type',
			type = varargin{i+1};
			if ~isstring_FMAT(type,'linear','circular'),
				error('Incorrect value for property ''type'' (type ''help RunningAverage'' for details).');
			end

		case 'window',
			window = varargin{i+1};
			if ~isdscalar(window,'>0'),
				error('Incorrect value for property ''window'' (type ''help RunningAverage'' for details).');
			end

		case 'overlap',
			overlap = varargin{i+1};
			if ~isdscalar(overlap,'>=0'),
				error('Incorrect value for property ''overlap'' (type ''help RunningAverage'' for details).');
			end

		case 'limits',
			limits = varargin{i+1};
			if ~isdvector(limits,'#2','<'),
				error('Incorrect value for property ''limits'' (type ''help RunningAverage'' for details).');
			end

		otherwise,
			error(['Unknown property ''' num2str(varargin{i}) ''' (type ''help RunningAverage'' for details).']);

	end
end

x0 = limits(1);
x1 = limits(2);
if window == 0,
	window = (x1-x0)/nBins;
end
if isempty(overlap),
	overlap = 0.8*window;
end

% Loop through data
i = 1;
xi = x0+window/2;
while xi+window/2 <= x1,
	x(i,1) = xi;
	ok = InIntervals(X,xi+[-0.5 0.5]*window);
	if sum(ok) == 0,
		m(i,1) = NaN;
		e(i,:) = [NaN NaN];
	elseif strcmp(type,'circular'),
		[M,C] = CircularConfidenceIntervals(Y(ok));
		m(i,1) = M;
		e(i,:) = C;
	else
		m(i,1) = nanmean(Y(ok));
		n = sum(ok);
		s = nanstd(Y(ok))/sqrt(n);
		e(i,1) = m(i)-s;
		e(i,2) = m(i)+s;
	end
	xi = xi + window - overlap;
	i = i + 1;
end


function seed = i4_seed_advance ( seed )

%*****************************************************************************80
%
%% I4_SEED_ADVANCE "advances" the seed.
%
%  Discussion:
%
%    This routine implements one step of the recursion
%
%      SEED = ( 16807 * SEED ) mod ( 2^31 - 1 )
%
%    This version of the routine does not check whether the input value of
%    SEED is zero.  If the input value is zero, the output value will be zero.
%
%    If we repeatedly use the output of SEED_ADVANCE as the next input,
%    and we start with SEED = 12345, then the first few iterates are:
%
%         Input      Output
%          SEED        SEED
%
%         12345   207482415
%     207482415  1790989824
%    1790989824  2035175616
%    2035175616    77048696
%      77048696    24794531
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    05 April 2013
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Paul Bratley, Bennett Fox, Linus Schrage,
%    A Guide to Simulation,
%    Second Edition,
%    Springer, 1987,
%    ISBN: 0387964673,
%    LC: QA76.9.C65.B73.
%
%    Bennett Fox,
%    Algorithm 647:
%    Implementation and Relative Efficiency of Quasirandom
%    Sequence Generators,
%    ACM Transactions on Mathematical Software,
%    Volume 12, Number 4, December 1986, pages 362-376.
%
%    Pierre L'Ecuyer,
%    Random Number Generation,
%    in Handbook of Simulation,
%    edited by Jerry Banks,
%    Wiley, 1998,
%    ISBN: 0471134031,
%    LC: T57.62.H37.
%
%    Peter Lewis, Allen Goodman, James Miller,
%    A Pseudo-Random Number Generator for the System/360,
%    IBM Systems Journal,
%    Volume 8, Number 2, 1969, pages 136-143.
%
%  Parameters:
%
%    Input, integer SEED, the seed value.
%
%    Output, integer SEED, the "next" seed.
%
  i4_huge = 2147483647;

  seed = floor ( seed );

  seed = mod ( seed, i4_huge );

  if ( seed < 0 )
    seed = seed + i4_huge;
  end

  k = floor ( seed / 127773 );

  seed = 16807 * ( seed - k * 127773 ) - k * 2836;

  if ( seed < 0 )
    seed = seed + i4_huge;
  end

  return
end


function determ = carry_determinant ( n, alpha )

%*****************************************************************************80
%
%% CARRY_DETERMINANT returns the determinant of the CARRY matrix.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%
%    Input, integer ALPHA, the numeric base being used in the addition.
%
%    Output, real DETERM, the determinant.
%
  power = ( n * ( n - 1 ) ) / 2;
  determ = 1.0 / alpha^power;

  return
end


function x = uniform_01_cdf_inv ( cdf )

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

  x = cdf;

  return
end


function optionValueReturned = optionvalue(SpotPrice, StrikePrice, RiskFreeRate,TimeExpiry, Volatility,theOptionType,ButterflyRange)
% mcc -d compiled -B 'ccom:BSOptionModel,BSOptionModelClass,1' optionvalue.m webvizroutine.m
%CALCROUTINE Calculate the value of the option

OptionType = lower(theOptionType);

if (strcmpi(OptionType,'call') == 1) %Call option

     %Convert months to expiry to years to expiry
     TimeExpiry = TimeExpiry / 12;

     %Calculate the value of the option
     optionValueReturned = blsprice(SpotPrice, StrikePrice, RiskFreeRate, ...
          TimeExpiry, Volatility);

elseif (strcmpi(OptionType,'put') == 1) %Put option

     %Convert months to expiry to years to expiry
     TimeExpiry = TimeExpiry / 12;

     %Calculate the value of the put option
     optionValueReturned = blsprice(SpotPrice, StrikePrice, RiskFreeRate, ...
          TimeExpiry, Volatility);

elseif (strcmpi(OptionType,'straddle') == 1) %Straddle option

     %Convert months to expiry to years to expiry
     TimeExpiry = TimeExpiry / 12;

     %Compute the value of the straddle

     optionValueReturned = blsstrval(SpotPrice, StrikePrice, RiskFreeRate, ...
          TimeExpiry, Volatility);

elseif (strcmpi(OptionType,'butterfly') == 1) %Butterfly option

     %Convert months to expiry to years to expiry
     TimeExpiry = TimeExpiry / 12;

     %Compute the value of the butterfly
     optionValueReturned = blsbtyval(SpotPrice, StrikePrice, RiskFreeRate, ...
          TimeExpiry, Volatility, ButterflyRange);

end

%--------------------------------------------------------------------------

function StraddleValue = blsstrval(SpotPrice, StrikePrice, RiskFreeRate, ...
          TimeExpiry, Volatility)
%BLSSTRVAL Black Scholes value of a straddle option

%Calculate the value of both the call and put option
[CallValue, PutValue] = blsprice(SpotPrice, StrikePrice, RiskFreeRate, ...
     TimeExpiry, Volatility);

%Compute the value of the straddle
StraddleValue = CallValue + PutValue;

%end of BLSSTRVAL subroutine

function ButterflyValue = blsbtyval(SpotPrice, StrikePrice, RiskFreeRate, ...
          TimeExpiry, Volatility, ButterflyRange)
%BLSBTYVAL Black Scholes value of a butterfly option

%Set the different strike prices
LowStrike = StrikePrice .* (1 - ButterflyRange);
HighStrike = StrikePrice .* (1 + ButterflyRange);

%Value the long positions in the low and high struck calls
LowValue = blsprice(SpotPrice, LowStrike, RiskFreeRate, ...
     TimeExpiry, Volatility);
HighValue = blsprice(SpotPrice, HighStrike, RiskFreeRate, ...
     TimeExpiry, Volatility);

%Value the short position in the calls struck at the initial strike
%price
ShortValue = 2 .* -(blsprice(SpotPrice, StrikePrice, RiskFreeRate, ...
     TimeExpiry, Volatility));

%Calculate the total value of the butterfly
ButterflyValue = LowValue + HighValue + ShortValue;

%end of BLSBTYVAL subroutine


clear all; close all; clc;

%%
L=10; x3=-L:0.1:L; n=length(x3)-1; % define domain
x2=x3(1:n); k=(2*pi/(2*L))*[0:n/2-1 -n/2:-1]; % k-vector
ye=exp(-(x2.^2)); ye2=exp((x2.^2)/2); % define Gaussians
for j=0:9      % loop through 10 modes
  yd=real(ifft(((i*k).^j).*fft(ye))); % 2nd derivative
  mode=((-1)^(j))*(((2^j)*factorial(j)*sqrt(pi))^(-0.5))*ye2.*yd;
  y(:,j+1)=(mode).';  % store modes as columns
end

x=x2(n/2+1-40:n/2+1+40);  % keep only -4<x<4
yharm=y(n/2+1-40:n/2+1+40,:);

%%
n=length(x);
f=(exp(-(x-0.5).^2)+3*exp(-2*(x+1.5).^2))';

for j=1:10  % full reconstruction
  a(j,1)=trapz(x,f.*yharm(:,j));
end
f2=yharm*a;
Efull(1)=log(norm(f2-f)+1);  % reconstruction error

for j=1:10  % matrix M reconstruction
   for jj=1:j
       Area=trapz(x,yharm(:,j).*yharm(:,jj));
       M(j,jj)=Area;
       M(jj,j)=Area;
   end
end
Cfull=cond(M)   % get condition number

%% Test Random trials with P% of measurements
for thresh=1:5;
  for jloop=1:1000  % 1000 random trials
    n2=randsample(n,8*thresh);  % random sampling
    P=zeros(n,1); P(n2)=1;
    for j=1:10
        for jj=1:j   % compute M matrix
            Area=trapz(x,P.*(yharm(:,j).*yharm(:,jj)));
            M2(j,jj)=Area; M2(jj,j)=Area;
        end
    end
    for j=1:10  % reconstruction using gappy
        ftild(j,1)=trapz(x,P.*(f.*yharm(:,j)));
    end
    atild=M2\ftild;   % compute error
    f2=yharm*atild;   % compute reconstruction
    Err(jloop)=norm(f2-f); % L2 error
    con(jloop)=cond(M2);   % condition number
  end
  % mean and variance
  E(thresh)=mean(log(Err+1)); V(thresh)=(var(log(Err+1)));
  Ec(thresh)=mean(log(con)); Vc(thresh)=(var(log(con)));
end
E=[E Efull]; V=[V 0];
Ec=[Ec log(Cfull)]; Vc=[Vc 0];
subplot(2,1,1), bar(E), hold on, errorbar(E,V,'r.')
subplot(2,1,2), bar(Ec), hold on, errorbar(Ec,Vc,'r.')

%%  For 20% measurements, sort great from bad

Pmaster=[];
for jloop=1:200  % 200 random trials
n2=randsample(n,20);
P=zeros(n,1); P(n2)=1;

Pmaster=[Pmaster P];

for j=1:10
   for jj=1:j
       Area=trapz(x,P.*(yharm(:,j).*yharm(:,jj)));
       M2(j,jj)=Area; M2(jj,j)=Area;
   end
end
for j=1:10  % reconstruction using gappy
  ftild(j,1)=trapz(x,P.*(f.*yharm(:,j)));
end
atild=M2\ftild;   % compute error
f2=yharm*atild;
Er(jloop)=norm(f2-f);
co(jloop)=cond(M2);

end

%%
figure(5)
subplot(3,1,1), bar(log(co))
subplot(3,1,2), hist(log(Er+1),50)
subplot(3,1,3), hist(log(co),50)

figure(7)
pcolor(-Pmaster.'), colormap(hot)

[Cloc,jloc]=sort(co);
figure(8)
%bar(log(Cloc));

jbest=jloc(1:11); jworst=jloc(end-10:end);
Sbest(:,1:11)=Pmaster(:,jbest);
Sworst(:,1:11)=Pmaster(:,jworst);
csor=[100*Cloc(1:10) zeros(1,10) Cloc(end-9:end)];

subplot(3,1,1), pcolor(-Sbest.'); colormap(hot)
subplot(3,1,2), pcolor(-Sworst.'); colormap(hot)
subplot(3,1,3), bar(csor)

%%
figure(7), axis off
figure(8), subplot(3,1,1), axis off
figure(8), subplot(3,1,2), axis off
figure(8), subplot(3,1,3), set(gca,'Xticklabel',{},'Yticklabel',{},'Xlim',[0 31])
figure(5), subplot(3,1,1), set(gca,'Xticklabel',{},'Yticklabel',{},'Xlim',[0 200])
figure(5), subplot(3,1,2), set(gca,'Xticklabel',{},'Yticklabel',{})
figure(5), subplot(3,1,3), set(gca,'Xticklabel',{},'Yticklabel',{})
figure(3), subplot(2,1,1), set(gca,'Xticklabel',{},'Yticklabel',{})
figure(3), subplot(2,1,2), set(gca,'Xticklabel',{},'Yticklabel',{})

%%

clear q
clear q2
figure(9)
m=30;
q=rand(m,m); n=m^2;
p=randsample(n,200);
q2=zeros(m,m);
q2(p)=q(p);
p2=randsample(n,40);
q3=zeros(m,m);
q3(p2)=q(p2);
pcolor(-q), colormap(hot), caxis([-1 0]), axis off
figure(10)
pcolor(-q2), colormap(hot), caxis([-1 0]), axis off
figure(11)
pcolor(-q3), colormap(hot), caxis([-1 0]), axis off


function x = daub2_transform_inverse ( n, y )

%*****************************************************************************80
%
%% DAUB2_TRANSFORM_INVERSE inverts the DAUB2 transform of a vector.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 July 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the dimension of the vector.
%    N must be a power of 2.
%
%    Input, real Y(N), the transformed vector.
%
%    Output, real X(N), the original vector.
%
  c = [ 7.071067811865475E-01, ...
        7.071067811865475E-01 ];

  x(1:n,1) = y(1:n);
  z(1:n,1) = 0.0;

  m = 1;

  while ( m * 2 <= n )

    for i = 1 : m
      z(2*i-1,1) = c(1) * ( x(i) + x(i+m) );
      z(2*i,1)   = c(2) * ( x(i) - x(i+m) );
    end

    x(1:2*m,1) = z(1:2*m);

    m = m * 2;

  end

  return
end


function out = arcLength(f, a, b)
%ARCLENGTH   Compute the length of the arc defined by a CHEBFUN.
%   ARCLENGTH(F) returns the arc length of the curve defined by CHEBFUN F in
%   the x-y plane over the interval where it is defined. If F is complex,
%   the output is the arc length of the curve in the complex plane.
%
%   ARCLENGTH(F, A, B) returns the arc length of F over the interval [A, B],
%   where [A, B] is a subinterval of the domain in which F is defined. In the
%   case of complex-valued F, ARCLENGTH(F, A, B) computes the length of the
%   arc whose ends correspond to A and B.
%
%   If F is a quasimatrix, the arc length of each CHEBFUN in F is computed
%   and a vector is returned.
%
% Examples:
%
%   f = chebfun(@(x) sin(x), [0 1]); L = arcLength(f)
%
%   arcLength(chebfun('exp(1i*pi*s)'))/(2*pi)

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

% Empty CHEBFUN:
if ( isempty(f) )
    out = [];
    return
end

% Check the first input for its type:
if ( ~isa(f, 'chebfun') )
    error('CHEBFUN:CHEBFUN:arcLength:Input', ...
        'The first argument must be a chebfun object.')
end

% Get the interval corresponding to the arc:
if ( nargin == 3 )
    % Full arguments:
    dom(1) = a;
    dom(2) = b;
elseif ( nargin == 2 )
    % Two arguments: the second argument is a vector:
    if ( max( size(a) ) ~= 2 )
        error('CHEBFUN:CHEBFUN:arcLength:Input', ...
            'The second argument must be a 1x2 vector.')
    end
    dom = a;
else
    % Single argument:
    dom = [f(1).domain(1) f(1).domain(end)];
end

% Loop over each column or row:
fPrime = f;
for i = 1:numel(f.funs)
    % This makes sure that no delta functions are
    % generated due to jump discontinuities. pointValues of fPrime are not
    % updated since they are not needed.
    fPrime.funs{i} = diff(f.funs{i});
end

if ( isreal(f) )
    g = sqrt(1 + fPrime.^2);
    out = sum(g, dom(1), dom(2));

else
    out = sum(abs(fPrime), dom(1), dom(2));
end

% Reform the output to accommodate the transposedness with the input:
if ( f(1).isTransposed )
    out = out.';
end

end


function b = c8mat_fss ( n, a, nb, b )

%*****************************************************************************80
%
%% C8MAT_FSS factors and solves a system with multiple right hand sides.
%
%  Discussion:
%
%    This routine uses partial pivoting, but no pivot vector is required.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 March 2013
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%    N must be positive.
%
%    Input, complex A(N,N), the coefficient matrix of the linear system.
%
%    Input, integer NB, the number of right hand sides.
%
%    Input, complex B(N,NB), the right hand side of the linear system.
%
%    Output, complex B(N,NB), the solution of the linear system.
%
  info = 0;

  for jcol = 1 : n
%
%  Find the maximum element in column I.
%
    piv = abs ( a(jcol,jcol) );
    ipiv = jcol;
    for i = jcol+1 : n
      if ( piv < abs ( a(i,jcol) ) )
        piv = abs ( a(i,jcol) );
        ipiv = i;
      end
    end

    if ( piv == 0.0 )
      info = jcol;
      fprintf ( 1, '\n' );
      fprintf ( 1, 'C8MAT_FSS - Fatal error!\n' );
      fprintf ( 1, '  Zero pivot on step %d\n', info );
      return
    end
%
%  Switch rows JCOL and IPIV, and B.
%
    if ( jcol ~= ipiv )

      for j = 1 : n
        t         = a(jcol,j);
        a(jcol,j) = a(ipiv,j);
        a(ipiv,j) = t;
      end

      t(1,1:nb)    = b(jcol,1:nb);
      b(jcol,1:nb) = b(ipiv,1:nb);
      b(ipiv,1:nb) = t(1,1:nb);

    end
%
%  Scale the pivot row.
%
    temp = a(jcol,jcol);
    a(jcol,jcol) = 1.0;
    a(jcol,jcol+1:n) = a(jcol,jcol+1:n) / temp;
    b(jcol,1:nb) = b(jcol,1:nb) / temp;
%
%  Use the pivot row to eliminate lower entries in that column.
%
    for i = jcol+1 : n
      if ( a(i,jcol) ~= 0.0 )
        temp = - a(i,jcol);
        a(i,jcol) = 0.0;
        a(i,jcol+1:n) = a(i,jcol+1:n) + temp * a(jcol,jcol+1:n);
        b(i,1:nb) = b(i,1:nb) + temp * b(jcol,1:nb);
      end
    end

  end
%
%  Back solve.
%
  for j = 1 : nb
    for jcol = n : -1 : 2
      b(1:jcol-1,j) = b(1:jcol-1,j) - a(1:jcol-1,jcol) * b(jcol,j);
    end
  end

  return
end


function varargout = solver_sDantzig( A, b, delta, mu, x0, z0, opts, varargin )
% SOLVER_SDANTZIG Dantzig selector problem. Uses smoothing.
%[ x, out, opts ] = solver_sDantzig( A, b, delta, mu, x0, z0, opts )
%    Solves the smoothed Dantzig
%        minimize norm(x,1) + (1/2)*mu*norm(x-x0).^2
%        s.t.     norm(D.*(A'*(A*x-b)),Inf) <= delta
%    by constructing and solving the composite dual
%        maximize - g_sm(z) - delta*norm(z,1)
%    where
%        gsm(z) = sup_x <z,D.*A'*(Ax-b)>-norm(x,1)-(1/2)*mu*norm(x-x0)
%    A must be a linear operator, b must be a vector, and delta and mu
%    must be positive scalars. Initial points x0 and z0 are optional.
%    The standard calling sequence assumes that D=I. To supply a scaling,
%    pass the cell array { A, D } instead of A. D must either be a scalar,
%    a vector of weights, or a linear operator.

% Supply default values
error(nargchk(4,8,nargin));
if nargin < 5, x0   = []; end
if nargin < 6, z0   = []; end
if nargin < 7, opts = []; end

% -- legacy options from original software --
if isfield(opts,'lambda0')
    z0 = opts.lambda0;
    opts = rmfield(opts,'lambda0');
end
if isfield(opts,'xPlug')
    x0 = opts.xPlug;
    opts = rmfield(opts,'xPlug');
end
if isfield(opts,'solver')
    svr     = opts.solver;
    opts    = rmfield(opts,'solver');
    if isfield(opts,'alg') && ~isempty(opts.alg)
        disp('Warning: conflictiong options for the algorithm');
    else
        % if specified as "solver_AT", truncate:
        s = strfind( svr, '_' );
        if ~isempty(s), svr = svr(s+1:end); end
        opts.alg = svr;
    end
end

% Extract the linear operators
D = [];
if isa( A, 'cell' ),
    if length(A) > 1, D = A{2}; end
    A = A{1};
end
if isempty(D),
    D = @(x)x;
elseif isa( D, 'double' ),
    D = @(x)D.*x;
end
if isa( A, 'double' ),
    A = linop_matrix(A);
end

% Call TFOCS
objectiveF = prox_l1;
affineF    = { @(y,mode)linear_DS( D, A, y, mode ), -D(A(b,2)) };
dualproxF  = prox_l1( delta );
[varargout{1:max(nargout,1)}] = ...
    tfocs_SCD( objectiveF, affineF, dualproxF, mu, x0, z0, opts, varargin{:} );

% Implements x -> D*A'*A*x and its adjoint if A is a linop
function y = linear_DS( D, A, y, mode )
switch mode,
case 0,
    y = A([],0);
    if iscell( y ),
        y = { y{1}, y{1} };
    else
        y = { [y(2),1], [y(2),1] };
    end
case 1, y = D(A(A(y,1),2));
case 2, y = A(A(D(y),1),2);
end

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


function c = ultra2ultra(c, lam_in, lam_out)
%ULTRA2ULTRA   Convert between Ultraspherical (US) expansions.
%   C_OUT = ULTRA2ULTRA(C_IN, LAM_IN, LAM_OUT) converts the vector C_IN of
%   US-LAM_IN coefficients to a vector of US-LAM_OUT coefficients.
%
%   This code is essentially a wrapper for the JAC2JAC code based on [1].
%
%   References:
%     [1] A. Townsend, M. Webb, and S. Olver, "Fast polynomial transforms
%     based on Toeplitz and Hankel matrices", submitted, 2016.
%
% See also JAC2JAC.

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

n = length(c) - 1;

% Scale input from US to Jacobi basis:
c = c./scl(lam_in, n);
% Call JAC2JAC:
c = jac2jac(c, lam_in-.5, lam_in-.5, lam_out-.5, lam_out-.5);
% Scale output from Jacobi to US:
c = c.*scl(lam_out, n);

end

function s = scl(lam, n)
% Scaling from Jacobi to US polynomials. See DLMF Table 18.3.1.
    if ( lam == 0 )
        nn = (0:n-1).';
        s = [1 ; cumprod((nn+.5)./(nn+1))];
    else
        nn = (0:n).';
        s = ( gamma(2*lam) ./ gamma(lam+.5) ) * ...
            exp( gammaln(lam+.5+nn) - gammaln(2*lam+nn) );
    end
end


% Diagram of van Albada limiter

% Theory in Section 10.8 of:

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

% This program makes Fig. 10.27 in the book

figure(1), clf, hold on

x = 0.0:0.01:4.0; y = (x.*x + x)./(1 + x.*x);	% Graph of van Albada limiter
plot(x,y)

x = 0.0:0.01:1.1; y = 0.5*(1+sqrt(2))*x; plot(x,y)
x = 0.0:0.01:4.0; y = 0.5*(1+sqrt(2))*ones(size(x)); plot(x,y)
y = ones(size(x)); plot(x,y)
x = 0.0:0.01:1.3; plot(x,x)
y = 0.0:0.01:1; x = ones(size(y)); plot(x,y,'--')


function Umap=FM2map(im,U,H)
% Unpack fuzzy-membership funcitons to produce membership maps.
%
% INPUT ARGUMENTS:
%   - im    : N-dimensional grayscale image in integer format.
%   - U     : L-by-c array of fuzzy class memberships, where c is the
%             number of classes and L is the intensity range of the input
%             image, such that L=numel(min(im(:)):max(im(:))). See
%             FastFCMeans for more info.
%   - H     : image histogram returned by FastFCMeans function.
%
% OUTPUT:
%   - Umap  : membership maps. Umap has the same size as the input image
%             plus an additional dimension to account for c classes. For
%             example, if im is a 2D M-by-N image then U will be
%             M-by-N-by-c array where U(:,:,i) is a membership map for the
%             i-th class.
%
% AUTHOR    : Anton Semechko (a.semechko@gmail.com)
% DATE      : May.2013
%

if nargin<3 || isempty(H)

    % Intensity range
    Imin=double(min(im(:)));
    Imax=double(max(im(:)));
    I=(Imin:Imax)';

    % Intensity histogram
    H=hist(double(im(:)),I);
    H=H(:);

end

% Unpack memberships
Umap=zeros(sum(H),size(U,2));
i1=1; i2=0;
for i=1:numel(H)
    i2=i2+H(i);
    Umap(i1:i2,:)=repmat(U(i,:),[H(i) 1]);
    i1=i2+1;
end

% Find the positional mapping
[~,idx]=sort(im(:), 'ascend');
[~,idx]=sort(idx(:),'ascend');

% Reshape membership maps to match image dimensions.
Umap=reshape(Umap(idx,:),[size(im) size(U,2)]);


function [mu,dmu,k,gamma] = sparse_learning(Phi,T,lambda,iters,flag1,flag2,flag3)
% *************************************************************************
%
% *** PURPOSE ***
% Implements generalized versions of SBL and FOCUSS for learning sparse
% representations from possibly overcomplete dictionaries.
%
%
% *** USAGE ***
% [mu,dmu,k,gamma] = sparse_learning(Phi,T,lambda,iters,flag1,flag2,flag3);
%
%
% *** INPUTS ***
% Phi       = N X M dictionary
% T         = N X L data matrix
% lambda    = scalar trade-off parameter (balances sparsity and data fit)
% iters     = maximum number of iterations
%
% flag1     = 0: fast Mackay-based SBL update rules
% flag1     = 1: fast EM-based SBL update rule
% flag1     = 2: traditional (slow but sometimes better) EM-based SBL update rule
% flag1     = [3 p]: FOCUSS algorithm using the p-valued quasi-norm
%
% flag2     = 0: regular initialization (equivalent to min. norm solution)
% flag2     = gamma0: initialize with gamma = gamma0, (M X 1) vector
%
% flag3     = display flag; 1 = show output, 0 = supress output
%
% *** OUTPUTS ***
% mu        = M X L matrix of weight estimates
% dmu       = delta-mu at convergence
% k         = number of iterations used
% gamma     = M X 1 vector of hyperparameter values
%
%
% *************************************************************************
% Written by:  David Wipf, david.wipf@mrsc.ucsf.edu
% *************************************************************************

% *** Control parameters ***
MIN_GAMMA       = 1e-16;
MIN_DMU         = 1e-12;
MAX_ITERS       = iters;
DISPLAY_FLAG    = flag3;     % Set to zero for no runtime screen printouts

% *** Initializations ***
[N M] = size(Phi);
[N L] = size(T);

if (~flag2)         gamma = ones(M,1);
else                gamma = flag2;  end;

keep_list = [1:M]';
m = length(keep_list);
mu = zeros(M,L);
dmu = -1;
k = 0;

% *** Learning loop ***
while (1)

    % *** Prune things as hyperparameters go to zero ***
    if (min(gamma) < MIN_GAMMA )
		index = find(gamma > MIN_GAMMA);
		gamma = gamma(index);
		Phi = Phi(:,index);
		keep_list = keep_list(index);
        m = length(gamma);

        if (m == 0)   break;  end;
    end;

    % *** Compute new weights ***
    G = repmat(sqrt(gamma)',N,1);
    PhiG = Phi.*G;
    [U,S,V] = svd(PhiG,'econ');

    [d1,d2] = size(S);
    if (d1 > 1)     diag_S = diag(S);
    else            diag_S = S(1);      end;

    U_scaled = U(:,1:min(N,m)).*repmat((diag_S./(diag_S.^2 + lambda + 1e-16))',N,1);
    Xi = G'.*(V*U_scaled');

    mu_old = mu;
    mu = Xi*T;

    % *** Update hyperparameters ***
    gamma_old = gamma;
    mu2_bar = sum(abs(mu).^2,2);

    if (flag1(1) == 0)
        % MacKay fixed-point SBL
        R_diag = real( (sum(Xi.'.*Phi)).' );
        gamma = mu2_bar./(L*R_diag);

    elseif (flag1(1) == 1)
        % Fast EM SBL
        R_diag = real( (sum(Xi.'.*Phi)).' );
        gamma = sqrt( gamma.*real(mu2_bar./(L*R_diag)) );

    elseif (flag1(1) == 2)
        % Traditional EM SBL
        PhiGsqr = PhiG.*G;
        Sigma_w_diag = real( gamma - ( sum(Xi.'.*PhiGsqr) ).' );
        gamma = mu2_bar/L + Sigma_w_diag;

    else
        % FOCUSS
        p = flag1(2);
        gamma = (mu2_bar/L).^(1-p/2);
    end;

    % *** Check stopping conditions, etc. ***
  	k = k+1;
    if (DISPLAY_FLAG) disp(['iters: ',num2str(k),'   num coeffs: ',num2str(m), ...
            '   gamma change: ',num2str(max(abs(gamma - gamma_old)))]); end;
    if (k >= MAX_ITERS) break;  end;

	if (size(mu) == size(mu_old))
        dmu = max(max(abs(mu_old - mu)));
        if (dmu < MIN_DMU)  break; end;
    end;

end;

% *** Expand weights, hyperparameters ***
temp = zeros(M,1);
if (m > 0) temp(keep_list,1) = gamma;  end;
gamma = temp;

temp = zeros(M,L);
if (m > 0) temp(keep_list,:) = mu;  end;
mu = temp;

return;


function ex1bvp
%EX1BVP  Example 1 of the BVP tutorial.
%   This is the example for MUSN in U. Ascher, R. Mattheij, and R. Russell,
%   Numerical Solution of Boundary Value Problems for Ordinary Differential
%   Equations, SIAM, Philadelphia, PA, 1995.  MUSN is a multiple shooting
%   code for nonlinear BVPs.  The problem is
%
%      u' =  0.5*u*(w - u)/v
%      v' = -0.5*(w - u)
%      w' = (0.9 - 1000*(w - y) - 0.5*w*(w - u))/z
%      z' =  0.5*(w - u)
%      y' = -100*(y - w)
%
%   The interval is [0 1] and the boundary conditions are
%
%      u(0) = v(0) = w(0) = 1,  z(0) = -10,  w(1) = y(1)
%
%   The example uses a guess for the solution coded here in EX1INIT.
%   The results of a run of the FORTRAN code MUSN are here compared to
%   the curves produced by BVP4C.

% Copyright 2004, The MathWorks, Inc.

solinit = bvpinit(linspace(0,1,5),@ex1init);
options = bvpset('Stats','on','RelTol',1e-5);

sol = bvp4c(@ex1ode,@ex1bc,solinit,options);

% The solution at the mesh points
x = sol.x;
y = sol.y;

% Solution obtained using MUSN:
amrx = [ 0. .1 .2 .3 .4 .5 .6 .7 .8 .9 1.]';
amry = [1.00000e+00   1.00000e+00   1.00000e+00  -1.00000e+01   9.67963e-01
        1.00701e+00   9.93036e-01   1.27014e+00  -9.99304e+00   1.24622e+00
        1.02560e+00   9.75042e-01   1.47051e+00  -9.97504e+00   1.45280e+00
        1.05313e+00   9.49550e-01   1.61931e+00  -9.94955e+00   1.60610e+00
        1.08796e+00   9.19155e-01   1.73140e+00  -9.91915e+00   1.72137e+00
        1.12900e+00   8.85737e-01   1.81775e+00  -9.88574e+00   1.80994e+00
        1.17554e+00   8.50676e-01   1.88576e+00  -9.85068e+00   1.87957e+00
        1.22696e+00   8.15025e-01   1.93990e+00  -9.81503e+00   1.93498e+00
        1.28262e+00   7.79653e-01   1.98190e+00  -9.77965e+00   1.97819e+00
        1.34161e+00   7.45374e-01   2.01050e+00  -9.74537e+00   2.00827e+00
        1.40232e+00   7.13102e-01   2.02032e+00  -9.71310e+00   2.02032e+00];

% Shift up the fourth component for the plot.
amry(:,4) = amry(:,4) + 10;
y(4,:) = y(4,:) + 10;

figure
plot(x,y',amrx,amry,'*')
axis([0 1 -0.5 2.5])
title('Example problem for MUSN')
ylabel('bvp4c and MUSN (*) solutions')
xlabel('x')

% --------------------------------------------------------------------------

function dydx = ex1ode(x,y)
%EX1ODE  ODE function for Example 1 of the BVP tutorial.
%   The components of y correspond to the original variables
%   as  y(1) = u, y(2) = v, y(3) = w, y(4) = z, y(5) = y.
dydx =  [ 0.5*y(1)*(y(3) - y(1))/y(2)
         -0.5*(y(3) - y(1))
         (0.9 - 1000*(y(3) - y(5)) - 0.5*y(3)*(y(3) - y(1)))/y(4)
          0.5*(y(3) - y(1))
          100*(y(3) - y(5)) ];

%-------------------------------------------------------------------------

function res = ex1bc(ya,yb)
%EX1BC  Boundary conditions for Example 1 of the BVP tutorial.
%   RES = EX1BC(YA,YB) returns a column vector RES of the
%   residual in the boundary conditions resulting from the
%   approximations YA and YB to the solution at the ends of
%   the interval [a b]. The BVP is solved when RES = 0.
%   The components of y correspond to the original variables
%   as  y(1) = u, y(2) = v, y(3) = w, y(4) = z, y(5) = y.
res = [ ya(1) - 1
        ya(2) - 1
        ya(3) - 1
        ya(4) + 10
        yb(3) - yb(5)];

%-------------------------------------------------------------------------

function v = ex1init(x)
%EX1INIT  Guess for the solution of Example 1 of the BVP tutorial.
v = [        1
             1
     -4.5*x^2+8.91*x+1
            -10
     -4.5*x^2+9*x+0.91 ];


function [cost,grad] = softICACost(theta, x, params)

% unpack weight matrix
W = reshape(theta, params.numFeatures, params.n);

% % project weights to norm ball (prevents degenerate bases)
Wold = W;
W = l2rowscaled(W, 1);

% Forward Prop
h = W*x;
r = W'*h;

% Sparsity Cost
K = sqrt(params.epsilon + h.^2);
sparsity_cost = params.lambda * sum(sum(K));
K = 1./K;

% Reconstruction Loss and Back Prop
diff = (r - x);
reconstruction_cost = 0.5 * sum(sum(diff.^2));
outderv = diff;

% compute the cost comprised of: 1) sparsity and 2) reconstruction
cost = sparsity_cost + reconstruction_cost;

% Backprop Output Layer
W2grad = outderv * h';

% Baclprop Hidden Layer
outderv = W * outderv;
outderv = outderv + params.lambda * (h .* K);

W1grad = outderv * x';
Wgrad = W1grad + W2grad';

% % unproject gradient for minFunc
grad = l2rowscaledg(Wold, W, Wgrad, 1);
grad = grad(:);


function [scales,weights,covar]=realized_quantile_variance_scale(samplesperbin,quantiles,simulations,symmetric)
% Computes the scales needed for estimating the integrated variance using Realized Quantile
% Variance.  Also computes the weights of the optimal combination and non-scaled covariance from
% which the weights are derived.
%
% USAGE:
%   [SCALES,WEIGHTS,COVAR]=realized_quantile_variance_scale(SAMPLESPERBIN,QUANTILES,SIMULATIONS)
%
% INPUTS:
%   SAMPLESPERBIN    - Number of returns to use in each bin when computing the quantiles. NOTE: The
%                        number of returns produced by filtering according to SAMPLINGTYPE and
%                        SAMPLINGINTERVAL must be an integer multiple of SAMPLESPERBIN.
%   QUANTILES        - k by 1 vector of quantile values to use when computing RQ, must satisfy 0.5<QUANTILES<=1.
%                        Quantiles must produce values such that QUANTILES*SAMPLESPERBIN is an
%                        integer.  The simplest method to accomplish this is to specify QUANTILES as
%                        the ratio of the index number of the return to SAMPLESPERBIN (e.g.
%                        QUANTILES = [13 15 19]/20)
%   SIMULATIONS       - [OPTIONAL] Scalar integer.  Should usually be at least 1,000,000.  Default
%                         value is 10,000,000.
%   SYMMETRIC         - [OPTIONAL] Logical value indicating whether the symmetric estimator is being
%                         used. Default is false.
%
% OUTPUTS:
%   SCALES            - k by 1 vector of scales for standardized quantile based estimates of variance
%   WEIGHTS           - k by 1 vector of weights that produce the optimal combination (lowest variance)
%   COVAR             - k by k non-scaled covariance matrix of the quantile realized variance - one
%                         for each quantile used.  Forms the actual (scaled) covariance when
%                         multiplied by the integrated quarticity.
%
% COMMENTS:
%   Uses Monte Carlo integration with 10,000,000 simulations.  Trade offs between accuracy and time
%   can be made by altering SIMULATIONS.
%
%  See also REALIZED_QUANTILE_VARIANCE
%

%
% Copyright: Kevin Sheppard
% kevin.sheppard@economics.ox.ac.uk
% Revision: 1    Date: 5/1/2008

if nargin<4
    symmetric = false;
end
if nargin ==2
    simulations = 10000000;
end

% Save the state and set it to a specific value so that the simulated results will be reproducable
state0=randn('state');
randn('state',datenum('MAR-26-1974'))

k = length(quantiles);

if symmetric
    indices = round(samplesperbin*quantiles);
else
    indicesHigh = round( samplesperbin*quantiles);
    indicesLow = round(samplesperbin*(1-quantiles)+1 );
end

% Need to block eventually incase someone tries to compute this with a
% large number of samplesperbin
rows = min(floor(2^13/samplesperbin),simulations);
iter = ceil(simulations/rows);
remaining = simulations;

scales = zeros(1,k);
opMatrix  = zeros(k);
% The MC integration
for i=1:iter
    numThisIter = min(remaining,rows);
    remaining = remaining - rows;

    x=randn(numThisIter,samplesperbin);
    if symmetric
        x=sort(x.^2,2);
        x2=x(:,indices);
    else
        x=sort(x,2);
        x2=x(:,indicesHigh).^2 + x(:,indicesLow).^2;
    end
    scales = scales + sum(x2)/simulations;
    opMatrix = opMatrix + x2'*x2/simulations;
end

% Compute the covariance
covar = opMatrix - scales'*scales;
covar = samplesperbin*diag(1./scales)*covar*diag(1./scales);
% And the weights according to the GMVP
weights=covar^(-1)*ones(k,1)/(ones(1,k)*covar^(-1)*ones(k,1));

% Reset the state
randn('state',state0);


%==============================================================================
% This code is part of the Matlab-based toolbox
% FAIR - Flexible Algorithms for Image Registration.
% For details see
% - https://github.com/C4IR and
% - http://www.siam.org/books/fa06/
% ##2
%==============================================================================
%
% Tutorial for FAIR: regulariztion
%
% given a certain force field f on a 2D domain, this tutorial
% computes and visualizes the elastic displacement u, such that
%
%  B'*B u = f
%
% where B is the discrete elastic operator
% see also getElasticMatrixStg
%==============================================================================

clear, close all, help(mfilename);

                    % 2D example
omega  = [0,1,0,1]; % physical domain
m      = [16,12];   % number of discretization points
mu     = 1;         % Lame constants, control elasticity properties
lambda = 0;         % Youngs modulus and Poisson ratio
n      = prod(m);   % number of cells, and staggered dimensions
ns     = [(m(1)+1)*m(2),m(1)*(m(2)+1)];

% generate cell centered, staggered and nodal grids
% note: computation is staggered, others used for visualization
xc = getCellCenteredGrid(omega,m);
xn = getNodalGrid(omega,m);

% build elasticity operator on a staggered grid and visualize
B = getElasticMatrixStg(omega,m,mu,lambda);
FAIRfigure(1); clf; subplot(2,2,1); spy(B); title('B elastic on staggered grid')

% create a force field o cell centered grid and visualize
fc  = [0*xc(1:n);-10*sin(pi*xc(1:n))];
% computations on staggered grid
fs = grid2grid(fc,m,'centered','staggered');

% compute the displacement from (B'*B)*us = fs
% note B is derivative operator and has null space (constants)

% remove constant parts: E'*(f-E*w) = 0
E = [ones(ns(1),1)*[1,0];ones(ns(2),1)*[0,1]];
fs = fs - E*((E'*E)\(E'*fs));

% solve for displacements
warning off % matrix is singular, but MATLAB doesn't care
us = (B'*B)\fs;
warning on

% visualization on cell centered and nodal grids
uc = grid2grid(us,m,'staggered','centered');
un = grid2grid(us,m,'staggered','nodal');

% shortcuts for visualization,
vecNorm   = @(v) sqrt(sum(reshape(v,[],2).^2,2));
viewField = @(v) viewImage2Dsc(vecNorm(v),omega,m);
PG        = @(x) plotGrid(x,omega,m);

% visualize force field
FAIRfigure(1); subplot(2,2,3);
viewField(fc); hold on; colormap(gray); colorbar; PG(xn);
qh = quiver(xc(1:n),xc(n+1:end),fc(1:n),fc(n+1:end),1);
set(qh,'color','r','linewidth',1)
title('a force field')

% visualize displacement field
FAIRfigure(1); subplot(2,2,4);
viewField(uc); hold on; colormap(gray); colorbar; PG(xn);
qh = quiver(xc(1:n),xc(n+1:end),uc(1:n),uc(n+1:end),1);
set(qh,'color','g','linewidth',1)
title('the displacement field')

% visuaize the displaced grid
FAIRfigure(1); subplot(2,2,2);
xh = PG(xn); hold on; axis equal image; yh = PG(xn+un);
set(xh,'linewidth',2); set(xh,'linewidth',2,'color','g');
title('initial and displaced grids')

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


function [oAllanDev] = calculateADEV(tau,sPeriod,readings)
%Overlapping Allan (ADEV) function that uses phase error or time error values
%input argument is readings already grouped as tau values. tau is the
%desired gate or tau time needed for calculating overlap.
%sPeriod is used to determine the overlap

N = numel(readings); %get the reading count
n = tau / sPeriod; %calculate averaging factor
n = floor(n); %make sure this is an integer
const = 1/(2*(N - (2*n))*tau^2); %calculate the const mult 1/(2*(N - (2*n))*tau^2)
%sum from i=1 to N-2n (Xi+2m - 2Xi+m + Xi)^2
sum = 0; %variable to store summation calculation

%loop for performing summation
for i = 1:(N-(2*n))
   sum = sum + (readings(i+(2*n)) - (2*readings(i+n)) + readings(i))^2; %previos sum + (yi+1 - yi)^2
end

oAllanDev = sqrt(const*sum); %square root for Allan Dev


  function [cost grad] = mri_r2_fit_costgrad_pd(pd, data)
%|function [cost grad] = mri_r2_fit_costgrad_pd(pd, data)
%| gradient wrt "proton density" (pd) image
%| for R2=1/T2 estimation from images

if nargin == 1 && streq(pd, 'test'), mri_r2_fit_costgrad_pd_test, return, end
if nargin < 2, ir_usage, end

yi = data.yi; % [(nd) nt] images
r2 = data.r2; % [(nd)] R2=1/T2 maps
te = data.te; % echo times

[yb yi] = mri_r2_fit_mean(pd, r2, yi, te);
cost = sum(abs(yi(:) - yb(:)).^2) / 2;

grad = mri_r2_fit_grad_pd(pd, r2, yi - yb, te);

if isfield(data, 'R')
	R = data.R;
	cost = cost + R.penal(R, pd);
	grad = grad + R.cgrad(R, pd);
end
grad = reshape(grad, size(pd));

% mri_r2_fit_mean()
function [yb yi] = mri_r2_fit_mean(pd, r2, yi, te)

nt = numel(te);
yi = reshapee(yi, [], nt); % [*nd nt]
yb = zeros(size(yi)); % [*nd nt]
for it=1:nt
	yb(:,it) = pd(:) .* exp(-te(it) * r2(:));
end

% mri_r2_fit_grad_pd()
function grad = mri_r2_fit_grad_pd(pd, r2, resid, te)

nt = numel(te);

grad = 0;
for it=1:nt
	tmp = exp(-te(it) * r2(:));
	grad = grad - tmp .* resid(:,it);
end

function mri_r2_fit_costgrad_pd_test

r2 = 0.01;
te = [0:3] * 20;
pd = 2;
yb = pd .* exp(-te * r2);
rng(0)
yi = yb + 0.1 * randn(size(yb));

%R = Reg1(true(1), 'beta', 3, 'order', 0, 'type_penal', 'mat');

data.yi = yi;
data.r2 = r2;
data.te = te;
%data.R = R;

pdlist = linspace(0, 4, 101);
cost = zeros(size(pdlist));
for ii=1:numel(pdlist)
	cost(ii) = mri_r2_fit_costgrad_pd(pdlist(ii), data);
end

p0 = 1.5;
[cost0 grad0] = mri_r2_fit_costgrad_pd(p0, data);

if im
	clf
	plot(pdlist, cost, '-', pdlist, cost0 + grad0*(pdlist-p0), '--')
end


function result=rsimpls(x,y,varargin)

%RSIMPLS is a 'Robust method for Partial Least Squares Regression based on the
% SIMPLS algorithm'. It can be applied to both low and high-dimensional predictor variables x
% and to one or multiple response variables y. It is resistant to outliers in the data.
% The RSIMPLS algorithm is built on two main stages. First, a matrix of scores is derived
% based on a robust covariance criterion (see robpca.m),
% and secondly a robust regression is performed based on the results from ROBPCA.
%
% The RSIMPLS method is described in:
%    Hubert, M., and Vanden Branden, K. (2003),
%    "Robust Methods for Partial Least Squares Regression",
%    Journal of Chemometrics, 17, 537-549.
%
% To select the number of components in the regression model, a robust RMSECV (root mean squared
% error of cross validation) curve is drawn, based on a fast algorithm for
% cross-validation. This approach is described in:
%
%    Engelen, S., Hubert, M. (2005),
%    "Fast model selection for robust calibration methods",
%    Analytica Chimica Acta, 544, 219-228.
%
% Required input arguments:
%            x : Data matrix of the explanatory variables
%                (n observations in rows, p variables in columns)
%            y : Data matrix of the response variables
%                (n observations in rows, q variables in columns)
%
% Optional input arguments:
%            k : Number of components to be used.
%                (default = min(rank([x,y]),kmax)). If k is not specified,
%                it can be selected using the option 'rmsecv'.
%         kmax : Maximal number of components to be used (default = 9).
%                If k is provided, kmax does not need to be specified, unless k is larger
%                than 9.
%        alpha : (1-alpha) measures the fraction of outliers the algorithm should
%                resist. Any value between 0.5 and 1 may be specified. (default = 0.75)
%            h : (n-h+1) measures the number of observations the algorithm should
%                resist. Any value between n/2 and n may be specified. (default = 0.75*n)
%                Alpha and h may not both be specified.
%       rmsecv : If equal to zero and k is not specified, a robust R-squared curve
%                is plotted and an optimal k value can be chosen. (default)
%                If equal to one and k is not specified, a robust component selection-curve is plotted and
%                an optimal k value can be chosen. This curve computes a combination of
%                the cross-validated root mean squared error and the robust residual
%                sum of squares for k=1 to kmax. Rmsecv and k may not both
%                be specified.
%        rmsep : If equal to one, the robust RMSEP-value (root mean squared error of
%                prediction) for the model with k components (default = 0). This value
%                is automatically given if rmsecv = 1.
%        plots : If equal to one, a menu is shown which allows to draw several plots,
%                such as a robust score outlier map and a regression
%                outlier map are drawn. (default)
%                If the input argument 'classic' is equal to one, the classical
%                diagnostic plots are drawn as well.
%                If 'plots' is equal to zero, all plots are suppressed.
%                See also makeplot.m
%        labsd : The 'labsd' observations with largest score distance are
%                labeled on the outlier map (default = 3)
%        labod : The 'labod' observations with largest orthogonal distance are
%                labeled on the outlier map (default = 3)
%      labresd : The 'labresd' observations with largest residual distance are
%                labeled on the outlier map (default = 3)
%      classic : If equal to one, the classical SIMPLS analysis will be performed as well
%                (see also csimpls.m). (default = 0)
%
% Options for advanced users:
%           kr : Total number of components used by the ROBPCA method.
%                We advise to use kr=k+q. (default)
%        kmaxr : Maximal number of components used by the ROBPCA method.
%                default = min(kmax+q,rank([x,y]))
%  plotsrobpca : If equal to one, a robust score outlier map from ROBPCA is drawn.
%                If the input argument 'classic' is equal to one, the classical
%                outlier map is drawn as well.
%                If 'plotsrobpca' is equal to zero, all plots are suppressed. (default)
%           st : Indicates the current stage of the algorithm for cross-validation (RMSECV)
%                default = 0 -> performs all the stages of the algorithm and computes all the
%                parameters for the full model.
%                st=1, robpca is still performed, but when
%                st=2, the algorithm proceeds based on the previous knownledge of the output from robpca.
%          out : Is an empty structure, but is constructed while performing the cross-validation.
%                (see rrmse.m)
%
% I/O: result=rsimpls(x,y,'k',k,'kmax',10,'alpha',0.75,'h',h,'rmsecv',0,'rmsep',0,...
%       'plots',1,'labsd',3,'labod',3,'labresd',3,'classic',1,'kr',kr,...
%       'kmaxr',kmaxr,'plotsrobpca',0,'st',0,'out',[]);
%  The user should only give the input arguments that have to change their default value.
%  The name of the input arguments needs to be followed by their value.
%  The order of the input arguments is of no importance.
%
% Examples:
%   rsimpls(x,y,'k',5,'plots',1);
%   rsimpls(x,y,'classic',1,'rmsecv',1);
%
% The output of RSIMPLS is a structure containing:
%
%   result.slope     : Robust slope estimate
%   result.int       : Robust intercept estimate
%   result.fitted    : Robust fitted values
%   result.res       : Robust residuals
%   result.cov       : Estimated variance-covariance matrix of the residuals
%   result.T         : Robust scores
%   result.weights.r : Robust simpls weights
%   result.weights.p : Robust simpls weights
%   result.Tcenter   : Robust center of the scores
%   result.Tcov      : Robust covariance matrix of the scores
%   result.rsquared  : Robust R-squared value for the optimal k
%   result.rcs       : Robust Component Selection Criterion:
%                      This is a matrix with kmax columns. The first row contains the approximate
%                      R-squared values (for k=1,...,kmax) and the second row the square root of the weighted
%                      residuals sum of squares. This is equal to the RCS-value with
%                      gamma = 0 (see Engelen and Hubert (2005) for the definition).
%                      If the input argument rmsecv = 1, the third row contains the RCS-value for
%                      gamma = 0.5 and the fourth for gamma = 1. The last one is equal to the robust
%                      cross-validated RMSE values.
%                      Note that all the entries in this matrix depend on the choice of kmax.
%   result.rmsep     : Robust RMSEP value
%   result.k         : Number of components used in the regression
%   result.h         : The quantile h used throughout the algorithm
%   result.sd        : Robust score distances
%   result.od        : Robust orthogonal distances
%   result.resd      : Residual distances (when there are several response variables).
%                      If univariate regression is performed, it contains the standardized residuals.
%   result.cutoff    : Cutoff values for the score (result.cutoff.sd), orthogonal
%                      (result.cutoff.od) and residual distances (result.cutoff.resd).
%                      We use 0.975 quantiles of the chi-squared distribution.
%   result.flag      : The observations whose score distance is larger than
%                      'result.cutoff.sd' receive a flag 'result.flag.sd' equal
%                      to zero (good leverage points). Otherwise 'result.flag.sd'
%                      is equal to one.
%                      The components 'result.flag.od' and 'result.flag.resd' are
%                      defined analogously, and determine the orthogonal outliers,
%                      resp. the bad leverage points/vertical outliers.
%                      The observations with 'result.flag.od' and 'result.flag.resd'
%                      equal to zero, can be considered as calibration outliers and receive
%                      'result.flag.all' equal to zero. The regular observations and the good leverage
%                      points have 'result.flag.all' equal to one.
%   result.class     : 'RSIMPLS'
%   result.classic   : If the inputargument 'classic' is equal to 1, this structure
%                      contains results of the classical SIMPLS analysis. (see also csimpls.m)
%   results.robpca   : The results of robpca on [X,Y].
%
% This function is part of LIBRA: the Matlab Library for Robust Analysis,
% available at:
%              http://wis.kuleuven.be/stat/robust.html
%
% Written by Karlien Vanden Branden
% Version date: 07/04/2004
% Last update: 04/08/2006

%
%initialization with defaults
%
if rem(nargin,2)~=0
    error('Number of input arguments must be even!');
end
[n,p1]=size(x);
[n2,q1]=size(y);
z=[x,y];
rx=rank(x);
rz=rank(z);
if n~=n2
    error('The response variables and the predictor variables have a different number of observations.')
end
niter=100;counter=1;mcd=0;alfa=0.75;
kmax=min([9,rx,floor(n/2),p1]);
kmaxr=min([kmax+q1,rz]);
h=floor(2*floor((n+kmaxr+1)/2)-n+2*(n-floor((n+kmaxr+1)/2))*alfa);
labsd=3;labod=3;labresd=3;
plotsrobpca=0;plots=1;k=0;
kr=k+q1;
st=0;rmsecv=0;
out=[];classic=0;rmsep=0;rmsep_value=nan;rmsecv_value = nan;rsquared_value = nan;rss_value = nan;
default=struct('alpha',alfa,'h',h,'labsd',labsd,'labod',labod,'labresd',labresd,'k',k,'kr',kr,...
    'plotsrobpca',plotsrobpca,'plots',plots,'kmax',kmax,'st',st,...
    'out',out,'rmsecv',rmsecv,'classic',classic,'rmsep',rmsep,...
    'kmaxr',kmaxr,'rmsep_value',rmsep_value,'rmsecv_value',rmsecv_value,'rsquared_value',...
    rsquared_value,'rss_value',rss_value);
list=fieldnames(default);
options=default;
IN=length(list);
i=1;
%
if nargin>2
    %
    %placing inputfields in array of strings
    %
    for j=1:nargin-3
        if rem(j,2)~=0
            chklist{i}=varargin{j};
            i=i+1;
        end
    end
    dummy=sum(strcmp(chklist,'h')+2*strcmp(chklist,'alpha'));
    switch dummy
        case 0 %Take on default values
            options.alpha=alfa;%0.75;
            options.h=h;
        case 3
            error('Both input arguments alpha and h are provided. Only one is required.')
    end
    %
    %Checking which default parameters have to be changed
    % and keep them in the structure 'options'.
    %
    while counter<=IN
        index=strmatch(list(counter,:),chklist,'exact');%contains the users input one by one
        if ~isempty(index) %in case of similarity
            for j=1:nargin-3 %searching the index of the accompanying field
                if rem(j,2)~=0 %fieldnames are placed on odd index
                    if strcmp(chklist{index},varargin{j})
                        I=j;
                    end
                end
            end
            options=setfield(options,chklist{index},varargin{I+1});
            index=[];
        end
        counter=counter+1;
    end
    options.h=floor(options.h);
    options.kmax=floor(options.kmax);
    options.k=floor(options.k);
    options.kmaxr=floor(options.kmaxr);
    options.kr=floor(options.kr);
    kmax=min([options.kmax,floor(n/2),rz,p1]);
    kmaxr=max([min([options.kmaxr,rz]),kmax+q1]);
    k=min(options.k,kmax);
    while k<0
        k=input(['The number of components can not be negative.\n'...
        'How many principal components would you like to retain?\n']);
    end
    if any(strcmp(chklist,'kr'))
        kr=floor(max([options.kr,k+q1]));
    else
        kr=k+q1;
    end
    if dummy==1 %checking inputvariable h
        if options.h-floor(options.h)~=0
            mess=sprintf('Attention (rsimpls.m): h must be an integer. \n');
            disp(mess)
        end
        if kr==0
            if options.h<floor((n+kmaxr+1)/2)
                options.h=floor((n+kmaxr+1)/2);
                mess=sprintf(['Attention (rsimpls.m): h should be larger than (n+kmaxr+1)/2.\n',...
                        'It is set to its minimum value',num2str(options.h)]);
                disp(mess)
            end
            options.alpha=options.h/n;
        else
            if options.h<floor((n+kr+1)/2)
                options.h=floor((n+kr+1)/2);
                mess=sprintf(['Attention (rsimpls.m): h should be larger than (n+kr+1)/2.\n',...
                        'It is set to its minimum value',num2str(options.h)]);
                disp(mess)
            end
            options.alpha=options.h/n;
        end
        if options.h>n
            options.alpha=0.75;
            if kr==0
                options.h=floor(2*floor((n+kmaxr+1)/2)-n+2*(n-floor((n+kmaxr+1)/2))*options.alpha);
            else
                options.h=floor(2*floor((n+kr+1)/2)-n+2*(n-floor((n+kr+1)/2))*options.alpha);
            end
            mess=sprintf(['Attention (rsimpls.m): h should be smaller than n. \n',...
                    'It is set to its default value ',num2str(options.h)]);
            disp(mess)
        end
    elseif dummy==2
        if options.alpha < 0.5
            options.alpha=0.5;
            mess=sprintf(['Attention (rsimpls.m): Alpha should be larger than 0.5. \n',...
                    'It is set to 0.5.']);
            disp(mess)
        end
        if options.alpha > 1
            options.alpha=0.75;
            mess=sprintf(['Attention (rsimpls.m): Alpha should be smaller than 1.\n',...
                    'It is set to 0.75.']);
            disp(mess)
        end
        if kr==0
            options.h=floor(2*floor((n+kmaxr+1)/2)-n+2*(n-floor((n+kmaxr+1)/2))*options.alpha);
        else
            options.h=floor(2*floor((n+kr+1)/2)-n+2*(n-floor((n+kr+1)/2))*options.alpha);
        end
    end
    h=options.h;alfa=options.alpha;labsd=max(0,min(floor(options.labsd),n));
    dummyh = strcmp(chklist,'h');
    dummykmax = strcmp(chklist,'kmax');
    if all(dummyh == 0) && any(dummykmax)
        h = floor(2*floor((n+kmax+1)/2)-n+2*(n-floor((n+kmax+1)/2))*alfa);
    end
    labod=max(0,min(floor(options.labod),n));labresd=max(0,min(floor(options.labresd),n));
    plotsrobpca=options.plotsrobpca;plots=options.plots;
    st=options.st;
    out=options.out;
    rmsecv=options.rmsecv;
    classic=options.classic;
    rmsep=options.rmsep;
    rmsep_value = options.rmsep_value;
    rmsecv_value = options.rmsecv_value;
    rmsecv = options.rmsecv;
    rsquared_value = options.rsquared_value;
    rss_value = options.rss_value;
end

if q1==1 && k>=(h-2)
    mess=sprintf(['Attention (rsimpls.m): The number of components, k = ',num2str(k),...
            '\n is larger than our recommended maximum value of k = ',num2str(h-2)-1,'.']);
    disp(mess)
elseif q1>1 && k>=((h/q1)-(q1/2)-0.5)
    mess=sprintf(['Attention (rsimpls.m): The number of components, k = ',num2str(k),...
            '\n is larger than our recommended maximum value of k = ',num2str(floor((h/q1)-(q1/2)-1.5)),'.']);
    disp(mess)
end

%
%MAIN PART
%
% selection of number of components
if k == 0
    if rmsecv == 0
        [R2,final]=rsquared(x,y,kmax,'RSIMPLS',options.h);
        rss = final.rss;
        k = final.k;
        result=rsimpls(x,y,'k',k,'kr',k+q1,'h',h,'rmsecv',0,'rmsep',options.rmsep,'plots',0,'classic',classic,'rsquared_value',R2,'rss_value',rss);
    else
        out=rrmse(x,y,h,kmax,'RSIMPLS',1);
        R2 = out.R2;
        rss = out.rss;
        k=out.k;
        rmsecv_value = out.rmsecv;
        pred = rrmse(x,y,h,kmax,'RSIMPLS',0,k,out.weight,out.res);
        result=rsimpls(x,y,'k',k,'kr',k+q1,'h',h,'rmsecv',0,'rmsep',0,'plots',0,'classic',classic,'rmsep_value',pred.rmsep,'rmsecv_value',rmsecv_value,'rsquared_value',R2,'rss_value',rss);
    end
else
    if rmsecv
        error(['Both RMSECV and k were given.', ...
            'Please rerun your analysis with one of these inputs.  (see help file)'])
    end
%First stage: Obtain the scores T by first performing ROBPCA on z:
    if st<=1
        out.robpca=robpca(z,'k',kr,'h',h,'plots',plotsrobpca,'kmax',kmaxr,'classic',classic,'mcd',mcd);
        out.h=h;
        out.centerz=out.robpca.M;
        out.sigmaxy=out.robpca.P(1:p1,:)*diag(out.robpca.L)*out.robpca.P(p1+1:p1+q1,:)';
        out.sigmax=out.robpca.P(1:p1,:)*diag(out.robpca.L)*out.robpca.P(1:p1,:)';
        out.xcentr=x-repmat(out.centerz(1:p1),n,1);
        out.ycentr=y-repmat(out.centerz(p1+1:p1+q1),n,1);
        out.weights2=out.robpca.flag.all;
    end
    if st
        i=k;
    else
        i=1;
    end
    while i<=k
        out.sigmayx=out.sigmaxy';
        if q1>p1
            [RR,LL]=eig(out.sigmaxy*out.sigmayx);
            [LL,I]=greatsort(diag(LL));
            rr=RR(:,I(1));
            qq=out.sigmayx*rr;
            qq=qq/norm(qq);
        else
            [QQ,LL]=eig(out.sigmayx*out.sigmaxy);
            [LL,I]=greatsort(diag(LL));
            qq=QQ(:,I(1));
            rr=out.sigmaxy*qq;
            rr=rr/norm(rr);
        end
        tt=out.xcentr*rr;
        uu=out.ycentr*qq;
        pp=out.sigmax*rr/(rr'*out.sigmax*rr);
        vv=pp;
        if i>1
            vv=vv-out.v*(out.v'*pp);
        end
        if vv'*vv==0
            error('The number of components is too large')
        end
        vv=vv./norm(vv);
        out.sigmaxy=out.sigmaxy-vv*(vv'*out.sigmaxy);
        out.v(:,i)=vv;
        out.q(:,i)=qq;
        out.t(:,i)=tt;
        out.u(:,i)=uu;
        out.p(:,i)=pp;
        out.r(:,i)=rr;
        i=i+1;
    end

    %Second Stage : Robust ROBPCA-regression
    robpcareg=robpcaregres(out.t,y,out.weights2);
    breg=robpcareg.coeffs(1:k,:);
    Yhat=out.t*breg+repmat(robpcareg.coeffs(k+1,:),n,1);
    b=out.r*breg;
    int=robpcareg.coeffs(k+1,:)-out.centerz(1:p1)*out.r*breg;

    if rmsep==1
        rmse=rrmse(x,y,h,kmax,'RSIMPLS',0,k);
        out.rmsep=rmse.rmsep;
    end

    % testing several output parameters
    if ~isnan(rmsep_value)
        out.rmsep = rmsep_value;
        options.rmsep = 1;
    end

    if ~isnan(rsquared_value)
        out.rcs = rsquared_value;
    end
    if ~isnan(rss_value)
        out.rcs = [out.rcs;sqrt(rss_value)];
    end
    if ~isnan(rmsecv_value)
        gammahalf = 0.5*sqrt(rss_value) + 0.5*rmsecv_value;
        out.rcs = [out.rcs;gammahalf;rmsecv_value];
        options.rmsecv = 1;
    end
    if any(isnan(rsquared_value)) && any(isnan(rss_value)) && any(isnan(rmsecv_value))
        out.rcs = 0;
    end

   %The output:
   out.T=out.t;
   out.weights.p=out.p;
   out.weights.r=out.r;
   out.kr=kr;
   out.h=h;
   out.alpha=alfa;
   out.slope=b;
   out.int=int;
   out.yhat=x*b+repmat(int,n,1);
   out.x=x;
   out.y=y;
   out.res=y-out.yhat;
   out.class='RSIMPLS';
   out.k=k;
   out.cov=robpcareg.cov;

   if ~st
       %calculation of robust distances
       %Score distance
       out.Tcov=robpcareg.sigma(1:k,1:k);
       out.Tcenter=robpcareg.center(1:k);
       out.sd=sqrt(mahalanobis(out.t,out.Tcenter,'cov',out.Tcov))';
       out.cutoff.sd=sqrt(chi2inv(0.975,k));
       %robust residual distance
       if q1==1
           out.resd=out.res/sqrt(out.cov);
       else
           out.resd=sqrt(mahalanobis(out.res,zeros(1,q1),'cov',out.cov))';
       end
       %robust orthogonal distances
       xtilde=out.t*out.p';
       Cdiff=out.xcentr-xtilde;
       for i=1:n
           out.od(i,1)=norm(Cdiff(i,:));
       end
       r=rank(x);
       if k~=r
           [m,s]=unimcd(out.od.^(2/3),out.h);
           out.cutoff.od = sqrt(norminv(0.975,m,s)^3);
       else
           out.cutoff.od=0;
       end
       out.cutoff.resd=sqrt(chi2inv(0.975,q1));

       %Computing flags
       out.flag.od=out.od<=out.cutoff.od;
       out.flag.resd=abs(out.resd)<=out.cutoff.resd;
       out.flag.all=(out.flag.od & out.flag.resd);

       %Multivariate Rsquared
       Yw=y(out.flag.all==1,:);
       cYw=mcenter(Yw);
       res=out.res(out.flag.all==1,:);
       out.rsquared=1-(det(res'*res)/det(cYw'*cYw));

       %Assigning output
       if options.rmsep~=1 && options.rmsecv~=1
           out.rmsep=0;
       end

       if classic
           resultclassic=csimpls(x,y,'k',k,'plots',0);
       else
           resultclassic=0;
       end
       result=struct('slope',{out.slope}, 'int',{out.int},'fitted',{out.yhat},'res',{out.res}, 'cov',{out.cov},...
           'T',{out.T}, 'weights', {out.weights},'Tcenter',{out.Tcenter},'Tcov',{out.Tcov},'rsquared',{out.rsquared},'rcs',{out.rcs},'rmsep',{out.rmsep},...
           'k',{out.k},'alpha',{out.alpha},'h',{out.h},'sd', {out.sd},'od',{out.od},...
           'resd',{out.resd},'cutoff',{out.cutoff},'flag',{out.flag},'class',{out.class},'classic',{resultclassic},'robpca',{out.robpca});
       if result.rcs==0
           result=rmfield(result,'rcs');
       end
       if result.rmsep==0
           result=rmfield(result,'rmsep');
       end
   else
       result=out;
   end
end

% Plots
try
    if plots && options.classic
        makeplot(result,'classic',1,'labsd',labsd,'labod',labod,'labresd',labresd)
    elseif plots
        makeplot(result,'labsd',labsd,'labod',labod,'labresd',labresd)
    end
catch %output must be given even if plots are interrupted
end


function f = bilinear_kernel(k, num_input, num_output)
% -------------------------------------------------------------------------
%   Description:
%       create bilinear interpolation kernel for the convt (deconv) layer
%
%   Input:
%       - k             : kernel size k x k
%       - num_input     : number of input channels
%       - num_output    : number of output channels
%
%   Output:
%       - f             : bilinear filter
%
%   Citation:
%       Deep Laplacian Pyramid Networks for Fast and Accurate Super-Resolution
%       Wei-Sheng Lai, Jia-Bin Huang, Narendra Ahuja, and Ming-Hsuan Yang
%       IEEE Conference on Computer Vision and Pattern Recognition (CVPR), 2017
%
%   Contact:
%       Wei-Sheng Lai
%       wlai24@ucmerced.edu
%       University of California, Merced
% -------------------------------------------------------------------------

    radius = ceil(k / 2);

    if rem(k, 2) == 1
        center = radius;
    else
        center = radius + 0.5;
    end

    C = 1:k;
    f = (ones(1, k) - abs(C - center) ./ radius)' ...
      * (ones(1, k) - abs(C - center) ./ radius);

    f = repmat(f, 1, 1, num_input, num_output);

end


function [M,E,EMAP] = crouzeix_raviart_massmatrix(V,F)
  % CROUZEIX_RAVIART_MASSMATRIX Compute the Crouzeix-Raviart mass matrix where
  % M(e,e) is just the sum of 1/3 the areas of the triangles on either side of
  % an edge e. For tets, edges are now faccets.
  %
  % See for example "Discrete Quadratic Curvature Energies" [Wardetzky, Bergou,
  % Harmon, Zorin, Grinspun 2007]
  %
  % Inputs:
  %   V  #V by dim list of vertex positions
  %   F  #F by element-size list of triangle indices
  % Outputs:
  %   M  #E by #E edge-based diagonal mass matrix
  %   E  #E by 2 list of edges
  %
  % See also: edge_laplacian, is_boundary_edge, crouzeix_raviart_cotmatrix,
  %   massmatrix
  %

  switch size(F,2)
  case 3
    allE = [F(:,[2 3]);F(:,[3 1]);F(:,[1 2])];
    % Map duplicate edges to first instance
    [E,~,EMAP] = unique(sort(allE,2),'rows');
    TA = doublearea(V,F)/2;
    M = sparse(EMAP,EMAP,repmat(TA/3,3,1),size(E,1), size(E,1));
  case 4
    T = F;
    allF = [ ...
      T(:,2) T(:,4) T(:,3); ...
      T(:,1) T(:,3) T(:,4); ...
      T(:,1) T(:,4) T(:,2); ...
      T(:,1) T(:,2) T(:,3); ...
      ];
    vol = volume(V,T);
    [F,~,FMAP] = unique(sort(allF,2),'rows');
    M = sparse(FMAP,FMAP,repmat(vol/4,4,1),size(F,1), size(F,1));
    E = F;
    EMAP = FMAP;
  end
end


function J=calcPolarConvJacob(zPolar,systemType,useHalfRange,lTx,lRx,M)
%%CALCPOLARCONVJACOB Calculate the Jacobian for a monostatic or bistatic
%            range and polar angle measurement in 2D with respect to
%            Cartesian position. Atmospheric effects are ignored. This
%            type of Jacobian is useful when performing tracking using
%            Cartesian-converted measurements where the clutter density is
%            specified in the measurement coordinate system, not the
%            converted measurement coordinate system.
%
%INPUTS: zPolar A 2X1 point in polar coordinates in the format
%          [range;azimuth], where the angle is given in radians and the
%          range can be bistatic.
% systemType An optional parameter specifying the axis from which the
%          azimuth angle is measured. It is assumed that the azimuth
%          angle is given in radians. Possible values are
%          0 (The default if omitted) The azimuth angle is
%             counterclockwise from the x axis.
%          1 The azimuth angle is measured clockwise from the y axis.
% useHalfRange A boolean value specifying whether the bistatic range value
%          should be divided by two. This normally comes up
%          when operating in monostatic mode, so that the range reported is
%          a one-way range. The default if this parameter is not provided
%          is false.
%      lTx The 2X1 [x;y] location vector of the transmitter in Cartesian
%          coordinates. If this parameter is omitted or an empty matrix is
%          passed, then the transmitter is assumed to be at the origin.
%      lRx The 2X1 [x;y] location vector of the receiver in Cartesian
%          coordinates. If this parameter is omitted or an empty matrix is
%          passed, then the receiver is assumed to be at the origin.
%        M A 2X2 rotation matrices to go from the alignment of the global
%          coordinate system to that at the receiver. If omitted or an
%          empty matrix is passed, then it is assumed that the local
%          coordinate system is aligned with the global and M=eye(2,2)
%          --the identity matrix is used.
%
%OUTPUTS: J The 2X2 Jacobian matrix. Each row is a components of range, and
%           azimuth (in that order by row) with derivatives taken with
%           respect to [x,y] by column.
%
%This function converts the measurement into Cartesian coordinates and then
%calls rangeGradient and polAngGradient.
%
%February 2017 David F.Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

if(nargin<6||isempty(M))
   M=eye(2,2);
end

if(nargin<5||isempty(lRx))
   lRx=zeros(2,1);
end

if(nargin<4||isempty(lTx))
   lTx=zeros(2,1);
end

if(nargin<3||isempty(useHalfRange))
    useHalfRange=true;
end

if(nargin<2||isempty(systemType))
    systemType=0;
end

x=pol2Cart(zPolar,systemType,useHalfRange,lTx,lRx,M);

J=zeros(2,2);
J(1,:)=rangeGradient(x,useHalfRange,lTx,lRx);
J(2,:)=polAngGradient(x,systemType,lRx);

end

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


function y = beta_pdf(x,a,b)
%BETA_PDF    Beta probability density function (pdf).
%
%   Y = BETA_PDF(X,A,B) Returns the Beta pdf with
%   parameters A and B, at the values in X.
%
%   The size of Y is the common size of the input arguments. A
%   scalar input functions as a constant matrix of the same size as
%   the other inputs.
%
%   Default value for A and B is 1.

% Copyright (c) 2005 Aki Vehtari

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

if nargin < 3,
  a = 1;
end

if nargin < 2;
  b = 1;
end

if nargin < 1,
  error('Requires at least one input argument.');
end

y=exp((a-1).*log(x) +(b-1).*log(1-x) -betaln(a,b));


function B = dtimatrix(bvalues,bvectors)
% B = dtimatrix(bvalues,bvectors)
%
% Constructs a DTI design matrix from the bvalues and bvectors.
% bvalues is a vector of length N
% bvectors is a matrix either Nx3 or 3xN
%
% B will be N by 7
% The 7th is the mean (all ones)
% The tensor will be constructed using the following regressors
%     1 2 3
%     2 4 5
%     3 5 6
%
% $Id: dtimatrix.m,v 1.2 2011/03/02 00:04:12 nicks Exp $

%
% dtimatrix.m
%
% Original Author: Doug Greve
% CVS Revision Info:
%    $Author: nicks $
%    $Date: 2011/03/02 00:04:12 $
%    $Revision: 1.2 $
%
% Copyright © 2011 The General Hospital Corporation (Boston, MA) "MGH"
%
% Terms and conditions for use, reproduction, distribution and contribution
% are found in the 'FreeSurfer Software License Agreement' contained
% in the file 'LICENSE' found in the FreeSurfer distribution, and here:
%
% https://surfer.nmr.mgh.harvard.edu/fswiki/FreeSurferSoftwareLicense
%
% Reporting: freesurfer@nmr.mgh.harvard.edu
%

if(nargin ~= 2)
  fprintf('B = dtimatrix(bvalues,bvectors)\n');
  return;
end

if(size(bvectors,2) ~= 3) bvectors = bvectors'; end
if(size(bvectors,2) ~= 3)
  fprintf('ERROR: bvectors must be Nx3 or 3xN\n');
  return;
end
Nb = size(bvectors,1);

if(Nb ~= length(bvalues))
  fprintf('ERROR: dimension mismatch between bvectors and bvalues\n');
  return;
end

bvalues = bvalues(:);

B = zeros(Nb,7);
B(:,1) =     bvalues .* bvectors(:,1).*bvectors(:,1);
B(:,2) = 2 * bvalues .* bvectors(:,1).*bvectors(:,2);
B(:,3) = 2 * bvalues .* bvectors(:,1).*bvectors(:,3);
B(:,4) =     bvalues .* bvectors(:,2).*bvectors(:,2);
B(:,5) = 2 * bvalues .* bvectors(:,2).*bvectors(:,3);
B(:,6) =     bvalues .* bvectors(:,3).*bvectors(:,3);
B(:,7) = 1;

return;


function [curve, params, errors, T] = fit_poly_to_fragment(fragment, order)
%
%[curve, params, errors] = fit_poly_to_fragment(fragment, order)
%
% Fit a polynomial curve of specified order to an edge fragment.  A
% fragment is simply an Nx2 vector of (x,y) coordinates.
%
% Can also return fit error and the polynomial parameters.
%

% Ensure there are enough points:
if(isempty(fragment))
    error('Supplied fragment contains no points!');
end

N = size(fragment,1);

% Reduce the order if not enough points are provided to fit the requested
% order polynomial (e.g. we need N=4 points to fit a cubic, if only N=3
% points are provided, this will reduce the order to 2, thereby enabling
% successful fitting of a quadratic)
while( N < (order+1) )
    order = order-1;
end

t = linspace(0,1,N)';

fit_normals = false;
% if(nargin==2)
%     order = normal_angles;
%     fit_normals = false;
% end

T = ones(N,1);
for(i_order = 1:order)
    T = [t.^i_order T];
end

weights = ones(N, 1);
weights(1) = N/4;
weights(end) = N/4;
if(~fit_normals)
    % Fit the polynomial so that it simply tries to pass through the
    % fragment's vertex coordinates.
    params = (T .* repmat(weights, [1, order+1])) \ (fragment .* repmat(weights, [1, 2]));

%     % Constrained least squares to get the start and end points to exactly
%     % match up to the input coordinates:
%     for(i=1:2)
%         params(:,i) = lsqlin(T(2:end-1,:), fragment(2:end-1,i), ...
%             T([1 end],:), fragment([1 end],i),T([1 end],:), fragment([1 end],i));
%     end
else
    error(['Um, actually, trying to constrain the slopes this way will NOT ' ...
           'work. It is not linear because we do not know the length of the ' ...
           'normal vectors, only the direction.']);

%     params = T \ fragment;
%     L = L_helper(params, t, order);
%
%     % Fit the polynomial so that it tries to pass through the coordinates of the
%     % input fragment AND tries to have slope matching the orientations of
%     % each vertex in the fragment.
%     T_orient = [ones(N,1) zeros(N,1)];
%     for(i_order = 1:(order-1))
%         T_orient = [(i_order+1)*t.^i_order T_orient];
%     end
%
%     for(i=1:100)
%         TT = [blkdiag(T,T); blkdiag(-T_orient, T_orient)];
%
%         params = TT \ [fragment(:); L.*sin(normal_angles); L.*cos(normal_angles)];
%         params = reshape(params, [order+1 2]);
%
%         L = L_helper(params, t, order);
%     end

end

curve = T*params;
if(nargout>=3)
    errors = abs(curve - fragment);
end

return;

function L = L_helper(params, t, order)

dx = params(end-1,1);
dy = params(end-1,2);
for(i_order = 2:order)
    dx = dx + i_order*params(end-i_order,1)*t.^(i_order-1);
    dy = dy + i_order*params(end-i_order,2)*t.^(i_order-1);
end

L = sqrt(dx.^2 + dy.^2);
return;


function [ fxx, fxy, fyy ] = f03_f2 ( n, x, y )

%*****************************************************************************80
%
%% F03_F2 returns second derivatives of function 3.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 January 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of evaluation points.
%
%    Input, real X(N,1), Y(N,1), the evalution points.
%
%    Output, real FXX(N,1), FXY(N,1), FYY(N,1), second derivatives.
%
  t1(1:n,1) = 5.4 * y(1:n,1);
  t2(1:n,1) = 1.0 + ( 3.0 * x(1:n,1) - 1.0 ).^2;

  fxx(1:n,1) = 3.0 * ( 1.25 + cos ( t1(1:n,1) ) ) .* ( 3.0 * t2(1:n,1) - 4.0 ) ...
    ./ ( t2(1:n,1).^3 );
  fxy(1:n,1) = 5.4 * ( 3.0 * x(1:n,1) - 1.0 ) .* sin ( t1(1:n,1) ) ...
    ./ ( t2(1:n,1) .* t2(1:n,1) );
  fyy(1:n,1) = - 4.86 * cos ( t1(1:n,1) ) ./ t2(1:n,1);

  return
end


function [pc,r]=circumcenter(p,t)

%   Copyright (C) 2004-2006 Per-Olof Persson. See COPYRIGHT.TXT for details.

nt=size(t,1);
pc=zeros(nt,2);
r=zeros(nt,1);

for it=1:nt
  ct=t(it,:);
  dp1=p(ct(2),:)-p(ct(1),:);
  dp2=p(ct(3),:)-p(ct(1),:);

  mid1=(p(ct(2),:)+p(ct(1),:))/2;
  mid2=(p(ct(3),:)+p(ct(1),:))/2;

  s=[-dp1(2),dp2(2);dp1(1),-dp2(1)]\[-mid1+mid2]';

  cpc=mid1+s(1)*[-dp1(2),dp1(1)];
  cr=norm(p(ct(1),:)-cpc);

  pc(it,:)=cpc;
  r(it,1)=cr;
end


function ncc_set_test ( )

%*****************************************************************************80
%
%% NCC_SET_TEST tests NCC_SET.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    24 April 2015
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'NCC_SET_TEST\n' );
  fprintf ( 1, '  NCC_SET sets up a Newton-Cotes Closed quadrature rule;\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Index       X             W\n' );
  fprintf ( 1, '\n' );

  for n = 1 : 10

    [ x, w ] = ncc_set ( n );

    fprintf ( 1, '\n' );

    for i = 1 : n
      fprintf ( 1, '  %2d  %12g  %12g\n', i, x(i), w(i) );
    end

  end

  return
end


function beale_test ( )

%*****************************************************************************80
%
%% BEALE_TEST works with the Beale function.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 January 2012
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'BEALE_TEST:\n' );
  fprintf ( 1, '  Test COMPASS_SEARCH with the Beale function.\n' );
  m = 2;
  delta_tol = 0.00001;
  delta = 0.1;
  k_max = 20000;

  x = [ 1.0, 1.0 ];
  r8vec_print ( m, x, '  Initial point X0:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X0) = %g\n', beale ( m, x ) );

  [ x, fx, k ] = compass_search ( @beale, m, x, delta_tol, delta, k_max );
  r8vec_print ( m, x, '  Estimated minimizer X1:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X1) = %g, number of steps = %d\n', fx, k );
%
%  Repeat with more difficult start.
%
  x = [ 1.0, 4.0 ];
  r8vec_print ( m, x, '  Initial point X0:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X0) = %g\n', beale ( m, x ) );

  [ x, fx, k ] = compass_search ( @beale, m, x, delta_tol, delta, k_max );
  r8vec_print ( m, x, '  Estimated minimizer X1:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X1) = %g, number of steps = %d\n', fx, k );
%
%  Demonstrate correct minimizer.
%
  x = [ 3.0, 0.5 ];
  r8vec_print ( m, x, '  Correct minimizer X*:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X*) = %g\n', beale ( m, x ) );

  return
end


function Y = sl2dpca_apply(Mm, PL, PR, data, matsiz, n)
%SL2DPCA_APPLY Applies 2D PCA onto a set of matrices to extract features
%
% $ Syntax $
%   - Y = sl2dpca_apply(Mm, PL, PR, data, matsiz, n)
%
% $ Description $
%   - Mm:           the mean matrix
%   - PL:           the left projection matrix
%   - PR:           the right projection matrix
%   - data:         the matrix samples or the cell array of filenames
%   - matsiz:       the original matrix size
%   - n:            the number of samples
%   - Y:            the extracted 2D features
%
% $ Description $
%   - Y = sl2dpca_apply(data, Mm, PL, PR) extracts 2D features for
%     the matrices given in data, in either a 3D array or a set of
%     array filenames. Suppose the original matrix size is d1 x d2,
%     PL be d1 x k1, PR be d2 x k2, then the feature matrix would be
%     of size k1 x k2. Y is a k1 x k2 x n array.
%
% $ History $
%   - Created by Dahua Lin, on Jul 31st, 2006
%

%% Parse and verify input arguments

if nargin < 6
    raise_lackinput('sl2dpca_apply', 6);
end

matsiz = matsiz(:)';
if length(matsiz) ~= 2
    error('sltoolbox:invalidarg', ...
        'matsiz should be a 2-elem vector');
end

if ~isequal(size(Mm), matsiz)
    error('sltoolbox:sizmismatch', ...
        'the sample size does not match the model');
end
d1 = matsiz(1);
d2 = matsiz(2);

if size(PL, 1) ~= d1 || size(PR, 1) ~= d2
    error('sltoolbox:sizmismatch', ...
        'the size of projection matrices are illegal');
end

%% Compute

if isnumeric(data)

    if size(data, 3) ~= n
        error('sltoolbox:sizmismatch', ...
            'The number of samples is not as specified');
    end

    Y = computeY(data, Mm, PL, PR);

elseif iscell(data)

    Y = zeros(size(PL, 2), size(PR, 2), n);

    nfiles = length(data);
    cf = 0;
    for i = 1 : nfiles
        curdata = slreadarray(data{i});
        curn = size(curdata, 3);
        Y(:,:,cf+1:cf+curn) = computeY(curdata, Mm, PL, PR);
        cf = cf + curn;
    end

else
    error('sltoolbox:invalidarg', ...
        'data should be a numeric array or a cell array of filenames');

end

%% Core compute function

function Y = computeY(X, Mm, PL, PR)

n = size(X, 3);
Y = zeros(size(PL, 2), size(PR, 2), n);
PLT = PL';

for i = 1 : n
    Y(:,:,i) = PLT * (X(:,:,i) - Mm) * PR;
end