#=
The prime factors of 13195 are 5, 7, 13 and 29.

What is the largest prime factor of the number 600851475143 ?
=#

using Primes
@time println(maximum(keys(factor(600851475143))))


module IntroAlgoCh2

function insertionsort!(A::AbstractArray)
    for j=2:length(A)
        key = A[j]

        i = j - 1
        while i > 0 && A[i] > key
            A[i+1] = A[i]
            i = i - 1
        end
        A[i+1] = key
    end
    return A
end

function _merge!(A::Array, p::Int, q::Int, r::Int)
    n1 = q - p + 1
    n2 = r - q

    L = A[p:q]
    R = A[q+1:r]

    i=1
    j=1

    for k=p:r
        if L[i] <= R[j]
            A[k] = L[i]
            i+=1
            if i >  n1
                A[k+1:r] .= R[j:end]
                break
            end
        else
            A[k] = R[j]
            j+=1

            if j > n2
                A[k+1:r] .= L[i:end]
                break
            end
        end
    end
end

function _mergesort!(A::Array, p::Int, r::Int)
    if p<r
        q = (p+r)÷2
        _mergesort!(A,p,q)
        _mergesort!(A,q+1,r)
        _merge!(A,p,q,r)
    end
end

function mergesort!(A::Array)
    _mergesort!(A, 1, length(A))

    return A
end

function mergesort_iterative!(A::Array)
    N = length(A)
    B = similar(A)

    #sorting
    for k=1:2:N-1
        if A[k] <= A[k+1]
            B[k] = A[k]
            B[k+1] = A[k+1]
        else
            B[k] = A[k+1]
            B[k+1] = A[k]
        end
    end
    if isodd(N)
        B[N] = A[N]
    end
    A, B = B, A #A is nu gesorteerd (deels) en B is garbage

    #merging
    mergestep = 2
    while mergestep < N
        for start = 1:mergestep*2:N
            if mergestep >= N - start
                break #er blijft nog maar een partitie over en die is al gesorteerd
            end

            p = start  #eerst index rij1
            q = start + mergestep #eerste index rij2
            r = min(q + mergestep - 1, N) #laatste index rij2

            i = p
            j = q

            for k=p:r
                if A[i] <= A[j]
                    B[k] = A[i]
                    i+=1
                    if i >= q
                        @views B[k+1:r] = A[j:r]
                        break
                    end
                else
                    B[k] = A[j]
                    j+=1

                    if j > r
                        @views B[k+1:r] =  A[i:q-1]
                        break
                    end
                end
            end
            A, B = B, A
        end
        mergestep *= 2
    end

    return A
end

function mergesort_iterative_optimized!(A::Array)
    N = length(A)
    if N <= 64
        return insertionsort!(A)
    end

    B = similar(A)

    #sorting
    sortrange = 1:64:N-64
    for i=sortrange
        insertionsort!(@views A[i:i+64])
    end
    insertionsort!(@views A[maximum(sortrange)+1:N])
    #A is nu gesorteerd (deels) en B is garbage

    #merging
    mergestep = 64
    while mergestep < N
        for start = 1:mergestep*2:N
            if mergestep >= N - start
                break #er blijft nog maar een partitie over en die is al gesorteerd
            end

            p = start  #eerst index rij1
            q = start + mergestep #eerste index rij2
            r = min(q + mergestep - 1, N) #laatste index rij2

            i = p
            j = q

            for k=p:r
                if A[i] <= A[j]
                    B[k] = A[i]
                    i+=1
                    if i >= q
                        @views B[k+1:r] = A[j:r]
                        break
                    end
                else
                    B[k] = A[j]
                    j+=1

                    if j > r
                        @views B[k+1:r] =  A[i:q-1]
                        break
                    end
                end
            end
            A, B = B, A
        end
        mergestep *= 2
    end

    return A
end

function _binarysearch(S_sorted::Vector{Int}, target::Int, low::Int, high::Int)::Union{Nothing, Int}
    if low == high
        return (S_sorted[low] == target ? low : nothing)
    end

    mid = (low + high)÷2

    if S_sorted[mid] == target
        return mid
    elseif S_sorted[mid] > target
        return _binarysearch(S_sorted, target, low, mid)
    else
        return _binarysearch(S_sorted, target, mid, high)
    end
end

function sumfinder(S::Vector{Int}, x::Int)::Union{Nothing, Tuple{Int, Int}}
    mergesort!(S)

    n = length(S)

    for i=1:n-1
        idx = let
            target = x - S[i]
            low = i+1
            high = n

            _binarysearch(S, target, low, high)
        end
        if idx !== nothing
            return (i, idx)
        end
    end

    return nothing

end

export insertionsort!, mergesort!, _binarysearch, sumfinder, mergesort_iterative!, mergesort_iterative_optimized!

end


# ---
# title: 1359. Count All Valid Pickup and Delivery Options
# id: problem1359
# author: Tian Jun
# date: 2020-10-31
# difficulty: Hard
# categories: Math, Dynamic Programming
# link: <https://leetcode.com/problems/count-all-valid-pickup-and-delivery-options/description/>
# hidden: true
# ---
#
# Given `n` orders, each order consist in pickup and delivery services.
#
# Count all valid pickup/delivery possible sequences such that delivery(i) is
# always after of pickup(i).
#
# Since the answer may be too large, return it modulo 10^9 + 7.
#
#
#
# **Example 1:**
#
#
#
#     Input: n = 1
#     Output: 1
#     Explanation: Unique order (P1, D1), Delivery 1 always is after of Pickup 1.
#
#
# **Example 2:**
#
#
#
#     Input: n = 2
#     Output: 6
#     Explanation: All possible orders:
#     (P1,P2,D1,D2), (P1,P2,D2,D1), (P1,D1,P2,D2), (P2,P1,D1,D2), (P2,P1,D2,D1) and (P2,D2,P1,D1).
#     This is an invalid order (P1,D2,P2,D1) because Pickup 2 is after of Delivery 2.
#
#
# **Example 3:**
#
#
#
#     Input: n = 3
#     Output: 90
#
#
#
#
# **Constraints:**
#
#   * `1 <= n <= 500`
#
#
## @lc code=start
using LeetCode

## add your code here:
## @lc code=end


module AnalyticalPlaneSolver

struct PlaneSolver
    L::Any
    W::Any
    R::Any
    lambda1::Any
    mu1::Any
    lambda2::Any
    mu2::Any
    theta0::Any
    C1::Any
    C2::Any
    D::Any
    uI::Any
    function PlaneSolver(L, W, R, lambda1, mu1, lambda2, mu2, theta0)
        C1 = solver_coefficient(lambda1, mu1)
        C2 = solver_coefficient(lambda2, mu2)
        D = 2 * lambda1 * mu1 / (lambda1 + 2mu1)

        uI = interface_displacement(L, R, C1, C2, D, theta0)
        new(L, W, R, lambda1, mu1, lambda2, mu2, theta0, C1, C2, D, uI)
    end
end

function solver_coefficient(lambda, mu)
    C = 4 * mu * (lambda + mu) / (lambda + 2mu)
    return C
end

function interface_displacement(L, R, C1, C2, D, theta0)
    uI = -(C1 + D) / (C2 / R + C1 / (L - R)) * theta0 / 3
    return uI
end

function parent_displacement_field(solver::PlaneSolver,x)
    uI = solver.uI
    R = solver.R
    lambda = solver.lambda2
    mu = solver.mu2

    ux = uI/R*x[1]
    uy = -lambda/(lambda+2mu)*uI/R*x[2]
    return [ux,uy]
end

function product_displacement_field(solver::PlaneSolver,x)
    uI = solver.uI
    L = solver.L
    R = solver.R
    lambda = solver.lambda1
    mu = solver.mu1
    t0 = solver.theta0

    ux = ((L-R)-(x[1]-R))/(L-R)*uI
    uy = (lambda/(lambda+2mu)*uI/(L-R) + (3lambda+2mu)/(lambda+2mu)*t0/3)*x[2]

    return [ux,uy]
end

function displacement_field(solver::PlaneSolver,x)
    R = solver.R
    if x[1] < R
        return parent_displacement_field(solver,x)
    else
        return product_displacement_field(solver,x)
    end
end

end


function simulate_exp_gpreal(t,alpha,beta,ndev)
#
# Function for simulating a GP based upon an exponential correlation
# matrix using an analytic form for the Cholesky decomposition and
# a computation in O(N) operations.  The autocorrelation function is:
#
#    K_ij = alpha * exp(-beta*(|t_i-t_j|))
#
# Requirements:
#  - alpha should be a real positive number.
#  - The times t *must* be sorted in order from least to greatest.
#  - beta may be complex
#  - ndev: normal deviates drawn from N(0,1) with the same length as time vector t.
# Output:
#  - data is a GP drawn from this correlation function with length nt
#
nt = length(t)
data = zeros(eltype(beta),nt)
data[nt] = sqrt(alpha)*ndev[nt]
gamma = zero(eltype(beta))
for i=nt-1:-1:1
  gamma = exp(-beta*(t[i+1]-t[i]))
#  println(i," ",abs(sqrt(1.0-gamma^2)))
  data[i] = sqrt(1.0-gamma^2)*sqrt(alpha)*ndev[i]+gamma*data[i+1]
end
return data
end


