function cvt_1d_sampling ( n, it_num, s_num )

%*****************************************************************************80
%
%% CVT_1D_SAMPLING carries out the Lloyd algorithm.
%
%  Discussion:
%
%    This program is a variation of the CVT_1D_LLOYD method.
%    Instead of using an exact technique to determine the Voronoi
%    regions, it uses sampling.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 September 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of generators.
%
%    Input, integer IT_NUM, the number of CVT iterations.
%
%    Input, integer S_NUM, the number of samples in [0,1] to use
%    when estimating the Voronoi regions.
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'CVT_1D_SAMPLING\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '  Use sampling to implement an approximation of Lloyd''s algorithm\n' );
  fprintf ( 1, '  in the 1D unit interval [0,1].\n' );

  if ( nargin < 1 )
    n = input ( '  Enter number of generators: ' );
  elseif ( ischar ( n ) )
    n = str2num ( n );
  end

  if ( nargin < 2 )
    it_num = input ( '  Enter number of iterations: ' );
  elseif ( ischar ( it_num ) )
    it_num = str2num ( it_num );
  end

  if ( nargin < 3 )
    s_num = input ( '  Enter number of sample points: ' );
  elseif ( ischar ( s_num ) )
    s_num = str2num ( s_num );
  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Number of generators is %d\n', n );
  fprintf ( 1, '  Number of iterations is %d\n', it_num );
  fprintf ( 1, '  Number of samples is %d\n', s_num );
%
%  For convenience, add a 0.0 and 1.0 point.
%  Also, sort the array.
%
  g = zeros ( n + 2, 1 );
  g_new = zeros ( n + 2, 1 );

  g(1,1) = 0.0;
  if ( 0 )
    g(2:n+1,1) = rand ( n, 1 );
  else
    g(2:n+1,1) = linspace ( 0.01, 0.02, n );
  end
  g(n+2,1) = 1.0;

  g = sort ( g );
%
%  Print the initial generators.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Initial generators:\n' );
  fprintf ( 1, '\n' );
  for k = 2 : n + 1
    fprintf ( 1, '  %4d  %f\n', k - 1, g(k,1) );
  end
%
%  Initialize the plotting arrays.
%
  g_plot = zeros ( n+2, it_num + 1 );

  step = 1 : it_num;
  e = nan ( it_num, 1 );
  gm = nan ( it_num, 1 );

  for it = 1 : it_num

    g_plot ( 1:n+2, it ) = g(1:n+2,1);

    s = rand ( s_num, 1 );
%
%  We need to "assign" each entry of S to the nearest X, then
%  replace X by the average of the values assigned to it.
%
%  There's a faster way for this 1D case.
%  1) Sort the S values.
%  2) Determine the values XM that delimit the Voronoi intervals.
%  3) For each XM, find the index LEFT in S such that S(LEFT) <= XM < S(LEFT+1).
%  4) Replace X(I) by the average of the S values that you have determined
%     are within its Voronoi interval.
%
    s = sort ( s );

    xm = zeros ( n - 1, 1 );
    for j = 1 : n - 1
      xm(j) = 0.5 * ( g(j+1) + g(j+2) );
    end

    left = r8vec_bracket4 ( s_num, s, n - 1, xm );
%
%  Compute the new generators.
%
    e(it,1) = 0.0;

    j = 1;
    g_new(j) = 0.0;

    k2 = 0;
    for j = 1 : n - 1
      k1 = k2;
      k2 = left(j);
      g_new(j+1) = sum ( s(k1+1:k2) ) / ( k2 - k1 );
      for k = k1 + 1 : k2
        e(it,1) = e(it,1) + ( s(k) - g(j+1) ).^2;
      end
    end

    k1 = k2;
    k2 = s_num;
    j = n + 1;
    g_new(j) = sum ( s(k1+1:k2) ) / ( k2 - k1 );
    for k = k1 + 1 : k2
      e(it,1) = e(it,1) + ( s(k) - g(j) ).^2;
    end

    j = n + 2;
    g_new(j) = 1.0;

    e(it,1) = e(it,1) / s_num;
%
%  Display the energy.
%
    figure ( 1 )
    plot ( step, log ( e ), 'm-*' )
    title ( 'Log (Energy)' )
    xlabel ( 'Step' )
    ylabel ( 'Energy' )
    grid
%
%  Compute the generator motion.
%
    gm(it,1) = sum ( ( g_new(:) - g(:) ).^2 ) / n;
%
%  Display the generator motion.
%
    figure ( 2 )
    plot ( step, log ( gm ), 'm-*' )
    title ( 'Log (Average generator motion)' )
    xlabel ( 'Step' )
    ylabel ( 'Motion' )
    grid
%
%  Update the generators.
%
    g = g_new;

  end

  g_plot(1:n+2,it_num+1) = g(1:n+2,1);

%
%  Print the current generators.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Current generators:\n' );
  fprintf ( 1, '\n' );
  for k = 2 : n + 1
    fprintf ( 1, '  %4d  %f\n', k - 1, g(k,1) );
  end
%
%  Plot the evolution of the locations of the generators.
%
  figure ( 3 )
  y = ( 0 : it_num );
  for k = 1 : n + 2
    plot ( g_plot(k,1:it_num+1), y )
    hold on;
  end
  grid on
  hold off;

  title ( 'Generator evolution' );
  xlabel ( 'Generator positions' );
  ylabel ( 'Iterations' );
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'CVT_1D_SAMPLING\n' );
  fprintf ( 1, '  Normal end of execution.\n' );
  fprintf ( 1, '\n' );
  timestamp ( );

  return
end
function left = r8vec_bracket4 ( nt, t, ns, s )

%*****************************************************************************80
%
%% R8VEC_BRACKET4 finds the interval to each of a vector of values.
%
%  Discussion:
%
%    An R8VEC is a vector of R8's.
%
%    The routine always returns the index LEFT of the sorted array
%    T with the property that either
%    *  T is contained in the interval [ T(LEFT), T(LEFT+1) ], or
%    *  T < T(LEFT) = T(1), or
%    *  T > T(LEFT+1) = T(N).
%
%    The routine is useful for interpolation problems, where
%    the abscissa must be located within an interval of data
%    abscissas for interpolation, or the "nearest" interval
%    to the (extreme) abscissa must be found so that extrapolation
%    can be carried out.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 April 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NT, length of the input array.
%
%    Input, real T(NT), an array that has been sorted
%    into ascending order.
%
%    Input, integer NS, the number of points to be bracketed.
%
%    Input, real S(NS), values to be bracketed by entries of T.
%
%    Output, integer LEFT(NS).
%    LEFT(I) is set so that the interval [ T(LEFT(I)), T(LEFT(I)+1) ]
%    is the closest to S(I); it either contains S(I), or else S(I)
%    lies outside the interval [ T(1), T(NT) ].
%

