%    Copyright (C) 2012      Waves Audio LTD
%    Copyright (C) 2003-2008 Jean-Marc Valin
%
%    File: speex_mdf.m
%    Echo canceller based on the MDF algorithm (see below)
%
%    Redistribution and use in source and binary forms, with or without
%    modification, are permitted provided that the following conditions are
%    met:
%
%    1. Redistributions of source code must retain the above copyright notice,
%    this list of conditions and the following disclaimer.
%
%    2. Redistributions in binary form must reproduce the above copyright
%    notice, this list of conditions and the following disclaimer in the
%    documentation and/or other materials provided with the distribution.
%
%    3. The name of the author may not be used to endorse or promote products
%    derived from this software without specific prior written permission.
%
%    THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
%    IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
%    OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
%    DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT,
%    INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
%    (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
%    SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
%    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
%    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
%    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
%    POSSIBILITY OF SUCH DAMAGE.
%
%    Notes from original mdf.c:
%
%    The echo canceller is based on the MDF algorithm described in:
%
%    J. S. Soo, K. K. Pang Multidelay block frequency adaptive filter,
%    IEEE Trans. Acoust. Speech Signal Process., Vol. ASSP-38, No. 2,
%    February 1990.
%
%    We use the Alternatively Updated MDF (AUMDF) variant. Robustness to
%    double-talk is achieved using a variable learning rate as described in:
%
%    Valin, J.-M., On Adjusting the Learning Rate in Frequency Domain Echo
%    Cancellation With Double-Talk. IEEE Transactions on Audio,
%    Speech and Language Processing, Vol. 15, No. 3, pp. 1030-1034, 2007.
%    http://people.xiph.org/~jm/papers/valin_taslp2006.pdf
%
%    There is no explicit double-talk detection, but a continuous variation
%    in the learning rate based on residual echo, double-talk and background
%    noise.
%
%    Another kludge that seems to work good: when performing the weight
%    update, we only move half the way toward the "goal" this seems to
%    reduce the effect of quantization noise in the update phase. This
%    can be seen as applying a gradient descent on a "soft constraint"
%    instead of having a hard constraint.
%
%    Notes for this file:
%
%    Usage:
%
%       speex_mdf_out = speex_mdf(Fs, u, d, filter_length, frame_size, dbg_var_name);
%
%       Fs                  sample rate
%       u                   speaker signal, column vector in range [-1; 1]
%       d                   microphone signal, column vector in range [-1; 1]
%       filter_length       typically 250ms, i.e. 4096 @ 16k FS
%                           must be a power of 2
%       frame_size          typically 8ms, i.e. 128 @ 16k Fs
%                           must be a power of 2
%       dbg_var_name        internal state variable name to trace.
%                           Default: 'st.leak_estimate'.
%
%    Jonathan Rouach <jonr@waves.com>
%

function  speex_mdf_out = speex_mdf(Fs, u, d, filter_length, frame_size, dbg_var_name)

fprintf('Starting Speex MDF (PBFDAF) algorithm.\n');

st = speex_echo_state_init_mc_mdf(frame_size, filter_length, 1, 1, Fs);

% which variable to trace
if nargin<6
    dbg_var_name = 'st.leak_estimate';
end
dbg = init_dbg(st, length(u));

[e, dbg] = main_loop(st, float_to_short(u), float_to_short(d), dbg);

speex_mdf_out.e = e/32768.0;
speex_mdf_out.var1 = dbg.var1;

    function x = float_to_short(x)
        x = x*32768.0;
        x(x< -32767.5) = -32768;
        x(x>  32766.5) =  32767;
        x = floor(0.5+x);
    end

    function [e, dbg] = main_loop(st, u, d, dbg)

        e = zeros(size(u));
        y = zeros(size(u));

        % prepare waitbar
%         try h_wb = waitbar(0, 'Processing...'); catch; end
        end_point = length(u);

        for n = 1:st.frame_size:end_point
            nStep = floor(n/st.frame_size)+1;

%             if mod(nStep, 128)==0 && update_waitbar_check_wasclosed(h_wb, n, end_point, st.sampling_rate)
%                 break;
%             end

            u_frame = u(n:n+st.frame_size-1);
            d_frame = d(n:n+st.frame_size-1);

            [out, st] = speex_echo_cancellation_mdf(st, d_frame, u_frame);

            e(n:n+st.frame_size-1) = out;
            y(n:n+st.frame_size-1) = d_frame - out;
            dbg.var1(:, nStep) = reshape( eval(dbg_var_name),  numel(eval(dbg_var_name)), 1);

        end

        try close(h_wb); catch; end

    end
    function st = speex_echo_state_init_mc_mdf(frame_size, filter_length, nb_mic, nb_speakers, sample_rate)

        st.K = nb_speakers;
        st.C = nb_mic;
        C=st.C;
        K=st.K;

        st.frame_size = frame_size;
        st.window_size = 2*frame_size;
        N = st.window_size;
        st.M = fix((filter_length+st.frame_size-1)/frame_size);
        M = st.M;
        st.cancel_count=0;
        st.sum_adapt = 0;
        st.saturated = 0;
        st.screwed_up = 0;

        %    /* This is the default sampling rate */
        st.sampling_rate = sample_rate;
        st.spec_average = (st.frame_size)/( st.sampling_rate);
        st.beta0 = (2.0*st.frame_size)/st.sampling_rate;
        st.beta_max = (.5*st.frame_size)/st.sampling_rate;
        st.leak_estimate = 0;

        st.e = zeros(N, C);
        st.x = zeros(N, K);
        st.input = zeros(st.frame_size, C);
        st.y = zeros(N, C);
        st.last_y = zeros(N, C);
        st.Yf = zeros(st.frame_size+1, 1);
        st.Rf = zeros(st.frame_size+1, 1);
        st.Xf = zeros(st.frame_size+1, 1);
        st.Yh = zeros(st.frame_size+1, 1);
        st.Eh = zeros(st.frame_size+1, 1);

        st.X = zeros(N, K, M+1);
        st.Y = zeros(N, C);
        st.E = zeros(N, C);
        st.W = zeros(N, K, M, C);
        st.foreground = zeros(N, K, M, C);
        st.PHI = zeros(frame_size+1, 1);
        st.power = zeros(frame_size+1, 1);
        st.power_1 = ones((frame_size+1), 1);
        st.window = zeros(N, 1);
        st.prop = zeros(M, 1);
        st.wtmp = zeros(N, 1);

        st.window = .5-.5*cos(2*pi*((1:N)'-1)/N);

        %        /* Ratio of ~10 between adaptation rate of first and last block */
        decay = exp(-2.4/M);
        st.prop(1, 1) = .7;
        for i=2:M
            st.prop(i, 1) = st.prop(i-1, 1) * decay;
        end

        st.prop = (.8 * st.prop)./sum(st.prop);

        st.memX = zeros(K, 1);
        st.memD = zeros(C, 1);
        st.memE = zeros(C, 1);
        st.preemph = .9;
        if (st.sampling_rate<12000)
            st.notch_radius = .9;
        elseif (st.sampling_rate<24000)
            st.notch_radius = .982;
        else
            st.notch_radius = .992;
        end

        st.notch_mem = zeros(2*C, 1);
        st.adapted = 0;
        st.Pey = 1;
        st.Pyy = 1;

        st.Davg1 = 0; st.Davg2 = 0;
        st.Dvar1 = 0; st.Dvar2 = 0;
    end

    function dbg = init_dbg(st, len)
        dbg.var1 = zeros(numel(eval(dbg_var_name)), fix(len/st.frame_size));
    end

    function [out, st] = speex_echo_cancellation_mdf(st, in, far_end)

        N = st.window_size;
        M = st.M;
        C = st.C;
        K = st.K;

        Pey_cur = 1;
        Pyy_cur = 1;

        out = zeros(st.frame_size, C);

        st.cancel_count = st.cancel_count + 1;

        ss=.35/M;
        ss_1 = 1-ss;

        for chan = 1:C
            % Apply a notch filter to make sure DC doesn't end up causing problems
            [st.input(:, chan), st.notch_mem(:, chan)] = filter_dc_notch16(in(:, chan), st.notch_radius, st.frame_size, st.notch_mem(:, chan));
            % Copy input data to buffer and apply pre-emphasis
            for i=1:st.frame_size
                tmp32 = st.input(i, chan)- (st.preemph* st.memD(chan));
                st.memD(chan) = st.input(i, chan);
                st.input(i, chan) = tmp32;
            end
        end

        for speak = 1:K
            for i =1:st.frame_size
                st.x(i, speak) = st.x(i+st.frame_size, speak);
                tmp32 = far_end(i, speak) - st.preemph * st.memX(speak);
                st.x(i+st.frame_size, speak) = tmp32;
                st.memX(speak) = far_end(i, speak);
            end
        end

        % Shift memory
        st.X = circshift(st.X, [0, 0, 1]);

        for speak = 1:K
            %  Convert x (echo input) to frequency domain
            % MATLAB_MATCH: we divide by N to get values as in speex
            st.X(:, speak, 1) = fft(st.x(:, speak)) /N;
        end

        Sxx = 0;
        for speak = 1:K
            Sxx = Sxx + sum(st.x(st.frame_size+1:end, speak).^2);
            st.Xf = abs(st.X(1:st.frame_size+1, speak, 1)).^2;
        end

        Sff = 0;
        for chan = 1:C

            %  Compute foreground filter
            st.Y(:, chan) = 0;
            for speak=1:K
                for j=1:M
                    st.Y(:, chan) = st.Y(:, chan) + st.X(:, speak, j) .* st.foreground(:, speak, j, chan);
                end
            end
            % MATLAB_MATCH: we multiply by N to get values as in speex
            st.e(:, chan) = ifft(st.Y(:, chan)) * N;
            st.e(1:st.frame_size, chan) = st.input(:, chan) - st.e(st.frame_size+1:end, chan);
            % st.e : [out foreground | leak foreground ]
            Sff = Sff + sum(abs(st.e(1:st.frame_size, chan)).^2);

        end

        % Adjust proportional adaption rate */
        if (st.adapted)
            st.prop = mdf_adjust_prop (st.W, N, M, C, K);
        end

        % Compute weight gradient */
        if (st.saturated == 0)
            for chan = 1:C
                for speak = 1:K
                    for j=M:-1:1
                        st.PHI = [st.power_1; st.power_1(end-1:-1:2)] .* st.prop(j) .* conj(st.X(:, speak, (j+1))) .* st.E(:, chan);
                        st.W(:, j) = st.W(:, j) + st.PHI;
                    end
                end
            end
        else
            st.saturated = st.saturated -1;
        end

        %FIXME: MC conversion required */
        % Update weight to prevent circular convolution (MDF / AUMDF)
        for chan = 1:C
            for speak = 1:K
                for j = 1:M
                    % This is a variant of the Alternatively Updated MDF (AUMDF) */
                    % Remove the "if" to make this an MDF filter */
                    if (j==1 || mod(2+st.cancel_count,(M-1)) == j)
                        st.wtmp = ifft(st.W(:, speak, j, chan));
                        st.wtmp(st.frame_size+1:N) = 0;
                        st.W(:, speak, j, chan) = fft(st.wtmp);
                    end
                end
            end
        end

        % So we can use power_spectrum_accum */
        st.Yf = zeros(st.frame_size+1, 1);
        st.Rf = zeros(st.frame_size+1, 1);
        st.Xf = zeros(st.frame_size+1, 1);

        Dbf = 0;

        for chan = 1:C
            st.Y(:, chan) = 0;
            for speak=1:K
                for j=1:M
                    st.Y(:, chan) = st.Y(:, chan) + st.X(:, speak, j) .* st.W(:, speak, j, chan);
                end
            end
            % MATLAB_MATCH: we multiply by N to get values as in speex
            st.y(:,chan) = ifft(st.Y(:,chan)) * N;
            % st.y : [ ~ | leak background ]
        end

        See = 0;

        % Difference in response, this is used to estimate the variance of our residual power estimate */
        for chan = 1:C
            st.e(1:st.frame_size, chan) = st.e(st.frame_size+1:N, chan) - st.y(st.frame_size+1:N, chan);
            Dbf = Dbf + 10 + sum(abs(st.e(1:st.frame_size, chan)).^2);
            st.e(1:st.frame_size, chan) = st.input(:, chan) - st.y(st.frame_size+1:N, chan);
            % st.e : [ out background | leak foreground ]
           See = See + sum(abs(st.e(1:st.frame_size, chan)).^2);
        end

        % Logic for updating the foreground filter */

        % For two time windows, compute the mean of the energy difference, as well as the variance */
        VAR1_UPDATE = .5;
        VAR2_UPDATE = .25;
        VAR_BACKTRACK = 4;
        MIN_LEAK = .005;

        st.Davg1 = .6*st.Davg1 + .4*(Sff-See);
        st.Davg2 = .85*st.Davg2 + .15*(Sff-See);
        st.Dvar1 = .36*st.Dvar1 + .16*Sff*Dbf;
        st.Dvar2 = .7225*st.Dvar2 + .0225*Sff*Dbf;

        update_foreground = 0;

        % Check if we have a statistically significant reduction in the residual echo */
        % Note that this is *not* Gaussian, so we need to be careful about the longer tail */
        if (Sff-See)*abs(Sff-See) > (Sff*Dbf)
            update_foreground = 1;
        elseif (st.Davg1* abs(st.Davg1) > (VAR1_UPDATE*st.Dvar1))
            update_foreground = 1;
        elseif (st.Davg2* abs(st.Davg2) > (VAR2_UPDATE*(st.Dvar2)))
            update_foreground = 1;
        end

        % Do we update? */
        if (update_foreground)

            st.Davg1 = 0;
            st.Davg2 = 0;
            st.Dvar1 = 0;
            st.Dvar2 = 0;
            st.foreground = st.W;
            % Apply a smooth transition so as to not introduce blocking artifacts */
            for chan = 1:C
                st.e(st.frame_size+1:N, chan) = (st.window(st.frame_size+1:N) .* st.e(st.frame_size+1:N, chan)) + (st.window(1:st.frame_size) .* st.y(st.frame_size+1:N, chan));
            end
        else
            reset_background=0;
            % Otherwise, check if the background filter is significantly worse */

            if (-(Sff-See)*abs(Sff-See)> VAR_BACKTRACK*(Sff*Dbf))
                reset_background = 1;
            end
            if ((-st.Davg1 * abs(st.Davg1))> (VAR_BACKTRACK*st.Dvar1))
                reset_background = 1;
            end
            if ((-st.Davg2* abs(st.Davg2))> (VAR_BACKTRACK*st.Dvar2))
                reset_background = 1;
            end

            if (reset_background)

                % Copy foreground filter to background filter */
                st.W = st.foreground;

                % We also need to copy the output so as to get correct adaptation */
                for chan = 1:C
                    st.y(st.frame_size+1:N, chan) = st.e(st.frame_size+1:N, chan);
                    st.e(1:st.frame_size, chan) = st.input(:, chan) - st.y(st.frame_size+1:N, chan);
                end

                See = Sff;
                st.Davg1 = 0;
                st.Davg2 = 0;
                st.Dvar1 = 0;
                st.Dvar2 = 0;
            end
        end

        Sey = 0;
        Syy = 0;
        Sdd = 0;

        for chan = 1:C

            % Compute error signal (for the output with de-emphasis) */
            for i=1:st.frame_size
                tmp_out = st.input(i, chan)- st.e(i+st.frame_size, chan);
                tmp_out = tmp_out + st.preemph * st.memE(chan);
                %  This is an arbitrary test for saturation in the microphone signal */
                if (in(i,chan) <= -32000 || in(i,chan) >= 32000)
                    if (st.saturated == 0)
                        st.saturated = 1;
                    end
                end
                out(i, chan) = tmp_out;
                st.memE(chan) = tmp_out;
            end

            % Compute error signal (filter update version) */
            st.e(st.frame_size+1:N, chan) = st.e(1:st.frame_size, chan);
            st.e(1:st.frame_size, chan) = 0;
            % st.e : [ zeros | out background ]

            % Compute a bunch of correlations */
            % FIXME: bad merge */
            Sey = Sey + sum(st.e(st.frame_size+1:N, chan) .* st.y(st.frame_size+1:N, chan));
            Syy = Syy + sum(st.y(st.frame_size+1:N, chan).^2);
            Sdd = Sdd + sum(st.input.^2);

            % Convert error to frequency domain */
            % MATLAB_MATCH: we divide by N to get values as in speex
            st.E = fft(st.e) / N;

            st.y(1:st.frame_size, chan) = 0;
            % MATLAB_MATCH: we divide by N to get values as in speex
            st.Y = fft(st.y) / N;

            % Compute power spectrum of echo (X), error (E) and filter response (Y) */
            st.Rf = abs(st.E(1:st.frame_size+1,chan)).^2;
            st.Yf = abs(st.Y(1:st.frame_size+1,chan)).^2;
        end

        % Do some sanity check */
        if (~(Syy>=0 && Sxx>=0 && See >= 0))
            % Things have gone really bad */
            st.screwed_up = st.screwed_up + 50;
            out = out*0;
        elseif Sff > Sdd+ N*10000
            % AEC seems to add lots of echo instead of removing it, let's see if it will improve */
            st.screwed_up = st.screwed_up + 1;
        else
            % Everything's fine */
            st.screwed_up=0;
        end

        if (st.screwed_up>=50)
            disp('Screwed up, full reset');
            st = speex_echo_state_reset_mdf(st);
        end

        % Add a small noise floor to make sure not to have problems when dividing */
        See = max(See, N* 100);

        for speak = 1:K
            Sxx = Sxx + sum(st.x(st.frame_size+1:end, speak).^2);
            st.Xf = abs(st.X(1:st.frame_size+1, speak, 1)).^2;
        end

        % Smooth far end energy estimate over time */
        st.power = ss_1*st.power+ 1 + ss*st.Xf;

        % Compute filtered spectra and (cross-)correlations */

        Eh_cur = st.Rf - st.Eh;
        Yh_cur = st.Yf - st.Yh;
        Pey_cur = Pey_cur + sum(Eh_cur.*Yh_cur) ;
        Pyy_cur = Pyy_cur + sum(Yh_cur.^2);
        st.Eh = (1-st.spec_average)*st.Eh + st.spec_average*st.Rf;
        st.Yh = (1-st.spec_average)*st.Yh + st.spec_average*st.Yf;

        Pyy = sqrt(Pyy_cur);
        Pey = Pey_cur/Pyy;

        % Compute correlation updatete rate */
        tmp32 = st.beta0*Syy;
        if (tmp32 > st.beta_max*See)
            tmp32 = st.beta_max*See;
        end
        alpha = tmp32/ See;
        alpha_1 = 1- alpha;

        % Update correlations (recursive average) */
        st.Pey = alpha_1*st.Pey + alpha*Pey;
        st.Pyy = alpha_1*st.Pyy + alpha*Pyy;

        if st.Pyy<1
            st.Pyy =1;
        end

        % We don't really hope to get better than 33 dB (MIN_LEAK-3dB) attenuation anyway */
        if st.Pey< MIN_LEAK * st.Pyy
            st.Pey = MIN_LEAK * st.Pyy;
        end

        if (st.Pey> st.Pyy)
            st.Pey = st.Pyy;
        end

        % leak_estimate is the linear regression result */
        st.leak_estimate = st.Pey/st.Pyy;

        % This looks like a stupid bug, but it's right (because we convert from Q14 to Q15) */
        if (st.leak_estimate > 16383)
            st.leak_estimate = 32767;
        end

        % Compute Residual to Error Ratio */
        RER = (.0001*Sxx + 3.*st.leak_estimate*Syy) / See;
        % Check for y in e (lower bound on RER) */
        if (RER < Sey*Sey/(1+See*Syy))
            RER = Sey*Sey/(1+See*Syy);
        end
        if (RER > .5)
            RER = .5;
        end

        % We consider that the filter has had minimal adaptation if the following is true*/
        if (~st.adapted && st.sum_adapt > M && st.leak_estimate*Syy > .03*Syy)
            st.adapted = 1;
        end

        if (st.adapted)
            % Normal learning rate calculation once we're past the minimal adaptation phase */
            for i=1:st.frame_size+1

                % Compute frequency-domain adaptation mask */
                r = st.leak_estimate*st.Yf(i);
                e = st.Rf(i)+1;
                if (r>.5*e)
                    r = .5*e;
                end
                r = 0.7*r + 0.3*(RER*e);
                %st.power_1[i] = adapt_rate*r/(e*(1+st.power[i]));*/
                st.power_1(i) = (r/(e*st.power(i)+10));
            end
        else
            % Temporary adaption rate if filter is not yet adapted enough */
            adapt_rate=0;

            if (Sxx > N* 1000)

                tmp32 = 0.25* Sxx;
                if (tmp32 > .25*See)
                    tmp32 = .25*See;
                end
                adapt_rate = tmp32/ See;
            end
            st.power_1 = adapt_rate./(st.power+10);

            % How much have we adapted so far? */
            st.sum_adapt = st.sum_adapt+adapt_rate;
        end

        % FIXME: MC conversion required */
        st.last_y(1:st.frame_size) = st.last_y(st.frame_size+1:N);
        if (st.adapted)
            % If the filter is adapted, take the filtered echo */
            st.last_y(st.frame_size+1:N) = in-out;
        end

    end

    function [out,mem] = filter_dc_notch16(in, radius, len, mem)
        out = zeros(size(in));
        den2 = radius*radius + .7*(1-radius)*(1-radius);
        for i=1:len
            vin = in(i);
            vout = mem(1) + vin;
            mem(1) = mem(2) + 2*(-vin + radius*vout);
            mem(2) = vin - (den2*vout);
            out(i) = radius*vout;
        end

    end

    function prop = mdf_adjust_prop(W, N, M, C, K)
        prop = zeros(M,1);
        for i=1:M
            tmp = 1;
            for chan=1:C
                for speak=1:K
                    tmp = tmp + sum(abs(W(1:N/2+1, K, i, C)).^2);
                end
            end
            prop(i) = sqrt(tmp);
        end
        max_sum = max(prop, 1);
        prop = prop + .1*max_sum;
        prop_sum = 1+sum(prop);
        prop = .99*prop / prop_sum;
    end

    % Resets echo canceller state */
    function st = speex_echo_state_reset_mdf(st)

        st.cancel_count=0;
        st.screwed_up = 0;
        N = st.window_size;
        M = st.M;
        C=st.C;
        K=st.K;

        st.e = zeros(N, C);
        st.x = zeros(N, K);
        st.input = zeros(st.frame_size, C);
        st.y = zeros(N, C);
        st.last_y = zeros(N, C);
        st.Yf = zeros(st.frame_size+1, 1);
        st.Rf = zeros(st.frame_size+1, 1);
        st.Xf = zeros(st.frame_size+1, 1);
        st.Yh = zeros(st.frame_size+1, 1);
        st.Eh = zeros(st.frame_size+1, 1);

        st.X = zeros(N, K, M+1);
        st.Y = zeros(N, C);
        st.E = zeros(N, C);
        st.W = zeros(N, K, M, C);
        st.foreground = zeros(N, K, M, C);
        st.PHI = zeros(N, 1);
        st.power = zeros(st.frame_size+1, 1);
        st.power_1 = ones((st.frame_size+1), 1);
        st.window = zeros(N, 1);
        st.prop = zeros(M, 1);
        st.wtmp = zeros(N, 1);

        st.memX = zeros(K, 1);
        st.memD = zeros(C, 1);
        st.memE = zeros(C, 1);

        st.saturated = 0;
        st.adapted = 0;
        st.sum_adapt = 0;
        st.Pey = 1;
        st.Pyy = 1;
        st.Davg1 = 0;
        st.Davg2 = 0;
        st.Dvar1 = 0;
        st.Dvar2 = 0;

    end

    function was_closed = update_waitbar_check_wasclosed(h, n, end_point, Fs)
        was_closed = 0;

        % update waitbar
        try
            waitbar(n/end_point, h, ['Processing... ', num2str(n/Fs, '%.2f'), 's / ', num2str(end_point/Fs, '%.2f'), 's' ]);
        catch ME
            % if it's no longer there (closed by user)
            if (strcmp(ME.identifier(1:length('MATLAB:waitbar:')), 'MATLAB:waitbar:'))
                was_closed = 1; % then get out of the loop
            end
        end

    end

end


function varargout = spatialdecomposition3d(x_D,varargin)

if ~check_option(varargin,'voronoi') && size(x_D,1) > 1 %  check_option(varargin,'unitcell') &&

  unitCell = varargin{1};

  dX = abs(2*unitCell([1 13 17]));

  % grid coordinates

  iX = bsxfun(@minus,x_D,min(x_D));
  iX = 1+round(bsxfun(@rdivide,iX,dX));

  sz = max(iX);  %extent, number of voxels in each direction

  % generate a tetragonal unit cell
  id = s2i(sz,iX);
  id = [id(:) id(:)];

  el = []; er = [];
  for dim=1:3
    nX = iX;    pX = iX;
    nX(:,dim) = nX(:,dim)+1;
    pX(:,dim) = pX(:,dim)-1;

    ex = [s2i(sz,nX) s2i(sz,pX)];

    del = pX(:,dim) < 1 | nX(:,dim) > sz(dim);
    el = [el;id(~del,:)];
    er = [er;ex(~del,:)];
  end

  % adjacency of voxels
  varargout{1} = el(:);
  varargout{2} = er(:);
  clear el er
  varargout{3} = sz;
  varargout{4} = dX;
  varargout{5} = min(x_D);

elseif ~check_option(varargin,'voronoi')

  sz = x_D;

  nd = prod(double(sz));
  nf = prod(double(sz+1));

  ind = varargin{1};
  dz = varargin{2};
  lz = double(varargin{3});

  %  adding boundary voxels
  [bind{1} bf{1}] = constr(sz,[0 0 0],0,nf);
  [bind{2} bf{2}] = constr(sz,[1 0 0],0,nf);
  [bind{3} bf{3}] = constr(sz,[0 0 0],2,nf);
  [bind{4} bf{4}] = constr(sz,[0 1 0],2,nf);
  [bind{5} bf{5}] = constr(sz,[0 0 0],4,nf);
  [bind{6} bf{6}] = constr(sz,[0 0 1],4,nf);

  aind = unique([uint32(ind); vertcat(bind{:})]);
  [ix,iy,iz] = ind2sub(sz,aind);
  clear bind

  ixn = ix+1; iyn = iy+1; izn = iz+1; % next voxel index

  % pointels incident to voxels
  VD = [s2i(sz+1,ix,iy,iz) s2i(sz+1,ixn,iy,iz)  s2i(sz+1,ixn,iyn,iz)  s2i(sz+1,ix,iyn,iz) ....
    s2i(sz+1,ix,iy,izn) s2i(sz+1,ixn,iy,izn) s2i(sz+1,ixn,iyn,izn) s2i(sz+1,ix,iyn,izn)];

  % new voxel coordinates
  vind = unique(VD(:));
  [vx,vy,vz] = ind2sub(sz+1,vind);
  varargout{1}(vind,:) = [double(vx-1)*dz(1)-dz(1)/2+lz(1),...
    double(vy-1)*dz(2)-dz(2)/2+lz(2),...
    double(vz-1)*dz(3)-dz(3)/2+lz(3)];
  clear vx vy vz dx dy dz lx ly lz

  % surfels incident to voxel
  FD = [s2i(sz+1,ix,iy,iz) s2i(sz+1,ixn,iy,iz) ...
    s2i(sz+1,ix,iy,iz)+2*nf s2i(sz+1,ix,iyn,iz)+2*nf ...
    s2i(sz+1,ix,iy,iz)+4*nf s2i(sz+1,ix,iy,izn)+4*nf];

  clear ix iy iz ixn iyn izn

  % pointels incident to facets
  tri = [ ...
    8 5 1 4  %4 1 5 8
    2 3 7 6
    5 6 2 1  %1 2 6 5
    3 4 8 7
    1 2 3 4  %4 3 2 1
    5 6 7 8];

  VF = zeros(nf,4,'uint32');
  VF(FD,:) = reshape(VD(:,tri),[],4);
  varargout{2} = VF;
  %   clear VD VF

  id = repmat(double(aind(:)),1,6);
  % surfels as incidence matrix

  FD = double(FD);
  o = ones(size(FD));
  o(:,1:2:6) = -1;

  FD = sparse(FD,id,o,6*nf,nd);
  varargout{3} = FD;

  bf = double(vertcat(bf{:}));

  [F,D,val] = find(FD(bf,:));
  varargout{4} =  sparse(bf(F),D,val,6*nf,nd);

else
  boundary = get_option(varargin,'boundary','cube');

  % extrapolate dummy coordinates %dirty
  if ~check_option(varargin,'3d')
    switch lower(boundary)
      case 'cube'
        v = get_option(varargin,'dx',ceil(nthroot(size(x_D,1),3)));
        a = min(x_D);
        b = max(x_D);
        d = (b-a)./v;

        dx = linspace(a(1),b(1),v);
        dy = linspace(a(2),b(2),v);
        dz = linspace(a(3),b(3),v);

        [x y] = meshgrid(dx,dy);
        z1 = [x(:) y(:)];
        z2 = z1;
        z1(:,3) = a(3)- d(3);
        z2(:,3) = b(3)+ d(3);

        [x z] = meshgrid(dx,dz);
        y1(:,[1 3]) = [x(:) z(:)];
        y2 = y1;
        y1(:,2) = a(2)- d(2);
        y2(:,2) = b(2)+ d(2);

        [y z] = meshgrid(dy,dz);
        x1(:,2:3) = [y(:) z(:)];
        x2 = x1;
        x1(:,1) = a(1)- d(1);
        x2(:,1) = b(1)+ d(1);

        dummy = [x1; x2; y1; y2; z1; z2];
      case 'sphere'
        dx = (max(x_D(:,1)) - min(x_D(:,1)));
        dy = (max(x_D(:,2)) - min(x_D(:,2)));
        dz = (max(x_D(:,3)) - min(x_D(:,3)));

        [x y z] = sphere;

        dummy = [x(:).*dx+dx/2+min(x_D(:,1)) ...
          y(:).*dy+dy/2+min(x_D(:,2)) ...
          z(:).*dz+dz/2+min(x_D(:,3)) ];

        dummy = unique(dummy,'rows');
      otherwise
        error('Uknown boundary type.')
    end
  else
    dx = (max(xy(:,1)) - min(xy(:,1)));
    dy = (max(xy(:,2)) - min(xy(:,2)));
    dz = (max(xy(:,3)) - min(xy(:,3)));

    [x y z] = sphere;

    dummy = [x(:).*dx+dx/2 ...
      y(:).*dy+dy/2 ...
      z(:).*dz+dz/2 ];

    dummy = unique(dummy,'rows');

  end
  n = size(x_D,1);
  x_D = [x_D; dummy];
  [v c] = voronoin(x_D,{'Q7','Q8','Q5','Q3','Qz'});   %Qf {'Qf'} ,{'Q7'}
  c(end-length(dummy)+1:end) = [];

  FD = cell(numel(c),1); VF = FD; % preallocate
  for k=1:numel(c)
    vertex = c{k}; s = [];
    tri = convhulln(v(vertex,:));
    s(1:size(tri,1),1) = k;

    VF{k} = vertex(tri);
    FD{k} = s;
  end

  VF = vertcat(VF{:});
  FD = vertcat(FD{:});
  [VF b faceID] = unique(sort(VF,2),'rows');
  FD = sparse(faceID(:),FD(:),1,max(faceID(:)),n);

  A = triu(FD'*FD,1);
  [varargout{1},varargout{2}] = find(A|A');

  varargout{3} = v;
  varargout{4} = VF;
  varargout{5} = FD;
end

function [bind,bf] = constr(sz,s,d,n)

dx = [1 sz(1)];
dy = [1 sz(2)];
dz = [1 sz(3)];

switch d
  case 0
    dx(~any(s)+1) = dx(any(s)+1);
  case 2
    dy(~any(s)+1) = dy(any(s)+1);
  case 4
    dz(~any(s)+1) = dz(any(s)+1);
end

[bx by bz] = meshgrid(dx(1):dx(2),dy(1):dy(2),dz(1):dz(2));
bind = s2i(sz,bx(:),by(:),bz(:));

[ix,iy,iz] = ind2sub(sz,bind);
bf = s2i(sz+1,ix+s(1),iy+s(2),iz+s(3))+d*n;

function ndx = s2i(sz,ix,iy,iz)
% faster version of sub2ind
if nargin == 4
  ndx = 1 + (ix-1) + (iy-1)*sz(1) +(iz-1)*sz(1)*sz(2);
elseif nargin == 2 && size(ix,2) == 3
  ndx = 1 + (ix(:,1)-1) + (ix(:,2)-1)*sz(1) +(ix(:,3)-1)*sz(1)*sz(2);
end


function [error_M,error_A,P] = compare_2_endmembers(M1,M2,A1,A2,m,n,...
    names,wl,show_figure,options)
%COMPARE_ENDMEMBERS Summary of this function goes here
%   Detailed explanation goes here
if nargin < 9
    show_figure = 0;
end

if nargin < 10
    options = [];
end

A1 = double(A1);

% use_uncertainty = 0;
var_dirs = [];
var_amts = [];

permute_criterion = 'auto';

if isstruct(options)
    arg_set = fieldnames(options);
    for i = 1:length(arg_set)
        eval([arg_set{i},'=options.',arg_set{i},';']);
    end
end

use_uncertainty = ~isempty(var_amts);

if isempty(M1) || isempty(A1) || size(A1,2) < size(A2,2)
    show_endmembers(M2,wl,names);
    show_abundances(A2,m,n);
    if use_uncertainty
        show_uncertainty_range([], M2, var_amts, var_dirs, wl, names, options);
    end

    error_M = [];
    error_A = [];
    P = eye(size(M2,1));
    return;
end

[M,B] = size(M1);

is_real_dataset = 0;
if length(unique(A1(:))) == 2
    is_real_dataset = 1;
end

if strcmp(permute_criterion, 'auto')
    if is_real_dataset
        permute_criterion = 'abundance';
    else
        permute_criterion = 'endmember';
    end
end

%% Permute the endmembers and abundances from the algorithm to accord with
% the ground truth ones.
if strcmp(permute_criterion, 'abundance')
    P = permute_abundances(A1,A2);
    M2_1 = P*M2;
elseif strcmp(permute_criterion, 'endmember')
    [P,M2_1] = permute_endmembers(M1,M2);
end
A2_1 = (P*A2')';

if use_uncertainty
    var_amts = P*var_amts;
    var_dirs = P*var_dirs;
end

%% Plot 2 groups of endmembers and show uncertainty range if possible
if show_figure
    show_uncertainty_range(M1, M2_1, var_amts, var_dirs, wl, names, options);
end

%% Calculate the error
error_A = calc_abundance_error(A1,A2_1);
error_M = nanmean(sqrt(nanmean(abs(M1-M2_1).^2, 2)));

if show_figure
    disp(['Error for A: ',num2str(error_A)]);
    disp(['Error for M: ',num2str(error_M)]);
end

if show_figure
    show_abundances(A2_1,m,n);
end

%% If size(A1,2) < size(A2,2), make the permutation matrix P square
if size(P,1) < size(P,2)
    missings = [];
    for i = 1:size(P,2)
        if all(P(:,i) == 0)
            missings = [missings,i];
        end
    end
    new_P1 = zeros(length(missings), size(P,2));
    for i = 1:length(missings)
        new_P1(i, missings(i)) = 1;
    end
    P = [P;new_P1];
end


function halton_test ( )

%*****************************************************************************80
%
%% HALTON_TEST tests the HALTON library.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    23 October 2008
%
%  Author:
%
%    John Burkardt
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'HALTON_TEST\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '  Test the HALTON library.\n' );

  halton_test01 ( );
  halton_test0125 ( );
  halton_test0126 ();
  halton_test02 ( );
  halton_test025 ( );
  halton_test03 ( );
  halton_test04 ( );
  halton_test045 ( );
  halton_test05( );
  halton_test06 ( );
  halton_test07 ( );
  halton_test08 ( );
  halton_test09 ( );
  halton_test10 ( );

  halton_test11 ( );
  halton_test12 ( );
  halton_test13 ( );
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'HALTON_TEST\n' );
  fprintf ( 1, '  Normal end of execution.\n' );
  fprintf ( 1, '\n' );
  timestamp ( );

  return
end


function varargout = drawDigraph(varargin)
%DRAWDIGRAPH Draw a directed graph, given as a set of vertices and edges.
%
%   drawDigraph(NODES1, NODES2, EDGES)
%   NODES1 are originating vertices
%   NODES2 are destination vertices
%   EDGES is an array, with first column containing index of origin vertex
%   (index in NODES1), and second column containing index of destination
%   vertex (index in NODES2).
%   Edges are drawn with arrows.
%
%   H = drawDigraph(...)
%   return handle to the set of edges.
%

% ------
% Author: David Legland
% E-mail: david.legland@inrae.fr
% Created: 2004-08-17
% Copyright 2004-2022 INRA - TPV URPOI - BIA IMASTE

%% Initialisations

% check number of arguments
if nargin < 3
    help drawDigraph;
    return;
end

% initialisations
sn1 = 'bo';     % nodes are red circles
sn2 = 'ro';     % nodes are red circles

%% process input arguments

% First extract the graph structure
n1 = varargin{1};
n2 = varargin{2};
e  = varargin{3};
varargin = varargin(4:length(varargin));

% extract drawing style
if ~isempty(varargin)
    sn1 = varargin{1};
end

if length(varargin)>1
    sn2 = varargin{2};
end

%% main drawing processing

hold on;

nodes = [n1 ; n2];
e(:,2) = e(:,2)+length(n1);

% Draw a 2 dimensional directed graph

% Draw 2D Edges
%if ~strcmp(se, 'none') & size(e, 1)>0
%    he = plot([n1(e(:,1),1) n2(e(:,2),1)]', [n1(e(:,1),2) n2(e(:,2),2)]', se);
%end
he = drawDirectedEdges(nodes, e);

hn = [];
% Draw 2D nodes
if ~strcmp(sn1, 'none')
    hn = plot(n1(:,1), n1(:,2), sn1);
end

 % Draw 2D nodes
if ~strcmp(sn2, 'none')
    hn = plot(n2(:,1), n2(:,2), sn2);
end

%% format output arguments

if nargout==1
    varargout{1} = he;
end

if nargout==2
    varargout{1} = hn;
    varargout{2} = he;
end


function [h,hcb]=FakeColor(X,Y,Z,varargin)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% function h=FakeColor(X,Y,Z,clims,nc,colmap,plotcb,cbpos)
%
% Work-around for multiple colormaps
%
% ex.:
%     h=FakeColor(time,depth,u)
%     h=FakeColor(time,depth,u,0.6*[-1 1],10,'jet','right')
%     h=FakeColor(time,depth,u,0.6*[-1 1],10,'cool','right')
%
% INPUTS:
% X,Y,Z : Data to contour
% (Optional):
% clims: 1 X 2 vector with color limits [min max]
% nc: # color levels to contour (default 10)
% colmap: Colormap to use (ie 'cool'), default jet
% plotcb: true to plot, false to not plot colorbar
% cbpos: String specifiying position (see the colorbar documentation for
% options)
% Based on code at
% http://figuredesign.blogspot.com/2012/05/multiple-colormaps-in-matlab.html
% , posted by Sally Warner.
% Idea/method credit goes to Nick Beaird and Noel Pelland @ UW for figuring out
% how to do this. I just made it into a (hopefully) easy to use function.%
%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
% AP - UW/APL - 10 Sept 2012
% apickering (at) apl (dot) washington (dot) edu
%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
% Updates:
% 17 Spet 2012 - Make axes width same as if regular colorbar was inserted
% 20 June 2013 - Return handle to colorbar as well as axes
% 27 July 2013 - modified by Marcel Thielmann
%                   -added support for any
%                    colorbar location and changed the colorbar location
%                    identifier so that it complies with MATLAB standards
%                   -added the possibility to provide an own colormap as
%                    input
%                   -removed the axis ij command (can be done outside the
%                    function if desired)
%
% -COMMENT (Marcel Thielmann, 27 July 2013):
% When commands such as axis square are used afterwards, colorbar
% width/height does not fit axis widht/height anymore. I have not managed
% to automatically resize the colorbar once this is done, but the following
% workaround served the purpose (the plotboxpos function can be found on
% the file exchange:
% http://www.mathworks.com/matlabcentral/fileexchange/9615-plotboxpos )
%
% [c,cb] = FakeColor(x,y,z,CLIM,nc,'jet',1,'NorthOutside');
% axis square
% labels
% xlabel(c,'xlabel')
% ylabel(c,'ylabel')
%
% CPOS = plotboxpos(c);
% CBPOS = get(cb,'Position');

% set(cb,'Position',[CPOS(1) CBPOS(2) CPOS(3) CBPOS(4)])

%~~~~~~~~~~~~~~~~~
%%

nvars=numel(varargin);

% defaults if not specified
if nvars==0
    clims=[nanmin(Z(:)) nanmax(Z(:)) ];
    nc=15;
    colmap='jet';
    plotcb=1;
    cbpos='EastOutside';
elseif nvars==1
    clims=varargin{1};
    nc=15;
    colmap='jet';
    plotcb=1;
    cbpos='EastOutside';
elseif nvars==2
    clims=varargin{1};
    nc=varargin{2};
    colmap='jet';
    plotcb=1;
    cbpos='EastOutside';
elseif nvars==3
    clims=varargin{1};
    nc=varargin{2};
    colmap=varargin{3};
    plotcb=1;
    cbpos='EastOutside';
elseif nvars==4
    clims=varargin{1};
    nc=varargin{2};
    colmap=varargin{3};
    plotcb=varargin{4};
    cbpos='EastOutside';
elseif nvars==5
    clims=varargin{1};
    nc=varargin{2};
    colmap=varargin{3};
    plotcb=varargin{4};
    cbpos=varargin{5};
end

cvec=linspace(clims(1),clims(2),nc);

% make a "colormap"
%==============================================
if ischar(colmap)              % one of matlabs own builtin colormap given as string
    tcmap=eval([colmap '(nc)']);
else                           % own colormap given as matrix
    tcmap = zeros(nc,3);
    cvec_all = linspace(clims(1),clims(2),size(colmap,1));
    for i = 1:3
        tcmap(:,i) = interp1(cvec_all,colmap(:,i),cvec);
    end
end

% mimick a pcolor plot using contourf
[~,conhand]=contourf(X,Y,Z,cvec,'linecolor','none');hold on % ,'linecolor','none'
%
%get the patch object handles:
p=get(conhand,'children');
thechild=get(p,'CData');
cdat=cell2mat(thechild);
%
%loop through and manually set facecolor of each patch to the colormap you  made:
for i=1:length(cvec)
    set(p(cdat==cvec(i)),'Facecolor',tcmap(i,:))
end
%
h=gca; % get handle of axes

if plotcb
    %now you need to make a fake colorbar using the same trick:
    %define the colorbar axes location just above the subplot you are working with:

    % Make axes width same as if a regular colorbar was added; this way if
    % other axes have regular colorbars, all plot axes will (hopefully) line up

    cb = colorbar(cbpos);

    % get position of axes and colorbar for later use
    pos= get(gca,'position');
    CBPOS = get(cb,'position');
    cbprop = get(cb);
    % get axis locations and tickmarks for later use
    CBXTICK = get(cb,'XTick');
    CBYTICK = get(cb,'YTick');
    CBXAXLOC = get(cb,'XAxisLocation');
    CBYAXLOC = get(cb,'YAxisLocation');

    colorbar('off')
    set(gca,'position',pos);

    %contourf your fake colorbar:
    hcb             = axes('Position',CBPOS);

    % depending on the location, create a vertical or horizontal colorbar
    if ~isempty(strfind(cbpos,'North')) || ~isempty(strfind(cbpos,'South'))
        [~,conhand]     = contourf(cvec',[0 1],[cvec; cvec],cvec,'linecolor','none');
    else
         [~,conhand]     = contourf([0 1],cvec,[cvec' cvec'],cvec,'linecolor','none');
    end

    p               = get(conhand,'children');
    thechild        = get(p,'CData');
    cdat            = cell2mat(thechild);

    % AGAIN, loop through and manually set facecolor of each patch
    for i=1:length(cvec)
        set(p(cdat==cvec(i)),'Facecolor',tcmap(i,:))
    end
    set(hcb,'xtick',CBXTICK,'ytick',CBYTICK,'xaxislocation',CBXAXLOC,'yaxisLocation',CBYAXLOC)

else
    hcb = NaN;
end

%%


function varargout=resgram(f,varargin)
%RESGRAM  Reassigned spectrogram plot
%   Usage: resgram(f,op1,op2, ... );
%          resgram(f,fs,op1,op2, ... );
%
%   `resgram(f)` plots a reassigned spectrogram of *f*.
%
%   `resgram(f,fs)` does the same for a signal with sampling rate *fs*
%   (sampled with *fs* samples per second).
%
%   Because reassigned spectrograms can have an extreme dynamical range,
%   consider always using the `'dynrange'` or `'clim'` options (see below)
%   in conjunction with the `'db'` option (on by default). An example:::
%
%     resgram(greasy,16000,'dynrange',70);
%
%   This will produce a reassigned spectrogram of the |greasy| signal
%   without drowning the interesting features in noise.
%
%   `C=resgram(f, ... )` returns the image to be displayed as a matrix. Use this
%   in conjunction with `imwrite` etc. These coefficients are **only** intended to
%   be used by post-processing image tools. Reassignment should be done
%   using the |gabreassign| function instead.
%
%   `resgram` accepts the following additional arguments:
%
%
%     'dynrange',r  Limit the dynamical range to *r* by using a colormap in
%                   the interval $[chigh-r,chigh]$, where *chigh* is the highest
%                   value in the plot. The default value of `[]` means to not
%                   limit the dynamical range.
%
%     'db'         Apply `20*log10` to the coefficients. This makes it possible to
%                  see very weak phenomena, but it might show too much noise. A
%                  logarithmic scale is more adapted to perception of sound.
%                  This is the default.
%
%     'sharp',alpha
%                  Set the sharpness of the plot. If $alpha=0$ the regular
%                  spectrogram is obtained. $alpha=1$ means full
%                  reassignment. Anything in between will produce a partially
%                  sharpened picture. Default is $alpha=1$.
%
%     'lin'        Show the energy of the coefficients on a linear scale.
%
%     'tfr',v      Set the ratio of frequency resolution to time resolution.
%                  A value $v=1$ is the default. Setting $v>1$ will give better
%                  frequency resolution at the expense of a worse time
%                  resolution. A value of $0<v<1$ will do the opposite.
%
%     'wlen',s     Window length. Specifies the length of the window
%                  measured in samples. See help of |pgauss| on the exact
%                  details of the window length.
%
%     'posfreq'    Display only the positive frequencies. This is the
%                  default for real-valued signals.
%
%     'nf'         Display negative frequencies, with the zero-frequency
%                  centered in the middle. For real signals, this will just
%                  mirror the upper half plane. This is standard for complex
%                  signals.
%
%     'tc'         Time centering. Move the beginning of the signal to the
%                  middle of the plot. This is useful for visualizing the
%                  window functions of the toolbox.
%
%     'image'      Use `imagesc` to display the spectrogram. This is the
%                  default.
%
%     'clim',clim  Use a colormap ranging from $clim(1)$ to $clim(2)$. These
%                  values are passed to `imagesc`. See the help on `imagesc`.
%
%     'thr',r      Keep only the largest fraction *r* of the coefficients, and
%                  set the rest to zero.
%
%     'fmax',y     Display *y* as the highest frequency. Default value of `[]`
%                  means to use the Nyquist frequency.
%
%     'xres',xres  Approximate number of pixels along x-axis / time.
%                  The default value is 800
%
%     'yres',yres  Approximate number of pixels along y-axis / frequency
%                  The default value is 600
%
%     'contour'    Do a contour plot to display the spectrogram.
%
%     'surf'       Do a surf plot to display the spectrogram.
%
%     'mesh'       Do a mesh plot to display the spectrogram.
%
%     'colorbar'   Display the colorbar. This is the default.
%
%     'nocolorbar'  Do not display the colorbar.
%
%   In addition to these parameters, `sgram` accepts any of the flags from
%   |setnorm|. The window used to calculate the spectrogram will be
%   normalized as specified.
%
%   See also: sgram

%   AUTHOR : Peter L. Søndergaard.
%   TESTING: NA
%   REFERENCE: NA

% BUG: Setting the sharpness different from 1 produces a black line in the
% middle of the plot.

if nargin<1
  error('Too few input arguments.');
end;

if sum(size(f)>1)>1
  error('Input must be a vector.');
end;

definput.import={'ltfattranslate','setnorm','tfplot'};

% Define initial value for flags and key/value pairs.
definput.flags.wlen={'nowlen','wlen'};
definput.flags.thr={'nothr','thr'};
definput.flags.tc={'notc','tc'};
definput.flags.plottype={'image','contour','mesh','pcolor'};

% Override the setting from tfplot, because SGRAM does not support the
% 'dbsq' setting (it does not make sense).
definput.flags.log={'db','lin'};

if isreal(f)
  definput.flags.posfreq={'posfreq','nf'};
else
  definput.flags.posfreq={'nf','posfreq'};
end;

definput.keyvals.sharp=1;
definput.keyvals.tfr=1;
definput.keyvals.wlen=0;
definput.keyvals.thr=0;
definput.keyvals.fmax=[];
definput.keyvals.xres=800;
definput.keyvals.yres=600;

[flags,kv,fs]=ltfatarghelper({'fs','dynrange'},definput,varargin);

if (kv.sharp<0 || kv.sharp >1)
  error(['RESGRAM: Sharpness parameter must be between (including) ' ...
	 '0 and 1']);
end;

% Downsample
if ~isempty(kv.fmax)
  if ~isempty(kv.fs)
    resamp=kv.fmax*2/fs;
  else
    resamp=kv.fmax*2/length(f);
  end;

  f=fftresample(f,round(length(f)*resamp));
  kv.fs=2*kv.fmax;
end;

Ls=length(f);

if flags.do_posfreq
   kv.yres=2*kv.yres;
end;

try
  [a,M,L,N,Ndisp]=gabimagepars(Ls,kv.xres,kv.yres);
catch
  err=lasterror;
  if strcmp(err.identifier,'LTFAT:noframe')
    error(sprintf(['The signal is too long. RESGRAM cannot visualize all the details.\n' ...
                   'Try a shorter signal or increase the image resolution by calling:\n\n' ...
                   '  sgram(...,''xres'',xres,''yres'',yres);\n\n' ...
                   'for larger values of xres and yres.\n'...
                   'The current values are:\n  xres=%i\n  yres=%i'],kv.xres,kv.yres));
  else
    rethrow(err);
  end;
end;

% Set an explicit window length, if this was specified.
if flags.do_wlen
  kv.tfr=kv.wlen^2/L;
end;

g={'gauss',kv.tfr,flags.norm};

[tgrad,fgrad,c]=gabphasegrad('dgt',f,g,a,M);
coef=gabreassign(abs(c).^2,kv.sharp*tgrad,kv.sharp*fgrad,a);

% Cut away zero-extension.
coef=coef(:,1:Ndisp);

if flags.do_thr
  % keep only the largest coefficients.
  coef=largestr(coef,kv.thr);
end

if flags.do_posfreq
  coef=coef(1:floor(M/2)+1,:);
  plotdgtreal(coef,a,M,'argimport',flags,kv);
else
  plotdgt(coef,a,'argimport',flags,kv);
end;

if nargout>0
  varargout={coef};
end;


function varargout = drawLine3d(lin, varargin)
%DRAWLINE3D Draw a 3D line clipped by the current axes
%
%   drawLine3d(LINE) draws the line LINE on the current axis, by clipping
%   with the current axis.
%
%   drawLine3d(LINE, PARAM, VALUE) accepts parameter/value pairs, like
%   for plot function. Color of the line can also be given as a single
%   parameter.
%
%   drawLine3d(AX,...) plots into AX instead of GCA.
%
%   H = drawLine3d(...) returns a handle to the created line object.
%   If the line is not clipped by the axis, function returns -1.
%
%   See also:
%   lines3d, createLine3d, clipLine3d
%
% ---------
% author : David Legland
% INRA - TPV URPOI - BIA IMASTE
% created the 17/02/2005.
%

% Parse and check inputs
isLine3d = @(x) validateattributes(x,{'numeric'},...
    {'nonempty','nonnan','real','finite','size',[nan,6]});
defOpts.Color='b';
[hAx, lin, varargin]=...
    parseDrawInput(lin, isLine3d, 'line', defOpts, varargin{:});

% extract limits of the bounding box
lim = get(hAx, 'xlim');
xmin = lim(1);
xmax = lim(2);
lim = get(hAx, 'ylim');
ymin = lim(1);
ymax = lim(2);
lim = get(hAx, 'zlim');
zmin = lim(1);
zmax = lim(2);

% clip the line with the limits of the current axis
edge = clipLine3d(lin, [xmin xmax ymin ymax zmin zmax]);

% draw the clipped line
if sum(isnan(edge))==0
    h  = drawEdge3d(hAx, edge);
    if ~isempty(varargin)
        set(h, varargin{:});
    end
else
    h  = -1;
end

% process output
if nargout>0
    varargout{1}=h;
end


function [X,Y,Z,CAPS] = extrude(varargin)
% EXTRUDE  Extrude a 2D curve along a 3D path to create
% tubes/cylinders/etc (and, optionally, fly though it!)
%
%   [X,Y,Z] = EXTRUDE(base,traj)
%   [X,Y,Z,CAPS] = EXTRUDE(base,traj,cap)
%   [X,Y,Z,CAPS] = EXTRUDE(base,traj,cap,alg)
%   [X,Y,Z,CAPS] = EXTRUDE(base,traj,cap,alg,fly) returns the surface and
%   handle to the surface plot object created by the 2D base curve and 3D
%   trajectory. SURF(X,Y,Z) can be used to display the object. If cap == 2,
%   data for the caps will be sent separately.
%
%   base = [x;y]   A 2-row Matrix defining the 2d base
%   traj = [x;y;z] A 3-row Matrix defining the 3d path
%   cap = Close off the ends of the tube:
%            0 -> No (default)
%            1 -> Yes
%            2 -> Yes but output them separately into the variable CAPS
%
%   alg = Creation algorithm:
%            1 Creates a natural looking surface with little twist (default)
%            2 More twisty, but preserves orientation vs. direction (which
%              is better for periodicity)
%   fly =  N  Fly through the path generated N times
%
%
%   DEMO: EXTRUDE with no arguments flies through a random periodic path
%         with a star/road/tube cross section using either algorithm
%
%   EXAMPLE 1: Generate a torus:
%
%       q = linspace(0,2*pi,33);
%       base = [cos(q); sin(q)];   % Base curve is a circle (radius = 1)
%       q = linspace(0,2*pi,101);
%       traj = 5*[cos(q); sin(q); 0*q]; %Trajectory is a circle (radius = 5)
%
%       [X,Y,Z] = extrude(base,traj);
%       figure; surf(X,Y,Z); axis equal;
%
%   EXAMPLE 2: Generate half a torus, with nice caps plotted separately:
%
%       q = linspace(0,2*pi,33);
%       base = [cos(q); sin(q)];   % Base curve is a circle (radius = 1)
%       q = linspace(0,pi,101);
%       traj = 5*[cos(q); sin(q); 0*q]; %Trajectory is a semicircle (radius = 5)
%
%       [X,Y,Z,CAPS] = extrude(base,traj,2);    %cap = 2 for separate caps
%       figure; surf(X,Y,Z); axis equal; hold on;
%       surf(CAPS(1).X,CAPS(1).Y,CAPS(1).Z,'linestyle','none');
%       surf(CAPS(2).X,CAPS(2).Y,CAPS(2).Z,'linestyle','none');
%
%
%   EXAMPLE 3: Generate a 3D square tube and fly through it once:
%
%       q = linspace(0,2*pi,5) + pi/4;
%       base = 0.15*[cos(q); sin(q)];   % Base curve is a square
%       t = linspace(0,1,2001);
%       traj = [sin(4*pi*t+1); sin(5*pi*t+2); sin(6*pi*t)];
%
%       [X,Y,Z] = extrude(base,traj,0,[],1);
%       figure; surf(X,Y,Z); axis equal;
%
%   2009-12-25 v3.1     Fixed an error with argument parsing
%   2009-12-18 v3.0     Added an option to close off the ends, and changed
%                       the order of the input arguments.
%   2009-08-20 v2.0     Added a better algorithm that allow for much less
%                       twistiness, a new (simpler) example, and better
%                       error checking.
%   2009-08-20 v1.1     Fixed an error with passing in only 2 arguments and
%                       clearer documentation
%   2009-08-19 v1.0     Initial Creation

%% Process input parameters
if nargin < 2  % Default base = star,   Default path = random
    disp('EXTRUDE DEMO: Fly through a random periodic path.')
    sw =  input('Pick a cross-section: (1)Star (2)Road (3)Tube ? ');
    switch sw
        case 1
            bs = 5; sharp = 0.5; bsize = .1;   %5 pointed star...
            basex = [cos(linspace(0,2*pi,bs+1));
                    sharp*cos(2*pi/2/bs + linspace(0,2*pi,bs+1))];
            basey = [sin(linspace(0,2*pi,bs+1));
                    sharp*sin(2*pi/2/bs + linspace(0,2*pi,bs+1))];
            base = bsize*[basex(1:2*bs+1); basey(1:2*bs+1)];
        case 2
            base = [-1 -1 1 1; 0 -.2 -.2 0]/10;
        case 3
            base = .1*[cos(linspace(0,2*pi,12)); sin(linspace(0,2*pi,12))];
        otherwise
            disp('Pick 1, 2, or 3! Try again.'); return;
    end

    alg = input('Pick an algorithm: (1) Normal (2) Twisty but orientation preserving ? ');
    if alg ~= 1 && alg ~= 2
        disp('Pick 1 or 2! Try again.'); return;
    end

    C = interpft(randn(10,3),1001)'; %Generate a smooth periodic path
    C = [C(:,end) C]; %close the loop
    C = 1*C./max(abs(C(:))); %normalize it
	fly = Inf;   %Fly through it forever
    cap = 0;    % No caps

elseif nargin >= 2;
    fly = []; alg = 1; cap = 0;
    C = varargin{2};
    base = varargin{1};
    if nargin >= 3 && ~isempty(varargin{3}); cap = varargin{3}; end
    if nargin >= 4 && ~isempty(varargin{4}); alg = varargin{4}; end
    if nargin == 5 && ~isempty(varargin{5}); fly = varargin{5}; end
end

% Check size to make size(C) = 3xN
if size(C,2) == 3 && size(C,1) ~= 3
    C = C';
end

% Check size to make size(base) = 2xN
if size(base,2) == 2 && size(base,1) ~= 2
    base = base';
end

%% Calculate derivatives and allocate matrices
npt = size(base,2);
base = [base; zeros(1,npt)];

if size(C,2) >= 3 %Use a 2nd order approximation for the derivatives of the trajectory
    dC = [C(:,1:3)*[-3; 4; -1]/2  [C(:,3:end) - C(:,1:end-2)]/2 C(:,end-2:end)*[1; -4; 3]/2];
else
    dC = C(:,[2 2]) - C(:,[1 1]);
end

dC0 = find(sum(abs(dC),1) == 0,1);    %Check for stagnation points
if ~isempty(dC0)
    warning('Removing stagnation points found in trajectory');
    dCgood = find(sum(abs(dC),1) ~= 0);
    C = C(:,dCgood); %
    dC = dC(:,dCgood); %
end

K = size(dC,2);
SUR = nan(3,npt,K);
camtar = zeros(3,K);
camup = zeros(3,K);
camdata = [[0;0;1],[0;1;0]];
%% Generate and plot the surface

dCvec_prev = [0;0;1];

switch alg
    case 1
        %% Natural Looking Tube (default)
        for k = 1:K
            % We want to rotate [0;0;1] 180degrees around an axis 'z' to become dC

            dCvec = dC(:,k)/norm(dC(:,k));
            z = cross(dCvec_prev,dCvec);

            if norm(z) ~= 0
                z = z/norm(z);
                q = real(acos(dot(dCvec_prev,dCvec)/norm(dCvec_prev)/norm(dCvec)));

                Z = repmat(z,1,npt);
                base = base*cos(q) + cross(Z,base)*sin(q)+Z*(1-cos(q))*diag(dot(Z,base));
                camdata = camdata*cos(q) + cross([z z],camdata)*sin(q)+[z z]*(1-cos(q))*diag(dot([z z],camdata));

                dCvec_prev = dCvec;
            end

            % Data for the camera used in the flying routine
            camtar(:,k) = camdata(:,1);
            camup(:,k) = camdata(:,2);

            SUR(:,:,k) = base + repmat(C(:,k),1,npt);

        end
    case 2
        %% Orientation preserving tube (more twisty but allows for periodicity)
        for k = 1:K
            % We want to rotate [0;0;1] 180degrees around an axis 'z' to become dC
            dCvec = dC(:,k)/norm(dC(:,k));
            if isequal(dCvec,[0;0;-1]) %Prevents a 0/0 = nan
                z = [0;1;0];
            else
                z = ([0; 0; 1] + dCvec)/2; z = z/norm(z);
            end
            z = repmat(z,1,npt);

            % Data for the camera used in the flying routine
            camtar(:,k) = z(:,1)*z(3)*2 - [0;0;1];
            camup(:,k) = z(:,1)*z(2)*2 - [0;1;0];

            SUR(:,:,k) = z*diag(dot(z,base))*2 - base + repmat(C(:,k),1,npt);

        end
    otherwise, error('Algorthm 1 or 2?');
end

CAPS = [];
if cap == 1; % Add caps
    SUR = cat(3,repmat(C(:,1),1,npt),SUR,repmat(C(:,K),1,npt));
end

X = squeeze(SUR(1,:,:));
Y = squeeze(SUR(2,:,:));
Z = squeeze(SUR(3,:,:));

if cap == 2 % Add separate caps
    SURCAP1 = cat(3,SUR(:,:,1),repmat(C(:,1),1,npt));
    SURCAP2 = cat(3,SUR(:,:,K),repmat(C(:,K),1,npt));
    CAPS(1).X = squeeze(SURCAP1(1,:,:));
    CAPS(1).Y = squeeze(SURCAP1(2,:,:));
    CAPS(1).Z = squeeze(SURCAP1(3,:,:));
    CAPS(2).X = squeeze(SURCAP2(1,:,:));
    CAPS(2).Y = squeeze(SURCAP2(2,:,:));
    CAPS(2).Z = squeeze(SURCAP2(3,:,:));
end

if isempty(fly) || fly <= 0
    return
end

if exist('sw','var') %If in DEMO mode, make two figures
    surf(X,Y,Z);
    axis equal;
end

curfig = figure;
h = surf(X,Y,Z);
axis equal;

%% Fix any NaN's (This should not happen...)
xisnan = find(isnan(X(1,:)), 1);
xnotnan = find(~isnan(X(1,:)));
if ~isempty(xisnan)
    warning('NaN''s found');
    X = X(:,xnotnan);
    Y = Y(:,xnotnan);
    Z = Z(:,xnotnan);
    camup = camup(:,xnotnan);
    camtar = camtar(:,xnotnan);
    C = C(:,xnotnan);
end

%% Fly through it
set(h,'facealpha',0.5,'edgecolor','flat'); colormap(hsv); %Make it look nice
set(gca,'visible','off','projection','perspective');
set(gcf,'color','k');
set(gcf,'closerequestfcn','assignin(''caller'',''stopme'',1); delete(gcbf)'); % Stop the loop when closing the figure
h = gcf;
K = size(C,2);
k = 0;
laps = 1;
stopme = 0;

while laps <= ceil(fly) && gcf == curfig && stopme == 0
    k = 1 + mod(k,K);  %Increment k but loop from K back to 1

    set(gca,'cameraviewangle',150);
    set(gcf,'name',['Lap ' num2str(laps) '/' num2str(fly) '  ' num2str(k) '/' num2str(K) '   Close the figure to stop.']);
    set(gca,'cameraposition',C(:,k),'cameratarget',C(:,k)+camtar(:,k),'cameraupvector',camup(:,k));
    drawnow;

    if k == K; laps=laps+1; end;

end
try close(h); catch; end; % If the figure remains after leaving the while loop


function Z = and(X,Y)
%AND Logical AND (&) for tensors.
%
%   See also TENSOR.
%
%MATLAB Tensor Toolbox.
%Copyright 2015, Sandia Corporation.

% This is the MATLAB Tensor Toolbox by T. Kolda, B. Bader, and others.
% http://www.sandia.gov/~tgkolda/TensorToolbox.
% Copyright (2015) Sandia Corporation. Under the terms of Contract
% DE-AC04-94AL85000, there is a non-exclusive license for use of this
% work by or on behalf of the U.S. Government. Export of this data may
% require a license from the United States Government.
% The full license terms can be found in the file LICENSE.txt

Z = tenfun(@and,X,Y);


function varargout = imHistogram(img, varargin)
%IMHISTOGRAM  Histogram of 2D/3D grayscale or color images
%
%   Usage
%   H = imHistogram(IMG);
%   imHistogram(IMG);
%
%   Description
%   H = imHistogram(IMG);
%   Compute the histogram of the image IMG. IMG can be a 2D or 3D image.
%   The number of bins is computed automatically depending on image type
%   for integer images, and on image min/max values for floating-point
%   images.
%   If IMG is a color image, the result is a N-by-3 array, containing
%   histograms for the red, green and blue bands in each column.
%
%   H = imHistogram(..., N);
%   Specifies the number of histogram bins. N must be a scalar>0.
%
%   H = imHistogram(..., [GMIN GMAX]);
%   Specifies the gray level extents. This can e especially useful for
%   images stored in float, or for images with more than 256 gray levels.
%
%   H = imHistogram(..., []);
%   Forces the function to compute the histogram limits from values of
%   image gray levels.
%
%   H = imHistogram(..., BINS);
%   Specifies the bin centers.
%
%   H = imHistogram(..., ROI);
%   where ROI is a binary image the same size as IMG, computes the
%   histogram only for pixels/voxels located inside of the specified region
%   of interest.
%
%   [H X] = imHistogram(...);
%   Returns the center of bins used for histogram computation.
%
%   imHistogram(IMG);
%   When called with no output argument, displays the histogram on the
%   current axis.
%
%
%   Examples
%   % Histogram of a grayscale image (similar to imhist)
%     img = imread('cameraman.tif');
%     imHistogram(img);
%
%   % RGB Histogram of a color image
%     img = imread('peppers.png');
%     imHistogram(img);
%
%   % Compute histogram of a 3D image, only for pixel with non null values
%   % (requires image processing toolbox)
%     info = analyze75info('brainMRI.hdr');
%     X = analyze75read(info);
%     imHistogram(X, X>0, 0:88)
%
%   See also
%   imhist, hist
%
% ------
% Author: David Legland
% e-mail: david.legland@grignon.inra.fr
% Created: 2010-01-27,    using Matlab 7.9.0.529 (R2009b)
% Copyright 2010 INRA - Cepia Software Platform.

% HISTORY
% 2010-09-10 code cleanup, update doc

%% Initialise default parameters

% check if image is color
colorImage = size(img, 3)==3;

% compute intensity bounds, based either on type or on image data
if isinteger(img)
    type = class(img);
    minimg = intmin(type);
    maximg = intmax(type);
else
    minimg = min(img(:));
    maximg = max(img(:));
end

% default number of histogram bins
N = 256;

% default roi is empty
roi = [];

%% Process inputs

% process each argument
while ~isempty(varargin)
    var = varargin{1};

    if isempty(var)
        % if an empty variable is given, assumes gray level bounds must be
        % recomputed from image values
        minimg = min(img(:));
        maximg = max(img(:));
    elseif isnumeric(var) && length(var)==1
        % argument is number of bins
        N = var;
    elseif isnumeric(var) && length(var)==2
        % argument is min and max of values to compute
        minimg = var(1);
        maximg = var(2);
    elseif islogical(var)
        % argument is a ROI
        roi = var;
    elseif isnumeric(var)
        % argument is value for histo bins
        x = var;
        minimg = var(1);
        maximg = var(end);
        N = length(x);
    end

    % remove processed argument from the list
    varargin(1) = [];
end

% compute bin centers if they were not specified
if ~exist('x', 'var')
    x = linspace(double(minimg), double(maximg), N);
end

%% Main processing

% compute image histogram
if ~colorImage
    % process 2D or 3D grayscale image
    h = calcHistogram(img, x, roi);
else
    % process color image: compute histogram of each channel
    h = zeros(length(x), 3);
    if ndims(img)==3
        % process 2D color image
        for i=1:3
            h(:, i) = calcHistogram(img(:,:,i), x, roi);
        end
    else
        % process 3D color image
        for i=1:3
            h(:, i) = calcHistogram(img(:,:,i,:), x, roi);
        end
    end
end

%% Process output arguments

% In case of no output argument, display the histogram
if nargout==0
    % display histogram in current axis
    if ~colorImage
        % Display grayscale histogram
        bar(gca, x, h, 'hist');
        % use jet color to avoid gray display
        colormap jet;
    else
        % display each color histogram as stairs, to see the 3 curves
        hh = stairs(gca, x, h);

        % setup curve colors
        set(hh(1), 'color', [1 0 0]); % red
        set(hh(2), 'color', [0 1 0]); % green
        set(hh(3), 'color', [0 0 1]); % blue
    end

    % setup histogram bounds
    xlim([minimg maximg]);

elseif nargout==1
    % return histogram
    varargout = {h};
elseif nargout==2
    % return histogram and x placement
    varargout = {h, x};
elseif nargout==3
    % return red, green and blue histograms as separate outputs
    varargout = {h(:,1), h(:,2), h(:,3)};
elseif nargout==4
    % return red, green and blue histograms as separate outputs as well as
    % the bin centers
    varargout = {h(:,1), h(:,2), h(:,3), x};
end

%% Utilitary functions

function h = calcHistogram(img, x, roi)
% Compute image histogram using specified bins, and eventually a region of
% interest
if isempty(roi)
    % histogram of whole image
    h = hist(double(img(:)), x);
else
    % histogram constrained to ROI
    h = hist(double(img(roi)), x);
end


function [v,varargout] = load(fname,varargin)
% import directions
%
% Description
%
% vector3d.load is a high level method for importing vector data from
% external files. It autodetects the format of the file. As parameters the
% method requires a filename and the column positions of either the x, y, z
% coordinates or the polar angles
%
% Syntax
%   v = vector3d.load(fname,'ColumnNames',{'x','y','z'})
%   v = vector3d.load(fname,'ColumnNames',{'latitude','longitude'})
%   v = vector3d.load(fname,'ColumnNames',{'polar angle','azimuth'},'columns',[2,3])
%
% Input
%  fname - file name (text files only)
%
% Options
%  columnNames       - names of the colums to be imported
%  columns           - postions of the columns to be imported
%  radians           - treat input in radiand
%  delimiter         - delimiter between numbers
%  interface  - specific interface to be used
%
% Output
%  v - @vector3d
%
% See also
%

if iscell(fname), fname = fname{1};end

%  determine interface
if check_option(varargin,'interface')
  interface = get_option(varargin,'interface');
  options = delete_option(varargin,'interface',1);
  if isempty(interface), return; end
elseif check_option(varargin,'columnames')
  interface = 'generic';
  options = varargin;
else
  [interface,options] = check_interfaces(fname,'Vector3d',varargin{:});
end

% load tensor
[v,varargout{1:nargout-1}] = feval(['loadVector3d_',char(interface)],fname,options{:});


function rs = predict2(s, dim, delay, len, nnr, mode, metric_lambda)

%tstoolbox/@signal/predict2
%   Syntax:
%     * rs = predict2(s, len, nnr, step, mode)
%
%   Input arguments:
%     * len - length of prediction (number of output values)
%     * nnr - number of nearest neighbors to use (default is one)
%     * step - stepsize (in samples) (default is one)
%     * mode:
%          + 0 = Output vectors are the mean of the images of the nearest
%            neighbors
%          + 1 = Output vectors are the distance weighted mean of the
%            images of the nearest neighbors
%          + 2 = Output vectors are calculated based on the local flow
%            using the mean of the images of the neighbors
%          + 3 = Output vectors are calculated based on the local flow
%            using the weighted mean of the images of the neighbors
%
%   Local constant iterative prediction for phase space data (e.g. data
%   stemming from a time delay reconstruction of a scalar time series),
%   using fast nearest neighbor search. Four methods of computing the
%   prediction output are possible.
%
% Copyright 1997-2001 DPI Goettingen, License http://www.physik3.gwdg.de/tstool/gpl.txt

narginchk(4,6);

if nargin < 5, nnr = 1; end
if nargin < 6, mode = 0; end
if nargin < 7, metric_lambda = 1; end

c = predict2(data(s), dim, delay, len, nnr, mode, metric_lambda); 	% do the prediction in phase space

c = c(:,1);

rs = signal(core(c), s);
a = getaxis(rs, 1);
rs = setaxis(rs, 1, a);
rs = cut(rs, 1, dlens(s,1)+1, dlens(rs, 1));
rs = addhistory(rs,  'Local constant prediction for scalar time series');
rs = addcommandlines(rs, 's = predict2(s', dim, delay, len, nnr, mode);


function M_hat = run_mc(params)
  M = params.M;
  Idx = params.Idx;
  maxrank = 1;
  maxCycles = 100;
  step_size = 0.1;
  [numr,numc] = size(M);
  [Usg,Vsg,err_reg] = grouse(M,Idx,numr,numc,maxrank,step_size,maxCycles);
  M_hat = Usg*Vsg';
end


function [boxes, blobIndIm, blobIndBoxes, hierarchy] = selective_search_boxes(im, fast_mode, im_width)
% Girshick Wrapper
%
% Based on the demo.m file included in the Selective Search
% IJCV code.
%
% Requires selective search code.

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

originalImSize = size(im);

if ~exist('im_width', 'var') || isempty(im_width)
  im_width = [];
  scale = 1;
else
  scale = size(im, 2) / im_width;
end

if scale ~= 1
  im = imresize(im, [NaN im_width]);
end

% Parameters. Note that this controls the number of hierarchical
% segmentations which are combined.
colorTypes = {'Hsv', 'Lab', 'RGI', 'H', 'Intensity'};

% Here you specify which similarity functions to use in merging
simFunctionHandles = {@SSSimColourTextureSizeFillOrig, ...
                      @SSSimTextureSizeFill, ...
                      @SSSimBoxFillOrig, ...
                      @SSSimSize};

% Thresholds for the Felzenszwalb and Huttenlocher segmentation algorithm.
% Note that by default, we set minSize = k, and sigma = 0.8.
% controls size of segments of initial segmentation.
ks = [50 100 150 300];
sigma = 0.8;

% After segmentation, filter out boxes which have a width/height smaller
% than minBoxWidth (default = 20 pixels).
minBoxWidth = 20;

% Comment the following three lines for the 'quality' version
if fast_mode
  colorTypes = colorTypes(1:2); % 'Fast' uses HSV and Lab
  simFunctionHandles = simFunctionHandles(1:2); % Two different merging strategies
  ks = ks(1:2);
end

idx = 1;
for j = 1:length(ks)
  k = ks(j); % Segmentation threshold k
  minSize = k; % We set minSize = k
  for n = 1:length(colorTypes)
    colorType = colorTypes{n};
    [boxesT{idx} blobIndIm{idx} blobIndBoxes{idx} hierarchy{idx} priorityT{idx}] = ...
      Image2HierarchicalGrouping(im, sigma, k, minSize, colorType, simFunctionHandles);
    idx = idx + 1;
  end
end
boxes = cat(1, boxesT{:}); % Concatenate boxes from all hierarchies
priority = cat(1, priorityT{:}); % Concatenate priorities

% Do pseudo random sorting as in paper
priority = priority .* rand(size(priority));
[priority sortIds] = sort(priority, 'ascend');
boxes = boxes(sortIds,:);

boxes = BoxRemoveDuplicates(boxes);

if scale ~= 1
  boxes = floor((boxes - 1) * scale + 1);
  for iii = 1:length(blobIndBoxes)
    blobIndBoxes{iii} = floor((blobIndBoxes{iii} - 1) * scale + 1);
    blobIndIm{iii} = imresize(blobIndIm{iii}, [originalImSize(1) originalImSize(2)], 'nearest');
  end
end

% Filter width of boxes
[nr, nc] = BoxSize(boxes);
idsGood = (nr >= minBoxWidth) & (nc >= minBoxWidth);
boxes = boxes(idsGood,:);


function [ rgb ] = jmol_color( Z )
%JMOL_COLOR Get color assigned to an element.
%   rgb = JMOL_COLOR(Z) returns a vector containing the RGB color assigned
%   to the element with atomic number Z. See
%   http://jmol.sourceforge.net/jscolors/
%
%   rgb = JMOL_COLOR(symbol) returns a vector containing the RGB color
%   assigned to the element with the given chemical symbol

    if ischar(Z)
        Z = chemsym2number(Z);
    end

    colors = [...
     [255,255,255];... H
     [217,255,255];... He
     [204,128,255];... Li
     [194,255,0];... Be
     [255,181,181];... B
     [144,144,144];... C
     [48,80,248];... N
     [255,13,13];... O
     [144,224,80];... F
     [179,227,245];... Ne
     [171,92,242];... Na
     [138,255,0];... Mg
     [191,166,166];... Al
     [240,200,160];... Si
     [255,128,0];... P
     [255,255,48];... S
     [31,240,31];... Cl
     [128,209,227];... Ar
     [143,64,212];... K
     [61,255,0];... Ca
     [230,230,230];... Sc
     [191,194,199];... Ti
     [166,166,171];... V
     [138,153,199];... Cr
     [156,122,199];... Mn
     [224,102,51];... Fe
     [240,144,160];... Co
     [80,208,80];... Ni
     [200,128,51];... Cu
     [125,128,176];... Zn
     [194,143,143];... Ga
     [102,143,143];... Ge
     [189,128,227];... As
     [255,161,0];... Se
     [166,41,41];... Br
     [92,184,209];... Kr
     [112,46,176];... Rb
     [0,255,0];... Sr
     [148,255,255];... Y
     [148,224,224];... Zr
     [115,194,201];... Nb
     [84,181,181];... Mo
     [59,158,158];... Tc
     [36,143,143];... Ru
     [10,125,140];... Rh
     [0,105,133];... Pd
     [192,192,192];... Ag
     [255,217,143];... Cd
     [166,117,115];... In
     [102,128,128];... Sn
     [158,99,181];... Sb
     [212,122,0];... Te
     [148,0,148];... I
     [66,158,176];... Xe
     [87,23,143];... Cs
     [0,201,0];... Ba
     [112,212,255];... La
     [255,255,199];... Ce
     [217,255,199];... Pr
     [199,255,199];... Nd
     [163,255,199];... Pm
     [143,255,199];... Sm
     [97,255,199];... Eu
     [69,255,199];... Gd
     [48,255,199];... Tb
     [31,255,199];... Dy
     [0,255,156];... Ho
     [0,230,117];... Er
     [0,212,82];... Tm
     [0,191,56];... Yb
     [0,171,36];... Lu
     [77,194,255];... Hf
     [77,166,255];... Ta
     [33,148,214];... W
     [38,125,171];... Re
     [38,102,150];... Os
     [23,84,135];... Ir
     [208,208,224];... Pt
     [255,209,35];... Au
     [184,184,208];... Hg
     [166,84,77];... Tl
     [87,89,97];... Pb
     [158,79,181];... Bi
     [171,92,0];... Po
     [117,79,69];... At
     [66,130,150];... Rn
     [66,0,102];... Fr
     [0,125,0];... Ra
     [112,171,250];... Ac
     [0,186,255];... Th
     [0,161,255];... Pa
     [0,143,255];... U
     [0,128,255];... Np
     [0,107,255];... Pu
     [84,92,242];... Am
     [120,92,227];... Cm
     [138,79,227];... Bk
     [161,54,212];... Cf
     [179,31,212];... Es
     [179,31,186];... Fm
     [179,13,166];... Md
     [189,13,135];... No
     [199,0,102];... Lr
     [204,0,89];... Rf
     [209,0,79];... Db
     [217,0,69];... Sg
     [224,0,56];... Bh
     [230,0,46];... Hs
     [235,0,38];... Mt
     ];

    rgb = colors(Z,:);

end


function [P, V, A] = extremePools(model, positivity, inequality)
% Calculates the extreme pools of a stoichiometric model using the vertex / facet enumeration package
%
% INPUT:
%    model:                structure with:
%
%                            * .S - `m x n` Stoichiometric matrix with integer coefficients. If no
%                              other inputs are specified it is assumed that all reactions are
%                              reversible and `S.v = 0`
%                            * .SIntRxnBool - `n x 1` boolean vector with 1 for internal reactions
%                            * .description - description
%
% OPTIONAL INPUT:
%    positivity:           {0, (1)} if `positivity == 1`, then positive orthant base
%    inequality:           {(0), 1} if `inequality == 1`, then use two inequalities rather than a single equaltiy
%
% .. Author: - lrs by David Avis, McGill University

[nMet, nRxn] = size(model.S);

if isfield(model, 'SIntRxnBool')
    A = model.S(:, model.SIntRxnBool)';
else
    A = model.S';
end

if nnz(A - round(A))
    figure
    spy(A - round(A))
    title('S-round(S)')
    error('Stoichiometric coefficients must be all integers')
end

a = zeros(size(A, 1),1);

if isfield(model, 'description')
    filename = model.description;
else
    filename = 'model';
end

if ~exist('positivity', 'var')
    positivity = 1;
end
if ~exist('inequality', 'var')
    inequality = 0;
end

suffix = '';
if positivity
    suffix = [suffix 'pos_'];
else
    suffix = [suffix 'neg_'];
end
if inequality
    suffix = [suffix 'ineq'];
else
    suffix = [suffix 'eq'];
end

% no inequalities
D = [];
d = [];

% no linear objective
f = [];

% no shell script
sh = 0;

% INPUT
% A          matrix of linear equalities A*x=(a)
% D          matrix of linear inequalities D*x>=(d)
% filename   base name of output file
%
% OPTIONAL INPUT
% positivity {0,(1)} if positivity==1, then positive orthant base
% inequality {0,(1)} if inequality==1, then use two inequalities rather than a single equaltiy
% a          boundry values for matrix of linear equalities A*x=a
% d          boundry values for matrix of linear inequalities D*x>=d
% f          linear objective for a linear optimization problem in rational arithmetic
%            minimise     f'*x
%            subject to   A*x=(a)
%                         D*x>=(d)
lrsInputHalfspace(A, D, filename, positivity, inequality, a, d, f, sh);

% pause(eps)
[status, result] = system('which lrs');
if ~isempty(result)
    % call lrs and wait until extreme pathways have been calculated
    systemCallText = ['lrs ' pwd filesep filename '_' suffix '.ine > ' pwd filesep filename '_' suffix '.ext'];
    [status, result] = system(systemCallText);
else
    error('lrs not installed or not in path')
end

[P, V] = lrsOutputReadRay([filename '_' suffix '.ext']);
P = P';
A = A';
if any(any(P * A ~= 0))
    warning('extreme pool not in nullspace of stoichiometric matrix')
end


function [coeff,resp,modelCI,medianHR] = computeModelCoefficientsTime_HN(X,Y,censoring,seed)
% -------------------------------------------------------------------------
% function [coeff,resp,modelCI] = computeModelCoefficients(X,Y,imbalance,batchNum)
% -------------------------------------------------------------------------
% DESCRIPTION:
% This function computes the final model logistic regression coefficients
% using bootstrap resampling, and it associated multivariable model
% response and bootstrap confidence intervals. See ref. [1] for more
% details. This function uses logistic regression utilities from DREES
% <http://www.cerr.info/drees>, as well as a rounding function written by
% Francois Beauducel available at:
% <http://www.mathworks.com/matlabcentral/fileexchange/26212-round-with-significant-digits>
% -------------------------------------------------------------------------
% 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
% [2] Vallieres, M. et al. (2015).
% -------------------------------------------------------------------------
% INPUTS:
% - X: Matrix of size [nInst X nFeat], specifying the numerical data of the
%      features of the input features, where 'nInst' refers to the number
%      of instances in X, and 'nFeat' to the number of features in X.
%      Each column is a different feature.
% - Y: Column vector of size [nInst X 1] specifying the outcome status
%      (1 or 0) for all instances.
% - imbalance: String specifying the type of imbalance-adjustement strategy
%              employed. Either 'IABR' for imbalance-adjusted bootstrap
%              resampling (see ref.[1]), or 'IALR' for imbalance-adjusted
%              logistic regression (see ref.[2]).
% - batchNum: (optional input). If present, integer that specifies the
%             batch number for parallelization purposes.
% -------------------------------------------------------------------------
% OUTPUTS:
% - coeff: Column vector of size [nCoeff+1 X 1] specifying the final
%          logistic regression coefficients. Last entry specify the offset
%          of the model.
% - resp: Column vector of size [nInst X 1] specifying the linear
%         multivariable model response when 'coeff' is applied to 'X'.
% - modelCI: Column vector of size [nInst X 2] specifying the 95%
%            confidence interval on the multivariable model response as
%            defined by the 2.5 (modelCI(i,1)) and the 97.5 (modelCI(i,2))
%            percentiles, for the ith instance. See ref. [1] for more
%            details.
% -------------------------------------------------------------------------
% AUTHOR(S):
% - Martin Vallieres <mart.vallieres@gmail.com>
% - DREES development team <http://www.cerr.info/drees> (logistic regression)
% - Francois Beauducel (roundsd.m)
% -------------------------------------------------------------------------
% HISTORY:
% - Creation: May 2015
% - Revision I: July 2015 (including imbalance-adjusted logistic regression)
%--------------------------------------------------------------------------
% 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
% --> Copyright 2010, Joseph O. Deasy, on behalf of the DREES development team.
%
%    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/>.
%
%    _______________________________________________________________
%
% --> Copyright (c) 2015, François Beauducel
%     All rights reserved.
%
% Redistribution and use in source and binary forms, with or without
% modification, are permitted provided that the following conditions are
% met:
%
%     * Redistributions of source code must retain the above copyright
%       notice, this list of conditions and the following disclaimer.
%     * Redistributions in binary form must reproduce the above copyright
%       notice, this list of conditions and the following disclaimer in
%       the documentation and/or other materials provided with the distribution
%
% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
% -------------------------------------------------------------------------

% INITIALIZATION
warning off
nBoot = 1000;
alpha = 0.05;
bound = 1; % One standard error
order = size(X,2);
coeff = zeros(order,nBoot);
tol = 10^6; % To avoid extremely large coefficients
nInst = numel(Y);

% RANDOM NUMBER GENERATOR SEED
rng(seed);

% COMPUTING OVER ALL BOOTSTRAP SAMPLES
respBoot = zeros(size(X,1),nBoot);
modelCI = zeros(size(X,1),2);
for n = 1:nBoot
    average = inf;
    while average > tol
        bootSam = ceil(nInst .* rand(nInst,1));
        Xtrain = X(bootSam,:); Ytrain = Y(bootSam,1);

        coeff_temp = coxphfit(Xtrain,Ytrain,'censoring',censoring(bootSam),'baseline',0);

        coeff_temp(isnan(coeff_temp)) = 0;
        coeff(:,n) = coeff_temp;
        average = mean(abs(coeff(:,n)));
    end
    [respBoot(:,n)] = responseCox(X,coeff(:,n));
end
SE_coeff = bound.*(std(coeff')')./sqrt(nBoot);
coeff = mean(coeff')';

% CALCULATING THE BOOTSTRAP CONFIDENCE INTERVALS OF THE FINAL MODEL
for i = 1:size(X,1)
    modelCI(i,1)= prctile(respBoot(i,:),alpha/2*100);
    modelCI(i,2)= prctile(respBoot(i,:),(1-alpha/2)*100);
end

% ROUNDING COEFFICIENTS

% According to their standard errors, as in ref. [1]
% Note: This type of rounding seems too strong and may not be desirable, as it significantly affects the specificity of models
%       --> kept here as comments before further investigations
% for i = 1:order+1
%     if coeff(i) > 0
%         coeff(i) = roundsd(coeff(i),ceil(log10(abs(coeff(i)/roundsd(SE_coeff(i),1)))) + 1);
%     else
%         coeff(i) = roundsd(coeff(i),ceil(log10(abs(coeff(i)/roundsd(SE_coeff(i),1)))));
%     end
% end

% Rounding to 4 significant digits
% --> seems to preserve the predictive properties of models
coeff = roundsd(coeff,4);

% MULTIVARIABLE RESPONSE OF THE FINAL MODEL
[resp] = responseCox(X,coeff);
medianHR = median(resp);

end


function varargout = fillMeshFaces(varargin)
%FILLMESHFACES Fill the faces of a mesh with the specified colors.
%
%   fillMeshFaces(V, F, VERTEXCOLORS)
%   Colorizes a mesh by filling faces with an array of values. The colors
%   can be a NV-by-1 array of values, or a NV-by-3 array of values.
%   Face filling uses 'interp' coloring mode.
%
%   fillMeshFaces(V, F, FACECOLORS)
%   Colorizes the mesh by specifying the value or the color associated to
%   each face. Face filling uses 'flat' coloring mode.
%
%   fillMeshFaces(..., PNAME, PVALUE)
%   Specifies additional parameters that will be passed to the 'patch'
%   function.
%
%   Example
%     % Colorize mesh based on z-coordinate of vertices.
%     [v, f] = createIcosahedron;
%     values = v(:,3);
%     figure; axis equal; view(3);
%     fillMeshFaces(v, f, values);
%
%     % Colorize mesh using specific color for each face
%     [v, f] = createIcosahedron;
%     colors = jet(20);
%     figure; axis equal; view(3);
%     fillMeshFaces(v, f, colors);
%
%   See also
%     drawMesh

% ------
% Author: David Legland
% E-mail: david.legland@inrae.fr
% Created: 2020-04-16, using Matlab 9.7.0.1247435 (R2019b) Update 2
% Copyright 2020-2022 INRAE - BIA Research Unit - BIBS Platform (Nantes)

%% Parse input arguments

% extract first argument
var1 = varargin{1};
varargin(1) = [];

% Check if first input argument is an axes handle
if isAxisHandle(var1)
    ax = var1;
    var1 = varargin{1};
    varargin(1) = [];
else
    ax = gca;
end

% Check if the input is a mesh structure
if isstruct(var1)
    % extract data to display
    vertices = var1.vertices;
    faces = var1.faces;
else
    % assumes input is given with vertices+faces arrays
    vertices = var1;
    faces = varargin{1};
    varargin(1) = [];
end

% next argument is face color
colors = varargin{1};
varargin(1) = [];

% adapt the face color key value depending on the size of the "color" input
% argument
faceColorMode = 'interp';
if size(colors, 1) == size(faces, 1)
    faceColorMode = 'flat';
end

% array FACES is a NF-by-NV indices array, with NV number of vertices of
% each face, and NF number of faces
h = patch('Parent', ax, ...
    'vertices', vertices, 'faces', faces, 'FaceVertexCData', colors, ...
    'FaceColor', faceColorMode, varargin{:});

%% Process output arguments

% format output parameters
if nargout > 0
    varargout = {h};
end


function asa314_test ( )

%*****************************************************************************80
%
%% MAIN is the main program for ASA314_TEST.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    05 May 2013
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Roger Payne,
%    Inversion of matrices with contents subject to modulo arithmetic,
%    Applied Statistics,
%    Volume 46, Number 2, 1997, pages 295-298.
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'ASA314_TEST:\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '  Test the ASA314 library.\n' );

  asa314_test01 ( );
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'ASA314_TEST:\n' );
  fprintf ( 1, '  Normal end of execution.\n' );
  fprintf ( 1, '\n' );
  timestamp ( );

  return
end


%--- help for generic/pull_objective ---
%
%  Pulls the objective function to optimize
%
%  ::
%
%    [ff,lb,ub]=pull_objective(obj)
%    [ff,lb,ub]=pull_objective(obj,varargin)
%    [ff,lb,ub,x0]=pull_objective(obj,varargin)
%    [ff,lb,ub,x0,vcov]=pull_objective(obj,varargin)
%    [ff,lb,ub,x0,vcov,obj]=pull_objective(obj,varargin)
%
%  Args:
%     obj (rise | dsge | svar | rfvar): initial model object
%     varargin (pairwise addional inputs): usual RISE arguments
%
%  Returns:
%     :
%
%     - **ff** [function handle]: for computing "minus log posterior kernel"
%     - **lb** [d x 1 vector]: lower bound of the parameters to optimize
%     - **ub** [d x 1 vector]: upper bound of the parameters to optimize
%     - **x0** [d x 1 vector]: posterior mode if available
%     - **vcov** [d x d matrix]: covariance matrix at the posterior mode if
%       available.
%     - **obj** [rise|dsge|svar|rfvar]: updated model object
%
%  Note:
%
%     - The function can be used for :
%
%        - optimization,
%        - gradient computation,
%        - hessian computation,
%        - posterior simulation
%
%     - The updated object should be used for doing various exercises (irfs,
%       simulations, etc.) if the posterior mode is not computed.
%
%     - Using this function is potentially costly, one could alternatively
%       simply use log_posterior_kernel. However, if there are restrictions, they
%       will not be enforced. Nevertheless it is an interesting proposition that
%       should be investigated further.
%
%
%    Other functions named pull_objective
%
%       abstvar/pull_objective    dsge/pull_objective
%


function [y, extra, invhess] = rbfevfwd(net, x, t, x_test, invhess)
%RBFEVFWD Forward propagation with evidence for RBF
%
%	Description
%	Y = RBFEVFWD(NET, X, T, X_TEST) takes a network data structure  NET
%	together with the input X and target T training data and input test
%	data X_TEST. It returns the normal forward propagation through the
%	network Y together with a matrix EXTRA which consists of error bars
%	(variance) for a regression problem or moderated outputs for a
%	classification problem.
%
%	The optional argument (and return value)  INVHESS is the inverse of
%	the network Hessian computed on the training data inputs and targets.
%	Passing it in avoids recomputing it, which can be a significant
%	saving for large training sets.
%
%	See also
%	FEVBAYES
%

%	Copyright (c) Ian T Nabney (1996-2001)

y = rbffwd(net, x_test);
% RBF outputs must be linear, so just pass them twice (second copy is
% not used
if nargin == 4
  [extra, invhess] = fevbayes(net, y, y, x, t, x_test);
else
  [extra, invhess] = fevbayes(net, y, y, x, t, x_test, invhess);
end


% tHis subroutine assigns creates a grid with
% spacing dx,dy (in degreees). The size will
% be selected interactiVELY. The bvalue in each
% volume around a grid point containing ni earthquakes
% will be calculated as well as the magnitude
% of completness
%   Stefan Wiemer 1/95

report_this_filefun(mfilename('fullpath'));

global no1 bo1 inb1 inb2

if sel == 'in'
    % get the grid parameter
    % initial values
    %
    dd = 1.00;
    dx = 1.00 ;
    ni = 500;

    def = {num2str(ZG.maepi.Date(1))};
    ni2 = inputdlg('Input Time of Mainshock ?','Input',1,def);
    l = ni2{:};
    mati = str2double(l);

    def = {'30'};
    ni2 = inputdlg('Time length considered in days?','Input',1,def);
    l = ni2{:};
    tlen = str2double(l);

    % make the interface
    %
    figure_w_normalized_uicontrolunits(...
        'Name','Grid Input Parameter',...
        'NumberTitle','off', ...
        'MenuBar','none', ...
        'units','points',...
        'Visible','off', ...
        'Position',[ ZG.wex+200 ZG.wey-200 550 300]);
    axis off

    %
    freq_field=uicontrol('Style','edit',...
        'Position',[.60 .50 .22 .10],...
        'Units','normalized','String',num2str(ni),...
        'Callback','ni=str2double(freq_field.String); freq_field.String=num2str(ni);');

    freq_field2=uicontrol('Style','edit',...
        'Position',[.60 .40 .22 .10],...
        'Units','normalized','String',num2str(dx),...
        'Callback','dx=str2double(freq_field2.String); freq_field2.String=num2str(dx);');

    freq_field3=uicontrol('Style','edit',...
        'Position',[.60 .30 .22 .10],...
        'Units','normalized','String',num2str(dd),...
        'Callback','dd=str2double(freq_field3.String); freq_field3.String=num2str(dd);');

    close_button=uicontrol('Style','Pushbutton',...
        'Position',[.60 .05 .15 .12 ],...
        'Units','normalized','Callback','close;done','String','Cancel');

    go_button1=uicontrol('Style','Pushbutton',...
        'Position',[.20 .05 .15 .12 ],...
        'Units','normalized',...
        'Callback','close,sel =''ca''; pcross',...
        'String','Go');

    txt3 = text(...
        'Color',[0 0 0 ],...
        'EraseMode','normal',...
        'Position',[0.30 0.65 0 ],...
        'Rotation',0 ,...
        'FontSize',ZmapGlobal.Data.fontsz.l ,...
        'FontWeight','bold',...
        'String',' Grid Parameter');
    txt5 = text(...
        'Color',[0 0 0 ],...
        'EraseMode','normal',...
        'Position',[0. 0.42 0 ],...
        'Rotation',0 ,...
        'FontSize',ZmapGlobal.Data.fontsz.m ,...
        'FontWeight','bold',...
        'String','Spacing along projection [km]');

    txt6 = text(...
        'Color',[0 0 0 ],...
        'EraseMode','normal',...
        'Position',[0. 0.32 0 ],...
        'Rotation',0 ,...
        'FontSize',ZmapGlobal.Data.fontsz.m ,...
        'FontWeight','bold',...
        'String','Spacing in depth in km:');

    txt1 = text(...
        'Color',[0 0 0 ],...
        'EraseMode','normal',...
        'Position',[0. 0.53 0 ],...
        'Rotation',0 ,...
        'FontSize',ZmapGlobal.Data.fontsz.m,...
        'FontWeight','bold',...
        'String','Number of Events (Ni):');

    set(gcf,'visible','on');
    watchoff

end   % if sel == in

% get the grid-size interactively and
% calculate the b-value in the grid by sorting
% thge seimicity and selectiong the ni neighbors
% to each grid point

if sel == 'ca'

    figure_w_normalized_uicontrolunits(xsec_fig)
    hold on

    messtext=...
        ['To select a polygon for a grid.       '
        'Please use the LEFT mouse button of   '
        'or the cursor to the select the poly- '
        'gon. Use the RIGTH mouse button for   '
        'the final point.                      '
        'Mac Users: Use the keyboard "p" more  '
        'point to select, "l" last point.      '
        '                                      '];

    zmap_message_center.set_message('Select Polygon for a grid',messtext);

    ax = findobj('Tag','main_map_ax');
    [x,y, mouse_points_overlay] = select_polygon(ax);
    zmap_message_center.set_info('Message',' Thank you .... ')

    plos2 = plot(x,y,'b-','era','xor');        % plot outline
    sum3 = 0.;
    pause(0.3)

    %create a rectangular grid
    xvect=[min(x):dx:max(x)];
    yvect=[min(y):dd:max(y)];
    gx = xvect;gy = yvect;
    tmpgri=zeros((length(xvect)*length(yvect)),2);
    n=0;
    for i=1:length(xvect)
        for j=1:length(yvect)
            n=n+1;
            tmpgri(n,:)=[xvect(i) yvect(j)];
        end
    end
    %extract all gridpoints in chosen polygon
    XI=tmpgri(:,1);
    YI=tmpgri(:,2);

    ll = polygon_filter(x,y, XI, YI, 'inside');
    %grid points in polygon
    newgri=tmpgri(ll,:);

    % Plot all grid points
    plot(newgri(:,1),newgri(:,2),'+k')

    if length(xvect) < 2  ||  length(yvect) < 2
        errordlg('Selection too small! (not a matrix)');
        return
    end

    itotal = length(newgri(:,1));

    zmap_message_center.set_info(' ','Running... ');think
    %  make grid, calculate start- endtime etc.  ...
    %
    t0b = min(newa.Date)  ;
    n = newa.Count;
    teb = newa.Date(n) ;
    tdiff = round(days(teb-t0b)/ZG.bin_days);
    loc = zeros(3, length(gx)*length(gy));

    % loop over  all points
    %
    i2 = 0.;
    i1 = 0.;
    bvg = [];
    allcount = 0.;
    wai = waitbar(0,' Please Wait ...  ');
    set(wai,'NumberTitle','off','Name','p-value grid - percent done');;
    drawnow
    %
    % loop
    dm = 0.1;
    dt = 0.01;
    M = max(ZG.newt2.Magnitude) - 5.;

    %
    for i= 1:length(newgri(:,1))
        x = newgri(i,1);y = newgri(i,2);
        allcount = allcount + 1.;
        i2 = i2+1;

        % calculate distance from center point and sort wrt distance
        l = sqrt(((xsecx' - x)).^2 + ((xsecy + y)).^2) ;
        [s,is] = sort(l);
        b = newa(is(:,1),:) ;       % re-orders matrix to agree row-wise

        % take first ni points
        b = b(1:ni,:);      % new data per grid point (b) is sorted in distance
        l2 = sort(l); di = l2(ni);

        [st,ist] = sort(b);   % re-sort wrt time for cumulative count
        b = b(ist(:,3),:);

        % call the p-value function
        % first find out what magco is
        l = b.Date > mati + days(3);
        %[bv magco stan av me mer me2,  pr] =  bvalca3(b(l,:),1,1);
        %l = b.Magnitude > magco+0.1;
        ZG.newt2 = b;
        tmin1 =0.05;

        calcp
        load aspar3.out
        re = aspar3;

        bvg = [bvg ; re(1,2) re(1,4) x y re(2,2) re(2,4) bv 0 di];
        waitbar(allcount/itotal)
    end  % for  newgri

    % save data
    %
    %  set(txt1,'String', 'Saving data...')
    drawnow
    gx = xvect;gy = yvect;

    %   catSave3 =...
    % [ 'zmap_message_center.set_info(''Save Grid'',''  '');think;',...
    %  '[file1,path1] = uiputfile(fullfile(ZmapGlobal.Data.data_dir, ''*.mat''), ''Grid Datafile Name?'') ;',...
    %  ' sapa2 = [''save '' path1 file1 '' ll tmpgri bvg xvect yvect gx gy dx dd ZG.bin_days ni newa maex maey maix maiy ''];',...
    %  ' if length(file1) > 1, eval(sapa2),end , done']; eval(catSave3)

    close(wai)
    watchoff

    % reshape a few matrices
    %
    normlap2=ones(length(tmpgri(:,1)),1)*nan;
    normlap2(ll)= bvg(:,1);
    re3=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,2);
    dp =reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,6);
    db =reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,9);
    r =reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,5);
    bv=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,7);
    bv2=reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,8);
    pmap =reshape(normlap2,length(yvect),length(xvect));

    normlap2(ll)= bvg(:,1);
    Pv=reshape(normlap2,length(yvect),length(xvect));

    old = re3;

    % View the b-value map
    view_pv2

end   %  if sel = ca

% Load exist b-grid
if sel == 'lo'
    load_existing_bgrid_version_A
end