classdef prtFeatSelLlnn < prtFeatSel
    % prtFeatSelLLnn  Local Learning based feature selection
    %
    %   FEATSEL = prtFeatSelLlnn returns a local learning based feature selection
    %   object.
    %
    %    FEATSEL = prtFeatSelLlnn(PROPERTY1, VALUE1, ...) constructs a
    %    prttFeatSelExhaustive object FEATSEL with properties as specified by
    %    PROPERTY/VALUE pair
    %
    %    A prtFeatSelExhaustive object has the following properties:
    %
    %    selectedFeatures       - The indices of the features selected,
    %                             a read-only parameter, found by training.
    %    verbosePlot            - Toggles plotting on/off during training
    %    nMaxIterations         - The maximum number of iterations
    %    normalizedWeightCutOff - The weight threshold for keeping a feature
    %
    %    The following features are settable, and are related to the
    %    training algorithm. Please see reference for further information.
    %
    %    kernelSigma
    %    sparsnessLambda
    %    vGradNMaxSteps
    %    vGradInitStepSize
    %    vGradChangeThreshold
    %    vGradNMaxStepSizeChanges
    %    weightChangeThreshold
    %
    %   Reference:
    %   http://www.computer.org/portal/web/csdl/doi/10.1109/TPAMI.2009.190
    %
    %   A prtFeatSelExhaustive object inherits the TRAIN and RUN methods
    %   from prtClass.
    %
    %   Example:
    %
    %   dataSet = prtDataGenSpiral;   % Create a 2 dimensional data set
    %   nNoiseFeatures = 100;      % Append 100 irrelevant features
    %   dataSet = prtDataSetClass(cat(2,dataSet.getObservations,randn([dataSet.nObservations, nNoiseFeatures])), dataSet.getTargets);
    %   featSel = prtFeatSelLlnn('verbosePlot',true);  % Create the feature
    %                                                  % selection object.
    %   featSel.nMaxIterations = 10;                   % Set the max # of
    %                                                  % iterations.
    %   featSel = featSel.train(dataSet);              % Train
    %
    %   See Also:  prtFeatSelStatic, prtFeatSelSfs, prtFeatSelExhaustive

    properties (SetAccess=private)
        % Required by prtAction
        name = 'Local Learning Nearest Neighbor'
        nameAbbreviation = 'LLNN'
    end

    properties

        kernelSigma = 1;
        sparsnessLambda = 2;
        vGradNMaxSteps = 100;
        vGradInitStepSize = 1;
        vGradChangeThreshold = 1e-4;
        vGradNMaxStepSizeChanges = 12;
        weightChangeThreshold = 0.01;
        nMaxIterations = 25;         % The maximum number of iterations
        normalizedWeightCutOff = 0.05;  % The weight threshold to include a feature.

        % Learned
        weights = [] ;           % The weights of each feature
        selectedFeatures = [];   % The selected features

        verbosePlot = false;     % Toggles plotting on/off during training
    end

    methods

        % Constructor %%
        function Obj = prtFeatSelLlnn(varargin)

            % Allow for string, value pairs
            Obj = prtUtilAssignStringValuePairs(Obj,varargin{:});
        end
    end

    methods (Access=protected,Hidden=true)

        % Train %%
        function Obj = trainAction(Obj,DS)

            % Remove stuff from data set, too many calls to getObservations
            X = DS.getObservations();
            Y = DS.getTargetsClassInd();

            vExpDistanceFunction = @(v,zBar)exp(-zBar*(v.^2));

            vFitnessFunction = @(v,cExpDistance)sum(log(1+cExpDistance)) + Obj.sparsnessLambda*sum(v.^2);

            w = ones(DS.nFeatures,1);
            wOld = w;
            wChanges = nan(Obj.nMaxIterations,1);
            for iter = 1:Obj.nMaxIterations

                % Find zBar
                % Eq: 3-5
                %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

                cSigma = Obj.kernelSigma*sqrt(sum((w./max(w))>Obj.normalizedWeightCutOff)); % Modify kernel to the "dimensionality" imposed by w

                zBar = zeros(DS.nObservations, DS.nFeatures);
                for iSamp = 1:DS.nObservations

                    % L1 Distance from this point in each dim
                    cD = abs(bsxfun(@minus,X(iSamp,:),X));
                    cD(iSamp,:) = inf;

                    % Label of this point
                    cY = Y(iSamp);

                    % Kernel mapped distance to this point
                    cK = exp(-sum(bsxfun(@times,cD,w(:)'),2)/cSigma); % Hard coded L1 Distance

                    % Calculate the prob of nearest miss and nearst hit
                    % Eqs: 4, 5
                    cKMiss = cK;
                    cKMiss(Y==cY) = 0; % Cant be a miss if you are the same type
                    cKMiss(iSamp) = 0; % Cant be your own miss
                    cKMiss = cKMiss./sum(cKMiss);

                    cKHit = cK;
                    cKHit(Y~=cY) = 0; % Cant be a hit if you are a different type
                    cKHit(iSamp) = 0; % Cant be your own hit
                    cKHit = cKHit./sum(cKHit);

                    % Eq: 3
                    cD(iSamp,:) = 0; % inf*0 = nan
                    zBar(iSamp,:) = sum(bsxfun(@times,cD, cKMiss),1) - sum(bsxfun(@times,cD, cKHit),1);

                end
                %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

                % Optimize v
                % Eqs: 9, 10
                %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                v = sqrt(w);

                cExpDistance = vExpDistanceFunction(v,zBar);
                vScore = vFitnessFunction(v,cExpDistance); % Eq: 9

                vScoreOld = vScore;
                for iStep = 1:Obj.vGradNMaxSteps
                    cStepSize = Obj.vGradInitStepSize*2; % we multiply by 2 since we divide by 2 at every iteration (even the first)

                    % Transform cExpDistance into necessary term for the
                    % gradient, we use the same name... just because
                    cExpDistance = cExpDistance./(1 + cExpDistance);
                    cExpDistance(isnan(cExpDistance)) = 0; % inf/(inf + 1)

                    % Eq: 10
                    cChange = Obj.sparsnessLambda*ones(size(w)) - sum(bsxfun(@times,cExpDistance, zBar),1)';

                    for iStepSize = 1:Obj.vGradNMaxStepSizeChanges
                        cStepSize = cStepSize / 2; % Lower the step size, we get here if 1) first iteration (we multiplied the step size by 2) or 2) step size was too big so we need to shrink it.

                        vNew = v - cStepSize*cChange.*v; % Eq: 10

                        cExpDistance = vExpDistanceFunction(vNew,zBar);

                        vNewScore = vFitnessFunction(vNew,cExpDistance);

                        if vNewScore < vScore
                            vScore = vNewScore;
                            v = vNew;
                            % Note that cExpDistance will be reused but
                            % immediately over written with its alter ego
                            % this saves a little mem I guess
                            break
                        else
                            % We increased the fitness (bad) so the step
                            % size must be too big.
                            % Continue in the loop decrease the step size
                            % by 50%.
                        end
                    end

                    if abs(vScore-vScoreOld)/mean([vScore vScoreOld]) < Obj.vGradChangeThreshold
                        break
                    else
                        vScoreOld = vScore;
                    end
                end
                %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

                w = v.^2;

                cWChange = norm(abs(w-wOld));

                %%% Other ideas for exit criterion %%%
                % cWChange = norm(abs(w-wOld))/sqrt(length(w));
                % cWChange = mean(abs(w-wOld)./mean(cat(2,w,wOld),2)); % Average percent change
                % wNorm = w ./ max(w);
                % wOldNorm = wOld ./ max(wOld);
                % cWChange = mean(abs(wNorm-wOldNorm)./mean(cat(2,wNorm,wOldNorm),2)); % Normalized Average percent change
                % cWChange = mean(abs(wNorm-wOldNorm)); % Normalized Average change

                if Obj.verbosePlot
                    subplot(2,1,1)
                    stem(w./max(w));
                    title('Feature Importance','FontSize',14)
                    xlabel('Feature')
                    ylabel('Normalized Feature Weight');
                    xlim([1 length(w)]);

                    subplot(2,1,2)
                    wChanges(iter) = cWChange;
                    plot(1:iter,wChanges(1:iter),'b-',1:iter,wChanges(1:iter),'rx')
                    title('Optimization Exit Criterion','FontSize',14)
                    xlabel('Iteration')
                    ylabel('Weight Change From Last Iteration')
                    xlim([0.5 iter+0.5]);
                    set(gca,'XTick',1:iter);

                    drawnow;
                end

                if cWChange < Obj.weightChangeThreshold
                    break
                end
                wOld =w;

            end

            Obj.weights = w;
            Obj.selectedFeatures = find(w > Obj.normalizedWeightCutOff);
        end

        % Run %
        function DataSet = runAction(Obj,DataSet)
            DataSet = DataSet.retainFeatures(Obj.selectedFeatures);
        end
    end
end


function [b,c,d,x,y,z,qfac] = vox2rasToQform(vox2ras)
% [a,b,c,x,y,z,qfac] = vox2rasToQform(vox2ras)
%
% Converts a vox2ras matrix to NIFTI qform parameters.
% Note: the vox2ras should be 6 DOF. This code mostly just
% follows CH's mriToNiftiQform() in mriio.c.
%
%  hdr.pixdim(1) = qfac;
%  hdr.quatern_b = b;
%  hdr.quatern_c = c;
%  hdr.quatern_d = d;
%  hdr.qoffset_x = x;
%  hdr.qoffset_y = y;
%  hdr.qoffset_z = z;
%  hdr.qform_code = NIFTI_XFORM_SCANNER_ANAT=1;
%

%
% vox2rasToQform.m
%
% Original Author: Doug Greve
% CVS Revision Info:
%    $Author: nicks $
%    $Date: 2011/03/02 00:04:13 $
%    $Revision: 1.3 $
%
% Copyright © 2011 The General Hospital Corporation (Boston, MA) "MGH"
%
% Terms and conditions for use, reproduction, distribution and contribution
% are found in the 'FreeSurfer Software License Agreement' contained
% in the file 'LICENSE' found in the FreeSurfer distribution, and here:
%
% https://surfer.nmr.mgh.harvard.edu/fswiki/FreeSurferSoftwareLicense
%
% Reporting: freesurfer@nmr.mgh.harvard.edu
%

a = [];
if(nargin ~= 1)
  fprintf('[a,b,c,x,y,z,qfac] = vox2rasToQform(vox2ras)\n');
  return;
end

x = vox2ras(1,4);
y = vox2ras(2,4);
z = vox2ras(3,4);

d = sqrt(sum(vox2ras(:,1:3).^2));
Mdc = vox2ras(1:3,1:3) ./ repmat(d,[3 1]);
if(det(Mdc) == 0.0)
  fprintf('ERROR: vox2ras determinant is 0\n');
  return;
end

r11 = Mdc(1,1);
r21 = Mdc(2,1);
r31 = Mdc(3,1);
r12 = Mdc(1,2);
r22 = Mdc(2,2);
r32 = Mdc(3,2);
r13 = Mdc(1,3);
r23 = Mdc(2,3);
r33 = Mdc(3,3);

if(det(Mdc) > 0.0) qfac = 1.0;
else
  r13 = -r13;
  r23 = -r23;
  r33 = -r33;
  qfac = -1.0;
end

%  /* following mat44_to_quatern() */

a = r11 + r22 + r33 + 1.0;
if(a > 0.5)
  a = 0.5 * sqrt(a);
  b = 0.25 * (r32-r23) / a;
  c = 0.25 * (r13-r31) / a;
  d = 0.25 * (r21-r12) / a;
else
  xd = 1.0 + r11 - (r22+r33);
  yd = 1.0 + r22 - (r11+r33);
  zd = 1.0 + r33 - (r11+r22);
  if(xd > 1.0)
    b = 0.5 * sqrt(xd);
    c = 0.25 * (r12+r21) / b;
    d = 0.25 * (r13+r31) / b;
    a = 0.25 * (r32-r23) / b;
  elseif( yd > 1.0 )
    c = 0.5 * sqrt(yd);
    b = 0.25 * (r12+r21) / c;
    d = 0.25 * (r23+r32) / c;
    a = 0.25 * (r13-r31) / c;
  else
    d = 0.5 * sqrt(zd);
    b = 0.25 * (r13+r31) / d;
    c = 0.25 * (r23+r32) / d;
    a = 0.25 * (r21-r12) / d;
  end
  if(a < 0.0)
    a = -a;
    b = -b;
    c = -c;
    d = -d;
  end
end

return


classdef BCEIBEA < ALGORITHM
% <multi/many> <real/integer/label/binary/permutation>
% Bi-criterion evolution based IBEA
% kappa --- 0.05 --- Fitness scaling factor

%------------------------------- Reference --------------------------------
% M. Li, S. Yang, and X. Liu, Pareto or non-Pareto: Bi-criterion evolution
% in multiobjective optimization, IEEE Transactions on Evolutionary
% Computation, 2016, 20(5): 645-665.
%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    methods
        function main(Algorithm,Problem)
            %% Parameter setting
            kappa = Algorithm.ParameterSet(0.05);

            %% Generate random population
            NPC      = Problem.Initialization();
            [PC,nND] = PCSelection(NPC,Problem.N);

            %% Optimization
            while Algorithm.NotTerminated(PC)
                % PC evolving
                NewPC = Exploration(Problem,PC,NPC,nND,Problem.N);
                % NPC selection
                NPC = EnvironmentalSelection([NPC,NewPC],Problem.N,kappa);
                % NPC evolving
                MatingPool = TournamentSelection(2,Problem.N,-CalFitness(NPC.objs,kappa));
                NewNPC     = OperatorGA(Problem,NPC(MatingPool));
                NPC        = EnvironmentalSelection([NPC,NewNPC],Problem.N,kappa);
                % PC selection
                [PC,nND] = PCSelection([PC,NewNPC,NewPC],Problem.N);
            end
        end
    end
end


function [val,vec,info] = syevd(jobz,uplo,a)
%SYEV   Computing eigen information.
%   [VAL,VEC,INFO] = SYEVD(JOBZ,UPLO,A) computes eigenvalues and,
%	optionally, eigenvectors of a symmetric matrix A.
%
%	JOBZ allows the user to choose if eigenvectors are to be computed.
%	JOBZ
%          = 'N':  Compute eigenvalues only;
%          = 'V':  Compute eigenvalues and eigenvectors.
%
%	UPLO allows the user to choose which part of the matrix will be referenced.
%	UPLO
%          = 'U':  Upper triangle of A is stored;
%          = 'L':  Lower triangle of A is stored.
%
%   If only eigenvalues are desired, the QR algorithm is used.
%
%	No input parameter are optional. If you want an easy to use interface,
%	see SYEV_DRIVER.

    vec = [];
	val = [];
	info = [];

	if (nargin~=3),
		disp('Wrong number of input parameters.');
		return;
	end;

	    %Do all the boring checking
	if (~isnumeric(a)),
		disp('The matrix is not composed of numeric values.');
		return;
	elseif (isinteger(a)),
		a=double(a);
	end;

    if (size(a,1)~=size(a,2)),
        disp('The matrix must be square.');
        return;
	end;
	n=int32(size(a,1));
	lda=int32(n);

	if (isComplex(a)),
		if (isDouble(a))

			w=zeros(double(n),1);
			work=complex(zeros(1));
			rwork=zeros(1,1);
			iwork=int32(zeros(1,1));
			lrwork=int32(-1);
			liwork=int32(-1);
			lwork=int32(-1);
			info=int32(-1);
			[jobz, uplo, n, vec, lda, val, work, lwork, rwork,lrwork, iwork, liwork, info]=lapack_zheevd(jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork, info);
			lwork=int32(work(1));
			liwork=int32(iwork(1));
			lrwork=int32(rwork(1));

			work=complex(zeros(double(lwork),1));
			iwork=int32(zeros(double(lwork),1));
			rwork=zeros(double(lwork),1);
			[jobz, uplo, n, vec, lda, val, work, lwork, rwork,lrwork, iwork, liwork, info]=lapack_zheevd(jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork, info);
		else
			w=single(zeros(double(n),1));
			work=single(complex(zeros(1)));
			rwork=single(zeros(1,1));
			iwork=int32(zeros(1,1));
			lrwork=int32(-1);
			liwork=int32(-1);
			lwork=int32(-1);
			info=int32(-1);
			[jobz, uplo, n, vec, lda, val, work, lwork, rwork,lrwork, iwork, liwork, info]=lapack_cheevd(jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork, info);
			lwork=int32(work(1));
			liwork=int32(iwork(1));
			lrwork=int32(rwork(1));

			work=single(complex(zeros(double(lwork),1)));
			iwork=int32(zeros(double(liwork),1));
			rwork=single(zeros(double(lrwork),1));
			[jobz, uplo, n, vec, lda, val, work, lwork, rwork,lrwork, iwork, liwork, info]=lapack_cheevd(jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork, info);

		end;
	else
		if (isDouble(a)),
			w=zeros(double(n),1);
			work=zeros(1);
			iwork=int32(zeros(1));
			lwork=int32(-1);
			liwork=int32(-1);
			info=int32(-1);
			[jobz, uplo, n, vec, lda, val, work, lwork, iwork,liwork, info]= lapack_dsyevd(jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info);
			lwork=int32(work(1));
			liwork=int32(iwork(1));
			work=zeros(double(lwork),1);
			iwork=int32(zeros(double(liwork),1));
			[jobz, uplo, n, vec, lda, val, work, lwork, iwork,liwork, info]= lapack_dsyevd(jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info);
		else
			w=single(zeros(double(n),1));
			work=single(zeros(1));
			iwork=int32(zeros(1));
			lwork=int32(-1);
			liwork=int32(-1);
			info=int32(-1);
			[jobz, uplo, n, vec, lda, val, work, lwork, iwork,liwork, info]= lapack_ssyevd(jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info);
			lwork=int32(work(1));
			liwork=int32(iwork(1));
			work=single(zeros(double(lwork),1));
			iwork=int32(zeros(double(liwork),1));
			[jobz, uplo, n, vec, lda, val, work, lwork, iwork,liwork, info]= lapack_ssyevd(jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info);
		end;
	end;


function [c, s, b, g, smin, active_set] = thresholded_oasisAR2(y, g, sn, optimize_b,...
    optimize_g, decimate, maxIter, thresh_factor)
%% Infer the most likely discretized spike train underlying an AR(1) fluorescence trace
% Solves the sparse non-negative deconvolution problem
%  min 1/2|c-y|^2 + lam |s|_1 subject to s_t = c_t-g c_{t-1} >=s_min or =0

%% inputs:
%   y:  T*1 vector, One dimensional array containing the fluorescence intensities
%withone entry per time-bin.
%   g:  scalar, Parameter of the AR(1) process that models the fluorescence ...
%impulse response.
%   sn:  scalar, standard deviation of the noise distribution
%   optimize_b: bool, optimize baseline if True
%   optimize_g: integer, number of large, isolated events to consider for
%       optimizing g
%   decimate: int, decimation factor for estimating hyper-parameters faster
%       on decimated data
%   maxIter:  int, maximum number of iterations
%   active_set: npool x 4 matrix, warm stared active sets
%  thresh_factor: scalar, set the maximum thresh as thresh_factor*sn^2*T

%% outputs
%   c: T*1 vector, the inferred denoised fluorescence signal at each time-bin.
%   s: T*1 vector, discetized deconvolved neural activity (spikes)
%   b: scalar, fluorescence baseline
%   g: scalar, parameter of the AR(1) process
%   smin: scalar, minimum nonzero spike count
%   active_set: npool x 4 matrix, active sets

%% Authors: Pengcheng Zhou, Carnegie Mellon University, 2016
% ported from the Python implementation from Johannes Friedrich

%% References
% Friedrich J et.al., NIPS 2016, Fast Active Set Method for Online Spike Inference from Calcium Imaging

%% input arguments
y = reshape(y, [], 1);
T = length(y);

if ~exist('g', 'var') || isempty(g)
    g = estimate_time_constant(y, 2);
end
if ~exist('sn', 'var') || isempty(sn)
    sn = GetSn(y);
end
if ~exist('optimize_b', 'var') || isempty(optimize_b)
    optimize_b = false;
end
if ~exist('optimize_g', 'var') || isempty(optimize_g)
    optimize_g = 0;
end
if ~exist('decimate', 'var') || isempty(decimate)
    decimate = 1;
else
    decimate = max(1, round(decimate));
end
if ~exist('maxIter', 'var') || isempty(maxIter)
    maxIter = 10;
end
if ~exist('thresh_factor', 'var') || isempty(thresh_factor)
    thresh_factor = 1.0;
end

thresh = thresh_factor* sn * sn * T;
smin = 0;

% change parameters due to downsampling
if decimate>1
    decimate = 1;  %#ok<NASGU>
    disp('to be done');
    %     fluo = y;
    %     y = resample(y, 1, decimate);
    %     g = g^decimate;
    %     thresh = thresh / decimate / decimate;
    %     T = length(y);
end
g_converged = false;

%% optimize parameters
tol = 1e-4;
if ~optimize_b   %% don't optimize the baseline b
    %% initialization
    b = 0;
    [solution, spks, active_set] = oasisAR2(y, g, [], smin);

    %% iteratively update parameters lambda & g
    for miter=1:maxIter
        len_active_set = size(active_set, 1);

        res = y - solution;
        RSS = res' * res;

        % update g
        if and(optimize_g, ~g_converged);
            g0 = g;
            [solution, active_set, g, spks] = update_g(y, g, spks,smin);
            if abs(g-g0)/g0 < 1e-3 % g is converged
                g_converged = true;
            end
        end
%         g_converged = true;
        res = y - solution;
        RSS = res' * res;
        if or(RSS>thresh, sum(solution)<1e-9)  % constrained form has been found, stop
            break;
        else
            % update lam
            [smin, solution, spks, active_set] = update_smin(y, g, smin,...
                solution, spks, active_set, sqrt(thresh), max(spks));

            % no more change of the active set
            if size(active_set,1)==len_active_set
                break;
            end
        end
    end
else
    %% initialization
    b = quantile(y, 0.15);
    [solution, spks, active_set] = oasisAR2(y-b, g, [], smin);

    %% optimize the baseline b and dependends on the optimized g too
    g_converged = false;
    for miter=1:maxIter
           % update b and g

        res = y - solution - b;
        RSS = res' * res;
        len_active_set = size(active_set,1);

        if or(abs(RSS-thresh) < tol, sum(solution)<1e-9)
            break;
        else
            % update smin
            [smin, solution, spks, active_set] = update_smin(y-b, g, smin,...
                solution, spks, active_set, sqrt(thresh), max(spks));
            b = mean(y-solution);

            % update b and g
            if and(optimize_g, ~g_converged);
                g0 = g;
                [solution, active_set, g, spks] = update_g(y-b, g0, spks, smin);
                if abs(g-g0)/g0 < 1e-4;
                    g_converged = true;
                end
            end

        end
    end

end
c = solution;
s = spks;

%% nested functions
    function [smin, solution, spks, active_set] = update_smin(y, g, smin, solution, ...
            spks, active_set, thresh, s_max)
        %%estimate smin to match the thresholded RSS
        len_active_set = size(active_set, 1);
        sv = linspace(smin, s_max, min(9, len_active_set));
        ind_start = 1;
        ind_end = length(sv);

        while (ind_end-ind_start)>1
            ind = floor((ind_start+ind_end)/2);
            tmp_smin = sv(ind);
            [tmp_solution, tmp_spks, tmp_active_set] = oasisAR2(y, g, [], ...
                tmp_smin, [], [], active_set);
            sqRSS = norm(y-tmp_solution,2);
            if sqRSS<thresh % increase smin
                solution = tmp_solution;
                spks = tmp_spks;
                active_set = tmp_active_set;
                smin = tmp_smin;
                ind_start = ind;
            elseif sqRSS>thresh % decrease smin
                ind_end = ind;
            else
                break;
            end
        end
    end

end

%update the AR coefficient: g
function [c, active_set, g, s] = update_g(y, g, spks, smin)
%% inputs:
%   y:  T*1 vector, One dimensional array containing the fluorescence intensities
%withone entry per time-bin.
%   g: 2x1 vector, AR2 parameters
%   active_set: npools*4 matrix, previous active sets.
% smin: scalr, minimize size of nonzero spikes

%% outputs
%   c: T*1 vector
%   s: T*1 vector, spike train
%   active_set: npool x 4 matrix, active sets
%   g: scalar

%% Authors: Pengcheng Zhou, Carnegie Mellon University, 2016

%% initialization
s_th = quantile(spks(spks>1e-3), 0.25);
tsp = find(spks>=s_th);
tsp = reshape(tsp, 1, []);
time_p = find(conv2(double(spks<=s_th), ones(30,1), 'same')>0);
time_p = reshape(time_p,[],1);
y = reshape(y,[],1);    % fluorescence data
yp = y(time_p);
T = length(y);
tau_dr = ar2exp(g);
tau_d = tau_dr(1);
tau_r = tau_dr(2);

%% find the optimal g and get the warm started active_set
tau_d0 = tau_d;
tau_r0 = tau_r;
bnd_d = tau_d0 * [1/4, 4];
bnd_r = tau_r0 * [1/4, 4];
for m=1:10
    tau_r = fminbnd(@rss_taur, bnd_r(1), bnd_r(2));
    tau_d = fminbnd(@rss_taud, bnd_d(1), bnd_d(2));
    if and(abs(tau_d-tau_d0)/tau_d0 < 1e-4, abs(tau_r-tau_r0)/tau_r0 < 1e-4)
        break;
    else
        tau_d0 = tau_d;
        tau_r0 = tau_r;
    end
end

%% copute the optimal solution
g = exp2ar([tau_d, tau_r]);
[c,s,active_set] = oasisAR2(y, g, 0, smin);

%% nested functions

    function rss = rss_taur(tau_r)
        ht = (exp(-(1:T)/tau_d) - exp(-(1:T)/tau_r))/(tau_d-tau_r);
        ht(T) = 0;
        ind = bsxfun(@minus, time_p, tsp);
        ind(ind<=0) = T;
        V = ht(ind);

        % find the best value of st
        s = (V'*V)\(V'*yp);
        res = yp - V*s;
        rss = res' * res;
    end

    function rss = rss_taud(tau_d)
         ht = (exp(-(1:T)/tau_d) - exp(-(1:T)/tau_r))/(tau_d-tau_r);
        ht(T) = 0;
        ind = bsxfun(@minus, time_p, tsp);
        ind(ind<=0) = T;
        V = ht(ind);

        % find the best value of st
        s = (V'*V)\(V'*yp);
        res = yp - V*s;
        rss = res' * res;
    end
end


function Output = Bayesian_RPCAmcmc_MarkovDep(X0,Theta0,Row,Col,hyperpara,MCMCpara)
%Bayesian_RPCAmcmc_withMarkovDep: Bayesian robust principle component analysis
%implemented by MCMC, considering Markov dependency on the sparse term in time and space.
%
% Model: X0 = D*(Delta.*Z)*S + S2.*Z2 + E
% ----------------------------------------------------
%
%USAGE: Output = Bayesian_RPCAmcmc_withMarkovDep(X0,Theta0,Row,Col,hyperpara,MCMCpara)
%
%INPUT :
%   X0: P x N, input data matrix. For the video application, every column is a frame of the video.
%
%   Theta0: struct data including the initial parameters of the model. The parameters of the model are initialized as follows,
%         D = Theta0.D: P x K matrix as a dictionary for lowrank learning
%         S = Theta0.S: K x N coefficient matrix
%         Z = Theta0.Z: K x K diagnal binary matrix for rank learning
%         Delta = Theta0.Delta: K x K diagnal matrix for weighting Z.
%         Tao = Theta0.Tao: precision of Delta. Here we set Tao=1.
%         Pi = Theta0.Pi: K x 1 vector. Pi is the probability of Z=1.
%
%         gamma_epsi = Theta0.gamma_epsi:  scalar, precision of the noise. Here we assumed the noise is stationary.
%
%         S2 = Theta0.S2: P x N matrix for Sparse Component learning
%         Z2 = Theta0.Z2: P x N binary matrix for Sparse Component learning
%         gamma_s = Theta0.gamma_s: precision of the S2
%         Pi2 = Theta0.Pi2: P x N . Pi2 is the probability of Z2=1.
%         Note that Pi2 here is a matrix, different from the model structure in function Bayesian_RPCAmcmc.
%
%   Row and Col: Row and column of the video frame.
%
%   hyperpara: MCMC hyperparameters
%     hyperpara.a0: scalar, hyperparameter 1 for Pi [1/K or 1/150 if K<150]
%       hyperpara.b0: scalar, hyperparameter 2 for Pi [1-hyperpara.a0]
%       hyperpara.c0: scalar, hyperparameter 1 for Tao precision [1e-6]
%       hyperpara.d0: scalar, hyperparameter 2 for Tao precision [1e-6]
%       hyperpara.e0: scalar, hyperparameter 1 for nosie precision [1e-6]
%       hyperpara.f0: scalar, hyperparameter 2 for nosie precision [1e-6]
%       hyperpara.g0: scalar, hyperparameter 1 for S2 precision [1e-6]
%       hyperpara.h0: scalar, hyperparameter 2 for S2 precision [1e-6]
%       hyperpara.alpha0: scalar,hyperparameter 1 for Pi2 [0.01*N]
%       hyperpara.beta0: scalar,hyperparameter 2 for Pi2 [0.99*N]
%       hyperpara.alpha1: scalar,hyperparameter 3 for Pi2 [0.99*N]
%       hyperpara.beta1: scalar,hyperparameter 4 for Pi2 [0.01*N]
%
%
%   MCMCpara: MCMC parameters
%       MCMCpara.nBurnin: scalar, number of burnin iterations [2000]
%       MCMCpara.nCollect: scalar, number of collected samples [1000]
%
%OUTPUT:
%   Output: struct data.
%         Output.Lowrank_mean: P x N matrix, mean of the Lowrank Component.
%         Output.Lowrank_std: P x N matrix, std of the Lowrank Component.
%         Output.Sparse_mean: P x N matrix, mean of the Sparse Component.
%         Output.Sparse_std: P x N matrix, std of the Sparse Component.
%         Output.Gamma_epsi_mean: scalar, mean of the noise precision.
%         Output.Gamma_epsi_std: scalar, std of the noise precision.
%         Output.rankL_mean: scalar, mean of the estimated rank of the lowrank Component.
%         Output.rankL_std: scalar, std of the estimated rank of the lowrank Component.
%         Output.NumSparse_mean: scalar, mean of the estimated number of the Sparse Component.
%         Output.NumSparse_std: scalar, std of the estimated number of the Sparse Component.

%--------------------------------------------------------------------------
% References:
% X. Ding, L. He and L. Carin, Bayesian Robust Principal Component Analysis, submitted to IEEE Trans. Image Processing (2010)
%
% Xinghao Ding, Lihan He, ECE, Duke University
% Created: Apr. 12, 2010,
% Last change: Aug. 2, 2010.
%--------------------------------------------------------------------------

% ---------------------
% check input arguments
% ---------------------

% P -- Dimension of the data vector
% N -- Number of samples
[P,N] = size(X0);
% K -- the largest possible rank
K = size(Theta0.D,2);

if nargin<6
    MCMCpara.nBurnin=100;
    MCMCpara.nCollect=100;
end
if nargin<5
    % Hyperparameters
    if K<150
        hyperpara.a0 = 1/150;
    else
        hyperpara.a0 = 1/K;
    end
    hyperpara.b0 = 1-hyperpara.a0;
    hyperpara.c0 = 1e-6;
    hyperpara.d0 = 1e-6;
    hyperpara.e0 = 1e-6;
    hyperpara.f0 = 1e-6;
    hyperpara.g0 = 1e-6;
    hyperpara.h0 = 1e-6;
    hyperpara.alpha0 = 0.01*N;
    hyperpara.beta0 = 0.99*N;
    hyperpara.alpha1 = 0.99*N;
    hyperpara.beta1 = 0.01*N;

end

if isempty(hyperpara)
    % P -- Dimension of the data vector
    % N -- Number of samples
    [P,N] = size(X0);
    % K -- the largest possible rank
    K = size(Theta0.D,2);

    % Hyperparameters
    if K<150
        hyperpara.a0 = 1/150;
    else
        hyperpara.a0 = 1/K;
    end
    hyperpara.b0 = 1-hyperpara.a0;
    hyperpara.c0 = 1e-6;
    hyperpara.d0 = 1e-6;
    hyperpara.e0 = 1e-6;
    hyperpara.f0 = 1e-6;
    hyperpara.g0 = 1e-6;
    hyperpara.h0 = 1e-6;
    hyperpara.alpha0 = 0.01*N;
    hyperpara.beta0 = 0.99*N;
    hyperpara.alpha1 = 0.99*N;
    hyperpara.beta1 = 0.01*N;
end

if isempty(MCMCpara)
   MCMCpara.nBurnin=100;
    MCMCpara.nCollect=100;
end

a0 = hyperpara.a0;
b0 = hyperpara.b0;
c0 = hyperpara.c0;
d0 = hyperpara.d0;
e0 = hyperpara.e0;
f0 = hyperpara.f0;
g0 = hyperpara.g0;
h0 = hyperpara.h0;
alpha0 = hyperpara.alpha0;
beta0 =  hyperpara.beta0;
alpha1 = hyperpara.alpha1;
beta1 =  hyperpara.beta1;

D = Theta0.D;
S = Theta0.S;
Z = Theta0.Z;
Delta = Theta0.Delta;
Tao = Theta0.Tao;
Pi = Theta0.Pi;
gamma_epsi = Theta0.gamma_epsi;
S2 = Theta0.S2;
Z2 = Theta0.Z2;
gamma_s = Theta0.gamma_s;
Pi2 = Theta0.Pi2;

Lowrank_Comp = zeros(P,N);
Sparse_Comp = zeros(P,N);

for iter=1:(MCMCpara.nBurnin+MCMCpara.nCollect)

    X = X0-D*diag(Delta.*Z)*S-S2.*Z2;

    %---------------------------------------------------------------
    % Low-rank component sampling
    %---------------------------------------------------------------

    for k=1:K
        Tao(k) =1;
        X = X+ Delta(k)*Z(k)*D(:,k)*S(k,:);

        %Sample D----------------------------------------------------------
        sigma_Dk = 1/(gamma_epsi*(Delta(k)).^2*Z(k)*(S(k,:)*S(k,:)')+P);
        mu_Dk = gamma_epsi*sigma_Dk* (Delta(k))*Z(k)*X*S(k,:)';
        D(:,k) = mu_Dk + randn(P,1)*sqrt(sigma_Dk);
        %clear sigma_Dk mu_D
        %------------------------------------------------------------------

        %Sample S----------------------------------------------------------

        Dk = D(:,k);
        sigS1 = 1/(1 + gamma_epsi*Z(k)*(Dk'*Dk)*(Delta(k)).^2);
        muS1 = gamma_epsi*sigS1*Z(k)*Delta(k)*D(:,k)'*X;
        S(k,:) = randn(1,N)*sqrt(sigS1) + muS1;
        %------------------------------------------------------------------

        %Sample Delta(k)
        sig_Delta = 1/(Tao(k)+gamma_epsi*(Dk'*Dk)*(S(k,:)*S(k,:)'));
        mu_Delta = gamma_epsi*sig_Delta*D(:,k)'*X*S(k,:)';
        if Z(k) ==1
            %Delta(k) = randn(1)*sqrt(sig_Delta)+mu_Delta;
            Delta(k) = normrnd(mu_Delta,sqrt(sig_Delta));
        else
            %Delta(k) = randn(1);
            Delta(k) =  normrnd(0,sqrt(1/Tao(k)));
        end
        %------------------------------------------------------------------

%        %Sample Z---------------------------------------------------------
        Sk = S(k,:);
        Dk = D(:,k);
        temp =  - 0.5*gamma_epsi*(Delta(k)).^2*(Dk'*Dk)*(Sk*Sk') + gamma_epsi*Delta(k)*Dk'*(X*S(k,:)');
        p1 = exp(temp)*Pi(k);
        p0 = 1-Pi(k);
        Z(k) = rand > p0/(p0+p1);
        %------------------------------------------------------------------

%       %Clappsed Gibbs Sample Z
%         tmpz = log(Pi(k)+eps) - log(1-Pi(k)+eps) + 0.5*log(sig_Delta) + (mu_Delta^2)/(2*sig_Delta) + 0.5*log(Tao(k));
%         if rand < 1/(1+exp(-tmpz))
%             Z(k) = 1; Delta(k) = normrnd(mu_Delta,sqrt(sig_Delta));
%         else
%             Z(k) = 0; Delta(k) =  normrnd(0,sqrt(1/Tao(k)));
%         end

        %sample Pi--------------------------------------------------
        ai = a0 + Z(k);
        bi = b0 + 1 - Z(k);
        Pi(k) =betarnd(ai,bi);
        %------------------------------------------------------------------

        %sample Tao
%         if Z(k) ==1
%             c1 =c0+1/2;
%             d1 =d0 + 0.5*(Delta(k)).^2;
%             Tao(k) = gamrnd(c1,1./d1);
%         else
%             Tao(k) = 1;
%         end
        %------------------------------------------------------------------

        X = X - Delta(k)*Z(k)*D(:,k)*S(k,:);
    end

    %---------------------------------------------------------------
    % Sparse component sampling
    %---------------------------------------------------------------

    X = X + S2.*Z2;

    % Sample S2
    sig_S2 = 1./(gamma_s + gamma_epsi*Z2);
    mu_S2 = gamma_epsi*sig_S2.*Z2.*X;
    S2 = randn(P,N).*sqrt(sig_S2)+mu_S2;

    % Sample Z2
    temp =  exp(-0.5*gamma_epsi*(S2.^2-2*S2.*X));
%     p1 = repmat(Pi2,[1,N]).*temp;
%     p0 = repmat(1- Pi2,[1,N]);
    p1 = Pi2.*temp;
    p0 = 1- Pi2;
    Z2 = rand(P,N)>p0./(p1+p0);

    X = X - S2.*Z2;

    %sample gamma_s
    g1 = g0 + 0.5*P*N;
    tempS2 = S2.*S2;
    h1 = h0 + 0.5*sum(tempS2(:));
    gamma_s = gamrnd(g1,1/h1);

    %Sample Pi2
%     sumZ2 = sum(Z2,2);
%     a2 = a1 + sumZ2;
%     b2 = b1 + N -sumZ2;
%     Pi2 = betarnd(a2,b2);

    %h = fspecial('average');
    h = [0.1,0.1,0.1;0.1,0.2,0.1;0.1,0.1,0.1];
    for n = 1:N
        temp1 = reshape(Z2(:,n),[Row,Col]);
        temp2 = imfilter(double(temp1),h)>0.6;
        tempZ2(:,n) = reshape(temp2,[Row*Col,1]);
    end

    a2 = alpha0 +Z2(:,1);
    b2 = beta0 + 1 - Z2(:,1);
    Pi2(:,1) = betarnd(a2,b2);

    for t = 2:N
%         a2 = alpha0*(~Z2(:,t-1))+alpha1*(Z2(:,t-1)) +Z2(:,t);
%         b2 = beta0*(~Z2(:,t-1))+beta1*(Z2(:,t-1)) +1 - Z2(:,t);
%         a2 = alpha0*(~(Z2(:,t-1).*tempZ2(:,t-1)))+alpha1*(Z2(:,t-1).*tempZ2(:,t-1)) +Z2(:,t);
%         b2 = beta0*(~(Z2(:,t-1).*tempZ2(:,t-1)))+beta1*(Z2(:,t-1).*tempZ2(:,t-1)) +1 - Z2(:,t);
%         a2 = alpha0*(~(tempZ2(:,t-1)))+alpha1*(tempZ2(:,t-1)) +Z2(:,t);
%         b2 = beta0*(~(tempZ2(:,t-1)))+beta1*(tempZ2(:,t-1)) +1 - Z2(:,t);
          a2 = alpha0*(~(tempZ2(:,t)))+alpha1*(tempZ2(:,t)) +Z2(:,t);
          b2 = beta0*(~(tempZ2(:,t)))+beta1*(tempZ2(:,t)) +1 - Z2(:,t);

%         a2 = alpha0*(~(tempZ2(:,t-1).*tempZ2(:,t)))+alpha1*(tempZ2(:,t-1).*tempZ2(:,t)) +Z2(:,t);
%         b2 = beta0*(~(tempZ2(:,t-1).*tempZ2(:,t)))+beta1*(tempZ2(:,t-1).*tempZ2(:,t)) +1 - Z2(:,t);

%         a2 = alpha0*(~(Z2(:,t-1).*tempZ2(:,t)))+alpha1*(Z2(:,t-1).*tempZ2(:,t)) +Z2(:,t);
%         b2 = beta0*(~(Z2(:,t-1).*tempZ2(:,t)))+beta1*(Z2(:,t-1).*tempZ2(:,t)) +1 - Z2(:,t);

        Pi2(:,t) = betarnd(a2,b2);
    end

    %---------------------------------------------------------------
    % noise component sampling
    %---------------------------------------------------------------

    %Sample gamma_epsi
    e1 = e0 + 0.5*P*N;
    f1 = f0 + 0.5*sum(sum(X.^2));
    gamma_epsi = gamrnd(e1,1./f1);

    %------------------------

    % Collect samples
    if iter>MCMCpara.nBurnin
        ii = ceil(iter-MCMCpara.nBurnin);

%         Lowrank_Comp(:,:,ii) = D*diag(Delta.*Z)*S;
%         Sparse_Comp(:,:,ii) = S2.*Z2;
        Lowrank_Comp = Lowrank_Comp + D*diag(Delta.*Z)*S;
        Sparse_Comp = Sparse_Comp + S2.*Z2;

        Gamma_epsi(ii) = gamma_epsi;
        tmpRank(ii) = length(find(Z~=0));
        %tmpNumSparse(ii) = length(find(Sparse_Comp(:,:,ii)~=0));
        %mse_rec(iter) = sum(sum((X0-Lowrank_Comp{ii}-Sparse_Comp{ii}).^2))/(P*N);
    end

end

% Output.Lowrank_mean = mean(Lowrank_Comp,3);
% Output.Lowrank_std = std(Lowrank_Comp,0,3);
% Output.Sparse_mean = mean(Sparse_Comp,3);
% Output.Sparse_std = std(Sparse_Comp,0,3);
Output.Lowrank_mean = Lowrank_Comp/MCMCpara.nCollect;
Output.Sparse_mean = Sparse_Comp/MCMCpara.nCollect;
Output.Gamma_epsi_mean = mean(Gamma_epsi);
Output.Gamma_epsi_std = std(Gamma_epsi);
Output.rankL_mean = mean(tmpRank);
Output.rankL_std = std(tmpRank);
% Output.NumSparse_mean = mean(tmpNumSparse);
% Output.NumSparse_std = std(tmpNumSparse);
end


function [r0,u0,p0] = Euler_IC1d(x,input)
% Load the IC of a classical 2D Riemann Problem configuration.
% By Manuel Diaz 2012.10.24.
% In the notation we take advantage of the matlab array notation as follows
%
% prop = [prop_left , prop_right]
%
% Notation:
% u   = Velocity in x direction
% p   = Pressure
% rho = Density
% r   = Fugacity
% E   = Enerty
% t   = temperature
%
% Based on:
% http://wonka.physics.ncsu.edu/pub/VH-1/testpage/ and
% http://sitemaker.umich.edu/anand/files/riemann_shock-tube.pdf
% See also my routine CFD/Riemann.m to compute exact solutions.
%
%% Initial Physical Properties per case:
switch input
    case{1} % Configuration 1, Sod's Problem
        fprintf('Case 1: Sods problem \n');
        p   = [1    0.1  ];
        u   = [0.75 0    ];
        rho = [1    0.125];

    case{2} % Configuration 2, Left Expansion and right strong shock
        fprintf('Case 2: Left Expansion and right strong shock \n');
        p   = [1000 0.1  ];
        u   = [0    0    ];
        rho = [3    2    ];

    case{3} % Configuration 3, Right Expansion and left strong shock
        fprintf('Case 3: Right Expansion and left strong shock \n');
        p   = [7    10   ];
        u   = [0    0    ];
        rho = [1    1    ];

    case{4} % Configuration 4, Double Shock
        fprintf('Case 4: Double Shock \n');
        p   = [450  45   ];
        u   = [20   -6   ];
        rho = [6    6    ];

    case{5} % Configuration 5, Double Expansion
        fprintf('Case 5: Double Expansion \n');
        p   = [40   40   ];
        u   = [-2   2    ];
        rho = [1    2.5  ];

    case{6} % Configuration 6, Cavitation
        fprintf('Case 6: Cavitation \n');
        p   = [0.4  0.4  ];
        u   = [-20  20   ];
        rho = [1    1    ];

    otherwise
        error('Available cases: 1, 2, 3, 4, 5 and 6');

end
% Print
fprintf('\n');
fprintf('density (L): %1.3f\n',rho(1));
fprintf('velocity(L): %1.3f\n',u(1));
fprintf('Presure (L): %1.3f\n',p(1));
fprintf('\n');
fprintf('density (R): %1.3f\n',rho(2));
fprintf('velocity(R): %1.3f\n',u(2));
fprintf('Presure (R): %1.3f\n',p(2));
fprintf('\n');

%% Load Selected case Initial condition:
% number of points required
 nx = length(x);

% Parameters of regions dimensions
x_middle = ceil(nx/2);
l_1 = 1:x_middle; l_2 = x_middle+1:nx;

% Pre-Allocate variables
r0 = zeros(1,nx);
u0 = zeros(1,nx);
p0 = zeros(1,nx);

% Initial Condition for our 2D domain
% Fugacity
r0(l_1) = rho(1); % region 1
r0(l_2) = rho(2); % region 2
% Velovity in x
u0(l_1) = u(1); % region 1
u0(l_2) = u(2); % region 2
% temperature
p0(l_1) = p(1); % region 1
p0(l_2) = p(2); % region 2


function product_rule ( list_filename, quad_filename )

%*****************************************************************************80
%
%% MAIN is the main program for PRODUCT_RULE.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    13 May 2007
%
%  Author:
%
%    John Burkardt
%
  timestamp ( );
  fprintf ( 1, '\n');
  fprintf ( 1, 'PRODUCT_RULE\n');
  fprintf ( 1, '  MATLAB version\n');
  fprintf ( 1, '\n');
  fprintf ( 1, '  Create a multidimensional product rule\n');
  fprintf ( 1, '  as a product of distinct 1D integration rules.\n');
%
%  Get the list filename.
%
  if ( nargin < 1 )

    fprintf ( 1, '\n' );
    fprintf ( 1, 'PRODUCT_RULE:\n' );
    list_filename = input ( '  Enter the name of the file listing the factors.' );

  end
%
%  Get the product file prefix.
%
  if ( nargin < 2 )

    fprintf ( 1, '\n' );
    fprintf ( 1, 'PRODUCT_RULE:\n' );
    quad_filename = input ( '  Enter the product file prefix to use.' );

  end
%
%  Count the items in the list file.
%
  list_num = file_row_count ( list_filename );
%
%  Determine the spatial dimension and number of points in the product.
%
  dim_num = list_num;
  point_num = product_rule_size ( list_filename, list_num );
%
%  Allocate the product items.
%
  x(1:dim_num,1:point_num) = 0.0;
  w(1:point_num) = 1.0;
  r(1:dim_num,1:2) = 0.0;

  list_unit = fopen ( list_filename, 'rt' );

  if ( list_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'PRODUCT_RULE - Fatal error!\n' );
    fprintf ( 1, '  Nonzero value of IOS while opening list file.\n' );
    error ( 'PRODUCT_RULE - Fatal error!' );
  end
%
%  Read the factor information and apply it.
%
  for dim = 1 : dim_num

    quad_1d_filename = fgetl ( list_unit );

    quad_x_1d_filename = strcat ( quad_1d_filename, '_x.txt' );
    quad_w_1d_filename = strcat ( quad_1d_filename, '_w.txt' );
    quad_r_1d_filename = strcat ( quad_1d_filename, '_r.txt' );
%
%  Read the X file.
%
    [ dim_num_1d, point_num_1d ] = r8mat_header_read ( quad_x_1d_filename );

    if ( dim_num_1d ~= 1 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'PRODUCT_RULE - Fatal error!\n' );
      fprintf ( 1, '  The 1D quadrature abscissa file should have exactly\n' );
      fprintf ( 1, '  one value on each line.\n' );
      error ( 'PRODUCT_RULE - Fatal error!' );
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Number of points in 1D rule = %d\n', point_num_1d );

    x_1d = r8mat_data_read ( quad_x_1d_filename, dim_num_1d, point_num_1d );
%
%  Read the W file.
%
    [ dim_num_1d, point_num_1d2 ] = r8mat_header_read ( quad_w_1d_filename );

    if ( dim_num_1d ~= 1 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'PRODUCT_RULE - Fatal error!\n' );
      fprintf ( 1, '  The 1D quadrature weight file should have exactly\n' );
      fprintf ( 1, '  one value on each line.\n' );
      error ( 'PRODUCT_RULE - Fatal error!' );
    end

    if ( point_num_1d2 ~= point_num_1d )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'PRODUCT_RULE - Fatal error!\n' );
      fprintf ( 1, '  The 1D quadrature weight file should have exactly\n' );
      fprintf ( 1, '  the same number of lines as the abscissa file.\n' );
      error ( 'PRODUCT_RULE - Fatal error!' );
    end

    w_1d = r8mat_data_read ( quad_w_1d_filename, dim_num_1d, point_num_1d );
%
%  Read the R file.
%
    [ dim_num_1d, point_num_1d2 ] = r8mat_header_read ( quad_r_1d_filename );

    if ( dim_num_1d ~= 1 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'PRODUCT_RULE - Fatal error!\n' );
      fprintf ( 1, '  The 1D quadrature region file should have exactly\n' );
      fprintf ( 1, '  one value on each line.\n' );
      error ( 'PRODUCT_RULE - Fatal error!' );
    end

    if ( point_num_1d2 ~= 2 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'PRODUCT_RULE - Fatal error!\n' );
      fprintf ( 1, '  The 1D quadrature region file should have exactly\n' );
      fprintf ( 1, '  two lines.\n' );
      error ( 'PRODUCT_RULE - Fatal error!' );
    end

    r_1d = r8mat_data_read ( quad_r_1d_filename, 1, 2 );
%
%  Update the X, W, and R of the product rule.
%
    x = r8vec_direct_product ( dim, point_num_1d, x_1d, dim_num, point_num, x );

    w = r8vec_direct_product2 ( dim, point_num_1d, w_1d, dim_num, point_num, w );

    r(dim,1) = r_1d(1);
    r(dim,2) = r_1d(2);

  end

  fclose ( list_unit );
%
%  Write the product rule.
%
  quad_x_filename = strcat ( quad_filename, '_x.txt' );
  quad_w_filename = strcat ( quad_filename, '_w.txt' );
  quad_r_filename = strcat ( quad_filename, '_r.txt' );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Creating product quadrature rule X file = "%s".\n', ...
    quad_x_filename );

  r8mat_write ( quad_x_filename, dim_num, point_num, x );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Creating product quadrature rule W file = "%s".\n', ...
    quad_w_filename );

  r8mat_write ( quad_w_filename, 1, point_num, w );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Creating product quadrature rule R file = "%s".\n', ...
    quad_r_filename );

  r8mat_write ( quad_r_filename, dim_num, 2, r );
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'PRODUCT_RULE:\n' );
  fprintf ( 1, '  Normal end of execution.\n' );
  fprintf ( 1, '\n' );
  timestamp ( );

  return