%
%  Check the input data.
%
  if ( nt < 2 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8VEC_BRACKET4 - Fatal error!\n' );
    fprintf ( 1, '  NT must be at least 2.\n' );
    error ( 'R8VEC_BRACKET4 - Fatal error!' );
  end

  for i = 1 : ns

    left(i) = floor ( ( nt + 1 ) / 2 );
%
%  CASE 1: S < T(LEFT):
%  Search for S in [T(I), T(I+1)] for intervals I = 1 to LEFT-1.
%
    if ( s(i) < t(left(i)) )

      if ( left(i) == 1 )
        continue
      elseif ( left(i) == 2 )
        left(i) = 1;
        continue
      elseif ( t(left(i)-1) <= s(i) )
        left(i) = left(i) - 1;
        continue
      elseif ( s(i) <= t(2) )
        left(i) = 1;
        continue
      end
%
%  ...Binary search for S in [T(I), T(I+1)] for intervals I = 2 to LEFT-2.
%
      low = 2;
      high = left(i) - 2;

      while ( 1 )

        if ( low == high )
          left(i) = low;
          break
        end

        mid = floor ( ( low + high + 1 ) / 2 );

        if ( t(mid) <= s(i) )
          low = mid;
        else
          high = mid - 1;
        end

      end
%
%  CASE2: T(LEFT+1) < S:
%  Search for S in [T(I),T(I+1)] for intervals I = LEFT+1 to N-1.
%
    elseif ( t(left(i)+1) < s(i) )

      if ( left(i) == nt - 1 )
        continue
      elseif ( left(i) == nt - 2 )
        left(i) = left(i) + 1;
        continue
      elseif ( s(i) <= t(left(i)+2) )
        left(i) = left(i) + 1;
        continue
      elseif ( t(nt-1) <= s(i) )
        left(i) = nt - 1;
        continue
      end
%
%  ...Binary search for S in [T(I), T(I+1)] for intervals I = LEFT+2 to NT-2.
%
      low = left(i) + 2;
      high = nt - 2;

      while ( 1 )

        if ( low == high )
          left(i) = low;
          break
        end

        mid = floor ( ( low + high + 1 ) / 2 );

        if ( t(mid) <= s(i) )
          low = mid;
        else
          high = mid - 1;
        end

      end
%
%  CASE3: T(LEFT) <= S <= T(LEFT+1):
%  S is in [T(LEFT), T(LEFT+1)].
%
    else

    end

  end

  return
end
function timestamp ( )

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

  return
end


function [p_, KLdiv, exitflag] = optimizeEntropy(p, A, b, Aeq, beq, options)

% number of inequality constraints
K_ = size(A, 1);
% number of equality constraints
K  = size(Aeq, 1);
A_ = A';
%b_ = b';
Aeq_ = Aeq';
beq_ = beq';
x0   = zeros(K_ + K, 1);
InqMat = -eye(K_ + K);
InqMat(K_ + 1:end, :) = [];
InqVec = zeros(K_, 1);

lnp = log(p);

% uses analytic gradient and Hessian during optimization
if nargin < 6
    options = optimset(...
        'Display', 'iter', ...
        'GradObj', 'on', ...
        'Hessian', 'on', ...
        'TolFun', 1e-10, ...
        'TolX', 1e-10, ...
        'TolCon', 1e-10, ...
        'MaxFunEvals', 5000, ...
        'MaxIter', 5000);
end

% minimize negative Lagrange function (i.e. maximize Lagrange function)
if ~K_
    % equality constraints only
    [v, dummy, exitflag] = fminunc(@nestedfunU, x0, options);
    if exitflag > 0
        lnp_ = lnp - 1 - Aeq_ * v;
    else
        lnp_ = lnp;
    end
else
    % inequality (and equality) constraints
    [lv, dummy, exitflag] = fmincon(@nestedfunC, x0, InqMat, InqVec, [], [], [], [], [], options);
    if exitflag > 0
        % inequality Lagrange multipliers
        l = lv(1:K_);
        % equality Lagrange multipliers
        v = lv(K_ + 1:end);
        lnp_ = lnp - 1 - A_ * l - Aeq_ * v;
    else
        lnp_ = lnp;
    end
end

p_ = exp(lnp_);

if nargout > 1
    if exitflag > 0
        KLdiv = p_' * (lnp_ - lnp);
    else
        KLdiv = NaN;
    end
end

    % sub-function -- equality case
    function [mL, g, H] = nestedfunU(v)
        lnx = lnp - 1 - Aeq_ * v;
        % robustificaton
        lnx = max(lnx, -150.0);
        x = exp(lnx);
        % Lagrange dual function
        L = x' * (lnx - lnp + Aeq_ * v) - beq_ * v;
        % take neg values since we want to maximize
        mL = -L;

        % gradient and Hessian
        g = beq - Aeq * x;
        H = Aeq * ((x * ones(1, K)) .* Aeq_);
    end

    % sub-function -- inequality case
    function [mL, g, H] = nestedfunC(lv)
        % inequality Lagrange multiplier
        l = lv(1:K_);
        % equality Lagrange multiplier
        v = lv(K_ + 1:end);
        lnx = lnp - 1 - A_ * l - Aeq_ * v;
        % robustification
        lnx = max(lnx, -150.0);
        x = exp(lnx);
        % Lagrange dual function
        L = x' * (lnx - lnp) + l' * (A * x - b) + v' * (Aeq * x - beq);
        % take neg values since we want to maximize
        mL = -L;

        % gradient and Hessian
        g = [b - A * x; beq - Aeq * x];
        H = [A * ((x * ones(1, K_)) .* A_), A * ((x * ones(1, K)) .* Aeq_);...
            Aeq * ((x * ones(1, K_)) .* A_), Aeq * ((x * ones(1, K)) .* Aeq_)];
    end
end


function c = block_fwt( f, w, J)
%BLOCK_FWT FWT func. wrapper for a block processing
%   Usage: c = block_fwt( f, w, J);
%
%   Input parameters:
%         f     : Input data.
%         w     : Analysis Wavelet Filterbank.
%         J     : Number of filterbank iterations.
%
%   Output parameters:
%         c      : Coefficient vector.
%
%   `c = block_fwt(f,w,J)` accepts suitably extended block of data *f*
%   and produces correct coefficients using the SegDWT algorithm (based on
%   overlap-save block convolution) with wavelet filters defined by *w*
%   and *J* levels. *f* is expected to be a column vector or a matrix and
%   the processing is done column-wise.
%
%   Do not call this function directly. The function is called from
%   |blockana| when used with frame type 'fwt' and 'segola' block transform
%   handling see |blockframeaccel|.
%
%   Function should be independent of block_interface.
%
%   See also: block, block_ifwt
%
%   References: ltfatnote026

if nargin<3
  error('%s: Too few input parameters.',upper(mfilename));
end;

% Initialize the wavelet filters structure
%h = fwtinit(h,'ana');

if any(w.a~=w.a(1))
   error('%s: Non-equal subsampling factors are not supported.',upper(mfilename));
end

w = fwtinit(w);
% Extended block length
Ls = size(f,1);
% Low-pass filter length
m = numel(w.h{1}.h);
% Low-pass subsampling factor
a = w.a(1);
% Extension length
rred = (a^J-1)/(a-1)*(m-a);
% Block boundaries
blocksize=w.a(1)^J;
% Input signal samples to be processed

% This is effectivelly the "negative" right extension described in chapter
% 4.1.4 in the reference.
L=rred+floor((Ls-rred)/blocksize)*blocksize;

levelLen = L;
filtNo = length(w.h);
subbNo = (filtNo-1)*J+1;
Lc = zeros(subbNo,1);
runPtr = 0;
for jj=1:J
   for ff=filtNo:-1:2
      Lc(end-runPtr) = floor((levelLen-m-1)/w.a(ff));
      runPtr = runPtr + 1;
   end
   levelLen = floor((levelLen-m-1)/w.a(1));
end
Lc(1)=levelLen;

%
%[Lc, L] = fwtclength(Ls,h,J,'valid');

% Crop to the right length
if(Ls>L)
   f=postpad(f,L);
end

if Ls<rred+a^J
   error('%s: Insufficient input signal length for the %s flag. Minimum is %i.',upper(mfilename),'''valid''',rred+a^J);
end

c = comp_fwt(f,w.h,w.a,J,'valid');

% Do the cropping
runPtr = 0;
for jj=1:J-1
   for ff=filtNo:-1:2
      cstart = (a^(J-jj)-1)/(a-1)*(m-a);
      c{end-runPtr} = c{end-runPtr}(cstart+1:end,:);
      runPtr = runPtr + 1;
   end
end

% To the pack format
c = cell2mat(c);


function [U,B_k,V] = lanc_b(A,p,k,reorth)
%LANC_B Lanczos bidiagonalization.
%
% B_k = lanc_b(A,p,k,reorth)
% [U,B_k,V] = lanc_b(A,p,k,reorth)
%
% Performs k steps of the Lanczos bidiagonalization process with
% starting vector p, producing a lower bidiagonal matrix
%           [b_11               ]
%           [b_21 b_22          ]
%     B_k = [     b_32 .        ]
%           [          . b_kk   ]
%           [            b_k+1,k]
% such that
%     A*V = U*B_k ,
% where U and V consist of the left and right Lanczos vectors.
%
% Reorthogonalization is controlled by means of reorth:
%    reorth = 0 : no reorthogonalization,
%    reorth = 1 : reorthogonalization by means of MGS,
%    reorth = 2 : Householder-reorthogonalization.
% No reorthogonalization is assumed if reorth is not specified.

% Reference: G. H. Golub & C. F. Van Loan, "Matrix Computations",
% 3. Ed., Johns Hopkins, 1996.  Section 9.3.4.
% Referred to as "bidiag1" by Paige and Saunders.

% Per Christian Hansen, IMM, April 8, 2001.

% Initialization.
if (k<1), error('Number of steps k must be positive'), end
if (nargin < 4), reorth = 0; end
if (reorth < 0 | reorth > 2), error('Illegal reorth'), end
if (nargout==2), error('Not enough output arguments'), end
[m,n] = size(A);
B_k = sparse(k+1,k);
if (nargout>1 | reorth==1)
  U = zeros(m,k); V = zeros(n,k); UV = 1;
else
  UV = 0;
end
if (reorth==2)
  if (k>=n), error('No. of iterations must satisfy k < n'), end
  HHU = zeros(m,k); HHV = zeros(n,k);
  HHalpha = zeros(1,k); HHbeta = HHalpha;
end

% Prepare for Lanczos iteration.
v = zeros(n,1);
beta = norm(p);
if (beta==0), error('Starting vector must be nonzero'), end
if (reorth==2)
  [beta,HHbeta(1),HHU(:,1)] = gen_hh(p);
end
u = p/beta;
if (UV), U(:,1) = u; end

% Perform Lanczos bidiagonalization with/without reorthogonalization.
for i=1:k

  r = A'*u - beta*v;
  if (reorth==0)
    alpha = norm(r); v = r/alpha;
  elseif (reorth==1)
    for j=1:i-1, r = r - (V(:,j)'*r)*V(:,j); end
    alpha = norm(r); v = r/alpha;
  else
    for j=1:i-1
      r(j:n) = app_hh(r(j:n),HHalpha(j),HHV(j:n,j));
    end
    [alpha,HHalpha(i),HHV(i:n,i)] = gen_hh(r(i:n));
    v = zeros(n,1); v(i) = 1;
    for j=i:-1:1
      v(j:n) = app_hh(v(j:n),HHalpha(j),HHV(j:n,j));
    end
  end
  B_k(i,i) = alpha; if (UV), V(:,i) = v; end

  p = A*v - alpha*u;
  if (reorth==0)
    beta = norm(p); u = p/beta;
  elseif (reorth==1)
    for j=1:i, p = p - (U(:,j)'*p)*U(:,j); end
    beta = norm(p); u = p/beta;
  else
    for j=1:i
      p(j:m) = app_hh(p(j:m),HHbeta(j),HHU(j:m,j));
    end
    [beta,HHbeta(i+1),HHU(i+1:m,i+1)] = gen_hh(p(i+1:m));
    u = zeros(m,1); u(i+1) = 1;
    for j=i+1:-1:1
      u(j:m) = app_hh(u(j:m),HHbeta(j),HHU(j:m,j));
    end
  end
  B_k(i+1,i) = beta; if (UV), U(:,i+1) = u; end

end

if (nargout==1), U = B_k; end


function linpack_z_test04 ( )

%*****************************************************************************80
%
%% TEST04 tests ZGBCO.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 June 2009
%
%  Author:
%
%    John Burkardt
%
  ml = 1;
  mu = 1;
  n = 3;
  lda = 2*ml+mu+1;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST04\n' );
  fprintf ( 1, '  For a complex general band storage matrix:\n' );
  fprintf ( 1, '  ZGBCO factors the matrix and estimates the\n' );
  fprintf ( 1, '  reciprocal condition number.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The matrix order is N = %d\n', n );
  fprintf ( 1, '  The lower band is ML =  %d\n', ml );
  fprintf ( 1, '  The upper band is MU =  %d\n', mu );
%
%  Set the values of the matrix A.
%
  a_save(1:n,1:n) = 0.0;

  m = ml + mu + 1;

  seed = 123456789;

  for j = 1 : n
    i1 = max ( 1, j - mu );
    i2 = min ( n, j + ml );
    for i = i1 : i2
      k = i - j + m;
      [ a(k,j), seed ] = c8_uniform_01 ( seed );
      a_save(i,j) = a(k,j);
    end
  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  The matrix A:\n' );
  fprintf ( 1, '\n' );

  for i = 1 : n
    for j = 1 : n
      fprintf ( 1, '  (%8f  %8f)', real ( a_save(i,j) ), imag ( a_save(i,j) ) );
    end
    fprintf ( 1, '\n' );
  end
%
%  Factor the matrix A.
%
  [ a, ipvt, rcond ] = zgbco ( a, lda, n, ml, mu );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Estimated reciprocal condition RCOND = %f\n', rcond );

  return
end


function [Gs]=gsp_graph_multiresolution_old(G,num_levels,varargin)
%GSP_GRAPH_MULTIRESOLUTION  Compute a multiresolution of graphs
%   Usage:  [Gs]=gsp_graph_multiresolution(G,num_levels);
%           [Gs]=gsp_graph_multiresolution(G,num_levels,param);
%
%   Input parameters:
%         G                          : Graph structure.
%         num_levels                 : Number of times to downsample and coarsen the graph.
%   Output parameters:
%         Gs                         : Cell array, with each element containing a graph structure represent a reduced graph.
%   Additional parameters:
%         param.downsampling_method  : The graph downsampling method (default='largest_eigenvector')
%         param.reduction_method     : The graph reduction method (default='Kron')
%         param.sparsify             : To perform a spectral sparsification step immediately after the graph reduction (default=1)
%         param.sparsify_epsilon     : Parameter epsilon used in the spectral sparsification (default=min(10/sqrt(G.N),.3))
%         param.compute_full_eigen   : To also compute the graph Laplacian eigenvalues and eigenvectors for every graph in the multiresolution sequence (default=0)
%
%   'gsp_graph_multiresolution(G,num_levels)' computes a multiresolution of
%   graph by repeatedly downsampling and performing graph reduction. The
%   default downsampling method is the largest eigenvector method based on
%   the polarity of the components of the eigenvector associated with the
%   largest graph Laplacian eigenvalue. The default graph reduction method
%   is Kron reduction followed by a graph sparsification step.
%
%   See also:
%
%   Demos:
%
%   References:
%
%   AUTHORS : David I Shuman, Elle Weeks, Andre Archer, Stefan Faridani, Yan Jin.
%   TESTING:
%   REFERENCE:

if nargin>2
    param=varargin{1};
else
    param=0;
end

if ~isfield(param,'reduction_method')
    reduction_method='kron';
else
    reduction_method=param.reduction_method;
end

if ~isfield(param,'downsampling_method')
    downsampling_method='largest_eigenvector';
else
    downsampling_method=param.downsampling_method;
end

if ~isfield(param,'sparsify')
    sparsify=1;
else
    sparsify=param.sparsify;
end

if ~isfield(param,'sparsify_epsilon')
    sparsify_epsilon=min(10/sqrt(G.N),.3);
else
    sparsify_epsilon=param.sparsify_epsilon;
end

if ~isfield(param,'compute_full_eigen')
    compute_full_eigen=0;
else
    compute_full_eigen=param.compute_full_eigen;
end

%set up cell for multiresolutions of graphs
Gs=cell(num_levels+1,1);
Gs{1}=G;
if compute_full_eigen
    if (~isfield(Gs{1},'U') || ~isfield(Gs{1},'e') )
        Gs{1}=gsp_compute_fourier_basis(Gs{1});
    end
else
    if ~isfield(Gs{1},'lmax')
        Gs{1}=gsp_estimate_lmax(Gs{1});
    end
end
Gs{1}.idx=(1:Gs{1}.N)';
Gs{1}.orig_idx=Gs{1}.idx;

for lev=1:num_levels

    % Graph downsamping: get indices to keep for the new lower resolution graph
    switch downsampling_method
        case 'largest_eigenvector'
            if compute_full_eigen
                largest_eigenvector = Gs{lev}.U(:,Gs{lev}.N);
            else
                [largest_eigenvector,~]=eigs(Gs{lev}.L,1);
            end
             largest_eigenvector = largest_eigenvector * sign(largest_eigenvector(1));

            nonnegative_logicals=(largest_eigenvector >= 0);
            if sum(nonnegative_logicals) == 0
                error('Too many pyramid levels. Try fewer.');
            end
            keep_inds=find(nonnegative_logicals==1);

        % we can add other downsampling methods here

        otherwise
            error('Unknown graph downsampling method');
    end

    % Graph reduction: rewire the new lower resolution graph to form weighted adjacency and Laplacian matrices
    switch reduction_method
        case 'kron'
            % Kron reduction
            Gs{lev+1}.L=gsp_kron_reduce_old(Gs{lev}.L,keep_inds);

        % we can add other graph reduction methods here

        otherwise
            error('Unknown graph reduction method');
    end

    % Spectral sparsification
    if sparsify
        N=size(Gs{lev+1}.L,1);
        sparsify_epsilon=max(sparsify_epsilon,2/sqrt(N));
    %    gsp_reset_seed();
        [Gs{lev+1}.L,~,~] = gsp_graph_sparsify_old(Gs{lev+1}.L,sparsify_epsilon);
    end

    % Create the new graph from the reduced weighted adjacency matrix
    new_W=diag(diag(Gs{lev+1}.L))-Gs{lev+1}.L;
    Gs{lev+1}=gsp_graph(new_W);
    Gs{lev+1}=gsp_copy_graph_attributes(Gs{lev},'unknown',Gs{lev+1});

    % Copy the coordinates of the subsampled vertices
    Gs{lev+1}.coords = Gs{lev}.coords(keep_inds,:);

    % Update indexing
    Gs{lev+1}.idx=keep_inds;
    Gs{lev+1}.orig_idx=Gs{lev}.orig_idx(keep_inds);

    % Compute full eigendecomposition of new graph, if desired
    if compute_full_eigen
        Gs{lev+1}=gsp_compute_fourier_basis(Gs{lev+1});
    else
        Gs{lev+1}=gsp_estimate_lmax(Gs{lev+1});
    end

end

end


echo on
%--------------------------------------------------
% ToUTM
%   Example conversion from Geodetic to UTM
%   coordinates.  Creates UTM coordinate listing
%   in GeoLab 2.0 NE format.
% 05 Feb 2010
%
% M-files:  dms2rad, refell, ell2utm
%--------------------------------------------------
%clear all

%---------- Define names and geodetic lat,lon of
%---------- points to convert

% PLO      07KC005ECC   N 58 54  12.11752 W111 35  21.20267      104.084
% PLO      07NA001ECC   N 58 59  47.66810 W111 23  32.15643      106.236
% PLO      100A         N 58 50  16.59244 W111 41  23.36311      106.060
% PLO      102A         N 58 52  23.70694 W111 46   9.27700      107.385
% NE       07KC005ECC       6529232.4191      466051.9575            UTM 12
% NE       07NA001ECC       6539528.0046      477460.4120            UTM 12
% NE       100A             6522003.1191      460180.9293            UTM 12
% NE       102A             6525984.6308      455641.7913            UTM 12

name=[
'07KC005ECC   '
'07NA001ECC   '
'100A         '
'102A         '
];
plo=[
58 54  12.11752  111 35  21.20267      104.084
58 59  47.66810  111 23  32.15643      106.236
58 50  16.59244  111 41  23.36311      106.060
58 52  23.70694  111 46   9.27700      107.385
];

%---------- Convert to UTM

latdms=plo(:,1:3);
londms=plo(:,4:6);
lat=dms2rad(latdms);
lon=-dms2rad(londms);
n=length(lat);
[a,b,e2,finv]=refell('NAD27');
[N,E,Zone]=ell2utm(lat,lon,a,e2);

%---------- List results

%[N E Zone]
echo off

disp(' ');
s=['          STATION NAME         N (m)',...
   '            E (m)                 Zone'];
disp(s);
s=['------------------------------------',...
   '---------------------------------------'];
disp(s);
for i=1:n
  s=[' NE       ',name(i,:),'%16.4f %16.4f',...
     '            UTM %3.0f\n'];
  fprintf(s,N(i),E(i),Zone(i));
end
fprintf('\n');


function [struct_irf_record,D_record,gamma_record,favar]=irfchol(sigma_gibbs,irf_record,It,Bu,IRFperiods,n,favar)

% function [struct_irf_record D_record gamma_record]=irfchol(sigma_gibbs,irf_record,It,Bu,IRFperiods,n)
% runs the gibbs sampler to obtain draws from the posterior distribution of IRFs, orthogonalised with a Choleski decomposition
% inputs:  - matrix'sigma_gibbs': record of the gibbs sampler draws for the sigma matrix (vectorised)
%          - cell 'irf_record': record of the gibbs sampler draws for the IRFs
%          - integer 'It': total number of iterations of the Gibbs sampler (defined p 28 of technical guide)
%          - integer 'Bu': number of burn-in iterations of the Gibbs sampler (defined p 28 of technical guide)
%          - integer 'IRFperiods': number of periods for IRFs
%          - integer 'n': number of endogenous variables in the BVAR model (defined p 7 of technical guide)
% outputs: - cell 'struct_irf_record': record of the gibbs sampler draws for the orthogonalised IRFs
%          - matrix 'D_record': record of the gibbs sampler draws for the structural matrix D
%          - matrix 'gamma_record': record of the gibbs sampler draws for the structural disturbances variance-covariance matrix gamma

% this function implements algorithm 2.4.1

% preallocation: create the matrices and cell arrays that will store the results from the simulations
struct_irf_record=cell(n,n);
D_record=zeros(n^2,It-Bu);
gamma_record=zeros(n^2,It-Bu);
% gamma is just identity
gamma=reshape(eye(n),n^2,1);
psi=zeros(n,n);
sigma_gibbs=reshape(sigma_gibbs,n,n,It-Bu);
% recall L from the sampling process in this case, analogue to beta and sigma
if favar.FAVAR==1 && favar.npltX>0
    FAVAR=1;
    npltX=favar.npltX;
    favar_struct_irf_record=cell(favar.npltX,n);
    Lgibbs=reshape(favar.L_gibbs,size(favar.L,1),size(favar.L,2),It-Bu);
    %relevant loadings of restricted information variables
    Lgibbs=Lgibbs(favar.plotX_index,:,:);
else
    FAVAR=0;
    npltX=0;
end

% step 1: repeat simulations a number of times equal to the number of simulations retained from Gibbs sampling
for ii=1:It-Bu

    % step 2: recover sigma
    sigma=squeeze(sigma_gibbs(:,:,ii));
    % step 3: Obtain the Choleski factor of sigma
    D=chol(bear.nspd(sigma),'lower');

    % step 4: obtain orthogonalised IRFs
    % loop over periods
    for jj=1:IRFperiods

        % loop over vertical and horizontal dimensions to recover the responses of all the variables to all the shocks
        for kk=1:n
            for ll=1:n
                % recover the IRF matrix psi, representing the response of variable kk to shock ll at time horizon jj, for Gibbs iteration ii
                psi(kk,ll)=irf_record{kk,ll}(ii,jj);
            end
        end

        % compute the orthonalised irf matrix psitilde, as defined in (2.3.10)
        psitilde=psi*D;

        % record the results in the cell; here again, loop over vertical and horizontal dimensions
        for kk=1:n
            for ll=1:n
                struct_irf_record{kk,ll}(ii,jj)=psitilde(kk,ll);
            end
        end

        % compute IRFs for FAVAR plotX variables
        if FAVAR==1 && npltX>0
            for oo=1:npltX
                L=squeeze(Lgibbs(oo,:,ii));
                for ll=1:n
                    favar_struct_irf_record{oo,ll}(ii,jj)=L*psitilde(:,ll);
                end
            end
        end

        %go for next period
    end

    % step 5: record values for D and gamma
    D_record(:,ii)=D(:);
    % gamma is just identity
    gamma_record(:,ii)=gamma;

    % go for next iteration
end

% save
if FAVAR==1 && npltX>0
    favar.IRF.favar_irf_record=favar_struct_irf_record;
end


function C = multiTimes( A, B, type )
% Matrix multiply each submatrix of two 3D arrays without looping.
%
% type controls the matrix multiplication to perform (for each i):
%  1    - C(:,:,i) = A(:,:,i)*B(:,:)
%  1.1  - C(i,:,:) = A(:,:,i)*B(:,:)
%  1.2  - C(:,:,i) = A(:,:)*B(:,:,i)
%  2    - C(:,:,i) = A(:,:,i)*B(:,:,i)
%  2.1  - C(:,:,i) = A(:,:,i)'*B(:,:,i)
%  2.2  - C(:,:,i) = A(:,:,i)*B(:,:,i)'
%  3    - C(:,i) = A(:,:,i)*B(:,i)
%  3.1  - C(:,i) = A(:,:,i)'*B(:,i)
%  3.2  - C(:,i) = A(:,i)'*B(:,:,i)
%  4.1  - C(i) = trace(A(:,:,i)'*B(:,:,i))
% Corresponding dimensions of A and B must match appropriately.
%
% USAGE
%  C = multiTimes( A, B, type )
%
% INPUTS
%  A         - [ma x na x oa] matrix
%  B         - [mb x nb x ob] matrix
%  type      - multiplication type (see above)
%
% OUTPUTS
%  C         - result of the multiplication
%
% EXAMPLE
%  n=10000; A=randn(2,2,n); B=randn(2);
%  tic, C1=multiTimes(A,B,1); toc
%  tic, C2=zeros(size(A)); for i=1:n, C2(:,:,i)=A(:,:,i)*B; end; toc
%
% See also BSXFUN, MTIMES
%
% Piotr's Computer Vision Matlab Toolbox      Version 2.52
% Copyright 2014 Piotr Dollar.  [pdollar-at-gmail.com]
% Licensed under the Simplified BSD License [see external/bsd.txt]

ma = size(A,1); na = size(A,2); oa = size(A,3);
mb = size(B,1); nb = size(B,2); ob = size(B,3);

% just to simplify the reading
%if( ma==mb ); m = ma; end
%if( na==nb ); n = na; end
if( oa==ob ); o = oa; end

switch type
  case 1    % C(:,:,i) = A(:,:,i)*B(:,:)
    C = permute(reshape(reshape(permute(A,[1 3 2]),ma*oa,na)*B,...
      ma,oa,nb),[1 3 2]);
  case 1.1  % C(i,:,:) = A(:,:,i)*B(:,:)
    C = reshape(reshape(permute(A,[3 1 2]),ma*oa,na)*B,oa,ma,nb);
  case 1.2  % C(:,:,i) = A(:,:)*B(:,:,i)
    C = reshape(A*reshape(B,mb,nb*ob),ma,nb,ob);
  case 2    % C(:,:,i) = A(:,:,i)*B(:,:,i)
    C = reshape(sum(bsxfun(@times,reshape(A,...
      [ma na 1 o]),reshape(B,[1 mb nb o])),2),[ma nb o]);
  case 2.1  % C(:,:,i) = A(:,:,i)'*B(:,:,i)
    C = reshape(sum(bsxfun(@times,reshape(permute(A,[2,1,3]),...
      [na ma 1 o]),reshape(B,[1 mb nb o])),2),[na nb o]);
  case 2.2  % C(:,:,i) = A(:,:,i)*B(:,:,i)'
    C = reshape(sum(bsxfun(@times,reshape(A,...
      [ma na 1 o]),reshape(permute(B,[2,1,3]),[1 nb mb o])),2),[ma mb o]);
  case 3    % C(:,i) = A(:,:,i)*B(:,i)
    C = reshape(sum(bsxfun(@times, A, reshape(B,[1 mb nb ])),2),ma,nb);
  case 3.1  % C(:,i) = A(:,:,i)'*B(:,i)
    C = reshape(sum(bsxfun(@times, permute(A,[2,1,3]), ...
      reshape(B,[1 mb nb ])),2),na,nb);
  case 3.2  % C(:,i) = A(:,i)'*B(:,:,i)
    C = reshape(sum(bsxfun(@times, reshape(A,ma,1,na), B),1), nb,na);
  case 4.1  % C(i) = tr(A(:,:,i)'*B(:,:,i))
    C = reshape(sum(sum(A.*B,1),2),1,o);
  otherwise
    error('unknown type: %f',type);
end


%% OPT13_RUN
%
%  Modified:
%
%    12 February 2008
%
   %---------------------------------------------------------------------
   %  Use NEWTON method.
   %---------------------------------------------------------------------
   fprintf('---------------------------------------------------------\n')
   fprintf('Test case 13 as a standard minimization problem.\n' );
   fprintf('Use Newton''s method.\n' );
   fprintf('The function is badly scaled.\n' );
   fprintf('There is a local minimizer at X=(0.285,0.279), F(X)=5.92\n' );
   fprintf('There is a global minimizere at X=-21.02,36.76), F(X)=0.0\n' );
   fprintf('---------------------------------------------------------\n')

   fname = 'opt13_fgh';
   options = [];
   options.max_iterations     = 30;
   options.method             = 'newton';

   fprintf('Newton:\n')

   x0 = [ 1; 1 ];
   x = entrust(fname, x0, options);

   fprintf('Newton''s method produced  (%10.7e,%10.7e)\n\n',x(1),x(2))
   f = opt13_fgh ( x, 'f' );
   fprintf('Value of F(X) = %f\n', f );

   %---------------------------------------------------------------------
   %  Use GAUSS-NEWTON method on least squares problem.
   %---------------------------------------------------------------------
   fprintf('---------------------------------------------------------\n')
   fprintf('Running testcase_13 as least squares problem: \n')
   fprintf('---------------------------------------------------------\n')
   fname = 'opt13_rj';
   options = [];
   options.verbose            = 0;
   options.method             = 'gauss_newton';
   options.step_tolerance     = 1.e-15;
   options.globalization      = 'none';
   options.gradient_tolerance = 1.e-10;
   options.max_iterations     = 10000;
   options.max_fevals         = 10000;

   x0 = [ 1; 1 ];
   x = entrust(fname, x0, options);
   fprintf('Gauss-Newton produced  (%10.7e, %10.7e)\n\n',x(1),x(2))
   [ res, jac ] = opt13_rj ( x, 'f' );
   fprintf('Norm of RES(X) = %f\n', norm ( res ) );


function [forecast_record]=maforecast(data_endo_a,data_exo_a,data_exo_p,It,Bu,beta_gibbs,sigma_gibbs,delta_gibbs,Fperiods,n,m,p,k1,k3)

% function [forecast_record]=maforecast(data_endo_a,data_exo_a,data_exo_p,It,Bu,beta_gibbs,sigma_gibbs,delta_gibbs,Fperiods,n,m,p,k1,k3)
% computes draws from the posterior predictive distribution, that is, from the posterior distribution of forecasts
% inputs:  - matrix 'data_endo_a': the matrix storing the pre-forecast endogenous data
%          - matrix 'data_exo_a': the matrix storing the pre-forecast exogenous data
%          - matrix 'data_exo_p': the matrix storing the predicted exogenous data
%          - integer 'It': the total number of iterations run by the Gibbs sampler
%          - integer 'Bu': the number of initial iterations discared as burn-in sample
%          - matrix 'beta_gibbs': the matrix recording the post-burn draws of beta
%          - matrix 'sigma_gibbs': the matrix recording the post-burn draws of sigma
%          - matrix 'delta_gibbs': the matrix recording the post-burn draws of delta
%          - integer 'Fperiods': the number of periods for which forecasts have to be produced
%          - integer 'n': the number of endogenous variables in the model
%          - integer 'm': the number of exogenous variables in the model
%          - integer 'p': the number of lags in the model
%          - integer 'k1': the number of coefficients related to the endogenous variables for each equation in the model
%          - integer 'k3': the number of coefficients related to the exogenous variables for each equation, in the reformulated model (3.5.5)
% outputs: - cell 'forecast_record': the cell array containing records of simulated  forecasts

% this function implements algorithm 2.1.1, adapted for the mean-adjusted BVAR model

% create first the cell storing the results
forecast_record=cell(n,1);

% generate the matrix of predicted exogenous variables
% augment the matrices of exogenous with a column of ones to account for the exogenous
data_exo_a=[ones(size(data_endo_a,1),1) data_exo_a];
data_exo_p=[ones(Fperiods,1) data_exo_p];

% then start simulations
% repeat the process a number of times equal to the number of simulations retained from Gibbs sampling
for ii=1:It-Bu

% compute the matrix temp1
temp1=data_endo_a(end-p+1:end,:);

% compute the matrix temp2
temp2=[data_exo_a(end-p+1:end,:)];

% step 2: draw beta and sigma
% draw beta from its posterior distribution
beta=beta_gibbs(:,ii);
% reshape
B=reshape(beta,k1,n);

% draw delta from its posterior distribution
delta=delta_gibbs(:,ii);
% reshape
Delta=reshape(delta,k3,n);

% draw sigma from its posterior distribution
sigma=sigma_gibbs(:,ii);
% reshape sigma to recover its original square form
sigma=reshape(sigma,n,n);

   % step 4: generate forecasts recursively
   % repeat the process for periods T+1 to T+h
   for jj=1:Fperiods

   % concatenate the predicted exogenous to the top of temp2 (the actual exogenous)
   temp2=[temp2;data_exo_p(jj,:)];

   % use the function lagx on temp1 to obtain the matrix Y; retain only the last row
   X=bear.lagx(temp1,p-1);
   X=X(end,:);

   % use the function lagx on temp2 to obtain the matrix Z; retain only the last row
   Z=bear.lagx(temp2,p);
   Z(:,m+1:end)=-Z(:,m+1:end);
   Z=Z(end,:);

   % draw the residuals from N(0,sigma)
   res=bear.trns(chol(bear.nspd(sigma),'Lower')*randn(n,1));

   % obtain predicted value for T+jj by using (3.5.9)
   yp=X*B+Z*Delta+res;

   % concatenate the transpose of yp to the top of temp1
   temp1=[temp1;yp];

   % repeat until values are obtained for T+h
   end

% step 5: record the results from current iteration in the cell forecast_record
   % loop over variables
   for kk=1:n
   % consider column kk of matrix temp1 and select the last h rows: these are the predicted values for the period T+1 to T+h, for variable kk
   temp3=temp1(end-Fperiods+1:end,kk);
   % record these values in the corresponding matrix of forecast_record
   forecast_record{kk,1}(ii,:)=temp3';
   end

% then go for next iteration
end


function [x,g,xn,gg] = kmeanhar(d,k,l,e,x0)
%KMEANS Vector quantisation using K-harmonic means algorithm [X,G,XN,GG]=(D,K,L,E,X0)
%
%  Inputs:
%
%    D(N,P)  contains N data vectors of dimension P
%    K       is number of centres required
%    L       integer portion is max loop count, fractional portion
%            gives stopping threshold as fractional reduction in performance criterion
%    E       is exponent in the cost function. Significantly faster if this is an even integer. [default 4]
%    X0(K,P) are the initial centres (optional)
%            Alternatively, X0 can be a character determining the initialization method:
%                'f'    Initialize with K randomly selected data points [default]
%                'p'    Initialize with centroids and variances of random partitions
%
%  Outputs:
%
%    X(K,P)  is output row vectors
%    G       is the final performance criterion value (normalized by N)
%    XN      nearest centre for each input point
%    GG(L+1) value of performance criterion before each iteration and at end
%
% The k-harmonic means algorithm selects K cluster centres to minimize
%                           sum_n(K/sum_k((d_n-x_k)^-e))
% where sum_n is over the N inputs points d_n and sum_k is over the K cluster centres x_k.
%
% It is often a good idea to scale the input data so that it has equal variance in each
% dimension before calling KMEANHAR so that approximately equal weight is given
% to each dimension in the distance calculation.

%  [1] Bin Zhang, "Generalized K-Harmonic Means - Boosting in Unsupervised Learning",
%      Hewlett-Packartd Labs, Technical Report HPL-2000-137, 2000 [Zhang2000]
%      http://www.hpl.hp.com/techreports/2000/HPL-2000-137.pdf

%  Bugs:
%      (1) Could use nested blocking to allow very large data arrays
%      (2) Could then allow incremental calling with partial data arrays (but messy)

%      Copyright (C) Mike Brookes 1998
%      Version: $Id: kmeanhar.m,v 1.6 2008/06/02 07:20:52 dmb Exp $
%
%   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.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% sort out the input arguments

if nargin<5
    x0='f';
    if nargin<4
        e=[];
        if nargin<3
            l=[];
        end
    end
end
if isempty(e)
    e=4;  % default value
end
if isempty(l)
    l=50+1e-3; % default value
end
sd=5;       % number of times we must be below threshold

% split into chunks if there are lots of data points

memsize=voicebox('memsize');
[n,p] = size(d);
nb=min(n,max(1,floor(memsize/(8*p*k))));    % block size for testing data points
nl=ceil(n/nb);                  % number of blocks

% initialize if X0 argument is not supplied

if ischar(x0)
    if k<n
        if any(x0=='p')                  % Initialize using a random partition
            ix=ceil(rand(1,n)*k);       % allocate to random clusters
            ix(rnsubset(k,n))=1:k;      % but force at least one point per cluster
            x=zeros(k,p);
            for i=1:k
                x(i,:)=mean(d(ix==i,:),1);
            end
        else                                % Forgy initialization: choose k random points [default]
            x=d(rnsubset(k,n),:);         % sample k centres without replacement
        end
    else
        x=d(mod((1:k)-1,n)+1,:);    % just include all points several times
    end
else
    x=x0;
end
eh=e/2;
th=l-floor(l);
l=floor(l)+(nargout>1);   % extra loop needed to calculate final performance value
if l<=0
    l=100;      % max number of iterations ever
end
if th==0
    th=-1;      % prevent any stopping if l has no fractional part
end
gg=zeros(l+1,1);
im=repmat(1:k,1,nb); im=im(:);

% index arrays for replication

wk=ones(k,1);
wp=ones(1,p);
% wn=ones(1,n);
%
% % Main calculation loop
%
% We have the following relationships to [1] where i and k index
% the data values and cluster centres respectively:
%
%   This program     [Zhang2000]                            Equation
%
%     d(i,:)            x_i                                 input data
%     x(k,:)            m_k                                 cluster centres
%     py(k,i)           (d_ik)^2
%     dm(i)'            d_i,min^2
%     pr(k,i)           (d_i,min/d_ik)^2
%     pe(k,i)           (d_i,min/d_ik)^p                    (7.6)
%     qik(k,i)          q_ik                                (7.2)
%     qk(k)             q_k                                 (7.3)
%     qik(k,i)./qk(k)   p_ik                                (7.4)
%     se(i)'            d_i,min^p * sumk(d_ik^-p)
%     xf(i)'            d_i,min^-2 / sumk(d_ik^-p)
%     xg(i)'            d_i,min^-(p+2) / sumk(d_ik^-p)^2

ss=sd+1;        % one extra loop at the start
g=0;                % dummy initial value of g
xn=zeros(n,1);
for j=1:l

    g1=g;                           % save old performance
    x1=x;                           % save old centres
    % first do partial chunk

    jx=n-(nl-1)*nb;
    ii=1:jx;
    kx=repmat(ii,k,1);
    km=repmat(1:k,1,jx);
    py=reshape(sum((d(kx(:),:)-x(km(:),:)).^2,2),k,jx);
    [dm,xn(ii)]=min(py,[],1);                 % min value in each column gives nearest centre
    dmk=dm(wk,:);                   % expand into a matrix
    dq=py>dmk;                      % update only these values
    pr=ones(k,jx);                   % leaving others at 1
    pr(dq)=dmk(dq)./py(dq);            % ratio of min(py)./py
    pe=pr.^eh;
    se=sum(pe,1);
    xf=dm.^(eh-1)./se;
    g=xf*dm.';                     % performance criterion (divided by k)
    xg=xf./se;
    qik=xg(wk,:).*pe.*pr;           % qik(k,i) is equal to q_ik in [Zhang2000]
    qk=sum(qik,2);
    xs=qik*d(ii,:);
    ix=jx+1;
    for il=2:nl
        jx=jx+nb;        % increment upper limit
        ii=ix:jx;
        kx=ii(wk,:);
        py=reshape(sum((d(kx(:),:)-x(im,:)).^2,2),k,nb);
        [dm,xn(ii)]=min(py,[],1);                 % min value in each column gives nearest centre
        dmk=dm(wk,:);                   % expand into a matrix
        dq=py>dmk;                      % update only these values
        pr=ones(k,nb);                   % leaving others at 1
        pr(dq)=dmk(dq)./py(dq);            % ratio of min(py)./py
        pe=pr.^eh;
        se=sum(pe,1);
        xf=dm.^(eh-1)./se;
        g=g+xf*dm.';                     % performance criterion (divided by k)
        xg=xf./se;
        qik=xg(wk,:).*pe.*pr;           % qik(k,i) is equal to q_ik in [Zhang2000]
        qk=qk+sum(qik,2);
        xs=xs+qik*d(ii,:);
        ix=jx+1;
    end
    gg(j)=g;
    x=xs./qk(:,wp);
    if g1-g<=th*g1
        ss=ss-1;
        if ~ss break; end  %  stop if improvement < threshold for sd consecutive iterations
    else
        ss=sd;
    end
end
gg=gg(1:j)*k/n;                       % scale and trim the performance criterion vector
g=g(end);
% gg' % *** DEBUIG ***
if nargout>1
    x=x1;                               % go back to the previous x values if G and/or XN value is output
end


function plotSDCon(sdcone,data)
%PLOTSDCON Plot Semidefinite Constraints on the current figure
%   plotSDCon(sdcone)

%   Copyright (C) 2013 Jonathan Currie (I2C2)

xl = xlim; yl = ylim;
hold on;

%Colour
dkr = [179/255 0.0 70/255];

%Determine number of quad constraints
if(iscell(sdcone))
    no = length(sdcone);
else
    no = 1;
end
%Generate Constraint Surface Points
[x1,x2] = meshgrid(linspace(xl(1),xl(2),data.npts),linspace(yl(1),yl(2),data.npts));

%For each semidefinite constraint, plot
for i = 1:no
    %Get Constraint Variables & Form Constraint Function
    if(iscell(sdcone))
        m = sqrt(size(sdcone{i},1));
        C = reshape(sdcone{i}(:,1),m,m); A0 = reshape(sdcone{i}(:,2),m,m);
        switch(data.ndec)
            case 1
                con = @(x) min(eig(A0*x(1) - C));
            case 2
                A1 = reshape(sdcone{i}(:,3),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) - C));
            case 3
                A1 = reshape(sdcone{i}(:,3),m,m); A2 = reshape(sdcone{i}(:,4),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) - C));
            case 4
                A1 = reshape(sdcone{i}(:,3),m,m); A2 = reshape(sdcone{i}(:,4),m,m);
                A3 = reshape(sdcone{i}(:,5),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) + A3*x(4) - C));
            case 5
                A1 = reshape(sdcone{i}(:,3),m,m); A2 = reshape(sdcone{i}(:,4),m,m);
                A3 = reshape(sdcone{i}(:,5),m,m); A4 = reshape(sdcone{i}(:,6),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) + A3*x(4) + A4*x(5) - C));
            otherwise
                error('Plotting Semidefinite constraints up to 5D is only supported');
        end
    else
        m = sqrt(size(sdcone,1));
        C = reshape(sdcone(:,1),m,m);
        A0 = reshape(sdcone(:,2),m,m);
        switch(data.ndec)
            case 1
                con = @(x) min(eig(A0*x(1) - C));
            case 2
                A1 = reshape(sdcone(:,3),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) - C));
            case 3
                A1 = reshape(sdcone(:,3),m,m);
                A2 = reshape(sdcone(:,4),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) - C));
            case 4
                A1 = reshape(sdcone(:,3),m,m);
                A2 = reshape(sdcone(:,4),m,m);
                A3 = reshape(sdcone(:,5),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) + A3*x(4) - C));
            case 5
                A1 = reshape(sdcone(:,3),m,m);
                A2 = reshape(sdcone(:,4),m,m);
                A3 = reshape(sdcone(:,5),m,m);
                A4 = reshape(sdcone(:,6),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) + A3*x(4) + A4*x(5) - C));
            otherwise
                error('Plotting Semidefinite constraints up to 5D is only supported');
        end
    end
    %Plot Each Quad Con as General Nonlinear Constraint
    plotNLCon(con,[],1e-6,Inf,x1,x2,dkr,data);
