% Tests for chebfun plotting functions.
function pass = test_plot_xylim(pref)

tol = 1e-4;
% Create a figure, and make it invisible. Need to do this a number of time
% throughout the test.
hfig = figure;
set(hfig,'visible','off')
%% Finite functions on unbounded domains

dom1 = [0 pi];
pass1 = [];
x = chebfun(@(x) x, dom1);
plot(x)
pass1(length(pass1) + 1) = ( norm(dom1 - get(gca,'xlim')) < tol);

plot(0.62*sin(x))
yl = get(gca, 'ylim');
pass1(length(pass1) + 1) = ( norm(0.62 - yl(2)) > 0.05);

plot(0.62*[sin(x) 0*x -sin(x)])
yl = get(gca, 'ylim');
pass1(length(pass1) + 1) = ( norm(0.62*[-1 1] - yl) > 0.05);
pass1(length(pass1) + 1) = strcmp(get(gca,'ylimmode'), 'auto');

plot(sin(x))
hold on
plot(-sin(x))
% yl = get(gca,'ylim');
% pass1(length(pass1) + 1) = ( norm(yl - [-1 1]) < tol );
pass1(length(pass1) + 1) = strcmp(get(gca,'ylimmode'), 'auto');
hold off

plot(.62*sin(x))
hold on
plot(-.62*sin(x))
yl = get(gca,'ylim');
pass1(length(pass1) + 1) = (norm(0.62*[-1 1] - yl) > 0.05 );
pass1(length(pass1) + 1) = strcmp(get(gca,'ylimmode'), 'auto');
hold off

%% Unbounded functions

dom2 = [-inf 0];
pass2 = [];
f = chebfun(@(x) exp(x), dom2);
plot(f)
pass2(length(pass2) + 1) =  strcmp(get(gca,'xlimmode'), 'manual');
pass2(length(pass2) + 1) =  strcmp(get(gca,'ylimmode'), 'auto');
xl = get(gca,'xlim');
pass2(length(pass2) + 1)  = ( norm(xl - [-10 0]) < tol );

g = chebfun(@(x) -0.62*exp(x), dom2);
plot(g)
pass2(length(pass2) + 1) =  strcmp(get(gca,'ylimmode'), 'auto');
yl = get(gca,'ylim');
pass2(length(pass2) + 1)  = ( norm(yl(1) - 0.62) > 0.05 );

dom3 = [-20 20];
h = chebfun(@(x) cos(x), dom3);
hold on
plot(h,'r')
xl = get(gca,'xlim');
pass2(length(pass2) + 1) = ( norm(xl - dom3) < tol );
hold off

plot(h,'g')
hold on
plot(g)
xl = get(gca,'xlim');
pass2(length(pass2) + 1)  = ( norm(xl - dom3) < tol );
hold off

dom4 = [-2 2];
h = chebfun(@(x) cos(x), dom4);
plot(g)
hold on
plot(h,'r')
xl = get(gca,'xlim');
pass2(length(pass2) + 1) = ( norm(xl - [-10 2]) < tol );
hold off

plot(h,'g')
hold on
plot(g)
xl = get(gca,'xlim');
pass2(length(pass2) + 1)  = ( norm(xl - [-10 2]) < tol );
hold off
%% Functions that blow-up
pass3 = [];
f1 = 11.3*sin(x);
f2 = 1./x;

plot(f2)
pass3(length(pass3) + 1) =  strcmp(get(gca,'xlimmode'), 'manual');
pass3(length(pass3) + 1) =  strcmp(get(gca,'ylimmode'), 'manual');
xl = get(gca, 'xlim');
yl = get(gca, 'ylim');
% Check that we obtain reasonable ylimits
pass3(length(pass3) + 1)  = ( norm(yl(1) - 1/xl(2)) < tol && ( yl(2) < 10 ) );
hold on
plot(f1,'r')
% Check that we obtain reasonable ylimits
yl = get(gca, 'ylim');
pass3(length(pass3) + 1)  = ( norm(yl(1)) < tol && ( yl(2) > 10 ) );
hold off

% Do the plotting in reverse order
plot(f1,'g')
ylOld = get(gca, 'ylim');
hold on
plot(f2)
% Check that we obtain reasonable ylimits
ylNew = get(gca, 'ylim');
pass3(length(pass3) + 1) = ( (norm(ylOld(1) - ylNew(1)) < tol) && ...
    (ylNew(2) > 10) );
hold off

% Check x-lim and y-lim symmetry of x:
f = chebfun(@(x) x, [-inf inf]);
plot(f)
xl = get(gca, 'xlim');
yl = get(gca, 'ylim');
pass3(length(pass3) + 1) = (abs(sum(xl)) < 1e-10) && (abs(sum(yl)) < 1e-10);

%%
pass = [pass1, pass2, pass3];

close(hfig);


%% polyTube
% Below is a demonstration of the features of the |polyTube| function

%%
clear; close all; clc;

%% Syntax
% |[Fs,Vs,Cs,Cs_rgb,Cs_d]=polyTube(Vg,optStruct);|

%% Description
% The polyTube function can be used to
%% Examples

%%
% Plot settings
markerSize=15;
lineWidth=2;
fontSize=10;

%% Example 1: Creating a swept tube

%%
% Creating example curve

t=linspace(0,4*pi,50);
Vg=[ t(:) sin(t(:)) cos(t(:))];
Vg=evenlySampleCurve(Vg);

%%
% Create tube
clear optStruct
optStruct.r=1.2; %Radius
optStruct.nr=25; %Number of points allong circumference
optStruct.patchType='quad'; %Output mesh type
optStruct.fixOpt=0; %Option to fix self intersection

[Fs,Vs,Cs]=polyTube(Vg,optStruct);

%%
% Visualization

cFigure;
subplot(1,2,1); hold on;
hp1=plotV(Vg,'k.-','MarkerSize',markerSize,'LineWidth',lineWidth);
axisGeom;

subplot(1,2,2); hold on;
hp2=gpatch(Fs,Vs,Cs,'k',1,1);
axisGeom; camlight headlight;

legend([hp1 hp2],{'Guide curve','Tube'});
gdrawnow;

%% Example 2: Variable radius

%%
% Creating example curve

t=linspace(0,1.5*pi,50);
r=linspace(0.25,1,50)'; %Defining radius allong curve
Vg=[t(:) zeros(size(t(:))) sin(t(:))];
Vg=evenlySampleCurve(Vg);

%%
% Create tube
clear optStruct
optStruct.r=r; %Radius
optStruct.nr=25; %Number of points allong circumference
optStruct.patchType='quad'; %Output mesh type
optStruct.fixOpt=0; %Option to fix self intersection

[Fs,Vs,Cs]=polyTube(Vg,optStruct);

%%
% Visualization

cFigure; hold on;
title('Variable radius');
gpatch(Fs,Vs,Cs,'k',1,1);
axisGeom; camlight headlight;
gdrawnow;

%% Example 3: Triangulated surface output and closed ends

%%
% Creating example curve

r=linspace(0.25,1,30)'; %Defining radius allong curve
t=linspace(0,pi,30);
Vg=[t(:) zeros(size(t(:))) -2*sin(t(:))];
Vg=evenlySampleCurve(Vg);

%%
% Create tube with open ends
clear optStruct
optStruct.r=1;
optStruct.nr=25;
optStruct.patchType='tri';
optStruct.closeOpt=0;
[Fs1,Vs1,Cs1]=polyTube(Vg,optStruct);

%%
% Create tube with closed ends
clear optStruct
optStruct.r=1;
optStruct.nr=25;
optStruct.patchType='tri';
optStruct.closeOpt=1;
[Fs2,Vs2,Cs2]=polyTube(Vg,optStruct);

%%
% Visualization

cFigure;
subplot(1,2,1); hold on;
title('Open tube')
gpatch(Fs1,Vs1,Cs1,'k',1,1);
axisGeom; camlight headlight;

subplot(1,2,2); hold on;
title('Closed tube')
gpatch(Fs2,Vs2,Cs2,'k',1,1);
axisGeom; camlight headlight;

gdrawnow;

%% Example 4: Using the fix option to attempt to fix self intersections

%%
% Creating example curve
t=linspace(0,pi,30);
Vg=[t(:) 2*sin(t(:)) zeros(size(t(:))) ];
Vg=evenlySampleCurve(Vg);

%%
% Create tube without self-intersection fix
clear optStruct
optStruct.r=1.2;
optStruct.nr=25;
optStruct.patchType='quad';
optStruct.fixOpt=0;
[Fs1,Vs1,Cs1]=polyTube(Vg,optStruct);

%%
% Create tube with self-intersection fix
clear optStruct
optStruct.r=1.2;
optStruct.nr=25;
optStruct.patchType='quad';
optStruct.fixOpt=1;
[Fs2,Vs2,Cs2]=polyTube(Vg,optStruct);

%%
% Visualization

cFigure;
subplot(1,2,1); hold on;
title('Self intersecting tube')
gpatch(Fs1,Vs1,'rw','k',0.5,2);
axisGeom; camlight headlight;
view(2);

subplot(1,2,2); hold on;
title('Fixed tube')
gpatch(Fs2,Vs2,'gw','k',1,2);
axisGeom; camlight headlight;
view(2);

gdrawnow;

%%
%
% <<gibbVerySmall.gif>>
%
% _*GIBBON*_
% <www.gibboncode.org>
%
% _Kevin Mattheus Moerman_, <gibbon.toolbox@gmail.com>

%%
% _*GIBBON footer text*_
%
% License: <https://github.com/gibbonCode/GIBBON/blob/master/LICENSE>
%
% GIBBON: The Geometry and Image-based Bioengineering add-On. A toolbox for
% image segmentation, image-based modeling, meshing, and finite element
% analysis.
%
% Copyright (C) 2006-2020 Kevin Mattheus Moerman
%
% 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/>.
%%
% _*GIBBON footer text*_
%
% License: <https://github.com/gibbonCode/GIBBON/blob/master/LICENSE>
%
% GIBBON: The Geometry and Image-based Bioengineering add-On. A toolbox for
% image segmentation, image-based modeling, meshing, and finite element
% analysis.
%
% Copyright (C) 2006-2022 Kevin Mattheus Moerman and the GIBBON contributors
%
% 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/>.


function varargout = fillPolygon3d(varargin)
%FILLPOLYGON3D Fill a 3D polygon specified by a list of vertex coords.
%
%   fillPolygon3d(COORD, COLOR)
%   packs coordinates in a single [N*3] array.
%   COORD can also be a cell array of polygon, in this case each polygon is
%   drawn using the same color.
%
%   fillPolygon3d(PX, PY, PZ, COLOR)
%   specifies coordinates in separate numeric vectors (either row or
%   columns)
%
%   fillPolygon3d(..., PARAM, VALUE)
%   allows to specify some drawing parameter/value pairs as for the plot
%   function.
%
%   H = fillPolygon3d(...)
%   also returns a handle to the list of created patch objects.
%
%   Example
%     t = linspace(0, 2*pi, 100)';
%     xt = 10 * cos(t);
%     yt = 5 * sin(t);
%     zt = zeros(100,1);
%     poly = [xt yt zt];
%     figure; hold on; axis equal; fillPolygon3d(poly, 'c');
%     drawPolygon3d(poly, 'linewidth', 2, 'color', 'k');
%
%   See also
%   polygons3d, drawPolygon3d, drawPolyline3d
%

% ------
% Author: David Legland
% E-mail: david.legland@inrae.fr
% Created: 2007-01-05
% Copyright 2007-2022 INRA - BIA PV Nantes - MIAJ Jouy-en-Josas

% Check if axes handle is specified
if isAxisHandle(varargin{1})
    hAx = varargin{1};
    varargin(1) = [];
else
    hAx = gca;
end

% check case we want to draw several curves, stored in a cell array
var1 = varargin{1};
if iscell(var1)
    hold on;
    h = [];
    for i = 1:length(var1(:))
        h = [h; fillPolygon3d(hAx, var1{i}, varargin{2:end})]; %#ok<AGROW>
    end
    if nargout>0
        varargout{1}=h;
    end
    return;
end

% extract vertex coordinates
if min(size(var1)) == 1
    % if first argument is a vector (either row or column), then assumes
    % first argument contains x coords, second argument contains y coords
    % and third one the z coords
    px = var1;
    if length(varargin) < 3
        error('geom3d:fillPolygon3d:Wrong number of arguments in fillPolygon3d');
    end
    py = varargin{2};
    pz = varargin{3};
    varargin = varargin(4:end);
else
    % first argument contains all three coordinates
    px = var1(:, 1);
    py = var1(:, 2);
    pz = var1(:, 3);
    varargin = varargin(2:end);
end

% extract color information
if isempty(varargin)
    color = 'c';
else
    color = varargin{1};
    varargin = varargin(2:end);
end

% fill the polygon
h = fill3(hAx, px, py, pz, color, varargin{:});

if nargout>0
    varargout{1}=h;
end


% Test file for chebtech/real.m

function pass = test_real(pref)

if ( nargin < 1 )
    pref = chebtech.techPref();
end

for n = 1:2
    if ( n == 1 )
        testclass = chebtech1();
    else
        testclass = chebtech2();
    end

    % Test a scalar-valued function:
    f = testclass.make(@(x) exp(1i*x) + 1i*sin(x), [], pref);
    g = testclass.make(@(x) cos(x), [], pref);
    h = real(f);
    pass(n, 1) = norm(h.coeffs - g.coeffs, inf) < 10*vscale(h)*eps;

    % Test an array-valued function:
    f = testclass.make(@(x) [exp(1i*x) + 1i*sin(x), -exp(1i*x)], [], pref);
    g = testclass.make(@(x) [cos(x), -real(exp(1i*x))], [], pref);
    h = real(f);
    pass(n, 2) = norm(h.coeffs - g.coeffs, inf) < 10*max(vscale(h)*eps);

    % Test a real function:
    f = testclass.make(@(x) 1i*cos(x), [], pref);
    g = real(f);
    pass(n, 3) = numel(g.coeffs) == 1 && g.coeffs == 0;

    % Test an array-valued real function:
    f = testclass.make(@(x) 1i*[cos(x), sin(x), exp(x)], [], pref);
    g = real(f);
    pass(n, 4) = all(size(g.coeffs) == [1, 3]) && all(g.coeffs == 0);
