% program demo_tutor.m
%
% P.M.T. Broersen, July 2004
%                  June 2005
% P.M.T. Broersen, November 2007

% see also demo_armasa for extensive example
%          demo_simple for basic example PSD and autocorrelation computation
%
%   Background information can be found in

%   Book:
%   Piet M.T. Broersen
%   Automatic Autocorrelation and Spectral Analysis
%   Springer-Verlag,London, 2006.
%   ISBN 1-84628-328.

%   Journal paper:
%   P. M. T. Broersen, Automatic Spectral Analysis with
%   Time Series Models, IEEE Transactions on Instrumentation
%   and Measurement, Vol. 51, No. 2, April 2002, pp. 211-216.
%
%   and many papers given in ARMASA info.txt

clc,
close all
clear all
echo on

% Generate stationary AR en MA polynomials a and b from reflection coefficients smaller than 1
% By taking reflection coefficients between -1 and +1, stationary invertible
% models are guaranteed with all poles and zeros inside the unit circle
% Reflection coefficients are transformed into parameters with rc2arset:
%

a = rc2arset([1 .3 .3])

b = rc2arset([1 -.9])

% From reflection coefficients to parameters and vice versa
[dum rc] = ar2arset(a)

N = 500;

% Generating data by starting with initial zeros is a poor idea.
% Simuarma generates N stationary data, with the asymptotical properties
% applicable from the first observation

data = simuarma(a,b,N);

% Compute and select time series models,
% with asel and bsel as parameters of the selected model
% Compute the accuracy of the selected model type and the best alternative
% model types and put them in sellog

[asel bsel sellog] = armasel(data)

% Compute the accuracy of the estimated model in comparison with
% the true process with the parameters a and b

ME = moderr(asel,bsel,a,b,N)

% Compute and plot the autocorrelation functions and spectra of the
% generating true model and the ARMAsel selected model.
% gain is the power gain or the ratio between output and input variance of ARMA process
% The length of the correlation function is chosen as 50.
%
[cortrue gain] = arma2cor(a,b,50);
corsel = arma2cor(asel,bsel,50);
[psdtrue fas] = arma2psd(a,b);
psdsel = arma2psd(asel,bsel);

echo off

figure(1),
plot(data),
xlabel('\rightarrow time axis [s]')
title([int2str(N),' ARMA(2,1) observations'])

figure(2),
plot(0:50,cortrue,0:50,corsel,'r')
title('True and estimated autocorrelation function')
xlabel('\rightarrow time lag [s]')
legend('true','estimated')

figure(3),
subplot(121),
plot(fas,psdtrue,fas,psdsel,'r')
title('True and estimated spectrum')
xlabel('\rightarrow normalized frequency \it{f/f_s}'),
legend('true','estimated',2)
ylabel('Lineair scale for PSD'),
axis tight
subplot(122),
semilogy(fas,psdtrue,fas,psdsel,'r')
title('True and estimated spectrum')
xlabel('\rightarrow normalized frequency \it{f/f_s}'),
legend('true','estimated',4)
ylabel('Log scale for PSD'),
axis tight,
subplot,

figure(4),
echo on

% The spectra on a linear scale are hardly to discern for high frequencies.
% That improves with a logaritmic scale.
% The frequency axis is between 0 and fs/2, where fs is the sampling frequency.
% Very often, fs is taken as 1 without mentioning it.
%
% Investigate the accuracy as estimated by ARMAsel for all models
% That accuracy is stored in sellog in pe_est files
% The accuracy of all models can be interpreted as the language of random data
%
% This example demonstrates how axis can be generated automatically for a
% properly scaled plot of the prediction errors
%
plot(sellog.ar.cand_order,sellog.ar.pe_est)
title('Estimated model accuracies as a function of model order and type')
xlabel('\rightarrow model order \itr')
ylabel('\rightarrow normalized model accuracy')
minar=min(sellog.ar.pe_est);
as2=axis;
as2(3)=.9*minar;
as2(4)=sellog.ar.pe_est(end);
axis(as2);
hold on,
plot(sellog.ma.cand_order,sellog.ma.pe_est,'r')
plot(sellog.arma.cand_ar_order,sellog.arma.pe_est,'g')
legend('AR(\itr\rm)','MA(\itr\rm)','ARMA(\itr,r\rm-1)',4),
hold off,

% A similar result in one line can be obtained with plotpe(sellog),
% where sellog is the third output argument of armasel

plotpe(sellog)

% Retrieve the reflection coefficients of the longest AR model that has been used in ARMAsel
% The longest AR model is allways saved as ASAglob_rc!!
%
% Recent versions of ARMASA (after 2008) save that model additionally as sellog.ar.rcarlong
%
rcarlong = ASAglobretr('ASAglob_rc');

% Determine the highest AR order that has been estimated with ARMAsel.
% Transform reflection coefficients rcarlong into a parameter vector.
% Plot spectrum (PSD) and autocorrelation function of selected and of long model.
%
% The correlation function and the PSD of the long model arlong
% are very irregular.
% Selection of the model order and type gives results with only
% statisatically significant details included.
%
maximum_order = length(rcarlong)-1
arlong = rc2arset(rcarlong);
corlang = arma2cor(arlong,1,50);
psdlang = arma2psd(arlong,1); echo off

% In arma2cor and arma2psd, 1 is used as the second parameter vector.
% That is the MA vector for true AR processes.
% The programs expect both an AR and a MA parameter vector.
% The first element of the parameter vector must always be 1.
% That can be the only parameter of the vector.

figure,
plot(0:50,cortrue,0:50,corsel,0:50,corlang)
title('True and estimated autocorrelation function')
xlabel('\rightarrow time lag [s]'),
legend('true','estimated','ARlong')

% Linear and logarithmic spectra of the same data demonstrate a strong
% preference for logarithmic plots of the PSD (power spectral density)

figure,
subplot(121),
plot(fas,psdtrue,fas,psdsel,fas,psdlang)
title('True and estimated spectrum')
xlabel('\rightarrow normalized frequency \it{f/f_s}'),
legend('true','estimated','ARlong',2)
ylabel('Linear scale for PSD'),
axis tight
subplot(122),
semilogy(fas,psdtrue,fas,psdsel,fas,psdlang)
title('True and estimated spectrum')
xlabel('\rightarrow normalized frequency \it{f/f_s}'),
legend('true','estimated','ARlong',4)
ylabel('Log scale for PSD'),
axis tight,
subplot

echo on

% Demo of variation of input variables for candidate orders
% Computation of models with prescribed type and order
%
echo off
disp('AR(10) with ar10 = armasel(data,10,0,0)')
ar10 = armasel(data,10,0,0),           % AR(10)
disp(' ')
disp('AR selected from orders between 2 and 20 with arselect= armasel(data,2:20,0,0)')
arselect = armasel(data,2:20,0,0),    % AR(selected between candidate orders 2 and 20)
disp(' ')
disp('AR(10) with ar10fromarlong = rc2arset(rcarlong,10)')
ar10fromarlong = rc2arset(rcarlong,10) % AR(10) computed with first 10 reflection coefficients
disp(' ')
disp('MA(6) model with ma6 = armasel(data,0,6,0)')
[dummy ma6] = armasel(data,0,6,0),     % MA(6)
disp(' ')
disp('ARMA(2,1) model with  armasel(data,0,0,2)')
[ar2 ma1] = armasel(data,0,0,2),       % ARMA(2,1)
disp(' ')
disp('ARMA(4,3) model with  armasel(data,0,0,4)')
[ar4 ma3] = armasel(data,0,0,4),       % ARMA(4,3)
disp(' ')
disp('Selection between candisdates AR(2), MA(3) and ARMA(5,4) with  armasel(data,2,3,5)')
[arx brx] = armasel(data,2,3,5)        % selects between the candidates AR(2), MA(3) and ARMA(5,4)
disp(' ')

% Accuracy of these models and of the selected model

disp(['ARMAsel selected from all candidates for N = ',int2str(N),' observations: ARMA(', ...
    int2str(length(asel)-1),',',int2str(length(bsel)-1),')'])
ME_selected = moderr(asel,bsel,a,b,N)
ME_ar10 = moderr(ar10,1,a,b,N)
ME_ma6 = moderr(1,ma6,a,b,N)
ME_arma21 = moderr(ar2,ma1,a,b,N)
ME_arma43 = moderr(ar4,ma3,a,b,N)
ME_arlong = moderr(arlong,1,a,b,N)

echo on,

% Prediction of the observations after the data with the selected model with arma2pred
% Lpred is the prediction horizon
% Normalizing the accuracy with the power gain
% Take care because the mean has been subtracted automatically,
% it should be added again for a correct prediction of the future
% pred_acc is the variance of the predictions
% asel and bsel have been found before with armasel in line 35
%
Lpred = 15
[pred pred_acc] = arma2pred(asel,bsel,data,Lpred);
[corsel gainsel]= arma2cor(asel,bsel)
pred_acc = pred_acc*std(data)^2/gainsel; echo off

figure,
plot(0:Lpred,[data(end) pred+mean(data)],'r*',1:Lpred, ...
    pred+1.96*sqrt(pred_acc)+mean(data),1:Lpred,pred-1.96*sqrt(pred_acc)+mean(data))
title('Prediction for \it{t > N} \rmof continuation of data \it{x_n}\rm , with 95 % confidence interval')
xlabel('\rightarrow Prediction starting with the last observation \it{x_N} \rmof the data')

echo on,

