function ROC = roc_plot(input_values, binary_outcome, varargin)
% This function makes a specific kind of ROC curve plot, based on input
% values along a continuous distribution and a binary outcome variable
% (logical)
%
% :Usage:
% ::
%
%     ROC = roc_plot(input_values, binary_outcome, ['include', include])
%
% Include is an optional logical variable of cases to include
%
% :Optional Inputs:
%
%   **'include':**
%        followed by logical vector of cases to include
%
%   **'threshold':**
%        followed by a priori threshold cutoff for determining misclassification
%
%   **'threshold_type':**
%        followed by thresh type: choices below:
%          - 'Optimal balanced error rate'
%          - 'Optimal overall accuracy' [default]
%          - 'Minimum SDT bias'
%          - [Enter threshold OR threshold_type]
%
%   **'color':**
%        followed by color, e.g., 'r' or [1 .5 0]
%
%   **'plotmethod':**
%        followed by 'deciles' [default] or 'observed'
%
%   **'nonormfit':**
%        suppress normal curve fitting to ROC
%
%   **'plothistograms':**
%        plot histograms of the signal present/absent distributions
%
%   **'writerscoreplus':**
%        Write text file for input into RScorePlus by Lew Harvey
%
%   **'boot':**
%        [default] Bootstrap 95% confidence intervals for sens, spec, PPV at threshold
%
%   **'noboot':**
%        Skip bootstrap
%
%   **'balanced':**
%        Balanced accuracy for single interval classification
%        THIS IS NOT COMPLETELY IMPLEMENTED BECAUSE IT AFFECTS ACCURACY
%        ESTIMATES, BUT NOT P-VALUES OR THRESHOLD AT WHICH TO EVALUATE SENS/SPEC
%
%   **'dependent':**
%        followed by vector of subject IDs, e.g., ('dependent',[1,1,2,2,3,3].
%
%        This will perform multilevel version of binomial test for single interval classification.
%
%   **'noplot':**
%        Skip generating plots
%
%   **'nooutput':**
%        Suppress text output
%
% :Outputs:
%
%   A structure containing the true and false pos rates (tpr, fpr) along the curve
%   and the criterion threshold values of the input variable (thr) corresponding to these rates.
%
% Sensitivity:                  Chances of predicting a "yes" given true "yes"
% Specificity:                  Chances of predicting a "no" given true "no"
% Positive predictive value:    Chances of true "yes" given predicted "yes"
% Negative predictive value:    Chances of true "no" given predicted "no"
% d or d_a:                     Effect size for classification; higher values indicate stronger predictive signal.
% AUC:                          Area under the ROC curve. Higher values indicate more true signal, with a max of 1
%                               (100% sensitivity with 100% specificity, perfect classification).
% sensitivity_ci, other _ci     95% confidence intervals for sensitivity and other statistics
%
%   Uses the function roc_calc.m
%
%   Also returns some information about misclassified observations
%   and line handle for ROC line plot and other statistics:
%     - area under ROC curve
%     - accuracy statistics based on binomial test
%     - PPV
%
% :Examples:
% ::
%
%    ROC = roc_plot(pattern_exp_values, ishot);
%    ROC = roc_plot(pattern_exp_values, ishot, 'threshold', 2.5);
%    ROC = roc_plot(pattern_exp_values, ishot, 'color', 'r', 'twochoice');
%    ROC = roc_plot(pattern_exp_values, ishot, 'color', 'r', 'twochoice', 'nonormfit');
%    ROC = roc_plot(pexp, logical(outcome), 'color', 'g', 'plothistograms', 'threshold', 0.3188);
%    ROC = roc_plot(pexp, logical(outcome), 'twochoice', 'color', 'b', 'plothistograms');
%    ROC = roc_plot(pexp, logical(outcome), 'writerscoreplus');
%    ROC = roc_plot(pexp, logical(outcome), 'color', 'r', 'plotmethod', 'observed', 'plothistograms');
%    ROC = roc_plot(pexp, logical(outcome), 'color', 'm', 'plotmethod', 'observed', 'plothistograms', 'Optimal overall accuracy');
%
% For a whole image with p-values, this may be helpful.
%
% Pre-specifies p-values you want to evaluate at.
% ::
%    rocout = roc_plot(1-t.p, truevals, 'plotmethod', 'observed', 'valuestoevaluate', 1 - [.5:-.1:.1 .05 .01 .005 .001 .0001 .00001 .000001 .0000001 .00000001]);
%
% ..
%    Tor Wager, Feb 2012
%    See Notes in text for more programming details.
%

%    Notes:
%    Tor Edited 3/17/2012 to add standard Gaussian signal detection fit curves,
%    effect size estimates based on Gaussian equal variance model
%
%    Tor Edited 3/20/2012 to fix AUC estimate and add/change output.
%
%    Tor Tested 3/20/12 against RScorePlus.  There are some consequences of
%    binning for input to RScorePlus, inclding that the "response" criteria are inferred
%    in RScorePlus, but they are given if we are selecting arbitrary criteria based on
%    continuous measures (e.g., brain activity). This influences the actual
%    estimates of the mean and std. signal distributions, as well as the
%    sens/spec estimates within response bins. This function does not use
%    arbitrary bins whenever possible, and uses the full ROC across thresholds
%    corresponding to each unique increment in specificity for AUC
%    calculation.
%
%    Edited 3/11/2014: Luke Chang to add balanced accuracy option for single
%    interval classification when classes are unbalanced
%
%    Edited 6/24/2014: Luke Chang to add multilevel binomial test for single
%    interval classification.  Assumes each subject has equal number of
%    trials.  Requires at least more than 20 subjects to ensure distribution
%    is reasonably approximated by normal distribution.  Uses one sample-test
%    across subjects.
%
%    Edited 1/13/2015: Luke Chang - added option to suppress plots for running
%    on cluster.
%
%    Edited 3/25/2015: Luke Chang - added option to suppress text output for
%    speeding up computations on cluster
%
%    Edited 8/2015: Tor Wager - reduced length of thr to speed computation
%    with large numbers of values (e.g., images with 50K+voxels)
%
%    12/8/2018: Tor Wager - made 2 substantive changes:
%     For 'Optimal balanced error rate', we don't want the threshold
%     that optimizes overall sensitivity+specificity; we want the threshold that
%     minimizes the discrepancy between sensitivity and specificity.
%     This is because with unbalanced classes, one can always choose
%     "yes" or "no" and the threshold will be at the bounds, yielding a
%     sens/spec of 0% and 100% or vice versa.
%
%     Threshold optimization correction for binomial P-values
%     Chance values can be tricky, and optimizing a threshold can be
%     circular. For example, if only 33% of observations are true
%     positives, and the classifier always guesses "no", it will be right
%     66% of the time, which is better than the 50% expected under random guessing.
%     We want to build in a correction for threshold selection.
%     The expectation under chance is that we'll adopt a strategy that
%     gives us at least the base-rate of true positive or true negative
%     results. For 33% true-pos, this would be 66%.
%     We take the max p-value of the difference from 0.5 and the baserate
%     or 1 - baserate.
%     Not implemented for 'dependent' binomial test.
%
% ..

include = true(size(binary_outcome));
threshold_type = 'Optimal overall accuracy';
class_thr = [];
color = [.2 .2 .2];
plotmethod = 'deciles'; %'npoints'; % 'observed';
donormfit = 1;
istwochoice = 0;
reportstats90 = 0;
plothistograms = 0;
writerscoreplus = 0;
doboot = 1;
dobalanced = 0;
doDependent = 0;
doplot = 1;
doOutput = 1;
valuestoevaluate = 'auto';

for i = 1:length(varargin)
    if ischar(varargin{i})
        switch varargin{i}

            case 'include', include = logical(varargin{i+1});

            case 'threshold'
                class_thr = varargin{i + 1};
                threshold_type = 'A priori threshold';

            case {'threshold_type'}
                threshold_type = varargin{i + 1}; varargin{i + 1} = [];

            case {'Optimal overall accuracy', 'Optimal balanced error rate', 'Minimum SDT bias'}
                threshold_type = varargin{i};

            case 'color'
                color = varargin{i + 1}; varargin{i + 1} = [];

            case 'plotmethod'
                plotmethod = varargin{i + 1}; varargin{i + 1} = [];

            case 'valuestoevaluate'
                valuestoevaluate = varargin{i + 1}; varargin{i + 1} = [];

            case 'nonormfit'
                donormfit = 0;

            case {'twochoice', 'forcedchoice', 'pairedobservations'}
                istwochoice = 1;

            case 'reportstats90', reportstats90 = 1;

            case 'plothistograms', plothistograms = 1;

            case 'boot', doboot = 1;
            case 'noboot', doboot = 0;

            case 'balanced'
                dobalanced = 1;
                error('THIS OPTION IS NOT IMPLEMENTED CORRECTLY; SEE CODE. CONSIDER USING ''Optimal balanced error rate'' OPTION');

            case 'noplot'
                doplot = 0;

            case 'nooutput'
                doOutput = 0;

            case 'dependent'
                doDependent = 1;
                subject_id = varargin{i + 1};
                if(~ismatrix(subject_id) || ~isnumeric(subject_id) || length(input_values)~=length(subject_id))
                    error('Make sure ''dependent'' flag is followed by valid subject_id vector')
                end

                disp('ROC for single interval classification of paired observations.')

            otherwise, warning(['Unknown input string option:' varargin{i}]);
        end
    end
end

if length(include) ~= length(binary_outcome) || ~any(include)
    error('Problem with include variable')
end

input_values = input_values(include);
binary_outcome = logical(binary_outcome(include));

% Deal with paired observations
% -------------------------------------------------------------------------

if istwochoice
    % Adjust input scores to reflect differences from the mean of each pair
    % This allows us to do forced-choice classification for pairs based on
    % which is higher. The higher one will always be above the mean.
    % The threshold used here should be zero.

    if doOutput
        disp('ROC for two-choice classification of paired observations.')
        disp('Assumes pos and null outcome observations have the same subject order.')
        disp('Using a priori threshold of 0 for pairwise differences.')
    end

    meanscores = (input_values(binary_outcome) + input_values(~binary_outcome)) ./ 2;

    input_values(binary_outcome) = input_values(binary_outcome) - meanscores;
    input_values(~binary_outcome) = input_values(~binary_outcome) - meanscores;

    threshold_type = 'A priori threshold';
    class_thr = 0;
end

% Get ROC values and main results
% -------------------------------------------------------------------------
if ischar(valuestoevaluate) && strcmp(valuestoevaluate, 'auto') % default

len = length(binary_outcome);
newlen = min(50*len, 500); % max 500 values to evaluate.

thr = linspace(min(input_values), max(input_values), newlen); %min(input_values):.01:max(input_values);

else
    thr = valuestoevaluate;
end

% AUC will be replaced with theoretical value in 2AFC case!
[dummy, tpr, fpr, auc, c_bias] = roc_calc(input_values, binary_outcome, thr);

% count signal present and signal absent
n1 = sum(~isnan(input_values(binary_outcome)) & ~isinf(input_values(binary_outcome)));
n0 = sum(~isnan(input_values(~binary_outcome)) & ~isinf(input_values(~binary_outcome)));

% Get criterion threshold for final stats output
% -------------------------------------------------------------------------

switch threshold_type
    case 'Optimal balanced error rate'

        % For 'Optimal balanced error rate', we don't want the threshold
        % that optimizes overall sensitivity+specificity; we want the threshold that
        % minimizes the discrepancy between sensitivity and specificity.
        % This is because with unbalanced classes, one can always choose
        % "yes" or "no" and the threshold will be at the bounds, yielding a
        % sens/spec of 0% and 100% or vice versa.

        % old:
%         avg = mean([tpr; 1-fpr]);
%         [dummy, wh] = max(avg);
%         class_thr = thr(wh);

        % new:
        tfdiff = diff([tpr; (1-fpr)]);
        [dummy, wh] = min(abs(tfdiff));
        class_thr = thr(wh);

        dobalanced = 1;

    case 'A priori threshold'

        % Report a priori threshold
        %         wh = find(thr <= class_thr);
        %         wh = wh(end);

    case 'Optimal overall accuracy'

        ncorrt = tpr .* n1;
        ncorrf = (1 - fpr) .* n0;

        mysum = sum([ncorrt; ncorrf]);
        [dummy, wh] = max(mysum);
        class_thr = thr(wh);

    case 'Minimum SDT bias'
        [dummy, wh] = min(abs(c_bias));
        class_thr = thr(wh);

    otherwise
        error('Unknown threshold type')
end

% Save stuff
% -------------------------------------------------------------------------
ROC.baserate = sum(binary_outcome) ./ length(binary_outcome);

ROC.all_vals.thr = thr;

ROC.class_threshold = class_thr;
ROC.sensitivity = sum(input_values(binary_outcome) >= class_thr) ./ n1; % go back to original thresh for precision when using specific input thresh
ROC.specificity = 1 - ( sum(input_values(~binary_outcome) >= class_thr) ./ n0 );
ROC.AUC = auc;
ROC.AUC_descrip = 'Numerically integrated, nonparametric area under curve';

% vectors of true/false positives and accuracy
if istwochoice
    falseneg = (input_values <= class_thr & binary_outcome); % Wani added this line to fix an error when two values are same (in the two-choice test)
else
    falseneg = (input_values < class_thr & binary_outcome);
end
falsepos = (input_values >= class_thr & ~binary_outcome);
misclass =  falseneg | falsepos;
truepos = binary_outcome & ~misclass;
trueneg = ~binary_outcome & ~misclass;

ROC.threshold_type_for_misclass = threshold_type;

if istwochoice
    % Reshape to reflect pairs for stats/output
    sz = [length(misclass) ./ 2 2];

    if any(sz ~= round(sz))
        disp('Two-choice classification assumes you enter paired observations in order:')
        disp('signal present for obs (1:n) followed by signal absent for (1:n) in the same order or vice versa.')
        error('The input has the wrong size.')
    end

    truepos = truepos(binary_outcome);
    trueneg = trueneg(~binary_outcome);
    falseneg = falseneg(binary_outcome);
    falsepos = falsepos(~binary_outcome);
    misclass = falsepos | falseneg;

    if any(truepos & falsepos) || any(trueneg & falseneg)
        disp('Two-choice classification assumes you enter paired observations in order:')
        disp('signal present for obs (1:n) followed by signal absent for (1:n) in the same order or vice versa.')
        error('Inconsistent output: The observations are likely not in order.')
    end

end

% Stuff for figuring out which points are misclassified

ROC.observations.truepos = truepos;
ROC.observations.trueneg = trueneg;
ROC.observations.falseneg = falseneg;
ROC.observations.falsepos = falsepos;
ROC.observations.misclass = misclass;

ROC.PPV = sum(ROC.observations.truepos) ./ (sum(ROC.observations.truepos) + sum(ROC.observations.falsepos));

% Accuracy stats
if ~dobalanced
    accuracy = 1 - (sum(misclass) ./ length(misclass));
else
    accuracy = (sum(truepos)/(sum(truepos) + sum(falseneg)) + sum(trueneg)/(sum(trueneg) + sum(falsepos)))/2;
end

ROC.accuracy = accuracy;

if ~doDependent

    % Threshold optimization correction for binomial P-values
    % Chance values can be tricky, and optimizing a threshold can be
    % circular. For example, if only 33% of observations are true
    % positives, and the classifier always guesses "no", it will be right
    % 66% of the time, which is better than the 50% expected under random guessing.
    % We want to build in a correction for threshold selection.
    % The expectation under chance is that we'll adopt a strategy that
    % gives us at least the base-rate of true positive or true negative
    % results. For 33% true-pos, this would be 66%.
    % We take the max p-value of the difference from 0.5 and the baserate
    % or 1 - baserate.
    % Not implemented for 'dependent' binomial test.

    RES = binotest(double(~misclass), .5);
    RES2 = binotest(double(~misclass), ROC.baserate);
    RES3 = binotest(double(~misclass), 1 - ROC.baserate);
    RES.p_val = max([RES.p_val RES2.p_val RES3.p_val]);

else %Run hierarchical version of binomial test

    %Create new subject matrix
    subID = unique(subject_id);
    for i = 1:length(subID)
        sdat(i,:) = ~misclass(subject_id == subID(i));
    end
    [RES1, RES2, RES3, RES4] = binotest_dependent(sdat,.5);
    RES = RES4;

end
ROC.N = RES.n;
ROC.accuracy_p = RES.p_val;
ROC.accuracy_se = RES.SE;

% Stuff for re-plotting full ROC
ROC.all_vals.tpr = tpr;
ROC.all_vals.fpr = fpr;

% -------------------------------------------------------------------------
% Plot stuff
%
% Get ROC values for plot - default is to plot 10 points
% -------------------------------------------------------------------------

switch plotmethod
    case 'deciles'
        plotthr = prctile(input_values, [10 20 30 40 50 60 70 80 90]);
        [dummy, plottpr, plotfpr] = roc_calc(input_values, binary_outcome, plotthr);
        plotsymbol = 'o';
        linewid = 2;

    case 'observed'
        plotthr = thr;
        plottpr = tpr;
        plotfpr = fpr;
        plotsymbol = '-';
        linewid = 3;
end

if doplot
    han = plot(plotfpr, plottpr, plotsymbol, 'Color', color, 'LineWidth', linewid);

    set(gca, 'FontSize', 32, 'XLim', [-.02 1.02], 'XTick', 0:.2:1, 'YTick', 0:.2:1);
    xlabel('(1 - Specificity)');
    ylabel('Sensitivity')

    inline_plothistograms();
end

% effect size
% -------------------------------------------------------------------------

if istwochoice
    % Two-alternative forced choice
    % -------------------------------------------------------------

    diffscores = input_values(binary_outcome) - input_values(~binary_outcome);

    meandiff = mean(diffscores);
    d = meandiff ./ std(diffscores);

    % forced-choice is variance of the difference, which is 2 * pooled variance
    % std of difference therefore = pooledsd * sqrt(2), and pooledsd = std(diffs)/sqrt(2)
    pooledsd = std(diffscores) ./ sqrt(2);

    d_a_model = meandiff ./ pooledsd; % estimate of what d_a would be for single-interval

    % From Lew Harvey's notes - this should be the "observed" d_a based on
    % empirical accuracy. But it will be inaccurate as accuracy approaches
    % 1. Use "model" because it's closer to the data, no norminv inaccuracy
    d_a_obs = sqrt(2) * norminv(ROC.accuracy);

    if donormfit
        % standard equal-variance signal detection
        x = [-3:.1:3];
        tprn = 1 - normcdf(x, d, 1);
        fprn = 1 - normcdf(x, -d, 1);
        hold on;
        if doplot
            han = [han plot(fprn, tprn, '-', 'Color', color, 'LineWidth', linewid)];
        end
    end

    aucn = calc_auc(fprn, tprn);
    expected_acc = 1 - normcdf(0, d, 1); % expected to be = to the AUC!

    ROC.Gaussian_model.type = 'Two-alternative forced choice';
    ROC.Gaussian_model.names = {'diff_scores'};
    ROC.Gaussian_model.means = meandiff;
    ROC.Gaussian_model.n = length(diffscores);
    ROC.Gaussian_model.sd = std(diffscores);
    ROC.Gaussian_model.d_a = d_a_model;
    ROC.Gaussian_model.d_a_descrip = '''Observed'' d_a based on empirical accuracy.';
    ROC.Gaussian_model.sensitivity = expected_acc;
    ROC.Gaussian_model.specificity = expected_acc;

    % PPV is just the accuracy, too.
    ROC.Gaussian_model.PPV = ROC.Gaussian_model.sensitivity ./ (ROC.Gaussian_model.sensitivity + 1 - ROC.Gaussian_model.specificity);

    ROC.Gaussian_model.AUC_numerical_integration = aucn;
    ROC.Gaussian_model.AUC = normcdf(d_a_model/sqrt(2)); % should just invert the accuracy equation. ...and yes, it does. same as accuracy.

else
    % single-interval
    % ------------------------------------------------------------
    %     N1 = length(input_values(binary_outcome)); done above
    %     N2 = length(input_values(~binary_outcome));

    meanpres = mean(input_values(binary_outcome));
    meanabs = mean(input_values(~binary_outcome));

    v1 = var(input_values(binary_outcome));
    v0 = var(input_values(~binary_outcome));

    pooledsd = sqrt((v1.*(n1-1) + v0.*(n0-1)) ./ (n1 + n0 - 2));

    d = (meanpres - meanabs) ./ pooledsd;

    zpres = meanpres ./ pooledsd;
    zabs = meanabs ./ pooledsd;

    if donormfit
        % integrate across PDFs for each of signal absent, signal present distributions
        x = [zabs-3:.1:zpres+3]; % relative to null dist
        tprn = 1 - normcdf(x, zpres, 1);
        fprn = 1 - normcdf(x, zabs, 1);
        hold on;
        if doplot
            han = [han plot(fprn, tprn, '-', 'Color', color, 'LineWidth', linewid)];
        end
    end

    aucn = calc_auc(fprn, tprn);

    ROC.Gaussian_model.type = 'Single-interval';
    ROC.Gaussian_model.names = {'sig. abs.' 'sig. pres.'};
    ROC.Gaussian_model.means = [meanabs meanpres];
    ROC.Gaussian_model.n = [n0 n1];
    ROC.Gaussian_model.sd = [sqrt(v0) sqrt(v1)];
    ROC.Gaussian_model.mean_diff = meanpres - meanabs;
    ROC.Gaussian_model.pooledsd = pooledsd;
    ROC.Gaussian_model.d_a = d;
    ROC.Gaussian_model.sensitivity = 1 - normcdf(class_thr, meanpres, sqrt(v1));
    ROC.Gaussian_model.specificity = normcdf(class_thr, meanabs, sqrt(v0));
    ROC.Gaussian_model.PPV = ROC.Gaussian_model.sensitivity ./ (ROC.Gaussian_model.sensitivity + 1 - ROC.Gaussian_model.specificity);

    ROC.Gaussian_model.AUC_numerical_integration = aucn;
    ROC.Gaussian_model.AUC = normcdf(d/sqrt(2));
    ROC.Gaussian_model.all_vals = struct('fprn', fprn, 'tprn', tprn);

end

if doplot
    ROC.line_handle = han;
end

% Boostrap, if asked for
% -------------------------------------------------------------------------
if doboot

    [ci, names] = roc_boot(input_values, binary_outcome, ROC.class_threshold, 0);

    ROC.sensitivity_ci = ci{1};
    ROC.specificity_ci = ci{2};
    ROC.PPV_ci = ci{3};

end

% fprintf('\nROC_PLOT Output: %s, %s\n', ROC.Gaussian_model.type, threshold_type);
%
% fprintf('  Nonparametric AUC:\t%3.2f\tParametric d_a:\t%3.2f\n', ROC.AUC, ROC.Gaussian_model.d_a);
%
% fprintf('  Threshold:\t%3.2f\tSens:\t%3.0f%%\tSpec:\t%3.0f%%\tPPV:\t%3.0f%%\n', ...
%     ROC.class_threshold, 100*ROC.sensitivity, 100*ROC.specificity, 100*ROC.PPV);
%
% fprintf('  Accuracy:\t%3.0f%% +- %3.1f%% (SE), P = %3.6f\n', ...
%     100*ROC.accuracy, 100*ROC.accuracy_se, ROC.accuracy_p);

if doOutput
    % Single line format
    fprintf('\nROC_PLOT Output: %s, %s\n', ROC.Gaussian_model.type, threshold_type);

    if doboot
        fprintf('Threshold:\t%3.2f\tSens:\t%3.0f%% CI(%.0f%%-%.0f%%)\tSpec:\t%3.0f%% CI(%.0f%%-%.0f%%)\tPPV:\t%3.0f%% CI(%.0f%%-%.0f%%)\t', ...
            ROC.class_threshold, 100*ROC.sensitivity, 100*ROC.sensitivity_ci, 100*ROC.specificity, 100*ROC.specificity_ci, 100*ROC.PPV, 100*ROC.PPV_ci);
    else
        fprintf('Threshold:\t%3.2f\tSens:\t%3.0f%%\tSpec:\t%3.0f%%\tPPV:\t%3.0f%%\t', ...
            ROC.class_threshold, 100*ROC.sensitivity, 100*ROC.specificity, 100*ROC.PPV);
    end

    fprintf('Nonparametric AUC:\t%3.2f\tParametric d_a:\t%3.2f\t', ROC.AUC, ROC.Gaussian_model.d_a);

    fprintf('  Accuracy:\t%3.0f%% +- %3.1f%% (SE), P = %3.6f\n', ...
        100*ROC.accuracy, 100*ROC.accuracy_se, ROC.accuracy_p);
end

% Report stats (max sens) at 90% specificity
if reportstats90

    ROC = report_at_threshold_spec();

end

% Calculate statistics by criterion threshold value
% Parallels output of RSCOREplus by Lew Harvey
% -------------------------------------------------------------------------

bins = [-Inf plotthr Inf];   % bin edges: EDGES(k) <= X(i) < EDGES(k+1)
npoints = length(bins);
s0 = histc(input_values(~binary_outcome), bins)';
s1 = histc(input_values(binary_outcome), bins)';

bin_names = {};

for i = 1:length(bins)
    %bin_names{i} = sprintf('R_%3.1f', bins(i));
    bin_names{i} = sprintf('R_%d', i);
end

ROC.Binned_output.s0 = s0;
ROC.Binned_output.s1 = s1;
ROC.Binned_output.bin_edges = bins;
ROC.Binned_output.bin_names = bin_names;

ROC.Binned_output.spec_bins = cumsum(s0) ./ sum(s0);
ROC.Binned_output.sens_bins = 1 - (cumsum(s1) ./ sum(s1));
ROC.Binned_output.PPV_bins = (ROC.Binned_output.sens_bins .* sum(s1)) ./ (ROC.Binned_output.sens_bins .* sum(s1) + (1 - ROC.Binned_output.spec_bins) .* sum(s0));

if writerscoreplus

    write_rscoreplus_input()

end

% INLINE FUNCTIONS
% -------------------------------------------------------------------------

    function inline_plothistograms()

        if plothistograms

            if ~isempty(findobj(get(0, 'Children'), 'type', 'figure'))
                returncurrfig = 1;
            end

            if returncurrfig
                figh = gcf;
            end

            % plot histograms...

            create_figure('distributions');
            h = histfit(input_values(binary_outcome), 20);
            hbar = get(h(1), 'Children');
            set(hbar, 'FaceAlpha', .3, 'FaceColor', [0 0 1], 'EdgeColor', 'none');
            % changing in diff versions of matlab...
            if isempty(hbar)
                set(h(1), 'FaceAlpha', .3, 'FaceColor', [0 0 1], 'EdgeColor', 'none');
            end

            set(h(2), 'Color', [0 0 1]);

            hold on;
            h = histfit(input_values(~binary_outcome), 20);
            hbar = get(h(1), 'Children');
            set(hbar, 'FaceAlpha', .3, 'FaceColor', [0 1 0], 'EdgeColor', 'none');

            % changing in diff versions of matlab...
            if isempty(hbar)
                set(h(1), 'FaceAlpha', .3, 'FaceColor', [0 1 0], 'EdgeColor', 'none');
            end

            set(h(2), 'Color', [0 .4 0]);

            h = plot_vertical_line(class_thr);
            set(h, 'Color', 'k', 'LineStyle', '-', 'LineWidth', 2)

            if returncurrfig
                figure(figh)
            end

        end

    end % inline

    function write_rscoreplus_input()

        fname = 'roc_rscoreplus_input.txt';
        disp('Writing RScorePlus input .txt file: %s\n', fname);

        fid = fopen(fullfile(pwd, fname), 'w+');
        if fid == -1, disp('Cannot open rscoreplus_input.txt file. Skipping.'); return, end

        fprintf(fid, 'Heading\nroc_plot.m_output\n');

        % parameters => see rscore plus help on lew harvey's website
        fprintf(fid, '%01d\t%01d\t%01d\t%01d\t%01d\t%01d\t', length(bins), 2, 1, 0, 0, 1);

        if istwochoice, paradigmstr = 'MAFC'; else paradigmstr = 'SINT'; end
        fprintf(fid, '%s\n', paradigmstr);

        fprintf(fid, 'labels\t');
        fprintf(fid, '%s\t', bin_names{:});
        fprintf(fid, '\n');

        fprintf(fid, 's0\t');
        fprintf(fid, '%d\t', s0);
        fprintf(fid, '\n');

        fprintf(fid, 's1\t');
        fprintf(fid, '%d\t', s1);
        fprintf(fid, '\n');

        fprintf(fid, '%3.1f\t%3.1f\t%3.1f\t%3.1f\n', 0, 1, .5, 1); % params of reference dist?
        fprintf(fid, '%01d\t%01d\t%01d\t%01d\n', 0, 0, 1, 1); % params of reference dist?

        fprintf(fid, 'end of file\n-1\n');
        fclose(fid);

    end % inline

    function report_at_threshold_spec
        wh = find(fpr <= .1);
        [mymax, wh2] = max(tpr(wh));
        wh = wh(wh2);
        if ~isempty(wh), wh = wh(1); else wh = NaN; end

        npos = sum(tpr(wh) .* binary_outcome);
        nfp = sum(fpr(wh) .* ~binary_outcome);
        ppv = npos ./ (npos + nfp);

        if isnan(wh)
            fprintf('At 90+%% Spec: Thresh = %3.2f, Sensitivity = %3.0f%%, Specificity = %3.0f%%, PPV = %3.0f%%\n', NaN, NaN, NaN, NaN);

            [ROC.thresh_90_percent_spec, ROC.sens_90_percent_spec] = deal(NaN);
        else

            fprintf('At 90+%% Spec: Thresh = %3.2f, Sensitivity = %3.0f%%, Specificity = %3.0f%%, PPV = %3.0f%%\n', thr(wh), tpr(wh)*100, (1-fpr(wh))*100, ppv * 100);

            ROC.thresh_90_percent_spec = thr(wh);
            ROC.sens_90_percent_spec = tpr(wh);
        end

        wh = find(fpr <= .05);
        [mymax, wh2] = max(tpr(wh));
        wh = wh(wh2);
        if ~isempty(wh), wh = wh(1); else wh = NaN; end

        if isnan(wh)
            fprintf('At 95+%% Spec: Thresh = %3.2f, Sensitivity = %3.0f%%, Specificity = %3.0f%%, PPV = %3.0f%%\n', NaN, NaN, NaN, NaN);

            [ROC.thresh_95_percent_spec, ROC.sens_95_percent_spec] = deal(NaN);

        else
            fprintf('At 95+%% Spec: Thresh = %3.2f, Sensitivity = %3.0f%%, Specificity = %3.0f%%, PPV = %3.0f%%\n', thr(wh), tpr(wh)*100, (1-fpr(wh))*100, ppv * 100);

            ROC.thresh_95_percent_spec = thr(wh);
            ROC.sens_95_percent_spec = tpr(wh);
        end

    end % inline

end % main function

%
% function [xvals, tpr, fpr] = roc_calc(input_vals, binary_outcome, xvals)
% % Calculate Receiver Operating Characteristic plot (ROC) given P-values
% %
% %  function [xvals, tpr, fpr] = roc_calc(input_vals or input values, input_vals, [treshold vals to assess])
% %
% % Modified from roc_calc.m in scnlab tools
% % Tor Wager, 2012
%
%
% [tpr, fpr] = deal(zeros(size(xvals)));
%
% indx = 1;
% for x = xvals
%     wh = input_vals >= x;
%
%     tpr(indx) = sum(wh(binary_outcome)) ./ sum(binary_outcome);
%     fpr(indx) = sum(wh(~binary_outcome)) ./ sum(~binary_outcome);
%
%     indx = indx + 1;
% end
%
% end % function

function auc = calc_auc(fpr, tpr)

[u, wh] = unique(fpr);
u2 = tpr(wh);

% fix for AUC = 1 if no overlap; triangle method not perfectly accurate
% here.
if any(u == 0 & u2 == 1), auc = 1; return, end

for i = 2:length(u)

    xdiff = u(i) - u(i - 1);
    ydiff = u2(i) - u2(i - 1);
    a(i) = xdiff * u2(i - 1) + xdiff * ydiff / 2;  % area of rect + area of triangle

end

auc = sum(a);

end


function BC = createBC3D(meshvar)
% Creates a boundary condition structure from a mesh structure
% for a 3D structured mesh. The default boundary conditions on
% all boundaries are Neumann;
% The values of each boundary condition are defined as:
% BC.<position>. :
%               a, b, c, where
% a*grad(phi).e + b*phi = c
%
% SYNOPSIS:
%   BC = createBC3D(meshvar)
%
% PARAMETERS:
%
%
% RETURNS:
%
%
% EXAMPLE:
%
% SEE ALSO:
%

% Extract number of cells from the mesh structure
Nxyz = meshvar.dims;
Nx = Nxyz(1); Ny = Nxyz(2); Nz = Nxyz(3);

% Define the top, bottom, right, and left boundary conditions
% (default = Neumann, i.e., a = 1, b = 0, c = 0)
top.a = ones(Nx,Nz);
top.b = zeros(Nx,Nz);
top.c = zeros(Nx,Nz);
top.periodic = 0;

bottom.a = ones(Nx,Nz);
bottom.b = zeros(Nx,Nz);
bottom.c = zeros(Nx,Nz);
bottom.periodic = 0;

right.a = ones(Ny,Nz);
right.b = zeros(Ny,Nz);
right.c = zeros(Ny,Nz);
right.periodic = 0;

left.a = ones(Ny,Nz);
left.b = zeros(Ny,Nz);
left.c = zeros(Ny,Nz);
left.periodic = 0;

front.a = ones(Nx,Ny);
front.b = zeros(Nx,Ny);
front.c = zeros(Nx,Ny);
front.periodic = 0;

back.a = ones(Nx,Ny);
back.b = zeros(Nx,Ny);
back.c = zeros(Nx,Ny);
back.periodic = 0;

BC= BoundaryCondition(meshvar, left, right, bottom, top, back, front);


function [C, S] = QLiftDec2Nevill(X, N, filtername)
%-----------------------------------------------------------------------------
% QLiftDec2Nevill
% Multilevel 2-D decomposition by the lifting scheme and using quincunx grids
%
% Calls for: NevilleR2Q, stencilR2Q, stencilCrop, stencilxgridfRVC, QLmaxlev,
%            storeQ1001, storeR,
%            getcolor01, getcolor10, getcolor00, getcolor11,
%            putcolor01, putcolor10, putcolor00, putcolor11.
% See also: QLiftRec2NV
%
% Design and implementation by:
% Dr. Paul M. de Zeeuw <Paul.de.Zeeuw@cwi.nl>  http://homepages.cwi.nl/~pauldz/
% Last Revision: May 16, 2002.
% (c) 1999-2002 Stichting CWI, Amsterdam
%-----------------------------------------------------------------------------
%Firstly, check input data
%
if  isempty(X)
  error(' QLiftDec2Nevill - empty matrix ');
else
  if mod(N, 2) == 1
    error(' QLiftDec2Nevill - only an even number of levels is accepted ');
  end
  if QLmaxlev(size(X), filtername) < N
    error(' QLiftDec2Nevill - too many levels requested ');
  end
  if N < 2
    disp([' QLiftDec2Nevill - WARNING too few levels requested ' ...
          '-> empty decomposition ']);
  end
end
C = []; S = [];
%
%Secondly, some initializing of filters
%
switch lower(filtername)
 case 'neville2'
   [Pa, centerPa] = NevilleR2Q(2);
 case 'neville4'
   [Pa, centerPa] = NevilleR2Q(4);
 case 'neville6'
   [Pa, centerPa] = NevilleR2Q(6);
 case 'neville8'
   [Pa, centerPa] = NevilleR2Q(8);
 otherwise
   error([' QLiftDec2Nevill - unknown filter ' filtername]);
end
%
% Here Pa is the stencil of a prediction step,
% e.g. Pa = 0.250*[0 1 0; 1 0 1; 0 1 0]; centerPa = [2 2];
%
Ua = 0.5 * Pa; centerUa = centerPa;
% Ua is the stencil of the update step and as such determined by Pa.
%
[Pb, centerPb] = stencilR2Q(Pa, centerPa);
[Pb, centerPb] = stencilCrop(Pb, centerPb);
% where Pb is the stencil of a prediction step,
% e.g. Pb = 0.250*[1 0 1; 0 0 0; 1 0 1]; centerPb = [2 2];
%
Ub = 0.5 * Pb; centerUb = centerPb; % Compare to V11!!,
%                                     what about center of stencil??
% Ub is the stencil of the update step and as such determined by Pb.
%
%Thirdly, start decomposition
%
O = X; % For the sake of efficient use of memory this could be improved upon.
% We descend to coarser grids, integer lev indicates number of scale.

for lev=1:2:N
%
   [nO, mO] = size(O);
   if ( nO < 3 ) || ( mO < 3)
     error(' QLiftDec2Nevill - too many levels ');
   else
     sizeO = size(O);
   end
%
%  The Lifting Scheme proceeds from a rectangular grid
%  towards a quincunx grid.
%
%  Stage: predict
%  Convolution of prediction stencil Pa with WHOLE gridfunction O.
%  Note: the operations count is twice as much as it could be.
   PaO = stencilxgridfRVC(O, Pa, centerPa);
%
%  Quincunx grid Q0011 is the union of the values at .00 and .11: "even slots"
%  Quincunx grid Q1001 is the union of the values at .10 and .01: "odd slots"
   Q1001D01 = getcolor01(O) - getcolor01(PaO);
   Q1001D10 = getcolor10(O) - getcolor10(PaO);
   clear PaO;
%  At this point the union (quincunx) of Q1001D01 & Q1001D10
%  contains the DETAILS of O.
%  Note: this is not an "in place" implementation.
%  For the inverse transform Q1001D01 and Q1001D10 have to be stored:
   [C, S] = storeQ1001( Q1001D10, Q1001D01, lev, 'd', C, S);
%
%  Stage: update
   RectDetail = putcolor10(Q1001D10, sizeO) + putcolor01(Q1001D01, sizeO);
   clear Q1001D01 Q1001D10;
   UaD = stencilxgridfRVC(RectDetail, Ua, centerUa);
   clear RectDetail;
%
   Q0011A00 = getcolor00(O) + getcolor00(UaD);
   Q0011A11 = getcolor11(O) + getcolor11(UaD);
   clear UaD O;
%
%  At this point the union (quincunx) of Q0011A00 & Q0011A11
%  contains the updated APPROXIMATION of O, the DETAILS of O
%  were in the union (quincunx) of Q1001D01 & Q1001D10 (see above).
%
%  The Lifting Scheme proceeds by a subsequent step from quincunx
%  to rectangular grid.
%
%  Q0011 is split into the 11 colour with the "odd slots" and
%  the 00 colour with the "even slots".
%
%  Stage: predict
   DETAIL11 = Q0011A11 - ...
      getcolor11(stencilxgridfRVC(putcolor00(Q0011A00, sizeO), Pb, centerPb));
   clear Q0011A11;
%  Note: the operations count is twice as much as it could be
%  DETAIL11 presents the detail gridfunction w.r.t. Q0011
%
%  For the inverse transform DETAIL11 has to be stored:
   [C, S] = storeR( DETAIL11, lev+1, 'd', C, S);
%
%  Stage: update
%  Break up next line in parts in case checking is desired
   APPROX00 = Q0011A00 + ...
      getcolor00(stencilxgridfRVC(putcolor11(DETAIL11, sizeO), Ub, centerUb));
   clear Q0011A00 DETAIL11;
%  APPROX00 now represents the updated version of the approximation of Q0011
%
%  At this point gridfunction DETAIL11 containing the DETAILS has been stored,
%  gridfunction APPROX00 contains the updated APPROXIMATION, on the (down-
%  sampled) rectangular grid and has to be stored as well if at the highest
%  scale.
%  Note that APPROX00 is downsampled onto a rectangular grid with dimensions of
%  half size of the original O.
   if lev+1 >= N
     [C, S] = storeR(APPROX00, lev+1, 'a', C, S);
%    It is obligatory that at least at one scale the Approximation has to be
%    stored or else the scheme cannot be inverted.
     clear APPROX00;
%    In the Lifting Scheme all scales have now been processed!
   else
%    We proceed to the next scale.
     O = APPROX00; clear APPROX00;
   end
end
%-----------------------------------------------------------------------------


function [fusedBox] = fusePETMRI(ROIbox_PET,ROIbox_MRI,maskBox_PET,MRIinv,MRIweight,wavelet)
% -------------------------------------------------------------------------
% function [fusedBox] = fusePETMRI(ROIbox_PET,ROIbox_MRI,maskBox_PET,Invert,MRIweight,wavelet)
% -------------------------------------------------------------------------
% DESCRIPTION:
% This function fuses the region of interest (ROI) of two registered PET and
% MRI volumes using a technique based on the wavelet transform. See Ref. [1]
% for more details.
% -------------------------------------------------------------------------
% REFERENCE:
% [1] Vallieres, M. et al. (2015). A radiomics model from joint FDG-PET and
%     MRI texture features for the prediction of lung metastases in soft-tissue
%     sarcomas of the extremities. Physics in Medicine and Biology, 60(14),
%     5471-5496. doi:10.1088/0031-9155/60/14/5471
% -------------------------------------------------------------------------
% INPUTS:
% - ROIbox_PET: 3D array of the smallest box containing the ROI of the PET
%               volume.
% - ROIbox_MRI: 3D array of the smallest box containing the ROI of the MRI
%               volume.
% - maskBox_PET: 3D array of the mask of the smallest box specifying the
%                ROI of the PET volume. Voxels within the ROI are assigned
%                value of 1, voxels outside a value of 0.
% - MRIinv: String specifying if the intensities of the MRI volume are
%           inverted prior to fusion with PET. Either 'Inv' for inversion,
%           or 'NoInv' for no inversion.
% - MRIweight: Numerical value specifying the weight of the MRI scan in the
%              fusion with PET.
% - wavelet: String specifying the name of the MATLAB wavelet basis used
%            wavelet basis used in the fusion process.
% -------------------------------------------------------------------------
% OUTPUTS:
% - fusedBox: 3D array of the smallest box containing the ROI of the fused
%             PET/MRI volume. Note that the output contains random values
%             outside the ROI. These values are added in the fusion process
%             in order to accurately calculate the mean and the standard
%             deviation of the ROI (only) of the MRI volume when performing
%             Collewet normalization in the wavelet domain. Apply the mask
%             to 'fusedBox' by setting NaNs outside the ROI to accurately
%             visualize the fusion.
% -------------------------------------------------------------------------
% AUTHOR(S): Martin Vallieres <mart.vallieres@gmail.com>
% -------------------------------------------------------------------------
% HISTORY:
% - Creation: January 2013
% - Revision: May 2015
% -------------------------------------------------------------------------
% STATEMENT:
% This file is part of <https://github.com/mvallieres/radiomics/>,
% a package providing MATLAB programming tools for radiomics analysis.
% --> Copyright (C) 2015  Martin Vallieres
%
%    This package 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 package 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 package.  If not, see <http://www.gnu.org/licenses/>.
% -------------------------------------------------------------------------

% PET PRE_PROCESSING
ROIbox_PET = sqrt(ROIbox_PET);

% RESAMPLING MRI VOLUME TO PET IN-PLANE RESOLUTION (slice spacing
% previously verified to be the same)
szPET = size(ROIbox_PET);
temp=zeros(szPET);
for i = 1:szPET(3)
    temp(:,:,i) = imresize(ROIbox_MRI(:,:,i),[szPET(1),szPET(2)],'Method','cubic','Antialiasing',true);
end
ROIbox_MRI = temp;

% NORMALIZATION (and inversion) OF VOLUMES
ROIOnly_MRI = ROIbox_MRI;
ROIOnly_PET = ROIbox_PET;
ROIOnly_MRI(maskBox_PET==0) = NaN;
ROIboxFill_MR = fillBox(ROIOnly_MRI);
ROIOnly_PET(maskBox_PET==0) = NaN;
minMRI = min(ROIOnly_MRI(:));
ROIboxFill_MR = ROIboxFill_MR - minMRI;
ROIOnly_MRI = ROIOnly_MRI - minMRI;
ROIboxFill_MR = ROIboxFill_MR./max(ROIOnly_MRI(:)).*255;
if strcmp(MRIinv,'Inv')
    ROIboxFill_MR = 255 - ROIboxFill_MR;
end
minPET = min(ROIOnly_PET(:));
ROIbox_PET = ROIbox_PET - minPET;
ROIOnly_PET = ROIOnly_PET - minPET;
ROIbox_PET = ROIbox_PET./max(ROIOnly_PET(:)).*255;

% WAVELET DECOMPOSITION AND FUSION OF COEFFICIENTS
wdecMRI = wavedec3(ROIboxFill_MR,1,wavelet);
wdecPET = wavedec3(ROIbox_PET,1,wavelet);
wdecFUSED = wdecPET;
nbcell = length(wdecMRI.dec);
for i = 1:nbcell
    wdecMRI.dec{i} = CollewetNorm(wdecMRI.dec{i});
    wdecMRI.dec{i}(isnan(wdecMRI.dec{i})) = wdecPET.dec{i}(isnan(wdecMRI.dec{i}));
    wdecFUSED.dec{i} = (1-MRIweight).*wdecPET.dec{i} + MRIweight.*wdecMRI.dec{i};
end

% WAVELET RECONSTRUCTION
fusedBox = waverec3(wdecFUSED);
fusedBox = fusedBox - min(fusedBox(:));
fusedBox = fusedBox./max(fusedBox(:)).*255;

end


classdef prtClassPerTurbo < prtClass
    % See: "Perturbo: a new classi?cation algorithm based on the spectrum
    % perturbations of the laplace-beltrami operator."
    %
    % Notes:
    % 1) Very very sensitive to the kernel sigma parameter; should/must
    % optimize over \sigma
    %
    % 2) Very memory intensive.  Consider bootstrapping data and/or bagging
    % this classifier to reduce computational load (memory ~ O(nObs^2) )
    %
    % % try this:
    % ds = prtDataGenMarysSimpleSixClass;
    % pt = prtClassPerTurbo;
    % pt.kernel = prtKernelRbf('sigma',.7);
    % pt = pt.train(ds);
    % plot(pt)
    %
    %
    % ds = prtDataGenMarySimple;
    % pt = prtClassPerTurbo;
    % pt.kernel = prtKernelRbf('sigma',.7);
    % pt = pt.train(ds);
    % plot(pt)
    %

    properties (SetAccess=private)
        name = 'PerTurbo'  % Bumping
        nameAbbreviation = 'PerTurbo'  %
        isNativeMary = true;         %
    end

    properties
        kernel = prtKernelRbfNdimensionScale;
    end
    properties (SetAccess=protected)
        trainedKernels
        K
        Kinv
        uClasses
    end

    methods

        function self = set.kernel(self,val)
            assert(numel(val)==1 &&  isa(val,'prtKernel'),'prt:prtClassRvm:kernel','kernel must be a prtKernel');
            self.kernel = val;
        end

        function self = prtClassPerTurbo(varargin)
            self = prtUtilAssignStringValuePairs(self,varargin{:});
        end

    end

    methods (Access=protected, Hidden = true)

        function self = trainAction(self,dataSet)
            self.uClasses = dataSet.uniqueClasses;
            y = dataSet.getTargets;
            x = dataSet.getObservations;
            for i = 1:length(self.uClasses)
                cInd = y == self.uClasses(i);
                cx = x(cInd,:);

                tempDs = prtDataSetClass(cx);
                self.trainedKernels{i} = self.kernel.train(tempDs);
                self.K{i} =  self.trainedKernels{i}.run_OutputDoubleArray(tempDs);
                self.Kinv{i} = inv(self.K{i});
            end
        end

        function yOut = runAction(self,dataSet)

            x = nan(dataSet.nObservations,length(self.uClasses));
            for samples = 1:1000:dataSet.nObservations
                retainObs = samples:min([samples+999,dataSet.nObservations]);
                currSet = dataSet.retainObservations(retainObs);
                for i = 1:length(self.uClasses)

                    k = self.trainedKernels{i}.run_OutputDoubleArray(currSet);
                    x(retainObs,i) = 1-diag(k*self.Kinv{i}*k');
                end
            end

            yOut = dataSet;
            yOut.X = -x;
            %binary; note - output mixture for binary classification
            if length(self.uClasses) == 2
                yOut.X = -x(:,2)+x(:,1);
            end
        end

    end
end


function r = subsref(a,s)
%SUBSREF      Implements subscripted references for Hessians
%

% 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
% modified 10/03/12     S.M. Rump  INTLAB_HESSIAN_DERIV_ERROR removed
% modified 10/06/12     S.M. Rump  internal use
%

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

  N = getappdata(0,'INTLAB_HESSIAN_NUMVAR');

  while 1
    if ~isa(a,'hessian')                 % index reference a.x(i) etc.
      r = subsref(a,s(1));
    elseif strcmp(s(1).type,'()')        % index reference a(i)
      r.x = a.x(s(1).subs{:});
      index = reshape(1:prod(size(a.x)),size(a.x));
      index = index(s(1).subs{:});
      r.dx = a.dx(:,index(:));
      r.hx = a.hx(:,index(:));
      % avoid Matlab 6.5f bug:
      % a = sparse([],[],[],1,1); a = reshape(a,1,1); abs(a)
      % produces  9.6721e-317  or similar number in underflow range
      if prod(size(r.x))==1
        r.x = full(r.x);
      end
      if prod(size(r.dx))==1
        r.dx = full(r.dx);
      end
      if prod(size(r.hx))==1
        r.hx = full(r.hx);
      end
      r = class(r,'hessian');
    elseif strcmp(s(1).type,'.')         % index reference a.x, a.dx or a.hx
      if strcmp(s(1).subs,'x')
        r = a.x;
      elseif strcmp(s(1).subs,'dx')
        sizeax = size(a.x);
        if ( length(sizeax)==2 ) & ( sizeax(2)==1 )
          sizeax = sizeax(1);            % row gradient for column vector a.x
        end
        if issparse(a.dx) & ( length(sizeax)>1 )
          error('access of .dx sparse hessian with more than one column, see hessianinit')
        end
        r = reshape(transpose(a.dx),[sizeax N]);
      elseif strcmp(s(1).subs,'ddx')
        r = a.dx;
      elseif strcmp(s(1).subs,'hx')
        if issparse(a.hx) & ( prod(size(a.x))>1 )
          error('access of .hx of non-scalar sparse hessian, see hessianinit')
        end
        index = reshape(1:N*N,N,N)';
        r = a.hx + a.hx(index(:),:);     % Hessian is .hx + transpose(.hx)
        sizeax = size(a.x);
        if prod(sizeax)==1
          r = reshape(r,N,N);
        else
          r = reshape(r,[sizeax N N]);
        end
      elseif strcmp(s(1).subs,'hhx')
        index = reshape(1:N*N,N,N)';
        r = a.hx + a.hx(index(:),:);     % Hessian is .hx + transpose(.hx)
      elseif strcmp(s(1).subs,'mid')
        r = mid(a);
      else
        error('invalid subscript reference for hessian')
      end
    else
      error('invalid index reference for hessian')
    end
    if length(s)==1
      if rndold
        setround(rndold)
      end
      return
    end
    s = s(2:end);
    a = r;
  end


function [traj, infStates] = tapas_ehgf(r, p, varargin)
% Calculates the trajectories of the agent's representations under the HGF
%
% This function can be called in two ways:
%
% (1) tapas_ehgf(r, p)
%
%     where r is the structure generated by tapas_fitModel and p is the parameter vector in native space;
%
% (2) tapas_ehgf(r, ptrans, 'trans')
%
%     where r is the structure generated by tapas_fitModel, ptrans is the parameter vector in
%     transformed space, and 'trans' is a flag indicating this.
%
% --------------------------------------------------------------------------------------------------
% Copyright (C) 2012-2020 Christoph Mathys, TNU, UZH & ETHZ
%
% This file is part of the HGF toolbox, which is released under the terms of the GNU General Public
% Licence (GPL), version 3. You can redistribute it and/or modify it under the terms of the GPL
% (either version 3 or, at your option, any later version). For further details, see the file
% COPYING or <http://www.gnu.org/licenses/>.

% Transform paramaters back to their native space if needed
if ~isempty(varargin) && strcmp(varargin{1},'trans');
    p = tapas_ehgf_transp(r, p);
end

% Number of levels
l = length(p)/5;

if l ~= floor(l)
    error('tapas:hgf:UndetNumLevels', 'Cannot determine number of levels');
end

% Unpack parameters
mu_0 = p(1:l);
sa_0 = p(l+1:2*l);
rho  = p(2*l+1:3*l);
ka   = p(3*l+1:4*l-1);
om   = p(4*l:5*l-2);
th   = exp(p(5*l-1));
al   = 1/p(5*l);

% Add dummy "zeroth" trial
u = [0; r.u(:,1)];

% Number of trials (including prior)
n = length(u);

% Assume that if u has more than one column, the last contains t
try
    if r.c_prc.irregular_intervals
        if size(u,2) > 1
            t = [0; r.u(:,end)];
        else
            error('tapas:hgf:InputSingleColumn', 'Input matrix must contain more than one column if irregular_intervals is set to true.');
        end
    else
        t = ones(n,1);
    end
catch
    if size(u,2) > 1
        t = [0; r.u(:,end)];
    else
        t = ones(n,1);
    end
end

% Initialize updated quantities

% Representations
mu = NaN(n,l);
pi = NaN(n,l);

% Other quantities
muhat = NaN(n,l);
pihat = NaN(n,l);
v     = NaN(n,l);
w     = NaN(n,l-1);
da    = NaN(n,l);
dau   = NaN(n,1);

% Representation priors
% Note: first entries of the other quantities remain
% NaN because they are undefined and are thrown away
% at the end; their presence simply leads to consistent
% trial indices.
mu(1,:) = mu_0;
pi(1,:) = 1./sa_0;

% Representation update loop
% Pass through trials
for k = 2:1:n
    if not(ismember(k-1, r.ign))

        %%%%%%%%%%%%%%%%%%%%%%
        % Effect of input u(k)
        %%%%%%%%%%%%%%%%%%%%%%

        % 1st level
        % ~~~~~~~~~
        % Prediction
        muhat(k,1) = mu(k-1,1) +t(k) *rho(1);

        % Precision of prediction
        pihat(k,1) = 1/(1/pi(k-1,1) +t(k) *exp(ka(1) *mu(k-1,2) +om(1)));

        % Input prediction error
        dau(k) = u(k) -muhat(k,1);

        % Updates
        pi(k,1) = pihat(k,1) +1/al;
        mu(k,1) = muhat(k,1) +1/pihat(k,1) *1/(1/pihat(k,1) +al) *dau(k);

        % Volatility prediction error
        da(k,1) = (1/pi(k,1) +(mu(k,1) -muhat(k,1))^2) *pihat(k,1) -1;

        if l > 2
            % Pass through higher levels
            % ~~~~~~~~~~~~~~~~~~~~~~~~~~
            for j = 2:l-1
                % Prediction
                muhat(k,j) = mu(k-1,j) +t(k) *rho(j);

                % Precision of prediction
                pihat(k,j) = 1/(1/pi(k-1,j) +t(k) *exp(ka(j) *mu(k-1,j+1) +om(j)));

                % Weighting factor
                v(k,j-1) = t(k) *exp(ka(j-1) *mu(k-1,j) +om(j-1));
                w(k,j-1) = v(k,j-1) *pihat(k,j-1);

                % Mean update
                mu(k,j) = muhat(k,j) +1/2 *1/pihat(k,j) *ka(j-1) *w(k,j-1) *da(k,j-1);

                % Ingredients of precision update which depend on the mean
                % update
                vv = t(k) *exp(ka(j-1) *mu(k,j) +om(j-1));
                pimhat = 1/(1/pi(k-1,j-1) +vv);
                ww = vv *pimhat;
                rr = (vv -1/pi(k-1,j-1)) *pimhat;
                dd = (1/pi(k,j-1) +(mu(k,j-1) -muhat(k,j-1))^2) *pimhat -1;

                % Precision update
                pi(k,j) = pihat(k,j) +max(0, 1/2 *ka(j-1)^2 *ww*(ww +rr*dd));

                % Volatility prediction error
                da(k,j) = (1/pi(k,j) +(mu(k,j) -muhat(k,j))^2) *pihat(k,j) -1;
            end
        end

        % Last level
        % ~~~~~~~~~~
        % Prediction
        muhat(k,l) = mu(k-1,l) +t(k) *rho(l);

        % Precision of prediction
        pihat(k,l) = 1/(1/pi(k-1,l) +t(k) *th);

        % Weighting factor
        v(k,l)   = t(k) *th;
        v(k,l-1) = t(k) *exp(ka(l-1) *mu(k-1,l) +om(l-1));
        w(k,l-1) = v(k,l-1) *pihat(k,l-1);

        % Mean update
        mu(k,l) = muhat(k,l) +1/2 *1/pihat(k,l) *ka(l-1) *w(k,l-1) *da(k,l-1);

        % Ingredients of the precision update which depend on the mean
        % update
        vv = t(k) *exp(ka(l-1) *mu(k,l) +om(l-1));
        pimhat = 1/(1/pi(k-1,l-1) +vv);
        ww = vv *pimhat;
        rr = (vv -1/pi(k-1,l-1)) *pimhat;
        dd = (1/pi(k,l-1) +(mu(k,l-1) -muhat(k,l-1))^2) *pimhat -1;

        pi(k,l) = pihat(k,l) +max(0, 1/2 *ka(l-1)^2 *ww*(ww +rr*dd));

        % Volatility prediction error
        da(k,l) = (1/pi(k,l) +(mu(k,l) -muhat(k,l))^2) *pihat(k,l) -1;
    else

        mu(k,:) = mu(k-1,:);
        pi(k,:) = pi(k-1,:);

        muhat(k,:) = muhat(k-1,:);
        pihat(k,:) = pihat(k-1,:);

        v(k,:)  = v(k-1,:);
        w(k,:)  = w(k-1,:);
        da(k,:) = da(k-1,:);

    end
end

% Remove representation priors
mu(1,:)  = [];
pi(1,:)  = [];

% Remove other dummy initial values
muhat(1,:) = [];
pihat(1,:) = [];
v(1,:)     = [];
w(1,:)     = [];
da(1,:)    = [];
dau(1)     = [];

% Create result data structure
traj = struct;

traj.mu     = mu;
traj.sa     = 1./pi;

traj.muhat  = muhat;
traj.sahat  = 1./pihat;

traj.v      = v;
traj.w      = w;
traj.da     = da;
traj.dau    = dau;

% Updates with respect to prediction
traj.ud = mu -muhat;

% Psi (precision weights on prediction errors)
psi        = NaN(n-1,l);
psi(:,1)   = 1./(al*pi(:,1));
psi(:,2:l) = pihat(:,1:l-1)./pi(:,2:l);
traj.psi   = psi;

% Epsilons (precision-weighted prediction errors)
epsi        = NaN(n-1,l);
epsi(:,1)   = psi(:,1) .*dau;
epsi(:,2:l) = psi(:,2:l) .*da(:,1:l-1);
traj.epsi   = epsi;

% Full learning rate (full weights on prediction errors)
wt        = NaN(n-1,l);
wt(:,1)   = psi(:,1);
wt(:,2:l) = 1/2 *(v(:,1:l-1) *diag(ka(1:l-1))) .*psi(:,2:l);
traj.wt   = wt;

% Create matrices for use by the observation model
infStates = NaN(n-1,l,4);
infStates(:,:,1) = traj.muhat;
infStates(:,:,2) = traj.sahat;
infStates(:,:,3) = traj.mu;
infStates(:,:,4) = traj.sa;

end


% SP_DRCHLT_L2_PROJ: assign the degrees of freedom of Dirichlet boundaries through an L2 projection.
%
%   [u, dofs] = sp_drchlt_l2_proj (sp, msh, h, sides)
%
% INPUT:
%
%  sp:    object defining the space of discrete functions (see sp_scalar)
%  msh:   object defining the domain partition and the quadrature rule (see msh_cartesian)
%  h:     function handle to compute the Dirichlet condition
%  sides: boundary sides on which a Dirichlet condition is imposed
%
% OUTPUT:
%
%  u:    assigned value to the degrees of freedom
%  dofs: global numbering of the corresponding basis functions
%
% Copyright (C) 2010 Carlo de Falco
% Copyright (C) 2010, 2011, 2015 Rafael Vazquez
%
%    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/>.

function [u, dofs] = sp_drchlt_l2_proj (sp, msh, h, sides)

  rhs  = zeros (sp.ndof, 1);

  % In the 1D case, with an open knot vector,  it is not necessary to compute a projection.
  % For now it only works for scalars
  if (msh.ndim == 1)
    dofs = []; u = zeros (numel(sides), 1);
    for ii = 1:numel(sides)
      iside = sides(ii);
      dofs = union (dofs, sp.boundary(iside).dofs);
      if (iside == 1)
        geo_map = msh.map(msh.breaks{1}(1));
      else
        geo_map = msh.map(msh.breaks{1}(end));
      end
      for jj = 1:msh.rdim; xx{jj} = geo_map(jj); end
      u(ii) = h(xx{:}, iside);
    end
    u = u(:);
    return
  end

  dofs = [];
  nent = 0;
  for iside = sides
    nent = nent + msh.boundary(iside).nel * sp.boundary(iside).nsh_max^2;
    dofs = union (dofs, sp.boundary(iside).dofs);
  end

  rows = zeros (nent, 1);
  cols = zeros (nent, 1);
  vals = zeros (nent, 1);

  ncounter = 0;
  for iside = sides
% Restrict the function handle to the specified side, in any dimension, hside = @(x,y) h(x,y,iside)
    hside = @(varargin) h(varargin{:},iside);
    [rs, cs, vs] = op_u_v_tp (sp.boundary(iside), sp.boundary(iside), msh.boundary(iside));

    bnd_dofs = sp.boundary(iside).dofs;

    rows(ncounter+(1:numel(rs))) = bnd_dofs(rs);
    cols(ncounter+(1:numel(rs))) = bnd_dofs(cs);
    vals(ncounter+(1:numel(rs))) = vs;
    ncounter = ncounter + numel (rs);

    rhs(bnd_dofs) = rhs(bnd_dofs) + op_f_v_tp (sp.boundary(iside),msh.boundary(iside), hside);
  end

  M = sparse (rows(1:ncounter), cols(1:ncounter), vals(1:ncounter));
  u = M(dofs, dofs) \ rhs(dofs, 1);

end


function fk_body = autoGen_fk_body(q1,q2,q3)
%AUTOGEN_FK_BODY
%    FK_BODY = AUTOGEN_FK_BODY(Q1,Q2,Q3)

%    This function was generated by the Symbolic Math Toolbox version 8.4.
%    01-Jun-2020 11:59:03

t2 = cos(q1);
t3 = cos(q2);
t4 = sin(q1);
t5 = q2+q3;
t6 = cos(t5);
t7 = sin(t5);
t8 = t3.*3.2e+1;
t9 = t6.*5.7e+1;
t10 = t8+t9;
fk_body = reshape([t2.*t6,t4.*t6,-t7,0.0,-t4,t2,0.0,0.0,t2.*t7,t4.*t7,t6,0.0,(t2.*t10)./2.0e+2,(t4.*t10)./2.0e+2,t7.*(-5.7e+1./2.0e+2)-sin(q2).*(4.0./2.5e+1),1.0],[4,4]);


%+========================================================================+
%|                                                                        |
%|            This script uses the GYPSILAB toolbox for Matlab            |
%|                                                                        |
%| COPYRIGHT : Matthieu Aussal, Marc Bakry (c) 2017-2019.                 |
%| PROPERTY  : Centre de Mathematiques Appliquees, Ecole polytechnique,   |
%| route de Saclay, 91128 Palaiseau, France. All rights reserved.         |
%| LICENCE   : This program is free software, distributed in the hope that|
%| it will be useful, but WITHOUT ANY WARRANTY. Natively, you can use,    |
%| redistribute and/or modify it under the terms of the GNU General Public|
%| License, as published by the Free Software Foundation (version 3 or    |
%| later,  http://www.gnu.org/licenses). For private use, dual licencing  |
%| is available, please contact us to activate a "pay for remove" option. |
%| CONTACT   : matthieu.aussal@polytechnique.edu                          |
%|             marc.bakry@polytechnique.edu                               |
%| WEBSITE   : www.cmap.polytechnique.fr/~aussal/gypsilab                 |
%|                                                                        |
%| Please acknowledge the gypsilab toolbox in programs or publications in |
%| which you use it.                                                      |
%|________________________________________________________________________|
%|   '&`   |                                                              |
%|    #    |   FILE       : nrtVibroSlab2d.m                              |
%|    #    |   VERSION    : 0.55                                          |
%|   _#_   |   AUTHOR(S)  : Matthieu Aussal & Marc Bakry                  |
%|  ( # )  |   CREATION   : 14.03.2019                                    |
%|  / 0 \  |   LAST MODIF :                                               |
%| ( === ) |   SYNOPSIS   :                                               |
%|  `---'  |                                                              |
%+========================================================================+

% Cleaning
clear all
close all
clc

% Gypsilab path
run('../../addpathGypsilab.m')

% Width of the slab
e = 0.5

% Frequency
f = 900:500:4000

% Incident direction (from bottom)
X0  = [0 1 0];

% Exterior domain (water)
rho0 = 1000;         % density      (kg.m3)
c0   = 1500;         % celerity     (m.s-1)
k0   = 2*pi/c0.*f;   % wave-number  (m-1)
lam0 = c0./f;        % wave-length  (m)

% Interior domain (different from water)
rhoS = 2*rho0;                                 % density                             (kg.m3)
cL   = 2*c0;                                   % celerity of longitudinal waves      (m.s-1)
kL   = 2*pi.*f./cL;                            % wave-number of longitudinal waves   (m-1)
lamL = real(cL)./f;                            % wavelength of longitudinal waves    (m)
cT   = 0;                                      % celerity of transverse waves        (m.s-1)
kT   = 2*pi.*f./cT;                            % wave-number of transverse waves     (m-1)
lamT = real(cT)./f;                            % wavelength of transverse waves      (m)

% Solution (pressure)
sol = zeros(2,length(f));

% Loop for each frequency
for i = 1:length(f)
    % Minimum wavelength
    tmp  = [lam0(i),lamL(i),lamT(i)];
    lmin = min(tmp(tmp>0));

    % Slab mesh
    L    = 20 * lmin;            % 20 wavelength to simulate infinite slab
    nx   = ceil(L/lmin * 6)+1;   % 6 node per wavelength for L
    ny   = ceil(e/lmin * 12)+1;  % 12 node per wavelength for e
    N    = nx * ny;              % Total number of nodes
    mesh = mshSquare(N,[L e])

    % Radiative mesh (fixed number of nodes)
    radiat = mshSquare(1e3,[L L]);

    % Boundary
    bound = swap(mesh.bnd)

    % Measurement points for trans and refl coeff (1 wavelenth from bound)
    Xmes = [0 -e/2-lmin 0 ; 0 e/2+lmin 0];

    % Cut-off function (50% full, 10% decrease)
    cutoff = vibsCutoff(1,L/5,L/10);

    % Green kernel function
    Gxy         = @(X,Y) femGreenKernel(X,Y,'[H0(kr)]',k0(i));
    gradyGxy{1} = @(X,Y) femGreenKernel(X,Y,'grady[H0(kr)]1',k0(i));
    gradyGxy{2} = @(X,Y) femGreenKernel(X,Y,'grady[H0(kr)]2',k0(i));
    gradyGxy{3} = @(X,Y) femGreenKernel(X,Y,'grady[H0(kr)]3',k0(i));

    % Plane wave function
    PW         = @(X) exp(1i*k0(i)*X*X0') .* cutoff(X);
    gradxPW{1} = @(X) 1i*k0(i)*X0(1) .* PW(X);
    gradxPW{2} = @(X) 1i*k0(i)*X0(2) .* PW(X);
    gradxPW{3} = @(X) 1i*k0(i)*X0(3) .* PW(X);

    % Coupling coeff for Brackage-Werner simulation
    beta = 1i*k0(i);

    % Graphical representation
    figure(1); clf;
    plot(radiat,real(PW(radiat.vtx)))
    hold on
    plot(mesh)
    plot(bound,'r')
    %     plotNrm(bound,'r')
    plot(msh(Xmes))
    axis equal
    colorbar
    title('Incident Wave')
    hold off

    % Quadrature and finite elements (volumn)
    omega = dom(mesh,3);
    U     = fem(mesh,'P1');

    % Quadrature and finite elements (boundary)
    sigma = dom(bound,3);
    u     = fem(bound,'P1');

    % Left-hand side
    tic
    [A,B,C,D] = vibsBlockOperator(omega,U,sigma,u,cL,cT,rhoS,c0,rho0,f(i));
    toc

    % Add dirichlet condition to x unknows (penalization)
    A(sub2ind(size(A),1:length(U),1:length(U))) = 1e15;

    % Right-hand side
    V    = cell(3,1);
    V{1} = - integral(sigma,ntimes(U,1),PW);
    V{2} = - integral(sigma,ntimes(U,2),PW);
    V{3} = integral(sigma,ntimes(u),gradxPW);

    % Resolution with Schur complement
    tic
    LHS    = [A B ; C D];
    RHS    = cell2mat(V);
    mu     = LHS \ RHS;
    mu     = mu(2*length(U)+1:end,:);
    lambda = beta*mu;
    toc

    % Measure of refexive and transmitted coeff
    tic
    Pmes = 1i/4 .* integral(Xmes,sigma,Gxy,u)*lambda - ...
        1i/4 .* integral(Xmes,sigma,gradyGxy,ntimes(u))*mu;
    Pmes(2) = Pmes(2) + PW(Xmes(2,:));
    toc

    % Save solution
    sol(:,i) = Pmes;

    % Finite element radiative operator --> \int_Sy G(x,y) psi(y) dy
    tic
    Srad = 1i/4 .* integral(radiat.vtx,sigma,Gxy,u);
    Srad = Srad - 1/(2*pi) .* regularize(radiat.vtx,sigma,'[log(r)]',u);

    % Finite element radiative operator --> \int_Sy dnyG(x,y) psi(y) dy
    Drad = 1i/4 .* integral(radiat.vtx,sigma,gradyGxy,ntimes(u));
    Drad = Drad - 1/(2*pi) .* regularize(radiat.vtx,sigma,'grady[log(r)]',ntimes(u));
    toc

    % Domain solution
    Psca = Srad*lambda - Drad*mu;
    Pinc = PW(radiat.vtx);
    Ptot = Psca + Pinc;

    % Graphical repesentation
    figure(10); clf;
    subplot(1,2,1)
    plot(bound)
    hold on
    plot(radiat,abs(Psca))
    plot(msh(Xmes),abs(Pmes))
    title('Scattered')
    axis equal
    colorbar
    hold off

    subplot(1,2,2)
    plot(bound)
    hold on
    plot(radiat,abs(Ptot))
    plot(msh(Xmes),abs(Pmes))
    title('Total')
    axis equal
    colorbar
    hold off
end

% Analytical solution
tic
c     = ones(length(f),1) * [c0 cL c0];
rho   = [rho0 rhoS rho0];
[R,T] = slabVibro(f,rho,c,e);
toc

% Comparison (db)
ref = 20*log10(abs([R ; T]));
sol = 20*log10(abs(sol));

norm(ref-sol)/norm(ref)

% Graphical representation
figure(100)
subplot(1,2,1)
plot(f,ref(1,:),'r',f,sol(1,:),'b+')
grid on
title('Reflexion coeffiscient')
legend({'Analytical','Numerical'})
xlabel('Frequency (Hz)')
ylabel('Amplitude (dB)')

subplot(1,2,2)
plot(f,ref(2,:),'r',f,sol(2,:),'b+')
grid on
title('Transmission coeffiscient')
legend({'Analytical','Numerical'})
xlabel('Frequency (Hz)')
ylabel('Amplitude (dB)')

disp('~~> Michto gypsilab !')


function  bdiff_bdepth(mycat)
    %  This routine etsimates the b-value of a curve automatically
    %  The b-valkue curve is differenciated and the point
    %  of maximum curvature marked. The b-value will be calculated
    %  using this point and the point half way toward the high
    %  magnitude end of the b-value curve.

    %  originally, "mycat" was "newcat"
    %  Stefan Wiemer 1/95
    %
    global cluscat mess bfig backcat magsteps_desc bvalsum3  bval aw bw t1 t2 t3 t4 dloop leg1 leg2
    global teb t0b cua  ew onesigma mrt bvalsumhold
    global gBdiff % contains b1, n1, b2, n2
    global mxlkbt lsbt ni
    ZG=ZmapGlobal.Data;

    report_this_filefun();

    bfig=findobj('Type','Figure','-and','Name','frequency-magnitude distribution');
    if ~isempty(bfig)
        if dloop == 2
            ZG.hold_state=true;
        end
    else
        bfig=figure_w_normalized_uicontrolunits(...                  %build figure for plot
            'Units','normalized','NumberTitle','off',...
            'Name','frequency-magnitude distribution',...
            'visible','off',...
            'pos',[ 0.300  0.3 0.4 0.6]);
        ZG.hold_state=false;

        uicontrol('Units','normal',...
            'Position',[.0 .85 .08 .06],'String','Info ',...
            'callback',@(~,~)infoz(1));
        uicontrol('Units','normal',...
            'Position',[.0 .45 .10 .06],'String','Manual ',...
            'callback',@(~,~)bfitnew(mycat));

        uicontrol('Units','normal',...
            'Position',[.0 .35 .10 .06],'String','RecTime ',...
            'callback',@callbackfun_003);

        uicontrol('Units','normal',...
            'Position',[.0 .25 .10 .06],'String','TimePlot ',...
            'callback',@cb_timeplot);

        uicontrol('Units','normal',...
            'Position',[.0 .65 .08 .06],'String','Save ',...
            'Callback',{@calSave9,magsteps_desc, bvalsum3});
    end

    maxmag = ceil(10*max(mycat.Magnitude))/10;
    mima = min(mycat.Magnitude);
    mima = min(mima, 0);

    % number of mag units
    nmagu = (maxmag*10)+1;

    [bval,xt2] = hist(mycat.Magnitude,(mima:0.1:maxmag));
    bvalsum = cumsum(bval); % N for M <=
    bval2 = bval(end:-1:1);
    bvalsum3 = cumsum(bval(end:-1:1));    % N for M >= (counted backwards)
    magsteps_desc = (maxmag:-0.1:mima);

    backg_ab = log10(bvalsum3);
    orient tall

    if ZG.hold_state
        axes(cua)
        disp("set(gca,'NextPlot','add')")
        set(gca,'NextPlot','add')
    else
        figure(bfig);delete(findobj(bfig,'Type','axes'));
        rect = [0.2,  0.3, 0.70, 0.6];           % plot Freq-Mag curves
        axes('position',rect);
    end

    pldepth =semilogy(magsteps_desc,bvalsum3,'sb');
    set(pldepth,'LineWidth',1.0,'MarkerSize',6,...
        'MarkerFaceColor','r','MarkerEdgeColor','b');
    set(gca,'NextPlot','add')
    difb = [0 diff(bvalsum3) ];

    % Marks the point of maximum curvature
    %
    i = find(difb == max(difb));
    i = max(i);
    te = semilogy(magsteps_desc(i),bvalsum3(i),'xk');
    set(te,'LineWidth',1.5,'MarkerSize',ms10)

    % Estimate the b-value
    %
    i2 = 1 ;
    te = semilogy(magsteps_desc(i2),difb(i2),'xk');
    set(te,'LineWidth',1.5,'MarkerSize',ms10)
    te = semilogy(magsteps_desc(i2),bvalsum3(i2),'xk');
    set(te,'LineWidth',1.5,'MarkerSize',ms10)

    xlabel('Magnitude','FontWeight','normal','FontSize',ZmapGlobal.Data.fontsz.s)
    ylabel('Cumulative Number','FontWeight','normal','FontSize',ZmapGlobal.Data.fontsz.s)
    %set(gca,'Color',color_bg)
    set(gca,'visible','on','FontSize',ZmapGlobal.Data.fontsz.s,'FontWeight','normal',...
        'FontWeight','normal','LineWidth',1.0,...
        'Box','on','Tag','cufi')

    cua = gca;

    M1b = [];
    M1b = [magsteps_desc(i) bvalsum3(i)];
    tt3=num2str(fix(100*M1b(1))/100);

    M2b = [];
    M2b =  [magsteps_desc(i2) bvalsum3(i2)];
    tt4=num2str(fix(100*M2b(1))/100);

    ll = magsteps_desc >= M1b(1)-0.05  & magsteps_desc <= M2b(1) +0.05;
    x = magsteps_desc(ll);

    l2 = mycat.Magnitude >= M1b(1)- 0.05  & mycat.Magnitude <= M2b(1)+ 0.05;
    [ bv, onesigma, av] = calc_bmemag(mycat.Magnitude(l2), 0.1) ;

    bv = -bv;

    pause(0.1)

    y = backg_ab(ll);
    [aw bw,  S, ew] = wls(x',y');
    p = [bw aw];
    %[p,S] = polyfit(x,y,1)                    % fit a line to background
    p2 = [bw+onesigma aw];
    p3 = [bw-onesigma aw];
    x2 = 1:0.1:6;
    f = polyval(p,x);
    f2 = polyval(p2,x);
    f3 = polyval(p3,x);
    [f4,delta] = polyval(p,x,S);
    Tr  = (teb-t0b)/(10.^ polyval(p,mrt));
    fprintf('Recurrence time Tr(M%g) = %g years\n', mrt, Tr);
    f = 10.^f;
    f2 = 10.^f2;
    f3 = 10.^f3;
    f4 = 10.^f4;
    delta = 10.^delta;
    set(gca,'NextPlot','add')
    ttm= semilogy(x,f,'r');                         % plot linear fit to backg
    set(ttm,'LineWidth',1)
    ttm= semilogy(x,f2,'k');                         % plot linear fit to backg
    set(ttm,'LineWidth',1)
    ttm= semilogy(x,f3,'k');                         % plot linear fit to backg
    set(ttm,'LineWidth',1)
    ttm= semilogy(x,f4-delta,'k-.');                         % plot linear fit to backg
    set(ttm,'LineWidth',1)
    ttm= semilogy(x,f4+delta,'k-.');
    set(ttm,'LineWidth',1)
    set(gca,'XLim',[min(mycat.Magnitude)-0.5  max(mycat.Magnitude)+0.5])
    set(gca,'YLim',[1 (mycat.Count+20)*1.4]);

    r = corrcoef(x,y);
    r = r(1,2);
    %std_backg = std(y - polyval(p,x));      % standard deviation of fit
    std_backg = ew;      % standard deviation of fit

    p=-p(1,1);
    p=fix(100*p)/100;
    std_backg=fix(100*std_backg)/100;
    tt1=num2str(bw,3);
    tt2=num2str(std_backg);
    tt4=num2str(bv,3);
    tt5=num2str(onesigma,2);

    rect=[0 0 1 1];
    h2=axes('position',rect);
    set(h2,'visible','off');

    %if ZG.hold_state
    ge_symbol = char(8805);
    if dloop == 2
        set(pldepth,'LineWidth',1.0,'MarkerSize',6,...
            'MarkerFaceColor','y','MarkerEdgeColor','g','Marker','o');
        set(cua,'Ylim',[ 1   ni ] );

        txt1=text(.10, .08,['Bottom Zone b-value (w LS, M  ', ge_symbol, ' ', num2str(M1b(1)) '): ',tt1, ' +/- ', tt2 ',a-value = ' , num2str(aw) ]);
        set(txt1,'FontWeight','normal','FontSize',ZmapGlobal.Data.fontsz.s,'Color','r')
        txt1=text(.10, .04,['Bottom Zone b-value (max lik, M ', ge_symbol, ' ', num2str(min(mycat.Magnitude)) '): ',tt4, ' +/- ', tt5,',a-value = ' , num2str(av)]);
        set(txt1,'FontWeight','normal','FontSize',ZmapGlobal.Data.fontsz.s, 'Color', 'r')
        lsbb = bw; mxlkbb = bv;

        lsb = lsbt/lsbb; mxlkb = mxlkbt/mxlkbb;
        slsb = num2str(lsb);
        smxlkb = num2str(mxlkb);
        txt3 = text(.25, .94,['LS b ratio = ', slsb,'           max lik b ratio = ',smxlkb]);
        set(txt3,'FontWeight','normal','FontSize',ZmapGlobal.Data.fontsz.s,'Color','b')
        %  leg(2)=pldepth
    else
        txt1=text(.10, .18,['Top Zone b-value (w LS, M  ', ge_symbol, ' ', num2str(M1b(1)) '): ',tt1, ' +/- ', tt2, ',a-value = ' , num2str(aw) ]);
        set(txt1,'FontWeight','normal','FontSize',ZmapGlobal.Data.fontsz.s)
        txt1=text(.10, .14,['Top Zone b-value (max lik, M ', ge_symbol, ' ', num2str(min(mycat.Magnitude)) '): ',tt4, ' +/- ', tt5,',a-value = ' , num2str(av)]);
        set(txt1,'FontWeight','normal','FontSize',ZmapGlobal.Data.fontsz.s)
        set(gcf,'PaperPosition',[0.5 0.5 4.0 5.5])
        lsbt = bw; mxlkbt = bv;
    end

    if dloop == 1
        leg1 = pldepth;
    end
    if dloop == 2
        leg2 = pldepth;
        legend([leg1,leg2],'Top depth zone','Bottom depth zone');
    end
    set(gcf,'visible','on');

    if ZG.hold_state
        % calculate the probability that the two distributions are different
        l = mycat.Magnitude >=  M1b(1);
        gBdiff.b2 = str2double(tt1); gBdiff.n2 = M1b(2);
        n = gBdiff.n1+gBdiff.n2;
        da = -2*n*log(n) + 2*gBdiff.n1*log(gBdiff.n1+gBdiff.n2*gBdiff.b1/gBdiff.b2) + 2*gBdiff.n2*log(gBdiff.n1*gBdiff.b2/gBdiff.b1+gBdiff.n2) -2;
        pr = exp(-da/2-2);
        fprintf('Probability: %g\n', pr);
        txt1=text(.60, .75,['p=  ', num2str(pr,2)],'Units','normalized');
        set(txt1,'FontWeight','normal','FontSize',ZmapGlobal.Data.fontsz.s)
        txt1=text(.60, .70, sprintf('gBdiff.n1: %g, gBdiff.n2: %g, gBdiff.b1: %g, gBdiff.b2: %g', ...
            gBdiff.n1, gBdiff.n2, gBdiff.b1, gBdiff.b2));
        set(txt1,'FontSize',8,'Units','normalized')
    else
        gBdiff.b1 = str2double(tt1); gBdiff.n1 = M1b(2);
    end

    bvalsumhold = bvalsum3;
    da = 10^(aw+bw*6.5);
    db = 10^(aw+bw*6.5)*(-6.5);
    dp = sqrt(da^2*ew^2+db^2*0.05^2);
    dr = 1/dp;

    set(gca,'NextPlot','replace');

    function callbackfun_003(mysrc,myevt)

        callback_tracker(mysrc,myevt,mfilename('fullpath'));
        est_recurrence_time_prob(mhcat, onesigma, aw, bw);
    end

    function cb_timeplot(mysrc,myevt)
        callback_tracker(mysrc,myevt,mfilename('fullpath'));
        ZG=ZmapGlobal.Data;
        ZG.newt2 = mycat;
        ctp=CumTimePlot(mycat);
        ctp.plot();
    end
end


function [M,Q]=community_louvain(W,gamma,M0,B)
%COMMUNITY_LOUVAIN     Optimal community structure
%
%   M     = community_louvain(W);
%   [M,Q] = community_louvain(W,gamma);
%   [M,Q] = community_louvain(W,gamma,M0);
%   [M,Q] = community_louvain(W,gamma,M0,'potts');
%   [M,Q] = community_louvain(W,gamma,M0,'negative_asym');
%   [M,Q] = community_louvain(W,[],[],B);
%
%   The optimal community structure is a subdivision of the network into
%   nonoverlapping groups of nodes which maximizes the number of within-
%	group edges, and minimizes the number of between-group edges.
%
%   This function is a fast and accurate multi-iterative generalization of
%   the Louvain community detection algorithm. This function subsumes and
%   improves upon,
%		modularity_louvain_und.m, modularity_finetune_und.m,
%		modularity_louvain_dir.m, modularity_finetune_dir.m,
%       modularity_louvain_und_sign.m
%	and additionally allows to optimize other objective functions (includes
%	built-in Potts-model Hamiltonian, allows for custom objective-function
%	matrices).
%
%   Inputs:
%       W,
%           directed/undirected weighted/binary connection matrix with
%           positive and possibly negative weights.
%       gamma,
%           resolution parameter (optional)
%               gamma>1,        detects smaller modules
%               0<=gamma<1,     detects larger modules
%               gamma=1,        classic modularity (default)
%       M0,
%           initial community affiliation vector (optional)
%       B,
%           objective-function type or custom objective matrix (optional)
%           'modularity',       modularity (default)
%           'potts',            Potts-model Hamiltonian (for binary networks)
%           'negative_sym',     symmetric treatment of negative weights
%           'negative_asym',    asymmetric treatment of negative weights
%           B,                  custom objective-function matrix
%
%           Note: see Rubinov and Sporns (2011) for a discussion of
%           symmetric vs. asymmetric treatment of negative weights.
%
%   Outputs:
%       M,
%           community affiliation vector
%       Q,
%           optimized community-structure statistic (modularity by default)
%
%   Example:
%       % Iterative community finetuning.
%       % W is the input connection matrix.
%       n  = size(W,1);             % number of nodes
%       M  = 1:n;                   % initial community affiliations
%       Q0 = -1; Q1 = 0;            % initialize modularity values
%       while Q1-Q0>1e-5;           % while modularity increases
%           Q0 = Q1;                % perform community detection
%           [M, Q1] = community_louvain(W, [], M);
%       end
%
%   References:
%       Blondel et al. (2008)  J. Stat. Mech. P10008.
%       Reichardt and Bornholdt (2006) Phys. Rev. E 74, 016110.
%       Ronhovde and Nussinov (2008) Phys. Rev. E 80, 016109
%       Sun et al. (2008) Europhysics Lett 86, 28004.
%       Rubinov and Sporns (2011) Neuroimage 56:2068-79.
%
%   Mika Rubinov, U Cambridge 2015-2016

%   Modification history
%   2015: Original
%   2016: Included generalization for negative weights.
%         Enforced binary network input for Potts-model Hamiltonian.
%         Streamlined code and expanded documentation.

W=double(W);                                % convert to double format
n=length(W);                                % get number of nodes
s=sum(sum(W));                              % get sum of edges

if ~exist('B','var') || isempty(B)
    type_B = 'modularity';
elseif ischar(B)
    type_B = B;
else
    type_B = 0;
    if exist('gamma','var') && ~isempty(gamma)
        warning('Value of gamma is ignored in generalized mode.')
    end
end
if ~exist('gamma','var') || isempty(gamma)
    gamma = 1;
end

if strcmp(type_B,'negative_sym') || strcmp(type_B,'negative_asym')
    W0 = W.*(W>0);                          %positive weights matrix
    s0 = sum(sum(W0));                      %weight of positive links
    B0 = W0-gamma*(sum(W0,2)*sum(W0,1))/s0; %positive modularity

    W1 =-W.*(W<0);                          %negative weights matrix
    s1 = sum(sum(W1));                      %weight of negative links
    if s1                                   %negative modularity
        B1 = W1-gamma*(sum(W1,2)*sum(W1,1))/s1;
    else
        B1 = 0;
    end
elseif min(min(W))<-1e-10
    err_string = [
        'The input connection matrix contains negative weights.\nSpecify ' ...
        '''negative_sym'' or ''negative_asym'' objective-function types.'];
    error(sprintf(err_string))              %#ok<SPERR>
end
if strcmp(type_B,'potts') && any(any(W ~= logical(W)))
    error('Potts-model Hamiltonian requires a binary W.')
end

if type_B
    switch type_B
        case 'modularity';      B = (W-gamma*(sum(W,2)*sum(W,1))/s)/s;
        case 'potts';           B =  W-gamma*(~W);
        case 'negative_sym';    B = B0/(s0+s1) - B1/(s0+s1);
        case 'negative_asym';   B = B0/s0      - B1/(s0+s1);
        otherwise;              error('Unknown objective function.');
    end
else                            % custom objective function matrix as input
    B = double(B);
    if ~isequal(size(W),size(B))
        error('W and B must have the same size.')
    end
end
if ~exist('M0','var') || isempty(M0)
    M0=1:n;
elseif numel(M0)~=n
    error('M0 must contain n elements.')
end

[~,~,Mb] = unique(M0);
M = Mb;

B = (B+B.')/2;                                          % symmetrize modularity matrix
Hnm=zeros(n,n);                                         % node-to-module degree
for m=1:max(Mb)                                         % loop over modules
    Hnm(:,m)=sum(B(:,Mb==m),2);
end

Q0 = -inf;
Q = sum(B(bsxfun(@eq,M0,M0.')));                        % compute modularity
first_iteration = true;
while Q-Q0>1e-10
    flag = true;                                        % flag for within-hierarchy search
    while flag;
        flag = false;
        for u=randperm(n)                               % loop over all nodes in random order
            ma = Mb(u);                                 % current module of u
            dQ = Hnm(u,:) - Hnm(u,ma) + B(u,u);
            dQ(ma) = 0;                                 % (line above) algorithm condition

            [max_dQ,mb] = max(dQ);                      % maximal increase in modularity and corresponding module
            if max_dQ>1e-10;                            % if maximal increase is positive
                flag = true;
                Mb(u) = mb;                             % reassign module

                Hnm(:,mb) = Hnm(:,mb)+B(:,u);           % change node-to-module strengths
                Hnm(:,ma) = Hnm(:,ma)-B(:,u);
            end
        end
    end
    [~,~,Mb] = unique(Mb);                              % new module assignments

    M0 = M;
    if first_iteration
        M=Mb;
        first_iteration=false;
    else
        for u=1:n                                       % loop through initial module assignments
            M(M0==u)=Mb(u);                             % assign new modules
        end
    end

    n=max(Mb);                                          % new number of modules
    B1=zeros(n);                                        % new weighted matrix
    for u=1:n
        for v=u:n
            bm=sum(sum(B(Mb==u,Mb==v)));                % pool weights of nodes in same module
            B1(u,v)=bm;
            B1(v,u)=bm;
        end
    end
    B=B1;

    Mb=1:n;                                             % initial module assignments
    Hnm=B;                                              % node-to-module strength

    Q0=Q;
    Q=trace(B);                                         % compute modularity
end


function f=comp_iwpfbt(c,wtNodes,pOutIdxs,chOutIdxs,Ls,ext,interscaling)
%COMP_IWFBT Compute Inverse Wavelet Packet Filter-Bank Tree
%   Usage:  f=comp_iwpfbt(c,wtNodes,pOutIdxs,chOutIdxs,Ls,ext)
%
%   Input parameters:
%         c          : Coefficients stored in cell array.
%         wtNodes    : Filterbank tree nodes (elementary filterbans) in
%                      reverse BF order. Cell array of structures of length *nodeNo*.
%         pOutIdxs   : Idx of each node's parent. Array of length *nodeNo*.
%         chOutIdxs  : Idxs of each node children. Cell array of vectors of
%                      length *nodeNo*.
%         ext        : Type of the forward transform boundary handling.
%
%   Output parameters:
%         f          : Reconstructed data in L*W array.
%

% Do non-expansve transform if ext=='per'
doPer = strcmp(ext,'per');

interscalingfac = 1;
if strcmp('intscale',interscaling)
    interscalingfac = 1/2;
elseif strcmp('intsqrt',interscaling)
    interscalingfac = 1/sqrt(2);
end

% For each node in tree in the BF order...
 for jj=1:length(wtNodes)
    % Node filters to a cell array
    %gCell = cellfun(@(gEl)conj(flipud(gEl.h(:))),wtNodes{jj}.g(:),'UniformOutput',0);
    gCell = cellfun(@(gEl)gEl.h(:),wtNodes{jj}.g(:),'UniformOutput',0);
    % Node filters subs. factors
    a = wtNodes{jj}.a;
    % Node filters initial skips
    if(doPer)
       %offset = cellfun(@(gEl) 1-numel(gEl.h)-gEl.offset,wtNodes{jj}.g);
       offset = cellfun(@(gEl) gEl.offset,wtNodes{jj}.g);
    else
       offset = -(a-1);
    end

    if(pOutIdxs(jj))
       % Run filterbank and add to the existing subband.
       ctmp = comp_ifilterbank_td(c(chOutIdxs{jj}),gCell,a,size(c{pOutIdxs(jj)},1),offset,ext);
       c{pOutIdxs(jj)} = c{pOutIdxs(jj)}+ctmp;

       c{pOutIdxs(jj)} = interscalingfac*c{pOutIdxs(jj)};

    else
       % We are at the root.
       f = comp_ifilterbank_td(c(chOutIdxs{jj}),gCell,a,Ls,offset,ext);
    end
 end


function [varargout]=regionTriMesh3D(varargin)

% function [F,V,boundaryInd]=regionTriMesh3D(regionCell,pointSpacing,resampleCurveOpt,interpMethod)
% ------------------------------------------------------------------------
% This function creates a 3D triangulation for the region specified in the
% variable regionCell. The mesh aims to obtain a point spacing as defined
% by the input pointSpacing.
% The function output contains the triangular faces in F, the vertices in V
% and the per triangle region indices in regionInd. By setting plotOn to 0
% or 1 plotting can be switched on or off.
%
% More on the specification of the region:
% The input variable regionCell is a cell array containing all the boundary
% curves, e.g. for a two curve region 1 we would have something like
% regionSpec{1}={V1,V2} where V1 and V2 are the boundary curves. Multiple
% curves may be given here. The first curve should form the outer boundary
% of the entire region, the curves that follow should define holes inside
% this boundary and the space inside them is therefore not meshed.
%
% See also: regionTriMesh2D
%
% Kevin Mattheus Moerman
% gibbon.toolbox@gmail.com
%
% 2013/11/21: Created
% 2013/11/21: Added varargin input parsing
%------------------------------------------------------------------------

%% Parse input

switch nargin
    case 1
        regionCell=varargin{1};
        pointSpacing=[];
        resampleCurveOpt=[];
        interpMethod=[];
    case 2
        regionCell=varargin{1};
        pointSpacing=varargin{2};
        resampleCurveOpt=[];
        interpMethod=[];
    case 3
        regionCell=varargin{1};
        pointSpacing=varargin{2};
        resampleCurveOpt=varargin{3};
        interpMethod=[];
    case 4
        regionCell=varargin{1};
        pointSpacing=varargin{2};
        resampleCurveOpt=varargin{3};
        interpMethod=varargin{4};
end

if isempty(pointSpacing)
    D=zeros(1,numel(regionCell));
    for q=1:1:numel(regionCell)
        D(q)=mean(diff(polyCurveLength(regionCell{1})));
    end
    pointSpacing=mean(D);
end

if isempty(resampleCurveOpt)
    resampleCurveOpt=0;
end

if isempty(interpMethod)
    interpMethod='natural';
end

%% Parse 3D regions and convert to planar 2D

% TO DO: get sizes and do it properly, hint cellfun(@(x) size(x,1),regionCell)
npSets=cellfun(@(x) size(x,1),regionCell);
npTotal=sum(npSets);

%Collect all points
Vt=zeros(npTotal,3);
startInd=1;
endInd=npSets(1);
for qCurve=1:1:numel(regionCell)
    Vs=regionCell{qCurve};
    Vt(startInd:endInd,:)=Vs;
    startInd=startInd+npSets(qCurve);
    if qCurve<numel(regionCell)
        endInd=startInd+npSets(qCurve+1)-1;
    end
end

Vt_mean=mean(Vt,1);
Vtc=Vt-Vt_mean(ones(size(Vt,1),1),:);

%Get orientation
[R_fit]=pointSetPrincipalDir(Vtc);

%Create planar 2D sets
Vtcr=Vt;
startInd=1;
endInd=npSets(1);
regionCell2D=regionCell;
for qCurve=1:1:numel(regionCell)
    Vs=Vt(startInd:endInd,:);
    Vs=Vs-Vt_mean(ones(size(Vs,1),1),:);
    Vs=(R_fit'*Vs')';
    regionCell2D{qCurve}=Vs(:,[1 2]);
    Vtcr(startInd:endInd,:)=Vs;
    startInd=startInd+npSets(qCurve);
    if qCurve<numel(regionCell)
        endInd=startInd+npSets(qCurve+1)-1;
    end
end

%% Use regionTriMesh2D to mesh region in 2D

[F,V,boundaryInd]=regionTriMesh2D(regionCell2D,pointSpacing,resampleCurveOpt,0);

%% Interpolate to obtain Z coordinates

interpFunc = scatteredInterpolant(Vtcr(:,[1 2]),Vtcr(:,3),interpMethod);
V(:,3)=interpFunc(V(:,[1 2]));
V=(R_fit*V')';
V=V+Vt_mean(ones(size(V,1),1),:);

%% Check normal directions against input curve(s)

% V_test=regionCell{1};
% V_test=V_test(1:2,:);

% [~,e]=minDist(V_test,V);
% E=patchEdges(F,1);
% if ~any(E(:,1)==e(1) & E(:,2)==e(2))
%    F=fliplr(F); %Invert if edge does not seem member of faces
% end

%% Collect ouput
varargout{1}=F;
varargout{2}=V;
varargout{3}=boundaryInd;

%%
% _*GIBBON footer text*_
%
% License: <https://github.com/gibbonCode/GIBBON/blob/master/LICENSE>
%
% GIBBON: The Geometry and Image-based Bioengineering add-On. A toolbox for
% image segmentation, image-based modeling, meshing, and finite element
% analysis.
%
% Copyright (C) 2006-2022 Kevin Mattheus Moerman and the GIBBON contributors
%
% 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/>.


function [au] = ft2au(ft)
% Convert length from feet to astronomical units.
% Chad A. Greene 2012
au = ft*2.03746215499e-12;