end

end


function [ X ] = special_add_se3( X,S )

    s_theta=S(1:3);
    s_p=S(4:6);

    sizeS=size(S,1);
    NumberOfLandmarks=(sizeS-6)/3;

    Exps=so3_exp(s_theta);

    X.position= Exps*X.position+jaco_r(-s_theta)*s_p;

    if NumberOfLandmarks>=1
        s_landmarksMatrix=reshape(S(7:end),3,NumberOfLandmarks);
        X.landmarks(1:3,:)=X.landmarks(1:3,:)+s_landmarksMatrix;
    end

    X.orientation=Exps*X.orientation;

end


% OP_KL_SHELLS: assemble the Kirchhoff-Love stiffness matrix K.
%
%   mat = op_KL_shells (spu, spv, msh, E_coeff, nu_coeff, t_coeff);
%
% INPUT:
%
%  spu:   structure representing the space of trial functions (see sp_vector/sp_evaluate_col)
%  spv:   structure representing the space of test functions  (see sp_vector/sp_evaluate_col)
%  msh:   structure containing the domain partition and the quadrature rule (see msh_cartesian/msh_evaluate_col)
%  E_coeff:  coefficients for the Young's modulus
%  nu_coeff: coefficients for the Poisson's ratio
%  t_coeff:  thickness of the shell
%
% OUTPUT:
%
%  mat:    assembled stiffness matrix
%
% Copyright (C) 2018, 2019 Pablo Antolin, Luca Coradello
%
%    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/>.

function mat = op_KL_shells (ref_sp_u, ref_sp_v, msh, E_coeff, nu_coeff, t_coeff)

   wq = msh.jacdet .* msh.quad_weights;

   [bending_stress, Kappa] = op_KL_bending_stress (ref_sp_u, ref_sp_v, msh, E_coeff .* wq, nu_coeff, t_coeff);
   [membrane_stress, Epsilon] = op_KL_membrane_stress (ref_sp_u, ref_sp_v, msh, E_coeff .* wq, nu_coeff, t_coeff);

   bending_stress = reshape(bending_stress, [], msh.nqn, ref_sp_u.nsh_max, msh.nel);
   membrane_stress = reshape(membrane_stress, [], msh.nqn, ref_sp_u.nsh_max, msh.nel);

   Kappa = reshape(Kappa, [], msh.nqn, ref_sp_v.nsh_max, msh.nel);
   Epsilon = reshape(Epsilon, [], msh.nqn, ref_sp_v.nsh_max, msh.nel);

   rows = zeros (msh.nel * ref_sp_u.nsh_max * ref_sp_v.nsh_max, 1);
   cols = zeros (msh.nel * ref_sp_u.nsh_max * ref_sp_v.nsh_max, 1);
   values = zeros (msh.nel * ref_sp_u.nsh_max * ref_sp_v.nsh_max, 1);

   ncounter = 0;

   for iel = 1:msh.nel
     if (all (msh.jacdet(:,iel)))

       ndof_u = ref_sp_u.nsh_max;
       ndof_v = ref_sp_v.nsh_max;

       bending_stress_iel = reshape(bending_stress (:, :, :, iel), [], msh.nqn, 1, ndof_u);
       membrane_stress_iel = reshape(membrane_stress (:, :, :, iel), [], msh.nqn, 1, ndof_u);

       Kappa_iel = reshape(Kappa (:, :, :, iel), [], msh.nqn, ndof_v, 1);
       Epsilon_iel = reshape(Epsilon (:, :, :, iel), [], msh.nqn, ndof_v, 1);

       tmp1 = sum (bsxfun (@times, bending_stress_iel, Kappa_iel), 1);
       tmp2 = sum (bsxfun (@times, membrane_stress_iel, Epsilon_iel), 1);

       elementary_values =   reshape (sum (tmp1, 2), ndof_v, ndof_u) + ...
                            reshape (sum (tmp2, 2), ndof_v, ndof_u);
       [rows_loc, cols_loc] = ndgrid (ref_sp_v.connectivity(:,iel), ref_sp_u.connectivity(:,iel));
       indices = rows_loc & cols_loc;
       rows(ncounter+(1:ref_sp_u.nsh(iel)*ref_sp_v.nsh(iel))) = rows_loc(indices);
       cols(ncounter+(1:ref_sp_u.nsh(iel)*ref_sp_v.nsh(iel))) = cols_loc(indices);
       values(ncounter+(1:ref_sp_u.nsh(iel)*ref_sp_v.nsh(iel))) = elementary_values(indices);
       ncounter = ncounter + ref_sp_u.nsh(iel)*ref_sp_v.nsh(iel);

%%%%%%%%%%%%%%%% old version, works when test and trial space are the same
%        % Here, the loops over the two sets of functions and the loop over the quadrature points are
%        % vectorized into a single operation.
%        ndof = ref_sp_u.nsh_max;
%        mat(ref_sp_v.connectivity(:, iel), ref_sp_u.connectivity(:, iel)) = ...
%            mat(ref_sp_v.connectivity(:, iel), ref_sp_u.connectivity(:, iel)) ...
%            + reshape(sum(sum(sum(repmat(bending_stress (:, :, :, :, iel), [1, 1, 1, 1, ndof]) ...
%                            .* permute(repmat(Kappa (:, :, :, :, iel), [1, 1, 1, 1, ndof]), [1, 2, 3, 5, 4])))) ...
%                  + sum(sum(sum(repmat(membrane_stress (:, :, :, :, iel), [1, 1, 1, 1, ndof]) ...
%                            .* permute(repmat(Epsilon (:, :, :, :, iel), [1, 1, 1, 1, ndof]), [1, 2, 3, 5, 4])))), [ndof, ndof]);

     else
       warning ('geopdes:jacdet_zero_at_quad_node',...
           'op_KL: singular map in element number %d', iel)
     end
   end
   mat = sparse (rows(1:ncounter), cols(1:ncounter), ...
                           values(1:ncounter), ref_sp_v.ndof, ref_sp_u.ndof);
end


function P = spm_imatrix(M)
% returns the parameters for creating an affine transformation
% FORMAT P = spm_imatrix(M)
% M      - Affine transformation matrix
% P      - Parameters (see spm_matrix for definitions)
%___________________________________________________________________________
% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging

% John Ashburner & Stefan Kiebel
% $Id$

