function[x,y]=ellcurves(varargin)
%ELLCURVES  Returns curves corresponding to specified ellipse properties.
%
%   For direct plotting of ellipses, see ELLPLOT, which calls ELLCURVES.
%
%   ZC=ELLCURVES(KAPPA,LAMBDA,THETA,ZRES) returns complex-valued curves ZC
%   tracing out the periphery of ellipses with amplitude KAPPA, linearity
%   LAMBDA, and orientation THETA, located at complex positions ZRES.
%
%   All input arguments are arrays of the same length, say N.  By default,
%   ZC is calculated at 32 locations around the periphery.  Thus ZC will be
%   a complex-valued matrix with 32 rows and N columns.
%
%   [XC,YC]=ELLCURVES(...) alternately returns the real and imaginary parts
%   of ZC, corresponding to the X- and Y- components of the ellipses.
%
%   ELLCURVES(KAPPA,LAMBDA,THETA,PHI,ZRES) with five input arguments begins
%   each ellipse at phase PHI.  For most applications, the starting phase
%   does not matter.  The default value is to begin with a phase of zero.
%
%   ELLCURVES(... ,'npoints',M) uses M points around the ellipse periphery.
%
%   ELLCURVES(... ,'aspect',AR) with AR=[XAR YAR] multiplies the X-signal
%   and Y-signal by XAR and YAR, respectively, for plotting purposes.
%
%   ELLCURVES is called by ELLPLOT, and is also useful in applications,
%   e.g. analysis of model fields within elliptical contours.
%
%   The curves can be plotted with PLOT(ZC).
%
%   See also ELLIPSEPLOT, ELLSIG, INELLIPSE.
%
%   Usage: zc=ellcurves(kappa,lambda,theta,zres);
%          zc=ellcurves(kappa,lambda,theta,phi,zres);
%          zc=ellcurves(kappa,lambda,theta,phi,zres,'npoints',64);
%          [xc,yc]=ellcurves(kappa,lambda,theta,phi,zres,'npoints',64);
%          zc=ellcurves(kappa,lambda,theta,phi,zres,'aspect',ar,'npoints',64);
%   __________________________________________________________________
%   This is part of JLAB --- type 'help jlab' for more information
%   (C) 2014--2018 J.M. Lilly --- type 'help jlab_license' for details

na=length(varargin);

k=varargin{1};
l=varargin{2};
theta=varargin{3};

ar=[1 1];
npoints=32;

if na>4
    for i=1:3
        if ischar(varargin{end-1})
            if strcmpi(varargin{end-1}(1:3),'npo')
                npoints=varargin{end};
            elseif strcmpi(varargin{end-1}(1:3),'asp')
                ar=varargin{end};
            end
            na=na-2;
            varargin=varargin(1:end-2);
        end
    end
end

if length(varargin)==5
    phi=varargin{4};
    x=varargin{5};
else
    x=varargin{4};
    if iscell(k)
        for i=1:length(k)
             phi{i}=zeros(size(k{i}));
        end
    else
        phi=zeros(size(k));
    end
end

if ~iscell(k)
    z=ellcurves_one(k,l,theta,phi,x,ar,npoints);
else
    for i=1:length(k)
        z{i,1}=ellcurves_one(k{i},l{i},theta{i},phi{i},x{i},ar,npoints);
    end
end

if nargout==2
    if iscell(z)
        x=cellreal(z);
        y=cellimag(z);
    else
        x=real(z);
        y=imag(z);
    end
else
    x=z;
end