end
hold off;

% OLD CODE
% %Plot Semidefinite Constraints (Inefficient.. ideas appreciated!)
% [x1,x2] = meshgrid(linspace(xl(1),xl(2),npts),linspace(yl(1),yl(2),npts));
% nox = size(x1);
% noy = size(x2);
% obj = zeros(nox(1),noy(2));
% if(iscell(sdcone))
%     no = length(sdcone);
% else
%     no = 1;
% end
% for i = 1:no
%     %get vars
%     if(iscell(sdcone))
%         C = sdcone{i}(:,1); A0 = sdcone{i}(:,2); A1 = sdcone{i}(:,3);
%     else
%         m = sqrt(size(sdcone,1));
%         C = reshape(sdcone(:,1),m,m);
%         A0 = reshape(sdcone(:,2),m,m);
%         A1 = reshape(sdcone(:,3),m,m);
%     end
%     % create surface
%     for n = 1:nox(1)
%         for m = 1:noy(2)
%             obj(n,m) = min(eig(A0*x1(n,m) + A1*x2(n,m) - C));
%         end
%     end
%     c = contour(x1,x2,obj,'color',dkr,'levellist',0);
%     %Plot Hatch
%     if(~isempty(c))
%         %See if we have multiple contours (non-convex or sd)
%         len = size(c,2)-1;
%         if(c(2,1) ~= len)
%             %Build contour array
%             cstrt = 2; cend = []; n = 2; ind = 1;
%             while(ind <= len)
%                 ind = ind + c(2,ind) + 1;
%                 cend(n-1) = ind-1; %#ok<AGROW>
%                 cstrt(n) = ind+1;  %#ok<AGROW>
%                 n = n + 1;
%             end
%         else
%             cstrt = 2;
%             cend = len;
%         end
%         %Plot each contour hatch
%         for n = 1:length(cend)
%             %Get contour vectors
%             vecx = diff(c(1,cstrt(n):cend(n)));
%             vecy = diff(c(2,cstrt(n):cend(n)));
%             if(isempty(vecx) || isempty(vecy))
%                 continue;
%             end
%             %Rotate hatch lines based on infeasible region
%             xt = [c(1,cstrt(n))+vecy(1) c(2,cstrt(n))-vecx(1)]'; %check rotated -90
%             fval = all(eig(A0*xt(1) + A1*xt(2) - C) >= 1e-6);
%             if(fval) %rotate 90
%                 hvecx = -vecy;
%                 hvecy = vecx;
%             else %rotate -90
%                 hvecx = vecy;
%                 hvecy = -vecx;
%             end
%             %Normalize
%             av = mean(sqrt(hvecx.^2 + hvecy.^2));
%             dirs = atan2(hvecy,hvecx);
%             hvecx = av*cos(dirs);
%             hvecy = av*sin(dirs);
%             %Shift origin
%             hvecx = c(1,cstrt(n):cend(n)-1) + hvecx;
%             hvecy = c(2,cstrt(n):cend(n)-1) + hvecy;
%             %Plot
%             line([c(1,cstrt(n):cend(n)-1)' hvecx']',[c(2,cstrt(n):cend(n)-1)' hvecy']','Color',dkr)
%         end
%     else
%         optiwarn('opti:plot','Cannot plot semidefinite constraint as contour data is empty!');
%     end
% end
%
% hold off;


