function [Eft, Covft, ljpyt, Eyt, Covyt] = gp_jpred(gp, x, y, varargin)
%GP_JPRED  Joint predictions with Gaussian process
%
%  Description
%    [EFT, COVFT] = GP_JPRED(GP, X, Y, XT, OPTIONS)
%    takes a GP structure together with matrix X of training
%    inputs and vector Y of training targets, and evaluates the
%    joint predictive distribution at test inputs XT. Returns a posterior
%    mean EFT and covariance COVFT of latent variables.
%
%        Eft =  E[f | xt,x,y,th]  = K_fy*(Kyy+s^2I)^(-1)*y
%      Covft = Var[f | xt,x,y,th] = K_fy - K_fy*(Kyy+s^2I)^(-1)*K_yf.
%
%    Each row of X corresponds to one input vector and each row of
%    Y corresponds to one output vector.
%
%    [EFT, COVFT, LJPYT] = GP_JPRED(GP, X, Y, XT, 'yt', YT, ...)
%    returns also logarithm of the predictive joint density LJPYT of
%    the observations YT at test input locations XT. This can be
%    used for example in the cross-validation. Here Y has to be
%    vector.
%
%    [EFT, COVFT, LJPYT, EYT, COVYT] = GP_JPRED(GP, X, Y, XT, 'yt', YT, ...)
%    returns also the posterior predictive mean and covariance.
%
%    [EF, COVF, LJPY, EY, VARY] = GP_JPRED(GP, X, Y, OPTIONS)
%    evaluates the predictive distribution at training inputs X
%    and logarithm of the predictive density PY of the training
%    observations Y.
%
%    OPTIONS is optional parameter-value pair
%      predcf - an index vector telling which covariance functions are
%                 used for prediction. Default is all (1:gpcfn).
%                 See additional information below.
%      tstind - a vector/cell array defining, which rows of X belong
%               to which training block in *IC type sparse models.
%               Default is []. In case of PIC, a cell array
%               containing index vectors specifying the blocking
%               structure for test data. IN FIC and CS+FIC a
%               vector of length n that points out the test inputs
%               that are also in the training set (if none, set
%               TSTIND = [])
%      yt     - optional observed yt in test points (see below)
%
%    NOTE! In case of FIC and PIC sparse approximation the
%    prediction for only some PREDCF covariance functions is just
%    an approximation since the covariance functions are coupled in
%    the approximation and are not strictly speaking additive
%    anymore.
%
%    For example, if you use covariance such as K = K1 + K2 your
%    predictions Ef1 = gp_pred(GP, X, Y, X, 'predcf', 1) and Ef2 =
%    gp_pred(gp, x, y, x, 'predcf', 2) should sum up to Ef =
%    gp_pred(gp, x, y, x). That is Ef = Ef1 + Ef2. With FULL model
%    this is true but with FIC and PIC this is true only
%    approximately. That is Ef \approx Ef1 + Ef2.
%
%    With CS+FIC the predictions are exact if the PREDCF covariance
%    functions are all in the FIC part or if they are CS
%    covariances.
%
%    NOTE! When making predictions with a subset of covariance
%    functions with FIC approximation the predictive variance can
%    in some cases be ill-behaved i.e. negative or
%    unrealistically small. This may happen because of the
%    approximative nature of the prediction.
%
%  See also
%    GP_SET, GP_OPTIM, DEMO_REGRESSION*
%

% Copyright (c) 2007-2010 Jarno Vanhatalo
% Copyright (c) 2008 Jouni Hartikainen
% Copyright (c) 2011-2012 Ville Tolvanen
% Copyright (c) 2010,2012 Aki Vehtari

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

if iscell(gp) || numel(gp.jitterSigma2)>1 || isfield(gp,'latent_method')
  % use an inference specific method
  if iscell(gp)
    fh_pred=@gpia_jpred;
  elseif numel(gp.jitterSigma2)>1
    fh_pred=@gpmc_jpred;
  elseif isfield(gp,'latent_method')
    fh_pred=gp.fh.jpred;
  else
    error('Logical error by coder of this function!')
  end
  switch nargout
    case 1
      [Eft] = fh_pred(gp, x, y, varargin{:});
    case 2
      [Eft, Covft] = fh_pred(gp, x, y, varargin{:});
    case 3
      [Eft, Covft, ljpyt] = fh_pred(gp, x, y, varargin{:});
    case 4
      [Eft, Covft, ljpyt, Eyt] = fh_pred(gp, x, y, varargin{:});
    case 5
      [Eft, Covft, ljpyt, Eyt, Covyt] = fh_pred(gp, x, y, varargin{:});
  end
  return
end

ip=inputParser;
ip.FunctionName = 'GP_JPRED';
ip.addRequired('gp',@isstruct);
ip.addRequired('x', @(x) ~isempty(x) && isreal(x) && all(isfinite(x(:))))
ip.addRequired('y', @(x) ~isempty(x) && isreal(x) && all(isfinite(x(:))))
ip.addOptional('xt', [], @(x) isempty(x) || (isreal(x) && all(isfinite(x(:)))))
ip.addParamValue('yt', [], @(x) isreal(x) && all(isfinite(x(:))))
ip.addParamValue('predcf', [], @(x) isempty(x) || ...
                 isvector(x) && isreal(x) && all(isfinite(x)&x>0))
ip.addParamValue('tstind', [], @(x) isempty(x) || iscell(x) ||...
                 (isvector(x) && isreal(x) && all(isfinite(x)&x>0)))
ip.parse(gp, x, y, varargin{:});
xt=ip.Results.xt;
yt=ip.Results.yt;
predcf=ip.Results.predcf;
tstind=ip.Results.tstind;
if isempty(xt)
  xt=x;
  if isempty(tstind)
    if iscell(gp)
      gptype=gp{1}.type;
    else
      gptype=gp.type;
    end
    switch gptype
      case {'FULL' 'VAR' 'DTC' 'SOR'}
        tstind = [];
      case {'FIC' 'CS+FIC'}
        tstind = 1:size(x,1);
      case 'PIC'
        if iscell(gp)
          tstind = gp{1}.tr_index;
        else
          tstind = gp.tr_index;
        end
    end
  end
  if isempty(yt)
    yt=y;
  end
end

tn = size(x,1);
if isfield(gp.lik, 'nondiagW') && ~ismember(gp.lik.type, {'LGP' 'LGPC'})
  switch gp.lik.type
    case {'Softmax', 'Multinom'}
      nout=size(y(:),1)/tn;
    otherwise
      if ~isfield(gp.lik,'xtime') && size(y,1)~=size(x,1)
        y=reshape(y,size(x,1),size(y,1)/size(x,1));
      end
      nout=length(gp.comp_cf);

      % Indices for looping over latent processes
      if ~isfield(gp.lik, 'xtime')
        nl=[0 repmat(n,1,nout)];
        nl=cumsum(nl);
      else
        xtime=gp.lik.xtime;
        ntime = size(xtime,1);
        n=tn-ntime;
        nl=[0 ntime n];
        nl=cumsum(nl);
      end
  end
  y=reshape(y,tn,nout);

  if isfield(gp, 'comp_cf')  % own covariance for each ouput component
    multicf = true;
    if length(gp.comp_cf) ~= nout
      error('GP2_PRED: the number of component vectors in gp.comp_cf must be the same as number of outputs or latent processes.')
    end
    if ~isempty(predcf)
      if ~iscell(predcf) || length(predcf)~=nout
        error(['GP2_PRED: if own covariance for each output or latent process component is used,'...
          'predcf has to be cell array and contain nout (vector) elements.   '])
      end
    else
      predcf = gp.comp_cf;
    end
  else
    multicf = false;
    for i1=1:nout
      predcf2{i1} = predcf;
    end
    predcf=predcf2;
  end
end

if nargout > 2 && isempty(yt)
  ljpyt=[];
end