% Translations and zooms
%-----------------------------------------------------------------------
R         = M(1:3,1:3);
C         = chol(R'*R);
P         = [M(1:3,4)' 0 0 0  diag(C)'  0 0 0];
if det(R)<0, P(7)=-P(7);end % Fix for -ve determinants

% Shears
%-----------------------------------------------------------------------
C         = diag(diag(C))\C;
P(10:12)  = C([4 7 8]);
R0        = spm_matrix([0 0 0  0 0 0 P(7:12)]);
R0        = R0(1:3,1:3);
R1        = R/R0;

% This just leaves rotations in matrix R1
%-----------------------------------------------------------------------
%[          c5*c6,           c5*s6, s5]
%[-s4*s5*c6-c4*s6, -s4*s5*s6+c4*c6, s4*c5]
%[-c4*s5*c6+s4*s6, -c4*s5*s6-s4*c6, c4*c5]

P(5) = asin(rang(R1(1,3)));
if (abs(P(5))-pi/2)^2 < 1e-9,
    P(4) = 0;
    P(6) = atan2(-rang(R1(2,1)), rang(-R1(3,1)/R1(1,3)));
else
    c    = cos(P(5));
    P(4) = atan2(rang(R1(2,3)/c), rang(R1(3,3)/c));
    P(6) = atan2(rang(R1(1,2)/c), rang(R1(1,1)/c));
end;
return;

% There may be slight rounding errors making b>1 or b<-1.
function a = rang(b)
a = min(max(b, -1), 1);
return;


function varargout = grad( f )
%GRAD   Numerical gradient of a SEPARABLEAPPROX.
%   [FX FY] = GRAD(F) returns the numerical gradient of the SEPARABLEAPPROX F, where FX
%   is the derivative of F in the x direction and FY is the derivative of F in
%   the y direction. Both derivatives are returned as SEPARABLEAPPROX objects.
%
%   G = GRAD(F) returns a CHEBFUN2V which represents
%
%            G = (F_x ; F_y )
%
%  This command is shorthand for GRADIENT(F).
%
% See also GRADIENT.

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

% Call GRADIENT:
if ( nargout <= 1 )
    out = gradient( f );
    varargout = { out };
else
    [fx, fy] = gradient( f );
    varargout = {fx, fy};
end

end


function x = ProxLP(y,p,tau)

if length(y(:))>1
    for i=1:length(y(:))
        x(i)=ProxLP(y(i),p,tau);
    end
    x = reshape(x,size(y));
    return
end

x = linspace(0,abs(y)*1.1,200);
[~,i] = min( 1/2*(x-abs(y)).^2 + tau*abs(x).^p );
x = x*sign(x(i));

end


classdef AffineGridGenerator < dagnn.Layer
%DAGNN.AFFINEGRIDGENERATIOR  Generate an affine grid for bilinear resampling
%   This layer maps 1 x 1 x 6 x N affine transforms to 2 x Ho x Wo x N
%   sampling grids compatible with dagnn.BlilinearSampler.

% (c) 2016 Ankush Gupta

 properties
     Ho = 0;
     Wo = 0;
 end

  properties (Transient)
    % the grid (normalized \in [-1,1]) --> this is cached
    % has the size: [HoWo x 2]
    xxyy ;
  end

  methods
    function outputs = forward(obj, inputs, ~)
      % input is a 1x1x6xN TENSOR corresponding to:
      % [ c1 c2 c5 ]
      % [ c3 c4 c6 ]
      % [  0  0  1 ]
      % i.e., [d1] = [c1 c2]  * [d1] + [c5]
      %       [d2]   [c3 c4]    [d2]   [c6]
      % where, di is the i-th dimension.
      %
      % OUTPUT is a 2xHoxWoxN grid which corresponds to applying
      % the above affine transform to the [-1,1] normalized x,y
      % coordinates.

      %fprintf('affineGridGenerator forward\n');
      useGPU = isa(inputs{1}, 'gpuArray');

      % reshape the tfm params into matrices:
      A = inputs{1};
      nbatch = size(A,4);
      A = reshape(A, 2,3,nbatch);
      L = A(:,1:2,:);
      L = reshape(L,2,2*nbatch); % linear part

      % generate the grid coordinates:
      if isempty(obj.xxyy)
        obj.initGrid(useGPU);
      end

      % transform the grid:
      t = A(:,3,:); % translation
      t = reshape(t,1,2*nbatch);
      g = bsxfun(@plus, obj.xxyy * L, t); % apply the transform
      g = reshape(g, obj.Wo,obj.Ho,2,nbatch);

      % cudnn compatibility:
      g = permute(g, [3,2,1,4]);

      outputs = {g};
    end

    function [derInputs, derParams] = backward(obj, inputs, ~, derOutputs)

      useGPU = isa(derOutputs{1}, 'gpuArray');
      dY = derOutputs{1};
      nbatch = size(dY,4);

      % cudnn compatibility:
      dY = permute(dY, [3,2,1,4]);

      % create the gradient buffer:
      dA = zeros([2,3,nbatch], 'single');
      if useGPU, dA = gpuArray(dA); end

      dY = reshape(dY, obj.Ho*obj.Wo, 2*nbatch);
      % gradient wrt the linear part:
      dL = obj.xxyy' * dY;
      dL = reshape(dL,2,2,nbatch);
      dA(:,1:2,:) = dL;

      % gradient wrt translation (or bias):
      dt = reshape(sum(dY,1),2,1,nbatch);
      dA(:,3,:) = dt;

      dA = reshape(dA, size(inputs{1}));
      derInputs = {dA};
      derParams = {};
    end

    function outputSizes = getOutputSizes(obj, inputSizes)
      nBatch = inputSizes{1}(4);
      outputSizes = {[2, obj.Ho, obj.Wo, nBatch]};
    end

    function obj = AffineGridGenerator(varargin)
      obj.load(varargin) ;
      % get the output sizes:
      obj.Ho = obj.Ho ;
      obj.Wo = obj.Wo ;
      obj.xxyy = [] ;
    end

    function obj = reset(obj)
      reset@dagnn.Layer(obj) ;
      obj.xxyy = [] ;
    end

    function initGrid(obj, useGPU)
      % initialize the grid:
      % this is a constant
      xi = linspace(-1, 1, obj.Ho);
      yi = linspace(-1, 1, obj.Wo);

      [yy,xx] = meshgrid(xi,yi);
      xxyy = [yy(:), xx(:)] ; % Mx2
      if useGPU
        xxyy = gpuArray(xxyy);
      end
      obj.xxyy = xxyy ;
    end

  end
end


function [mm] = ly2mm(ly)
% Convert length from light years to millimeters.
% Chad A. Greene 2012
mm = ly*9460730472581000000;


% Reference performance
accTestRef = 0.9866;
allowedError = 0.001;
method = 'HPOLD';

% Create the algorithm object
algorithmObj = HPOLD();

% Clear parameter struct
clear param;

% Parameter C (Cost)
param.C = 10;

param.k = 10;

% Run the algorithm
info = algorithmObj.fitpredict(train,test,param);

trainCM = confusionmat(info.predictedTrain,train.targets);
testCM = confusionmat(info.predictedTest,test.targets);

accTrain = CCR.calculateMetric(trainCM);
accTest  = CCR.calculateMetric(testCM);

% Report accuracy
fprintf('Performing test for %s\n', method);
fprintf('Accuracy Train %f, Accuracy Test %f\n',accTrain,accTest);

if abs(accTestRef-accTest)<allowedError
    fprintf('Test accuracy matches reference accuracy\n');
else
    warning('Test accuracy does NOT match reference accuracy');
end


classdef CEC2010_F7 < PROBLEM
% <single> <real> <constrained>
% CEC'2010 constrained optimization benchmark problem

%------------------------------- Reference --------------------------------
% R. Mallipeddi and P. N. Suganthan, Problem definitions and evaluation
% criteria for the CEC 2010 competition on constrained real-parameter
% optimization, Nanyang Technological University, Singapore, 2010.
%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    properties
        O;  % Optimal decision vector
    end
    methods
        %% Default settings of the problem
        function Setting(obj)
            CallStack = dbstack('-completenames');
            load(fullfile(fileparts(CallStack(1).file),'CEC2010.mat'),'Data');
            obj.O = Data{7};
            obj.M = 1;
            if isempty(obj.D); obj.D = 10; end
            obj.D = min(obj.D,length(obj.O));
            obj.lower    = zeros(1,obj.D) - 140;
            obj.upper    = zeros(1,obj.D) + 140;
            obj.encoding = ones(1,obj.D);
        end
        %% Calculate objective values
        function PopObj = CalObj(obj,PopDec)
            Z = 1 + PopDec - repmat(obj.O(1:size(PopDec,2)),size(PopDec,1),1);
            PopObj = sum(100*(Z(:,1:end-1).^2-Z(:,2:end)).^2+(Z(:,1:end-1)-1).^2,2);
        end
        %% Calculate constraint violations
        function PopCon = CalCon(obj,PopDec)
            Y = PopDec - repmat(obj.O(1:size(PopDec,2)),size(PopDec,1),1);
            PopCon = 0.5 - exp(-0.1*sqrt(mean(Y.^2,2))) - 3*exp(mean(cos(0.1*Y),2)) + exp(1);
        end
    end
end


function test_ft_appendspike

% MEM 2gb
% WALLTIME 00:10:00
% DEPENDENCY ft_appendspike

spike = [];
spike.label = {'unit1'  'unit2'  'unit3'};
spike.timestamp = {linspace(0,100,100) linspace(0,200,200) linspace(0,300,300)};
spike.trial = {randn(1,100) randn(1,200) randn(1,300)};
spike.trialtime = [linspace(0,30,300)', linspace(0,30,300)'+0.5];

spike2 = spike;
spike.label = {'unit12'  'unit22'  'unit32'};
spike2.trial = {randn(1,100) randn(1,200) randn(1,300)};

cfg = [];
cfg.trl = spike.trialtime;
spikeout = ft_appendspike(cfg,spike,spike2);


classdef HPOLD < Algorithm
    %HPOLD Hierarchical Partial Order Label Decomposition performs partial
    %order classification with a hierarchical model [1]. Class 1 versus the
    %rest is first classified with a binary model and the remainder labels
    %(2,3,...,Q) with an ordinal model. The available methods are logistic
    %regression and suport vector machine. For additional details see [1].
    %
    %   SVR methods:
    %      fitpredict               - runs the corresponding algorithm,
    %                                   fitting the model and testing it in a dataset.
    %      fit                        - Fits a model from training data
    %      predict                    - Performs label prediction
    %
    %   References:
    %     [1] J. Sánchez-Monedero, M. Pérez-Ortiz, A. Sáez, P.A. Gutiérrez,
    %         and C. Hervás-Martínez. "Partial order label decomposition
    %         approaches for melanoma diagnosis". Applied Soft Computing.
    %         Volume 64, March 2018, Pages 341-355.
    %         https://doi.org/10.1016/j.asoc.2017.11.042
    %
    %   This file is part of ORCA: https://github.com/ayrna/orca
    %   Original authors: Pedro Antonio Gutiérrez, María Pérez Ortiz, Javier Sánchez Monedero
    %   Citation: If you use this code, please cite the associated paper http://www.uco.es/grupos/ayrna/orreview
    %   Copyright:
    %       This software is released under the The GNU General Public License v3.0 licence
    %       available at http://www.gnu.org/licenses/gpl-3.0.html
    properties
        description = 'Hierarchical Partial Order Label Decomposition';
        %C penalty coefficient and the kernel parameters (both for the binary
        %and ordinal methods).
        parameters = struct('C', 0.1, 'k', 0.1);
        binaryMethod = 'SVC1V1';
        ordinalMethod = 'SVORIM';
    end
    properties(Access = private)
        objBI;
        objOR;
    end

    methods

        % TODO: update doc
        function obj = HPOLD(varargin)
            %HPOLD constructs an object of the class HPOLD and sets its default
            %   characteristics
            %   OBJ = HPOLD() builds HPOLD
            obj.parseArgs(varargin);
        end

        function [projectedTrain, predictedTrain] = privfit( obj, train, param)
            %PRIVFIT trains the model for the HPOLD method with TRAIN data and
            %vector of parameters PARAM.

            projectedTrain = -1*ones(length(train.targets),1);% dummy value
            predictedTrain = -1*ones(length(train.targets),1);% dummy value

            % Create binary dataset
            trainTargetsBi = ones(size(train.targets));
            trainTargetsBi(train.targets~=1)=2;

            trainBi.patterns = train.patterns;
            trainBi.targets = trainTargetsBi;

            % Create ordinal dataset by removing class obj.binClass patterns
            % and relabelling the rest of the labels
            trainOr.patterns = train.patterns(train.targets~=1,:);
            trainOr.targets = train.targets(train.targets~=1,:) - 1;

            % Create and train binary classifier
            switch(lower(obj.binaryMethod))
                case 'svc1v1'
                    parambi.C = param.C;
                    parambi.k = param.k;
                    obj.objBI = SVC1V1();
                    obj.objBI.fit(trainBi, parambi);
                case 'csvc1v1'
                    error('TODO')
                    parambi.C = param.C;
                    parambi.k = param.k;
                    obj.objBI = CSVC();
                    obj.objBI.fit(trainBi, parambi);
                case 'liblinear'
                    parambi.C = param.C;
                    obj.objBI = LIBLINEAR();
                    obj.objBI.fit(trainBi, parambi);
                otherwise
                    error(['Unknown binary classifier method:', obj.binaryMethod])
            end

            % Create and train ordinal classifier
            switch(lower(obj.ordinalMethod))
                case 'svorim'
                    obj.objOR = SVORIM();
                    paramor.C = param.C;
                    paramor.k = param.k;
                    obj.objOR.fit(trainOr,paramor);
                    %obj.objOR.model = obj.objOR.fit(trainOr,paramor);
                case 'pom'
                    obj.objOR = POM();
                    obj.objOR.fit(trainOr);
                    %obj.objOR.model = obj.objOR.fit(trainOr);
                otherwise
                    error(['Unknown ordinal classifier method:', obj.ordinalMethod])
            end

            % Save model and parameters
            model.parameters = param;
            model.modelBI = obj.objBI.getModel();
            model.modelOR = obj.objOR.getModel();
            obj.model = model;
            [projectedTrain, predictedTrain] = obj.predict(train.patterns);
        end

        function [projected, predTargets]= privpredict(obj, testPatterns)
            %PREDICT predict labels of TEST patterns labels using MODEL.
            projected = -1*ones(size(testPatterns,1),1);% dummy value
            % Binary prediction: classes 1/2
            [projectedTest_bi,predTargets] = obj.objBI.predict(testPatterns);
            % Ordinal prediction for patterns of class ~= class 1
            [projectedTest_or, predictedTest_or] = obj.objOR.predict(testPatterns(predTargets~=1,:));
            % +1 to correct label numbering
            predictedTest_or = predictedTest_or + 1;
            predTargets(predTargets~=1,:) = predictedTest_or;
        end

    end

end


function [maps, mapeq, maps_b, mapeq_b] = genSDPConstraintMap(n,k, W)

    maps =  {}; %cell(2*n,1);
    mapeq = {};
    eqCount = 1; ieqCount = 1;
    for i=1:n
        A = zeros(n,n);
        A(i,:) = 1;
        Av = [A(:); 0];

        M = sparse(n*n+1, n*n+1);
        M(n*n+1, :) = Av;
        maps{ieqCount} = M; ieqCount = ieqCount + 1;
    end

    for i=1:n
        A = zeros(n,n);
        A(:,i) = 1;
        Av = [A(:); 0];

        M = sparse(n*n+1, n*n+1);
        M(n*n+1, :) = Av;
        maps{ieqCount} = M; ieqCount = ieqCount + 1;
    end
    maps_b = ones (2*n, 1);

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

    % 1^TX1 = k
    M = sparse(n*n+1, n*n+1);
    M(n*n+1,1:n*n) = 1;
    mapeq{eqCount} = M; eqCount = eqCount+1;
    mapeq_b = k;

    % Sum Yqrst = k
%     M = ones(n*n, n*n);
%     M = [M; zeros(1,n*n)];
%     M = [M zeros(n*n+1,1)];
%     mapeq{eqCount} = M; eqCount = eqCount + 1;
%     mapeq_b = [mapeq_b; k*k];

    % Wherever W(i,j) < 0, force Y(i,j) to 0
%     for i=1:size(W,1)
%         for j=1:size(W,2)
%            if (W(i,j) < 0)
%                M = sparse(n*n+1, n*n+1); M(i,j) = 1;
%                mapeq{eqCount} = M; eqCount = eqCount + 1;
%                mapeq_b = [mapeq_b; 0];
%             end
%         end
%     end
% %
%
    % Force Yqrst = 0;
%      for p=1:n
%        for q=1:n
%            for s=1:n
%                for t=1:n
%                    i = p + (q-1)*n;
%                    j = s + (t-1)*n;
%                    if (p==s && q~=t)||(p~=s && q==t)
%                        M = sparse(n*n+1, n*n+1); M(i,j) = 1;
%                        mapeq{eqCount} = M; eqCount = eqCount + 1;
%                        mapeq_b = [mapeq_b; 0];
%                    else
% %                        M = sparse(n*n+1, n*n+1);
% %                        M(i,j) = 1; M(i,n*n+1) = -1;
% %                        maps_b = [maps_b;0];
% %                        maps{ieqCount} = M; ieqCount = ieqCount + 1;
% %
% %                        if (i~=j)
% %                            M = sparse(n*n+1, n*n+1);
% %                            M(i,j) = 1; M(j,n*n+1) = -1;
% %                            maps_b = [maps_b;0];
% %                            maps{ieqCount} = M; ieqCount = ieqCount + 1;
% %                        end
%                    end
%
%
%
%                 end
%             end
%         end
%     end

end


function [sMap, distNeuronsToData, sTrain] = rsom_batchtrain(sMap, Distances, varargin)

%RSOM_BATCHTRAIN Use a batch algorithm to train the Self-Organizing Map on
%relational data.
%
% [sM,distToData,sT] = som_batchtrain(sM, D, [argID, value, ...])
%
%  sM = som_batchtrain(sM, D);
%  [sM, distToData] = som_batchtrain(sM, D, 'epochs', 50, 'lambda0', 2.5);
%
% Input and output arguments:
%   sM         (struct) rsom map struct, the trained and updated map is
%                       returned
%   D          (matrix) dissimilarity data for training, size nData x nData
%   [argID,    (string) See below.
%    value]    (varies)
%
%   distToData (matrix) distance  from the neurons to data,
%                       size nNeurons x nData
%   sT         (struct) learning parameters used during the training
%
% Here are the valid argument IDs and corresponding values.
%   'lambda0'     (scalar) initial decay constant
%   'lambdaFin'   (scalar) final decay value
%   'epochs'      (scalar) number of epochs
%
% For more help, try 'type rsom_batchtrain' or check out online documentation.
% See also RSOM_RANDINIT, RSOM_LININIT.

%%%%%%%%%%%%% DETAILED DESCRIPTION %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% rsom_batchtrain
%
% PURPOSE
%
% Trains a Relational Self-Organizing Map on dissimilarity data using the
% batch algorithm.
%
% SYNTAX
%
%  sM = rsom_batchtrain(sM,D);
%  sM = rsom_batchtrain(...,'argID',value,...);
%
% DESCRIPTION
%
% Trains the given and already initialized RSOM with the batch algorithm.
% Training data are expected to be given in the form of dissimilarity data
% D. If D is generated from euclidean data, i.e.
% (D)_ij = ||x_i - x_j||^2, training the relational SOM is equivalent to
% the standard SOM and the neuron position in the input space can be
% acquired by sMap.cCodebook * x, where x are training data.
%
% REFERENCES
%
%   Barbara Hammer, Alexander Hasenfuss: Topographic Mapping of Large
%   Dissimilarity Data Sets. Neural Computation 22(9): 2229-2284 (2010)
%
% REQUIRED INPUT ARGUMENTS
%
%   sM         (struct) initialized rsom map struct
%   D          (matrix) dissimilarity data for training, size nData x nData
%
% OPTIONAL INPUT ARGUMENTS
%
%  argID (string) Argument identifier string (see below).
%  value (varies) Value for the argument (see below).
%
%  The optional arguments can be given as 'argID',value -pairs.
%  The valid IDs and corresponding values are listed below.
%
%  Below is the list of valid arguments:
%   'lambda0'     (scalar) initial decay constant
%   'lambdaFin'   (scalar) final decay value
%   'epochs'      (scalar) number of training epochs
%
% OUTPUT ARGUMENTS
%
%   sM         (struct) the trained rsom map struct. The current training
%                       is added to the training history (sM.trainhist).
%   distToData (matrix)
%   sT         (struct) train struct; information of the accomplished
%                       training
%
% EXAMPLES
%
%  mData = size(D,1);
%  sM = rsom_randinit(nData, [20 3]); % create a 20 x 3 grid
%  sM = rsom_batchtrain(sM,D);
%
% SEE ALSO
%
%   rsom_randinit   Initialize a RSOM randomly

% Contributed to SOM Toolbox vs2, December 7th, 2012 by Alexander Schulz
% Copyright (c) Alexander Hasenfuss
% http://www.cis.hut.fi/projects/somtoolbox/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% Prase input
p = inputParser;
p.addRequired('sMap', @isstruct);
p.addRequired('Distances', @isnumeric);

% Get size
m = size( Distances, 1 );
GridDistances = som_unit_dists(sMap.topol).^2;
n = size( GridDistances, 1 );

p.addParamValue('lambda0', n/2, @isnumeric);
p.addParamValue('lambdaFin', 0.01, @isnumeric);
p.addParamValue('epochs', 100, @(x) ~(x-floor(x)) & (length(x) == 1));

p.parse(sMap, Distances, varargin{:});
lambda0   = p.Results.lambda0;
lambdaFin = p.Results.lambdaFin;
epochs    = p.Results.epochs;

%% Initialize
lambda = lambda0 * (lambdaFin/lambda0).^((0:(epochs-1))/(epochs-1));

QuantizationErrors = zeros(1,epochs);

cNeurons = sMap.cCodebook;

sTrain = som_train_struct('algorithm','batch');
sTrain = som_set(sTrain, 'neigh', sMap.neigh, 'trainlen', epochs, ...
    'radius_ini', sqrt(lambda0/2), 'radius_fin', sqrt(lambdaFin/2));

%% Perform optimization
for i=1:epochs,

  % Determine quadratic distances between neurons and data
   distNeuronsToData = determine_distance_relational_neurons_to_data( Distances, cNeurons );

  % Determine winner w_I*(x_j) for every datapoint (w* := [w_I*(x_1), ..., w_I*(x_m)])
   [err, w_star] = min( distNeuronsToData, [], 1 );

  % Determine k~_ij (distances to winner neurons)
   KK = GridDistances(:,w_star);

  % Neighbourhood Function
   HH = exp(-(KK)/lambda(i));

  % Update rule
   cNeurons = HH ./ (sum(HH,2) * ones(1,m));

  % Determine quantization error
   QuantizationErrors(i) = determine_qerror( sqrt( distNeuronsToData ) );

end

% Determine distance between neurons and data
distNeuronsToData = sqrt( determine_distance_relational_neurons_to_data( Distances, cNeurons ) );
sMap.cCodebook = cNeurons;

sTrain = som_set(sTrain,'time',datestr(now,0));
tl = length(sMap.trainhist);
sMap.trainhist(tl+1) = sTrain;

function distNeuronsToData = determine_distance_relational_neurons_to_data( Distances, cNeurons )

%
% Determines dissimilarities between relational neurons and data on which they are defined
%
% Distances ... (m x m)-Matrix of dissimilarities between data points
% cNeurons ... Coefficient (n x m)-Matrix of relational neurons
%
% Use squared distances to compare with other methods on euclidean distances !
%
% A.Hasenfuss (c) 2007-2008 (Optimized Version)
%

[n,m] = size( cNeurons );

% Determine distances between neurons and data
  temp1 = cNeurons * Distances;

  temp2 = zeros(n,1);
  for i = 1:n
    temp2(i,1) = 0.5 * (temp1(i,:) * cNeurons(i,:)');
  end

  distNeuronsToData = temp1 - temp2*ones(1,m);

function QuantizationError = determine_qerror( distNeuronsToData )

%
% Determines the quantization error for median neurons
%
% A.Hasenfuss (c) 2006
%

[WinnerDist, WinnerIdx] = min( distNeuronsToData, [], 1  );
QuantizationError = sum( WinnerDist.^2 )/2;


function test2
%TEST2 test cs_sparse, cs_permute, cs_pvec, cs_ipvec, cs_symperm
%
% Example:
%   test2
% See also: testall

%   Copyright 2006-2007, Timothy A. Davis.
%   http://www.cise.ufl.edu/research/sparse

rand ('state', 0)
% clf

for trial = 1:100
    m = fix (10 * rand (1)) ;
    n = fix (10 * rand (1)) ;
    nz = fix (100 * rand (1)) ;

    i = 1 + fix (m * rand (nz,1)) ;
    j = 1 + fix (n * rand (nz,1)) ;
    x = rand (nz,1) ;

    if (~ispc)
        if (mod (trial, 2) == 1)
            x = x + 1i * (2*rand(nz,1)-1) ;
        end
    end

    A = sparse (i,j,x) ;
    B = cs_sparse (i,j,x) ;
    D = cs_sparse2 (i,j,x) ;
    fprintf ('%3d %3d %6d : %6d %6d : %d\n', ...
        m, n, nz, nnz (A), nnz(B), nz-nnz(A)) ;

    err = norm (A-B,1) / max (1, norm (A,1)) ;
    if (err > 0)
        disp ('err = ') ;
        disp (err) ;
    end
    if (err > 1e-14)
        error ('!') ;
    end

    if (nnz (B-D) > 0)
        error ('!') ;
    end

    if (nnz (A) ~= nnz (B))
        error ('nz!') ;
    end

    if (max (1,nnz (B)) ~= max (1,nzmax (B)))
        nnz (B)
        nzmax (B)
        error ('nzmax!') ;
    end
    % pack

    [m n] = size (A) ;
    p = randperm (m) ;
    q = randperm (n) ;
    C1 = A (p,q) ;
    C2 = cs_permute (A,p,q) ;
    err = norm (C1-C2,1) ;
    if (err > 0)
        error ('!') ;
    end

%    subplot (1,2,1) ; spy (A)
%    subplot (1,2,2) ; spy (C2)
%    drawnow

    x = rand (m,1) ;

    if (~ispc)
        if (mod (trial, 2) == 1)
            x = x + 1i * (2*rand(m,1)-1) ;
        end
    end

    x1 = x (p) ;
    x2 = cs_pvec (x, p) ;

    err = norm (x1-x2,1) ;
    if (err > 0)
        error ('!') ;
    end

    x1 = zeros (m,1) ;
    x1 (p) = x ;                                                            %#ok
    x2 = cs_ipvec (x, p) ;                                                  %#ok

    n = min (m,n) ;
    B = A (1:n, 1:n) ;
    p = randperm (n) ;
    B = B+B' ;

    C1 = triu (B (p,p)) ;
    C2 = cs_symperm (B,p) ;

    try
        pp = amd (C2) ;                                                     %#ok
    catch
        pp = symamd (C2) ;                                                  %#ok
    end

    err = norm (C1-C2,1) ;
    if (err > 0)
        error ('!') ;
    end

end


function [fs, bmg] = slfiltersize(fs0)
%SLFILTERSIZE Extracts information from filtersize
%
% $ Syntax $
%   - [fs, bmg] = slfiltersize(fs0)
%
% $ Arguments $
%   - fs0:      The input filter size
%   - fs:       The full filter size form
%   - bmg:      The boundary margins
%
% $ Description $
%   - [fs, bmg] = slfiltersize(fs0) restores the full form of the input
%     filtersize. In sltoolbox, filter size can be specified in either
%     of the following forms:
%     \*
%     \t    Table.  The forms of the filter size                    \\
%     \h     name      &           syntax                           \\
%            full      & [height, width, center_y, center_x]        \\
%            sizeonly  & [height, width]
%                        The center will be computed as:
%                        cy = floor((1 + h) / 2)
%                        cx = floor((1 + w) / 2)                    \\
%            lenonly   & [len]
%                        height = width = len
%     \*
%     bmg is the boundary margins in the form of
%     [top_margin, bottom_margin, left_margin, right_margin]
%
% $ History $
%   - Created by Dahua Lin, on Sep 1st, 2006
%

%% parse filter size

if ~isvector(fs0)
    error('sltoolbox:invalidarg', ...
        'fs0 should be a vector');
end

switch length(fs0)
    case 1
        h = fs0;
        w = fs0;
        cy = floor((1+h)/2);
        cx = floor((1+w)/2);
    case 2
        cencoords = floor((1 + fs0) / 2);
        h = fs0(1);
        w = fs0(2);
        cy = cencoords(1);
        cx = cencoords(2);
    case 4
        h = fs0(1);
        w = fs0(2);
        cy = fs0(3);
        cx = fs0(4);
    otherwise
        error('sltoolbox:sizmismatch', ...
            'The length of fs0 is illegal');
end

fs = [h, w, cy, cx];

%% compute boundary margins

if nargout >= 2
    tm = cy - 1;
    bm = h - cy;
    lm = cx - 1;
    rm = w - cx;
    bmg = [tm, bm, lm, rm];
end


function R = gamrand1(A, B)
%GAMRAND1 Random matrices from gamma distribution.
%
%   R = GAMRAND1(A,B) returns a matrix of random numbers chosen
%   from the gamma distribution with parameters A and B.
%   Both parameters have to be scalar.
%
%   Note: Parameterization as in (Neal, 1996).
%      A is mean of the distribution
%      B is degrees of freedom
%
%	See also INVGAMRAND
%
% Copyright (c) 1999 Aki Vehtari

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

error('No mex-file for this architecture. See Matlab help and convert.m in ./linuxCsource or ./winCsource for help.')


function noise = ncnmNoiseParamInit(noise, y)

% NCNMNOISEPARAMINIT null category noise model's parameter initialisation.
% The null category noise model enables semi-supervised learning
% with Gaussian processes. The approach is described in a 2004 NIPS
% paper by Lawrence and Jordan.
%
% FORMAT
% DESC initialises the parameters of the null category noise model.
% ARG noise : the structure to initialise.
% ARG y : a set of target values.
% RETURN noise : the initialised noise structure.
%
% FORMAT
% DESC initialises the parameters of the null category noise model.
% ARG noise : the structure to initialise.
% RETURN noise : the initialised noise structure.
%
% SEEALSO : noiseParamInit, noiseCreate
%
% COPYRIGHT : Neil D. Lawrence, 2004, 2005, 2006

% NOISE

% The likelihood is not log concave.
noise.logconcave = 0;
noise.gammaSplit = 0;

if nargin > 1
  nClass1 = sum(y==1, 1);
  nClass2 = sum(y==-1, 1);
  totClass = nClass1 + nClass2;
  p1 = nClass1./totClass;
  noise.numProcess = size(y, 2);
  noise.gamman = sum(isnan(y))/length(y);
  noise.gammap = noise.gamman;
  noise.bias = invCumGaussian(p1);
else
  noise.bias = zeros(1, noise.numProcess);
  noise.gamman = 0.5;
  noise.gammap = 0.5;
end
if noise.gammaSplit
  noise.nParams = noise.numProcess+2;
else
  noise.nParams = noise.numProcess+1;
end

% Constrain noise.prior to be between 0 and 1.
if noise.gammaSplit
  noise.transforms.index = [noise.numProcess+1 noise.numProcess+2];
else
  noise.transforms.index = [noise.numProcess+1];
end
noise.transforms.type = optimiDefaultConstraint('zeroone');

% This isn't optimised, it sets the gradient of the erf.
noise.sigma2 = eps;

% Can handle missing values?
noise.missing = 1;
noise.width = 1;


function colsum = r8col_sum ( m, n, a )

%*****************************************************************************80
%
%% R8COL_SUM sums the columns of an R8COL.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    24 April 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns.
%
%    Input, real A(M,N), the array to be examined.
%
%    Output, real COLSUM(N), the sums of the columns.
%
  for j = 1 : n
    colsum(j) = sum ( a(1:m,j) );
  end

  return
end


function [ unique_num, a1, a2 ] = r8vec2_sorted_unique ( n, a1, a2 )

%*****************************************************************************80
%
%% R8VEC2_SORTED_UNIQUE keeps unique elements in a sorted R8VEC2.
%
%  Discussion:
%
%    An R8VEC2 is two R8VEC's.
%
%    An R8VEC is a vector of R8 values.
%
%    Item I is stored as the pair A1(I), A2(I).
%
%    The items must have been sorted, or at least it must be the
%    case that equal items are stored in adjacent vector locations.
%
%    If the items were not sorted, then this routine will only
%    replace a string of equal values by a single representative.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 November 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of items.
%
%    Input, real A1(N), A2(N), the array of N items.
%
%    Output, integer UNIQUE_NUM, the number of unique items.
%
%    Output, real A1(UNIQUE_NUM), A2(UNIQUE_NUM), the array of unique items.
%
  if ( n <= 0 )
    unique_num = 0;
    return
  end

  unique_num = 1;

  for itest = 2 : n

    if ( a1(itest) ~= a1(unique_num) || a2(itest) ~= a2(unique_num) )

      unique_num = unique_num + 1;

      a1(unique_num) = a1(itest);
      a2(unique_num) = a2(itest);

    end

  end

  a1 = a1(1:unique_num);
  a2 = a2(1:unique_num);

  return
end


function slicefr(x,y,z,v,xs,ys,zs)
% This script is a routine built around Matlab's SLICE function.
% It does the same as SLICE, just, it plots a black 'frame' along the edges
% of each slice and a dotted line where two slices intersect.
% This works only of slices parallel to the co-ordinate axes.
%
% U. Theune, Geophysics, U of A
%

slice(x,y,z,v,xs,ys,zs)

hold on
axis tight
xl=get(gca,'xlim');
yl=get(gca,'ylim');
zl=get(gca,'zlim');

% Plot the frames
for i=1:length(xs)
    plot3([1 1 1 1 1]*xs(i),[yl(1) yl(1) yl(2) yl(2) yl(1)],[zl(1) zl(2) zl(2) zl(1) zl(1)],'k','linewidth',0.5)
end
for i=1:length(ys)
    plot3([xl(1) xl(1) xl(2) xl(2) xl(1)],[1 1 1 1 1]*ys(i),[zl(1) zl(2) zl(2) zl(1) zl(1)],'k','linewidth',0.5)
end
for i=1:length(zs)
    plot3([xl(1) xl(2) xl(2) xl(1) xl(1)],[yl(1) yl(1) yl(2) yl(2) yl(1)],[1 1 1 1 1]*zs(i),'k','linewidth',0.5)
end
% Plot the intersection lines
% - vertical
for i=1:length(xs)
    for j=1:length(ys)
        plot3([xs(i) xs(i)],[ys(j) ys(j)],[zl(1) zl(2)],':k','linewidth',0.25)
    end
end
% - and horizontal
for i=1:length(zs)
    for j=1:length(ys)
        plot3([xl(1) xl(2)],[ys(j) ys(j)],[zs(i) zs(i)],':k','linewidth',0.25)
    end
end
for i=1:length(zs)
    for j=1:length(xs)
        plot3([xs(j) xs(j)],[yl(1) yl(2)],[zs(i) zs(i)],':k','linewidth',0.25)
    end
end
hold off
axis normal


function poly2 = clipPolygonHP(poly, line)
%CLIPPOLYGONHP Clip a polygon with a Half-plane defined by a directed line
%
%   POLY2 = clipPolygonHP(POLY, LINE)
%   POLY is a [Nx2] array of points, and LINE is given as [x0 y0 dx dy].
%   The result POLY2 is also an array of points, sometimes smaller than
%   poly, and that can be [0x2] (empty polygon).
%
%   See also:
%   polygons2d, clipPolygon
%
% ---------
% author : David Legland
% created the 31/07/2005.
% Copyright 2010 INRA - Cepia Software Platform.
%

%   HISTORY
%   15/08/2005 add test to avoid empty polygons
%   13/06/2007 deprecate
%   10/10/2008 'reprecate'

% avoid to process empty polygons
if size(poly, 1)<3
    poly2 = zeros([0 2]);
    return;
end

% ensure the last point is the same as the first one
if sum(poly(end, :)==poly(1,:))~=2
    poly = [poly; poly(1,:)];
end

N = size(poly, 1);
edges = [poly([N 1:N-1], :) poly];

b = isLeftOriented(poly, line);

% case of totally clipped polygon
if sum(b)==0
    poly2 = zeros(0, 2);
    return;
end

poly2 = zeros(0, 2);

i=1;
while i<=N

    if isLeftOriented(poly(i,:), line)
        % keep all points located on the right side of line
        poly2 = [poly2; poly(i,:)]; %#ok<AGROW>
    else
        % compute of preceeding edge with line
        if i>1
            poly2 = [poly2; intersectLineEdge(line, edges(i, :))]; %#ok<AGROW>
        end

        % go to the next point on the left side
        i=i+1;
        while i<=N

            % find the next point on the right side
            if isLeftOriented(poly(i,:), line)
                % add intersection of previous edge
                poly2 = [poly2; intersectLineEdge(line, edges(i, :))]; %#ok<AGROW>

                % add current point
                poly2 = [poly2; poly(i,:)]; %#ok<AGROW>

                % exit the second loop
                break;
            end

            i=i+1;
        end
    end

    i=i+1;
end

% remove last point if it is the same as the first one
if sum(poly2(end, :)==poly(1,:))==2
    poly2 = poly2(1:end-1, :);
end


classdef TestCalcHist
    %TestCalcHist

    properties (Constant)
        img = fullfile(mexopencv.root(),'test','img001.jpg');
    end

    methods (Static)
        function test_1
            % 2D histogram
            im = imread(TestCalcHist.img);
            histSize = [30, 32];
            edges1 = linspace(0, 256, histSize(1)+1);
            edges2 = linspace(0, 256, histSize(2)+1);
            edges = {edges1, edges2};

            H = cv.calcHist(im(:,:,[1 2]), edges);
            validateattributes(H, {'single'}, {'nonsparse', 'size',histSize});

            HH = cv.calcHist({im(:,:,1), im(:,:,2)}, edges);
            validateattributes(HH, {'single'}, {'nonsparse', 'size',histSize});
            assert(isequal(H,HH));

            HH = cv.calcHist(im, edges, 'Channels',[1 2]-1);
            validateattributes(HH, {'single'}, {'nonsparse', 'size',histSize});
            assert(isequal(H,HH));

            HH = cv.calcHist(im, edges, 'Channels',[1 2]-1, 'HistSize',histSize);
            validateattributes(HH, {'single'}, {'nonsparse', 'size',histSize});
            assert(isequal(H,HH));

            HH = cv.calcHist(im, {edges1([1 end]), edges2([1 end])}, ...
                'Uniform',true, 'Channels',[1 2]-1, 'HistSize',histSize);
            validateattributes(HH, {'single'}, {'nonsparse', 'size',histSize});
            assert(isequal(H,HH));

            HH(:) = 0;
            HH = cv.calcHist(im(:,:,[1 2]), edges, 'Hist',HH);
            validateattributes(HH, {'single'}, {'nonsparse', 'size',histSize});
            assert(isequal(H,HH));

            HH = cv.calcHist(im(:,:,[1 2]), edges, 'Sparse',true);
            validateattributes(HH, {'double'}, {'size',histSize});
            assert(issparse(HH) && isequal(H,full(HH)));
        end

        function test_histc
            % compare against HISTC
            im = cv.imread(TestCalcHist.img, 'Grayscale',true);  % uint8 grayscale
            edges = [0 50 100 150 200 256];                      % 1D histogram
            H1 = cv.calcHist(im, edges);
            H2  = histc(im(:), edges);
            assert(isequal(H1, H2(1:end-1)));

            % with a mask
            mask = false(size(im));
            mask(100:300,100:300) = true;
            H1 = cv.calcHist(im, edges, 'Mask',mask);
            H2  = histc(im(mask), edges);
            assert(isequal(H1, H2(1:end-1)));
        end

        function test_histcounts
            % compare against the new HISTCOUNTS function
            if mexopencv.isOctave() || verLessThan('matlab','8.4')
                error('mexopencv:testskip', 'toolbox');
            end
            im = cv.imread(TestCalcHist.img, 'Grayscale',true);  % uint8 grayscale
            edges = [0 50 100 150 200 256];                      % 1D histogram
            H1 = cv.calcHist(im, edges);
            H2  = histcounts(im, [edges(1:end-1) 255]);
            assert(isequal(H1(:), H2(:)));

            % with a mask
            mask = false(size(im));
            mask(100:300,100:300) = true;
            H1 = cv.calcHist(im, edges, 'Mask',mask);
            H2  = histcounts(im(mask), [edges(1:end-1) 255]);
            assert(isequal(H1(:), H2(:)));
        end

        function test_nd_hist
            % multi-dimensional histogram (4-D)
            X = rand([400,500,4], 'single');
            [h,w,~] = size(X);
            edges = {[0 1], [0 1], [0 1], [0 1]};
            histSize = [7 8 9 10];
            H = cv.calcHist(X, edges, 'HistSize',histSize, 'Uniform',true);
            validateattributes(H, {'single'}, {'ndims',4, 'size',histSize});
            assert(isequal(sum(H(:)), h*w));
        end

        function test_error_argnum
            try
                cv.calcHist();
                throw('UnitTest:Fail');
            catch e
                assert(strcmp(e.identifier,'mexopencv:error'));
            end
        end
    end

end


function histogram_discrete_test ( )

%*****************************************************************************80
%
%% HISTOGRAM_DISCRETE_TEST tests the HISTOGRAM_DISCRETE library.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 May 2013
%
%  Author:
%
%    John Burkardt
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'HISTOGRAM_DISCRETE_TEST:\n' );
  fprintf ( 1, '  MATLAB version.\n' );
  fprintf ( 1, '  Test the HISTOGRAM_DISCRETE library.\n' );

  setup_discrete_test ( );
  pdf_discrete_test ( );
  cdf_discrete_test ( );

  s_num = 50;
  bigger_test ( s_num );

  s_num = 200;
  gaussian_test ( s_num );
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'HISTOGRAM_DISCRETE_TEST:\n' );
  fprintf ( 1, '  Normal end of execution.\n' );
  fprintf ( 1, '\n' );
  timestamp ( );

  return
