function [G_D2,MSE]=GenerateGD2Table(numiter,N,alphaNT,G_D2init,Range_prior,Range_post)
%function [G_D2,MSE]=GenerateGD2Table(numiter,N,alphaNT,Range_prior,Range_post);
% Generates gain table for MMSE noise power estimation. The recursive
% nature of the estimation problem is taken into account by an iterative
% scheme. For more details see:
%
% J.S. Erkelens and R. Heusdens, "Tracking of nonstationary noise based on
% data-driven recursive noise power estimation", IEEE Trans. Audio,
% Speech & Lang. Proc., vol. 16, no. 6, pp. 1112-1123, 2008.
%
% J.S. Erkelens and R. Heusdens, "Fast noise tracking based on recursive
% smoothing of MMSE noise power estimates", ICASSP 2008, pp. 4873-4876.
%
% INPUT VARIABLES:
% numiter : number of optimization iterations.
% N : frame length.
% alphaNT : smoothing parameter in prior SNR parameter for noise tracking.
% Range_prior : range of the prior SNR parameter, e.g, [-19 40] (as used
% in the papers) means that the prior SNR is quantized between -19 dB and
% 40 dB in steps of 1 dB.
% Range_post: range of the posterior SNR. In the papers [-30 40] is used,
% meaning that the gain table G_D2 has dimensions 60-by-71.
% G_D2init : Initial gain table for MMSE estimation of noise power. May be
% found with the basic data-driven method. Simply initializing with
% ones(60,71) should also work (for Range_prior=[-19 40] and
% Range_post=[-30 40]).
%
% OUTPUT VARIABLES:
% G_D2 : gain table for MMSE estimation of noise power.
% MSE : normalized mean-square error per iteration (NOTE: since we are
% initializing with the noisy powers, this MSE may INCREASE with each
% iteration.
% If we apply the gain functions to the training data RECURSIVELY, however,
% the mse decreases with each iteration step. Both MSEs (on the traindata
% and when applied recursively) do converge to the same end value. See the
% 2nd paper mentioned above for a more thorough explanation and
% illustration.
%
% Copyright 2008: Delft University of Technology, Information and
% Communication Theory Group. The software is free for non-commercial use.
% This program comes WITHOUT ANY WARRANTY.
%
% Last modified: 17-3-2008.

global NoiseSpectrum
load NoiseSpectrum

Gd2new=G_D2init;
% Intialize MSE
MSE=zeros(1,numiter);
% SNRs (dB scale)
SNRs=[-12.5:5:27.5];
% Directory with training data
DIR='C:/data/Timit_TBW/Matrices/';
% List of training data files
fid=fopen('C:/data/Timit_TBW/trainlist.txt','r');
% read the first filename
s=fgetl(fid);
for k1=1:numiter
    % Initialize statistics needed to compute the optimal gain values
    sumD2R2=zeros(Range_prior(2)-Range_prior(1)+1,Range_post(2)-Range_post(1)+1);
    sumR4=sumD2R2;sumD4=sumD2R2;
    while s~=-1 % while not EOF
        % Use 2 Timit directories for training
        if strcmpi(s(16:18),'dr4') | strcmpi(s(16:18),'dr5')
            % Strip some path info and convert to lowercase
            s=lower(s(16:end-3));
            % Some difference between Windows and Linux
            I=find(s=='\');s(I)='/';
            % Collect statistics for all SNRs
            for snrnr=1:length(SNRs)
                % strip path info, retain file name
                filestr=s(11:end-1);
                % directory name for arrays of frame numbers with
                % sufficient speech energy.
                dirstr=[DIR s(1:10)];
                % load indices of frames with sufficient speech energy.
                % Only those are used for optimization of the gain.
                eval(['load ' dirstr filestr '_IsufE'])
                % directory name for the data at current SNR
                dirstr=[DIR s(1:10) 'Snr' num2str(snrnr) '/'];
                % load noise powers (needed to compute the statistics
                % for gain optimization).
                iterstr='Init';matstrD='Dmatrix';
                filestrD=[dirstr filestr '_' matstrD 'Snr' num2str(snrnr) iterstr];
                eval(['load ' filestrD ' ' matstrD])
                % "Dclean" means the "true" noise powers. The final
                % estimates will of course not be "clean" but contaminated
                % by some speech power.
                Dclean=Dmatrix;
                % Load noisy amplitudes (Rmatrix)
                filestrR=[dirstr filestr '_Rmatrix' 'Snr' num2str(snrnr) 'Init'];
                eval(['load ' filestrR ' Rmatrix'])
                % Load estimates from the previous iteration (Dmatrix) ...
                iterstr='Iter';
                filestrD=[dirstr filestr '_' matstrD 'Snr' num2str(snrnr) iterstr];
                eval(['load ' filestrD ' ' matstrD])
                % ... but initialize with 'Rmatrix', i.e., noisy amplitudes
                % in the first iteration.
                if k1==1,Dmatrix=Rmatrix;end
                % Collect statistics and calculate new data
                [sumd4,sumd2r2,sumr4,Dmatrix]=collectdata(N,alphaNT,IsufE,Dclean,Dmatrix,Rmatrix,Gd2new,Range_prior,Range_post,SNRs(snrnr));
                sumD2R2=sumD2R2+sumd2r2;sumR4=sumR4+sumr4;sumD4=sumD4+sumd4;
                % Save updated Dmatrix
                iterstr='Iter';
                filestrD=[dirstr filestr '_' matstrD 'Snr' num2str(snrnr) iterstr];
                eval(['save ' filestrD ' ' matstrD])
            end % for snrnr=1:length(SNRs)
        end % strcmpi(s(16:18),'dr4') | strcmpi(s(16:18),'dr5')
        % read the next file name
        s=fgetl(fid);
    end % while s~=-1
    % Update gain function and calculate MSE
    sumR41=sumR4;
    sumR41(sumR41==0)=1;% avoid dividing by 0
    Gd2new=sumD2R2./sumR41;
    % Calculate MSE
    MSEd=sumD4-2*Gd2new.*sumD2R2+(Gd2new.^2).*sumR4;
    % Normalize
    MSEd=sum(sum(MSEd))/sum(sum(sumD4));
    MSE(k1)=MSEd;
    % Save some stuff
    alphap=0.1;alphad=0.85;T=4;% These values are used below in the function collectdata
    eval(['save ' DIR2 'GainTable_iteration' num2str(k1) ' Gd2new MSE alphaNT alphad alphap N T']);
    % display number of iterations to go and MSE
    disp(numiter-k1),disp(MSEd)
    % Go through all the data again in the next iteration
    frewind(fid);s=fgetl(fid);
end % for k1=1:numiter
fclose(fid);
G_D2=Gd2new;

function [sumd4,sumd2r2,sumr4,Dnew]=collectdata(N,alphaNT,IsufE,Dclean,Dmatrix,Rmatrix,Gd2new,Range_prior,Range_post,dBsnr)
global NoiseSpectrum
% Initialization of statistics for computing the gain table
sumd2r2=zeros(Range_prior(2)-Range_prior(1)+1,Range_post(2)-Range_post(1)+1);
sumr4=sumd2r2;
sumd4=sumd2r2;
alpha2=0.85*ones(1,N/2+1)';
alphap=0.1;alphad=alpha2(1);
T=4;
% Frequency bins used to collect the statistics from
freqbins=10:110;
% speech presence probability
Pspi=zeros(1,N/2+1)';Pspii=Pspi;
% speech presence index
Isp=zeros(1,N/2+1)';
% minimum value prior SNR
ksi_min=10^(-1.9);% -19 dB
% Initialization of noise variance for iteration i and i+1 (denoted by ii)
labda_di=NoiseSpectrum/(10^(dBsnr/10));%True noise variance.
% Appropriate when the speech is normalized as in GenerateTraindata.m
% Note that statistics are collected for bins in the passband only.
labda_dii=labda_di;
S=size(Dmatrix);
Dnew=zeros(S);Dnew(:,1)=Dmatrix(:,1);
% frame length
N=2*S(1)-2;
S=S(2);
% length of a column of the gain matrix
Gsize=size(Gd2new);Gsize=Gsize(1);
for m=2:S
    R=Rmatrix(:,m);D=Dclean(:,m);
    % Update prior SNR (priorNT) and posterior SNR (postSNR) using data
    % from the last iteration
    postSNR=R.^2./labda_di;
    B0=Rmatrix(:,m-1).^2;
    priorNT=max(alphaNT*B0./labda_di+(1-alphaNT)*postSNR,ksi_min);
    dBprior=10*log10(priorNT);
    dBpost=10*log10(postSNR+eps);
    % Indices in gain table
    Iprior=min(max(round(dBprior),Range_prior(1)),Range_prior(2))-Range_prior(1)+1;
    Ipost=min(max(round(dBpost),Range_post(1)),Range_post(2))-Range_post(1)+1;
    % Update labda_di
    D20=Dmatrix(:,m).^2;
    Mpost=freqsmooth(postSNR,1);Isp=(Mpost>T);
    Pspi=alphap.*Pspi+(1-alphap).*Isp;
    alpha2i=alphad+(1-alphad).*Pspi;
    labda_di=alpha2i.*labda_di+(1-alpha2i).*D20;
    % Calculate new estimated noise powers
    D2=GainR2(Gd2new,Iprior,Ipost,R,N);
    Dnew(:,m)=sqrt(D2);
    % Calculate new priorNT en postSNR
    postSNR=R.^2./labda_dii;
    priorNT=max(alphaNT*B0./labda_dii+(1-alphaNT)*postSNR,ksi_min);
    dBprior=10*log10(priorNT);
    dBpost=10*log10(postSNR+eps);
    Iprior=min(max(round(dBprior),Range_prior(1)),Range_prior(2))-Range_prior(1)+1;
    Ipost=min(max(round(dBpost),Range_post(1)),Range_post(2))-Range_post(1)+1;
    % Collect data from bins 10 t/m 110 (because telephone bandwidth speech
    % is limited to about 300-3400 Hz) for frames with sufficient speech
    % energy.
    if ~isempty(intersect(m,IsufE))
        %CHECK FOR MULTIPLE ELEMENTS
        index2=Iprior(freqbins)+Gsize*(Ipost(freqbins)-1);
        if length(unique(index2))==length(index2)
            sumd4(index2)=sumd4(index2)+D(freqbins).^4;
            sumr4(index2)=sumr4(index2)+R(freqbins).^4;
            sumd2r2(index2)=sumd2r2(index2)+(R(freqbins).*D(freqbins)).^2;
        else
            for k1=1:length(freqbins)
                index2=Iprior(freqbins(k1))+Gsize*(Ipost(freqbins(k1))-1);
                sumd4(index2)=sumd4(index2)+D(freqbins(k1)).^4;
                sumr4(index2)=sumr4(index2)+R(freqbins(k1)).^4;
                sumd2r2(index2)=sumd2r2(index2)+(R(freqbins(k1)).*D(freqbins(k1))).^2;
            end
        end
    end
    % Update labda_d with new estimate of D^2
    D20=Dnew(:,m).^2;
    Mpost=freqsmooth(postSNR,1);Isp=(Mpost>T);
    Pspii=alphap.*Pspii+(1-alphap).*Isp;
    alpha2ii=alphad+(1-alphad).*Pspii;
    labda_dii=alpha2ii.*labda_dii+(1-alpha2ii).*D20;
end

function Amplitude2=GainR2(Gmatrix,Iprior,Ipost,R,N)
L=size(Gmatrix);L=L(1);
index=1:N/2+1;index2=Iprior(index)+L*(Ipost(index)-1);
Amplitude2=Gmatrix(index2).*(R.^2);

function mx=freqsmooth(x,w)
L=length(x);mx=zeros(size(x));
for k=1:L
    i1=max(k-w,1);i2=min(k+w,L);
    mx(k)=sum(x(i1:i2))/(i2-i1+1);
end


function [oceanloadcorr] = ocean_loading_correction(time, XR, XS)

% SYNTAX:
%   [oceanloadcorr] = ocean_loading_correction(time, XR, XS);
%
% INPUT:
%   time = GPS time
%   XR   = receiver position  (X,Y,Z)
%   XS   = satellite position (X,Y,Z)
%
% OUTPUT:
%   oceanloadcorr = ocean loading correction terms (along the satellite-receiver line-of-sight)
%
% DESCRIPTION:
%   Computation of the ocean loading displacement terms.

%--- * --. --- --. .--. ... * ---------------------------------------------
%               ___ ___ ___
%     __ _ ___ / __| _ | __|
%    / _` / _ \ (_ |  _|__ \
%    \__, \___/\___|_| |___/
%    |___/                    v 1.0RC1
%
%--------------------------------------------------------------------------
%  Copyright (C) 2021 Geomatics Research & Development srl (GReD)
%  Written by:
%  Contributors:     ...
%  A list of all the historical goGPS contributors is in CREDITS.nfo
%--------------------------------------------------------------------------
%
%   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/>.
%
%--------------------------------------------------------------------------
% 01100111 01101111 01000111 01010000 01010011
%--------------------------------------------------------------------------

%ocean loading displacements matrix, station-dependent (see http://holt.oso.chalmers.se/loading/)
global ol_disp zero_time

oceanloadcorr = zeros(size(XS,1),1);
if (isempty(ol_disp))
    return
end

%terms depending on the longitude of the lunar node (see Kouba and Heroux, 2001)
fj = 1; %(at 1-3 mm precision)
uj = 0; %(at 1-3 mm precision)

%ref: http://202.127.29.4/cddisa/data_base/IERS/Convensions/Convension_2003/SUBROUTINES/ARG.f
tidal_waves = [1.40519E-4, 2.0,-2.0, 0.0, 0.00; ... % M2  - semidiurnal
               1.45444E-4, 0.0, 0.0, 0.0, 0.00; ... % S2  - semidiurnal
               1.37880E-4, 2.0,-3.0, 1.0, 0.00; ... % N2  - semidiurnal
               1.45842E-4, 2.0, 0.0, 0.0, 0.00; ... % K2  - semidiurnal
               0.72921E-4, 1.0, 0.0, 0.0, 0.25; ... % K1  - diurnal
               0.67598E-4, 1.0,-2.0, 0.0,-0.25; ... % O1  - diurnal
               0.72523E-4,-1.0, 0.0, 0.0,-0.25; ... % P1  - diurnal
               0.64959E-4, 1.0,-3.0, 1.0,-0.25; ... % Q1  - diurnal
               0.53234E-5, 0.0, 2.0, 0.0, 0.00; ... % Mf  - long-period
               0.26392E-5, 0.0, 1.0,-1.0, 0.00; ... % Mm  - long-period
               0.03982E-5, 2.0, 0.0, 0.0, 0.00];    % Ssa - long-period

refdate = datenum([1975 1 1 0 0 0]);

[week, sow] = time2weektow(zero_time + time);
dateUTC = datevec(gps2utc(datenum(gps2date(week, sow))));

%separate the fractional part of day in seconds
fday = dateUTC(4)*3600 + dateUTC(5)*60 + dateUTC(6);
dateUTC(4:end) = 0;

%number of days since reference date (1 Jan 1975)
days = (datenum(dateUTC) - refdate);

capt = (27392.500528 + 1.000000035*days)/36525;

%mean longitude of the Sun at the beginning of day
H0 = (279.69668 + (36000.768930485 + 3.03e-4*capt)*capt)*pi/180;

%mean longitude of the Moon at the beginning of day
S0 = (((1.9e-6*capt - 0.001133)*capt + 481267.88314137)*capt + 270.434358)*pi/180;

%mean longitude of the lunar perigee at the beginning of day
P0 = (((-1.2e-5*capt - 0.010325)*capt + 4069.0340329577)*capt + 334.329653)*pi/180;

corr = zeros(3,1);
for k = 1 : 11
    angle = tidal_waves(k,1)*fday + tidal_waves(k,2)*H0 + tidal_waves(k,3)*S0 + tidal_waves(k,4)*P0 + tidal_waves(k,5)*2*pi;
    corr  = corr + fj*ol_disp(1).matrix(1:3,k).*cos(angle + uj - ol_disp(1).matrix(4:6,k)*pi/180);
end
corrENU(1,1) = -corr(2,1); %east
corrENU(2,1) = -corr(3,1); %north
corrENU(3,1) =  corr(1,1); %up

%displacement along the receiver-satellite line-of-sight
XRcorr = local2globalPos(corrENU, XR);
corrXYZ = XRcorr - XR;
for s = 1 : size(XS,1)
    LOS  = XR - XS(s,:)';
    LOSu = LOS / norm(LOS);
    % oceanloadcorr(s,1) = dot(corrXYZ,LOSu);
    oceanloadcorr(s,1) = sum(conj(corrXYZ).*LOSu);
end


function [res,exact] = AccDot(varargin)
%AccDot       Accurate dot product with faithful, to nearest or K-fold rounding
%
%   res = AccDot(A1,B1,...,An,Bn,K)
%
%res is sum(Ai*Bi)
%   K optional, default K=1 for faithfully rounded result
%   K   =0    rounded to nearest result
%       >1    result in cell array of length K of non-overlapping sequences,
%               sum(res{i})=sum(Ai,Bi) with K-fold accuracy
%       =inf  result in cell array of length K of non-overlapping sequences of
%               sufficient length s.t. sum(res{i})=sum(Ai,Bi) exactly
%       []    interval inclusion of the result; inclusion is best possible if no
%               underflow occurs.
%
%output exact (optional), array of 0/1 of size of result with entry equal to 1
%  iff corresponding dot product exact.
%
%All factors may be real non-interval.
%  The size of every product Ai*Bi must be the same.
%
%One of the factors Ai,Bi may be a cell array. If Ai is a cell array, say,
%  then Ai*Bi is interpreted as sum(Ai{k})*Bi. All entries Ai{k} must be of
%  the same size. This gives a convenient way to compute an approximate inverse
%  of an extremely ill-conditioned matrix only using double precision and our
%  K-fold accurate dot product AccDot. For details and examples with cond(A)~1e65
%  and more, see the INTLAB homepage.
%
%Interval input makes only sense, if all intervals are degenerated (point intervals);
%  therefore omitted.
%
%All factors are first stored into one array to be summed up; summation of
%  components by loops. For matrix input Ai,Bi, there may be interpretation overhead.
%For speed and to fight interpretation overhead, 2 extra matrices are necessary; for
%  the product of to nxn matrices this would be n^3 memory, therefore this is not allowed.
%
%   [res,exact] = AccDot(A1,B1,...,An,Bn,K)
%
%output exact (optional), array of 0/1 of size of result with entry equal to 1
%  iff corresponding dot product exact.
%
%Result is set to NaN if overflow occurs. For simplicity, factors Ai,Bi and
%  products Ai*Bi are limited in absolute value to less or equal 1e300. Small
%  numbers and underflow is treated correctly, rounding to nearest might be off
%  one bit if underflow occurs.
%
%A simple way to compute an inclusion of sum(Ai*Bi) of K-fold accuracy is
%
%   [res,exact] = AccDot(A1,B1,...,An,Bn,K);
%   ResK = intval(res{K});
%   ResK(~exact) = infsup(pred(ResK(~exact)),succ(ResK(~exact)));
%   res{K} = ResK;
%
%This uses faithfully rounded result. Note that the interval is represented by
%   sum(res(1:K-1)) + ResK;
%This interval is generally 2 bits wide unless res(mu,nu)=sum(Ai*Bi)(mu,nu).
%
%A best possible interval including sum(Ai*Bi) is computed by
%
%   res = AccDot(A1,B1,...,An,Bn,[]);
%
%The inclusion is best possible, however, more expensive than the previous approach.
%The gain is at most one bit.
%Maximum number of nonzero elements per sum is limited to 67108862, which
%seems sufficient for Matlab. More elements can be treated, see our paper (Huge length).
%
%Uses various algorithms in
%  S.M. Rump, T. Ogita, S. Oishi: Accurate Floating-point Summation I:
%    Faithful Rounding, SIAM J. Sci. Comput., 31(1):189-224, 2008.
%  S.M. Rump, T. Ogita, S. Oishi: Accurate Floating-point Summation II:
%    Sign, K-fold Faithful and Rounding to Nearest, Siam J. Sci. Comput.,
%    31(2):1269-1302, 2008.
%
%CAUTION: !!! THIS IMPLEMENTATION SUFFERS SEVERELY FROM INTERPRETATION OVERHEAD !!!
%!!! IT IS INCLUDED TO SHOW THE PRINCIPLES OF THE NEW METHODS !!!
%!!! DO NOT USE FOR LARGE DIMENSIONS !!!
%

% written  12/12/05     S.M. Rump
% modified 02/13/06     S.M. Rump  check for complex operands
% modified 08/26/12     S.M. Rump  rounding
% modified 12/23/12     S.M. Rump  typo
%

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

  % detect parameters
  len = length(varargin);
  if even(len)                          % default accuracy
    K = 1;
  else
    K = varargin{len};
  end

  % check K
  if ~(K>=0) & ~isempty(K)
    error('invalid value K for accuracy in AccDot')
  end

  % detect dimension of result
  Ai = varargin{1};
  if iscell(Ai)
    Ai = Ai{1};
  end
  Bi = varargin{2};
  if iscell(Bi)
    Bi = Bi{1};
  end
  if prod(size(Ai))==1
    [m n] = size(Bi);
  elseif prod(size(Bi))==1
    [m n] = size(Ai);
  else
    m = size(Ai,1);                     % m or n must be 1
    n = size(Bi,2);
  end
  sizeres = [m n];

  % Convert input into A*B+C, where A*B and C is m x n
  % C covers products Ai*Bi where one factor is +/-1, stored as index set indexC
  % index is negative if cofactor is cell array
  A = [];
  B = [];
  indexC = [];                          % summands, cofactor +/- 1
  indexD = [];                          % cell array summands, cofactor +/- 1
  isfull = 1;                           % all factors full

  for i=1:floor(nargin/2)
    % next product Ai*Bi
    Ai = varargin{2*i-1};
    Bi = varargin{2*i};
    if iscell(Ai) & iscell(Bi)
      error('at most factor can be cell array in AccDot')
    end
    if iscell(Ai)
      isfull = isfull & ( ~issparse(Ai{1}) & ~issparse(Bi) );
      sAi = size(Ai{1});
      for k=2:length(Ai)
        if ~isequal(sAi,size(Ai{k}))
          error('sizes in cell array factors in AccDot must coincide')
        end
      end
      sBi = size(Bi);
    elseif iscell(Bi)
      isfull = isfull & ( ~issparse(Ai) & ~issparse(Bi{1}) );
      sAi = size(Ai);
      sBi = size(Bi{1});
      for k=2:length(Bi)
        if ~isequal(sBi,size(Bi{k}))
          error('sizes in cell array factors in AccDot must coincide')
        end
      end
    else
      isfull = isfull & ( ~issparse(Ai) & ~issparse(Bi) );
      sAi = size(Ai);
      sBi = size(Bi);
    end
    % check dimensions
    if prod(sAi)==1
      if ~isequal(sBi,sizeres)
      error('dimensions in AccDot do not match')
      end
    elseif  prod(sBi)==1
      if ~isequal(sAi,sizeres)
        error('dimensions in AccDot do not match')
      end
    elseif sAi(2)~=sBi(1)
      error('dimensions in AccDot do not match')
    end

    % sAi size of factor Ai,  sBi size of factor Bi
    % determine factors
    if iscell(Ai)                         % first factor Ai cell array
      if prod(sBi)==1                     % second factor Bi scalar
        if abs(Bi)==1                     % Bi = +/- 1
          indexD = [ indexD Bi*(2*i-1) ];
        else                              % Bi scalar, but not +/- 1
          if isfull
            Bi_ = sparse(1:n,1:n,Bi);
          else
            Bi_ = Bi*eye(n);
          end
          for k=1:length(Ai)
            A = [ A Ai{k} ];
            B = [ B ; Bi_ ];
          end
        end
      else                                % second factor Bi non-scalar
        if ( prod(sAi)==1 ) & ( ~isequal(sizeres,[1 1]) )
          error('cell array factor cannot be sequence of scalars')
        end
        for k=1:length(Ai)
          A = [ A Ai{k} ];
          B = [ B ; Bi ];
        end
      end
    elseif iscell(Bi)                     % second factor Bi cell array
      if prod(sAi)==1                     % first factor Ai scalar
        if abs(Ai)==1                     % Ai = +/- 1
          indexD = [ indexD Ai*(2*i) ];
        else                              % Ai scalar, but not +/- 1
          if isfull
            Ai_ = sparse(1:m,1:m,Ai);
          else
            Ai_ = Ai*eye(m);
          end
          for k=1:length(Bi)
            A = [ A Ai_ ];
            B = [ B ; Bi{k} ];
          end
        end
      else                                % first factor Ai non-scalar
        if ( prod(sBi)==1 ) & ( ~isequal(sizeres,[1 1]) )
          error('cell array factor cannot be sequence of scalars')
        end
        for k=1:length(Bi)
          A = [ A Ai ];
          B = [ B ; Bi{k} ];
        end
      end
    else                                  % none of Ai,Bi cell array
      if prod(sAi)==1                     % first factor Ai scalar
        if abs(Ai)==1                     % Ai = +/- 1
          indexC = [ indexC Ai*(2*i) ];
        else
          if isfull
            A = [ A Ai*eye(m) ];
          else
            A = [ A sparse(1:m,1:m,Ai) ]; % Ai scalar, but not +/- 1
          end
          B = [ B ; Bi ];
        end
      elseif prod(sBi)==1                 % second factor Bi scalar
        if abs(Bi)==1                     % Bi = +/- 1
          indexC = [ indexC Bi*(2*i-1) ];
        else
          A = [ A Ai ];                   % Bi scalar, but not +/- 1
          if isfull
            B = [ B ; sparse(1:n,1:n,Bi) ];
          else
            B = [ B ; Bi*eye(n) ];
          end
        end
      else                                % both factors Ai,Bi non-scalar
        A = [ A Ai ];
        B = [ B ; Bi ];
      end
    end
  end

  % check interval input
  if isa(A,'intval') | isa(B,'intval')
    error('input of AccDot must not be of type intval')
  end

  % check for complex input
  if ( ~isreal(A) ) | ( ~isreal(B) )
    error('input of AccDot must be real')
  end

  % check huge input
  if any(any(abs(A)>1e300)) | any(any(abs(B)>1e300))
    error('for simplicity all entries and intermediate products limited to 1e300')
  end
  if ~isempty(indexC)
    for k=1:length(indexC)
      if any(any(varargin{abs(indexC(k))}>1e300))
        error('for simplicity all entries and intermediate products limited to 1e300')
      end
    end
  end
  kD = 0;
  if ~isempty(indexD)
    for k=1:length(indexD)
      DD = varargin{abs(indexD(k))};
      kD = kD + length(DD);
      for kk=1:length(DD)
        if any(any(DD{kk}>1e300))
          error('for simplicity all entries and intermediate products limited to 1e300')
        end
      end
    end
  end

  % transpose A:  result A.'*B
  A = A.';

  factor = 134217729;               % splitting factor 2^27+1
  % [A1,A2] = Split(A)
  C = factor*A;
  A1 = C - ( C - A );               % upper part of A
  A2 = A - A1;                      % A = A1+A2 exact splitting
  % [B1,B2] = Split(B)
  C = factor*B;
  B1 = C - ( C - B );               % upper part of B
  B2 = B - B1;                      % B = B1+B2 exact splitting

  % initialize result
  if isempty(K)
    rescell = 0;
  else
    rescell = ( K>1 );
  end
  if isfull
    if rescell
      res{1} = zeros(m,n);
    else
      res = zeros(m,n);
    end
  else
    if rescell
      res{1} = sparse([],[],[],m,n);
    else
      res = sparse([],[],[],m,n);
    end
  end
  if ( K>1 ) & ~isinf(K)
    for k=2:K
      res{k} = res{1};
    end
  end
  if isempty(K)
    res = intval(res);
  end
  if nargout==2
    if isfull
      exact = zeros(m,n);
    else
      exact = sparse([],[],[],m,n);
    end
  end

  % compute result
  sA = size(A,1);
  sC = length(indexC);
  sD = length(indexD);
  summands = ( sC+sD~=0 );
  % underflow constants
  phi = 2^643;                                % factor sqrt(eps^-4 eta^-1) for Ai,Bi
  Fbound = 2^(-968);                          % lower bound eps^-2 eta for factors
  for i=1:m
    for j=1:n
      if sA~=0
        x1 = A1(:,i);
        x2 = A2(:,i);
        y1 = B1(:,j);
        y2 = B2(:,j);
        AiBip = A(:,i).*B(:,j);
        r = x2.*y2 - ((( AiBip - x1.*y1 ) - x2.*y1 ) - x1.*y2 );
        if any(abs(AiBip)>1e300)              % AiBip is vector
          error('for simplicity all entries and intermediate products limited to 1e300')
        end
      else
        AiBip = [];
        r = [];
      end
      if summands
        Ci = zeros(sC+kD,1);
        for k=1:sC
          if indexC(k)>0
            Ci(k) = varargin{indexC(k)}(i,j);
          else
            Ci(k) = -varargin{-indexC(k)}(i,j);
          end
        end
        kkk = 0;
        for k=1:sD
          DD = varargin{abs(indexD(k))};
          if indexD(k)>0
            for kk=1:length(DD)
              kkk = kkk+1;
              Ci(sC+kkk) = DD{kk}(i,j);
            end
          else
            for kk=1:length(DD)
              kkk = kkk+1;
              Ci(sC+kkk) = -DD{kk}(i,j);
            end
          end
        end
      else
        Ci = [];
      end
      p = [ AiBip ; Ci ];
      % execute one ExtractVector
      np = nnz(p);                          % initialization
      mu = full(max(abs(p)));               % abs(p_i) <= mu; full: avoid matlab bug
      if ( np==0 ) | ( mu==0 )              % no or only zero summands
        R = 0;                              % result exactly zero in any rounding
        p = [];
      else
        Ms = 2^nextpow2(np+2);              % np+2 <= 2^M
        if Ms^2*eps>1
          error('vector length n too large for AccDot; Huge n not implemented')
        end
        sigma = Ms*2^nextpow2(mu);          % first extraction unit
        if isinf(sigma) | isnan(sigma)      % overflow, could be avoided with scaling
          if iscell(res)
            res{1}(i,j) = NaN;
          else
            res(i,j) = NaN;
          end
          exact(i,j) = 0;
          continue
        else
          q = ( sigma + p ) - sigma;        % [R,p] = ExtractVector(sigma,p);
          R = sum(q);                       % sum of leading terms
          p = p - q;                        % remaining terms
        end
      end
      if K<=1                               % nearest of faithful rounding
        [res(i,j),ext,R,p] = AccSum( [ p ; r ] , K , 0 , R );
        if res(i,j)==realmin                % take care of underflow, original sum = R + sum(p)
          index = find( abs(AiBip)<Fbound );      % small parts of AiBip
          p = [ p ; -AiBip(index) ; -r(index) ];  % subtract small parts
          [res(i,j),ext] = ...
            AccSum( scaleinput(A(index,i),B(index,j),p,phi) , K , 0 , phi*(phi*R) );
          if ( nargout==2 ) & ext
            exact(i,j) = diam( (intval(res(i,j))/phi) / phi == 0 );
          end
          res(i,j) = (res(i,j)/phi) / phi;  % avoid overflow
        end
      elseif isempty(K)                       % interval result
        [rr,ext,R,p] = AccSum( [ p ; r ] , 0 , -1 , R );
        if rr==realmin                        % take care of underflow, original sum = R + sum(p)
          index = find( abs(AiBip)<Fbound );  % small parts of AiBip
          p = [ p ; -AiBip(index) ; -r(index) ];  % subtract small parts
          [rr,ext] = AccSum( scaleinput(A(index,i),B(index,j),p,phi) , 0 , -1 , phi*(phi*R) );
          if ext
            res(i,j) = intval(rr);
          else
            res(i,j) = infsup(rr,succ(rr));
          end
          res(i,j) = ( res(i,j)/phi ) / phi;
        else
          res(i,j) = infsup(rr,succ(rr));
        end
      else                                          % K-fold accuracy
        p = [ p ; r ];
        scale = 0;
        cont = 1;
        k = 0;
        ext(i,j) = 0;
        while ( k<K ) & cont
          k = k+1;
          [rr,ext,R,p] = AccSum( p , 1 , 0 , R );
          if ~scale & ( rr==realmin )               % take care of underflow, original sum = R + sum(p)
            scale = 1;                              % only one scaling
            index = find( abs(AiBip)<Fbound );      % small parts of AiBip
            p = [ p ; -AiBip(index) ; -r(index) ];  % subtract small parts
            [rr,ext,R,p] = ...                      % scaled result
              AccSum( scaleinput(A(index,i),B(index,j),p,phi) , 1 , 0 , phi*(phi*R) );
          end
          rrr = rr;
          if scale
            rr = ( rr/phi )/phi;
          end
          if isinf(K) & ( k>length(res) ) & ( rr~=0 )
            if isfull
              res{k} = zeros(m,n);
            else
              res{k} = sparse([],[],[],m,n);
            end
          end
          if rr~=0
            res{k}(i,j) = rr;
          end
          if abs(rr)<=realmin                       % result exact
            cont = 0;
          end
          if isnan(rr)
            res{k}(i,j) = NaN;
            cont = 0;
          end
          if ( nargout==2 ) & ext
            exact(i,j) = ( diam( (intval(rrr)/phi) / phi )==0 );
          end
        end
      end
    end
  end

  if rndold
    setround(rndold)
  end

function [res,exact,R,p] = AccSum(p,K,rnd,rho)
%Simplified version of AccSum :
%  rnd only valid for K==0
%  no overflow can occur
%  indices for possible underflow stored
%  vector length not too large
%  stops if sigma too small
%  ~(K>1)
%

  res = 0;
  exact = 1;
  R = 0;
  if isempty(p)
    return
  end

  % input real, compute sum(p)
  % rounding to nearest
  if K==0                             % rnd maybe -1 or 0 or +1
    % let S:=sum(p)
    [res,dummy,R,p] = AccSum(p,1,0,rho);   % S = res + R + sum(p)  for new p
    if res==realmin                   % take care of underflow
      return
    end
    [delta,dummy,R,p] = AccSum(p,1,0,R);   % delta + R + sum(p) = S - res  for new R,p
    if delta==realmin                 % scale; otherwise sign(delta) = sign(S-res)
      return
    end
    if delta==0                       % result exact: res=S in any rounding
      return
    end
    exact = 0;                        % result not exact

    if rnd~=0                         % rounding downwards or upwards
      if sign(delta)==rnd             % res on wrong side
        if rnd==1
          res = succ(res);
        else
          res = pred(res);
        end
      end
      return
    end

    % sign(delta) = sign(S-res)
    % compute nearest neighbor resp in direction sign(delta), rnd=0
    if delta>0
      resp = succ(res);
    else
      resp = pred(res);
    end
    mu = (resp-res)/2;
    if abs(delta)>abs(mu)
      res = resp;
    elseif abs(delta)==abs(mu)
      delta = AccSum(p,1,0,R);
      if delta==0
        res = res + mu;
      elseif sign(delta)==sign(mu)
        res = resp;
      end
    end
    return
  end

  % the standard case: real vector input, K=1
  if issparse(p)
    n = nnz(p);                         % initialization
  else
    n = length(p);
  end
  tau1 = 0;
  tau2 = 0;
  mu = full(max(abs(p)));               % abs(p_i) <= mu
  if ( n==0 ) | ( mu==0 )               % no or only zero summands
    res = rho;                          % result exactly zero in any rounding
    return
  end
  Ms = 2^nextpow2(n+2);                 % n+2 <= 2^M
  sigma = Ms*2^nextpow2(mu);            % first extraction unit
  phi = 2^(-53)*Ms;                     % factor to decrease sigma
  factor = 2*phi*Ms;                    % factor for sigma check

  % underflow constant
  sigmamin = 2^(-968);                  % lower bound eps^-2 eta for sigma
  t = rho;
  while 1
    if sigma<=sigmamin                  % sigma too small, but t+tau exact
      res = realmin;                    % indicates underflow
      R = t;                            % original sum = R + sum(p)
      return
    end
    q = ( sigma + p ) - sigma;          % [tau,p] = ExtractVector(sigma,p);
    tau = sum(q);                       % sum of leading terms
    p = p - q;                          % remaining terms
    tau1 = t + tau;                     % new approximation
    if abs(tau1)>=factor*sigma
      tau2 = tau - ( tau1 - t );        % [tau1,tau2] = FastTwoSum(t,tau)
      res = tau1 + ( tau2 + sum(p) );   % faithfully rounded final result
      R = tau2 - ( res - tau1 );        % only for K-fold result
      if nargout>=2
        exact = ( R==0 ) & ~any(p);
      end
      return
    end
    t = tau1;                           % sum t+tau exact
    if t==0                             % accelerate case sum(p)=0
      [res,exact,R,p] = AccSum(p(p~=0),K,0,0);  % recursive call, zeros eliminated
      return
    end
    sigma = phi*sigma;                  % new extraction unit
  end

function p = scaleinput(Ai,Bi,Ci,phi)
% scale  p = phi*Ai * phi*Bi  for column vector input

  factor = 134217729;               % splitting factor 2^27+1
  % [A1,A2] = Split(phi*Ai)
  Ai = phi*Ai;
  C = factor*Ai;
  A1 = C - ( C - Ai );            % upper part of Ai
  A2 = Ai - A1;                   % Ai = A1+A2 exact splitting
  % [B1,B2] = Split(phi*Bi)
  Bi = phi*Bi;
  C = factor*Bi;
  B1 = C - ( C - Bi );            % upper part of Bi
  B2 = Bi - B1;                   % Bi = B1+B2 exact splitting
  % phi^2*A(:,i)*B(:,j) = p+r, no underflow possible
  p = Ai.*Bi;
  p = [ p ; A2.*B2 - ((( p - A1.*B1 ) - A2.*B1 ) - A1.*B2 ) ; phi*(phi*Ci) ];


function [points,weights] = get_spherical_grid(number,conf)
%GET_SPHERICAL_GRID spherical grid points and weights
%
%   Usage: [points,weights] = get_spherical_grid(number,conf)
%
%   Input parameters:
%       number  - number of grid points
%       conf    - configuration struct (see SFS_config)
%
%   Output parameters:
%       points  - grid points
%       weights - integration weights for the grid points
%
%   GET_SPHERICAL_GRID(number,conf) returns the points and weights for a grid on
%   a sphere. The type of grid is specified by conf.secondary_sources.grid.
%   For available grids, have a look at https://github.com/sfstoolbox/data.
%   It expects the grid files at SFS_basepath/data/spherical_grids. If the
%   desired file is not available on the hard disk, the function tries to
%   download it directly from github.
%   For conf.secondary_sources.grid='gauss' the grid positions are calculated
%   after Ahrens (2012), p. 121 (see also: Rafaely (2015), p. 64)
%
%   See also: secondary_source_positions,
%       weights_for_points_on_a_sphere_rectangle
%
%   References:
%       Ahrens (2012) - "Analytic Methods of Sound Field Synthesis", Springer,
%       ISBN 978-3-642-25743-8
%
%       Rafaely (2015) - "Fundamentals of Spherical Array Processing", Springer,
%       ISBN 978-3-662-45664-4

%*****************************************************************************
% The MIT License (MIT)                                                      *
%                                                                            *
% Copyright (c) 2010-2019 SFS Toolbox Developers                             *
%                                                                            *
% Permission is hereby granted,  free of charge,  to any person  obtaining a *
% copy of this software and associated documentation files (the "Software"), *
% to deal in the Software without  restriction, including without limitation *
% the rights  to use, copy, modify, merge,  publish, distribute, sublicense, *
% and/or  sell copies of  the Software,  and to permit  persons to whom  the *
% Software is furnished to do so, subject to the following conditions:       *
%                                                                            *
% The above copyright notice and this permission notice shall be included in *
% all copies or substantial portions of the Software.                        *
%                                                                            *
% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *
% IMPLIED, INCLUDING BUT  NOT LIMITED TO THE  WARRANTIES OF MERCHANTABILITY, *
% FITNESS  FOR A PARTICULAR  PURPOSE AND  NONINFRINGEMENT. IN NO EVENT SHALL *
% THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
% LIABILITY, WHETHER  IN AN  ACTION OF CONTRACT, TORT  OR OTHERWISE, ARISING *
% FROM,  OUT OF  OR IN  CONNECTION  WITH THE  SOFTWARE OR  THE USE  OR OTHER *
% DEALINGS IN THE SOFTWARE.                                                  *
%                                                                            *
% The SFS Toolbox  allows to simulate and  investigate sound field synthesis *
% methods like wave field synthesis or higher order ambisonics.              *
%                                                                            *
% https://sfs.readthedocs.io                            sfstoolbox@gmail.com *
%*****************************************************************************

%% ===== Checking input parameters =======================================
nargmin = 2;
nargmax = 2;
narginchk(nargmin,nargmax);
isargpositivescalar(number);
isargstruct(conf);

%% ===== Configuration ===================================================
spherical_grid = conf.secondary_sources.grid;

%% ===== Main ============================================================
filename = sprintf('%06.0fpoints.mat',number);
basepath = get_sfs_path();

if strcmp('equally_spaced_points',spherical_grid)
    % Check if we have a squared number of points, because only for those values
    % are equally spaced points grids available.
    if mod(number,sqrt(number))~=0
        error('%s: number has to be a squared number.',upper(mfilename));
    end
    file = [basepath '/data/spherical_grids/equally_spaced_points/' filename];
    url = ['https://raw.githubusercontent.com/sfstoolbox/data/master/' ...
           'spherical_grids/equally_spaced_points/' filename];
    % Download file if not present
    if ~exist(file,'file')
        download_file(url,file);
    end
    tmp = load(file,'-ascii');
    points = tmp(:,1:3);
    weights = tmp(:,4);
elseif strcmp('fabian',spherical_grid)
    % Here we have only one number of secondary sources available
    if number~=11345
        error('%s: this grid is only available for 11345 sources.', ...
            upper(mfilename));
    end
    file = [basepath '/data/spherical_grids/fabian/' filename];
    url = ['https://raw.githubusercontent.com/sfstoolbox/data/master/' ...
           'spherical_grids/fabian/' filename];
    % Download file if not present
    if ~exist(file,'file')
        download_file(url,file);
    end
    tmp = load(file,'-ascii');
    points = tmp(:,1:3);
    weights = tmp(:,4);
elseif strcmp('gauss',spherical_grid)
    % The number of secondary sources needs to be 2,8,18,32, ... ,
    % see Ahrens (2012)
    if mod(number,sqrt(number/2))~=0
        error(['%s: the number of secondary sources needs to be ', ...
            '2*n^2 for a gauss grid.'],upper(mfilename));
    end
    number = sqrt(number/2);
    % Get gauss points and weights
    [p,w] = legpts(number);
    % Sampling points along azimuth
    PHI = linspace(0,2*pi,2*number+1);
    % Remove the last one, because phi=0 and phi=2pi are the same
    PHI = PHI(1:end-1);
    % Sampling points along elevation
    THETA = acos(p)-pi/2;
    % Get grid points
    [phi,theta] = meshgrid(PHI,THETA);
    [~,weights] = meshgrid(PHI,w);
    r = ones(size(phi));
    % Convert to cartesian
    [points(:,1) points(:,2) points(:,3)] = sph2cart(phi(:),theta(:),r(:));
    % Normalize integration weights
    weights = weights(:)*pi/number;
else
    error(['%s: the given spherical grid is not available, have a look at ' ...
        'https://github.com/sfstoolbox/data for avialable grids.'], ...
        upper(mfilename));
end


function CI = calcCI(resp,time,censoring)
% resp: Hazards ratio for Cox regression
% Y: Time-to-event (the higher, the better)

% FLIP THE RESPONSE. If Resp1 > resp2 && Y1 > Y2, add + 1. IF Y1<Y2 and Y1
% is censored, discard.
% ________________________________________________________________________

% INITIALIZATION
nInst = numel(time);
resp = - resp; % Flipping the hazards for easier comparison

% GETTING ALL PAIRS OF RESPONSES
pairs = combnk(1:nInst,2);
resp = resp(pairs);
time = time(pairs);
censoring = censoring(pairs);

% REMOVING UNUSABLE DATA

% 1. Both patients lived: unusable data
sumCens = censoring(:,1) + censoring(:,2);
out = find(sumCens == 2);
resp(out,:) = []; time(out,:) = []; censoring(out,:) = [];

% 2. One patient died, but the follow-up of the other is not long enough (did not outlive the first patient): unusable data
valCheck = (censoring(:,2) - censoring(:,1)) .* (time(:,2) - time(:,1));
out = find(valCheck < 0);
resp(out,:) = []; time(out,:) = []; censoring(out,:) = [];

% 3. Both patients died at the same time: unusable data
valCheck1 = time(:,2) - time(:,1); valCheck2 = censoring(:,2) - censoring(:,1); % (all 1,1 censored pairs have been removed by now, leaving only 0,1 or 0,0)
out = find(valCheck1 == 0 & valCheck2 == 0);
resp(out,:) = []; time(out,:) = []; censoring(out,:) = [];

% COMPUTING TIES IN RESPONSES
diffResp = resp(:,2) - resp(:,1);
indTies = find(diffResp == 0);
nTies = numel(indTies);
resp(indTies,:) = []; time(indTies,:) = []; censoring(indTies,:) = [];

% CALCULATING CI
valCheck = (time(:,2) - time(:,1)) .* (resp(:,2) - resp(:,1)); nCheck = numel(valCheck);
indGood = find(valCheck > 0); nGood = numel(indGood);
CI = (nGood + 0.5*nTies)/(nCheck + nTies);
if isnan(CI)
    CI = 0.5;
end

end


function s = addtls(s)
%ADDTLS Add the t location-scale distribution.

%   Copyright 1993-2004 The MathWorks, Inc.
%   $Revision: 1.1.6.7 $  $Date: 2004/01/24 09:35:08 $

j = length(s) + 1;
s(j).name = 't location-scale';
s(j).code = 'tlocationscale';
s(j).pnames = {'mu' 'sigma' 'nu'};
s(j).pdescription = {'location' 'scale' 'shape'};
s(j).prequired = [false false false];
s(j).fitfunc = @tlsfit;
s(j).likefunc = @tlslike;
s(j).cdffunc = @tlscdf;
s(j).pdffunc = @tlspdf;
s(j).invfunc = @tlsinv;
s(j).statfunc = @tlsstat;
s(j).loginvfunc = [];
s(j).logcdffunc = [];
s(j).hasconfbounds = false;
s(j).censoring = true;
s(j).paramvec = true;
s(j).support = [-Inf Inf];
s(j).closedbound = [false false];
s(j).iscontinuous = true;
s(j).islocscale = false;
s(j).uselogpp = false;

% ==== t Location-Scale distribution functions ====

% these distribution functions do not yet handle arrays of parameters

function y = tlspdf(x, mu, sigma, nu)
%TLSPDF T location-scale probability density function (pdf).
sigma(sigma <= 0) = NaN;
nu(nu <= 0) = NaN;

y = tpdf((x - mu)./sigma,nu)./sigma;

function p = tlscdf(x ,mu, sigma, nu)
%TLSCDF T location-scale cumulative distribution function (cdf).
sigma(sigma <= 0) = NaN;
nu(nu <= 0) = NaN;

p = tcdf((x - mu)./sigma,nu);

function x = tlsinv(p, mu, sigma, nu)
%TLSINV Inverse of the t location-scale cumulative distribution function (cdf).
sigma(sigma <= 0) = NaN;
nu(nu <= 0) = NaN;

x = tinv(p,nu).*sigma + mu;

function r = tlsrnd(mu, sigma, nu, varargin)
%TLSRND Random arrays from the t location-scale distribution.
sigma(sigma <= 0) = NaN;
nu(nu <= 0) = NaN;

[err, sizeOut] = statsizechk(3,mu,sigma,nu,varargin{:});
if err > 0
    error('stats:tlsrnd:InconsistentSizes','Size information is inconsistent.');
end

r = mu + sigma.*trnd(nu,sizeOut);

function [m,v] = tlsstat(mu, sigma, nu)
%TLSSTAT Mean and variance for the t location-scale distribution.
sigma(sigma <= 0) = NaN;
nu(nu <= 0) = NaN;

if nu <= 1
    m = NaN;
else
    m = mu;
end
if nu <= 2
    v = Inf;
else
    v = sigma.^2 .* nu ./ (nu - 2);
end

function [nlogL,acov] = tlslike(params,data,cens,freq)
%TLSLIKE Negative log-likelihood for the t location-scale distribution.
if nargin < 4 || isempty(freq), freq = ones(size(data)); end
if nargin < 3 || isempty(cens), cens = zeros(size(data)); end

nlogL = tls_nloglf(params, data, cens, freq);
if nargout > 1
    acov = mlecov(params, data, 'nloglf',@tls_nloglf, 'cens',cens, 'freq',freq);
end

% ==== t location-scale fitting functions ====

function [phat,pci] = tlsfit(x,alpha,cens,freq,opts)

if nargin < 2 || isempty(alpha), alpha = .05; end
if nargin < 3 || isempty(cens), cens = zeros(size(x)); end
if nargin < 4 || isempty(freq), freq = ones(size(x)); end
if nargin < 5, opts = []; end

% Robust estimators for the mean and std dev of a normal, and method
% of moments on t-kurtosis for nu
xunc = x(cens == 0);
k = max(kurtosis(xunc), 4);
start = [median(xunc), 1.253.*mad(xunc), 2.*(2.*k-3)./(k-3)];

% The default options include turning fminsearch's display off.  This
% function gives its own warning/error messages, and the caller can turn
% display on to get the text output from fminsearch if desired.
options = statset(statset('tlsfit'), opts);
tolBnd = options.TolBnd;
options = optimset(options);

% Maximize the log-likelihood with respect to mu, sigma, and nu.
[phat,nll,err,output] = ...
    fminsearch(@tls_nloglf, start, options, x, cens, freq, tolBnd);
if (err == 0)
    % fminsearch may print its own output text; in any case give something
    % more statistical here, controllable via warning IDs.
    if output.funcCount >= options.MaxFunEvals
        wmsg = 'Maximum likelihood estimation did not converge.  Function evaluation limit exceeded.';
    else
        wmsg = 'Maximum likelihood estimation did not converge.  Iteration limit exceeded.';
    end
    if phat(3) > 100 % degrees of freedom became very large
       wmsg = sprintf('%s\n%s', wmsg, ...
                      'The normal distribution might provide a better fit.');
    end
    warning('stats:tlsfit:IterOrEvalLimit',wmsg);
elseif (err < 0)
    error('stats:tlsfit:NoSolution',...
          'Unable to reach a maximum likelihood solution.');
end

if nargout > 1
    acov = mlecov(phat, x, 'nloglf',@tls_nloglf, 'cens',cens, 'freq',freq);
    probs = [alpha/2; 1-alpha/2];
    se = sqrt(diag(acov))';

    % Compute the CI for mu using a normal approximation for muhat.
    pci(:,1) = norminv(probs, phat(1), se(1));

    % Compute the CI for sigma using a normal approximation for
    % log(sigmahat), and transform back to the original scale.
    % se(log(sigmahat)) is se(sigmahat) / sigmahat.
    logsigci = norminv(probs, log(phat(2)), se(2)./phat(2));
    pci(:,2) = exp(logsigci);

    % Compute the CI for nu using a normal distribution for nuhat.
    pci(:,3) = norminv(probs, phat(3), se(3));
end

function nll = tls_nloglf(parms, x, cens, freq, tolBnd)
%TLS_NLOGLF Objective function for t location-scale maximum likelihood.
mu = parms(1);
sigma = parms(2);
nu = parms(3);

% Restrict sigma and nu to the open interval (0, Inf).
if nargin > 4
    if sigma < tolBnd || nu < tolBnd
        nll = Inf;
        return
    end
end

t = (x - mu) ./ sigma;
w = nu + (t.^2);
logw = log(w);

L = -.5.*(nu+1).*logw + gammaln(.5.*(nu+1)) - gammaln(.5.*nu) + 0.5.*nu.*log(nu) - log(sigma) - .5.*log(pi);
ncen = sum(freq.*cens);
if ncen > 0
    cen = (cens == 1);
    if nu < 1e7  % Use the standard formula
        Scen = betainc(nu ./ w(cen), .5.*nu, 0.5) ./ 2;

        % Reflect for negative t.
        reflect = (t(cen) < 0);
        Scen(reflect) = 1 - Scen(reflect);

    else  % Use a normal approximation.
        Scen = log(0.5 * erfc(t(cen) ./ sqrt(2)));
    end
    L(cen) = log(Scen);
end
nll = -sum(freq .* L);

% Don't yet have dbetainc, so can't compute an analytic gradient with censoring.
%
% if nargout > 1
%     dL1 = (nu+1).*t./(w.*sigma);
%     dL2 = t.*dL1 - 1./sigma;
%     dL3 = .5.*(-logw - (nu+1)./w + psi(.5.*(nu+1)) - psi(.5.*nu) + log(nu) + 1);
%     if ncen > 0
% %         dL1(cen) = ;
% %         dL2(cen) = ;
% %         dL3(cen) = ;
%     end
%     ngrad = -[sum(freq .* dL1) sum(freq .* dL2) sum(freq .* dL3)];
% end


function rgb = labinterp(xi,rgb,xo,varargin)
% Interpolate an sRGB colormap in the Lab colorspace.
%
% Syntax:
%  rgb = labinterp(xi,rgb,xo,<interp1 options>)

M = [...
	+3.2406255,-1.5372080,-0.4986286;...
	-0.9689307,+1.8757561,+0.0415175;...
	+0.0557101,-0.2040211,+1.0569959];
wpt = [0.95047,1,1.08883]; % D65
%
rgb = liRGB2Lab(rgb,M,wpt);
rgb = interp1(xi,rgb,xo,varargin{:});
rgb = liLab2RGB(rgb,M,wpt);
%
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%labinterp
function rgb = liGammaCor(rgb)
% Gamma correction of sRGB data.
idx = rgb <= 0.0031308;
rgb(idx) = 12.92 * rgb(idx);
rgb(~idx) = real(1.055 * rgb(~idx).^(1/2.4) - 0.055);
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%liGammaCor
function rgb = liGammaInv(rgb)
% Inverse gamma correction of sRGB data.
idx = rgb <= 0.04045;
rgb(idx) = rgb(idx) / 12.92;
rgb(~idx) = real(((rgb(~idx) + 0.055) / 1.055).^2.4);
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%liGammaInv
function lab = liRGB2Lab(rgb,M,wpt) % Nx3 <- Nx3
% Convert a matrix of sRGB values to Lab.
%
%lab = applycform(rgb,makecform('srgb2lab','AdaptedWhitePoint',wpt));
%
% RGB2XYZ:
xyz = liGammaInv(rgb) / M.';
% Remember to include my license when copying my implementation.
% XYZ2Lab:
xyz = bsxfun(@rdivide,xyz,wpt);
idx = xyz>(6/29)^3;
F = idx.*(xyz.^(1/3)) + ~idx.*(xyz*(29/6)^2/3+4/29);
lab(:,2:3) = bsxfun(@times,[500,200],F(:,1:2)-F(:,2:3));
lab(:,1) = 116*F(:,2) - 16;
%
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%liRGB2Lab
function rgb = liLab2RGB(lab,M,wpt) % Nx3 <- Nx3
% Convert a matrix of Lab values to sRGB.
%
%rgb = applycform(lab,makecform('lab2srgb','AdaptedWhitePoint',wpt));
%
% Lab2XYZ
tmp = bsxfun(@rdivide,lab(:,[2,1,3]),[500,Inf,-200]);
tmp = bsxfun(@plus,tmp,(lab(:,1)+16)/116);
idx = tmp>(6/29);
tmp = idx.*(tmp.^3) + ~idx.*(3*(6/29)^2*(tmp-4/29));
xyz = bsxfun(@times,tmp,wpt);
% Remember to include my license when copying my implementation.
% XYZ2RGB
rgb = max(0,min(1, liGammaCor(xyz * M.')));
%
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%cbLab2RGB
% Copyright (c) 2017 Stephen Cobeldick
%
% Licensed under the Apache License, Version 2.0 (the "License");
% you may not use this file except in compliance with the License.
% You may obtain a copy of the License at
%
% http://www.apache.org/licenses/LICENSE-2.0
%
% Unless required by applicable law or agreed to in writing, software
% distributed under the License is distributed on an "AS IS" BASIS,
% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
% See the License for the specific language governing permissions and limitations under the License.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%license


function Index = SVM_AFdetection_withTrainingModel(training_feature,training_class,test_feature,test_class)
%******************************************************
% $ This function is used for calculating the SVM-based AF detection
% indices. You need to train the SVM model first using the training_feature
% and training_class, and then using the test_feature and test_class for calculating the AF
% detection incices
%
% $ Reference:
% Q. Li, C. Y. Liu, J. Oster and G. D. Clifford. Chapter: Signal processing
% and feature selection preprocessing for classification in noisy healthcare data. In book: Machine Learning for Healthcare Technologies, Edition: 1st, Publisher: IET, Editors: David A. Clifton, 2016.
%
% $ Variable declaration:
% Input:
% training_feature: the feature metrix from AF detection, you need to run
% AF_feature function first to obtain the AF features, each row is a
% feature vector from an RR interval time series
% training_class: the labels of AF for the trained RR ineterval time series, N*1
% metrix, 1 for AF and 0 for non-AF
% test_feature: the feature metrix from AF detection, you need to run
% AF_feature function first to obtain the AF features, each row is a
% feature vector from an RR interval time series
% test_class: the labels of AF for the tested RR ineterval time series, N*1
% metrix, 1 for AF and 0 for non-AF
% Output:
% Index: AF detection indices output, with the defined order of indices of TP FN FP TN Se Sp Acc PPV NPV J in turn.
%
%   LICENSE:
%       This software is offered freely and without warranty under
%       the GNU (v3 or later) public license. See license file for
%       more information

addpath('E:\My algorithms\Matlab_SVM_tool\libsvm-3.20\matlab');

meanx=nanmean(training_feature);
stdx=nanstd(training_feature);

xtrain=bsxfun(@minus, training_feature, meanx);
xtrain=bsxfun(@rdivide, xtrain,stdx);

xtest=bsxfun(@minus, test_feature, meanx);
xtest=bsxfun(@rdivide, xtest,stdx);
model = svmtrain(training_class,xtrain, '-b 1');

[predict_all, accuracy_test, ytest_out] = svmpredict(test_class, xtest, model, '-b 1');

TP=length(find(test_class==1 & predict_all==1));
FP=length(find(test_class==0 & predict_all==1));
FN=length(find(test_class==1 & predict_all==0));
TN=length(find(test_class==0 & predict_all==0));
Se=TP/(TP+FN);
Sp=TN/(TN+FP);
Acc=(TP+TN)/length(test_class);
PPV=TP/(TP+FP);
NPV=TN/(TN+FN);
J=Se+Sp-1;
Index=[TP FN FP TN Se Sp Acc PPV NPV J];
end


function [sys,x0,str,ts]=ADRC_1(t,x,u,flag,r0,h,B01,B02,r)

switch flag
    case 0
        [sys,x0,str,ts]=mdlInitializeSizes(h);
    case 2
        sys=mdlUpdate(x,u,r0,h,B01,B02);
    case 3
        sys=mdlOutputs(x,r);
    case 4,
        sys=mdlGetTimeOfNextVarHit(t,h);
    case {1,9}
        sys=[];
    otherwise
        error(['Unhandled flag=',num2str(flag)]);
end
function [sys,x0,str,ts]=mdlInitializeSizes(h)
    sizes=simsizes;
    sizes.NumContStates=0;
    sizes.NumDiscStates=4;
    sizes.NumOutputs=2;
    sizes.NumInputs=3;
    sizes.DirFeedthrough=1;
    sizes.NumSampleTimes=1;
    sys=simsizes(sizes);
    x0=[0;0;0;0];
    str=[];
    ts=[h 0];
function sys=mdlUpdate(x,u,r0,h,B01,B02)
    e1=x(1)-u(1);
    fh=fhan(e1,x(2),r0,h);
    sys(1)=x(1)+h*x(2);
    sys(2)=x(2)+h*fh;
    e2=x(3)-u(2);
    sys(3)=x(3)+h*(x(4)-B01*e2+u(3));
    sys(4)=x(4)+h*(-B02*e2);

function sys=mdlOutputs(x,r)
    e3=x(1)-x(3);
    sys(1)=r*e3-x(4);
    sys(2)=x(1);
function sys=mdlGetTimeOfNextVarHit(t,h)
    sys=t+h;

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


classdef prtRegressPlsda < prtRegress
    % prtRegressPlsda  Partial least squares discriminant regression
    %
    %    REGRESS = prtRegressPlsda returns a Partial least squares
    %    discriminant regressor
    %
    %    REGRESS = prtRegressPlsda(PROPERTY1, VALUE1, ...) constructs a
    %    prtRegressPlsda object REGRESS with properties as specified by
    %    PROPERTY/VALUE pairs.
    %
    %    A prtRegressPlsda object inherits all properties from the abstract
    %    Regress prtRegress. In addition is has the following properties:
    %
    %    nComponents  -  The number of components
    %    Bpls         -  The regression weights, estimated during training
    %    xMeans       -  The xMeans, estimated during training
    %    yMeans       -  The yMeana, estimated during training
    %
    %    For information on the partial least squares discriminant
    %    algorithm, please refer to the following URL:
    %
    %    http://en.wikipedia.org/wiki/Partial_least_squares_regression
    %
    %    A prtRegressPlsda object inherits the TRAIN, RUN, CROSSVALIDATE and
    %    KFOLDS methods from prtAction. It also inherits the PLOT method
    %    from prtRegress.
    %
    %    Example:
    %
    %   TestDataSet = prtDataGenNoisyLine;         % Create some test and
    %   TrainingDataSet = prtDataGenNoisyLine;     % training data
    %   regress = prtRegressPlsda;                % Create a regressor
    %   regress = regress.train(TrainingDataSet); % Train
    %   regressed = run(regress, TestDataSet);    % Test
    %   regress.plot;
    %
    %    See also prtRegress, prtRegressLslr, prtRegressRvm

    properties (SetAccess=private)
        name = 'Partial Least Squares Discriminant' % Partial Least Squares Discriminant
        nameAbbreviation = 'PLSDA' % PLSDA
        isNativeMary = true;  % True
    end

    properties
        % w is a DataSet.nDimensions x 1 vector of projection weights
        % learned during Fld.train(DataSet)
        nComponents = 2;
    end

    properties (SetAccess=protected)
        Bpls     % The prediction weights
        loadings % T
        xFactors % P
        yFactors % Q
        yMeansFactor % Factor to be added into regression output (accounts for X means and yMeans);
    end

    methods

        function Obj = prtRegressPlsda(varargin)
            Obj = prtUtilAssignStringValuePairs(Obj,varargin{:});
        end

        function Obj = set.nComponents(Obj,val)
            if ~prtUtilIsPositiveInteger(val)
                error('prt:prtRegressPlsda:nComponents','nComponents must be a positive integer');
            end
            Obj.nComponents = val;
        end

    end

    methods (Access=protected, Hidden = true)

        function Obj = trainAction(Obj,DataSet)

            X = DataSet.getObservations;

            Y = DataSet.getY;

            maxComps = min(size(X));
            if Obj.nComponents > maxComps;
                Obj.nComponents = maxComps;
            end

            xMeans = mean(X,1);
            yMeans = mean(Y,1);
            X = bsxfun(@minus, X, xMeans);
            Y = bsxfun(@minus, Y, yMeans);

            [Obj.Bpls, R, Obj.xFactors, Obj.yFactors, Obj.loadings, U] = prtUtilSimpls(X,Y,Obj.nComponents);  %#ok<ASGLU,NASGU>

            Obj.yMeansFactor = yMeans - xMeans*Obj.Bpls;

        end

        function DataSet = runAction(Obj,DataSet)
            yOut = bsxfun(@plus,DataSet.getObservations*Obj.Bpls, Obj.yMeansFactor);
            DataSet = DataSet.setObservations(yOut);
        end

        function xOut = runActionFast(Obj,xIn,ds) %#ok<INUSD>
           xOut = bsxfun(@plus,xIn*Obj.Bpls, Obj.yMeansFactor);
        end
    end
end


function [ w, x ] = gm_rule_set_old ( rule, dim_num, point_num )

%*****************************************************************************80
%
%% GM_RULE_SET_OLD sets a Grundmann-Moeller rule.  (OBSOLETE VERSION)
%
%  Discussion:
%
%    This version of the computation is no longer used.  The direct
%    application of the formula results in overflows and inaccuracies
%    very quickly.
%
%    This rule returns weights and abscissas of a Grundmann-Moeller
%    quadrature rule for the DIM_NUM-dimensional unit simplex.
%
%    The dimension POINT_NUM can be determined by calling GM_RULE_SIZE.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 July 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Axel Grundmann, Michael Moeller,
%    Invariant Integration Formulas for the N-Simplex
%    by Combinatorial Methods,
%    SIAM Journal on Numerical Analysis,
%    Volume 15, Number 2, April 1978, pages 282-290.
%
%  Parameters:
%
%    Input, integer RULE, the index of the rule.
%    0 <= RULE.
%
%    Input, integer DIM_NUM, the spatial dimension.
%    1 <= DIM_NUM.
%
%    Input, integer POINT_NUM, the number of points in the rule.
%
%    Output, real W(POINT_NUM), the weights.
%
%    Output, real X(DIM_NUM,POINT_NUM), the abscissas.
%
  s = rule;
  d = 2 * s + 1;
  k = 0;
  n = dim_num;
  one_pm = 1;

  for i = 0 : s

    weight = r8_factorial ( n ) ...
      * ( one_pm *  ( d + n - 2 * i )^d ) ...
      / ( 2^(2*s) * r8_factorial ( i ) * r8_factorial ( d + n - i ) );

    one_pm = - one_pm;

    beta_sum = s - i;
    more = 0;
    beta = [];
    h = 0;
    t = 0;

    while ( 1 )

      [ beta, more, h, t ] = comp_next ( beta_sum, dim_num + 1, ...
        beta, more, h, t );

      k = k + 1;

      w(k) = weight;

      x(1:dim_num,k) = ( 2 * beta(2:dim_num+1)' + 1 ) / ( d + n - 2 * i );

      if ( ~more )
        break
      end

    end

  end

  return
end


% jointprob() - rejection of odd columns of a data array  using
%              joint probability of the values in that column (and
%              using the probability distribution of all columns).
%
% Usage:
%   >>  [jp rej] = jointprob( signal );
%   >>  [jp rej] = jointprob( signal, threshold, jp, normalize, discret);
%
%
% Inputs:
%   signal     - one dimensional column vector of data values, two
%                dimensional column vector of values of size
%                sweeps x frames or three dimensional array of size
%                component x sweeps x frames. If three dimensional,
%                all components are treated independently.
%   threshold  - Absolute threshold. If normalization is used then the
%                threshold is expressed in standard deviation of the
%                mean. 0 means no threshold.
%   jp         - pre-computed joint probability (only perform thresholding).
%                Default is the empty array [].
%   normalize  - 0 = do not not normalize entropy. 1 = normalize entropy.
%                2 is 20% trimming (10% low and 10% high) proba. before
%                normalizing. Default is 0.
%   discret    - discretization variable for calculation of the
%                discrete probability density. Default is 1000 points.
%
% Outputs:
%   jp         - normalized joint probability  of the single trials
%                (size component x sweeps)
%   rej        - rejected matrix (0 and 1, size comp x sweeps)
%
% Remark:
%   The exact values of joint-probability depend on the size of a time
%   step and thus cannot be considered as absolute.
%
% See also: realproba()

% Copyright (C) 2001 Arnaud Delorme, Salk Institute, arno@salk.edu
%
% 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

function [jp, rej] = jointprob( signal, threshold, oldjp, normalize, discret );

if nargin < 1
	help jointprob;
	return;
end;
if nargin < 2
	threshold = 0;
end;
if nargin < 3
	oldjp = [];
end;
if nargin < 4
	normalize = 0;
end;
if nargin < 5
	discret = 1000;
end;

if size(signal,2) == 1 % transpose if necessary
	signal = signal';
end;

[nbchan pnts sweeps] = size(signal);
jp  = zeros(nbchan,sweeps);

if exist('oldjp') & ~isempty( oldjp ) % speed up the computation
	jp = oldjp;
else
	for rc = 1:nbchan

		% COMPUTE THE DENSITY FUNCTION
		% ----------------------------
		[ dataProba sortbox ] = realproba( signal(rc, :), discret );

		% compute all entropy
		% -------------------
		for index=1:sweeps
			datatmp = dataProba((index-1)*pnts+1:index*pnts);
			jp(rc, index) = - sum( log( datatmp ) );
			     % - sum( datatmp .* log( datatmp ) ); would be the entropy
		end;
	end;

	% normalize the last dimension
	% ----------------------------
	if normalize
        tmpjp = jp;
        if normalize == 2,
            tmpjp = sort(jp);
            tmpjp = tmpjp(round(length(tmpjp)*0.1):end-round(length(tmpjp)*0.1));
        end;
        try,
            switch ndims( signal )
             case 2,	jp = (jp-mean(tmpjp)) / std(tmpjp);
             case 3,	jp = (jp-mean(tmpjp,2)*ones(1,size(jp,2)))./ ...
                  (std(tmpjp,0,2)*ones(1,size(jp,2)));
            end;
        catch, error('Error while normalizing'); end;
	end;
end

% reject
% ------
if threshold ~= 0
    if length(threshold) > 1
    	rej = (threshold(1) > jp) | (jp > threshold(2));
    else
    	rej = abs(jp) > threshold;
    end;
else
	rej = zeros(size(jp));
end;

return;


function [minFlux,maxFlux,Vmin,Vmax] = fluxVariability(model,optPercentage,osenseStr,rxnNameList,verbFlag, allowLoops)
%fluxVariability Performs flux variablity analysis
%
% [minFlux,maxFlux] = fluxVariability(model,optPercentage,osenseStr,rxnNameList,verbFlag, allowLoops)
%
%INPUT
% model             COBRA model structure
%
%OPTIONAL INPUTS
% optPercentage     Only consider solutions that give you at least a certain
%                   percentage of the optimal solution (Default = 100
%                   or optimal solutions only)
% osenseStr         Objective sense ('min' or 'max') (Default = 'max')
% rxnNameList       List of reactions for which FVA is performed
%                   (Default = all reactions in the model)
% verbFlag          Verbose output (opt, default false)
% allowLoops        Whether loops are allowed in solution. (Default = true)
%                   See optimizeCbModel for description
%
%OUTPUT
% minFlux           Minimum flux for each reaction
% maxFlux           Maximum flux for each reaction
%
%OPTIONAL OUTPUT
% Vmin          Matrix of column flux vectors, where each column is a
%               separate minimization.
% Vmax          Matrix of column flux vectors, where each column is a
%               separate maximization.
%

% Markus Herrgard  8/21/06 Original code.
% Ronan Fleming   01/20/10 Take the extremal flux from the flux vector,
%                          not from the objective since this is invariant
%                          to the value and sign of the coefficient
% Ronan Fleming   27/09/10 Vmin,Vmax

if (nargin < 2)
    optPercentage = 100;
end
if (nargin < 3)
    osenseStr = 'max';
end
if (nargin < 4)
    rxnNameList = model.rxns;
end
if (nargin < 5)
    verbFlag = false;
end
if (nargin < 6)
    allowLoops = true;
end
if (isempty(optPercentage))
    optPercentage = 100;
end
if (isempty(osenseStr))
    osenseStr = 'max';
end
if (isempty(rxnNameList))
    rxnNameList = model.rxns;
end

% LP solution tolerance
global CBT_LP_PARAMS
if (exist('CBT_LP_PARAMS', 'var'))
    if isfield(CBT_LP_PARAMS, 'objTol')
        tol = CBT_LP_PARAMS.objTol;
    else
        tol = 1e-6;
    end
    if isfield(CBT_LP_PARAMS, 'minNorm')
        minNorm = CBT_LP_PARAMS.minNorm;
    else
        minNorm = 0;
    end
else
    tol = 1e-6;
    minNorm = 0;
end

% Determine constraints for the correct space (0-100% of the full space)
if (sum(model.c ~= 0) > 0)
    hasObjective = true;
    optSol = optimizeCbModel(model,osenseStr, 0, allowLoops);
    if (optSol.stat > 0)
        objRxn = model.rxns(model.c~=0);
        if (strcmp(osenseStr,'max'))
            objValue = floor(optSol.f/tol)*tol*optPercentage/100;
        else
            objValue = ceil(optSol.f/tol)*tol*optPercentage/100;
        end
    else
        error('Infeasible problem - no optimal solution!');
    end
else
    hasObjective = false;
end

if (verbFlag == 1)
    h = waitbar(0,'Flux variability analysis in progress ...');
end
if (verbFlag > 1)
    fprintf('%4s\t%4s\t%10s\t%9s\t%9s\n','No','Perc','Name','Min','Max');
end

if (~isfield(model,'b'))
    model.b = zeros(size(model.S,1),1);
end
% Set up the general problem
[nMets,nRxns] = size(model.S);
rxnListFull = model.rxns;
LPproblem.c = model.c;
LPproblem.lb = model.lb;
LPproblem.ub = model.ub;
LPproblem.csense(1:nMets) = 'E';
LPproblem.csense = LPproblem.csense';
if hasObjective
    LPproblem.A = [model.S;columnVector(model.c)'];
    LPproblem.b = [model.b;objValue];
    if (strcmp(osenseStr,'max'))
        LPproblem.csense(end+1) = 'G';
    else
        LPproblem.csense(end+1) = 'L';
    end
else
    LPproblem.A = model.S;
    LPproblem.b = model.b;
end

% %solve to generate initial basis
LPproblem.osense = -1;
tempSolution = solveCobraLP(LPproblem);
LPproblem.basis = tempSolution.basis;

% Loop through reactions
maxFlux = zeros(length(rxnNameList), 1);
minFlux = zeros(length(rxnNameList), 1);

if length(minNorm)> 1 || minNorm > 0
    Vmin=zeros(nRxns,nRxns);
    Vmax=zeros(nRxns,nRxns);
    %minimizing the Euclidean norm gets rid of the loops, so there
    %is no need for a second slower MILP approach
    allowLoops=1;
else
    Vmin=[];
    Vmax=[];
end

solutionPool = zeros(length(model.lb), 0);
if ~exist('matlabpool') || (matlabpool('size') == 0) %aka nothing is active
    m = 0;
    for i = 1:length(rxnNameList)
        if mod(i,10) == 0, clear mex, end
        if (verbFlag == 1),fprintf('iteration %d.  skipped %d\n', i, round(m));end
        LPproblem.c = zeros(nRxns,1);
        rxnBool=strcmp(rxnListFull,rxnNameList{i});
        LPproblem.c(rxnBool) = 1; %no need to set this more than 1
        % do LP always
        LPproblem.osense = -1;
        LPsolution = solveCobraLP(LPproblem);
        %take the maximum flux from the flux vector, not from the obj -Ronan
        maxFlux(i) = LPsolution.full(LPproblem.c~=0);

        %minimise the Euclidean norm of the optimal flux vector to remove
        %loops -Ronan
        if length(minNorm)> 1 || minNorm > 0
            QPproblem=LPproblem;
            QPproblem.lb(LPproblem.c~=0)=maxFlux(i)-1e-12;
            QPproblem.ub(LPproblem.c~=0)=maxFlux(i)+1e12;
            QPproblem.c(:)=0;
            %Minimise Euclidean norm using quadratic programming
            if length(minNorm)==1
                minNorm=ones(nRxns,1)*minNorm;
            end
            QPproblem.F = spdiags(minNorm,0,nRxns,nRxns);
            %quadratic optimization
            solution = solveCobraQP(QPproblem);
            if isempty(solution.full)
                pause(eps)
            end
            Vmax(:,rxnBool)=solution.full(1:nRxns,1);
        end

        LPproblem.osense = 1;
        LPsolution = solveCobraLP(LPproblem);
        %take the maximum flux from the flux vector, not from the obj -Ronan
        minFlux(i) = LPsolution.full(LPproblem.c~=0);

        %minimise the Euclidean norm of the optimal flux vector to remove
        %loops
        %minimise the Euclidean norm of the optimal flux vector to remove
        %loops
        if length(minNorm)> 1 || minNorm > 0
            QPproblem=LPproblem;
            QPproblem.lb(LPproblem.c~=0)=maxFlux(i)-1e-12;
            QPproblem.ub(LPproblem.c~=0)=maxFlux(i)+1e12;
            QPproblem.c(:)=0;
            QPproblem.F = spdiags(minNorm,0,nRxns,nRxns);
            %Minimise Euclidean norm using quadratic programming
            if length(minNorm)==1
                minNorm=ones(nRxns,1)*minNorm;
            end
            QPproblem.F = spdiags(minNorm,0,nRxns,nRxns);
            %quadratic optimization
            solution = solveCobraQP(QPproblem);
            Vmin(:,rxnBool)=solution.full(1:nRxns,1);
        end

        if ~allowLoops
            if any( abs(LPproblem.c'*solutionPool - maxFlux(i)) < tol) % if any previous solutions are good enough.
                % no need to do anything.
                m = m+.5;
            else
                LPproblem.osense = -1;
                LPsolution = solveCobraMILP(addLoopLawConstraints(LPproblem, model));
                maxFlux(i) = LPsolution.obj/1000;
              end
            if any( abs(LPproblem.c'*solutionPool - minFlux(i)) < tol)
                m = m+.5;
                % no need to do anything.
            else
                LPproblem.osense = 1;
                LPsolution = solveCobraMILP(addLoopLawConstraints(LPproblem, model));
                minFlux(i) = LPsolution.obj/1000;
            end
        end
        if (verbFlag == 1)
            waitbar(i/length(rxnNameList),h);
        end
        if (verbFlag > 1)
            fprintf('%4d\t%4.0f\t%10s\t%9.3f\t%9.3f\n',i,100*i/length(rxnNameList),rxnNameList{i},minFlux(i),maxFlux(i));
        end
    end
else % parallel job.  pretty much does the same thing.
    parfor i = 1:length(rxnNameList)
        %if mod(i,10) == 0, clear mex, end
        %if (verbFlag == 1),fprintf('iteration %d.  skipped %d\n', i, round(m));end
        c = zeros(nRxns,1);
        c(strcmp(rxnListFull,rxnNameList{i})) = 1000;
        if allowLoops % do LP
            LPsolution = solveCobraLP(struct(...
                'A', LPproblem.A,...
                'b', LPproblem.b,...
                'lb', LPproblem.lb,...
                'ub', LPproblem.ub,...
                'csense', LPproblem.csense,...
                'c',c,...
                'osense',-1, ...
                'basis', LPproblem.basis ...
            ));
            %take the maximum flux from the flux vector, not from the obj -Ronan
            maxFlux(i) = LPsolution.full(c~=0);
            %LPproblemb.osense = 1;
            LPsolution = solveCobraLP(struct(...
                'A', LPproblem.A,...
                'b', LPproblem.b,...
                'lb', LPproblem.lb,...
                'ub', LPproblem.ub,...
                'csense', LPproblem.csense,...
                'c',c,...
                'osense',1, ... %only part that's different.
                'basis', LPproblem.basis ...
            ));
            minFlux(i) = LPsolution.full(c~=0);
        else
            LPsolution = solveCobraMILP(addLoopLawConstraints(struct(...
                'A', LPproblem.A,...
                'b', LPproblem.b,...
                'lb', LPproblem.lb,...
                'ub', LPproblem.ub,...
                'csense', LPproblem.csense,...
                'c',c,...
                'osense',-1 ...
            ), model));
            maxFlux(i) = LPsolution.obj/1000;

            LPsolution = solveCobraMILP(addLoopLawConstraints(struct(...
                'A', LPproblem.A,...
                'b', LPproblem.b,...
                'lb', LPproblem.lb,...
                'ub', LPproblem.ub,...
                'csense', LPproblem.csense,...
                'c',c,...
                'osense',1 ...
            ), model));%
            minFlux(i) = LPsolution.obj/1000;
        end
    end
end

if (verbFlag == 1)
	if ( regexp( version, 'R20') )
        	close(h);
	end
end

maxFlux = columnVector(maxFlux);
minFlux = columnVector(minFlux);


function bsv_test04 ( )

%*****************************************************************************80
%
%% BSV_TEST04 varies the location of the left boundary A in the Burgers equation.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 April 2012
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'BSV_TEST04:\n' );
  fprintf ( 1, '  Solution of steady viscous Burgers equation.\n' );
  fprintf ( 1, '  Vary the left boundary location A around the value -1.\n' );

  a_test = [ -1.04, -1.02, -1.01, -1.005, -1.0, -0.995, -0.99, -0.98, -0.96 ];
  test_num = length ( a_test );
  b = +1.0;
  alpha = 1.0;
  beta = -1.0;
  nu = 0.1;
  n = 161;
  output = 0;

  u = zeros(n,test_num);

  fprintf ( 1, '\n' );

  for test = 1 : test_num

    a = a_test(test);

    fprintf ( 1, '  Using A = %g\n', a );

    u(:,test) = bsv ( a, b, alpha, beta, nu, n, output );

  end

  x = linspace ( a, b, n );

  figure ( 4 )
  clf
  hold on
  plot ( x, u, 'b-', 'LineWidth', 3 );
  plot ( [a,b], [0.0,0.0], 'r-', 'LineWidth', 2 )
  grid on
  title ( 'A = -1.04, -1.02, -1.01, -1.005, -1, -0.995, -0.99, -0.98, -0.96' )
  xlabel ( '<--- X --->' )
  ylabel ( '<---U(X) --->' )
  axis ( [ a, b, -1.5, alpha ] )
  hold off
  filename = 'bsv_test04.png';
  print ( '-dpng', filename )
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Saved plot to file "%s".\n', filename );

  return
end


function nlogL = DN_nlogL_norm(y)
% DN_nlogL_norm     Negative log likelihood of data coming from a Gaussian distribution.
%
% Fits a Gaussian distribution to the data using the normfit function in
% Matlab's Statistics Toolbox and returns the negative log likelihood of the
% data coming from a Gaussian distribution using the normlike function.
%
%---INPUT:
% y, a vector of data

% ------------------------------------------------------------------------------
% Copyright (C) 2020, Ben D. Fulcher <ben.d.fulcher@gmail.com>,
% <http://www.benfulcher.com>
%
% If you use this code for your research, please cite the following two papers:
%
% (1) B.D. Fulcher and N.S. Jones, "hctsa: A Computational Framework for Automated
% Time-Series Phenotyping Using Massive Feature Extraction, Cell Systems 5: 527 (2017).
% DOI: 10.1016/j.cels.2017.10.001
%
% (2) B.D. Fulcher, M.A. Little, N.S. Jones, "Highly comparative time-series
% analysis: the empirical structure of time series and their methods",
% J. Roy. Soc. Interface 10(83) 20130048 (2013).
% DOI: 10.1098/rsif.2013.0048
%
% This function 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/>.
% ------------------------------------------------------------------------------

[muhat, sigmahat] = normfit(y);
nlogL = normlike([muhat, sigmahat],y)/length(y);

% ** Somehow this just scales with length, regardless of the distribution of y?

end


function beta = l1plusTV(H, Ht, A, At, y, sizeImage, TVlambda, p, normfac, err, insweep, decfac, tol)

% Algorithm for solving problems of the form:
% min ||x||_p + TVlambda*TV(A'x)s.t. ||y-Hx||_2 < err

% Inputs
% H - Forward Measurement Operator
% Ht - Backward Measurement Operator
% A - Sparsifying Forward Transform
% At - Sparsifying Backward Transform
% y - collected data
% sizeImage - size of Image matrix
% TVlambda - multiplication factor for TV norm
% p - non-convex norm (default 1)
% normfac - highest singular value of A (default 1)
% err - two norm mismatch (default 1e-6)
% insweep - number of sweeps for internal loop (default 50)
% decfac - lambda decrease factor for outside loop (default 0.5)
% tol - tolerance for convergence (default 1e-4)

% copyright (c) Angshul Majumdar 2010

N = sizeImage;
c = 4;

if nargin < 9
    p = 1;
end
if nargin < 10
    normfac = 1;
end
if nargin < 11
    err = 1e-6;
end
if nargin < 12
    insweep = 50;
end
if nargin < 13
    decfac = 0.5;
end
if nargin < 14
    tol = 1e-4;
end

alpha = 1.1*normfac;
x_initial = Ht(y);
z_initial = zeros(length(TV(x_initial)),1);

x = x_initial; z = z_initial;

lambdaInit = decfac*max(abs(Ht(y))); lambda = lambdaInit;

f_current = norm(y-H(x_initial)) + lambda*norm(x,p) + TVlambda*norm(TV(At(x)),1);

while lambda > lambdaInit*tol
    lambda
    for i = 1:insweep
        f_previous = f_current;

        Wtilde = abs(x).^(p-2);
        W = 1 + (lambda/2)*Wtilde;

        b = x + (1/alpha)*(Ht(y-H(x)));
        btilde = (1./sqrt(W)).*b;
        z = (c*z + weightedTV(b-weightedTVtrans(z)))./((2*alpha/TVlambda)*(abs(weightedTV(x))).^(2-p)+c);
        x = 1./sqrt(W).*btilde - (1./sqrt(W)).*weightedTVtrans(z);

        f_current = norm(y-H(x_initial)) + lambda*norm(x,p) + TVlambda*norm(TV(x),1);

        if norm(f_current-f_previous)/norm(f_current + f_previous)<tol
            break;
        end
    end
    if norm(y-H(x))<err
        break;
    end
    lambda = decfac*lambda;
end
beta = x;

%%%%%% Functions for computing TV and TVtranspose %%%%%%%

    function wFvec = weightedTV(Xvec)
        wFvec = TV((1./sqrt(W)).*Xvec);
    end

    function wXvec = weightedTVtrans(Fvec)
        wXvec = (1./sqrt(W)).*TVtrans(Fvec);
    end

    function Fvec = TV(Xvec)
        Ivec = At(Xvec); % image pixels
        X = reshape(Ivec,N(1),N(2)); % sparse transform coefficients

        FX = zeros(N);
        FY = zeros(N);

        FX(1:end-1,:) = diff(X);
        FY(:,1:end-1) = diff(X')';

        Fvec = [FX(:)' FY(:)']';
    end

    function Xvec = TVtrans(Fvec)
        FX = reshape(Fvec(1:end/2),N(1),N(2));
        FY = reshape(Fvec(1+end/2:end),N(1),N(2));

        DX = zeros(N(1)+1,N(2));
        DY = zeros(N(1),N(2)+1);
        DX(2:end-1,:) = FX(1:end-1,:);
        DY(:,2:end-1) = FY(:,1:end-1);

        XT = -diff(DX);
        YT = -diff(DY')';

        X = XT + YT; % image
        Xvec = A(X(:));
    end
end


function [mix] = spm_mix (y,m,verbose)
% Fit a multivariate Gaussian Mixture model using VB
% FORMAT [mix] = spm_mix (y,m,verbose)
%
% y          [N x d] data matrix containing N samples of d-dim data
% m          Number of mixture components
% verbose    Set to 1 to see evolution of free energy, 0 otherwise
%            (default=1)
%
% mix        Returned model
%
%--------------------------------------------------------------------------
% The fields in mix are:
%
% m                The number of components
% fm               The negative free energy. This decomposes into
%                  fm=acc-kl_proportions-kl_covs-kl_centres
%
% acc              model accuracy
% kl_proportions   complexity penalty for cluster proportions
% kl_covs          complexity penalty for cluster covariances
% kl_centres       complexity penalty for cluster centres
%
% Fields:
%
% lambda           Post mixers, q(pi|D) = D(lambda)
% gamma            [m x N] matrix of belonging probabilities
% state(s).a       Post precisions, q(Gamma|D)=W(a,B)
% state(s).B
% state(s).C       Post covariance
% state(s).m       Post mean, q(mu|D)=N(m_s,beta_s Gamma_s)
% state(s).beta
% state(s).prior   Estimated mixing proportions
%
%                  In the field prior:
%
% lambda_0         Prior mixers, p(pi) = D(lambda_0)
% a_0,B_0          Prior precisions, p(Gamma)=W(a_0,B_0)
% m_0,beta_0       Prior means, p(mu)=N(m_0,beta_0 Gamma_s)
%
%__________________________________________________________________________
% Copyright (C) 2007-2014 Wellcome Trust Centre for Neuroimaging

% Will Penny
% $Id: spm_mix.m 5962 2014-04-17 12:47:43Z spm $

% This code implements the algorithm in:
%
% See Attias, H. (2000) A Variational
% Bayesian framework for Graphical Models, NIPS.
%
% See also:
%
% W.D. Penny (2001) Variational Bayes for d-dimensional Gaussian mixture models
% Wellcome Department of Imaging Neuroscience, University College London.
%
% for Negative Free Energy expression and validation.

if nargin < 3
    verbose=1;
end
[N,d]=size(y);

% Put model info into data structure format
mix.nin=d;
mix.m=m;

% PRIORS
% Set mixing priors
lambda_0=1;
% Set mean priors
m_0=mean(y);
beta_0=1;
% Set precision priors
% These settings set the prior covariance matrix to be
% equal to the 0.01*d*identity matrix - if original data is
% zmuv, this is reasonable
a_0=d;
B_0=0.01*d*eye(d);
%B_0=d*eye(d);

% Also, store in data structure ready for output
mix.prior.lambda_0=lambda_0;
mix.prior.m_0=m_0;
mix.prior.beta_0=beta_0;
mix.prior.a_0=a_0;
mix.prior.B_0=B_0;

sd=0;
for i=1:d,
  sd=sd+psi((a_0+1-i)/2);
end
log_tilde_gamma_0=sd-log(det(B_0))+d*log(2);

if (m==1)
    % For a single component we just have a Gaussian model

    % Set posterios
    state(1).a=N+a_0;
    state(1).beta=N+beta_0;
    state(1).m=m_0;
    Cy=cov(y);
    state(1).B=N*Cy+B_0;

    fm=spm_lg_gamma (d,0.5*state(1).a);
    fm=fm-spm_lg_gamma (d,0.5*a_0);
    fm=fm-0.5*d*N*log(pi);
    fm=fm+0.5*d*(log(beta_0)-log(state(1).beta));
    fm=fm+0.5*a_0*log(det(B_0));
    fm=fm-0.5*state(1).a*log(det(state(1).B));

    mix.m=m;
    mix.fm=fm;
    state(1).C=state(1).B/state(1).a;
    mix.state=state;

    mix.priors=1;
    return;
end

% Run kmeans on the data
% to initialise posterior
[priors,means,covs] = spm_kmeans(y,m);

% Add pseudo-counts to ML priors
priors=priors+(1/N);
lambda=priors;
for s=1:m,
  state(s).m=means(s,:);
  state(s).beta=priors(s)*N+beta_0;
  state(s).a=priors(s)*N+a_0;
  Cov=covs(:,:,s);
  % If component cov is rank deficient set to prior
  if rank(Cov) < size(Cov,1)
    state(s).B=B_0;
  else
    state(s).B=priors(s)*N*Cov;
  end
  N_bar(s)=priors(s)*N;
end

% Start algorithm
lik=[];
tol=0.0001;
max_loops=32;
for loops=1:max_loops,

    % E-step
    lambda_tot=sum(lambda);
    for s=1:m,
        state(s).bar_gamma=state(s).a*inv(state(s).B);
        log_tilde_pi(s)=psi(lambda(s))-psi(lambda_tot);
        sd=0;
        for i=1:d,
            sd=sd+psi((state(s).a+1-i)/2);
        end
        log_tilde_gamma(s)=sd-log(det(state(s).B))+d*log(2);

        tilde_pi(s)=exp(log_tilde_pi(s));
        tilde_gamma(s)=exp(log_tilde_gamma(s));
        for n=1:N,
            gamma(s,n)=tilde_pi(s)*tilde_gamma(s)^0.5;
            dy=(y(n,:)-state(s).m);
            gamma(s,n)=gamma(s,n)*(exp(-0.5*dy*state(s).bar_gamma*dy')+eps)*exp(-d/(2*state(s).beta));
        end
    end

    gamma_n=sum(gamma);
    for s=1:m,
        if mean(gamma_n) > eps
            % If component still exists
            gamma(s,:)=gamma(s,:)./gamma_n;
        end
    end

    % M-step

    % Part-I
    for s=1:m,
        pi_bar(s)=mean(gamma(s,:))+eps;
        N_bar(s)=N*pi_bar(s)+eps;
        bar_mu(s,:)=(1/N_bar(s))*sum(gamma(s,:)'*ones(1,d).*y);

    end

    % get weighted means and covariances
    for s=1:m,
        state(s).bar_sigma=zeros(d,d);
        for n=1:N,
            dy=y(n,:)-bar_mu(s,:);
            state(s).bar_sigma=state(s).bar_sigma+gamma(s,n).*(dy'*dy);
        end
        state(s).bar_sigma=(state(s).bar_sigma)/N_bar(s);

        if isnan(state(s).bar_sigma)
            state(s).bar_sigma
        end
    end

    % Now compute the free energy
    f1=-spm_kl_dirichlet(lambda,lambda_0*ones(1,m),log_tilde_pi);
    for s=1:m,
        f2(s)=-spm_kl_wishart(state(s).a,state(s).B,a_0,B_0);

        % KL-method for computing f3(s)
        Cs=state(s).B/(state(s).beta*state(s).a);
        C0=state(s).B/(beta_0*state(s).a);
        f3(s)=-spm_kl_normal(state(s).m,Cs,m_0,C0);

        % Check f3(s)
        check_f3=-0.5*d*(log(state(s).beta)-log(beta_0)+(beta_0/state(s).beta)-1);
        dm=state(s).m-m_0;
        check_f3=check_f3-0.5*dm*beta_0*state(s).a*inv(state(s).B)*dm';
        f3(s)=check_f3;

        f4(s)=N_bar(s)*log_tilde_pi(s)-sum(gamma(s,:).*log(gamma(s,:)+eps));
        LaB=0;
        for i=1:d,
            LaB=LaB+psi((state(s).a+1-i)/2);
        end
        LaB=LaB+d*log(2)-log(det(state(s).B));
        f5(s)=0.5*N_bar(s)*(-d*log(2*pi)+LaB-trace(state(s).bar_gamma*state(s).bar_sigma)-(d/state(s).beta));
        fkl(s)=f2(s)+f3(s)+f4(s)+f5(s);
        fkl_adj(s)=f2(s)+f3(s)+(f4(s)+f5(s))/N_bar(s);
    end
    fm=f1+sum(f2)+sum(f3)+sum(f4)+sum(f5);

    acc=sum(f4)+sum(f5);
    kl_proportions=-f1;
    kl_covs=-sum(f2);
    kl_centres=-sum(f3);

    if verbose
        disp(sprintf('Iter=%d, F1=%1.2f, F2=%1.2f, F3=%1.2f, F4=%1.2f, F5=%1.2f, Fm=%1.2f',loops,f1,sum(f2),sum(f3),sum(f4),sum(f5),fm));
    end

    % Convergence criterion
    oldlik=lik;
    lik=fm;
    if (loops>1)
        if abs((lik-oldlik)/lik) < tol
            break;
        end
    end;

    % Part-II

    for s=1:m,
        % Posterior mixing coefficients
        lambda(s)=N_bar(s)+lambda_0;
        % Posterior means
        state(s).m=(N_bar(s)*bar_mu(s,:)+beta_0*m_0)/(N_bar(s)+beta_0);
        state(s).beta=N_bar(s)+beta_0;
        % Posterior precisions
        state(s).a=N_bar(s)+a_0;
        dy=bar_mu(s,:)-m_0;
        state(s).B=N_bar(s)*state(s).bar_sigma + (N_bar(s)*beta_0*dy'*dy)/(N_bar(s)+beta_0)+B_0;
    end
end

% Put variables into data structure
mix.m=m;
mix.fm=fm;
mix.acc=acc;
mix.kl_proportions=kl_proportions;
mix.kl_covs=kl_covs;
mix.kl_centres=kl_centres;
mix.state=state;
mix.lambda=lambda;
mix.gamma=gamma;

% Put info into data structure
for j=1:m,
    mix.state(j).prior=pi_bar(j);
    mix.state(j).C=mix.state(j).B/mix.state(j).a;
end


function degree = keast_degree ( rule )

%*****************************************************************************80
%
%% KEAST_DEGREE returns the degree of a Keast rule for the tetrahedron.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 June 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Patrick Keast,
%    Moderate Degree Tetrahedral Quadrature Formulas,
%    Computer Methods in Applied Mechanics and Engineering,
%    Volume 55, Number 3, May 1986, pages 339-348.
%
%  Parameters:
%
%    Input, integer RULE, the index of the rule.
%
%    Output, integer DEGREE, the degree of the rule.
%
  if ( rule == 1 )
    degree = 0;
  elseif ( rule == 2 )
    degree = 1;
  elseif ( rule == 3 )
    degree = 2;
  elseif ( rule == 4 )
    degree = 3;
  elseif ( rule == 5 )
    degree = 4;
  elseif ( rule == 6 )
    degree = 4;
  elseif ( rule == 7 )
    degree = 5;
  elseif ( rule == 8 )
    degree = 6;
  elseif ( rule == 9 )
    degree = 7;
  elseif ( rule == 10 )
    degree = 8;
  else
    degree = -1;
    fprintf ( 1, '\n' );
    fprintf ( 1, 'KEAST_DEGREE - Fatal error!\n' );
    fprintf ( 1, '  Illegal value of RULE = %d\n', rule );
    error ( 'KEAST_DEGREE - Fatal error!' )
  end

  return
end


function y = sum_square_pos( x, dim )

%SUM_SQUARE_POS   Sum of squares of the positive parts.
%   For vectors, SUM_SQUARE(X) is the sum of the squares of the positive
%   parts of X; i.e., SUM( MAX(X,0)^2 ). X must be real.
%
%   For matrices, SUM_SQUARE_POS(X) is a row vector containing the
%   application of SUM_SQUARE_POS to each column. For N-D arrays, the
%   SUM_SQUARE_POS operation is applied to the first non-singleton
%   dimension of X.
%
%   SUM_SQUARE_POS(X,DIM) takes the sum along the dimension DIM of X.
%
%   Disciplined convex programming information:
%       SUM_SQUARE_POS(X,...) is convex and nondecreasing in X. Thus, when
%       used in CVX expressions, X must be convex (or affine). DIM must
%       always be constant.

error( nargchk( 1, 2, nargin ) );
if nargin == 2,
    y = sum( square_pos( x ), dim );
else
    y = sum( square_pos( x ) );
end

% Copyright 2010 Michael C. Grant and Stephen P. Boyd.
% See the file COPYING.txt for full copyright information.
% The command 'cvx_where' will show where this file is located.


function linpack_s_test16 ( )

%*****************************************************************************80
%
%% TEST16 tests SPOCO.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    24 June 2009
%
%  Author:
%
%    John Burkardt
%
  n = 5;
  lda = n;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST16\n' );
  fprintf ( 1, '  For a positive definite symmetric matrix,\n' );
  fprintf ( 1, '  SPOCO estimates the reciprocal condition number.\n' );
  fprintf ( 1, '  The matrix size is N = %d\n', n );
%
%  Set the matrix A.
%
  a(1:n,1:n) = 0.0;

  for i = 1 : n
    a(i,i) = 2.0;
    if ( 1 < i )
      a(i,i-1) = -1.0;
    end
    if ( i < n )
      a(i,i+1) = -1.0;
    end
  end
%
%  Estimate the condition.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Estimate the condition.\n' );

  [ a, rcond, z, info ] = spoco ( a, lda, n );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Reciprocal condition  = %f\n', rcond );

  return
end


function P=maxpooling_s2(A)

[h,w]=size(A);

if mod(h,2)==1
    A=[A;zeros(1,w)];
    h=h+1;
end
if mod(w,2)==1
    A=[A,zeros(h,1)];
    w=w+1;
end

A1=A(1:2:h-1,1:2:w-1);
A2=A(1:2:h-1,2:2:w);
A3=A(2:2:h,1:2:w-1);
A4=A(2:2:h,2:2:w);

P1=max(A1,A2);
P2=max(A3,A4);
P=max(P1,P2);


function fixed = p15_fixed_points ( m, fixed_num )

%*****************************************************************************80
%
%% P15_FIXED_POINTS returns the fixed points in problem 15.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 April 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Per-Olof Persson and Gilbert Strang,
%    A Simple Mesh Generator in MATLAB,
%    SIAM Review,
%    Volume 46, Number 2, June 2004, pages 329-345.
%
%  Parameters:
%
%    Input, integer M, the spatial dimension.
%
%    Input, integer FIXED_NUM, the number of fixed points.
%
%    Output, real FIXED(M,FIXED_NUM), the fixed points.
%
  fixed = [    ...
   -8.0, -1.0; ...
    2.0, -1.0; ...
    2.0,  0.0; ...
    8.0,  0.0; ...
    8.0,  1.0; ...
   -2.0,  1.0; ...
   -2.0,  0.0; ...
   -8.0,  0.0 ]';

  return
end


%This Matlab script can be used to reproduce Figures 4.5-6 in the monograph:
%
%Emil Bjornson, Jakob Hoydis and Luca Sanguinetti (2017),
%"Massive MIMO Networks: Spectral, Energy, and Hardware Efficiency",
%Foundations and Trends in Signal Processing: Vol. 11, No. 3-4,
%pp. 154-655. DOI: 10.1561/2000000093.
%
%For further information, visit: https://www.massivemimobook.com
%
%This is version 1.0 (Last edited: 2017-11-04)
%
%License: This code is licensed under the GPLv2 license. If you in any way
%use this code for research that results in publications, please cite our
%monograph as described above.

%Empty workspace and close figures
close all;
clear;

%Number of BSs
L = 16;

%Number of UEs per BS
K = 10;

%Define the range of BS antennas
Mrange = 10:10:100;

%Extract maximum number of BS antennas
Mmax = max(Mrange);

%Define the range of pilot reuse factors
fRange = [1 2 4];

%Select the number of setups with random UE locations
nbrOfSetups = 100;

%Select the number of channel realizations per setup
nbrOfRealizations = 100;

%% Propagation parameters

%Communication bandwidth
B = 20e6;

%Total uplink transmit power per UE (mW)
p = 100;

%Noise figure at the BS (in dB)
noiseFigure = 7;

%Compute noise power
noiseVariancedBm = -174 + 10*log10(B) + noiseFigure;

%Select length of coherence block
tau_c = 200;

%Use the approximation of the Gaussian local scattering model
accuracy = 2;

%Angular standard deviation in the local scattering model (in degrees)
ASDdeg = 10;

%Prepare to save simulation results
sumSE_MR = zeros(length(Mrange),length(fRange),nbrOfSetups);
sumSE_ZF = zeros(length(Mrange),length(fRange),nbrOfSetups);
sumSE_RZF = zeros(length(Mrange),length(fRange),nbrOfSetups);
sumSE_SMMSE = zeros(length(Mrange),length(fRange),nbrOfSetups);
sumSE_MMMSE = zeros(length(Mrange),length(fRange),nbrOfSetups);

%% Go through all setups
for n = 1:nbrOfSetups

    %Output simulation progress
    disp([num2str(n) ' setups out of ' num2str(nbrOfSetups)]);

    %Compute channel statistics for one setup
    [R,channelGaindB] = functionExampleSetup(L,K,Mmax,accuracy,ASDdeg);

    %Compute the normalized average channel gain, where the normalization
    %is based on the noise power
    channelGainOverNoise = channelGaindB - noiseVariancedBm;

    %Go through all number of antennas
    for m = 1:length(Mrange)

        %Output simulation progress
        disp([num2str(m) ' antennas out of ' num2str(length(Mrange))]);

        %Go through all pilot reuse factors
        for s = 1:length(fRange)

            %Extract pilot reuse factor
            f = fRange(s);

            %Generate channel realizations with estimates and estimation
            %error correlation matrices
            [Hhat,C,tau_p,Rscaled] = functionChannelEstimates(R(1:Mrange(m),1:Mrange(m),:,:,:),channelGainOverNoise,nbrOfRealizations,Mrange(m),K,L,p,f);

            %Compute SEs using Theorem 4.1
            [SE_MR,SE_RZF,SE_MMMSE,SE_ZF,SE_SMMSE] = functionComputeSE_UL(Hhat,C,Rscaled,tau_c,tau_p,nbrOfRealizations,Mrange(m),K,L,p);

            %Save average sum SE per cell
            sumSE_MR(m,s,n) = mean(sum(SE_MR,1));
            sumSE_ZF(m,s,n) = mean(sum(SE_ZF,1));
            sumSE_SMMSE(m,s,n) = mean(sum(SE_SMMSE,1));
            sumSE_RZF(m,s,n) = mean(sum(SE_RZF,1));
            sumSE_MMMSE(m,s,n) = mean(sum(SE_MMMSE,1));

            %Delete large matrices
            clear Hhat C Rscaled;

        end

    end

    %Delete large matrices
    clear R;

end

%% Plot the simulation results
for s = 1:length(fRange)

    figure(s);
    hold on; box on;

    plot(Mrange,mean(sumSE_MMMSE(:,s,:),3),'rd-','LineWidth',1);
    plot(Mrange,mean(sumSE_SMMSE(:,s,:),3),'b:','LineWidth',1);
    plot(Mrange,mean(sumSE_RZF(:,s,:),3),'k-.','LineWidth',1);
    plot(Mrange,mean(sumSE_ZF(:,s,:),3),'r--','LineWidth',1);
    plot(Mrange,mean(sumSE_MR(:,s,:),3),'bs-','LineWidth',1);

    xlabel('Number of antennas (M)');
    ylabel('Average sum SE [bit/s/Hz/cell]');
    legend('M-MMSE','S-MMSE','RZF','ZF','MR','Location','NorthWest');
    ylim([0 60]);

end