function suborder_num = tetrahedron_nco_suborder_num ( rule )

%*****************************************************************************80
%
%% TETRAHEDRON_NCO_SUBORDER_NUM returns the number of suborders for an NCO rule.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    31 January 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Peter Silvester,
%    Symmetric Quadrature Formulae for Simplexes,
%    Mathematics of Computation,
%    Volume 24, Number 109, January 1970, pages 95-100.
%
%  Parameters:
%
%    Input, integer RULE, the index of the rule.
%
%    Output, integer SUBORDER_NUM, the number of suborders of the rule.
%
  if ( rule == 1 )
    suborder_num = 1;
  elseif ( rule == 2 )
    suborder_num = 1;
  elseif ( rule == 3 )
    suborder_num = 2;
  elseif ( rule == 4 )
    suborder_num = 3;
  elseif ( rule == 5 )
    suborder_num = 5;
  elseif ( rule == 6 )
    suborder_num = 6;
  elseif ( rule == 7 )
    suborder_num = 9;

  else

    suborder_num = -1;
    fprintf ( 1, '\n' );
    fprintf ( 1, 'TETRAHEDRON_NCO_SUBORDER_NUM - Fatal error!\n' );
    fprintf ( 1, '  Illegal RULE = %d\n', rule );
    error ( 'TETRAHEDRON_NCO_SUBORDER_NUM - Fatal error!\n' )

  end

  return
end


function spline_test23 ( )

%*****************************************************************************80
%
%% TEST23 tests SPLINE_OVERHAUSER_VAL.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    01 February 2009
%
%  Author
%
%    John Burkardt
%
  ndata = 4;
  ndim = 2;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST23\n' );
  fprintf ( 1, '  SPLINE_OVERHAUSER_VAL evaluates the\n' );
  fprintf ( 1, '    Overhauser spline.\n' );
%
%  Set the data.
%
  tdata(1) = 1.0;
  ydata(1,1) =   0.0;
  ydata(2,1) =   0.0;

  tdata(2) = 2.0;
  ydata(1,2) =   1.0;
  ydata(2,2) =   1.0;

  tdata(3) = 3.0;
  ydata(1,3) =   2.0;
  ydata(2,3) = - 1.0;

  tdata(4) = 4.0;
  ydata(1,4) =   3.0;
  ydata(2,4) =   0.0;

  fprintf ( 1, '\n' );
  fprintf ( 1, '  The data to be interpolated:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Number of data values = %d\n', ndata );
  fprintf ( 1, '\n' );
  fprintf ( 1, '       T             Y\n' );
  fprintf ( 1, '\n' );

  for i = 1 : ndata
    fprintf ( 1, '%14f  ', tdata(i) );
    for j = 1 : ndim
      fprintf ( 1, '%14f  ',  ydata(j,i) );
    end
    fprintf ( 1, '\n' );
  end
%
%  Now evaluate the spline all over the place.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  T, Spline value\n' );
  fprintf ( 1, '\n' );

  for i = 0 : 6 * ndata + 3

    tval = ( i ) / 6.0;
    yval = spline_overhauser_val ( ndim, ndata, tdata, ydata, tval );

    fprintf ( 1, '%14f  ', tval );
    for j = 1 : ndim
      fprintf ( 1, '%14f  ',  yval(j) );
    end
    fprintf ( 1, '\n' );

  end

  return
end


function F  = obj_find_valve_param_table_3way(x,Q_r)
% Objective function to find out the required area vs. spool displacement
% relationship for 3-way valve.
% Copyright 2010 MathWorks, Inc.

% x - vector of variable parameters. It is constructed of ten area values
% a_1 ... a_max - cross-sectional area of the valve at 10 successive
% spool position s_1 ... s_10. The positions are set by shifting the spool
% from zero to its maximum opening at constant speed.

% Q_r - required flow rate expressed in percentage with respect to its
% maximum flow and maximum displacement

% Q_max - maximum flow rate

assignin('base','a_1', x(1));
assignin('base','a_2', x(2));
assignin('base','a_3', x(3));
assignin('base','a_4', x(4));
assignin('base','a_5', x(5));
assignin('base','a_6', x(6));
assignin('base','a_7', x(7));
assignin('base','a_8', x(8));
assignin('base','a_9', x(9));
assignin('base','a_10', x(10));

model = 'valve_testrig_flow_char_3way';
load_system(model);
sim(model);

k = [1 1 1 0.9 0.8 0.7 0.6 0.5 0.4 0.3 0.2]; % Weight multipliers

% Computing objective function
F = 0;
for j = 1:11
    F = F + k(j) * (yout(j) - Q_r(j))^2;
end
end

% EOF


function [delay,maxBitRate,energy] = dtiNeuronBitRate(radius, length, meanFiringRate, myelinated)
%
% [delay,maxBitRate,energy] = dtiNeuronBitRate(radius, length, meanFiringRate, [myelinated=true])
%
% Returns neural conduction delay in msec, the maximum bit-rate, and the energy consumption
% given the outer radius (in micrometers), the length (in millimeters), and the mean firing
% rate (in spikes/sec).
%
% Energy requirements are specified in amol glucose / action potential.
%
% See:
%   Brenner et. al. (2000). Synergy in a neural code. Neural Comput.
%   Wang et. al. (2008). Functional Trade-Offs in White Matter Axonal Scaling. J. Neurosci.
%   (The main reference that works out the bit-rate.)
%
% Also see:
%   Timing jitter vs. radius: Swadlow (2000). Time and the brain (R. Miller, ed.)
%   (We assume that timing jitter is +/-10% or the total conduction delay.)
%
% 2009.02.06 RFD wrote it.

if(~exist('myelinated','var') || isempty(myelinated))
    myelinated = true;
end

[speed,energyPerMm] = dtiNeuralConductionSpeed(radius, myelinated);

delay = 1 ./ (speed ./ length);
% delay is in ms- we need seconds, thus the 1000
energy = energyPerMm.*length;
maxBitRate = log2(1./(meanFiringRate.*0.2.*(delay./1000)));

return;


function specGlobal = doa_music(x,Param,nsrc)
if(size(x,2)<2)
    error('ERROR[MUSIC]:信号通道数必须大于等于2');