end
function column_num = file_column_count ( input_file_name )

%*****************************************************************************80
%
%% FILE_COLUMN_COUNT counts the columns in the first line of a file.
%
%  Discussion:
%
%    The file is assumed to be a simple text file.
%
%    Most lines of the file are presumed to consist of COLUMN_NUM words,
%    separated by spaces.  There may also be some blank lines, and some
%    comment lines, which have a "#" in column 1.
%
%    The routine tries to find the first non-comment non-blank line and
%    counts the number of words in that line.
%
%    If all lines are blanks or comments, it goes back and tries to analyze
%    a comment line.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 February 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILE_NAME, the name of the file.
%
%    Output, integer COLUMN_NUM, the number of columns in the file.
%
  FALSE = 0;
  TRUE = 1;
%
%  Open the file.
%
  input_unit = fopen ( input_file_name );

  if ( input_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'FILE_COLUMN_COUNT - Error!\n' );
    fprintf ( 1, '  Could not open the file "%s".\n', input_file_name );
    error ( 'FILE_COLUMN_COUNT - Error!' );
  end
%
%  Read one line, but skip blank lines and comment lines.
%  Use FGETL so we drop the newline character!
%
  got_one = FALSE;

  while ( 1 )

    line = fgetl ( input_unit );

    if ( line == -1 )
      break;
    end

    if ( s_len_trim ( line ) == 0 )

    elseif ( line(1) == '#' )

    else
      got_one = TRUE;
      break;
    end

  end

  fclose ( input_unit );

  if ( got_one == FALSE )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'FILE_COLUMN_COUNT - Warning!\n' );
    fprintf ( 1, '  The file does not seem to contain any data.\n' );
    column_num = -1;
    return;
  end

  column_num = s_word_count ( line );

  return