function CostGradient(X::Array,y::Vector;λ=0, Norm=false)

   #Size of the X Parameters
    m=size(X,1)
    n=size(X,2)
    #if Normalize

    if Norm==true
       μ=mean(X,dims=1)
       σ=std(X,dims=1)
       X=(X.-μ)./σ
    else
        μ=zeros(1,n)
        σ=ones(1,n)
    end

    #Add vector of ones to X parameters
    X=[ones(m) X]

    CostFunction=function (θ)
                    se=(X*θ).-y
                    J=(0.5./m).*((se'*se)+λ*(θ[2:end]'*θ[2:end]))
                    return J
                end
    θr=zeros(n+1)
    Gradient=function (θ)
             θr.=θ
             θr[1]=0
             g=(1/m).*(X'*((X*θ).-y)) .+ ((λ./m).*θr)
        return g
            end

    return CostFunction, Gradient, μ, σ
end


using AQFED.Math
const SqrtEpsilon = sqrt(eps())
# totalVariance is vol^2*τ
export blackScholesFormula, blackScholesVega

function blackScholesFormula(isCall::Bool, strike::Number, spot::Number, totalVariance::Number, driftDf::Number, discountDf::Number)
    sign = 1
    if !isCall
        sign = -1
    end
    forward = spot / driftDf
    if totalVariance < eps()
        price = discountDf * max(sign * (forward - strike), 0)
        return price
    elseif spot < eps()
        if isCall
            return 0
        else
            return discountDf * strike
        end
    elseif strike < eps()
        if isCall
            return discountDf * forward
        else
            return 0
        end
    else
        sqrtVar = sqrt(totalVariance)
        d1 = log(forward / strike)/sqrtVar + sqrtVar/2
        d2 = d1 - sqrtVar
        nd1 = normcdf(sign * d1)
        nd2 = normcdf(sign * d2)
        price = sign * discountDf * (forward * nd1 - strike * nd2)
        return price
    end
end

function blackScholesVega(strike::Number,
	spot::Number,
	variance::Number,
	driftDf::Number,
	discountDf::Number,
	tte::Number)::Number
	forward = spot / driftDf
	sqrtVar = sqrt(variance)
	d1 = 1.0/sqrtVar*log(forward/strike) + 0.5*sqrtVar
	nd1 = normpdf(d1)
	vega = discountDf * forward * nd1 * sqrt(tte)
	return vega
end


##
##  s p e c i a l . j l  Special Functions
##

# Lambert W function, inverse of x -> x exp(x)
# its derivative is 1 / (1+zw) / exp(zw) where zw = lambertW(z)
#
function lambertW(x::Real)
    if x <  -1.0/exp(1.0); return NaN, NaN;  end
    if x == -1.0/exp(1.0); return -Inf, Inf; end

    local w0::Real = 1.0, w1::Real, w2::Real
    w1 = w0 - (w0 * exp(w0) - x)/((w0 + 1.0) * exp(w0) -
        (w0 + 2.0) * (w0 * exp(w0) - x)/(2.0 * w0 + 2.0))

    while abs(w1 - w0) > 1e-15
        w0 = w1
        w1 = w0 - (w0 * exp(w0) - x)/((w0 + 1.0) * exp(w0) -
            (w0 + 2.0) * (w0 * exp(w0) - x)/(2.0 * w0 + 2.0))
    end

    w2 = 1.0 / (1 + w1) / exp(w1)

    return w1, w2
end


export Random, random
"""
    random(x;args)

Randomly generate a vector of size `x`, based on provided (optional arguments) :
- `L` is the typical wavelength (default is `L=1`),
- `s` is the (real) Sobolev index regularity (default is `s=∞`, smooth data),
- `λ` is the length of spatial localization (default is `λ=∞`, no localization),
- `a` is the amplitude of the returned vector (default is `a=1`).

The vector is generated through randomly chosen Fourier coefficients,
multiplied with weigth `w=10^(-|k|L/(2π))` if `s=∞`, or `w=1/(1+9(|k|L/(2π))^(s+1/2))` otherwise.
If `λ≠∞`, the function in spatial variables is multiplied by `exp(-|x/λ|^2)`,
and in any case normalized to have maximum absolute value 1.

"""
function random( x;L=1,s=Inf,λ=Inf,a=1 )

    k = Mesh( x ).k
    if s == Inf
        w = 10 .^(-abs.(k*L/(2*π)))
    else
        w = 1 ./( 1 .+ 9*abs.(k*L/(2*π)).^(s+1/2) )
    end
    if λ == Inf
        φ = zero(x).+1
    else
        φ = exp.(-abs.((x/λ).^2))
    end

    θ = 2*π*rand(Float64,length(x))
    r = rand(Float64,length(x))
    Fourier = r.*exp.(-1im.*θ).*w
    Physic = real.(ifft(Fourier)).*φ
    return Physic./(maximum(Physic)-minimum(Physic))*a
end

"""
    Random(param;args)

Randomly generated initial data, based on provided (optional arguments) :
- `L` is the typical wavelength (default is `L=1`),
- `s` is the (real) Sobolev index regularity (default is `s=∞`),
- `λ` is the length of spatial localization (default is `λ=∞`, no localization),
- `a` is the couple of amplitudes of the surface deformation, and velocity (default is `a=(1,1)`).

Return an initial data `init::InitialData`,  to be used in initial-value problems `Problem(model, init, param)`,
with `init.η` and `init.v` two samples of `random(x;L,s,λ)`,
where `x` is the set of collocation points generated by `Mesh(param)`.

"""
struct Random <: InitialData

    η
    v
    label :: String
    info  :: String

    function Random(param;L=1,s=Inf,λ=Inf,a=(1,1))
        mesh=Mesh(param);x=mesh.x;
        η = random( x; L=L,s=s,λ=λ,a=a[1] )
        v = random( x; L=L,s=s,λ=λ,a=a[2] )
        init=Init(x,η,v)
        if s == Inf s="∞" end
        if λ == Inf λ="∞" end
        label = "randomly generated"
        info = "Randomly generated initial data with \n\
        ├───typical wavelength: L = $L,\n\
        ├─────regularity index: s = $s,\n\
        ├─spatial localization: λ = $λ,\n\
        ├────surface amplitude: $(a[1]),\n\
        └───velocity amplitude: $(a[2])."
    	new( init.η,init.v,label,info )

    end

end


@testset "sm" begin
    v1 = rand(5)
    v2 = rand(5)

    αs₁ = rand(3)
    αs₂ = rand(5, 3)
    γs = rand(5, 3)
    ωs = rand(5, 3)

    k1 = spectral_mixture_kernel(αs₁, γs, ωs)
    k2 = spectral_mixture_product_kernel(αs₂, γs, ωs)

    t = v1 - v2

    @test k1(v1, v2) ≈ sum(αs₁ .* exp.(-(t' * γs)'.^2) .*
                           cospi.((t' * ωs)')) atol=1e-5

    @test k2(v1, v2) ≈ prod(sum(αs₂[i,:]' .* exp.(-(γs[i,:]' * t[i]).^2) .*
                                cospi.(ωs[i,:]' * t[i])) for i in 1:length(t)) atol=1e-5

    @test_throws DimensionMismatch spectral_mixture_kernel(rand(5) ,rand(4,3), rand(4,3))
    @test_throws DimensionMismatch spectral_mixture_kernel(rand(3) ,rand(4,3), rand(5,3))
    @test_throws DimensionMismatch spectral_mixture_product_kernel(rand(5,3) ,rand(4,3), rand(5,3))
    # test_ADs(x->spectral_mixture_kernel(exp.(x[1:3]), reshape(x[4:18], 5, 3), reshape(x[19:end], 5, 3)), vcat(log.(αs₁), γs[:], ωs[:]), dims = [5,5])
    @test_broken "No tests passing (BaseKernel)"
end


using ApproxFun, BandedMatrices, BlockBandedMatrices, LinearAlgebra, BlockArrays, MultivariateOrthogonalPolynomials, Test
using SparseVolterraExamples

#############################
## Tests for Volterra integral equations of first and second kind
## with Clenshaw Jacobi expansion of the kernel.
####
## Includes tests for 1 to x and 1 to 1-x limits of integration.
#############################

@testset "Volterra Integral Equation 1st kind, could be monomial, flip=true" begin
    g(x) = sin(x)-x*cos(x);
    K(x,y) = y;
    @test triVolterraEQ1FullKernelSolver(g,K,30,true) ≈ Fun(x->sin(x),Jacobi(0,1, 0..1))
    #########################################################################
    g(x) = 2+x-2*exp(x)+x*exp(x)
    K(x,y) = x-y;
    @test triVolterraEQ1FullKernelSolver(g,K,20,true) ≈ Fun(x->x*exp(x),Jacobi(0,1, 0..1))
end

@testset "Volterra Integral Equation 1st kind, could be monomial, flip=false" begin
    N = 20
    g(x) = 3-x-2*exp(1-x)+(1-x)*exp(1-x);
    K(x,y) = 1-y-x;
    @test triVolterraEQ1FullKernelSolver(g,K,N,false) ≈ Fun(x -> x*exp(x), Jacobi(0,1,0..1))
end

@testset "Volterra Integral Equation 1st kind, not monomial, flip=false" begin
    N = 20;
    g(x) = 1/12*(4-4*(-1+x)^3+3*(-1+x)^4-4*cos((1-x)^3))
    K(x,y) = 1+y+sin(y^3);
    @test triVolterraEQ1FullKernelSolver(g,K,N,false) ≈ Fun(x->x^2,Jacobi(0,1,0..1))
end

@testset "Volterra Integral Equation 2nd kind, could be monomial, flip=false" begin
    N = 15;
    S = Jacobi(0,1,0..1);
    g = Fun(x -> (x-1)*cos(2*pi*(1-x))/(2*pi)+((4*pi^2+1)/(4*pi^2))*sin(2*pi*(1-x)), S);
    K(x,y)=y;
    @test triVolterraEQ2FullKernelSolver(g,K,N,false) ≈ Fun(x -> sin(2*pi*(1-x)), S)
    #########################################################################
    N = 15;
    S = Jacobi(0,1,0..1);
    g = Fun(x -> (-17/30)*x^6+2*x^5-(3/2)*x^4-(11/2)*x^3+(15/2)*x^2-(21/10)*x+1/6, S);
    K(x,y) = 7*x*y+5*y^2;
    @test triVolterraEQ2FullKernelSolver(g,K,N,false) ≈ Fun(x -> 1-x^3, S)
end

@testset "Volterra Integral Equation 2nd kind, not monomial, flip=true" begin
    g = Fun(x->x^2+2*x-exp(x)+2, Jacobi(0,1,0..1));
    K(x,y) = (y-x)^2;
    @test triVolterraEQ2FullKernelSolver(g,K,20,true) ≈ Fun(x->exp(x),Jacobi(0,1,0..1));
end


using BenchmarkTools
using LinearAlgebra

function progonka!(u,a,b,c,f)
    N = size(f,1)
    α=similar(f)
    β=similar(f)
    α[2] = -c[1]/b[1]
    β[2] = f[1]/b[1]
    @inbounds @fastmath for i in 2:N-1 #Forward Sweep
        α[i+1]=-c[i]/(a[i-1]*α[i]+b[i])
        β[i+1]=(f[i]-a[i-1]*β[i])/(a[i-1]*α[i]+b[i])
    end
    u[N]=(f[N]-a[N-1]*β[N])/(a[N-1]*α[N]+b[N])
    @inbounds @fastmath for i in N-1:-1:1 #Backward Sweep
        u[i]=α[i+1]*u[i+1]+β[i+1]
    end
    u
end

progonka(a,b,c,f)=progonka!(similar(f),a,b,c,f)

function tprogonka()
    N=1000
    a=-rand(N-1)
    c=-rand(N-1)
    b=2.0.+rand(N)
    f=rand(N)

    A=Tridiagonal(a,b,c)
    utri=A\f
    upro=progonka(a,b,c,f)
    @assert utri≈upro
    @btime utri=$A\$f
    @btime upro=progonka($a,$b,$c,$f)
    nothing
end


using SKTB.FermiContour
using Test

# Compare the rate of convergence with the predicted rate.
# Not a proper unit test, but good enough for our purposes.

@testset "FermiContour" begin

E1 = 0
E2 = 1
β = 10.0
n = 2:2:18
x = range(E1,stop=E2,length=100)

# Compute empirical convergence rate
error = zeros(length(n))
for i = 1:length(n)
    w,z = fermicontour(E1,E2,β,n[i])
    fx = sum(real(w*fermidirac.(z,β) ./ (z  .- x)) for (w,z) in zip(w,z))
    error[i] = maximum(abs.(fermidirac.(x,β) .- fx))
end

# Compute theoretical convergence rate
m = E1^2 + π^2/β^2
M = E2^2 + π^2/β^2
k = (sqrt(M/m)-1)/(sqrt(M/m)+1)
K = SKTB.FermiContour.JacobiFunc.K(k^2)
iK = SKTB.FermiContour.JacobiFunc.iK(k^2)
predicted = 2 * exp.(-π*iK/(2K)*n)

println("n   error    predicted    err/pred")
display([n  error predicted error./predicted]); println()
@test maximum(abs.(error./predicted .- 1.0)) < 0.1

# TODO: implement analogous test for 0T contour!

end


using ArtificialBeeColony

# initializer for bees' position
function init()
    rand(1)*20 .- 10   # [-10, 10]
end

# target function
function target(x::Vector{Float64})
    x[1]^2+10*sin(2*x[1])
end

N = 50       # the number of bees
epoch = 100  # the number of iteration
flag = true  # time invariant flag

abc = ABC(N, init)
best = search!(abc, target; epoch=epoch, time_invariant=flag)

println("x = ", best[1])
println("target(x) = ", target(best))


# v0.6.0

function magicsquareodd(base::Int)
    if base & 1 == 0 || base < 3; error("base must be odd and >3") end

    square = fill(0, base, base)
    r, number = 1, 1
    size = base * base

    c = div(base, 2) + 1
    while number ≤ size
        square[r, c] = number
        fr = r == 1 ? base : r - 1
        fc = c == base ? 1 : c + 1
        if square[fr, fc] != 0
            fr = r == base ? 1 : r + 1
            fc = c
        end
        r, c = fr, fc
        number += 1
    end

    return square
end

for n in 3:2:7
    println("Magic square with size $n - magic constant = ", div(n ^ 3 + n, 2))
    println("----------------------------------------------------")
    square = magicsquareodd(n)
    for i in 1:n
        println(square[i, :])
    end
    println()
end


"""
Copyright Marcus Greiff 2020

Full test suite for the aerial vehicle controller generation
"""

using LinearAlgebra, Test, AerialVehicleControl

recompile()        # Recompile the C-code
runAllTests = true # If defined, will not recompile the C-code

@testset "All tests" begin
    @testset "Math library tests" begin
        include("controller_math/test_math_functions.jl")
        include("controller_math/test_SO3_maps.jl")
        include("controller_math/test_SU2_maps.jl")
    end
    @testset "Attitude controllers" begin
        include("controller_implementations/test_FSF_attitude_utils.jl")
        include("controller_implementations/test_FSF_continuous_SO3.jl")
        include("controller_implementations/test_FSF_robust_SO3.jl")
        include("controller_implementations/test_FSF_continuous_SU2.jl")
        include("controller_implementations/test_FSF_discontinuous_SU2.jl")
        include("controller_implementations/test_FSF_robust_SU2.jl")
        include("controller_implementations/test_FOF_continuous_SO3.jl")
    end
    @testset "General utility functions" begin
        include("controller_utils/test_power_distribution.jl")
    end
    @testset "Matrix math functions" begin
        include("matrix_math/test_matrix_addition_inplace.jl")
        include("matrix_math/test_matrix_addition.jl")
        include("matrix_math/test_matrix_eigvals.jl")
        include("matrix_math/test_matrix_multiplication.jl")
        include("matrix_math/test_matrix_solve_posdef.jl")
        include("matrix_math/test_matrix_subtraction_inplace.jl")
        include("matrix_math/test_matrix_subtraction.jl")
        include("matrix_math/test_matrix_transposition.jl")
    end
end


function solve_008(n::Int64)

    # Hardcode string
    str = "7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450"

    max_prod = 0
    # Iterate over string and multiply digits
    for j = 1:(1000-n)
        sub_str = str[j:j+n]
        prod = 1
        for i = 1:n
            prod *= parse(Int64,sub_str[i])
        end
        if prod > max_prod
            max_prod = prod
        end
    end

    return max_prod
end


import MathematicalSets.AbstractSet

# ===========================================================================
# This is a collection of concrete subtypes of `AbstractSet` for the purposes
# of testing and code coverage.
#
# For use cases of `MathematicalSets` in external libraries, see the section
# `Usage` in the documentation.
# ===========================================================================

"""
    DummySet <: MathematicalSets.AbstractSet

The dummy set is a set with no fields. It is used to cover the `MathematicalSets`
functions.
"""
struct DummySet <: MathematicalSets.AbstractSet end

"""
    Singleton{T<:AbstractVector} <: AbstractSet

A singleton is a set with one element.

### Fields

- `element` -- element in the singleton
"""
struct Singleton{T<:AbstractVector} <: MathematicalSets.AbstractSet
    element::T
end

MathematicalSets.space_dimension(s::Singleton) = length(s.element)

# the dimension of a point is conventionally 0
MathematicalSets.dimension(s::Singleton) = 0

# the following metric properties for a singleton are usually zero, although
# depending on the applicaton one could be interested to have e.g. a Dirac δ
# if commented, defaults to returning `nothing` in `MathematicalSets`:
MathematicalSets.volume(s::Singleton) = 0.
MathematicalSets.surface_area(s::Singleton) = 0.

"""
    Ball{T} <: AbstractSet

Euclidean ``n``-dimensional ball in ``\\mathbb{R}^n``.

### Fields

- `center` -- vector that represents the center of the ball
- `radius` -- scalar that represents the radius of the ball
"""
struct Ball{T, VT <: AbstractVector{T}} <: MathematicalSets.AbstractSet
    center::VT
    radius::T
end
radius(S::Ball) = S.radius
center(S::Ball) = S.center

MathematicalSets.space_dimension(S::Ball) = length(S.center)
MathematicalSets.dimension(S::Ball) = space_dimension(S)

# convenience constructor: if only the radius and dimension are supplied,
# the ball is centered in the origin
Ball(R::T, n::Int) where T = Ball(zeros(T, n), R)

using SpecialFunctions # needed for the gamma function

function MathematicalSets.volume(S::Ball)
    n, R = dimension(S), radius(S)
    return π^(n/2) * R^n / gamma(n/2 + 1)
end

function MathematicalSets.surface_area(S::Ball)
    n, R = dimension(S), radius(S)
    return π^(n/2) * n * R^(n-1) / gamma(n/2 + 1)
end


# Create example data
x = LinRange(-2, 2, 40)
f(t) = t^3 + t^2 + t
y = f.(x)
# Plot x and y
plot(x, y)
# Plot x using the callable
plot(x, f)
# Plot y, using its indices for the x values
plot(y)
# Plot two columns
plot(x, [y 3x.^2 .- 3])
# Plot various series them with custom line specs
y2 = 3x.^2 .- 3
plot(x, y, "-r", x, y2, ":*b")


# =========================================================================== #
# Types
# =========================================================================== #

abstract type DistributionType
end

struct UniformDistribution{T} <: DistributionType
    a::T
    b::T
end
function UniformDistribution(a::T, b::T) where {T}
    a = min(a, b)
    b = max(a, b)
    UniformDistribution{T}(a, b)
end
function UniformDistribution() where {T}
    UniformDistribution{T}(0.0, 1.0)
end

struct NormalDistribution{T} <: DistributionType
    mu::T
    sigma::T
end
function NormalDistribution(mu::T, sigma::T) where {T}
    if sigma < 0
        error("sigma must be positive")
    end
    NormalDistribution{T}(mu, sigma)
end
function NormalDistribution(;mu = 0.0, sigma = 1.0)
    NormalDistribution(mu, sigma)
end

struct CauchyDistribution{T} <: DistributionType
    mu::T
    c::T
end
function CauchyDistribution(mu::T, c::T) where {T}
    CauchyDistribution{T}(mu, c)
end
function CauchyDistribution(;mu = 0.0, c = 1.0)
    CauchyDistribution(mu, c)
end

struct MultiNormalDistribution{T} <: DistributionType
    mu::Vector{T}
    sigma::Matrix{T}
    L::LowerTriangular{T, Matrix{T}}
    inv_sigma::Matrix{T}
end
function MultiNormalDistribution(mu::Vector{T}, sigma::Matrix{T}) where {T}
    n_dim = length(mu)
    sz = size(sigma)
    if sz[1] != sz[2]
        error("Non-square sigma matrix")
    end
    if sz[1] != n_dim
        error("dimension mismatch between mu and sigma")
    end

    fact = cholesky(sigma)

    id = Matrix{T}( one(T) * I, n_dim, n_dim )
    inv_sigma = fact.L \ ( fact.U \ id )
    MultiNormalDistribution{T}(mu, sigma, fact.L, inv_sigma)
end


"""
    sum_of_bit_difference(array::Array{Int64,1})

For finding the sum of bit differences in all pairs of an array, the array will be
transformed into a series of subarrays  for a given bit-length.

# Arguments
- `array::Array{Int64,1}`: Unsorted array

# Examples
```julia-repl
julia> import ClassicAlgorithmsCollections
julia> arr = [8, 1, 2, 12, 45, 100, 43]
julia> ClassicAlgorithmsCollections.maximum_xor_subarray(arr)
104
```
"""
function sum_of_bit_difference(array::Array{Int64,1}, bit = 32)
    n = length(array)
    result = 0
    for i in 1:bit
        count = 0
        for j in 1:n
            if (array[j] & (1 << i)) != 0
                count += 1
            end
        end
        result += count * (n - count) * 2
    end
    return result
end


"""
    TDist(ν)

The *Students T distribution* with `ν` degrees of freedom has probability density function

```math
f(x; d) = \\frac{1}{\\sqrt{d} B(1/2, d/2)}
\\left( 1 + \\frac{x^2}{d} \\right)^{-\\frac{d + 1}{2}}
```

```julia
TDist(d)      # t-distribution with d degrees of freedom

params(d)     # Get the parameters, i.e. (d,)
dof(d)        # Get the degrees of freedom, i.e. d
```

External links

[Student's T distribution on Wikipedia](https://en.wikipedia.org/wiki/Student%27s_t-distribution)

"""
struct TDist{T<:Real} <: ContinuousUnivariateDistribution
    ν::T
    TDist{T}(ν::T) where {T <: Real} = new{T}(ν)
end

function TDist(ν::T) where {T <: Real}
    @check_args(TDist, ν > zero(ν))
    return TDist{T}(ν)
end

TDist(ν::T, ::NoArgCheck) where {T<:Real} = TDist{T}(ν)
TDist(ν::Integer) = TDist(float(ν))

@distr_support TDist -Inf Inf

#### Conversions
convert(::Type{TDist{T}}, ν::Real) where {T<:Real} = TDist(T(ν))
convert(::Type{TDist{T}}, d::TDist{S}) where {T<:Real, S<:Real} = TDist(T(d.ν), NoArgCheck())

#### Parameters

dof(d::TDist) = d.ν
params(d::TDist) = (d.ν,)
@inline partype(d::TDist{T}) where {T<:Real} = T

#### Statistics

mean(d::TDist{T}) where {T<:Real} = d.ν > 1 ? zero(T) : T(NaN)
median(d::TDist{T}) where {T<:Real} = zero(T)
mode(d::TDist{T}) where {T<:Real} = zero(T)

function var(d::TDist{T}) where T<:Real
    ν = d.ν
    isinf(ν) && return one(T)
    ν > 2 ? ν / (ν - 2) :
    ν > 1 ? T(Inf) : T(NaN)
end

skewness(d::TDist{T}) where {T<:Real} = d.ν > 3 ? zero(T) : T(NaN)

function kurtosis(d::TDist{T}) where T<:Real
    ν = d.ν
    ν > 4 ? 6 / (ν - 4) :
    ν > 2 ? T(Inf) : T(NaN)
end

function entropy(d::TDist{T}) where T <: Real
    isinf(d.ν) && return entropy( Normal(zero(T), one(T)) )
    h = d.ν/2
    h1 = h + 1//2
    h1 * (digamma(h1) - digamma(h)) + log(d.ν)/2 + lbeta(h, 1//2)
end

#### Evaluation & Sampling

@_delegate_statsfuns TDist tdist ν

rand(rng::AbstractRNG, d::TDist) = randn(rng) / ( isinf(d.ν) ? 1 : sqrt(rand(rng, Chisq(d.ν))/d.ν) )

function cf(d::TDist{T}, t::Real) where T <: Real
    isinf(d.ν) && return cf(Normal(zero(T), one(T)), t)
    t == 0 && return complex(1)
    h = d.ν/2
    q = d.ν/4
    complex(2(q*t^2)^q * besselk(h, sqrt(d.ν) * abs(t)) / gamma(h))
end

gradlogpdf(d::TDist{T}, x::Real) where {T<:Real} = isinf(d.ν) ? gradlogpdf(Normal(zero(T), one(T)), x) : -((d.ν + 1) * x) / (x^2 + d.ν)


using DynamicHMCModels

Random.seed!(1)

cd(@__DIR__)
include("sdt_functions.jl")
include("simulateSDT.jl")

struct SDTProblem
    hits::Int64
    fas::Int64
    Nd::Int64
end

function (problem::SDTProblem)(θ)
    @unpack hits,fas,Nd=problem   # extract the data
    @unpack d,c=θ
    logpdf(SDT(d,c),[hits,fas,Nd])+logpdf(Normal(0,1/sqrt(2)),d) +
    logpdf(Normal(0,1/sqrt(2)),c)
end

# Define problem with data and inits.

data = simulateSDT(;Nd=100)

p = SDTProblem(data...)
p((d=2.0,c=.0))

# Write a function to return properly dimensioned transformation.
problem_transformation(p::SDTProblem) =
     as((d=asℝ,c=asℝ))

# Use Flux for the gradient.
P = TransformedLogDensity(problem_transformation(p), p)
∇P = ADgradient(:ForwardDiff, P);

#import Zygote
#∇P = ADgradient(:Zygote, P);

# FSample from the posterior.
chain, NUTS_tuned = NUTS_init_tune_mcmc(∇P, 4000);

# Undo the transformation to obtain the posterior from the chain.
posterior = TransformVariables.transform.(Ref(problem_transformation(p)),
  get_position.(chain));

chns = nptochain(posterior,NUTS_tuned)


doc"""
    rsi(ta, n=14; wilder=false)

Relative Strength Index

```math
    RSI = \frac{EMA(Up, n)}{EMA(Up, n) + EMA(Dn, n)}
```
"""
function rsi(ta::TimeArray, n::Int=14; wilder::Bool=false)
    ret = diff(ta.values)
    ups = zeros(size(ta.values, 1) - 1, size(ta.values, 2))
    dns = zeros(size(ta.values, 1) - 1, size(ta.values, 2))

    @inbounds for i in 1:size(ta.values, 1) - 1
        for j in 1:size(ta.values, 2)
            if ret[i, j] >= 0
                ups[i, j] += ret[i, j]
            else
                dns[i, j] += ret[i, j]
            end
        end
    end

    upsema = ema(ups, n, wilder=wilder)
    dnsema = abs.(ema(dns, n, wilder=wilder))
    rs     = upsema ./ dnsema

    res  = @. 100 - (100 / (1 + rs))

    cname   = String[]
    cols    = colnames(ta)
    for c in 1:length(cols)
        push!(cname, string(cols[c], "_rsi_", n))
    end

    TimeArray(ta.timestamp[n+1:end], res, cname, ta.meta)
end

doc"""
    cci(ohlc, ma=20, c=0.015)

Commodity Channel Index

```math
    CCI = \frac{P_{typical} - SMA(P_{typical})}{c \times \sigma(P_{typical})}
```

**Reference**

- https://en.wikipedia.org/wiki/Commodity_channel_index

"""
function cci(ohlc::TimeArray, ma::Int=20, c::AbstractFloat=0.015)
    pt = typical(ohlc)
    cci = safediv.((pt .- sma(pt, ma)), moving(mean_abs_dev, pt, ma)) ./ c
    rename(cci, "cci")
end

doc"""
    chaikinoscillator(ohlcv, fast=3, slow=10; h="High", l="Low", c="Close")

**Chaikin Oscillator**

Developed by Marc Chaikin

**Formula**

```math
    Chaikin\ OSC = EMA(ADL, fast) - EMA(ADL, slow)
```

where the [`adl`](@ref) is the Accumulation/Distribution Line.

**Reference**

- [StockCharts]
  (http://stockcharts.com/school/doku.php?id=chart_school:technical_indicators:chaikin_oscillator)
"""
function chaikinoscillator(ohlcv::TimeArray, fast::Integer=3, slow::Integer=10;
                           h="High", l="Low", c="Close")
    _adl = adl(ohlcv, h=h, l=l, c=c)
    rename(ema(_adl, fast) .- ema(_adl, slow), ["chaikinoscillator"])
end

doc"""
    macd(ta, fast=12, slow=26, signal=9; wilder=false)

Moving Average Convergence / Divergence

```math
    \begin{align*}
        MACD Bar & = DIF - DEM \\
        DIF & = EMA(P_{close}, fast) - EMA(P_{close}, slow) \\
        DEM & = EMA(DIF, 9) \tag{signal}
    \end{align*}
```

**Return**:

`TimeArray` with 3 columns `["macd", "dif", "signal"]`.

If the input is a multi-column `TimeArray`, the new column names will be
`["A_macd", "B_macd", "A_dif", "B_dif", "A_signal", "B_signal"]`.

"""
function macd(ta::TimeArray{T,N},
              fast::Int=12, slow::Int=26, signal::Int=9;
              wilder::Bool=false) where {T,N}
    dif = ema(ta, fast, wilder=wilder) .- ema(ta, slow, wilder=wilder)
    sig = ema(dif, signal, wilder=wilder)
    osc = dif .- sig

    cols = ["macd", "dif", "signal"]
    new_cols = (N > 1) ? gen_colnames(ta.colnames, cols) : cols

    merge(merge(osc, dif), sig, colnames=new_cols)
end

doc"""
    roc(ta, n)

**Rate of Change**

**Formula**:

```math
    roc = \frac{close_{t} - close_{t-n}}{close_{t-n}}
```

**Reference**:

- [Wikipedia](https://en.wikipedia.org/wiki/Momentum_(technical_analysis))

"""
function roc(ta::TimeArray, n::Integer)
    prev = lag(ta, n)
    rename((ta .- prev) ./ prev, ["$c\_roc_$n" for c ∈ ta.colnames])
end

doc"""
    aroon(ohlc, n=25; h="High", l="Low")

**Aroon Oscillator**

**Formula**

```math
    \begin{align*}
        up   & = \frac{\mathop{argmax}(High_{t-n} \dots High_t)}{n} \times 100 \\
        down & = \frac{\mathop{argmin}(Low_{t-n} \dots Low_t)}{n} \times 100 \\
        osc  & = up - down
    \end{align*}
```

**Reference**

- [StockCharts]
  (http://stockcharts.com/school/doku.php?id=chart_school:technical_indicators:aroon_oscillator)
"""
function aroon(ohlc::TimeArray, n::Integer=25; h="High", l="Low")
    up = rename(moving(indmax, ohlc[h], n) ./ n .* 100, "up")
    dn = rename(moving(indmin, ohlc[l], n) ./ n .* 100, "dn")
    osc = rename(up .- dn, "osc")

    merge(merge(up, dn), osc)
end

doc"""
    adx(ohlc, n=14; h="High", l="Low", c="Close")

**Average Directional Movement Index**

Developed by J. Welles Wilder.
This Implementation follows StockCharts.

**Reference**

- [wikipedia]
  (https://en.wikipedia.org/wiki/Average_directional_movement_index)

- [StockCharts]
  (http://stockcharts.com/school/doku.php?id=chart_school:technical_indicators:average_directional_index_adx)
"""
function adx(ohlc::TimeArray, n::Integer=14; h="High", l="Low", c="Close")
    dm = relu(merge(ohlc[h] .- lag(ohlc[h]), lag(ohlc[l]) .- ohlc[l]))
    dm.values[findmin(dm.values, 2)[2]] = 0

    dm = wilder_smooth(dm, n)

    tr = wilder_smooth(truerange(ohlc, h=h, l=l, c=c), n)

    di = (dm ./ tr) .* 100
    di = rename(di, ["+di", "-di"])

    dx = @. abs((di["+di"] - di["-di"]) / (di["+di"] + di["-di"])) * 100
    adx = wilder_smooth(dx, n, dx=true)

    rename(merge(adx, merge(dx, di)), ["adx", "dx", "+di", "-di"])
end

doc"""
    stochasticoscillator(ohlc, n=14, fast_d=3, slow_d=3; h="High", l="Low", c="Close")

**Stochastic Oscillator**

A.k.a *%K%D*, or *KD*

**Parameter**

- `n`: period of fast(raw) `%K`

- `fast_d`: MA period of fast `%D`

- `slow_d`: MA period of slow `%D`

**Formula**

```math
    \begin{align*}
        fast\ \%K & = \frac{Close_t - \max(High_{t-n}, \dots, High_t)}
            {\max(High_{t-n}, \dots, High_t) - \min(Low_{t-n}, \dots, Low_t)}
            \times 100 \\
        fast\ \%D & = SMA(fast\ \%K) \\
        slow\ \%D & = SMA(fast\ \%D)
    \end{align*}
```

**Reference**

- [Wikipedia]
  (https://en.wikipedia.org/wiki/Stochastic_oscillator)

- [FMLabs]
  (http://www.fmlabs.com/reference/default.htm?url=StochasticOscillator.htm)
"""
function stochasticoscillator(ohlc::TimeArray, n::Integer=14, fast_d::Integer=3,
                              slow_d::Integer=3; h="High", l="Low", c="Close")
    high = moving(maximum, ohlc[h], n)
    low = moving(minimum, ohlc[l], n)
    fast_k = rename((ohlc[c] .- low) ./ (high .- low) .* 100, "fast_k")
    fast_d = rename(sma(fast_k, fast_d), "fast_d")
    slow_d = rename(sma(fast_d, slow_d), "slow_d")
    merge(merge(fast_k, fast_d), slow_d)
end


using Test, Astro

# earth tests from meeus chapter 11

print("Geodesic distance")
# geodesic distance between Paris and Washington observatories
# should be 6181.628423726299 km

d = geodesic_distance(deg2rad(dms_to_d(-2, 20, 14)),deg2rad(dms_to_d(48, 50, 11)), deg2rad(dms_to_d(77,3,56)), deg2rad(dms_to_d(38,55,17)))
@test isapprox(d, 6181.6, atol=.1)
println(" passed")

print("Geocentric latitude")
# p sin phi and p cos phi

r = geographical_to_geocentric_lat(deg2rad(dms_to_d(33, 21, 22)), 1706)
# TODO earth-tests.jl Is this accurate enough?
@test rad2deg(r[1]) ≈  33.356111 atol= .2# <<<----------------------?
@test isapprox(r[2], 0.546, atol=.1)
@test isapprox(r[3], 0.83, atol=.1)
println(" passed")


module MyInterpolations
export my_lin_interp
function my_lin_interp(grid,vals)
    function func(x::Real)
        if x <= grid[1]
            return (vals[2] - vals[1])/(grid[2] - grid[1])*(x - grid[1]) + vals[1]
        elseif x >= grid[end]
            return (vals[end] - vals[end-1])/(grid[end] - grid[end-1])*(x - grid[end]) + vals[end]
        else
            index = searchsortedlast(grid,x)
            return (vals[index+1] - vals[index])/(grid[index+1] - grid[index])*(x - grid[index]) + vals[index]
        end
    end
end
end


using sparsePolyChaos
using PolyChaos

###
### Multivariate sparse PCE
###
maxDeg = 10
interactions = 3

model(x,y) = (x^4 - 6 * x^2  + 3) + (x^2 - 1) * (y^2 - 1) + (y^3 - 3 * y) # He_4(x) + He_2(x) * He_2(y) + He_3(y)
# model(x,y) = (x^2 - 1) * (y^2 - 1) # He2(x) * He2(y)
# model(x,y) = (x^2 - 1) # He2(x)

### Setup and compute PCE coefficients of x ###
k = 2
op = GaussOrthoPoly(maxDeg)
mop = MultiOrthoPoly([op for i in 1:k], maxDeg)
L = dim(mop)

pce, Ap, p, R², Q² = sparsePCE(mop, model; pMax = maxDeg, jMax = interactions)

println("Basis polynomials: ", Ap)
println("PCE coefficients: ", pce)
println("Max degree:: ", p)
println("R² error: ", R²)
println("Q² error: ", Q²)


using ModelingToolkit, OrdinaryDiffEq, Test

@parameters t α β γ δ
@variables x(t) y(t)
D = Differential(t)

eqs = [D(x) ~ α*x - β*x*y,
       D(y) ~ -δ*y + γ*x*y]

sys = ODESystem(eqs)

u0 = [x => 1.0,
      y => 1.0]

p  = [α => 1.5,
      β => 1.0,
      δ => 3.0,
      γ => 1.0]

tspan = (0.0,10.0)
prob = ODEProblem(sys,u0,tspan,p)
sol = solve(prob,Tsit5())

sys2 = liouville_transform(sys)
@variables trJ

u0 = [x => 1.0,
      y => 1.0,
      trJ => 1.0]

prob = ODEProblem(sys2,u0,tspan,p,jac=true)
sol = solve(prob,Tsit5())
@test sol[end,end] ≈ 1.0742818931017244


@testset "Metropolis Hastings general" begin

    @testset "1D" begin
        Random.seed!(123456)
        prop(mu) = MvNormal(mu, 3)

        target(x) = log(pdf(MvNormal([2], 1), x))

        samps, acc = metropolis_hastings(target, prop, [2], 2000, 200)

        @test mean(samps) ≈ 2 atol = 0.1
        @test std(samps) ≈ 1 atol = 0.1
    end

    @testset "3D" begin
        Random.seed!(123456)
        prop(mu) = MvNormal(mu, [3 0 0; 0 3 0; 0 0 3])

        target(x) = log(pdf(MvNormal([-2, 2, 0], [1 0.5 0.5; 0.5 1 0.5; 0.5 0.5 1]), x))

        samps, acc = metropolis_hastings(target, prop, [-2, 2, 0], 2000, 200)

        μ = mean(samps, dims = 1)
        σ = std(samps, dims = 1)
        corrs = cor(samps)
        @test vec(μ) ≈ [-2; 2; 0] atol = 0.2
        @test vec(σ) ≈ [1; 1; 1] atol = 0.1
        @test corrs ≈ [1 0.5 0.5; 0.5 1 0.5; 0.5 0.5 1] atol = 0.2
    end

    @testset "No logged target" begin
        Random.seed!(123456)
        prop(mu) = MvNormal(mu, [3 0 0; 0 3 0; 0 0 3])

        target(x) = pdf(MvNormal([-2, 2, 0], [1 0.5 0.5; 0.5 1 0.5; 0.5 0.5 1]), x)

        samps, acc = metropolis_hastings(target, prop, [-2, 2, 0], 2000, 200, islogged = false)

        μ = mean(samps, dims = 1)
        σ = std(samps, dims = 1)
        corrs = cor(samps)
        @test vec(μ) ≈ [-2; 2; 0] atol = 0.2
        @test vec(σ) ≈ [1; 1; 1] atol = 0.1
        @test corrs ≈ [1 0.5 0.5; 0.5 1 0.5; 0.5 0.5 1] atol = 0.2
    end
end

@testset "Metropolis Hastings simple" begin

    @testset "1D" begin
        Random.seed!(123456)
        proprnd(mu) = rand(MvNormal(mu, 3))

        target(x) = log(pdf(MvNormal([2], 1), x))

        samps, acc = metropolis_hastings_simple(target, proprnd, [2], 2000, 200)

        @test mean(samps) ≈ 2 atol = 0.1
        @test std(samps) ≈ 1 atol = 0.1

    end

    @testset "3D" begin
        Random.seed!(123456)
        proprnd(mu) = rand(MvNormal(mu, [3 0 0; 0 3 0; 0 0 3]))

        target(x) = log(pdf(MvNormal([-2, 2, 0], [1 0.5 0.5; 0.5 1 0.5; 0.5 0.5 1]), x))

        samps, acc = metropolis_hastings_simple(target, proprnd, [-2,2, 0], 2000, 200)

        μ = mean(samps, dims = 1)
        σ = std(samps, dims = 1)
        corrs = cor(samps)
        @test vec(μ) ≈ [-2; 2; 0] atol = 0.2
        @test vec(σ) ≈ [1; 1; 1] atol = 0.1
        @test corrs ≈ [1 0.5 0.5; 0.5 1 0.5; 0.5 0.5 1] atol = 0.2

    end
    Random.seed!()
end


#############################################################################
# JuMP
# An algebraic modelling langauge for Julia
# See http://github.com/JuliaOpt/JuMP.jl
#############################################################################
# corr_sdp.jl
#
# Given three random variables A,B,C and given bounds on two of the three
# correlation coefficients:
# -0.2 <= ρ_AB <= -0.1
#  0.4 <= ρ_BC <=  0.5
# We can use the following property of the correlations:
# [  1    ρ_AB  ρ_AC ]
# [ ρ_AB   1    ρ_BC ]  ≽ 0
# [ ρ_AC  ρ_BC   1   ]
# To determine bounds on ρ_AC by solving a SDP
#############################################################################

using JuMP

m = Model()

@variable(m, X[1:3,1:3], SDP)

# Diagonal is 1s
@constraint(m, X[1,1] == 1)
@constraint(m, X[2,2] == 1)
@constraint(m, X[3,3] == 1)

# Bounds on the known correlations
@constraint(m, X[1,2] >= -0.2)
@constraint(m, X[1,2] <= -0.1)
@constraint(m, X[2,3] >=  0.4)
@constraint(m, X[2,3] <=  0.5)

# Find upper bound
@objective(m, Max, X[1,3])
solve(m)
println("Maximum value is ", getvalue(X)[1,3])
@assert +0.8719 <= getvalue(X)[1,3] <= +0.8720

# Find lower bound
@objective(m, Min, X[1,3])
solve(m)
println("Minimum value is ", getvalue(X)[1,3])
@assert -0.9779 >= getvalue(X)[1,3] >= -0.9799


module moo_functions

function quickavg(xs::Vector{Float64}; first::Int64 = 1, last::Int64 = length(xs))::Float64
    out = 0.0
    for k in first:last
        out += xs[k]
    end
    return out/(last - first + 1)
end

function zdt1(x::Vector{Float64})::Tuple{Float64, Float64}
    g  = 1.0 + 9.0*quickavg(x, first = 2)
    f1 = x[1]
    f2 = g * (1.0 - sqrt(f1/g))
    return (f1, f2)
end

function zdt2(x::Vector{Float64})::Tuple{Float64, Float64}
    g  = 1.0 + 9.0*quickavg(x, first = 2)
    f1 = x[1]
    f2 = g * (1.0 - (f1/g)^2)
    return (f1, f2)
end

function zdt3(x::Vector{Float64})::Tuple{Float64, Float64}
    g  = 1.0 + 9.0*quickavg(x, first = 2)
    f1 = x[1]
    f2 = g * (1.0 - sqrt(f1/g) - f1/g * sin(10*pi*f1))
    return (f1, f2)
end

function zdt4(x::Vector{Float64})::Tuple{Float64, Float64}
    g  = 1.0 + 10*(length(x)-1)
    for k in 2:length(x)
        g += x[k]^2 - 10*cos(4*pi*x[k])
    end
    f1 = x[1]
    f2 = g * (1.0 - sqrt(f1/g))
    return (f1, f2)
end

function zdt6(x::Vector{Float64})::Tuple{Float64, Float64}
    g  = 1.0 + 9.0*quickavg(x, first = 1)^0.25
    f1 = 1.0 - exp(-4.0*x[1])*sin(6*pi*x[1])^6
    f2 = g*(1.0 - (f1/g)^2)
    return (f1, f2)
end

function zdt()
    return Dict{Int8, Function}(
        1 => zdt1,
        2 => zdt2,
        3 => zdt3,
        4 => zdt4,
        6 => zdt6
    )
end

function opt_hvs()
    return Dict{Int8, Float64}(
        1 => 120.0 + 2/3,
        2 => 120.0 + 1/3,
        3 => 128.77811613069076060,
        4 => 120.0 + 2/3,
        6 => 117.51857519692037009,
    )
end

end


using TensorIntegration
using Test
using LinearAlgebra

@testset "Expectation of uniform by simpson rule, 1D/2D/3D" begin
    # add test for basic integrals
    N = 5
    # uniform expectation
    a = 1.
    b = 3.
    pdf(x, a, b) = 1.0 ./ (b-a)
    grid, weights = TensorIntegration.simpson(a, b, N)

    Exp = dot((grid.*pdf.(grid, a, b)),weights)
    @test Exp ≈ (a+b)/2.

    # now in 2d
    N2d = [5, 5]
    a2d = [1., 1.]
    b2d = [2., 2.]
    pdf(x, a, b, d) = 1.0 ./ (b[d]-a[d])

    grid, weights = TensorIntegration.tensor_simpson(a2d, b2d, N2d)
    Exp1 = dot((grid[:,1].*pdf(grid, a2d, b2d, 1)), weights)
    Exp2 = dot((grid[:,2].*pdf(grid, a2d, b2d, 2)), weights)

    @test Exp1[1] ≈ (a2d[1]+b2d[1])/2.
    @test Exp2[1] ≈ (a2d[2]+b2d[2])/2.

    # now in 3d
    N3d = [5, 5, 5]
    a3d = [1., 1., 0.1]
    b3d = [2., 2., 3.3]
    pdf(x, a::Array, b::Array) = 1.0 ./ prod(b3d.-a3d)

    grid, weights = TensorIntegration.tensor_simpson(a3d, b3d, N3d)
    Exp1 = dot((grid[:,1].*pdf(grid, a3d, b3d)), weights)
    Exp2 = dot((grid[:,2].*pdf(grid, a3d, b3d)), weights)
    Exp3 = dot((grid[:,3].*pdf(grid, a3d, b3d)), weights)

    @test isapprox(Exp1, (a3d[1]+b3d[1])/2.)
    @test isapprox(Exp2, (a3d[2]+b3d[2])/2.)
    @test isapprox(Exp3, (a3d[3]+b3d[3])/2.)

    # now with one dimension only 1 point
    N3d = [5, 5, 1]
    a3d = [1., 1., 1.]
    b3d = [2., 2., 2.]
    pdf(x, a::Array, b::Array) = 1.0 ./prod(b3d.-a3d)

    grid, weights = TensorIntegration.tensor_simpson(a3d, b3d, N3d)
    Exp1 = dot((grid[:,1].*pdf(grid, a3d, b3d)), weights)
    Exp2 = dot((grid[:,2].*pdf(grid, a3d, b3d)), weights)
    Exp3 = dot((grid[:,3].*pdf(grid, a3d, b3d)), weights)

    @test isapprox(Exp1, (a3d[1]+b3d[1])/2.)
    @test isapprox(Exp2, (a3d[2]+b3d[2])/2.)
    @test isapprox(Exp3, (a3d[3]+b3d[3])/2.)
end


export binary_search

function binary_search(array::Vector{T}, target::T) where T
    left = 1
    right = length(array)

    while left <= right
        mid = trunc(Int, left+(right-left)/2)
        if array[mid] > target
            right = mid-1
        elseif array[mid] < target
            left = mid+1
        else
            return mid
        end
    end

    return -1
end


### A Pluto.jl notebook ###
# v0.14.5

using Markdown
using InteractiveUtils

# ╔═╡ c930a0fa-4ef8-4963-b4b2-0d576ecdde7e
using Pkg, DrWatson

# ╔═╡ 919b41e5-7e43-45e0-8676-373b77ac6208
begin
	@quickactivate "NumericalMethodsforEngineers"
	using Roots, Plots
	using Symbolics, SymbolicUtils, Latexify, LaTeXStrings, ModelingToolkit
	using NumericalMethodsforEngineers, Test
end

# ╔═╡ c34bdc36-5013-4096-9cb2-581ad9e02239
md" ## f-03-01.jl"

# ╔═╡ 0b1514c5-eded-4f60-ac31-6f27a4deff1d
begin
	@variables f x
	f = exp(x) - x^4
	L(f)
end

# ╔═╡ 7c4288f0-38d9-4c39-b6b1-789aba5465b6
f_j = build_function(f, [x], expression=Val{false});

# ╔═╡ c7c87623-9c41-4a68-8673-47a71c67f083
begin
	y = -10.0:0.1:10.0
	plot(y, f_j.(y), leg=false)
	hline!([0.0])
	vline!([fzeros(f_j, [-1, 2])])
end

# ╔═╡ 2708dfb1-09dd-458c-8b5f-2e2ec3d800c4
begin
	D = Differential(x)
	fp_s = expand_derivatives(D(f))
	fp_j = build_function(fp_s, [x], expression=Val{false})
	L(fp_s)
end

# ╔═╡ 1dd78a44-b910-4bb2-8af0-9a1ab3ee4a51
Roots.newton(f_j, fp_j, 8)        # 8.6131694564414

# ╔═╡ 8054c3fd-3ecb-4c2a-b606-7fd518d750a3
begin
	fpp_s = expand_derivatives(D(D(f)))
	fpp_j = build_function(fpp_s, [x], expression=Val{false})
	L(fpp_s)
end

# ╔═╡ 7e2f4bd6-4f9a-4a72-8e70-e5fc56f806ee
halley(f_j, fp_j, fpp_j, 8)

# ╔═╡ 3e022154-6933-4ba7-8cf9-2d48d3cbb27f
secant_method(f_j, [8, 8.5])

# ╔═╡ 26cd9127-ae9e-4f09-97e4-d10f514e2164
md" ## End of f-03-01.jl"

# ╔═╡ Cell order:
# ╟─c34bdc36-5013-4096-9cb2-581ad9e02239
# ╠═c930a0fa-4ef8-4963-b4b2-0d576ecdde7e
# ╠═919b41e5-7e43-45e0-8676-373b77ac6208
# ╠═0b1514c5-eded-4f60-ac31-6f27a4deff1d
# ╠═7c4288f0-38d9-4c39-b6b1-789aba5465b6
# ╠═c7c87623-9c41-4a68-8673-47a71c67f083
# ╠═2708dfb1-09dd-458c-8b5f-2e2ec3d800c4
# ╠═1dd78a44-b910-4bb2-8af0-9a1ab3ee4a51
# ╠═8054c3fd-3ecb-4c2a-b606-7fd518d750a3
# ╠═7e2f4bd6-4f9a-4a72-8e70-e5fc56f806ee
# ╠═3e022154-6933-4ba7-8cf9-2d48d3cbb27f
# ╟─26cd9127-ae9e-4f09-97e4-d10f514e2164


using NewtonsMethod, LinearAlgebra
using Test

f(x)=-x^2; fp(x)=-2x
g(x)=2(x-4)^3; gp(x) = 6(x-4)^2
h(x)=x^3-2x^2-11x+12; hp(x)=3x^2-4x-11
n(x)=x^2+42.0; np(x)=2x
x₀=1.0; xb₀=one(BigFloat); x1=2.35287527; x2=2.35284172
tol=1E-6 # use manual tolerance for known-function tests

for x in [x₀, xb₀]
    @testset "Fns with known roots" begin
        @test norm(newtonroot(f, fp, x)[1]) < tol
        @test norm(newtonroot(g, gp, x)[1] - 4) < tol
        #known basins of attraction for h
        @test norm(newtonroot(h, hp, x1)[1] - 4) < tol
        @test norm(newtonroot(h, hp, x2)[1] + 3) < tol
        #nonconvergence
        @test newtonroot(n, np, x)[1]==nothing
    end

    @testset "Autodiff known fns" begin
        @test norm(newtonroot(f, x)[1]) < tol
        @test norm(newtonroot(g, x)[1] - 4.0) < tol
        @test norm(newtonroot(h, x1)[1] - 4.0) < tol
        @test norm(newtonroot(h, x2)[1] + 3.0) < tol
        @test newtonroot(n, x)[1]==nothing # redundant?
        @test newtonroot(n, x)==newtonroot(n, np, x) # test of f′=Diff(f)
    end
end

@testset "Maxiter, iter, tol" begin
    # expected nonconvergence behavior for complicated function and small maxiter
    @test newtonroot(h, hp, x1, maxiter=5)[1]==nothing
    @test newtonroot(h, x1, maxiter=5)[1]==nothing
    # OK to set tol as exactly 0 when NM yields exact root
    @test newtonroot(h, hp, x1, tol=0.0)[1] == 4.0
    @test newtonroot(h, x1, tol=0.0)[1] == 4.0
    # NM cannot get exact root, so tol=0 returns nothing when x has arbitrary precision
    @test newtonroot(f, fp, one(BigFloat), tol=0.0)[1] == nothing
    @test newtonroot(f, one(BigFloat), tol=0.0)[1] == nothing
    # when tol is nonzero, tol' > tol yields less precise estimate
    @test norm(newtonroot(f, fp, x₀, tol=1E-4)[1] - 0) > norm(newtonroot(f, fp, x₀, tol=1E-5)[1] - 0)
    # tests for iter. nonideal logic, i think.
    @test newtonroot(h, hp, x1, maxiter=0)[3]==1
    @test newtonroot(h, hp, x1, tol=Inf)[3]==1
end


module UnionFindAlgo

export UnionFind, union!, find, isconnected

"""
Union find with the *Weighted quick union* (WQU)
algorithm.

- `id`: the parent node's id
- `sz`: size of the tree
"""
mutable struct UnionFind
    id::Vector{Int}
    sz::Vector{Int}
    ncomp::Int
    UnionFind(n::Int) = new(collect(1:n), fill(1, n), n)
end

function UnionFind(data::NamedTuple)
    uf = UnionFind(data.nv)
    edges = data.edges
    for (p, q) in edges
        union!(uf, p, q)
    end
    uf
end

function union!(uf, p, q)
    i = find(uf, p)
    j = find(uf, q)
    i == j && return
    # weighted quick-union: always connect the root
    # of smaller tree to the root of the larger tree
    if (uf.sz[i] < uf.sz[j])
        uf.id[i] = j
        uf.sz[j] += uf.sz[i]
    else
        uf.id[j] = i
        uf.sz[i] += uf.sz[j]
    end
    uf.ncomp -= 1
    return nothing
end

"""
    find(uf, p)

Find the root of p. The component in WQUPC is defined by
the root of each node.

In theory path compression can help further flatten
the tree. There are two ways to conduct path compression:

1. find the root for `p` and then assign all nodes on the path
   from `p` to root to the newly found root. This requires running
   the `find` twice.
2. Directly change parent to grandparent, this will halve the
   height in the subtree. In code: `uf.id[i] = uf.id[uf.id[i]]`

In practice, the performance gain from path compression is not
significant. On `largeUF.txt`(V=1e6, E=2e6) approach (2) gives
about 1% improvement. The difference might be larger for larger
dataset.
"""
function find(uf, p)
    i = uf.id[p]
    while uf.id[i] != i
        # path compression: set parent to grandparent
        # this trick halves the subtree each time
        uf.id[i] = uf.id[uf.id[i]]
        # go to the parent node
        i = uf.id[i]
    end
    i
end

isconnected(uf, p, q) = find(uf, p) == find(uf, q)

end


# Test 0: Solve 1D Burgers Equation
# u(x,t)_t+(0.5*u²(x,t))_{x}=0
# u(0,x) = f0(x)

@testset "1D Scalar Algorithms" begin

using ConservationLawsDiffEq
using LinearAlgebra
using OrdinaryDiffEq

include("burgers.jl")
CL = ConservationLawsDiffEq

CFL = 0.5
Tend = 1.0
ul = 1.0
ur = 0.0
x0 = 0.0

prob1 = RiemannProblem(Burgers(), ul, ur, x0, 0.0)
sol_ana  = get_solution(prob1)

# First define the problem data (Jacobian is optional but useful)
Jf(u) = u           #Jacobian
f(u) = u^2/2        #Flux function

f0(x) = (x < x0) ? ul : ur

# Now discretizate the domain
mesh = Uniform1DFVMesh(50, [-3.0, 3.0])

function get_problem(alg::CL.AbstractFVAlgorithm, use_threads, mesh, Tend,CFL)
  # Now get a explicit semidiscretization (discrete in space) du_h(t)/dt = f_h(u_h(t))
  f_h = getSemiDiscretization(f,alg,mesh,[Dirichlet(;side=:Both)]; Df = Jf, use_threads = use_threads,numvars = 1)

  #Compute discrete initial data
  u0 = getInitialState(mesh,f0,use_threads = true)

  #Setup ODE problem for a time interval = [0.0,1.0]
  ode_prob = ODEProblem(f_h,u0,(0.0,Tend))

  #Setup callback in order to fix CFL constant value
  cb = getCFLCallback(f_h, CFL)

  #Estimate an initial dt
  dt = update_dt!(u0, f_h, CFL)
  return ode_prob, cb, dt
end

function test_Scheme(alg, maxerror, threaded_mode=true)
  println("Testing ",split("$alg","(")[1],": ")
  prob,cb,dt = get_problem(alg, false, mesh, Tend,CFL)
  @time sol = solve(prob,SSPRK22(); dt = dt, callback = cb, save_everystep = false)
  @test get_L1_error(sol_ana, fv_solution(sol,mesh)) < maxerror
  if threaded_mode
    println("in threaded mode: ")
    prob,cb,dt = get_problem(alg, true, mesh, Tend,CFL)
    @time sol1 = solve(prob,SSPRK22(); dt = dt, callback = cb, save_everystep = false)
    @test get_L1_error(sol_ana, fv_solution(sol1,mesh)) ≈ get_L1_error(sol_ana, fv_solution(sol,mesh))
  end
end

# Test Schemes relative error
test_Scheme(FVSKTScheme(), 0.048)
test_Scheme(LaxFriedrichsScheme(), 0.24)
test_Scheme(LocalLaxFriedrichsScheme(), 0.17, false)
test_Scheme(GlobalLaxFriedrichsScheme(), 0.24)
test_Scheme(LaxWendroffScheme(), 0.043)
test_Scheme(LaxWendroff2sScheme(), 0.088)
test_Scheme(FVCompWENOScheme(), 0.045)
test_Scheme(FVCompMWENOScheme(), 0.041)
test_Scheme(FVSpecMWENOScheme(), 0.028, false)
test_Scheme(FVCUScheme(), 0.039)
test_Scheme(FVDRCUScheme(), 0.039)
test_Scheme(FVDRCU5Scheme(), 0.053)

# Test dt and CFL callback
prob,cb,dt = get_problem(FVSKTScheme(), false, mesh, Tend,CFL)
@time sol = solve(prob,SSPRK22(); dt = dt, callback = cb, save_everystep = true)
@test sol.t == [0.0,0.05999999999999994,0.11999999999999988,0.17999999999999983,0.23999999999999977,
                0.2999999999999997,0.35999999999999965,0.4199999999999996,0.47999999999999954,
                0.5399999999999995,0.5999999999999994,0.6599999999999994,0.7199999999999993,
                0.7799999999999992,0.8399999999999992,0.8999999999999991,0.9599999999999991,1.0]
end


module NewtonsMethod

using ForwardDiff, LinearAlgebra

export newtonroot

function iterativesolver(f, x₀, checkconvergence, updatex)
    xold = x₀.*10
    fold = 10*f(x₀)
    xnew = x₀
    fnew = f(xnew)
    iter = 1
    while !checkconvergence(xold, xnew, fold, fnew, iter)
        xold = xnew
        xnew = updatex(f, xold)
        fold = fnew
        fnew = f(xnew)
        iter += 1
    end
    return(value = xnew, iter=iter)
end

function newtonroot(f, f′; x₀, tol=1e-7, maxiter=1000)
    res = iterativesolver(f,
                          x₀,
                          (xold, xnew, fold, fnew, iter) -> norm(xnew - xold) < 1e-4 || iter > maxiter,
                          (f, x) -> x - f(x) / f′(x))
    if res.iter <= maxiter
        return res
    else
        return (value = nothing, iter=res.iter)
    end
end

function newtonroot(f; x₀, tol=1e-7, maxiter=1000)
    return newtonroot(f, x -> ForwardDiff.derivative(f, x); x₀, tol, maxiter)
end

end


"""
    center(A)

Centers columns of a 2d array

# Arguments

- A = 2d array of floats

# Value

2d array of floats

"""
function center(A::AbstractArray{Float64,2})

    # Row means of A
    m = mean(A, dims=1)
    # Initialize centered matrix
    W = zeros(size(A))

    # Subtract column means
    W .= A .- m

    return W
end

"""
    cov_est(resid)

Estimates error variance and its variance/covariance

# Arguments

- resid = 2d array of floats consisting of the residuals

# Value

Tuple
- est: 2d array of floats; estimate
- varest: 2d array of floats; variance/covariance estimate

2d array of floats

"""
function cov_est(resid::AbstractArray{Float64,2})

    # Dimensions of residuals
    n = size(resid, 1)
    p = size(resid, 2)

    # Centered residual matrix
    W = center(resid)

    # Allocate space for the estimates and their variances
    est = zeros(p, p)
    varEst = zeros(p, p)

    # Loop through the possible entries
    for i = 1:p
        for j = i:p
            # Multiply the ith and jth columns
            ww = W[:,i].*W[:,j]

            if i==j # Diagonal elements
                est[i,i] = (n/(n-1)) * mean(ww)
                varEst[i,i] = (n/(n-1)^2) * var(ww)
            else # Non-diagonal elements
                est[i,j] = est[j,i] = (n/(n-1)) * mean(ww)
                varEst[i,j] = varEst[j,i] = (n/(n-1)^2) * var(ww)
            end

        end
    end

    return est, varEst
end

"""
    shrink_sigma(resid, targetType)

Estimates variance of errors and the shrinkage coefficient

# Arguments

- resid = 2d array of floats consisting of the residuals
- targetType = string indicating the target type toward which to shrink the
  variance. Acceptable inputs are "A", "B", "C", and "D".
    - "A": Target is identity matrix
    - "B": Target is diagonal matrix with constant diagonal
    - "C": Target is has same diagonal element, and same off-diagonal element
    - "D": Target is diagonal matrix with unequal entries

# Value

Tuple
- sigma: 2d array of floats; shrunk estimated variance of errors
- lambda: floating scalar; estimated shrinkage coefficient
  (0 = no shrinkage, 1 = complete shrinkage)

# Reference

Ledoit, O., & Wolf, M. (2003). Improved estimation of the covariance matrix
    of stock returns with an application to portfolio selection. Journal of
    empirical finance, 10(5), 603-621.

"""
function shrink_sigma(resid::AbstractArray{Float64,2}, targetType::String)

    # Dimensions of resid
    (n, p) = size(resid)

    # Estimates and the variance of the error variance
    (est, varEst) = cov_est(resid)

    if targetType=="A"  # Shrink to identity
        # Create identity target matrix
        T = Matrix{Float64}(I, p, p)
        # Estimate optimal lambda
        lambda = sum(varEst) / sum((est-T).^2)

    elseif targetType=="B"  # Shrink to common variance
        # Create target matrix
        T = Matrix{Float64}(I, p, p) * mean(diag(est))
        # Estimate optimal lambda
        lambda = sum(varEst) / sum((est-T).^2)

    elseif targetType=="C"  # Shrink to equal variance and covariance
        v = mean(diag(est))
        c = (sum(est) - sum(diag(est))) / (n*(n-1))
        # Create target matrix
        T = fill(c,(p,p)) + (v-c) * Matrix{Float64}(I, p, p)
        # Estimate optimal lambda
        lambda = sum(varEst) / sum((est-T).^2)

    elseif targetType=="D"  # Shrink to zero correlation
        v = diag(est)
        # Create target matrix
        T = diagm(0 => v)
        # Estimate optimal lambda
        lambda = (sum(varEst) - sum(diag(varEst))) /
                 (sum(est.^2) - sum(diag(est).^2))
    end

    return lambda*T + (1-lambda)*est, lambda
end


"""
Computes mean resultant vector length for circular data.

	1. α: sample of angles in radians
    - w: number of incidences in case of binned angle data
    - d: spacing of bin centers for binned data, used to correct for bias in estimation of r, in radians
    - dims: compute along this dimension(default=1)

	return: mean resultant length
"""
function circ_r(α; w = ones(size(α)), d = 0, dims = 1)
  # compute weighted sum of cos and sin of angles
  r = sum(w .* cis.(α); dims)

  # obtain length
  r = abs.(r) ./ sum(w; dims)

  # for data with known spacing, apply correction factor to correct for bias in the estimation of r (see Zar, p. 601, equ. 26.16)
  if d != 0
    c = d / 2 / sin(d / 2)
    r *= c
  end
  length(r) == 1 ? r[1] : r
end

"""
Computes the mean direction for circular data.

	1. α: sample of angles in radians
    - w: weightings in case of binned angle data
    - dims: compute along this dimension(default=1)

	return:
	- μ: mean direction
	- ul: upper 95% confidence limit
	- ll: lower 95% confidence limit
"""
function circ_mean(α; w = ones(size(α)), dims = 1)
  # compute weighted sum of cos and sin of angles
  r = sum(w .* cis.(α); dims)

  # obtain mean by
  μ = angle.(r)
  μ = length(μ) == 1 ? μ[1] : μ

  # confidence limits
  t = circ_confmean(α; xi = 0.05, w, d = 0, dims)
  ul = μ .+ t
  ll = μ .- t

  return (; μ, ul, ll)
end

"""
Transforms p-axial data to a common scale.

  1. α: sample of angles in radians
  2. p: number of modes(default=1)

  return: transformed data
"""
circ_axial(α, p = 1) = mod2pi.(α * p)

"""
Computes the median direction for circular data.

  1. α: sample of angles in radians

  return: median direction
"""
function circ_median(α::AbstractVector)
  α = mod2pi.(α)
  n = length(α)

  dd = circ_dist2(α)
  m1 = dropdims(count(>=(0), dd; dims = 1), dims = 1)
  m2 = dropdims(count(<=(0), dd; dims = 1), dims = 1)

  dm = abs.(m1 .- m2)
  m = minimum(dm)
  md = circ_mean(α[dm.==m]).μ
  αμ = circ_mean(α).μ
  if abs(circ_dist(αμ, md)) > abs(circ_dist(αμ, md + π))
    md = mod2pi(md + π)
  end
  return md
end

"""
Computes circular standard deviation for circular data (equ. 26.20, Zar).

	1. α: sample of angles in radians
   - w: weightings in case of binned angle data
   - d: spacing of bin centers for binned data, used to correct for bias in estimation of r, in radians
   - dims: compute along this dimension(default=1)

	return:
  - s: angular deviation
  - s0: circular standard deviation
"""
function circ_std(α; w = ones(size(α)), d = 0, dims = 1)
  # compute mean resultant vector length
  r = circ_r(α; w, d, dims)

  s = sqrt.(2 .* (1 .- r))      # 26.20
  s0 = sqrt.(-2 .* log.(r))   # 26.21
  return (; s, s0)
end

"""
Computes circular variance for circular data (equ. 26.17/18, Zar).

	1. α: sample of angles in radians
  - w: number of incidences in case of binned angle data
  - d: spacing of bin centers for binned data, used to correct for bias in estimation of r, in radians
	- dims: compute along this dimension(default=1)

	return:
	- S: circular variance 1-r
	- s: angular variance 2(1-r)
"""
function circ_var(α; w = ones(size(α)), d = 0, dims = 1)
  # compute mean resultant vector length
  r = circ_r(α; w, d, dims)

  # apply transformation to var
  S = 1 .- r
  s = 2 * S
  return (; S, s)
end

"""
Computes the confidence limits on the mean for circular data.

	1. α: sample of angles in radians
   - xi: (1-xi) confidence limits are computed, default=0.05
   - w: number of incidences in case of binned angle data
   - d: spacing of bin centers for binned data, used to correct for bias in estimation of r, in radians
   - dims: compute along this dimension(default=1)

	return: mean ± d yields upper/lower (1-xi)% confidence limit
"""
function circ_confmean(α; xi = 0.05, w = ones(size(α)), d = 0, dims = 1)
  # compute ingredients for conf. lim.
  r = circ_r(α; w, d, dims)
  n = sum(w; dims)
  R = n .* r
  c2 = quantile(Chisq(1), 1 - xi)

  # check for resultant vector length and select appropriate formula
  t = zeros(size(r))

  for i = 1:length(r)
    if r[i] < 0.9 && r[i] > sqrt(c2 / 2 / n[i])
      t[i] = sqrt((2 * n[i] * (2 * R[i]^2 - n[i] * c2)) / (4 * n[i] - c2))  # equ. 26.24
    elseif r[i] >= 0.9
      t[i] = sqrt(n[i]^2 - (n[i]^2 - R[i]^2) * exp(c2 / n[i]))      # equ. 26.25
    else
      t[i] = NaN
      @warn "Requirements for confidence levels not met."
    end
  end

  # apply final transform
  t = acos.(clamp.(t ./ R, -1, 1))
  t = length(t) == 1 ? t[1] : t
end

"""
Calculates a measure of angular skewness.

	1. α: sample of angles in radians
    - w: weightings in case of binned angle data
    - dims: compute along this dimension(default=1)

	return:
	- b: skewness (from Pewsey)
	- b0: alternative skewness measure (from Fisher)
"""
function circ_skewness(α; w = ones(size(α)), dims = 1)
  # compute neccessary values
  R = circ_r(α; w, d = 0, dims)
  θ = circ_mean(α; w, dims).μ
  _, ρ₂, μ₂ = circ_moment(α; w, p = 2, cent = false, dims)

  # compute skewness
  if ndims(θ) > 0
    θ₂ = repeat(θ, outer = Int.(size(α) ./ size(θ)))
  else
    θ₂ = θ
  end
  b = sum(w .* sin.(2 * circ_dist(α, θ₂)); dims) ./ sum(w; dims)
  b0 = ρ₂ .* sin.(circ_dist(μ₂, 2θ)) ./ (1 .- R) .^ (3 / 2)   # (formula 2.29)
  b = length(b) == 1 ? b[1] : b
  b0 = length(b0) == 1 ? b0[1] : b0
  return (; b, b0)
end

"""
Calculates a measure of angular kurtosis.

  1. α: sample of angles in radians
    - w: weightings in case of binned angle data
    - dims: compute along this dimension(default=1)

  return:
  - k: kurtosis (from Pewsey)
  - k0: kurtosis (from Fisher)
"""
function circ_kurtosis(α; w = ones(size(α)), dims = 1)
  # compute mean direction
  R = circ_r(α; w, d = 0, dims)
  θ = circ_mean(α; w, dims).μ
  _, ρ₂, _ = circ_moment(α; w, p = 2, cent = true, dims)
  _, _, μ₂ = circ_moment(α; w, p = 2, cent = false, dims)

  # compute skewness
  if ndims(θ) > 0
    θ₂ = repeat(θ, outer = Int.(size(α) ./ size(θ)))
  else
    θ₂ = θ
  end
  k = sum(w .* cos.(2 * circ_dist(α, θ₂)); dims) ./ sum(w; dims)
  k0 = (ρ₂ .* cos.(circ_dist(μ₂, 2θ)) .- R .^ 4) ./ (1 .- R) .^ 2    # (formula 2.30)
  k = length(k) == 1 ? k[1] : k
  k0 = length(k0) == 1 ? k0[1] : k0
  return (; k, k0)
end

"""
Calculates the complex p-th centred or non-centred moment of the angular data in angle.

  1. α: sample of angles in radians
   - w: number of incidences in case of binned angle data
   - p: p-th moment to be computed, default=1
   - cent: if true, central moments are computed, default = false
   - dims: compute along this dimension(default=1)

  return:
  - mp: complex p-th moment
  - ρp: magnitude of the p-th moment
  - μp: angle of th p-th moment
"""
function circ_moment(α; w = ones(size(α)), p = 1, cent = false, dims = 1)
  if cent
    θ = circ_mean(α; w, dims).μ
    if ndims(θ) > 0
      v = Int.(size(α) ./ size(θ))
      θ = repeat(θ, outer = v)
    end
    α = circ_dist(α, θ)
  end

  n = size(α, dims)
  c̄ = sum(cos.(p * α) .* w; dims) / n
  s̄ = sum(sin.(p * α) .* w; dims) / n
  mp = c̄ .+ im * s̄
  ρp = abs.(mp)
  μp = angle.(mp)
  mp = length(mp) == 1 ? mp[1] : mp
  ρp = length(ρp) == 1 ? ρp[1] : ρp
  μp = length(μp) == 1 ? μp[1] : μp
  return (; mp, ρp, μp)
end

"""
Pairwise difference α-β around the circle computed efficiently.

  1. α: sample of linear random variable
  2. β: sample of linear random variable or one single angle

  return: matrix with differences
"""
circ_dist(α, β) = angle.(cis.(α) ./ cis.(β))

"""
All pairwise difference α-β around the circle computed efficiently.

  1. α: sample of linear random variable
  2. β: sample of linear random variable

  return: matrix with pairwise differences
"""
circ_dist2(α) = circ_dist2(α, α)
circ_dist2(α, β) = angle.(cis.(α) ./ cis.(β'))

"""
Computes descriptive statistics for circular data.

  1. α: sample of angles in radians
    - w: weightings in case of binned angle data
    - d: spacing of bin centers for binned data, used to correct for bias in estimation of r, in radians

  return: descriptive statistics
"""
function circ_stats(α::AbstractVector; w = ones(size(α)), d = 0)
  # mean
  mean = circ_mean(α; w).μ
  # median
  median = circ_median(α)
  # variance
  var = circ_var(α; w, d)
  # standard deviation
  std, std0 = circ_std(α; w, d)
  # skewness
  skewness, skewness0 = circ_skewness(α; w)
  # kurtosis
  kurtosis, kurtosis0 = circ_kurtosis(α; w)

  return (; mean, median, var,std,std0, skewness,skewness0,kurtosis,kurtosis0)
end

"""
Computes Rayleigh test for non-uniformity of circular data.

	H0: the population is uniformly distributed around the circle
  HA: the populatoin is not distributed uniformly around the circle
	Assumption: the distribution has maximally one mode and the data is
							sampled from a von Mises distribution!

	1. α: sample of angles in radians
    - w: number of incidences in case of binned angle data
    - d: spacing of bin centers for binned data, used to correct for bias in estimation of r, in radians

	return:
	- p: p-value of Rayleigh's test
	- z: value of the z-statistic
"""
function circ_rtest(α; w = ones(size(α)), d = 0)
  r = circ_r(α; w, d)
  n = sum(w)

  # compute Rayleigh's R (equ. 27.1)
  R = n * r

  # compute Rayleigh's z (equ. 27.2)
  z = R^2 / n

  # compute p value using approxation in Zar, p. 617
  p = exp(sqrt(1 + 4n + 4(n^2 - R^2)) - (1 + 2n))
  return (; p, z)
end

"""
Computes Omnibus or Hodges-Ajne test for non-uniformity of circular data.

	H0: the population is uniformly distributed around the circle
	HA: the population is not distributed uniformly around the circle
	Alternative to the Rayleigh and Rao's test. Works well for unimodal,
	bimodal or multimodal data. If requirements of the Rayleigh test are met, the latter is more powerful.

	1. α: sample of angles in radians
    - sz: step size for evaluating distribution, default 1 degree
    - w: number of incidences in case of binned angle data

	return:
	- p: p-value
	- m: minimum number of samples falling in one half of the circle
"""
function circ_otest(α; sz = deg2rad(1), w = ones(size(α)))
  α = mod2pi.(α)
  n = sum(w)
  dg = 0:sz:π

  m1 = zeros(size(dg))
  m2 = zeros(size(dg))
  for i = 1:length(dg)
    m1[i] = sum((α .> dg[i]) .& (α .< π + dg[i]) .* w)
    m2[i] = n - m1[i]
  end
  m = min(minimum(m1), minimum(m2))

  if n > 50
    # approximation by Ajne (1968)
    A = π * sqrt(n) / 2 / (n - 2m)
    p = sqrt(2π) / A * exp(-π^2 / 8 / A^2)
  else
    # exact formula by Hodges (1955)
    # p = 2^(1-n) * (n-2m) * nchoosek(n,m)  # revised below for numerical stability
    p = exp((1 - n) * log(2) + log(n - 2m) + loggamma(n + 1) - loggamma(m + 1) - loggamma(n - m + 1))
  end
  return (; p, m)
end

"""
Calculates Rao's spacing test by comparing distances between points on a circle to those expected from a uniform distribution.
  H0: Data is distributed uniformly around the circle.
  H1: Data is not uniformly distributed around the circle.

  Alternative to the Rayleigh test and the Omnibus test. Less powerful
  than the Rayleigh test when the distribution is unimodal on a global scale but uniform locally.

  Due to the complexity of the distributioin of the test statistic, we resort to the tables published by
  Russell, Gerald S. and Levitin, Daniel J.(1995) An expanded table of probability values for rao's spacing test, Communications in Statistics - Simulation and Computation
  Therefore the reported p-value is the smallest α level at which the test would still be significant.
  If the test is not significant at the α=0.1 level, we return the critical value for α = 0.05 and p = 0.5.

  1. α: sample of angles in radians

  return:
  - p: smallest p-value at which test would be significant
  - u: computed value of the test-statistic u
  - UC: critical value of the test statistic at sig-level
"""
function circ_raotest(α)
  # for the purpose of the test, convert to angles
  α = sort(rad2deg.(α))
  n = length(α)

  # compute test statistic
  u = 0
  λ = 360 / n
  for j = 1:n-1
    ti = α[j+1] - α[j]
    u += abs(ti - λ)
  end

  tn = 360 - α[n] + α[1]
  u = 0.5(u + abs(tn - λ))

  getVal = (N, u) -> begin
      # Table II from Russel and Levitin, 1995
      α = [0.001, 0.01, 0.05, 0.10]
      table = [
        4 247.32 221.14 186.45 168.02
        5 245.19 211.93 183.44 168.66
        6 236.81 206.79 180.65 166.30
        7 229.46 202.55 177.83 165.05
        8 224.41 198.46 175.68 163.56
        9 219.52 195.27 173.68 162.36
        10 215.44 192.37 171.98 161.23
        11 211.87 189.88 170.45 160.24
        12 208.69 187.66 169.09 159.33
        13 205.87 185.68 167.87 158.50
        14 203.33 183.90 166.76 157.75
        15 201.04 182.28 165.75 157.06
        16 198.96 180.81 164.83 156.43
        17 197.05 179.46 163.98 155.84
        18 195.29 178.22 163.20 155.29
        19 193.67 177.08 162.47 154.78
        20 192.17 176.01 161.79 154.31
        21 190.78 175.02 161.16 153.86
        22 189.47 174.10 160.56 153.44
        23 188.25 173.23 160.01 153.05
        24 187.11 172.41 159.48 152.68
        25 186.03 171.64 158.99 152.32
        26 185.01 170.92 158.52 151.99
        27 184.05 170.23 158.07 151.67
        28 183.14 169.58 157.65 151.37
        29 182.28 168.96 157.25 151.08
        30 181.45 168.38 156.87 150.80
        35 177.88 165.81 155.19 149.59
        40 174.99 163.73 153.82 148.60
        45 172.58 162.00 152.68 147.76
        50 170.54 160.53 151.70 147.05
        75 163.60 155.49 148.34 144.56
        100 159.45 152.46 146.29 143.03
        150 154.51 148.84 143.83 141.18
        200 151.56 146.67 142.35 140.06
        300 148.06 144.09 140.57 138.71
        400 145.96 142.54 139.50 137.89
        500 144.54 141.48 138.77 137.33
        600 143.48 140.70 138.23 136.91
        700 142.66 140.09 137.80 136.59
        800 142.00 139.60 137.46 136.33
        900 141.45 139.19 137.18 136.11
        1000 140.99 138.84 136.94 135.92]

      ridx = findfirst(table[:, 1] .>= N)
      cidx = findfirst(table[ridx, 2:end] .< u)

      if isnothing(cidx)
        UC = table[ridx, end-1]
        p = 0.5
      else
        UC = table[ridx, cidx+1]
        p = α[cidx]
      end
      return p, UC
    end

  # get critical value from table
  p, UC = getVal(n, u)

  return (; p, u, UC)
end

"""
Computes V test for non-uniformity of circular data with a specified mean direction.

  H0: the population is uniformly distributed around the circle
  HA: the population is not distributed uniformly around the circle but has a mean of `m`.

  !!!note
    Not rejecting H0 may mean that the population is uniformly distributed around the circle OR
    that it has a mode but that this mode is not centered at `m`.

  The V test has more power than the Rayleigh test and is preferred if there is reason to believe in a specific mean direction.

  1. α: sample of angles in radians
  - m: suspected mean direction, default=0
  - w: number of incidences in case of binned angle data
  - d: spacing of bin centers for binned data, used to correct for bias in estimation of r, in radians

  return:
  - p: p-value of V test
  - v: value of the V statistic
"""
function circ_vtest(α; m = 0, w = ones(size(α)), d = 0)
  # compute some ingredients
  r = circ_r(α; w, d)
  μ, = circ_mean(α; w)
  n = sum(w)

  # compute Rayleigh's R (equ. 27.1)
  R = n * r

  # compute the V statistic (equ. 27.5)
  v = R * cos(μ - m)

  # compute u (equ. 27.6)
  u = v * sqrt(2 / n)

  # compute p-value from one tailed normal approximation
  p = 1 - cdf(Normal(), u)

  return (; p, v)
end

"""
Tests for significance of the median.

  H0: the population has median angle `md`
  HA: the population has not median angle `md`

  1. α: sample of angles in radians
  - md: median to test, default=0

  return: p-value
"""
function circ_medtest(α; md = 0)
  n = length(α)

  # compute deviations from median
  d = circ_dist(α, md)

  n1 = sum(d .< 0)
  n2 = sum(d .> 0)

  # compute p-value with binomial test
  sum(pdf.(Binomial(n, 0.5), [0:min(n1, n2); max(n1, n2):n]))
end

"""
One-Sample test for the mean angle.
  H0: the population has mean `m`.
  HA: the population has not mean `m`.

  !!!note: This is the equvivalent to a one-sample t-test with specified mean direction.

  1. α: sample of angles in radians
  - m: assumed mean direction, default=0
  - w: number of incidences in case of binned angle data
  - d: spacing of bin centers for binned data, used to correct for bias in estimation of r, in radians
  - xi: alpha level of the test

  return:
  - h: false if H0 can not be rejected, true otherwise
  - μ: mean
  - ul: upper (1-xi) confidence level
  - ll: lower (1-xi) confidence level
"""
function circ_mtest(α; xi = 0.05, m = 0, w = ones(size(α)), d = 0)
  # compute ingredients
  μ, = circ_mean(α; w)
  t = circ_confmean(α; xi, w, d)
  ul = μ + t
  ll = μ - t

  # compute test via confidence limits (example 27.3)
  h = abs(circ_dist2(m, μ)) > t

  return (; h, μ, ul, ll)
end

"""
Parametric Watson-Williams multi-sample test for equal means. Can be used as a one-way ANOVA test for circular data.

  H0: the s populations have equal means
  HA: the s populations have unequal means

  !!! note
  Use with binned data is only advisable if binning is finer than 10 deg.
  In this case, α is assumed to correspond to bin centers.

  The Watson-Williams two-sample test assumes underlying von-Mises distributrions.
  All groups are assumed to have a common concentration parameter k.

  1. α: angles in radians
  2. idx: indicates which population the respective angle in α comes from, 1:s
    - w: number of incidences in case of binned angle data

  return:
  - p: p-value of the Watson-Williams multi-sample test. Discard H0 if p is small.
  - F: F statistics
"""
function circ_wwtest(α, idx; w = ones(size(α)))
  # number of groups
  u = unique(idx)
  s = length(u)

  # number of samples
  n = sum(w)

  # compute relevant quantitites
  pn = zeros(s)
  pr = zeros(s)
  for t = 1:s
    pidx = idx .== u[t]
    pn[t] = sum(pidx .* w)
    pr[t] = circ_r(α[pidx]; w = w[pidx])
  end

  r = circ_r(α; w)
  rw = sum(pn .* pr) / n

  # make sure assumptions are satisfied
  checkAssumption =
    (rw, n) -> begin
      if n >= 11 && rw < 0.45
        @warn "Test not applicable. Average resultant vector length < 0.45."
      elseif n < 11 && n >= 7 && rw < 0.5
        @warn "Test not applicable. Average number of samples per population 6 < x < 11 and average resultant vector length < 0.5."
      elseif n >= 5 && n < 7 && rw < 0.55
        @warn "Test not applicable. Average number of samples per population 4 < x < 7 and average resultant vector length < 0.55."
      elseif n < 5
        @warn "Test not applicable. Average number of samples per population < 5."
      end
    end
  checkAssumption(rw, mean(pn))

  # test statistic
  kk = circ_kappa(rw)
  β = 1 + 3 / (8 * kk)    # correction factor
  A = sum(pr .* pn) - r * n
  B = n - sum(pr .* pn)

  F = β * (n - s) * A / (s - 1) / B
  # p = 1 - fcdf(F, s - 1, n - s)
  p = 1 - cdf(FDist(s - 1, n - s), F)

  # fprintf('\nANALYSIS OF VARIANCE TABLE (WATSON-WILLIAMS TEST)\n\n');
  # fprintf('%s\t\t\t\t%s\t%s\t\t%s\t\t%s\t\t\t%s\n', ' ' ,'d.f.', 'SS', 'MS', 'F', 'P-Value');
  # fprintf('--------------------------------------------------------------------\n');
  # fprintf('%s\t\t\t%u\t\t%.2f\t%.2f\t%.2f\t\t%.4f\n', 'Columns', s-1 , A, A/(s-1), F, pval);
  # fprintf('%s\t\t%u\t\t%.2f\t%.2f\n', 'Residual ', n-s, B, B/(n-s));
  # fprintf('--------------------------------------------------------------------\n');
  # fprintf('%s\t\t%u\t\t%.2f', 'Total   ',n-1,A+B);
  # fprintf('\n\n')

  # table = ["Source",'d.f.','SS','MS','F','P-Value';
  #          'Columns', s-1 , A, A/(s-1), F, pval;
  #          'Residual ', n-s, B, B/(n-s), [], [];
  #          'Total',n-1,A+B,[],[],[]]

  return (; p, F)
end

"""
Parametric two-way ANOVA for circular data with interations.

  !!!note
  The test assumes underlying von-Mises distributrions.
  All groups are assumed to have a common concentration parameter k, between 0 and 2.

  1. α: angles in radians
  2. idp: indicates the level of factor 1 (1:p)
  3. idq: indicates the level of factor 2 (1:q)
    - inter: whether to include effect of interaction
    - fn: string array containing names of the factors

  return:
  - p: pvalues for factors and interaction
  - s: statistic of each p value
"""
function circ_hktest(α, idp, idq; inter = true, fn = ['A', 'B'])
  # number of groups for every factor
  pu = unique(idp)
  p = length(pu)
  qu = unique(idq)
  q = length(qu)

  # number of samples
  n = length(α)

  # compute important sums for the test statistics
  cn = zeros(p, q)
  cr = zeros(p, q)
  pm = zeros(p)
  pr = zeros(p)
  pn = zeros(p)
  qm = zeros(q)
  qr = zeros(q)
  qn = zeros(q)
  for pp = 1:p
    p_id = idp .== pu[pp] # indices of factor1 = pp
    for qq = 1:q
      q_id = idq .== qu[qq] # indices of factor2 = qq
      idx = p_id .& q_id
      cn[pp, qq] = sum(idx)     # number of items in cell
      cr[pp, qq] = cn[pp, qq] * circ_r(α[idx]) # R of cell
    end
    # R and mean angle for factor 1
    pr[pp] = sum(p_id) * circ_r(α[p_id])
    pm[pp] = circ_mean(α[p_id]).μ
    pn[pp] = sum(p_id)
  end

  # R and mean angle for factor 2
  for qq = 1:q
    q_id = idq .== qu[qq]
    qr[qq] = sum(q_id) * circ_r(α[q_id])
    qm[qq] = circ_mean(α[q_id]).μ
    qn[qq] = sum(q_id)
  end

  # R and mean angle for whole sample (total)
  tr = n * circ_r(α)

  # estimate kappa
  kk = circ_kappa(tr / n)

  # different formulas for different width of the distribution
  if kk > 2
    # large kappa

    # effect of factor 1
    eff_1 = sum(pr .^ 2 ./ dropdims(sum(cn, dims = 2), dims = 2)) - tr .^ 2 / n
    df_1 = p - 1
    ms_1 = eff_1 / df_1

    # effect of factor 2
    eff_2 = sum(qr .^ 2 ./ dropdims(sum(cn, dims = 1), dims = 1)) - tr .^ 2 / n
    df_2 = q - 1
    ms_2 = eff_2 / df_2

    # total effect
    eff_t = n - tr .^ 2 / n
    df_t = n - 1

    m = mean(cn)

    if inter
      # correction factor for improved F statistic
      β = 1 / (1 - 1 / (5kk) - 1 / (10kk^2))

      # residual effects
      eff_r = n - sum(cr .^ 2 ./ cn)
      df_r = p * q * (m - 1)
      ms_r = eff_r / df_r

      # interaction effects
      eff_i =
        sum(cr .^ 2 ./ cn) - sum(qr .^ 2 ./ qn) - sum(pr .^ 2 ./ pn) +
        tr .^ 2 / n
      df_i = (p - 1) * (q - 1)
      ms_i = eff_i / df_i

      # interaction test statistic
      FI = ms_i / ms_r
      pI = 1 - cdf(FDist(df_i, df_r), FI)

    else
      # residual effect
      eff_r = n - sum(qr .^ 2 ./ qn) - sum(pr .^ 2 ./ pn) + tr .^ 2 / n
      df_r = (p - 1) * (q - 1)
      ms_r = eff_r / df_r

      # interaction effects
      eff_i = []
      df_i = []
      ms_i = []

      # interaction test statistic
      FI = []
      pI = NaN
      β = 1
    end

    # compute all test statistics as F = β * MS(A) / MS(R)
    F1 = β * ms_1 / ms_r
    p1 = 1 - cdf(FDist(df_1, df_r), F1)

    F2 = β * ms_2 / ms_r
    p2 = 1 - cdf(FDist(df_2, df_r), F2)
    s = [F1, F2, FI]
  else
    # small kappa

    # correction factor
    rr = besseli(1, kk) / besseli(0, kk)
    f = 2 / (1 - rr^2)

    chi1 = f * (sum(pr .^ 2 ./ pn) - tr .^ 2 / n)
    df_1 = 2 * (p - 1)
    p1 = 1 - cdf(Chisq(df_1), chi1)

    chi2 = f * (sum(qr .^ 2 ./ qn) - tr .^ 2 / n)
    df_2 = 2 * (q - 1)
    p2 = 1 - cdf(Chisq(df_2), chi2)

    chiI =
      f * (
        sum(cr .^ 2 ./ cn) - sum(pr .^ 2 ./ pn) - sum(qr .^ 2 ./ qn) +
        tr .^ 2 / n
      )
    df_i = (p - 1) * (q - 1)
    pI = 1 - cdf(Chisq(df_i), chiI)
    s = [chi1, chi2, chiI]
  end
  p = [p1, p2, pI]
  #
  # if kk>2
  #
  #   fprintf('\nANALYSIS OF VARIANCE TABLE (HIGH KAPPA MODE)\n\n');
  #
  #   fprintf('%s\t\t\t\t%s\t%s\t\t%s\t\t%s\t\t\t%s\n', ' ' ,'d.f.', 'SS', 'MS', 'F', 'P-Value');
  #   fprintf('--------------------------------------------------------------------\n');
  #   fprintf('%s\t\t\t\t%u\t\t%.2f\t%.2f\t%.2f\t\t%.4f\n', fn{1}, df_1 , eff_1, ms_1, F1, p1);
  #   fprintf('%s\t\t\t\t%u\t\t%.2f\t%.2f\t%.2f\t\t%.4f\n', fn{2}, df_2 , eff_2, ms_2, F2, p2);
  #   if (inter)
  #       fprintf('%s\t\t%u\t\t%.2f\t%.2f\t%.2f\t\t%.4f\n', 'Interaction', df_i , eff_i, ms_i, FI, pI);
  #   end
  #   fprintf('%s\t\t%u\t\t%.2f\t%.2f\n', 'Residual ', df_r, eff_r, ms_r);
  #   fprintf('--------------------------------------------------------------------\n');
  #   fprintf('%s\t\t%u\t\t%.2f', 'Total   ',df_t,eff_t);
  #   fprintf('\n\n')
  # else
  #   fprintf('\nANALYSIS OF VARIANCE TABLE (LOW KAPPA MODE)\n\n');
  #
  #   fprintf('%s\t\t\t\t%s\t%s\t\t\t%s\n', ' ' ,'d.f.', 'CHI2', 'P-Value');
  #   fprintf('--------------------------------------------------------------------\n');
  #   fprintf('%s\t\t\t\t%u\t\t%.2f\t\t\t%.4f\n', fn{1}, df_1 , chi1, p1);
  #   fprintf('%s\t\t\t\t%u\t\t%.2f\t\t\t%.4f\n', fn{2}, df_2 , chi2, p2);
  #   if (inter)
  #       fprintf('%s\t\t%u\t\t%.2f\t\t\t%.4f\n', 'Interaction', df_i , chiI, pI);
  #   end
  #   fprintf('--------------------------------------------------------------------\n');
  #   fprintf('\n\n')
  #
  # end
  return (; p, s)
end

"""
A parametric two-sample test to determine whether two concentration parameters are different.

  H0: The two concentration parameters are equal.
  HA: The two concentration parameters are different.

  Assumptions: both samples are drawn from von Mises type distributions and their joint resultant vector length should be > .7

  1. α₁: sample of angles in radians
  2. α₂: sample of angles in radians

  return:
  - p: p-value that samples have different concentrations
  - f: f-statistic calculated
"""
function circ_ktest(α₁, α₂)
  n1 = length(α₁)
  n2 = length(α₂)

  R1 = n1 * circ_r(α₁)
  R2 = n2 * circ_r(α₂)

  # make sure that r̄ > .7
  r̄ = (R1 + R2) / (n1 + n2)

  if r̄ < 0.7
    @warn "Resultant vector length should be > 0.7"
  end

  # calculate test statistic
  f = ((n2 - 1) * (n1 - R1)) / ((n1 - 1) * (n2 - R2))
  if f > 1
    p = 2 * (1 - cdf(FDist(n1, n2), f))
  else
    f = 1 / f
    p = 2 * (1 - cdf(FDist(n2, n1), f))
  end
  return (; p, f)
end

"""
Tests for symmetry about the median.
  H0: the population is symmetrical around the median
  HA: the population is not symmetrical around the median

  1. α: sample of angles in radians

  return: p-value
"""
function circ_symtest(α)
  # compute median
  md = circ_median(α)

  # compute deviations from median
  d = circ_dist(α, md)

  # compute wilcoxon sign rank test
  pvalue(SignedRankTest(d))
end

const kuipertable= [5	1.45800000000000	1.56500000000000	1.68200000000000	1.76300000000000	1.83800000000000	1.92000000000000	1.97000000000000;
                    6	1.47100000000000	1.58200000000000	1.71100000000000	1.79300000000000	1.86700000000000	1.95700000000000	2.02000000000000;
                    7	1.48300000000000	1.59800000000000	1.72700000000000	1.81400000000000	1.89400000000000	1.98700000000000	2.05100000000000;
                    8	1.49300000000000	1.60800000000000	1.74100000000000	1.83000000000000	1.91100000000000	2.00900000000000	2.07700000000000;
                    9	1.50000000000000	1.61800000000000	1.75200000000000	1.84300000000000	1.92600000000000	2.02700000000000	2.09700000000000;
                    10	1.50700000000000	1.62500000000000	1.76100000000000	1.85400000000000	1.93800000000000	2.04100000000000	2.11300000000000;
                    11	1.51300000000000	1.63100000000000	1.76900000000000	1.86200000000000	1.94800000000000	2.05300000000000	2.12600000000000;
                    12	1.51700000000000	1.63700000000000	1.77600000000000	1.87000000000000	1.95700000000000	2.06200000000000	2.13700000000000;
                    13	1.52200000000000	1.64200000000000	1.78200000000000	1.87600000000000	1.96400000000000	2.07100000000000	2.15400000000000;
                    14	1.52500000000000	1.64600000000000	1.78700000000000	1.88200000000000	1.97000000000000	2.07800000000000	2.15400000000000;
                    15	1.52900000000000	1.65000000000000	1.79100000000000	1.88700000000000	1.97600000000000	2.08500000000000	2.16100000000000;
                    16	1.53200000000000	1.65300000000000	1.79500000000000	1.89200000000000	1.98100000000000	2.09000000000000	2.16800000000000;
                    17	1.53400000000000	1.65700000000000	1.79900000000000	1.89600000000000	1.98600000000000	2.09600000000000	2.17300000000000;
                    18	1.53700000000000	1.65900000000000	1.80200000000000	1.89900000000000	1.99000000000000	2.10000000000000	2.17800000000000;
                    19	1.53900000000000	1.66200000000000	1.80500000000000	1.90300000000000	1.99300000000000	2.10400000000000	2.18300000000000;
                    20	1.54100000000000	1.66400000000000	1.80800000000000	1.90600000000000	1.99700000000000	2.10800000000000	2.18700000000000;
                    21	1.54300000000000	1.66700000000000	1.81000000000000	1.90800000000000	2	                2.11200000000000	2.19100000000000;
                    22	1.54500000000000	1.66900000000000	1.81300000000000	1.91100000000000	2.00300000000000	2.11500000000000	2.19400000000000;
                    23	1.54700000000000	1.67000000000000	1.81500000000000	1.91300000000000	2.00500000000000	2.11800000000000	2.19800000000000;
                    24	1.54900000000000	1.67200000000000	1.81700000000000	1.91600000000000	2.00800000000000	2.12100000000000	2.20100000000000;
                    25	1.55000000000000	1.67400000000000	1.81900000000000	1.91800000000000	2.01000000000000	2.12300000000000	2.20300000000000;
                    30	1.55600000000000	1.68100000000000	1.82600000000000	1.92600000000000	2.01900000000000	2.13400000000000	2.21500000000000;
                    35	1.56100000000000	1.68600000000000	1.83200000000000	1.93300000000000	2.02600000000000	2.14100000000000	2.22300000000000;
                    40	1.56500000000000	1.69000000000000	1.83700000000000	1.93800000000000	2.03200000000000	2.14800000000000	2.23000000000000;
                    45	1.56800000000000	1.69400000000000	1.84100000000000	1.94200000000000	2.03600000000000	2.15200000000000	2.23500000000000;
                    50	1.57100000000000	1.69700000000000	1.84400000000000	1.94600000000000	2.04000000000000	2.15700000000000	2.23900000000000;
                    100	1.58800000000000	1.71400000000000	1.86200000000000	1.96500000000000	2.06000000000000	2.17800000000000	2.26200000000000;
                    200	1.60000000000000	1.72600000000000	1.87600000000000	1.97900000000000	2.07500000000000	2.19400000000000	2.27900000000000;
                    500	1.61000000000000	1.73700000000000	1.88700000000000	1.99000000000000	2.08700000000000	2.20700000000000	2.29200000000000;
                    501	1.62000000000000	1.74700000000000	1.89800000000000	2.00100000000000	2.09800000000000	2.21800000000000	2.30300000000000]

"""
The Kuiper two-sample test tests whether the two samples differ significantly.
The difference can be in any property, such as mean location and dispersion.
It is a circular analogue of the Kolmogorov-Smirnov test.

  H0: The two distributions are identical.
  HA: The two distributions are different.

  1. α₁: sample of angles in radians
  2. α₂: sample of angles in radians
    - n: resolution at which the cdf are evaluated

  return:
  - p: p-value; the smallest of .10, .05, .02, .01, .005, .002, .001,
        for which the test statistic is still higher than the respective critical value.
        this is due to the use of tabulated values. if p>.1, pval is set to 1.
  - k: test statistic
  - K: critical value
"""
function circ_kuipertest(α₁, α₂; n = 100)
  n = length(α₁)
  m = length(α₂)

  # create cdfs of both samples
  ϕ₁, cdf1 = circ_samplecdf(α₁; n)
  _, cdf2 = circ_samplecdf(α₂; n)

  # maximal difference between sample cdfs
  dplus, gdpi = findmax([0; cdf1 .- cdf2])
  dminus, gdmi = findmax([0; cdf2 .- cdf1])

  # calculate k-statistic
  k = n * m * (dplus + dminus)

  # find p-value
  p, K = kuiperlookup(min(n, m), k / sqrt(n * m * (n + m)))
  K *= sqrt(n * m * (n + m))

  return (; p, k, K)
end

function kuiperlookup(n, k)
  α = [0.10, 0.05, 0.02, 0.01, 0.005, 0.002, 0.001]
  nn = kuipertable[:, 1]

  # find correct row of the table
  row = findfirst(n.==nn)
  if isnothing(row)
    # find closest value if no entry is present
    row = length(nn) - sum(n .< nn)
    if row == 0
      error("n too small.")
    else
      @warn "n=$n not found in table, using closest n=$(nn[row]) present."
    end
  end

  # find minimal p-value and test-statistic
  idx = findlast(kuipertable[row, 2:end] .< k)
  if isnothing(idx)
    p = 1
    K = NaN
  else
    p = α[idx]
    K = kuipertable[row, idx+1]
  end

  return (; p, K)
end

"""
Circular correlation coefficient for two circular random variables.

  1. α₁: sample of angles in radians
  2. α₂: sample of angles in radians

  return:
  - ρ: correlation coefficient
  - p: p-value
"""
function circ_corrcc(α₁, α₂)
  # compute mean directions
  n = length(α₁)
  ᾱ₁ = circ_mean(α₁).μ
  ᾱ₂ = circ_mean(α₂).μ

  # compute correlation coeffcient from p. 176
  num = sum(sin.(α₁ .- ᾱ₁) .* sin.(α₂ .- ᾱ₂))
  den = sqrt(sum(sin.(α₁ .- ᾱ₁) .^ 2) .* sum(sin.(α₂ .- ᾱ₂) .^ 2))
  ρ = num / den

  # compute pvalue
  l20 = mean(sin.(α₁ .- ᾱ₁) .^ 2)
  l02 = mean(sin.(α₂ .- ᾱ₂) .^ 2)
  l22 = mean((sin.(α₁ .- ᾱ₁) .^ 2) .* (sin.(α₂ .- ᾱ₂) .^ 2))

  ts = sqrt((n * l20 * l02) / l22) * ρ
  p = 2 * (1 - cdf(Normal(), abs(ts)))
  return (; ρ, p)
end

"""
Correlation coefficient between one circular and one linear random variable.

  1. α: sample of angles in radians
  2. x: sample of linear random variable

  return:
  - ρ: correlation coefficient
  - p: p-value
"""
function circ_corrcl(α, x)
  n = length(α)

  # compute correlation coefficent for sin and cos independently
  rxs = cor(x, sin.(α))
  rxc = cor(x, cos.(α))
  rcs = cor(sin.(α), cos.(α))

  # compute angular-linear correlation (equ. 27.47)
  ρ = sqrt((rxc^2 + rxs^2 - 2 * rxc * rxs * rcs) / (1 - rcs^2))

  # compute pvalue
  p = 1 - cdf(Chisq(2), n * ρ^2)
  return (; ρ, p)
end

"""
Computes an approximation to the ML estimate of the concentration parameter kappa of the von Mises distribution.

  1. α: angles in radians OR α is length resultant
    - w: number of incidences in case of binned angle data

  return: estimated value of kappa
"""
function circ_kappa(α; w = ones(size(α)))
  N = length(α)

  if N > 1
    R = circ_r(α; w)
  else
    R = α
  end

  if R < 0.53
    κ = 2R + R^3 + 5R^5 / 6
  elseif R >= 0.53 && R < 0.85
    κ = -0.4 + 1.39R + 0.43 / (1 - R)
  else
    κ = 1 / (R^3 - 4R^2 + 3R)
  end

  if N < 15 && N > 1
    if κ < 2
      κ = max(κ - 2 * (N * κ)^-1, 0)
    else
      κ = (N - 1)^3 * κ / (N^3 + N)
    end
  end
  κ
end

"""
Performs a simple agglomerative clustering of angular data.

1. α: sample of angles in radians
  - k: number of clusters desired, default=2

return:
- cid: cluster id for each entry of α
- α: sorted angles, matched with cid
- μ: mean direction of angles in each cluster
"""
function circ_clust(α; k = 2)

  n = length(α)
  n < k && error("Not enough data for clusters.")

  # prepare data
  cid = 1:n

  # main clustering loop
  num_unique = length(unique(cid))

  while (num_unique > k)

    # find centroid means...

    # calculate the means for each putative cluster
    μ = fill(NaN, n)
    for j = 1:n
      if sum(cid .== j) > 0
        μ[j], = circ_mean(α(cid .== j))
      end
    end

    # find distance between centroids...
    μdist = abs.(circ_dist2(μ))

    # find closest pair of clusters/datapoints
    mindist = minimum(μdist[tril(ones(size(μdist), size(μdist)), -1)==1])
    row, col = findall(μdist .== mindist)

    # update cluster id's
    cid[cid.==maximum(row)] = minimum(col)

    # update stop criteria
    num_unique = length(unique(cid))

  end

  # renumber cluster ids (so cids [1 3 7 10] => [1 2 3 4])
  cid2 = deepcopy(cid)
  uniquecids = unique(cid)
  for j = 1:length(uniquecids)
    cid[cid2.==uniquecids[j]] = j
  end

  # compute final cluster means
  μ = fill(NaN, num_unique)
  for j = 1:num_unique
    if sum(cid .== j) > 0
      μ[j], = circ_mean(α[cid.==j]')
    end
  end

  return (; cid, α, μ)
end

"""
Helper function for circ_kuipertest. Evaluates CDF of sample.

  1. α: sample of angles in radians
    - n: resolution at which the cdf are evaluated

  return:
  - ϕ: angles at which CDF are evaluated
  - c: CDF values at ϕ
"""
function circ_samplecdf(α; n = 100)
  ϕ = range(0, 2π, length = n + 1)

  # ensure all points in α are on interval [0, 2pi)
  α = sort(mod2pi.(α))

  dp = 1 / length(α) # incremental change in probability
  c = cumsum(map((l, r) -> dp * sum(l .<= α .< r), ϕ[1:end-1], ϕ[2:end]))
  ϕ = ϕ[1:end-1]

  return (; ϕ, c)
end


# # [Basic Epidemiology Models](@id epidemiology_example)
#
#md # [![](https://img.shields.io/badge/show-nbviewer-579ACA.svg)](@__NBVIEWER_ROOT_URL__/examples/covid/epidemiology.ipynb)

using AlgebraicPetri.Epidemiology

using Petri
using StochasticDiffEq
using Plots

using Catlab.Theories
using Catlab.CategoricalAlgebra.ShapeDiagrams
using Catlab.Graphics

display_wd(ex) = to_graphviz(ex, orientation=LeftToRight, labels=true);

# #### SIR Model:

# define model

sir = transmission ⋅ recovery

# get resulting petri net and visualize model

p_sir = decoration(F_epi(sir));
display_wd(sir)
#-
Graph(p_sir)

# define initial states and transition rates, then
# create, solve, and visualize ODE problem

u0 = [10.0, 1, 0];
p = [0.4, 0.4];

prob,cb = SDEProblem(p_sir,u0,(0.0,7.5),p);
sol = solve(prob,SRA1(),callback=cb)

plot(sol)

# #### SEIR Model:

# define model

sei = exposure ⋅ (illness ⊗ id(I)) ⋅ ∇(I)

seir = sei ⋅ recovery

# get resulting petri net and visualize model

p_seir = decoration(F_epi(seir));

display_wd(seir)
#-
Graph(p_seir)

# define initial states and transition rates, then
# create, solve, and visualize ODE problem

u0 = [10.0, 1, 0, 0];
p = [0.9, 0.2, 0.5];

prob,cb = SDEProblem(p_seir,u0,(0.0,15.0),p);
sol = solve(prob,SRA1(),callback=cb)

plot(sol)

# #### SEIRD Model:

# define model

seird = sei ⋅ Δ(I) ⋅ (death ⊗ recovery)

# get resulting petri net and visualize model

p_seird = decoration(F_epi(seird));

display_wd(seird)
#-
Graph(p_seird)

# define initial states and transition rates, then
# create, solve, and visualize ODE problem

u0 = [10.0, 1, 0, 0, 0];
p = [0.9, 0.2, 0.5, 0.1];

prob,cb = SDEProblem(p_seird,u0,(0.0,15.0),p);
sol = solve(prob,SRA1(),callback=cb)

plot(sol)