end


%This Matlab script can be used to reproduce Figures 4.21-22 in the monograph:
%
%Emil Bjornson, Jakob Hoydis and Luca Sanguinetti (2017),
%"Massive MIMO Networks: Spectral, Energy, and Hardware Efficiency",
%Foundations and Trends in Signal Processing: Vol. 11, No. 3-4,
%pp. 154-655. DOI: 10.1561/2000000093.
%
%For further information, visit: https://www.massivemimobook.com
%
%This is version 1.0 (Last edited: 2017-11-04)
%
%License: This code is licensed under the GPLv2 license. If you in any way
%use this code for research that results in publications, please cite our
%monograph as described above.

%Empty workspace and close figures
close all;
clear;

%Number of BSs
L = 16;

%Number of UEs per BS
K = 10;

%Number of BS antennas
M = 100;

%Define the pilot reuse factor
f = 1;

%Select the number of setups with random UE locations
nbrOfSetups = 10;

%Select the number of channel realizations per setup
nbrOfRealizations = 1000;

%% Propagation parameters

%Communication bandwidth
B = 20e6;

%Total uplink transmit power per UE (mW)
p = 100;

%Total downlink transmit power per UE (mW)
rho = 100;

%Noise figure at the BS (in dB)
noiseFigure = 7;