%
% Using reduced statistics
%
% REDUCED STATISTICS REDUCED STATISTICS REDUCED STATISTICS REDUCED STATISTICS
%_____________________________________________________________________________
%
% Computes the best model for the data if only a long AR model is available
% and the sample size N of the observations that were used to compute the long AR model
% Generally, there is a only small difference between ARMA models estimated from data and
% ARMA models estimated with reduced statistics.
%
%
% S. de Waele
% Automatic Spectral Analysis,
% This and more extensions of ARMASA can be found under
% spectral analysis at the download address
% http: www.mathworks.com/matlabcentral/fileexchange/

% Also programs for equidistant data where some data are missing can be
% found and programs for irregular data, all at various places in
% http: www.mathworks.com/matlabcentral/fileexchange/
% by the authors Piet Broersen and Stijn de Waele
%
% An error message can be found if the additional software is not down loaded
%
echo off

try
    disp('The model selected from armasel applied to the data was')
    asel
    bsel
    disp(' ')
    disp('    [asel_rs bsel_rs sellog_rs] = armasel_rs(arlong,N)  gives:')
    disp(' ')
    [asel_rs bsel_rs sellog_rs] = armasel_rs(arlong,N)
    disp(' ')
    disp('   The accuracy of the selected reduced statistics model')
    ME_rs = moderr(asel_rs,bsel_rs,a,b,N)
    disp(' ')
    disp('  The difference between the selected data model and the reduced statistics model')
    ME_dif = moderr(asel_rs,bsel_rs,asel,bsel,N)

    disp(' ')
    disp(' Computation of the ARMA(3,2) model with the reduced statistics algorithm')
    disp(' ')
    [a_rs b_rs sellog32_rs] = armasel_rs(arlong,N,0,0:1,3) %ARMA(3,2)
    disp(' ')
    disp('   The accuracy of the ARMA(3,2) model')
    ME_arma32_rs = moderr(a_rs,b_rs,a,b,N)

    % some care is required for giving a fixed MA or ARMA order in armasel_rs
    % using only candidate order 0 might give error messages
    % the example shows how those messages are suppressed
catch
    disp(' The program armasel_rs requires additional software of Stijn de Waele')
    disp(' Automatic Spectral Analysis')
    disp(' This can be found under spectral analysis at the download address')
    disp(' http: www.mathworks.com/matlabcentral/fileexchange/')
end


function point_num = sparse_grid_f2s_size ( dim_num, level_max )

%*****************************************************************************80
%
%% SPARSE_GRID_F2S_SIZE sizes a sparse grid using Fejer Type 2 Slow rules.
%
%  Discussion:
%
%    The grid is defined as the sum of the product rules whose LEVEL
%    satisfies:
%
%      0 <= LEVEL <= LEVEL_MAX.
%
%    This calculation is much faster than a previous method.  It simply
%    computes the number of new points that are added at each level in the
%    1D rule, and then counts the new points at a given DIM_NUM dimensional
%    level vector as the product of the new points added in each dimension.
%
%    This approach will work for nested families, and may be extensible
%    to other families, and to mixed rules.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 December 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer LEVEL_MAX, the maximum value of LEVEL.
%
%    Output, integer POINT_NUM, the total number of unique
%    points in the grids.
%

%
%  Special case.
%
  if ( level_max < 0 )
    point_num = 0;
    return
  end

  if ( level_max == 0 )
    point_num = 1;
    return
  end
%
%  Construct the vector that counts the new points in the 1D rule.
%
  new_1d = zeros ( level_max+1, 1 );

  new_1d(0+1) = 1;

  p = 1;
  o = 1;

  for l = 1 : level_max
    p = 2 * l + 1;
    if ( o < p )
      new_1d(l+1) = o + 1;
      o = 2 * o + 1;
    else
      new_1d(l+1) = 0;
    end
  end
%
%  Count the number of points by counting the number of new points
%  associated with each level vector.
%
  level_1d = zeros ( dim_num, 1 );

  point_num = 0;

  for level = 0 : level_max

    more = 0;
    h = 0;
    t = 0;

    while ( 1 )

      [ level_1d, more, h, t ] = comp_next ( level, dim_num, level_1d, more, h, t );

      point_num = point_num + prod ( new_1d(level_1d(1:dim_num)+1) );

      if ( ~more )
        break
      end

    end

  end

  return
end


function himmelblau_test ( )

%*****************************************************************************80
%
%% HIMMELBLAU_TEST works with the Himmelblau function.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 January 2012
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'HIMMELBLAU_TEST:\n' );
  fprintf ( 1, '  Test COMPASS_SEARCH with the Himmelblau function.\n' );
  m = 2;
  delta_tol = 0.00001;
  delta = 0.3;
  k_max = 20000;

  x = [ 1.0, 1.0 ];
  r8vec_print ( m, x, '  Initial point X0:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X0) = %g\n', himmelblau ( m, x ) );

  [ x, fx, k ] = compass_search ( @himmelblau, m, x, delta_tol, delta, k_max );
  r8vec_print ( m, x, '  Estimated minimizer X1:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X1) = %g, number of steps = %d\n', fx, k );

  x = [ -1.0, 1.0 ];
  r8vec_print ( m, x, '  Initial point X0:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X0) = %g\n', himmelblau ( m, x ) );

  [ x, fx, k ] = compass_search ( @himmelblau, m, x, delta_tol, delta, k_max );
  r8vec_print ( m, x, '  Estimated minimizer X1:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X1) = %g, number of steps = %d\n', fx, k );

  x = [ -1.0, -1.0 ];
  r8vec_print ( m, x, '  Initial point X0:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X0) = %g\n', himmelblau ( m, x ) );

  [ x, fx, k ] = compass_search ( @himmelblau, m, x, delta_tol, delta, k_max );
  r8vec_print ( m, x, '  Estimated minimizer X1:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X1) = %g, number of steps = %d\n', fx, k );

  x = [ 1.0, -1.0 ];
  r8vec_print ( m, x, '  Initial point X0:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X0) = %g\n', himmelblau ( m, x ) );

  [ x, fx, k ] = compass_search ( @himmelblau, m, x, delta_tol, delta, k_max );
  r8vec_print ( m, x, '  Estimated minimizer X1:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X1) = %g, number of steps = %d\n', fx, k );
