classdef MaF13 < PROBLEM
% <multi/many> <real> <large/none>
% P7

%------------------------------- Reference --------------------------------
% R. Cheng, M. Li, Y. Tian, X. Zhang, S. Yang, Y. Jin, and X. Yao, A
% benchmark test suite for evolutionary many-objective optimization,
% Complex & Intelligent Systems, 2017, 3(1): 67-81.
%------------------------------- 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 = 5; end
            obj.M        = max(obj.M,3);
            obj.lower    = [zeros(1,2),zeros(1,obj.D-2)-2];
            obj.upper    = [ones(1,2),zeros(1,obj.D-2)+2];
            obj.encoding = ones(1,obj.D);
        end
        %% Calculate objective values
        function PopObj = CalObj(obj,X)
            [N,D] = size(X);
            Y = X - 2*repmat(X(:,2),1,D).*sin(2*pi*repmat(X(:,1),1,D)+repmat(1:D,N,1)*pi/D);
            PopObj(:,1) = sin(X(:,1)*pi/2)                   + 2*mean(Y(:,4:3:D).^2,2);
            PopObj(:,2) = cos(X(:,1)*pi/2).*sin(X(:,2)*pi/2) + 2*mean(Y(:,5:3:D).^2,2);
            PopObj(:,3) = cos(X(:,1)*pi/2).*cos(X(:,2)*pi/2) + 2*mean(Y(:,3:3:D).^2,2);
            PopObj(:,4:obj.M) = repmat(PopObj(:,1).^2+PopObj(:,2).^10+PopObj(:,3).^10+2*mean(Y(:,4:D).^2,2),1,obj.M-3);
        end
        %% Generate points on the Pareto front
        function R = GetOptimum(obj,N)
            R = UniformPoint(N,3);
            R = R./repmat(sqrt(sum(R.^2,2)),1,3);
            R = [R,repmat(R(:,1).^2+R(:,2).^10+R(:,3).^10,1,obj.M-3)];
        end
        %% Generate the image of Pareto front
        function R = GetPF(obj)
            if obj.M == 3
                a = linspace(0,pi/2,10)';
                R = {sin(a)*cos(a'),sin(a)*sin(a'),cos(a)*ones(size(a'))};
            else
                R = [];
            end
        end
    end
end


%% SOBOL_TEST04 tests SOBOL.
%
global SOBOL_lastq;
global SOBOL_seed;

fprintf ( 1, '\n' );
fprintf ( 1, 'SOBOL_TEST04\n' );
fprintf ( 1, '  SOBOL returns the next element\n' );
fprintf ( 1, '  of a Sobol sequence.\n' );
fprintf ( 1, '\n' );
fprintf ( 1, '  In this test, we call Sobol repeatedly.\n' );

dim_max = 4;

for ( dim_num = 2 : dim_max )

  SOBOL_seed = 0;
  seed = 0;
  qs = prime_ge ( dim_num );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Using dimension DIM_NUM =   %d\n', dim_num );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Seed  Seed   Sobol\n' );
  fprintf ( 1, '  In    Out\n' );
  fprintf ( 1, '\n' );
  for ( i = 0 : 110 )
    [ r, seed_out ] = sobol ( dim_num, seed );
    if ( i <= 11 || 95 <= i )
      fprintf ( 1, '%6d %6d  ', seed, seed_out );
      for ( j = 1 : dim_num )
        fprintf ( 1, '%10f  ', r(j) );
      end
      fprintf ( 1, '\n' );
    elseif ( i == 12 )
      fprintf ( 1, '......................\n' );
    end
    seed = seed_out;
  end

end


% test for reducing the TV norm
name = 'lena';
n = 256;
M = load_image(name);
M = rescale(crop(M, n));

t = compute_total_variation(M);

tvtgt = t*.1;
niter = 400;

options.tvtgt = tvtgt;
options.niter = niter;
options.nrefresh = 200;
[Mtv,err,tv,lalist] = perform_tv_denoising(M,options);

L = 1/2*err.^2+lalist(end)*tv;
clf;
subplot(2,1,1);
plot(tv-tvtgt, '.-'); title('TV-TV_0'); axis tight;
subplot(2,1,2);
plot(L, '.-'); title('Lagrangian'); axis tight;


function polys = readPolygonSet(filename)
%READPOLYGONSET Read a set of simple polygons stored in a file.
%
%   POLY = readPolygonSet(FILENAME);
%   Returns the polygon stored in the file FILENAME.
%   Polygons are assumed to be stored in text files, without headers, with
%   x and y coordinates packed in two separate lines:
%     X11 X12 X13 ... X1N
%     Y11 Y12 Y13 ... Y1N
%     X21 X22 X23 ... X2N
%     Y21 Y22 Y23 ... Y2N
%
%   Each polygon may have a different number of vertices. The result is a
%   cell array of polygon, each cell containing a N-by-2 array representing
%   the vertex coordinates.
%
%   See also
%   polygons2d

% ------
% Author: David Legland
% E-mail: david.legland@inrae.fr
% Created: 2004-04-11
% Copyright 2004-2022 INRA - TPV URPOI - BIA IMASTE

% the set of polygons (no pre-allocation, as we do not know how many
% polygons are stored)
polys = {};

% index of polygon
p = 0;

% open file for reading
fid = fopen(filename, 'rt');

% use an infinite loop, terminated in case of EOF
while true
    % set of X, and Y coordinates
    line1 = fgetl(fid);
    line2 = fgetl(fid);

    % break loop if end of file is reached
    if line1 == -1
        break;
    end

    % create a new polygon by concatenating vertex coordinates
    p = p + 1;
    polys{p} = [str2num(line1)' str2num(line2)']; %#ok<AGROW,ST2NM>
end

% close file
fclose(fid);


function value = r4_round_i4 ( x )

%*****************************************************************************80
%
%% R4_ROUND_I4 rounds an R4 to the nearest integral value, returning an I4.
%
%  Discussion:
%
%    In MATLAB, it is essentially true that there is little difference between
%    this function and R4_ROUND, because we store our integers in what amounts
%    to a real variable.
%
%  Example:
%
%        X        R4_ROUND_I4
%
%      1.3         1
%      1.4         1
%      1.5         1 or 2
%      1.6         2
%      0.0         0
%     -0.7        -1
%     -1.1        -1
%     -1.6        -2
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    03 April 2013
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the value.
%
%    Output, integer R4_ROUND_I4, the rounded value.
%
  if ( x < 0.0 )
    value = - floor ( - x + 0.5 );
  else
    value =   floor ( + x + 0.5 );
  end

  return
end


function [ out ] = proj_box( x,l,u )
%PROJ_BOX computes the orthogonal projection onto the box {x:l<=x<=u}
%
%  Usage:
%  out = PROJ_BOX(x,l,u)
%  ===========================================
%  Input:
%  x - point to be projected (vector/matrix)
%  l - lower bound (vector/matrix/scalar)
%  u - upper bound (vector/matrix/scalar)
%  ===========================================
%  Assumptions:
%  l<=u
%  ===========================================
%  Output:
%  out - projection vector

% This file is part of the FOM package - a collection of first order methods for solving convex optimization problems
% Copyright (C) 2017 Amir and Nili Beck
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program.  If not, see <http://www.gnu.org/licenses/>.

%reading the user x and
if (nargin < 3)
    error ('usage: proj_box( x,l,u )') ;
end

if any(any((l > u)))
    error('Set is infeasible') ;
end

out= min(max(l,x),u) ;
end


function halton_test09 ( )

%*****************************************************************************80
%
%% TEST09 tests SPHERE_UNIT_HALTON_2D.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 January 2009
%
%  Author:
%
%    John Burkardt
%
  dim_num2 = 2;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST09\n' );
  fprintf ( 1, '  For the unit sphere in 2 dimensions (the circle):\n' );
  fprintf ( 1, '  HALTON generates "U1" points,\n' );
  fprintf ( 1, '  U1_TO_SPHERE_UNIT_2D samples the circle;\n' );

  dim_num = 1;
  halton_dim_num_set ( dim_num );
  n = 5;
  step = 0;
  halton_step_set ( step );
  seed(1:dim_num) = 0;
  halton_seed_set ( seed );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  DIM_NUM = %12d\n', dim_num );
  fprintf ( 1, '  N =    %12d\n', n );
  fprintf ( 1, '  STEP = %12d\n', step );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  A few sample values:\n' );
  fprintf ( 1, '\n' );

  for j = 1 : n
    u = halton ( );
    x = u1_to_sphere_unit_2d ( u );
    fprintf ( 1, '  ' );
    for i = 1 : dim_num2
      fprintf ( 1, '%6f  ', x(i) );
    end
    fprintf ( 1, '\n' );
  end

  n = 1000;
  step = 0;
  halton_step_set ( step );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  N =    %12d\n', n );
  fprintf ( 1, '  STEP = %12d\n', step );

  average(1:dim_num2) = 0.0;

  for i = 1 : n
    u = halton ( );
    x = u1_to_sphere_unit_2d ( u );
    average(1:dim_num) = average(1:dim_num) + x(1:dim_num);
  end

  average(1:dim_num2) = average(1:dim_num2) / n;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Average the points, which should get a value\n' );
  fprintf ( 1, '  close to zero, and closer as N increases.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Average:        ' );
  for i = 1 : dim_num2
    fprintf ( 1, '  %12f', average(i) );
  end
  fprintf ( 1, '\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Now choose a random direction, sample the same\n' );
  fprintf ( 1, '  number of points, and compute the dot product with\n' );
  fprintf ( 1, '  the direction.\n' );
  fprintf ( 1, '  Take the absolute value of each dot product\n' );
  fprintf ( 1, '  and sum and average.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  We expect a value near 2 / PI = 0.6366...\n' );

  for j2 = 1 : 5

    seed_val = get_seed ( );
    step = seed_val + 111 * j2;
    halton_step_set ( step );

    u = halton ( );
    v = u1_to_sphere_unit_2d ( u );

    step = 0;
    halton_step_set ( step );

    dot_average = 0.0;

    for j = 1 : n
      u = halton ( );
      x = u1_to_sphere_unit_2d ( u );
      dot_average = dot_average + abs ( x(1:dim_num2) * v(1:dim_num2)' );
    end

    dot_average = dot_average / n;

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Random V:         ' );
    for i = 1 : dim_num2
      fprintf ( 1, '  %12f', v(i) );
    end
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Average |(XdotV)| = %f\n', dot_average );

  end

  return
end


function vol=surfvolume(node,face,option)
%
% vol=surfvolume(node,face,option)
%
% calculate the enclosed volume for a closed surface
%
% author: Qianqian Fang, <q.fang at neu.edu>
%
% input:
%    node:  node coordinates
%    face:  surface triangle list
%
% output:
%    vol:   total volume of the enclosed space
%
% -- this function is part of iso2mesh toolbox (http://iso2mesh.sf.net)
%

face=face(:,1:3);

ed=surfedge(face);
if(~isempty(ed))
   error('open surface is detected, you have to close it first, consider meshcheckrepair() with meshfix option');
end

[no,el]=fillsurf(node,face);

vol=elemvolume(no,el);
vol=sum(vol);


function ball_grid_display ( ng, xy )

%*****************************************************************************80
%
%% BALL_GRID_DISPLAY displays grid points inside a ball.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    05 September 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NG, the number of grid points inside the ball.
%
%    Input, real XY(3,NG), the grid points.
%
  scatter3 ( xy(1,:), xy(2,:), xy(3,:), 'b.' );
  axis equal
  title ( sprintf ( '%d grid points inside a ball', ng ) )
  grid on

  return
end


function [ n_data, x, fx ] = i1ml1_values ( n_data )

%*****************************************************************************80
%
%% I1ML1_VALUES returns some values of the I1ML1 function.
%
%  Discussion:
%
%    The function is defined by:
%
%      I1ML1(x) = I1(x) - L1(x)
%
%    I1(x) is the modified Bessel function of the first kind of order 1,
%    L1(x) is the modified Struve function of order 1.
%
%    The data was reported by McLeod.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Allan McLeod,
%    Algorithm 757, MISCFUN: A software package to compute uncommon
%      special functions,
%    ACM Transactions on Mathematical Software,
%    Volume 22, Number 3, September 1996, pages 288-301.
%
%  Parameters:
%
%    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
%    first call.  On each call, the routine increments N_DATA by 1, and
%    returns the corresponding data; when there is no more data, the
%    output value of N_DATA will be 0 again.
%
%    Output, real X, the argument of the function.
%
%    Output, real FX, the value of the function.
%
  n_max = 20;

  fx_vec = [ ...
     0.97575346155386267134E-03, ...
     0.77609293280609272733E-02, ...
     0.59302966404545373770E-01, ...
     0.20395212276737365307E+00, ...
     0.33839472293667639038E+00, ...
     0.48787706726961324579E+00, ...
     0.59018734196576517506E+00, ...
     0.62604539530312149476E+00, ...
     0.63209315274909764698E+00, ...
     0.63410179313235359215E+00, ...
     0.63417966797578128188E+00, ...
     0.63439268632392089434E+00, ...
     0.63501579073257770690E+00, ...
     0.63559616677359459337E+00, ...
     0.63591001826697110312E+00, ...
     0.63622113181751073643E+00, ...
     0.63636481702133606597E+00, ...
     0.63650653499619902120E+00, ...
     0.63655609126300261851E+00, ...
     0.63657902087183929223E+00 ];

  x_vec = [ ...
       0.0019531250E+00, ...
       0.0156250000E+00, ...
       0.1250000000E+00, ...
       0.5000000000E+00, ...
       1.0000000000E+00, ...
       2.0000000000E+00, ...
       4.0000000000E+00, ...
       8.0000000000E+00, ...
      12.0000000000E+00, ...
      16.0000000000E+00, ...
      16.2500000000E+00, ...
      17.0000000000E+00, ...
      20.0000000000E+00, ...
      25.0000000000E+00, ...
      30.0000000000E+00, ...
      40.0000000000E+00, ...
      50.0000000000E+00, ...
      75.0000000000E+00, ...
     100.0000000000E+00, ...
     125.0000000000E+00 ];

  if ( n_data < 0 )
    n_data = 0;
  end

  n_data = n_data + 1;

  if ( n_max < n_data )
    n_data = 0;
    x = 0.0;
    fx = 0.0;
  else
    x = x_vec(n_data);
    fx = fx_vec(n_data);
  end

  return
end


function inter = learn_struct_dbn_reveal(seqs, ns, max_fan_in, penalty)
% LEARN_STRUCT_DBN_REVEAL Learn inter-slice adjacency matrix given fully observable discrete time series
% inter = learn_struct_dbn_reveal(seqs, node_sizes, max_fan_in, penalty)
%
% seqs{l}{i,t} = value of node i in slice t of time-series l.
%   If you have a single time series in an N*T array D, use
%      seqs = { num2cell(D) }.
%   If you have L time series, each of length T, in an N*T*L array D, use
%      seqs= cell(1,L); for l=1:L, seqs{l} = num2cell(D(:,:,l)); end
%   or, in vectorized form,
%      seqs = squeeze(num2cell(num2cell(D),[1 2]));
% Currently the data is assumed to be discrete (1,2,...)
%
% node_sizes(i) is the number of possible values for node i
% max_fan_in is the largest number of parents we allow per node (default: N)
% penalty is weight given to the complexity penalty (default: 0.5)
%  A penalty of 0.5 gives the BIC score.
%  A penalty of 0 gives the ML score.
%  Maximizing likelihood is equivalent to maximizing mutual information between parents and child.
%
% inter(i,j) = 1 iff node in slice t connects to node j in slice t+1
%
% The parent set for each node in slice 2 is computed by evaluating all subsets of nodes in slice 1,
% and picking the largest scoring one. This takes O(n^k) time per node, where n is the num. nodes
% per slice, and k <= n is the max fan in.
% Since all the nodes are observed, we do not need to use an inference engine.
% And since we are only learning the inter-slice matrix, we do not need to check for cycles.
%
% This algorithm is described in
% - "REVEAL: A general reverse engineering algorithm for inference of genetic network
%      architectures", Liang et al. PSB 1998
% - "Extended dependency analysis of large systems",
%       Roger Conant, Intl. J. General Systems, 1988, vol 14, pp 97-141
% - "Learning the structure of DBNs", Friedman, Murphy and Russell, UAI 1998.

n = length(ns);

if nargin < 3, max_fan_in = n; end
if nargin < 4, penalty = 0.5; end

inter = zeros(n,n);

if ~iscell(seqs)
  data{1} = seqs;
end

nseq = length(seqs);
nslices = 0;
data = cell(1, nseq);
for l=1:nseq
  nslices = nslices + size(seqs{l}, 2);
  data{l} = cell2num(seqs{l})'; % each row is a case
end
ndata = nslices - nseq; % subtract off the initial slice of each sequence

% We concatenate the sequences as in the following example.
% Let there be 2 sequences of lengths 4 and 5, with n nodes per slice,
% and let i be the target node.
% Then we construct following matrix D
%
% s{1}{1,1} ... s{1}{1,3}     s{2}{1,1} ... s{2}{1,4}
% ....
% s{1}{n,1} ... s{1}{n,3}     s{2}{n,1} ... s{2}{n,4}
% s{1}{i,2} ... s{1}{i,4}     s{2}{i,2} ... s{2}{i,5}
%
% D(1:n, i) is the i'th input and D(n+1, i) is the i'th output.
%
% We concatenate each sequence separately to avoid treating the transition
% from the end of one sequence to the beginning of another as a "normal" transition.

for i=1:n
  D = [];
  for l=1:nseq
    T = size(seqs{l}, 2);
    A = cell2num(seqs{l}(:, 1:T-1));
    B = cell2num(seqs{l}(i, 2:T));
    C = [A;B];
    D = [D C];
  end
  SS = subsets(1:n, max_fan_in, 1); % skip the empty set
  nSS = length(SS);
  bic_score = zeros(1, nSS);
  ll_score = zeros(1, nSS);
  target = n+1;
  ns2 = [ns ns(i)];
  for h=1:nSS
    ps = SS{h};
    dom = [ps target];
    counts = compute_counts(D(dom, :), ns2(dom));
    CPT = mk_stochastic(counts);
    [bic_score(h), ll_score(h)] = bic_score_family(counts, CPT, ndata);
  end
  if penalty == 0
    h = argmax(ll_score);
  else
    h = argmax(bic_score);
  end
  ps = SS{h};
  inter(ps, i) = 1;
end


function [ frames, indexes ] = vec2frames( vec, Nw, Ns, direction, window, padding )
% VEC2FRAMES Splits signal into overlapped frames using indexing.
%
%   B=vec2frames(A,M,N) creates a matrix B whose columns consist of
%   segments of length M, taken at every N samples along input vector A.
%
%   [B,R]=vec2frames(A,M,N,D,W,P) creates a matrix B whose columns
%   or rows, as specified by D, consist of segments of length M, taken
%   at every N samples along the input vector A and windowed using the
%   analysis window specified by W. The division of A into frames is
%   achieved using indexes returned in R as follows: B=A(R);
%
%   Summary
%
%           A is an input vector
%
%           M is a frame length (in samples)
%
%           N is a frame shift (in samples)
%
%           D specifies if the frames in B are rows or columns,
%             i.e., D = 'rows' or 'cols', respectively
%
%           W is an optional analysis window function to be applied to
%             each frame, given as a function handle, e.g., W = @hanning
%             or as a vector of window samples, e.g., W = hanning( M )
%
%           P specifies if last frame should be padded to full length,
%             or simply discarded, i.e., P = true or false, respectively
%
%           B is the output matrix of frames
%
%           R is a matrix of indexes used for framing, such that division
%             of A into frames is achieved as follows: B=A(R);
%
%   Examples
%
%           % divide the input vector into seven-sample-long frames with a shift
%           % of three samples and return frames as columns of the output matrix
%           % (note that the last sample of the input vector is discarded)
%           vec2frames( [1:20], 7, 3 )
%
%           % divide the input vector into seven-sample-long frames with a shift
%           % of three samples and return frames as rows of the output matrix
%           % (note that the last sample of the input vector is discarded)
%           vec2frames( [1:20], 7, 3, 'rows' )
%
%           % divide the input vector into seven-sample-long frames with a shift
%           % of three samples, pad the last frame with zeros so that no samples
%           % are discarded and return frames as rows of the output matrix
%           vec2frames( [1:20], 7, 3, 'rows', [], true )
%
%           % divide the input vector into seven-sample-long frames with a shift
%           % of three samples, pad the last frame with white Gaussian noise
%           % of variance (1E-5)^2 so that no samples are discarded and
%           % return frames as rows of the output matrix
%           vec2frames( [1:20], 7, 3, 'rows', false, { 'noise', 1E-5 } )
%
%           % divide the input vector into seven-sample-long frames with a shift
%           % of three samples, pad the last frame with zeros so that no samples
%           % are discarded, apply the Hanning analysis window to each frame and
%           % return frames as columns of the output matrix
%           vec2frames( [1:20], 7, 3, 'cols', @hanning, 0 )
%
%   See also FRAMES2VEC, DEMO

%   Author: Kamil Wojcicki, UTD, July 2011

    % usage information
    usage = 'usage: [ frames, indexes ] = vec2frames( vector, frame_length, frame_shift, direction, window, padding );';

    % default settings
    switch( nargin )
    case { 0, 1, 2 }, error( usage );
    case 3, padding=false; window=false; direction='cols';
    case 4, padding=false; window=false;
    case 5, padding=false;
    end

    % input validation
    if( isempty(vec) || isempty(Nw) || isempty(Ns) ), error( usage ); end;
    if( min(size(vec))~=1 ), error( usage ); end;
    if( Nw==0 || Ns==0 ), error( usage ); end;

    vec = vec(:);                       % ensure column vector

    L = length( vec );                  % length of the input vector
    M = floor((L-Nw)/Ns+1);             % number of frames

    % perform signal padding to enable exact division of signal samples into frames
    % (note that if padding is disabled, some samples may be discarded)
    if( ~isempty(padding) )

        % figure out if the input vector can be divided into frames exactly
        E = (L-((M-1)*Ns+Nw));

        % see if padding is actually needed
        if( E>0 )

            % how much padding will be needed to complete the last frame?
            P = Nw-E;

            % pad with zeros
            if( islogical(padding) && padding )
                vec = [ vec; zeros(P,1) ];

            % pad with a specific numeric constant
            elseif( isnumeric(padding) && length(padding)==1 )
                vec = [ vec; padding*ones(P,1) ];

            % pad with a low variance white Gaussian noise
            elseif( isstr(padding) && strcmp(padding,'noise') )
                vec = [ vec; 1E-6*randn(P,1) ];

            % pad with a specific variance white Gaussian noise
            elseif( iscell(padding) && strcmp(padding{1},'noise') )
                if( length(padding)>1 ), scale = padding{2};
                else, scale = 1E-6; end;
                vec = [ vec; scale*randn(P,1) ];

            % if not padding required, decrement frame count
            % (not a very elegant solution)
            else
                M = M-1;

            end

            % increment the frame count
            M = M+1;
        end
    end

    % compute index matrix
    switch( direction )

    case 'rows'                                                 % for frames as rows
        indf = Ns*[ 0:(M-1) ].';                                % indexes for frames
        inds = [ 1:Nw ];                                        % indexes for samples
        indexes = indf(:,ones(1,Nw)) + inds(ones(M,1),:);       % combined framing indexes

    case 'cols'                                                 % for frames as columns
        indf = Ns*[ 0:(M-1) ];                                  % indexes for frames
        inds = [ 1:Nw ].';                                      % indexes for samples
        indexes = indf(ones(Nw,1),:) + inds(:,ones(1,M));       % combined framing indexes

    otherwise
        error( sprintf('Direction: %s not supported!\n', direction) );

    end

    % divide the input signal into frames using indexing
    frames = vec( indexes );

    % return if custom analysis windowing was not requested
    if( isempty(window) || ( islogical(window) && ~window ) ), return; end;

    % if analysis window function handle was specified, generate window samples
    if( isa(window,'function_handle') )
        window = window( Nw );
    end

    % make sure analysis window is numeric and of correct length, otherwise return
    if( isnumeric(window) && length(window)==Nw )

        % apply analysis windowing beyond the implicit rectangular window function
        switch( direction )
        case 'rows', frames = frames * diag( window );
        case 'cols', frames = diag( window ) * frames;
        end

    end

% EOF


function [label, model, L] = mixGaussVb(X, m, prior)
% Variational Bayesian inference for Gaussian mixture.
% Input:
%   X: d x n data matrix
%   m: k (1 x 1) or label (1 x n, 1<=label(i)<=k) or model structure
% Output:
%   label: 1 x n cluster label
%   model: trained model structure
%   L: variational lower bound
% Reference: Pattern Recognition and Machine Learning by Christopher M. Bishop (P.474)
% Written by Mo Chen (sth4nth@gmail.com).
fprintf('Variational Bayesian Gaussian mixture: running ... \n');
[d,n] = size(X);
if nargin < 3
    prior.alpha = 1;
    prior.kappa = 1;
    prior.m = mean(X,2);
    prior.v = d+1;
    prior.M = eye(d);   % M = inv(W)
end
prior.logW = -2*sum(log(diag(chol(prior.M))));

tol = 1e-8;
maxiter = 2000;
L = -inf(1,maxiter);
model = init(X,m,prior);
for iter = 2:maxiter
    model = expect(X,model);
    model = maximize(X,model,prior);
    L(iter) = bound(X,model,prior);
    if abs(L(iter)-L(iter-1)) < tol*abs(L(iter)); break; end
end
L = L(2:iter);
label = zeros(1,n);
[~,label(:)] = max(model.R,[],2);
[~,~,label(:)] = unique(label);

function model = init(X, m, prior)
n = size(X,2);
if isstruct(m)  % init with a model
    model = m;
elseif numel(m) == 1  % random init k
    k = m;
    label = ceil(k*rand(1,n));
    model.R = full(sparse(1:n,label,1,n,k,n));
elseif all(size(m)==[1,n])  % init with labels
    label = m;
    k = max(label);
    model.R = full(sparse(1:n,label,1,n,k,n));
else
    error('ERROR: init is not valid.');
end
model = maximize(X,model,prior);

% Done
function model = maximize(X, model, prior)
alpha0 = prior.alpha;
kappa0 = prior.kappa;
m0 = prior.m;
v0 = prior.v;
M0 = prior.M;
R = model.R;

nk = sum(R,1); % 10.51
alpha = alpha0+nk; % 10.58
kappa = kappa0+nk; % 10.60
v = v0+nk; % 10.63
m = bsxfun(@plus,kappa0*m0,X*R);
m = bsxfun(@times,m,1./kappa); % 10.61

[d,k] = size(m);
U = zeros(d,d,k);
logW = zeros(1,k);
r = sqrt(R');
for i = 1:k
    Xm = bsxfun(@minus,X,m(:,i));
    Xm = bsxfun(@times,Xm,r(i,:));
    m0m = m0-m(:,i);
    M = M0+Xm*Xm'+kappa0*(m0m*m0m');     % equivalent to 10.62
    U(:,:,i) = chol(M);
    logW(i) = -2*sum(log(diag(U(:,:,i))));
end

model.alpha = alpha;
model.kappa = kappa;
model.m = m;
model.v = v;
model.U = U;
model.logW = logW;

% Done
function model = expect(X, model)
alpha = model.alpha; % Dirichlet
kappa = model.kappa;   % Gaussian
m = model.m;         % Gasusian
v = model.v;         % Whishart
U = model.U;         % Whishart
logW = model.logW;
n = size(X,2);
[d,k] = size(m);

EQ = zeros(n,k);
for i = 1:k
    Q = (U(:,:,i)'\bsxfun(@minus,X,m(:,i)));
    EQ(:,i) = d/kappa(i)+v(i)*dot(Q,Q,1);    % 10.64
end
ElogLambda = sum(psi(0,0.5*bsxfun(@minus,v+1,(1:d)')),1)+d*log(2)+logW; % 10.65
Elogpi = psi(0,alpha)-psi(0,sum(alpha)); % 10.66
logRho = -0.5*bsxfun(@minus,EQ,ElogLambda-d*log(2*pi)); % 10.46
logRho = bsxfun(@plus,logRho,Elogpi);   % 10.46
logR = bsxfun(@minus,logRho,logsumexp(logRho,2)); % 10.49
R = exp(logR);

model.logR = logR;
model.R = R;

% Done
function L = bound(X, model, prior)
alpha0 = prior.alpha;
kappa0 = prior.kappa;
v0 = prior.v;
logW0 = prior.logW;
alpha = model.alpha;
kappa = model.kappa;
v = model.v;
logW = model.logW;
R = model.R;
logR = model.logR;
[d,n] = size(X);
k = size(R,2);

Epz = 0;
Eqz = dot(R(:),logR(:));
logCalpha0 = gammaln(k*alpha0)-k*gammaln(alpha0);
Eppi = logCalpha0;
logCalpha = gammaln(sum(alpha))-sum(gammaln(alpha));
Eqpi = logCalpha;
Epmu = 0.5*d*k*log(kappa0);
Eqmu = 0.5*d*sum(log(kappa));
logB0 = -0.5*v0*(logW0+d*log(2))-logMvGamma(0.5*v0,d);
EpLambda = k*logB0;
logB =  -0.5*v.*(logW+d*log(2))-logMvGamma(0.5*v,d);
EqLambda = sum(logB);
EpX = -0.5*d*n*log(2*pi);
L = Epz-Eqz+Eppi-Eqpi+Epmu-Eqmu+EpLambda-EqLambda+EpX;


function y = s2y(s);

% Y = s2y(S)
%
% Scattering to Admittance transformation
%
% y = (I-s) * inv(I+s)
%
% for square matrices at multiple frequencies
%
% 27.09.2002

I = diag(ones(1, size(s,2)));

for i=1:size(s,3)
   y(:,:,i) = (I-s(:,:,i)) * inv(I+s(:,:,i));
end;


function [Q, R] = stiefelgeneralized_retraction_MGS(B, X, U, t)
% Retraction for generalized Stiefel based on Modified Gram-Schmidt.
% When used just as a retraction, only the output Q is relevant.
% NB, Dec. 16, 2018.
    if ~exist('t', 'var') || isempty(t)
        A = X + U;   % t = 1 by default
    else
        A = X + t*U;
    end
    [n, p] = size(X);
    Q = zeros(n, p);
    R = zeros(p, p);
    for j = 1 : p
        v = A(:, j);
        R(j, j) = sqrt(v'*B*v);
        Q(:, j) = v / R(j, j);
        R(j, (j+1):p) = Q(:, j)' * B * A(:, (j+1):p);
        A(:, (j+1):p) = A(:, (j+1):p) - Q(:, j) * R(j, (j+1):p);
    end
end


function randi_test ( )

%*****************************************************************************80
%
%% RANDI_TEST shows how random integers are generated in MATLAB.
%
%  Discussion:
%
%    The RANDI function is meant to replace MATLAB's previous function
%    for computing random integers, called RANDINT().
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2013
%
%  Author:
%
%    John Burkardt
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'RANDI_TEST:\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '  Test the MATLAB RANDI function.\n' );

  randi_test01 ( );

  randi_test02 ( );

  seed = 123456789;
  randi_test03 ( seed );

  seed = 987654321;
  randi_test03 ( seed );

  seed = 123456789;
  randi_test03 ( seed );
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'RANDI_TEST:\n' );
  fprintf ( 1, '  Normal end of execution.\n' );

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

  return
end
function randi_test01 ( )

%*****************************************************************************80
%
%% RANDI_TEST01 simply calls the random integer generator a few times.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2013
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'RANDI_TEST01:\n' );
  fprintf ( 1, '  In MATLAB, random integers are generated by calling RANDI:\n' );
  fprintf ( 1, '  The maximum value is specified as IMAX.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  A = randi ( imax, 1 ) a random scalar value between 1 and IMAX.\n' );
  fprintf ( 1, '  B = randi ( imax, 5, 1 ) a random column vector of 5 entries.\n' );
  fprintf ( 1, '  C = randi ( imax, 1, 5 ) a random row vector of 5 entries.\n' );
  fprintf ( 1, '  D = randi ( imax, 3, 4 ) a 3 by 4 random matrix.\n' );
  fprintf ( 1, '  E = randi ( imax, 5 )    a 5 by 5 random matrix.\n' );

  a = randi ( 9, 1 )
  b = randi ( 9, 5, 1 )
  c = randi ( 9, 1, 5 )
  d = randi ( 4, 3, 4 )
  e = randi ( 4, 5 )

  return
end
function randi_test02 ( )

%*****************************************************************************80
%
%% RANDI_TEST02 specifies the lower and upper limits.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2013
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'RANDI_TEST02:\n' );
  fprintf ( 1, '  RANDI allows the user to specify the numeric range.\n' );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  A = randi ( [ 5,    10 ],  1, 1 ) a random scalar value.\n' );
  fprintf ( 1, '  B = randi ( [ 7,     8 ], 10, 1 ) a random column vector of 5 entries.\n' );
  fprintf ( 1, '  C = randi ( [ -1,   +1 ],  1, 5 ) a random row vector of 5 entries.\n' );
  fprintf ( 1, '  D = randi ( [ -5,   +5 ],  3, 4 ) a 3 by 4 random matrix.\n' );
  fprintf ( 1, '  E = randi ( [ 100, 200 ],  5, 5 ) a 5 by 5 random matrix.\n' );

  a = randi ( [   5,  10 ], 1, 1 )
  b = randi ( [   7,   8 ], 10, 1 )
  c = randi ( [  -1,  +1 ], 1, 5 )
  d = randi ( [  -5,  +5 ], 3, 4 )
  e = randi ( [ 100, 200 ], 5, 5 )

  return
end
function randi_test03 ( seed )

%*****************************************************************************80
%
%% RANDI_TEST03 sets the seed before calling RANDI.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    13 February 2013
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'RANDI_TEST03:\n' );
  fprintf ( 1, '  By setting the random number seed, you can control\n' );
  fprintf ( 1, '  how the random number sequence begins.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The command "rng ( 123456789 )" sets the seed to 123456789.\n' );

  rng ( seed );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Seed has been set to %d\n', seed );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Now generate 5 random values.\n' );

  for i = 1 : 5
    a = randi (  [ 1, 100 ], 1, 1 );
    fprintf ( 1, '  RANDI([1,100],1,1) = %g\n', a );
  end

  rng ( seed );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Seed has been reset to %d\n', seed );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Now generate 5 more random values.\n' );

  for i = 1 : 5
    a = randi ( [ 1, 100 ], 1, 1 );
    fprintf ( 1, '  RANDI([1,100],1,1) = %g\n', a );
  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 [G] = uGal2G(uGal)
% Convert acceleration from microgals to average acceleration due to
% Earth's gravity.
% Chad A. Greene 2012
G = uGal/(9.80665e+8);
end


function n = nfold(cs,axis)
% maximal n-fold of symmetry axes

if nargin == 1
  switch cs.LaueName
    case {'112/m','2/m11','12/m1','mmm'}
      n = 2;
    case {'m-3','-3','-3m1','-31m'}
      n = 3;
    case {'4/m','4/mmm','m-3m'}
      n = 4;
    case {'6/m','6/mmm'}
      n = 6;
    otherwise
      n = 1;
  end
else
  axis = vector3d(axis);
  n = ones(size(axis));
  for i = 1:length(axis)
    ind = isnull(angle(cs.rot.axis,axis(i))) & cs.rot.angle>0;
    if any(ind(:))
      n(i) = 2*pi / min(cs.rot(ind).angle);
    end
  end

end


function [u,Du,eqn,info] = PoissonP3(node,elem,pde,bdFlag,option)
%% POISSONP2 Poisson equation: P3 quadratic element.
%
% u = PoissonP3(node,elem,pde,bdFlag,option) produces the cubic
%   finite element approximation of the Poisson equation
%
%       -div(d*grad(u))=f  in \Omega, with
%       Dirichlet boundary condition u=g_D on \Gamma_D,
%       Neumann boundary condition   d*grad(u)*n=g_N on \Gamma_N,
%       Robin boundary condition     g_R*u + d*grad(u)*n=g_N on \Gamma _R
%
% [u,Du,eqn,info] = PoissonP3(node,elem,pde,bdFlag,option)
%
% The usage is the same as Poisson. For quadratic elements, middle points
% of each edge are degree of freedom. See dofP2doc for detail.
%
% Example
%   femrateP2
%
% See also Poisson, Poisson3, Poisson3P2,PoissonP2
% Created by Jie Zhou
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

if ~exist('option','var'), option = []; end

tic;
%% Construct Data Structure
[elem2dof,elem2edge,edge,bdDof]  = dofP3(elem);
N = size(node,1);  NT = size(elem,1); NE = size(edge,1);
Ndof = N + 2*NE + NT;

%% Compute geometric quantities and gradient of local basis
[Dlambda,area] = gradbasis(node,elem);

%% Assemble stiffness matrix
% Since Dphi_i*Dphi_j is four degree, so four order numerical quadrature rule is used here
if ~isfield(pde,'d'), pde.d = []; end
if ~isfield(option,'quadorder')
    option.quadorder = 5;   % default order 2(p-1)+1
end
[lambda, w] = quadpts(option.quadorder);
nQuad = size(lambda,1);
ii = zeros(55*NT,1); jj = zeros(55*NT,1); sA = zeros(55*NT,nQuad);
% generate sparse pattern
index = 0;
for i = 1:10
    for j = i:10
        ii(index+1:index+NT) = double(elem2dof(:,i));
        jj(index+1:index+NT) = double(elem2dof(:,j));
        index = index + NT;
    end
end
% compute non-zeros
for p = 1:nQuad
    % Dphi at quadrature points
    Dphip(:,:,1) = (27/2*lambda(p,1)*lambda(p,1)-9*lambda(p,1)+1).*Dlambda(:,:,1);
    Dphip(:,:,2) = (27/2*lambda(p,2)*lambda(p,2)-9*lambda(p,2)+1).*Dlambda(:,:,2);
    Dphip(:,:,3) = (27/2*lambda(p,3)*lambda(p,3)-9*lambda(p,3)+1).*Dlambda(:,:,3);
    Dphip(:,:,4) = 9/2*((3*lambda(p,2)*lambda(p,2)-lambda(p,2)).*Dlambda(:,:,3)+...
                   lambda(p,3)*(6*lambda(p,2)-1).*Dlambda(:,:,2));
    Dphip(:,:,5) = 9/2*((3*lambda(p,3)*lambda(p,3)-lambda(p,3)).*Dlambda(:,:,2)+...
                   lambda(p,2)*(6*lambda(p,3)-1).*Dlambda(:,:,3));
    Dphip(:,:,6) = 9/2*((3*lambda(p,3)*lambda(p,3)-lambda(p,3)).*Dlambda(:,:,1)+...
                   lambda(p,1)*(6*lambda(p,3)-1).*Dlambda(:,:,3));
    Dphip(:,:,7) = 9/2*((3*lambda(p,1)*lambda(p,1)-lambda(p,1)).*Dlambda(:,:,3)+...
                   lambda(p,3)*(6*lambda(p,1)-1).*Dlambda(:,:,1));
    Dphip(:,:,8) = 9/2*((3*lambda(p,1)*lambda(p,1)-lambda(p,1)).*Dlambda(:,:,2)+...
                   lambda(p,2)*(6*lambda(p,1)-1).*Dlambda(:,:,1));
    Dphip(:,:,9)  = 9/2*((3*lambda(p,2)*lambda(p,2)-lambda(p,2)).*Dlambda(:,:,1)+...
                   lambda(p,1)*(6*lambda(p,2)-1).*Dlambda(:,:,2));
    Dphip(:,:,10) = 27*(lambda(p,1)*lambda(p,2)*Dlambda(:,:,3)+lambda(p,1)*lambda(p,3)*Dlambda(:,:,2)+...
                   lambda(p,3)*lambda(p,2)*Dlambda(:,:,1));
    index = 0;
    for i = 1:10
        for j = i:10
            Aij = 0;
            if isempty(pde.d) || isnumeric(pde.d)
                Aij = Aij + w(p)*dot(Dphip(:,:,i),Dphip(:,:,j),2);
            else
                pxy = lambda(p,1)*node(elem(:,1),:) ...
                    + lambda(p,2)*node(elem(:,2),:) ...
                    + lambda(p,3)*node(elem(:,3),:);
                Aij = Aij + w(p)*dot(Dphip(:,:,i),Dphip(:,:,j),2).*pde.d(pxy);
            end
             if ~isempty(pde.d) && isnumeric(pde.d) % d is piecewise constant
                 Aij = pde.d.*Aij;
             end
            Aij = Aij.*area;
            sA(index+1:index+NT,p) = Aij;
            index = index + NT;
        end
    end
end
sA = sum(sA,2);
diagIdx = (ii == jj);   upperIdx = ~diagIdx;
A = sparse(ii(diagIdx),jj(diagIdx),sA(diagIdx),Ndof,Ndof);
AU = sparse(ii(upperIdx),jj(upperIdx),sA(upperIdx),Ndof,Ndof);
A = A + AU + AU';
clear Aij ii jj sA

%% Assemble right hand side by high order quadrature rule
b = zeros(Ndof,1);
if ~isfield(option,'fquadorder')
    option.fquadorder = 6;   % default order
end
if ~isfield(pde,'f') || (isreal(pde.f) && (pde.f==0))
    pde.f = [];
end
if ~isempty(pde.f)
    % quadrature points in the barycentric coordinate
    [lambda,w] = quadpts(option.fquadorder);
    nQuad = size(lambda,1);
    phi(:,1) = 0.5*(3*lambda(:,1)-1).*(3*lambda(:,1)-2).*lambda(:,1);
    phi(:,2) = 0.5*(3*lambda(:,2)-1).*(3*lambda(:,2)-2).*lambda(:,2);
    phi(:,3) = 0.5*(3*lambda(:,3)-1).*(3*lambda(:,3)-2).*lambda(:,3);
    phi(:,4) = 9/2*lambda(:,3).*lambda(:,2).*(3*lambda(:,2)-1);
    phi(:,5) = 9/2*lambda(:,3).*lambda(:,2).*(3*lambda(:,3)-1);
    phi(:,6) = 9/2*lambda(:,1).*lambda(:,3).*(3*lambda(:,3)-1);
    phi(:,7) = 9/2*lambda(:,1).*lambda(:,3).*(3*lambda(:,1)-1);
    phi(:,8) = 9/2*lambda(:,1).*lambda(:,2).*(3*lambda(:,1)-1);
    phi(:,9) = 9/2*lambda(:,1).*lambda(:,2).*(3*lambda(:,2)-1);
    phi(:,10) = 27*lambda(:,1).*lambda(:,2).*lambda(:,3);

    bt = zeros(NT,10);
    for p = 1:nQuad
        % quadrature points in the x-y coordinate
        pxy = lambda(p,1)*node(elem(:,1),:) ...
            + lambda(p,2)*node(elem(:,2),:) ...
            + lambda(p,3)*node(elem(:,3),:);
        if isfield(pde,'f') && isnumeric(pde.f)
            fp = pde.f;        % piecewise constant
        else
            fp = pde.f(pxy);   % function handle
        end
        for j = 1:10
            bt(:,j) = bt(:,j) + w(p)*phi(p,j)*fp;
        end
    end
    bt = bt.*repmat(area,1,10);
    b = accumarray(elem2dof(:),bt(:),[Ndof 1]);
end

%% Boundary Conditions
if nargin<=3, bdFlag = []; end
[AD,b,u,freeDof,isPureNeumann] = getbdP3(b);

%% Record assembeling time
assembleTime = toc;
if ~isfield(option,'printlevel'), option.printlevel = 1; end
if option.printlevel >= 2
    fprintf('Time to assemble matrix equation %4.2g s\n',assembleTime);
end

%% Solve the system of linear equations
if isempty(freeDof), return; end
% Set up solver
if isempty(option) || ~isfield(option,'solver')    % no option.solver
    if Ndof <= 2e3  % Direct solver for small size systems
        option.solver = 'direct';
    else            % Multigrid-type  solver for large size systems
        option.solver = 'mg';
    end
end

solver = option.solver;
% solve
switch solver
    case 'direct'
        tic;
        u(freeDof) = AD(freeDof,freeDof)\b(freeDof);
        residual = norm(b - AD*u);
        info = struct('solverTime',toc,'itStep',0,'err',residual,'flag',2,'stopErr',residual);
    case 'none'
        info = struct('solverTime',[],'itStep',0,'err',[],'flag',3,'stopErr',[]);
    case 'mg'
        option.x0 = u;
        option.solver = 'CG';
        option.tol = Ndof^(-2);
        [u,info] = mg(AD,b,elem,option,edge);
    case 'amg'
        option.solver = 'CG';
        option.tol = Ndof^(-2);
        [u(freeDof),info] = amg(AD(freeDof,freeDof),b(freeDof),option);
end
clear phi lambda
% post-process for pure Neumann problem
if isPureNeumann
    intguh = double(sparse(NT,1));
    [lambda,w] = quadpts(3);  %This is P3 element.
    nQuad = size(lambda,1);
    phi(:,1) = 0.5*(3*lambda(:,1)-1).*(3*lambda(:,1)-2).*lambda(:,1);
    phi(:,2) = 0.5*(3*lambda(:,2)-1).*(3*lambda(:,2)-2).*lambda(:,2);
    phi(:,3) = 0.5*(3*lambda(:,3)-1).*(3*lambda(:,3)-2).*lambda(:,3);
    phi(:,4) = 9/2*lambda(:,3).*lambda(:,2).*(3*lambda(:,2)-1);
    phi(:,5) = 9/2*lambda(:,3).*lambda(:,2).*(3*lambda(:,3)-1);
    phi(:,6) = 9/2*lambda(:,1).*lambda(:,3).*(3*lambda(:,3)-1);
    phi(:,7) = 9/2*lambda(:,1).*lambda(:,3).*(3*lambda(:,1)-1);
    phi(:,8) = 9/2*lambda(:,1).*lambda(:,2).*(3*lambda(:,1)-1);
    phi(:,9) = 9/2*lambda(:,1).*lambda(:,2).*(3*lambda(:,2)-1);
    phi(:,10) = 27*lambda(:,1).*lambda(:,2).*lambda(:,3);
     for     p = 1:nQuad
     intguh(:) = intguh(:) + w(p)*(phi(p,1)*u(elem2dof(:,1))+phi(p,2)*u(elem2dof(:,2))+phi(p,3)*u(elem2dof(:,3))...
                           + phi(p,4)*u(elem2dof(:,4))+phi(p,5)*u(elem2dof(:,5))+phi(p,6)*u(elem2dof(:,6))...
                           + phi(p,7)*u(elem2dof(:,7))+phi(p,8)*u(elem2dof(:,8))+phi(p,9)*u(elem2dof(:,9))...
                           + phi(p,10)*u(elem2dof(:,10)));
     end                 %compute the intgrable of uh.
     intguh = intguh.*area;
         uc = sum(intguh)/sum(area);
          u = u - uc;    % normalization for pure Neumann problem
end

% Output information
eqn = struct('A',AD,'b',b,'edge',edge,'freeDof',freeDof);
info.assembleTime = assembleTime;

%% Compute Du
Du = [];
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% subfunctions getbdP3
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    function [AD,b,u,freeDof,isPureNeumann] = getbdP3(b)
    %% Boundary conditions for Poisson equation: P3 quadratic FEM.
    %
    % The set up of boundary condition consists of two parts:
    %
    % 1) Modify the matrix for Dirichlet boundary nodes, which are not degree
    % of freedom. Values at these nodes are evaluatation of pde.g_D. The
    % original stiffness matrix A is turn into the matrix AD by enforcing
    % AD(fixedDof,fixedDof)=I, AD(fixedDof,freeDof)=0, AD(freeDof,fixedDof)=0.
    %
    % 2) Modify the right hand side b. The Neumann boundary integral is added
    % to b. For Dirichlet boundary ndoes, b(fixedDof) is the evaluation of
    % pde.g_D.
    %
    % Special attentation should be given for the pure Neumann boundary
    % condition. To enforce the compatible condition, the vector b should have
    % mean value zero. To avoid a singular matrix, the 1st node is chosen as
    % fixedDof.
    %
    % The order of assigning Neumann and Dirichlet boundary condition is
    % important to get the right setting at the intersection nodes of Dirichlet
    % and Neumann boundary edges.

    u = zeros(Ndof,1);

    %% Set up boundary and basic parameter
    if ~isfield(pde,'g_D'), pde.g_D = []; end
    if ~isfield(pde,'g_N'), pde.g_N = []; end
    if ~isfield(pde,'g_R'), pde.g_R = []; end

    %% Part 1: Modify the matrix for Dirichlet and Robin condition
    % Robin boundary condition
    Robin = [];
    idxR = (bdFlag(:) == 3);      %index of Robin edges in bdFlag
    if any(idxR)
        isRobin = false(NE,1);
        isRobin(elem2edge(idxR)) = true;
        Robin = edge(isRobin,:);  % Robin edges
    end
    if ~isempty(Robin) && ~isempty(pde.g_R) && ~(isnumeric(pde.g_R) && (pde.g_R == 0))
        if ~isfield(option,'gRquadorder')
            option.gRquadorder = 8;   % we should use six order  rule.
        end
        [lambdagR,weightgR] = quadpts1(option.gRquadorder);
        nQuadgR = size(lambdagR,1);
        % cubic bases (1--3--4--2)
        bdphi = zeros(nQuadgR,4);
        bdphi(:,1) = 0.5*(3*lambdagR(:,1)-1).*(3*lambdagR(:,1)-2).*lambdagR(:,1);
        bdphi(:,2) = 0.5*(3*lambdagR(:,2)-1).*(3*lambdagR(:,2)-2).*lambdagR(:,2);
        bdphi(:,3) = 9/2*lambdagR(:,1).*lambdagR(:,2).*(3*lambdagR(:,1)-1);
        bdphi(:,4) = 9/2*lambdagR(:,1).*lambdagR(:,2).*(3*lambdagR(:,2)-1);
        % length of edge
        el = sqrt(sum((node(Robin(:,1),:) - node(Robin(:,2),:)).^2,2));
        NR = size(Robin,1);
        ss = zeros(NR,4,4);
        for pp = 1:nQuadgR
            ppxy = lambdagR(pp,1)*node(Robin(:,1),:) ...
                 + lambdagR(pp,2)*node(Robin(:,2),:);
            gRp = pde.g_R(ppxy);
            for iR = 1:4
                for jR = iR:4   % only compute half of the off-diagonal part
                    ss(:,iR,jR) = ss(:,iR,jR) + ...
                    weightgR(pp)*gRp*bdphi(pp,iR).*bdphi(pp,jR);
                end
            end
        end
        ss(:) = ss(:).*repmat(el,16,1);
        Robin(:,3) = 2*find(isRobin)+N-1;  % the third one maps to corresponding dof
        Robin(:,4) = 2*find(isRobin)+N;    % the fourth one maps to corresponding dof
        index = 0;
        for iR = 1:4
            for jR = 1:4
                iiR(index+1:index+NR) = double(Robin(:,iR));
                jjR(index+1:index+NR) = double(Robin(:,jR));
                if jR>=iR
                    ssR(index+1:index+NR) = ss(:,iR,jR);
                else
                    ssR(index+1:index+NR) = ss(:,jR,iR);
                end
                index = index + NR;
            end
        end
        A = A + sparse(iiR,jjR,ssR,Ndof,Ndof);
    end

    % Find Dirichlet boundary dof: fixedDof
    fixedDof = []; freeDof = [];
    isFixedDof = false(Ndof,1);
    if ~isempty(bdFlag)
        isDirichlet(elem2edge(bdFlag(:)==1)) = true;
        isFixedDof(edge(isDirichlet,:)) = true;
        isFixedDof(N + 2*find(isDirichlet')-1) = true;
        isFixedDof(N + 2*find(isDirichlet')) = true;
        fixedDof = find(isFixedDof);
        freeDof = find(~isFixedDof);
    end
    if isempty(bdFlag) && ~isempty(pde.g_D) && isempty(pde.g_N) && isempty(pde.g_R)
        fixedDof = bdDof;
        isFixedDof(fixedDof) = true;
        freeDof = find(~isFixedDof);
    end
    isPureNeumann = false;
    if isempty(fixedDof) && isempty(Robin)  % pure Neumann boundary condition
        % pde.g_N could be empty which is homogenous Neumann boundary condition
        isPureNeumann = true;
        fixedDof = 1;
        freeDof = 2:Ndof;    % eliminate the kernel by enforcing u(1) = 0;
    end
    % Modify the matrix
    % Build Dirichlet boundary condition into the matrix AD by enforcing
    % |AD(fixedDof,fixedDof)=I, AD(fixedDof,freeDof)=0,
    % AD(freeDof,fixedDof)=0|.
    if ~isempty(fixedDof)
        bdidx = zeros(Ndof,1);
        bdidx(fixedDof) = 1;
        Tbd = sparse(1:Ndof,1:Ndof,bdidx,Ndof,Ndof);
        T = sparse(1:Ndof,1:Ndof,1-bdidx,Ndof,Ndof);
        AD = T*A*T + Tbd;
    else
        AD = A;
    end

    %% Part 2: Find boundary edges and modify the load b
    % Find boundary edges: Neumann and Robin
    Neumann = [];
    if ~isempty(bdFlag)
        idxN = (bdFlag(:) == 2);      % all Neumann edges in bdFlag
        Neumannidx = elem2edge(idxN | idxR); % index of Neumann and Robin edges
        % since boundary integral is also needed for Robin edges
        Neumann   = edge(Neumannidx,:);
    end
    if isempty(bdFlag) && (~isempty(pde.g_N) || ~isempty(pde.g_R))
        % no bdFlag, only pde.g_N or pde.g_R is given in the input
        Neumannidx = find(bdDof>N);
        Neumann = edge(Neumannidx,:);
    end

    % Neumann boundary condition
    if ~isempty(pde.g_N) && ~isempty(Neumann) && ~(isnumeric(pde.g_N) && (pde.g_N == 0))
        if ~isfield(option,'gNquadorder')
            option.gNquadorder = 6;
        end
        [lambdagN,weightgN] = quadpts1(option.gNquadorder);
        nQuadgN = size(lambdagN,1);
        % quadratic bases (1---3---4--2)
        bdphi = zeros(nQuadgN,4);
        bdphi(:,1) = 0.5*(3*lambdagN(:,1)-1).*(3*lambdagN(:,1)-2).*lambdagN(:,1);
        bdphi(:,2) = 0.5*(3*lambdagN(:,2)-1).*(3*lambdagN(:,2)-2).*lambdagN(:,2);
        bdphi(:,3) = 9/2*lambdagN(:,1).*lambdagN(:,2).*(3*lambdagN(:,1)-1);
        bdphi(:,4) = 9/2*lambdagN(:,1).*lambdagN(:,2).*(3*lambdagN(:,2)-1);
        % length of edge
        el = sqrt(sum((node(Neumann(:,1),:) - node(Neumann(:,2),:)).^2,2));
        ge = zeros(size(Neumann,1),4);
        for pp = 1:nQuadgN
            ppxy = lambdagN(pp,1)*node(Neumann(:,1),:) ...
                 + lambdagN(pp,2)*node(Neumann(:,2),:);
            gNp = pde.g_N(ppxy);
            ge(:,1) = ge(:,1) + weightgN(pp)*gNp*bdphi(pp,1);
            ge(:,2) = ge(:,2) + weightgN(pp)*gNp*bdphi(pp,2);
            ge(:,3) = ge(:,3) + weightgN(pp)*gNp*bdphi(pp,3);
            ge(:,4) = ge(:,4) + weightgN(pp)*gNp*bdphi(pp,4);
        end
        ge = ge.*repmat(el,1,4);
        b(1:N) = b(1:N) + accumarray(Neumann(:), [ge(:,1); ge(:,2)],[N,1]);
        b(N+2*Neumannidx-1) = b(N+2*Neumannidx-1) + ge(:,3);
        b(N+2*Neumannidx)   = b(N+2*Neumannidx) + ge(:,4);
    end

    % Dirichlet boundary conditions
    if ~isPureNeumann && ~isempty(fixedDof) && ...
       ~isempty(pde.g_D) && ~(isnumeric(pde.g_D) && (pde.g_D == 0))
        % interpolation
        idx = (fixedDof > N);  % index of edge nodes
        u(fixedDof(~idx)) = pde.g_D(node(fixedDof(~idx),:)); % bd value at vertex dofs
        % for P3,  we should divide the points of edge into two parts.
        bdEdgeIdx = fixedDof(idx) - N;
        %  First parts, the points  * is in  1---*------2
        bdEdgeMid = node(edge(isDirichlet,1),:)+(node(edge(isDirichlet,2),:) ...
                  - node(edge(isDirichlet,1),:))/3;
        u(N + bdEdgeIdx(1:2:end)) = pde.g_D(bdEdgeMid);
      %  Second parts, the points * is in  1------*---2
        bdEdgeMid = node(edge(isDirichlet,1),:)+2*(node(edge(isDirichlet,2),:)...
                  - node(edge(isDirichlet,1),:))/3;
        u(N + bdEdgeIdx(2:2:end)) = pde.g_D(bdEdgeMid);
        % modify the right hand side
        b = b - A*u;
    end
    if ~isPureNeumann % non-empty Dirichlet boundary condition
        b(fixedDof) = u(fixedDof);
    end

    % Pure Neumann boundary condition
    if isPureNeumann
        b = b - mean(b);   % compatilbe condition: sum(b) = 0
        b(1) = 0;
    end
    end % end of getbdP3
end % end of function PoissonP3


function S = tsmooth(I,lambda,sigma,sharpness,maxIter)
%tsmooth - Structure Extraction from Texture via Relative Total Variation
%   S = tsmooth(I, lambda, sigma, maxIter) extracts structure S from
%   structure+texture input I, with smoothness weight lambda, scale
%   parameter sigma and iteration number maxIter.
%
%   Paras:
%   @I         : Input UINT8 image, both grayscale and color images are acceptable.
%   @lambda    : Parameter controlling the degree of smooth.
%                Range (0, 0.05], 0.01 by default.
%   @sigma     : Parameter specifying the maximum size of texture elements.
%                Range (0, 6], 3 by defalut.
%   @sharpness : Parameter controlling the sharpness of the final results,
%                which corresponds to \epsilon_s in the paper [1]. The smaller the value, the sharper the result.
%                Range (1e-3, 0.03], 0.02 by defalut.
%   @maxIter   : Number of itearations, 4 by default.
%
%   Example
%   ==========
%   I  = imread('Bishapur_zan.jpg');
%   S  = tsmooth(I); % Default Parameters (lambda = 0.01, sigma = 3, sharpness = 0.02, maxIter = 4)
%   figure, imshow(I), figure, imshow(S);
%
%   ==========
%   The Code is created based on the method described in the following paper
%   [1] "Structure Extraction from Texture via Relative Total Variation", Li Xu, Qiong Yan, Yang Xia, Jiaya Jia, ACM Transactions on Graphics,
%   (SIGGRAPH Asia 2012), 2012.
%   The code and the algorithm are for non-comercial use only.
%
%   Author: Li Xu (xuli@cse.cuhk.edu.hk)
%   Date  : 08/25/2012
%   Version : 1.0
%   Copyright 2012, The Chinese University of Hong Kong.
%

    if (~exist('lambda','var'))
       lambda=0.01;
    end
    if (~exist('sigma','var'))
       sigma=3.0;
    end
    if (~exist('sharpness','var'))
        sharpness = 0.02;
    end
    if (~exist('maxIter','var'))
       maxIter=4;
    end
    I = im2double(I);
    x = I;
    sigma_iter = sigma;
    lambda = lambda/2.0;
    dec=2.0;
    for iter = 1:maxIter
        [wx, wy] = computeTextureWeights(x, sigma_iter, sharpness);
        x = solveLinearEquation(I, wx, wy, lambda);
        sigma_iter = sigma_iter/dec;
        if sigma_iter < 0.5
            sigma_iter = 0.5;
        end
    end
    S = x;
end

function [retx, rety] = computeTextureWeights(fin, sigma,sharpness)

   fx = diff(fin,1,2);
   fx = padarray(fx, [0 1 0], 'post');
   fy = diff(fin,1,1);
   fy = padarray(fy, [1 0 0], 'post');

   vareps_s = sharpness;
   vareps = 0.001;

   wto = max(sum(sqrt(fx.^2+fy.^2),3)/size(fin,3),vareps_s).^(-1);
   fbin = lpfilter(fin, sigma);
   gfx = diff(fbin,1,2);
   gfx = padarray(gfx, [0 1], 'post');
   gfy = diff(fbin,1,1);
   gfy = padarray(gfy, [1 0], 'post');
   wtbx = max(sum(abs(gfx),3)/size(fin,3),vareps).^(-1);
   wtby = max(sum(abs(gfy),3)/size(fin,3),vareps).^(-1);
   retx = wtbx.*wto;
   rety = wtby.*wto;

   retx(:,end) = 0;
   rety(end,:) = 0;

end

function ret = conv2_sep(im, sigma)
  ksize = bitor(round(5*sigma),1);
  g = fspecial('gaussian', [1,ksize], sigma);
  ret = conv2(im,g,'same');
  ret = conv2(ret,g','same');
end

function FBImg = lpfilter(FImg, sigma)
    FBImg = FImg;
    for ic = 1:size(FBImg,3)
        FBImg(:,:,ic) = conv2_sep(FImg(:,:,ic), sigma);
    end
end

function OUT = solveLinearEquation(IN, wx, wy, lambda)
%
% The code for constructing inhomogenious Laplacian is adapted from
% the implementaion of the wlsFilter.
%
% For color images, we enforce wx and wy be same for three channels
% and thus the pre-conditionar only need to be computed once.
%
    [r,c,ch] = size(IN);
    k = r*c;
    dx = -lambda*wx(:);
    dy = -lambda*wy(:);
    B(:,1) = dx;
    B(:,2) = dy;
    d = [-r,-1];
    A = spdiags(B,d,k,k);
    e = dx;
    w = padarray(dx, r, 'pre'); w = w(1:end-r);
    s = dy;
    n = padarray(dy, 1, 'pre'); n = n(1:end-1);
    D = 1-(e+w+s+n);
    A = A + A' + spdiags(D, 0, k, k);
    if exist('ichol','builtin')
        L = ichol(A,struct('michol','on'));
        OUT = IN;
        for ii=1:ch
            tin = IN(:,:,ii);
            [tout, flag] = pcg(A, tin(:),0.1,100, L, L');
            OUT(:,:,ii) = reshape(tout, r, c);
        end
    else
        OUT = IN;
        for ii=1:ch
            tin = IN(:,:,ii);
            tout = A\tin(:);
            OUT(:,:,ii) = reshape(tout, r, c);
        end
    end

end


function pass = test_chebcoeffs2( pref )
% Test chebpoly2

if ( nargin == 0)
    pref = chebfunpref;
end

tol = 1000*pref.cheb2Prefs.chebfun2eps;
j = 1;

% Rank-2 function
n = 10;
m = 8;
Tn = chebpoly(n);
Tm = chebpoly(m);
f = Tn * Tn' + Tm * Tn';
X = chebcoeffs2( f );
Exact = zeros(n+1); Exact(n+1,n+1) = 1; Exact(m+1,n+1) = 1;
pass(j) = norm( X - Exact ) < tol; j = j + 1;

%f = Tm * Tn';
% check inverses
Z = chebfun2.vals2coeffs( chebpolyval2( f ) );
pass(j) = norm( Z - Exact ) < tol; j = j + 1;

f = chebfun2( @(x,y) x + y );
pass(j) = isequal( size(coeffs2(f,2,1)), [2 1] ); j = j + 1;

end


function cs_star = surfaceConcentration(cs_barrato,jflux,Q,T,param)
% surfaceConcentration evaluates the concentration of Li-ions at the electrode surfaces.

%   This file is part of the LIONSIMBA Toolbox
%
%	Official web-site: 	http://sisdin.unipv.it/labsisdin/lionsimba.php
% 	Official GitHUB: 	https://github.com/lionsimbatoolbox/LIONSIMBA
%
%   LIONSIMBA: A Matlab framework based on a finite volume model suitable for Li-ion battery design, simulation, and control
%   Copyright (C) 2016-2018 :Marcello Torchio, Lalo Magni, Davide Raimondo,
%                            University of Pavia, 27100, Pavia, Italy
%                            Bhushan Gopaluni, Univ. of British Columbia,
%                            Vancouver, BC V6T 1Z3, Canada
%                            Richard D. Braatz,
%                            Massachusetts Institute of Technology,
%                            Cambridge, Massachusetts 02142, USA
%
%   Main code contributors to LIONSIMBA 2.0:
%                           Ian Campbell, Krishnakumar Gopalakrishnan,
%                           Imperial college London, London, UK
%
%   LIONSIMBA is a free Matlab-based software distributed with an MIT
%   license.

% Diffusion coefficients for the solid phase
[Dps_eff, Dns_eff] = param.SolidDiffusionCoefficientsFunction(T,param);

% Check what kind of solid diffusion model has been chosen.
if(param.SolidPhaseDiffusion==1) % Two parameters model
    % Evaluates the average surface concentration in both the electrodes.
    % Cathode
    cs_star_p = cs_barrato(1:param.Np)-(param.Rp_p./(Dps_eff.*5)).*jflux(1:param.Np);
    % Anode
    cs_star_n = cs_barrato(param.Np+1:end)-(param.Rp_n./(Dns_eff.*5)).*jflux(param.Np+1:end);
elseif(param.SolidPhaseDiffusion==2) % Three parameters model
    % Cathode
    cs_star_p = cs_barrato(1:param.Np)+(param.Rp_p./(Dps_eff.*35)).*(-jflux(1:param.Np)+8*Dps_eff.*Q(1:param.Np));
    % Anode
    cs_star_n = cs_barrato(param.Np+1:end)+(param.Rp_n./(Dns_eff.*35)).*(-jflux(param.Np+1:end)+8*Dns_eff.*Q(param.Np+1:end));
elseif(param.SolidPhaseDiffusion==3) % Full model
    p_indices = param.Nr_p:param.Nr_p:param.Nr_p*param.Np;
    n_indices = param.Nr_n:param.Nr_n:param.Nr_n*param.Nn;
    % If the full model has been used, just take the concentration data at r=Rp
    cs_star_p = cs_barrato(p_indices);
    cs_star_n = cs_barrato(n_indices+p_indices(end));
end
% Return the residuals
cs_star = [cs_star_p;cs_star_n];

end


% make_avi_movie_example1.m
%
%  Discussion:
%
%    This is a simple example program to create an
%    Audio Video Interleaved (AVI) movie that can be played
%    independently of Matlab, using, for example, the XINE player
%    for Linux. We capture NUMFRAMES frames for the 1-D sine
%    wave with phase changing from 0 to 2 pi.
%
%    Before running this program close all figures and don't interfere
%    with the generated figures until the recording process is done.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 November 2004
%
%  Author:
%
%    Marcus Garvie
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'MAKE_AVI_MOVIE_EXAMPLE1\n' );
  fprintf ( 1, '  Create an AVI animation of simple graphics,\n' );
  fprintf ( 1, '  generating one frame at a time.\n' )
%
%  Set the total number of frames that we will generate.
%
  numframes = 100;
  hp = 2 * pi / numframes;
%
%  Control how fast final movie will play; total time
%  of movie in seconds will be about (numframes)/(num_frames_per_second)
%
  num_frames_per_second = 10;
  dur = numframes / num_frames_per_second;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  This movie will contain %d frames.\n', numframes );
  fprintf ( 1, '  The number of frames per second will be %f\n', num_frames_per_second );
  fprintf ( 1, '  so the movie should take %f seconds to play.\n', dur );
%
%  The AVIFILE function creates a new Audio Video Interleaved (AVI) file.
%  We specify its name, and we also set the value of "FPS", which is the
%  rate at which we will display frames (individual snapshots) per second.
%
  aviobj = avifile ( 'sinwave.avi', 'fps', num_frames_per_second );
%
%  Control resolution of wave
%
  num_nodes = 100;
  h = 2 * pi / num_nodes;
  i = 1 : num_nodes + 1;
%
%  Set the X values at which the function will be evaluated.
%
  x = ( i - 1 ) * h;
%
%  Now we make plots of sine waves.  Each new plot is a frame which
%  can be added to the AVI movie using the ADDFRAME function.
%
  for j =  1 : numframes+1
    y = sin ( x - ( j - 1 ) * hp );
    plot ( x, y )
    axis tight
    frame = getframe ( gca );
    aviobj = addframe ( aviobj, frame );
  end
%
%  Tell MATLAB we have completed the movie.
%
  aviobj = close ( aviobj );

  fprintf ( 1, '\n' );
  fprintf ( 1, 'MAKE_AVI_MOVIE_EXAMPLE1\n' );
  fprintf ( 1, '  Normal end of execution.\n' );
  fprintf ( 1, '  The movie file "sinwave.avi" has been created.\n' );


function [ar,rc,ASAcontrol] = rc2arset(rc,req_order,last)
%RC2ARSET AR reflectioncoefficients to AR models
%   AR = RC2ARSET(RC) converts AR-reflectioncoefficients RC into an AR-
%   model of order LENGTH(RC)-1, with parameter vector AR. The procedure
%   implements the parameter relations of the Levinson-Durbin recursion.
%
%   [SET_AR,SET_RC] = RC2ARSET(RC,REQ_ORDER) returns intermediate AR
%   parameter vectors in the cell array SET_AR and an array SET_RC of
%   reflectioncoefficients, both corresponding to orders requested by
%   REQ_ORDER. REQ_ORDER must be either a row of ascending AR-orders, or
%   a single AR-order.
%
%   RC2ARSET is an ARMASA main function.
%
%   See also: COV2ARSET, AR2ARSET.

%   References: P. Stoica and R.L. Moses, Introduction to Spectral
%               Analysis, Prentice-Hall, Inc., New Jersey, 1997,
%               Chapter 3.

%Header
%=====================================================================

%Declaration of variables
%------------------------

%Declare and assign values to local variables
%according to the input argument pattern
switch nargin
case 1
   if isa(rc,'struct'), ASAcontrol=rc; rc=[];
   else, ASAcontrol=[];
   end
   req_order=[];
case 2
   if isa(req_order,'struct'), ASAcontrol=req_order; req_order=[];
   else, ASAcontrol=[];
   end
case 3
   if isa(last,'struct'), ASAcontrol=last;
   else, error(ASAerr(39))
   end
otherwise
   error(ASAerr(1,mfilename))
end

if isequal(nargin,1) & ~isempty(ASAcontrol)
      %ASAcontrol is the only input argument
   ASAcontrol.error_chk = 0;
   ASAcontrol.run = 0;
end

%ARMASA-function version information
%-----------------------------------

%This ARMASA-function is characterized by
%its current version,
ASAcontrol.is_version = [2000 12 30 20 0 0];
%and its compatability with versions down to,
ASAcontrol.comp_version = [2000 12 30 20 0 0];

%Checks
%------

if ~any(strcmp(fieldnames(ASAcontrol),'error_chk')) | ASAcontrol.error_chk
   %Perform standard error checks
   %Input argument format checks
   ASAcontrol.error_chk = 1;
   if ~isnum(rc)
      error(ASAerr(11,'rc'))
   end
   if ~isavector(rc)
      error(ASAerr(15,'rc'))
   elseif size(rc,1)>1
      rc = rc';
      warning(ASAwarn(25,{'column';'rc';'row'},ASAcontrol))
   end
   if ~isempty(req_order)
      if ~isnum(req_order) | ~isintvector(req_order) |...
            req_order(1)<0 | ~isascending(req_order)
         error(ASAerr(12,{'requested';'req_order'}))
      elseif size(req_order,1)>1
         req_order = req_order';
         warning(ASAwarn(25,{'column';'req_order';'row'},ASAcontrol))
      end
   end

   %Input argument value checks
   if ~isreal(rc)
      error(ASAerr(13))
   end
   if rc(1)~=1
      error(ASAerr(23,{'rc','reflectioncoefficient'}))
   end
   if ~isempty(req_order) & req_order(end) > length(rc)-1
      error(ASAerr(24,'reflectioncoefficients'))
   end
end

if ~any(strcmp(fieldnames(ASAcontrol),'version_chk')) | ASAcontrol.version_chk
      %Perform version check
   ASAcontrol.version_chk = 1;

   %Make sure the requested version of this function
   %complies with its actual version
   ASAversionchk(ASAcontrol);
end

if ~any(strcmp(fieldnames(ASAcontrol),'run')) | ASAcontrol.run
      %Run the computational kernel
   ASAcontrol.run = 1;

%Main
%=====================================================

%Recursion initialization
%------------------------

l_rc = length(rc);
max_k = l_rc;
ar = zeros(1,l_rc);
ar(1) = 1;
store = ~isempty(req_order);
if store
   counter = 1;
   max_counter = length(req_order);
   max_k = req_order(max_counter)+1;
   ar_stack = cell(max_counter,1);
   rc_stack = zeros(1,max_counter);
   if req_order(1)==0
      ar_stack{1} = 1;
      rc_stack(1) = 1;
      counter = counter+1;
   end
end

%Levinson Durbin parameter recursion
%-----------------------------------

for k = 2:max_k
   order = k-1;
   rc_temp = rc(k);
   ar(2:order) = ar(2:order)+rc_temp*ar(order:-1:2);
   ar(k) = rc_temp;
   if store & k==req_order(counter)+1
      ar_stack{counter} = ar(1:k);
      rc_stack(counter) = rc_temp;
      counter = counter+1;
   end
end

%Output argument arrangement
%---------------------------

if store
   ar = ar_stack;
   rc = rc_stack;
end

%Footer
%=====================================================

else %Skip the computational kernel
   %Return ASAcontrol as the first output argument
   if nargout>1
      warning(ASAwarn(9,mfilename,ASAcontrol))
   end
   ar = ASAcontrol;
   ASAcontrol = [];
end

%Program history
%======================================================================
%
% Version                Programmer(s)          E-mail address
% -------                -------------          --------------
% former versions        P.M.T. Broersen        p.m.t.broersen@tudelft.nl
% [2000 12 30 20 0 0]    W. Wunderink           wwunderink01@freeler.nl


function jed = ss_to_jed_unix ( s )

%*****************************************************************************80
%
%% SS_TO_JED_UNIX converts a UNIX SS date to a JED.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 June 2001
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real S, the UNIX date.
%
%    Output, real JED, the corresponding Julian Ephemeris Date.
%
  jed_epoch = epoch_to_jed_unix ( );

  d = s / ( 24.0 * 60.0 * 60.0 );

  jed = jed_epoch + d;

  return
end


function r8vec_sorted_undex_test ( )

%*****************************************************************************80
%
%% R8VEC_SORTED_UNDEX_TEST tests R8VEC_SORTED_UNDEX.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 October 2008
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'R8VEC_SORTED_UNDEX_TEST\n' );
  fprintf ( 1, '  R8VEC_SORTED_UNDEX produces index vectors which create a sorted\n' );
  fprintf ( 1, '  list of the unique elements of a sorted R8VEC, \n' );
  fprintf ( 1, '  and a map from the original vector to the (implicit) \n' );
  fprintf ( 1, '  vector of sorted unique elements.\n' );

  x_num = 9;
  x_val = [ 11.0, 11.0, 11.0, 22.0, 22.0, 33.0, 33.0, 55.0, 55.0 ];

  r8vec_print ( x_num, x_val, '  The vector X:' );

  tol = r8_epsilon ( );
  x_unique_num = r8vec_sorted_unique_count ( x_num, x_val, tol );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Tolerance for equality is %e\n', tol );
  fprintf ( 1, '  Number of unique entries in X is %d\n', x_unique_num );

  [ undx, xdnu ] = r8vec_sorted_undex ( x_num, x_val, x_unique_num, tol );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  UNDX can be used to list the unique elements of X\n' );
  fprintf ( 1, '  in sorted order.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '     I  UNDX   X(UNDX)\n' );
  fprintf ( 1, '\n' );
  for i = 1 : x_unique_num
    fprintf ( 1, '  %4d  %4d  %8f\n', i, undx(i), x_val(undx(i)) );
  end

  xu_val(1:x_unique_num) = x_val(undx(1:x_unique_num));

  fprintf ( 1, '\n' );
  fprintf ( 1, '  UNDX can be used to created XU, a copy of X\n' );
  fprintf ( 1, '  containing only the unique elements, in sorted order.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '     I  UNDX     XU(I)\n' );
  fprintf ( 1, '\n' );
  for i = 1 : x_unique_num
    fprintf ( 1, '  %4d  %4d  %8f\n', i, undx(i), xu_val(i) );
  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  XDNU can be used to match each element of X with one of the\n' );
  fprintf ( 1, '  unique elements\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '     I  XDNU    X(I)       XU(XDNU(I))\n' );
  fprintf ( 1, '\n' );

  for i = 1 : x_num
    fprintf ( 1, '  %4d  %4d  %8f  %12f\n', i, xdnu(i), x_val(i), xu_val(xdnu(i)) );
  end

  return
end


function AA = int_tim_seg(tt,L,we,type, we_histo)
%function AA = int_tim_seg(tt,L,we,type, we_histo)
%  to be used with function fast_mr.m in @fast_mr
%  tt is time vector
%  L is number of segments, i.e. number of interpolation points
%  we is fieldmap, not required for linear and hanning types.
%  type is type of interpolator as follows:
%        1   is for ideal min-max using field map
%        2   is for histogram approximation, using we_histo
%  we_histo: only used when type 2 is selected
%            has two columns:
%                    column 1:  bin centers for histogram
%                    column 2:  histogram values at those bin centers

mint = min(tt(:));
maxt = max(tt(:));
rangt = maxt-mint;
minwe = min(we(:));
maxwe = max(we(:));
ndat = length(tt);
N = numel(we);

tau = (rangt+eps)/(L);

AA = zeros(L+1,ndat);

if L==0
  AA = ones(1,ndat);
  return
end

tt = tt-mint;

if (type == 1) % Exact LS interpolator
    gg = exp(i*we(:)*tau)*ones(1,L);  %CHECK MINUS SIGN HERE
    lll = ones(size(gg(:,1)))*[1:L];
    gl = gg.^lll;
    G = [ones(size(gg(:,1))),gl];
    glsum = sum(gl);
    GTG = zeros(L+1,L+1);
    GTG = GTG+diag(N*ones(L+1,1),0);
    for kk = 1:L
       GTG = GTG+diag(glsum(kk)*ones(L+1-kk,1),kk);
       GTG = GTG+diag(conj(glsum(kk))*ones(L+1-kk,1),-kk);
    end
       if (rcond(GTG)>10*eps)
           iGTGGT = inv(GTG)*G';
       else
           iGTGGT = pinv(GTG)*G';
           sprintf('used pinv instead')
      end
 %  for yy = 1:ndat
           cc = exp(i*we(:)*(tt(:))');
          % cc = exp(i*we(:)*tt(yy));
          % AA(:,yy) = (iGTGGT*cc)'.';
           AA = (iGTGGT*cc)'.';
 %   end
end
if (type == 2) % Approx Histogram Interpolator using we_histo
     %find bin size to give an integer value for KK
     rangwe = max(we_histo(:,1))-min(we_histo(:,1));
     minwe = min(we_histo(:,1));
     num_bins = length(we_histo(:,1));
     KK = floor(2*pi/((rangwe/num_bins)*tau));
     % bin size
     dwn = 2*pi/(KK*tau);
     bin_centers = we_histo(:,1);
     N_ap = we_histo(:,2).';
     %keyboard
     ftwe_ap = fft(N_ap.*(exp(i*dwn*[0:(num_bins-1)]*tau*(L))),KK);
     ftwe_ap = exp(-i*(minwe+dwn/2)*tau*([0:(KK-1)]-(L))).*ftwe_ap;
     GTGap_ap = zeros(L+1,L+1);
     for kk = 1:(2*L+1)
        GTGap_ap = GTGap_ap+diag(ftwe_ap(kk)*ones(L+1-abs((L+1)-kk),1),-(L+1)+kk);
     end
       if (rcond(GTGap_ap.')>10*eps)
           iGTGap_ap = inv(GTGap_ap.');
       else
           iGTGap_ap = pinv(GTGap_ap.');
           sprintf('used pinv instead')
      end
     for yy = 1:ndat
        ftc_ap= fft(N_ap.*(exp(i*[0:(num_bins-1)]*dwn*tt(yy))),KK);
        ftc_ap = exp(i*(minwe+dwn/2)*(tt(yy)-tau*[0:KK-1])).*(ftc_ap);
        GTc_ap = ftc_ap(1:L+1).';
        AA(:,yy) = (iGTGap_ap*GTc_ap)'.';
     end
end


function [THz] = MHz2THz(MHz)
% Convert frequency from megahertz to terahertz.
% Chad A. Greene 2012
THz = MHz*1e-6;


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Reduce an image applying Gaussian Pyramid.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function IResult = GPReduce(I,displayflag)

if ~exist('displayflag','var')
	displayflag = 1;
end

Wt = [0.0500    0.2500    0.4000    0.2500    0.0500];

dim = size(I);
newdim = ceil(dim*0.5);
IResult = zeros(newdim,class(I)); % Initialize the array in the beginning ..
I = single(I);
m = [-2:2];n=m;

switch length(dim)
	case 1
		%% Pad the boundaries.
		I = [ I(1) ; I(1) ;  I ; I(dim(1));  I(dim(1)) ];  % Add two rows towards the beginning and the end.
		for i = 0 : newdim(1) -1
			A = I(2*i+m+3).*Wt;;
			IResult(i + 1)= sum(A(:));
		end
	case 2
		%% Pad the boundaries.
		I = [ I(1,:) ; I(1,:) ;  I ; I(dim(1),:);  I(dim(1),:) ];  % Add two rows towards the beginning and the end.
		I = [ I(:,1)  I(:,1)     I   I(:,dim(2))  I(:,dim(2)) ];  % Add two columns towards the beginning and the end.

		Wt2 = Wt'*Wt;

		for i = 0 : newdim(1) -1
			for j = 0 : newdim(2) -1
				A = I(2*i+m+3,2*j+m+3).*Wt2;
				IResult(i + 1, j + 1) = sum(A(:));
			end
		end

	case 3
		Wt3 = ones(5,5,5);
		for i = 1:5
			Wt3(i,:,:) = Wt3(i,:,:) * Wt(i);
			Wt3(:,i,:) = Wt3(:,i,:) * Wt(i);
			Wt3(:,:,i) = Wt3(:,:,i) * Wt(i);
		end

		%% Pad the boundaries.
		I2 = zeros(dim+4,class(I));
		I2(3:2+dim(1),3:2+dim(2),3:2+dim(3)) = I;
		I2(1,:,:)=I2(3,:,:);I2(1,:,:)=I2(3,:,:);I2(end,:,:)=I2(end-2,:,:);I2(end-1,:,:)=I2(end-2,:,:);
		I2(:,1,:)=I2(:,3,:);I2(:,2,:)=I2(:,3,:);I2(:,end,:)=I2(:,end-2,:);I2(:,end-1,:)=I2(:,end-2,:);
		I2(:,:,1)=I2(:,:,3);I2(:,:,2)=I2(:,:,3);I2(:,:,end)=I2(:,:,end-2);I2(:,:,end-1)=I2(:,:,end-2);
		I=I2; clear I2;

		if( displayflag==1)
			H = waitbar(0,'Progress');
			set(H,'Name','GPReduce ...');
		end
		for k = 0 : newdim(3) - 1
			if( displayflag==1)
				waitbar(k/newdim(3),H,sprintf('(%d%%) %d out of %d',round(k/newdim(3)*100),k,newdim(3)));
			else
				fprintf('.');
			end
			for j = 0 : newdim(2) -1
				for i = 0 : newdim(1) -1
					A = I(2*i+m+3,2*j+m+3,2*k+m+3).*Wt3;
					IResult(i+1,j+1,k+1) = sum(A(:));
				end
			end
		end
		if( displayflag==1)
			close(H);
		else
			fprintf('\n');
		end
end


function spline_test04 ( )

%*****************************************************************************80
%
%% TEST04 tests BASIS_MATRIX_BETA_UNI, BASIS_MATRIX_TMP.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    01 February 2009
%
%  Author
%
%    John Burkardt
%
  n = 4;
  ndata = 4;
  nsample = 4;
  tdata = [ -1.0E+00, 0.0E+00, 1.0E+00, 2.0E+00 ]';
  ydata = [  4.0E+00, 7.0E+00, 12.0E+00, 19.0E+00 ]';

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST04\n' );
  fprintf ( 1, '  BASIS_MATRIX_BETA_UNI sets up the basis matrix\n' );
  fprintf ( 1, '    for the uniform beta spline.\n' );
%
%  First test
%
  beta1 = 1.0E+00;
  beta2 = 0.0E+00;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  BETA1 = %14f\n', beta1 );
  fprintf ( 1, '  BETA2 = %14f\n', beta2 );

  mbasis = basis_matrix_beta_uni ( beta1, beta2 );

  fprintf ( 1, '\n' );
  fprintf ( 1, '    TDATA, YDATA\n' );
  fprintf ( 1, '\n' );
  for i = 1 : ndata
    fprintf ( 1, '%12f  %12f\n', tdata(i), ydata(i) );
  end

  left = 2;

  fprintf ( 1, '\n' );
  fprintf ( 1, '    T, Spline(T)\n' );
  fprintf ( 1, '\n' );

  for i = 0 : ndata

    if ( i == 0 )
      tlo = tdata(1) - 0.5E+00 * ( tdata(2) - tdata(1) );
      thi = tdata(1);
    elseif ( i < ndata )
      tlo = tdata(i);
      thi = tdata(i+1);
    elseif ( ndata <= i )
      tlo = tdata(ndata);
      thi = tdata(ndata) + 0.5E+00 * ( tdata(ndata) - tdata(ndata-1) );
    end

    if ( i < ndata )
      jhi = nsample - 1;
    else
      jhi = nsample;
    end

    for j = 0 : jhi

      tval = ( ( nsample - j ) * tlo   ...
             + (           j ) * thi ) ...
             /   nsample;

      yval = basis_matrix_tmp ( left, n, mbasis, ndata, tdata, ydata, tval );

      if ( 0 < i & j == 0 )
        mark = '*';
      else
        mark = ' ';
      end

      fprintf ( 1, '%c  %12f  %12f\n', mark, tval, yval );

    end

  end
%
%  Second test
%
  beta1 = 1.0E+00;
  beta2 = 100.0E+00;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  BETA1 = %14f\n', beta1 );
  fprintf ( 1, '  BETA2 = %14f\n', beta2 );

  mbasis = basis_matrix_beta_uni ( beta1, beta2 );

  fprintf ( 1, '\n' );
  fprintf ( 1, '    TDATA, YDATA\n' );
  fprintf ( 1, '\n' );
  for i = 1 : ndata
    fprintf ( 1, '%12f  %12f\n', tdata(i), ydata(i) );
  end

  left = 2;

  fprintf ( 1, '\n' );
  fprintf ( 1, '    T, Spline(T)\n' );
  fprintf ( 1, '\n' );

  for i = 0 : ndata

    if ( i == 0 )
      tlo = tdata(1) - 0.5E+00 * ( tdata(2) - tdata(1) );
      thi = tdata(1);
    elseif ( i < ndata )
      tlo = tdata(i);
      thi = tdata(i+1);
    elseif ( ndata <= i )
      tlo = tdata(ndata);
      thi = tdata(ndata) + 0.5E+00 * ( tdata(ndata) - tdata(ndata-1) );
    end

    if ( i < ndata )
      jhi = nsample - 1;
    else
      jhi = nsample;
    end

    for j = 0 : jhi

      tval = ( ( nsample - j ) * tlo   ...
             + (           j ) * thi ) ...
             /   nsample;

      yval = basis_matrix_tmp ( left, n, mbasis, ndata, tdata, ydata, tval );

      if ( 0 < i & j == 0 )
        mark = '*';
      else
        mark = ' ';
      end

      fprintf ( 1, '%c  %12f  %12f\n', mark, tval, yval );

    end

  end
%
%  Third test
%
  beta1 = 100.0E+00;
  beta2 = 0.0E+00;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  BETA1 = %14f\n', beta1 );
  fprintf ( 1, '  BETA2 = %14f\n', beta2 );

  mbasis = basis_matrix_beta_uni ( beta1, beta2 );

  fprintf ( 1, '\n' );
  fprintf ( 1, '    TDATA, YDATA\n' );
  fprintf ( 1, '\n' );
  for i = 1 : ndata
    fprintf ( 1, '%12f  %12f\n', tdata(i), ydata(i) );
  end

  left = 2;

  fprintf ( 1, '\n' );
  fprintf ( 1, '    T, Spline(T)\n' );
  fprintf ( 1, '\n' );

  for i = 0 : ndata

    if ( i == 0 )
      tlo = tdata(1) - 0.5E+00 * ( tdata(2) - tdata(1) );
      thi = tdata(1);
    elseif ( i < ndata )
      tlo = tdata(i);
      thi = tdata(i+1);
    elseif ( ndata <= i )
      tlo = tdata(ndata);
      thi = tdata(ndata) + 0.5E+00 * ( tdata(ndata) - tdata(ndata-1) );
    end

    if ( i < ndata )
      jhi = nsample - 1;
    else
      jhi = nsample;
    end

    for j = 0 : jhi

      tval = ( ( nsample - j ) * tlo   ...
             + (           j ) * thi ) ...
             /   nsample;

      yval = basis_matrix_tmp ( left, n, mbasis, ndata, tdata, ydata, tval );

      if ( 0 < i & j == 0 )
        mark = '*';
      else
        mark = ' ';
      end

      fprintf ( 1, '%c  %12f  %12f\n', mark, tval, yval );

    end

  end

  return
end


function [I] = corrindex(XData, YData, YDataM, par_number)
%
% Function for calculation of the correlation index
%
% Inputs:   XData:  x data
%           YData:  y data
%           YDataM: model data
%           par_number: number of model parameters
% Output:   I: correlation index
%
% Authors:
% Ivo Petras (ivo.petras@tuke.sk)
% Dagmar Bednarova (dagmar.bednarova@tuke.sk)
%
% Date: 21/002/2007
%
kx=length(XData);
ky=length(YData);
kym=length(YDataM);
if kx ~= ky
    disp('Incompatible X and Y data.');
    close all;
end
n=kym;
sey=(sum((YData-YDataM).^2))/(n-par_number);
sy=var(YData);
I=(1-(sey./sy))^0.5;
%


function linplus_test155 ( )

%*****************************************************************************80
%
%% TEST155 tests R8BTO_MXV, R8BTO_VXM.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 March 2009
%
%  Author:
%
%    John Burkardt
%
  l = 3;
  m = 2;
  n = m * l;
%
%  I don't know how MATLAB wants me to enter a triply-dimensioned array.
%  I've tried several different approaches with no success, so
%  here's the clodhopper's method:
%
  a = zeros ( m, m, 2*l-1 );

  a(1,1,1) = 1.0E+00;
  a(2,1,1) = 5.0E+00;
  a(1,2,1) = 2.0E+00;
  a(2,2,1) = 5.0E+00;
  a(1,1,2) = 3.0E+00;
  a(2,1,2) = 6.0E+00;
  a(1,2,2) = 4.0E+00;
  a(2,2,2) = 6.0E+00;
  a(1,1,3) = 5.0E+00;
  a(2,1,3) = 7.0E+00;
  a(1,2,3) = 6.0E+00;
  a(2,2,3) = 7.0E+00;
  a(1,1,4) = 7.0E+00;
  a(2,1,4) = 8.0E+00;
  a(1,2,4) = 8.0E+00;
  a(2,2,4) = 8.0E+00;
  a(1,1,5) = 9.0E+00;
  a(2,1,5) = 9.0E+00;
  a(1,2,5) = 0.0E+00;
  a(2,2,5) = 9.0E+00;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST155\n' );
  fprintf ( 1, '  For a real block Toeplitz matrix,\n' );
  fprintf ( 1, '  R8BTO_MXV computes A * x.\n' );
  fprintf ( 1, '  R8BTO_VXM computes A''* x.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Block order M =  %d\n', m );
  fprintf ( 1, '  Block number L = %d\n', l );
  fprintf ( 1, '  Matrix order N = %d\n', n );

  r8bto_print ( m, l, a, '  The block Toeplitz matrix:' );

  x = r8ge_indicator ( m, l );

  r8ge_print ( m, l, x, '  The matrix x:' );

  b = r8bto_mxv ( m, l, a, x );

  r8ge_print ( m, l, b, '  The product A*x:' );

  b = r8bto_vxm ( m, l, a, x );

  r8ge_print ( m, l, b, '  The product A''*x:' );

  return
end


function [node,face,elem]=meshcylinders(c0, v, len, varargin)
%
% [node,face]=meshcylinders(c0, v, len, r,tsize,maxvol,ndiv)
%    or
% [node,face,elem]=meshcylinders(c0, v, len, r, tsize,maxvol,ndiv)
% [nplc,fplc]=meshcylinders(c0, v, len,r,0,0,ndiv);
%
% create the surface and (optionally) tetrahedral mesh of a 3D cylinder
%
% author: Qianqian Fang, <q.fang at neu.edu>
%
% input:
%   c0, cylinder list axis's starting point
%   v: directional vector of the cylinder
%   len: a scalar or a vector denoting the length of each
%        cylinder segment along the direction of v
%   tsize, maxvol, ndiv: please see the help for meshacylinder for details
%
% output:
%   node, face, elem: please see the help for meshacylinder for details
%
% -- this function is part of iso2mesh toolbox (http://iso2mesh.sf.net)
%

len=cumsum(len);
[ncyl,fcyl]=meshacylinder(c0,c0+v*len(1),varargin{:});

if(nargout==2 && length(len)==1)
    node=ncyl;
    face=fcyl;
    return;
end

for i=2:length(len)
   [ncyl1,fcyl1]=meshacylinder(c0+v*len(i-1),c0+v*len(i),varargin{:});
   if(iscell(fcyl1))
       fcyl1=cellfun(@(x) {x{1}+size(ncyl,1),x{2}}, fcyl1, 'UniformOutput', false);
       if(i==1)
           fcyl1=fcyl1(1:end-1);
       else
           fcyl1={fcyl1{1:end-2},fcyl1{end}};
       end
       fcyl=[fcyl(:)' fcyl1(:)'];
   else
       fcyl1=fcyl1+size(ncyl,1);
       fcyl=[fcyl; fcyl1];
   end
   ncyl=[ncyl; ncyl1];
end

[ncyl,I,J]=unique(round(ncyl*1e10),'rows');
ncyl=ncyl*1e-10;
if(iscell(fcyl))
    fcyl=cellfun(@(x) {J(x{1})',x{2}}, fcyl, 'UniformOutput', false);
else
    fcyl=J(fcyl);
end

tsize=varargin{2};
maxvol=varargin{3};

if(nargout==2 && tsize==0.0 && maxvol==0.0)
    node=ncyl;
    face=fcyl;
    return;
end
if(nargin==3)
    tsize=len/10;
end
if(nargin<5)
    maxvol=tsize*tsize*tsize;
end

centroid=cumsum([0 len(1:end-1)])+len/2;   % define the centroids of each cylinder segment
seeds=repmat(c0(:)',length(len),1)+repmat(v(:)',length(len),1).*repmat(centroid(:),1,3);
[node,elem,face]=surf2mesh(ncyl,fcyl,[],[],1,maxvol,seeds,[],0);


function out=mp(x,y)
%MP multiple precision class constructor.
%   p = mp(x,y) creates a mp object from the matrices x and y,
%   where x contains the double to be converted into an mp object
%         y contains the precision
% Special calls to mp include:
%   mp('pi',precision) => returns pi to precision (precision is optional)

maxDoublePrec=16; %digits
if nargin == 0
 out.rval=[];
 out.ival=[];
 out.precision=[];
 out=class(out,'mp');
elseif isa(x,'mp')
 %out=x;
 if nargin==1
  out=x;
 else
  for ii=1:numel(x)
   out(ii)=mp(x(ii).rval,y(min(numel(y),ii)));
   if ~isreal(x(ii))
    out(ii)=out(ii)+mp(x(ii).ival,y(min(numel(y),ii)))*i;
   end
  end
 end % if nargin==2
else
 mp_defaults
 precision=default_precision;
 out_rval=cell(size(x));
 out_ival=cell(size(x));
 if nargin==2
  precision=double(y(1));
 end % if nargin==2
 if isa(x,'double')
  for ii=1:numel(x)
   [str,exponent]=mpfr_construct_dd(real(x(ii)),precision);
   % throw away anything past maxDoublePrec, set to 0's
   if length(str)>maxDoublePrec
    str(maxDoublePrec+1:end)='0';
   end
   out_rval{ii}=mpExpForm(mpAddDecimal(str),exponent);
   if ~isreal(x(ii))
    [str,exponent]=mpfr_construct_dd(imag(x(ii)),precision);
    % throw away anything past maxDoublePrec, set to 0's
    if length(str)>maxDoublePrec
     str(maxDoublePrec+1:end)='0';
    end
    out_ival{ii}=mpExpForm(mpAddDecimal(str),exponent);
   end
  end % for ii=1:size(x,
 elseif isa(x,'cell')
  for ii=1:numel(x)
   [str,exponent]=mpfr_construct_cd(x{ii},precision);
   out_rval{ii}=mpExpForm(mpAddDecimal(str),exponent);
  end % for ii=1:size(x,
 elseif isa(x,'char')
  out_rval=cell(1);
  out_ival=cell(1);
  if any(strfind(lower(x),'pi'))
   out_rval=mpfr_pi(precision);
%%%   [str,exponent]=mpfr_pi(precision);
%%%   out_rval=mpExpForm(mpAddDecimal(str),exponent);
  else
   [str,exponent]=mpfr_construct_cd(x,precision);
   out_rval{1,1}=mpExpForm(mpAddDecimal(str),exponent);
  end
 end
 out=class(struct('rval',out_rval,...
                  'ival',out_ival,...
                  'precision',precision),'mp');
end

%%%out_rval
%%%out_rexp
%%%out_ival
%%%out_iexp

%'rrrrrrr',kb
% x=magic(3),s1='023e1',s2='-.002e-1'
% mp(x)


function [connmat] = triangle2connectivity(tri, pos)

% TRIANGLE2CONNECTIVITY computes a connectivity-matrix from a triangulation.
%
% Use as
%  [connmat] = triangle2connectivity(tri)
% or
%  [connmat] = triangle2connectivity(tri, pos)
%
% The input tri is an Mx3 matrix describing a triangulated surface,
% containing indices to connecting vertices. The output connmat is a sparse
% logical NxN matrix, with ones, where vertices are connected, and zeros
% otherwise.
%
% If you specify the vertex positions in the second input argument as Nx3
% matrix, the output will be a sparse matrix with the lengths of the
% edges between the connected vertices.
%
% See also CHANNELCONNECTIVIY

% Copyright (C) 2015, Jan-Mathijs Schoffelen
%
% This file is part of FieldTrip, see http://www.fieldtriptoolbox.org
% for the documentation and details.
%
%    FieldTrip 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.
%
%    FieldTrip 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 FieldTrip. If not, see <http://www.gnu.org/licenses/>.
%
% $Id$

% ensure that the vertices are indexed starting from 1
if min(tri(:))==0,
  tri = tri + 1;
end

% ensure that the vertices are indexed according to 1:number of unique vertices
tri = tri_reindex(tri);

% create the unique edges from the triangulation
edges  = [tri(:,[1 2]); tri(:,[1 3]); tri(:,[2 3])];
edges  = double(unique(sort([edges; edges(:,[2 1])],2), 'rows'));

% fill the connectivity matrix
n        = size(edges,1);
if nargin<2
  % create sparse binary matrix
  connmat = sparse([edges(:,1);edges(:,2)],[edges(:,2);edges(:,1)],true(2*n,1));
else
  % create sparse matrix with edge lengths
  dpos    = sqrt(sum( (pos(edges(:,1),:) - pos(edges(:,2),:)).^2, 2));
  connmat = sparse([edges(:,1);edges(:,2)],[edges(:,2);edges(:,1)],[dpos(:);dpos(:)]);
end

function [newtri] = tri_reindex(tri)

% this subfunction reindexes tri such that they run from 1:number of unique vertices
newtri       = tri;
[srt, indx]  = sort(tri(:));
tmp          = cumsum(double(diff([0;srt])>0));
newtri(indx) = tmp;


function varargout = armorf(x,Nr,Nl,p)
%ARMORF   AR parameter estimation via LWR method by Morf modified.
%   x is a matrix whose every row is one variable's time series
%   Nr is the number of realizations, Nl is the length of every realization
%   If the time series are stationary long, just let Nr=1, Nl=length(x)
%   p is the order of AR model
%
%   A = ARMORF(X,NR,NL,P) returns the polynomial coefficients A corresponding to
%     the AR model estimate of matrix X using Morf's method.
%
%   [A,E] = ARMORF(...) returns the final prediction error E (the
%   covariance matrix of the white noise of the AR model).
%
%   [A,E,K] = ARMORF(...) returns the vector K of reflection
%     coefficients (parcor coefficients).
%
%   Ref: M. Morf, etal, Recursive Multichannel Maximum Entropy Spectral Estimation,
%              IEEE trans. GeoSci. Elec., 1978, Vol.GE-16, No.2, pp85-94.
%        S. Haykin, Nonlinear Methods of Spectral Analysis, 2nd Ed.
%              Springer-Verlag, 1983, Chapter 2
%
%   finished on Aug.9, 2002 by Yonghong Chen

% Initialization
[L,N]=size(x);
R0=zeros(L,L);
R0f=R0;
R0b=R0;
pf=R0;
pb=R0;
pfb=R0;
ap(:,:,1)=R0;
bp(:,:,1)=R0;
En=R0;
for i=1:Nr
    En=En+x(:,(i-1)*Nl+1:i*Nl)*x(:,(i-1)*Nl+1:i*Nl)';
    ap(:,:,1)=ap(:,:,1)+x(:,(i-1)*Nl+2:i*Nl)*x(:,(i-1)*Nl+2:i*Nl)';
    bp(:,:,1)=bp(:,:,1)+x(:,(i-1)*Nl+1:i*Nl-1)*x(:,(i-1)*Nl+1:i*Nl-1)';
end
ap(:,:,1) = inv((chol(ap(:,:,1)/Nr*(Nl-1)))');
bp(:,:,1) = inv((chol(bp(:,:,1)/Nr*(Nl-1)))');
for i=1:Nr
    efp = ap(:,:,1)*x(:,(i-1)*Nl+2:i*Nl);
    ebp = bp(:,:,1)*x(:,(i-1)*Nl+1:i*Nl-1);
    pf = pf + efp*efp';
    pb = pb + ebp*ebp';
    pfb = pfb + efp*ebp';
end
En = chol(En/N)'; % Covariance of the noise

% Initial output variables
coeff = []; %  Coefficient matrices of the AR model
kr=[];  % reflection coefficients

for m=1:p
   % Calculate the next order reflection (parcor) coefficient
   ck = inv((chol(pf))')*pfb*inv(chol(pb));
   kr=[kr,ck];
   % Update the forward and backward prediction errors
   ef = eye(L)- ck*ck';
   eb = eye(L)- ck'*ck;

   % Update the prediction error
   En = En*chol(ef)';
   E = (ef+eb)./2;

   % Update the coefficients of the forward and backward prediction errors
   ap(:,:,m+1) = zeros(L);
   bp(:,:,m+1) = zeros(L);
   pf = zeros(L);
   pb = zeros(L);
   pfb = zeros(L);

   for i=1:m+1
       a(:,:,i) = inv((chol(ef))')*(ap(:,:,i)-ck*bp(:,:,m+2-i));
       b(:,:,i) = inv((chol(eb))')*(bp(:,:,i)-ck'*ap(:,:,m+2-i));
   end
   for k=1:Nr
       efp = zeros(L,Nl-m-1);
       ebp = zeros(L,Nl-m-1);
       for i=1:m+1
           k1=m+2-i+(k-1)*Nl+1;
           k2=Nl-i+1+(k-1)*Nl;
           efp = efp+a(:,:,i)*x(:,k1:k2);
           ebp = ebp+b(:,:,m+2-i)*x(:,k1-1:k2-1);
       end
       pf = pf + efp*efp';
       pb = pb + ebp*ebp';
       pfb = pfb + efp*ebp';
   end
   ap = a;
   bp = b;
end
for j=1:p
    coeff = [coeff,inv(a(:,:,1))*a(:,:,j+1)];
end

varargout{1} = coeff;
if nargout >= 2
    varargout{2} = En*En';
end
if nargout >= 3
    varargout{3} = kr;
end


function [] = test_lasso()

    %clc;
    clear;
    close all;

    rng('default')

    %% Set algorithms
    %algorithms = {'PG-BKT', 'PG-TFOCS-BKT', 'PG-FIX', 'SUBG-DEC', 'SUBG-BKT', 'APG-TFOCS-BKT', 'FISTA', 'CD-LASSO', 'ADMM-LASSO'};
    algorithms = {'SMOOTH-FIX', 'SMOOTH-BKT', 'PG-WOLFE', 'PG-TFOCS-BKT', 'PG-FIX', 'SUBG-DEC', 'SUBG-BKT', 'APG-BKT', 'APG-TFOCS-BKT', 'FISTA', 'ADMM-LASSO'};
    %algorithms = {'SUBG-DEC', 'SUBG-BKT', 'SUBG-TFOCS-BKT'};
    %algorithms = {'SUBG-DEC', 'SUBG-BKT', 'SUBG-TFOCS-BKT', 'SMOOTH-FIX', 'FISTA', 'ADMM-LASSO'};
    algorithms = {'SUBG-DEC', 'SUBG-BKT'};

    %% prepare dataset
    if 1
        n = 1280;
        d = 100;
        k = 15;                                     % cardinality of nonzero elements
        [A,~] = qr(randn(n,d),0);
        A = A';
        p = randperm(n);
        p = p(1:k);                                 % select location of k nonzeros
        x0 = zeros(n,1);
        x0(p) = randn(k,1);
        b = A*x0 + .02*randn(d, 1);                 % add random noise
        lambda_max = norm( A'*b, 'inf' );
        lambda = 0.1*lambda_max;
    else
        n = 500;
        d = 100;
        A = randn(d,n);
        b = randn(d,1);
        lambda = 5;
    end

    %% initialize
    w_init = rand(n,1);
    w_list = cell(length(algorithms),1);
    info_list = cell(length(algorithms),1);

    %% perform algorithms
    for alg_idx=1:length(algorithms)

        %% define problem definitions
        clear problem;
        problem = lasso(A, b, lambda, 'prox_reg');

        fprintf('\n\n### [%02d] %s ###\n\n', alg_idx, algorithms{alg_idx});

        clear options;
        % general options for optimization algorithms
        options.w_init = w_init;
        options.tol_gnorm = 1e-10;
        options.max_epoch = 100;
        options.max_iter = options.max_epoch;
        options.verbose = true;
        options.f_opt = 0;
        options.store_w = false;

        switch algorithms{alg_idx}
            case {'SMOOTH-FIX'}
                smooth_mu = 0.1;
                clear problem;
                problem = lasso(A, b, lambda, 'smooth', smooth_mu);

                options.step_alg = 'fix';
                options.step_init = 1/(problem.L+lambda/smooth_mu);
                [w_list{alg_idx}, info_list{alg_idx}] = smoothing_gd(problem, options);

            case {'SMOOTH-BKT'}
                smooth_mu = 0.1;
                clear problem;
                problem = lasso(A, b, lambda, 'smooth', smooth_mu);

                options.step_alg = 'backtracking';
                [w_list{alg_idx}, info_list{alg_idx}] = smoothing_gd(problem, options);

            case {'SUBG-DEC'}

                options.step_alg = 'decay-7';
                options.step_init = 1/problem.L;
                [w_list{alg_idx}, info_list{alg_idx}] = subg(problem, options);

            case {'SUBG-BKT'}

                options.step_alg = 'backtracking';
                [w_list{alg_idx}, info_list{alg_idx}] = subg(problem, options);

            case {'SUBG-TFOCS-BKT'}

                options.step_alg = 'tfocs_backtracking';
                [w_list{alg_idx}, info_list{alg_idx}] = subg(problem, options);

            case {'PG-BKT'}

                options.step_alg = 'backtracking';
                %options.step_init_alg = 'bb_init';
                [w_list{alg_idx}, info_list{alg_idx}] = sd(problem, options);

            case {'PG-FIX'}

                options.step_alg = 'fix';
                options.step_alg = 'fix';
                options.step_init = 1/problem.L;
                %options.step_init_alg = 'bb_init';
                [w_list{alg_idx}, info_list{alg_idx}] = sd(problem, options);

            case {'PG-WOLFE'}

                options.step_alg = 'strong_wolfe';
                options.step_init_alg = 'bb_init';
                [w_list{alg_idx}, info_list{alg_idx}] = sd(problem, options);

            case {'PG-TFOCS-BKT'}

                options.step_alg = 'tfocs_backtracking';
                options.step_init_alg = 'bb_init';
                [w_list{alg_idx}, info_list{alg_idx}] = sd(problem, options);

            case {'APG-BKT'}

                options.step_alg = 'backtracking';
                options.step_init_alg = 'bb_init';
                %[w_list{alg_idx}, info_list{alg_idx}] = sd_nesterov(problem, options);
                [w_list{alg_idx}, info_list{alg_idx}] = ag(problem, options);

            case {'APG-TFOCS-BKT'}

                options.step_alg = 'tfocs_backtracking';
                options.step_init_alg = 'bb_init';
                %[w_list{alg_idx}, info_list{alg_idx}] = sd_nesterov(problem, options);
                [w_list{alg_idx}, info_list{alg_idx}] = ag(problem, options);

            case {'FISTA'}

                options.sub_mode  = 'FISTA';
                [w_list{alg_idx}, info_list{alg_idx}] = ista(problem, options);

            case {'ADMM-LASSO'}

                options.rho = 0.1;
                [w_list{alg_idx}, info_list{alg_idx}] = admm_lasso(problem, options);

            case {'CD-LASSO'}

                options.sub_mode = 'lasso';
                [w_list{alg_idx}, info_list{alg_idx}] = cd_lasso_elasticnet(problem, options);

            case {'L-BFGS-BKT'}

                options.step_alg = 'backtracking';
                [w_list{alg_idx}, info_list{alg_idx}] = lbfgs(problem, options);

            case {'L-BFGS-WOLFE'}

                options.step_alg = 'strong_wolfe';
                [w_list{alg_idx}, info_list{alg_idx}] = lbfgs(problem, options);

            case {'P-Newton-CHOLESKY'}

                options.sub_mode = 'CHOLESKY';
                options.step_init_alg = 'bb_init';
                options.step_alg = 'tfocs_backtracking';
                %options.step_alg = 'backtracking';
                [w_list{alg_idx}, info_list{alg_idx}] = newton(problem, options);

            otherwise
                warn_str = [algorithms{alg_idx}, ' is not supported.'];
                warning(warn_str);
                w_list{alg_idx} = '';
                info_list{alg_idx} = '';
        end

    end

    fprintf('\n\n');

    %% plot all

    % display iter vs cost
    display_graph('iter','cost', algorithms, w_list, info_list);
    % display time vs cost
    display_graph('time','cost', algorithms, w_list, info_list);
    % display iter vs. l1 norm, i.e. the toral number of non-zero elements
    display_graph('iter','reg', algorithms, w_list, info_list);

end


%IM_ROTATE Fixed mapping for image rotation
%
%	B = IM_ROTATE(A,ALF)
%	B = A*IM_ROTATE([],ALF)
%	B = A*IM_ROTATE(ALF)
%
% INPUT
%   A        Dataset with object images (possibly multi-band)
%   ALF      Rotation angle (in radians),
%            default: rotation to main axis
%
% OUTPUT
%   B        Dataset with rotated object images
%
% DESCRIPTION
% The objects stored as images in the dataset or datafile A are rotated
% using the IMROTATE command.
%
% SEE ALSO (PRTools Guide)
% DATASETS, DATAFILES, DIP_IMAGE

% Copyright: R.P.W. Duin, r.p.w.duin@37steps.com
% Faculty EWI, Delft University of Technology
% P.O. Box 5031, 2600 GA Delft, The Netherlands

function b = im_rotate(varargin)

	argin = shiftargin(varargin,'vector');
  argin = setdefaults(argin,[],[]);
  if mapping_task(argin,'definition')
    b = define_mapping(argin,'fixed');
    b = setname(b,'Image rotate');
  else
    [a,alf] = deal(argin{:});
    if isa(a,'prdataset') % allows datafiles too
%       error('Command cannot be used for datasets as it may change image size')
%     elseif isdatafile(a)
      isobjim(a);
      b = filtim(a,mfilename,{alf});
      b = setfeatsize(b,getfeatsize(a));
    elseif isa(a,'double') || isa(a,'dip_image') % here we have a single image

      a = double(a);

      if isempty(alf)
        m = im_moments(a,'central',[1 2 0; 1 0 2]');
        C = [m(2) m(1); m(1) m(3)];
        [E,D] = preig(C); [dummy,ind] = sort(diag(D));
        alf = atan2(E(2,ind(1)),E(1,ind(1)))+pi/2;
      end

      b = imrotate(a,alf*360/(2*pi),'bilinear','crop');

    end

  end

return