%DTC Verzakov Tree - Trainable Decision Tree Classifier
%
%   W = DTC(A, CRIT, CHISQSTOPVAL, PRUNE, T, NFEAT)
%
% INPUT
%   A       Training dataset.
%           Object weights and class priors:
%             It is possible to assign individual weights to dataset
%             objects by using 'weights' identifier:
%
%             A = SETIDENT(A, WEIGHTS, 'weights')
%
%             If weights are not defined they assumed to be equal to 1 for
%             all objects. The actual weights used by the training routine
%             are computed by using supplied weights along with the class
%             priors (if priors are not set then the apparent priors are used):
%
%             ACTUAL_WEIGHTS(I) = M*(WEIGHTS(I)/CW(C))*(PRIOR(C)/SUM(PRIOR))
%
%             where M is the total amount of (labelled) objects in A,
%             CW is the vector weights sums for each class, and C is
%             the class of the object I. The sum of all actual weights is M.
%
%           Feature types:
%             Features are treated diffrently based on their domain information.
%             If the feature domain is empty or is the interval/collection of intervals
%             then this feature is considered to be the continuous one and
%             branches are created by splitting at the threshold value.
%             Otherwise (feature domain specifies a set of values or set of
%             names), the feature is considered to be the nominal one and
%             branches corresponding to all present feature values are
%             created.
%
%           Unknown and 'non-applicable' values:
%           If the feature value is NaN then it is assumed that its value
%           is unknown. In such a situation the object with unknown value
%           is split into fractions and sent down all branches.
%           The concept of the 'non-applicable' feature value is different
%           from the concept of the unknown (missing) value.
%           ...
%           The 'non-applicable' values for the continues features are
%           encoded as INF. If feature domain is the (set of) interval(s),
%           then INF value has to be explicitly added to the domain
%           defintion. The 'non-applicable' value of nominal features
%           does not have predefined encoding. If it is necessary user
%           have to include such value into domain definition.
%
%   CRIT   Splitting citerion name.
%          'igr' Information Gain Ratio (default):
%          As defined by Quinlan. The penalty on the number of the distinct
%          values of the continues feature is used. If the gain is zero or
%          negative due to such penalization, the split is not performed.
%          This leads to smaller trees and may give non-zero training error.
%          This criterion does not use costs. (Costs are used only at the classification step).
%
%          'gini' Gini impurity index. More precisely, the change in this
%          index. GINI index can be interpreted as a misclassification rate
%          for the stochastic prior based classifier, so costs are
%          naturally embedded. If the change in the (absolute) error less
%          or equal to 0.1 (change in the cost less or equal to 0.1 of minimal
%          absolute value of non-zero costs) the split is not performed.
%          This leads to smaller trees and may give non-zero training error.
%
%          'miscls' Classification error criterion.
%          To be used only for educational puposes because
%          it gives rather inferior results. Costs are naturally embedded.
%
%   CHISQSTOPVAL Early stopping crtitical value for the chi-squared test
%          on the difference between the original node class distribution and
%          branches class distributions. CHISQSTOPVAL is 0 by default.
%          Which means that branches will be discarded only if they bring no
%          change in class distribution.
%
%   PRUNE  Pruning type name
%          'prunep' - pessimistic (top-down) pruning as defined by Quinlan.
%          Pessimistic pruning be perfromed if cost matrix is defined.
%          'prunet' - test set (bottom-up) pruning using the (required)
%          dataset T.
%          These implementations of both pruning algorithms may be not
%          exactly correct if there are unknown values in datastes.
%
%   T      Test test for the test set pruning
%
% OUTPUT
%   W      Classifier mapping
%
% DESCRIPTION
%    If (full grown) branches of (sub)tree do not improve classification error
%    (misclassification cost) they are immediatley discarded.
%    This may happen because we use regularized posteriors. As a result
%    the algorithm is more stable, trees are smaller, but split on
%    the training set may be not perfect.
%
% REFERENCES
% [1] J.R. Quinlan, Simplifying Decision Trees, International Journal of
%     Man-Machine Studies, 27(3), pp. 221-234, 1987.
% [2] J.R. Quinlan, Improved use of continuous attributes in C4.5. Journal
%     of AI Research, 4(96), pp. 77-90, 1996.
%
% see also DATASETS, MAPPINGS, TREEC

% Copyright: S. Verzakov, s.verzakov@gmail.com
% Based on prtools' treec, tree_map, and their subroutines
% by Guido te Brake and R.P.W Duin

function w = dtc(a, crit, chisqstopval, prune, t, nfeat)

		% When no input data is given, an empty tree is defined:
	if (nargin == 0) || isempty(a)

    if nargin < 2 || isempty(crit)
			crit = 'igr';
    end

    if nargin < 3 || isempty(chisqstopval)
      chisqstopval = 0;
    end

    if nargin < 4 || isempty(prune)
      prune = '';
    end

    if nargin < 5
      t = [];
    end

    if nargin < 6
      nfeat = [];
    end

    w = prmapping('dtc', {crit, chisqstopval, prune, t, nfeat});
    w = setname(w, ['DecTree' upper(crit)]);

  elseif (nargin == 2) && ismapping(crit)
    % Execution
    w = crit;
    tree = +w;

    % B contains posteriors.
    % We do not need to convert posteriors to costs.
    % PRTools will do it automatically

    b = mapdt(tree, +a);
    b = setdat(a,b,w);
%    b = setfeatlab(b, getlabels(w));

    w = b;

  else
    % Training

    if nargin < 2 || isempty(crit)
      crit = 'igr';
    end

    if nargin < 3 || isempty(chisqstopval)
      chisqstopval = 0;
    end

    if nargin < 4 || isempty(prune)
      prune = '';
    end

    if nargin < 5
      t = [];
    end

    if nargin < 6
      nfeat = [];
    end

    if ~any(strcmpi(crit, {'igr', 'gini', 'miscls'}))
      error('Unknown splitting criterion');
    end

    islabtype(a,'crisp');
    isvaldfile(a, 1, 2); % at least 1 object per class, 2 classes
    a = seldat(prdataset(a)); % get rid of all unlabelled objects

    m = size(a,1);
    % Get weights (if defined)
    weights = getident(a, 'weights');
    if isempty(weights)
      weights = ones([m 1]);
    else
     idx = (weights > 0);
     if nnz(idx) < m
       a = a(idx, :);
       weights = weights(idx);
     end
     isvaldset(a, 1, 2);
    end

    % First get some useful parameters:

    % Sizes
    [m, k, c] = getsize(a);
    cs = classsizes(a);

    % Determine if features are categorical
    featdom = getfeatdom(a);
    featdom = featdom(:)';
    if isempty(featdom)
      feattype = zeros(1, k);
    else
      feattype = cellfun(@(x) ischar(x) || (size(x,1)==1), featdom);
    end

    % Features to use
    usefeat = true([1, k]);
    if ~isempty(nfeat)
      nfeat = min(nfeat, k);
    end

    % Labelling
    nlab = getnlab(a);

    % Get priors
    prior = getprior(a);
    prior = prior/sum(prior);

    % Define weights:
    % the total sum of weights is equal to m
    % Compute class weights
    cw = zeros(size(cs));
    for i=1:c
      cw(i) = sum(weights(nlab == i));
    end
    % Rescale objects weights
    % by class weight factors derived from priors
    cwf = m*prior./cw;
    weights = weights.*(cwf(nlab)).';

    % Miscalssification cost
    cost = a.cost;

    % Now the training can really start:
    tree = makedt(+a, feattype, usefeat, nfeat, c, nlab, weights, cost, crit, chisqstopval);

    if ~isempty(prune)
      if strcmpi(prune, 'prunep')
        if ~isempty(cost)
          error('Pessimistic prunning based on misclassification costs is not implemented');
        end
        tree = prunep(tree);
      elseif strcmpi(prune, 'prunet')
        if isempty(t)
          error('Test set is not specified for the test set prunning');
        end
         tree = prunet(tree, t, cost);
      else
        error('Unkown prunning method');
      end

      tree = cleandt(tree);
    end

    % Store the results:
    w = prmapping('dtc', 'trained', {tree}, getlablist(a), k, c);
    w = setname(w, ['DecTree' upper(crit)]);
    w = setcost(w, cost);
  end

  return