%
%  Demonstrate Himmelblau minimizers.
%
  x = [ 3.0, 2.0 ];
  r8vec_print ( m, x, '  Correct Himmelblau minimizer X1*:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X*) = %g\n', himmelblau ( m, x ) );

  x = [ 3.58439, -1.84813 ];
  r8vec_print ( m, x, '  Correct Himmelblau minimizer X2*:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X*) = %g\n', himmelblau ( m, x ) );

  x = [ -3.77934, -3.28317 ];
  r8vec_print ( m, x, '  Correct Himmelblau minimizer X3*:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X*) = %g\n', himmelblau ( m, x ) );

  x = [ -2.80512,  3.13134 ];
  r8vec_print ( m, x, '  Correct Himmelblau minimizer X4*:' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  F(X*) = %g\n', himmelblau ( m, x ) );

  return
end


% QQDIAGRAM - Empirical quantile-quantile diagram.
%
% Description:
%               The quantiles (percentiles) of the input distribution Y are plotted (Y-axis)
%               against the corresponding quantiles of the input distribution X.
%               If only X is given, the corresponding quantiles are plotted (Y-axis)
%               against the quantiles of a Gaussian distribution ('Normal plot').
%               Two black dots indicate the lower and upper quartiles.
%               If the data in X and Y belong the same distribution the plot will be linear.
%               In this case,the red and black reference lines (.-.-.-.-) will overlap.
%               This will be true also if the data in X and Y belong to two distributions with
%               the same shape, one distribution being rescaled and shifted with respect to the
%               other.
%               If only X is given, a line is plotted to indicate the mean of X, and a segment
%               is plotted to indicate the standard deviation of X. If the data in X are normally
%               distributed, the red and black reference lines (.-.-.-.-) will overlap.
%
% Usage:
%   >>  ah  =  qqdiagram( x, y, pk );
%
% Inputs:
%   x       - vector of observations
%
% Optional inputs:
%   y       - second vector of observation to compare the first to
%   pk      - the empirical quantiles will be estimated at the values in pk [0..1]
%
% Author: Luca Finelli, CNL / Salk Institute - SCCN, 20 August 2002
%
% Reference: Stahel W., Statistische Datenanalyse, Vieweg, Braunschweig/Wiesbaden, 1995
%
% See also:
%   QUANTILE, SIGNALSTAT, EEGLAB

% Copyright (C) 2002 Luca Finelli, Salk/SCCN, La Jolla, CA
%
% Reference: Stahel, W. Statistische Datenanalyse, Vieweg, Braunschweig/Wiesbaden 1995
%
% This file is part of EEGLAB, see http://www.eeglab.org
% for the documentation and details.
%
% Redistribution and use in source and binary forms, with or without
% modification, are permitted provided that the following conditions are met:
%
% 1. Redistributions of source code must retain the above copyright notice,
% this list of conditions and the following disclaimer.
%
% 2. Redistributions in binary form must reproduce the above copyright notice,
% this list of conditions and the following disclaimer in the documentation
% and/or other materials provided with the distribution.
%
% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
% THE POSSIBILITY OF SUCH DAMAGE.

function qqdiagram( x , y, pk )

if nargin < 1
	help qqdiagram;
	return;
end;

if (nargin == 3 && (any(pk > 1) || any(pk < 0)))
    error('qqdiagram(): elements in pk must be between 0 and 1');
end

if nargin==1
	y=x;
	nn=max(1000,10*length(y))+1;
	x=randn(1,nn);
end

if nargin < 3
	nx=sum(~isnan(x));
	ny=sum(~isnan(y));
   	k=min(nx,ny);
    pk=((1:k) - 0.5) ./ k;  % values to estimate the empirical quantiles at
else
    k=length(pk);
end

if nx==k
    xx=sort(x(~isnan(x)));
else
    xx=quantile(x(~isnan(x)),pk);
end

if ny==k
    yy=sort(y(~isnan(y)));
else
    yy=quantile(y(~isnan(y)),pk);
end

% QQ diagram
plot(xx,yy,'+')
hold on

% x-axis range
maxx=max(xx);
minx=min(xx);
rangex=maxx-minx;
xmin=minx-rangex/50;
xmax=maxx+rangex/50;

% Quartiles
xqrt1=quantile(x,0.25); xqrt3=quantile(x,0.75);
yqrt1=quantile(y,0.25); yqrt3=quantile(y,0.75);

plot([xqrt1 xqrt3],[yqrt1 yqrt3],'k-','LineWidth',2); % IQR range

% Drawing the line
sigma=(yqrt3-yqrt1)/(xqrt3-xqrt1);
cy=(yqrt1 + yqrt3)/2;

if nargin ==1
    maxy=max(y);
    miny=min(y);
    rangey=maxy-miny;
	ymin=miny-rangey/50;
	ymax=maxy+rangey/50;

	plot([(miny-cy)/sigma (maxy-cy)/sigma],[miny maxy],'r-.') % the line
    % For normally distributed data, the slope of the plot line
    % is equal to the ratio of the standard deviation of the distributions
	plot([0 (maxy-mean(y))/std(y)],[mean(y) maxy],'k-.') % the ideal line

	xlim=get(gca,'XLim');
	plot([1 1],[ymin  mean(y)+std(y)],'k--')
	plot([1 1],[mean(y)  mean(y)+std(y)],'k-','LineWidth',2)
        % textx = 1.0;
        % texty = mean(y)+3.0*rangey/50.0;
	% text(double(textx), double(texty),' St. Dev.','horizontalalignment','center')
    set(gca,'xtick',get(gca,'xtick'));  % show that vertical line is at 1 sd
	plot([0 0],[ymin  mean(y)],'k--')
	plot(xlim,[mean(y) mean(y)],'k--')
	% text(double(xlim(1)), double(mean(y)+rangey/50),'Mean X')
	plot([xqrt1  xqrt3],[yqrt1 yqrt3],'k.','MarkerSize',10)
	set(gca,'XLim',[xmin xmax],'YLim',[ymin ymax])
	xlabel('Standard Normal Quantiles')
	ylabel('X Quantiles')
else
    cx=(xqrt1 + xqrt3)/2;
    maxy=cy+sigma*(max(x)-cx);
	miny=cy-sigma*(cx-min(x));

	plot([min(x) max(x)],[miny maxy],'r-.'); % the line
    xlabel('X Quantiles');
    ylabel('Y Quantiles');
end


function det = r8po_det ( n, a_lu )

%*****************************************************************************80
%
%% R8PO_DET computes the determinant of a matrix factored by R8PO_FA.
%
%  Discussion:
%
%    The R8PO storage format is appropriate for a symmetric positive definite
%    matrix and its inverse.  (The Cholesky factor of a R8PO matrix is an
%    upper triangular matrix, so it will be in R8GE storage format.)
%
%    Only the diagonal and upper triangle of the square array are used.
%    This same storage scheme is used when the matrix is factored by
%    R8PO_FA, or inverted by R8PO_INVERSE.  For clarity, the lower triangle
%    is set to zero.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 March 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%
%    Input, real A_LU(N,N), the LU factors from R8PO_FA.
%
%    Output, real DET, the determinant of A.
%
  det = 1.0E+00;

  for i = 1 : n
    det = det * a_lu(i,i);
  end

  return
end


function y = quadcc(fun,a,b,tol)
%QUADCC   Numerical integration using Clenshaw-Curtis quadrature.
%   Y = QUADCC(FUN,A,B) estimates the definite integral of the
%   function FUN from A to B, using an adaptive Clenshaw-Curtis
%   quadrature scheme.  FUN is either a MATLAB expression written
%   as a string or inline function, or a function M-file.  A and
%   B are the lower and upper limits of integration, respectively.
%
%   QUADCC computes the integral by recursively dividing the interval
%   (A,B) into finer subintervals, defined by the zero-points of the
%   Type 1 Chebyshev polynomials.  The recursion continues until
%   either (1) the difference between computed estimates of the
%   integral in successive recursion steps falls below a tolerance
%   (default TOL = 1e-6), or (2) the integral domain has been
%   divided into 1024 subintervals.  A warning is returned if the
%   maximum number of subintervals is reached before the tolerance
%   criterion is met.
%   Y = QUADCC(FUN,A,B,TOL) uses the supplied value of TOL instead
%   of the default.
%
%   QUADCC provides limited handling of certain types of improper
%   integral.  If the integrand has a pole at one (or both) of the
%   integration limits, QUADCC returns a warning and attempts to
%   evaluate the integral by shifting the integration limit a
%   distance EPS inside the integration interval.  If QUADCC
%   encounters a pole inside the integration interval, an error is
%   produced.
%
%   Examples:
%
%       1) String expression
%            Y = quadcc('1./(x.^2-5)',-1,2)
%
%       2) Inline function
%            foo = inline('x.*sin(x)')
%            Y = quadcc(foo,0,2*pi)
%
%       3) Function M-file
%            Y = quadcc(@foo,0,1)
%            with foo.m a function M-file:
%
%            function y = foo(x)
%            y = tan(x);
%
%   See also  QUAD, QUADL, DBLQUAD, TRIPLEQUAD, INLINE

%   References
%   ----------
%   "Numerical Recipes in C. The Art of Scientific Computing, 2nd edition".
%   W. H. Press, S. A. Teukolsky, W. T. Vetterling, and B. P. Flannery.
%   Cambridge Unversity Press, 2002.

% Paul Fricker  12/09/2002

if a==b
    y = 0;
    return
end

if ~exist('tol')
    tol = 1e-6;
end

% Make sure 'fun' is an inline function
f = fcnchk(fun);

% Initialize by breaking the integration interval into four regions.
N = 4;
p = (b+a)/2;
q = (b-a)/2;
% Write out [ cos((0:4)/4*pi) ] explicitly to avoid cos(pi/2) roundoff
x = p-q*[1 0.7071067811865475 0 -0.7071067811865475 -1];
F = feval(f,x);

% Simple attempt to handle improper integral
if isinf(F(1))
    F(1) = feval(f,x(1)+eps);
    warning('QUADCC:improperLower', ...
            ['Improper integral: Integrand has pole ' ...
             'at lower integration limit.'])
end

if isinf(F(5))
    F(5) = feval(f,x(5)-eps);
    warning('QUADCC:improperUpper', ...
            ['Improper integral: Integrand has pole ' ...
             'at upper integration limit.'])
end

% Modify the first and last terms of 'F'.
F(1) = F(1)/2;
F(end) = F(end)/2;

% Call the integrator function recursively
[y,warn] = intcc(f,x,F,N,p,q,tol,Inf);

if warn==1
    warning('QUADCC:MaxSubDivide', ...
            ['Computation terminated before tolerance criterion (TOL = ' num2str(tol) ') was met.'])
end

% EOF 'quadcc'

function [y,warn] = intcc(f,x,F,N,p,q,tol,yinit)
% INTCC Recursive integrator function for the QUADCC routine.
%
% Input parameters:
% f     : Integrand
% x     : Chebyshev polynomial zero-points between the integration limits (a,b)
% F     : Values of 'f' evaluated at 'x'
% N     : Initial number of zero-points ('discretization')
% p,q   : Endpoint parameters (from integration limits)
% tol   : Integration tolerance (terminates the recursion)
% yinit : Estimated value of the integral from the previous pass

% Terminate recursion if integral has not converged before 1024 points
if size(x,2) > 2^10
    warn = 1;
    y = yinit;
    return
else
    warn = 0;
end

% Double the size of the approximation
N = 2*N;
Nvec = 0:N;

x2 = zeros(1,N+1);
x2(1:2:end) = x;
x2(2:2:end) = p-q*cos((1:2:N)/N*pi);

G = zeros(1,N+1);
G(1:2:end) = F;
G(2:2:end) = feval(f,x2(2:2:end));
G = G(:);

if any(isinf(G))
    error('Improper integral: Integrand has a pole between integration limits.')
end

