function [movie_frame] = show_s2_partition(N,varargin)
%SHOW_S2_PARTITION 3D illustration of an EQ partition of S^2
%
%Syntax
% [movie_frame] = show_s2_partition(N,options);
%
%Description
% SHOW_S2_PARTITION(N) uses a 3d plot to illustrate the partition of
% the unit sphere S^2 into N regions.
%
% MOVIE_FRAME = SHOW_S2_PARTITION(N) sets MOVIE_FRAME to be an array of
% movie frames for use with MOVIE. The movie frames will contain the region by
% region build-up of the illustration.
%
% SHOW_S2_PARTITION(N,'offset','extra') uses experimental extra offsets.
% For more detail on partition options, see HELP PARTITION_OPTIONS.
%
% SHOW_S2_PARTITION(N,options) also recognizes a number of illustration
% options, which are specified as name, value pairs.
% Any number of pairs can be used, in any order.
%
% The following illustration options are used.
%
% SHOW_S2_PARTITION(N,'fontsize',size)
% Font size used in titles (numeric, default 16).
%
% SHOW_S2_PARTITION(N,'title','show')
% SHOW_S2_PARTITION(N,'title','hide')
% Show or hide title (default 'show').
%
% SHOW_S2_PARTITION(N,'points','show')
% SHOW_S2_PARTITION(N,'points','hide')
% Show or hide center points (default 'show').
%
% SHOW_S2_PARTITION(N,'sphere','show')
% SHOW_S2_PARTITION(N,'sphere','hide')
% Show or hide the unit sphere S^2 (default 'show').
%
% For more detail on illustration options, see HELP ILLUSTRATION_OPTIONS.
%
%Examples
% > show_s2_partition(10)
% > frames=show_s2_partition(9,'offset','extra')
% frames =
% 1x10 struct array with fields:
%     cdata
%     colormap
% > show_s2_partition(99,'points','hide')
%
%See also
% MOVIE, PARTITION_OPTIONS, ILLUSTRATION_OPTIONS, PROJECT_S2_PARTITION

% Copyright 2004-2005 Paul Leopardi for the University of New South Wales.
% $Revision 1.10 $ $Date 2005-06-01 $
% Function changed name from s2x to polar2cart
% Documentation files renamed
% $Revision 1.00 $ $Date 2005-02-13 $
%
% For licensing, see COPYING.
% For references, see AUTHORS.
% For revision history, see CHANGELOG.

pdefault.extra_offset =  false;
popt = partition_options(pdefault, varargin{:});

gdefault.fontsize = 16;
gdefault.show_title  = true;
gdefault.show_points = true;
gdefault.show_sphere = true;
gopt = illustration_options(gdefault, varargin{:});

dim = 2;

surf_jet;

if gopt.show_title
    if gopt.show_points
        pointstr = ', showing the center point of each region';
    else
        pointstr = '';
    end
    titlestr = sprintf(...
        '\nRecursive zonal equal area partition of {S^2} \n into %d regions%s.',...
        N,pointstr);
    title(titlestr,'FontWeight','bold','FontUnits','normalized',...
        'FontSize',gopt.fontsize/512);
end

frame_no = 1;
if nargout > 0
    movie_frame(frame_no) = getframe(gcf);
    frame_no = frame_no + 1;
end

if gopt.show_sphere
    show_s2_sphere;
    hold on
    if nargout > 0
        movie_frame(frame_no) = getframe(gcf);
        frame_no = frame_no + 1;
    end
end

R = eq_regions(dim,N,popt.extra_offset);
top_colat = 0;
for i = N:-1:2
    if top_colat ~= R(2,1,i)
        top_colat = R(2,1,i);
        pause(0);
    end
    show_s2_region(R(:,:,i),N);
    if nargout > 0
        movie_frame(frame_no) = getframe(gcf);
        frame_no = frame_no + 1;
    end
end

if gopt.show_points
    x = eq_point_set(dim,N,popt.extra_offset);
    show_r3_point_set(x,'sphere','hide','title','hide');
    hold on
    if nargout > 0
        movie_frame(frame_no) = getframe(gcf);
        frame_no = frame_no + 1;
    end
end

hold off
%
% end function

function show_s2_region(region,N)
%SHOW_S2_REGION Illustrate a region of S^2
%
%Syntax
% show_s2_region(region,N);
%
%Description
% SHOW_S2_REGION(REGION,N) uses 3D surface plots to illustrate a region of S^2.
% The region is given as a 2 x 2 matrix in spherical polar coordinates

tol = eps*2^5;

dim = size(region,1);
t = region(:,1);
b = region(:,2);

if abs(b(1)) < tol
    b(1) = 2*pi;
end
pseudo = 0;
if abs(t(1)) < tol && abs(b(1)-2*pi) < tol
    pseudo = 1;
end
n = 21;
delta = 1/(n-1);
h = 0:delta:1;
t_to_b = zeros(dim,n);
b_to_t = t_to_b;
r = sqrt(1/N)/12;
for k = 1:dim
    if ~pseudo || k < 2
        L = 1:dim;
        j(L) = mod(k+L,dim)+1;
        t_to_b(j(1),:) = t(j(1))+(b(j(1))-t(j(1)))*h;
        t_to_b(j(2),:) = t(j(2))*ones(1,n);
        t_to_b_x = polar2cart(t_to_b);
        [X,Y,Z] = fatcurve(t_to_b_x,r);
        surface(X,Y,Z,-ones(size(Z)),...
       'FaceColor','interp','FaceLighting','phong','EdgeColor','none')
        axis equal
        hold on
    end
end
grid off
axis off
%
% end function


function prob_test162 ( )

%*****************************************************************************80
%
%% TEST162 tests ZIPF_SAMPLE.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
  nsample = 1000;
  seed = 123456789;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST162\n' );
  fprintf ( 1, '  For the Zipf PDF:\n' );
  fprintf ( 1, '  ZIPF_SAMPLE samples.\n' );

  a = 4.0;

  check = zipf_check ( a );

  if ( ~check );
    fprintf ( 1, '\n' );
    fprintf ( 1, 'TEST162 - Fatal error!\n' );
    fprintf ( 1, '  The parameters are not legal.\n' );
    return
  end

  mean = zipf_mean ( a );
  variance = zipf_variance ( a );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  PDF parameter A =             %14f\n', a );
  fprintf ( 1, '  PDF mean =                    %14f\n', mean );
  fprintf ( 1, '  PDF variance =                %14f\n', variance );

  for i = 1 : nsample
    [ x(i), seed ] = zipf_sample ( a, seed );
  end

  mean = i4vec_mean ( nsample, x );
  variance = i4vec_variance ( nsample, x );
  xmax = max ( x(1:nsample) );
  xmin = min ( x(1:nsample) );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Sample size =     %6d\n', nsample );
  fprintf ( 1, '  Sample mean =     %14f\n', mean );
  fprintf ( 1, '  Sample variance = %14f\n', variance );
  fprintf ( 1, '  Sample maximum =  %6d\n', xmax );
  fprintf ( 1, '  Sample minimum =  %6d\n', xmin );

  return
end


function calpak_test016 ( )

%*****************************************************************************80
%
%% CALPAK_TEST016 tests JED_TO_YMDF_COPTIC and YMDF_TO_JED_COPTIC.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 March 2013
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'CALPAK_TEST016\n' );
  fprintf ( 1, '  For the Coptic calendar:\n' );
  fprintf ( 1, '  JED_TO_YMDF_COPTIC: JED -> YMDF.\n' );
  fprintf ( 1, '  YMDF_TO_JED_COPTIC: YMDF -> JED.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  JED (in)    YMDF               JED (out)\n' );
  fprintf ( 1, '\n' );

  jed_epoch = epoch_to_jed_coptic ( );

  i = 0;

  while ( 1 )

    i = i + 1;
    jed1 = jed_test ( i );

    if ( jed1 < 0.0 )
      break
    end

    if ( jed_epoch <= jed1 )

      [ y2, m2, d2, f2 ] = jed_to_ymdf_coptic ( jed1 );

      s2 = ymdf_to_s_numeric ( y2, m2, d2, f2 );

      jed3 = ymdf_to_jed_coptic ( y2, m2, d2, f2 );

      fprintf ( 1, '  %11.2f  %20s  %11.2f\n', jed1, s2, jed3 );

    end

  end

  return
end


 function sn = nufft_scale(Nd, Kd, alpha, beta, Nmid)
%function sn = nufft_scale(Nd, Kd, alpha, beta, Nmid)
%|
%| Compute scaling factors for NUFFT
%|
%| in
%|	Nd,Kd
%|	alpha	{d}
%|	beta	{d}
%|
%| option
%|	Nmid	[d]		midpoint: floor(Nd/2) or default (Nd-1)/2
%|
%| out
%|	sn	[[Nd]]		scaling factors
%|
%| Copyright 2004-7-8, Jeff Fessler, University of Michigan

if nargin == 1 && streq(Nd, 'test'), nufft_scale_test, return, end
if nargin < 4, ir_usage, end

if nargin < 5, Nmid = (Nd-1)/2; end

dd = length(Nd);
if dd == 1 && ~iscell(alpha) % 1D case
	sn = nufft_scale1(Nd(1), Kd(1), alpha, beta, Nmid(1));
return
end

% scaling factors: "outer product" of 1D vectors
sn = 1;
for id=1:dd
	tmp = nufft_scale1(Nd(id), Kd(id), alpha{id}, beta{id}, Nmid(id));
	sn = sn(:) * tmp';
end
if length(Nd) > 1
	sn = reshape(sn, Nd);	% [(Nd)]
else
	sn = sn(:);	% [(Nd)]
end

% Compute scaling factors for 1D NUFFT (from Fourier series coefficients)
% in:
%	N,K
%	alpha
%	beta
% out:
%	sn	[N]		scaling factors
%
% Copyright 2001-10-4, Jeff Fessler, The University of Michigan

function sn = nufft_scale1(N, K, alpha, beta, Nmid)

if ~isreal(alpha(1)), error 'need real alpha_0', end
L = length(alpha) - 1;

%
% compute scaling factors from Fourier coefficients
%
if L > 0
	sn = zeros(N,1);
	n = [0:(N-1)]';
	i_gam_n_n0 = 1i * (2*pi/K) * (n - Nmid) * beta;

	for l1=-L:L
		alf = alpha(abs(l1)+1);
		if l1 < 0, alf = conj(alf); end
		sn = sn + alf * exp(i_gam_n_n0 * l1);
	end

else
	sn = alpha * ones(N,1);
end

% self test
function nufft_scale_test

N = 100;
K = 2*N;
alpha = [1.0 -0.0 -0.2];
sn = nufft_scale(N, K, alpha, 1);
if im
	n = [0:(N-1)]';
	clf, plot(n, real(sn), 'r-', n, imag(sn), 'b-')
	ir_legend({'$s[n]$ real', '$s[n]$ imag'})
	ylabelf('$s[n]$')
	xlabelf('$n$')
end

pr minmax(real(sn))
pr minmax(imag(sn))


function coeffs = alias(coeffs, m)
%ALIAS   Alias Chebyshev coefficients on the 1st kind Chebyshev grid.
%   ALIAS(C, M) aliases the Chebyshev coefficients stored in the column vector C
%   to have length M. If M > LENGTH(C), the coefficients are padded with zeros.
%   If C is a matrix of coefficients, each of the columns is aliased to length
%   M.
%
% See also PROLONG.

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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Note that the formula for aliasing on the 1st-kind Chebyshev grid is
% different from that for the 2nd-kind grid, even though the coefficients
% being aliased are for 1st-kind Chebyshev polynomials in both cases.
%
% Useful References:
%   Fox, L. and Parker, I. B., Chebyshev polynomials in Numerical Analysis,
%   Oxford University Press, 1972.  (pp. 67)
%
%   Mason, J. C. and Handscomb, D. C., Chebyshev polynomials, Chapman &
%   Hall/CRC, Boca Raton, FL, 2003.  (pp. 153)
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

n = size(coeffs, 1);

% Pad with zeros:
if ( m > n )
    coeffs = [ coeffs ; zeros(m-n, size(coeffs, 2)) ];
    return
end

% Alias coefficients:
if ( m == 1 )
    % Reduce to a single point:
    e = ones(1, ceil(n/2));
    e(2:2:end) = -1;
    coeffs = e*coeffs(1:2:end,:);
elseif ( m > n/2 )
    % If m > n/2, only single coefficients are aliased, and we can vectorise.
    j = ((m + 1):n).';
    k = abs(mod(j + m - 2, 2*m) - m + 1) + 1;
    p = floor((j-1+m)/(2*m));
    t = (-1).^p;
    coeffs(k,:) = coeffs(k,:) + bsxfun(@times, t, coeffs(j,:));
else
    % Otherwise we must do everything in a tight loop. (Which is slower!)
    for j = (m + 1):n
        k = abs(mod(j + m - 2, 2*m) - m + 1) + 1;
        sgn = 1 - 2*mod(floor((j - 1 + m)/(2*m)), 2);
        coeffs(k,:) = coeffs(k,:) + sgn*coeffs(j,:);
    end
end

% Truncate:
coeffs = coeffs(1:m,:);

end


% Program to form Admittance And Impedance Bus Formation....
% with Transformer Tap setting..

function ybus = ybusppg()  % Returns ybus

linedata = linedata30(); % Calling "linedata3.m" for Line Data...
fb = linedata(:,1);     % From bus number...
tb = linedata(:,2);     % To bus number...
r = linedata(:,3);      % Resistance, R...
x = linedata(:,4);      % Reactance, X...
b = linedata(:,5);    % Ground Admittance, B/2...
a = linedata(:,6);      % Tap setting value..
z = r + i*x;            % Z matrix...
y = 1./z;               % To get inverse of each element...
b = i*b;                % Make B imaginary...

