function [g,a,fc,L,info]=audfilters(fs,Ls,varargin)
%AUDFILTERS Generates filters equidistantly spaced on auditory frequency scales
%   Usage:  [g,a,fc,L]=audfilters(fs,Ls);
%           [g,a,fc,L]=audfilters(fs,Ls,...);
%
%   Input parameters:
%      fs    : Sampling rate (in Hz).
%      Ls    : Signal length.
%   Output parameters:
%      g     : Cell array of filters.
%      a     : Downsampling rate for each channel.
%      fc    : Center frequency of each channel.
%      L     : Next admissible length suitable for the generated filters.
%
%   `[g,a,fc,L]=audfilters(fs,Ls)` constructs a set of filters *g* that are
%   equidistantly spaced on a perceptual frequency scale (see |freqtoaud|) between
%   0 and the Nyquist frequency. The filter bandwidths are proportional to the
%   critical bandwidth of the auditory filters |audfiltbw|. The filters are intended
%   to work with signals with a sampling rate of *fs*. The signal length *Ls* is
%   mandatory, since we need to avoid too narrow frequency windows.
%
%   By default the ERB scale is chosen but other frequency scales are
%   possible. Currently supported scales are 'erb', 'erb83', 'bark', 'mel'
%   and 'mel1000', and can be changed by passing the associated string as
%   an optional parameter. See |freqtoaud| for more information on the
%   supported frequency scales.
%
%   By default, a Hann window shape is chosen as prototype frequency
%   response for all filters. The prototype frequency response can be
%   changed by passing any of the window types from |firwin| or |freqwin|
%   as an optional parameter.
%
%   `[g,a,fc,L]=audfilters(fs,Ls,fmin,fmax)` constructs a set of filters
%   between *fmin* and *fmax*. The filters are equidistantly spaced on the
%   selected frequency scale. One additional filter will be positioned at
%   the 0 and Nyquist frequencies each, so as to cover the full range of
%   positive frequencies.
%   The values of *fmin* and *fmax* can be instead specified using a
%   key/value pair as::
%
%       [g,a,fc,L]=audfilters(fs,Ls,...,'fmin',fmin,'fmax',fmax)
%
%   Default values are *fmin=0* and *fmax=fs/2*.
%
%   For more details on the construction of the filters, please see the
%   given references.
%
%   Downsampling factors
%   --------------------
%
%   The integer downsampling rates of the channels must all divide the
%   signal length, |filterbank| will only work for input signal lengths
%   being multiples of the least common multiple of the downsampling rates.
%   See the help of |filterbanklength|.
%   The fractional downsampling rates restrict the filterbank to a single
%   length *L=Ls*.
%
%   `[g,a]=audfilters(...,'regsampling')` constructs a non-uniform
%   filterbank with integer subsampling factors.
%
%   `[g,a]=audfilters(...,'uniform')` constructs a uniform filterbank
%   where the integer downsampling rate is the same for all the channels. This
%   results in most redundant representation which produces nice plots.
%
%   `[g,a]=audfilters(...,'fractional')` constructs a filterbank with
%   fractional downsampling rates *a*.
%   This results in the least redundant system.
%
%   `[g,a]=audfilters(...,'fractionaluniform')` constructs a filterbank with
%   fractional downsampling rates *a*, which are uniform for all filters
%   except the "filling" low-pass and high-pass filters which can have different
%   fractional downsampling rates. This is useful when uniform subsampling
%   and low redundancy at the same time are desirable.
%
%   Additional parameters
%   ---------------------
%
%   `audfilters` accepts the following optional parameters:
%
%     'spacing',b        Specify the spacing between the filters, measured in
%                        scale units. Default value is *b=1* for the scales
%                        'erb', 'erb83' and 'bark'; the default is *b=100* for
%                        'mel' and 'mel1000'.
%
%     'bwmul',bwmul      Bandwidth of the filters relative to the bandwidth
%                        returned by |audfiltbw|. Default value is *bwmul=1* for
%                        the scales 'erb', 'erb83' and 'bark'; the default is
%                        *b=100* for 'mel' and 'mel1000'.
%
%     'redmul',redmul    Redundancy multiplier. Increasing the value of this
%                        will make the system more redundant by lowering the
%                        channel downsampling rates. It is only used if the
%                        filterbank is a non-uniform filterbank. Default
%                        value is *1*. If the value is less than one, the
%                        system may no longer be painless.
%
%     'redtar',redtar    Target redundancy. The downsampling factors will be
%                        adjusted to achieve a redundancy as close as possible
%                        to 'redtar'.
%
%     'M',M              Specify the total number of filters between *fmin* and
%                        *fmax*. If this parameter is specified, it overwrites the
%                        `'spacing'` parameter.
%
%     'symmetric'        Create filters that are symmetric around their centre
%                        frequency. This is the default.
%
%     'warped'           Create asymmetric filters that are symmetric on the
%                        auditory scale.
%
%     'complex'          Construct a filterbank that covers the entire
%                        frequency range instead of just the positive
%                        frequencies this allows the analysis of complex
%                        valued signals.
%
%     'nosubprec'        Disable subsample window positions.
%
%     'trunc_at'         When using a prototype defined in |freqwin|, a hard
%                        thresholding of the filters at the specified threshold
%                        value is performed to reduce their support size.
%                        The default value is *trunc_at=10e-5*. When no
%                        truncation is desired, *trunc_at=0* should be chosen.
%                        This value is ignored when a prototype shape from
%                        |firwin| was chosen.
%
%     'min_win',min_win  Minimum admissible window length (in samples).
%                        Default is *4*. This restrict the windows not
%                        to become too narrow when *L* is low.
%
%   Examples:
%   ---------
%
%   In the first example, we construct a highly redudant uniform
%   filterbank on the ERB scale and visualize the result:::
%
%     [f,fs]=greasy;  % Get the test signal
%     [g,a,fc,L]=audfilters(fs,length(f),'uniform','M',100);
%     c=filterbank(f,g,a);
%     plotfilterbank(c,a,fc,fs,90,'audtick');
%
%   In the second example, we construct a non-uniform filterbank with
%   fractional sampling that works for this particular signal length, and
%   test the reconstruction. The plot displays the response of the
%   filterbank to verify that the filters are well-behaved both on a
%   normal and an ERB-scale. The second plot shows frequency responses of
%   filters used for analysis (top) and synthesis (bottom). :::
%
%     [f,fs]=greasy;  % Get the test signal
%     L=length(f);
%     [g,a,fc]=audfilters(fs,L,'fractional');
%     c=filterbank(f,{'realdual',g},a);
%     r=2*real(ifilterbank(c,g,a));
%     norm(f-r)
%
%     % Plot the response
%     figure(1);
%     subplot(2,1,1);
%     R=filterbankresponse(g,a,L,fs,'real','plot');
%
%     subplot(2,1,2);
%     semiaudplot(linspace(0,fs/2,L/2+1),R(1:L/2+1));
%     ylabel('Magnitude');
%
%     % Plot frequency responses of individual filters
%     gd=filterbankrealdual(g,a,L);
%     figure(2);
%     subplot(2,1,1);
%     filterbankfreqz(gd,a,L,fs,'plot','linabs','posfreq');
%
%     subplot(2,1,2);
%     filterbankfreqz(g,a,L,fs,'plot','linabs','posfreq');
%
%
%   See also: filterbank, ufilterbank, ifilterbank, ceil23
%
%   References: ltfatnote027 nehobaprpide18

% Authors: Peter L. Søndergaard (original 'erbfilters' function)
% Modified by: Thibaud Necciari, Nicki Holighaus
% Comments updated by: Nicki Holighaus (09.05.22)

% Date: 16.12.16

complainif_notenoughargs(nargin,2,upper(mfilename));
complainif_notposscalar(fs,'fs',upper(mfilename));
complainif_notposint(Ls,'Ls',upper(mfilename));

firwinflags=getfield(arg_firwin,'flags','wintype');
freqwinflags=getfield(arg_freqwin,'flags','wintype');

definput.flags.wintype = [ firwinflags, freqwinflags];
definput.keyvals.M=[];
definput.keyvals.redmul=1;
definput.keyvals.min_win = 4;
definput.keyvals.bwmul=[];
definput.keyvals.spacing=[];
definput.keyvals.trunc_at=10^(-5);
definput.keyvals.fmin=0;
definput.keyvals.fmax=fs/2;
definput.keyvals.redtar=[];
definput.flags.subprec={'subprec','nosubprec'};
definput.flags.audscale={'erb','erb83','bark','mel','mel1000'};
definput.flags.warp     = {'symmetric','warped'};
definput.flags.real     = {'real','complex'};
definput.flags.sampling = {'regsampling','uniform','fractional',...
                           'fractionaluniform'};

[varargin,winCell] = arghelper_filterswinparser(definput.flags.wintype,varargin);

[flags,kv]=ltfatarghelper({'fmin','fmax'},definput,varargin);
if isempty(winCell), winCell = {flags.wintype}; end

switch flags.audscale
    case {'mel','mel1000'} % The mel scales are very fine, therefore default spacing is adjusted
        definput.keyvals.bwmul=100;
        definput.keyvals.spacing=100;
    otherwise
        definput.keyvals.bwmul=1;
        definput.keyvals.spacing=1;
end
[flags,kv]=ltfatarghelper({'fmin','fmax','redtar'},definput,varargin);

if flags.do_bark && (fs > 44100)
    error(['%s: Bark scale is not suitable for sampling rates higher than 44.1 kHz. ',...
    'Please choose another scale.'],upper(mfilename));
end

if ~isscalar(kv.bwmul) || kv.bwmul <= 0
    error('%s: bwmul must be a positive scalar.',upper(mfilename));
end

if ~isscalar(kv.redmul) || kv.redmul <= 0
    error('%s: redmul must be a positive scalar.',upper(mfilename));
end

if ~isempty(kv.redtar)
    if ~isscalar(kv.redtar) || kv.redtar <= 0
        error('%s: redtar must be a positive scalar.',upper(mfilename));
    end
end

if kv.redtar <= 1
    warning('%s: redtar is very low; the resulting system might be unstable.',upper(mfilename));
end

if kv.fmax <= kv.fmin || kv.fmin < 0 || kv.fmax > fs/2
    error('%s: fmax must be bigger than fmin and in the range [0,fs/2].',upper(mfilename));
end

if kv.trunc_at > 1 || kv.trunc_at < 0
    error('%s: trunc_at must be in range [0,1].',upper(mfilename));
end

if ~isscalar(kv.min_win) || rem(kv.min_win,1) ~= 0 || kv.min_win < 1
    error('%s: min_win must be an integer bigger or equal to 1.',upper(mfilename));
end

if ~isempty(kv.M)
    complainif_notposint(kv.M,'M',upper(mfilename));
    kv.spacing = (freqtoaud(kv.fmax,flags.audscale) - freqtoaud(kv.fmin,flags.audscale))/(kv.M-1);
end

% Construct function handle for filter prototype and determine its ERB-type
% bandwidth
[filterfunc,winbw] = helper_filtergeneratorfunc(...
                          flags.wintype,winCell,fs,kv.bwmul,kv.min_win,kv.trunc_at,...
                          flags.audscale,flags.do_subprec,flags.do_symmetric,flags.do_warped);

% Construct the AUD filterbank
fmin = max(kv.fmin,audtofreq(kv.spacing,flags.audscale));
fmax = min(kv.fmax,fs/2);

innerChanNum = floor((freqtoaud(fmax,flags.audscale)-freqtoaud(fmin,flags.audscale))/kv.spacing)+1;

fmax = audtofreq(freqtoaud(fmin,flags.audscale)+(innerChanNum-1)*kv.spacing,flags.audscale);

% Make sure that fmax < fs/2, and F_ERB(fmax) = F_ERB(fmin)+k/spacing, for
% some k.
count = 0;
while fmax >= fs/2
    count = count+1;
    fmax = audtofreq(freqtoaud(fmin,flags.audscale)+(innerChanNum-count-1)*kv.spacing,flags.audscale);
end
innerChanNum = innerChanNum-count;

if fmax <= fmin || fmin > fs/4 || fmax < fs/4
    error(['%s: Bad combination of fs, fmax and fmin.'],upper(mfilename));
end

% Center frequencies are given as equidistantly spaced points on auditory
% scale
fc=audspace(fmin,fmax,innerChanNum,flags.audscale).';
fc = [0;fc;fs/2];
M2 = innerChanNum+2;

ind = (2:M2-1)';
%% Compute the frequency support
% fsupp is measured in Hz

fsupp=zeros(M2,1);
aprecise=zeros(M2,1);

if flags.do_symmetric
    fsupp(ind)=audfiltbw(fc(ind),flags.audscale)/winbw*kv.bwmul;

    % Generate lowpass filter parameters
    fsupp(1) = 0; % Placeholder value
    % Determine border of passband
    fps0 = audtofreq(freqtoaud(fc(2),flags.audscale)+3*kv.spacing,flags.audscale);% f_{p,s}^{-}
    % Determine lowpass width
    fsupp_temp1 = audfiltbw(fps0,flags.audscale)/winbw*kv.bwmul;
    % Determine bandwidth-adapted decimation factor
    aprecise(1) = max(fs./(2*max(fps0,0)+fsupp_temp1*kv.redmul),1);

    % Generate highpass filter parameters
    fsupp(end) = 0; % Placeholder value
    % Determine border of passband
    fps0 = audtofreq(freqtoaud(fc(end-1),flags.audscale)-3*kv.spacing,flags.audscale);% f_{p,s}^{+}
    % Determine highpass width
    fsupp_temp1 = audfiltbw(fps0,flags.audscale)/winbw*kv.bwmul;
    % Determine bandwidth-adapted decimation factor
    aprecise(end) = max(fs./(2*(fc(end)-min(fps0,fs/2))+fsupp_temp1*kv.redmul),1);
else
    % fsupp_scale is measured on the selected auditory scale
    % The scaling is incorrect, it does not account for the warping (NH:
    % I do think it is correct.)
    fsupp_scale=1/winbw*kv.bwmul;

    % Convert fsupp into the correct widths in Hz, necessary to compute
    % "a" in the next if-statement
    fsupp(ind)=audtofreq(freqtoaud(fc(ind),flags.audscale)+fsupp_scale/2,flags.audscale)-...
               audtofreq(freqtoaud(fc(ind),flags.audscale)-fsupp_scale/2,flags.audscale);

    % Generate lowpass filter parameters
    fsupp(1) = 0; % Placeholder value
    % Determine border of passband
    fps0 = audtofreq(freqtoaud(fc(2),flags.audscale)+3*kv.spacing,flags.audscale);% f_{p,s}^{-}
    % Determine lowpass width
    fsupp_temp1 = audfiltbw(fps0,flags.audscale)/winbw*kv.bwmul;
    % Determine bandwidth-adapted decimation factor
    aprecise(1) = max(fs./(2*max(fps0,0)+fsupp_temp1*kv.redmul),1);

    % Generate highpass filter parameters
    fsupp(end) = 0; % Placeholder value
    % Determine border of passband
    fps0 = audtofreq(freqtoaud(fc(end-1),flags.audscale)-3*kv.spacing,flags.audscale);% f_{p,s}^{+}
    % Determine highpass width
    fsupp_temp1 = audfiltbw(fps0,flags.audscale)/winbw*kv.bwmul;
    % Determine bandwidth-adapted decimation factor
    aprecise(end) = max(fs./(2*(fc(end)-min(fps0,fs/2))+fsupp_temp1*kv.redmul),1);
