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

% This file is part of Manopt and is copyrighted. See the license file.
%
% Main author: Nicolas Boumal, Sept. 3, 2013
% Contributors:
%
% Change log:
%     Sep. 15, 2022 (NB):
%         Changed name from positive_definite_karcher_mean, clarified
%         some comments.

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

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

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

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

    % Explicitly pick an approximate Hessian for the trust-region method.
    % (This is only to show an example of how it can be done; the solver
    % below, rlbfgs, does not use the approximate Hessian; trustregions
    % would, but it would figure it out automatically with default
    % stepsize if the line below is omitted.)
    problem.approxhess = approxhessianFD(problem, struct('stepsize', 1e-4));

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

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

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

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

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

    % Issue a call to a solver. Default options are selected.
    % Our initial guess is the first data point. Most solvers work well
    % with this problem. Limited-memory BFGS is one good example:
    X = rlbfgs(problem, A(:, :, 1));

end


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

clear all;
close all;

num=[1 1];
den=conv([1 0],[0.1 -1]);
w=logspace(-1,2,100);
[m,p]=bode(num,den,w);
subplot(2,1,1),loglog(w,m,'-',w,ones(size(w)),'-');
grid;
ylabel('Magnitude');
title('Fig. 6.30 Bode Plot for G=(s+1)/[s(s/10 -1)] (a) magnitude');
subplot(2,1,2)
if p>0, p=p-360; end      % Matlab quadrant control varies in different versions
semilogx(w,p,'-',w,-180*ones(size(w)),'-');
axis([.1 100 -270 -90])
grid;
xlabel('\omega (rad/sec)');
ylabel('Phase (deg)');
title('(b) phase');


% This program obtains the analytical step response of a parallel RLC
% circuit. In addition, graphs of the voltage across the parallel
% combination and branch currents are obtained.
% H. Saadat, Copyright 1999

function PresponseIL
warning('off','MATLAB:dispatcher:InexactMatch')
Rhandle=findobj('Tag','Rtext');
R=eval(get(Rhandle,'String'));
KOhandle=findobj('Tag','KOhm');
KO=get(KOhandle,'Value');
if KO==1
   R=1000*R;
else, end
Lhandle=findobj('Tag','Ltext');
L=eval(get(Lhandle,'String'));
mHhandle=findobj('Tag','mHenry');
ml=get(mHhandle,'Value');
if ml==1
   L=L/1000;
else, end
Chandle=findobj('Tag','Ctext');
C=eval(get(Chandle,'String'));
micFhandle=findobj('Tag','micFarad');
micF=get(micFhandle,'Value');
if micF==1
   C=C/1000000;
else, end
Rhandle=findobj('Tag','IStext');
Is=eval(get(Rhandle,'String'));
Rhandle=findobj('Tag','I0text');
I0=eval(get(Rhandle,'String'));
Rhandle=findobj('Tag','V0text');
V0=eval(get(Rhandle,'String'));
% Step Response of a parallel RLC circuit
if L==inf | C==inf
   plot(0, 0)
   text(-0.8, 0.80, 'Parameters must lie in the following ranges:', 'color', [0 0 0.6275])
   text(-0.8, 0.65, '0 < R \leq inf,   0 < L < inf,   &    0 < C < inf', 'color', [0 0 0.6275])
   text(-0.8, 0.5, 'Enter the correct value and press Solve', 'color', [0 0 0.6275])
   axis([-1  1  -1  1]);return,  else
end
if R==0 | L==0 | C == 0
plot(0, 0)
title('Short-circuit across the parallel circuit', 'color', [ 1 0 0])
text(-0.8, 0.80, 'Parameters must lie in the following ranges:', 'color', [0 0 0.6275])
text(-0.8, 0.65, '0 < R \leq inf,   0 < L < inf,   &    0 < C < inf', 'color', [0 0 0.6275])
text(-0.8, 0.5, 'Enter the correct value and press Solve', 'color', [0 0 0.6275])
axis([-1  1  -1  1]);return,  else
alpha =1/(2*R*C);
end
w02 = 1/(L*C); w0 = sqrt(w02);
if alpha~= 0
   err=(alpha-w0)/alpha;
   if abs(err) <1e-4
   w0=alpha;
   else, end
else, end
dv = Is/C-I0/C-V0/(R*C);
di = V0/L;
if alpha > w0
 % Overdamped response
    s(1) = -alpha + sqrt(alpha^2 - w02);
    s(2) = -alpha - sqrt(alpha^2 - w02);
    A1 = (dv-s(2)*V0)/(s(1)-s(2));
    A2 = (dv-s(1)*V0)/(s(2)-s(1));
    A1i =(di-s(2)*(I0-Is))/(s(1)-s(2));
    A2i =(di-s(1)*(I0-Is))/(s(2)-s(1));
    tf = 6*max(abs(1/s(1)), abs(1/s(2)));
    t=0:tf/100:tf;
    v = A1*exp(s(1)*t)+A2*exp(s(2)*t);
    iL=Is + A1i*exp(s(1)*t)+A2i*exp(s(2)*t);
    iR = v/R;
    iC= Is -iR-iL;
    it=iR+iL+iC;
    plot(t,iL,'erasemode','none','color',[0.9 0 0.8]), grid
    if Is==0
    title(['I_L(t) = (', num2str(A1i), ') e^{(', num2str(s(1)), 't)} + (', num2str(A2i), ') e^{(', num2str(s(2)), 't)}'],'color',[0.9 0 0.8])
    elseif Is~=0
    title(['i_L(t) = ',num2str(Is), ' + (', num2str(A1i), ') e^{(', num2str(s(1)), 't)} + (', num2str(A2i), ') e^{(', num2str(s(2)), 't)}'],'color',[0.9 0 0.8])
    end
    xlabel(['\alpha = ',num2str(alpha), ',  \omega_0 = ',  num2str(w0), '  (O.D.)          t, sec'])
    ylabel('i_L(t), Amps')
    elseif alpha < w0
     if alpha~=0
      % Underdamped response
      tf = 6/alpha;
      t=0:tf/200:tf;
      wd= sqrt(w02 - alpha^2);
      s(1) = -alpha +j*wd;
      s(2) = -alpha -j*wd;
      B1 = V0; B2 = (dv+alpha*B1)/wd;
      B1i = I0 - Is; B2i = (di+alpha*B1i)/wd;
      v = exp(-alpha*t).*(B1*cos(wd*t)+B2*sin(wd*t));
      iL = Is + exp(-alpha*t).*(B1i*cos(wd*t)+B2i*sin(wd*t));
      iR = v/R;
      iC= Is -iR-iL;
      it=iR+iL+iC;
      plot(t,iL,'erasemode','none','color',[.9 0 0.8]), grid
         if Is == 0
         title(['I_L(t) = e^{(-', num2str(alpha), 't)}[(', num2str(B1i), ')cos',num2str(wd),'t + (' , num2str(B2i), ')sin',num2str(wd),'t]'],'color',[0.9 0 0.8])
         elseif Is~= 0
         title(['i_L(t) = ',num2str(Is), ' + e^{(-', num2str(alpha), 't)}[(', num2str(B1i), ')cos',num2str(wd),'t + (' , num2str(B2i), ')sin',num2str(wd),'t]'],'color',[0.9 0 0.8])
         end
      xlabel(['\alpha = ',num2str(alpha), ',  \omega_0 = ',  num2str(w0), '  (U.D.)          t, sec'])
      ylabel('i_L(t), Amps')
      else
      % Undamped Response
      tf = 8*pi/w0;
      t=0:tf/200:tf;
      wd= w0;
      B1 = V0; B2 = (dv)/wd;
      B1i = I0 - Is; B2i = (di)/wd;
      iL = Is + B1i*cos(wd*t)+B2i*sin(wd*t);
      v = B1*cos(wd*t)+B2*sin(wd*t);
      iR = v/R;
      iC= Is -iR-iL;
      it=iR+iL+iC;
      plot(t,iL,'erasemode','none','color',[0.9 0 0.80]), grid
      	if Is == 0
      	title(['I_L(t) = (', num2str(B1i), ')cos',num2str(wd),'t + (' , num2str(B2i), ')sin',num2str(wd),'t'],'color',[0.9 0 0.8])
      	elseif Is ~= 0
      	title(['i_L(t) = ',num2str(Is), ' + (', num2str(B1i), ')cos',num2str(wd),'t + (' , num2str(B2i), ')sin',num2str(wd),'t'],'color',[0.9 0 0.8])
      	end
      xlabel(['\alpha = ',num2str(alpha), ',  \omega_0 = ',  num2str(w0), '  (Undamped)          t, sec'])
      ylabel('i_L(t), Amps')
      end
   elseif alpha ==w0
    % Critically damped response
    s(1)=-alpha;  s(2) = s(1);
    D2 = V0;
    D1 = dv+alpha*D2;
    D2i = I0 - Is; D1i = di+alpha*D2i;
    tf = 8/alpha;
    t=0:tf/100:tf;
    iL=Is + exp(-alpha*t).*(D1i*t+D2i);
    v = exp(-alpha*t).*(D1*t+D2);
    iR = v/R;
    iC= Is -iR-iL;
    it=iR+iL+iC;
    plot(t,iL,'erasemode','none','color',[0.9 0 0.8]), grid
    	if Is == 0
          title(['i_L(t) = e^{(-', num2str(alpha), 't)}[(', num2str(D1i), ')t + (' , num2str(D2i), ')]'],'color',[0.9 0 0.8])
          elseif Is ~= 0
          title(['i_L(t) = ',num2str(Is), ' + e^{(-', num2str(alpha), 't)}[(', num2str(D1i), ')t + (' , num2str(D2i), ')]'],'color',[0.9 0 0.8])
      end
    xlabel(['\alpha = ',num2str(alpha), ',  \omega_0 = ',  num2str(w0), '  (C.D.)          t, sec'])
    ylabel('i_L(t), Amps')
    else, end


function [out, idxtrain,eigvector, eigvalue] = kpca(spectraldata, No_Train, dimension, kernel, parameter)

%
%  Kernel principal component analysis, KPCA
%
% [out, eigvector, eigvalue] = kpca(spectraldata, No_Train, dimension, kernel, parameter)
%
% Input
%
% spectraldata       - input hyperspectral data with 3-D, ncols by nrows by nbands
% No_Train           - randomly selected samples for training (<= 5000),
%                       depending on the memory of your PC
% dimension          - the dimension of extracted kernelized PCs (with largest eigen values)
% kernel             - kernel function
% parameter          - parameters for kernel fuction
%                        - kernel = 'linear';% linear kernel
%                        - kernel = 'Gaussian'; parameter=1; %Gausian kernel
%                        - kernel = 'poly'; parameter=[1,3];% third order polynomial
%
%
% Output
%
% out                - the extracted kernelized PCs
% eigvector          - the eigenvectors divided by square root of corresponding eigenvalues
% eigvalue           - the first dimension largest eigenvalues

if nargin <  3, error('not enough input'); end
if nargin <  4
    if strncmp(kernel,'Gaussian',1)
        parameter=1;
    elseif strncmp(kernel,'poly',1)
        parameter=[1, 3];
    end
end

[nrows,ncols,nbands] = size(spectraldata);
X0 = reshape(spectraldata,nrows*ncols,nbands);
clear spectraldata

%% sub-sample for training, select No_Train samples randomly
rand('state',4711007);% initialization of rand
if No_Train>nrows*ncols, No_Train = nrows*ncols; end
idxtrain = randsample(nrows*ncols, No_Train);
X = double(X0(idxtrain,:));
ntrain = size(X,1);

Xtest = X0;
ntest = size(Xtest,1);
clear X0;

%% kernelized training data and centering the kernel matrix
[K scale sums] = kernelize_training(kernel, X, parameter);
meanK = mean(K(:));
meanrowsK = mean(K);
K = centering(K);