end
function row_num = file_row_count ( input_file_name )

%*****************************************************************************80
%
%% FILE_ROW_COUNT counts the number of row records in a file.
%
%  Discussion:
%
%    Each input line is a "RECORD".
%
%    The records are divided into three groups:
%
%    * BLANK LINES (nothing but blanks)
%    * COMMENT LINES (begin with a '#')
%    * DATA RECORDS (anything else)
%
%    The value returned by the function is the number of data records.
%
%    By the way, if the MATLAB routine FGETS is used, instead of
%    FGETL, then the variable LINE will include line termination
%    characters, which means that a blank line would not actually
%    have zero characters.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    31 December 2006
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILE_NAME, the name of the input file.
%
%    Output, integer ROW_NUM, the number of rows found.
%
  input_unit = fopen ( input_file_name );

  if ( input_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'FILE_ROW_COUNT - Error!\n' );
    fprintf ( 1, '  Could not open the file "%s".\n', input_file_name );
    error ( 'FILE_ROW_COUNT - Error!' );
  end

  blank_num = 0;
  comment_num = 0;
  row_num = 0;

  record_num = 0;

  while ( 1 )

    line = fgetl ( input_unit );

    if ( line == -1 )
      break;
    end

    record_num = record_num + 1;
    record_length = s_len_trim ( line );

    if ( record_length <= 0 )
      blank_num = blank_num + 1;
    elseif ( line(1) == '#' )
      comment_num = comment_num + 1;
    else
      row_num = row_num + 1;
    end

  end

  fclose ( input_unit );

  return