end;

% Do not allow lower bandwidth than keyvals.min_win
fsuppmin = kv.min_win/Ls*fs;
for ii = 1:numel(fsupp)
    if fsupp(ii) < fsuppmin;
        fsupp(ii) = fsuppmin;
    end
end

% Find suitable channel subsampling rates
aprecise(ind)=fs./fsupp(ind)/kv.redmul;
aprecise=aprecise(:);

if any(aprecise<1)
    error('%s: Invalid subsampling rates. Decrease redmul.',upper(mfilename))
end

%% Compute the downsampling rate
if flags.do_regsampling
    % Shrink "a" to the next composite number
    a=floor23(aprecise);

    % Determine the minimal transform length
    L=filterbanklength(Ls,a);

    % Heuristic trying to reduce lcm(a)
    while L>2*Ls && ~(all(a)==a(1))
        maxa = max(a);
        a(a==maxa) = 0;
        a(a==0) = max(a);
        L = filterbanklength(Ls,a);
    end

% Determine true decimation factors from "aprecise" according to chosen
% subsampling scheme (see help above)
elseif flags.do_fractional
    L = Ls;
    N=ceil(Ls./aprecise);
    a=[repmat(Ls,M2,1),N];
elseif flags.do_fractionaluniform
    L = Ls;
    N=ceil(Ls./min(aprecise));
    a= repmat([Ls,N],M2,1);
elseif flags.do_uniform
    a=floor(min(aprecise));
    L=filterbanklength(Ls,a);
    a = repmat(a,M2,1);
end;

% Get an expanded "a" / Convert "a" to LTFAT 2-column fractional format
afull=comp_filterbank_a(a,M2,struct());

%% Compute the scaling of the filters
% Filters are scaled such that the energy of the subband coefficients
% remains approximately constant independent of the decimation factor
scal=sqrt(afull(:,1)./afull(:,2));

%% Construct the real or complex filterbank

if flags.do_real
    % Scale the first and last channels
    scal(1)=scal(1)/sqrt(2);
    scal(M2)=scal(M2)/sqrt(2);