% Evaluate the Chebyshev polynomial coefficients for
% approximating the input function 'f'
M = cos(Nvec(1:2:end-1)'*Nvec/N*pi);
M(abs(M)<eps) = 0;
C = 4/N*M*G;

% Compute the quadrature coefficients
coeffs = -1./Nvec(2:2:end)./(Nvec(2:2:end)-2);
coeffs(1) = 0.5;

% Compute the integral estimate
y = q*coeffs*C;

% Continue recursion if the difference between the current value
% of the integral and the previous value is still above 'tol'.
if abs(y-yinit) > tol
    [y,warn] = intcc(f,x2,G,N,p,q,tol,y);
end

% EOF 'intcc'


function value = f1sd1 ( x )

%*****************************************************************************80
%
%% F1SD1 evaluates the function 1.0D+00/ sqrt ( 1.1 - x**2 ).
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 January 2008
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the argument of the function.
%
%    Output, real VALUE, the value of the function.
%
  f1sd1 = 1.0 / sqrt ( 1.1 - x * x );

  return
end


function [ a_lu, pivot, info ] = r8ge_fa ( n, a )

%*****************************************************************************80
%
%% R8GE_FA performs a LINPACK style PLU factorization of an R8GE matrix.
%
%  Discussion:
%
%    The R8GE storage format is used for a general M by N matrix.  A storage
%    space is made for each logical entry.  The two dimensional logical
%    array is mapped to a vector, in which storage is by columns.
%
%    This is a simplified version of the LINPACK routine DGEFA.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Dongarra, Bunch, Moler, Stewart,
%    LINPACK User's Guide,
%    SIAM, 1979
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%    N must be positive.
%
%    Input, real A(N,N), the matrix to be factored.
%
%    Output, real A_LU(N,N), an upper triangular matrix and
%    the multipliers used to obtain it.  The factorization
%    can be written A = L * U, where L is a product of
%    permutation and unit lower triangular matrices and U
%    is upper triangular.
%
%    Output, integer PIVOT(N), a vector of pivot indices.
%
%    Output, integer INFO, singularity flag.
%    0, no singularity detected.
%    nonzero, the factorization failed on the INFO-th step.
%
  a_lu(1:n,1:n) = a(1:n,1:n);

  info = 0;

  for k = 1 : n-1
%
%  Find L, the index of the pivot row.
%
    l = k;
    for i = k+1 : n
      if ( abs ( a_lu(l,k) ) < abs ( a_lu(i,k) ) )
        l = i;
      end
    end

    pivot(k) = l;
%
%  If the pivot index is zero, the algorithm has failed.
%
    if ( a_lu(l,k) == 0.0 )
      info = k;
      fprintf ( 1, '\n' );
      fprintf ( 1, 'R8GE_FA - Fatal error!\n' );
      fprintf ( 1, '  Zero pivot on step %d\n', info );
      return;
    end
%
%  Interchange rows L and K if necessary.
%
    if ( l ~= k )
      t         = a_lu(l,k);
      a_lu(l,k) = a_lu(k,k);
      a_lu(k,k) = t;
    end
%
%  Normalize the values that lie below the pivot entry A(K,K).
%
    a_lu(k+1:n,k) = -a_lu(k+1:n,k) / a_lu(k,k);
%
%  Row elimination with column indexing.
%
    for j = k+1 : n

      if ( l ~= k )
        t         = a_lu(l,j);
        a_lu(l,j) = a_lu(k,j);
        a_lu(k,j) = t;
      end

      a_lu(k+1:n,j) = a_lu(k+1:n,j) + a_lu(k+1:n,k) * a_lu(k,j);

    end
  end

  pivot(n) = n;

  if ( a_lu(n,n) == 0.0 )
    info = n;
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8GE_FA - Fatal error!\n' );
    fprintf ( 1, '  Zero pivot on step %d\n', info );
    return;
  end

  return
end


function  [M,mv,alpha,unA] = ...
           select_taylor_degree(A,b,m_max,p_max,prec,shift,bal,force_estm)
%SELECT_TAYLOR_DEGREE   Select degree of Taylor approximation.
%   [M,MV,alpha,unA] = SELECT_TAYLOR_DEGREE(A,m_max,p_max) forms a matrix M
%   for use in determining the truncated Taylor series degree in EXPMV
%   and EXPMV_TSPAN, based on parameters m_max and p_max.
%   MV is the number of matrix-vector products with A or A^* computed.

%   Reference: A. H. Al-Mohy and N. J. Higham, Computing the action of
%   the matrix exponential, with an application to exponential
%   integrators. MIMS EPrint 2010.30, The University of Manchester, 2010.

%   Awad H. Al-Mohy and Nicholas J. Higham, October 26, 2010.

if nargin < 8, force_estm = false; end
if nargin < 4 || isempty(p_max), p_max = 8; end
if nargin < 3 || isempty(m_max), m_max = 55; end

if p_max < 2 || m_max > 60 || m_max + 1 < p_max*(p_max - 1)
    error('>>> Invalid p_max or m_max.')
end
n = length(A);
if nargin < 7 || isempty(bal), bal = false; end
if bal
    [D B] = balance(A);
    if norm(B,1) < norm(A,1), A = B; end
end
if nargin < 5 || isempty(prec), prec = class(A); end
switch prec
    case 'double'
        load theta_taylor
    case 'single'
        load theta_taylor_single
    case 'half'
        load theta_taylor_half
end
if shift
    mu = trace(A)/n;
    A = A-mu*speye(n);
end
mv = 0;
if ~force_estm, normA = norm(A,1); end

if ~force_estm && normA <= 4*theta(m_max)*p_max*(p_max + 3)/(m_max*size(b,2));
% if true
    % Base choice of m on normA, not the alpha_p.
    unA = 1;
    c = normA;
    alpha = c*ones(p_max-1,1);
else
    unA = 0;
    eta = zeros(p_max,1); alpha = zeros(p_max-1,1);
    for p = 1:p_max
        [c,k] = normAm(A,p+1);
        c = c^(1/(p+1));
        mv = mv + k;
        eta(p) = c;
    end
    for p = 1:p_max-1
        alpha(p) = max(eta(p),eta(p+1));
    end
end
M = zeros(m_max,p_max-1);
for p = 2:p_max
    for m = p*(p-1)-1 : m_max
        M(m,p-1) = alpha(p-1)/theta(m);
    end
end


% This program obtains the analytical step response of a parallel RLC
% circuit. In addition, graphs of the voltage across the parallel
% combination and branch currents are obtained.
% H. Saadat, Copyright 1999

function PresponseIR
warning('off','MATLAB:dispatcher:InexactMatch')
Rhandle=findobj('Tag','Rtext');
R=eval(get(Rhandle,'String'));
KOhandle=findobj('Tag','KOhm');
KO=get(KOhandle,'Value');
if KO==1
   R=1000*R;
else, end
Lhandle=findobj('Tag','Ltext');
L=eval(get(Lhandle,'String'));
mHhandle=findobj('Tag','mHenry');
ml=get(mHhandle,'Value');
if ml==1
   L=L/1000;
else, end
Chandle=findobj('Tag','Ctext');
C=eval(get(Chandle,'String'));
micFhandle=findobj('Tag','micFarad');
micF=get(micFhandle,'Value');
if micF==1
   C=C/1000000;
else, end
Rhandle=findobj('Tag','IStext');
Is=eval(get(Rhandle,'String'));
Rhandle=findobj('Tag','I0text');
I0=eval(get(Rhandle,'String'));
Rhandle=findobj('Tag','V0text');
V0=eval(get(Rhandle,'String'));
% Step Response of a parallel RLC circuit
if L==inf | C==inf
   plot(0, 0)
   text(-0.8, 0.80, 'Parameters must lie in the following ranges:', 'color', [0 0 0.6275])
   text(-0.8, 0.65, '0 < R \leq inf,   0 < L < inf,   &    0 < C < inf', 'color', [0 0 0.6275])
   text(-0.8, 0.5, 'Enter the correct value and press Solve', 'color', [0 0 0.6275])
   axis([-1  1  -1  1]);return,  else
end
if R==0 | L==0 | C == 0
plot(0, 0)
title('Short-circuit across the parallel circuit', 'color', [ 1 0 0])
text(-0.8, 0.80, 'Parameters must lie in the following ranges:', 'color', [0 0 0.6275])
text(-0.8, 0.65, '0 < R \leq inf,   0 < L < inf,   &    0 < C < inf', 'color', [0 0 0.6275])
text(-0.8, 0.5, 'Enter the correct value and press Solve', 'color', [0 0 0.6275])
axis([-1  1  -1  1]);return,  else
alpha =1/(2*R*C);
end
w02 = 1/(L*C); w0 = sqrt(w02);
if alpha~= 0
   err=(alpha-w0)/alpha;
   if abs(err) <1e-4
   w0=alpha;
   else, end
else, end
dv = Is/C-I0/C-V0/(R*C);
di = V0/L;
if alpha > w0
 % Overdamped response
    s(1) = -alpha + sqrt(alpha^2 - w02);
    s(2) = -alpha - sqrt(alpha^2 - w02);
    A1 = (dv-s(2)*V0)/(s(1)-s(2));
    A2 = (dv-s(1)*V0)/(s(2)-s(1));
    A1i =(di-s(2)*(I0-Is))/(s(1)-s(2));
    A2i =(di-s(1)*(I0-Is))/(s(2)-s(1));
    tf = 6*max(abs(1/s(1)), abs(1/s(2)));
    t=0:tf/100:tf;
    v = A1*exp(s(1)*t)+A2*exp(s(2)*t);
    iL=Is + A1i*exp(s(1)*t)+A2i*exp(s(2)*t);
    iR = v/R;
    iC= Is -iR-iL;
    it=iR+iL+iC;
    plot(t,iR,'erasemode','none','color',[0.9 0 0.8]), grid
    title(['i_R(t) =(', num2str(A1/R), ') e^{(', num2str(s(1)), 't)} + (', num2str(A2/R), ') e^{(', num2str(s(2)), 't)}'],'color',[0.9 0 0.8])
    xlabel(['\alpha = ',num2str(alpha), ',  \omega_0 = ',  num2str(w0), '  (O.D.)          t, sec'])
    ylabel('i_R(t), Amps')
    elseif alpha < w0
     if alpha~=0
      % Underdamped response
      tf = 6/alpha;
      t=0:tf/200:tf;
      wd= sqrt(w02 - alpha^2);
      s(1) = -alpha +j*wd;
      s(2) = -alpha -j*wd;
      B1 = V0; B2 = (dv+alpha*B1)/wd;
      B1i = I0 - Is; B2i = (di+alpha*B1i)/wd;
      v = exp(-alpha*t).*(B1*cos(wd*t)+B2*sin(wd*t));
      iL = Is + exp(-alpha*t).*(B1i*cos(wd*t)+B2i*sin(wd*t));
      iR = v/R;
      iC= Is -iR-iL;
      it=iR+iL+iC;
      plot(t,iR,'erasemode','none','color',[.9 0 0.8]), grid
      title(['i_R(t) = e^{(-', num2str(alpha), 't)}[(', num2str(B1/R), ')cos',num2str(wd),'t + (' , num2str(B2/R), ')sin',num2str(wd),'t]'],'color',[0.9 0 0.8])
      xlabel(['\alpha = ',num2str(alpha), ',  \omega_0 = ',  num2str(w0), '  (U.D.)          t, sec'])
      ylabel('i_R(t), Amps')
      else
      % Undamped Response
      tf = 8*pi/w0;
      t=0:tf/200:tf;
      wd= w0;
      B1 = V0; B2 = (dv)/wd;
      B1i = I0 - Is; B2i = (di)/wd;
      iL = Is + B1i*cos(wd*t)+B2i*sin(wd*t);
      v = B1*cos(wd*t)+B2*sin(wd*t);
      iR = v/R;
      iC= Is -iR-iL;
      it=iR+iL+iC;
      plot(t,iR,'erasemode','none','color',[0.9 0 0.80]), grid
      title('i_R(t) =  0')
      xlabel(['\alpha = ',num2str(alpha), ',  \omega_0 = ',  num2str(w0), '  (Undamped)          t, sec'])
      ylabel('i_R(t), Amps')
      end
   elseif alpha ==w0
    % Critically damped response
    s(1)=-alpha;  s(2) = s(1);
    D2 = V0;
    D1 = dv+alpha*D2;
    D2i = I0 - Is; D1i = di+alpha*D2i;
    tf = 8/alpha;
    t=0:tf/100:tf;
    iL=Is + exp(-alpha*t).*(D1i*t+D2i);
    v = exp(-alpha*t).*(D1*t+D2);
    iR = v/R;
    iC= Is -iR-iL;
    it=iR+iL+iC;
    plot(t,iR,'erasemode','none','color',[0.9 0 0.8]), grid
    title(['i_R(t) = e^{(-', num2str(alpha), 't)}[(', num2str(D1/R), ')t + (' , num2str(D2/R), ')]'],'color',[0.9 0 0.8])
    xlabel(['\alpha = ',num2str(alpha), ',  \omega_0 = ',  num2str(w0), '  (C.D.)          t, sec'])
    ylabel('i_R(t), Amps')
    else, end


% realproba() - compute the effective probability of the value
%               in the sample.
%
% Usage:
%   >> [probaMap, probaDist ] = realproba( data, discret);
%
% Inputs:
%   data       - the data onto which compute the probability
%   discret    - discretisation factor (default: (size of data)/5)
%                if 0 base the computation on a Gaussian
%                approximation of the data
%
% Outputs:
%   probaMap   - the probabilities associated with the values
%   probaDist  - the probabilities distribution
%
% Author: Arnaud Delorme, CNL / Salk Institute, 2001

% Copyright (C) 2001 Arnaud Delorme, Salk Institute, arno@salk.edu
%
% This program is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 2 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program; if not, write to the Free Software
% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

function [ probaMap, sortbox ] = realproba( data, bins );

if nargin < 1
	help realproba;
	return;
end;
if nargin < 2
	bins = round(size(data,1)*size(data,2)/5);
end;

if bins > 0
	% COMPUTE THE DENSITY FUNCTION
	% ----------------------------
	SIZE = size(data,1)*size(data,2);
	sortbox = zeros(1,bins);
	minimum =  min(data(:));
	maximum =  max(data(:));
	data = floor((data - minimum )/(maximum - minimum)*(bins-1))+1;
    if any(any(isnan(data))), warning('Binning failed - could be due to zeroed out channel'); end;
	for index=1:SIZE
		sortbox(data(index)) = sortbox(data(index))+1;
	end;
	probaMap = sortbox(data) / SIZE;
	sortbox  = sortbox / SIZE;
else
	% BASE OVER ERROR FUNCTION
	% ------------------------
	data     = (data-mean(data(:)))./std(data(:));
	probaMap = exp(-0.5*( data.*data ))/(2*pi);
	probaMap = probaMap/sum(probaMap); % because the total surface under a normalized Gaussian is 2
	sortbox  = probaMap/sum(probaMap);
end;
return;


function vwap = getVWAP(price, volume, dates)
%GETVWAP: calculate the Volume Weighted Average Price at the end of each
%day, given intra daily data of the closing price and volume.
%
%   VWAP = GETVWAP(price, volume, dates) returns the Volume Weighted
%   Average Price (VWAP) at the end of the day. The input consists of the
%   intra-daily price, volume and dates (in formatted form).
%
%   vwap:           is a vector of the VWAP prices at the end of each
%                   unique day, conditional on the dates.
%
%  $Date: 04/10/2012$
%
% -------------------------------------------------------------------------

% Not all securities publish their volume shares, i.e. sometimes the volume
% vector is empty.
if sum(volume) == 0, error('getVWAP:InvalidInput','No historical intra-daily data of volume'); end
if size(price,2) > 1 || size(volume,2) > 1 || size(dates,2) > 1, error('getVWAP:InvalidInput','Price, volume and dates should be a row vector'); end

% FIND THE UNIQUE DAYS. TWO OPTIONS ARE POSSIBLE:
% -- 1 --   make use of the included GETUNIQUEDAYELEMENTS code (general
%           framework, adaptable for multi purposes, external)

uniqueDays = getUniqueDayElements(dates);
k = size(unique(day(dates)),1);
vwap = zeros(1, k );

% -- 2 --   get rid of the [EXTERNAL] GETUNIQUEDAYELEMENTS code and use the
%           following [INTERNAL] method:

    % k = size(unique(day(dates)),1);
    % vwap = zeros(1, k );
    % uniqueDays = zeros(1, k ); iter = 1; uniqueDays(iter) = day(dates(1));
    %
    % % find the unique days
    % for i = 2:size(dates,1);
    %     if uniqueDays(iter) ~= day(dates(i));
    %         iter = iter + 1;
    %         uniqueDays(iter) = day(dates(i));
    %     end
    % end

% calculate vwap
for i = 1:size(uniqueDays,2)
    dayi = day(dates)==uniqueDays(i);
    vwap(i) = sum( volume(dayi) ...
        .*price( dayi ) ) / sum( volume( dayi ) );
end


function KLD = prtRvUtilWishartKld(q,Q,p,P)
% WISHARTKLD  Kulback Liebler Divergence between two Wishart densities
%       KLD(Q||P)
%
%   KL-Divergence of Normal, Gamma, Dirichlet and Wishart densities
%      Penny, 2001
%
% Syntax: KLD = wishartKLD(aQ,BQ,aP,BP)
%
% Inputs:
%   aQ - The strength parameter of the Q distribution
%   BQ - The mean parameter of the Q distribution
%   aP - The strength parameter of the P distribution
%   BP - The mean parameter of the P distribution
%
% Outputs:
%   KLD - The KLD for the Wishart distributions

d = size(Q,1);

dims = 1:d;

KLD = p/2*(prtUtilLogDet(Q) - prtUtilLogDet(P)) + q/2*(trace(inv(Q)*P) - d) + prtRvUtilGeneralizedGammaLn(p/2,d) - prtRvUtilGeneralizedGammaLn(q/2,d) + (q/2 - p/2)*sum(psi((q+1-dims)/2));

if KLD < 0
    KLD = 0; % This only happens in the range of 0;
end


%% Autoregressive Conditional Mean, Variance and Kurtosis
% Allows the estimation of the Autoregressive Conditional Kurtosis Model
% presented in Brooks, C., Burke, S., P., and Persand, G., (2005),
% "Autoregressive Conditional Kurtosis Model", Journal of Financial
% Econometrics, 3(3),339-421.
%
%% *_Mean Models_*
%
% $$ARMAX(AR, MA, X): r_t = a_0 + {\sum_{i=1}^n}{a_1}{r_{t-i}} + {\sum_{j=1}^k}{a_2}{\varepsilon}_{t-j} + {\sum_{l=1}^m}{a_3}{X_l} + {\varepsilon}_t$
%
%% *_Variance Models_*
%
% $$GARCH(P,Q,Y): {\sigma}_t^2 = b_0 + {\sum_{i=1}^p}b_{1,i}{\varepsilon}_{t-i}^2 + {\sum_{j=1}^q}b_{2,j}{\sigma}_{t-q}^2 + {\sum_{l=1}^m}{b_3}{Y_l}$
% $$GJR-GARCH(P,Q,Y): {\sigma}_t^2 = b_0 + {\sum_{i=1}^p}b_{1,i}{\varepsilon}_{t-i}^2 + {\sum_{j=1}^q}b_{2,j}{\sigma}_{t-j}^2 + {\sum_{i=1}^p}b_{3,i}{\varepsilon}_{t-i}^2*I_{t-i} + {\sum_{l=1}^m}{b_3}{Y_l}$
% $$AGARCH(P,Q,Y): {\sigma}_t^2 = b_0 + {\sum_{i=1}^p}b_{1,i}({\varepsilon}_{t-i} + {\gamma_{t-p}}))^2 + {\sum_{j=1}^q}b_{2,j}{\sigma}_{t-j} + {\sum_{l=1}^m}{b_3}{Y_l}$
% $$NAGARCH(P,Q,Y): {\sigma}_t^2 = b_0 + {\sum_{i=1}^p}b_{1,i}({\varepsilon}(t-i)/{\sqrt{{\sigma}_{t-i}^2}} + {\sum_{i=1}^p}{\gamma_{t-i}}^2 +  {\sum_{j=1}^q}b_{2,j}{\sigma}_{t-j}^2 + {\sum_{l=1}^m}{b_3}{Y_l}$
%
%% *_Kurtosis Models_*
% $$GARCH-K(P,Q): k_t = d_0 + {\sum_{i=1}^p}d_{1,i}{\varepsilon}_{t-i}^4/{\sigma}_{t-i}^2 +{\sum_{j=1}^q}d_{2,j}k_{t-q}$
%
%% *_Distribution_*
%
% $$f(x) = \frac{{\Gamma}\left(\frac{{\nu_t}+1}{2} \right)}{\sqrt{{\nu_t}{\pi}}{\Gamma} \left( \frac{{\nu_t}}{2} \right)}\left(1+\frac{\epsilon_t^2}{\nu_t} \right)^{-\frac{\nu_t+1}{2}}$
%
% where the degrees of freedom can be expressed as a function of conditional kurtosis
%
% $$\nu_t = \frac{4k_t - 6}{k_t - 3}$
%
% <..\readme\readme.html Return to Main>


function TwoDimEllipsoid(Location,Square_Dispersion,Scale,PlotEigVectors,PlotSquare)
% this function computes the location-dispersion ellipsoid
% see "Risk and Asset Allocation"-Springer (2005), by A. Meucci

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% compute the ellipsoid in the r plane, solution to  ((R-Location)' * Dispersion^-1 * (R-Location) ) = Scale^2
[EigenVectors,EigenValues] = eig(Square_Dispersion);
EigenValues=diag(EigenValues);
Centered_Ellipse=[];
Angle = [0 : pi/500 : 2*pi];
NumSteps=length(Angle);
for i=1:NumSteps
    y=[cos(Angle(i))                                   % normalized variables (parametric representation of the ellipsoid)
        sin(Angle(i))];
    Centered_Ellipse=[Centered_Ellipse EigenVectors*diag(sqrt(EigenValues))*y];
end
R= Location*ones(1,NumSteps) + Scale*Centered_Ellipse;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%draw plots

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% plot the ellipsoid
hold on
h=plot(R(1,:),R(2,:));
set(h,'color','r','linewidth',2)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% plot a rectangle centered in Location with semisides of lengths Dispersion(1) and Dispersion(2), respectively
if PlotSquare
    Dispersion=sqrt(diag(Square_Dispersion));
    Vertex_LowRight_A=Location(1)+Scale*Dispersion(1); Vertex_LowRight_B=Location(2)-Scale*Dispersion(2);
    Vertex_LowLeft_A=Location(1)-Scale*Dispersion(1); Vertex_LowLeft_B=Location(2)-Scale*Dispersion(2);
    Vertex_UpRight_A=Location(1)+Scale*Dispersion(1); Vertex_UpRight_B=Location(2)+Scale*Dispersion(2);
    Vertex_UpLeft_A=Location(1)-Scale*Dispersion(1); Vertex_UpLeft_B=Location(2)+Scale*Dispersion(2);

    Square=[Vertex_LowRight_A            Vertex_LowRight_B
        Vertex_LowLeft_A             Vertex_LowLeft_B
        Vertex_UpLeft_A              Vertex_UpLeft_B
        Vertex_UpRight_A             Vertex_UpRight_B
        Vertex_LowRight_A            Vertex_LowRight_B];
        hold on;
        h=plot(Square(:,1),Square(:,2));
        set(h,'color','r','linewidth',2)
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% plot eigenvectors in the r plane (centered in Location) of length the
% square root of the eigenvalues (rescaled)
if PlotEigVectors
    L_1=Scale*sqrt(EigenValues(1));
    L_2=Scale*sqrt(EigenValues(2));

    % deal with reflection: matlab chooses the wrong one
    Sign= sign(EigenVectors(1,1));
    Start_A=Location(1);                               % eigenvector 1
    End_A= Location(1) + Sign*(EigenVectors(1,1)) * L_1;
    Start_B=Location(2);
    End_B= Location(2) + Sign*(EigenVectors(1,2)) * L_1;
    hold on
    h=plot([Start_A End_A],[Start_B End_B]);
    set(h,'color','r','linewidth',2)
    axis equal;

    Start_A=Location(1);                               % eigenvector 2
    End_A= Location(1) + (EigenVectors(2,1)* L_2);
    Start_B=Location(2);
    End_B= Location(2) + (EigenVectors(2,2)* L_2);
    hold on;
    h=plot([Start_A End_A],[Start_B End_B]);
    set(h,'color','r','linewidth',2)
end

grid on


function normals = vertexNormal(vertices, faces)
%VERTEXNORMAL Compute normals to a mesh vertices
%
%   N = vertexNormal(V, F)
%   Computes vertex normals of the mesh given by vertices V and F.
%   V is a vertex array with 3 columns, F is either a NF-by-3 or NF-by-4
%   index array, or a cell array with NF elements.
%
%   Example
%     % Draw the vertex normals of a sphere
%     s = [10 20 30 40];
%     [v f] = sphereMesh(s);
%     drawMesh(v, f);
%     view(3);axis equal; light; lighting gouraud;
%     normals = vertexNormal(v, f);
%     drawVector3d(v, normals);
%
%   See also
%     meshes3d, faceNormal, triangulateFaces
%
% ------
% Author: David Legland
% e-mail: david.legland@grignon.inra.fr
% Created: 2011-12-19,    using Matlab 7.9.0.529 (R2009b)
% Copyright 2011 INRA - Cepia Software Platform.

nv = size(vertices, 1);
nf = size(faces, 1);

% unit normals to the faces
faceNormals = normalizeVector3d(faceNormal(vertices, faces));

% compute normal of each vertex: sum of normals to each face
normals = zeros(nv, 3);
if isnumeric(faces)
    for i = 1:nf
        face = faces(i, :);
        for j = 1:length(face)
            v = face(j);
            normals(v, :) = normals(v,:) + faceNormals(i,:);
        end
    end
else
    for i = 1:nf
        face = faces{i};
        for j = 1:length(face)
            v = face(j);
            normals(v, :) = normals(v,:) + faceNormals(i,:);
        end
    end
end

% normalize vertex normals to unit vectors
normals = normalizeVector3d(normals);


function g = estimate_time_constant(y, p, sn, lags, fudge_factor)
%% Estimate noise standard deviation and AR coefficients if they are not present

%% inputs:
%   y: N X T matrix, fluorescence trace
%   p: positive integer, order of AR system
%   sn: scalar, noise standard deviation, estimated if not provided
%   lags: positive integer, number of additional lags where he autocovariance is computed
%    fudge_factor: float (0< fudge_factor <= 1) shrinkage factor to reduce bias

%% outputs
%   g: 1 x p vector, AR coefficient

%% Authors: Pengcheng Zhou, Carnegie Mellon University, 2016
% adapted from the MATLAB implemention by Eftychios Pnevmatikakis and the
% Python implementation from Johannes Friedrich

%% References
% Pnevmatikakis E. et.al., Neuron 2016, Simultaneous Denoising, Deconvolution, and Demixing of Calcium Imaging Data

%% input arguments
if ~exist('p', 'var') || isempty(p)
    p = 2;
end
if ~exist('sn', 'var') || isempty(sn)
    sn = GetSn(y);
end
if ~exist('lags', 'var') || isempty(lags)
    lags = 5;
end
if ~exist('fudge_factor', 'var') || isempty(fudge_factor)
    fudge_factor = 1;
end

%% estimate time constants
lags = lags + p;
if ~isempty(which('xcov')) %signal processing toolbox
    xc = xcov(y,lags,'biased');
else
    ynormed = (y - mean(y));
    xc = nan(lags + 1, 1);
    for k = 0:lags
        xc(k + 1) = ynormed(1 + k:end)' * ynormed(1:end - k);
    end
    xc = [flipud(xc(2:end)); xc] / numel(y);
end
xc = xc(:);
A = toeplitz(xc(lags+(1:lags)),xc(lags+(1:p))) - sn^2*eye(lags,p);
g = pinv(A)*xc(lags+2:end);

% while max(abs(roots([1,-g(:)']))>1) && p < 3
%     warning('No stable AR(%i) model found. Checking for AR(%i) model \n',p,p+1);
%     p = p + 1;
%     g = estimate_time_constants(y,p,sn,lags);
% end
% if p == 5
%     g = 0;
% end

% re-adjust time constant values
rg = roots([1;-g(:)]);
if ~isreal(rg); rg = real(rg) + .001*randn(size(rg)); end
rg(rg>1) = 0.95 + 0.001*randn(size(rg(rg>1)));
rg(rg<0) = 0.15 + 0.001*randn(size(rg(rg<0)));
pg = poly(fudge_factor*rg);
g = -pg(2:end);


function [membership,means,rms] = kmeansML(k,data,varargin)
% [membership,means,rms] = kmeansML(k,data,...)
%
% Multi-level kmeans.
% Tries very hard to always return k clusters.
%
% INPUT
%	k		Number of clusters
% 	data		dxn matrix of data points
%	'maxiter'	Max number of iterations. [30]
%	'dtol'		Min change in center locations. [0]
%	'etol'		Min percent change in RMS error. [0]
%	'ml'		Multi-level? [true]
%	'verbose'	Verbose level. [0]
%			    0 = none
%			    1 = textual
%			    2 = visual
%
% OUTPUT
% 	membership	1xn cluster membership vector
% 	means		dxk matrix of cluster centroids
%	rms		RMS error of model
%
% October 2002
% David R. Martin <dmartin@eecs.berkeley.edu>

% process options
maxIter = 30;
dtol = 0;
etol = 0;
ml = true;
verbose = 0;
for i = 1:2:numel(varargin),
  opt = varargin{i};
  if ~ischar(opt), error('option names not a string'); end
  if i==numel(varargin), error(sprintf('option ''%s'' has no value',opt)); end
  val = varargin{i+1};
  switch opt,
   case 'maxiter', maxIter = max(1,val);
   case 'dtol', dtol = max(0,val);
   case 'etol', etol = max(0,val);
   case 'ml', ml = val;
   case 'verbose', verbose = val;
   otherwise, error(sprintf('invalid option ''%s''',opt));
  end
end

[membership,means,rms] = ...
    kmeansInternal(k,data,maxIter,dtol,etol,ml,verbose,1);

function [membership,means,rms] = kmeansInternal(...
    k,data,maxIter,dtol,etol,ml,verbose,retry)

[d,n] = size(data);
perm = randperm(n);

% compute initial means
rate = 3;
minN = 50;
coarseN = round(n/rate);
if ~ml | coarseN < k | coarseN < minN,
  % pick random points as means
  means = data(:,perm(1:k));
else
  % recurse on random subsample to get means
  coarseData = data(:,perm(1:coarseN));
  [coarseMem,means] = ...
      kmeansInternal(k,coarseData,maxIter,dtol,etol,ml,verbose,0);
end

% Iterate.
iter = 0;
rms = inf;
if verbose>0, fwrite(2,sprintf('kmeansML: n=%d d=%d k=%d [',n,d,k)); end
while iter < maxIter,
  if verbose>0, fwrite(2,'.'); end
  iter = iter + 1;
  % Compute cluster membership and RMS error.
  rmsPrev = rms;
  [membership,rms] = computeMembership(data,means);
  % Compute new means and cluster counts.
  prevMeans = means;
  [means,counts] = computeMeans(k,data,membership);
  % The error should always decrease.
  if rms > rmsPrev, error('bug: rms > rmsPrev'); end
  % Check for convergence.
  rmsPctChange = 2 * (rmsPrev - rms) / (rmsPrev + rms + eps);
  maxMoved = sqrt(max(sum((prevMeans-means).^2)));
  if rmsPctChange <= etol & maxMoved <= dtol, break; end
  % Visualize.
  if verbose>1, kmeansVis(data,membership,means); end
end
[membership,rms] = computeMembership(data,means);
if verbose>0, fwrite(2,sprintf('] rms=%.3g\n',rms)); end

% If there's an empty cluster, then re-run kmeans.
% Retry a fixed number of times.
maxRetries = 3;
if find(counts==0),
  if retry < maxRetries,
    disp('Warning: Re-runing kmeans due to empty cluster.');
    [membership,means] = kmeansInternal( ...
        k,data,maxIter,dtol,etol,ml,verbose,retry+1);
  else
    disp('Warning: There is an empty cluster.');
  end
end

function [membership,rms] = computeMembership(data,means)
z = distSqr(data,means);
[d2,membership] = min(z,[],2);
rms = sqrt(mean(d2));

function [means,counts] = computeMeans(k,data,membership)
[d,n] = size(data);
means = zeros(d,k);
counts = zeros(1,k);
for i = 1:k,
  ind = find(membership==i);
  counts(i) = length(ind);
  means(:,i) = sum(data(:,ind),2) / max(1,counts(i));
end

%  for i = 1:n,
%    j = membership(i);
%    means(:,j) = means(:,j) + data(:,i);
%    counts(j) = counts(j) + 1;
%  end
%  for j = 1:k,
%    means(:,j) = means(:,j) / max(1,counts(j));
%  end


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Spherical Harmonic Modeling and Analysis Toolkit (SPHARM-MAT) is a 3D
% shape modeling and analysis toolkit.
% It is a software package developed at Shenlab in Center for Neuroimaging,
% Indiana University (SpharmMat@gmail.com, http://www.iupui.edu/~shenlab/)
% It is available to the scientific community as copyright freeware
% under the terms of the GNU General Public Licence.
%
% Copyright 2009, 2010, ShenLab, Center for Neuroimaging, Indiana University
%
% This file is part of SPHARM-MAT.
%
% SPHARM-MAT is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% SPHARM-MAT is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with SPHARM-MAT. If not, see <http://www.gnu.org/licenses/>.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% ============================================
%
% Goal: Create canonical spherical harmonic bases
%
% Li Shen
% 04/11/2002 - create
% 10/15/2002 - rename and modify
% 11/03/2008 - renamed by Sungeun Kim.

function Z = calculate_SPHARM_basis(vs, degree)

[PHI,THETA] = cart2sph(vs(:,1),vs(:,2),vs(:,3));
ind = find(PHI<0);
PHI(ind) = PHI(ind)+2*pi;
THETA = pi/2-THETA;
vertnum = size(THETA,1);

Z = spharm_basis(degree,THETA,PHI);

return;

function Z = spharm_basis(max_degree,theta,phi)

Z = []; vnum = size(theta,1);

% save calculations for efficiency
for k = 0:(2*max_degree)
    fact(k+1) = factorial(k);
end
for m = 0:max_degree
    exp_i_m_phi(:,m+1) = exp(i*m*phi);
    sign_m(m+1) = (-1)^(m);
end

for n = 0:max_degree

	% P = legendre(n,X) computes the associated Legendre functions of degree n and
	% order m = 0,1,...,n, evaluated at X. Argument n must be a scalar integer
	% less than 256, and X must contain real values in the domain -1<=x<=1.
	% The returned array P has one more dimension than X, and each element
	% P(m+1,d1,d2...) contains the associated Legendre function of degree n and order
	% m evaluated at X(d1,d2...).

    Pn = legendre(n,cos(theta'))';

    posi_Y = [];
    nega_Y = [];

    m= 0:n;
    v = sqrt(((2*n+1)/(4*pi))*(fact(n-m+1)./fact(n+m+1)));
    v = v(ones(1,vnum),:).*Pn(:,m+1).*exp_i_m_phi(:,m+1);
    posi_Y(:,m+1) = v; % positive order;
    nega_Y(:,n-m+1) = sign_m(ones(1,vnum),m+1).*conj(v); % negative order

    Z(:,end+1:end+n) = nega_Y(:,1:n);
    Z(:,end+1:end+n+1) = posi_Y(:,1:(n+1));
end

return;


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   [alpha, beta, gamma] = rot2euler(R, convention)
%   Returns the Euler angles alpha, beta and gamma that yield a given matrix
%   R. The convention specifies the order and axes of rotations.
%   Currently, only the XYZ convention is supported.
%
%   In particular, the function computes the angles alpha, beta and gamma that
%   allow to compute R as.
%
%   R = Rot(alpha,'x')*Rot(beta,'y')*Rot(gamma,'z')
%
%   Author: Arturo Gil. Universidad Miguel Hernandez de Elche. email:
%   arturo.gil@umh.es date:   11/11/2020
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Copyright (C) 2012, by Arturo Gil Aparicio
%
% This file is part of ARTE (A Robotics Toolbox for Education).
%
% ARTE is free software: you can redistribute it and/or modify
% it under the terms of the GNU Lesser General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% ARTE is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU Lesser General Public License for more details.
%
% You should have received a copy of the GNU Leser General Public License
% along with ARTE.  If not, see <http://www.gnu.org/licenses/>.
function [sol1, sol2] = rot2euler(R, convention)

if convention=='XYZ'
    [sol1, sol2]=conventionXYZ(R);
elseif convention=='ZYX'
    [sol1, sol2]=conventionZYX(R);
else
    'Unknown convention. Only XYZ and ZYX are supported'
end

function [sol1, sol2] = conventionXYZ(R)
%'R(1,3)=sen(beta)=1??'
if abs(R(1,3)) == 1
    % degenerate case in which sen(beta)=+-1 and cos(beta)=0
    alpha1 = 0; % arbitrarily set alpha to zero
    alpha2 = pi; % arbitrarily set alpha to pi
    beta1 = asin(R(1,3));
    beta2 = pi-beta1;
    if sin(beta1) > 0
        gamma1 = atan2(R(2,1), -R(3,1));
        gamma2 = atan2(R(2,1), -R(3,1)) - alpha2;
    else
        gamma1 = atan2(R(2,1), R(3,1));
        gamma2 = atan2(R(2,1), R(3,1))+alpha2;
    end
else
    beta1 = asin(R(1,3));
    beta2 = pi-beta1;

    % standard way to compute alpha beta and gamma
    alpha1 = -atan2(R(2,3)/cos(beta1), R(3,3)/cos(beta1));
    alpha2 = -atan2(R(2,3)/cos(beta2), R(3,3)/cos(beta2));
    gamma1 = -atan2(R(1,2)/cos(beta1), R(1,1)/cos(beta1));
    gamma2 = -atan2(R(1,2)/cos(beta2), R(1,1)/cos(beta2));
end
% Normalize all angles to -pi, pi
sol1 = [alpha1, beta1, gamma1];
sol2 = [alpha2, beta2, gamma2];
sol1 = normalize_angles(sol1);
sol2 = normalize_angles(sol2);

function [sol1, sol2] = conventionZYX(R)
%R(3,1)=sin(beta)=+-1?? --> degenerate case
% degenerate case in which sen(beta)=+-1 and cos(beta)=0
if abs(R(3,1)) == 1
    alpha1 = 0; % arbitrarily set alpha to zero
    alpha2 = pi;%arbitrarily set to pi
    beta1 = asin(-R(3,1));
    beta2 = pi-beta1;
    if sin(beta1) > 0
        gamma1 = atan2(R(1,2), R(2,2));
        gamma2 = atan2(R(1,2), R(2,2)) + alpha2;
    else
        gamma1 = atan2(-R(1,2), R(2,2));
        gamma2 = atan2(-R(1,2), R(2,2)) - alpha2;
    end
else
    % standard way to compute alpha beta and gamma outside of the gimbal
    % lock
    beta1 = asin(-R(3,1));
    beta2 = pi-beta1;

    alpha1 = atan2(R(2,1)/cos(beta1), R(1,1)/cos(beta1));
    alpha2 = atan2(R(2,1)/cos(beta2), R(1,1)/cos(beta2));
    gamma1 = atan2(R(3,2)/cos(beta1), R(3,3)/cos(beta1));
    gamma2 = atan2(R(3,2)/cos(beta2), R(3,3)/cos(beta2));
end
% Normalize all angles to -pi, pi
sol1 = [alpha1, beta1, gamma1];
sol2 = [alpha2, beta2, gamma2];
sol1 = normalize_angles(sol1);
sol2 = normalize_angles(sol2);

function sol_norm = normalize_angles(sol)
sol_norm = [0 0 0];
for i=1:3
    sol_norm(i) = atan2(sin(sol(i)), cos(sol(i)));
end


function [out_img, criterion] = TVdenoising(img, method, num_steps, lambda, clear_img, alpha, showfigs)

[H, W] = size(img);
N = H * W;

%% method aspects
switch method
    case 'ROFalg1'
        alg = 1;
        Lone = 0;
        huber = 0;
    case 'ROFalg2'
        alg = 2;
        Lone = 0;
        huber = 0;
    case 'TVL1ROFalg1'
        alg = 1;
        Lone = 1;
        huber = 0;
    case 'HuberROFalg3'
        alg = 3;
        Lone = 0;
        huber = 1;
    case 'HuberL1ROFalg1'
        alg = 1;
        Lone = 1;
        huber = 1;
    otherwise
        disp(['Unknown method: ' method]);
        return;
end

%% parameters
L = sqrt(8);

switch alg
    case 0      % Arrow-Hurwics version of Alg 2 (AHMOD)
        tau = 1/L;
        sigma = 1/L;
        gamma = 0.35 * lambda;
        theta = 0;
    case 1
        tau = 0.01;
        sigma = 1/(tau * L * L);
        theta = 1;
    case 2
        tau = 1/L;
        sigma = 1/L;
        gamma = 0.35*lambda;
    case 3
        gamma = lambda;
        delta = alpha;
        mu = 2 * sqrt(gamma * delta) / L;
        theta = 1/(1+mu);
        tau = mu / (2 * gamma);
        sigma = mu / (2 * delta);
end

%% initial solution
% primal task variables
u = img(:);
ubar = u;

% dual task variable
p = zeros(N * 2, 1);

%% precomputed
nabla = make_derivatives_mine(H, W);
divop = nabla';
% divop = make_divop(H, W);
denom = 1 + tau * lambda;

%% initial criterion value
if (Lone)
    lambda_denom = 1;
else
    lambda_denom = 2;
end

criterion = zeros(1, num_steps+1);
criterion(1) = Fval(u, img, alpha, huber) + lambda / lambda_denom * Gval(u, img, Lone);

%% plot the initial state
if showfigs
    fh1 = sfigure;

    imshow([img reshape(u, H, W)]);

    fh2 = sfigure;
    plot(0, criterion(1), 'b-');
    xlabel('step');
    ylabel('J(u)');
end

%% main loop
for step = 1:num_steps
    disp(['step: ' num2str(step)]);

    % ------ update p^n+1 ------
    p = p + sigma * nabla * ubar;

    if huber
        p = p / (1 + sigma * alpha);
    end

    % projection of p onto L2 ball
    p_len = sqrt(p(1:N).^2 + p(N+1:end).^2);
    p_len = max(1, p_len);
    p = p ./ repmat(p_len, 2, 1);

    % ----- update u^n+1 ------
    divp = divop * p;
    u_tilde = u - tau * divp;

    if Lone
        dif = u_tilde - img(:);
        idx1 = dif > tau * lambda;
        idx2 = dif < -tau * lambda;
        idx3 = abs(dif) <= tau * lambda;
        u_new = zeros(size(u));
        u_new(idx1) = u_tilde(idx1) - tau * lambda;
        u_new(idx2) = u_tilde(idx2) + tau * lambda;
        u_new(idx3) = img(idx3);
    else
        if alg == 2 || alg == 0
            denom = 1 + tau * lambda;
        end
        u_new = (u_tilde + tau * lambda * img(:)) / denom;
    end

    % ----- update tau and sigma -----
    if alg == 2
        theta = 1/(sqrt(1+2*gamma*tau));
        tau = tau * theta;
        sigma = sigma / theta;
    end
    if alg == 0
        theta_tmp = 1/(sqrt(1+2*gamma*tau));
        tau = tau * theta_tmp;
        sigma = sigma / theta_tmp;
    end

    % update ubar^n+1
    ubar = u_new + theta * (u_new - u);

    u = u_new;

    % compute the criterion function value
    criterion(step+1) = Fval(u, clear_img, alpha, huber) + lambda / lambda_denom * Gval(u, img, Lone);

    % plot current result
    if showfigs
        sfigure(fh1);
        imshow([img reshape(u, H, W)]);
        drawnow;

        sfigure(fh2);
        plot(0:step, criterion(1:step+1), 'b-');
        xlabel('step');
        ylabel('J(u)');
        drawnow;
    end
end

out_img = u;


function COFMEn = COFMEn(data, m, r,fs)
%******************************************************
% $ This function is usded for calcualting the cofficient of fuzzy measure entropy (COFMEn) for physiological signal time sequence.
% $ Using COFMEn aims to improve the performance of COSEn.
%
% $ Reference: Liu C Y, Li K, Zhao L N, Liu F, Zheng D C, Liu C C and Liu S
% T. Analysis of heart rate variability using fuzzy measure entropy.
% Computers in Biology and Medicine, 2013, 43(2): 100-108
%
% $ Variable declaration:
% data is RR time series
% m is embedding dimension (usually m=1)
% r is threshold value (usually r=30 ms)
% local threshold r_l=0.2, global threshold r_g=0.2,
% local weight of sequence segments' similarity n_l=2
% global weight of sequence segments' similarity n_g=2
%
% $ Author:  Chengyu Liu (bestlcy@sdu.edu.cn)
%           Institute of Biomedical Engineering,
%           Shandong University
% $Last updated:  2015.10.15
%
%   LICENSE:
%       This software is offered freely and without warranty under
%       the GNU (v3 or later) public license. See license file for
%       more information

% data=[108,108,109,109,108,108,110,107,109,109,109,109,108,109,108,108,108,108,107,108,108,108,108,107,109,107,108,107,108,108,108,108,108,108,108,109,108,109,108,108,109,108,108,108,109,107,108,107,107,108,108,108,109,107,108,108,108,108,108,108]*4;
% data=[109,108,108,109,109,109,108,109,108,108,109,108,108,109,108,108,108,109,108,109,109,109,108,108,109,108,108,109,109,109]*4;
% m=1;
% r=30;

N=length(data);
for i=1:N-m
    x1(i,:)=data(i:i+m-1);
    x2(i,:)=data(i:i+m);
end

ratio=0.4;
if N>20
%     Thr=ratio*N;
    Thr=5;
else
    Thr=5;
end

Min_numerator=0;
kk=0;
while Min_numerator<Thr
    [Min_numerator,r]=ReGet_min_numerator(x1,x2,N,m,r,fs);
    kk=kk+1;
end
if kk==1 || kk>20
   if N<20
        r=r-1;
    else
        r=r-1000/fs;
    end
end

if Min_numerator==N-m
    while Min_numerator>=Thr
        [Min_numerator,r]=ReGet_min_numerator2(x1,x2,N,m,r,fs);
    end
    if r<0
        r=r+2;
    else
        r=r+1;
    end
end

x=data;
r_l   = r;
r_g   = r;
n_l   = 2;
n_g   = 2;
%% m=2
D_l   = zeros(N-m,1); % initiate the mean local distance vector
D_g   = zeros(N-m,1); % initiate the mean global distance vector
for i = 1:N-m
    distance_l = zeros(N-m,1); % initiate the local distance vector for the ith vector
    distance_g = zeros(N-m,1); % initiate the global distance vector for the ith vector
    for j = 1:N-m
        if j==i
            d_l = 0;
            d_g = 0;
        else
        d_l = max(abs(x(i:i+m-1)-mean(x(i:i+m-1))-x(j:j+m-1)+mean(x(j:j+m-1))));
        d_g = max(abs(x(i:i+m-1)-x(j:j+m-1)));
        end
        distance_l(j) = exp(-(d_l.^n_l/r_l));
        distance_g(j) = exp(-(d_g.^n_g/r_g));
    end
    D_l(i) = sum(distance_l)/(N-m-1);
    D_g(i) = sum(distance_g)/(N-m-1);
end
Bm_l = mean(D_l);
Bm_g = mean(D_g);

%% m=m+1
m=m+1;
D_l   = zeros(N-m,1);
D_g   = zeros(N-m,1);
for i = 1:N-m
    distance_l = zeros(N-m,1);
    distance_g = zeros(N-m,1);
    for j = 1:N-m
        if j==i
            d_l = 0;
            d_g = 0;
        else
        d_l = max(abs(x(i:i+m-1)-mean(x(i:i+m-1))-x(j:j+m-1)+mean(x(j:j+m-1))));
        d_g = max(abs(x(i:i+m-1)-x(j:j+m-1)));
        end
        distance_l(j) = exp(-(d_l.^n_l/r_l));
        distance_g(j) = exp(-(d_g.^n_g/r_g));
    end
    D_l(i) = sum(distance_l)/(N-m-1);
    D_g(i) = sum(distance_g)/(N-m-1);
end
Am_l = mean(D_l);
Am_g = mean(D_g);

%% Calculate local and global fuzzy measure entropy
FuzzyLMEn = -log(Am_l/Bm_l);  % local fuzzy measure entropy
FuzzyGMEn = -log(Am_g/Bm_g);  % global fuzzy measure entropy
%% Generate fuzzy measure entropy
COFMEn  = FuzzyLMEn+FuzzyGMEn+2*log(2*r/1000)-2*log(mean(data)/1000);