function stats = UFstats (A, kind, nometis, skip_chol, skip_dmperm, Z)
%UFSTATS compute matrix statistics for the UF Sparse Matrix Collection
% Example:
%   stats = UFstats (A, kind, nometis, skip_chol, skip_dmperm, Z)
%
% A: a sparse matrix
% kind: a string with the Problem.kind
% nometis: if nonzero then metis(A,'col') is not used, nor is metis used in the
%       dmperm+ ordering.
% Z: empty, or a sparse matrix the same size as A.  Only used for psym and
%       nzero statistics, described below.
%
% Requires amd, cholmod, metis, RBio, and CSparse.  Computes the following
% statistics, returning them as fields in the stats struct:
%
%   nrows           number of rows
%   ncols           number of columns
%   nnz             number of entries in A
%   RBtype          Rutherford/Boeing type
%   isBinary        1 if binary, 0 otherwise
%   isReal          1 if real, 0 if complex
%   cholcand        1 if a candidate for sparse Cholesky, 0 otherwise
%   nsym            numeric symmetry (0 to 1, where 1=symmetric)
%   psym            pattern symmetry (0 to 1, where 1=symmetric)
%   nnzdiag         nnz (diag (A)) if A is square, 0 otherwise
%   nzero           nnz (Z)
%   amd_lnz         nnz(L) for chol(C(p,p)) where, C=A+A', p=amd(C)
%   amd_flops       flop count for chol(C(p,p)) where, C=A+A', p=amd(C)
%   amd_vnz         nnz in Householder vectors for qr(A(:,colamd(A)))
%   amd_rnz         nnz in R for qr(A(:,colamd(A)))
%   metis_lnz       nnz(L) for chol(C(p,p)) where, C=A+A', p=metis(C)
%   metis_flops     flop count for chol(C(p,p)) where, C=A+A', p=metis(C)
%   metis_vnz       nnz in Householder vectors for qr(A(:,metis(A,'col')))
%   metis_rnz       nnz in R for qr(A(:,metis(A,'col')))
%   nblocks         # of blocks from dmperm
%   sprank          sprank(A)
%   nzoff           # of entries not in diagonal blocks from dmperm
%   ncc             # of strongly connected components
%   dmperm_lnz      nnz(L), using dmperm plus amd or metis
%   dmperm_unz      nnz(U), using dmperm plus amd or metis
%   dmperm_flops    flop count with dperm plus
%   dmperm_vnz      nnz in Householder vectors for dmperm plus
%   dmperm_rnz      nnz in R for dmperm plus
%   posdef          1 if positive definite, 0 otherwise
%   isND	    1 if a 2D/3D problem, 0 otherwise
%
% The *_lnz, *_unz, and *_flops statistics are not computed for rectangular
% or structurally singular matrices.  nzoff and the dmperm_* stats are not
% computed for structurally singular matrices.  If a statistic is not computed,
% it is set to -2.  If an attempt to compute the statistic was made but failed,
% it is set to -1.
%
% See also UFget, UFindex, amd, metis, RBtype, cs_scc, cs_sqr, dmperm.

% Copyright 2006-2007, Timothy A. Davis

% Requires the SuiteSparse set of packages: CHOLMOD, AMD, COLAMD, RBio, CSparse;
% and METIS.

if (nargin < 3)
    nometis = 0 ;
end

%-------------------------------------------------------------------------------
% ensure the matrix is sparse
%-------------------------------------------------------------------------------

if (~issparse (A))
    A = sparse (A) ;
end

%-------------------------------------------------------------------------------
% basic stats
%-------------------------------------------------------------------------------

tic ;
[m n] = size (A) ;
stats.nrows = m ;
stats.ncols = n ;
stats.nnz = nnz (A) ;
stats.RBtype = RBtype (A) ;			% Rutherford/Boeing type
stats.isBinary = (stats.RBtype (1) == 'p') ;
stats.isReal = (stats.RBtype (1) ~= 'c') ;

fprintf ('RBtype: %s time: %g\n', stats.RBtype, toc) ;

%-------------------------------------------------------------------------------
% symmetry and Cholesky candidacy
%-------------------------------------------------------------------------------

% get the symmetry
tic ;
[s xmatched pmatched nzoffdiag nnzdiag] = spsym (A) ;

stats.cholcand = (s >= 6) ; % check if Cholesky candidate

if (m ~= n)
    stats.nsym = 0 ;
    stats.psym = 0 ;
elseif (nzoffdiag > 0)
    stats.nsym = xmatched / nzoffdiag ;
    stats.psym = pmatched / nzoffdiag ;
else
    stats.nsym = 1 ;
    stats.psym = 1 ;
end

fprintf ('cholcand: %d\n', stats.cholcand) ;
fprintf ('nsym: %g psym: %g time: %g\n', stats.nsym, stats.psym, toc) ;
tic ;

stats.nnzdiag = nnzdiag ;

if (nargin > 5)
    stats.nzero = nnz (Z) ;

    % recompute the pattern symmetry with Z included
    if (m == n)
	try
	    AZ = A+Z ;
	    if (nnz (AZ) ~= nnz (A) + nnz (Z))
		error ('A and Z overlap!')
	    end
	    [s xmatched pmatched nzoffdiag] = spsym (AZ) ;
	    clear AZ
	    if (nzoffdiag > 0)
		stats.psym = pmatched / nzoffdiag ;
	    else
		stats.psym = 1 ;
	    end
	catch
	    fprintf ('failed to compute symmetry of pattern of A+Z\n') ;
	end
    end

else
    stats.nzero = 0 ;
end

fprintf ('nsym: %g psym: %g time: %g\n', stats.nsym, stats.psym, toc) ;
tic ;

%-------------------------------------------------------------------------------
% intialize ordering statistics
%-------------------------------------------------------------------------------

% if square, Cholesky of C(p,p) where C=A+A', p = amd(C)
stats.amd_lnz = -1 ;	    % nnz (chol (C))
stats.amd_flops = -1 ;	    % flop counts for chol (C)

% if square or rectangular
stats.amd_vnz = -1 ;	    % nnz (V), upper bound on L, for A(:,colamd(A))
stats.amd_rnz = -1 ;	    % nnz (R), upper bound on U, for A(:,colamd(A))

% if square, Cholesky of C(p,p) where C=A+A', p = metis(C)
stats.metis_lnz = -1 ;	    % nnz (chol (C))
stats.metis_flops = -1 ;    % flop counts for chol (C)

% if square or rectangular
stats.metis_vnz = -1 ;	    % nnz (V), upper bound on L, for A(:,metis(A))
stats.metis_rnz = -1 ;	    % nnz (R), upper bound on U, for A(:,metis(A))

% dmperm analysis
stats.nblocks = -1 ;	    % # of blocks in block-triangular form
stats.sprank = -1 ;	    % structural rank
stats.nzoff = -1 ;	    % # of entries of A in off-diagonal blocks

% cs_scc2
stats.ncc = -1 ;	    % # of strongly connected components

% dmperm: best of amd/metis on each square block, best of colamd/metis
% on rectangular blocks
stats.dmperm_lnz = -1 ;	    % nnz (L), for square struct full rank matrices
stats.dmperm_unz = -1 ;	    % nnz (U) + nzoff, for square struct full rank mat
stats.dmperm_flops = -1 ;   % Cholesky flop count of each square block
stats.dmperm_vnz = -1 ;	    % nnz (V), upper bound on L
stats.dmperm_rnz = -1 ;	    % nnz (R), upper bound on U

stats.isND = -1 ;	    % 1 if 2D/3D problem, 0 otherwise

d = max (m,n) ;

% if the matrix has a symmetric nonzero pattern, nzoff will always be zero
if (stats.psym == 1)
    stats.nzoff = 0 ;
end

%-------------------------------------------------------------------------------
% determine if positive definite
%-------------------------------------------------------------------------------

if (~stats.cholcand)

    % not a candidate for Cholesky, so it cannot be positive definite
    stats.posdef = 0 ;

elseif (skip_chol)

    % Cholesky was skipped
    fprintf ('skip Cholesky\n') ;
    stats.posdef = -1 ;

else

    % try chol
    try
	[x, cstats] = cholmod2 (A, ones (stats.ncols,1)) ;
	rcond = cstats (1) ;
	fprintf ('rcond: %g\n', rcond) ;
	stats.posdef = (rcond > 0) ;
    catch
	% chol failed
	disp (lasterr) ;
	fprintf ('sparse Cholesky failed\n') ;
	stats.posdef = -1 ;
    end
    clear x cstats
end

fprintf ('posdef: %d time: %g\n', stats.posdef, toc) ;
tic ;

%-------------------------------------------------------------------------------
% transpose A if m < n, for ordering methods
%-------------------------------------------------------------------------------

if (m < n)
    try
	A = A' ;		    % A is now tall and thin, or square
    catch
	disp (lasterr) ;
	fprintf ('transpose failed...\n') ;
	return ;
    end
    [m n] = size (A) ;
end

if (~isreal (A))
    try
	A = spones (A) ;
    catch
	disp (lasterr) ;
	fprintf ('conversion from complex failed...\n') ;
	return ;
    end
end

fprintf ('computed A transpose if needed, time: %g\n', toc) ;
tic ;

%-------------------------------------------------------------------------------
% order entire matrix with AMD and METIS, if square
%-------------------------------------------------------------------------------

if (m == n)

    tic ;
    try
	if (stats.RBtype (2) == 'u')
	    C = A|A' ;
	else
	    C = A ;
	end
    catch
	disp (lasterr) ;
	fprintf ('A+A'' failed\n') ;
    end
    fprintf ('computed A+A'', time: %g\n', toc) ;

    % order the whole matrix with AMD
    tic ;
    try
	p = amd (C) ;
	c = symbfact (C (p,p)) ;
	stats.amd_lnz = sum (c) ;
	stats.amd_flops = sum (c.^2) ;
    catch
	disp (lasterr) ;
	fprintf ('amd failed\n') ;
    end
    clear p c
    fprintf ('AMD   lnz %d flops %g time: %g\n', ...
	stats.amd_lnz, stats.amd_flops, toc) ;

    % order the whole matrix with METIS
    tic ;
    try
	p = metis (C) ;
	c = symbfact (C (p,p)) ;
	stats.metis_lnz = sum (c) ;
	stats.metis_flops = sum (c.^2) ;
    catch
	disp (lasterr) ;
	fprintf ('metis failed\n') ;
    end
    clear p c C
    fprintf ('METIS lnz %d flops %g time: %g\n', ...
	stats.metis_lnz, stats.metis_flops, toc) ;

else

    % not computed if rectangular
    stats.amd_lnz = -2 ;
    stats.amd_flops = -2 ;
    stats.metis_lnz = -2 ;
    stats.metis_flops = -2 ;

end

%-------------------------------------------------------------------------------
% order entire matrix with COLAMD, for LU bounds
%-------------------------------------------------------------------------------

tic ;
try
    % do not ignore any rows, and do not do etree postordering
    q = colamd2mex (A, [d 10]) ;
    [vnz,rnz] = cs_sqr (A (:,q)) ;
    stats.amd_rnz = rnz ;
    stats.amd_vnz = vnz ;
catch
    disp (lasterr) ;
    fprintf ('colamd2 and cs_sqr failed\n') ;
end
clear q
fprintf ('COLAMD rnz %d vnz %d time: %g\n', stats.amd_rnz, stats.amd_vnz, toc) ;
tic ;

%-------------------------------------------------------------------------------
% order entire matrix with METIS, for LU bounds
%-------------------------------------------------------------------------------

if (~nometis)
    try
	q = metis (A, 'col') ;
	[vnz,rnz] = cs_sqr (A (:,q)) ;
	stats.metis_rnz = rnz ;
	stats.metis_vnz = vnz ;
    catch
	disp (lasterr) ;
	fprintf ('metis(A''*A) and cs_sqr failed\n') ;
    end
end
clear q
fprintf ('METIS  rnz %d vnz %d time: %g\n', ...
    stats.metis_rnz, stats.metis_vnz, toc) ;
tic ;

%-------------------------------------------------------------------------------
% strongly connected components
%-------------------------------------------------------------------------------

try
    % find the # of strongly connected components of the graph of a square A,
    % or # of connected components of the bipartite graph of a rectangular A.
    % [p,q,r,s] = cs_scc2 (A) ;
    if (m == n)
	[p r] = cs_scc (A) ;
    else
	[p r] = cs_scc (spaugment (A)) ;
    end
    stats.ncc = length (r) - 1 ;
    clear p r
catch
    disp (lasterr) ;
    fprintf ('cs_scc failed\n') ;
end

fprintf ('scc %d, time: %g\n', stats.ncc, toc) ;
tic ;

%-------------------------------------------------------------------------------
% isND
%-------------------------------------------------------------------------------

s = 0 ;
if (strfind (kind, 'structural'))
    s = 1 ;
elseif (strfind (kind, 'fluid'))
    s = 1 ;
elseif (strfind (kind, '2D'))
    s = 1 ;
elseif (strfind (kind, 'reduction'))
    s = 1 ;
elseif (strfind (kind, 'electromagnetics'))
    s = 1 ;
elseif (strfind (kind, 'semiconductor'))
    s = 1 ;
elseif (strfind (kind, 'thermal'))
    s = 1 ;
elseif (strfind (kind, 'materials'))
    s = 1 ;
elseif (strfind (kind, 'acoustics'))
    s = 1 ;
elseif (strfind (kind, 'vision'))
    s = 1 ;
elseif (strfind (kind, 'robotics'))
    s = 1 ;
end
stats.isND = s ;

fprintf ('isND %d\n', stats.isND) ;

