#Linear Kalman filter example
#This example closely follows that given on "Greg Czerniak's Website". Namely
#the voltage example on this page: http://greg.czerniak.info/guides/kalman1/

#Let's import the modules required to execute the Kalman Filter
using StateSpace
using Distributions
using DataFrames
using Gadfly
using Colors

#To use the Kalman Filter we need three things:
#1) Some observations
#2) The parameters of the Kalman Filter model describing the system process and
#the observation model.
#3) An initial guess of the state.
#
#The following code is split into those three sections to begin with. We finish
#by performing the Kalman Filter algorithm and finally displaying the results.

################################################################################
#Section: Generate noisy Observations
#-------------------------------------------------------------------------------
#Let's assume that the true voltage value does not change throughout the
#experiment. So we can give the true voltage a value
true_voltage = 1.25

#However our measurements of the true voltage are noisy. Here we assume that the
#noise is normally distributed with zero mean but non-zero variance:
measurement_noise_variance = 0.1

#Given this information we can generate some noisy data (observations). We'll
#also choose the number of observations
number_of_observations = 60
observations = randn(number_of_observations) * sqrt(measurement_noise_variance) + true_voltage

#Note that the observation list has to be transposed because each column of the
#matrix is considered as a new observation.
observations = observations'
#End Section: Generate noisy Observations
################################################################################

################################################################################
#Section: Describe Kalman Filter parameters
#-------------------------------------------------------------------------------
#Now that we have some observations we need to describe the Kalman Filter
#parameters:
#Process matrix - Note that since this is a one-dimensional system I've given
#a floating point value rather than explicitly declaring a matrix with one
#element, although you can do it that way. The value of 1.0 here means that the
#process model suggests that the previous state is the same as the next state.
#i.e. the voltage doesn't change.
process_matrix = 1.0

#Process Covariance - Since it's a single value, the covariance is the same as
#variance. We've made it small here because we are fairly sure of our process
#model that the state doesn't change. If we were less sure that the model was
#correct then we would increase this value.
process_covariance = 0.00001

#Observation matrix - Since we measure the voltage directly (we don't measure
#some quantity related by a function - i.e. we don't measure twice the voltage)
#the observation matrix is equal to 1.0
observation_matrix = 1.0

#Observation Covariance - we set the variance of the measurement noise earlier
#so we'll give it the same value.
observation_covariance = measurement_noise_variance

#Now we can create our Linear State Space Model
linSSM = LinearGaussianSSM(process_matrix, process_covariance, observation_matrix, observation_covariance)
#End Section: Describe Kalman Filter parameters
################################################################################

################################################################################
#Section: Set initial guess of the state
#-------------------------------------------------------------------------------
#We'll begin with a guess that's quite off. We'll assume an initial mean state
#of 3 (i.e. we think we have 3 volts) and give the variance as 1
initial_guess = MvNormal([3.0], [1.0])
#End Section: Set initial guess of the state
################################################################################

################################################################################
#Section: Execute Kalman Filter
#-------------------------------------------------------------------------------
#Now that we have some noisy observations, the Kalman filter parameters and an
#intial guess for the state of the system, we can run the Kalman Filter
filtered_state = filter(linSSM, observations, initial_guess)
#End Section: Execute Kalman Filter
################################################################################

################################################################################
#Section: Plot Filtered results
#-------------------------------------------------------------------------------
#Here we are plotting the filtered results with Gadfly. See the Gadfly
#documentation for information about how plotting works if you are unfamiliar.
#Website: http://gadflyjl.org/

x_data = 1:number_of_observations
state_array = Vector{Float64}(number_of_observations+1)
confidence_array = Vector{Float64}(number_of_observations+1)
state_array[1] = initial_guess.μ[1]
confidence_array[1] = 2*sqrt(initial_guess.Σ.diag[1])
for i in x_data
    current_state = filtered_state.state[i]
    state_array[i+1] = current_state.μ[1]
    confidence_array[i+1] = 2*sqrt(current_state.Σ.mat[1])
end
df_fs = DataFrame(
    x = [0;x_data],
    y = state_array,
    ymin = state_array - confidence_array,
    ymax = state_array + confidence_array,
    f = "Filtered values"
    )

n = 3
getColors = distinguishable_colors(n, Color[LCHab(70, 60, 240)],
                                   transform=c -> deuteranopic(c, 0.5),
                                   lchoices=Float64[65, 70, 75, 80],
                                   cchoices=Float64[0, 50, 60, 70],
                                   hchoices=linspace(0, 330, 24))
filtered_state_plot = plot(
    layer(x=x_data, y=filtered_state.observations, Geom.point, Theme(default_color=getColors[2])),
    layer(x=[0;x_data], y=ones(number_of_observations+1)*true_voltage, Geom.line, Theme(default_color=getColors[3])),
    layer(df_fs, x=:x, y=:y, ymin=:ymin, ymax=:ymax, Geom.line, Geom.ribbon),
    Guide.xlabel("Measurement Number"), Guide.ylabel("Voltage (Volts)"),
    Guide.manual_color_key("Colour Key",["Filtered Estimate", "Measurements","True Value "],[getColors[1],getColors[2],getColors[3]]),
    Guide.title("Linear Kalman Filter Example")
    )
display(filtered_state_plot)
#End Section: Plot Filtered results
################################################################################

################################################################################
#Section: Execute Kalman Smoother
#-------------------------------------------------------------------------------
#Everything can be performed much better in hindsight and that's essentially
#where the Kalman smoother comes in. Given all of the observations and the
#filtered state (including the Kalman filter parameters, the smoother attempts
#to give better estimates of the system's state. Here we perform smoothing on
#the filtered data.
smoothed_state = smooth(linSSM, filtered_state)
#End Section: Execute Kalman Filter
################################################################################

################################################################################
#Section: Plot Smoothed Results
#-------------------------------------------------------------------------------
#Here we are plotting the smoothed results with Gadfly. See the Gadfly
#documentation for information about how plotting works if you are unfamiliar.
#Website: http://gadflyjl.org/
state_array = Vector{Float64}(number_of_observations)
confidence_array = Vector{Float64}(number_of_observations)
for i in x_data
    current_state = smoothed_state.state[i]
    state_array[i] = current_state.μ[1]
    confidence_array[i] = 2*sqrt(current_state.Σ.mat[1])
end
df_ss = DataFrame(
    x = x_data,
    y = state_array,
    ymin = state_array - confidence_array,
    ymax = state_array + confidence_array,
    f = "Filtered values"
    )

smoothed_state_plot = plot(
    layer(x=x_data, y=smoothed_state.observations, Geom.point, Theme(default_color=getColors[2])),
    layer(x=x_data, y=ones(number_of_observations)*true_voltage, Geom.line, Theme(default_color=getColors[3])),
    layer(df_ss, x=:x, y=:y, ymin=:ymin, ymax=:ymax, Geom.line, Geom.ribbon),
    Guide.xlabel("Measurement Number"), Guide.ylabel("Voltage (Volts)"),
    Guide.manual_color_key("Colour Key",["Smoothed Estimate", "Measurements","True Value "],[getColors[1],getColors[2],getColors[3]]),
    Guide.title("Linear Kalman Smoother Example")
    )
display(smoothed_state_plot)
#End Section: Plot Filtered results
################################################################################


"""
    norm_data(A; dims=1, use_MAD::Bool=false, corrected::Bool=false)

Computes ``\\frac{A - \\bar A}{\\sigma}``, where `dims` is 1 (the default) if `A` is
column-oriented and 2 if it is row-oriented. If `use_MAD` is `true`, ``\\bar A`` is
`median(A, dims=dims)` and ``\\sigma`` is the MAD version of the standard deviation. If
`use_MAD` is `false`, ``\\bar A`` is `mean(A, dims=dims)` and ``\\sigma`` is the standard
deviation. If `corrected` is `true` then the sum is scaled with `n-1`, whereas the sum is
scaled with `n` if `corrected` is `false`, where `n = size(A, dims)`.
"""
function norm_data(A; dims=1, use_MAD=false, corrected=false)
    A = Matrix{Float64}(A)
    if use_MAD
        return (A .- median(A, dims=dims)) ./ mapslices(mad, A, dims=dims)
    else
        return (A .- mean(A, dims=dims)) ./ std(A, dims=dims, corrected=corrected)
    end
end

"""
    classic_PCA(A; dims=1, standardize::Bool=true, corrected::Bool=false)

Performs PCA on a copy of the ``m × n`` matrix `A`. `dims` is 1 (the default) if `A` is
column-oriented and 2 if it is row-oriented. If `standardize` is `true` (the default), the
copy will be transformed using the MAD version of the standard deviation. If `corrected`
is `true` then the sum is scaled with `n-1`, whereas the sum is scaled with `n` if
`corrected` is `false`, where `n = size(A, dims)`.

Returns `(V, S, prod)`, where ``A = U Σ V^*``, with ``Σ = \\text{diagm}(S)`` being the
diagonal matrix of singular values sorted in descending order and `prod` is the matrix
multiplication of `V` and `A`, with `A` being standardized by default.
"""
function classic_PCA(A; dims=1, standardize=true, corrected=false)
    data = copy(A)
    data = standardize ? norm_data(data, dims=dims, use_MAD=true, corrected=corrected) : data
    U, S, V = svd(cov(data, dims=dims, corrected=corrected))
    prod = dims == 1 ? data * V : V' * data
    return V, S, prod
end


@doc raw"""
    usinc(θ::Real)

Unnormalized version of `sinc` function, i.e. $\operatorname{usinc}(θ) = \frac{\sin(θ)}{θ}$.
This is equivalent to `sinc(θ/π)`.
"""
@inline usinc(θ::Real) = θ == 0 ? one(θ) : isinf(θ) ? zero(θ) : sin(θ) / θ

@doc raw"""
    usinc_from_cos(x::Real)

Unnormalized version of `sinc` function, i.e. $\operatorname{usinc}(θ) = \frac{\sin(θ)}{θ}$,
computed from $x = cos(θ)$.
"""
@inline function usinc_from_cos(x::Real)
    return if x >= 1
        one(x)
    elseif x <= -1
        zero(x)
    else
        sqrt(1 - x^2) / acos(x)
    end
end

@doc raw"""
    nzsign(z[, absz])

Compute a modified `sign(z)` that is always nonzero, i.e. where
````math
\operatorname(nzsign)(z) = \begin{cases}
    1 & \text{if } z = 0\\
    \frac{z}{|z|} & \text{otherwise}
\end{cases}
````
"""
@inline function nzsign(z, absz=abs(z))
    psignz = z / absz
    return ifelse(iszero(absz), one(psignz), psignz)
end

allocate(p, s::Size{S}) where {S} = similar(p, S...)
allocate(p::StaticArray, s::Size{S}) where {S} = similar(p, maybesize(s))
allocate(p, ::Type{T}, s::Size{S}) where {S,T} = similar(p, T, S...)
allocate(p::StaticArray, ::Type{T}, s::Size{S}) where {S,T} = similar(p, T, maybesize(s))

"""
    eigen_safe(x)

Compute the eigendecomposition of `x`. If `x` is a `StaticMatrix`, it is
converted to a `Matrix` before the decomposition.
"""
@inline eigen_safe(x; kwargs...) = eigen(x; kwargs...)
@inline function eigen_safe(x::StaticMatrix; kwargs...)
    s = size(x)
    E = eigen!(Matrix(parent(x)); kwargs...)
    return Eigen(SizedVector{s[1]}(E.values), SizedMatrix{s...}(E.vectors))
end

"""
    log_safe(x)

Compute the matrix logarithm of `x`. If `x` is a `StaticMatrix`, it is
converted to a `Matrix` before computing the log.
"""
@inline log_safe(x) = log(x)
@inline function log_safe(x::StaticMatrix)
    s = Size(x)
    return SizedMatrix{s[1],s[2]}(log(Matrix(parent(x))))
end

