function [hPlot] = plot_FMDboth(mCatalog, fMc, fAvalue, fBvalue, fBinning, nMinNum)
% function [hPlot, fBValue, fAValue, fStdDev, fMc, fMeanMag]
%   = plot_FMD(mCatalog, bCumulative, hAxes, sSymbol, sColor, bPlotB, nCalculateMC, fBinning)
% -------------------------------------------------------------------------------------------
% Plots a cumulative and non-cumulative frequency magnitude distribution including the b-value
%
% plot_FMD(mCatalog) opens a figure and plots the frequency magnitude distribution
%   with standard parameters
%
% Input parameters:
%   mCatalog        Earthquake catalog
%   fMc             Magnitude of completeness
%   fAValue         Calculateda-value
%   fBValue         Calculated b-value
%   fBinning        Magnitude binning of the catalog (default 0.1)
%   nMinNum         Minimum number of events
%
% Output parameters:
%   hPlot           Handle of the plot
%
% jowoe@gps.caltech.edu
% 25.01.2006

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

% Catalog size
[nRow,nCol] = size(mCatalog);

% Create the frequency magnitude distribution vector
[vFMD, vNonCFMD] = calc_FMD(mCatalog);

if ~exist('fBinning', 'var')
  fBinning = 0.1;
end

figure
% Plot cumulative frequency magnitude distribution
hPlot = semilogy(vFMD(1,:), vFMD(2,:));
set(hPlot,'Marker','^','MarkerEdgeColor',[0 0 0],'MarkerFaceColor',[0.75 0.75 0.75],'Markersize',8,'Linewidth',2,'Linestyle','none');
hold on
hPlot2 = semilogy(vNonCFMD(1,:), vNonCFMD(2,:));
set(hPlot2,'Marker','d','MarkerEdgeColor',[0 0 0],'MarkerFaceColor',[0.4 0.4 0.4],'Markersize',8,'Linewidth',2,'Linestyle','none');

% Add further plots to the axes
set(gca, 'NextPlot', 'add');

if (~isnan(fMc) & ~isnan(fBvalue) & nRow >= 2*nMinNum)
    % Determine the positions of 'x'-markers
    nIndexLo = find((vFMD(1,:) < fMc + 0.05) & (vFMD(1,:) > fMc - 0.05));
    fMagHi = vFMD(1,1);
    vSel = vFMD(1,:) <= fMagHi & vFMD(1,:) >= fMc-.0001;
    vMagnitudes = vFMD(1,vSel);

    % Plot the 'x'-marker
    hPlot = semilogy(vFMD(1,nIndexLo), vFMD(2,nIndexLo), 'x','Color',[0.8 0 0]);
    set(hPlot, 'LineWidth', [2.5], 'MarkerSize', 12);
    hPlot = semilogy(vFMD(1,1), vFMD(2,1), 'x','Color',[0.8 0 0]);
    set(hPlot, 'LineWidth', [2.5], 'MarkerSize', 12)

    % Plot the line representing the b-value
    vPoly = [-1*fBvalue fAvalue];
    fBFunc = 10.^(polyval(vPoly, vMagnitudes));
    hPlot = semilogy(vMagnitudes, fBFunc);
    set(hPlot, 'LineWidth', [2.0],'Linestyle','--','Color',[0.8 0 0]);