else
    % Replicate the centre frequencies and sampling rates, except the first and
    % last
    a=[a;flipud(a(2:M2-1,:))];
    scal=[scal;flipud(scal(2:M2-1))];
    fc  =[fc; -flipud(fc(2:M2-1))];
    fsupp=[fsupp;flipud(fsupp(2:M2-1))];
    ind = [ind;numel(fc)+2-(M2-1:-1:2)'];
end;

%% Compute the filters
% This is actually much faster than the vectorized call.
g = cell(1,numel(fc));
for m=ind.'
    g{m}=filterfunc(fsupp(m),fc(m),scal(m));
end

% Generate lowpass filter
g{1} = audlowpassfilter(g(1:M2),a(1:M2,:),fc(1:M2),fs,scal(1),kv,flags);

% Generate highpass filter
g{M2} = audhighpassfilter(g(1:M2),a(1:M2,:),fc(1:M2),fs,scal(M2),kv,flags);

% Adjust the downsampling rates in order to achieve 'redtar' (see help
% above)
if ~isempty(kv.redtar)
    if flags.do_uniform
        % Compute and display redundancy for verification
        org_red = (M2-2)/a(1);
        a_new = floor(a*org_red/kv.redtar);
        scal_new = org_red/kv.redtar*ones(numel(g),1);
        % new_red = (M2-2)/a_new(1);
    else
        % The decimation factors of all filters except for lowpass and
        % highpass are adjusted proportional to their bandwidth. For
        % lowpass and highpass, only the tapered part is considered for
        % adjustment to better preserve stability. Please consult the
        % references for details.
        dk_old = a(:,1)./a(:,2);
        org_red = sum(2./dk_old(2:end-1));
        a_new = [a(1,:);[a(2:end-1,1),ceil(a(2:end-1,2)*kv.redtar/org_red)];a(end,:)];
        % Adjust d0 and dK to the new redundancy
        cbw = 2*sum(audfiltbw(fc(2:M2-1),flags.audscale)/winbw*kv.bwmul)/(kv.redtar*fs);
        % Low-pass
        fps0 = audtofreq(freqtoaud(fc(2),flags.audscale)+3*kv.spacing,flags.audscale);% f_{p,s}^{-}
        fsupp_temp0 = audfiltbw(fps0,flags.audscale)/winbw*kv.bwmul;
        a_new(1,2) = ceil(Ls/max(fs./(2*fps0+fsupp_temp0/cbw),1));
        % High-pass
        fps1 = audtofreq(freqtoaud(fc(end-1),flags.audscale)-3*kv.spacing,flags.audscale);% f_{p,s}^{+}
        fsupp_temp1 = audfiltbw(fps1,flags.audscale)/winbw*kv.bwmul;
        a_new(end,2) = ceil(Ls/max(fs./(2*(fc(end)-fps1)+fsupp_temp1/cbw),1));
        % Finally re-scale all filters
        dk_new = a_new(:,1)./a_new(:,2);
        scal_new = dk_new./dk_old;
        % new_red = sum(2./dk_new)-sum(1./dk_new([1,end]));
    end
    g_new = filterbankscale(g,sqrt(scal_new)'); % Perform rescaling
    a = a_new;
    g = g_new;
    if 0
        % Compute and display redundancy for verification
        fprintf('Original redundancy: %g \n', org_red);
        fprintf('Target redundancy: %g \n', kv.redtar);
        fprintf('Actual redundancy: %g \n', new_red);
    end
end

winbwrat = winbw/0.754;
basebw = 1.875657;

info.fc  = 2*fc/fs;
info.tfr = @(L)(1/L)*1./((2*fsupp*winbwrat/fs)./basebw).^2;

function glow = audlowpassfilter(g,a,fc,fs,scal,kv,flags)

% Make a probe, compute the restricted filter bank response to check if low-pass filter is needed
Lprobe = 10000;
FBresp0 = filterbankresponse(g(2:end-1),a(2:end-1,:),Lprobe,'real');
eps_thr = 1e-3;
ind_f1 = floor(fc(2)*Lprobe/fs);
ind_fK = floor(fc(end-1)*Lprobe/fs);
if ind_f1 == 0 || ...
    min(FBresp0(1:ind_f1)) >= (1-eps_thr)*min(FBresp0(ind_f1:ind_fK))
%       Not required
    glow.H = @(L) 0;
    glow.foff = @(L) 0;
    glow.realonly = 0;
    glow.delay = 0;
    glow.fs = g{2}.fs;
else

%       Required
    % Compute the transition frequencies f_{p,s}^{-} and f_{p,e}^{-}
    % Determines the width of the plateau
    fps = audtofreq(freqtoaud(fc(2),flags.audscale)+3*kv.spacing,flags.audscale);
    % Determines the cosine transition frequency
    fpe = audtofreq(freqtoaud(fc(2),flags.audscale)+4*kv.spacing,flags.audscale);
    fsupp_LP = 2*fpe;
    ratio = 2*(fpe-fps)/fsupp_LP;
    Lw = @(L) min(ceil(fsupp_LP*L/fs),L);

    P0 = blfilter({'hann','taper',ratio},fsupp_LP,'fs',fs,'inf','min_win',kv.min_win);
    temp_fbresp = @(L) filterbankresponse(g(2:end-1),a(2:end-1,:),L,'real');
    Hinv = @(L) sqrt(max(temp_fbresp(L))-temp_fbresp(L));

%     Compute the final low-pass filter
    glow.H = @(L) fftshift(long2fir(...
        filterbankfreqz(P0,a(1,:),L).*Hinv(L),Lw(L)))*scal;
    glow.foff = @(L) -floor(Lw(L)/2);
    glow.realonly = 0;
    glow.delay = 0;
    glow.fs = g{2}.fs;
end

function ghigh = audhighpassfilter(g,a,fc,fs,scal,kv,flags)

% Make a probe, compute the restricted filter bank response to check if hi-pass filter is needed
Lprobe = 10000;
FBresp0 = filterbankresponse(g(2:end-1),a(2:end-1,:),Lprobe,'real');
eps_thr = 1e-3;
ind_f1 = floor(fc(2)*Lprobe/fs);
ind_fK = floor(fc(end-1)*Lprobe/fs);
if ind_f1 == 0 ||...
    min(FBresp0(ind_fK:floor(Lprobe/2))) >= (1-eps_thr)*min(FBresp0(ind_f1:ind_fK))
%       Not required
    ghigh.H = @(L) 0;
    ghigh.foff = @(L) 0;
    ghigh.realonly = 0;
    ghigh.delay = 0;
    ghigh.fs = g{2}.fs;
else

    %     Compute the transition frequencies f_{p,s}^{+} and f_{p,e}^{+}
    % Determines the width of the plateau
    fps = audtofreq(freqtoaud(fc(end-1),flags.audscale)-3*kv.spacing,flags.audscale);
    % Determines the cosine transition frequency
    fpe = audtofreq(freqtoaud(fc(end-1),flags.audscale)-4*kv.spacing,flags.audscale);

    %     plateauWidth = 2*(fs/2-fps);
    fsupp_HP = 2*(fs/2-fpe);
    ratio = 2*(fps-fpe)/fsupp_HP;
    Lw = @(L) min(ceil(fsupp_HP*L/fs),L);

    PK = blfilter({'hann','taper',ratio},fsupp_HP,'fc',fs/2,'fs',fs,'inf','min_win',kv.min_win);
    temp_fbresp = @(L) filterbankresponse(g(2:end-1),a(2:end-1,:),L,'real');
    Hinv = @(L) sqrt(max(temp_fbresp(L))-temp_fbresp(L));

    %     Compute the final high-pass filter
    ghigh.H = @(L) fftshift(long2fir(fftshift(...
        filterbankfreqz(PK,a(1,:),L).*Hinv(L)),Lw(L)))*scal;

    ghigh.foff = @(L) ceil(L/2)-floor(Lw(L)/2)-1;
    ghigh.realonly = 0;
    ghigh.delay = 0;
    ghigh.fs = g{2}.fs;
end


% Test file for trigtech/diff.m

function pass = test_diff(pref)

% Get preferences.
if ( nargin < 1 )
    pref = trigtech.techPref();
end

% Generate a few random points to use as test values.
seedRNG(6178);
x = 2 * rand(100, 1) - 1;

testclass = trigtech();

%%
% Spot-check derivatives for a couple of functions.

f = testclass.make({[],[-.25;.75]});
df = diff(f);
df_coeffs_exact = [.25*pi*1i;0];
pass(1) = (norm(df.coeffs-df_coeffs_exact, inf) < eps*norm(df_coeffs_exact,inf));

f = testclass.make(@(x) exp(cos(pi*x)), [], pref);
df = diff(f);
df_exact = @(x) -pi*sin(pi*x).*exp(cos(pi*x));
err = df_exact(x) - feval(df, x);
pass(2) = (norm(err, inf) < 1e3*vscale(df)*eps);

a = 10; b = 20;
f = testclass.make(@(x) cos(a*pi*sin(b*pi*x)), [], pref);
df = diff(f);
df_exact = @(x) -pi^2*a*b*cos(b*pi*x).*sin(a*pi*sin(b*pi*x));
err = df_exact(x) - feval(df, x);
pass(3) = (norm(err, inf) < 1e4*vscale(df)*eps);

f = testclass.make(@(x) exp(-50*x.^2), [], pref);
df = diff(f);
df_exact = @(x) -100*x.*exp(-50*x.^2);
err = df_exact(x) - feval(df, x);
pass(4) = (norm(err, inf) < 100*vscale(df)*eps);

a1 = 4; b1 = 3; a2 = 6; b2 = 4;
f = testclass.make(@(x) cos(a1*pi*sin(b1*pi*x)) + 1i*cos(a2*pi*sin(b2*pi*x)), [], pref);
df = diff(f);
df_exact = @(x) -pi^2*a1*b1*cos(b1*pi*x).*sin(a1*pi*sin(b1*pi*x)) - 1i*pi^2*a2*b2*cos(b2*pi*x).*sin(a2*pi*sin(b2*pi*x));
err = df_exact(x) - feval(df, x);
pass(5) = (norm(err, inf) < 1e3*vscale(df)*eps);

%%
% Verify that calling diff() gives the same answer as direct construction.

f = testclass.make(@(x) 1/21/pi*cos(21*pi*x), [], pref);
df = testclass.make(@(x) -sin(21*pi*x), [], pref);
err = diff(f) - df;
pass(6) = (norm(err.coeffs, inf) < 100*vscale(df)*eps);

%%
% Verify basic differentiation rules.

f = testclass.make(@(x) exp(1)-exp(cos(3*pi*x)), [], pref);
df = diff(f);
g = testclass.make(@(x) exp(-sin(2*pi*x)), [], pref);
dg = diff(g);
tol_f = 10*vscale(df)*eps;
tol_g = 10*vscale(dg)*eps;

errfn = diff(f + g) - (df + dg);
err = feval(errfn, x);
pass(7) = (norm(err, inf) < 10*max(tol_f, tol_g));

errfn = diff(f.*g) - (f.*dg + g.*df);
err = feval(errfn, x);
pass(8) = (norm(err, inf) < length(f)*max(tol_f, tol_g));

const = testclass.make(@(x) ones(size(x)), [], pref);
dconst = diff(const);
err = feval(dconst, x);
pass(9) = (norm(err, inf) == 0);

%%
% Check higher-order derivatives.  (NB:  We relax the tolerance by n + 1
% factors of 10, where n is the number of derivatives taken.)

f = testclass.make(@(x) exp(cos(4*pi*x))-1, [], pref);
df2 = diff(f, 2);
df2_exact = @(x) -16*pi^2*exp(cos(4*pi*x)).*(cos(4*pi*x) + cos(4*pi*x).^2 - 1);
err = df2_exact(x) - feval(df2, x);
pass(10) = (norm(err, inf) < 1e3*vscale(df2)*eps);

f = testclass.make(@(x) sin(pi*x), [], pref);
df6 = diff(f, 6);
df6_exact = -pi^6*f;
err = feval(df6_exact,x) - feval(df6, x);
pass(11) = (norm(err, inf) < 100*vscale(df6)*eps);

f = testclass.make(@(x) (1/10/pi)*cos(10*pi*sin(pi*x)), [], pref);
df5 = diff(f, 5);
err = feval(df5,[-1;1]);  % Odd derivatives of this function vanish at +-1
pass(12) = (norm(err, inf) < 1e3*vscale(df5)*eps);

%%
% Check operation for array-valued chebtech objects.
f = testclass.make(@(x) [exp(-50*x.^2) sin(4*pi*(x-0.2)) 1i*exp(cos(pi*x))], [], pref);
df = diff(f);
df_exact = @(x) [-100*x.*exp(-50*x.^2) 4*pi*cos(4*pi*(x-0.2)) -pi*1i*sin(pi*x).*exp(cos(pi*x))];
err = feval(df, x) - df_exact(x);
pass(13) = (norm(err(:), inf) < 100*max(vscale(df)*eps));

% DIM option.
dim2df = diff(f, 1, 2);
g = @(x) [(sin(4*pi*(x-0.2))-exp(-50*x.^2))  (1i*exp(cos(pi*x))-sin(4*pi*(x-0.2)))];
err = feval(dim2df, x) - g(x);
pass(14) = isequal(size(vscale(dim2df)), [1 2]) && ...
    (norm(err(:), inf) < 100*max(vscale(dim2df)*eps));

dim2df2 = diff(f, 2, 2);
g = @(x) exp(-50*x.^2) - 2*sin(4*pi*(x-0.2)) + 1i*exp(cos(pi*x));
err = feval(dim2df2, x) - g(x);
pass(15) = isequal(size(vscale(dim2df2)), [1 1]) && ...
    (norm(err(:), inf) < 1e3*max(vscale(dim2df2)*eps));

% DIM option should return an empty trigtech for non-array-valued input.
f = testclass.make(@(x) sin(pi*x));
dim2df = diff(f, 1, 2);
pass(16) = (isempty(dim2df.coeffs));

% even example with complex coefficients
f = testclass.make({[],[1+1i;1-1i]});
df = diff(f);
df_coeffs_exact = [-pi*1i*(1+1i);0;];
pass(17) = (norm(df.coeffs-df_coeffs_exact, inf) < eps*norm(df_coeffs_exact,inf));

end


function EIN = PQIntNoise (f)
% Generate the internal noise energy vector

% P. Kabal $Revision: 1.1 $  $Date: 2003/12/07 13:34:10 $

N = length (f);
for (m = 0:N-1)
    INdB = 1.456 * (f(m+1) / 1000)^(-0.8);
    EIN(m+1) = 10^(INdB / 10);
end


function perr = p_err(t, pc, pk, qp, tt, ts)
    %p_err calculate p error
    sumln=sum(log(t+pc));
    qsumln=pk/qp^2;
    qsumln=qsumln*(((tt+pc)^qp)*(1-qp*log(tt+pc))-((ts+pc)^qp)*(1-qp*log(ts+pc)));
    esumln=qsumln+sumln;
    perr=esumln;
end


% explore balloon model stability

clear all
close all
clc

xg1 = [-5:0.2:5];
xg2 = xg1;
n = length(xg1);
lm = zeros(n,n);
kas = [-4:0.2:4];
kaf = [-3:0.2:3];

try

    load demo_stability_hrf.mat
    % get max eigenvalue
    P = [0;0;0;0;0;0];
    for i=1:n
        for j=1:n
            J = VBA_numericDiff(@f_HRF,1,[xg1(i);xg2(j);0;0],P,0,[]);
            lm(i,j) = max(real(eig(J)));
        end
    end

    % get separatrix
    stab = zeros(n,n);
    stab(lm>=0) = -1;
    L = del2(stab);
    sep = zeros(n,n);
    sep(L<0)=1;
    p = length(find(L==1));
    y = [];
    for i=1:n
        for j=1:n
            if sep(i,j)==1
                y = [y,[xg1(i);xg2(j)]];
            end
        end
    end
    g_fname = @g_exp;
    options.inG.x = y(2,:)';
    options.priors.muPhi = [1;1;0];
    options.priors.SigmaPhi = eye(3);
    options.priors.SigmaPhi(1,1) = 0;
    options.priors.SigmaPhi(3,3) = 0;
    options.verbose = 0;
    options.DisplayWin = 0;
    dim.n_theta         = 0;
    dim.n_phi           = 3;
    dim.n               = 0;
    [posterior,out] = VBA_NLStateSpaceModel(y(1,:)',[],[],g_fname,dim,options);

catch

    % loop over different kas/kaf
    phi = zeros(length(kaf),length(kas));
    for k=1:length(kas)
        for l=1:length(kaf)
            k,l
            % get max eigenvalue
            P = [0;0;kaf(l);kas(k);0;0];
            for i=1:n
                for j=1:n
                    J = VBA_numericDiff(@f_HRF,1,[xg1(i);xg2(j);0;0],P,0,[]);
                    lm(i,j) = max(real(eig(J)));
                end
            end

            % get separatrix
            stab = zeros(n,n);
            stab(lm>=0) = -1;
            L = del2(stab);
            sep = zeros(n,n);
            sep(L<0)=1;
            p = length(find(L==1));
            y = [];
            for i=1:n
                for j=1:n
                    if sep(i,j)==1
                        y = [y,[xg1(i);xg2(j)]];
                    end
                end
            end
            g_fname = @g_exp;
            options.inG.x = y(2,:)';
            options.priors.muPhi = [1;1;0];
            options.priors.SigmaPhi = eye(3);
            options.priors.SigmaPhi(1,1) = 0;
            options.priors.SigmaPhi(3,3) = 0;
            options.verbose = 0;
            options.DisplayWin = 0;
            dim.n_theta         = 0;
            dim.n_phi           = 3;
            dim.n               = 0;
            [posterior,out] = VBA_NLStateSpaceModel(y(1,:)',[],[],g_fname,dim,options);
            phi(l,k) = posterior.muPhi(2);

        end
    end

end

% store for display purposes
x = options.inG.x;
gx = out.suffStat.gx;
PHI = posterior.muPhi;

gkaf = kron(ones(1,length(kas)),kaf)';
gkaf = gkaf - mean(gkaf);
gkas = kron(kas,ones(1,length(kaf)))';
gkas = gkas - mean(gkas);
options = [];
g_fname = @g_exp2d;
options.inG.gkaf = gkaf;
options.inG.gkas = gkas;
options.priors.muPhi = ones(1,1);
options.priors.SigmaPhi = 1e4*eye(1);
options.verbose = 1;
options.DisplayWin = 1;
dim.n_theta         = 0;
dim.n_phi           = 1;
dim.n               = 0;
[posterior,out] = VBA_NLStateSpaceModel(...
    phi(:),[],[],g_fname,dim,options);
I = reshape(out.suffStat.gx,length(kaf),length(kas));

% display results

hf = figure('color',[1 1 1],'position',[649,40,767,1105],'menubar','none');
ha = subplot(3,2,1,'parent',hf);
hi = imagesc(flipud(lm),'parent',ha);
xlabel(ha,'x2: blood inflow')
ylabel(ha,'x1: vasodilatory signal')
title(ha,'max eigenvalue')
colorbar('peer',ha);

ha = subplot(3,2,2,'parent',hf);
hi = plot(y(2,:),y(1,:),'.','parent',ha);
xlabel(ha,'x2: blood inflow')
ylabel(ha,'x1: vasodilatory signal')
set(ha,...
    'xlim',[min(xg1),max(xg1)],...
    'ylim',[min(xg1),max(xg1)],...
    'nextplot','add')
axis(ha,'square')
grid(ha,'on')
title(ha,...
    ['separatrix: kas=',...
    num2str(P(4)),...
    ' ; kaf=',...
    num2str(P(3))])
set(ha,'nextplot','add')
[xs,is] = sort(x);
ys = gx(is);
plot(ha,xs,ys,'k','parent',ha)
plot(0,0,'r+','parent',ha);
str = ['x(1) = ',...
    'theta',...
    '*exp(',...
    'x(2)) : theta = ',...
    num2str(PHI(2))];
legend(ha,{'numerical',str,'equilibrium'})

ha = subplot(3,2,3,'parent',hf);
hi = imagesc(phi,'parent',ha);
colorbar('peer',ha);
xlabel(ha,'kas')
ylabel(ha,'kaf')
title('separatrix parameter (theta)')

ha = subplot(3,2,4,'parent',hf);
hi = plot(kas,phi','parent',ha);
xlabel(ha,'kas')
ylabel(ha,'separatrix parameter (theta)')
grid(ha,'on');
axis(ha,'tight')
for i=1:length(kaf)
    leg{i} = ['kaf=',num2str(kaf(i))];
end
legend(ha,leg)
title(ha,'separatrix parameter (theta)')

ha = subplot(3,2,5,'parent',hf);
hi = imagesc(I,'parent',ha);
colorbar('peer',ha);
xlabel(ha,'kas')
ylabel(ha,'kaf')
title('fitted separatrix parameter (theta)')

ha = subplot(3,2,6,'parent',hf);
hi = plot(phi(:),I(:),'k.','parent',ha);
mi = min([phi(:);I(:)]);
ma = max([phi(:);I(:)]);
set(ha,'nextplot','add')
plot(ha,[mi ma],[mi ma],'r')
xlabel(ha,'sep param')
ylabel(ha,'fitted sep param (theta)')
title('sep param model fit')

str = ['theta = ',...
    num2str(posterior.muPhi(1)),...
    '*exp(kaf/2 - |kas-kaf/2|)'];
legend(ha,{'numerical',str})
grid(ha,'on');
set(ha,'xlim',[mi ma],'ylim',[mi ma])


function [X_hat]=SD_detector(y,H,nT)
    % Input parameters
    %     y : received signal, nRx1
    %     H : Channel matrix, nRxnT
    %    nT : number of Tx antennas
    % Output parameter
    %    X_hat : estimated signal, nTx1

    global x_list;         % candidate symbols in real constellations
    global x_now;          % temporary x_vector elements
    global x_hat;          % inv(H)*y
    global x_sliced;       % sliced x_hat
    global x_pre;          % x vectors obtained in the previous stage
    global real_constellation; % real constellation
    global R;               % R in the QR decomposition
    global radius_squared; % radius^2
    global x_metric;       % ML metrics of previous stage candidates
    global len;             % nT*2
    QAM_table2 = [-3-3j, -3-j, -3+3j, -3+j, -1-3j, -1-j, -1+3j, -1+j,3-3j, ...
               3-j, 3+3j, 3+j, 1-3j, 1-j, 1+3j, 1+j]/sqrt(10); % 16-QAM
    real_constellation = [-3 -1 1 3]/sqrt(10);
    y =[real(y); imag(y)];     % y : complex vector  -> real vector
    H =[real(H)  -(imag(H)) ; imag(H)   real(H)];
    % H : complex vector  -> real vector
    len = nT*2; % complex -> real
    x_list = zeros(len,4); % 4 : real constellation length, 16-QAM
    x_now = zeros(len,1); x_hat = zeros(len,1); x_pre = zeros(len,1); x_metric = 0;
    [Q,R] = qr(H);     % nR x nT QR decomposition
    x_hat = inv(H)*y;                % zero forcing equalization
    x_sliced = QAM16_real_slicer(x_hat,len)';  % slicing
    radius_squared  = norm(R*(x_sliced-x_hat))^2;  % Radious^2
    transition = 1;
    % meaning of transition
    % 0 : radius*2, 1~len : stage number
    % len+1 : compare two vectors in terms of norm values
    % len+2 : finish
    flag = 1;
    % transition tracing 0 : stage index increases by +1
    %1 : stage index decreases by -1
    %2 : 1->len+2 or len+1->1
    while (transition<len+2)
       if transition==0    % radius_squared*2
         [flag,transition,radius_squared,x_list]= radius_control(radius_squared,transition);
        elseif transition <= len
         [flag,transition] = stage_processing(flag,transition);
        elseif transition == len+1 %
         [flag,transition] = compare_vector_norm(transition);
       end
    end
    ML = x_pre;
    for i=1:len/2
        X_hat(i) = ML(i)+j*ML(i+len/2);
    end
end

function [flag,transition] = stage_processing(flag,transition)
    % Input parameters
    %    flag : previous stage index
    %       flag = 0 : stage index decreased -> x_now empty -> new x_now
    %       flag = 1 : stage index decreased -> new x_now
    %       flag = 2 : previous stage index =len+1 ->  If R>R'? start from the first stage
    %     transition : stage number
    % Output parameters
    %     flag : stage number is calculated from flag
    %     transition : next stage number, 0 : R*2, 1: next stage, len+2: finish
    global x_list x_metric x_now x_hat real_constellation R radius_squared x_sliced;

    global x_list;
    global x_metric;
    global x_now;
    global x_hat;
    global real_constellation;
    global R;
    global radius_squared;
    global x_sliced;
    stage_index = length(R(1,:))-(transition-1);
    if flag == 2  % previous stage=len+1 : recalculate radius R'
      radius_squared  = norm(R*(x_sliced-x_hat))^2;
    end
    if flag ~= 0 % previous stage=len+1 or 0
    -> upper and lower bound calculation, x_list(stage_index,:)
        [bound_lower bound_upper] = bound(transition);
        for i =1:4    % search for a candidate in x_now(stage_index),
           % 4=size(real_constellation), 16-QAM assumed
           if bound_lower <= real_constellation(i) && real_constellation(i) <= bound_upper
             list_len = list_length(x_list(stage_index,:));
             x_list(stage_index,list_len+1) = real_constellation(i);
           end
        end
    end
    list_len = list_length(x_list(stage_index,:));
    if list_len == 0     % no candidate in x_now
      if x_metric == 0 || transition ~= 1
        % transition >=2 ? if no candidate ? decrease stage index
        flag = 0;
        transition = transition-1;
       elseif x_metric ~= 0 && transition == 1
        % above two conditions are met? ML solution found
        transition = length(R(1,:))+2;  % finish stage
      end
    else              % candidate exist in x_now ? increase stage index
      flag = 1;
      transition = transition+1;
      x_now(stage_index) = x_list(stage_index,1);
      x_list(stage_index,:) = [x_list(stage_index,[2:4]) 0];
end

function [bound_lower bound_upper]=bound(transition)
    % Input parameters
    %     R : [Q R] = qr(H)
    %     radius_squared : R^2
    %     transition : stage number
    %     x_hat : inv(H)*y
    %     x_now : slicing x_hat
    % Output parameters
    %     bound_lower : bound lower
    %     bound_upper : bound upper

    global R  radius_squared  x_now  x_hat;
    len = length(x_hat);
    temp_sqrt = radius_squared;
    temp_k=0;
    for i=1:1:transition-1
       temp_abs=0;
       for k=1:1:i
          index_1 = len-(i-1);
          index_2 = index_1+ (k-1);
          temp_k = R(index_1,index_2)*(x_now(index_2)-x_hat(index_2));
          temp_abs=temp_abs+temp_k;
       end
       temp_sqrt = temp_sqrt - abs(temp_abs)^2;
    end
    temp_sqrt = sqrt(temp_sqrt);
    temp_no_sqrt = 0;
    index_1 = len-(transition-1);
    index_2 = index_1;
    for i=1:1:transition-1
       index_2 = index_2+1;
       temp_i = R(index_1,index_2)*(x_now(index_2)-x_hat(index_2));
       temp_no_sqrt = temp_no_sqrt - temp_i;
    end
    temp_lower = -temp_sqrt + temp_no_sqrt;
    temp_upper = temp_sqrt + temp_no_sqrt;
    index = len-(transition-1);
    bound_lower = temp_lower/R(index,index) + x_hat(index);
    bound_upper = temp_upper/R(index,index) + x_hat(index);
    bound_upper = fix(bound_upper*sqrt(10))/sqrt(10);
    bound_lower = ceil(bound_lower*sqrt(10))/sqrt(10);
end

function [len]=list_length(list)
    % Input parameter
    %     list : vector type
    % Output parameter
    %     len : index number

    len = 0;
    for i=1:4
       if list(i)==0,  break;  else len = len+1;  end
    end
end

function [flag,transition,radius_squared,x_list] =radius_control(radius_squared,transition)
    % Input parameters
    %     radius_squared : current radius
    %     transition : current stage number
    % Output parameters
    %     radius_squared : doubled radius
    %     transition : next stage number
    %     flag : next stage number is calculated from flag
    global len;
    radius_squared = radius_squared*2;
    transition = transition+1;
    flag = 1;
    x_list(len,:)=zeros(1,4);
end

function [check]=vector_comparison(vector_1,vector_2)
    % check if the two vectors are the same
    % Input parameters
    %   pre_x : vector 1
    %   now_x : vector 2
    % Output parameters
    %   check : 1-> same vectors, 0-> different vectors
    check = 0;
    len1 = length(vector_1);  len2 = length(vector_2);
    if len1 ~= len2
      error('vector size is different');
    end
    for column_num = 1:len1
       if vector_1(column_num,1) == vector_2(column_num,1)
         check = check + 1;
       end
    end
    if check == len1,  check = 1;
     else    check = 0;
    end
end

function [flag,transition]=compare_vector_norm(transition)
    % stage index increased(flag = 1) : recalculate x_list(index,:)
    % stage index decreased(flag = 0) : in the previous stage, no candidate x_now in x_list
    % Input parameters
    %     flag : previous stage
    %     transition : stage number
    % Output parameters
    %    flag : next stage number is calculated from flag
    %    transition : next stage number
    global x_list x_pre x_metric x_now x_hat R radius_squared x_sliced len;
    vector_identity = vector_comparison(x_pre,x_now);
    % check if the new candidate is among the ones we found before
    if vector_identity == 1
      % if 1 ? ML solution found
      len_total = 0;
      for i=1:len  % if the vector is unique ? len_total = 0
         len_total = len_total + list_length(x_list(i,:));
      end
      if len_total == 0      % ML solution vector found
        transition = len+2; % finish
        flag = 1;
       else                      % more than one candidates
        transition = transition-1;  % go back to the previous stage
        flag =0;
      end
     else  % if 0 ? new candidate vector is different from the previous candidate vector and norm is smaller ? restart
      x_sliced_temp = x_now;
      metric_temp  = norm(R*(x_sliced_temp-x_hat))^2;
      if metric_temp <=  radius_squared
        % new candidate vector has smaller metric ? restart
        x_pre = x_now;  x_metric = metric_temp;
        x_sliced = x_now;  transition = 1;       % restart
        flag = 2;  x_list=zeros(len,4); % initialization
        x_now=zeros(len,1);  % initialization
       else % new candidate vector has a larger ML metric
        transition = transition-1;  % go back to the previous stage
        flag =0;
      end
    end
end


%DEMO_SPATIAL2  Demonstration for a disease mapping problem with Gaussian
%               process prior and negative binomial observation
%               model
%
%  Description
%    The disease mapping problem consist of a data with number of
%    death cases, Y, and background population, N, appointed to
%    co-ordinates, X. The goal is to find a relative risk surface,
%    which describes if the number of death cases in certain areas
%    is lower or higher than expected. The data is simulated.
%
%    The model is constructed as follows:
%
%    The number of death cases Y_i in area i is assumed to satisfy
%
%         Y_i ~ Neg-Bin(Y_i| d, E_i * r_i)
%
%    where E_i is the expected number of deaths (see Vanhatalo and
%    Vehtari (2007), how E_i is evaluated) at area i, r_i is the
%    relative risk and d is the dispersion parameter coverning the
%    variance.
%
%    We place a zero mean Gaussian process prior for log(R), R =
%    [r_1, r_2,...,r_n], which implies that at the observed input
%    locations latent values, f, have prior
%
%         f = log(R) ~ N(0, K),
%
%    where K is the covariance matrix, whose elements are given as
%    K_ij = k(x_i, x_j | th). The function k(x_i, x_j | th) is
%    covariance function and th its parameters. We place a prior
%    for parameters, p(th).
%
%    The inference is conducted first with Laplace approximation
%    and then with EP. We use compactly supported covariance
%    function which leads to sparse covariance matrix.
%
%  See also
%    DEMO_REGRESSION1, DEMO_CLASSIFIC1, DEMO_SPATIAL1
%
% Copyright (c) 2008-2010 Jarno Vanhatalo
% Copyright (c) 2010 Aki Vehtari

% This software is distributed under the GNU General Public
% License (version 3 or later); please refer to the file
% License.txt, included with the software, for details.

% =====================================
% Laplace approximation
% =====================================

% load the data
S = which('demo_spatial2');
data = load(strrep(S,'demo_spatial2.m','demodata/spatial2.txt'));

x = data(:,1:2);
ye = data(:,3);
y = data(:,4);

% Now we have loaded the following parameters
% x = co-ordinates
% y = number of deaths
% ye = the expexted number of deaths

fprintf(['GP with negative-binomial observation model, Laplace\n' ...
         'integration over the latent values and MAP estimate\n' ...
         'for the parameters\n']);

% Create the covariance functions
pl = prior_t();
pm = prior_sqrtt('s2', 0.3);
if ~exist('ldlchol')
  warning('GPstuff:SuiteSparseMissing',...
    ['SuiteSparse is not properly installed. \n' ...
    'Using gpcf_sexp (non-compact support) instead of gpcf_ppcs2 (compact support)']);
  gpcf1 = gpcf_sexp('lengthScale', 5, 'magnSigma2', 0.05);
  gpcf1 = gpcf_sexp(gpcf1, 'lengthScale_prior', pl, 'magnSigma2_prior', pm);
else
  gpcf1 = gpcf_ppcs2('nin', 2, 'lengthScale', 5, 'magnSigma2', 0.05);
  gpcf1 = gpcf_ppcs2(gpcf1, 'lengthScale_prior', pl, 'magnSigma2_prior', pm);
end

% Create the likelihood structure
lik = lik_negbin();

% Create the GP structure
gp = gp_set('lik', lik, 'cf', gpcf1, 'jitterSigma2', 1e-4);

% Set the approximate inference method to Laplace
gp = gp_set(gp, 'latent_method', 'Laplace');

% Set the options for the scaled conjugate optimization
opt=optimset('TolFun',1e-2,'TolX',1e-2,'Display','iter');
% Optimize with the scaled conjugate gradient method
gp=gp_optim(gp,x,y,'z',ye,'opt',opt);

% Visualize sparsity pattern
figure
C = gp_trcov(gp,x);
fprintf('Proportion of non-zeros is %.4f\n',nnz(C) / prod(size(C)))
p = amd(C);
spy(C(p,p))

% Make prediction to the data points
[Ef, Varf] = gp_pred(gp, x, y, x, 'z', ye);

% Define help parameters for plotting
xii=sub2ind([120 70],x(:,2),x(:,1));
[X1,X2]=meshgrid(1:70,1:120);

% Plot the figures
figure
G=repmat(NaN,size(X1));
G(xii)=exp(Ef);
pcolor(X1,X2,G),shading flat
colormap(mapcolor(G)),colorbar
set(gca, 'Clim', [0.2    1.5])
axis equal
axis([0 70 0 120])
title('Posterior median of the relative risk (Laplace)')

figure
G=repmat(NaN,size(X1));
G(xii)=(exp(Varf) - 1).*exp(2*Ef+Varf);
pcolor(X1,X2,G),shading flat
colormap(mapcolor(G)),colorbar
%set(gca, 'Clim', [0.005    0.03])
axis equal
axis([0 70 0 120])
title('Posterior variance of the relative risk (Laplace)')

% =====================================
% EP approximation
% =====================================
fprintf(['GP with negative-binomial observation model, EP\n' ...
         'integration over the latent values and MAP estimate\n' ...
         'for the parameters\n']);

% Set the approximate inference method to EP
gp = gp_set(gp, 'latent_method', 'EP');

% Set the options for the scaled conjugate optimization
opt=optimset('TolFun',1e-2,'TolX',1e-2,'Display','iter');
% Optimize with the scaled conjugate gradient method
gp=gp_optim(gp,x,y,'z',ye,'opt',opt);

% Visualize sparsity pattern
figure
C = gp_trcov(gp,x);
fprintf('Proportion of non-zeros is %.4f\n',nnz(C) / prod(size(C)))
p = amd(C);
spy(C(p,p))

% make prediction to the data points
[Ef, Varf] = gp_pred(gp, x, y, x, 'z', ye);

% Define help parameters for plotting
xii=sub2ind([120 70],x(:,2),x(:,1));
[X1,X2]=meshgrid(1:70,1:120);

% Plot the figures
figure
G=repmat(NaN,size(X1));
G(xii)=exp(Ef);
pcolor(X1,X2,G),shading flat
colormap(mapcolor(G)),colorbar
set(gca, 'Clim', [0.2    1.5])
axis equal
axis([0 70 0 120])
title('Posterior median of the relative risk (EP)')

figure
G=repmat(NaN,size(X1));
G(xii)=(exp(Varf) - 1).*exp(2*Ef+Varf);
pcolor(X1,X2,G),shading flat
colormap(mapcolor(G)),colorbar
%set(gca, 'Clim', [0.005    0.03])
axis equal
axis([0 70 0 120])
title('Posterior variance of the relative risk (EP)')


function [alphas,l,rho,d12,ix] = matRad_siddonRayTracer(isocenter, ...
                                    resolution, ...
                                    sourcePoint, ...
                                    targetPoint, ...
                                    cubes)
% siddon ray tracing through 3D cube to calculate the radiological depth
% according to Siddon 1985 Medical Physics
%
% call
%   [alphas,l,rho,d12,vis] = matRad_siddonRayTracer(isocenter, ...
%                               resolution, ...
%                               sourcePoint, ...
%                               targetPoint, ...
%                               cubes)
%
% input
%   isocenter:      isocenter within cube [voxels]
%   resolution:     resolution of the cubes [mm/voxel]
%   sourcePoint:    source point of ray tracing
%   targetPoint:    target point of ray tracing
%   cubes:          cell array of cubes for ray tracing (it is possible to pass
%                   multiple cubes for ray tracing to save computation time)
%
% output (see Siddon 1985 Medical Physics for a detailed description of the
% variales)
%   alphas          relative distance between start and endpoint for the
%                    intersections with the cube
%   l               lengths of intersestions with cubes
%   rho             densities extracted from cubes
%   d12             distance between start and endpoint of ray tracing
%   ix              indices of hit voxels
%
% References
%   [1] http://www.ncbi.nlm.nih.gov/pubmed/4000088
%
% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Copyright 2015 the matRad development team.
%
% This file is part of the matRad project. It is subject to the license
% terms in the LICENSE file found in the top-level directory of this
% distribution and at https://github.com/e0404/matRad/LICENSES.txt. No part
% of the matRad project, including this file, may be copied, modified,
% propagated, or distributed except according to the terms contained in the
% LICENSE file.
%
% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Add isocenter to source and target point. Because the algorithm does not
% works with negatives values. This put (resolution.x,resolution.y,resolution.z)
% in the center of first voxel

sourcePoint = sourcePoint + isocenter;
targetPoint = targetPoint + isocenter;

% Save the numbers of planes.
[yNumPlanes, xNumPlanes, zNumPlanes] = size(cubes{1});
xNumPlanes = xNumPlanes + 1;
yNumPlanes = yNumPlanes + 1;
zNumPlanes = zNumPlanes + 1;

% eq 11
% Calculate the distance from source to target point.
d12 = norm(sourcePoint-targetPoint);

% eq 3
% Position of first planes in millimeter. 0.5 because the central position
% of the first voxel is at [resolution.x resolution.y resolution.z]
xPlane_1 = .5*resolution.x;
yPlane_1 = .5*resolution.y;
zPlane_1 = .5*resolution.z;

% Position of last planes in milimiter
xPlane_end = (xNumPlanes - .5)*resolution.x;
yPlane_end = (yNumPlanes - .5)*resolution.y;
zPlane_end = (zNumPlanes - .5)*resolution.z;

% eq 4
% Calculate parametrics values of \alpha_{min} and \alpha_{max} for every
% axis, intersecting the ray with the sides of the CT.
if targetPoint(1) ~= sourcePoint(1)
    aX_1   = (xPlane_1 - sourcePoint(1)) / (targetPoint(1) - sourcePoint(1));
    aX_end = (xPlane_end - sourcePoint(1)) / (targetPoint(1) - sourcePoint(1));
else
    aX_1   = [];
    aX_end = [];
end
if targetPoint(2) ~= sourcePoint(2)
    aY_1   = (yPlane_1 - sourcePoint(2)) / (targetPoint(2) - sourcePoint(2));
    aY_end = (yPlane_end - sourcePoint(2)) / (targetPoint(2) - sourcePoint(2));
else
    aY_1   = [];
    aY_end = [];
end
if targetPoint(3) ~= sourcePoint(3)
    aZ_1   = (zPlane_1 - sourcePoint(3)) / (targetPoint(3) - sourcePoint(3));
    aZ_end = (zPlane_end - sourcePoint(3)) / (targetPoint(3) - sourcePoint(3));
else
    aZ_1   = [];
    aZ_end = [];
end

% eq 5
% Compute the \alpha_{min} and \alpha_{max} in terms of parametric values
% given by equation 4.
alpha_min = max([0 min(aX_1,aX_end) min(aY_1,aY_end) min(aZ_1,aZ_end)]);
alpha_max = min([1 max(aX_1,aX_end) max(aY_1,aY_end) max(aZ_1,aZ_end)]);

% eq 6
% Calculate the range of indeces who gives parametric values for
% intersected planes.
if targetPoint(1) == sourcePoint(1)
    i_min = []; i_max = [];
elseif targetPoint(1) > sourcePoint(1)
    i_min = xNumPlanes - (xPlane_end - alpha_min * (targetPoint(1) - sourcePoint(1)) - sourcePoint(1))/resolution.x;
    i_max = 1          + (sourcePoint(1) + alpha_max * (targetPoint(1) - sourcePoint(1)) - xPlane_1)/resolution.x;
    % rounding
    i_min = ceil(1/1000*(round(1000*i_min)));
    i_max = floor(1/1000*(round(1000*i_max)));
else
    i_min = xNumPlanes - (xPlane_end - alpha_max * (targetPoint(1) - sourcePoint(1)) - sourcePoint(1))/resolution.x;
    i_max = 1          + (sourcePoint(1) + alpha_min * (targetPoint(1) - sourcePoint(1)) - xPlane_1)/resolution.x;
    i_min = ceil(1/1000*(round(1000*i_min)));
    i_max = floor(1/1000*(round(1000*i_max)));
end
if targetPoint(2) == sourcePoint(2)
    j_min = []; j_max = [];
elseif targetPoint(2) > sourcePoint(2)
    j_min = yNumPlanes - (yPlane_end - alpha_min * (targetPoint(2) - sourcePoint(2)) - sourcePoint(2))/resolution.y;
    j_max = 1          + (sourcePoint(2) + alpha_max * (targetPoint(2) - sourcePoint(2)) - yPlane_1)/resolution.y;
    j_min = ceil(1/1000*(round(1000*j_min)));
    j_max = floor(1/1000*(round(1000*j_max)));
else
    j_min = yNumPlanes - (yPlane_end - alpha_max * (targetPoint(2) - sourcePoint(2)) - sourcePoint(2))/resolution.y;
    j_max = 1          + (sourcePoint(2) + alpha_min * (targetPoint(2) - sourcePoint(2)) - yPlane_1)/resolution.y;
    j_min = ceil(1/1000*(round(1000*j_min)));
    j_max = floor(1/1000*(round(1000*j_max)));
end
if targetPoint(3) == sourcePoint(3)
    k_min = []; k_max = [];
elseif targetPoint(3) >= sourcePoint(3)
    k_min = zNumPlanes - (zPlane_end - alpha_min * (targetPoint(3) - sourcePoint(3)) - sourcePoint(3))/resolution.z;
    k_max = 1          + (sourcePoint(3) + alpha_max * (targetPoint(3) - sourcePoint(3)) - zPlane_1)/resolution.z;
    k_min = ceil(1/1000*(round(1000*k_min)));
    k_max = floor(1/1000*(round(1000*k_max)));
else
    k_min = zNumPlanes - (zPlane_end - alpha_max * (targetPoint(3) - sourcePoint(3)) - sourcePoint(3))/resolution.z;
    k_max = 1          + (sourcePoint(3) + alpha_min * (targetPoint(3) - sourcePoint(3)) - zPlane_1)/resolution.z;
    k_min = ceil(1/1000*(round(1000*k_min)));
    k_max = floor(1/1000*(round(1000*k_max)));
end

% eq 7
% For the given range of indices, calculate the paremetrics values who
% represents intersections of the ray with the plane.
if i_min ~= i_max
    if targetPoint(1) > sourcePoint(1)
        alpha_x = (resolution.x*(i_min:1:i_max)-sourcePoint(1)-.5*resolution.x)/(targetPoint(1)-sourcePoint(1));
    else
        alpha_x = (resolution.x*(i_max:-1:i_min)-sourcePoint(1)-.5*resolution.x)/(targetPoint(1)-sourcePoint(1));
    end
else
    alpha_x = [];
end
if j_min ~= j_max
    if targetPoint(2) > sourcePoint(2)
        alpha_y = (resolution.y*(j_min:1:j_max)-sourcePoint(2)-.5*resolution.y)/(targetPoint(2)-sourcePoint(2));
    else
        alpha_y = (resolution.y*(j_max:-1:j_min)-sourcePoint(2)-.5*resolution.y)/(targetPoint(2)-sourcePoint(2));
    end
else
    alpha_y = [];
end
if k_min ~= k_max
    if targetPoint(3) > sourcePoint(3)
        alpha_z = (resolution.z*(k_min:1:k_max)-sourcePoint(3)-.5*resolution.z)/(targetPoint(3)-sourcePoint(3));
    else
        alpha_z = (resolution.z*(k_max:-1:k_min)-sourcePoint(3)-.5*resolution.z)/(targetPoint(3)-sourcePoint(3));
    end
else
    alpha_z = [];
end

% eq 8
% Merge parametrics sets.
alphas = unique([alpha_min alpha_x alpha_y alpha_z alpha_max]);

% eq 10
% Calculate the voxel intersection length.
l = d12*diff(alphas);

% eq 13
% Calculate \alpha_{middle}
alphas_mid = .5*(alphas(1:end-1)+alphas(2:end));

% eq 12
% Calculate the voxel indices: first convert to physical coords
i_mm = sourcePoint(1) + alphas_mid*(targetPoint(1) - sourcePoint(1));
j_mm = sourcePoint(2) + alphas_mid*(targetPoint(2) - sourcePoint(2));
k_mm = sourcePoint(3) + alphas_mid*(targetPoint(3) - sourcePoint(3));
% then convert to voxel index
i = round(i_mm/resolution.x);
j = round(j_mm/resolution.y);
k = round(k_mm/resolution.z);

% Handle numerical instabilities at the borders.
i(i<=0) = 1; j(j<=0) = 1; k(k<=0) = 1;
i(i>xNumPlanes-1) = xNumPlanes-1;
j(j>yNumPlanes-1) = yNumPlanes-1;
k(k>zNumPlanes-1) = zNumPlanes-1;

% Convert to linear indices
ix = j + (i-1)*size(cubes{1},1) + (k-1)*size(cubes{1},1)*size(cubes{1},2);

% obtains the values from cubes
rho = cell(numel(cubes),1);
for i = 1:numel(cubes)
    rho{i} = cubes{i}(ix);
end


% Author: Housam Binous

% Dynamic and control of a tank using the genetic algorithm toolbox

% National Institute of Applied Sciences and Technology, Tunis, TUNISIA

% Email: binoushousam@yahoo.com

function f=obj2(par)

global sys

% real PID controller's transfer function

num=[par(2) 1];
den=[par(2) 0];

pid1=tf(num,den);

num=[par(3) 1];
den=[0.1*par(3) 1];

pid2=tf(num,den);

pid=par(1)*pid1*pid2;

% response to change in set point
% set point for tank's height is equal to 2

sys_series=series(pid,sys);

sys_controlled=feedback(sys_series,1);

u=2*ones(501,1);

[y1 t3]=lsim(sys_controlled,u,0:0.01:5);

% objective function to be minimized by
% genetic algorithm in order to obtain
% real PID controller's parameters

f=0;

for i=1:201
    f=f+abs(2-y1(i))*t3(i);
end


% This is a simple example of how to fit
% a cubic spline contour
% to data using active geometric shape model.

% Copyright (C) 2012 Quan Wang <wangq10@rpi.edu>,
% Signal Analysis and Machine Perception Laboratory,
% Department of Electrical, Computer, and Systems Engineering,
% Rensselaer Polytechnic Institute, Troy, NY 12180, USA
%
% You are free to use this software for academic purposes if you cite our paper:
% Quan Wang, Kim L. Boyer,
% The active geometric shape model: A new robust deformable shape model and its applications,
% Computer Vision and Image Understanding, Volume 116, Issue 12, December 2012, Pages 1178-1194,
% ISSN 1077-3142, 10.1016/j.cviu.2012.08.004.
%
% For commercial use, please contact the authors.

clear;clc;close all;
addpath('../force field');
addpath('../math');

%% 1. experiment set up

% image size = 400*500
rows=400;
cols=500;

% number of trials
Num_Of_Trials=10;

% number of data points and outliers
num_data=100;
num_outlier=5;
noise=5;

% number of landmarks for data/model
Nlm=6; % data
NN=6; % model

% ground truth parameters
x0=250+(rand(1)-0.5)*100;
y0=200+(rand(1)-0.5)*100;
D0=60+rand(1,Nlm)*100;

% image blur parameters
sigma1=20;
sigma2=5;

%% 2. generate data

% generate data points and outliers
theta=rand(num_data,1)*2*pi;
lm_theta=linspace(0,2*pi,Nlm+1);
DD=myspline(lm_theta,D0,theta);
x=x0+DD.*cos(theta)+noise*randn(size(theta));
y=y0+DD.*sin(theta)+noise*randn(size(theta));
x=[x;rand(num_outlier,1)*cols];
y=[y;rand(num_outlier,1)*rows];
x=round(x);
y=round(y);
x(x<1)=1;
x(x>cols)=cols;
y(y<1)=1;
y(y>rows)=rows;
xp=x;
yp=y;

% display data points and outliers
plot(x,y,'.');
axis equal;
axis([1 cols 1 rows]);
title('data points and outliers');
xlabel('x');
ylabel('y');
drawnow;

% generate image
I=zeros(rows,cols);
for i=1:max(size(y))
    I(y(i),x(i))=100;
end
[m n]=size(I);

%% 3. GVF field
I2=gaussianBlur(I,sigma1);
[u,v] = GVF(I2, 1 , 0.1, 50);
dx2=u;dy2=v;

I3=gaussianBlur(I,sigma2);
[dx3 dy3]=gradient(I3);

best_fit=Inf;

%% 4. many trials
disp('Fitting the cubic spline contour...');
for trial=1:Num_Of_Trials
    close all;
    fprintf('Trial: %d\n',trial);
    init=[250+(rand(1)-0.5)*100,200+(rand(1)-0.5)*100,60+rand(1,NN)*40];
    increment=[0.2,0.2,0.2];
    threshold=[0.000001,0.000001,0.000001];
    bound=[40,150];
    %% fit a spline contour
    % stage 1: big sigma
    [xc yc D fit_save]=fit_spline_contour_force(...
        init,increment,threshold,bound,dx2,dy2,500,0);

    % stage 2: small sigma
    [xc yc D]=fit_spline_contour_force(...
        [xc yc D],increment,threshold,bound,dx3,dy3,100,0);

    %% correction
    clear D2;
    for k=1:NN
        dt=2*pi/100000;
        angle=2*pi/NN*(k-1);

        lm_theta=linspace(0,2*pi,NN+1);
        distances=myspline(lm_theta,D,[angle-dt angle angle+dt]);
        r=D(k);
        r1=(distances(3)-distances(1)) / (2*dt);
        r2=(distances(3)+distances(1)-2*distances(2)) / (dt^2);
        D2(k)=correctCurve_polar(r,r1,r2,sigma2,100);
    end
    D=D2;

    %% fitness function
    beta=0.9;
    fit0=0;
    fit1=0;
    fit2=0;
    [x,y,theta]=spline_contour_in_image(m,n,xc,yc,D);
    [x1,y1,theta1]=spline_contour_in_image(m,n,xc,yc,D*beta);
    [x2,y2,theta2]=spline_contour_in_image(m,n,xc,yc,D/beta);
    for i=1:max(size(theta))
        fit0=fit0+norm([dx2(y(i),x(i)),dy2(y(i),x(i))]);
    end
    for i=1:max(size(theta1))
        fit1=fit1+norm([dx2(y1(i),x1(i)),dy2(y1(i),x1(i))]);
    end
    for i=1:max(size(theta2))
        fit2=fit2+norm([dx2(y2(i),x2(i)),dy2(y2(i),x2(i))]);
    end
    fit0=fit0/max(size(theta));
    fit1=fit1/max(size(theta1));
    fit2=fit2/max(size(theta2));
    current_fit=fit0-fit1/2-fit2/2;

    if current_fit<best_fit
        best_fit=current_fit;
        best_xc=xc;
        best_yc=yc;
        best_D=D;
        best_fit_save=fit_save;
    end
end

% display fitting results
close all;

figure;
plot(xp,yp,'.');
axis equal;
axis([1 cols 1 rows]);
hold on;
theta=0:0.01:2*pi;
[x2,y2,temp]=spline_contour_in_image(rows,cols,best_xc,best_yc,best_D);
plot(x2,y2,'-.r','LineWidth',2);
plot(xp,yp,'.');
legend('noisy data points and outliers','active geometric shape model fit');
title('fitting a cubic spline contour using active geometric shape model');
xlabel('x');
ylabel('y');

%% 5. show numerical results
fprintf('num_data=%-4d    num_outlier=%-4d    \n',num_data,num_outlier);
fprintf('Nlm(data)=%-4d   Nlm(model)=%-4d    \n',Nlm,NN);
fprintf('------------------------------------------------------------\n');
fprintf('         xc        yc        D   \n');
fprintf('True:  ');
disp([x0 y0 D0]);
fprintf('Fit:   ');
disp([best_xc best_yc best_D]);

%% 6. show fitness function
figure;hold on;
plot(1:500,best_fit_save,'b','LineWidth',2);
legend('fitness function');
grid on;
xlabel('iteration');
ylabel('fitness function');
title('fitness function in each iteration');


function [sys,x0,str,ts]=Nonlinear_PD_fhan(t,x,u,flag,r,h,h1)

if flag==0

    sys = [0;1;1;2;0;1;1];
     x0 = [0];
    str = [ ];
     ts = [h 0];

elseif flag==2

    sys=-fhan(u(1),u(2),r,h1);

elseif flag==3
    sys=x;

elseif flag==4
    sys=sys+h;

else
    sys=[];
end
function y=fhan(x1,x2,r,h)
d=r*h;
d0=h*d;
y=x1+h*x2;
a0=sqrt(d^2+8*r*abs(y));
if abs(y)>d0
    a=x2+(a0-d)*sign(y)/2;
else
    a=x2+y/h;
end

if abs(a)>d
    y=-r*sign(a);
else
    y=-r*a/d;
end


function bvec_sub_test ( )

%*****************************************************************************80
%
%% BVEC_SUB_TEST tests BVEC_SUB;
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    03 January 2015
%
%  Author:
%
%    John Burkardt
%
  n = 10;
  seed = 123456789;
  test_num = 10;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'BVEC_SUB_TEST\n' );
  fprintf ( 1, '  BVEC_SUB subtracts binary vectors representing integers;\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '        I        J        I - J   BVEC_SUB\n' );
  fprintf ( 1, '\n' );

  for test = 1 : test_num

    [ i, seed ] = i4_uniform_ab ( -100, 100, seed );
    [ j, seed ] = i4_uniform_ab ( -100, 100, seed );

    k = i - j;

    bvec1 = i4_to_bvec ( i, n );
    bvec2 = i4_to_bvec ( j, n );
    bvec4 = bvec_sub ( n, bvec1, bvec2 );
    l = bvec_to_i4 ( n, bvec4 );

    fprintf ( 1, '  %8d  %8d  %8d  %8d\n', i, j, k, l );

  end

  return
end


function out = correl_compare_dep_permtest(y1,y2,varargin)
% Compare dependent correlations between pairs of vectors in y1 and y2
%
% :Usage:
% ::
%
%     out = correl_compare_dep_permtest(y1,y2,['alpha',myalpha],['rank'],['table'])
%
% :PERMUTATION TEST: for correl_compare_dep
%
% Repeats dep. correl. analysis for each pair of columns
% Returns results in correlation matrix form, where number of rows and
% cols. are the number of pairs [y1(:,i) y2(:,i)]
%
% myalpha is 2-tailed alpha value; p-values are 2-tailed
% FDR correction is at .01, 2-tailed
%
% Based on Steiger, 1980, tests for comparing dependent correlations.
%
% :Examples:
% ::
%
%    for i = 1:length(cl), y1(:,i) = cl.CONTRAST.data(:,2); y2(:,i) = cl.CONTRAST.data(:,1); end
%    for i = 1:length(cl), y1(:,i) = cl(i).CONTRAST.data(:,2); y2(:,i) = cl(i).CONTRAST.data(:,1); end
%    y1 is matrix of obs x data vectors for condition 1
%    y2 is matrix of obs x data vectors for condition 2
%    out = correl_compare_dep(y1,y2)
%
%    figure('Color','w');nmdsfig(c.GroupSpace,c.ClusterSolution.classes, ...
%    c.names,out.sig,1,{'Pos' 'Neg'});
%    nmdsfig_legend(c.ClusterSolution.X,c.r)
%
%    % compare correlations on cluster averages
%    c_compare = correl_compare_dep(y1avg,y2avg,'alpha',.05,'rank','table','names',c.APPLY_CLUSTER.names);

    myalpha = .05;
    dorankdata = 0;
    dotable = 0;
    names = [];

    for i = 1:length(varargin)
        if isstr(varargin{i})
            switch varargin{i}
                % functional commands
                case 'alpha', myalpha = varargin{i+1};
                case 'rank', dorankdata = 1;
                case 'table', dotable = 1;
                case 'names', names = varargin{i+1};
                otherwise, warning(['Unknown input string option:' varargin{i}]);
            end
        end
    end

    [N,npairs] = size(y1);

    [rows,cols,ncorr] = corrcoef_indices(npairs);

    if nargin < 4, dorankdata = 0; end
    if dorankdata
        str = sprintf('Ranking data: Nonparametric correlations'); fprintf(1,str);

        for i = 1:npairs
            y1(:,i) = rankdata(y1(:,i));
            y2(:,i) = rankdata(y2(:,i));
        end
    else
        str = sprintf('Assuming continuous data (no ranks).'); fprintf(1,str);
    end

    erase_string(str);

    i = 1; j = 2; k = 3; h = 4;

    % ----------------------------------------
    %%% Correct Permutation %%%
    % ----------------------------------------
    str = sprintf('Computing differences among correlations %04d',0); fprintf(1,str);

    [diffr,Zstar2,rr,pvec] = compare_dep_subfcn(ncorr,y1,y2,rows,cols,i,j,k,h,N);

    erase_string(str);

    % ----------------------------------------
    %%% All output stuff %%%
    % ----------------------------------------
    r1 = reconstruct(rr(:,1),npairs,ncorr,rows,cols);
    r2 = reconstruct(rr(:,2),npairs,ncorr,rows,cols);

    Z = reconstruct(Zstar2,npairs,ncorr,rows,cols);
    p = reconstruct(pvec,npairs,ncorr,rows,cols);

    dat = [rr diffr Zstar2 pvec];
    dat = [rows cols dat];
    dat = dat(pvec <= myalpha,:);

    diffr = reconstruct(diffr,npairs,ncorr,rows,cols);

    sig = (p <= myalpha - eye(size(p))) .* sign(diffr);

    % FDR corrected
    pthr = FDR(pvec,.05);
    if isempty(pthr), pthr = 0; end

    sigfdr = (p <= pthr) .* sign(diffr);

    out = struct('alpha',myalpha,'r1',r1,'r2',r2,'diffr',diffr, ...
        'Z',Z,'p',p,'sig',sig,'pthr',pthr,'sigfdr',sigfdr,'sigstats',dat);

    % output table...
    if dotable
        if isempty(names)
            disp(['No names entered; try ''names'' keyword to add them.']);
            for ii = 1:npairs, names{ii} = ['R' num2str(ii)]; end
        end

        disp(['Uncorrected, p < ' num2str(myalpha)])
        maketable(out,'sig',names);
        disp('')

        disp(['FDR corrected, p < ' num2str(myalpha)])
        maketable(out,'sigfdr',names);
        disp('')
    end

    % ----------------------------------------
    %%% Permutations %%%
    % ----------------------------------------
    niter = 5000;

    [out.nalpha,out.n01,out.nalpha_posvsneg,out.n01_posvsneg] = do_perms;
    out.crit_n_at_alpha = prctile(out.nalpha,95);
    out.crit_n_at_01 = prctile(out.n01,95);
    out.crit_sumsigned_at_alpha = prctile(out.nalpha_posvsneg,97.5);
    out.crit_sumsigned_at_01 = prctile(out.n01_posvsneg,97.5);

    out.numsig_at_alpha = sum(squareform(out.p) <= out.alpha);
    out.numsig_at_01 = sum(squareform(out.p) <= .01);

    out.sumsigned_at_alpha = sum(  (squareform(out.p) <= out.alpha) .* sign(squareform(out.diffr))  );
    out.sumsigned_at_01 = sum(  (squareform(out.p) <= .01) .* sign(squareform(out.diffr))  );

    if dotable
        fprintf(1,'Alpha: %3.4f, Num. sig: %3.0f, Critical num sig: %3.0f\n',out.alpha,out.numsig_at_alpha,out.crit_n_at_alpha);
        fprintf(1,'Alpha: %3.4f, Num. sig: %3.0f, Critical num sig: %3.0f\n',.01,out.numsig_at_01,out.crit_n_at_01);

        fprintf(1,'Alpha: %3.4f, Sum of signed sig.: %3.0f, Critical num 2-tailed: %3.0f\n',out.alpha,out.sumsigned_at_alpha, out.crit_sumsigned_at_alpha);
        fprintf(1,'Alpha: %3.4f, Sum of signed sig.: %3.0f, Critical num 2-tailed: %3.0f\n',.01,out.sumsigned_at_01, out.crit_sumsigned_at_01);

    end

    % nested function
    % get number of significant effects under null hypothesis at alpha and at
    % .01
    function [nalpha,n01,nalpha_posvsneg,n01_posvsneg] = do_perms

        nalpha = zeros(1,niter);
        n01 = nalpha;
        nalpha_posvsneg = nalpha;
        n01_posvsneg = nalpha;

        fprintf(1,'Getting distribution for number of significant correlations.\n  Running %3.0f permutations: %04d',niter,0);

        for ii = 1:niter
            fprintf(1,'\b\b\b\b%04d',ii);

            % permute data
            for jj = 2:npairs
                wh = randperm(N);
                y1(:,jj) = y1(wh,jj);
                y2(:,jj) = y2(wh,jj);
            end

            % test correlations
            [diffr,Zstar2,rr,pvec] = compare_dep_subfcn(ncorr,y1,y2,rows,cols,i,j,k,h,N,0);

            nalpha(ii) = sum(pvec <= myalpha);
            n01(ii) = sum(pvec <= .01);

            nalpha_posvsneg(ii) = sum(  (pvec <= myalpha) .* sign(diffr)  );
            n01_posvsneg(ii) = sum(  (pvec <= .01) .* sign(diffr)  );

        end
        fprintf(1,'\n');

    end

    end   %%% end main function

    function [diffr,Zstar2,rr,pvec] = compare_dep_subfcn(ncorr,y1,y2,rows,cols,i,j,k,h,N,dotext)

    diffr = zeros(ncorr,1);     % correlation difference
    Zstar2 = zeros(ncorr,1);    % from Steiger, the Z-score
    rr = zeros(ncorr,2);        % the correl values for y1 and y2

    if ~exist('dotext','var'), dotext = 1; end

    for cc = 1:ncorr

        if dotext, fprintf(1,'\b\b\b\b%04d',cc); end

        % get full correlation matrix for the 4 variables involved
        dat = [y1(:,[rows(cc) cols(cc)]) y2(:,[rows(cc) cols(cc)])];

        % get differences between correlation z-values (estimate)
        [diffr(cc),r,rr(cc,:),diffrz,z] = correlation_diffs(dat,i,j,k,h);

        s = covcorr(r,i,j,k,h);         % covariance of corr coeffs

        Zstar2(cc) = diffrz * sqrt( (N-3) ./ (2-(2*s)) );

        % bootstrap
        %vals = bootstrp(5000,@correlation_diffs,dat,i,j,k,h);
        %Zboot(cc) = mean(vals) ./ std(vals);

        %if Zstar2(cc) > 2, keyboard, end
    end

    pvec = 2 * (1 - normcdf(abs(Zstar2)));

    end

function [diffr,r,rr,diffrz,z] = correlation_diffs(dat,i,j,k,h)
    % get differences between correlation z-values
    r = corrcoef(dat);

    rr = [r(i,j) r(k,h)];                % correls to be compared
    diffr = -diff(rr);              % negative sign means we get (1) - (2)

    if nargout > 3
        z = .5 .* log( (1+rr) ./ (1-rr) );
        diffrz = -diff(z);               % diff btwn correl z values
    end

    end

function [rows,cols,ncorr] = corrcoef_indices(npairs)
    % upper triangle only
    tmp = triu(ones(npairs));
    tmp = tmp - eye(npairs);
    [rows,cols] = find(tmp);
    ncorr = length(rows);
    end

function s = covcorr(R,i,j,k,h)

    % pool correl. coeff for more stable var est.
    % as they are equal under Ho.  Steiger, 1980, eq. 14 for Z*
    pooledr = mean([R(i,j) R(k,h)]);
    s = pearsonf(R,i,j,k,h) ./  ( corvar(pooledr) );

    end

function cv = corvar(r)
    % variance of a correlation coefficient
    % simplified form (special case) of pearsonf
    cv = (1 - r^2) ^ 2;
    end

    % % function cv = co(R,x,y)
    % % % x and y are 2-vector indices of matrix R to compute covariance for
    % % % cv is covariance
    % % cv = pearsonf(R,x(1),x(2),y(1),y(2));
    % % end

function pf = pearsonf(R,i,j,k,h)

    % Pearson-Filon: covariance (or var) of element i,j with element k,h
    % depending on correlation values

    % for variance of 1 correl, works as well, and reduces to:
    % (1 - rr(1)^2)^2

    pf = (1/2) .* R(i,j) .* R(k,h) .* ...
        ( R(i,k).^2 + R(i,h).^2 + R(j,k).^2 + R(j,h).^2 ) + ...
        R(i,k) .* R(j,h) + R(i,h) .* R(j,k) - ...
        R(i,j) .* ( R(j,k) .* R(j,h) + R(i,k) .* R(i,h) ) - ...
        R(k,h) .* ( R(j,k) .* R(i,k) + R(j,h) .* R(i,h) );

    end

    % function pf = pearsonf2(r,j,k,h,m)
    %
    % pf = .5 * ( (r(j,h) - r(j,k)*r(k,h)) * (r(k,m) - r(k,h)*r(h,m))  + ...
    %     (r(j,m) - r(j,h)*r(h,m)) * (r(k,h) - r(k,j)*r(j,h)) + ...
    %     (r(j,h) - r(j,m)*r(m,h)) * (r(k,m) - r(k,j)*r(j,m)) + ...
    %     (r(j,m) - r(j,k)*r(k,m)) * (r(k,h) - r(k,m)*r(m,h))    );
    %
    % end

function valmat = reconstruct(vals,npairs,ncorr,rows,cols)

    valmat = zeros(npairs);
    for i = 1:ncorr
        valmat(rows(i),cols(i)) = vals(i);
    end
    valmat = valmat + valmat';

    end

function erase_string(str1)
    fprintf(1,repmat('\b',1,length(str1))); % erase string
    end

% function maketable(c_compare,whfield,names)
%     [rows,cols] = find(triu(c_compare.(whfield)));
%     if isempty(rows)
%         disp('No significant results.')
%     else
%         fprintf(1,'Name1\tName2\trow\tcol.\t+ or -\tZ\tp\n');
%         for i = 1:length(rows)
%             fprintf(1,'%s\t%s\t%3.0f\t%3.0f\t%3.0f\t%3.2f\t%3.4f\n',names{rows(i)}, ...
%                 names{cols(i)},rows(i),cols(i),c_compare.(whfield)(rows(i),cols(i)),c_compare.Z(rows(i),cols(i)),c_compare.p(rows(i),cols(i)));
%         end
%     end
%     fprintf(1,'\n');
%     end

function maketable(c_compare,whfield,names)

    str = {'-' '+'};
    [rows,cols] = find(triu(c_compare.(whfield)));
    if isempty(rows)
        disp('No significant results.')
    else
        fprintf(1,'Name1\tName2\trow\tcol.\t+ or -\tr1\tr2\tZ\tp\n');
        for i = 1:length(rows)
            fprintf(1,'%s\t%s\t%3.0f\t%3.0f\t%s\t%3.3f\t%3.3f\t%3.2f\t%3.4f\n', ...
                names{rows(i)}, names{cols(i)},rows(i),cols(i), ...
                str{1.5 + (.5.*c_compare.(whfield)(rows(i),cols(i)))}, ...          % + or - sign
                c_compare.r1(rows(i),cols(i)),c_compare.r2(rows(i),cols(i)), ...   % correlations
                c_compare.Z(rows(i),cols(i)),c_compare.p(rows(i),cols(i)));        % Z and p
        end
    end
    fprintf(1,'\n');
end


//Make some assumptions
// let's assume seq_len = 64 for now
// N d_mod d_ff h dk dv
// 6 512   2048 8 64 64
Constant Seq_Len 128;

Network Transformer {
	//Start encoder
	Layer MH_FC_DimReduce_VKQ_0 { //Batched FC layer, where seq_len is batch, input is d_model x 1
		Type: CONV
		Stride { X: 1, Y: 1 }	// k = 3 * 512, one for each VKQ
		Dimensions { N: Seq_Len, K: 1536, C: 1, R: 1, S: 512, Y:1, X:512 }
		Dataflow {
			SpatialMap(1,1) K;
			TemporalMap(1,1) C;
			TemporalMap(Sz(R),Sz(R)) R;
			TemporalMap(Sz(S),Sz(S)) S;
			TemporalMap(Sz(R),1) Y;
			TemporalMap(Sz(S),1) X;
			Cluster(1, P);
			SpatialMap(1,1) C;
			TemporalMap(Sz(R),1) Y;
			TemporalMap(Sz(S),1) X;
			TemporalMap(Sz(R),Sz(R)) R;
			TemporalMap(Sz(S),Sz(S)) S;
		}
	} //good

	Layer SD_MatMul_QK_00 { //Mat mul, batch is 1
		Type: CONV //MatMul -> M(seql)xK(dv)xN(seql)-> filter = Kx1(m chans), input = KxN
		Stride { X: 1, Y: 1 }
		//N=1, K(conv)=M(matr), C=1, R(conv)=K(matr),S=1,Y(conv)=K(matr), X(conv)=N(matr)
		Dimensions { N: 1, K: Seq_Len, C: 1, R: 64, S: 1, Y:64, X:Seq_Len }
		Dataflow {
			SpatialMap(2,1) K;
			TemporalMap(1,1) C;
			TemporalMap(Sz(R),Sz(R)) R;
			TemporalMap(Sz(S),Sz(S)) S;
			TemporalMap(Sz(R),1) Y;
			TemporalMap(Sz(S),1) X;

		}
	}

	Layer SD_MatMul_V_00 { //Mat mul, batch is 1
		Type: CONV //MatMul -> M(seql)xK(seql)xN(dv)-> filter = Kx1(m chans), input = KxN
		Stride { X: 1, Y: 1 }
		//N=1, K(conv)=M(matr), C=1, R(conv)=K(matr),S=1,Y(conv)=K(matr), X(conv)=N(matr)
		Dimensions { N: 1, K: Seq_Len, C: 1, R: Seq_Len, S: 1, Y:Seq_Len, X:64 }
		Dataflow {
			SpatialMap(1,1) K;
			TemporalMap(1,1) C;
			TemporalMap(Sz(R),Sz(R)) R;
			TemporalMap(Sz(S),Sz(S)) S;
			TemporalMap(Sz(R),1) Y;
			TemporalMap(Sz(S),1) X;
			Cluster(1, P);
			SpatialMap(1,1) C;
			TemporalMap(Sz(R),1) Y;
			TemporalMap(Sz(S),1) X;
			TemporalMap(Sz(R),Sz(R)) R;
			TemporalMap(Sz(S),Sz(S)) S;
		}
	}

	// done with h parallel sd layers now
	Layer MH_FC_DimRecast_0 { //Batched FC layer, where seq_len is batch, input is d_model x 1
		Type: CONV
		Stride { X: 1, Y: 1 }	// v,k,q have been combined
		Dimensions { N: Seq_Len, K: 512, C: 1, R: 1, S: 512, Y:1, X:512 }
		Dataflow {
			SpatialMap(1,1) K;
			TemporalMap(1,1) C;
			TemporalMap(Sz(R),Sz(R)) R;
			TemporalMap(Sz(S),Sz(S)) S;
			TemporalMap(Sz(R),1) Y;
			TemporalMap(Sz(S),1) X;
			Cluster(1, P);
			SpatialMap(1,1) C;
			TemporalMap(Sz(R),1) Y;
			TemporalMap(Sz(S),1) X;
			TemporalMap(Sz(R),Sz(R)) R;
			TemporalMap(Sz(S),Sz(S)) S;
		}
	} //good

	/// done with h parallel sd layers now
	Layer FF_A_0 { //Batched FC layer, where seq_len is batch, input is d_model x 1
		Type: CONV //2048 output neurons, 512->2048
		Stride { X: 1, Y: 1 }
		Dimensions { N: Seq_Len, K: 2048, C: 1, R: 1, S: 512, Y:1, X:512 }
		Dataflow {
			SpatialMap(1,1) K;
			TemporalMap(1,1) C;
			TemporalMap(Sz(R),Sz(R)) R;
			TemporalMap(Sz(S),Sz(S)) S;
			TemporalMap(Sz(R),1) Y;
			TemporalMap(Sz(S),1) X;
			Cluster(1, P);
			SpatialMap(1,1) C;
			TemporalMap(Sz(R),1) Y;
			TemporalMap(Sz(S),1) X;
			TemporalMap(Sz(R),Sz(R)) R;
			TemporalMap(Sz(S),Sz(S)) S;
		}
	} //good

	/// done with h parallel sd layers now
	Layer FF_B_0 { //Batched FC layer, where seq_len is batch, input is d_model x 1
		Type: CONV //2048 -> 512
		Stride { X: 1, Y: 1 }
		Dimensions { N: Seq_Len, K: 512, C: 1, R: 1, S: 2048, Y:1, X:2048 }
		Dataflow {
			SpatialMap(1,1) K;
			TemporalMap(1,1) C;
			TemporalMap(Sz(R),Sz(R)) R;
			TemporalMap(Sz(S),Sz(S)) S;
			TemporalMap(Sz(R),1) Y;
			TemporalMap(Sz(S),1) X;
			Cluster(1, P);
			SpatialMap(1,1) C;
			TemporalMap(Sz(R),1) Y;
			TemporalMap(Sz(S),1) X;
			TemporalMap(Sz(R),Sz(R)) R;
			TemporalMap(Sz(S),Sz(S)) S;
		}
	} //good

}


function handWritingTest
%%
clc
clear
close all
%% 获取目录下的所有txt文件名称
d = dir(['digits/trainingDigits/' '*.txt']); % struct 类型
dircell = struct2cell(d); %cell 类型
trainSetLen = size(dircell,2);
K = 4;
dataSize = 1024;
trainLabels = zeros(trainSetLen,1);
trainSet = [];
simpleTrainSet = zeros(1,dataSize);
simpleTestSet = zeros(1,dataSize);

%% 加载数据
fprintf('loading data...')
for i = 1:trainSetLen
    trainName =  dircell(1,i);
    trainFilename = cell2mat(trainName);
    trainLabels(i) = str2num(trainFilename(1));

    fid = fopen(['digits/trainingDigits/' trainFilename],'r');
    traindata = fscanf(fid,'%s');
    for j = 1:dataSize
        simpleTrainSet(j) =  str2num(traindata(j));
    end
    trainSet = [trainSet ; simpleTrainSet];
    fclose(fid);
end

d = dir(['digits/testDigits/' '*.txt']); % struct 类型
dircell = struct2cell(d); %cell 类型
testSetLen = size(dircell,2);
error = 0;
%% 测试数据
for k = 1:testSetLen
    testName =  dircell(1,k);
    testFilename = cell2mat(testName);
    testLabels = str2num(testFilename(1));

    fid = fopen(['digits/testDigits/' testFilename],'r');
    testdata = fscanf(fid,'%s');
    for j = 1:dataSize
        simpleTestSet(j) =  str2num(testdata(j));
    end
    classifyResult = KNN(simpleTestSet,trainSet,trainLabels,K);
    fprintf('识别数字为：%d  真实数字为：%d\n' , [classifyResult , testLabels])
    if(classifyResult~=testLabels)
        error = error+1;
    end
    fclose(fid);
end

fprintf('识别准确率为：%f\n',1-error/testSetLen)

end


%% Compose two vector fields
%  Changed: Dec 31st, 2011
%
function [vx,vy,vz] = compose(ax,ay,az, bx,by,bz)

    % Piggyback
    piggybackscale = 1.2; % just to get too many outside values
    [ax,lim] = piggyback(ax,piggybackscale);
    [ay,lim] = piggyback(ay,piggybackscale);
    [az,lim] = piggyback(az,piggybackscale);
    [bx,lim] = piggyback(bx,piggybackscale);
    [by,lim] = piggyback(by,piggybackscale);
    [bz,lim] = piggyback(bz,piggybackscale);

    % Coordinates
    nx = size(ax,1);
    ny = size(ax,2);
    nz = size(ax,3);

    [y,x,z] = ndgrid(1:nx, 1:ny, 1:nz); % coordinate image

    % Where points are going
    xp  = iminterpolate(x+ax, bx,by,bz);
    yp  = iminterpolate(y+ay, bx,by,bz);
    zp  = iminterpolate(z+az, bx,by,bz);

    % Update field
    vx = xp - x;
    vy = yp - y;
    vz = zp - z;

    % Zero vectors going outside the image
    zr  = (xp==0 & yp==0 & zp==0);
    vx(zr) = 0;
    vy(zr) = 0;
    vz(zr) = 0;

    % Unpiggyback
    vx = vx(lim(1):lim(2),lim(3):lim(4),lim(5):lim(6));
    vy = vy(lim(1):lim(2),lim(3):lim(4),lim(5):lim(6));
    vz = vz(lim(1):lim(2),lim(3):lim(4),lim(5):lim(6));

end


function fcnn = fcnnupdateweights(fcnn)
%FCNNUPDATEWEIGHTS Update the weights of fully-connected neural net.
%   FCNN = FCNUPDATEWEIGHTS(FCNN]) updates the weights of the
%   fully-connected net, FCNN. The following code implements Step 4 in
%   Table 14.9.
%
%   Type
%
%    >> help fcninfo
%
%   at the prompt for detailed explanations of the components of the
%   fully-connected neural net.
%
%   Copyright 2002-2020 Gatesmark
%
%   This function, and other functions in the DIPUM Toolbox, are based
%   on the theoretical and practical foundations established in the
%   book Digital Image Processing Using MATLAB, 3rd ed., Gatesmark
%   Press, 2020.
%
%   Book website: http://www.imageprocessingplace.com
%   License: https://github.com/dipum/dipum-toolbox/blob/master/LICENSE.txt

% Number of layers.
L = numel([fcnn.NumNodes]);

% Learning rate constant.
alpha = fcnn(L).Alpha;

% Update the weights.
for k = 2:L
   fcnn(k).Weights = fcnn(k).Weights - alpha*(fcnn(k).D)*(fcnn(k - 1).A');
   fcnn(k).Biases = fcnn(k).Biases - alpha*sum(fcnn(k).D,2);
end


function k = exor ( i, j )

%% EXOR calculates the exclusive OR of two integers.
%
%  Modified:
%
%    31 March 2003
%
%  Author:
%
%   John Burkardt
%
%  Reference:
%
%    Bennett Fox,
%    Algorithm 647:
%    Implementation and Relative Efficiency of Quasirandom
%    Sequence Generators,
%    ACM Transactions on Mathematical Software,
%    Volume 12, Number 4, pages 362-376, 1986.
%
%  Parameters:
%
%    Input, integer I, J, two values whose exclusive OR is needed.
%
%    Output, integer K, the exclusive OR of I and J.
%
  k = 0;
  l = 1;
%
  i = floor ( i );
  j = floor ( j );

  while ( i ~= 0 | j ~= 0 )
%
%  Check the current right-hand bits of I and J.
%  If they differ, set the appropriate bit of K.
%
    i2 = floor ( i / 2 );
    j2 = floor ( j / 2 );

    if ( ...
      ( ( i == 2 * i2 ) & ( j ~= 2 * j2 ) ) | ...
      ( ( i ~= 2 * i2 ) & ( j == 2 * j2 ) ) )
      k = k + l;
    end

    i = i2;
    j = j2;
    l = 2 * l;

  end


% pop_newtimef() - Returns estimates and plots of event-related (log) spectral
%           perturbation (ERSP) and inter-trial coherence (ITC) phenomena
%           timelocked to a set of single-channel input epochs
%
% Usage:
%   >> pop_newtimef(EEG, typeplot);          % pop_up window
%   >> pop_newtimef(EEG, typeplot, lastcom); % pop_up window
%   >> pop_newtimef(EEG, typeplot, channel); % do not pop-up window
%   >> pop_newtimef(EEG, typeproc, num, tlimits,cycles,
%                        'key1',value1,'key2',value2, ... );
%
% Graphical interface:
%   "Channel/component number" - [edit box] this is the index of the data
%              channel or the index of the component for which to plot the
%              time-frequency decomposition.
%   "Sub-epoch time limits" - [edit box] sub epochs may be extracted (note that
%              this function aims at plotting data epochs not continuous data).
%              You may select the new epoch limits in this edit box.
%   "Use n time points" - [muliple choice list] this is the number of time
%              points to use for the time-frequency decomposition. The more
%              time points, the longer the time-frequency decomposition
%              takes to compute.
%   "Frequency limits" - [edit box] these are the lower and upper
%              frequency limit of the time-frequency decomposition. Instead
%              of limits, you may also enter a sequence of frequencies. For
%              example to compute the time-frequency decomposition at all
%              frequency between 5 and 50 hertz with 1 Hz increment, enter "1:50"
%   "Use limits, padding n" - [muliple choice list] "using limits" means
%              to use the upper and lower limits in "Frequency limits" with
%              a specific padding ratio (padratio argument of newtimef).
%              The last option "use actual frequencies" forces newtimef to
%              ignore the padratio argument and use the vector of frequencies
%              given as input in the "Frequency limits" edit box.
%   "Log spaced" - [checkbox] you may check this box to compute log-spaced
%              frequencies. Note that this is only relevant if you specify
%              frequency limits (in case you specify actual frequencies,
%              this parameter is ignored).
%   "Use divisive baseline" - [muliple choice list] there are two types of
%              baseline correction, additive (the baseline is subtracted)
%              or divisive (the data is divided by the baseline values).
%              The choice is yours. There is also the option to perform
%              baseline correction in single trials. See the 'trialbase' "full"
%              option in the newtimef.m documentation for more information.
%   "No baseline" - [checkbox] check this box to compute the raw time-frequency
%              decomposition with no baseline removal.
%   "Wavelet cycles" - [edit box] specify the number of cycle at the lowest
%              and highest frequency. Instead of specifying the number of cycle
%              at the highest frequency, you may also specify a wavelet
%              "factor" (see newtimef help message). In addition, it is
%              possible to specify actual wavelet cycles for each frequency
%              by entering a sequence of numbers.
%   "Use FFT" - [checkbox] check this checkbox to use FFT instead of
%              wavelet decomposition.
%   "ERSP color limits" - [edit box] set the upper and lower limit for the
%              ERSP image.
%   "see log power" - [checkbox] the log power values (in dB) are plotted.
%              Uncheck this box to plot the absolute power values.
%   "ITC color limits" - [edit box] set the upper and lower limit for the
%              ITC image.
%   "plot ITC phase" - [checkbox] check this box plot plot (overlayed on
%              the ITC amplitude) the polarity of the ITC complex value.
%   "Bootstrap significance level" - [edit box] use this edit box to enter
%              the p-value threshold for masking both the ERSP and the ITC
%              image for significance (masked values appear as light green)
%   "FDR correct" - [checkbox] this correct the p-value for multiple comparisons
%              (accross all time and frequencies) using the False Discovery
%              Rate method. See the fdr.m function for more details.
%   "Optional newtimef arguments" - [edit box] addition argument for the
%              newtimef function may be entered here in the 'key', value
%              format.
%   "Plot Event Related Spectral Power" - [checkbox] plot the ERSP image
%              showing event related spectral stimulus induced changes
%   "Plot Inter Trial Coherence" - [checkbox] plot the ITC image.
%   "Plot Curve at each frequency" - [checkbox] instead of plotting images,
%              it is also possible to display curves at each frequency.
%              This functionality is beta and might not work in all cases.
%
% Inputs:
%   INEEG    - input EEG dataset
%   typeproc - type of processing: 1 process the raw channel data
%                                  0 process the ICA component data
%   num      - component or channel number
%   tlimits  - [mintime maxtime] (ms) sub-epoch time limits to plot
%   cycles   -  > 0 --> Number of cycles in each analysis wavelet
%               = 0 --> Use FFTs (with constant window length
%                       at all frequencies)
%
% Optional inputs:
%    See the newtimef() function.
%
% Outputs: Same as newtimef(); no outputs are returned when a
%          window pops-up to ask for additional arguments
%
% Saving the ERSP and ITC output values:
%    Simply look up the history using the eegh function (type eegh).
%    Then copy and paste the pop_newtimef() command and add output args.
%    See the newtimef() function for a list of outputs. For instance,
% >> [ersp itc powbase times frequencies] = pop_newtimef( EEG, ....);
%
% Author: Arnaud Delorme, CNL / Salk Institute, 2001
%
% See also: newtimef(), eeglab()

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

% 01-25-02 reformated help & license -ad
% 03-08-02 add eeglab option & optimize variable sizes -ad
% 03-10-02 change newtimef call -ad
% 03-18-02 added title -ad & sm
% 04-04-02 added outputs -ad & sm

function varargout = pop_newtimef(EEG, typeproc, num, tlimits, cycles, varargin );

varargout{1} = '';
% display help if not enough arguments
% ------------------------------------
if nargin < 2
	help pop_newtimef;
	return;
end;
lastcom = [];
if nargin < 3
	popup = 1;
else
	popup = isstr(num) | isempty(num);
	if isstr(num)
		lastcom = num;
	end;
end;

% pop up window
% -------------
if popup
	[txt vars] = gethelpvar('newtimef.m');

    g = [1 0.3 0.6 0.4];
	geometry = { g g g g g g g g [0.975 1.27] [1] [1.2 1 1.2]};
    uilist = { ...
               { 'Style', 'text', 'string', fastif(typeproc, 'Channel number', 'Component number'), 'fontweight', 'bold'  } ...
			   { 'Style', 'edit', 'string', getkeyval(lastcom,3,[],'1') 'tag' 'chan'} {} {} ...
               ...
			   { 'Style', 'text', 'string', 'Sub epoch time limits [min max] (msec)', 'fontweight', 'bold' } ...
			   { 'Style', 'edit', 'string', getkeyval(lastcom,4,[],[ int2str(EEG.xmin*1000) ' ' int2str(EEG.xmax*1000) ]) 'tag' 'tlimits' } ...
               { 'Style', 'popupmenu', 'string', 'Use 50 time points|Use 100 time points|Use 150 time points|Use 200 time points|Use 300 time points|Use 400 time points' 'tag' 'ntimesout' 'value' 4} { } ...
			   ...
			   { 'Style', 'text', 'string', 'Frequency limits [min max] (Hz) or sequence', 'fontweight', 'bold' } ...
			   { 'Style', 'edit', 'string', '' 'tag' 'freqs'  } ...
               { 'Style', 'popupmenu', 'string', 'Use limits, padding 1|Use limits, padding 2|Use limits, padding 4|Use actual freqs.' 'tag' 'nfreqs' }  ...
               { 'Style', 'checkbox', 'string' 'Log spaced' 'value' 0 'tag' 'freqscale' } ...
			   ...
			   { 'Style', 'text', 'string', 'Baseline limits [min max] (msec) (0->pre-stim.)', 'fontweight', 'bold' } ...
			   { 'Style', 'edit', 'string', '0' 'tag' 'baseline' } ...
			   { 'Style', 'popupmenu',  'string', 'Use divisive baseline (DIV)|Use standard deviation (STD)|Use single trial DIV baseline|Use single trial STD baseline' 'tag' 'basenorm' } ...
               { 'Style', 'checkbox', 'string' 'No baseline' 'tag' 'nobase' } ...
               ...
               { 'Style', 'text', 'string', 'Wavelet cycles [min max/fact] or sequence', 'fontweight', 'bold' } ...
               { 'Style', 'edit', 'string', getkeyval(lastcom,5,[],'3 0.5') 'tag' 'cycle' } ...
               { 'Style', 'checkbox', 'string' 'Use FFT' 'value' 0 'tag' 'fft' } ...
               { } ...
			   ...
			   { 'Style', 'text', 'string', 'ERSP color limits [max] (min=-max)', 'fontweight', 'bold' } ...
               { 'Style', 'edit', 'string', '' 'tag' 'erspmax'} ...
               { 'Style', 'checkbox', 'string' 'see log power (set)' 'tag' 'scale' 'value' 1} {} ...
			   ...
			   { 'Style', 'text', 'string', 'ITC color limits [max]', 'fontweight', 'bold' } ...
               { 'Style', 'edit', 'string', '' 'tag' 'itcmax'} ...
               { 'Style', 'checkbox', 'string' 'plot ITC phase (set)' 'tag' 'plotphase' } {} ...
			   ...
			   { 'Style', 'text', 'string', 'Bootstrap significance level (Ex: 0.01 -> 1%)', 'fontweight', 'bold' } ...
               { 'Style', 'edit', 'string', getkeyval(lastcom,'alpha') 'tag' 'alpha'} ...
               { 'Style', 'checkbox', 'string' 'FDR correct (set)' 'tag' 'fdr' } {} ...
			   ...
			   { 'Style', 'text', 'string', 'Optional newtimef() arguments (see Help)', 'fontweight', 'bold', ...
				 'tooltipstring', 'See newtimef() help via the Help button on the right...' } ...
			   { 'Style', 'edit', 'string', '' 'tag' 'options' } ...
			   {} ...
			   { 'Style', 'checkbox', 'value', ~getkeyval(lastcom,'plotersp','present',0), 'string', ...
				 'Plot Event Related Spectral Power', 'tooltipstring', ...
				 'Plot log spectral perturbation image in the upper panel' 'tag' 'plotersp' } ...
			   { 'Style', 'checkbox', 'value', ~getkeyval(lastcom,'plotitc','present',0), 'string', ...
				 'Plot Inter Trial Coherence', 'tooltipstring', ...
				 'Plot the inter-trial coherence image in the lower panel' 'tag' 'plotitc' } ...
			   { 'Style', 'checkbox', 'value', 0, 'string', ...
				 'Plot curve at each frequency' 'tag' 'plotcurve' } ...
			 };
      % { 'Style', 'edit', 'string', '''padratio'', 4, ''plotphase'', ''off''' } ...
			   %{ 'Style', 'text', 'string',  '[set] -> Plot ITC phase sign', 'fontweight', 'bold', ...
			%	 'tooltipstring', ['Plot the sign (+/-) of inter-trial coherence phase' 10 ...
			%		'as red (+) or blue (-)'] } ...
			%   { 'Style', 'checkbox', 'value', ~getkeyval(lastcom,'plotphase','present',1) } { } ...

	[ tmp1 tmp2 strhalt result ] = inputgui( geometry, uilist, 'pophelp(''pop_newtimef'');', ...
					   fastif(typeproc, 'Plot channel time frequency -- pop_newtimef()', ...
							  'Plot component time frequency -- pop_newtimef()'));
	if length( tmp1 ) == 0 return; end;

	if result.fft,      result.cycle = '0'; end;
	if result.nobase,   result.baseline = 'NaN'; end;

	num	     = eval( [ '[' result.chan    ']' ] );
	tlimits	 = eval( [ '[' result.tlimits ']' ] );
	cycles	 = eval( [ '[' result.cycle   ']' ] );
    freqs    = eval( [ '[' result.freqs   ']' ] );
    %result.ncycles == 2 is ignored

    % add topoplot
    % ------------
    options = [];
    if isfield(EEG.chanlocs, 'theta') && ~isempty(EEG.chanlocs(num).theta)
        if ~isfield(EEG, 'chaninfo'), EEG.chaninfo = []; end;
        if typeproc == 1
            if isempty(EEG.chanlocs), caption = [ 'Channel ' int2str(num) ]; else caption = EEG.chanlocs(num).labels; end;
            options = [options ', ''topovec'', ' int2str(num) ...
                        ', ''elocs'', EEG.chanlocs, ''chaninfo'', EEG.chaninfo, ''caption'', ''' caption '''' ];
        else
            options = [options ', ''topovec'', EEG.icawinv(:,' int2str(num) ...
                       '), ''elocs'', EEG.chanlocs, ''chaninfo'', EEG.chaninfo, ''caption'', [''IC ' num2str(num) ''']' ];
      end;
    end;

	if ~isempty( result.baseline ),  options = [ options ', ''baseline'',[' result.baseline ']' ]; end;
    if ~isempty( result.alpha ),     options = [ options ', ''alpha'',' result.alpha ];   end;
	if ~isempty( result.options ),   options = [ options ',' result.options ];            end;
	if ~isempty( result.freqs ),     options = [ options ', ''freqs'', [' result.freqs ']'   ]; end;
	if ~isempty( result.erspmax ),   options = [ options ', ''erspmax'', [' result.erspmax ']' ]; end;
	if ~isempty( result.itcmax ),    options = [ options ', ''itcmax'','  result.itcmax ];      end;
	if ~result.plotersp,             options = [ options ', ''plotersp'', ''off''' ];     end;
	if ~result.plotitc,              options = [ options ', ''plotitc'' , ''off''' ];     end;
	if result.plotcurve,             options = [ options ', ''plottype'', ''curve''' ];   end;
	if result.fdr,                   options = [ options ', ''mcorrect'', ''fdr''' ];     end;
	if result.freqscale,             options = [ options ', ''freqscale'', ''log''' ];    end;
	if ~result.plotphase,            options = [ options ', ''plotphase'', ''off''' ];    end;
	if ~result.scale,                options = [ options ', ''scale'', ''abs''' ];        end;
    if result.ntimesout == 1,        options = [ options ', ''ntimesout'', 50' ];         end;
    if result.ntimesout == 2,        options = [ options ', ''ntimesout'', 100' ];        end;
    if result.ntimesout == 3,        options = [ options ', ''ntimesout'', 150' ];        end;
    if result.ntimesout == 5,        options = [ options ', ''ntimesout'', 300' ];        end;
    if result.ntimesout == 6,        options = [ options ', ''ntimesout'', 400' ];        end;
    if result.nfreqs == 1,           options = [ options ', ''padratio'', 1' ];           end;
    if result.nfreqs == 2,           options = [ options ', ''padratio'', 2' ];           end;
    if result.nfreqs == 3,           options = [ options ', ''padratio'', 4' ];           end;
    if result.nfreqs == 4,           options = [ options ', ''nfreqs'', ' int2str(length(freqs)) ]; end;
    if result.basenorm == 2,         options = [ options ', ''basenorm'', ''on''' ];      end;
    if result.basenorm == 4,         options = [ options ', ''basenorm'', ''on''' ];      end;
    if result.basenorm >= 3,         options = [ options ', ''trialbase'', ''full''' ];      end;

    % add title
    % ---------
	if isempty( findstr(  '''title''', result.options))
        if ~isempty(EEG.chanlocs) & typeproc
            chanlabel = EEG.chanlocs(num).labels;
        else
            chanlabel = int2str(num);
        end;
	end;

    % compute default winsize
    % -----------------------
    if EEG.xmin < 0 && isempty(findstr( '''winsize''', result.options)) && isempty( result.freqs )
        fprintf('Computing window size in pop_newtimef based on half of the length of the baseline period');
        options = [ options ', ''winsize'', ' int2str(-EEG.xmin*EEG.srate) ];
    end;

	figure; try, icadefs; set(gcf, 'color', BACKCOLOR); catch, end;
else
    options = [ ',' vararg2str(varargin) ];
end;

% compute epoch limits
% --------------------
if isempty(tlimits)
	tlimits = [EEG.xmin, EEG.xmax]*1000;
end;
pointrange1 = round(max((tlimits(1)/1000-EEG.xmin)*EEG.srate, 1));
pointrange2 = round(min((tlimits(2)/1000-EEG.xmin)*EEG.srate, EEG.pnts));
pointrange = [pointrange1:pointrange2];

% call function sample either on raw data or ICA data
% ---------------------------------------------------
if typeproc == 1
	tmpsig = EEG.data(num,pointrange,:);
else
	if ~isempty( EEG.icasphere )
        if ~isempty(EEG.icaact)
    		tmpsig = EEG.icaact(num,pointrange,:);
 	    else
            tmpsig = (EEG.icaweights(num,:)*EEG.icasphere)*reshape(EEG.data(:,pointrange,:), EEG.nbchan, EEG.trials*length(pointrange));
        end;
	else
		error('You must run ICA first');
	end;
end;
tmpsig = reshape( tmpsig, length(num), size(tmpsig,2)*size(tmpsig,3));

% outputs
% -------
outstr = '';
if ~popup
    for io = 1:nargout, outstr = [outstr 'varargout{' int2str(io) '},' ]; end;
    if ~isempty(outstr), outstr = [ '[' outstr(1:end-1) '] =' ]; end;
end;

% plot the datas and generate output command
% --------------------------------------------
if length( options ) < 2
    options = '';
end;
if nargin < 4
    varargout{1} = sprintf('figure; pop_newtimef( %s, %d, %d, [%s], [%s] %s);', inputname(1), typeproc, num, ...
			int2str(tlimits), num2str(cycles), options);
end;
com = sprintf('%s newtimef( tmpsig(:, :), length(pointrange), [tlimits(1) tlimits(2)], EEG.srate, cycles %s);', outstr, options);
eval(com)

return;

% get contextual help
% -------------------
function txt = context(var, allvars, alltext);
	loc = strmatch( var, allvars);
	if ~isempty(loc)
		txt= alltext{loc(1)};
	else
		disp([ 'warning: variable ''' var ''' not found']);
		txt = '';
	end;