% Evaluate this if sparse model is used
switch gp.type
  case 'FULL'

    if ~isfield(gp.lik, 'nondiagW') && ismember(gp.lik.type, {'LGP', 'LGPC'})
        %evaluate a = C\y;
        % -------------------
        [c, C]=gp_trcov(gp,x);

        if issparse(C)
          LD = ldlchol(C);
          a = ldlsolve(LD,y);
        elseif isempty(C)
          C=0;
          L=[];
          a = zeros(length(y),1);
        else
          L = chol(C)';
          a = L'\(L\y);
        end

        % evaluate K*a
        % -------------------
        K=gp_cov(gp,x,xt,predcf);
        Eft = K'*a;

        if  isfield(gp,'meanf')
          if issparse(C)
            [RB RAR] = mean_jpredf(gp,x,xt,K,LD,a,'gaussian',[]);    % terms with non-zero mean -prior
          else
            [RB RAR] = mean_jpredf(gp,x,xt,K,L,a,'gaussian',[]);    % terms with non-zero mean -prior
          end
          Eft = Eft + RB;
        end

        % Evaluate variance
        % Vector of diagonal elements of covariance matrix
        if nargout > 1

          V = gp_trcov(gp,xt,predcf);
          if issparse(C)
            Covft = (V - (K'*ldlsolve(LD,K)));
          else
            v = L\K;
            Covft = (V - (v'*v));
          end

          % If there are specified mean functions
          if  isfield(gp,'meanf')
            Covft = Covft + RAR;
          end
        end

        if nargout > 2
          % Scale mixture model in lik_smt is a special case
          % handle it separately
          if ~strcmp(gp.lik.type, 'lik_smt')
            % normal case
            [V, Cv] = gp_trvar(gp,xt,predcf);
            Eyt = Eft;
            apu = Cv - V;
            Covyt = Covft + diag(apu); % Utilize the Covft calculated above (faster!?) dimensions did not match here earlier!
            % Log joint predictive density
            if ~isempty(yt)
              ljpyt = mnorm_lpdf(yt', Eyt', Covyt);
            end
          else
            % scale mixture case
            nu = gp.lik.nu;             % Not working at the moment. Probably.
            sigma2 = gp.lik.tau2.*gp.lik.alpha.^2;
            sigma = sqrt(sigma2);

            Eyt = Eft;
            Covyt = (nu./(nu-2).*sigma2);

            for i2 = 1:length(Eft)
              mean_app = Eft(i2);
              sigm_app = sqrt(Covft(i2));

              pd = @(f) t_pdf(yt(i2), nu, f, sigma).*norm_pdf(f,Eft(i2),sqrt(Covft(i2)));
              pyt(i2) = quadgk(pd, mean_app - 12*sigm_app, mean_app + 12*sigm_app);
            end
          end
        end
    else
      % Likelihoods with non-diagonal Hessian
      L = zeros(tn,tn,nout);
      ntest=size(xt,1);
      K_nf = zeros(ntest,tn,nout);
      if multicf
        for i1=1:nout
          [tmp,C] = gp_trcov(gp, x, gp.comp_cf{i1});
          L(:,:,i1) = chol(C)';
          K_nf(:,:,i1) = gp_cov(gp,xt,x,predcf{i1});
        end
      else
        for i1=1:nout
          [tmp,C] = gp_trcov(gp, x);
          L(:,:,i1) = chol(C)';
          K_nf(:,:,i1) = gp_cov(gp,xt,x,predcf{i1});
        end
      end

      Eft = zeros(ntest,nout);
      for i1=1:nout
        Eft(:,i1) = K_nf(:,:,i1)*(L(:,:,i1)'\(L(:,:,i1)\y(:,i1)));
      end

      Covft = zeros(ntest*nout,ntest*nout);
      if nargout > 1
        if multicf
          for i1=1:nout
            v = L(:,:,i1)\K_nf(:,:,i1)';
            V = gp_trcov(gp,xt,gp.comp_cf{i1});
            Covft((i1-1)*ntest+1:i1*ntest,(i1-1)*ntest+1:i1*ntest) = V - v'*v;
          end
        else
          for i1=1:nout
            v = L(:,:,i1)\K_nf(:,:,i1)';
            V = gp_trcov(gp,xt,predcf{i1});
            Covft((i1-1)*ntest+1:i1*ntest,(i1-1)*ntest+1:i1*ntest) = V - v'*v;
          end
        end
      end
      if nargout > 2
        % normal case
        Eyt = Eft;
        Covyt=Covft;
        ljpyt=0;
        for i1=1:nout
          [V, Cv] = gp_trvar(gp,xt,predcf{i1});
          % Diagonal indices
          i2=(i1-1)*(nout*ntest^2+ntest)+1:nout*ntest+1:i1*(nout*ntest^2+ntest);
          Covyt(i2) = Covyt(i2) + Cv' - V';
          if ~isempty(yt)
            ljpyt = ljpyt + mnorm_lpdf(yt(:,i1)', Eyt(:,i1)', Covyt((i1-1)*ntest+1:i1*ntest,(i1-1)*ntest+1:i1*ntest));
          end
        end
        Eyt=Eyt(:);
      end
      Eft=Eft(:);
    end

  case 'FIC'
    % Check the tstind vector
    if nargin > 5
        if ~isempty(tstind) && length(tstind) ~= size(x,1)
            error('tstind (if provided) has to be of same lenght as x.')
        end
    else
        tstind = [];
    end

    u = gp.X_u;
    m = size(u,1);
    % Turn the inducing vector on right direction
    if size(u,2) ~= size(x,2)
        u=u';
    end
    % Calculate some help matrices
    [Kv_ff, Cv_ff] = gp_trvar(gp, x);  % 1 x f  vector
    K_fu = gp_cov(gp, x, u);   % f x u
    K_uu = gp_trcov(gp, u);     % u x u, noiseles covariance K_uu
    K_nu = gp_cov(gp,xt,u);       % n x u
    Luu = chol(K_uu,'lower');

    % Evaluate the Lambda (La) for specific model
    % Q_ff = K_fu*inv(K_uu)*K_fu'
    % Here we need only the diag(Q_ff), which is evaluated below
    B=Luu\(K_fu');
    Qv_ff=sum(B.^2)';
    Lav = Cv_ff-Qv_ff;   % 1 x f, Vector of diagonal elements
                         % iLaKfu = diag(inv(Lav))*K_fu = inv(La)*K_fu
    iLaKfu = zeros(size(K_fu));  % f x u,
    n=size(x,1)
    for i=1:n
        iLaKfu(i,:) = K_fu(i,:)./Lav(i);  % f x u
    end
    A = K_uu+K_fu'*iLaKfu;
    A = (A+A')./2;

    L = iLaKfu/chol(A);
    p = y./Lav - L*(L'*y);

    % Prediction matrices formed with only subset of cf's.
    if ~isempty(predcf)
        K_fu = gp_cov(gp, x, u, predcf);   % f x u
        K_uu = gp_trcov(gp, u, predcf);     % u x u, noiseles covariance K_uu
        K_nu = gp_cov(gp,xt,u,predcf);       % n x u
    end
    Eft = K_nu*(K_uu\(K_fu'*p));

    % if the prediction is made for training set, evaluate Lav also for prediction points
    if ~isempty(tstind)
        [Kv_ff, Cv_ff] = gp_trvar(gp, xt(tstind,:), predcf);
        Luu = chol(K_uu,'lower');
        B=Luu\(K_fu');
        Qv_ff=sum(B.^2)';
        Lav2 = zeros(size(Eft));
        Lav2(tstind) = Kv_ff-Qv_ff;
        Eft(tstind) = Eft(tstind) + Lav2(tstind).*p;
    end

    if nargout > 1
        [Knn_v, Cnn_v] = gp_trvar(gp,xt,predcf);
        Luu = chol(K_uu, 'lower');
        B=Luu\(K_fu');
        B2=Luu\(K_nu');
        Lav_n = Knn_v - sum(B2.^2)';
        BL = B*L;

        if isempty(tstind)
            error('tstind not provided.')
        end

        % if the prediction is made for training set, evaluate Lav also for prediction points
        if ~isempty(tstind)
          K = B'*B2 + diag(Lav_n);
          K2 = B2'*B2 + diag(Lav_n);
          C = B'*B + diag(Lav);

          L = chol(C,'lower');
          a = L'\(L\y);
          v = L\K;

          Covft = K2-v'*v;
        end
    end

    if nargout > 2
        Eyt = Eft;
        Covyt = Covft + diag(Cnn_v) - diag(Knn_v);
        if ~isempty(yt)
          ljpyt = mnorm_lpdf(yt', Eyt', Covyt);
        end
    end

  case {'PIC' 'PIC_BLOCK'}
    u = gp.X_u;
    ind = gp.tr_index;
    if size(u,2) ~= size(x,2)
        u=u';
    end

    % Calculate some help matrices
    [Kv_ff, Cv_ff] = gp_trvar(gp, x);  % 1 x f  vector
    K_fu = gp_cov(gp, x, u);         % f x u
    K_nu = gp_cov(gp, xt, u);         % n x u
    K_uu = gp_trcov(gp, u);    % u x u, noiseles covariance K_uu
    Luu = chol(K_uu)';

    % Evaluate the Lambda (La) for specific model
    % Q_ff = K_fu*inv(K_uu)*K_fu'
    % Here we need only the diag(Q_ff), which is evaluated below
    B=Luu\K_fu';
    iLaKfu = zeros(size(K_fu));  % f x u
    for i=1:length(ind)
        Qbl_ff = B(:,ind{i})'*B(:,ind{i});
        [Kbl_ff, Cbl_ff] = gp_trcov(gp, x(ind{i},:));
        La{i} = Cbl_ff - Qbl_ff;
        iLaKfu(ind{i},:) = La{i}\K_fu(ind{i},:);
    end
    A = K_uu+K_fu'*iLaKfu;
    A = (A+A')./2;            % Ensure symmetry
    L = iLaKfu/chol(A);

    tyy = y;
    % From this on evaluate the prediction
    % See Snelson and Ghahramani (2007) for details
    p=iLaKfu*(A\(iLaKfu'*tyy));
    for i=1:length(ind)
        p2(ind{i},:) = La{i}\tyy(ind{i},:);
    end
    p= p2-p;

    % Prediction matrices formed with only subsetof cf's.
    if ~isempty(predcf)
        K_fu = gp_cov(gp, x, u, predcf);        % f x u
        K_nu = gp_cov(gp, xt, u, predcf);         % n x u
        K_uu = gp_trcov(gp, u, predcf);          % u x u, noiseles covariance K_uu
    end

    iKuuKuf = K_uu\K_fu';
    w_bu=zeros(length(xt),length(u));
    w_n=zeros(length(xt),1);
    B2=Luu\(K_nu');
    for i=1:length(ind)
        w_bu(tstind{i},:) = repmat((iKuuKuf(:,ind{i})*p(ind{i},:))', length(tstind{i}),1);
        K_nf = gp_cov(gp, xt(tstind{i},:), x(ind{i},:),predcf);              % n x u
        w_n(tstind{i},:) = K_nf*p(ind{i},:);
        Qbl_ff = B2(:,tstind{i})'*B2(:,tstind{i});
        [Kbl_ff, Cbl_ff] = gp_trcov(gp, xt(tstind{i},:));
        La2{i} = Kbl_ff - Qbl_ff;
    end

    Eft = K_nu*(iKuuKuf*p) - sum(K_nu.*w_bu,2) + w_n;

    if nargout > 1
        % Form iLaKfu again if a subset of cf's is used for making predictions
        if ~isempty(predcf)
            iLaKfu = zeros(size(K_fu));  % f x u
            for i=1:length(ind)
                iLaKfu(ind{i},:) = La{i}\K_fu(ind{i},:);
            end
        end

%         kstarstar = gp_trvar(gp, xt, predcf);
%         KnuiKuu = K_nu/K_uu;
%         KufiLaKfu = K_fu'*iLaKfu;
%         QnfL = KnuiKuu*(K_fu'*L);
%         Covft1 = zeros(size(xt,1),size(xt,1));
%         Covft2 = zeros(size(xt,1),size(xt,1));
%         Covft3 = zeros(size(xt,1),size(xt,1));
%         C = B'*B;
%         KKnn = gp_trcov(gp,xt,predcf);
%         Knn = B2'*B2;
%         Knf = B2'*B;
%         KKnf = gp_cov(gp,xt,x,predcf);
%         for i=1:length(ind)
%             KubiLaKbu = K_fu(ind{i},:)'/La{i}*K_fu(ind{i},:);
%             nonblock = KufiLaKfu - KubiLaKbu;
%             Covft1(tstind{i}) = diag(KnuiKuu(tstind{i},:)*nonblock*KnuiKuu(tstind{i},:)');
%
%             Knb = gp_cov(gp, xt(tstind{i},:), x(ind{i},:), predcf);
%             Covft2(tstind{i}) = diag(Knb/La{i}*Knb');
%
%             KnbL = Knb*L(ind{i},:);
%             QnbL = KnuiKuu(tstind{i},:)*(K_fu(ind{i},:)'*L(ind{i},:));
%             %Covft3(tstind{i}) = sum(QnfL(tstind{i},:) - QnbL + KnbL,2);
%             Covft3(tstind{i}) = diag((QnfL(tstind{i},:) - QnbL + KnbL)*(QnfL(tstind{i},:) - QnbL + KnbL)');
%             C(ind{i},ind{i}) = C(ind{i},ind{i}) + La{i};
%             Knn(ind{i},ind{i}) = Knn(ind{i},ind{i}) + KKnn(tstind{i},tstind{i}) - B2(:,tstind{i})'*B2(:,tstind{i});
%             Knf(tstind{i},ind{i}) = Knf(tstind{i},ind{i}) + KKnf(tstind{i},ind{i}) - B2(:,tstind{i})'*B(:,ind{i});
%         end
%         L = chol(C,'lower');
%         v = L\Knf;
%         Covft = Knn-v'*v;
% %         Covft = kstarstar - (Covft1 + Covft2 - Covft3);       %MUUTETTU
%     end

        B2=Luu\(K_nu');
        C = B'*B;
        KKnn = gp_trcov(gp,xt,predcf);
        Knn = B2'*B2;
        Knf = B2'*B;
        KKnf = gp_cov(gp,xt,x,predcf);
        for i=1:length(ind)
            if (size(ind{i},1) ~= size(tstind{i},1))
                error('Testing and training block cell array vectors differ in size.');     % gp.tr_index and tstind
            end
            C(ind{i},ind{i}) = C(ind{i},ind{i}) + La{i};
            Knn(ind{i},ind{i}) = Knn(ind{i},ind{i}) + KKnn(tstind{i},tstind{i}) - B2(:,tstind{i})'*B2(:,tstind{i});
            Knf(tstind{i},ind{i}) = Knf(tstind{i},ind{i}) + KKnf(tstind{i},ind{i}) - B2(:,tstind{i})'*B(:,ind{i});
        end

        L = chol(C)';

        v = L\Knf';
        Covft = (Knn) - (v'*v);
    end

    if nargout > 2
        Eyt = Eft;
        [Knn_v, Cnn_v] = gp_trvar(gp,xt,predcf);
        Covyt = Covft + diag(Cnn_v) - diag(Knn_v);
        if ~isempty(yt)
          ljpyt = mnorm_lpdf(yt', Eyt', Covyt);
        end
    end
  case 'CS+FIC'
    % Here tstind = 1 if the prediction is made for the training set
    if nargin > 5
        if ~isempty(tstind) && length(tstind) ~= size(x,1)
            error('tstind (if provided) has to be of same lenght as x.')
        end
    else
        tstind = [];
    end

    n = size(x,1);
    n2 = size(xt,1);

    u = gp.X_u;
    m = size(u,1);
    ncf = length(gp.cf);

    % Indexes to all non-compact support and compact support covariances.
    cf1 = [];
    cf2 = [];
    % Indexes to non-CS and CS covariances, which are used for predictions
    predcf1 = [];
    predcf2 = [];

    % Loop through all covariance functions
    for i = 1:ncf
        % Non-CS covariances
        if ~isfield(gp.cf{i},'cs')
            cf1 = [cf1 i];
            % If used for prediction
            if ~isempty(find(predcf==i))
                predcf1 = [predcf1 i];
            end
        % CS-covariances
        else
            cf2 = [cf2 i];
            % If used for prediction
            if ~isempty(find(predcf==i))
                predcf2 = [predcf2 i];
            end
        end
    end
    if isempty(predcf1) && isempty(predcf2)
        predcf1 = cf1;
        predcf2 = cf2;
    end

    % Determine the types of the covariance functions used
    % in making the prediction.
    if ~isempty(predcf1) && isempty(predcf2)       % Only non-CS covariances
        ptype = 1;
        predcf2 = cf2;
    elseif isempty(predcf1) && ~isempty(predcf2)   % Only CS covariances
        ptype = 2;
        predcf1 = cf1;
    else                                           % Both non-CS and CS covariances
        ptype = 3;
    end

    % First evaluate needed covariance matrices
    % v defines that parameter is a vector
    [Kv_ff, Cv_ff] = gp_trvar(gp, x, cf1);  % f x 1  vector
    K_fu = gp_cov(gp, x, u, cf1);         % f x u
    K_uu = gp_trcov(gp, u, cf1);    % u x u, noiseles covariance K_uu
    K_uu = (K_uu+K_uu')./2;     % ensure the symmetry of K_uu

    Luu  = chol(K_uu)';
    K_nu = gp_cov(gp, xt, u, cf1);         % n x u

    % Evaluate the Lambda (La)
    % Q_ff = K_fu*inv(K_uu)*K_fu'
    B=Luu\(K_fu');       % u x f
    Qv_ff=sum(B.^2)';
    Lav = Cv_ff-Qv_ff;   % f x 1, Vector of diagonal elements

    K_cs = gp_trcov(gp,x,cf2);
    Kcs_nf = gp_cov(gp, xt, x, predcf2);
    Kcs_nn = gp_trcov(gp, xt, predcf2);
    La = sparse(1:tn,1:tn,Lav,tn,tn) + K_cs;

    iLaKfu = La\K_fu;
    A = K_uu+K_fu'*iLaKfu;
    A = (A+A')./2;     % Ensure symmetry
    L = iLaKfu/chol(A);

    p = La\y - L*(L'*y);

    %p2 = y./Lav - iLaKfu*(A\(iLaKfu'*y));
    %    Knf = K_nu*(K_uu\K_fu');

    K_fu = gp_cov(gp, x, u, predcf1);       % f x u
    K_uu = gp_trcov(gp, u, predcf1);         % u x u, noiseles covariance K_uu
    K_uu = (K_uu+K_uu')./2;                  % ensure the symmetry of K_uu
    K_nu = gp_cov(gp, xt, u, predcf1);        % n x u

    % Calculate the predictive mean according to the type of
    % covariance functions used for making the prediction
    if ptype == 1
        Eft = K_nu*(K_uu\(K_fu'*p));
    elseif ptype == 2
        Eft = Kcs_nf*p;
    else
        Eft = K_nu*(K_uu\(K_fu'*p)) + Kcs_nf*p;
    end

    % evaluate also Lav2 if the prediction is made for training set
    if ~isempty(tstind)
        [Kv_ff, Cv_ff] = gp_trvar(gp, xt(tstind,:), predcf1);
        Luu = chol(K_uu)';
        B=Luu\(K_fu');
        Qv_ff=sum(B.^2)';
        Lav2 = zeros(size(Eft));
        Lav2(tstind) = Kv_ff-Qv_ff;
    end

    % Add also Lav2 if the prediction is made for training set
    % and non-CS covariance function is used for prediction
    if ~isempty(tstind) && (ptype == 1 || ptype == 3)
        Eft(tstind) = Eft(tstind) + Lav2(tstind).*p;
    end

    if nargout > 1
        [Knn_v, Cnn_v] = gp_trvar(gp,xt,predcf);
        Luu = chol(K_uu, 'lower');
        B=Luu\(K_fu');
        B2=Luu\(K_nu');
        iLaKfu = La\K_fu;

        % Calculate the predictive variance according to the type
        % covariance functions used for making the prediction
        if ptype == 1 || ptype == 3
            % FIC part of the covariance
%             Covft = Knn_v - sum(B2'.*(B*(La\B')*B2)',2) +
%             sum((K_nu*(K_uu\(K_fu'*L))).^2, 2);             % MUUTETTU
            tmpmatr = (K_nu*(K_uu\(K_fu'*L)));
            Covft = B2'*B2 + Kcs_nn + sparse(1:n2,1:n2,Knn_v - sum(B2.^2)',n2,n2) - B2'*(B*(La\B')*B2) + tmpmatr*tmpmatr';
%             Covft = B2'*B2 + Kcs_nn - B2'*(B*(La\B')*B2) + tmpmatr*tmpmatr';

            % Add Lav2 if the prediction is made for the training set
            if  ~isempty(tstind)
                % Non-CS covariance
                if ptype == 1
                    Kcs_nf = sparse(tstind,1:n,Lav2(tstind),n2,n);
                % Non-CS and CS covariances
                else
                    Kcs_nf = Kcs_nf + sparse(tstind,1:n,Lav2(tstind),n2,n);
                end
                 % Add Lav2 and possibly Kcs_nf
                 tmpmatr = Kcs_nf/chol(La);
                 Covft = Covft - tmpmatr*tmpmatr';
                 tmpmatr = Kcs_nf*L;
                 Covft = Covft + tmpmatr*tmpmatr';
                 Covft = Covft - 2.*(Kcs_nf*iLaKfu)*(K_uu\K_nu') + 2.*(Kcs_nf*L)*(L'*K_fu*(K_uu\K_nu'));
            % In case of both non-CS and CS prediction covariances add
            % only Kcs_nf if the prediction is not done for the training set
            elseif ptype == 3
                tmpmatr = Kcs_nf/chol(La);
                Covft = Covft - tmpmatr*tmpmatr';
                tmpmatr = Kcs_nf*L;
                Covft = Covft + tmpmatr*tmpmatr';
                Covft = Covft - 2*(Kcs_nf*iLaKfu)*(K_uu\K_nu') + 2.*(Kcs_nf*L)*(L'*K_fu*(K_uu\K_nu'));
            end
        % Prediction with only CS covariance
        elseif ptype == 2
            Covft = Knn_v - sum((Kcs_nf/chol(La)).^2,2) + sum((Kcs_nf*L).^2, 2) ;

        end
    end

% $$$     Lav_pr = Kv_ff-Qv_ff;
% $$$     K2 = B'*B + K_cs + diag(Lav_pr);
% $$$     C = B'*B + K_cs + diag(Lav);
% $$$     K = B'*B + Kcs_nf + diag(Lav_pr);
% $$$
% $$$     L = chol(C)';
% $$$     %    y=K'*(C\y);
% $$$     a = L'\(L\y);
% $$$     Eft = K'*a;
% $$$
% $$$     v = L\K;
% $$$     V = gp_trvar(gp,xt,predcf);
% $$$     Covft = V - diag(v'*v);

    if nargout > 2
        Eyt = Eft;
        Covyt = Covft + diag(Cnn_v) - diag(Knn_v);
        if ~isempty(yt)
          ljpyt = mnorm_lpdf(yt', Eyt', Covyt);
        end
    end

  case {'VAR' 'DTC' 'SOR'}
    % Check the tstind vector
    if nargin > 5
        if ~isempty(tstind) && length(tstind) ~= size(tx,1)
            error('tstind (if provided) has to be of same lenght as tx.')
        end
    else
        tstind = [];
    end

    u = gp.X_u;
    m = size(u,1);
    % Turn the inducing vector on right direction
    if size(u,2) ~= size(x,2)
        u=u';
    end
    % Calculate some help matrices
    [Kv_ff, Cv_ff] = gp_trvar(gp, x);  % 1 x f  vector
    K_fu = gp_cov(gp, x, u);   % f x u
    K_uu = gp_trcov(gp, u);     % u x u, noiseles covariance K_uu
    K_nu = gp_cov(gp,xt,u);       % n x u
    Luu = chol(K_uu, 'lower');

    % Evaluate the Lambda (La) for specific model
    % Q_ff = K_fu*inv(K_uu)*K_fu'
    % Here we need only the diag(Q_ff), which is evaluated below
    B=Luu\(K_fu');
    Qv_ff=sum(B.^2)';
    Lav2 = diag(Cv_ff-Kv_ff);
    Lav = Cv_ff-Kv_ff;   % 1 x f, Vector of diagonal elements
                         % iLaKfu = diag(inv(Lav))*K_fu = inv(La)*K_fu
    iLaKfu = zeros(size(K_fu));  % f x u,
    n=size(x,1)
    for i=1:n
        iLaKfu(i,:) = K_fu(i,:)./Lav(i);  % f x u
    end
    A = K_uu+K_fu'*iLaKfu;
    A = (A+A')./2;

    L = iLaKfu/chol(A);
    p = y./Lav - L*(L'*y);

    % Prediction matrices formed with only subset of cf's.
    if ~isempty(predcf)
        K_fu = gp_cov(gp, x, u, predcf);   % f x u
        K_uu = gp_trcov(gp, u, predcf);     % u x u, noiseles covariance K_uu
        K_nu = gp_cov(gp,xt,u,predcf);       % n x u
    end
    Eft = K_nu*(K_uu\(K_fu'*p));

    if nargout > 1
%         [Knn_v, Cnn_v] = gp_trvar(gp,xt,predcf);
        [Knn_v, Cnn_v] = gp_trcov(gp,xt,predcf);
        Luu = chol(K_uu,'lower');
        B=Luu\(K_fu');
        B2=Luu\(K_nu');

        Covftr = sum(B2'.*(B*bsxfun(@ldivide,Lav2,B')*B2)',2) - sum((K_nu*(K_uu\(K_fu'*L))).^2, 2);
%         Covftr =
        switch gp.type
          case {'VAR' 'DTC'}
            Covft = Knn_v - Covftr;         % Knn_v = diag(K_*,*)
          case  'SOR'
            Covft = sum(B2.^2,1)' - Covftr;     % sum(B2.^2,1)' = diag(Q_*,*)
        end

    end
    if nargout > 2
        Eyt = Eft;
        switch gp.type
          case {'VAR' 'DTC'}
            Covyt = Covft + Cnn_v - Knn_v;
          case 'SOR'
            Covyt = Covft + Cnn_v - sum(B2.^2,1)';
        end
    end
    if nargout > 4
        pyt = norm_pdf(y, Eyt, sqrt(Covyt));
    end

  case 'SSGP'
    if nargin > 4
        error(['Prediction with a subset of original ' ...
               'covariance functions not currently implemented with SSGP']);
    end

    [Phi_f, S] = gp_trcov(gp, x);
    Phi_a = gp_trcov(gp, xt);
    m = size(Phi_f,2);
    ns = eye(m,m)*S(1,1);

    L = chol(Phi_f'*Phi_f + ns,'lower');
    Eft = Phi_a*(L'\(L\(Phi_f'*y)));

    if nargout > 1
        Covft = sum(Phi_a/L',2)*S(1,1);
    end
    if nargout > 2
        error('gp_pred with three output arguments is not implemented for SSGP!')
    end
end


function [dGf0, dHf0, mf, aveHbound, aveZi, lambda, gpfnsp] = calcdGHT(dGzero, dHzero, zi, nH, pHr, is, temp, chi, Legendre, LegendreCHI, printLevel)
% Calculates the standard transformed Gibbs energy of a reactant
%
% Reproduces the function of T (in Kelvin), pHa (electrode pH), and ionic strength (is) that
% gives the standard transformed Gibbs energy of formation of a reactant
% (sum of species) and the standard transformed enthalpy of a reactant.
%
% Assuming p pseudoisomer species corresponding to one reactant
%
% Optional output dependent on multiple precision toolbox
%
% USAGE:
%
%    [dGf0, dHf0, mf, aveHbound, aveZi, lambda, gpfnsp] = calcdGHT(dGzero, dHzero, zi, nH, pHr, is, temp, chi, Legendre, LegendreCHI, printLevel)
%
% INPUTS:
%    dGzero:         `p x 1` standard Gibbs energy of formation at 298.15 K
%    zi:             `p x 1` electric charge
%    nH:             `p x 1` number of hydrogen atoms in each species
%    pHr:            real pH of 5 to 9 (see realpH.m)
%    is:             ionic strength 0 to 0.35 M
%    temp:           temperature 273.15 K to 313.15 K
%
% OPTIONAL INPUT:
%    dHzero:         `p x 1` standard enthalpy of formation at 298.15 K
%    chi:            electrical potential
%    Legendre:       {(1), 0} Legendre Transformation for specifc pHr?
%    LegendreCHI:    {(1), 0} Legendre Transformation for specifc electrical potential?
%
% OUTPUT:
%    dGf0:           reactant standard transformed Gibbs energy of formation
%    dHf0:           reactant standard transformed enthalpy of formation
%    mf:             mole fraction of each species within a pseudoisomer group
%    aveHbound:      average number of protons bound to a reactant
%    aveZi:          average charge of a reactant
%    lambda:         activity coefficient for each metabolite species
%    gpfnsp:         metabolite species standard transformed Gibbs energy of formation
%
% OPTIONAL OUTPUT:
%
%    dHf0:           standard transformed enthalpy of formation
%
% The values of the standard transformed Gibbs energy of formation
% and the standard transformed enthalpy of formation can be calculated
% temperature in the range 273.15 K to 313.15 K, using the van't Hoff equation.
% `pHr` in the range 5 to 9 (these correspond to the pH range of the species in Alberty's tables)
% ionic strength in the range 0 to 0.35 M.
% See Mathematica program `calcdGHT p289 Alberty 2003`
%
% The changes in the values of standard transformed Gibbs energy of formation
% and the standard transformed enthalpy of formation might be improved if
% knowlegde of standard molar heat capacity was available for each species
% See `p41 Alberty 2003`
%
% Multiple Precision Toolbox for MATLAB by Ben Barrowes (mptoolbox_1.1)
% http://www.mathworks.com/matlabcentral/fileexchange/6446
%
% .. Author: -Ronan M.T. Fleming

if ~exist('printLevel','var')
    printLevel=0;
end

electricalTerm = 0; % initialize electricalTerm

if pHr<5 || pHr>9
    if 0
        error('pHr out of applicable range, 5 - 9.');
    else
        warning('pHr out of applicable range, 5 - 9.');
    end
end
if temp<273.15 || temp>313.15
    error('temperature out of applicable range, 273.15 - 313.15');
end
if is<0 || is>0.35
    error('ionic strength out of applicable range, 0 - 0.35');
end

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

%check if multiple precision toolbox is properly installed
if strcmp(which('mp'),'') || 1 %TODO install
    if printLevel>0
        fprintf('%s\n','No multiple precision toolbox: NaN returned if exp(x) gets too large');
    end
    R=8.31451;
    %Energies are expressed in kJ mol^-1.*)
    R=R/1000;
    %standard temperature with a capital T
    T=298.15;

    %Faraday Constant (kJ/mol)
    F=96.48; %kJ/mol

    p=9.20483;
    q=10^3;
    r=1.284668;
    s=10^5;
    u=4.95199;
    v=10^8;
    % Eq. 3.7-3 p48 Alberty 2003
    % Around 298.15K
    % alpha = 1.10708 - 1.54508*temp/(10^3) +5.95584*temp^2/(10^6)
    % Eq. 3.7-4 p49 Alberty 2003
    % R*T*alpha, where alpha is the temperature dependent coeffficient, sometimes A,
    % in the extended Debye-Huckel equation
    gibbscoeff = (9.20483*temp)/10^3 - (1.284668*temp^2)/10^5 + (4.95199*temp^3)/10^8;

    %If standard enthalpy of formation is known, and independent of
    %temperature an adjustment for temperature can be made.
    %(calcdGHT p289 Alberty 2003)
    if isempty(dHzero)
        %dGzeroT = (dGzero*temp)/T + dHzero*(1 - temp/T);
        dGzeroT = dGzero;%(dGzero*temp)/T + dHzero*(1 - temp/T);
    else
        % van't Hoff equation
        dGzeroT = (dGzero*temp)/T + dHzero*(1 - temp/T);
    end

    %pHr
    if Legendre
        %Eq. 4.4-9/10 p67 Alberty 2003
        %note the use of culture temperature
        pHterm = nH*R*temp*log(10^-pHr);
        %Eq 4.4-10 Alberty 2003 with temp dependent gibbscoeff
        istermG = (gibbscoeff*(zi.^2 - nH)*is^0.5)/(1 + 1.6*is^0.5);
    else
        %no Legendre transformation for pHr
        pHterm = 0;
        %Eq 3.6-3 Alberty 2003 with temp dependent gibbscoeff
        istermG = (gibbscoeff*(zi.^2)*is^0.5)/(1 + 1.6*is^0.5); %omit the -nH if  no Legendre
    end

    if LegendreCHI
        if 0
            %By convention, we assume the chemical potential of a metabolite
            %includes an electrical potential term
            % u = u0 + RT*log(activity) + F*zi*chi;
            %The Legendre transformation for electrical potential is
            % u' = u -  F*zi*chi = u0 + RT*log(activity);
            %So the following line will negate the effect of an electrical
            %potential ONLY if it has previously been added.
            electricalTerm=-(F*(chi/1000))*zi;
            %eq 8.5-1 p148 Alberty 2003
        else
            %Imaginary Legendre Transformation for Electrical Potential, to
            %take account of the fact that we have not previously added an
            %electrical potential term to the standard Gibbs energy.
            electricalTerm=0;
            %The charge and change in chemical potential for multiphase
            %reactions is taken into account in
            %deltaG0concFluxConstraintBounds.m
        end
    end

    %standard transformed Gibbs energy of each species
    gpfnsp = dGzeroT - pHterm - istermG - electricalTerm;

    %isomer group thermodynamic standard transformed Gibbs energy of
    %formation for a reactant with more than one metabolite species
    if length(dGzero)==1
        dGf0=gpfnsp;
    else
        %need to approximate log(sum(exp(-gpfnsp/(R*temp))));
        dGf0 = -R*temp*maxstar(-gpfnsp/(R*temp));
    end

    %Mole fraction
    %see 3.5-12 p45 Alberty 2003
    mf=exp((dGf0-gpfnsp)/(R*temp));
%     fprintf('%s\n','Cannot calculate mole fractions without multiple
%     precision toolbox');

    %activity coefficient
    lambda=double(exp(-(gibbscoeff*(zi.^2)*is^0.5)/(1 + 1.6*is^0.5)/(R*temp)));

    %average number of H+ ions bound by a reactant
    aveHbound=mf'*nH;

    %average charge of a reactant
    aveZi=mf'*zi;
%     fprintf('%s\n',int2str(length(dGzero)));

    %isomer group thermodynamic standard transformed Enthalpy of
    %formation for a reactant
    %%%%%%% makes script faster to leave this out for now.
    dHzero=[];
    if ~isempty(dHzero)
        %make temperature a smaller variable
        t=temp;
        switch length(dGzero)
            case 1
                %corresponds to Simplify[-(t^2*D[dGf0/t, t])] in Albertys code for
                %one species reactant
                %see Mathematica file dHfn.nb
                A=dGzero(1);
                B=dHzero(1);
                C=zi(1);
                D=nH(1);
                dHf0 =(B*(1+1.6*is^0.5)*s*v + (C^2)*(is^0.5)*(t^2)*(2*s*t*u-r*v)+D*(is^0.5)*(t^2)*(-2*s*t*u+r*v)) / ((1+1.6*is^0.5)*s*v);

                if isnan(dHf0)
                    error('No multiple precision toolbox: NaN returned if exp(x) gets too large')
                end
            case 2
                %see Mathematica file dHfn.nb
                A=dGzero(1);
                B=dHzero(1);
                C=zi(1);
                D=nH(1);
                a=dGzero(2);
                b=dHzero(2);
                c=zi(2);
                d=nH(2);
                %translated to matlab from mathematica by hand
                dHf0 =((10^-pHr)^d*exp(-(b*((1/t)-(1/T))+a/T-(((c^2-d)*is^0.5*(p*s*v+q*t*(s*t*u-r*v)))/((1+1.6*is^0.5)*q*s*v)))/R)*(b*(1+1.6*is^0.5)*s*v+...
                    c^2*is^0.5*t^2*(2*s*t*u-r*v)+d*is^0.5*t^2*(-2*s*t*u+r*v))+...
                    (10^-pHr)^D*exp(-(B*((1/t)-(1/T))+A/T-(((C^2-D)*is^0.5*(p*s*v+q*t*(s*t*u-r*v)))/((1+1.6*is^0.5)*q*s*v)))/R)*(B*(1+1.6*is^0.5)*s*v+...
                    C^2*is^0.5*t^2*(2*s*t*u-r*v)+D*is^0.5*t^2*(-2*s*t*u+r*v)))/...
                    (((10^-pHr)^d*exp((b*((-1/t)+(1/T))-a/T+(((c^2-d)*is^0.5*(p*s*v+q*t*(s*t*u-r*v)))/((1+1.6*is^0.5)*q*s*v)))/R)+...
                    (10^-pHr)^D*exp((B*((-1/t)+(1/T))-A/T+(((C^2-D)*is^0.5*(p*s*v+q*t*(s*t*u-r*v)))/((1+1.6*is^0.5)*q*s*v)))/R))*(1+1.6*is^0.5)*s*v);
                %         Mathematica Expression to Matlab m-file Converter by Harri Ojanen, Rutgers University
                %         dHfn2=((10.^((-1).*pHr)).^d.*exp(R.^(-1).*(b.*((-1).*t.^(-1)+T.^(-1))+(-1).*a.* ...
                %             T.^(-1)+0.1E1.*(c.^2+(-0.1E1).*d).*(0.1E1+0.16E1.*is.^0.5E0).^(-1).* ...
                %             is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+(-0.1E1).* ...
                %             r.*v))))+(10.^((-1).*pHr)).^D.*exp(R.^(-1).*(B.*((-1).*t.^(-1)+T.^(-1))+( ...
                %             -1).*A.*T.^(-1)+0.1E1.*(C.^2+(-0.1E1).*D).*(0.1E1+0.16E1.*is.^0.5E0).^( ...
                %             -1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+( ...
                %             -0.1E1).*r.*v))))).^(-1).*(0.1E1+0.16E1.*is.^0.5E0).^(-1).*s.^(-1).*v.^( ...
                %             -1).*((10.^((-1).*pHr)).^d.*exp((-1).*R.^(-1).*(b.*(t.^(-1)+(-1).*T.^(-1) ...
                %             )+a.*T.^(-1)+(-0.1E1).*(c.^2+(-0.1E1).*d).*(0.1E1+0.16E1.*is.^0.5E0).^( ...
                %             -1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+( ...
                %             -0.1E1).*r.*v)))).*(b.*(1+0.16E1.*is.^0.5E0).*s.*v+c.^2.*is.^0.5E0.* ...
                %             t.^2.*(0.2E1.*s.*t.*u+(-0.1E1).*r.*v)+d.*is.^0.5E0.*t.^2.*((-0.2E1).*s.* ...
                %             t.*u+r.*v))+(10.^((-1).*pHr)).^D.*exp((-1).*R.^(-1).*(B.*(t.^(-1)+(-1).* ...
                %             T.^(-1))+A.*T.^(-1)+(-0.1E1).*(C.^2+(-0.1E1).*D).*(0.1E1+0.16E1.* ...
                %             is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*( ...
                %             s.*t.*u+(-0.1E1).*r.*v)))).*(B.*(1+0.16E1.*is.^0.5E0).*s.*v+C.^2.* ...
                %             is.^0.5E0.*t.^2.*(0.2E1.*s.*t.*u+(-0.1E1).*r.*v)+D.*is.^0.5E0.*t.^2.*(( ...
                %             -0.2E1).*s.*t.*u+r.*v)));

                if isnan(dHf0)
                    %see Mathematica file dHfn.nb
                    error('No multiple precision toolbox: NaN returned if exp(x) gets too large')
                end
            case 3

                A=dGzero(1);
                B=dHzero(1);
                C=zi(1);
                D=nH(1);
                a=dGzero(2);
                b=dHzero(2);
                c=zi(2);
                d=nH(2);
                e=dGzero(3);
                f=dHzero(3);
                g=zi(3);
                h=nH(3);
                %see Mathematica file dHfn.nb
                %Mathematica Expression to Matlab m-file Converter by Harri Ojanen, Rutgers University
                dHf0 = ((10.^((-1).*pHr)).^d.*exp(R.^(-1).*(b.*((-1).*t.^(-1)+T.^(-1))+(-1).*a.* ...
                    T.^(-1)+0.1E1.*(c.^2+(-0.1E1).*d).*(0.1E1+0.16E1.*is.^0.5E0).^(-1).* ...
                    is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+(-0.1E1).* ...
                    r.*v))))+(10.^((-1).*pHr)).^D.*exp(R.^(-1).*(B.*((-1).*t.^(-1)+T.^(-1))+( ...
                    -1).*A.*T.^(-1)+0.1E1.*(C.^2+(-0.1E1).*D).*(0.1E1+0.16E1.*is.^0.5E0).^( ...
                    -1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+( ...
                    -0.1E1).*r.*v))))+(10.^((-1).*pHr)).^h.*exp(R.^(-1).*(f.*((-1).*t.^(-1)+ ...
                    T.^(-1))+(-1).*e.*T.^(-1)+0.1E1.*(g.^2+(-0.1E1).*h).*(0.1E1+0.16E1.* ...
                    is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*( ...
                    s.*t.*u+(-0.1E1).*r.*v))))).^(-1).*(0.1E1+0.16E1.*is.^0.5E0).^(-1).*s.^( ...
                    -1).*v.^(-1).*((10.^((-1).*pHr)).^d.*exp((-1).*R.^(-1).*(b.*(t.^(-1)+(-1) ...
                    .*T.^(-1))+a.*T.^(-1)+(-0.1E1).*(c.^2+(-0.1E1).*d).*(0.1E1+0.16E1.* ...
                    is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*( ...
                    s.*t.*u+(-0.1E1).*r.*v)))).*(b.*(1+0.16E1.*is.^0.5E0).*s.*v+c.^2.* ...
                    is.^0.5E0.*t.^2.*(0.2E1.*s.*t.*u+(-0.1E1).*r.*v)+d.*is.^0.5E0.*t.^2.*(( ...
                    -0.2E1).*s.*t.*u+r.*v))+(10.^((-1).*pHr)).^D.*exp((-1).*R.^(-1).*(B.*( ...
                    t.^(-1)+(-1).*T.^(-1))+A.*T.^(-1)+(-0.1E1).*(C.^2+(-0.1E1).*D).*(0.1E1+ ...
                    0.16E1.*is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.* ...
                    v+q.*t.*(s.*t.*u+(-0.1E1).*r.*v)))).*(B.*(1+0.16E1.*is.^0.5E0).*s.*v+ ...
                    C.^2.*is.^0.5E0.*t.^2.*(0.2E1.*s.*t.*u+(-0.1E1).*r.*v)+D.*is.^0.5E0.* ...
                    t.^2.*((-0.2E1).*s.*t.*u+r.*v))+(10.^((-1).*pHr)).^h.*exp((-1).*R.^(-1).* ...
                    (f.*(t.^(-1)+(-1).*T.^(-1))+e.*T.^(-1)+(-0.1E1).*(g.^2+(-0.1E1).*h).*( ...
                    0.1E1+0.16E1.*is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*( ...
                    p.*s.*v+q.*t.*(s.*t.*u+(-0.1E1).*r.*v)))).*(f.*(1+0.16E1.*is.^0.5E0).* ...
                    s.*v+g.^2.*is.^0.5E0.*t.^2.*(0.2E1.*s.*t.*u+(-0.1E1).*r.*v)+h.* ...
                    is.^0.5E0.*t.^2.*((-0.2E1).*s.*t.*u+r.*v)));

                %       dHf0 = ((10.^((-1).*pHr)).^d.*...
                %             exp(R.^(-1).*(b.*((-1).*t.^(-1)+T.^(-1))+(-1).*a.* ...
                %             T.^(-1)+0.1E1.*(c.^2+(-0.1E1).*d).*(1+1.6*is.^0.5).^(-1).* ...
                %             is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+(-0.1E1).* ...
                %             r.*v))))...
                %             +(10.^((-1).*pHr)).^D.*...
                %             exp(R.^(-1).*(B.*((-1).*t.^(-1)+T.^(-1))+( ...
                %             -1).*A.*T.^(-1)+0.1E1.*(C.^2+(-0.1E1).*D).*(1+1.6*is.^0.5).^( ...
                %             -1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+( ...
                %             -0.1E1).*r.*v))))...
                %             +(10.^((-1).*pHr)).^h.*...
                %             exp(R.^(-1).*(f.*((-1).*t.^(-1)+ ...
                %             T.^(-1))+(-1).*e.*T.^(-1)+0.1E1.*(g.^2+(-0.1E1).*h).*(0.1E1+0.16E1.* ...
                %             is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*( ...
                %             s.*t.*u+(-0.1E1).*r.*v))))...
                %             ).^(-1).*(1+1.6*is.^0.5).^(-1).*s.^(-1).*v.^(-1).*...%%% end of denominator
                %             ((10.^((-1).*pHr)).^d.*...
                %             exp((-1).*R.^(-1).*(b.*(t.^(-1)+(-1) ...
                %             .*T.^(-1))+a.*T.^(-1)+(-0.1E1).*(c.^2+(-0.1E1).*d).*(0.1E1+0.16E1.* ...
                %             is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*( ...
                %             s.*t.*u+(-0.1E1).*r.*v))))...
                %             .*(b*(1+1.6*is^0.5)*s*v...
                %             +c^2*is.^0.5*t^2*(2.*s.*t.*u-r*v)+d.*is.^0.5*t^2*(-2*s*t*u+r*v))...
                %             +(10.^((-1).*pHr)).^D.*...
                %             exp((-1).*R.^(-1).*(B.*( ...
                %             t.^(-1)+(-1).*T.^(-1))+A.*T.^(-1)+(-0.1E1).*(C.^2+(-0.1E1).*D).*(0.1E1+ ...
                %             0.16E1.*is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.* ...
                %             v+q.*t.*(s.*t.*u+(-0.1E1).*r.*v))))...
                %             .*(B.*(1+1.6*is.^0.5).*s.*v+ ...
                %             C.^2*is^0.5*t^2*(2*s*t*u-r*v)+D*is.^0.5*t^2*(-2*s*t*u+r*v))...
                %             +(10.^(-pHr)).^h.*...
                %             exp((-1).*R.^(-1).* ...
                %             (f.*(t.^(-1)+(-1).*T.^(-1))+e.*T.^(-1)+(-0.1E1).*(g.^2+(-0.1E1).*h).*( ...
                %             1+1.6*is.^0.5).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*( ...
                %             p.*s.*v+q.*t.*(s.*t.*u+(-0.1E1).*r.*v))))...
                %             *(f*(1+1.6*is.^0.5)*s*v+g^2*is^0.5*t.^2*(2*s*t*u-r*v)+h*is^0.5*t^2*(-2*s*t*u+r*v)));
                %
                %             denominatorInv = ((10.^((-1).*pHr)).^d.*...
                %             exp(R.^(-1).*(b.*((-1).*t.^(-1)+T.^(-1))+(-1).*a.* ...
                %             T.^(-1)+0.1E1.*(c.^2+(-0.1E1).*d).*(1+1.6*is.^0.5).^(-1).* ...
                %             is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+(-0.1E1).* ...
                %             r.*v))))...
                %             +(10.^((-1).*pHr)).^D.*...
                %             exp(R.^(-1).*(B.*((-1).*t.^(-1)+T.^(-1))+( ...
                %             -1).*A.*T.^(-1)+0.1E1.*(C.^2+(-0.1E1).*D).*(1+1.6*is.^0.5).^( ...
                %             -1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+( ...
                %             -0.1E1).*r.*v))))...
                %             +(10.^((-1).*pHr)).^h.*...
                %             exp(R.^(-1).*(f.*((-1).*t.^(-1)+ ...
                %             T.^(-1))+(-1).*e.*T.^(-1)+0.1E1.*(g.^2+(-0.1E1).*h).*(0.1E1+0.16E1.* ...
                %             is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*( ...
                %             s.*t.*u+(-0.1E1).*r.*v))))...
                %             ).^(-1).*(1+1.6*is.^0.5).^(-1).*s.^(-1).*v.^(-1);%%% end of denominator
                %
                %             dInv1=(10.^((-1).*pHr)).^d.*...
                %             exp(R.^(-1).*(b.*((-1).*t.^(-1)+T.^(-1))+(-1).*a.* ...
                %             T.^(-1)+0.1E1.*(c.^2+(-0.1E1).*d).*(1+1.6*is.^0.5).^(-1).* ...
                %             is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+(-0.1E1).* ...
                %             r.*v))));
                %
                %         dInv2=(10.^((-1).*pHr)).^D.*...
                %             exp(R.^(-1).*(B.*((-1).*t.^(-1)+T.^(-1))+( ...
                %             -1).*A.*T.^(-1)+0.1E1.*(C.^2+(-0.1E1).*D).*(1+1.6*is.^0.5).^( ...
                %             -1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+( ...
                %             -0.1E1).*r.*v))));
                %
                %         dInv3=(10.^((-1).*pHr)).^h.*...
                %             exp(R.^(-1).*(f.*((-1).*t.^(-1)+ ...
                %             T.^(-1))+(-1).*e.*T.^(-1)+0.1E1.*(g.^2+(-0.1E1).*h).*(0.1E1+0.16E1.* ...
                %             is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*( ...
                %             s.*t.*u+(-0.1E1).*r.*v))));
                %
                %         dinvEnd=(1+1.6*is.^0.5).^(-1).*s.^(-1).*v.^(-1);
                %
                %         denominatorInv=(dInv1+dInv2+dInv3)^-1*dinvEnd;
                %
                %
                %
                %
                %             numerator=((10.^((-1).*pHr)).^d.*...
                %             exp((-1).*R.^(-1).*(b.*(t.^(-1)+(-1) ...
                %             .*T.^(-1))+a.*T.^(-1)+(-0.1E1).*(c.^2+(-0.1E1).*d).*(0.1E1+0.16E1.* ...
                %             is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*( ...
                %             s.*t.*u+(-0.1E1).*r.*v))))...
                %             .*(b*(1+1.6*is^0.5)*s*v...
                %             +c^2*is.^0.5*t^2*(2.*s.*t.*u-r*v)+d.*is.^0.5*t^2*(-2*s*t*u+r*v))...
                %             +(10.^((-1).*pHr)).^D.*...
                %             exp((-1).*R.^(-1).*(B.*( ...
                %             t.^(-1)+(-1).*T.^(-1))+A.*T.^(-1)+(-0.1E1).*(C.^2+(-0.1E1).*D).*(0.1E1+ ...
                %             0.16E1.*is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.* ...
                %             v+q.*t.*(s.*t.*u+(-0.1E1).*r.*v))))...
                %             .*(B.*(1+1.6*is.^0.5).*s.*v+ ...
                %             C.^2*is^0.5*t^2*(2*s*t*u-r*v)+D*is.^0.5*t^2*(-2*s*t*u+r*v))...
                %             +(10.^(-pHr)).^h.*...
                %             exp((-1).*R.^(-1).* ...
                %             (f.*(t.^(-1)+(-1).*T.^(-1))+e.*T.^(-1)+(-0.1E1).*(g.^2+(-0.1E1).*h).*( ...
                %             1+1.6*is.^0.5).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*( ...
                %             p.*s.*v+q.*t.*(s.*t.*u+(-0.1E1).*r.*v))))...
                %             *(f*(1+1.6*is.^0.5)*s*v+g^2*is^0.5*t.^2*(2*s*t*u-r*v)+h*is^0.5*t^2*(-2*s*t*u+r*v)));
                %             dHf0=denominatorInv*numerator;

                if isnan(dHf0)
                    %see Mathematica file dHfn.nb
                    error('No multiple precision toolbox: NaN returned if exp(x) gets too large')
                end
            otherwise
                dHf0 = NaN;
        end
        if isnan(dHf0)
            %see Mathematica file dHfn.nb
            error('Too many species in reactant so standard transformed enthalpy is NaN')
        end
    else
        %changed to NaN 20 July 2009
        dHf0=NaN;
    end
else
    fprintf('%s\n','Using multiple precision toolbox');
    dGzero=mp(dGzero);
    dHzero=mp(dHzero);
    zi=mp(zi);
    nH=mp(nH);
    pHr=mp(pHr);
    is=mp(is);
    chi=mp(chi);
    %culture temp
    temp=mp(temp);

    R=mp(8.31451);
    %Energies are expressed in kJ mol^-1.*)
    R=R/1000;
    %standard temperature with a capital T
    T=mp(298.15);
    %Faraday Constant (kJ/mol)
    F=96.48; %kJ/mol
    F=mp(F);

    p=mp(9.20483);
    q=mp(10^3);
    r=mp(1.284668);
    s=mp(10^5);
    u=mp(4.95199);
    v=mp(10^8);

    %RTalpha p 49 Alberty 2003
    %where alpha is the Debye-Huckel Constant
    gibbscoeff = (9.20483*temp)/10^3 - (1.284668*temp^2)/10^5 + (4.95199*temp^3)/10^8;

    %If standard enthalpy of formation is known, and independent of
    %temperature an adjustment for temperature can be made.
    %(calcdGHT p289 Alberty 2003)
    if isempty(dHzero) || double(temp)==T;
        %dGzeroT = (dGzero*temp)/T + dHzero*(1 - temp/T);
        dGzeroT = dGzero;%(dGzero*temp)/T + dHzero*(1 - temp/T);
    else
        dGzeroT = (dGzero*temp)/T + dHzero*(1 - temp/T);
    end

    %pHr
    if Legendre
        %Eq. 4.4-9/10 p67 Alberty 2003
        %note the use of culture temperature
        pHterm = nH*R*temp*log(10^-pHr);
        %Eq 4.4-10 Alberty 2003 with temp dependent gibbscoeff
        istermG = (gibbscoeff*(zi.^2 - nH)*is^0.5)/(1 + 1.6*is^0.5);
    else
        %no Legendre transformation for pHr
        pHterm = 0;
        %Eq 3.6-3 Alberty 2003 with temp dependent gibbscoeff
        istermG = (gibbscoeff*(zi.^2)*is^0.5)/(1 + 1.6*is^0.5); %omit the -nH if  no Legendre
    end

    if LegendreCHI
        if 0
            %By convention, we assume the chemical potential of a metabolite
            %includes an electrical potential term
            % u = u0 + RT*log(activity) + F*zi*chi;
            %The Legendre transformation for electrical potential is
            % u' = u -  F*zi*chi = u0 + RT*log(activity);
            %So the following line will negate the effect of an electrical
            %potential ONLY if it has previously been added.
            electricalTerm=-(F*(chi/1000))*zi;
            %eq 8.5-1 p148 Alberty 2003
        else
            %Imaginary Legendre Transformation for Electrical Potential, to
            %take account of the fact that we have not previously added an
            %electrical potential term to the standard Gibbs energy.
            electricalTerm=0;
            %The charge and change in chemical potential for multiphase
            %reactions is taken into account in
            %deltaG0concFluxConstraintBounds.m
        end
    end

    %standard transformed Gibbs energy of each species
    gpfnsp = dGzeroT - pHterm - istermG - electricalTerm;

    %partition function
    pf=sum(exp(-gpfnsp/(R*temp)));

    %mole fraction
    if length(dGzero)==1
        mf=1;
    else
        %mole fraction of each species if there is more than one
        lin_gpfnsp=exp(-gpfnsp/(R*temp));
        %cast back into a double
        mf=double(lin_gpfnsp/pf);
    end

    %activity coefficient
    lambda=double(exp(-(gibbscoeff*(zi.^2)*is^0.5)/(1 + 1.6*is^0.5)/(R*temp)));

    %average number of H+ ions bound by a reactant
    aveHbound=mf'*double(nH);

    %average number of H+ ions bound by a reactant
    aveZi=mf'*double(zi);

    %isomer group thermodynamic standard transformed Gibbs energy of
    %formation for a reactant with more than one metabolite species
    if length(dGzero)==1
        dGf0=gpfnsp;
    else
        dGf0 = -R*temp*log(pf);
    %     dGf0 = -R*temp*maxstar(-gpfnsp/(R*temp));
    end

    %isomer group thermodynamic standard transformed Enthalpy of
    %formation for a reactant
    %%%%%%% makes script faster to leave this out for now.
    dHzero=[];
    %%%%%%%
    if ~isempty(dHzero)
        %make temperature a smaller variable
        t=temp;
        switch length(dGzero)
            case 1
                %corresponds to Simplify[-(t^2*D[dGf0/t, t])] in Albertys code for
                %one species reactant
                %see Mathematica file dHfn.nb
                A=dGzero(1);
                B=dHzero(1);
                C=zi(1);
                D=nH(1);
                dHf0 =(B*(1+1.6*is^0.5)*s*v + (C^2)*(is^0.5)*(t^2)*(2*s*t*u-r*v)+D*(is^0.5)*(t^2)*(-2*s*t*u+r*v)) / ((1+1.6*is^0.5)*s*v);
            case 2
                %see Mathematica file dHfn.nb
                A=dGzero(1);
                B=dHzero(1);
                C=zi(1);
                D=nH(1);
                a=dGzero(2);
                b=dHzero(2);
                c=zi(2);
                d=nH(2);
                %translated to matlab from mathematica by hand
                dHf0 =((10^-pHr)^d*exp(-(b*((1/t)-(1/T))+a/T-(((c^2-d)*is^0.5*(p*s*v+q*t*(s*t*u-r*v)))/((1+1.6*is^0.5)*q*s*v)))/R)*(b*(1+1.6*is^0.5)*s*v+...
                    c^2*is^0.5*t^2*(2*s*t*u-r*v)+d*is^0.5*t^2*(-2*s*t*u+r*v))+...
                    (10^-pHr)^D*exp(-(B*((1/t)-(1/T))+A/T-(((C^2-D)*is^0.5*(p*s*v+q*t*(s*t*u-r*v)))/((1+1.6*is^0.5)*q*s*v)))/R)*(B*(1+1.6*is^0.5)*s*v+...
                    C^2*is^0.5*t^2*(2*s*t*u-r*v)+D*is^0.5*t^2*(-2*s*t*u+r*v)))/...
                    (((10^-pHr)^d*exp((b*((-1/t)+(1/T))-a/T+(((c^2-d)*is^0.5*(p*s*v+q*t*(s*t*u-r*v)))/((1+1.6*is^0.5)*q*s*v)))/R)+...
                    (10^-pHr)^D*exp((B*((-1/t)+(1/T))-A/T+(((C^2-D)*is^0.5*(p*s*v+q*t*(s*t*u-r*v)))/((1+1.6*is^0.5)*q*s*v)))/R))*(1+1.6*is^0.5)*s*v);
                %         Mathematica Expression to Matlab m-file Converter by Harri Ojanen, Rutgers University
                %         dHfn2=((10.^((-1).*pHr)).^d.*exp(R.^(-1).*(b.*((-1).*t.^(-1)+T.^(-1))+(-1).*a.* ...
                %             T.^(-1)+0.1E1.*(c.^2+(-0.1E1).*d).*(0.1E1+0.16E1.*is.^0.5E0).^(-1).* ...
                %             is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+(-0.1E1).* ...
                %             r.*v))))+(10.^((-1).*pHr)).^D.*exp(R.^(-1).*(B.*((-1).*t.^(-1)+T.^(-1))+( ...
                %             -1).*A.*T.^(-1)+0.1E1.*(C.^2+(-0.1E1).*D).*(0.1E1+0.16E1.*is.^0.5E0).^( ...
                %             -1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+( ...
                %             -0.1E1).*r.*v))))).^(-1).*(0.1E1+0.16E1.*is.^0.5E0).^(-1).*s.^(-1).*v.^( ...
                %             -1).*((10.^((-1).*pHr)).^d.*exp((-1).*R.^(-1).*(b.*(t.^(-1)+(-1).*T.^(-1) ...
                %             )+a.*T.^(-1)+(-0.1E1).*(c.^2+(-0.1E1).*d).*(0.1E1+0.16E1.*is.^0.5E0).^( ...
                %             -1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+( ...
                %             -0.1E1).*r.*v)))).*(b.*(1+0.16E1.*is.^0.5E0).*s.*v+c.^2.*is.^0.5E0.* ...
                %             t.^2.*(0.2E1.*s.*t.*u+(-0.1E1).*r.*v)+d.*is.^0.5E0.*t.^2.*((-0.2E1).*s.* ...
                %             t.*u+r.*v))+(10.^((-1).*pHr)).^D.*exp((-1).*R.^(-1).*(B.*(t.^(-1)+(-1).* ...
                %             T.^(-1))+A.*T.^(-1)+(-0.1E1).*(C.^2+(-0.1E1).*D).*(0.1E1+0.16E1.* ...
                %             is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*( ...
                %             s.*t.*u+(-0.1E1).*r.*v)))).*(B.*(1+0.16E1.*is.^0.5E0).*s.*v+C.^2.* ...
                %             is.^0.5E0.*t.^2.*(0.2E1.*s.*t.*u+(-0.1E1).*r.*v)+D.*is.^0.5E0.*t.^2.*(( ...
                %             -0.2E1).*s.*t.*u+r.*v)));
            case 3
                A=dGzero(1);
                B=dHzero(1);
                C=zi(1);
                D=nH(1);
                a=dGzero(2);
                b=dHzero(2);
                c=zi(2);
                d=nH(2);
                e=dGzero(3);
                f=dHzero(3);
                g=zi(3);
                h=nH(3);
                %see Mathematica file dHfn.nb
                %Mathematica Expression to Matlab m-file Converter by Harri Ojanen, Rutgers University
                dHf0 = ((10.^((-1).*pHr)).^d.*exp(R.^(-1).*(b.*((-1).*t.^(-1)+T.^(-1))+(-1).*a.* ...
                    T.^(-1)+0.1E1.*(c.^2+(-0.1E1).*d).*(0.1E1+0.16E1.*is.^0.5E0).^(-1).* ...
                    is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+(-0.1E1).* ...
                    r.*v))))+(10.^((-1).*pHr)).^D.*exp(R.^(-1).*(B.*((-1).*t.^(-1)+T.^(-1))+( ...
                    -1).*A.*T.^(-1)+0.1E1.*(C.^2+(-0.1E1).*D).*(0.1E1+0.16E1.*is.^0.5E0).^( ...
                    -1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*(s.*t.*u+( ...
                    -0.1E1).*r.*v))))+(10.^((-1).*pHr)).^h.*exp(R.^(-1).*(f.*((-1).*t.^(-1)+ ...
                    T.^(-1))+(-1).*e.*T.^(-1)+0.1E1.*(g.^2+(-0.1E1).*h).*(0.1E1+0.16E1.* ...
                    is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*( ...
                    s.*t.*u+(-0.1E1).*r.*v))))).^(-1).*(0.1E1+0.16E1.*is.^0.5E0).^(-1).*s.^( ...
                    -1).*v.^(-1).*((10.^((-1).*pHr)).^d.*exp((-1).*R.^(-1).*(b.*(t.^(-1)+(-1) ...
                    .*T.^(-1))+a.*T.^(-1)+(-0.1E1).*(c.^2+(-0.1E1).*d).*(0.1E1+0.16E1.* ...
                    is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.*v+q.*t.*( ...
                    s.*t.*u+(-0.1E1).*r.*v)))).*(b.*(1+0.16E1.*is.^0.5E0).*s.*v+c.^2.* ...
                    is.^0.5E0.*t.^2.*(0.2E1.*s.*t.*u+(-0.1E1).*r.*v)+d.*is.^0.5E0.*t.^2.*(( ...
                    -0.2E1).*s.*t.*u+r.*v))+(10.^((-1).*pHr)).^D.*exp((-1).*R.^(-1).*(B.*( ...
                    t.^(-1)+(-1).*T.^(-1))+A.*T.^(-1)+(-0.1E1).*(C.^2+(-0.1E1).*D).*(0.1E1+ ...
                    0.16E1.*is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*(p.*s.* ...
                    v+q.*t.*(s.*t.*u+(-0.1E1).*r.*v)))).*(B.*(1+0.16E1.*is.^0.5E0).*s.*v+ ...
                    C.^2.*is.^0.5E0.*t.^2.*(0.2E1.*s.*t.*u+(-0.1E1).*r.*v)+D.*is.^0.5E0.* ...
                    t.^2.*((-0.2E1).*s.*t.*u+r.*v))+(10.^((-1).*pHr)).^h.*exp((-1).*R.^(-1).* ...
                    (f.*(t.^(-1)+(-1).*T.^(-1))+e.*T.^(-1)+(-0.1E1).*(g.^2+(-0.1E1).*h).*( ...
                    0.1E1+0.16E1.*is.^0.5E0).^(-1).*is.^0.5E0.*q.^(-1).*s.^(-1).*v.^(-1).*( ...
                    p.*s.*v+q.*t.*(s.*t.*u+(-0.1E1).*r.*v)))).*(f.*(1+0.16E1.*is.^0.5E0).* ...
                    s.*v+g.^2.*is.^0.5E0.*t.^2.*(0.2E1.*s.*t.*u+(-0.1E1).*r.*v)+h.* ...
                    is.^0.5E0.*t.^2.*((-0.2E1).*s.*t.*u+r.*v)));
            otherwise
                dHf0 = NaN;
        end
        if isnan(dHf0)
            %see Mathematica file dHfn.nb
%             error('Too many species in reactant so standard transformed enthalpy is NaN')
            fprintf('%s\n','Too many species in reactant so standard transformed enthalpy is NaN')
        end
        %cast back into normal matlab double
        dHf0=double(dHf0);
    else
        %changed to NaN 20 July 2009
        dHf0=NaN;
    end
    %cast back into normal matlab double
    dGf0=double(dGf0);
    gpfnsp=double(gpfnsp);
end

%
%This is a helper function to compute the log(sum(exp(v))) of a vector v
function y = maxstar(x, w, dim)
% maxstar   Log of a sum of exponentials.
%   For vectors, maxstar(x) is equivalent to log(sum(exp(x))).
%   For matrices, maxstar(x) is a row vector and maxstar operates on
%   each column of x. For N-D arrays, maxstar(x) operates along the
%   first non-singleton dimension.
%
%   maxstar(x,w) is the log of a weighted sum of exponentials,
%   equivalent to log(sum(w.*exp(x))). Vectors w and x must be
%   the same length. For matrix x, the weights w can be input as
%   a matrix the same size as x, or as a vector of the same length
%   as columns of x. Weights may be zero or negative, but the result
%   sum(w.*exp(x)) must be greater than zero.
%
%   maxstar(x, [], dim) operates along the dimension dim, and has
%   the same dimensions as the MATLAB function max(x, [], dim).
%
%   Note:
%   The max* function is described in Lin & Costello, Error Control
%   Coding, 2nd Edition, equation 12.127, in the two-argument form
%     max*(x1,x2) = max(x1,x2) + log(1 + exp(-abs(x1-x2))).
%   The function max* can be applied iteratively:
%     max*(x1,x2,x3) = max*(max*(x1,x2),x3).
%   Functions max(x) ~ max*(x), and min(x) ~ -max*(-x).
%
%   Algorithm:
%   The double precision MATLAB expresson log(sum(exp(x))) fails
%   if all(x < -745), or if any(x > 706). This is avoided using
%   m = max(x) in  max*(x) = m + log(sum(exp(x - m))).
%
%   Example: If x = [2 8 4
%                    7 3 9]
%
%   then maxstar(x,[],1) is [7.0067 8.0067 9.0067],
%
%   and  maxstar(x,[],2) is [8.0206
%                            9.1291].

% 2006-02-10   R. Dickson
% 2006-03-25   Implemented N-D array features following a suggestion
%              from John D'Errico.
%
%   Uses: max, log, exp, sum, shiftdim, repmat, size, zeros, ones,
%         length, isempty, error, nargin, find, reshape

if nargin < 1 || nargin > 3
    error('Wrong number of input arguments.');
end

[x, n] = shiftdim(x);
szx = size(x);

switch nargin
    case 1
        w = [];
        dim = 1;
    case 2
        dim = 1;
    case 3
        dim = dim - n;
end

if isempty(w)
    % replicate m = max(x) to get mm, with size(mm) == size(x)
    m = max(x,[],dim);
    szm = ones(size(szx));
    szm(dim) = szx(dim);
    mm = repmat(m,szm);
    y = m + log(sum(exp(x - mm), dim));
else
    w = shiftdim(w);
    szw = size(w);
    % protect the second condition with a short-circuit or
    if ~(length(szw) == length(szx)) || ~all(szw == szx)
        if size(w,1) == size(x,dim)
            % replicate w with repmat so size(w) == size(x)
            szw = ones(size(szx));
            szw(dim) = size(w,1);
            w = reshape(w, szw);
            szr = szx;
            szr(dim) = 1;
            w = repmat(w, szr);
        else
            error('Length of w must match size(x,dim).');
        end
    end

    % Move the weight into the exponent xw and find
    % m = max(xw) over terms with positive weights
    ipos = find(w>0);
    xw = -Inf*zeros(szx);
    xw(ipos) = x(ipos) + log(w(ipos));
    m = max(xw,[],dim);
    % replicate m with repmat so size(mm) == size(x)
    szm = ones(size(szx));
    szm(dim) = szx(dim);
    mm = repmat(m,szm);
    exwp = zeros(szx);
    exwp(ipos) = exp(xw(ipos)-mm(ipos));
    % check for terms with negative weights
    ineg = find(w<0);
    if ~isempty(ineg)
        exwn = zeros(szx);
        exwn(ineg) = exp(x(ineg) + log(-w(ineg)) - mm(ineg));
        y = m + log(sum(exwp, dim) - sum(exwn, dim));
    else
        y = m + log(sum(exwp, dim));
    end
end
%


function [ m, n, nz_num, base ] = r8cc_read_size ( col_file, row_file )

%*****************************************************************************80
%
%% R8CC_READ_SIZE reads the sizes of a R8CC sparse matrix from a file.
%
%  Discussion:
%
%    The value of M is "guessed" to be the largest value that occurs in
%    the ROW file.  However, if a row index of 0 is encountered, then
%    the value of M is incremented by 1.
%
%    The value of N is the number of records in the COL file minus 1.
%
%    The value of NZ_NUM is simply the number of records in the ROW file.
%
%    The value of BASE is 0 or 1, depending on whether the program
%    "guesses" that the row and column indices are 0-based or 1-based.
%    Although the first entry of the COL array might be used as evidence,
%    this program makes its determination based on whether it encounters
%    a 0 index in the ROW file.
%
%    The R8CC format is the double precision sparse compressed column
%    format.  Associated with this format, we have an M by N matrix
%    with NZ_NUM nonzero entries.  We construct the column pointer
%    vector COL of length N+1, such that entries of column J will be
%    stored in positions COL(J) through COL(J+1)-1.  This indexing
%    refers to both the ROW and A vectors, which store the row indices
%    and the values of the nonzero entries.  The entries of the
%    ROW vector corresponding to each column are assumed to be
%    ascending sorted.
%
%    The R8CC format is equivalent to the MATLAB "sparse" format,
%    and the Harwell Boeing "real unsymmetric assembled" (RUA) format.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 September 2006
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Iain Duff, Roger Grimes, John Lewis,
%    User's Guide for the Harwell-Boeing Sparse Matrix Collection,
%    October 1992
%
%  Parameters:
%
%    Input, string COL_FILE, ROW_FILE, the names of the
%    column and row files that describe the structure of the matrix.
%
%    Output, integer M, N, the inferred number of rows and columns
%    in the sparse matrix.
%
%    Output, integer NZ_NUM, the number of nonzero entries in the
%    sparse matrix.
%
%    Output, integer BASE, is 0 if the row indexing is believed
%    to be 0-based, and 1 if the row-index is believed to be
%    1-based.  In uncertain cases, BASE = 1 is the default.
%

%
%  Default values.
%
  m = -1;
  n = -1;
  nz_num = -1;
  base = -1;
%
%  Check the COL file first.
%
  input_unit = fopen ( col_file );

  if ( input_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8CC_READ_SIZE - Fatal error!\n' );
    fprintf ( 1, '  Could not open the file "%s".\n', col_file );
    error ( 'R8CC_READ_SIZE - Fatal error!' );
    return;
  end

  n = -1;

  while ( 1 )

    [ col, count ] = fscanf ( input_unit, '%d', 1 );

    if ( count ~= 1 )
      break;
    end

    n = n + 1;

  end

  fclose ( input_unit );
%
%  Check the ROW file.
%
  input_unit = fopen ( row_file );

  if ( input_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8CC_READ_SIZE - Fatal error!\n' );
    fprintf ( 1, '  Could not open the file "%s".\n', row_file );
    error ( 'R8CC_READ_SIZE - Fatal error!' );
    return;
  end

  base = 1;
  m = 0;
  nz_num = 0;

  while ( 1 )

    [ row, count ] = fscanf ( input_unit, '%d', 1 );

    if ( count ~= 1 )
      break;
    end

    nz_num = nz_num + 1;
    m = max ( m, row );
    if ( row == 0 )
      base = 0;
    end

  end

  fclose ( input_unit );

  return
end


function [lf, vol] = eeg_leadfield4(R, elc, vol)

% EEG_LEADFIELD4 electric leadfield for a dipole in 4 concentric spheres
%
% [lf] = eeg_leadfield4(R, elc, vol)
%
% with input arguments
%   R          position of the dipole
%   elc        position of the electrodes
% and vol being a structure with the elements
%   vol.r      radius of the 4 spheres
%   vol.cond   conductivity of the 4 spheres
%   vol.t      constant factors for series expansion (optional)
%
% The center of the spheres should be at the origin.
%
% This implementation is adapted from
%   Lutkenhoner, Habilschrift 1992.
% The original reference is
%  Cuffin BN, Cohen D. Comparison of the magnetoencephalogram and electroencephalogram. Electroencephalogr Clin Neurophysiol. 1979 Aug;47(2):132-46.
%
% See also EEG_LEADFIELD4_PREPARE for precomputing the constant factors,
% which can save time when multiple leadfield computations are done.

% Copyright (C) 2002, Robert Oostenveld
%
% This file is part of FieldTrip, see http://www.fieldtriptoolbox.org
% for the documentation and details.
%
%    FieldTrip 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.
%
%    FieldTrip 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 FieldTrip. If not, see <http://www.gnu.org/licenses/>.
%
% $Id$

% sort the spheres from the smallest to the largest
[vol.r, indx] = sort(vol.r);
vol.cond      = vol.cond(indx);

% use more convenient names for the radii and conductivities
r1 = vol.r(1); c1 = vol.cond(1);
r2 = vol.r(2); c2 = vol.cond(2);
r3 = vol.r(3); c3 = vol.cond(3);
r4 = vol.r(4); c4 = vol.cond(4);

% check whether the electrode ly on the sphere, allowing 0.5% tolerance
dist = sqrt(sum(elc.^2,2));
if any(abs(dist-r4)>r4*0.005)
  ft_warning('electrodes do not ly on sphere surface -> using projection')
end
elc = r4 * elc ./ [dist dist dist];

% check whether the dipole is inside the brain [disabled for EEGLAB]
% if sqrt(sum(R.^2))>=r1
%   ft_error('dipole is outside the brain compartment');
% end

% rotate everything so that the dipole is along the pos. z-axis
% only if the dipole is not in the origin or along the positive z-axis
if R(1)~=0 || R(2)~=0
  % compute the rotation matrix
  % the inverse rotation matrix is the transposed of this one
  val1 = norm(R);
  val2 = norm(R(1:2));
  rot(1,1) = R(1) * R(3) / (val1 * val2);
  rot(1,2) = R(2) * R(3) / (val1 * val2);
  rot(1,3) = -1.0 * val2 / val1;
  rot(2,1) = -1.0 * R(2) / val2;
  rot(2,2) =        R(1) / val2;
  rot(2,3) =                  0;
  rot(3,:) = R ./ val1;
  % rotate the electrodes
  elc = elc*rot';
elseif R(1)==0 && R(2)==0 && R(3)<0
  % dipole on negative z-axis, this case is very simple: reflect on xy-plane
  elc(:,3) = -elc(:,3);
else
  % dipole is on positive z-axis, nothing has to be done
end

% compute the constant factors for the sphere configuration if needed
if ~isfield(vol, 't')
  vol.t = eeg_leadfield4_prepare(vol);
end

Nchans = size(elc,1);
lf     = zeros(Nchans,3);
Nmax   = length(vol.t);
n      = 1:Nmax;
f      = norm(R)/r4;        % following cuffin1979
% c      = r2/r4;       % following cuffin1979
% d      = r3/r4;       % following cuffin1979

% this code is to cross-validate the lutkenhoner and cuffin implementations
% [lut_t, cuf_t] = eeg_leadfield4_prepare(vol);
% lut_c = (2*n+1).^4.*f.^(n-1) ./ (lut_t.*4*pi*c4*r4^2);
% cuf_c = (2*n+1).^4.*f.^(n-1) .*(c*d).^(2.*n+1) ./ (cuf_t.*4*pi*c4*r4^2);

% given a fixed volume conductor, these only need to be computed once for all electrodes
const = (2*n+1).^4.*f.^(n-1) ./ (vol.t.*4*pi*c4*r4^2);

for i=1:Nchans
  % convert the position of the electrodes to spherical coordinates
  [phi, el] = cart2sph(elc(i,1), elc(i,2), elc(i,3));

  % change from colatitude to latitude and compute the cosine
  cos_theta = cos(pi/2-el);

  % the series summation starts at zero
  s_x = 0;
  s_z = 0;

  for n=1:Nmax
    P0  = plgndr(n,0,cos_theta);        % zero'th order Legendre
    P1  = plgndr(n,1,cos_theta);        % first order Legendre
    s_x = s_x + const(n)*P1/n;          % s_y is identical
    s_z = s_z + const(n)*P0;
  end

  lf(i,1) = -cos(phi) * s_x;
  lf(i,2) = -sin(phi) * s_x;            % s_y is identical to s_x
  lf(i,3) = 1         * s_z;
end

% apply the inverse rotation to the leadfield matrix
if R(1)~=0 || R(2)~=0
  lf = lf*rot;
elseif R(1)==0 && R(2)==0 && R(3)<0
  lf(:,3) = -lf(:,3);
end


function stats = rsquare_multiple_regions_multilevel(Y, X, varargin)
% Predict outcome var (y) using data from multiple vars (X, e.g., brain regions)
% Test R-square against permuted data
%
% :Usage:
% ::
%
%     stats = rsquare_multiple_regions_multilevel(Y, X, varargin)
%
% :Inputs: Variable args
%
%   **'colors':**
%        followed by colors cell ({'r' 'g' 'b'}) for each col. of X
%
%   **'nperms:**
%        then num perms
%
% :Examples:
% ::
%
%    % SETUP data
%    cl = [clpos_data clneg_data];
%
%    cl(cat(1, cl.numVox) < min_cluster_size) = [];
%
%    % get brain data cell
%    for i = 1:size(cl(1).all_data, 2)
%        for c = 1:length(cl)
%            data{i}(:,c) = cl(c).all_data(:, i);
%        end
%    end
%
%    % NMDS ANALYSIS
%    OUT = [];
%
%    OUT.ridge = matrix_direct_effects_ridge(data);
%    D = OUT.ridge.mean; D(find(eye(size(D)))) = 1;
%    D = (D' + D) ./ 2;
%    OUT.ridge.D = (1 - D) ./ 2;
%    [OUT.stats_mds.GroupSpace,OUT.stats_mds.obs,OUT.stats_mds.implied_dissim] = shepardplot(OUT.ridge.D,[]);
%
%    OUT.stats_mds = nmdsfig_tools('cluster_solution',OUT.stats_mds, OUT.stats_mds.GroupSpace, 2:max_networks, nperms, []);
%    OUT.stats_mds.colors = {'ro' 'go' 'bo' 'yo' 'co' 'mo' 'ko' 'r^' 'g^' 'b^' 'y^' 'c^' 'm^' 'k^'};
%    create_figure('nmdsfig');
%
%    OUT.stats_mds.names = [];
%    nmdsfig(OUT.stats_mds.GroupSpace,'classes',OUT.stats_mds.ClusterSolution.classes,'names',OUT.stats_mds.names,'sig',OUT.ridge.fdrsig);
%    hh = nmdsfig_fill(OUT.stats_mds);
%    axis image; axis equal
%
%
%    % Multiple regions predict behavior
%
%    % Design matrix with cluster averages
%    classes = OUT.stats_mds.ClusterSolution.classes;
%    clear X
%    for i = 1:length(data)
%        for j = 1:max(classes)
%            X{i}(:, j) = nanmean(data{i}(:, classes == j), 2);
%        end
%    end
%
%    OUT.stats_regression = rsquare_multiple_regions_multilevel(acc_x_dist, X, 'colors', OUT.stats_mds.colors, 'nperms', 100);
%
% ..
%    Tor Wager, June 2008
%
%    var args not all done yet (in development)
% ..

nperms = 100;

for i = 1:length(varargin)
        if ischar(varargin{i})
            switch varargin{i}

                    % functional commands
                case 'colors', colors = varargin{i+1};

                case 'nperms', nperms = varargin{i + 1};

                otherwise, warning(['Unknown input string option:' varargin{i}]);
            end
        end
end

%% initial model fits, all together, then separately to get order
stats = glmfit_multilevel(Y, X, ones(length(X), 1), 'weighted');

nvars = size(X{1}, 2);

for i = 1:nvars
    for s = 1:length(X)
        Xr{s} = [X{s}(:, i)]; % reduced model, with only this regressor.
    end

    stats_ind = glmfit_multilevel(Y, Xr, ones(length(X), 1), 'weighted');
    stats.separate_reg_pvals(i) = stats_ind.p(2);

end

%%% **** Notes: should do best 1, then best combo of 2, best 3...etc ****
%%% permute additional param after best combo from prev. step

%% Predicting using variable # regions
[tmp, myorder] = sort(stats.separate_reg_pvals); % eliminate intercept
stats.myorder = myorder;

for i = 1:length(myorder)

    for s = 1:length(X)

        Xr{s} = [ones(size(X{s}, 1), 1) X{s}(:, myorder(1:i))]; % reduced model, with regressors ordered by predictive accuracy.

        [B,BINT,R,RINT,sstats] = regress(Y{s}, Xr{s});

        r2(s, i) = sstats(1);

    end

end

create_figure('R-squared'); barplot_columns(r2, 'R-squared', [], 'nofig', 'noind');
xlabel('Number of networks in model');
ylabel('Average R^2 value');

if exist('colors', 'var') && ~isempty(colors)

    for i = 1:size(r2, 2)
        hbar(i) = bar(i, nanmean(r2(:, i)), 'FaceColor', colors{myorder(i)}(1));
    end

end

stats.observed_r2 = r2;

drawnow

%% permutation

clear permindx
for i = 1:length(X)
    permindx{i} = permute_setupperms(size(X{i}, 1), nperms);

    %Xrp{s} = [ones(size(X{s}, 1), 1) X{s}(:, myorder(1:i))]; % reduced model, with regressors ordered by predictive accuracy.

end

[r2meanp, b1mean] = deal(zeros(nperms, length(myorder)));

%%
for p = 1:nperms

    fprintf('%3.0f ', p);

    if mod(p, 20) == 0, fprintf(1, '\n'); end

    [r2, bb] = deal(zeros(length(X), length(myorder)));

    for i = 1:length(myorder)

        for s = 1:length(X)

            % Method 1: Permute all variables (permute data)
            Xr{s} = [ones(size(X{s}, 1), 1) X{s}(:, myorder(1:i))]; % reduced model, with regressors ordered by predictive accuracy.

            Yp{s} = Y{s}(permindx{s}(p, :)', :); % permute

% %             % Method 2: Permute only the i:endth regressors
% %             % part to not permute: conditional on this being in model
% %             Xsnp = X{s}(:, myorder(1:i-1));
% %
% %             % part to permute: if everything else were random...
% %             Xsp = X{s}(:, myorder(i:end));
% %             Xsp = Xsp(permindx{s}(p, :)', :); % permute
% %             Xr{s} = [ones(size(X{s}, 1), 1) Xsnp Xsp]; % reduced model, with regressors ordered by predictive accuracy.
% %             Yp{s} = Y{s};

            [B,BINT,R,RINT,sstats] = regress(Yp{s}, Xr{s});

            r2(s, i) = sstats(1);

            bb(s, i) = B(2);

            % %         Xrp_ml{s} = [X{s}(permindx{s}(p, :)', myorder(1:i))]; % reduced model, with regressors ordered by predictive accuracy.

        end

        % %     stats = glmfit_multilevel(Y, Xrp_ml, ones(length(X), 1), 'weighted', 'noverbose');
        % %     multilev_pvals{i}(p, :) = stats.p;

    end

    r2meanp(p, :) = nanmean(r2);

    b1mean(p, :) = nanmean(bb);

end

fprintf(1, '\n');

bar((1:nvars) + .2, mean(r2meanp), 'FaceColor', [.2 .2 .2]);

%% Z-scores and p-values based on perm dist
fp = r2meanp > repmat(nanmean(stats.observed_r2, 1), nperms, 1);

stats.permute.pvals = sum(double(fp), 1) ./ nperms;

yval = nanmean(stats.observed_r2) + .15 * nanmean(stats.observed_r2);

wh = find(stats.permute.pvals <= .001);
if ~isempty(wh), for i = 1:length(wh), text(wh(i), yval(wh(i)), '***', 'FontSize', 18); end, end

wh = find(stats.permute.pvals <= .01 & stats.permute.pvals > .001);
if ~isempty(wh), for i = 1:length(wh), text(wh(i), yval(wh(i)), '**', 'FontSize', 18); end, end

wh = find(stats.permute.pvals <= .05 & stats.permute.pvals > .01);
if ~isempty(wh), for i = 1:length(wh), text(wh(i), yval(wh(i)), '*', 'FontSize', 18); end, end

%%
disp('Added .permute field to stats output strucuture.');
stats.permute.nperms = nperms;
stats.permute.r2meanp = r2meanp;
stats.permute.r2mean_ub = prctile(stats.permute.r2meanp, 95);
stats.permute.permindx = permindx;

stats.permute.b1mean = b1mean;


function [params] = pf_calc(params)
% function [params] = pf_calc(params)
% -----------------------------------
% Calculation of the probabilistic forecast test.
%
% Input parameters:
%   params.mCatalog           Earthquake catalog
%   params.mPolygon           Polygon (defined by ex_selectgrid)
%   params.vX                 X-vector (defined by ex_selectgrid)
%   params.vY                 Y-vector (defined by ex_selectgrid)
%   params.vUsedNodes         Used nodes vX * vY defining the mPolygon (defined by ex_selectgrid)
%   params.bRandom            Perform random simulation (=1) or real calculation (=0)
%   params.nCalculation       Number of random simulations
%   params.bMap               Calculate a map (=1) or a cross-section (=0)
%   params.bNumber            Use constant number (=1) or constant radius (=0)
%   params.nNumberEvents      Number of earthquakes if bNumber == 1
%   params.fRadius            Radius of gridnode if bNumber == 0
%   params.nMinimumNumber     Minimum number of earthquakes per node for determining a b-value
%   params.fForecastPeriod    Forecasting period in years
%   params.bLearningPeriod    Use different learning period than the rest of the catalog
%   params.fLearningPeriod    Learning period in years
%   params.bSignificance      Calculate significance during random simulation
%                             using params.fRealProbability
%   params.fRealProbability   Probability of calculation with real data
%   params.nCalculateMC       Method to calculate magnitude of completeness (see also: help calc_Mc)
%   params.nTestMethod        Method to calculate the Kagan & Jackson test (see also: help kj_poissonian)
%   params.bMinMagMc          Use magnitude of completeness as lower limit of magnitude range for testing (=1)
%                             Use params.fMinMag as lower limit (=0)
%   params.fMinMag            Lower limit of magnitude range for testing
%   params.fMaxMag            Upper limit of magnitude range for testing
%
% Output parameters:
%   Same as input parameters including
%   params.mValueGrid         Matrix of calculated Kagan & Jackson test values
%   params.vRandomMeans       Vector of means of probability differences per simulation run
%   params.vSignificanceLevel Vector of significance levels per simulation run
%   params.fBValueOverall     Calculated overall b-value
%   params.fStdDevOverall     Calculated standard deviation
%   params.fMcOverall         Calculated magnitude of completeness
%
% Danijel Schorlemmer
% April 24, 2002

global bDebug;
if bDebug
  report_this_filefun(mfilename('fullpath'));
end

% Init variable
% params.mRandomDist = [];

% Create random probability-ratios
% --------------------------------
if (params.bRandomNode) | (params.bRandomArea)
  if params.bForceRandomCalculation
    % Init the matrix of random probability-ratios (node-wise) for all calculations
    mRandomDist_ = [];
  else
    try
      mRandomDist_ = params.mRandomDist;
    catch
      mRandomDist_ = [];
    end
  end
  if isempty(mRandomDist_)
    % Loop over the calculations
    for nCnt_ = 1:params.nNumberCalculationNode
      % Init the vector of probability-ratios for one simulation
      vRandomDist_ = [];
      % Randomize catalog
      mRandomCatalog_ = params.mCatalog;
      mRandomCatalog_(:,6) = params.mCatalog(randperm(length(params.mCatalog)), 6);
      % Loop over the grid
      for nNode_ = 1:length(params.mPolygon(:,1))
        % Create catalog of given gridnode
        mNodeCatalog_ = mRandomCatalog_(params.caNodeIndices{nNode_}, :);
        % Calculate the probability-ratio
        [rCalcNodeResult_] = pf_CalcNode(mNodeCatalog_, params.fSplitTime, params.bLearningPeriod, params.fLearningPeriod, ...
          params.bForecastPeriod, params.fForecastPeriod, params.nCalculateMC, params.fMcOverall, params.bMinMagMc, ...
          params.fMinMag, params.fMaxMag, params.nTestMethod, params.nMinimumNumber, params.fBValueOverall, params.fStdDevOverall);
        % Store it into the vector
        vRandomDist_ = [vRandomDist_; rCalcNodeResult_.fProbDiff];
      end % of for nNode_
      % Store the vector into the matrix
      mRandomDist_ = [mRandomDist_ vRandomDist_];
    end % of for nCnt_
    params.mRandomDist = mRandomDist_;
  end
end % of if (params.bRandomNode) | (params.bRandomArea)

% Perform the real calculation
% ----------------------------
% Init result matrix
mValueGrid_ = [];
% Loop over all grid nodes
for nNode_ = 1:length(params.mPolygon(:,1))
  % Create node catalog
  mNodeCatalog_ = params.mCatalog(params.caNodeIndices{nNode_}, :);
  % Calculate the probability-ratio
  [rCalcNodeResult_] = pf_CalcNode(mNodeCatalog_, params.fSplitTime, params.bLearningPeriod, params.fLearningPeriod, ...
    params.bForecastPeriod, params.fForecastPeriod, params.nCalculateMC, params.fMcOverall, params.bMinMagMc, ...
    params.fMinMag, params.fMaxMag, params.nTestMethod, params.nMinimumNumber, params.fBValueOverall, params.fStdDevOverall);
  % Calculate the significnance of the probability-ratio
  if params.bRandomNode
    fSignificanceLevel_ = kj_calcsig(rCalcNodeResult_.fProbDiff, mRandomDist_(nNode_,:), 2);
    fSignificanceLevel_ = fSignificanceLevel_ - 50;
    fSignificanceLevel_ = fSignificanceLevel_ * (-2); % Flip it (we want to be positive)
    fNormSignificanceLevel_ = kj_CalcNormSig(mRandomDist_(nNode_,:), rCalcNodeResult_.fProbDiff);
    fNormSignificanceLevel_ = fNormSignificanceLevel_ - 50;
    fNormSignificanceLevel_ = fNormSignificanceLevel_ * (-2); % Flip it (we want to be positive)
  else % of if params.bRandomNode
    fSignificanceLevel_ = nan;
    fNormSignificanceLevel_ = nan;
  end % of if params.bRandomNode
  % Store the results
  mValueGrid_= [mValueGrid_; fSignificanceLevel_ fNormSignificanceLevel_ rCalcNodeResult_.fProbDiff ...
      rCalcNodeResult_.fProbK rCalcNodeResult_.fProbO rCalcNodeResult_.nEventsLearning rCalcNodeResult_.nEventsObserved ...
      rCalcNodeResult_.fWeightK rCalcNodeResult_.fWeightO params.fBValueOverall rCalcNodeResult_.fBValueO rCalcNodeResult_.fMc];
end % for nNode
params.vcsGridNames = cellstr(char('Significance level', 'Significance level (normal distribution)', 'Probability difference', 'Kagan & Jackson', 'Our model', 'Number events in learning period', ...
  'Number events in forecasting period', 'Weighting of the overall b-value', 'Weighting of the node b-value', ...
  'b-value used for Kagan & Jackson model', 'b-value used for our model', 'Magnitude of completeness'));
params.mValueGrid = mValueGrid_;
% params.mRandomDist = mRandomDist_;

% % Perform the random simulation over the area
% % -------------------------------------------
% if params.bRandomArea
%   % Init matrix for significance values (n-times per gridnode)
%   mSignificanceGrid_ = [];
%   % Loop over the calculations
%   for nCnt_ = 1:params.nNumberCalculationArea
%     % Randomize catalog
%     mRandomCatalog_ = params.mCatalog;
%     mRandomCatalog_(:,6) = params.mCatalog(randperm(length(params.mCatalog)), 6);
%     % Init vector for significance values of one calculation over the entire grid
%     vSignificanceGrid_ = [];
%     % Loop over the grid
%     for nNode_ = 1:length(params.mPolygon(:,1))
%       % Create node catalog
%       mNodeCatalog_ = mRandomCatalog_(params.caNodeIndices{nNode_}, :);
%       % Calculate the probability-ratio
%       [rCalcNodeResult_] = pf_CalcNode(mNodeCatalog_, params.fSplitTime, params.bLearningPeriod, params.fLearningPeriod, ...
%         params.bForecastPeriod, params.fForecastPeriod, params.nCalculateMC, params.fMcOverall, params.bMinMagMc, ...
%         params.fMinMag, params.fMaxMag, params.nTestMethod, params.nMinimumNumber, params.fBValueOverall, params.fStdDevOverall);
%       % Calculate the significnance of the probability-ratio
%       fSignificanceLevel_ = kj_calcsig(rCalcNodeResult_.fProbDiff, mRandomDist_(nNode_,:), 2);
%       fSignificanceLevel_ = fSignificanceLevel_ - 50;
%       fSignificanceLevel_ = fSignificanceLevel_ * (-2); % Flip it (we want to be positive)
%       %       fNormSignificanceLevel_ = kj_CalcNormSig(mRandomDist_(nNode_,:), rCalcNodeResult_.fProbDiff);
%       %       fNormSignificanceLevel_ = fNormSignificanceLevel_ - 50;
%       %       fNormSignificanceLevel_ = fNormSignificanceLevel_ * (-2); % Flip it (we want to be positive)
%       % Store it into the vector
%       vSignificanceGrid_ = [vSignificanceGrid_ fSignificanceLevel_];
%     end % of for nNode_
%     % Store the vector into the matrix
%     mSignificanceGrid_ = [mSignificanceGrid_; vSignificanceGrid_];
%   end % of for nCnt_
% params.mSignificanceGrid = mSignificanceGrid_;
%
% % Evaluate overall significance
% % -----------------------------
%
% % Has to be set in the dialog
params.fSignificanceLevel = 95;
% % Compute the number of grid nodes with significant values
vSel_ = mValueGrid_(:,1) > params.fSignificanceLevel;
params.nRealPositive_ = sum(vSel_);
vSel_ = mValueGrid_(:,1) < -params.fSignificanceLevel;
params.nRealNegative_ = sum(vSel_);
% % Display them
disp(['Number positive: ' num2str(params.nRealPositive_)]);
disp(['Number negative: ' num2str(params.nRealNegative_)]);
%
% mRandomPositive_ = [];
% mRandomNegative_ = [];
%
% for nCnt_ = 1:params.nNumberCalculationArea
%  vSel_ = mSignificanceGrid_(nCnt_,:) > params.fSignificanceLevel;
%   %mTempGrid_ = mSignificanceGrid_(nCnt_,vSel_);
%   mRandomPositive_ = [mRandomPositive_; sum(vSel_)];
%
%  vSel_ = mSignificanceGrid_(nCnt_,:) < -params.fSignificanceLevel;
%   %mTempGrid_ = mSignificanceGrid_(nCnt_,vSel_);
%   mRandomNegative_ = [mRandomNegative_; sum(vSel_)];
% end
%
% fPositiveSignificance = kj_calcsig(nRealPositive_, mRandomPositive_, 3);
% fNegativeSignificance = kj_calcsig(nRealNegative_, mRandomNegative_, 3);
%
% disp(['Positive significance: ' num2str(fPositiveSignificance)]);
% disp(['Negative significance: ' num2str(fNegativeSignificance)]);
% end % of if params.bRandomArea