nbus = max(max(fb),max(tb));    % no. of buses...
nbranch = length(fb);           % no. of branches...
ybus = zeros(nbus,nbus);        % Initialise YBus...

 % Formation of the Off Diagonal Elements...
 for k = 1:nbranch
     ybus(fb(k),tb(k)) = ybus(fb(k),tb(k))-y(k)/a(k);
     ybus(tb(k),fb(k)) = ybus(fb(k),tb(k));
 end

 % Formation of Diagonal Elements....
 for m = 1:nbus
     for n = 1:nbranch
         if fb(n) == m
             ybus(m,m) = ybus(m,m) + y(n)/(a(n)^2) + b(n);
         elseif tb(n) == m
             ybus(m,m) = ybus(m,m) + y(n) + b(n);
         end
     end
 end


function element_neighbor = triangulation_neighbor_elements ( ...
  element_order, element_num, element_node )

%*****************************************************************************80
%
%% TRIANGULATION_NEIGHBOR_ELEMENTS determines element neighbors.
%
%  Discussion:
%
%    A triangulation of a set of nodes can be completely described by
%    the coordinates of the nodes, and the list of nodes that make up
%    each element.  However, in some cases, it is necessary to know
%    element adjacency information, that is, which element, if any,
%    is adjacent to a given element on a particular side.
%
%    This routine creates a data structure recording this information.
%
%    The primary amount of work occurs in sorting a list of 3 * ELEMENT_NUM
%    data items.
%
%    This routine was modified to use columns instead of rows.
%
%  Example:
%
%    The input information from ELEMENT_NODE:
%
%    Element    Nodes
%    --------   ---------------
%     1         3      4      1
%     2         3      1      2
%     3         3      2      8
%     4         2      1      5
%     5         8      2     13
%     6         8     13      9
%     7         3      8      9
%     8        13      2      5
%     9         9     13      7
%    10         7     13      5
%    11         6      7      5
%    12         9      7      6
%    13        10      9      6
%    14         6      5     12
%    15        11      6     12
%    16        10      6     11
%
%    The output information in ELEMENT_NEIGHBOR:
%
%    Element   Neighboring Elements
%    --------  ---------------------
%
%     1        -1     -1      2
%     2         1      4      3
%     3         2      5      7
%     4         2     -1      8
%     5         3      8      6
%     6         5      9      7
%     7         3      6     -1
%     8         5      4     10
%     9         6     10     12
%    10         9      8     11
%    11        12     10     14
%    12         9     11     13
%    13        -1     12     16
%    14        11     -1     15
%    15        16     14     -1
%    16        13     15     -1
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 August 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer ELEMENT_ORDER, the order of the element.
%
%    Input, integer ELEMENT_NUM, the number of element.
%
%    Input, integer ELEMENT_NODE(ELEMENT_ORDER,ELEMENT_NUM), the nodes that
%    make up each element.
%
%    Output, integer ELEMENT_NEIGHBOR(3,ELEMENT_NUM), the three elements that are direct
%    neighbors of a given element.  ELEMENT_NEIGHBOR(1,I) is the index of the element
%    which touches side 1, defined by nodes 2 and 3, and so on.  ELEMENT_NEIGHBOR(1,I)
%    is negative if there is no neighbor on that side.  In this case, that
%    side of the element lies on the boundary of the triangulation.
%

%
%  Step 1.
%  From the list of nodes for element E, of the form: (I,J,K)
%  construct the three neighbor relations:
%
%    (I,J,3,E) or (J,I,3,E),
%    (J,K,1,E) or (K,J,1,E),
%    (K,I,2,E) or (I,K,2,E)
%
%  where we choose (I,J,3,E) if I < J, or else (J,I,3,E)
%
  col = zeros ( 4, 3 * element_num );

  for element = 1 : element_num

    i = element_node(1,element);
    j = element_node(2,element);
    k = element_node(3,element);

    if ( i < j )
      col(1:4,1+3*(element-1)) = [ i, j, 3, element ]';
    else
      col(1:4,1+3*(element-1)) = [ j, i, 3, element ]';
    end

    if ( j < k )
      col(1:4,2+3*(element-1)) = [ j, k, 1, element ]';
    else
      col(1:4,2+3*(element-1)) = [ k, j, 1, element ]';
    end

    if ( k < i )
      col(1:4,3+3*(element-1)) = [ k, i, 2, element ]';
    else
      col(1:4,3+3*(element-1)) = [ i, k, 2, element ]';
    end

  end
%
%  Step 2. Perform an ascending dictionary sort on the neighbor relations.
%  We only intend to sort on rows 1 and 2; the routine we call here
%  sorts on rows 1 through 4 but that won't hurt us.
%
%  What we need is to find cases where two elements share an edge.
%  Say they share an edge defined by the nodes I and J.  Then there are
%  two columns of COL that start out ( I, J, ?, ? ).  By sorting COL,
%  we make sure that these two columns occur consecutively.  That will
%  make it easy to notice that the elements are neighbors.
%
  col = i4col_sort_a ( 4, 3*element_num, col );
%
%  Step 3. Neighboring elements show up as consecutive columns with
%  identical first two entries.  Whenever you spot this happening,
%  make the appropriate entries in ELEMENT_NEIGHBOR.
%
  element_neighbor(1:3,1:element_num) = -1;

  icol = 1;

  while ( 1 )

    if ( 3 * element_num <= icol )
      break
    end

    if ( col(1,icol) ~= col(1,icol+1) || col(2,icol) ~= col(2,icol+1) )
      icol = icol + 1;
      continue
    end

    side1 = col(3,icol);
    element1 =  col(4,icol);
    side2 = col(3,icol+1);
    element2 =  col(4,icol+1);

    element_neighbor(side1,element1) = element2;
    element_neighbor(side2,element2) = element1;

    icol = icol + 2;

  end

  return
end


function c = r8ge_mxm ( n, a, b )

%*****************************************************************************80
%
%% R8GE_MXM multiplies two R8GE matrices.
%
%  Discussion:
%
%    The R8GE storage format is used for a general M by N matrix.  A storage
%    space is made for each logical entry.  The two dimensional logical
%    array is mapped to a vector, in which storage is by columns.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 February 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the matrices.
%    N must be positive.
%
%    Input, real A(N,N), B(N,N), the R8GE factor matrices.
%
%    Output, real C(N,N), the R8GE product matrix.
%
  c(1:n,1:n) = a(1:n,1:n) * b(1:n,1:n);

  return
end


function [ fr1, fr2 ] = splitDouble( tt )
% breaks up a double number into a double integer part and a fractional part
%
% void split (double tt,
%
%             double *fr)
%
% ------------------------------------------------------------------------
%
%    PURPOSE:
%       This function breaks up a double number into a double integer
%       part and a fractional part.
%
%    REFERENCES:
%       Standish, E.M. and Newhall, X X (1988). "The JPL Export
%          Planetary Ephemeris"; JPL document dated 17 June 1988.
%
%    INPUT
%    ARGUMENTS:
%       tt (double)
%          Input number.
%
%    OUTPUT
%    ARGUMENTS:
%       *fr (double)
%          2-element output array;
%             fr[0] contains integer part,
%             fr[1] contains fractional part.
%          For negative input numbers,
%             fr[0] contains the next more negative integer;
%             fr[1] contains a positive fraction.
%
%    RETURNED
%    VALUE:
%       None.
%
%    GLOBALS
%    USED:
%       None.
%
%    FUNCTIONS
%    CALLED:
%       None.
%
%    VER./DATE/
%    PROGRAMMER:
%       V1.0/06-90/JAB (USNO/NA): CA coding standards
%       V1.1/03-93/WTH (USNO/AA): Convert to C.
%       V1.2/07-93/WTH (USNO/AA): Update to C standards.
%       V1.3/10-10/WKP (USNO/AA): Renamed function to lowercase to
%                                 comply with coding standards.
%
%    NOTES:
%       None.
%
% ------------------------------------------------------------------------

%   Get integer and fractional parts.

   ir = floor(tt);
   fr2 = tt - ir;
   fr1 = ir;

end


function fem_basis_test04 ( )

%*****************************************************************************80
%
%% FEM_BASIS_TEST04 repeats TEST01 using FEM_BASIS_MD.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    10 October 2010
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'FEM_BASIS_TEST04\n' );
  fprintf ( 1, '  FEM_BASIS_MD evaluates an arbitrary\n' );
  fprintf ( 1, '  basis function over an M-dimensional simplex.\n' );

  m = 1;

  i1 = [ 2, 1 ]';
  d = sum ( i1 );
  x1(1:m) = i1(1:m) / d;
  fprintf ( 1, '\n' );
  fprintf ( 1, '   I   J        X          L(I,J)(X)\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  %2d  %2d  %10.4f  %14.6g\n', i1(1:m+1), x1(1:m), 1.0 );
  fprintf ( 1, '\n' );
  for p1 = 0 : d
    i2(1) = p1;
    i2(m+1) = d - sum ( i2(1:m) );
    x2(1:m) = i2(1:m) / d;
    l = fem_basis_md ( m, i1, x2 );
    fprintf ( 1, '  %2d  %2d  %10.4f  %14.6g\n', i2(1:m+1), x2(1:m), l );
  end

  return
end


% Small technical example.
% Performs a check on the computation of certain central moments
% on a quincunx grid.
%
disp('Small technical example.');
disp('Performs a check on the computation of certain central moments');
disp('on a quincunx grid.');
disp('FOR MORE INFORMATION:  help Q0011mupq');
disp(' ');
disp('See also the report http://repository.cwi.nl:8888/cwi_repository/docs/IV/04/04178D.pdf');
disp('Dr. Paul M. de Zeeuw <Paul.de.Zeeuw@cwi.nl>');
disp(' (C) 1998-2006 Stichting CWI, Amsterdam, The Netherlands');
disp(' ');
%---INSERT YOUR IMAGE HERE-----------------------------------------------------
if exist('imread','file') == 2
  Orig = double(imread('zenithgray.TIF','tiff'));
else
  load zenithgray; Orig = zenithgray; clear zenithgray;
end
%
disp([' Dimensions ' int2str( size(Orig) )]);
%---EXTRACT A QUINCUNX GRIDFUNCTION-----
F00 = getcolor00(Orig);
F11 = getcolor11(Orig);
disp('The dimensions of the extracted quincunx gridfunction read as follows');
disp([int2str(size(F00)) ' and ' int2str(size(F11))]);
%
%---COMPUTE MASS------------------------
mu00 = Q0011mupq(F00, F11, 0, 0);
disp([' Mass  ' num2str( mu00, '%+12.4e')]);
%---NICE CHECK: OUTCOME SHOULD VANISH---
mu10 = Q0011mupq(F00, F11, 1, 0);
disp(' NICE CHECK: First order central moment (x-dir) should vanish');
disp([' reads ' num2str( mu10, '%+12.4e')]);
%---NICE CHECK: OUTCOME SHOULD VANISH---
mu01 = Q0011mupq(F00, F11, 0, 1);
disp(' NICE CHECK: First order central moment (y-dir) should vanish');
disp([' reads ' num2str( mu01, '%+12.4e')]);


% book : Signals and Systems Laboratory with MATLAB
% authors : Alex Palamides & Anastasia Veloni

% Fast Fourier Transform of the sequence x=[1 2 3],n=0,1,2

x=[1 2 3];

Xk1=fft(x)

Xk2=dft(x)


function func_LuminanceMasking
% Show luminance masking effect of HVS
% This function is part of the toolbox "Basic introduction to HVS"
%
% Command line
% ----------------------
% func_LuminanceMasking
% input:  None
%
% output: CSF figure
%
% More information can be found in
% S. E. Palmer, "Vision Science: From Photons to Phenomenology," MIT Press,
% Cambridge, MA, 1999.
%
%
% Jing Tian Apr.24 2004
% Contact me : scuteejtian@hotmail.com
% Homepage : http://ikanchi.yeah.net
% This program is written in Apr.2003 during my postgraduate in
% NTU, Singapore.
% ----------------------

freq = 1;
C = 0.05;
L = 100;

x = linspace(-1.5 * pi, 0.5 * pi, 100);
y = linspace(150, 50, 100);
[xx,yy] = meshgrid(x, y);

i = 1;
for L = 100 : 20 : 200;
	z = L .* C .* sin(2 .* pi .* freq .* xx) + L;
	imagesc(z);
	colormap gray;
	shading interp;
	ch = ['luminancemasking', num2str(i), '.bmp'];
	imwrite(z, gray(256), ch, 'bmp');
	i = i + 1;
end


function [y] = temporal_agg_p(z,op1,sc)
% PURPOSE: Temporal aggregation of a time series preserving its dimension
% ------------------------------------------------------------
% SYNTAX: y = temporal_agg_p(z,op1,sc);
% ------------------------------------------------------------
% OUTPUT: y: nx1 temporally aggregated series, missing=0
% ------------------------------------------------------------
% INPUT:  z: nx1 ---> vector of high frequency data
%         op1: type of temporal aggregation
%         op1=1 ---> sum (flow)
%         op1=2 ---> average (index)
%         op1=3 ---> last element (stock) ---> interpolation
%         op1=4 ---> first element (stock) ---> interpolation
%         sc: number of high frequency data points
%            for each low frequency data points
%         Note: n = sc x N
% ------------------------------------------------------------
% LIBRARY: aggreg
% ------------------------------------------------------------

% written by:
%  Enrique M. Quilis
%  Macroeconomic Research Department
%  Ministry of Economy and Competitiveness
%  <enrique.quilis@mineco.es>
% Version 1.0 [October 2010]

[n,m] = size(z);

% ------------------------------------------------------------
% Computes the number of low frequency points.
% Low frequency periods should be complete

N = fix(n/sc);
C = aggreg_p(op1,n,sc);

% -----------------------------------------------------------
% Expanding the aggregation matrix to perform
% extrapolation if needed.

if (n > sc * N)
   pred = n - sc*N;           % Number of required extrapolations
   C=[C zeros(N,pred)];
else
   pred = 0;
end

y = C*z;


function [Gs, op, nodes] = mk_nbrs_of_digraph(G0)
% MK_NBRS_OF_DIGRAPH Make all digraphs that differ from G0 by a single edge deletion, addition or reversal
% [Gs, op, nodes] = mk_nbrs_of_digraph(G0)
%
% Gs(:,:,i) is the i'th neighbor
% op{i} = 'add', 'del', or 'rev' is the operation used to create the i'th neighbor.
% nodes(i,1:2) are the head and tail of the operated-on arc.