end
function point_num = product_rule_size ( list_filename, list_num )

%*****************************************************************************80
%
%% PRODUCT_RULE_SIZE returns the size of a product rule of distinct factors.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    10 May 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string LIST_FILENAME, a file containing a list
%    of prefixes defining quadrature rules.
%
%    Input, integer LIST_NUM, the number of prefixes in the file.
%
%    Output, integer POINT_NUM, the number of points in the product rule.
%
  point_num = 1;

  list_unit = fopen ( list_filename, 'rt' );

  if ( list_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'PRODUCT_RULE_SIZE - Fatal error!\n' );
    fprintf ( 1, '  Nonzero value of IOS while opening list file.\n' );
    error ( 'PRODUCT_RULE_SIZE - Fatal error!' );
  end

  for list = 1 : list_num

    quad_1d_filename = fgetl ( list_unit );

    quad_x_1d_filename = strcat ( quad_1d_filename, '_x.txt' );

    [ dim_num_1d, point_num_1d ] = r8mat_header_read ( quad_x_1d_filename );

    point_num = point_num * point_num_1d;

  end

  fclose ( list_unit );

  return
end
function table = r8mat_data_read ( input_filename, m, n )

%*****************************************************************************80
%
%% R8MAT_DATA_READ reads data from an R8MAT file.
%
%  Discussion:
%
%    An R8MAT is an array of R8's.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    27 January 2006
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILENAME, the name of the input file.
%
%    Input, integer M, N, the number of rows and columns of data.
%
%    Output, real TABLE(M,N), the point coordinates.
%
  table = zeros ( m, n );
