function varargout = colorspace(Conversion,varargin)
%COLORSPACE  Transform a color image between color representations.
%   B = COLORSPACE(S,A) transforms the color representation of image A
%   where S is a string specifying the conversion.  The input array A
%   should be a real full double array of size Mx3 or MxNx3.  The output B
%   is the same size as A.
%
%   S tells the source and destination color spaces, S = 'dest<-src', or
%   alternatively, S = 'src->dest'.  Supported color spaces are
%
%     'RGB'              sRGB IEC 61966-2-1
%     'YCbCr'            Luma + Chroma ("digitized" version of Y'PbPr)
%     'JPEG-YCbCr'       Luma + Chroma space used in JFIF JPEG
%     'YDbDr'            SECAM Y'DbDr Luma + Chroma
%     'YPbPr'            Luma (ITU-R BT.601) + Chroma
%     'YUV'              NTSC PAL Y'UV Luma + Chroma
%     'YIQ'              NTSC Y'IQ Luma + Chroma
%     'HSV' or 'HSB'     Hue Saturation Value/Brightness
%     'HSL' or 'HLS'     Hue Saturation Luminance
%     'HSI'              Hue Saturation Intensity
%     'XYZ'              CIE 1931 XYZ
%     'Lab'              CIE 1976 L*a*b* (CIELAB)
%     'Luv'              CIE L*u*v* (CIELUV)
%     'LCH'              CIE L*C*H* (CIELCH)
%     'CAT02 LMS'        CIE CAT02 LMS
%
%  All conversions assume 2 degree observer and D65 illuminant.
%
%  Color space names are case insensitive and spaces are ignored.  When
%  sRGB is the source or destination, it can be omitted. For example
%  'yuv<-' is short for 'yuv<-rgb'.
%
%  For sRGB, the values should be scaled between 0 and 1.  Beware that
%  transformations generally do not constrain colors to be "in gamut."
%  Particularly, transforming from another space to sRGB may obtain
%  R'G'B' values outside of the [0,1] range.  So the result should be
%  clamped to [0,1] before displaying:
%     image(min(max(B,0),1));  % Clamp B to [0,1] and display
%
%  sRGB (Red Green Blue) is the (ITU-R BT.709 gamma-corrected) standard
%  red-green-blue representation of colors used in digital imaging.  The
%  components should be scaled between 0 and 1.  The space can be
%  visualized geometrically as a cube.
%
%  Y'PbPr, Y'CbCr, Y'DbDr, Y'UV, and Y'IQ are related to sRGB by linear
%  transformations.  These spaces separate a color into a grayscale
%  luminance component Y and two chroma components.  The valid ranges of
%  the components depends on the space.
%
%  HSV (Hue Saturation Value) is related to sRGB by
%     H = hexagonal hue angle   (0 <= H < 360),
%     S = C/V                   (0 <= S <= 1),
%     V = max(R',G',B')         (0 <= V <= 1),
%  where C = max(R',G',B') - min(R',G',B').  The hue angle H is computed on
%  a hexagon.  The space is geometrically a hexagonal cone.
%
%  HSL (Hue Saturation Lightness) is related to sRGB by
%     H = hexagonal hue angle                (0 <= H < 360),
%     S = C/(1 - |2L-1|)                     (0 <= S <= 1),
%     L = (max(R',G',B') + min(R',G',B'))/2  (0 <= L <= 1),
%  where H and C are the same as in HSV.  Geometrically, the space is a
%  double hexagonal cone.
%
%  HSI (Hue Saturation Intensity) is related to sRGB by
%     H = polar hue angle        (0 <= H < 360),
%     S = 1 - min(R',G',B')/I    (0 <= S <= 1),
%     I = (R'+G'+B')/3           (0 <= I <= 1).
%  Unlike HSV and HSL, the hue angle H is computed on a circle rather than
%  a hexagon.
%
%  CIE XYZ is related to sRGB by inverse gamma correction followed by a
%  linear transform.  Other CIE color spaces are defined relative to XYZ.
%
%  CIE L*a*b*, L*u*v*, and L*C*H* are nonlinear functions of XYZ.  The L*
%  component is designed to match closely with human perception of
%  lightness.  The other two components describe the chroma.
%
%  CIE CAT02 LMS is the linear transformation of XYZ using the MCAT02
%  chromatic adaptation matrix.  The space is designed to model the
%  response of the three types of cones in the human eye, where L, M, S,
%  correspond respectively to red ("long"), green ("medium"), and blue
%  ("short").
%
% Author::
% Pascal Getreuer 2005-2010

%%% Input parsing %%%
if nargin < 2, error('Not enough input arguments.'); end
[SrcSpace,DestSpace] = parse(Conversion);

if nargin == 2
   Image = varargin{1};
elseif nargin >= 3
   Image = cat(3,varargin{:});
else
   error('Invalid number of input arguments.');
end

FlipDims = (size(Image,3) == 1);

if FlipDims, Image = permute(Image,[1,3,2]); end
if ~isa(Image,'double'), Image = double(Image)/255; end
if size(Image,3) ~= 3, error('Invalid input size.'); end

SrcT = gettransform(SrcSpace);
DestT = gettransform(DestSpace);

if ~ischar(SrcT) && ~ischar(DestT)
   % Both source and destination transforms are affine, so they
   % can be composed into one affine operation
   T = [DestT(:,1:3)*SrcT(:,1:3),DestT(:,1:3)*SrcT(:,4)+DestT(:,4)];
   Temp = zeros(size(Image));
   Temp(:,:,1) = T(1)*Image(:,:,1) + T(4)*Image(:,:,2) + T(7)*Image(:,:,3) + T(10);
   Temp(:,:,2) = T(2)*Image(:,:,1) + T(5)*Image(:,:,2) + T(8)*Image(:,:,3) + T(11);
   Temp(:,:,3) = T(3)*Image(:,:,1) + T(6)*Image(:,:,2) + T(9)*Image(:,:,3) + T(12);
   Image = Temp;
elseif ~ischar(DestT)
   Image = rgb(Image,SrcSpace);
   Temp = zeros(size(Image));
   Temp(:,:,1) = DestT(1)*Image(:,:,1) + DestT(4)*Image(:,:,2) + DestT(7)*Image(:,:,3) + DestT(10);
   Temp(:,:,2) = DestT(2)*Image(:,:,1) + DestT(5)*Image(:,:,2) + DestT(8)*Image(:,:,3) + DestT(11);
   Temp(:,:,3) = DestT(3)*Image(:,:,1) + DestT(6)*Image(:,:,2) + DestT(9)*Image(:,:,3) + DestT(12);
   Image = Temp;
else
   Image = feval(DestT,Image,SrcSpace);
end

%%% Output format %%%
if nargout > 1
   varargout = {Image(:,:,1),Image(:,:,2),Image(:,:,3)};
else
   if FlipDims, Image = permute(Image,[1,3,2]); end
   varargout = {Image};
end

return;

function [SrcSpace,DestSpace] = parse(Str)
% Parse conversion argument

if ischar(Str)
   Str = lower(strrep(strrep(Str,'-',''),'=',''));
   k = find(Str == '>');

   if length(k) == 1         % Interpret the form 'src->dest'
      SrcSpace = Str(1:k-1);
      DestSpace = Str(k+1:end);
   else
      k = find(Str == '<');

      if length(k) == 1      % Interpret the form 'dest<-src'
         DestSpace = Str(1:k-1);
         SrcSpace = Str(k+1:end);
      else
         error(['Invalid conversion, ''',Str,'''.']);
      end
   end

   SrcSpace = alias(SrcSpace);
   DestSpace = alias(DestSpace);
else
   SrcSpace = 1;             % No source pre-transform
   DestSpace = Conversion;
   if any(size(Conversion) ~= 3), error('Transformation matrix must be 3x3.'); end
end
return;

function Space = alias(Space)
Space = strrep(strrep(Space,'cie',''),' ','');

if isempty(Space)
   Space = 'rgb';
end

switch Space
case {'ycbcr','ycc'}
   Space = 'ycbcr';
case {'hsv','hsb'}
   Space = 'hsv';
case {'hsl','hsi','hls'}
   Space = 'hsl';
case {'rgb','yuv','yiq','ydbdr','ycbcr','jpegycbcr','xyz','lab','luv','lch'}
   return;
end
return;

function T = gettransform(Space)
% Get a colorspace transform: either a matrix describing an affine transform,
% or a string referring to a conversion subroutine
switch Space
case 'ypbpr'
   T = [0.299,0.587,0.114,0;-0.1687367,-0.331264,0.5,0;0.5,-0.418688,-0.081312,0];
case 'yuv'
   % sRGB to NTSC/PAL YUV
   % Wikipedia: http://en.wikipedia.org/wiki/YUV
   T = [0.299,0.587,0.114,0;-0.147,-0.289,0.436,0;0.615,-0.515,-0.100,0];
case 'ydbdr'
   % sRGB to SECAM YDbDr
   % Wikipedia: http://en.wikipedia.org/wiki/YDbDr
   T = [0.299,0.587,0.114,0;-0.450,-0.883,1.333,0;-1.333,1.116,0.217,0];
case 'yiq'
   % sRGB in [0,1] to NTSC YIQ in [0,1];[-0.595716,0.595716];[-0.522591,0.522591];
   % Wikipedia: http://en.wikipedia.org/wiki/YIQ
   T = [0.299,0.587,0.114,0;0.595716,-0.274453,-0.321263,0;0.211456,-0.522591,0.311135,0];
case 'ycbcr'
   % sRGB (range [0,1]) to ITU-R BRT.601 (CCIR 601) Y'CbCr
   % Wikipedia: http://en.wikipedia.org/wiki/YCbCr
   % Poynton, Equation 3, scaling of R'G'B to Y'PbPr conversion
   T = [65.481,128.553,24.966,16;-37.797,-74.203,112.0,128;112.0,-93.786,-18.214,128];
case 'jpegycbcr'
   % Wikipedia: http://en.wikipedia.org/wiki/YCbCr
   T = [0.299,0.587,0.114,0;-0.168736,-0.331264,0.5,0.5;0.5,-0.418688,-0.081312,0.5]*255;
case {'rgb','xyz','hsv','hsl','lab','luv','lch','cat02lms'}
   T = Space;
otherwise
   error(['Unknown color space, ''',Space,'''.']);
end
return;

function Image = rgb(Image,SrcSpace)
% Convert to sRGB from 'SrcSpace'
switch SrcSpace
case 'rgb'
   return;
case 'hsv'
   % Convert HSV to sRGB
   Image = huetorgb((1 - Image(:,:,2)).*Image(:,:,3),Image(:,:,3),Image(:,:,1));
case 'hsl'
   % Convert HSL to sRGB
   L = Image(:,:,3);
   Delta = Image(:,:,2).*min(L,1-L);
   Image = huetorgb(L-Delta,L+Delta,Image(:,:,1));
case {'xyz','lab','luv','lch','cat02lms'}
   % Convert to CIE XYZ
   Image = xyz(Image,SrcSpace);
   % Convert XYZ to RGB
   T = [3.2406, -1.5372, -0.4986; -0.9689, 1.8758, 0.0415; 0.0557, -0.2040, 1.057];
   R = T(1)*Image(:,:,1) + T(4)*Image(:,:,2) + T(7)*Image(:,:,3);  % R
   G = T(2)*Image(:,:,1) + T(5)*Image(:,:,2) + T(8)*Image(:,:,3);  % G
   B = T(3)*Image(:,:,1) + T(6)*Image(:,:,2) + T(9)*Image(:,:,3);  % B
   % Desaturate and rescale to constrain resulting RGB values to [0,1]
   AddWhite = -min(min(min(R,G),B),0);
   R = R + AddWhite;
   G = G + AddWhite;
   B = B + AddWhite;
   % Apply gamma correction to convert linear RGB to sRGB
   Image(:,:,1) = gammacorrection(R);  % R'
   Image(:,:,2) = gammacorrection(G);  % G'
   Image(:,:,3) = gammacorrection(B);  % B'
otherwise  % Conversion is through an affine transform
   T = gettransform(SrcSpace);
   temp = inv(T(:,1:3));
   T = [temp,-temp*T(:,4)];
   R = T(1)*Image(:,:,1) + T(4)*Image(:,:,2) + T(7)*Image(:,:,3) + T(10);
   G = T(2)*Image(:,:,1) + T(5)*Image(:,:,2) + T(8)*Image(:,:,3) + T(11);
   B = T(3)*Image(:,:,1) + T(6)*Image(:,:,2) + T(9)*Image(:,:,3) + T(12);
   Image(:,:,1) = R;
   Image(:,:,2) = G;
   Image(:,:,3) = B;
end

% Clip to [0,1]
Image = min(max(Image,0),1);
return;

function Image = xyz(Image,SrcSpace)
% Convert to CIE XYZ from 'SrcSpace'
WhitePoint = [0.950456,1,1.088754];

switch SrcSpace
case 'xyz'
   return;
case 'luv'
   % Convert CIE L*uv to XYZ
   WhitePointU = (4*WhitePoint(1))./(WhitePoint(1) + 15*WhitePoint(2) + 3*WhitePoint(3));
   WhitePointV = (9*WhitePoint(2))./(WhitePoint(1) + 15*WhitePoint(2) + 3*WhitePoint(3));
   L = Image(:,:,1);
   Y = (L + 16)/116;
   Y = invf(Y)*WhitePoint(2);
   U = Image(:,:,2)./(13*L + 1e-6*(L==0)) + WhitePointU;
   V = Image(:,:,3)./(13*L + 1e-6*(L==0)) + WhitePointV;
   Image(:,:,1) = -(9*Y.*U)./((U-4).*V - U.*V);                  % X
   Image(:,:,2) = Y;                                             % Y
   Image(:,:,3) = (9*Y - (15*V.*Y) - (V.*Image(:,:,1)))./(3*V);  % Z
case {'lab','lch'}
   Image = lab(Image,SrcSpace);
   % Convert CIE L*ab to XYZ
   fY = (Image(:,:,1) + 16)/116;
   fX = fY + Image(:,:,2)/500;
   fZ = fY - Image(:,:,3)/200;
   Image(:,:,1) = WhitePoint(1)*invf(fX);  % X
   Image(:,:,2) = WhitePoint(2)*invf(fY);  % Y
   Image(:,:,3) = WhitePoint(3)*invf(fZ);  % Z
case 'cat02lms'
    % Convert CAT02 LMS to XYZ
   T = inv([0.7328, 0.4296, -0.1624;-0.7036, 1.6975, 0.0061; 0.0030, 0.0136, 0.9834]);
   L = Image(:,:,1);
   M = Image(:,:,2);
   S = Image(:,:,3);
   Image(:,:,1) = T(1)*L + T(4)*M + T(7)*S;  % X
   Image(:,:,2) = T(2)*L + T(5)*M + T(8)*S;  % Y
   Image(:,:,3) = T(3)*L + T(6)*M + T(9)*S;  % Z
otherwise   % Convert from some gamma-corrected space
   % Convert to sRGB
   Image = rgb(Image,SrcSpace);
   % Undo gamma correction
   R = invgammacorrection(Image(:,:,1));
   G = invgammacorrection(Image(:,:,2));
   B = invgammacorrection(Image(:,:,3));
   % Convert RGB to XYZ
   T = inv([3.2406, -1.5372, -0.4986; -0.9689, 1.8758, 0.0415; 0.0557, -0.2040, 1.057]);
   Image(:,:,1) = T(1)*R + T(4)*G + T(7)*B;  % X
   Image(:,:,2) = T(2)*R + T(5)*G + T(8)*B;  % Y
   Image(:,:,3) = T(3)*R + T(6)*G + T(9)*B;  % Z
end
return;

function Image = hsv(Image,SrcSpace)
% Convert to HSV
Image = rgb(Image,SrcSpace);
V = max(Image,[],3);
S = (V - min(Image,[],3))./(V + (V == 0));
Image(:,:,1) = rgbtohue(Image);
Image(:,:,2) = S;
Image(:,:,3) = V;
return;

function Image = hsl(Image,SrcSpace)
% Convert to HSL
switch SrcSpace
case 'hsv'
   % Convert HSV to HSL
   MaxVal = Image(:,:,3);
   MinVal = (1 - Image(:,:,2)).*MaxVal;
   L = 0.5*(MaxVal + MinVal);
   temp = min(L,1-L);
   Image(:,:,2) = 0.5*(MaxVal - MinVal)./(temp + (temp == 0));
   Image(:,:,3) = L;
otherwise
   Image = rgb(Image,SrcSpace);  % Convert to sRGB
   % Convert sRGB to HSL
   MinVal = min(Image,[],3);
   MaxVal = max(Image,[],3);
   L = 0.5*(MaxVal + MinVal);
   temp = min(L,1-L);
   S = 0.5*(MaxVal - MinVal)./(temp + (temp == 0));
   Image(:,:,1) = rgbtohue(Image);
   Image(:,:,2) = S;
   Image(:,:,3) = L;
end
return;

function Image = lab(Image,SrcSpace)
% Convert to CIE L*a*b* (CIELAB)
WhitePoint = [0.950456,1,1.088754];

switch SrcSpace
case 'lab'
   return;
case 'lch'
   % Convert CIE L*CH to CIE L*ab
   C = Image(:,:,2);
   Image(:,:,2) = cos(Image(:,:,3)*pi/180).*C;  % a*
   Image(:,:,3) = sin(Image(:,:,3)*pi/180).*C;  % b*
otherwise
   Image = xyz(Image,SrcSpace);  % Convert to XYZ
   % Convert XYZ to CIE L*a*b*
   X = Image(:,:,1)/WhitePoint(1);
   Y = Image(:,:,2)/WhitePoint(2);
   Z = Image(:,:,3)/WhitePoint(3);
   fX = f(X);
   fY = f(Y);
   fZ = f(Z);
   Image(:,:,1) = 116*fY - 16;    % L*
   Image(:,:,2) = 500*(fX - fY);  % a*
   Image(:,:,3) = 200*(fY - fZ);  % b*
end
return;

function Image = luv(Image,SrcSpace)
% Convert to CIE L*u*v* (CIELUV)
WhitePoint = [0.950456,1,1.088754];
WhitePointU = (4*WhitePoint(1))./(WhitePoint(1) + 15*WhitePoint(2) + 3*WhitePoint(3));
WhitePointV = (9*WhitePoint(2))./(WhitePoint(1) + 15*WhitePoint(2) + 3*WhitePoint(3));

Image = xyz(Image,SrcSpace); % Convert to XYZ
Denom = Image(:,:,1) + 15*Image(:,:,2) + 3*Image(:,:,3);
U = (4*Image(:,:,1))./(Denom + (Denom == 0));
V = (9*Image(:,:,2))./(Denom + (Denom == 0));
Y = Image(:,:,2)/WhitePoint(2);
L = 116*f(Y) - 16;
Image(:,:,1) = L;                        % L*
Image(:,:,2) = 13*L.*(U - WhitePointU);  % u*
Image(:,:,3) = 13*L.*(V - WhitePointV);  % v*
return;

function Image = lch(Image,SrcSpace)
% Convert to CIE L*ch
Image = lab(Image,SrcSpace);  % Convert to CIE L*ab
H = atan2(Image(:,:,3),Image(:,:,2));
H = H*180/pi + 360*(H < 0);
Image(:,:,2) = sqrt(Image(:,:,2).^2 + Image(:,:,3).^2);  % C
Image(:,:,3) = H;                                        % H
return;

function Image = cat02lms(Image,SrcSpace)
% Convert to CAT02 LMS
Image = xyz(Image,SrcSpace);
T = [0.7328, 0.4296, -0.1624;-0.7036, 1.6975, 0.0061; 0.0030, 0.0136, 0.9834];
X = Image(:,:,1);
Y = Image(:,:,2);
Z = Image(:,:,3);
Image(:,:,1) = T(1)*X + T(4)*Y + T(7)*Z;  % L
Image(:,:,2) = T(2)*X + T(5)*Y + T(8)*Z;  % M
Image(:,:,3) = T(3)*X + T(6)*Y + T(9)*Z;  % S
return;

function Image = huetorgb(m0,m2,H)
% Convert HSV or HSL hue to RGB
N = size(H);
H = min(max(H(:),0),360)/60;
m0 = m0(:);
m2 = m2(:);
F = H - round(H/2)*2;
M = [m0, m0 + (m2-m0).*abs(F), m2];
Num = length(m0);
j = [2 1 0;1 2 0;0 2 1;0 1 2;1 0 2;2 0 1;2 1 0]*Num;
k = floor(H) + 1;
Image = reshape([M(j(k,1)+(1:Num).'),M(j(k,2)+(1:Num).'),M(j(k,3)+(1:Num).')],[N,3]);
return;

function H = rgbtohue(Image)
% Convert RGB to HSV or HSL hue
[M,i] = sort(Image,3);
i = i(:,:,3);
Delta = M(:,:,3) - M(:,:,1);
Delta = Delta + (Delta == 0);
R = Image(:,:,1);
G = Image(:,:,2);
B = Image(:,:,3);
H = zeros(size(R));
k = (i == 1);
H(k) = (G(k) - B(k))./Delta(k);
k = (i == 2);
H(k) = 2 + (B(k) - R(k))./Delta(k);
k = (i == 3);
H(k) = 4 + (R(k) - G(k))./Delta(k);
H = 60*H + 360*(H < 0);
H(Delta == 0) = nan;
return;

function Rp = gammacorrection(R)
Rp = zeros(size(R));
i = (R <= 0.0031306684425005883);
Rp(i) = 12.92*R(i);
Rp(~i) = real(1.055*R(~i).^0.416666666666666667 - 0.055);
return;

function R = invgammacorrection(Rp)
R = zeros(size(Rp));
i = (Rp <= 0.0404482362771076);
R(i) = Rp(i)/12.92;
R(~i) = real(((Rp(~i) + 0.055)/1.055).^2.4);
return;

function fY = f(Y)
fY = real(Y.^(1/3));
i = (Y < 0.008856);
fY(i) = Y(i)*(841/108) + (4/29);
return;

function Y = invf(fY)
Y = fY.^3;
i = (Y < 0.008856);
Y(i) = (fY(i) - 4/29)*(108/841);
return;


function acc = st_to_cc_values ( nst, ist, jst, ast, ncc, n, icc, ccc )

%*****************************************************************************80
%
%% ST_TO_CC_VALUES creates CC values from ST data.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 July 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NST, the number of ST elements.
%
%    Input, integer IST(NST), JST(NST), the ST rows and columns.
%
%    Input, real AST(NST), the ST values.
%
%    Input, integer NCC, the number of CC elements.
%
%    Input, integer N, the number of columns.
%
%    Input, integer ICC(NCC), the CC rows.
%
%    Input, integer CCC(N+1), the CC compressed columns.
%
%    Output, real ACC(NCC), the CC values.
%
  acc = zeros ( ncc, 1 );

  for kst = 1 : nst

    i = ist(kst);
    j = jst(kst);

    clo = ccc(j);
    chi = ccc(j+1);

    fail = 1;

    for kcc = clo : chi - 1
      if ( icc(kcc) == i )
        acc(kcc) = acc(kcc) + ast(kst);
        fail = 0;
        break
      end
    end

    if ( fail )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'ST_TO_CC_VALUES - Fatal error!\n' );
      fprintf ( 1, '  ST entry cannot be located in CC array.\n' );
      fprintf ( 1, '  ST index KST    = %d\n', kst );
      fprintf ( 1, '  ST row IST(KST) = %d\n', ist(kst) );
      fprintf ( 1, '  ST col JST(KST) = %d\n', jst(kst) );
      fprintf ( 1, '  ST val AST(KST) = %g\n', ast(kst) );
      error ( 'ST_TO_CC_VALUES - Fatal error!' );
    end

  end

  return
end


function [U,data,SS,R] = arap(V,F,b,bc,varargin)
  % ARAP Solve for the as-rigid-as-possible deformation according to various
  % manifestations including:
  %   (1) "As-rigid-as-possible Surface Modeling" by [Sorkine and Alexa 2007]
  %   (2) "A local-global approach to mesh parameterization" by [Liu et al.
  %     2010] or "A simple geometric model for elastic deformation" by [Chao et
  %     al.  2010]
  %   (3) Adapted version of "As-rigid-as-possible Surface Modeling" by
  %     [Sorkine and Alexa 2007] presented in section 4.2 of or "A simple
  %     geometric model for elastic deformation" by [Chao et al.  2010]
  %
  % U = arap(V,F,b,bc) given a rest mesh (V,F) and list of constraint vertex
  % indices (b) and their new postions (bc) solve for pose mesh positions (U),
  % using default choice for 'Energy'
  %
  % U = arap(V,F,b,bc,'ParameterName','ParameterValue',...)
  %
  % Inputs:
  %   V  #V by dim list of rest domain positions
  %   F  #F by {3|4} list of {triangle|tetrahedra} indices into V
  %   b  #b list of indices of constraint (boundary) vertices
  %   bc  #b by dim list of constraint positions for b
  %   Optional:
  %     'Energy'
  %       followed by a string specifying which arap energy definition to use.
  %       One of the following:
  %         'spokes'  "As-rigid-as-possible Surface Modeling" by [Sorkine and
  %           Alexa 2007], rotations defined at vertices affecting incident
  %           edges
  %         'elements'  "A local-global approach to mesh parameterization" by
  %           [Liu et al.  2010] or "A simple geometric model for elastic
  %           deformation" by [Chao et al.  2010], rotations defined at
  %           elements (triangles or tets)
  %         'spokes-and-rims'  Adapted version of "As-rigid-as-possible Surface
  %           Modeling" by [Sorkine and Alexa 2007] presented in section 4.2 of
  %           or "A simple geometric model for elastic deformation" by [Chao et
  %           al.  2010], rotations defined at vertices affecting incident
  %           edges and opposite edges
  %     'V0' #V by dim list of initial guess positions
  %       dim by dim by #C list of linear transformations initial guesses,
  %       optional (default is to use identity transformations)
  %     'Data' see output
  %     'Groups'
  %       followed by #V list of group indices (1 to k) for each vertex, such
  %       that vertex i is assigned to group G(i)
  %     'Tol'
  %       stopping critera parameter. If variables (linear transformation matrix
  %       entries) change by less than 'tol' the optimization terminates,
  %       default is 0.75 (weak tolerance)
  %     'MaxIter'
  %       max number of local-global iterations, default is 100
  %     'Dynamic'
  %        #V by dim list of external forces
  %     'TimeStep'
  %        scalar time step value
  %     'Vm1'
  %        #V by dim positions at time t-1
  %     'Tikhonov' followed by constant Tikhonov regularization parameter
  %       alpha:
  %       http://en.wikipedia.org/wiki/Tikhonov_regularization#Relation_to_probabilistic_formulation
  %     'Youngs'  followed by young's modulus (only for dynamics)
  %     'Flat' followed by whether to add the constraint that Z=0 {false}
  %     'RemoveRigid' followed by whether to add a constraint that places an
  %       arbitrary point at the origin and another along the x-axis {false}
  %     'Aeq'/'Beq'  followed by #Aeq by dim*#V linear equality constraints
  %        matrix and righthand sides respectively {[]}/{[]}
  % Outputs:
  %   U  #V by dim list of new positions
  %   data  struct of reusable data
  %     .CSM dim*n by dim*n sparse matrix containing special laplacians along the
  %       diagonal so that when multiplied by repmat(U,dim,1) gives covariance
  %       matrix elements, can be used to speed up next time this function is
  %       called, see function definitions
  %
  % Known issues: 'Flat',true + 'Energy','elements' should only need a 2D
  % rotation fit, but this does 3D to stay general (e.g. if one were to use
  % 'spokes' then the edge-set cannot be pre-mapped to a common plane)
  %
  % See also: takeo_arap
  %

  % parse input
  G = [];

  % number of vertices
  n = size(V,1);
  assert(isempty(b) || max(b) <= n,'b should be in bounds [1,size(V,1)]');
  assert(isempty(b) || min(b) >= 1,'b should be in bounds [1,size(V,1)]');

  indices = 1:n;
  max_iterations = 100;
  tol = 0.001;
  interior = indices(~ismember(indices,b));
  U = [];
  Vm1 = [];
  youngs = 1.2e9;
  % default is Sorkine and Alexa style local rigidity energy
  energy = [];
  % default is no external forces
  fext = [];
  % defaults is unit time step
  h = 1;
  % Tikhonov regularization alpha
  alpha_tik = 0;
  % flatten/parameterization
  flat = false;
  % remove rigid transformation invariance
  remove_rigid = false;
  G = [];
  debug = false;
  data = [];
  Aeq = [];
  Beq = [];
  ref_data = [];
  weight = [];

  % Map of parameter names to variable names
  params_to_variables = containers.Map( ...
    {'Energy','V0','Data','Tikhonov','Groups','Tol', ...
     'MaxIter','Dynamic','TimeStep','Vm1','RemoveRigid','Debug', ...
     'Aeq','Beq','Flat','Ref','Weight','Youngs'}, ...
    {'energy','U','data','alpha_tik','G','tol','max_iterations','fext', ...
    'h','Vm1','remove_rigid','debug','Aeq','Beq','flat','ref_data','weight','youngs'});
  v = 1;
  while v <= numel(varargin)
    param_name = varargin{v};
    if isKey(params_to_variables,param_name)
      assert(v+1<=numel(varargin));
      v = v+1;
      % Trick: use feval on anonymous function to use assignin to this workspace
      feval(@()assignin('caller',params_to_variables(param_name),varargin{v}));
    else
      error('Unsupported parameter: %s',varargin{v});
    end
    v=v+1;
  end

  if isempty(energy)
    switch size(F,2)
    case 4
      energy = 'elements';
    case 3
      energy = 'spokes-and-rims';
    end
  end
  if isempty(fext)
    dynamic = false;
    fext = zeros(size(V));
  else
    dynamic = true;
  end

  if isempty(data)
    if strcmp(energy,'elements') && numel(G) ~= size(F,1) && numel(G) == n
      % groups are defined per vertex, convert to per face using mode
      data.G = mode(G(F),2);
    else
      data.G = G;
    end
  end

  if isempty(data.G)
    k = n;
  else
    k = max(data.G);
  end

  ref_map = [];
  if isempty(ref_data)
    if flat
      [ref_V,ref_F,ref_map] = plane_project(V,F);
      assert(strcmp(energy,'elements'),'flat only makes sense with elements');
    else
      ref_V = V;
      ref_F = F;
    end
  else
    ref_V = ref_data{1};
    ref_F = ref_data{2};
    ref_map = ref_data{3};
  end
  dim = size(ref_V,2);

  if isempty(bc)
    bc = sparse(0,dim);
  end

  assert(dim == size(bc,2));
  assert(size(Aeq,1) == size(Beq,1));
  assert((size(Aeq,2) == 0) || (size(Aeq,2) == dim*size(V,1)));

  if isempty(U)
    if(dim == 2)
      U = laplacian_mesh_editing(V,F,b,bc);
    else
      U = V;
    end
    U = U(:,1:dim);
  end
  assert(n == size(U,1));
  assert(dim == size(U,2));

  if dynamic
    V0 = U(:,1:dim);
    if isempty(Vm1)
      Vm1 = V0;
    end
    %% This parameter seem good for a 0.1m tall hotdog with h=0.0333
    % Larger --> more rigid
    dyn_alpha = h^2*youngs;
    % Smaller --> more damped
    mom = 1e10;
    M = massmatrix(ref_V,ref_F);
    if ~isempty(ref_map)
      M = ref_map*M*ref_map';
    end
    DQ = 0.5*mom*M;
    Dl =     mom*M*(-2*V0 + Vm1) - h^2*fext;
  else
    dyn_alpha = 1;
    DQ = sparse(size(V,1),size(V,1));
    Dl = sparse(size(V,1),dim);
  end

  if ~isfield(data,'L') || isempty(data.L)
    if isempty(weight)
      data.L = cotmatrix(ref_V,ref_F);
    else
      wA = doublearea(ref_V,ref_F);
      wG = grad(ref_V,ref_F);
      data.L = -0.5*wG'*( repmat(wA.*weight,dim,1) .* wG);
    end

    if ~isempty(ref_map)
      data.L = ref_map*data.L*ref_map';
    end
  end

  rr.b = cell(dim,1);
  rr.bc = cell(dim,1);
  if ~isfield(data,'rr')
    data.rr = [];
    if ~isfield(data.rr,'preF')
      data.rr.preF = cell(dim,1);
    end
  end
  if ~isfield(data,'preF')
    data.preF = [];
  end
  if remove_rigid
    if ~isempty(b)
      warning('RemoveRigid`s constraints are not typically wanted if |b|>0');
    end
    % the only danger is picking two points which end up mapped very close to
    % each other
    [~,f] = farthest_points(V,dim);
    for c = 1:dim
      rr.b{c} = f([1:dim-(c-1)])';
      rr.bc{c} = zeros(numel(rr.b{c}),1);
    end
    % Immediately remove rigid transformation from initial guess
    U = bsxfun(@minus,U,U(f(1),:));
    % We know that f(1) is at origin
    switch dim
    case 3
      % rotate about y-axis so that f(2) has (x=0)
      theta = atan2(U(f(2),1),U(f(2),3));
      R = axisangle2matrix([0 1 0],theta);
      U = U*R;
      % rotate about x-axis so that f(2) has (y=0)
      theta = atan2(U(f(2),3),U(f(2),2))+pi/2;
      R = axisangle2matrix([1 0 0],theta);
      U = U*R;
      % rotate about z-axis so that f(3) has (x=0)
      theta = atan2(U(f(3),2),U(f(3),1))+pi/2;
      R = axisangle2matrix([0 0 1],theta);
      U = U*R;
    case 2
      % rotate so that f(2) is on y-axis (x=0)
      theta = atan2(U(f(2),2),U(f(2),1))+pi/2;
      R = [cos(theta) -sin(theta);sin(theta) cos(theta)];
      U = U*R;
    otherwise
      error('Unsupported dimension');
    end
  end

  all = [interior(:);b(:)]';

  % cholesky factorization
  %cholL = chol(-L(interior,interior),'lower');
  % Why lu and not cholesky?
  %[luL,luU,luP,luQ,luR] = lu(-L(interior,interior));

  %R = repmat(eye(dim,dim),[1 1 n]);

  if ~isfield(data,'ae') || isempty(data.ae)
    data.ae = avgedge(V,F);
  end

  % build covariance scatter matrix used to build covariance matrices we'll
  % later fit rotations to
  if ~isfield(data,'CSM') || isempty(data.CSM)
    %assert(size(ref_V,2) == dim);
    data.CSM = ...
      covariance_scatter_matrix(ref_V,ref_F,'Energy',energy);
    if ~isempty(ref_map)
      data.CSM = data.CSM * repdiag(ref_map',dim);
    end

    % if there are groups then condense scatter matrix to only build
    % covariance matrices for each group
    if ~isempty(G)
      G_sum = group_sum_matrix(data.G,k);
      %CSM = [G_sum sparse(k,n); sparse(k,n) G_sum] * CSM;
      data.CSM = repdiag(G_sum,dim) * data.CSM;
    end
  end

  % precompute rhs premultiplier
  if ~isfield(data,'K') || isempty(data.K)
    [~,data.K] = arap_rhs(ref_V,ref_F,[],'Energy',energy,'Weight',weight);
    if ~isempty(ref_map)
      data.K = repdiag(ref_map,dim) * data.K;
    end
  end

  % initialize rotations with identies (not necessary)
  R = repmat(eye(dim,dim),[1 1 size(data.CSM,1)/dim]);

  iteration = 1;
  U_prev = V;
  data.energy = inf;
  while true

    if iteration > max_iterations
      if debug
        fprintf('arap: Iter (%d) > max_iterations (%d)\n',iteration,max_iterations);
      end
      break;
    end

    if iteration > 1
      change = max(abs(U(:)-U_prev(:)));
      if debug
        fprintf('arap: iter: %d, change: %g, energy: %g\n', ...
          iteration,change/data.ae,data.energy);
      end
      if change/data.ae <tol
        if debug
          fprintf('arap: change (%g) < tol*ae (%g * %g)\n',change,tol,data.ae);
        end
        break;
      end
    end

    U_prev = U;

    % energy after last global step
    U(b,:) = bc;
    %E = arap_energy(V,F,U,R);
    %[1 E]

    % compute covariance matrix elements
    S = zeros(size(data.CSM,1),dim);
    S(:,1:dim) = data.CSM*repmat(U,dim,1);
    % dim by dim by n list of covariance matrices
    SS = permute(reshape(S,[size(data.CSM,1)/dim dim dim]),[2 3 1]);
    % fit rotations to each deformed vertex
    R = fit_rotations(SS,'SinglePrecision',false);

    % energy after last local step
    U(b,:) = bc;
    %E = arap_energy(V,F,U,R);
    %[2 E]

    % This is still the SLOW way of building the right hand side, the entire
    % step of building the right hand side should collapse into a
    % #handles*dim*dim+1 by #groups matrix times the rotations at for group

    % distribute group rotations to vertices in each group
    if ~isempty(data.G)
      R = R(:,:,data.G);
    end

    U(b,:) = bc;

    %B = arap_rhs(V,F,R);
    Rcol = reshape(permute(R,[3 1 2]),size(data.K,2),1);
    Bcol = data.K * Rcol;
    B = reshape(Bcol,[size(Bcol,1)/dim dim]);

    zQ = -0.5*dyn_alpha*data.L+DQ+alpha_tik*speye(size(data.L));
    zL = -dyn_alpha*B+Dl;
    % RemoveRigid requires to solve each indepently
    if remove_rigid
      assert(isempty(Aeq),'Linear equality constraints not supported')
      for c = 1:dim
        eff_b = [b rr.b{c}];
        eff_bc = [bc(:,c);rr.bc{c}];
        [U(:,c),data.rr.preF{c}] = min_quad_with_fixed( ...
          zQ, ...
          zL(:,c),eff_b,eff_bc,[],[],data.rr.preF{c});
      end
    else
      if isempty(Aeq)
        cellfun(@(v) assignin('base',v,evalin('caller',v)),{'zQ','zL'});
        [U,data.preF] = min_quad_with_fixed( ...
          zQ, ...
          zL,b,bc,Aeq,Beq,data.preF);
      else
        assert(dim == size(bc,2));
        assert(dim == size(B,2));
        % repeat diagonal to solve for all coordinates together
        mQ = repdiag(zQ,dim);
        mL = reshape(zL,[],1);
        mb = reshape(bsxfun(@plus,b(:),size(V,1)*(0:dim-1)),[],1)';
        mbc = bc(:);
        [U,data.preF] = min_quad_with_fixed(mQ,mL,mb,mbc,Aeq,Beq,data.preF);
        U = reshape(U,[],dim);
      end
    end
    energy_prev = data.energy;
    data.energy = trace(U'*(zQ)*U+U'*(zL))+trace(V'*(0.5*dyn_alpha*data.L*V));
    if data.energy > energy_prev
      if debug
        fprintf('arap: energy (%g) increasing (over %g) (iter %d)\n', ...
          data.energy,energy_prev,iteration);
      end
      break;
    end

    %U(interior,:) = -L(interior,interior) \ (B(interior,:) + L(interior,b)*bc);
    %U(interior,:) = -L(interior,all)*L(all,interior) \ (L(interior,all)*B(all,:) + L(interior,all)*L(all,b)*bc);
    %U(interior,:) = luQ*(luU\(luL\(luP*(luR\(B(interior,:)+L(interior,b)*bc)))));
    %U(interior,:)=cholL\((B(interior,:)+L(interior,b)*bc)'/cholL)';
    iteration = iteration + 1;
  end
  U = U(:,1:dim);
end


function [F,V,faceBoundaryMarker]=quadBox(boxDim,boxEl)

%%
F=[]; V=[]; faceBoundaryMarker=[];

[Xtb,Ytb]=meshgrid(0:boxEl(1),0:boxEl(2));

[Ylr,Zlr]=meshgrid(0:boxEl(2),0:boxEl(3));
[f,v]=surf2patch(0*ones(size(Ylr)),Ylr,Zlr); %Left
f=fliplr(f);
F=[F;f+size(V,1)]; V=[V;v;]; faceBoundaryMarker=[faceBoundaryMarker; 1*ones(size(f,1),1)];

[f,v]=surf2patch(boxEl(1)*ones(size(Ylr)),Ylr,Zlr); %Right
F=[F;f+size(V,1)]; V=[V;v;]; faceBoundaryMarker=[faceBoundaryMarker; 2*ones(size(f,1),1)];

[Yfb,Zfb]=meshgrid(0:boxEl(1),0:boxEl(3));
[f,v]=surf2patch(Yfb,0*ones(size(Yfb)),Zfb); %Front
F=[F;f+size(V,1)]; V=[V;v;]; faceBoundaryMarker=[faceBoundaryMarker; 3*ones(size(f,1),1)];

[f,v]=surf2patch(Yfb,boxEl(2)*ones(size(Yfb)),Zfb); %Back
f=fliplr(f);
F=[F;f+size(V,1)]; V=[V;v;]; faceBoundaryMarker=[faceBoundaryMarker; 4*ones(size(f,1),1)];

[f,v]=surf2patch(Xtb,Ytb,0*ones(size(Xtb))); %Bottom
f=fliplr(f);
F=[F;f+size(V,1)]; V=[V;v;]; faceBoundaryMarker=[faceBoundaryMarker; 5*ones(size(f,1),1)];

[f,v]=surf2patch(Xtb,Ytb,boxEl(3)*ones(size(Xtb))); %Top
F=[F;f+size(V,1)]; V=[V;v;]; faceBoundaryMarker=[faceBoundaryMarker; 6*ones(size(f,1),1)];

%%
% Remove double nodes by merging
[F,V]=mergeVertices(F,V);

%%
% Scale coordinates
maxV=max(V,[],1);
V=V./maxV(ones(size(V,1),1),:);
V=V.*boxDim(ones(size(V,1),1),:);
V=V-boxDim(ones(size(V,1),1),:)/2;

%%
% _*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 Mh = hmxSingle(Mh)
%+========================================================================+
%|                                                                        |
%|         OPENHMX - LIBRARY FOR H-MATRIX COMPRESSION AND ALGEBRA         |
%|           openHmx is part of the GYPSILAB toolbox for Matlab           |
%|                                                                        |
%| COPYRIGHT : Matthieu Aussal (c) 2017-2018.                             |
%| PROPERTY  : Centre de Mathematiques Appliquees, Ecole polytechnique,   |
%| route de Saclay, 91128 Palaiseau, France. All rights reserved.         |
%| LICENCE   : This program is free software, distributed in the hope that|
%| it will be useful, but WITHOUT ANY WARRANTY. Natively, you can use,    |
%| redistribute and/or modify it under the terms of the GNU General Public|
%| License, as published by the Free Software Foundation (version 3 or    |
%| later,  http://www.gnu.org/licenses). For private use, dual licencing  |
%| is available, please contact us to activate a "pay for remove" option. |
%| CONTACT   : matthieu.aussal@polytechnique.edu                          |
%| WEBSITE   : www.cmap.polytechnique.fr/~aussal/gypsilab                 |
%|                                                                        |
%| Please acknowledge the gypsilab toolbox in programs or publications in |
%| which you use it.                                                      |
%|________________________________________________________________________|
%|   '&`   |                                                              |
%|    #    |   FILE       : hmxSingle.m                                   |
%|    #    |   VERSION    : 0.40                                          |
%|   _#_   |   AUTHOR(S)  : Matthieu Aussal                               |
%|  ( # )  |   CREATION   : 14.03.2017                                    |
%|  / 0 \  |   LAST MODIF : 14.03.2018                                    |
%| ( === ) |   SYNOPSIS   : Convert H-Matrix to single precision          |
%|  `---'  |                                                              |
%+========================================================================+

% Position
Mh.pos = {single(Mh.pos{1}),single(Mh.pos{2})};

%%% H-Matrix (recursion)
if (Mh.typ == 0)
    for i = 1:4
        Mh.chd{i} = hmxSingle(Mh.chd{i});
        Mh.row{i} = single(Mh.row{i});
        Mh.col{i} = single(Mh.col{i});
    end
    Mh = hmxFusion(Mh);

%%% Compressed leaf
elseif (Mh.typ == 1)
    Mh.dat{1} = single(Mh.dat{1});
    Mh.dat{2} = single(Mh.dat{2});

%%% Full leaf
elseif (Mh.typ == 2)
    Mh.dat = single(Mh.dat);

%%% Unknown type
else
    error('hmxSingle.m : unavailable case')
end
end


% +IOSR
%
%   Contents file for +IOSR and its subfolders.
%
%   +IOSR
%   iosr.install                         - Set search paths, and download and install dependencies
%
%   +IOSR/+ACOUSTICS
%   iosr.acoustics.irStats               - Calculate RT, DRR, Cte, and EDT for impulse response file
%   iosr.acoustics.rtEst                 - Estimate reverberation time based on room size and absorption
%
%   +IOSR/+AUDITORY
%   iosr.auditory.azimuth2itd            - Convert azimuth in degrees to ITD
%   iosr.auditory.binSearch              - Conduct a binary search
%   iosr.auditory.calcIld                - Calculate normalised interaural level difference
%   iosr.auditory.chXcorr                - Calculate cross-correlograms with a wide range of options
%   iosr.auditory.chXcorr2               - Calculate cross-correlograms with a range of options
%   chXcorr2_c.c
%   chXcorr_c.c
%   iosr.auditory.createWindow           - Create a Hann or exp. window with specified onsets/offsets
%   iosr.auditory.dupWeight              - Calculate duplex weighting coefficients for ITD and ILD
%   iosr.auditory.erbRate2hz             - Convert ERB rate to Hz
%   iosr.auditory.freqMulti              - Calculate frequency coefficient for ITD-azimuth warping
%   iosr.auditory.gammatoneFast          - Produce an array of responses from gammatone filters via FFT
%   iosr.auditory.hz2erbRate             - Convert Hz to ERB rate
%   iosr.auditory.iso226                 - ISO 226:2003 Normal equal-loudness-level contours
%   iosr.auditory.itd2azimuth            - Convert ITD to azimuth
%   iosr.auditory.lindemannInh           - Signal pre-processing for Lindemann's cross-correlation
%   iosr.auditory.loudWeight             - Calculate loudness weighting coefficients
%   iosr.auditory.makeErbCFs             - Make a series of center frequencies equally spaced in ERB-rate
%   iosr.auditory.meddisHairCell         - Calculate Ray Meddis' hair cell model for a number of channels
%   iosr.auditory.perceptualCentroid     - Perceptual spectral centroid
%   iosr.auditory.perceptualCentroid2    - Alternative perceptual spectral centroid
%   iosr.auditory.xcorrLindemann         - Cross-correlation based on Lindemann's precedence model
%   xcorrLindemann_c.c
%
%   +IOSR/+BSS
%   iosr.bss.applyIdealMasks             - Calculate and apply ideal masks via STFT
%   iosr.bss.applyMask                   - Apply a time-frequency mask to an STFT
%   iosr.bss.calcImr                     - Calculates the Ideal Mask Ratio (IMR)
%   iosr.bss.calcSnr                     - Calculate the separation SNR
%   iosr.bss.cfs2fcs                     - Calculate gammatone crossover frequencies
%   iosr.bss.example                     - Determine STFT parameters
%   iosr.bss.generateMixtures            - Generate arrays of mixtures from targets and interferers
%   iosr.bss.getFullMask                 - Convert frame rate mask to a sample-by-sample mask
%   iosr.bss.idealMasks                  - Calculate ideal time-frequency masks from STFTs
%   iosr.bss.mixture                     - Class of sound source separation mixture
%   iosr.bss.resynthesise                - Resynthesise a target from a time-frequency mask
%   iosr.bss.source                      - Class of sound source separation source
%
%   +IOSR/+DSP
%   iosr.dsp.audio                       - Abstract superclass providing audio-related properties and methods
%   iosr.dsp.autocorr                    - Perform autocorrelation via FFT
%   iosr.dsp.convFft                     - Convolve two vectors using FFT multiplication
%   iosr.dsp.istft                       - Calculate the Inverse Short-Time Fourier Transform
%   iosr.dsp.lapwin                      - Laplace window
%   iosr.dsp.localpeaks                  - Find local peaks and troughs in a vector
%   iosr.dsp.ltas                        - Calculate the long-term average spectrum of a signal
%   iosr.dsp.matchEQ                     - Match the LTAS of a signal to an arbitrary spectral magnitude
%   iosr.dsp.rcoswin                     - Raised cosine window
%   iosr.dsp.rms                         - Calculate the rms of a vector or matrix
%   iosr.dsp.sincFilter                  - Apply a near-ideal low-pass or band-pass brickwall filter
%   iosr.dsp.smoothSpectrum              - Apply 1/N-octave smoothing to a frequency spectrum
%   iosr.dsp.stft                        - Calculate the short-time Fourier transform of a signal
%   iosr.dsp.vsmooth                     - Smooth a vector using mathematical functions
%
%   +IOSR/+FIGURES
%   iosr.figures.chMap                   - Create a monochrome-compatible colour map
%   iosr.figures.cmrMap                  - Create a monochrome-compatible colour map
%   iosr.figures.multiwaveplot           - Stacked line plots from a matrix or vectors
%   iosr.figures.subfigrid               - Create axis positions for subfigures
%
%   +IOSR/+GENERAL
%   iosr.general.cell2csv                - Output a cell array to a CSV file
%   iosr.general.checkMexCompiled        - Check if mex file is compiled for system
%   iosr.general.getContents             - Get the contents of a specified directory
%   iosr.general.updateContents          - Create a Contents.m file including subdirectories
%   iosr.general.urn                     - Generate random number sequence without duplicates
%
%   +IOSR/+STATISTICS
%   iosr.statistics.boxPlot              - Draw a box plot
%   iosr.statistics.functionalBoxPlot    - Draw a functional boxplot
%   iosr.statistics.functionalPlot       - Abstract superclass for functional plots
%   iosr.statistics.functionalSpreadPlot - Draw a functional plot showing data spread
%   iosr.statistics.getRmse              - Calculate the root-mean-square error between input data
%   iosr.statistics.laprnd               - Pseudorandom numbers drawn from the Laplace distribution
%   iosr.statistics.qqPlot               - Quantile-quantile plot with patch option
%   iosr.statistics.quantile             - Quantiles of a sample via various methods
%   iosr.statistics.statsPlot            - An abstract superclass for classes that plot statistics
%   iosr.statistics.tab2box              - Prepare tabular data for boxPlot function
%   iosr.statistics.trirnd               - Pseudorandom numbers drawn from the triangular distribution
%
%   +IOSR/+SVN
%   iosr.svn.buildSvnProfile             - Read data from files tagged with SVN keywords
%   iosr.svn.headRev                     - Retrieve the head revision for specified files
%   iosr.svn.readSvnKeyword              - Read data from a file tagged with an SVN keyword
%
%   This file was generated by updateContents.m on 31 May 2017 at 17:06:32.


function [fMshift, fProbability, fAICc, mProblikelihood, bH, bH2] = calc_loglikelihood_dM2(mCat1, mCat2)
% function [fMshift, fProbability, fAICc, mProblikelihood, bH] = calc_loglikelihood_dM2(mCat1, mCat2);
% ----------------------------------------------------------------------------------------------------
% Calculate log-likelihood estimation of magnitude shift dM between to periods; use power-law
% approximation to first time period for comparison
%
% Incoming variable
% mCat1 : EQ catalog period 1
% mCat2 : EQ catalog period 2 (Observed catalog)
%
% Outgoing variable
% fProbability    : log-likelihood probabilty
% fMshift         : Magnitude shift with the lowest  max. lieklihood score
% fAICc           : Corrected Akaike Information Criterion
% mProblikelihood : Solution matrix shift and likelihood score
% bH              : Result of KSTEST2 hypothesis test at 0.05 significance level
% bH2             : Result of KSTEST2 hypothesis test at 0.05 significance level on EMR-model
%
% Author: J. Woessner, woessner@seismo.ifg,.ethz.ch
% last update: 02.02.04

% Initialize
mProblikelihood = [];
vfProbability = [];
vMshift = [];
vMc = [];
fBinning = 0.1;

% Determine exact time period
fPeriod1 = max(mCat1(:,3)) - min(mCat1(:,3));
fPeriod2 = max(mCat2(:,3)) - min(mCat2(:,3));

mCat1Mod = mCat1;

for fMshift = -0.4:0.1:0.4
    % Apply shift
    mCat1Mod(:,6) = mCat1(:,6)+fMshift;
    % Initialize values
    fMinMag = floor(min([min(mCat1Mod(:,6)) min(mCat2(:,6))]));
    fMaxMag = ceil(max([max(mCat1Mod(:,6)) max(mCat2(:,6))]));
    %% Calculate model for best fitting Mc
     try
        [mResult, fMls, fMc, fMu, fSigma, mDataPred, vPredBest, fBvalue] = calc_McCdfnormal(mCat1Mod, fBinning);
        vPredFMD = mDataPred(:,1)'./fPeriod1;
        vMags = mDataPred(:,2)';
        [vModFMD,vBin1] = hist(mCat1Mod(:,6),fMinMag:0.1:fMaxMag);
        [vObsFMD,vBin2] = hist(mCat2(:,6),min(vMags):0.1:max(vMags));
%             figure_w_normalized_uicontrolunits(40)
%             plot(vBin2, vObsFMD./fPeriod2,'bo')
%             hold on
%             plot(vBin1, vModFMD./fPeriod1,'go')
%             plot(vMags,vPredFMD,'r*')
%             hold off
%             drawnow
        % Time normalization and round due to Poisson distribution calculation in calc_log10poisspdf
        vObsFMD = ceil(vObsFMD./fPeriod2);
        % Calculate the likelihoods for both models
        vProb_ = calc_log10poisspdf2(vObsFMD',vPredFMD');
        % Sum the probabilities
        fProbability = (-1) * sum(vProb_);
        vfProbability = [vfProbability; fProbability];
        vMshift = [vMshift; fMshift];
        vMc = [vMc; fMc];
    catch
        vfProbability = [vfProbability; NaN];
        vMshift = [vMshift; NaN];
        vMc = [vMc; NaN];
    end; % of try-catch
end

try
    %%% Find the minimum loglikelihood score: if the minimum score is obtained several times, calculate MEAN
    %%% of the magnitude shift
    vdMloglikeli = [vfProbability vMshift];
    vSel = (vdMloglikeli == nan(vdMloglikeli(:,1)));
    vdMloglikeli = vdMloglikeli(vSel,:);
    if length(vdMloglikeli(:,1)) > 1
        fProbability = min(vdMloglikeli(:,1));
        fMshift = roundn(mean(vdMloglikeli(:,2)),-1);
    else
        fProbability = vdMloglikeli(:,1);
        fMshift = vdMloglikeli(:,2);
    end
    % KS-Test
    [bH,fPval,fKsstat] = kstest2(roundn(mCat2(:,6),-1),roundn(mCat1(:,6)+fMshift,-1),0.05,0);
    % Solution matrix
    mProblikelihood = [vMc vMshift vfProbability];
    nDegFree = 1; % Magnitude shift is the degree of freedom
    n_samples = length(mCat1(:,6))+length(mCat2(:,6));
    %% Corrected Akaike Information Criterion (AICc)
    fAICc = -2*(-fProbability)+2*nDegFree+2*nDegFree*(nDegFree+1)/(n_samples-nDegFree-1);

    % KSTest on Model
    vMag1 = [];
    mCat1Mod(:,6) = mCat1(:,6)+fMshift;
    [mResult, fMls, fMc, fMu, fSigma, mDataPred, vPredBest, fBvalue] = calc_McCdfnormal(mCat1Mod, fBinning);
    mPredFMD = mDataPred;
    %mPredFMD(:,1) = ceil(mDataPred(:,1)./fPeriod1);
    vSel = (mPredFMD(:,2) ~= 0); % Remove bins with zero frequency of zero events
    mData2 = mPredFMD(vSel,:);
    for nCnt=1:length(mData2(:,1))
        fM = repmat(mData2(nCnt,2),mData2(nCnt,1),1);
        vMag1 = [vMag1; fM];
    end
    [bH2,fPval2,fKsstat2] = kstest2(roundn(mCat2(:,6),-1),roundn(vMag1,-1),0.05,0);

catch
    mProblikelihood = [NaN NaN NaN];
    fAICc = NaN;
    fMshift = NaN;
    fProbability = NaN;
    bH = NaN;
    bH2 = NaN;
end; % of try-catch


function mpc = case9target
%CASE9TARGET    Target injection power flow data for 9 bus, 3 generator case.
%   Please see CASEFORMAT for details on the case file format.
%
%   Modified version of case9.m used as target for example CPF.

%   MATPOWER

%% MATPOWER Case Format : Version 2
mpc.version = '2';

%%-----  Power Flow Data  -----%%
%% system MVA base
mpc.baseMVA = 100;

%% bus data
%	bus_i	type	Pd	Qd	Gs	Bs	area	Vm	Va	baseKV	zone	Vmax	Vmin
mpc.bus = [
	1	3	0	0	0	0	1	1	0	345	1	1.1	0.9;
	2	2	0	0	0	0	1	1	0	345	1	1.1	0.9;
	3	2	0	0	0	0	1	1	0	345	1	1.1	0.9;
	4	1	0	0	0	0	1	1	0	345	1	1.1	0.9;
	5	1	305.4	123.15	0	0	1	1	0	345	1	1.1	0.9;
	6	1	0	0	0	0	1	1	0	345	1	1.1	0.9;
	7	1	214.11	71.09	0	0	1	1	0	345	1	1.1	0.9;
	8	1	0	0	0	0	1	1	0	345	1	1.1	0.9;
	9	1	235.61	81.44	0	0	1	1	0	345	1	1.1	0.9;
];

%% generator data
%	bus	Pg	Qg	Qmax	Qmin	Vg	mBase	status	Pmax	Pmin	Pc1	Pc2	Qc1min	Qc1max	Qc2min	Qc2max	ramp_agc	ramp_10	ramp_30	ramp_q	apf
mpc.gen = [
	1	72.3	27.03	300	-300	1.04	100	1	250	10	0	0	0	0	0	0	0	0	0	0	0;
	2	248	0	300	-300	1.025	100	1	300	10	0	0	0	0	0	0	0	0	0	0	0;
	3	124.59	0	300	-300	1.025	100	1	270	10	0	0	0	0	0	0	0	0	0	0	0;
];

%% branch data
%	fbus	tbus	r	x	b	rateA	rateB	rateC	ratio	angle	status	angmin	angmax
mpc.branch = [
	1	4	0	0.0576	0	250	250	250	0	0	1	-360	360;
	4	5	0.017	0.092	0.158	250	250	250	0	0	1	-360	360;
	5	6	0.039	0.17	0.358	150	150	150	0	0	1	-360	360;
	3	6	0	0.0586	0	300	300	300	0	0	1	-360	360;
	6	7	0.0119	0.1008	0.209	150	150	150	0	0	1	-360	360;
	7	8	0.0085	0.072	0.149	250	250	250	0	0	1	-360	360;
	8	2	0	0.0625	0	250	250	250	0	0	1	-360	360;
	8	9	0.032	0.161	0.306	250	250	250	0	0	1	-360	360;
	9	4	0.01	0.085	0.176	250	250	250	0	0	1	-360	360;
];

%%-----  OPF Data  -----%%
%% generator cost data
%	1	startup	shutdown	n	x1	y1	...	xn	yn
%	2	startup	shutdown	n	c(n-1)	...	c0
mpc.gencost = [
	2	1500	0	3	0.11	5	150;
	2	2000	0	3	0.085	1.2	600;
	2	3000	0	3	0.1225	1	335;
];


function [g1, g2] = lfmaXlfmKernGradient(lfmKern1, lfmKern2, t1, t2, covGrad, meanVector)

% LFMAXLFMKERNGRADIENT Compute a cross gradient between a LFMA and a LFM.
% FORMAT
% DESC computes cross gradient of parameters of a cross kernel
% between two lfm kernels, one lfm kernel corresponds to the accel. and
% the other corresponds to the position. It is supposed to be used together
% with the multiple output kernel.
% ARG lfmKern1 : the kernel structure associated with the first LFM
% kernel (acceleration).
% ARG lfmKern2 : the kernel structure associated with the second LFM
% kernel (position).
% ARG t1 : inputs for which kernel is to be computed.
% ARG covGrad : gradient of the objective function with respect to
% the elements of the cross kernel matrix.
% RETURN g1 : gradient of the parameters of the first kernel, for
% ordering see lfmKernExtractParam.
% RETURN g2 : gradient of the parameters of the second kernel, for
% ordering see lfmKernExtractParam.
%
% FORMAT
% DESC computes cross gradient of parameters of a cross kernel
% between two lfm kernels, one lfm kernel corresponds to the accel. and
% the other corresponds to the position. It is supposed to be used together
% with the multiple output kernel.
% ARG lfmKern1 : the kernel structure associated with the first LFM
% kernel (acceleration).
% ARG lfmKern2 : the kernel structure associated with the second LFM
% kernel (position).
% ARG t1 : row inputs for which kernel is to be computed.
% ARG t2 : column inputs for which kernel is to be computed.
% ARG covGrad : gradient of the objective function with respect to
% the elements of the cross kernel matrix.
% RETURN g1 : gradient of the parameters of the first kernel, for
% ordering see lfmKernExtractParam.
% RETURN g2 : gradient of the parameters of the second kernel, for
% ordering see lfmKernExtractParam.
%
% FORMAT
% DESC computes cross gradient of parameters of a cross kernel
% between two lfm kernels, one lfm kernel corresponds to the accel. and
% the other corresponds to the position. It is supposed to be used together
% with the multiple output kernel.
% ARG lfmKern1 : the kernel structure associated with the first LFM
% kernel (acceleration).
% ARG lfmKern2 : the kernel structure associated with the second LFM
% kernel (position).
% ARG t1 : row inputs for which kernel is to be computed.
% ARG t2 : column inputs for which kernel is to be computed.
% ARG covGrad : gradient of the objective function with respect to
% the elements of the cross kernel matrix.
% ARG meanVec : precomputed factor that is used for the switching dynamical
% latent force model.
% RETURN g1 : gradient of the parameters of the first kernel, for
% ordering see lfmKernExtractParam.
% RETURN g2 : gradient of the parameters of the second kernel, for
% ordering see lfmKernExtractParam.
%
% SEEALSO : multiKernParamInit, multiKernCompute, lfmvKernParamInit
%
% COPYRIGHT : Mauricio Alvarez, 2010

% KERN

subComponent = false; % This is just a flag that indicates if this kernel is part of a bigger kernel (SDLFM)

if nargin == 4
    covGrad = t2;
    t2 = t1;
elseif nargin == 6
    subComponent = true;
    if numel(meanVector)>1
        if size(meanVector,1) == 1,
            if size(meanVector, 2)~=size(covGrad, 2)
                error('The dimensions of meanVector don''t correspond to the dimensions of covGrad')
            end
        else
            if size((meanVector'), 2)~=size(covGrad,2)
                error('The dimensions of meanVector don''t correspond to the dimensions of covGrad')
            end
        end
    else
        if numel(t1)==1 && numel(t2)>1
            % matGrad will be row vector and so should be covGrad
            dimcovGrad = length(covGrad);
            covGrad = reshape(covGrad, [1 dimcovGrad]);
        elseif numel(t1)>1 && numel(t2)==1
            % matGrad will be column vector and sp should be covGrad
            dimcovGrad = length(covGrad);
            covGrad = reshape(covGrad, [dimcovGrad 1]);
        end
    end
end

if size(t1, 2) > 1 || size(t2, 2) > 1
    error('Input can only have one column');
end
if lfmKern1.inverseWidth ~= lfmKern2.inverseWidth
    error('Kernels cannot be cross combined if they have different inverse widths.')
end

% Parameters of the simulation (in the order providen by kernExtractParam)

m = [lfmKern1.mass lfmKern2.mass];                  % Par. 1
D = [lfmKern1.spring lfmKern2.spring];              % Par. 2
C = [lfmKern1.damper lfmKern2.damper];              % Par. 3
sigma2 = 2/lfmKern1.inverseWidth;                   % Par. 4
sigma = sqrt(sigma2);
S = [lfmKern1.sensitivity lfmKern2.sensitivity];    % Par. 5

alpha = C./(2*m);
omega = sqrt(D./m-alpha.^2);

% Initialization of vectors and matrices

g1 = zeros(1,5);
g2 = zeros(1,5);

% Precomputations
computeH  = cell(4,1);
computeUpsilonMatrix = cell(2,1);
computeUpsilonVector = cell(2,1);
gradientUpsilonMatrix = cell(4,1);
gradientUpsilonVector = cell(4,1);
gamma1_p = alpha(1) + j*omega(1);
gamma1_m = alpha(1) - j*omega(1);
gamma2_p = alpha(2) + j*omega(2);
gamma2_m = alpha(2) - j*omega(2);
preExp1 = zeros(length(t1),2);
preExp2 = zeros(length(t2),2);
preExpg1 = zeros(length(t1),2);
preExpgg1 = zeros(length(t1),2);
preExpt1 = zeros(length(t1),2);
preExpt2 = zeros(length(t2),2);
preGamma(1) = gamma1_p + gamma2_p;
preGamma(2) = gamma1_p + gamma2_m;
preGamma(3) = gamma1_m + gamma2_p;
preGamma(4) = gamma1_m + gamma2_m;
preGamma2 = preGamma.^2;
preConst = 1./preGamma;
preConst2 = 1./(preGamma2);
preFactors(1) = preConst(2) - preConst(1);
preFactors(2) = preConst(3) - preConst(4);
preFactors(3) = preConst(3) - preConst(1);
preFactors(4) = preConst(2) - preConst(4);
preFactors2(1) = -preConst2(2) + preConst2(1);
preFactors2(2) = -preConst2(3) + preConst2(4);
preFactors2(3) = -preConst2(3) + preConst2(1);
preFactors2(4) = -preConst2(2) + preConst2(4);
preExp1(:,1) = exp(-gamma1_p*t1);
preExp1(:,2) = exp(-gamma1_m*t1);
preExp2(:,1) = exp(-gamma2_p*t2);
preExp2(:,2) = exp(-gamma2_m*t2);
preExpg1(:,1) = (2*gamma1_p)*preExp1(:,1);
preExpg1(:,2) = (2*gamma1_m)*preExp1(:,2);
preExpgg1(:,1) = (gamma1_p^2)*preExp1(:,1);
preExpgg1(:,2) = (gamma1_m^2)*preExp1(:,2);
preExpt1(:,1) = t1.*preExpgg1(:,1);
preExpt1(:,2) = t1.*preExpgg1(:,2);
preExpt2(:,1) = t2.*exp(-gamma2_p*t2);
preExpt2(:,2) = t2.*exp(-gamma2_m*t2);
[computeH{1}, computeUpsilonMatrix{1}, computeUpsilonMatrixLocal{1}] =  lfmComputeH3AP(gamma1_p, gamma1_m, sigma2, t1,t2,preFactors([1 2]), 0);
[computeH{2}, computeUpsilonMatrix{2}, computeUpsilonMatrixLocal{2}] =  lfmComputeH3AP(gamma2_p, gamma2_m, sigma2, t2,t1,preFactors([3 4]), 1);
[computeH{3}, computeUpsilonVector{1}, computeUpsilonVectorLocal{1}] =  lfmComputeH4AP(gamma1_p, gamma1_m, sigma2, t1, preGamma([1 2 4 3]), preExp2, 0 );
[computeH{4}, computeUpsilonVector{2}, computeUpsilonVectorLocal{2}] =  lfmComputeH4AP(gamma2_p, gamma2_m, sigma2, t2, preGamma([1 3 4 2]), preExpgg1, 1 );
preKernel = ( computeH{1} + computeH{2}.' + computeH{3} + computeH{4}.');

% Precompute derivatives
gradientUpsilonMatrix{1} = lfmapGradientUpsilonMatrix(gamma1_p,sigma2,t1, t2, 0, computeUpsilonMatrixLocal{1}{1});
gradientUpsilonMatrix{2} = lfmapGradientUpsilonMatrix(gamma1_m,sigma2,t1, t2, 0, computeUpsilonMatrixLocal{1}{2});
gradientUpsilonMatrix{3} = lfmapGradientUpsilonMatrix(gamma2_p,sigma2,t2, t1, 1, computeUpsilonMatrixLocal{2}{1});
gradientUpsilonMatrix{4} = lfmapGradientUpsilonMatrix(gamma2_m,sigma2,t2, t1, 1, computeUpsilonMatrixLocal{2}{2});
gradientUpsilonVector{1} = lfmapGradientUpsilonVector(gamma1_p,sigma2,t1, computeUpsilonVectorLocal{1}{1});
gradientUpsilonVector{2} = lfmapGradientUpsilonVector(gamma1_m,sigma2,t1, computeUpsilonVectorLocal{1}{2});
gradientUpsilonVector{3} = lfmGradientUpsilonVector(gamma2_p,sigma2,t2);
gradientUpsilonVector{4} = lfmGradientUpsilonVector(gamma2_m,sigma2,t2);

if lfmKern1.isNormalised
    K0 =  lfmKern1.sensitivity*lfmKern2.sensitivity/(8*sqrt(2)*lfmKern1.mass*lfmKern2.mass*prod(omega));
    K02 = 1/(8*sqrt(2)*prod(m)*prod(omega));
else
    K0 =  sigma*sqrt(pi)*lfmKern1.sensitivity*lfmKern2.sensitivity/(8*lfmKern1.mass*lfmKern2.mass*prod(omega));
    K02 = sigma*sqrt(pi)/(8*prod(m)*prod(omega));
end

% Gradient with respect to m, D and C
for ind_theta = 1:3 % Parameter (m, D or C)
    for ind_par = 0:1 % System (1 or 2)
        % Choosing the right gradients for m, omega, gamma1 and gamma2
        switch ind_theta
            case 1  % Gradient wrt m
                gradThetaM = [1-ind_par ind_par];
                gradThetaAlpha = -C./(2*(m.^2));
                gradThetaOmega = (C.^2-2*m.*D)./(2*(m.^2).*sqrt(4*m.*D-C.^2));
            case 2  % Gradient wrt D
                gradThetaM = zeros(1,2);
                gradThetaAlpha = zeros(1,2);
                gradThetaOmega = 1./sqrt(4*m.*D-C.^2);
            case 3  % Gradient wrt C
                gradThetaM = zeros(1,2);
                gradThetaAlpha = 1./(2*m);
                gradThetaOmega = -C./(2*m.*sqrt(4*m.*D-C.^2));
        end
        gradThetaGamma1 = gradThetaAlpha + j*gradThetaOmega;
        gradThetaGamma2 = gradThetaAlpha - j*gradThetaOmega;
        % Gradient evaluation
        gradThetaGamma11 = [gradThetaGamma1(1) gradThetaGamma2(1)];
        gradThetaGamma2 = [gradThetaGamma1(2) gradThetaGamma2(2)];
        gradThetaGamma1 = gradThetaGamma11;

        if ~ind_par % ind_par = k or d
            matGrad = K0 ...
                * ( lfmGradientH31( preFactors([1 2]), preFactors2([1 2]), gradThetaGamma1, ...
                gradientUpsilonMatrix{1}, gradientUpsilonMatrix{2}, computeUpsilonMatrix{1}{1}, ...
                computeUpsilonMatrix{1}{2}, 1) + ...
                lfmGradientH32( preGamma2,  gradThetaGamma1, computeUpsilonMatrix{2}{1}, ...
                computeUpsilonMatrix{2}{2}, 1).' + ...
                lfmGradientH41( preGamma, preGamma2, gradThetaGamma1, preExp2, ...
                gradientUpsilonVector{1}, gradientUpsilonVector{2}, computeUpsilonVector{1}{1},...
                computeUpsilonVector{1}{2}, 1) + ...
                lfmGradientH42AP(preGamma, preGamma2, gradThetaGamma1, preExpg1, preExpgg1, preExpt1, ...
                computeUpsilonVector{2}{1}, computeUpsilonVector{2}{2}).'...
                - (gradThetaM(1+ind_par)/m(1+ind_par) ...
                + gradThetaOmega(1+ind_par)/omega(1+ind_par)) ...
                *preKernel);
        else % ind_par = r or d'
            matGrad = K0 ...
                * ( lfmGradientH31( preFactors([3 4]), preFactors2([3 4]), gradThetaGamma2, ...
                gradientUpsilonMatrix{3}, gradientUpsilonMatrix{4}, computeUpsilonMatrix{2}{1}, ...
                computeUpsilonMatrix{2}{2}, 1).' + ...
                lfmGradientH32( preGamma2([1 3 2 4]),  gradThetaGamma2, computeUpsilonMatrix{1}{1}, ...
                computeUpsilonMatrix{1}{2}, 1) + ...
                lfmGradientH41( preGamma([1 3 2 4]), preGamma2([1 3 2 4]), gradThetaGamma2, preExpgg1, ...
                    gradientUpsilonVector{3}, gradientUpsilonVector{4}, computeUpsilonVector{2}{1},...
                    computeUpsilonVector{2}{2}, 1).' + ...
                lfmGradientH42(preGamma([1 3 2 4]), preGamma2([1 3 2 4]), gradThetaGamma2, preExp2, preExpt2, ...
                computeUpsilonVector{1}{1}, computeUpsilonVector{1}{2}, 1)...
                - (gradThetaM(1+ind_par)/m(1+ind_par) ...
                + gradThetaOmega(1+ind_par)/omega(1+ind_par)) ...
                *preKernel);
        end

        if subComponent
            if size(meanVector,1) ==1,
                matGrad = matGrad*meanVector;
            else
                matGrad = (meanVector*matGrad).';
            end
        end

        % Check the parameter to assign the derivative
        if ind_par == 0
            g1(ind_theta) = sum(sum(matGrad.*covGrad));
        else
            g2(ind_theta) = sum(sum(matGrad.*covGrad));
        end
    end
end

% Gradients with respect to sigma
if lfmKern1.isNormalised
    matGrad = K0*(lfmGradientSigmaH3AP(gamma1_p, gamma1_m, sigma2, t1, t2, preFactors([1 2]), 0)...
        +  lfmGradientSigmaH3AP(gamma2_p, gamma2_m, sigma2, t2, t1, preFactors([3 4]), 1).'...
        +  lfmGradientSigmaH4AP(gamma1_p, gamma1_m, sigma2, t1, preGamma([1 2 4 3]), preExp2, 0 )...
        +  lfmGradientSigmaH4AP(gamma2_p, gamma2_m, sigma2, t2, preGamma([1 3 4 2]), preExpgg1, 1 ).');
else
    matGrad = (prod(S)*sqrt(pi)/(8*prod(m)*prod(omega))) ...
        * (preKernel ...
        + sigma*(lfmGradientSigmaH3AP(gamma1_p, gamma1_m, sigma2, t1, t2, preFactors([1 2]), 0)...
        +  lfmGradientSigmaH3AP(gamma2_p, gamma2_m, sigma2, t2, t1, preFactors([3 4]), 1).'...
        +  lfmGradientSigmaH4AP(gamma1_p, gamma1_m, sigma2, t1, preGamma([1 2 4 3]), preExp2, 0 )...
        +  lfmGradientSigmaH4AP(gamma2_p, gamma2_m, sigma2, t2, preGamma([1 3 4 2]), preExpgg1, 1 ).' ));
end

if subComponent
    if size(meanVector,1) ==1,
        matGrad = matGrad*meanVector;
    else
        matGrad = (meanVector*matGrad).';
    end
end
g1(4) = sum(sum(matGrad.*covGrad))*(-(sigma^3)/4);
g2(4) = g1(4);

% Gradients with respect to S

matGrad = K02*preKernel;

if subComponent
    if size(meanVector,1) ==1,
        matGrad = matGrad*meanVector;
    else
        matGrad = (meanVector*matGrad).';
    end
end

g1(5) = sum(sum(S(2)*matGrad.*covGrad));
g2(5) = sum(sum(S(1)*matGrad.*covGrad));

g2(4) = 0; % Otherwise is counted twice, temporarly changed by Mauricio Alvarez

g1 = real(g1);
g2 = real(g2);


function x_it=m_st_block(x_it,mparams)
%m_st_block   block preconditioner for Stokes equations
%   x_it = m_st_block(x_it,mparams);
%   input
%          x_it         operand for preconditioning operator
%          mparams      structure defining block preconditioning operator
%   output
%          x_it         result of ilu preconditioning operation
%
%   IFISS function: DJS, HCE; 9 April 2005.
% Copyright (c) 2005 D.J. Silvester, H.C. Elman, A. Ramage

nv=size(mparams.Ast,1); np=size(mparams.Q,1);
rv=x_it(1:nv); rp=x_it(nv+1:nv+np);
zv=mparams.Ast\rv; zp=mparams.Q\rp;
x_it = [zv;zp];


% start : starting time of audio signal in seconds(e.g. 0 second)
% finish : e.g. ending time of audio signal in seconds (e.g. 30 second)
% filename: the input file (wavfile)
%
%
% segments: the signal segmentation with 20 msec accuracy based on RMS,
% if segments(i) = 1 then there is a change, otherwize segments(i) = 0
% The command find(segments == 1)/50 yields the signal segmentation times in sec
%
% classif: final classification of signal. classif(i) is the class
% of the i^{th} (20 msec) interval of the given signal (see also Fig 2 (b))
%
% Fig 1 shows the propability of each class per segment
%
% Fig 2 (a) shows the  segmentation of the audio signal
% Fig 2 (b) shows the  classification of the audio signal
% Fig 2 (c) shows the  RMS of the audio signal
%
% example to run: [classif, segments]=trmszc(0,60,'test3.wav')

function [classif, segments]=trmszc(start,finish,filename)

segments = [];
classif = [];

[Y1,FS,NBITS,OPTS]=wavread(filename,[1 5]);
duration = finish-start;
kanalia = size(Y1,2);
arxh = start*FS;
m = 100;
timeread = 1;

Vt = 0*[1:50];
Vta = [];
Vtz = 0*[1:50];
Vtz1 = 0*[1:50];

Vtaz = [];
Vtaz1 = [];

shma = [];
temp = [];
y = 0;
py = [1:1:50];

scp = 0;
sc = 0;
Vtp = [1:1:50];
i=1;
[PYs,FS,NBITS,OPTS]=wavread(filename,[arxh+1+(i-1)*timeread*FS  arxh+i*timeread*FS]);
sf11 = 0;
aVt = [];

%READING - Computation of RMS-ZC-RMS*ZC per 20 msec

for i=1:floor(duration/timeread),
   [Ys,FS,NBITS,OPTS]=wavread(filename,[arxh+1+(i-1)*timeread*FS  arxh+i*timeread*FS]);
   if kanalia==2,
      Ys = Ys(:,1)+Ys(:,2);
   end
   for j=1:timeread*50,
      y = Ys(round((j-1)*0.02*FS+1):floor(j*0.02*FS));
      rms = sqrt(sum(y.*y));
      Vtp = Vt;
      Vt = [Vt(2:50) rms];
      l = length(y);
      y1 = y(1:l-1);
      y2 = y(2:l);
      mm1 = y1.*y2;
      zc = 0.5*sum((abs(sign(mm1))-sign(mm1)));
      Vtz1 = [Vtz1(2:50) zc];
      zc = zc*rms;
      Vtz = [Vtz(2:50) zc];
   end

   m = mean(Vt);
   v = var(Vt);
   Vta = [Vta Vt];
   Vtaz = [Vtaz Vtz];
   Vtaz1 = [Vtaz1 Vtz1];

   if (v ~= 0 & m ~= 0)
      b(i) = v/m;
      a(i) = (m/b(i))-1;
   else
      b(i) = 1000000;
      a(i) = -1;
   end
end

%Computation of  KVRMS

l = length(Vta);
ftm(1) = mean(Vta(1:50));
ftv(1) = var(Vta(1:50));
for i=2:l-50,
  ftm(i) = ftm(i-1)+(Vta(i+49)-Vta(i-1))/50;
  ftv(i) = ftv(i-1) + ftm(i-1)*ftm(i-1) + ((Vta(i+49)*Vta(i+49)-Vta(i-1)*Vta(i-1))/50) - ftm(i)*ftm(i);

  if  ftm(i)~= 0,
     kvrms(i) =   ftv(i)/(ftm(i)*ftm(i));
  else
     kvrms(i) = 0;
  end
end

l = floor(duration/timeread);
m = mean(kvrms);
v = var(kvrms);
b1111 = v/m;
a111 = (m/b1111)-1;

%computation of similarity (omiot) between windows  based on RMS distribution
for i=2:l,
   k = (a(i)+a(i-1)+2)/2;
   omiot1(i-1) = ((2/(b(i-1)+b(i)))^k)*(b(i-1)^((a(i)+1)/2))*(b(i)^((a(i-1)+1)/2))*gamma(k)/(sqrt(gamma(a(i-1)+1)*gamma(a(i)+1)));
   if omiot1(i-1) ~= omiot1(i-1),
      omiot1(i-1) = 0;
   end
end

for i=3:l,
   k = (a(i)+a(i-2)+2)/2;
   omiot2(i-2) = ((2/(b(i-2)+b(i)))^k)*(b(i-2)^((a(i)+1)/2))*(b(i)^((a(i-2)+1)/2))*gamma(k)/(sqrt(gamma(a(i-2)+1)*gamma(a(i)+1)));
   if omiot2(i-2) ~= omiot2(i-2),
      omiot2(i-2) = 0;
   end
end

P = [];

%Segmentation
%Computation of propability  P of change  (at window i)

for i=2:l-1,
   P(i-1) =(1-omiot2(i-1))*(1-omiot1(i-1)+1-omiot1(i))*(1-omiot2(i-1));
end

for i=2:l-1,
   P(i-1) =(1-omiot2(i-1));
end

P = [0 P 0];

M = mean(P);
V1 = mean(abs(P(1:l-3)-P(2:l-2)));
V2 = mean(abs(P(1:l-4)-P(3:l-2)));

V = (V1+V2)*0.25;

V = 0.25*median(abs((P(1:l-4)-P(3:l-2))));

Pd(1) = P(1);
Pd(2) = P(2);

for i=3:l-2,
   m = mean(P([i-2:i-1 i+1:i+2]));
   m1 = max(P([i-2:i-1 i+1:i+2]));

   if (m < 0.1*M)
      m1 = 0.1*M;
   end
   d = (P(i)-m)/m1;

   if d < 0,
      d = 0;
   end
   Pd(i) = P(i)*d/V;
end
Pd(l) = P(l);
Pd(l-1) = P(l-1);

%window size = 1 sec

%Selection of candicate windows where there is a change

j = 0;
for i=3:l-3,
   if (Pd(i) > 5 & P(i) > P(i+1) & P(i) > P(i-1)),
      j = j+1;
      pos(j) = i;
   end
end

if j == 0,
   return;
end

%Computation of change with 20 msec accurancy

k2 = 1;
c = 25;
for k1=1:length(pos),
   i = 50*(pos(k1)-2);  % msec
   for j=-c:50+c,
      if (ftv(i+j) ~= 0 & ftm(i+j) ~= 0),
         b1 = ftv(i+j)/ftm(i+j);
         a1 = ftm(i+j)/b1-1;
      else
         b1 = 10000;
         a1 = -1;
      end

      if (ftv(i+j+50) ~= 0 & ftm(i+j+50) ~= 0)
         b2 = ftv(i+j+50)/ftm(i+j+50);
         a2 = ftm(i+j+50)/b2-1;
      else
         b2 = 10000;
         a2 = -1;
      end
      k = (a2+a1+2)/2;
      Om(j+c+1) = ((2/(b1+b2))^k)*(b1^((a2+1)/2))*(b2^((a1+1)/2))*gamma(k)/(sqrt(gamma(a1+1)*gamma(a2+1)));
      if Om(j+c+1)~= Om(j+c+1),
         Om(j+c+1) = 0;
      end
   end
   [x posms(k1)] = min(Om);
   h = 1-Om;
   if mean(h(max(posms(k1)-25,1):min(2*c+51,posms(k1)+25))) >  0.1,
      msec(k2) = posms(k1)-1-c;
      mpos(k2) = pos(k1);
      k2 = k2+1;
   end
end

posms = [];
posms = msec;
pos = [];
pos = mpos;

fpos = start+pos-1+0.02*posms;

pfpos = floor(50*pos+posms-50);

bvoise = 0.14339738781836;
bmusic = 0.04399754659151;
amusic = 1.66349817725076;
avoise = 2.32677887950291;

pfpos = [1 pfpos length(kvrms)];
l = length(pfpos)-1;
V = [];
Pzero = [];
Fsp1 = [];

%Classification for each segment

for i=1:l,

   d = 0;

   x1 = mean(kvrms([pfpos(i):pfpos(i+1)]));
   x = x1;
   y = Vtaz([pfpos(i)+d:pfpos(i+1)-d]);
   y = y/(2*max(Vta(pfpos(i)+d:pfpos(i+1)-d)) - min(Vta(pfpos(i)+d:pfpos(i+1)-d))-median(Vta(pfpos(i)+d:pfpos(i+1)-d)));

   thor(i) = 50*mean(exp(-y));

   Pmusic(i) = (x^amusic)*exp(-x/bmusic)/(gamma(amusic+1)*bmusic^(amusic+1));
   Pvoise(i) = 0.5*(x^avoise)*exp(-x/bvoise)/(gamma(avoise+1)*bvoise^(avoise+1));
   sm = 0.7*median(ftm(pfpos(i):pfpos(i+1)))+0.3*mean(ftm(pfpos(i):pfpos(i+1)));
   Pspace(i) =  6*exp((-sm*sm)/(2*0.6*0.6));

   zpos(i) = sum(exp(-10*Vtaz1([pfpos(i)+d:pfpos(i+1)-d])))/length(Vtaz1([pfpos(i)+d:pfpos(i+1)-d]));

   if zpos(i) > 0.08 | x > 3
     Pvoise(i)  = 10;
  else
      Pmusic(i) = (x^amusic)*exp(-x/bmusic)/(gamma(amusic+1)*bmusic^(amusic+1));
      Pvoise(i)  = 0.5*(x^avoise)*exp(-x/bvoise)/(gamma(avoise+1)*bvoise^(avoise+1));
   end

   V(i,:) = [Pmusic(i)  Pvoise(i)];
   [Pmax(i) type(i)] = max(V(i,:));

  thor2(i) = 50*mean(exp(-4*y));
  Pmusicg(i) = 0;

   if thor2(i) > 3.5,
      Pvoiseg(i) = 10;
   else
      Pmusicg(i) = (x^amusic)*exp(-x/bmusic)/(gamma(amusic+1)*bmusic^(amusic+1));
      Pvoiseg(i)  = 0.5*(x^avoise)*exp(-x/bvoise)/(gamma(avoise+1)*bvoise^(avoise+1));
   end

   Vg(i,:) = [Pmusicg(i)  Pvoiseg(i)];
   [Pmaxg(i) typeg(i)] = max(Vg(i,:));

   Vk = (sign(Vtaz1([pfpos(i):pfpos(i+1)])));
   tempV = [];
   tempV = Vta([pfpos(i):pfpos(i+1)]);
   rr = max(tempV)+0.001;
   tempV1 = tempV/rr;
   Vk0 = Vk;

   for j = 1:length(Vk)
      if (tempV1(j) < 0.1 & tempV(j) < 1.5) | tempV(j) < 1
         Vk(j) = 0;
      end
   end
   Vk1 = Vk;

   for j = 1:length(Vk)
      if (tempV1(j) < 0.4 | tempV(j) < 2 | tempV(j) < mean(tempV(j)))
         Vk1(j) = 0;
      end
   end
   Zca = [];
   Zca = Vk1.*(Vtaz1([pfpos(i):pfpos(i+1)]));

   Pol = (ones(1,length(Vk)) -  sign(Vk)).*Vk0;

   VZC = Pol.*Vtaz1([pfpos(i):pfpos(i+1)]);

   dVk = abs(Vk(2:length(Vk))-Vk(1:length(Vk)-1));

   Freq(i,1) = 50*sum(dVk)/(2*length(Vk)); %FSP%
   Freq(i,2) = length(Vk)/50;%duration in sec of the segment
   Freq(i,3) = sum(Freq(:,2));
   Freq(i,4) = zpos(i);
   Freq(i,5) = thor2(i);
   Freq(i,6) =   max(Zca);

   Pmusicg(i) = 0;
   Pvoiseg(i) = 0;
   if Freq(i,1) < 0.59 & Freq(i,2) > 2.5,
      Pmusicg(i) = 10;
   else
      Pmusicg(i) = (x^amusic)*exp(-x/bmusic)/(gamma(amusic+1)*bmusic^(amusic+1));
      Pvoiseg(i)  = 0.5*(x^avoise)*exp(-x/bvoise)/(gamma(avoise+1)*bvoise^(avoise+1));
      if x > 3,
         Pvoiseg(i) = Pvoiseg(i)+0.1;

      end

      if x > 300 ,
         Pmusicg(i) = 9;
     end

      if thor2 > 3.5
         Pvoiseg(i) = 11;
      end
      if max(Zca) > 280,
         Pmusicg(i) = 11;
         max(Zca)

      end
      if Freq(i,1) > 4.62 & Freq(i,2) > 2.5 & (thor2(i) > 0.1 | zpos(i) > 0.05),
         Pvoiseg(i) = 12;
      end

      if zpos(i) > 0.15
         Pvoiseg(i)  = 13;
      end
  end
   Vg(i,:) = [Pmusicg(i)  Pvoiseg(i)];
   [Pmaxg(i) typeg(i)] = max(Vg(i,:));

	Fsp1 = [Fsp1 Vk];

   if (Pspace(i) > 4 & thor2(i) < 1)  | (Pspace(i) > 4.5),
      type(i) = 3; %silence
      typeg(i) = 3;
   end

   if (pfpos(i+1) - pfpos(i))/50 < 0.5 & i >= 1, % short segments
      type(i) = type(i-1);
   end
end

   g = [];
   g1 = [];
   tt = [];
   pt = [];
   pm = [];
   ps = [];
   pv = [];
   pmf = [];

for i=1:l,
   tt = [tt type(i)*ones(1,pfpos(i+1)-pfpos(i))];
   pt = [pt Pmax(i)*ones(1,pfpos(i+1)-pfpos(i))];
   pm = [pm Pmusic(i)*ones(1,pfpos(i+1)-pfpos(i))];
   pv = [pv Pvoise(i)*ones(1,pfpos(i+1)-pfpos(i))];
   ps = [ps Pspace(i)*ones(1,pfpos(i+1)-pfpos(i))];
end

PosV = 100*sum(exp(-10*abs(tt-2*ones(1,length(tt)))))/length(tt);
PosM = 100*sum(exp(-10*abs(tt-ones(1,length(tt)))))/length(tt);

l1 = l;
l = length(tt);

l = l1;
 g = [];
   g1 = [];
   tt = [];
   pt = [];
   pm = [];
   ps = [];
   pv = [];
   pmf = [];

for i=1:l,
   tt = [tt typeg(i)*ones(1,pfpos(i+1)-pfpos(i))];
   pt = [pt Pmaxg(i)*ones(1,pfpos(i+1)-pfpos(i))];
   pm = [pm Pmusicg(i)*ones(1,pfpos(i+1)-pfpos(i))];
   pv = [pv Pvoiseg(i)*ones(1,pfpos(i+1)-pfpos(i))];
   ps = [ps Pspace(i)*ones(1,pfpos(i+1)-pfpos(i))];
end
l = length(tt);

PosVg = 100*sum(exp(-10*abs(tt-2*ones(1,length(tt)))))/length(tt);
PosMg = 100*sum(exp(-10*abs(tt-ones(1,length(tt)))))/length(tt);

figure(1);
subplot(5,1,1);
plot([1:l]*(finish-start-1)/l+start,tt);
title('classification type (1 : Music, 2: Voise, 3: Silence)');
subplot(5,1,2);
plot([1:l]*(finish-start-1)/l+start,pt);
title('~probability posibility of selected type');
subplot(5,1,3);
plot([1:l]*(finish-start-1)/l+start,pm);
title('~probability MUsic');
subplot(5,1,4);
plot([1:l]*(finish-start-1)/l+start,pv);
title('~probability Voise');
subplot(5,1,5);
plot([1:l]*(finish-start-1)/l+start,ps);
title('~probability silence');

for k = 1:length(Vta),
   if Vta(k) < 2 | Vta(k) < 0.1*max(Vta),
      Vtaz1(k) = 0;
   end
end
m = 100;
temp = [];
h1 = [];
temp = Vtaz1;
h1 = hist(temp,m);
h1(1) = 0;
h1 = h1/sum(h1);
a1 = [min(temp):(max(temp)-min(temp))/m:max(temp)-(max(temp)-min(temp))/m];

segbar = [];
j = 1;
i = 1;
while i <= l,
   if j <= length(fpos) & round(50*fpos(j)) == i,
      segbar(i) = 1;
      j = j+1;
   else
      segbar(i) = 0;
   end
   i = i+1;
end

segments = segbar;

figure(2);
subplot(3,1,1);
stem([1:l]*(finish-start-1)/l+start,segbar);
axis([0 duration 0 1]);
title('Segmentation');
xlabel('sec');
subplot(3,1,2);
plot([1:l]*(finish-start-1)/l+start,tt);
axis([0.5 duration 0 3.5]);
title('classification type (1 : Music, 2: Voise, 3: Silence)');
xlabel('sec');
subplot(3,1,3);
plot(start+([1:length(Vta)]*duration/length(Vta)),Vta);
axis([0 duration 0 (floor(max(Vta))+1)]);
title('RMS');
xlabel('sec');

classif = tt;


function [mCat]=sr_makeSRC4(mCat,fTw,T)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% This function removes events and creates a quiescence according to the
% chosen input variables. The lat/lon position of the quiescence is
% determined randomly.
%
% Input Variables
% mCat      Earthquake catalog in zmap-format
% fTw       Duration of PSQ
% T         Starting time of PSQ
% fR        Degree of rate change (0.75 = 75% reduction)
%
% Output Variables
% mCat      Catalog with PSQ%
%
% van Stiphout Thomas ; vanstiphout@sed.ethz.ch
% Created: 14.08.2007
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

disp('zmap/src/thomas/seismicrates/sr_makeSRC4.m')

% rate decrease for grid node
fR=0.75;
fLonPSQ=-116.4;
fLatPSQ=34.3;
nN=300;
fLon0=fLonPSQ;
fLat0=fLatPSQ;

% get N nearest events for certain grid point
%     [caNodeIndices, vResolution_] = ex_CreateIndexCatalog(mCat, [fLon0 fLat0], 1, 0, nN, 99, 0.1, 0.1);
%     % transform cell array to matrix
%     vSel=cell2mat(caNodeIndices);

% get events within certain radius of a grid point
[caNodeIndices, vResolution] = ex_CreateIndexCatalog(mCat, [fLon0 fLat0], 1, 1, ...
    100, 10, 0.1, 0.1);
% transform cell array to matrix
caNodeIndices_=cell2mat(caNodeIndices);
vSel=caNodeIndices_;
% transform cell array to matrix
vResolution_=cell2mat(vResolution);

% control plots
% figure;plot(mCat(:,1),mCat(:,2),'.k');
% hold on;plot(mCat(vSel,1),mCat(vSel,2),'dr');

% select from N events the one in the quiescence time period
vSel3=find((mCat(vSel,3)>T-fTw) & (mCat(vSel,3)<T));
% create help matrix for events in quite period
vSel4=zeros(size(vSel3,1),1);
% determine number of events to remove
fRemove=fR;
% create vector with % events to be removed (=1)
vSel4(1:ceil(size(vSel4,1)*fRemove))=1;
vSel4=logical(vSel4(randperm(size(vSel4,1))));
% Select indices of the N events to be removed
% vSel5 are events to be removed (indices from N events)
vSel5=vSel3(vSel4,1);
% create position of events in mCatalog to be removed
vSelNaN=vSel(vSel5);
% tag events to be removed with NaN
mCat(vSelNaN,1)=NaN;
mCat=mCat(~isnan(mCat(:,1)),:);

%% calculate rate increase in box

fBvalue=1;
fInc=0.1;
fMinLat=33.6;
fMaxLat=33.75;
fMinLon=-116.75;
fMaxLon=-116.5;
mPoly=[fMaxLon fMinLat;fMaxLon fMaxLat;fMinLon fMaxLat;fMinLon fMinLat];
fMinTime=T-fTw;
fMaxTime=T;

[vSel,bnd]=inpoly(mCat(:,1:2),mPoly);
vSel=find(vSel==1);
nNSel=size(vSel,1);
mNewCat=nan(nNSel,size(mCat,2));

% Create magnitudes
[mNewCat] = syn_create_magnitudes(mNewCat, fBvalue, min(mCat(:,6)), fInc);
% Randomize
rng('shuffle');

fMaxDepth=max(mCat(:,7));
fMinDepth=min(mCat(:,7));
% Create location
mNewCat(:,1) = rand(nNSel, 1) * (fMaxLon-fMinLon) + fMinLon;
mNewCat(:,2) = rand(nNSel, 1) * (fMaxLat-fMinLat) + fMinLat;
mNewCat(:,7) = rand(nNSel, 1) * (fMaxDepth-fMinDepth) + fMinDepth;

% Randomize
rng('shuffle');

% Create focal times
mNewCat(:,3) = rand(nNSel, 1) * (fMaxTime-fMinTime) + fMinTime;
% vst: datevec does not transform mNewCat(:,3) properly. Replaced by
% decyear2mat.
mNewCat(:,3)=mNewCat(randperm(size(mNewCat,1)),3);
% [mNewCat(:,10) mNewCat(:,4) mNewCat(:,5) mNewCat(:,8) mNewCat(:,9)] = datevec(mNewCat(:,3));
[mNewCat(:,10) mNewCat(:,4) mNewCat(:,5) mNewCat(:,8) mNewCat(:,9) tmp] = decyear2mat(mNewCat(:,3));

% Remove column 10 (seconds)
% mNewCat = mNewCat(:,1:end);
mCat=[mCat; mNewCat];
[Xsort, Xi]=sort(mCat(:,3),1);
mCat=mCat(Xi,:);


function [sp_fit_group,sp_profiles,sp_fit] = spectdecompose(sp_fit,options,chan)
%
% From a multitaper or MAR estimation of the states spectra (per subject),
% it factorises the spectral information (which is given by frequency bin)
% into a set of spectral components (which are much fewer than the
% frequency bins), in order to facilitate interpretation and visualisation.
% The decomposition can be done either using PCA or non-negative matrix
% factorisation or NNMF (the default). Note that if NNMF is used, the
% solution might somewhat vary every time the function is called.
%
% INPUTS:
%
% sp_fit                The output of hmmspectramar or hmmspectramt. It
%                       should be a cell, where each element corresponds
%                       to one subject
% options               Struct indicating the decomposing options
%        .Ncomp         Number of components (default 4)
%        .Method        'NNMF' or 'PCA' (default 'NNMF')
%        .Base          What to base the factorisation on: PSD if 'psd' or on
%                       coherence if 'coh' (default: 'coh')
%        .sp_profiles   Spectral profiles; if supplied, these will be used
%                       instead of computing them (default: empty)
%        .plot          If the spectral profiles are to be plotted (default: 0)
% chan                  If supplied, a vector of integers defining which
%                       channels will be used in the decomposion;
%                       if not specified, all will beused
%
% OUTPUT:
%
% sp_fit_group          A single struct containing the mean across subjects
%                       of sp_fit. If there is only one subject, then
%                       sp_fit_group equals sp_fit
% sp_profiles           The (frequency bins by spectral components) mixing
%                       matrix used to project from (no. of frequency bins
%                       by regions) to (no. of components by regions)
% sp_fit                A cell with the spectral components, with the same fields
%                       and dimensions that the input 'sp_fit', but with Ncomp
%                       components instead of No. frequency bins. If there
%                       is only one subject, then sp_fit is a single struct
%
% Authors: Mark Woolrich, OHBA, University of Oxford (2017)
%          Diego Vidaurre, OHBA, University of Oxford (2017)
%          Andrew Quinn, OHBA, University of Oxford (2018)

if ~iscell(sp_fit)
    warning('Only one subject was provided; recommended to run at the group level')
    aux = sp_fit;
    sp_fit = {};
    sp_fit{1} = aux;
    clear aux
end

if nargin < 2, options = struct(); end
if ~isfield(options,'Niterations'), options.Niterations = 10; end
if ~isfield(options,'Ncomp'), options.Ncomp = 4; end
if ~isfield(options,'Method'), options.Method = 'NNMF'; end
if ~isfield(options,'Base'), options.Base = 'coh'; end
if ~isfield(options,'plot'), options.plot = 0; end

ndim = size(sp_fit{1}.state(1).psd,2); % no. channels
if nargin < 3, chan = 1:ndim;
else, ndim = length(chan);
end
ndim2 = ndim*(ndim-1)/2;
Nf = size(sp_fit{1}.state(1).psd,1); % no. frequencies
N = length(sp_fit); % no. subjects
K = length(sp_fit{1}.state); % no. states
ind_offdiag = triu(true(ndim),1)==1;

% check that all estimations have the same number of freq bins
for n = 1:N
    if isempty(sp_fit{n})
        error('One or more elements of sp_fit are empty - remove them first')
    end
    if size(sp_fit{n}.state(1).psd,1) ~= Nf
        error(['It is necessary for the spectral estimation of all subjects ' ...
            'to have the same number of frequency bins. ' ...
            'In the case of the multitaper, this is can be done by setting ' ...
            'the options tapers and win to a fixed value.'])
    end
end

% put coh and psd in temporary arrays
psd_comps = zeros(N,K,Nf,ndim);
coh_comps = zeros(N,K,Nf,ndim,ndim);
for n = 1:N
    for k = 1:K
        psd = sp_fit{n}.state(k).psd(:,chan,chan);
        coh = sp_fit{n}.state(k).coh(:,chan,chan);
        for j = chan
            psd_comps(n,k,:,j) = psd(:,j,j);
            for l = chan
                coh_comps(n,k,:,j,l) = coh(:,j,l);
            end
        end
    end
end

% Build the matrix that is to be factorised
Xpsd = zeros(Nf,ndim*K);
keep_psd = true(1,ndim*K);
for k = 1:K
    ind = (1:ndim) + (k-1)*ndim;
    notnan = ~isnan(psd_comps(:,k,1,1)) & ~isinf(psd_comps(:,k,1,1));
    if any(notnan)
        Xpsd(:,ind)= squeeze(mean(abs(psd_comps(notnan,k,:,:)),1)); % mean across subjects
    else
        keep_psd(ind) = false;
    end
end
Xcoh = zeros(Nf,K*ndim2);
keep_coh = true(1,ndim2*K);
for k = 1:K
    ind = (1:ndim2) + (k-1)*ndim2;
    notnan = ~isnan(coh_comps(:,k,1,1,2)) & ~isinf(coh_comps(:,k,1,1,2));
    if any(notnan)
        ck = squeeze(mean(abs(coh_comps(notnan,k,:,:,:)),1));
        Xcoh(:,ind) = ck(:,ind_offdiag);
    else
        Xcoh(:,ind) = false;
    end

end
if strcmpi(options.Base,'psd')
    X = Xpsd(:,keep_psd);
else
    X = Xcoh(:,keep_coh);
end

% Specify fit function, a unimodal gaussian
gauss_func = @(x,f) f.a1.*exp(-((x-f.b1)/f.c1).^2);
% Default fit options
options_fit = fitoptions('gauss1');
% constrain lower and upper bounds
options_fit.Lower = [0,1,0];
options_fit.Upper = [Inf,size(X,1),size(X,1)];

if ~isfield(options,'sp_profiles') || isempty(options.sp_profiles)
    % Doing the decomposition
    if strcmpi(options.Method,'NNMF')
        bestval = Inf; fitval = zeros(options.Niterations,1);
        for ii = 1:options.Niterations
            try
                [A,~] = nnmf(X,options.Ncomp,'replicates',500,'algorithm','als');
            catch
                error('nnmf not found - perhaps the Matlab version is too old')
            end
            for jj = 1:size(A,2)
                f = fit( linspace(1,size(A,1),size(A,1))',A(:,jj), 'gauss1',options_fit);
                residuals = A(:,jj) - gauss_func(1:size(A,1),f)';
                fitval(ii) = fitval(ii) + sum( residuals.^2 ) / size(A,2);
            end
            if fitval(ii) < bestval
                bestval = fitval(ii);
                bestfit = A;
            end
        end
        %sp_profiles = pinv(X') * b'; % you lose non-negativity by doing this
        sp_profiles = bestfit;
        [~,ind] = max(sp_profiles,[],1);
        [~,neworder_auto] = sort(ind);
        sp_profiles = sp_profiles(:,neworder_auto);
    else
        try
            m = mean(X);
            X = X - repmat(m,Nf,1);
            [~,A] = pca(X,'NumComponents',options.Ncomp);
        catch
            error('Error running pca - maybe not matlab''s own?')
        end
        sp_profiles = A;
    end
else
    sp_profiles = options.sp_profiles;
end

% plot if required
if options.plot
    figure;
    if options.Ncomp > 4
        j1 = ceil(options.Ncomp/2); j2 = 2;
    else
        j1 = options.Ncomp; j2 = 1;
    end
    for j = 1:options.Ncomp
        subplot(j1,j2,j)
        plot(sp_profiles(:,j),'LineWidth',2.5)
    end
end

% group level
sp_fit_group = struct();
sp_fit_group.state = struct();

% NNMF / PCA
psd = zeros(ndim*K,options.Ncomp);
coh = zeros(ndim2*K,options.Ncomp);
if strcmpi(options.Method,'NNMF')
   psd(keep_psd,:) = (Xpsd(:,keep_psd)' * sp_profiles); % ndim by components
   coh(keep_coh,:) = (Xcoh(:,keep_coh)' * sp_profiles);
%     opt = statset('maxiter',0);
%     [~,b] = nnmf(Xpsd,options.Ncomp,'algorithm','als',...
%         'w0',sp_profiles,'Options',opt);
%     psd = b'; % regions by components
%     [~,b] = nnmf(Xcoh,options.Ncomp,'algorithm','als',...
%         'w0',sp_profiles,'Options',opt);
%     coh = b'; % pairs of regions by components
else
    Xpsd(:,keep_psd) = Xpsd(:,keep_psd) - repmat(mean(Xpsd(:,keep_psd)),Nf,1);
    Xcoh(:,keep_coh) = Xcoh(:,keep_coh) - repmat(mean(Xcoh(:,keep_coh)),Nf,1);
    psd(keep_psd,:) = (Xpsd(:,keep_psd)' * sp_profiles); % ndim by components
    coh(keep_coh,:) = (Xcoh(:,keep_coh)' * sp_profiles);
end
if any(isnan(psd(:))) || any(isnan(coh(:)))
   warning('There are NaNs in the estimations for those states that were not used')
end
for k = 1:K
    sp_fit_group.state(k).psd = zeros(options.Ncomp,ndim,ndim);
    sp_fit_group.state(k).coh = ones(options.Ncomp,ndim,ndim);
    ind = (1:ndim) + (k-1)*ndim;
    for i = 1:options.Ncomp
        sp_fit_group.state(k).psd(i,:,:) = diag(psd(ind,i));
    end
    ind = (1:ndim2) + (k-1)*ndim2;
    for i = 1:options.Ncomp
        graphmat = zeros(ndim);
        graphmat(ind_offdiag) = coh(ind,i);
        graphmat=(graphmat+graphmat') + eye(ndim);
        sp_fit_group.state(k).coh(i,:,:) = graphmat;
    end
end

% Subject level
if N > 1 && nargout == 3
    for n = 1:N
        sp_fit{n} = struct();
        sp_fit{n}.state = struct();
        % prepare matrix
        Xpsd = zeros(Nf,ndim*K);
        keep_psd = true(1,ndim*K);
        for k = 1:K
            ind = (1:ndim) + (k-1)*ndim;
            Xpsd(:,ind)= squeeze(abs(psd_comps(n,k,:,:)));
            if any(isnan(var(Xpsd(:,ind)))) || any(isinf(var(Xpsd(:,ind))))
                keep_psd(ind) = false;
                warning(['Session ' num2str(n) ' did not use state ' num2str(k) '; PSD set to NaN'])
            end
        end
        Xcoh = zeros(Nf,K*ndim2);
        keep_coh = true(1,K*ndim2);
        for k = 1:K
            ind = (1:ndim2) + (k-1)*ndim2;
            ck = squeeze(abs(coh_comps(n,k,:,:,:)));
            Xcoh(:,ind) = ck(:,ind_offdiag);
            if any(isnan(var(Xcoh(:,ind)))) || any(isinf(var(Xcoh(:,ind))))
                keep_coh(ind) = false;
                warning(['Session ' num2str(n) ' did not use state ' num2str(k) '; Coh set to NaN'])
            end
        end
        % NNMF / PCA
        psd = zeros(ndim*K,options.Ncomp);
        coh = zeros(ndim2*K,options.Ncomp);
        if strcmpi(options.Method,'NNMF')
            opt = statset('maxiter',1);
            [~,b] = nnmf(Xpsd(:,keep_psd),options.Ncomp,'algorithm','als',...
                'w0',sp_profiles,'Options',opt);
            psd(keep_psd,:) = b'; % regions by components
            [~,b] = nnmf(Xcoh(:,keep_coh),options.Ncomp,'algorithm','als',...
                'w0',sp_profiles,'Options',opt);
            coh(keep_coh,:) = b';
        else
            Xpsd(:,keep_psd) = Xpsd(:,keep_psd) - repmat(mean(Xpsd(:,keep_psd)),Nf,1);
            Xcoh(:,keep_coh) = Xcoh(:,keep_coh) - repmat(mean(Xcoh(:,keep_coh)),Nf,1);
            psd(keep_psd,:) = (Xpsd(:,keep_psd)' * sp_profiles);
            coh(keep_coh,:) = (Xcoh(:,keep_coh)' * sp_profiles);
        end
        % Reshape stuff
        for k = 1:K
            sp_fit{n}.state(k).psd = zeros(options.Ncomp,ndim,ndim);
            sp_fit{n}.state(k).coh = ones(options.Ncomp,ndim,ndim);
            ind = (1:ndim) + (k-1)*ndim;
            for i = 1:options.Ncomp
                sp_fit{n}.state(k).psd(i,:,:) = diag(psd(ind,i));
            end
            ind = (1:ndim2) + (k-1)*ndim2;
            for i = 1:options.Ncomp
                graphmat = zeros(ndim);
                graphmat(ind_offdiag) = coh(ind,i);
                graphmat=(graphmat+graphmat') + eye(ndim);
                sp_fit{n}.state(k).coh(i,:,:) = graphmat;
            end
        end
    end
else
    sp_fit = sp_fit_group;
end

end


function [centers, labels, info] = slkmeansex(X, n, estfunctor, clsfunctor, varargin)
%SLKMEANSEX Performs Generalized K-means
%
% $ Syntax $
%   - [centers, labels] = slkmeansex(X, n, estfunctor, clsfunctor, ...)
%   - [centers, labels, info] = slkmeansex(X, n, estfunctor, clsfunctor, ...)
%
% $ Arguments $
%   - X:            the samples to be clustered
%   - n:            the number of samples
%   - estfunctor:   the functor to estimate means(centers), as follows:
%                   centers = estfunc(centers, X, K, weights, labels, ...)
%                   when input centers is empty, it performs initial
%                   estimation, otherwise, it performs updating.
%                   In addition, it should ignore the samples with
%                   labels being zeros or negative numbers.
%   - clsfunctor:   the functor to classify samples
%                   labels = clsfunc(centers, X, n, ...)
%                   it should produce 1 x n row vector.
%   - centers:      the clustered centers
%   - labels:       the labels indicating which sample belong to which center
%                   a 1 x n row vector.
%   - info:         the information on iteration process
%
% $ Description $
%   - [centers, labels] = slkmeansex(X, n, estfunctor, clsfunctor, ...)
%     is a generalized version of K-means. It actually implements an
%     iterative process to estimate centers from clustered samples and
%     re-clustered the samples according to centers.
%     You can specify the following properties:
%       - 'K':              the number of initial number of clusters
%                           (default = 3)
%       - 'init_centers':   the initial centers.
%       - 'maxiter':        the maximum number of iterations
%                           (default = 100);
%       - 'annthres':       the threshold of annealing
%                           when the sum of sample weights for a center
%                           is below annthres * the total weight, the
%                           center will be discarded. (default = 0)
%       - 'annfunc':        the function to discard a set of centers
%                           centers = annfunc(centers, inds_discard);
%       - 'weights':        the weights of the samples (default = [])
%       - 'verbose':        whether to show progress information
%                           (default = true)
%
% $ Remarks $
%   - The X and centers can be in any form that conform to the specified
%     functors.
%
%   - If init_centers is specified, K should be exactly the number of
%     initial centers.
%
%   - If annthres is 0, then no centers will be discarded even some centers
%     have no support samples in the process. The estfunctor should keep
%     those centers unchanged.
%
% $ History $
%   - Created by Dahua Lin, on Aug 28, 2006
%   - Modified by Dahua Lin, on Aug 30, 2006
%       - utilize slevalfunctor and slsharedisp
%   - Modified by Dahua Lin, on Aug 31, 2006
%       - based on slreevallearn
%

%% parse and verify input arguments

if nargin < 4
    raise_lackinput('slkmeansex', 4);
end

opts.K = 3;
opts.init_centers = [];
opts.maxiter = 100;
opts.annthres = 0;
opts.annfunc = [];
opts.weights = [];
opts.verbose = true;
opts = slparseprops(opts, varargin{:});

if opts.K > n
    error('sltoolbox:rterror', ...
        'The initial K is larger than the number of samples');
end

if opts.annthres > 0
    if isempty(opts.annfunc)
        error('sltoolbox:invalidarg', ...
            'You should specify annfunc when annthres > 0');
    end
end

w = opts.weights;
if ~isempty(w)
    if ~isequal(w, [1 n])
        error('sltoolbox:sizmismatch', ...
            'The weights should be a 1 x n row vector');
    end
end

%% Initialization

slsharedisp_attach('slkmeansex', 'show', opts.verbose);

slsharedisp('Intialize K-Means');

if isempty(opts.init_centers)
    initcinds = randsample(n, opts.K);
    labels = zeros(1, n);
    labels(initcinds) = 1:opts.K;

    K = opts.K;
    centers = slevalfunctor(estfunctor, [], X, K, w, labels);
else
    K = opts.K;
    centers = opts.init_centers;
end

slsharedisp_incindent;
slsharedisp('initial K = %d', K);
slsharedisp_decindent;

labels = slevalfunctor(clsfunctor, centers, X, n);

%% Updating

slsharedisp('Update K-Means');
slsharedisp_incindent;

km_estfunctor = {@kmeansex_est, estfunctor, opts};
km_evalfunctor = {@kmeansex_eval, clsfunctor};
km_cmpfunctor = {@kmeansex_cmp};

models = {centers, K};
data = {X, n, w};
[models, labels, info] = slreevallearn(models, labels, data, ...
    km_estfunctor, km_evalfunctor, km_cmpfunctor, ...
    'iter', {'maxiter', opts.maxiter, 'titlebreak', false}, 'isrecorded', false);

centers = models{1};

slsharedisp_decindent;
slsharedisp_detach;

%% Core functions

% models = {centers, K}
% data = {X, n, w}

function models = kmeansex_est(models, data, labels, estfunctor, opts)

X = data{1};
w = data{3};
centers = models{1};
K = models{2};

if ~isempty(centers) && opts.annthres > 0
    if isempty(w)
        w = ones(1, length(labels));
    end
    cw = sllabeledsum(w, labels, 1:K);
    wthres = opts.annthres * sum(cw) / K;
    if any(cw < wthres)
        inds_ann = find(cw < wthres);
        centers = feval(opts.annfunc, centers, inds_ann);
        K = K - length(inds_ann);

        models = {centers, K};
        return;
    end
end

centers = slevalfunctor(estfunctor, centers, X, K, w, labels);
models = {centers, K};

function labels = kmeansex_eval(models, data, labels, clsfunctor)

X = data{1};
n = data{2};
centers = models{1};

slignorevars(labels);

labels = slevalfunctor(clsfunctor, centers, X, n);

function isconverged = kmeansex_cmp(models_prev, models, labels_prev, labels)

K_prev = models_prev{2};
K = models{2};
n = length(labels);

slsharedisp_attach('kmeansex_cmp');

isconverged = false;
if K == K_prev
    nchanged = sum(labels ~= labels_prev);
    slsharedisp('K = %d: %d / %d changed', K, nchanged, n);

    if nchanged == 0
        isconverged = true;
    end
else
    slsharedisp('K = %d ==> %d', K_prev, K);
end

slsharedisp_detach();


function F = retrieveR(level, o, H, L)
%------------------------------------------------------------------------------
%
% This function extracts a two-dimensional gridfunction F from H.
% F is supposed to be uniquely determined by the integer level and
% character o describing its type. F is defined on a rectangular
% domain.
% This function is a two-dimensional lifting scheme utility.
%
% F = 2D gridfunction of coefficients extracted from H.
%
% level = integer designated as the level of F.
%
% o = character, should be either 'a' or 'd',
%     describing the type of F:
%     'a' relates to approximation (coefficients) and
%     'd' relates to detail (coefficients)
%
% L = 2D integer array of bookkeeping, see function storeR.
%
% H = 1D array that functions as storage (heap). The coefficients of F
%     are extracted from H as a result of calling retrieveR.
%
% See also: storeR, retrieveQ
%
% Design and implementation by:
% Dr. Paul M. de Zeeuw <Paul.de.Zeeuw@cwi.nl>  http://homepages.cwi.nl/~pauldz/
% Last Revision: May 5, 2002.
% (c) 1999-2002 Stichting CWI, Amsterdam.
%------------------------------------------------------------------------------
if isempty(L)
  if ~isempty(H)
    disp([' retrieveR - ERROR at type ' o ' with level ' num2str(level)]);
    error(' retrieveR - books empty but heap is not ')
  else
    F = [];
  end
else
  if isempty(H)
    disp([' retrieveR - ERROR at type ' o ' with level ' num2str(level)]);
    error(' retrieveR - books not empty but heap is ')
  else
    [nL, mL] = size(L);
    if mL ~= 6
      disp([' retrieveR - ERROR at type ' o ' level ' num2str(level)]);
      error(' retrieveR - books do not fit ')
    else
      jL = -1;
      j = 1;
      foundit = 0;
      while j <= nL && ~foundit
         if L(j, 1) == level
           switch o
               case 'a' , if L(j, 3) == 0 && L(j, 2) == 0
                            jL = j;
                            foundit = 1;
                          end
               case 'd' , if L(j, 3) == 1 && L(j, 2) == 0
                            jL = j;
                            foundit = 1;
                          end
               otherwise
               disp([' retrieveR - ERROR at type ' o ' level ' num2str(level)]);
               error(' retrieveR - unknown type of coefficients ')
           end
         end
         j = j + 1;
      end
      if jL == -1
        disp([' retrieveR - ERROR at type ' o ' level ' num2str(level)]);
        error(' retrieveR - no such coefficients in heap')
      else
        nF = L(jL, 4);
        if nF < 1
          disp([' retrieveR - ERROR at type ' o ' level ' num2str(level)]);
          error(' retrieveR - unvalid 1st dimension of target')
        end
        mF = L(jL, 5);
        if mF < 1
          disp([' retrieveR - ERROR at type ' o ' level ' num2str(level)]);
          error(' retrieveR - unvalid 2nd dimension of target')
        end
        heaptr = L(jL, 6);
        if heaptr < 2
          disp([' retrieveR - ERROR at type ' o ' level ' num2str(level)]);
          error(' retrieveR - bookkeeping error ')
        else
          [nH, mH] = size(H);
          if mH ~=1
            disp([' retrieveR - ERROR at type ' o ' level ' num2str(level)]);
            error(' retrieveR - heap should be column vector')
          else
            beginptr = heaptr-nF*mF;
            if heaptr-1 > nH
              disp([' retrieveR - ERROR at type ' o ' level ' num2str(level)]);
              error(' retrieveR - heap not that large')
            elseif beginptr < 1
              disp([' retrieveR - ERROR at type ' o ' level ' num2str(level)]);
              error(' retrieveR - heap not that large, dimensions?')
            else
              F = reshape(H(beginptr:(heaptr-1)), nF, mF);
            end
          end
        end
      end
    end
  end
end
%------------------------------------------------------------------------------