%MAKEDT General tree building algorithm
%
%   TREE = MAKEDT(A, FEATTYPE, USEFEAT, NFEAT, C, NLAB, WEIGHTS, COST, CRIT, CHISQSTOPVAL)
%
% INPUT
%   A      Data matrix
%
%   FEATTYPE Row defining the feature types (0 - continues, 1 - nominal)
%
%   USEFEAT Row defining the features to be used for splitting
%
%   NFEAT  The maximum number of features for which splitting has to be
%          attempted. If the number of the available features is geater
%          than NFEAT the random subset of NFEAT features will be used for
%          splitting.
%
%  C       Total number of classes in the initial dataset
%
%  NLAB    Numeric class labels of objects in A
%
%  WEIGHTS Weights of objects in A
%
%  COST    Misclassification costs
%
%  CRIT    Name of splitting criterion to be used
%
%  CHISQSTOPVAL Crtitical value for the chi-squared test
%
% OUTPUT
%   TREE   Structure containing arrays defining decision tree.
%          .NSMP The number of samples. NSMP(J) is the sum of weights of objects
%          which reached the node J.
%
%          .POST Posterior probabilities. POST(J, :) is the class
%          distribution at the node J. Object weights are taken into
%          account. 0 and 1 probablities are avoided by perfroming Bayes
%          uniform priors regularization.
%
%          .CIDX Class index. CIDX(J) is the class corresponding to the
%          node J if it considered as a leaf.
%
%          .ERRL Leaf error. ERRL(J) is the misclassification error (cost)
%          on training samples which reached the node J if this node is
%          considered to be a leaf.
%
%          .ERRT Leaf error. ERRT(J) is the misclassification error (cost)
%          on training samples which reached the node J if this node is
%          considered to be a root of the (sub)tree.
%
%          .SIZE Tree size. SIZE(J) is the (sub)tree size with root at the
%          node J.
%
%          .FIDX Feature index. FIDX(J) is the index of the feature on
%          which node J is split. FIDX(J) == 0 means that J is a leaf.
%
%          .FVAL Feature value(s). For nominal features FVAL{J} is the set
%          of feature values observed at the node J (LENGTH(FVAL{J} == 0
%          for the leaf, otherwise it is > 1).
%          For continues features, if LENGTH(FVAL{J}) == 1 then it contains
%          threshold THR for splitting into the left (<= THR) and the
%          right (> THR) branches. If FVAL{J} == [] (and J is not a leaf)
%          then it means that split is perfromed between applicable and
%          non-applicable values.
%
%          .NIDX Branch node indices. For nominal features NIDX{J,K} is
%          the index of branch node of node J with value FVAL{J,K}
%          of feature FIDX(J). For continues features (if LENGTH(FVAL{J}) == 1)
%          NIDX{J,1} is the index of the left branch node, NIDX{J,2} is the
%          index of the right branch node. If FVAL{J} == []
%          (and J is not a leaf) then NIDX{J,1} is the index of branch node
%          containing objects with applicable values of feature FIDX(J) and
%          NIDX{J,2} is the index of branch node containing objects with
%          non-applicable values of the same feature.
%
% This is a low-level routine called by DTC.
%
% See also IGR, GINI, MISCLS

function tree = makedt(a, feattype, usefeat, nfeat, c, nlab, weights, cost, crit, chisqstopval)

  % Construct the tree:

  % Find (absolute) class frequencies
  C = zeros(1, c);
  for j=1:c
    C(j) = sum(weights(nlab == j));
  end

  NC = nnz(C);
  tree.nsmp = sum(C);

  % regularization by 'uniform' Bayesian priors;
  C0 = C;
  C = C + 1;
  p = C/sum(C);

  if isempty(cost)
    [maxpost, cidx] = max(p);
    errc = tree.nsmp*(1-maxpost);
    %errc = tree.nsmp - C0(cidx);
  else
    costp = p*cost;
    [mincost, cidx] = min(costp);
    errc = mincost;
  end

  tree.post = p;
  tree.cidx = cidx;
  tree.errl = errc;
  tree.errt = errc;
  tree.size = 1;

  if NC ~= 1 % not a pure class dataset
    % now the tree is recursively constructed further:
		% use desired split criterion
    [fidx, fval, nb, bidx, chisqval] = findsplit(+a, feattype, usefeat, nfeat, c, nlab, weights, cost, crit);

    % When the stop criterion is not reached yet, we recursively split
		% further:
    if ~isempty(fidx) && (chisqval > chisqstopval)
      tree.fidx = fidx;
      tree.fval = {fval};

      if feattype(fidx) > 0
        usefeat(fidx) = 0;
      end

      uidx = bidx == 0;
      nu = nnz(uidx);
      if nu > 0
        knsmp = tree.nsmp - sum(weights(uidx));
      end

      tree.nidx = {zeros(1, nb)};
      tree.errt(1) = 0;
      for j=1:nb
        tree.nidx{1}(j) = tree.size(1) + 1;

        J = bidx == j;
        if nu == 0
          bweights = weights(J);
        else
          J = J | uidx;
          bweights = weights(J);
          buidx = uidx(J);
          bknsmp = sum(bweights(~buidx));
          bweights(buidx) = (bknsmp/knsmp)*bweights(buidx);
        end

        branch = makedt(+a(J, :), feattype, usefeat, nfeat, c, nlab(J), bweights, cost, crit, chisqstopval);

        branch.nidx = cellfun(@(x) x + tree.size(1)*(x>0), branch.nidx, 'UniformOutput', false);
        tree.errt(1) = tree.errt(1) + branch.errt(1);
        tree.size(1) = tree.size(1) + size(branch.nidx, 1);

        tree.nsmp = [tree.nsmp; branch.nsmp];
        tree.post = [tree.post; branch.post];
        tree.cidx = [tree.cidx; branch.cidx];
        tree.errl = [tree.errl; branch.errl];
        tree.errt = [tree.errt; branch.errt];
        tree.size = [tree.size; branch.size];
        tree.fidx = [tree.fidx; branch.fidx];
        tree.fval = [tree.fval; branch.fval];
        tree.nidx = [tree.nidx; branch.nidx];
      end
    end
  end

  % no improvement in error (cost), rollback
  if (tree.size(1) > 1) && (tree.errt(1) >= tree.errl(1))
    tree.nsmp = tree.nsmp(1);
    tree.post = tree.post(1,:);
    tree.cidx = tree.cidx(1);
    tree.errl = tree.errl(1);
    tree.errt = tree.errl(1); % sic!
    tree.size = 1;
  end

  if tree.size(1) == 1
    % We reached the stop criterion or no further split is possible
    % so we make a leaf node:
    tree.fidx = 0;
    tree.fval = {[]};
    tree.nidx = {[]};
  end

	return

%MAPDT Tree mapping and node statistic calculation
%
% 	[P, S] = MAPDT(TREE, A, NLAB, WEIGHTS)
%

function [p, s] = mapdt(tree, a, nlab, weights)

  persistent dt st

  if isstruct(tree)
    dt = tree;

    if nargin < 4
      weights = [];
    end

    if nargin < 3
      nlab = [];
    end

    m = size(a, 1);
    [n, c] = size(dt.post);
    p = zeros([m, c]);

    if (nargout < 2) || isempty(nlab)
      st = [];

      for i=1:m
        p(i, :) = mapdt(1, +a(i, :));
      end

    else
      st = zeros([n, c]);
      nlab (nlab > c) = 0;
      if isempty(weights)
        weights = ones(m, 1);
      end

      for i=1:m
        p(i, :) = mapdt(1, +a(i, :), nlab(i), weights(i));
      end
    end

    s = st;
    clear dt st

  else
    j = tree;

    while j > 0
      if ~isempty(st) && (nlab > 0)
        st(j, nlab) = st(j, nlab) + weights;
      end

      k = 0;
      fidx = dt.fidx(j);

      if fidx ~= 0
        nidx = dt.nidx{j};
        aval = a(fidx);

        if ~isnan(aval)
          fval = dt.fval{j};

          if isempty(fval)
            k = nidx(2 - (aval ~= inf));
          elseif length(fval) == 1
            if aval ~= inf
              k = nidx(2 - (aval <= fval));
            elseif length(nidx) == 3
              k = nidx(3);
            end;
          else
            k = nidx(aval == fval);
            if isempty(k)
              k = 0;
            end
          end

        else
          p = zeros([1, size(dt.post, 2)]);
          if isempty(st) || (nlab <= 0)
            for b=1:length(nidx)
              k = nidx(b);
              f = (dt.nsmp(k)/dt.nsmp(j));
              p = p + f*mapdt(nidx(b), a);
            end
          else
            for b=1:length(nidx)
              k = nidx(b);
              f = (dt.nsmp(k)/dt.nsmp(j));
              p = p + f*mapdt(nidx(b), a, nlab, f*weights);
            end
          end
          k = -1;
        end
      end

      if k == 0
        p = dt.post(j, :);
      end

      j = k;
    end
  end

  return

%FINDSPLIT General routine for finding the best split
%
% 	[FIDX, FVAL, NB, BIDX, CHISQVAL, CRITVAL] = FINDSPLI(A, FEATTYPE, USEFEAT, NFEAT, C, NLAB, WEIGHTS, COST, CRIT)
%

function [fidx, fval, nb, bidx, chisqval, critval] = findsplit(a, feattype, usefeat, nfeat, c, nlab, weights, cost, crit)

  selfeatidx = find(usefeat);
  nf = length(selfeatidx);
  if ~isempty(nfeat) && (nfeat < nf)
    permidx = randperm(length(selfeatidx));
    selfeatidx = selfeatidx(permidx(1:nfeat));
    nf = nfeat;
  end

  fval = cell([1, nf]);
  chisqval = zeros([1, nf]);
  critval = nan([1, nf]);

  % repeat for all selected features
  for f=1:nf
    fidx = selfeatidx(f);
    af = a(:, fidx);

    kidx = ~isnan(af); % known values index
    if nnz(kidx) == 0
      continue
    end

    MU = sum(weights(~kidx)) + realmin;

    af = af(kidx);
    wk = weights(kidx);
    nlabk = nlab(kidx);

    switch feattype(fidx)
      case 0 % continous/ordered feature
        naidx = af == inf;
        NA = repmat(realmin, [1 c]);
        MNA = c*realmin;
        nlabna = nlabk(naidx);
        nna = length(nlabna);
        if nna > 0
          for j = 1:c
            NA(1,j) = sum(wk(nlabna == j)) + realmin;
          end
          MNA = sum(NA);
        end

        apidx = find(~naidx);
        af = af(apidx);
        wap = wk(apidx);
        nlabap = nlabk(apidx);
        [af, sortidx] = sort(af);
        wap = wap(sortidx);
        nlabap = nlabap(sortidx);

        if length(af) == 1
          uv = af;
          ns = 0;
          sli = [];
        else
          labchngcount = cumsum([1; double(diff(nlabap) ~= 0)]);
          uniquevallowidx = find([true; ((diff(af)./(0.5*abs(af(1:end-1) + af(2:end)) + realmin)) > 1e-8)]);
          uniquevalhighidx = [(uniquevallowidx(2:end) - 1); length(af)];
          % unique values
          uv = af(uniquevalhighidx);

          % split low indices in unique values
          sli = find(labchngcount(uniquevalhighidx(2:end)) - labchngcount(uniquevallowidx(1:end-1)) > 0);
          % split low indices in af
          splitlowidx = uniquevalhighidx(sli);
          ns = length(splitlowidx);
        end

        if (ns == 0) && (nna == 0)
          continue
        end

        % applicable, left, and right branch class counts
        AP = zeros(1, c);
        L = zeros(ns, c);
        R = zeros(ns, c);

        for j = 1:c
          J = find(nlabap == j);
          mj = length(J);
          AP(j) = sum(wap(J));
          if (ns > 0) && (mj > 0)
            L(:, j) = (repmat(splitlowidx, [1, mj]) >= repmat(J.', [ns, 1]))*wap(J) + realmin;
            R(:, j) = AP(j) - L(:, j) + realmin;
          end
        end
        AP = AP + 2*realmin;

        % total count of applicable
        MAP = sum(AP);

        % known
        K = AP + NA;
        MK = MNA + MAP;

        % object counts for branches
        ML = sum(L, 2);
        MR = sum(R, 2);

        [cv, i] = feval(crit, 0, MU, MK, K, MNA, NA, MAP, AP, ML, L, MR, R, cost, weights, uv, sli);
        critval(f) = cv;

        if ~isnan(cv) && (cv > -inf)
          if (ns > 0) && ~isempty(i)
            t = splitlowidx(i);
            fval{f} = 0.5*(af(t) + af(t+1));

            if nna == 0
              APL = AP*(ML(i)/MAP);
              APR = AP*(MR(i)/MAP);
              chisqval(f) = sum(((L(i, :) - APL).^2)./APL + ((R(i, :) - APR).^2)./APR);
            else
              KNA = K*(MNA/MK);
              KL = K*(ML(i)/MK);
              KR = K*(MR(i)/MK);
              chisqval(f) = sum(((NA - KNA).^2)./KNA + ((L(i, :) - KL).^2)./KL + ((R(i, :) - KR).^2)./KR);
            end
          else
            fval{f} = [];
            KNA = K*(MNA/MK);
            KAP = K*(MAP/MK);
            chisqval(f) = sum(((NA - KNA).^2)./KNA + ((AP(i, :) - KAP).^2)./KAP);
          end
        end

      case 1 % nominal feature
        vf = unique(af);
        v = length(vf);

        B = zeros(v, c);
        for j=1:c
          J = find(j == nlab);
          mj = length(J);
          if mj > 0
            B(:, j) = (repmat(vf, [1, mj]) ==  repmat(af(J).', [v 1]))*weights(J);
          end
        end

        B = B + realmin;

        % class counts for known
        K = sum(B, 1);

        % total known count
        MK = sum(K);

        % object counts for branches
        MB = sum(B, 2);

        cv = feval(crit, 1, MU, MK, K, MB, B, cost, weights);
        critval(f) = cv;

        if ~isnan(cv) && (cv > -inf)
          KB = MB.*K/MK;
          chisqval(f) = sum(sum(((B - KB).^2)./KB));
          fval{f} = bf;
        end
    end
  end

  % best criterion over all features
  testfeatidx = find(~isnan(critval) & (critval > -inf));
  if isempty(testfeatidx)
    fidx = [];
    fval = [];
    nb = [];
    bidx = [];
    chisqval = [];
    critval = [];

  else
    [critval, fidx] = max(critval(testfeatidx));
    fidx = testfeatidx(fidx);
    fval = fval{fidx};
    chisqval = chisqval(fidx);
    fidx = selfeatidx(fidx);

    af = a(:, fidx);
    m = size(af, 1);
    bidx = zeros(m, 1);

    switch feattype(fidx)
      case 0
        apidx = af < inf;

        if ~isempty(fval)
          lidx = af <= fval;
          ridx = apidx & ~lidx;
          bidx(lidx) = 1;
          bidx(ridx) = 2;
          nb = 2;
        else
          bidx(apidx) = 1;
          nb = 1;
        end

        naidx = ~isnan(af) & ~apidx;
        if nnz(naidx) > 0
          nb = nb + 1;
          bidx(naidx) = nb;
        end

      case 1
        nb = length(fval);
        for i=1:nb
          bidx(af == fval(i)) = i;
        end
    end
  end

  return

%IGR The information gain ratio
%
% 	[CRITVAL, IDX] = IGR(FEATTYPE, MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, COST, WEIGHTS, UV, SLI)
%   [CRITVAL, IDX] = IGR(FEATTYPE,MU, MK, K, MB, B, COST, WEIGHTS

function [critval, idx] = igr(feattype, varargin)

  switch feattype
    case 0
      [MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, cost, weights, uv, sli] = deal(varargin{:});

      M = MK + MU;

      infoold = - K * log2(K.'/MK);
      infonew = - NA * log2(NA.'/MNA);
      infosplit = - MU * log2(MU/M) - MNA * log2(MNA/M);

      if ~isempty(R)
        infolr = - ( ...
          sum(L .* log2(L./(repmat(ML, [1 size(L, 2)]))), 2) + ...
          sum(R .* log2(R./(repmat(MR, [1 size(R, 2)]))), 2) ...
        );

        % best criterion value over all thresholds
        [infolr, idx] = min(infolr);

        infonew = infonew + infolr;
        infosplit = infosplit - [ML(idx), MR(idx)] * log2([ML(idx); MR(idx)]/M);

      else
        idx = [];
        infonew = infonew - AP * log2(AP.'/MAP);
        infosplit = infosplit - MAP * log2(MAP/M);
      end

      infothresh = log2(max(length(uv) - 1, 1));
      infogain = (infoold - infonew - infothresh);

    case 1
      idx = [];
       [MU, MK, K, MB, B, cost, weights] = deal(varargin{:});

      M = MK + MU;

      infoold = - K * log2(K.'/MK);
      infosplit = - MU.' * log2(MU/M);

      infonew = - sum(sum(B .* log2(B./(repmat(MB, [1 size(B, 2)]))), 2), 1);
      infosplit = infosplit - MB.' * log2(MB/M);

      infogain = (infoold - infonew);
  end

  % infogain = infogain / M;
  % infosplit = infospit / M;

  if infogain > 0
    critval = infogain / infosplit;
  else
    critval = -inf;
  end

  return

%GINI
%
% 	[CRITVAL, IDX] = GINI(FEATTYPE, MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, COST, WEIGHTS, UV, SLI)
%   [CRITVAL, IDX] = GINI(FEATTYPE,MU, MK, K, MB, B, COST, WEIGHTS%

function [critval, idx] = gini(feattype, varargin)

  switch feattype
    case 0
      [MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, cost, weights, uv, sli] = deal(varargin{:});

      if isempty(cost)
        purityold = K * (K.'/MK);
        %impurityold = MK - purityold;

        if ~isempty(R)
          puritylr = ( ...
            sum(L .* (L./(repmat(ML, [1 size(L, 2)]))), 2) + ...
            sum(R .* (R./(repmat(MR, [1 size(R, 2)]))), 2) ...
          );

          % best criterion value over all thresholds
          [puritylr, idx] = max(puritylr);
          puritynew = puritylr + NA * (NA.'/MNA);

        else
          idx = [];
          puritynew = AP * (AP.'/ MAP) + NA * (NA.'/MNA);
        end

        %impuritynew = MK - puritynew;
        deltaimpurity = puritynew - purityold;

      else
        impurityold = K * cost * (K.'/MK);

        if ~isempty(R)
          impuritylr = ...
            sum((L*cost) .* (L./(repmat(ML, [1 size(L, 2)]))), 2) + ...
            sum((R*cost) .* (R./(repmat(MR, [1 size(R, 2)]))), 2);

          [impuritylr, idx] = min(impuritylr);
          impuritynew = impuritylr + NA * cost * (NA.'/MNA);

        else
          idx = [];
          impuritynew = AP * cost* (AP.'/ MAP) + NA * cost *(NA.'/MNA);
        end

        deltaimpurity = impurityold - impuritynew;
      end

    case 1
      idx = [];
      [MU, MK, K, MB, B, cost, weights] = deal(varargin{:});

      if isempty(cost)
        purityold = K * (K.'/MK);
        %impurityold = MK - purityold;
        puritynew = sum(sum(B .* (B./(repmat(MB, [1 size(B, 2)]))), 2));
        %impuritynew = MK - puritynew;
        deltaimpurity = puritynew - purityold;

      else
        impurityold = K * cost * (K.'/MK);
        impuritynew = ( ...
          sum(sum((B*cost) .* (B./(repmat(MB, [1 size(B, 2)]))), 2), 1) ...
        );

        deltaimpurity = impurityold - impuritynew;
      end
  end

  if isempty(cost)
    deltamin = 0.1;
  else
    deltamin = 0.1*min(abs(cost(abs(cost) > 0)));
  end

  if deltaimpurity > deltamin
    critval = deltaimpurity/(MU+MK);
  else
    critval = -inf;
  end

  return

%MISCLS Miscalssification error
%
% 	[CRITVAL, IDX] = MISCLS(FEATTYPE, MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, COST, WEIGHTS, UV, SLI)
%   [CRITVAL, IDX] = MISCLS(FEATTYPE,MU, MK, K, MB, B, COST, WEIGHTS
%

function [critval, idx] = miscls(feattype, varargin)

  switch feattype
    case 0
      [MU, MK, K, MNA, NA, PRMAP, AP, ML, L, MR, R, cost, weights, uv, sli] = deal(varargin{:});

      if isempty(cost)
        ccold = max(K, [], 2);
        if ~isempty(R)
          ccnew = max(L, [], 2) + max(R, [], 2);
          [ccnew, idx] = max(ccnew);
          ccnew = ccnew + max(NA, [], 2);
        else
          idx = [];
          ccnew = max(AP, [], 2) + max(NA, [], 2);
        end

        deltamc = ccnew - ccold;

      else
        mcold = min(K*cost, [], 2);
        if ~isempty(R)
          mcnew = min(L*cost, [], 2) + min(R*cost, [], 2);
          [mcnew, idx] = min(mcnew);
           mcnew = mcnew + min(NA*cost, [], 2);
        else
          idx = [];
          mcnew = min(AP*cost, [], 2) + min(NA*cost, [], 2);
        end

        deltamc = mcold - mcnew;
      end

    case 1
      idx = [];
      [MU, MK, K, MB, B, cost, weights] = deal(varargin{:});

      if isempty(cost)
        ccold = max(K, [], 2);
        ccnew = sum(max(B, [], 2), 1);
        deltamc = ccnew - ccold;
      else
        mcold = min(K*cost, [], 2);
        mcnew  = sum(min(B*cost, [], 2), 1);
        deltamc = mcold - mcnew;
      end
  end

  %if isempty(cost)
  %  deltamin = min(weights(weights > 0));
  %else
  %  deltamin = min(weights(weights > 0))*min(cost(cost > 0));
  %end
  %
  %if ~isempty(deltamin)
  %  deltamin = 0.5*deltamin;
  %else
  %  deltamin = 0;
  %end
  %
  %if deltamc <= deltamin
  %  critval = -inf;
  %else
  %  critval = deltamc / (MU+MK);
  %end

  critval = deltamc / (MU+MK);

  return

%PRUNEP Pessimistic pruning of a decision tree
%
% 	TREE = PRUNEP(TREE,NODE)
%
% Pessimistic pruning defined by Quinlan.

function tree = prunep(tree, node)

  persistent pt;

  if (nargout ~= 0) || (nargin ~= 1) || ~isscalar(tree) || ~isnumeric(tree) || ~isint(tree)
    if nargin < 2 || isempty(node)
      node = 1;
    end

    pt = tree;
    prunep(node);
    tree = pt;
    clear pt;

  else
    node = tree;
    if pt.fidx(node) > 0
      tnidx = (node+1):(node + pt.size(node) - 1);

      nleaves = nnz(pt.fidx(tnidx) == 0);
      errt = pt.errt(node) + 0.5*nleaves;
      errl = pt.errl(node) + 0.5;
      nsmp = pt.nsmp(node);
      sd = sqrt(errt*(1-errt/nsmp));

      if errl < (errt + sd)
        pt.fidx(tnidx) = -1;

        pt.errt(node) = pt.errl(node);
        pt.size(node) = 1;
        pt.fidx(node) = 0;
        pt.fval(node) = {[]};
        pt.nidx(node) = {[]};

      else
        errt = 0;
        for i=1:length(pt.nidx{node})
          idx = pt.nidx{node}(i);
          prunep(idx);
          errt = errt + pt.errt(idx);
        end
        pt.errt(idx) = errt;
      end
    end
  end

  return

%PRUNET Prune tree by testset
%
% 	TREE = PRUNET(TREE,T,COST)
%
% The test set a is used to prune a decision tree.

function tree = prunet(tree, t, cost)

  persistent pt;

  if (nargout ~= 0) || (nargin ~= 1) || ~isscalar(tree) || ~isnumeric(tree) || ~isint(tree)
    if nargin < 3
      cost = [];
    end

    [m, k, c] = getsize(t);

    cs = classsizes(t);
    prior = getprior(t);
    prior = prior/sum(prior);
    weights = m*prior./cs;

    pt = tree;
    mt = size(pt.post,1);
    [p, s] = mapdt(pt, +t, getnlab(t), weights);

    % error (cost) in each node as if there were leafs
    if isempty(cost)
      idx = sub2ind([mt, c], (1:mt).', pt.cidx);
      pt.test_errl = sum(s,2) - s(idx);
    else
      pt.test_errl = sum(s .* cost(:, pt.cidx).', 2);
    end

    pt.test_errt = pt.test_errl;

    prunet(1);
    tree = pt;
    clear pt;

  else
    node = tree;
    if pt.fidx(node) > 0
      test_errt = 0;
      errt = 0;

      for i=1:length(pt.nidx{node})
        idx = pt.nidx{node}(i);
        prunet(idx);
        test_errt = test_errt + pt.test_errt(idx);
        errt = errt + pt.errt(idx);
      end

      if pt.test_errl(node) <= test_errt
        pt.fidx(pt.nidx{node}) = -1;

        pt.errt(node) = pt.errl(node);
        pt.size(node) = 1;
        pt.fidx(node) = 0;
        pt.fval(node) = {[]};
        pt.nidx(node) = {[]};

      else
        pt.test_errt(node) = test_errt;
        pt.errt(node) = errt;
      end
    end
  end;

  return

function tree = cleandt(tree)

  rnidx = tree.fidx == -1;
  if nnz(rnidx) == 0
    return
  end

  rncount = cumsum(rnidx);
  fn = fieldnames(tree);
  for i=1:length(fn)
    tree.(fn{i})(rnidx, :) = [];
  end

  tree.nidx = cellfun(@(x) x - rncount(x).', tree.nidx, 'UniformOutput', false);

  idx = (1:length(rnidx)).';
  idx(rnidx) = [];
  tree.size = tree.size - (rncount(idx) - rncount(idx + tree.size - 1));

 	return


function DEM_coupled_oscillators
% Dual estimation of the Lorenz system: Cross-validation of Laplace schemes
%__________________________________________________________________________
% This routine illustrates the inversion of a loosely coupled oscillator
% model using generalised filtering. In this example, three regions are
% coupled in terms of their amplitude and phase in a hierarchical fashion.
% Data are generated under a particular set of parameters. The timeseries
% are then transformed using a Hilbert transform into the corresponding
% analytic signal. This then constitutes the data feature for subsequent
% inversion using generalised filtering; here, in four generalised
% coordinates of motion. By assuming fairly precise priors on the amplitude
% of random fluctuations one can recover the parameters and use the
% posterior density for subsequent Bayesian model comparison. In this
% example, we used Bayesian model reduction to assess the evidence for
% models with and without amplitude or phase coupling.
%
% The parameters and orders of this example have been optimised to provide
% proof of principle this sort of  model can be inverted using generalised
% filtering.  The sensitivity to these parameters and orders can be
% assessed numerically by editing the code.
%__________________________________________________________________________
% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging

% Karl Friston
% $Id: DEM_coupled_oscillators.m 7679 2019-10-24 15:54:07Z spm $

% specify states and parameters
%==========================================================================
N     = 128;                             % number of time points
n     = 3;                               % number of sources (oscillators)
Hz    = 8;                               % characteristic frequency (Hz)
dt    = 1/64;                            % sampling interval (sec)

% model states (where hidden states comprise phase differences)
%--------------------------------------------------------------------------
x.r   = zeros(n,1);                      % amplitude
x.p   = zeros(n,1);                      % phase  differences
x.w   = zeros(1,1);                      % phase (common to sources)

% model parameters
%--------------------------------------------------------------------------
A     = spm_speye(n,n,-1);               % form of adjacency matrix
P.L   = diag(ones(n,1));                 % lead field (measurement mapping)
P.Ap  = A/16 - A'/32 - eye(n,n)/16;      % amplitude coupling
P.Ar  = A/16 + A'/4;                     % phase coupling
P.C   = sparse(1,1,1,n,1)/8;             % exogenous input to first source
P.r   = 1/8;                             % weak amplitude
P.w   = 2*pi*Hz*dt;                      % intrinsic frequency

% observation function (to generate timeseries)
%--------------------------------------------------------------------------
g = @(x,v,P) P.L*((x.r).*cos(x.p + x.w));

% equations of motion (simplified coupled oscillator model)
%--------------------------------------------------------------------------
f = @(x,v,P) [P.Ap*(x.r - P.r) + P.C*v;
              sum(P.Ar.*sin(bsxfun(@minus,x.p,x.p')),2) - P.C*v; ...
              P.w];

% causes or exogenous input (a Gaussian function of peristimulus time)
%--------------------------------------------------------------------------
U = exp(-((1:N) - N/2).^2/((N/8)^2));    % exogenous input
T = (1:N)*dt;                            % sample times (seconds)

% parameters for generalised filtering (see spm_LAP)
%--------------------------------------------------------------------------
E.n     = 4;                             % embedding dimension
E.d     = 1;                             % data embedding
E.nN    = 8;                             % number of iterations
E.s     = 1/2;                           % smoothness of fluctuations

% first level state space model
%--------------------------------------------------------------------------
M(1).E  = E;                             % filtering parameters
M(1).x  = x;                             % initial states
M(1).f  = f;                             % equations of motion
M(1).g  = g;                             % observation mapping
M(1).pE = P;                             % model parameters
M(1).V  = exp(12);                       % precision of observation noise
M(1).W  = exp(12);                       % precision of state noise

% second level - causes or exogenous forcing term
%--------------------------------------------------------------------------
M(2).v  = 0;                             % initial causes
M(2).V  = exp(16);                       % precision of exogenous causes

% create data with known parameters (P)
%==========================================================================
DEM = spm_DEM_generate(M,U,P);

% transform analytic signal to create a new data feature
%==========================================================================

% analytic signal (via Hilbert transform)
%--------------------------------------------------------------------------
Y  = spm_hilbert(full(DEM.Y)');          % analytic signal
Yr = abs(Y)';                            % amplitude
Yp = unwrap(angle(Y));                   % phase
Yp = Yp' - ones(n,1)*(1:N)*P.w;          % phase difference
Y  = [Yr; Yp];                           % analytic data feature

% show synthetic data,latent states and exogenous input
%--------------------------------------------------------------------------
spm_figure('GetWin','synthetic data');
spm_DEM_qU(DEM.pU);

subplot(4,2,2), plot(T,DEM.pU.x{1}(1:n,:)')
title('hidden amplitude','FontSize',16)
xlabel('time (seconds)'), spm_axis tight, box off

subplot(4,2,4), plot(T,DEM.pU.x{1}((1:n) + n,:)')
title('phase difference','FontSize',16)
xlabel('time (seconds)'), spm_axis tight, box off

subplot(4,2,6), plot(T,Yr)
title('response amplitude','FontSize',16)
xlabel('time (seconds)'), spm_axis tight, box off

subplot(4,2,8), plot(T,Yp)
title('unwrapped phase','FontSize',16)
xlabel('time (seconds)'), spm_axis tight, box off
drawnow

% Now try to recover model parameters from data features
%==========================================================================

% change observation function (g) to generate analytic signal
%--------------------------------------------------------------------------
g = @(x,v,P) [P.L*x.r; x.p];

% initialization of priors over parameters
%--------------------------------------------------------------------------
pE       = P;                            % prior parameters
pC       = spm_zeros(P);                 % prior variance

pE.Ar    = zeros(n,n);                   % set prior phase and amplitude
pE.Ap    = -speye(n,n)/16;               % coupling parameters to 0
pC.Ar    = (P.Ar ~= 0);                  % and set the prior variance to 1
pC.Ap    = (P.Ap ~= 0);

Vr       = ones(1,n)*8;                  % log precision of sampling noise
Vp       = ones(1,n)*8;                  % and state noise

% place new observation function and priors in generative model
%--------------------------------------------------------------------------
DEM.M(1).g  = g;
DEM.M(1).pE = pE;
DEM.M(1).pC = pC;
DEM.M(1).V  = exp([Vr Vp]);
DEM.M(1).W  = exp([Vr Vp 32]);           % use precise beliefs about time

% data and known input; removing initial time points to suppress artefacts
%--------------------------------------------------------------------------
DEM.Y = Y(:,8:end);
DEM.U = U(:,8:end);

% Inversion using generalised filtering
%==========================================================================
LAP   = spm_DEM(DEM);

% Show parameters
%--------------------------------------------------------------------------
spm_figure('GetWin','Parameters'); clf; spm_DEM_qP(LAP.qP,LAP.pP)
subplot(2,1,1),legend('mean','90% CI','Location','North'), legend(gca,'boxoff')
title('Estimated and true (black) parameters','FontSize',16)

% use Bayesian model reduction to test different hypotheses
%==========================================================================
model{1} = 'no coupling';
model{2} = 'no amplitude coupling';
model{3} = 'no phase coupling';
model{4} = 'Full model';

% apply precise shrinkage priors to off-diagonal coupling elements
%--------------------------------------------------------------------------
PC{1} = pC; PC{1}.Ar = diag(diag(pC.Ar)); PC{1}.Ap = diag(diag(pC.Ap));
PC{2} = pC; PC{2}.Ap = diag(diag(pC.Ap));
PC{3} = pC; PC{3}.Ar = diag(diag(pC.Ar));
PC{4} = pC;

%  evaluate the evidence for these new models or prior constraints
%--------------------------------------------------------------------------
qE    = LAP.qP.P{1};
qC    = LAP.qP.C;
pE    = LAP.M(1).pE;
pC    = LAP.M(1).pC;
for m = 1:numel(PC)
    rC     = diag(spm_vec(PC{m}));
    F(m,1) = spm_log_evidence(qE,qC,pE,pC,pE,rC);
end

% report marginal log likelihood or evidence
%--------------------------------------------------------------------------
F = F - min(F);

spm_figure('GetWin','Model Comparison');clf;
subplot(2,2,1), bar(F,'c')
title('Log evidence','FontSize',16)
xlabel(model), axis square, box off

subplot(2,2,2), bar(spm_softmax(F(:)),'c')
title('Probability','FontSize',16)
xlabel(model), axis square, box off


classdef UniversalElementSet < AbstractElementSet
    %KeplerianElementSet Summary of this class goes here
    %   Detailed explanation goes here

    properties
        c3(1,1) double = 0; %km^2/s^2
        rP(1,1) double = 1000 %km
        inc(1,1) double %rad
        raan(1,1) double %rad
        arg(1,1) double %rad
        tau(1,1) double %s

        optVar UniversalElementSetVariable
    end

    properties(Constant)
        typeEnum = ElementSetEnum.UniversalElements
    end

    methods
        function obj = UniversalElementSet(time, c3, rP, inc, raan, arg, tau, frame)
            if(nargin > 0)
                obj.time = time;
                obj.c3 = c3;
                obj.rP = rP;
                obj.inc = inc;
                obj.raan = raan;
                obj.arg = arg;
                obj.tau = tau;
                obj.frame = frame;
            end
        end

        %vectorized
        function cartElemSet = convertToCartesianElementSet(obj)
            cartElemSet = convertToCartesianElementSet(convertToKeplerianElementSet(obj));
        end

        %vectorized
        function kepElemSet = convertToKeplerianElementSet(obj)
%             gmu = obj.frame.getOriginBody().gm;
            gmu = NaN(length(obj), 1);
            for(i=1:length(obj))
                gmu(i) = obj(i).frame.getOriginBody().gm;
            end

            sma = -gmu./[obj.c3];
            ecc = abs(1 - [obj.rP]./sma);

            n = computeMeanMotion(sma, gmu);
            mean = [obj.tau] .* n;
            tru = computeTrueAnomFromMean(mean, ecc);

%             kepElemSet = KeplerianElementSet(obj.time, sma, ecc, obj.inc, obj.raan, obj.arg, tru, obj.frame);
            kepElemSet = repmat(KeplerianElementSet.getDefaultElements(), size(obj));
            for(i=1:length(obj))
                kepElemSet(i) = KeplerianElementSet(obj(i).time, sma(i), ecc(i), obj(i).inc, obj(i).raan, obj(i).arg, tru(i), obj(i).frame);
            end
        end

        %vectorized
        function geoElemSet = convertToGeographicElementSet(obj)
            geoElemSet = convertToGeographicElementSet(convertToCartesianElementSet(obj));
        end

        %vectorized
        function univElemSet = convertToUniversalElementSet(obj)
            univElemSet = obj;
        end

        function elemVect = getElementVector(obj)
            elemVect = [obj.c3,obj.rP,rad2deg(obj.inc),rad2deg(obj.raan),rad2deg(obj.arg),obj.tau];
        end
    end

    methods(Access=protected)
        function displayScalarObject(obj)
            fprintf('Universal State \n\tTime: %0.3f sec UT \n\tC3 Energy: %0.3f km^2/s^2 \n\tRp: %0.9f km \n\tInc: %0.3f deg \n\tRAAN: %0.3f deg \n\tArg Peri: %0.3f deg \n\tTime Past Peri.: %0.3f s \n\tFrame: %s\n', ...
                    obj.time, ...
                    obj.c3, ...
                    obj.rP, ...
                    rad2deg(obj.inc), ...
                    rad2deg(obj.raan), ...
                    rad2deg(obj.arg), ...
                    obj.tau, ...
                    obj.frame.getNameStr());
        end
    end

    methods(Static)
        function elemSet = getDefaultElements()
            elemSet = UniversalElementSet();
        end

        function errMsg = validateInputOrbit(errMsg, hC3, hRp, hInc, hRaan, hArg, hTau, bodyInfo, bndStr, checkElement)
            if(isempty(bndStr))
                bndStr = '';
            else
                bndStr = sprintf(' (%s Bound)', bndStr);
            end

            if(checkElement(2))
                Rp = str2double(get(hRp,'String'));
                enteredStr = get(hRp,'String');
                numberName = ['Radius of Periapsis', bndStr];
                lb = 0;
                ub = Inf;
                isInt = false;
                errMsg = validateNumber(Rp, numberName, lb, ub, isInt, errMsg, enteredStr);
            end

            if(checkElement(1))
                c3 = str2double(get(hC3,'String'));
                enteredStr = get(hC3,'String');
                numberName = ['C3 Energy', bndStr];
                lb = -Inf;
                ub = Inf;
                isInt = false;
                errMsg = validateNumber(c3, numberName, lb, ub, isInt, errMsg, enteredStr);
            end

            if(checkElement(3))
                inc = str2double(get(hInc,'String'));
                enteredStr = get(hInc,'String');
                numberName = ['Inclination', bndStr];
                lb = 0;
                ub = 180;
                isInt = false;
                errMsg = validateNumber(inc, numberName, lb, ub, isInt, errMsg, enteredStr);
            end

            if(checkElement(4))
                raan = str2double(get(hRaan,'String'));
                enteredStr = get(hRaan,'String');
                numberName = ['Right Asc. of the Asc. Node', bndStr];
                lb = -360;
                ub = 360;
                isInt = false;
                errMsg = validateNumber(raan, numberName, lb, ub, isInt, errMsg, enteredStr);
            end

            if(checkElement(5))
                arg = str2double(get(hArg,'String'));
                enteredStr = get(hArg,'String');
                numberName = ['Argument of Periapsis', bndStr];
                lb = -360;
                ub = 360;
                isInt = false;
                errMsg = validateNumber(arg, numberName, lb, ub, isInt, errMsg, enteredStr);
            end

            if(checkElement(6))
                tru = str2double(get(hTau,'String'));
                enteredStr = get(hTau,'String');
                numberName = ['Time Past Periapsis', bndStr];
                lb = -Inf;
                ub = Inf;
                isInt = false;
                errMsg = validateNumber(tru, numberName, lb, ub, isInt, errMsg, enteredStr);
            end
        end
    end
end


classdef nntopology < nntest
  properties (TestParameter)
    topology = {'sequential', 'diamond'}
    conserveMemory = {false, true}
  end

  methods (Test)
    function testEval(test, topology, conserveMemory)
      if strcmp(test.currentDataType, 'double'), return ; end

      x = Input() ;

      switch topology
      case 'sequential'
        % a sequence of 3 layers that can be worked out by hand.

        % network input
        x_value = [1, -1] ;
        x_value = reshape(single(x_value), 1, 1, 2) ;

        % expected output
        y_value = [1, 2] ;
        y_value = reshape(single(y_value), 1, 1, 2) ;

        % expected derivative
        x_der = [-1, 0] ;
        x_der = reshape(single(x_der), 1, 1, 2) ;

        % derivative for backprop
        y_der = ones(1, 1, 2, 'single') ;

        % convs will just be the identity, or its negative
        w_value = reshape(eye(2, 'single'), 1, 1, 2, 2) ;

        y = vl_nnconv(x, Param('value', w_value), []) ;
        y = vl_nnrelu(y) ;
        y = vl_nnconv(y, Param('value', -w_value), Param('value', single([2, 2]))) ;

      case 'diamond'
        % input branches out into 2 middle layers, which are then joined
        % again. tests correct accumulation of derivatives, and math
        % operators.

        % network input
        x_value = [3; 10] ;

        % expected output
        y_value = [9; 30] ;

        % expected derivative
        x_der = [3; 3] ;

        % derivative for backprop
        y_der = ones(2, 1) ;

        % ensure they're matrix multiplies, instead of scalar
        x1 = 2 * eye(2) * x ;
        x2 = 5 * eye(2) * x ;
        y = x2 - x1 ;

      otherwise
        error('Unknown topology.')
      end

      % name layers, create net and set input
      Layer.workspaceNames() ;
      net = Net(y, 'conserveMemory', conserveMemory) ;

      % handle GPU
      if strcmp(test.currentDevice, 'gpu')
        gpuDevice(1) ;
        net.move('gpu') ;
        y_der = gpuArray(y_der) ;
      end

      % run forward and backward
      net.eval({'x', x_value}, 'normal', y_der) ;

      % check output and input derivatives
      disp('Output:') ;
      disp(squeeze(net.getValue(y))) ;
      disp('Input derivative:') ;
      disp(squeeze(net.getDer(x))) ;

      test.eq(net.getValue(y), y_value) ;
      test.eq(net.getDer(x), x_der) ;
    end
  end
end


function [qt] = m32qt(m3)
% Convert volume from cubic meters to US liquid quarts.
% Chad Greene 2012
qt = m3*1056.6882094;


function [ scmap_all,poly ] = get_sticks_segmentation( p, im, joints )

stride = 4; %p.stride;
half_stride = stride/2;
scale_factor = p.scale_factor;
sz = 17;

scmap_height = ceil(size(im, 1) * scale_factor / stride);
scmap_width = ceil(size(im, 2) * scale_factor / stride);

joint_pairs = [1 2; 2 3; 6 5; 4 5; 7 8; 8 9; 12 11; 11 10; 13 14];
limb_size_coefs = [1.0 1.0 1.0 1.0 0.8 0.8 0.8 0.8 1.0];

num_sticks = size(joint_pairs, 1) + 1;

scmap_all = zeros(scmap_height, scmap_width, num_sticks);

for k = 1:size(joint_pairs, 1)
    scmap = zeros(scmap_height, scmap_width);
    limb_sz = sz * limb_size_coefs(k);

    jnt1 = joints(joint_pairs(k, 1), :);
    jnt2 = joints(joint_pairs(k, 2), :);
    if ~isnan(jnt1(1)) && ~isnan(jnt2(1))

        % stick heatmap
        diff = jnt2-jnt1;
        if norm(diff) > 1.0
            perp = [-diff(2) diff(1)];
            perp = perp/norm(perp);
            % construct stick polygon
            poly = zeros(5, 2, 'double');
            poly(1,:) = jnt1-perp*limb_sz;
            poly(2,:) = jnt1+perp*limb_sz;
            poly(3,:) = jnt2+perp*limb_sz;
            poly(4,:) = jnt2-perp*limb_sz;
            poly(5,:) = poly(1,:);

            for j = 1:scmap_height
                for i = 1:scmap_width

                    crd = [i-1, j-1]*stride;
                    if p.res_net
                        crd = crd + half_stride;
                    end
                    crd = single(crd)/scale_factor;
                    [in, on] = inpolygon(crd(1),crd(2),poly(:,1),poly(:,2));
                    scmap(j, i) = in | on;
                end
            end

            if k ~= 9
                for j = 1:scmap_height
                    for i = 1:scmap_width

                        crd = [i-1, j-1]*stride;
                        if p.res_net
                            crd = crd + half_stride;
                        end
                        crd = single(crd)/scale_factor;

                        if norm(crd-jnt1) <= limb_sz
                            scmap(j, i) = 1;
                        end
                        if norm(crd-jnt2) <= limb_sz
                            scmap(j, i) = 1;
                        end
                    end
                end
            end
        end
    end

    scmap_all(:,:,k) = scmap(:,:);
end

% torso
jnt = zeros(4, 2);
joints = int32(joints);
jnt1 = double(joints(3, :));
jnt2 = double(joints(4, :));
jnt3 = double(joints(9, :));
jnt4 = double(joints(10, :));

if ~isnan(jnt1(1)) && ~isnan(jnt2(1)) && ~isnan(jnt3(1)) && ~isnan(jnt4(1))
    points = zeros(1, 2);

    index = 1;

    if all(jnt1 == jnt2)
        jnt2(1) = jnt1(1) + 1;
    end
    diff12 = normalise(jnt2-jnt1);
    points(index, :) = jnt2 + diff12*sz;
    index = index + 1;
    points(index, :) = jnt1 - diff12*sz;
    index = index + 1;

    if all(jnt1 == jnt3)
        jnt3(2) = jnt1(2) - 1;
    end
    diff13 = normalise(jnt3-jnt1);
    points(index, :) = jnt3 + diff13*sz;
    index = index + 1;
    points(index, :) = jnt1 - diff13*sz;
    index = index + 1;

    if norm(jnt3 - jnt4) <= sz*1.5
        if all(jnt4 == jnt3)
            jnt4(1) = jnt3(1) + 1;
        end

        diff34 = normalise(jnt4-jnt3);
        points(index, :) = jnt4 + diff34*sz;
        index = index + 1;
        points(index, :) = jnt3 - diff34*sz;
        index = index + 1;
    end

    if all(jnt2 == jnt4)
        jnt4(2) = jnt2(2) - 1;
    end
    diff24 = normalise(jnt4-jnt2);
    points(index, :) = jnt4 + diff24*sz;
    index = index + 1;
    points(index, :) = jnt2 - diff24*sz;
    index = index + 1;

    I = convhull(points(:,1), points(:, 2));
    poly = points(I, :);

    scmap = zeros(scmap_height, scmap_width);
    for j = 1:scmap_height
        for i = 1:scmap_width

            crd = [i-1, j-1]*stride;
            if p.res_net
                crd = crd + half_stride;
            end
            crd = single(crd)/scale_factor;
            [in, on] = inpolygon(crd(1),crd(2),poly(:,1),poly(:,2));
            scmap(j, i) = in | on;
        end
    end

    scmap_all(:,:,size(scmap_all, 3)) = scmap(:,:);
end

end

function out = normalise(vec)
vec = double(vec);
n = norm(vec);
if n <= 1
end
out = vec/norm(vec);
end


%% uniform grid
[node,elem,HB] = cubemesh([-1,1,-1,1,-1,1],1);
showmesh3(node,elem);
findnode3(node,'all');
[node,hexelem] = tet2hex(node,elem,HB);

%% Adaptive grid
[node,elem,HB] = cubemesh([-1,1,-1,1,-1,1],1/4);
[node,elem] = delmesh(node,elem,'x<0 & y<0');
bdFlag = setboundary3(node,elem,'Neumann');
for k = 1:2
    eta = abs(sign(f(node(elem(:,1),:))) + sign(f(node(elem(:,2),:)))...
            + sign(f(node(elem(:,3),:))) + sign(f(node(elem(:,4),:))));
    refineElem = find(eta < 4);
    [node,elem,bdFlag,HB] = bisect3(node,elem,refineElem,bdFlag,HB);
end
[tempvar,bdFace] = findboundary3(elem,bdFlag);
showmesh(node,bdFace);
[node,hexelem] = tet2hex(node,elem,HB);

%% sphere
function s = f(p)
    s = sum(p.^2,2) - (0.5)^2;
end


function [cm3] = mi32cm3(mi3)
% Convert volume from cubic miles to cubic centimeters.
% Chad Greene 2012
cm3 = mi3*4168181825400000 ;


function D = driving_function_mono_sdm_kx_pw(kx,nk,f,conf)
%DRIVING_FUNCTION_MONO_SDM_KX_PW driving signal for a plane wave in SDM in
%the kx-domain
%
%   Usage: D = driving_function_mono_sdm_kx_pw(kx,nk,f,conf)
%
%   Input parameters:
%       kx          - kx dimension [nx1]
%       nk          - direction of plane wave / m [1x3]
%       f           - frequency of the monochromatic source / Hz
%       conf        - configuration struct (see SFS_config)
%
%   Output parameters:
%       D           - driving function signal [nx1]
%
%   See also: driving_function_mono_sdm_kx, sound_field_mono_sdm_kx

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

%% ===== Checking of input  parameters ==================================
nargmin = 4;
nargmax = 4;
narginchk(nargmin,nargmax);
isargmatrix(kx,nk);
isargpositivescalar(f);
isargstruct(conf);

%% ===== Configuration ==================================================
xref = conf.xref;
c = conf.c;
dimension = conf.dimension;
driving_functions = conf.driving_functions;

%% ===== Computation ====================================================
% Calculate the driving function in time-frequency domain

% Frequency
omega = 2*pi*f;
D = zeros(1,length(kx));

if strcmp('2D',dimension)

    % === 2-Dimensional ==================================================

    % Ensure 2D
    nk = nk(:,1:2);

    switch driving_functions
    case 'default'
        % --- SFS Toolbox ------------------------------------------------
        to_be_implemented;
    otherwise
        error(['%s: %s, this type of driving function is not implemented ', ...
            'for a 2D plane wave.'],upper(mfilename),driving_functions);
    end

elseif strcmp('2.5D',dimension)

    % === 2.5-Dimensional ================================================

    switch driving_functions
    case 'default'
        % --- SFS Toolbox ------------------------------------------------
        % D_2.5D using a plane wave as source model
        %
        %                   e^(-i w/c nky*xrefy)
        % D_2.5D(x0,w) = 4i ----------------------
        %                     (2) /w          \
        %                    H0  | - nky*xrefy |
        %                         \c          /
        %
        % https://sfs.rtfd.io/en/3.2/d_nfchoa/#equation-fd-sdm-plane-25d
        %
        idx = find(kx>=omega/c*nk(:,1),1,'first');
        D(idx) = 4*1i*exp(-1i*omega/c*nk(2).*xref(2)) / ...
            besselh(0,2,omega/c.*nk(2).*xref(2));
        %
    otherwise
        error(['%s: %s, this type of driving function is not implemented ', ...
            'for a 2.5D plane wave.'],upper(mfilename),driving_functions);
    end

elseif strcmp('3D',dimension)

    % === 3-Dimensional ==================================================

    switch driving_functions
    case 'default'
        % --- SFS Toolbox ------------------------------------------------
        to_be_implemented;
    otherwise
        error(['%s: %s, this type of driving function is not implemented ', ...
            'for a 3D plane wave.'],upper(mfilename),driving_functions);
    end

else
    error('%s: the dimension %s is unknown.',upper(mfilename),dimension);
end


function [fitresult, gof, x, y] = createFit(num_feats, mean_r,varargin)
%CREATEFIT(NUM_FEATS,MEAN_R)
%  Create a fit.
%
%  Data for 'untitled fit 1' fit:
%      X Input : num_feats
%      Y Output: mean_r
%  Output:
%      fitresult : a fit object representing the fit.
%      gof : structure with goodness-of fit info.
%
%  See also FIT, CFIT, SFIT.

%  Auto-generated by MATLAB on 09-Jan-2018 14:30:55

%% Fit: 'untitled fit 1'.
[xData, yData] = prepareCurveData( num_feats, mean_r );

% Set up fittype and options.
ft = fittype( '(1-b*exp(-a*x))+c', 'independent', 'x', 'dependent', 'y' );
opts = fitoptions( 'Method', 'NonlinearLeastSquares' );
opts.Display = 'Off';
opts.Lower = [0 -Inf -Inf];
opts.StartPoint = [0.0358727641861837 0.448641991059645 0.835416899160867];
opts.Upper = [1 Inf Inf];

% Fit model to data.
[fitresult, gof] = fit( xData, yData, ft, opts );

% % Plot fit with data.
hold on;
h = plot( fitresult, xData, yData);
 set(gca,'XScale','log')
 set(h,varargin{:})
 x=h(2).XData;y=h(2).YData;
% legend( h, 'mean_r vs. num_feats', 'untitled fit 1', 'Location', 'NorthEast' );
% Label axes
% xlabel num_feats
% ylabel mean_r
% grid on
clf;


function [sys,x0,str,ts]=ADRC_Two_order(t,x,u,flag,r0,h,B01,B02,B03,D,b0,c,r1,h1)

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

function sys=mdlOutputs(x,c,r1,h1,b0)
    e3=x(1)-x(3);
    e4=x(2)-x(4);
    sys=-fhan(e3,c*e4,r1,h1)-x(5)/b0;
function sys=mdlGetTimeOfNextVarHit(t,h)
    sys=t+h;

 function y=fhan(x1,x2,r,h)
d=r*h;
d0=h*d;
y=x1+h*x2;
a0=sqrt(d^2+8*r*abs(y));
if abs(y)>d0
    a=x2+(a0-d)*sign(y)/2;
else
    a=x2+y/h;
end

if abs(a)>d
    y=-r*sign(a);
else
    y=-r*a/d;
end

function f=fal(e,a,d)
    if abs(e)<d
        f=e*d^(a-1);
    else f=(abs(e))^a*sign(e);
    end


function representations = batch_flipped_chol_omp(data_matrix, nk, threshold, quiet)
    if nargin < 3
        threshold = 1e-3;
    end
    if nargin < 4
        quiet = false;
    end
    % Number of data vectors
    ns = size(data_matrix, 2);
    % Computes sparse representations of the data vectors
    data_matrix = spx.norm.normalize_l2(data_matrix);
    % support set for each vector [one row for each vector]
    support_sets = ones(ns, nk);
    % termination vector
    % contains the number of iterations in each a particular vector was solved.
    % initially it is set to K
    % the moment residual norm reduces below the threshold
    % we mark it as finished and store the number of iterations
    % in this vector
    termination_vector = nk * ones(ns, 1);
    % gram matrix
    gram_matrix = data_matrix' * data_matrix;
    % initialize the correlation matrix
    correlation_matrix = abs(gram_matrix);
    prev_delta = zeros(1, ns);
    % Initialization of residual norms
    res_norm_sqr = ones(1, ns);
    % the Cholesky factors
    L = zeros(ns, nk, nk);
    % Initialize it
    L(:, 1,1) = 1;
    for iter=1:nk
        if ~quiet
            fprintf('.');
        end
        k2 = iter-1;
        % set all the diagonal entries (inner product with self) to zero.
        correlation_matrix(1:ns+1:end) = 0;
        % the inner product of a residual with each atom is stored along a column
        % we need to take maximum of each column to identity the best matching atom
        [~, best_match_indices] = max(correlation_matrix, [], 1);
        % we fill in the support set
        support_sets(:, iter) = best_match_indices;
        if (iter ~= nk)
            % we need to compute residuals except for the last iteration.
            % iterate for each data point
            for s=1:ns
                if termination_vector(s) == nk
                    % pick support for this vector
                    support_set = support_sets(s, 1:iter);
                    lambda = support_set(end);
                    if iter > 1
                        b = gram_matrix(support_set(1:k2), lambda);
                        opts = struct();
                        opts.LT= true;
                        LL = reshape(L(s, 1:k2, 1:k2), [k2, k2]);
                        w = linsolve(LL, b, opts);
                        L(s, iter, 1:iter) = [w' sqrt(1 - w' * w)];
                    end
                    % now solve for the coefficients using LL' z = p(:,Gamma)
                    h0 = gram_matrix(:,s);
                    h0lamba = h0(support_set);
                    LL = reshape(L(s, 1:iter, 1:iter), [iter, iter]);
                    opts = struct();
                    opts.LT = true;
                    z1 = linsolve(LL, h0lamba, opts);
                    opts = struct();
                    opts.LT = true;
                    opts.TRANSA = true;
                    z = linsolve(LL, z1, opts);
                    % pick gram submatrix
                    submatrix = gram_matrix(:, support_set);
                    beta = submatrix * z;
                    h = h0 - beta;
                    % put the new correlations into correlation matrix
                    correlation_matrix(:, s) = abs(h);
                    delta = z' * beta(support_set);
                    res_norm_sqr(s) = res_norm_sqr(s) - delta + prev_delta(s);
                    prev_delta(s) = delta;
                    if res_norm_sqr(s) < threshold
                        % The processing of this vector is complete
                        termination_vector(s) = iter;
                    end
                end
            end
        end
    end
    % disp(termination_vector');
    % final computation of coefficients
    % the values of coefficients corresponding to support sets
    coefficients_matrix = zeros(ns, nk);
    % Creation of sparse representation matrix
    for s=1:ns
        % number of iterations for this vector
        k = termination_vector(s);
        support_set  = support_sets(s, 1:k);
        x = data_matrix(:, s);
        % pick atoms from the unnormalized data matrix
        submatrix = data_matrix(:, support_set);
        % solve the least squares problem
        coeff = submatrix \ x;
        % if (s == 1)
        %     disp(submatrix(1:10, :));
        %     disp(x(1:10));
        %     disp(coeff);
        % end
        % put the coefficients back into coefficients matrix
        coefficients_matrix(s, 1:k) = coeff';
    end

    % each column varies from 1 to ns
    % each row is just a repetition
    column_indices  = repmat((1:ns)', 1, nk);

    % the support set, column_indices and coefficients_matrix are combined to form
    % the representation matrix at the end of function as follows
    % the support set contains row number
    % the column_indices contains the column number
    % the values contains the value of the non-zero entry
    % ns, ns is the size of the sparse matrix.
    representations = sparse( support_sets(:), column_indices(:), coefficients_matrix(:), ns, ns);
    iterations = termination_vector;
    if ~quiet
        fprintf('\n');
    end
end


function e = rmModelSearchFit(p,Y,trends,params,rawrss);
% rmModelSearchFit - actual fit function of rmSearchFit
%
% error = rmModelSearchFit(p,Y,trends,params);
%
% Basic fit with several hard limits on where the values can
% go. When encountering a set limit error will go to infinity. We
% may want to consider a more smooth limit.
%
% 2006/06 SOD: wrote it.

% sigma should be > 0 and < sigmaRatioInfVal
% This is a hard border beyond which the estimates cannot go.
if p(3)<=0 | p(3)>params.analysis.sigmaRatioInfVal, e = realmax; return; end;

% don't estimate too far away from the stimulus size, say 10x
if sqrt(p(1).^2+p(2).^2) > 10*max([params.stim(:).stimSize]), e = realmax; return; end;

% input check for 1 or 2 Gaussians
if numel(p) == 3,
  gaussianId = [p(3) p(3) 0 p(1) p(2)];
else,
  % also check that second Gaussian is at least twice as big as the
  % first one
  if p(4)< 2.*p(3) | p(4)>params.analysis.sigmaRatioInfVal, e = realmax; return; end;
  gaussianId = [p(3) p(3) 0 p(1) p(2);p(4) p(4) 0 p(1) p(2)];
end;

% make prediction
[pred, weight] = rfMakePrediction(params,gaussianId);

% Another hard border that depends on the relative overlap with
% stimulus window and penalizes pRFs too far away or too
% large. We'll do this only for the 1st pRF.
if weight(1)<0.01, e = realmax; return; end;

% fit
X = [pred trends];
b = pinv(X)*Y;

% Last sanity checks:
% The first pRF should be positive.
if b(1)<0, e = realmax; return; end;
% For two Gaussians the center should always be positive.
if numel(p) == 4,
  if b(1)+b(2)<=0, e = realmax; return; end;
end;

% RSS weighted by amount within of RF in stimulus window
% e = sum((Y - X*b).^2) ./ weight;
e = norm(Y - X*b).^2;

% if rawrss is given scale rss relative to rawrss,
% otherwise report actuall rss.
if nargin > 4,
  e = e./rawrss.*100;
end;

return;


 function dt = distance(S,p1,p2)
        dt = norm(S(:,p1) - S(:,p2));
 end


function net = GNGUpdate(oSignals,net)
% Update GNG

%--------------------------------------------------------------------------
% Copyright Yiping Liu
% Please contact {yiping0liu@gmail.com} if you have any problem.
%--------------------------------------------------------------------------

    %% Parameters
    [nSig,D]=size(oSignals);
    maxAge = net.maxAge;
    lambda = net.lambda;
    epsilon_a = net.epsilon_a;
    epsilon_nb = net.epsilon_nb;
    alpha = net.alpha;
    delta = net.delta;
    maxHP = net.maxHP;
    maxIter = net.maxIter;
    Node = net.Node;
    Err  = net.Err;
    edge = net.edge;
    age  = net.age;
    hp  = net.hp;

    %% Randamize Input Signal
    ran = randperm(nSig);
    oSignals = oSignals(ran,:);

    %% Input Signal Normalization [0-1]
    oMax = max(oSignals,[],1);
    oMin = min(oSignals,[],1);
    oRange = oMax-oMin;
    Signals = (oSignals - repmat(oMin,nSig,1))./repmat(oRange,nSig,1);

    %% Update GNG
    for nitr = 1:maxIter
        % Step 0: Initialization. Start with two neural units (nodes) selected from input data
        if size(Node,1) <= 2
            Ni = 2;
            Xmin = min(Signals,[],1);
            Xmax = max(Signals,[],1);
            for i = 1:Ni
                Node(i,:) = unifrnd(Xmin, Xmax);
            end
            Err = [0; 0];
            edge = zeros(2,2);
            age  = zeros(2,2);
            hp = ones(1,2).*maxHP;
        end

        for numSig = 1:nSig

            % Step 1: Input one signal
            pattern = Signals(numSig,:);

            % Step 2: Find the two nearest nodes ra and rb to new signal
            d = pdist2(pattern, Node);
            [~, SortOrder] = sort(d);
            ra = SortOrder(1);
            rb = SortOrder(2);

            % Step 2.5: change HP
            hp = hp-1;
            hp(ra) = maxHP;
            hp(rb) = hp(rb)+1;

            % Steps 3: Increment the age of all edges emanating from ra
            age(ra, :) = age(ra, :) + 1;
            age(:, ra) = age(:, ra) + 1;

            % Step 4: Add the squared distance to a local error counter variable
            Err(ra) = Err(ra) + d(ra)^2;

            % Step 5: Move ra and its topological neighbors towards singal
            Node(ra,:) = Node(ra,:) + epsilon_a * (pattern - Node(ra,:));
            for j = find(edge(ra,:)==1)
                Node(j,:) = Node(j,:) + epsilon_nb * (pattern - Node(j,:));% for Neighbor nodes which are connecting to ra.
            end

            % Step 6:
            % If ra and rb are connected by an edge, set the age of this edge to zero.
            % If such an edge does not exist, create it.
            edge(ra,rb) = 1;
            edge(rb,ra) = 1;
            age(ra,rb) = 0;
            age(rb,ra) = 0;

            % Step 7(1):
            % Remove edges from node if age>maxAge.
            edge(age>maxAge) = 0;

            % Step 7(2):
            % Remove dead node and their edges.
            DeadNodes = (hp<=0);
            edge(DeadNodes, :) = [];
            edge(:, DeadNodes) = [];
            age(DeadNodes, :) = [];
            age(:, DeadNodes) = [];
            Node(DeadNodes, :) = [];
            Err(DeadNodes) = [];
            hp(DeadNodes) = [];

            % Step 8: Node Insertion Procedure.
            % rnew: new node
            % r1max: node which has maximum accumulated error
            % r2max: neighbor node of r1max
            if mod(numSig, lambda) == 0 && net.maxNode > size(Node,1)
                [~, r1max] = max(Err);
                [~, r2max] = max(edge(:,r1max).*Err);
                rnew = size(Node,1) + 1;
                Node(rnew,:) = (Node(r1max,:) + Node(r2max,:))/2;
                edge(r1max,r2max) = 0;
                edge(r2max,r1max) = 0;
                edge(r1max,rnew) = 1;
                edge(rnew,r1max) = 1;
                edge(rnew,r2max) = 1;
                edge(r2max,rnew) = 1;
                age(rnew,:) = 0;
                age(:,rnew) = 0;
                Err(r1max) = alpha * Err(r1max);
                Err(r2max) = alpha * Err(r2max);
                Err(rnew) = Err(r1max);
                hp(rnew) = maxHP;
            end

            % Step 9: Decrease the error of all units.
            Err = delta*Err;

        end
    end

    %% Output net
    net.Node = Node;
    net.Err = Err;
    net.edge = edge;
    net.age = age;
    net.hp = hp;

    %% Expansion (Algorithm 3)
    % Accociate signal to its closest node
    Distance = pdist2(Node,Signals);
    [~,pi] = min(Distance,[],1);
    % Node Label based on edge (detect sub-network)
    connection = graph(edge ~= 0);
    NetLabel = conncomp(connection);
    % Data Label based on Node
    DataLable = NetLabel(pi);
    % Expand each sub-network
    for i=1:max(NetLabel)
        subData = find(DataLable == i);
        subNet = find(NetLabel == i);
        if length(subData)<=1 || length(subNet)<=1
            continue;
        end
        DataMax = max(Signals(subData,:),[],1);
        DataMin = min(Signals(subData,:),[],1);
        NetMax = max(Node(subNet,:),[],1);
        NetMin = min(Node(subNet,:),[],1);
        DataRange = DataMax-DataMin;
        NetRange = NetMax-NetMin;
        Ratio = DataRange./NetRange;
        for k = 1:D
            for j = subNet
                Node(j,k)= (Node(j,k)- NetMin(k)).*Ratio(k)+DataMin(k);
            end
        end
    end
    net.NodeS = Node;
end


% Script demonstrating usage of the cbpdndlcns function.
%
% Author: Brendt Wohlberg <brendt@lanl.gov>
%
% This file is part of the SPORCO library. Details of the copyright
% and user license can be found in the 'Copyright' and 'License' files
% distributed with the library.

% Training images
S0 = zeros(512, 512, 5, 'single');
S0(:,:,1) = single(stdimage('lena.grey')) / 255;
S0(:,:,2) = single(stdimage('barbara.grey')) / 255;
S0(:,:,3) = single(stdimage('kiel.grey')) / 255;
S0(:,:,4) = single(rgb2gray(stdimage('mandrill'))) / 255;
tmp = single(stdimage('man.grey')) / 255;
S0(:,:,5) = tmp(101:612, 101:612);

%Reduce images size to speed up demo script
tmp = zeros(256, 256, 5, 'single');
for k = 1:size(S0,3),
  tmp(:,:,k) = imresize(S0(:,:,k), 0.5);
end
S0 = tmp;

% Filter input images and compute highpass images
npd = 16;
fltlmbd = 5;
[Sl, Sh] = lowpass(S0, fltlmbd, npd);

% Construct initial dictionary
D0 = zeros(8,8,32, 'single');
D0(3:6,3:6,:) = single(randn(4,4,32));

% Set up cbpdndl parameters
lambda = 0.2;
opt = [];
opt.Verbose = 1;
opt.MaxMainIter = 250;
opt.rho = 50*lambda + 0.5;
opt.sigma = size(Sh,3);
opt.AutoRho = 1;
opt.AutoRhoPeriod = 10;
opt.AutoSigma = 1;
opt.AutoSigmaPeriod = 10;
opt.XRelaxParam = 1.8;
opt.DRelaxParam = 1.8;

% Do dictionary learning
[D, X, optinf] = cbpdndlcns(D0, Sh, lambda, opt);

% Display learned dictionary
figure;
imdisp(tiledict(D));

% Plot functional value evolution
figure;
plot(optinf.itstat(:,2));
xlabel('Iterations');
ylabel('Functional value');


function [X,cost,test,stats] = completion_rankincrease_adaptive_new2( method, A_Omega, Omega, A_Omega_C, Omega_C, A_Gamma, Gamma, X0, opts )

    if ~isfield( opts, 'maxrank');      opts.maxrank = 4  ;         end
    if ~isfield( opts, 'cg');           opts.cg = true;             end
    if ~isfield( opts, 'tol');          opts.tol = 1e-6;            end
    if ~isfield( opts, 'reltol');       opts.reltol = 1e-8;         end
    if ~isfield( opts, 'reltol_final'); opts.reltol_final = eps;    end
    if ~isfield( opts, 'maxiter');      opts.maxiter = 10;          end
    if ~isfield( opts, 'maxiter_final');opts.maxiter_final = 20;    end
    if ~isfield( opts, 'locked_tol');   opts.locked_tol = 1;        end
    if ~isfield( opts, 'epsilon');      opts.epsilon = 1e-8;        end
    if ~isfield( opts, 'verbose');      opts.verbose = false;       end

    if strcmpi( method, 'GeomCG' )
        completion = @( A_Omega, Omega, A_Gamma, Gamma, X0, opts ) ...
                            completion_orth( A_Omega, Omega, A_Gamma, Gamma, X0, opts )
    elseif strcmpi( method, 'ALS' )
        completion = @( A_Omega, Omega, A_Gamma, Gamma, X0, opts ) ...
                            completion_als( A_Omega, Omega, A_Gamma, Gamma, X0, opts )
    end
    d = X0.order;

    test = [];
    control_old = inf;

    % ===========================================
    disp('____________________________________________________________________');
    disp(['Completion with with starting rank r = [ ' num2str(X0.rank) ' ] ...']);
    [X,cost,control,stats] = completion( A_Omega, Omega, A_Gamma, Gamma, X0, opts);

    stats.rankidx = [length(cost)];

    disp('____________________________________________________________________');
    disp(['Increasing rank ... ']);

    locked = zeros(1,d+1);

    for k = 2:opts.maxrank
        for i = 2:d

            disp(['Locked cores:' num2str(locked) ])
            if locked(i)
                disp(['Rank r(' num2str(i) ') is locked. Skipping.']);
            else
                r = X.rank;
                disp(['Trying to increase rank r(' num2str(i) ') from ' num2str(r(i)) ' to ' num2str(r(i)+1) ':']);
                Xnew = increaseRank(X, 1, i, opts.epsilon);
                Xnew = orthogonalize(Xnew, d);
                if i==d && k == opts.maxrank
                    opts.maxiter = opts.maxiter_final;
                end
                [Xnew,cost_tmp,control_tmp,stats_tmp] = completion( A_Omega, Omega, A_Omega_C, Omega_C, Xnew, opts);
                stats.rankidx = [stats.rankidx, length(cost_tmp)];
                disp( ['Current cost function:            ', num2str(cost_tmp(end)) ]);

                progress = (control_tmp(end) - control_old )/control_old;
                disp( ['Current rel. progress on control: ' num2str(progress)]);

                if  progress > opts.locked_tol
                    disp(['     ... failed. Reverting.']);
                else
                   disp(['     ... accepted.']);
                   X = Xnew;
                   control_old = control_tmp(end)
                   test_current = norm(X(Gamma) - A_Gamma)/ norm(A_Gamma)
                   disp( ['Current error on test set Gamma:  ', num2str(test_current) ]);
                   test = [test, test_current];
                end

                if ~isempty(stats.time)
                    stats_tmp.time = stats_tmp.time + stats.time(end);
                end

                cost = [cost; cost_tmp];
                control = [control; control_tmp];
                stats.time = [stats.time, stats_tmp.time];

            end

        end
    end

end


function imsegs = APPgetSpStats(imsegs)
% imsegs = APPgetSpStats(imsegs)
% Gets basic information about the superpixels
%
% Copyright(C) Derek Hoiem, Carnegie Mellon University, 2005
% Current Version: 1.0  09/30/2005

for ii = 1:length(imsegs)

	nseg = imsegs(ii).nseg;
	segimage = double( imsegs(ii).segimage );
%     segimage = imsegs(ii).segimage;

    imh = size(segimage, 1);

	adjmat = eye([nseg nseg]);

    % get adjacency
    dx = segimage ~= segimage(:,[2:end end]);
    dy = segimage ~= segimage([2:end end], :);

    ind1 = find(dy);
    ind2 = ind1 + 1;
    s1 = segimage(ind1);
    s2 = segimage(ind2);
%     adjmat(s1 + nseg*(s2-1)) = 1;
%     adjmat(s2 + nseg*(s1-1)) = 1;
    adjmat(sub2ind([nseg, nseg], s1, s2)) = 1;
    adjmat(sub2ind([nseg, nseg], s2, s1)) = 1;

    ind3 = find(dx);
    ind4 = ind3 + imh;
    s3 = segimage(ind3);
    s4 = segimage(ind4);
%     adjmat(s3 + nseg*(s4-1)) = 1;
%     adjmat(s4 + nseg*(s3-1)) = 1;
    adjmat(sub2ind([nseg, nseg], s3, s4)) = 1;
    adjmat(sub2ind([nseg, nseg], s4, s3)) = 1;

%   slower code
% 	[height, width] = size(segimage);
%
% 	for y = 1:height-1
%         for x = 1:width-1
%             s1 = segimage(y, x);
%             s2 = segimage(y+1, x);
%             s3 = segimage(y, x+1);
%             if s1 > 0
%                 npixels(s1) = npixels(s1) + 1;
%                 if s2 > 0
%                     adjmat(s1, s2) = 1;
%                     adjmat(s2, s1) = 1;
%                 end
%                 if s3 > 0
%                     adjmat(s1, s3) = 1;
%                     adjmat(s3, s1) = 1;
%                 end
%             end
%         end
% 	end
%
% 	x = width;
% 	for y = 1:height
%         s1 = segimage(y, x);
%         if s1 > 0
%             npixels(s1) = npixels(s1) + 1;
%         end
% 	end
%
% 	y = height;
% 	for x = 1:width-1
%         s1 = segimage(y, x);
%         if s1 > 0
%             npixels(s1) = npixels(s1) + 1;
%         end
% 	end

    stats = regionprops(segimage, 'Area');
    imsegs(ii).npixels = vertcat(stats(:).Area);
	imsegs(ii).adjmat = logical(adjmat);

end


%WAVE_SIGNIF  Significance testing for the 1D Wavelet transform WAVELET
%
%   [SIGNIF,FFT_THEOR] = ...
%      wave_signif(Y,DT,SCALE,SIGTEST,LAG1,SIGLVL,DOF,MOTHER,PARAM)
%
% INPUTS:
%
%    Y = the time series, or, the VARIANCE of the time series.
%        (If this is a single number, it is assumed to be the variance...)
%    DT = amount of time between each Y value, i.e. the sampling time.
%    SCALE = the vector of scale indices, from previous call to WAVELET.
%
%
% OUTPUTS:
%
%    SIGNIF = significance levels as a function of SCALE
%    FFT_THEOR = output theoretical red-noise spectrum as fn of PERIOD
%
%
% OPTIONAL INPUTS:
% *** Note *** setting any of the following to -1 will cause the default
%               value to be used.
%
%    SIGTEST = 0, 1, or 2.    If omitted, then assume 0.
%
%         If 0 (the default), then just do a regular chi-square test,
%             i.e. Eqn (18) from Torrence & Compo.
%         If 1, then do a "time-average" test, i.e. Eqn (23).
%             In this case, DOF should be set to NA, the number
%             of local wavelet spectra that were averaged together.
%             For the Global Wavelet Spectrum, this would be NA=N,
%             where N is the number of points in your time series.
%         If 2, then do a "scale-average" test, i.e. Eqns (25)-(28).
%             In this case, DOF should be set to a
%             two-element vector [S1,S2], which gives the scale
%             range that was averaged together.
%             e.g. if one scale-averaged scales between 2 and 8,
%             then DOF=[2,8].
%
%    LAG1 = LAG 1 Autocorrelation, used for SIGNIF levels. Default is 0.0
%
%    SIGLVL = significance level to use. Default is 0.95
%
%    DOF = degrees-of-freedom for signif test.
%         IF SIGTEST=0, then (automatically) DOF = 2 (or 1 for MOTHER='DOG')
%         IF SIGTEST=1, then DOF = NA, the number of times averaged together.
%         IF SIGTEST=2, then DOF = [S1,S2], the range of scales averaged.
%
%       Note: IF SIGTEST=1, then DOF can be a vector (same length as SCALEs),
%            in which case NA is assumed to vary with SCALE.
%            This allows one to average different numbers of times
%            together at different scales, or to take into account
%            things like the Cone of Influence.
%            See discussion following Eqn (23) in Torrence & Compo.
%
%
%----------------------------------------------------------------------------
%   Copyright (C) 1995-1998, Christopher Torrence and Gilbert P. Compo
%   University of Colorado, Program in Atmospheric and Oceanic Sciences.
%   This software may be used, copied, or redistributed as long as it is not
%   sold and this copyright notice is reproduced on each copy made.  This
%   routine is provided as is without any express or implied warranties
%   whatsoever.
%----------------------------------------------------------------------------
function [signif,fft_theor] = ...
	wave_signif(Y,dt,scale1,sigtest,lag1,siglvl,dof,mother,param);

if (nargin < 9), param = -1;, end
if (nargin < 8), mother = -1;, end
if (nargin < 7), dof = -1;, end
if (nargin < 6), siglvl = -1;, end
if (nargin < 5), lag1 = -1;, end
if (nargin < 4), sigtest = -1;, end
if (nargin < 3)
	error('Must input a vector Y, sampling time DT, and SCALE vector')
end

n1 = length(Y);
J1 = length(scale1) - 1;
scale(1:J1+1) = scale1;
s0 = min(scale);
dj = log(scale(2)/scale(1))/log(2.);

if (n1 == 1)
	variance = Y;
else
	variance = std(Y)^2;
end

if (sigtest == -1), sigtest = 0;, end
if (lag1 == -1), lag1 = 0.0;, end
if (siglvl == -1), siglvl = 0.95;, end
if (mother == -1), mother = 'MORLET';, end

mother = upper(mother);

% get the appropriate parameters [see Table(2)]
if (strcmp(mother,'MORLET'))  %----------------------------------  Morlet
	if (param == -1), param = 6.;, end
	k0 = param;
	fourier_factor = (4*pi)/(k0 + sqrt(2 + k0^2)); % Scale-->Fourier [Sec.3h]
	empir = [2.,-1,-1,-1];
	if (k0 == 6), empir(2:4)=[0.776,2.32,0.60];, end
elseif (strcmp(mother,'PAUL'))  %--------------------------------  Paul
	if (param == -1), param = 4.;, end
	m = param;
	fourier_factor = 4*pi/(2*m+1);
	empir = [2.,-1,-1,-1];
	if (m == 4), empir(2:4)=[1.132,1.17,1.5];, end
elseif (strcmp(mother,'DOG'))  %---------------------------------  DOG
	if (param == -1), param = 2.;, end
	m = param;
	fourier_factor = 2*pi*sqrt(2./(2*m+1));
	empir = [1.,-1,-1,-1];
	if (m == 2), empir(2:4) = [3.541,1.43,1.4];, end
	if (m == 6), empir(2:4) = [1.966,1.37,0.97];, end
else
	error('Mother must be one of MORLET,PAUL,DOG')
end

period = scale.*fourier_factor;
dofmin = empir(1);     % Degrees of freedom with no smoothing
Cdelta = empir(2);     % reconstruction factor
gamma_fac = empir(3);  % time-decorrelation factor
dj0 = empir(4);        % scale-decorrelation factor

freq = dt ./ period;   % normalized frequency
fft_theor = (1-lag1^2) ./ (1-2*lag1*cos(freq*2*pi)+lag1^2);  % [Eqn(16)]
fft_theor = variance*fft_theor;  % include time-series variance
signif = fft_theor;
if (dof == -1), dof = dofmin;, end

if (sigtest == 0)    % no smoothing, DOF=dofmin [Sec.4]
	dof = dofmin;
	chisquare = chisquare_inv(siglvl,dof)/dof;
	signif = fft_theor*chisquare ;  % [Eqn(18)]
elseif (sigtest == 1)  % time-averaged significance
	if (length(dof) == 1), dof=zeros(1,J1+1)+dof;, end
	truncate = find(dof < 1);
	dof(truncate) = ones(size(truncate));
	dof = dofmin*sqrt(1 + (dof*dt/gamma_fac ./ scale).^2 );   % [Eqn(23)]
	truncate = find(dof < dofmin);
	dof(truncate) = dofmin*ones(size(truncate));   % minimum DOF is dofmin
	for a1 = 1:J1+1
		chisquare = chisquare_inv(siglvl,dof(a1))/dof(a1);
		signif(a1) = fft_theor(a1)*chisquare;
	end
elseif (sigtest == 2)  % time-averaged significance
	if (length(dof) ~= 2)
		error('DOF must be set to [S1,S2], the range of scale-averages')
	end
	if (Cdelta == -1)
		error(['Cdelta & dj0 not defined for ',mother, ...
			' with param = ',num2str(param)])
	end
	s1 = dof(1);
	s2 = dof(2);
	avg = find((scale >= s1) & (scale <= s2));  % scales between S1 & S2
	navg = length(avg);
	if (navg == 0)
		error(['No valid scales between ',num2str(s1),' and ',num2str(s2)])
	end
	Savg = 1./sum(1 ./ scale(avg));       % [Eqn(25)]
	Smid = exp((log(s1)+log(s2))/2.);     % power-of-two midpoint
	dof = (dofmin*navg*Savg/Smid)*sqrt(1 + (navg*dj/dj0)^2);  % [Eqn(28)]
	fft_theor = Savg*sum(fft_theor(avg) ./ scale(avg));  % [Eqn(27)]
	chisquare = chisquare_inv(siglvl,dof)/dof;
	signif = (dj*dt/Cdelta/Savg)*fft_theor*chisquare;    % [Eqn(26)]
else
	error('sigtest must be either 0, 1, or 2')
end

return


function varargout = sift(varargin)
% VL_SIFT  Scale-Invariant Feature Transform
%   F = VL_SIFT(I) computes the SIFT frames [1] (keypoints) F of the
%   image I. I is a gray-scale image in single precision. Each column
%   of F is a feature frame and has the format [X;Y;S;TH], where X,Y
%   is the (fractional) center of the frame, S is the scale and TH is
%   the orientation (in radians).
%
%   [F,D] = VL_SIFT(I) computes the SIFT descriptors [1] as well. Each
%   column of D is the descriptor of the corresponding frame in F. A
%   descriptor is a 128-dimensional vector of class UINT8.
%
%   VL_SIFT() accepts the following options:
%
%   Octaves:: [maximum possible]
%     Set the number of octave of the DoG scale space.
%
%   Levels:: [3]
%     Set the number of levels per octave of the DoG scale space.
%
%   FirstOctave:: [0]
%     Set the index of the first octave of the DoG scale space.
%
%   PeakThresh:: [0]
%     Set the peak selection threshold.
%
%   EdgeThresh:: [10]
%     Set the non-edge selection threshold.
%
%   NormThresh:: [-inf]
%     Set the minimum l2-norm of the descriptors before
%     normalization. Descriptors below the threshold are set to zero.
%
%   Magnif:: [3]
%     Set the descriptor magnification factor. The scale of the
%     keypoint is multiplied by this factor to obtain the width (in
%     pixels) of the spatial bins. For instance, if there are there
%     are 4 spatial bins along each spatial direction, the
%     ``side'' of the descriptor is approximatively 4 * MAGNIF.
%
%   WindowSize:: [2]
%     Set the variance of the Gaussian window that determines the
%     descriptor support. It is expressend in units of spatial
%     bins.
%
%   Frames:: [not specified]
%     If specified, set the frames to use (bypass the detector). If
%     frames are not passed in order of increasing scale, they are
%     re-orderded.
%
%   Orientations::
%     If specified, compute the orietantions of the frames overriding
%     the orientation specified by the 'Frames' option.
%
%   Verbose::
%     If specfified, be verbose (may be repeated to increase the
%     verbosity level).
%
%   REFERENCES::
%     [1] D. G. Lowe, Distinctive image features from scale-invariant
%     keypoints. IJCV, vol. 2, no. 60, pp. 91-110, 2004.
%
%   See also: VL_UBCMATCH(), VL_DSIFT(), VL_HELP().
[varargout{1:nargout}] = vl_sift(varargin{:});


% ACOS   Inverse cosine, result in radians.
%    ACOS(X) is the arccosine of the elements of X. Complex
%    results are obtained if ABS(x) > 1.0 for some element.
%
%    See also COS, ACOSD.
%
%    Reference page in Doc Center
%       doc acos
%
%    Other functions named acos
%
%       codistributed/acos    gpuArray/acos    sym/acos    ts/acos
%


function determ = daub10_determinant ( n )

%*****************************************************************************80
%
%% DAUB10_DETERMINANT returns the determinant of the DAUB10 matrix.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 July 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%
%    Output, real DETERM, the determinant.
%
  determ = + 1.0;

  return
end


%% Copyright (C) 2016-2017 Lagu
%% Copyright (C) 2017, 2019, 2022 Colin B. Macdonald
%%
%% This file is part of OctSymPy.
%%
%% OctSymPy 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 software is distributed in the hope that it will be useful,
%% but WITHOUT ANY WARRANTY; without even the implied warranty
%% of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
%% the GNU General Public License for more details.
%%
%% You should have received a copy of the GNU General Public
%% License along with this software; see the file COPYING.
%% If not, see <http://www.gnu.org/licenses/>.

%% -*- texinfo -*-
%% @documentencoding UTF-8
%% @defmethod @@sym ellipticCK (@var{m})
%% Complementary complete elliptic integral of the first kind.
%%
%% The complete elliptic integral (of the first kind) with the
%% complementary parameter @code{1 - @var{m}} is given by:
%% @example
%% @group
%% syms m
%% ellipticCK (m)
%%   @result{} ans = (sym) K(1 - m)
%% @end group
%% @end example
%%
%% Example:
%% @example
%% @group
%% ellipticCK (sym (1)/4)
%%   @result{} ans = (sym) K(3/4)
%% vpa (ans)
%%   @result{} (sym) 2.1565156474996432354386749988003
%% @end group
%% @end example
%%
%% There are other conventions for the inputs of elliptic integrals,
%% @pxref{@@sym/ellipticF}.
%%
%% @seealso{@@sym/ellipticK}
%% @end defmethod

function y = ellipticCK (m)
  if (nargin > 1)
    print_usage ();
  end

  y = ellipticK (1 - m);

end

%!error ellipticCK (sym (1), 2)

%!assert (double (ellipticCK (sym (1)/2)), 1.8541, 10e-5)
%!assert (double (ellipticCK (sym (101)/10)), 0.812691836806976, -3*eps)
%!assert (isequal (ellipticCK (sym (1)), sym(pi)/2))