%
%  Build up the format string for reading M real numbers.
%
  string = ' ';

  for i = 0 : m
    string = strcat ( string, ' %f' );
  end

  input_unit = fopen ( input_filename );

  if ( input_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8MAT_DATA_READ - Error!\n' );
    fprintf ( 1, '  Could not open the file.\n' );
    error ( 'R8MAT_DATA_READ - Error!' );
  end

  i = 0;

  while ( i < n )

    line = fgets ( input_unit );

    if ( line == -1 )
      break;
    end

    if ( line(1) == '#' )

    elseif ( s_len_trim ( line ) == 0 )

    else

      [ x, count ] = sscanf ( line, string );

      if ( count == m )
        i = i + 1;
        table(1:m,i) = x(1:m);
      end

    end

  end

  fclose ( input_unit );

  return
end
function [ m, n ] = r8mat_header_read ( input_filename )

%*****************************************************************************80
%
%% R8MAT_HEADER_READ reads the header from an R8MAT file.
%
%  Discussion:
%
%    An R8MAT is an array of R8's.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 October 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILENAME, the name of the input file.
%
%    Output, integer M, the spatial dimension.
%
%    Output, integer N, the number of points.
%
  m = file_column_count ( input_filename );

  if ( m <= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8MAT_HEADER_READ - Fatal error!\n' );
    fprintf ( 1, '  There was some kind of I/O problem while trying\n' );
    fprintf ( 1, '  to count the number of data columns in\n' );
    fprintf ( 1, '  the file %s.\n', input_filename );
  end

  n = file_row_count ( input_filename );

  if ( n <= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8MAT_HEADER_READ - Fatal error!\n' );
    fprintf ( 1, '  There was some kind of I/O problem while trying\n' );
    fprintf ( 1, '  to count the number of data rows in\n' );
    fprintf ( 1, '  the file %s\n', input_filename );
  end

  return
end
function r8mat_write ( output_filename, m, n, table )

%*****************************************************************************80
%
%% R8MAT_WRITE writes an R8MAT file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    11 August 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string OUTPUT_FILENAME, the output filename.
%
%    Input, integer M, the spatial dimension.
%
%    Input, integer N, the number of points.
%
%    Input, real TABLE(M,N), the points.
%

%
%  Open the file.
%
  output_unit = fopen ( output_filename, 'wt' );

  if ( output_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8MAT_WRITE - Error!\n' );
    fprintf ( 1, '  Could not open the output file.\n' );
    error ( 'R8MAT_WRITE - Error!' );
  end
%
%  Write the data.
%
%  For smaller data files, and less precision, try:
%
%     fprintf ( output_unit, '  %14.6f', table(i,j) );
%
  for j = 1 : n
    for i = 1 : m
      fprintf ( output_unit, '  %24.16f', table(i,j) );
    end
    fprintf ( output_unit, '\n' );
  end
%
%  Close the file.
%
  fclose ( output_unit );

  return
end
function x = r8vec_direct_product ( factor_index, factor_order, ...
  factor_value, factor_num, point_num, x )

%*****************************************************************************80
%
%% R8VEC_DIRECT_PRODUCT creates a direct product of R8VEC's.
%
%  Discussion:
%
%    To explain what is going on here, suppose we had to construct
%    a multidimensional quadrature rule as the product of K rules
%    for 1D quadrature.
%
%    The product rule will be represented as a list of points and weights.
%
%    The J-th item in the product rule will be associated with
%      item J1 of 1D rule 1,
%      item J2 of 1D rule 2,
%      ...,
%      item JK of 1D rule K.
%
%    In particular,
%      X(J) = ( X(1,J1), X(2,J2), ..., X(K,JK))
%    and
%      W(J) = W(1,J1) * W(2,J2) * ... * W(K,JK)
%
%    So we can construct the quadrature rule if we can properly
%    distribute the information in the 1D quadrature rules.
%
%    This routine carries out that task.
%
%    Another way to do this would be to compute, one by one, the
%    set of all possible indices (J1,J2,...,JK), and then index
%    the appropriate information.  An advantage of the method shown
%    here is that you can process the K-th set of information and
%    then discard it.
%
%  Example:
%
%    Rule 1:
%      Order = 4
%      X(1:4) = ( 1, 2, 3, 4 )
%
%    Rule 2:
%      Order = 3
%      X(1:3) = ( 10, 20, 30 )
%
%    Rule 3:
%      Order = 2
%      X(1:2) = ( 100, 200 )
%
%    Product Rule:
%      Order = 24
%      X(1:24) =
%        ( 1, 10, 100 )
%        ( 2, 10, 100 )
%        ( 3, 10, 100 )
%        ( 4, 10, 100 )
%        ( 1, 20, 100 )
%        ( 2, 20, 100 )
%        ( 3, 20, 100 )
%        ( 4, 20, 100 )
%        ( 1, 30, 100 )
%        ( 2, 30, 100 )
%        ( 3, 30, 100 )
%        ( 4, 30, 100 )
%        ( 1, 10, 200 )
%        ( 2, 10, 200 )
%        ( 3, 10, 200 )
%        ( 4, 10, 200 )
%        ( 1, 20, 200 )
%        ( 2, 20, 200 )
%        ( 3, 20, 200 )
%        ( 4, 20, 200 )
%        ( 1, 30, 200 )
%        ( 2, 30, 200 )
%        ( 3, 30, 200 )
%        ( 4, 30, 200 )
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 April 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer FACTOR_INDEX, the index of the factor being processed.
%    The first factor processed must be factor 1%
%
%    Input, integer FACTOR_ORDER, the order of the factor.
%
%    Input, real FACTOR_VALUE(FACTOR_ORDER), the factor values
%    for factor FACTOR_INDEX.
%
%    Input, integer FACTOR_NUM, the number of factors.
%
%    Input, integer POINT_NUM, the number of elements in the direct product.
%
%    Input, real X(FACTOR_NUM,POINT_NUM), the elements of the
%    direct product, which are built up gradually.
%
%    Output, real X(FACTOR_NUM,POINT_NUM), the elements of the
%    direct product, updated by the latest factor.
%
%  Local Parameters:
%
%    Local, integer START, the first location of a block of values to set.
%
%    Local, integer CONTIG, the number of consecutive values to set.
%
%    Local, integer SKIP, the distance from the current value of START
%    to the next location of a block of values to set.
%
%    Local, integer REP, the number of blocks of values to set.
%
  persistent contig;
  persistent rep;
  persistent skip;

  if ( factor_index == 1 )
    contig = 1;
    skip = 1;
    rep = point_num;
    x(1:factor_num,1:point_num) = 0.0;
  end

  rep = rep / factor_order;
  skip = skip * factor_order;

  for j = 1 : factor_order

    start = 1 + ( j - 1 ) * contig;

    for k = 1 : rep
      x(factor_index,start:start+contig-1) = factor_value(j);
      start = start + skip;
    end

  end

  contig = contig * factor_order;

  return
end
function w = r8vec_direct_product2 ( factor_index, factor_order, ...
  factor_value, factor_num, point_num, w )

%*****************************************************************************80
%
%% R8VEC_DIRECT_PRODUCT2 creates a direct product of R8VEC's.
%
%  Discussion:
%
%    To explain what is going on here, suppose we had to construct
%    a multidimensional quadrature rule as the product of K rules
%    for 1D quadrature.
%
%    The product rule will be represented as a list of points and weights.
%
%    The J-th item in the product rule will be associated with
%      item J1 of 1D rule 1,
%      item J2 of 1D rule 2,
%      ...,
%      item JK of 1D rule K.
%
%    In particular,
%      X(J) = ( X(1,J1), X(2,J2), ..., X(K,JK))
%    and
%      W(J) = W(1,J1) * W(2,J2) * ... * W(K,JK)
%
%    So we can construct the quadrature rule if we can properly
%    distribute the information in the 1D quadrature rules.
%
%    This routine carries out that task for the weights W.
%
%    Another way to do this would be to compute, one by one, the
%    set of all possible indices (J1,J2,...,JK), and then index
%    the appropriate information.  An advantage of the method shown
%    here is that you can process the K-th set of information and
%    then discard it.
%
%  Example:
%
%    Rule 1:
%      Order = 4
%      W(1:4) = ( 2, 3, 5, 7 )
%
%    Rule 2:
%      Order = 3
%      W(1:3) = ( 11, 13, 17 )
%
%    Rule 3:
%      Order = 2
%      W(1:2) = ( 19, 23 )
%
%    Product Rule:
%      Order = 24
%      W(1:24) =
%        ( 2 * 11 * 19 )
%        ( 3 * 11 * 19 )
%        ( 4 * 11 * 19 )
%        ( 7 * 11 * 19 )
%        ( 2 * 13 * 19 )
%        ( 3 * 13 * 19 )
%        ( 5 * 13 * 19 )
%        ( 7 * 13 * 19 )
%        ( 2 * 17 * 19 )
%        ( 3 * 17 * 19 )
%        ( 5 * 17 * 19 )
%        ( 7 * 17 * 19 )
%        ( 2 * 11 * 23 )
%        ( 3 * 11 * 23 )
%        ( 5 * 11 * 23 )
%        ( 7 * 11 * 23 )
%        ( 2 * 13 * 23 )
%        ( 3 * 13 * 23 )
%        ( 5 * 13 * 23 )
%        ( 7 * 13 * 23 )
%        ( 2 * 17 * 23 )
%        ( 3 * 17 * 23 )
%        ( 5 * 17 * 23 )
%        ( 7 * 17 * 23 )
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 April 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer FACTOR_INDEX, the index of the factor being processed.
%    The first factor processed must be factor 1.
%
%    Input, integer FACTOR_ORDER, the order of the factor.
%
%    Input, real FACTOR_VALUE(FACTOR_ORDER), the factor values for
%    factor FACTOR_INDEX.
%
%    Input, integer FACTOR_NUM, the number of factors.
%
%    Input, integer POINT_NUM, the number of elements in the direct product.
%
%    Output, real W(POINT_NUM), the elements of the
%    direct product, updated by the latest factor.
%
%  Local Parameters:
%
%    Local, integer START, the first location of a block of values to set.
%
%    Local, integer CONTIG, the number of consecutive values to set.
%
%    Local, integer SKIP, the distance from the current value of START
%    to the next location of a block of values to set.
%
%    Local, integer REP, the number of blocks of values to set.
%
  persistent contig;
  persistent rep;
  persistent skip;

  if ( factor_index == 1 )
    contig = 1;
    skip = 1;
    rep = point_num;
    w(1:point_num) = 1.0;
  end

  rep = rep / factor_order;
  skip = skip * factor_order;

  for j = 1 : factor_order

    start = 1 + ( j - 1 ) * contig;

    for k = 1 : rep
      w(start:start+contig-1) = w(start:start+contig-1) * factor_value(j);
      start = start + skip;
    end

  end

  contig = contig * factor_order;

  return
end
function len = s_len_trim ( s )

%*****************************************************************************80
%
%% S_LEN_TRIM returns the length of a character string to the last nonblank.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 June 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string S, the string to be measured.
%
%    Output, integer LEN, the length of the string up to the last nonblank.
%
  len = length ( s );

  while ( 0 < len )
    if ( s(len) ~= ' ' )
      return
    end
    len = len - 1;
  end

  return
end
function word_num = s_word_count ( s )

%*****************************************************************************80
%
%% S_WORD_COUNT counts the number of "words" in a string.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 January 2006
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string S, the string to be examined.
%
%    Output, integer WORD_NUM, the number of "words" in the string.
%    Words are presumed to be separated by one or more blanks.
%
  FALSE = 0;
  TRUE = 1;

  word_num = 0;
  s_length = length ( s );

  if ( s_length <= 0 )
    return;
  end

  blank = TRUE;

  for i = 1 : s_length

    if ( s(i) == ' ' )
      blank = TRUE;
    elseif ( blank == TRUE )
      word_num = word_num + 1;
      blank = FALSE;
    end

  end

  return
end
function timestamp ( )

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

  return
end


function r = r(kernel)

% R
%
% This method returns an upper bound on
%
%    R > k(x1, x1) - k(x1, x2)
%
% for arbitrary x1 and x2.  For a Gaussian radial basis kernel R = 1.

%
% File        : @rbf/r.m
%
% Date        : Friday 7th July 2000
%
% Author      : Dr Gavin C. Cawley
%
% Description : Part of an object-oriented implementation of Vapnik's Support
%               Vector Machine, as described in [1].
%
% References  : [1] V.N. Vapnik,
%                   "The Nature of Statistical Learning Theory",
%                   Springer-Verlag, New York, ISBN 0-387-94559-8,
%                   1995.
%
% History     : 07/07/2000 - v1.00
%               12/09/2000 - v1.01 minor improvements to comments and help
%                                  messages
%
% Copyright   : (c) Dr Gavin C. Cawley, July 2000
%
%    This program is free software; you can redistribute it and/or modify
%    it under the terms of the GNU General Public License as published by
%    the Free Software Foundation; either version 2 of the License, or
%    (at your option) any later version.
%
%    This program is distributed in the hope that it will be useful,
%    but WITHOUT ANY WARRANTY; without even the implied warranty of
%    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%    GNU General Public License for more details.
%
%    You should have received a copy of the GNU General Public License
%    along with this program; if not, write to the Free Software
%    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
%

r = 1.0;

% bye bye...


%% Theory of Misorientations
%
%%
% Misorientation describe the relative orientation of two crystal with
% respect to each other. Those crystal may be of the same phase or of
% different phases. Misorientation are used to describe

%% Grain Exchange Symmetry

%%
% Misorientation describes the relative orientation of two grains with
% respect to each other. Important concepts are twinnings and
% CSL (coincidence site lattice) misorientations. To illustrate this
% concept at a practical example let us first import some Magnesium EBSD
% data.

mtexdata twins silent

% use only proper symmetry operations
ebsd('M').CS = ebsd('M').CS.properGroup;

% compute grains
grains = calcGrains(ebsd('indexed'),'threshold',5*degree);
CS = grains.CS; % extract crystal symmetry

%%
% Next we plot the grains together with their mean orientation and
% highlight grain 74 and grain 85

plot(grains,grains.meanOrientation,'micronbar','off')

hold on
plot(grains([74,85]).boundary,'edgecolor','w','linewidth',2)
hold off

text(grains([74,85]),{'1','2'})

%%
% After extracting the mean orientation of grain 74 and 85

ori1 = grains(74).meanOrientation;
ori2 = grains(85).meanOrientation;

%%
% we may compute the misorientation angle between both orientations by

angle(ori1, ori2) ./ degree

%%
% Note that the misorientation angle is computed by default modulo crystal
% symmetry, i.e., the angle is always the smallest angles between all
% possible pairs of symmetrically equivalent orientations. In our example
% this means that symmetrisation of one orientation has no impact on the
% angle

angle(ori1, ori2.symmetrise) ./ degree

%%
% The misorientation angle neglecting crystal symmetry can be computed by

angle(ori1, ori2.symmetrise,'noSymmetry')./ degree

%%
% We see that the smallest angle indeed coincides with the angle computed
% before.

%% Misorientations
% Remember that both orientations ori1 and ori2 map crystal coordinates
% onto specimen coordinates. Hence, the product of an inverse orientation
% with another orientation transfers crystal coordinates from one crystal
% reference frame into crystal coordinates with respect to another crystal
% reference frame. This transformation is called misorientation

mori = inv(ori1) * ori2

%%
% In the present case the misorientation describes the coordinate transform
% from the reference frame of grain 85 into the reference frame of crystal
% 74. Take as an example the plane {11-20} with respect to the grain 85.
% Then the plane in grain 74 which alignes parallel to this plane can be
% computed by

round(mori * Miller(1,1,-2,0,CS))

%%
% Conversely, the inverse of mori is the coordinate transform from crystal
% 74 to grain 85.

round(inv(mori) * Miller(2,-1,-1,0,CS))

%% Coincident lattice planes
% The coincidence between major lattice planes may suggest that the
% misorientation is a twinning misorientation. Lets analyse whether there
% are some more alignments between major lattice planes.

%m = Miller({1,-1,0,0},{1,1,-2,0},{1,-1,0,1},{0,0,0,1},CS);
m = Miller({1,-1,0,0},{1,1,-2,0},{-1,0,1,1},{0,0,0,1},CS);

% cycle through all major lattice planes
close all
for im = 1:length(m)
  % plot the lattice planes of grains 85 with respect to the
  % reference frame of grain 74
  plot(mori * m(im).symmetrise,'MarkerSize',10,...
    'DisplayName',char(m(im)),'figSize','large','noLabel','upper')
  hold all
end
hold off

% mark the corresponding lattice planes in the twin
mm = round(unique(mori*m.symmetrise,'noSymmetry'),'maxHKL',6);
annotate(mm,'labeled','MarkerSize',5,'figSize','large','textAboveMarker')

% show legend
legend({},'location','SouthEast','FontSize',13);

%%
% we observe an almost perfect match for the lattice planes {11-20} to
% {-2110} and {1-101} to {-1101} and good coincidences for the lattice
% plane {1-100} to {0001} and {0001} to {0-661}. Lets compute the angles
% explicitly

angle(mori * Miller(1,1,-2,0,CS),Miller(2,-1,-1,0,CS)) / degree
angle(mori * Miller(1,0,-1,-1,CS),Miller(1,-1,0,1,CS)) / degree
angle(mori * Miller(0,0,0,1,CS) ,Miller(1,0,-1,0,CS),'noSymmetry') / degree
angle(mori * Miller(1,1,-2,2,CS),Miller(1,0,-1,0,CS)) / degree
angle(mori * Miller(1,0,-1,0,CS),Miller(1,1,-2,2,CS)) / degree

%% Twinning misorientations
% Lets define a misorientation that makes a perfect fit between the {11-20}
% lattice planes and between the {10-11} lattice planes

mori = orientation.map(Miller(1,1,-2,0,CS),Miller(2,-1,-1,0,CS),...
  Miller(-1,0,1,1,CS),Miller(-1,1,0,1,CS))

% the rotational axis
round(mori.axis)

% the rotational angle
mori.angle / degree

%%
% and plot the same figure as before with the exact twinning
% misorientation.

% cycle through all major lattice planes
close all
for im = 1:length(m)
  % plot the lattice planes of grains 85 with respect to the
  % reference frame of grain 74
  plot(mori * m(im).symmetrise,'MarkerSize',10,...
    'DisplayName',char(m(im)),'figSize','large','noLabel','upper')
  hold all
end
hold off

% mark the corresponding lattice planes in the twin
mm = round(unique(mori*m.symmetrise,'noSymmetry'),'maxHKL',6);
annotate(mm,'labeled','MarkerSize',5,'figSize','large')

% show legend
legend({},'location','NorthWest','FontSize',13);

%% Highlight twinning boundaries
% It turns out that in the previous EBSD map many grain boundaries have a
% misorientation close to the twinning misorientation we just defined. Lets
% Lets highlight those twinning boundaries

% consider only Magnesium to Magnesium grain boundaries
gB = grains.boundary('Mag','Mag');

% check for small deviation from the twinning misorientation
isTwinning = angle(gB.misorientation,mori) < 5*degree;

% plot the grains and highlight the twinning boundaries
plot(grains,grains.meanOrientation,'micronbar','off')
hold on
plot(gB(isTwinning),'edgecolor','w','linewidth',2)
hold off

%%
% From this picture we see that large fraction of grain boudaries are
% twinning boundaries. To make this observation more evident we may plot
% the boundary misorientation angle distribution function. This is simply
% the angle distribution of all boundary misorientations and can be
% displayed with

close all
plotAngleDistribution(gB.misorientation)

%%
% From this we observe that we have about 50 percent twinning boundaries.
% Analogously we may also plot the axis distribution

plotAxisDistribution(gB.misorientation,'contour')

%%
% which emphasises a strong portion of rotations about the (-12-10) axis.

%% Phase transitions
% Misorientations may not only be defined between crystal frames of the
% same phase. Lets consider the phases Magnetite and Hematite.

CS_Mag = loadCIF('Magnetite')
CS_Hem = loadCIF('Hematite')

%%
% The phase transition from Magnetite to Hematite is described in
% literature by {111}_m parallel {0001}_h and {-101}_m parallel {10-10}_h
% The corresponding misorientation is defined in MTEX by

Mag2Hem = orientation.map(...
  Miller(1,1,1,CS_Mag),Miller(0,0,0,1,CS_Hem),...
  Miller(-1,0,1,CS_Mag),Miller(1,0,-1,0,CS_Hem))

%%
% Assume a Magnetite grain with orientation

ori_Mag = orientation.byEuler(0,0,0,CS_Mag)

%%
% Then we can compute all variants of the phase transition by

symmetrise(ori_Mag) * inv(Mag2Hem)

%%
% and the corresponding pole figures by

plotPDF(symmetrise(ori_Mag) * inv(Mag2Hem),...
  Miller({1,0,-1,0},{1,1,-2,0},{0,0,0,1},CS_Hem))


%
%      JAWAHARLAL NEHRU TECHNOLOGICAL UNIVERSITY
%
%
%
%

clear;
clc;
clear all;
close all;
display('           ');
display('           ');

display('           ');
display('               SOME EXPERIMENTS ON IMAGE DENOISING USING WAVELETS ');

display('           ');
display('           ');
display('         RAJA RAO           ');

display('           ');
display('           ');

display('select the image');

display('           1:lena.png');
display('           2:barbara.png');
display('           3:boat.png');
display('           4:house.png');
display('           5:peppers256.png');
display('           6:cameraman.jpg');
display('           ');
display('           7:hyderabad.png');
display('           8:friendgray.jpg');
display('           ');

ss1=input('enter your choice:   ');
switch ss1
    case 1
       f=imread('lena.png');
       %f=imread('babu.jpg');
    case 2
        f=imread('barbara.png');
    case 3
        f=imread('boat.png');
    case 4
        f=imread('house.png');
        case 5
        f=imread('peppers256.png');
    case 6
        f=imread('cameraman.jpg');
    case 7
        f=imread('hyderabad512.png');
    case 8
        f=imread('friendgray.jpg');
end

subplot(2,2,1), imshow(f);title('original image');

display('enter the type of noise:');
display('    1    for salt & pepper');
display('    2    for gaussian');
display('    3    for poisson');
display('    4    for speckle');

ud=input('enter the value:');

switch ud
    case 1
        display('enter the % of noise(Ex:0.2)');
        ud1=input('pls enter:     ');
        g=imnoise(f,'salt & pepper',ud1);
    case 2

%f=imread('peppers256.png');
%subplot(2,2,1),imshow(f);
display('enter the noise varience:  ');
va=input('enter between 0.01 to 0.09:   ');
g=imnoise(f,'gaussian',0,va);
    case 3
       % display('enter the % of noise(Ex:0.2)');
        %ud1=input('pls enter:     ');
        g=imnoise(f,'poisson');
        case 4
        display('enter the varience of noise(Ex:0.02)');
        ud1=input('pls enter:     ');
        g=imnoise(f,'speckle',ud1);

end
%g=imnoise(f,'salt & pepper',01);
subplot(2,2,2),imshow(g);title('noisy image');

%[ca,ch,cv,cd] = dwt2(g,'db2');
%c=[ca ch;cv cd];
%subplot(2,2,3),imshow(uint8(c));

x=g;
% Use wdencmp for image de-noising.
% find default values (see ddencmp).
[thr,sorh,keepapp] = ddencmp('den','wv',x);
display('');
display('select wavelet');
display('enter 1 for haar wavelet');
display('enter 2 for db2 wavelet');
display('enter 3 for db4 wavelet');
display('enter 4 for sym wavelet');
display('enter 5 for sym wavelet');
display('enter 6 for bior wavelet');
display('enter 7 for bior wavelet');
display('enter 8 for mexh wavelet');
display('enter 9 for coif  wavelet');
display('enter 10 for meyr wavelet');
display('enter 11 for morl wavelet');
display('enter 12 for  rbio wavelet');
display('press any key to quit');
display('');

ww=input('enter your choice:    ');
switch ww
    case 1
        wv='haar';
    case 2
        wv='db2';
    case 3
        wv='db4' ;
    case 4
        wv='sym2'
    case 5
        wv='sym4';
    case 6
        wv='bior1.1';
    case 7
       wv='bior6.8';
    case 8
        wv='mexh';
    case 9
        wv='coif5';
    case 10
        wv='dmey';
    case 11
        wv='mor1';
    case 12
        wv='jpeg9.7';
    otherwise
        quit;
end
display('');
display('enter 1 for soft thresholding');
display('enter 2 for hard thresholding');
display('enter 3 for bayes soft thresholding');
sorh=input('sorh:   ');

display('enter the level of decomposition');
level=input(' enter 1 or 2 :    ');

switch sorh
    case 1
        sorh='s';
        xd = wdencmp('gbl',x,wv,level,thr,sorh,keepapp);
    case 2
        sorh='h';
        xd = wdencmp('gbl',x,wv,level,thr,sorh,keepapp);
    case 3
        %%%%%%%%%%%%%%%%%%%%%
       % clear all;
%close all;
%clc;

%Denoising using Bayes soft thresholding

%Note: Figure window 1 displays the original image, fig 2 the noisy img
%fig 3 denoised img by bayes soft thresholding

%Reading the image
%pic=imread('elaine','png');
pic=f;
%figure, imagesc(pic);colormap(gray);

%Define the Noise Variance and adding Gaussian noise
%While using 'imnoise' the pixel values(0 to 255) are converted to double in the range 0 to 1
%So variance also has to be suitably converted
sig=15;
V=(sig/256)^2;
npic=g;
%npic=imnoise(pic,'gaussian',0,V);
%figure, imagesc(npic);colormap(gray);

%Define the type of wavelet(filterbank) used and the number of scales in the wavelet decomp
filtertype=wv;
levels=level;

%Doing the wavelet decomposition
[C,S]=wavedec2(npic,levels,filtertype);

st=(S(1,1)^2)+1;
bayesC=[C(1:st-1),zeros(1,length(st:1:length(C)))];
var=length(C)-S(size(S,1)-1,1)^2+1;

%Calculating sigmahat
sigmahat=median(abs(C(var:length(C))))/0.6745;

for jj=2:size(S,1)-1
    %for the H detail coefficients
    coefh=C(st:st+S(jj,1)^2-1);
    thr=bayes(coefh,sigmahat);
    bayesC(st:st+S(jj,1)^2-1)=sthresh(coefh,thr);
    st=st+S(jj,1)^2;

    % for the V detail coefficients
    coefv=C(st:st+S(jj,1)^2-1);
    thr=bayes(coefv,sigmahat);
    bayesC(st:st+S(jj,1)^2-1)=sthresh(coefv,thr);
    st=st+S(jj,1)^2;

    %for Diag detail coefficients
    coefd=C(st:st+S(jj,1)^2-1);
    thr=bayes(coefd,sigmahat);
    bayesC(st:st+S(jj,1)^2-1)=sthresh(coefd,thr);
    st=st+S(jj,1)^2;
end

%Reconstructing the image from the Bayes-thresholded wavelet coefficients
bayespic=waverec2(bayesC,S,filtertype);
xd=bayespic;
%Displaying the Bayes-denoised image
%figure, imagesc(uint8(bayespic));colormap(gray);
display('IEEE TRANSACTIONS ON IMAGE PROCESSING, VOL. 9, NO. 9, SEPTEMBER 2000');

display('IEEE TRANSACTIONS ON IMAGE PROCESSING, VOL. 9, NO. 9, SEPTEMBER 2000');
display('Adaptive Wavelet Thresholding for Image Denoising and Compression');
display('S. Grace Chang, Student Member, IEEE, Bin Yu, Senior Member, IEEE, and Martin Vetterli, Fellow, IEEE');

        %%%%%%%%%%%%%%%%%%%%%%%%%%

end

%sorh=sorh;
% de-noise image using global thresholding option.

%f=imread('peppers256.png');
[c,s]=wavefast(g,level,wv);
subplot(2,2,3),wave2gray(c,s,8);title('decomposed structure');

subplot(2,2,4),xd=uint8(xd);
imshow(xd);title('denoised image');
%subplot(2,2,4),sub=f-xd;
%sub=abs(1.2*sub);
%imshow(im2uint8(sub));title('difference image');
ff=im2double(f);xdd=im2double(xd);
display('      ');
display('      ');
display('reference: To calcullate signal to noise ratio');
display('Makoto Miyahara');
display('"Objective Picture Quality Scale (PQS) for Image Coding"');
display('IEEE Trans. on Comm., Vol 46, No.9, 1998.');
display('      ');
display('      ');
snr=wpsnr(ff,xdd)

display('      ');
display('      ');
mse=compare11(ff,xdd)


function [ft3] = mi32ft3(mi3)
% Convert volume from cubic miles to cubic feet.
% Chad Greene 2012
ft3 = mi3*147197952000;


function c = tapas_hgf_binary_mab_config
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Contains the configuration for the Hierarchical Gaussian Filter (HGF) in a multi-armded bandit
% situation for binary inputs in the absence of perceptual uncertainty.
%
% The HGF is the model introduced in
%
% Mathys C, Daunizeau J, Friston, KJ, and Stephan KE. (2011). A Bayesian foundation
% for individual learning under uncertainty. Frontiers in Human Neuroscience, 5:39.
%
% The binary HGF model has since been augmented with a positive factor kappa1 which
% scales the second level with respect to the first, i.e., the relation between the
% first and second level is
%
% p(x1=1|x2) = s(kappa1*x2), where s(.) is the logistic sigmoid.
%
% By default, kappa1 is fixed to 1, leading exactly to the model introduced in
% Mathys et al. (2011).
%
% This file refers to BINARY inputs (Eqs 1-3 in Mathys et al., (2011));
% for continuous inputs, refer to tapas_hgf_config.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% The HGF configuration consists of the priors of parameters and initial values. All priors are
% Gaussian in the space where the quantity they refer to is estimated. They are specified by their
% sufficient statistics: mean and variance (NOT standard deviation).
%
% Quantities are estimated in their native space if they are unbounded (e.g., the omegas). They are
% estimated in log-space if they have a natural lower bound at zero (e.g., the sigmas).
%
% Parameters can be fixed (i.e., set to a fixed value) by setting the variance of their prior to
% zero. Aside from being useful for model comparison, the need for this arises whenever the scale
% and origin at the j-th level are arbitrary. This is the case if the observation model does not
% contain the representations mu_j and sigma_j. A choice of scale and origin is then implied by
% fixing the initial value mu_j_0 of mu_j and either kappa_j-1 or omega_j-1.
%
% Fitted trajectories can be plotted by using the command
%
% >> tapas_hgf_binary_mab_plotTraj(est)
%
% where est is the stucture returned by tapas_fitModel. This structure contains the estimated
% perceptual parameters in est.p_prc and the estimated trajectories of the agent's
% representations (cf. Mathys et al., 2011). Their meanings are:
%
%         est.p_prc.mu_0       row vector of initial values of mu (in ascending order of levels)
%         est.p_prc.sa_0       row vector of initial values of sigma (in ascending order of levels)
%         est.p_prc.rho        row vector of rhos (representing drift; in ascending order of levels)
%         est.p_prc.ka         row vector of kappas (in ascending order of levels)
%         est.p_prc.om         row vector of omegas (in ascending order of levels)
%
% Note that the first entry in all of the row vectors will be NaN because, at the first level,
% these parameters are either determined by the second level (mu_0 and sa_0) or undefined (rho,
% kappa, and omega).
%
%         est.traj.mu          mu (rows: trials, columns: levels, 3rd dim: bandits)
%         est.traj.sa          sigma (rows: trials, columns: levels, 3rd dim: bandits)
%         est.traj.muhat       prediction of mu (rows: trials, columns: levels, 3rd dim: bandits)
%         est.traj.sahat       precisions of predictions (rows: trials, columns: levels, 3rd dim: bandits)
%         est.traj.v           inferred variance of random walk (rows: trials, columns: levels)
%         est.traj.w           weighting factors (rows: trials, columns: levels)
%         est.traj.da          volatility prediction errors  (rows: trials, columns: levels)
%         est.traj.ud          updates with respect to prediction  (rows: trials, columns: levels)
%         est.traj.psi         precision weights on prediction errors  (rows: trials, columns: levels)
%         est.traj.epsi        precision-weighted prediction errors  (rows: trials, columns: levels)
%         est.traj.wt          full weights on prediction errors (at the first level,
%                                  this is the learning rate) (rows: trials, columns: levels)
%
% Note that in the absence of sensory uncertainty (which is the assumption here), the first
% column of mu, corresponding to the first level, will be equal to the inputs. Likewise, the
% first column of sa will be 0 always.
%
% Tips:
% - When analyzing a new dataset, take your inputs u and use
%
%   >> est = tapas_fitModel([], u, 'tapas_hgf_binary_mab_config', 'tapas_bayes_optimal_binary_config');
%
%   to determine the Bayes optimal perceptual parameters (given your current priors as defined in
%   this file here, so choose them wide and loose to let the inputs influence the result). You can
%   then use the optimal parameters as your new prior means for the perceptual parameters.
%
% - If you get an error saying that the prior means are in a region where model assumptions are
%   violated, lower the prior means of the omegas, starting with the highest level and proceeding
%   downwards.
%
% - Alternatives are lowering the prior means of the kappas, if they are not fixed, or adjusting
%   the values of the kappas or omegas, if any of them are fixed.
%
% - If the log-model evidence cannot be calculated because the Hessian poses problems, look at
%   est.optim.H and fix the parameters that lead to NaNs.
%
% - Your guide to all these adjustments is the log-model evidence (LME). Whenever the LME increases
%   by at least 3 across datasets, the adjustment was a good idea and can be justified by just this:
%   the LME increased, so you had a better model.
%
% --------------------------------------------------------------------------------------------------
% Copyright (C) 2013-2017 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/>.

% Config structure
c = struct;

% Model name
c.model = 'hgf_binary_mab';

% Number of levels (minimum: 3)
c.n_levels = 3;

% Number of bandits
c.n_bandits = 3;

% Coupling
% This may only be set to true if c.n_bandits is set to 2 above. If
% true, it means that the two bandits' winning probabilities are
% coupled in the sense that they add to 1 and are both updated on
% each trial even though only the outcome for one of them is observed.
c.coupled = false;

% Input intervals
% If input intervals are irregular, the last column of the input
% matrix u has to contain the interval between inputs k-1 and k
% in the k-th row, and this flag has to be set to true
c.irregular_intervals = false;

% Sufficient statistics of Gaussian parameter priors

% Initial mus and sigmas
% Format: row vectors of length n_levels
% For all but the first two levels, this is usually best
% kept fixed to 1 (determines origin on x_i-scale). The
% first level is NaN because it is determined by the second,
% and the second implies neutrality between outcomes when it
% is centered at 0.
c.mu_0mu = [NaN, 0, 1];
c.mu_0sa = [NaN, 0, 0];

c.logsa_0mu = [NaN,   log(0.1), log(1)];
c.logsa_0sa = [NaN,          0,      0];

% Rhos
% Format: row vector of length n_levels.
% Undefined (therefore NaN) at the first level.
% Fix this to zero to turn off drift.
c.rhomu = [NaN, 0, 0];
c.rhosa = [NaN, 0, 0];

% Kappas
% Format: row vector of length n_levels-1.
% Fixing log(kappa1) to log(1) leads to the original HGF model.
% Higher log(kappas) should be fixed (preferably to log(1)) if the
% observation model does not use mu_i+1 (kappa then determines the
% scaling of x_i+1).
c.logkamu = [log(1), log(1)];
c.logkasa = [     0,      0];

% Omegas
% Format: row vector of length n_levels.
% Undefined (therefore NaN) at the first level.
c.ommu = [NaN,  -2,  -6];
c.omsa = [NaN, 4^2, 4^2];

% Gather prior settings in vectors
c.priormus = [
    c.mu_0mu,...
    c.logsa_0mu,...
    c.rhomu,...
    c.logkamu,...
    c.ommu,...
         ];

c.priorsas = [
    c.mu_0sa,...
    c.logsa_0sa,...
    c.rhosa,...
    c.logkasa,...
    c.omsa,...
         ];

% Check whether we have the right number of priors
expectedLength = 3*c.n_levels+2*(c.n_levels-1)+1;
if length([c.priormus, c.priorsas]) ~= 2*expectedLength;
    error('tapas:hgf:PriorDefNotMatchingLevels', 'Prior definition does not match number of levels.')
end

% Model function handle
c.prc_fun = @tapas_hgf_binary_mab;

% Handle to function that transforms perceptual parameters to their native space
% from the space they are estimated in
c.transp_prc_fun = @tapas_hgf_binary_mab_transp;

return;


function sc = patchCorr(imId,pix,ptch,method)

% PATCHCORR  Correlation score of a patch in an image
%   PATCHCORR(IMID,PIX,PATCH,METHOD) computes the correlation score
%   between PATCH and the corresponding patch centered at pixel
%   PIX in the _global_ image Image{IMID}, using METHOD.
%
%   PATCH is a structure containing:
%     I:   Matrix with pixellic values of the patch
%     SI:  Sum of all pixellic values
%     SII: Sum of all squared pixellic values
%
%   METHOD is one of the following strings 'zncc', 'ssd', 'census'
%
%   See also ZNCC, SSD, CENSUS

%   (c) 2005 Joan Sola

% patch size
pSze = size(ptch.I);

% pixel centered image patch
iPatch = pix2patch(imId,pix,pSze(2),pSze(1));

if nargin<4
    method = 'zncc';
end

switch lower(method)
    case 'zncc'
        sc = zncc(...
            ptch.I,iPatch.I,...
            ptch.SI,ptch.SII,...
            iPatch.SI,iPatch.SII);
    case 'ssd'
        sc = ssd(ptch,iPatch);
    case 'census'
        sc = census(ptch,iPatch);
    otherwise
        error('Unknown correlation method.')
end

% ========== End of function - Start GPL license ==========

%   # START GPL LICENSE

%---------------------------------------------------------------------
%
%   This file is part of SLAMTB, a SLAM toolbox for Matlab.
%
%   SLAMTB 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.
%
%   SLAMTB 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 SLAMTB.  If not, see <http://www.gnu.org/licenses/>.
%
%---------------------------------------------------------------------

%   SLAMTB is Copyright:
%   Copyright (c) 2008-2010, Joan Sola @ LAAS-CNRS,
%   Copyright (c) 2010-2013, Joan Sola,
%   Copyright (c) 2014-2015, Joan Sola @ IRI-UPC-CSIC,
%   SLAMTB is Copyright 2009
%   by Joan Sola, Teresa Vidal-Calleja, David Marquez and Jean Marie Codol
%   @ LAAS-CNRS.
%   See on top of this file for its particular copyright.

%   # END GPL LICENSE