function [u,sigma,eqn,info] = PoissonRT0(node,elem,bdFlag,pde,option)
%% POISSONRT0 Poisson equation: lowest order RT element.
%
%  [u,sigma] = PoissonRT0(node,elem,bdFlag,pde) produces an approximation of
%  the Poisson equation
%
%       -div(d*grad(u))=f  in \Omega, with
%       Dirichlet boundary condition u=g_D on \Gamma_D,
%       Neumann boundary condition   d*grad(u)*n=g_N on \Gamma_N
%
%  in the mixed formulation:
%
%  Find (\sigma , u) in H_{g_N,\Gamma_N}(div,\Omega)\times L^2(\Omega) s.t.
%
%  (d^-1\sigma,\tau) + (div \tau, u)  = <\tau*n,g_D>_{\Gamma_D}
%  \forall \tau in H_{0,\Gamma_N}(div,\Omega)
%  (div \sigma, v)                =  -(f,v)
%  \forall v in L^2(\Omega)
%
%  where
%  H_{g,\Gamma}(div,\Omega) = {\sigma \in H(div,\Omega); \sigma*n = g
%  on \Gamma \subset \partial\Omega }.
%
%  The unknown sigma = d*grad(u) is approximated using the lowest order
%  Raviart-Thomas element and u by piecewise constant element (with basis 1).
%
%  [u,sigma] = PoissonRT0(node,elem,bdFlag,pde,option) specifies options
%   - option.solver
%     'direct': the built in direct solver \ (mldivide)
%     'tri':    triangular preconditioner
%     'uzawapcg': PCG for the Schur complement equation
%     'none': only assemble the matrix equation but not solve
%
%   The default setting is to use the direct solver for small size problems
%   and transforming based multigrid solvers for large size problems.
%
%  Example
%
%    squarePoissonRT0
%
% Created by Ming Wang. Reorganized by Long Chen. Change basis for u.
%
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

%% Preprocess
if ~exist('bdFlag','var'), bdFlag = []; end
if ~exist('option','var'), option = []; end

%% Diffusion coefficient
time = cputime;  % record assembling time
if ~isfield(pde,'d'), pde.d = []; end
if isfield(pde,'d') && ~isempty(pde.d)
   if isnumeric(pde.d)
      K = pde.d;                   % d is an array
   else                            % d is a function
      center = (node(elem(:,1),:) + node(elem(:,2),:) + node(elem(:,3),:))/3;
      K = pde.d(center);  % take inverse sequencil.
   end
else
    K = [];
end

%% Data structure
elemold = elem;
[elem,bdFlag] = sortelem(elem,bdFlag);  % ascend ordering of elem
[elem2edge,edge] = dofedge(elem);
NT = size(elem,1); NE = size(edge,1);
[Dlambda,area,elemSign] = gradbasis(node,elem);

%% Assemble matrix
Nsigma = NE; Nu = NT; Ndof = Nsigma + Nu;

% M. Mass matrix for RT0 element
M = getmassmatvec(elem2edge,area,Dlambda,'RT0',K); % ascend ordering of loc edge

% B. divergence operator
B = icdmat(double(elem2edge),elemSign*[1 -1 1]); % inconsistency with the induced ordering

% C. zero matrix.
C = sparse(Nu,Nu);

