function varargout = imRAG(img, varargin)
%IMRAG Region adjacency graph of a label image
%
%   Usage:
%   ADJ = imRAG(LBLMAP);
%   [NODES, ADJ] = imRAG(LBLMAP);
%   [NODES, ADJ, BNDINDS] = imRAG(LBLMAP);
%
%   ADJ = imRAG(LBLMAP);
%   computes region adjacency graph of the 2D or 3D image LBLMAP.
%   The result is a N-by-2 array, containing 2 indices for each couple of
%   neighbor regions. Two regions are considered as neighbor if they are
%   separated by a black (i. e. with color 0) pixel in the horizontal or
%   vertical direction.
%   ADJ has the format [LBL1 LBL2], LBL1 and LBL2 being vertical arrays the
%   same size.
%
%   LBL1 is given in ascending order, LBL2 is given in ascending order for
%   each LBL1. Ex:
%   [1 2]
%   [1 3]
%   [1 4]
%   [2 3]
%   [2 5]
%   [3 4]
%
%   [NODES, ADJ] = imRAG(LBLMAP);
%   Return two arrays: the first one is a [N-by-2] array containing
%   centroids of the N label region, and ADJ is the adjacency list as
%   previously described.
%   For 3D images, the nodes array is [N-by-3].
%
%   [NODES, ADJ, BNDINDS] = imRAG(LBLMAP);
%   (only for 2D arrays) Also returns for each pair of adjacent regions the
%   linear indices of the boundary pixels or voxels (located in between the
%   two regions). BNDINDS is a cell array with as many cells as the number
%   of rows of the ADJ result.
%
%   ... = imRAG(LBLMAP, GAP);
%   Specifies the gap to use between regions. Default is 1, corresponding
%   to regions connected when they are separating by a single 0 pixel or
%   voxel.
%   Using a GAP equal to 0 may be useful when there is no separation
%   between regions. In this case, the result corresponds to the detection
%   of 4-adjacent regions.
%   Using values of GAP larger than 1 allows for detecting adjacent regions
%   when they are separated by more space. However, some adjacencies may be
%   missed in case of thin structures (See algorithm below).
%
%   Example
%     % Simple example on 2D array
%     img = zeros([7 7]);
%     img(2:3, 2:3) = 1; img(5:6, 2:3) = 2;
%     img(2:3, 5:6) = 3; img(5:6, 5:6) = 4;
%     img
%     img =
%          0     0     0     0     0     0     0
%          0     1     1     0     3     3     0
%          0     1     1     0     3     3     0
%          0     0     0     0     0     0     0
%          0     2     2     0     4     4     0
%          0     2     2     0     4     4     0
%          0     0     0     0     0     0     0
%     imRAG(img)
%     ans =
%          1     2
%          1     3
%          2     4
%          3     4
%
%     % Compute the Skeleton of Influence Zone of disjoint regions
%     % (requires image processing toolbox)
%     % read and display an image with several objects
%     img = imread('coins.png');
%     figure(1); clf;
%     imshow(img); hold on;
%     % compute the Skeleton by influence zones using watershed
%     bin = imfill(img>100, 'holes');
%     dist = bwdist(bin);
%     wat = watershed(dist, 4);
%     % compute overlay image for display
%     tmp = uint8(double(img).*(wat>0));
%     ovr = uint8(cat(3, max(img, uint8(255*(wat==0))), tmp, tmp));
%     imshow(ovr);
%     % show the resulting graph
%     [n, e] = imRAG(wat);
%     for i = 1:size(e, 1)
%         plot(n(e(i,:), 1), n(e(i,:), 2), 'linewidth', 4, 'color', 'g');
%     end
%     plot(n(:,1), n(:,2), 'bo', 'markerfacecolor', 'b');
%
%
%   % Create a basic 3D image with labels, and compute RAG
%     germs = [50 50 50;...
%         20 20 20;80 20 20;20 80 20;80 80 20; ...
%         20 20 80;80 20 80;20 80 80;80 80 80];
%     img = zeros([100 100 100]);
%     for i = 1:size(germs, 1)
%         img(germs(i,1), germs(i,2), germs(i,3)) = 1;
%     end
%     wat = watershed(bwdist(img), 6);
%     [n, e] = imRAG(wat);
%     figure; drawGraph(n, e);
%     view(3);
%
%
%   Algorithms
%   The adjacencies are computed by computing the pairs of pixels or voxels
%   with different values and separated by a given distance in each main
%   direction of the image. When values are different, they areassumed to
%   correspond to the labels of two adjacent regions.
%   Adjacencies are detected in the X and Y directions for 3D images, and
%   in the X, Y and Z directions for 3D images. There is no detection of
%   adjacency in diagonal directions.
%
%   An alternative algorithm would be to compute the result of dilation for
%   each region, and detect which labels intersect the dilated region.
%   The number of image processing operations may be very large, ususally
%   resulting in much slower processing time. The following code computes
%   RAG using a 5-by-5 square for detecting adjacent regions:
%     inds = unique(img)
%     inds(inds == 0) = [];
%     adjList = zeros(0, 2);
%     for i = 1:length(inds)
%         mask = imdilate(img == inds(i), ones(5, 5));
%         neighs = unique(img(mask));
%         neighs = neighs(~ismember(neighs, [0 i]));
%         adjList = [adjList; repmat(i, length(neighs), 1) neighs];
%     end
%     adjList = unique(sort(adjList, 2), 'rows');
%   Note that more adjacencies may be detected compared to with the imRAG
%   function.
%

% ------
% Author: David Legland
% e-mail: david.legland@inra.fr
% Created: 2004-02-20,
% Copyright 2007 INRA - BIA PV Nantes - MIAJ Jouy-en-Josas.

%   History
%   2007-10-12 update doc
%   2007-10-17 add example
%   2010-03-08 replace calls to regionprops by local centroid computation
%   2010-07-29 update doc
%   2012-07-20 remove the use of "diff", using less memory
%   2017-07-31 return output also when nargin == 0, sort labels in 3D

%% Initialisations

% size of image
dim = size(img);

% number of dimensions
nd = length(dim);

% Number of background pixels or voxels between two regions
% gap = 0 -> regions are contiguous
% gap = 1 -> there is a 1-pixel large line or surface between two adjacent
% 	pixels, for example the result of a watershed
gap = 1;
if ~isempty(varargin) && isnumeric(varargin{1})
    gap = varargin{1};
end
shift = gap + 1;

% flag indicating whether edge indices should be computed
computeEdgeInds = nargout > 2;
if computeEdgeInds && gap ~= 1
    error('imRAG:wrongGapValue', ...
        'Edge indices can only be computed for gap equal to 1');
end

if nd == 2
    %% First direction of 2D image

    % identify transitions
    [i1, i2] = find(img(1:end-shift,:) ~= img((shift+1):end, :));

	% get values of consecutive changes
	val1 = img(sub2ind(dim, i1, i2));
	val2 = img(sub2ind(dim, i1+shift, i2));

    % keep only changes not involving background, ordered such that n1 < n2
    inds = val1 ~= 0 & val2 ~= 0 & val1 ~= val2;
    edges = sort([val1(inds) val2(inds)], 2);

    % keep array of positions as linear indices
    if computeEdgeInds
        posD1 = sub2ind(dim, i1(inds)+1, i2(inds));
    end

    %% Second direction of 2D image

    % identify transitions
    [i1, i2] = find(img(:, 1:end-shift) ~= img(:, (shift+1):end));

	% get values of consecutive changes
	val1 = img(sub2ind(dim, i1, i2));
	val2 = img(sub2ind(dim, i1, i2+shift));

    % keep only changes not involving background, ordered such that n1 < n2
    inds = val1 ~= 0 & val2 ~= 0 & val1 ~= val2;
    edges = [edges ; sort([val1(inds) val2(inds)], 2)];

    if computeEdgeInds
        % keep array of positions as linear indices
        posD2 = sub2ind(dim, i1(inds), i2(inds)+1);
        posList = [posD1 ; posD2];
    end

elseif nd == 3
    %% First direction of 3D image

    % identify transitions
    [i1, i2, i3] = ind2sub(dim-[shift 0 0], ...
        find(img(1:end-shift,:,:) ~= img((shift+1):end,:,:)));

	% get values of consecutive changes
	val1 = img(sub2ind(dim, i1, i2, i3));
	val2 = img(sub2ind(dim, i1+shift, i2, i3));

    % keep only changes not involving background
    inds = val1 ~= 0 & val2 ~= 0 & val1 ~= val2;
    edges = unique(sort([val1(inds) val2(inds)], 2), 'rows');

    if computeEdgeInds
        % keep array of positions as linear indices
        posD1 = sub2ind(dim, i1(inds)+1, i2(inds), i3(inds));
    end

    %% Second direction of 3D image

    % identify transitions
    [i1, i2, i3] = ind2sub(dim-[0 shift 0], ...
        find(img(:,1:end-shift,:) ~= img(:,(shift+1):end,:)));

	% get values of consecutive changes
	val1 = img(sub2ind(dim, i1, i2, i3));
	val2 = img(sub2ind(dim, i1, i2+shift, i3));

    % keep only changes not involving background
    inds = val1 ~= 0 & val2 ~= 0 & val1 ~= val2;
    edges = [edges; unique(sort([val1(inds) val2(inds)], 2), 'rows')];

    if computeEdgeInds
        % keep array of positions as linear indices
        posD2 = sub2ind(dim, i1(inds), i2(inds)+1, i3(inds));
    end

    %% Third direction of 3D image

    % identify transitions
    [i1, i2, i3] = ind2sub(dim-[0 0 shift], ...
        find(img(:,:,1:end-shift) ~= img(:,:,(shift+1):end)));

	% get values of consecutive changes
	val1 = img(sub2ind(dim, i1, i2, i3));
    val2 = img(sub2ind(dim, i1, i2, i3+shift));

    % keep only changes not involving background
    inds = val1 ~= 0 & val2 ~= 0 & val1 ~= val2;
    edges = [edges; unique(sort([val1(inds) val2(inds)], 2), 'rows')];

    if computeEdgeInds
        % keep array of positions as linear indices
        posD3 = sub2ind(dim, i1(inds), i2(inds), i3(inds)+1);
        posList = [posD1 ; posD2 ; posD3];
    end
end

% remove double edges, keeping in indsC indices of merged edge for each
% original edge
[edges, indsA, indsC] = unique(edges, 'rows'); %#ok<ASGLU>

if computeEdgeInds
    nEdges = size(edges, 1);
    edgeInds = cell(nEdges, 1);
    for iEdge = 1:nEdges
        inds = indsC == iEdge;
        edgeInds{iEdge} = unique(posList(inds));
    end
end

%% Output processing

if nargout <= 1
    varargout{1} = edges;

else
    % Also compute region centroids
    N = max(img(:));
    points = zeros(N, nd);
    labels = unique(img);
    labels(labels==0) = [];

    if nd == 2
        % compute 2D centroids
        for i = 1:length(labels)
            label = labels(i);
            [iy, ix] = ind2sub(dim, find(img==label));
            points(label, 1) = mean(ix);
            points(label, 2) = mean(iy);
        end
    else
        % compute 3D centroids
        for i = 1:length(labels)
            label = labels(i);
            [iy, ix, iz] = ind2sub(dim, find(img==label));
            points(label, 1) = mean(ix);
            points(label, 2) = mean(iy);
            points(label, 3) = mean(iz);
        end
    end

    % setup output arguments
    varargout{1} = points;
    varargout{2} = edges;

    % eventually returns the position of edges as third output argument
    if nargout > 2
        varargout{3} = edgeInds;
    end
end