%-------------------------------------------------------------------------------
% Dulmage-Mendelsohn permutation, and order each block
%-------------------------------------------------------------------------------

if (skip_dmperm)
    fprintf ('skip cs_dmperm, known irreducible\n') ;
else
    try
        % find the Dulmage-Mendelsohn decomposition
        [p,q,r,s,cc,rr] = cs_dmperm (A) ;
        nblocks = length (r) - 1 ;
        stats.nblocks = nblocks ;
        stats.sprank = rr(4)-1 ;
    catch
        disp (lasterr) ;
        fprintf ('cs_dmperm failed\n') ;
    end
end

fprintf ('sprank %d, time: %g\n', stats.sprank, toc) ;
fprintf ('nblocks %d\n', stats.nblocks) ;
tic

ok_square = 1 ;
ok_vnz = 1 ;

try

    mm = diff (r) ;
    nn = diff (s) ;
    square = all (mm == nn) ;

    if (~square)

	% not computed if the matrix is rectangular
	stats.dmperm_lnz = -2 ;
	stats.dmperm_unz = -2 ;
	stats.dmperm_flops = -2 ;

    end

    if (stats.sprank < min (m,n))

	% do not report DMPERM results for structurally singular matrices
	stats.nzoff = -2 ;
	stats.dmperm_lnz = -2 ;
	stats.dmperm_unz = -2 ;
	stats.dmperm_flops = -2 ;
	stats.dmperm_vnz = -2 ;
	stats.dmperm_rnz = -2 ;

    elseif (nblocks == n && m == n)

	% square triangular or diagonal
	C = A (p,q) ;
	clear p q r s

	stats.nzoff = nnz (triu (C, 1)) ;
	stats.dmperm_lnz = n ;
	stats.dmperm_unz = n + stats.nzoff ;
	stats.dmperm_flops = n ;
	stats.dmperm_vnz = n ;
	stats.dmperm_rnz = nnz (C) ;

    elseif (nblocks == 1 && m == n)

	% only one block of structural full rank, so don't redo analysis
	clear p q r s

	stats.nzoff = 0 ;
	if (stats.metis_lnz < 0 || stats.amd_lnz < stats.metis_lnz)
	    stats.dmperm_lnz = stats.amd_lnz ;
	    stats.dmperm_unz = stats.amd_lnz ;
	    stats.dmperm_flops = stats.amd_flops ;
	else
	    stats.dmperm_lnz = stats.metis_lnz ;
	    stats.dmperm_unz = stats.metis_lnz ;
	    stats.dmperm_flops = stats.metis_flops ;
	end

	if (stats.metis_vnz < 0 || stats.amd_rnz < stats.metis_rnz)
	    stats.dmperm_vnz = stats.amd_vnz ;
	    stats.dmperm_rnz = stats.amd_rnz ;
	else
	    stats.dmperm_vnz = stats.metis_vnz ;
	    stats.dmperm_rnz = stats.metis_rnz ;
	end

    else

	% analyze each block of the permuted matrix
	C = A (p,q) ;
	clear p q

	nzoff = nnz (C) ;
	lnz = 0 ;
	unz = 0 ;
	flops = 0 ;
	vnz = 0 ;
	rnz = 0 ;

	for k = 1:nblocks
	    i1 = r (k) ;
	    i2 = r (k+1) - 1 ;
	    j1 = s (k) ;
	    j2 = s (k+1) - 1 ;

	    if (i2-i1 == 1 && j2-j1 == 1)
		% singleton case
		nzoff = nzoff - 1 ;
		unz = unz + 1 ;
		lnz = lnz + 1 ;
		flops = flops + 1 ;
		rnz = rnz + 1 ;
		vnz = vnz + 1 ;
		continue ;
	    end

	    % get the kth block
	    S = C (i1:i2, j1:j2) ;
	    [ms ns] = size (S) ;
	    nzoff = nzoff - nnz (S) ;

	    if (ok_square)
		try
		    if (square)

			% all blocks are square, analyze a square block
			% best of amd and metis
			if (nometis)
			    [pblock c] = analyze (S|S', 'sym', 1) ;
			else
			    [pblock c] = analyze (S|S', 'sym', 3) ;
			end
			lnzblock = sum (c) ;
			unz = unz + lnzblock ;
			lnz = lnz + lnzblock ;
			flops = flops + sum (c.^2) ;
			clear c pblock

		    end
		catch
		    % ordering failed, but keep going to compute nzoff
		    ok_square = 0 ;
		end
	    end

	    if (ok_vnz)
		try

		    % analyze a rectangular block, or LU bounds for square block
		    if (ms < ns)
			S = S' ;
		    end
		    % best of amd and metis
		    try
			if (nometis)
			    pblock = analyze (S, 'col', 1) ;
			else
			    pblock = analyze (S, 'col', 3) ;
			end
		    catch
			pblock = colamd2mex (S, [d 10]) ;
		    end
		    [vnz2,rnz2] = cs_sqr (S (:, pblock)) ;
		    rnz = rnz + rnz2 ;
		    vnz = vnz + vnz2 ;

		catch
		    % ordering failed, but keep going to compute nzoff
		    ok_vnz = 0 ;
		end
	    end

	    clear S pblock

	end

	stats.nzoff = nzoff ;

	if (ok_square)
	    if (~square)
		stats.dmperm_unz = -2 ;
		stats.dmperm_lnz = -2 ;
		stats.dmperm_flops = -2 ;
	    else
		stats.dmperm_lnz = lnz ;
		stats.dmperm_unz = unz + nzoff ;
		stats.dmperm_flops = flops ;
	    end
	end

	if (ok_vnz)
	    stats.dmperm_vnz = vnz ;
	    stats.dmperm_rnz = rnz + nzoff ;
	end

	clear C r s

    end

    if (~ok_square)
	disp (lasterr) ;
	fprintf ('cs_dmperm (square: lnz, unz, flops) ordering failed\n') ;
    end
    if (~ok_vnz)
	disp (lasterr) ;
	fprintf ('cs_dmperm (LU bounds: vnz, rnz) ordering failed\n') ;
    end

catch
    disp (lasterr) ;
    fprintf ('cs_dmperm ordering and nzoff failed (or skipped)\n') ;
end

fprintf ('dmperm stats done, time %g\n', toc) ;
fprintf ('UFstats done\n') ;


%GETNEXTCLIQUES Find a pair of cliques ready for message passing
%   [i, j] = GETNEXTCLIQUES(P, messages) finds ready cliques in a given
%   clique tree, P, and a matrix of current messages. Returns indices i and j
%   such that clique i is ready to transmit a message to clique j.
%
%   We are doing clique tree message passing, so
%   do not return (i,j) if clique i has already passed a message to clique j.
%
%	 messages is a n x n matrix of passed messages, where messages(i,j)
% 	 represents the message going from clique i to clique j.
%   This matrix is initialized in CliqueTreeCalibrate as such:
%      MESSAGES = repmat(struct('var', [], 'card', [], 'val', []), N, N);
%
%   If more than one message is ready to be transmitted, return
%   the pair (i,j) that is numerically smallest. If you use an outer
%   for loop over i and an inner for loop over j, breaking when you find a
%   ready pair of cliques, you will get the right answer.
%
%   If no such cliques exist, returns i = j = 0.
%
%   See also CLIQUETREECALIBRATE
%
% Copyright (C) Daphne Koller, Stanford University, 2012

function [i, j] = GetNextCliques(P, messages)

% initialization
% you should set them to the correct values in your code
i = 0;
j = 0;

N = length(messages);
mess = ones(size(messages));

for k = 1:N
	for l = 1:N
		mess(k,l) = length(messages(k,l).var)!=0;
	end
end
%mess=messages;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% YOUR CODE HERE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

for k = 1:N
	for l = 1:N
		if P.edges(k,l)==0 || mess(k,l)==1
			continue;
		end
		kmess = mess(:,k)';
	 	edges = P.edges(:,k);
		edges(l) = 0;
		kmess(l) = 0;
		%if sum(kmess) == sum(P.edges(k,:))-1
		if sum(kmess' == edges)==N
			i = k;
			j = l;
			return;
		end
		if i!=0
			break;
		end
	end
	if i!=0
		break;
	end
end
return;


function [x,state] = struct_poly(z,task,t)
%STRUCT_POLY Matrix with columns as polynomials.
%   [x,state] = struct_poly(z,[],t) computes a matrix x in which the
%   jth column is equal to the polynomial
%
%      polyval(z(j,:),s)
%
%   evaluated at the points s, defined as
%
%      (t-0.5*(min(t)+max(t)))/(0.5*(max(t)-min(t))).
%
%   The degree of the polynomial is equal to size(z,2)-1. The structure
%   state stores information which is reused in computing the right and
%   left Jacobian-vector products.
%
%   struct_poly(z,task,t) computes the right or left Jacobian-vector
%   product of this transformation, depending on the structure task. Use
%   the structure state and add the field 'r' of the same shape as z or the
%   field 'l' of the same shape as x to obtain the structure task for
%   computing the right and left Jacobian-vector products
%
%      (dF(:)/dz(:).')*task.r(:) and
%      (dF(:)/dz(:).')'*task.l(:) + conj((dF(:)/dconj(z(:)).')'*task.l(:)),
%
%   respectively. Here, F(z) represents this transormation, (:) signifies
%   vectorization and the derivative w.r.t. z (conj(z)) is a partial
%   derivative which treats conj(z) (z) as constant. The output has the
%   same shape as x or z for the right and left Jacobian-vector products,
%   respectively.
%
%   See also struct_rational, struct_rbf.

%   Authors: Laurent Sorber (Laurent.Sorber@cs.kuleuven.be)
%            Marc Van Barel (Marc.VanBarel@cs.kuleuven.be)
%            Lieven De Lathauwer (Lieven.DeLathauwer@kuleuven-kulak.be)
%
%   References:
%   [1] L. Sorber, M. Van Barel, L. De Lathauwer, "Structured data fusion,"
%       ESAT-SISTA Internal Report 13-177, KU Leuven, 2013.

if nargin < 2, task = []; end
if nargin < 3
    error('struct_poly:t','Please supply evaluation points.');
end

if isempty(task)
    [x,state] = struct_rational({z,[]},task,t);
elseif ~isempty(task.r)
    task.r = {task.r,[]};
    [x,state] = struct_rational({z,[]},task,t);
elseif ~isempty(task.l)
    [x,state] = struct_rational({z,[]},task,t); x = x{1};
end

end


%INTBDR Integation of expression over boundaries.
%
%   [ VAL ] = INTBDR( S_EXPR, PROB, IND_B, I_CUB, SOLNUM, IND_S )
%   Integrates the expression S_EXPR over the boundaries indicated in
%   IND_B. PROB is a valid finite element problem struct, and I_CUB
%   specifies the numerical integration rule. IND_S optionally
%   specifies which subdomain to use as reference for internal/
%   interior boundaries (normals point out from these subdomains).
%
%       Input       Value/[Size]           Description
%       -----------------------------------------------------------------------------------
%       s_expr      string                 Expression to integrate
%       prob        struct                 Finite element problem struct
%       ind_b       [1,n_bdr]              Boundary numbers (default all)
%       i_cub       scalar                 Numerical integration rule (default 2)
%       solnum      scalar {n_sols}        Solution number/time to evaluate
%       ind_s       integer array          Integration subdomains for internal boundaries
%                                                                                .
%       Output      Value/[Size]           Description
%       -----------------------------------------------------------------------------------
%       val         scalar                 Result of integration
%
%   See also INTSUBD, MINMAXSUBD, MINMAXBDR

% Copyright 2013-2022 Precise Simulation, Ltd.


function exact = p47_exact ( )

%*****************************************************************************80
%
%% P47_EXACT returns the exact integral for problem 47.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 November 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Output, real EXACT, the value of the integral.
%
  exact = - 4.0 / 9.0;

  return
end


function N=patchnormals(FV)
% This function PATCHNORMALS calculates the normals of a triangulated
% mesh. PATCHNORMALS calls the patchnormal_double.c mex function which
% first calculates the normals of all faces, and after that calculates
% the vertice normals from the face normals weighted by the angles
% of the faces.
%
% N=patchnormals(FV);
%
% Inputs,
%   FV : A struct containing FV.faces with a facelist Nx3 and FV.vertices
%        with a Nx3 vertices list. Such a structure is created by Matlab
%        Patch function
% Outputs,
%   N : A Mx3 list with the normals of all vertices
%
% Example,
%   % Compile the c-coded function
%   mex patchnormals_double.c -v
%
%   % Load a triangulated mesh of a sphere
%   load sphere;
%
%   % Calculate the normals
%   N=patchnormals(FV);
%
%   % Show the normals
%   figure, patch(FV,'FaceColor',[1 0 0]); axis square; hold on;
%   for i=1:size(N,1);
%       p1=FV.vertices(i,:); p2=FV.vertices(i,:)+10*N(i,:);
%       plot3([p1(1) p2(1)],[p1(2) p2(2)],[p1(3) p2(3)],'g-');
%   end
%
% Function is written by D.Kroon University of Twente (June 2009)

sizev=size(FV.vertices);
% Check size of vertice array
if((sizev(2)~=3)||(length(sizev)~=2))
    error('patchnormals:inputs','The vertice list is not a m x 3 array')
end

sizef=size(FV.faces);
% Check size of vertice array
if((sizef(2)~=3)||(length(sizef)~=2))
    error('patchnormals:inputs','The vertice list is not a m x 3 array')
end

% Check if vertice indices exist
if(max(FV.faces(:))>size(FV.vertices,1))
    error('patchnormals:inputs','The face list contains an undefined vertex index')
end

% Check if vertice indices exist
if(min(FV.faces(:))<1)
    error('patchnormals:inputs','The face list contains an vertex index smaller then 1')
end

[Nx,Ny,Nz]=patchnormals_double(double(FV.faces(:,1)),double(FV.faces(:,2)),double(FV.faces(:,3)),double(FV.vertices(:,1)),double(FV.vertices(:,2)),double(FV.vertices(:,3)));

N=zeros(length(Nx),3);
N(:,1)=Nx;
N(:,2)=Ny;
N(:,3)=Nz;


function ind = squareNeighbors2(RowsCols,Nid)
% return the neighbor ids in a square grid
%
%

[col,row] = meshgrid(1:RowsCols(2),1:RowsCols(1));

dRow = [1 -1 0  0 1  1 -1 -1];
dCol = [0  0 1 -1 1 -1  1 -1];

if nargin == 2
  ind = calcInd(Nid);
else

  ind = zeros([RowsCols,length(dRow)]);
  for Nid = 1:length(dRow)
    ind(:,:,Nid) = calcInd(Nid);
  end

end

  function indLocal = calcInd(Nid)

  nrow = row + dRow(Nid);
  ncol = col + dCol(Nid);

  % ensure coordinates are within the range
  ncol = max(min(ncol,RowsCols(2)),1);
  nrow = max(min(nrow,RowsCols(1)),1);

  indLocal = sub2ind(RowsCols,nrow,ncol);

  end

end


% op_rmNworstaverages.m
% Jamie Near, McGill University 2014.
%
% USAGE:
% [out,metric,badAverages]=op_rmNworstaverages(in,n);
%
% DESCRIPTION:
% Removes motion corrupted averages from a dataset containing multiple
% averages.  The N most badly motion corrupted averages are discarded.
%
% INPUTS:
% in         = input data in matlab structure format
% n          = number of bad averages to remove
%
% OUTPUTS:
% out         = Output dataset following removal of motion corrupted averages.
% metric      = Vector of unlikeness metrics corresponding to all input
%               averages.
% badAverages = Indices of the averages that were removed.

function [out,metric,badAverages]=op_rmNworstaverages(in,n);

if in.flags.averaged
    error('ERROR:  Averaging has already been performed!  Aborting!');
end

if ~in.flags.addedrcvrs
    error('ERROR:  Receivers should be combined first!  Aborting!');
end

%first, make a metric by subtracting all averages from the first average,
%and then taking the sum of all all the spectral points.
if in.dims.subSpecs>0
    SS=in.sz(in.dims.subSpecs);
else
    SS=1;
end
infilt=op_filter(in,10);
%inavg=op_averaging(infilt);
inavg=op_median(infilt);
for k=1:in.sz(in.dims.averages)
    for m=1:SS
            metric(k,m)=sum((real(infilt.specs(:,k,m))-(real(inavg.specs(:,m)))).^2);
    end
end

%find the average and standard deviation of the metric
avg=mean(metric);
stdev=std(metric);

%Now z-transform the metric so that it is centered about zero, and they
%have a standard deviation of 1.0.
zmetric=(metric-avg)/stdev;

for m=1:SS
    P(m,:)=polyfit([1:in.sz(in.dims.averages)]',zmetric(:,m),2);
    figure
    plot([1:in.sz(in.dims.averages)],zmetric(:,m),'.',[1:in.sz(in.dims.averages)],polyval(P(m,:),[1:in.sz(in.dims.averages)]));
end

%Now make a mask that represents the locations of the averages
%whose metric values are more than nsd standard deviations away from the
%mean metric value.

%first sort the zmetric array to find the n highest values:

[zmetric_sorted,inds]=sort(zmetric-polyval(P,[1:in.sz(in.dims.averages)])',1,'descend');

mask=zeros(size(zmetric));

for l=1:SS
    %mask(:,l)=metric(:,l)>(avg(l)+(nsd*stdev(l))) | metric(:,l)<(avg(l)-(nsd*stdev(l)));
    %mask(:,l)=metric(:,l)>(polyval(P(l,:),[1:in.sz(in.dims.averages)])'+(nsd*stdev(l))) | metric(:,l)<(polyval(P(l,:),[1:in.sz(in.dims.averages)])'-(nsd*stdev(l)));
    %mask(:,l)=metric(:,l)>(polyval(P(l,:),[1:in.sz(in.dims.averages)])'+(nsd*stdev(l)));
    %mask(:,l)=(metric(:,l)-polyval(P(l,:),[1:in.sz(in.dims.averages)])')==max((metric(:,l)-polyval(P(l,:),[1:in.sz(in.dims.averages)])'));
    for b=1:n
        mask(inds(b),l)=1;
    end
end

%Unfortunately, if one average is corrupted, then all of the subspecs
%corresponding to that average have to be thrown away.  Therefore, take the
%minimum intensity projection along the subspecs dimension to find out
%which averages contain at least one corrupted subspec:
if size(mask,2)>1
    mask=sum(mask')'>0;
end

%now the corrupted and uncorrupted average numbers are given by:
badAverages=find(mask);
goodAverages=find(~mask);

%make a new fids array containing only good averages
fids=in.fids(:,goodAverages,:,:);

%%re-calculate Specs using fft
specs=fftshift(ifft(fids,[],in.dims.t),in.dims.t);

%re-calculate the sz variable
sz=size(fids);

%FILLING IN DATA STRUCTURE
out=in;
out.fids=fids;
out.specs=specs;
out.sz=sz;
out.averages=length(goodAverages) * in.rawSubspecs;

%FILLING IN THE FLAGS
out.flags=in.flags;
out.flags.writtentostruct=1;


function [K] = ku1u1(x, xp, hyp, i)

logsigma = hyp(1);
logtheta = hyp(2);

n_x = size(x,1);
n_xp = size(xp,1);

x = repmat(x,1,n_xp);
xp = repmat(xp',n_x,1);

switch i

case 0

K=exp(1).^(logsigma+(-1/2).*exp(1).^((-1).*logtheta).*(x+(-1).*xp).^2);

case 1 % logsigma

K=exp(1).^(logsigma+(-1/2).*exp(1).^((-1).*logtheta).*(x+(-1).*xp).^2);

case 2 % logtheta

K=(1/2).*exp(1).^(logsigma+(-1).*logtheta+(-1/2).*exp(1).^((-1).*logtheta) ...
  .*(x+(-1).*xp).^2).*(x+(-1).*xp).^2;

otherwise

        K = zeros(n_x, n_xp);
end

if K == 0

    K = zeros(n_x, n_xp);

end

end


% predicting numerical values using Logistic Regression
clear all;
format long
disp('===== Logistic Regression ====');
disp('Reading featur vector');

for feat = 1:3
    featurs = csvread('data\forWeka_featuresonly.csv');
    num_data = 50%size(featurs,1); %5000;
    disp(sprintf('Number of datapoints %d',num_data))

    possiblefeaturizations =  {'bernouli', 'tfidf','multinomial'};
    %featurization = 'bernouli'%'tfidf'%'tfidf'%'multinomial'%'tfidf' %'multinomial'; % 'bernouli', 'tfidf'
    featurization  = possiblefeaturizations{feat}

    featurs = featurs(:,2:size(featurs,2));
    if strcmp(featurization,'multinomial')
        %just pass
    elseif strcmp(featurization,'bernouli')
        featurs = double(featurs>0);
    elseif strcmp(featurization,'tfidf')
        occurance = (featurs>0);
        idf = log(size(featurs,1)./sum(occurance));
        featurs = featurs.*repmat( idf, size(featurs,1),1);
    end

    size_training = floor(.8*num_data);

    trainingset = featurs(1:size_training,:);
    testset = featurs((size_training+1):num_data,:);

    disp('Splitting up data into training/test sets');
    [num,txt,raw] = xlsread('data\final104.xls');

    % reading the description of each shoe
    descriptions = raw(2:size(raw,1),2);
    style_ratings = num(1:size(num,1),1);
    comfort_ratings = num(1:size(num,1),4);
    overal_ratings = num(1:size(num,1),5);

    % only take m data points
    m=num_data;
    descriptions = descriptions(1:m);
    style_ratings = style_ratings(1:m);
    comfort_ratings = comfort_ratings(1:m);
    overal_ratings = overal_ratings(1:m);

    responsevals = [style_ratings, comfort_ratings, overal_ratings];

    responsevals_training = responsevals(1:size_training,:);
    responsevals_test = responsevals((size_training+1):num_data,:);

    disp('Logistic Regression');
    %

    tic;

    predictions = [];
    actual = [];
    for i =1:3
        a = responsevals_training(:,i);
        b = responsevals_test(:,i)';
        [COEFF,SCORE] = princomp(trainingset);
        regresscoeff = mnrfit(SCORE,a);
        C2 = (regresscoeff'*(testset'));
        predictions = [predictions, C2'];
        actual = [actual, b'];
    end

    MSE = mean(sum(((predictions-actual).^2)'))
    toc;

end


function [parameters, LL, ht, VCVrobust, VCV, scores, diagnostics] = tarch(epsilon, p, o, q, error_type, tarch_type, startingvals, options)
% TARCH(P,O,Q) parameter estimation with different error distributions:
% Normal, Students-T, Generalized Error Distribution, Skewed T
% Estimation of ARCH or GARCH models if o=0 and tarch_type=2
% Estimation of TARCH or GJR asymmetric models if o>0 and tarch_type=1 or 2
%
% USAGE:
%   [PARAMETERS] = tarch(EPSILON,P,O,Q)
%   [PARAMETERS,LL,HT,VCVROBUST,VCV,SCORES,DIAGNOSTICS] =
%                                   tarch(EPSILON,P,O,Q,ERROR_TYPE,TARCH_TYPE,STARTINGVALS,OPTIONS)
%
% INPUTS:
%   EPSILON      - A column of mean zero data
%   P            - Positive, scalar integer representing the number of symmetric innovations
%   O            - Non-negative scalar integer representing the number of asymmetric innovations (0
%                    for symmetric processes)
%   Q            - Non-negative, scalar integer representing the number of lags of conditional
%                    variance (0 for ARCH)
%   ERROR_TYPE   - [OPTIONAL] The error distribution used, valid types are:
%                    'NORMAL'    - Gaussian Innovations [DEFAULT]
%                    'STUDENTST' - T distributed errors
%                    'GED'       - Generalized Error Distribution
%                    'SKEWT'     - Skewed T distribution
%   TARCH_TYPE   - [OPTIONAL] The type of variance process, either
%                    1 - Model evolves in absolute values
%                    2 - Model evolves in squares [DEFAULT]
%   STARTINGVALS - [OPTIONAL] A (1+p+o+q), plus 1 for STUDENTST OR GED (nu), plus 2 for SKEWT
%                    (nu,lambda), vector of starting values.
%                     [omega alpha(1) ... alpha(p) gamma(1) ... gamma(o) beta(1) ... beta(q) [nu lambda]]'.
%   OPTIONS      - [OPTIONAL] A user provided options structure. Default options are below.
%
% OUTPUTS:
%   PARAMETERS   - A 1+p+o+q column vector of parameters with
%                  [omega alpha(1) ... alpha(p) gamma(1) ... gamma(o) beta(1) ... beta(q) [nu lambda]]'.
%   LL           - The log likelihood at the optimum
%   HT           - The estimated conditional variances
%   VCVROBUST    - Robust parameter covariance matrix
%   VCV          - Non-robust standard errors (inverse Hessian)
%   SCORES       - Matrix of scores (# of params by t)
%   DIAGNOSTICS  - Structure of optimization outputs and other values useful for functions calling TARCH.
%
% COMMENTS:
% The following (generally wrong) constraints are used:
%   (1) omega > 0
%   (2) alpha(i) >= 0 for i = 1,2,...,p
%   (3) gamma(i) + alpha(i) > 0 for i=1,...,o
%   (3) beta(i)  >= 0 for i = 1,2,...,q
%   (4) sum(alpha(i) + 0.5*gamma(j) + beta(k)) < 1 for i = 1,2,...p and
%   j = 1,2,...o, k=1,2,...,q
%   (5) nu>2 of Students T and nu>1 for GED
%   (6) -.99<lambda<.99 for Skewed T
%
%   The conditional variance, h(t), of a TARCH(P,O,Q) process is modeled as follows:
%
%    g(h(t)) = omega
%            + alpha(1)*f(r_{t-1}) + ... + alpha(p)*f(r_{t-p})+...
%            + gamma(1)*I(t-1)*f(r_{t-1}) +...+ gamma(o)*I(t-o)*f(r_{t-o})+...
%            beta(1)*g(h(t-1)) +...+ beta(q)*g(h(t-q))
%
%     where f(x) = abs(x)  if tarch_type=1
%          g(x) = sqrt(x) if tarch_type=1
%          f(x) = x^2     if tarch_type=2
%          g(x) = x       if tarch_type=2
%
%   Default Options
%    options  =  optimset('fminunc');
%    options  =  optimset(options , 'TolFun'      , 1e-005);
%    options  =  optimset(options , 'TolX'        , 1e-005);
%    options  =  optimset(options , 'Display'     , 'iter');
%    options  =  optimset(options , 'Diagnostics' , 'on');
%    options  =  optimset(options , 'LargeScale'  , 'off');
%    options  =  optimset(options , 'MaxFunEvals' , '400*numberOfVariables');
%
%  See also TARCH_LIKELIHOOD, TARCH_CORE, TARCH_PARAMETER_CHECK, TARCH_STARTING_VALUES,
%  TARCH_TRANSFORM, TARCH_ITRANSFORM
%
%  You should use the MEX files (or compile if not using Win64 Matlab) as they provide speed ups of
%  approx 100 times relative to the m file.

% Copyright: Kevin Sheppard
% kevin.sheppard@economics.ox.ac.uk
% Revision: 3    Date: 9/1/2005

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Input Checking
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
switch nargin
    case 4
        [p,o,q,error_type,tarch_type,startingvals,options]=tarch_parameter_check(epsilon, p, o, q);
    case 5
        [p,o,q,error_type,tarch_type,startingvals,options]=tarch_parameter_check(epsilon, p, o, q, error_type);
    case 6
        [p,o,q,error_type,tarch_type,startingvals,options]=tarch_parameter_check(epsilon, p, o, q, error_type, tarch_type);
    case 7
        [p,o,q,error_type,tarch_type,startingvals,options]=tarch_parameter_check(epsilon, p, o, q, error_type, tarch_type, startingvals);
    case 8
        [p,o,q,error_type,tarch_type,startingvals,options]=tarch_parameter_check(epsilon, p, o, q, error_type, tarch_type, startingvals, options);
    otherwise
        error('Number of inputs must be between 4 and 8');
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Input Checking
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%Initial setup
m  =  max([p o q]);

%Augment the data with back casts to avoid costly memory allocations
if tarch_type==1
    %fepsilon is f(epsilon), as above
    fepsilon   =  [mean(abs(epsilon))*ones(m,1) ; abs(epsilon)];
    %fIepsilon is fepsilon*(epsilon<0)
    fIepsilon   =  [0.5*mean(abs(epsilon))*ones(m,1) ; abs(epsilon).*(epsilon<0)];

    % Local back casting
    back_cast_length = max(floor(length(epsilon)^(1/2)),1);
    back_cast_weights = .05*(.9.^(0:back_cast_length ));
    back_cast_weights = back_cast_weights/sum(back_cast_weights);
    back_cast = back_cast_weights*(abs(epsilon(1:back_cast_length+1)));
    if back_cast==0
        back_cast=mean(abs(epsilon));
    end
else
    %fepsilon is f(epsilon), as above
    fepsilon   =  [mean(epsilon.^2)*ones(m,1) ; epsilon.^2];
    %fIepsilon is fepsilon*(epsilon<0)
    fIepsilon   =  [0.5*mean(epsilon.^2)*ones(m,1) ; epsilon.^2.*(epsilon<0)];
    % Local back casting
    back_cast_length = max(floor(length(epsilon)^(1/2)),1);
    back_cast_weights = .05*(.9.^(0:back_cast_length ));
    back_cast_weights = back_cast_weights/sum(back_cast_weights);
    back_cast = back_cast_weights*((epsilon(1:back_cast_length+1)).^2);
    if back_cast==0
        back_cast=mean(epsilon.^2);
    end
end
epsilon_augmented=[zeros(m,1);epsilon];
%Compute the length of the augmented epsilon
T     = size(fepsilon,1);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%Starting values
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%This flag is for the robustness check below, if the user supplies starting
%values, there will be no robustness check
if isempty(startingvals)
    startingflag=0;
else
    startingflag=1;
end
%Grid search for starting values.
[startingvals,nu,lambda,~,ordered_parameters]=tarch_starting_values(startingvals,epsilon_augmented,fepsilon,fIepsilon,p,o,q,T,error_type,tarch_type);
%Finally, initialize the starting values
startingvals = [startingvals; nu; lambda];
%Transform the starting vals
[garch_params_transformed,nu_transformed,lambda_transformed]=tarch_transform(startingvals,p,o,q,error_type);
%Re-append nu, lambda
startingvals_transformed = [garch_params_transformed; nu_transformed; lambda_transformed];
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%Starting values
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Estimate the parameters. Note the 1 in the last argument to indicate it
% is a constrained optimization

%LL0 is used to make sure the log likelihood improves
LL0=tarch_likelihood(startingvals_transformed,epsilon_augmented,fepsilon,fIepsilon,p,o,q,error_type,tarch_type,back_cast,T,1);
%Parameter estimation
[parameters,LL,exitflag,output]=fminunc('tarch_likelihood',startingvals_transformed,options,epsilon_augmented,fepsilon,fIepsilon,p,o,q,error_type,tarch_type,back_cast,T,1);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%Estimation Robustness
%This portion of the code is to make sure that the optimization converged
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%This is the case where the optimization did not converge, but improved on
%the initial log likelihood
if  exitflag<=0 && LL<LL0
    %Try more iterations, only do more iterations if the final likelihood is
    %actually better than the initial

    %Increase the max iterations and max fun evals
    %Also switch to steepest descent
    if ischar(options.MaxFunEvals)
        options.MaxIter=2*100*length(parameters);
    else
        options.MaxIter=2*options.MaxIter;
    end
    if ischar(options.MaxFunEvals)
        options.MaxFunEvals=4*100*length(parameters);
    else
        options.MaxFunEvals=2*options.MaxFunEvals;
    end
    options.HessUpdate='steepdesc';
    % Estimate the parameters.
    [parameters,LL,exitflag,output]=fminunc('tarch_likelihood',parameters,options,epsilon_augmented,fepsilon,fIepsilon,p,o,q,error_type,tarch_type,back_cast,T,1);
end

%If the optimization still hasn't converged, try other starting values
if startingflag==0 && exitflag<=0
    %Keep track of the final estimates, if nothing converges, we will
    %return the
    robust_parameters(1,:)=parameters';
    %Also keep the LL
    robust_LL = zeros(2,1);
    robust_LL(1) = LL;
    %Keep track of the iteration
    index=2;
    while exitflag<=0
        %This condition checks that we haven't converged
        %OR that the best objective is worse than best grid search
        %Sort the original grid search log likelihoods and parameters

        startingvals=[ordered_parameters(index,:)' ; nu; lambda];
        %Transform the starting vals
        [garch_params_transformed,nu_transformed,lambda_transformed]=tarch_transform(startingvals,p,o,q,error_type);
        %Reappend nu
        startingvals_transformed = [garch_params_transformed; nu_transformed; lambda_transformed];

        LL0=tarch_likelihood(startingvals_transformed,epsilon_augmented,fepsilon,fIepsilon,p,o,q,error_type,tarch_type,back_cast,T,1);
        options.HessUpdate='bfgs';
        %Try the second set of starting values
        [parameters,LL,exitflag,output]=fminunc('tarch_likelihood',startingvals_transformed,options,epsilon_augmented,fepsilon,fIepsilon,p,o,q,error_type,tarch_type,back_cast,T,1);
        if  exitflag<=0 && LL<LL0
            %Again, if the LL improved, try more iterations
            %Increase the max iterations and max fun evals
            %Also switch to steepest descent
            options.MaxIter=2*options.MaxIter;
            options.MaxFunEvals=2*options.MaxFunEvals;
            options.HessUpdate='steepdesc';
            % Estimate the parameters.
            [parameters,LL,exitflag,output]=fminunc('tarch_likelihood',parameters,options,epsilon_augmented,fepsilon,fIepsilon,p,o,q,error_type,tarch_type,back_cast,T,1);
        end
        %Save the parameter estimates
        robust_parameters(index,:)=parameters';
        robust_LL(index)=LL;
        %Increment the index
        index=index+1;

        if index>size(ordered_parameters,1);
            %save the best LL and parameters and break
            warning('MFEToolbox:Convergence','Convergence not achieved.  Use results with caution');
            [LL,index]=min(robust_LL);
            parameters=robust_parameters(index,:)';
            break
        end
    end
end

%Transform the parameters from the real line to the restricted space
[parameters,nu,lambda]=tarch_itransform(parameters,p,o,q,error_type);
parameters=[parameters;nu;lambda];
%Compute the log likelihood if needed
if nargout>1
    [LL, ~, ht]=tarch_likelihood(parameters,epsilon_augmented,fepsilon,fIepsilon,p,o,q,error_type,tarch_type,back_cast,T);
    LL=-LL;
end

%Compute standard errors using RobustVCV if needed.
if nargout>3
    nw=0; %No newey west on scores
    [VCVrobust,A,~,scores,hess]=robustvcv('tarch_likelihood',parameters,nw,epsilon_augmented,fepsilon,fIepsilon,p,o,q,error_type,tarch_type,back_cast,T);
    VCV=hess^(-1)/(T-m);
    diagnostics.A = A;
end

%Report diagnostics in case requested
diagnostics.EXITFLAG=exitflag;
diagnostics.ITERATIONS=output.iterations;
diagnostics.FUNCCOUNT=output.funcCount;
diagnostics.MESSAGE=output.message;
diagnostics.m = m;
diagnostics.T = T;
diagnostics.fdata = fepsilon;
diagnostics.fIdata = fIepsilon;
diagnostics.back_cast = back_cast;


function PSNRdb = PSNR(x, y)

err = x - y;
err = err(:);
PSNRdb = 20 * log10(256/sqrt(mean(err .^2)));


function [ lo, hi ] = p02_box ( m )

%*****************************************************************************80
%
%% P02_BOX returns a bounding box for problem 02.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 April 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Per-Olof Persson and Gilbert Strang,
%    A Simple Mesh Generator in MATLAB,
%    SIAM Review,
%    Volume 46, Number 2, June 2004, pages 329-345.
%
%  Parameters:
%
%    Input, integer M, the spatial dimension.
%
%    Output, real LO(M), HI(M), the low and high corners of the box.
%
  center = [ 0.0, 0.0 ];
  r1 = 1.0;
  r2 = 0.4;

  lo(1:m) = [ center(1) - r1, center(2) - r1 ];
  hi(1:m) = [ center(1) + r1, center(2) + r1 ];

  return
end


function [err, time] = spincomp(S, N, dt, pref)
%SPINCOMP  Compare time-stepping schemes in 1D/2D/3D.
%   SPINCOMP(S, N, DT, PREF) compares the time-stepping schemes in PREF.SCHEME
%   applied to the PDE specified by the SPINOP/SPINOP2/SPINOP3 S, using a fixed
%   number N of grid points and different time-steps DT. The results are shown
%   in a pair of log-log plots. PREF is a SPINPREF/SPINPREF2/SPINPREF3 object.
%
%   [ERR, TIME] = SPINCOMP(S, N, DT, PREF) returns the errors and the computer
%   times.
%
% Example 1: Compare the ETDRK schemes for 1D Kuramoto-Sivashinsky equation
%
%   dom = [0 32*pi]; tspan = [0 30];
%   u0 = chebfun('cos(x/16).*(1 + sin(x/16))',dom,'trig');
%   S = spinop('KS');
%   S.init = u0; S.tspan = tspan;
%   N = 256; dt = [1, 5e-1, 2e-1, 1e-1, 5e-2, 2e-2];
%   pref = spinpref;
%   pref.scheme = {'etdrk4', 'exprk5s8', 'krogstad', 'friedli', ...
%      'hochbruck-ostermann', 'minchev', 'strehmel-weiner'};
%   spincomp(S, N, dt, pref);
%
% Example 2: Compare the PREDICTOR-CORRECTOR schemes for 2D Gray-Scott equations
%
%   G = 3; dom = G*[0 1 0 1]; tspan = [0 10];
%   u01 = chebfun2(@(x,y) 1-exp(-150*((x-G/2).^2 + (y-G/2).^2)), dom, 'trig');
%   u02 = chebfun2(@(x,y) exp(-150*((x-G/2).^2 + 2*(y-G/2).^2)), dom, 'trig');
%   u0 = chebmatrix(u01);
%   u0(2,1) = u02;
%   S = spinop2('GS'); S.init = u0; S.tspan = tspan;
%   N = 128; dt = [1, 5e-1, 2e-1, 5e-2, 2e-2];
%   pref = spinpref2;
%   pref.scheme = {'pec423', 'pecec433', 'pec524', 'pecec534', 'pec625', ...
%      'pecec635', 'pec726', 'pecec736'};
%   spincomp(S, N, dt, pref);
%
% See also SPINOP, SPINOP2, SPINOP3, SPINSCHEME.
%
% Copyright 2017 by The University of Oxford and The Chebfun Developers.
% See http://www.chebfun.org/ for Chebfun information.

% Get the schemes:
schemes = pref.scheme;
nSchemes = length(schemes);

% Get the time-steps:
timesteps = dt;
nTimesteps = length(timesteps);

% Convert the initial conditiona to a CHEBMATRIX:
u0 = S.init;
if ( isa(u0, 'chebfun') == 1 || isa(u0, 'chebfun2') == 1 || ...
    isa(u0, 'chebfun3') == 1)
    u0 = chebmatrix(u0);
elseif ( isa(u0, 'chebfun2v') == 1 || isa(u0, 'chebfun3v') == 1 )
    temp = chebmatrix(u0(1));
    for k = 2:size(u0, 1)
        temp(k,1) = u0(k);
    end
    u0 = temp;
end
nVars = length(u0);

% Create a grid to compare exact and computed solutions:
dom = u0{1}.domain;
xx = trigpts(32, dom);
if ( isa(u0{1}, 'chebfun') == 1 )
    dim = 1;
elseif ( isa(u0{1}, 'chebfun2') == 1 )
    dim = 2;
    [xx, yy] = meshgrid(xx);
elseif ( isa(u0{1}, 'chebfun3') == 1 )
    dim = 3;
    [xx, yy, zz] = meshgrid(xx);
end

% First, estimate the exact solution using a very small time step (half the
% smallest time-step) and with PECEC736 (7th-order multistep scheme):
if ( isa(pref, 'spinpref') == 1 )
    prefu = spinpref();
elseif ( isa(pref, 'spinpref2') == 1 )
    prefu = spinpref2();
elseif ( isa(pref, 'spinpref3') == 1 )
    prefu = spinpref3();
end
prefu.scheme = 'pecec736';
prefu.plot = 'off';
prefu.M = pref.M;
uexact = spinoperator.solvepde(S, N, min(timesteps)/2, prefu);
if ( isa(uexact, 'chebmatrix') == 0 )
    uexact = chebmatrix(uexact);
end

% Scale (i.e., maximum amplitude) of the exact solution:
scale = 0;
for i = 1:nVars
    if ( dim == 1 )
        scale = max(scale, max(abs(uexact{i}(xx))));
    elseif( dim == 2 )
        scale = max(scale, max(max(abs(uexact{i}(xx,yy)))));
    elseif ( dim == 3 )
        scale = max(scale, max(max(max(abs(uexact{i}(xx,yy,zz))))));
    end
end

% Second, compute solutions for different schemes and time-steps:
err = zeros(nTimesteps, nSchemes);
time = zeros(nTimesteps, nSchemes);
for k = 1:nTimesteps
    for l = 1:nSchemes
        prefu.scheme = schemes{l};
        [u, ~, t] = spinoperator.solvepde(S, N, timesteps(k), prefu);
        time(k,l) = t;
        if ( isa(u, 'chebmatrix') == 0 )
            u = chebmatrix(u);
        end
        isNan = isNanTest(u, dim);
        if ( isNan == 1 )
            err(k,l) = NaN;
        else
            for i = 1:nVars
                if ( dim == 1 )
                    temp = abs(u{i}(xx) - uexact{i}(xx));
                elseif( dim == 2 )
                    temp = abs(u{i}(xx,yy) - uexact{i}(xx,yy));
                elseif ( dim == 3 )
                    temp = abs(u{i}(xx,yy,zz) - uexact{i}(xx,yy,zz));
                end
                temp = max(temp(:));
                err(k,l) = max(err(k,l), temp);
            end
        end
    end
end
err = err/scale; % Relative error
tspan = S.tspan;
TF = tspan(end);
timesteps = timesteps/TF; % Relative time-steps

% Plot Accuarcy vs time-step:
figure, subplot(1, 2, 1)
labels = cell(nSchemes, 1);
for l = 1:nSchemes
    labels{l} = schemes{l};
    if ( l > 1 )
        hold on
    end
    if ( l < 8 )
        loglog(timesteps, err(:, l), '.-', 'linewidth', 2, 'markersize', 30)
    elseif ( l < 15 )
        loglog(timesteps, err(:, l), 'x-', 'linewidth', 2, 'markersize', 10)
    else
        loglog(timesteps, err(:, l), 'o-', 'linewidth', 2, 'markersize', 10)
    end
end
left = 10^floor(log10(min(timesteps)));
right = 10^ceil(log10(max(timesteps)));
down = max(min(1e-10, 10^floor(log10(min(err(:))))), 1e-12);
up = min(max(1e0, 10^ceil(log10(max(err(:))))), 1e2);
set(gca, 'fontsize', 16), axis([left right down up])
xlabel('Relative time-step'), ylabel(sprintf('Relative error at t = %.3f', TF))
legend(labels, 'Location', 'NorthWest')

% Plot Accuarcy vs computer time:
subplot(1, 2, 2)
for l = 1:nSchemes
    if ( l > 1 )
        hold on
    end
    if ( l < 8 )
        loglog(time(:,l), err(:, l), '.-', 'linewidth', 2, 'markersize', 30)
   elseif ( l < 15 )
        loglog(time(:,l), err(:, l), 'x-', 'linewidth', 2, 'markersize', 10)
    else
        loglog(time(:,l), err(:, l), 'o-', 'linewidth', 2, 'markersize', 10)
    end
end
left = 10^(floor(log10(min(min(time)))));
right = 10^(ceil(log10(max(max(time)))));
set(gca, 'fontsize', 16), axis([left right down up])
xlabel('Computer time (s)'), ylabel(sprintf('Relative error at t = %.3f', TF))
legend(labels, 'Location', 'NorthEast')

end

function out = isNanTest(u, dim)

B = u.blocks;
if ( dim == 1 )
    out = any(cell2mat(cellfun(@(C) isnan(C), B, 'UniformOutput', 0)));
elseif ( dim == 2 )
    out = any(cell2mat(cellfun(@(C) isnan(C.cols), B, 'UniformOutput', 0)));
    out = out || ...
        any(cell2mat(cellfun(@(C) isnan(C.rows), B, 'UniformOutput', 0)));
elseif ( dim == 3 )
    out = any(cell2mat(cellfun(@(C) isnan(C.cols), B, 'UniformOutput', 0)));
    out = out || ...
        any(cell2mat(cellfun(@(C) isnan(C.rows), B, 'UniformOutput', 0)));
    out = out || ...
        any(cell2mat(cellfun(@(C) isnan(C.tubes), B, 'UniformOutput', 0)));
end

end


function [idx, iter, obj, H] = symnmf_cluster(X, k, options)
%SYMNMF_CLUSTER
% [idx, iter, obj, H] = symnmf_cluster(X, k, options)
%
% This function performs graph clustering on a data matrix.
%
% Input:
% X - NxP data matrix (N observations with dimension P),
%     where each row is one observation,
%     and each column is one feature/variable.
%     (If an NxN similarity matrix is available,
%      please call 'symnmf_anls' directly.)
% k - Specifying the number of clusters.
% options - A structure of optional parameters for
%           clustering (see details below).
%
% Default configurations:
%   options.graph_type = 'sparse';
%   options.similarity_type = 'gaussian';
%   options.graph_objfun = 'ncut';
%   (no options.kk given)
%   options.nn = 7;
%   options.tol = 1e-3;
%   options.maxiter = 10000;
%   options.rep = 1;
%   (no options.Hinit given)
%   options.computeobj = true;
%   options.alg = 'anls';
%
% Output:
% idx - Nx1 vector, containing the clustering assignment
%       of each observation.
% iter - Number of iterations actually used
% obj - Final value of the objective function
%           f(H) = ||A - HH'||_F^2
% H - Final result of low-rank matrix H
%
% Available options:
% 1. options.graph_type
%    = 'full': to construct a fully-connected graph
%    = 'sparse': to construct a sparse graph where
%                each observation is connected to
%                its KK nearest neighbors. (DEFAULT)
%
%    (Note: Only undirected graph is supported,
%           so the resulting similarity matrix
%           is symmetric.)
%
% 2. options.similarity_type
%    = 'gaussian': to use self-tuning Gaussian similarity,
%                  proposed in [Zelnik-Manor and Perona,
%                  2004] (see more details in functions
%                  'scale_dist3' and 'scale_dist3_knn') (DEFAULT)
%    = 'inner_product': to use inner product similarity
%                       (good choice for text data)
%
% 3. options.graph_objfun
%    = 'ncut': to use normalized cut (DEFAULT)
%    = 'rcut': to use ratio cut
%
% 4. options.kk (DEFAULT is unset, i.e. depending on N)
%    specifies the number of nearest neighbors WHEN
%    options.graph_type = 'sparse'.
%
%    The default value depends on N:
%    option.kk = floor(log2(N)) + 1;
%
% 5. options.nn (DEFAULT is 7)
%    specifies the nn-th neighbor, which is used in
%    the self-tuning Gaussian similarity WHEN
%    options.similarity_type = 'gaussian'.
%
% 6. options.tol (DEFAULT is 1e-3)
%    controls the termination of SymNMF algorithm.
%
% 7. options.maxiter (DEFAULT is 10000)
%    limits the number of iteration allowed in each run.
%
% 8. options.rep (DEFAULT is 1)
%    sets the nubmer of runs of SymNMF algorithm.
%
%    The return values 'idx', 'iter', 'obj', and 'H' are
%    corresponding to a single run, which is the run that
%    yields the lowest objective function value.
%
%    Using multiple runs of SymNMF may help avoid local minima.
%
% 9. options.Hinit (DEFAULT is unset, i.e. random initialization)
%    sets the initialization of matrix H in each run.
%
%    options.Hinit is a 3-dim array. The 3rd dimension may imply
%    the choice of options.rep, and each 2-dim array in the 1st
%    and 2nd dimensions is a NxK nonnegative matrix.
%
%    Random initialization is recommended. If options.Hinit has to
%    be a fixed set of matrices for testing, the instructions on
%    how to initialize H should be followed. Please consult the
%    usage of 'symnmf_newton'.
%
% 10. options.computeobj (DEFAULT is true)
%     specifies whether to compute the objective value
%     f(H) at the final solution H.
%
% 11. options.alg
%     = 'anls' to use ANLS algorithm (DEFAULT)
%     = 'newton' to use Newton-like algorithm
%
% This function is used for experiments in the following paper:
%     Da Kuang, Chris Ding, Haesun Park,
%     Symmetric Nonnegative Matrix Factorization for Graph Clustering,
%     The 12th SIAM International Conference on Data Mining (SDM '12), pp. 106--117.
% Please cite this paper if you find this code useful.
%

[n, p] = size(X);

if ~exist('options', 'var')
    graph_type = 'sparse';
    similarity_type = 'gaussian';
    graph_objfun = 'ncut';
    kk = floor(log2(n)) + 1;
    nn = 7;
    tol = 1e-3;
    maxiter = 10000;
    rep = 1;
    Hinit = [];
    computeobj = true;
    alg = 'anls';
else
    if isfield(options, 'graph_type')
        graph_type_names = {'full', 'sparse'};
        j = find(strcmpi(options.graph_type, graph_type_names));
        if ~isempty(j)
            graph_type = graph_type_names{j};
        else
            error('Invalid options.graph_type value!');
        end
    else
        graph_type = 'sparse';
    end
    if isfield(options, 'similarity_type')
        similarity_type_names = {'gaussian', 'inner_product'};
        j = find(strcmpi(options.similarity_type, similarity_type_names));
        if ~isempty(j)
            similarity_type = similarity_type_names{j};
        else
            error('Invalid options.similarity_type value!');
        end
    else
        similarity_type = 'gaussian';
    end
    if isfield(options, 'graph_objfun')
        graph_objfun_names = {'ncut', 'rcut'};
        j = find(strcmpi(options.graph_objfun, graph_objfun_names));
        if ~isempty(j)
            graph_objfun = graph_objfun_names{j};
        else
            error('Invalid options.graph_objfun value!');
        end
    else
        graph_objfun = 'ncut';
    end
    if isfield(options, 'kk')
        if ~isempty(options.kk) & isnumeric(options.kk) & options.kk < n
            kk = options.kk;
        else
            error('options.kk must be an integer less than N!');
        end
    else
        kk = floor(log2(n)) + 1;
    end
    if isfield(options, 'nn')
        if ~isempty(options.nn) & isnumeric(options.nn) & options.nn < n
            nn = options.nn;
        else
            error('options.nn must be an integer less than N!');
        end
    else
        nn = 7;
    end
    if isfield(options, 'tol')
        if ~isempty(options.tol) & isnumeric(options.tol) & options.tol > 0 & options.tol < 1
            tol = options.tol;
        else
            error('options.tol must be a real number and 0 < options.tol < 1!');
        end
    else
        tol = 1e-3;
    end
    if isfield(options, 'maxiter')
        if ~isempty(options.maxiter) & isnumeric(options.maxiter) & options.maxiter > 0
            maxiter = options.maxiter;
        else
            error('options.maxiter must be a positive integer!');
        end
    else
        maxiter = 10000;
    end
    if isfield(options, 'rep')
        if ~isempty(options.rep) & isnumeric(options.rep) & options.rep > 0
            rep = options.rep;
        else
            error('options.rep must be a positive integer!');
        end
        if isfield(options, 'Hinit') & size(options.Hinit, 3) ~= rep
            error('The third dimension of options.Hinit must match options.rep!')
        end
    else
        if isfield(options, 'Hinit') & ~isempty(options.Hinit)
            rep = size(options.Hinit, 3);
        else
            rep = 1;
        end
    end
    if isfield(options, 'Hinit')
        if ~isempty(options.Hinit) & isnumeric(options.Hinit) & size(options.Hinit, 1) == n & size(options.Hinit, 2) == k
            Hinit = options.Hinit;
        else
            error('The size of each initialization of H must be Nxk!');
        end
    else
        Hinit = [];
    end
    if isfield(options, 'computeobj')
        if ~isempty(options.computeobj) & (isnumeric(options.computeobj) | isboolean(options.computeobj))
            computeobj = options.computeobj;
        else
            error('options.computeobj must be boolean or a real number!');
        end
    else
        computeobj = true;
    end
    if computeobj == false & rep > 1
        error('options.computeobj must be true if options.rep > 1!');
    end
    if isfield(options, 'alg')
        alg_names = {'anls', 'newton'};
        j = find(strcmpi(options.alg, alg_names));
        if ~isempty(j)
            alg = alg_names{j};
        else
            error('Invalid options.alg value!');
        end
    else
        alg = 'anls';
    end
end

D = dist2(X, X);
if strcmp(graph_type, 'full') & strcmp(similarity_type, 'gaussian')
    A = scale_dist3(D, nn);
elseif strcmp(graph_type, 'full') & strcmp(similarity_type, 'inner_product')
    A = X * X';
elseif strcmp(graph_type, 'sparse') & strcmp(similarity_type, 'gaussian')
    A = scale_dist3_knn(D, nn, kk, true);
else % graph_type == 'sparse' & similarity_type == 'inner_product'
    Xnorm = X';
    d = 1./sqrt(sum(Xnorm.^2));
    Xnorm = bsxfun(@times, Xnorm, d);
    A = inner_product_knn(D, Xnorm, knn, true);
    clear Xnorm, d;
end
clear D;

if strcmp(graph_objfun, 'ncut')
    dd = 1 ./ sum(A);
    dd = sqrt(dd);
    A = bsxfun(@times, A, dd);
    A = A';
    A = bsxfun(@times, A, dd);
    clear dd;
end
A = (A + A') / 2;

params.maxiter = maxiter;
params.tol = tol;

obj_best = Inf;
for i = 1 : rep
    if isempty(Hinit)
        if strcmp(alg, 'newton')
            [sol, infos] = symm_newton(A, k, params);
        else % strcmp(alg, 'anls')
            [sol, infos] = symm_anls(A, k, params);
        end
    else
        params.Hinit = Hinit(:, :, i);
        if strcmp(alg, 'newton')
            [sol, infos] = symm_newton(A, k, params);
        else % strcmp(alg, 'anls')
            [sol, infos] = symm_anls(A, k, params);
        end
    end
    H = sol.H;
    [max_val, idx] = max(H, [], 2);
    if infos.cost(end) < obj_best
        idx_best = idx;
        iter_best = infos.iter(end);
        obj_best = infos.cost(end);
        H_best = H;
    end
end

idx = idx_best;
iter = iter_best;
obj = obj_best;
H = H_best;


function point_merge_test04 ( m, n, n_unique, tol, seed )

%*****************************************************************************80
%
%% POINT_MERGE_TEST04 tests uniqueness indexing with a tolerance.
%
%  Discussion:
%
%    POINT_RADIAL_TOL_UNIQUE_COUNT uses an algorithm that should be,
%      in general, O(N);
%    POINT_TOL_UNIQUE_COUNT uses an O(N^2) algorithm.
%
%    For this test, we just want to make sure the algorithms agree
%    in the counting.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    24 July 2010
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'POINT_MERGE_TEST04\n' );
  fprintf ( 1, '  To index the unique columns in an R8COL, we call\n' );
  fprintf ( 1, '  POINT_RADIAL_TOL_UNIQUE_COUNT, (with random center)\n' );
  fprintf ( 1, '  POINT_TOL_UNIQUE_COUNT, (with zero tolerance)\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  M = %d\n', m );
  fprintf ( 1, '  N = %d\n', n );
  fprintf ( 1, '  TOL = %f\n', tol );
  fprintf ( 1, '  SEED = %d\n', seed );

  [ a, seed ] = r8col_duplicates ( m, n, n_unique, seed );

  r8mat_transpose_print ( m, n, a, '  Matrix with N_UNIQUE unique columns:' );
%
%  The form of the tolerance test means that if two vectors are initially
%  equal, they remain "tolerably equal" after the addition of random
%  perturbation vectors whose 2-norm is no greater than TOL/2.
%
  for j = 1 : n
    [ r, seed ] = r8vec_uniform_01 ( m, seed );
    r(1:m) = r(1:m) / sqrt ( sum ( r(1:m).^2 ) );
    a(1:m,j) = a(1:m,j) + 0.5 * tol * r(1:m,1);
  end

  r8mat_transpose_print ( m, n, a, '  Blurred matrix:' );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  N_UNIQUE =                      %d\n', n_unique );

  [ unique_num, undx, xdnu, seed ] = point_radial_tol_unique_index ( m, n, a, ...
    tol, seed );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  POINT_RADIAL_TOL_UNIQUE_INDEX\n' );
  fprintf ( 1, '  Unique_num = %d\n', unique_num );

  i4vec_print ( unique_num, undx, '  UNDX:' );

  i4vec_print ( n, xdnu, '  XDNU:' );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  List of nonunique points P(J), represented by\n' );
  fprintf ( 1, '  point with index I(J).\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  J, P(J)\n' );
  fprintf ( 1, '  I(J), P(I(J))\n' );
  fprintf ( 1, '  || P(J) - P(I(J)) || (should be <= TOL)\n' );
  fprintf ( 1, '\n' );
  for j = 1 : n
    k = undx(xdnu(j));
    if ( j ~= k )
      fprintf ( 1, '\n' );
      fprintf ( 1, '  %4d', j );
      for i = 1 : m
        fprintf ( 1, '  %14f', a(i,j) );
      end
      fprintf ( 1, '\n' );
      fprintf ( 1, '  %4d', k );
      for i = 1 : m
        fprintf ( 1, '  %14f', a(i,k) );
      end
      fprintf ( 1, '\n' );
      dist = sqrt ( sum ( ( a(1:m,j) - a(1:m,k) ).^2 ) );
      fprintf ( 1, '          %10f\n', dist );
    end
  end
%
%  The interpretation of XDNU is simpler for POINT_TOL_UNIQUE_INDEX.
%
  [ unique_num, xdnu ] = point_tol_unique_index ( m, n, a, tol );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  POINT_TOL_UNIQUE_INDEX\n' );
  fprintf ( 1, '  Unique_num = %d\n', unique_num );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  List of nonunique points P(J), represented by\n' );
  fprintf ( 1, '  point with index I(J).\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  J, P(J)\n' );
  fprintf ( 1, '  I(J), P(I(J))\n' );
  fprintf ( 1, '  || P(J) - P(I(J)) || (should be <= TOL)\n' );
  fprintf ( 1, '\n' );
  for j = 1 : n
    k = xdnu(j);
    if ( j ~= k )
      fprintf ( 1, '\n' );
      fprintf ( 1, '  %4d', j );
      for i = 1 : m
        fprintf ( 1, '  %14f', a(i,j) );
      end
      fprintf ( 1, '\n' );
      fprintf ( 1, '  %4d', k );
      for i = 1 : m
        fprintf ( 1, '  %14f', a(i,k) );
      end
      fprintf ( 1, '\n' );
      dist = sqrt ( sum ( ( a(1:m,j) - a(1:m,k) ).^2 ) );
      fprintf ( 1, '          %10f\n', dist );
    end
  end

  return
end


function a = r8row_sort_heap_a ( m, n, a )

%*****************************************************************************80
%
%% R8ROW_SORT_HEAP_A ascending heapsorts an R8ROW.
%
%  Discussion:
%
%    In lexicographic order, the statement "X < Y", applied to two real
%    vectors X and Y of length M, means that there is some index I, with
%    1 <= I <= M, with the property that
%
%      X(J) = Y(J) for J < I,
%    and
%      X(I) < Y(I).
%
%    In other words, the first time they differ, X is smaller.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 May 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns.
%
%    Input, real A(M,N), the array of M rows of N-vectors.
%
%    Output, real A(M,N), the rows of A have been sorted.
%
  if ( m <= 0 )
    return
  end

  if ( n <= 1 )
    return
  end
%
%  Initialize.
%
  i = 0;
  indx = 0;
  isgn = 0;
  j = 0;
%
%  Call the external heap sorter.
%
  while ( 1 )

    [ indx, i, j ] = sort_heap_external ( m, indx, isgn );
%
%  Interchange the I and J objects.
%
    if ( 0 < indx )

      a = r8row_swap ( m, n, a, i, j );
%
%  Compare the I and J objects.
%
    elseif ( indx < 0 )

      isgn = r8row_compare ( m, n, a, i, j );

    elseif ( indx == 0 )

      break

    end

  end

  return
end


function [ V ] = T2V( T )
%T2V converts 4x4 transformation matrix into a 1x6 vector
%   Inputs -
%   T - a standard 4x4 transformation matrix
%
%   Outputs -
%   V - 1x6 vector of form [x,y,z,rx,ry,rz] where x,y,z is the translation
%   and rx,ry,rz is an angle-axis representation of the angle where the
%   unit vector representing the axis has been multipled by the angle of
%   rotation about it

validateattributes(T, {'numeric'},{'size',[4,4]});

T = double(T);

V(1:3) = T(1:3,4);
V(4:6) = R2V(T(1:3,1:3));

end


function H = psd_project_rows(H,tol)
  % H = psd_project_rows(H)
  if nargin < 2
    tol = 0;
  end
  m = round(sqrt(size(H,2)));
  assert(m*m==size(H,2));
  for i = 1:size(H,1)
    A = reshape(H(i,:),m,m);
    [V,D] = eig(triu(A)+triu(A,1)','vector');
    B = V*(max(D,tol).*V');
    H(i,:) = B(:);
    if any(~isreal(B(:)))
      keyboard
    end
  end

end


function [score]=crps(ygibbs,yo)

% compute first the dimension of the gibbs sampler draws (normally, 'It' iterations minus 'Bu' discarded burn iterations)
It_Bu=size(ygibbs,1);

% compute the first summation term
sum1=sum(abs(ygibbs-repmat(yo,It_Bu,1)));

% compute the second summation term
 temp=abs(repmat(ygibbs,1,It_Bu)-repmat(ygibbs',It_Bu,1));
 sum2=sum(temp(:));

% eventually compute the score
score=(1/It_Bu)*sum1-(1/(2*It_Bu^2))*sum2;


function T_hat = run_tc(params)
  T = params.T;
  Idx = params.Idx;

  Omega = find(Idx);
  Ak = T(Omega);

  N = ndims(T);
  Nway = size(T); % dimension of tensor
  coreNway = [Nway(1),Nway(2),1];

  % rank_dec strategy
  opts = [];
  opts.alpha_adj = 0;
  opts.rank_adj = -1*ones(1,3);
  opts.rank_min = 5*ones(1,3);
  opts.rank_max = 20*ones(1,3);
  EstCoreNway = round(1.25*coreNway);
  coNway = zeros(1,N);
  for n = 1:N
    coNway(n) = prod(Nway)/Nway(n);
  end
  % use random generated starting point
  for i = 1:3
    X0{i} = randn(Nway(i),EstCoreNway(i));
    Y0{i} = randn(EstCoreNway(i),coNway(i));
  end
  opts.X0 = X0; opts.Y0 = Y0;
  [X_dec,Y_dec,Out_dec] = TMac(Ak,Omega,Nway,EstCoreNway,opts);
  % use the weighted sum of all mode matrix factorizations as estimated tensor
  T_hat = zeros(Nway);
  for i = 1:N
    T_hat = T_hat+Out_dec.alpha(i)*Fold(X_dec{i}*Y_dec{i},Nway,i);
  end
end


% Local Regression and Likelihood, Figure 4.4.
% Author: Catherine Loader
%
% AIC plot for a local poisson regression.

load mine;
a = (0.4:0.05:1)';
figure('Name','fig4_4: AIC plot for local poisson regression' );
aicplot(a,extrp,frac,'family','poisson','deg',1);


function [Z_hat, E_hat] = exact_alm_lrr_l21v2(D, A, lambda, tol, maxIter,display)

% Aug 2013
% This matlab code implements the Exact ALM algorithm for
% min_{Z,E}  |Z|_* + lambda |E|_2,1  s.t.  D = AZ + E
%
% D - m x n matrix of observations/data (required input)
% A - m x k matrix of the dictionary (required input)

% lambda - weight on sparse error term in the cost function
%
% tol - tolerance for stopping criterion.
%     - DEFAULT 1e-7 if omitted or -1.
%
% maxIter - maximum number of iterations
%         - DEFAULT 1000, if omitted or -1.
%
[m n] = size(D);
k = size(A,2);

if nargin < 4 || isempty(tol)
    tol = 1e-7;
end

if nargin < 5 || isempty(maxIter)
    maxIter = 1000;
end

if nargin<6 || isempty(display)
    display = false;
end

maxIter_primal = 10000;
% initialize
Y = sign(D);
norm_two = norm(Y,2);
norm_inf = norm( Y(:), inf) / lambda;
dual_norm = max(norm_two, norm_inf);
Y = Y / dual_norm;

W = zeros(k,n);

Z_hat = zeros(k,n);
E_hat = zeros(m,n);
%parameters
dnorm = norm(D, 'fro');
tolProj1 = 1e-6 * dnorm;

anorm = norm(A,2);
tolProj2 = 1e-6 * dnorm/anorm;

mu = .5/norm_two; % this one can be tuned
rho = 6;          % this one can be tuned

%pre-computation
if m>=k
    inv_ata = inv(eye(k) + A'*A);
else
    inv_ata = eye(k) - A'/(eye(m)+A*A')*A;
end

iter = 0;
while iter < maxIter
    iter = iter + 1;

    % solve the primal problem by alternative projection
    primal_iter = 0;

    while primal_iter < maxIter_primal
        primal_iter = primal_iter + 1;
        temp_Z = Z_hat;
        temp_E = E_hat;

        %update J
        temp = temp_Z + W/mu;

        [U,S,V] = svd(temp, 'econ'); % stable
        %[U,S,V] = svdecon(temp); % fastest, but EIG must not contain NaN or Inf.

        diagS = diag(S);
        svp = length(find(diagS > 1/mu));
        diagS = max(0,diagS - 1/mu);

        if svp < 0.5 %svp = 0
            svp = 1;
        end
        J_hat = U(:,1:svp)*diag(diagS(1:svp))*V(:,1:svp)';

        % update Z
        temp = J_hat + A'*(D - temp_E) + (A'*Y-W)/mu;
        Z_hat = inv_ata*temp;

        %update E
        temp = D - A*Z_hat + Y/mu;
        E_hat =  solve_l1l2(temp, lambda/mu);

        if norm(E_hat - temp_E, 'fro') < tolProj1 && norm(Z_hat - temp_Z)<tolProj2
            break;
        end
    end

    H1 = D - A*Z_hat - E_hat;
    H2 = Z_hat - J_hat;
    Y = Y + mu*H1;
    W = W + mu*H2;
    mu = rho * mu;

    %% stop Criterion
    stopCriterion = max(norm(H1, 'fro')/dnorm, norm(H2,'fro')/dnorm*anorm);
    if display
        disp(['LRR: Iteration' num2str(iter) '(' num2str(primal_iter) '), mu ' num2str(mu) ', |E|_2,0 ' num2str(sum(sum(E_hat.^2,1)>0))...
        ', stopCriterion ' num2str(stopCriterion)]);
    end

    if stopCriterion < tol
        break;
    end

end

end


function z0 = bicinter(x, y, z, x0, y0)
N = 16;
M = 4;
[xn, yn, zn] = findnearest(x, y, z, x0, y0, N);
F = zeros(N, N);
for p = 1:N
    Fr = zeros(1, N);
    for i = 1:M
    for j = 1:M
        Fr( map_ijk(i, j, M) ) = (xn(p)^(i-1))*(yn(p)^(j-1));
    end
    end
    F(p, :) = Fr;
end
a = F\zn;
z0 = 0;
for i = 1:M
for j = 1:M
    z0 = z0 + a( map_ijk(i, j, M) )*(x0^(i-1))*(y0^(j-1));
end
end

function k = map_ijk (i, j, M)
    k = (i-1)*M + j;


function ds_plumb=cosmo_fmri_deoblique(ds)
% de-oblique a dataset
%
% Input:
%     ds                fmri dataset struct
%
% Output:
%
% Example:
%     % start with a simple dataset
%     x=cosmo_synthetic_dataset('size','huge','ntargets',1,'nchunks',1);
%     % make dataset oblique (manually)
%     x.a.vol.mat(1,1)=.8;
%     x.a.vol.mat(2,1)=.6;
%     y=cosmo_fmri_deoblique(x);
%     cosmo_disp(x.a.vol)
%     %|| .mat
%     %||   [ 0.8         0         0        -3
%     %||     0.6         2         0        -3
%     %||       0         0         2        -3
%     %||       0         0         0         1 ]
%     %|| .dim
%     %||   [ 20        17        19 ]
%     %|| .xform
%     %||   'scanner_anat'
%     cosmo_disp(y.a.vol)
%     %|| .mat
%     %||   [ 1         0         0      -3.2
%     %||     0         2         0      -2.4
%     %||     0         0         2        -3
%     %||     0         0         0         1 ]
%     %|| .dim
%     %||   [ 20        17        19 ]
%     %|| .xform
%     %||   'scanner_anat'
%     %
%     % other attributes are unchanged:
%     assert(isequal({x.samples x.fa x.sa x.a.fdim},...
%                    {y.samples y.fa y.sa y.a.fdim}));
%     %
%     % a plump dataset does not change after de-obliqueing
%     z=cosmo_fmri_deoblique(y);
%     isequal(y,z)
%     %|| true
%
% Notes:
%   - Using this function changes the location of the voxels in
%     world-space, that is world coordinates (x, y, z).
%   - This function is intended for AFNI and BrainVoyager, as these
%     programs prefer 'plump' (non-oblique) volumes.
%   - When using this function, it is recommended to inspect the result
%     visually.
%
% #   For CoSMoMVPA's copyright information and license terms,   #
% #   see the COPYING file distributed with CoSMoMVPA.           #

% get canonical orthogonal matrix
[unused,rot_ortho]=cosmo_fmri_orientation(ds);
mat=ds.a.vol.mat;

% convert base1 -> base0
mat(1:3,4)=mat(1:3,4)+mat(1:3,1:3)*[1 1 1]';

% use pixel dimension to set non-zero elements
mat_ortho=mat;
pixdim=sqrt(sum(mat(1:3,1:3).^2,1));
mat_ortho(1:3,1:3)=bsxfun(@times,rot_ortho(1:3,1:3),pixdim);

% convert base0 -> base1
mat_ortho(1:3,4)=mat_ortho(1:3,1:3)*-[1 1 1]'+mat_ortho(1:3,4);

% ensure single element in rotation part
assert(all(sum(mat_ortho(:,1:3)~=0,1)==1));
assert(all(sum(mat_ortho(1:3,1:3)~=0,2)==1));

ds_plumb=ds;
ds_plumb.a.vol.mat=mat_ortho;


function [Ep M] = spm_induced_optimise_parameters(PARAMS)
% Demo routine that optimises free parameters
%==========================================================================
%
% This exemplar routine illustrates how one can adjust or tune prior
% parameter expectations to produce desired spectral responses as specified
% by the complex eigenvalue spectrum - or a reduced form that considers a
% small number of complex values (roots).
%__________________________________________________________________________
% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging

% Karl Friston
% $Id: spm_induced_optimise_parameters.m 6856 2016-08-10 17:55:05Z karl $

% Parameters to optimise
%--------------------------------------------------------------------------
if ~nargin, PARAMS = {'G','T','L'}; end

% spectral specification
%==========================================================================
J      = [3 7];                % indices of hidden states producing outputs
Np     = length(J);

% Target spectrum - gamma, beta and alpha
%--------------------------------------------------------------------------
Hz     = 1:128;
s(:,1) = -[128 64 32 64]'   + 1j*2*pi*[4 12 48 64]';
s(:,2) = -[128 64 256 256]' + 1j*2*pi*[8 16 48 64]';

% Model specification
%==========================================================================
Nc    = 1;
Ns    = 1;
options.spatial  = 'LFP';
options.model    = 'TFM';
M.dipfit.model = options.model;
M.dipfit.type  = options.spatial;
M.dipfit.Nc    = Nc;
M.dipfit.Ns    = Ns;
M.J            = J;
M.Hz           = Hz;

% get priors
%--------------------------------------------------------------------------
[pE pC] = spm_dcm_neural_priors({0 0 0},{},1,options.model);
[pE pC] = spm_L_priors(M.dipfit,pE,pC);
[pE pC] = spm_ssr_priors(pE,pC);
[x,f]   = spm_dcm_x_neural(pE,options.model);

% suppress measurement noise
%--------------------------------------------------------------------------
pE.a(2) =      - 2;
pE.b    = pE.b - 16;
pE.c    = pE.c - 16;

% a target data
%--------------------------------------------------------------------------
Gu    = spm_csd_mtf_gu(pE,M.Hz);
for i = 1:Np
    csd(:,i,i) = 512*full(Gu.*sum(spm_s2csd(s(:,i),Hz),2));
end

% orders and model
%==========================================================================
nx      = length(spm_vec(x));
nu      = Ns;
u       = sparse(1,nu);

% fix priors if a subset of parameters are specified
%--------------------------------------------------------------------------
pV    = spm_vec(pC);
V     = pV - pV;
for i = 1:length(PARAMS)
    V(spm_fieldindices(pE,PARAMS{i})) = 1;
end
pC    = spm_unvec(V.*pV,pC);

% create LFP model
%--------------------------------------------------------------------------
M.IS   = 'spm_csd_mtf';
M.FS   = 'spm_diag_array';
M.g    = @(x,u,P,M) P.L*x(M.J(:));

M.f    = f;
M.x    = x;
M.n    = nx;
M.pE   = pE;
M.pC   = pC;
M.hE   = 8;
M.hC   = 1/128;
M.m    = nu;
M.l    = Np;

% solve for steady state
%--------------------------------------------------------------------------
M.x    = spm_dcm_neural_x(pE,M);
M.u    = u;
M.Nmax = 32;

% Optimisation: Target (Y)
%==========================================================================
[Ep Cp] = spm_nlsi_GN(M,[],{csd});

% Characterise contributions of parameters to spectral representation
%==========================================================================

% Show results with current (prior) parameters
%--------------------------------------------------------------------------
spm_figure('GetWin','Spectral responses'); clf

% and plot spectra
%--------------------------------------------------------------------------
subplot(2,2,1)
Gp    = spm_csd_mtf(pE,M);
Gq    = spm_csd_mtf(Ep,M);
plot(Hz,abs(spm_diag_array(Gp{1})),'r'), hold on
plot(Hz,abs(spm_diag_array(Gq{1})),'b'),  hold on
plot(Hz,abs(spm_diag_array(csd)),  '--'),  hold off

title({'Spectral responses';'Before (red) and after (blue)'},'FontSize',16)
xlabel('Frequency')
ylabel('Spectral density')
axis square

% Show results with optimised parameters
%--------------------------------------------------------------------------
subplot(2,2,2)
sp  = spm_ssm2s(pE,M);
sq  = spm_ssm2s(Ep,M);
gp  = spm_s2csd(sp,Hz);
gq  = spm_s2csd(sq,Hz);
plot(Hz,gp,'r',Hz,gq,'b')

title({'Eigenmodes';'Before (red) and after (blue)'},'FontSize',16)
xlabel('Frequency')
ylabel('Spectral density of modes')
axis square

% Show old and new priors
%==========================================================================

% change in parameters (and conditional confidence)
%--------------------------------------------------------------------------
E     = spm_vec(Ep) - spm_vec(pE);
C     = diag(Cp);

% eliminate an interesting parameters and sought on basis of contribution
%--------------------------------------------------------------------------
[c,j] = sort(C,'ascend');
j     = j(find(abs(E(j)) > exp(-8) & C(j) > 0));

subplot(4,1,3)
spm_plot_ci(E(j),C(j))
title('Posterior updates','FontSize',16)
xlabel('Free parameters')
ylabel('Value')
set(gca,'XTick',1:length(j))
set(gca,'XTickLabel',spm_fieldindices(pE,j))

subplot(4,1,4)
bar(-log(C(j,:)))
title('Contribution (log precision)','FontSize',16)
xlabel('Free parameters')
ylabel('log precision')
set(gca,'XTick',1:length(j))
set(gca,'XLim',[0 (length(j) + 1)])
set(gca,'XTickLabel',spm_fieldindices(pE,j))

return

% examine Jacobian
%==========================================================================
spm_figure('GetWin','Jacobian'); clf

% get transfer functions and Jacobian
%--------------------------------------------------------------------------
[S,K,s,w,t,dfdx] = spm_dcm_mtf(Ep,M,[]);

% and plot
%--------------------------------------------------------------------------
subplot(2,2,1)
imagesc(dfdx)
title('Jacobian','FontSize',16)
xlabel('hidden state')
ylabel('hidden state')
axis square


function f = diff( f, varargin )
%DIFF   Derivative of a diskfun in Cartesian coordinates.
%
%   F = DIFF( F ) computes the first derivative of F with respect to x.
%
%   F = DIFF( F, DIM )  computes the first derivative of F. If DIM = 1, the
%   derivative is taken in the x-direction. If DIM = 2, the derivative
%   is taken in the y-direction.
%
%   F = DIFF( F, DIM, K) computes the kth derivatives of F in the variable
%   given by DIM.
%
% See also DISKFUN/LAPLACIAN, DISKFUN/DIFFX, DISKFUN/DIFFY

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

if ( isempty(f) )
    f = diskfun;
    return
end

% Parse user inputs:
if ( nargin == 1 )
    dim = 1;
    K = 1;
elseif ( nargin == 2 )
    dim = varargin{1};
    K = 1;
else
    dim = varargin{1};
    K = varargin{2};
end

if ( dim ~= 1 && dim ~= 2  )
    error('DISKFUN:DIFF:DIM', 'Unrecognized coordinate dimension.');
end

if ( abs( K - round(K) ) > eps )
    error('DISKFUN:DIFF:DIFFORDER', 'Fractional derivatives not allowed.')
end
K = round( K );

% Implement higher derivatives as repeated (iterated) differentiation
for j=1:K
    f = onediff(f, dim);
end

end
% TODO: This code will not work for complex valued diskfuns, if we ever
% allow them.

function f = onediff(f, dim)

% Make sure f has as short a length as possible.
f=simplify(f);

% We are going to work at the tech level to make things faster.
[C, ~, R] = cdr( f );

% Do everything with even length columns since then no special
% modifications are required for dividing by rho series expansion.
parity = mod(length(C),2);
n = length(C)+parity;
m = length(R);

% The variable coefficients in the definitions of the derivatives means
% that the length of the columns and rows will increase by one wave number
% after taking the derivatives with respect to x and y.
m = m+2;
n = n+2;

% Matrices for multiplying by sin(theta), cos(theta) and 1/r in coefficient space.
Msinm = .5i*spdiags(ones(m,1)*[-1,1],[-1 1],m,m);
Mcosm = .5*spdiags(ones(m,1)*[1,1],[-1 1],m,m);
Mn = ultraS.multmat(n, [0;1], 0);

% Work at the tech level to make things faster.
ctechs = C.funs{1}.onefun;
rtechs = R.funs{1}.onefun;

% Alias to get the extra zeros in place.
ctechs.coeffs = ctechs.alias(ctechs.coeffs, n);
rtechs.coeffs = rtechs.alias(rtechs.coeffs, m);

% Compute the derivatives.
dCdr = diff(ctechs);
dRdth = diff(rtechs)/pi;

% 1/r*col
rinv = Mn \ ctechs.coeffs;

if (dim==1) %d/dx

    %CDR for -1/r.*sin(th).*d/dth
    C1 = rinv;
    R1 = -Msinm*dRdth.coeffs;

    %CDR for cos(th).*d/dr
    C2 = dCdr.coeffs;
    R2 = Mcosm*rtechs.coeffs;

else  %d/dy

    %CDR for 1/r.*cos(th).*d/dth
    C1 = rinv;
    R1 = Mcosm*dRdth.coeffs;

    %CDR for sin(th).*d/dr
    C2 = dCdr.coeffs;
    R2 = Msinm*rtechs.coeffs;
end

% Put pieces back together
f1 = f;
c1techs = chebtech2({' ',C1});
f1.cols.funs{1}.onefun = c1techs;
r1techs = real(trigtech({'',R1}));
f1.rows.funs{1}.onefun = r1techs;

% Parity changes
temp = f1.idxPlus;
f1.idxPlus = f1.idxMinus;
f1.idxMinus = temp;

f2 = f;
c2techs = chebtech2({'',C2});
f2.cols.funs{1}.onefun = c2techs;
r2techs = real(trigtech({'',R2}));
f2.rows.funs{1}.onefun = r2techs;

% Parity changes
temp = f2.idxPlus;
f2.idxPlus = f2.idxMinus;
f2.idxMinus = temp;

% Compression plus may not preserve the expansion properties we want.
% So we sample each piece add them together and construct a diskfun.
% TODO: Fix this so everything is done in coefficient space, like this
% f = f1 + f2;

% Constructor requires even m
m = m + mod(m, 2);

f = diskfun(sample(f1,m,n/2+1)+sample(f2,m,n/2+1));

end


function [S,Li] = eeg_interp_sph_spline(V,X,Y,Z,Npoints)

% eeg_interp_sph_spline - Spherical Spline Laplacian of Potential
%
% Useage: [S,Li] = eeg_lap_sph_spline(voltage,X,Y,Z,Npoints)
%
% where:    'voltage' is an EEG/ERP measurement at time t from
%           electrode positions (X,Y,Z) on a scalp surface.  All
%           input arrays are the same size, assumed (Nelec x 1).
%           The origin of X,Y,Z is assumed (0,0,0).
%
%           S  => the x,y,z points on a hemisphere
%           Li => spherical spline Laplacian of voltages
%
%           S is generated by 'elec_sphere_points' with
%           Rpoints=Npoints and Epoints=16.
%
% Notes:    This function calculates the spherical spline Laplacian
%           of Perrin et al (1989).  Electroenceph. & Clin.
%             Neurophysiology, 72: 184-187.
%

% $Revision: 1.1 $ $Date: 2009-04-28 22:13:52 $

% Licence:  GNU GPL, no implied or express warranties
% History:  08/01  Darren.Weber_at_radiology.ucsf.edu, with
%                  mathematical and matlab advice from
%                  Dr. Murk Bottema (Flinders University of SA)
%
%           08/01  Needs testing & verification!
%                  With large electrode arrays, the result should be
%                  regularized (not sure why).
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    % Check for correct size & orientation of X,Y,Z,V
    [x1,x2] = size(X);
    [y1,y2] = size(Y);
    [z1,z2] = size(Z);
    [v1,v2] = size(V);
    if ~and(isequal(x1,y1,z1,v1),isequal(x2,y2,z2,v2))
        error('ERROR: all X, Y, Z, V must be size (Nx1)');
    end
    if x1 < x2, X = X'; [x1,x2] = size(X); end
    if y1 < y2, Y = Y'; [y1,y2] = size(Y); end
    if z1 < z2, Z = Z'; [z1,z2] = size(Z); end
    if v1 < v2, V = V'; [v1,v2] = size(V); end
    if ~(isequal(x2,y2,z2,v2,1))
        error('ERROR: all X, Y, Z, V must be size (Nx1)');
    end

    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    % Computations derived from Perrin et al. (1989)

    % G * C = V,  where:
    %
    % G  (NxN)    spherical spline
    % C  (Nx1)    spline coefficients
    % V  (Nx1)    voltage potentials at (X,Y,Z) electrode locations
    %
    % solve for C = V * Sp' (C = V\Sp; (see "help slash"))

    % First calc G, where G is a function of the cosine of
    % the angle (theta) between electrode point vectors
    A   = [ X Y Z ];
    COS = cosines(A,A);
    G   = spheric_spline(COS);
    C   = spline_coefficients(G,V); % spline coefficients (Co,C1,...,Cn)
    Co  = C(1);
    Ci  = C(2:end);

    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    % Obtain interpolated potentials at S (eq.1, Perrin et al., 1989)
    % V(s) = Co + sum( Ci * g(x) )

    % get spherical electrode radius
    [r,x,y,z] = elec_sphere_fit(X,Y,Z,0,0,0,0);
    % Generate spherical points for interpolation
    [x,y,z]   = elec_sphere_points(16,Npoints,r);
    S         = [x y z];

    fprintf('...Spherical Interpolation Progress:\n');
    rows = 80;  % progress indicator

    for p = 1:length(S)

        B = S(p,:);
        Cos = cosines(A,B);         %(1xN)

        Gx  = spheric_spline(Cos);  %(1xN)

        CiGx = Ci .* Gx';           %(1xN)

        Vi(p,1) = Co + sum(CiGx);

        fprintf('.');  % progress indicator
        if([p] == rows ) fprintf('\n'); rows = rows + 80; end
    end

return

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Solve eq. 3 Perrin et al. (1989)
% g(COS) = 1/4pi * sum[n=1:inf] (( (2*n+1)/(n^m * (n+1)^m) ) * Pn(COS));

function [Gx] = spheric_spline(Cosine)

    m = 4;    N = 7;    % gives accuracy of 10^-6

    P = legendre(N,Cosine);
    %P = LEGENDRE(N,X) computes the associated Legendre functions
    %of degree N and order m = 0, 1, ..., N, evaluated for each element
    %of X.
    %In general, P has one more dimension than X.
    %Each element P(m+1,i,j,k,...) contains the associated Legendre
    %function of degree N and order m evaluated at X(i,j,k,...).

    ndim = ndims(P);
    switch ndim
    case 2, P = P(2:N+1,:);
    case 3, P = P(2:N+1,:,:);
    case 4, P = P(2:N+1,:,:,:);
    otherwise
    end

    k = (1/4 * pi);

    for n = 1:(N),  Series(n,1) = (2*n + 1) / (n^(m-1) * (n+1)^(m-1));  end

    if min(size(Cosine)) == 1,    Gx      = k * ( Series' * P );
    else
        for i = 1:length(Cosine), Gx(i,:) = k * ( Series' * P(:,:,i) );
        end
    end
return

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Solve eq. 2 Perrin et al. (1989)
function [C] = spline_coefficients(Gx,V)

    % add ones to first row & column of Gx
    tmp =  ones(size(V));       Gx   = [tmp Gx];
    tmp = [ones(size(V))' 1]';  Gx   = [tmp Gx']';

    Gx(1,1) = 0;    % according to Murk
    %Gx(1,1) = 1;    % according to EMSE, Greenblatt

    CoV = [0 V']';

    C = Gx\CoV;
return

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [Cos] = cosines(A,B)

    for     a = 1:size(A,1),  Aa = A(a,:); A_len = norm(Aa);
        for b = 1:size(B,1),  Bb = B(b,:); B_len = norm(Bb);

            Cos(a,b) = dot(Aa,Bb) / (A_len * B_len);
        end
    end
return


function [A,B,flag] = oprACAv(opr,k,X,Xnrm,Y,Ynrm,tol)
%+========================================================================+
%|                                                                        |
%|            OPENOPR - LIBRARY FOR SPECIFIC OPERATORS IN BEM             |
%|           openOpr 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       : oprACAv.m                                     |
%|    #    |   VERSION    : 0.61                                          |
%|   _#_   |   AUTHOR(S)  : Matthieu Aussal                               |
%|  ( # )  |   CREATION   : 14.03.2017                                    |
%|  / 0 \  |   LAST MODIF : 05.09.2019                                    |
%| ( === ) |   SYNOPSIS   : Adaptative Cross Approximation, partial       |
%|  `---'  |                & total pivoting                              |
%+========================================================================+

% Matrix dimensions
Nx = size(X,1);
Ny = size(Y,1);

% Initialize indices
Ir = (1:Nx)';
Ic = (1:Ny)';

% Partial pivoting with handle function
row = @(i) oprGreenKernel(opr,k,X(i,:),Xnrm(i,:),Y,Ynrm);
col = @(j) oprGreenKernel(opr,k,X,Xnrm,Y(j,:),Ynrm(j,:));

% First row (row index of maximum reference value)
i   = 1;
B   = row(i);
dim = size(B,3);

% First pivot (maximum of the first row)
[~,j] = max(max(abs(B),[],3));
delta = B(j,:,:);

% Securitys
delta(abs(delta)<1e-12) = 1e-12;

% First column
A = col(j)./delta;

% Unused indices1
Ir = [Ir(1:i-1);Ir(i+1:end)];
Ic = [Ic(1:j-1);Ic(j+1:end)];

% Frobenius norm for the initial tensor product
Rn2 = zeros(dim,1);
err = 0;
for l = 1:dim
    An2    = A(:,1,l)'*A(:,1,l);
    Bn2    = B(:,1,l)'*B(:,1,l);
    Rn2(l) = An2*Bn2;
    err    = max(err,sqrt(An2)*sqrt(Bn2)/sqrt(Rn2(l)));
end

% Iterative construction using frobenius norm
n = 1;
while (err > tol)
    % New pivot by maximum
    [~,i] = max(max(abs(A(Ir,n,:)),[],3));
    new   = row(Ir(i));
    for l = 1:dim
        new(:,:,l) = new(:,:,l) - B(:,:,l)*A(Ir(i),1:n,l).';
    end
    [~,j] = max(max(abs(new(Ic,:,:)),[],3));
    delta = new(Ic(j),:,:);

    % New pivot by minimum
    [~,iMin] = min(min(abs(A(Ir,n,:)),[],3));
    newMin   = row(Ir(iMin));
    for l = 1:dim
        newMin(:,:,l) = newMin(:,:,l) - B(:,:,l)*A(Ir(iMin),:,l).';
    end
    [~,jMin] = max(max(abs(newMin(Ic,:,:)),[],3));
    deltaMin = newMin(Ic(jMin),:,:);

    % Best pivot
    if (norm(deltaMin(:)) > norm(delta(:)))
        i     = iMin;
        new   = newMin;
        j     = jMin;
        delta = deltaMin;
    end

    % Security
    delta(abs(delta)<1e-12) = 1e-12;

    % Update row
    B(:,n+1,:) = new;

    % New column
    new = col(Ic(j));
    for l = 1:dim
        new(:,:,l) = (new(:,:,l) - A(:,:,l)*B(Ic(j),1:n,l).')./delta(l);    %B(:,:,l)*A(Ir(i),:,l).';
    end
    A(:,n+1,:) = new;

    % Update row and column indices
    Ir = [Ir(1:i-1);Ir(i+1:end)];
    Ic = [Ic(1:j-1);Ic(j+1:end)];

    % Incrementation
    n = n + 1;

    % Relative Frobenius error by block
    err = 0;
    for l = 1:dim
        An2    = A(:,n,l)'*A(:,n,l);
        Bn2    = B(:,n,l)'*B(:,n,l);
        u      = B(:,n,l)'*B(:,1:n-1,l);
        v      = A(:,n,l)'*A(:,1:n-1,l);
        AB     = v*u.';
        Rn2(l) = Rn2(l) + 2*real(AB) + An2*Bn2;
        err    = max(err,sqrt(An2)*sqrt(Bn2)/sqrt(Rn2(l)));
    end

    % Compression failed
    if (n*(Nx+Ny) > Nx*Ny)
        A    = [];
        B    = [];
        flag = 0;
        return
    end
%     sqrt(An2)*sqrt(Bn2)/sqrt(Rn2)
%     norm(A*B.' - A(:,1:n-1)*B(:,1:n-1).','fro')/norm(A*B.','fro')
%     norm(A(:,n)*B(:,n).','fro')/norm(A*B.','fro')
%     norm(ref,'inf')/nrm
%     '================================'
end

% B transposition lead to  A * B
B    = permute(B,[2 1,3]);
flag = 1;
end


function check_NFSOFT
%
% checks for Y_l(g h) = T_l(g) Y_l(h)
%

%% input data
L = 16;

%q = axis2quat(xvector+yvector,25*degree);
%q = axis2quat(zvector,90*degree);
%h = [xvector,-xvector,yvector];

qq = quaternion(SO3Grid(10));
h = equispacedS2Grid('points',20,'antipodal');

progress(0,length(qq));

for iq = 1:length(qq)

  progress(iq,length(qq));

  q = qq(iq);

  %% convert to export parameters
  g = Euler(q,'nfft');
%   alpha = fft_rho(alpha); %-->z
%   beta  = fft_theta(beta);
%   gamma = fft_rho(gamma); %-->z
%   g = 2*pi*[alpha;beta;gamma];
  %g = [0;pi/2;0];

  %% set parameters
  c = 1;
  A = ones(1,L+1);

  %% run NFSOFT
  T = call_extern('odf2fc','EXTERN',g,c,A); % conjugate(D)

  % extract result
  T = complex(T(1:2:end),T(2:2:end));

  %% check result

  for l = 0:L

    Y = sphericalY(l,h).'; % -> Y
    gY = sphericalY(l,q*h).'; % -> Y
    Tl = reshape(T(deg2dim(l)+1:deg2dim(l+1)),2*l+1,2*l+1);
    %    TY = flipud(Tl * flipud(Y));
    %    TY = flipud(fliplr(Tl) * Y);
    TY = Tl * Y;
    er(l+1,iq) = sqrt(norm(TY(:) - gY(:)));
    %TY = conj(Tl) * Y;norm(TY(:) - gY(:))
    %TY = Tl' * Y;norm(TY(:) - gY(:))
    %TY = Tl.' * Y;norm(TY(:) - gY(:))

  end

end

%plot(mean(er,2));
if mean(er(:)) > 0.001
  error('Error in NFSOFT');
else
  disp('checking NFSOFT: ok')
  disp(mean(er(:)))
end

pcolor(er)

function d = deg2dim(l)
% dimension of the harmonic space up to order l

d = l*(2*l-1)*(2*l+1)/3;