function res = chowlin_co_W(Y,x,ta,sc,opC)
% PURPOSE: Temporal disaggregation using the Chow-Lin method
%         (quarterly rho derived from Cochrane-Orcutt annual rho)
%          Without pretesting for intercept
% ------------------------------------------------------------
% SYNTAX: res = chowlin_co_W(Y,x,ta,sc,opC);
% ------------------------------------------------------------
% OUTPUT: res: a structure
%           res.meth    ='Chow-Lin';
%           res.ta      = type of disaggregation
%           res.type    = method of estimation
%           res.N       = nobs. of low frequency data
%           res.n       = nobs. of high-frequency data
%           res.pred    = number of extrapolations
%           res.sc       = frequency conversion between low and high freq.
%           res.p       = number of regressors (including intercept)
%           res.Y       = low frequency data
%           res.x       = high frequency indicators
%           res.y       = high frequency estimate
%           res.y_dt    = high frequency estimate: standard deviation
%           res.y_lo    = high frequency estimate: sd - sigma
%           res.y_up    = high frequency estimate: sd + sigma
%           res.u       = high frequency residuals
%           res.U       = low frequency residuals
%           res.beta    = estimated model parameters
%           res.beta_sd = estimated model parameters: standard deviation
%           res.beta_t  = estimated model parameters: t ratios
%           res.rho     = innovational parameter
%           res.aic     = Information criterion: AIC
%           res.bic     = Information criterion: BIC
%           res.co      = Cochrane-Orcutt regression (see LeSage
%           Econometric Toolbox)
% ------------------------------------------------------------
% INPUT: Y: Nx1 ---> vector of low frequency data
%        x: nxp ---> matrix of high frequency indicators (without intercept)
%        ta: type of disaggregation
%            ta=1 ---> sum (flow)
%            ta=2 ---> average (index)
%        sc: number of high frequency data points for each low frequency data points
%            sc= 3 ---> quarterly to monthly
%            sc= 4 ---> annual to quarterly
%        opC: 1x1 option related to intercept
%            opc = 0 : no intercept in hf model
%            opc = 1 : intercept in hf model
% ------------------------------------------------------------
% LIBRARY: aggreg, olsc
% ------------------------------------------------------------
% SEE ALSO: chowlin, litterman, fernandez, td_plot, td_print
% ------------------------------------------------------------
% REFERENCE: Chow, G. and Lin, A.L. (1971) "Best linear unbiased
% distribution and extrapolation of economic time series by related
% series", Review of Economic and Statistics, vol. 53, n. 4, p. 372-375.
% Bournay, J. y Laroque, G. (1979) "Reflexions sur la methode d'elaboration
% des comptes trimestriels", Annales de l'INSEE, n. 36, p. 3-30.

