function [vert, faces] = tess_disc(h0)
% TESS_CIRCLE: Create a meshed disc.
%
% USAGE:  [vert, faces] = tess_disc(h0);
%
% INPUTS:
%    - h0 : Initial edge length

% @=============================================================================
% This function is part of the Brainstorm software:
% https://neuroimage.usc.edu/brainstorm
%
% Copyright (c) University of Southern California & McGill University
% This software is distributed under the terms of the GNU General Public License
% as published by the Free Software Foundation. Further details on the GPLv3
% license can be found at http://www.gnu.org/copyleft/gpl.html.
%
% FOR RESEARCH PURPOSES ONLY. THE SOFTWARE IS PROVIDED "AS IS," AND THE
% UNIVERSITY OF SOUTHERN CALIFORNIA AND ITS COLLABORATORS DO NOT MAKE ANY
% WARRANTY, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO WARRANTIES OF
% MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, NOR DO THEY ASSUME ANY
% LIABILITY OR RESPONSIBILITY FOR THE USE OF THIS SOFTWARE.
%
% For more information type "brainstorm license" at command prompt.
% =============================================================================@
%
% Authors: Francois Tadel, 2016

% Parse inputs
if (nargin < 1) || isempty(h0)
    h0 = 0.07;
end

% Distance and edge length function
fd = @(p) sqrt(sum(p.^2,2))-1;
fh = @(p) ones(size(p,1),1);
bbox = [-1,-1;1,1];
pfix = [];

% Use distmesh toolbox
[vert, faces] = distmesh2d(fd, fh, h0, bbox, pfix);


function Wop = normalize_wavelet_factory_1d(N, filter_options, scat_options, epsilon)

    if nargin <4
        epsilon = 2^(-20);
    end

    filters = filter_bank(N, filter_options);

    for m = 0:scat_options.M
        filt_ind = min(numel(filters), m+1);
        Wop{m+1} = @(X)(wavelet_renorm(X, m));
    end

    function [S, Utilde] = wavelet_renorm(U, m)
        filt_ind = min(numel(filters), m+1);
        [S, U] = wavelet_layer_1d(U, filters{filt_ind}, scat_options);
        Utilde = renorm_low_pass_layer_1d(S, U, epsilon);
    end

end


function [hPa] = Torr2hPa(Torr)
% Convert pressure from torr to hectopascals
% Chad Greene 2012
hPa = Torr*1.33322;


function X = lleEmbed(Y, dims, neighbours)

% LLEEMBED Embed data set with LLE.

% MLTOOLS

% Wrapper for Sam Roweis' LLE code.

% Note LLE code uses the transpose of a design matrix.
if nargin < 3
  neighbours = 7;
end
if any(any(isnan(Y)))
  error('Cannot initialise gplvm using LLE when missing data is present.')
