function [I J K]=sphere_index(r,Ic,Jc,Kc)

% function [I J K]=sphere_index(r)
% ------------------------------------------------------------------------
% This function generates the indices 'I',  'J' and 'K' of voxel centers
% found within a sphere of radius 'r' (in voxels). The indices are not
% 'real' indices but are 'centered around zero'. They can be used to
% generate the indices of voxels found inside a sphere around point 'n' by
% adding In,Jn,Kn to I,J and K.
%
%
% Kevin Mattheus Moerman
% kevinmoerman@hotmail.com
% 07/08/2008
% ------------------------------------------------------------------------

if nargin == 1
    Ic=0; Jc=0; Kc=0;
end

%Set-up mesh calculate radius
[X,Y,Z] = meshgrid((-round(r+1)):1:(round(r+1)));
X=X+Jc; Y=Y+Ic; Z=Z+Kc;
radius = hypot(hypot(X,Y),Z);
[I,J,K]=ind2sub(size(X),find(radius<=r));
IJK_middle=round(size(X)/2);
I=I-IJK_middle(1);
J=J-IJK_middle(2);
K=K-IJK_middle(3);

%%
% _*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 r=roteu2ro(m,t)
%ROTEU2QR converts a sequence of Euler angles to a real unit quaternion
% Inputs:
%
%     M(1,n)   a string of n characters from the set {'x','y','z'}
%              or, equivalently, a vector whose elements are 1, 2, or 3
%     T(n,1)   n rotation angles. A positive rotation is clockwise if
%              looking along the axis away from the origin.
%
% Outputs:
%
%     R(3,3)   Input rotation matrix
%              Plots a diagram if no output specified
%
% The string M specifies the axes about which the rotations are performed.
% You cannot have the same axis in adjacent positions and so there are 12
% possibilities. Common ones are "ZXZ" and "ZYX". A positive rotation is clockwise
% if looking along the axis away from the origin; thus a rotation of +pi/2
% around Z rotates [1 0 0]' to [0 1 0]'.
%
% Inverse conversion: If m has length 3 with adjacent characters distinct,
%                     then rotro2eu(m,roteu2ro(m,t))=t.
%
% Inverse rotation:   roteu2ro(m,t)*roteu2ro(fliplr(m),-fliplr(t))=eye(3)

%
%      Copyright (C) Mike Brookes 2007-2012
%      Version: $Id: roteu2ro.m 2171 2012-07-12 07:33:03Z dmb $
%
%   VOICEBOX is a MATLAB toolbox for speech processing.
%   Home page: http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   This program is free software; you can redistribute it and/or modify
%   it under the terms of the GNU General Public License as published by
%   the Free Software Foundation; either version 2 of the License, or
%   (at your option) any later version.
%
%   This program is distributed in the hope that it will be useful,
%   but WITHOUT ANY WARRANTY; without even the implied warranty of
%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%   GNU General Public License for more details.
%
%   You can obtain a copy of the GNU General Public License from
%   http://www.gnu.org/copyleft/gpl.html or by writing to
%   Free Software Foundation, Inc.,675 Mass Ave, Cambridge, MA 02139, USA.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
r=rotqr2ro(roteu2qr(m,t));


function value = p16_f ( dim_num, point_num, x )