# NOTE: workaround until https://github.com/JuliaLang/julia/pull/39973 or similar is merged
"""
    log_safe!(y, x)

Compute the matrix logarithm of `x`. If the eltype of `y` is real, then the imaginary part
of `x` is ignored, and a `DomainError` is raised if `real(x)` has no real logarithm.
"""
function log_safe!(Y, A)
    if eltype(Y) <: Real
        if ishermitian(A)
            eigenF = eigen(Symmetric(real(A)))
            i = findfirst(≤(0), eigenF.values)
            if i !== nothing
                throw(
                    DomainError(
                        eigenF.values[i],
                        "All eigenvalues must be positive to compute a real logarithm.",
                    ),
                )
            end
            mul!(Y, eigenF.vectors .* log.(eigenF.values'), eigenF.vectors')
        elseif istriu(A)
            i = findfirst(≤(0), @view(A[diagind(A)]))
            if i !== nothing
                throw(
                    DomainError(
                        A[i, i],
                        "All eigenvalues must be positive to compute a real logarithm.",
                    ),
                )
            end
            copyto!(Y, real(log(UpperTriangular(A))))
        else
            schurF = schur(convert(Matrix, real(A)))
            i = findfirst(x -> isreal(x) && real(x) ≤ 0, schurF.values)
            if i !== nothing
                throw(
                    DomainError(
                        schurF.values[i],
                        "All eigenvalues must be positive to compute a real logarithm.",
                    ),
                )
            end
            if istriu(schurF.T)
                mul!(Y, schurF.Z, real(log(UpperTriangular(schurF.T))) * schurF.Z')
            else
                schurS = schur(complex(schurF.T))
                Y .= real.(schurS.Z * log(UpperTriangular(schurS.T)) * schurS.Z')
                mul!(Y, schurF.Z * Y, schurF.Z')
            end
        end
    else
        copyto!(Y, log_safe(A))
    end
    return Y
end

"""
    mul!_safe(Y, A, B) -> Y

Call `mul!` safely, that is, `A` and/or `B` are permitted to alias with `Y`.
"""
mul!_safe(Y, A, B) = (Y === A || Y === B) ? copyto!(Y, A * B) : mul!(Y, A, B)

@doc raw"""
    realify(X::AbstractMatrix{T𝔽}, 𝔽::AbstractNumbers) -> Y::AbstractMatrix{<:Real}

Given a matrix $X ∈ 𝔽^{n × n}$, compute $Y ∈ ℝ^{m × m}$, where $m = n \operatorname{dim}_𝔽$,
and $\operatorname{dim}_𝔽$ is the [`real_dimension`](@ref) of the number field $𝔽$, using
the map $ϕ \colon X ↦ Y$, that preserves the matrix product, so that for all
$C,D ∈ 𝔽^{n × n}$,
````math
ϕ(C) ϕ(D) = ϕ(CD).
````
See [`realify!`](@ref) for an in-place version, and [`unrealify!`](@ref) to compute the
inverse of $ϕ$.
"""
function realify(X, 𝔽)
    n = LinearAlgebra.checksquare(X)
    nℝ = real_dimension(𝔽) * n
    Y = allocate(X, real(eltype(X)), nℝ, nℝ)
    return realify!(Y, X, 𝔽, n)
end
realify(X, ::typeof(ℝ)) = X

"""
    realify!(Y::AbstractMatrix{<:Real}, X::AbstractMatrix{T𝔽}, 𝔽::AbstractNumbers)

In-place version of [`realify`](@ref).
"""
realify!(Y, X, 𝔽)

@doc raw"""
    realify!(Y::AbstractMatrix{<:Real}, X::AbstractMatrix{<:Complex}, ::typeof(ℂ))

Given a complex matrix $X = A + iB ∈ ℂ^{n × n}$, compute its realified matrix
$Y ∈ ℝ^{2n × 2n}$, written
where
````math
Y = \begin{pmatrix}A & -B \\ B & A \end{pmatrix}.
````
"""
function realify!(Y, X, ::typeof(ℂ), n=LinearAlgebra.checksquare(X))
    for i in 1:n, j in 1:n
        Xr, Xi = reim(X[i, j])
        Y[i, j] = Y[n + i, n + j] = Xr
        Y[n + i, j] = Xi
        Y[i, n + j] = -Xi
    end
    return Y
end

@doc raw"""
    unrealify!(X::AbstractMatrix{T𝔽}, Y::AbstractMatrix{<:Real}, 𝔽::AbstractNumbers[, n])

Given a real matrix $Y ∈ ℝ^{m × m}$, where $m = n \operatorname{dim}_𝔽$, and
$\operatorname{dim}_𝔽$ is the [`real_dimension`](@ref) of the number field $𝔽$, compute
in-place its equivalent matrix $X ∈ 𝔽^{n × n}$. Note that this function does not check that
$Y$ has a valid structure to be un-realified.

See [`realify!`](@ref) for the inverse of this function.
"""
unrealify!(X, Y, 𝔽)

function unrealify!(X, Y, ::typeof(ℂ), n=LinearAlgebra.checksquare(X))
    for i in 1:n, j in 1:n
        X[i, j] = complex((Y[i, j] + Y[n + i, n + j]) / 2, (Y[n + i, j] - Y[i, n + j]) / 2)
    end
    return X
end
unrealify!(Y, X, ::typeof(ℝ), args...) = copyto!(Y, X)

@generated maybesize(s::Size{S}) where {S} = prod(S) > 100 ? S : :(s)

"""
    select_from_tuple(t::NTuple{N, Any}, positions::Val{P})

Selects elements of tuple `t` at positions specified by the second argument.
For example `select_from_tuple(("a", "b", "c"), Val((3, 1, 1)))` returns
`("c", "a", "a")`.
"""
@generated function select_from_tuple(t::NTuple{N,Any}, positions::Val{P}) where {N,P}
    for k in P
        (k < 0 || k > N) && error("positions must be between 1 and $N")
    end
    return Expr(:tuple, [Expr(:ref, :t, k) for k in P]...)
end

@doc raw"""
    vec2skew!(X, v, k)

create a skew symmetric matrix inplace in `X` of size $k\times k$ from a vector `v`,
for example for `v=[1,2,3]` and `k=3` this
yields
````julia
[  0  1  2;
  -1  0  3;
  -2 -3  0
]
````
"""
function vec2skew!(X, v)
    k = size(X)[1]
    size(X)[2] != k && error("X is of wrong size, expected ($k,$k) got $(size(X)).")
    n = div(k * (k - 1), 2)
    length(v) < n && error("The vector $(v) is too short, expected $(n) got $(length(v)).")
    m = 0
    X .= [i < j ? (m += 1; v[m]) : zero(eltype(v)) for i in 1:k, j in 1:k]
    X .= X - X'
    return X
end
function vec2skew(v, k)
    X = similar(v, k, k)
    vec2skew!(X, v)
    return X
end

@doc raw"""
    isnormal(x; kwargs...) -> Bool

Check if the matrix or number `x` is normal, that is, if it commutes with its adjoint:
````math
x x^\mathrm{H} = x^\mathrm{H} x.
````
By default, this is an equality check. Provide `kwargs` for `isapprox` to perform an
approximate check.
"""
function isnormal(x; kwargs...)
    (isdiag(x) || ishermitian(x)) && return true
    isempty(kwargs) && return x * x' == x' * x
    return isapprox(x * x', x' * x; kwargs...)
end
isnormal(::LinearAlgebra.RealHermSymComplexHerm; kwargs...) = true

"""
    ziptuples(a, b[, c[, d[, e]]])

Zips tuples `a`, `b`, and remaining in a fast, type-stable way. If they have different
lengths, the result is trimmed to the length of the shorter tuple.
"""
@generated function ziptuples(a::NTuple{N,Any}, b::NTuple{M,Any}) where {N,M}
    ex = Expr(:tuple)
    for i in 1:min(N, M)
        push!(ex.args, :((a[$i], b[$i])))
    end
    return ex
end
@generated function ziptuples(
    a::NTuple{N,Any},
    b::NTuple{M,Any},
    c::NTuple{L,Any},
) where {N,M,L}
    ex = Expr(:tuple)
    for i in 1:min(N, M, L)
        push!(ex.args, :((a[$i], b[$i], c[$i])))
    end
    return ex
end
@generated function ziptuples(
    a::NTuple{N,Any},
    b::NTuple{M,Any},
    c::NTuple{L,Any},
    d::NTuple{K,Any},
) where {N,M,L,K}
    ex = Expr(:tuple)
    for i in 1:min(N, M, L, K)
        push!(ex.args, :((a[$i], b[$i], c[$i], d[$i])))
    end
    return ex
end
@generated function ziptuples(
    a::NTuple{N,Any},
    b::NTuple{M,Any},
    c::NTuple{L,Any},
    d::NTuple{K,Any},
    e::NTuple{J,Any},
) where {N,M,L,K,J}
    ex = Expr(:tuple)
    for i in 1:min(N, M, L, K, J)
        push!(ex.args, :((a[$i], b[$i], c[$i], d[$i], e[$i])))
    end
    return ex
end


### A Pluto.jl notebook ###
# v0.19.4

using Markdown
using InteractiveUtils

# This Pluto notebook uses @bind for interactivity. When running this notebook outside of Pluto, the following 'mock version' of @bind gives bound variables a default value (instead of an error).
macro bind(def, element)
    quote
        local iv = try Base.loaded_modules[Base.PkgId(Base.UUID("6e696c72-6542-2067-7265-42206c756150"), "AbstractPlutoDingetjes")].Bonds.initial_value catch; b -> missing; end
        local el = $(esc(element))
        global $(esc(def)) = Core.applicable(Base.get, el) ? Base.get(el) : iv(el)
        el
    end
end

# ╔═╡ 7c860884-5afd-4b4a-b358-4f2bce8bd395
using Pkg; Pkg.activate("../..")

# ╔═╡ 38c4e220-d708-11ec-3968-fbbd41c26155
using PlutoUI, Plots, DifferentialEquations, NonLinearDynamicsCourse

# ╔═╡ 2ac364c2-cbdd-49b4-9f26-9fe89382be5e
TableOfContents(title="📚 Table of Contents", indent=true, depth=4, aside=true)

# ╔═╡ 6b6a5e19-5298-4969-b1c9-699aa1cb2996
html"""

"""

# ╔═╡ 62cba86d-4406-4d16-8715-b29bee7d3178
md"""
# Logistic Equation

$\dot{x}=Rx\left(1-\frac{x}{K}\right)$
"""

# ╔═╡ 6d64cc27-1059-4dd7-8f17-1c6fd9a2eca0
html"""

"""

# ╔═╡ 4dc32b5a-5794-4d2d-844e-cdb80bec2e7b
logistic(x,p,t)=p[1]*x*(1.0-x/p[2])

# ╔═╡ 77766c99-4142-4acb-a855-ab133e67aa66
@bind pars2 (
	PlutoUI.combine() do bind
		md"""
		R: $(bind(Slider(0:0.02:2.0,default=0.1;show_value=true))) \
		K: $(bind(Slider(0.01:0.02:2.0,default=0.1;show_value=true))) \
		x0: $(bind(Slider(0:0.02:2.0,default=0.1;show_value=true)))
		"""
	end
)

# ╔═╡ 16a156b5-92ab-4e1c-ab70-c3b348186c57
flux1D(logistic,pars2[3],100.0,pars2;xlims=[-0.1,2.0],title="Logistic")

# ╔═╡ ce4da9bf-316b-45d2-8504-f2a63cdda247
md"""
# Logistic Equation with Harvest

$\dot{x}=Rx\left(1-\frac{x}{K}\right)-H$
"""

# ╔═╡ 29474ca0-839b-45de-a7bf-7d91c5ea59aa
logharvest1(x,p,t)=p[1]*x*(1.0-x/p[2])-p[3]

# ╔═╡ 8fc407f4-a242-4cdc-b7e0-062c8f5782d1
@bind pars_harvest (
	PlutoUI.combine() do bind
		md"""
		R: $(bind(Slider(0:0.02:2.0,default=0.1;show_value=true))) \
		K: $(bind(Slider(0.01:0.02:2.0,default=0.1;show_value=true))) \
		H: $(bind(Slider(0.01:0.02:2.0,default=0.1;show_value=true))) \
		x0: $(bind(Slider(0:0.02:2.0,default=0.1;show_value=true)))
		"""
	end
)

# ╔═╡ 794936ae-d9ae-4319-994f-4282c99c4238
flux1D(logharvest1,pars_harvest[4],300.0,pars_harvest,(u)->(u<0);xlims=[0.0,2.0],title="Logistic with Harvest")

# ╔═╡ b13d261e-1c1b-41b0-ae86-e20cd2304727
md"""
## Critical Slowing Down
"""

# ╔═╡ c3757398-060c-412c-997b-58331b2dee04
@bind pars_csd (
	PlutoUI.combine() do bind
		md"""
		H: $(bind(Slider(0.2:0.002:0.25,default=0.1;show_value=true))) \
		S: $(bind(Slider(0:0.001:0.1,default=0.0;show_value=true)))
		"""
	end
)

# ╔═╡ f1f04dd4-0447-4e48-9bab-f34058a6a0f1
flux1D(logharvest1,0.5+sqrt(0.25-pars_csd[1]),200.0,[1.0,1.0,pars_csd[1]],10.0,pars_csd[2],(u)->(u<0);xlims=[0.0,1.0],title="Log whith Harvest perturbed")

# ╔═╡ c803ed90-958c-4d0e-84d5-3e8cc9c8fbfe
md"""
# Consumer Equation

$\dot{x} = Rx\left(1-\frac{x}{K}\right) - Px$
"""

# ╔═╡ b4ea8364-a582-443c-bdb1-46e75a5c4d4e
# Consumer Equation
consumer(x,p,t)=p[1]*x*(1.0-x/p[2])-p[3]*x

# ╔═╡ 5afa3aff-af15-429b-a0fb-9a0dfcad740d
@bind pars_consumer (
	PlutoUI.combine() do bind
		md"""
		R: $(bind(Slider(0:0.02:1.0,default=0.1;show_value=true))) \
		K: $(bind(Slider(0.01:0.02:2.0,default=0.1;show_value=true))) \
		P: $(bind(Slider(0.0:0.01:0.5,default=0.1;show_value=true))) \
		x0: $(bind(Slider(0:0.02:2.0,default=0.1;show_value=true)))
		"""
	end
)

# ╔═╡ 5018d342-0a51-4275-8c0f-1b5d253c2ec0
flux1D(consumer,pars_consumer[4],300.0,pars_consumer,xlims=[0.0,2.0],title="Consumer Equation")

# ╔═╡ 84a596c1-3a0a-4edd-a7ea-f3fcd8839c2a
md"""
# Logistic Equation with Outbreak

$\dot{x} = Rx\left(1-\displaystyle\frac{x}{K}\right)-P\displaystyle\frac{x^2}{1+x^2}$
"""

# ╔═╡ 91b2718a-a921-4bae-99c0-91ec9c7e6479
html"""

"""

# ╔═╡ 5a0b156e-b0b2-43b8-b15e-bcdb65c154bf
logoutbreak(x,p,t)=p[1]*x*(1.0-x/p[2])-p[3]*x*x/(1+x*x)

# ╔═╡ 6528501f-3bb2-48a7-b24e-d32400033538
@bind pars_outbreak (
	PlutoUI.combine() do bind
		md"""
		R: $(bind(Slider(0:0.02:2.0,default=0.1;show_value=true))) \
		K: $(bind(Slider(0.01:0.02:10.0,default=0.1;show_value=true))) \
		P: $(bind(Slider(0.0:0.01:1.0,default=0.1;show_value=true))) \
		x0: $(bind(Slider(0:0.02:8.0,default=0.1;show_value=true)))
		"""
	end
)

# ╔═╡ a3270d8b-f167-4fb9-bcc5-c62c91b39649
flux1D(logoutbreak,pars_outbreak[4],300.0,pars_outbreak;xlims=[-0.2,8.0],title="Log with Outbreak")

# ╔═╡ 0d0d6d2f-56b2-4e01-b9a4-6e469eac90ad
html"""

"""

# ╔═╡ 76cfd5c8-6298-4ae2-9d2d-9e60deb12f49
html"""

"""

# ╔═╡ 0bf40552-b627-4fa7-b3ba-1d8c7ed4a568
html"""

"""

# ╔═╡ Cell order:
# ╟─7c860884-5afd-4b4a-b358-4f2bce8bd395
# ╠═38c4e220-d708-11ec-3968-fbbd41c26155
# ╟─2ac364c2-cbdd-49b4-9f26-9fe89382be5e
# ╟─6b6a5e19-5298-4969-b1c9-699aa1cb2996
# ╟─62cba86d-4406-4d16-8715-b29bee7d3178
# ╟─6d64cc27-1059-4dd7-8f17-1c6fd9a2eca0
# ╠═4dc32b5a-5794-4d2d-844e-cdb80bec2e7b
# ╟─16a156b5-92ab-4e1c-ab70-c3b348186c57
# ╟─77766c99-4142-4acb-a855-ab133e67aa66
# ╟─ce4da9bf-316b-45d2-8504-f2a63cdda247
# ╠═29474ca0-839b-45de-a7bf-7d91c5ea59aa
# ╟─794936ae-d9ae-4319-994f-4282c99c4238
# ╟─8fc407f4-a242-4cdc-b7e0-062c8f5782d1
# ╟─b13d261e-1c1b-41b0-ae86-e20cd2304727
# ╟─f1f04dd4-0447-4e48-9bab-f34058a6a0f1
# ╟─c3757398-060c-412c-997b-58331b2dee04
# ╟─c803ed90-958c-4d0e-84d5-3e8cc9c8fbfe
# ╠═b4ea8364-a582-443c-bdb1-46e75a5c4d4e
# ╟─5018d342-0a51-4275-8c0f-1b5d253c2ec0
# ╟─5afa3aff-af15-429b-a0fb-9a0dfcad740d
# ╟─84a596c1-3a0a-4edd-a7ea-f3fcd8839c2a
# ╟─91b2718a-a921-4bae-99c0-91ec9c7e6479
# ╠═5a0b156e-b0b2-43b8-b15e-bcdb65c154bf
# ╟─a3270d8b-f167-4fb9-bcc5-c62c91b39649
# ╟─6528501f-3bb2-48a7-b24e-d32400033538
# ╟─0d0d6d2f-56b2-4e01-b9a4-6e469eac90ad
# ╟─76cfd5c8-6298-4ae2-9d2d-9e60deb12f49
# ╟─0bf40552-b627-4fa7-b3ba-1d8c7ed4a568


#=
Created on Wednesday 18 March 2020
Last update: Tuesday 23 March 2020

@author: Michiel Stock
michielfmstock@gmail.com

This is an illustration of solving the Krontrovich formulation of the optimal
transport problem. It also demonstrates the use of Convex.jl, a package for
convex optimization problems.
=#

using Convex, SCS

# first give the problem parameters, we use the dessert problem

# portions per person
a = [3.0, 3, 3, 4, 2, 2, 2, 1]
# quantities of each dessert
b = [4.0, 2, 6, 4, 4]

# should both have the same sum
@assert sum(a) ≈ sum(b)

preferences = [2 2 1 0 0;
              0 -2 -2 -2 2;
              1 2 2 2 -1;
              2 1 0 1 -1;
              0.5 2 2 1 0;
              0 1 1 1 -1;
             -2 2 2 1 1;
              2 1 2 1 -1]

C = -preferences

n, m = size(C)

P = Variable(n, m)

problem = minimize(sum(P .* C),  # objective
                    P >= 0,  # non-neg constraints
                    P * ones(m) == a,  # row marginals
                    P' * ones(n) == b)  # column marginals

solve!(problem, () -> SCS.Optimizer(verbose=false))

pstar = problem.optval  # best objective
Pstar = P.value  # distribution

using StatsPlots

groupedbar(Pstar, bar_position = :stack, title="Optimal distribution desserts\nobjective = $pstar")

savefig("figures/kantovorisc.png")


#=##############################################################################
# DESCRIPTION
    Methods for generation of conic sections
# AUTHORSHIP
  * Author    : Eduardo J Alvarez
  * Email     : Edo.AlvarezR@gmail.com
  * Created   : Sep 2019
  * License   : MIT License
=###############################################################################

"""
    `line_intersect(x1, y1, x2, y2, x3, y3, x4, y4)`

    Returns the intersect between two lines, with the first line
passing through the points `(x1, y1), (x2, y2)`, and the second line passing
through the points `(x3, y3), (x4, y4)`.
"""
function line_intersect(x1, y1, x2, y2, x3, y3, x4, y4)
    Px = (
            (x1*y2-y1*x2)*(x3-x4) - (x1-x2)*(x3*y4 - y3*x4)
         ) / (
            (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
         )
    Py = (
            (x1*y2-y1*x2)*(y3-y4) - (y1-y2)*(x3*y4-y3*x4)
         ) / (
            (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
         )

    return Px, Py
end

"""
    `generate_conic_fun(Ax::Real, Ay::Real, Bx::Real, By::Real, Cx::Real, Cy::Real, Sx::Real, Sy::Real)`

     Returns a conic curve function with control point A, B, and C, and shoulder point S.
        See Raymer's Aircraft Design, lofting chapter (p. 128).
"""
function generate_conic_fun(Ax::Real, Ay::Real, Bx::Real, By::Real,
                            Cx::Real, Cy::Real, Sx::Real, Sy::Real)

    """
        Receives a value between 0 and 1, and returns the
    corresponding point along the conic curve, with 0 being A
    and 1 B.
    """
    function conic_fun(s)
        if s<0 || s>1
            error("Invalid conic parameter $s. Value between 0 and 1 expected.")
        end

        # D: Point in between A and B
        Dx = Ax + s*(Bx-Ax)
        Dy = Ay + s*(By-Ay)

        # E: Intersect between AS and CD
        Ex, Ey = line_intersect(Ax, Ay, Sx, Sy, Cx, Cy, Dx, Dy)

        # F: Intersect between BS and CD
        Fx, Fy = line_intersect(Bx, By, Sx, Sy, Cx, Cy, Dx, Dy)

        # P: Intersect between AF and BE
        Px, Py = line_intersect(Ax, Ay, Fx, Fy, Bx, By, Ex, Ey)

        return Px, Py
    end

    return conic_fun
end

"""
    `generate_conic_fun(Ax::Real, Ay::Real, Bx::Real, By::Real, Cx::Real, Cy::Real, rho::Real)`

    Returns a conic curve function with control point A, B, and C, and shape parameter rho.
        See Raymer's Aircraft Design, lofting chapter (p. 132).

    Hyperbola: rho > 0.5
    Parabola:  rho = 0.5
    Ellipse:   rho < 0.5
    Circle:    rho = 0.4142 and AC = BC
"""
function generate_conic_fun(Ax::Real, Ay::Real, Bx::Real, By::Real,
                            Cx::Real, Cy::Real, rho::Real)

    # D: Midpoint between A and B
    Dx = Ax + 0.5*(Bx-Ax)
    Dy = Ay + 0.5*(By-Ay)

    # S: Shoulder point in between D and C
    Sx = Dx + rho*(Cx-Dx)
    Sy = Dy + rho*(Cy-Dy)

    return generate_conic_fun(Ax, Ay, Bx, By, Cx, Cy, Sx, Sy)
end

"""
    `conic_cross_section(Ps::Array{Array{T1, 1},1}, CPs::Array{Array{T2, 1},1},
rhos::Array{T3, 1}, ss::Array{Array{T4, 1},1})`

    Receives a collection of points `Ps` along an open contour, and
stretching control points `CPs`, shape parameters `rhos`, and probing
parameters `ss` associated to every section of the contour, and it returns
a compound-conic cross section (it is a closed loop, so the number of
sections is equal to the number of points)
"""
function conic_cross_section(Ps::Array{Array{T1, 1},1},
                             CPs::Array{Array{T2, 1},1},
                             rhos::Array{T3, 1},
                             ss::Array{Array{T4, 1},1}
                            ) where {T1<:Real, T2<:Real, T3<:Real, T4<:Real}
    nPs = size(Ps, 1)

    if size(CPs, 1)!=nPs
        error("Invalid CPs. Expected $nPs, got $(size(CPs, 1)).")
    elseif size(rhos, 1)!=nPs
        error("Invalid rhos. Expected $nPs, got $(size(rhos, 1)).")
    elseif size(ss, 1)!=nPs
        error("Invalid ss. Expected $nPs, got $(size(ss, 1)).")
    end

    points = []

    for i in 1:nPs
        A = Ps[i]
        B = Ps[i%nPs + 1]

        conic_fun = generate_conic_fun(Ps[i]..., Ps[i%nPs + 1]...,
                                                CPs[i]..., rhos[i])
        for s in ss[i]
            push!(points, [conic_fun(s)...])
        end
    end

    return points
end


function cart_to_cyl(x,y)
    return [sqrt(x*x + y*y), (atan(y, x) + 2π)%(2π)]
end
function cyl_to_cart(r,t)
    return [r*cos(t), r*sin(t)]
end
function dcart_to_cyl(x,y)
    r2 = x*x + y*y
    r = sqrt(r2)
    return [x/r y/r; -y/r2 x/r2]
end
function dcyl_to_cart(r,t)
    ct, st = cos(t), sin(t)
    return [ct -r*st;st r*ct]
end
function step(x, s, n)
    x_trj = zeros(3, n+1)
    x_trj[:,1] = x
    s0, s1, s2 = s[1], s[2], s[3]
    for i = 2:n+1
           x_trj[:,i] = next(x_trj[:,i-1],s)
    end
    return x_trj
end
function next(u, s)
    x, y, z = u
    s0, s1, s2 = s
    r, t = cart_to_cyl(x, y)
    r1 = s0 + (r - s0)/s1 + cos(t)/2
    t1 = (2*t + s2/4*sin(4*t)) % (2π)
    z1 = z/s1 + sin(t)/2
    x1, y1 = cyl_to_cart(r1,t1)
    return [x1, y1, z1]
end
function dstep(u::Array{Float64,1},s::Array{Float64,1})
    du = zeros(2,2)
    s0, s1, s2 = s
    x, y, z = u
    r, t = cart_to_cyl(x,y)
    r1 = s0 + (r - s0)/s1 + cos(t)/2
    t1 = (2*t + s2/4*sin(4*t)) % (2π)
    z1 = z/s1 + sin(t)/2

    drt1drt = [1/s1 -sin(t)/2;0 2 + s2*cos(4*t)]
    dz1dt = cos(t)/2
    dz1dz = 1/s1

    drtdxy = dcart_to_cyl(x,y)
    dtdx, dtdy = drtdxy[2,1], drtdxy[2,2]
    dxy1dxy = dcyl_to_cart(r1,t1)*drt1drt*drtdxy
    dz1 = [dz1dt*dtdx dz1dt*dtdy dz1dz]

    du = [dxy1dxy [0;0]]
    du = [du;dz1]
    return du
end
function pert(u::Array{Float64,1}, s::Array{Float64,1},
              p::Int64)
    x, y, z = u
    s0, s1, s2 = s
    r, t = cart_to_cyl(x,y)
    r1 = s0 + (r - s0)/s1 + cos(t)/2
    t1 = 2*t + s2/4*sin(4*t)
    z1 = z/s1 + sin(t)/2
    x1, y1 = cyl_to_cart(r1,t1)
    dxyz1drtz1 = [dcyl_to_cart(r1,t1) [0;0]]
    dxyz1drtz1 = [dxyz1drtz1; [0 0 1]]

    if p==1
        drtz1ds = [1-1/s1; 0; 0]
    elseif p==2
        drtz1ds = [-(r - s0)/s1^2; 0; -z/s1^2]
    elseif p==3
        drtz1ds = [0; (1/4)*sin(4*t); 0]
    else
        println("parameter perturbation is only defined
                for indices 1 through 3")
        return 0
    end
    return dxyz1drtz1*drtz1ds
end


"""
    Gamma

* Parametrization
parametrized in \\alpha and \\theta

* Score

* Fisher Information

* `time_varying_params` map.

* Default link
"""
Gamma

function score!(score_til::Matrix{T}, y::T, ::Type{Gamma}, param::Matrix{T}, t::Int) where T
    score_til[t, 1] = log(y) - digamma(param[t, 1]) - log(param[t, 2])
    score_til[t, 2] = y/param[t, 2]^2 - param[t, 1]/param[t, 2]
    return
end

function fisher_information!(aux::AuxiliaryLinAlg{T}, ::Type{Gamma}, param::Matrix{T}, t::Int) where T
    aux.fisher[1, 1] = trigamma(param[t, 1])
    aux.fisher[2, 2] = param[t, 1] / param[t, 2]^2
    aux.fisher[2, 1] = 1/param[t, 2]
    aux.fisher[1, 2] = 1/param[t, 2]
    return
end

function log_likelihood(::Type{Gamma}, y::Vector{T}, param::Matrix{T}, n::Int) where T
    loglik = 0.0
    for t in 1:n
        loglik += (param[t, 1] - 1)*log(y[t]) - y[t]/param[t, 2] - loggamma(param[t, 1]) - param[t, 1]*log(param[t, 2])
    end
    return -loglik
end

# Links
function link!(param_tilde::Matrix{T}, ::Type{Gamma}, param::Matrix{T}, t::Int) where T
    param_tilde[t, 1] = link(LogLink, param[t, 1], zero(T))
    param_tilde[t, 2] = link(LogLink, param[t, 2], zero(T))
    return
end
function unlink!(param::Matrix{T}, ::Type{Gamma}, param_tilde::Matrix{T}, t::Int) where T
    param[t, 1] = unlink(LogLink, param_tilde[t, 1], zero(T))
    param[t, 2] = unlink(LogLink, param_tilde[t, 2], zero(T))
    return
end
function jacobian_link!(aux::AuxiliaryLinAlg{T}, ::Type{Gamma}, param::Matrix{T}, t::Int) where T
    aux.jac[1] = jacobian_link(LogLink, param[t, 1], zero(T))
    aux.jac[2] = jacobian_link(LogLink, param[t, 2], zero(T))
    return
end

# utils
function update_dist(::Type{Gamma}, param::Matrix{T}, t::Int) where T
    small_threshold!(param, SMALL_NUM, t)
    return Gamma(param[t, 1], param[t, 2])
end

function params_sdm(d::Gamma)
    return Distributions.params(d)
end

function num_params(::Type{Gamma})
    return 2
end


"""
    Circle(c,r)

Circle in the complex plane. \$|c-z|=r\$.

#### Arguments
- `c::N`: Center.
- `r::R`: Radius.
"""
struct Circle{N <: Number, R <: Real} <: AbstractCircle
  center::N
  radius::R

  function Circle{N,R}(c0::N, r0::R)  where {N <: Number, R <: Real}
    #if r0 < 0
    #  error("Circle can not have negative radius.")
    #end
    new(c0,r0)
  end
end

Circle(c0::N, r0::R) where {N <: Number, R <: Real} = Circle{N,R}(c0,r0)

center(c::Circle) = c.center
centerC(c::Circle) = c.center
centerR2(c::Circle) = real(c.center), imag(c.center)
centerx(c::Circle) = real(c.center)
centery(c::Circle) = imag(c.center)
radius(c::Circle) = c.radius
radius2(c::Circle) = c.radius*c.radius

Base.show(io::IO, c::Circle{N,R}) where {N,R} =
print(io, "Circle{$N,$R}: |z - (", c.center, ")| = ", c.radius)

"""
    CircleR2(x,y,r)

Circle in the plane \$\\mathbb{R}^2\$. \$|(x0,y0)-(x,y)|=r\$.
"""
struct CircleR2{R <: Real} <: AbstractCircle
  centerx::R
  centery::R
  radius::R

  function CircleR2{R}(x0::R, y0::R, r0::R)  where {R <: Real}
    #if r0 < 0
    #  error("Circle can not have negative radius.")
    #end
    new(x0,y0,r0)
  end
end

CircleR2(x0::R, y0::R, r0::R) where {R <: Real} = CircleR2{R}(x0,y0,r0)
CircleR2(x0::Real, y0::Real, r0::Real) = CircleR2(promote(x0,y0,r0)...)

center(c::CircleR2) = c.centerx, c.centery
centerC(c::CircleR2) = complex(c.centerx, c.centery)
centerR2(c::CircleR2) = c.centerx, c.centery
centerx(c::CircleR2) = c.centerx
centery(c::CircleR2) = c.centery
radius(c::CircleR2) = c.radius
radius2(c::CircleR2) = c.radius*c.radius

Base.show(io::IO, c::CircleR2{R}) where {R} =
print(io, "CircleR2{$R}: |(x,y) - (", c.centerx, ",", c.centery, " )| = ", c.radius)

"""
    Arc(c,p1,p2)

Circular arc the complex plane.

#### Arguments:
- `c::N`: center.
- `p1::N`: Initial point.
- `p2::N`: Final point.
"""
struct Arc{N} <: AbstractArc
  center::N
  p1::N
  p2::N

  function Arc{N}(c0::N, p10::N, p20::N)  where {N <: Number}
    #if r0 < 0
    #  error("Circle can not have negative radius.")
    #end
    new(c0,p10,p20)
  end
end

Arc(c0::N, p10::N, p20::N) where {N <: Number} = Arc{N}(c0,p10,p20)
Arc(c0::Number, p10::Number, p20::Number) = Arc(promote(c0,p10,p20)...)
Arc(c0::Number, r::Real, θ1::Real, θ2::Real) =
Arc(c0, r*(cos(θ1)+sin(θ1)*im), r*(cos(θ2)+sin(θ2)*im))

center(ca::Arc) = ca.center
centerC(ca::Arc) = ca.center
centerR2(ca::Arc) = real(ca.center), imag(ca.center)
radius(ca::Arc) = abs(ca.center - ca.p1)
radius2(ca::Arc) = abs2(ca.center - ca.p1)
initialpoint(ca::Arc) = ca.p1
finalpoint(ca::Arc) = ca.p2
initialpointC(ca::Arc) = ca.p1
finalpointC(ca::Arc) = ca.p2
initialpointR2(ca::Arc) = real(ca.p1), imag(ca.p1)
finalpointR2(ca::Arc) = real(ca.p2), imag(ca.p2)

Base.show(io::IO, ca::Arc{N}) where {N} =
print(io, "Arc{$N}: center=", ca.center, ", extremes ", ca.p1, ", ", ca.p2)

"""
    BiArc(c,p1,p2,p3,p4)

Two arcs in the same circunference.
"""
struct BiArc{N <: Number} <: AbstractCircularCurve
  center::N
  p1::N
  p2::N
  p3::N
  p4::N

  function BiArc{N}(c0::N, p10::N, p20::N, p30::N, p40::N)  where {N <: Number}
    new(c0,p10,p20,p30,p40)
  end
end

BiArc(c0::N, p10::N, p20::N, p30::N, p40::N) where {N <: Number} = BiArc{N}(c0,p10,p20,p30,p40)
BiArc(c0::Number, p10::Number, p20::Number, p30::Number, p40::Number) = BiArc(promote(c0,p10,p20,p30,p40)...)

toarcs(ba::BiArc) = Arc(ba.center,ba.p1,ba.p2), Arc(ba.center,ba.p3,ba.p4)

#=
ToDo!
ArcR2
BiArcR2
=#

"""
Checks if `z` is inside the circle `c` with \$|center-z|^2 < radius^2\$.
"""
isinside(z::Number, c::Circle) = abs2(c.center - z) < (c.radius * c.radius)

"""
Checks if `z` is outside the circle `c` with \$|center-z|^2 > radius^2\$.
"""
isoutside(z::Number, c::Circle) = abs2(c.center - z) > (c.radius * c.radius)

"""
    circlepoints(c, [θ0, θ1; numpts]) -> Array{Tuple{Float64,Float64}}

Create an array of points (`Tuple{Float64,Float64}`) in a given circle

#### Arguments
- `c::Circle`: A circle.
- `θ0::Real`: Initial angle.
- `θ1::Real`: Final angle.
- `numpts::Integer`: Number of points to create.
"""
circlepoints(c::AbstractCircle, θ0::Real=0, θ1::Real=2π; numpts::Integer=100) =
[ (centerx(c) + radius(c)*cos(θ), centery(c) + radius(c)*sin(θ)) for θ ∈ θ0:((θ1 - θ0)/numpts):θ1 ]

circlepoints(x::Real, y::Real, r::Real, θ0::Real=0, θ1::Real=2π; numpts::Integer=100) =
[ (x + r*cos(θ), y + r*sin(θ)) for θ ∈ θ0:((θ1 - θ0)/numpts):θ1 ]

"""
    circlepoints(c, [θ0, θ1; numpts]) -> Array{Complex{Float64}}

Create an array of complex number in a given circle.

#### Arguments
- `c::Circle`: A circle.
- `θ0::Real`: Initial angle.
- `θ1::Real`: Final angle.
- `numpts::Integer`: Number of points to create.
"""
circlecomplexes(c::AbstractCircle, θ0::Real=0, θ1::Real=2π; numpts::Integer=100) =
[ centerC(c) + radius(c)*exp(θ*im) for θ ∈ θ0:((θ1 - θ0)/numpts):θ1 ]

circlecomplexes(z::Number, r::Real, θ0::Real=0, θ1::Real=2π; numpts::Integer=100) =
[ z + r*cos(θ) + r*sin(θ)*im for θ ∈ θ0:((θ1 - θ0)/numpts):θ1 ]


export Ricker
"""
    Ricker(epp::Union{ElasticPropagatorParams, AcousticPropagatorParams},
    a::Union{PyObject, <:Real},
    shift::Union{PyObject, <:Real},
    amp::Union{PyObject, <:Real}=1.0)

Returns a Ricker wavelet (a tensor).
- `epp`: a `ElasticPropagatorParams` or an `AcousticPropagatorParams`
- `a`: Width parameter
- `shift`: Center of the Ricker wavelet
- `amp`: Amplitude of the Ricker wavelet

```math
f(x) = \\mathrm{amp}A (1 - x^2/a^2) exp(-x^2/2 a^2)
```
where
```math
A = 2/sqrt(3a)pi^1/4
```
"""
function Ricker(epp,
        a,
        shift,
        amp=1.0)
    NT, T = epp.NSTEP, epp.NSTEP*epp.DELTAT
    A = @. 2 / (sqrt(3 * a) * (pi^0.25))
    wsq = @. a^2
    vec =  collect(1:NT) .-shift
    xsq = @. vec^2
    mod = @. (1 - xsq / wsq)
    gauss = @. exp(-xsq / (2 * wsq))
    total = @. amp * A * mod * gauss
    return total
end

struct SafeIndex{T}
    arg::T
end

function SafeIndex(args::Tuple)
    SafeIndex(CartesianIndex(args))
end
SafeIndex(args::Int...) = SafeIndex(args)

function Base.getindex(x::AbstractArray, si::SafeIndex)
    getindex(x, si.arg)
end

function Base.setindex!(x::AbstractArray, val, si::SafeIndex)
    setindex!(x, val, si.arg)
end


A = rand(4,3)   # simulate a matrix with elements selected at random from (0,1)

B = rand(3, 4)

A'   # "lazy" transpose

A*B

using LinearAlgebra, RCall, StatsModels, Tables

Formaldehyde = rcopy(R"Formaldehyde")

R"""
library(ggplot2)
qplot(x=carb, y=optden, data=Formaldehyde, geom="point")
"""

X = hcat(ones(size(Formaldehyde, 1)), Formaldehyde.carb)

y = Formaldehyde.optden

β = X\y     # least squares estimate

r = y - X*β   #residual

X'r   # not exactly zero but very small entries

using GLM

m1 = fit(LinearModel, @formula(optden ~ 1 + carb), Formaldehyde)

f1 = @formula(optden ~ 1 + carb)
y, X = modelcols(apply_schema(f1, schema(Formaldehyde)), Formaldehyde)

X

X

xpx = X'X

ch = cholesky(xpx)

ch.U'ch.U

ch.U'ch.U ≈ xpx

v = ldiv!(ch.U', X'y)

βc = ldiv!(ch.U, copy(v))     # solution from the Cholesky factorization

βc ≈ β

ldiv!(ch, X'y)

Xy = hcat(X, y)              # augmented model matrix

cha = cholesky(Xy'Xy)        # augmented Cholesky factor

RXX = UpperTriangular(view(cha.U, 1:2, 1:2))

RXX ≈ ch.U

rXy = cha.U[1:2, end]     # creates a copy ("view" doesn't copy)

rXy ≈ v

βac = ldiv!(RXX, copy(rXy))     # least squares solution from the augmented Cholesky

βac ≈ β

abs2(cha.U[end,end]) ≈ sum(abs2, y - X*β)   # check on residual sum of squares

Formrows = Tables.rowtable(Formaldehyde)

chr = cholesky(zeros(3, 3) + I)  # initialize

fill!(chr.factors, 0);   # zero out the contents
chr

fill!(chr.factors, 0)
for r in Formrows
    lowrankupdate!(chr, [1.0, r.carb, r.optden])
end
chr

qrX = qr(X)

qrX.R'qrX.R

qrX.R'qrX.R ≈ xpx


module mbaruniax1
using FinEtools
using FinEtoolsDeforLinear
using FinEtools.FENodeSetModule
using FinEtools.MeshExportModule
using FinEtoolsDeforLinear.MatDeforLinearElasticModule: tangentmoduli!, update!, thermalstrain!
using Test
import LinearAlgebra: norm, cholesky, cross
function test()
    E = 30e6*phun("psi") # Young's modulus
    alpha = 5.5e-6*phun("in")/phun("in")/phun("F")
    for nu in [0.0 0.3 0.45]

        MR = DeforModelRed1DStress
        material = MatDeforElastIso(MR,  0.0, E, nu, alpha)
        D = fill(0.0, 1, 1)
        t::FFlt, dt::FFlt, loc::FFltMat, label::FInt = 0.0, 0.0, [0.0 0.0 0.0], 0
        tangentmoduli!(material,  D,  t, dt, loc, label)
        @test D[1, 1] ≈ E
    end

    true
end
end
using .mbaruniax1
mbaruniax1.test()

module mbaruniax2
using FinEtools
using FinEtoolsDeforLinear
using FinEtools.FENodeSetModule
using FinEtools.MeshExportModule
using FinEtoolsDeforLinear.MatDeforLinearElasticModule: tangentmoduli!, update!, thermalstrain!
using Test
import LinearAlgebra: norm, cholesky, cross
function test()
    E = 30e6*phun("psi") # Young's modulus
    alpha = 5.5e-6*phun("in")/phun("in")/phun("F")
    for nu in [0.0 0.3 0.45]

        MR = DeforModelRed1DStrain
        material = MatDeforElastIso(MR,  0.0, E, nu, alpha)
        D = fill(0.0, 1, 1)
        t::FFlt, dt::FFlt, loc::FFltMat, label::FInt = 0.0, 0.0, [0.0 0.0 0.0], 0
        tangentmoduli!(material,  D,  t, dt, loc, label)
        lambda = E * nu / (1 + nu) / (1 - 2*(nu));
        mu = E / 2. / (1+nu);
        @test D[1, 1] ≈ lambda + 2*mu
    end

    true
end
end
using .mbaruniax2
mbaruniax2.test()


"""
constructDormandPrince()

Constructs the tableau object for the Dormand-Prince Order 4/5 method.
"""
function constructDormandPrince(T::Type = Float64)
  A = [0 0 0 0 0 0 0
      1//5 0 0 0 0 0 0
      3//40 9//40 0 0 0 0 0
      44//45 -56//15 32//9 0 0 0 0
      19372//6561 -25360//2187 64448//6561 -212//729 0 0 0
      9017//3168 -355//33 46732//5247 49//176 -5103//18656 0 0
      35//384 0 500//1113 125//192 -2187//6784 11//84 0]
  c = [0;1//5;3//10;4//5;8//9;1;1]
  α = [35//384;0;500//1113;125//192;-2187//6784;11//84;0]
  αEEst = [5179//57600;0;7571//16695;393//640;-92097//339200;187//2100;1//40]
  A = map(T,A)
  α = map(T,α)
  αEEst = map(T,αEEst)
  c = map(T,c)
  return(ExplicitRKTableau(A,c,α,5,αEEst=αEEst,adaptiveorder=4,fsal=true))
end

"""
ODE_DEFAULT_TABLEAU

Sets the default tableau for the ODE solver. Currently Dormand-Prince 4/5.
"""
const ODE_DEFAULT_TABLEAU = constructDormandPrince()

@inline ODE_DEFAULT_NORM(u) = sqrt(sum(abs2,u) / length(u))
@inline ODE_DEFAULT_NORM(u::Number) = abs(u)
@inline ODE_DEFAULT_ISOUTOFDOMAIN(t,u) = false
@inline ODE_DEFAULT_PROG_MESSAGE(dt,t,u) = "dt="*string(dt)*"\nt="*string(t)*"\nmax u="*string(maximum(abs.(u)))
@inline ODE_DEFAULT_UNSTABLE_CHECK(dt,t,u) = any(isnan,u)


include("utils.jl")

@testset "SkewSymmetricMatrices" begin
    M = SkewSymmetricMatrices(3, ℝ)
    A = [1 2 3; 4 5 6; 7 8 9]
    A_skewsym = [0 -2 -3; 2 0 1; 3 -1 0]
    A_skewsym2 = [0 -2 -3; 2 0 1; 3 -1 0]
    B_skewsym = [0 -2 -3; 2 0 -1; 3 1 0]
    M_complex = SkewSymmetricMatrices(3, ℂ)
    A_skewsym_complex = [1.0im -2.0 -3.0; 2.0 0.0 1.0; 3.0 -1.0 0.0]
    B_skewsym_complex = [2.0im -2.0 - 2.0im -3.0; 2.0 - 2.0im 0.0 -1.0; 3.0 1.0 0.0]
    @test repr(M_complex) == "SkewSymmetricMatrices(3, ℂ)"
    C = [0 -1 im; 1 0 -im; im -im 0]
    D = [1 0; 0 1]
    X = zeros(3, 3)
    @testset "Real Skew-Symmetric Matrices Basics" begin
        @test repr(M) == "SkewSymmetricMatrices(3, ℝ)"
        @test representation_size(M) == (3, 3)
        @test base_manifold(M) === M
        @test typeof(get_embedding(M)) === Euclidean{Tuple{3,3},ℝ}
        @test check_manifold_point(M, B_skewsym) === nothing
        @test_throws DomainError is_manifold_point(M, A, true)
        @test_throws DomainError is_manifold_point(M, C, true)
        @test_throws DomainError is_manifold_point(M, D, true)
        @test check_tangent_vector(M, B_skewsym, B_skewsym) === nothing
        @test_throws DomainError is_tangent_vector(M, B_skewsym, A, true)
        @test_throws DomainError is_tangent_vector(M, A, B_skewsym, true)
        @test_throws DomainError is_tangent_vector(M, B_skewsym, D, true)
        @test_throws DomainError is_tangent_vector(
            M,
            B_skewsym,
            1 * im * zero_tangent_vector(M, B_skewsym),
            true,
        )
        @test manifold_dimension(M) == 3
        @test manifold_dimension(M_complex) == 9
        @test A_skewsym2 == project!(M, A_skewsym, A_skewsym)
        @test A_skewsym2 == project(M, A_skewsym, A_skewsym)
        A_sym3 = similar(A_skewsym)
        embed!(M, A_sym3, A_skewsym)
        A_sym4 = embed(M, A_skewsym)
        @test A_sym3 == A_skewsym
        @test A_sym4 == A_skewsym
    end
    types = [Matrix{Float64}, ]
    TEST_FLOAT32 && push!(types, Matrix{Float32})
    TEST_STATIC_SIZED && push!(types, MMatrix{3, 3, Float64})
    bases = (DefaultOrthonormalBasis(), ProjectedOrthonormalBasis(:svd))
    for T in types
        pts = [convert(T, A_skewsym), convert(T, B_skewsym), convert(T, X)]
        @testset "Type $T" begin
            test_manifold(
                M,
                pts,
                test_injectivity_radius = false,
                test_reverse_diff = isa(T, Vector),
                test_project_tangent = true,
                test_musical_isomorphisms = true,
                test_vector_transport = true,
                basis_types_vecs = (
                    DiagonalizingOrthonormalBasis(log(M, pts[1], pts[2])),
                    bases...,
                ),
                basis_types_to_from = bases,
            )
        end
    end
    complex_types = [ Matrix{ComplexF64}, ]
    TEST_FLOAT32 && push!(complex_types, Matrix{ComplexF32})
    TEST_STATIC_SIZED && push!(compley_types, MMatrix{3, 3, ComplexF64})
    for T in complex_types
        pts_complex =
            [convert(T, A_skewsym_complex), convert(T, B_skewsym_complex), convert(T, X)]
        @testset "Type $T" begin
            test_manifold(
                M_complex,
                pts_complex,
                test_injectivity_radius = false,
                test_reverse_diff = isa(T, Vector),
                test_project_tangent = true,
                test_musical_isomorphisms = true,
                test_vector_transport = true,
                basis_types_vecs = (DefaultOrthonormalBasis(),),
                basis_types_to_from = (DefaultOrthonormalBasis(),),
            )
            @test isapprox(
                -pts_complex[1],
                exp(M, pts_complex[1], log(M, pts_complex[1], -pts_complex[1])),
            )
        end # testset type $T
    end # for
end # test SymmetricMatrices


import FractionalCalculus.FracDiffAlg

"""
Riesz sense fractional derivative
"""
abstract type Riesz <: FracDiffAlg end

"""
# Riesz sense symmetric fractional derivative algorithm.

    fracdiff(f, α, end_point, h, Riesz_Symmetric())

Compute fractional derivative of Riesz sense using Triangular Strip Matrix algorithm.

### Example

```julia-repl
julia> fracdiff(x->x, 0.5, 1, 0.01, Riesz_Symmetric())
```
"""
struct Riesz_Symmetric <: Riesz end

################################################################
###                    Type defination done                  ###
################################################################

function fracdiff(f, α, end_point, h, ::Riesz_Symmetric)
    N=Int(floor(end_point/h))

    mat = RieszMatrix(α, N+1, h)
    return mat*f.(collect(0:h:end_point))
end
function RieszMatrix(α, N, h)
    caputo = B(N+1, α)
    caputo = caputo[2:(N+1), 1:N]
    result = 1/2*(caputo+caputo')
    result = h^(-α)*result

    return result
end

function B(N, p)
    result=zeros(N, N)
    temp=omega(N, p)

    @inbounds @simd for i ∈ 1:N
        @views result[i, 1:i]=reverse(temp[1:i])
    end

    return result
end

function omega(n, p)
    omega = zeros(n+1)

    omega[1]=1
    @fastmath @inbounds @simd for i ∈ 1:n
        omega[i+1]=(1-(p+1)/i)*omega[i]
    end

    return omega
end


export arithmetic_mean, geometric_mean, harmonic_mean, generalized_means
export pref_attach3, common3, jaccard3, adamic_adar3
export common_nbr_set

"""
arithmetic_mean
---------------

Returns the arithmetic mean of the weights of the edges of a list of triangles.

arithmetic_mean(triangles::Vector{NTuple{3,Int64}}, B::SpIntMat)

Input parameters:
- triangles::Vector{NTuple{3,Int64}}: The vector of triangles upon which to compute scores.
- B::SpIntMat: Projected graph as a Sparse integer matrix, where B[i, j] is the number of times that i and j co-appear in a simplex.
"""
function arithmetic_mean(triangles::Vector{NTuple{3,Int64}}, B::SpIntMat)
    scores = zeros(Float64, length(triangles))
    Threads.@threads for ind = 1:length(triangles)
        i, j, k = triangles[ind]
        scores[ind] = (B[i, j] + B[j, k] + B[i, k]) / 3
    end
    return scores
end

"""
geometric_mean
---------------

Returns the geometric mean of the weights of the edges of a list of triangles.

geometric_mean(triangles::Vector{NTuple{3,Int64}}, B::SpIntMat)

Input parameters:
- triangles::Vector{NTuple{3,Int64}}: The vector of triangles upon which to compute scores.
- B::SpIntMat: Projected graph as a Sparse integer matrix, where B[i, j] is the number of times that i and j co-appear in a simplex.
"""
function geometric_mean(triangles::Vector{NTuple{3,Int64}}, B::SpIntMat)
    scores = zeros(Float64, length(triangles))
    Threads.@threads for ind = 1:length(triangles)
        i, j, k = triangles[ind]
        scores[ind] = (B[i, j] * B[j, k] * B[i, k])^(1 / 3)
    end
    return scores
end

"""
harmonic_mean
---------------

Returns the harmonic mean of the weights of the edges of a list of triangles.

harmonic_mean(triangles::Vector{NTuple{3,Int64}}, B::SpIntMat)

Input parameters:
- triangles::Vector{NTuple{3,Int64}}: The vector of triangles upon which to compute scores.
- B::SpIntMat: Projected graph as a Sparse integer matrix, where B[i, j] is the number of times that i and j co-appear in a simplex.
"""
function harmonic_mean(triangles::Vector{NTuple{3,Int64}}, B::SpIntMat)
    scores = zeros(Float64, length(triangles))
    Threads.@threads for ind = 1:length(triangles)
        i, j, k = triangles[ind]
        scores[ind] = 3.0 / (1.0 / B[i, j] + 1.0 / B[j, k] + 1.0 / B[i, k])
    end
    return scores
end

"""
generalized_means
----------------

Computes the generalized p-means of the weights of the edges of a list of triangles.
The generalized mean of 3 values is

```math
M_p(x, y, z) = ((x^p + y^p + z^p) / 3)^{1/p}
```

generalized_means(triangles::Vector{NTuple{3,Int64}}, B::SpIntMat, ps::Float64=[-Inf; collect(-4:0.25:4); Inf])

Input parameters:
- triangles::Vector{NTuple{3,Int64}}: The vector of triangles upon which to compute scores.
- B::SpIntMat: Projected graph as a Sparse integer matrix, where B[i, j] is the number of times that i and j co-appear in a simplex.
- ps::Vector{Float64}=[-Inf; collect(-4:0.25:4); Inf]: the values of p for which to compute the means

Returns a matrix of size length(triangles) x length(ps) of the scores for the various generalized means.
"""
function generalized_means(triangles::Vector{NTuple{3,Int64}}, B::SpIntMat, ps::Vector{Float64}=[-Inf; collect(-4:0.25:4); Inf])
    scores = zeros(Float64, length(triangles), length(ps))
    Threads.@threads for ind = 1:length(triangles)
        i, j, k = triangles[ind]
        Bij, Bjk, Bik = B[i, j], B[j, k], B[i, k]
        for (r, p) in enumerate(ps)
            if     p == -Inf; scores[ind, r] = min(Bij, Bjk, Bik)
            elseif p == Inf;  scores[ind, r] = max(Bij, Bjk, Bik)
            elseif p == 0;    scores[ind, r] = (Bij * Bjk * Bik)^(1.0 / 3)
            else              scores[ind, r] = ((Bij^p + Bjk^p + Bik^p) / 3)^(1.0 / p)
            end
        end
    end
    return scores
end

"""
pref_attach3
------------

Returns the preferential attachment score for a degree vector

pref_attach3(triangles::Vector{NTuple{3,Int64}}, degrees::Vector{Int64})

The score of triangle (i, j, k) is degrees[i] * degrees[j] * degrees[k]

Input parameters:
- triangles::Vector{NTuple{3,Int64}}: The vector of triangles upon which to compute scores.
- degrees::Vector{Int64}: the degree vector
"""
function pref_attach3(triangles::Vector{NTuple{3,Int64}}, degrees::Vector{Int64})
    scores = zeros(Float64, length(triangles))
    Threads.@threads for ind = 1:length(triangles)
        i, j, k = triangles[ind]
        scores[ind] = 1.0 * degrees[i] * degrees[j] * degrees[k]
    end
    return scores
end

""" Return common neighbors of two nodes u and v. """
function common_nbr_set(common_nbrs::NbrSetMap, u::Int64, v::Int64)
    min_node, max_node = min(u, v), max(u, v)
    if !haskey(common_nbrs, (min_node, max_node))
        return Set{Int64}()
    end
    return common_nbrs[(min_node, max_node)]
end

"""
common3
------------

Returns the number of common 4th neighbors of a list of triangles.

common3(triangles::Vector{NTuple{3,Int64}}, common_nbrs::NbrSetMap)

Input parameters:
- triangles::Vector{NTuple{3,Int64}}: The vector of triangles upon which to compute scores.
- common_nbrs::NbrSetMap: the common neighbors map attained from common_neighbors_map()
"""
function common3(triangles::Vector{NTuple{3,Int64}}, common_nbrs::NbrSetMap)
    scores = zeros(Float64, length(triangles))
    Threads.@threads for ind = 1:length(triangles)
        i, j, k = triangles[ind]
        common_ij = common_nbr_set(common_nbrs, i, j)
        common_ik = common_nbr_set(common_nbrs, i, k)
        common_jk = common_nbr_set(common_nbrs, j, k)
        common_ijk = intersect(common_ij, common_ik, common_jk)
        scores[ind] = length(common_ijk)
    end
    return scores
end

"""
jaccard3
------------

Returns the 3-way Jaccard index of the neighbor lists of nodes in triangle.

jaccard3(triangles::Vector{NTuple{3,Int64}}, common_nbrs::NbrSetMap, degrees::Vector{Int64})

Input parameters:
- triangles::Vector{NTuple{3,Int64}}: The vector of triangles upon which to compute scores.
- common_nbrs::NbrSetMap: the common neighbors map attained from common_neighbors_map()
- degrees::Vector{Int64}: degree of each node in the projected graph
"""
function jaccard3(triangles::Vector{NTuple{3,Int64}}, common_nbrs::NbrSetMap,
                  degrees::Vector{Int64})
    scores = zeros(Float64, length(triangles))
    Threads.@threads for ind = 1:length(triangles)
        i, j, k = triangles[ind]
        common_ij = common_nbr_set(common_nbrs, i, j)
        common_ik = common_nbr_set(common_nbrs, i, k)
        common_jk = common_nbr_set(common_nbrs, j, k)
        common_ijk = intersect(common_ij, common_ik, common_jk)
        nij, nik, njk = length(common_ij), length(common_ik), length(common_jk)
        nijk = length(common_ijk)
        di, dj, dk = degrees[[i, j, k]]
        scores[ind] = nijk / (di + dj + dk - nij - nik - njk + nijk)
    end
    return scores
end

"""
adamic_adar3
------------

Returns the 3-way Adamic-Adar score for a list of triangles.

adamic_adar3(triangles::Vector{NTuple{3,Int64}}, common_nbrs::NbrSetMap, degrees::Vector{Int64})

Input parameters:
- triangles::Vector{NTuple{3,Int64}}: The vector of triangles upon which to compute scores.
- common_nbrs::NbrSetMap: the common neighbors map attained from common_neighbors_map()
- degrees::Vector{Int64}: degree of each node in the projected graph
"""
function adamic_adar3(triangles::Vector{NTuple{3,Int64}}, common_nbrs::NbrSetMap,
                      degrees::Vector{Int64})
    scores = zeros(Float64, length(triangles))
    Threads.@threads for ind = 1:length(triangles)
        i, j, k = triangles[ind]
        common_ij = common_nbr_set(common_nbrs, i, j)
        common_ik = common_nbr_set(common_nbrs, i, k)
        common_jk = common_nbr_set(common_nbrs, j, k)
        common_ijk = intersect(common_ij, common_ik, common_jk)
        scores[ind] = sum([1.0 / log(degrees[z]) for z in common_ijk])
    end
    return scores
end


abstract type AbstractPoint end

function iselliptic(𝑥::Number,𝑦::Number,𝑎::Number,𝑏::Number)
    𝑦^2 == 𝑥^3 + 𝑎*𝑥 + 𝑏
end

POINTTYPES = Union{Integer,PrimeField}

"""
Represents a point with coordinates (𝑥,𝑦) on an elliptic curve where 𝑦² = 𝑥³ + 𝑎𝑥 + 𝑏
Optional parameter 𝑝 represents finite field 𝐹ₚ and will convert all other parameter to PrimeField
Point(∞,∞,𝑎,𝑏) represents point at infinity
Returns an error if elliptic curve equation isn't satisfied
"""
struct Point{T<:Number,S<:Number} <: AbstractPoint
    𝑥::T
    𝑦::T
    𝑎::S
    𝑏::S
    Point{T,S}(𝑥,𝑦,𝑎,𝑏) where {T<:Number,S<:Number} = new(𝑥,𝑦,𝑎,𝑏)
end

Point(𝑥::Infinity,𝑦::Infinity,𝑎::T,𝑏::T) where {T<:POINTTYPES} = Point{Infinity,T}(𝑥,𝑦,𝑎,𝑏)
Point(𝑥::T,𝑦::T,𝑎::T,𝑏::T) where {T<:POINTTYPES} = !iselliptic(𝑥,𝑦,𝑎,𝑏) ? throw(DomainError("Point is not on curve")) : Point{T,T}(𝑥,𝑦,𝑎,𝑏)
Point(𝑥::Infinity,𝑦::Infinity,𝑎::T,𝑏::T,𝑝::T) where {T<:Integer} = Point(𝑥,𝑦,FieldElement(𝑎,𝑝),FieldElement(𝑏,𝑝))
Point(𝑥::T,𝑦::T,𝑎::T,𝑏::T,𝑝::T) where {T<:Integer} = Point(FieldElement(𝑥,𝑝),FieldElement(𝑦,𝑝),FieldElement(𝑎,𝑝),FieldElement(𝑏,𝑝))

"Formats AbstractPoint as (𝑥, 𝑦) on 𝑦² = 𝑥³ + 𝑎𝑥 + 𝑏 (: 𝐹ₚ)"
function show(io::IO, z::AbstractPoint)
    if typeof(z.𝑥) <: PrimeField
        x, y = z.𝑥.𝑛, z.𝑦.𝑛
    else
        x, y = z.𝑥, z.𝑦
    end

    if typeof(z.𝑎) <: PrimeField
        a, b = z.𝑎.𝑛, z.𝑏.𝑛
        field = string(" : 𝐹", z.𝑎.𝑝)
    else
        a, b = z.𝑎, z.𝑏
        field = ""
    end
    print(io, "(", x, ", ", y, ") on 𝑦² = 𝑥³ + ", a, "𝑥 + ", b, field)
end

"""
Returns the point resulting from the intersection of the curve and the
straight line defined by the points P and Q
"""
function +(𝑃::AbstractPoint,𝑄::AbstractPoint)
    T = typeof(𝑃)
    S = typeof(𝑃.𝑎)
    if 𝑃.𝑎 != 𝑄.𝑎 || 𝑃.𝑏 != 𝑄.𝑏
        throw(DomainError("Points are not on the same curve"))

    # Case 0
    elseif 𝑃.𝑥 == ∞
        return 𝑄
    elseif 𝑄.𝑥 == ∞
        return 𝑃
    elseif 𝑃.𝑥 == 𝑄.𝑥 && 𝑃.𝑦 != 𝑄.𝑦
        # something more elegant should exist to return correct point type
        if T <: Point
            return Point{Infinity,S}(∞, ∞, 𝑃.𝑎, 𝑃.𝑏)
        elseif T <: S256Point
            return S256Point{Infinity}(∞, ∞, 𝑃.𝑎, 𝑃.𝑏)
        end

    # Case 1
    elseif 𝑃.𝑥 != 𝑄.𝑥
        λ = (𝑄.𝑦 - 𝑃.𝑦) ÷ (𝑄.𝑥 - 𝑃.𝑥)
        𝑥 = λ^2 - 𝑃.𝑥 - 𝑄.𝑥
    # Case 2
    else
        λ = (3 * 𝑃.𝑥^2 + 𝑃.𝑎) ÷ (2 * 𝑃.𝑦)
        𝑥 = λ^2 - 2 * 𝑃.𝑥
    end
    𝑦 = λ * (𝑃.𝑥 - 𝑥) - 𝑃.𝑦
    return T(S(𝑥), S(𝑦), 𝑃.𝑎, 𝑃.𝑏)
end

"Scalar multiplication of a Point"
function *(λ::Integer,𝑃::Point)
    𝑅 = Point(∞, ∞, 𝑃.𝑎, 𝑃.𝑏)
    while λ > 0
        𝑅 += 𝑃
        λ -= 1
    end
    return 𝑅
end


function algebry(rel::Parallelism, coords)
    A = coords[rel.l.l]
    B = coords[rel.l.r]
    C = coords[rel.r.l]
    D = coords[rel.r.r]
    return ((B.x - A.x)*(D.y - C.y) - (B.y - A.y)*(D.x - C.x),)
end

function algebry(rel::Perpendicularity, coords)
    A = coords[rel.l.l]
    B = coords[rel.l.r]
    C = coords[rel.r.l]
    D = coords[rel.r.r]
    return ((B.x - A.x)*(D.x - C.x) + (B.y - A.y)*(D.y - C.y),)
end

function algebry(rel::Congruence{Segment}, coords)
    A = coords[rel.l.l]
    B = coords[rel.l.r]
    C = coords[rel.r.l]
    D = coords[rel.r.r]
    return ((B.x-A.x)^2 + (B.y-A.y)^2 - (D.x-C.x)^2 - (D.y-C.y)^2,)
end

function algebry(rel::Parallelogram, coords)
    A = coords[rel.A]
    B = coords[rel.B]
    C = coords[rel.C]
    D = coords[rel.D]
    return (B.x + D.x - A.x - C.x, B.y + D.y - A.y - C.y)
end

function algebry(rel::Midpoint, coords)
    M = coords[rel.M]
    A = coords[rel.seg.l]
    B = coords[rel.seg.r]
    return (2*M.x-A.x-B.x, 2*M.y-A.y-B.y)
end

function algebry(rel::Appartenence{Segment}, coords)
    P = coords[rel.l]
    A = coords[rel.r.l]
    B = coords[rel.r.r]
    return ((B.x - A.x)*(P.y - A.y) - (B.y - A.y)*(P.x - A.x),)
end

function algebry(rel::Intersection{Segment, Segment}, coords)
    return (algebry(Appartenence(rel.P, rel.l), coords)[1], algebry(Appartenence(rel.P, rel.r), coords)[1])
end

function algebry(rel::Projection, coords)
    return (algebry(Appartenence(rel.H, rel.seg), coords)[1], algebry(Perpendicularity(Segment(rel.P, rel.H), rel.seg), coords)[1])
end

function algebry(rel::Appartenence{Circle}, coords)
    OP = Segment(rel.r.O, rel.l)
    OA = Segment(rel.r.O, rel.r.A)
    return algebry(Congruence(OA, OP), coords)
end

function algebry(rel::CircleThreePoints, coords)
    OA = Segment(rel.O, rel.A)
    OB = Segment(rel.O, rel.B)
    OC = Segment(rel.O, rel.C)
    return (algebry(Congruence(OA, OB), coords)[1], algebry(Congruence(OA, OC), coords)[1])
end


using DifferentialEquations
using Plots

function sir_ode!(du,u,p,t)
    (S,I,R) = u
    (β,c,γ) = p
    N = S+I+R
    @inbounds begin
        du[1] = -β*c*I/N*S
        du[2] = β*c*I/N*S - γ*I
        du[3] = γ*I
    end
    nothing
end;

δt = 0.1
tmax = 80.0
tspan = (0.0,tmax)
t = 0.0:δt:tmax;

u0 = [990.0,10.0,0.0]; # S,I.R

p = [0.05,10.0,0.25]; # β,c,γ

lockdown_times = [10.0, 20.0]
condition(u,t,integrator) = t ∈ lockdown_times
function affect!(integrator)
    if integrator.t < lockdown_times[2]
        integrator.p[1] = 0.01
    else
        integrator.p[1] = 0.05
    end
end
cb = PresetTimeCallback(lockdown_times, affect!);

prob_ode = ODEProblem(sir_ode!,u0,tspan,p)

sol_ode = solve(prob_ode, callback = cb);

plot(sol_ode, label = ["S" "I" "R"], title = "Lockdown in a SIR model")
vline!(lockdown_times, c = :red, w = 2, label = "")


# # [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
using AlgebraicPetri.Epidemiology

using LabelledArrays
using OrdinaryDiffEq
using Plots

using Catlab
using Catlab.Graphics
using Catlab.WiringDiagrams
using Catlab.CategoricalAlgebra
using Catlab.Programs.RelationalPrograms

display_uwd(ex) = to_graphviz(ex, box_labels=:name, junction_labels=:variable, edge_attrs=Dict(:len=>".75"));

# #### SIR Model:

# define model
sir = @relation (s,i,r) begin
    infection(s,i)
    recovery(i,r)
end
display_uwd(sir)
#-
p_sir = apex(oapply_epi(sir))
Graph(p_sir)

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

u0 = LVector(S=10, I=1, R=0);
p = LVector(inf=0.4, rec=0.4);

# The C-Set representation has direct support for generating a DiffEq vector field

prob = ODEProblem(vectorfield(p_sir),u0,(0.0,7.5),p);
sol = solve(prob,Tsit5())

plot(sol)

# #### SEIR Model:

# define model
seir = @relation (s,e,i,r) begin
    exposure(s,i,e)
    illness(e,i)
    recovery(i,r)
end
display_uwd(seir)
#-
p_seir = apex(oapply_epi(seir))
Graph(p_seir)

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

u0 = LVector(S=10, E=1, I=0, R=0);
p = LVector(exp=.9, ill=.2, rec=.5);

prob = ODEProblem(vectorfield(p_seir),u0,(0.0,15.0),p);
sol = solve(prob,Tsit5())

plot(sol)

# #### SEIRD Model:

# define model
seird = @relation (s,e,i,r,d) begin
    exposure(s,i,e)
    illness(e,i)
    recovery(i,r)
    death(i,d)
end
display_uwd(seird)
#-
p_seird = apex(oapply_epi(seird))
Graph(p_seird)

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

u0 = LVector(S=10, E=1, I=0, R=0, D=0);
p = LVector(exp=0.9, ill=0.2, rec=0.5, death=0.1);

prob = ODEProblem(vectorfield(p_seird),u0,(0.0,15.0),p);
sol = solve(prob,Tsit5())

plot(sol)


using Plots, Measures; pyplot()

pDiscrete = [0.25, 0.25, 0.5]
xGridD = 0:2

pContinuous(x) = 3/4*(1 - x^2)
xGridC = -1:0.01:1

pContinuous2(x) = x < 0 ? x+1 : 1-x

p1 = plot(xGridD, line=:stem, pDiscrete, marker=:circle, c=:blue, ms=6, msw=0)
p2 = plot(xGridC, pContinuous.(xGridC), c=:blue)
p3 = plot(xGridC, pContinuous2.(xGridC), c=:blue)

plot(p1, p2, p3, layout=(1,3), legend=false, ylims=(0,1.1), xlabel="x",
	ylabel=["Probability" "Density" "Density"], size=(1200, 400), margin=5mm)


include("diagnostics.jl")
using DataFrames, Plots

export calc_auc
export roc_curve

"calc the AUC of a function given xs and ys"
function calc_auc(x::Array, y::Array)
    df = rename!(hcat(x, y) |> DataFrame, Symbol.(["x", "y"]))
    df = sort(df, [:x, :y])
    auc = 0
    for i in 2:nrow(df)
        # rectangular component
        x = df[i, :x][1] - df[i-1, :x][1]
        y = df[i-1, :y][1]
        auc += x*y
        # triangular component
        height = df[i, :y][1] - y
        auc += 0.5*x * height
    end
    return auc
end

"generates data necssary for ROC curve, array of true positive and false positive rates + AUC"
function roc_data(actual::Array{Int64}, pred::Array{Float64}, step = 0.01)
    x = 0:step:1
    tps = [true_positives(actual, predict_from_threshold(pred, threshold), rate=true) for threshold in x]
    fps = [false_positives(actual, predict_from_threshold(pred, threshold), rate=true) for threshold in x]
    auc = calc_auc(fps, tps)
    return tps, fps, auc
end

"""
_given array of predictions (0 ≤ x ≤ 1] and array of actuals, return ROC AUC plot_

#### parameters:
    actual : Array{Int}
        actual labels, ∈ [0,1]
    pred : Array{Float64}
        an array of prediction values 0 ≤ x ≤ 1

#### returns: Plots.Plot{Plots.GRBackend}
    plot of ROC AUC
"""
function roc_curve(actual::Array{Int}, pred::Array{Float64})
    # diagonal line
    p1 = plot(
        [0, 1],
        [0, 1],
        label = "",
        line = :dash,
        color = :black,
        ylim = (0, 1),
        xlim = (0, 1),
    )
    y, x, auc = roc_data(actual, pred)
    plot!(x, y, label = "AUC=$(round(auc, digits=4))", color = :blue)

    plot!(legend = :bottomright)
    plot!(
        ylabel = "True Positive Rate",
        xlabel = "False Positive Rate",
        title = "ROC and AUC",
    )
    return p1
end


## --- Weighted means

    # Plain vanilla weighted mean
    @test awmean([0,1,2,3],[1,1,1,1]) == (1.5, 0.5, 5/3)
    @test awmean(1:10,ones(10)) == (5.5, 0.31622776601683794, 9.166666666666666)

    # Weighted mean with geochronogists' MSWD-correction to uncertainty
    @test gwmean([0,1,2,3],[1,1,1,1]) == (1.5, 0.6454972243679028, 5/3)
    @test gwmean(1:10,ones(10)) == (5.5, 0.9574271077563381, 9.166666666666666)

    # Mean Square of Weighted Deviates (aka reduced chi-squared)
    @test MSWD(0:10, ones(11)) == 11
    @test MSWD([0,1,2],[1,1,1]) == 1.0

## --- York fit

    x = [0.9304, 2.2969, 2.8047, 3.7933, 5.3853, 6.1995, 6.7479, 8.1856, 8.7423, 10.2588]
    y = [0.8742, 2.1626, 3.042, 3.829, 5.0116, 5.5614, 6.7675, 7.8856, 9.6414, 10.4955]
    fobj = yorkfit(x, ones(10)/4, y, ones(10)/4)
    @test fobj.intercept ≈  -0.23498964673701916
    @test fobj.intercept_sigma ≈ 0.02250863813481163
    @test fobj.slope ≈ 1.041124018512526
    @test fobj.slope_sigma ≈ 0.0035683808205783673
    @test fobj.mswd ≈ 1.1419901440278089

    @test display(fobj) != NaN

## ---


using Turing, Random, MCMCChains
using CSV, DataFrames, StatsBase
using ParetoSmooth
using StatisticalRethinking

#Random.seed!(129111)

df = CSV.read(sr_datadir("WaffleDivorce.csv"), DataFrame)
df.D = zscore(df.Divorce)
df.M = zscore(df.Marriage)
df.A = zscore(df.MedianAgeMarriage)
data = (D=df.D, A=df.A)

function lin(a, b, c, x...)
    result = @. a + b * c
    for i in 1:2:length(x)
        @. result += x[i] * x[i+1]
    end
    return result
end

@model function m5_1t(A, D)
    a ~ Normal(0, 0.2)
    bA ~ Normal(0, 0.5)
    σ ~ Exponential(1)
    for i in eachindex(D)
        μ = lin(a, A[i], bA)
        D[i] ~ Normal(μ, σ)
    end
end

chn5_1t = sample(m5_1t(df.A, df.D), NUTS(1000, .9), MCMCThreads(), 1000, 4)

@model function m5_2t(M, D)
    a ~ Normal(0, 0.2)
    bM ~ Normal(0, 0.5)
    σ ~ Exponential(1)
    for i in eachindex(D)
        μ = lin(a, M[i], bM)
        D[i] ~ Normal(μ, σ)
    end
end

chn5_2t = sample(m5_2t(df.M, df.D), NUTS(1000, .9), MCMCThreads(), 1000, 4)

@model function m5_3t(A, M, D)
    a ~ Normal(0, 0.2)
    bA ~ Normal(0, 0.5)
    bM ~ Normal(0, 0.5)
    σ ~ Exponential(1)
    for i in eachindex(D)
        μ = a + M[i] * bM + A[i] * bA
        D[i] ~ Normal(μ, σ)
    end
end

chn5_3t = sample(m5_3t(df.A, df.M, df.D), NUTS(1000, .9), MCMCThreads(), 1000, 4)

pw_lls5_1t = pointwise_log_likelihoods(m5_1t(df.A, df.D), chn5_1t)
pw_lls5_2t = pointwise_log_likelihoods(m5_2t(df.M, df.D), chn5_2t)
pw_lls5_3t = pointwise_log_likelihoods(m5_3t(df.A, df.M, df.D), chn5_3t)

loo_comparison = ParetoSmooth.loo_compare([pw_lls5_1t, pw_lls5_2t, pw_lls5_3t];
    model_names=[:m5_1t, :m5_2t, :m5_3t])

for (i, psis) in enumerate(loo_comparison.psis)
    psis |> display
    pk_plot(psis.pointwise(:pareto_k))
    savefig(joinpath(@__DIR__, "m5.$(i)t.png"))
end
println()
Particles(chn5_1t[:,[:a, :bA, :σ],:]) |> display
Particles(chn5_2t[:,[:a, :bM, :σ],:]) |> display
Particles(chn5_3t[:,[:a, :bA, :bM, :σ],:]) |> display
loo_comparison |> display


export ortho_latin, check_ortho

"""
`A,B = ortho_latin(n)` returns a pair of orthogonal `n`-by-`n`
Latin squares.

`A,B = ortho_latin(n,true)` returns a pair of orthogonal Latin squares
that are transposes of each other.

`A,B = ortho_latin(n,r,s)` builds the Latin squares `latin(n,r)`
and `latin(n,s)` and, if they are orthogonal, returns them as the
answer. (Otherwise, throws an error.) See: `find_ortho_parameters`.
"""
function ortho_latin(n::Int, self::Bool=false)
    if !self
        try
            r,s = find_ortho_parameters(n)
            return ortho_latin(n,r,s)
        catch
        end
    end
    println("No quick solution. Using integer programming.")

    return ortho_latin_IP(n,self)
end

function ortho_latin_IP(n::Int,self::Bool=false)
    MOD = Model(get_solver())
    # Z[i,j,k,l] is an indicator that there is a k in A[i,j] and
    # an l in B[i,j]
    @variable(MOD,Z[1:n,1:n,1:n,1:n], Bin)

    # one entry per cell constraint
    for i=1:n
        for j=1:n
            @constraint(MOD, sum(Z[i,j,k,l] for k=1:n for l=1:n) == 1)
        end
    end

    # Top row 11 22 33 ... nn
    if !self
        for i=1:n
            @constraint(MOD, Z[1,i,i,i]==1)  # A[1,i] = B[1,i] = i
        end
    end

    # orthogonality constraint
    for k=1:n
        for l=1:n
            @constraint(MOD, sum(Z[i,j,k,l] for i=1:n for j=1:n) == 1)
        end
    end

    # Row constraints

    for i=1:n
        for k=1:n
            @constraint(MOD, sum(Z[i,j,k,l] for j=1:n for l=1:n) == 1)
        end
    end

    for i=1:n
        for l=1:n
            @constraint(MOD, sum(Z[i,j,k,l] for j=1:n for k=1:n) == 1)
        end
    end

    # Col constraints
    for j=1:n
        for k=1:n
            @constraint(MOD, sum(Z[i,j,k,l] for i=1:n for l=1:n) == 1)
        end
    end

    for j=1:n
        for l=1:n
            @constraint(MOD, sum(Z[i,j,k,l] for i=1:n for k=1:n) == 1)
        end
    end

    if self   # force A^T==B
        for i=1:n
            for j=1:n
                for k=1:n
                    for l=1:n
                        @constraint(MOD, Z[i,j,k,l] == Z[j,i,l,k])
                    end
                end
            end
        end
    end

    optimize!(MOD)
    status = Int(termination_status(MOD))

    if status != 1
        error("No pair of orthogonal Latin squares of order $n can be found.")
    end

    ZZ = value.(Z)
    A = zeros(Int,n,n)
    B = zeros(Int,n,n)

    for i=1:n
        for j=1:n
            for k=1:n
                for l=1:n
                    if ZZ[i,j,k,l]>0
                        A[i,j] = k
                        B[i,j] = l
                    end
                end
            end
        end
    end

    return A,B
end

function ortho_latin(n::Int, r::Int, s::Int)
    A = latin(n,r)
    B = latin(n,s)
    @assert check_ortho(A,B) "Parameters n=$n, r=$r, and s=$s do not generate a pair of orthogonal Latin squares"
    return A,B
end

"""
`find_ortho_parameters(n)` tries to find parameters `r` and `s`
so that `ortho_latin(n,r,s)` will succeed. Returns `(r,s)` if
successful or throws an error if not.
"""
function find_ortho_parameters(n::Int)
    for r=1:n-1
        for s=1:n-1
            if gcd(n,r)==1 && gcd(n,s)==1 && gcd(n,r-s)==1
                return r,s
            end
        end
    end
    error("No parameters for n=$n found")
end

"""
`check_ortho(A,B)` checks that matrices `A` and `B` are a pair of
orthogonal Latin squares.
"""
function check_ortho(A::Matrix{Int},B::Matrix{Int})::Bool
    if size(A) != size(B)
        return false
    end
    if !check_latin(A) || !check_latin(B)
        return false
    end
    n,r = size(A)

    vals = unique((n+1)*A + B)
    return length(vals) == n*n
end


#
# Me Learning Machine Learning
# Chapter 1: Julia and Knet
#
# In summary, I am (loosely) following the Knet tutorial
# (https://github.com/denizyuret/Knet.jl/blob/master/README.md#Tutorial-1)
# and adding lots of comments, including some of these noob-style "this line
# does x, y and z" comments (because I am a Julia noob :-) ).
#
# Leandro Motta Barros
#

using Knet

# ------------------------------------------------------------------------------
# Reading and pre-processing data
# ------------------------------------------------------------------------------

# This is based on the classic "Boston Housing" dataset, which I downloaded from
# https://archive.ics.uci.edu/ml/machine-learning-databases/housing/housing.data
# (see the file `housing.names` on the same server and directory for more info).
# This database contains 506 lines by 14 columns.

# Read the data into an array. By default, `readdlm` assumes that fields are
# separated by blanks -- quite handy, 'cause that's exactly what we have here.
rawdata = readdlm("housing.data") # [506 x 14]

# Take only the input (independent variables), which is everything but the 14th
# column. We also transpose the matrix, which at first seemed weird for me. It
# turns out that Julia stores arrays in column-major order, so having the data
# transposed will make it more efficient to iterate over the training examples.
x = rawdata[:,1:13]' # [13 x 506]

# Normalization of input variables. The operation itself is pretty standard,
# though the implementation might deserve a comment or two. Here (as in the
# previous line, indeed), there is a lot of Matlab/Octave taste. "Dot-operator"
# to execute element-wise operations. Second parameter to `mean` and `std` (`2`)
# meaning that the mean and standard deviation are to be made along the second
# dimension of the array. In other words, along all elements in a single column.
# Which, in still other words, is the same as saying that we are computing the
# mean and standard deviation among all values of each feature (recall that `x`
# was transposed in the previous line).
x = (x .- mean(x,2)) ./ std(x,2) # [13 x 506]

# Now take the expected output, which is on the 14th (and last) column in our
# data. Again, transpose.
y = rawdata[:,14:14]'

# ------------------------------------------------------------------------------
# Linear regression
# ------------------------------------------------------------------------------

# Initialize the weights. `randn` generates Gaussian-distributed random numbers
# with mean equals to zero and standard deviation of 1.0.

# TODO: Why this explicit array of `Any`? Why that additional zero?

w = Any[ 0.1 * randn(1,13), 0 ]

function train(w, data; lr = .1)
    for (x,y) in data
        dw = lossgradient(w, x, y)
        for i in 1:length(w)
            w[i] -= lr * dw[i]
        end
    end
    return w
end

show(w)

#print(x)


# These functions compute the sizes of combinations of parameters.

using Combinatorics: combinations

"""
    total_combinations(arity, n_way)

Given an array of the number of values for each parameter and the
level of coverage, return the number of n-tuples required for complete
coverage.
"""
function total_combinations(arity, n_way)
  param_cnt = length(arity)
  sum(prod(arity[key_set]) for key_set in combinations(1:param_cnt, n_way))
end

"""
    next_multiplicative!(values, arity)

Given a set of values for parameters, this returns the next possible
value. When it reaches the end, it cycles back to the start. The first
value is all ones. The last value equals the arity.
"""
function next_multiplicative!(values, arity)
    carry = 1
    for slot_idx in length(values):-1:1
        values[slot_idx] += carry
        if arity[slot_idx] < values[slot_idx]
            values[slot_idx] = 1
            carry = 1
        else
            carry = 0
        end
    end
end

"""
    all_combinations(arity, n_way)

This represents possible coverage as a matrix, one row per parameter,
zero if not used. `arity` is a list of the number of values for each parameter,
and `n_way` is the order of the combinations, most commonly 2-way.
"""
function all_combinations(arity, n_way)
    v_cnt = length(arity)
    # This returns a list of lists, so it has length, not size.
    indices = collect(combinations(1:v_cnt, n_way))
    combinations_cnt = total_combinations(arity, n_way)

    coverage = zeros(eltype(arity), v_cnt, combinations_cnt)
    idx = 1
    for indices_idx in 1:length(indices)
        offset = indices[indices_idx]
        sub_arity = arity[offset]
        sub_cnt = prod(sub_arity)
        values = copy(sub_arity)
        for sub_idx in 1:sub_cnt
            next_multiplicative!(values, sub_arity)
            coverage[offset, idx] = values
            idx += 1
        end
    end
    coverage
end

"""
    one_parameter_combinations(arity, n_way)

Generates all combinations that are nonzero for the last parameter.
This is for in-parameter-order generation, where we need
only those tuples that end with this column being nonzero.

The construction method is to leave out the given parameter
and construct all `n_way` - 1 tuples. Then copy and paste that
once for each possible value of the given parameter.
"""
function one_parameter_combinations(arity, n_way)
    param_cnt = length(arity)
    if n_way > 1
        partial = all_combinations(arity[1:(param_cnt-1)], n_way - 1)
        one_set = size(partial, 2)
        comb = zeros(eltype(arity), param_cnt, one_set * arity[param_cnt])
        for vidx in 1:(arity[param_cnt])
            col_begin = (vidx - 1) * one_set + 1
            col_end = vidx * one_set
            comb[1:size(partial, 1), col_begin:col_end] .= partial
            comb[param_cnt, col_begin:col_end] .= vidx
        end
    else  # n_way == 1
        comb = zeros(eltype(arity), param_cnt, arity[param_cnt])
        comb[param_cnt, :] .= 1:(arity[param_cnt])
    end
    comb
end

combination_number(n, m) = prod(n:-1:(n-m+1)) ÷ factorial(m)

function pairs_in_entry(entry, n_way)
    n = length(entry)
    ans = zeros(Int, combination_number(n, n_way), n)
    col_set_idx = 1
    for param_idx in combinations(1:length(entry), n_way)
        for row_idx in 1:n_way
            ans[param_idx[row_idx], col_set_idx] = entry[param_idx[row_idx]]
        end
        col_set_idx += 1
    end
    ans
end


# Example from "Bounds on the reachable sets of nonlinear control systems" Constant Temperature Profile
id = :ScottB2013a

pL = [420.0]
pU = [480.0]
ScottB2013a_x0(p::Vector{T}) where T = [1.5*one(T); 0.5*one(T); zero(T)]
function ScottB2013a_f!(du::Vector{T}, u::Vector{T}, p::Vector{T}, t) where T

    R = 8.134
    A1 = 2400
    A2 = 8800
    E1 = 6.9*10^3
    E2 = 1.69*10^4

    du[1] = -A1*exp(E1/(R*p[1]))*u[1]
    du[2] = A1*exp(E1/(R*p[1]))*u[1] - A2*exp(E2/(R*p[1]))*u[2]
    du[3] = A2*exp(E2/(R*p[1]))*u[2]
    return
end
tspan = (0.0, 0.08)

prob = ODERelaxProb(ScottB2013a_f!, tspan, ScottB2013a_x0, pL, pU)
url = "https://www.sciencedirect.com/science/article/pii/S0005109812004839"
source = "ScottB2013"
desc = "3 Series Rxn Network"


using StanModels, CSV

df = CSV.read(joinpath(@__DIR__, "..", "..", "data", "milk.csv"), delim=';')
dcc = filter(row -> !(row[:neocortex_perc] == "NA"), df)
dcc[!, :kcal_per_g] = convert(Vector{Float64}, dcc[!, :kcal_per_g])
dcc[!, :neocortex_perc] = parse.(Float64, dcc[!, :neocortex_perc])

# Show first 5 rows

first(dcc, 5)

# Define the Stan language model

m5_5s = "
data{
    int N;
    vector[N] kcal_per_g;
    vector[N] neocortex_perc;
}
parameters{
    real a;
    real bn;
    real sigma;
}
model{
    vector[N] mu = a + bn * neocortex_perc;
    sigma ~ uniform( 0 , 1 );
    bn ~ normal( 0 , 1 );
    a ~ normal( 0 , 100 );
    kcal_per_g ~ normal( mu , sigma );
}
";

# Define the Stanmodel and set the output format to :mcmcchains.

sm = SampleModel("m5.5s", m5_5s);

# Input data for cmdstan

m5_5_data = Dict("N" => size(dcc, 1),
  "kcal_per_g" => dcc[!, :kcal_per_g],
  "neocortex_perc" => dcc[!, :neocortex_perc]);

# Sample using cmdstan

(sample_file, log_file) = stan_sample(sm, data=m5_5_data);

# Rethinking results

rethinking_results = "
       mean   sd  5.5% 94.5%
 a     0.04 0.15 -0.21  0.29
 bN    0.13 0.22 -0.22  0.49
 sigma 1.00 0.16  0.74  1.26
"

# Describe the draws
if !(sample_file == nothing)
  chn = read_samples(sm)
  describe(chn)
end


"A basis of Chebyshev polynomials of the second kind on the interval `[-1,1]`."
struct ChebyshevU{T} <: OPS{T}
    n			::	Int
end

ChebyshevU(n::Int) = ChebyshevU{Float64}(n)

similar(b::ChebyshevU, ::Type{T}, n::Int) where {T} = ChebyshevU{T}(n)

show(io::IO, d::ChebyshevU{Float64}) = print(io, "ChebyshevU($(length(d)))")
show(io::IO, d::ChebyshevU{T}) where T = print(io, "ChebyshevU{$(T)}($(length(d)))")

function unsafe_eval_element(b::ChebyshevU, idx::PolynomialDegree, x::Real)
    # Don't use the formula when |x|=1, because it will generate NaN's
    d = degree(idx)
    abs(x) < 1 ? sin((d+1)*acos(x))/sqrt(1-x^2) : recurrence_eval(b, idx, x)
end

first_moment(b::ChebyshevU{T}) where {T} = convert(T, pi)/2

interpolation_grid(b::ChebyshevU{T}) where {T} = ChebyshevUNodes{T}(b.n)

iscompatible(dict::ChebyshevU, grid::ChebyshevUNodes) = length(dict) == length(grid)
issymmetric(::ChebyshevU) = true
measure(dict::ChebyshevU{T}) where {T} = ChebyshevUWeight{T}()
hasmeasure(::ChebyshevU) = true

function innerproduct_native(b1::ChebyshevU, i::PolynomialDegree, b2::ChebyshevU, j::PolynomialDegree, m::ChebyshevUWeight;
			T = coefficienttype(b1), options...)
	if i == j
		convert(T, pi)/2
	else
		zero(T)
	end
end

# Parameters alpha and beta of the corresponding Jacobi polynomial
jacobi_α(b::ChebyshevU{T}) where {T} = one(T)/2
jacobi_β(b::ChebyshevU{T}) where {T} = one(T)/2

# See DLMF, Table 18.9.1
# http://dlmf.nist.gov/18.9#i
rec_An(b::ChebyshevU{T}, n::Int) where {T} = convert(T, 2)

rec_Bn(b::ChebyshevU{T}, n::Int) where {T} = zero(T)

rec_Cn(b::ChebyshevU{T}, n::Int) where {T} = one(T)

support(b::ChebyshevU{T}) where {T} = ChebyshevInterval{T}()

"A Chebyshev polynomial of the second kind"
struct ChebyshevUPolynomial{T} <: OrthogonalPolynomial{T}
    degree  ::  Int
end

ChebyshevUPolynomial{T}(p::ChebyshevUPolynomial) where {T} = ChebyshevUPolynomial{T}(p.degree)

show(io::IO, p::ChebyshevUPolynomial) = print(io, "U_$(degree(p))(x) (Chebyshev polynomial of the second kind)")

convert(::Type{TypedFunction{T,T}}, p::ChebyshevUPolynomial) where {T} = ChebyshevUPolynomial{T}(p.degree)

support(::ChebyshevUPolynomial{T}) where {T} = ChebyshevInterval{T}()

(p::ChebyshevUPolynomial{T})(x) where {T} = eval_element(ChebyshevU{T}(degree(p)+1), degree(p)+1, x)

basisfunction(dict::ChebyshevU, idx) = basisfunction(dict, native_index(dict, idx))
basisfunction(dict::ChebyshevU{T}, idx::PolynomialDegree) where {T} = ChebyshevUPolynomial{T}(degree(idx))

dictionary(p::ChebyshevUPolynomial{T}) where {T} = ChebyshevU{T}(degree(p)+1)
index(p::ChebyshevUPolynomial) = degree(p)+1


include("spline_kernel.jl")

# Removing t = 0, such that Σ is invertible
t = Vector(0.1:0.1:1)
n = length(t);

# Creating a test matrix Σ = tril(UV') + triu(VU',1) that is PSD
p = 2;
U, V = spline_kernel(t, p);
Σ    = spline_kernel_matrix(U, V) + I;
chol = cholesky(Σ)

# Creating a symmetric exended generator representable semiseperable matrix
K  = DiaSymSemiseparable(U,V,ones(n))
# Calculating its Cholesky factorization
L = DiaSymSemiseparableChol(K)
# Creating a test vector
x = randn(n);

# Testing multiplication
@test isapprox(L*x, chol.L*x, atol=1e-6)
@test isapprox(L'*x, chol.U*x, atol=1e-6)

# Testing inverses (Using Cholesky factorizations)
@test isapprox(L'\(L\x), chol.U\(chol.L\x), atol=1e-6)
@test isapprox(inv(L), chol.U\(chol.L\Diagonal(ones(K.n))), atol=1e-6)
@test isapprox(inv(L,x), chol.U\(chol.L\x), atol=1e-6)
@test isapprox(K*(K\x), x)
@test isapprox(K'*(K'\x), x)

# Testing logdet
@test isapprox(logdet(L), logdet(chol.L), atol=1e-10)
@test isapprox(logdet(L'), logdet(chol.U), atol=1e-10)

# Testing traces
@test isapprox(tr(L), tr(chol.L)) # Trace of L
@test isapprox(trinv(L), tr(chol\Diagonal(ones(K.n)))) # Trace of (K+D)^(-1)
D = SymSemiseparable(U,V);
@test isapprox(tr(L,D), tr(chol\spline_kernel_matrix(U, V))) # Trace of (K+D)^(-1)K

# Testing using the SymSemiseparableChol struct as a lower triangular matrix
C = DiaSymSemiseparableChol(U,V,ones(K.n));
@test isapprox(C*x, (tril(U*V',-1) + I)*x)


# indicator of the L2 norm ball with given radius

"""
  IndBallL2(r::Real=1.0)

Returns the function `g = ind{x : ||x|| ⩽ r}`, for a real parameter `r > 0`.
"""

immutable IndBallL2{R <: Real} <: IndicatorConvex
  r::R
  function IndBallL2(r::R)
    if r <= 0
      error("parameter r must be positive")
    else
      new(r)
    end
  end
end

IndBallL2{R <: Real}(r::R=1.0) = IndBallL2{R}(r)

function (f::IndBallL2){T <: RealOrComplex}(x::AbstractArray{T})
  if vecnorm(x) - f.r > 1e-14
    return +Inf
  end
  return 0.0
end

function prox!{T <: RealOrComplex}(f::IndBallL2, x::AbstractArray{T}, y::AbstractArray{T}, gamma::Real=1.0)
  scal = f.r/vecnorm(x)
  if scal > 1
    y[:] = x
    return 0.0
  end
  for k in eachindex(x)
    y[k] = scal*x[k]
  end
  return 0.0
end

fun_name(f::IndBallL2) = "indicator of an L2 norm ball"
fun_dom(f::IndBallL2) = "AbstractArray{Real}, AbstractArray{Complex}"
fun_expr(f::IndBallL2) = "x ↦ 0 if ||x|| ⩽ r, +∞ otherwise"
fun_params(f::IndBallL2) = "r = $(f.r)"

function prox_naive{T <: RealOrComplex}(f::IndBallL2, x::AbstractArray{T}, gamma::Real=1.0)
  normx = vecnorm(x)
  if normx > f.r
    y = (f.r/normx)*x
  else
    y = x
  end
  return y, 0.0
end


using GeometryTypes
using SurfaceTopology
using LinearAlgebra

function quadraticform(vects,vnormal)

    Lx = [0 0 0; 0 0 -1; 0 1 0]
    Ly = [0 0 1; 0 0 0; -1 0 0]
    Lz = [0 -1 0; 1 0 0; 0 0 0]

    d = [0,0,1] + vnormal
    d /= norm(d)

    Ln = d[1]*Lx + d[2]*Ly + d[3]*Lz
    R = exp(pi*Ln)

    vects = copy(vects)
    for vj in 1:length(vects)
        vects[vj] = R*vects[vj]
    end

    ### Construction of the system
    A = Array{Float64}(undef,3,3)
    B = Array{Float64}(undef,3)

    vects_norm2 = Array{Float64}(undef,length(vects))
    for vj in 1:length(vects)
       vects_norm2[vj] = norm(vects[vj])^2
    end

    A[1,1] = sum((v[1]^4 for v in vects) ./ vects_norm2)
    A[1,2] = sum((v[1]^3*v[2] for v in vects) ./ vects_norm2)
    A[1,3] = sum((v[1]^2*v[2]^2 for v in vects) ./ vects_norm2)
    A[2,1] = A[1,2]
    A[2,2] = A[1,3]
    A[2,3] = sum( (v[2]^3*v[1] for v in vects) ./vects_norm2)
    A[3,1] = A[1,3]
    A[3,2] = A[2,3]
    A[3,3] = sum((v[2]^4 for v in vects) ./vects_norm2)

    B[1] = sum((v[3]*v[1]^2 for v in vects) ./vects_norm2)
    B[2] = sum((v[1]*v[2]*v[3] for v in vects) ./vects_norm2)
    B[3] = sum((v[2]^2*v[3] for v in vects) ./vects_norm2)

    C,D,E = A\B
    return C,D,E
end

function meancurvature(points,topology)
    curvatures = Array{Float64}(undef,length(points))
    for v in 1:length(points)

        s = Point(0,0,0)
        for (v1,v2) in EdgeRing(v,topology)
            s += cross(points[v2],points[v1])
        end
        normal = s ./ norm(s)

        vring = collect(VertexRing(v,topology))
        vects = [points[vi] - points[v] for vi in vring]

        C,D,E = quadraticform(vects,normal)

        A = [C D/2;D/2 E]
        k1,k2 = eigvals(-A)
        H = (k1 + k2)/2

        ### Multiplier by is 2 an empirical fix
        curvatures[v] = 2*H
    end
    return curvatures
end

function normals(vertices,topology)
    n = Point{3,Float64}[]
    for v in 1:length(vertices)
        s = Point(0,0,0)
        for (v1,v2) in EdgeRing(v,topology)
            s += cross(vertices[v2],vertices[v1])
        end
        normal = s ./ norm(s)
        push!(n,normal)
    end
    return n
end

function vertexareas(points,topology)
    vareas = zeros(Float64,length(points))
    for face in Faces(topology)
        v1,v2,v3 = face
        area = norm(cross(points[v2]-points[v1],points[v3]-points[v1])) /2
        vareas[v1] += area/3
        vareas[v2] += area/3
        vareas[v3] += area/3
    end
    return vareas
end

function surfacevolume(points,topology)
    # Calculate face normal
    # Calculate projected area
    # Calculate ordinary volume
    # Calculate volume between projected and real area
    # (+) if normal is outwards

    normal0 = [0,0,1]
    s = 0
    for face in Faces(topology)
        y1 = points[face[1]]
        y2 = points[face[2]]
        y3 = points[face[3]]

        normaly = cross(y2-y1,y3-y1)
        normaly /= norm(normaly)

        area = norm(cross(y2-y1,y3-y1))/2
        areaproj = dot(normaly,normal0)*area
        volume = dot(y1 + y2 + y3,normal0)/3*areaproj

        s += volume
    end

    return s
end


"""
	random_density(n)

Returns a random ``N × N`` density matrix, distributed according to the
Hilbert-Schmidt measure.

NOTE: No guarantee about the quality of the algorithm
For more details see [V Al Osipov et al 2010 J. Phys. A: Math. Theor. 43 055302]
(https://doi.org/10.1088/1751-8113/43/5/055302)
"""
function random_density_matrix(n)
    A = randn(n,n) + 1im * randn(n,n)
    rho = A * A'
    return rho / tr(rho)
end

"""
	unitary_op(H, t)

Returns the unitary evolution operator ``U = \\exp[-i H t]``.
"""
function unitary_op(H, t)
   return exp(-1im * Matrix(H) * t)
end

"""
    commutator(A, B)

Returns the commutator [A,B] = A * B - B * A between two matrices
"""
function commutator(a, b)
	a * b - b * a
end

"""
	localized_state(N, i)

Returns the density operator for a state ``|i⟩`` in an ``N``-dimensional Hilbert
space
"""
function localized_state(n, i)
   sparse([i,n],[i,n],[1,0])
end


# # Chebyshev transform
# This demonstrates the Chebyshev transform and inverse transform,
# explaining precisely the normalization and points

using FastTransforms
n = 20

# First kind points $\to$ first kind polynomials
p_1 = chebyshevpoints(Float64, n, Val(1))
f = exp.(p_1)
f̌ = chebyshevtransform(f, Val(1))
f̃ = x -> [cos(k*acos(x)) for k=0:n-1]' * f̌
f̃(0.1) ≈ exp(0.1)

# First kind polynomials $\to$ first kind points
ichebyshevtransform(f̌, Val(1)) ≈ exp.(p_1)

# Second kind points $\to$ first kind polynomials
p_2 = chebyshevpoints(Float64, n, Val(2))
f = exp.(p_2)
f̌ = chebyshevtransform(f, Val(2))
f̃ = x -> [cos(k*acos(x)) for k=0:n-1]' * f̌
f̃(0.1) ≈ exp(0.1)

# First kind polynomials $\to$ second kind points
ichebyshevtransform(f̌, Val(2)) ≈ exp.(p_2)

# First kind points $\to$ second kind polynomials
p_1 = chebyshevpoints(Float64, n, Val(1))
f = exp.(p_1)
f̌ = chebyshevutransform(f, Val(1))
f̃ = x -> [sin((k+1)*acos(x))/sin(acos(x)) for k=0:n-1]' * f̌
f̃(0.1) ≈ exp(0.1)

# Second kind polynomials $\to$ first kind points
ichebyshevutransform(f̌, Val(1)) ≈ exp.(p_1)

# Second kind points $\to$ second kind polynomials
p_2 = chebyshevpoints(Float64, n, Val(2))[2:n-1]
f = exp.(p_2)
f̌ = chebyshevutransform(f, Val(2))
f̃ = x -> [sin((k+1)*acos(x))/sin(acos(x)) for k=0:n-3]' * f̌
f̃(0.1) ≈ exp(0.1)

# Second kind polynomials $\to$ second kind points
ichebyshevutransform(f̌, Val(2)) ≈ exp.(p_2)