%Compute noise power
noiseVariancedBm = -174 + 10*log10(B) + noiseFigure;

%Use the approximation of the Gaussian local scattering model
accuracy = 2;

%Angular standard deviation in the local scattering model (in degrees)
ASDdeg = 10;

%Prepare to save simulation results
sumchannelGains_MR = zeros(K,L,K,L,nbrOfSetups);
sumchannelGains_RZF = zeros(K,L,K,L,nbrOfSetups);
sumchannelGains_MMMSE = zeros(K,L,K,L,nbrOfSetups);

%% Go through all setups
for n = 1:nbrOfSetups

    %Output simulation progress
    disp([num2str(n) ' setups out of ' num2str(nbrOfSetups)]);

    %Compute channel statistics for one setup
    [R,channelGaindB] = functionExampleSetup(L,K,M,accuracy,ASDdeg);

    %Compute the normalized average channel gain, where the normalization
    %is based on the noise power
    channelGainOverNoise = channelGaindB - noiseVariancedBm;

    %Generate channel realizations with estimates and estimation
    %error correlation matrices
    [Hhat,C,tau_p,~,H] = functionChannelEstimates(R,channelGainOverNoise,nbrOfRealizations,M,K,L,p,f);

    %Compute channel gain terms between all users
    [channelGains_MR,channelGains_RZF,channelGains_MMMSE] = functionComputeULDLPowerLevels(H,Hhat,C,nbrOfRealizations,M,K,L,p);

    %Delete large matrices
    clear Hhat C H R;

    %Save results
    sumchannelGains_MR(:,:,:,:,n) = channelGains_MR;
    sumchannelGains_RZF(:,:,:,:,n) = channelGains_RZF;
    sumchannelGains_MMMSE(:,:,:,:,n) = channelGains_MMMSE;

end

%Prepare to compute signal and interference gains in UL and DL
signalGainsUL_MR = zeros(K,L,nbrOfSetups);
interferenceGainsUL_MR = zeros(K,L,nbrOfSetups);

signalGainsDL_MR = zeros(K,L,nbrOfSetups);
interferenceGainsDL_MR = zeros(K,L,nbrOfSetups);

signalGainsUL_MMMSE = zeros(K,L,nbrOfSetups);
interferenceGainsUL_MMMSE = zeros(K,L,nbrOfSetups);

signalGainsDL_MMMSE = zeros(K,L,nbrOfSetups);
interferenceGainsDL_MMMSE = zeros(K,L,nbrOfSetups);

%Go through all cells
for j = 1:L

    %Go through all UEs
    for k = 1:K

        %Extract the interference gains with MR in the UL
        signalGainsUL_MR(k,j,:) = reshape(p*sumchannelGains_MR(k,j,k,j,:),[1 1 nbrOfSetups]);
        interferenceGainsUL_MR(k,j,:) = reshape(p*sum(sum(sumchannelGains_MR(k,j,:,:,:),3),4),[1 1 nbrOfSetups])-signalGainsUL_MR(k,j,:);

        %Extract the interference gains with MR in the DL
        signalGainsDL_MR(k,j,:) = reshape(rho*sumchannelGains_MR(k,j,k,j,:),[1 1 nbrOfSetups]);
        interferenceGainsDL_MR(k,j,:) = reshape(rho*sum(sum(sumchannelGains_MR(:,:,k,j,:),1),2),[1 1 nbrOfSetups])-signalGainsDL_MR(k,j,:);

        %Extract the interference gains with M-MMSE in the UL
        signalGainsUL_MMMSE(k,j,:) = reshape(p*sumchannelGains_MMMSE(k,j,k,j,:),[1 1 nbrOfSetups]);
        interferenceGainsUL_MMMSE(k,j,:) = reshape(p*sum(sum(sumchannelGains_MMMSE(k,j,:,:,:),3),4),[1 1 nbrOfSetups])-signalGainsUL_MMMSE(k,j,:);

        %Extract the interference gains with M-MMSE in the DL
        signalGainsDL_MMMSE(k,j,:) = reshape(rho*sumchannelGains_MMMSE(k,j,k,j,:),[1 1 nbrOfSetups]);
        interferenceGainsDL_MMMSE(k,j,:) = reshape(rho*sum(sum(sumchannelGains_MMMSE(:,:,k,j,:),1),2),[1 1 nbrOfSetups])-signalGainsDL_MMMSE(k,j,:);

    end

end

%Plot simulation results in the UL with MR
figure; hold on; box on;

plot(10*log10(signalGainsUL_MR(:)),10*log10(interferenceGainsUL_MR(:)),'k*','LineWidth',1);
xlabel('Signal power over noise floor [dB]');
ylabel('Interference power over noise floor [dB]');
axis([-10 70 0 60]);

%Plot simulation results in the UL with M-MMSE
figure; hold on; box on;