%*****************************************************************************80
%
%% P16_F evaluates the integrand for problem 16.
%
%  Discussion:
%
%    The integrand can be regarded as the L1 norm of X - Z.
%
%    It would be nice to allow the use to specify several
%    base points Z, to make the function more jagged more places%
%
%  Dimension:
%
%    DIM_NUM arbitrary.
%
%  Region:
%
%    0 <= X(1:DIM_NUM) <= 1
%
%  Integral Parameters:
%
%    The integrand can be regarded as the L1 norm of X - Z.
%
%    There is a basis point Z associated with the integrand.
%    Z(1:DIM_NUM) defaults to ( 0.5, 0.5, ..., 0.5 ).
%    The user can set, get, or randomize this value by calling
%    P16_R8VEC.
%
%  Integrand:
%
%    sum ( abs ( x(1:dim_num) - z(1:dim_num) ) )
%
%  Exact Integral:
%
%    The integral is separable into
%
%       Int ( A(1) <= X(1) <= B(1) ) abs ( X(1) - Z(1) )
%     * Product ( B(1:N)-A(1:N), skip index 1 )
%     + Int ( A(2) <= X(2) <= B(2) ) abs ( X(2) - Z(2) )
%     * Product ( B(1:N)-A(1:N), skip index 2 )
%     ...
%     + Int ( A(N) <= X(N) <= B(N) ) abs ( X(N) - Z(N) )
%     * Product ( B(1:N)-A(1:N), skip index N )
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 June 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer DIM_NUM, the dimension of the argument.
%
%    Input, integer POINT_NUM, the number of points.
%
%    Input, real X(DIM_NUM,POINT_NUM), the evaluation points.
%
%    Output, real VALUE(POINT_NUM), the integrand values.
%
  z = [];
  z = p16_r8vec ( 'G', 'Z', dim_num, z );

  value(1:point_num) = 0.0;

  for point = 1 : point_num

    value(point) = sum ( abs ( x(1:dim_num,point) - z(1:dim_num)' ) );

  end

  p16_i4 ( 'I', '#', point_num );

  return
end


clc;
clear;
close all;

T0 = 500 ; % initial temperature
r = 0.997 ; % temperature damping rate
Ts = 1 ; % stop temperature
iter = 300;

model = initModel();
set(gcf,'unit','normalized','position',[0,0.35,1,0.7]);

flag = 0;

% initialization
while(1)
route = randomSol(model);
if(isFeasible(route,model))
    break;
end
end

cost = calculateCost(route,model);
T = T0;

cnt = 1;
minCost = cost;
minRoute = route;

maxIterate = 2100;
costArray = zeros(maxIterate,1);

% SA
while(T > Ts)
    for k = 1:iter
    mode = randi([1 3]);
    newRoute = createNeibor(route,model,mode);
    newCost = calculateCost(newRoute,model);
    delta = newCost - cost;

    if(delta < 0)
        cost = newCost;
        route = newRoute;
    else
        p=exp(-delta/T);
        if rand() <= p
             cost = newCost;
             route = newRoute;

        end
    end
    end

    costArray(cnt) = cost;
    if cost<minCost
        minCost = cost;
        minRoute = route;
        flag = 1;
    end

    T = T*r; %  annealing
    disp(['Iteration ' num2str(cnt) ': BestCost = ' num2str(minCost) ': CurrentCost = ' num2str(cost) ' T = ' num2str(T)]);
    cnt = cnt+1;

   figure(1);
   if(flag == 1)
   plotSolution(minRoute,model);
    flag = 0;
   end
%    figure(2);
   subplot(1,2,2)
   plot(costArray);

   pause(0.0001);
end


function [L,E] = facet_laplacian(V,F)
  % FACET_LAPLACIAN Builds an "edge-based" Laplacian L, which is an #E by #V
  % rectangular matrix which maps scalar functions living at vertices to
  % Laplacian values living at edges. For tets, edges are now facets.
  %
  % [L,E] = facet_laplacian(V,F)
  %
  % Inputs:
  %   V  #V by dim list of vertex positions
  %   F  #F by element-size list of triangle indices
  % Outputs:
  %   L  #E by #V edge-based Laplacian
  %   E  #E by 2 list of edges
  %
  % Examples:
  %   % load some non-convex shape (V,F)
  %   [L,E] = facet_laplacian(V,F);
  %   % find boundary edges
  %   B = is_boundary_edge(E,F);
  %   % Construct mass matrix
  %   [M,mE] = crouzeix_raviart_massmatrix(V,F);
  %   % Be sure same edges are being used.
  %   assert(all(E(:)==mE(:)));
  %   % "Kill" boundary edges
  %   L(B,:) = 0;
  %   % Linear functions are now in the spectrum
  %   [~,~,U] = svd(full(L));
  %   tsurf(F,[V(:,1:2) U(:,end-1)])
  %
  %   % mesh in (V,F)
  %   [Le] = facet_laplacian(V,F);
  %   [Lcr,E,EMAP] = crouzeix_raviart_cotmatrix(V,F);
  %   V2E = sparse(E(:),repmat(1:size(E,1),1,size(E,2))',1,size(V,1),size(E,1))';
  %   V2E = bsxfun(@rdivide,V2E,sum(V2E,2));
  %   LcrV2E = Lcr*V2E;
  %   max(max(abs(LcrV2E--2*Le)))
  %
  %
  % See also: crouzeix_raviart_massmatrix, is_boundary_edge
  %

  %% check for non-manifold edges
  %S = statistics(V,F,'Fast',true);
  %if S.num_nonmanifold_edges > 0
  %  error(sprintf('There are %d non-manifold edges',S.num_nonmanifold_edges));
  %end

  switch size(F,2)
  case 3
    % number of vertices
    n = size(V,1);
    % number of faces
    m = size(F,1);
    % Compute cotangents
    C = cotangent(V,F);
    % Map each face-edge to a unique edge
    F2E = reshape(1:3*m,m,3);
    % Assemble entries
    %             R S S R S S R S S
    LI = [ F2E(:,[1 1 1 2 2 2 3 3 3]) ];
    LJ = [   F(:,[1 2 3 2 3 1 3 1 2]) ];
    LV = [ ...
      C(:,2)+C(:,3), -C(:,3), -C(:,2) ...
      C(:,3)+C(:,1), -C(:,1), -C(:,3) ...
      C(:,1)+C(:,2), -C(:,2), -C(:,1)];

    %warning('only spokes');
    %LI = LI(:,[2 3 5 6 8 9]);
    %LJ = LJ(:,[2 3 5 6 8 9]);
    %LV = LV(:,[2 3 5 6 8 9]);
    %warning('only rims');
    %LI = LI(:,[1 4 7]);
    %LJ = LJ(:,[1 4 7]);
    %LV = LV(:,[1 4 7]);

    assert(all(size(LI)==size(LJ)));
    assert(all(size(LI)==size(LV)));
    % Throw contribution at each edge
    L = sparse(LI,LJ,LV,3*m,n);

    allE = [F(:,[2 3]);F(:,[3 1]);F(:,[1 2])];
    % Map duplicate edges to first instance
    [E,~,EMAP] = unique(sort(allE,2),'rows');

    L = sparse(EMAP,F2E(:),1,size(E,1),3*m) * L;

    % Q: What's going on for boundary edges?
    % A: Interior edges are integrating around butterly. Boundary edges are only
    % integrating around half what would be their butterfly. They "should" also
    % integrate along themselves to enclose an area. Since they don't they
    % amount to computing minus the normal derivative.
  case 4
    [Lcr,E] = crouzeix_raviart_cotmatrix(V,F);
    A = sparse(E(:),repmat(1:size(E,1),1,3)',1,size(V,1),size(E,1))';
    Df = diag(sparse(sum(A,2)));
    % Legacy factor of 2 to match triangle version
    L = 0.5*3*Lcr*(Df\A);
    % Lv == 0.5*A'*Lf;
  end

end


function[]=makefigs_morsebox
%MAKEFIGS_MORSEBOX  Makes a sample figure for MORSEBOX.

ga1=(1/3:.1:11);
be1=(1/3:.1:10);

[ga,be]=meshgrid(ga1,be1);
[fm,fe,fi,cf] = morsefreq(ga,be);
a=morsebox(ga,be);

figure
contourf(ga1,be1,a,(.5:.01:.6))
hold on, contour(ga1,be1,a,(.500:.002:.51),'k:')
colormap gray,flipmap,
axis([1 10 1 10])
xtick(1:10),ytick(1:10)
ax=gca;
hc=colorbar;

contour(ga1,be1,(fm-fe)./(2*pi),[ 0 0],'k','linewidth',2)
contour(ga1,be1,(fm-fi)./(2*pi),[ 0 0],'k','linewidth',2)
contour(ga1,be1,cf./(2*pi),[ 0 0],'k','linewidth',2)
caxis([.5 .6])
vlines(3,'k--')
plot(ga1,12./ga1,'k')

title('Morse Wavelet Area and Transitions')
xlabel('Gamma Parameter')
ylabel('Beta Parameter')
plot([1+sqrt(-1)*0 10+sqrt(-1)*9/2],'k','linewidth',3)
plot([1+sqrt(-1)*0 10+sqrt(-1)*9/2],'w--','linewidth',2)


function Problem2_26
%Problem 2.26 Ternary condensation inside a vertical tube.
% Uses the function BVP4C to numerically solve the boundary-value problem.
% BVPINIT is used to form an initial guess for the solution on
% a mesh of ten equally spaced points. A guess for unknown parameters
% (the two fluxes) is the last argument of BVPINIT.
% BVP4C returns the solution as the structure 'sol'. The computed fluxes are
% returned in the field sol.parameters.
% The calculated concentration profiles are plotted.

% Calculate the mass-transfer coefficients
Re = 9574;
density = 0.882;
viscosity = 0.00001602;
diameter = 0.0254;
% MS diffusion coefficients
D = [1.6*10^-5 1.444*10^-5 3.873*10^-5];
% Calculate Schmidt numbers
Sc(1) = viscosity/(density*D(1));
Sc(2) = viscosity/(density*D(2));
Sc(3) = viscosity/(density*D(3));
% Calculate Sherwood numbers
Sh(1) = 0.023*Re^0.83*Sc(1)^0.44;
Sh(2) = 0.023*Re^0.83*Sc(2)^0.44;
Sh(3) = 0.023*Re^0.83*Sc(3)^0.44;
% Molecular weight of pure components
M = [60.1 18 28];
y1 = [0.1123
      0.4246
      0.4631];
Mav1 = M*y1;
y2 = [0.1457
      0.1640
      0.6903];
Mav2 = M*y2;
Mav = (Mav1+Mav2)/2;
% Calculate total molar density
c = density/Mav;
F12 = Sh(1)*c*D(1)*1000/diameter;
F13 = Sh(2)*c*D(2)*1000/diameter;
F23 = Sh(3)*c*D(3)*1000/diameter;
solinit = bvpinit(linspace(0,1,10),[1, 1], [1, 1]);
options = bvpset('stats','on');
sol = bvp4c(@prob226ode,@prob226bc,solinit,options,F12,F13,F23);
x = sol.x;
y = sol.y;
y(3,:) = 1-y(1,:) -y(2,:);
fprintf('\n');
fprintf('Computed Mass-Transfer Coefficients:');
fprintf('\n');
fprintf('F12, mole/m2-s = %7.4f.\n',F12);
fprintf('\n');
fprintf('F13, mole/m2-s = %7.4f.\n',F13);
fprintf('\n');
fprintf('F23, mole/m2-s = %7.4f.\n',F23);
fprintf('\n');
fprintf(' Computed N1 in mole/m2-s =%7.4f.\n',sol.parameters(1))
fprintf('\n')
fprintf(' Computed N2 in mole/m2-s=%7.4f.\n',sol.parameters(2))
fprintf('\n')
clf reset
plot(x,y(1,:),'k-*',x,y(2,:),'k:+',x,y(3,:),'k-.o')
axis([0 1 0 0.7])
title('Concentration profiles in Problem 2.26')
xlabel('Distance along the diffusion path, cm.')
ylabel('Mole fraction')
legend('Isopropanol', 'Water', 'Nitrogen')
shg

% --------------------------------------------------------------------------

function dydx = prob226ode(x,y,N,F12,F13,F23)
N3 = 0;

%F12 = 0.933;
%F13 = 0.880;
%F23 = 1.530;
dydx = [ (y(1)*N(2)-y(2)*N(1))/F12+(y(1)*N3-(1-y(1)-y(2))*N(1))/F13
         (y(2)*N(1)-y(1)*N(2))/F12+(y(2)*N3-(1-y(1)-y(2))*N(2))/F23 ];

% --------------------------------------------------------------------------

function res = prob226bc(ya,yb,N,F12,F13,F23)
res = [ya(2)-0.4246
       yb(2) - 0.1640
       ya(1) - 0.1123
       yb(1) - 0.1457 ];

% --------------------------------------------------------------------------


function psnr= PSNR(X,Y)
%Calculates the Peak-to-peak Signal to Noise Ratio of two images X and Y
[M,N]=size(X);
m=double(0);
X=cast(X,'double');
Y=cast(Y,'double');
for i=1:M
    for j=1:N
        m=m+((X(i,j)-Y(i,j))^2);
    end
end
m=m/(M*N);
psnr=10*log10(255*255/m);


function out = DN_Spread(y,spreadMeasure)
% DN_Spread     Measure of spread of the input time series.
%
% Returns the spread of the raw data vector, as the standard deviation,
% inter-quartile range, mean absolute deviation, or median absolute deviation.
%
%---INPUTS:
% y, the input data vector
%
% spreadMeasure, the spead measure:
%               (i) 'std': standard deviation
%               (ii) 'iqr': interquartile range
%               (iii) 'mad': mean absolute deviation
%               (iv) 'mead': median absolute deviation

% ------------------------------------------------------------------------------
% Copyright (C) 2020, Ben D. Fulcher <ben.d.fulcher@gmail.com>,
% <http://www.benfulcher.com>
%
% If you use this code for your research, please cite the following two papers:
%
% (1) B.D. Fulcher and N.S. Jones, "hctsa: A Computational Framework for Automated
% Time-Series Phenotyping Using Massive Feature Extraction, Cell Systems 5: 527 (2017).
% DOI: 10.1016/j.cels.2017.10.001
%
% (2) B.D. Fulcher, M.A. Little, N.S. Jones, "Highly comparative time-series
% analysis: the empirical structure of time series and their methods",
% J. Roy. Soc. Interface 10(83) 20130048 (2013).
% DOI: 10.1098/rsif.2013.0048
%
% This function 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/>.
% ------------------------------------------------------------------------------

% ------------------------------------------------------------------------------
% Check Inputs
% ------------------------------------------------------------------------------
if nargin < 2 || isempty(spreadMeasure)
    spreadMeasure = 'std'; % return std by default
end

% ------------------------------------------------------------------------------
% Evaluate the spread measure
% ------------------------------------------------------------------------------
switch spreadMeasure
	case 'std'
        % Standard deviation
		out = std(y);

	case 'iqr'
        % Interquartile range
		out = iqr(y);

	case 'mad'
        % Mean absolute deviation
		out = mad(y,0);

    case 'mead'
        % Median absolute deviation
        out = mad(y,1);

    otherwise
        error('Unknown spread measure ''%s''',spreadMeasure)
end

end


function [x, L]= time_step_RBF_new(W,x,lambda,timestep,time_step_value)

% build the degree function ( d_i = sum_j w_ij)
W=sparse(W);
D=sum(W,2);
laplacian = 1;
[dim num] = size(x);
if nargin<5

            time_step_value=0.25;
            time_step_value=0.1;
            time_step_value=0.25;
             time_step_value=0.1;
              time_step_value=0.2;%% for depth
               time_step_value=0.1;
end

% checks if elements of the degree function are zero and correct this
if(sum(D==0)>0)
    disp('Warning, Elements of d are zero');
    for i=1:num
        if(D(i)==0), D(i)=1; end
    end
end
% type of Laplacian (normalized, unnormalized)

% build the final weight matrix - reweighted by some power of the degree
% function \tilde{k}_ij = k_ij / pow(d_i d_j, lambda)
if(lambda~=0)
    f=spdiags(1./(D.^lambda), 0, num, num);
    W=1/(num)*f*W*f;
    clear f;
end
clear d

% final degree function of weights \tilde{k}
e=sum(W,2);
if(sum(e==0)>0)
    disp('Warning, Elements of e are zero');
    for i=1:num
        if(e(i)==0), e(i)=1/(num); end
    end
end

% for the time step it is easier to have the transpose of x
x=x';

tic
if(timestep==0)
    % explicit timestep
    D=spdiags(e,0,num,num);
    L=D-W;
    step=-0.1*L*x;
    x = x + step;
else
    % implicit timestep
    D=spdiags(e,0,num,num);

    L=sparse(D-W);
    %L=sparse(L);
    switch laplacian
        case 0,
            %normalized, solve L*x_new =x_old, where L=Id - E^{-1}W

            z=(D+0.25*L)\(D*x);
            % z=(D+0.1*L)\(D*x);
            diff = z - x;
            for i=1:num
                x(i,:) = x(i,:) + diff(i,:);
            end
        case 1,
            %unnormalized
            % z=cholmod(speye(num) + 0.5*L,x);

            z = (speye(num) + time_step_value*L)\x;
            diff = z - x;

            parfor i=1:num
                x(i,:) = x(i,:) + diff(i,:);
            end

    end
end

x=x'; % transform the data back in column format (one data point=one column in x)
t=toc;
% disp(['Time for time step: ', num2str(t),' seconds']);
% time_step_value


function [fAlpha, fDmax] = calc_KStestGR(mCatalog, fBinning, fBValue, fMc)
% [mAlphaVal] = calc_KStestGR(mCatalog, fBinning, fBValue)
% ------------------------------------------------------------------------
% Calculate Koglomorov-Smirnov-test with constant b-value
% Reference for equations to calculate the statistics nD:
% Y.Y. Kagan, Accuracy of modern global earthquake catalogs, Physics of the Earth and Planetary Interiors
% 4179, 1-37, 2002
%
% Incoming variables:
% mCatalog : Earthquake catalog
% fBinning : Binning interval
% fBValue  : Fix b-value
%
% Outgoing variables:
% mAlphaVal(:,1) : Significance level Alpha according to ascending magnitudes
% mAlphaVal(:,2) : Ascending magnitudes
%
% Author: J. Woessner
% last update: 25.03.03

% Initialize
mAlphaVal = [];
vD = [];

% Select data above Mc
vSel = (mCatalog(:,6) >= fMc);
mCatalog = mCatalog(vSel,:);

% Set fix values
fMaxMag = ceil(10 * max(mCatalog(:,6))) / 10;
fMinMag = (round(min(mCatalog(:,6)*10)))/10;
vMag = fMinMag:0.1:fMaxMag;

% Using Bath's law : see Reference Console
% Beta-value
fBeta = log(10)*fBValue;

% Probability density function
% vPdf = fBeta*exp(-fBeta*(vMag-fMc))
%
% % Cumulative density function
% vCdf = cumsum(vPdf);
% %vCdf = vCdf/max(vCdf);
% vCdf = [vCdf; vMag];
% vCdf = vCdf';

% CDF theoretically
vCdf = (1-exp(-fBeta*(vMag-fMc)))./(1-exp(-fBeta*(fMaxMag-2-fMc)));
vCdf = [vCdf; vMag];
vCdf = vCdf';

% Use Kagan 2002 approach
% Sort catalog with ascending magnitude
[mCatSorted,vIndex] = sort(mCatalog(:,6));
mCat = mCatalog(vIndex(:,1),:);

% Calulate statistic fD = max_(1=<k=<N)((k/N-F(M_k)
nEvents = length(mCat(:,1));
vkEvent = 1:length(mCat(:,1));
vkEvent = vkEvent/nEvents;
vkEvent = vkEvent';
for nE = 1:nEvents
    % Find probability of theoretical distribution for event k with magnitude Mk
    try
        vSel = (vCdf(:,2) == (round(mCat(nE,6)*10))/10);
        fD = max(nE/nEvents-vCdf(vSel,1));
        vD = [vD; fD];
    catch
        fD = nan;
        vD = [vD; fD];
    end
end
fDmax = max(vD);
fAlpha = exp(-2*nEvents*(fDmax+1/(6*nEvents))^2);
% vAlpha = exp(-2*nEvents.*(vD+1/(6*nEvents)).^2)
% disp('v')


function pred = ml_predictgmm(trials, model)
% Prediction function for Gaussian Mixture Models.
% Prediction = ml_predictgmm(Trials, Model)
%
% In:
%   Trials  : the data a matrix, as in ml_predict
%
%   Model   : predictive model as produced by ml_trainlogreg
%
% Out:
%   Prediction  : discrete probability distribution, formatted as
%                 {'disc' [NxC] [Cx1]}, with element #2 being the per-class probability and
%                 element #3 the original target values per class
%                 thus, the expected target values are Prediction{2}*Prediction{3}
%
% Examples:
%   targets might look like this: [-1 -1 1 -1 1 -1 -1 1 -1 -1 1 -1 -1 1 ...]'
%
%   model = ml_traingmm(data,targets)
%   p = ml_predictgmm(data, model); expectation = p{2}*p{3};
%   now expectation might look like this: [-0.6 -0.9 +0.4 -0.7 +0.8 -0.1 +0.5 +1.0 -0.9 +1.0 -1.0 -1.0 +1.0 ...]'
%
% See also:
%   ml_traingmm
%
%                           Christian Kothe, Swartz Center for Computational Neuroscience, UCSD
%                           2010-04-05

% scale data
trials = hlp_applyscaling(trials,model.sc_info);

% predict probabilities
switch model.variant
    case {'avdp','vdp','bj','bjrnd','cdp','csb','vb'}
        for c=1:length(model.classes)
            model.class{c}.test_data = trials';
            % obtain log probabilities under each component
            tmp = vdpgm(model.data{c}',model.class{c});
            pdfmat(:,c) = exp(tmp.predictive_posterior');
        end
        % normalize the log probabilities, incorporate the prior, and turn them into true conditional probabilities
        probs = gmmb_normalize(pdfmat);
    case {'em','fj','gem'}
        pdfmat = gmmb_pdf(trials, model.class);
        probs = gmmb_normalize(gmmb_weightprior(pdfmat, model.class));
end
pred = {'disc', probs, model.classes};


function Q = mg_ns_smooth(A,sweeps,smooth,stype)
%mg_ns_smooth   smoothers for GMG iteration (Navier-Stokes)
%   Q = mg_ns_smooth(A,sweeps,smooth,stype)
%   input
%          A         coefficient matrix
%          sweeps    number of directions for multidirectional Gauss-Seidel
%          smooth    smoother (1, Jacobi, 2, Gauss-Seidel, 3 ILU)
%          stype     type of smoother (1 point, 2 line)
%   output
%          Q         structure, smoothing operators in factored form
%
%   IFISS function: HCE; 18 March 2005.
% Copyright (c) 2005 D.J. Silvester, H.C. Elman, A. Ramage

N=size(A,1);
n = sqrt(size(A,1));
if stype==2
   % line Gauss-Seidel
   Q1 = tril(A,1);
   [L1,U1] = lu(Q1);
   if sweeps>=2
      Q2 = diag(diag(A,0)) + diag(diag(A,-n),-n) + diag(diag(A,n),n) ...
         + diag(diag(A,-n-1),-n-1) + diag( diag(A,-1),-1)        ...
         + diag(diag(A,n-1),n-1);
      [L2,U2] = lu(Q2);
      if sweeps>=3
         Q3 = triu(A,-1);
         [L3,U3] = lu(Q3);
      if sweeps==4
         Q4 = diag(diag(A,0)) + diag(diag(A,-n),-n) + diag(diag(A,n),n) ...
            + diag(diag(A,n+1),n+1) + diag( diag(A,1),1)            ...
            + diag(diag(A,-n+1),-n+1);
         [L4,U4] = lu(Q4);
         else
            L4=sparse(N,N); U4=L4;
         end
      else
         L3=sparse(N,N); U3=L3; L4=L3; U4=L3;
      end
   else
      L2=sparse(N,N); U2=L2; L3=L2; U3=L2; L4=L2; U4=L2;
   end
else
   % point smoothers
   if smooth==3,
      % ILU
      [L1,U1]=ilu0(A);
      L2=sparse(size(L1)); U2=L2; L3=L2; U3=L2; L4=L2; U4=L2;
   elseif smooth==2,
      % point Gauss-Seidel
      Q1 = tril(A,0); [L1,U1] = lu(Q1);
      L2=sparse(size(L1)); U2=L2; L3=L2; U3=L2; L4=L2; U4=L2;
   else
      % point damped Jacobi
      omega=8/9; % relaxation factor for damped Jacobi
      Q1 = (1/omega)*spdiags(diag(A),0,n*n,n*n);[L1,U1] = lu(Q1);
      L2=sparse(size(L1)); U2=L2; L3=L2; U3=L2; L4=L2; U4=L2;
   end
end
Q = struct('L1',L1,'L2',L2,'L3',L3,'L4',L4, ...
           'U1',U1,'U2',U2,'U3',U3,'U4',U4);


function Y = pdist(X,s,varargin)
%PDIST Pairwise distance between observations.
%   Y = PDIST(X) returns a vector Y containing the Euclidean distances
%   between each pair of observations in the M-by-N data matrix X.  Rows of
%   X correspond to observations, columns correspond to variables.  Y is an
%   (M*(M-1)/2)-by-1 vector, corresponding to the M*(M-1)/2 pairs of
%   observations in X.
%
%   Y = PDIST(X, DISTANCE) computes Y using DISTANCE.  Choices are:
%
%       'euclidean'   - Euclidean distance
%       'seuclidean'  - Standardized Euclidean distance, each coordinate
%                       in the sum of squares is inverse weighted by the
%                       sample variance of that coordinate
%       'cityblock'   - City Block distance
%       'mahalanobis' - Mahalanobis distance
%       'minkowski'   - Minkowski distance with exponent 2
%       'cosine'      - One minus the cosine of the included angle
%                       between observations (treated as vectors)
%       'correlation' - One minus the sample correlation between
%                       observatons (treated as sequences of values).
%       'hamming'     - Hamming distance, percentage of coordinates
%                       that differ
%       'jaccard'     - One minus the Jaccard coefficient, the
%                       percentage of nonzero coordinates that differ
%       function      - A distance function specified using @, for
%                       example @DISTFUN
%
%   A distance function must be of the form
%
%         function D = DISTFUN(XI, XJ, P1, P2, ...),
%
%   taking as arguments two L-by-N matrices XI and XJ each of which
%   contains rows of X, plus zero or more additional problem-dependent
%   arguments P1, P2, ..., and returning an L-by-1 vector of distances D,
%   whose Kth element is the distance between the observations XI(K,:)
%   and XJ(K,:).
%
%   Y = PDIST(X, DISTFUN, P1, P2, ...) passes the arguments P1, P2, ...
%   directly to the function DISTFUN.
%
%   Y = PDIST(X, 'minkowski', P) computes Minkowski distance using the
%   positive scalar exponent P.
%
%   The output Y is arranged in the order of ((1,2),(1,3),..., (1,M),
%   (2,3),...(2,M),.....(M-1,M)), i.e. the upper right triangle of the full
%   M-by-M distance matrix.  To get the distance between the Ith and Jth
%   observations (I < J), either use the formula Y((I-1)*(M-I/2)+J-I), or
%   use the helper function Z = SQUAREFORM(Y), which returns an M-by-M
%   square symmetric matrix, with the (I,J) entry equal to distance between
%   observation I and observation J.
%
%   Example:
%
%      X = randn(100, 5);                 % some random points
%      Y = pdist(X, 'euclidean');         % unweighted distance
%      Wgts = [.1 .3 .3 .2 .1];           % coordinate weights
%      Ywgt = pdist(X, @weucldist, Wgts); % weighted distance
%
%      function d = weucldist(XI, XJ, W) % weighted euclidean distance
%      d = sqrt((XI-XJ).^2 * W');
%
%   See also SQUAREFORM, LINKAGE, SILHOUETTE.

%   An example of distance for data with missing elements:
%
%      X = randn(100, 5);     % some random points
%      X(unidrnd(prod(size(X)),1,20)) = NaN; % scatter in some NaNs
%      D = pdist(X, @naneucdist);
%
%      function d = naneucdist(XI, XJ) % euclidean distance, ignoring NaNs
%      sqdx = (XI-XJ).^2;
%      nk = sum(~isnan(sqdx),2); nk(nk == 0) = NaN;
%      d = sqrt(nansum(sqdx')' .* size(XI,2) ./ nk); %correct for missing coords

%   Copyright 1993-2002 The MathWorks, Inc.
%   $Revision: 1.15 $

if nargin < 2
    s = 'euc';
    distfun = @distcalc;
    distargs = {s};
else
    if ischar(s)
        methods = strvcat('euclidean','seuclidean','cityblock','mahalanobis','minkowski','cosine','correlation','hamming','jaccard');
        i = strmatch(lower(s), methods);
        if length(i) > 1
            error(sprintf('Ambiguous ''DISTANCE'' argument:  %s.', s));
        elseif isempty(i)
            % error(sprintf('Unknown ''DISTANCE'' argument:  %s.', s));
            distfun = str2func(s);
            distargs = varargin;
            s = 'usr';
        else
            s = lower(methods(i,1:3));
            distfun = @distcalc;
            distargs = {s};
        end
    elseif isa(s, 'function_handle') |  isa(s, 'inline')
        distfun = s;
        distargs = varargin;
        s = 'usr';
    else
        error('The ''DISTANCE'' argument must be a string or a function.');
    end
end

[m, n] = size(X);
if any(imag(X(:))) & ~isequal(s,'usr')
   error('PDIST does not accept complex inputs.');
end

switch s
case 'seu' % Standardized Euclidean weights by coordinate variance
   distargs{end+1} = 1 ./ var(X)';
case 'mah' % Mahalanobis
   distargs{end+1} = inv(cov(X));
case 'min' % Minkowski distance needs a third argument
   if nargin < 3  % use default value for exponent
      distargs{end+1} = 2;
   elseif varargin{1} > 0
      distargs{end+1} = varargin{1}; % get exponent from input args
   else
      error('The exponent for the Minkowski metric must be positive.');
   end
case 'cos' % Cosine
   Xnorm = sqrt(sum(X.^2, 2));
   if min(Xnorm) <= eps * max(Xnorm)
       error(['Some points have small relative magnitudes, making them ', ...
              'effectively zero.\nEither remove those points, or choose a ', ...
              'distance other than cosine.'], []);
   end
   X = X ./ Xnorm(:,ones(1,n));
case 'cor' % Correlation
   X = X - repmat(mean(X,2),1,n);
   Xnorm = sqrt(sum(X.^2, 2));
   if min(Xnorm) <= eps * max(Xnorm)
       error(['Some points have small relative standard deviations, making ', ...
              'them effectively constant.\nEither remove those points, or ', ...
              'choose a distance other than correlation.'], []);
   end
   X = X ./ Xnorm(:,ones(1,n));
end

if m < 2
   % Degenerate case, just return an empty of the proper size.
   Y = zeros(1,0);
   return;
end

% Create (I,J) defining all pairs of points
p = (m-1):-1:2;
I = zeros(m*(m-1)/2,1);
I(cumsum([1 p])) = 1;
I = cumsum(I);
J = ones(m*(m-1)/2,1);
J(cumsum(p)+1) = 2-p;
J(1)=2;
J = cumsum(J);

% For large matrices, process blocks of rows as a group
n = length(I);
ncols = size(X,2);
blocksize = 1e4;                     % # of doubles to process as a group
M = max(1,ceil(blocksize/ncols));    % # of rows to process as a group
nrem = rem(n,M);
if nrem==0, nrem = min(M,n); end

Y = zeros(1,n);
ii = 1:nrem;
try
    Y(ii) = feval(distfun,X(I(ii),:),X(J(ii),:),distargs{:})';
catch
    if isa(distfun, 'inline')
        error(['The inline distance function generated the following ', ...
               'error:\n%s'], lasterr);
    elseif strfind(lasterr, ...
                   sprintf('Undefined function ''%s''', func2str(distfun)))
        error('The distance function ''%s'' was not found.', func2str(distfun));
    else
        error(['The distance function ''%s'' generated the following ', ...
               'error:\n%s'], func2str(distfun),lasterr);
    end
end;
for j=nrem+1:M:n
    ii = j:j+M-1;
    try
        Y(ii) = feval(distfun,X(I(ii),:),X(J(ii),:),distargs{:})';
    catch
        if isa(distfun, 'inline')
            error(['The inline distance function generated the following ', ...
                    'error:\n%s'], lasterr);
        else
            error(['The distance function ''%s'' generated the following', ...
                    'error:\n%s'], func2str(distfun),lasterr);
        end;
    end;
end

% ----------------------------------------------
function d = distcalc(XI,XJ,s,arg)
%DISTCALC Perform distance calculation for PDIST.
switch s
case 'euc',   d = sqrt(sum((XI-XJ).^2,2));            % Euclidean
case 'seu',   d = sqrt(((XI-XJ).^2) * arg);           % Standardized Euclidean
case 'cit',   d = sum(abs((XI-XJ)),2);                % City Block
case 'mah',   Y = XI - XJ;
              d = sqrt(sum((Y*arg).*Y,2));            % Mahalanobis
case 'min',   d = sum(abs((XI-XJ)).^arg,2).^(1/arg);  % Minkowski
case 'cos',   d = 1 - sum(XI.*XJ,2);                  % Cosine
case 'cor',   d = 1 - sum(XI.*XJ,2);                  % Correlation
case 'ham',   d = sum(XI ~= XJ,2) / size(XI,2);       % Hamming
case 'jac',   nz = XI ~= 0 | XJ ~= 0;
              ne = XI ~= XJ;
              d = sum(ne&nz,2) ./ sum(nz,2);          % Jaccard
end


function [ortirfmatrix]=irfsim_new(beta,D,n,m,p,k,horizon)

% [irfmatrix ortirfmatrix]=bear.irfsim(beta,D,n,m,p,k,horizon)
% computes IRF matrices and orthogonalised IRF matrices
% inputs:  - vector 'beta': vectorised form of VAR coefficients (defined in 1.1.12)
%          - matrix 'D': structural matrix for the OLS model (defined in 2.3.3)
%          - integer 'n': number of endogenous variables in the BVAR model (defined p 7 of technical guide)
%          - integer 'm': number of exogenous variables in the BVAR model (defined p 7 of technical guide)
%          - integer 'p': number of lags included in the model (defined p 7 of technical guide)
%          - integer 'k': number of coefficients to estimate for each equation in the BVAR model (defined p 7 of technical guide)
%          - integer 'horizon': number of IRF periods
% outputs: - matrix 'irfmatrix': record of the series of irf matrices
%          - matrix 'ortirfmatrix': record of the series of orthogonalised irf matrices

% first reshape beta to obtain B
B=reshape(beta,k,n);

% deal with shocks in turn
for ii=1:n

% create a matrix of zeros of dimension p*n
Y=zeros(p,n);
% set the value of the last row, column i, equal to 1
Y(p,ii)=1;

   % repeat the algorithm from period T+1 to period T+h
   for jj=1:horizon-1

   % step 1
   % use the function lagx to obtain the matrix temp, containing the endogenous regressors
   temp=bear.lagx(Y,p-1);

   % step 2
   % define the vector X
   X=[temp(end,:) zeros(1,m)];

   % step 3
   % obtain the predicted value for T+jj
   yp=X*B;

   % step 4
   % concatenate yp at the top of Y
   Y=[Y;yp];

   % repeat until values are obtained for T+h
   end

% consider 'Y' and trim the (p-1) initial periods: what remains is the series of IRFs for period T to period T+h-1
Y=Y(p:end,:);

% record the results in the matrix irfmatrix

   % loop over periods
   for jj=1:horizon

      % loop over variables
      for kk=1:n
      irfmatrix(kk,ii,jj)=Y(jj,kk);
      end

   end

% conduct the same process with shocks in other variables
end

% obtain now orthogonalised IRFs
% loop over periods
for ii=1:horizon
ortirfmatrix(:,:,ii)=irfmatrix(:,:,ii)*D;
end


function [ f ] = pendulumF( y )
%pendulumf Pendulum equations.

    g = 1;
    m = 1;
    l = 1;

    f(1,1) = y(3,:);
    f(2,1) = y(4,:);
    f(3,1) = -y(1,:).*y(5,:)/m;
    f(4,1) = (-y(2,:).*y(5,:)-g)/m;
    f(5,1) = y(1,:).*y(3,:) + y(2,:).*y(4,:);

end


function [w, g_sqr] = adagrad(w, g_sqr, grad, opts, lr)
%ADAGRAD
%   Example AdaGrad solver, for use with CNN_TRAIN and CNN_TRAIN_DAG.
%
%   Set the initial learning rate for AdaGrad in the options for
%   CNN_TRAIN and CNN_TRAIN_DAG. Note that a learning rate that works for
%   SGD may be inappropriate for AdaGrad; the default is 0.001.
%
%   If called without any input argument, returns the default options
%   structure.
%
%   Solver options: (opts.train.solverOpts)
%
%   `epsilon`:: 1e-10
%      Small additive constant to regularize variance estimate.
%
%   `rho`:: 1
%      Moving average window for variance update, between 0 and 1 (larger
%      values result in slower/more stable updating). This is similar to
%      RHO in AdaDelta and RMSProp. Standard AdaGrad is obtained with a RHO
%      value of 1 (use total average instead of a moving average).
%
%   A possibly undesirable effect of standard AdaGrad is that the update
%   will monotonically decrease to 0, until training eventually stops. This
%   is because the AdaGrad update is inversely proportional to the total
%   variance of the gradients seen so far.
%   With RHO smaller than 1, a moving average is used instead. This
%   prevents the final update from monotonically decreasing to 0.

% Copyright (C) 2016 Joao F. Henriques.
% All rights reserved.
%
% This file is part of the VLFeat library and is made available under
% the terms of the BSD license (see the COPYING file).

if nargin == 0  % Return the default solver options
  w = struct('epsilon', 1e-10, 'rho', 1) ;
  return ;
end

g_sqr = g_sqr * opts.rho + grad.^2 ;

w = w - lr * grad ./ (sqrt(g_sqr) + opts.epsilon) ;


function result = ball_f1_nd ( func, n, xc, r )

%*****************************************************************************80
%
%% BALL_F1_ND approximates an integral inside a ball in ND.
%
%  Integration region:
%
%    Points X(1:N) such that:
%
%      Sum ( X(1:N) - XC(1:N) )**2 <= R**2.
%
%  Discussion:
%
%    An (N+1)*2**N point 5-th degree formula is used, Stroud number SN:5-6.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 May 2004
%
%  Author:
%
%    MATLAB version by John Burkardt
%
%  Reference:
%
%    Arthur H Stroud,
%    Approximate Calculation of Multiple Integrals,
%    Prentice Hall, 1971.
%
%  Parameters:
%
%    Input, external FUNC, the name of the user supplied
%    function which evaluates F at the N-vector X, of the form
%      function value = func ( n, x )
%
%    Input, integer N, the dimension of the space.
%
%    Input, real XC(N), the center of the ball.
%
%    Input, real R, the radius of the ball.
%
%    Output, real RESULT, the approximate integral of the function.
%
  if ( r == 0.0E+00 )
    result = 0.0E+00;
    return
  end

  u2 = ( 1.0E+00 - 2.0E+00 * sqrt ( 1.0E+00 / ( n + 4 ) ) ) / ( n + 2 );
  u = sqrt ( u2 );
  x(1:n) = xc(1:n) - r * u;

  w = 1.0E+00 / ( ( n + 1 ) * 2^n );

  quad = 0.0E+00;
  ihi = 2^n;

  for i = 1 : ihi

    itemp = i - 1;

    for j = 1 : n

      u = ( xc(j) - x(j) ) / r;

      if ( mod ( itemp, 2 ) == 1 )
        x(j) = xc(j) - abs ( x(j) - xc(j) );
      else
        x(j) = xc(j) + abs ( x(j) - xc(j) );
      end

      itemp = floor ( itemp / 2 );

    end

    quad = quad + w * feval ( func, n, x );

  end

  temp = sqrt ( n + 4 );

  t = sqrt ( 2.0E+00 * ( n + 1 ) / ( n + 2 ) ) / ( n * temp );

  y = ( 1.0E+00 + 2.0E+00 / ( n * temp ) ) / ( n + 2 );
  v = sqrt ( y - t );
  u = sqrt ( y + ( n - 1 ) * t );

  khi = 2^n;

  for i = 1 : n

    x(1:n) = xc(1:n) - r * v;

    x(i) = xc(i) - r * u;

    for k = 1 : khi

      ktemp = k - 1;

      for j = 1 : n

        if ( mod ( ktemp, 2 ) == 1 )
          x(j) = xc(j) - abs ( x(j) - xc(j) );
        else
          x(j) = xc(j) + abs ( x(j) - xc(j) );
        end

        ktemp = floor ( ktemp / 2 );

      end

      quad = quad + w * feval ( func, n, x );

    end

    x(i) = xc(i) - r * v;

  end

  volume = ball_volume_nd ( n, r );
  result = quad * volume;

  return
end


function F = spm_Ncdf_jdw(x,u,v)
% Cumulative Distribution Function (CDF) for univariate Normal distributions: J.D.  Williams aproximation
% FORMAT F = spm_Ncdf_jdw(x,u,v)
%
% x - ordinates
% u - mean              [Defaults to 0]
% v - variance  (v>0)   [Defaults to 1]
% F - pdf of N(u,v) at x (Lower tail probability)
%__________________________________________________________________________
%
% spm_Ncdf implements the Cumulative Distribution Function (CDF) for
% the Normal (Gaussian) family of distributions.
%
% References:
%--------------------------------------------------------------------------
% An Approximation to the Probability Integral
% J. D. Williams
% The Annals of Mathematical Statistics, Vol. 17, No. 3. (Sep., 1946), pp.
% 363-365.
%
%__________________________________________________________________________
% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging

% Karl Friston
% $Id: spm_Ncdf_jdw.m 4836 2012-08-10 15:55:21Z karl $

%-Format arguments
%--------------------------------------------------------------------------
if nargin < 3, v = 1; end
if nargin < 2, u = 0; end

%-Approximate integral
%--------------------------------------------------------------------------
x    = (x - u)./sqrt(abs(v));
F    = sqrt(1 - exp(-(2/pi)*x.^2))/2;
i    = x < 0;
F(i) = -F(i);
F    = F + 1/2;


function res = backtest(rex,Nh);
% PURPOSE: Backtesting of temporal disaggregation.
% -----------------------------------------------------------------------
% SYNTAX: res = backtest(rex,Nh);
% -----------------------------------------------------------------------
% OUTPUT: res: a structure with...
%         rex  : reference structure
%         yh   : recursive estimations from FROM T=N+Nh T=N
%         yrev : revision as %, compared with final (full info) estimation
% -----------------------------------------------------------------------
% INPUT: rex: a structure generated by chowlin(), fernandez(), litterman()
%             or ssc()
%        Nh: 1x1 --> number of low-freq. to compute revisions
% -----------------------------------------------------------------------
% LIBRARY: chowlin, fernandez, litterman, ssc
% -----------------------------------------------------------------------
% NOTE: Revision of estimates when adding low-frequency data from T=N-Nh to
% T=N

% written by:
%  Enrique M. Quilis
%  Macroeconomic Research Department
%  Ministry of Economy and Competitiveness
%  <enrique.quilis@mineco.es>

% Version 2.1 [May 2008]

t0 = clock;

% ------------------------------------------------------------
% Loading the structure

Y 		= rex.Y;
x 		= rex.x(:,2:end); %Excluding intercept
ta 	    = rex.ta;
sc 	    = rex.sc;
type 	= rex.type;
opC     = rex.opC;

% ------------------------------------------------------------
% Size of the problem

N = rex.N;     % Size of low-frequency input
n = rex.n;     % Size of high-frequency input
p = rex.p - 1; % Number of regressors (without intercept)

% ------------------------------------------------------------
% BACKTEST: REVISIONS OF ESTIMATES, AS Y EXPANDS (x all sample)
% ------------------------------------------------------------

x = x(1:sc*N,:);
yh = NaN * ones(n,Nh+1);
for h=Nh:-1:0
    Yh = Y(1:end-h);
    % Calling temporal disaggregation function
    switch rex.meth
        case {'Chow-Lin'}
            rl   = rex.rl;
            res1 = chowlin(Yh,x,ta,sc,type,opC,rl);
        case {'Fernandez'}
            res1 = fernandez(Yh,x,ta,sc,opC);
        case {'Litterman'}
            rl   = rex.rl;
            res1 = litterman(Yh,x,ta,sc,type,opC,rl);
        case {'Santos Silva-Cardoso'}
            rl   = rex.rl;
            res1 = ssc(Yh,x,ta,sc,type,opC,rl);
        otherwise
            error ('*** BACKTESTING IS NOT AVAILABLE FOR THIS METHOD ***');
    end
    % Generating yh
    yh(:,Nh-h+1) = res1.y;
end

% Computation of revisons as percentages
yrev = (yh - kron(ones(1,Nh+1),yh(:,end))) ./ yh;

% -----------------------------------------------------------
% Loading the structure
% -----------------------------------------------------------

% Reference structure
res.rex = rex;
% Sequence of estimates
res.yh = yh;
% Revisions of stimates
res.yrev = yrev;
% Elapsed time
res.et = etime(clock,t0);


function varargout = transformPoint(varargin)
%TRANSFORMPOINT Apply an affine transform to a point or a point set.
%
%   PT2 = transformPoint(PT1, TRANSFO);
%   Returns the result of the transformation TRANSFO applied to the point
%   PT1. PT1 has the form [xp yp], and TRANSFO is either a 2-by-2, a
%   2-by-3, or a 3-by-3 matrix,
%
%   Format of TRANSFO can be one of :
%   [a b]   ,   [a b c] , or [a b c]
%   [d e]       [d e f]      [d e f]
%                            [0 0 1]
%
%   PT2 = transformPoint(PT1, TRANSFO);
%   Also works when PTA is a N-by-2 array representing point coordinates.
%   In this case, the result PT2 has the same size as PT1.
%
%   [X2, Y2] = transformPoint(X1, Y1, TRANS);
%   Also works when PX1 and PY1 are two arrays the same size. The function
%   transforms each pair (PX1, PY1), and returns the result in (X2, Y2),
%   which has the same size as (PX1 PY1).
%
%
%   See also
%     points2d, transforms2d, translation, rotation
%

% ------
% Author: David Legland
% E-mail: david.legland@inrae.fr
% Created: 2004-04-06
% Copyright 2004-2022 INRA - TPV URPOI - BIA IMASTE

% parse input arguments
if length(varargin) == 2
    var = varargin{1};
    px = var(:,1);
    py = var(:,2);
    trans = varargin{2};
elseif length(varargin) == 3
    px = varargin{1};
    py = varargin{2};
    trans = varargin{3};
else
    error('wrong number of arguments in "transformPoint"');
end

% apply linear part of the transform
px2 = px * trans(1,1) + py * trans(1,2);
py2 = px * trans(2,1) + py * trans(2,2);

% add translation vector, if exist
if size(trans, 2) > 2
    px2 = px2 + trans(1,3);
    py2 = py2 + trans(2,3);
end

% format output arguments
if nargout < 2
    varargout{1} = [px2 py2];
elseif nargout
    varargout{1} = px2;
    varargout{2} = py2;
end


function [mu, muw]= ViscosityCO2Water(T, p, x_CO2)
% This function calculates the viscosity of the pure water, brine, and
% water-CO2, and brine-CO2 systems
% p is in Pa, T in K, x_CO2 is the mole fraction of CO2, mu in Pa.s
% Written by Ali A. Eftekhari at TU Delft
% See the license file
Mwater = 0.0180153; % kg/mol
% MCO2 = 0.04401; % kg/mol

P = p/1e6; % convert Pa to MPa
m_CO2 = DuanSun(T, p, 0); % CO2 equilibrium molality (mol CO2/kg water)
x_CO2_eq = m_CO2/(m_CO2+1/Mwater);
muw = IAPWS_IF97('mu_pT', P, T); % pure water viscosity in Pa.s
vis_ratio = 1+(-4.069e-3*(T-273.15)+0.2531)*x_CO2/x_CO2_eq;
mu = muw*vis_ratio;


%Test script to run SVP for matrix completion using uniformly sampled random matrices
%Written by: Prateek Jain (pjain@cs.utexas.edu) and Raghu Meka (meka@cs.utexas.edu)
%Last updated: October, 2009

m = 5000;
n = 2000;
k = 10; %rank of the optimal matrix
p = 0.2; %fraction of known entries
params.tol=1e-3;
params.vtol=1e-4;
params.mxitr=100;
params.verbosity=1;

M = randn(m,k)*randn(k,n); %Generate the underlying matrix
random_permutation=randperm(m*n);
Omega=random_permutation(1:p*m*n)'; %Generate samples with uniform density p
Omega=sort(Omega);

fprintf('Running SVP with m=%d, n=%d, p=%f...\n',m,n,p);
t=cputime;
[U,S,V,num_iter] = svp(Omega, M(Omega), m, n, k, params); %Run SVP
t = cputime-t;
fprintf('SVP finished with RMSE=%f in time t=%f\n',norm(M-U*diag(S)*V','fro')/sqrt(length(Omega)),t);


function [varargout]=rigidTransformationMatrixDirect(V1,V2)

%%
%Force input to 3D
if size(V1,2)==2
    V1(:,3)=0;
end

if size(V2,2)==2
    V2(:,3)=0;
end

[Q]=kabschRotationMatrix(V1,V2);

V1_m=mean(V1,1);
V2_m=mean(V2,1);

T1=eye(4,4);
T1(1:3,end)=V2_m(:);

R=eye(4,4);
R(1:3,1:3)=Q;

T2=eye(4,4);
T2(1:3,end)=-V1_m;

T=T1*R*T2;

varargout{1}=T;
varargout{2}=R(1:3,1:3);

%%
% _*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 plotkde(X, sigma2)
% Plot 2d kernel density.
% Written by Mo Chen (sth4nth@gmail.com).
if nargin < 2
    sigma2 = 1e-1;
end
level = 64;
n = 256;

X = standardize(X);

spread(X);
x_range = xlim;
y_range = ylim;

x = linspace(x_range(1),x_range(2), n);
y = linspace(y_range(2),y_range(1), n);

[a,b] = meshgrid(x,y);

z = exp(logkdepdf([a(:)';b(:)'],X,sigma2));

z = z-min(z);
z = floor(z/max(z)*(level-1));

figure;
image(reshape(z,n,n));
colormap(jet(level));
set(gca, 'XTick', [1 256]);
set(gca, 'XTickLabel', [min(x) max(x)]);
set(gca, 'YTick', [1 256]);
set(gca, 'YTickLabel', [min(y) max(y)]);
axis off


function boolVal=linTargetIsUntrackable(targetParams,PD,lambda,AbsTol,RelTol,maxIter)
%%LINTARGETISUNTRACKABLE Assuming that an asymptotic inoovation covariance
%           is available or that a target follows a particular specified
%           linear dynamic model (e.g. position, velocity, and
%           acceleration, and it could have correlation terms like a Gauss-
%           Markov model) with known process noise covariance and Cartesian
%           measurement covariance, and assuming that a probability of
%           detection is known, determine whether a target is untrackable.
%           A target is deemed untrackable if the cost function used in a
%           multiple hypothesis tracker (MHT)  is always greater than or
%           equal to  the null hypothesis than for any track hypothesis
%           when given asymptotic track accuracy parameters. If a track is
%           untrackable, even an MHT of infinite length would not be able
%           to track the target. This assumes Cartesian measurements. The
%           use of range rate, complex target amplitude, micro-Doppler and
%           other information could potentially render untrackable targets
%           trackable.
%
%INPUTS: targetParams This can be one of two types of inputs. If an
%          asymptotic innovation covariance matrix is known, then this is
%          the innovation covariance matrix. Otherwise, this is a structure
%          holding parameters for a linear system so that an asymptotic
%          innovation covariance matrix can be computed. The members of the
%          structure are:
%           H The zDim X xDim measurement matrix such that H*x+w is the
%             measurement, where x is the state and w is zero-mean Gaussian
%             noise with covariance matrix R.
%           F The xDim X xDim state transition matrix The state at
%             discrete-time k+1 is modeled as F times the state at time k
%             plus zero- mean Gaussian process noise with covariance matrix
%             Q.
%           R The zDim X zDim measurement covariance matrix.
%           Q The xDim X xDim process noise covariance matrix. This can
%             not be a singular matrix.
%       PD The optional detection probability of the target at each scan.
%          PD should not be 1.
%   lambda The false alarm density in Cartesian coordinates. For example,
%          this might be 1e-8 false alarms per unit volume in cubic meters.
%   RelTol The maximum relative error tolerance allowed when computing the
%          asymptotic predictive covariance matrix. This is a positive
%          scalar. If omitted or an empty matrix is passed, the default
%          value of 1e-13 is used. This value is only used if targetParams
%          is a structure.
%   AbsTol The absolute error tolerance allowed, a positive scalar. When
%          computing the asymptotic predictive covariance matrix. This is a
%          positive scalar. If omitted or an empty matrix is passed, the
%          default value of 1e-10 is used. This value is only used if
%          targetParams is a structure.
%  maxIter An optional integer specifying the maximum number of iterations
%          to use when cmputing the asymptotic predictive covariance
%          matrix. By default, if omitted, this is 5000. This value is only
%          used if targetParams is a structure.
%
%As discussed in Chapter 7.5 of [1], track oriented MHTs declare target
%existence based on finite sums of log-likelihood ratios. These ratios are
%typically made into dimensionless score functions as in Chapter 7.5 of [1]
%and in [2]. For the probability that a measurement z is from a particular
%target, the contribution to the score function is f(z)*PD/lambda, where
%f(z) is the likelihood of the measurement conditioned on the predicted
%state estimate. The null hypothesis receives a score of 1-PD. If the null
%hypothesis is always greater than or equal to the track association
%hypothesis then a target is untrackable.
%
%Given a Cartesian measurement model (z=H*x+w where x is the target state,
%w is measurement noise with covariance matrix R and H is the measurement
%matrix) and assuming a linear dynamic model (xpredicted=F*xPrior+v where v
%is noise with covariance matrix Q) where the state transition matrix F and
%the process noise covariance matrix Q are constant (implying a uniform
%revisit rate) as well as having a known detection probability of PD,  one
%determine an asymptotic lower bound on the estimation accuracy of a
%predicted state measurement using the RiccatiPredNoClutter function. Given
%PPred, a lower bound on the state precision covariance, the score function
%contribution for a target-originated measurement is maximum when the
%predicted measurement equals the measurement value. From Chapter 7.5.3 of
%[1], for a linear measurement model, this is
%PD/(lambda*sqrt(det(2*pi*SPred))) where SPred is the innovation covariance
%matrix, which as given in the derivation of the Kalman filter in Chapter 5
%of [3] is H*PPred*H'+R. Thus, this function determines whether this
%maximum score for a track-originated measurement is greater than the
%alternative (1-PD). If not, then the target is untrackable.
%
%The trackability bound here can be considered something of a "stealth"
%bound, because for a fixed false alarm level in a system, a target can
%become untrackable either by lowing its detection probability sufficiently
%(becoming "stealth") and/or by increasing its maneuverability, which,
%here, is reflected in increasign the process noise covariance.
%
%Note that if the innovation covariance matrix is passed for targetParams,
%this function just uses its size and determiniant.
%
%EXAMPLE:
% T=1;
% targetParams=[];
% targetParams.F=FPolyKal(T,6,1);
% q0=1;
% targetParams.Q=QPolyKal(T,6,1,q0);
% targetParams.R=diag([10;10;10]);
% targetParams.H=[1,0,0,0,0,0;
%    0,1,0,0,0,0;
%    0,0,1,0,0,0];
% PD=0.5;
% lambda=1e-8;
% boolVal=linTargetIsUntrackable(targetParams,PD,lambda)
% %The above example is trackable (boolVal=false). However, if the
% %detection probability decreases/ the false alarm rate increases, then
% %one gets an untrackable target. Consider:
% PD=0.1;
% lambda=1e-6;
% boolVal1=linTargetIsUntrackable(targetParams,PD,lambda)
%
%REFERENCES:
%[1] Y. Bar-Shalom, P. K. Willett, and X. Tian, Tracking and Data Fusion.
%    Storrs, CT: YBS Publishing, 2011.
%[2] Y. Bar-Shalom, S. S. Blackman, and R. J. Fitzgerald, "Dimensionless
%    score function for multiple hypothesis tracking," IEEE Transactions on
%    Aerospace and Electronic Systems, vol. 43, no. 1, pp. 392-400, Jan.
%    2007.
%[3] Y. Bar-Shalom, X. R. Li, and T. Kirubarajan, Estimation with
%    Applications to Tracking and Navigation. New York: John Wiley and
%    Sons, Inc, 2001.
%
%January 2017 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

if(nargin<4||isempty(AbsTol))
    AbsTol=1e-13;
end

if(nargin<5||isempty(RelTol))
    RelTol=1e-10;
end

if(nargin<6||isempty(maxIter))
   maxIter=5000;
end

if(isstruct(targetParams))
    H=targetParams.H;
    F=targetParams.F;
    R=targetParams.R;
    Q=targetParams.Q;
    m=size(H,1);

    %Asymptotic predicted state covariance matrix with given PD assuming
    %completely correct association hypotheses.
    PPred=RiccatiPredNoClutter(H,F,R,Q,PD,AbsTol,RelTol,maxIter);

    %Asymptotic innovation covariance matrix.
    detSPred=det(H*PPred*H'+R);
else
    S=targetParams;
    m=size(S,1);
    detSPred=det(S);
end

maxIsTargetScore=PD/(lambda*sqrt((2*pi)^m*detSPred));
missedDetectScore=1-PD;

boolVal=maxIsTargetScore<=missedDetectScore;
end

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


% SB1_EXAMPLECLASSIFY   Example of Sparse Bayes Classification
%
% SB1_EXAMPLECLASSIFY(N,KERNEL,WIDTH,MAXITS)
%
% INPUT ARGUMENTS:
%
%       N       Number of training points (up to 250)
%       KERNEL  Kernel function to use (see SB1_KERNELFUNCTION)
%       WIDTH   Kernel length scale parameter
%       MAXITS  Maximum number of iterations to run for
%
% NOTES: The data is taken from the book "Pattern Recognition for
%        Neural Networks" (Ripley). Running SB1_EXAMPLECLASSIFY with
%        no arguments will result in sensible defaults.
%
%
% Copyright 2009 :: Michael E. Tipping
%
% This file is part of the SPARSEBAYES baseline implementation (V1.10)
%
% Contact the author: m a i l [at] m i k e t i p p i n g . c o m
%
function SB1_ExampleClassify(N,kernel_,width,maxIts)

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

% Set verbosity of output (0 to 4)
setEnvironment('Diagnostic','verbosity',3);
% Set file ID to write to (1 = stdout)
setEnvironment('Diagnostic','fid',1);

%
% Set default values for data and model
%
useBias	= true;
%
rand('state',1)
if nargin==0
  % Some acceptable defaults
  %
  N		= 100;
  kernel_	= 'gauss';
  width		= 0.5;
  maxIts	= 1000;
end
monIts		= round(maxIts/10);
N		= min([250 N]); % training set has fixed size of 250
Nt		= 1000;
%
% Load Ripley's synthetic training data (see reference in doc)
%
load synth.tr
synth	= synth(randperm(size(synth,1)),:);
X	= synth(1:N,1:2);
t	= synth(1:N,3);

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

COL_data1	= 'k';
COL_data2	= 0.75*[0 1 0];
COL_boundary50	= 'r';
COL_boundary75	= 0.5*ones(1,3);
COL_rv		= 'r';

%
% Plot the training data
%
figure(1)
whitebg(1,'w')
clf
h_c1	= plot(X(t==0,1),X(t==0,2),'.','MarkerSize',18,'Color',COL_data1);
hold on
h_c2	= plot(X(t==1,1),X(t==1,2),'.','MarkerSize',18,'Color',COL_data2);
box	= 1.1*[min(X(:,1)) max(X(:,1)) min(X(:,2)) max(X(:,2))];
axis(box)
set(gca,'FontSize',12)
drawnow

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

%
% Set up initial hyperparameters - precise settings should not be critical
%
initAlpha	= (1/N)^2;
% Set beta to zero for classification
initBeta	= 0;
%
% "Train" a sparse Bayes kernel-based model (relevance vector machine)
%
[weights, used, bias, marginal, alpha, beta, gamma] = ...
    SB1_RVM(X,t,initAlpha,initBeta,kernel_,width,useBias,maxIts,monIts);

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

%
% Load Ripley's test set
%
load synth.te
synth	= synth(randperm(size(synth,1)),:);
Xtest	= synth(1:Nt,1:2);
ttest	= synth(1:Nt,3);
%
% Compute RVM over test data and calculate error
%
PHI	= SB1_KernelFunction(Xtest,X(used,:),kernel_,width);
y_rvm	= PHI*weights + bias;
errs	= sum(y_rvm(ttest==0)>0) + sum(y_rvm(ttest==1)<=0);
SB1_Diagnostic(1,'RVM CLASSIFICATION test error: %.2f%%\n', errs/Nt*100)

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

%
% Visualise the results over a grid
%
gsteps		= 50;
range1		= box(1):(box(2)-box(1))/(gsteps-1):box(2);
range2		= box(3):(box(4)-box(3))/(gsteps-1):box(4);
[grid1 grid2]	= meshgrid(range1,range2);
Xgrid		= [grid1(:) grid2(:)];
size(Xgrid)
%
% Evaluate RVM
%
PHI		= SB1_KernelFunction(Xgrid,X(used,:),kernel_,width);
y_grid		= PHI*weights + bias;

% apply sigmoid for probabilities
p_grid		= 1./(1+exp(-y_grid));

%
% Show decision boundary (p=0.5) and illustrate p=0.25 and 0.75
%
[c,h05]		= ...
    contour(range1,range2,reshape(p_grid,size(grid1)),[0.5],'-');
[c,h075]	= ...
    contour(range1,range2,reshape(p_grid,size(grid1)),[0.25 0.75],'--');
set(h05, 'Color',COL_boundary50,'LineWidth',3);
set(h075,'Color',COL_boundary75,'LineWidth',2);
%
% Show relevance vectors
%
h_rv	= plot(X(used,1),X(used,2),'o','LineWidth',2,'MarkerSize',10,...
	       'Color',COL_rv);
%
legend([h_c1 h_c2 h05 h075(1) h_rv],...
       'Class 1','Class 2','Decision boundary','p=0.25/0.75','RVs',...
       'Location','NorthWest')
%
hold off
title('RVM Classification of Ripley''s synthetic data','FontSize',14)


%[ P, inls ] = ht_simple_ransac_p3p( u, X, rthr, maxiter )
%u: 3 x n image points
%X: 3 x n 3D points
%rthr: inlier threshold
%maxiter: default=1000

function [ P, inls ] = ht_simple_ransac_p3p( u, X, rthr, max_iter )
if nargin < 4
    max_iter = 1000;
end

%initialization
u = bsxfun(@rdivide, u, sqrt(sum(u.^2, 1)));
Npts = size(u, 2);
rthr = cos(rthr);
max_inlsnum = 3;
no_iter = 0;
P = [];
inls = false(1, Npts);
%ransac
while no_iter < max_iter
    no_iter = no_iter + 1;

    idx = randperm(Npts, 3);
    P_cand = P3PSolver([u(:, idx); X(:, idx)]);
    [inls_cand, inls_cand_num] = calculate_inls_angular(P_cand, u, X, rthr);
    if length(P_cand) > 1
        [inls_cand_num, inls_cand_idx] = max(inls_cand_num);
        inls_cand = inls_cand{inls_cand_idx};
        P_cand = P_cand{inls_cand_idx};
    else
        inls_cand_num = inls_cand_num(1);
        inls_cand = inls_cand{1};
        P_cand = P_cand{1};
    end

    if inls_cand_num >= max_inlsnum
        max_inlsnum = inls_cand_num;
        P = P_cand;
        inls = inls_cand;
        max_iter = min([max_iter, nsamples(max_inlsnum, Npts, 3, 0.95)]);
    end

end

end

function [SampleCnt, q] = nsamples(ni, ptNum, pf, conf)
    q  = prod (((ni-pf+1) : ni) ./ ((ptNum-pf+1) : ptNum));
    if q < eps
      SampleCnt = Inf;
    else
      %   SampleCnt  = log(1 - conf) / log(1 - q);
      if q > conf
        SampleCnt = 1;
      else
        SampleCnt  = log(1 - conf) / log(1 - q);
      end
    end
end

function [inls, inls_num] = calculate_inls_angular(Pcand, u, X, rthr)
    inls = cell(1, length(Pcand));
    inls_num = zeros(1, length(Pcand));
    for ii = 1:1:length(Pcand)
        X_reproj = Pcand{ii} * [X; ones(1, size(X, 2))];
        X_reproj = bsxfun(@rdivide, X_reproj, sqrt(sum(X_reproj.^2, 1)));

        res = sum(u .* X_reproj, 1);
        inls{ii} = res > rthr;
        inls_num(ii) = sum(inls{ii});
    end

end


function raeq = eqxra (tjd, k)

% this function computes the intermediate right ascension
% of the equinox at julian date tjd, using an analytical expression
% for the accumulated precession in right ascension.  for the
% true equinox the result is the equation of the origins.

% input

%  tjd = tdb julian date

%  k = equinox selection code

%      set k = 0 for mean equinox
%      set k = 1 for true equinox (equation of the origins)

% output

%  raeq = intermediate right ascension of the equinox, in hours (+ or -)

% NOTE: this function computes the accumulated precession in right
%       ascension using the analytic equation in capitaine et al. (2003),
%       astronomy and astrophysics 412, 567-586, eq. (42).

% ported from NOVAS 3.0

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

% t0 = tdb julian date of epoch j2000.0 (tt)

t0 = 2451545.0d0;

t = (tjd - t0) / 36525.0d0;

% for the true equinox, obtain the equation of the equinoxes in time seconds

if (k == 1)

    [a, a, ee, a, a] = etilt (tjd);

    eqeq = ee;

else

    eqeq = 0.0d0;

end

% precession in ra in arcseconds taken from capitaine et al. (2003),
% astronomy and astrophysics 412, 567-586, eq. (42)

precra = 0.014506d0 + ...
    (((( -0.0000000368d0 * t ...
    - 0.000029956d0) * t ...
    - 0.00000044d0) * t ...
    + 1.3915817d0) * t ...
    + 4612.156534d0) * t;

raeq = -(precra / 15.0d0 + eqeq) / 3600.0d0;


function transm = transformmatrix(s,r,t)
% *** Homogeneous transformation matrix ***
% Function transformmatrix returns transformation matrix from object to image space.
%
% transm = transformmatrix (s,r,t)
%
% inputs,
%   s = Zoom factor
%   r = Rotation vector (rotx,roty,rotz)
%   t = Translation Vector [x,y,z]
%
% transm = Rotation Matrix
%

S=[s 0 0 0;
   0 s 0 0;
   0 0 s 0;
   0 0 0 1];

Rx=[1 0 0 0;
    0 cos(r(1)) -sin(r(1)) 0;
    0 sin(r(1)) cos(r(1)) 0;
    0 0 0 1];

Ry=[cos(r(2)) 0 sin(r(2)) 0;
    0 1 0 0;
    -sin(r(2)) 0 cos(r(2)) 0;
    0 0 0 1];

Rz=[cos(r(3)) -sin(r(3)) 0 0;
    sin(r(3)) cos(r(3)) 0 0;
    0 0 1 0;
    0 0 0 1];

R=Rx*Ry*Rz;

T=[1 0 0 t(1);
   0 1 0 t(2);
   0 0 1 t(3);
   0 0 0 1];

transm = S*R*T;


function Cct=clg2cct(Clg,lat,lon)
% CLG2CCT  Convert local geodetic covariance matrix to CT.
%   Vectorized. Requires rotlg2ct. See also CCT2CLG.
% Version: 2011-04-05
% Useage:  Cct=clg2cct(Clg,lat,lon)
% Input:   Clg - LG covariance matrix
%          lat - vector of station latitudes (rad)
%          lon - vector of station longitudes (rad)
% Output:  Cct - CT covariance matrix

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

n=length(lat);
if (n*3 ~= max(size(Clg)) )
  error('Size of lat,lon does not match size of Clg');
end

for i=1:n
  sinlat=sin(lat(i));
  coslat=cos(lat(i));
  sinlon=sin(lon(i));
  coslon=cos(lon(i));
  Ji=rotlg2ct(lat(i),lon(i));
  indi=(i-1)*3+[1:3];
  for j=1:n
    sinlat=sin(lat(j));
    coslat=cos(lat(j));
    sinlon=sin(lon(j));
    coslon=cos(lon(j));
    Jj=rotlg2ct(lat(j),lon(j));
    indj=(j-1)*3+[1:3];
    Cct(indi,indj)=Ji*Clg(indi,indj)*Jj';
  end
end


function [fx,fy,ft] = computeDerivatives2(im1,im2)
%
% function [fx,fy,fz] = computeDerivatives2(im1,im2)
%
% im1 and im2 are images
%
% [fx,fy,ft] are images, derivatives of the input images

filter = [0.03504 0.24878 0.43234 0.24878 0.03504];
dfilter = [0.10689 0.28461 0.0  -0.28461  -0.10689];

dx1 = conv2sep(im1,dfilter,filter,'valid');
dy1 = conv2sep(im1,filter,dfilter,'valid');
blur1 = conv2sep(im1,filter,filter,'valid');
dx2 = conv2sep(im2,dfilter,filter,'valid');
dy2 = conv2sep(im2,filter,dfilter,'valid');
blur2 = conv2sep(im2,filter,filter,'valid');

fx=(dx1+dx2)/2;
fy=(dy1+dy2)/2;
ft=(blur2-blur1);


% 15.7.02
%
% Unscented Kalman Filter (UKF) applied to FitzHugh-Nagumo neuron dynamics.
% Voltage observed, currents and inputs estimated.
%
% FitzHughNagumo() is the main program and calls the other programs.
%
% A detailed description is provided in
% H.U. Voss, J. Timmer & J. Kurths, Nonlinear dynamical system identification from uncertain and indirect measurements, Int. J. Bifurcation and Chaos 14, 1905-1933 (2004).
% I will be happy to email this paper on request. It contains a tutorial about the estimation of hidden states and unscented Kalman filtering.
%
% For commercial use and questions, please contact me.
%
% ++++++++++++++++++++++++++++++++++++++++++++++
% Henning U. Voss, Ph.D.
% Associate Professor of Physics in Radiology
% Citigroup Biomedical Imaging Center
% Weill Medical College of Cornell University
% 516 E 72nd Street
% New York, NY 10021
% Tel. 001-212 746-5216, Fax. 001-212 746-6681
% Email: hev2006@med.cornell.edu
% ++++++++++++++++++++++++++++++++++++++++++++++

function FitzHughNagumo()

global dT

orient tall

% Dimensions: dq for param. vector, dx augmented state, dy observation
dq=1; dx=dq+2; dy=1;

fct='FitzHughNagumo_fct'; % model function F(x)
obsfct='FitzHughNagumo_obsfct';   % observation function G(x)

ll=800; % number of data samples
dT=0.2; % sampling time step (global variable)

% Simulating data: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

x0=zeros(2,ll); x0(:,1)=[0; 0]; % true trajectory
dt=.1*dT; nn=fix(dT/dt); % the integration time step is smaller than dT

% External input, estimated as parameter p later on:
z=[1:ll]/250*2*pi; z=-.4-1.01*abs(sin(z/2));

% 4th order Runge-Kutta integrator:

for n=1:ll-1;
  xx=x0(:,n);
  for i=1:nn
    k1=dt*FitzHughNagumo_int(xx,z(n));
    k2=dt*FitzHughNagumo_int(xx+k1/2,z(n));
    k3=dt*FitzHughNagumo_int(xx+k2/2,z(n));
    k4=dt*FitzHughNagumo_int(xx+k3,z(n));
    xx=xx+k1/6+k2/3+k3/3+k4/6;
  end;
  x0(:,n+1)=xx;
end;

x=[z; x0]; % augmented state vector (notation a bit different to paper)

R=.2^2*var(FitzHughNagumo_obsfct(x))*eye(dy,dy); % observation noise covariance matrix
randn('state',0); y=feval(obsfct,x)+sqrtm(R)*randn(dy,ll); % noisy data

% Initial conditions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

xhat=zeros(dx,ll);
xhat(:,2)=x(:,2); % first guess of x_1 set to observation

Q=.015; % process noise covariance matrix

Pxx=zeros(dx,dx,ll);
Pxx(:,:,1)=blkdiag(Q,R,R);

errors=zeros(dx,ll); % not so important
Ks=zeros(dx,dy,ll);  % Kalman gains

% Main loop for recursive estimation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

for k=2:ll

[xhat(:,k),Pxx(:,:,k),Ks(:,:,k)]=ut(xhat(:,k-1),Pxx(:,:,k-1),y(:,k),fct,obsfct,dq,dx,dy,R);

Pxx(1,1,k)=Q;

errors(:,k)=sqrt(diag(Pxx(:,:,k)));

end; % k

% Results %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

chisq=mean((x(1,:)-xhat(1,:)).^2+(x(2,:)-xhat(2,:)).^2+(x(3,:)-xhat(3,:)).^2)
est=xhat(1:dq,ll)'
error=errors(1:dq,ll)'

figure(1)

subplot(2,1,1)
plot(y,'bd','MarkerEdgeColor','blue', 'MarkerFaceColor','blue','MarkerSize',3);
hold on;
plot(x(dq+1,:),'black','LineWidth',2);
%plot(xhat(dq+1,:),'r','LineWidth',2);
xlabel(texlabel('t'));
ylabel(texlabel('x_1, y'));
hold off;
axis tight
title('(a)')
drawnow

subplot(2,1,2)
plot(x(dq+2,:),'black','LineWidth',2);
hold on
plot(xhat(dq+2,:),'r','LineWidth',2);
plot(x(1,:),'black','LineWidth',2);
for i=1:dq; plot(xhat(i,:),'m','LineWidth',2); end;
for i=1:dq; plot(xhat(i,:)+errors(i,:),'m'); end;
for i=1:dq; plot(xhat(i,:)-errors(i,:),'m'); end;
xlabel(texlabel('t'));
ylabel(texlabel('z, estimated z, x_2, estimated x_2'));
hold off
axis tight
title('(b)')

function r=FitzHughNagumo_int(x,z)
% Function for modeling data, not for UKF execution
a=.7; b=.8; c=3.;
r=[c*(x(2)+x(1)-x(1)^3/3+z); -(x(1)-a+b*x(2))/c];

function r=FitzHughNagumo_obsfct(x)
% Observation function
r=x(2,:);

function r=FitzHughNagumo_fct(dq,x)
% Runge-Kutta integrator for FitzHugh-Nagumo system with parameters

global dT
dt=.02; % local integration step
nn=fix(dT/dt);

p=x(1:dq,:);
xnl=x(dq+1:size(x(:,1)),:);
for n=1:nn
k1=dt*fc(xnl,p);
k2=dt*fc(xnl+k1/2,p);
k3=dt*fc(xnl+k2/2,p);
k4=dt*fc(xnl+k3,p);
xnl=xnl+k1/6+k2/3+k3/3+k4/6;
end
r=[x(1:dq,:); xnl];

function r=fc(x,p);
a=.7; b=.8; c=3.;
r=[c*(x(2,:)+x(1,:)-x(1,:).^3/3+p); -(x(1,:)-a+b*x(2,:))/c];

function [xhat,Pxx,K]=ut(xhat,Pxx,y,fct,obsfct,dq,dx,dy,R);
% Unscented transformation. Not specific to FitzHugh-Nagumo model

  N=2*dx;

  xsigma=chol( dx*Pxx )'; % Pxx=root*root', but Pxx=chol'*chol
  Xa=xhat*ones(1,N)+[xsigma, -xsigma];
  X=feval(fct,dq,Xa);

  xtilde=sum(X')'/N;

  Pxx=zeros(dx,dx);
  for i=1:N;
    Pxx=Pxx+(X(:,i)-xtilde)*(X(:,i)-xtilde)'/N;
  end;

  Y=feval(obsfct,X);

  ytilde=sum(Y')'/N;
  Pyy=R;
  for i=1:N;
    Pyy=Pyy+(Y(:,i)-ytilde)*(Y(:,i)-ytilde)'/N;
  end;
  Pxy=zeros(dx,dy);
  for i=1:N;
    Pxy=Pxy+(X(:,i)-xtilde)*(Y(:,i)-ytilde)'/N;
  end;

  K=Pxy*inv(Pyy);
  xhat=xtilde+K*(y-ytilde);
  Pxx=Pxx-K*Pxy';


function vEst=RROnlyStaticVelEst(rr,xTx,xRx,zTar)
%%RRONLYSTATICVELEST Perform unweighted least-squares estimation of a
%           target velocity vector given only range rate measurements from
%           different bistatic channels (or from multiple receivers if the
%           target is the transmitter). This function can work in 2D and
%           3D space and it will produce a least-squares estimate when more
%           than the minimum number of range rate measurements needed is
%           given. This uses a non-relativistic model for the range rates
%           and ignores possible atmospheric effects.
%
%INPUTS: rr A numMeasX1 or 1XnumMeas vector of range rates. numMeas>=3 for
%           the velocity vector to be observable in 3D and numMeas>=2 in
%           2D.
%       xTx A 6XnumMeas matrix (in 3D or a 4XnumMeas matrix in 2D) of
%           stacked transmitter position and velocity vectors. If the
%           target is the transmitter, then an empty matrix should be
%           passed. xTx(:,n)=[x;y;z;xDot;yDot;zDot] is the state (3
%           position and 3 velocity components) corresponding to the nth
%           range rate measurement. If all of the transmitters are in the
%           same spot, then a single 6X1 or 4X1 vector can be passed.
%       xRx A 6XnumMeas matrix (in 3D or a 4XnumMeas matrix in 2D) of
%           stacked transmitter position and velocity vectors.
%           states1(:,n)=[x;y;z;xDot;yDot;zDot] is the state (3 position
%           and 3 velocity components) corresponding to the nth range rate
%           measurement. If all of the receivers are in the same spot, then
%           a single 6X1 or 4X1 vector can be passed.
%      zTar The 3X1 (in 3D) or 2X1 (in 2D) Cartesian position of the
%           target.
%
%OUTPUTS: vEst The 3X1 (in 3D) or 2X1 (in 2D) least squares Cartesian
%              velocity estimate of the target.
%
%This implements the least squares velocity vector estimation procedure of
%Equation 41 in Section IV E of [1]. The case of the transmitter being the
%target is handled specially (to get rid fo the singulaity).
%
%EXAMPLE 1:
%This is just a simple example showing that for three range rate values,
%one can get back the orignal velocity value in 3D.
% zTar=[0;40e3;40e3];
% vTar=[400;-200;100];
% xTx1=[100;10e3;3e3;50;50;-50];
% xTx2=[0;0;0;0;0;-20];
% xTx3=[10e3;10e3;3e3;100;-100;100];
%
% xRx1=[-10e3;0;3e3;100;100;100];
% xRx2=[0;10e3;30;-80;-200;-20];
% xRx3=xRx2;
%
% states1=[xTx1,xTx2,xTx3];
% states2=[xRx1,xRx2,xRx3];
%
% xTar=[zTar;vTar];
%
% useHalfRange=false;
% rr=zeros(3,1);
% rr(1)=getRangeRate(xTar,useHalfRange,xTx1,xRx1);
% rr(2)=getRangeRate(xTar,useHalfRange,xTx2,xRx2);
% rr(3)=getRangeRate(xTar,useHalfRange,xTx3,xRx3);
%
% vEst=RROnlyStaticVelEst(rr,states1,states2,zTar)
%One will see that vEst=vzTar.
%
%EXAMPLE 2:
%This is the same as example 1, except the demonstration is now occurring
%in 2D.
% zTar=[0;40e3];
% vTar=[400;-200];
% xTx1=[100;10e3;50;50];
% xTx2=[0;0;0;0];
% xTx3=[10e3;10e3;100;-100];
%
% xRx1=[-10e3;0;100;100];
% xRx2=[0;10e3;-80;-200];
% xRx3=xRx2;
%
% states1=[xTx1,xTx2,xTx3];
% states2=[xRx1,xRx2,xRx3];
%
% xTar=[zTar;vTar];
%
% useHalfRange=false;
% rr=zeros(3,1);
% rr(1)=getRangeRate(xTar,useHalfRange,xTx1,xRx1);
% rr(2)=getRangeRate(xTar,useHalfRange,xTx2,xRx2);
% rr(3)=getRangeRate(xTar,useHalfRange,xTx3,xRx3);
%
% vEst=RROnlyStaticVelEst(rr,states1,states2,zTar)
%One will see that vEst=vzTar.
%
%EXAMPLE 3:
%In this example, the range rate is one-way from the target (e.g. the
%target is an emitter). The relative error of the velocity estimate with
%the truth (noiseless scenario) is within finite precision limits.
% zTar=randn(3,1);
% vTar=randn(3,1);
% numMeas=5;
% xRx=randn(6,numMeas);
% xTar=[zTar;vTar];
% useHalfRange=false;
% rr=zeros(numMeas,1);
% for k=1:numMeas
%     rr(k)=getRangeRate(xTar,useHalfRange,xTar,xRx(:,k));
% end
% vEst=RROnlyStaticVelEst(rr,[],xRx,zTar);
% RelErr=max(abs((vTar-vEst)./vTar))
%
%REFERENCES:
%[1] David F. Crouse , "Basic tracking using nonlinear 3D monostatic and
%    bistatic measurements," IEEE Aerospace and Electronic Systems
%    Magazine, vol. 29, no. 8, Part II, pp. 4-53, Aug. 2014.
%
%October 2013 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

numMeas=length(rr);
rr=rr(:);

if(size(xTx,2)==1)
    xTx=repmat(xTx,1,numMeas);
end

if(size(xRx,2)==1)
    xRx=repmat(xRx,1,numMeas);
end

posDim=length(zTar);

zRx=xRx(1:posDim,:);
vRx=xRx((posDim+1):(2*posDim),:);

h=bsxfun(@minus,zTar,zRx);
hNorm=sqrt(sum(h.*h,1));
h=bsxfun(@rdivide,h,hNorm);

if(~isempty(xTx))
    %The target is not the transmitter.
    zTx=xTx(1:posDim,:);
    vTx=xTx((posDim+1):(2*posDim),:);
    hi=bsxfun(@minus,zTar,zTx);
    hiNorm=sqrt(sum(hi.*hi,1));
    hi=bsxfun(@rdivide,hi,hiNorm);

    rDotB=rr+sum(h.*vRx,1)'+sum(hi.*vTx,1)';
    Hv=bsxfun(@plus,h',hi');
else
    %The target is the transmitter.
    rDotB=rr+sum(h.*vRx,1)';
    Hv=h';
end

vEst=lsqminnorm(Hv,rDotB);

end

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


% feldkamp_example.m
% example of how to use feldkamp.m for cone-beam CT reconstruction
% Copyright 2004-8-28, Nicole Caparanis, Patty Laskowsky, Taka Masuda,
% and Jeff Fessler, The University of Michigan

if ~isvar('proj'), disp 'proj'
	down = 8;
	nh = 256/down;
	nv = 240/down;
	na = 224/down;
	ds = 1024/nh;
	dt = ds;
	dis_src_det = 949.075;
	dis_iso_det = 408.075;
	dis_src_iso = dis_src_det - dis_iso_det;
%	dis_foc_src = inf; % flat detector panel
	dis_foc_src = 0; % arc detector
	offset_det_h = 0.25; % quarter detector
	offset_det_v = 0.0;
	horiz = ([-(nh-1)/2:(nh-1)/2]' - offset_det_h) * ds;
	verti = ([-(nv-1)/2:(nv-1)/2]' - offset_det_v) * dt;
	printf('rmax=%g', dis_src_iso*sin(atan(max(abs(horiz)) / dis_src_det)))

	ell = [ ...
		[20 0 0  150 150 200 0 0.01]; % 30cm diam "cylinder"
		[80 0 0 50 50 30  0 0.01]; % bone-like inserts
		[0 0 75  40 40 40  0 0.01];
		[0 70 0  30 30 30  0 0.01];
	];

	proj = ellipsoid_proj(ell, horiz, verti, na, ...
		dis_src_iso, dis_iso_det, dis_foc_src);

	nx = 256/down;
	ny = 240/down;
	nz = 200/down;
	dx = 2*down; dy = dx; dz = dx; % 2mm voxels * down-sampling
	xtrue = ellipsoids(nx, ny, nz, ell, dx, dy, dz);

	% cone-beam system geometry, generalized from fan-beam geometry.
	% see ASPIRE users guide under tech. reports on web page for details.
	args = arg_pair('system', NaN, 'nx', nx, 'ny', ny, 'nz', nz, ...
		'nv', nv, 'nh', nh, 'na', na, 'support', 'all', ...
		'orbit', 360, 'orbit_start', 0, ...
		'pixel_size', dx, 'ray_spacing', ds, 'strip_width', 0, ...
		'dis_src_det', dis_src_det, ...
		'dis_iso_det', dis_iso_det, ...
		'dis_foc_src', dis_foc_src, ...
		'offset_source', 0, ...
		'offset_det_h', offset_det_h, ...
		'offset_det_v', offset_det_v);

	pl=330;
	im(pl+1, xtrue, 'x true'), cbar
	im(pl+4, proj, 'true projections'), cbar
	drawnow
prompt
end

% noisy data and estimated line integrals
if ~isvar('li_hat'), disp 'li_hat'
	% noisy data, if blank scan value has been specified.
	if isvar('bi') && isvar('ri')
		yb = bi .* exp(-proj) + ri;
		yi = poisson(yb);
		li_hat = -log((yi-ri) ./ bi);
		li_hat(yi-ri <= 0) = 0; % fix: need something better here...
	else
		li_hat = proj; % noiseless
	end
end

% FDK cone-beam reconstruction
if ~isvar('xfdk'), disp 'fdk'
	mask = true([nx ny nz]);
	xfdk = feldkamp_old(li_hat, 'ramp', mask, args);
end

if 1
	% show results (off-center slices worse than central slice)
	im(pl+2, xfdk, 'FDK recon'), cbar
	im(pl+3, xfdk - xtrue, 'FDK error'), cbar

	subplot(pl+5)
	ix = 1:nx; iy = ceil(ny/2); iz = ceil(nz/2);
	plot(ix, xtrue(ix,iy,iz), '-', ix, xfdk(ix,iy,iz), '--')
	axis([1 nx -0.005 0.025]), legend('true', 'FDK recon', 2)
	title 'middle slice', xlabel 'ix'

	subplot(pl+6)
	iz=1:nz; ix = 1+floor(nx/2); iy = 1+floor(ny/2);
	plot(iz, squeeze(xtrue(ix,iy,iz)), '-', iz, squeeze(xfdk(ix,iy,iz)), '--')
	axis([1 nz -0.005 0.025]), legend('true', 'FDK recon', 2), xlabel 'iz'
	title(sprintf('profile at (ix,iy)=(%g,%g)', ix,iy))

prompt
end


%% CUBEAFEMQUADCURL quad curl equations on the unit cube
%
%   CUBEAFEMQUADCURL computes ND0-(CR-P0)-ND0 nonconforming approximations
%   of the quad curl equations in the unit cube. The mesh is refined
%   adaptively guided by a residual-based estimator.
%
% Copyright (C)  Long Chen. See COPYRIGHT.txt for details.

close all; clear;

%% Set up
maxN = 5e5;
maxIt = 20;
theta = 0.3;
N = zeros(maxIt,1);
h = zeros(maxIt,1);
erru = zeros(maxIt,1);
errw = zeros(maxIt,1);
errphi = zeros(maxIt,1);
etaTotal = zeros(maxIt,1);
etaw = zeros(maxIt,1);
etaphi = zeros(maxIt,1);
etau = zeros(maxIt,1);

%% Generate initial mesh
H = pi;
[node,elem,HB] = cubemesh([0,H,0,H,0,H],H/2);
bdFlag = setboundary3(node,elem,'Dirichlet');

%% PDE and options
pde = quadCurlDataSmooth1;

option.solver = 'direct';
option.printlevel = 0;

%% Finite Element Method
for k = 1:maxIt

    %% SOLVE
    [soln,eqn] = quadcurl3NC(node,elem,bdFlag,pde,option);
    N(k) = 2*length(soln.u)+3*length(soln.phi);
    %% ESTIMATE
    [erru(k), errK] = getHcurlerror3ND(node,elem,pde.curlu,soln.u);
    [etaK, est] = estimatequadcurl(node,elem,soln,pde,option);
    etaTotal(k) = sqrt(sum(etaK.^2));
    etaw(k) = sqrt(sum((est.eta1).^2));
    etaphi(k) = sqrt(sum((est.eta2).^2));
    etau(k) = sqrt(sum((est.eta3).^2));
    fprintf("Iter %2d, # Dof= %6d; \n||curl(u-u_h)|| = %8.6g,eta = %8.6g \n \n",...
           k, N(k), erru(k), etaTotal(k))
    %% Visualize
    figure(1);
    set(gcf, 'Position', [100 600 1000 300])
    subplot(1,3,1)
    showboundary3(node,elem,'z<pi/2','facealpha',0.5);

    subplot(1,3,2)
    errorE2V = accumarray(elem(:),repmat(errK,[4,1]),[size(node,1), 1]);
    showsolution3(node,elem,errorE2V,'z<pi/2 ','EdgeColor','k');

    subplot(1,3,3)
    etaE2V = accumarray(elem(:),repmat(etaK,[4,1]),[size(node,1), 1]);
    showsolution3(node,elem,etaE2V,'z<pi/2 ','EdgeColor','k');

    drawnow;
    %% MARK and REFINE
    if N(k) > maxN
        break;
    end

    markedElem = mark(elem,etaK,theta);
    if k < maxIt
        [node,elem,bdFlag,HB] = bisect3(node,elem,markedElem,bdFlag,HB);
        [elem,bdFlag] = sortelem3(elem,bdFlag);
    end

end

%%
close all;
figure(1);
r1 = showrate(N,erru,10,'r-o');
r2 = showrate(N,etaTotal,10,'b-*');
r3 = showrate(N,etaw,10,'color',[0.2, 0.8,0.7],'marker','*');
r4 = showrate(N,etaphi,10,'color',[0.2, 0.8,0.7],'marker','*');
r5 = showrate(N,etau,10,'color',[0.2, 0.8,0.7],'marker','*');
set(gca,'xscale','log','yscale','log');
T = title('Convergence');
XL = xlabel('$\#$ DoFs');
YL = ylabel('Error Magnitudes');
L = legend('$\Vert  \nabla\times(u-u_h)\Vert$', ...
    ['$N^{' num2str(r1) '}$'],...
    '$\eta(w_h,\phi_h,u_h)$', ...
    ['$N^{' num2str(r2) '}$'],...
    '$\eta_1(w_h)$', ['$N^{' num2str(r3) '}$'],...
    '$\eta_2(\phi_h)$', ['$N^{' num2str(r4) '}$'],...
    '$\eta_3(u_h)$', ['$N^{' num2str(r5) '}$'],...
    'LOCATION','Best');
set([XL,YL,L],'Interpreter','latex','FontSize', 12);
set(T,'Interpreter','latex','FontSize',16);
grid on;
set(gcf,'color','w','Position', [100 200 350 500])
drawnow;

%% sanity check
if N<5e3
    figure(2);
    subplot(1,2,1);
    option.scale = 2;
    option.plot = 'quiver3';
    center = (node(elem(:,1),:) + node(elem(:,2),:) + ...
        node(elem(:,3),:) + node(elem(:,4),:))/4;
    showvector3(center,pde.curlu(center),option);
    subplot(1,2,2);
    curluh = curlu3(node,elem,soln.u);
    showvector3(center,curluh,option);
    % showvector3(center,curlwh_comp2,option);

    set(gcf,'color','w','Position', [500 600 750 300])
    drawnow;
end


function [xs,phid,wlsden,timeiter,niter] = wls_gcd(A, W, yy, xhat, ng, niter, tol)
%	weighted least squares minimized by
%	grouped coordinate descent algorithm
%	Input
%		A	[nn,np]		system matrix
%		W	[nn,nn]		inverse data covariance
%		yy	[nn,1]		noisy data
%		xhat	[np,1] or [nx,ny]	initial estimate
%		ng			# groups, or, if array, groups
%		tol			stopping criterion for convergence
%		niter			max
%
%	Output
%		xs	[np,niter+1]	estimates each iteration
%		phid	[niter+1,1]	objective decrease
%		wlsden	[np,1]		curvature of surrogate
%		timeiter [niter+1,1]	CPU time each iteration
%		niter			# total iterations
%
% Saowapak Sotthivirat
% 8/15/00

[nx,ny] = size(xhat);

np = ncol(A);
yy = yy(:);
xhat = xhat(:);
xs(:,1) = xhat;

%
%	build groups
%
if numel(ng) == 1
	groups = zeros(np, ng);
	for ig = 1:ng
		gg(:,ig) = [ig:ng:np]';
		groups(gg(:,ig),ig) = ones(size(gg(:,ig)));
	end
elseif numel(ng) == 2
	groups	= group2d(nx, ny,ng,ones(ng(1),ng(2)),0);
	ng	= ncol(groups);
	for ig = 1:ng
		gg(:,ig) = find(groups(:,ig).*[1:np]');
	end
else
	groups	= ng;
	ng	= ncol(groups);
end

%	precompute quadratic part of denominator
%	change '1' to 'ig' for overlapping groups
wlsden = zeros(np, 1);
for ig = 1:ng
	gr = groups(:,ig);
	ggi = gg(:,ig);

	t = A * gr;	% faster than: sum(A(:,gg)',1)';
	t = W * t;	% only slightly slower than: diag(W) .* t;
			% faster than either: A(:,gg)'*t or A' * t !
	t = t' * A;
	wlsden(ggi) = t(ggi)';
end

wii = diag(W);
res = A * xhat - yy;
phi0 = res'*W*res/2;
ii = 1;
phid(ii) = 0;
timeiter(ii) = 0;
t0 = cputime;

while phid(ii) < tol & ii <= niter

	for ig = 1:ng
		ggi = gg(:,ig);
		xold = xhat(ggi);
		xnew = xold;
		ader = ((W*res)'*A(:,ggi))';
		diff = ader./wlsden(ggi);
		xnew = xnew - diff;
		xhat(ggi) = max(0,xnew);
		res = res - A(:,ggi) * diff;

	end
	ii = ii+1;
	xs(:,ii) = xhat;
	phid(ii) = phi0 - res'*W*res/2;
	timeiter(ii) = cputime - t0;
end

niter = ii;


function [F,sA] = spm_multinomial_log_evidence(qA,pA,rA)
% Bayesian model reduction for multinomial distibutions
% FORMAT [F,sA] = spm_multinomial_log_evidence(qA,pA,rA)
%
% qA  - parameter of posterior of full model
% pA  - parameter of prior of full model
% rA  - parameter of prior of reduced model
%
%
% F   - (negative) free energy or log evidence of reduced model
% sA  - parameter of reduced posterior
%
% This routine computes the negative log evidence of a reduced model of a
% mutinomial distribution. This also applies for Bernoulli, Binomial, and
% Categorical distributions.
%__________________________________________________________________________
% Copyright (C) 2005 Wellcome Trust Centre for Neuroimaging

% Thomas Parr
% $Id: spm_multinomial_log_evidence.m 7679 2019-10-24 15:54:07Z spm $

% reduced posteriors
%--------------------------------------------------------------------------
sA = spm_softmax(qA + rA - pA);

% change in free energy or log model evidence
%--------------------------------------------------------------------------
k = find(rA);
F  = log(rA(k(1))) - log(pA(k(1))) + log(qA(k(1))) - log(sA(k(1)));


function [type,center,theta,foci,ecc,normform] = conic_properties(A,B,C,D,E,F)

[type,x0,y0,theta,A2,B2,C2,D2,E2,F2] = conic_standard_form(A,B,C,D,E,F);

% change from translation followed by rotation to rotation followed by
% translation
% x <- (x + u)*R
% = x*R + u*R
R = [cos(theta),sin(theta);-sin(theta),cos(theta)];
center = [x0,y0]*R;
normform = [A2,B2,C2,D2,E2,F2];

if strcmpi(type,'circle')
  foci = [0,0];
  ecc = 0;
elseif strcmpi(type,'ellipse') || strcmpi(type,'hyperbola'),
  a2 = 1 / min(abs(A2),abs(C2));
  b2 = 1 / max(abs(A2),abs(C2));
  c2 = sqrt(a2 - b2);
  if A2 < C2,
    foci = [-c2,0;c2,0];
  else
    foci = [0,-c2;0,c2];
  end
  ecc = c2 / a2;
elseif strcmpi(type,'parabola'),
  if abs(A2) > abs(C2),
    foci = [0,-E2/4];
  else
    foci = [-D2/4,0];
  end
  ecc = 1;
else % other
  foci = zeros(0,2);
  ecc = 0;
end

nfoci = size(foci,2);
if nfoci > 0,
  % translate
  foci(:,1) = foci(:,1) + x0;
  foci(:,2) = foci(:,2) + y0;
  % rotate
  foci = foci*R;
end


function model = glmOmnibus(model, units);
%
% model = glmOmnibus(model, [units]);
%
% Compute the 'omnibus' contrast for a GLM -- an F test of the significance
% of all experimental conditions against baseline -- appending the results
% to a GLM model struct.
%
% model: struct produced by the glm function.
%
% units: 'F' or 'p', specifies the units to return for each voxel. [Default
% 'p', p-value associated w/ the F distribution.]
%
% Appends a model.omnibus field, containing the results of the contrast
% for each voxel, as well as an omnibus_units field, specifying the units
% used.
%
% For details see Burock and Dale, "Estimation and Detection of
% Event-Related fMRI Signals with Temporally Correlated Noise: A
% Statistically Efficient and Unbiased Approach", HBM, 2001.
%
% ras, 01/04/2006.
if ieNotDefined('units'), units = 'p'; end

% Omnibus Significance Test %  (from er_selxavg)
R = eye(model.nh, Navgs_tot);
q = R*hhat;
if model.nh > 1
    qsum = sum(q); % To get a sign %
else
    qsum = q;
end

if (model.nh == 1)
    Fnum = inv(R * model.C * R') * (q.^2) ;  %'
else
    Fnum = sum(q .* (inv(R*model.C*R') * q));  %'
end

Fden = model.nh * (eres_std.^2);
ind = find(Fden == 0);
Fden(ind) = 10^10;
F = sign(qsum) .* Fnum ./ Fden;

if (~isempty(fomnibusstem))
    fname = sprintf('%s_%03d.mat',fomnibusstem,slice);
    tmp = reshape(F,[nrows ncols]);
    er_svtfile(tmp,fname,override);
end

if isequal(lower(units), 'p')
    % convert to p-value, looking it up for the associated F distribution:
    % This will have [J, n-K] degrees of freedom, where J is the number
    % of rows in our restriction matrix R, and n and K are the # of rows
    % and columns in the design matrix X, respectively.
    p = sign(F) .* er_ftest(model.nh, model.dof, abs(F));

    % this prevents values from becoming infinite -- but I'm not
    % sure why p(indz) is set to 1 rather than s
    indz = find(p==0);
    p(indz) = 1;
    p = sign(p).*(-log10(abs(p)));

    omnibus(1:nrows, 1:ncols, slice) = reshape(p, [nrows ncols]);
end


function [P orderstruct] = mmtimes(varargin)
% P = mmtimes(M1, M2, ... Mn)
%   return a chain matrix product P = M1*M2* ... *Mn
%
% {Mi} are matrices with compatible dimension: size(Mi,2) = size(Mi+1,1)
%
% Because the matrix multiplication is associative; the chain product can
% be carried out with different order, leading to the same result (up to
% round-off error). MMTIMES uses "optimal" order of binary product to
% reduce the computational effort (probably the accuracy is also improved).
%
% The function assumes the cost of the product of (m x n) with (n x p)
% matrices is (m*n*p). This assumption is typically true for full matrix.
%
% Notes:
%   Scalar matrix are groupped together, and the rest will be
%   multiplied with optimal order.
%
%   To get the the structure that stores the best order, call with the
%   second outputs:
%   >> [P orderstruct] = mmtimes(M1, M2, ... Mn);
%   % This structure can be used later if the input matrices have the
%   % same sizes as those in the first call (but with different contents)
%   >> P = mmtimes(M1, M2, ... Mn, orderstruct);
%
% See also: mtimes
%
% Author: Bruno Luong <brunoluong@yahoo.com>
% Orginal: 19-Jun-2010
%          20-Jun-2010: quicker top-down algorithm
%          23-Jun-2010: treat the case of scalars
%          16-Aug-2010: passing optimal order as output/input argument

Matrices = varargin;

buildexpr = false;
if ~isempty(Matrices) && isstruct(Matrices{end})
    orderstruct = Matrices{end};
    Matrices(end) = [];
else
    % Detect scalars
    iscst = cellfun('length',Matrices) == 1;
    if any(iscst)
        % scalars are multiplied apart
        cst = prod([Matrices{iscst}]);
        Matrices = Matrices(~iscst);
    else
        cst = 1;
    end
    % Size of matrices
    szmats = [cellfun('size',Matrices,1) size(Matrices{end},2)];
    s = MatrixChainOrder(szmats);

    orderstruct = struct('cst', cst, ...
                         's', s, ...
                         'szmats', szmats);

    if nargout>=2
        % Prepare to build the string expression
        vnames = arrayfun(@inputname, 1:nargin, 'UniformOutput', false);
        % Default names, e.g., M1, M2, ..., for inputs that is not single variable
        noname = cellfun('isempty', vnames);
        vnames(noname) = arrayfun(@(i) sprintf('M%d', i), find(noname), 'UniformOutput', false);
        if any(iscst)
            % String '(M1*M2*...)' for constants
            cstexpr = strcat(vnames(iscst),'*');
            cstexpr = strcat(cstexpr{:});
            cstexpr = ['(' cstexpr(1:end-1) ')'];
        else
            cstexpr = '';
        end
        vnames = vnames(~iscst);
        buildexpr = true;
    end
end

if ~isempty(Matrices)
    P = ProdEngine(1,length(Matrices),orderstruct.s,Matrices);
    if orderstruct.cst~=1
        P = orderstruct.cst*P;
    end
    if buildexpr
        expr = Prodexpr(1,length(Matrices),orderstruct.s,vnames);
        if ~isempty(cstexpr)
            % Concatenate the constant expression in front
            expr = [cstexpr '*' expr];
        end
        orderstruct.expr = expr;
    end
else
    P = orderstruct.cst;
    if nargout>=2
        orderstruct.expr = cstexpr;
    end
end

end % mmtimes

%%
function [s qmin] = MatrixChainOrder(szmats)
% Find the best ordered chain-product, the best splitting index
% of M(i)*...*M(j) is stored in s(j,i) of the array s (only the lower
% part is filled)
% Top-down dynamic programming, complexity O(n^3)

n = length(szmats)-1;
s = zeros(n);

pk = szmats(2:n);
ij = (0:n-1)*(n+1)+1;
left = zeros(1,n-1);
right = zeros(1,n-1);
L = 1;
while true % off-diagonal offset
    q = zeros(size(pk));
    for j=1:n-L % this is faster and BSXFUN or product with DIAGONAL matrix
        q(:,j) = (szmats(j)*szmats(j+L+1))*pk(:,j);
    end
    q = q + left + right;
    [qmin loc] = min(q, [], 1);
    s(ij(1:end-L)+L) = (1:n-L)+loc;

    if L<n-1
        pk = [pk(:,1:end-1);
              pk(end,2:end)];
        left = [left(:,1:end-1);
                qmin(1:end-1)];
        right = [qmin(2:end);
                 right(:,2:end)];
        L = L+1;
    else
        break
    end % if
end % while-loop

end % MatrixChainOrder

%%
function P = ProdEngine(i,j,s,Matrices)
% Perform matrix product from the optimal order, recursive engine
if i==j
    P = Matrices{i};
else
    k = s(j,i);
    P = ProdEngine(i,k-1,s,Matrices)*ProdEngine(k,j,s,Matrices);
end

end

%%
function expr = Prodexpr(i,j,s,vnames)
% Return the string expression of the optimal order
if i==j
    expr = vnames{i};
else
    k = s(j,i);
    expr = ['(' Prodexpr(i,k-1,s,vnames) '*' Prodexpr(k,j,s,vnames) ')'];
end

end % Prodexpr


function alpha = neper2db(alpha, y)
%NEPER2DB   Convert nepers to decibels.
%
% DESCRIPTION:
%       neper2db converts an attenuation coefficient in units of
%       Nepers/((rad/s)^y m)to units of dB/(MHz^y cm).
%
% USAGE:
%       alpha = neper2db(alpha)
%       alpha = neper2db(alpha, y)
%
% INPUTS:
%       alpha       - attenuation in Nepers/((rad/s)^y m)
%
% OPTIONAL INPUTS:
%       y           - power law exponent (default = 1)
%
% OUTPUTS:
%       alpha       - attenuation in dB/(MHz^y cm)
%
% ABOUT:
%       author      - Bradley Treeby
%       date        - 3rd December 2009
%       last update - 5th December 2011
%
% This function is part of the k-Wave Toolbox (http://www.k-wave.org)
% Copyright (C) 2009-2014 Bradley Treeby and Ben Cox
%
% See also db2neper

% This file is part of k-Wave. k-Wave is free software: you can
% redistribute it and/or modify it under the terms of the GNU Lesser
% General Public License as published by the Free Software Foundation,
% either version 3 of the License, or (at your option) any later version.
%
% k-Wave 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 Lesser General Public License for
% more details.
%
% You should have received a copy of the GNU Lesser General Public License
% along with k-Wave. If not, see <http://www.gnu.org/licenses/>.

if nargin == 1
    y = 1;
end

alpha = 20*log10(exp(1))*alpha*(2*pi/1e-6)^y/100;