%% select the first dimension eigvectors
dimout = ntrain;
if dimout>dimension, dimout=dimension; end
[eigvector,eigvalue,flagk] = eigs(K, dimout, 'LM');

if flagk~=0, warning('*** Convergence problems in eigs ***'); end
eigvalue = diag(abs(eigvalue))';
eigvector = sqrt(ntrain-1)*eigvector*diag(1./sqrt(eigvalue));
clear K

out = NaN(ntest,dimout);
%% kernelized the test samples, center kernel and calculate kernel PCs
for rr=1:nrows
     idx = (rr-1)*ncols+1;
     idx = idx:(idx+ncols-1);
     Xk = kernelize_test(kernel, X, Xtest(idx,:), scale, sums);
     Xk = Xk - repmat(meanrowsK,ncols,1)' - repmat(mean(Xk),ntrain,1) + meanK;
     out(idx,:) = Xk'*eigvector;
end

out = reshape(out,nrows,ncols,dimout);


function [d, pt1, pt2] = distanceLines3d(line1, line2)
%DISTANCELINES3D Minimal distance between two 3D lines.
%
%   D = distanceLines3d(LINE1, LINE2);
%   Returns the distance between line LINE1 and the line LINE2, given as:
%   LINE1 : [x0 y0 z0 dx dy dz] (or M-by-6 array)
%   LINE2 : [x0 y0 z0 dx dy dz] (or N-by-6 array)
%   D     : (positive) array M-by-N
%
%   [D, PT1, PT2] = distanceLines3d(LINE1, LINE2);
%   Also returns the points located on LINE1 and LINE2 corresponding to the
%   shortest distance.
%   One should get the following:
%   distancePoints3d(PT1, PT2) - D == 0
%
%
%   Example
%     line1 = [2 3 4 0 1 0];
%     line2 = [8 8 8 0 0 1];
%     distanceLines3d(line1, line2)
%     ans =
%         6.0000
%
%   See also:
%   lines3d, distancePoints3d
%
%   ---------
%   authors: Brandon Baker, oqilipo, David Legland
%   created January 19, 2011
%

% number of points of each array
n1 = size(line1, 1);
n2 = size(line2, 1);