function[z]=ellcurves_one(kappa,lambda,theta,phi,x,ar,npoints)
phio=linspace(0,2*pi,npoints);
%x=conj(x');

z=zeros(length(phio),length(kappa));
for i=1:length(phio)  %Loop over phio, very fast
    [xc,yc]=ellsig(kappa,lambda,theta,phi+phio(i),'real');
    %vsize(xc,yc,x)
    z(i,:)=ar(1)*xc+sqrt(-1)*ar(2)*yc+x;
end
%vsize(xc,yc,x)

%if ~isempty(strfind(str,'not'))
%    z=permute(z,[2 1]);  %This is like 6 times faster than conjugate transpose
%end


function boundary = p03_boundary_nearest ( m, n, point )

%*****************************************************************************80
%
%% P03_BOUNDARY_NEAREST returns a nearest boundary point in problem 03.
%
%  Discussion:
%
%    The given input point need not be inside the region.
%
%    In some cases, more than one boundary point may be "nearest",
%    but only one will be returned.
%
%    31 August 2005: Thanks to Hua Fei for pointing out that a previous
%    version of this routine gave inaccurate results for points that were
%    significantly far from the box.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 April 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Per-Olof Persson and Gilbert Strang,
%    A Simple Mesh Generator in MATLAB,
%    SIAM Review,
%    Volume 46, Number 2, June 2004, pages 329-345.
%
%  Parameters:
%
%    Input, integer M, the spatial dimension.
%
%    Input, integer N, the number of points.
%
%    Input, real POINT(M,N), the points.
%
%    Output, real BOUNDARY(M,N), points on the boundary
%    that are nearest to each point.
%
  center = [ 0.0, 0.0 ];
  r1 = 1.0;
  r2 = 0.4;
  x1 = -1.0;
  x2 = +1.0;
  y1 = -1.0;
  y2 = +1.0;

  for j = 1 : n

    x = point(1,j);
    y = point(2,j);
%
%  Special case: a point at the center of the box.
%  The closest point is ANY point on the circle.
%
    if ( point(1,j) == center(1) & point(2,j) == center(2) )
      boundary(1,j) = center(1) + r2;
      boundary(2,j) = center(2);
      continue
    end
%
%  Is the point to the left of the box?
%
    if ( x <= x1 )

      boundary(1,j) = x1;

      if ( y <= y1 )
        boundary(2,j) = y1;
      elseif ( y <= y2 )
        boundary(2,j) = y;
      elseif ( y2 <= y )
        boundary(2,j) = y2;
      end
%
%  To the right of the box?
%
    elseif ( x2 <= x )

      boundary(1,j) = x2;

      if ( y <= y1 )
        boundary(2,j) = y1;
      elseif ( y <= y2 )
        boundary(2,j) = y;
      elseif ( y2 <= y )
        boundary(2,j) = y2;
      end
%
%  Below the middle of the box?
%
    elseif ( y <= y1 )

      boundary(1,j) = x;
      boundary(2,j) = y1;
%
%  Above the middle of the box?
%
    elseif ( y2 <= y )

      boundary(1,j) = x;
      boundary(2,j) = y2;
%
%  Inside the box.
%  Figure out which side is closest by drawing the diagonal lines.
%
    else
%
%  Y is small.
%
      if (     y <= x &  y <= -x )
        boundary(1,j) = x;
        boundary(2,j) = y1;
%
%  X is big.
%
      elseif ( y <= x & -y <=  x )
        boundary(1,j) = x2;
        boundary(2,j) = y;
%
%  Y is big.
%
      elseif ( x <= y & -x <=  y )
        boundary(1,j) = x;
        boundary(2,j) = y2;
%
%  X is small.
%
      elseif ( x <= y &  x <= -y )
        boundary(1,j) = x1;
        boundary(2,j) = y;
      end
%
%  For points inside the box, the boundary of the circle might be closer than
%  the boundary of the box.
%
      r = sqrt ( sum ( ( point(1:m,j) - center(1:m)' ).^2 ) );

      dist_circle = abs ( r - r2 );
      dist_box = sqrt ( sum ( ( point(1:m,j) - boundary(1:m,j) ).^2 ) );

      if ( dist_circle <  dist_box )
        boundary(1:m,j) = center(1:m)' + r2 / r * ( point(1:m,j) - center(1:m)' );
      end

    end

  end

  return
end


%============================================================================
% Copyright (C) 2014, Heikki Hyyti
%
% Permission is hereby granted, free of charge, to any person obtaining a
% copy of this software and associated documentation files (the "Software"),
% to deal in the Software without restriction, including without limitation
% the rights to use, copy, modify, merge, publish, distribute, sublicense,
% and/or sell copies of the Software, and to permit persons to whom the
% Software is furnished to do so, subject to the following conditions:
%
% The above copyright notice and this permission notice shall be included in
% all copies or substantial portions of the Software.
%
% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
% IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
% FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
% THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
% LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
% FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
% DEALINGS IN THE SOFTWARE.
%============================================================================

function [a,b] = fitRegressionLine(x, y)
    A11 = x' * x;
    A12 = sum(x);
    A21 = A12;
    A22 = size(x,1);

    B11 = y(:,1)' * x;
    B21 = sum(y(:,1));

    a = (A12*B21 - A22*B11) / (A12*A21 - A11*A22);
    b = (A11*B21 - A21*B11) / (A11*A22 - A12*A21);
end


%SVMR SVM regression
%
%      W = SVMR(X,NU,KTYPE,KPAR,EP)
%      W = X*SVMR([],NU,KTYPE,KPAR,EP)
%      W = X*SVMR(NU,KTYPE,KPAR,EP)
%
% INPUT
%   X      Regression dataset
%   NU     Fraction of objects outside the 'data tube'
%   KTYPE  Kernel type (default KTYPE='p', for polynomial)
%   KPAR   Extra parameter for the kernel
%   EP     Epsilon, with of the 'data tube'
%
% OUTPUT
%   W      Support vector regression
%
% DESCRIPTION
% Train an nu-Support Vector Regression on dataset X with parameter NU.
% The kernel is defined by kernel type KTYPE and kernel parameter KPAR.
% For the definitions of these kernels, have a look at proxm.m.
%
% SEE ALSO (PRTools Guide)
%  LINEARR, PROXM, GPR, SVC

% Copyright: D.M.J. Tax, D.M.J.Tax@37steps.com
% Faculty EWI, Delft University of Technology
% P.O. Box 5031, 2600 GA Delft, The Netherlands

function y = svmr(varargin)

	argin = shiftargin(varargin,{'scalar','char'},1);
	argin = shiftargin(argin,'char',2);
  argin = setdefaults(argin,[],0.01,'p',1,0.2);

  if mapping_task(argin,'definition')
    y = define_mapping(argin,'untrained');
    y = setname(y,'SVM regression');

  elseif mapping_task(argin,'training')			% Train a mapping.

    [x,nu,ktype,kpar,ep] = deal(argin{:});
    [n,d] = size(x);
    y = gettargets(x);
    % kernel mapping:
    wk = proxm(+x,ktype,kpar);
    K = +(x*wk);
    % setup optimization:
    tol = 1e-6;
    C = 1/(n*nu);
    H = [K -K; -K K];
    f = repmat(ep,2*n,1) - [y; -y];
    A = [];
    b = [];
    Aeq = [ones(1,n) -ones(1,n)];
    beq = 0;
    lb = zeros(2*n,1);
    ub = repmat(C,2*n,1);
    %do the optimization:
    if exist('qld')
      alf = qld(H,f,Aeq,beq,lb,ub,[],1);
    else
      alf = quadprog(H,f,A,b,Aeq,beq,lb,ub);
    end
    % find SV's
    w = alf(1:n)-alf((n+1):end);  % the real weights
    Isv = find(abs(w)>tol);
    Ibnd = find(abs(w(Isv))<C-tol);
    % for the 'real' sv's, we want the classifier output to compute the
    % offset:
    I = Isv(Ibnd);
    out1 = sum(repmat(w',length(Ibnd),1).*K(I,:),2);
    sw = sign(w);
    out = y(I) - out1 - sw(I).*ep;

    % store the useful parameters:
    W.b = mean(out);
    W.wk = proxm(+x(Isv,:),ktype,kpar);
    W.w = w(Isv);

    y = prmapping(mfilename,'trained',W,1,d,1);
    y = setname(y,'Linear regression');
  else
    % evaluation
    [x,v] = deal(argin{1:2});
    W = getdata(v);
    [n,d] = size(x);
    Kz = +(x*W.wk);
    out = sum(repmat(W.w',n,1).*Kz,2) + repmat(W.b,n,1);
    y = setdat(x,out);

  end

return


function a = rutis3 ( )

%*****************************************************************************80
%
%% RUTIS3 returns the RUTIS3 matrix.
%
%  Example:
%
%    4 -5  0  3
%    0  4 -3 -5
%    5 -3  4  0
%    3  0  5  4
%
%  Properties:
%
%    A is not symmetric: A' /= A.
%
%    A is integral, therefore det ( A ) is integral, and
%    det ( A ) * inverse ( A ) is integral.
%
%    A has distinct eigenvalues.
%
%    A has a pair of complex eigenvalues.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    20 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Joan Westlake,
%    A Handbook of Numerical Matrix Inversion and Solution of
%    Linear Equations,
%    John Wiley, 1968,
%    ISBN13: 978-0471936756,
%    LC: QA263.W47.
%
%  Parameters:
%
%    Output, real A(4,4), the matrix.
%

%
%  Note that the matrix entries are listed by row.
%
  a(1:4,1:4) = [ ...
    4.0, -5.0,  0.0,  3.0; ...
    0.0,  4.0, -3.0, -5.0; ...
    5.0, -3.0,  4.0,  0.0; ...
    3.0,  0.0,  5.0,  4.0 ];

  return
end


function jd=mjd2jd(mjd)
% MJD2JD  Converts Modified Julian Date to Julian Date.
%   Non-vectorized version. See also CAL2JD, DOY2JD, GPS2JD,
%   JD2CAL, JD2DOW, JD2DOY, JD2GPS, JD2MJD, JD2YR, YR2JD.
% Version: 2010-03-25
% Usage:   jd=mjd2jd(mjd)
% Input:   mjd - Modified Julian date
% Output:  jd  - Julian date

% Copyright (c) 2011, Michael R. Craymer
% All rights reserved.
% Email: mike@craymer.com

if nargin ~= 1
  warning('Incorrect number of arguments');
  return;
end

jd=mjd+2400000.5;


%{

This code is to render a Mesh given a 3x4 camera matrix with an image resolution widthxheight. The rendering result is an ID map for facets, edges and vertices. This can usually used for occlusion testing in texture mapping a model from an image, such as the texture mapping in the following two papers.

--Jianxiong Xiao http://mit.edu/jxiao/

Citation:

[1] J. Xiao, T. Fang, P. Zhao, M. Lhuillier, and L. Quan
Image-based Street-side City Modeling
ACM Transaction on Graphics (TOG), Volume 28, Number 5
Proceedings of ACM SIGGRAPH Asia 2009

[2] J. Xiao, T. Fang, P. Tan, P. Zhao, E. Ofek, and L. Quan
Image-based Facade Modeling
ACM Transaction on Graphics (TOG), Volume 27, Number 5
Proceedings of ACM SIGGRAPH Asia 2008

%}

clear
clc

syms P00 P01 P02 P03 P10 P11 P12 P13 P20 P21 P22 P23
syms m_far m_near m_width m_height scale

projection = [P00 P01 P02 P03; P10 P11 P12 P13; P20 P21 P22 P23; 0 0 0 1];

% handle the near and far clip plane in OpenGL
protr = [1.0, 0.0, 0.0, 0.0;
    0.0, 1.0, 0.0, 0.0;
    0.0, 0.0, m_far / (m_far - m_near), - m_near * m_far /(m_far - m_near);
    0.0, 0.0, 1.0, 0.0];

% handle half pixel inconsistency
offset = [1.0, 0.0, 0.5, 0.0;
    0.0, 1.0, 0.5, 0.0;
    0.0, 0.0, 1.0, 0.0;
    0.0, 0.0, 0.0, 1.0];

% undo image aspect ratio and size
m0 = [m_width / 2, 0.0,         0.0, 0 + m_width / 2.0;
    0.0,        m_height / 2, 0.0, 0 + m_height / 2.0;
    0.0,        0.0,         0.5, 0.5;
    0.0,        0.0,         0.0, 1.0];

% handle scaling
m1=[1 / scale,   0.0,         0.0,                0.0;
    0.0,        1 / scale,    0.0,                0.0;
    0.0,        0.0,         1.0,                0.0;
    0.0,        0.0,         0.0,                1.0];

% handle upside down in vertical direction in image
m2=[1,           0.0,         0.0,                0.0;
    0.0,        -1.0,        m_height,            0.0;
    0.0,        0.0,         1.0,                0.0;
    0.0,        0.0,         0.0,                1.0];

M = (m0 \ protr * m2 * m1 * offset * projection);

M =

[     P20*(1/(m_width*scale) - 1) + (2*P00)/(m_width*scale),     P21*(1/(m_width*scale) - 1) + (2*P01)/(m_width*scale),     P22*(1/(m_width*scale) - 1) + (2*P02)/(m_width*scale),                       P23*(1/(m_width*scale) - 1) + (2*P03)/(m_width*scale)]
[ - P20*(1/(m_height*scale) - 1) - (2*P10)/(m_height*scale), - P21*(1/(m_height*scale) - 1) - (2*P11)/(m_height*scale), - P22*(1/(m_height*scale) - 1) - (2*P12)/(m_height*scale),                   - P23*(1/(m_height*scale) - 1) - (2*P13)/(m_height*scale)]
[                   (P20*(m_far + m_near))/(m_far - m_near),                   (P21*(m_far + m_near))/(m_far - m_near),                   (P22*(m_far + m_near))/(m_far - m_near), (P23*(m_far + m_near))/(m_far - m_near) - (2*m_far*m_near)/(m_far - m_near)]
[                                                       P20,                                                       P21,                                                       P22,                                                                         P23]

inv_width_scale  = 1/(m_width*scale);
inv_height_scale = 1/(m_height*scale);
inv_width_scale_1 =inv_width_scale - 1;
inv_height_scale_1_s = -(inv_height_scale - 1);
inv_width_scale_2 = inv_width_scale*2;
inv_height_scale_2_s = -inv_height_scale*2;
m_far_a_m_near = m_far + m_near;
m_far_s_m_near = m_far - m_near;
m_far_d_m_near = m_far_a_m_near/m_far_s_m_near;

M =
[     P20*(inv_width_scale - 1) + (2*P00)*inv_width_scale,   P21*(inv_width_scale - 1) + (2*P01)*inv_width_scale  , P22*(inv_width_scale - 1) + (2*P02)*inv_width_scale    ,                       P23*(inv_width_scale - 1) + (2*P03)*inv_width_scale]
[ - P20*(inv_height_scale - 1) - (2*P10)*inv_height_scale, - P21*(inv_height_scale - 1) - (2*P11)*inv_height_scale, - P22*(inv_height_scale - 1) - (2*P12)*inv_height_scale,                   - P23*(inv_height_scale - 1) - (2*P13)*inv_height_scale]
[                   (P20*m_far_a_m_near)/m_far_s_m_near,                   (P21*m_far_a_m_near)/m_far_s_m_near,                   (P22*m_far_a_m_near)/m_far_s_m_near, (P23*m_far_a_m_near)/m_far_s_m_near - (2*m_far*m_near)/m_far_s_m_near]
[                                                       P20,                                                       P21,                                                       P22,                                                                         P23]

% final OpenGL matrix = M'
% column 1
P20*inv_width_scale_1 + P00*inv_width_scale_2,
P21*inv_width_scale_1 + P01*inv_width_scale_2,
P22*inv_width_scale_1 + P02*inv_width_scale_2,
P23*inv_width_scale_1 + P03*inv_width_scale_2,

% column 2
P20*inv_height_scale_1_s + P10*inv_height_scale_2_s,
P21*inv_height_scale_1_s + P11*inv_height_scale_2_s,
P22*inv_height_scale_1_s + P12*inv_height_scale_2_s,
P23*inv_height_scale_1_s + P13*inv_height_scale_2_s,

% column 3
P20*m_far_d_m_near,
P21*m_far_d_m_near,
P22*m_far_d_m_near,
P23*m_far_d_m_near - (2*m_far*m_near)/m_far_s_m_near,
% column 4
 P20
 P21
 P22
 P23

% final matrix to opengl

P20*inv_width_scale_1 + P00*inv_width_scale_2,  P20*inv_height_scale_1_s + P10*inv_height_scale_2_s,    P20*m_far_d_m_near,     P20,
P21*inv_width_scale_1 + P01*inv_width_scale_2,  P21*inv_height_scale_1_s + P11*inv_height_scale_2_s,    P21*m_far_d_m_near,     P21,
P22*inv_width_scale_1 + P02*inv_width_scale_2,  P22*inv_height_scale_1_s + P12*inv_height_scale_2_s,    P22*m_far_d_m_near,     P22,
P23*inv_width_scale_1 + P03*inv_width_scale_2,  P23*inv_height_scale_1_s + P13*inv_height_scale_2_s,    P23*m_far_d_m_near - (2*m_far*m_near)/m_far_s_m_near,   P23

inv_width_scale  = 1/(m_width*scale);
inv_height_scale = 1/(m_height*scale);
inv_width_scale_1 =inv_width_scale - 1;
inv_height_scale_1_s = -(inv_height_scale - 1);
inv_width_scale_2 = inv_width_scale*2;
inv_height_scale_2_s = -inv_height_scale*2;
m_far_a_m_near = m_far + m_near;
m_far_s_m_near = m_far - m_near;
m_far_d_m_near = m_far_a_m_near/m_far_s_m_near;


function lambda = gear_eigenvalues ( ii, jj, n )

%*****************************************************************************80
%
%% GEAR_EIGENVALUES returns the eigenvalues of the GEAR matrix.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    15 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer II, JJ, define the two special entries.
%
%    Input, integer N, the order of A.
%
%    Output, real LAMBDA(N,1), the eigenvalues.
%
  lambda = zeros ( n, 1 );
%
%  Separate the sign and value.
%
  alpha = zeros ( n, 1 );

  j = abs ( ii );
  js = i4_sign ( ii );

  k = abs ( jj );
  ks = i4_sign ( jj );

  if ( 0 < js & 0 < ks )

    w = 0;

    phi = n - floor ( ( j + k ) / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = 2 * p * pi / ( 2 * n + 2 - j - k );
    end

    phi = floor ( ( j - 1 ) / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = 2 * p * pi / j;
    end

    phi = floor ( ( k - 1 ) / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = 2 * p * pi / k;
    end

    w = w + 1;
    alpha(w) = 0.0;

    if ( i4_is_even ( j ) & i4_is_even ( k ) )
      w = w + 1;
      alpha(w) = pi;
    end

  elseif ( 0 < js & ks < 0 )

    w = 0;

    phi = n + 1 - floor ( (j+k+1) / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = ( 2 * p - 1 ) * pi / ( 2 * n + 2 - j - k );
    end

    phi = floor ( ( j - 1 ) / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = 2 * p * pi / j;
    end

    phi = floor ( k / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = ( 2 * p - 1 ) * pi / k;
    end

    if ( i4_is_even ( j ) & i4_is_odd ( k ) )
      w = w + 1;
      alpha(w) = pi;
    end

  elseif ( js < 0 & 0 < ks )

    w = 0;

    phi = n + 1 - floor ( ( j + k + 1 ) / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = ( 2 * p - 1 ) * pi / ( 2 * n + 2 - j - k );
    end

    phi = floor ( j / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = ( 2 * p - 1 ) * pi / j;
    end

    phi = floor ( ( k - 1 ) / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = 2 * p * pi / k;
    end

    if ( i4_is_odd ( j ) & i4_is_even ( k ) )
      w = w + 1;
      alpha(w) = pi;
    end

  elseif ( js < 0 & ks < 0 )

    w = 0;

    phi = n - floor ( ( j + k ) / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = 2 * p * pi / ( 2 * n + 2 - j - k );
    end

    phi = floor ( j / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = ( 2 * p - 1 ) * pi / j;
    end

    phi = floor ( k / 2 );
    for p = 1 : phi
      w = w + 1;
      alpha(w) = ( 2 * p - 1 ) * pi / k;
    end

    if ( i4_is_odd ( j ) & i4_is_odd ( k ) )
      w = w + 1;
      alpha(w) = pi;
    end

  end

  for w = 1 : n
    lambda(w,1) = 2.0 * cos ( alpha(w) );
  end

  return
end


function [varargout]=patchEdgeAngles(F,V)

% function [A,Ad]=patchEdgeAngles(F,V)
% -----------------------------------------------------------------------
% Computes the edge angles (A) for the patch data specified by the faces
% (F) and vertices (V) arrays.
%
%
% See also:
%
% Kevin Mattheus Moerman
% gibbon.toolbox@gmail.com
%
% 2015/08/18
%------------------------------------------------------------------------

%%

numNodes=size(F,2);

A=zeros(size(F));
for q=1:1:numNodes

    q1=q;
    q0=q-1;
    if q0<1
        q0=numNodes;
    end
    q2=q+1;
    if q2>numNodes
        q2=1;
    end

    P0=V(F(:,q0),:)-V(F(:,q1),:);
    P0=vecnormalize(P0);
    P2=V(F(:,q2),:)-V(F(:,q1),:);
    P2=vecnormalize(P2);
    A(:,q)=acos(dot(P0,P2,2));

end

varargout{1}=A;

if nargout>1
    varargout{2}=180*(A./pi);
end

%%
% _*GIBBON footer text*_
%
% License: <https://github.com/gibbonCode/GIBBON/blob/master/LICENSE>
%
% GIBBON: The Geometry and Image-based Bioengineering add-On. A toolbox for
% image segmentation, image-based modeling, meshing, and finite element
% analysis.
%
% Copyright (C) 2006-2022 Kevin Mattheus Moerman and the GIBBON contributors
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program.  If not, see <http://www.gnu.org/licenses/>.


function [policy, iter, cpu_time] = mdp_value_iteration(P, R, discount, epsilon, max_iter, V0)

% mdp_value_iteration   Resolution of discounted MDP with value iteration algorithm
% Arguments --------------------------------------------------------------
% Let S = number of states, A = number of actions
%   P(SxSxA)  = transition matrix
%              P could be an array with 3 dimensions or
%              a cell array (1xA), each cell containing a matrix (SxS) possibly sparse
%   R(SxSxA) or (SxA) = reward matrix
%              R could be an array with 3 dimensions (SxSxA) or
%              a cell array (1xA), each cell containing a sparse matrix (SxS) or
%              a 2D array(SxA) possibly sparse
%   discount  = discount rate in ]0; 1]
%               beware to check conditions of convergence for discount = 1.
%   epsilon   = epsilon-optimal policy search, upper than 0,
%               optional (default : 0.01)
%   max_iter  = maximum number of iteration to be done, upper than 0,
%               optional (default : computed)
%   V0(S)     = starting value function, optional (default : zeros(S,1))
% Evaluation -------------------------------------------------------------
%   policy(S) = epsilon-optimal policy
%   iter      = number of done iterations
%   cpu_time  = used CPU time
%--------------------------------------------------------------------------
% In verbose mode, at each iteration, displays the variation of V
% and the condition which stopped iterations: epsilon-optimum policy found
% or maximum number of iterations reached.

% MDPtoolbox: Markov Decision Processes Toolbox
% Copyright (C) 2009  INRA
% Redistribution and use in source and binary forms, with or without modification,
% are permitted provided that the following conditions are met:
%    * Redistributions of source code must retain the above copyright notice,
%      this list of conditions and the following disclaimer.
%    * Redistributions in binary form must reproduce the above copyright notice,
%      this list of conditions and the following disclaimer in the documentation
%      and/or other materials provided with the distribution.
%    * Neither the name of the <ORGANIZATION> nor the names of its contributors
%      may be used to endorse or promote products derived from this software
%      without specific prior written permission.
% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
% ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
% IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
% INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
% BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
% DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
% LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
% OF THE POSSIBILITY OF SUCH DAMAGE.

cpu_time = cputime;

global mdp_VERBOSE;

% check of arguments
if iscell(P); S = size(P{1},1); else S = size(P,1); end;
if discount <= 0 || discount > 1
    disp('--------------------------------------------------------')
    disp('MDP Toolbox ERROR: Discount rate must be in ]0; 1]')
    disp('--------------------------------------------------------')
elseif nargin > 3 && (epsilon <= 0)
    disp('--------------------------------------------------------')
    disp('MDP Toolbox ERROR: epsilon must be upper than 0')
    disp('--------------------------------------------------------')
elseif nargin > 4 && max_iter <= 0
    disp('--------------------------------------------------------')
    disp('MDP Toolbox ERROR: The maximum number of iteration must be upper than 0')
    disp('--------------------------------------------------------')
elseif nargin > 5 && size(V0,1) ~= S
    disp('--------------------------------------------------------')
    disp('MDP Toolbox ERROR: V0 must have the same dimension as P')
    disp('--------------------------------------------------------')
else

    if discount == 1
        disp('--------------------------------------------------------')
        disp('MDP Toolbox WARNING: check conditions of convergence.')
        disp('With no discount, convergence is not always assumed.')
        disp('--------------------------------------------------------')
    end;

    PR = mdp_computePR(P,R);

    % initialization of optional arguments
    if nargin < 6; V0 = zeros(S,1); end;
    if nargin < 4; epsilon = 0.01; end;
    % compute a bound for the number of iterations
    if discount ~= 1
       computed_max_iter = mdp_value_iteration_bound_iter(P, R, discount, epsilon, V0);
    end;
    if nargin < 5
        if discount ~= 1
            max_iter = computed_max_iter;
        else
            max_iter = 1000;
        end;
    else
        if discount ~= 1 && max_iter > computed_max_iter
            disp(['MDP Toolbox WARNING: max_iter is bounded by ' num2str(computed_max_iter,'%12.1f') ])
            max_iter = computed_max_iter;
        end;
    end;

    % computation of threshold of variation for V for an epsilon-optimal policy
    if discount ~= 1
        thresh = epsilon * (1-discount)/discount;
    else
        thresh = epsilon;
    end;

    if mdp_VERBOSE; disp('  Iteration    V_variation'); end;

    iter = 0;
    V = V0;
    is_done = false;
    while ~is_done
        iter = iter + 1;
        Vprev = V;

        [V, policy] = mdp_bellman_operator(P,PR,discount,V);

        variation = mdp_span(V - Vprev);
        if mdp_VERBOSE;
            disp(['      ' num2str(iter,'%5i') '         ' num2str(variation)]);
        end;
        if variation < thresh
            is_done = true;
            if mdp_VERBOSE
                disp('MDP Toolbox: iterations stopped, epsilon-optimal policy found')
            end;
        elseif iter == max_iter
            is_done = true;
            if mdp_VERBOSE
                disp('MDP Toolbox: iterations stopped by maximum number of iteration condition')
            end;
        end;
    end;

end;

cpu_time = cputime - cpu_time;


function [angle_SAM,map] = SAM(ref,tar)
%--------------------------------------------------------------------------
% Spectral angle mapper (SAM)
%
% USAGE
%   [angle_SAM,map] = SAM(msoriginal,msfused)
%
% INPUT
%   ref : reference HS data (rows,cols,bands)
%   tar : target HS data (rows,cols,bands)
%
% OUTPUT
%   angle_SAM : average SAM in degree (scalar)
%   map       : 2-D map of SAM
%
%--------------------------------------------------------------------------
[rows,cols,bands] = size(tar);
prod_scal = dot(ref,tar,3);
norm_orig = dot(ref,ref,3);
norm_fusa = dot(tar,tar,3);
prod_norm = sqrt(norm_orig.*norm_fusa);
prod_map = prod_norm;
prod_map(prod_map==0)=eps;
map = acos(prod_scal./prod_map);
prod_scal = reshape(prod_scal,rows*cols,1);
prod_norm = reshape(prod_norm, rows*cols,1);
z=find(prod_norm==0);
prod_scal(z)=[];prod_norm(z)=[];
angolo = sum(sum(acos(prod_scal./prod_norm)))/(size(prod_norm,1));
angle_SAM = real(angolo)*180/pi;

end


function [EccA] = vect_solveKepler(meanALL, eccALL)
%solveKepler Summary of this function goes here
%   Detailed explanation goes here.
    EccA = zeros(size(eccALL));
    tol = 1E-12;

    if(any(eccALL < 1))
        ecc = eccALL(eccALL < 1);
        mean = meanALL(eccALL < 1);

        mean = AngleZero2Pi(mean);

        E0 = zeros(size(mean));
        E1 = ones(size(mean)) * Inf;
        if(any(mean > pi))
            E0(mean > pi) = mean(mean > pi) - ecc(mean > pi);
        end
        if(any(mean <= pi))
            E0(mean <= pi) = mean(mean <= pi) + ecc(mean <= pi);
        end

        first = true;
        while(any(abs(E1 - E0) > tol))
            if(~first)
                E0 = E1;
            end
            E1 = E0 + (mean - E0 + ecc.*sin(E0))./(1-ecc.*cos(E0));
            if(first)
                first = false;
            end
        end
        EccA(eccALL < 1) = E1;
    end

    if(any(eccALL >= 1))
        ecc = eccALL(eccALL >= 1);
        mean = meanALL(eccALL >= 1);

        H0 = zeros(size(mean));
        H1 = ones(size(mean)) * Inf;

        if(any(ecc < 1.6))
            bool = (-pi < mean & mean < 0) | mean > pi;
            H0(bool) = mean(bool) - ecc(bool);
            H0(not(bool)) = mean(not(bool)) + ecc(not(bool));
        end
        if(any(ecc >= 1.6))
            bool = ecc<3.6 & abs(mean) > pi;
            H0(bool) = mean(bool) - sign(mean(bool)).*ecc(bool);
            H0(not(bool)) = mean(not(bool))./(ecc(not(bool))-1);
        end

        first = true;
        while(any(abs(H1 - H0) > tol))
            if(~first)
                H0 = H1;
            end
            H1 = H0 + (mean - ecc.*sinh(H0) + H0)./(ecc.*cosh(H0) - 1);

            if(any(isnan(H1))) %this code necessary to prevent Inf/Inf = NaN cases where H0 is very large and the sinh/cosh functions give Inf as an answer
                bool1 = isnan(H1) & -ecc.*sinh(H0) == Inf;
                bool2 = isnan(H1) & -ecc.*sinh(H0) == -Inf;

                H1(bool1) = H0(bool1) + ones(size(H0(bool1)));
                H1(bool2) = H0(bool2) - ones(size(H0(bool2)));
            end

            if(first)
                first = false;
            end
        end
        EccA(eccALL >= 1) = H1;
    end
end


function [ axisAngle ] = Rot2AxisAngle( Rot )
%ROT2AXISANGLE Summary of this function goes here
%   Detailed explanation goes here

    theta = acos((trace(Rot) - 1) / 2);

    vec = 1.0/(2*sin(theta));
    vec = vec * [Rot(3,2) - Rot(2,3), Rot(1,3) - Rot(3,1), Rot(2,1) - Rot(1,2)];
    axisAngle = vec * theta;
end


function [betaAngle] = patchFaceAngles(F,V)

% function [betaAngle] = patchFaceAngles(F,V)
% ------------------------------------------------------------------------
%
%
% 2018/11/14 Created
%
% ------------------------------------------------------------------------

%%
% Get connectivity matrices
connecticityStruct=patchConnectivity(F,V);
edgeVertexConnectivity=connecticityStruct.edge.vertex;
edgeFaceConnectivity=connecticityStruct.edge.face;
faceEdgeConnectivity=connecticityStruct.face.edge;
% vertexEdgeConnectivity=connecticityStruct.vertex.edge;

logicValid=all(edgeFaceConnectivity>0,2);

% Face normals
N=patchNormal(F,V);

% Create edge vectors
VE = V(edgeVertexConnectivity(:,1),:) - V(edgeVertexConnectivity(:,2),:); %Edge vector
edgeVectorLength = sqrt(sum(VE.^2,2)); %Length of edge vector
VE=VE./edgeVectorLength(:,ones(1,3)); %Normalized edge vector

% Compute the un-signed angle
betaAngle=nan(size(edgeFaceConnectivity,1),1);
betaAngle(logicValid) = real(acos(dot(N(edgeFaceConnectivity(logicValid,1),:),N(edgeFaceConnectivity(logicValid,2),:),2)));

% Fix sign of angle
cp = nan(size(edgeFaceConnectivity,1),3);
cp(logicValid,:) = cross(N(edgeFaceConnectivity(logicValid,1),:),N(edgeFaceConnectivity(logicValid,2),:),2);

si = sign(dot(cp,VE,2));
% si(abs(si)<eps)=1;

betaAngle=pi+(betaAngle.*si);

betaAngle=betaAngle(faceEdgeConnectivity);

end
%%
% _*GIBBON footer text*_
%
% License: <https://github.com/gibbonCode/GIBBON/blob/master/LICENSE>
%
% GIBBON: The Geometry and Image-based Bioengineering add-On. A toolbox for
% image segmentation, image-based modeling, meshing, and finite element
% analysis.
%
% Copyright (C) 2006-2022 Kevin Mattheus Moerman and the GIBBON contributors
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program.  If not, see <http://www.gnu.org/licenses/>.


% 股票预测问题 by 曲线拟合
%% 历史数据处理
clear;clc;
x = [2,3,4,5,8,9,10,11,12,15,16,17,18,19,22,23,24,25,26,29,30]; % 时间
y = [7.74,7.84,7.82,7.78,7.91, 7.97,7.9,7.76,7.9,8.04,8.06, 8.11,8.08,8.13,8.03,8.01,8.06,8.0,8.3,8.41,8.28];  % 当天收盘价

p=polyfit(x,y,3);  % 多项式拟合，返回次数为 3 的多项式 p(x) 的系数，该阶数是 y 中数据的最佳拟合（在最小二乘方式中）。p 中的系数按降幂排列，p 的长度为 n+1
plot(x,y,'*',x,polyval(p,x));

%% 开始预测
x1=[31,32,33];   % 待预测时间
xi=[x,x1];
y1=[8.27,8.17,9.54];  %  该股票后三个交易日的收盘价分别为8.27,8.17,9.54
plot(x,y,'*',xi,polyval(p,xi),x1,y1,'rp');
% 结论：预测结果仅供参考


function Bd = getBd(phi, h, d)

% getBd: get the B-matrix as in equation (16) and Lemma 2
%
% Usage:    Bd = getBd(phi, h, d)
%
% INPUTS:
%       phi: a cell containing all the systems Phi_i(s)
%       h: the fast sampling interval
%       d: the vector of fractional delays
%
% OUTPUT:
%       Bd: matrix Bd as in equation (16)
%
% SEE ALSO: getAd, getCd

N = length(d);

% Compute for the block not containing Q0 and R0
BB = [];

for i = 1:N
    Ai = phi{i+1}{1};
    Bi = phi{i+1}{2};
    Ci = phi{i+1}{3};

    % Column i of BB
    BBi = [];

    % Concatenate Delta_ij to get row i
    for j = 1:N
        if ( i <= j)
            Aj = phi{j+1}{1};
            Bj = phi{j+1}{2};
            Cj = phi{j+1}{3};

            QQ = MVL(Ai, Bi, Aj, Bj, h);
            QR =   expm(d(j)*Aj) * MVL(Ai, Bi, Aj, Bj, h-d(j)) * Cj' ;
            RQ = ( expm(d(i)*Ai) * MVL(Aj, Bj, Ai, Bi, h-d(i)) * Ci' )' ;   % Transpose of QR above

            if (d(i) < d(j))
                RR = Ci * expm( (d(j)-d(i)) * Ai) * MVL(Ai, Bi, Aj, Bj, h-d(j)) * Cj' ;
            else
                RR = Ci * MVL(Ai, Bi, Aj, Bj, h-d(i)) * expm( (d(i)-d(j)) * Ai') * Cj' ;
            end

            BBij = [QQ, QR;
                    RQ, RR];

            BBi = [BBi BBij];
        else
            Aj = phi{j+1}{1};
            Bj = phi{j+1}{2};
            Cj = phi{j+1}{3};

            % position of this block BBij
            sc = size(BBi, 2) + 1;          % Starting column
            wc = size(Aj,1) + size(Cj,1);   % Number of column in this block
            sr = size(BB, 1) + 1;           % Starting row
            wr = size(Ai,1) + size(Ci,1);   % Number of row in this block

            % To save computation, we use Delta_ji'
            BBi = [BBi BB(sc:(sc+wc-1), sr:(sr+wr-1))'];
        end
    end

    BB = [BB; BBi];
end

% column 0 of BB, except the first block Q0*Q0'
BB0 = [];

A0 = phi{1}{1};
B0 = phi{1}{2};
C0 = phi{1}{3};

for i = 1:N
    Ai = phi{i+1}{1};
    Bi = phi{i+1}{2};
    Ci = phi{i+1}{3};

    QQ = MVL(A0, B0, Ai, Bi, h);
    QR = expm(d(i)*Ai) * MVL(A0, B0, Ai, Bi, h-d(i)) * Ci' ;

    BB0 = [BB0 QQ QR];
end

QQ0 = MVL(A0, B0, A0, B0, h);

BB = [QQ0   BB0;
      BB0'  BB];

Bd = real(sqrtm(BB));


function squareStokesP1P0
%STOKE Summary of this function goes here
%   Detailed explanation goes here

close all; clear all; clc;
%figure(1); set(gcf,'Units','normal'); set(gcf,'Position',[0,0,0.7,0.75]);
%---------------------- Parameters ----------------------------------------
maxIt = 3; N = zeros(maxIt,1);
erru = zeros(maxIt,1);  errp = zeros(maxIt,1);
%---------------------- Generate initial mesh -----------------------------
node = [0,0; 1,0; 1,1; 0,1];    % nodes
elem = [2,3,1; 4,1,3];          % elements
for k = 1:3
    [node,elem] = uniformbisect(node,elem);
end
%% pde
pde.f = @f; pde.g_D = @g_D; pde.p=@exactp;
%---------------------- Finite Element Method -----------------------------
%
for k = 1:maxIt
    [node,elem] = uniformbisect(node,elem);
    [u,p,A,nodeRefine,nodeFine,elemFine] = mgStokesP1P0TwolevelNew(node,elem,pde);
    N(k) = length(u) + length(p);
    uI = exactu(nodeRefine);
    erru(k) = sqrt((u-uI(:))'*A{2}*(u-uI(:)));
    center = (nodeFine(elemFine(:,1),:)+nodeFine(elemFine(:,2),:)+nodeFine(elemFine(:,3),:))/3;
    pI = exactp(center);
    pI = pI-pI(end);
    errp(k)=max(abs(p-pI));
%     errp(k) = norm(p - pI)/sqrt(N);
    fprintf('erru = %6.3g, errp = %6.3g\n', erru(k), errp(k));
end
%% Plot convergence rates
figure(2);
showrate2(N,erru,1,'-*','||Du-Du_h||',N,errp,1,'m-+','||p-p_h||');
end
%---------------------- End of function SQUARE -----------------------------
function z = f(p)
x = p(:,1); y = p(:,2);
z(:,1) = -4*pi^2*(2*cos(2*pi*x)-1).*sin(2*pi*y)+x.^2;
z(:,2) = 4*pi^2*(2*cos(2*pi*y)-1).*sin(2*pi*x);
end
function z = exactu(p)
x = p(:,1); y = p(:,2);
z(:,1) = (1-cos(2*pi*x)).*sin(2*pi*y);
z(:,2) = -(1-cos(2*pi*y)).*sin(2*pi*x);
end
function z=exactp(p)
x = p(:,1);
z = 1/3*x.^3;
end

% %---------------------- Sub functions called by CUBE ----------------------
% function z = f(p) % load data (right hand side function)
% x = p(:,1); y = p(:,2);
% z(:,1) = 2^10*( (1-6*x+6*x.^2).*(y-3*y.^2+2*y.^3) ...
%        + (x.^2-2*x.^3+x.^4).*(-3+6*y)...
%        - (-3+6*x).*(y.^2-2*y.^3+y.^4) );
% z(:,2) = -(2^10)*( (-3+6*x).*(y.^2-2*y.^3 ...
%        + y.^4)+(x-3*x.^2+2*x.^3).*(1-6*y+6*y.^2)...
%        + (1-6*x+6*x.^2).*(y-3*y.^2+2*y.^3) );
% end
% %--------------------------------------------------------------------------
% function z = exactu(p)
% x = p(:,1); y = p(:,2);
% z(:,1) = -(2^8)*(x.^2-2*x.^3+x.^4).*(2*y-6*y.^2+4*y.^3);
% z(:,2) = 2^8*(2*x-6*x.^2+4*x.^3).*(y.^2-2*y.^3+y.^4);
% end
% %--------------------------------------------------------------------------
% function z = exactp(p)
% x = p(:,1); y = p(:,2);
% z = -(2^8)*(2-12*x+12*x.^2).*(y.^2-2*y.^3+y.^4);
% end
%--------------------------------------------------------------------------
function z = g_D(p) % Dirichlet boundary condition
z = exactu(p);
end


function a = polya_fit_m(data, a, weight)
% POLYA_FIT_M   Maximum-likelihood Dirichlet-multinomial (Polya) mean.
%
% POLYA_FIT_M(data,a) returns the MLE (a) for the matrix DATA,
% subject to a constraint on sum(A).
% Each row of DATA is a histogram of counts.
% A is a row vector providing the initial guess for the parameters.
%
% POLYA_FIT_M(data,a,weight) returns the MLE where each histogram is weighted.
% WEIGHT is a column vector of numbers in [0,1] (default all ones).
%
% A is decomposed into S*M, where M is a vector such that sum(M)=1,
% and only M is changed by this function.  In other words, sum(A)
% is unchanged by this function.
%
% The algorithm is a generalized Newton iteration, described in
% "Estimating a Dirichlet distribution" by T. Minka.

% Written by Tom Minka

s = sum(a);
m = a/s;
[N,K] = size(data);

use_weight = (nargin > 2);
row = (rows(a) == 1);

for iter = 1:20
  old_m = m;
  if row
    a = s*m;
    for k = 1:length(m)
      dk = data(:,k);
      vdk = a(k)*di_pochhammer(a(k), dk);
      if use_weight
	vdk = vdk .* weight;
      end
      m(k) = sum(vdk);
    end
  else
    a = repmat(s*m, 1, N);
    vdata = a.*di_pochhammer(a, data);
    if use_weight
      vdata = vdata .* repmat(weight, rows(vdata), 1);
    end
    m = row_sum(vdata);
  end
  m = m ./ sum(m);
  if max(abs(m - old_m)) < 1e-4
    break
  end
end
a = s*m;


function [fMeanMag, fBValue, fStdDev, fAValue] = ...
        calc_bmemag(mag, fBinning)
    %CALC_BMEMAG Calculate Maximum Likelihood b-value
    % [fMeanMag, fBValue, fStdDev, fAValue] = ...
    %                   calc_bmemag(mag, fBinning)
    % Calculates the mean magnitute, the b-value based
    % on the maximum likelihood estimation, the a-value and the
    % standard deviation of the b-value
    %
    % Input parameters:
    %   mag             Vector of magnitudes
    %   fBinning        Bin size in magnitude (default 0.1)
    %
    % Output parameters:
    %   fMeanMag        Mean magnitude
    %   fBValue         b-value
    %   fStdDev         Standard deviation of b-value
    %   fAValue         a-value

    % Copyright (C) 2003 by Danijel Schorlemmer
    %
    % 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.,
    % 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
    %
    % Modified by Glenn Thompson 2014/06/14

    % Set the default value if not passed to the function
    if ~exist('fBinning')
        fBinning = 0.1;
    end

    % Calculate the minimum and mean magnitude, length of catalog
    nLen = length(mag);
    fMinMag = min(mag);
    fMeanMag = mean(mag);
    % Calculate the b-value (maximum likelihood)
    fBValue = (1/(fMeanMag-(fMinMag-(fBinning/2))))*log10(exp(1));
    % Calculate the standard deviation
    fStdDev = (sum((mag-fMeanMag).^2))/(nLen*(nLen-1));
    fStdDev = 2.30 * sqrt(fStdDev) * fBValue^2;
    % Calculate the a-value
    fAValue = log10(nLen) + fBValue * fMinMag;
end


% Notes for Laplace scheme and dynamic updating of parameters
%==========================================================================
n  = 128;                       % number of samples (time bins)
P  = 4;                         % true parameter
k  = n;                         % precision on fluctuations
pp = 2;                         % prior on parameter
m  = 8;                         % number of data
iS = eye(m,m)*2;                % error precision
s  = sqrtm(inv(iS));

p  = [0;0];                     % initial parameter estimates
for i = 1:n

    x      = 4 + randn(m,1);          % exogenous input
    z      = s*randn(m,1);            % error
    y      = P*x + z;                 % response
    e      = y - p(1)*x;              % prediction error
    Lp     = -e'*iS*x + pp*p(1);
    Lpp    = x'*iS*x  + pp;
    f      = [p(2); (-Lp -k*p(2))];
    dfdx   = [0 1;   -Lpp -k];
    p      = p + spm_dx(dfdx,f,1);
    X(:,i) = p;
    LP(i)  = Lp;
end

% results
%--------------------------------------------------------------------------
subplot(2,1,1)
plot(1:n,X)
title('generalised parameter estimates','FontSize',16)

subplot(2,1,2)
plot(1:n,LP)
title('energy gradient','FontSize',16)

return

% Notes
%==========================================================================
M.f = inline('[x(2); (u - K(1)*x(2))]','x','u','K','M');
M.m = 1;
M.n = 2;
M.l = 2;
M.x = [0;0];
M.u = 0;

N   = 128;
dt  = 1/64;
K   = 4;
[K0,K1,K2] = spm_kernels(M,K,N,dt);

subplot(2,1,1)
plot([1:N]*dt,K1);
xlabel('time (s)')
title('Kernels','FontSize',16)
legend('drive','trace')
axis square


% Matlab Script: cluster_win.m
% ----------------------------
%
% Plots the distance window length and the time window length against magnitude
%
%

%% Magntiude areas
vMagnitude = (0:0.1:10);
vMagnitudea = (0:0.1:6.5);
vMagnitudeb = (6.5:0.1:10);

% Gardener and Knopoff, 1974
vSpaceGaKn74 = 10.^(0.1238*vMagnitude+0.983);
vTimeGaKn74 = 10.^(0.5409*vMagnitudea-0.547);
vTimeGaKn74b = 10.^(0.032*vMagnitudeb+2.7389); % M>=6.5

% Uhrhammer 1976
vSpaceUr = exp(-1.024+0.804*vMagnitude);
vTimeUr = exp(-2.87+1.235*vMagnitude);

% Gruenthal, 1985
vSpaceGr85 = 10.^(0.1060*vMagnitude+1.0982);
vTimeGr85 = 10.^(0.5055*vMagnitude-0.1329);
% Gruenthal, pers. communication
vSpaceGr = exp(1.77+sqrt(0.037+1.02*vMagnitude));
vTimeGra = exp(-3.95+sqrt(0.62+17.32*vMagnitudea));
vTimeGrb = 10.^(2.8+0.024*vMagnitudeb); % M >= 6.5

% Youngs, 1987
%% Maximum window limits
%% Space
vMagY1 = (0:0.01:2.43);
vMagY2 = (2.43:0.01:5.87);
vMagY3 = (5.87:0.01:10);
vSpaceY1 = 20+0*vMagY1;
vSpaceY2 = 10.^(0.1159*vMagY2+1.0197);
vSpaceY3 = 10.^(0.5281*vMagY3-1.3937);
%% Time
vMagTY1 = (0:0.01:3.89);
vMagTY2 = (3.89:0.01:10);
vTimeY1 = 30+0*vMagTY1;
vTimeY2 = 10.^(0.4916*vMagTY2-0.4317);

%% Minimum window limits
%% Space
vMinY1 = (0:0.01:4.41);
vMinY2 = (4.41:0.01:4.98);
vMinY3 = (4.98:0.01:6.42);
vMinY4 = (6.42:0.01:10);
vSpaceMinY1 = 10+0*vMinY1;
vSpaceMinY2 = 10.^(0.5281*vMinY2-1.3290);
vSpaceMinY3 = 10.^(0.3313*vMinY3-0.3490);
vSpaceMinY4 = 10.^(0.1154*vMinY4+1.0371);
%% Time
vMinTY1 = (0:0.01:5);
vMinTY2 = (5:0.01:10);
vTimeMinY1 = 5+0*vMinTY1;
vTimeMinY2 = 10.^(1.0526*vMinTY2-4.561);

% Plotting time window
hPlot = figure_w_normalized_uicontrolunits('tag','Timewindow','Numbertitle','off','Name','Time window length','Units','normalized');
hAxe = axes('tag','ax_timewindow','Nextplot','replace','box','on');

set(gca,'tag','ax_timewindow','Nextplot','replace','box','on','Xticklabel', [0 10 100]);
axs1=findobj('tag','ax_timewindow');
axes(axs1(1));
semilogy(vMagnitudea,vTimeGaKn74,'Color',[1 0 0],'Linewidth', 2);
hold on;
semilogy(vMagnitude,vTimeGr85,'Color',[0 0.5 0],'Linewidth', 2);
semilogy(vMagnitudea,vTimeGra,'Color',[0 0.8 0],'Linewidth', 2);
semilogy(vMagnitude,vTimeUr,'Color',[0.5 0 0],'Linewidth', 2);
semilogy(vMagTY1,vTimeY1,vMagTY2,vTimeY2,'Color',[0 0 1],'Linewidth', 2);
semilogy(vMagnitudeb,vTimeGaKn74b,'Color',[1 0 0],'Linewidth', 2);
semilogy(vMinTY1,vTimeMinY1,vMinTY2,vTimeMinY2,'Color',[0 0 1],'Linewidth', 2);
semilogy(vMagnitudeb,vTimeGrb,'Color',[0 0.8 0],'Linewidth', 2);
legend('Gardner & Knopoff (1974)','Gruenthal (1985)','Gruenthal (pers.)','Urhammer (1976)','Mod. Young (1987)');
xlabel('Magnitude');
ylabel('Time / [days]');
set(gca,'Xlim',[0 9]);%,'Ylim',[0.1 3000],'Yticklabel', [0.1 1 10 100 1000]);
grid on;

% Plotting space window
hPlot2 = figure_w_normalized_uicontrolunits('tag','Spacewindow','Numbertitle','off','Name','Spacial window length','Units','normalized');
hAxe2 = axes('tag','ax_spacewindow','Nextplot','replace','box','on');

set(gca,'tag','ax_spacewindow','Nextplot','replace','box','on');
axs1=findobj('tag','ax_spacewindow');
axes(axs1(1));
semilogy(vMagnitude,vSpaceGaKn74,'Color',[1 0 0],'Linewidth', 2);
hold on;
semilogy(vMagnitude,vSpaceGr85,'Color',[0 0.5 0],'Linewidth', 2);
semilogy(vMagnitude,vSpaceGr,'Color',[0 0.8 0],'Linewidth', 2);
semilogy(vMagnitude,vSpaceUr,'Color',[0.5 0 0],'Linewidth', 2);
semilogy(vMagY1,vSpaceY1,vMagY2,vSpaceY2,vMagY3,vSpaceY3,'Color',[0 0 1],'Linewidth', 2);
semilogy(vMinY1,vSpaceMinY1,vMinY2,vSpaceMinY2,vMinY3,vSpaceMinY3,vMinY4,vSpaceMinY4,'Color',[0 0 1],'Linewidth', 2);
legend('Gardner & Knopoff (1974)','Gruenthal (1985)','Gruenthal (pers. comm)','Urhammer (1976)','Mod. Young (1987)');
ylabel('Distance / [km]')
xlabel('Magnitude');
set(gca,'Xlim',[0 9],'Ylim', [5 300],'Yticklabel', [10 100]);
grid on;


%MDS Trainale mapping for multidimensional scaling, a variant of Sammon mapping
%
%   [W,J,STRESS] = MDS(DT,Y,OPTIONS)
%   [W,J,STRESS] = MDS(DT,K,OPTIONS)
%   [W,J,STRESS] = DT*MDS([],K,OPTIONS)
%   [W,J,STRESS] = DT*MDS(K,OPTIONS)
%              X = DS*W
%
%
% INPUT
%   DT      Square (M x M) dissimilarity matrix used for training
%   DS      N x M dissimilarity matrix between testset and trainset
%   Y       M x K matrix containing starting target configuration, or
%   K       Desired output dimensionality (default 2)
%   OPTIONS Various parameters of the  minimization procedure put into
%           a structure consisting of the following fields: 'q', 'optim',
%           'init','etol','maxiter', 'isratio', 'itmap', 'st' and 'inspect'
%           (default:
%
%              OPTIONS.q       = 0
%              OPTIONS.optim   = 'pn'
%              OPTIONS.init    = 'cs'
%              OPTIONS.etol    = 1e-6 (the precise value depends on q)
%              OPTIONS.maxiter = 100
%              OPTIONS.isratio = 0
%              OPTIONS.itmap   = 'yes'
%              OPTIONS.st      = 1
%              OPTIONS.inspect = 2).
%
% OUTPUT
%   W       Multidimensional scaling mapping
%   J       Index of points removed before optimization
%   STRESS  Vector of stress values
%   X       N x K dataset with output configuration
%
% DESCRIPTION
% Finds a nonlinear MDS map (a variant of the Sammon map) of objects
% represented by a symmetric distance matrix D with zero diagonal, given
% either the dimensionality K or the initial configuration Y. This is done
% in an iterative manner by minimizing the Sammon stress between the given
% dissimilarities D (DT or DS) and the distances DY in the K-dimensional
% target space:
%
%   E = 1/(sum_{i<j} D_{ij}^(Q+2)) sum_{i<j} (D_{ij} - DY_{ij})^2 * D_{ij}^Q
%
% If D(i,j) = 0 for any different points i and j, then one of them is
% superfluous. The indices of these points are returned in J.
%
% There is a simplified interface to MDS, called SAMMONM. The main
% differences are that SAMMONM operates on feature based datasets, while MDS
% expects dissimilarity matrices; MDS maps new objects by a second
% optimization procedures minimizing the stress for the test objects, while
% SAMMONM uses a linear mapping between dissimilarities and the target
% space. See also PREX_MDS for examples.
%
% OPTIONS is an optional variable, using which the parameters for the mapping
% can be controlled. It may contain the following fields:
%
%   Q        Stress measure to use (see above): -2,-1,0,1 or 2.
%   INIT     Initialisation method for Y: 'randp', 'randnp', 'maxv', 'cs'
%            or 'kl'. See MDS_INIT for an explanation.
%   OPTIM    Minimization procedure to use: 'pn' for Pseudo-Newton or
%            'scg' for Scaled Conjugate Gradients.
%   ETOL     Tolerance of the minimization procedure. Usually, it should be
%   MAXITER  in the order of 1e-6. If MAXITER is given (see below), then the
%            optimization is stopped either when the error drops below ETOL or
%            MAXITER iterations are reached.
%   ISRATIO  Indicates whether a ratio MDS should be performed (1) or not (0).
%            If ISRATIO is 1, then instead of fitting the dissimilarities
%            D_{ij}, A*D_{ij} is fitted in the stress function. The value A
%            is estimated analytically in each iteration.
%   ITMAP    Determines the way new points are mapped, either in an iterative
%            manner ('yes') by minimizing the stress; or by a linear projection
%            ('no').
%   ST       Status, determines whether after each iteration the stress should
%   INSPECT  be printed on the screen (1) or not (0). When INSPECT > 0,
%            ST = 1 and the mapping is onto 2D or larger, then the progress
%            is plotted during the minimization every INSPECT iterations.
%
% Important:
% - It is assumed that D either is or approximates a Euclidean distance
%     matrix, i.e:
%            D_{ij} = sqrt (sum_k(x_i - x_j)^2).
% - Missing values can be handled; they should be marked by 'NaN' in D.
%
% EXAMPLES:
% opt.optim = 'scg';
% opt.init  = 'cs';
% D  = sqrt(distm(a)); % Compute the Euclidean distance dataset of A
% w1 = mds(D,2,opt);   % An MDS map onto 2D initialized by Classical Scaling,
%                      % optimized by a Scaled Conjugate Gradients algorithm
% n  = size(D,1);
% y  = rand(n,2);
% w2 = mds(D,y,opt);   % An MDS map onto 2D initialized by random vectors
%
% z = rand(n,n);       % Set around 40% of the random distances to NaN, i.e.
% z = (z+z')/2;        % not used in the MDS mapping
% z = find(z <= 0.6);
% D(z) = NaN;
% D(1:n+1:n^2) = 0;    % Set the diagonal to zero
% opt.optim = 'pn';
% opt.init  = 'randnp';
% opt.etol  = 1e-8;    % Should be high, as only some distances are used
% w3 = mds(D,2,opt);   % An MDS map onto 2D initialized by a random projection
%
% REFERENCES
% 1. M.F. Moler, A Scaled Conjugate Gradient Algorithm for Fast Supervised
%    Learning', Neural Networks, vol. 6, 525-533, 1993.
% 2. W.H. Press, S.A. Teukolsky, W.T. Vetterling and B.P. Flannery,
%    Numerical Recipes in C, Cambridge University Press, Cambridge, 1992.
% 3. I. Borg and P. Groenen, Modern Multidimensional Scaling, Springer
%    Verlag, Berlin, 1997.
% 4. T.F. Cox and M.A.A. Cox, Multidimensional Scaling, Chapman and Hall,
%    London, 1994.
%
% SEE ALSO (PRTools Guide)
% DATASETS, MAPPINGS, PREX_MDS, MDS_CS, SAMMONM, TSNEM

%
% Copyright: E. Pekalska, R.P.W. Duin, e.pekalska@37steps.com
%

function [w,J,err,opt,y] = mds(varargin)

  mapname = 'MDS';
	argin = shiftargin(varargin,{'scalar'});
  argin = setdefaults(argin,[],2,[]);

  if mapping_task(argin,'definition')
    w = define_mapping(argin,'untrained',mapname);

  else % Train, evaluate or extend a mapping.

    [D,y,options] = deal(argin{:});
    opt = mds_setopt(options);

  % YREP contains representative objects in the projected MDS space, i.e.
  % for which the mapping exists. YREP is empty for the original MDS, since
  %  no projection is available yet.

    yrep = [];

    if (isdataset(D) | isa(D,'double'))
      [m,mm] = size(D);

      % Convert D to double, but retain labels in LAB.
      if (isdataset(D)), lab = getlab(D); D = +D; else, lab = ones(m,1); end;

      if (ismapping(y))

        % The MDS mapping exists; this means that YREP has already been stored.
        pars = getdata(y); [k,c] = size(y);

        y     = [];        % Empty, should now be found.
        yrep  = pars{1};  % There exists an MDS map, hence YREP is stored.
        opt   = pars{2};  % Options used for the mapping.
        II    = pars{3};  % Index of non-repeated points in YREP.
        winit = pars{4};  % The Classical Scaling map, if INIT = 'cs'.
        v     = pars{5};  % Weights used for adding new points if ITMAP = 'no'.
        n = c;            % Number of dimensions of the projected space.

        % Initialization by 'cs' is not possible when there is no winit
        % (i.e. the CS map) and new points should be added.
        if (strcmp(opt.init,'cs')) & (isempty(winit))
          prwarning(2,'OPTIONS.init = cs is not possible when adding points; using kl.');
          opt.init = 'kl';
        end

        % If YREP is a scalar, we have an empty mapping.
        if (max(size(yrep)) == 1)
          y    = yrep;
          yrep = [];
        end

        % Check whether D is a matrix with the zero diagonal for the existing map.
        if (m == mm) & (length(intersect(find(D(:)<eps),1:m+1:(m*mm))) >= m)
          w = yrep;         % D is the same matrix as in the projection process;
          return            % YREP is then the solution
        end

        if (length(pars) < 6) | (isempty(pars{6}))
          yinit = [];
        else
          yinit = pars{6};   % Possible initial configuration for points to
                            % be added to an existing map
          if (size(yinit,1) ~= size(D,1))
            prwarning(2,'the size of the initial configuration does not match that of the dissimilarity matrix, using random initialization.')
            yinit =[];
          end
        end

      else

        % No MDS mapping available yet; perform the checks.

        if (~issym(D,1e-12))
          prwarning(2,'D is not a symmetric matrix; will average.');
          D = (D+D')/2;
        end

        % Check the number of zeros on the diagonal

        if (any(abs(diag(D)) > 0))
          error('D should have a zero diagonal');
        end
      end

    else    % D is neither a dataset nor a matrix of doubles
      error('D should be a dataset or a matrix of doubles.');
    end

    if (~isempty(y))

      % Y is the initial configuration or N, no MDS map exists yet;
      % D is a square matrix.

      % Remove identical points, i.e. points for which D(i,j) = 0 for i ~= j.
      % I contains the indices of points left for the MDS mapping, J those
      % of the removed points and P those of the points left in I which were
      % identical to those removed.

      [I,J,P] = mds_reppoints(D);
      D = D(I,I);
      [ni,nc] = size(D);

      % NANID is an extra field in the OPTIONS structure, containing the indices
      % of NaN values (= missing values) in distance matrix D.

      opt.nanid = find(isnan(D(:)) == 1);

      % Initialise Y.

      [m2,n] = size(y);
      if (max(m2,n) == 1)    % Y is a scalar, hence really is a dimensionality N.
        n = y;
        [y,winit] = mds_init(D,n,opt.init);
      else
        if (mm ~= m2)
          error('The matrix D and the starting configuration Y should have the same number of columns.');
        end
        winit = [];
        y = +y(I,:);
      end

      % The final number of true distances is:
      no_dist = (ni*(ni-1) - length(opt.nanid))/2;

    else

      % This happens only if we add extra points to an existing MDS map.
      % Remove identical points, i.e. points for which D(i,j) = 0 for i ~= j.
      % I contains the indices of points left for the MDS mapping, J those
      % of the removed points and P those of the points left in I which were
      % identical to those removed.

      [I,J,P] = mds_reppoints(D(:,II));
      D = D(I,II);
      [ni,nc] = size(D);
      yrep = yrep(II,:);
      n = size(yrep,2);

      % NANID is an extra field in the OPTIONS structure, containing the indices
      % of NaN values (= missing values) in distance matrix D.

      opt.nanid = find(isnan(D(:)));

      % Initialise Y. if the new points should be added in an iterative manner.

      [m2,n] = size(yrep);
      if (~isempty(yinit))             % An initial configuration exists.
        y = yinit;
      elseif (strcmp(opt.init, 'cs')) & (~isempty(winit))
        y = D*winit;
      else
        y = mds_init(D,n,opt.init);
      end

      if (~isempty(opt.nanid))         % Rescale.
        scale = (max(yrep)-min(yrep))./(max(y)-min(y));
        y = y .* repmat(scale,ni,1);
      end

      % The final number of true distances is:
      no_dist = (ni*nc - length(opt.nanid));
    end

    % Check whether there is enough data left.

    if (~isempty(opt.nanid))
      if (n*ni+2 > no_dist),
        error('There are too many missing distances: it is not possible to determine the MDS map.');
      end
      if (strcmp (opt.itmap,'no'))
        opt.itmap = 'yes';
        prwarning(1,'Due to the missing values, the projection can only be iterative. OPTIONS are changed appropriately.')
      end
    end

    if (opt.inspect > 0)
      opt.plotlab = lab(I,:);  % Labels to be used for plotting in MDS_SAMMAP.
    else
      opt.plotlab = [];
    end

    if (isempty(yrep)) | (~isempty(yrep) & strcmp(opt.itmap, 'yes'))

      % Either no MDS exists yet OR new points should be mapped in an iterative manner.

      printinfo(opt);
      [yy,err] = mds_sammap(D,y,yrep,opt);

      % Define the linear projection of distances.

      v = [];
      if (isempty(yrep)) & (isempty(opt.nanid))
        if (rank(D) < m)
          v = prpinv(D)*yy;
        else
          v = D \ yy;
        end
      end
    else
      % New points should be added by a linear projection of dissimilarity data.
      yy = D*v;
    end

    % Establish the projected configuration including the removed points.

    y = zeros(m,n); y(I,:) = +yy;
    if (~isempty(J))
      if (~isempty(yrep))
        y(J,:) = +yrep(II(P),:);
      else
        for k=length(J):-1:1        % J: indices of removed points.
          y(J(k),:) = y(P(k),:);    % P: indices of points equal to points in J.
        end
      end
    end

    % In the definition step: shift the obtained configuration such that the
    % mean lies at the origin.

    if (isempty(yrep))
      y = y - ones(length(y),1)*mean(y);
      y = prdataset(y,lab);
    else
      w = prdataset(y,lab);
      return;
    end

    % In the definition step: the mapping should be stored.

    opt = rmfield(opt,'nanid');   % These fields are to be used internally only;
    opt = rmfield(opt,'plotlab'); % not to be set up from outside
    w   = prmapping(mfilename,'trained',{y,opt,I,winit,v,[]},[],m,n);
    w   = setname(w,mapname);

  end

return

% **********************************************************************************
%                             Extra functions
% **********************************************************************************

% PRINTINFO(OPT)
%
% Prints progress information to the file handle given by OPT.ST.

function printinfo(opt)

  if opt.st < 1
    return
  end
  %fprintf(opt.st,'Sammon mapping, error function with the parameter q=%d\n',opt.q);

  switch (opt.optim)
    case 'pn',
      %fprintf(opt.st,'Minimization by Pseudo-Newton algorithm\n');
    case 'scg',
      %fprintf(opt.st,'Minimization by Scaled Conjugate Gradients algorithm\n');
    otherwise
      error(strcat('Possible initialization methods: pn (Pseudo-Newton), ',...
                   'or scg (Scaled Conjugate Gradients).'));
  end

return

% **********************************************************************************

% [I,J,P] = MDS_REPPOINTS(D)
%
% Finds the indices of repeated/left points. J contains the indices of
% repeated points in D. This means that for each j in J, there is a point
% k ~= j such that D(J(j),k) = 0. I contains the indices of the remaining
% points, and P those of the points in I that were identical to those in J.
% Directly used in MDS routine.

function [I,J,P] = mds_reppoints(D)

  epsilon = 1e-20;      % Differences smaller than this are assumed to be zero.

  [m,mm] = size(D);

  I = 1:m; J = []; P = [];

  if (m == mm) & (all(abs(D(1:m+1:end)) <= epsilon))
    K = intersect (find (triu(ones(m),1)), find(D < epsilon));
    if (~isempty(K))
      P = mod(K,m);
      J = fix(K./m) + 1;
      I(J) = [];
    end
  else
    [J,P] = find(D<=epsilon);
    I(J)  = [];
  end

return;

% **********************************************************************************

% MDS_SETOPT  Sets parameters for the MDS mapping
%
%   OPT = MDS_SETOPT(OPT_GIVEN)
%
% INPUT
%   OPT_GIVEN Parameters for the MDS mapping, described below (default: [])
%
% OUTPUT
%   OPT       Structure of chosen options; if OPT_GIVEN is empty, then
%               OPT.q       = 0
%               OPT.optim   = 'pn'
%               OPT.init    = 'cs'
%               OPT.etol    = 1e-6 (the precise value depends on q)
%               OPT.maxiter = 100
%               OPT.itmap   = 'yes'
%               OPT.isratio = 0
%               OPT.st      = 1
%               OPT.inspect = 2
%
% DESCRIPTION
% Parameters for the MDS mapping can be set or changed. OPT_GIVEN consists
% of the following fields: 'q', 'init', 'optim', 'etol', 'maxiter','itmap',
% 'isratio', 'st' and 'inspect'. OPTIONS can include all the fields or some
% of them only. The fields of OPT have some default values, which can be
% changed by the OPT_GIVEN field values. If OPT_GIVEN is empty, then OPT
% contains all default values. For a description of the fields, see MDS.

%
% Copyright: Elzbieta Pekalska, ela@ph.tn.tudelft.nl, 2000-2003
% Faculty of Applied Sciences, Delft University of Technology
%

function opt = mds_setopt (opt_given)

  opt.q       = 0;
  opt.init    = 'cs';
  opt.optim   = 'pn';
  opt.st      = 1;
  opt.itmap   = 'yes';
  opt.maxiter = 100;
  opt.inspect = 2;
  opt.etol    = inf;
  opt.isratio = 0;
  opt.nanid   = [];    % Here are some extra values; set up in the MDS routine.
  opt.plotlab = [];    % Not to be changed by the user.

  if (~isempty(opt_given))
    if (~isstruct(opt_given))
      error('OPTIONS should be a structure with at least one of the following fields: q, init, etol, optim, maxiter, itmap, isratio, st or inspect.');
    end
    fn = fieldnames(opt_given);
    if (~all(ismember(fn,fieldnames(opt))))
      error('Wrong field names; valid field names are: q, init, optim, etol, maxiter, itmap, isratio, st or inspect.')
    end
    for i = 1:length(fn)
      opt = setfield(opt,fn{i},getfield(opt_given,fn{i}));
    end
  end

  if (isempty(intersect(opt.q,-2:1:2)))
    error ('OPTIONS.q should be -2, -1, 0, 1 or 2.');
  end

  if (opt.maxiter < 2)
    error ('OPTIONS.iter should be at least 1.');
  end

  if (isinf(opt.etol))
    switch (opt.q)                 % Different defaults for different stresses.
      case -2,
        opt.etol = 1e-6;
      case {-1,0}
        opt.etol = 10*sqrt(eps);
      case {1,2}
        opt.etol = sqrt(eps);
      end
  elseif (opt.etol <= 0) | (opt.etol >= 0.1)
    error ('OPTIONS.etol should be positive and smaller than 0.1.');
  end

  if (~ismember(opt.optim, {'pn','scg'}))
    error('OPTIONS.optim should be pn or scg.');
  end

  if (~ismember(opt.itmap, {'yes','no'}))
    error('OPTIONS.itmap should be yes or no.');
  end

return

% MDS_SAMMAP Sammon iterative nonlinear mapping for MDS
%
%   [YMAP,ERR] = MDS_SAMMAP(D,Y,YREP,OPTIONS)
%
% INPUT
%   D       Square (M x M) dissimilarity matrix
%   Y       M x N matrix containing starting configuration, or
%   YREP    Configuration of the representation points
%   OPTIONS Various parameters of the  minimization procedure put into
%           a structure consisting of the following fields: 'q', 'optim',
%           'init','etol','maxiter', 'isratio', 'itmap', 'st' and 'inspect'
%           (default:
%             OPTIONS.q       = 0
%             OPTIONS.optim   = 'pn'
%             OPTIONS.init    = 'cs'
%             OPTIONS.etol    = 1e-6 (the precise value depends on q)
%             OPTIONS.maxiter = 100
%             OPTIONS.isratio = 0
%             OPTIONS.itmap   = 'yes'
%             OPTIONS.st      = 1
%             OPTIONS.inspect = 2).
%
% OUTPUT
%   YMAP     Mapped configuration
%   ERR     Sammon stress
%
% DESCRIPTION
% Maps the objects given by a symmetric distance matrix D (with a zero
% diagonal) onto, say, an N-dimensional configuration YMAP by an iterative
% minimization of a variant of the Sammon stress. The minimization starts
% from the initial configuration Y; see MDS_INIT.
%
% YREP is the Sammon configuration of the representation set. It is used
% when new points have to be projected. In other words, if D is an M x M
% symmetric distance matrix, then YREP is empty; if D is an M x N matrix,
% then YMAP is sought such that D can approximate the distances between YMAP
% and YREP.
%
% Missing values can be handled by marking them by NaN in D.
%
% SEE ALSO (PRTools Guide)
% MAPPINGS, MDS, MDS_CS, MDS_INIT, MDS_SETOPT

%
% Copyright: Elzbieta Pekalska, ela@ph.tn.tudelft.nl, 2000-2003
% Faculty of Applied Sciences, Delft University of Technology
%

function [y,err] = mds_sammap(Ds,y,yrep,opt)

  if (nargin < 4)
    opt = [];                 % Will be filled by MDS_SETOPT, below.
  end
  if isempty(opt), opt = mds_setopt(opt); end
  if (nargin < 3)
    yrep = [];
  end

  % Extract labels and calculate distance matrix.

  [m,n] = size(y);
  if (~isempty(yrep))
    replab = getlab(yrep);
    yrep = +yrep;
    D = sqrt(distm(y,yrep));
  else
    D = sqrt(distm(y));
    yrep = [];
    replab = [];
  end

%   if (isempty(opt.plotlab))
%     opt.plotlab = ones(m,1);
%   end

  it   = 0;           % Iteration number.
  eold = inf;         % Previous stress (error).

  % Calculate initial stress.

  [e,a]= mds_samstress(opt.q,y,yrep,Ds,D,opt.nanid,opt.isratio); err = e;

  %if opt.st > 0, fprintf(opt.st,'iteration: %4i   stress: %3.8d\n',it,e); end

  tt = sprintf('Processing %i iterations: ',opt.maxiter);
  prwaitbar(opt.maxiter,tt)

  switch (opt.optim)
    case 'pn',        % Pseudo-Newton minimization.

      epr   = e;      % Previous values of E, EOLD for line search algorithm.
      eepr  = e;
      add   = 1e-4;   % Avoid G2 equal 0; see below.

      BETA   = 1e-3;   % Parameter for line search algorithm.
      lam1   = 0;
      lam2   = 1;      % LAM (the step factor) lies in (LAM1, LAM2).
      LMIN   = 1e-10;  % Minimum acceptable value for LAM in line search.
      lambest = 1e-4; % LAM = LAMBEST, if LAM was not found.

      % Loop until the error change falls below the tolerance or until
      % the maximum number of iterations is reached.

      while (abs(e-eold) >= opt.etol*(1 + abs(e))) & (it < opt.maxiter)

        % Plot progress if requested.

%        if (opt.st > 0) & (opt.inspect > 0) & (mod(it,opt.inspect) == 0)
%          if (it == 0), figure(1); clf; end
%          mds_plot(y,yrep,opt.plotlab,replab,e);
%        end

        yold = y; eold = e;

        % Calculate the stress.

        [e,a]      = mds_samstress (opt.q,yold,yrep,Ds,[],opt.nanid,opt.isratio);

        % Calculate gradients and pseudo-Newton update P.

        [g1,g2,cc] = mds_gradients (opt.q,yold,yrep,a*Ds,[],opt.nanid);
        p        = (g1/cc)./(abs(g2/cc) + add);
        slope    = g1(:)' * p(:);

        lam = 1;

        % Search for a suitable step LAM using a line search.

        while (1)

          % Take a step and calculate the delta error DE.

          y      = yold + lam .* p;
          [e,a]  = mds_samstress(opt.q,y,yrep,Ds,[],opt.nanid,opt.isratio);
          de     = e - eold;

          % Stop if the condition for a suitable lam is fulfilled.

          if (de < BETA * lam * slope)
            break;
          end

          % Try to find a suitable step LAM.

          if (lam ~= 1)
            r1 = de - lam*slope;
            r2 = epr - eepr - lam2*slope;
            aa = (2*de + r1/lam^2 - r2/lam2^2)/(lam2-lam1)^3;
            bb = ((-lam2*r1)/lam^2 +(lam*r2)/lam2^2)/(lam2-lam1)^2;

            if (abs(aa) <= eps)
              lamtmp = -0.5 * slope/bb;
            else
              lamtmp = (-bb + sqrt(max(0,(bb^2 - 3*aa*slope))))/(3*aa);
            end

            % Prevent LAM from becoming too large.

            if (lamtmp > 0.5 * lam), lamtmp = 0.5 * lam; end

          else
            lamtmp = -0.5 * slope/(e - eold - slope);
          end

          % Prevent LAM from becoming too small.

          lam2 = lam;
          lam  = max(lamtmp, 0.1*lam);
          epr  = e;
          eepr = eold;

          if (lam < LMIN)
            y = yold + lambest .* p;
            [e,a] = mds_samstress(opt.q,y,yrep,Ds,[],opt.nanid,opt.isratio);
            break;
          end
        end

        it  = it + 1;
        err = [err; e];

        prwaitbar(opt.maxiter,it,[tt num2str(it) ', error: ' num2str(e)]);
        %if opt.st > 0, fprintf(opt.st,'iteration: %4i   stress: %3.8d\n',it,e); end

      end

    case 'scg',              % Scaled Conjugate Gradient minimization.

      sigma0  = 1e-8;
      lambda  = 1e-8;       % Regularization parameter.
      lambda1 = 0;

      % Calculate initial stress and direction of decrease P.

      [e,a]   = mds_samstress(opt.q,y,yrep,Ds,D,opt.nanid,opt.isratio);
      g1      = mds_gradients(opt.q,y,yrep,a*Ds,D,opt.nanid);   % Gradient
      p       = -g1;                                            % Direction of decrease
      gnorm2  = g1(:)' * g1(:);
      success = 1;

      % Sanity check.

      if (gnorm2 < 1e-15)
        prwarning(2,['Gradient is nearly zero: ' gnorm2 ' (unlikely); initial configuration is the right one.']);
        return
      end

      % Loop until the error change falls below the tolerance or until
      % the maximum number of iterations is reached.

      while (abs(eold - e) > opt.etol * (1 + e)) & (it < opt.maxiter)

        g0     = g1;            % Previous gradient
        pnorm2 = p(:)' * p(:);
        eold   = e;

        % Plot progress if requested.

%        if (opt.inspect > 0) & (mod(it,opt.inspect) == 0)
%          if (it == 0), figure(1); clf; end
%          mds_plot(y,yrep,opt.plotlab,replab,e);
%        end

        if (success)
          sigma = sigma0/sqrt(pnorm2);      % SIGMA: a small step from y to yy
          yy    = y + sigma .*p;
          [e,a] = mds_samstress(opt.q,yy,yrep,Ds,[],opt.nanid,opt.isratio);
          g2    = mds_gradients(opt.q,yy,yrep,a*Ds,[],opt.nanid); % Gradient for yy
          s     = (g2-g1)/sigma;        % Approximation of Hessian*P directly, instead of computing
          delta = p(:)' * s(:);         % the Hessian, since only DELTA = P'*Hessian*P is in fact needed
        end

        % Regularize the Hessian indirectly to make it positive definite.
        % DELTA is now computed as P'* (Hessian + regularization * Identity) * P
        delta = delta + (lambda1 - lambda) * pnorm2;

        % Indicate if the Hessian is negative definite; the regularization above was too small.
        if (delta < 0)
          lambda1 = 2 * (lambda - delta/pnorm2);  % Now the Hessian will be positive definite
          delta   = -delta + lambda * pnorm2;     % This is obtained after plugging lambda1
          lambda  = lambda1;                      % into the formulation a few lines above.
        end

        mi = - p(:)' * g1(:);
        yy = y + (mi/delta) .*p;                  % mi/delta is a step size
        [ee,a] = mds_samstress(opt.q,yy,yrep,Ds,[],opt.nanid,opt.isratio);

        % This minimization procedure is based on the second order approximation of the
        % stress function by using the gradient and the Hessian approximation. The Hessian
        % is regularized, but maybe not sufficiently. The ratio Dc (<=1) below indicates
        % a proper approximation, if Dc is close to 1.

        Dc = 2 * delta/mi^2 * (e - ee);
        e  = ee;

        % If Dc > 0, then the stress can be successfully decreased.
        success = (Dc >= 0);
        if (success)
          y       = yy;
          [ee,a]  = mds_samstress(opt.q,yy,yrep,Ds,[],opt.nanid,opt.isratio);
          g1      = mds_gradients(opt.q,yy,yrep,a*Ds,[],opt.nanid);
          gnorm2  = g1(:)' * g1(:);
          lambda1 = 0;

          beta = max(0,(g1(:)'*(g1(:)-g0(:)))/mi);
          p   = -g1 + beta .* p;                 % P is a new conjugate direction

          if (g1(:)'*p(:) >= 0 | mod(it-1,n*m) == 0),
            p = -g1;                            % No much improvement, restart
          end

          if (Dc >= 0.75)
            lambda = 0.25 * lambda;             % Make the regularization smaller
          end

          it  = it + 1;
          err = [err; e];
          prwaitbar(opt.maxiter,it,[tt num2str(it) ', error: ' num2str(e)]);
          %fprintf (opt.st,'iteration: %4i   stress: %3.8d\n',it,e);

        else        % Dc < 0
          % Note that for Dc < 0, the iteration number IT is not increased,
          % so the Hessian is further regularized until SUCCESS equals 1.
          lambda1 = lambda;
        end

      % The approximation of the Hessian was poor or the stress was not
      % decreased (Dc < 0), hence the regularization lambda is enlarged.
      if (Dc < 0.25)
        lambda = lambda + delta * (1 - Dc)/pnorm2;
      end
    end
  end
  prwaitbar(0);

return

% **********************************************************************************

%MDS_STRESS - Calculate Sammon stress during optimization
%
%   E = MDS_SAMSTRESS(Q,Y,YREP,Ds,D,NANINDEX)
%
% INPUT
%   Q         Indicator of the Sammon stress; Q = -2,-1,0,1,2
%   Y         Current lower-dimensional configuration
%   YREP      Configuration of the representation objects; it should be
%             empty when no representation set is considered
%   Ds        Original distance matrix
%   D         Approximate distance matrix (optional; otherwise computed from Y)
%   NANINDEX  Index of the missing values; marked in Ds by NaN (optional; to
%             be found in Ds)
%
% OUTPUT
%   E         Sammon stress
%
% DESCRIPTION
% Computes the Sammon stress between the original distance matrix Ds and the
% approximated distance matrix D between the mapped configuration Y and the
% configuration of the representation set YREP, expressed as follows:
%
% E = 1/(sum_{i<j} Ds_{ij}^(q+2)) sum_{i<j} (Ds_{ij} - D_{ij})^2 * Ds_{ij}^q
%
% It is directly used in the MDS_SAMMAP routine.

%
% Copyright: Elzbieta Pekalska, Robert P.W. Duin, ela@ph.tn.tudelft.nl, 2000-2003
% Faculty of Applied Sciences, Delft University of Technology
%

function [e,alpha] = mds_samstress (q,y,yrep,Ds,D,nanindex,isratio)

  % If D is not given, calculate it from Y, the current mapped points.

  if (nargin < 5) | (isempty(D))
    if (~isempty(yrep))
      D = sqrt(distm(y,yrep));
    else
      D = sqrt(distm(y));
    end
  end

  if (nargin < 6)
    nanindex = [];    % Not given, so calculate below.
  end

  if (nargin < 7)
    isratio = 0;      % Assume this is meant.
  end

  todefine = isempty(yrep);

  [m,n]  = size(y); [mm,k] = size(Ds);
  if (m ~= mm)
    error('The sizes of Y and Ds do not match.');
  end
  if (any(size(D) ~= size(Ds)))
    error ('The sizes of D and Ds do not match.');
  end
  m2 = m*k;

  % Convert to double.
  D  = +D; Ds = +Ds;

  % I is the index of non-NaN, non-zero (> eps) values to be included
  % for the computation of the stress.

  I = 1:m2;
  if (~isempty(nanindex))
    I(nanindex) = [];
  end

  O = [];
  if (todefine), O = 1:m+1:m2; end
  I = setdiff(I,O);

  % If OPTIONS.isratio is set, calculate optimal ALPHA to scale with.

  if (isratio)
    alpha = sum((Ds(I).^q).*D(I).^2)/sum((Ds(I).^(q+1)).*D(I));
    Ds    = alpha*Ds;
  else
    alpha = 1;
  end

  % C is the normalization factor.
  c = sum(Ds(I).^(q+2));

  % If Q == 0, prevent unnecessary calculation (X^0 == 1).
  if (q ~= 0)
    e = sum(Ds(I).^q .*((Ds(I)-D(I)).^2))/c;
  else
    e = sum(((Ds(I)-D(I)).^2))/c;
  end

return

% **********************************************************************************

%MDS_GRADIENTS - Gradients for variants of the Sammon stress
%
%   [G1,G2,CC] = MDS_GRADIENTS(Q,Y,YREP,Ds,D,NANINDEX)
%
% INPUT
%   Q          Indicator of the Sammon stress; Q = -2,-1,0,1,2
%   Y         Current lower-dimensional configuration
%   YREP      Configuration of the representation objects; it should be
%             empty when no representation set is considered
%   Ds        Original distance matrix
%   D         Approximate distance matrix (optional; otherwise computed from Y)
%   nanindex  Index of missing values; marked in Ds by NaN (optional;
%             otherwise found from Ds)
%
% OUTPUT
%   G1        Gradient direction
%   G2        Approximation of the Hessian by its diagonal
%
% DESCRIPTION
% This is a routine used directly in the MDS_SAMMAP routine.
%
% SEE ALSO (PRTools Guide)
% MDS, MDS_INIT, MDS_SAMMAP, MDS_SAMSTRESS

%
% Copyright: Elzbieta Pekalska, Robert P.W. Duin, ela@ph.tn.tudelft.nl, 2000-2003
% Faculty of Applied Sciences, Delft University of Technology
%

function [g1,g2,c] = mds_gradients(q,y,yrep,Ds,D,nanindex)

  % If D is not given, calculate it from Y, the current mapped points.

	y = +y;
	yrep = +yrep;
  if (nargin < 5) | (isempty(D))
    if (~isempty(yrep))
      D = sqrt(distm(y,yrep));
    else
      D = sqrt(distm(y));
    end
  end

  % If NANINDEX is not given, find it from Ds.

  if (nargin < 6)
    nanindex = find(isnan(Ds(:))==1);
  end

  % YREP is empty if no representation set is defined yet.
  % This happens when the mapping should be defined.

  todefine = (isempty(yrep));
  if (todefine)
    yrep  = y;
  end

  [m,n]  = size(y); [mm,k] = size(Ds);
  if (m ~= mm)
    error('The sizes of Y and Ds do not match.');
  end
  if (any(size(D) ~= size(Ds)))
    error ('The sizes of D and Ds do not match.');
  end
  m2 = m*k;

  % Convert to doubles.

  D  = +D; Ds = +Ds;

  % I is the index of non-NaN, non-zero (> eps) values to be included
  % for the computation of the gradient and the Hessians diagonal.

  I = (1:m2)';
  if (~isempty(nanindex))
    I(nanindex) = [];
  end
  K    = find(Ds(I) <= eps | D(I) <= eps);
  I(K) = [];

  % C is a normalization factor.

  c = -2/sum(Ds(I).^(q+2));

  % Compute G1, the gradient.

  h1 = zeros(m2,1);
  if (q == 0)                    % Prevent unnecessary computation when Q = 0.
    h1(I) = (Ds(I)-D(I)) ./ D(I);
  else
    h1(I) = (Ds(I)-D(I)) ./ (D(I).*(Ds(I).^(-q)));
  end
  h1 = reshape (h1',m,k);
  g2 = h1 * ones(k,n);          % Here G2 is assigned only temporarily,
  g1 = c * (g2.*y - h1*yrep);    % for the computation of G1.

  % Compute G2, the diagonal of the Hessian, if requested.

  if (nargout > 1)
    h2 = zeros(m2,1);
    switch (q)
      case -2,
        h2(I) = -1./(Ds(I).*D(I).^3);
      case -1,
        h2(I) = -1./(D(I).^3);
      case 0,
        h2(I) = - Ds(I)./(D(I).^3);
      case 1,
        h2(I) = - Ds(I).^2./(D(I).^3);
      case 2,
        h2(I) = -(Ds(I)./D(I)).^3;
      end
    h2 = reshape (h2',m,k);
    g2 = c * (g2 + (h2*ones(k,n)).*y.^2 + h2*yrep.^2 - 2*(h2*yrep).*y);
  end

return


% function [ARSignal StatWT] = WaveletAnalysis(StatWT,L,wavename,iqr,SignalLength)
%
%
% Perform a wavelet motion correction of the dod data and computes the
% distribution of the wavelet coefficients. It sets the coefficient
% exceeding iqr times the interquartile range to zero, because these are probably due
% to motion artifacts. It applies the inverse discrete wavelet transform and
% reconstruct the signal.
%
% The algorithm follows in part the procedure described by
% Molavi et al.,Physiol Meas, 33, 259-270 (2012).
%
% INPUTS:
% StatWT:       matrix of wavelet coefficients (# of time points x # of
%               levels+1). The first column contains the approximation
%               coefficients, while the other all the details coefficients at
%               different levels
% L:            Lowest wavelet scale used in the analysis
% wavename:     name of the wavelet used in the reconstruction, should be the
%               same used in the previous decomposition
% iqr:          parameter used to compute the statistics (iqr = 1.5 means 1.5 times the
%               interquartile range and is usually used to detect outliers).
%               Increasing it, it will delete less coefficients.
% SignalLength: Length of the original signal before zero padding
%
%
% OUTPUTS:
% ARSIgnal:     signal reconstructed after the discrete inverse wavelet transform
%               and corrected for motion artifacts.
% StatWT:       matrix of wavelet coefficients corrected for motion
%               artifacts. Same size as StatWT input
%
% LOG:
% Script by Behnam Molavi bmolavi@ece.ubc.ca adapted for Homer2 by RJC
% modified 10/17/2012 by S. Brigadoi

function [ARSignal,StatWT]  = WaveletAnalysis(StatWT,L,wavename,iqr,SignalLength)

n=size(StatWT,1);       % Length of data vector with zero padding
N=log2(size(StatWT,1)); % Finest scale (original signal)
SignalLength_tmp = SignalLength;

for j=1:N-L-1
    SignalLength_tmp = fix(SignalLength_tmp/2);
    n_blocks = 2^j; % number of blocks in the level
    l_blocks = n/n_blocks; % length of the blocks in the level
    for b=0:(2^j-1)
        sr = StatWT(b*l_blocks+1:b*l_blocks+l_blocks,j+1);

        sr_temp = sr(1:SignalLength_tmp); % compute statistics only on original data
        quants = quantile(sr_temp,[.25 .50 .75]);  % compute quantiles
        IQR = quants(3)-quants(1);  % compute interquartile range
        prob1 = quants(3)+IQR*iqr;
        prob2 = quants(1)-IQR*iqr;
        outliers_1 = find(sr>prob1);
        outliers_2 = find(sr<prob2);
        outliers = [outliers_1' outliers_2'];
        sr(outliers) = 0;  % set outliers to 0
        StatWT(b*l_blocks+1:b*l_blocks+l_blocks,j+1) = sr;
    end
end
ARSignal=IWT_inv(StatWT,wavename);  % reconstruct the signal with the discrete inverse wavelet transform


function [V] = GNMFtest(U, X)
% Graph regularized Non-negative Matrix Factorization (GNMF) handling the test data
%
% Notation:
% X ... (mFea x nSmp) data matrix
%       mFea  ... number of words (vocabulary size)
%       nSmp  ... number of documents
% U ... (mFea x K) basis matrix learned by GNMF.
%
% X = U*V'
%
% References:
% [1] Deng Cai, Xiaofei He, Xiaoyun Wu, and Jiawei Han. "Non-negative
% Matrix Factorization on Manifold", Proc. 2008 Int. Conf. on Data Mining
% (ICDM'08), Pisa, Italy, Dec. 2008.
%
% [2] Deng Cai, Xiaofei He, Jiawei Han, Thomas Huang. "Graph Regularized
% Non-negative Matrix Factorization for Data Representation", IEEE
% Transactions on Pattern Analysis and Machine Intelligence, , Vol. 33, No.
% 8, pp. 1548-1560, 2011.
%
%
%   version 1.0 --Jan./2012
%
%   Written by Deng Cai (dengcai AT gmail.com)
%

if min(min(X)) < 0
    error('Input should be nonnegative!');
end

UTU = U'*U;
UTU = max(UTU,UTU');
UTX = U'*X;
V = max(0,UTU\UTX);
V = V';


function varargout = createCube()
%CREATECUBE Create a 3D mesh representing the unit cube.
%
%   [V, E, F] = createCube
%   Create a unit cube, as a polyhedra representation.
%   c has the form [V E F], where V is a 8-by-3 array with vertices
%   coordinates, E is a 12-by-2 array containing indices of neighbour
%   vertices, and F is a 6-by-4 array containing vertices array of each
%   face.
%
%   [V, F] = createCube;
%   Returns only the vertices and the face vertex indices.
%
%   MESH = createCube;
%   Returns the data as a mesh structure, with fields 'vertices', 'edges'
%   and 'faces'.
%
%   Example
%   [n, e, f] = createCube;
%   drawMesh(n, f);
%
%   See also
%   meshes3d, drawMesh
%   createOctahedron, createTetrahedron, createDodecahedron
%   createIcosahedron, createCubeOctahedron
%

% ------
% Author: David Legland
% E-mail: david.legland@inra.fr
% Created: 2005-02-10
% Copyright 2005-2022 INRA - TPV URPOI - BIA IMASTE

x0 = 0; dx= 1;
y0 = 0; dy= 1;
z0 = 0; dz= 1;

nodes = [...
    x0 y0 z0; ...
    x0+dx y0 z0; ...
    x0 y0+dy z0; ...
    x0+dx y0+dy z0; ...
    x0 y0 z0+dz; ...
    x0+dx y0 z0+dz; ...
    x0 y0+dy z0+dz; ...
    x0+dx y0+dy z0+dz];

edges = [1 2;1 3;1 5;2 4;2 6;3 4;3 7;4 8;5 6;5 7;6 8;7 8];

% faces are oriented such that normals point outwards
faces = [1 3 4 2;5 6 8 7;2 4 8 6;1 5 7 3;1 2 6 5;3 7 8 4];

% format output
varargout = formatMeshOutput(nargout, nodes, edges, faces);


% Given a set of nonnegative vectors x{i}, i=1,2,...,r
%
% Compute the function g(mu) = sum_i beta_i [ e^T x_i(mu) ]
% where
% beta_i = 1/[ ||w{i}|| - min_j w{i}(j) ], and
% If x{i} - beta_i mu w{i} contains at least one postive entry:
%      x_i(mu) = (x{i} - beta_i mu w{i})_+;
%      x_i(mu) = x_i(mu)/||x_i(mu)||_2;
% Otherwise
%     x_i(mu) is 1-sparse with nonzero entry equal to one at position
%     corresponding to the largest entry of x{i} - beta_i mu w{i}

function [vgmu,xp,gradg] = wgmu(x,w,mu);

vgmu = 0;
gradg = 0;
for i = 1 : length(x)
    ni = length(x{i});
    betai = 1/(norm(w{i})-min(w{i}));
    xp{i} = x{i} - mu*betai*w{i};
    indtp = find(xp{i} > 0);
    % Gradient g(mu)
    if ~isempty(indtp)
        xp{i} = max(0,xp{i});
        f2 = norm(xp{i});
        if nargout >= 3
            nip = w{i}(indtp)'*w{i}(indtp);

            gradg = gradg + betai^2 * ( - nip * f2^(-1) ...
                + (w{i}(indtp)'*xp{i}(indtp))^2 * f2^(-3)  );
        end
        xp{i} = xp{i}/norm(xp{i},2);
        vgmu = vgmu + betai*sum(xp{i}.*w{i});
    else
        [~,im] = max(xp{i});
        xp{i} = zeros( ni , 1 );
        xp{i}(im) = 1;
        vgmu = vgmu + betai*w{i}(im);
    end
end


classdef Skewness < Algorithm

    methods (Access = public)

        function obj = Skewness()
            obj.name = 'Skewness';
            obj.inputPort = DataType.kSignal;
            obj.outputPort = DataType.kFeature;
        end

        function result = compute(~,signal)
            %meanAlgorithm = dsp.Mean('RunningMean',false,'Dimension','All');
            %signalMean = step(meanAlgorithm,signal);
            signalMean = mean(signal);

            n = single(length(signal));

            upper = single(0);
            lower = single(0);
            for i = 1 : n
                temp = single(signal(i) - signalMean);
                temp2 = single(temp * temp);
                upper = upper + temp2 * temp;
                lower = lower + temp2;
            end
            lower = lower / n;
            result = upper / (n * lower^1.5);
        end

        function metrics = computeMetrics(~,input)
            n = size(input,1);
            flops = 6 * n;
            memory = 1;
            outputSize = Constants.kFeatureBytes;
            metrics = Metric(flops,memory,outputSize);
        end
    end

end


function [Mreordered,Mindices,cost] = reorder_matrix(M1,cost,flag)
%REORDER_MATRIX         matrix reordering for visualization
%
%   [Mreordered,Mindices,cost] = reorder_matrix(M1,cost,flag)
%
%   This function rearranges the nodes in matrix M1 such that the matrix
%   elements are squeezed along the main diagonal.  The function uses a
%   version of simulated annealing.
%
%   Inputs:     M1             = connection matrix (weighted or binary,
%                                directed or undirected)
%               cost           = 'line' or 'circ', for shape of lattice
%                                cost (linear or ring lattice)
%
%               Mreordered     = reordered connection matrix
%               Mindices       = reordered indices
%               cost           = distance between M1 and Mreordered
%
%   Note that in general, the outcome will depend on the initial condition
%   (the setting of the random number seed).  Also, there is no good way to
%   determine optimal annealing parameters in advance - these paramters
%   will need to be adjusted "by hand" (particularly H, Texp, and T0).
%   For large and/or dense matrices, it is highly recommended to perform
%   exploratory runs varying the settings of 'H' and 'Texp' and then select
%   the best values.
%
%   Based on extensive testing, it appears that T0 and Hbrk can remain
%   unchanged in most cases.  Texp may be varied from 1-1/H to 1-10/H, for
%   example.  H is the most important parameter - set to larger values as
%   the problem size increases.  It is advisable to run this function
%   multiple times and select the solution(s) with the lowest 'cost'.
%
%   Setting 'Texp' to zero cancels annealing and uses a greedy algorithm
%   instead.
%
%   Yusuke Adachi, University of Tokyo 2010
%   Olaf Sporns, Indiana University 2010

N = size(M1,1);

% generate cost function
if (strcmp(cost,'line'))
    profil = fliplr(normpdf(1:N,0,N/2));
end;
if (strcmp(cost,'circ'))
    profil = fliplr(normpdf(1:N,N/2,N/4));
end;
COST = (toeplitz(profil,profil).*~eye(N));
COST = COST./sum(sum(COST));

% establish maxcost, lowcost, mincost
maxcost = sum(sort(COST(:)).*(sort(M1(:))));
lowcost = sum(sum(M1.*COST))/maxcost;
mincost = lowcost;

% initialize
anew = 1:N;
amin = 1:N;
h = 0; hcnt = 0;

% set annealing parameters
% H determines the maximal number of steps
% Texp determines the steepness of the temperature gradient
% T0 sets the initial temperature (and scales the energy term)
% Hbrk sets a break point for the simulation (if no further improvement)
H = 1e04; Texp = 1-10/H; T0 = 1e-03; Hbrk = H/10;
%Texp = 0;

while h<H
    h = h+1; hcnt = hcnt+1;
    % terminate if no new mincost has been found for some time
    if (hcnt>Hbrk)
        break;
    end;
    % current temperature
    T = T0*Texp^h;
    % choose two positions at random and flip them
    atmp = anew;
    %r = randperm(N);  % slower
    r = ceil(rand(1,2).*N);
    atmp(r(1)) = anew(r(2));
    atmp(r(2)) = anew(r(1));
    costnew = sum(sum(M1(atmp,atmp).*COST))/maxcost;
    % annealing
    if (costnew < lowcost) || (rand < exp(-(costnew-lowcost)/T))
        anew = atmp;
        lowcost = costnew;
        % is this a new absolute best?
        if (lowcost<mincost)
            amin = anew;
            mincost = lowcost;
            if (flag==1)
                disp(['step ',num2str(h),' ... current lowest cost = ',num2str(mincost)]);
            end;
            hcnt = 0;
        end;
    end;
end;
disp(['step ',num2str(h),' ... final lowest cost = ',num2str(mincost)]);

% prepare output
Mreordered = M1(amin,amin);
Mindices = amin;
cost = mincost;


% Copyright (C) 2012 Rik Wehbring
% Copyright (C) 1995-2012 Kurt Hornik
%
% This file is part of Octave.
%
% Octave is free software; you can redistribute it and/or modify it
% under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 3 of the License, or (at
% your option) any later version.
%
% Octave 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 Octave; see the file COPYING.  If not, see
% <http://www.gnu.org/licenses/>.

% -*- texinfo -*-
% @deftypefn {Function File} {} finv (@var{x}, @var{m}, @var{n})
% For each element of @var{x}, compute the quantile (the inverse of
% the CDF) at @var{x} of the F distribution with @var{m} and @var{n}
% degrees of freedom.
% @end deftypefn

% Author: KH <Kurt.Hornik@wu-wien.ac.at>
% Description: Quantile function of the F distribution

function inv = finv (x, m, n)

if (nargin ~= 3)
  print_usage ();
end

if (~isscalar (m) || ~isscalar (n))
  [retval, x, m, n] = common_size (x, m, n);
  if (retval > 0)
    error ('finv: X, M, and N must be of common size or scalars');
  end
end

if ~(isreal (x) || isreal (m) || isreal (n))
  error ('finv: X, M, and N must not be complex');
end

if (isa (x, 'single') || isa (m, 'single') || isa (n, 'single'))
  inv = NaN (size (x), 'single');
else
  inv = NaN (size (x));
end

k = (x == 1) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf);
inv(k) = Inf;

k = (x >= 0) & (x < 1) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf);
if (isscalar (m) && isscalar (n))
  inv(k) = ((1 ./ betainv (1 - x(k), n/2, m/2) - 1) * n / m);
else
  inv(k) = ((1 ./ betainv (1 - x(k), n(k)/2, m(k)/2) - 1)...
    .* n(k) ./ m(k));
end

end


function y = daub10_transform ( n, x )

%*****************************************************************************80
%
%% DAUB10_TRANSFORM computes the DAUB10 transform of a vector.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 July 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the dimension of the vector.
%    N must be a power of 2 and at least 4.
%
%    Input, real X(N), the vector to be transformed.
%
%    Output, real Y(N), the transformed vector.
%
  c = [ ...
    0.1601023979741929; ...
    0.6038292697971895; ...
    0.7243085284377726; ...
    0.1384281459013203; ...
   -0.2422948870663823; ...
   -0.0322448695846381; ...
    0.0775714938400459; ...
   -0.0062414902127983; ...
   -0.0125807519990820; ...
    0.0033357252854738 ];
  p = 9;
  y(1:n,1) = x(1:n);
  m = n;
  q = floor ( ( p - 1 ) / 2 );

  while ( 4 <= m )

    i = 1;
    z(1:m,1) = 0.0;

    for j = 1 : 2 : m - 1

      mh = floor ( m / 2 );
      for k = 0 : 2 : p - 1
        j0 = i4_wrap ( j + k,     1, m );
        j1 = i4_wrap ( j + k + 1, 1, m );
        z(i,1)    = z(i,1)    + c(  k+1) * y(j0) + c(  k+2) * y(j1);
        z(i+mh,1) = z(i+mh,1) + c(p-k+1) * y(j0) - c(p-k  ) * y(j1);
      end

      i = i + 1;

    end

    y(1:m,1) = z(1:m);

    m = floor ( m / 2 );

  end

  return
end


%--------------------------------------------------------------------------
%
% Example script for sinf_1D.m and sinf_3D.m
%
% Author        : dr.ir. Emanuel A.P. Habets
% Date          : 16-09-2010
%
% Related paper : E.A.P. Habets and S. Gannot, 'Generating sensor signals
%                 in isotropic noise fields', Submitted to the Journal
%                 of the Acoustical Society of America, May, 2007.
%
% Comment       :
%
%--------------------------------------------------------------------------

clear;
close all;

%% Initialization
fs = 8000;                       % Sample frequency
NFFT = 256;                      % Number of frequency bins (for analysis)
w = 2*pi*fs*(0:NFFT/2)/NFFT;
c = 340;                         % Speed of sound
L = 2^18;                        % Data length

[x1,y1,z1]=sph2cart(0,0,0.1);    % Sensor position 1
[x2,y2,z2]=sph2cart(0,0,0.2);    % Sensor position 2
P = [0 x1 x2; 0 y1 y2; 0 z1 z2]; % Construct position matrix
M = 3;                           % Number of sensors

% Calculate sensor distances w.r.t. sensor 1
d = zeros(1,M);
for m = 2:M
    d(m) = norm(P(:,m)-P(:,1),2);
end

%% Generate sensor signals
params.c = c;
params.fs = fs;

% 1D example
params.N_phi = 64;
z = sinf_1D(d,L,params);

% 3D example
% params.N = 256;
% z = sinf_3D(P,L,params);

%% Calculate spatial coherences
sc_sim = zeros(M-2,NFFT/2+1);
sc_theory = zeros(M-2,NFFT/2+1);
for m = 1:M-1
    [sc,F]=mycohere(z(1,:)',z(m+1,:)',NFFT,fs,hanning(NFFT),0.75*NFFT);
    sc_sim(m,:) = real(sc');

    sc_theory(m,:) = sinc(w*d(m+1)/c/pi);
end

%% Plot results
% Sensor pair 1-2
figure(1);
m=1;
plot(F/1000,sc_sim(m,:),'k')
hold on;
plot(F/1000,sc_theory(m,:),'--k')
hold off;
xlabel('Frequency [kHz]');
ylabel('Spatial Coherence');
title(sprintf('Distance %1.2f m',d(m+1)));
set(gca,'DataAspectRatio',[1 0.75 1]);
legend('Simulation','Theory');
grid on;

% Sensor pair 1-3
figure(2);
m=2;
plot(F/1000,sc_sim(m,:),'k')
hold on;
plot(F/1000,sc_theory(m,:),'--k')
hold off;
xlabel('Frequency [kHz]');
ylabel('Spatial Coherence');
title(sprintf('Distance %1.2f m',d(m+1)));
set(gca,'DataAspectRatio',[1 0.75 1]);
legend('Simulation','Theory');
grid on;