end
% Y-Limits
vYLim = get(gca,'YLim');
set(gca,'FontSize',12','Fontweight','bold','box','on','Ylim',[1 vYLim(2)],'Linewidth',1.5)
xlabel('Magnitude','FontSize',14','Fontweight','bold')
ylabel('Number of events','FontSize',14','Fontweight','bold')


% SCRIPT TEST FOR THE KINEMATIC PROBLEM FOR SERIAL ROBOTS

% Copyright (C) 2012, by Arturo Gil Aparicio
%
% This file is part of ARTE (A Robotics Toolbox for Education).
%
% ARTE is free software: you can redistribute it and/or modify
% it under the terms of the GNU Lesser General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% ARTE 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 Lesser General Public License for more details.
%
% You should have received a copy of the GNU Leser General Public License
% along with ARTE.  If not, see <http://www.gnu.org/licenses/>.
%
% qinv =
%
%          0         0         0         0    3.1416    3.1416    3.1416    3.1416
%    -0.0412   -0.0412    1.6597    1.6597   -1.5798   -1.5798   -0.3550   -0.3550
%     0.0720    0.0720    3.0696    3.0696   -0.3825   -0.3825   -2.7591   -2.7591
%     0.0000   -3.1416    3.1416   -0.0000    0.0000    3.1416    0.0000   -3.1416
%    -0.0308    0.0308   -1.5539    1.5539   -1.1793    1.1793   -0.0275    0.0275
%    -0.0000    3.1416   -3.1416         0    3.1416   -0.0000    3.1416   -0.0000

function test_kinematics_irb140

close all

fprintf('\nTHE DEMO PRESENTS THE DIRECT AND INVERSE KINEMATIC PROBLEM')

%load robot parameters. You can try different robots%
robot=load_robot('ABB', 'IRB140');
%adjust 3D view as desired
adjust_view(robot)

% reach this!
T =[0.0000   -0.0000    1.0000    0.4000;
   -0.0000    1.0000    0.0000   -0.0000;
   -1.0000   -0.0000    0.0000    0.6000;
   0         0         0    1.0000];

%Call the inversekinematic for this robot. All the possible solutions are
%stored at qinv. At least, one of the possible solutions should match q
qinv = inversekinematic(robot, T)

test_joints(robot, qinv)

test_solutions(robot, qinv, T);

test_movement(robot, qinv, T);

function test_movement(robot, qinv, T)

q0 = [0, 0, 0, 0, 0, 0];
n = 5
for i=1:size(qinv,2)
   qq = [];
   qi = qinv(:,i);
   for j=1:6
        v = linspace(q0(j), qi(j), n);
        qq = [qq; v];
   end
   animate(robot, qq)
end

function test_solutions(robot, qinv, T)
n_solutions = 8;

fprintf('\nNOW WE CAN REPRESENT THE DIFFERENT SOLUTIONS TO ACHIEVE THE SAME POSITION AND ORIENTATION\n')
fprintf('\nNote that some solutions may not be feasible since some joints may be out of range.\n')
correct=zeros(1,n_solutions);
%check that all of them are possible solutions!
for i=1:size(qinv,2)

    Ti = directkinematic(robot, qinv(:,i)) %Ti is constant for the different solutions

    % Note that all the solutions may not be feasible. Some of the joints may
    % be out of range. You can test this situation with test_joints
    test_joints(robot, qinv(:,i));

    %now draw the robot to see the solution
    drawrobot3d(robot, qinv(:,i))

    pause(0.5);

    k=sum(sum((T-Ti).^2));
    if k < 0.01 % a simple threshold to find differences in the solution
        correct(1,i)= 1;
    else
        correct(1,i)= 0; %uncorrect solution
        fprintf('\nERROR: One of the solutions seems to be uncorrect. Sum of errors: %f', i, k);
    end
end

fprintf('\n************** RESULTS **************')

%Display a message if any of the solutions is not correct
if sum(correct)==n_solutions
    fprintf('\nTEST 1--> OK: Every solution in qinv yields the same position/orientation T');
else
    fprintf('\nTEST 1--> ERROR: One or more of the solutions seem to be uncorrect.');
end

fprintf('\n************** ****** **************\n')


% -----------------------------------------------------------------------------------------------------
function pyramid = make_scale_pyramid(im, targetPosition, in_side_scaled, out_side, avgChans, stats, p)
%MAKE_SCALE_PYRAMID
%   computes a pyramid of re-scaled copies of the target (centered on TARGETPOSITION)
%   and resizes them to OUT_SIDE. If crops exceed image boundaries they are padded with AVGCHANS.
%
%   Luca Bertinetto, Jack Valmadre, Joao F. Henriques, 2016
% -----------------------------------------------------------------------------------------------------
    in_side_scaled = round(in_side_scaled);
    pyramid = gpuArray(zeros(out_side, out_side, 3, p.numScale, 'single'));
    max_target_side = in_side_scaled(end);
    min_target_side = in_side_scaled(1);
    beta = out_side / min_target_side;
    % size_in_search_area = beta * size_in_image
    % e.g. out_side = beta * min_target_side
    search_side = round(beta * max_target_side);
    [search_region, ~] = get_subwindow_tracking(im, targetPosition, [search_side search_side], [max_target_side max_target_side], avgChans);
    if p.subMean
        search_region = bsxfun(@minus, search_region, reshape(stats.x.rgbMean, [1 1 3]));
    end
    assert(round(beta * min_target_side)==out_side);

    for s = 1:p.numScale
        target_side = round(beta * in_side_scaled(s));
        pyramid(:,:,:,s) = get_subwindow_tracking(search_region, (1+search_side*[1 1])/2, [out_side out_side], target_side*[1 1], avgChans);
    end
end


filename='CantileverBeam_Triangle_Linear_Fine';
ptype = 'MACRO';
method = 'SIMPALL';
materialType = 'ISOTROPIC';
initial_case = 'full';
cost = {'compliance'};
weights = [1];
constraint = {'volumeConstraint'};
optimizer = 'DualNestedInPrimal';
optimizerUnconstrained = 'SLERP';
incrementFactor = 1;
designVariable = 'LevelSet';
filterType = 'P1';
constraint_case = 'INEQUALITY';
line_search_initiator = 'STANDARD';
showBC = true;

nsteps = 50;
Vfrac_final = 0.3;
Perimeter_target = 1;
optimality_final = 1e-3;
constr_final =1e-3;

Vfrac_initial = 1;
optimality_initial = 1e-2;
constr_initial = 1e-3;
TOL.rho_plus = 1;
TOL.rho_minus = 0;
TOL.E_plus = 1;
TOL.E_minus = 1e-3;
TOL.nu_plus = 1/3;
TOL.nu_minus = 1/3;

monitoring_interval = 1;
optimalityInitial = 1e-3;


function [positions, time] = tracker(video_path, img_files, pos, target_sz, ...
    padding, kernel, lambda1, lambda2, output_sigma_factor, interp_factor, cell_size, ...
    features, show_visualization)
%TRACKER Kernelized/Dual Correlation Filter (KCF/DCF) tracking.
%   This function implements the pipeline for tracking with the KCF (by
%   choosing a non-linear kernel) and DCF (by choosing a linear kernel).
%
%   It is meant to be called by the interface function RUN_TRACKER, which
%   sets up the parameters and loads the video information.
%
%   Parameters:
%     VIDEO_PATH is the location of the image files (must end with a slash
%      '/' or '\').
%     IMG_FILES is a cell array of image file names.
%     POS and TARGET_SZ are the initial position and size of the target
%      (both in format [rows, columns]).
%     PADDING is the additional tracked region, for context, relative to
%      the target size.
%     KERNEL is a struct describing the kernel. The field TYPE must be one
%      of 'gaussian', 'polynomial' or 'linear'. The optional fields SIGMA,
%      POLY_A and POLY_B are the parameters for the Gaussian and Polynomial
%      kernels.
%     OUTPUT_SIGMA_FACTOR is the spatial bandwidth of the regression
%      target, relative to the target size.
%     INTERP_FACTOR is the adaptation rate of the tracker.
%     CELL_SIZE is the number of pixels per cell (must be 1 if using raw
%      pixels).
%     FEATURES is a struct describing the used features (see GET_FEATURES).
%     SHOW_VISUALIZATION will show an interactive video if set to true.
%
%   Outputs:
%    POSITIONS is an Nx2 matrix of target positions over time (in the
%     format [rows, columns]).
%    TIME is the tracker execution time, without video loading/rendering.
%
%   Joao F. Henriques, 2014

	%if the target is large, lower the resolution, we don't need that much
	%detail
	resize_image = (sqrt(prod(target_sz)) >= 100);  %diagonal size >= threshold
	if resize_image,
		pos = floor(pos / 2);
		target_sz = floor(target_sz / 2);
	end

	%window size, taking padding into account
	window_sz = floor(target_sz * (1 + padding));

% 	%we could choose a size that is a power of two, for better FFT
% 	%performance. in practice it is slower, due to the larger window size.
% 	window_sz = 2 .^ nextpow2(window_sz);

	%create regression labels, gaussian shaped, with a bandwidth
	%proportional to target size
	output_sigma = sqrt(prod(target_sz)) * output_sigma_factor / cell_size;
	yf = fft2(gaussian_shaped_labels(output_sigma, floor(window_sz / cell_size)));

	%store pre-computed cosine window
	cos_window = hann(size(yf,1)) * hann(size(yf,2))';

	if show_visualization,  %create video interface
		update_visualization = show_video(img_files, video_path, resize_image);
	end

	%note: variables ending with 'f' are in the Fourier domain.

	time = 0;  %to calculate FPS
	positions = zeros(numel(img_files), 2);  %to calculate precision
    offset = [-target_sz(1) 0; 0 -target_sz(2); target_sz(1) 0; 0 target_sz(2)];

	for frame = 1:numel(img_files),
		%load image
		im = imread([video_path img_files{frame}]);
		if size(im,3) > 1,
			im = rgb2gray(im);
		end
		if resize_image,
			im = imresize(im, 0.5);
		end

		tic()

		if frame > 1,
			%obtain a subwindow for detection at the position from last
			%frame, and convert to Fourier domain (its size is unchanged)
			patch = get_subwindow(im, pos, window_sz);
			zf = fft2(get_features(patch, features, cell_size, cos_window));

			response = real(ifft2(model_wf .* zf));  %equation for fast detection

			%target location is at the maximum response. we must take into
			%account the fact that, if the target doesn't move, the peak
			%will appear at the top-left corner, not at the center (this is
			%discussed in the paper). the responses wrap around cyclically.
			[vert_delta, horiz_delta] = find(response == max(response(:)), 1);
			if vert_delta > size(zf,1) / 2,  %wrap around to negative half-space of vertical axis
				vert_delta = vert_delta - size(zf,1);
			end
			if horiz_delta > size(zf,2) / 2,  %same for horizontal axis
				horiz_delta = horiz_delta - size(zf,2);
			end
			pos = pos + cell_size * [vert_delta - 1, horiz_delta - 1];
		end

		%obtain a subwindow for training at newly estimated target position
		patch = get_subwindow(im, pos, window_sz);
		xf = fft2(get_features(patch, features, cell_size, cos_window));

		kf = conj(xf) .* xf;

        kfn = zeros([size(xf) length(offset)]);
        for j=1:length(offset)
            %obtain a subwindow close to target for regression to 0
            patch = get_subwindow(im, pos+offset(j,:), window_sz);
            xfn = fft2(get_features(patch, features, cell_size, cos_window));
            kfn(:,:,j) = conj(xfn) .* xfn;
        end

        num = conj(xf) .* yf;
        den = kf + lambda1 + lambda2.*sum(kfn,3);
        wf = num ./ den;

		if frame == 1,  %first frame, train with a single image
			model_wf = wf;
		else
			%subsequent frames, interpolate model
			model_wf = (1 - interp_factor) * model_wf + interp_factor * wf;
		end

		%save position and timing
		positions(frame,:) = pos;
		time = time + toc();

		%visualization
		if show_visualization,
			box = [pos([2,1]) - target_sz([2,1])/2, target_sz([2,1])];
			stop = update_visualization(frame, box);
			if stop, break, end  %user pressed Esc, stop early

			drawnow
% 			pause(0.05)  %uncomment to run slower
		end

	end

	if resize_image,
		positions = positions * 2;
	end
end


function f_x = ParFor14(in1)
%PARFOR14
%    F_X = PARFOR14(IN1)

%    This function was generated by the Symbolic Math Toolbox version 8.2.
%    20-Sep-2019 09:35:38

u = in1(:,1);
ux = in1(:,4);
uxxx = in1(:,6);
f_x = ((ux.*-2.895410174450939e19+uxxx.*2.0816405633874e18+u.*ux.*2.276963278976451e19).*-1.402326054557642e-16)./u;


function [regions, scores] = sampleRegions(pB, spLR, seg, niter, maxov, nregions)

stats = regionprops(seg, 'Area');
area = [stats.Area];
area = area / sum(area);

updateFactor = 0.9;

nsp = numel(area);

scores = cell(niter+1,1);
regions = cell(niter+1, 1);

pB2 = pB;

% get regions through hierarchical segmentation
for k = 1:niter

    %pB2 = pB2-min(pB2);  pB2 = pB2 / max(pB2); % normalize 0 to 1
    hier = boundaries2hierarchy(pB2, spLR, 'max', [], [], pB);
    if k==1
        [scores{k}, scoresSp] = getHierarchyRegionScores(hier);
        scores{niter+1} = scoresSp;
        regions{niter+1} = num2cell(1:nsp)'; % superpixel regions
    else
        % assign costs according to original boundary likelihoods
%         for k2 = 1:nsp-1
%             hier.thresh(k2) = max(pB(hier.edges_removed{k2}));
%         end
        scores{k} = getHierarchyRegionScores(hier);
    end
    regions{k} = hier.new_region;

%     if k>1
%         ts = [scores{k} ; scores{1}];
%         [sval, sind] = sort(ts, 'descend');
%         sum(sind(1:50)<=numel(scores{k}))
%     end

    % decrement likelihoods of boundaries that are removed late
    for k2 = 1:nsp-1
        pB2(hier.edges_removed{k2}) = pB2(hier.edges_removed{k2}) * updateFactor^(k2/(nsp-1));
        %pB2(hier.edges_removed{k2}) = pB2(hier.edges_removed{k2}) + rand(1)*0.05;
    end
end

iterind = cell(numel(scores), 1);
for k = 1:numel(scores)
    iterind{k} = k*ones(numel(scores{k}), 1);
end
iterind = cat(1, iterind{:});

scores = cat(1, scores{:});
regions = cat(1, regions{:});

for k = 1:numel(regions)
    scores(k) = scores(k) * sqrt(sum(area(regions{k})));
end

if isempty(nregions)
    return;
end

coverage = zeros(nsp, 1);
cov = zeros(nregions, 1);
isselected = false(numel(regions), 1);

[scores, sind] = sort(scores, 'descend');
regions = regions(sind);

% take top nregion regions that do not overlap too much
rind = zeros(nregions,1);
n = 0;
for k1 = 1:numel(regions)
    isov = false;
    for k2 = 1:k1-1
        if isselected(k2) && (regionOverlap(regions{k1}, regions{k2}, area) > maxov)
            isov = true;
            break;
        end
    end
    if ~isov
        n=n+1;
        coverage(regions{k1}) = coverage(regions{k1}) + 1;
        isselected(k1) = true;
        cov(n) = sum(area(coverage>0))/sum(area);
        rind(n) = k1;
        if n==nregions
            break;
        end
    end
end
%regions = regions(rind(1:n));

iterind = iterind(sind);
for k = 1:max(iterind)
    disp([num2str(k) ': ' num2str(sum(iterind(rind)==k))]);
end

rind2 = zeros(sum(coverage==0), 1);
n2 = 0;
if any(coverage==0)
    for k = 1:numel(regions)
        if any(coverage(regions{k})==0)
            n2 = n2 +1;
            rind2(n2) = k;
            coverage(regions{k}) = coverage(regions{k})+1;
            if ~any(coverage==0)
                break;
            end
        end
    end
end

regions = regions([rind(1:n) ; rind2(1:n2)]);
scores = scores([rind(1:n) ; rind2(1:n2)]);

disp(mean(scores))


function test_laggedcoherence

% MEM 2gb
% WALLTIME 00:20:00
% DEPENDENCY ft_connectivityanalysis ft_laggedcoherence ft_freqanalysis

% this is a test for the low-level function

datain=[];
datain.label={'Ch1','Ch2'};
datain.fsample=1000;
datain.time{1}=0:1/datain.fsample:8.832; % changed by JM, since it does not make sense to have less than 6 s of data if 1 Hz is requested with 3 cycles
datain.trial{1}=randn(2,length(datain.time{1}));

cfg=[];
cfg.foi=[1 1.5 2 3 4 5 6 7 8 17 18 19 20 21];
cfg.loi=[1 2 3];
cfg.numcycles=3;

lcout=ft_laggedcoherence(cfg,datain);


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% strtsw.m %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% function s = strtsw(smax,level,f)
% updates the record list for starting a new sweep and computes the
% lowest level containing non-split boxes

% Input:
% smax         depth of search
% level(1:nboxes)  levels of these boxes (level(j) = 0 if box j has
%              already been split)
% f(1:nboxes)  their function values at the base vertices

% Output:
% s            lowest level with record(s) ~= 0

function s = strtsw(smax,level,f)
global nboxes record
% nboxes       number of boxes not in the `shopping basket'
% record(1:smax-1)  vector pointing to the best non-split box at each
%              level; record(s) = 0 if there is no non-split box at
%              level s (record list)

% initialization
record = zeros(smax-1,1);
s = smax;
for j = 1:nboxes
  if level(j) > 0
    if level(j) < s
      s = level(j);
    end
    if ~record(level(j))
      record(level(j)) = j;
    elseif f(j) < f(record(level(j)))
      record(level(j)) = j;
    end
  end
end


function Conn = hlp_absvalsq(Conn,methods,force,verb,absonly)
%
% Compute the square of the absolute value of a complex number. If
% 'force'=false then real-valued data is returned unmodified
%
% Inputs:
%
%   Conn        Connectivity structure as computed by est_mvarConnectivity().
%   methods     Cell array of strings denoting which connectivity measures
%               (fields of Conn) to transform.
%   force       force each measure to be squared, irregardless of whether
%               or not it is complex
% Outputs:
%
%   Conn        Transformed connectivity structure.
%
% See Also: pop_est_mvarConnectivity()
%
% References:
%
% [1] Mullen T (2010) The Source Information Flow Toolbox (SIFT):
%   Theoretical Handbook and User Manual.
%   Available at: http://www.sccn.ucsd.edu/wiki/Sift/
%
%
% Author: Tim Mullen 2010, SCCN/INC, UCSD.
% Email:  tim@sccn.ucsd.edu

% This function is part of the Source Information Flow Toolbox (SIFT)
%
% 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, write to the Free Software
% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

    if nargin<3
        force = 0;
    end

    if nargin<4
        verb = 1;
    end

    if nargin<5
        absonly = false;
    end

    if ~iscell(methods)
        error('methods must be a cell matrix of strings');
    end

    for cnd=1:length(Conn)
        for i=1:length(methods)
            if ~isfield(Conn(cnd),methods{i})
                if verb, fprintf('Conn(%d).%s does not exist. Skipping...\n',cnd,methods{i}); end
                continue;
            end
            if isreal(Conn(cnd).(methods{i})) && ~force
               if verb, fprintf('Conn(%d).%s is real, skipping (use ''force'' argument to override)\n',cnd,methods{i}); end
                continue;
            end

            if absonly
                Conn(cnd).(methods{i}) = abs(Conn(cnd).(methods{i}));
            else
                Conn(cnd).(methods{i}) = abs(Conn(cnd).(methods{i})).^2;
            end

%             Conn(cnd).(methods{i}) = Conn(cnd).(methods{i}).*conj(Conn(cnd).(methods{i}));
        end
    end


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


classdef asRoiClass < impoly
    properties (Access = private)
        parentAxesHandle   = 0;     % parent axes handle
        parentImageHandle  = 0;     % parent image handle
        parentFigureHandle = 0;

        textHandle            = [];
        textContextMenuHandle = [];
        precision = '%g';      % standard notation is compact

        filterStr = ''      % WARNING: test

        guiHandle    = struct('figure','text')
        cmenuHandle  = struct('sendPosition','ignoreZeros');

        sendPositionCallback = [];
        sendPositionCallbackId = [];

        fullStrToggle = true;  % show full string or just compact form
    end

    properties (Access = public)

    end

    methods
        function obj = asRoiClass(parentAxesHandle, roiPos, sendPositionCallback)
            if nargin < 2
                roiPos = [];
                if nargin < 1
                    parentAxesHandle = gca;
                end
            end

            obj     = obj@impoly(parentAxesHandle, roiPos);
            obj.setColor('green')
            obj.parentAxesHandle   = parentAxesHandle;
            obj.parentImageHandle  = findall(get(parentAxesHandle,'Children'),'Type','image');
            obj.parentFigureHandle = get(get(obj.parentAxesHandle,'Parent'),'Parent');

            if nargin == 3
                obj.sendPositionCallback = sendPositionCallback;
            end

            obj.updateImpolyContextMenu;
            obj.createTextContextMenu;

%             addNewPositionCallback(obj,@(pos)obj.showRoiGui);
%             obj.showRoiGui;
            addNewPositionCallback(obj,@(pos)obj.updateRoiString);
            obj.updateRoiString;

        end

        function roi = getRoiData(obj)
            ud = get(obj.parentAxesHandle,'UserData');
            if isempty(ud)
                refImg = get(obj.parentImageHandle,'CData');
            else
                if isfield(ud,'isComplex') && ud.isComplex
                    refImg = ud.cplxImg;
                else
                    refImg = get(obj.parentImageHandle,'CData');
                end
            end
            mask   = obj.createMask;
            roi    = refImg(mask == 1);
            if obj.getIgnoreZerosToggle
                roi = roi(roi~=0);
            end
            if ~isempty(obj.filterStr)
                eval(['roi = roi(roi',obj.filterStr,');']);
            end

        end

        function [m, s] = getMeanAndStd(obj)
           roi = obj.getRoiData;
           if ~isempty(roi)
               m = mean(roi);
               s = std(roi);
           else
               m = 0;
               s = 0;
           end
        end

        function N = getN(obj)
           roi = obj.getRoiData;
           N = numel(roi);
        end
        function mini = getMin(obj)
            mini = min(obj.getRoiData);
        end
        function maxi = getMax(obj)
            maxi = max(obj.getRoiData);
        end

        function updateRoiString(obj)
            if obj.fullStrToggle
                obj.drawFullString;
            else
                obj.drawMeanAndStdString;
            end
        end

        function str = getMeanAndStdString(obj)
            [m, s] = obj.getMeanAndStd;
            str = [num2str(m,obj.precision), ' +- ', num2str(s,obj.precision)];
        end

        function drawMeanAndStdString(obj)
            % writes roi statistics as a text in the image window
            if ~isempty(obj.textHandle)
                delete(obj.textHandle);
            end
            obj.textHandle = text(.015,.99,obj.getMeanAndStdString,'Units','normalized','parent',obj.parentAxesHandle,...
                'Color','green','BackgroundColor','Black',...
                'VerticalAlignment','top',...
                'UIContextMenu',obj.textContextMenuHandle);
        end

        function drawFullString(obj)
            % writes roi statistics as a text in the image window
            if ~isempty(obj.textHandle)
                delete(obj.textHandle);
            end
            str = strvcat(obj.getMeanAndStdString,num2str(obj.getN),num2str(obj.getMin,obj.precision),num2str(obj.getMax,obj.precision));
            obj.textHandle = text(.015,.98,str,'Units','normalized','parent',obj.parentAxesHandle,...
                'Color','green','BackgroundColor','Black',...
                'VerticalAlignment','top',...
                'UIContextMenu',obj.textContextMenuHandle);
        end

        function h = getTextHandle(obj)
            h = obj.textHandle;
        end

        function bool = guiIsPresent(obj)
            bool = false;
            if ishandle(obj.guiHandle.figure)
                if strcmp(get(obj.guiHandle.figure,'Tag') ,'roiGui')
                    bool = true;
                end
            end
        end

        function showRoiGui(obj)
            if obj.guiIsPresent
                set(obj.guiHandle.text,'String',obj.getMeanAndStdString);
            else
                pos = [800, 800, 40, 40];
                str = obj.getMeanAndStdString;

                obj.guiHandle.figure = figure('MenuBar','none','Toolbar','none',...
                    'Position',pos, 'Tag', 'roiGui');
                obj.guiHandle.text = uicontrol('Style','Text','String',str,'HorizontalAlignment','left',...
                    'Units','normalized','pos',[0 0 1 1],...
                    'parent',obj.guiHandle.figure,'HandleVisibility','on',...
                    'FontUnits','normalized','FontSize',.35);
            end
        end

        function delete(obj)
            if obj.guiIsPresent
                close(obj.guiHandle.figure);
            end
            if ~isempty(obj.textHandle) && ishandle(obj.textHandle)
                delete(obj.textHandle);
            end
        end

        function toggle = getSendPositionToggle(obj)
            switch get(obj.cmenuHandle.sendPosition,'Checked')
                case 'on'
                    toggle = true;
                case 'off'
                    toggle = false;
            end
        end

        function toggle = getIgnoreZerosToggle(obj)
            switch get(obj.cmenuHandle.ignoreZeros,'Checked')
                case 'on'
                    toggle = true;
                case 'off'
                    toggle = false;
            end
        end

        function setSendPositionToggle(obj, toggle)
            if nargin < 2
                toggle = ~obj.getSendPositionToggle;
            end

            switch toggle
                case 1
                    set(obj.cmenuHandle.sendPosition,'Checked','on');
                    obj.sendPositionCallbackId = addNewPositionCallback(obj,obj.sendPositionCallback);
                    obj.callSendPositionCallback(); % execute callback once
                case 0
                    set(obj.cmenuHandle.sendPosition,'Checked','off');
                    removeNewPositionCallback(obj,obj.sendPositionCallbackId);
            end
        end

        function addFilterString(obj,str)
            % WARNING, INCOMPLETE IMPLEMENTATION
            obj.filterStr = str;
            obj.updateRoiString;
        end

        function callSendPositionCallback(obj)
            obj.sendPositionCallback(obj.getPosition);
        end

        function setIgnoreZerosToggle(obj, toggle)
            if nargin < 2
                toggle = ~obj.getIgnoreZerosToggle;
            end

            switch toggle
                case 1
                    set(obj.cmenuHandle.ignoreZeros,'Checked','on');
                case 0
                    set(obj.cmenuHandle.ignoreZeros,'Checked','off');
            end
            obj.updateRoiString;
        end

    end

    methods (Access = private)
        function updateImpolyContextMenu(obj)
            % add some features to the impoly context menu

            cmh = obj.getContextMenu;

            uimenu(cmh,'Label','Delete ROI'   ,...
                'callback',@(src,evnt)obj.delete);

            uimenu(cmh,'Label','Delete all ROIs'   ,...
                'callback',@(src,evnt)evalin('base','asDeleteAllRois'));

            if ~isempty(obj.sendPositionCallback)
                obj.cmenuHandle.sendPosition = uimenu(cmh,'Label','Send Position'   ,...
                    'callback',@(src,evnt)obj.setSendPositionToggle);
            end

            obj.cmenuHandle.ignoreZeros = uimenu(cmh,'Label','Ignore Zeros'   ,...
                'callback',@(src,evnt)obj.setIgnoreZerosToggle,...
                'Checked','on');

        end

        function createTextContextMenu(obj)
            % create a context menu to choose between different notations
            % in the image text

            if isempty(obj.textContextMenuHandle)
                obj.textContextMenuHandle = uicontextmenu('Parent',obj.parentFigureHandle);

                uimenu(obj.textContextMenuHandle,'Label','Decimal notation'   ,...
                    'callback',@(src,evnt)obj.setNotation('%d'));
                uimenu(obj.textContextMenuHandle,'Label','Fixed-point notation'   ,...
                    'callback',@(src,evnt)obj.setNotation('%2.2f'));
                uimenu(obj.textContextMenuHandle,'Label','Exponential notation'   ,...
                    'callback',@(src,evnt)obj.setNotation('%2.2e'));
                uimenu(obj.textContextMenuHandle,'Label','Compact exponential notation'   ,...
                    'callback',@(src,evnt)obj.setNotation('%g'));

            end
        end

        function setNotation(obj, precision)
            obj.precision = precision;
            obj.updateRoiString % update text
        end

    end
end


function [pca,c] = spm_vpca_update (T,S,pca,c,m)
% Update VPCA parameters
% FORMAT [pca,c] = spm_vpca_update (T,S,pca,c,m)
%
% T     [d x N] matrix containing N d-dimensional data vectors
%       The nth data sample, t_n, is nth column of T
% S
% pca   data structure (see eg. spm_vpca.m)
% c     information about single component
% m     cluster number (used for mixtures of VPCA model)
%
% pca,c updated info
%__________________________________________________________________________
% Copyright (C) 2012-2014 Wellcome Trust Centre for Neuroimaging

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

q=c(m).q;
d=pca.d;
N=pca.N;
if isfield(pca,'update_mean')
    update_mean=pca.update_mean;
else
    update_mean=1;
end

% Update latent variables
c(m).sxn2=zeros(q,q);
c(m).Sigma_x=inv(eye(q)+pca.mean_tau*c(m).avg_WtW);
for n=1:N,
    c(m).M_x(:,n)=pca.mean_tau*c(m).Sigma_x*c(m).M_w'*(T(:,n)-c(m).mean_mu);
    c(m).xn2(:,:,n)=c(m).Sigma_x+c(m).M_x(:,n)*c(m).M_x(:,n)';
    c(m).sxn2=c(m).sxn2+S(m,n)*c(m).xn2(:,:,n);
end

% Update factors
c(m).Sigma_w = inv(diag(c(m).mean_alpha)+pca.mean_tau*c(m).sxn2);
for k=1:d,
    obs_err=T(k,:)-c(m).mean_mu(k)*ones(1,N);
    obs_err=S(m,:).*obs_err;
    x_err=c(m).M_x*obs_err';
    mwk=pca.mean_tau*c(m).Sigma_w*x_err;
    c(m).M_w(k,:) = mwk';
end
c(m).avg_WtW=c(m).M_w'*c(m).M_w+d*c(m).Sigma_w;

% Update mean
if update_mean
    c(m).Sigma_mu=1/(pca.beta+sum(S(m,:))*pca.mean_tau);
    t_err=zeros(d,1);
    for n=1:N,
        t_err=t_err+S(m,n)*(T(:,n)-c(m).M_w*c(m).M_x(:,n));
    end
    c(m).mean_mu=pca.mean_tau*c(m).Sigma_mu*t_err;
end

% Update alphas - shrinkage priors on factor columns
pca.qa_alpha=pca.a_alpha+d/2;
for i=1:q,
    c(m).qb_alpha(i)=pca.b_alpha+0.5*c(m).avg_WtW(i,i);
    c(m).mean_alpha(i)=pca.qa_alpha/c(m).qb_alpha(i);
end

c(m).sum_quad_exp=0;
T3=0.5*spm_logdet(c(m).Sigma_x);
quad_term=c(m).mean_mu'*c(m).mean_mu+trace(c(m).Sigma_mu);
trSx=trace(c(m).Sigma_x);
mutW=2*c(m).mean_mu'*c(m).M_w;
for n=1:N,
    term1=T(:,n)'*T(:,n)+quad_term;
    term2=trace(c(m).avg_WtW*c(m).xn2(:,:,n));
    term3=mutW*c(m).M_x(:,n);
    term4=-2*T(:,n)'*c(m).M_w*c(m).M_x(:,n)-2*T(:,n)'*c(m).mean_mu;
    c(m).sum_quad_exp=c(m).sum_quad_exp+S(m,n)*(term1+term2+term3+term4);
    c(m).T1b(n)=-0.5*(c(m).M_x(:,n)'*c(m).M_x(:,n)+trSx);
    T2=-0.5*pca.mean_tau*(term1+term2+term3+term4);
    pca.log_QS(m,n)=c(m).T1b(n)+T2+T3;
end

if pca.M==1
    % Update tau - precision of observation noise
    pca.qa_tau=pca.a_tau+0.5*N*d;
    pca.qb_tau=pca.b_tau+0.5*c(m).sum_quad_exp;
    pca.mean_tau=pca.qa_tau/pca.qb_tau;
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 SO3VF = minus(SO3VF1,SO3VF2)
% overloads |SO3VF1 - SO3VF2|
%
% Syntax
%   SO3VF = SO3VF1 - SO3VF2
%   SO3VF = a - SO3VF1
%   SO3VF = SO3VF1 - a
%
% Input
%  SO3VF1, SO3VF2 - @SO3VectorField
%  a - double
%
% Output
%  SO3VF - @SO3VectorField
%

SO3VF = plus(SO3VF1,-SO3VF2);

end