else
  X = lle(Y', neighbours, dims);
  X = X';
  % Rescale X so that variance is 1 and mean is zero.
  meanX = mean(X);
  X = X-ones(size(Y, 1), 1)*meanX;
  varX = var(X);
  X = X*diag(sqrt(1./varX));
end


function [parent] = multiNonUnifMutation(parent,bounds,Ops)
% Multi-Non uniform mutation changes all of the parameters of the parent
% based on a non-uniform probability distribution.  This Gaussian
% distribution starts wide, and narrows to a point distribution as the
% current generation approaches the maximum generation.
%
% function [newSol] = multiNonUnifMutate(parent,bounds,Ops)
% parent  - the first parent ( [solution string function value] )
% bounds  - the bounds matrix for the solution space
% Ops     - Options for multiNonUnifMutation
%          [gen #MultiNonUnifMutations maxGen b]

% Binary and Real-Valued Simulation Evolution for Matlab
% Copyright (C) 1996 C.R. Houck, J.A. Joines, M.G. Kay
%
% C.R. Houck, J.Joines, and M.Kay. A genetic algorithm for function
% optimization: A Matlab implementation. ACM Transactions on Mathmatical
% Software, Submitted 1996.
%
% This program is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 1, or (at your option)
% any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details. A copy of the GNU
% General Public License can be obtained from the
% Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

cg=Ops(1); 				% Current Generation
mg=Ops(3); 				% Maximum Number of Generations
b=Ops(4);                               % Shape parameter
df = bounds(:,2) - bounds(:,1); 	% Range of the variables
numVar = size(parent,2)-1; 		% Get the number of variables
% Now mutate that point
md = round(rand(1,numVar));
for i = 1:numVar
  if md(i)
    parent(i)=parent(i)+delta(cg,mg,bounds(i,2)-parent(i),b);
  else
    parent(i)=parent(i)-delta(cg,mg,parent(i)-bounds(i,1),b);
  end
end


% Reflective multivariate slice sampling

function [func, fx] = mcmc_init_reflective(x_init, get_logpdf, get_dlogpdf, ...
                                           epsilon, L, varargin)

options = struct( ...
    'fx',    @func_x_default, ...
    'type',  'inside');
% $$$     'y',     @(x) x,  ...        % transform the variable
% $$$     'logdy', @(x) 0,  ...        % log-jacobi of the transformation
% $$$     'dy',    @(x) 1,  ...
% $$$     'ddy',   @(x) 0,  ...
% $$$     'f',     @(y, varargin) []); % function for making pre-evaluations for logpdf

% Parse arguments
[options, errmsg] = argparse( options, varargin{:} );
error(errmsg);

% Initialization
x_current = x_init;
[fx_current, dfx_current] = options.fx(x_current);
logpdf_current = get_logpdf(fx_current);

fx = fx_current;

x_proposal = x_current;

switch options.type

 case 'outside'
  func = @reflective_outside;

 case 'inside'
  func = @reflective_inside;

 case default
  error('Unknown type for slice sampling');

end

  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  function [x, fx] = reflective_inside(varargin)
  x_trajectory = x_current;
  fx_trajectory = fx_current;
  dfx_trajectory = dfx_current;
  logpdf_trajectory = logpdf_current;
  lp_trajectory = logpdf_current(varargin{:});

  % Momentum stuff
  step = exprnd(epsilon); % step length
  p = randn(size(x_current));

  %traj = [];

  % Simulate N steps
  for n=1:L

    if mod(n-1,ceil(L/10)) == 0
      % Update the slice
      lp_slice = lp_trajectory + log(rand());
    end

    % Move a step forward
    x_proposed = x_trajectory + step*p;
    % Check whether the new point is inside the slice
    [fx_proposed, dfx_proposed] = options.fx(x_proposed);
    logpdf_proposed = get_logpdf(fx_proposed);
    lp_proposed = logpdf_proposed(varargin{:});
    if lp_proposed <= lp_slice
      % Reflect based on the gradient at the inside point

      % Get the gradient
      dlogpdf = get_dlogpdf(dfx_trajectory);
      g = dlogpdf(varargin{:});

      % New momentum
      g2 = g'*g;
      if g2 > 0
        p = p - (2*(p'*g)/g2)*g;
      else
        % Random or opposite direction?
        p = -p;%orth(randn(numel(p))) * p;
      end

      % Check the reflected point is inside the slice
      x_reflect = x_trajectory + step*p;
      [fx_reflect, dfx_reflect] = options.fx(x_reflect);
      logpdf_reflect = get_logpdf(fx_reflect);
      lp_reflect = logpdf_reflect(varargin{:});
      if lp_reflect <= lp_slice
        disp('Reject trajectory')
        % TODO: Should I keep the state or ignore
        x = x_current;
        fx = fx_current;
        %x = nan;
        %fx = nan;
        return
      end

      %
      % TODO: HOW TO REQUEST THE GRADIENT?!?!?!!!!
      %

      % Verify opposite direction
      x_verify = x_trajectory - step*p;
      fx_verify = options.fx(x_verify);
      logpdf_verify = get_logpdf(fx_verify);
      lp_verify = logpdf_verify(varargin{:});
      if lp_verify > lp_slice
        disp('Reject trajectory')
        % TODO: Should I keep the state or ignore
        x = x_current;
        fx = fx_current;
        %x = nan;
        %fx = nan;
        return
      end

      % Accept the reflected step
      %disp('Reflect')
      x_trajectory = x_reflect;
      fx_trajectory = fx_reflect;
      dfx_trajectory = dfx_reflect;
      lp_trajectory = lp_reflect;
      logpdf_trajectory = logpdf_reflect;

    else

      % Accept the forward step
      x_trajectory = x_proposed;
      fx_trajectory = fx_proposed;
      dfx_trajectory = dfx_proposed;
      lp_trajectory = lp_proposed;
      logpdf_trajectory = logpdf_proposed;

    end
%    traj = [traj, x_trajectory];
  end

% $$$   figure
% $$$   plot(traj(1,:),traj(2,:), 'kx-');
% $$$   % Plot contours
% $$$   v = axis();
% $$$   vx = linspace(v(1), v(2), 20);
% $$$   vy = linspace(v(3), v(4), 10);
% $$$   [VY,VX] = meshgrid(vy,vx);
% $$$   V = [VX(:), VY(:)]';
% $$$   F = zeros(size(VX));
% $$$   for n=1:numel(F)
% $$$     logpdf = get_logpdf(V(:,n));
% $$$     F(n) = logpdf();
% $$$   end
% $$$   hold on
% $$$   contour(VX,VY,reshape(F,size(VX)));
% $$$   error('jou')

  disp('Accept trajectory')
  x_current = x_trajectory;
  fx_current = fx_trajectory;
  dfx_current = dfx_trajectory;
  logpdf_current = logpdf_trajectory;

  x = x_current;
  fx = fx_current;
  end

  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  function [y, fy] = reflective_outside(varargin)
  disp('Check gradient')
  mycheckgrad(@helper, x_current, 1e-6)
  error('Stopped because wanted to check gradients')
    function [f, df] = helper(x)
    [fx, dfx] = options.fx(x);
    logpdf = get_logpdf(fx);
    dlogpdf = get_dlogpdf(dfx);
    f = logpdf(varargin{:});
    df = dlogpdf(varargin{:});
    end
  end

end

function [fx, dfx] = func_x_default(x)
fx = x;
dfx = x;
end


function dcentral = dcentral_pair(trx,larva1,larva2)

% initialize
dcentral = nan(1,trx(larva1).nframes);

% get start and end frames of overlap
t0 = max(trx(larva1).firstframe,trx(larva2).firstframe);
t1 = min(trx(larva1).endframe,trx(larva2).endframe);

% no overlap
if t1 < t0,
  return;
end

% indices for these frames
i0 = t0 + trx(larva1).off;
i1 = t1 + trx(larva1).off;
j0 = t0 + trx(larva2).off;
j1 = t1 + trx(larva2).off;

% centroid distance
dx = trx(larva2).xcentral_mm(j0:j1)-trx(larva1).xcentral_mm(i0:i1);
dy = trx(larva2).ycentral_mm(j0:j1)-trx(larva1).ycentral_mm(i0:i1);
z = sqrt(dx.^2 + dy.^2);
dcentral(i0:i1) = z;


function [hd_record,hd_estimates]=panel6hd(Xi,theta_gibbs,D_record,strshocks_record,It,Bu,Ymat,N,n,m,p,k,T,d,HDband)

% preliminary tasks
% first create the hd_record and temp cells
hd_record=cell(n*N,n*N+1);
temp=cell(n*N,2);

% then initiate the Gibbs algorithm
for ii=1:It-Bu

% recover theta for the current iteration (one column for each period)
theta_iter=reshape(theta_gibbs(:,ii,:),d,T);

% recover D for the current iteration (one page for each period)
D_iter=[];
for jj=1:T
D_iter(:,:,jj)=reshape(D_record(:,ii,jj),N*n,N*n);
end

% recover the series of period-specific orthogonal IRFs
[IRFcell]=bear.panel6hdsim(theta_iter,D_iter,Xi,N,n,m,p,T,k);

% recover the structural disturbances
ETA=[];
for jj=1:N*n
ETA=[ETA;strshocks_record{jj,1}(ii,:)];
end
ETA=ETA';

% then compute the historical decomposition
   % loop over variables
   for jj=1:n*N
      % loop over shocks
      for kk=1:n*N
      % loop over shocks
      vshocks=ETA(:,kk);
         % loop over time periods
         for ll=1:T
         % initiate the vectors of IRFs and shocks
         virf=[];
            % then loop over IRF periods
            for mm=1:ll
            % create the vector of IRF coefficients
            virf=[virf IRFcell{mm,ll}(jj,kk)];
            end
         % compute then the contribution of shock kk for variable jj at period ll
         hd_record{jj,kk}(ii,ll)=virf*flipud(vshocks(1:ll,1));
         end
      end
   end

% then go for next Gibbs iteration
end

% compute the contributions of deterministic variables
% loop over rows of temp/hd_record
for ii=1:n*N
% fill the Ytot matrix in temp
% initial condition
temp{ii,1}=hd_record{ii,1};
   % sum over the remaining columns of hd_record
   for jj=2:n*N
   temp{ii,1}=temp{ii,1}+hd_record{ii,jj};
   end
% fill the Y matrix in temp
temp{ii,2}=repmat(Ymat(:,ii)',It-Bu,1);
% fill the Yd matrix in hd_record
hd_record{ii,N*n+1}=temp{ii,2}-temp{ii,1};
% go for next variable
end

% finally, obtain point esimates and credibility intervals
[hd_estimates]=bear.hdestimates(hd_record,N*n,T,HDband);


function frobenius_number_order2_values_test ( )

%*****************************************************************************80
%
%% FROBENIUS_NUMBER_ORDER2_VALUES_TEST tests FROBENIUS_NUMBER_ORDER2_VALUES.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    08 February 2007
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'FROBENIUS_NUMBER_ORDER2_VALUES_TEST:\n' );
  fprintf ( 1, '  FROBENIUS_NUMBER_ORDER2_VALUES returns values of\n' );
  fprintf ( 1, '  the Frobenius number of order 2.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '         C1        C2          F(C1,C2)\n' );
  fprintf ( 1, '\n' );

  n_data = 0;

  while ( 1 )

    [ n_data, c1, c2, f ] = frobenius_number_order2_values ( n_data );

    if ( n_data == 0 )
      break
    end

    fprintf ( 1, '  %8d  %8d  %8d\n', c1, c2, f );

  end

  return
end


function M = spm_mesh_isosurface(V, t, s)
% Compute isosurface geometry from volume data
% FORMAT M = spm_mesh_isosurface(V, t, s)
% V        - volume data
%            spm_vol struct, nifti object or 3D array
% t        - isosurface value
% s        - Gaussian filter width (FWHM) in {edges} [Default: 0]
%
% M        - patch structure
%
% This is merely a wrapper around isosurface.
%__________________________________________________________________________
% Copyright (C) 2019 Wellcome Trust Centre for Neuroimaging

% Guillaume Flandin
% $Id: spm_mesh_isosurface.m 7677 2019-10-24 09:55:24Z guillaume $

if ischar(V) || isstruct(V)
    V = spm_vol(V);
    V = struct('dat',spm_read_vols(V),'mat',V.mat);
elseif isa(V,'nifti')
    V = struct('dat',full(V.dat),'mat',V.mat);
elseif isnumeric(V) || islogical(V)
    V = struct('dat',V,'mat',eye(4));
else
    error('Invalid volume data type.');
end

if nargin < 3, s = 0; end

if any(s)
    spm_smooth(V.dat, V.dat, s);
end

for i=1:numel(t)

    [faces,vertices] = isosurface(V.dat, t(i));

    if isempty(vertices)
        faces    = zeros(0,3);
        vertices = zeros(0,3);
    end

    % Swap around x and y because isosurface uses meshgrid and not ndgrid
    mat      = V(1).mat(1:3,:) * [0 1 0 0;1 0 0 0;0 0 1 0; 0 0 0 1];
    vertices = (mat * [vertices'; ones(1,size(vertices,1))])';

    M(i) = struct('faces',faces, 'vertices',vertices);

end


function XvalResult = ncrossdecomp(Method,X,FacMin,FacMax,Segments,Cent,Show);

%NCROSSDECOMP crossvalidation of PARAFAC/Tucker/PCA
%
% See also:
% 'ncrossreg'
%
% This file performs cross-validation of decomposition models
% PARAFAC, PCA, and Tucker. The cross-validation is performed
% such that part of the data are set to missing, the model is
% fitted to the remaining data, and the residuals between fitted
% and true left-out elements is calculated. This is performed
% 'Segments' times such that all elements are left out once.
% The segments are chosen by taking every 'Segments' element of
% X(:), i.e. from the vectorized array. If X is of size 5 x 7,
% and three segemnts are chosen ('Segments' = 3), then in the
% first of three models, the model is fitted to the matrix
%
% |x 0 0 x 0 0 x|
% |0 x 0 0 x 0 0|
% |0 0 x 0 0 x 0|
% |x 0 0 x 0 0 x|
% |0 x 0 0 x 0 0|
%
% where x's indicate missing elements. After fitting the residuals
% in the locations of missing values are calculated. After fitting
% all three models, all residuals have been calculated.
%
% Note that the number of segments must be chosen such that no columns
% or rows contain only missing elements (the algorithm will check this).
% Using 'Segments' = 7, 9, or 13 will usually achieve that.
%
% I/O
% XvalResult = ncrossdecomp(Method,X,FacMin,FacMax,Segments,Cent,Show);
%
% INPUT
% Method   : 'parafac', 'tucker', 'pca', or 'nipals'
%            For Tucker only Tucker3 models with equal
%            number of components is currently available.
%            For PCA the least squares model is calculated.
%            Thus, offsets and parameters are calculated in
%            a least squares sense unlike the method NIPALS,
%            which calculates the PCA model using an ad hoc
%            approach for handling missing data (as in
%            standard chemometric software).
% X        : Multi-way array of data
% FacMin   : Lowest number of factors to use
% FacMax   : Highest number of factors (note that for Tucker only models
%            with the same number of components in each mode are
%            calculated currently
% Segments : The number of segments to use. Try many!
% Cent     : If set of one, the data are centered across samples,
%            i.e. ordinary centering. Note, however, that the centering
%            is not performed in a least squares sense but as preprocessing.
%            This is not optimal because the data have missing data because
%            of the way the elements are left out. This can give
%            significantly lower fit than reasonable if you have few samples
%            or use few segments. Alternatively, you can center the data
%            beforehand and perform cross-validation on the centered data
% Show     : If set to 0, no plot is given
%
% OUTPUT
% Structure XvalResult holding:
%           Fit: The fitted percentage of variation explaind (as a
%                function of component number)
%          Xval: The cross-validated percentage of variation explaind
%                (as a function of component number)
%   FittedModel: The fitted model (as a function of component number)
%     XvalModel: The cross-validated model (as a function of component number)

% $ Version 1.0301 $ Date 28. June 1999 $ Not compiled $
% $ Version 2.00 $ May 2001 $ Changed to array notation $ RB $ Not compiled $

% Copyright (C) 1995-2006  Rasmus Bro & Claus Andersson
% Copenhagen University, DK-1958 Frederiksberg, Denmark, rb@life.ku.dk
%
% This program is free software; you can redistribute it and/or modify it under
% the terms of the GNU General Public License as published by the Free Software
% Foundation; either version 2 of the License, or (at your option) any later version.
%
% This program is distributed in the hope that it will be useful, but WITHOUT
% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
% FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
% You should have received a copy of the GNU General Public License along with
% this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
% Street, Fifth Floor, Boston, MA  02110-1301, USA.

% uses NANSUM,

%GT
Perm  = [1:ndims(X)];
DimX  = size(X);
ord   = ndims(X);
delta = zeros(1,ndims(X));
for i = 1:ndims(X)
    c(i)     = isempty(intersect(factor(DimX(i)),factor(Segments)));
    index{i} = 1:DimX(i);
end
delta = zeros(1,ndims(X));
for i = 1:ndims(X)
    c(i)     = isempty(intersect(factor(DimX(i)),factor(Segments)));
    index{i} = 1:DimX(i);
end
P = find(~c);
if sum(c) < length(DimX) - 1
    for i = 1:sum(~c)
        while ~c(P(i)) & delta(P(i)) < (abs(DimX(P(i))- Segments) - 1)
            if ~rem(DimX(P(i)),2) & ~rem(Segments,2) & delta(P(i)) > 0
                Off = 2;
            else
                Off = 1;
            end
            delta(P(i)) = delta(P(i)) + Off;
            c(P(i)) = isempty(intersect(factor(DimX(P(i)) + delta(P(i))),factor(Segments)));
        end
        if sum(c) == length(DimX) - 1
            return
        end
    end
    if sum(~c) > 1
        error('The chosen segmentation leads to tubes of only missing values')
    end
end
if sum(c) == length(DimX) - 1
    [c,Perm] = sort(~c);
end
[nil,PermI] = sort(Perm);
X           = reshape(X,DimX(1),prod(DimX(2:end)));
%GT end

[I,J] = size(X);

if exist('Show')~=1
   Show = 1;
end

if lower(Method(1:3)=='tuc')
   if length(FacMin)==1
      FacMin = ones(1,ord)*FacMin;
   elseif length(FacMin)~=ord
      error('Error in FacMin: When fitting Tucker models, the number of factors should be given for each mode')
   end
   if length(FacMax)==1
      FacMax = ones(1,ord)*FacMax;
   elseif length(FacMax)~=ord
      error('Error in FacMax: When fitting Tucker models, the number of factors should be given for each mode')
   end
end

%RB
% Check if the selected segmentation works (does not produce rows/columns of only missing)
%out = ones(I,J);
%out(1:Segments:end)=NaN;
%out(find(isnan(X))) = NaN;
%if any(sum(isnan(out))==I)
%   error(' The chosen segmentation leads to columns of only missing elements')
%elseif any(sum(isnan(out'))==J)
%   error(' The chosen segmentation leads to rows of only missing elements')
%end
%RB end

if lower(Method(1:3)~='tuc')

   XvalResult.Fit = zeros(FacMax,2)*NaN;
   XvalResult.Xval = zeros(FacMax,2)*NaN;
   for f = 1:FacMin-1
      XvalResult.XvalModel{f} =  'Not fitted';
      XvalResult.FittedModel{f} = 'Not fitted';
   end

   for f = FacMin:FacMax

      % Fitted model
      disp([' Total model - Comp. ',num2str(f),'/',num2str(FacMax)])
      [M,Mean,Param] = decomp(Method,X,DimX,f,1,Segments,Cent,I,J);
      Model = M + ones(I,1)*Mean';
      id    = find(~isnan(X));
      OffsetCorrectedData = X - ones(I,1)*Mean';
      XvalResult.Fit(f,:) = [100*(1 - sum( (X(id) - Model(id)).^2)/sum(OffsetCorrectedData(id).^2)) f];
      XvalResult.FittedModel{f} = Model;

      % Xvalidated Model of data
      ModelXval = zeros(I,J)*NaN;
      for s = 1:Segments
         disp([' Segment ',num2str(s),'/',num2str(Segments),' - Comp. ',num2str(f),'/',num2str(FacMax)])
         %GT
         Xnow    = permute(zeros(DimX),Perm);
         dimsadd = size(Xnow);
         for j = 1:length(DimX)
            dimsadd(j) = delta(Perm(j));
            Xnow       = cat(j,Xnow,zeros(dimsadd));
            index2{j}  = 1:DimX(Perm(j));
            dimsadd    = size(Xnow);
         end
         Xnow(s:Segments:end)     = NaN;
         Xnow                     = reshape(permute(Xnow(index2{:}),PermI),DimX(1),prod(DimX(2:end)));
         Pos                      = isnan(Xnow);
         [M,Mean]                 = decomp(Method,Xnow + X,DimX,f,s,Segments,Cent,I,J,Param);
         model                    = M + ones(I,1)*Mean';
         ModelXval(Pos)           = model(Pos);
         %GT end
      end

      XvalResult.Xval(f,:) = [100*(1 - sum( (X(id) - ModelXval(id)).^2)/sum(OffsetCorrectedData(id).^2)) f];
      XvalResult.XvalModel{f} =  ModelXval;
   end

else % Do Tucker model

   %GT
   if length(FacMin) ~= ord
      FacMin = ones(1,ord)*min(FacMin);
   end
   if length(FacMax) ~= ord
      FacMax = ones(1,ord)*min(FacMax);
   end
   for i=1:length(FacMin)
      ind{i} = [FacMin(i):FacMax(i)]';
      ind2{i} = ones(length(ind{i}),1);
   end
   NCombs = cellfun('length',ind);
   for i=1:length(FacMin)
      o = [1:i-1,i+1:length(FacMin)];
      t = ipermute(ind{i}(:,ind2{o}),[i,o]);
      possibleCombs(1:prod(NCombs),i) = t(:);
   end
   FeasCombs = sort(possibleCombs');
   f2        = prod(FeasCombs(1:size(FeasCombs,1)-1,:))<FeasCombs(end,:);
   possibleCombs(f2,:) = [];
   possibleCombs(:,end+1) = find(~f2(:));
   %GTend
   %RB
   % Find all
   %PossibleNumber = [min(FacMin):max(FacMax)]'*ones(1,ord);
   %possibleCombs = unique(nchoosek(PossibleNumber(:),ord),'rows');
   %remove useless
   %f2 = [];
   %for f1 = 1:size(possibleCombs,1)
   %   if (prod(possibleCombs(f1,:))/max(possibleCombs(f1,:)))<max(possibleCombs(f1,:)) % Check that the largest mode is larger than the product of the other
   %      f2 = [f2;f1];
   %   elseif any(possibleCombs(f1,:)>FacMax)  % Chk the model is desired,
   %      f2 = [f2;f1];
   %   end
   %end
   %possibleCombs(f2,:)=[];
   %[f1,f2]=sort(sum(possibleCombs'));
   %possibleCombs = [possibleCombs(f2,:) f1'];
   %RBend

   XvalResult.Fit = zeros(size(possibleCombs,1),ord+1)*NaN;
   XvalResult.Xval = zeros(size(possibleCombs,1),ord+1)*NaN;
   for f = 1:size(possibleCombs,1)
      XvalResult.XvalModel{f} =  'Not fitted';
      XvalResult.FittedModel{f} = 'Not fitted';
   end

   for f1 = 1:size(possibleCombs,1)

      % Fitted model
      %GT
      disp([' Total model - Comp. ',num2str(possibleCombs(f1,:)),'/',num2str(FacMax)])
      [M,Mean,Param] = decomp(Method,X,DimX,possibleCombs(f1,:),1,Segments,Cent,I,J);
      %GTend
      %RB
      %disp([' Total model - Comp. ',num2str(possibleCombs(f1,1:end-1)),'/',num2str(FacMax)])
      %[M,Mean,Param] = decomp(Method,X,DimX,possibleCombs(f1,1:end-1),1,Segments,Cent,I,J);
      %RBend
      Model = M + ones(I,1)*Mean';
      id    = find(~isnan(X));
      OffsetCorrectedData = X - ones(I,1)*Mean';
      XvalResult.Fit(f1,:) = [100*(1 - sum( (X(id) - Model(id)).^2)/sum(OffsetCorrectedData(id).^2)) possibleCombs(f1,1:end-1)];
      XvalResult.FittedModel{f1} = Model;

      % Xvalidated Model of data
      ModelXval = zeros(I,J)*NaN;
      for s = 1:Segments
         disp([' Segment ',num2str(s),'/',num2str(Segments),' - Comp. ',num2str(possibleCombs(f1,1:end-1)),'/',num2str(FacMax)])
         %GT
         Xnow    = permute(zeros(DimX),Perm);
         dimsadd = DimX;
         for j = 1:length(DimX)
             dimsadd(j) = delta(j);
             Xnow       = cat(j,Xnow,zeros(dimsadd));
             index2{j}  = 1:DimX(j);
             dimsadd(j) = dimsadd(j) + DimX(j);
         end
         Xnow(s:Segments:end)     = NaN;
         Xnow                     = reshape(permute(Xnow(index2{:}),PermI),DimX(1),prod(DimX(2:end)));
         Pos                      = isnan(Xnow);
         [M,Mean]                 = decomp(Method,Xnow + X,DimX,possibleCombs(f1,1:end-1),s,Segments,Cent,I,J,Param);
         model                    = M + ones(I,1)*Mean';
         ModelXval(Pos)           = model(Pos);
         %GT end
      end

      XvalResult.Xval(f1,:) = [100*(1 - sum( (X(id) - ModelXval(id)).^2)/sum(OffsetCorrectedData(id).^2)) possibleCombs(f1,1:end-1)];
      XvalResult.XvalModel{f1} =  ModelXval;
   end

end

if Show&FacMin-FacMax~=0
   if Method(1:3) == 'pca'
      Nam = 'PCA';
   elseif Method(1:3) == 'tuc'
      Nam = 'Tucker';
   elseif Method(1:3) == 'par'
      Nam = 'PARAFAC';
   elseif Method(1:3) == 'nip'
      Nam = 'NIPALS';
   end

   figure
   save jjj
   if lower(Method(1:3))~='tuc'
      bar(FacMin:FacMax,[XvalResult.Fit(FacMin:FacMax,1) XvalResult.Xval(FacMin:FacMax,1)],.76,'grouped')
   else
      % extract the ones with lowest Xval fit (for each # total comp) for plotting
      fx = [];
      f5 =[];
      for f1 = 1:max(possibleCombs(:,end))
         f2 = find(possibleCombs(:,end)==f1);
         if length(f2)
            [f3,f4] = max(XvalResult.Xval(f2));
            f5 = [f5,f2(f4)];
         end
      end
      fx = [possibleCombs(f5,end) XvalResult.Fit(f5,1) XvalResult.Xval(f5,1)];
      bar(fx(:,1),fx(:,2:3),.76,'grouped')
      for f1 = 1:size(fx,1)
         f6=text(fx(f1,1),95,['[',num2str(possibleCombs(f5(f1),1:end-1)),']']);
         set(f6,'Rotation',270)
      end
   end

   g=get(gca,'YLim');
   set(gca,'YLim',[max(-20,g(1)) 100])
   legend('Fitted','Xvalidated',0)
   titl = ['Xvalidation results (',Nam,')'];
   if Cent
      titl = [titl ,' - centering'];
   else
      titl = [titl ,' - no centering'];
   end
   title(titl,'FontWeight','Bold')
   xlabel('Total number of components')
   ylabel('Percent variance explained')
end

function [M,Mean,parameters] = decomp(Method,X,DimX,f,s,Segments,Cent,I,J,parameters);

Conv = 0;
it = 0;
maxit = 500;
% Initialize
if Cent
   Mean = nanmean(X)';
else
   Mean = zeros(J,1);
end

if lower(Method(1:3)) == 'par'
   Xc = reshape(X- ones(I,1)*Mean',DimX);
   if exist('parameters')==1
      fact = parafac(Xc,f,[1e-5 10 0 0 NaN maxit],[],parameters.fact);
   else
      fact = parafac(Xc,f,[1e-5 10 0 0 NaN maxit]);
   end
   M = reshape(nmodel(fact),DimX(1),prod(DimX(2:end)));
   parameters.fact=fact;
elseif lower(Method(1:3)) == 'tuc'
   Xc = reshape(X- ones(I,1)*Mean',DimX);
   if exist('parameters')==1
      [fact,G] = tucker(Xc,f,[1e-2 0 0 0 NaN maxit],[],[],parameters.fact,parameters.G);
   else
      [fact,G] = tucker(Xc,f,[1e-2 0 0 0 NaN maxit]);
   end
   parameters.fact=fact;
   parameters.G=G;
   M = reshape(nmodel(fact,G),DimX(1),prod(DimX(2:end)))      ;
elseif lower(Method) == 'pca'|lower(Method) == 'nip'
   Xc = reshape(X- ones(I,1)*Mean',DimX(1),prod(DimX(2:end)));
   [t,p] = pcanipals(X- ones(I,1)*Mean',f,0);
   parameters.t=t;
   parameters.p=p;
   M = t*p';
else
   error(' Name of method not recognized')
end
Fit = X - M - ones(I,1)*Mean';
Fit = sum(Fit(find(~isnan(X))).^2);

% Iterate
while ~Conv
   it     = it+1;
   FitOld = Fit;

   % Fit multilinear part
   Xcent = X - ones(I,1)*Mean';

   if Method(1:3) == 'par'
      fact = parafac(reshape(Xcent,DimX),f,[1e-2 0 0 0 NaN maxit],[],fact);
      M = reshape(nmodel(fact),DimX(1),prod(DimX(2:end)));
   elseif Method(1:3) == 'tuc'
      [fact,G] = tucker(reshape(Xcent,DimX),f,[1e-2 0 0 0 NaN maxit],[0 0 0],zeros(size(G)),fact,G);
      M = reshape(nmodel(fact,G),DimX(1),prod(DimX(2:end)));
   elseif Method == 'pca'
      [t,p] = pcals(Xcent,f,0,t,p,0);
      M = t*p';
   elseif Method == 'nip'
      [t,p] = pcanipals(Xcent,f,0);
      M = t*p';
   end

   % Find offsets
   if Cent
      x = X;
      mm=M+ones(I,1)*Mean';
      x(find(isnan(X)))=mm(find(isnan(X)));
      Mean = mean(x)';
   end

   %Find fit
   Fit = X - M - ones(I,1)*Mean';
   Fit = sum(Fit(find(~isnan(X))).^2);
   if abs(Fit-FitOld)/FitOld<1e-8 | it > 1500
      Conv = 1;
   end

end
disp([' Fit ',num2str(Fit),' using ',num2str(it),' it.'])

function [t,p] = pcals(X,F,cent,t,p,show);

%  LEAST SQUARES PCA WITH MISSING ELEMENTS
%  20-6-1999
%
%  Calculates a least squares PCA model. Missing elements
%  are denoted NaN. The solution is NOT nested, so one has
%  to calculate a new model for each number of components.

ShowMeFitEvery = 20;
MaxIterations  = 5;
[I,J]=size(X);
Xorig      = X;
Miss       = find(isnan(X));
NotMiss    = find(~isnan(X));
m          = t*p';
X(Miss)    = m(Miss);
ssX    = sum(X(NotMiss).^2);

Fit    = 3;
OldFit = 6;
it     = 0;

while abs(Fit-OldFit)/OldFit>1e-3 & it < MaxIterations;
   it      = it +1;
   OldFit  = Fit;

   [t,s,p] = svds(X,F);
   t       = t*s;

   Model   = t*p';
   X(Miss) = Model(Miss);
   Fit     = sum(sum( (Xorig(NotMiss) - Model(NotMiss)).^2));

   if ~rem(it,ShowMeFitEvery)&show
      disp(['    Fit after ',num2str(it),' it. :',num2str(RelFit),'%'])
   end

end

function [t,p,Mean] = pcanipals(X,F,cent);

% NIPALS-PCA WITH MISSING ELEMENTS
% cent: One if centering is to be included, else zero

[I,J]=size(X);
rand('state',sum(100*clock))

Xorig      = X;
Miss       = isnan(X);
NotMiss    = ~isnan(X);
ssX    = sum(X(find(NotMiss)).^2);
Mean   = zeros(1,J);
if cent
   Mean    = nanmean(X);
end
X      = X - ones(I,1)*Mean;

t=[];
p=[];

for f=1:F
   Fit    = 3;
   OldFit = 6;
   it     = 0;
   T      = rand(I,1);
   P      = rand(J,1);
   Fit    = 2;
   FitOld = 3;

   while abs(Fit-FitOld)/FitOld>1e-7 & it < 100;
      FitOld  = Fit;
      it      = it +1;

      for j = 1:J
         id=find(NotMiss(:,j));
         if length(id)==0
            id,end
         P(j) = T(id)'*X(id,j)/(T(id)'*T(id));
      end
      P = P/norm(P);

      for i = 1:I
         id=find(NotMiss(i,:));
         T(i) = P(id)'*X(i,id)'/(P(id)'*P(id));
      end

      Fit = X-T*P';
      Fit = sum(Fit(find(NotMiss)).^2);
   end
   t = [t T];
   p = [p P];
   X = X - T*P';

end

function Xc = nanmean(X)

if isempty(X)
   Xc = NaN;
   return
end

i = isnan(X);
j = find(i);
i = sum(i);
X(j) = 0;
Num = size(X,1)-i;
Xc = sum(X);
i = find(Num);
Xc(i) = Xc(i)./Num(i);
Xc(find(~Num))=NaN;


%CREATECLIQUETREE Takes in a list of factors F, Evidence and returns a
%clique tree after calling ComputeInitialPotentials at the end.
%
%   C = CREATECLIQUETREE(F) Takes a list of factors and creates a clique
%   tree . The value of the cliques should be initialized to
%   the initial potential.
%   It returns a clique tree that has the following fields:
%   - .edges: Contains indices of the nodes that have edges between them.
%   - .factorList: Contains the list of factors used to build the Clique
%   tree.
%

% Copyright (C) Daphne Koller, Stanford Univerity, 2012

function P = CreateCliqueTree(F)

C.nodes = {};

V = unique([F(:).var]);

% Setting up the cardinality for the variables since we only get a list
% of factors.
C.card = zeros(1, length(V));
for i = 1 : length(V),

    for j = 1 : length(F)
        if (~isempty(find(F(j).var == i)))
            C.card(i) = F(j).card(find(F(j).var == i));
            break;
        end
    end
end

C.factorList = F;

% Setting up the adjaceny matrix.
edges = zeros(length(V));

for i = 1:length(F)
    for j = 1:length(F(i).var)
        for k = 1:length(F(i).var)
            edges(F(i).var(j), F(i).var(k)) = 1;
        end
    end
end

cliquesConsidered = 0;

while cliquesConsidered < length(V)

    % Using Min-Neighbors where you prefer to eliminate the variable that has
    % the smallest number of edges connected to it.
    % Everytime you enter the loop, you look at the state of the graph and
    % pick the variable to be eliminated.

    bestClique = 0;
    bestScore = inf;
    for i=1:size(edges,1)
        score = sum(edges(i,:));
        if score > 0 && score < bestScore
            bestScore = score;
            bestClique = i;
        end
    end

    cliquesConsidered = cliquesConsidered + 1;
    [F, C, edges] = EliminateVar(F, C, edges, bestClique);

end

% Pruning the tree.
C = PruneTree(C);

% Assume that C now has correct cardinality, variables, nodes and edges.
% Here we make the function call to assign factors to cliques and compute the
% initial potentials for clusters.

P = ComputeInitialPotentials(C);


% Infrared small target detection utilizing the multiscale relative local contrast measure
clc;
clearvars;
close all;
for kk = 1
    fold = '.\data\';% 27 images
    try
        img = imread([fold, num2str(kk), '.jpg']);
    catch
        img = imread([fold, num2str(kk), '.bmp']);
    end
    img = img(:,:,1);
    out= RLCM(img);
    figure, imshow(img);
    figure, imshow(out, []);
    figure, surf(out);
end


%  INTERNAL FUNCTION: separate terms for conditional forecasting
%
%  ::
%
%    [Ty,Te,Tsig,C]=SEPARATE_TERMS(T,sstate,ny,nx,nshocks,k,h)
%
%  Args:
%
%     - **T** [cell array]: solution impact
%     - **sstate** [cell array]: steady state
%     - **state_cols** [vector]: location of state variables excluding shocks
%     - **k** [numeric]: number of forward steps (anticipation)
%     - **nshocks** [numeric]: number of shocks
%
%  Returns:
%     :
%
%     - **Ty** [cell array]: includes square matrices for the impact of
%       endogenous variables
%     - **Te** [cell array]: includes matrices for the impact of shocks
%     - **Tsig** [cell array]: includes vectors summing the impact of
%       uncertainty and the trend
%     - **C** [cell array]: includes vectors summing the impact of
%       uncertainty, the trend and the steady state
%
%


function [sourcemodel] = lbex(cfg, sourcemodel)

% This function will add the field "subspace" to the sourcemodel definition.
%
% The subspace projection is based on the LBEX (local basis expansion)
% method.

% set the defaults
cfg.lbex       = ft_getopt(cfg, 'lbex',       3); % this is a distance, in units of sourcemodel.pos
cfg.lbexeigtol = ft_getopt(cfg, 'lbexeigtol', 1000*eps);
cfg.feedback   = ft_getopt(cfg, 'feedback',   'text');
cfg.keep       = ft_getopt(cfg, 'keep',       'all');

if isequal(cfg.keep, 'all')
  cfg.keep = sourcemodel.inside;
else
  if ~islogical(cfg.keep)
    keep = false(size(sourcemodel.pos,1),1);
    keep(cfg.keep) = true;
    cfg.keep = keep;
  end
end
assert(isequal(numel(cfg.keep), numel(sourcemodel.inside)));

cfg.keep = cfg.keep(:) & sourcemodel.inside(:);

Ndipoles = size(sourcemodel.pos,1);
Ninside  = sum(cfg.keep);
inside   = find(cfg.keep);

% concatenate the leadfield of all dipoles that are inside the brain into one large matrix
lfa = cat(2, sourcemodel.leadfield{:});

% do the computations on the svd basis to avoid numerical issues
[U,S,V] = svd(lfa, 'econ');
diagS   = diag(S);
Tol     = 1e-12;
sel     = find(diagS>Tol.*diagS(1));
P       = diag(1./sqrt(diag(S(sel,sel))))*U(:,sel)'; % prewhitening matrix
lfa     = P*lfa;

% covariance of all leadfields
Ca = lfa * lfa';

sourcemodel.subspace = cell(1,size(sourcemodel.pos,1));
ft_progress('init', cfg.feedback, 'computing lbex');
for dipindx=1:Ninside
  % renumber the loop-index variable to make it easier to print the progress bar
  i = inside(dipindx);

  % compute the distance from this dipole to each other dipole
  dist = sqrt(sum((sourcemodel.pos-repmat(sourcemodel.pos(i,:), [Ndipoles 1])).^2, 2));

  % define the region of interest around this dipole
  sel  = dist<=cfg.lbex & sourcemodel.inside;
  Nsel = sum(sel);

  % concatenate the leadfield of all dipoles that are inside the ROI into one matrix
  lfr = P*cat(2,sourcemodel.leadfield{sel(:)'});

  % covariance of leadfields of dipoles inside the ROI
  Cr = lfr * lfr';

  % The eigenvalue problem is to determine the nontrivial solutions of the equation
  %   A*x = l*x
  % The generalized eigenvalue decomposition solves
  %   A*x = l*B*x
  % If B is non-singular, the problem could be solved by reducing it into a standard eigenvalue problem
  %   inv(B)*A*x = l*x
  % See http://www.mathworks.com/access/helpdesk/help/techdoc/ref/eig.html

  % compute eigenspace decomposition, THIS IS NUMERICALLY UNSTABLE
  [v, d] = eig(Cr, Ca);
  % compute eigenspace decomposition, THIS ALSO DOES NOT SOLVE THE PROBLEM
  % [v, d] = eig(pinv(Ca, cfg.lbexeigtol)*Cr);

  % select the eigenvectors with a non-zero eigenvalue
  dd  = diag(d);
  dd  = dd./max(dd);
  sel = dd>cfg.lbexeigtol;
  Nsel2 = sum(sel);

  ft_progress(dipindx/Ninside, 'computing lbex %d/%d, number of dipoles in ROI=%d, subspace dimension=%d\n', dipindx, Ninside, Nsel, Nsel2);

  % remember the subspace projection matrix
  sourcemodel.subspace{inside(dipindx)} = flip(v(:, sel)',1)*P;
end
ft_progress('close');

if ~isequal(cfg.keep(:),sourcemodel.inside(:))
  sourcemodel.inside = cfg.keep;
  sourcemodel.leadfield(~cfg.keep) = {[]};
  sourcemodel.subspace(~cfg.keep)  = {[]};
end


function [Hdraw,HvarsDraw,phi_Hdraw,Adraw,h0]=sampleH_MHstep(yData,Psi,A,B,phi_H,HvarsOld,priorValues,dataValues,n,h0)

%yData=YData
%Psi=PsiDraw_prop
%A=Adraw
%B=Bdraw
%phi_H=phi_Hdraw'
%HvarsOld=HvarsDraw
%% Initialize
offset_c=priorValues.offset_c; %constant for log transformation

[T,M]=size(yData);
p = size(B,1)/M; %lags of the B vector that has dimensions MxM*p (no constant), each column is one regression

% obtain prior data
startMeanVector=priorValues.mean_ln_h0;  %log mean of the initial state (variance scaling parameters) as residuals from an AR(4) in the training sample
startVarVector=priorValues.var_ln_h0;    %variance of the initial state for the elements of lambda

% obtain prior data
b0=priorValues.mean_ln_h0;  %log mean of the initial state (variance scaling parameters) as residuals from an AR(4) in the training sample
a0=eye(M)/priorValues.var_ln_h0(1,1);    %variance of the initial state for the elements of lambda

priorPhi_H=priorValues.phi_h;            %centering parameter for the inverse gamma of the variance of the innovations governing the random walk for lambda
priorD_H  =priorValues.d_h;              %scaling parameter for the inverse gamma distribution for the variance of the innovations governing the random walk for lambda

kappa= priorValues.kappa;
gamma= 1; %priorValues.gamma;

S_h = priorPhi_H*ones(n,1);
nu_h = priorD_H*ones(n,1);

Y_Psi=yData-Psi;  %subtract the local mean
%Y_Psi(1:p,:)=yData(1:p,:)-ones(p,1)*mean(yData(1:p,:)); %also generate initial conditions for the construction of the lagmatrix
Y_Psi(1:p,:)=yData(1:p,:)-ones(p,1)*(Psi(p+1,:)); %also generate initial conditions for the construction of the lagmatrix

% X_Psi = lagmatrix(Y_Psi,1:p); %create RHS of the VAR part
% X_Psi = X_Psi(p+1:end,:);     %remove the first p rows of RHS
X_Psi = bear.lagx(Y_Psi,p-1);
X_Psi = X_Psi(1:end-1,:);
Y_Psi=Y_Psi(p+1:end,:);       %and do so for LHS

E=Y_Psi-X_Psi*B;              %VAR residuals
Escaled=E*A';                 %transform such that VAR residuals have variance Lambda

   for jj=1:T-p
   epst(:,:,jj)=E(jj,:)'; %generate period specific errors
   end

   scaling = ones(n,1);
   Abelowdiag = cell(n,1);
   for kk=2:size(E,2)
       Abelowdiag{kk,1} = A(kk,1:kk-1)';
   end

  %logHvarsOld = HvarsOld;
   logHvarsOld = log(HvarsOld);
   logHdraw = logHvarsOld(p+1:end,:);
%% draw the series lambda_i,t from their conditional posteriors, i=1,...,n and t=1,...,T

% consider variables in turn
   for jj=1:n
      % consider periods in turn
      for kk=p+1:T
      % a candidate value will be drawn from N(lambdabar,phibar)
      % the definitions of lambdabar and phibar varies with the period, thus define them first
         % if the period is the first period
         if kk==p+1
         %lambdabar=(gamma/(1+gamma^2))*((startMeanVector(jj,1))+logHvarsOld(kk+1,jj));
         lambdabar=(gamma*(h0(jj,1)+logHvarsOld(kk+1,jj)))/(1/kappa+gamma^2);
         phibar=phi_H(1,jj)/(1/kappa+gamma^2);
         %phibar=startVarVector(jj,1)+phi_H(1,jj)/(1/kappa+gamma^2);
         %if the period is the final period
         elseif kk==T
         lambdabar=gamma*logHdraw(end-1,jj);
         phibar=phi_H(1,jj);
         % if the period is any period in-between
         else
         lambdabar=(gamma/(1+gamma^2))*(logHdraw(kk-p-1,jj)+logHvarsOld(kk+1,jj));
         phibar=phi_H(1,jj)/(1+gamma^2);
         end
      % now draw the candidate
      cand=lambdabar+phibar^0.5*randn;

%       end
      % compute the acceptance probability
      prob=bear.mhprob2(jj,cand,logHvarsOld(kk,jj),scaling(jj,1),epst(:,1,kk-p),Abelowdiag{jj,1});
      % draw a uniform random number
      draw=rand;
         % keep the candidate if the draw value is lower than the prob
         if draw<=prob
         logHdraw(kk-p,jj)=cand;
%          else
%          logHdraw(kk-p,jj)=logHvarsOld(kk,jj);
%          % if not, just keep the former value
          end
      end
   end

G=speye(T-p)-sparse(diag(gamma*ones(T-p-1,1),-1));
% set the value for omega
omega=10;
% compute I_omega
I_o=sparse(diag([1/kappa;ones(T-p-1,1)]));
GIG=G'*I_o*G;
alpha0=0.01;
alphabar=T-p+alpha0;
delta0=0.01;

% draw the parameters in turn
   for jj=1:n
   % estimate deltabar
   deltabar=logHdraw(1:end,jj)'*GIG*logHdraw(1:end,jj)+delta0;
   % draw the value phi_i
   phi_Hdraw(jj)=bear.igrandn(alphabar/2,deltabar/2);
   end

   %% draw A
   Hvars=exp([zeros(n,p) logHdraw']');

   [Adraw]=bear.sampleA_H(yData,Psi,B,Hvars,T,priorValues,dataValues);
   AdrawInv=Adraw\eye(n);

   %% sample the initial value
Kh0 = a0 + sparse(1:n,1:n,1./phi_Hdraw');
h0_hat = Kh0\(a0*b0 + log(Hvars(p+1,:)')./phi_Hdraw');
h0 = h0_hat + chol(Kh0,'lower')'\randn(n,1);

   %% Construct H
Hdraw=zeros(n,n,T);

for t=1:T
    Hdraw(:,:,t)=AdrawInv*diag(Hvars(t,:))*AdrawInv';
end

HvarsDraw=Hvars;


% Add a prior on the beta parameter to avoid low Signal to Noise Ratio
% problems.
function model = hsvargplvmControlSNR(model, meanSNR, layer, view, priorInfo, priorScale)

if nargin < 1, error('At least one argument needed!'); end
if nargin < 6, priorScale = 25; end
if nargin < 5, priorInfo = []; end
if nargin < 4 || isempty(view), view = 1; end
if nargin < 3 || isempty(layer), layer = model.H; end
% Where I want the expected value of my inv gamma if it was on SNR
if nargin < 2 || isempty(meanSNR), meanSNR = 150; end

if isempty(priorInfo)
    priorInfo.name = 'invgamma'; % What type of prior
    varData = var(model.layer{layer}.comp{view}.mOrig(:));
    meanB = meanSNR./varData;
    a=0.08;%1.0001; % Relatively large right-tail
    b=meanB*(a+1); % Because mode = b/(a-1)
    priorInfo.params = [a b];
end

model = hsvargplvmAddParamPrior(model, layer, 1, 'beta', priorInfo.name, priorInfo.params);
if ~isempty('priorScale')
    model.layer{layer}.comp{view}.paramPriors{1}.prior.scale = priorScale;
end


function [Population,W,B] = WeightUpdate(Population,W,Archive,Z,T,Global)
% Weight Update

%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    %% Routine to find undeveloped individuals (correspondingly their weights) in the archive set
    % Normalisation
    N_arc         = length(Archive);
    fmin_arc      = min(Archive.objs);
    fmax_arc      = max(Archive.objs);
    Archiveobjs   = (Archive.objs - repmat(fmin_arc,N_arc,1) )./repmat(fmax_arc - fmin_arc,N_arc,1);
    Populaionobjs = (Population.objs - repmat(fmin_arc,Global.N,1) )./repmat(fmax_arc - fmin_arc,Global.N,1);
    % Euclidean distance between individuals in the archive set and individuals in the Population
    dis1 = pdist2(Archiveobjs,Populaionobjs);
    dis1 = sort(dis1,2);
    % Euclidean distance between any two individuals in the archive set
    dis2 = pdist2(Archiveobjs,Archiveobjs);
    dis2 = sort(dis2,2);
    % Calculate the niche size(median of the distances from their closest solution in the archive )
    niche_size = median(dis2(:,2));
    % Find undeveloped
    Archive_und = Archive(dis1(:,1) >= niche_size);
    N_und = length(Archive_und);

    %% If the undeveloped individuals are promising then add them into the evolutionary Population
    % Obtain their corresponding weights.
	if ~isempty(Archive_und)
        W1 = (Archive_und.objs - repmat(Z,N_und,1))./repmat( sum(Archive_und.objs,2)-repmat(sum(Z),N_und,1), 1, Global.M );
        for i = 1 : size(W1,1)
            W_all = [W;W1(i,:)];
            B1 = pdist2(W_all,W_all);
            B1(logical(eye(length(B1)))) = inf;
            [~,B1] = sort(B1,2);
            B1 = B1(:,1:T);

            Population1 = [Population,Archive_und(i)];
            Population2 = Population1(B1(end,:));

            Value_Tche_all = max(abs(Population2.objs-repmat(Z,T,1))./repmat(W1(i,:),T,1),[],2);
            Value_Tche     = max(abs(Archive_und(i).obj -    Z     )./W1(i,:),[],2);
            index = find(Value_Tche_all<Value_Tche, 1);

            if isempty(index)
                % Put the wight into the W, as well as the corresponding solution
                W = [W;W1(i,:)];
                Population = [Population Archive_und(i)];

                % Update neighbour solutions after adding a weight
                P = B1(end,:);
                g_old = max( abs( Population(P).objs - repmat(Z,T,1) )./W(P,:),[],2 );
                g_new = max( abs( repmat(Archive_und(i).obj,T,1) - repmat(Z,T,1) )./W(P,:),[],2 );
                Population(P(g_old > g_new)) = Archive_und(i);
            end
        end
    end

    %% Delet the poorly performed weights until the size of W is reduced to N
    % find out the solution that is shared by the most weights in the population
    while length(Population) > Global.N
        [~,ai,bi] = unique(Population.objs,'rows');
        if length(ai) == length(bi)   % If every solution in the population corresponds to only one weight
            % Normalisation
            fmax  = max(Population.objs,[],1);
            fmin  = min(Population.objs,[],1);
            PCObj = (Population.objs-repmat(fmin,length(Population),1))./repmat(fmax-fmin,length(Population),1);
            % Determine the radius of the niche
            d  = pdist2(PCObj,PCObj);
            d(logical(eye(length(d)))) = inf;
            sd = sort(d,2);
            num_obj = size(Population.objs,2);
            r  = median(sd(:,min(num_obj,size(sd,2))));
            R  = min(d./r,1);
            % Delete solution one by one
            while length(Population) > Global.N
                [~,worst]  = max(1-prod(R,2));
                Population(worst)  = [];
                R(worst,:) = [];
                R(:,worst) = [];
                W(worst,:) = [];
            end
        else
            Index = find(bi==mode(bi));
            Value_Tche2 = max(abs(Population(Index).objs-repmat(Z,size(Index,1),1))./W(Index,:),[],2);
            Index_max= find(Value_Tche2 == max(Value_Tche2));
            Population(Index(Index_max(1)))=[];
            W(Index(Index_max(1)),:)=[];
        end
    end
    % Update the neighbours of each weight
    B = pdist2(W,W);
    [~,B] = sort(B,2);
    B = B(:,1:T);
end


function score = IGDX(Population,POS)
% <min> <multi/many> <real/integer/label/binary/permutation> <large/none> <constrained/none> <expensive/none> <sparse/none> <multimodal> <dynamic/none>
% Inverted generational distance in the decision space

%------------------------------- Reference --------------------------------
% A. Zhou, Q. Zhang, and Y. Jin, Approximating the set of Pareto-optimal
% solutions in both the decision and objective spaces by an estimation of
% distribution algorithm, IEEE Transactions on Evolutionary Computation,
% 2009, 13(5): 1167-1189.
%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    PopDec = Population.decs;
    if size(PopDec,2) ~= size(POS,2)
        score = nan;
    else
        score = mean(min(pdist2(POS,PopDec),[],2));
    end
end


%  INTERNAL FUNCTION: Numerical evaluation of the hessian of the policy objective
%
%  ::
%
%    H=evaluate_policy_objective_hessian_numerically(funcs,y,x,ss,param,sparam,def,s0,s1)
%
%  Args:
%
%     - **funcs** [fhandle|cell array]: function or functions to be
%       differentiated
%     - **y** [vector]: values of endogenous variables
%     - **x** [vector]: values of exogenous variables
%     - **ss** [vector]: steady state
%     - **param** [vector]: parameter vector
%     - **sparam** [vector]: vector of parameters appearing with a lead
%     - **def** [vector]: values of definitions
%     - **s0** [scalar]: state today
%     - **s1** [scalar]: state tomorrow
%
%  Returns:
%     :
%
%     - **H** [matrix]: Numerical Hessian of **funcs** at [y]
%
%  Note:
%     It is assumed that the inputs are y,x,ss,param,sparam,def,s0,s1 as
%     ordered in parser.input_list()
%
%


function [prob_lut, prob_map] = getForegroundBackgroundProbs(frame, obj_rect, num_bins, bin_mapping)
%GETFOREGROUNDBACKGROUNDPROBS Computes the probability lookup table for the
%object vs surrounding region model.
% Parameters:
%   frame       Input (color) image cropped to contain only the surrounding
%               region
%   obj_rect    Rectangular object region
%   num_bins    Number of bins per channel (scalar)
%   bin_mapping Maps intensity values to num_bins bins

[rows, cols, layers] = size(frame);
%%size of object
obj_row = round(obj_rect(2));
obj_col = round(obj_rect(1));
obj_width = round(obj_rect(3));
obj_height = round(obj_rect(4));

if obj_row + obj_height > rows, obj_height = rows - obj_row; end
if obj_col + obj_width > cols, obj_width = cols - obj_col; end

if nargout > 1
  prob_map = zeros(rows, cols);
end

if layers == 3
  % Color image
  obj_hist = zeros(num_bins, num_bins, num_bins, 'double');
  surr_hist = zeros(num_bins, num_bins, num_bins, 'double');

  % Histogram over full image
  [x,y] = meshgrid(1:cols, 1:rows);
  idx_map = sub2ind([rows, cols], y(:), x(:));
  idx_1 = sub2ind([rows, cols, layers], y(:), x(:), ones(numel(x), 1));
  idx_2 = sub2ind([rows, cols, layers], y(:), x(:), 2.*ones(numel(x), 1));
  idx_3 = sub2ind([rows, cols, layers], y(:), x(:), 3.*ones(numel(x), 1));

  bin_1 = bin_mapping(frame(idx_1)+1);
  bin_2 = bin_mapping(frame(idx_2)+1);
  bin_3 = bin_mapping(frame(idx_3)+1);

  idx_hist_full = sub2ind(size(surr_hist), bin_1, bin_2, bin_3);
  bins = unique(idx_hist_full);
  for b = bins
    surr_hist(b) = nnz(idx_hist_full == b);
  end

  % Histogram over object region
  [x,y] = meshgrid(max(1,obj_col):(obj_col+obj_width), max(1,obj_row):(obj_row+obj_height));
  idx_1 = sub2ind([rows, cols, layers], y(:), x(:), ones(numel(x), 1));
  idx_2 = sub2ind([rows, cols, layers], y(:), x(:), 2.*ones(numel(x), 1));
  idx_3 = sub2ind([rows, cols, layers], y(:), x(:), 3.*ones(numel(x), 1));

  bin_1o = bin_mapping(frame(idx_1)+1);
  bin_2o = bin_mapping(frame(idx_2)+1);
  bin_3o = bin_mapping(frame(idx_3)+1);

  idx_hist_obj = sub2ind(size(obj_hist), bin_1o, bin_2o, bin_3o);
  bins = unique(idx_hist_obj);
  for b = bins
    obj_hist(b) = nnz(idx_hist_obj == b);
  end

  prob_lut = (obj_hist + 1) ./ (surr_hist + 2);
  if nargout > 1
    prob_map(idx_map) = prob_lut(idx_hist_full);
  end
elseif layers == 10
  obj_hist = zeros(1,1,layers, 'double');
  surr_hist = zeros(1,1,layers, 'double');

  for r = 1:rows
    for c = 1:cols
      surr_hist = surr_hist + (frame(r,c,:)+1)/2;
      if r >= obj_row && r < obj_row+obj_height && c >= obj_col && c < obj_col+obj_width
        obj_hist = obj_hist + (frame(r,c,:)+1)/2;
      end
    end
  end
  prob_lut = (obj_hist + 1) ./ (surr_hist + 2);

elseif layers == 1
  % Color image
  obj_hist = zeros(num_bins, 1, 'double');
  surr_hist = zeros(num_bins, 1, 'double');

  % Histogram over full image
  [x,y] = meshgrid(1:cols, 1:rows);
  idx_map = sub2ind([rows, cols], y(:), x(:));

  bin = bin_mapping(frame(idx_map)+1);

  idx_hist_full = sub2ind(size(surr_hist), bin);
  bins = unique(idx_hist_full);
  for b = bins
    surr_hist(b) = nnz(idx_hist_full == b);
  end

  % Histogram over object region
  [x,y] = meshgrid(max(1,obj_col):(obj_col+obj_width), max(1,obj_row):(obj_row+obj_height));
  idx = sub2ind([rows, cols], y(:), x(:));

  bin_1o = bin_mapping(frame(idx)+1);

  idx_hist_obj = sub2ind(size(obj_hist), bin_1o);
  bins = unique(idx_hist_obj);
  for b = bins
    obj_hist(b) = nnz(idx_hist_obj == b);
  end

  prob_lut = (obj_hist + 1) ./ (surr_hist + 2);
  if nargout > 1
    prob_map(idx_map) = prob_lut(idx_hist_full);
  end
else
  error('Not supported\n');
end

end


function [ y, m, d, f ] = jed_to_ymdf_alexandrian ( jed )

%*****************************************************************************80
%
%% JED_TO_YMDF_ALEXANDRIAN converts a JED to an Alexandrian YMDF date.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    05 July 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real JED, the Julian Ephemeris Date.
%
%    Output, integer Y, M, D, real F,
%    the YMDF date.
%

%
%  Determine the computational date (Y'/M'/D').
%
  j = floor ( jed + 0.5 );
  f = ( jed + 0.5 ) - j;

  j_prime = j + 124;

  y_prime = floor ( ( 4 * j_prime + 3 ) / 1461 );
  t_prime = floor ( mod ( 4 * j_prime + 3, 1461 ) / 4 );
  m_prime = floor ( t_prime / 30 );
  d_prime = mod ( t_prime, 30 );
%
%  Convert the computational date to a calendar date.
%
  d = d_prime + 1;
  m = mod ( m_prime, 13 ) + 1;
  y = y_prime - 4690 + floor ( ( 13 - m ) / 13 );

  return
end


function [pvec, pstruct] = tapas_hgf_binary_transp(r, ptrans)
% --------------------------------------------------------------------------------------------------
% Copyright (C) 2012-2013 Christoph Mathys, TNU, UZH & ETHZ
%
% This file is part of the HGF toolbox, which is released under the terms of the GNU General Public
% Licence (GPL), version 3. You can redistribute it and/or modify it under the terms of the GPL
% (either version 3 or, at your option, any later version). For further details, see the file
% COPYING or <http://www.gnu.org/licenses/>.

pvec    = NaN(1,length(ptrans));
pstruct = struct;

l = r.c_prc.n_levels;

pvec(1:l)         = ptrans(1:l);                           % mu_0
pstruct.mu_0      = pvec(1:l);
pvec(l+1:2*l)     = exp(ptrans(l+1:2*l));                  % sa_0
pstruct.sa_0      = pvec(l+1:2*l);
pvec(2*l+1:3*l)   = ptrans(2*l+1:3*l);                     % rho
pstruct.rho       = pvec(2*l+1:3*l);
pvec(3*l+1:4*l-1) = exp(ptrans(3*l+1:4*l-1));              % ka
pstruct.ka        = pvec(3*l+1:4*l-1);
pvec(4*l:5*l-1)   = ptrans(4*l:5*l-1);                     % om
pstruct.om        = pvec(4*l:5*l-1);

return;


function [Pro,FreeNodec] = nodeisoP2TansferUniform(elemc,elemf,FreeNode)
%  Only works for uniformrefinered.
%
%
% Created by Jie Zhou,Jan,17,2013.
% Talk with Long Chen
%% Data structure.
%% Data structure.
if ~exist('FreeNode','var'), FreeNode = []; end
[elem2dofc,edgec] = dofP2(elemc);
[elem2doff,edgef] = dofP2(elemf);

Nc = max(elemc(:));  Nf = max(elemf(:));
Ndofc = Nc + size(edgec,1);Ndoff = Nf + size(edgef,1);
NTc = size(elemc,1);  %NTc:coarse elements number.
%NTf = size(elemf,1);

elem2node2f = sparse(NTc,9); %very important, map from coarse space to fine space
%we just consider the middle points in fine edges.
elem2node2f(:,1)=elem2doff(1:NTc,4);
elem2node2f(:,2)=elem2doff(1:NTc,5);
elem2node2f(:,3)=elem2doff(1:NTc,6);

elem2node2f(:,4)=elem2doff(NTc+1:2*NTc,4);
elem2node2f(:,5)=elem2doff(NTc+1:2*NTc,5);
elem2node2f(:,6)=elem2doff(NTc+1:2*NTc,6);

elem2node2f(:,7)=elem2doff(2*NTc+1:3*NTc,4);
elem2node2f(:,8)=elem2doff(2*NTc+1:3*NTc,5);
elem2node2f(:,9)=elem2doff(2*NTc+1:3*NTc,6);

%% Assembel the transfer matrix
%        1       2         3        4       5       6         7           8          9
c0=1/2;
locPij=[ 0    1/2*c0    1/2*c0      0        0        0          0         0        0;...
         0    0         0         1/2*c0     0       1/2*c0      0         0        0;...
         0    0         0           0        0        0         1/2*c0     1/2*c0   0;...
         0    0         0         1/2*c0     1/2      0         1/2*c0     0        1/2; ...
         1/2  1/2*c0    0           0        0        0          0         1/2*c0   1/2; ...
         1/2  0         1/2*c0      0        1/2      1/2*c0     0         0        0];
%%Corase grid order          fine grid order
% 3                          *
% * *                        *  7
% *   *                      8    *
% *     *                    *      *
% 5       4                  ***9******
% *         *                *      *    4
% *           *              2  1   5      *
% *             *            *      *        *
% 1*****6********2           ***3********6*****

ii = zeros(40*NTc,1); jj = zeros(40*NTc,1); ss = zeros(40*NTc,1);
index = 0;
for i = 1:6
    for j = 1:9
        if locPij(i,j)~=0
            %Pij = locPij(i,j)*elem2edgeSignc(:,i).*elem2edgesignc2f(:,j);
            ii(index+1:index+NTc) =  elem2dofc(:,i);
            jj(index+1:index+NTc) =  elem2node2f(:,j);
            ss(index+1:index+NTc) =  locPij(i,j);
            index = index + NTc;
        end
    end
end
ii(ii==0)=[];
jj(jj==0)=[];
ss(ss==0)=[];

% Modification for boundary middle points.
s = accumarray([elem2doff(:,4);elem2doff(:,5);elem2doff(:,6)],1,[Ndoff 1]);
bdEdgeidxf = (s == 1);
bdEdgeidxfinjj = bdEdgeidxf(jj);
ss(bdEdgeidxfinjj) = 2*ss(bdEdgeidxfinjj);
ii = [(1:Ndofc)'; ii];
jj = [(1:Ndofc)'; jj];
ss = [ones(Ndofc,1); ss];
Pro     =  sparse(jj,ii,ss,Ndoff,Ndofc);
% Pro(1:Ndofc,1:Ndofc) = speye(Ndofc,Ndofc);
% The transfer for  is a identical matrix, so the local matrix is 6 by 9.

%% Truncated to free nodes
if ~isempty(FreeNode)
    FreeNodec = FreeNode(FreeNode<=Ndofc);
    Pro = Pro(FreeNode,FreeNodec);
end


function plotData(X, y)
%PLOTDATA Plots the data points X and y into a new figure
%   PLOTDATA(x,y) plots the data points with + for the positive examples
%   and o for the negative examples. X is assumed to be a Mx2 matrix.

% Create New Figure
figure; hold on;
% Find Indices of Positive and Negative Examples
pos = find(y==1); neg = find(y == 0);
% Plot Examples
plot(X(pos, 1), X(pos, 2), 'k+','LineWidth', 2, ...
'MarkerSize', 7);
plot(X(neg, 1), X(neg, 2), 'ko', 'MarkerFaceColor', 'y', ...
'MarkerSize', 7);
% ====================== YOUR CODE HERE ======================
% Instructions: Plot the positive and negative examples on a
%               2D plot, using the option 'k+' for the positive
%               examples and 'ko' for the negative examples.
%

% =========================================================================

hold off;

end


% DEMOIL3 Oil data with deterministic training conditional.

% FGPLVM

% Fix seeds
randn('seed', 1e5);
rand('seed', 1e5);

dataSetName = 'oil';
experimentNo = 3;

% load data
[Y, lbls] = lvmLoadData(dataSetName);

% Set up model
options = fgplvmOptions('dtc');
options.optimiser = 'scg';
latentDim = 2;
d = size(Y, 2);

model = fgplvmCreate(latentDim, d, Y, options);

% Optimise the model.
iters = 1000;
display = 1;

model = fgplvmOptimise(model, display, iters);

% Save the results.
capName = dataSetName;;
capName(1) = upper(capName(1));
save(['dem' capName num2str(experimentNo) '.mat'], 'model');

if exist('printDiagram') & printDiagram
  fgplvmPrintPlot(model, lbls, capName, experimentNo);
end

% Load the results and display dynamically.
fgplvmResultsDynamic(dataSetName, experimentNo, 'vector')

% compute the nearest neighbours errors in latent space.
errors = fgplvmNearestNeighbour(model, lbls);


function sR=icassoProjection(sR, method, varargin)
%function sR=icassoProjection(sR,[method],['identifier1',val1,'identifier2',val2,...]))
%
%PURPOSE
%
%To project points on plane so that Euclidean distances between the
%projected points correspond to the similarity matrix between IC
%estimates in the Icasso result structure.
%
%EXAMPLES OF BASIC USAGE
%
%   sR=icassoProjection(sR);
%
%makes a CCA projection using default parameters. This is equivalent
%of giving command:
%
%   sR=icassoProjection(sR,'cca', 's2d','sim2dis2','epochs',70,'alpha',0.7);
%
%In the following example 'sim2dis' (i.e., D=1-S) is used to make
%the similarity-to-dissimilarity transformation and a longer,
%sammon's projection is used and a longer training sequence is engaged:
%
%   sR=icassoProjection(sR,'sammon','s2d','sim2dis','epochs',200):
%
%INPUT
%
%[An argument in brackets is optional. If it isn't  given or it's
% an empty matrix/string, the function will use a default value.]
%
% sR       (struct) Icasso result data structure
% [method] (string) 'cca' (defalut) | 'mmds' | 'sammon'
%
%Optional input arguments are given as argument identifier - value
%pairs: 'identifier1', value1, 'identifier2', value2,...
%(case insensitive)
%
%  'epochs'     (scalar) see details
%  'alpha',     (scalar) see details
%  'radius'     (scalar) see details
%  's2d'        (string) see details
%
%OUTPUT
%
% sR (struct) updated Icasso result data structure,
%
%The function updates _only_ the following fields:
%sR.projection.method, sR.projection.parameters, and
%sR.projection.coordinates. See icassoStruct.
%
%DETAILS
%
%The function transforms the similarities S in field
%sR.cluster.similarities into dissimilarities using function
%sim2dis2 as default. Note that this may be different from
%the transformation that was used for making clustering.
%Input argument pair 's2d',<string> gives the name of function
%that is used to make the transformation from similarities
%S=sR.cluster.similarity. There are two ready made functions
%sim2dis.m and sim2dis2.m that can be used:
%   function      makes transformation
%  'sim2dis2'     D=sqrt(1-S)   (default)
%  'sim2dis'      D=1-S
%or you can specify your own function.
%
%The function can use three methods to do the projection on D
%1. Curvilinear Component Analysis (CCA) (preferred)
%2. Principal Coordinates (linear Metric Multi-Dimensional Scaling,MMDS)
%3. Sammon's projection (Sammon)
%CCA and Sammon require some parameters. The default values are set
%according to experience and can be altered if necessary. MMDS is
%automatically used as an initial projection for both Sammon and CCA.
%
%'epochs'  (scalar) the number of epochs for CCA or Sammon.
%           Ignored for MMDS.
%           default(s): CCA: 75, Sammon: 100
%
%'radius'  (scalar) CCA initial radius. Ignored for Sammon and MMDS
%            default(s) CCA: max(10,M/20) where M is the number of
%            estimates
%
%'alpha'   (scalar) learning rate factor for CCA or Sammon.
%            ignored for MMDS
%            default(s): CCA: 0.7, Sammon: 0.7
%
%SEE ALSO
% mmds
% cca (in SOM Toolbox)
% sammon (in SOM Toolbox)

%COPYRIGHT NOTICE
%This function is a part of Icasso software library
%Copyright (C) 2003-2005 Johan Himberg
%
%This program is free software; you can redistribute it and/or
%modify it under the terms of the GNU General Public License
%as published by the Free Software Foundation; either version 2
%of the License, or any later version.
%
%This program is distributed in the hope that it will be useful,
%but WITHOUT ANY WARRANTY; without even the implied warranty of
%MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%GNU General Public License for more details.
%
%You should have received a copy of the GNU General Public License
%along with this program; if not, write to the Free Software
%Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

% ver 1.21 030305 johan

% Set default projection method
if nargin<2|isempty(method),
  method='cca';
end

% Check the method
method=lower(method);
switch method
 case {'sammon','cca','mmds'}
  ;
 otherwise
  error('Unknown projection.');
end

% We project onto plane
outputDimension=2;

% Set default parameters for proj, methods
switch method
 case 'sammon'
  default={'alpha',0.7,'epochs',100,'s2d','sqrtsim2dis'};
 case 'cca'
  default={'alpha',0.7,'epochs',75,...
	   'radius',max(icassoGet(sR,'M')/20,10),'s2d','sqrtsim2dis'};
 case 'mmds'
  default={'s2d','sqrtsim2dis'};
end

%% Check optional arguments and add defaults
projectionparameters=processvarargin(varargin,default);
num_of_args=length(projectionparameters);

%% check arguments
for i=1:2:num_of_args;
  switch lower(projectionparameters{i})
   case 's2d'
    sim2dis=projectionparameters{i+1};
   case 'epochs'
    epochs=projectionparameters{i+1};
   case 'alpha'
    alpha=projectionparameters{i+1};
   case 'radius'
    CCAradius=projectionparameters{i+1};
   otherwise
    error(['Indentifier ' projectionparameters{i} ' not recognized.']);
  end
end

% Make similarity-to-dissimilarity transformation

D=feval(sim2dis,sR.cluster.similarity);

disp([char(13) 'Projection, using ' upper(method) char(13)]);

switch method
 case 'mmds'
  P=mmds(D);
  P=P(:,1:outputDimension);
 otherwise
  % Start from MMDS
  initialProjection=mmds(D); initialProjection=initialProjection(:,1:2);
  %
  dummy=rand(size(D,1),outputDimension);
  % rand. init projection: set
  % initialProjection=dummy;
  switch method
   case 'sammon' % Use SOM Toolbox Sammon
    P=sammon(dummy,initialProjection,epochs,'steps',alpha,D);
   case 'cca'    % Use SOM Toolbox CCA
    P=cca(dummy,initialProjection,epochs,D,alpha,CCAradius);
  end
end

sR.projection.method=method;
sR.projection.parameters=projectionparameters;
sR.projection.coordinates=P;


function [cl] = oz2cl(oz)
% Convert volume from US liquid ounces to centiliters.
% Chad Greene 2012
cl = oz*2.9573529563;


function drawAzBeam(azCenter,beamHalfwidth,range,systemType,lRx,M,closeEnds,varargin)
%%DRAWANGLEBEAM Draw the outline in 2D Cartesian coordinates of a polar
%           beam in a particular direction. This does not shape the beam
%           based upon gain. It just outlines a region, drawing a curve on
%           the end at a constant range, if desired. This can be useful for
%           determining whether plotted targets are near various beams in
%           2D.
%
%INPUTS: azCenter The scalar center angle of the beam in radians.
%   beamHalfwidth The distance from the center of the beam to one side of
%                 the beam in radians. This must be >0.
%           range This can be a scalar or a length-2 vector. If a scalar,
%                 it is the maximum extent of the range to which the beam
%                 is drawn. If this is a length-2 vector, then range(1) is
%                 the minimum range to draw and range(2) is the maximum
%                 range to be covered by the beam. This is a one-way range.
%      systemType An optional parameter specifying the axis from which the
%                 angles are measured. Possible values are:
%                 0 (The default if omitted or an empty matrix is passed)
%                   The azimuth angle is counterclockwise from the x axis.
%                 1 The azimuth angle is measured clockwise from the y axis.
%             lRx The 2X1 [x;y] location vector of the receiver in
%                 Cartesian coordinates.  If this parameter is omitted or
%                 an empty matrix is passed, then the receiver is assumed
%                 to be at the origin.
%               M A 2X2 rotation matrices to go from the alignment of the
%                 global coordinate system to that at the receiver. If
%                 omitted or an empty matrix is passed, then it is assumed
%                 that the local coordinate system is aligned with the
%                 global and M=eye(2) --the identity matrix is used.
%
%OUTPUTS: None.
%
%EXAMPLE:
%This function draws 60-degree beams in three directions making an image
%reminiscent of a radioactive symbol.
% figure(1)
% clf
% hold on
% %60 degree beam.
% beamHalfwidth=30*(pi/180);
% range=[2;10];
% systemType=0;
% azCenter=30*(pi/180);
% drawAzBeam(azCenter,beamHalfwidth,range,[],[],[],[],'-k','linewidth',2)
% azCenter=pi-30*(pi/180);
% drawAzBeam(azCenter,beamHalfwidth,range,[],[],[],[],'-k','linewidth',2)
% azCenter=-pi/2;
% drawAzBeam(azCenter,beamHalfwidth,range,[],[],[],[],'-k','linewidth',2)
%
%January 2023 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

if(nargin<4||isempty(systemType))
    systemType=0;
end

if(nargin<5||isempty(lRx))
    lRx=[0;0];
end

if(nargin<6||isempty(M))
    M=eye(2,2);
end

if(nargin<7||isempty(closeEnds))
    closeEnds=true;
end

numPts=1000;

if(isscalar(range))
   %If only a maximum range is given, set the minimum range to 0.
   range=[0;range];
end

if(systemType==1)
    azCenter=pi/2-azCenter;
end

if(beamHalfwidth<=0)
    error('beamHalfwidth must be positive.')
end

%Save the value of hold on the plot so that it can be reset to its previous
%state after plotting multiple lines.
holdVal=ishold();

systemType=0;
useHalfRange=true;

if(closeEnds==false)
    %Draw the sides
    az1=azCenter-beamHalfwidth;
    startPoint=pol2Cart([range(1);az1],systemType,useHalfRange,lRx,lRx,M);
    endPoint=pol2Cart([range(2);az1],systemType,useHalfRange,lRx,lRx,M);
    plot([startPoint(1);endPoint(1)],[startPoint(2);endPoint(2)],varargin{:})

    hold on
    az2=azCenter+beamHalfwidth;
    startPoint=pol2Cart([range(1);az2],systemType,useHalfRange,lRx,lRx,M);
    endPoint=pol2Cart([range(2);az2],systemType,useHalfRange,lRx,lRx,M);
    plot([startPoint(1);endPoint(1)],[startPoint(2);endPoint(2)],varargin{:})

    %Restore the hold value.
    if(~holdVal)
        hold off
    end
    return
end

if(range(1)~=0)
    totalNumPoints=2*numPts+1;
else
    totalNumPoints=numPts+2;
end
zPts=zeros(2,totalNumPoints);

az1=azCenter-beamHalfwidth;
az2=azCenter+beamHalfwidth;
ang=[az1+linspace(0,2*beamHalfwidth,numPts-1),az2];
zPts(:,1:numPts)=pol2Cart([range(2)*ones(1,numPts);ang],systemType,useHalfRange,lRx,lRx,M);

if(range(1)~=0)
    ang=flip(ang);
    zPts(:,(numPts+1):(2*numPts))=pol2Cart([range(1)*ones(1,numPts);ang],systemType,useHalfRange,lRx,lRx,M);
else
    zPts(:,numPts+1)=lRx;
end
zPts(:,totalNumPoints)=zPts(:,1);
plot(zPts(1,:),zPts(2,:),varargin{:})

%Restore the hold value to its original setting.
if(~holdVal)
    hold off
end
end

%LICENSE:
%
%The source code is in the public domain and not licensed or under
%copyright. The information and software may be used freely by the public.
%As required by 17 U.S.C. 403, third parties producing copyrighted works
%consisting predominantly of the material produced by U.S. government
%agencies must provide notice with such work(s) identifying the U.S.
%Government material incorporated and stating that such material is not
%subject to copyright protection.
%
%Derived works shall not identify themselves in a manner that implies an
%endorsement by or an affiliation with the Naval Research Laboratory.
%
%RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF THE
%SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY THE NAVAL
%RESEARCH LABORATORY FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE ACTIONS
%OF RECIPIENT IN THE USE OF THE SOFTWARE.


function p45=p45(h)
sldata;
limitpoints;
slopes;
T45=2.78e-3*h+139.1;
p2=p1*(T2/T1)^(-g/(m12*R));
p3=p2*exp(-g*(h3-h2)/(R*T2));
p4=p3*(T4/T3)^(-g/(m34*R));
p45=p4*(T45/T4)^(-g/(m45*R));


function gmt_Colormap_ConvertPovRayToGMT(sPovRayFile, sGMTFile, fMin, fMax, bFlip)

mMatlabColormap = gui_Colormap_ReadPovRay(sPovRayFile, 256);
if exist('bFlip', 'var')
  if bFlip
    mMatlabColormap = flipud(mMatlabColormap);
  end
end
nRow = length(mMatlabColormap(:,1));
fDiff = fMax - fMin;
vMinRow = fMin:(fDiff/nRow):(fMax-(fDiff/nRow));
vMaxRow = (fMin+(fDiff/nRow)):(fDiff/nRow):fMax;
mGMTColormap = [vMinRow' mMatlabColormap.*255 vMaxRow' mMatlabColormap.*255];
save(sGMTFile, 'mGMTColormap', '-ascii');


function [data,colorRange,minData,maxData] = scaleData(data,varargin)

data = real(data);

%if check_option(varargin,{'log','logarithmic'}), data(data==0)=NaN; end

% min and max
if check_option(varargin,{'log','logarithmic'})
  minData = min(data(~isnan(data) & ~isinf(log(data))));
else
  minData = min(data(~isnan(data) & ~isinf(data)));
end
maxData = max(data(~isnan(data) & ~isinf(data)));

% get colorrange from data
colorRange = [minData,maxData];
minData = nanmin(data(:));
maxData = nanmax(data(:));
if minData == maxData
  if minData == 0
    maxData = 1;
  else
    minData = 0;
  end
end

% from options
if check_option(varargin,{'contourf'},'double')

  contours = get_option(varargin,{'contourf','contour'},[],'double');
  colorRange = [contours(1),contours(end)];

elseif check_option(varargin,'colorRange','double')

  colorRange = get_option(varargin,'colorrange',[],'double');

  if isinf(colorRange(1))
    if isfinite(minData)
      colorRange(1) = minData;
    else
      colorRange(1) = colorRange(2)-2*eps;
    end
  end

end

% correct for allmost constant data
if isempty(colorRange)
  colorRange = [0,1];
elseif colorRange(1)>0 && ...
    ((colorRange(2)-colorRange(1))/colorRange(1) < 1e-15)
  colorRange = [min(colorRange(1),0),max(colorRange(2),1)];
end


function most_ex1_ed(quiet)
%MOST_EX1_ED  Examples of deterministic economic dispatch.

%   MOST
%   Copyright (c) 2015-2016, Power Systems Engineering Research Center (PSERC)
%   by Ray Zimmerman, PSERC Cornell
%
%   This file is part of MOST.
%   Covered by the 3-clause BSD License (see LICENSE file for details).
%   See https://github.com/MATPOWER/most for more info.

%% set up options
define_constants;
verbose = 0;
casefile = 'ex_case3a';
mpopt = mpoption('verbose', verbose);
mpopt = mpoption(mpopt, 'out.gen', 1);
mpopt = mpoption(mpopt, 'model', 'DC');
mpopt = mpoption(mpopt, 'opf.dc.solver', 'MIPS');
mpopt = mpoption(mpopt, 'most.solver', mpopt.opf.dc.solver);
if ~verbose
    mpopt = mpoption(mpopt, 'out.all', 0);
end

%%-----  economic dispatch (no network)  -----
%% runopf
mpc = loadcase(casefile);
mpc.branch(:, RATE_A) = 0;  % disable line flow limits (mimic no network case)
r1 = rundcopf(mpc, mpopt);
Pg1 = r1.gen(:, PG);        % active generation
lam1 = r1.bus(:, LAM_P);    % nodal energy price

%% most
mpc = loadcase(casefile);
mpopt = mpoption(mpopt, 'most.dc_model', 0);    % use model with no network
mdi = loadmd(mpc);
mdo = most(mdi, mpopt);
ms = most_summary(mdo);
r2 = mdo.flow.mpc;
Pg2 = r2.gen(:, PG);        % active generation
lam2 = r2.bus(:, LAM_P);    % nodal energy price

%% comparison
Pg = [Pg1 Pg2]
lam = [lam1 lam2]

%%-----  economic dispatch (w/reserves)  -----
%% runopf_w_res
mpc = loadcase(casefile);
mpc.branch(:, RATE_A) = 0;  % disable line flow limits (mimic no network case)
r1 = runopf_w_res(mpc, mpopt);
Pg1 = r1.gen(:, PG);        % active generation
lam1 = r1.bus(:, LAM_P);    % nodal energy price
R1 = r1.reserves.R;         % reserve quantity
prc1 = r1.reserves.prc;     % reserve price

%% most
mpc = loadcase(casefile);
mpopt = mpoption(mpopt, 'most.dc_model', 0);    % use model with no network
mdi = loadmd(mpc);
mdi.FixedReserves = mpc.reserves;   % include fixed zonal reserves
mdo = most(mdi, mpopt);
ms = most_summary(mdo);
r2 = mdo.flow.mpc;
Pg2 = r2.gen(:, PG);        % active generation
lam2 = r2.bus(:, LAM_P);    % nodal energy price
R2 = r2.reserves.R;         % reserve quantity
prc2 = r2.reserves.prc;     % reserve price

%% comparison
Pg = [Pg1 Pg2]
lam = [lam1 lam2]
R = [R1 R2]
prc = [prc1 prc2]


function outdata = jatmos70(indata)

% Jacchia 1970 atmosphere main driver

% input

%  indata(1)  = geodetic altitude (kilometers)
%  indata(2)  = geodetic latitude (radians)
%  indata(3)  = geographic longitude (radians)
%  indata(4)  = calendar year (all digits)
%  indata(5)  = calendar month
%  indata(6)  = calendar day
%  indata(7)  = utc hours
%  indata(8)  = utc minutes
%  indata(9)  = geomagnetic index type
%               (1 = indata(12) is Kp, 2 = indata(12) is Ap)
%  indata(10) = solar radio noise flux (jansky)
%  indata(11) = 162-day average F10 (jansky)
%  indata(12) = geomagnetic activity index

% output

%  outdata(1)  = exospheric temperature (deg K)
%  outdata(2)  = temperature at altitude (deg K)
%  outdata(3)  = N2 number density (per meter-cubed)
%  outdata(4)  = O2 number density (per meter-cubed)
%  outdata(5)  = O number density (per meter-cubed)
%  outdata(6)  = A number density (per meter-cubed)
%  outdata(7)  = He number density (per meter-cubed)
%  outdata(8)  = H number density (per meter-cubed)
%  outdata(9)  = average molecular weight
%  outdata(10) = total density (kilogram/meter-cubed)
%  outdata(11) = log10(total density)
%  outdata(12) = total pressure (pascals)

% Orbital Mechanics with MATLAB

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

bfh = 440;

rgas = 8314.32;

% unload input data

z = indata(1);
xlat = indata(2);
xlng = indata(3);
iyr = indata(4);
mn = indata(5);
ida = indata(6);
ihr = indata(7);
min = indata(8);
i1 = indata(9);
f10 = indata(10);
f10b = indata(11);
gi = indata(12);

% compute solar coordinates

[sda, sha, dd, dy] = jtme(mn, ida, iyr, ihr, min, xlng);

% calculate exospheric temperature

te = jtinf(f10, f10b, gi, xlat, sda, sha, dy, i1);

% evaluate jacchia model

[dens, dl, em, tz, a(1), a(2), a(3), a(4), a(5), a(6)] = jacchia(z, te);

denlg = 0;
dummy = dl;
den = dl;

if (z <= 170)
   dummy = jslv(z, xlat, dd);
   denlg = dummy;
end

if (z >= 500)
    den = jslvh(den, a(5), xlat, sda);
    dl = den;
elseif (z > bfh)
    dhel1 = a(5);
    dhel2 = a(5);
    dlg1 = dl;
    dlg2 = dl;
    dlg2 = jslvh(dlg2, dhel2, xlat, sda);
    ih = z;
    [fdhel, fdlg] = jfair(dhel1, dhel2, dlg1, dlg2, ih);
    dl = fdlg;
    a(5) = fdhel;
end

dl = dl + denlg;

dens = 10 ^ dl;

% load output data array

outdata(1) = te;

outdata(2) = tz;

for i = 1:1:6
    outdata(i + 2) = 1000000 * (10 ^ a(i));
end

outdata(9) = em;
outdata(10) = dens * 1000;
outdata(11) = dl;

p = outdata(10) * rgas * tz / em;

outdata(12) = p;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function [dens, dl, em, tz, an, ao2, ao, aa, ahe, ah] = jacchia (z, t)

% jacchia 1970 atmosphere

global alpha ei

av = 6.02257e+23;
qn = 0.7811;
qo2 = 0.20955;
qa = 9.343e-03;
qhe = 0.00001289;
rgas = 8.31432;
t0 = 183;

tx = 444.3807 + 0.02385 * t - 392.8292 * exp(-0.0021357 * t);
a2 = 2 * (t - tx) / pi;
txt0 = tx - t0;
t1 = 1.9 * txt0 / 35;
t3 = -1.7 * txt0 / (35 ^ 3);
t4 = -.8 * txt0 / (35 ^ 4);
tz = jtemp(z, tx, t1, t3, t4, a2);

a = 90;
d = min(z, 105);

r = jgauss(a, d, 1, tx, t1, t3, t4, a2);

em = jmweight(d);

td = jtemp(d, tx, t1, t3, t4, a2);

dens = 0.000000021926 * em * exp(-r / rgas) / td;

factor = av * dens;
par = factor / em;
factor = factor / 28.96;

if (z <= 105)
   dl = log10(dens);
   an = log10(qn * factor);
   aa = log10(qa * factor);
   ahe = log10(qhe * factor);
   ao = log10(2 * par * (1 - em / 28.96));
   ao2 = log10(par * (em * (1 + qo2) / 28.96 - 1));
   ah = 0;
   return;
end

di(1) = qn * factor;
di(2) = par * (em * (1 + qo2) / 28.96 - 1);
di(3) = 2 * par * (1 - em / 28.96);
di(4) = qa * factor;
di(5) = qhe * factor;

r = jgauss(d, z, 2, tx, t1, t3, t4, a2);

for i = 1:1:5
    dit(i) = di(i) * (td / tz) ^ (1 + alpha(i)) * exp(-ei(i) * r / rgas);

    if (dit(i) <= 0)
       dit(i) = 0.000001;
    end
end

if (z > 500)
   a1 = 500;
   s = jtemp(a1, tx, t1, t3, t4, a2);
   di(6) = 10 ^ (73.13 - 39.4 * log10(s) + 5.5 * log10(s) * log10(s));
   r = jgauss(a1, z, 7, tx, t1, t3, t4, a2);
   dit(6) = di(6) * (s / tz) * exp(-ei(6) * r / rgas);
else
   dit(6) = 1;
end

dens = 0;

for i = 1:1:6
    dens = dens + ei(i) * dit(i) / av;
end

em = dens * av / (dit(1) + dit(2) + dit(3) + dit(4) + dit(5) + dit(6));

dl = log10(dens);

an = log10(dit(1));
ao2 = log10(dit(2));
ao = log10(dit(3));
aa = log10(dit(4));
ahe = log10(dit(5));
ah = log10(dit(6));

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function [sda, sha, dd, dy] = jtme (mn, ida, iyr, ihr, min, xlng)

% solar declination and hour angle

dtr = pi / 180;

atr = dtr / 3600;

% compute julian date on january 1

jdate = julian(1, 1, iyr);

% compute julian date on day of interest

xmjd = julian(mn, ida, iyr);

% compute day number of the year

dd = xmjd - jdate;

% compute fraction of tropical year

dy = dd / 365.2422;

% compute greenwich mean time

gmt = 60 * ihr + min;

% compute solar coordinates

a = xmjd + gmt / 1440 - 2451545;

b = a / 36525 + 1;

o = r2r(0.056531 + 0.00023080893 * a);
m = r2r(0.140023 + 0.00445036173 * a);
l = r2r(0.779072 + 0.00273790931 * a);
h = r2r(0.606434 + 0.0366011013 * a);
n = r2r(0.053856 + 0.00145561327 * a);
f = r2r(0.993126 + 0.0027377785 * a);
r = r2r(0.347343 - 0.00014709391 * a);

obliq = atr * (84428 - 47 * b + 9 * cos(r));

p = 6910 * sin(f) + 72 * sin(2 * f) - 17 * b * sin(f) - 7 * cos(f - o) ...
    + 6 * sin(h - l) + 5 * sin(4 * f - 8 * n + 3 * o) ...
    - 5 * cos(2 * (f - m)) - 4 * sin(f - m) + 4 * cos(4 * f - 8 * n ...
    + 3 * o) + 3 * sin(2 * (f - m)) - 3 * sin(o) - 3 * sin(2 * (f - o));

p = l + atr * (p - 17 * sin(r));

a = sin(p) * cos(obliq);

b = cos(p);

% compute solar right ascension and declination

ras = atan3(a, b);

sda = asin(sin(obliq) * sin(p));

% compute greenwich sidereal time

gst = gast1(xmjd + ihr / 24 + min / 1440);

% compute right ascension of point of interest

rap = mod(gst + xlng, 2.0 * pi);

% compute hour angle

sha = mod(rap - ras, 2.0 * pi);

if (sha > pi)
   sha = sha - 2.0 * pi;
end

if (sha < -pi)
   sha = sha + 2.0 * pi;
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function te = jtinf (f10, f10b, gi, xlat, sda, sha, dy, i1)

% exospheric temperature

c1 = 383;
c2 = 3.32;
c3 = 1.8;

d1 = 28;
d2 = 0.03;
d3 = 1;
d4 = 100;
d5 = -0.08;

e1 = 2.41;
e2 = 0.349;
e3 = 0.206;
e4 = 6.2831853;
e5 = 3.9531708;
e6 = 12.5663706;
e7 = 4.3214352;
e8 = 0.1145;
e9 = 0.5;
e10 = 6.2831853;
e11 = 5.974262;
e12 = 2.16;

beta = -0.6457718;
gamma = 0.7504916;
p = 0.1047198;
re = 0.31;

tc = c1 + c2 * f10b + c3 * (f10 - f10b);

eta = 0.5 * abs(xlat - sda);
theta = 0.5 * abs(xlat + sda);
tau = sha + beta + p * sin(sha + gamma);

if (tau > pi)
   tau = tau - 2 * pi;
end

if (tau < -pi)
   tau = tau + 2 * pi;
end

a1 = (sin(theta)) ^ 2.5;
a2 = (cos(eta)) ^ 2.5;
a3 = (cos(tau / 2)) ^ 3;
b1 = 1 + re * a1;
b2 = (a2 - a1) / b1;
tv = b1 * (1 + re * b2 * a3);
tl = tc * tv;

if (i1 == 1)
   tg = d1 * gi + d2 * exp(gi);
else
   tg = d3 * gi + d4 * (1 - exp(d5 * gi));
end

g3 = 0.5 * (1 + sin(e10 * dy + e11));

g3 = g3 ^ e12;

tau1 = dy + e8 * (g3 - e9);

g1 = e2 + e3 * (sin(e4 * tau1 + e5));

g2 = sin(e6 * tau1 + e7);

ts = e1 + f10b * g1 * g2;

te = tl + tg + ts;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function den = jslv (alt, xlat, day)

den = 0;

if (alt > 170)
   return;
end

z = alt - 90;
x = -0.0013 * z * z;
y = 0.0172 * day + 1.72;
p = sin(y);
sp = (sin(xlat)) ^ 2;
s = 0.014 * z * exp(x);
d = s * p * sp;

if (xlat < 0)
   d = -d;
end

den = d;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function den = jslvh (den, denhe, xlat, sda)

ezero = 10 ^ denhe;

a = abs(0.65 * (sda / 0.40909079));

b = 0.5 * xlat;

if (sda < 0)
   b = -b;
end

x = 0.7854 - b;

y = sin(x) ^ 3;

dhe = a * (y - 0.35356);

denhe = denhe + dhe;

d1 = 10 ^ denhe;

del = d1 - ezero;

rho = 10 ^ den;

drho = 6.646e-24 * del;

rho = rho + drho;

den = log10(rho);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function [fdhel, fdlg] = jfair (dhel1, dhel2, dlg1, dlg2, ih)

% fair density

global cz

bfh = 440;

i = fix((ih - bfh) / 10) + 1;

czi = cz(i);
szi = 1 - czi;

fdlg = (dlg1 * czi) + (dlg2 * szi);

fdhel = (dhel1 * czi) + (dhel2 * szi);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function r = jgauss (z1, z2, nmin, tx, t1, t3, t4, a2)

% gaussian quadrature

global ng xgauss cgauss altmin

r = 0;

for k = nmin:1:8
    ngauss = ng(k);
    a = altmin(k);
    d = min(z2, altmin(k + 1));
    rr = 0;
    del = 0.5 * (d - a);
    j = ngauss - 2;

    for i = 1:1:ngauss
        z = del * (xgauss(i, j) + 1) + a;

        rr = rr + cgauss(i, j) * jmweight(z) * jgrav(z) ...
             / jtemp(z, tx, t1, t3, t4, a2);
    end

    rr = del * rr;
    r = r + rr;

    if (d == z2)
       break;
    end
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function agrav = jgrav(altitude)

% acceleration of gravity

agrav = 9.80665 / ((1 + altitude / 6356.766) ^ 2);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function mweight = jmweight (a)

% molecular weight function

global bdata

if (a > 105)
   mweight = 1;
else
   u = a - 100;

   wttmp = bdata(1);

   for i = 2:1:7
       wttmp = wttmp + bdata(i) * u ^ (i - 1);
   end

   mweight = wttmp;
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function temp = jtemp (alt, tx, t1, t3, t4, a2)

% temperature function

bb = 0.0000045;

u = alt - 125.0;

if (u > 0)
   temp = tx + a2 * atan(t1 * u * (1 + bb * (u ^ 2.5)) / a2);
else
   temp = tx + t1 * u + t3 * (u ^ 3) + t4 * (u ^ 4);
end


function [ qy, qty, b, rsd, ab, info ] = dqrsl ( a, lda, n, k, qraux, y, job )

%*****************************************************************************80
%
%% DQRSL computes transformations, projections, and least squares solutions.
%
%  Discussion:
%
%    DQRSL requires the output of DQRDC.
%
%    For K <= min(N,P), let AK be the matrix
%
%      AK = ( A(JPVT(1)), A(JPVT(2)), ..., A(JPVT(K)) )
%
%    formed from columns JPVT(1), ..., JPVT(K) of the original
%    N by P matrix A that was input to DQRDC.  If no pivoting was
%    done, AK consists of the first K columns of A in their
%    original order.  DQRDC produces a factored orthogonal matrix Q
%    and an upper triangular matrix R such that
%
%      AK = Q * (R)
%               (0)
%
%    This information is contained in coded form in the arrays
%    A and QRAUX.
%
%    The parameters QY, QTY, B, RSD, and AB are not referenced
%    if their computation is not requested and in this case
%    can be replaced by dummy variables in the calling program.
%    To save storage, the user may in some cases use the same
%    array for different parameters in the calling sequence.  A
%    frequently occuring example is when one wishes to compute
%    any of B, RSD, or AB and does not need Y or QTY.  In this
%    case one may identify Y, QTY, and one of B, RSD, or AB, while
%    providing separate arrays for anything else that is to be
%    computed.
%
%    Thus the calling sequence
%
%      call dqrsl ( a, lda, n, k, qraux, y, dum, y, b, y, dum, 110, info )
%
%    will result in the computation of B and RSD, with RSD
%    overwriting Y.  More generally, each item in the following
%    list contains groups of permissible identifications for
%    a single calling sequence.
%
%      1. (Y,QTY,B) (RSD) (AB) (QY)
%
%      2. (Y,QTY,RSD) (B) (AB) (QY)
%
%      3. (Y,QTY,AB) (B) (RSD) (QY)
%
%      4. (Y,QY) (QTY,B) (RSD) (AB)
%
%      5. (Y,QY) (QTY,RSD) (B) (AB)
%
%      6. (Y,QY) (QTY,AB) (B) (RSD)
%
%    In any group the value returned in the array allocated to
%    the group corresponds to the last member of the group.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 June 2005
%
%  Author:
%
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Dongarra, Moler, Bunch and Stewart,
%    LINPACK User's Guide,
%    SIAM, (Society for Industrial and Applied Mathematics),
%    3600 University City Science Center,
%    Philadelphia, PA, 19104-2688.
%    ISBN 0-89871-172-X
%
%  Parameters:
%
%    Input, real A(LDA,P), contains the output of DQRDC.
%
%    Input, integer LDA, the leading dimension of the array A.
%
%    Input, integer N, the number of rows of the matrix AK.  It must
%    have the same value as N in DQRDC.
%
%    Input, integer K, the number of columns of the matrix AK.  K
%    must not be greater than min(N,P), where P is the same as in the
%    calling sequence to DQRDC.
%
%    Input, real QRAUX(P), the auxiliary output from DQRDC.
%
%    Input, real Y(N), a vector to be manipulated by DQRSL.
%
%    Input, integer JOB, specifies what is to be computed.  JOB has
%    the decimal expansion ABCDE, with the following meaning:
%      if A /= 0, compute QY.
%      if B /= 0, compute QTY.
%      if C /= 0, compute QTY and B.
%      if D /= 0, compute QTY and RSD.
%      if E /= 0, compute QTY and AB.
%    Note that a request to compute B, RSD, or AB automatically triggers
%    the computation of QTY, for which an array must be provided in the
%    calling sequence.
%
%    Output, real QY(N), contains Q * Y, if requested.
%
%    Output, real QTY(N), contains Q' * Y, if requested.
%
%    Output, real B(K), the solution of the least squares problem
%      minimize norm2 ( Y - AK * B),
%    if its computation has been requested.  Note that if pivoting was
%    requested in DQRDC, the J-th component of B will be associated with
%    column JPVT(J) of the original matrix A that was input into DQRDC.
%
%    Output, real RSD(N), the least squares residual Y - AK * B,
%    if its computation has been requested.  RSD is also the orthogonal
%    projection of Y onto the orthogonal complement of the column space
%    of AK.
%
%    Output, real AB(N), the least squares approximation Ak * B,
%    if its computation has been requested.  AB is also the orthogonal
%    projection of Y onto the column space of A.
%
%    Output, integer INFO, is zero unless the computation of B has
%    been requested and R is exactly singular.  In this case, INFO is the
%    index of the first zero diagonal element of R, and B is left unaltered.
%

%
%  Set info flag.
%
  info = 0;
%
%  Determine what is to be computed.
%
  cqy =  floor       ( job / 10000         ) ~= 0;
  cqty =         mod ( job,  10000 )         ~= 0;
  cb =   floor ( mod ( job,   1000 ) / 100 ) ~= 0;
  cr =   floor ( mod ( job,    100 ) /  10 ) ~= 0;
  cab =          mod ( job,     10 )       ~= 0;

  ju = min ( k, n - 1 );
%
%  Special action when N = 1.
%
  if ( ju == 0 )

    qy(1) = y(1);
    qty(1) = y(1);
    ab(1) = y(1);

    if ( a(1,1) == 0.0 )
      info = 1;
    else
      b(1) = y(1) / a(1,1);
    end

    rsd(1) = 0.0;

    return

  end
%
%  Set up to compute QY or QTY.
%
  qy(1:n) = y(1:n);
  qty(1:n) = y(1:n);
%
%  Compute QY.
%
  if ( cqy )

    for jj = 1 : ju

      j = ju - jj + 1;

      if ( qraux(j) ~= 0.0 )
        temp = a(j,j);
        a(j,j) = qraux(j);
        t = -ddot ( n-j+1, a(j:n,j), 1, qy(j:n), 1 ) / a(j,j);
        qy(j:n) = daxpy ( n-j+1, t, a(j:n,j)', 1, qy(j:n), 1 );
        a(j,j) = temp;
      end

    end

  end
%
%  Compute Q'*Y.
%
  if ( cqty )

    for j = 1 : ju
      if ( qraux(j) ~= 0.0 )
        temp = a(j,j);
        a(j,j) = qraux(j);
        t = -ddot ( n-j+1, a(j:n,j), 1, qty(j:n), 1 ) / a(j,j);
        qty(j:n) = daxpy ( n-j+1, t, a(j:n,j), 1, qty(j:n), 1 );
        a(j,j) = temp;
      end
    end

  end
%
%  Set up to compute B, RSD, or AB.
%
  b(1:k) = qty(1:k);
  ab(1:k) = qty(1:k);
  rsd(k+1:n) = qty(k+1:n);
  ab(k+1:n) = 0.0;
  rsd(1:k) = 0.0;
%
%  Compute B.
%
  if ( cb )

    for jj = 1 : k

      j = k - jj + 1;

      if ( a(j,j) == 0.0 )
        info = j;
        break
      end

      b(j) = b(j) / a(j,j);

      if ( j ~= 1 )
        t = -b(j);
        b(1:j-1) = daxpy ( j-1, t, a(1:j-1,j), 1, b(1:j-1), 1 );
      end

    end

  end
%
%  Compute RSD or AB as required.
%
  if ( cr | cab )

    for jj = 1 : ju

      j = ju - jj + 1;

      if ( qraux(j) ~= 0.0 )

        temp = a(j,j);
        a(j,j) = qraux(j);

        if ( cr )
          rsd(j:n) = -ddot ( n-j+1, a(j:n,j), 1, rsd(j:n), 1 ) / a(j,j);
          rsd(j:n) = daxpy ( n-j+1, t, a(j:n,j), 1, rsd(j:n), 1 );
        end

        if ( cab )
          t = -ddot ( n-j+1, a(j:n,j), 1, ab(j:n), 1 ) / a(j,j);
          ab(j:n) = daxpy ( n-j+1, t, a(j:n,j), 1, ab(j:n), 1 );
        end

        a(j,j) = temp;

      end
    end
  end

  return
end


function [O]=titgen(S)
%these function give a string for example from poly2strs.m and if power of
%if each element >=10 then place it between { }
%for example if input: s^11+s^10+s^9+1  then output is s^{11}+s^{10}+s^9+1
%these is used for title.m for power >=10

if isempty(S)
    display('Error: Input String is empty');
    return;
end

len=length(S);
pointer=0;
k=1;
for i=1:len
    if S(i)=='^'
        pointer(1,k)=i;
        k=k+1;
    end
    if (S(i)=='+' || S(i)=='-') && i~=1
        pointer(1,k)=i;
        k=k+1;
    end
end
lp=length(pointer);
str{1}=S(1:pointer(1));
for j=1:lp
    if j~=lp
        str{j+1}=S(pointer(j)+1:pointer(j+1));
    end
end
str{j+1}=S(pointer(lp)+1:len);

for m=2:2:length(str)
    temp=str{m};
    if temp(length(temp))=='+'
        temp(length(temp))='';
        str{m}=temp;
        str{m+1}=strcat('+',str{m+1});
    elseif temp(length(temp))=='-'
        temp(length(temp))='';
        str{m}=temp;
        str{m+1}=strcat('-',str{m+1});
    end

    num_pow=str2double(str{m});
    if num_pow>=10
        str{m}=sprintf('{%g}',num_pow);
    end
end

O=strcat(str{:});


function I = haze_linear(R, t, L)
%HAZE_LINEAR  Generate hazy image from clean image using the linear haze model
%corresponding to Lambert-Beer law
%   Inputs:
%       -|R|: H-by-W-by-|image_channels| clean image representing true radiance
%       of scene.
%       -|t|: H-by-W transmission map.
%       -|L|: 1-by-1-by-|image_channels| homogeneous atmospheric light.
%
%   Outputs:
%       -|I|: synthetic hazy image, with same size as input clean image |R|.

image_channels = size(L, 3);

% Auxiliary matrix with replicates of transmission map for all channels,
% allowing to express hazy image conveniently.
t_replicated = repmat(t, 1, 1, image_channels);

% Apply linear haze model.
I = t_replicated .* R + (1 - t_replicated) .* repmat(L, size(t));

end


function days = month_length_bahai ( y, m )

%*****************************************************************************80
%
%% MONTH_LENGTH_BAHAI returns the number of days in a Bahai month.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 July 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer Y, the year in which the month occurred.
%
%    Input, integer M, the number of the month.
%
%    Output, integer DAYS, the number of
%    days in the month.
%

%
%  Copy the input.
%
  m2 = m;
  y2 = y;
%
%  Check the input.
%
  [ y2, m2, ierror ] = ym_check_bahai ( y2, m2 );

  if ( ierror ~= 0 )
    days = 0;
    return
  end

  if ( m2 <= 18 || m2 == 20 )
    days = 19;
  elseif ( year_is_leap_bahai ( y2 ) )
    days = 5;
  else
    days = 4;
  end

  return
end


%  Copyright (c) 2014, Karen Simonyan
%  All rights reserved.
%  This code is made available under the terms of the BSD license (see COPYING file).

% Modified by Aruni Roy Chowdhury

function [ res, extra ] = evalBestThresh( scores, gt )
%EVALBESTTHRESH
% finds an optimal threshold - the threshold which maximises the accuracy

    % threshold scores and get the sign

    res = -Inf;
    extra.bestThresh = [];

    % thresh loop
    for i=1:numel(scores)

        curThresh = scores(i);
        class = 2 * (scores >= curThresh) - 1;

        % class-n accuracy
        acc = mean(class == gt);

        if acc > res

            res = acc;
            extra.bestThresh = curThresh;
        end
    end

    res = res * 100;

end


function [g, gdata, gprior] = mlpgrad(net, x, t)
%MLPGRAD Evaluate gradient of error function for 2-layer network.
%
%	Description
%	G = MLPGRAD(NET, X, T) takes a network data structure NET  together
%	with a matrix X of input vectors and a matrix T of target vectors,
%	and evaluates the gradient G of the error function with respect to
%	the network weights. The error funcion corresponds to the choice of
%	output unit activation function. Each row of X corresponds to one
%	input vector and each row of T corresponds to one target vector.
%
%	[G, GDATA, GPRIOR] = MLPGRAD(NET, X, T) also returns separately  the
%	data and prior contributions to the gradient. In the case of multiple
%	groups in the prior, GPRIOR is a matrix with a row for each group and
%	a column for each weight parameter.
%
%	See also
%	MLP, MLPPAK, MLPUNPAK, MLPFWD, MLPERR, MLPBKP
%

%	Copyright (c) Ian T Nabney (1996-2001)

% Check arguments for consistency
errstring = consist(net, 'mlp', x, t);
if ~isempty(errstring);
  error(errstring);
end
[y, z] = mlpfwd(net, x);
delout = y - t;

gdata = mlpbkp(net, x, z, delout);

[g, gdata, gprior] = gbayes(net, gdata);


%TEST_TIMING_DGT_FAC  Test timing factorization DGTs
%
%   This script test the timing SPREADADJs by comparing the results to
%   spreadadj in the main toolbox. Therefore, the correctness of
%   spreadadj must be verified first.

routinemax=2;

spfraction=.1;

test_failed=0;

disp('--- Used subroutines ---');

for rtype=1:2

  if rtype==1
    rname='REAL ';
  else
    rname='CMPLX';
  end;

  for sptype=1:2

    if sptype==1
      spname='FULL  ';
    else
      spname='SPARSE';
    end;

    for L=12:13

      if rtype==1
        if sptype==1
          coef1=rand(L,L);
          coef2=rand(L,L);
        else
          coef1=sprand(L,L,spfraction);
          coef2=sprand(L,L,spfraction);
        end;
      else
        if sptype==1
          coef1=crand(L,L);
          coef2=crand(L,L);
        else
          coef1=spcrand(L,L,spfraction);
          coef2=spcrand(L,L,spfraction);
        end;
      end;

      ctwist=tconv(coef1,coef2);

      for rout=1:routinemax

        ctwist2=feval(['ref_tconv_',num2str(rout)],coef1,coef2);

        rdiff=ctwist-ctwist2;

        res=norm(rdiff(:));

        fail='';
        if res>10e-10
          fail='FAILED';
          test_failed=test_failed+1;
        end;

        s=sprintf('TWI %s %s %i L:%3i %0.5g %s',rname,spname,rout,L,res,fail);
        disp(s)
      end;

    end;

  end;

end;

test_failed