debug = 0; % the vectorized version is about 3 to 10 times faster

n = length(G0);
[I,J] = find(G0); % I(k), J(k) is the k'th edge
E = length(I); % num edges present in G0

% SINGLE EDGE DELETIONS

Grep = repmat(G0(:), 1, E); % each column is a copy of G0
% edge_ndx(k) is the scalar location of the k'th edge
edge_ndx = find(G0);
% edge_ndx = subv2ind([n n], [I J]); % equivalent
% We set (ndx(k), k) to 0 for k=1:E in Grep
ndx = subv2ind(size(Grep), [edge_ndx(:) (1:E)']);
G1 = Grep;
G1(ndx) = 0;
Gdel = reshape(G1, [n n E]);

% if debug
% % Non-vectorized version
% ctr = 1;
% for e=1:E
%   i = I(e); j = J(e);
%   Gdel2(:,:,ctr) = G0;
%   Gdel2(i,j,ctr) = 0;
%   ctr = ctr + 1;
% end
% assert(isequal(Gdel, Gdel2));
% end

% SINGLE EDGE REVERSALS

% rev_edge_ndx(k) is the scalar location of the k'th reversed edge
%rev_edge_ndx = find(G0'); % different order to edge_ndx, which is bad
rev_edge_ndx = subv2ind([n n], [J I]);
% We set (rev_edge_ndx(k), k) to 1 for k=1:E in G1
% We have already deleted i->j in the previous step
ndx = subv2ind(size(Grep), [rev_edge_ndx(:) (1:E)']);
G1(ndx) = 1;
Grev = reshape(G1, [n n E]);

% if debug
% % Non-vectorized version
% ctr = 1;
% for e=1:E
%   i = I(e); j = J(e);
%   Grev2(:,:,ctr) = G0;
%   Grev2(i,j,ctr) = 0;
%   Grev2(j,i,ctr) = 1;
%   ctr = ctr + 1;
% end
% assert(isequal(Grev, Grev2));
% end

% SINGLE EDGE ADDITIONS

Gbar = ~G0; % Gbar(i,j)=1 iff there is no i->j edge in G0
Gbar = setdiag(Gbar, 0); % turn off self loops
[Ibar,Jbar] = find(Gbar);

bar_edge_ndx = find(Gbar);
Ebar = length(Ibar); % num edges present in Gbar
Grep = repmat(G0(:), 1, Ebar); % each column is a copy of G0
ndx = subv2ind(size(Grep), [bar_edge_ndx(:) (1:Ebar)']);
Grep(ndx) = 1;
Gadd = reshape(Grep, [n n Ebar]);

% if debug
% % Non-vectorized version
% ctr = 1;
% for e=1:length(Ibar)
%   i = Ibar(e); j = Jbar(e);
%   Gadd2(:,:,ctr) = G0;
%   Gadd2(i,j,ctr) = 1;
%   ctr = ctr + 1;
% end
% assert(isequal(Gadd, Gadd2));
% end

Gs = cat(3, Gdel, Grev, Gadd);

nodes = [I J;
	 I J;
	 Ibar Jbar];

op = cell(1, E+E+Ebar);
op(1:E) = {'del'};
op(E+1:2*E) = {'rev'};
op(2*E+1:end) = {'add'};

% numeric output:
% op(i) = 1, 2, or 3, if the i'th neighbor was created by adding, deleting or reversing an arc.

ADD = 1;
DEL = 2;
REV = 3;

%op = [repmat(DEL, 1, E) repmat(REV, 1, E) repmat(ADD, 1, Ebar)];


function [t,s]=zerocros(x,m)
%ZEROCROS finds the zeros crossings in a signal [T,S]=(X,M)% find zero crossings in a signal
% Inputs:  x = input waveform
%          m = mode string containing:
%              'p' - positive crossings only
%              'n' - negative crossings only
%              'b' - both (default)
%              'r' - round to integer values
%
% Outputs: t = sample positions of zero crossings (not necessarily integers)
%          s = estimated slope of x at the zero crossing
%
% This routine uses linear interpolation to estimate the position of a zero crossing
% A zero crossing occurs between x(n) and x(n+1) iff (x(n)>=0) ~= (x(n+1)>=0)

% Example: x=sin(2*pi*(0:1000)/200); x(1:100:1001)=0; zerocros(x);
% Note that we get a zero crossing at the end but not at the start.

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

if nargin<2
    m='b';
end
s=x>=0;
k=s(2:end)-s(1:end-1);
if any(m=='p')
    f=find(k>0);
elseif any(m=='n')
    f=find(k<0);
else
    f=find(k~=0);
end
s=x(f+1)-x(f);
t=f-x(f)./s;
if any(m=='r')
    t=round(t);
end
if ~nargout
    n=length(x);
    plot(1:n,x,'-',t,zeros(length(t),1),'o');
end


function test_approx_test12 ( )

%*****************************************************************************80
%
%% TEST_APPROX_TEST12 plots a Bernstein spline approximant for problem 7.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 February 2012
%
%  Author:
%
%    John Burkardt
%
  approx_filename = 'test12_approx.txt';
  data_filename = 'test12_data.txt';
  nplot = 101;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST_APPROX_TEST12\n' );
  fprintf ( 1, '  Plot a Bernstein approximant for problem 5.\n' );
  fprintf ( 1, '  Note that the Bernstein approximant requires equally\n' );
  fprintf ( 1, '  spaced data.\n' );

  prob = 5;
%
%  Get the data.
%
  data_num = p00_data_num ( prob );

  [ xdata, ydata ] = p00_dat ( prob, data_num );

  r8vec2_write ( data_filename, data_num, xdata, ydata )

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Data values stored in "%s"\n', data_filename );
%
%  Evaluate the approximant function.
%
  a = xdata(1);
  b = xdata(data_num);

  xplot = zeros ( nplot, 1 );
  yplot = zeros ( nplot, 1 );

  for plot = 1 : nplot

    xval = ( ( nplot - plot     ) * a     ...
           + (         plot - 1 ) * b ) ...
           / ( nplot        - 1 );

    yval = bpab_approx ( data_num - 1, a, b, ydata, xval );

    xplot(plot) = xval;
    yplot(plot) = yval;

  end

  r8vec2_write ( approx_filename, nplot, xplot, yplot );

  fprintf ( 1, '  Approximant values stored in "%s"\n', approx_filename );

  return
end


classdef RegressionLoss < dagnn.Loss

  properties
    lossType = 1.
  end

  methods
    function outputs = forward(obj, inputs, params)
        X = inputs{1};
        c = inputs{2};
        assert(numel(X) == numel(c));
        c = reshape(c,[1,1,size(c)]);
        switch obj.lossType
            case 'CE'
                X = vl_nnsigmoid(X);
                Y = sum(squeeze(-c.*log(X) - (1-c).*log(1.001-X)));
            case 'MSE'
                Y = sum(squeeze((X - c).^2));
            case 'Huber'
                delta = 1.0;
                a = abs(squeeze(X - c));
                y1 = 0.5*sum(a(a<=delta).^2);
                y2 = sum((a(a>delta)-0.5*delta)*delta);
                Y = y1 + y2;
        end
        outputs{1} = Y;
        if obj.ignoreAverage, return; end;
        n = obj.numAveraged ;
        m = n + size(inputs{2},2);
        obj.average = (n * obj.average + gather(outputs{1})) / m ;
        obj.numAveraged = m ;
    end

    function [derInputs, derParams] = backward(obj, inputs, params, derOutputs)
        X = inputs{1};
        c = inputs{2};
        assert(numel(X) == numel(c));
        c = reshape(c,[1,1,size(c)]);
        switch obj.lossType
            case 'CE'
                X = vl_nnsigmoid(X);
                Y = X - c;
            case 'MSE'
                Y = X - c;
            case 'Huber'
                delta = 1;
                a = X - c;
                Y = X - c;
                Y(a>delta) = delta;
                Y(a<-delta) = - delta;
        end
        derInputs = {Y, []};
        derParams = {};
    end

    function obj = RegressionLoss(varargin)
      obj.load(varargin) ;
    end
  end
end


function y = mean(w)
   %MEAN Average or mean value of waveform's data.
   %   Y = mean(waveform)
   %   returns a scalar containing the mean value of the waveform data
   %
   %   Input Arguments
   %       WAVEFORM: waveform object   N-DIMENSIONAL
   %
   %   Output
   %       Y: array of same size as WAVEFORM, with each element corresponding
   %          to the mean value of the matching waveform
   %
   %   NOTE: Values of NaN are ignored.
   %
   %   See also NANMEAN, WAVEFORM/MIN, WAVEFORM/MAX, WAVEFORM/MEDIAN, SORT.

   % AUTHOR: Celso Reyes, Geophysical Institute, Univ. of Alaska Fairbanks
   % $Date$
   % $Revision$

   y = nan(size(w));
   % if the statistics toolbox is installed, use the builtin nanmean function
   % to ignore NaN values during the variance calculation.
   if ~isempty(ver('stats'))
      for I = 1 : numel(w);
         y(I) = nanmean( w(I).data );
      end
   else
      % the statistics toolbox is not installed, so any nan values will have
      % to be dealt with (ignored) manually.
      for I = 1 : numel(w);
         d = w(I).data;
         d = d(~isnan(d)); %ignore NaN values
         if ~isempty(d)
            y(I) = mean( d );
         end
      end
   end
end


function Choose = LastSelection(PopObj1,PopObj2,K,Z,Zmin)
% Select part of the solutions in the last front

%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

% This function is written by Zhenshou Song
% Email: zssong@stu.xidian.edu.cn

    PopObj = [PopObj1;PopObj2] - repmat(Zmin,size(PopObj1,1)+size(PopObj2,1),1);
    [N,M]  = size(PopObj);
    N1     = size(PopObj1,1);
    N2     = size(PopObj2,1);
    NZ     = size(Z,1);

    %% Normalization
    % Detect the extreme points
    Extreme = zeros(1,M);
    w       = zeros(M)+1e-6+eye(M);
    for i = 1 : M
        [~,Extreme(i)] = min(max(PopObj./repmat(w(i,:),N,1),[],2));
    end
    % Calculate the intercepts of the hyperplane constructed by the extreme
    % points and the axes
    Hyperplane = PopObj(Extreme,:)\ones(M,1);
    a = 1./Hyperplane;
    if any(isnan(a))
        a = max(PopObj,[],1)';
    end
    % Normalization
    PopObj = PopObj./repmat(a',N,1);

    %% Associate each solution with one reference point
    % Calculate the distance of each solution to each reference vector
    Cosine   = 1 - pdist2(PopObj,Z,'cosine');
    Distance = repmat(sqrt(sum(PopObj.^2,2)),1,NZ).*sqrt(1-Cosine.^2);
    % Associate each solution with its nearest reference point
    [d,pi] = min(Distance',[],1);

    %% Calculate the number of associated solutions except for the last front of each reference point
    rho = hist(pi(1:N1),1:NZ);

    %% Environmental selection
    Choose  = false(1,N2);
    Zchoose = true(1,NZ);
    % Select K solutions one by one
    while sum(Choose) < K
        % Select the least crowded reference point
        Temp = find(Zchoose);
        Jmin = find(rho(Temp)==min(rho(Temp)));
        j    = Temp(Jmin(randi(length(Jmin))));
        I    = find(Choose==0 & pi(N1+1:end)==j);
        % Then select one solution associated with this reference point
        if ~isempty(I)
            if rho(j) == 0
                [~,s] = min(d(N1+I));
            else
                s = randi(length(I));
            end
            Choose(I(s)) = true;
            rho(j) = rho(j) + 1;
        else
            Zchoose(j) = false;
        end
    end
end


function [im_x, im_y] = project( camera, world_X, world_Y, world_Z )
%PROJECT: project a 3D point into an image
%
%   [IM_X,IM_Y] = PROJECT(CAMERA,WORLD_X,WORLD_Y,WORLD_Z) projects one or
%   more 3D point in the world coordinate frame into image coordinates

%   Copyright 2005-2009 The MathWorks, Inc.
%   $Revision: 1.0 $    $Date: 2006/06/30 00:00:00 $

z = camera.rawP(3,1) * world_X ...
    + camera.rawP(3,2) * world_Y ...
    + camera.rawP(3,3) * world_Z ...
    + camera.rawP(3,4);
im_y = round( (camera.rawP(2,1) * world_X ...
    + camera.rawP(2,2) * world_Y ...
    + camera.rawP(2,3) * world_Z ...
    + camera.rawP(2,4)) ./ z);
im_x = round( (camera.rawP(1,1) * world_X ...
    + camera.rawP(1,2) * world_Y ...
    + camera.rawP(1,3) * world_Z ...
    + camera.rawP(1,4)) ./ z);


function str = sim_dampedOscillator(f0,tau,fs,varnum)
% return a string corresponding to the equation of motion of a damped
% oscillator. This is meant to be compatible with format used in
% sim_genVARModelFromEq()
%
% f0:   fundamental frequency (Hz)
% tau:  damping time (e.g. 100). Larger values --> more sinusoidal
% fs:   samping rate
% varnum: the index of the channel/variable being model
% (e.g. x2 --> varnum = 2)
%
% (C) Tim Mullen, May, 2011. SCCN/INC UCSD

str = sprintf('{2*exp(-1/%f)*cos(2*pi*%f/%f)}*x%d(t-1) + -exp(-2/%f)*x%d(t-2)',tau,f0,fs,varnum,tau,varnum);


function dgrav=model_grav(sys,rr,rs)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%obtains the gravitational delay correction for the effect of general
%relativity (red shift) to the GPS signal
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
global glc
dgrav=0;

if norm(rr)<=0||norm(rs)<=0,return;end

rec_module=sqrt(rr(1)^2+rr(2)^2+rr(3)^2);
sat_module=sqrt(rs(1)^2+rs(2)^2+rs(3)^2);
distance  =norm(rr-rs);

switch sys
    case glc.SYS_GLO,MU=glc.MU_GLO;
    case glc.SYS_GAL,MU=glc.MU_GAL;
    case glc.SYS_BDS,MU=glc.MU_BDS;
    otherwise,       MU=glc.MU_GPS;
end

dgrav=2*MU/glc.CLIGHT^2*log((rec_module+sat_module+distance)/(rec_module+sat_module-distance));

return


% Copyright (C) Daphne Koller, Stanford University, 2012

function EU = SimpleCalcExpectedUtility(I)

  % Inputs: An influence diagram, I (as described in the writeup).
  %         I.RandomFactors = list of factors for each random variable.  These are CPDs, with
  %              the child variable = D.var(1)
  %         I.DecisionFactors = factor for the decision node.
  %         I.UtilityFactors = list of factors representing conditional utilities.
  % Return Value: the expected utility of I
  % Given a fully instantiated influence diagram with a single utility node and decision node,
  % calculate and return the expected utility.  Note - assumes that the decision rule for the
  % decision node is fully assigned.

  % In this function, we assume there is only one utility node.
  F = [I.RandomFactors I.DecisionFactors];
  U = I.UtilityFactors(1);
  EU = [];
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  %
  % YOUR CODE HERE
  %
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  Fnew = VariableElimination(F,setdiff(unique([F.var]),U.var));
  %Fnew = F;
  out = Fnew(1);
  for i = 2:length(Fnew)
	  out = FactorProduct(out,Fnew(i));
  end

  hha = U;
  hha.val = ones(1,length(U.val));
  out = FactorProduct(hha,out);
  U = FactorProduct(hha,U);
  %out = FactorMarginalization(out,setdiff(unique([F.var]),U.var));

EU = [sum(out.val.*U.val)];

end


function lik = lik_multinom(varargin)
%LIK_MULTINOM  Create a multinomial likelihood structure
%
%  Description
%    LIK = LIK_MULTINOM creates multinomial likelihood for multi-class
%    count data. The observed numbers in each class with C classes is
%    given as 1xC vector.
%
%    The likelihood is defined as follows:
%                              __ n                __ C
%      p(y|f^1, ..., f^C, z) = || i=1 [ gamma(N+1) || c=1 p_i^c^(y_i^c)/gamma(y_i^c+1)]
%
%    where p_i^c = exp(f_i^c)/ (sum_c=1^C exp(f_i^c)) is the succes
%    probability for class c, which is a function of the latent variable
%    f_i^c for the corresponding class and N=sum(y) is the number of trials.
%
%  See also
%    GP_SET, LIK_*
%
% Copyright (c) 2010 Jaakko Riihimäki, Pasi Jylänki
% Copyright (c) 2010 Aki Vehtari
% Copyright (c) 2010 Jarno Vanhatalo

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

  ip=inputParser;
  ip.FunctionName = 'LIK_MULTINOM';
  ip.addOptional('lik', [], @isstruct);
  ip.parse(varargin{:});
  lik=ip.Results.lik;

  if isempty(lik)
    init=true;
    lik.type = 'Multinom';
    lik.nondiagW = true;
  else
    if ~isfield(lik,'type') || ~isequal(lik.type,'Multinom')
      error('First argument does not seem to be a valid likelihood function structure')
    end
    init=false;
  end

  if init
    % Set the function handles to the subfunctions
    lik.fh.pak = @lik_multinom_pak;
    lik.fh.unpak = @lik_multinom_unpak;
    lik.fh.ll = @lik_multinom_ll;
    lik.fh.llg = @lik_multinom_llg;
    lik.fh.llg2 = @lik_multinom_llg2;
    lik.fh.llg3 = @lik_multinom_llg3;
    lik.fh.tiltedMoments = @lik_multinom_tiltedMoments;
    lik.fh.predy = @lik_multinom_predy;
    lik.fh.invlink = @lik_multinom_invlink;
    lik.fh.recappend = @lik_multinom_recappend;
  end

end

function [w,s,h] = lik_multinom_pak(lik)
%LIK_MULTINOM_PAK  Combine likelihood parameters into one vector.
%
%  Description
%    W = LIK_MULTINOM_PAK(LIK) takes a likelihood structure LIK and
%    returns an empty verctor W. If Multinom likelihood had
%    parameters this would combine them into a single row vector
%    W (see e.g. lik_negbin). This is a mandatory subfunction used
%    for example in energy and gradient computations.
%
%
%  See also
%    LIK_MULTINOM_UNPAK, GP_PAK

  w = []; s = {};h=[];
end

function [lik, w] = lik_multinom_unpak(lik, w)
%LIK_MULTINOM_UNPAK  Extract likelihood parameters from the vector.
%
%  Description
%    W = LIK_MULTINOM_UNPAK(W, LIK) Doesn't do anything.
%
%    If Multinom likelihood had parameters this would extracts them
%    parameters from the vector W to the LIK structure. This is a
%    mandatory subfunction used for example in energy and gradient
%    computations.
%
%
%  See also
%    LIK_MULTINOM_PAK, GP_UNPAK

  lik=lik;
  w=w;
end

function ll = lik_multinom_ll(lik, y, f, z)
%LIK_MULTINOM_LL  Log likelihood
%
%  Description
%    LL = LIK_MULTINOM_LL(LIK, Y, F) takes a likelihood structure
%    LIK, class counts Y (NxC matrix), and latent values F (NxC
%    matrix). Returns the log likelihood, log p(y|f,z). This
%    subfunction is needed when using Laplace approximation or
%    MCMC for inference with non-Gaussian likelihoods. This
%    subfunction is also used in information criteria
%    (DIC, WAIC) computations.
%
%  See also
%    LIK_MULTINOM_LLG, LIK_MULTINOM_LLG3, LIK_MULTINOM_LLG2, GPLA_E

  f=reshape(f,size(y));
  expf = exp(f);
  p = expf ./ repmat(sum(expf,2),1,size(expf,2));
  N = sum(y,2);

  ll = sum(gammaln(N+1) - sum(gammaln(y+1),2) + sum(y.*log(p),2) );

end

function llg = lik_multinom_llg(lik, y, f, param, z)
%LIK_MULTINOM_LLG    Gradient of the log likelihood
%
%  Description
%    LLG = LIK_MULTINOM_LLG(LIK, Y, F, PARAM) takes a likelihood
%    structure LIK, class labels Y, and latent values F. Returns
%    the gradient of the log likelihood with respect to PARAM. At
%    the moment PARAM can be 'param' or 'latent'. This subfunction
%    is needed when using Laplace approximation or MCMC for inference
%    with non-Gaussian likelihoods.
%
%  See also
%    LIK_MULTINOM_LL, LIK_MULTINOM_LLG2, LIK_MULTINOM_LLG3, GPLA_E

  f=reshape(f,size(y));
  C = size(y,2);
  expf2 = exp(f);
  N=sum(y, 2);
  pi2 = (N*ones(1,C)).*expf2./(sum(expf2, 2)*ones(1,C));
  pi_vec=pi2(:);
  llg = y(:)-pi_vec;

end

function [pi_vec, pi_mat] = lik_multinom_llg2(lik, y, f, param, z)
%LIK_MULTINOM_LLG2  Second gradients of the log likelihood
%
%  Description
%    LLG2 = LIK_MULTINOM_LLG2(LIK, Y, F, PARAM) takes a likelihood
%    structure LIK, class labels Y, and latent values F. Returns
%    the Hessian of the log likelihood with respect to PARAM. At
%    the moment PARAM can be only 'latent'. LLG2 is a vector with
%    diagonal elements of the Hessian matrix (off diagonals are
%    zero). This subfunction is needed when using Laplace
%    approximation or EP for inference with non-Gaussian likelihoods.
%
%  See also
%    LIK_MULTINOM_LL, LIK_MULTINOM_LLG, LIK_MULTINOM_LLG3, GPLA_E

% multinom:
  [n,nout]=size(y);
  N = sum(y,2)*ones(1,nout);
  f=reshape(f,n,nout);

  expf2 = exp(f);
  pi2 = expf2./(sum(expf2, 2)*ones(1,nout));
  pi_vec=pi2(:).*N(:);

  pi_mat=zeros(nout*n, n);
  for i1=1:nout
    pi_mat((1+(i1-1)*n):(nout*n+1):end)=pi2(:,i1).*sqrt(N(:,i1));
  end
  %     D = diag(pi_vec);
  %     llg2 = -D + pi_mat*pi_mat';

end

function [dw_mat] = lik_multinom_llg3(lik, y, f, param, z)
%LIK_MULTINOM_LLG3  Third gradients of the log likelihood
%
%  Description
%    LLG3 = LIK_MULTINOM_LLG3(LIK, Y, F, PARAM) takes a likelihood
%    structure LIK, class labels Y, and latent values F and
%    returns the third gradients of the log likelihood with
%    respect to PARAM. At the moment PARAM can be only 'latent'.
%    LLG3 is a vector with third gradients. This subfunction is
%    needed when using Laplace approximation for inference with
%    non-Gaussian likelihoods.
%
%  See also
%    LIK_MULTINOM_LL, LIK_MULTINOM_LLG, LIK_MULTINOM_LLG2, GPLA_E, GPLA_G

  [n,nout] = size(y);
  f2 = reshape(f,n,nout);

  N=sum(y, 2);
  expf2 = exp(f2);
  pi2 = expf2./(sum(expf2, 2)*ones(1,nout));
  pi_vec=pi2(:);

  dw_mat=zeros(nout,nout,nout,n);

  for cc3=1:nout
    for ii1=1:n

      pic=pi_vec(ii1:n:(nout*n));
      for cc1=1:nout
        for cc2=1:nout

          % multinom third derivatives
          cc_sum_tmp=0;
          if cc1==cc2 && cc1==cc3 && cc2==cc3
            cc_sum_tmp=cc_sum_tmp+pic(cc1);
          end
          if cc1==cc2
            cc_sum_tmp=cc_sum_tmp-pic(cc1)*pic(cc3);
          end
          if cc2==cc3
            cc_sum_tmp=cc_sum_tmp-pic(cc1)*pic(cc2);
          end
          if cc1==cc3
            cc_sum_tmp=cc_sum_tmp-pic(cc1)*pic(cc2);
          end
          cc_sum_tmp=cc_sum_tmp+2*pic(cc1)*pic(cc2)*pic(cc3);

          dw_mat(cc1,cc2,cc3,ii1)=cc_sum_tmp.*N(ii1);
        end
      end
    end
  end

end

function [logM_0, m_1, sigm2hati1] = lik_multinom_tiltedMoments(lik, y, i1, S2_i, M_i, z)
    %LIK_COXPH_TILTEDMOMENTS  Returns the marginal moments for EP algorithm
    %
    %  Description
    %    [M_0, M_1, M2] = LIK_COXPH_TILTEDMOMENTS(LIK, Y, I, S2,
    %    MYY, Z) takes a likelihood structure LIK, class labels
    %    Y, index I and cavity variance S2 and
    %    mean MYY. Returns the zeroth moment M_0, mean M_1 and
    %    variance M_2 of the posterior marginal (see Rasmussen and
    %    Williams (2006): Gaussian processes for Machine Learning,
    %    page 55). This subfunction is needed when using EP for
    %    inference with non-Gaussian likelihoods.
    %
    %  See also
    %    GPEP_E

    error('tiltedMoment has not been implemented for multinom likelihood');

end

function [lpy, Ey, Vary] = lik_multinom_predy(lik, Ef, Varf, yt, zt)
%LIK_MULTINOM_PREDY  Returns the predictive mean, variance and density of y
%
%  Description
%    LPY = LIK_MULTINOM_PREDY(LIK, EF, VARF YT)
%    Returns logarithm of the predictive density PY of YT, that is
%        p(yt | y) = \int p(yt | f) p(f|y) df.
%    This requires also the incedence counts YT. This subfunction
%    is needed when computing posterior predictive distributions for
%    future observations.
%
%    [LPY, EY, VARY] = LIK_MULTINOM_PREDY(LIK, EF, VARF, YT) takes a
%    likelihood structure LIK, posterior mean EF and posterior
%    Variance VARF of the latent variable and returns the
%    posterior predictive mean EY and variance VARY of the
%    observations related to the latent variables. This subfunction
%    is needed when computing posterior predictive distributions for
%    future observations.
%

%
%  See also
%    GPLA_PRED, GPEP_PRED, GPMC_PRED

  N=sum(yt,2);
  S=10000;
  [ntest, nout]=size(yt);
  pi=zeros(ntest,nout);
  lpy=zeros(ntest,nout);
  Ey=zeros(ntest,nout);
  Vary=zeros(size(Varf));
  Ef=reshape(Ef(:),ntest,nout);
  [notused,notused,c] =size(Varf);
  if c>1
    mcmc=false;
  else
    mcmc=true;
    Varf=reshape(Varf(:), ntest, nout);
  end
  for i1=1:ntest
    if mcmc
      Sigm_tmp = (Varf(i1,:));
      f_star=bsxfun(@plus, Ef(i1,:), bsxfun(@times, sqrt(Sigm_tmp), ...
        randn(S,nout)));
    else
      Sigm_tmp=(Varf(:,:,i1)'+Varf(:,:,i1))./2;
      f_star=mvnrnd(Ef(i1,:), Sigm_tmp, S);
    end

    tmp = exp(f_star);
    tmp = tmp./(sum(tmp, 2)*ones(1,size(tmp,2)));

    if nargout > 1
        Ey(i1,:) = N(i1).*mean(tmp);
        for z1 = 1:nout;
          for z2 = 1:nout
            for z3=1:S
              Var_tmp(:,:,z3) = (diag(tmp(z3,:)) - tmp(z3,:)'*tmp(z3,:));
            end
            if mcmc
              Vary(i1+(0:nout-1)*ntest,:) = diag(N(i1).*mean(Var_tmp,3));
            else
              Vary(:,:,i1) = N(i1).*mean(Var_tmp,3);
            end
          end
        end
    end
    lpy=[];
    if ~isempty(yt)
      ytmp = repmat(yt(i1,:),S,1);
      lpy(i1,:) = log(mean( mnpdf(ytmp,tmp) ));
    end
  end
  lpy=lpy(:);
  Ey=Ey(:);
  Vary=Vary(:);
end

function p = lik_multinom_invlink(lik, f, z)
%LIK_MULTINOM_INVLINK Returns values of inverse link function
%
%  Description
%    P = LIK_MULTINOM_INVLINK(LIK, F) takes a likelihood structure LIK and
%    latent values F and returns the values of inverse link function P.
%    This subfunction is needed when using function gp_predprctmu.
%
%     See also
%     LIK_MULTINOM_LL, LIK_MULTINOM_PREDY
p = multinominv(f).*z;
end

function reclik = lik_multinom_recappend(reclik, ri, lik)
%RECAPPEND  Append the parameters to the record
%
%  Description
%    RECLIK = LIK_MULTINOM_RECAPPEND(RECLIK, RI, LIK) takes a
%    likelihood record structure RECLIK, record index RI and
%    likelihood structure LIK with the current MCMC samples of
%    the parameters. Returns RECLIK which contains all the old
%    samples and the current samples from LIK. This subfunction
%    is needed when using MCMC sampling (gp_mc).
%
%  See also
%    GP_MC

  if nargin == 2
    reclik.type = 'Multinom';
    reclik.nondiagW = true;

    % Set the function handles
    reclik.fh.pak = @lik_multinom_pak;
    reclik.fh.unpak = @lik_multinom_unpak;
    reclik.fh.ll = @lik_multinom_ll;
    reclik.fh.llg = @lik_multinom_llg;
    reclik.fh.llg2 = @lik_multinom_llg2;
    reclik.fh.llg3 = @lik_multinom_llg3;
    reclik.fh.tiltedMoments = @lik_multinom_tiltedMoments;
    reclik.fh.predy = @lik_multinom_predy;
    reclik.fh.invlink = @lik_multinom_invlink;
    reclik.fh.recappend = @lik_multinom_recappend;
  end

end


% PRMF (Wang et al. 2012)
% process_video('RPCA', 'PRMF', 'dataset/demo.avi', 'output/demo_PRMF.avi');
X = normalize(M);
rk = 2;
lambdaU = 1;
lambdaV = 1;
tol = 1e-2;
[P, Q] = RPMF(X, rk, lambdaU, lambdaV, tol);
L = P * Q;
%S = abs(X - P * Q);
S = X - L;


function err = getL2error(node,elem,uexact,uh,quadOrder,varargin)
%% GETL2ERROR L2 norm of the approximation error.
%
%  err = getL2error(node,elem,@uexact,uh) computes the L2 norm of the error
%  between the exact solution uexact and a finite element approximation uh
%  on a mesh described by node and elem.
%
%  The input parameter uexact is a function handle and uh is a column array
%  which could be:
%    - P0 element i.e. discontinuous and piecewise constant
%    - P1 element i.e. continuous and piecewise linear
%    - CR element i.e. piecewise linear and continuous at mid pts of edges
%    - P2 element i.e. continuous and piecewise quadratic
%    - P1+P0 element which could happen in the fluid application
%
%  err = getL2error(node,elem,@uexact,uh,quadOrder) computes error
%  using the quadrature rule with order quadOrder (up to 5). The default
%  order is 3.
%
%  Example: compute L2 error of piecewise linear interpolation
%
%     [node,elem] = squaremesh([0,1,0,1],0.25);
%     for k = 1:4
%         exactu = inline('sin(pi*pxy(:,1)).*sin(pi*pxy(:,2))','pxy');
%         uI = exactu(node);
%         N(k) = size(node,1);
%         err(k) = getL2error(node,elem,exactu,uI);
%         [node,elem] = uniformrefine(node,elem);
%     end
%     showrate(N,err);
%
% The cubic element is added by Jie Zhou.
%
% See also getH1error, getL2error3, getH1error3, quadpts.
%
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

Nu = length(uh);    N = size(node,1);   NT = size(elem,1);
% Euler formula N-NE+NT = c % rough estimateus using Euler formula
NE = N + NT;    NP2 = N + NE;   NP3 = N + 2*NE + NT;
%% Default quadrature orders for different elements
if Nu > N+NT-5
    elem2dof = dofP2(elem);
    NP2 = max(elem2dof(:));
    NE = NP2 - N;
    NP3 = N+2*NE+NT;
end

%% Default quadrature orders for different elements
if ~exist('quadOrder','var')
    switch Nu
        case NT     % piecewise constant function P0
            quadOrder = 2;
        case N      % piecewise linear function P1 element
            quadOrder = 3;
        case NE     % piecewise linear function CR element
            quadOrder = 3;
        case N+NT   % piecewise linear function + constant function
            quadOrder = 3;
        case NP2    % piecewise quadratic function
            quadOrder = 4;
        case NE+NT  % weak Galerkin element
            quadOrder = 3;
        case NP3    % P3 element
            quadOrder = 5;
    end
end

%% compute L2 error element-wise using quadrature rule with order quadOrder
err = zeros(NT,1);
[lambda,weight] = quadpts(quadOrder);
% basis function at quadrature points
switch Nu
    case N    % P1 piecewise linear function
        phi = lambda; % linear bases
    case N+NT % P1+P0
        phi = lambda; % linear bases
    case NE  % CR nonconforming P1 element
        phi = 1-2*lambda;
        elem2edge = elem2dof(:,4:6) - N;
    case NP2 % P2 piecewise quadratic elements
        phi(:,1) = lambda(:,1).*(2*lambda(:,1)-1);
        phi(:,2) = lambda(:,2).*(2*lambda(:,2)-1);
        phi(:,3) = lambda(:,3).*(2*lambda(:,3)-1);
        phi(:,4) = 4*lambda(:,2).*lambda(:,3);
        phi(:,5) = 4*lambda(:,1).*lambda(:,3);
        phi(:,6) = 4*lambda(:,2).*lambda(:,1);
    case NE+NT  % weak Galerkin element
%             uhp = uh(1:NT); % only count the interior part
        phi = 1-2*lambda;
        elem2edge = elem2dof(:,4:6) - N + NT;
    case 2*NE+NT+N % P3 piecewise cubic elements
        phi(:,1) = 0.5*(3*lambda(:,1)-1).*(3*lambda(:,1)-2).*lambda(:,1);
        phi(:,2) = 0.5*(3*lambda(:,2)-1).*(3*lambda(:,2)-2).*lambda(:,2);
        phi(:,3) = 0.5*(3*lambda(:,3)-1).*(3*lambda(:,3)-2).*lambda(:,3);
        phi(:,4) = 9/2*lambda(:,3).*lambda(:,2).*(3*lambda(:,2)-1);
        phi(:,5) = 9/2*lambda(:,3).*lambda(:,2).*(3*lambda(:,3)-1);
        phi(:,6) = 9/2*lambda(:,1).*lambda(:,3).*(3*lambda(:,3)-1);
        phi(:,7) = 9/2*lambda(:,1).*lambda(:,3).*(3*lambda(:,1)-1);
        phi(:,8) = 9/2*lambda(:,1).*lambda(:,2).*(3*lambda(:,1)-1);
        phi(:,9) = 9/2*lambda(:,1).*lambda(:,2).*(3*lambda(:,2)-1);
        phi(:,10) = 27*lambda(:,1).*lambda(:,2).*lambda(:,3);
        elem2dof = dofP3(elem);
end
nQuad = size(lambda,1);
for p = 1:nQuad
    % evaluate uh at quadrature point
    switch Nu
        case NT   % P0 piecewise constant function
            uhp = uh;
        case N    % P1 piecewise linear function
            uhp = uh(elem(:,1))*phi(p,1) + ...
                  uh(elem(:,2))*phi(p,2) + ...
                  uh(elem(:,3))*phi(p,3);
        case N+NT % P1+P0
            uhp = uh(elem(:,1))*phi(p,1) + ...
                  uh(elem(:,2))*phi(p,2) + ...
                  uh(elem(:,3))*phi(p,3);
            uhp = uhp + uh(N+1:end);
        case NE  % CR nonconforming P1 element
            uhp = uh(elem2edge(:,1))*phi(p,1) + ...
                  uh(elem2edge(:,2))*phi(p,2) + ...
                  uh(elem2edge(:,3))*phi(p,3);
        case NP2 % P2 piecewise quadratic function
            uhp = uh(elem2dof(:,1)).*phi(p,1) + ...
                  uh(elem2dof(:,2)).*phi(p,2) + ...
                  uh(elem2dof(:,3)).*phi(p,3) + ...
                  uh(elem2dof(:,4)).*phi(p,4) + ...
                  uh(elem2dof(:,5)).*phi(p,5) + ...
                  uh(elem2dof(:,6)).*phi(p,6);
        case NP3
            uhp = uh(elem2dof(:,1)).*phi(p,1) + ...
                  uh(elem2dof(:,2)).*phi(p,2) + ...
                  uh(elem2dof(:,3)).*phi(p,3) + ...
                  uh(elem2dof(:,4)).*phi(p,4) + ...
                  uh(elem2dof(:,5)).*phi(p,5) + ...
                  uh(elem2dof(:,6)).*phi(p,6) + ...
                  uh(elem2dof(:,7)).*phi(p,7) + ...
                  uh(elem2dof(:,8)).*phi(p,8) + ...
                  uh(elem2dof(:,9)).*phi(p,9) + ...
                  uh(elem2dof(:,10)).*phi(p,10);
        case NE+NT  % weak Galerkin element
%             uhp = uh(1:NT); % only count the interior part
            uhp = uh(elem2edge(:,1))*phi(p,1) + ...
                  uh(elem2edge(:,2))*phi(p,2) + ...
                  uh(elem2edge(:,3))*phi(p,3);
    end
    % quadrature points in the x-y coordinate
    pxy = lambda(p,1)*node(elem(:,1),:) ...
        + lambda(p,2)*node(elem(:,2),:) ...
        + lambda(p,3)*node(elem(:,3),:);
    err = err + weight(p)*(uexact(pxy) - uhp).^2;
end
%% Modification
% area of triangles
ve2 = node(elem(:,1),:)-node(elem(:,3),:);
ve3 = node(elem(:,2),:)-node(elem(:,1),:);
area = 0.5*abs(-ve3(:,1).*ve2(:,2)+ve3(:,2).*ve2(:,1));
err = area.*err;
err(isnan(err)) = 0; % singular values, i.e. uexact(p) = infty, are excluded
err = sqrt(sum(err));


function [A,E,Y] = singular_value_rpca( D, lambda, tau, delta, svdMethod, A0)

%   Solves the Robust PCA relaxation
%
%      min  \tau ( |A|_* + \lambda |E|_1 ) + 1/2 |(A,E)|_F^2
%      subj  A+E = D
%
%   by iterative thresholding.
%
%   Inputs:
%      D      -- the data matrix, m x n.
%      lambda -- relative weight of sparsity of error
%
%   Optional:
%      tau    -- magnitude of L2 relaxation of the pure robust PCA SDP,
%                 higher value is desirable.
%      delta  -- stepsize, should be in (0,1).
%      svdMethod -- SVD routine to be used in each iteration, must be one
%                    of 'svdlibc', 'propack', or 'svds'. If not any of
%                    these, default option is MATLAB's svd command. (May
%                    require additional library dependencies if custom routine is used.)
%      A0 -- true low-rank solution, if known, to enable better display of
%            progress in each iteration.
%
%   Outputs:
%      A      -- estimate of the low-rank generating matrix
%      E      -- estimate of the error or corruption
%
%   Winter '08, John Wright, Shankar Rao. Questions? jnwright@uiuc.edu
%
%   Copyright: Perception and Decision Laboratory
%			University of Illinois, Urbana-Champaign

VERBOSE                         = 2;
EPSILON_PRIMAL                  = 5e-4;

if nargin < 5,  svdMethod = 'svd'; end

if nargin < 4,  delta = 0.9; end;

if nargin < 3, tau = 1e4; end;

MAX_ITER                        = 25000;
DISPLAY_EVERY                   = 100;

[m,n] = size(D);

Y = zeros(m,n);  % Lagrange multiplier
A = zeros(m,n);  % Structure
E = zeros(m,n);  % Error

rankA = 0;

iter      = 0;
converged = false;

while ~converged
    iter = iter + 1;

    switch lower(svdMethod)
        case 'svdlibc'
            [U,diagS,V] = svdlibc(Y, rankA+1);
        case 'propack'
            [U,S,V] = lansvd(Y,rankA+1,'L');
            diagS = diag(S);
        case 'svds'
            [U,S,V] = svds(Y, rankA+1, 'L');
            diagS = diag(S);
        otherwise
            [U,S,V] = svd(Y,0);
            diagS = diag(S);
    end

    A = U * diag(pos(diagS-tau)) * V';
    E = sign(Y) .* pos( abs(Y) - lambda*tau );
    M = D - A - E;

    rankA  = sum(diagS>tau);
    cardE = sum(sum(double(abs(E)>0)));

    Y = Y + delta * M;

%     if VERBOSE > 1 && mod(iter, DISPLAY_EVERY)==0 && nargin>=6,
%         disp(['    Iteration '    num2str(iter)               ...
%             ' |A|_F '         num2str(norm(A,'fro'))      ...
%             ' rank(A) '         num2str(rankA)              ...
%             ' |E|_F '         num2str(norm(E,'fro'))      ...
%             ' |E|_0 '         num2str(cardE) ...
%             ' |D-A-E|_F ' num2str(norm(M,'fro')) ...
%             ' |A-A0|_F / |A0|_F ' num2str(norm(A-A0,'fro')/norm(A0,'fro')) ...
%             ' |D-A-E|_1,inf ' num2str(max(max(abs(M)))) ]);
%     elseif VERBOSE > 0 && mod(iter, DISPLAY_EVERY)==0,
%         disp(['    Iteration '    num2str(iter)               ...
%             ' rank(A) '         num2str(rankA) ...
%             ' ||E||_0 ' num2str(cardE) ]);
%     end

    if ( norm(D-A-E,'fro')/norm(D,'fro') < EPSILON_PRIMAL || iter >= MAX_ITER )
        converged = true;
    end

%     if ( iter >= MAX_ITER )
%         disp('Maximum number of iterations reached.') ;
%     end

end


function [z,p,sig,pt] = fisherp(p,varargin)
% :Usage:
% ::
%
%     function [z,p,sig,pt] = fisherp(p,[alph])
%
% :Inputs:
%
%   **p:**
%        values in 4-D array
%
%        1st 3 dims are within images, dim4 = image
%
% :Optional: alpha value for thresholding
%
% :Outputs:
%
%   **z:**
%        Fisher's combined test statistic, compare to normal
%
%   **p:**
%        p-values for combined test
%
%   **sig:**
%        signficance 1 / 0 binary mask, p < .05 (or alph) FDR-corr
%
%   **pt:**
%        p-value threshold for FDR corrected significance at alph
%
% :Described in:
% Lazar, N. A., Luna, B., Sweeney, J. A., & Eddy, W. F. (2002).
% Combining brains: a survey of methods for statistical pooling
% of information. Neuroimage, 16(2), 538-550.
%
% Stouffer, S. A., Suchman, E. A., DeVinney, L. C., Star, S. A., and
% Williams, R. M. 1949. The American Soldier: Vol. I. Adjustment
% During Army Life. Princeton University Press, Princeton.
%
% Threshold is determined with False Discovery Rate (Benjamini & Hochberg, 1995)
%
% ..
%    tor wager
% ..

if length(varargin) > 0, alph = varargin{1};,else,alph = 0.05;,end

lastdim = length(size(p));
k = size(p,lastdim);

z = -2*sum(log(p),lastdim);
p = 1 - chi2cdf(z(:),2*k);  % distributed as chi-square with 2k df
p = reshape(p,size(z));

% eliminate voxels outside of brain, all 0, 1, or all NaN values
p(all(p == 0,lastdim)) = NaN;
p(all(p == 1,lastdim)) = NaN;

pp = p(:); pp(isnan(pp)) = [];
pt = FDR(pp,alph);
if isempty(pt), pt = -Inf;, end

%z = sum(norminv(1 - p),lastdim) ./ sqrt(k);
%p = normcdf(1-z);

%if alph, sig = p <= alph;,end
sig = p <= pt;

return


clear
close all

lambda = 1;
iter = 4;
p = 0.8;
eps = 0.0001;

Img = im2double((imread('flower.png')));
Smoothed = ILS_LNorm(Img, lambda, p, eps, iter);
% Smoothed = ILS_LNorm_GPU(Img, lambda, p, eps, iter);

Diff = Img - Smoothed;
ImgE = Img + 3 * Diff;

figure; imshow(Smoothed)
figure; imshow(ImgE)

%%
Img = im2double(imread('clip_art.jpg'));
lambda = 30;
gamma = 10/255;
iter = 10;

Smoothed = ILS_Welsch(Img, lambda, gamma, iter);
% Smoothed = ILS_Welsch_GPU(Img, lambda, gamma, iter);

figure; imshow(Img)
figure; imshow(Smoothed)


function [prob,sol,fmin] = lp_prob(varargin)
%LP_PROB  Return an OPTI LP
%
%   prob = lp_prob(no) return a pre-built optiprob of a saved LP.
%
%   [prob,sol,fmin] = lp_prob(no) returns the optimum solution and function
%   eval at the optimum
%
%   no = lp_prob() returns the number of problems available for testing.

%   (C) 2011 Jonathan Currie (IPL)

%Check if just returning no problems
if(nargin < 1)
    prob = 11; sol = []; fmin = [];
    return;
else
    no = varargin{1};
end

%Big switch yard
switch(no)
    case 1
        f = -[-1, 2]';
        A = [2, 1;-4, 4];
        b = [5, 5]';
        e = -[1, 1];
        prob = optiprob('f',f,'mix',A,b,e,'name','TestLP1');
        sol = [1.25;2.5];
        fmin = -3.75;

    case 2
        f = -[50, 100];
        A = [10, 5;4, 10; 1, 1.5];
        b = [2500, 2000, 450]';
        e = [-1, -1, -1];
        prob = optiprob('f',f,'mix',A,b,e,'name','TestLP2');
        sol = [187.5;125];
        fmin = -21875;

    case 3
        f = [40, 36];
        A = [5, 3];
        b = 45;
        e = 1;
        ub = [8, 10];
        prob = optiprob('f',f,'mix',A,b,e,'ub',ub,'name','TestLP3');
        sol = [8;5/3];
        fmin = 380;

    case 4
        f = [3, -7, -12];
        A = [-3, 6, 8;6, -3, 7;-6, 3, 3];
        b = [12, 8, 5]';
        e = [-1, -1, -1];
        prob = optiprob('f',f,'mix',A,b,e,'name','TestLP4');
        sol = [-0.0666666666;0.23333333333;1.3];
        fmin = -17.43333333333333;

    case 5
        f = [2, 3, 7, 7];
        A = [1, 1, -2, -5;-1, 2, 1, 4];
        b = [2, -3]';
        e = [1, 1];
        lb = zeros(4,1);
        ub = [30 100 20 1]';
        prob = optiprob('f',f,'mix',A,b,e,'bounds',lb,ub,'name','TestLP5');
        sol = [2;0;0;0];
        fmin = 4;

    case 6
        f = [1, 2, 3, 7, 8, 8];
        A = [5, -3, 2, -3, -1, 2; -1, 0, 2, 1, 3, -3;1, 2, -1, 0, 5, -1];
        b = [-5, -1, 3]';
        e = [1, 1, 1];
        lb = zeros(6,1);
        ub = 10*ones(6,1);
        prob = optiprob('f',f,'mix',A,b,e,'bounds',lb,ub,'name','TestLP6');
        sol = [0;1.5;0;0;0;0];
        fmin = 3;

    case 7
        n = 40;
        t = (0:n-1)';
        y = 3.5 -.2*t;
        b = y + 0.5*ones(size(y));
        m = [ones(n,1),t(:)];
        A = [m,-m,eye(n)];
        f = [sum(m),sum(-m),2*ones(1,n)];
        e = ones(n,1);
        lb = zeros(n+4,1);
        ub = [10, 10, 10, 10, 5*ones(1,n)];
        prob = optiprob('f',f,'mix',A,b,e,'bounds',lb,ub,'name','TestLP7');
        sol = [4;0;0;0.2;zeros(40,1)];
        fmin = 4.0000000000000044;

    case 8
        f = -[8, 15];
        A = [10, 21;2, 1];
        b = [156, 22]';
        e = [-1, -1];
        prob = optiprob('f',f,'mix',A,b,e,'name','TestLP8');
        sol = [9.5625;2.875];
        fmin = -119.625;

    case 9
        f = -[3, 13];
        A = [2, 9;11, -8];
        b = [40, 82]';
        e = [-1, -1];
        prob = optiprob('f',f,'mix',A,b,e,'name','TestLP9');
        sol = [9.2;2.4];
        fmin = -58.8;

    case 10
        f = -[592, 381, 273, 55, 48, 37, 23];
        A = [3534, 2356, 1767, 589, 528, 451, 304];
        b = 119567;
        e = -1;
        lb = zeros(7,1);
        ub = [100 50 33 20 77 44 20]';
        prob = optiprob('f',f,'mix',A,b,e,'bounds',lb,ub,'name','TestLP10');
        sol = [33.8333333333333;zeros(6,1)];
        fmin = -20029.33333333333;

    case 11
        f = [-1 -1 -3 -2 -2]';
        A = [-1 -1 1 1 0;
             1 0 1 -3 0];
        b = [30;30];
        ub = [40;1;inf;inf;1];
        prob = optiprob('f',f,'ineq',A,b,'ub',ub,'name','TestLP11');
        sol = [40;1;50.75;20.25;1];
        fmin = -235.7500;

    otherwise
        error('Problem not available or not implemented yet');
end


function test_ft_preproc_dftfilter

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

if nargout
  % assume that this is called by RUNTESTS
  tests = functiontests(localfunctions);
else
  % assume that this is called from the command line
  fn = localfunctions;
  for i=1:numel(fn)
    feval(fn{i});
  end
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function testIssue1770(testCase)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% this is an issue related to numerical precision which is too strictly
% checked in ft_preproc_dftfilter (with spectral interpolation)

fs = 500;
data = [];
data.time{1} = -1:1/fs:2.4980; %-> observation: using linspace instead works fine

lnoise(1,:) = (1+hanning(1750))'.*sin((2.*pi.*data.time{1}).*50);
lnoise(2,:) = (1+hanning(1750))'.*sin((2.*pi.*data.time{1}).*100);

data.trial{1} = randn(2,1750)+lnoise;
data.label = {'a';'b'};
data.fsample = fs;

lineFreq = 50;

cfg              = [];
cfg.dftfilter    = 'yes'; % apply line noise filter with spectrum interpolation
cfg.dftfreq      = [lineFreq lineFreq*2]; % line noise and harmonic
cfg.dftreplace   = 'neighbour'; % spectral interpolation
cfg.dftbandwidth = [1 2]; % width of window to be interpolated
cfg.dftneighbourwidth = [2 2]; % width of window from which to interpolate
datafilt1 = ft_preprocessing(cfg, data);

cfg.dftreplace   = 'neighbour_fft';
datafilt2 = ft_preprocessing(cfg, data); % this should now work thanks to some eps leniency

cfg           = [];
cfg.dftfilter = 'yes';
cfg.dftfreq   = [lineFreq lineFreq*2];
datafilt3     = ft_preprocessing(cfg, data);

figure

subplot(2,2,1);plot(datafilt1.time{1}, data.trial{1}-datafilt1.trial{1}); ylim([-2.1 2.1]);xlabel('estimated linenoise neighbour');
subplot(2,2,2);plot(datafilt2.time{1}, data.trial{1}-datafilt2.trial{1}); ylim([-2.1 2.1]);xlabel('estimated linenoise neighbour_fft','interpreter','none');
subplot(2,2,3);plot(datafilt2.time{1}, data.trial{1}-datafilt3.trial{1}); ylim([-2.1 2.1]);xlabel('estimated linenoise static dft');
subplot(2,2,4);plot(data.time{1}, lnoise); ylim([-2.1 2.1]);xlabel('simulated linenoise');

figure; plot(data.time{1}, datafilt1.trial{1}-datafilt2.trial{1});
% the difference here can be explained by the fact that neighbour_fft takes
% an asymmetric band around 50/100 Hz, due to rounding in nearest I guess

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% some other instances, testing ft_preproc_dftfilter directly
tim = (0:1999)./1000;
dat = randn(1, 2000) + (1+hanning(2000))'.*sin(2.*pi.*(tim).*50);
filt  = ft_preproc_dftfilter(dat, 1000, 50, 'dftreplace', 'neighbour');
filt2 = ft_preproc_dftfilter(dat, 1000, 50, 'dftreplace', 'neighbour_fft');

figure;plot(tim, dat-filt); hold on;plot(tim, (1+hanning(2000))'.*sin(2.*pi.*(tim).*50));
figure;plot(tim, dat-filt2); hold on;plot(tim, (1+hanning(2000))'.*sin(2.*pi.*(tim).*50));
figure;plot(filt, filt2, 'o');

tim = (0:2000)./1000;
dat = randn(1, 2001) + (1+hanning(2001))'.*sin(2.*pi.*(tim).*50);
filt = ft_preproc_dftfilter(dat, 1000, 50, 'dftreplace', 'neighbour');
try
  filt2 = ft_preproc_dftfilter(dat, 1000, 50, 'dftreplace', 'neighbour_fft');
  ft_error('if the code ends up here, then something suddenly started working');
catch
  % this is supposed to happen
end

figure;plot(tim, dat-filt); hold on;plot(tim, (1+hanning(2001))'.*sin(2.*pi.*(tim).*50));

dat = randn(3, 2001) + [(1+hanning(2001))'.*sin(2.*pi.*(tim).*53) ; (1+hanning(2001))'.*sin(2.*pi.*(tim).*79 - 0.025) ; (1+hanning(2001))'.*sin(2.*pi.*(tim).*127 + 0.002)];
filt = ft_preproc_dftfilter(dat, 1000, [53, 79, 127], 'dftreplace', 'neighbour', 'dftneighbourwidth', [1 1 1]);
figure;
subplot(2,2,1); plot(tim, dat(1,:)-filt(1,:)); hold on;plot(tim, (1+hanning(2001))'.*sin(2.*pi.*(tim).*53));
subplot(2,2,2); plot(tim, dat(2,:)-filt(2,:)); hold on;plot(tim, (1+hanning(2001))'.*sin(2.*pi.*(tim).*79 - 0.025));
subplot(2,2,3); plot(tim, dat(3,:)-filt(3,:)); hold on;plot(tim, (1+hanning(2001))'.*sin(2.*pi.*(tim).*127 + 0.002));

tim = (0:5000)./678.253;
krn = (1+hanning(5000)')./2;
dat = randn(1, 5001) + ([krn(1:2500) ones(1,2501)]).*sin(2.*pi.*(tim).*50);
filt = ft_preproc_dftfilter(dat, 678.253, 50, 'dftreplace', 'neighbour', 'dftneighbourwidth', 2, 'dftbandwidth', 2);
figure;hold on;plot(tim, ([krn(1:2500) ones(1,2501)]).*sin(2.*pi.*(tim).*50));plot(tim, dat-filt)

tim = (0:4999)./1000;
krn = (1+hanning(5000)')./2;
dat = randn(1, 5000) + ([krn(1:2500) ones(1,2500)]).*sin(2.*pi.*(tim).*50);
filt = ft_preproc_dftfilter(dat, 1000, 50, 'dftreplace', 'neighbour', 'dftneighbourwidth', 2, 'dftbandwidth', 2);
figure;hold on;plot(tim, ([krn(1:2500) ones(1,2500)]).*sin(2.*pi.*(tim).*50));plot(tim, dat-filt)

%%%%%%%%%
% Code chunk from Sabine
samples_off = 2; % samples to add, so a full 50 Hz cycle doesn't fit

lengthsec= 4;  % data length in seconds
fs = 1000; % sampling rate
acfreq = 50; % set the powerline frequency, e.g., 50 or 60 Hz

datlength = (lengthsec*fs);
dat = gausswin(datlength, round(datlength/100) )';
t= (0:(length(dat)-1))/fs;
noise = cos( 2 * pi * acfreq * t );

% spectrum interpolation
filt_spec = ft_preproc_dftfilter(dat + noise, fs, acfreq, 'dftreplace', 'neighbour', ...
  'dftbandwidth', 2, 'dftneighbourwidth', 2 );

% add samples to the data to introduce leakage
datlength2 = (lengthsec*fs) + samples_off;  % LEAK, add samples, so a full cycle doesn't fit
dat2 = gausswin(datlength2, round(datlength2/100) )';
t2 = (0:(length(dat2)-1))/fs;
noise2 = cos( 2 * pi * acfreq * t2 );

% comment out error message in the dftfilter function, before running this
filt_spec_leak = ft_preproc_dftfilter(dat2 + noise2, fs, acfreq, 'dftreplace', 'neighbour', ...
  'dftbandwidth', 2, 'dftneighbourwidth', 2 );

figure;
hold all
plot( t , dat + noise,'k')
ylabel('Amplitude (a.u.)')
xlabel('Time (s)')
ylim( [ -1.25 2.05 ] )
xlim( [ 0 4.005 ] )
legend('Gaussian with 50 Hz line noise')
title('Gaussian with added 50 Hz sinusoid of constant amplitude - 4.003 s')

figure;
hold all
plot( t , filt_spec, 'b')
plot( t2 , filt_spec_leak,'r')
plot(t, dat,'k')
xlabel('Time (s)')
ylabel('Amplitude (a.u.)')
legend('Spectrum Interpolation Full Cycle', 'Spectrum Interpolation Not Full Cycle', ...
  'Original Clean Gaussian')

ylim( [ -0.5 1.5] )
xlim( [ 0 4 ] )
title(['DFT neighbour function used for mixed signal (gaussian + line noise)  - Data length = ' ...
  num2str(datlength/fs) ' s and ' num2str(datlength2/fs) ' s']);


function [p,ellipse]=phantom3d(varargin)

%PHANTOM3D Three-dimensional analogue of MATLAB Shepp-Logan phantom
%   P = PHANTOM3D(DEF,N) generates a 3D head phantom that can
%   be used to test 3-D reconstruction algorithms.
%
%   DEF is a string that specifies the type of head phantom to generate.
%   Valid values are:
%
%      'Shepp-Logan'            A test image used widely by researchers in
%                               tomography
%      'Modified Shepp-Logan'   (default) A variant of the Shepp-Logan phantom
%                               in which the contrast is improved for better
%                               visual perception.
%
%   N is a scalar that specifies the grid size of P.
%   If you omit the argument, N defaults to 64.
%
%   P = PHANTOM3D(E,N) generates a user-defined phantom, where each row
%   of the matrix E specifies an ellipsoid in the image.  E has ten columns,
%   with each column containing a different parameter for the ellipsoids:
%
%     Column 1:  A      the additive intensity value of the ellipsoid
%     Column 2:  a      the length of the x semi-axis of the ellipsoid
%     Column 3:  b      the length of the y semi-axis of the ellipsoid
%     Column 4:  c      the length of the z semi-axis of the ellipsoid
%     Column 5:  x0     the x-coordinate of the center of the ellipsoid
%     Column 6:  y0     the y-coordinate of the center of the ellipsoid
%     Column 7:  z0     the z-coordinate of the center of the ellipsoid
%     Column 8:  phi    phi Euler angle (in degrees) (rotation about z-axis)
%     Column 9:  theta  theta Euler angle (in degrees) (rotation about x-axis)
%     Column 10: psi    psi Euler angle (in degrees) (rotation about z-axis)
%
%   For purposes of generating the phantom, the domains for the x-, y-, and
%   z-axes span [-1,1].  Columns 2 through 7 must be specified in terms
%   of this range.
%
%   [P,E] = PHANTOM3D(...) returns the matrix E used to generate the phantom.
%
%   Class Support
%   -------------
%   All inputs must be of class double.  All outputs are of class double.
%
%   Remarks
%   -------
%   For any given voxel in the output image, the voxel's value is equal to the
%   sum of the additive intensity values of all ellipsoids that the voxel is a
%   part of.  If a voxel is not part of any ellipsoid, its value is 0.
%
%   The additive intensity value A for an ellipsoid can be positive or negative;
%   if it is negative, the ellipsoid will be darker than the surrounding pixels.
%   Note that, depending on the values of A, some voxels may have values outside
%   the range [0,1].
%
%   Example
%   -------
%        ph = phantom3d(128);
%        figure, imshow(squeeze(ph(64,:,:)))
%
%   Copyright 2005 Matthias Christian Schabel (matthias @ stanfordalumni . org)
%   University of Utah Department of Radiology
%   Utah Center for Advanced Imaging Research
%   729 Arapeen Drive
%   Salt Lake City, UT 84108-1218
%
%   This code is released under the Gnu Public License (GPL). For more information,
%   see : http://www.gnu.org/copyleft/gpl.html
%
%   Portions of this code are based on phantom.m, copyrighted by the Mathworks
%

[ellipse,n] = parse_inputs(varargin{:});

p = zeros([n n n]);

rng =  ( (0:n-1)-(n-1)/2 ) / ((n-1)/2);

[x,y,z] = meshgrid(rng,rng,rng);

coord = [flatten(x); flatten(y); flatten(z)];

p = flatten(p);

for k = 1:size(ellipse,1)
   A = ellipse(k,1);            % Amplitude change for this ellipsoid
   asq = ellipse(k,2)^2;        % a^2
   bsq = ellipse(k,3)^2;        % b^2
   csq = ellipse(k,4)^2;        % c^2
   x0 = ellipse(k,5);           % x offset
   y0 = ellipse(k,6);           % y offset
   z0 = ellipse(k,7);           % z offset
   phi = ellipse(k,8)*pi/180;   % first Euler angle in radians
   theta = ellipse(k,9)*pi/180; % second Euler angle in radians
   psi = ellipse(k,10)*pi/180;  % third Euler angle in radians

   cphi = cos(phi);
   sphi = sin(phi);
   ctheta = cos(theta);
   stheta = sin(theta);
   cpsi = cos(psi);
   spsi = sin(psi);

   % Euler rotation matrix
   alpha = [cpsi*cphi-ctheta*sphi*spsi   cpsi*sphi+ctheta*cphi*spsi  spsi*stheta;
            -spsi*cphi-ctheta*sphi*cpsi  -spsi*sphi+ctheta*cphi*cpsi cpsi*stheta;
            stheta*sphi                  -stheta*cphi                ctheta];

   % rotated ellipsoid coordinates
   coordp = alpha*coord;

   idx = find((coordp(1,:)-x0).^2./asq + (coordp(2,:)-y0).^2./bsq + (coordp(3,:)-z0).^2./csq <= 1);
   p(idx) = p(idx) + A;
end

p = reshape(p,[n n n]);

return;

function out = flatten(in)

out = reshape(in,[1 prod(size(in))]);

return;

function [e,n] = parse_inputs(varargin)
%  e is the m-by-10 array which defines ellipsoids
%  n is the size of the phantom brain image

n = 128;     % The default size
e = [];
defaults = {'shepp-logan', 'modified shepp-logan', 'yu-ye-wang'};

for i=1:nargin
   if ischar(varargin{i})         % Look for a default phantom
      def = lower(varargin{i});
      idx = strmatch(def, defaults);
      if isempty(idx)
         eid = sprintf('Images:%s:unknownPhantom',mfilename);
         msg = 'Unknown default phantom selected.';
         error(eid,'%s',msg);
      end
      switch defaults{idx}
      case 'shepp-logan'
         e = shepp_logan;
      case 'modified shepp-logan'
         e = modified_shepp_logan;
      case 'yu-ye-wang'
         e = yu_ye_wang;
      end
   elseif numel(varargin{i})==1
      n = varargin{i};            % a scalar is the image size
   elseif ndims(varargin{i})==2 && size(varargin{i},2)==10
      e = varargin{i};            % user specified phantom
   else
      eid = sprintf('Images:%s:invalidInputArgs',mfilename);
      msg = 'Invalid input arguments.';
      error(eid,'%s',msg);
   end
end

% ellipse is not yet defined
if isempty(e)
   e = modified_shepp_logan;
end

return;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  Default head phantoms:   %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function e = shepp_logan

e = modified_shepp_logan;
e(:,1) = [1 -.98 -.02 -.02 .01 .01 .01 .01 .01 .01];

return;

function e = modified_shepp_logan
%
%   This head phantom is the same as the Shepp-Logan except
%   the intensities are changed to yield higher contrast in
%   the image.  Taken from Toft, 199-200.
%
%         A      a     b     c     x0      y0      z0    phi  theta    psi
%        -----------------------------------------------------------------
e =    [  1  .6900  .920  .810      0       0       0      0      0      0
        -.8  .6624  .874  .780      0  -.0184       0      0      0      0
        -.2  .1100  .310  .220    .22       0       0    -18      0     10
        -.2  .1600  .410  .280   -.22       0       0     18      0     10
         .1  .2100  .250  .410      0     .35    -.15      0      0      0
         .1  .0460  .046  .050      0      .1     .25      0      0      0
         .1  .0460  .046  .050      0     -.1     .25      0      0      0
         .1  .0460  .023  .050   -.08   -.605       0      0      0      0
         .1  .0230  .023  .020      0   -.606       0      0      0      0
         .1  .0230  .046  .020    .06   -.605       0      0      0      0 ];

return;

function e = yu_ye_wang
%
%   Yu H, Ye Y, Wang G, Katsevich-Type Algorithms for Variable Radius Spiral Cone-Beam CT
%
%         A      a     b     c     x0      y0      z0    phi  theta    psi
%        -----------------------------------------------------------------
e =    [  1  .6900  .920  .900      0       0       0      0      0      0
        -.8  .6624  .874  .880      0       0       0      0      0      0
        -.2  .4100  .160  .210   -.22       0    -.25    108      0      0
        -.2  .3100  .110  .220    .22       0    -.25     72      0      0
         .2  .2100  .250  .500      0     .35    -.25      0      0      0
         .2  .0460  .046  .046      0      .1    -.25      0      0      0
         .1  .0460  .023  .020   -.08    -.65    -.25      0      0      0
         .1  .0460  .023  .020    .06    -.65    -.25     90      0      0
         .2  .0560  .040  .100    .06   -.105    .625     90      0      0
        -.2  .0560  .056  .100      0    .100    .625      0      0      0 ];

return;


function [newModel,scores,stats] = boostingUpdate(data,labels,oldModel,binVals,bins,params)

% Learn classifier with all the data.

posEx = labels == 1;
negEx = ~posEx;
numPos = sum(posEx);
numNeg = sum(negEx);

if numPos<1 || numNeg<1,
  newModel = struct('dim',1,'error',0.5,'dir',1,'tr',0,'alpha',0);
  scores = zeros(1,numel(labels));
  return;
end

wt = ones(length(posEx),1);
posWt = numNeg/(numPos+numNeg);
negWt = numPos/(numPos+numNeg);
wt(posEx) = posWt;
wt(negEx) = negWt;
wt = wt./sum(wt);

modLabels = sign( (labels==1)-0.5);

updatedModel = updateOldWeights(data,modLabels,oldModel,wt);
[newModel,scores] = addNewRules(data,modLabels,updatedModel,binVals,bins,wt,params);

if nargout >= 3,
  % compute some statistics of how well training worked
  stats = ComputeBoostingStats(scores,labels);
end

function updatedModel = updateOldWeights(data,labels,oldModel,exWt)

wt = exWt;
updatedModel = oldModel;
scores = zeros(size(data,1),1);
for ndx = 1:numel(oldModel)
  curWkRule = oldModel(ndx);
  tr = curWkRule.tr;
  dir = curWkRule.dir;
  dim = curWkRule.dim;
  if dir>0,
    tt = ((data(:,dim)> tr)-0.5)*2;
  else
    tt = ((data(:,dim)<= tr)-0.5)*2;
  end
  curError = sum( (tt.*labels).*wt);
  if(curError<0);
    curError = 0;
  end
  updatedModel(ndx).error = 0.5-curError/2;
  updatedModel(ndx).alpha = 1-2*updatedModel(ndx).error;
  scores = scores + myBoostClassify(data,updatedModel(ndx));
  tt = scores.*labels;
  wt = exWt./(1+exp(tt));
  wt = wt./sum(wt);
end

function [newModel,scores] = addNewRules(data,labels,updatedModel,binVals,bins,exWt,params)

extraIters = params.iter_updates;
newModel = updatedModel;
scores = myBoostClassify(data,updatedModel);
tt = scores.*labels;
wt = exWt./(1+exp(tt));
wt = wt./sum(wt);
for itt = 1:extraIters
  wkRule = findWeakRuleSamples(data,labels,wt,binVals,bins,params);

  tr = wkRule.tr;
  dir = wkRule.dir;
  dim = wkRule.dim;
  if dir>0,
    tt = ((data(:,dim)> tr)-0.5)*2;
  else
    tt = ((data(:,dim)<= tr)-0.5)*2;
  end
  curError = sum( (tt.*labels).*wt);
  if(curError<0);
    curError = 0;
  end

  wkRule.error = 0.5-curError/2;
  wkRule.alpha = 1-2*wkRule.error;

  newModel(end+1) = wkRule;
  scores = scores + myBoostClassify(data,newModel(end));
  tt = scores.*labels;
  wt = exWt./(1+exp(tt));
  wt = wt./sum(wt);
end


 function cost = qpwls_cost(xs, G, W, yy, C, mask)
%function cost = qpwls_cost(xs, G, W, yy, C, mask)
% compute QPWLS cost for each column of x
%
% Copyright Apr 1999, Jeff Fessler

if nargin < 3, ir_usage, end

if nargin == 6
	xs = reshape(xs, size(xs,1)*size(xs,2), size(xs,3));
	xs = xs(find(mask(:)), :);
end

cost = zeros(ncol(xs),1);
for kk=1:ncol(xs)
	x = xs(:,kk);
	resid = yy - G * x;	% predicted measurements
	cost(kk) = resid' * W * resid / 2 + norm(C * x).^2 / 2;
end

cost = reale(cost);	% trick: x'*x is not real for complex values


function [W, TE, R, R2, SDS] = ROLLINGSTYLE(F, S, N)
% Rolling style analysis
%
% INPUTS:
%   F... vector of fund returns
%   S... matrix of style factor returns
%   N... number of rolling periods
%
% OUTPUTS:
% W... vector of optimal style index weights
% TE... tracking error between calculated and actual fund
% Fcalc... vector of calculated fund time series
% R2... coefficient of determination between fund and calculated fund
% SDS... Style Drift Score
%
% Andreas Steiner
% performanceanalysis@andreassteiner.net,
% http://www.andreassteiner.net/performanceanalysis

W = []; TE = []; R = []; R2 = [];

for t = N:rows(F)

     [w, te, r, r2] = TEMINQP(F(t-(N-1):t), S(t-(N-1):t,:));

     W = [W; w];
     TE = [TE; te];
     R = [R; r(end)];
     R2 = [R2; r2];

end;

SDS = sqrt(sum(var(W)));

figure
bar(W, 'stacked')
title('Rolling Style Analysis: Style Weights Over Time')
axis tight


function [err_res,elerr_res] = diffpost_res(jmp,els,rhsq,hlsq)
%diffpost_res  computes Q1 element residual error estimator
%   [err_res,elerr_res] = diffpost_res(jmp,els,rhsq,hlsq);
%   input
%          jmp          elementwise edge flux jumps
%          els          elementwise edge lengths
%          rhsq         elementwise L2 residual norms
%          hlsq         elementwise areas
%   output
%          err_res      global residual error
%          elerr_res    elementwise residual errors
%
%   IFISS function: DJS; 1 April 2005.
% Copyright (c) 2005 D.J. Silvester, H.C. Elman, A. Ramage
elerr_res=0.5*sum((els.*els.*jmp.*jmp)')' + hlsq.*rhsq;
err_res=sqrt(sum(elerr_res));
elerr_res=sqrt(elerr_res);
fprintf('computing residual error estimator... ')
fprintf('\nestimated global error (in energy):  %10.6e\n',err_res)
return


function out = SY_RangeEvolve(y)
% SY_RangeEvolve    How the time-series range changes across time.
%
% Measures of the range of the time series as a function of time,
% i.e., range(x_{1:i}) for i = 1, 2, ..., N, where N is the length of the time
% series.
%
%---INPUT:
% y, the time series
%
%---OUTPUTS: based on the dynamics of how new extreme events occur with time.

% ------------------------------------------------------------------------------
% Copyright (C) 2020, Ben D. Fulcher <ben.d.fulcher@gmail.com>,
% <http://www.benfulcher.com>
%
% If you use this code for your research, please cite the following two papers:
%
% (1) B.D. Fulcher and N.S. Jones, "hctsa: A Computational Framework for Automated
% Time-Series Phenotyping Using Massive Feature Extraction, Cell Systems 5: 527 (2017).
% DOI: 10.1016/j.cels.2017.10.001
%
% (2) B.D. Fulcher, M.A. Little, N.S. Jones, "Highly comparative time-series
% analysis: the empirical structure of time series and their methods",
% J. Roy. Soc. Interface 10(83) 20130048 (2013).
% DOI: 10.1098/rsif.2013.0048
%
% This function is free software: you can redistribute it and/or modify it under
% the terms of the GNU General Public License as published by the Free Software
% Foundation, either version 3 of the License, or (at your option) any later
% version.
%
% This program is distributed in the hope that it will be useful, but WITHOUT
% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
% FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
% details.
%
% You should have received a copy of the GNU General Public License along with
% this program. If not, see <http://www.gnu.org/licenses/>.
% ------------------------------------------------------------------------------

doPlot = false; % whether to plot outputs
N = length(y); % length of the time series
cums = zeros(N,1);

for i = 1:N
    cums(i) = range(y(1:i));
end
% cums = cums/range(y);

if doPlot
    figure('color','w');
    plot(cums);
end

fullr = range(y);

% Define an anonymous function for the number of unique entries in a vector, x:
lunique = @(x) length(unique(x));

out.totnuq = lunique(cums);

% How many of the unique extrema are in first <proportion> of time series?
cumtox = @(x) lunique(cums(1:floor(N*x)))/out.totnuq;
out.nuqp1 = cumtox(0.01);
out.nuqp10 = cumtox(0.1);
out.nuqp20 = cumtox(0.2);
out.nuqp50 = cumtox(0.5);

% (**1**) how many unique extrema are in first <length> of time series

Ns = [10, 50, 100, 1000];
for i = 1:length(Ns)
    if N >= Ns(i)
        out.(sprintf('nuql%u',Ns(i))) = lunique(cums(1:Ns(i)))/out.totnuq;
    else
        out.(sprintf('nuql%u',Ns(i))) = NaN;
    end
end

% (**2**) Actual proportion of full range captured at different points

out.p1 = cums(ceil(N*0.01))/fullr;
out.p10 = cums(ceil(N*0.1))/fullr;
out.p20 = cums(ceil(N*0.2))/fullr;
out.p50 = cums(ceil(N*0.5))/fullr;

Ns = [10, 50, 100, 1000];
for i = 1:length(Ns)
    if N >= Ns(i)
        out.(sprintf('l%u',Ns(i))) = cums(Ns(i))/fullr;
    else
        out.(sprintf('l%u',Ns(i))) = NaN;
    end
end

end


function [Z,A,B,rss] = arch2(X, na, mode, sil)

%   [Z,A,B,rss] = arch2(X, na, mode, silent )
%
%   archetypal analysis of column orientated data set <X>
%
%   input arguments :
%
%   - each column of data is one 'observation', e.g. the sample values of
%     all channels in a multichannel measurement at one point in time
%
%   - na : number of generated archetypes
%
%   - mode can be one of the following : 'normalized' (default),
%     'mean', 'raw'
%     - in mode 'normalized' each column of data is centered by removing its mean
%       and then normalized by dividing through its standard deviation before
%       the covariance matrix is calculated
%     - in mode 'mean' only the mean of every column of data is removed
%     - in mode 'raw' no preprocessing is applied to data
%     - in mode 'scale' <X> is divided by max(abs(X))
%
%   - silent is an optional flag which supresses output of text and plot on the matlab
%     screen. Returned values (see below) are in no way affected
%
%
%   output arguments :
%
%   - Z : each column of Z is an archetype
%
%   - A : the columns of A are the coefficients of the archetypes to
%         the constrains ||X-Z*A|| -> min
%
%   - B : the columns of B create the X-mixtures (the archtypes)
%         Z=X*B
%
%   - rss : the residual sum of squares for each iteration
%
%   Christian Merkwirth & Joerg Wichard
%   Februar 1998

global silent

narginchk(2,3);

if nargin < 3
    mode = 'normalized';
end

if nargin < 4
    silent = 0;
else
    silent = 1;
end

[m,n] = size(X);

printline('archetypal analysis')
printline(['on data set of size ' num2str(n) 'x' num2str(m)]);

if (na < 1)
  printline('number of archetypes must be greater than zero');
end

if strncmp(mode, 'r',1)
  mode = 'raw';
  printline('no data preprocessing');
elseif strncmp(mode, 'm',1)
  mode = 'mean';
  printline('removing mean from data set');
  mn = mean(X,2);
  X = X - repmat(mn, 1, n);
elseif strncmp(mode, 's',1)
  mode = 'scale';
  printline('scaling data set');
  xm = max(max(abs(X)));
  X = (1/xm)*X;
else
  mode = 'normalized';
  printline('removing mean and normalizing data');
  mn = mean(X,2);
  X = X - repmat(mn, 1, n);
  dv = std(X,0,2);
  X = X ./ repmat(dv, 1, n);
end

gew1=20*m;              % Gewichtung der Convexit�tsbedingung
gew2=5*m;               % Gewichtung der Convexit�tsbedingung
tol=0.01;              %%Toleranz f�r die Abbruchbedingung
numb = 20;              %% Max. Anzahl der Iterationen

%%  x zuf�llig ausw�len
B=eye(n);
rp=randperm(na);
B=B(:,rp);
Z=X*B;

%% Hier beginnt die Alternierende Optimierung
rss(1,:)=[ 0 sum(sum(X .* X))]
count=0;

for c=1:numb;

  for l=1:na;

    %% Maximum an Z anf�gen
    MX=max(max(Z));
    Z(m+1,:)=gew1*MX;
    X(m+1,:)=gew1*MX;

    %% A suchen bei konstantem Z
    for i=1:n;
      A(:,i)= lsqnonneg(Z,X(:,i));
    end;

    %% Gewichtung entfernen
    X=X(1:m,:);
    Z=Z(1:m,:);

    %% Z suchen bei konstantem A
    for i=1:n;
      V(:,i)=A(l,i)*(X(:,i) - Z*A(:,i) + A(l,i)*Z(:,l));
    end;

    %% Singul�re Archetypen durch max ||X-Z*A|| ersetzen
    if ( (sum(A(l,:)) .* sum(A(l,:))) ==0)
      VT=sum((X-Z*A).*(X-Z*A));
      [VTC,VTI]=max(VT);
      B(:,l)=0;
      B(VTI,l)=1;

    else
      VS=(sum(A(l,:).*A(l,:)))*sum(V,2);
      MV=max(max(X));
      X(m+1,:)=gew2*MV;
      VS(m+1)=gew2*MV;

      B(:,l)=nnls(X,VS, 4 * max(size(X)) * norm(X,1) * eps);

      %% Gewichtung entfernen
      X=X(1:m,:);
      VS=VS(1:m);
    end;
  end;

  Z=X*B;

  %% norm RSS berechnen
  rss((c+1),:)=[ c sum(sum((X-Z*A).*(X-Z*A))) ];

  if (abs(rss(c+1,2)-rss(c,2)) < tol*rss(c,2) )
    break;
  end;

  count=count+1;
end;

%% Ergebnis auf Konsistenz �berpr�fen
[C,I]=max(rss);
if( (I < count) & (rss(I) < rss(count)) )
  printline('Minimum not reached')
end

if( count == numb )
  printline('Maximum Number of Iterations')
end

if silent
  figure(1)
  subplot(4,1,1)
  plot(rss(:,1), rss(:,2))
  title('Residual Sum of Squares')

  subplot(4,1,2)
  plot(X)
  title('Input Data');

  subplot(4,1,3)
  plot((Z),'k')
  title('Archetypes');

  subplot(4,1,4)
  plot((Z),'k')
  hold on;
  plot(X)
  hold off;
  title('Archetypes & Input Data');
end

function printline(string)
global silent
if silent~=1
        disp(string)
end


function determ = frank_determinant ( n )

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

  return
end


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

%% -*- texinfo -*-
%% @documentencoding UTF-8
%% @defmethod @@sym trace (@var{A})
%% Trace of symbolic matrix.
%%
%% Example:
%% @example
%% @group
%% syms x
%% A = [1 2 x; 3 sym(pi) 4; 13 5 2*x]
%%   @result{} A = (sym 3×3 matrix)
%%       ⎡1   2   x ⎤
%%       ⎢          ⎥
%%       ⎢3   π   4 ⎥
%%       ⎢          ⎥
%%       ⎣13  5  2⋅x⎦
%% trace(A)
%%   @result{} ans = (sym) 2⋅x + 1 + π
%% @end group
%% @end example
%%
%% As an example, we can check that the trace of the product is @emph{not}
%% the product of the traces:
%% @example
%% @group
%% A = sym([1 2; 3 4]);
%% B = sym([pi 3; 1 8]);
%% trace(A*B)
%%   @result{} ans = (sym) π + 43
%% trace(A) * trace(B)
%%   @result{} ans = (sym) 5⋅π + 40
%% @end group
%% @end example
%% However, such a property does hold if we use the Kronecker tensor product
%% (@pxref{@@sym/trace}):
%% @example
%% @group
%% kron(A, B)
%%   @result{} ans = (sym 4×4 matrix)
%%       ⎡ π   3   2⋅π  6 ⎤
%%       ⎢                ⎥
%%       ⎢ 1   8    2   16⎥
%%       ⎢                ⎥
%%       ⎢3⋅π  9   4⋅π  12⎥
%%       ⎢                ⎥
%%       ⎣ 3   24   4   32⎦
%% trace(kron(A, B))
%%   @result{} ans = (sym) 5⋅π + 40
%% trace(A) * trace(B)
%%   @result{} ans = (sym) 5⋅π + 40
%% @end group
%% @end example
%%
%% @seealso{@@sym/det}
%% @end defmethod

function z = trace(x)

  cmd = { 'x, = _ins'
          'if not x.is_Matrix:'
          '    x = sp.Matrix([[x]])'
          'return sp.trace(x),' };

  z = pycall_sympy__ (cmd, x);

end

%!test
%! % scalar
%! syms x
%! assert (isequal (trace(x), x))

%!test
%! syms x
%! A = [x 3; 2*x 5];
%! assert (isequal (trace(A), x + 5))


function y = prtUtilNanVar(x,dim)
% prtUtilNanVar - Calculated the variance of data, X, ignoring nans
%
% y = prtUtilNanVar(x)
% y = prtUtilNanVar(x,dim)

if nargin < 2 || isempty(dim)
    dim = 1; % Default of sum
    if isvector(x)
        if size(x,1) > size(x,2)
            dim = 1;
        else
            dim = 2;
        end
    end
end

meanX = prtUtilNanMean(x,dim);
y = prtUtilNanMean(bsxfun(@minus,x,meanX).^2,dim)*size(x,dim)./(size(x,dim)-1); % Variance is normalized by n-1 not n;