function lik = lik_inputdependentweibull(varargin)
%LIK_INPUTDEPENDENTWEIBULL  Create a (right censored) input dependent Weibull likelihood structure
%
%  Description
%    LIK = LIK_INPUTDEPENDENTWEIBULL('PARAM1',VALUE1,'PARAM2,VALUE2,...)
%    creates a likelihood structure for a right censored input dependent
%    Weibull survival model in which the named parameters have the
%    specified values. Any unspecified parameters are set to default
%    values.
%
%    LIK = LIK_INPUTDEPENDENTWEIBULL(LIK,'PARAM1',VALUE1,'PARAM2,VALUE2,...)
%    modify a likelihood structure with the named parameters
%    altered with the specified values.
%
%    Parameters for Weibull likelihood [default]
%      shape       - shape parameter r [1]
%      shape_prior - prior for shape [prior_logunif]
%
%    Note! If the prior is 'prior_fixed' then the parameter in
%    question is considered fixed and it is not handled in
%    optimization, grid integration, MCMC etc.
%
%    The likelihood is defined as follows:
%                       __ n
%      p(y|f1, f2, z) = || i=1 [ r_i^(1-z_i) exp( (1-z_i)*(-f1_i)
%                           +(1-z_i)*(r_i-1)*log(y_i)
%                           -exp(-f1_i)*y_i^r_i) ]
%
%    where r_i=r*exp(f2_i) is the shape parameter of Weibull distribution.
%    z is a vector of censoring indicators with z = 0 for uncensored event
%    and z = 1 for right censored event. Here the second latent variable f2
%    implies the input dependance to the shape parameter in the original
%    Weibull likelihood.
%
%    When using the Weibull likelihood you can give the
%    vector z as an extra parameter to each function that requires
%    also y. For example, you can call gp_optim as follows:
%      gp_optim(gp, x, y, 'z', z)
%    If z is not given or it is empty, then usual likelihood for
%    uncensored data is used
%
%  See also
%    GP_SET, LIK_*, PRIOR_*
%
% Copyright (c) 2011 Jaakko Riihimäki
% Copyright (c) 2011 Aki Vehtari
% Copyright (c) 2012 Ville Tolvanen

% 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.

  ip=inputParser;
  ip.FunctionName = 'LIK_INPUTDEPENDENTWEIBULL';
  ip.addOptional('lik', [], @isstruct);
  ip.addParamValue('shape',1, @(x) isscalar(x) && x>0);
  ip.addParamValue('shape_prior',prior_logunif(), @(x) isstruct(x) || isempty(x));
  ip.parse(varargin{:});
  lik=ip.Results.lik;

  if isempty(lik)
    init=true;
    lik.nondiagW=true;
    lik.type = 'Inputdependent-Weibull';
  else
    if ~isfield(lik,'type') || ~isequal(lik.type,'Weibull')
      error('First argument does not seem to be a valid likelihood function structure')
    end
    init=false;
  end

  % Initialize parameters
  if init || ~ismember('shape',ip.UsingDefaults)
    lik.shape = ip.Results.shape;
  end
  % Initialize prior structure
  if init
    lik.p=[];
  end
  if init || ~ismember('shape_prior',ip.UsingDefaults)
    lik.p.shape=ip.Results.shape_prior;
  end

  if init
    % Set the function handles to the subfunctions
    lik.fh.pak = @lik_inputdependentweibull_pak;
    lik.fh.unpak = @lik_inputdependentweibull_unpak;
    lik.fh.lp = @lik_inputdependentweibull_lp;
    lik.fh.lpg = @lik_inputdependentweibull_lpg;
    lik.fh.ll = @lik_inputdependentweibull_ll;
    lik.fh.llg = @lik_inputdependentweibull_llg;
    lik.fh.llg2 = @lik_inputdependentweibull_llg2;
    lik.fh.llg3 = @lik_inputdependentweibull_llg3;
    lik.fh.invlink = @lik_inputdependentweibull_invlink;
    lik.fh.predy = @lik_inputdependentweibull_predy;
    lik.fh.recappend = @lik_inputdependentweibull_recappend;
  end

end

function [w,s,h] = lik_inputdependentweibull_pak(lik)
%LIK_INPUTDEPENDENTWEIBULL_PAK  Combine likelihood parameters into one vector.
%
%  Description
%    W = LIK_INPUTDEPENDENTWEIBULL_PAK(LIK) takes a likelihood structure LIK and
%    combines the parameters into a single row vector W. This is a
%    mandatory subfunction used for example in energy and gradient
%    computations.
%
%       w = log(lik.shape)
%
%   See also
%   LIK_INPUTDEPENDENTWEIBULL_UNPAK, GP_PAK

  w=[];s={};h=[];
  if ~isempty(lik.p.shape)
    w = log(lik.shape);
    s = [s; 'log(weibull.shape)'];
    h = [h 0];
    [wh, sh, hh] = lik.p.shape.fh.pak(lik.p.shape);
    w = [w wh];
    s = [s; sh];
    h = [h hh];
  end
end

function [lik, w] = lik_inputdependentweibull_unpak(lik, w)
%LIK_INPUTDEPENDENTWEIBULL_UNPAK  Extract likelihood parameters from the vector.
%
%  Description
%    [LIK, W] = LIK_INPUTDEPENDENTWEIBULL_UNPAK(W, LIK) takes a likelihood
%    structure LIK and extracts the parameters from the vector W
%    to the LIK structure. This is a mandatory subfunction used
%    for example in energy and gradient computations.
%
%   Assignment is inverse of
%       w = log(lik.shape)
%
%   See also
%   LIK_INPUTDEPENDENTWEIBULL_PAK, GP_UNPAK

  if ~isempty(lik.p.shape)
    lik.shape = exp(w(1));
    w = w(2:end);
    [p, w] = lik.p.shape.fh.unpak(lik.p.shape, w);
    lik.p.shape = p;
  end
end

function lp = lik_inputdependentweibull_lp(lik, varargin)
%LIK_INPUTDEPENDENTWEIBULL_LP  log(prior) of the likelihood parameters
%
%  Description
%    LP = LIK_INPUTDEPENDENTWEIBULL_LP(LIK) takes a likelihood structure LIK and
%    returns log(p(th)), where th collects the parameters. This
%    subfunction is needed when there are likelihood parameters.
%
%  See also
%    LIK_INPUTDEPENDENTWEIBULL_LLG, LIK_INPUTDEPENDENTWEIBULL_LLG3, LIK_INPUTDEPENDENTWEIBULL_LLG2, GPLA_E

% If prior for shape parameter, add its contribution
  lp=0;
  if ~isempty(lik.p.shape)
    lp = lik.p.shape.fh.lp(lik.shape, lik.p.shape) +log(lik.shape);
  end

end

function lpg = lik_inputdependentweibull_lpg(lik)
%LIK_INPUTDEPENDENTWEIBULL_LPG  d log(prior)/dth of the likelihood
%                parameters th
%
%  Description
%    E = LIK_INPUTDEPENDENTWEIBULL_LPG(LIK) takes a likelihood structure LIK and
%    returns d log(p(th))/dth, where th collects the parameters.
%    This subfunction is needed when there are likelihood parameters.
%
%  See also
%    LIK_INPUTDEPENDENTWEIBULL_LLG, LIK_INPUTDEPENDENTWEIBULL_LLG3, LIK_INPUTDEPENDENTWEIBULL_LLG2, GPLA_G

  lpg=[];
  if ~isempty(lik.p.shape)
    % Evaluate the gprior with respect to shape
    ggs = lik.p.shape.fh.lpg(lik.shape, lik.p.shape);
    lpg = ggs(1).*lik.shape + 1;
    if length(ggs) > 1
      lpg = [lpg ggs(2:end)];
    end
  end
end

function ll = lik_inputdependentweibull_ll(lik, y, ff, z)
%LIK_INPUTDEPENDENTWEIBULL_LL  Log likelihood
%
%  Description
%    LL = LIK_INPUTDEPENDENTWEIBULL_LL(LIK, Y, F, Z) takes a likelihood
%    structure LIK, survival times Y, censoring indicators Z, and
%    latent values F. Returns the log likelihood, log p(y|f,z).
%    This subfunction is needed when using Laplace approximation
%    or MCMC for inference with non-Gaussian likelihoods. This
%    subfunction is also used in information criteria (DIC, WAIC)
%    computations.
%
%  See also
%    LIK_INPUTDEPENDENTWEIBULL_LLG, LIK_INPUTDEPENDENTWEIBULL_LLG3, LIK_INPUTDEPENDENTWEIBULL_LLG2, GPLA_E

  if numel(z)==0
    % no censoring by default
    z=0;
  end

  f=ff(:);
  n=size(y,1);
  f1=f(1:n);
  f2=f((n+1):2*n);
  expf2=exp(f2);
  expf2(isinf(expf2))=realmax;
  a = lik.shape;
  ll = sum((1-z).*(log(a*expf2) + (a*expf2-1).*log(y)-f1) - exp(-f1).*y.^(a*expf2));

end

function llg = lik_inputdependentweibull_llg(lik, y, ff, param, z)
%LIK_INPUTDEPENDENTWEIBULL_LLG  Gradient of the log likelihood
%
%  Description
%    LLG = LIK_INPUTDEPENDENTWEIBULL_LLG(LIK, Y, F, PARAM) takes a likelihood
%    structure LIK, survival times Y, censoring indicators Z and
%    latent values F. Returns the gradient of the log likelihood
%    with respect to PARAM. At the moment PARAM can be 'param' or
%    'latent'. This subfunction is needed when using Laplace
%    approximation or MCMC for inference with non-Gaussian likelihoods.
%
%  See also
%    LIK_INPUTDEPENDENTWEIBULL_LL, LIK_INPUTDEPENDENTWEIBULL_LLG2, LIK_INPUTDEPENDENTWEIBULL_LLG3, GPLA_E

  if numel(z)==0
    % no censoring by default
    z=0;
  end

  f=ff(:);
  n=size(y,1);
  f1=f(1:n);
  f2=f((n+1):2*n);
  expf2=exp(f2);
  expf2(isinf(expf2))=realmax;
  a = lik.shape;
  switch param
    case 'param'
      llg = sum((1-z).*(1./a + expf2.*log(y)) - exp(-f1).*y.^(a.*expf2).*log(y).*expf2);
      % correction for the log transformation
      llg = llg.*lik.shape;
    case 'latent'
      llg1 = -(1-z) + exp(-f1).*y.^(a.*expf2);
      llg2 = (1-z).*(1 + a.*expf2.*log(y)) - exp(-f1).*y.^(a.*expf2).*log(y).*a.*expf2;
      llg = [llg1; llg2];
  end
end

function llg2 = lik_inputdependentweibull_llg2(lik, y, ff, param, z)
%LIK_INPUTDEPENDENTWEIBULL_LLG2  Second gradients of the log likelihood
%
%  Description
%    LLG2 = LIK_INPUTDEPENDENTWEIBULL_LLG2(LIK, Y, F, PARAM) takes a
%    likelihood structure LIK, survival times Y, censoring indicators Z,
%    and latent values F. Returns the hessian of the log likelihood with
%    respect to PARAM. LLG2 is a (2*length(y)) x 2 matrix containing the
%    non-zero elements of the Hessian matrix. This subfunction is needed
%    when using Laplace approximation or EP for  inference with
%    non-Gaussian likelihoods.
%
%  See also
%    LIK_INPUTDEPENDENTWEIBULL_LL, LIK_INPUTDEPENDENTWEIBULL_LLG,
%    LIK_INPUTDEPENDENTWEIBULL_LLG3, GPLA_E

  if numel(z)==0
    % no censoring by default
    z=0;
  end

  a = lik.shape;
  f=ff(:);
  n=size(y,1);
  f1=f(1:n);
  f2=f((n+1):2*n);
  expf2=exp(f2);
  expf2(isinf(expf2))=realmax;
  switch param
    case 'param'

    case 'latent'
      t1=exp(-f1).*y.^(a.*expf2);
      t2=log(y).*a.*expf2;
      t3=t1.*t2;

      llg2_11 = -t1;
      llg2_12 = t3;
      llg2_22 = (1-z).*t2 - (t2 + 1).*t3;

      llg2 = [llg2_11 llg2_12; llg2_12 llg2_22];

    case 'latent+param'
      t1=expf2.*log(y);
      t2=exp(-f1).*y.^(a.*expf2);
      t3=t1.*t2;
      llg2_1 = t3;
      llg2_2 = (1-z).*t1 - (t1.*a + 1).*t3;
      llg2 = [llg2_1; llg2_2];
      % correction due to the log transformation
      llg2 = llg2.*lik.shape;
  end
end

function llg3 = lik_inputdependentweibull_llg3(lik, y, ff, param, z)
%LIK_INPUTDEPENDENTWEIBULL_LLG3  Third gradients of the log likelihood
%
%  Description
%    LLG3 = LIK_INPUTDEPENDENTWEIBULL_LLG3(LIK, Y, F, PARAM) takes a likelihood
%    structure LIK, survival times Y, censoring indicators Z and
%    latent values F and returns the third gradients of the log
%    likelihood with respect to PARAM. At the moment PARAM can be
%    only 'latent'. LLG3 is a vector with third gradients. This
%    subfunction is needed when using Laplace approximation for
%    inference with non-Gaussian likelihoods.
%
%  See also
%    LIK_INPUTDEPENDENTWEIBULL_LL, LIK_INPUTDEPENDENTWEIBULL_LLG, LIK_INPUTDEPENDENTWEIBULL_LLG2, GPLA_E, GPLA_G

  if numel(z)==0
    % no censoring by default
    z=0;
  end

  a = lik.shape;
  f=ff(:);
  n=size(y,1);
  f1=f(1:n);
  f2=f((n+1):2*n);
  expf2=exp(f2);
  expf2(isinf(expf2))=realmax;
  switch param
    case 'param'

    case 'latent'
      t1=a.*expf2.*log(y);
      t2=exp(-f1).*y.^(a.*expf2);
      t3=t2.*t1;
      t4=t3.*t1;

      nl=2;
      llg3=zeros(nl,nl,nl,n);

      llg3(1,1,1,:) = t2;

      llg3(2,2,1,:) = t4 + t3;
      llg3(2,1,2,:) = llg3(2,2,1,:);
      llg3(1,2,2,:) = llg3(2,2,1,:);

      llg3(2,1,1,:) = -t3;
      llg3(1,2,1,:) = llg3(2,1,1,:);
      llg3(1,1,2,:) = llg3(2,1,1,:);

      llg3(2,2,2,:) = (1-z).*t1 - t4.*t1 - 3.*t4 - t3;

    case 'latent2+param'
      t1 = log(y).*expf2;
      t2 = exp(-f1).*y.^(a*expf2);
      t3 = t2.*t1;
      t4 = t3.*t1;
      llg3_11 = -t3;
      llg3_12 = a.*t4 + t3;
      llg3_22 = (1-z).*t1 - a.^2.*t4.*t1 - 3.*a.*t4 - t3;

      llg3 = [diag(llg3_11) diag(llg3_12); diag(llg3_12) diag(llg3_22)];
      % correction due to the log transformation
      llg3 = llg3.*lik.shape;
  end
end

function [lpy, Ey, Vary] = lik_inputdependentweibull_predy(lik, Ef, Varf, yt, zt)
%LIK_INPUTDEPENDENTWEIBULL_PREDY  Returns the predictive mean, variance and density of y
%
%  Description
%    LPY = LIK_INPUTDEPENDENTWEIBULL_PREDY(LIK, EF, VARF YT, ZT)
%    Returns logarithm of the predictive density PY of YT, that is
%        p(yt | zt) = \int p(yt | f, zt) p(f|y) df.
%    This requires also the survival times YT, censoring indicators ZT.
%    This subfunction is needed when computing posterior predictive
%    distributions for future observations.
%
%    [LPY, EY, VARY] = LIK_INPUTDEPENDENTWEIBULL_PREDY(LIK, EF, VARF) takes a
%    likelihood structure LIK, posterior mean EF and posterior
%    Variance VARF of the latent variable and returns the
%    posterior predictive mean EY and variance VARY of the
%    observations related to the latent variables. This subfunction
%    is needed when computing posterior predictive distributions for
%    future observations.
%
%
%  See also
%    GPLA_PRED, GPEP_PRED, GPMC_PRED

  if numel(zt)==0
    % no censoring
    zt=zeros(size(yt));
  end

  yc = 1-zt;
  r = lik.shape;

  Ef = Ef(:);
  ntest = 0.5*size(Ef,1);
  Ef1=Ef(1:ntest); Ef2=Ef(ntest+1:end);
  %     Varf1=squeeze(Varf(1,1,:)); Varf2=squeeze(Varf(2,2,:));
  if size(Varf,2) == size(Varf,1)
    Varf1=diag(Varf(1:ntest,1:ntest));Varf2=diag(Varf(ntest+1:end,ntest+1:end));
  else
    Varf1=Varf(:,1); Varf2=Varf(:,2);
  end

  Ey=[];
  Vary=[];

  % Evaluate the posterior predictive densities of the given observations
  lpy = zeros(length(yt),1);

  for i2=1:ntest
    m1=Ef1(i2); m2=Ef2(i2);
    s1=sqrt(Varf1(i2)); s2=sqrt(Varf2(i2));
    % Function handle for Weibull * Gaussian_f1 * Gaussian_f2
    pd=@(f1,f2) exp(yc(i2).*((log(r) + f2) + (r.*exp(f2)-1).*log(yt(i2))-f1) - exp(-f1).*yt(i2).^(r*exp(f2))) ...
      .*norm_pdf(f1,Ef1(i2),sqrt(Varf1(i2))).*norm_pdf(f2,Ef2(i2),sqrt(Varf2(i2)));
    % Integrate over latent variables
    lpy(i2) = log(dblquad(pd, m1-6.*s1, m1+6.*s1, m2-6.*s2, m2+6.*s2));
  end

end

function p = lik_inputdependentweibull_invlink(lik, f, z)
%LIK_INPUTDEPENDENTWEIBULL Returns values of inverse link function
%
%  Description
%    P = LIK_INPUTDEPENDENTWEIBULL_INVLINK(LIK, F) takes a likelihood structure LIK and
%    latent values F and returns the values of inverse link function P.
%    This subfunction is needed when using function gp_predprctmu.
%
%     See also
%     LIK_INPUTDEPENDENTWEIBULL_LL, LIK_INPUTDEPENDENTWEIBULL_PREDY

p = exp(f);
end

function reclik = lik_inputdependentweibull_recappend(reclik, ri, lik)
%RECAPPEND  Append the parameters to the record
%
%  Description
%    RECLIK = LIK_INPUTDEPENDENTWEIBULL__RECAPPEND(RECLIK, RI, LIK) takes a
%    likelihood record structure RECLIK, record index RI and
%    likelihood structure LIK with the current MCMC samples of
%    the parameters. Returns RECLIK which contains all the old
%    samples and the current samples from LIK. This subfunction
%    is needed when using MCMC sampling (gp_mc).
%
%  See also
%    GP_MC

  if nargin == 2
    % Initialize the record
    reclik.type = 'Inputdependent-Weibull';
    reclik.nondiagW=true;

    % Initialize parameter
%     reclik.shape = [];

    % Set the function handles
    reclik.fh.pak = @lik_inputdependentweibull_pak;
    reclik.fh.unpak = @lik_inputdependentweibull_unpak;
    reclik.fh.lp = @lik_t_lp;
    reclik.fh.lpg = @lik_t_lpg;
    reclik.fh.ll = @lik_inputdependentweibull_ll;
    reclik.fh.llg = @lik_inputdependentweibull_llg;
    reclik.fh.llg2 = @lik_inputdependentweibull_llg2;
    reclik.fh.llg3 = @lik_inputdependentweibull_llg3;
    reclik.fh.invlink = @lik_inputdependentweibull_invlink;
    reclik.fh.predy = @lik_inputdependentweibull_predy;
    reclik.fh.recappend = @lik_inputdependentweibull_recappend;
    reclik.p=[];
    reclik.p.shape=[];
    if ~isempty(ri.p.shape)
      reclik.p.shape = ri.p.shape;
    end
  else
    % Append to the record
    reclik.shape(ri,:)=lik.shape;
    if ~isempty(lik.p.shape)
      reclik.p.shape = lik.p.shape.fh.recappend(reclik.p.shape, ri, lik.p.shape);
    end
  end
end


function [x,zo]=estnoiseg_orig(yf,tz,pp)
%ESTNOISEG - estimate MMSE noise spectrum [x,zo]=(yf,tz,pp)
%
% Usage:    ninc=round(0.016*fs);   % frame increment [fs=sample frequency]
%           ovf=2;                  % overlap factor
%           f=rfft(enframe(s,hanning(ovf*ninc,'periodic'),ninc),ovf*ninc,2);
%           f=f.*conj(f);           % convert to power spectrum
%           x=estnoiseg(f,ninc/fs); % estimate the noise power spectrum
%
% Inputs:
%   yf      input power spectra (one row per frame)
%   tz      frame increment in seconds
%           Alternatively, the input state from a previous call (see below)
%   pp      algorithm parameters [optional]
%
% Outputs:
%   x       estimated noise power spectra (one row per frame)
%   zo      output state
%
% The algorithm parameters are defined in reference [1] from which equation
% numbers are given in parentheses. They are as follows:
%
%        pp.tax      % smoothing time constant for noise power estimate [0.0717 seconds](8)
%        pp.tap      % smoothing time constant for smoothed speech prob [0.152 seconds](23)
%        pp.psthr    % threshold for smoothed speech probability [0.99] (24)
%        pp.pnsaf    % noise probability safety value [0.01] (24)
%        pp.pspri    % prior speech probability [0.5] (18)
%        pp.asnr     % active SNR in dB [15] (18)
%        pp.psini    % initial speech probability [0.5] (23)
%        pp.tavini   % assumed speech absent time at start [0.064 seconds]
%
% If convenient, you can call estnoiseg in chunks of arbitrary size. Thus the following are equivalent:
%
%                   (a) dp=estnoiseg(yp(1:300),tinc);
%
%                   (b) [dp(1:100,:),z]=estnoiseg(yp(1:100,:),tinc);
%                       [dp(101:200,:),z]=estnoiseg(yp(101:200,:),z);
%                       [dp(201:300,:),z]=estnoiseg(yp(201:300,:),z);

% This is intended to be a precise implementation of [1] for a frame rate of 62.5 Hz.
% Time constants are adjusted for other frame rates.
%
% Refs:
%    [1] Gerkmann, T. & Hendriks, R. C.
%        Unbiased MMSE-Based Noise Power Estimation With Low Complexity and Low Tracking Delay
%        IEEE Trans Audio, Speech, Language Processing, 2012, 20, 1383-1393

%	   Copyright (C) Mike Brookes 2012
%      Version: $Id: estnoiseg.m 3387 2013-08-23 12:32:47Z dmb $
%
%   VOICEBOX is a MATLAB toolbox for speech processing.
%   Home page: http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   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 can obtain a copy of the GNU General Public License from
%   http://www.gnu.org/copyleft/gpl.html or by writing to
%   Free Software Foundation, Inc.,675 Mass Ave, Cambridge, MA 02139, USA.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

[nr,nrf]=size(yf);          % number of frames and freq bins
x=zeros(nr,nrf);            % initialize output arrays
if isempty(yf) && isstruct(tz)             % no real data
    zo=tz;                  % just keep the same state
else
    if isstruct(tz)         % take parameters from a previous call
        nrcum=tz.nrcum;     % cumulative number of frames
        xt=tz.xt;           % smoothed power spectrum
        pslp=tz.pslp;       % correction factor (9)
        tinc=tz.tinc;       % frame increment
        qq=tz.qq;           % parameter structure
    else
        tinc = tz;          % second argument is frame increment
        nrcum=0;            % no frames so far
        % default algorithm constants
        qq.tax=0.0717;      % noise output smoothing time constant = -tinc/log(0.8) (8)
        qq.tap=0.152;       % speech prob smoothing time constant = -tinc/log(0.9) (23)
        qq.psthr=0.99;      % threshold for smoothed speech probability [0.99] (24)
        qq.pnsaf=0.01;      % noise probability safety value [0.01] (24)
        qq.pspri=0.5;       % prior speech probability [0.5] (18)
        qq.asnr=15;         % active SNR in dB [15] (18)
        qq.psini=0.5;       % initial speech probability [0.5] (23)
        qq.tavini=0.064;        % assumed speech absent time at start [64 ms]

        if nargin>=3 && ~isempty(pp)  % update fields from pp input
            qqn=fieldnames(qq);
            for i=1:length(qqn)
                if isfield(pp,qqn{i})
                    qq.(qqn{i})=pp.(qqn{i});
                end
            end
        end
        pslp=repmat(qq.psini,1,nrf); % initialize smoothed speech presence prob
        xt=[];                       % initialize just in case the first call has no data
    end

    % unpack parameters needed within the loop

    psthr=qq.psthr;     % threshold for smoothed speech probability [0.99] (24)
    pnsaf=qq.pnsaf;     % noise probability safety value [0.01] (24)

    % derived algorithm constants

    ax=exp(-tinc/qq.tax); % noise output smoothing factor = 0.8 (8)
    axc=1-ax;
    ap=exp(-tinc/qq.tap); % noise output smoothing factor = 0.9 (23)
    apc=1-ap;
    xih1=10^(qq.asnr/10); % speech-present SNR
    xih1r=1/(1+xih1)-1;
    pfac=(1/qq.pspri-1)*(1+xih1); % p(noise)/p(speech) (18)

    if nrcum==0 && nr>0       % initialize values for first frame
        xt=qq.psini*mean(yf(1:max(1,min(nr,round(1+qq.tavini/tinc))),:),1);  % initial noise estimate
    end

    % loop for each frame
    for t=1:nr
        yft=yf(t,:);        % noisy speech power spectrum
        ph1y=(1+pfac*exp(xih1r*yft./xt)).^(-1); % a-posteriori speech presence prob (18)
        pslp=ap*pslp+apc*ph1y; % smoothed speech presence prob (23)
        ph1y=min(ph1y,1-pnsaf*(pslp>psthr)); % limit ph1y (24)
        xtr=(1-ph1y).*yft+ph1y.*xt; % estimated raw noise spectrum (22)
        xt=ax*xt+axc*xtr;  % smooth the noise estimate (8)
        x(t,:)=xt;  % save the noise estimate
    end
    if nargout>1    % we need to store the state for next time
        zo.nrcum=nrcum+nr;      % number of frames so far
        zo.xt=xt;          % smoothed power spectrum
        zo.pslp=pslp;               % correction factor (9)
        zo.tinc=tinc;     % must be the last one
        zo.qq=qq;
    end
    if ~nargout
        clf;
        subplot(212);
        plot((1:nr)*tinc,10*log10([sum(yf,2) sum(x,2)]))
        ylabel('Frame Energy (dB)');
        xlabel(sprintf('Time (s)   [%d ms frame incr]',round(tinc*1000)));
        axisenlarge([-1 -1.05]);
        legend('input','noise','Location','Best');
        subplot(211);
        plot(1:nrf,10*log10([sum(yf,1)'/nr sum(x,1)'/nr]))
        ylabel('Power (dB)');
        xlabel('Frequency bin');
        axisenlarge([-1 -1.05]);
        legend('input','noise','Location','Best');
    end
end


function [varargout]=subHex(varargin)

% function [E,V,C,CV]=subHex(E,V,n,splitMethod)
% ------------------------------------------------------------------------
%
% Kevin Mattheus Moerman
% gibbon.toolbox@gmail.com
%
%
% 2017/08/31 Added function description to top of function
% ------------------------------------------------------------------------

%% Parse input

switch nargin
    case 2
        E=varargin{1};
        V=varargin{2};
        n=1;
        splitMethod=1;
    case 3
        E=varargin{1};
        V=varargin{2};
        n=varargin{3};
        splitMethod=1;
    case 4
        E=varargin{1};
        V=varargin{2};
        n=varargin{3};
        splitMethod=varargin{4};
end

C=(1:1:size(E,1))'; %Element colors or indices
CV=[];

%%
if n>0
    for qIter=1:1:n
        switch splitMethod
            case 1
                %% Mid edge sets
                edgeMat=[E(:,[1 2]); E(:,[2 3]);  E(:,[3 4]); E(:,[4 1]);... %top
                    E(:,[5 6]); E(:,[6 7]);  E(:,[7 8]); E(:,[8 5]);... %bottom
                    E(:,[1 5]); E(:,[2 6]);  E(:,[3 7]); E(:,[4 8])];   %top-bottom edges

                E_sort=sort(edgeMat,2); %Sorted edges matrix
                [~,ind1,~]=unique(E_sort,'rows');
                edgeMat=edgeMat(ind1,:);

                numPoints = size(V,1);
                numEdges = size(edgeMat,1);

                % Get indices of the four edges associated with each face
                A = sparse(edgeMat(:,1),edgeMat(:,2),(1:numEdges)+numPoints,numPoints,numPoints,numEdges);
                A = max(A,A'); %Copy symmetric

                %Indices for A matrix
                indA_12=E(:,1)+(E(:,2)-1)*numPoints;
                indA_23=E(:,2)+(E(:,3)-1)*numPoints;
                indA_34=E(:,3)+(E(:,4)-1)*numPoints;
                indA_41=E(:,4)+(E(:,1)-1)*numPoints;

                indA_56=E(:,5)+(E(:,6)-1)*numPoints;
                indA_67=E(:,6)+(E(:,7)-1)*numPoints;
                indA_78=E(:,7)+(E(:,8)-1)*numPoints;
                indA_85=E(:,8)+(E(:,5)-1)*numPoints;

                indA_15=E(:,1)+(E(:,5)-1)*numPoints;
                indA_26=E(:,2)+(E(:,6)-1)*numPoints;
                indA_37=E(:,3)+(E(:,7)-1)*numPoints;
                indA_48=E(:,4)+(E(:,8)-1)*numPoints;

                %Get indices for vertex array
                indV_12=full(A(indA_12));
                indV_23=full(A(indA_23));
                indV_34=full(A(indA_34));
                indV_41=full(A(indA_41));

                indV_56=full(A(indA_56));
                indV_67=full(A(indA_67));
                indV_78=full(A(indA_78));
                indV_85=full(A(indA_85));

                indV_15=full(A(indA_15));
                indV_26=full(A(indA_26));
                indV_37=full(A(indA_37));
                indV_48=full(A(indA_48));

                %% Mid element
                indV_mid=(1:1:size(E,1))'+numPoints+size(edgeMat,1);

                %% Mid face

                %Element faces matrix
                F =[E(:,[4 3 2 1]);... %top
                    E(:,[5 6 7 8]);... %bottom
                    E(:,[1 2 6 5]);... %side 1
                    E(:,[3 4 8 7]);... %side 2
                    E(:,[2 3 7 6]);... %front
                    E(:,[5 8 4 1]);]; %back

                F_sort=sort(F,2); %Sorted edges matrix
                [~,ind1,ind2]=unique(F_sort,'rows');
                F=F(ind1,:);

                indV_midFace=(1:1:size(F_sort,1))';
                indOffset=numPoints+size(edgeMat,1)+size(E,1);

                indV_midFace4321=ind2(indV_midFace((1-1)*size(E,1)+(1:size(E,1))))+indOffset;
                indV_midFace5678=ind2(indV_midFace((2-1)*size(E,1)+(1:size(E,1))))+indOffset;
                indV_midFace1265=ind2(indV_midFace((3-1)*size(E,1)+(1:size(E,1))))+indOffset;
                indV_midFace3487=ind2(indV_midFace((4-1)*size(E,1)+(1:size(E,1))))+indOffset;
                indV_midFace2376=ind2(indV_midFace((5-1)*size(E,1)+(1:size(E,1))))+indOffset;
                indV_midFace5841=ind2(indV_midFace((6-1)*size(E,1)+(1:size(E,1))))+indOffset;

                %% Create element array
                Es=[E(:,1) indV_12 indV_midFace4321 indV_41 indV_15 indV_midFace1265 indV_mid indV_midFace5841;...%Corner hex 1
                    indV_12 E(:,2) indV_23 indV_midFace4321 indV_midFace1265 indV_26 indV_midFace2376 indV_mid;... %Corner hex 2
                    indV_midFace4321 indV_23 E(:,3) indV_34 indV_mid indV_midFace2376 indV_37 indV_midFace3487;... %Corner hex 3
                    indV_41 indV_midFace4321 indV_34 E(:,4) indV_midFace5841 indV_mid indV_midFace3487 indV_48;... %Corner hex 4
                    indV_15 indV_midFace1265 indV_mid indV_midFace5841 E(:,5) indV_56 indV_midFace5678 indV_85 ;...%Corner hex 5
                    indV_midFace1265 indV_26 indV_midFace2376 indV_mid  indV_56 E(:,6) indV_67 indV_midFace5678;... %Corner hex 6
                    indV_mid indV_midFace2376 indV_37 indV_midFace3487 indV_midFace5678 indV_67 E(:,7) indV_78 ;... %Corner hex 7
                    indV_midFace5841 indV_mid indV_midFace3487 indV_48 indV_85 indV_midFace5678 indV_78 E(:,8) ;... %Corner hex 8
                    ];

                %% Create vertex array
                Vn=0.5*(V(edgeMat(:,1),:)+V(edgeMat(:,2),:)); %new mid-edge points
                Vm=patchCentre(E,V); %Mid element nodes

                Vf=zeros(size(F,1),3);
                for q=1:1:size(V,2)
                    X=V(:,q);
                    Vf(:,q)=mean(X(F),2);
                end
                Vs = [V; Vn; Vm; Vf]; %Join point sets

                CV=[0*ones(size(V,1),1); 1*ones(size(Vn,1),1); 2*ones(size(Vm,1),1); 3*ones(size(Vf,1),1);];

            case 2

                %% Mid edge sets
                edgeMat=[E(:,[1 5]); E(:,[2 6]);  E(:,[3 7]); E(:,[4 8])];   %top-bottom edges

                E_sort=sort(edgeMat,2); %Sorted edges matrix
                [~,ind1,~]=unique(E_sort,'rows');
                edgeMat=edgeMat(ind1,:);

                numPoints = size(V,1);
                numEdges = size(edgeMat,1);

                % Get indices of the four edges associated with each face
                A = sparse(edgeMat(:,1),edgeMat(:,2),(1:numEdges)+numPoints,numPoints,numPoints,numEdges);
                A = max(A,A'); %Copy symmetric

                %Indices for A matrix
                indA_15=E(:,1)+(E(:,5)-1)*numPoints;
                indA_26=E(:,2)+(E(:,6)-1)*numPoints;
                indA_37=E(:,3)+(E(:,7)-1)*numPoints;
                indA_48=E(:,4)+(E(:,8)-1)*numPoints;

                %Get indices for vertex array
                indV_15=full(A(indA_15));
                indV_26=full(A(indA_26));
                indV_37=full(A(indA_37));
                indV_48=full(A(indA_48));

                %% Create element array
                Es=[E(:,1:4) indV_15 indV_26 indV_37 indV_48;...
                    indV_15 indV_26 indV_37 indV_48 E(:,5:8)];

                %% Create vertex array
                Vn=0.5*(V(edgeMat(:,1),:)+V(edgeMat(:,2),:)); %new mid-edge points
                Vs = [V; Vn;]; %Join point sets
                CV=[0*ones(size(V,1),1); 1*ones(size(Vn,1),1);];

            case 3

                %% Mid edge sets
                edgeMat=[E(:,[1 2]); E(:,[5 6]);  E(:,[7 8]); E(:,[3 4])]; %left-right edges

                E_sort=sort(edgeMat,2); %Sorted edges matrix
                [~,ind1,~]=unique(E_sort,'rows');
                edgeMat=edgeMat(ind1,:);

                numPoints = size(V,1);
                numEdges = size(edgeMat,1);

                % Get indices of the four edges associated with each face
                A = sparse(edgeMat(:,1),edgeMat(:,2),(1:numEdges)+numPoints,numPoints,numPoints,numEdges);
                A = max(A,A'); %Copy symmetric

                %Indices for A matrix
                indA_12=E(:,1)+(E(:,2)-1)*numPoints;
                indA_56=E(:,5)+(E(:,6)-1)*numPoints;
                indA_78=E(:,7)+(E(:,8)-1)*numPoints;
                indA_34=E(:,3)+(E(:,4)-1)*numPoints;

                %Get indices for vertex array
                indV_12=full(A(indA_12));
                indV_56=full(A(indA_56));
                indV_78=full(A(indA_78));
                indV_34=full(A(indA_34));

                %% Create element array
                Es=[E(:,1) indV_12 indV_34 E(:,4) E(:,5) indV_56 indV_78 E(:,8);...
                    indV_12 E(:,2) E(:,3) indV_34 indV_56  E(:,6) E(:,7) indV_78];

                %% Create vertex array
                Vn=0.5*(V(edgeMat(:,1),:)+V(edgeMat(:,2),:)); %new mid-edge points
                Vs = [V; Vn;]; %Join point sets
                CV=[0*ones(size(V,1),1); 1*ones(size(Vn,1),1);];

            case 4

                %% Mid edge sets
                edgeMat=[E(:,[4 1]); E(:,[8 5]);  E(:,[6 7]); E(:,[2 3])]; %front-back edges

                E_sort=sort(edgeMat,2); %Sorted edges matrix
                [~,ind1,~]=unique(E_sort,'rows');
                edgeMat=edgeMat(ind1,:);

                numPoints = size(V,1);
                numEdges = size(edgeMat,1);

                % Get indices of the four edges associated with each face
                A = sparse(edgeMat(:,1),edgeMat(:,2),(1:numEdges)+numPoints,numPoints,numPoints,numEdges);
                A = max(A,A'); %Copy symmetric

                %Indices for A matrix
                indA_41=E(:,4)+(E(:,1)-1)*numPoints;
                indA_85=E(:,8)+(E(:,5)-1)*numPoints;
                indA_67=E(:,6)+(E(:,7)-1)*numPoints;
                indA_23=E(:,2)+(E(:,3)-1)*numPoints;

                %Get indices for vertex array
                indV_41=full(A(indA_41));
                indV_85=full(A(indA_85));
                indV_67=full(A(indA_67));
                indV_23=full(A(indA_23));

                %% Create element array
                Es=[E(:,[1 2]) indV_23 indV_41 E(:,[5 6]) indV_67 indV_85;...
                    indV_41 indV_23 E(:,[3 4]) indV_85 indV_67 E(:,[7 8])];

                %% Create vertex array
                Vn=0.5*(V(edgeMat(:,1),:)+V(edgeMat(:,2),:)); %new mid-edge points
                Vs = [V; Vn;]; %Join point sets
                CV=[0*ones(size(V,1),1); 1*ones(size(Vn,1),1);];

        end

        %% Override input
        C=repmat(C,[size(Es,1)/size(E,1),1]);
        E=Es;
        V=Vs;
    end
end

varargout{1}=E;
varargout{2}=V;
varargout{3}=C;
varargout{4}=CV;

%%
% _*GIBBON footer text*_
%
% License: <https://github.com/gibbonCode/GIBBON/blob/master/LICENSE>
%
% GIBBON: The Geometry and Image-based Bioengineering add-On. A toolbox for
% image segmentation, image-based modeling, meshing, and finite element
% analysis.
%
% Copyright (C) 2006-2022 Kevin Mattheus Moerman and the GIBBON contributors
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program.  If not, see <http://www.gnu.org/licenses/>.


function out = run_sqrs(ecg,HRVparams,rs)
%out = run_sqrs(ecg,s,rs)
%	OVERVIEW:
%       QRS onset detector
%   INPUT:
%       ecg = single channel of ECG in digital values
%       s   = settings struct
%       rs  = resampling option; 1 = resample original signal, 0 = don't
%   OUTPUT:
%       out = sample points of onset of each QRS complex
%   DEPENDENCIES & LIBRARIES:
%   REFERENCE:
%	REPO:
%       https://github.com/cliffordlab/hrv_toolbox
%   ORIGINAL SOURCE AND AUTHORS:
%       Converted from sqrs.c at:
%       http://www.physionet.org/physiotools/wfdb/app/sqrs.c
%       to  sqrs.m (Matlab)     by J. Perry,    July        2006
%           sqrs.c	(C)         by	G.B. Moody  27 October  1990
%
%	Last revised by John:  25 February 2006
%	Last revised by Gari:  07 February 2007
%
%   03-06-2017
%   Edited by Adriana Vest
%   Now requires settings struct HRVparams, which defines debug mode and
%   sampling frequency, and resampling option rs.
%   LICENSE AND COPYRIGHT:
%       See Below
%
% if debug>0, then plot final data (default; debug=0)
%
% This algorithm is sensitive to high frequency noise, so you
% might want to use an FIR band-pass filter first.
%
% Avaialble under the GPL (see below)
%-------------------------------------------------------------------------------
% sqrs: Single-channel QRS detector
% Copyright (C) 1990-2006 George B. Moody
%
% 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.
%
% You may contact the author by e-mail (george@mit.edu) or postal
% mail (MIT Room E25-505A, Cambridge, MA 02139 USA).  For updates to
% this software, please visit PhysioNet (http://www.physionet.org/).
% _________________________________________________________________
%
% The detector algorithm is based on example 10 in the WFDB
% Programmer's Guide, which in turn is based on a Pascal program
% written by W.A.H. Engelse and C. Zeelenberg, "A single scan
% algorithm for QRS-detection and feature extraction", Computers in
% Cardiology 6:37-42 (1979).  `sqrs' does not include the feature
% extraction capability of the Pascal program.  The output of `sqrs'
% is an annotation file (with annotator name `qrs') in which all
% detected beats are labelled normal;  the annotation file may also
% contain `artifact' annotations at locations which `sqrs' believes
% are noise-corrupted.
%
% 'sqrs' has been optimized for adult human ECGs. For other ECGs,
% it may be necessary to experiment with the input sampling
% frequency and the time constants indicated below.
%
% This program is provided as an example only, and is not intended
% for any clinical application.  At the time the algorithm was
% originally published, its performance was typical of
% state-of-the-art QRS detectors.  Recent designs, particularly
% those that can analyze two or more input signals, may exhibit
% significantly better performance.
%%

if nargin<2
    error('Incorrect number of input arguments: must provide ECG signal and HRV paramters struct')
end
if nargin < 3
    rs = 1;
end

%debug = s.debug;
debug = 0;
fs = HRVparams.Fs;

if ~rs
    %% 1. Use Fs of Input
    time = 0;
    now = 10;

    %freq = 256;
    freq = fs;
    ms160 = ceil(0.16*freq);
    ms200 = ceil(0.2*freq);
    s2 = ceil(2*freq);
    scmin = 500;
    % number of ADC units corresponding to scmin microvolts
    % scmin = muvadu(signal, scmin);
    scmax = 10 * scmin;
    slopecrit = 10 * scmin;
    maxslope = 0;
    nslope = 0;
    out = [];

    while (now < length(ecg)) %   && (to == 0)
        filter = [1 4 6 4 1 -1 -4 -6 -4 -1] * ecg((now-9):now);
        if (mod(time, s2) == 0)
	    % Adjust slope
            if (nslope == 0)
	      slopecrit = max(slopecrit - slopecrit/16, scmin);
            elseif (nslope >= 5)
	      slopecrit = min(slopecrit + slopecrit/16, scmax);
            end
        end
        if (nslope == 0  && abs(filter) > slopecrit)
            nslope = nslope + 1;
	    maxtime = ms160;
	    if (filter > 0)
	      sign = 1;
	    else
	      sign = -1;
	    end
            qtime = time;
        end
        if (nslope ~= 0)
            if (filter * sign < -slopecrit)
                sign = -sign;
                nslope = nslope + 1;
                if (nslope > 4)
                  maxtime = ms200;
                else
                  maxtime = ms160;
                end
            elseif (filter * sign > slopecrit &&  abs(filter) > maxslope)
                maxslope = abs(filter);
            end

            if (maxtime < 0)
                if (2 <= nslope && nslope <= 4)
                    slopecrit = slopecrit + ((maxslope/4) - slopecrit)/8;
                    if (slopecrit < scmin)
                        slopecrit = scmin;
                    elseif (slopecrit > scmax)
                        slopecrit = scmax;
                    end
                    out = [out; now - (time - qtime) - 4];
                    %annot.anntyp = NORMAL;
                    time = 0;
                elseif (nslope >= 5)
                    out = [out; now - (time - qtime) - 4];
                    %annot.anntyp = ARFCT;
                end
                nslope = 0;
            end
            maxtime = maxtime - 1;
        end
	time = time + 1;
	now = now + 1;
    end

    out=out-1; % adjust for 1 sample offset problem.

    if debug > 0
       plot(ecg,'b');
       hold on;
       plot(out,ecg(out),'m*');
    end
elseif rs
    %% 2. Resample at 256 Hz
    % These time constants may need adjustment for pediatric or
    % small mammal ECGs.
    ecg_rs = resample(ecg,256,fs);

    time = 0;
    now = 10;

    freq = 256;
    ms160 = ceil(0.16*freq);
    ms200 = ceil(0.2*freq);
    s2 = ceil(2*freq);
    %scmin = 500;
    % ANV changed this to work with real units
    scmin = 500;
    % number of ADC units corresponding to scmin microvolts
    % scmin = muvadu(ecg_rs, scmin);
    scmax = 10 * scmin;
    slopecrit = 10 * scmin;
    maxslope = 0;
    nslope = 0;
    out = [];

    while (now < length(ecg_rs)) %   && (to == 0)
        filter = [1 4 6 4 1 -1 -4 -6 -4 -1] * ecg_rs((now-9):now);
        if (mod(time, s2) == 0)
            % Adjust slope
            if (nslope == 0)
                slopecrit = max(slopecrit - slopecrit/16, scmin);
            elseif (nslope >= 5)
                slopecrit = min(slopecrit + slopecrit/16, scmax);
            end
        end
        if (nslope == 0  && abs(filter) > slopecrit)
            nslope = nslope + 1;
            maxtime = ms160;
            if (filter > 0)
                sign = 1;
            else
                sign = -1;
            end
            qtime = time;
        end
        if (nslope ~= 0)
            if (filter * sign < -slopecrit)
                sign = -sign;
                nslope = nslope + 1;
                if (nslope > 4)
                    maxtime = ms200;
                else
                  maxtime = ms160;
                end
            elseif (filter * sign > slopecrit &&  abs(filter) > maxslope)
                maxslope = abs(filter);
            end
            if (maxtime < 0)
                if (2 <= nslope && nslope <= 4)
                    slopecrit = slopecrit + ((maxslope/4) - slopecrit)/8;
                    if (slopecrit < scmin)
                        slopecrit = scmin;
                    elseif (slopecrit > scmax)
                        slopecrit = scmax;
                    end
                    out = [out; now - (time - qtime) - 4];
                    %annot.anntyp = NORMAL;
                    time = 0;
                elseif (nslope >= 5)
                    out = [out; now - (time - qtime) - 4];
                    %annot.anntyp = ARFCT;
                end
                nslope = 0;
            end
            maxtime = maxtime - 1;
        end
	time = time + 1;
	now = now + 1;
    end

    out=out-1; % adjust for 1 sample offset problem.

    if debug > 0
       plot(ecg_rs,'b');
       hold on;
       plot(out,ecg_rs(out),'m*');
    end

end


%%*****************************************************************
%% convertcmpsdp: convert SDP with complex data into one
%%                with real data by converting
%%
%%  C - sum_{k=1}^m yk*Ak psd
%%  to
%%  [CR,-CI] - sum ykR*[AkR,-AkI] psd
%%  [CI, CR]           [AkI, AkR]
%%
%%  ykI = 0 for k = 1:m
%%
%% [bblk,AAt,CC,bb] = convertcmpsdp(blk,A,C,b);
%%*****************************************************************
%% SDPT3: version 4.0
%% Copyright (c) 1997 by
%% K.C. Toh, M.J. Todd, R.H. Tutuncu
%% Last Modified: 16 Sep 2004
%%*****************************************************************

  function [bblk,AAt,CC,bb,iscmp] = convertcmpsdp(blk,A,C,b);

  m = length(b);
  [pp,mm] = size(A);
  if (pp ~= size(blk,1))
     error('blk and A not compatible');
  end
  numblk = size(blk,1);
  iscmp = zeros(numblk,m+1);
  for p = 1:size(blk,1)
     pblk = blk(p,:);
     len = size(A(p),2);
     for k = 1:len
        if ~isempty(A{p,k})
           iscmp(p,k) = 1-isreal(A{p,k});
        end
     end
     iscmp(p,m+1) = 1-isreal(C{p});
  end
  iscmp = norm(iscmp,'fro');
%%
  if (iscmp == 0)
     %% data is real
     bblk = blk; AAt = A; CC = C; bb = b;
     return;
  end
%%
  bb = [real(b)];
  bblk = cell(size(blk,1),2);
  for p = 1:size(blk,1)
     pblk = blk(p,:);
     if (size(pblk{2},1) > size(pblk{2},2))
        pblk{2} = pblk{2}';
     end
     if strcmp(pblk{1},'s')
        ss = [0,cumsum(pblk{2})];
        ss2 = [0,cumsum(2*pblk{2})];
        n = sum(pblk{2});
        n2 = sum(pblk{2}.*(pblk{2}+1))/2;
        AR = cell(1,m); Ctmp = sparse(2*n,2*n);
        if (size(A{p},1)==n2 & size(A{p},2)==m);
           Atype = 1;
        elseif (size(A(p),1)==1 & size(A(p),2)==1);
           Atype = 2;
        else
           error('convertcmp: At is not properly coded');
        end
        for k = 0:m
           if (k == 0)
              Ak = C{p};
           else
              if (Atype == 1)
                 Ak = smat(pblk,A{p}(:,k),1);
              elseif (Atype == 2)
                 Ak = A{p,k};
              end
           end
           Atmp = sparse(2*n,2*n);
           if (length(pblk{2}) == 1)
              tmp = [real(Ak),-imag(Ak);  imag(Ak), real(Ak)];
              if (k==0)
                 Ctmp = tmp;
              else
                 Atmp = tmp;
              end
           else
              for j = 1:length(pblk{2})
                 idx = [ss(j)+1: ss(j+1)];
                 Akj = Ak(idx,idx);
                 tmp = [real(Akj),-imag(Akj);  imag(Akj), real(Akj)];
                 idx2 = [ss2(j)+1: ss2(j+1)];
                 if (k==0)
                    Ctmp(idx2,idx2) = tmp;
                 else
   	            Atmp(idx2,idx2) = tmp;
                 end
              end
           end
           if (k==0);
              CC{p,1} = Ctmp;
           else
              AR{k} = Atmp;
           end
        end
        bblk{p,1} = 's'; bblk{p,2} = 2*pblk{2};
        AAt(p,1) = svec(bblk(p,:),AR);
     elseif strcmp(pblk{1},'q');
        error('SOCP block with complex data is currently not allowed');
     elseif strcmp(pblk{1},'l');
        if isreal(A{p}) & isreal(C{p})
           bblk(p,:) = blk(p,:);
           AAt{p,1} = A{p}; CC{p,1} = C{p};
        else
           error('data for linear block must be real');
        end
     elseif strcmp(pblk{1},'u');
        if isreal(A{p}) & isreal(C{p})
           bblk(p,:) = blk(p,:);
           AAt{p,1} = A{p}; CC{p,1} = C{p};
        else
           error('data for unrestricted block must be real');
        end
     end
  end
%%*********************************************************


function []=mavardisp(beta_median,beta_std,beta_lbound,beta_ubound,psi_median,psi_std,psi_lbound,psi_ubound,sigma_median,X,Z,Y,n,m,p,k1,k3,q1,q2,T,ar,lambda1,lambda2,lambda3,lambda4,lambda5,IRFt,beta_gibbs,endo,exo,psi_gibbs,startdate,enddate,stringdates1,decimaldates1,datapath)

% function []=mavardisp(beta_median,beta_std,beta_lbound,beta_ubound,psi_median,psi_std,psi_lbound,psi_ubound,sigma_median,X,Z,Y,n,m,p,k1,k3,q1,q2,T,ar,lambda1,lambda2,lambda3,lambda4,lambda5,IRFt,beta_gibbs,endo,exo,psi_gibbs,startdate,enddate,stringdates1,decimaldates1,datapath)
% displays estimation results for the MABVAR model on Matlab prompt, creates a copy of these results on the text file results.txt
% inputs:  - vector 'beta_median': median value of the posterior distribution of beta
%          - vector 'beta_std': standard deviation of the posterior distribution of beta
%          - vector 'beta_lbound': lower bound of the credibility interval of beta
%          - vector 'beta_ubound': upper bound of the credibility interval of beta
%          - vector 'psi_median': median value of the posterior distribution of psi
%          - vector 'psi_std': standard deviation of the posterior distribution of psi
%          - vector 'psi_lbound': lower bound of the credibility interval of psi
%          - vector 'psi_ubound': upper bound of the credibility interval of psi
%          - vector 'sigma_median': median value of the posterior distribution of sigma (vectorised)
%          - matrix 'X': matrix of regressors for the VAR model (defined in 3.5.10)
%          - matrix 'Z': matrix of exogenous regressors for the MABVAR model (defined in 3.5.10)
%          - matrix 'Y': matrix of regressands for the VAR model (defined in 3.5.10)
%          - integer 'n': number of endogenous variables in the BVAR model (defined p 7 of technical guide)
%          - integer 'm': number of exogenous variables in the BVAR model (defined p 7 of technical guide)
%          - integer 'p': number of lags included in the model (defined p 7 of technical guide)
%          - integer 'k1': number of endogenous coefficients to estimate for each equation in the MABVAR model (defined p 77 of technical guide)
%          - integer 'k3': number of exogenous coefficients to estimate for each equation in the reformulated MABVAR model (defined p 77 of technical guide)
%          - integer 'q1': total number of endogenous coefficients to estimate in the MABVAR model (defined p 77 of technical guide)
%          - integer 'q2': total number of exogenous coefficients to estimate in the MABVAR model (defined p 77 of technical guide)
%          - integer 'T': number of sample time periods (defined p 7 of technical guide)
%          - scalar 'lambda1': overall tightness hyperparameter (defined p 16 of technical guide)
%          - scalar 'lambda2': cross-variable weighting hyperparameter(defined p 16 of technical guide)
%          - scalar 'lambda3': lag decay hyperparameter (defined p 16 of technical guide)
%          - scalar 'lambda4': exogenous variable tightness hyperparameter (defined p 17 of technical guide)
%          - scalar 'lambda5': block exogeneity shrinkage hyperparameter (defined p 32 of technical guide)
%          - integer 'IRFt': determines which type of structural decomposition to apply (none, Choleski, triangular factorization)
%          - matrix 'beta_gibbs': record of the gibbs sampler draws for the beta vector
%          - cell 'endo': list of endogenous variables of the model
%          - matrix 'psi_gibbs': record of the gibbs sampler draws for the psi vector
%          - cell 'exo': list of exogenous variables of the model
%          - string 'startdate': start date of the sample
%          - string 'enddate': end date of the sample
%          - cell 'stringdates1': date strings for the sample period
%          - vector 'decimaldates1': dates converted into decimal values, for the sample period
%          - string 'datapath': user-supplied path to excel data spreadsheet
% outputs: none

% before displaying and saving the results, start estimating the evaluation measures for the model

% obtain first a point estimate betatilde of the VAR coefficients related to endogenous variables
% this is simply beta_median, which is both the mean and the median of the normal distribution
betatilde=beta_median;
Btilde=reshape(betatilde,k1,n);
% generate U, using Btilde, from (3.5.15)
% U=eye(n*m);
%    for jj=1:p
%    U=[U;kron(eye(m),Btilde((jj-1)*n+1:jj*n,:)')];
%    end

% obtain then a point estimate psitilde of the VAR coefficients related to exogenous variables
% this is simply psi_median, which is both the mean and the median of the normal distribution
psitilde=psi_median;

% % combine the two to obtain vec(DELTA'), using (3.5.14)
% vecdeltap=U*psitilde;
% % recover delta
% deltap=reshape(vecdeltap,n,k3);
% DELTA=deltap';

% use this estimate to produce predicted values for the model, following (3.5.9)
Ytilde=X*Btilde+Z*DELTA;
% then produce the corresponding residuals, using (3.5.9)
EPStilde=Y-Ytilde;

% check first whether the model is stationary, using (1.9.1)
[stationary eigmodulus]=bear.macheckstable(Btilde,n,p);

% Compute then the sum of squared residuals
% compute first the RSS matrix, defined in (1.9.5)
RSS=EPStilde'*EPStilde;
% retain only the diagonal elements to get the vector of RSSi values
rss=diag(RSS);

% Go on calculating R2
% generate Mbar
Mbar=eye(T)-ones(T,T)/T;
% then compute the TSS matrix, defined in (1.9.8)
TSS=Y'*Mbar*Y;
% generate the R2 matrix in (1.9.9)
R2=eye(n)-RSS./TSS;
% retain only the diagonal elements to get the vector of R2 values
r2=diag(R2);

% then calculate the adjusted R2, using (1.9.11)
R2bar=eye(n)-((T-1)/(T-(k1+m)))*(eye(n)-R2);
% retain only the diagonal elements to get the vector of R2bar values
r2bar=diag(R2bar);

% now start displaying and saving the results

% preliminary task: create and open the txt file used to save the results

filelocation=datapath;
filelocation=[filelocation '\results.txt'];
fid=fopen(filelocation,'wt');

% print toolbox header

fprintf('%s\n','');
fprintf(fid,'%s\n','');

fprintf('%s\n','%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%');
fprintf(fid,'%s\n','%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%');
fprintf('%s\n','%                                                                                %%');
fprintf(fid,'%s\n','%                                                                                %');
fprintf('%s\n','%    BAYESIAN ESTIMATION, ANALYSIS AND REGRESSION (BEAR) TOOLBOX                                         %');
fprintf(fid,'%s\n','%    BAYESIAN ESTIMATION, ANALYSIS AND REGRESSION (BEAR) TOOLBOX                                     %');
fprintf('%s\n','%                                                                                %');
fprintf(fid,'%s\n','%                                                                                %');
fprintf('%s\n','%    This statistical package has been developed by the external developments division of the ECB.       %');
fprintf(fid,'%s\n','%    This statistical package has been developed by the external developments division of the ECB.   %');
fprintf('%s\n','%                                                                                %');
fprintf(fid,'%s\n','%                                                                                %');
fprintf('%s\n','%    Authors:                                                                                %');
fprintf(fid,'%s\n','%    Authors:                                                                                %');
fprintf('%s\n','%    Romain Legrand  (Romain Legrand <b00148883@essec.edu>)                                              %');
fprintf(fid,'%s\n','%    Romain Legrand  (Romain Legrand <b00148883@essec.edu>)                                          %');
fprintf('%s\n','%    Alistair Dieppe (adieppe@worldbank.org)                                                             %');
fprintf(fid,'%s\n','%    Alistair Dieppe (adieppe@worldbank.org)                                                         %');
fprintf('%s\n','%    Björn van Roye  (Bjorn.van_Roye@ecb.europa.eu)                                                      %');
fprintf(fid,'%s\n','%    Björn van Roye  (Bjorn.van_Roye@ecb.europa.eu)                                                  %');
fprintf('%s\n','%                                                                                %');
fprintf(fid,'%s\n','%                                                                                %');
fprintf('%s\n','%    Version 4.4                                                                                %');
fprintf(fid,'%s\n','%    Version 4.4                                                                                %');
fprintf('%s\n','%                                                                                %');
fprintf(fid,'%s\n','%                                                                                %');
fprintf('%s\n','%    The authors are grateful to Paolo Bonomolo, Marta Banbura, Martin Bruns, Fabio Canova,              %');
fprintf(fid,'%s\n','%    The authors are grateful to Paolo Bonomolo, Marta Banbura, Martin Bruns, Fabio Canova,          %');
fprintf('%s\n','%    Matteo Ciccarelli, Marek Jarocinski, Niccolo Battistini, Gabriel Bobeica                            %');
fprintf(fid,'%s\n','%    Matteo Ciccarelli, Marek Jarocinski, Niccolo Battistini, Gabriel Bobeica                        %');
fprintf('%s\n','%    Michele Lenza, Chiara Osbat, Mirela Miescu, Gary Koop, Giorgio Primiceri                            %');
fprintf(fid,'%s\n','%    Michele Lenza, Chiara Osbat, Mirela Miescu, Gary Koop, Giorgio Primiceri,                       %');
fprintf('%s\n','%    Michal Rubaszek, Barbara Rossi, Ben Schumann, Peter Welz, Hugo Vega de la Cruz and Francesca Loria. %');
fprintf(fid,'%s\n','%  Michal Rubaszek, Barbara Rossi, Ben Schumann, Peter Welz, Hugo Vega de la Cruz and Francesca Loria%');
fprintf('%s\n','%    valuable input and advice which contributed to improve the quality of this work.                    %');
fprintf(fid,'%s\n','%  valuable input and advice which contributed to improve the quality of this work.                  %');
fprintf('%s\n','%                                                                                %');
fprintf(fid,'%s\n','%                                                                                %');
fprintf('%s\n','%   These programmes are the responsibilities of the authors and not of the ECB and the Worldbank.       %');
fprintf(fid,'%s\n','%   These programmes are the responsibilities of the authors and not of the ECB and the Worldbank.   %');
fprintf('%s\n','%   Errors and ommissions remain those of the authors.                                                   %');
fprintf(fid,'%s\n','%   Errors and ommissions remain those of the authors.                                               %');
fprintf('%s\n','%                                                                                %');
fprintf(fid,'%s\n','%                                                                                %');
fprintf('%s\n','%    Please do not use or quote this work without permission.                                            %');
fprintf(fid,'%s\n','%    Please do not use or quote this work without permission.                                        %');
fprintf('%s\n','%                                                                                %');
fprintf(fid,'%s\n','%                                                                                %');
fprintf('%s\n','%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%');
fprintf(fid,'%s\n','%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%');

% print then estimation results

fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');

toolboxinfo='BEAR toolbox estimates';
fprintf('%s\n',toolboxinfo);
fprintf(fid,'%s\n',toolboxinfo);

time=clock;
datestring=datestr(time);
dateinfo=['Date: ' datestring(1,1:11) '   Time: ' datestring(1,13:17)];
fprintf('%s\n',dateinfo);
fprintf(fid,'%s\n',dateinfo);

fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');

VARtypeinfo='Mean-adjusted BVAR';
fprintf('%s\n',VARtypeinfo);
fprintf(fid,'%s\n',VARtypeinfo);

if IRFt==1
SVARinfo='structural decomposition: none';
elseif IRFt==2
SVARinfo='structural decomposition: choleski factorisation';
elseif IRFt==3
SVARinfo='structural decomposition: triangular factorisation';
elseif IRFt==4
SVARinfo='structural decomposition: sign restrictions';
end
fprintf('%s\n',SVARinfo);
fprintf(fid,'%s\n',SVARinfo);

temp='endogenous variables: ';
for ii=1:n
temp=[temp ' ' endo{ii,1} ' '];
end
endoinfo=temp;
fprintf('%s\n',endoinfo);
fprintf(fid,'%s\n',endoinfo);

temp='exogenous variables: constant';
% if m>1
%    for ii=1:m-1
%    temp=[temp ' ' exo{ii,1} ' '];
%    end
% end
exoinfo=temp;
fprintf('%s\n',exoinfo);
fprintf(fid,'%s\n',exoinfo);

sampledateinfo=['estimation sample: ' startdate '-' enddate];
fprintf('%s\n',sampledateinfo);
fprintf(fid,'%s\n',sampledateinfo);

samplelengthinfo=['sample size (omitting initial conditions): ' num2str(T)];
fprintf('%s\n',samplelengthinfo);
fprintf(fid,'%s\n',samplelengthinfo);

laginfo=['number of lags included in regression: ' num2str(p)];
fprintf('%s\n',laginfo);
fprintf(fid,'%s\n',laginfo);

hyperparam1='hyperparameters:';
fprintf('%s\n',hyperparam1);
fprintf(fid,'%s\n',hyperparam1);

hyperparam2=['autoregressive coefficient (ar):          ' num2str(ar)];
fprintf('%s\n',hyperparam2);
fprintf(fid,'%s\n',hyperparam2);

hyperparam3=['overall tightness (lambda1):              ' num2str(lambda1)];
fprintf('%s\n',hyperparam3);
fprintf(fid,'%s\n',hyperparam3);

hyperparam4=['cross-variable weighting (lambda2):       ' num2str(lambda2)];
fprintf('%s\n',hyperparam4);
fprintf(fid,'%s\n',hyperparam4);

hyperparam5=['lag decay (lambda3):                      ' num2str(lambda3)];
fprintf('%s\n',hyperparam5);
fprintf(fid,'%s\n',hyperparam5);

hyperparam6=['exogenous variable tightness (lambda4):   ' num2str(lambda4)];
fprintf('%s\n',hyperparam6);
fprintf(fid,'%s\n',hyperparam6);

hyperparam7=['block exogeneity shrinkage (lambda5):     ' num2str(lambda5)];
fprintf('%s\n',hyperparam7);
fprintf(fid,'%s\n',hyperparam7);

% display coefficient estimates

fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');

coeffinfo=['VAR coefficients (beta): posterior estimates'];
fprintf('%s\n',coeffinfo);
fprintf(fid,'%s\n',coeffinfo);

for ii=1:n

fprintf('%s\n','');
fprintf(fid,'%s\n','');
if ii~=1
fprintf('%s\n','');
fprintf(fid,'%s\n','');
end

endoinfo=['Endogenous: ' endo{ii,1}];
fprintf('%s\n',endoinfo);
fprintf(fid,'%s\n',endoinfo);

coeffheader=fprintf('%25s %15s %15s %15s %15s\n','','Median','St.dev','Low.bound','Upp.bound');
coeffheader=fprintf(fid,'%25s %15s %15s %15s %15s\n','','Median','St.dev','Low.bound','Upp.bound');

% handle the endogenous
   for jj=1:n
      for kk=1:p
      values=[beta_median((ii-1)*k1+n*(kk-1)+jj,1) beta_std((ii-1)*k1+n*(kk-1)+jj,1) beta_lbound((ii-1)*k1+n*(kk-1)+jj,1) beta_ubound((ii-1)*k1+n*(kk-1)+jj,1)];
      fprintf('%25s %15.3f %15.3f %15.3f %15.3f\n',strcat(endo{jj,1},'(-',int2str(kk),')'),values);
      fprintf(fid,'%25s %15.3f %15.3f %15.3f %15.3f\n',strcat(endo{jj,1},'(-',int2str(kk),')'),values);
      end
   end

% handle the exogenous
% display the results related to the constant
values=[psi_median(ii,1) psi_std(ii,1) psi_lbound(ii,1) psi_ubound(ii,1)];
fprintf('%25s %15.3f %15.3f %15.3f %15.3f\n','Constant',values);
fprintf(fid,'%25s %15.3f %15.3f %15.3f %15.3f\n','Constant',values);
   % if there is no other exogenous, stop here
   if m==1
   % if there are other exogenous, display their results
   elseif m>1
      for jj=1:m-1
      values=[psi_median(n*jj+ii,1) psi_std(n*jj+ii,1) psi_lbound(n*jj+ii,1) psi_ubound(n*jj+ii,1)];
      %fprintf('%25s %15.3f %15.3f %15.3f %15.3f\n',exo{jj,1},values);
     %fprintf(fid,'%25s %15.3f %15.3f %15.3f %15.3f\n',exo{jj,1},values);
     end
   end

fprintf('%s\n','');
fprintf(fid,'%s\n','');

% display evaluation measures
rssinfo=['Sum of squared residuals: ' num2str(rss(ii,1),'%.2f')];
fprintf('%s\n',rssinfo);
fprintf(fid,'%s\n',rssinfo);

r2info=['R-squared: ' num2str(r2(ii,1),'%.3f')];
fprintf('%s\n',r2info);
fprintf(fid,'%s\n',r2info);

adjr2info=['adj. R-squared: ' num2str(r2bar(ii,1),'%.3f')];
fprintf('%s\n',adjr2info);
fprintf(fid,'%s\n',adjr2info);

end

fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');

% display VAR stability results
eigmodulus=reshape(eigmodulus,p,n);
stabilityinfo1=['Roots of the characteristic polynomial (modulus):'];
fprintf('%s\n',stabilityinfo1);
fprintf(fid,'%s\n',stabilityinfo1);
for ii=1:p
temp=num2str(eigmodulus(ii,1),'%.3f');
   for jj=2:n
   temp=[temp,'  ',num2str(eigmodulus(ii,jj),'%.3f')];
   end
fprintf('%s\n',temp);
fprintf(fid,'%s\n',temp);
end
if stationary==1;
stabilityinfo2=['No root lies outside the unit circle.'];
stabilityinfo3=['The estimated VAR model satisfies the stability condition'];
fprintf('%s\n',stabilityinfo2);
fprintf(fid,'%s\n',stabilityinfo2);
fprintf('%s\n',stabilityinfo3);
fprintf(fid,'%s\n',stabilityinfo3);
else
stabilityinfo2=['Warning: at leat one root lies on or outside the unit circle.'];
stabilityinfo3=['The estimated VAR model will not be stable'];
fprintf('%s\n',stabilityinfo2);
fprintf(fid,'%s\n',stabilityinfo2);
fprintf('%s\n',stabilityinfo3);
fprintf(fid,'%s\n',stabilityinfo3);
end

fprintf('%s\n','');
fprintf(fid,'%s\n','');
fprintf('%s\n','');
fprintf(fid,'%s\n','');

% display posterior for sigma
sigmainfo=['sigma (residual covariance matrix): posterior estimates'];
fprintf('%s\n',sigmainfo);
fprintf(fid,'%s\n',sigmainfo);
% calculate the (integer) length of the largest number in sigma, for formatting purpose
width=length(sprintf('%d',floor(max(abs(bear.vec(sigma_median))))));
% add a separator, a potential minus sign, and three digits (total=5) to obtain the total space for each entry in the matrix
width=width+5;
for ii=1:n
temp=[];
   for jj=1:n
   % convert matrix entry into string
   number=num2str(sigma_median(ii,jj),'% .3f');
      % pad potential missing blanks
      while numel(number)<width
      number=[' ' number];
      end
   number=[number '  '];
   temp=[temp number];
   end
fprintf('%s\n',temp);
fprintf(fid,'%s\n',temp);
end

fclose(fid);

% Finally, display the results in terms of graph

% graph the empirical posterior distribution of the VAR parameters
% first reshape the gibbs sampler output to be compatible with the way Matlab uses subplot
% first concatenate psi_gibbs on beta_gibbs to obtain a vector similar to beta in the classical BVAR model
temp=[];
for ii=1:n
temp=[temp;beta_gibbs((ii-1)*k1+1:ii*k1,:)];
   for jj=1:m
   temp=[temp;psi_gibbs((jj-1)*m+ii,:)];
   end
end
beta_reshape=temp;
[beta_swap]=bear.betaswap(beta_reshape,n,m,p,k1+m);
plotvar=1;
plotlag=1;
plotexo=1;
plotconst=1;
% then plot the figure
%{
postdis=figure;
set(postdis,'Color',[0.9 0.9 0.9]);
set(postdis,'name','posterior ditribution of VAR coefficients');
for ii=1:(q1+q2)
subplot(n,k1+m,ii)
hist(beta_swap(ii,:),20);
histproperties=findobj(gca,'Type','patch');
set(histproperties,'FaceColor',[0.7 0.78 1],'EdgeColor',[0 0 0],'LineWidth',0.1);
set(gca,'FontName','Times New Roman');
   % top labels for endogenous
   if ii<=n*p
   temp=[endo{plotvar,1} '(-' num2str(plotlag) ')'];
   title(temp,'FontWeight','normal');
      if plotlag<p
      plotlag=plotlag+1;
      elseif plotlag==p
      plotlag=1;
      plotvar=plotvar+1;
      end
   end
   % top labels for exogenous
   %if ii==k1+1
   %title('Constant','FontWeight','normal');
   %end
   %if ii>k1+1 && ii<=k1+m
   %title(exo{plotexo,1},'FontWeight','normal');
   %plotexo=plotexo+1;
   %end
   % side labels
   %if rem((ii-1)/(k1+m),1)==0
   ylabel(endo{(ii-1)/(k1+m)+1,1},'FontWeight','normal');
   %end
end
%}

% plot actual vs. fitted
actualfitted=figure;
set(actualfitted,'Color',[0.9 0.9 0.9]);
set(actualfitted,'name','model estimation: actual vs fitted')
ncolumns=ceil(n^0.5);
nrows=ceil(n/ncolumns);
for ii=1:n
subplot(nrows,ncolumns,ii)
hold on
plot(decimaldates1,Y(:,ii),'Color',[0 0 0],'LineWidth',2);
plot(decimaldates1,Ytilde(:,ii),'Color',[1 0 0],'LineWidth',2);
hold off
set(gca,'XLim',[decimaldates1(1,1) decimaldates1(end,1)],'FontName','Times New Roman');
title(endo{ii,1},'FontName','Times New Roman','FontSize',10);
   if ii==1
   plotlegend=legend('actual','fitted');
   set(plotlegend,'FontName','Times New Roman');
   end
end

% plot the residuals
residuals=figure;
set(residuals,'Color',[0.9 0.9 0.9]);
set(residuals,'name','model estimation: residuals')
for ii=1:n
subplot(nrows,ncolumns,ii)
plot(decimaldates1,EPStilde(:,ii),'Color',[0 0 0],'LineWidth',2)
set(gca,'XLim',[decimaldates1(1,1) decimaldates1(end,1)],'FontName','Times New Roman');
title(endo{ii,1},'FontName','Times New Roman','FontSize',10);
end

% finally, save the results on excel
bear.data.excelrecord2fcn(T, n, endo, stringdates1, Y, Ytilde, pref, EPStilde)


% Assumes depth == 0
function point3D = proj2Dto3D(point2D, cameraParams, rotationMatrix, translationVector)
    N = size(point2D, 1);
    if N ~= 2
        point2D = point2D';
    end
    if size(point2D, 1) == 2
        point2D(3, :) = 1;
    end
    numPoints = size(point2D, 2);

    % if length(point2D) == 2
    %     point2D(3) = 1;
    % end
    % if size(point2D, 2) > 1
    %     point2D = point2D';
    % end
    K = cameraParams.IntrinsicMatrix';
    z_small = inv(rotationMatrix) * inv(K) * point2D;
    lamda = repmat(-translationVector(3), 1, numPoints) ./ z_small(3, :);

    translationVector = translationVector';
    % multiply lamda*z_small, i.e. lamda(i)*z_small(:, i)
    B = cellfun(@(x, y)(translationVector + x * y), num2cell(lamda), num2cell(z_small, 1), 'uniformoutput', false);
    point3D = cell2mat(B);
end


% EEGFILTFFT -  (high|low|band)-pass filter data using inverse fft
%                 (without using the Matlab signal processing toolbox)
% Usage:
%  >> [smoothdata] = eegfiltfft(data,srate,locutoff,hicutoff);
%  >> [smoothdata] = eegfiltfft(data,srate,locutoff,hicutoff,epochframes,filtorder,revfilt);
%
% Inputs:
%   data        = (channels,frames*epochs) data to filter
%   srate       = data sampling rate (Hz)
%   locutoff    = low-edge frequency in pass band (Hz)  {0 -> lowpass}
%   hicutoff    = high-edge frequency in pass band (Hz) {0 -> highpass}
%
% Optional inputs:
%   epochframes = frames per epoch (filter each epoch separately {def/0: data is 1 epoch}
%   filtorder   = argument not used (but required for symmetry with EEGFILT function).
%   revfilt     = [0|1] reverse filter (i.e. bandpass filter to notch filter). {0}
%
% Outputs:
%    smoothdata = smoothed data
%
% Known problems:
%    The signal drop off is much smaller compared to standard filtering methods
%
% Author: Arnaud Delorme, SCCN/INC/UCSD, La Jolla, 2003
%
% See also: EEGFILT

% inspired from a google group message
% http://groups.google.com/groups?q=without+%22the+signal+processing+toolbox%22&hl=en&lr=&ie=UTF-8&oe=UTF-8&selm=f56893ae.0311141025.3069d4f8%40posting.google.com&rnum=8

% Copyright (C) Arnaud Delorme, SCCN/INC/UCSD, arno@salk.edu
%
% This file is part of EEGLAB, see http://www.eeglab.org
% for the documentation and details.
%
% Redistribution and use in source and binary forms, with or without
% modification, are permitted provided that the following conditions are met:
%
% 1. Redistributions of source code must retain the above copyright notice,
% this list of conditions and the following disclaimer.
%
% 2. Redistributions in binary form must reproduce the above copyright notice,
% this list of conditions and the following disclaimer in the documentation
% and/or other materials provided with the distribution.
%
% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
% THE POSSIBILITY OF SUCH DAMAGE.

function smoothdata = eegfiltfft(data, fs, lowcut, highcut, epochframes, filtorder, revfilt);

    if nargin < 4
        help eegfiltfft;
    end
    [chans frames] = size(data);
    if nargin < 5 || epochframes == 0
        epochframes = frames;
    end
    if nargin < 7
        revfilt = 0;
    end

    epochs = frames/epochframes;
    if epochs ~= round(epochs)
        error('Epochframes does not divide the total number of frames');
    end
    fv=reshape([0:epochframes-1]*fs/epochframes,epochframes,1); % Frequency vector for plotting

    %figure;
    %plot(fv, 20*log(abs(X))/log(10))  % Plot power spectrum in dB scale
    %xlabel('Frequency [Hz]')
    %ylabel('Signal power [dB]')

    % find closest freq in fft decomposition
    % --------------------------------------
    if lowcut ~= 0
        [tmp idxl]=min(abs(fv-lowcut));  % Find the entry in fv closest to 5 kHz
    else
        idxl = 0;
    end
    if highcut ~= 0
        [tmp idxh]=min(abs(fv-highcut));  % Find the entry in fv closest to 5 kHz
    else
        idxh = ceil(length(fv)/2);
    end

    % filter the data
    % ---------------
    smoothdata = zeros(chans,frames);
    for e = 1:epochs                % filter each epoch, channel
        for c=1:chans
            X=fft(data(c,(e-1)*epochframes+1:e*epochframes));
            if revfilt
                X(idxl+1:idxh-1)=0;
                if mod(length(X),2) == 0
                    X(end/2:end)=0;
                else
                    X((end+1)/2:end)=0;
                end
            else
                X(1:idxl)=complex(0);
                X(end-idxl:end)=complex(0);
                X(idxh:end)=complex(0);
            end;
            smoothdata(c,(e-1)*epochframes+1:e*epochframes) = 2*real(ifft(X));
            if epochs == 1
                if rem(c,20) ~= 0
                    fprintf('.');
                else
                    fprintf('%d',c);
                end
            end
        end
    end
    fprintf('\n');


function [p1,p2,P1_l,P2_l] = idpLin2idpPnts(l)

% IDPLIN2IDPPNTS  IDP line to two IDP points conversion.
%   [P1,P2] = IDPLIN2IDPPNTS(L) extracts the two endpoints of the IDP line
%   L in the form of two IDP points with the same anchor of that of the
%   line.
%
%   [p1,p2,P1_l,P2_l] = IDPLIN2IDPPNTS(...) returns the Jacobians wrt L.

%   Copyright 2008-2009 Joan Sola @ LAAS-CNRS.

p1 = l(1:6,:);
p2 = l([1:3 7:9],:);

if nargout > 2

    P1_l = [eye(6) zeros(6,3)];
    P2_l = [eye(3) zeros(3,6) ; zeros(3,6) eye(3)];

end

return

%% jac

syms x y z p1 y1 r1 p2 y2 r2 real
l = [x y z p1 y1 r1 p2 y2 r2]';

[p1,p2,P1_l,P2_l] = idpLin2idpPnts(l);

simplify(P1_l - jacobian(p1,l))
simplify(P2_l - jacobian(p2,l))

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

%   # START GPL LICENSE

%---------------------------------------------------------------------
%
%   This file is part of SLAMTB, a SLAM toolbox for Matlab.
%
%   SLAMTB is free software: you can redistribute it and/or modify
%   it under the terms of the GNU General Public License as published by
%   the Free Software Foundation, either version 3 of the License, or
%   (at your option) any later version.
%
%   SLAMTB is distributed in the hope that it will be useful,
%   but WITHOUT ANY WARRANTY; without even the implied warranty of
%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%   GNU General Public License for more details.
%
%   You should have received a copy of the GNU General Public License
%   along with SLAMTB.  If not, see <http://www.gnu.org/licenses/>.
%
%---------------------------------------------------------------------

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

%   # END GPL LICENSE