function gpcf = gpcf_periodic(varargin)
%GPCF_PERIODIC  Create a periodic covariance function for Gaussian Process
%
%  Description
%    GPCF = GPCF_PERIODIC('PARAM1',VALUE1,'PARAM2,VALUE2,...)
%    creates periodic covariance function structure in which the
%    named parameters have the specified values. Any unspecified
%    parameters are set to default values.
%
%    GPCF = GPCF_PERIODIC(GPCF,'PARAM1',VALUE1,'PARAM2,VALUE2,...)
%    modify a covariance function structure with the named
%    parameters altered with the specified values.
%
%    Periodic covariance function with squared exponential decay
%    part as in Rasmussen & Williams (2006) Gaussian processes for
%    Machine Learning.
%
%    Parameters for periodic covariance function [default]
%      magnSigma2             - magnitude (squared) [0.1]
%      lengthScale            - length scale for each input [10]
%                               This can be either scalar
%                               corresponding isotropic or vector
%                               corresponding ARD
%      period                 - length of the periodic component(s) [1]
%      lengthScale_sexp       - length scale for the squared exponential
%                               component [10] This can be either scalar
%                               corresponding isotropic or vector
%                               corresponding ARD.
%      decay                  - determines whether the squared exponential
%                               decay term is used (1) or not (0).
%                               Not a hyperparameter for the function.
%      kalman_deg             - degree of approximation in type 'KALMAN' [6]
%      kalman_deg_sexp        - degree of sexp approximation in type
%                               'KALMAN' [6]
%      kalman_valid           - determines whether Bessel function is
%                               used (1) or not (0) in type 'KALMAN' [0]
%      magnSigma2_prior       - prior structure for magnSigma2 [prior_logunif]
%      lengthScale_prior      - prior structure for lengthScale [prior_t]
%      lengthScale_sexp_prior - prior structure for lengthScale_sexp
%                               [prior_fixed]
%      period_prior           - prior structure for period [prior_fixed]
%
%    Note! If the prior is 'prior_fixed' then the parameter in
%    question is considered fixed and it is not handled in
%    optimization, grid integration, MCMC etc.
%
%  See also
%    GP_SET, GPCF_*, PRIOR_*
%
% Copyright (c) 2009-2010 Heikki Peura
% Copyright (c) 2010 Aki Vehtari
% Copyright (c) 2014 Arno Solin and Jukka Koskenranta

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

  ip=inputParser;
  ip.FunctionName = 'GPCF_PERIODIC';
  ip.addOptional('gpcf', [], @isstruct);
  ip.addParamValue('magnSigma2',0.1, @(x) isscalar(x) && x>0);
  ip.addParamValue('lengthScale',10, @(x) isvector(x) && all(x>0));
  ip.addParamValue('period',1, @(x) isscalar(x) && x>0);
  ip.addParamValue('lengthScale_sexp',10, @(x) isvector(x) && all(x>0));
  ip.addParamValue('decay',0, @(x) isscalar(x) && (x==0||x==1));
  ip.addParamValue('kalman_deg',[], @(x) isscalar(x) && mod(x,1)==0);
  ip.addParamValue('kalman_deg_sexp',[], @(x) isscalar(x) && mod(x,1)==0);
  ip.addParamValue('kalman_valid',[], @(x) isscalar(x) && (x==0||x==1));
  ip.addParamValue('magnSigma2_prior',prior_logunif, @(x) isstruct(x) || isempty(x));
  ip.addParamValue('lengthScale_prior',prior_t, @(x) isstruct(x) || isempty(x));
  ip.addParamValue('lengthScale_sexp_prior',[], @(x) isstruct(x) || isempty(x));
  ip.addParamValue('period_prior',[], @(x) isstruct(x) || isempty(x));
  ip.addParamValue('selectedVariables',[], @(x) isempty(x) || ...
                   (isvector(x) && all(x>0)));
  ip.parse(varargin{:});
  gpcf=ip.Results.gpcf;

  if isempty(gpcf)
    init=true;
    gpcf.type = 'gpcf_periodic';
  else
    if ~isfield(gpcf,'type') && ~isequal(gpcf.type,'gpcf_periodic')
      error('First argument does not seem to be a valid covariance function structure')
    end
    init=false;
  end

  if init || ~ismember('magnSigma2',ip.UsingDefaults)
    gpcf.magnSigma2 = ip.Results.magnSigma2;
  end
  if init || ~ismember('lengthScale',ip.UsingDefaults)
    gpcf.lengthScale = ip.Results.lengthScale;
  end
  if init || ~ismember('period',ip.UsingDefaults)
    gpcf.period = ip.Results.period;
  end
  if init || ~ismember('lengthScale_sexp',ip.UsingDefaults)
    gpcf.lengthScale_sexp=ip . Results.lengthScale_sexp;
  end
  if init || ~ismember('decay',ip.UsingDefaults)
    gpcf.decay = ip.Results.decay;
  end
  if init || ~ismember('kalman_deg',ip.UsingDefaults)
      if ~isempty(ip.Results.kalman_deg)
          gpcf.kalman_deg = ip.Results.kalman_deg;
      end
  end
  if init || ~ismember('kalman_deg_sexp',ip.UsingDefaults)
      if ~isempty(ip.Results.kalman_deg_sexp)
          gpcf.kalman_deg_sexp = ip.Results.kalman_deg_sexp;
      end
  end
  if init || ~ismember('kalman_valid',ip.UsingDefaults)
      if ~isempty(ip.Results.kalman_valid)
          gpcf.kalman_valid = ip.Results.kalman_valid;
      end
  end
  if init || ~ismember('magnSigma2_prior',ip.UsingDefaults)
    gpcf.p.magnSigma2 = ip.Results.magnSigma2_prior;
  end
  if init || ~ismember('lengthScale_prior',ip.UsingDefaults)
    gpcf.p.lengthScale = ip.Results.lengthScale_prior;
  end
  if init || ~ismember('lengthScale_sexp_prior',ip.UsingDefaults)
    gpcf.p.lengthScale_sexp = ip.Results.lengthScale_sexp_prior;
  end
  if init || ~ismember('period_prior',ip.UsingDefaults)
    gpcf.p.period = ip.Results.period_prior;
  end

  if ~ismember('selectedVariables',ip.UsingDefaults)
    gpcf.selectedVariables = ip.Results.selectedVariables;
  end

  if init
    % Set the function handles to the subfunctions
    gpcf.fh.pak = @gpcf_periodic_pak;
    gpcf.fh.unpak = @gpcf_periodic_unpak;
    gpcf.fh.lp = @gpcf_periodic_lp;
    gpcf.fh.lpg = @gpcf_periodic_lpg;
    gpcf.fh.cfg = @gpcf_periodic_cfg;
    gpcf.fh.ginput = @gpcf_periodic_ginput;
    gpcf.fh.cov = @gpcf_periodic_cov;
    gpcf.fh.covvec = @gpcf_periodic_covvec;
    gpcf.fh.trcov  = @gpcf_periodic_trcov;
    gpcf.fh.trvar  = @gpcf_periodic_trvar;
    gpcf.fh.recappend = @gpcf_periodic_recappend;
    gpcf.fh.cf2ss = @gpcf_periodic_cf2ss;
  end

end

function [w, s, h] = gpcf_periodic_pak(gpcf)
%GPCF_PERIODIC_PAK  Combine GP covariance function parameters into
%                   one vector
%
%  Description
%    W = GPCF_PERIODIC_PAK(GPCF) takes a covariance function
%    structure GPCF and combines the covariance function
%    parameters and their hyperparameters into a single row
%    vector W. This is a mandatory subfunction used for example
%    in energy and gradient computations.
%
%       w = [ log(gpcf.magnSigma2)
%             (hyperparameters of gpcf.magnSigma2)
%             log(gpcf.lengthScale(:))
%             (hyperparameters of gpcf.lengthScale)
%             log(gpcf.lengthScale_sexp)
%             (hyperparameters of gpcf.lengthScale_sexp)
%             log(gpcf.period)
%             (hyperparameters of gpcf.period)]'
%
%  See also
%    GPCF_PERIODIC_UNPAK

  if isfield(gpcf,'metric')
    error('Periodic covariance function not compatible with metrics.');
  else
    i1=0;i2=1;
    w = []; s = {}; h=[];

    if ~isempty(gpcf.p.magnSigma2)
      w = [w log(gpcf.magnSigma2)];
      s = [s; 'log(periodic.magnSigma2)'];
      h = [h 1];

      % Hyperparameters of magnSigma2
      [wh, sh, hh] = gpcf.p.magnSigma2.fh.pak(gpcf.p.magnSigma2);
      sh=strcat(repmat('prior-', size(sh,1),1),sh);
      w = [w wh];
      s = [s; sh];
      h = [h 1+hh];
    end

    if ~isempty(gpcf.p.lengthScale)
      w = [w log(gpcf.lengthScale)];
      s = [s; 'log(periodic.lengthScale)'];
      h = [h ones(1,numel(gpcf.lengthScale))];

      % Hyperparameters of lengthScale
      [wh, sh, hh] = gpcf.p.lengthScale.fh.pak(gpcf.p.lengthScale);
      sh=strcat(repmat('prior-', size(sh,1),1),sh);
      w = [w wh];
      s = [s; sh];
      h = [h 1+hh];
    end

    if gpcf.decay == 1 && ~isempty(gpcf.p.lengthScale_sexp)
      w = [w log(gpcf.lengthScale_sexp)];
      s = [s; 'log(periodic.lengthScale_sexp)'];
      h = [h ones(1,numel(gpcf.lengthScale_sexp))];

      % Hyperparameters of lengthScale_sexp
      [wh, sh, hh] = gpcf.p.lengthScale_sexp.fh.pak(gpcf.p.lengthScale_sexp);
      sh=strcat(repmat('prior-', size(sh,1),1),sh);
      w = [w wh];
      s = [s; sh];
      h = [h 1+hh];
    end

    if ~isempty(gpcf.p.period)
      w = [w log(gpcf.period)];
      s = [s; 'log(periodic.period)'];
      h = [h 1];

      % Hyperparameters of period
      [wh, sh, hh] = gpcf.p.period.fh.pak(gpcf.p.period);
      sh=strcat(repmat('prior-', size(sh,1),1),sh);
      w = [w wh];
      s = [s; sh];
      h = [h 1+hh];
    end
  end
end

function [gpcf, w] = gpcf_periodic_unpak(gpcf, w)
%GPCF_PERIODIC_UNPAK  Sets the covariance function parameters into
%                     the structure
%
%  Description
%    [GPCF, W] = GPCF_PERIODIC_UNPAK(GPCF, W) takes a covariance
%    function structure GPCF and a hyper-parameter vector W, and
%    returns a covariance function structure identical to the
%    input, except that the covariance hyper-parameters have been
%    set to the values in W. Deletes the values set to GPCF from
%    W and returns the modified W. This is a mandatory subfunction
%    used for example in energy and gradient computations.
%
%    Assignment is inverse of
%       w = [ log(gpcf.magnSigma2)
%             (hyperparameters of gpcf.magnSigma2)
%             log(gpcf.lengthScale(:))
%             (hyperparameters of gpcf.lengthScale)
%             log(gpcf.lengthScale_sexp)
%             (hyperparameters of gpcf.lengthScale_sexp)
%             log(gpcf.period)
%             (hyperparameters of gpcf.period)]'
%
%  See also
%    GPCF_PERIODIC_PAK

  if isfield(gpcf,'metric')
    error('Covariance function not compatible with metrics');
  else
    gpp=gpcf.p;
    if ~isempty(gpp.magnSigma2)
      i1=1;
      gpcf.magnSigma2 = exp(w(i1));
      w = w(i1+1:end);
    end
    if ~isempty(gpp.lengthScale)
      i2=length(gpcf.lengthScale);
      i1=1;
      gpcf.lengthScale = exp(w(i1:i2));
      w = w(i2+1:end);
    end
    if ~isempty(gpp.lengthScale_sexp) && gpcf.decay == 1
      i2=length(gpcf.lengthScale_sexp);
      i1=1;
      gpcf.lengthScale_sexp = exp(w(i1:i2));
      w = w(i2+1:end);
    end
    if ~isempty(gpp.period)
      i2=length(gpcf.period);
      i1=1;
      gpcf.period = exp(w(i1:i2));
      w = w(i2+1:end);
    end
    % hyperparameters
    if ~isempty(gpp.magnSigma2)
      [p, w] = gpcf.p.magnSigma2.fh.unpak(gpcf.p.magnSigma2, w);
      gpcf.p.magnSigma2 = p;
    end
    if ~isempty(gpp.lengthScale)
      [p, w] = gpcf.p.lengthScale.fh.unpak(gpcf.p.lengthScale, w);
      gpcf.p.lengthScale = p;
    end
    if ~isempty(gpp.lengthScale_sexp)
      [p, w] = gpcf.p.lengthScale_sexp.fh.unpak(gpcf.p.lengthScale_sexp, w);
      gpcf.p.lengthScale_sexp = p;
    end
    if ~isempty(gpp.period)
      [p, w] = gpcf.p.period.fh.unpak(gpcf.p.period, w);
      gpcf.p.period = p;
    end

  end
end

function lp = gpcf_periodic_lp(gpcf)
%GPCF_PERIODIC_LP  Evaluate the log prior of covariance function parameters
%
%  Description
%    LP = GPCF_PERIODIC_LP(GPCF) takes a covariance function
%    structure GPCF and returns log(p(th)), where th collects the
%    parameters. This is a mandatory subfunction used for example
%    in energy computations.
%
%    Also the log prior of the hyperparameters of the covariance
%    function parameters is added to E if hyperprior is
%    defined.
%
%  See also
%    GPCF_PERIODIC_PAK, GPCF_PERIODIC_UNPAK, GPCF_PERIODIC_LPG, GP_E

  lp = 0;
  gpp=gpcf.p;

  if isfield(gpcf,'metric')
    error('Covariance function not compatible with metrics');
  else
    % Evaluate the prior contribution to the error. The parameters that
    % are sampled are from space W = log(w) where w is all the "real" samples.
    % On the other hand errors are evaluated in the W-space so we need take
    % into account also the  Jacobian of transformation W -> w = exp(W).
    % See Gelman et al. (2013), Bayesian Data Analysis, third edition, p. 21.

    if ~isempty(gpcf.p.magnSigma2)
      lp = gpp.magnSigma2.fh.lp(gpcf.magnSigma2, gpp.magnSigma2) +log(gpcf.magnSigma2);
    end
    if ~isempty(gpp.lengthScale)
      lp = lp +gpp.lengthScale.fh.lp(gpcf.lengthScale, gpp.lengthScale) +sum(log(gpcf.lengthScale));
    end

    if ~isempty(gpp.lengthScale_sexp) && gpcf.decay == 1
      lp = lp +gpp.lengthScale_sexp.fh.lp(gpcf.lengthScale_sexp, gpp.lengthScale_sexp) +sum(log(gpcf.lengthScale_sexp));
    end
    if ~isempty(gpcf.p.period)
      lp = gpp.period.fh.lp(gpcf.period, gpp.period) +sum(log(gpcf.period));
    end
  end

end

function lpg = gpcf_periodic_lpg(gpcf)
%GPCF_PERIODIC_LPG  Evaluate gradient of the log prior with respect
%               to the parameters.
%
%  Description
%    LPG = GPCF_PERIODIC_LPG(GPCF) takes a covariance function
%    structure GPCF and returns LPG = d log (p(th))/dth, where th
%    is the vector of parameters. This is a mandatory subfunction
%    used for example in gradient computations.
%
%  See also
%    GPCF_PERIODIC_PAK, GPCF_PERIODIC_UNPAK, GPCF_PERIODIC_LP, GP_G

  lpg = [];
  gpp=gpcf.p;
  if isfield(gpcf,'metric')
    error('Covariance function not compatible with metrics');
  end
  if ~isempty(gpcf.p.magnSigma2)
    lpgs = gpp.magnSigma2.fh.lpg(gpcf.magnSigma2, gpp.magnSigma2);
    lpg = [lpg lpgs(1).*gpcf.magnSigma2+1 lpgs(2:end)];
  end
  if ~isempty(gpcf.p.lengthScale)
    lll = length(gpcf.lengthScale);
    lpgs = gpp.lengthScale.fh.lpg(gpcf.lengthScale, gpp.lengthScale);
    lpg = [lpg lpgs(1:lll).*gpcf.lengthScale+1 lpgs(lll+1:end)];
  end
  if gpcf.decay == 1 && ~isempty(gpcf.p.lengthScale_sexp)
    lll = length(gpcf.lengthScale_sexp);
    lpgs = gpp.lengthScale_sexp.fh.lpg(gpcf.lengthScale_sexp, gpp.lengthScale_sexp);
    lpg = [lpg lpgs(1:lll).*gpcf.lengthScale_sexp+1 lpgs(lll+1:end)];
  end
  if ~isempty(gpcf.p.period)
    lpgs = gpp.period.fh.lpg(gpcf.period, gpp.period);
    lpg = [lpg lpgs(1).*gpcf.period+1 lpgs(2:end)];
  end
end

function DKff = gpcf_periodic_cfg(gpcf, x, x2, mask, i1)
%GPCF_PERIODIC_CFG  Evaluate gradient of covariance function
%                   with respect to the parameters
%
%  Description
%    DKff = GPCF_PERIODIC_CFG(GPCF, X) takes a covariance
%    function structure GPCF, a matrix X of input vectors and
%    returns DKff, the gradients of covariance matrix Kff =
%    k(X,X) with respect to th (cell array with matrix elements).
%    This is a mandatory subfunction used in gradient computations.
%
%    DKff = GPCF_PERIODIC_CFG(GPCF, X, X2) takes a covariance
%    function structure GPCF, a matrix X of input vectors and
%    returns DKff, the gradients of covariance matrix Kff =
%    k(X,X2) with respect to th (cell array with matrix
%    elements). This subfunction is needed when using sparse
%    approximations (e.g. FIC).
%
%    DKff = GPCF_PERIODIC_CFG(GPCF, X, [], MASK) takes a
%    covariance function structure GPCF, a matrix X of input
%    vectors and returns DKff, the diagonal of gradients of
%    covariance matrix Kff = k(X,X2) with respect to th (cell
%    array with matrix elements). This subfunction is needed
%    when using sparse approximations (e.g. FIC).
%
%    DKff = GPCF_PERIODIC_CFG(GPCF, X, X2, [], i) takes a covariance
%    function structure GPCF, a matrix X of input vectors and
%    returns DKff, the gradients of covariance matrix Kff =
%    k(X,X2), or k(X,X) if X2 is empty, with respect to ith
%    hyperparameter. This subfunction is needed when using memory
%    save option in gp_set.
%
%  See also
%    GPCF_PERIODIC_PAK, GPCF_PERIODIC_UNPAK, GPCF_PERIODIC_LP, GP_G

  gpp=gpcf.p;

  i2=1;
  gp_period=gpcf.period;
  DKff={};
  gprior=[];

  if nargin==5
    % Use memory save option
    savememory=1;
    if i1==0
      % Return number of hyperparameters
      i=0;
      if ~isempty(gpcf.p.magnSigma2)
        i=1;
      end
      if ~isempty(gpcf.p.lengthScale)
        i=i+length(gpcf.lengthScale);
      end
      if gpcf.decay==1 && ~isempty(gpcf.p.lengthScale_sexp)
        i=i+length(gpcf.lengthScale_sexp);
      end
      if ~isempty(gpcf.p.period)
        i=i+length(gpcf.lengthScale);
      end
      DKff=i;
      return
    end
  else
    savememory=0;
  end

  % Evaluate: DKff{1} = d Kff / d magnSigma2
  %           DKff{2} = d Kff / d lengthScale
  % NOTE! Here we have already taken into account that the parameters are transformed
  % through log() and thus dK/dlog(p) = p * dK/dp

  % evaluate the gradient for training covariance
  if nargin == 2 || (isempty(x2) && isempty(mask))
    Cdm = gpcf_periodic_trcov(gpcf, x);

    ii1=0;
    if ~isempty(gpcf.p.magnSigma2) && (~savememory || all(i1==1));
        ii1=1;
        DKff{ii1} = Cdm;
    end

    if isfield(gpcf,'metric')
      error('Covariance function not compatible with metrics');
    else
      if isfield(gpcf,'selectedVariables')
        x = x(:,gpcf.selectedVariables);
      end
      [n, m] =size(x);
      if ~savememory
        i1=1:m;
      else
        if i1==1
          DKff=DKff{1};
          return
        else
          i1=i1-1;
        end
      end

      if ~isempty(gpcf.p.lengthScale) && (~savememory || all(i1 <= length(gpcf.lengthScale)))
        % loop over all the lengthScales
        if length(gpcf.lengthScale) == 1
          % In the case of isotropic PERIODIC
          s = 2./gpcf.lengthScale.^2;
          dist = 0;
          for i=1:m
            D = sin(pi.*bsxfun(@minus,x(:,i),x(:,i)')./gp_period);
            dist = dist + 2.*D.^2;
          end
          D = Cdm.*s.*dist;

          ii1 = ii1+1;
          DKff{ii1} = D;
        else
          % In the case ARD is used
          for i=i1
            s = 2./gpcf.lengthScale(i).^2;
            dist = sin(pi.*bsxfun(@minus,x(:,i),x(:,i)')./gp_period);
            D = Cdm.*s.*2.*dist.^2;

            ii1 = ii1+1;
            DKff{ii1} = D;
          end
        end
      end
      if savememory
        if length(DKff) == 1
          DKff=DKff{1};
          return
        end
        i1=i1-length(gpcf.lengthScale);
      end
      if gpcf.decay == 1
        if ~isempty(gpcf.p.lengthScale_sexp) && (~savememory || all(i1 <= length(gpcf.lengthScale_sexp)))
          if length(gpcf.lengthScale_sexp) == 1
            % In the case of isotropic PERIODIC
            s = 1./gpcf.lengthScale_sexp.^2;
            dist = 0;
            for i=1:m
              D = bsxfun(@minus,x(:,i),x(:,i)');
              dist = dist + D.^2;
            end
            D = Cdm.*s.*dist;

            ii1 = ii1+1;
            DKff{ii1} = D;
          else
            % In the case ARD is used
            for i=i1
              s = 1./gpcf.lengthScale_sexp(i).^2;
              dist = bsxfun(@minus,x(:,i),x(:,i)');
              D = Cdm.*s.*dist.^2;

              ii1 = ii1+1;
              DKff{ii1} = D;
            end
          end
        end
      end
      if savememory
        if length(DKff) == 1
          DKff=DKff{1};
          return
        end
        i1=i1-length(gpcf.lengthScale_sexp);
      end

      if ~isempty(gpcf.p.period)
        % Evaluate help matrix for calculations of derivatives
        % with respect to the period
        if length(gpcf.lengthScale) == 1
          % In the case of an isotropic PERIODIC
          s = repmat(1./gpcf.lengthScale.^2, 1, m);

          dist = 0;
          for i=1:m
            dist = dist + 2.*pi./gp_period.*sin(2.*pi.*bsxfun(@minus,x(:,i),x(:,i)')./gp_period).*bsxfun(@minus,x(:,i),x(:,i)').*s(i);
          end
          D = Cdm.*dist;
          ii1=ii1+1;
          DKff{ii1} = D;
        else
          % In the case ARD is used
          for i=i1
            s = 1./gpcf.lengthScale(i).^2;        % set the length
            dist = 2.*pi./gp_period.*sin(2.*pi.*bsxfun(@minus,x(:,i),x(:,i)')./gp_period).*bsxfun(@minus,x(:,i),x(:,i)');
            D = Cdm.*s.*dist;

            ii1=ii1+1;
            DKff{ii1} = D;
          end
        end
      end

    end
    % Evaluate the gradient of non-symmetric covariance (e.g. K_fu)
  elseif nargin == 3 || isempty(mask)
    if size(x,2) ~= size(x2,2)
      error('gpcf_periodic -> _ghyper: The number of columns in x and x2 has to be the same. ')
    end

    K = gpcf.fh.cov(gpcf, x, x2);
    ii1=0;
    if ~isempty(gpcf.p.magnSigma2) && (~savememory || all(i1==1))
        ii1=1;
        DKff{ii1} = K;
    end

    if isfield(gpcf,'metric')
      error('Covariance function not compatible with metrics');
    else
      if isfield(gpcf,'selectedVariables')
        x = x(:,gpcf.selectedVariables);
        x2 = x2(:,gpcf.selectedVariables);
      end
      [n, m] =size(x);
      if ~savememory
        i1=1:m;
      else
        if i1==1
          DKff=DKff{1};
          return
        end
        i1=i1-1;
      end
      % Evaluate help matrix for calculations of derivatives with respect to the lengthScale
      if ~isempty(gpcf.p.lengthScale) && (~savememory || all(i1 <= length(gpcf.lengthScale)))
        if length(gpcf.lengthScale) == 1
          % In the case of an isotropic PERIODIC
          s = 1./gpcf.lengthScale.^2;
          dist = 0; dist2 = 0;
          for i=1:m
            dist = dist + 2.*sin(pi.*bsxfun(@minus,x(:,i),x2(:,i)')./gp_period).^2;
          end
          DK_l = 2.*s.*K.*dist;

          ii1=ii1+1;
          DKff{ii1} = DK_l;
        else
          % In the case ARD is used
          for i=i1
            s = 1./gpcf.lengthScale(i).^2;        % set the length
            dist = 2.*sin(pi.*bsxfun(@minus,x(:,i),x2(:,i)')./gp_period);
            DK_l = 2.*s.*K.*dist.^2;

            ii1=ii1+1;
            DKff{ii1} = DK_l;
          end
        end
      end
      if savememory
        if length(DKff) == 1
          DKff=DKff{1};
          return
        end
        i1=i1-length(gpcf.lengthScale);
      end

      if gpcf.decay == 1 && (~savememory || all(i1 <= length(gpcf.lengthScale_sexp)))
        % Evaluate help matrix for calculations of derivatives with
        % respect to the lengthScale_sexp
        if length(gpcf.lengthScale_sexp) == 1
          % In the case of an isotropic PERIODIC
          s = 1./gpcf.lengthScale_sexp.^2;
          dist = 0; dist2 = 0;
          for i=1:m
            dist = dist + bsxfun(@minus,x(:,i),x2(:,i)').^2;
          end
          DK_l = s.*K.*dist;

          ii1=ii1+1;
          DKff{ii1} = DK_l;
        else
          % In the case ARD is used
          for i=i1
            s = 1./gpcf.lengthScale_sexp(i).^2;        % set the length
            dist = bsxfun(@minus,x(:,i),x2(:,i)');
            DK_l = s.*K.*dist.^2;

            ii1=ii1+1;
            DKff{ii1} = DK_l;
          end
        end
      end
      if savememory
        if length(DKff) == 1
          DKff=DKff{1};
          return
        end
        i1=i1-length(gpcf.lengthScale_sexp);
      end

      if ~isempty(gpcf.p.period)
        % Evaluate help matrix for calculations of derivatives
        % with respect to the period
        if length(gpcf.lengthScale) == 1
          % In the case of an isotropic PERIODIC
          s = repmat(1./gpcf.lengthScale.^2, 1, m);
          dist = 0; dist2 = 0;
          for i=1:m
            dist = dist + 2.*pi./gp_period.*sin(2.*pi.*bsxfun(@minus,x(:,i),x2(:,i)')./gp_period).*bsxfun(@minus,x(:,i),x2(:,i)').*s(i);
          end
          DK_l = K.*dist;

          ii1=ii1+1;
          DKff{ii1} = DK_l;
        else
          % In the case ARD is used
          for i=i1
            s = 1./gpcf.lengthScale(i).^2;        % set the length
            dist = 2.*pi./gp_period.*sin(2.*pi.*bsxfun(@minus,x(:,i),x2(:,i)')./gp_period).*bsxfun(@minus,x(:,i),x2(:,i)');
            DK_l = s.*K.*dist;

            ii1=ii1+1;
            DKff{ii1} = DK_l;
          end
        end
      end
    end
    % Evaluate: DKff{1}    = d mask(Kff,I) / d magnSigma2
    %           DKff{2...} = d mask(Kff,I) / d lengthScale etc.
  elseif nargin == 4 || nargin == 5
    [n, m] =size(x);
    if isfield(gpcf,'metric')
      error('Covariance function not compatible with metrics');
    else
        ii1=0;
        if ~isempty(gpcf.p.magnSigma2) && (~savememory || all(i1==1))
            ii1=1;
            DKff{ii1} = gpcf.fh.trvar(gpcf, x);   % d mask(Kff,I) / d magnSigma2
        end
      for i2=1:length(gpcf.lengthScale)
        ii1 = ii1+1;
        DKff{ii1}  = 0;                          % d mask(Kff,I) / d lengthScale
      end
      if gpcf.decay == 1
        for i2=1:length(gpcf.lengthScale_sexp)
          ii1 = ii1+1;
          DKff{ii1}  = 0;                      % d mask(Kff,I) / d lengthScale_sexp
        end
      end
      if ~isempty(gpcf.p.period)
        ii1 = ii1+1;                             % d mask(Kff,I) / d period
        DKff{ii1}  = 0;
      end
    end
  end
  if savememory
    DKff=DKff{1};
  end
end

function DKff = gpcf_periodic_ginput(gpcf, x, x2, i1)
%GPCF_PERIODIC_GINPUT  Evaluate gradient of covariance function with
%                      respect to x
%
%  Description
%    DKff = GPCF_PERIODIC_GINPUT(GPCF, X) takes a covariance
%    function structure GPCF, a matrix X of input vectors and
%    returns DKff, the gradients of covariance matrix Kff =
%    k(X,X) with respect to X (cell array with matrix elements).
%    This subfunction is needed when computing gradients with
%    respect to inducing inputs in sparse approximations.
%
%    DKff = GPCF_PERIODIC_GINPUT(GPCF, X, X2) takes a covariance
%    function structure GPCF, a matrix X of input vectors and
%    returns DKff, the gradients of covariance matrix Kff =
%    k(X,X2) with respect to X (cell array with matrix elements).
%    This subfunction is needed when computing gradients with
%    respect to inducing inputs in sparse approximations.
%
%    DKff = GPCF_PERIODIC_GINPUT(GPCF, X, X2, i) takes a covariance
%    function structure GPCF, a matrix X of input vectors and
%    returns DKff, the gradients of covariance matrix Kff =
%    k(X,X2), or k(X,X) if X2 is empty, with respect to ith
%    covariate in X. This subfunction is needed when using memory
%    save option in gp_set.
%
%  See also
%    GPCF_PERIODIC_PAK, GPCF_PERIODIC_UNPAK, GPCF_PERIODIC_LP, GP_G

  [n, m] =size(x);
  gp_period=gpcf.period;
  ii1 = 0;
  if length(gpcf.lengthScale) == 1
    % In the case of an isotropic PERIODIC
    s = repmat(1./gpcf.lengthScale.^2, 1, m);
    %gp_period = repmat(1./gp_period, 1, m);
  else
    s = 1./gpcf.lengthScale.^2;
  end
  if gpcf.decay == 1
    if length(gpcf.lengthScale_sexp) == 1
      % In the case of an isotropic PERIODIC
      s_sexp = repmat(1./gpcf.lengthScale_sexp.^2, 1, m);
    else
      s_sexp = 1./gpcf.lengthScale_sexp.^2;
    end
  end
  if nargin<4
    i1=1:m;
  else
    % Use memory save option
    if i1==0
      % Return number of covariates
      if isfield(gpcf,'selectedVariables')
        DKff=length(gpcf.selectedVariables);
      else
        DKff=m;
      end
      return
    end
  end

  if nargin == 2 || isempty(x2)
    K = gpcf.fh.trcov(gpcf, x);
    if isfield(gpcf,'metric')
      error('Covariance function not compatible with metrics');
    else
      for j = 1:n
        for i=i1
          DK = zeros(size(K));
          DK(j,:) = -s(i).*2.*pi./gp_period.*sin(2.*pi.*bsxfun(@minus,x(j,i),x(:,i)')./gp_period);
          if gpcf.decay == 1
            DK(j,:) = DK(j,:)-s_sexp(i).*bsxfun(@minus,x(j,i),x(:,i)');
          end
          DK = DK + DK';

          DK = DK.*K;      % dist2 = dist2 + dist2' - diag(diag(dist2));

          ii1 = ii1 + 1;
          DKff{ii1} = DK;
        end
      end
    end

  elseif nargin == 3
    K = gpcf.fh.cov(gpcf, x, x2);

    if isfield(gpcf,'metric')
      error('Covariance function not compatible with metrics');
    else
      ii1 = 0;
      for i=i1
        for j = 1:n
          DK= zeros(size(K));
          if gpcf.decay == 1
            DK(j,:) = -s(i).*2.*pi./gp_period.*sin(2.*pi.*bsxfun(@minus,x(j,i),x2(:,i)')./gp_period)-s_sexp(i).*bsxfun(@minus,x(j,i),x2(:,i)');
          else
            DK(j,:) = -s(i).*2.*pi./gp_period.*sin(2.*pi.*bsxfun(@minus,x(j,i),x2(:,i)')./gp_period);
          end
          DK = DK.*K;

          ii1 = ii1 + 1;
          DKff{ii1} = DK;
        end
      end
    end
  end
end

function C = gpcf_periodic_cov(gpcf, x1, x2)
%GP_PERIODIC_COV  Evaluate covariance matrix between two input vectors
%
%  Description
%    C = GP_PERIODIC_COV(GP, TX, X) takes in covariance function
%    of a Gaussian process GP and two matrixes TX and X that
%    contain input vectors to GP. Returns covariance matrix C.
%    Every element ij of C contains covariance between inputs i
%    in TX and j in X. This is a mandatory subfunction used for
%    example in prediction and energy computations.
%
%  See also
%    GPCF_PERIODIC_TRCOV, GPCF_PERIODIC_TRVAR, GP_COV, GP_TRCOV

  if isempty(x2)
    x2=x1;
  end
%   [n1,m1]=size(x1);
%   [n2,m2]=size(x2);
  gp_period=gpcf.period;

  if size(x1,2)~=size(x2,2)
    error('the number of columns of X1 and X2 has to be same')
  end

  if isfield(gpcf,'metric')
    error('Covariance function not compatible with metrics');
  else
    if isfield(gpcf,'selectedVariables')
      x1 = x1(:,gpcf.selectedVariables);
      x2 = x2(:,gpcf.selectedVariables);
    end
    [n1,m1]=size(x1);
    [n2,m2]=size(x2);

    C=zeros(n1,n2);
    ma2 = gpcf.magnSigma2;

    % Evaluate the covariance
    if ~isempty(gpcf.lengthScale)
      s = 1./gpcf.lengthScale.^2;
      if gpcf.decay == 1
        s_sexp = 1./gpcf.lengthScale_sexp.^2;
      end
      if m1==1 && m2==1
        dd = bsxfun(@minus,x1,x2');
        dist=2.*sin(pi.*dd./gp_period).^2.*s;
        if gpcf.decay == 1
          dist = dist + dd.^2.*s_sexp./2;
        end
      else
        % If ARD is not used make s a vector of
        % equal elements
        if size(s)==1
          s = repmat(s,1,m1);
        end
        if gpcf.decay == 1
          if size(s_sexp)==1
            s_sexp = repmat(s_sexp,1,m1);
          end
        end

        dist=zeros(n1,n2);
        for j=1:m1
          dd = bsxfun(@minus,x1(:,j),x2(:,j)');
          dist = dist + 2.*sin(pi.*dd./gp_period).^2.*s(:,j);
          if gpcf.decay == 1
            dist = dist +dd.^2.*s_sexp(:,j)./2;
          end
        end
      end
      dist(dist<eps) = 0;
      C = ma2.*exp(-dist);
    end

  end
end

function C = gpcf_periodic_trcov(gpcf, x)
%GP_PERIODIC_TRCOV  Evaluate training covariance matrix of inputs
%
%  Description
%    C = GP_PERIODIC_TRCOV(GP, TX) takes in covariance function
%    of a Gaussian process GP and matrix TX that contains
%    training input vectors. Returns covariance matrix C. Every
%    element ij of C contains covariance between inputs i and j
%    in TX. This is a mandatory subfunction used for example in
%    prediction and energy computations.
%
%  See also
%    GPCF_PERIODIC_COV, GPCF_PERIODIC_TRVAR, GP_COV, GP_TRCOV

  if isfield(gpcf,'metric')
    error('Covariance function not compatible with metrics');
  else

    % Try to use the C-implementation
    C=trcov(gpcf, x);
    %     C = NaN;
    if isnan(C)
      % If there wasn't C-implementation do here
      if isfield(gpcf,'selectedVariables')
        x = x(:,gpcf.selectedVariables);
      end
      [n, m] =size(x);
      gp_period=gpcf.period;

      s = 1./(gpcf.lengthScale);
      s2 = s.^2;
      if size(s)==1
        s2 = repmat(s2,1,m);
        gp_period = repmat(gp_period,1,m);
      end
      if gpcf.decay == 1
        s_sexp = 1./(gpcf.lengthScale_sexp);
        s_sexp2 = s_sexp.^2;
        if size(s_sexp)==1
          s_sexp2 = repmat(s_sexp2,1,m);
        end
      end

      ma = gpcf.magnSigma2;

      C = zeros(n,n);
      for ii1=1:n-1
        d = zeros(n-ii1,1);
        col_ind = ii1+1:n;
        for ii2=1:m
          d = d+2.*s2(ii2).*sin(pi.*(x(col_ind,ii2)-x(ii1,ii2))./gp_period(ii2)).^2;
          if gpcf.decay == 1
            d=d+s_sexp2(ii2)./2.*(x(col_ind,ii2)-x(ii1,ii2)).^2;
          end
        end
        C(col_ind,ii1) = d;

      end
      C(C<eps) = 0;
      C = C+C';
      C = ma.*exp(-C);
    end
  end
end

function C = gpcf_periodic_trvar(gpcf, x)
%GP_PERIODIC_TRVAR  Evaluate training variance vector
%
%  Description
%    C = GP_PERIODIC_TRVAR(GPCF, TX) takes in covariance function
%    of a Gaussian process GPCF and matrix TX that contains
%    training inputs. Returns variance vector C. Every
%    element i of C contains variance of input i in TX. This is a
%    mandatory subfunction used for example in prediction and
%    energy computations.
%
%  See also
%    GPCF_PERIODIC_COV, GP_COV, GP_TRCOV

  [n, m] =size(x);

  C = ones(n,1)*gpcf.magnSigma2;
  C(C<eps)=0;
end

function reccf = gpcf_periodic_recappend(reccf, ri, gpcf)
%RECAPPEND Record append
%
%  Description
%    RECCF = GPCF_PERIODIC_RECAPPEND(RECCF, RI, GPCF) takes a
%    covariance function record structure RECCF, record index RI
%    and covariance function structure GPCF with the current MCMC
%    samples of the parameters. Returns RECCF which contains all
%    the old samples and the current samples from GPCF. This
%    subfunction is needed when using MCMC sampling (gp_mc).
%
%  See also
%    GP_MC and GP_MC -> RECAPPEND

  if nargin == 2
    % Initialize the record
    reccf.type = 'gpcf_periodic';

    % Initialize parameters
    reccf.lengthScale= [];
    reccf.magnSigma2 = [];
    reccf.lengthScale_sexp = [];
    reccf.period = [];

    % Set the function handles
    reccf.fh.pak = @gpcf_periodic_pak;
    reccf.fh.unpak = @gpcf_periodic_unpak;
    reccf.fh.lp = @gpcf_periodic_lp;
    reccf.fh.lpg = @gpcf_periodic_lpg;
    reccf.fh.cfg = @gpcf_periodic_cfg;
    reccf.fh.cov = @gpcf_periodic_cov;
    reccf.fh.trcov  = @gpcf_periodic_trcov;
    reccf.fh.trvar  = @gpcf_periodic_trvar;
    reccf.fh.recappend = @gpcf_periodic_recappend;
    reccf.p=[];
    reccf.p.lengthScale=[];
    reccf.p.magnSigma2=[];
    if ri.decay == 1
      reccf.p.lengthScale_sexp=[];
      if ~isempty(ri.p.lengthScale_sexp)
        reccf.p.lengthScale_sexp = ri.p.lengthScale_sexp;
      end
    end

    reccf.p.period=[];
    if ~isempty(ri.p.period)
      reccf.p.period= ri.p.period;
    end
    if isfield(ri.p,'lengthScale') && ~isempty(ri.p.lengthScale)
      reccf.p.lengthScale = ri.p.lengthScale;
    end
    if ~isempty(ri.p.magnSigma2)
      reccf.p.magnSigma2 = ri.p.magnSigma2;
    end
  else
    % Append to the record

    gpp = gpcf.p;

    % record lengthScale
    reccf.lengthScale(ri,:)=gpcf.lengthScale;
    if isfield(gpp,'lengthScale') && ~isempty(gpp.lengthScale)
      reccf.p.lengthScale = gpp.lengthScale.fh.recappend(reccf.p.lengthScale, ri, gpcf.p.lengthScale);
    end

    % record magnSigma2
    reccf.magnSigma2(ri,:)=gpcf.magnSigma2;
    if isfield(gpp,'magnSigma2') && ~isempty(gpp.magnSigma2)
      reccf.p.magnSigma2 = gpp.magnSigma2.fh.recappend(reccf.p.magnSigma2, ri, gpcf.p.magnSigma2);
    end

    % record lengthScale_sexp
    if ~isempty(gpcf.lengthScale_sexp) && gpcf.decay == 1
      reccf.lengthScale_sexp(ri,:)=gpcf.lengthScale_sexp;
      if isfield(gpp,'lengthScale_sexp') && ~isempty(gpp.lengthScale_sexp)
        reccf.p.lengthScale_sexp = gpp.lengthScale_sexp.fh.recappend(reccf.p.lengthScale_sexp, ri, gpcf.p.lengthScale_sexp);
      end
    end

    % record period
    reccf.period(ri,:)=gpcf.period;
    if isfield(gpp,'period') && ~isempty(gpp.period)
      reccf.p.period = gpp.period.fh.recappend(reccf.p.period, ri, gpcf.p.period);
    end

    % record decay
    if ~isempty(gpcf.decay)
      reccf.decay(ri,:)=gpcf.decay;
    end

  end
end

function [F,L,Qc,H,Pinf,dF,dQc,dPinf,params] = gpcf_periodic_cf2ss(gpcf,x)
%GPCF_PERIODIC_CF2SS Convert the covariance function to state space form
%
%  Description
%    Convert the covariance function to state space form such that
%    the process can be described by the stochastic differential equation
%    of the form:
%      df(t)/dt = F f(t) + L w(t),
%    where w(t) is a white noise process. The observation model now
%    corresponds to y_k = H f(t_k) + r_k, where r_k ~ N(0,sigma2).
%
%  References:
%    Arno Solin and Simo Sarkka (2014). Explicit link between periodic
%    covariance functions and state space models. Accepted for
%    publication in Proceedings of the Seventeenth International
%    Conference on Artifcial Intelligence and Statistics (AISTATS 2014).
%

  % Check arguments
  if nargin < 2, x = []; end

  % Check if kalman_deg is given
  if isfield(gpcf,'kalman_deg')
      kalman_deg = gpcf.kalman_deg;
  else
      kalman_deg = [];
  end

  % Check if kalman_deg_sexp is given
  if isfield(gpcf,'kalman_deg_sexp')
      kalman_deg_sexp = gpcf.kalman_deg_sexp;
  else
      kalman_deg_sexp = [];
  end

  % Check if kalman_valid is given
  if isfield(gpcf,'kalman_valid')
      kalman_valid = gpcf.kalman_valid;
  else
      kalman_valid = [];
  end

  % Case squared exponential (i.e. quasi-periodic)
  if gpcf.decay

      % Return model matrices, derivatives and parameter information
      [F,L,Qc,H,Pinf,dF,dQc,dPinf,params] = ...
          cf_quasiperiodic_to_ss(gpcf.magnSigma2,gpcf.lengthScale, ...
          gpcf.period,gpcf.lengthScale_sexp,kalman_deg, ...
          inf,kalman_deg_sexp,kalman_valid);

      % Balance matrices for numerical stability
      [F,L,Qc,H,Pinf,dF,dQc,dPinf] = ...
          ss_balance(F,L,Qc,H,Pinf,dF,dQc,dPinf);

      % Check optimized parameters
      if isempty(gpcf.p.magnSigma2), ind(1) = false; else ind(1) = true; end
      if isempty(gpcf.p.lengthScale), ind(2) = false; else ind(2) = true; end
      if isempty(gpcf.p.lengthScale_sexp), ind(3) = false; else ind(3) = true; end
      if isempty(gpcf.p.period), ind(4) = false; else ind(4) = true; end

      % Change order: lengthScale_sexp <--> period
      % Use only optimized parameter gradients
      dF(:,:,[3,4])    = dF(:,:,[4,3]);
      dQc(:,:,[3,4])   = dQc(:,:,[4,3]);
      dPinf(:,:,[3,4]) = dPinf(:,:,[4,3]);

  % Case without squared exponential (i.e. purely periodic)
  else

      % Return model matrices, derivatives and parameter information
      [F,L,Qc,H,Pinf,dF,dQc,dPinf,params] = ...
          cf_periodic_to_ss(gpcf.magnSigma2,gpcf.lengthScale, ...
            gpcf.period,kalman_deg,kalman_valid);

      % Check optimization parameters
      if isempty(gpcf.p.magnSigma2), ind(1) = false; else ind(1) = true; end
      if isempty(gpcf.p.lengthScale), ind(2) = false; else ind(2) = true; end
      if isempty(gpcf.p.period), ind(3) = false; else ind(3) = true; end

  end

  % Return only those derivatives that are needed
  dF    = dF(:,:,ind);
  dQc   = dQc(:,:,ind);
  dPinf = dPinf(:,:,ind);

end


function [x, infos] = spg_nmf(V, rank, in_options)
% Stochastic projected gradient for non-negative matrix factorization (SMU-NMF) algorithm.
%
% Inputs:
%       matrix      V
%       rank        rank
%       options     options
% Output:
%       w           solution of w
%       infos       information
%
%
% This file is part of NMFLibrary.
%
% Created by H.Kasai on Mar. 28, 2017
%
% Change log:
%
%       Mar. 14, 2018 (Hiroyuki Kasai): Fixed algorithm.
%
%       May. 20, 2019 (Hiroyuki Kasai): Added initialization module.
%
%       Jul. 12, 2022 (Hiroyuki Kasai): Modified code structures.
%

    % set dimensions and samples
    [m, n] = size(V);

    % set local options
    local_options = [];
    local_options.W_sub_mode          = 'STD';
    local_options.H_sub_mode          = 'LS';
    local_options.accel               = false;
    local_options.ls                  = false;
    local_options.precon              = false;
    local_options.h_repeat            = 1;
    local_options.rep_mode            = 'fix';
    local_options.robust              = false;

    % check input options
    if ~exist('in_options', 'var') || isempty(in_options)
        in_options = struct();
    end
    % merge options
    options = mergeOptions(get_nmf_default_options(), local_options);
    options = mergeOptions(options, in_options);

    % initialize factors
    init_options = options;
    [init_factors, ~] = generate_init_factors(V, rank, init_options);
    Wt = init_factors.W;
    H = init_factors.H;
    R = init_factors.R;

    % determine sub_mode
    if options.accel
        options.H_sub_mode = 'ACC';
    else
        if options.ls
            options.H_sub_mode = 'LS';
        else
            options.H_sub_mode = 'STD';
        end
        options.h_repeat = 1;
    end

    % permute samples
    if options.permute_on
        perm_idx = randperm(n);
    else
        perm_idx = 1:n;
    end
    V = V(:,perm_idx);
    H = H(:,perm_idx);

    % initialize
    method_name = sprintf('SPG-NMF (%s,%s)', options.W_sub_mode, options.H_sub_mode);
    epoch = 0;
    grad_calc_count = 0;
    nesterov_alpha = 1;

    if options.verbose > 0
        fprintf('# %s: started ...\n', method_name);
    end

    if strcmp(options.rep_mode, 'adaptive')
        rhoh = 1+(m+m*rank)/(1*(rank+1));
        alpha = 2;
        delta = 0.01;
    end

    % store initial info
    clear infos;
    [infos, f_val, optgap] = store_nmf_info(V, Wt, H, R, options, [], epoch, grad_calc_count, 0);

    if options.verbose > 1
        fprintf('SPG-NMF (%s,%s): Epoch = 0000, cost = %.16e, optgap = %.4e\n', options.W_sub_mode, options.H_sub_mode, f_val, optgap);
    end

    % set start time
    start_time = tic();

    % main outer loop
    while true

        % check stop condition
        [stop_flag, reason, max_reached_flag] = check_stop_condition(epoch, infos, options);
        if stop_flag
            display_stop_reason(epoch, infos, options, method_name, reason, max_reached_flag);
            break;
        end

        cnt = 0;

        % main inner loop
        for t = 1 : options.batch_size : n - 1
            cnt = cnt + 1;

            % retrieve vt and ht
            vt = V(:,t:t+options.batch_size-1);
            ht = H(:,t:t+options.batch_size-1);

            % uddate ht
            Wtv = Wt.' * vt;
            WtW = Wt.' * Wt;
            if strcmp(options.H_sub_mode, 'ACC')
                if strcmp(options.rep_mode, 'adaptive')
                    gamma = 1;
                    eps0 = 1;
                    j = 1;
                    rhoh_alpha = rhoh*alpha;
                    %while j <= floor(1+rhoh*alpha) &&  gamma >= delta*eps0
                    while j <= rhoh_alpha && gamma >= delta*eps0
                        ht0 = ht;
                        ht = ht .* (Wtv) ./ (WtW * ht);
                        ht = ht + (ht<eps) .* eps;
                        if j == 1
                            eps0 = norm(ht0-ht);
                        end
                        gamma = norm(ht0-ht);
                        j = j+1;
                    end
                else
                    for ii=1:options.h_repeat
                        ht = ht .* (Wtv) ./ (WtW * ht);
                        ht = ht + (ht<eps) .* eps;
                    end
                end
            elseif strcmp(options.H_sub_mode, 'LS')
                ht = calc_nls_nmf(vt, Wt, 1e-16);
                ht = ht + (ht<eps) * eps;
            else
                ht = ht .* (Wtv) ./ (WtW * ht);
                ht = ht + (ht<eps) .* eps;
            end

            % update W
            if strcmp(options.W_sub_mode, 'Precon')
                Wt = projection_precon_mnls(vt, ht', Wt);
            elseif strcmp(options.W_sub_mode, 'Nesterov')
                options.nesterov_maxit = 1;
                options.nesterov_func_type = 'smooth';
                %options.nesterov_func_type = 'stochastic';
                %options.nesterov_func_type = 'strong_alpha_beta';

                [Wt, apg_iter, nesterov_alpha] = nesterov_mnls(vt, ht', Wt, nesterov_alpha, options.nesterov_maxit, options.nesterov_func_type);
                %nesterov_alpha
            else
                Wt = projection_mnls(vt, ht', Wt);
            end
            Wt = Wt + (Wt<eps) .* eps;

            % store new h
            H(:,t:t+options.batch_size-1) = ht;

            grad_calc_count = grad_calc_count + m * options.batch_size;
        end

        % measure elapsed time
        elapsed_time = toc(start_time);

        % update epoch
        epoch = epoch + 1;

        % store info
        infos = store_nmf_info(V, Wt, H, R, options, infos, epoch, grad_calc_count, elapsed_time);

        % display info
        display_info(method_name, epoch, infos, options);

    end

    x.W = Wt;
    x.H(:,perm_idx) = H;

end


function out = Dstar(R, n, e, P, fun)
%finds excess distortion for a given rate at a given blocklength for
%transmission of a GMS over an AWGN (noise variance 1)
%R - rate
%n - block length (scalar)
%e - excess probability
%P - channel SNR
%fun - which function to use for calculation

%
%   Created in 2012 by Victoria Kostina (vkostina@caltech.edu)
%

%starting points - 'persistent' to make optimization faster
persistent x0;
persistent y0;
persistent nprev;

if isempty(nprev)
    nprev = 0;
end

tol = 1e-12;

options = optimset('TolX',tol, 'MaxFunEvals', 500, 'Display', 'off');
dbar = 1/(1+P);
V1 = 2*dbar^2; %no coding (amplifiers)
V = 2*dbar^2*(2 - dbar^2); %optimal blocklength-n code

Vc = P*(P+2)/2/(P+1)^2;
Vs = .5;

deltan = n - nprev; %distance between consecutive n's
x0correction = sqrt(V1/n)*Qinv(e)/2/n^(3/2)*deltan;
y0slack = .1;

k = ceil(R*n);

if ~isempty(x0)
    x0 = x0 - x0correction;
    d0 = x0;
else
    d0 = 1.8*dbar;
end

switch lower(fun)
    case 'aseparate'
        out = ASeparate();
    case 'ajoint'
        %Achievability via JSCC coding
        options = optimset('TolX',tol, 'MaxFunEvals', 500, 'Algorithm', 'active-set', 'Display', 'off');
        out = AJoint();
    case 'cht'
        %Converse via hypothesis testing
        out = Cht();
    case 'nocoding'
        %no coding
        out = ANoCoding();
    case 'approxnocoding'
        out = ApproxNoCoding();
    case 'approx'
        %gaussian approximation
        out = Approx();
    otherwise
        disp('Error: unknown type.')
end

%--------------------------------------------------------------------------
    function out = ANoCoding()
        %No coding

        out = fzero(@(d)1 - e - chi2cdf(n*d/dbar, n), d0);
    end

%--------------------------------------------------------------------------
    function out = ApproxNoCoding()
        %No coding
        out = dbar + sqrt(V1/n)*Qinv(e);
    end
%--------------------------------------------------------------------------
    function out = Approx()
        %No coding
        %C = .5*log(1 + P);
       % Rd = .5*log(1/d);
        %out = fzero(@(d)C + .5*log(d) - sqrt(1/n*(Vc + Vs))*Qinv(e), d0);
        out = dbar + sqrt(V/n)*Qinv(e);
    end

%--------------------------------------------------------------------------
    function out = Cht()
        %Converse via meta-converse

        tau = thres(k);

        out = fzero(@(d)Qrob(d, tau) - 1, d0);
        updatex0(out);

        function out = Qrob(d, tau)

            b = sqrt( tau*n/k/d );
            out = quad(@density, 0, b);
            function out = density(r)
                % v - noncentral chi square (n) /n
                % v0 - central chi square (k) /n

                out = ncx2cdf(n*(tau - k/n*d*r.^2)/P, n, n*(1 + 1/P)).*r.^(k-1).*k;

            end
        end

        function out = thres(k)
            %find tau:
            tau0 = 1 + k/n + 2*sqrt( (n*Vc + k*Vs)/n^2 )*Qinv(e);
            %out = fzero(@(tau)Prob(tau) - 1 + e, tau0, options);
            out = fzero(@(tau)Prob(tau) - 1 + e, tau0, options);

            function out = Prob(tau)

                if n < 200
                    b = 10*k/n; %Ev0 = k/n
                else
                    b = 2*k/n;
                end

                out = quad(@density, 0, b);
                function out = density(v0)
                    % v - noncentral chi square (n) /n
                    % v0 - central chi square (k) /n

                    out = ncx2cdf(n*(tau - v0)*(1+P)/P, n, n/P).*chi2pdf(n*v0,k)*n;

                end
            end
        end
    end

%--------------------------------------------------------------------------
    function out = AJoint()
        %dP/dQ is bounded by a constant. Find that constant.
        [~, gamma2] = fminbnd(@(x)-ncx2pdf(n*x, n, n*P)./chi2pdf(n*x/(1+P), n)*(1+P), 0, 10);
        gamma2 = -gamma2;

        out = fzero(@(d)bound(d) - e, d0);
        updatex0(out);
%        fprintf('AJoint: n = %i, R = %f \n', n, out);

        function out = bound(d)
            %optimize with respect to r and g; y0 = [r gg] - TOO SLOW
            if d > 1
                out = NaN;
                return;
            end
            out = goal([d 3]);

            function out = goal(dg)
                d = dg(1);

                gamma1 = log(n)/2*dg(2);

                r0 = sqrt(1 - d);
                a = max(0, r0 - sqrt(d));
                b = r0 + sqrt(d);

                A = n/2*log(1+P) + n/2 - log(gamma1) - log(gamma2);

                Fouter = @(v0)chi2pdf(k*v0, k).*k.*Iinner(v0);
                Ftail = @(v0)(1 - ncx2cdf(thresv(v0)*n,n,n/P)).*chi2pdf(k*v0,k).*k;
                %   Ftail = @(v0) exp(n/P*t./(1-2*t))./(1-2*t).^(n/2).*exp(-t*thresv(v0)).*chi2pdf(k*v0,k).*k;
                out = quad(Fouter, a^2 + tol, b^2- tol)...                      %exponent < 1
                    + quad(Ftail, a^2 + tol, b^2 - tol)...                      %exponent = 1
                    + chi2cdf((a^2 + tol)*k, k) + 1 - chi2cdf((b^2 - tol)*k, k)...      %nontypical source realization
                    + exp(1-gamma1);

                %out = quad(Ftail, a^2 + tol, b^2 - tol); %most significant
                %term

                function out = Iinner(v0)
                    %exponent < 1
                    out = zeros(1, numel(v0));
                    for j0 = 1:numel(v0)
                        Finner = @(v) ncx2pdf(n*v, n, n/P).*n.*exp(P/2/(1+P)*n*(v - thresv(v0(j0))));
                        out(j0) = quad(Finner, 0, thresv(v0(j0)) );
                    end
                    if any(isnan(out))
                        return;
                    end
                end

                function out = thresv(x)
                    %threshold for v as a function of v0
                    out = max( 0, 2*(1+P)/P/n*(A + logPdball(x)) );
                end

                function out = logPdball(x)
                    %x - distance squared from the origin (x*k central chi square k)
                    %lower bound

                    cosa = (r0^2 + x - d)./(2*r0.*sqrt(x));
                    sina = (1 - cosa.^2).^(1/2);
                    out = loggamma(k/2+1, 'LB') - loggamma((k-1)/2 +1, 'UB')- .5*log(pi)-log(k) + (k-1)*log(sina);

                    %handle small distances from the origin
                    out(x <= sqrt(d) - r0) = -Inf;
                end
            end
        end
    end

%--------------------------------------------------------------------------
    function out = ASeparate()
        %achievability via separate coding
        %R = 1

        if isempty(y0)
            %first pass
            startL = 1;
            endL = n;
        else
            startL = max( ceil((y0 - 4*y0slack)*n), 1);
            endL = min( ceil((y0 + 4*y0slack)*n), n );
        end

        %precompute channel error probability
        PeCh = ones(1, endL);
        for L = startL:endL %exp(r) - the number of messages passed from the source enc to the channel enc
            PeCh(L) = PeubChannel(P, n, L);
        end

        Peubseparate(k, d0, PeCh, e);
        out = fzero(@(d)Peubseparate(k, d, PeCh, e) - e, d0);
        updatex0(out);
        [err, curL] = Peubseparate(k, out, PeCh, e);
        updatey0(curL/n);
    end

%--------------------------------------------------------------------------
%Utilities for faster computation
    function updatex0(x)
        if ~isnan(x) && n > 100
            x0 = x;
            nprev = n;
        end
    end

%--------------------------------------------------------------------------
%Utilities for faster computation
    function updatey0(y)
        if ~isnan(y) && n > 100
            y0 = y;
        end
    end
end


function X = mrdivide(A, B)
%/   Right matrix divide for an UNBNDFUN.
%   A/B divides the UNBNDFUN A by a scalar B. More generally, it gives the
%   least-squares solution (with respect to the continuous L^2 norm) to X*B = A
%   when either A or B is an UNBNDFUN. Note that in the latter case, formally it
%   is X.' that is returned, as UNBNDFUN objects are always columns.
%
% See also QR, RDIVIDE, MLDIVIDE.

% Copyright 2017 by The University of Oxford and The Chebfun Developers.
% See http://www.chebfun.org/ for Chebfun information.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Case B is a matrix: X*B = A  ==> X = A/B = (Q*R)/B = Q*(R/B)
%
% Case A is a matrix: X*B = X*(Q*R) = A ==> X = (A/R)*Q' ==> X' = Q*(A/R)'
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

if ( (size(B, 2) ~= size(A, 2)) && ~(isa(B, 'double') && isscalar(B)) )
    error('CHEBFUN:UNBNDFUN:mrdivide:size', 'Matrix dimensions must agree.');

elseif ( isa(B, 'double') )  % UNBNDFUN / double

    if ( isscalar(B) )
        % Scalar case is easy:
        X = A;                              % Copy A to X
        X.onefun = X.onefun/B;              % mrdivide of the onefun
    else
        % Call MRDIVIDE at the ONEFUN level:
        X = A;
        X.onefun = (A.onefun/B);

%         % Alternatively, we could call QR() at the UNBNDFUN level
%         % For matrix case, we do least squares via QR:
%         [Q, R] = qr(A, 0);
%         X = Q*(R/B);
    end

elseif ( isa(A, 'double') )  % double / UNBNDFUN
    error('CHEBFUN:UNBNDFUN:mrdivide:doubleDivUnbndfun', ...
        ['/ does not support the division of a numerical matrix divided by ' ...
        'by an UNBNDFUN.']);

elseif ( isa(B, 'unbndfun') && isa(A, 'unbndfun') )
    error('CHEBFUN:UNBNDFUN:mrdivide:unbndfunDivUnbndfun', ...
        'Use ./ to divide UNBNDFUN by an UNBNDFUN.');

else
    error('CHEBFUN:UNBNDFUN:mrdivide:badArg', '%s/%s is not well-defined.', ...
        class(A), class(B));

end

end


function [ DKI, K_ADC, K_AKC, Kv1, Kv2, Kv3, I_DKI ] = fit_DKI_model( im, B_mat, thresh_val, method)
% FIT_DT    Fits the diffusion kurtosis model voxelwise to an image
%           S = S0 exp(-(bD + 1/6 b^2 * K))
%
%
% Inputs:
%
%   IM is the input image, of any dimensionality, with the diffusion
%   scans in the last dimension
%
%   B is the b-matrix, of size [3 3 N]. If the measured b matrix isn't
%   available, it can be approximated by:
%   b(:,:,n)=b_values(n)*unit_vectors(n,:)'*unit_vectors(n,:);
%
%   THRESH_VAL is a threshold for skipping the FA, ADC and vector field
%   computation in voxels x where im(x) < thresh_val. THRESH_VAL can
%   alternatively be a mask of voxels to process.
%
%   METHOD is a string, and can take the following values:
%       'linear' fits the tensor in the log domain (default)
%       'nonlinear' fits the tensor in the signal domain (recommended for
%       high b-values or when SNR is low)
%
% Outputs:
%
%   DKI is the array of coefficients

% Author: Darryl McClymont <darryl.mcclymont@gmail.com>
% Copyright © 2014-2015 University of Oxford
% Version: 0.1.1
%
% University of Oxford means the Chancellor, Masters and Scholars of
% the University of Oxford, having an administrative office at
% Wellington Square, Oxford OX1 2JD, UK.
%
% This file is part of Gerardus.
%
% 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. The offer of this
% program under the terms of the License is subject to the License
% being interpreted in accordance with English Law and subject to any
% action against the University of Oxford being under the jurisdiction
% of the English Courts.
%
% You should have received a copy of the GNU General Public License
% along with this program.  If not, see <http://www.gnu.org/licenses/>.

% check arguments
%narginchk(2, 5);
%nargoutchk(0, 5);

sz = size(im);

if (nargin < 3) || isempty(thresh_val)
    thresh_val = -inf;
end

if (nargin < 4) || isempty(method)% default method is linear least squares
    method = 'linear';
end

% check that a valid method has been given
if ~max([strcmp(method, 'linear'), strcmp(method, 'nonlinear')])
    disp('Unrecognised method, performing fast linear fitting')
end

% handle a vector with the wrong orientation
if (length(sz) == 2) && (sz(2) == 1)
    im = im';
    sz = size(im);
end

% reshape image
I_vector = reshape(im, [prod(sz(1:end-1)), sz(end)]);

% handle mask or threshold
if isscalar(thresh_val)
    thresh_val = I_vector(:,1) > thresh_val;
else
    thresh_val = logical(thresh_val);
end

% keep only the masked voxels
I_vector = double(I_vector(thresh_val(:), :));

[~, b0] = max(mean(I_vector, 1));

% normalise and take the log of the image to linearise the equation
imlog = log(abs(bsxfun(@rdivide, I_vector, I_vector(:,b0))));

% get the bvalue
bvalue = squeeze(B_mat(1,1,:) + B_mat(2,2,:) + B_mat(3,3,:))';

% normalise the B matrix
B_mat_norm = B_mat ./ repmat(permute(bvalue + eps, [3,1,2]), [3 3 1]);

% define A matrix

A_D = squeeze([B_mat_norm(1,1,:), B_mat_norm(2,2,:), B_mat_norm(3,3,:), 2*B_mat_norm(1,2,:), 2*B_mat_norm(1,3,:), 2*B_mat_norm(2,3,:)])';
% A_D in the paper is not scaled by the b value

A_K = squeeze([B_mat_norm(1,1,:).^2, B_mat_norm(2,2,:).^2, B_mat_norm(3,3,:).^2, ...
    4*B_mat_norm(1,1,:).*B_mat_norm(1,2,:), ...
    4*B_mat_norm(1,1,:).*B_mat_norm(1,3,:), ...
    4*B_mat_norm(1,2,:).*B_mat_norm(2,2,:), ...
    4*B_mat_norm(1,3,:).*B_mat_norm(3,3,:), ...
    4*B_mat_norm(2,2,:).*B_mat_norm(2,3,:), ...
    4*B_mat_norm(2,3,:).*B_mat_norm(3,3,:), ...
    2*B_mat_norm(1,1,:).*B_mat_norm(2,2,:) + 4*B_mat_norm(1,2,:).*B_mat_norm(1,2,:), ...
    2*B_mat_norm(1,1,:).*B_mat_norm(3,3,:) + 4*B_mat_norm(1,3,:).*B_mat_norm(1,3,:), ...
    2*B_mat_norm(2,2,:).*B_mat_norm(3,3,:) + 4*B_mat_norm(2,3,:).*B_mat_norm(2,3,:), ...
    8*B_mat_norm(1,2,:).*B_mat_norm(1,3,:) + 4*B_mat_norm(1,1,:).*B_mat_norm(2,3,:), ...
    8*B_mat_norm(1,2,:).*B_mat_norm(2,3,:) + 4*B_mat_norm(2,2,:).*B_mat_norm(1,3,:), ...
    8*B_mat_norm(1,3,:).*B_mat_norm(2,3,:) + 4*B_mat_norm(3,3,:).*B_mat_norm(1,2,:)])';
% this takes care of cross terms by saying that (for example) 6 x^2 y^2
% = 2 (x^2) (y^2) + 4 (xy) (xy)
% so it uses these elements of the B matrix.

A = [-bsxfun(@times, bvalue', A_D), 1/6 * bsxfun(@times, bvalue'.^2, A_K)];

% only keep b values less than 5000 in the linear fit
lin_bvals = bvalue < 5000;

% weighted fit
param.rician = 0;
param.unique_weights = 0;
param.verbose = 1;
M = weighted_linear_fit(imlog(:,lin_bvals), A(lin_bvals,:)', @(z)exp(z), param);
%M = weighted_linear_fit(imlog, A', @(z)exp(z), param);

%M = (pinv(A) * imlog')';
%M = (pinv(A' * (W.^2) * A) * A' * (W.^2) * (imlog'))';
% weighted version of M = (pinv(A) * imlog')';

% add the S0 column
M = [I_vector(:,1), M];

M_lin = M;

% perform nonlinear fitting (if required)
if strcmp(method, 'nonlinear')

    % get error
    I_recon = bsxfun(@times, M(:,1) , exp(M(:,2:end) * A'));
    rmse_lin = sqrt(mean((I_vector(:) - I_recon(:)).^2));
    %disp(['RMSE from quick fit = ' num2str(rmse_lin)])

    options = optimoptions('lsqcurvefit','Jacobian','on', 'DerivativeCheck', 'off', ...
        'display', 'off', 'MaxIter', 40);

    lb = [0 0 0 0 -1 -1 -1 ... % [S0 DTI
            0 0 0 -1 -1 -1 -1 -1 -1 0 0 0 -1 -1 -1] * 3E-3; % DKI ]

    ub = [inf, ones(1,21) * 3E-3]; % [S0 DTI DKI]

    % constrain initial guess between lower and upper bounds
    M = bsxfun(@max, M, lb);
    M = bsxfun(@min, M, ub);
    M(isnan(M(:))) = 0;
    M(isinf(M(:))) = 0;

    if (size(I_vector,1) > 1000) && (matlabpool('size') == 0)
        disp('Open matlabpool for parallel processing')
    end

    A_hat = -A';

    parfor i = 1:size(I_vector,1)

        M(i,:) = lsqcurvefit(@DKI_model, M(i,:), A_hat, I_vector(i,:), lb, ub, options);

    end

    I_recon = bsxfun(@times, M(:,1) , exp(M(:,2:end) * A'));
    rmse = sqrt(mean((I_vector(:) - I_recon(:)).^2));

    bad_fits = rmse > rmse_lin;
    %disp(['Number of bad fits: ' num2str(sum(bad_fits(:)))])
    M(bad_fits,:) = M_lin(bad_fits,:);

    %disp(['RMSE from slow fit = ' num2str(rmse)])

end

if nargout == 1
    % quick hack because reshape sz needs to be at least length 2
    if length(sz) == 2
        sz = [sz(1), 1, sz(2)];
    end

    % fill regions outside mask with zeros, and reshape
    DKI = zeros(prod(sz(1:end-1)), 22);
    DKI(thresh_val(:), :) = M;
    DKI = reshape(DKI, [sz(1:end-1), 22]);

    return
end

% compute the returned signal
I_DKI = bsxfun(@times, M(:,1), exp(M(:, 2:end) * A'));

K_v1 = zeros(1, size(M,1));
K_v2 = zeros(1, size(M,1));
K_v3 = zeros(1, size(M,1));
ADC = zeros(1, size(M,1));
AKC = zeros(1, size(M,1));

[x, y, z] = psphere(200);
x = x(1:end/2); y = y(1:end/2); z = z(1:end/2);

% Compute the kurtosis (mean and directional)
for v = 1:size(M,1)

    % reshape the coefficients

    % S0 = M(i,1);

    D_hat_i = M(v,2:7);

    % A_D = xx, yy, zz, xy, xz, yz

    % rearrange for convenience
    D_hat = D_hat_i([1 4 5 2 6 3]);

    D33 = [D_hat(1), D_hat(2), D_hat(3);
           D_hat(2), D_hat(4), D_hat(5);
           D_hat(3), D_hat(5), D_hat(6)];

    [vec, val] = eig(D33);
    % sort
    [~, ix] = sort(sum(val,1), 'descend');
    vec = vec(:, ix);
    val = sum(val(:, ix));

    % eigenvalues should be positive
    % taking the magnitude is a very bad way of handling them
    val = abs(val);

    ADC(v) = sum(val) / 3;

    D2i = M(v, 8:end);

    % A_K = xxxx, yyyy, zzzz, 1 2 3
    %       xxxy, xxxz, xyyy, 4 5 6
    %       xzzz, yyyz, yzzz, 7 8 9
    %       xxyy, xxzz, yyzz, 10 11 12
    %       xxyz, xyyz, xyzz ,13 14 15

    % re-arrange for convenience
    D2 = D2i([1, 4, 5, 10, 13, 11, 6, 14, 15, 7, 2, 8, 12, 9, 3]);

    % kurtosis tensor (includes ADC^2 internally)
    K = [ D2(01), D2(02), D2(03), D2(04), D2(05), D2(06); % xx
          D2(02), D2(04), D2(05), D2(07), D2(08), D2(09); % xy
          D2(03), D2(05), D2(06), D2(08), D2(09), D2(10); % xz
          D2(04), D2(07), D2(08), D2(11), D2(12), D2(13); % yy
          D2(05), D2(08), D2(09), D2(12), D2(13), D2(14); % yz
          D2(06), D2(09), D2(10), D2(13), D2(14), D2(15)];% zz
        %   xx      xy      xz      yy      yz      zz

    % Parallel kurtosis (kurtosis in the direction of highest diffusivity)
    v1 = vec(:, 1);

    % Diffusion in this direction
    D_v1 = v1' * D33 * v1; % = eigenvalue 1

    % kurtosis in this direction
    v1_sq = v1 * v1';
    v1_sq_vect = [v1_sq(1), 2*v1_sq(2), 2*v1_sq(3), v1_sq(5), 2*v1_sq(6), v1_sq(9)];
    K_v1(v) = (v1_sq_vect * K * v1_sq_vect') / (D_v1^2);

    % Parallel kurtosis (v2)
    v2 = vec(:, 2);

    % Diffusion in this direction
    D_v2 = v2' * D33 * v2; % = eigenvalue 2

    % kurtosis in this direction
    v2_sq = v2 * v2';
    v2_sq_vect = [v2_sq(1), 2*v2_sq(2), 2*v2_sq(3), v2_sq(5), 2*v2_sq(6), v2_sq(9)];
    K_v2(v) = (v2_sq_vect * K * v2_sq_vect') / (D_v2^2);

    % Parallel kurtosis (v3)
    v3 = vec(:, 3);

    % Diffusion in this direction
    D_v3 = v3' * D33 * v3; % = eigenvalue 3

    % kurtosis in this direction
    v3_sq = v3 * v3';
    v3_sq_vect = [v3_sq(1), 2*v3_sq(2), 2*v3_sq(3), v3_sq(5), 2*v3_sq(6), v3_sq(9)];
    K_v3(v) = (v3_sq_vect * K * v3_sq_vect') / (D_v3^2);

    % mean kurtosis
    % there are clever ways of getting this, but the easiest is to just
    % average the kurtosis over a bunch of uniformly spaced directions
    K_vi = zeros(1,length(x));
    for i = 1:length(x)
        vi = [x(i), y(i), z(i)]';
        D_vi = vi' * D33 * vi;
        vi_sq = vi * vi';
        vi_sq_vect = [vi_sq(1), 2*vi_sq(2), 2*vi_sq(3), vi_sq(5), 2*vi_sq(6), vi_sq(9)];
        K_vi(i) = (vi_sq_vect * K * vi_sq_vect') / (D_vi^2);
    end

    AKC(v) = mean(K_vi);

end

% quick hack because reshape sz needs to be at least length 2
if length(sz) == 2
    sz = [sz(1), 1, sz(2)];
end

% fill regions outside mask with zeros, and reshape
DKI = zeros(prod(sz(1:end-1)), 22);
DKI(thresh_val(:), :) = M;
DKI = reshape(DKI, [sz(1:end-1), 22]);

IDKI = zeros(prod(sz(1:end-1)), sz(end));
IDKI(thresh_val(:), :) = I_DKI;
I_DKI = reshape(IDKI, sz);

K_ADC = zeros(size(thresh_val));
K_ADC(thresh_val) = ADC;
K_ADC = reshape(K_ADC, sz(1:end-1));

K_AKC = zeros(size(thresh_val));
K_AKC(thresh_val) = AKC;
K_AKC = reshape(K_AKC, sz(1:end-1));

Kv1 = zeros(size(thresh_val));
Kv1(thresh_val) = K_v1;
Kv1 = reshape(Kv1, sz(1:end-1));

Kv2 = zeros(size(thresh_val));
Kv2(thresh_val) = K_v2;
Kv2 = reshape(Kv2, sz(1:end-1));

Kv3 = zeros(size(thresh_val));
Kv3(thresh_val) = K_v3;
Kv3 = reshape(Kv3, sz(1:end-1));

end

function [ F, J ] = DKI_model( x, Bv )

    F = x(1) * exp(-(x(2:end) * Bv));

    if nargout > 1 % Jacobian
        J = zeros(length(F), length(x));

        J(:,1) = exp(-(x(2:end) * Bv));

        J(:,2:end) = -bsxfun(@times, Bv, F)';

    end

end

%% This converts the 3x3 kurtosis tensor into a 3x3x3x3 kurtosis tensor
% It is not needed right now, but good to have for the future.

%     K_index =[01, 02, 03, 04, 05, 06; % xx
%               02, 04, 05, 07, 08, 09; % xy
%               03, 05, 06, 08, 09, 10; % xz
%               04, 07, 08, 11, 12, 13; % yy
%               05, 08, 09, 12, 13, 14; % yz
%               06, 09, 10, 13, 14, 15];% zz
%             % xx  xy  xz  yy  yz  zz
%
%     W = zeros([3 3 3 3]);
%
%     for i = 1:3
%         for j = 1:3
%              for k = 1:3
%                  for l = 1:3
%                     switch i
%                         case 1
%                             r1 = [1 2 3];
%                         case 2
%                             r1 = [2 4 5];
%                         case 3
%                             r1 = [3 5 6];
%                     end
%                     switch j
%                         case 1
%                             r2 = [1 2 3];
%                         case 2
%                             r2 = [2 4 5];
%                         case 3
%                             r2 = [3 5 6];
%                     end
%
%                     if i == j
%                         switch i
%                             case 1
%                                 r =1;
%                             case 2
%                                 r = 4;
%                             case 3
%                                 r = 6;
%                         end
%                     else
%                         r = intersect(r1, r2);
%                     end
%
%
%                     switch k
%                         case 1
%                             c1 = [1 2 3];
%                         case 2
%                             c1 = [2 4 5];
%                         case 3
%                             c1 = [3 5 6];
%                     end
%                     switch l
%                         case 1
%                             c2 = [1 2 3];
%                         case 2
%                             c2 = [2 4 5];
%                         case 3
%                             c2 = [3 5 6];
%                     end
%
%                     if k == l
%                         switch k
%                             case 1
%                                 c =1;
%                             case 2
%                                 c = 4;
%                             case 3
%                                 c = 6;
%                         end
%                     else
%                         c = intersect(c1, c2);
%                     end
%
%                     D2_index = K_index(r,c);
%
%                     W(i,j,k,l) = D2(D2_index);
%                  end
%              end
%         end
%     end
%     v1 = vec(:, 1);
%     % Diffusion in this direction
%     D_v1 = v1' * D33 * v1;
%     K_v1_vox = 0;
%     for i = 1:3
%         for j = 1:3
%             for k = 1:3
%                 for l = 1:3
%                     K_v1_vox = K_v1_vox + v1(i) * v1(j) * v1(k) * v1(l) * W(i,j,k,l);
%                 end
%             end
%         end
%     end
%     K_v1(v) = K_v1_vox / D_v1^2;


function tricost(varargin)
%TRICOST draw quality-metrics for a 2-simplex triangulation
%embedded in the two-dimensional plane.
%   TRICOST(VERT,EDGE,TRIA,TNUM) draws histograms of quality
%   metrics for the triangulation.
%   VERT is a V-by-2 array of XY coordinates in the triangu-
%   lation, EDGE is an array of constrained edges, TRIA is a
%   T-by-3 array of triangles, and TNUM is a T-by-1 array of
%   part indices. Each row of TRIA and EDGE define an eleme-
%   nt. VERT(TRIA(II,1),:), VERT(TRIA(II,2),:) and VERT(TRIA
%   (II,3),:) are the coordinates of the II-TH triangle. The
%   edges in EDGE are defined in a similar manner. NUM is an
%   array of part indexing, such that TNUM(II) is the index
%   of the part in which the II-TH triangle resides.
%
%   TRICOST(...,HVRT) additionally draws histograms of rela-
%   tive edge-length, indicating conformance to the spacing
%   constraints. HVRT is a V-by-1 array of spacing informat-
%   ion, per an evaluation of the mesh-size function at the
%   mesh vertices VERT.
%
%   See also REFINE2, SMOOTH2

%-----------------------------------------------------------
%   Darren Engwirda : 2017 --
%   Email           : de2363@columbia.edu
%   Last updated    : 09/07/2018
%-----------------------------------------------------------

    vert = [] ; conn = [] ; tria = [] ;
    tnum = [] ; hvrt = [] ;

%---------------------------------------------- extract args
    if (nargin>=+1), vert = varargin{1}; end
    if (nargin>=+2), conn = varargin{2}; end
    if (nargin>=+3), tria = varargin{3}; end
    if (nargin>=+4), tnum = varargin{4}; end
    if (nargin>=+5), hvrt = varargin{5}; end

%---------------------------------------------- basic checks
    if ( ~isnumeric(vert) || ...
         ~isnumeric(conn) || ...
         ~isnumeric(tria) || ...
         ~isnumeric(tnum) || ...
         ~isnumeric(hvrt) )
        error('tricost:incorrectInputClass' , ...
            'Incorrect input class.') ;
    end

%---------------------------------------------- basic checks
    if (ndims(vert) ~= +2 || ...
        ndims(conn) ~= +2 || ...
        ndims(tria) ~= +2 )
        error('tricost:incorrectDimensions' , ...
            'Incorrect input dimensions.');
    end
    if (size(vert,2)~= +2 || ...
        size(conn,2) < +2 || ...
        size(tria,2) < +3 )
        error('tricost:incorrectDimensions' , ...
            'Incorrect input dimensions.');
    end

    nvrt = size(vert,1) ;
    ntri = size(tria,1) ;

%---------------------------------------------- basic checks
    if (min(min(conn(:,1:2))) < +1 || ...
            max(max(conn(:,1:2))) > nvrt )
        error('tricost:invalidInputs', ...
            'Invalid EDGE input array.') ;
    end

    if (min(min(tria(:,1:3))) < +1 || ...
            max(max(tria(:,1:3))) > nvrt )
        error('tricost:invalidInputs', ...
            'Invalid TRIA input array.') ;
    end

%-- borrowed from the JIGSAW library!

%-- draw sub-axes directly -- sub-plot gives
%-- silly inconsistent ax spacing...!

    axpos31 = [.125,.750,.800,.150] ;
    axpos32 = [.125,.450,.800,.150] ;
    axpos33 = [.125,.150,.800,.150] ;

    axpos41 = [.125,.835,.800,.135] ;
    axpos42 = [.125,.590,.800,.135] ;
    axpos43 = [.125,.345,.800,.135] ;
    axpos44 = [.125,.100,.800,.135] ;

%-- draw cost histograms for 2-tria elements
    figure;
    set(gcf,'color','w','units','normalized', ...
        'position',[.05,.10,.30,.30]);
    if (~isempty(hvrt))

%-- have size-func data
    axes('position',axpos41); hold on;
    scrhist(triscr2(vert,tria),'tria3');
    axes('position',axpos42); hold on;
    anghist(triang2(vert,tria),'tria3');
    axes('position',axpos43); hold on;
    hfnhist(relhfn2(vert, ...
                    tria,hvrt),'tria3');
    axes('position',axpos44); hold on;
    deghist(trideg2(vert,tria),'tria3');

    else

%-- null size-func data
    axes('position',axpos31); hold on;
    scrhist(triscr2(vert,tria),'tria3');
    axes('position',axpos32); hold on;
    anghist(triang2(vert,tria),'tria3');
    axes('position',axpos33); hold on;
    deghist(trideg2(vert,tria),'tria3');

    end

end

function [mf] = mad(ff)
%MAD return mean absolute deviation (from the mean).

    mf = mean(abs(ff-mean(ff))) ;

end

function deghist(dd,ty)
%DEGHIST draw histogram for "degree" quality-metric.

    dd = dd(:);
    be = 1:max(dd);
    hc = histc(dd,be);

    r = [.85,.00,.00] ; y = [1.0,.95,.00] ;
    g = [.00,.90,.00] ; k = [.60,.60,.60] ;

    bar(be,hc,1.05,'facecolor',k,'edgecolor',k);

    axis tight;
    set(gca,'ycolor', get(gca,'color'),'ytick',[],...
        'xtick',2:2:12,'layer','top','fontsize',...
            14,'linewidth',2.,'ticklength',[.025,.025],...
                'box','off','xlim',[0,12]);

    switch (ty)
    case 'tria4'

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )
        text(-.225,0,'$|d|_{\tau}$',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter','latex') ;
    else
        text(-.225,0, '|d|_{\tau}' ,...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter',  'tex') ;
    end

    case 'tria3'

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )
        text(-.225,0,'$|d|_{f}$',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter','latex') ;
    else
        text(-.225,0, '|d|_{\tau}' ,...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter',  'tex') ;
    end

    end

end

function anghist(ad,ty)
%ANGHIST draw histogram for "angle" quality-metric.

    ad = ad(:);
    be = linspace(0.,180.,91);
    bm =(be(1:end-1)+be(2:end))/2.;
    hc = histc(ad,be);

    switch (ty)
    case 'tria4'
        poor = bm <  10.  | bm >= 160. ;
        okay =(bm >= 10.  & bm <  20. )| ...
              (bm >= 140. & bm <  160.);
        good =(bm >= 20.  & bm <  30. )| ...
              (bm >= 120. & bm <  140.);
        best = bm >= 30.  & bm <  120. ;

    case 'tria3'
        poor = bm <  15.  | bm >= 150. ;
        okay =(bm >= 15.  & bm <  30. )| ...
              (bm >= 120. & bm <  150.);
        good =(bm >= 30.  & bm <  45. )| ...
              (bm >= 90.  & bm <  120.);
        best = bm >= 45.  & bm <  90.  ;

    end

    r = [.85,.00,.00] ; y = [1.0,.95,.00] ;
    g = [.00,.90,.00] ; k = [.60,.60,.60] ;

    bar(bm(poor),hc(poor),1.05,...
        'facecolor',r,'edgecolor',r) ;
    bar(bm(okay),hc(okay),1.05,...
        'facecolor',y,'edgecolor',y) ;
    bar(bm(good),hc(good),1.05,...
        'facecolor',g,'edgecolor',g) ;
    bar(bm(best),hc(best),1.05,...
        'facecolor',k,'edgecolor',k) ;

    axis tight;
    set(gca,'ycolor', get(gca,'color'),'ytick',[],...
        'xtick',0:30:180,'layer','top','fontsize',...
            14,'linewidth',2.,'ticklength',[.025,.025],...
                'box','off','xlim',[0.,180.]) ;

    mina = max(1.000,min(ad)); %%!! so that axes don't obscure!
    maxa = min(179.0,max(ad));

    bara = mean(ad(:));
    mada = mad (ad(:));

    line([ mina, mina],...
        [0,max(hc)],'color','r','linewidth',1.5);
    line([ maxa, maxa],...
        [0,max(hc)],'color','r','linewidth',1.5);

    if ( mina > 25.0)
        text(mina-1.8,.90*max(hc),num2str(min(ad),'%16.1f'),...
            'horizontalalignment',...
                'right','fontsize',15) ;
    else
        text(mina+1.8,.90*max(hc),num2str(min(ad),'%16.1f'),...
            'horizontalalignment',...
                'left' ,'fontsize',15) ;
    end

    if ( maxa < 140.)
        text(maxa+1.8,.90*max(hc),num2str(max(ad),'%16.1f'),...
            'horizontalalignment',...
                'left' ,'fontsize',15) ;
    else
        text(maxa-1.8,.90*max(hc),num2str(max(ad),'%16.1f'),...
            'horizontalalignment',...
                'right','fontsize',15) ;
    end

    if ( maxa < 100.)

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )
        text(maxa-16.,.45*max(hc),...
        '$\bar{\sigma}_{\theta}\!= $',...
            'horizontalalignment', 'left',...
                'fontsize',16,'interpreter','latex') ;

        text(maxa+1.8,.45*max(hc),num2str(mad(ad),'%16.2f'),...
            'horizontalalignment',...
                'left' ,'fontsize',15) ;
    end

    else

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )
        text(maxa-16.,.45*max(hc),...
        '$\bar{\sigma}_{\theta}\!= $',...
            'horizontalalignment', 'left',...
                'fontsize',16,'interpreter','latex') ;

        text(maxa+1.8,.45*max(hc),num2str(mad(ad),'%16.3f'),...
            'horizontalalignment',...
                'left' ,'fontsize',15) ;
    end

    end

    switch (ty)
    case 'tria4'

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )
        text(-9.0,0.0,'$\theta_{\tau}$',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter','latex') ;
    else
        text(-9.0,0.0, '\theta_{\tau}' ,...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter',  'tex') ;
    end

    case 'tria3'

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )
        text(-9.0,0.0,'$\theta_{f}$',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter','latex') ;
    else
        text(-9.0,0.0, '\theta_{f}' ,...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter',  'tex') ;
    end

    end

end

function scrhist(sc,ty)
%SCRHIST draw histogram for "score" quality-metric.

    sc = sc(:);
    be = linspace(0.,1.,101);
    bm = (be(1:end-1)+be(2:end)) / 2.;
    hc = histc(sc,be);

    switch (ty)
    case{'tria4','dual4'}
        poor = bm <  .25 ;
        okay = bm >= .25 & bm <  .50 ;
        good = bm >= .50 & bm <  .75 ;
        best = bm >= .75 ;

    case{'tria3','dual3'}
        poor = bm <  .30 ;
        okay = bm >= .30 & bm <  .60 ;
        good = bm >= .60 & bm <  .90 ;
        best = bm >= .90 ;

    end

    r = [.85,.00,.00] ; y = [1.0,.95,.00] ;
    g = [.00,.90,.00] ; k = [.60,.60,.60] ;

    bar(bm(poor),hc(poor),1.05,...
        'facecolor',r,'edgecolor',r) ;
    bar(bm(okay),hc(okay),1.05,...
        'facecolor',y,'edgecolor',y) ;
    bar(bm(good),hc(good),1.05,...
        'facecolor',g,'edgecolor',g) ;
    bar(bm(best),hc(best),1.05,...
        'facecolor',k,'edgecolor',k) ;

    axis tight;
    set(gca,'ycolor', get(gca,'color'),'ytick',[],...
        'xtick',.0:.2:1.,'layer','top','fontsize',...
            14,'linewidth',2.,'ticklength',[.025,.025],...
                'box','off','xlim',[0.,1.]) ;

    mins = max(0.010,min(sc)); %%!! so that axes don't obscure!
    maxs = min(0.990,max(sc));

    line([ mins, mins],...
        [0,max(hc)],'color','r','linewidth',1.5);
    line([mean(sc),mean(sc)],...
        [0,max(hc)],'color','r','linewidth',1.5);

    if ( mins > .4)
        text(mins-.01,.9*max(hc),num2str(min(sc),'%16.3f'),...
            'horizontalalignment',...
                'right','fontsize',15) ;
    else
        text(mins+.01,.9*max(hc),num2str(min(sc),'%16.3f'),...
            'horizontalalignment',...
                'left' ,'fontsize',15) ;
    end

    if ( mean(sc) > mins + .150)
    text(mean(sc)-.01,.9*max(hc),num2str(mean(sc),'%16.3f'),...
        'horizontalalignment','right','fontsize',15) ;
    end

    switch (ty)
    case 'tria4'

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )
        text(-.04,0.0, ...
        '$\mathcal{Q}^{\mathcal{T}}_{\tau}$',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter','latex') ;
    else
        text(-.04,0.0,'Q^{t}_{\tau}',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter',  'tex') ;
    end

    case 'tria3'

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )
        text(-.04,0.0, ...
        '$\mathcal{Q}^{\mathcal{T}}_{f}$',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter','latex') ;
    else
        text(-.04,0.0,'Q^{t}_{f}',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter',  'tex') ;
    end

    case 'dual4'

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )
        text(-.04,0.0, ...
        '$\mathcal{Q}^{\mathcal{D}}_{\tau}$',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter','latex') ;
    else
        text(-.04,0.0,'Q^{d}_{\tau}',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter',  'tex') ;
    end

    case 'dual3'

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )
        text(-.04,0.0, ...
        '$\mathcal{Q}^{\mathcal{D}}_{f}$',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter','latex') ;
    else
        text(-.04,0.0,'Q^{d}_{f}',...
            'horizontalalignment','right',...
                'fontsize',22,'interpreter',  'tex') ;
    end

    end

end

function hfnhist(hf,ty)
%HFNHIST draw histogram for "hfunc" quality-metric.

    be = linspace(0.,2.,101);
    bm = (be(1:end-1)+be(2:end)) / 2.;
    hc = histc(hf,be);

    poor = bm <  .40 | bm >= 1.6  ;
    okay =(bm >= .40 & bm <  .60 )| ...
          (bm >= 1.4 & bm <  1.6 );
    good =(bm >= .60 & bm <  .80 )| ...
          (bm >= 1.2 & bm <  1.4 );
    best = bm >= .80 & bm <  1.2 ;

    r = [.85,.00,.00] ; y = [1.0,.95,.00] ;
    g = [.00,.90,.00] ; k = [.60,.60,.60] ;

    bar(bm(poor),hc(poor),1.05,...
        'facecolor',r,'edgecolor',r) ;
    bar(bm(okay),hc(okay),1.05,...
        'facecolor',y,'edgecolor',y) ;
    bar(bm(good),hc(good),1.05,...
        'facecolor',g,'edgecolor',g) ;
    bar(bm(best),hc(best),1.05,...
        'facecolor',k,'edgecolor',k) ;

    axis tight;
    set(gca,'ycolor', get(gca,'color'),'ytick',[],...
        'xtick',.0:.5:2.,'layer','top','fontsize',...
            14,'linewidth',2.,'ticklength',[.025,.025],...
                'box','off','xlim',[0.,2.]);

    line([max(hf),max(hf)],...
        [0,max(hc)],'color','r','linewidth',1.5);

    text(max(hf)+.02,.90*max(hc),num2str(max(hf),'%16.2f'),...
        'horizontalalignment','left','fontsize',15) ;

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )

    text(max(hf)-.18,.45*max(hc),'$\bar{\sigma}_{h}\! = $',...
        'horizontalalignment','left',...
            'fontsize',16,'interpreter','latex') ;

    text(max(hf)+.02,.45*max(hc),num2str(mad(hf),'%16.2f'),...
        'horizontalalignment','left','fontsize',15) ;

    end

    if ( ~(exist('OCTAVE_VERSION','builtin') > +0) )

    text(-0.10,0.0,'$h_{r}$','horizontalalignment','right',...
        'fontsize',22,'interpreter','latex') ;

    else

    text(-0.10,0.0, 'h_{r}' ,'horizontalalignment','right',...
        'fontsize',22,'interpreter',  'tex') ;

    end

end