% STATCOND  - compare two or more data conditions statistically using
%               standard parametric or nonparametric permutation-based ANOVA
%               (1-way or 2-way) or t-test methods. Parametric testing uses
%               FCDF from the Matlab Statistical Toolbox.
% Usage:
%          >> [stats, df, pvals, surrog] = statcond( data, 'key','val'... );
%
% Inputs:
%   data       = one-or two-dimensional cell array of data matrices.
%                   For nonparametric, permutation-based testing, the
%                last dimension of the data arrays (which may be of up to
%                4 dimensions) is permuted across conditions, either in
%                a 'paired' fashion (not changing the, e.g., subject or
%                trial order in the last dimension) or in an umpaired
%                fashion (not respecting this order). If the number of
%                elements in the last dimension is not the same across
%                conditions, the 'paired' option is turned 'off'.  Note:
%                All other dimensions MUST be constant across conditions.
%                   For example, consider a (1,3) cell array of matrices
%                of size (100,20,x) each holding a (100,20) time/frequency
%                transform from each of x subjects. Only the last dimension
%                (here x, the number of subjects) may differ across the
%                three conditions.
%                   The test used depends on the size of the data array input.
%                When the data cell array has 2 columns and the data are
%                paired, a paired t-test is performed; when the data are
%                unpaired, an unpaired t-test is performed. If 'data'
%                has only one row (paired or unpaired) and more than 2
%                columns, a one-way ANOVA is performed. If the data cell
%                array contains several rows and columns, and the data is
%                paired, a two-way repeated measure ANOVA is performed.
%                NOTE THAT IF THE DATA is unpaired, EEGLAB will use a
%                balanced 1 or 2 way ANOVA and parametric results might not
%                be meaningful (bootstrap and permstatcondutation should be fine).
%
% Optional inputs:
%   'paired'   = ['on'|'off'] pair the data array {default: 'on' unless
%                the last dimension of data array is of different lengths}.
%   'method'   = ['perm'|'bootstrap'|'param'] method for computing the p-values:
%                 'param' or 'parametric' = parametric testing (standard ANOVA
%                                           or t-test);
%                 'perm' or 'permutation' = non-parametric testing using
%                                           surrogate data
%                 'bootstrap' = non-parametric bootstrap
%                  made by permuting the input data {default: 'param'}
%   'naccu'    = [integer] Number of surrogate data copies to use in 'perm'
%                 or 'bootstrap' method estimation (see above) {default: 200}.
%   'verbose'  = ['on'|'off'] print info on the command line {default: 'on'}.
%   'variance' = ['homegenous'|'inhomogenous'] this option is exclusively
%                for parametric statistics using unpaired t-test. It allows
%                to compute a more accurate value for the degree of freedom
%                using the formula for inhomogenous variance (see
%                ttest2_cell function). Default is 'inhomegenous'.
%   'surrog'   = surrogate data array (see output).
%   'stats'    = F- or T-value array (see output).
%   'tail'     = ['one'|'two'] run one-tailed (F-test) or two tailed
%                (T-test). This option is only relevant when using the
%                'surrog' input. Otherwise it is ignored.
%   'forceanova' = ['on'|'off'] force the use of ANOVA calculation even
%                for 2x1 designs. Default is 'off'.
%   'alpha'    = [float] p-value threshold value. Allow returning
%                confidence intervals and mask (requires structoutput below).
%   'structoutput' = ['on'|'off'] return an output structure instead of
%                the regular output. Allow to output mask and confidence
%                intervals.
%   'cluster'  = ['on'|'off'] cluster correction for multiple comparison.
%                Only functional when alpha is set (if alpha is NaN, it
%                sets it to 0.05) and for 1-way Anova or t-test.
%
% Legacy parameters:
%   'threshold' - now 'alpha'
%   'mode'      - now 'method'
%
% Outputs:
%   stats      = F- or T-value array of the same size as input data without
%                the last dimension. A T value is returned only when the data
%                includes exactly two conditions.
%   df         = degrees of freedom, a (2,1) vector, when F-values are returned
%   pvals      = array of p-values. Same size as input data without the last
%                data dimension. All returned p-values are two-tailed.
%   surrog     = surrogate statistic values (same size as stats output with the last
%                dimension filled with a number ('naccu') of surrogate data sets.
%
% Important note: When a two-way ANOVA is performed, outputs are cell arrays
%                 with three elements: output(1) = row effects;
%                 output(2) = column effects; output(3) = interactions
%                 between rows and columns.
%
% Examples:
%      >> a = { rand(1,10) rand(1,10)+0.5 }; % pseudo 'paired' data vectors
%         [t df pvals] = statcond(a);        % perform paired t-test
%           pvals =
%              5.2807e-04 % standard t-test probability value
%         % Note: for different RAND outputs, results will differ.
%
%         [t df pvals surog] = statcond(a, 'method', 'perm', 'naccu', 2000);
%           pvals =
%              0.0065 % nonparametric t-test using 2000 permuted data sets
%
%         a = { rand(2,11) rand(2,10) rand(2,12)+0.5 }; % pseudo 'unpaired'
%         [F df pvals] = statcond(a); % perform an unpaired ANOVA
%           pvals =
%              0.00025 % p-values for difference between columns
%              0.00002 % for each data row
%
%         a = { rand(3,4,10) rand(3,4,10) rand(3,4,10); ...
%               rand(3,4,10) rand(3,4,10) rand(3,4,10)+0.5 };
%         % pseudo (2,3)-condition data array, each entry containing
%         %                                    ten (3,4) data matrices
%         [F df pvals] = statcond(a);  % perform a paired 2-way ANOVA
%         % Output:
%           pvals{1} % a (3,4) matrix of p-values; effects across rows
%           pvals{2} % a (3,4) matrix of p-values; effects across columns
%           pvals{3} % a (3,4) matrix of p-values; interaction effects
%                                      % across rows and columns
%
% Author: Arnaud Delorme, SCCN/INC/UCSD, La Jolla, 2005-
%         With thanks to Robert Oostenveld for fruitful discussions
%         and advices on this function.
%
% See also: ANOVA1_CELL, ANOVA2_CELL, ANOVA2RM_CELL, FCDF

% perform a paired t-test
% -----------------------
% a = { rand(2,10) rand(2,10) };
% [t df pval] = statcond(a); pval
% [h p t stat] = ttest( a{1}(1,:), a{2}(1,:)); p
% [h p t stat] = ttest( a{1}(2,:), a{2}(2,:)); p
%
% compare significance levels
% --------------------------
% a = { rand(1,10) rand(1,10) };
% [F df pval] = statcond(a, 'method', 'perm', 'naccu', 200); pval
% [h p t stat] = ttest( a{1}(1,:), a{2}(1,:)); p

% Copyright (C) Arnaud Delorme
%
% 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 [ ori_vals, df, pvals, surrogval ] = statcond( data, varargin );

    if nargin < 1
        help statcond;
        return;
    end
    try, warning('off', 'MATLAB:divideByZero'); catch, end;

    if exist('finputcheck')
        g = finputcheck( varargin, { 'naccu'      'integer'   [1 Inf]             200;
                                     'method'     'string'    { 'param','parametric','perm','permutation','bootstrap' }  'param';
                                     'mode'       'string'    { }                 '';
                                     'paired'     'string'    { 'on','off','auto' }      'auto';
                                     'surrog'     { 'real','cell' }      []       [];
                                     'stats'      { 'real','cell' }      []       [];
                                     'structoutput' 'string'  { 'on','off' }      'off';
                                     'forceanova'   'string'  { 'on','off' }      'off';
                                     'arraycomp'  'string'    { 'on','off' }      'on';
                                     'cluster'    'string'    { 'on','off' }      'off';
                                     'alpha'      'real'      []                  NaN;
                                     'tail'       'string'    { 'one','both','upper','lower'}    'both';
                                     'variance'   'string'    { 'homogenous','inhomogenous' }    'inhomogenous';
                                     'returnresamplingarray' 'string'    { 'on','off' }      'off';
                                     'verbose'    'string'    { 'on','off' }      'on' }, 'statcond');
        if ischar(g), error(g); end
    else
        g = struct(varargin{:});
        if ~isfield(g, 'naccu'),     g.naccu = 200; end
        if ~isfield(g, 'method'),    g.method  = 'param'; end
        if ~isfield(g, 'paired'),    g.paired = 'auto'; end
        if ~isfield(g, 'surrog'),    g.surrog = []; end
        if ~isfield(g, 'orivals'),   g.orivals = []; end
        if ~isfield(g, 'arraycomp'), g.arraycomp = 'on'; end
        if ~isfield(g, 'verbose'),   g.verbose = 'on'; end
        if ~isfield(g, 'tail'),      g.tail = 'both'; end
        if ~isfield(g, 'variance'),  g.variance = 'homogenous'; end
        if ~isfield(g, 'structoutput'), g.structoutput = 'on'; end
        if ~isfield(g, 'returnresamplingarray'),   g.returnresamplingarray = 'off'; end
    end
    if ~isempty(g.mode), g.method = g.mode; end
    if size(data,2) == 1, data  = transpose(data); end % cell array transpose

    % other settings
    % --------------
    if strcmpi(g.method, 'parametric'), g.method = 'param'; end
    if strcmpi(g.method, 'permutation'), g.method = 'perm'; end
    if strcmpi(g.verbose, 'on'), verb = 1; else verb = 0; end
    if strcmp(g.method, 'param' ) && exist('fcdf') ~= 2
      myfprintf('on',['statcond(): parametric testing requires fcdf() \n' ...
               '            from the Matlab StatsticaL Toolbox.\n' ...
               '            Running nonparametric permutation tests\n.']);
      g.method = 'perm';
    end
    g.naccu = round(g.naccu);

    % pairing
    % -------
    paired{1} = 'on';
    if size(data,1) == 1 && length(unique(cellfun('size', data, ndims(data{1}) ))) > 1
        paired{1} = 'off';
    else
        paired{1} = 'on';
        for iCol = 1:size(data,2)
            if length(unique(cellfun('size', data(:,iCol), ndims(data{1}) ))) > 1
                paired{1} = 'off';
            end
        end
        paired{2} = 'on';
        for iRow = 1:size(data,1)
            if length(unique(cellfun('size', data(iRow,:), ndims(data{1}) ))) > 1
                paired{2} = 'off';
            end
        end
    end
    if length(paired) > 1
        if (strcmpi(paired{1}, 'off') && strcmpi(paired{2}, 'on')) || ...
                (strcmpi(paired{1}, 'on') && strcmpi(paired{2}, 'off'))
            myfprintf(g.verbose, 'Possible mixed paired and unpaired independent variables, using balanced Anova (which assumes all unpaired)\n');
            paired{1} = 'off';
        end
    end
    if strcmpi(g.paired, 'auto')
        g.paired = paired{1};
    else
        if strcmpi(g.paired, 'on') && strcmpi(paired{1}, 'off')
            myfprintf(g.verbose, 'You set to use paired statistics but the number of cases differs\n');
            g.paired = 'off';
        end
    end

    % reshape matrices
    % ----------------
    nd = size(data{1});
    nd = nd(1:end-1);
    for index = 1:prod(size(data))
        data{index} = reshape(data{index}, [prod(nd) size(data{index},myndims(data{index}))]);
    end

    if ~strcmpi(g.method, 'param') && isempty(g.surrog)
         tmpsize   = size(data{1});
         surrogval = zeros([ tmpsize(1:end-1) g.naccu ], 'single');
    else surrogval = [];
    end

    % check for NaNs or Inf
    % ---------------------
    for iDat = 1:length(data(:))
        if any(isnan(reshape(data{iDat}, prod(size(data{iDat})),1))) || ...
                any(isinf(reshape(data{iDat}, prod(size(data{iDat})),1)))
            error('Statcond: One of the input array contains NaNs or Infinite values');
        end
    end

    % bootstrap flag
    % --------------
    if strcmpi(g.method, 'bootstrap'), bootflag = 1;
    else                               bootflag = 0;
    end

    if isempty(g.surrog)

        % return resampling array
        % -----------------------
        if strcmpi(g.returnresamplingarray, 'on')
            if strcmpi(g.arraycomp, 'on')
                ori_vals = surrogdistrib( data, 'method', g.method, 'pairing', g.paired, 'naccu', g.naccu);
            else
                ori_vals = surrogdistrib( data, 'method', g.method, 'pairing', g.paired);
            end
            return;
        end

        % text output
        % -----------
        myfprintf(verb,'%d x %d, ', size(data,1), size(data,2));
        if strcmpi(g.paired, 'on')
             myfprintf(verb,'paired data, ');
        else myfprintf(verb,'unpaired data, ');
        end
        if size(data,1) == 1 && size(data,2) == 2
             myfprintf(verb,'computing T values\n');
        else myfprintf(verb,'computing F values\n');
        end
        if size(data,1) > 1
            if strcmpi(g.paired, 'on')
                 myfprintf(verb,'Using 2-way repeated measure ANOVA\n');
            else myfprintf(verb,'Using balanced 2-way ANOVA (not suitable for parametric testing, only bootstrap)\n');
            end
        elseif size(data,2) > 2
            if strcmpi(g.paired, 'on')
                 myfprintf(verb,'Using 1-way repeated measure ANOVA\n');
            else myfprintf(verb,'Using balanced 1-way ANOVA (equivalent to Matlab anova1)\n');
            end
        else
            if strcmpi(g.paired, 'on')
                 myfprintf(verb,'Using paired t-test\n');
            else myfprintf(verb,'Using unpaired t-test\n');
            end
        end
        if ~strcmpi(g.method, 'param')
            if bootflag, myfprintf(verb,'Bootstraps (of %d):', g.naccu);
            else         myfprintf(verb,'Permutations (of %d):', g.naccu);
            end
        end
    end

    tail = g.tail;
    if isempty(g.surrog)
        if size(data,1) == 1 % only one row

            if size(data,2) == 2 && strcmpi(g.forceanova, 'off')

                % paired t-test (very fast)
                % -------------
                [ori_vals, df] = ttest_cell_select(data, g.paired, g.variance);

                if strcmpi(g.method, 'param')

                    % Check if exist tcd.m file from the Statistics Toolbox (Bug 1352 )
                    if exist('tcdf','file') == 2  && license('test', 'Statistics_Toolbox')
                        pvals = 2*tcdf(-abs(ori_vals), df);
                    else
                        pvals = 2*mytcdf(-abs(ori_vals), df);
                    end

                    pvals = reshape(pvals, size(pvals));
                else
                    if strcmpi(g.arraycomp, 'on')
                        try
                            myfprintf(verb,'...');
                            res = surrogdistrib( data, 'method', g.method, 'pairing', g.paired, 'naccu', g.naccu);
                            surrogval = ttest_cell_select( res, g.paired, g.variance);
                        catch
                           lasterr
                           myfprintf(verb,'\nFast computation failed because of memory limitation, reverting to standard computation');
                           g.arraycomp = 'off';
                        end
                    end
                    if strcmpi(g.arraycomp, 'off')
                        [res, precomp] = surrogdistrib( data, 'method', g.method, 'pairing', g.paired);
                        for index = 1:g.naccu
                            res = surrogdistrib( {}, 'precomp', precomp);
                            if mod(index, 10) == 0, myfprintf(verb,'%d ', index); end
                            if mod(index, 100) == 0, myfprintf(verb,'\n'); end
                            if myndims(res{1}) == 1
                                 surrogval(index)     = ttest_cell_select(res, g.paired, g.variance);
                            else surrogval(:,index)   = ttest_cell_select(res, g.paired, g.variance);
                            end
                        end
                    end
                end
            else
                % one-way ANOVA (paired) this is equivalent to unpaired t-test
                % -------------
                tail = 'one';
                [ori_vals, df] = anova1_cell_select( data, g.paired );
                if strcmpi(g.method, 'param')
                    pvals = 1-fcdf(ori_vals, df(1), df(2));
                else
                    if strcmpi(g.arraycomp, 'on')
                        try
                            myfprintf(verb,'...');
                            res = surrogdistrib( data, 'method', g.method, 'pairing', g.paired, 'naccu', g.naccu);
                            surrogval = anova1_cell_select( res, g.paired );
                        catch,
                            myfprintf(verb,'\nFast computation failed because of memory limitation, reverting to standard computing');
                            g.arraycomp = 'off';
                        end
                    end
                    if strcmpi(g.arraycomp, 'off')
                        [res, precomp] = surrogdistrib( data, 'method', g.method, 'pairing', g.paired);
                        for index = 1:g.naccu
                            if mod(index, 10) == 0, myfprintf(verb,'%d ', index); end
                            if mod(index, 100) == 0, myfprintf(verb,'\n'); end

                            res = surrogdistrib( {}, 'precomp', precomp);
                            if myndims(data{1}) == 1
                            	 surrogval(index)     = anova1_cell_select( res, g.paired );
                            else surrogval(:,index)   = anova1_cell_select( res, g.paired );
                            end
                        end
                    end
                end
            end
        else
            % two-way ANOVA (paired or unpaired)
            % ----------------------------------
            tail = 'one';
            [ ori_vals{1}, ori_vals{2}, ori_vals{3}, df{1}, df{2}, df{3} ] = anova2_cell_select( data, g.paired );
            if strcmpi(g.method, 'param')
                pvals{1} = 1-fcdf(ori_vals{1}, df{1}(1), df{1}(2));
                pvals{2} = 1-fcdf(ori_vals{2}, df{2}(1), df{2}(2));
                pvals{3} = 1-fcdf(ori_vals{3}, df{3}(1), df{3}(2));
            else
                surrogval = { surrogval surrogval surrogval };
                dataori   = data;
                if strcmpi(g.arraycomp, 'on')
                    try
                        myfprintf(verb,'...');
                        res = surrogdistrib( data, 'method', g.method, 'pairing', g.paired, 'naccu', g.naccu);
                        [ surrogval{1}, surrogval{2}, surrogval{3} ] = anova2_cell_select( res, g.paired );
                    catch
                        myfprintf(verb,'\nFast computation failed because of memory limitation, reverting to standard computing');
                        g.arraycomp = 'off';
                    end
                end
                if strcmpi(g.arraycomp, 'off')
                    [res, precomp] = surrogdistrib( data, 'method', g.method, 'pairing', g.paired);
                    for index = 1:g.naccu
                        if mod(index, 10) == 0, myfprintf(verb,'%d ', index); end
                        if mod(index, 100) == 0, myfprintf(verb,'\n'); end

                        res = surrogdistrib( {}, 'precomp', precomp);
                        if myndims(data{1}) == 1
                         	 [ surrogval{1}(index),     surrogval{2}(index),     surrogval{3}(index)     ] = anova2_cell_select( res, g.paired );
                        else [ surrogval{1}(:,index),   surrogval{2}(:,index),   surrogval{3}(:,index)   ] = anova2_cell_select( res, g.paired );
                        end
                    end
                end
            end
        end
        myfprintf(verb,'\n');
    else
        surrogval = g.surrog;
        ori_vals  = g.stats;
        df        = [];
    end

    % compute p-values
    % ----------------
    if ~strcmpi(g.method, 'param')
        if iscell( surrogval )
            pvals{1} = stat_surrogate_pvals(surrogval{1}, ori_vals{1}, tail);
            pvals{2} = stat_surrogate_pvals(surrogval{2}, ori_vals{2}, tail);
            pvals{3} = stat_surrogate_pvals(surrogval{3}, ori_vals{3}, tail);
        else
            if strcmpi(g.cluster, 'on')
                if isnan(g.alpha)
                    g.alpha = 0.05;
                    disp('Alpha value set to 0.05 automatically');
                end
                if size(surrogval,3) > 1 || size(surrogval,4) > 1 || isnan(g.alpha)
                    error('Cluster method not implemented for alpha NaN or for more than 2 dims');
                else
                    tmpPvals = 2*tcdf(-abs(surrogval), size(surrogval,1)) < g.alpha;
                    largestCluster = zeros(1, size(surrogval,2));
                    signifPos = zeros(1, size(surrogval,1));
                    for iSurog = 1:size(surrogval,2)
                        signifPos = tmpPvals(:,iSurog);
                        while any(signifPos)
                            tmpInd = find(signifPos);
                            currentInd = tmpInd(1);
                            currentCount = 0;
                            while currentInd+currentCount <= length(signifPos) && signifPos(currentInd+currentCount) == 1
                                signifPos(currentInd+currentCount) = 0;
                                currentCount = currentCount+1;
                            end
                            if currentCount > largestCluster(iSurog), largestCluster(iSurog) = currentCount; end
                        end
                    end
                    largestCluster = sort(largestCluster);
                    thresholdVal = largestCluster(round(length(largestCluster)*(1-g.alpha)));

                    % assign p-val status
                    signifPos = 2*tcdf(-abs(ori_vals), length(ori_vals)) < g.alpha;
                    pvals     = ones(size(signifPos));
                    while any(signifPos)
                        tmpInd = find(signifPos);
                        currentInd = tmpInd(1);
                        currentCount = 0;
                        while currentInd+currentCount <= length(signifPos) && signifPos(currentInd+currentCount) == 1
                            signifPos(currentInd+currentCount) = 0;
                            currentCount = currentCount+1;
                        end
                        if currentCount >= thresholdVal, pvals(currentInd:currentInd+currentCount-1) = 0; end
                    end

                end
            else
                pvals = stat_surrogate_pvals(surrogval, ori_vals, tail);
            end
        end
        try, warning('on', 'MATLAB:divideByZero'); catch, end
    end

    [ ori_vals, pvals ] = reshape_results( nd, ori_vals, pvals);
    [ surrogval ]       = reshape_results( [nd g.naccu], surrogval);

    % confidence intervals
    % --------------------
    if ~isnan(g.alpha)
        outputstruct.ci = stat_surrogate_ci(surrogval, g.alpha, tail);
        if strcmpi(g.structoutput, 'off')
            disp('Warning: returning confidence interval requires an output structure');
        end
        if iscell(pvals)
            for ind = 1:length(pvals)
                outputstruct.mask{ind} = pvals{ind} < g.alpha;
            end
        else
            outputstruct.mask = pvals < g.alpha;
        end
    end

    % create a structure for outputting values
    % ---------------------------------------
    if strcmpi(g.structoutput, 'on')
        outputstruct.method = g.method;
        outputstruct.pval   = pvals;
        outputstruct.df     = df;
        outputstruct.surrog = surrogval;
        if length(data(:)) == 2
             outputstruct.t = ori_vals;
        else outputstruct.f = ori_vals;
        end
        outputstruct.stat   = ori_vals;
        ori_vals = outputstruct;
    end

% compute ANOVA 2-way
% -------------------
function [f1, f2, f3, df1, df2, df3] = anova2_cell_select( res, paired)
    if strcmpi(paired,'on')
        [f1, f2, f3, df1, df2, df3] = anova2rm_cell( res );
    else
        [f1, f2, f3, df1, df2, df3] = anova2_cell( res );
    end

% compute ANOVA 1-way
% -------------------
function [f, df] = anova1_cell_select( res, paired)
    if strcmpi(paired,'on')
        [f, df] = anova1rm_cell( res );
    else
        [f, df] = anova1_cell( res );
    end

% compute t-test
% -------------------
function [t, df] = ttest_cell_select( res, paired, homogenous)
    if strcmpi(paired,'on')
        [t, df] = ttest_cell( res{1}, res{2});
    else
        [t, df] = ttest2_cell( res{1}, res{2}, homogenous);
    end

% function to compute the number of dimensions
% --------------------------------------------
function val = myndims(a)
    if ndims(a) > 2
        val = ndims(a);
    else
        if size(a,1) == 1
            val = 2;
        elseif size(a,2) == 1
            val = 1;
        else
            val = 2;
        end
    end

% function for verbose messages
% -----------------------------
function myfprintf(verb, varargin)
    if verb
        fprintf(varargin{:});
    end

% function to replace tcdf
% ------------------------
function p = mytcdf(x,v)

if length(v) == 1
    v = repmat(v, size(x));
end

x2 = x.^2;
inds1 = (v < x2);
inds2 = (v >= x2);
if any(inds1(:)), p(inds1) = betainc(v(inds1) ./ (v(inds1) + x2(inds1)), v(inds1)/2, 0.5, 'lower') / 2; end
if any(inds2(:)), p(inds2) = betainc(x2(inds2) ./ (v(inds2) + x2(inds2)), 0.5, v(inds2)/2, 'upper') / 2; end
inds = (x > 0);
if any(inds)
    p(inds) = 1 - p(inds);
end

inds = (v > 1e7);
if any(inds(:)), p(inds) = normcum(x(inds)); end

p(x == 0) = 0.5;
if isempty(p)
    p = ones(size(x));
else
    p = reshape(p, size(x));
end
function [p] = normcum(z)
p = 0.5 * erfc(-z ./ sqrt(2));

% reshape results
% ---------------
function varargout = reshape_results(nd, varargin)
    if length(varargin) > 1
        for index = 1:length(varargin)
            varargout{index} = reshape_results(nd, varargin{index});
        end
    elseif iscell(varargin{1})
        for index = 1:length(varargin{1})
            varargout{1}{index} = reshape_results(nd, varargin{1}{index});
        end
    else
        if ~isempty(varargin{1})
            if length(nd) == 1, nd = [ nd 1 ]; end
            varargout{1} = reshape(varargin{1}, nd);
        else varargout{1} = [];
        end
    end


function [ ap, info ] = dppfa ( ap, n )

%*****************************************************************************80
%
%% DPPFA factors a real symmetric positive definite matrix in packed form.
%
%  Discussion:
%
%    DPPFA is usually called by DPPCO, but it can be called
%    directly with a saving in time if RCOND is not needed.
%
%  Packed storage:
%
%    The following program segment will pack the upper
%    triangle of a symmetric matrix.
%
%      k = 0
%      do j = 1, n
%        do i = 1, j
%          k = k + 1
%          ap(k) = a(i,j)
%        end
%      end
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    17 June 2005
%
%  Author:
%
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Dongarra, Moler, Bunch and Stewart,
%    LINPACK User's Guide,
%    SIAM, (Society for Industrial and Applied Mathematics),
%    3600 University City Science Center,
%    Philadelphia, PA, 19104-2688.
%    ISBN 0-89871-172-X
%
%  Parameters:
%
%    Input, real AP(N*(N+1)/2), the packed form of a symmetric matrix A.
%    The columns of the upper triangle are stored sequentially in a
%    one-dimensional array.
%
%    Input, integer N, the order of the matrix.
%
%    Output, real AP(N*(N+1)/2), an upper triangular matrix R, stored
%    in packed form, so that A = R'*R.
%
%    Output, integer INFO, error flag.
%    0, for normal return.
%    K, if the leading minor of order K is not positive definite.
%
  info = 0;
  jj = 0;

  for j = 1 : n

    s = 0.0;
    kj = jj;
    kk = 0;

    for k = 1 : j-1

      kj = kj + 1;
      t = ap(kj) - ddot ( k-1, ap(kk+1:kk+k-1), 1, ap(jj+1:jj+k-1), 1 );
      kk = kk + k;
      t = t / ap(kk);
      ap(kj) = t;
      s = s + t * t;

    end

    jj = jj + j;
    s = ap(jj) - s;

    if ( s <= 0.0 )
      info = j;
      return
    end

    ap(jj) = sqrt ( s );

  end

  return
end


function sol=polynsolve(polyset,ord,varnames,tol)
% POLYNSOLVE - attempt exact solution of multivariate polynomial system
%
% usage: sol=polynsolve(polyset)
%
% INPUTS: polyset, ord, varnames, tol
%  polyset is a cell array of polynomials in string or coefficient form
%    that is acceptable input for petschel.groebner.m
%  ord (optional) is the preferred ordering
%  varnames (optional) is the list of variable names if not {'x1','x2',...}
%  tol (optional) is the default zero tolerance
%    (see petschel.groebner.m for further details on ord, varnames, tol)
%
% OUTPUTS: sol
%  sol is an array containing the solutions to {polyset{:}=0}:
%    sol(i,j) is the value of xj in the i'th solution
%    If there are infinitely many solutions, sol(i,j)=NaN
%
% ALGORITHM:
%  Uses petschel.groebner bases (lex order).  If any one-variable polynomials
%  result, solve them and substitute back into the equations.
%  If "1" results, the system is not solvable.  If any multivariate polys
%  remain, those variables have an infinite number of solutions.
%
% KNOWN BUGS
%  See petschel.groebner.m for details
%
% SEE ALSO:
%  petschel.groebner, petschel.poly2str, petschel.str2poly

% Author: Ben Petschel 23/6/2009
%
% Change history:
%  23/6/2009 - first release
%  30/3/2010 - change poly representation from n-dim to rectangular array

if nargin<4

    tol = 0;

    if nargin<3

        varnames = {};

    end

end

if (nargin<2) || isempty(ord)

    ord = 'lex';

end

if (numel(polyset)>0) && ischar(polyset{1})

    polyset = petschel.str2poly(polyset,varnames);

end

gbasis=petschel.groebner(polyset,ord,varnames,tol);

% if petschel.groebner is all linear terms, it is a solution, otherwise find
% 1-variable polynomials and solve them, substituting the solutions into
% the other equations
sol = [];

i=1;

keepgoing = true;

while keepgoing && (i<=numel(gbasis))

    % search for 1-variable polynomials
    d = size(gbasis{i},2)-1;

    if numel(sol)<d
        % sol will always be a row vector, until possibly the final step
        % make sure sol has enough possible variables
        sol = [sol,nan(1,d-numel(sol))];

    end

    [tf,n,Q]=ispoly1(gbasis{i});

    if tf
        % attempt solution
        if length(Q)==1
            % have equation 1==0, so no solution
            sol = [];

            keepgoing = false;

        elseif length(Q)==2
            % Q=[a;b] so have equation a*xn+b=0 (a~=0) and solution is x=-b/a

            sol(n) = -Q(2)/Q(1);

        else
            % have polynomial in xn, so solve and substitute solution
            r = roots(Q);

            gbasisrecur = gbasis;

            sol = [];

            for j=1:length(r)
                % replace equation i with linear term (xn-r(j)==0)

                gbasisrecur{i} = linearterm(r(j),n);

                sol = [sol; petschel.polynsolve(gbasisrecur,ord,varnames,tol)];

                keepgoing = false;

            end

        end

    end

    i = i+1;

end

end % main function polynsolve(...)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [tf,n,Q]=ispoly1(P)
% returns tf=true if P is a 1-variable polynomial
% n is the number of the variable the polynomial is in
% Q is a column vector of the polynomial coefficients

if isempty(P) || all(P(:)==0)

    tf=true;

    n=1;

    Q=0;

elseif size(P,2)==1

    tf=true;

    n=1;

    Q=P;

else

    ind = find(any(P(:,2:end)>0,1));

    if numel(ind)==1
        % is a polynomial in 1 variable if exponents of only 1 variable are >0
        tf=true;

        n=ind;

        Q=[]; % collect coefficients of the polynomial

        Q(P(:,ind+1)+1)=P(:,1);

        Q=Q(end:-1:1); % reverse order to be consistent with ROOTS

    else

        tf=false;

        n=0;

        Q=[];

    end

end

end % helper function ispoly1(...)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Q=linearterm(a,n)
% returns coefficient array of a linear term (xn-a)

Q=zeros(2,n+1);

Q(1,1)=-a;

Q(2,1)=1;

Q(2,end)=1;

end % helper function linearterm(...)


function plotAcrobot(t,z,u,p)

[energy.total, energy.potential, energy.kinetic] = acrobotEnergy(z,p);

subplot(2,3,1);
plot(t,z(1,:))
xlabel('t')
ylabel('q1')
title('link one angle')
subplot(2,3,2);
plot(t,z(2,:))
xlabel('t')
ylabel('q2')
title('link two angle')
subplot(2,3,4);
plot(t,z(3,:))
xlabel('t')
ylabel('dq1')
title('link one rate')
subplot(2,3,5);
plot(t,z(4,:))
xlabel('t')
ylabel('dq2')
title('link two rate')

subplot(2,3,3); hold on
plot(t,energy.total,'k')
plot(t,energy.potential,'r')
plot(t,energy.kinetic,'b')
legend('total','potential','kinetic')
xlabel('t')
ylabel('e');
title('mechanical energy')

subplot(2,3,6)
plot(t,u)
xlabel('t')
ylabel('u')
title('torque between links')

end


function[varargout]=transmaxdist(varargin)
%TRANSMAXDIST  Distributions of wavelet transform maxima in noise.
%
%   This function is part of 'element analysis' described in Lilly (2017),
%   "Element analysis: a wavelet-based method for analyzing time-localized
%   events in noisy time series", available at www.jmlilly.net.
%
%   [COUNT,BINS]=TRANSMAXDIST(GAMMA,BETA,ALPHA,FS,R,N,M) returns the
%   histogram of wavelet transform maxima magnitudes, for a length N time
%   series having spectral slope -2*ALPHA transformed at frequencies FS
%   using a (GAMMA,BETA) wavelet, based on a simulation having N*M points.
%
%   Here GAMMA, BETA, ALPHA, and R are all scalars, or are all arrays of
%   the same length as FS.  FS is a frequency array computed by MORSESPACE.
%
%   R is the ratio between each frequency FS and the next.  This will be
%   constant and greater than one when FS is computed by MORSESPACE.  As
%   as described in Appendix C of Lilly (2017), R=FS(n)./FS(n+1) for all n.
%
%   COUNT is the number of transform maxima observed at each frequency in
%   the magnitude bins BINS.  COUNT is a LENGTH(BINS) x LENGTH(FS) matrix.
%
%   Transform maxima values, as output in BINS, are normalized such that
%   the expected squared magnitude of the wavelet transform of noise occurs
%   at unity.  BINS thus corresponds to the normalized event magnitude.
%
%   TRANSMAXDIST works by simulating a vector whose statistical properties
%   mimic those of the wavelet transform and the four adjacted points, thus
%   avoiding the need to explicitly compute the transform.  The choice of
%   e.g. M=1000 simulates a transform 1000 times as long as time series of
%   interest, which itself is of length N.
%
%   [COUNT,BINS,RATE]=TRANSMAXDIST(...) also returns the RATE, the
%   normalized reversed cumulative density function.  RATE gives the
%   expected number of transform maxima occuring in a time series of length
%   N having a magnitude greater than the corresponding bin value.
%
%   [COUNT,BINS,RATE,SIGMA]=TRANSMAXDIST(...) also returns the theoretical
%   covariance matrix SIGMA from which the Monte Carlo simulations are
%   constructed.  SIGMA is an array of length 5 x 5 x LENGTH(FS).
%
%   Note that if the covariance matrix is not positive definite, as can
%   happen due to numerical complications for extreme BETA and GAMMA
%   choices, then COUNT and RATE will both consist entirely of NaNs.
%   _______________________________________________________________________
%
%   Additional options
%
%   TRANSMAXDIST(...,BINS) alternately uses BINS for the bin centers
%   instead of the default choice, which is set to LINSPACE(0,6,200)'.
%
%   By default, TRANSMAXDIST performs a simulation for each of the scale
%   frequencies in FS.  TRANSMAXDIST(...,'extrapolate') instead computes
%   the distribution only for the highest scale frequency, then
%   extrapolates these values to all other scale frequencies with a scaling
%   law.  GAMMA, BETA, ALPHA, and R must all be scalars in this case.
%
%   For details, see Lilly (2017).
%
%   See also MAXPROPS, TRANSMAX, ISOMAX, MAX2EDDY.
%
%   'transmaxdist --t' runs some tests.
%
%   Usage: [count,bins]=transmaxdist(ga,be,al,fs,r,N,M);
%          [count,bins,rate,sigma]=transmaxdist(ga,be,al,fs,r,N,M);
%          [count,bins,rate,sigma]=transmaxdist(ga,be,al,fs,r,N,M,'extrap');
%   __________________________________________________________________
%   This is part of JLAB --- type 'help jlab' for more information
%   (C) 2017 J.M. Lilly --- type 'help jlab_license' for details

if strcmp(varargin{1}, '--t')
    transmaxdist_test,return
end

%parstr='serial';
%
%   TRANSMAXDIST(...,'parallel') uses a PARFOR loop in the computation of
%   the covariance matrix SIGMA.  The default behavior is 'serial'.

str='all';
normstr='band';
for i=1:3
    if ischar(varargin{end})
        if strcmpi(varargin{end}(1:3),'all')||strcmpi(varargin{end}(1:3),'ext')
            str=varargin{end};
        elseif strcmpi(varargin{end}(1:3),'ser')||strcmpi(varargin{end}(1:3),'par')
            parstr=varargin{end};
        elseif strcmpi(varargin{end}(1:3),'ban')||strcmpi(varargin{end}(1:3),'ene')
            normstr=varargin{end};
        end
        varargin=varargin(1:end-1);
    end
end

gamma=varargin{1};
beta=varargin{2};
alpha=varargin{3};
fs=varargin{4};
r=varargin{5};
N=varargin{6};
M=varargin{7};
if length(varargin)==7
    bins=linspace(0,6,200)';
else
    bins=varargin{8}(:);
end

s=morsefreq(gamma,beta)./fs;

%Some error checking
if ~isscalar(gamma)
    lg=length(gamma);
    lb=length(beta);
    la=length(alpha);
    ls=length(s);
    lr=length(r);
    if ~(lg==lb&&lg==la&&lg==ls&&lg==lr)
        error('TRANSMAXDIST was expecting the first five input arguments to all be the same length.')
    end
    if strcmpi(str(1:3),'ext')&&(length(gamma)>1)
        error('Sorry, ALPHA, BETA, GAMMA, FS, and R must be scalars for ''extrapolate'' option.')
    end
else
    if length(s)>1
        ro=s(2:end)./s(1:end-1);
        if ~allall(abs(ro-r)<1e8)
            disp('Input value of R does not match that computed from FS.');
        end
    end
end

arrayify(s,r,gamma,beta,alpha);
Sigma=zeros(5,5,length(s));

%s,r,gamma,beta,alpha
%if strcmpi(parstr(1:3),'ser')
    for i=1:length(s)
        Sigma(:,:,i)=sigmamat1(s(i),r(i),gamma(i),beta(i),alpha(i),normstr);
    end
%elseif strcmpi(parstr(1:3),'par')
%    parfor i=1:length(s)
%        Sigma(:,:,i)=sigmamat1(s(i),r(i),gamma(i),beta(i),alpha(i),normstr);
%    end
%end

xeps=(randn(5,N*M)+1i*randn(5,N*M))./sqrt(2);%std(xeps(:))
n=zeros(length(bins),length(s));

if strcmpi(str(1:3),'all')
    for k=1:length(s)
        disp(['TRANSMAXDIST performing simulation ' int2str(k) ' of ' int2str(length(s)) '.'])
        try
           L=chol(Sigma(:,:,k),'lower');
        catch
           L=[];
        end

        if ~isempty(L)
            wsim=L*xeps;

            bool=(abs(wsim(1,:))>abs(wsim(2,:)));
            bool=bool&(abs(wsim(1,:))>abs(wsim(3,:)));
            bool=bool&(abs(wsim(1,:))>abs(wsim(4,:)));
            bool=bool&(abs(wsim(1,:))>abs(wsim(5,:)));

            wmax=wsim(1,bool);
            nk=hist(abs(wmax),bins);
            n(:,k)=nk';
        else
            n(:,k)=nan*ones(size(n(:,k)));
        end
    end
elseif strcmpi(str(1:3),'ext')
    L=chol(Sigma(:,:,1),'lower');
    wsim=L*xeps;

    bool=(abs(wsim(1,:))>abs(wsim(2,:)));
    bool=bool&(abs(wsim(1,:))>abs(wsim(3,:)));
    bool=bool&(abs(wsim(1,:))>abs(wsim(4,:)));
    bool=bool&(abs(wsim(1,:))>abs(wsim(5,:)));

    wmax=wsim(1,bool);
    nk=hist(abs(wmax),bins);
    n(:,1)=nk';
    for k=2:length(s)
        n(:,k)=n(:,1)*frac(s(1),s(k));
    end
end

n=n./M;
rate=cumsum(n,1,'reverse');

%rate=n;
%for i=1:size(n,2)
    %L=2*sqrt(2)*sqrt(gamma(i).*beta(i))./fs(i);
 %   rate(:,i)=cumsum(n(:,i),1,'reverse');
%end

%     for i=1:5
%         for j=1:5
%             Sigmahat(i,j)=vmean(wsim(i,:).*conj(wsim(j,:)),2);
%         end
%     end
%     Sigmahat=Sigmahat./vmean(squared(wsim(1,:)),2);

varargout{1}=n;
varargout{2}=bins;
varargout{3}=rate;
varargout{4}=Sigma;
%varargout{4}=Sigmahat;

function[Sigma]=sigmamat1(s,r,gamma,beta,alpha,normstr)

p={gamma,beta,alpha,normstr};
Sigma=zeros(5,5);

Sigma(1,:)=[xi(0,s,1,p) xi(1,s,1,p)  xi(-1,s,1,p)  xi(0,s,r,p)   xi(0,s,1/r,p)     ];
Sigma(2,:)=[nan         xi(0,s,1,p)  xi(-2,s,1,p)  xi(-1,s,r,p)  xi(-1,s,1/r,p)    ];
Sigma(3,:)=[nan         nan          xi(0,s,1,p)   xi(1,s,r,p)   xi(1,s,1/r,p)     ];
Sigma(4,:)=[nan         nan          nan           xi(0,r*s,1,p) xi(0,r*s,1/r.^2,p)];
Sigma(5,:)=[nan         nan          nan           nan           xi(0,s/r,1,p)     ];

for j=1:5
    for i=(j+1):5
          Sigma(i,j)=conj(Sigma(j,i));
    end
end

[m0,ffun]=morsemom(-2*alpha,gamma,beta);
if strcmpi(normstr(1:3),'ene')
    Sigma=frac(Sigma,ffun.*s.^(2*alpha));
elseif strcmpi(normstr(1:3),'ban')
    Sigma=frac(Sigma,ffun*s.^(2*alpha-1));
end

function[x]=xi(tau,s,r,p)

gamma=p{1};
beta=p{2};
alpha=p{3};
normstr=p{4};

rtilde=(1+r.^gamma).^(1./gamma);

%Implicitly set A^2=1 as I will shortly divide by it
%fact1=frac(morseafun(gamma,beta).^2,morseafun(gamma,2*beta-2*alpha));
%fact2=frac((r.^beta).*(s.^(2*alpha-1)),rtilde.^(2*beta-2*alpha+1));

%Note:  use the input normalization in the numerator, and the *amplitude*
%normalization in the denominator.  All the latter does is cancel the
%coefficient coming from MORSEXPAND, which assumes the amplitude normalization
fact1=frac(morseafun(gamma,beta,normstr).^2,morseafun(gamma,2*beta-2*alpha));
if strcmpi(normstr(1:3),'ene')
    fact2=frac((r.^(beta+1/2)).*(s.^(2*alpha)),rtilde.^(2*beta-2*alpha+1));
elseif strcmpi(normstr(1:3),'ban')
    fact2=frac((r.^beta).*(s.^(2*alpha-1)),rtilde.^(2*beta-2*alpha+1));
end

x=fact1.*fact2.*conj(morsexpand(tau./(s.*rtilde),gamma,2*beta-2*alpha,morsefreq(gamma,2*beta-2*alpha)));
%x=fact1.*fact2.*conj(morsexpand(tau./(s.*rtilde),gamma,2*beta-2*alpha,morsefreq(gamma,2*beta-2*alpha),'cumulant'));

%fact1,fact2
%Equivalent
%fact2=frac((r.^beta).*(s.^(2*alpha)),rtilde.^(2*beta-2*alpha));
%fs=morsefreq(gamma,2*beta-2*alpha)./(s.*rtilde);
%x=fact1.*fact2.*conj(morsexpand(tau,gamma,2*beta-2*alpha,fs));

function[]=transmaxdist_test

for k=1:2
    tic
    ga=2;be=2;
    switch k
        case 1
            alpha=0;
        case 2
            alpha=1;
    end
    %fs=morsespace(ga,be,100);
    fs=morsespace(ga,be,{0.01,pi},2*pi/100);
    N=1e6;
    rng(1);
    x=randn(N,1);
    if alpha ==1
        x=cumsum(x);
        x=x./std(x);
    end
    w=wavetrans(x,{ga,be,fs(1:3),'bandpass'});

    clear xvec
    xvec(:,1)=w(:,2);
    xvec(:,2)=w([2:end 1],2);
    xvec(:,3)=w([end 1:end-1],2);
    xvec(:,4)=w(:,3);
    xvec(:,5)=w(:,1);

    for i=1:5
        for j=1:5
            Sigmahat(i,j)=vmean(xvec(:,i).*conj(xvec(:,j)),1);
        end
    end
    Sigmahat=Sigmahat./vmean(squared(xvec(:,1)),1);

    [count,bins,rate,Sigma]=transmaxdist(ga,be,alpha,fs(2),fs(1)./fs(2),N,1);
    switch k
        case 1
            bool=maxmax(abs(Sigma-Sigmahat)./abs(Sigma))<1/100;
            reporttest('TRANSMAXDIST simulated and theoretical covariance matrices agree to within 1%, white noise case',bool)
        case 2
            bool=maxmax(abs(Sigma-Sigmahat)./abs(Sigma))<4/100;
            reporttest('TRANSMAXDIST simulated and theoretical covariance matrices agree to within 4%, red noise case',bool)
    end

    %[index,ww]=transmax(fs(1:3),w);
    %n=hist(abs(ww)./vstd(w(:,2),1),bins)';
    %figure,plot(bins,[count n]) %That looks great!
end

function[]=transmaxdist_other

%[n,sigma]=transmaxdist(ga,be,0,[fs(2) fs(3)],N/10);
N=1e8;
tic;[n,x,Sigma]=transmaxdist(ga,be,0,fs,N);toc
for i=1:size(n,2)
    ntilde(:,i)=n(:,i)./frac(N,2*sqrt(2)*sqrt(ga*be)./fs(i));
    %ntilde(:,i)=n(:,i)./sum(n(:,i));
end

tic
N=1e8;
x=randn(N,1);
w=wavetrans(x,{ga,be,fs(1:3)});
toc

tic; [ii,jj,ww,ff]=transmax(fs(1:3),w);toc
bins=linspace(0,6,200)';
wwtilde=ww./sqrt(vmean(squared(w(:,2)),1));
nn=hist(abs(wwtilde),bins);
nn=nn./frac(N,2*sqrt(2)*sqrt(ga*be)./fs(2));


function yms=EWT2D_Curvelet_Scaling(Radius,w1,gamma,W,H)

%==================================================
% function ymw=EWT2D_Curvelet_Scaling(w1,gamma,W,H)
%
% Generate the 1D Littlewood-Paley wavelet in the
% Fourier domain associated to the disk [0,w1]
% with transition ratio gamma
%
% Input parameters:
%   -Radius : matrix giving the radius at each pixel
%   -w1 : boundary
%   -gamma : transition ratio
%   -W : image width
%   -H : image height
%
% Output:
%   -yms: Fourier transform of the scaling function
%
% Author: Jerome Gilles - Giang Tran
% Institution: UCLA - Department of Mathematics
% Year: 2013
% Version: 1.0
%===================================================

an=1/(2*gamma*w1);
pbn=(1+gamma)*w1;
mbn=(1-gamma)*w1;

yms=zeros(H,W);

for i=1:W
   for j=1:H
      if (Radius(j,i)<mbn)
        yms(j,i)=1;
      elseif ((Radius(j,i)>=mbn) && (Radius(j,i)<=pbn))
        yms(j,i)=cos(pi*EWT_beta(an*(Radius(j,i)-mbn))/2);
      end
   end
end


function W = unfold( U, dir )
    %UNFOLD Left/right-unfold a 3D array.
    %   W = UNFOLD(U, DIR) unfolds the 3-dim. tensor U in direction DIR, where
    %   DIR is either 'LEFT' or 'RIGHT' (case insensitive).
    %
    %   See also MATRICIZE, TENSORIZE, TENSORPROD_TTEMPS.

    %   TTeMPS Toolbox.
    %   Michael Steinlechner, 2013-2016
    %   Questions and contact: michael.steinlechner@epfl.ch
    %   BSD 2-clause license, see LICENSE.txt

    d = size(U);
    % pad with 1 for the last dim (annoying)
    if length(size(U)) == 2
        d = [d, 1];
    end

    if strcmpi(dir, 'left')
        W = reshape( U, [d(1)*d(2), d(3)] );
    elseif strcmpi(dir, 'right')
        W = reshape( U, [d(1), d(2)*d(3)] );
    else
        error('Unknown direction specified. Choose either LEFT or RIGHT')
    end
end


function [A,B] = vrep2hrep(pts);
%
% Given a set of points, computes an H-representation of its convex hull
%
%  A x <= B
%
% Calls Komei Fukuda's CDD (floating point version)

% This file is part of SOSTOOLS - Sum of Squares Toolbox ver 3.00.
%
% Copyright (C)2002, 2004, 2013  A. Papachristodoulou (1), J. Anderson (1),
%                                G. Valmorbida (1), S. Prajna (2),
%                                P. Seiler (3), P. A. Parrilo (4)
% (1) Department of Engineering Science, University of Oxford, Oxford, U.K.
% (2) Control and Dynamical Systems - California Institute of Technology,
%     Pasadena, CA 91125, USA.
% (3) Aerospace and Engineering Mechanics Department, University of
%     Minnesota, Minneapolis, MN 55455-0153, USA.
% (4) Laboratory for Information and Decision Systems, M.I.T.,
%     Massachusetts, MA 02139-4307
%
% Send bug reports and feedback to: sostools@cds.caltech.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, see <http://www.gnu.org/licenses/>.

% PP 22/10/2002

[npts,dim]=size(pts);

cdd = cddpath;

filename = 'temp.ext' ;

fid = fopen(filename,'w');

fprintf(fid,'*\n');
fprintf(fid,'* Generated automatically by vrep2hrep.m\n');
fprintf(fid,'*\n');
fprintf(fid,'V-representation\n');
fprintf(fid,'begin\n');
fprintf(fid,'%d %d real\n',npts,dim+1);

fmt = ['1 ' repmat('%.15E ',1,dim) '\n'];

% Print the data
fprintf(fid,fmt,pts');

fprintf(fid,'end\n');
fprintf(fid,'stdout_off\n');
fclose(fid);

% Now, run CDD
cmd = [cdd ' ' filename];

vv = version;
if str2num(vv(1))>5
  [dummy1,dummy2] = system(cmd);
else
  if ~isunix
    [dummy1,dummy2] = dos(cmd);
  else
    [dummy1,dummy2] = unix(cmd);
  end;
end;

% Read the output

filename = 'temp.ine' ;

fid = fopen(filename,'r');

% Skip everything, until 'begin'
tline = [];
while strcmp(tline,'begin') == 0;
 tline = fgetl(fid) ;
end

nineqs = fscanf(fid,'%d',1);
dims   = fscanf(fid,'%d',1);
dummy2 = fscanf(fid,'%s',1);

H = fscanf(fid,'%E',[dims,nineqs]);
fclose(fid);

% Get rid of the files
delete('temp.ext');
delete('temp.ine');

H = H' ;

B = H(:,1);
A = -H(:,2:dims);


% This is material illustrating the methods from the book
% Financial Modelling  - Theory, Implementation and Practice with Matlab
% source
% Wiley Finance Series
% ISBN 978-0-470-74489-5
%
% Date: 02.05.2012
%
% Authors:  Joerg Kienitz
%           Daniel Wetterau
%
% Please send comments, suggestions, bugs, code etc. to
% kienitzwetterau_FinModelling@gmx.de
%
% (C) Joerg Kienitz, Daniel Wetterau
%
% Since this piece of code is distributed via the mathworks file-exchange
% it is covered by the BSD license
%
% This code is being provided solely for information and general
% illustrative purposes. The authors will not be responsible for the
% consequences of reliance upon using the code or for numbers produced
% from using the code.

function phi = CharacteristicFunctionLib(model,u,lnS,T,r,d,varargin)
%---------------------------------------------------------
% Characteristic Function Library of the following models:
%---------------------------------------------------------
% Black Scholes
% Merton Jump Diffusion
% Heston Stochastic Volatility Model
% Bates Stochastic Volatility / Jump Diffusion Model
% Variance Gamma
% Normal Inverse Gaussian
% Meixner
% Generalized Hyperbolic
% CGMY
% Variance Gamma with Gamma Ornstein Uhlenbeck clock
% Variance Gamma with CIR clock
%---------------------------------------------------------

optAlfaCalculation = true;

ME1 = MException('VerifyInput:InvalidNrOfArguments',...
    'Invalid number of Input arguments');
ME2 = MException('VerifyInput:InvalidModel',...
    'Undefined Model');

if strcmp(model,'BlackScholes')
    if nargin == 7
        funobj = @Black_characteristicFn;
    else
        throw(ME1)
    end
elseif strcmp(model,'Heston')
    if nargin == 11
        funobj = @Heston_characteristicFn;
    else
        throw(ME1)
    end
elseif strcmp(model,'Merton')
    if nargin == 10
        funobj = @Merton_characteristicFn;
    else
        throw(ME1)
    end
elseif strcmp(model,'Bates')
    if nargin == 14
        funobj = @Bates_characteristicFn;
    else
        throw(ME1)
    end
elseif strcmp(model,'VarianceGamma')
    if nargin == 9
        funobj = @VG_characteristicFn;
    else
        throw(ME1)
    end
elseif strcmp(model,'NIG')
    if nargin == 10
        funobj = @NIG_characteristicFn;
    else
        throw(ME1)
    end
elseif strcmp(model,'CGMY')
    if nargin == 10
        funobj = @CGMY_characteristicFn;
    else
        throw(ME1)
    end
elseif strcmp(model,'Meixner')
    if nargin == 9
        funobj = @Meixner_characteristicFn;
    else
        throw(ME1)
    end
elseif strcmp(model,'GH')
    if nargin == 10
        funobj = @GH_characteristicFn;
    else
        throw(ME1)
    end
elseif strcmp(model,'IntegratedCIR')
    if nargin == 13
        funobj = @VarianceGammaCIR_characteristicFn;
    else
        throw(ME1)
    end
elseif strcmp(model,'VarianceGammaOU')
    if nargin == 12
        funobj = @VarianceGammaOU_characteristicFn;
    else
        throw(ME1)
    end
else
    throw(ME2)
end

fval = feval(funobj,u,lnS,T,r,d,varargin{:});

if optAlfaCalculation == true
    phi = fval;
else
    phi = exp(fval);
end

end

%% Explicit Implementation of the characteristic Functions E[exp(iu*lnS_T)]
%-----------------------------------------------------------------------

% Black Scholes
function phi = Black_characteristicFn(u,lnS,T,r,d,sigma)
    %phi = exp(i*u*(lnS+(r-d-0.5*sigma*sigma)*T) - 0.5*sigma*sigma*u.*u*T);
    phi = 1i*u*(lnS+(r-d-0.5*sigma*sigma)*T) - 0.5*sigma*sigma*u.*u*T;
end

% Merton Jump Diffusion
function phi = Merton_characteristicFn(u,lnS,T,r,d,sigma,a,b,lambda)
    phi = Black_characteristicFn(u,lnS,T,r,d,sigma) + LogNormalJump_characteristicFn(u,a,b,lambda,T);
end

% Heston
function phi = Heston_characteristicFn(u,lnS,T,r,d,V0,theta,kappa,omega,rho)

alfa = -0.5*(u.*u + u*1i);
beta = kappa - rho*omega*u*1i;

omega2 = omega * omega;
gamma = 0.5 * omega2;

D = sqrt(beta .* beta - 4.0 * alfa .* gamma);

bD = beta - D;
eDt = exp(- D * T);

G = bD ./ (beta + D);
B = (bD ./ omega2) .* ((1.0 - eDt) ./ (1.0 - G .* eDt));
psi = (G .* eDt - 1.0) ./(G - 1.0);
A = ((kappa * theta) / (omega2)) * (bD * T - 2.0 * log(psi));

phi = A + B*V0 + 1i*u*(lnS+(r-d)*T);

end

% Bates
function phi = Bates_characteristicFn(u,lnS,T,r,d,V0,theta,kappa,omega,rho,a,b,lambda)
    phiHes = Heston_characteristicFn(u,lnS,T,r,d,V0,theta,kappa,omega,rho);
    phi = phiHes + LogNormalJump_characteristicFn(u,a,b,lambda,T);
end

% LogNormalJump for Merton and Bates
function phiJump = LogNormalJump_characteristicFn(u,a,b,lambda,T)
    %phiJump = exp(lambda*T*(-a*u*i + (exp(u*i*log(1.0+a)+0.5*b*b*u*i.*(u*i-1.0))-1.0)));
    phiJump = lambda*T*(-a*u*1i + (exp(u*1i*log(1.0+a)+0.5*b*b*u*1i.*(u*1i-1.0))-1.0));
end

% Variance Gamma
function phi = VG_characteristicFn(u,lnS,T,r,d,sigma,nu,theta)
    omega = (1/nu)*( log(1-theta*nu-sigma*sigma*nu/2) );
    tmp = 1 - 1i * theta * nu * u + 0.5 * sigma * sigma * u .* u * nu;
    %tmp = tmp.^(-T / nu);
    %phi = exp( i * u * (lnS + (r + omega - d) * T )) .* tmp;
    phi = 1i * u * (lnS + (r + omega - d) * T ) - T*log(tmp)/nu;

end

% Normal Inverse Gaussian
function phi = NIG_characteristicFn(u,lnS,T,r,d,alfa,beta,mu,delta)
    m = delta*(sqrt(alfa*alfa-(beta+1)^2)-sqrt(alfa*alfa-beta*beta));
    %tmp = exp(i*u*mu*T-delta*T*(sqrt(alfa*alfa-(beta+i*u).^2)-sqrt(alfa*alfa-beta*beta)));
    %phi = exp( i*u*(lnS + (r-d+m)*T)).*tmp;
    tmp = 1i*u*mu*T-delta*T*(sqrt(alfa*alfa-(beta+1i*u).^2)-sqrt(alfa*alfa-beta*beta));
    phi = 1i*u*(lnS + (r-d+m)*T) + tmp;
end

% Meixner
function phi = Meixner_characteristicFn(u,lnS,T,r,d,alfa,beta,delta)
    m = -2*delta*(log(cos(0.5*beta)) - log(cos((alfa+beta)/2)));
    tmp = (cos(0.5*beta)./cosh(0.5*(alfa*u-1i*beta))).^(2*T*delta);
    %phi = exp( i*u*(lnS + (r-d+m)*T)).*tmp;
    phi = 1i*u*(lnS + (r-d+m)*T) + log(tmp);
end

% Generalized Hyperbolic
function phi = GH_characteristicFn(u,lnS,T,r,d,alfa,beta,delta,nu)
    arg1 = alfa*alfa-beta*beta;
    arg2 = arg1-2*1i*u*beta + u.*u;
    argm = arg1-2*beta-1;
    m = -log((arg1./argm).^(0.5*nu).*besselk(nu,delta*sqrt(argm))./besselk(nu,delta*sqrt(arg1)));
    tmp = (arg1./arg2).^(0.5*nu).*besselk(nu,delta*sqrt(arg2))./besselk(nu,delta*sqrt(arg1));
    %phi = exp( i*u*(lnS + (r-d+m)*T)).*tmp.^T;
    phi = 1i*u*(lnS + (r-d+m)*T) + log(tmp).*T;
end

% CGMY
function phi = CGMY_characteristicFn(u,lnS,T,r,d,C,G,M,Y)
    m = -C*gamma(-Y)*((M-1)^Y-M^Y+(G+1)^Y-G^Y);
    %tmp = exp(C*T*gamma(-Y)*((M-i*u).^Y-M^Y+(G+i*u).^Y-G^Y));
    %phi = exp( i*u*(lnS + (r-d+m)*T)).*tmp;
    tmp = C*T*gamma(-Y)*((M-1i*u).^Y-M^Y+(G+1i*u).^Y-G^Y);
    phi = 1i*u*(lnS + (r-d+m)*T) + tmp;
end

%function phi = IntegratedCIR_characteristicFn(u,lnS,T,r,d,sigma,nu,theta,kappa,eta,lambda,y0)

%v1 = i*log(1 - i * theta * nu * u + 0.5 * sigma * sigma * u .* u * nu)/nu;
%v2 = i*log(1 - i * theta * nu *(-i) + 0.5 * sigma * sigma * (-i) .* (-i) * nu)/nu;

function phi = VarianceGammaCIR_characteristicFn(u,lnS,T,r,d,C,G,M,kappa,eta,lambda,y0)

v1 = -1i*C*(log(G*M)-log(G*M+(M-G)*1i*u + u.*u));
v2 = -1i*C*(log(G*M)-log(G*M+(M-G)*1i*(-1i) + (-1i).*(-1i)));

gamma1 = sqrt(kappa^2 - 2*lambda^2*1i*v1);
gamma2 = sqrt(kappa^2 - 2*lambda^2*1i*v2);
phi1 = kappa^2*eta*T/lambda^2 + 2*y0*1i*v1 ./ (kappa + gamma1.*coth(0.5*gamma1*T))...
    - 2*kappa*eta/lambda^2*log(cosh(0.5*gamma1*T) + kappa*sinh(0.5*gamma1*T)./gamma1);
phi2 = kappa^2*eta*T/lambda^2 + 2*y0*1i*v2 / (kappa + gamma2*coth(0.5*gamma2*T))...
    - 2*kappa*eta/lambda^2*log(cosh(0.5*gamma2*T) + kappa*sinh(0.5*gamma2*T)/gamma2);

%gam = sqrt(kappa^2-2*lambda^2);
m = 0;%- (kappa^2*eta*T/lambda^2 + 2*y0/(kappa+gam*coth(gam*T/2))) + 2*kappa*eta/lambda^2*log(cosh(gam*T/2)+kappa*sinh(gam*T/2)/gam);
phi = 1i*u*(lnS + (r-d+m)*T) + phi1 - 1i*u*phi2;%0.5*(log(phi1.^2) - i*u*log(phi2.^2));

end

function phi = VarianceGammaOU_characteristicFn(u,lnS,T,r,d,C,G,M,lambda,a,b)
    psiX1 = (-1i)*log((G*M./(G*M+(M-G)*1i*u+u.*u)).^C);
    psiX2 = (-1i)*log((G*M/(G*M+(M-G)-1)).^C);
    phiCIR1 = 1i*psiX1*lambda^(-1)*(1-exp(-lambda*T)) + lambda*a./(1i*psiX1-lambda*b).*(b*log(b./(b-1i*psiX1*lambda^(-1)*(1-exp(-lambda*T))))-1i*psiX1*T);
    phiCIR2 = 1i*psiX2*lambda^(-1)*(1-exp(-lambda*T)) + lambda*a./(1i*psiX2-lambda*b).*(b*log(b./(b-1i*psiX2*lambda^(-1)*(1-exp(-lambda*T))))-1i*psiX2*T);
    phi = 1i*u*(lnS + (r-d)*T)+phiCIR1 - 1i*u.*phiCIR2;
end


function [ y , ysup ] = exp_rnd(x,rnd)
%EXP_RND      Rigorous bounds for exp(x) and input vector x according to rnd
%
%   [ y , ysup ] = exp_rnd(x,rnd)
%
%If specified with two output arguments, lower and upper bound is computed
%independent of rnd, otherwise y is rounded according to rnd.
%Rounding need not be to nearest after leaving exp_rnd
%

% written  12/30/98     S.M. Rump
% modified 08/31/99     S.M. Rump  extreme input, improved accuracy,
%                                  major revision
% modified 02/14/01     S.M. Rump  improved accuracy
% modified 08/26/12     S.M. Rump  global variables removed
% modified 10/13/12     S.M. Rump  INTLAB_INTVAL_STDFCTS
%

  INTLAB_STDFCTS_EXP = getappdata(0,'INTLAB_STDFCTS_EXP');

  infsup = ( nargout==2 );
  if infsup
    rnd = -1;
  end

  setround(0)
  xint = fix(x);                            % integer part of x, chopped
  xfrac = x - xint;                         % fractional part, -1 < xfrac < 1

  indexlarge = ( xint>709 );                % care for exceptions
  indexsmall = ( xint<-744 );
  index = indexlarge | indexsmall | isnan(x);
  xint(index) = 0;
  xfrac(index) = 0;

  xs = pow2( floor(pow2(xfrac,14)) , -14 );  % max. 14 bits of mantissa of xfrac,
                                             % no bit below 2^-14
  d = xfrac - xs;                            % 0 <= d < 2^-14, exactly repr.
  expxs = exp(xs);
  factor = INTLAB_STDFCTS_EXP.EPS;
  Exint = INTLAB_STDFCTS_EXP.POW(745+xint);
  Exinteps = INTLAB_STDFCTS_EXP.POWSUP(745+xint);

  % general case, exp(xfrac) = exp(xs)*exp(d)
  if infsup          % 0 <= err <= exp(d)*d^4/4! < 0.2501*d*d^3/3!

    % calculate upper bound
    setround(1)
    % exp(d)*expxs <= corr + expxs
    corr = (( ( 1+0.2501*d ) .* expxs.*d/3 + expxs ).*d/2 + expxs ).*d;

    % exp(xs) <= expxs*(1+EPS)
    % exp(xfrac) = exp(d)*exp(xs) <= (corr+expxs)*(1+EPS)
    ysup = ( corr + corr*factor ) + expxs*factor ;

    % exp(xfrac) <= expxs+ysup,  exp(x) = exp(xfrac)*exp(xint)
    ysup = expxs.*Exint + ( (expxs+ysup).*Exinteps + ysup.*Exint );
    ysup(x==0) = 1;

  end

  setround(rnd)
  if rnd==-1
    Exinteps = INTLAB_STDFCTS_EXP.POWINF(745+xint);
    corr1 = 1;
  else
    corr1 = 1 + 0.2501*d;
  end

  % exp(d)*expxs ~ corr + expxs    subject to rounding
  corr = (( corr1 .* expxs.*d/3 + expxs ).*d/2 + expxs ).*d;

  % exp(xs)  in  expxs*(1+/-EPS)
  % exp(xfrac) = exp(d)*exp(xs)  in  (corr+expxs)*(1+rnd*EPS)
  y = ( corr + (corr*rnd)*factor ) + (expxs*rnd)*factor;

  % exp(xfrac) ~ expxs+y,  exp(x) = exp(xfrac)*exp(xint)
  y = expxs.*Exint + ( (expxs+y).*Exinteps + y.*Exint );
  y(x==0) = 1;

  % large or small input, exceptions
  if any(index)

    if any(indexlarge)
      if infsup
        y(indexlarge) = realmax;
        ysup(indexlarge) = inf;
      else
        if rnd==-1
          y(indexlarge) = realmax;
        else
          y(indexlarge) = inf;
        end
      end
    end

    if any(indexsmall)
      INTLAB_INTVAL_ETA = realmin*eps;  % smallest positive denormalized fl-pt
      if infsup
        y(indexsmall) = 0;
        ysup(indexsmall) = INTLAB_INTVAL_ETA;
      else
        if rnd==-1
          y(indexsmall) = 0;
        else
          y(indexsmall) = INTLAB_INTVAL_ETA;
        end
      end
    end

    index = isnan(x);
    if any(index)
      y(index) = NaN;
      if infsup
        ysup(index) = NaN;
      end
    end

  end

  index = ( xint<-720 );
  if any(index)
    y(index) = max( y(index) , 0 );
  end


% This is material illustrating the methods from the book
% Financial Modelling  - Theory, Implementation and Practice with Matlab
% source
% Wiley Finance Series
% ISBN 978-0-470-74489-5
%
% Date: 02.05.2012
%
% Authors:  Joerg Kienitz
%           Daniel Wetterau
%
% Please send comments, suggestions, bugs, code etc. to
% kienitzwetterau_FinModelling@gmx.de
%
% (C) Joerg Kienitz, Daniel Wetterau
%
% Since this piece of code is distributed via the mathworks file-exchange
% it is covered by the BSD license
%
% This code is being provided solely for information and general
% illustrative purposes. The authors will not be responsible for the
% consequences of reliance upon using the code or for numbers produced
% from using the code.

% We test the performance of the inverse method using numerical
% algorithms based on the Kienitz extrapolation methodology
% for generating MC densities and we compare against analytic values

% Generate random numbers from a SABR density using numerical inversion
% of the cumulated probability and the density truncation method

clear; clc;
NSim = 100000;          % number of simulations
U = rand(1,NSim);       % uniforms

% sabr parameters
t =1;
% a = 0.25; b = 0.5; r = -.5;  f = 0.03;  n = 0.2;
% b= 0.5; r=-0.1595; f=0.0495;  n=0.3843;  a=0.1339 * f^(1-b);
b = 0.5;n=0.2;r=-0.2;f=0.03; a=0.9*f^(1-b);
% calibrate the parameters
[kl, mu, cl, bl, al, ku, nu, cu, bu, au] = ...
    psabr_param(a, b, r, n, f, 0.0001:0.0001:0.2, t,4);

% apply the calibrated density
d = @(x) psabr_5(a, b, r, n, f, x, t, ...
    kl, ku, mu, cl, bl, al, nu, cu, bu, au);

x_sabr = 0.001:0.0001:1;                % x_values for table
tic;
y_sabr = FSABR2_1(x_sabr,d);            % values for the table
US = FInvSABR4_2(U,x_sabr, y_sabr);     % inversion using table
toc

nbins = 150;
Nzero = sum(US==1);
Pzero = Nzero / NSim;
[n,xout] = hist(US,nbins);                % calc histogram
n(end) = 0;
pdensity = n/NSim*nbins; cdensity = cumsum(n) / NSim;

n(end) = 0;                             % remove artefact
figure;bar(n/nbins);                    % plot histogram
x = 0:.0001:1;                          % x values for plot
y = d(x);                               % calculate the density
Y = sum(y)*0.0001;
y(1) = 1-Y;
figure('Color', [1 1 1]);
hold on; plot([0 xout],[Pzero pdensity],'ro-'); plot(x,y); xlim([0,.2]); hold off; % plot sim against value
xlabel('Strike'); ylabel('Density p(x)');
x = [0 xout];                          % x values for plot
y = d(x);

figure('Color', [1 1 1]);
hold on; plot(x,[Pzero pdensity],'ro-'); plot(x,y,'gx-'); xlim([0,.25]); hold off; % plot sim against value

figure('Color', [1 1 1]);
plot(x,([Pzero pdensity] - y)./y); xlim([0,.25]); hold off; % plot sim against value


function r = cos(a)
%COS          Hessian (elementwise) cosine
%

% written  04/04/04     S.M. Rump
% modified 04/06/05     S.M. Rump  rounding unchanged
% modified 09/28/08     S.M. Rump  check for rounding to nearest improved
% modified 08/26/12     S.M. Rump  global variables removed
%

  e = 1e-30;
  if 1+e==1-e                           % fast check for rounding to nearest
    rndold = 0;
  else
    rndold = getround;
    setround(0)
  end

  K = prod(size(a.x));
  if K==1                   % scalar hessian

    r.x = cos(a.x);
    msinax = -sin(a.x);
    r.dx = msinax * a.dx;
    r.hx = msinax * a.hx - reshape( ((0.5*r.x)*a.dx) * a.dx.',size(a.hx));

  else                      % matrix hessian

    N = getappdata(0,'INTLAB_HESSIAN_NUMVAR');
    N2 = N^2;

    r.x = cos(full(a.x));
    if issparse(a.hx)               % input sparse

      ax = -sin(a.x(:));
      sizeax = length(ax);
      [ia,ja,sa] = find(a.dx);
      % check for emptyness: cures Matlab bug
      % a=sparse([],[],[],2,1), [i,j,s]=find(a), s(i).*s(:)  yields error
      if isempty(ia)
        r.dx = sparse([],[],[],N,sizeax);
        r.hx = sparse([],[],[],N2,sizeax);
      else
        adx1 = (-0.5)*r.x(:);
        if isa(a.x,'intval')          % sparse intval
          rdx = times(ax(ja),sa(:),0);
          adx1 = times(adx1(ja),sa(:),0);
          if rdx.complex
            r.dx = intval( sparse(ia,ja,rdx.mid,N,sizeax) , sparse(ia,ja,rdx.rad,N,sizeax) , 'midrad' );
          else
            r.dx = intval( sparse(ia,ja,rdx.inf,N,sizeax) , sparse(ia,ja,rdx.sup,N,sizeax) , 'infsup' );
          end
          if adx1.complex
            adx1 = intval( sparse(ia,ja,adx1.mid,N,sizeax) , sparse(ia,ja,adx1.rad,N,sizeax) , 'midrad' );
          else
            adx1 = intval( sparse(ia,ja,adx1.inf,N,sizeax) , sparse(ia,ja,adx1.sup,N,sizeax) , 'infsup' );
          end
        else                          % sparse point
          r.dx = sparse(ia,ja,ax(ja).*sa(:),N,sizeax);
          adx1 = sparse(ia,ja,adx1(ja).*sa(:),N,sizeax);
        end
        r.hx = adx2rhx(N,sizeax,adx1,a.dx);
      end
      [ia,ja,sa] = find(a.hx);        % sparse point or intval
      % check for emptyness: cures Matlab bug
      % a=sparse([],[],[],2,1), [i,j,s]=find(a), s(i).*s(:)  yields error
      if ~isempty(ia)
        if isa(a.x,'intval')
          rhx = times(ax(ja),sa(:),0);
          if rhx.complex
            r.hx = r.hx + intval( sparse(ia,ja,rhx.mid,N2,sizeax) , sparse(ia,ja,rhx.rad,N2,sizeax) , 'midrad' );
          else
            r.hx = r.hx + intval( sparse(ia,ja,rhx.inf,N2,sizeax) , sparse(ia,ja,rhx.sup,N2,sizeax) , 'infsup' );
          end
        else
          r.hx = r.hx + sparse(ia,ja,ax(ja).*sa(:),N2,sizeax);
        end
      end

    else                            % input full

      r.x = cos(a.x);
      rx = r.x(:).';
      msinax = -sin(a.x(:).');
      msinax = msinax(ones(N*N,1),:);
      r.dx = a.dx .* msinax(1:N,:);
      adx = repmat(0.5*rx,N,1) .* a.dx;
      r.hx = a.hx .* msinax - adx(repmat(1:N,N,1),:) .* a.dx(repmat(1:N,1,N),:);

    end

  end

  r = class(r,'hessian');

  if rndold
    setround(rndold)
  end


function r = acoth(a)
%ACOTH        Hessian (elementwise) inverse hyperbolic cotangent
%

% written  04/04/04     S.M. Rump
% modified 04/06/05     S.M. Rump  rounding unchanged
% modified 09/28/08     S.M. Rump  check for rounding to nearest improved
% modified 08/26/12     S.M. Rump  global variables removed
%

  e = 1e-30;
  if 1+e==1-e                           % fast check for rounding to nearest
    rndold = 0;
  else
    rndold = getround;
    setround(0)
  end

  K = prod(size(a.x));
  if K==1                   % scalar hessian

    r.x = acoth(a.x);
    f = 1 / ( 1 - sqr(a.x) );
    r.dx = a.dx * f;
    r.hx = ( a.hx + reshape( (a.x*r.dx) * a.dx.' , size(a.hx) ) ) * f;

  else                      % matrix hessian

    N = getappdata(0,'INTLAB_HESSIAN_NUMVAR');
    N2 = N^2;

    r.x = acoth(a.x);
    if issparse(a.hx)               % input sparse

      ax = 1 ./ ( 1 - sqr(full(a.x(:))) );
      sizeax = length(ax);
      [ia,ja,sa] = find(a.dx);
      % check for emptyness: cures Matlab bug
      % a=sparse([],[],[],2,1), [i,j,s]=find(a), s(i).*s(:)  yields error
      if isempty(ia)
        r.dx = sparse([],[],[],N,sizeax);
        r.hx = sparse([],[],[],N2,sizeax);
      else
        adx1 = a.x(:).*ax;
        if isa(a.x,'intval')          % sparse intval
          rdx = times(ax(ja),sa(:),0);
          adx1 = times(adx1(ja),sa(:),0);
          if rdx.complex
            r.dx = intval( sparse(ia,ja,rdx.mid,N,sizeax) , sparse(ia,ja,rdx.rad,N,sizeax) , 'midrad' );
          else
            r.dx = intval( sparse(ia,ja,rdx.inf,N,sizeax) , sparse(ia,ja,rdx.sup,N,sizeax) , 'infsup' );
          end
          if adx1.complex
            adx1 = intval( sparse(ia,ja,adx1.mid,N,sizeax) , sparse(ia,ja,adx1.rad,N,sizeax) , 'midrad' );
          else
            adx1 = intval( sparse(ia,ja,adx1.inf,N,sizeax) , sparse(ia,ja,adx1.sup,N,sizeax) , 'infsup' );
          end
        else                          % sparse point
          r.dx = sparse(ia,ja,ax(ja).*sa(:),N,sizeax);
          adx1 = sparse(ia,ja,adx1(ja).*sa(:),N,sizeax);
        end
        r.hx = adx2rhx(N,sizeax,adx1,r.dx);
      end
      [ia,ja,sa] = find(a.hx);      % sparse point or intval
      % check for emptyness: cures Matlab bug
      % a=sparse([],[],[],2,1), [i,j,s]=find(a), s(i).*s(:)  yields error
      if ~isempty(ia)
        if isa(a.x,'intval')
          rhx = times(ax(ja),sa(:),0);
          if rhx.complex
            r.hx = r.hx + intval( sparse(ia,ja,rhx.mid,N2,sizeax) , sparse(ia,ja,rhx.rad,N2,sizeax) , 'midrad' );
          else
            r.hx = r.hx + intval( sparse(ia,ja,rhx.inf,N2,sizeax) , sparse(ia,ja,rhx.sup,N2,sizeax) , 'infsup' );
          end
        else
          r.hx = r.hx + sparse(ia,ja,ax(ja).*sa(:),N2,sizeax);
        end
      end

    else                            % input full

      r.x = acoth(a.x);
      ax = a.x(:).';
      f = 1 ./ ( 1 - sqr(ax) );
      f = f(ones(N*N,1),:);
      r.dx = a.dx .* f(1:N,:);
      adx = repmat(ax,N,1) .* r.dx;
      r.hx = ( a.hx + adx(repmat(1:N,N,1),:) .* a.dx(repmat(1:N,1,N),:) ) .* f;

    end

  end

  r = class(r,'hessian');

  if rndold
    setround(rndold)
  end


function [Y, optinf] = celnet_gpu(D, S, lambda, mu, opt)

% celnet_gpu -- Convolutional Elastic Net (GPU version)
%
%         argmin_{x_m} (1/2)||\sum_m d_m * x_m - s||_2^2 +
%                      lambda \sum_m ||x_m||_1 + (mu/2) \sum_m ||x_m||_2^2
%
%         The solution is computed using an ADMM approach (see
%         boyd-2010-distributed) with efficient solution of the main
%         linear systems (see wohlberg-2016-efficient).
%
% Usage:
%       [Y, optinf] = celnet_gpu(D, S, lambda, mu, opt)
%
% Input:
%       D           Dictionary filter set (3D array)
%       s           Input image
%       lambda      Regularization parameter (l1)
%       mu          Regularization parameter (l2)
%       opt         Algorithm parameters structure
%
% Output:
%       Y           Dictionary coefficient map set (3D array)
%       optinf      Details of optimisation
%
%
% Options structure fields:
%   Verbose          Flag determining whether iteration status is displayed.
%                    Fields are iteration number, functional value,
%                    data fidelity term, l1 regularisation term, l2
%                    regularisation term, and primal and dual residuals
%                    (see Sec. 3.3 of boyd-2010-distributed). The value of
%                    rho is also displayed if options request that it is
%                    automatically adjusted.
%   MaxMainIter      Maximum main iterations
%   AbsStopTol       Absolute convergence tolerance (see Sec. 3.3.1 of
%                    boyd-2010-distributed)
%   RelStopTol       Relative convergence tolerance (see Sec. 3.3.1 of
%                    boyd-2010-distributed)
%   L1Weight         Weighting array for coefficients in l1 norm of X.
%                    Array should have the same dimensions as X, but the
%                    first two dimensions may be of unit size, corresponding
%                    to a weighting that varies with filter index but is
%                    spatially constant.
%   L2Weight         Weighting array for l2 norm of X. Array should have
%                    dimensions corresponding to the non-spatial dimensions
%                    of X since spatial weighting is no possible (i.e.
%                    weighting varies only with filter and sample index).
%   Y0               Initial value for Y
%   U0               Initial value for U
%   rho              ADMM penalty parameter
%   AutoRho          Flag determining whether rho is automatically updated
%                    (see Sec. 3.4.1 of boyd-2010-distributed)
%   AutoRhoPeriod    Iteration period on which rho is updated
%   RhoRsdlRatio     Primal/dual residual ratio in rho update test
%   RhoScaling       Multiplier applied to rho when updated
%   AutoRhoScaling   Flag determining whether RhoScaling value is
%                    adaptively determined (see wohlberg-2015-adaptive). If
%                    enabled, RhoScaling specifies a maximum allowed
%                    multiplier instead of a fixed multiplier.
%   RhoRsdlTarget    Residual ratio targeted by auto rho update policy.
%   StdResiduals     Flag determining whether standard residual definitions
%                    (see Sec 3.3 of boyd-2010-distributed) are used instead
%                    of normalised residuals (see wohlberg-2015-adaptive)
%   RelaxParam       Relaxation parameter (see Sec. 3.4.3 of
%                    boyd-2010-distributed)
%   NoBndryCross     Flag indicating whether all solution coefficients
%                    corresponding to filters crossing the image boundary
%                    should be forced to zero.
%   AuxVarObj        Flag determining whether objective function is computed
%                    using the auxiliary (split) variable
%   HighMemSolve     Use more memory for a slightly faster solution
%
%
% Authors: Brendt Wohlberg <brendt@lanl.gov>
%          Ping-Keng Jao <jpk7656@gmail.com>
% Modified: 2015-12-18
%
% This file is part of the SPORCO library. Details of the copyright
% and user license can be found in the 'License' file distributed with
% the library.

gS = gpuArray(S);
gD = gpuArray(D);
glambda = gpuArray(lambda);

if nargin < 5,
  opt = [];
end
if nargin < 4,
  gmu = gpuArray(0);
else
  gmu = gpuArray(mu);
end
checkopt(opt, defaultopts([]));
opt = defaultopts(opt);

% Set up status display for verbose operation
hstr = 'Itn   Fnc       DFid      l1        l2        r         s      ';
sfms = '%4d %9.2e %9.2e %9.2e %9.2e %9.2e %9.2e';
nsep = 64;
if opt.AutoRho,
  hstr = [hstr '   rho  '];
  sfms = [sfms ' %9.2e'];
  nsep = nsep + 10;
end
if opt.Verbose && opt.MaxMainIter > 0,
  disp(hstr);
  disp(char('-' * ones(1,nsep)));
end

% Start timer
tstart = tic;

% Collapsing of trailing singleton dimensions greatly complicates
% handling of both SMV and MMV cases. The simplest approach would be
% if S could always be reshaped to 4d, with dimensions consisting of
% image rows, image cols, a single dimensional placeholder for number
% of filters, and number of measurements, but in the single
% measurement case the third dimension is collapsed so that the array
% is only 3d.
if size(S,3) > 1,
  xsz = [size(S,1) size(S,2) size(D,3) size(S,3)];
  % Insert singleton 3rd dimension (for number of filters) so that
  % 4th dimension is number of images in input s volume
  S = reshape(S, [size(S,1) size(S,2) 1 size(S,3)]);
else
  xsz = [size(S,1) size(S,2) size(D,3) 1];
end
% Compute filters in DFT domain
gDf = fft2(gD, size(S,1), size(S,2));
% Convolve-sum and its Hermitian transpose
gDop = @(x) sum(bsxfun(@times, gDf, x), 3);
gDHop = @(x) bsxfun(@times, conj(gDf), x);
% Compute signal in DFT domain
gSf = fft2(gS);
% S convolved with all filters in DFT domain
gDSf = gDHop(gSf);

% Set up l2 weight array
if isscalar(opt.L2Weight),
  gwl2 = gpuArray(opt.L2Weight);
else
  gwl2 = gpuArray(reshape(opt.L2Weight, [1 1 size(opt.L2Weight,1) ...
                      size(opt.L2Weight,2)]));
end

% Default lambda is 1/10 times the lambda value beyond which the
% solution is a zero vector
if nargin < 3 | isempty(glambda),
  gb = ifft2(gDHop(gSf), 'symmetric');
  glambda = 0.1*max(vec(abs(gb)));
end
% Set up algorithm parameters and initialise variables
grho = gpuArray(opt.rho);
if isempty(grho), grho = 50*glambda+1; end;
gmwr = gmu*gwl2 + grho;
if isempty(opt.RhoRsdlTarget),
  if opt.StdResiduals,
    opt.RhoRsdlTarget = 1;
  else
    opt.RhoRsdlTarget = 1 + (18.3).^(log10(glambda) + 1);
  end
end
if opt.HighMemSolve,
  gcn = bsxfun(@rdivide, gDf, gmwr);
  gcd = sum(gDf.*bsxfun(@rdivide, conj(gDf), gmu*gwl2 + grho), 3) + 1.0;
  gC = bsxfun(@rdivide, gcn, gcd);
  clear cn cd;
else
  C = [];
end
gNx = prod(gpuArray(xsz));
optinf = struct('itstat', [], 'opt', opt);
gr = gpuArray(Inf);
gs = gpuArray(Inf);
gepri = gpuArray(0);
gedua = gpuArray(0);

% Initialise main working variables
% X = [];
if isempty(opt.Y0),
  gY = gpuArray.zeros(xsz);
else
  gY = gpuArray(opt.Y0);
end
gYprv = gY;
if isempty(opt.U0),
  if isempty(opt.Y0),
    gU = gpuArray.zeros(xsz);
  else
    gU = (glambda/grho)*sign(gY);
  end
else
  gU = gpuArray(opt.U0);
end

% Main loop
k = 1;
while k <= opt.MaxMainIter & (gr > gepri | gs > gedua),

  % Solve X subproblem
  gXf = solvedbd_sm(gDf, gmwr, gDSf + grho*fft2(gY - gU), gC);
  gX = ifft2(gXf, 'symmetric');

  % See pg. 21 of boyd-2010-distributed
  if opt.RelaxParam == 1,
    gXr = gX;
  else
    gXr = opt.RelaxParam*gX + (1-opt.RelaxParam)*gY;
  end

  % Solve Y subproblem
  gY = shrink(gXr + gU, (glambda/grho)*opt.L1Weight);
  if opt.NoBndryCross,
    gY((end-size(gD,1)+2):end,:,:,:) = 0;
    gY(:,(end-size(gD,1)+2):end,:,:) = 0;
  end

  % Update dual variable
  gU = gU + gXr - gY;

  % Compute data fidelity term in Fourier domain (note normalisation)
  if opt.AuxVarObj,
    gYf = fft2(gY); % This represents unnecessary computational cost
    gJdf = sum(vec(abs(sum(bsxfun(@times,gDf,gYf),3)-gSf).^2)) / ...
           (2*xsz(1)*xsz(2));
    gJl1 = sum(abs(vec(bsxfun(@times, opt.L1Weight, gY))));
    gJl2 = sum(vec(gwl2.*sum(sum(gY.^2, 1),2)))/2;
  else
    gJdf = sum(vec(abs(sum(bsxfun(@times,gDf,gXf),3)-gSf).^2)) / ...
           (2*xsz(1)*xsz(2));
    gJl1 = sum(abs(vec(bsxfun(@times, opt.L1Weight, gX))));
    gJl2 = sum(vec(gwl2.*sum(sum(gX.^2, 1),2)))/2;
  end
  gJfn = gJdf + glambda*gJl1 + gmu*gJl2;

  gnX = norm(gX(:)); gnY = norm(gY(:)); gnU = norm(gU(:));
  if opt.StdResiduals,
    % See pp. 19-20 of boyd-2010-distributed
    gr = norm(vec(gX - gY));
    gs = norm(vec(grho*(gYprv - gY)));
    gepri = sqrt(gNx)*opt.AbsStopTol+max(gnX,gnY)*opt.RelStopTol;
    gedua = sqrt(gNx)*opt.AbsStopTol+grho*gnU*opt.RelStopTol;
  else
    % See wohlberg-2015-adaptive
    gr = norm(vec(gX - gY))/max(gnX,gnY);
    gs = norm(vec(gYprv - gY))/gnU;
    gepri = sqrt(gNx)*opt.AbsStopTol/max(gnX,gnY)+opt.RelStopTol;
    gedua = sqrt(gNx)*opt.AbsStopTol/(grho*gnU)+opt.RelStopTol;
  end

  % Record and display iteration details
  tk = toc(tstart);
  optinf.itstat = [optinf.itstat; [k gather(gJfn) gather(gJdf) gather(gJl1) ...
                   gather(gJl2) gather(gr) gather(gs) gather(gepri) ...
                      gather(gedua) gather(grho) tk]];
  if opt.Verbose,
    if opt.AutoRho,
      disp(sprintf(sfms, k, gather(gJfn), gather(gJdf), gather(gJl1), ...
                   gather(gJl2), gather(gr), gather(gs), gather(grho)));
    else
      disp(sprintf(sfms, k, gather(gJfn), gather(gJdf), gather(gJl1), ...
                   gather(gJl2), gather(gr), gather(gs)));
    end
  end

  % See wohlberg-2015-adaptive and pp. 20-21 of boyd-2010-distributed
  if opt.AutoRho,
    if k ~= 1 && mod(k, opt.AutoRhoPeriod) == 0,
      if opt.AutoRhoScaling,
        grhomlt = sqrt(gr/(gs*opt.RhoRsdlTarget));
        if grhomlt < 1, grhomlt = 1/grhomlt; end
        if grhomlt > opt.RhoScaling, grhomlt = opt.RhoScaling; end
      else
        rhomlt = opt.RhoScaling;
      end
      grsf = 1;
      if gr > opt.RhoRsdlTarget*opt.RhoRsdlRatio*gs, grsf = grhomlt; end
      if gs > (opt.RhoRsdlRatio/opt.RhoRsdlTarget)*gr, grsf = 1/grhomlt; end
      grho = grsf*grho;
      gU = gU/grsf;
      if opt.HighMemSolve && grsf ~= 1,
        gmwr = gmu*gwl2 + grho;
        gcn = bsxfun(@rdivide, gDf, gmwr);
        gcd = sum(gDf.*bsxfun(@rdivide, conj(gDf), gmwr), 3) + 1.0;
        gC = bsxfun(@rdivide, gcn, gcd);
        clear gcn gcd;
      end
    end
  end

  gYprv = gY;
  k = k + 1;

end

% Record run time and working variables
optinf.runtime = toc(tstart);
optinf.X = gather(gX);
optinf.Xf = gather(gXf);
optinf.Y = gather(gY);
optinf.U = gather(gU);
optinf.lambda = gather(glambda);
optinf.mu = gather(mu);
optinf.rho = gather(grho);
Y = gather(gY);
if opt.Verbose && opt.MaxMainIter > 0,
  disp(char('-' * ones(1,nsep)));
end

return

function u = vec(v)

  u = v(:);

return

function u = shrink(v, lambda)

  if isscalar(lambda),
    u = sign(v).*max(0, abs(v) - lambda);
  else
    u = sign(v).*max(0, bsxfun(@minus, abs(v), lambda));
  end

return

function opt = defaultopts(opt)

  if ~isfield(opt,'Verbose'),
    opt.Verbose = 0;
  end
  if ~isfield(opt,'MaxMainIter'),
    opt.MaxMainIter = 1000;
  end
  if ~isfield(opt,'AbsStopTol'),
    opt.AbsStopTol = 0;
  end
  if ~isfield(opt,'RelStopTol'),
    opt.RelStopTol = 1e-4;
  end
  if ~isfield(opt,'L1Weight'),
    opt.L1Weight = 1;
  end
  if ~isfield(opt,'L2Weight'),
    opt.L2Weight = 1;
  end
  if ~isfield(opt,'Y0'),
    opt.Y0 = [];
  end
  if ~isfield(opt,'U0'),
    opt.U0 = [];
  end
  if ~isfield(opt,'rho'),
    opt.rho = [];
  end
  if ~isfield(opt,'AutoRho'),
    opt.AutoRho = 1;
  end
  if ~isfield(opt,'AutoRhoPeriod'),
    opt.AutoRhoPeriod = 1;
  end
  if ~isfield(opt,'RhoRsdlRatio'),
    opt.RhoRsdlRatio = 1.2;
  end
  if ~isfield(opt,'RhoScaling'),
    opt.RhoScaling = 100;
  end
  if ~isfield(opt,'AutoRhoScaling'),
    opt.AutoRhoScaling = 1;
  end
  if ~isfield(opt,'RhoRsdlTarget'),
    opt.RhoRsdlTarget = [];
  end
  if ~isfield(opt,'StdResiduals'),
    opt.StdResiduals = 0;
  end
  if ~isfield(opt,'RelaxParam'),
    opt.RelaxParam = 1.8;
  end
  if ~isfield(opt,'NoBndryCross'),
    opt.NoBndryCross = 0;
  end
  if ~isfield(opt,'AuxVarObj'),
    opt.AuxVarObj = 0;
  end
  if ~isfield(opt,'HighMemSolve'),
    opt.HighMemSolve = 0;
  end

return


function u = forward ( e, r, sigma, t1, Nx, Nt, L )

%*****************************************************************************80
%
%% FORWARD uses the forward difference method to value a European call option.
%
%  Modified:
%
%    28 March 2005
%
%  Author:
%
%    Original MATLAB version by Desmond Higham
%
%  Reference:
%
%    Desmond Higham,
%    Black-Scholes for Scientific Computing Students,
%    Computing in Science and Engineering,
%    November/December 2004, Volume 6, Number 6, pages 72-79.
%
%  Parameters:
%
%    Input, real E, the exercise price.
%
%    Input, real R, the interest rate.
%
%    Input, real SIGMA, the volatility of the asset.
%
%    Input, real T1, the expiry date.
%
%    Input, integer NX, the number of "space" steps used to divide the
%    interval [0,L].
%
%    Input, integer NT, the number of time steps.
%
%    Input, real L, the maximum value of S to consider.
%
%    Output, real U(NX-1,NT+1), the value of the European call option.
%
  k = t1 / Nt;
  h = L / Nx;
  TR1 = diag ( ones ( Nx-2,1),1) - diag ( ones(Nx-2,1), -1 );
  TR2 = -2 * eye(Nx-1,Nx-1) + diag(ones(Nx-2,1),1) + diag(ones(Nx-2,1),-1);
  mvec = [1:Nx-1];
  D1 = diag ( mvec );
  D2 = diag ( mvec.^2 );
  Aftcs = ( 1.0 - r * k ) * eye ( Nx-1,Nx-1 ) ...
        + 0.5 * k * sigma^2 * D2 * TR2 ...
        + 0.5 * k * r * D1 * TR1;

  u = zeros ( Nx-1,Nt+1);
  uzero = max ( [h:h:L-h]'-e, 0.0 );
  u(:,1) = uzero;
  p = zeros(Nx-1,1);

  for i = 1 : Nt
    tau = ( i - 1 ) * k;
    p(end) = 0.5 * k * (Nx-1) * ((sigma^2)*(Nx-1)+r) * ( L - e * exp ( - r * tau ) );
    u(:,i+1) = Aftcs * u(:,i) + p;
  end

  return
end


function [ p, rank ] = perm_tj_successor ( n, p, rank )

%*****************************************************************************80
%
%% PERM_TJ_SUCCESSOR computes the Trotter-Johnson permutation successor.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 January 2011
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Donald Kreher, Douglas Simpson,
%    Combinatorial Algorithms,
%    CRC Press, 1998,
%    ISBN: 0-8493-3988-X,
%    LC: QA164.K73.
%
%  Parameters:
%
%    Input, integer N, the number of values being permuted.
%    N must be positive.
%
%    Input/output, integer P(N), describes the permutation.
%    P(I) is the item which is permuted into the I-th place
%    by the permutation.
%
%    Input/output, integer RANK, the rank.
%    If RANK = -1 on input, then the routine understands that this is
%    the first call, and that the user wishes the routine to supply
%    the first element in the ordering, which has RANK = 0.
%    In general, the input value of RANK is increased by 1 for output,
%    unless the very last element of the ordering was input, in which
%    case the output value of RANK is 0.
%

%
%  Return the first element.
%
  if ( rank == -1 )
    p = 1 : n;
    rank = 0;
    return
  end
%
%  Check.
%
  missing = perm_check ( n, p );

  if ( missing ~= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'PERM_TJ_SUCCESSOR - Fatal error!\n' );
    fprintf ( 1, '  The input array is illegal.\n' );
    fprintf ( 1, '  Missing element = ', missing );
    error ( 'PERM_TJ_SUCCESSOR - Fatal error!' );
  end

  st = 0;
  q(1:n) = p(1:n);
  done = 0;
  m = n;

  while ( 1 < m && ~done )

    d = 1;
    while ( q(d) ~= m )
      d = d + 1;
    end

    for i = d : m - 1
      q(i) = q(i+1);
    end

    par = perm_parity ( m - 1, q );

    if ( par == 1 )

      if ( d == m )
        m = m - 1;
      else
        t         = p(st+d);
        p(st+d)   = p(st+d+1);
        p(st+d+1) = t;
        done = 1;
      end

    else

      if ( d == 1 )
        m = m - 1;
        st = st + 1;
      else
        t         = p(st+d);
        p(st+d)   = p(st+d-1);
        p(st+d-1) = t;
        done = 1;
      end

    end

  end
%
%  Last element was input.  Return first one.
%
  if ( m == 1 )
    p = 1 : n;
    rank = 0;
    return
  end

  rank = rank + 1;

  return
end


function [classMeans,clusterIndex,maxIterReached] = prtUtilKmeans(data,nClusters,varargin)
%[classMeans,clusterIndex] = prtUtilKmeans(data,nClusters)
%   Perform k-means clustering on the nObservations x nFeatures matrix data
%   using nClusters.  classMeans is a matrix of size nClusters (or less) x
%   nFeatures representing the classMeans, and clusterIndex is a
%   nObservations x 1 vector indicating the closest mean to each
%   observation in data.
%
%[classMeans,clusterIndex] = prtUtilKmeans(data,nClusters,param1,value1,...)
%   Enables inputs of parameter/value pairs as described below:
%
%   Parameters:
%       initialMeans - string or double matrix of size nClusters x
%       nFeatures.  If initialMeans is a string, it can be 'random' or
%       'plusplus'. random  which uses random samples from the data to
%       initialize the classMeans. plusplus uses the kMeans++ algorithm
%           Arthur, D. and Vassilvitskii, S. (2007).
%               k-means++: The advantages of careful seeding.
%               Proceedings of the eighteenth annual ACM-SIAM
%               symposium on Discrete algorithms. 1027?1035.
%       If initialMeans is a double matrix, the rows of the
%       matrix represetnt the initial class means, and nClusters is
%       ignored.  Default is 'plusplus'.
%
%       distanceMetricFn - prtDistance* function specifying the distance
%       metric to use.  distanceMetricFn(x,x) must return 0.  Default value
%       is @(data,centers)prtDistanceEuclidean(data,centers));
%
%       handleEmptyClusters - string specifying how to handle empty
%       clusters.  Allowed values are 'remove' and 'random'.  Default value
%       is 'remove'.
%
%       plotVisualization - bool value specifying whether to display a plot
%       of the current class centers and the corresponding data on every
%       iteration.  plotVisualization can also be a counting number, in
%       which case it specifies how often to update the plot.  Default
%       value is 'false'.
%
%   Example usage:
%
%       ds = prtDataGenBimodal(100);
%       data = ds.getObservations;
%       close all;
%       [classMeans,clusterIndex] = prtUtilKmeans(data,4,'plotVisualization',4);
%
%       close all;
%       [classMeans,clusterIndex] = prtUtilKmeans(data,4,'plotVisualization',4,'distanceMetricFn',@prtDistanceCityBlock);
%

p = inputParser;

%p.addParamValue('initialMeans',randn(50,2)/10);
p.addParamValue('initialMeans','random');
p.addParamValue('distanceMetricFn',@(data,centers)prtDistanceEuclidean(data,centers));
p.addParamValue('handleEmptyClusters','remove');
p.addParamValue('maxIterations',1000);
p.addParamValue('plotVisualization',false);
p.addParamValue('logicalMeans',false);

p.parse(varargin{:});
inputStructure = p.Results;

[nSamples,nDimensions] = size(data); %#ok<NASGU>
clusterIndexOld = nan(nSamples,1);
clusterIndex = [];

for iter = 1:inputStructure.maxIterations

    if iter == 1; %initialize
        if isa(inputStructure.initialMeans,'char')
            switch lower(inputStructure.initialMeans)
                case 'random'
                    randInds = max(1,ceil(rand(1,nClusters)*nSamples));
                    classMeans = data(randInds,:);
                case 'plusplus'

                    classMeans = nan(nClusters, size(data,2));
                    classMeans(1,:) = data(max(1,ceil(rand*nSamples)),:);
                    initDistanceMat = nan(nSamples,nClusters);
                    for iCluster = 2:nClusters
                        initDistanceMat(:,iCluster-1) = sum(bsxfun(@minus,data,classMeans(iCluster-1,:)).^2,2); % KMeans++ uses a squared euclidean distance.

                        minDistances = min(initDistanceMat,[],2);
                        drawProbabilities = minDistances./sum(minDistances);

                        newClusterMeanIndex = prtRvUtilRandomSample(drawProbabilities, 1);

                        classMeans(iCluster,:) = data(newClusterMeanIndex,:);
                    end

                otherwise
                    error('invalid');
            end
        elseif isnumeric(inputStructure.initialMeans)
            classMeans = inputStructure.initialMeans;
            nClusters = size(classMeans,1);
        else
            error('invalid');
        end
    else
        for clusterInd = 1:nClusters
            classMeans(clusterInd,:) = mean(data(clusterIndex == clusterInd,:),1);
        end
        if inputStructure.logicalMeans
            classMeans = classMeans>0.5;
        end
    end

    if ~mod(iter,inputStructure.plotVisualization);
        prtUtilKmeansPlotVisualization(data,classMeans,clusterIndex,inputStructure,iter);
    end

    distanceMat = inputStructure.distanceMetricFn(data,classMeans);
    [twiddle,clusterIndex] = min(distanceMat,[],2); %#ok<ASGLU>

    %Handle empty clusters:
    nMaxFixSteps = 10;
    for iFix = 1:nMaxFixSteps
        if length(unique(clusterIndex)) ~= nClusters
            invalidClusters = setdiff(1:nClusters,clusterIndex);
            validClusters = intersect(1:nClusters,clusterIndex);
            switch lower(inputStructure.handleEmptyClusters)
                case 'remove'
                    classMeans = classMeans(validClusters,:);
                    nClusters = nClusters - length(invalidClusters);
                    distanceMat = distanceMat(:,validClusters);
                    [twiddle,clusterIndex] = min(distanceMat,[],2); %#ok<ASGLU>
                case 'random'
                    randInds = max(1,ceil(rand(1,length(invalidClusters))*nSamples));
                    classMeans(invalidClusters,:) = data(randInds,:);
                    distanceMat =  inputStructure.distanceMetricFn(data,classMeans);
                    [twiddle,clusterIndex] = min(distanceMat,[],2); %#ok<ASGLU>
                otherwise
                    error('invalid');
            end
        else
            break
        end
    end
    if iFix == nMaxFixSteps
        maxIterReached = true;
        return
    end
    %Check convergence:
    if all(clusterIndexOld == clusterIndex)
        maxIterReached = false;
        return;
    else
        clusterIndexOld = clusterIndex;
    end

end
maxIterReached = true;

function prtUtilKmeansPlotVisualization(data,classMeans,clusterIndex,inputStructure,iter)

[nSamples,nDimensions] = size(data); %#ok<ASGLU>
if iter == 1
    distanceMat =  inputStructure.distanceMetricFn(data,classMeans);
    [twiddle,clusterIndex] = min(distanceMat,[],2); %#ok<ASGLU>
end
if nDimensions > 3
    warning('prt:prtUtilKmeans','plotVisualization is true, but dimensionality of data (%d) is > 3',nDimensions);
    return;
end
ds = prtDataSetClass(data,clusterIndex);

plot(ds);
hold on;
switch nDimensions
    case 1
        plot(classMeans,'b.');
    case 2
        plot(classMeans(:,1),classMeans(:,2),'b.');
    case 3
        plot3(classMeans(:,1),classMeans(:,2),classMeans(:,3),'b.');
end
hold off;
title(sprintf('Iteration %d',iter));
drawnow; %pause;


function bm=EWT_beta(x)

% function used in the construction of Meyer's wavelet
if x<0
    bm=0;
elseif x>1
    bm=1;
else
    bm=x^4*(35-84*x+70*x^2-20*x^3);
end


function imgOut = GammaDrago(img, drago_gamma, drago_slope, drago_start)
%
%        imgOut = GammaDrago(img, drago_gamma, drago_slope, drago_start)
%
%        This function applies gamma correction for the Drago et al.'s TMO,
%        please see DragoTMO.m
%
%        Input:
%           -img: an LDR image tone mapped with DragoTMO.m
%           -drago_gamma: is the elevation ratio of the line passing by the
%            origin and tangent to the curve
%           -drago_slope: f-stop value
%           -drago_start: is the abscissa at the point of tangency
%
%        Output:
%           -imgOut: gamma corrected img version
%
%     Copyright (C) 2013  Francesco Banterle
%
%     This program is free software: you can redistribute it and/or modify
%     it under the terms of the GNU General Public License as published by
%     the Free Software Foundation, either version 3 of the License, or
%     (at your option) any later version.
%
%     This program is distributed in the hope that it will be useful,
%     but WITHOUT ANY WARRANTY; without even the implied warranty of
%     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%     GNU General Public License for more details.
%
%     You should have received a copy of the GNU General Public License
%     along with this program.  If not, see <http://www.gnu.org/licenses/>.
%

if(~exist('drago_gamma','var'))
    drago_gamma = 2.2;
end

if(~exist('drago_slope','var'))
    drago_slope = 4.5;
end

if(~exist('drago_start','var'))
    drago_start = 0.018;
end

%applying gamma correction as in Drago et al. 2003
indx1 = find(img<=drago_start);
indx2 = find(img> drago_start);
img(indx1) =  img(indx1)*drago_slope;
img(indx2) = (img(indx2).^(0.9/drago_gamma))*1.099-0.099;

%clamping values out of the range [0.0,1.0]
imgOut = ClampImg(img, 0.0, 1.0);

end