% written by:
%  Enrique M. Quilis
%  Macroeconomic Research Department
%  Ministry of Economy and Competitiveness
%  <enrique.quilis@mineco.es>

% Version 1.1 [August 2006]

t0=clock;

% ------------------------------------------------------------
% Checks

if ((sc ~= 3) & (sc ~= 4))
    error ('*** THE FREQUENCY CONVERSION SHOULD BE 3 OR 4 ***');
 end

if ((ta == 3) | (ta == 4))
    error ('*** THIS RELEASE DOES NOT PERFORM INTERPOLATION ***');
end

% ------------------------------------------------------------
% Size of the problem

[N,M] = size(Y);    % Size of low-frequency input
[n,p] = size(x);    % Size of p high-frequency inputs (without intercept)

% ------------------------------------------------------------
% Preparing the X matrix: including an intercept if opC==1

if (opC == 1)
   e=ones(n,1);
   x=[e x];       % Expanding the regressor matrix
   p=p+1;         % Number of p high-frequency inputs (plus intercept)
end

% ------------------------------------------------------------
% Generating the aggregation matrix

C = aggreg(ta,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

% -----------------------------------------------------------
% Temporal aggregation of the indicators

X=C*x;

% ------------------------------------------------------------
% Computing annual rho by means of Cochrane-Orcutt

rex = olsc(Y,X); %Econometric Toolbox (LeSage, 1999)

Ra=rex.rho; %Getting annual rho

if (Ra < 0)
    error ('*** ANNUAL RHO IS NEGATIVE. END OF PROGRAM ***');
end

if (Ra >= 1)
   Ra = 0.99;
end

r = 0:0.01:0.99; nr = length(r); R=ones(nr,1);
switch sc
case 3 %Quarterly to monthly
   for i=1:nr
      R(i) = (r(i)^5+2*r(i)^4+3*r(i)^3+2*r(i)^2+r(i)) / (2*r(i)^2+4*r(i)+3);
   end
case 4 %Annual to quarterly
   % ------------------------------------------------------------
   % Evaluating the function that relates annual and quarterly rho
   for i=1:nr
      R(i) = (r(i)*(r(i)+1)*(r(i)^2+1)^2) / (2*(r(i)^2+r(i)+2));
   end
end

% -----------------------------------------------------------
% Determination of optimal rho

[aux,h] = min(abs(Ra-R));
rho = r(h);

% -----------------------------------------------------------
% Final estimation with optimal rho

I=eye(n); w=I;
LL = diag(-ones(n-1,1),-1);

Aux=I+rho*LL;
Aux(1,1)=sqrt(1-rho^2);
w=inv(Aux'*Aux);           % High frequency VCV matrix (without sigma_a)
W=C*w*C';                  % Low frequency VCV matrix (without sigma_a)
Wi=inv(W);
beta=(X'*Wi*X)\(X'*Wi*Y);  % beta estimator
U=Y-X*beta;                % Low frequency residuals
scp=U'*Wi*U;               % Weighted least squares
sigma_a=scp/(N-p);         % sigma_a estimator
L=w*C'*Wi;                 % Filtering matrix
u=L*U;                     % High frequency residuals

% -----------------------------------------------------------
% Temporally disaggregated time series

y = x*beta + u;

% -----------------------------------------------------------
% Information criteria
% Note: p is expanded to include the innovational parameter

aic=log(sigma_a)+2*(p+1)/N;
bic=log(sigma_a)+log(N)*(p+1)/N;

% -----------------------------------------------------------
% VCV matrix of high frequency estimates

sigma_beta=sigma_a*inv(X'*Wi*X);

VCV_y=sigma_a*(eye(n)-L*C)*w+(x-L*X)*sigma_beta*(x-L*X)';

d_y=sqrt((diag(VCV_y)));   % Std. dev. of high frequency estimates
y_li=y-d_y;           % Lower lim. of high frequency estimates
y_ls=y+d_y;           % Upper lim. of high frequency estimates

% -----------------------------------------------------------
% -----------------------------------------------------------
% Loading the structure

res.meth='Chow-Lin';

% -----------------------------------------------------------
% Basic parameters

res.ta        = ta;
res.N         = N;
res.n         = n;
res.pred      = pred;
res.sc        = sc;
res.p         = p;
res.type      = 3;  % For output convenience
res.opC       = opC;

% -----------------------------------------------------------
% Series

res.Y         = Y;
res.x         = x;
res.y         = y;
res.y_dt      = d_y;
res.y_lo      = y_li;
res.y_up      = y_ls;

% -----------------------------------------------------------
% Residuals

res.u         = u;
res.U         = U;

% -----------------------------------------------------------
% Parameters

res.beta      = beta;
res.beta_sd   = sqrt(diag(sigma_beta));
res.beta_t    = beta./sqrt(diag(sigma_beta));
res.rho       = rho;

% -----------------------------------------------------------
% Information criteria

res.aic       = aic;
res.bic       = bic;

% -----------------------------------------------------------
% Cochrane-Orcutt results

res.co       = rex;

% -----------------------------------------------------------
% Objective function

res.val       = R;
res.r         = r;
res.valA      = Ra * ones(nr,1);
res.ropt      = rho * ones(nr,1);

% -----------------------------------------------------------
% Elapsed time

res.et        = etime(clock,t0);


function [z,Z,iZ,MD2,Z_e,Z_y] = innovation(y,R,e,E,f)

% INNOVATION  Innovation of an observation.
%   [z,Z] = INNOVATION(y,R,e,E) computes innovation z and innovation's
%   covariances matrix Z from a measurement N{y,R} to the expectation N{e,E}
%   as
%
%     z = y - e
%     Z = R + E
%
%   [z,Z] = INNOVATION(y,R,e,E,@Finn) uses the innovation function Finn to
%   compute the innovation:
%
%       z = Finn(y,e)
%
%   and uses its Jacobians F_e and F_y to compute Z:
%
%       Z = F_e*E*F_e' + F_y*R*F_y'
%
%   [z,Z,iZ,MD2] = INNOVATION(...) returns also the inverse of the
%   innovation covariance iZ and the squared Mahalanobis distance MD2.
%
%   [z,Z,iZ,MD2,F_e,F_y] INNOVATION(...) returns the Jacobians wrt the
%   expectation e and the measurement y.
%
%   EXAMPLES:
%   innovation(seg,SEG,hmLin,HMLIN,@hms2hh) is the innovation of a segment
%   measurement seg = [x1;y1;x2;y2] with respect to a homogeneous line
%   hmLin = [a;b;c], defined as the two orthogonal distances from [xi;yi]
%   to hmLin.
%
%   See also HMS2HH, MAHALANOBIS.

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

if nargin == 4  % Use plain Euclidean innovation
    z   = y - e;
    Z   = R + E;
    Z_e = -1;
    Z_y = 1;
else            % Use given function
    [z,Z_e,Z_y] = f(e,y);
    Z = Z_e*E*Z_e' + Z_y*R*Z_y';
end

% compute extra outputs
if nargout >= 3
    iZ = eye(size(Z,1))/Z;  % better than inv(Z) -- ask Matlab!
    if nargout >= 4
        MD2 = z'*iZ*z;
    end
end

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

%   # START GPL LICENSE

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

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

%   # END GPL LICENSE


function [c,Ls] = unsdgtreal(f,g,a,M)
%UNSDGTREAL  Uniform non-stationary Discrete Gabor transform
%   Usage:  c=unsdgtreal(f,g,a,M);
%           [c,Ls]=unsdgtreal(f,g,a,M);
%
%   Input parameters:
%         f     : Input signal.
%         g     : Cell array of window functions.
%         a     : Vector of time positions of windows.
%         M     : Vector of numbers of frequency channels.
%   Output parameters:
%         c     : Cell array of coefficients.
%         Ls    : Length of input signal.
%
%   `unsdgtreal(f,g,a,M)` computes the non-stationary Gabor coefficients of the
%   input signal *f*. The signal *f* can be a multichannel signal, given in
%   the form of a 2D matrix of size $Ls \times W$, with *Ls* the signal
%   length and *W* the number of signal channels.
%
%   As opposed to |nsdgt| only the coefficients of the positive frequencies
%   of the output are returned. `unsdgtreal` will refuse to work for complex
%   valued input signals.
%
%   The non-stationary Gabor theory extends standard Gabor theory by
%   enabling the evolution of the window over time. It is therefore
%   necessary to specify a set of windows instead of a single window.  This
%   is done by using a cell array for *g*. In this cell array, the n'th
%   element `g{n}` is a row vector specifying the n'th window. The
%   uniformity means that the number of channels is not allowed to vary over
%   time.
%
%   The resulting coefficients is stored as a $M/2+1 \times N \times W$
%   array. `c(m,n,l)` is thus the value of the coefficient for time index *n*,
%   frequency index *m* and signal channel *l*.
%
%   The variable *a* contains the distance in samples between two
%   consecutive blocks of coefficients. The variable *M* contains the
%   number of channels for each block of coefficients. Both *a* and *M* are
%   vectors of integers.
%
%   The variables *g*, *a* and *M* must have the same length, and the result *c*
%   will also have the same length.
%
%   The time positions of the coefficients blocks can be obtained by the
%   following code. A value of 0 correspond to the first sample of the
%   signal::
%
%     timepos = cumsum(a)-a(1);
%
%   `[c,Ls]=unsdgtreal(f,g,a,M)` additionally returns the length *Ls* of the input
%   signal *f*. This is handy for reconstruction::
%
%     [c,Ls]=unsdgtreal(f,g,a,M);
%     fr=insdgtreal(c,gd,a,Ls);
%
%   will reconstruct the signal *f* no matter what the length of *f* is,
%   provided that *gd* are dual windows of *g*.
%
%   Notes:
%   ------
%
%   `unsdgtreal` uses circular border conditions, that is to say that the signal is
%   considered as periodic for windows overlapping the beginning or the
%   end of the signal.
%
%   The phaselocking convention used in `unsdgtreal` is different from the
%   convention used in the |dgt| function. `unsdgtreal` results are phaselocked (a
%   phase reference moving with the window is used), whereas |dgt| results are
%   not phaselocked (a fixed phase reference corresponding to time 0 of the
%   signal is used). See the help on |phaselock| for more details on
%   phaselocking conventions.
%
%   See also:  nsdgt, insdgtreal, nsgabdual, nsgabtight, phaselock
%
%   Demos:  demo_nsdgt
%
%   References: ltfatnote018

%   AUTHOR : Florent Jaillet
%   TESTING: TEST_NSDGTREAL
%   REFERENCE:

if ~isnumeric(a)
  error('%s: a must be numeric.',upper(mfilename));
end;

if ~isnumeric(M)
  error('%s: M must be numeric.',upper(mfilename));
end;

L=sum(a);

[f,Ls,W,wasrow,remembershape]=comp_sigreshape_pre(f,'UNSDGTREAL',0);
f=postpad(f,L);

[g,info]=nsgabwin(g,a,M);

if ~info.isuniform
    error('%s: M must be a scalar or a constant vector.',upper(mfilename));
end;
M=M(1);

timepos=cumsum(a)-a(1);

N=length(a); % Number of time positions

M2=floor(M/2)+1;
c=zeros(M2,N,W,assert_classname(f,g{1})); % Initialisation of the result

for ii=1:N
  shift=floor(length(g{ii})/2);
  temp=zeros(M,W,assert_classname(f,g{1}));

  % Windowing of the signal.
  % Possible improvements: The following could be computed faster by
  % explicitely computing the indexes instead of using modulo and the
  % repmat is not needed if the number of signal channels W=1 (but the time
  % difference when removing it whould be really small)
  temp(1:length(g{ii}))=f(mod((1:length(g{ii}))+timepos(ii)-shift-1,L)+1,:).*...
    repmat(conj(circshift(g{ii},shift)),1,W);

  temp=circshift(temp,-shift);
  if M<length(g{ii})
    % Fft size is smaller than window length, some aliasing is needed
    x=floor(length(g{ii})/M);
    y=length(g{ii})-x*M;
    % Possible improvements: the following could probably be computed
    % faster using matrix manipulation (reshape, sum...)
    temp1=temp;
    temp=zeros(M,size(temp,2),assert_classname(f,g{1}));
    for jj=0:x-1
      temp=temp+temp1(jj*M+(1:M),:);
    end
    temp(1:y,:)=temp(1:y,:)+temp1(x*M+(1:y),:);
  end

  % FFT of the windowed signal
  c(:,ii,:) = reshape(fftreal(temp),M2,1,W);
end


function [logww] = free_energy(vv,beta_k1,beta_k0,visbiases_base,visbiases,hidbias,vishid)

 [numcases,numdims] = size(vv);
 temp_base = vv*visbiases_base';
 temp_bias = vv*visbiases';
 tempvWh = hidbias + (vv*vishid);

 aa = beta_k1;
 p_star_k1  = (1-aa)*temp_base  + aa*temp_bias + sum(log(1+exp(aa*tempvWh)),2);

 aa = beta_k0;
 p_star_k0  =  (1-aa)*temp_base + aa*temp_bias + sum(log(1+exp(aa*tempvWh)),2);

 logww = (p_star_k1 - p_star_k0);


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

%Empty workspace and close figures
close all;
clear;

%Define number of UEs per cell
K = 10;

%Define the range of BS antennas
Mrange = 10:10:100;

%Define the pilot length
tau_p = K;

%Complexity of MMSE channel estimation, based on Table 3.1
complexity_MMSE = Mrange*tau_p + Mrange.^2;

%Complexity of EW-MMSE channel estimation, based on Table 3.1
complexity_EW_MMSE = Mrange*(tau_p + 1);

%Complexity of LS channel estimation, based on Table 3.1
complexity_LS = Mrange*tau_p;

%% Plot the simulation results
figure;
hold on; box on;

plot(Mrange,complexity_MMSE,'r--','LineWidth',1);
plot(Mrange,complexity_EW_MMSE,'k-','LineWidth',1);
plot(Mrange,complexity_LS,'b-.','LineWidth',1);

xlabel('Number of antennas (M)');
ylabel('Number of complex multiplications');
set(gca,'YScale','log');

legend('MMSE','EW-MMSE','LS','Location','NorthWest');


function element_node = grid_t10_element ( nelemx, nelemy )

%*****************************************************************************80
%
%% GRID_T10_ELEMENT produces a grid of pairs of 10 node triangles.
%
%  Example:
%
%    Input:
%
%      NELEMX = 2, NELEMY = 2
%
%    Output:
%
%      ELEMENT_NODE =
%         1,  2,  3,  4, 10, 16, 22, 15,  8,  9;
%        25, 24, 23, 22, 16, 10,  4, 11, 18, 17;
%         4,  5,  6,  7, 13, 19, 25, 18, 11, 12;
%        28, 27, 26, 25, 19, 13,  7, 14, 21, 20;
%        22, 23, 24, 25, 31, 37, 43, 36, 29, 30;
%        46, 45, 44, 43, 37, 31, 25, 32, 39, 38;
%        25, 26, 27, 28, 34, 40, 46, 39, 31, 33;
%        49, 48, 47, 46, 40, 34, 28, 35, 42, 41.
%
%  Grid:
%
%   43-44-45-46-47-48-49
%    |\     6 |\     8 |
%    | \      | \      |
%   36 37 38 39 40 41 42
%    |   \    |   \    |
%    |    \   |    \   |
%   29 30 31 32 33 34 35
%    |      \ |      \ |
%    | 5     \| 7     \|
%   22-23-24-25-26-27-28
%    |\     2 |\     4 |
%    | \      | \      |
%   15 16 17 18 19 20 21
%    |   \    |   \    |
%    |    \   |    \   |
%    8  9 10 11 12 13 14
%    |      \ |      \ |
%    | 1     \| 3     \|
%    1--2--3--4--5--6--7
%
%  Reference Element T10:
%
%    |
%    1  10
%    |  |\
%    |  | \
%    |  8  9
%    |  |   \
%    S  |    \
%    |  5  6  7
%    |  |      \
%    |  |       \
%    0  1--2--3--4
%    |
%    +--0----R---1-->
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 April 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NELEMX, NELEMY, the number of elements along the
%    X and Y directions.  The number of elements generated will be
%    2 * NELEMX * NELEMY.
%
%    Output, integer ELEMENT_NODE(10,2*NELEMX*NELEMY), the nodes that form
%    each element.
%
  element = 0;

  for j = 1 : nelemy
    for i = 1 : nelemx

      base = ( j - 1 ) * 3 * ( 3 * nelemx + 1 ) + 3 * i - 2;

      element = element + 1;

      element_node( 1,element) = base;
      element_node( 2,element) = base                          + 1;
      element_node( 3,element) = base                          + 2;
      element_node( 4,element) = base                          + 3;
      element_node( 5,element) = base +     ( 3 * nelemx + 1 ) + 2;
      element_node( 6,element) = base + 2 * ( 3 * nelemx + 1 ) + 1;
      element_node( 7,element) = base + 3 * ( 3 * nelemx + 1 );
      element_node( 8,element) = base + 2 * ( 3 * nelemx + 1 );
      element_node( 9,element) = base +     ( 2 * nelemx + 1 ) + 2;
      element_node(10,element) = base +     ( 2 * nelemx + 1 ) + 3;

      element = element + 1;

      element_node( 1,element) = base + 3 * ( 3 * nelemx + 1 ) + 3;
      element_node( 2,element) = base + 3 * ( 3 * nelemx + 1 ) + 2;
      element_node( 3,element) = base + 3 * ( 3 * nelemx + 1 ) + 1;
      element_node( 4,element) = base + 3 * ( 3 * nelemx + 1 );
      element_node( 5,element) = base + 2 * ( 3 * nelemx + 1 ) + 1;
      element_node( 6,element) = base +     ( 3 * nelemx + 1 ) + 2;
      element_node( 7,element) = base                          + 3;
      element_node( 8,element) = base +     ( 3 * nelemx + 1 ) + 3;
      element_node( 9,element) = base + 2 * ( 3 * nelemx + 1 ) + 3;
      element_node(10,element) = base + 2 * ( 3 * nelemx + 1 ) + 2;

    end
  end

  return
end


classdef DTLZ7 < PROBLEM
% <multi/many> <real> <large/none> <expensive/none>
% Benchmark MOP proposed by Deb, Thiele, Laumanns, and Zitzler

%------------------------------- Reference --------------------------------
% K. Deb, L. Thiele, M. Laumanns, and E. Zitzler, Scalable test problems
% for evolutionary multiobjective optimization, Evolutionary multiobjective
% Optimization. Theoretical Advances and Applications, 2005, 105-145.
%------------------------------- 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".
%--------------------------------------------------------------------------

    methods
        %% Default settings of the problem
        function Setting(obj)
            if isempty(obj.M); obj.M = 3; end
            if isempty(obj.D); obj.D = obj.M+19; end
            obj.lower    = zeros(1,obj.D);
            obj.upper    = ones(1,obj.D);
            obj.encoding = ones(1,obj.D);
        end
        %% Calculate objective values
        function PopObj = CalObj(obj,PopDec)
            PopObj = zeros(size(PopDec,1),obj.M);
            g      = 1+9*mean(PopDec(:,obj.M:end),2);
            PopObj(:,1:obj.M-1) = PopDec(:,1:obj.M-1);
            PopObj(:,obj.M)     = (1+g).*(obj.M-sum(PopObj(:,1:obj.M-1)./(1+repmat(g,1,obj.M-1)).*(1+sin(3*pi.*PopObj(:,1:obj.M-1))),2));
        end
        %% Generate points on the Pareto front
        function R = GetOptimum(obj,N)
            interval     = [0,0.251412,0.631627,0.859401];
            median       = (interval(2)-interval(1))/(interval(4)-interval(3)+interval(2)-interval(1));
            X            = UniformPoint(N,obj.M-1,'grid');
            X(X<=median) = X(X<=median)*(interval(2)-interval(1))/median+interval(1);
            X(X>median)  = (X(X>median)-median)*(interval(4)-interval(3))/(1-median)+interval(3);
            R            = [X,2*(obj.M-sum(X/2.*(1+sin(3*pi.*X)),2))];
        end
        %% Generate the image of Pareto front
        function R = GetPF(obj)
            if obj.M == 2
                x      = linspace(0,1,100)';
                y      = 2*(2-x/2.*(1+sin(3*pi*x)));
                nd     = NDSort([x,y],1)==1;
                x(~nd) = nan;
                R      = [x,y];
            elseif obj.M == 3
                [x,y]  = meshgrid(linspace(0,1,20));
                z      = 2*(3-x/2.*(1+sin(3*pi*x))-y/2.*(1+sin(3*pi*y)));
                nd     = reshape(NDSort([x(:),y(:),z(:)],1)==1,size(z));
                z(~nd) = nan;
                R      = {x,y,z};
            else
                R = [];
            end
        end
    end
end


function [result_edgesize,result_pertg,nvell_num] = Riverflux_distribution(obj)
% [result_edgesize,result_pertg，nvell_num] = Riverflux_distribution(obj)
%
% Input a msh class object to get the representative edge width and flux
% percentage for each node on the riverine flow boundary.
%
% This function is used to distribute a total flux of a cross-section where
% the riverine boundary located to each node of the riverine boundary.
%
% result_edgesize and result_pertgis are the result of the representative
% edge width and flux percentage for each node, respectively. nvell_num
% represents the number of nodes for each riverine boundary.
%
% Each column of result_edgesize and result_pertg represents the result of
% each riverine boundary.
%
% Nodal representative edge width equals to the sum of half the width of
% each of the two edges it is connected to.
%
% Nodeal flow percentage on the riverine boundary equals to the flow area
% of this node divided by the total flow area of the cross-section.
%
% Nodal flow area is calculated via a trapezoidal rule using its representative
% edge width and the bathymetric depths of this node and its neighboring nodes.
%
% Note that the calculation of representative edge width and flow percentage
% for the nodes at either end of the boundary is a little bit of different.
%
% User need to specify river flow boundaries (ibtype=22) before using it.
%
% Author:      Jiangchao Qiu
% Created:     January 7 2021
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
bd_dat = obj.bd;
p_dat = obj.p;
b_dat = obj.b;
river_num = find(bd_dat.ibtype == 22);
N = length(river_num);% total number of river boundarys
nvell_num = bd_dat.nvell(river_num);% number of nodes for each river boundary

% Consider the riverine boundaries may have different number of nodes, the
% number of rows for result_edgesize and result_pertg is set to max(nvell_num)
result_edgesize = NaN(max(nvell_num),N); % the final result of edgesize
result_pertg = NaN(max(nvell_num),N);% the final result of percentage

if isempty(river_num)
    error('No riverine boundary information to distribute total flow')
end

for i=1:N
    node_num = bd_dat.nbvv(:,river_num(i));
    node_num(node_num==0)=[];
    bathy = b_dat(node_num);
    location = p_dat(node_num,:);
    J = length(node_num);% total number of nodes for the current river boundary
    flowarea = zeros(J,1);
    edgesize = zeros(J,1);
    %% calculate the projected distance for each edge on the boundary
    proj = 'Mercator';
    m_proj(proj,'lon',[ min(obj.p(:,1))-0.25 max(obj.p(:,1))+0.25 ],...
                'lat',[ min(obj.p(:,2))-0.25 max(obj.p(:,2))+0.25])
    proj_location = zeros(J,2);
    for j=1:J
        [proj_location(j,1),proj_location(j,2)] = m_ll2xy(location(j,1),location(j,2));
    end
    node_distance = 1000*m_xydist(proj_location(:,1),proj_location(:,2));
    %% calculate the respresentive width for each node
    % note: if the current boundary has J nodes, there are J-1 edges
    for j=1:J
		if j==1      % the first edge (the number is J)
            edgesize(j) = 0.5*node_distance(j);
        elseif j==J  % the last edge (the number is J-1)
            edgesize(j) = 0.5*node_distance(j-1);
        else         % the other edges
            edgesize(j) = 0.5*node_distance(j-1)+0.5*node_distance(j);
        end
        result_edgesize(1:J,i) = edgesize;
    end
    %% calculate flow area for each node on the boundary
    for j=1:J
        if j==1      % the first node
            local_z1 = (bathy(j)+bathy(j+1))*0.5;
            flowarea(j) = 0.5*(bathy(j)+local_z1)*(0.5*node_distance(j));
        elseif j==J  % the last node
            local_z1 = (bathy(j-1)+bathy(j))*0.5;
            flowarea(j) = 0.5*(bathy(j)+local_z1)*(0.5*node_distance(j-1));
        else         % the other nodes
            local_z1 = (bathy(j-1)+bathy(j))*0.5;
            local_z2 = (bathy(j)+bathy(j+1))*0.5;
            flowarea(j) = 0.5*(bathy(j)+local_z1)*(0.5*node_distance(j-1))+...
                          0.5*(bathy(j)+local_z2)*(0.5*node_distance(j));
        end
        percent = flowarea/sum(flowarea);  % the flux distribution percentage for each node
        result_pertg(1:J,i) =  percent;
    end
end


function varargout = spm_diffeo(varargin)
% Mex function called for image registration stuff
%
%_______________________________________________________________________
%
% FORMAT u = spm_diffeo('vel2mom', v, param)
% v     - velocity (flow) field n1*n2*n3*3.
% param - 8 parameters (settings)
%         - [1][2][3] Voxel sizes
%         - [4][5][6][7][8] Regularisation parameters
%           - [4] Absolute displacements need to be penalised by a tiny
%                 amount.  The first element encodes the amount of
%                 penalty on these.  Ideally, absolute displacements
%                 should not be penalised, but it is usually necessary
%                 for technical reasons.
%           - [5] The `membrane energy' of the deformation is penalised,
%                 usually by a relatively small amount. This penalises
%                 the sum of squares of the derivatives of the velocity
%                 field (ie the sum of squares of the elements of the
%                 Jacobian tensors).
%           - [6] The `bending energy' is penalised (3rd element). This
%                 penalises the sum of squares of the 2nd derivatives of
%                 the velocity.
%           - [7][8] Linear elasticity regularisation is also included.
%                    The first parameter (mu) is similar to that for
%                    linear elasticity, except it penalises the sum of
%                    squares of the Jacobian tensors after they have been
%                    made symmetric (by averaging with the transpose).
%                    This term essentially penalises length changes,
%                    without penalising rotations.
%                    The final term also relates to linear elasticity,
%                    and is the weight that denotes how much to penalise
%                    changes to the divergence of the velocities (lambda).
%                    This divergence is a measure of the rate of volumetric
%                    expansion or contraction.
% u       - `momentum' field n1*n2*n3*3.
%
% Convert a velocity field to a momentum field by u = A*v, where
% A is the large sparse matrix encoding some form of regularisation.
% v and m are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT v = spm_diffeo('mom2vel',g, param)
% v     - the solution n1*n2*n3*3
% g     - parameterisation of first derivatives
% param - 10 parameters (settings)
%         - [1][2][3] Voxel sizes
%         - [4][5][6][7][8] Regularisation settings (see vel2mom).
%         - [9] Number of Full Multigrid cycles.
%         - [10] Number of relaxation iterations per cycle.
%
% Solve equations using a Full Multigrid method.  See Press et al
% for more information.
% v = inv(A)*g
% g and v are both single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT v = spm_diffeo('fmg',H, g, param)
% v     - the solution n1*n2*n3*3
% H     - parameterisation of 2nd derivatives
% g     - parameterisation of first derivatives
% param - 10 parameters (settings)
%         - [1][2][3] Voxel sizes
%         - [4][5][6][7][8] Regularisation settings (see vel2mom).
%         - [9] Number of Full Multigrid cycles.
%         - [10] Number of relaxation iterations per cycle.
%
% Solve equations using a Full Multigrid method, but using Hessian of
% the matching term.  See Press et al for more information.
% v = inv(A+H)*g
% H, g and v are all single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT v = spm_diffeo('cgs',H, g, param)
% v     - the solution
% H     - parameterisation of 2nd derivatives
% g     - parameterisation of first derivatives
% param - 10 parameters (settings)
%         - [1][2][3] Voxel sizes
%         - [4][5][6][7][8] Regularisation settings (see vel2mom).
%         - [9] Tolerance.  Indicates required degree of accuracy.
%         - [10] Maximum number of iterations.
%
% This is for solving a set of equations using a conjugate gradient
% solver. This method is less efficient than the Full Multigrid, and
% is included for illustrative purposes.
% v = inv(A+H)*g
% H, g and v are all single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT F = spm_diffeo('kernel',d,prm)
% d   - image dimensions
% prm - 8 parameters (settings).
%       These are described above (for 'vel2mom').
% F   - The differential operator encoded as an image (or images).
%       Convolving a velocity field by this will give the momentum.
%
%_______________________________________________________________________
%
% FORMAT y3 = spm_diffeo('comp',y1,y2)
% y1, y2 - deformation fields n1*n2*n3*3.
% y3     - deformation field field n1*n2*n3*3.
%
% Composition of two deformations y3 = y1(y2)
% y1, y2 and y3 are single precision floating point.
%
%
% FORMAT [y3,J3] = spm_diffeo('comp', y1, y2, J1, J2)
% y1, y2 - deformation fields n1*n2*n3*3.
% y3     - deformation field n1*n2*n3*3.
% J1, J2 - Jacobian tensor fields n1*n2*n3*3*3.
% J3     - Jacobian tensor field n1*n2*n3*3*3.
%
% Composition of two deformations, with their Jacobian fields.
% All fields are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT iy = spm_diffeo('invdef',y,d,M1,M2);
%
% iy - inverted deformation field of size d(1)*d(2)*d(3)*3.
% y  - original deformation field.
% M1 - An affine mapping from mm to voxels in the co-ordinate
%      system of the inverse deformation field.
% M2 - An affine mapping from voxels to mm in the co-ordinate
%      system of the forward deformation field.
%
% Inversion of a deformation field.
%
% The field is assumed to consist of a piecewise affine transformations,
% whereby each cube jointing 8 neighbouring voxels contains eight
% tetrahedra.  The mapping within each tetrahedron is assumed to be
% affine.
%
%  Reference:
%    J. Ashburner, J. Andersson and K. J. Friston (2000).
%    "Image Registration using a Symmetric Prior - in Three-Dimensions".
%    Human Brain Mapping 9(4):212-225 (appendix).
%_______________________________________________________________________
%
% FORMAT [f,dfx,dfy,dfz] = spm_diffeo('bsplins', c, y,d)
% c          - input image(s) of B-spline coefficients n1*n2*n3*n4
%              - see 'bsplinc'
% y          - points to sample n1*n2*n3*3
% d(1:3)     - degree of B-spline (from 0 to 7) along different dimensions
%              - these must be same as used by 'bsplinc'
% d(4:6)     - 1/0 to indicate wrapping along the dimensions
%
% f           - output image n1*n2*n3*n4
% dfx,dfy,dfz - sampled first derivatives
%
% c, f and y are single precision floating point.
%
% This function takes B-spline basis coefficients from spm_bsplinc,
% and re-convolves them with B-splines centred at the new sample points.
%
% Note that nearest neighbour interpolation is used instead of 0th
% degree B-splines, and the derivatives of trilinear interpolation are
% returned insted of those of 1st degree B-splines.  The difference is
% extremely subtle.
%
% c, f and y are single precision floating point.
%
%  References:
%    M. Unser, A. Aldroubi and M. Eden.
%    "B-Spline Signal Processing: Part I-Theory,"
%    IEEE Transactions on Signal Processing 41(2):821-832 (1993).
%
%    M. Unser, A. Aldroubi and M. Eden.
%    "B-Spline Signal Processing: Part II-Efficient Design and
%    Applications,"
%    IEEE Transactions on Signal Processing 41(2):834-848 (1993).
%
%    M. Unser.
%    "Splines: A Perfect Fit for Signal and Image Processing,"
%    IEEE Signal Processing Magazine, 16(6):22-38 (1999)
%
%    P. Thevenaz and T. Blu and M. Unser.
%    "Interpolation Revisited"
%    IEEE Transactions on Medical Imaging 19(7):739-758 (2000).
%
%_______________________________________________________________________
%
% FORMAT c = spm_diffeo('bsplinc',f,d)
%   f - an image
%   d(1:3) - degree of B-spline (from 0 to 7) along different dimensions
%       d(4:6) - 1/0 to indicate wrapping along the dimensions
%   c - returned volume of B-spline coefficients
%
% This function deconvolves B-splines from f, returning
% coefficients, c.  These coefficients are then passed to 'bsplins'
% in order to sample the data using B-spline interpolation.
%
%_______________________________________________________________________
%
% FORMAT f2 = spm_diffeo('samp', f1, y)
% f1 - input image(s) n1*n2*n3*n4
% y  - points to sample n1*n2*n3*3
% f2 - output image n1*n2*n3*n4
%
% Sample a function according to a deformation using trilinear interp.
% f2 = f1(y)
% f1, f2 and y are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT f2 = spm_diffeo('push', f1, y)
% f1 - input image(s) n1*n2*n3*n4
% y  - points to sample n1*n2*n3*3
% f2 - output image n1*n2*n3*n4
%
% Push values of a function according to a deformation.  Note that the
% deformation should be the inverse of the one used with 'samp' or 'bsplins'.
% f1, f2 and y are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT f2 = spm_diffeo('pushc', f1, y)
% f1 - input image(s) n1*n2*n3*n4
% y  - points to sample n1*n2*n3*3
% f2 - output image n1*n2*n3*n4
%
% Push values of a function according to a deformation, but using
% circulant boundary conditions.  Data wraps around.
% f1, f2 and y are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT ut = spm_diffeo('pushg', u0, y)
% u0 - input momentum n1*n2*n3*3
% y  - points to sample n1*n2*n3*3
% ut - output momentum n1*n2*n3*3
%
% FORMAT ut = spm_diffeo('pushg', u0, y)
% u0 - input momentum n1*n2*n3*3
% y  - points to sample n1*n2*n3*3
% J  - Jacobian tensor field of y n1*n2*n3*3*3
% ut - output momentum n1*n2*n3*3
%
% Push values of a momentum field according to a deformation using
% circulant boundary conditions.  This essentially computes
% (Ad_y)^* u = |det dy| (dy)^T u(y), which is a key to the
% EPdiff equations used for geodesic shooting.
% u0, ut and y are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT f2 = spm_diffeo('resize', f1, dim)
% f1  - input fields n1*n2*n3*n4
% f2  - output field dim1*dim2*dim3*n4
% dim - output dimensions
%
% Resize a field according to dimensions dim.  This is a component of
% the multigrid approach, and is used for prolongation.
%
%_______________________________________________________________________
%
% FORMAT v2 = spm_diffeo('restrict', v1)
% v1  - input fields n1*n2*n3*n4
% v2  - output field dim1*dim2*dim3*n4
%
% Restricts a field such that its dimensions are approximately half
% their original.  This is a component of the multigrid approach.
%
%_______________________________________________________________________
%
% FORMAT J = spm_diffeo('def2jac',y)
% y - Deformation field
% J - Jacobian tensor field of y
%
% Compute Jacobian tensors from a deformation.
%
%_______________________________________________________________________
%
% FORMAT J = spm_diffeo('def2det',y)
% y - Deformation field
% j - Jacobian determinant field of y
%
% Compute Jacobian determinants from a deformation.
%
%_______________________________________________________________________
%
% FORMAT j = spm_diffeo('det',J)
% J - Jacobian tensor field
% j - Jacobian determinant field
%
% Compute determinants of Jacobian tensors.
%
%_______________________________________________________________________
%
% FORMAT dv = spm_diffeo('div',v)
% v  - velocity field
% dv - divergences of velocity field
%
% Computes divergence from velocity field.  This is indicative of rates
% of volumetric expansion/contraction.
%
%_______________________________________________________________________
%
% FORMAT [y,J] = spm_diffeo('smalldef',v,s)
% v - velocity field
% s - scaling factor
% y - small deformation
% J - approximate Jacobian tensors of small deformation (computed via
%     a matrix exponsntial of the Jacobians of the velocity field).
%
% This function is used for each time step of geodesic shooting.  It may
% change in future to use some form of Pade approximation of the
% small deformation.
%
%_______________________________________________________________________
%
% FORMAT v3 = spm_diffeo('brc', v1, v2)
% v1, v2, v3 - flow fields n1*n2*n3*3
%
% Lie Bracket.  Useful for many things
% e.g. Baker-Campbell-Haussdorf series expansion.
% The Lie bracket is denoted by
% v3 = [v1,v2]
% and on scalar fields, is computed by
% v3 = J1*v2 - J2*v1, where J1 and J2 are the Jacobian
% tensor fields. For matrices, the Lie bracket is simply
% [A,B] = A*B-B*A
%
%_______________________________________________________________________
%
% FORMAT v = spm_diffeo('dartel',v,g,f,param)
% v     - flow field n1*n2*n3*3 (single precision float)
% g     - first image n1*n2*n3*n4 (single precision float)
% f     - second image n1*n2*n3*n4 (single precision float)
% param - 9 parameters (settings)
%         - [1] Regularisation type, can take values of
%           - 0 Linear elasticity
%           - 1 Membrane energy
%           - 2 Bending energy
%         - [2][3][4] Regularisation parameters
%           - For "membrane energy", the parameters are
%             lambda, unused and id.
%           - For "linear elasticity", the parameters are
%             mu, lambda, and id
%           - For "bending energy", the parameters are
%             lambda, id1 and id2, such that regularisation is by
%             (-lambda*\grad^2 + id1)^2 + id2
%         - [5] Levenberg-Marquardt regularisation
%         - [6] Number of Full Multigrid cycles
%         - [7] Number of relaxation iterations per cycle
%         - [8] K, such that 2^K time points are used to
%               generate the deformations.  A value of zero
%               indicates a small deformation model.
%         - [9] code of 0, 1 or 2.
%               0 - asymmetric sums of squares objective function.
%               1 -  symmetric sums of squares objective function.
%               2 - assumes multinomial distribution, where template
%                   encodes the means and interpolation of template
%                   done using logs and softmax function.
%
% This is for performing a single iteration of the Dartel optimisation.
% All velocity fields and images are represented by single precision floating
% point values. Images can be scalar fields, in which case the objective
% function is the sum of squares difference.  Alternatively, images can be
% vector fields, in which case the objective function is the sum of squares
% difference between each scalar field + the sum of squares difference
% between one minus the sum of the scalar fields.
%
%_______________________________________________________________________
%
% FORMAT [y,J] = spm_diffeo('Exp', v, param)
% v - flow field
% J - Jacobian. Usually a tensor field of Jacobian matrices, but can
%     be a field of Jacobian determinants.
% param - 2 (or 3) parameters.
%         [1] K, the number of recursions (squaring steps), such
%             that exponentiation is done using an Euler-like
%             integration with 2^K time steps.
%         [2] a scaling parameter.
%         If there is a third parameter, and it is set to 1, then
%         the J will be the Jacobian determinants.
%
% A flow field is "exponentiated" to generate a deformation field
% using a scaling and squaring approach.  See the work of Arsigny
% et al, or Cleve Moler's "19 Dubious Ways" papers.
%
%_______________________________________________________________________
%
% Note that the boundary conditions are circulant throughout.
% Interpolation is trilinear, except for the resize function
% which uses a 2nd degree B-spline (without first deconvolving).
%
%_______________________________________________________________________
% Copyright (C) 2012 Wellcome Trust Centre for Neuroimaging

% John Ashburner
% $Id: spm_diffeo.m 4890 2012-09-03 15:19:46Z guillaume $

%-This is merely the help file for the compiled routine
error('spm_diffeo.c not compiled - see Makefile')