A = [M B';B C];

%% Assemble right hand side.
fu = zeros(Nu,1);
if ~isfield(pde,'f') || (isreal(pde.f) && (pde.f==0))
    pde.f = [];
end
if ~isfield(option,'fquadorder')
    option.fquadorder = 2;   % default order
end
if ~isempty(pde.f)
	[lambda,w] = quadpts(option.fquadorder);
	nQuad = size(lambda,1);
    for p = 1:nQuad
		% quadrature points in the x-y coordinate
		pxy = lambda(p,1)*node(elem(:,1),:) ...
			+ lambda(p,2)*node(elem(:,2),:) ...
			+ lambda(p,3)*node(elem(:,3),:);
		fp = pde.f(pxy);
		fu = fu - fp*w(p);  % div u = -f;
    end
    fu = fu.*area;
end
clear fp
F((Nsigma+1):Ndof,1) = fu;

%% Boundary Conditions
if ~exist('bdFlag','var'), bdFlag = []; end
[AD,F,bigu,freeDof,isPureNeumannBC] = getbdRT0(F);
eqn = struct('M',AD(1:NE,1:NE),'B',AD(NE+1:end,1:NE),'C',AD(NE+1:end,NE+1:end),...
             'f',F(1:NE),'g',F(NE+1:end),'freeDof',freeDof,'A',AD);

%% Record assembling time
assembleTime = cputime - time;
if ~isfield(option,'printlevel'), option.printlevel = 1; end
if option.printlevel >= 2
    fprintf('Time to assemble matrix equation %4.2g s\n',assembleTime);
end

%% Solve the linear system.
% Set up solver type
if isempty(option) || ~isfield(option,'solver')    % no option.solver
    if Ndof <= 2e3  % Direct solver for small size systems
        option.solver = 'direct';
    else         % MGCG  solver for large size systems
        option.solver = 'tri';
    end
% elseif strcmp(option.solver,'mg')
%     option.solver = 'tripremixPoisson';
end
solver = option.solver;
% solve
switch lower(solver)
    case 'direct'
        t = cputime;
        bigu(freeDof) = AD(freeDof,freeDof)\F(freeDof);
        sigma = bigu(1:NE);
        u = bigu(NE+1:end);
        info = struct('solverTime',cputime - t,'itStep',1,'error',0,'flag',0,'stopErr',0);
    case 'none'
        sigma = zeros(NE,1); u = zeros(NT,1); info =[];
    case 'tri'
        [sigma,u,info] = tripremixPoisson(eqn.M,eqn.B,eqn.C,eqn.f,eqn.g,elemold);
    case 'uzawapcg'
        [sigma,u,info] = uzawapcg(eqn.M,eqn.B,eqn.C,eqn.f,eqn.g,elemold);
%     case 'mg'
%         option.freeEdge = freeEdge;
%         option.isPureNeumannBC = isPureNeumannBC;
%         [sigma0,u,info] = mgDarcy(eqn.M,eqn.B,eqn.f,eqn.g,elemold,option);
%         sigma = bigu(1:NE);
%         sigma(freeEdge) = sigma0;
end
if isPureNeumannBC % post process for u for pure Neumann boundary condition
    ubar = sum(u.*area)/sum(area);
    u = u - ubar;
end

%% Output information
info.assembleTime = assembleTime;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% subfunction getbdRT0
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    function [AD,F,bigu,freeDof,isPureNeumannBC] = getbdRT0(F)
    %% GETBDRT0 Boundary conditions for Poisson equation: RT0 element.
    %
    %  Created by Ming Wang. Improved the check of edgeSign by Long Chen.

    bigu = zeros(Ndof,1);

    %% No boundary conditions
    if ~isfield(pde,'g_D'), pde.g_D = []; end
    if ~isfield(pde,'g_N'), pde.g_N = []; end

    %% Set up bdFlag
    if isempty(bdFlag) % no bdFlag information
       if ~isempty(pde.g_N) % case: Neumann
           bdFlag = setboundary(node,elem,'Neumann');
       elseif ~isempty(pde.g_D) % case: Dirichlet
           bdFlag = setboundary(node,elem,'Dirichlet');
       end
    end

    %% Find Dirichlet and Neumann dofs
    edgeSign = ones(NE,1);
    isDirichlet = false(NE,1);
    isNeumann = false(NE,1);
    if ~isempty(bdFlag)
        isDirichlet(elem2edge(bdFlag(:)==1)) = true;
          isNeumann(elem2edge(bdFlag(:)==2)) = true;
        % Direction of boundary edges may not be the outwards normal direction
        % of the domain. edgeSign is introduced to record this inconsistency.
        edgeSign = ones(NE,1);
        idx = (bdFlag(:,1) ~= 0) & (elemSign == -1);% first edge is on boundary
        edgeSign(elem2edge(idx,1)) = -1;
        idx = (bdFlag(:,2) ~= 0) & (elemSign == 1); % second edge is on boundary
        edgeSign(elem2edge(idx,2)) = -1;
        idx = (bdFlag(:,3) ~= 0) & (elemSign == -1);% third edge is on boundary
        edgeSign(elem2edge(idx,3)) = -1;
    end
    Dirichlet = edge(isDirichlet,:);
    Neumann = edge(isNeumann,:);
    isBdDof = false(Ndof,1);
    isBdDof(isNeumann) = true;   % for mixed method, Neumann edges are fixed
    freeDof = find(~isBdDof);
%     isFreeEdge = true(NE,1);
%     isFreeEdge(isNeumann) = false;
%     freeEdge = find(isFreeEdge);

    %% Dirichlet boundary condition (Neumann BC in the mixed form)
    %   We need only modify the rhs on dof associated with Dirichlet
    %   boundary. Compute the int_e g_D \phi_e\cdot n ds on the boundary.
    if ~isempty(pde.g_D) && isnumeric(pde.g_D) && (pde.g_D==0)
        pde.g_D = [];
    end
    if ~isempty(pde.g_D) && any(isDirichlet)
        if ~isfield(option,'gNquadorder')
            option.gNquadorder = 2;   % default order exact for quadratic gN
        end
        [lambda,w] = quadpts1(option.gNquadorder);
        nQuad = size(lambda,1);
        % <\phi\cdot n, g_D> = 1/|e_{i,j}|\int e_{i,j} g_D ds
        for ip = 1:nQuad
        	pxy = lambda(ip,1)*node(Dirichlet(:,1),:)+...
                  lambda(ip,2)*node(Dirichlet(:,2),:);
            F(isDirichlet) = F(isDirichlet) + w(ip)*pde.g_D(pxy);
        end
        F(isDirichlet) = F(isDirichlet).*edgeSign(isDirichlet);
        % no edge length since the basis of sigma contains it.
    end

    %% Neumann boundary condition (Dirichlet BC in mixed form)
    % We compute the integral int_e g_N ds and assign to boundary dof
    if ~isempty(pde.g_N) && isnumeric(pde.g_N) && (pde.g_N==0)
        pde.g_N = [];
    end
    if ~isempty(pde.g_N) && any(isNeumann)
        % modify the rhs to include Dirichlet boundary condition
        ve = node(Neumann(:,1),:)-node(Neumann(:,2),:);
        edgeLength = sqrt(sum(ve.^2,2));
        % compute the integral int_e g_N ds
        if ~isfield(option,'gNquadorder')
            option.gNquadorder = 2;   % default order exact for quadratic gN
        end
        [lambda,w] = quadpts1(option.gNquadorder);
        nQuad = size(lambda,1);
        bigu(isNeumann) = 0;
        for ip = 1:nQuad
        	pxy = lambda(ip,1)*node(Neumann(:,1),:)+...
                  lambda(ip,2)*node(Neumann(:,2),:);
            bigu(isNeumann) = bigu(isNeumann) + w(ip)*pde.g_N(pxy).*edgeLength;
        end
        % correct the sign
        bigu(isNeumann) = bigu(isNeumann).*edgeSign(isNeumann);
        F = F - A*bigu;
        F(isNeumann) = bigu(isNeumann);
    end

    %% Pure Neumann boundary condition
    isPureNeumannBC = false;
    if ~any(isDirichlet) && any(isNeumann)
        freeDof = freeDof(1:end-1);  % eliminate the kernel by enforcing u(NT) = 0;
        isBdDof(end) = true;
        isPureNeumannBC = true;
        F(NE+1:end) = F(NE+1:end) - mean(F(NE+1:end)); % normalize
%         F(end) = 0;
    end

    %% Modify the matrix
    %  Build Neumann boundary condition(Dirichlet BC in mixed form) into the
    %  matrix AD by enforcing  |AD(bdNode,bdNode)=I,
    %  AD(bdNode,FreeNode)=0, AD(FreeNode,bdNode)=0|.
    if any(isBdDof)
       bdidx = zeros(Ndof,1);
       bdidx(isBdDof) = 1;
       Tbd = spdiags(bdidx,0,Ndof,Ndof);
       T = spdiags(1-bdidx,0,Ndof,Ndof);
       AD = T*A*T + Tbd;
    else
       AD = A;
    end
    end % end of getbdRT0
end


function  FRIEDEL= Tpm_FR(P,X,G,DH,ERH)
% TPM_FR  Friedel two-phase multiplier
% TPM_FR(P,X,G,DH,ERH) Returns the Friedel two-phase
% multipier for a steam-water system
%  Called function: h2o_rhof(P), h2o_rhog(P), h2o_muf(P),
%                   h2o_mug(P), h2o_sigma(P), h2o_rhotp(P,X),
%                   ffcw(RE,DH,ERH),
%  Required Inputs are: P  - pressure (kPa)
%                       X  - quality (fraction)
%                       G  - mass flux (kg/m^2s)
%                       DH - hydraulic diameter (m)
%                       ERH - equivalent roughness height (m)
% ---------------------------------------------------------------
% The MATLAB function was created by Tibor Balint, December 1998
% TBoreal Research Corporation, Toronto, Ont. Canada
% (tibor@netcom.ca) and also, University of Warwick, UK
% ---------------------------------------------------------------

format long g;  % set the format of the calculations

% set the density and viscosity properties
RF=h2o_rhof(P); %sat. fluid density
RG=h2o_rhog(P); %sat. steam density
MUF=h2o_muf(P); %dynamic viscosity of sat. fluid
MUG=h2o_mug(P); %dynamic viscosity of sat. steam
SIGMA=h2o_sigma(P); %surface tension
VFG=(1/RG)-(1/RF); %diff. between steam and fluid spec.volumes
VF=1/RF; %saturated fluid specific volume

% the two-phase specific density
RHOTP=h2o_rhotp(P,X);

% the two-phase specific volume
VTP=1/RHOTP;

% the Froude number
FR=(G^2)*(VTP^2)/(9.81*DH);

% the Weber number
WE=(G^2)*DH*VTP/SIGMA;

% the Reynolds number FOR LIQUID
REF=G*DH/MUF;

% the Reynolds number FOR STEAM
REG=G*DH/MUG;

% the Colebrook-White friction factor FOR LIQUID
FCWF=ffcw(REF,DH,ERH);

% the Colebrook-White friction factor FOR STEAM
FCWG=ffcw(REG,DH,ERH);

% Calculate the Friedel correlation
% the first part of the Friedel correlation
A=((1-X)^2)+(X^2)*(RF*FCWG)/(RG*FCWF);

%  THE FRIEDEL TWO-PHASE FRICTION MULTIPLIER
FRIEDEL=A+3.21*(X^0.78)*((1-X)^0.224)*((RF/RG)^0.91)*((MUG/MUF)^0.19)*...
       ((1-(MUG/MUF))^0.7)/((FR^0.0454)*(WE^0.035));

return


function bnet = mk_asia_bnet(CPD_type, p, arity)
% MK_ASIA_BNET Make the 'Asia' bayes net.
%
% BNET = MK_ASIA_BNET uses the parameters specified on p21 of Cowell et al,
% "Probabilistic networks and expert systems", Springer Verlag 1999.
%
% BNET = MK_ASIA_BNET('cpt', p) uses random parameters drawn from a Dirichlet(p,p,...)
% distribution. If p << 1, this is nearly deterministic; if p >> 1, this is nearly uniform.
%
% BNET = MK_ASIA_BNET('bool') makes each CPT a random boolean function.
%
% BNET = MK_ASIA_BNET('gauss') makes each CPT a random linear Gaussian distribution.
%
% BNET = MK_ASIA_BNET('orig') is the same as MK_ASIA_BNET.
%
% BNET = MK_ASIA_BNET('cpt', p, arity) can specify non-binary nodes.

if nargin == 0, CPD_type = 'orig'; end
if nargin < 3, arity = 2; end

Smoking = 1;
Bronchitis = 2;
LungCancer = 3;
VisitToAsia = 4;
TB = 5;
TBorCancer = 6;
Dys = 7;
Xray = 8;

n = 8;
dag = zeros(n);
dag(Smoking, [Bronchitis LungCancer]) = 1;
dag(Bronchitis, Dys) = 1;
dag(LungCancer, TBorCancer) = 1;
dag(VisitToAsia, TB) = 1;
dag(TB, TBorCancer) = 1;
dag(TBorCancer, [Dys Xray]) = 1;

ns = arity*ones(1,n);
if strcmp(CPD_type, 'gauss')
    dnodes = [];
else
    dnodes = 1:n;
end
bnet = mk_bnet(dag, ns, 'discrete', dnodes);

switch CPD_type
    case 'orig'
        % true is 2, false is 1
        bnet.CPD{VisitToAsia} = tabular_CPD(bnet, VisitToAsia, [0.99   0.01]);
        bnet.CPD{Bronchitis} = tabular_CPD(bnet, Bronchitis, [0.7 0.4   0.3 0.6]);
        % minka: bug fix
        bnet.CPD{Dys} = tabular_CPD(bnet, Dys, [0.9 0.2 0.3 0.1   0.1 0.8 0.7 0.9]);
        bnet.CPD{TBorCancer} = tabular_CPD(bnet, TBorCancer, [1 0 0 0   0 1 1 1]);
        % minka: bug fix
        bnet.CPD{LungCancer} = tabular_CPD(bnet, LungCancer, [0.99 0.9  0.01 0.1]);
        bnet.CPD{Smoking} = tabular_CPD(bnet, Smoking, [0.5 0.5]);
        bnet.CPD{TB} = tabular_CPD(bnet, TB, [0.99 0.95  0.01 0.05]);
        bnet.CPD{Xray} = tabular_CPD(bnet, Xray, [0.95 0.02  0.05 0.98]);
    case 'bool'
        for i=1:n
            bnet.CPD{i} = boolean_CPD(bnet, i, 'rnd');
        end
    case 'gauss'
        for i=1:n
            bnet.CPD{i} = gaussian_CPD(bnet, i, 'cov', 1*eye(ns(i)));
        end
    case 'cpt'
        for i=1:n
            bnet.CPD{i} = tabular_CPD(bnet, i, p);
        end
end


function [corr,t,p, fdrsig, fdrthresh] = correlation(meth,x,varargin)
% Multiple types of correlations, including Spearman's rho
% (nonparametric) and phi (dichotomous)
%
% :Usage:
% ::
%
%     [corr,t,p,fdrp, fdrthresh] = correlation(method,x,[y],['matrix'])
%
%     IN PROGRESS : Warning : Use at your own risk.
%     Some methods are not adequately tested yet.
%     Spearman's rho does not correct for ties
%
% :Inputs:
%
%   **Methods:**
%        String indicating the method for computing the correlation
%        coefficient
%        - Pearson's r.          Enter: {'r','pearson',[]}
%        - IRLS                  Enter: {'irls','robust'}
%        - Phi                   Enter: {'phi'}
%        - Spearman's rho        Enter: {'rho','spearman'}
%        - Kendall's Tau (a)     Enter: {'taua','kendalla'}
%        - Tau (b)               Enter: {'tau','kendall','taub','kendallb'}
%        - Gamma                 Enter: {'gamma','kruskal'}
%
%   **x:**
%        Matrix of observations (n instances by p varianbles)
%
% :Optional Inputs:
%
%   **varargin:**
%        To be documented
%
% :Outputs:
%
%   **OUT:**
%        Output stats structure
%
% :Examples:
% ::
%
%    % Corelation between two variables, Pearson's
%    x = rand(10,1); y = rand(10,1);
%    [corr,t,p] = correlation('r',x,y);
%
%    % Correlation matrix of 10 variables, phi correlation:
%    studybyroi = magic(10);
%    [corr,t,p] = correlation('phi',studybyroi);
%
% :See Also: correlation_fast_series.m
%
% ..
%    tor wager, november 2006, Jan 2007
% ..

corr = []; t = []; p = [];

% get y data, if entered
% --------------------------------
for i = 1:length(varargin)
    if ~ischar(varargin{i}) && ~any(size(varargin{i}) - size(x))
        y = varargin{i};
    end
end

% get flag for whether to compute correls among all possible pairs
% --------------------------------
matrixFormFlag = 0;
if any(strcmp(varargin,'matrix')) || ~exist('y','var')
    matrixFormFlag = 1;
end

[n,nvars] = size(x);

% Get indices
% --------------------------------
if matrixFormFlag
    % input is matrix
    [rows,cols,npairs] = corrcoef_indices(nvars);

else
    % input is columns of consecutive pairs to correlate
    npairs = size(x,2); % number of pairs of correlations to compute
end

doverbose = 0;
if npairs > 1000, doverbose = 1; fprintf('%03d%%', 0); end

% Compute correlations
% --------------------------------
for i = 1:npairs

    if doverbose, fprintf('\b\b\b\b%03d%%', round(i*100 ./ npairs)), end

    % get data
    if matrixFormFlag
        x1 = x(:,rows(i)); x2 = x(:,cols(i));
    else
        x1 = x(:,i); x2 = y(:,i);
    end

    if nargout > 1
        [c,tt,pp] = compute_single_correl(meth,x1,x2,n);
    else
        c = compute_single_correl(meth,x1,x2,n);
    end

    corr(i,1) = c;

    if nargout > 1
        if ~isempty(tt), t(i,1) = tt; end
        if ~isempty(pp), p(i,1) = pp; end
    end
end

% Reconstruct into matrix, if needed
% --------------------------------
if matrixFormFlag
    corr = reconstruct(corr,nvars,npairs,rows,cols);

    corr = corr + eye(nvars);

    if ~isempty(t), t = reconstruct(t,nvars,npairs,rows,cols); end

    if ~isempty(p), p = reconstruct(p,nvars,npairs,rows,cols); end

    % FDR correction, if requested
    % only works for matrices, otherwise error
    if nargout > 3
        [fdrthresh,fdrsig] = fdr_correct_pvals(p,corr);
    end

elseif nargout > 3
    error('FDR output is only allowed for matrix form output.  Try requesting fewer outputs')
end

return

% sub-functions

function [est,t,p] = compute_single_correl(meth,x,y,n)

est = [];
t = [];
p = [];

[wasnan, x, y] = nanremove(x, y);

switch lower(meth)

    case {'irls','robust'}
        [b,stats]=robustfit(x,y,'bisquare'); %,[],'off');
        est = weighted_corrcoef([x y], stats.w);
        est = est(1,2);

        t = stats.t(2);
        p = stats.p(2);

    case {'r','pearson',[]}

        if islogical(x)
            warning('Logical vectors not appropriate for Pearson''s r.');
            x = double(x);
            y = double(y);
        end

        [est,p] = corrcoef([x y]);
        est = est(1,2);
        p = p(1,2);

    case 'phi'
        % Phi is for dichotomous (2-level) variables
        % formula from Robert Yaffee, NYU, online.

        tab = make_crosstabs(x,y);
        num = det(tab);                 % same as: num = tab(1,1)*tab(2,2) - tab(1,2)*tab(2,1);
        den = ( prod(sum(tab,2)) .* prod(sum(tab,1)) ).^.5;
        est = num ./ den;

        % F = varexp/dfexp / varunexp/dferror; t = sqrt(F)
        if nargout > 1 % for speed
            t = est .* sqrt((n - 2) ./ (1 - est.^2));
            p = 2 .* (1 - tcdf(abs(t),n-2));        % two-tailed p-value
        end
        %wts = [];
        %nonpar = 0;
        % this works,but is unsigned
        %[chi2,df,p,sig] = chi2test([x y],'obs'); %,wts,nonpar);
        %est = (chi2 ./ n) .^ .5;

    case {'rho','spearman'}

        % This method uses midrank method to handle ties; needs checking
        % vs. SPSS
        D = rankdata(x) - rankdata(y);
        est = 1 - (6*(D'*D)) ./ (n * (n^2-1));

        % same as : corrcoef(rankdata(x),rankdata(y));
        % but faster
        % tested against SPSS 11.04
        % problem with large n?

        % % n = 1000;
        % % tic, for i = 1:100, x = rand(n,1); y = x + rand(n,1);
        % % corrcoef(rankdata(x),rankdata(y));
        % % end, toc
        % % tic, for i = 1:100, x = rand(n,1); y = x + rand(n,1);
        % %     n = size(x,1);
        % % D = rankdata(x) - rankdata(y);
        % % 1 - (6*(D'*D)) ./ (n * ((n^2)-1));
        % % end, toc

    case {'taua','kendalla'}

        % checked 1/13/07 against http://www.wessa.net/rwasp_kendall.wasp
        % should probably be checked against SPSS

        [r,i] = sort(x);
        y = y(i);               % get ordered y; don't really need to rank

        % count number of ranks above each successive value of y
        for i = 1:(n - 1)
            P(i) = sum( y(i+1:end) > y(i) );
        end
        est = 4 * sum(P) ./ (n * (n - 1)) - 1;

        if nargout > 1 % for speed
            % actually a z-score
            t = 3 * est * (n * (n - 1)) .^.5 ./ (2 * (2 * n + 5)) .^.5;
            p = 1 - normcdf(abs(t));

            if p == 0, p = 10*eps; end
        end

    case {'tau','kendall','taub','kendallb'}

        % checked 1/13/07 against http://www.wessa.net/rwasp_kendall.wasp
        % should probably be checked against SPSS

        [r,i] = sort(x);
        y = y(i);               % get ordered y

        % count number of ranks above each successive value of y
        for i = 1:(n - 1)
            wh = r > r(i);  % find pts with x value greater than r(i); handle x ties
            P(i) = sum( y(wh) > y(i) ); % concordances
            N(i) = sum( y(wh) < y(i) ); % discordances
        end

        %% *** maybe ties have to include all values that are tied"??
        % http://www.statsdirect.com/help/nonparametric_methods/kend.htm
        xties = get_ties(x);
        yties = get_ties(y);

        num = sum(P) - sum(N);

        n1 = n * (n - 1) ./ 2;

        % From http://www.unesco.org/webworld/idams/advguide/Chapt4_2.htm
        % and http://www.statsdirect.com/help/nonparametric_methods/kend.htm
        den = sqrt(  (n1 - sum(xties)) * (n1 - sum(yties))  );

        % Tau b : from http://www.unesco.org/webworld/idams/advguide/Chapt4_2.htm
        %den = sqrt((sum(P) + sum(N) + (n - sum(xties))) * (sum(P) + sum(N) + (n - sum(yties))));

        est = num ./ den;

        if nargout > 1 % for speed
            % actually a z-score
            t = 3 * est * (n * (n - 1)) .^.5 ./ (2 * (2 * n + 5)) .^.5;
            p = 1 - normcdf(abs(t));
        end

    case {'gamma','kruskal'}

        [r,i] = sort(x);
        y = y(i);               % get ranks of y

        % count number of ranks above each successive value of y
        for i = 1:(n - 1)
            wh = r > r(i);  % find pts with x value greater than r(i); handle x ties
            P(i) = sum( y(wh) > y(i) ); % concordances
            N(i) = sum( y(wh) < y(i) ); % discordances
        end

        num = sum(P) - sum(N);
        den = sum(P) + sum(N);
        est = num ./ den;

    otherwise
        error('Unknown correlation option');
end

return

function tab = make_crosstabs(x,y)
% make table (crosstabs)
u1 = unique(x);
u2 = unique(y);
len1 = length(u1);
len2 = length(u2);
tab = zeros(len1,len2);
w = 1;                  % weights

for i = 1:length(u1)                   % rows are 0 then 1 on the first var, "Nos" then "Yesses"
    for j = 1:length(u2)               % for each column
        tab(i,j) = sum( (x == u1(i) & y == u2(j)) .* w );
    end
end

return

function ties = get_ties(x)
r = rankdata(x, 'nomidrank');
for i = 1:length(unique(r))
    ties(i) = sum(r == i);
end
ties = sum(ties .* (ties - 1) ./ 2);
return

function [rows,cols,npairs] = corrcoef_indices(nvars)

    if nvars > 1000
        fprintf('Setting up indices of matrix.');
        % added to deal with large datasets
        tmp = triu(true(nvars));

        for i = 1:nvars
            tmp(i, i) = 0;
        end

%         % create logical identity matrix of large size
%         t2 = eye(1000);
%         t2 = logical(t2);
%         eyemtx = t2;
%         while size(eyemtx, 2) < nvars
%             eyemtx = blkdiag(eyemtx, t2);
%         end
%         eyemtx = eyemtx(1:nvars, 1:nvars);
%
%         tmp = tmp - eyemtx;

        fprintf(1,'Done.\n');

    else
        % upper triangle only
        tmp = triu(ones(nvars));
        tmp = tmp - eye(nvars);
    end

    [rows,cols] = find(tmp);
    npairs = length(rows);

    return

function valmat = reconstruct(vals,nvars,npairs,rows,cols)

valmat = zeros(nvars);
for i = 1:npairs
    valmat(rows(i),cols(i)) = vals(i);
end
valmat = valmat + valmat';

return

function [pthr,sig] = fdr_correct_pvals(p,r)

    psq = p; psq(find(eye(size(p,1)))) = 0;
    psq = squareform(psq);
    pthr = FDR(p,.05);
    if isempty(pthr), pthr = 0; end

    sig = sign(r) .* (p < pthr);

    return


function EMfc
%This is an implementation of the EM algorithm for Clustering via Gaussian
%mixture models, using graphical on-line representation.

%Panagiotis Braimakis (s6990029)

%load simulated gaussian data.
clear;clc
%for p=1:1000
load data
%load M5    %uncomment only if you want to take results from k-means
            %algorithm

%if i load the M5 matrix then i get as starting values tha ones given via
%the kmeans algorithm, which as he saw detects only spherical clusters
%(which does not always hold)
%So lets give initial random id's to the observations.

  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%OPTIONAL SUB-SAMPLING%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5%%%%%%
 %sample from X
 t=10000;
%  Y=randperm(t);
%  X=X(Y,:);

cidx=unidrnd(5,t,1);
%in order to give a SEED for the Z matrix ,which classifies
%each row of data to it's cluster, we use the results of another clustering method
tic;
Z=zeros(t,5);   %Setting up the storing matrix.
for i=1:t
for j=1:5
if (cidx(i)==j)     %cidx was the (t*1) id-matrix of each record (from 1 to 5)
Z(i,j)=1;           %The new (t*5) Z matrix has only ones, where needed
end %if
end %for
end %for

%Since we have the seed we can now implement the M-step of the algorithm &
%get the loop started between the "Maximization" & "Expectation" steps.

    w=0;    %for the graphs.
    c=2;    %starting counter.
    ll(1)=-88888888;  %starting values just to set the first difference between the log-likelihood's
                %in the first step (remember l(-1) & l(0) does not exist!!!)
    ll(2)=-77777777;
while ll(c)-ll(c-1) > 10^(-10);

    c=c+1;
    g=c-2   %iteration number.
    %all these are the estimates for the parameters of mixture models with
    %normal components.(Geoffrey J. Mclachlan &Kaye E. Basford)

    %nk row matrix is an estimate of the number of "points" on each
    %cluster.
    nk=sum(Z,1);

    %just for the plots

    for i=1:t
max(i)=Z(i,1);
k=1;
for j=2:5
if  (Z(i,j)>max(i))
max(i)=Z(i,j);
P(i,k)=0;
k=j;
else
P(i,j)=0;
end
end
P(i,k)=1;
end

    n=sum(P,1);

        %Now the tk row-matrix estimates each time the probabilities of belonging
    %to the jth cluster (j=1:5)
    tk=nk./t;
    %%Now comes the mean's matrix if we suppose that i element of X belongs to the k-th
    %%cluster (that is done via the Z matrix each time).
    sumclusterX=X'*Z;
    diagnk=diag(nk);
    diag1nk=inv(diagnk);
    mean=sumclusterX*diag1nk;

    %Next one is the estimated intra-cluster VAriance-COvariance MAtrix of
    %the data.

 covma=cell(5,1);

    for j=1:5

    Q1=X-ones(t,1)*mean(:,j)';  %x's-means
    Q2=Q1';
A=cell(t,1);
    for i=1:t
        A(i)={Q1(i,:)};
    end
B=cell(t,1);
    for i=1:t
        B(i)={Q2(:,i)};
    end
        T=[Z(:,j) Z(:,j)];

C=cell(1,1);
    for e=1:t
       C{e}=(T(e,:)'.*B{e})*A{e};
    end

    nom=[0 0;0 0];
    for k = 1:length(C)
    nom=C{k}+nom;
    end %for

    covma{j}=nom./nk(j);
    end %for

  %PLOTS the 95% confidence ellipses & the (X,Y) pairs of each cluster in each iteration.

%   w=w+1;
%   subplot(2,2,w);
%   hold on,
%
%
  plot(X(:,1),X(:,2),'m.');
  confreg(mean(:,1),covma{1},n(1),0.05);
  confreg(mean(:,2),covma{2},n(2),0.05);
  confreg(mean(:,3),covma{3},n(3),0.05);
  confreg(mean(:,4),covma{4},n(4),0.05);
  confreg(mean(:,5),covma{5},n(5),0.05);
  axis equal;
  zoom out;
  xlabel(g);
  title('Progress Graph');
  ylabel('Data vs Clusters');
  grid on;
  hold off
pause(0.1);

  if w==4    %tests' whether your initial graph counter is 4 in order to reset him and subplot to
    w=0;    %the correct position.
  else
    w=w;
  end %if

   %f(xi|theta-hat) matrix (n*k) -which is for every xi and every
    %mean,var-cov matrix.

 for k=1:5
     for i=1:t
 Q11=X(i,:)-mean(:,k)';  %xi-mean
 Q22=Q11';
   f(i,k)=(((2*pi)^-1)*(det(covma{k}))^(-1/2))*exp(-(1/2)*(Q11*(covma{k}^-1))*Q22);
 %The l(i,k) matrix is only computed in these two for's in order to avoid extra aggravation
 %of our program.

 l(i,k)=tk(k)*f(i,k);

    end %for
 end %for

%the log-likelihood of our data given the iteration c is equal to:
ll(c)=sum(log(sum(l,2)));

%  E-step (posterior expected value)

for i=1:t
    for k=1:5

        Z(i,k)=(tk(k)*f(i,k))/sum(tk'.*f(i,:)');
    end
end
save sampleresults1 Z mean covma n P ll ;

 end %while

% disp('Time to Find Clusters: ');
% Q(p)=toc
% LL{p}=ll;
% MEANS{p}=mean;
% COVS{p}=covma;
% save MEANS&COVS100 MEANS COVS Q LL;
% p
%end %for p
disp('Have a nice morning')


function asa063_test01 ( )

%*****************************************************************************80
%
%% ASA063_TEST01 demonstrates the use of BETAIN.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    23 January 2008
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'ASA063_TEST01:\n' );
  fprintf ( 1, '  BETAIN computes the incomplete beta function.\n' );
  fprintf ( 1, '  Compare to tabulated values.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '      A       B       X       ' );
  fprintf ( 1, 'FX                       FX2\n' );
  fprintf ( 1, '                              ' );
  fprintf ( 1, '(Tabulated)              (BETAIN)                DIFF\n' );
  fprintf ( 1, '\n' );

  n_data = 0;

  while ( 1 )

    [ n_data, a, b, x, fx ] = beta_inc_values ( n_data );

    if ( n_data == 0 )
      break
    end

    beta_log = gammaln ( a ) ...
             + gammaln ( b ) ...
             - gammaln ( a + b );

    [ fx2, ifault ] = betain ( x, a, b, beta_log );

    fprintf ( 1, '  %6.2f  %6.2f  %6.2f  %24.16e  %24.16e  %10.4e\n', ...
    a, b, x, fx, fx2, abs ( fx - fx2 ) );

  end

  return
end


function y = daxpy ( n, sa, x, incx, y, incy )

%*****************************************************************************80
%
%% DAXPY adds a constant times one vector to another.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 April 2009
%
%  Author:
%
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
%    LINPACK User's Guide,
%    SIAM, (Society for Industrial and Applied Mathematics),
%    3600 University City Science Center,
%    Philadelphia, PA, 19104-2688.
%    ISBN 0-89871-172-X
%
%    Charles Lawson, Richard Hanson, David Kincaid, Fred Krogh,
%    Basic Linear Algebra Subprograms for Fortran Usage,
%    Algorithm 539,
%    ACM Transactions on Mathematical Software,
%    Volume 5, Number 3, September 1979, pages 308-323.
%
%  Parameters:
%
%    Input, integer N, the number of entries in the vector.
%
%    Input, real SA, the multiplier.
%
%    Input, real X(*), the vector to be scaled and added to Y.
%
%    Input, integer INCX, the increment between successive entries of X.
%
%    Input/output, real Y(*), the vector to which a
%    multiple of X is to be added.
%
%    Input, integer INCY, the increment between successive entries of Y.
%
  y(1:incy:1+(n-1)*incy) = y(1:incy:1+(n-1)*incy) + sa * x(1:incx:1+(n-1)*incx);

  return
end


% interpmethod is either 'linear' or 'spline'
function [z,Hu] = htls(k,y,interpmethod)
% "Algorithm for time-domain NMR data fitting based on total least squares"
% Vanhuffel, S., Chen, H., Decanniere, C. and Vanhecke, P., (1994)
if nargin < 3; interpmethod = 'linear'; end

y = complete_signal(y,interpmethod);
n = length(y);
y = reshape(y,[n,1]);
l = ceil(n/2);
Hy = hankel(y(1:l),y(l:n));
[U,~,~] = svd(Hy,'econ');
Ur = U(:,1:k);
Ur1 = Ur(2:end,:);
Ur2 = Ur(1:end-1,:);
[~,~,V] = svd([Ur2 Ur1]);
I = 1:k;
V12 = V(I,k+I);
V22 = V(k+I,k+I);
Q = -V12/V22;
e = eig(Q);
A = (e.^(0:n-1)).';
c = A \ y;
u = A*c;
Hu = hankel(u(1:k+1),u(k+1:n));
[U,~,~] = svd(Hu,'econ');
z = U(:,end);

function y = complete_signal(y,interpmethod)
I = isnan(y);
if ~any(I); return; end
t = 1:length(y);
y(I) = interp1(t(~I),y(~I),t(I),interpmethod);


% This is material illustrating the methods from the book
% Financial Modelling  - Theory, Implementation and Practice with Matlab
% source
% Wiley Finance Series
% ISBN 978-0-470-74489-5
%
% Date: 02.05.2012
%
% Authors:  Joerg Kienitz
%           Daniel Wetterau
%
% Please send comments, suggestions, bugs, code etc. to
% kienitzwetterau_FinModelling@gmx.de
%
% (C) Joerg Kienitz, Daniel Wetterau
%
% Since this piece of code is distributed via the mathworks file-exchange
% it is covered by the BSD license
%
% This code is being provided solely for information and general
% illustrative purposes. The authors will not be responsible for the
% consequences of reliance upon using the code or for numbers produced
% from using the code.

function pathS = MC_NIGGOU(S0,r,d,T,alpha,beta,delta,lambda,a,b,NTime,NSim,NBatches)
% discretization of Normal Inverse Gaussian process with
% Gamma Ornstein-Uhlenbeck clock

intNt = 10;                 % steps in between orginial grid points
allsteps = intNt * NTime;   % All Nts that have to be simulated
dT = T / NTime;        % Delta for time discretization
time = 0 : dT : T;    % dummy for martingale correction

pathS = zeros(NSim,NTime+1,NBatches); % output
lnS = zeros(NSim,NTime+1);            % used in batch
lnS(:,1) = log(S0*exp(-d*T));         % set S(0) dividend adjusted

% precompute constants
y0 = 1;
psiNIG = (-1i)*(-delta)*(sqrt(alpha^2-(beta+1)^2) ...
    -sqrt(alpha^2-beta^2));                       % char exp
phiGOU = 1i*psiNIG*y0/lambda*(1-exp(-lambda*time)) ...
         + lambda*a./(1i*psiNIG-lambda*b) ...
         .*(b*log(b./(b-1i*psiNIG/lambda ...
         *(1-exp(-lambda*time))))-1i*psiNIG*time);% char func
omegaT = -phiGOU;           % martingale correction
omegaT(1) = 0;              % martingale correction in 0

for l = 1 : NBatches        % batch loop
    yy = ones(NSim,allsteps+1);             % spot clock
    Np = poissrnd(a*lambda/allsteps*T,[NSim,allsteps]);   % Poissonians

    for k = 1 : NSim
        for j = 1 : allsteps                  % generating OU process
            if Np(k,j) > 0
                Ex = -log(rand(Np(k,j),1))/b; % RVs with exponential law
                U = exp(-lambda * T / allsteps * rand(Np(k,j),1));          % Uniforms
                yy(k,j+1) = (1-lambda*T/allsteps)*yy(k,j) + sum(Ex .* U);
         else
                yy(k,j+1) = (1-lambda*T/allsteps)*yy(k,j);
            end
        end
    end

    ZZ = T*cumsum(yy,2)/allsteps;       % integrated Gamma O-U process
    Y = zeros(NSim,NTime+1);            % intergrated time
    % compute the integrated time at discretization steps
    for m=2:NTime+1
        Y(:,m) = ZZ(:,(m-1)*intNt);
    end

    for m=2:NTime+1     % time loop
        a_par = Y(:,m)-Y(:,m-1);             % IG param
        b_par = delta*sqrt(alpha^2-beta^2);  % IG param
        theta = a_par/b_par;
        chi = a_par.^2;
        %Yvec = ones(NSim,1);
        %for n = 1:NSim
        %    Yvec(n) = randraw('ig', [theta(n), chi(n)], 1 );
        %end
        chisq1 = randn(NSim,1).^2;
        Yvec = theta + 0.5*theta./chi .* ( theta.*chisq1 - ...
            sqrt(4*theta.*chi.*chisq1 + theta.^2.*chisq1.^2) );
        Ind = find(rand(NSim,1) >= theta./(theta+Yvec));
        Yvec(Ind) = theta(Ind).^2./Yvec(Ind);   % subordinator

        Zvec = randn(NSim,1);       % Gaussian
        lnS(:,m) = lnS(:,m-1) + (r-d)*dT + omegaT(m)-omegaT(m-1) ...
                     + beta*delta^2*Yvec + delta*sqrt(Yvec).*Zvec;
    end
    pathS(:,:,l) = exp(lnS);   % spot paths
end


function varargout = mcint(h, n, opt)

%MCINT Monte Carlo integrator for multiple functions
%
% Satisfy your wildest integration fantasies!
%
%
%
% written by Lee Ferchoff, 2006
% Do not modify this file in any way unless for your own personal
% use. Do not re-release any part of the code contained in this file.
% Do not attach your own name to any part of the code contained in this
% file. Please reference me and e-mail to inform me if you use any part
% of this code, or original ideas from the algorithm. Thanks! Hope you find
% it helpful.
% E-mail: umferch1 at cc DOT umanitoba DOT ca
%
%
%
%
% A real-valued integral is calculated in arbitrary n-dimensional
% coordinates by averaging the value of a
% function over a large number of randomly selected points within the
% hypervolume to be integrated. Multiple functions can be integrated
% simultaneously over the same domain. The hypervolume can be of
% arbitrary shape, as long as it can be expressed as a series of
% logical conditions on the coordinates.
%
% Examples of the usage of mcint can be found in learnmcint.m
%
% Throughout, x(i,j) contains the matrix of "darts", or random
% points used to evaluate the function to be integrated.
% The rows i, refer to the ith coordinate of a
% point, where each column j, is a separate point. In standard
% notation, the coordinate vectors of all points 'n' are given by:
%
%       1-coordinate vector is     x(1,:)
%       2-coordinate vector is     x(2,:)
%       3-coordinate vector is     x(3,:)
%       ...
%       mth-coordinate is   x(m,:)
%
% In Cartesian coordinates, you might define the 1-dimension to be x,
% the 2-dimension to be y, or if you are using spherical coordinates,
% you could define the 1-dimension to be r, the 2-dimension to be
% theta, and the 3-dimension to be phi.
%
% This is the format that must be used when passing functions
% of coordinates to mcint. Operations on these coordinates must
% be written as vector operations (i.e. .* and .^, not * and ^).
%
% To integrate in a non-Cartesian coordinate system, in your
% function definition, multiply by the Jacobian from
% the Cartesian to 'system' transformation, for whatever coordinate
% system you are using. Jacobians for common coordinate systems
% can be obtained from jacobian.m. For example, to integrate
% f(r,theta,phi) in spherical coordinates, on paper you would write
%
%   triple integral ( f(r,theta,phi) * r^2 * sin(theta) dr d(theta) d(phi) )
%
% So the integrand should be defined as:
%
%   "f(x)" .* x(1,:).^2 + sin(x(2,:))
%       or making use of jacobian.m;
%   "f(x)" .* jacobian(x,'spherical')
%
% You can write your own Jacobian in, if you choose not to call jacobian.m.
% This flexibility allows you to mix coordinate systems. For example, you
% can do a 6-dimensional integral where three of the dimensions are in
% spherical coordinates and the other three are in elliptical. Furthermore,
% you can choose whatever order you want for the coordinate
% defintions, as long as you write the Jacobian accordingly. For example,
% x(1,:) could be theta, x(2,:) r, x(3,:) the angular variable in the
% elliptic coordinates, and so on.
%
%
%INPUT
%
% h -- data structure defining a hypervolume integration problem
%
%   h.b(i,j) -- bounding parallepiped of the hypervolume to be
%       integrated.
%       size(b) = [dim 2] where dim is the number of dimensions
%       of the hypervolume. (i,1) is the minimum bounding coordinate
%       in the ith dimension and (i,2) is the maximum bounding coordinate
%       in the ith dimension.
%
%       Example: To integrate x from -1 to 1, and y from 0 to Inf,
%                b(:,1) = [-1; 0]
%                b(:,2) = [1; Inf]
%
%   h.cond{1,j} (OPTIONAL) -- cell array which contains the functions
%       expressing additional logical conditional statements that define
%       a hypervolume within its bounding box. These conditional
%       statements, indexed by j, are functions.
%       h.cond may be empty, if one wishes to integrate
%       over a rectangular parallepiped and doesn't
%       require any further logical conditions on the
%       hypervolume.
%
%       Example: cond = {@outCircle @aboveLine}
%                where the functions are defined as:
%
%                function tf = outcircle(x, par)
%                   tf = x(1,:).^2 + x(2,:).^2 >= 1;
%
%                function tf = aboveLine(x, par)
%                   tf = x(2,:) > x(1,:);
%
%                In this example, our hypervolume of integration
%                is restricted to the region outside of circle of
%                radius 1 at the origin, and to the upper left
%                of the line y=x.
%
%       All h.cond function definitions should take a structure par as
%       their second input, even if no parameters from 'par' are used in
%       the funciton.
%
%   h.funcs{1,j} -- cell array which contains the functions to be
%       integrated. When the jth function is evaluated, it returns
%       the evaluation of the jth integrand. The usual usage is
%       to enter a function that returns an row vector for the integrand
%       f(1,k), where the kth column is the integrand evaluated at the
%       kth dart point. mcint tests the conditions in the order you enter
%       them in the cell array, therefore it is most efficient to list
%       them from most likely to fail to least likely to fail.
%
%       Example: function f = simpleExample(x, par)
%                   f = x(1,:).^2 .* 2*exp(-x(2,:));
%
%       In this case, the integral returned will be a scalar, I(1,1)
%       containing the value of the integral.
%
%       If h.funcs contains several functions, I(1,m) will be the
%       value of the integral for the mth function in h.funs.
%
%       Example: function f = simpleExample(x, par)
%                   f = x(1,:).^2 .* 2*exp(-x(2,:));
%                function f = Id(x)
%                   f = ones( 1, size(x,2));
%
%       In this example, I(1,1) will be the integral of @simpleExample
%       and I(1,2) will be the integral of @Id. Note that @Id is the
%       identity function; to obtain the hypervolume itself, simply
%       integrate this identity function.
%
%       To allow greater flexibility, a function handle may contain
%       more than one function. If h.funcs contains one function handle
%       which returns a function with m rows, then I(m,1) will be
%       the integral for the integrand defined by the mth row returned
%       by the function.
%
%       Example: function f = energy(x, par)
%                   p = calculatePsi(x);
%                   H = getHamiltonian(x);
%                   f(1,:) = conj(p).*H.*p;
%                   f(2,:) = conj(p).*p;
%
%       This example shows you how you might calculate the expectation
%       value of energy for a quantum system. Here we've calculated
%       p (the wavefunction psi) and H (the Hamiltonian) on the random
%       dart matrix (x). Row one of the function will be the
%       evaluation of the integrand for the expectation value of the
%       Hamiltonian, and row two will be the probability density.
%       mcint will give I(1,1) which is the expectation value of the
%       Hamiltonian, and I(2,1) which is the total probability. Then
%       the user can simply find the expectation value of energy as
%       I(1,1)/I(2,1).
%
%       This method of putting multiple integrands in one function
%       handle is preferable when they are calculated with the same
%       ingredients. It would be more time consuming to make a separate
%       function handle for both expectation values calculated above
%       since the wavefunction psi would have to be calculated in
%       BOTH of the function handles with a call to @calculatePsi:
%                   p = calculatePsi(x);
%
%       This inefficiency can thus be avoided. In Quantum Energy Solver
%       (Lee Ferchoff), I use this method to calculate the expectation
%       value of the Hamiltonian, and the identity operator for ALL of
%       the individuals in the population at at once under one function
%       handle.
%
%       NOTE: As of now, if multiple function handles are used, each one
%             must contain the same number of rows. Support will be added
%             for varying numbers of rows in a future version.
%
%       In general, if h.funcs contains j function handles, then mcint
%       returns I, where I(i,j) is the integral of the function in the ith
%       row of the jth function handle.
%
%       All h.funcs function definitions should take a structure 'par' as
%       their second input, even if no parameters from 'par' are used in
%       the funciton.
%
%
% n -- the number of randomly chosen sampling points
%
%
% opt (OPTIONAL) -- integration options
%
%   opt.maxArray -- adjustable max array size parameter. mcint has
%       built-in memory management. This is the largest number
%       of elements that will be stored in memory for
%       use by mcint at any given time.
%
%       NOTE: The default max array size of 1e4 has been tested
%       extensively, this gives the shortest run time for a fixed amount
%       of points. This has been tested for integrals of dimensions 1 and
%       3 and n of 1e5 and 5e6, and it was found that run time increased
%       if the max array size was either increased or decreased from 1e4
%       in all cases.
%       If it is decreased from 1e4, the run time sharply increases. This
%       is because we lose most of the vectorization of the code,
%       since the function evaluations are broken up into vectorized
%       groups of the maximum array size. If the max array size is
%       increased from 1e4, the run time gradually increases by about
%       25% until memory management is not being used and the whole
%       integration is done in one shot. I suppose this is because
%       doing stuff with really large matricies is unwieldy and in
%       this case breaking up a bit of the vectorization at the benefit
%       of using smaller matricies seems to be a good thing.
%
%       1e-4 is optimum for the linux boxes in Room 523.
%       Anything above 1e-3 seems to be handled equally well by
%       hactar.
%   opt.noerror -- if true, statistical errors are not calculated and
%       only the integral value is returned. Note that this mode cannot
%       be used when a tolerance is requested with opt.tol.
%   opt.tol -- TOLERANCE STOPPING CONDITION
%       absolute tolerance requested (integration will stop
%       when reached)
%       opt.tol(i,j) is the absolute tolerance
%         for the ith row of the jth function in h.funcs. If a tolerance
%         is set to zero, then it is taken to mean that no tolerance is
%         requested for that particular integral.
%   opt.time -- TIME STOPPING CONDITION
%       maximum time allowed in seconds. Integration
%       will end normally after this time.
%   opt.warnOff -- if true, turn off printed warnings, such as not meeting a
%       requested tolerance
%   opt.mcintPar -- a struture containing parameters that is passed to the
%       functions in h.funcs, which can be used in function evaluation
%
%OUTPUT
%
% varargout(1) is
% I(i,j,k) -- integral (with optional error)
%     I(i,j,1) -- value of the integral for the integrand defined
%     in the ith row of the jth function handle in h.funcs.
%     I(i,j,2) -- value of the statistical error of the integral
%     for the integrand defined in the ith row of the jth function
%     handle in h.funcs. The error is calculated from random fluctations
%     of the integrand about its mean value.
%
%     Errors are calculated by default, so k=1:2 by default.
%     If user passes opt.noerror=1 to mcint, then no errors are
%     calculated, and so k=1 only.
%
% varargout(2) is
% info (OPTIONAL) -- technical data about the integration. The data
%     can be used for error checking.
%
%     info.maxArray -- maximum array size used
%     info.memoryManaged -- if true, the requested number of points
%         n was large enough, that the integration had to be
%         performed with chunks of size maxArray
%     info.noerror -- if true, no statistical error calculated
%     info.extraParameters -- if true, extra parameters were passed
%         to the functions to be integrated in opt.mcintPar
%
%     info.dim -- number of dimensions
%     info.n -- number of random points requested
%     info.points -- number of random points used
%     info.pointdiff -- info.n-info.points
%
%     info.tolReq(i,j) -- tolerance requested by user. The abs tolerance
%         for the ith row of the jth function in h.funcs. If a tolerance
%         is set to zero, then it is taken to mean that no tolerance is
%         requested for that particular integral. This is what the user
%         entered in opt.tol.
%     info.someTolReq -- if true, at least one integral tolerance has
%         been requested
%     info.tolMet(i,j) -- true in the indicies for integrals which
%         have had their requested tolerance met. (i,j) labels the ith
%         row of the jth function in h.funcs
%         info.tolMet=-1 in the indicies representing integrals for which
%         a specific tolerance was not requested. If no tolerance was
%         required for any integral, info.tolMet is a scalar -1.
%     info.allTolMet -- if true, the requested tolerance for every
%         tolerance was met
%     info.timeReq -- max time requested by the user. info.timeReq=-1
%         if a specific time limit was not requested
%     info.timeMet -- if true, the integration was within the requested
%         time. info.timeMet=-1 if a specific time limit was not
%         requested
%     info.totalTime -- total time required for integration
%
%
%FEATURES TO BE ADDED IN THE NEXT VERSION:
%
% - relative tolerance stopping condition
% - differening amounts of rows in the functions in h.funcs
% - protection against overflow from a chance hit near a singularity
%
%Lee Ferchoff

t0 = clock; % record initial time

if ~isfield(h,'cond')
    h.cond = {};
end

% ===========================
% SET OPTIONS
% ===========================

% --------------------------------------
% mcint is memory managed, and will not
% use an array that has more elements
% than the number maxArray
p.info.maxArray = 1e4; % default max array size
% will be changed if opt.maxArray is a field
% --------------------------------------

% -1 means no request
p.info.tolReq = -1;
p.info.someTolReq = -1;
p.info.tolMet = -1;
p.info.allTolMet = -1;
p.info.timeReq = -1;
p.info.timeMet = -1;

p.info.noerror = 0; % if true, statistical errors are not calculated
p.info.extraParameters = 0; % if true, the user has provided opt.mcintPar

warnOff = 0; % if true, no warnings will be printed to screen
p.par = [];

if nargin==3 % optional parameter structure opt has been provided
    if isfield(opt,'maxArray')
        p.info.maxArray = opt.maxArray;
    end
    if isfield(opt,'noerror')
        p.info.noerror = opt.noerror;
    end
    if isfield(opt,'mcintPar') % user has provided extra parameters
        p.info.extraParameters = 1;
        p.par = opt.mcintPar;
    end
    if isfield(opt,'tol') % user requested tolerances
        p.info.tolReq = abs(opt.tol);
        p.info.someTolReq = 1;
        p.info.tolMet = 0;
        p.info.allTolMet = 0;
    end
    if isfield(opt,'time') % user requested max integration time
        p.info.timeReq = opt.time;
        p.info.timeMet = 0;
    end
    if isfield(opt,'warnOff')
        warnOff = opt.warnOff;
    end
end
% error: can't not calculate error and still request an error tolerance
if p.info.noerror==1 && p.info.someTolReq==1
    if warnOff==0
        disp('WARNING: IF a tolerance is requested, error must be calculated.');
        disp('Integration will continue WITH error calculation.');
    end
    p.info.noerror = 0;
end

% ===========================
% SETUP INTEGRATION PROBLEM
% ===========================

p.dim = size(h.b, 1);
p.nf = length(h.funcs); % # functions
points = n; % running counter that keeps track of how many of the n darts have been thrown

% Transform any improper integral bounds:

% true in rows of b having at least one improper integral limit
p.infBound = sum(isinf(h.b),2) ~= 0;
% perform inverse tangent coordinate transformation on affected rows.
% This will allow us to calculate the improper integral in the old
% coordinate system as a proper integral in the new coordinate system.
h.b(p.infBound,:) = atan(h.b(p.infBound,:));
% p.infDims isthe numbers of the dimensions with improper limits
p.infDims = find(p.infBound==1);
p.improperProblem = ~isempty(p.infDims);  % if true, at least one infinite dim
V = prod(h.b(:,2) - h.b(:,1)); % bounding volume (after transformation)

% ===========================
% INTEGRATE
% ===========================

if p.dim*n <= p.info.maxArray

    p.info.memoryManaged = 0;

    p.cols = n;
    p.xMin=repmat(h.b(:,1),1,p.cols);
    p.xMax=repmat(h.b(:,2),1,p.cols);
    s = updateSums(h,p);

else % memory management needed

    p.info.memoryManaged = 1;

    p.cols = floor(p.info.maxArray/p.dim);
    p.xMin=repmat(h.b(:,1),1,p.cols);
    p.xMax=repmat(h.b(:,2),1,p.cols);

    % # of runs which use the full maxArray size
    fullruns = ceil(p.dim*n/p.info.maxArray)-1;
    for j=1:fullruns
        newS = updateSums(h,p);
        if ~exist('s') % first run through loop; initialize s, s2
            s = zeros(size(newS));
        end
        s = s + newS;
        points = j*p.cols;

        % Check for stopping conditions
        if (p.info.timeReq~=-1 && etime(clock,t0)>p.info.timeReq)
            % executes if max time has elapsed
            p.info.timeMet = 1;
            break;
        elseif p.info.someTolReq==1
            % checks if all tolerances have been met
            E = getError(s,points,V);
            tolMatrix = zeros(size(E));
            tolMatrix(:) = Inf;
            tolMatrix = p.info.tolReq(find(p.info.tolReq~=0));
            p.info.tolMet = E < tolMatrix;
            p.info.allTolMet = prod(+p.info.tolMet(:));
            if p.info.allTolMet==1
                break;
            end
        end
    end

    % if integration wasn't stopped by some condition, finish the leftover
    % points
    if ~(p.info.timeMet==1 || p.info.allTolMet==1)
        % The last update covers the leftover points on the exact
        % number of points the user requested

        p.cols = n - points;
        p.xMin=repmat(h.b(:,1),1,p.cols);
        p.xMax=repmat(h.b(:,2),1,p.cols);

        newS = updateSums(h,p);
        s = s + newS;

        points = points + p.cols;
    end

end

% ===========================
% REPORT RESULT
% ===========================

% return integral and possibly error
I(:,:,1) = V/points * s(:,:,1); % integral
if p.info.noerror==0
    I(:,:,2) = getError(s,points,V); % error
end
varargout(1) = {I};

% some tolerance was requested and wasn't met
if p.info.allTolMet==0 && warnOff==0
    disp('***');
    disp('Max number of requested darts thrown.');
    disp('Requested tolerance was not achieved.');
    disp('***');
end

 % build info structure to pass to user
if nargout==2
    p.info.dim = p.dim;
    p.info.n = n;
    p.info.points = points;
    p.info.pointdiff = n - points;
    p.info.totalTime = etime(clock,t0);

    varargout(2) = {p.info};
end

function E = getError(s,points,V)
%GETERROR Find the current statistical error of the integral
%
%INPUT
%   s -- s(:,:,1) function sums
%     -- s(:,:,2) function squared sums
%   points -- number of points in sum
%   V -- hypervolume
%
%OUTPUT
%
%   E(i,j) -- the current error of the ith row and jth column using the
%             function sums in s

E = V/points * sqrt(s(:,:,2) - s(:,:,1).*s(:,:,1)/points);

function s = updateSums(h, p)

%UPDATESUMS Calculate function sums for mcint
%
%INPUT
%   h -- data structure defining the hypervolume integration problem
%   p -- data structure containing the current parameters of the
%        integration
%
%OUTPUT
%   s(i,j,k)  -- k=1, sum of the functions over all darts
%                k=2, sum of the functions squared over all darts
%                   for the ith row of the jth function handle in h.funcs
%
%   if p.info.noerror=1, then the k=2 matrix is not returned

% p.xMin, p.xMax passed into function rather than being calculated
% in it so that p.xMin, p.xMax only need to be calculated once
% for many memory blocks of size info.maxArray

% ===========================
% GENERATE RANDOM DARTS
% ===========================

% x(i,j) is the ith Cartesian coordinate of the jth random point
x = p.xMin + (p.xMax-p.xMin) .* rand(p.dim,p.cols); % random dart matrix

% ===========================
% COORDINATE TRANSFORMATIONS
% ===========================

% perform coordinate transformations if there is at least one improper
% integral. Transform only the infinite dimensions, since the
% transformation costs time and is not needed for the finite dimensions
if p.improperProblem
    x(p.infDims,:) = tan( x(p.infDims,:) );
end

% remove all points from x which aren't in hypervolume
% by using the extra restrictions given on the hypervolume
for i=1:length(h.cond)
    x = x( :, feval(h.cond{i},x));
end

% we calculate the Jacobian of the arctan transformation AFTER removing
% the points that aren't in the hypervolume so we don't waste time
% calculating the Jacobian for points that aren't in the integration
if p.improperProblem
    jacobian = prod( x(p.infDims,:).^2 + 1, 1 );
end

% ===========================
% INTEGRAND EVALUATION
% ===========================

for i = p.nf: -1: 1
    f = feval(h.funcs{i}, x, p.par);
    if p.improperProblem % multiply by the Jacobian of the arctan transform
        jacobian = repmat(jacobian(1,:), [size(f,1) 1]);
        f = f .* jacobian;
    end
    s(:,i,1) = sum(f,2);
    if p.info.noerror==0
        s(:,i,2) = sum(f.*f,2);
    end
end


function [index, window] = FineMeyerWindow(dyadic_points,deg);
% FineMeyerWindow: Evaluates a highpass Meyer window
%  Usage:
%    [index, window] = FineMeyerWindow(L,deg);
%  Inputs:
%    dyadic-points   Pair of the form 2^j, 2^(j+1)
%    deg    Degree of the polynomial
%  Outputs:
%    index  location of the window on the time axis; contains [2^j 2^(j+1)]
%    window highpass Meyer window

pio2 = pi/2;

eps    = floor(dyadic_points(1)/3);
epsp   = dyadic_points(1) - eps - 1;
farlftind = [ 1 : dyadic_points(1)-eps];
lftind     = [ dyadic_points(1)-eps+1 : dyadic_points(1)];
lmidind    = [ dyadic_points(1)+1 : dyadic_points(1)+eps+1];
rmidind    = [ dyadic_points(2)-epsp+1 : dyadic_points(2) ];

farlft = zeros(1,length(farlftind));
lft  = sin(pio2*WindowMeyer(3*((lftind-1)/dyadic_points(2))-1,deg));
lmid = sin(pio2*WindowMeyer(3*((lmidind-1)/dyadic_points(2))-1,deg));
rmid = ones(1,length(rmidind));

index = [farlftind lftind lmidind rmidind];
window = [farlft lft lmid rmid];


function [p, dp] = pne_pfcn_pseudo_arc_len(x, xp, step, zp)
%PNE_PFCN_PSEUDO_ARC_LEN  Pseudo arc length parameterization function for PNE
%   [P, DP] = PNE_PFCN_PSEUDO_ARC_LEN(X, XP, STEP, ZP)
%
%   Inputs:
%       X    : solution vector x (last element is parameter lambda)
%       XP   : previous solution vector
%       STEP : continuation parameter step size
%       ZP   : normalized tangent vector at XP
%
%   This function defines a pseudo arc length parameterization for a PNE,
%   where the current point on the solution curve is constrained to lie in
%   the hyperplane running through the predicted solution orthogonal to the
%   tangent line from the previous corrected solution.
%
%   Outputs:
%       P : value of parameterization function
%       DP : Jacobian of paramerization function (transpose of gradient)
%
%   See also PNE_PFCN_NATURAL, PNE_PFCN_ARC_LEN.

%   MP-Opt-Model
%   Copyright (c) 2013-2021, Power Systems Engineering Research Center (PSERC)
%   by Ray Zimmerman, PSERC Cornell
%   and Shrirang Abhyankar, Argonne National Laboratory
%
%   This file is part of MP-Opt-Model.
%   Covered by the 3-clause BSD License (see LICENSE file for details).
%   See https://github.com/MATPOWER/mp-opt-model for more info.

dp = zp';                   %% derivative
p = dp * (x - xp) - step;   %% function


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

%*****************************************************************************80
%
%% JED_TO_YMDF_SYRIAN converts a JED to a Syrian YMDF date.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 July 2012
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Edward Richards,
%    Algorithm F,
%    Mapping Time, The Calendar and Its History,
%    Oxford, 1999, pages 324-325.
%
%  Parameters:
%
%    Input, real JED, the Julian Ephemeris Date.
%
%    Output, integer Y, M, D, real F,
%    the YMDF date.
%

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

  j_prime = j + 1401;

  y_prime = floor ( ( 4 * j_prime + 3 ) / 1461 );
  t_prime = floor ( mod ( 4 * j_prime + 3, 1461 ) / 4 );
  m_prime = floor ( ( 5 * t_prime + 2 ) / 153 );
  d_prime = floor ( mod ( 5 * t_prime + 2, 153 ) / 5 );
%
%  Convert the computational date to a calendar date.
%
  d = d_prime + 1;
  m = mod ( m_prime + 5, 12 ) + 1;
  y = y_prime - 4405 + floor ( ( 17 - m ) / 12 );

  return
end


function [kappa,pval,k, pk]=kappa_stats(D,ncat)
% calculate Kappa statisc for agreement
% D: matrix NxM of N scores by M raters
% cat: categories
% Written By Issam El Naqa Date: 03/21/07
% ref.: SAS docs. (Fleiss '81)
%
% Copyright 2010, Joseph O. Deasy, on behalf of the CERR development team.
%
% This file is part of The Computational Environment for Radiotherapy Research (CERR).
%
% CERR development has been led by:  Aditya Apte, Divya Khullar, James Alaly, and Joseph O. Deasy.
%
% CERR has been financially supported by the US National Institutes of Health under multiple grants.
%
% CERR is distributed under the terms of the Lesser GNU Public License.
%
%     This version of CERR 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.
%
% CERR 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 CERR.  If not, see <http://www.gnu.org/licenses/>.

[N,M]=size(D);
lk=length(ncat); % number of categories
for i=1:lk
    x(:,i) = sum(D==ncat(i),2);
end
p=sum(x)/(N*M);
k=1-sum(x.*(M-x))./((N*M*(M-1).*p.*(1-p))+eps);
sek=sqrt(2/(N*M*(M-1)));
pk=drxlr_get_p_gaussian(k./sek)/2; % one-sided
% kappa=sum(p.*(1-p).*k)/sum(p.*(1-p));
kappa=1-(N*M^2-sum(sum(x.^2)))/((N*M*(M-1)*sum(p.*(1-p)))+eps);
sekappa=sqrt(2)/(sum(p.*(1-p)*sqrt(N*M*(M-1)))+eps)*sqrt(sum(p.*(1-p))^2-sum(p.*(1-p).*(1-2*p)));
z=kappa/sekappa;
pval=drxlr_get_p_gaussian(z)/2; % one-sided
return

function p=drxlr_get_p_gaussian(x)
% two tailed p-value from a normal distribution
%DREX subfunction
%Written by Issam El Naqa 2003-2005
%Extracted for generalized use 2005, AJH

    p = erfc(abs(x)./sqrt(2));

return


function r8mat_det_5d_test ( )

%*****************************************************************************80
%
%% R8MAT_DET_5D_TEST tests R8MAT_DET_5D;
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 April 2009
%
%  Author:
%
%    John Burkardt
%
  n = 5;

  x = [ 1.0, 10.0, 4.0, 2.0, 3.0 ];

  fprintf ( 1, '\n' );
  fprintf ( 1, 'R8MAT_DET_5D_TEST\n' );
  fprintf ( 1, '  R8MAT_DET_5D: determinant of 5 by 5 matrix.\n' );

  a = r8mat_vand2 ( n, x );
  det = r8mat_det_5d ( a );

  r8mat_print ( n, n, a, '  Matrix:' );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  R8MAT_DET_5D computes determinant: %f\n', det );
%
%  Special formula for the determinant of a Vandermonde matrix:
%
  det = 1.0;
  for i = 1 : n
    for j = 1 : i-1
      det = det * ( x(i) - x(j) );
    end
  end

  fprintf ( 1, '  Exact determinant is %f\n', det );

  return
end


function M = getmassmatvec(elem2edge,area,Dlambda,elemType,K)
%% GETMASSMATVEC Get the mass matrix of vector finite element space
%
% M = GETMASSMATVEC(elem2edge,area,Dlambda,elemType,K) get mass matrix of the finite element
% space specified by elemType.
%
% The elemType can be:
%
% - "RT0": The lowest order Raviart-Thomas element
% - "BDM1": The lowest order Brezzi-Douglas-Michel element
% - "BDM1B": The BDM element enriched by the curl of cubic bubble function
% - "ND1': The lowest order Nedelec element
%
% Note that RT0 and ND1 share the same mass matrix.
%
% Created by Ming Wang at July, 2012. Improved by Long Chen.

if ~exist('K','var'), K = []; end
NE = double(max(elem2edge(:)));
NT = size(elem2edge,1);
DiDj = zeros(NT,3,3);
for i = 1:3
    for j = i:3
        DiDj(:,i,j) = dot(Dlambda(:,:,i),Dlambda(:,:,j),2);
        DiDj(:,j,i) = DiDj(:,i,j);
    end
end

localEdge = [2 3; 1 3; 1 2];
%% RT0
if strcmp(elemType,'RT0') || strcmp(elemType,'ND1')
    M = sparse(NE,NE);
    for i = 1:3
        for j = i:3
            % local to global index map and its sign
            ii = double(elem2edge(:,i));
            jj = double(elem2edge(:,j));
            i1 = localEdge(i,1); i2 = localEdge(i,2); % [i1,i2] is the edge opposite to vertex i.
            j1 = localEdge(j,1); j2 = localEdge(j,2);
            % computation of mass matrix --- (phi_i, phi_j)
            Mij = 1/12*area.*( (1+(i1==j1))*DiDj(:,i2,j2) ...
                             - (1+(i1==j2))*DiDj(:,i2,j1) ...
                             - (1+(i2==j1))*DiDj(:,i1,j2) ...
                             + (1+(i2==j2))*DiDj(:,i1,j1));
            if ~isempty(K)
                Mij = Mij./K;
            end
            if (j==i)
                M = M + sparse(ii,jj,Mij,NE,NE);
            else
                M = M + sparse([ii;jj],[jj;ii],[Mij; Mij],NE,NE);
            end
        end
    end
end
%% BDM1
if strcmp(elemType,'BDM1') || strcmp(elemType,'BDM1B')
    M = sparse(2*NE,2*NE);
    for i = 1:3
        for j = i:3
            % local to global index map and its sign
            ii = double(elem2edge(:,i));
            jj = double(elem2edge(:,j));
            i1 = localEdge(i,1); i2 = localEdge(i,2); % [i1,i2] is the edge opposite to vertex i.
            j1 = localEdge(j,1); j2 = localEdge(j,2);
            % computation of mass matrix, note that (rot u, rot v) = (grad u, grad v)
            % (phi_i, phi_j)
            Mij = 1/12*area.*( (1+(i1==j1))*DiDj(:,i2,j2) ...
                             - (1+(i1==j2))*DiDj(:,i2,j1) ...
                             - (1+(i2==j1))*DiDj(:,i1,j2) ...
                             + (1+(i2==j2))*DiDj(:,i1,j1));
            if ~isempty(K)
                Mij = Mij./K;
            end
            if (j==i)
                M = M + sparse(ii,jj,Mij,2*NE,2*NE);
            else
                M = M + sparse([ii;jj],[jj;ii],[Mij; Mij],2*NE,2*NE);
            end
            % (psi_i,psi_j)
            Mij = 1/12*area.*( (1+(i1==j1))*DiDj(:,i2,j2) ...
                             + (1+(i1==j2))*DiDj(:,i2,j1) ...
                             + (1+(i2==j1))*DiDj(:,i1,j2) ...
                             + (1+(i2==j2))*DiDj(:,i1,j1));
            if ~isempty(K)
                Mij = Mij./K;
            end
            if (j==i)
                M = M + sparse(ii+NE,jj+NE,Mij,2*NE,2*NE);
            else
                M = M + sparse([ii;jj]+NE,[jj;ii]+NE,[Mij; Mij],2*NE,2*NE);
            end
        end
    end
    for i = 1:3
        for j = 1:3
            % local to global index map and its sign
            ii = double(elem2edge(:,i));
            jj = double(elem2edge(:,j));
            i1 = localEdge(i,1); i2 = localEdge(i,2);
            j1 = localEdge(j,1); j2 = localEdge(j,2);
            % (psi_i,phi_j)
            Mij = 1/12*area.*( (1+(i1==j1))*DiDj(:,i2,j2) ...
                             - (1+(i1==j2))*DiDj(:,i2,j1) ...
                             + (1+(i2==j1))*DiDj(:,i1,j2) ...
                             - (1+(i2==j2))*DiDj(:,i1,j1));
            if ~isempty(K)
                Mij = Mij./K;
            end
            M = M + sparse([ii+NE;jj],[jj;ii+NE],[Mij; Mij],2*NE,2*NE);
        end
    end
end
%% BDM1B
if strcmp(elemType,'BDM1B')
    newM = sparse(2*NE+NT,2*NE+NT);
    newM(1:2*NE,1:2*NE) = M;
    M = newM;
    % (phi_i, bubble)
    for i = 1:3
        ii = double(elem2edge(:,i));
        jj = double((1:NT)');
        i1 = localEdge(i,1); i2 = localEdge(i,2); i3 = 6-i1-i2;
        Mij = 9/10*area.*(...
             dot(Dlambda(:,:,i2),Dlambda(:,:,i3),2)...
            +dot(Dlambda(:,:,i2),Dlambda(:,:,i2),2)...
            -dot(Dlambda(:,:,i1),Dlambda(:,:,i3),2)...
            -dot(Dlambda(:,:,i1),Dlambda(:,:,i1),2));
        if ~isempty(K)
            Mij = Mij./K;
        end
        M = M + sparse([ii;jj+2*NE],[jj+2*NE;ii],[Mij;Mij],2*NE+NT,2*NE+NT);
    end
    clear ii jj i1 i2 i3 Mij;
    % (psi_i, bubble)
    for i = 1:3
        ii = double(elem2edge(:,i));
        jj = double((1:NT)');
        i1 = localEdge(i,1); i2 = localEdge(i,2); i3 = 6-i1-i2;
        Mij = 9/10*area.*(...
             dot(Dlambda(:,:,i2),Dlambda(:,:,i3),2)...
            +dot(Dlambda(:,:,i1),Dlambda(:,:,i3),2)...
            +dot(Dlambda(:,:,i2),Dlambda(:,:,i2),2)...
            +dot(Dlambda(:,:,i1),Dlambda(:,:,i1),2)...
            +dot(Dlambda(:,:,i1),Dlambda(:,:,i2),2));
        if ~isempty(K)
            Mij = Mij./K;
        end
        M = M + sparse([ii+NE;jj+2*NE],[jj+2*NE;ii+NE],[Mij;Mij],2*NE+NT,2*NE+NT);
    end
    clear ii jj i1 i2 i3 Mij;
    % (bubble, bubble)
    ii = 1+2*NE:NT+2*NE;
    Mij = 81/10*area.*(...
          dot(Dlambda(:,:,1),Dlambda(:,:,1),2)...
         +dot(Dlambda(:,:,1),Dlambda(:,:,2),2)...
         +dot(Dlambda(:,:,1),Dlambda(:,:,3),2)...
         +dot(Dlambda(:,:,2),Dlambda(:,:,2),2)...
         +dot(Dlambda(:,:,2),Dlambda(:,:,3),2)...
         +dot(Dlambda(:,:,3),Dlambda(:,:,3),2));
    if ~isempty(K)
        Mij = Mij./K;
    end
    M = M + sparse(ii,ii,Mij,2*NE+NT,2*NE+NT);
end


%RELMTEST
%script to test two earthqauake rate hypotheses using earthquake data
%
region='Northern California Aftershock model';
nsim=100;
mt=2;
 park1=vRatesH;
 park2=vRatesN;
%load H1;
%load H2;
%park1=H1; %Hypothesis with variable b-values
%park2=H2; %Null hypothesis, uniform b-value
clear test null;
%     xmin(i)=park1(j,1);
%     xmax(i)=park1(j,2);
%     ymin(i)=park1(j,3);
%     ymax(i)=park1(j,4);
%     zmin(i)=park1(j,5);
%     zmax(i)=park1(j,6);
%     magmin(i)=park1(j,7);
%     magmax(i)=park1(j,8);
%     lamda1(i)=park1(j,9);
%     weight(i)=park1(j,10);
nquake=park1(:,11);
[m,n] = size(park1);
magmin=park1(:,7);
lamda1=park1(:,9);
lamda2=park2(:,9);
weight1=park1(:,10);
weight2=park2(:,10);
weight=weight1.*weight2.*(magmin>mt);
%
% Remove rows of matrix for which weight is zero
%
j=0;
for i = 1:m
    if weight(i)>0
        j=j+1;
        w(j)=weight(i);
        nq(j)=nquake(i);
        lam1(j)=lamda1(i);
        lam2(j)=lamda2(i);
        mmin(j)=magmin(i);
    end
end
nq=w.*nq;
Nquake=sum(nq);
lam1=w.*lam1;
lam2=w.*lam2;
clear park1 park2 lamda1 lamda2 nquake magmin weight weight1 weight2;
%
%make a weighted magnitude-frequency plot
%
mf=[mmin;nq;lam1;lam2]';
mfsort=sortrows(mf);
mag=mfsort(:,1);

Fobs=flip(cumsum(flip(mfsort(:,2))));
Fth1=flip(cumsum(flip(mfsort(:,3))));
Fth2=flip(cumsum(flip(mfsort(:,4))));
figure%(1)
semilogy(mag,Fobs,'r',mag,Fth1,'g',mag,Fth2,'b');
grid;
axis([3,8,.0001,100]);

%
%    Evaluate whether total number of quakes is consistent with H1
%
%
Nhat=sum(lam1)
peq=poisspdf(Nquake, Nhat); % probability of exactly Nquake
Ple=poisscdf(Nquake, Nhat); % probability of less than or equal to Nquake
Pless=Ple-peq;              % probability of less than Nquake
Pmore=1-Ple                 % probability of more than Nquake
P1_equal=peq;
P1_less=Pless;
P1_more=Pmore;
Nhat1=Nhat;
lamcum1=cumsum(lam1)/Nhat1;

%   Evaluate whether total number of quakes is consistent with H2

Nhat=sum(lam2)
peq=poisspdf(Nquake, Nhat); % probability of exactly Nquake
Ple=poisscdf(Nquake, Nhat); % probability of less than or equal to Nquake
Pless=Ple-peq;              % probability of less than Nquake
Pmore=1-Ple                 % probability of more than Nquake
P2_equal=peq;
P2_less=Pless;
P2_more=Pmore;
Nhat2=Nhat;
lamcum2=cumsum(lam2)/Nhat2;
%
%   simulate catalogs according to H1,
%   and evaluate likelihood scores of nsquake1 and real catalog using lamda1 and lamda2
%
nsquake=simulate(Nquake,lam1, nsim);
[LLR1, rank11,rank12] = Rtest(lam1, lam2, nq, nsquake, w);
%
%   simulate catalogs according to H2,
%   and evaluate likelihood scores of nsquake1 and real catalog using lamda1 and lamda2
%
nsquake=simulate(Nquake,lam2, nsim);
[LLR2, rank21,rank22] = Rtest(lam1, lam2, nq, nsquake, w);
%
%Plot cumulative likelihood scores for two hypotheses
%
alpha = sum(LLR2>0)/nsim
beta = sum(LLR1<0)/nsim
index=[1:nsim]/nsim;
x=[0,0];y=[0,1];
figure_w_normalized_uicontrolunits(2);
plot(LLR1,index,'g',LLR2,index,'r',x,y,'b')';
xlabel('Likelihood ratio (Variable b/Constant b)')';
ylabel('Fraction of cases');
title('Green assumes variable-b hypothesis; Red assumes constant=b hypothesis');

region, mt,Nquake, Nhat1,Nhat2,P1_less,P1_more,P2_less,P2_more, alpha, beta, rank11,rank12, rank21, rank22
%[rank1,rank2]
%[Nhat1,Nhat2]
%[P1_less, P2_less]
%[P1_more, P2_more]


function CM = Tpm_CM(P,X)
% TPM_CM  Chenoweth-Martin two-phase multiplier
% TPM_CM(P,X) Returns the Chenoweth-Martin two-phase
% multipier for a steam-water system
%  Called function: h2o_rhof(P), h2o_rhog(P)
%  Required Inputs are: P - pressure (kPa), X - quality (fraction)
% ---------------------------------------------------------------
% The MATLAB function was created by Tibor Balint, December 1998
% TBoreal Research Corporation, Toronto, Ont. Canada
% (tibor@netcom.ca) and also, University of Warwick, UK
% ---------------------------------------------------------------

format long g;  % set the format of the calculations

if X<=0
   CM=1;
else
   RF=h2o_rhof(P);
   RG=h2o_rhog(P);
% Liquid Volume Fraction
   LVF=1-(X*RF/(X*RF+(1-X)*RG));
%The two-phase multiplier is
   CM=LVF^(-0.8642);
end

return


function I2 = lensdistort(I, k, varargin)
%LENSDISTORT corrects for barrel and pincusion lens abberations
%   I = LENSDISTORT(I, k)corrects for radially symmetric distortions, where
%   I is the input image and k is the distortion parameter. lens distortion
%   can be one of two types: barrel distortion and pincushion distortion.
%   In "barrel distortion", image magnification decreases with
%   distance from the optical axis. The apparent effect is that of an image
%   which has been mapped around a sphere (or barrel). In "pincushion
%   distortion", image magnification increases with the distance from the
%   optical axis. The visible effect is that lines that do not go through the
%   centre of the image are bowed inwards, towards the centre of the image,
%   like a pincushion [1].
%
%   I = LENSDISTORT(...,PARAM1,VAL1,PARAM2,VAL2,...) creates a new image image,
%   specifying parameters and corresponding values that control various aspects
%   of the image distortion correction. Parameter names case does not matter.
%
%   Parameters include:
%
%   'bordertype'            String that controls the treatment of the image
%                           edges. Valid strings are 'fit' and 'crop'. By
%                           default, 'bordertype' is set to 'crop'.
%
%   'interpolation'         String that specifies the interpolating kernel
%                           that the separable resampler uses. Valid
%                           strings are 'cubic', 'linear' and 'nearest'. By
%                           default, the 'interpolation' is set to 'cubic'
%
%   'padmethod'             string that controls how the resampler
%                           interpolates or assigns values to output elements
%                           that map close to or outside the edge of the input
%                           array. Valid strings are 'bound', circular',
%                           'fill', 'replicate', and symmetric'. By
%                           default, the 'padmethod' is set to 'fill'
%
%   'ftype'                 Integer between 1 and 4 that specifies the
%                           distortion model to be used. The models
%                           available are
%
%                           'ftype' = 1:    s = r.*(1./(1+k.*r));
%
%                           'ftype' = 2:    s = r.*(1./(1+k.*(r.^2)));
%
%                           'ftype' = 3:    s = r.*(1+k.*r);
%
%                           'ftype' = 4:    s = r.*(1+k.*(r.^2));
%
%                           By default, the 'ftype' is set to 4.
%
%   Class Support
%   -------------
%   An input intensity image can be uint8, int8, uint16, int16, uint32,
%   int32, single, double, or logical. An input indexed image can be uint8,
%   uint16, single, double, or logical.
%
%   Examples
%   --------
%       % read image
%       I = imread('cameraman.tif');
%
%       % Distort Image
%       I2 = lensdistort(I, 0.1);
%
%       % Display both images
%       imshow(I), figure, imshow(I2)
%
%   References
%   --------------
%   [1] http://en.wikipedia.org/wiki/Distortion_(optics), August 2012.
%
%   [2] Harri Ojanen, "Automatic Correction of Lens Distortion by Using
%       Digital Image Processing," July 10, 1999.
%
%   [3] G.Vassy and T.Perlaki, "Applying and removing lens distortion in post
%       production," year???
%
%   [4] http://www.mathworks.com/products/demos/image/...
%       create_gallery/tform.html#34594, August 2012.
%
%   Created by Jaap de Vries, 8/31/2012
%   jpdvrs@yahoo.com
%
%-----------------------------------------------------------------------%

%-------------------------------------------------------------------------
% This part of the codes creates variable input parameters using the input
% parser object
p = inputParser;
%   Make input string case independant
p.CaseSensitive = false;

%   Specifies the required inputs
addRequired(p,'I',@isnumeric);
addRequired(p,'k',@isnumeric);

%   Sets the default values for the optional parameters
defaultFtype = 4;
defaultBorder = 'crop';
defaultInterpolation = 'cubic';
defaultPadmethod = 'fill';

%   Specifies valid strings for the optional parameters
validBorder = {'fit','crop'};
validInterpolation = {'cubic','linear', 'nearest'};
validPadmethod = {'bound','circular', 'fill', 'replicate', 'symmetric'};

%   Funtion handles to determine wheter a proper input string has been used
checkBorder = @(x) any(validatestring(x,validBorder));
checkInterpolation = @(x) any(validatestring(x,validInterpolation));
checkPadmethod = @(x) any(validatestring(x,validPadmethod));

%   Create optional inputs
addParamValue(p,'bordertype',defaultBorder,checkBorder);
addParamValue(p,'interpolation',defaultInterpolation,checkInterpolation);
addParamValue(p,'padmethod',defaultPadmethod,checkPadmethod);
addParamValue(p,'ftype',defaultFtype,@isnumeric);

%   Pass all parameters and input to the parse method
parse(p,I,k,varargin{:});

%-------------------------------------------------------------------------
% This determines wether its a color (M,N,3) or gray scale (M,N,1) image
if ndims(I) == 3
     for i=1:3
        I2(:,:,i) = imdistcorrect(I(:,:,i),k);
     end
elseif ismatrix(I)
    I2 = imdistcorrect(I,k);
else
    error('Unknown image dimensions')
end

%-------------------------------------------------------------------------
% Nested function that perfoms the transformation
    function I3 = imdistcorrect(I,k)
    % Determine the size of the image to be distorted
    [M N]=size(I);
    center = [round(N/2) round(M/2)];
    % Creates N x M (#pixels) x-y points
    [xi,yi] = meshgrid(1:N,1:M);
    % Creates converst the mesh into a colum vector of coordiantes relative to
    % the center
    xt = xi(:) - center(1);
    yt = yi(:) - center(2);
    % Converts the x-y coordinates to polar coordinates
    [theta,r] = cart2pol(xt,yt);
    % Calculate the maximum vector (image center to image corner) to be used
    % for normalization
    R = sqrt(center(1)^2 + center(2)^2);
    % Normalize the polar coordinate r to range between 0 and 1
    r = r/R;
    % Aply the r-based transformation
    s = distortfun(r,k,p.Results.ftype);
    % un-normalize s
    s2 = s * R;
    % Find a scaling parameter based on selected border type
    brcor = bordercorrect(r,s,k, center, R);

    s2 = s2 * brcor;

    % Convert back to cartesian coordinates
    [ut,vt] = pol2cart(theta,s2);

    u = reshape(ut,size(xi)) + center(1);
    v = reshape(vt,size(yi)) + center(2);
    tmap_B = cat(3,u,v);
    resamp = makeresampler(p.Results.interpolation, p.Results.padmethod);
    I3 = tformarray(I,[],resamp,[2 1],[1 2],[],tmap_B,255);
    end

%-------------------------------------------------------------------------
% Nested function that creates a scaling parameter based on the
% 'bordertype' selected
    function x = bordercorrect(r,s,k,center, R)
        if k < 0
            if strcmp(p.Results.bordertype, 'fit')
               x = r(1)/s(1);
            end
            if strcmp(p.Results.bordertype,'crop')
               x = 1/(1 + k*(min(center)/R)^2);
            end
        elseif k > 0
            if strcmp(p.Results.bordertype, 'fit')
               x = 1/(1 + k*(min(center)/R)^2);
            end
            if strcmp(p.Results.bordertype, 'crop')
               x = r(1)/s(1);
            end
        end
    end

%-------------------------------------------------------------------------
% Nested function that pics the model type to be used
    function s = distortfun(r,k,fcnum)
        switch fcnum
        case(1)
            s = r.*(1./(1+k.*r));
        case(2)
            s = r.*(1./(1+k.*(r.^2)));
        case(3)
            s = r.*(1+k.*r);
        case(4)
            s = r.*(1+k.*(r.^2));
        end
    end

end


function [ ptab, b, c, d, eps, ierror ] =  least_set ( ntab, xtab, ytab, ndeg )

%% LEAST_SET constructs the least squares polynomial approximation to data.
%
%  Discussion:
%
%    The least squares polynomial is not returned directly as a simple
%    polynomial.  Instead, it is represented in terms of a set of
%    orthogonal polynomials appopriate for the given data.  This makes
%    the computation more accurate, but means that the user can not
%    easily evaluate the computed polynomial.  Instead, the routine
%    LEAST_EVAL should be used to evaluate the least squares polynomial
%    at any point.  (However, the value of the least squares polynomial
%    at each of the data points is returned as part of this computation.)
%
%
%    A discrete unweighted inner product is used, so that
%
%      ( F(X), G(X) ) = sum ( 1 <= I <= NTAB ) F(XTAB(I)) * G(XTAB(I)).
%
%    The least squares polynomial is determined using a set of
%    orthogonal polynomials PHI.  These polynomials can be defined
%    recursively by:
%
%      PHI(0)(X) = 1
%      PHI(1)(X) = X - B(1)
%      PHI(I)(X) = ( X - B(I) ) * PHI(I-1)(X) - D(I) * PHI(I-2)(X)
%
%    The array B(1:NDEG) contains the values
%
%      B(I) = ( X*PHI(I-1), PHI(I-1) ) / ( PHI(I-1), PHI(I-1) )
%
%    The array D(2:NDEG) contains the values
%
%      D(I) = ( PHI(I-1), PHI(I-1) ) / ( PHI(I-2), PHI(I-2) )
%
%    Using this basis, the least squares polynomial can be represented as
%
%      P(X)(I) = sum ( 0 <= I <= NDEG ) C(I) * PHI(I)(X)
%
%    The array C(0:NDEG) contains the values
%
%      C(I) = ( YTAB(I), PHI(I) ) / ( PHI(I), PHI(I) )
%
%  Modified:
%
%    16 May 2004
%
%  Reference:
%
%    Gisela Engeln-Muellges and Frank Uhlig,
%    Numerical Algorithms with C, pages 191-193.
%    Springer, 1996.
%
%  Parameters:
%
%    Input, integer NTAB, the number of data points.
%
%    Input, real XTAB(NTAB), the X data.  The values in XTAB
%    should be distinct, and in increasing order.
%
%    Input, real YTAB(NTAB), the Y data values corresponding
%    to the X data in XTAB.
%
%    Input, integer NDEG, the degree of the polynomial which the
%    program is to use.  NDEG must be at least 1, and less than or
%    equal to NTAB-1.
%
%    Output, real PTAB(NTAB), the value of the least squares polynomial
%    at the points XTAB(1:NTAB).
%
%    Output, real B(1:NDEG), C(1:NDEG+1), D(1:NDEG-1), arrays containing
%    data about the polynomial.
%
%    Output, real EPS, the root-mean-square discrepancy of the
%    polynomial fit.
%
%    Output, integer IERROR, error flag.
%    zero, no error occurred;
%    nonzero, an error occurred, and the polynomial could not be computed.
%
  ierror = 0;
  C_OFFSET = 1;
  D_OFFSET = -1;
%
%  Check NDEG.
%
  if ( ndeg < 1 )
    ierror = 1;
    fprintf ( 1, '\n' );
    fprintf ( 1, 'LEAST_SET - Fatal error!\n' );
    fprintf ( 1, '  NDEG < 1.\n' );
    error ( 'LEAST_SET - Fatal error!' );
  end

  if ( ntab <= ndeg )
    ierror = 1;
    fprintf ( 1, '\n' );
    fprintf ( 1, 'LEAST_SET - Fatal error!\n' );
    fprintf ( 1, '  NTAB <= NDEG.\n' );
    error ( 'LEAST_SET - Fatal error!' );
  end
%
%  Check that the abscissas are strictly increasing.
%
  for ( i = 1 : ntab-1 )
    if ( xtab(i+1) <= xtab(i) )
      ierror = 1;
      fprintf ( 1, '\n' );
      fprintf ( 1, 'LEAST_SET - Fatal error!\n' );
      fprintf ( 1, '  XTAB must be strictly increasing, but\n' );
      fprintf ( 1, '  XTAB(%d) = %f\n', i,   xtab(i)   );
      fprintf ( 1, '  XTAB(%d) = %f\n', i+1, xtab(i+1) );
      error ( 'LEAST_SET - Fatal error!' );
    end
  end

  i0l1 = 0;
  i1l1 = ntab;
%
%  The polynomial is of degree at least 0.
%
  y_sum = sum ( ytab(1:ntab) );
  rn0 = ntab;
  c(0+C_OFFSET) = y_sum / ntab;

  ptab(1:ntab) = y_sum / ntab;

  if ( ndeg == 0 )
    eps = sum ( ( ptab(1:ntab) - ytab(1:ntab) ).^2 );
    eps = sqrt ( eps / ntab );
    b = [];
    d = [];
    return;
  end
%
%  The polynomial is of degree at least 1.
%
  b(1) = sum ( xtab(1:ntab) ) / ntab;

  s = 0.0E+00;
  sum2 = 0.0E+00;
  for ( i = 1 : ntab )
    ztab(i1l1+i) = xtab(i) - b(1);
    s = s + ztab(i1l1+i)^2;
    sum2 = sum2 + ztab(i1l1+i) * ( ytab(i) - ptab(i) );
  end

  rn1 = s;
  c(1+C_OFFSET) = sum2 / s;

  for ( i = 1 : ntab )
    ptab(i) = ptab(i) + c(1+C_OFFSET) * ztab(i1l1+i);
  end

  if ( ndeg == 1 )
    eps = sum ( ( ptab(1:ntab) - ytab(1:ntab) ).^2 );
    eps = sqrt ( eps / ntab );
    d = [];
    return;
  end

  ztable(1:ntab) = 1.0E+00;

  mdeg = 2;
  k = 2;

  while ( 1 )

    d(k+D_OFFSET) = rn1 / rn0;

    sum2 = 0.0E+00;
    for ( i = 1 : ntab )
      sum2 = sum2 + xtab(i) * ztab(i1l1+i) * ztab(i1l1+i);
    end

    b(k) = sum2 / rn1;

    s = 0.0E+00;
    sum2 = 0.0E+00;
    for ( i = 1 : ntab )
      ztab(i0l1+i) = ( xtab(i) - b(k) ) * ztab(i1l1+i) ...
        - d(k+D_OFFSET) * ztab(i0l1+i);
      s = s + ztab(i0l1+i) * ztab(i0l1+i);
      sum2 = sum2 + ztab(i0l1+i) * ( ytab(i) - ptab(i) );
    end

    rn0 = rn1;
    rn1 = s;

    c(k+C_OFFSET) = sum2 / rn1;

    it = i0l1;
    i0l1 = i1l1;
    i1l1 = it;

    for ( i = 1 : ntab )
      ptab(i) = ptab(i) + c(k+C_OFFSET) * ztab(i1l1+i);
    end

    if ( ndeg <= mdeg )
      break;
    end

    mdeg = mdeg + 1;
    k = k + 1;

  end
%
%  Compute the RMS error.
%
  eps = sum ( ( ptab(1:ntab) - ytab(1:ntab) ).^2 );
  eps = sqrt ( eps / ntab );


function [hmg, HMG_u, HMG_s, HMG_k, HMG_c] = invPinHoleHmg(u,s,k,c)

% INVPINHOLEHMG Retro-project anchored homogeneous point AHP.
%   HMG = INVPINHOLEHMG(U,S) gives the retroprojected anchored homogeneous
%   point (HMG) of a pixel U at inverse-depth S, from a canonical pin-hole
%   camera, that is, with calibration parameters
%     u0 = 0, v0 = 0, au = 1, av = 1
%   It uses reference frames {RDF,RD} (right-down-front for the 3D world
%   points and right-down for the pixel), according to this scheme:
%
%         / z (forward)
%        /
%       +------- x                 +------- u
%       |                          |
%       |      3D : P=[x;y;z]      |     image : U=[u;v]
%       | y                        | v
%
%   HMG = INVPINHOLEHMG(U,S,K) allows the introduction of the camera's
%   calibration parameters:
%     K = [u0 v0 au av]'
%
%   HMG = INVPINHOLEHMG(U,S,K,C) allows the introduction of the camera's radial
%   distortion correction parameters:
%     C = [c2 c4 c6 ...]'
%   so that the new pixel is corrected following the distortion equation:
%     U = U_D * (1 + K2*R^2 + K4*R^4 + ...)
%   with R^2 = sum(U_D.^2), being U_D the distorted pixel in the image
%   plane for a camera with unit focal length.
%
%   If U is a pixels matrix, INVPINHOLEHMG(U,...) returns a HMGS matrix HMG,
%   with these matrices defined as
%     U   = [U1 ... Un];       Ui   = [ui;vi]
%     HMG = [HMG1 ... HMGn];   HMGi = [xi,yi,zi,ri]
%   where xi, yi, zi are the non-homogeneous parts of HMG, defining the
%   optical ray, and ri is the inverse of the distance (wrongly named
%   "inverse depth")
%
%   [HMG,HMG_u,HMG_s,HMG_k,HMG_c] returns the Jacobians of HMG wrt U, S, K and C. It
%   only works for single pixels U=[u;v], and for distortion correction
%   vectors C of up to 3 parameters C=[c2;c4;c6]. See UNDISTORT for
%   information on longer distortion vectors.
%
%   See also RETRO, UNDISTORT, DEPIXELLISE, PINHOLEHMG.

%   Copyright 2008-2009 Joan Sola @ LAAS-CNRS.

if nargout == 1 % only point

    switch nargin
        case 2
            v = retro(u,1);
        case 3
            v = retro(depixellise(u,k),1);
        case 4
            v = retro(undistort(depixellise(u,k),c),1);
    end
    n = normvec(v);
    hmg  = [n;s];

else % Jacobians

    if size(u,2) > 1
        error('Jacobians not available for multiple pixels')
    else

        switch nargin
            case 2
                [v, V_u] = invPinHole(u,1);
                [n,N_v]  = normvec(v,1);
                hmg      = [n;s];
                HMG_v    = [N_v;zeros(1,3)];
                HMG_s    = [0;0;0;1];
                HMG_u    = HMG_v*V_u;

            case 3
                [v, V_u, V_1, V_k] = invPinHole(u,1,k);
                [n,N_v]  = normvec(v,1);
                hmg      = [n;s];
                HMG_v    = [N_v;zeros(1,3)];
                HMG_s    = [0;0;0;1];
                HMG_u    = HMG_v*V_u;
                HMG_k    = HMG_v*V_k;

            case 4
                [v, V_u, V_1, V_k, V_c] = invPinHole(u,1,k,c);
                [n,N_v]  = normvec(v,1);
                hmg      = [n;s];
                HMG_v    = [N_v;zeros(1,3)];
                HMG_s    = [0;0;0;1];
                HMG_u    = HMG_v*V_u;
                HMG_k    = HMG_v*V_k;
                HMG_c    = HMG_v*V_c;

        end
    end

end

return

%% jacobians
syms u v s u0 v0 au av c2 c4 c6 real
U=[u;v];
k=[u0;v0;au;av];
c=[c2;c4;c6];

% [hmg,HMG_u,HMG_s] = invPinHoleHmg(U,s);
% [hmg,HMG_u,HMG_s,HMG_k] = invPinHoleHmg(U,s,k);
[hmg,HMG_u,HMG_s,HMG_k,HMG_c] = invPinHoleHmg(U,s,k,c);

simplify(HMG_u - jacobian(hmg,U))
simplify(HMG_s - jacobian(hmg,s))
simplify(HMG_k - jacobian(hmg,k))
% simplify(HMG_c - jacobian(hmg,c))

% ========== End of function - Start GPL license ==========

%   # START GPL LICENSE

%---------------------------------------------------------------------
%
%   This file is part of SLAMTB, a SLAM toolbox for Matlab.
%
%   SLAMTB 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.
%
%   SLAMTB 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 SLAMTB.  If not, see <http://www.gnu.org/licenses/>.
%
%---------------------------------------------------------------------

%   SLAMTB is Copyright:
%   Copyright (c) 2008-2010, Joan Sola @ LAAS-CNRS,
%   Copyright (c) 2010-2013, Joan Sola,
%   Copyright (c) 2014-2015, Joan Sola @ IRI-UPC-CSIC,
%   SLAMTB is Copyright 2009
%   by Joan Sola, Teresa Vidal-Calleja, David Marquez and Jean Marie Codol
%   @ LAAS-CNRS.
%   See on top of this file for its particular copyright.

%   # END GPL LICENSE


function [point,sc] = harris_strongest(im,sigma,mrg,edgerej)
% HARRIS_STRONGEST Extract strongest Harris point.
%   HARRIS_STRONGEST(IM) extracts the strongest harris point in image IM.
%
%   HARRIS_STRONGEST(IM, SG, MRG, EDGEREJ) accepts additional inputs as
%   follows:
%
%   INPUT
%   =====
%   im     : the graylevel image
%   sigma  : STD of the smoothing mask in pixels
%   mrg    : inner margin to be ignored
%   edgerej: maximum ratio allowed between largest and smallest eigenvalues
%
%   [P,SC] = HARRIS_STRONGEST(...) returns also the point's strength as a
%   scalar score (non-normalized).
%
%   OUTPUT
%   ======
%   point  : the interest point extracted
%   sc     : strength of corner point
%
%   EXAMPLE
%   =======
%   [point,sc] = harris_strongest(im)

% Author :: Vincent Garcia - multiple point detector
% Date   :: 05/12/2007
%
% Author :: Joan Sola - strongest point detector, margin ignoring, edge
% rejection
% Date   :: 01/08/2008
%
% REFERENCES
% ==========
% C.G. Harris and M.J. Stephens. "A combined corner and edge detector",
% Proceedings Fourth Alvey Vision Conference, Manchester.
% pp 147-151, 1988.
%
% Alison Noble, "Descriptions of Image Surfaces", PhD thesis, Department
% of Engineering Science, Oxford University 1989, p45.
%
% C. Schmid, R. Mohrand and C. Bauckhage, "Evaluation of Interest Point Detectors",
% Int. Journal of Computer Vision, 37(2), 151-172, 2000.
%

persistent x dx dy ex g; % gaussian filter

% Input options management
switch nargin
    case 1
        sigma = 2;
        mrg = 0;
        edgerej = 20;
    case 2
        mrg = 0;
        edgerej = 20;
    case 3
        edgerej = 20;
end

% only luminance value
im = single(im(:,:,1));

% image size
[sx,sy] = size(im);

% derivative masks
s_D = 0.5*sigma;
if isempty(x)
    x  = -round(2.0*s_D):round(2.0*s_D);
    ex = exp(-x.*x/(2*s_D^2)) ./ (s_D*sqrt(2*pi));
    dx = s_D^2 * x .* ex;
    dy = dx';
    g = conv2(ex,ex');
    g = g/sum(sum(g));
end

% image derivatives
Ix = conv2(im, dx, 'same');
Iy = conv2(im, dy, 'same');

Ix2 = conv2(Ix.^2, g, 'same'); % Smoothed squared image derivatives
Iy2 = conv2(Iy.^2, g, 'same');
Ixy = conv2(Ix.*Iy, g, 'same');

% interest point response
% Original Harris measure.
% k = 0.06; cim = (Ix2.*Iy2 - Ixy.^2) - k*(Ix2 + Iy2).^2;

% Alison Noble measure.
% cim = (Ix2.*Iy2 - Ixy.^2)./(Ix2 + Iy2 + eps);

% Shi and Tomasi -- smallest eigenvalue
a = Ix2+Iy2;
b = sqrt((Ix2-Iy2).^2+4*Ixy.^2);
cim = a-b;  % Smallest eigenvalue.

% supress corner measures close to margin
cim([1:mrg sx-mrg+1:sx],:) = -9e9;
cim(:,[1:mrg sy-mrg+1:sy]) = -9e9;

% Find strongest corner [u;v] and score
[scv,v] = max(cim);
[sc,u]  = max(scv);     % score and u-coordinate
v       = v(u);         % v-coordinate

% reject edges
l = sc;                 % smallest eigenvalue is the score
L = a(v,u) + b(v,u);    %  largest eigenvalue
if L/l > edgerej        % reject edge detections
    sc = 0;             % return nothing if winner is an edge
end

point = [u;v];

% comment out this part for displaying purposes
% figure(98)
% imshow(im,[0 255]);colormap(gray(255))
% axis on
% hold on;
% sz = 3;
% rectangle('Position',[u-sz,v-sz,2*sz,2*sz],'Curvature',[0 0],'EdgeColor','b','LineWidth',1);
% figure(99)
% imshow(cim,[0 max(max(cim))]); axis on;colormap(gray(255))
% rectangle('Position',[u-sz,v-sz,2*sz,2*sz],'Curvature',[0 0],'EdgeColor','b','LineWidth',1);
% point;
% sc;

% ========== End of function - Start GPL license ==========

%   # START GPL LICENSE

%---------------------------------------------------------------------
%
%   This file is part of SLAMTB, a SLAM toolbox for Matlab.
%
%   SLAMTB 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.
%
%   SLAMTB 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 SLAMTB.  If not, see <http://www.gnu.org/licenses/>.
%
%---------------------------------------------------------------------

%   SLAMTB is Copyright:
%   Copyright (c) 2008-2010, Joan Sola @ LAAS-CNRS,
%   Copyright (c) 2010-2013, Joan Sola,
%   Copyright (c) 2014-2015, Joan Sola @ IRI-UPC-CSIC,
%   SLAMTB is Copyright 2009
%   by Joan Sola, Teresa Vidal-Calleja, David Marquez and Jean Marie Codol
%   @ LAAS-CNRS.
%   See on top of this file for its particular copyright.

%   # END GPL LICENSE


function M = femUnk2Qud(fe,domain)
%+========================================================================+
%|                                                                        |
%|              OPENFEM - LIBRARY FOR FINITE ELEMENT METHOD               |
%|           openFem is part of the GYPSILAB toolbox for Matlab           |
%|                                                                        |
%| COPYRIGHT : Matthieu Aussal & Francois Alouges (c) 2017-2018.          |
%| PROPERTY  : Centre de Mathematiques Appliquees, Ecole polytechnique,   |
%| route de Saclay, 91128 Palaiseau, France. All rights reserved.         |
%| LICENCE   : This program is free software, distributed in the hope that|
%| it will be useful, but WITHOUT ANY WARRANTY. Natively, you can use,    |
%| redistribute and/or modify it under the terms of the GNU General Public|
%| License, as published by the Free Software Foundation (version 3 or    |
%| later,  http://www.gnu.org/licenses). For private use, dual licencing  |
%| is available, please contact us to activate a "pay for remove" option. |
%| CONTACT   : matthieu.aussal@polytechnique.edu                          |
%|             francois.alouges@polytechnique.edu                         |
%| WEBSITE   : www.cmap.polytechnique.fr/~aussal/gypsilab                 |
%|                                                                        |
%| Please acknowledge the gypsilab toolbox in programs or publications in |
%| which you use it.                                                      |
%|________________________________________________________________________|
%|   '&`   |                                                              |
%|    #    |   FILE       : femUnknown.m                                  |
%|    #    |   VERSION    : 0.40                                          |
%|   _#_   |   AUTHOR(S)  : Matthieu Aussal & François Alouges            |
%|  ( # )  |   CREATION   : 14.03.2017                                    |
%|  / 0 \  |   LAST MODIF : 14.03.2018                                    |
%| ( === ) |   SYNOPSIS   : Unknowns and reduction matrix for constrained |
%|  `---'  |                finite elements                               |
%+========================================================================+

% Unknown to degrees of freedom matrix
[~,P] = fe.unk;

% Surfacic restriction (trace)
if (size(fe.msh.elt,2) == size(domain.msh.elt,2) + 1)
    bound  = fe.msh.bnd;
    P      = restriction(fe,bound) * P;
    fe.msh = bound;
end

% Degrees of freedom to quadrature matrix
if strcmp(fe.typ(1),'P')
    M = femLagrangePn(fe,domain);
elseif strcmp(fe.typ,'RWG')
    M = femRaoWiltonGlisson(fe,domain);
elseif strcmp(fe.typ,'NED')
    M = femNedelec(fe,domain);
else
    error('fem.m : unavailable case')
end

% Unknown to quadrature
if iscell(M)
    M{1} = M{1} * P;
    M{2} = M{2} * P;
    M{3} = M{3} * P;
else
    M = M * P;
end
end