plot(10*log10(signalGainsUL_MMMSE(:)),10*log10(interferenceGainsUL_MMMSE(:)),'ks','LineWidth',1);
xlabel('Signal power over noise floor [dB]');
ylabel('Interference power over noise floor [dB]');
axis([-10 70 0 60]);

%Plot simulation results in the DL with MR
figure; hold on; box on;

plot(10*log10(signalGainsDL_MR(:)),10*log10(interferenceGainsDL_MR(:)),'k*','LineWidth',1);
xlabel('Signal power over noise floor [dB]');
ylabel('Interference power over noise floor [dB]');
axis([-10 70 0 60]);

%Plot simulation results in the DL with M-MMSE
figure; hold on; box on;

plot(10*log10(signalGainsDL_MMMSE(:)),10*log10(interferenceGainsDL_MMMSE(:)),'ks','LineWidth',1);
xlabel('Signal power over noise floor [dB]');
ylabel('Interference power over noise floor [dB]');
axis([-10 70 0 60]);


function MV = ffmInteractionsSparse(X,Xbox,Y,Ybox,V,Ibox,green,k,edg,tol)
%+========================================================================+
%|                                                                        |
%|         OPENFFM - LIBRARY FOR FAST AND FREE MEMORY CONVOLUTION         |
%|           openFfm is part of the GYPSILAB toolbox for Matlab           |
%|                                                                        |
%| COPYRIGHT : Matthieu Aussal (c) 2017-2019.                             |
%| PROPERTY  : Centre de Mathematiques Appliquees, Ecole polytechnique,   |
%| route de Saclay, 91128 Palaiseau, France. All rights reserved.         |
%| LICENCE   : This program is free software, distributed in the hope that|
%| it will be useful, but WITHOUT ANY WARRANTY. Natively, you can use,    |
%| redistribute and/or modify it under the terms of the GNU General Public|
%| License, as published by the Free Software Foundation (version 3 or    |
%| later,  http://www.gnu.org/licenses). For private use, dual licencing  |
%| is available, please contact us to activate a "pay for remove" option. |
%| CONTACT   : matthieu.aussal@polytechnique.edu                          |
%| WEBSITE   : www.cmap.polytechnique.fr/~aussal/gypsilab                 |
%|                                                                        |
%| Please acknowledge the gypsilab toolbox in programs or publications in |
%| which you use it.                                                      |
%|________________________________________________________________________|
%|   '&`   |                                                              |
%|    #    |   FILE       : ffmInteractionsSparse.m                       |
%|    #    |   VERSION    : 0.61                                          |
%|   _#_   |   AUTHOR(S)  : Matthieu Aussal                               |
%|  ( # )  |   CREATION   : 14.03.2017                                    |
%|  / 0 \  |   LAST MODIF : 05.09.2019                                    |
%| ( === ) |   SYNOPSIS   : Sparse product for low-frequency compressible |
%|  `---'  |                leaves                                        |
%+========================================================================+

% Initialisation du produit Matrice-Vecteur
MV = zeros(size(X,1),1,class(V));

% Quadrature des interpolations lagrangiennes
[Xq,ii,jj,kk,xq] = ffmQuadrature(green,k,edg,tol);

% Unicite des vecteurs de translation
XY        = Ybox.ctr(Ibox(:,2),:) - Xbox.ctr(Ibox(:,1),:);
[~,Il,It] = unique(floor(XY*1e6),'rows','stable');
Nt        = length(Il);

% Fonctions de transfert
Tx = cell(Nt,1);
Ty = cell(Nt,1);
for i = 1:Nt
    [Tx{i},Ty{i}] = ffmTransfert(Xq,XY(Il(i),:),green,k,edg,tol);
end

% Interpolations en Y
Vy = cell(size(Ybox.ind));
for i = unique(Ibox(:,2)')
    % Boite centree en Y dans le cube unitaire d'interpolation
    iy = Ybox.ind{i};
    ny = length(iy);
    Ym = (2/edg) .* (Y(iy,:) - ones(ny,1)*Ybox.ctr(i,:));

    % Interpolation de Lagrange (Ym->Xq)
    Vy{i} = ffmInterp(ii,jj,kk,xq,Ym,V(iy),-1);
end

% Translations
TVy = cell(size(Xbox.ind));
for i = 1:length(TVy)
    TVy{i} = 0;
end
for i = 1:size(Ibox,1)
    TVy{Ibox(i,1)} = TVy{Ibox(i,1)} + Tx{It(i)} * (Ty{It(i)} * Vy{Ibox(i,2)});
end

% Interpolations en X
for i = unique(Ibox(:,1)')
    % Boite centree en X dans le cube unitaire d'interpolation
    ix = Xbox.ind{i};
    nx = length(ix);
    Xm = (2/edg) .* (X(ix,:) - ones(nx,1)*Xbox.ctr(i,:));

    % Interpolation de Lagrange (Xq->Xm)
    MV(ix) = ffmInterp(ii,jj,kk,xq,Xm,TVy{i},+1);
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [Xq,ii,jj,kk,xq] = ffmQuadrature(green,k,edg,tol)
% Nuages de reference emetteurs X
x       = (-0.5*edg:edg/(10-1):0.5*edg)';
[x,y,z] = ndgrid(x,x,x);
Xref    = [x(:) y(:) z(:)];
Nref    = size(Xref,1);

% Nuage de reference transmetteur avec translation minimale
r0   = [2*edg 0 0];
Yref = [Xref(:,1)+r0(1) , Xref(:,2:3)];

% Xref dans le cube unitaire d'interpolation
a    = [-0.5 -0.5 -0.5]*edg;
b    = [0.5 0.5 0.5]*edg;
Xuni = ones(Nref,1)*(2./(b-a)) .* (Xref-ones(Nref,1)*(b+a)./2);

% Solution de reference
V     = ones(Nref,1) + 1i;
[I,J] = ndgrid(1:Nref,1:1:Nref);
ref   = reshape(ffmGreenKernel(Xref(I,:),Yref(J,:),green,k),Nref,Nref) * V;

% Initialisation
sol = 1e6;
nq  = 1;

% Boucle sur l'ordre de quadrature
while norm(ref-sol)/norm(ref) > tol
    % Incrementation
    nq = nq + 1;

    % Indices de construction de l'interpolateur de Lagrange
    [ii,jj,kk] = ndgrid(1:nq,1:nq,1:nq);

    % Points de quadratures Tchebitchev (1D et 3D)
    xq = cos( (2*(nq:-1:1)-1)*pi/(2*nq))';
    Xq = [xq(ii(:)) xq(jj(:)) xq(kk(:))];

    % Vecteur de la translation
    [TA,TB] = ffmTransfert(Xq,r0,green,k,edg,tol);

    % Interpolation de Lagrange (Ym->Yq)
    Vy = ffmInterp(ii,jj,kk,xq,Xuni,V,-1);

    % Transfert (Yq->Xq)
    TVy = TA * (TB * Vy);

    % Interpolation de Lagrange (Xq->Xm)
    sol = ffmInterp(ii,jj,kk,xq,Xuni,TVy,+1);
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [TA,TB] = ffmTransfert(Xq,xy,green,k,edg,tol)
% Dimensions
Nq = size(Xq,1);

% Interpolants en X
a   = [0 0 0];
b   = [1 1 1]*edg;
Txq = (ones(Nq,1)*(b-a)/2).*Xq + ones(Nq,1)*(b+a)/2;

% Interpolants en Y
a   = xy + a;
b   = xy + b;
Tyq = (ones(Nq,1)*(b-a)/2).*Xq + ones(Nq,1)*(b+a)/2;

% Noyaux de green avec compression aux interpolants
[TA,TB,flag] = hmxACA(Txq,Tyq,green,k,tol/10);

% Calcul direct si necessaire
if ~flag
    [I,J] = ndgrid(1:Nq,1:1:Nq);
    TA    = reshape(ffmGreenKernel(Txq(I,:),Tyq(J,:),green,k),Nq,Nq);
    TB    = 1;
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function MV = ffmInterp(ii,jj,kk,xq,X,V,iflag)
% Dimensions
Nx = size(X,1);
nq = length(xq);

% Interpolateur de Lagrange par dimension d'espace
Aq = cell(1,nq);
for l = 1:nq^2
    if isempty(Aq{ii(l)})
        Aq{ii(l)} = ones(Nx,3,class(V));
    end
    if ii(l) ~= jj(l)
        Aq{ii(l)} = Aq{ii(l)} .* (X-xq(jj(l)))./(xq(ii(l))-xq(jj(l)));
    end
end

% Interpolation (X->Xq)
if (iflag == -1)
    MV = zeros(nq^3,1,class(V));
    for l = 1:nq^3
        MV(l) = (Aq{ii(l)}(:,1) .* Aq{jj(l)}(:,2) .* Aq{kk(l)}(:,3)).' * V;
    end

% Interpolation (Xq->X)
elseif (iflag == +1)
    MV = zeros(Nx,1,class(V));
    for l = 1:nq^3
        MV = MV + Aq{ii(l)}(:,1) .* Aq{jj(l)}(:,2) .* Aq{kk(l)}(:,3) .* V(l);
    end
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


function [subcl,out,pccl] = cluster_network(cl,k,beh,varargin)
% [subcl,out,pccl] = cluster_network(cl,k,beh,varargin)
%
% uses clusters(i).BARPLOT.dat (preferred) or .data as data, with column k
% beh is n x m matrix of m covariates, (n subjects), double centered
%
% tor wager
%
% if varargin, saves data in file with string = varargin{1}
%
% subcl is clusters cell array with one clusters structure per class -
% separates positively and negatively weighted clusters.
%
% pccl is cl cell array for each significant PC
% Z field in each cluster has PC weights , for imaging
% Z values are actually correlation between timeseries and PC, which is
% a normalization of the PC weights (eigenvector weights)
% try montage_clusters([],pccl,[2 2])

doresid = 1;
dorobust = 0;   % nonfunctional!  change in prplot

if length(varargin) > 0
    dosave = 1;
    savestr = varargin{1};
    try, eval(['mkdir ' savestr]),catch,end
    cd(savestr)
else
    dosave = 0;
    savestr = '-';
end

plotflag = 1;

dat = []; dopk = 0;

for i = 1:length(cl)

    if ~isfield(cl(i).BARPLOT,'dat') & ~isfield(cl(i).BARPLOT,'data')
        dopk = 1;
        % not implemented
    end

    try
        dat = [dat cl(i).BARPLOT.dat(:,k)];
    catch
        dat = [dat cl(i).BARPLOT.data(:,k)];
    end
end

% double-center
%
dat = scale(dat,1); dat = scale(dat',1)';

% ---------------------------------------------
% principal components
% ---------------------------------------------

%out = rapca(dat);
%out.pcomps = out.T;
%out.weights = out.P;
%out.eigval = out.L;
fprintf(1,'pca_npm.')
[pc,stats] = pca_npm(dat,500);
out = stats; out.T = stats.score(:,stats.wh); out.P = pc; out.L =stats.eigval(stats.wh);
figure('Color','w');plot(out.eigval,'ro-','LineWidth',2); hold on; plot(out.thresh,'ks-','LineWidth',2)
legend({'Eigenvalues' 'Upper 95% permuted'})

out.k = k;
out.dat = dat;
out.beh = beh;

for i = 1:size(out.T,2),
    pccl{i} = cl;
    for j = 1:length(cl)
        pccl{i}(j).Z = ones(size(pccl{i}(j).Z)) .* out.wcor(j,i);
    end
    montage_clusters([],pccl{i},[2 2])
end

% ---------------------------------------------
% classification of regions
% ---------------------------------------------

maxclusters = length(out.L);

%tmp = out.P * diag(out.L);   % put original scaling back so that early eigs are weighted more heavily
%out.class = docluster(tmp',maxclusters,plotflag);

%out.outliers = find(out.od > mean(out.od) + 1.5*std(out.od) | out.od < mean(out.od) - 1.5*std(out.od));

disp('cluster_network:')
%fprintf(1,'Input clusters:\t%3.0f\nGroups:\t%3.0f\n',length(cl),max(out.class))
fprintf(1,'Input clusters:\t%3.0f\nGroups:\t%3.0f\n',length(cl),size(out.class,2))
fprintf(1,'Data column:\t%3.0f\n',k)
fprintf(1,['Eigenvalues:\t'])
    for i = 1:min(8,length(out.eigval))
        if out.sig(i),sstr = '*';,else,sstr='';,end
        fprintf(1,'%3.2f%s\t',out.eigval(i),sstr)
    end
fprintf(1,'\n')

fprintf(1,['Var. explained:\t' repmat('%3.2f\t',1,length(out.L)) '\n'],out.expl(out.wh))
fprintf(1,['p (nonparametric):\t' repmat('%3.6f\t',1,length(out.L)) '\n'],out.p(out.wh))

c = tril(corrcoef(dat));c=c(:);c(c==1 | c == 0) = [];
disp(sprintf('PC1stats\tmean\tstd\tmin\tmax\n'))
disp(sprintf('%s\t%3.2f\t%3.2f\t%3.2f\t%3.2f\t',savestr,mean(c),std(c),min(c),max(c)))

    % ---------------------------------------------
    % correlations between components and behavior
    % ---------------------------------------------

    for j = 1:size(beh,2),
        figure('Color','w');[r,str,sig,ry,rx,h] = prplot(out.T,beh,j);
        set(gcf,'Position',[38    48   618   495])
        title(['Partial correlations btwn beh.' num2str(j) ' and PCs'])
        out.CORREL.rcomp{j} = r;
        out.CORREL.compsig{j} = sig;
        out.CORREL.rcomp_names{j} = ['Corr. of beh. ' num2str(j) ' with PCs'];

        out.CORREL.raw_str = 'Rows are components, cols are beh vectors';
        for k = 1:size(out.T,2)
            r = corrcoef(out.T(:,k),beh(:,j));
            out.CORREL.raw_compr(k,j) = r(1,2);
        end

        if dosave & sig,
            saveas(gcf,[savestr 'BEH' num2str(j) '_PCs.fig'])
            saveas(gcf,[savestr 'BEH' num2str(j) '_PCs.tif'])
        end

    end

    %
    %for i = 1:max(out.class)
    %    out.classdata(:,i) = mean(dat(:,out.class==i),2);
    %end

    % ---------------------------------------------
    % correlations between avgs and behavior
    % ---------------------------------------------

    for j = 1:size(beh,2),
        figure('Color','w');[r,str,sig,ry,rx,h] = prplot(out.classdata,beh,j);
        set(gcf,'Position',[957.0000   64.0000  618.0000  495.0000])
        title(['Partial Correlations btwn beh.' num2str(j) ' and avg data of each class'])
        out.CORREL.beh = beh;
        out.CORREL.rclass{j} = r;
        out.CORREL.classsig{j} = sig;
        out.CORREL.rclass_names{j} = ['Corr. of beh. ' num2str(j) ' with class avgs'];

        for k = 1:size(out.classdata,2)
            r = corrcoef(out.classdata(:,k),beh(:,j));
            out.CORREL.raw_classr(k,j) = r(1,2);
        end

        if dosave,
            saveas(gcf,[savestr 'BEH' num2str(j) '_class.fig'])
            saveas(gcf,[savestr 'BEH' num2str(j) '_class.tif'])
        end
    end

    % ---------------------------------------------
    % table
    % ---------------------------------------------

    fprintf(1,['Correlations\t'])
    for i = 1:size(beh,2)
        for j = 1:size(out.T,2)
            fprintf(1,'BEH%3.0fCOMP%3.0f\t',i,j)
        end
    end
    fprintf(1,'\n')
    fprintf(1,['r: component scores\t\n'])
    for i = 1:size(beh,2)
        fprintf('Partial r with Beh %3.0f\t',i)
        for j = 1:size(out.T,2)
            if out.CORREL.compsig{i}(j), rstr='*';,else,rstr='';,end
            fprintf(1,'%3.2f%s\t',out.CORREL.rcomp{i}(j),rstr)
        end
        fprintf(1,'\n')
    end
    fprintf(1,'\n')

    [dummy,dummy,dummy,dummy,rcrit]=r2z(.5,size(out.T,1),.05);
    out.CORREL.rcrit = rcrit;
    for i = 1:size(beh,2)
        fprintf(1,'Raw r with Beh %3.0f\t',i)
        for j = 1:size(out.T,2)
            if out.CORREL.raw_compr(j,i) >= rcrit, rstr='*';,else,rstr='';,end
            fprintf(1,'%3.2f%s\t',out.CORREL.raw_compr(j,i),rstr)
        end
        fprintf(1,'\n')
    end

    fprintf(1,['r: class averages\t\n'])
    for i = 1:size(beh,2)
        fprintf('Partial r with Beh %3.0f\t',i)
        for j = 1:size(out.class,2)
            if out.CORREL.classsig{i}(j), rstr='*';,else,rstr='';,end
            fprintf(1,'%3.2f%s\t',out.CORREL.rclass{i}(j),rstr)
        end
        fprintf(1,'\n')
    end

    for i = 1:size(beh,2)
        fprintf(1,'Raw r with Beh %3.0f\t',i)
        for j = 1:size(out.class,2)
            if out.CORREL.raw_classr(j,i) >= rcrit, rstr='*';,else,rstr='';,end
            fprintf(1,'%3.2f%s\t',out.CORREL.raw_classr(j,i),rstr)
        end
        fprintf(1,'\n')
    end

    %%% ***  class data predicting beh
    %    for i = 1:size(beh,2)
    %    fprintf(1,'Raw r with Beh %3.0f\t',i)
    %    for j = 1:size(out.class,2)
    %        if out.CORREL.raw_classr(j,i) >= rcrit, rstr='*';,else,rstr='';,end
    %        fprintf(1,'%3.2f%s\t',out.CORREL.raw_classr(j,i),rstr)
    %    end
   %     fprintf(1,'\n')
   %end

    fprintf(1,'\n')
    fprintf(1,['prop. regions in class\t\n'])
    tmp = sum(out.class)./size(out.class,1);
    fprintf(1,repmat('%3.2f\t',1,length(tmp)),tmp)
    fprintf(1,'\n')
    fprintf(1,['r: avg class weights\n'])
    for i = 1:length(out.wh)
        for j = 1:size(out.class,2)
            fprintf(1,'%3.2f\t',mean(out.pc(:,i) .* out.class(:,j)));
        end
    end

    fprintf(1,'\n')
    fprintf(1,'\n')

    % ---------------------------------------------
    % save clusters and get figures for each
    % ---------------------------------------------
    mycols = {'r' 'b' 'g' 'y' 'c' 'm' 'k' 'k' 'k' 'k'}; str = [];
    for i = 1:size(out.class,2)
        %subcl{i} = cl(out.class==i);
        subcl{i} = cl(find(out.class(:,i)));
        str = [str ',subcl{' num2str(i) '}'];
    end
    str = ['montage_clusters([]' str ',[mycols(1:size(out.class,2)) {''k''} {''k''}]);'];
    eval(str)
    set(gcf,'Position',[266          73         711        1048])
    if dosave,
            saveas(gcf,[savestr 'class_montage.fig'])
            saveas(gcf,[savestr 'class_montage.fig'])
    end

    % ---------------------------------------------
    % residual table
    % ---------------------------------------------
    wh_pos = zeros(size(out.T,1),size(beh,2)); wh_neg = wh_pos;

    fprintf(1,['Cluster\tx\ty\tz\tVox\t'])
    for i=1:length(out.L), fprintf(1,'%s\t',['R-C' num2str(i)]);,end
    for i = 1:size(out.class,2),fprintf(1,'Class_%3.0f\t',i),end

    fprintf(1,'Comm.\t')
    for i=1:size(beh,2), fprintf(1,'%s\t',['Res-BEH' num2str(i)]);,end
    fprintf(1,'\n')

    for i = 1:length(cl)

        if isfield(cl,'shorttitle'),mstr=[cl(i).shorttitle '(cl. ' num2str(i) ')'];
        elseif isfield(cl,'BAstr'), mstr = cl(i).BAstr;, else, mstr = ['CL' num2str(i)];,end

        fprintf(1,'%s\t%3.0f\t%3.0f\t%3.0f\t%3.0f\t',mstr,cl(i).mm_center(1),cl(i).mm_center(2),cl(i).mm_center(3),cl(i).numVox)
        fprintf(1,repmat('%3.2f\t',1,length(out.L)),out.wcor(i,:))
        for j = 1:size(out.class,2),fprintf(1,'%3.0f\t',out.class(i,j)),end

        if doresid

        X = [out.T ones(size(out.T,1),1)]; y = dat(:,i);
        rd = y - X * (pinv(X) * y);
        out.residstr = 'Residual activation after removing principal components';
        out.residuals(:,i) = rd;
        out.communality(i) = 1 - (var(rd) ./ var(y));
        fprintf(1,'%3.2f\t',out.communality(i));

        for j = 1:size(beh,2)
            figure('Color','w');[r,str,sig,ry,rx,h] = prplot(rd,beh,j);
            set(gcf,'Position',[1068         701         524         410])
            title(['RESIDUAL r: BEH' num2str(j) ' cl ' num2str(i) ' for data col. ' num2str(k)])

            if dosave,
                saveas(gcf,[savestr 'BEH' num2str(j) 'cl' num2str(i) '_residcor.fig'])
                saveas(gcf,[savestr 'BEH' num2str(j) 'cl' num2str(i) '_residcor.tif'])
            end

            if sig,
                rstr='*';,
                if r > 0,wh_pos(i,j) = 1;,elseif r < 0,wh_neg(i,j) = 1;,else, error('Uh-oh!'),end
            else,rstr='';,close,
            end
            fprintf(1,'%3.2f%s\t',r,rstr);
        end

        end

        fprintf(1,'\n')
    end

    if doresid
    % ---------------------------------------------
    % show areas with residual correlations
    % ---------------------------------------------

    for i = 1:size(beh,2)
        mycols = {[1 .5 0] [.2 .6 .5]}; str = [];

        clpos{i} = cl(find(wh_pos(:,i)));
        clneg{i} = cl(find(wh_neg(:,i)));

        if ~isempty(clpos{i})
            str = [str ',clpos{' num2str(i) '}'];
        else
            mycols = mycols(2);
        end

        if ~isempty(clneg{i})
            str = [str ',clneg{' num2str(i) '}'];
        end

        if ~isempty(clpos{i}) |  ~isempty(clneg{i})
            str = ['montage_clusters([]' str ',mycols);'];
            eval(str)
            set(gcf,'Position',[266          73         711        1048])

            if dosave,
                saveas(gcf,[savestr 'BEH' num2str(i) '_resid_montage.fig'])
                saveas(gcf,[savestr 'BEH' num2str(i) '_resid_montage.tif'])
            end
        end
    end

    end % if doresid

    if dosave, eval(['save ' savestr '_clusters subcl out']),end

return

    function class = docluster(a,maxclusters,doplot)

    Y = pdist(a','euclid');     % transpose so the voxels are observations, eigenvectors the variables
    Z = linkage(Y,'complete');
    if maxclusters > 1
        class = cluster(Z,maxclusters)';

        if doplot,
            dendrogram(Z,0); title('Dendrogram for clustering')
        end

    else
        class = ones(1,size(a,2));
    end

return


function X=image_show(img,grlvls,scale,title)
%Displays image, with additional parameters
%X = image_show(img,grlvls,scale,title)
%
%Input:
% img - image array; if the values fall outside [0,255] they will be
%       scaled
% grlvls - if it is a single value it represents the number of gray levels
%          to be displayed;
%          if grlvls is an array then it represents the colormap
% scale - scale for displaying the image
% title - name of the image figure, if it starts with 'save_' the image will be
%         saved instead. Don't forget the image format(e.g. 'save_test.png')!!
%
%Output:
% X - contains the image (useful if the image values have been scaled to
%     fit in the [0, 255] range
%
%Note:
% Works also for truecolor non-indexed images.
% If the range between the maximum and the minimum value in the image is larger
% than 2^16 then the image values will be rescaled logarithmically.
%
%Example:
% X = image_show(A,256,2,'A'); %zoom 2x

%for wavelet coefficients:
%Z2= 128+32*log2(abs(Y)+1); //high pass
%Z2(1:36,1:44) = Y(1:36,1:44)/8; //LL

LogTreshold = 10;

if isstr(img)
    img=imread(img);
end;
if numel(grlvls)>1
    mapa=grlvls;
else
    mapa=gray(grlvls);
end;
% maximg=max(img(:));
% minimg=min(img(:));
% if (maximg ~= minimg)
%     if maximg>255 | minimg<0
%         if log2(maximg-minimg)>LogTreshold
%             logimg=log2(abs(img)+1);
%             img=255*logimg/max(max(logimg));
%         else
%             img=round(255*(img-minimg)./(maximg-minimg));
%         end;
%     end;
%     if nargin<4
%         title=''
%         if nargin <3
%             scale=1;
%         end;
%     end;
% end;

set(0,'Units','pixels');
rd=get(0,'ScreenSize');
[rws,cls,ndms]=size(img);
rws=scale*rws;
cls=scale*cls;
fwd=round(cls+cls*0.1);
fhg=round(rws+rws*0.1);
if ~isempty(strmatch('save_',title))
    if ndims(img)==3
        imwrite(img,title);
    else
        imwrite(img,mapa,title);
    end;
else
    figure('Name',title,'Menubar','none','Units','pixels','Position',[(rd(3)-fwd)/2 (rd(4)-fhg)/2 fwd fhg]);
    image(img);
    if ndims(img)<3
        colormap(mapa);
    end;
    fh=gca;
    set(gca,'DataAspectRatio',[1 1 1],'TickLength',[0 0],'XTick',[],'YTick',[],'Units','pixels','Position',[cls*0.05 rws*0.05 cls rws]);
end;
X=img;


function inout_flow_png ( )

%*****************************************************************************80
%
%% INOUT_FLOW_PNG creates PNG image files from flow data.
%
%  Discussion:
%
%    This MATLAB script file reads the In/Out flow data:
%
%      geometry (XY values at nodes, assumed to be in 'xy.txt')
%      flow (UV values at nodes, in a sequence of files starting with 'up001.txt')
%
%    and plots the velocity vectors (U,V)(X,Y), and saves each plot as a
%    PNG file, presumably so the PNG files can be gathered into an
%    animation.
%
%    The file plots either the velocity vector field, or the velocity
%    direction field, depending on the value of the internal logical
%    parameter "normalized".
%
%    The MATLAB routine QUIVER will internally scale the vectors, but this
%    can be adjusted by setting SCALE to a value that is not 1.
%
%    For the unnormalized case, the velocity field is computed to a fixed
%    scale determined by finding the largest velocity vector over time.
%
%    This routine requires some auxiliary routines in order to "increment"
%    the name of the current velocity data file to get the name of the next
%    one, with the main such routine being called FILE_NAME_INC.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    05 July 2003
%
%  Author:
%
%    John Burkardt
%
  FALSE = 0;
  TRUE = 1;
  scale = 1.0;
  normalized = TRUE;

  nframes = 500;
%
%  Get the XY coordinates of the nodes.
%
  load xy.txt;

  x = xy(:,1);
  y = xy(:,2);
%
%  Thin the data.
%
  thin_factor = 2;
  thin_dex = thin_index ( x, y, thin_factor );
  thin_num = length ( thin_dex );
  x = x(thin_dex);
  y = y(thin_dex);
%
%  For unnormalized plots, you need to make sure that a fixed scale is preserved from
%  step to step.  The only way I can see to do this requires that I determine the
%  maximum velocity over all time, and then append one extract node and velocity
%  to the data structure.
%
  if ( normalized == FALSE )

    upfile = 'up000.txt';
    vnorm_max = 0.0;

    for ( i = 1 : nframes )
      fprintf ( 1, '  Checking file %d.\n', i );
      upfile = file_name_inc ( upfile );
      uv = load ( upfile );
      u = uv(thin_dex,1);
      v = uv(thin_dex,2);
      norm = sqrt ( u.^2 + v.^2 );
      vnorm_max = max ( vnorm_max, max ( norm ) );
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Maximum visible velocity magnitude is %f\n', vnorm_max );

  end
%
%  Set the coordinates of the boundary lines, and an extra set of
%  lines that will be invisible, but which make some space for the
%  file name to be displayed within the plot area.
%
  bx1 = [ 0.00, 1.00, 1.00, 0.99, 0.99, 0.00, 0.00 ];
  by1 = [ 0.00, 0.00, 0.80, 0.80, 0.01, 0.01, 0.00 ];

  bx2 = [ 0.00, 0.00, 1.00, 1.00, 0.01, 0.01, 0.00 ];
  by2 = [ 0.20, 1.00, 1.00, 0.99, 0.99, 0.20, 0.20 ];

  bx3 = [ -0.10,  1.10, 1.10, -0.10, -0.10 ];
  by3 = [ -0.10, -0.10, 1.10,  1.10, -0.10 ];
%
%  Set the name of the 0th (nonexistent) velocity file.
%  All the velocity files with have this format, with the
%  numeric part of the name incremented to get the next one.
%  In particular, the first velocity file is called UP001.TXT.
%
  upfile = 'up000.txt';
  pngfile = 'up000.png';

  for ( i = 1 : nframes )

    fprintf ( 1, '  Converting file %d.\n', i );

    upfile = file_name_inc ( upfile );
    pngfile = file_name_inc ( pngfile );
    uv = load ( upfile );
    u = uv(thin_dex,1);
    v = uv(thin_dex,2);

    if ( normalized == TRUE )
      norm = sqrt ( u.^2 + v.^2 );
      nonzero = find ( norm ~= 0.0 );
      u(nonzero) = u(nonzero) ./ norm(nonzero);
      v(nonzero) = v(nonzero) ./ norm(nonzero);
      vnorm_max = 1.0;
    end

    x(thin_num+1) = 0.00;
    y(thin_num+1) = 1.05;
    u(thin_num+1) = vnorm_max;
    v(thin_num+1) = 0.0;

    quiver ( x,  y, u, v, scale )
%
%  Draw the boundary lines, and the invisible bounding line.
%
    line ( bx1, by1, 'color', 'r' )
    line ( bx2, by2, 'color', 'r' )
    line ( bx3, by3, 'color', 'w' )

    axis equal
    if ( normalized == TRUE )
      title ( 'In/Out Direction Field' )
    else
      title ( 'In/Out Flow Field' )
    end
    text ( 0.420, 1.03, upfile )
%
%  Here's where we take a snapshot of the current image, and save it to
%  a PNG file.  Doing this was surprisingly complicated, and the help
%  system was not very clear.  Surely there's a more straightforward way!
%
    F = getframe;
    [X,map] = frame2im ( F );
    imwrite ( X, pngfile, 'PNG' );

  end

  return
end
function file_name = file_name_inc ( file_name )

%*****************************************************************************80
%
%% FILE_NAME_INC generates the next filename in a series.
%
%  Discussion:
%
%    It is assumed that the digits in the name, whether scattered or
%    connected, represent a number that is to be increased by 1 on
%    each call.  If this number is all 9's on input, the output number
%    is all 0's.  Non-numeric letters of the name are unaffected..
%
%    If the name is empty, then the routine stops.
%
%    If the name contains no digits, the empty string is returned.
%
%  Example:
%
%      Input            Output
%      -----            ------
%      'a7to11.txt'     'a7to12.txt'  (typical case.  Last digit incremented)
%      'a7to99.txt'     'a8to00.txt'  (last digit incremented, with carry.)
%      'a9to99.txt'     'a0to00.txt'  (wrap around)
%      'cat.txt'        ' '           (no digits in input name.)
%      ' '              STOP!         (error.)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 September 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, character FILE_NAME(*), the string to be incremented.
%
%    Output, character FILE_NAME_NEW(*), the incremented string.
%
  lens = length ( file_name );

  if ( lens <= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'FILE_NAME_INC - Fatal error!\n' );
    fprintf ( 1, '  The input filename is empty.\n' );
    error ( 'FILE_NAME_INC - Fatal error!' );
  end

  change = 0;

  for i = lens : -1 : 1

    c = file_name(i);

    if ( '0' <= c & c <= '8' )

      change = change + 1;

      c = c + 1;

      file_name(i) = c;

      return

    elseif ( c == '9' )

      change = change + 1;

      c = '0';

      file_name(i) = c;

    end

  end

  if ( change == 0 )
    file_name = ' ';
  end

  return
end
function thin_dex = thin_index ( x, y, thin_factor )

%*****************************************************************************80
%
%%  THIN_INDEX determines thinning indices for a X, Y data.
%
%  Discussion:
%
%    A set of X, Y data is given, that is presumably, not too far off
%    from being on a rectangular grid.
%
%    The input value of THIN_FACTOR indicates by how much the data should
%    be thinned.
%
%    The X and Y ranges are computed, and only those data points are
%    retained for which both X and Y lie in an appropriate subrange.
%
%    For instance, a THIN_FACTOR of 2 would essentially save data
%    that lay in the black squares of a checkerboard.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    17 June
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X(NODE_NUM), Y(NODE_NUM), the X and Y coordinates
%    of the nodes.
%
%    Input, integer THIN_FACTOR, the thinning factor.
%
%    Output, integer THIN_DEX(NODE_NUM), contains in (1:THIN_NUM) the
%    indices into X and Y of the vectors to be retained after thinning.
%
  TRUE = 1;
  FALSE = 0;

  node_num = length ( x );

  x_unique_num = 0;

  for ( i = 1 : node_num )

    unique = TRUE;

    for ( j = 1 : x_unique_num )
      if ( x(i) == x_unique(j) )
        unique = FALSE;
        break;
      end
    end

    if ( unique )
      x_unique_num = x_unique_num + 1;
      x_unique(x_unique_num) = x(i);
    end

  end

  sort ( x_unique );

  y_unique_num = 0;

  for ( i = 1 : node_num )

    unique = TRUE;

    for ( j = 1 : y_unique_num )
      if ( y(i) == y_unique(j) )
        unique = FALSE;
        break;
      end
    end

    if ( unique )
      y_unique_num = y_unique_num + 1;
      y_unique(y_unique_num) = y(i);
    end

  end

  sort ( y_unique );

  thin_num = 0;

  for ( i = 1 : node_num )

    for ( j = 1 : x_unique_num-1 )
      if ( x_unique(j) <= x(i) & x(i) <= x_unique(j+1) )
        x_bin = j;
        break;
      end
    end

    for ( j = 1 : y_unique_num-1 )
      if ( y_unique(j) <= y(i) & y(i) <= y_unique(j+1) )
        y_bin = j;
        break;
      end
    end

    if ( mod ( y_bin, thin_factor ) == thin_factor / 2 & ...
         mod ( x_bin, thin_factor ) == thin_factor / 2 )

      thin_num = thin_num + 1;
      thin_dex(thin_num) = i;

    end

  end

  return
end
function timestamp ( )

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

  return
end


function [yd] = km2yd(km)
% Convert length from kilometers to yards.
% Chad A. Greene 2012
yd = km*1093.613298338;


% Test code for the stroke utility procedures

% Fake character
stk1 = [1 2; 1 2; 1 2; 2 2];
stk2 = [1 2];
stk3 = [2 2];
stk4 = [0 0; 20 20];
stk1 = stk1 + randn(size(stk1));
stk2 = stk2 + randn(size(stk2));
stk3 = stk3 + randn(size(stk3));
stk4 = stk4 + randn(size(stk4));

vstk = [stk1; stk2; stk3; stk4];
S = {stk1; stk2; stk3; stk4};
S2 = {2*stk1; 2*stk2; 2*stk3; 2*stk4}; % rescale by 2
S_reverse = {stk1(end:-1:1,:); stk2; stk3; stk4(end:-1:1,:)};
com = mean(vstk);
rg = range(vstk,1);

% Check center of mass
com2 = com_char(S);
if aeq(com,com2)
   fprintf(1,'Center of mass test passed\n');
else
   error('COM failed');
end

% Check range of character
myrange = range_char(S);
if isequal(myrange,rg)
    fprintf(1,'Range test passed\n');
else
    error('Range test failed');
end

% Check removing strokes
minlen = 3;
mindist = 10;
RR = remove_short_stk(S,minlen,mindist);
if isequal(RR,S([1 4]))
   fprintf(1,'Remove stroke test passed\n');
else
   error('Remove stroke test failed');
end

% Check rescaling
R = apply_each_stroke(S,@(x)rescale_stk(x,[2 2]));
if isequal(R,S2)
   fprintf(1,'Apply each stroke test passed\n');
   fprintf(1,'Rescale test passed\n');
else
   error('Rescale test failed');
end

% Check reverse
RV = apply_each_stroke(S,@(x)reverse_stk(x));
if isequal(RV,S_reverse)
   fprintf(1,'Reverse test passed\n');
else
   error('Reverse test failed');
end


function b = sspsl ( ap, n, kpvt, b )

%*****************************************************************************80
%
%% SSPSL solves the real symmetric system factored by SSPFA.
%
%  Discussion:
%
%    To compute inverse(A) * C where C is a matrix with P columns:
%
%      call sspfa ( ap, n, kpvt, info )
%
%      if ( info /= 0 ) go to ...
%
%      do j = 1, p
%        call sspsl ( ap, n, kpvt, c(1,j) )
%      end do
%
%    A division by zero may occur if SSPCO has set RCOND == 0.0D+00
%    or SSPFA has set INFO /= 0.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 November 2006
%
%  Author:
%
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Dongarra, Moler, Bunch and Stewart,
%    LINPACK User's Guide,
%    SIAM, (Society for Industrial and Applied Mathematics),
%    3600 University City Science Center,
%    Philadelphia, PA, 19104-2688.
%    ISBN 0-89871-172-X
%
%  Parameters:
%
%    Input, real ( kind = 8 ) AP(N*(N+1)/2), the output from SSPFA.
%
%    Input, integer N, the order of the matrix.
%
%    Input, integer KPVT(N), the pivot vector from SSPFA.
%
%    Input, real B(N), the right hand side.
%
%    Output, real B(N), the solution.
%

%
%  Loop backward applying the transformations and D inverse to B.
%
  k = n;
  ik = floor ( ( n * ( n - 1 ) ) / 2 );

  while ( 0 < k )

    kk = ik + k;

    if ( 0 <= kpvt(k) )
%
%  1 x 1 pivot block.
%
      if ( k ~= 1 )

        kp = kpvt(k);
%
%  Interchange.
%
        if ( kp ~= k )
          temp = b(k);
          b(k) = b(kp);
          b(kp) = temp;
        end
%
%  Apply the transformation.
%
        b(1:k-1) = saxpy ( k-1, b(k), ap(ik+1:ik+k-1), 1, b(1:k-1), 1 );

      end
%
%  Apply D inverse.
%
      b(k) = b(k) / ap(kk);
      k = k - 1;
      ik = ik - k;

    else
%
%  2 x 2 pivot block.
%
      ikm1 = ik - ( k - 1 );

      if ( k ~= 2 )

        kp = abs ( kpvt(k) );
%
%  Interchange.
%
        if ( kp ~= k-1 )
          temp = b(k-1);
          b(k-1) = b(kp);
          b(kp) = temp;
        end
%
%  Apply the transformation.
%
        b(1:k-2) = saxpy ( k-2, b(k), ap(ik+1:ik+k-2), 1, b(1:k-2), 1 );
        b(1:k-2) = saxpy ( k-2, b(k-1), ap(ikm1+1:ikm1+k-2), 1, b(1:k-2), 1 );

      end
%
%  Apply D inverse.
%
      km1k = ik + k - 1;
      kk = ik + k;
      ak = ap(kk) / ap(km1k);
      km1km1 = ikm1 + k - 1;
      akm1 = ap(km1km1) / ap(km1k);
      bk = b(k) / ap(km1k);
      bkm1 = b(k-1) / ap(km1k);
      denom = ak * akm1 - 1.0;
      b(k) = ( akm1 * bk - bkm1 ) / denom;
      b(k-1) = ( ak * bkm1 - bk ) / denom;
      k = k - 2;
      ik = ik - ( k + 1 ) - k;

    end

  end
%
%  Loop forward applying the transformations.
%
  k = 1;
  ik = 0;

  while ( k <= n )

    if ( 0 <= kpvt(k) )
%
%  1 x 1 pivot block.
%
      if ( k ~= 1 )
%
%  Apply the transformation.
%
        b(k) = b(k) + sdot ( k-1, ap(ik+1:ik+k-1), 1, b(1:k-1), 1 );
        kp = kpvt(k);
%
%  Interchange.
%
        if ( kp ~= k )
          temp = b(k);
          b(k) = b(kp);
          b(kp) = temp;
        end

      end

      ik = ik + k;
      k = k + 1;

    else
%
%  2 x 2 pivot block.
%
      if ( k ~= 1 )
%
%  Apply the transformation.
%
        b(k) = b(k) + sdot ( k-1, ap(ik+1:ik+k-1), 1, b(1:k-1), 1 );
        ikp1 = ik + k;
        b(k+1) = b(k+1) + sdot ( k-1, ap(ikp1+1:ikp1+k-1), 1, b(1:k-1), 1 );
        kp = abs ( kpvt(k) );
%
%  Interchange.
%
        if ( kp ~= k )
          temp = b(k);
          b(k) = b(kp);
          b(kp) = temp;
        end

      end

      ik = ik + k + k + 1;
      k = k + 2;

    end

  end

  return
end