end
%% STFT
X = ssl_stft(x.',Param.window,Param.noverlap,Param.nfft,Param.fs);%nbin,nfram,nchan
X = X(2:end,:,:);
X = X(Param.freqBins,:,:);
[nbin,~,nmic] = size(X);
%% MUSIC
% linspace包含端点，保证插值时不会出现NaN
aziGrid = linspace(Param.azimuth(1),Param.azimuth(end),round((Param.azimuth(end)-Param.azimuth(1))/Param.alphaRes)+1);
eleGrid = linspace(Param.elevation(1),Param.elevation(end),round((Param.elevation(end)-Param.elevation(1))/Param.alphaRes)+1);
power = zeros(nbin, length(aziGrid), length(eleGrid));

for ibin = 1:nbin % 对于每个频点
    Rxx = (transpose(squeeze(X(ibin,:,:)))*conj(squeeze(X(ibin,:,:))));% 自相关矩阵
    [U,~,~] = svd(Rxx);    % SVD分解   Rxx = U * S * U^H
    En = U(:,nsrc+1:end);  % 噪声子空间
    fprintf('%d\n',ibin)
    for iaz = 1 :length(aziGrid)
        for iel = 1 :length(eleGrid)
            v = [cosd(eleGrid(iel))*cosd(aziGrid(iaz));cosd(eleGrid(iel))*sind(aziGrid(iaz));sind(eleGrid(iel))];% 3 x 1
            tau = v'*(Param.micPos-repmat(Param.micPos(:,1),[1,nmic]))./Param.c; % 1 * nmic  参考麦克为1：Param.micPos(:,1)
            a = exp(1i*2*pi*Param.f(ibin).*transpose(tau));%nmic x 1     SV = exp(-2*1i*pi*tau*Param.f.');  % nmic x nbin
            power(ibin,iaz,iel) = 1./(sum(abs( ctranspose(a) * En * ctranspose(En) * a )));
        end
    end
end

% 对所有频率的空间谱加在一起:
spec = squeeze(sum(power,1)); %nAzi x nEle
[az,el]=meshgrid(aziGrid,eleGrid);
[azi,eli]=meshgrid(Param.azimuth,Param.elevation);

specInterp = interp2(az,el,spec.',azi,eli);
% specInterp = interp2(azOri,elOri,spec.',azInterp,elInterp);
specGlobal = reshape(specInterp.',1,[]);
end

function X=ssl_stft(x,window,noverlap,nfft,fs)

% Inputs:x: nchan x nsampl  window = blackman(wlen);
% Output:X: nbin x nfram x nchan matrix

[nchan,~]=size(x);
[Xtemp,F,T,~] = spectrogram(x(1,:),window,noverlap,nfft,fs);%S nbinxnframe
nbin = length(F);
nframe = length(T);
X = zeros(nbin,nframe,nchan);
X(:,:,1) = Xtemp;
for ichan = 2:nchan
    X(:,:,ichan) = spectrogram(x(ichan,:),window,noverlap,nfft,fs);
end

end


function cvx_optval = norm_nuc( X ) %#ok

%NORM_NUC   Internal cvx version.

error( nargchk( 1, 1, nargin ) );
if ndims( X ) > 2,
    error( 'norm_nuc is not defined for N-D arrays.' );
elseif ~cvx_isaffine( X ),
    error( 'Input must be affine.' );
end

%
% Construct problem
%

[ m, n ] = size( X ); %#ok
cvx_begin sdp
    variable W1(m,m) symmetric
    variable W2(n,n) symmetric
    minimize(0.5*(trace(W1)+trace(W2)));
    [W1,X;X',W2] >= 0; %#ok
cvx_end

% Copyright 2010 Michael C. Grant and Stephen P. Boyd.
% See the file COPYING.txt for full copyright information.
% The command 'cvx_where' will show where this file is located.


function [rvts,rvtsSS,rvtsD,rvtsSSD,diagnostics] = realized_twoscale_variance(price,time,timeType,samplingType,samplingInterval,subsamples,options)
% Estimated quadratic variation using the Two-Scale estimator of Ait-Sahalia, Mykland and Zhang
%
% USAGE:
%   RVTS = realized_twoscale_variance(PRICE)
%   [RVTS,RVTSSS,RVTSD,RVTSSSD,DIAGNOSTICS] = realized_twoscale_variance(PRICE,TIME,TIMETYPE,SAMPLINGTYPE,SAMPLINGINTERVAL,SUBSAMPLES,OPTIONS)
%
% INPUTS:
%   PRICE            - m by 1 vector of high frequency prices
%   TIME             - [OPTIONAL] m by 1 vector of times where TIME(i) corresponds to PRICE(i).
%   TIMETYPE         - [OPTIONAL] String describing the way times are measured
%                       'wall'    24-hour clock of the form HHMMSS.mmm, e.g. 101543 or 153217
%                       'seconds' Time measured in seconds past midnight
%                       'unit'  Unit normalized date format, e.g. .1, .234, .9
%                         Unit normalized times are more general than the other types and can be
%                         applied to data from more than one calendar day
%   SAMPLINGTYPE     - [OPTIONAL] String describing the type of sampling to use when
%                        filtering PRICE for estimating the fast scale estimator.
%                        'CalendarTime' - Sample in calendar time using observations separated by
%                          SAMPLINGINTERVAL seconds
%                        'CalendarUniform' - Sample in calendar time using SAMPLINGINTERVAL
%                          observations spread uniformly between TIME(1) and TIME(m)
%                        'BusinessTime' - Sample in business (tick) time using observation separated
%                          by SAMPLINGINTERVAL ticks
%                        'BusinessUniform' - Sample in business (tick) time using observations
%                          uniformly spaced in business time.
%                        'Fixed' - Sample at specific points in time. When using fixed,
%                          SAMPLINGINTERVAL must be a n by 1 vector of times with the same TIMETYPE
%                          as TIME (i.e. seconds if TIME is in seconds)
%   SAMPLINGINTERVAL  - [OPTIONAL] Scalar integer or n by 1 vector whose meaning depends on the
%                         selected SAMPLINGTYPE
%   OPTIONS           - [OPTIONAL] Realized Two-Scale option structure initialized by calling
%                         realized_options('Multiscale'). See help realized_options for a description of
%                         available options.
%
% OUTPUTS:
%   RVTS        - Realized two-scale variance estimate
%   RVTSSS      - Realized two-scale variance estimate constructed by averaging RVTS across multiple
%                 initial observations.  If SAMPLINGTYPE is 'BusinessTime' and SAMPLINGINTERAL is 1
%                 then subsampling is not possible.
%   RVTSD       - Debiased version of realized two-scale variance estimate
%   RVTSSSD     - Debiased version of realized two-scale variance estimate constructed by averaging RVTS across multiple
%                 initial observations.
%   DIAGNOSTICS - Structure of useful diagnostic information.  Fields are
%                   BANDWIDTH             - Ratio of slow scale to fast scale where the fast scale
%                                           sampling is determined by SAMPLINGTYPE and SAMPLINGINTERVAL.
%                   NOISEVARIANCE         - Bandi-Russell noise variance estimate. Empty if user
%                                           supplies bandwidth.
%                   DEBIASEDNOISEVARIANCE - Bias adjusted estimate of the noise variance.
%                   IQESTIMATE            - Estimate of IQ used. Empty if not needed. Empty if user
%                                           supplies bandwidth.
%
% COMMENTS:
%   For best results:
%     - Use prices sampled close to the highest frequency available, if not using 'BusinessTime' and
%     - If using calendar time sampling, sample close to the limit of the data availability (e.g. 5-15
%       seconds for a stock that trades a few thousand times per day)
%     - When sampling less frequently (e.g. 5 - 30 minutes) standard realized variance is
%       probably more appropriate
%     - The debiased version should be preferred to the standard version
%
% EXAMPLE:
%  % Default usage with 'BusinessTime' sampling with interval 1 and automatic bandwidth selection
%  [RVTS,RVTSSS,RVTSD,RVTSSSD] = realized_twoscale_variance(PRICE)
%
%  % 5-tick two-scale variance with automatic bandwidth selection
%  [RVTS,RVTSSS,RVTSD,RVTSSSD] = realized_twoscale_variance(PRICE,TIME,'wall','BusinessTime',5)
%
%  % Two scale variance with a bandwidth of 30 sampling at every tick
%  options = realized_options('Twoscale');
%  options.bandwidth = 30;
%  [RVTS,RVTSSS,RVTSD,RVTSSSD] = realized_twoscale_variance(PRICE,TIME,'wall','BusinessTime',1,0,options)
%
%  % 5-tick two-scale variance with automatic bandwidth selection and dense subsampling
%  [RVTS,RVTSSS,RVTSD,RVTSSSD] = realized_twoscale_variance(PRICE,TIME,'wall','BusinessTime',5,4)
%
%  See also REALIZED_OPTIONS, REALIZED_NOISE_ESTIMATE, REALIZED_VARIANCE,
%  REALIZED_VARIANCE_OPTIMAL_SAMPLING, REALIZED_RANGE, REALIZED_QUANTILE_VARIANCE

% Copyright: Kevin Sheppard
% kevin.sheppard@economics.ox.ac.uk
% Revision: 1    Date: 5/1/2008

%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Input Checking
%%%%%%%%%%%%%%%%%%%%%%%%%%%%
switch nargin
    case 1
        m = length(price);
        time = linspace(9.5*3600,16*3600,m)';
        timeType = 'seconds';
        samplingType = 'businesstime';
        samplingInterval = 1;
        subsamples = 1;
        options = realized_options('twoscale');
    case 5
        subsamples = 1;
        options = realized_options('twoscale');
    case 6
        options = realized_options('twoscale');
    case 7
        % Nothing
    otherwise
        error('One, five, six or seven inputs required.')
end
samplingType=lower(samplingType);
timeType=lower(timeType);
[errorMessage, options] = realized_twoscale_variance_parameter_check(price,time,timeType,samplingType,samplingInterval,subsamples,options);

if ~isempty(errorMessage )
    error(errorMessage)
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Input Checking
%%%%%%%%%%%%%%%%%%%%%%%%%%%%

logPrice = log(price);
filteredLogPrice = realized_price_filter(logPrice,time,timeType,samplingType,samplingInterval);
%options.bandwidth= 60;
if isempty(options.bandwidth)
    % Estimate the optimal bandwidth if not provided
    [noiseVariance, debiasedNoiseVariance, IQEstimate] = realized_noise_estimate(price, time, timeType, options);
    diagnostics.noiseVariance=noiseVariance;
    diagnostics.debiasedNoiseVariance=debiasedNoiseVariance;
    diagnostics.IQEstimate=IQEstimate;
    % Select the correct noise variance estimate
    if options.useDebiasedNoise
        selectedNoiseVariance = debiasedNoiseVariance;
    else
        selectedNoiseVariance = noiseVariance;
    end
    % Compute the bandwidth
    n = length(filteredLogPrice) - 1;
    cOpt = ((12 * selectedNoiseVariance^2) / IQEstimate)^(1/3);
    options.bandwidth = ceil(cOpt * n^(2/3));
end

bandwidth = ceil(options.bandwidth);
if bandwidth<2
    warning('oxfordRealized:smallBandwidth','The selected bandwidth is less then 2, and RTVS is not well defined in this case.  Setting bandwidth to 2 and proceeding.')
    bandwidth = 2;
end
diagnostics.bandwidth = bandwidth;

n = length(filteredLogPrice) - 1;
K = bandwidth;
nbar = (n - K + 1) / K;
[RV,count,naturalCount] = overlap_realized_variance(filteredLogPrice,K);
overlapScale = count / naturalCount;
RVq = RV / overlapScale;
RV1 = overlap_realized_variance(filteredLogPrice,1);
% Eq. 55
rvts = RVq - nbar/n * RV1;
% Eq. 64
rvtsD = (1-nbar/n)^(-1)*rvts;

% Subsampled RVq and RV1
subsampledLogPrices = realized_subsample(logPrice,time,timeType,samplingType,samplingInterval,subsamples);
rvqs = zeros(subsamples,1);
rv1s = zeros(subsamples,1);
totalCount  = 0;
totalCount0 = 0;
for i=1:subsamples
    filteredLogPrice =  subsampledLogPrices{i};
    [RV,count] = overlap_realized_variance(filteredLogPrice,K);
    rvqs(i) = RV;
    totalCount = totalCount + count;
    if i==1
        baseCount = count;
    end
    [rv1s(i),count] = overlap_realized_variance(filteredLogPrice,1);
    totalCount0 = totalCount0 + count;
    if i==1
        baseCount0 = count;
    end
end
RVqSS = sum(rvqs) * (baseCount / totalCount);
% RVq is now based on all overlapping blcoks, so need to normalize to the
% non-overlapping case
RVqSS = RVqSS / overlapScale;
RV1SS = sum(rv1s) * (baseCount0 / totalCount0);
rvtsSS = RVqSS - nbar/n * RV1SS;
rvtsSSD = (1-nbar/n)^(-1)*rvtsSS;
end

function [rv,count,naturalCount] = overlap_realized_variance(price,skip)

naturalCount = (length(price)-1)/skip;
m = length(price);
returns = price(1+skip:m) - price(1:m-skip);
count = length(returns);
rv = returns' * returns;

end

function [errorMessage,options] = realized_twoscale_variance_parameter_check(price,time,timeType,samplingType,samplingInterval,subsamples,options)
% Support function for realized_twoscale_variance that does input validation
%
% USAGE:
%   [ERRORMESSAGE,OPTIONS] = realized_variance_optimal_sampling_parameter_check(PRICE,TIME,TIMETYPE,SAMPLINGTYPE,SAMPLINGINVERVAL,OPTIONS)
%
% INPUTS:
%   See realized_variance_optimal_sampling
%
% OUTPUT:
%   ERRORMESSAGE - String containing a description of the error if one is detected.  Empty if no error.
%
% COMMENTS:
%   See realized_options for a description of the other fields in OPTIONS
%
%  See also REALIZED_VARIANCE_OPTIMAL_SAMPLING

% Copyright: Kevin Sheppard
% kevin.sheppard@economics.ox.ac.uk
% Revision: 1    Date: 5/1/2008
errorMessage = [];

if size(price,2)>size(price,1)
    price=price';
end
if size(price,2)>1
    errorMessage = 'PRICE must be a m by 1 vector.';
    return
end
if size(time,2)>size(time,1)
    time=time';
end
if any(diff(time)<0)
    errorMessage = 'TIME must be sorted and increasing';
    return
end
if size(time,2)>1 || length(time)~=length(price)
    errorMessage = 'TIME must be a m by 1 vector.';
    return
end

timeType=lower(timeType);
if ~ismember(timeType,{'wall','seconds','unit'})
    errorMessage = 'TIMETYPE must be one of ''wall'', ''seconds'' or ''unit''.';
    return;
end

samplingType=lower(samplingType);
if ismember(samplingType,{'calendartime','calendaruniform','businesstime','businessuniform'})
    % Must be a scalar integer
    if ~isscalar(samplingInterval) || floor(samplingInterval)~=samplingInterval || samplingInterval<1
        errorMessage = 'SAMPLINGINTERVAL must be a positive integer for the SAMPLINGTYPE selected.';
        return
    end
else
    if size(samplingInterval,2)>size(samplingInterval,1)
        samplingInterval=samplingInterval';
    end
    if ~(any(samplingInterval>=t0) && any(samplingInterval<=tT))
        errorMessage = 'At least one sampling interval must be between min(TIME) and max(TIME) when using ''Fixed'' as SAMPLINGTYPE.';
        return
    end
    if any(diff(samplingInterval)<=0)
        errorMessage = 'When using ''Fixed'' as SAMPLINGTYPE the vector of sampling times in SAMPLINGINTERVAL must be sorted and strictly increasing.';
        return
    end
end

% Options

% List of flat top kernels
flatTopKernelList = {'bartlett','twoscale','2ndorder','epanechnikov',...
    'cubic','multiscale','5thorder','6thorder','7thorder','8thorder','parzen',...
    'th1','th2','th5','th16'};

% List of non flat top kernels
nonFlatTopKernelList = {'nonflatparzen','qs','fejer','thinf','bnhls'};

% Combined kernel list
kernelList = [flatTopKernelList nonFlatTopKernelList];

% Check fields for valid values
optionsFieldNames = fieldnames(options);
% Insert any missing fiedls
defaultOptions = realized_options('Optimal Sampling');
defaultFieldNames = fieldnames(defaultOptions);
missingFields = setdiff(defaultFieldNames,optionsFieldNames);
if ~isempty(missingFields)
    for i = 1:length(missingFields)
        options.(missingFields{i}) = defaultOptions.(missingFields{i});
    end
end

for i=1:length(optionsFieldNames)
    fieldName = optionsFieldNames{i};
    fieldValue = options.(fieldName);
    if ischar(fieldValue)
        fieldValue = lower(fieldValue);
        options.(fieldName) = fieldValue;
    end

    switch fieldName
        case {'medFrequencyKernel'}
            % Member of kernelList
            if ~ismember(fieldValue,kernelList)
                errorMessage = ['OPTIONS.' fieldName ' must be one of the listed types.'];
                return
            end
        case {'medFrequencyBandwidth'}
            % Non-negative scalar
            if ~isempty(fieldValue) && ~isnonnegativescalar(fieldValue)
                errorMessage = ['OPTIONS.' fieldName ' must a non-negative scalar.'];
                return
            end
        case {'useDebiasedNoise','useAdjustedNoiseCount'}
            % Logical or scalar
            if ~islogical(fieldValue) && ~ismember(fieldValue,[0 1])
                errorMessage = 'OPTIONS.useDebiasedNoise must be a logical value.';
                return
            end
        case {'IQEstimationSamplingType','medFrequencySamplingType','noiseVarianceSamplingType'}
            % One of the sampling types
            if ~ismember(fieldValue,{'calendartime','calendaruniform','businesstime','businessuniform','fixed'})
                errorMessage = ['OPTIONS.' fieldName ' must be one of ''CalendarTime'', ''CalendarUniform'', ''BusinessTime'', ''BusinessUniform'' or ''Fixed''.'];
                return
            end
        case {'medFrequencySamplingInterval','noiseVarianceSamplingInterval','IQEstimationSamplingInterval'}
            % Non-negative scalar, less that 1 if timeType is unit
            if isempty(fieldValue) || ~isnonnegativescalar(fieldValue)
                errorMessage = ['OPTIONS.' fieldName ' must be a non-negative scalar between 0 and 1.'];
                return
            end
            if strcmp(timeType,'unit') && fieldValue>1
                errorMessage = ['OPTIONS.' fieldName ' must be less than 1 if TIMETYPE when ''unit''.'];
                return
            end
    end
end

if ~isempty(subsamples)
    if ~isscalar(subsamples) || subsamples<0 || floor(subsamples)~=subsamples
        errorMessage = 'SUBSAMPLES must be a non-negative scalar.';
    end
end
end

function condition = isnonnegativescalar(x)
% Function that returns logical true if that input is a non-empty scalar >=0
condition = ~isempty(x) && isscalar(x) && x>=0;
end


function f = spm_fx_mountaincar(x,v,a,P)
% state equations for mountain car problem
% FORMAT f = spm_fx_mountaincar(x,v,P)
% FORMAT f = spm_fx_mountaincar(x,v,a,P)
% FORMAT f = spm_fx_mountaincar(x,v,P,M)
% x    - [x, x']
% v    - exogenous force
% a    - action
%
% P.a  - 0th order coefficients of force
% P.b  - 1st order coefficients of force
% P.c  - 2nd order coefficients of force
% P.d  - action coefficient
%
% M    - model structure
%
% f    - flow dx/dt
%
% see:
% Gaussian Processes in Reinforcement Learning
% Carl Edward Rasmussen and Malte Kuss
% Max Planck Institute for Biological Cybernetics
% Spemannstraße 38, 72076 T¨ubingen, Germany
% {carl,malte.kuss}@tuebingen.mpg.de
%__________________________________________________________________________
% Copyright (C) 2005 Wellcome Trust Centre for Neuroimaging

% Karl Friston
% $Id: spm_fx_mountaincar.m 7679 2019-10-24 15:54:07Z spm $

% determine controlled forces (a)
%==========================================================================

% spm_fx_mountaincar(x,v,P) - recognition model (no action)
%--------------------------------------------------------------------------
global eta
if isempty(eta), eta = 8; end
if nargin == 3

    P    = a;
    a    = 0;

elseif all(isfield(P,{'f','g'}))

    % spm_fx_mountaincar(x,v,P,M) - generative model (no action)
    %----------------------------------------------------------------------
    P.f;
    P.g;
    M    = P;
    P    = a;
    a    = 0;

end

% default parameters
%--------------------------------------------------------------------------
if isempty(P)
    P.a  = 0;
    P.b  = [0 0];
    P.c  = [0 0 0 0];
    P.d  = 1;
end

% acceleration = force:
%--------------------------------------------------------------------------
x     = x(1:2);
a     = tanh((P.d*a + P.a + P.b*x + P.c*kron(x,x))/2);

% f(x)
%--------------------------------------------------------------------------
dt    = 1/4;
if x(1) < 0                                  % gravity
    dHdx = 2*x(1) + 1;
else
    xx   = x(1)^2;
    dHdx = (5*xx + 1).^(-3/2) + (x(1)/2).^4;
end
f     = [x(2); a + v - dHdx - x(2)/eta]*dt;

return

% NOTES: Plots for figure
%--------------------------------------------------------------------------
dx    = 1/64;
x     = linspace(-2,2,1/dx);
xx    = x.^2;
dHdx  = (x < 0).*(2*x + 1);
dHdx  = (x > 0).*((5*xx + 1).^(-3/2) + (x/2).^4) + dHdx;
H     = cumsum(dHdx)*dx;
H     = H - min(H);

subplot(2,2,1)
plot(x,H,x.^0,H,':')
xlabel('position','FontSize',12)
ylabel('height','FontSize',12)
title('mountain car problem','FontSize',16)
axis square

subplot(2,2,2)
plot(x,-dHdx,x,x*0,'-.',x,-x.^0,'--')
xlabel('position','FontSize',12)
ylabel('force','FontSize',12)
title('forces','FontSize',16)
axis square


function [v,faces] = generateUnitCells(xy,unitCell,varargin)
% generate a list of patches according to spatial coordinates and the unitCell
%
% Input
%  xy       - midpoints of the cells
%  unitCell - spatial coordinates of the unit cell
%
% Ouput
%  v     - list of vertices
%  faces - list of faces

% compute the vertices
x = reshape(bsxfun(@plus,xy(:,1),unitCell(:,1).'),[],1);
y = reshape(bsxfun(@plus,xy(:,2),unitCell(:,2).'),[],1);

% remove equal points
% in general every measurment point generates 4 or 6 vertex points
% some of them apear multiple times
% lets try to reduce them

if ~check_option(varargin,'noStripes')
  eps = abs(diff(unitCell));
  eps = eps(eps > max(eps(:))/10);
  eps = min(eps) / 12;
  [~,m,n] = unique(round([x-min(x) y-min(y)]./eps),'rows');
else
  [~,m,n] = uniquetol([x-min(x) y-min(y)],0.01/sqrt(size(xy,1)),'ByRows',true );
end

v = [x(m) y(m)];

% set faces
faces = reshape(n, [], size(unitCell,1));

% tic
% [~,m,n] = unique(round([x-min(x) y-min(y)]./eps),'rows');
% toc

%%
% tic
% [~,m,n] = uniquetol([x-min(x) y-min(y)],0.01/sqrt(size(xy,1)),'ByRows',true );
% toc


function [f] = elec_fit_ellipse_optim(r, X, Y, Z, xo, yo, zo)

% elec_fit_ellipse_optim - Optimization for elec_fit_ellipse.m
%
% Called from elec_fit_ellipse.m
%

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

% Licence:  GNU GPL, no implied or express warranties
% History:  02/2002, Darren.Weber_at_radiology.ucsf.edu
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% r is a 3x1 vector of radius values for each x,y,z axis component of ellipse
%
% equation of ellipsoid with center (xo,yo,zo) and radius for each axis (x,y,z) = (a,b,c):
% (( x - xo )^2 / a^2) + (( y - yo )^2 / b^2) + (( z - zo )^2 / c^2) = 1
%
% This function below creates a scalar value to
% return to the fminsearch function in elec_fit_sphere.

E = ( (X-xo).^2 )/r(1).^2 + ((Y-yo).^2)/r(2).^2 + ((Z-zo).^2)/r(3).^2  - 1;

f = sum( E .* E );  % sum of squares returned

return


function cvt_1d_sampling ( n, it_num, s_num )

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

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

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

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

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

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

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

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

  for it = 1 : it_num

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

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

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

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

    j = 1;
    g_new(j) = 0.0;

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

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

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

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

  end

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

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

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

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

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

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

  for i = 1 : ns

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

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

      while ( 1 )

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

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

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

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

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

      while ( 1 )

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

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

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

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

    end

  end

  return
end
function timestamp ( )

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

  return
end


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

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

lnp = log(p);

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

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

p_ = exp(lnp_);

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

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

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

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

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


function pyramid_num_test ( )

%*****************************************************************************80
%
%% PYRAMID_NUM_TEST tests PYRAMID_NUM.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 December 2014
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'PYRAMID_NUM_TEST\n' );
  fprintf ( 1, '  PYRAMID_NUM computes the pyramidal numbers.\n' );
  fprintf ( 1, '\n' );

  for n = 1 : 10
    fprintf ( 1, '  %2d  %6d\n', n, pyramid_num ( n ) );
  end

  return
end


function [fx,dF_dX,dF_dTheta] = f_lin1D(Xt,Theta,ut,inF)
% dummy 2D linear evolution function

deltat = inF.delta_t;

try
    a = inF.a.^-1;
catch
    a = 1;
end
try
    [uu,dudtheta] = feval(inF.u_fname,Theta(2:end),ut(2:end),inF);
catch
    uu = 0;
    if size(Theta,1) > 1
        dudtheta = zeros(size(Theta,1)-1,1);
    else
        dudtheta = [];
    end
end

A = -a.*exp(Theta(1));
fx = Xt + deltat.*(A*Xt + ut(1) + uu);
dF_dX = 1 + deltat.*A;
dF_dTheta = deltat.*([Xt*A;zeros(size(Theta,1)-1,1)] + [0;dudtheta]);


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

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

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

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

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

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

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

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

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

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

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

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

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


function c8_tan_test ( )

%*****************************************************************************80
%
%% C8_TAN_TEST tests C8_TAN.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 February 2015
%
%  Author:
%
%    John Burkardt
%
  seed = 123456678;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'C8_TAN_TEST\n' );
  fprintf ( 1, '  C8_TAN computes the tangent of a C8.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, ...
    '       C1=C8_UNIFORM_01          C2 = C8_TAN(C1)           C3 = C8_ATAN(C1)\n' );
  fprintf ( 1, '     ---------------------     ---------------------     ---------------------\n' );
  fprintf ( 1, '\n' );

  for test = 1 : 10

    [ c1, seed ] = c8_uniform_01 ( seed );
    c2 = c8_tan ( c1 );
    c3 = c8_atan ( c2);

    fprintf ( 1, '  (%12f  %12f)  (%12f  %12f)  (%12f  %12f)\n', ...
      real ( c1 ), imag ( c1 ), real ( c2 ), imag ( c2 ), real ( c3 ), imag ( c3 ) );

  end

  return
end


function tests = test_lansvd
  tests = functiontests(localfunctions);
end

function A = mat_simple1_1(n)
    m = 200;
    if nargin < 1
        n = 50;
    end
    U0 = orth(randn(m));
    V0 = orth(randn(n));
    S0 = zeros(m, n);
    for i=1:n
        S0(i,i) = m / (i);
    end
    A = U0*S0*V0';
end

function verify_lansvd(A, k, testCase)
    S1 = svds(A, k);
    options.verbosity = 0;
    options.tolerance = 16 * eps;
    options.k = k;
    S2 = spx.fast.lansvd(A, options);
    verifyEqual(testCase, S1, S2, 'RelTol', 1e-9);

    [U1, S1, V1] = svds(A, k);
    S1 = diag(S1);
    [U2, S2, V2] = spx.fast.lansvd(A, options);
    verifyEqual(testCase, S1, S2, 'RelTol', 1e-9);
    verifyEqual(testCase, spx.la.nonorthogonality(U2), 0, 'AbsTol', 1e-9);
    verifyEqual(testCase, spx.la.nonorthogonality(V2), 0, 'AbsTol', 1e-9);
    % TODO this tolerance is very high
    verifyEqual(testCase, abs(U1), abs(U2), 'AbsTol', 1e-5);
    % verifyEqual(testCase, abs(V1), abs(V2), 'AbsTol', 1e-12);
end

function verify_lansvd_func_handle(A, k, testCase)
    S.A = @(x)  A *x;
    S.At = @(x)  (x' * A)';
    [M, N] = size(A);
    S.M = M;
    S.N = N;

    S1 = svds(A, k);
    options.verbosity = 0;
    options.tolerance = 16 * eps;
    options.k = k;
    S2 = spx.fast.lansvd(S, options);
    verifyEqual(testCase, S1, S2, 'RelTol', 1e-9);

    [U1, S1, V1] = svds(A, k);
    [U2, S2, V2] = spx.fast.lansvd(S, options);
    verifyEqual(testCase, S1, S2, 'RelTol', 1e-9);
    verifyEqual(testCase, spx.la.nonorthogonality(U2), 0, 'AbsTol', 1e-10);
    verifyEqual(testCase, spx.la.nonorthogonality(V2), 0, 'AbsTol', 1e-10);
    verifyEqual(testCase, abs(U1), abs(U2), 'AbsTol', 1e-12);
    verifyEqual(testCase, abs(V1), abs(V2), 'AbsTol', 1e-12);
end

function verify_lansvd_svt(A, lambda, testCase)
    options.verbosity = 0;
    options.tolerance = 16 * eps;
    options.lambda = lambda;
    S2 = spx.fast.lansvd(A, options);
    k = numel(S2);
    S1 = svds(A, k+1);
    % verify that the singular value after k-th one is smaller than the threshold
    verifyTrue(testCase, S1(k+1) <= lambda);
    verifyEqual(testCase, S1(1:k), S2, 'RelTol', 1e-9);
end

function test_simple_cases(testCase)
    A = [];
    verify_lansvd(A, 1, testCase);
    A = [2.4];
    verify_lansvd(A, 1, testCase);
end

function test_single_row(testCase)
    A = [1 2 3];
    verify_lansvd(A, 1, testCase);
    verify_lansvd_func_handle(A, 1, testCase);
end

function test_single_col(testCase)
    A = [1 2 3]';
    verify_lansvd(A, 1, testCase);
end

function test_1(testCase)
    verify_lansvd(spx.data.mtx_mkt.abb313, 4, testCase);
    verify_lansvd(spx.data.mtx_mkt.abb313, 10, testCase);
end

function test_2(testCase)
    verify_lansvd(spx.data.mtx_mkt.illc1850, 4, testCase);
    verify_lansvd(spx.data.mtx_mkt.illc1850, 10, testCase);
end

function test_3(testCase)
    verify_lansvd(mat_simple1_1(20), 4, testCase);
end

function test_4(testCase)
    verify_lansvd(mat_simple1_1(50), 10, testCase);
end

function test_cryg10000(testCase)
    verify_lansvd(spx.data.mtx_mkt.cryg10000, 4, testCase);
    verify_lansvd(spx.data.mtx_mkt.cryg10000, 10, testCase);
end

function test_abb313_svt(testCase)
    verify_lansvd_svt(spx.data.mtx_mkt.abb313, 7.51, testCase);
end

function test_illc1850_svt(testCase)
    %TODO . The test should pass at much lower thresholds
    verify_lansvd_svt(spx.data.mtx_mkt.illc1850, 1.5, testCase);
end


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

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

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

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

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

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

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

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

end

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


function [no,fc]=gridsurf(x,y,z, varargin)
%
% [no,fc]=gridsurf(x,y,z)
%    or
% [no,fc]=gridsurf(x,y,z, opt)
% [no,fc]=gridsurf(x,y,z, 'param1', value1, 'param2', value2, ...)
%
% convert a grid-shaped surface (used as input for surf) to a quad or triangular mesh
%
% author: Qianqian Fang, <q.fang at neu.edu>
%
% input:
%   x,y,z: parameter used as the input for surf()/mesh()
%   : a surface mesh triangle list (ne x 3)
%   opt: a list of optional parameters, currently surfacenorm supports:
%        'Type': [3|4|int] if set to 3 (default), output triangular mesh; if set to 4,
%                output a quad mesh where fc is an Nx4 array; otherwise,
%                output a quad mesh where fc is a cell array
%        'Nodup': [0|1] if set to 0 (default), no duplicated nodes in x/y/z are removed;
%                if set to 1, duplicated nodes are removed
%
% output:
%   no: output surface node coordinates
%   fc: output surface connections - if 'type' set to 3 or 4, fc is a numerical array,
%       otherwise, fc is a cell array with each element containing 4 integers
%
% -- this function is part of iso2mesh toolbox (http://iso2mesh.sf.net)
%

opt=varargin2struct(varargin{:});

s=size(x);
if(~all(s==size(y) & s==size(z)))
    error('x/y/z must be a 2D array of the same size');
end

no=[x(:),y(:),z(:)];
nodelen=size(no,1);
fc=zeros((s(1)-1)*s(2),4);
row=[(1:s(1)-1)', (2:s(1))', (s(1)+2:2*s(1))', (s(1)+1:2*s(1)-1)'];

for i=0:s(2)-1
    fc(i*(s(1)-1)+1:(i+1)*(s(1)-1),:)=row+i*s(1);
end

fc(fc>nodelen)=fc(fc>nodelen)-nodelen;

if(jsonopt('nodup',0,opt))
    [no,fc]=removedupnodes(no,fc);
end

outputtype=jsonopt('type',3,opt);
if(outputtype==3)
    fc=[fc(:,[1 2 3]); fc(:,[1 3 4])];
elseif(outputtype==4)
    fc=num2cell(fc,2);
end


function linpack_z_test04 ( )

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

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

  m = ml + mu + 1;

  seed = 123456789;

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

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

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

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

  return
end


function [ptbifu, ptroot] = points_init(bw)

% This function initializes the feature points from the binary image

[M, N]= size(bw);
imdim = M*N + 1;

Neighbor = [-M, 1, M, -1, -1-M, 1-M,  1+M, -1+M];
Len = prod(size(Neighbor));

seeds = find(bw == 1);
npix = prod(size(seeds));
countmap = zeros(size(bw));

for k =1:npix
    localidx = seeds(k);
    neighidx = localidx + Neighbor;
    for i=1:Len
        idx = neighidx(i);
        if (idx>0) & (idx<imdim) & (bw(idx) ==1)
            countmap(localidx) = countmap(localidx)+1;
        end
    end
end

% The bifurcation candidates may connect, but only the central is true
% bifurcation point
bw1 = (countmap>=3);
[labelmap, numlabel] = bwlabel(bw1, 8);
for i=1:numlabel
    candidates = find(labelmap==i);
    ptbifu(i) = candidates(fix((end+1)/2));
end

ptroot = find(countmap == 1);

ptbifu = ptbifu(:);
ptroot = ptroot(:);


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

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

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

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

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

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

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

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

for lev=1:num_levels

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

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

        % we can add other downsampling methods here

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

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

        % we can add other graph reduction methods here

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

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

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

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

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

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

end

end


% RPCA (De la Torre and Black, 2001)
% process_video('RPCA', 'RPCA', 'dataset/demo.avi', 'output/demo_RPCA.avi');
sizeim = [params.rows params.cols];
[L,S] = RPCA(M,sizeim);


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

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

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

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

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

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

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

%[N E Zone]
echo off

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


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

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

% this function implements algorithm 2.4.1

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

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

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

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

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

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

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

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

        %go for next period
    end

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

    % go for next iteration
end

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


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%DENSE LUCAS KANADE PYRAMIDAL + ITERATIVE REFINMENT
%J.MARZAT - ENSEM / INRIA Rocquencourt (France) julien.marzat@gmail.com
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%Data acquisition
im1=single((imread('yos_img_10.pgm')));
im2=single((imread('yos_img_11.pgm')));
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%parameters : levels number, window size, iterations number, regularization
numLevels=3;
window=9;
iterations=1;
alpha = 0.001;

hw = floor(window/2);
t0=clock;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%pyramids creation
pyramid1 = im1;
pyramid2 = im2;
%init
for i=2:numLevels
    im1 = impyramid(im1, 'reduce');
    im2 = impyramid(im2, 'reduce');
    pyramid1(1:size(im1,1), 1:size(im1,2), i) = im1;
    pyramid2(1:size(im2,1), 1:size(im2,2), i) = im2;
end;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%Processing all levels
for p = 1:numLevels

    %current pyramid
    im1 = pyramid1(1:(size(pyramid1,1)/(2^(numLevels - p))), 1:(size(pyramid1,2)/(2^(numLevels - p))), (numLevels - p)+1);
    im2 = pyramid2(1:(size(pyramid2,1)/(2^(numLevels - p))), 1:(size(pyramid2,2)/(2^(numLevels - p))), (numLevels - p)+1);

    %init
    if p==1
    u=zeros(size(im1));
    v=zeros(size(im1));
    else
    %resizing
    u = 2 * imresize(u,size(u)*2,'bilinear');
    v = 2 * imresize(v,size(v)*2,'bilinear');
    end

    %refinment loop
    for r = 1:iterations

    u=round(u);
    v=round(v);

    %every pixel loop
        for i = 1+hw:size(im1,1)-hw
            for j = 1+hw:size(im2,2)-hw
            patch1 = im1(i-hw:i+hw, j-hw:j+hw);

            %moved patch
            lr = i-hw+v(i,j);
            hr = i+hw+v(i,j);
            lc = j-hw+u(i,j);
            hc = j+hw+u(i,j);

                  if (lr < 1)||(hr > size(im1,1))||(lc < 1)||(hc > size(im1,2))
                  %Regularized least square processing
                  else
                  patch2 = im2(lr:hr, lc:hc);

                  fx = conv2(patch1, 0.25* [-1 1; -1 1]) + conv2(patch2, 0.25*[-1 1; -1 1]);
                  fy = conv2(patch1, 0.25* [-1 -1; 1 1]) + conv2(patch2, 0.25*[-1 -1; 1 1]);
                  ft = conv2(patch1, 0.25*ones(2)) + conv2(patch2, -0.25*ones(2));

                  Fx = fx(2:window-1,2:window-1)';
                  Fy = fy(2:window-1,2:window-1)';
                  Ft = ft(2:window-1,2:window-1)';

                  A = [Fx(:) Fy(:)];
                  G=A'*A;

                  G(1,1)=G(1,1)+alpha; G(2,2)=G(2,2)+alpha;
                  U=1/(G(1,1)*G(2,2)-G(1,2)*G(2,1))*[G(2,2) -G(1,2);-G(2,1) G(1,1)]*A'*-Ft(:);
                  u(i,j)=u(i,j)+U(1); v(i,j)=v(i,j)+U(2);
                  end
            end
        end
    end
    etime(clock,t0)
end

%resizing
u=u(window:size(u,1)-window+1,window:size(u,2)-window+1);
v=v(window:size(v,1)-window+1,window:size(v,2)-window+1);

%colormap display
figure(1)
RGB1=showmap3(u,v,5);
imshow(RGB1);


% 3D Example for Multilevel Mass-Preserving Image Registration using VAMPIRE
%
% (c) Fabian Gigengack and Lars Ruthotto 2011/02/04, see FAIR.2 and FAIRcopyright.m.
% http://www.uni-muenster.de/EIMI/
% http://www.mic.uni-luebeck.de/
%
%   - data                 Cardiac gated PET images of a mouse heart.
%                          (level 4:6, full resolution: 40x40x40)
%                          Images show the heart in systole and diastole.
%   - viewer               viewImage3D
%   - interpolation        splineInterMex (regularizer='moments', theta=0.01)
%   - distance             SSD
%   - pre-registration     none
%   - regularizer          mfHyperElastic
%   - optimizer            Gauss-Newton with ArmijoBacktrack linesearch
%
% Acknowledgement:
% ----------------
% Thanks to the European Institute for Molecular Imaging (EIMI) and SFB 656,
% University of Muenster, Germany for supplying this interesting data.

setup3DmouseData

% prepare the plot
FAIRplots('clear')
Dshow = @(T,R,omega,m) viewIP(abs(T-R),omega,m,'colormap',gray(256));
FAIRplots('set','Dshow',Dshow);

% set the regularizer
alpha       = 1;
alphaLength = 1;
alphaArea   = 0.1;
alphaVolume = 2;
regularizer('reset', 'regularizer', 'mfHyperElastic', 'alpha', alpha, ...
    'alphaLength', alphaLength, ...
    'alphaArea',   alphaArea, ...
    'alphaVolume', alphaVolume);

% finally: run the MultiLevel Non-Parametric Image Registration
NPIRpara            = optPara('NPIR-GN');
NPIRpara.lineSearch = @ArmijoDiffeomorphic;
NPIRpara.solver     = @VAMPIREsolveGN_PCG;

[yc,wc,his] = MLIR(ML, 'NPIRobj', @VAMPIRENPIRobjFctn, ...
    'parametric', false, 'NPIRpara', NPIRpara);

%% Plot results
% Compute resulting image: dataT(yc) * det(D(yc))
Topt = reshape(linearInter(dataT,omega,center(yc,m)) .* geometry(yc,m,'Jac','omega',omega), m);

figure(1); clf;
subplot(2,2,1)
viewSlices(dataT,omega,m);
title('dataT, template');

subplot(2,2,2)
viewSlices(dataR,omega,m);
title('dataR, reference');

subplot(2,2,3)
viewSlices(Topt,omega,m);
title('dataT(y).*detDy');

subplot(2,2,4)
viewSlices((Topt-dataR),omega,m);
title('final residual');


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

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

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

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


function hd = DirectionCalulate(X1,Y1,X2,Y2)
    hd=rem(atan2d(Y2-Y1,X2-X1)+360, 360);
end


function k = findcols(A, b)
%FINDCOLS Find indices of a given column within a matrix.
%
%   FINDCOLS(A, B) returns a row vector with the indices of the columns
%   in the matrix A that are identical to the column vector B.  If no
%   columns in A are identical to B, an empty vector is returned.
%
%   The methods uses a for-loop, but it uses less memory and is in many
%   cases a lot faster than the vectorized methods
%
%      find( all( A == repmat(b, 1, size(A, 2)), 1 ) )
%      find( all( A == b(:,ones(size(A, 2), 1)), 1 ) )
%
%   See also FIND, FINDROWS.

%   Author:      Peter J. Acklam
%   Time-stamp:  2002-03-03 13:51:19 +0100
%   E-mail:      pjacklam@online.no
%   URL:         http://home.online.no/~pjacklam

   k = find( A(1,:) == b(1) );
   for j = 2:size(A, 1)
      k = k( A(j,k) == b(j) );
      if isempty(k)
         return
      end
   end


function h = plot_tensor_field(H, M, options)

% plot_tensor_field - display a tensor field
%
%   h = plot_tensor_field(H, M, options);
%
%   options.sub controls sub-sampling
%   options.color controls color
%
%   Copyright (c) 2006 Gabriel Peyre

if nargin<3
    options.null = 0;
end
if not( isstruct(options) )
    sub = options;
    clear options;
    options.sub = sub;
end

% sub = getoptions(options, 'sub', 1);
sub = getoptions(options, 'sub', round(size(H,1)/30) );
color = getoptions(options, 'color', 'r');

if nargin<2
    M = [];
end

if not(isempty(M)) && size(M,3)==1
    M = repmat(M, [1 1 3]); % ensure B&W image
end

if size(H,3)==3 && size(H,4)==1
    H = cat(3, H(:,:,1), H(:,:,3), H(:,:,3), H(:,:,2) );
    H = reshape(H, size(H,1), size(H,2), 2, 2);
    if 0
    % flip the main eigen-axes
    [e1,e2,l1,l2] = perform_tensor_decomp(H);
    H = perform_tensor_recomp(e2,e1,l1,l2);
    end
    h = plot_tensor_field(H, M, sub);
    return;
end

% swap X and Y axis
%%% TODO
a = H(:,:,2,2);
H(:,:,2,2) = H(:,:,1,1);
H(:,:,1,1) = a;

hold on;
if ~isempty(M)
    imagesc(rescale(M)); drawnow;
end
h = fn_tensordisplay(H(:,:,1,1),H(:,:,1,2), H(:,:,2,2), 'sub', sub, 'color', color);
axis image; axis off;
colormap jet(256);
% hold off;

function h = fn_tensordisplay(varargin)

% function h = fn_tensordisplay([X,Y,]Txx,Txy,Tyy[,'sigma',sigma][,'sub',sub][,color][,patch options...]])
% function h = fn_tensordisplay([X,Y,]e[,'sigma',sigma][,'sub',sub][,color][,patch options...]])

% X,Y,Txx,Txy,Tyy
if isstruct(varargin{1}) || isstruct(varargin{3})
    if isstruct(varargin{1}), nextarg=1; else nextarg=3; end
    e = varargin{nextarg};
    Txx = e.ytyt;
    Txy = -e.ytyx;
    Tyy = e.yxyx;
    if nextarg==1
        [nj ni] = size(Txx);
        [X Y] = meshgrid(1:ni,1:nj);
    else
        [X Y] = deal(varargin{1:2});
    end
    nextarg = nextarg+1;
else
    [nj ni] = size(varargin{3});
    if nargin<5 || ischar(varargin{4}) || ischar(varargin{5}) || any(size(varargin{5})~=[nj ni])
        [X Y] = meshgrid(1:ni,1:nj);
        nextarg = 1;
    else
        [X Y] = deal(varargin{1:2});
        nextarg = 3;
    end
    [Txx Txy Tyy] = deal(varargin{nextarg:nextarg+2});
    nextarg = nextarg+3;
end
if any(size(X)==1), [X Y] = meshgrid(X,Y); end
[nj,ni] = size(X);
if any(size(Y)~=[nj ni]) || ...
        any(size(Txx)~=[nj ni]) || any(size(Txy)~=[nj ni]) || any(size(Tyy)~=[nj ni])
    error('Matrices must be same size')
end
% sigma, sub, color
color = 'r';
while nextarg<=nargin
    flag = varargin{nextarg};
    nextarg=nextarg+1;
    if ~ischar(flag), color = flag; continue, end
    switch lower(flag)
        case 'sigma'
            sigma = varargin{nextarg};
            nextarg = nextarg+1;
            switch length(sigma)
                case 1
                    sigmax = sigma;
                    sigmay = sigma;
                case 2
                    sigmax = sigma(1);
                    sigmay = sigma(2);
                otherwise
                    error('sigma definition should entail two values');
            end
            h = fspecial('gaussian',[ceil(2*sigmay) 1],sigmay)*fspecial('gaussian',[1 ceil(2*sigmax)],sigmax);
            Txx = imfilter(Txx,h,'replicate');
            Txy = imfilter(Txy,h,'replicate');
            Tyy = imfilter(Tyy,h,'replicate');
        case 'sub'
            sub = varargin{nextarg};
            nextarg = nextarg+1;
            switch length(sub)
                case 1
                    [x y] = meshgrid(1:sub:ni,1:sub:nj);
                    sub = y+nj*(x-1);
                case 2
                    [x y] = meshgrid(1:sub(1):ni,1:sub(2):nj);
                    sub = y+nj*(x-1);
            end
            X = X(sub); Y = Y(sub);
            Txx = Txx(sub); Txy = Txy(sub); Tyy = Tyy(sub);
            [nj ni] = size(sub);
        case 'color'
            color = varargin{nextarg};
            nextarg = nextarg+1;
        otherwise
            break
    end
end
% options
options = {varargin{nextarg:end}};

npoints = 50;
theta = (0:npoints-1)*(2*pi/npoints);
circle = [cos(theta) ; sin(theta)];
Tensor = cat(3,Txx,Txy,Txy,Tyy);        % jdisplay x idisplay x tensor
Tensor = reshape(Tensor,2*nj*ni,2);     % (display x 1tensor) x 2tensor
Ellipse = Tensor * circle;              % (display x uv) x npoints
Ellipse = reshape(Ellipse,nj*ni,2,npoints);         % display x uv x npoints
XX = repmat(X(:),1,npoints);                        % display x npoints
YY = repmat(Y(:),1,npoints);                        % display x npoints
U  = reshape(Ellipse(:,1,:),nj*ni,npoints);         % display x npoints
V  = reshape(Ellipse(:,2,:),nj*ni,npoints);         % display x npoints
umax = max(U')'; vmax = max(V')';
umax(umax==0)=1; vmax(vmax==0)=1;
if ni==1, dx=1; else dx = X(1,2)-X(1,1); end
if nj==1, dy=1; else dy = Y(2,1)-Y(1,1); end
fact = min(dx./umax,dy./vmax)*.35;
fact = repmat(fact,1,npoints);
U = XX + fact.*U;
V = YY + fact.*V;

%-----------
MM = mmax(Txx+Tyy);
mm = mmin(Txx+Tyy);
[S1, S2] = size(U);
Colormap = zeros(S2, S1, 3);
Map = colormap(jet(256));
for k =1:npoints
    Colormap(k,:,1) = Map(floor(255*(Txx(:)+Tyy(:)-mm)/(MM-mm)) + 1, 1);
    Colormap(k,:,2) = Map(floor(255*(Txx(:)+Tyy(:)-mm)/(MM-mm)) + 1, 2);
    Colormap(k,:,3) = Map(floor(255*(Txx(:)+Tyy(:)-mm)/(MM-mm)) + 1, 3);
end
%-----------
%h = fill(U',V',color,'EdgeColor',color,options{:});
h = fill(U',V',Colormap,'EdgeColor', 'interp');

axis ij;

if nargout==0, clear h, end

function a=mmax(a)
a = max(a(:));
function a=mmin(a)
a = min(a(:));


function plotFunc()
  colors = ['r'; 'b';'m';'g'];
  lineWidth=2;
  markerSize=20;
  sigmas = [2.5, 5, 10];

  hold on;
  legendStrs = {};
  x=-20:0.2:20;
  for ii=1:length(sigmas)
    sigma = sigmas(ii);
    y = exp(-0.5*(x/sigma).^2);
    plot(x, y, colors(ii), 'MarkerSize', markerSize, 'linewidth', lineWidth);
    legendStrs{end+1} = ['\sigma=' num2str(sigma)];
  end

  % legend
  fontsize = 12;
  legendLocation = 'Best'; % 'NorthWest'; %
  legend(legendStrs,'FontSize', fontsize, 'Location', legendLocation);
end


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

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

   fprintf('Newton:\n')

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

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

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

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


function stroud_test335 ( )

%*****************************************************************************80
%
%% TEST335 tests SPHERE_SHELL_03_ND.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 April 2009
%
%  Author:
%
%    John Burkardt
%
  global FUNC_ND_INDEX;

  n_max = 3;

  num = function_nd_num ( );

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST335\n' );
  fprintf ( 1, '  For integrals inside a spherical shell in ND:\n' );
  fprintf ( 1, '  SPHERE_SHELL_03_ND approximates the integral.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  We compare these results with those computed by\n' );
  fprintf ( 1, '  from the difference of two ball integrals:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  BALL_F1_ND approximates the integral;\n' );
  fprintf ( 1, '  BALL_F3_ND approximates the integral.\n' );
  fprintf ( 1, '\n' );

  for j = 1 : 2

    if ( j == 1 )
      r1 = 0.0;
      r2 = 1.0;
      xc(1:n_max) = 0.0;
    else
      r1 = 2.0;
      r2 = 3.0;
      xc(1:n_max) = [ 1.0, -1.0, 2.0 ];
    end

    for n = 2 : n_max

      fprintf ( 1, '\n' );
      fprintf ( 1, '  Spatial dimension N = %d\n', n );
      fprintf ( 1, '  Sphere center:\n' );
      for i = 1 : n
        fprintf ( 1, '  %12f', xc(i) );
      end
      fprintf ( 1, '\n' );
      fprintf ( 1, '  Inner sphere radius = %f\n', r1 );
      fprintf ( 1, '  Outer sphere radius = %f\n', r2 );
      fprintf ( 1, '  Spherical shell volume = %f\n', ...
        sphere_shell_volume_nd ( n, r1, r2 ) );
      fprintf ( 1, '\n' );
      fprintf ( 1, '\n' );
      fprintf ( 1, '    Rule:      #3       F1(R2)-F1(R1)  F3(R2)-F3(R1)\n' );
      fprintf ( 1, '    F(X)\n' );
      fprintf ( 1, '\n' );

      for i = 1 : num

        FUNC_ND_INDEX = i;

        result1 = sphere_shell_03_nd ( 'function_nd', n, xc, r1, r2 );

        result3 = ball_f1_nd ( 'function_nd', n, xc, r1 );
        result4 = ball_f1_nd ( 'function_nd', n, xc, r2 );

        result5 = ball_f3_nd ( 'function_nd', n, xc, r1 );
        result6 = ball_f3_nd ( 'function_nd', n, xc, r2 );

        fname = function_nd_name ( i );

        fprintf ( 1, '  %s  %12f  %12f  %12f\n', ...
          fname, result1, result4-result3, result6-result5 );

      end

    end

  end

  return
end


% add the path of RBM code
addpath('..');
addpath('~/work/Algorithms/liblinear-1.7/matlab');

% load MNIST
load 'mnist_14x14.mat';

% shuffle the training data
perm_idx = randperm (size(X,1));

n_all = size(X, 1);
n_train = ceil(n_all * 3 / 4);
n_valid = floor(n_all /4);

X_valid = X(perm_idx(n_train+1:end), :);
X_valid_labels = X_labels(perm_idx(n_train+1:end));
X = X(perm_idx(1:n_train), :);
X_labels = X_labels(perm_idx(1:n_train));

layers = [size(X,2), 200, 100, 50, 2];
n_layers = length(layers);
blayers = [1, 1, 1, 1, 0];

use_tanh = 0;
do_pretrain = 1;

if do_pretrain
    Ds = cell(n_layers - 1, 1);
    H = X;
    H_valid = X_valid;

    for l = 1:n_layers-1
        % construct DAE and use default configurations
        D = default_dae (layers(l), layers(l+1));

        D.data.binary = blayers(l);
        D.hidden.binary = blayers(l+1);

        if use_tanh
            if l > 1
                D.visible.use_tanh = 1;
            end
            D.hidden.use_tanh = 1;
        else
            if D.data.binary
                mH = mean(H, 1)';
                D.vbias = min(max(log(mH./(1 - mH)), -4), 4);
            else
                D.vbias = mean(H, 1)';
            end
        end

        D.learning.lrate = 1e-1;
        D.learning.lrate0 = 5000;
        D.learning.weight_decay = 0.0001;
        D.learning.minibatch_sz = 128;

        D.valid_min_epochs = 10;

        D.noise.drop = 0.2;
        D.noise.level = 0;

        %D.adagrad.use = 1;
        %D.adagrad.epsilon = 1e-8;
        D.adagrad.use = 0;
        D.adadelta.use = 1;
        D.adadelta.epsilon = 1e-8;
        D.adadelta.momentum = 0.99;

        D.iteration.n_epochs = 500;

        % save the intermediate data after every epoch
        D.hook.per_epoch = {@save_intermediate, {sprintf('dae_mnist_%d.mat', l)}};

        % print learining process
        D.verbose = 0;
        % display the progress
        D.debug.do_display = 0;

        % train RBM
        fprintf(1, 'Training DAE (%d)\n', l);
        tic;
        D = dae (D, H, H_valid, 0.1);
        fprintf(1, 'Training is done after %f seconds\n', toc);

        H = dae_get_hidden(H, D);
        H_valid = dae_get_hidden(H_valid, D);

        Ds{l} = D;
    end
end

S = default_sdae (layers);

S.data.binary = blayers(1);
S.bottleneck.binary = blayers(end);
S.hidden.use_tanh = use_tanh;

S.hook.per_epoch = {@save_intermediate, {'sdae_mnist.mat'}};

S.learning.lrate = 1e-1;
S.learning.lrate0 = 5000;
%S.learning.momentum = 0.9;
S.learning.weight_decay = 0.0001;
S.learning.minibatch_sz = 128;

%S.noise.drop = 0.2;
%S.noise.level = 0;
S.adadelta.use = 1;
S.adadelta.epsilon = 1e-8;
S.adadelta.momentum = 0.99;

%S.adagrad.use = 1;
%S.adagrad.epsilon = 1e-8;
S.valid_min_epochs = 10;

S.iteration.n_epochs = 100;

if do_pretrain
    for l = 1:n_layers-1
        S.biases{l+1} = Ds{l}.hbias;
        S.W{l} = Ds{l}.W;
    end
else
    if S.data.binary
        mH = mean(X, 1)';
        S.biases{1} = min(max(log(mH./(1 - mH)), -4), 4);
    else
        S.biases{1} = mean(X, 1)';
    end
end

fprintf(1, 'Training sDAE\n');
tic;
S = sdae (S, X, X_valid, 0.1);
fprintf(1, 'Training is done after %f seconds\n', toc);

H = sdae_get_hidden (X, S);
save 'sdae_mnist_vis.mat' H X_labels;

vis_mnist;


% TEST_THICL_LSHAPED_MP_G_NMNN: data function for Neumann boundary condition.

function g = test_thick_Lshaped_mp_g_nmnn(x, y, z, ind)
  switch (ind)
   case {1, 4}
     g = cos(z) .* exp(x) .* (sin(x.*y) + y .* cos(x.*y));
   case {2, 3}
     g = -x .* exp(x) .* cos(x.*y) .* cos(z);
   case {5}
     g = -cos(z) .* exp(x) .* (sin(x.*y) + y .* cos(x.*y));
   case {6}
     g = x .* exp(x) .* cos(x.*y) .* cos(z);
   case {7}
     g = exp(x) .* sin(x.*y) .* sin(z);
   case {8}
     g = - exp(x) .* sin(x.*y) .* sin(z);
   otherwise
    error('g_nmnn: error in the reference number for the boundary')
  end
end


%PRTESTC Test routine for the PRTOOLS classifier
%
% This script tests a given, untrained classifier w, defined in the
% workspace, e.g. w = my_classifier. The goal is to find out whether
% w fulfills all the requirements of a PRTools classifier.
%

if exist('w') ~= 1 | ~ismapping(w) | ~isuntrained(w)
	error('No untrained classifier w found')
end

m = 50;
a = gendath([m,m]);
a = setprior(a,0);
[b,c] = gendat(a,0.5);
name = getname(w);
if (isempty(name))
	error('No name found for the untrained classifier.')
end

disp('')
disp(['     Testing Classifier ' name])
disp(['     ------------------ '])
v = b*w;
newfig(1,3);
scatterd(b);
plotc(v);
if (isempty(getname(v)))
	disp('No name found for the classifier.')
end
disp('Classification error for the Higleyman data: ')
disp(c*v*testc)

disp('Direct output: ')
disp(c(1:5,:)*v)

disp('Classifier output: ')
disp(c(1:5,:)*v*classc)

disp('Soft labels, classification error: ')
a = gendath([m,m],'soft');
a = setprior(a,0);
[b,c] = gendat(a,0.5);
disp(c*(b*w)*testc);

newfig(2,3);
learnsizes = [3,5,7,10,15];
e = cleval(w,b,learnsizes,2,c);
plote(e)
a = gendatm(repmat(20,1,8));
a = setprior(a,0);
[b,c] = gendat(a,0.5);
newfig(3,3)
scatterd(b)
u = b*w;
plotc(u)
disp('Classification error for a multi-class problem: ')
disp(c*u*testc)

if (isaffine(v))
	load nist16_38
	a = prdataset(a);
	v = a*w;
	newfig(6,3);
	show(v);
end


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   % repeat until values are obtained for T+h
   end

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

% then go for next iteration
end


function lspec = lyapspec(ts, dim, delay, NNR, eps, Nref)

ts = ts(:);
N = length(ts) - dim*delay;
ref = 1:delay:min(N,(1+(Nref-1)*delay));

[nn, dists, points] = emb_nn_search(ts(1:(end-delay)), [dim delay], ref, NNR+1, -1);

Q = diag(ones(dim,1));
lspec = [];zeros(dim, 1);

for i=1:length(ref)
	X = points(nn(i,:), :);
	X0 = mean(X);		% center of gravity
	Y = X - repmat(X0, NNR+1, 1);
	[U,W,V] = svd(Y);
	w = diag(W) / sum(diag(W));
	k = max(find(w >= eps));
	V = V(:,1:k);
	Z = Y * V;

	images = ts(dim*delay+nn(i,:));
	%all(points(nn(i,:)+delay,1) == images);

	a = [Z ones(NNR+1,1)] \ images;

	b = a(end);
	a = a(1:end-1);
	c = V * a;

	%mean(abs(images-(X * c + ( b - X0 * c))) ./ abs(images))

	JAC = sparse([ones(1,dim) 2:dim], [1:dim 1:dim-1], [c' ones(1, dim-1)]);
	%full(JAC);

	A =  JAC * Q;
	[Q,R,E] = qr(A);

	lspec = [lspec; diag(R)'];
end

lspec = mean(log(abs(lspec(min(length(ref)/10,500):end,:))));


function distance = word_distance(word1, word2, model)
% Shows the L2 distance between word1 and word2 in the word_embedding_weights.
% Inputs:
%   word1: The first word as a string.
%   word2: The second word as a string.
%   model: Model returned by the training script.
% Example usage:
%   word_distance('school', 'university', model);

word_embedding_weights = model.word_embedding_weights;
vocab = model.vocab;
id1 = strmatch(word1, vocab, 'exact');
id2 = strmatch(word2, vocab, 'exact');
if ~any(id1)
  fprintf(1, 'Word ''%s\'' not in vocabulary.\n', word1);
  return;
end
if ~any(id2)
  fprintf(1, 'Word ''%s\'' not in vocabulary.\n', word2);
  return;
end
word_rep1 = word_embedding_weights(id1, :);
word_rep2 = word_embedding_weights(id2, :);
diff = word_rep1 - word_rep2;
distance = sqrt(sum(diff .* diff));


% SPINV_LDLCHOL - Evaluate the sparse inverse matrix given the LDL
%                 decomposition.
%
% For a sparse symmetric positive definite matrix C,
%
%   Z = SPINV(LD)
%
% where LD = LDLCHOL(C) and [Z]_ij = [inv(C)]_ij for such ij that [C]_ij
% is non-zero.
%
% See Vanhatalo and Vehtari (2008) for details.

% Copyright (c) 2008      Jarno Vanhatalo

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

function Z = spinv_ldlchol(LD)

Z = spinv(LD, 1);
return

    n = size(LD,1);

    % The mex-file was not available, so evaluate the sparse inverse here

    % TODO:
    % For now, just evaluate the matrix A and then run..
    %[L,D] = ldlsplit(LD);
    %A = L*D*L';

    if nargin < 2
      q = 1:n;
    end

    %[LD, p, q] = ldlchol(A);

    [I,J,ld] = find(LD);
    temp = [I(:) J(:) ; J(:) I(:)];
    temp = sortrows(unique(temp,'rows'),2);
    Iz = temp(:,1); Jz = temp(:,2);

    % Find the column starting points
    a1=zeros(n,1);
    a2 = cumsum(histc(J,1:n));
    a1(1) = 1; a1(2:end) = a2(1:end-1) + 1;
    az1=zeros(n,1);
    az2 = cumsum(histc(Jz,1:n));
    az1(1) = 1; az1(2:end) = az2(1:end-1) + 1;

    for j=1:n
        indaz{j} = az1(j):az2(j);
        indIz{j} = Iz(indaz{j})';
    end

    % Evaluate the sparse inverse
    z = zeros(size(Iz));
    z(end) = 1./ld(end);
    % Allocate memory
    cindit=zeros(n,1);
    for jj = n-1:-1:1
        fil = ld(a1(jj)+1:a1(jj+1)-1);
        fi = I(a1(jj)+1:a1(jj+1)-1);
        lfi = length(fi);
        Zt = zeros(lfi,lfi);
        indz = cumsum(histc(indIz{jj},[0 ; fi]));
        indz = az1(jj) + indz(1:end-1);

        i4=0;
        for i1 = 1:lfi
            cind1=indaz{fi(i1)};
            Icind1=indIz{fi(i1)};
            indfi = lfi;
            i2=length(Icind1);
            go = true;
            while go
                if Icind1(i2)==jj  % Find the indeces for the jj'th rows in fi columns
                    i4=i4+1;
                    cindit(i4)=cind1(i2);
                    go = false;
                end
                if indfi >= 1 && fi(indfi) == Icind1(i2) % Find the indeces for the fi'th rows in i2'nd columns
                    Zt(indfi,i1) = z(cind1(i2));
                    indfi = indfi-1;
                end
                i2 = i2-1;
            end
        end
        % remove extras
        cindi=cindit(1:i4);

        zij = -fil'*Zt;
        z(cindi) = zij;
        z(indz) = zij;
        zij = 1./ld(a1(jj)) - fil'*z(indz);
        z(az1(jj)-1+find(indIz{jj}==jj,1)) = zij;
    end

    Z = sparse(Iz,Jz,z);
    r(q) = 1:n;
    Z = Z(r,r);

end