if nargout <= 1
    % express line coordinate as n1-by-n2 arrays
    v1x = repmat(line1(:,4), [1 n2]);
    v1y = repmat(line1(:,5), [1 n2]);
    v1z = repmat(line1(:,6), [1 n2]);
    p1x = repmat(line1(:,1), [1 n2]);
    p1y = repmat(line1(:,2), [1 n2]);
    p1z = repmat(line1(:,3), [1 n2]);

    v2x = repmat(line2(:,4)', [n1 1]);
    v2y = repmat(line2(:,5)', [n1 1]);
    v2z = repmat(line2(:,6)', [n1 1]);
    p2x = repmat(line2(:,1)', [n1 1]);
    p2y = repmat(line2(:,2)', [n1 1]);
    p2z = repmat(line2(:,3)', [n1 1]);

    % calculates distance for each set of lines
    vcross = cross([v1x(:) v1y(:) v1z(:)], [v2x(:) v2y(:) v2z(:)]);
    num = ([p1x(:) p1y(:) p1z(:)] - [p2x(:) p2y(:) p2z(:)]) .* vcross;
    t1 = sum(num,2);
    d = abs(t1) ./ (vectorNorm3d(vcross) + eps);

    % returns result as n1-by-n2 array
    d = reshape(d, n1, n2);

else
    % check input dimension, as we need to be able to match each pair of
    % lines
    if n1 ~= n2
        error('geom3d:distanceLines3d:IllegalInputArgument', ...
            'when output points are requested, number of lines should be the same');
    end

    p1 = line1(:, 1:3);
    p2 = line2(:, 1:3);
    dp = p2 - p1;
    v1 = line1(:, 4:6);
    v2 = line2(:, 4:6);

    % compute distance
    vcross = cross(v1, v2, 2);
    num = dp .* vcross;
    t1 = sum(num, 2);
    d = abs(t1) ./ (vectorNorm3d(vcross) + eps);

    % precomputations
    a = dot(v1, v1, 2);
    b = dot(v1, v2, 2);
    e = dot(v2, v2, 2);
    den = a.*e - b.*b; % 0, if lines are parallel

    % vector between origin of both lines
    r = line1(:,1:3) - line2(:,1:3);

    % solve linear system
    c = dot(v1, r, 2);
    f = dot(v2, r, 2);
    s = (b .* f - c .* e) ./ den;
    t = (a .* f - c .* b) ./ den;

    % convert to coordinates of points on lines
    pt1 = line1(:,1:3) + v1 .* s;
    pt2 = line2(:,1:3) + v2 .* t;
end


function [zgrid,xgrid,ygrid] = gridfit(x,y,z,xnodes,ynodes,varargin)
% gridfit: estimates a surface on a 2d grid, based on scattered data
%          Replicates are allowed. All methods extrapolate to the grid
%          boundaries. Gridfit uses a modified ridge estimator to
%          generate the surface, where the bias is toward smoothness.
%
%          Gridfit is not an interpolant. Its goal is a smooth surface
%          that approximates your data, but allows you to control the
%          amount of smoothing.
%
% usage #1: zgrid = gridfit(x,y,z,xnodes,ynodes);
% usage #2: [zgrid,xgrid,ygrid] = gridfit(x,y,z,xnodes,ynodes);
% usage #3: zgrid = gridfit(x,y,z,xnodes,ynodes,prop,val,prop,val,...);
%
% Arguments: (input)
%  x,y,z - vectors of equal lengths, containing arbitrary scattered data
%          The only constraint on x and y is they cannot ALL fall on a
%          single line in the x-y plane. Replicate points will be treated
%          in a least squares sense.
%
%          ANY points containing a NaN are ignored in the estimation
%
%  xnodes - vector defining the nodes in the grid in the independent
%          variable (x). xnodes need not be equally spaced. xnodes
%          must completely span the data. If they do not, then the
%          'extend' property is applied, adjusting the first and last
%          nodes to be extended as necessary. See below for a complete
%          description of the 'extend' property.
%
%          If xnodes is a scalar integer, then it specifies the number
%          of equally spaced nodes between the min and max of the data.
%
%  ynodes - vector defining the nodes in the grid in the independent
%          variable (y). ynodes need not be equally spaced.
%
%          If ynodes is a scalar integer, then it specifies the number
%          of equally spaced nodes between the min and max of the data.
%
%          Also see the extend property.
%
%  Additional arguments follow in the form of property/value pairs.
%  Valid properties are:
%    'smoothness', 'interp', 'regularizer', 'solver', 'maxiter'
%    'extend', 'tilesize', 'overlap'
%
%  Any UNAMBIGUOUS shortening (even down to a single letter) is
%  valid for property names. All properties have default values,
%  chosen (I hope) to give a reasonable result out of the box.
%
%   'smoothness' - scalar - determines the eventual smoothness of the
%          estimated surface. A larger value here means the surface
%          will be smoother. Smoothness must be a non-negative real
%          number.
%
%          Note: the problem is normalized in advance so that a
%          smoothness of 1 MAY generate reasonable results. If you
%          find the result is too smooth, then use a smaller value
%          for this parameter. Likewise, bumpy surfaces suggest use
%          of a larger value. (Sometimes, use of an iterative solver
%          with too small a limit on the maximum number of iterations
%          will result in non-convergence.)
%
%          DEFAULT: 1
%
%
%   'interp' - character, denotes the interpolation scheme used
%          to interpolate the data.
%
%          DEFAULT: 'triangle'
%
%          'bilinear' - use bilinear interpolation within the grid
%                     (also known as tensor product linear interpolation)
%
%          'triangle' - split each cell in the grid into a triangle,
%                     then linear interpolation inside each triangle
%
%          'nearest' - nearest neighbor interpolation. This will
%                     rarely be a good choice, but I included it
%                     as an option for completeness.
%
%
%   'regularizer' - character flag, denotes the regularization
%          paradignm to be used. There are currently three options.
%
%          DEFAULT: 'gradient'
%
%          'diffusion' or 'laplacian' - uses a finite difference
%              approximation to the Laplacian operator (i.e, del^2).
%
%              We can think of the surface as a plate, wherein the
%              bending rigidity of the plate is specified by the user
%              as a number relative to the importance of fidelity to
%              the data. A stiffer plate will result in a smoother
%              surface overall, but fit the data less well. I've
%              modeled a simple plate using the Laplacian, del^2. (A
%              projected enhancement is to do a better job with the
%              plate equations.)
%
%              We can also view the regularizer as a diffusion problem,
%              where the relative thermal conductivity is supplied.
%              Here interpolation is seen as a problem of finding the
%              steady temperature profile in an object, given a set of
%              points held at a fixed temperature. Extrapolation will
%              be linear. Both paradigms are appropriate for a Laplacian
%              regularizer.
%
%          'gradient' - attempts to ensure the gradient is as smooth
%              as possible everywhere. Its subtly different from the
%              'diffusion' option, in that here the directional
%              derivatives are biased to be smooth across cell
%              boundaries in the grid.
%
%              The gradient option uncouples the terms in the Laplacian.
%              Think of it as two coupled PDEs instead of one PDE. Why
%              are they different at all? The terms in the Laplacian
%              can balance each other.
%
%          'springs' - uses a spring model connecting nodes to each
%              other, as well as connecting data points to the nodes
%              in the grid. This choice will cause any extrapolation
%              to be as constant as possible.
%
%              Here the smoothing parameter is the relative stiffness
%              of the springs connecting the nodes to each other compared
%              to the stiffness of a spting connecting the lattice to
%              each data point. Since all springs have a rest length
%              (length at which the spring has zero potential energy)
%              of zero, any extrapolation will be minimized.
%
%          Note: I don't terribly like the 'springs' strategy.
%          It tends to drag the surface towards the mean of all
%          the data. Its been left in only because the paradigm
%          interests me.
%
%
%   'solver' - character flag - denotes the solver used for the
%          resulting linear system. Different solvers will have
%          different solution times depending upon the specific
%          problem to be solved. Up to a certain size grid, the
%          direct \ solver will often be speedy, until memory
%          swaps causes problems.
%
%          What solver should you use? Problems with a significant
%          amount of extrapolation should avoid lsqr. \ may be
%          best numerically for small smoothnesss parameters and
%          high extents of extrapolation.
%
%          Large numbers of points will slow down the direct
%          \, but when applied to the normal equations, \ can be
%          quite fast. Since the equations generated by these
%          methods will tend to be well conditioned, the normal
%          equations are not a bad choice of method to use. Beware
%          when a small smoothing parameter is used, since this will
%          make the equations less well conditioned.
%
%          DEFAULT: 'normal'
%
%          '\' - uses matlab's backslash operator to solve the sparse
%                     system. 'backslash' is an alternate name.
%
%          'symmlq' - uses matlab's iterative symmlq solver
%
%          'lsqr' - uses matlab's iterative lsqr solver
%
%          'normal' - uses \ to solve the normal equations.
%
%
%   'maxiter' - only applies to iterative solvers - defines the
%          maximum number of iterations for an iterative solver
%
%          DEFAULT: min(10000,length(xnodes)*length(ynodes))
%
%
%   'extend' - character flag - controls whether the first and last
%          nodes in each dimension are allowed to be adjusted to
%          bound the data, and whether the user will be warned if
%          this was deemed necessary to happen.
%
%          DEFAULT: 'warning'
%
%          'warning' - Adjust the first and/or last node in
%                     x or y if the nodes do not FULLY contain
%                     the data. Issue a warning message to this
%                     effect, telling the amount of adjustment
%                     applied.
%
%          'never'  - Issue an error message when the nodes do
%                     not absolutely contain the data.
%
%          'always' - automatically adjust the first and last
%                     nodes in each dimension if necessary.
%                     No warning is given when this option is set.
%
%
%   'tilesize' - grids which are simply too large to solve for
%          in one single estimation step can be built as a set
%          of tiles. For example, a 1000x1000 grid will require
%          the estimation of 1e6 unknowns. This is likely to
%          require more memory (and time) than you have available.
%          But if your data is dense enough, then you can model
%          it locally using smaller tiles of the grid.
%
%          My recommendation for a reasonable tilesize is
%          roughly 100 to 200. Tiles of this size take only
%          a few seconds to solve normally, so the entire grid
%          can be modeled in a finite amount of time. The minimum
%          tilesize can never be less than 3, although even this
%          size tile is so small as to be ridiculous.
%
%          If your data is so sparse than some tiles contain
%          insufficient data to model, then those tiles will
%          be left as NaNs.
%
%          DEFAULT: inf
%
%
%   'overlap' - Tiles in a grid have some overlap, so they
%          can minimize any problems along the edge of a tile.
%          In this overlapped region, the grid is built using a
%          bi-linear combination of the overlapping tiles.
%
%          The overlap is specified as a fraction of the tile
%          size, so an overlap of 0.20 means there will be a 20%
%          overlap of successive tiles. I do allow a zero overlap,
%          but it must be no more than 1/2.
%
%          0 <= overlap <= 0.5
%
%          Overlap is ignored if the tilesize is greater than the
%          number of nodes in both directions.
%
%          DEFAULT: 0.20
%
%
%   'autoscale' - Some data may have widely different scales on
%          the respective x and y axes. If this happens, then
%          the regularization may experience difficulties.
%
%          autoscale = 'on' will cause gridfit to scale the x
%          and y node intervals to a unit length. This should
%          improve the regularization procedure. The scaling is
%          purely internal.
%
%          autoscale = 'off' will disable automatic scaling
%
%          DEFAULT: 'on'
%
%
% Arguments: (output)
%  zgrid   - (nx,ny) array containing the fitted surface
%
%  xgrid, ygrid - as returned by meshgrid(xnodes,ynodes)
%
%
% Speed considerations:
%  Remember that gridfit must solve a LARGE system of linear
%  equations. There will be as many unknowns as the total
%  number of nodes in the final lattice. While these equations
%  may be sparse, solving a system of 10000 equations may take
%  a second or so. Very large problems may benefit from the
%  iterative solvers or from tiling.
%
%
% Example usage:
%
%  x = rand(100,1);
%  y = rand(100,1);
%  z = exp(x+2*y);
%  xnodes = 0:.1:1;
%  ynodes = 0:.1:1;
%
%  g = gridfit(x,y,z,xnodes,ynodes);
%
% Note: this is equivalent to the following call:
%
%  g = gridfit(x,y,z,xnodes,ynodes, ...
%              'smooth',1, ...
%              'interp','triangle', ...
%              'solver','normal', ...
%              'regularizer','gradient', ...
%              'extend','warning', ...
%              'tilesize',inf);
%
%
% Author: John D'Errico
% e-mail address: woodchips@rochester.rr.com
% Release: 2.0
% Release date: 5/23/06

% set defaults
params.smoothness = 1;
params.interp = 'triangle';
params.regularizer = 'gradient';
params.solver = 'normal';
params.maxiter = [];
params.extend = 'warning';
params.tilesize = inf;
params.overlap = 0.20;
params.mask = [];
params.autoscale = 'on';
params.xscale = 1;
params.yscale = 1;

% was the params struct supplied?
if ~isempty(varargin)
  if isstruct(varargin{1})
    % params is only supplied if its a call from tiled_gridfit
    params = varargin{1};
    if length(varargin)>1
      % check for any overrides
      params = parse_pv_pairs(params,varargin{2:end});
    end
  else
    % check for any overrides of the defaults
    params = parse_pv_pairs(params,varargin);

  end
end

% check the parameters for acceptability
params = check_params(params);

% ensure all of x,y,z,xnodes,ynodes are column vectors,
% also drop any NaN data
x=x(:);
y=y(:);
z=z(:);
k = isnan(x) | isnan(y) | isnan(z);
if any(k)
  x(k)=[];
  y(k)=[];
  z(k)=[];
end
xmin = min(x);
xmax = max(x);
ymin = min(y);
ymax = max(y);

% did they supply a scalar for the nodes?
if length(xnodes)==1
  xnodes = linspace(xmin,xmax,xnodes)';
  xnodes(end) = xmax; % make sure it hits the max
end
if length(ynodes)==1
  ynodes = linspace(ymin,ymax,ynodes)';
  ynodes(end) = ymax; % make sure it hits the max
end

xnodes=xnodes(:);
ynodes=ynodes(:);
dx = diff(xnodes);
dy = diff(ynodes);
nx = length(xnodes);
ny = length(ynodes);
ngrid = nx*ny;

% set the scaling if autoscale was on
if strcmpi(params.autoscale,'on')
  params.xscale = mean(dx);
  params.yscale = mean(dy);
  params.autoscale = 'off';
end

% check to see if any tiling is necessary
if (params.tilesize < max(nx,ny))
  % split it into smaller tiles. compute zgrid and ygrid
  % at the very end if requested
  zgrid = tiled_gridfit(x,y,z,xnodes,ynodes,params);
else
  % its a single tile.

  % mask must be either an empty array, or a boolean
  % aray of the same size as the final grid.
  nmask = size(params.mask);
  if ~isempty(params.mask) && ((nmask(2)~=nx) || (nmask(1)~=ny))
    if ((nmask(2)==ny) || (nmask(1)==nx))
      error 'Mask array is probably transposed from proper orientation.'
    else
      error 'Mask array must be the same size as the final grid.'
    end
  end
  if ~isempty(params.mask)
    params.maskflag = 1;
  else
    params.maskflag = 0;
  end

  % default for maxiter?
  if isempty(params.maxiter)
    params.maxiter = min(10000,nx*ny);
  end

  % check lengths of the data
  n = length(x);
  if (length(y)~=n) || (length(z)~=n)
    error 'Data vectors are incompatible in size.'
  end
  if n<3
    error 'Insufficient data for surface estimation.'
  end

  % verify the nodes are distinct
  if any(diff(xnodes)<=0) || any(diff(ynodes)<=0)
    error 'xnodes and ynodes must be monotone increasing'
  end

  % do we need to tweak the first or last node in x or y?
  if xmin<xnodes(1)
    switch params.extend
      case 'always'
        xnodes(1) = xmin;
      case 'warning'
        warning(['xnodes(1) was decreased by: ',num2str(xnodes(1)-xmin),', new node = ',num2str(xmin)])
        xnodes(1) = xmin;
      case 'never'
        error(['Some x (',num2str(xmin),') falls below xnodes(1) by: ',num2str(xnodes(1)-xmin)])
    end
  end
  if xmax>xnodes(end)
    switch params.extend
      case 'always'
        xnodes(end) = xmax;
      case 'warning'
        warning(['xnodes(end) was increased by: ',num2str(xmax-xnodes(end)),', new node = ',num2str(xmax)])
        xnodes(end) = xmax;
      case 'never'
        error(['Some x (',num2str(xmax),') falls above xnodes(end) by: ',num2str(xmax-xnodes(end))])
    end
  end
  if ymin<ynodes(1)
    switch params.extend
      case 'always'
        ynodes(1) = ymin;
      case 'warning'
        warning(['ynodes(1) was decreased by: ',num2str(ynodes(1)-ymin),', new node = ',num2str(ymin)])
        ynodes(1) = ymin;
      case 'never'
        error(['Some y (',num2str(ymin),') falls below ynodes(1) by: ',num2str(ynodes(1)-ymin)])
    end
  end
  if ymax>ynodes(end)
    switch params.extend
      case 'always'
        ynodes(end) = ymax;
      case 'warning'
        warning(['ynodes(end) was increased by: ',num2str(ymax-ynodes(end)),', new node = ',num2str(ymax)])
        ynodes(end) = ymax;
      case 'never'
        error(['Some y (',num2str(ymax),') falls above ynodes(end) by: ',num2str(ymax-ynodes(end))])
    end
  end

  % determine which cell in the array each point lies in
  [junk,indx] = histc(x,xnodes); %#ok
  [junk,indy] = histc(y,ynodes); %#ok
  % any point falling at the last node is taken to be
  % inside the last cell in x or y.
  k=(indx==nx);
  indx(k)=indx(k)-1;
  k=(indy==ny);
  indy(k)=indy(k)-1;
  ind = indy + ny*(indx-1);

  % Do we have a mask to apply?
  if params.maskflag
    % if we do, then we need to ensure that every
    % cell with at least one data point also has at
    % least all of its corners unmasked.
    params.mask(ind) = 1;
    params.mask(ind+1) = 1;
    params.mask(ind+ny) = 1;
    params.mask(ind+ny+1) = 1;
  end

  % interpolation equations for each point
  tx = min(1,max(0,(x - xnodes(indx))./dx(indx)));
  ty = min(1,max(0,(y - ynodes(indy))./dy(indy)));
  % Future enhancement: add cubic interpolant
  switch params.interp
    case 'triangle'
      % linear interpolation inside each triangle
      k = (tx > ty);
      L = ones(n,1);
      L(k) = ny;

      t1 = min(tx,ty);
      t2 = max(tx,ty);
      A = sparse(repmat((1:n)',1,3),[ind,ind+ny+1,ind+L], ...
        [1-t2,t1,t2-t1],n,ngrid);

    case 'nearest'
      % nearest neighbor interpolation in a cell
      k = round(1-ty) + round(1-tx)*ny;
      A = sparse((1:n)',ind+k,ones(n,1),n,ngrid);

    case 'bilinear'
      % bilinear interpolation in a cell
      A = sparse(repmat((1:n)',1,4),[ind,ind+1,ind+ny,ind+ny+1], ...
        [(1-tx).*(1-ty), (1-tx).*ty, tx.*(1-ty), tx.*ty], ...
        n,ngrid);

  end
  rhs = z;

  % Build regularizer. Add del^4 regularizer one day.
  switch params.regularizer
    case 'springs'
      % zero "rest length" springs
      [i,j] = meshgrid(1:nx,1:(ny-1));
      ind = j(:) + ny*(i(:)-1);
      m = nx*(ny-1);
      stiffness = 1./(dy/params.yscale);
      Areg = sparse(repmat((1:m)',1,2),[ind,ind+1], ...
        stiffness(j(:))*[-1 1],m,ngrid);

      [i,j] = meshgrid(1:(nx-1),1:ny);
      ind = j(:) + ny*(i(:)-1);
      m = (nx-1)*ny;
      stiffness = 1./(dx/params.xscale);
      Areg = [Areg;sparse(repmat((1:m)',1,2),[ind,ind+ny], ...
        stiffness(i(:))*[-1 1],m,ngrid)];

      [i,j] = meshgrid(1:(nx-1),1:(ny-1));
      ind = j(:) + ny*(i(:)-1);
      m = (nx-1)*(ny-1);
      stiffness = 1./sqrt((dx(i(:))/params.xscale).^2 + ...
        (dy(j(:))/params.yscale).^2);

      Areg = [Areg;sparse(repmat((1:m)',1,2),[ind,ind+ny+1], ...
        stiffness*[-1 1],m,ngrid)];

      Areg = [Areg;sparse(repmat((1:m)',1,2),[ind+1,ind+ny], ...
        stiffness*[-1 1],m,ngrid)];

    case {'diffusion' 'laplacian'}
      % thermal diffusion using Laplacian (del^2)
      [i,j] = meshgrid(1:nx,2:(ny-1));
      ind = j(:) + ny*(i(:)-1);
      dy1 = dy(j(:)-1)/params.yscale;
      dy2 = dy(j(:))/params.yscale;

      Areg = sparse(repmat(ind,1,3),[ind-1,ind,ind+1], ...
        [-2./(dy1.*(dy1+dy2)), 2./(dy1.*dy2), ...
        -2./(dy2.*(dy1+dy2))],ngrid,ngrid);

      [i,j] = meshgrid(2:(nx-1),1:ny);
      ind = j(:) + ny*(i(:)-1);
      dx1 = dx(i(:)-1)/params.xscale;
      dx2 = dx(i(:))/params.xscale;

      Areg = Areg + sparse(repmat(ind,1,3),[ind-ny,ind,ind+ny], ...
        [-2./(dx1.*(dx1+dx2)), 2./(dx1.*dx2), ...
        -2./(dx2.*(dx1+dx2))],ngrid,ngrid);

    case 'gradient'
      % Subtly different from the Laplacian. A point for future
      % enhancement is to do it better for the triangle interpolation
      % case.
      [i,j] = meshgrid(1:nx,2:(ny-1));
      ind = j(:) + ny*(i(:)-1);
      dy1 = dy(j(:)-1)/params.yscale;
      dy2 = dy(j(:))/params.yscale;

      Areg = sparse(repmat(ind,1,3),[ind-1,ind,ind+1], ...
        [-2./(dy1.*(dy1+dy2)), 2./(dy1.*dy2), ...
        -2./(dy2.*(dy1+dy2))],ngrid,ngrid);

      [i,j] = meshgrid(2:(nx-1),1:ny);
      ind = j(:) + ny*(i(:)-1);
      dx1 = dx(i(:)-1)/params.xscale;
      dx2 = dx(i(:))/params.xscale;

      Areg = [Areg;sparse(repmat(ind,1,3),[ind-ny,ind,ind+ny], ...
        [-2./(dx1.*(dx1+dx2)), 2./(dx1.*dx2), ...
        -2./(dx2.*(dx1+dx2))],ngrid,ngrid)];

  end
  nreg = size(Areg,1);

  % Append the regularizer to the interpolation equations,
  % scaling the problem first. Use the 1-norm for speed.
  NA = norm(A,1);
  NR = norm(Areg,1);
  A = [A;Areg*(params.smoothness*NA/NR)];
  rhs = [rhs;zeros(nreg,1)];
  % do we have a mask to apply?
  if params.maskflag
    unmasked = find(params.mask);
  end
  % solve the full system, with regularizer attached
  switch params.solver
    case {'\' 'backslash'}
      if params.maskflag
        % there is a mask to use
        % permute for minimum fill in for R (in the QR)
        p = colamd(A(:,unmasked));
        zgrid=nan(ny,nx);
        zgrid(unmasked(p)) = A(:,unmasked(p))\rhs;
      else
        % permute for minimum fill in for R (in the QR)
        p = colamd(A);
        zgrid=zeros(ny,nx);
        zgrid(p) = A(:,p)\rhs;
      end

    case 'normal'
      % The normal equations, solved with \. Can be fast
      % for huge numbers of data points.
      if params.maskflag
        % there is a mask to use
        % Permute for minimum fill-in for \ (in chol)
        APA = A(:,unmasked)'*A(:,unmasked);
        p = symamd(APA);
        zgrid=nan(ny,nx);
        zgrid(unmasked(p)) = APA(p,p)\(A(:,unmasked(p))'*rhs);
      else
        % Permute for minimum fill-in for \ (in chol)
        APA = A'*A;
        p = symamd(APA);
        zgrid=zeros(ny,nx);
        zgrid(p) = APA(p,p)\(A(:,p)'*rhs);
      end

    case 'symmlq'
      % iterative solver - symmlq - requires a symmetric matrix,
      % so use it to solve the normal equations. No preconditioner.
      tol = abs(max(z)-min(z))*1.e-13;
      if params.maskflag
        % there is a mask to use
        zgrid=nan(ny,nx);
        [zgrid(unmasked),flag] = symmlq(A(:,unmasked)'*A(:,unmasked), ...
          A(:,unmasked)'*rhs,tol,params.maxiter);
      else
        [zgrid,flag] = symmlq(A'*A,A'*rhs,tol,params.maxiter);
        zgrid = reshape(zgrid,ny,nx);
      end
      % display a warning if convergence problems
      switch flag
        case 0
          % no problems with convergence
        case 1
          % SYMMLQ iterated MAXIT times but did not converge.
          warning(['Symmlq performed ',num2str(params.maxiter), ...
            ' iterations but did not converge.'])
        case 3
          % SYMMLQ stagnated, successive iterates were the same
          warning 'Symmlq stagnated without apparent convergence.'
        otherwise
          warning(['One of the scalar quantities calculated in',...
            ' symmlq was too small or too large to continue computing.'])
      end

    case 'lsqr'
      % iterative solver - lsqr. No preconditioner here.
      tol = abs(max(z)-min(z))*1.e-13;
      if params.maskflag
        % there is a mask to use
        zgrid=nan(ny,nx);
        [zgrid(unmasked),flag] = lsqr(A(:,unmasked),rhs,tol,params.maxiter);
      else
        [zgrid,flag] = lsqr(A,rhs,tol,params.maxiter);
        zgrid = reshape(zgrid,ny,nx);
      end

      % display a warning if convergence problems
      switch flag
        case 0
          % no problems with convergence
        case 1
          % lsqr iterated MAXIT times but did not converge.
          warning(['Lsqr performed ',num2str(params.maxiter), ...
            ' iterations but did not converge.'])
        case 3
          % lsqr stagnated, successive iterates were the same
          warning 'Lsqr stagnated without apparent convergence.'
        case 4
          warning(['One of the scalar quantities calculated in',...
            ' LSQR was too small or too large to continue computing.'])
      end

  end

end  % if params.tilesize...

% only generate xgrid and ygrid if requested.
if nargout>1
  [xgrid,ygrid]=meshgrid(xnodes,ynodes);
end

% ============================================
% End of main function - gridfit
% ============================================

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

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

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

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

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

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

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

end

% ============================================
% subfunction - check_params
% ============================================
function params = check_params(params)

% check the parameters for acceptability
% smoothness == 1 by default
if isempty(params.smoothness)
  params.smoothness = 1;
else
  if (length(params.smoothness)>1) || (params.smoothness<=0)
    error 'Smoothness must be scalar, real, finite, and positive.'
  end
end

% regularizer  - must be one of 4 options - the second and
% third are actually synonyms.
valid = {'springs', 'diffusion', 'laplacian', 'gradient'};
if isempty(params.regularizer)
  params.regularizer = 'diffusion';
end
ind = find(strncmpi(params.regularizer,valid,length(params.regularizer)));
if (length(ind)==1)
  params.regularizer = valid{ind};
else
  error(['Invalid regularization method: ',params.regularizer])
end

% interp must be one of:
%    'bilinear', 'nearest', or 'triangle'
% but accept any shortening thereof.
valid = {'bilinear', 'nearest', 'triangle'};
if isempty(params.interp)
  params.interp = 'triangle';
end
ind = find(strncmpi(params.interp,valid,length(params.interp)));
if (length(ind)==1)
  params.interp = valid{ind};
else
  error(['Invalid interpolation method: ',params.interp])
end

% solver must be one of:
%    'backslash', '\', 'symmlq', 'lsqr', or 'normal'
% but accept any shortening thereof.
valid = {'backslash', '\', 'symmlq', 'lsqr', 'normal'};
if isempty(params.solver)
  params.solver = '\';
end
ind = find(strncmpi(params.solver,valid,length(params.solver)));
if (length(ind)==1)
  params.solver = valid{ind};
else
  error(['Invalid solver option: ',params.solver])
end

% extend must be one of:
%    'never', 'warning', 'always'
% but accept any shortening thereof.
valid = {'never', 'warning', 'always'};
if isempty(params.extend)
  params.extend = 'warning';
end
ind = find(strncmpi(params.extend,valid,length(params.extend)));
if (length(ind)==1)
  params.extend = valid{ind};
else
  error(['Invalid extend option: ',params.extend])
end

% tilesize == inf by default
if isempty(params.tilesize)
  params.tilesize = inf;
elseif (length(params.tilesize)>1) || (params.tilesize<3)
  error 'Tilesize must be scalar and > 0.'
end

% overlap == 0.20 by default
if isempty(params.overlap)
  params.overlap = 0.20;
elseif (length(params.overlap)>1) || (params.overlap<0) || (params.overlap>0.5)
  error 'Overlap must be scalar and 0 < overlap < 1.'
end

% ============================================
% subfunction - tiled_gridfit
% ============================================
function zgrid=tiled_gridfit(x,y,z,xnodes,ynodes,params)
% tiled_gridfit: a tiled version of gridfit, continuous across tile boundaries
% usage: [zgrid,xgrid,ygrid]=tiled_gridfit(x,y,z,xnodes,ynodes,params)
%
% Tiled_gridfit is used when the total grid is far too large
% to model using a single call to gridfit. While gridfit may take
% only a second or so to build a 100x100 grid, a 2000x2000 grid
% will probably not run at all due to memory problems.
%
% Tiles in the grid with insufficient data (<4 points) will be
% filled with NaNs. Avoid use of too small tiles, especially
% if your data has holes in it that may encompass an entire tile.
%
% A mask may also be applied, in which case tiled_gridfit will
% subdivide the mask into tiles. Note that any boolean mask
% provided is assumed to be the size of the complete grid.
%
% Tiled_gridfit may not be fast on huge grids, but it should run
% as long as you use a reasonable tilesize. 8-)

% Note that we have already verified all parameters in check_params

% Matrix elements in a square tile
tilesize = params.tilesize;
% Size of overlap in terms of matrix elements. Overlaps
% of purely zero cause problems, so force at least two
% elements to overlap.
overlap = max(2,floor(tilesize*params.overlap));

% reset the tilesize for each particular tile to be inf, so
% we will never see a recursive call to tiled_gridfit
Tparams = params;
Tparams.tilesize = inf;

nx = length(xnodes);
ny = length(ynodes);
zgrid = zeros(ny,nx);

% linear ramp for the bilinear interpolation
rampfun = inline('(t-t(1))/(t(end)-t(1))','t');

% loop over each tile in the grid
h = mrvWaitbar(0,'Relax and have a cup of JAVA. Its my treat.');
warncount = 0;
xtind = 1:min(nx,tilesize);
while ~isempty(xtind) && (xtind(1)<=nx)

  xinterp = ones(1,length(xtind));
  if (xtind(1) ~= 1)
    xinterp(1:overlap) = rampfun(xnodes(xtind(1:overlap)));
  end
  if (xtind(end) ~= nx)
    xinterp((end-overlap+1):end) = 1-rampfun(xnodes(xtind((end-overlap+1):end)));
  end

  ytind = 1:min(ny,tilesize);
  while ~isempty(ytind) && (ytind(1)<=ny)
    % update the mrvWaitbar
    mrvWaitbar((xtind(end)-tilesize)/nx + tilesize*ytind(end)/ny/nx)

    yinterp = ones(length(ytind),1);
    if (ytind(1) ~= 1)
      yinterp(1:overlap) = rampfun(ynodes(ytind(1:overlap)));
    end
    if (ytind(end) ~= ny)
      yinterp((end-overlap+1):end) = 1-rampfun(ynodes(ytind((end-overlap+1):end)));
    end

    % was a mask supplied?
    if ~isempty(params.mask)
      submask = params.mask(ytind,xtind);
      Tparams.mask = submask;
    end

    % extract data that lies in this grid tile
    k = (x>=xnodes(xtind(1))) & (x<=xnodes(xtind(end))) & ...
        (y>=ynodes(ytind(1))) & (y<=ynodes(ytind(end)));
    k = find(k);

    if length(k)<4
      if warncount == 0
        warning 'A tile was too underpopulated to model. Filled with NaNs.'
      end
      warncount = warncount + 1;

      % fill this part of the grid with NaNs
      zgrid(ytind,xtind) = NaN;

    else
      % build this tile
      zgtile = gridfit(x(k),y(k),z(k),xnodes(xtind),ynodes(ytind),Tparams);

      % bilinear interpolation (using an outer product)
      interp_coef = yinterp*xinterp;

      % accumulate the tile into the complete grid
      zgrid(ytind,xtind) = zgrid(ytind,xtind) + zgtile.*interp_coef;

    end

    % step to the next tile in y
    if ytind(end)<ny
      ytind = ytind + tilesize - overlap;
      % are we within overlap elements of the edge of the grid?
      if (ytind(end)+max(3,overlap))>=ny
        % extend this tile to the edge
        ytind = ytind(1):ny;
      end
    else
      ytind = ny+1;
    end

  end % while loop over y

  % step to the next tile in x
  if xtind(end)<nx
    xtind = xtind + tilesize - overlap;
    % are we within overlap elements of the edge of the grid?
    if (xtind(end)+max(3,overlap))>=nx
      % extend this tile to the edge
      xtind = xtind(1):nx;
    end
  else
    xtind = nx+1;
  end

end % while loop over x

% close down the mrvWaitbar
close(h)

if warncount>0
  warning([num2str(warncount),' tiles were underpopulated & filled with NaNs'])
end


function det = r8ge_np_det ( n, a_lu )

%*****************************************************************************80
%
%% R8GE_NP_DET computes the determinant of a matrix factored by R8GE_NP_FA.
%
%  Discussion:
%
%    The R8GE storage format is used for a general M by N matrix.  A storage
%    space is made for each logical entry.  The two dimensional logical
%    array is mapped to a vector, in which storage is by columns.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 March 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%    N must be positive.
%
%    Input, real A_LU(N,N), the LU factors from R8GE_NP_FA.
%
%    Output, real DET, the determinant of the matrix.
%
  det = 1.0E+00;

  for i = 1 : n
    det = det * a_lu(i,i);
  end

  return
end


function model = ml_trainlda(varargin)
% Learn a linear predictive model by (regularized) Linear Discriminant Analysis.
% Model = ml_trainlda(Trials, Targets, Lambda, Options...)
%
% LDA is one of the simplest and oldest learning algorithms, originally introduced by Fisher in [1].
% Its basic assumption is that the data originates from two classes (extended to more via 1-vs-1
% voting), where the data in each class is distributed in the feature space according to a normal
% distribution. The shape of the distribution is assumed to be identical for both classes, and the
% relative weight/prior probability of each class is (by default) assumed to be identical, as well.
% An example would be data with features generated as a weighted sum of some latent variables which
% take on different values between conditions (but identical values within each condition), and
% which are superimposed with gaussian noise (which is identically distributed across conditions,
% e.g. from a large sum of independent random variables).
%
% Despite its simplicity, LDA assumes more structure in the data than is usually necessary (namely a
% certain normal distribution per class), and sometimes, more than what can be satisfactorily
% learned from the data, so that, even when the assumptions are fulfilled, the method is not
% guaranteed to give the optimal result. The estimation of the per-class covariance matrix is a
% notoriously data-hungry (and especially outlier-sensitive) step, and the main weakness of standard
% LDA.
%
% ml_trainlda offers three advanced covariance estimators, with different trade-offs to mitigate
% these problems. The variants 'shrinkage' and 'independence' each introduce a regularization
% parameter [2] which controls the complexity of the estimated matrix, and which need to be selected
% in a parameter search (which is orders of magnitude more time-consuming). The 'auto' variant
% computes the degree of regularization analyically in closed form, and is therefore both fast and
% (in some sense) optimal (but more restricted than 'independence') [3]. When enough trials are
% available, full covariance matrices are learned, but the less trials are given, the more the
% covariance estimates degrade to spherical (though well-formed) ones. Auto is the default for lda.
%
% While regularization can automatically control the complexity of a classifier, it is not a panacea
% which allows to add arbitrarily many features, since with each additional feature, the amount of
% structure (here:correlation) that can be captured in the remaining ones gets reduced.
%
% Within the toolbox, LDA is one of the bread-and-butter classifiers, and is worth trying in every
% reasonably simple classification task, especially for its speed. The major problem with LDA
% compared to other available classifiers is that it easier to break it with outliers than, for
% example, support vector machines or logistic regression. Another weakness is that the outputs are
% relatively primitive probability estimates, in contrast to, for example, logistic regression
% (somewhat better) or relevance vector machines (clearly better).
%
% In:
%   Trials       : training data, as in ml_train
%
%   Targets      : target variable, as in ml_train
%
%   Lambda       : optional regularization parameter, reasonable range: 0:0.1:1, greater is stronger
%                  requires that the regularization mode is set to either 'shrinkage' or 'independence' (default: [])
%
%   Options  : optional name-value parameters to control the training details:
%              'regularization' -> 'shrinkage': covariance shrinkage, depends on plambda
%                                  'independence': feature independence, depends on plambda
%                                  'auto': analytical covariance shrinkage, plambda is ignored (default)
%              'weight_bias' -> 0/1, take unequal class priors into account for bias calculation
%                               default: 0
%              'weight_cov' -> 0/1, take unequal class priors into account for covariance calculation
%                              default: 0
% Out:
%   Model   : a linear model; w is the linear weights, b is the bias; classes indicates the class labels which the model predicts
%
% Examples:
%   % learn a standard shrinkage LDA model
%   model = ml_trainlda(trials,targets);
%
%   % take unequal class priors into account for both the bias and the covariance matrix
%   model = ml_trainlda(trials,targets,[],'weight_bias',1,'weight_cov',1);
%
%   % use a different type of regularization, which controls feature independence and requires cross-validation
%   model = utl_searchmodel({trials,target},'args',{{'lda',search(0:0.1:1),'regularization','independence'}})
%
%
% See also:
%   ml_predictlda
%
% References:
%   [1] Fisher, R. "The use of multiple measurements in taxonomic problems."
%       Annals Eugen. 7 (1936), 188, 179.
%   [2] Friedman, J. "Regularized discriminant analysis."
%       Journal of the American Statistical Association 84, 405 (1989), 175, 165.
%   [3] O. Ledoit and M. Wolf, "A well-conditioned estimator for large-dimensional covariance matrices"
%       J Multivar Anal, 88(2): 365-411, 2004.
%
%                           Christian Kothe, Swartz Center for Computational Neuroscience, UCSD
%                           2010-04-03
dp;

arg_define([0 3],varargin, ...
    arg_norep('trials'), ...
    arg_norep('targets'), ...
    arg({'plambda','Lambda','lambda'}, [], [0 1], 'Optional regularization parameter. Reasonable range: 0:0.1:1 - greater is stronger. Requires that the regularization mode is set to either "shrinkage" or "independence" (not necessary in "auto" mode).'), ...
    arg({'regularization','Regularizer','Regularization'}, 'auto', {'none','auto','shrinkage','independence'}, 'Type of regularization. Regularizes the robustness / flexibility of covariance estimates. Auto is analytical covariance shrinkage, shrinkage is shrinkage as selected via plambda, and independence is feature independence, also selected via plambda.'), ...
    arg({'weight_bias','WeightedBias'}, false, [], 'Account for class priors in bias. If you do have unequal probabilities for the different classes, this should be enabled.'), ...
    arg({'weight_cov','WeightedCov'}, false, [], 'Account for class priors in covariance. If you do have unequal probabilities for the different classes, it makes sense to enable this.'), ...
    arg({'robust','Robust'}, false, [], 'Use robust estimation. Uses geometric medians in place of means; can help if some trials are very noisy.'), ...
    arg({'votingScheme','VotingScheme'},'1vR',{'1v1','1vR'},'Voting scheme. If multi-class classification is used, this determine how binary classifiers are arranged to solve the multi-class problem. 1v1 gets slow for large numbers of classes (as all pairs are tested), but can be more accurate than 1vR.'));

% find the class labels
classes = unique(targets);
if length(classes) > 2
    % learn a voting arrangement of models...
    model = ml_trainvote(trials, targets, votingScheme, @ml_trainlda, @ml_predictlda, varargin{:},'weight_bias',true);    %#ok<*NODEF>
elseif length(classes) == 1
    error('BCILAB:only_one_class','Your training data set has no trials for one of your classes; you need at least two classes to train a classifier.\n\nThe most likely reasons are that one of your target markers does not occur in the data, or that all your trials of a particular class are concentrated in a single short segment of your data (10 or 20 percent). The latter would be a problem with the experiment design.');
else
    % pre-prune degenerate features
    retain = true(1,size(trials,2));
    for c = 1:length(classes)
        X = trials(targets==classes(c),:);
        n{c} = size(X,1);
        mu{c} = mean(X,1);
        v{c} = var(X,[],1);
        retain = retain & isfinite(mu{c}) & isfinite(v{c}) & (n{c}==1 | v{c} > eps);
    end
    % apply feature mask...
    trials = trials(:,retain);
    % estimate distribution of each class...
    for c = 1:length(classes)
        lams{c} = NaN;
        X = trials(targets==classes(c),:);
        n{c} = size(X,1);
        if robust
            mu{c} = geometric_median(X);
        else
            mu{c} = mean(X,1);
        end
        if n{c} == 1
            sig{c} = zeros(size(X,2));
        elseif strcmp(regularization,'auto')
            if robust
                % for lack of a better solution in this case we estimate lambda using a non-robust
                % Ledoit-Wolf estimator and then use it in a subsequent robust re-estimation
                [dummy,lams{c}] = cov_shrink(X); %#ok<ASGLU>
                sig{c} = cov_blockgeom(X,1);
                sig{c} = (1-lams{c})*sig{c} + lams{c}*eye(length(sig{c}))*abs(mean(diag(sig{c})));
            else
                [sig{c},lams{c}] = cov_shrink(X);
            end
        else
            if robust
                sig{c} = cov_blockgeom(X,1);
            else
                sig{c} = cov(X);
            end
            if ~isempty(plambda) && ~strcmp(regularization,'none')
                % plambda-dependent regularization
                if strcmp(regularization,'independence')
                    sig{c} = (1-plambda)*sig{c} + plambda * diag(diag(sig{c}));
                elseif strcmp(regularization,'shrinkage')
                    sig{c} = (1-plambda)*sig{c} + plambda*eye(length(sig{c}))*abs(mean(diag(sig{c})));
                else
                    error('unknown regularization mode');
                end
            end
        end
    end

    ns = quickif(weight_cov,n,{1 1});
    nb = quickif(weight_bias,n,{1 1});
    % do the math
    mu_both = (mu{1}*nb{2} + mu{2}*nb{1}) / (nb{1}+nb{2});
    sig_both = (sig{1}*ns{1} + sig{2}*ns{2}) / (ns{1}+ns{2});
    w = (mu{2} - mu{1}) / sig_both;
    w = w / (mu{2}*w' - mu_both*w');
    model = struct('w',{w}, 'b',{mu_both*w'}, 'classes',{classes},'featuremask',{retain},'lams',{lams});
    1;
end


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  In this script, we perform phase transition analysis
%  of Orthogonal matching pursuit.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
close all;
clear all;
clc;
rng('default');
% Create the directory for storing results
[status_code,message,message_id] = mkdir('bin');
target_file_path = 'bin/ra_mmv_phase_transition_snr_20db_s_8.mat';
N = 256;
S = 8;
pta = spx.pursuit.PhaseTransitionAnalysis(N);
pta.SNR = 20;

% options for CoSaMP MMV solver
solver_options.RankAwareResidual = true;
P = 2;

% pta.NumTrials = 100;
dict_model = @(M, N) spx.dict.simple.gaussian_dict(M, N);
data_model = @(N, K) spx.data.synthetic.SparseSignalGenerator(N, K, S).gaussian;
recovery_solver = @(Phi, K, y) spx.pursuit.joint.CoSaMP(Phi, K, P, solver_options).solve(y).Z;
pta.run(dict_model, data_model, recovery_solver);
pta.save_results(target_file_path);


function [samples,gammas,Lambda,joints2D,hists] = DGAnyMarginal(pmfs,Sigma,supports,Nsamples)

% [samples,gammas,Lambda,joints2D,hists] = DGAnyMarginal(pmfs,Sigma,supports,Nsamples)
%   Generates samples from a Multivariate Discretized Gaussian with specified marginals
%   and covariance. Also returns parameters of the fitted DG.
%
%   Inputs:
%     pmfs: the probability mass functions of the marginal distribution of the
%       input-random variables. Must be a cell-array with n elements, each of
%       which is a vector which sums to one
%     Sigma: The covariance matrix of the input-random variable. The function
%       does not check for admissability, i.e. results might be wrong if there
%       exists no random variable which has the specified marginals and
%       covariance.
%     supports: The support of each dimension of the input random variable.
%       Must be a cell-array with n elements, each of whcih is a vector with
%       increasing entries giving the possible values of each random variable,
%       e.g. if the first dimension of the rv is 1 with probability .2, 3 with
%       prob .8, then pmfs{1}=[.2,.8], supports{1}=[1,3]; If empty support is
%       specified, then each is taken to be [0:numel(pdfs{k}-1];
%     Nsamples: The number of samples to be generated.
%
%   Outputs:
%     samples: a matrix of size Nsamples by n, where each row is a sample from
%       the DG.
%     gammas: the discretization thresholds, as described in the paper. When
%       sampling. The k-th dimension of the output random variable is f if e.g.
%       supports{k}(1)=f and gammas{k}(f) <= U(k) <= gammas{k}(f+1)
%     Lambda: the covariance matrix of the latent Gaussian random variable U
%     joints2D: An n by n cell array, where each entry contains the 2
%       dimensional joint distribution of  a pair of dimensions of the DG.
%     hists: the empirical marginals of the samples returned in "samples"
%
%   Usage:
%
% Code from the paper: 'Generating spike-trains with specified
% correlations', Macke et al., submitted to Neural Computation
%
% www.kyb.mpg.de/bethgegroup/code/efficientsampling

[gammas,Lambda,joints2D]=FindDGAnyMarginal(pmfs,Sigma,supports);

[samples,hists]=SampleDGAnyMarginal(gammas,Lambda,supports,Nsamples);

samples = samples';


function [dist, proj] = distancePointEllipse(point, elli)
%DISTANCEPOINTELLIPSE Distance from a point to an ellipse.
%
%   DIST = distancePointEllipse(POINT, ELLI)
%   Computes the Euclidean distance between the point POINT and the ellipse
%   ELLI.
%   POINT may also be a N-by-2 array of point coordinates. In that case the
%   result is a N-by-1 array of distances.
%
%   [DIST, PROJ] = distancePointEllipse(POINT, ELLI)
%   Also return the coordinates of the projection of the point onto the
%   ellipse. PROJ has same dimensions as the array POINT.
%
%   Example
%     % create an ellipse
%     elli = [50 50 40 30 20];
%     % generate points along a regular grid
%     [x, y] = meshgrid(1:100, 1:100);
%     pts = [x(:) y(:)];
%     % compute distance map
%     distMap = reshape(distancePointEllipse(pts, elli), size(x));
%     figure; imshow(distMap, []); colormap parula;
%
%
%   References:
%     https://blog.chatfield.io/simple-method-for-distance-to-ellipse/
%
%   See also
%     ellipses2d, projPointOnEllipse, distancePoints
%

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

proj = projPointOnEllipse(point, elli);

dist = distancePoints(point, proj, 'diag');


function [ fea, out ] = ex_poisson1( varargin )
%EX_POISSON1  1D Poisson equation example.
%
%   [ FEA, OUT ] = EX_POISSON1( VARARGIN ) Poisson equation on a line with a
%   constant source term equal to 1, homogenous boundary conditions, and
%   exact solution (-x^2+x)/2. Accepts the following property/value pairs.
%
%       Input       Value/{Default}        Description
%       -----------------------------------------------------------------------------------
%       hmax        scalar {1/10}          Grid cell size
%       sfun        string {sflag1}        Finite element shape function
%       iphys       scalar 0/{1}           Use physics mode to define problem    (=1)
%                                          or directly define fea.eqn/bdr fields (=0)
%                                          or use core assembly functions        (<0)
%       iplot       scalar 0/{1}           Plot solution (=1)
%                                                                                .
%       Output      Value/(Size)           Description
%       -----------------------------------------------------------------------------------
%       fea         struct                 Problem definition struct
%       out         struct                 Output struct

% Copyright 2013-2022 Precise Simulation, Ltd.

cOptDef = { 'hmax',   1/10;
            'sfun',   'sflag1';
            'refsol', '(-x^2+x)/2';
            'fsrc',   '1';
            'iphys',  1;
            'icub',   2;
            'iplot',  1;
            'tol',    2e-2;
            'fid',    1 };
[got,opt] = parseopt(cOptDef,varargin{:});
fid       = opt.fid;

% Grid generation.
if( opt.hmax>0 )
  nx = round( 1/opt.hmax );
  fea.grid = linegrid( nx, 0, 1 );
else   % Scrambled testing grid.
  fea.grid.p = [ 0 1/10 4/10 1/3 1 1-1/3 ];
  fea.grid.c = [ 1 4 2 6 3 ;
                 2 3 4 5 6 ];
  fea.grid.a = [ 0 2 1 4 3 ;
                 2 4 3 0 5 ];
  fea.grid.b = [ 1 1 1 -1 ;
                 4 2 2  1 ]';
  fea.grid.s = ones(1,5);
end
n_bdr = 2;   % Number of boundaries.

% Problem definition.
fea.sdim  = { 'x' };                    % Coordinate name.
switch opt.iphys

 case 0   % Directly define fea.eqn/bdr fields.

  fea.dvar  = { 'u' };                  % Dependent variable name.
  fea.sfun  = { opt.sfun  };            % Shape function.

  % Define equation system.
  fea.eqn.a.form = { [2;2] };           % First row indicates test function space   (2=x-derivative),
                                        % second row indicates trial function space (2=x-derivative).
  fea.eqn.a.coef = { 1 };               % Coefficient used in assembling stiffness matrix.

  fea.eqn.f.form = { 1 };               % Test function space to evaluate in right hand side (1=function values).
  fea.eqn.f.coef = { opt.fsrc };        % Coefficient used in right hand side.

  % Define boundary conditions.
  if( strcmp(opt.sfun(end-1:end),'H3') )   % Prescribed derivatives at end points for Hermite elements.
    fea.bdr.d = {{ 0 0 ; 1/2 -1/2 }};
  else
    fea.bdr.d     = cell(1,n_bdr);
    [fea.bdr.d{:}] = deal(0);              % Assign zero to all boundaries (homogenous Dirichlet conditions).
  end

  fea.bdr.n     = cell(1,n_bdr);        % No Neumann boundaries ('fea.bdr.n' empty).

  % Parse and solve problem.
  fea       = parseprob(fea);           % Check and parse problem struct.
  fea.sol.u = solvestat(fea,'fid',fid,'icub',opt.icub); % Call to stationary solver.

 case 1   % Use physics mode.

  fea = addphys(fea,@poisson);          % Add Poisson equation physics mode.
  fea.phys.poi.sfun = { opt.sfun };     % Set shape function.
  fea.phys.poi.eqn.coef{3,4} = { opt.fsrc };   % Set source term coefficient.
  fea.phys.poi.bdr.coef{1,end} = repmat({0},1,n_bdr);   % Set Dirichlet boundary coefficient to zero.
  fea = parsephys(fea);                 % Check and parse physics modes.
  if( strcmp(opt.sfun(end-1:end),'H3') )   % Prescribed derivatives at end points for Hermite elements.
    fea.bdr.d = {{ 0 0 ; 1/2 -1/2 }};
  end

  % Parse and solve problem.
  fea       = parseprob(fea);           % Check and parse problem struct.
  fea.sol.u = solvestat(fea,'fid',fid,'icub',opt.icub); % Call to stationary solver.

 otherwise   % Use core assembly functions.

  fea.dvar  = { 'u' };                  % Dependent variable name.
  fea.sfun  = { opt.sfun  };            % Shape function.
  fea       = parseprob(fea);           % Check and parse problem struct.

  % Assemble stiffness matrix.
  form  = [2;2];
  sfun  = {opt.sfun;opt.sfun};
  coefa = 1;
  sind  = 1;
  i_cub = opt.icub;

  [vRowInds,vColInds,vAvals,n_rows,n_cols] = ...
    assemblea(form,sfun,coefa,i_cub,fea.grid.p,fea.grid.c,fea.grid.a,fea.grid.s,[]);
  A = sparse(vRowInds,vColInds,vAvals,n_rows,n_cols);

  % Check and compare with finite difference stencil.
  if (strcmp(opt.sfun,'sflag1'))
    h = 1/nx;
    n = nx+1;
    e = ones(n,1);
    A_ref = 1/h*spdiags([-e 2*e -e], -1:1, n, n);
    A_ref(1) = A_ref(1)/2;
    A_ref(end) = A_ref(end)/2;

    err = norm(A(:)-A_ref(:));
    if err>opt.tol
      out.err  = err;
      out.pass = -1;
      return
    end
  end

  form  = 1;
  sfun  = sfun{1};
  coeff = 1;

  f = assemblef(form,sfun,coeff,i_cub,fea.grid.p,fea.grid.c,fea.grid.a,fea.grid.s,[]);

  % Check and compare with finite difference stencil.
  if (strcmp(opt.sfun,'sflag1'))
    f_ref          = coeff*h*ones(n,1);
    f_ref([1 end]) = coeff*1/2*h;

    err = norm(f-f_ref);
    if err>1e-6
      out.err  = err;
      out.pass = -2;
      return
    end
  end

  % Set homogenous Dirichlet boundary conditions on first and last dof/node.
  bind = [1 nx+1];
  A = A';   %'
  A(:,bind) = 0;         % Zero out Dirichlet BC rows.
  for i=1:length(bind)   % Loop to set diagonal entry to 1.
    i_a = bind(i);
    A(i_a,i_a) = 1;
  end
  A = A';   %'
  f(bind) = 0;           % Set corresponding source term entries to Dirichlet BC values.

  % Solve problem.
  fea.sol.u = A\f;

end

% Postprocessing.
if ( opt.iplot>0 )
  x = linspace( 0, 1, 41 );
  u = evalexpr( 'u', x, fea )';
  figure
  subplot(3,1,1)
  plot( x, u )
  axis( [0 1 0 0.2])
  grid on
  title('Solution u')
  subplot(3,1,2)
  ux = (-x.^2+x)/2;
  plot( x, ux )
  axis( [0 1 0 0.2])
  grid on
  title('Exact solution')
  subplot(3,1,3)
  plot( x, abs(ux-u) )
  title('Error')
end

% Error checking.
xi = [1/2; 1/2];
s_err = ['abs(',opt.refsol,'-u)'];
err = evalexpr0(s_err,xi,1,1:size(fea.grid.c,2),[],fea);
ref = evalexpr0('u',xi,1,1:size(fea.grid.c,2),[],fea);
err = sqrt(sum(err.^2)/sum(ref.^2));

if( ~isempty(fid) )
  fprintf(fid,'\nL2 Error: %e\n',err)
  fprintf(fid,'\n\n')
end

out.err  = err;
out.tol  = opt.tol;
out.pass = out.err<out.tol;
if ( nargout==0 )
  clear fea out
end


function [lambda_vec, error_train, error_val] = ...
    validationCurve(X, y, Xval, yval)
%VALIDATIONCURVE Generate the train and validation errors needed to
%plot a validation curve that we can use to select lambda
%   [lambda_vec, error_train, error_val] = ...
%       VALIDATIONCURVE(X, y, Xval, yval) returns the train
%       and validation errors (in error_train, error_val)
%       for different values of lambda. You are given the training set (X,
%       y) and validation set (Xval, yval).
%

% Selected values of lambda (you should not change this)
lambda_vec = [0 0.001 0.003 0.01 0.03 0.1 0.3 1 3 10]';

% You need to return these variables correctly.
error_train = zeros(length(lambda_vec), 1);
error_val = zeros(length(lambda_vec), 1);

% ====================== YOUR CODE HERE ======================
% Instructions: Fill in this function to return training errors in
%               error_train and the validation errors in error_val. The
%               vector lambda_vec contains the different lambda parameters
%               to use for each calculation of the errors, i.e,
%               error_train(i), and error_val(i) should give
%               you the errors obtained after training with
%               lambda = lambda_vec(i)
%
% Note: You can loop over lambda_vec with the following:
%
%       for i = 1:length(lambda_vec)
%           lambda = lambda_vec(i);
%           % Compute train / val errors when training linear
%           % regression with regularization parameter lambda
%           % You should store the result in error_train(i)
%           % and error_val(i)
%           ....
%
%       end
%
%

for i = 1 : length(lambda_vec),
	lambda = lambda_vec(i);
	[theta] = trainLinearReg(X, y, lambda);
	[error_train(i), grad] = linearRegCostFunction(X, y, theta, 0);
	[error_val(i), grad] = linearRegCostFunction(Xval , yval, theta, 0);
end

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

end


% Copyright (C) 1999 Paul Kienzle <pkienzle@users.sf.net>
% Copyright (C) 2003 Doug Stewart <dastew@sympatico.ca>
% Copyright (C) 2011 Alexander Klein <alexander.klein@math.uni-giessen.de>
%
% This program is free software; you can redistribute it and/or modify it under
% the terms of the GNU General Public License as published by the Free Software
% Foundation; either version 3 of the License, or (at your option) any later
% version.
%
% This program is distributed in the hope that it will be useful, but WITHOUT
% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
% details.
%
% You should have received a copy of the GNU General Public License along with
% this program; if not, see <http://www.gnu.org/licenses/>.

% Generate a butterworth filter.
% Default is a discrete space (Z) filter.
%
% [b,a] = butter(n, Wc)
%    low pass filter with cutoff pi*Wc radians
%
% [b,a] = butter(n, Wc, 'high')
%    high pass filter with cutoff pi*Wc radians
%
% [b,a] = butter(n, [Wl, Wh])
%    band pass filter with edges pi*Wl and pi*Wh radians
%
% [b,a] = butter(n, [Wl, Wh], 'stop')
%    band reject filter with edges pi*Wl and pi*Wh radians
%
% [z,p,g] = butter(...)
%    return filter as zero-pole-gain rather than coefficients of the
%    numerator and denominator polynomials.
%
% [...] = butter(...,'s')
%     return a Laplace space filter, W can be larger than 1.
%
% [a,b,c,d] = butter(...)
%  return  state-space matrices
%
% References:
%
% Proakis & Manolakis (1992). Digital Signal Processing. New York:
% Macmillan Publishing Company.

function [a, b, c, d] = oc_butter (n, W, varargin)

if (nargin>4 || nargin<2) || (nargout>4 || nargout<2)
    print_usage;
end

% interpret the input parameters
if (~(length(n)==1 && n == round(n) && n > 0))
    error ('butter: filter order n must be a positive integer');
end

stop = 0;
digital = 1;
for i=1:length(varargin)
    switch varargin{i}
        case 's', digital = 0;
        case 'z', digital = 1;
        case { 'high', 'stop' }, stop = 1;
        case { 'low',  'pass' }, stop = 0;
        otherwise,  error ('butter: expected [high|stop] or [s|z]');
    end
end

[r, c]=size(W);
if (~(length(W)<=2 && (r==1 || c==1)))
    error ('butter: frequency must be given as w0 or [w0, w1]');
elseif (~(length(W)==1 || length(W) == 2))
    error ('butter: only one filter band allowed');
elseif (length(W)==2 && ~(W(1) < W(2)))
    error ('butter: first band edge must be smaller than second');
end

if ( digital && ~all(W >= 0 & W <= 1))
    error ('butter: critical frequencies must be in (0 1)');
elseif ( ~digital && ~all(W >= 0 ))
    error ('butter: critical frequencies must be in (0 inf)');
end

% Prewarp to the band edges to s plane
if digital
    T = 2;       % sampling frequency of 2 Hz
    W = 2/T*tan(pi*W/T);
end

% Generate splane poles for the prototype butterworth filter
% source: Kuc
C = 1; % default cutoff frequency
pole = C*exp(1i*pi*(2*(1:n) + n - 1)/(2*n));
if mod(n,2) == 1, pole((n+1)/2) = -1; end  % pure real value at exp(i*pi)
zero = [];
gain = C^n;

% splane frequency transform
[zero, pole, gain] = oc_sftrans(zero, pole, gain, W, stop);

% Use bilinear transform to convert poles to the z plane
if digital
    [zero, pole, gain] = oc_bilinear(zero, pole, gain, T);
end

% convert to the correct output form
if nargout==2,
    a = real(gain*poly(zero));
    b = real(poly(pole));
elseif nargout==3,
    a = zero;
    b = pole;
    c = gain;
else
    % output ss results
    % [a, b, c, d] = oc_zp2ss(zero, pole, gain);
    error('Not supported');
end

end


%% Ex. 13 Making a quick plot
x = [0:0.1:20];
y = sin(x);
plot(x,y)

% remaks : Remarks: This only serves as a very quick example of what Matlab can do in making
% plots.The first line is equivalent to x = [0 0.1 0.2 0.3 ... 19.8 19.9 20]. It
% assigns the content of x which is an array of 201 elements. The "0:0.1:20" means the
% 201 numbers are evenly spaced. They start from 0 and end at 20 with an increment of
% 0.1. The second line gives the content of the new array, y, as
 % y = [sin(x(1)) sin(x(2)) sin(x(3)) ... sin(x(200)) sin(x(201))] ,
% or
% y = [sin(0) sin(0.1) sin(0.2) ... sin(19.9) sin(20)] .
% The 3rd line makes a plot of y vs. x.


clearvars;
close all;
% clc;

rng default;

M = 300;
N = 1000;
K = 60;

A = randn(M, N);
x0 = zeros(N,1);

permutation = randperm(N);
indices = permutation(1:K);
% non-zero entries
x0(indices) = randn(K,1);

b0 = A * x0;
% noise variance
sigma = 0.1;
e = sigma * randn(M, 1);
% add noise
b = b0 + e;

% orthonormalize the rows of A
% perform QR decomposition of rows of A
[Q, R] = qr(A', 0);
% keep the orthogonal rows
A = Q';
% change b accordingly to the new coordinates
b = R'\b;

options.verbose = 0;
options.max_iterations = 200;
options.tolerance = 5e-3;
solver = spx.pursuit.single.L1_ADMM_YZ(A, options);
% an upper bound on residual norm
delta = norm(e);
x = solver.solve_bpic(b, delta);

r = x - x0;
max_diff = max(abs(r));
rel_error = norm(x-x0) /norm(x0);
iterations = solver.details.iterations(1);
elapsed_time = solver.details.elapsed_times(1);
fprintf('Iterations: %d, Relative error: %e, max diff: %.4f, time: %.4f seconds\n', ...
    iterations, rel_error, max_diff, elapsed_time);

print = 1;
if print
    subplot(211);
    stem(x0, '.');
    subplot(212);
    stem(x, '.');
    figure;
    iterations = solver.details.iterations(1);
    iters = 1:iterations;
    primal_objectives = solver.details.primal_objectives(iters, 1);
    dual_objectives = solver.details.dual_objectives(iters, 1);
    plot(iters, primal_objectives);
    hold on;
    plot(iters, dual_objectives);
    xlabel('Iterations');
    ylabel('Objective Value');
    legend({'Primal Objective', 'Dual Objective'});
    grid on;
end


function [matrix]=MakeCircle(Diameter,Size,edgewidth);
% MAKECIRCLE - make a circle with hard or soft edgesin a matrix of minimum size
% [matrix]=MakeCircle(Diameter,Size,edgewidth);
% Sizes are in pixels, edgewith > 1 = with of raised cosine function

if nargin < 1,
	help(mfilename);
	return;
end;
if nargin < 2,
	Size=Diameter;
end;
if nargin < 3,
	edgewidth = 0;
end;

% check
if Diameter+edgewidth>Size,
	disp(sprintf('Diameter + edgewidth are larger than Size'));
end;

% Make matrix coordinate system with 0 in center:
coords=-Size/2+.5:Size/2-.5;
[xx,yy]=meshgrid(coords);
dist_from_center = sqrt((xx.*xx)+(yy.*yy));clear xx yy;
fix_circ_calc = find(dist_from_center <= Diameter/2);
if edgewidth,
   edge_calc     = find(dist_from_center >  Diameter/2 & ...
                        dist_from_center <= Diameter/2 + edgewidth);
end;

%Make actual matrix
image_matrix=zeros(Size,Size);
image_matrix(fix_circ_calc)=1;
if edgewidth,
	dist_from_center = cos((dist_from_center-Diameter/2)./(edgewidth).*pi)./2+.5;
	image_matrix(edge_calc)=dist_from_center(edge_calc);
end;

matrix=image_matrix;
%ImageShow(matrix);


function [WMM,VADS] = CalMetric(PopObj,W)
% Calculate the weighted min-max metric and the vector angle distance
% scaling metric between each solution and vector

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

	N  = size(PopObj,1);
    NW = size(W,1);

    %% Normalization
    Zmax   = max(PopObj,[],1);
    Zmin   = min(PopObj,[],1);
    PopObj = (PopObj-repmat(Zmin,N,1))./(repmat(Zmax-Zmin,N,1));
    W      = 1./(W-repmat(Zmin,NW,1)+eps);

    %% Calculate WMM
    WMM = zeros(N,NW);
    for i = 1 : NW
        WMM(:,i)  = max(PopObj.*repmat(W(i,:)./norm(W(i,:)),N,1),[],2);
    end

    %% Calculate VADS
    if nargout > 1
        VADS  = zeros(N,NW);
        NormP = sqrt(sum(PopObj.^2,2));
        for i = 1 : NW
            VADS(:,i) = NormP./(PopObj*W(i,:)'./NormP).^100;
        end
    end
end


function [llh] = tapas_mixedlinear_llh(data, theta, ptheta)
%% Likelihood of the nodes of a linear multivariate model with diagonal
% precisions on each parameter.
%
% It is the likelihood of
%
% p(y|x, beta, pi) = N(y - x*b, 1/pi)
%
% Note that this is a multivariate regression problem, so beta is a matrix
% in which each column correspond to one parameter of the model.
%

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

y = data.y;
u = data.u;

x = data.u.x;
theta = theta.y;

[np, nc] = size(y);

llh = zeros(np, nc);

ln2pi = log(2 * pi);

for j = 1:nc
    % Mean
    beta = theta{j}.mu;
    % Precision
    pe = theta{j}.pe;
    % Regressors

    lpe = log(pe);

    % number of subjects x number of parameters
    py = u.x * beta;
    [ins, inp] = size(py);
    ty = y{j};

    % Residuals
    r = (reshape(ty, inp, ins)' - py);

    % Prediction error
    e = sum(bsxfun(@times, pe, r .* r), 2);

    % This is a vector. For each subject needs to include the precision.
    llh(:, j) = sum(-0.5 * ln2pi +  0.5 * lpe) - 0.5 * e;
end

end


% Count the number of multiple edges in the graph.
%
% INPUT: adjacency matrix, nxn
% OUTPUT: integer, number of multiple edges
%
% Examples: multiEdges([0 2; 2 0])=1, and multiEdges([0 0 1; 2 0 0; 0 1 0])=1
%
% Note 1: The definition of number of multi-arcs/edges (node pairs
%         that have multiple edges across them) here is:
%         mA = length(find(adj>1)); (normalized by 2 if the graph is directed).
%
% Note 2: This creates a natural difference in counting for
% undirected and directed graphs.
%
% Other routines used: isSymmetric.m
% GB: last updated, Sep 26 2014

function mE=multiEdges(adj)

if isSymmetric(adj) % here use "is symmetric" as surrogate for "is directed"
  mE=length(find(adj>1))/2;
else
  mE=length(find(adj>1));
end


function value = identity_condition ( n )

%*****************************************************************************80
%
%% IDENTITY_CONDITION returns the L1 condition of the IDENTITY matrix.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    08 February 2015
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%
%    Output, real VALUE, the L1 condition.
%
  a_norm = 1.0;
  b_norm = 1.0;
  value = a_norm * b_norm;

  return
end


function [ r, seed ] = r8mat_uniform_01 ( m, n, seed )

%*****************************************************************************80
%
%% R8MAT_UNIFORM_01 returns a unit pseudorandom R8MAT.
%
%  Modified:
%
%    21 September 2006
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Paul Bratley, Bennett Fox, Linus Schrage,
%    A Guide to Simulation,
%    Springer Verlag, pages 201-202, 1983.
%
%    Bennett Fox,
%    Algorithm 647:
%    Implementation and Relative Efficiency of Quasirandom
%    Sequence Generators,
%    ACM Transactions on Mathematical Software,
%    Volume 12, Number 4, pages 362-376, 1986.
%
%    Peter Lewis, Allen Goodman, James Miller,
%    A Pseudo-Random Number Generator for the System/360,
%    IBM Systems Journal,
%    Volume 8, pages 136-143, 1969.
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns in the array.
%
%    Input, integer SEED, the integer "seed" used to generate
%    the output random number.
%
%    Output, real R(M,N), an array of random values between 0 and 1.
%
%    Output, integer SEED, the updated seed.  This would
%    normally be used as the input seed on the next call.
%
  if ( seed == 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8MAT_UNIFORM_01 - Fatal error!\n' );
    fprintf ( 1, '  Input SEED = 0!\n' );
    error ( 'R8MAT_UNIFORM_01 - Fatal error!' );
  end

  for j = 1 : n
    for i = 1 : m

      seed = floor ( seed );

      seed = mod ( seed, 2147483647 );

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

      k = floor ( seed / 127773 );

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

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

      r(i,j) = seed * 4.656612875E-10;

    end
  end


function determ = lotkin_determinant ( n )

%*****************************************************************************80
%
%% LOTKIN_DETERMINANT returns the determinant of the LOTKIN matrix.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of A.
%
%    Output, real DETERM, the determinant.
%
  delta = 1.0;

  for i = 2 : n
    delta = - r8_choose ( 2 * i - 2, i - 2 ) * r8_choose ( 2 * i - 2, i - 1 ) ...
      * ( 2 * i - 1 ) * delta;
  end

  determ = 1.0 / delta;

  return
end


function a = dorr_inverse ( alpha, n )

%*****************************************************************************80
%
%% DORR_INVERSE returns the inverse of the DORR matrix.
%
%  Discussion:
%
%    The DORR matrix is a special case of the TRIV matrix.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    28 February 2015
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    CM daFonseca, J Petronilho,
%    Explicit Inverses of Some Tridiagonal Matrices,
%    Linear Algebra and Its Applications,
%    Volume 325, 2001, pages 7-21.
%
%  Parameters:
%
%    Input, real ALPHA, the parameter.
%
%    Input, integer N, the order of the matrix.
%
%    Output, real A(N,N), the inverse of the matrix.
%

%
%  Form the three diagonals.
%
  x = zeros ( n - 1, 1 );
  y = zeros ( n,     1 );
  z = zeros ( n - 1, 1 );

  for i = 1 : n
    for j = 1 : n

      if ( i <= floor ( ( n + 1 ) / 2 ) )

        if ( j == i - 1 )
          x(i-1) = - alpha * ( n + 1 )^2;
        elseif ( j == i )
          y(i) = 2.0 * alpha * ( n + 1 )^2 + 0.5 * ( n + 1 ) - i;
        elseif ( j == i + 1 )
          z(i) = - alpha * ( n + 1 )^2 - 0.5 * ( n + 1 ) + i;
        end

      else

        if ( j == i - 1 )
          x(i-1) = - alpha * ( n + 1 )^2 + 0.5 * ( n + 1 ) - i;
        elseif ( j == i )
          y(i) = 2.0 * alpha * ( n + 1 )^2 - 0.5 * ( n + 1 ) + i;
        elseif ( j == i + 1 )
          z(i) = - alpha * ( n + 1 )^2;
        end

      end

    end
  end
%
%  Now evaluate the inverse.
%
  a = zeros ( n, n );

  d = zeros ( n, 1 );
  e = zeros ( n, 1 );

  d(n) = y(n);
  for i = n - 1 : -1 : 1
    d(i) = y(i) - x(i) * z(i) / d(i+1);
  end

  e(1) = y(1);
  for i = 2 : n
    e(i) = y(i) - x(i-1) * z(i-1) / e(i-1);
  end

  for i = 1 : n
    for j = 1 : i
      a(i,j) = r8_mop ( i + j ) * prod ( x(j:i-1) ) ...
        * prod ( d(i+1:n) ) / prod ( e(j:n) );
    end
    for j = i + 1 : n
      a(i,j) = r8_mop ( i + j ) * prod ( z(i:j-1) ) ...
        * prod ( d(j+1:n) ) / prod ( e(i:n) );
    end
  end

  return
end


function X_rec = recoverData(Z, U, K)
%RECOVERDATA Recovers an approximation of the original data when using the
%projected data
%   X_rec = RECOVERDATA(Z, U, K) recovers an approximation the
%   original data that has been reduced to K dimensions. It returns the
%   approximate reconstruction in X_rec.
%

% You need to return the following variables correctly.
X_rec = zeros(size(Z, 1), size(U, 1));

% ====================== YOUR CODE HERE ======================
% Instructions: Compute the approximation of the data by projecting back
%               onto the original space using the top K eigenvectors in U.
%
%               For the i-th example Z(i,:), the (approximate)
%               recovered data for dimension j is given as follows:
%                    v = Z(i, :)';
%                    recovered_j = v' * U(j, 1:K)';
%
%               Notice that U(j, 1:K) is a row vector.
%

for i = 1 : size(Z, 1),
    for j = 1 : size(U,1),
        v = Z(i, :)';
        rec = v' * U(j, 1 : K)';
        X_rec(i, j) = rec;
    end
end

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

end


function [lambda_vec, error_train, error_val] = ...
    validationCurve(X, y, Xval, yval)
%VALIDATIONCURVE Generate the train and validation errors needed to
%plot a validation curve that we can use to select lambda
%   [lambda_vec, error_train, error_val] = ...
%       VALIDATIONCURVE(X, y, Xval, yval) returns the train
%       and validation errors (in error_train, error_val)
%       for different values of lambda. You are given the training set (X,
%       y) and validation set (Xval, yval).
%

% Selected values of lambda (you should not change this)
lambda_vec = [0 0.001 0.003 0.01 0.03 0.1 0.3 1 3 10]';

% You need to return these variables correctly.
error_train = zeros(length(lambda_vec), 1);
error_val = zeros(length(lambda_vec), 1);

% ====================== YOUR CODE HERE ======================
% Instructions: Fill in this function to return training errors in
%               error_train and the validation errors in error_val. The
%               vector lambda_vec contains the different lambda parameters
%               to use for each calculation of the errors, i.e,
%               error_train(i), and error_val(i) should give
%               you the errors obtained after training with
%               lambda = lambda_vec(i)
%
% Note: You can loop over lambda_vec with the following:
%
%       for i = 1:length(lambda_vec)
%           lambda = lambda_vec(i);
%           % Compute train / val errors when training linear
%           % regression with regularization parameter lambda
%           % You should store the result in error_train(i)
%           % and error_val(i)
%           ....
%
%       end
%
%
for i = 1:length(lambda_vec)
	lambda = lambda_vec(i);
	theta = trainLinearReg(X, y, lambda);
    error_train(i) = linearRegCostFunction(X, y, theta, 0);
	error_val(i) = linearRegCostFunction(Xval,yval,theta,0);
end

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

end


function i4_factorial2_test ( )

%*****************************************************************************80
%
%% I4_FACTORIAL2_TEST tests I4_FACTORIAL2.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 January 2015
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'I4_FACTORIAL2_TEST\n' );
  fprintf ( 1, '  I4_FACTORIAL2 evaluates the double factorial function.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '         N      Exact         I4_FACTORIAL2(N)\n' );

  n_data = 0;

  while ( 1 )

    [ n_data, n, f1 ] = i4_factorial2_values ( n_data );

    if ( n_data == 0 )
      break
    end

    f2 = i4_factorial2 ( n );

    fprintf ( 1, '  %8d  %12d  %12d\n', n, f1, f2 );

  end

  return
end


function tanh_plot ( )

%*****************************************************************************80
%
%% TANH_PLOT makes a plot of certain tanh() functions.
%
%  Discussion:
%
%    The value is +1 if the number is positive or zero, and it is -1 otherwise.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 April 2012
%
%  Author:
%
%    John Burkardt
%
  m = 101;
  x = ( linspace ( -1.0, +1.0, m ) )';

  u = zeros ( m, 6 );
  for j = 0 : 5
    s = 2^j;
    u(:,j+1) = tanh ( s * x(:) / 2.0 ) / ( tanh ( s * -1.0 / 2.0 ) );
  end

  plot ( x, u, 'Linewidth', 3 )
  grid on
  axis ( [-1, +1, -1.1, +1.1 ] )
  xlabel ( '<--- X --->' )
  ylabel ( '<--- U(X) ---> ' )
  title ( 'tanh ( 2^J * x / 2.0 ), J = 0, 1, ..., 5 scaled to be +1 at -1' )

  return
end


function lattice_rule_test06 ( )

%*****************************************************************************80
%
%% LATTICE_RULE_TEST06 tests FIBONACCI_LATTICE_Q3;
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 November 2008
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Ian Sloan, Stephen Joe,
%    Lattice Methods for Multiple Integration,
%    Oxford, 1994.
%
  dim_num = 2;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'LATTICE_RULE_TEST06\n' );
  fprintf ( 1, '  FIBONACCI_LATTICE_Q3 applies a Fibonacci lattice rule\n' );
  fprintf ( 1, '  to integrate a function over the unit square.\n' );
  fprintf ( 1, '  A nonlinear coordinate transformation is applied.\n' );
  fprintf ( 1, '  These Fibonacci rules are only available in 2D.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The spatial dimension DIM_NUM = %d\n', dim_num );

  a(1:dim_num) = 0.0;
  b(1:dim_num) = 1.0;

  exact = e_01_2d ( dim_num, a, b );

  fprintf ( 1, '\n' );
  fprintf ( 1, '         K         M    EXACT       ESTIMATE    ERROR\n' );
  fprintf ( 1, '\n' );

  for k = 3 : 18

    quad = fibonacci_lattice_q3 ( k, @f_01_2d );

    error = abs ( exact - quad );
    m = fibonacci ( k );

    fprintf ( 1, '  %8d  %8d  %10.6f  %10.6f  %10.6e\n', k, m, exact, quad, error );

  end

  return
end