struct ProductNumbers <: AbstractRelativeRoots
  z::Distributions.Normal
end
getSample(s::ProductNumbers, N::Int=1) = (reshape(rand(s.z,N),1,:), )

function (s::ProductNumbers)(res::AbstractArray{<:Real},
      userdata::FactorMetadata,
      idx::Int,
      meas::Tuple{<:AbstractArray{<:Real,2}},
      X::AbstractArray{<:Real,2},
      Y::AbstractArray{<:Real,2},
      XY::AbstractArray{<:Real,2}  )
  #
  res[1] = XY[1,idx] - X[1,idx]*Y[1,idx] + meas[1][1,idx]
  nothing
end

struct AreEqual <: AbstractRelativeRoots
  z::Distributions.Normal
end
function getSample(cf::CalcFactor{<:AreEqual}, N::Int=1)
  return ([rand(cf.factor.z,1) for _ in 1:N], )
end

function (cf::CalcFactor{<:AreEqual})(meas,
                                      X,
                                      Y  )
  #
  return X[1]-Y[1] + meas[1]
end

struct Square <: AbstractRelativeRoots
  z::Distributions.Normal
end
getSample(cf::CalcFactor{<:Square}, N::Int=1) = (reshape(rand(cf.factor.z,N),1,:), )

function (cf::CalcFactor{<:Square})(meas,
                                    X,
                                    XX  )
  #
  return XX[1] - X[1]*X[1] + meas[1]
end

mutable struct NumbersPrior <: AbstractPrior
  z::ManifoldKernelDensity
end
getSample(cf::CalcFactor{<:NumbersPrior}, N::Int=1) = (reshape(rand(cf.factor.z,N),1,:), )


##########################################################################
# Copyright 2017 Samuel Ridler.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
##########################################################################

# P-median problem

pMedianDefaultOptions = Dict([:x_bin => true, :y_bin => false, :solver => "gurobi", :solver_args => [], :solver_kwargs => []])
try Gurobi catch; pMedianDefaultOptions[:solver] = "cbc" end

"""
	solvePMedian(n::Int, c::Array{Float,2}; options::Dict{Symbol,T} = pMedianDefaultOptions, results::Dict = Dict()) where T <: Any
Solves the p-median problem for `n` facilities and costs `c` where `c[i,j]` is the cost of serving demand point `j` from facility location `i`.
The p-median problem is to locate facilities in order to minimise the total cost of serving demand, where each demand point is served by the facility which can serve the point at lowest cost.
Returns a vector indicating which facility locations to use.
`results` will store results such as the objective value and decision variable values.
"""
function solvePMedian(n::Int, c::Array{Float,2}; options::Dict{Symbol,T} = pMedianDefaultOptions, results::Dict = Dict()) where T <: Any
	@assert(n >= 1)
	s, d = size(c) # number of potential facilities, number of demand points

	global pMedianDefaultOptions
	defaultOptions = copy(pMedianDefaultOptions)
	merge!(defaultOptions, options)

	m = model = Model()

	# solver
	solver = options[:solver]
	args = options[:solver_args]
	kwargs = options[:solver_kwargs]
	if solver == "cbc" set_optimizer(model, with_optimizer(Cbc.Optimizer, logLevel=0, args...; kwargs...))
	elseif solver == "glpk" set_optimizer(model, with_optimizer(GLPK.Optimizer, args...; kwargs...))
	elseif solver == "gurobi" @stdout_silent(set_optimizer(model, with_optimizer(Gurobi.Optimizer, OutputFlag=0, args...; kwargs...)))
	end

	# variables
	options[:x_bin] ? @variable(m, x[i=1:s], Bin) : @variable(m, 0 <= x[i=1:s] <= 1) # x[i] = 1 if one facility at location i, 0 otherwise
	options[:y_bin] ? @variable(m, y[i=1:s,j=1:d], Bin) : @variable(m, 0 <= y[i=1:s,j=1:d] <= 1) # y[i,j] = 1 if facility at location i serves point j

	@constraints(model, begin
		(maxFacilityCount, sum(x) <= n)
		(serveDemandFromOpenFacilities[i=1:s,j=1:d], y[i,j] <= x[i]) # can only serve point j from facility location i if it is opened
		(demandServedBySingleFacility[j=1:d], sum(y[:,j]) == 1)
	end)

	@expressions(model, begin
		cost, sum(c.*y)
	end)

	# solve
	@objective(model, Min, cost)
	@stdout_silent optimize!(model)
	@assert(termination_status(model) == MOI.OPTIMAL)

	results[:cost] = JuMP.value.(cost)
	results[:x] = JuMP.value.(x)
	results[:y] = JuMP.value.(y)
	results[:model] = model

	solution = convert(Vector{Int}, round.(results[:x])) # solution[i] = 1 if facility location i should be used, 0 otherwise
	return solution
end


function bondtensor(::Type{TT}, J) where TT
    TT.([J -J; -J J])
end

function vertextensor(::Type{TT}, h) where TT
    TT.([h, -h])
end

function copytensor(::Type{T}) where T
    Diagonal([one(T), zero(T), zero(T), one(T)])
end

function resettensor(::Type{T}) where T
    [one(T) one(T); zero(T) zero(T)]
end

"""
    hypercubicI([T], ndim::Int, D::Int)

Get a `ndim`-dimensional identity hypercubic, with bound dimension `D`.
"""
function hypercubicI(::Type{T}, ndim::Int, D::Int) where T
    res = zeros(T, fill(D, ndim)...)
    @inbounds for i=1:D
        res[fill(i,ndim)...] = one(T)
    end
    return res
end

hypercubicI(ndim::Int, D::Int) = hypercubicI(Float64, ndim, D)

Gh(vertex_tensor::Vector{T}) where T = tropicalblock(Diagonal(vertex_tensor))
Gvb(bond_tensor::Matrix{T}) where T = tropicalblock(Diagonal([bond_tensor...]))
Ghb(bond_tensor::Matrix{T}) where T = tropicalblock(transpose(bond_tensor))
function G16(::Type{TT}, Js) where TT<:TropicalTypes
    xs = map(x->_bondtensor(TT, x), Js)
    mat = zeros(TT, 2, 2, 2, 2, 2, 2, 2, 2)
    for a=1:2, α=1:2, β=1:2, b=1:2, γ=1:2, c=1:2, d=1:2, δ=1:2
        mat[a,b,c,d,α,β,γ,δ] += xs[1][a,α] * xs[2][a,β] * xs[3][a,γ] * xs[4][a,δ] *
        xs[5][b,α] * xs[6][b,β] * xs[7][b,γ] * xs[8][b,δ] * xs[9][c,α] * xs[10][c,β] *
        xs[11][c,γ] * xs[12][c,δ] * xs[13][d,α] * xs[14][d,β] * xs[15][d,γ] * xs[16][d,δ]
    end
    tropicalblock(reshape(mat, 16, 16))
end

function _bondtensor(::Type{TT}, J) where TT
    TT.([J -J; -J J])
end

"""
    Gcp(T)

copy state of qubit 2 -> 1.
"""
function Gcp(::Type{TT}) where TT
    tropicalblock(copytensor(TT))
end

function Greset(::Type{TT}) where TT
    tropicalblock([one(TT) one(TT); zero(TT) zero(TT)])
end

function Gcut(::Type{TT}) where TT
    tropicalblock([one(TT) one(TT); one(TT) one(TT)])
end


export Chebyshev

function Chebyshev(nlp_stop,
				   PData :: PDataFact,
				   dₙ :: Vector,
				   gt :: Vector)
	# printstyled("on est dans Chebyshev  \n", color = :yellow)
	T = eltype(gt)
	# @show T
	nlp_at_x = nlp_stop.current_state
	x = nlp_at_x.x
	# xdemi = NaN * rand(length(dₙ))
	# @show x
	# @show ∇f³xuv
	# @show typeof(nlp_stop.pb)
	Tdndn = ∇f³xuv(nlp_stop.pb, x, dₙ, dₙ)
	# printstyled("on a Tdndn  \n", color = :yellow)

	ϵ2 =  sqrt(eps(eltype(gt)))
   	Γ = max.(abs.(PData.Δ), ϵ2)

	d̃ = PData.L \ Tdndn[PData.pp]
    d̂ = PData.L' \ (PData.Q * (PData.Q' * d̃ ./ Γ))
    d = -d̂[invperm(PData.pp)]

	dC = dₙ + T(0.5) * d
	return dC
end


# Base model struct
Base.@kwdef mutable struct graded{T <: AbstractFloat} <: IRTmodel
    a::AbstractVector{T} = [0.0]
    d::AbstractVector{T} = [0.0]
    group::Vector{Int64} = [1]
    fixed::Bool = false
    # graded(;a = [0.0], d = [0.0], group = [1], fixed = true) = new(a, d, group, fixed)
end

function _distribute!(new, old::graded)
    old.a = new[begin:length(old.a)]
    old.d = new[length(old.a)+1:end]
end

function _distribute!(new, old::graded, q)
    old.a = new[begin:length(old.a)][q]
    old.d = new[length(old.a)+1:end]
end

function _distribute(new, old::graded)
    out = copy(old)
    out.a = new[begin:length(out.a)]
    out.d = new[length(out.a)+1:end]
    return out
end

function _distribute(new, old::graded, q)
    out = copy(old)
    out.a = new[begin:length(out.a)][q]
    out.d = new[length(out.a)+1:end]
    return out
end

function _take(par::graded)
    return [par.a; par.d]
end

function _take(par::graded, q)
    return [par.a[q]; par.d]
end

function _copy(x::graded)
    graded(a = x.a, d = x.d, group = x.group, fixed = x.fixed)
end

function _rescale!(par::graded, μ, Σ, q)
    if length(q) == 1
        # This item follows unidimensional model.
        A = 1/ sqrt(Σ[1]); K = -A*μ[1]
        par.a = par.a / A
        par.d = @. par.d - par.a*K/A
    else
        # This item seems to follow the multidimensional model.
        L = cholesky(Hermitian(Σ)).L
        tmp = par.a' * L
        par.a =  tmp'# Dimension mismatch ?
        par.d = par.d .+ par.a' * μ
    end
end

function _irf(p::graded, θ, u, q)::Float64
    if u == 0
        return 1.0 - logistic(p.a[q]'θ[q] + p.d[u+1])
    elseif u == length(p.d)
        return logistic(p.a[q]'θ[q] + p.d[u])
    else
        return logistic(p.a[q]'θ[q] + p.d[u]) - logistic(p.a[q]'θ[q] + p.d[u+1])
    end
end

function _irf(p, m::graded, θ, u, q)::eltype(p)
    a = p[1:length(m.a[q])]
    d = p[length(m.a[q])+1:end]
    if u == 0
        return 1.0 - logistic(a'θ[q] + d[u+1])
    elseif u == length(d)
        return logistic(a'θ[q] + d[u])
    else
        return logistic(a'θ[q] + d[u]) - logistic(a'θ[q] + d[u+1])
    end
end


"""
    SixDOFBodyEuler
    SixDOFBodyEuler(x::AbstractVector)
    SixDOFBodyEuler(dss::DSState)

Six degrees of freedom dynamic system using u, v, w for velocity representation and Euler
angles for attitude.

Flat Earth hypothesis is applied and Earth reference frame is considered inertial.

It is considered that the aircraft xb-zb plane is a plane of symmetry so that Jxy and Jyz
cross-product of inertia are zero and will not be taken into account.

# Fields
- `x::SVector{13, T}`: state vector.
  - [u (m/s), v (m/s), w (m/s), ϕ (rad), θ (rad), ψ (rad), p (rad/s), q (rad/s), r (rad/s),
    x (m), y (m), z (m), pow (%)].
"""
struct SixDOFBodyEuler{T}<:DSState{T}
    x::SVector{13, T}
end

SixDOFBodyEuler(x::AbstractVector) = SixDOFBodyEuler(SVector{13, eltype(x)}(x))

SixDOFBodyEuler(dss::DSState) = SixDOFBodyEuler(
    [
        get_body_velocity(dss)...,
        get_euler_angles(dss)[3:-1:1]...,
        get_ang_vel_body(dss)...,
        get_earth_position(dss)...,
        get_engine_power(dss),
    ]
)

get_x_names(dss::SixDOFBodyEuler) = [:u, :v, :w, :ϕ, :θ, :ψ, :p, :q, :r, :x, :y, :z, :pow]

# Mandatory getters for DSState
get_earth_position(dss::SixDOFBodyEuler) = get_x(dss)[10:12]
get_height(dss::SixDOFBodyEuler) = -get_x(dss)[12]

get_euler_angles(dss::SixDOFBodyEuler) = get_x(dss)[6:-1:4]

get_tas(dss::SixDOFBodyEuler) = get_tasαβ(dss)[1]
get_α(dss::SixDOFBodyEuler) = get_tasαβ(dss)[2]
get_β(dss::SixDOFBodyEuler) = get_tasαβ(dss)[3]
get_tasαβ(dss::SixDOFBodyEuler) = uvw_to_tasαβ(get_body_velocity(dss)...)
get_body_velocity(dss::SixDOFBodyEuler) = get_x(dss)[1:3]
get_horizon_velocity(dss::SixDOFBodyEuler) = body2horizon(
    get_body_velocity(dss)..., get_euler_angles(dss)...
)

get_ang_vel_body(dss::SixDOFBodyEuler) = get_x(dss)[7:9]
get_euler_angles_rates(dss::SixDOFBodyEuler) = pqr_2_ψθϕ_dot(
    get_ang_vel_body(dss)..., get_euler_angles(dss)[2:3]...
)

get_engine_power(dss::SixDOFBodyEuler) = get_x(dss)[13]

# Mandatory getters for DSStateDot
get_tas_dot(dssd::DSStateDot{S, N, T}) where {S<:SixDOFBodyEuler, N, T} = get_tasαβ_dot(dssd)[1]
get_α_dot(dssd::DSStateDot{S, N, T}) where {S<:SixDOFBodyEuler, N, T} = get_tasαβ_dot(dssd)[2]
get_β_dot(dssd::DSStateDot{S, N, T}) where {S<:SixDOFBodyEuler, N, T} = get_tasαβ_dot(dssd)[3]
get_tasαβ_dot(dssd::DSStateDot{S, N, T}) where {S<:SixDOFBodyEuler, N, T} = uvw_dot_to_tasαβ_dot(
    get_x(dssd)[1:3]..., get_xdot(dssd)[1:3]...
)
get_accel_body(dssd::DSStateDot{S, N, T}) where {S<:SixDOFBodyEuler, N, T} = get_xdot(dssd)[1:3]
get_ang_accel_body(dssd::DSStateDot{S, N, T}) where {S<:SixDOFBodyEuler, N, T} = get_xdot(dssd)[7:9]
get_engine_power_dot(dssd::DSStateDot{S, N, T}) where {S<:SixDOFBodyEuler, N, T} = get_xdot(dssd)[13]

function state_eqs(dss::SixDOFBodyEuler, time, mass, inertia, forces, moments, h, pow_dot)

    xdot = sixdof_body_earth_euler_fixed_mass(
         time,
         get_x(dss),
         mass,
         inertia,
         forces,
         moments,
         h
    )

    xdot = [xdot..., pow_dot]

    return DSStateDot(dss, xdot)
end

"""
    sixdof_body_earth_euler_fixed_mass!(x_dot, time, x, mass, inertia, forces, moments, h)

Mutating version of [sixdof_body_earth_euler_fixed_mass](@ref).
"""
function sixdof_body_earth_euler_fixed_mass!(
    x_dot, time, x, mass, inertia, forces, moments, h
    )

    m = mass
    u, v, w, ϕ, θ, ψ, p, q, r, xe, ye, ze = x

    # Unpack forces
    Fx, Fy, Fz = forces
    # Unpack moments
    L, M, N = moments
    # Unpack angular momentum contributions
    hx, hy, hz = h
    # Unpack inertia
    Ixx, Iyy, Izz = inertia[1, 1], inertia[2, 2], inertia[3, 3]
    Ixz = inertia[1, 3]

    sψ, cψ = sin(ψ), cos(ψ)
    sθ, cθ = sin(θ), cos(θ)
    sϕ, cϕ = sin(ϕ), cos(ϕ)

    # Linear momentum equations
    x_dot[1] = Fx / m + r * v - q * w
    x_dot[2] = Fy / m - r * u + p * w
    x_dot[3] = Fz / m + q * u - p * v

    # Moments
    pq = p * q
    qr = q * r

    rhy_qhz = (r * hy - q * hz)
    qhx_phy = (q * hx - p * hy)

    # If inertia is constant this terms are constant too.
    # TODO: think about passing them as arguments to improve speed.
    IxzS = Ixz^2
    xpq = Ixz * (Ixx - Iyy + Izz)
    gam = Ixx * Izz - IxzS
    xqr = Izz * (Izz - Iyy) + IxzS
    zpq = (Ixx - Iyy) * Ixx + IxzS
    ypr = Izz - Ixx

    # Angular momentum equations
    x_dot[7] = (xpq * pq - xqr * qr + Izz * (L + rhy_qhz) + Ixz * (N + qhx_phy)) / gam
    x_dot[8] = (ypr * p * r - Ixz * (p^2 - r^2) + M - r * hx + p * hz) / Iyy
    x_dot[9] = (zpq * pq - xpq * qr + Ixz * (L + rhy_qhz) + Ixx * (N + qhx_phy)) / gam

    # Angular Kinematic equations
    x_dot[6] = (q * sϕ + r * cϕ) / cθ
    x_dot[5] = q * cϕ - r * sϕ
    # ϕ_dot = p + (q * sϕ + r * cϕ) * tan(θ)
    x_dot[4] = p + x_dot[6] * sθ

    # Linear kinematic equations
    x_dot[10] =  cθ*cψ * u + (sϕ*sθ*cψ - cϕ*sψ) * v + (cϕ*sθ*cψ + sϕ*sψ) * w
    x_dot[11] =  cθ*sψ * u + (sϕ*sθ*sψ + cϕ*cψ) * v + (cϕ*sθ*sψ - sϕ*cψ) * w
    x_dot[12] = -sθ    * u +  sϕ*cθ             * v +  cϕ*cθ             * w

end

"""
    sixdof_body_earth_euler_fixed_mass(time, x, mass, inertia, forces, moments, h)

State equations for `SixDOFBodyEuler` dynamic system.

# Arguments

- `time::Number`: time (s).
- `x::AbstractArray`: state vector.
  - [u (m/s), v (m/s), w (m/s), ϕ (rad), θ (rad), ψ (rad), p (rad/s), q (rad/s), r (rad/s),
    x (m), y (m), z (m), pow (%)].
- `mass::Number`: mass (kg).
- `inertia::AbstractMatrix`: 3x3 inertia tensor (kg·m^2).
- `forces::AbstractVector`: body axis forces [Fx, Fy, Fz] (N).
- `moments::AbstractVector`: body axis moments (L, M, N) (N·m).
- `h::AbstractVector`:  Additional angular momentum contributions such as those coming from
 spinning rotors (kg·m²/s).

# Returns
- `x_dot::Array`: time derivative of the state vector.

# Notes

It is considered that the aircraft xb-zb plane is a plane of symmetry so that Jxy and Jyz
cross-product of inertia are zero and will not be taken into account.

# See also

[six_dof_body_euler_fixed_mass!](@ref)
"""
function sixdof_body_earth_euler_fixed_mass(time, x, mass, inertia, forces, moments, h)
    x_dot = Array{eltype(x)}(undef, 12)
    sixdof_body_earth_euler_fixed_mass!(x_dot, time, x, mass, inertia, forces, moments, h)
    return x_dot
end


@testset "8.7 Zeta function" begin
    (a, b, s, x, ) = @variables a b s x

    #= ::Package:: =#

    #= ::Title:: =#
    #=Integration*Problems*Involving*Zeta*Functions=#

    #= ::Subsection::Closed:: =#
    #=Integrands*of*the*form*x^m*Zeta(2, a+b*x)=#

    @test_int [x^2*Zeta(2, a + b*x), x, 4, -((2*x*LogGamma(a + b*x))/b^2) + (2*PolyGamma(-2, a + b*x))/b^3 + (x^2*PolyGamma(0, a + b*x))/b]
    @test_int [x^1*Zeta(2, a + b*x), x, 3, -(LogGamma(a + b*x)/b^2) + (x*PolyGamma(0, a + b*x))/b]
    @test_int [x^0*Zeta(2, a + b*x), x, 2, PolyGamma(0, a + b*x)/b]
    @test_int [Zeta(2, a + b*x)/x^1, x, 1, Unintegrable(PolyGamma(1, a + b*x)/x, x)]
    @test_int [Zeta(2, a + b*x)/x^2, x, 2, b*Unintegrable(PolyGamma(2, a + b*x)/x, x) - PolyGamma(1, a + b*x)/x]
    @test_int [Zeta(2, a + b*x)/x^3, x, 3, (1/2)*b^2*Unintegrable(PolyGamma(3, a + b*x)/x, x) - PolyGamma(1, a + b*x)/(2*x^2) - (b*PolyGamma(2, a + b*x))/(2*x)]

    @test_int [Zeta(2, a + b*x)/x^2 - b*(PolyGamma(2, a + b*x)/x), x, 3, -(PolyGamma(1, a + b*x)/x)]

    #= ::Subsection::Closed:: =#
    #=Integrands*of*the*form*x^m*Zeta(s, a+b*x)=#

    @test_int [x^2*Zeta(s, a + b*x), x, 3, If(13>=8, (2*Zeta(-3 + s, a + b*x))/(b^3*(1 - s)*(2 - s)*(3 - s)) - (2*x*Zeta(-2 + s, a + b*x))/(b^2*(1 - s)*(2 - s)) + (x^2*Zeta(-1 + s, a + b*x))/(b*(1 - s)), (2*Zeta(-3 + s, a + b*x))/(b^3*(1 - s)*(6 - 5*s + s^2)) - (2*x*Zeta(-2 + s, a + b*x))/(b^2*(1 - s)*(2 - s)) + (x^2*Zeta(-1 + s, a + b*x))/(b*(1 - s)))]
    @test_int [x^1*Zeta(s, a + b*x), x, 2, -(Zeta(-2 + s, a + b*x)/(b^2*(1 - s)*(2 - s))) + (x*Zeta(-1 + s, a + b*x))/(b*(1 - s))]
    @test_int [x^0*Zeta(s, a + b*x), x, 1, Zeta(-1 + s, a + b*x)/(b*(1 - s))]
    @test_int [Zeta(s, a + b*x)/x^1, x, 0, CannotIntegrate(Zeta(s, a + b*x)/x, x)]
    @test_int [Zeta(s, a + b*x)/x^2, x, 1, (-b)*s*CannotIntegrate(Zeta(1 + s, a + b*x)/x, x) - Zeta(s, a + b*x)/x]
    @test_int [Zeta(s, a + b*x)/x^3, x, 2, (1/2)*b^2*s*(1 + s)*CannotIntegrate(Zeta(2 + s, a + b*x)/x, x) - Zeta(s, a + b*x)/(2*x^2) + (b*s*Zeta(1 + s, a + b*x))/(2*x)]

    @test_int [Zeta(s, a + b*x)/x^2 + b*s*(Zeta(1 + s, a + b*x)/x), x, 2, -(Zeta(s, a + b*x)/x)]
    end

test/8 Special functions/8.7 Zeta function.jl


using Unitful.DefaultSymbols

"""
Converts a spectroscopic wavenumber (inverse wavelength) to the transition
photon energy.
"""
σ_to_energy(σ) = u"ħ" * 2π * u"c" * σ

"""
88Sr+ ion.
"""
const sr88 = NoHyperfineOneElectronSpecies(
    Dict(
        "S_1/2" => 0J,
        "D_3/2" => σ_to_energy(14555.90 / cm), # [Sansonetti2012]
        "D_5/2" => σ_to_energy(14836.24 / cm), # [Sansonetti2012]
        "P_1/2" => σ_to_energy(23715.19 / cm), # [Sansonetti2012]
        "P_3/2" => σ_to_energy(24516.65 / cm), # [Sansonetti2012]
    ),
    Dict(
        ("S_1/2", "P_3/2") => 141MHz, # …(2) [Sansonetti2012]
        ("S_1/2", "P_1/2") => 127.9MHz, # …(1.3) [Likforman2016]
        ("S_1/2", "D_5/2") => 2.559Hz, # …(10) [Sansonetti2012]
        ("S_1/2", "D_3/2") => 2.299Hz, # …(21) [Sansonetti2012]
        ("D_3/2", "P_1/2") => 7.46MHz, # …(14) [Likforman2016]
        ("D_3/2", "P_3/2") => 1.0MHz, # …(2) [Sansonetti2012]
        ("D_5/2", "P_3/2") => 8.7MHz, # …(15) [Sansonetti2012]
    )
)

export sr88


module TestMarkovCategories
using Test

using Catlab.Syntax, Catlab.WiringDiagrams
using Catlab.Experimental.MarkovCategories

# Doctrines
###########

A, B = Ob(FreeMarkovCategory, :A, :B)
M = Hom(:M, A, B)

# Domains and codomains
@test dom(expectation(M)) == A
@test codom(expectation(M)) == B

# Extra syntax
@test 𝔼(M) == expectation(M)

# LaTeX notation
@test sprint(show_latex, expectation(M)) == "\\mathbb{E}\\left(M\\right)"

# Wiring diagrams
#################

A, B, C = [ Ports{MarkovCategory.Hom}([sym]) for sym in [:A, :B, :C] ]
M = singleton_diagram(MarkovCategory.Hom, Box(:M,[:A],[:B]))
N = singleton_diagram(MarkovCategory.Hom, Box(:N,[:B],[:C]))

# Non-functoriality of expectation.
@test expectation(compose(M,N)) != compose(expectation(M),expectation(N))

end


## gradient methods

"""
    gradient(inFLD::MeshArray,Γ::NamedTuple)

Compute spatial derivatives. Other methods:
```
gradient(inFLD::MeshArray,Γ::NamedTuple,doDIV::Bool)
gradient(inFLD::MeshArray,iDXC::MeshArray,iDYC::MeshArray)
```
"""
function gradient(inFLD::MeshArray,Γ::NamedTuple)
(dFLDdx, dFLDdy)=gradient(inFLD,Γ,true)
return dFLDdx, dFLDdy
end

function gradient(inFLD::MeshArray,Γ::NamedTuple,doDIV::Bool)

exFLD=exchange(inFLD,1)
dFLDdx=similar(inFLD)
dFLDdy=similar(inFLD)

for a=1:inFLD.grid.nFaces
  (s1,s2)=size(exFLD.f[a])
  tmpA=view(exFLD.f[a],2:s1-1,2:s2-1)
  tmpB=tmpA-view(exFLD.f[a],1:s1-2,2:s2-1)
  tmpC=tmpA-view(exFLD.f[a],2:s1-1,1:s2-2)
  if doDIV
    dFLDdx.f[a]=tmpB./Γ.DXC.f[a]
    dFLDdy.f[a]=tmpC./Γ.DYC.f[a]
  else
    dFLDdx.f[a]=tmpB
    dFLDdy.f[a]=tmpC
  end
end

return dFLDdx, dFLDdy
end

function gradient(inFLD::MeshArray,iDXC::MeshArray,iDYC::MeshArray)

exFLD=exchange(inFLD,1)
dFLDdx=similar(inFLD)
dFLDdy=similar(inFLD)

for a=1:inFLD.grid.nFaces
  (s1,s2)=size(exFLD.f[a])
  tmpA=view(exFLD.f[a],2:s1-1,2:s2-1)
  tmpB=tmpA-view(exFLD.f[a],1:s1-2,2:s2-1)
  tmpC=tmpA-view(exFLD.f[a],2:s1-1,1:s2-2)
  dFLDdx.f[a]=tmpB.*iDXC.f[a]
  dFLDdy.f[a]=tmpC.*iDYC.f[a]
end

return dFLDdx, dFLDdy
end

## mask methods

function mask(fld::MeshArray)
fldmsk=mask(fld,NaN)
return fldmsk
end

"""
    mask(fld::MeshArray, val::Number)

Replace non finite values with val. Other methods:
```
mask(fld::MeshArray)
mask(fld::MeshArray, val::Number, noval::Number)
```
"""
function mask(fld::MeshArray, val::Number)
  fldmsk=similar(fld)
  for a=1:fld.grid.nFaces
    tmp1=copy(fld.f[a])
    replace!(x -> !isfinite(x) ? val : x, tmp1 )
    fldmsk.f[a]=tmp1
  end
  return fldmsk
end

function mask(fld::MeshArray, val::Number, noval::Number)
  fldmsk=similar(fld)
  for a=1:fld.grid.nFaces
    tmp1=copy(fld.f[a])
    replace!(x -> x==noval ? val : x, tmp1  )
    fldmsk.f[a]=tmp1
  end
  return fldmsk
end

## convergence methods

"""
    convergence(uFLD::MeshArray,vFLD::MeshArray)

Compute convergence of a vector field
"""
function convergence(uFLD::MeshArray,vFLD::MeshArray)

#important note:
#  Normally uFLD, vFLD should not contain any NaN;
#  if otherwise then something this may be needed:
#  uFLD=mask(uFLD,0.0); vFLD=mask(vFLD,0.0);

CONV=similar(uFLD)

(tmpU,tmpV)=exch_UV(uFLD,vFLD)
for a=1:tmpU.grid.nFaces
  (s1,s2)=size(uFLD.f[a])
  tmpU1=view(tmpU.f[a],1:s1,1:s2)
  tmpU2=view(tmpU.f[a],2:s1+1,1:s2)
  tmpV1=view(tmpV.f[a],1:s1,1:s2)
  tmpV2=view(tmpV.f[a],1:s1,2:s2+1)
  CONV.f[a]=tmpU1-tmpU2+tmpV1-tmpV2
end

return CONV
end

## smooth function

"""
    smooth(FLD::MeshArray,DXCsm::MeshArray,DYCsm::MeshArray,Γ::NamedTuple)

Smooth out scales below DXCsm / DYCsm via diffusion
"""
function smooth(FLD::MeshArray,DXCsm::MeshArray,DYCsm::MeshArray,Γ::NamedTuple)

#important note:
#input FLD should be land masked (NaN/1) by caller if needed

#get land masks (NaN/1):
mskC=fill(1.0,FLD) + 0.0 * mask(FLD)
(mskW,mskS)=gradient(FLD,Γ,false)
mskW=fill(1.0,FLD) + 0.0 * mask(mskW)
mskS=fill(1.0,FLD) + 0.0 * mask(mskS)

#replace NaN with 0. in FLD and land masks:
FLD=mask(FLD,0.0)
mskC=mask(mskC,0.0)
mskW=mask(mskW,0.0)
mskS=mask(mskS,0.0)

#get inverse grid spacing:
iDXC=similar(FLD)
iDYC=similar(FLD)
for a=1:FLD.grid.nFaces
  iDXC.f[a]=1.0./Γ.DXC.f[a]
  iDYC.f[a]=1.0./Γ.DYC.f[a]
end

#Before scaling the diffusive operator ...
tmp0=DXCsm*iDXC*mskW;
tmp00=maximum(tmp0);
tmp0=DYCsm*iDYC*mskS;
tmp00=max(tmp00,maximum(tmp0));

#... determine a suitable time period:
nbt=ceil(1.1*2*tmp00^2);
dt=1.;
T=nbt*dt;
#println("nbt="*"$nbt")

#diffusion operator times DYG / DXG
KuxFac=mskW*DXCsm*DXCsm/T/2.0*Γ.DYG
KvyFac=mskS*DYCsm*DYCsm/T/2.0*Γ.DXG

#time steping factor:
dtFac=dt*mskC/Γ.RAC

#loop:
for it=1:nbt
  (dTdxAtU,dTdyAtV)=gradient(FLD,iDXC,iDYC);
  tmpU=similar(FLD)
  tmpV=similar(FLD)
  for a=1:FLD.grid.nFaces
      tmpU.f[a]=dTdxAtU.f[a].*KuxFac.f[a];
      tmpV.f[a]=dTdyAtV.f[a].*KvyFac.f[a];
  end
  tmpC=convergence(tmpU,tmpV);
  for a=1:FLD.grid.nFaces
      FLD.f[a]=FLD.f[a]-dtFac.f[a].*tmpC.f[a];
  end
end

#Apply land mask (NaN/1) to end result:
mskC=mask(mskC,NaN,0.0)
FLD=mskC*FLD

return FLD

end

## ThroughFlow function

"""
    ThroughFlow(VectorField,IntegralPath,Γ::NamedTuple)

Compute transport through an integration path
"""
function ThroughFlow(VectorField,IntegralPath,Γ::NamedTuple)

    #Note: vertical intergration is not always wanted; left for user to do outside

    U=VectorField["U"]
    V=VectorField["V"]

    nd=ndims(U)
    #println("nd=$nd and d=$d")

    n=fill(1,4)
    tmp=size(U)
    n[1:nd].=tmp[1:nd]

    haskey(VectorField,"factors") ? f=VectorField["factors"] : f=Array{String,1}(undef,0)
    haskey(VectorField,"dimensions") ? d=VectorField["dimensions"] : d=Array{String,1}(undef,nd)

    #a bit of a hack to distinguish gcmfaces v gcmarray indexing:
    isdefined(U,:fIndex) ? ndoffset=1 : ndoffset=0
    length(d)!=nd+ndoffset ? error("inconsistent specification of dims") : nothing

    trsp=Array{Float64}(undef,1,n[3],n[4])
    do_dz=sum(f.=="dz")
    do_dxory=sum(f.=="dxory")

    for i3=1:n[3]
        #method 1: quite slow
        #mskW=IntegralPath.mskW
        #do_dxory==1 ? mskW=mskW*Γ.DYG : nothing
        #do_dz==1 ? mskW=Γ.DRF[i3]*mskW : nothing
        #mskS=IntegralPath.mskS
        #do_dxory==1 ? mskS=mskS*Γ.DXG : nothing
        #do_dz==1 ? mskS=Γ.DRF[i3]*mskS : nothing
        #
        #method 2: less slow
        tabW=IntegralPath.tabW
        tabS=IntegralPath.tabS
        for i4=1:n[4]
            #method 1: quite slow
            #trsp[1,i3,i4]=sum(mskW*U[:,:,i3,i4])+sum(mskS*V[:,:,i3,i4])
            #
            #method 2: less slow
            trsp[1,i3,i4]=0.0
            for k=1:size(tabW,1)
                (a,i1,i2,w)=tabW[k,:]
                do_dxory==1 ? w=w*Γ.DYG.f[a][i1,i2] : nothing
                do_dz==1 ? w=w*Γ.DRF[i3] : nothing
                isdefined(U,:fIndex) ? u=U.f[a,i3,i4][i1,i2] : u=U.f[a][i1,i2,i3,i4]
                trsp[1,i3,i4]=trsp[1,i3,i4]+w*u
            end
            for k=1:size(tabS,1)
                (a,i1,i2,w)=tabS[k,:]
                do_dxory==1 ? w=w*Γ.DXG.f[a][i1,i2] : nothing
                do_dz==1 ? w=w*Γ.DRF[i3] : nothing
                isdefined(V,:fIndex) ? v=V.f[a,i3,i4][i1,i2] : v=V.f[a][i1,i2,i3,i4]
                trsp[1,i3,i4]=trsp[1,i3,i4]+w*v
            end
        end
    end

    nd+ndoffset<4 ? trsp=dropdims(trsp,dims=3) : nothing
    nd+ndoffset<3 ? trsp=dropdims(trsp,dims=2) : nothing
    nd+ndoffset==2 ? trsp=trsp[1] : nothing

    return trsp
end

## LatitudeCircles function

"""
    LatitudeCircles(LatValues,Γ::NamedTuple)

Compute integration paths that follow latitude circles
"""
function LatitudeCircles(LatValues,Γ::NamedTuple)

    LatitudeCircles=Array{NamedTuple}(undef,length(LatValues))

    for j=1:length(LatValues)
        mskCint=1*(Γ.YC .>= LatValues[j])
        mskC=similar(mskCint)
        mskW=similar(mskCint)
        mskS=similar(mskCint)

        mskCint=exchange(mskCint,1)

        for i=1:mskCint.grid.nFaces
            tmp1=mskCint.f[i]
            # tracer mask:
            tmp2=tmp1[2:end-1,1:end-2]+tmp1[2:end-1,3:end]+
            tmp1[1:end-2,2:end-1]+tmp1[3:end,2:end-1]
            mskC.f[i]=1((tmp2.>0).&(tmp1[2:end-1,2:end-1].==0))
            # velocity masks:
            mskW.f[i]=tmp1[2:end-1,2:end-1] - tmp1[1:end-2,2:end-1]
            mskS.f[i]=tmp1[2:end-1,2:end-1] - tmp1[2:end-1,1:end-2]
        end

        function MskToTab(msk::MeshArray)
          n=Int(sum(msk .!= 0)); k=0
          tab=Array{Int,2}(undef,n,4)
          for i=1:msk.grid.nFaces
            a=msk.f[i]
            b=findall( a .!= 0)
            for ii in eachindex(b)
              k += 1
              tab[k,:]=[i,b[ii][1],b[ii][2],a[b[ii]]]
            end
          end
          return tab
        end

        LatitudeCircles[j]=(lat=LatValues[j],
        tabC=MskToTab(mskC),tabW=MskToTab(mskW),tabS=MskToTab(mskS))
    end

    return LatitudeCircles

end

##


"""
    BIC(sem_fit::SemFit)

Return the bayesian information criterion.
"""
BIC(sem_fit::SemFit) = minus2ll(sem_fit) + log(n_obs(sem_fit))*n_par(sem_fit)


#simulation of subsidizing
using Optim, LinearAlgebra, Random, Distributions, Suppressor, Statistics

struct UnobservedType
    v::Array{Float64}
    c::Array{Float64, 2}
end

function UnobservedType(n)
    v = rand(Uniform(7, 15), n)
    cW = rand(Uniform(5, 10), n)
    cM = rand(Uniform(2, 5), n)
    return UnobservedType(v, [cW cM])
end

function calculate_ground_truth()
    n = 1000000
    types = UnobservedType(n)
    p0 = eqm_price(zeros(n, 2), types)
    function direct_effect(η)
        y = get_supplier_welfare(transpose(p0) .+ zeros(n, 2), types; η = η)
        return mean(y)
    end

    function total_effect(η)
        p1 = eqm_price(zeros(n, 2), types; η = η)
        y1 = get_supplier_welfare(transpose(p1) .+ zeros(n, 2), types; η = η)
        return mean(y1)
    end
    #println(eqm_price(zeros(n, 2), types; η = 0.1) - eqm_price(zeros(n, 2), types; η = 0.0))
    println((total_effect(0.2) - total_effect(-0.2))/0.4)
    println((direct_effect(0.2) - direct_effect(-0.2))/0.4)
    #τ = central_fdm(5, 1; factor=1e6)(total_effect, 0.0)
    #τD = central_fdm(5, 1; factor=1e6)(direct_effect, 0.0)

    #return (τ = τ, τD = τD)
end

function mc_simulation(S, n)
    results = zeros((S, 7))
    for i in 1:S
        estimates = run_simulation(n)
        results[i, :] .= collect(estimates)
    end
    return results
end

function run_simulation(n)
    types = UnobservedType(n)
    return calculate_effects(types)
end

function get_supplier_welfare(P, types; η= 0.0)
    qs = aggregate_supply(P, types; η=η)
    return qs[:, 1].*(P[:, 1] .+ η .- P[:, 2] .- types.c[:, 1])
end

# calculate general eqm effect using local experimemnt
function calculate_effects(types)
    n = length(types.v)
    U = 0.6 .*rand([-1,1], (n, 2))
    pstar = eqm_price(U, types)
    Z = aggregate_excess_demand(transpose(pstar) .+ U, types)
    qs = aggregate_supply(transpose(pstar) .+ U, types)
    qd = aggregate_demand(transpose(pstar) .+ U, types)
    ys = get_supplier_welfare(transpose(pstar) .+ U, types)
    ∂Zπ = zeros(2, 1)
    ∂Zp = zeros(2, 2)
    ∂ys = inv(transpose(U)*U)*(transpose(U)*ys)

    for i in 1:2
        ∂Zp[:, i] .= inv(transpose(U)*U)*(transpose(U)*Z[:, i])
    end
    ∂Zπ[1] = -1.0 .* inv(transpose(U[:, 1])*U[:, 1])*(transpose(U[:, 1])*qs[:, 1])
    ∂Zπ[2] = inv(transpose(U[:, 1])*U[:, 1])*(transpose(U[:, 1])*Z[:, 2])
    ∂pstar = - inv(∂Zp)*(∂Zπ)
    τI = transpose(∂ys)*∂pstar
    dy = ∂ys[1] + τI[1]
    return (τ = dy, τD  = ∂ys[1], τI = τI[1], ∂pstarG = ∂pstar[1], ∂pstarH = ∂pstar[2],
            ∂ysG = ∂ys[1], ∂ysW = ∂ys[2])
end

function aggregate_demand(P, types)
    n = size(types.c)[1]
    qd = zeros((n, 2))
    for i in 1:n
        qd[i, :] .=  individual_excess_demand(P[i, :], types.c[i, :], types.v[i]).qd
    end
    return qd
end

function aggregate_supply(P, types; η=0.0)
    n = size(types.c)[1]
    qs = zeros((n, 2))
    for i in 1:n
        qs[i, :] .=  individual_excess_demand(P[i, :], types.c[i, :], types.v[i]; η= η).qs
    end
    return qs
end

function aggregate_excess_demand(P, types; η = 0.0)
    n = size(types.c)[1]
    Z = zeros((n, 2))
    for i in 1:n
        Z[i, :] .=  individual_excess_demand(P[i, :], types.c[i, :], types.v[i]; η = η).z
    end
    return Z
end

function individual_excess_demand(p, c, v; η = 0.0)
     #println(p)
     profits = [p[1] + η - p[2] - c[1], p[2] - c[2]]
     k = argmax(profits)
     l = argmin(profits)
     z = zeros(2)
     z[k] = -1.0 .* (profits[k] .>0)
     z[l] = 0.0
     supply = -1.0 .* z
     demand = [(p[1] < v).*1.0, supply[1]]
     z[2] = z[2] + demand[2]
     z[1] = z[1] + demand[1]
     return (z= z, qs = supply, qd = demand)
 end

function eqm_price(U, types::UnobservedType; η = 0.0)
    function eqm_condition(p)
        zp = aggregate_excess_demand(transpose(p) .+ U, types; η= η)
        return norm(mean(zp, dims=1))
    end
    r = optimize(eqm_condition, [8.0, 3.0]).minimizer
    #rintln(r)
    return r
end


###############################################################################
#
# Calculate soil water content from pressure
#
###############################################################################
"""
    soil_erwc(sh::AbstractSoilVC{FT}, p_25::FT) where {FT<:AbstractFloat}

Returns the Effective relative water content of the soil
    ``\\frac{Θ - Θr}{Θs - Θr}``, given
- `sh` [`BrooksCorey`](@ref) or [`VanGenuchten`](@ref) type soil hydraulics
- `p_25` Matrix water potential equivalent to 25 degree C, with surface tension
correction
"""
function soil_erwc(
            sh::BrooksCorey{FT},
            p_25::FT
) where {FT<:AbstractFloat}
    if p_25 < 0
        @unpack b, ϕs = sh;

        return (-ϕs/p_25) ^ (1/b)
    else
        return FT(1)
    end
end

function soil_erwc(
            sh::VanGenuchten{FT},
            p_25::FT
) where {FT<:AbstractFloat}
    if p_25 < 0
        @unpack m, n, α = sh;

        return ( 1 / ( 1 + (-p_25 * α) ^ n ) ) ^ m
    else
        return FT(1)
    end
end

"""
    soil_rwc(sh::AbstractSoilVC{FT}, p_25::FT) where {FT<:AbstractFloat}

Returns the relative soil water content, given
- `sh` [`BrooksCorey`](@ref) or [`VanGenuchten`](@ref) type soil hydraulics
- `p_25` Matrix water potential equivalent to 25 degree C, with surface tension
correction
"""
function soil_rwc(
            sh::BrooksCorey{FT},
            p_25::FT
) where {FT<:AbstractFloat}
    @unpack Θs = sh;

    return soil_swc(sh, p_25) / Θs
end

function soil_rwc(
            sh::VanGenuchten{FT},
            p_25::FT
) where {FT<:AbstractFloat}
    @unpack Θs = sh;

    return soil_swc(sh, p_25) / Θs
end

"""
    soil_swc(sh::AbstractSoilVC{FT}, p_25::FT) where {FT<:AbstractFloat}

Returns the soil water content, given
- `sh` [`BrooksCorey`](@ref) or [`VanGenuchten`](@ref) type soil hydraulics
- `p_25` Matrix water potential equivalent to 25 degree C, with surface tension
correction
"""
function soil_swc(
            sh::BrooksCorey{FT},
            p_25::FT
) where {FT<:AbstractFloat}
    @unpack Θr, Θs = sh;

    return soil_erwc(sh, p_25) * (Θs - Θr) + Θr
end

function soil_swc(
            sh::VanGenuchten{FT},
            p_25::FT
) where {FT<:AbstractFloat}
    @unpack Θr, Θs = sh;

    return soil_erwc(sh, p_25) * (Θs - Θr) + Θr
end

###############################################################################
#
# Calculate soil k from water content
#
###############################################################################
"""
    soil_k_ratio_erwc(
                sh::AbstractSoilVC{FT},
                erwc::FT
    ) where {FT<:AbstractFloat}

Return the soil k relative to maximal k, given
- `sh` [`BrooksCorey`](@ref) or [`VanGenuchten`](@ref) type soil hydraulics
- `erwc` Effective relative soil water content (``\\frac{Θs - Θr}{Θs - Θ}``)
"""
function soil_k_ratio_erwc(
            sh::BrooksCorey{FT},
            erwc::FT
) where {FT<:AbstractFloat}
    k_ratio = erwc ^ (2*sh.b+3);

    return max(k_ratio, FT(1e-20))
end

function soil_k_ratio_erwc(
            sh::VanGenuchten{FT},
            erwc::FT
) where {FT<:AbstractFloat}
    @unpack m = sh;
    k_ratio = sqrt(erwc) * (1 - (1 - erwc^(1/m)) ^ m)^2;

    return max(k_ratio, FT(1e-20))
end

"""
    soil_k_ratio_rwc(sh::AbstractSoilVC{FT}, rwc::FT) where {FT<:AbstractFloat}

Return the soil k relative to maximal k, given
- `sh` [`BrooksCorey`](@ref) or [`VanGenuchten`](@ref) type soil hydraulics
- `rwc` Relative soil water content
"""
function soil_k_ratio_rwc(
            sh::BrooksCorey{FT},
            rwc::FT
) where {FT<:AbstractFloat}
    @unpack Θr, Θs = sh;

    erwc = min(1, max(0, (rwc * Θs - Θr) / (Θs - Θr)));

    return soil_k_ratio_erwc(sh, erwc)
end

function soil_k_ratio_rwc(
            sh::VanGenuchten{FT},
            rwc::FT
) where {FT<:AbstractFloat}
    @unpack Θr, Θs = sh;

    erwc = min(1, max(0, (rwc * Θs - Θr) / (Θs - Θr)));

    return soil_k_ratio_erwc(sh, erwc)
end

"""
    soil_k_ratio_swc(sh::AbstractSoilVC{FT}, swc::FT) where {FT<:AbstractFloat}

Return the soil k relative to maximal k, given
- `sh` [`BrooksCorey`](@ref) or [`VanGenuchten`](@ref) type soil hydraulics
- `swc` Relative soil water content
"""
function soil_k_ratio_swc(
            sh::BrooksCorey{FT},
            swc::FT
) where {FT<:AbstractFloat}
    @unpack Θr, Θs = sh;

    erwc = min(1, max(0, (swc - Θr) / (Θs - Θr)));

    return soil_k_ratio_erwc(sh, erwc)
end

function soil_k_ratio_swc(
            sh::VanGenuchten{FT},
            swc::FT
) where {FT<:AbstractFloat}
    @unpack Θr, Θs = sh;

    erwc = min(1, max(0, (swc - Θr) / (Θs - Θr)));

    return soil_k_ratio_erwc(sh, erwc)
end

###############################################################################
#
# Calculate soil k from pressure
#
###############################################################################
"""
    soil_k_ratio_p25(
                sh::AbstractSoilVC{FT},
                p_25::FT
    ) where {FT<:AbstractFloat}

Return the soil k relative to maximal k, given
- `sh` [`AbstractSoilVC`](@ref) type soil hydraulics
- `p_25` Matrix water potential equivalent to 25 degree C, with surface tension
"""
function soil_k_ratio_p25(
            sh::AbstractSoilVC{FT},
            p_25::FT
) where {FT<:AbstractFloat}
    erwc = soil_erwc(sh, p_25);

    return soil_k_ratio_erwc(sh, erwc)
end

###############################################################################
#
# Calculate soil pressure from water content
#
###############################################################################
"""
    soil_p_25_erwc(sh::AbstractSoilVC{FT}, erwc::FT) where {FT<:AbstractFloat}

Returns the Relative water content of the soil, given
- `sh` [`BrooksCorey`](@ref) or [`VanGenuchten`](@ref) type soil hydraulics
- `erwc` Effectibe relative soil water content (``\\frac{Θs - Θr}{Θs - Θ}``)

Note that this function returns the matrix potential of water, not water
potential. Also, the potential is that at 25 degree C, not yet been corrected
for temperature effect on surface tension.
"""
function soil_p_25_erwc(
            sh::BrooksCorey{FT},
            erwc::FT
) where {FT<:AbstractFloat}
    if erwc < 1
        @unpack b, ϕs = sh;

        return -ϕs / (erwc ^ b)
    else
        return FT(0)
    end
end

function soil_p_25_erwc(
            sh::VanGenuchten{FT},
            erwc::FT
) where {FT<:AbstractFloat}
    if erwc < 1
        @unpack m, n, α = sh;

        return -1 * (erwc ^ (-1/m) - 1) ^ (1/n) / α
    else
        return FT(0)
    end
end

"""
    soil_p_25_rwc(sh::AbstractSoilVC{FT}, rwc::FT) where {FT<:AbstractFloat}

Returns the Relative water content of the soil, given
- `sh` [`BrooksCorey`](@ref) or [`VanGenuchten`](@ref) type soil hydraulics
- `rwc` Relative soil water content

Note that this function returns the matrix potential of water, not water
potential. Also, the potential is that at 25 degree C, not yet been corrected
for temperature effect on surface tension.
"""
function soil_p_25_rwc(
            sh::BrooksCorey{FT},
            rwc::FT
) where {FT<:AbstractFloat}
    @unpack Θr, Θs = sh;

    erwc = min(1, max(0, (rwc * Θs - Θr) / (Θs - Θr)));

    return soil_p_25_erwc(sh, erwc)
end

function soil_p_25_rwc(
            sh::VanGenuchten{FT},
            rwc::FT
) where {FT<:AbstractFloat}
    @unpack Θr, Θs = sh;

    erwc = min(1, max(0, (rwc * Θs - Θr) / (Θs - Θr)));

    return soil_p_25_erwc(sh, erwc)
end

"""
    soil_p_25_swc(sh::AbstractSoilVC{FT}, rwc::FT) where {FT<:AbstractFloat}

Returns the Relative water content of the soil, given
- `sh` [`BrooksCorey`](@ref) or [`VanGenuchten`](@ref) type soil hydraulics
- `swc` Soil water content

Note that this function returns the matrix potential of water, not water
potential. Also, the potential is that at 25 degree C, not yet been corrected
for temperature effect on surface tension.
"""
function soil_p_25_swc(
            sh::BrooksCorey{FT},
            swc::FT
) where {FT<:AbstractFloat}
    @unpack Θr, Θs = sh;

    erwc = min(1, max(0, (swc - Θr) / (Θs - Θr)));

    return soil_p_25_erwc(sh, erwc)
end

function soil_p_25_swc(
            sh::VanGenuchten{FT},
            swc::FT
) where {FT<:AbstractFloat}
    @unpack Θr, Θs = sh;

    erwc = min(1, max(0, (swc - Θr) / (Θs - Θr)));

    return soil_p_25_erwc(sh, erwc)
end

###############################################################################
#
# Fit Soil VC
#
###############################################################################
"""
    fit_soil_VC!(
                vc_vG::VanGenuchten{FT},
                vc_BC::BrooksCorey{FT}
    ) where {FT<:AbstractFloat}

Update BrooksCorey setup from known VanGenuchten parameters, given
- `vc_vG` [`VanGenuchten`](@ref) type soil VC
- `vc_BC` [`BrooksCorey`](@ref) type soil VC
"""
function fit_soil_VC!(
            vc_vG::VanGenuchten{FT},
            vc_BC::BrooksCorey{FT}
) where {FT<:AbstractFloat}
    # generate data to fit
    _Θ    = range(vc_vG.Θr+FT(1e-2); stop=vc_vG.Θs-FT(1e-2), length=30);
    _P_vG = -1 .* soil_p_25_swc.([vc_vG], _Θ);
    _P_BC = -1 .* soil_p_25_swc.([vc_BC], _Θ);

    f(x) = (
        vc_BC.b  = x[1];
        vc_BC.ϕs = x[2];
        _P_BC   .= -1 .* soil_p_25_swc.([vc_BC], _Θ);
        _diff    = sum( (log.(_P_BC) .- log.(_P_vG)) .^ 2 );
        return -_diff
    );

    st = SolutionToleranceND{FT}([1e-3, 1e-6], 30);
    ms = ReduceStepMethodND{FT}(x_mins = FT[1e-3, 1e-6],
                                x_maxs = FT[ 100, 1000],
                                x_inis = [vc_BC.b, vc_BC.ϕs],
                                Δ_inis = FT[0.1, 1e-3]);
    bc = find_peak(f, ms, st);
    vc_BC.b  = bc[1];
    vc_BC.ϕs = bc[2];

    return nothing
end


using SimplexSplitting, InvariantDistribution

@testset "InvDist" begin
    e_ex = Embedding(invariant_gaussian_embedding(npts = 25))
    t_ex = triang_from_embedding(e_ex)
    mm = mm_dd(t_ex)
    @test all(sum(mm, 2) .≈ 1)

    invdist = estimate_invdist(mm)
    @test sum(invdist.dist) ≈ 1
end


"""
Holds the parameters unique to a particular binary subsystem modeled by
the MQCM; namely, the parameters in Eqns 17, 19, and 20 of Pelton et al
paper I.
"""
struct BinaryMQCModel{T}
    gab0::T
  	gaparams::Vector{T}
    gbparams::Vector{T}
    # Order: Za_aa, Zb_bb, Za_ab, Zb_ba
    coordparams::Vector{T}

end

"""
Calculate both coordination numbers Za and Zb given a particular
Modified Quasichemical Model and its configuration in pair fractions.
Eqns. 19-20 of Pelton et al. 'The Modified Quasichemical
Model I--Binary Solutions'
"""
function coordination(data::BinaryMQCModel, npairs)
  Za_aa, Zb_bb, Za_ab, Zb_ba = data.coordparams
  naa, nbb, nab = npairs
  inv_Za = 2naa/(Za_aa*(2naa + nab)) + nab/(Za_ab*(2naa + nab))
  inv_Zb = 2nbb/(Zb_bb*(2nbb + nab)) + nab/(Zb_ba*(2nbb + nab))
  return [1/inv_Za, 1/inv_Zb]
end

"""
Calculate Δgab given a particular Modified Quasichemical Model and
its current configuration. Equivalent to Eqn 17 in Pelton et al. I
"""
function gab(data::BinaryMQCModel, pairfracs)
	aterm = 0.0
  bterm = 0.0
  Xaa, Xbb, Xab = pairfracs
  for i in 1:length(data.gaparams)
    aterm += data.gaparams[i] * Xaa^i
  end
  for j in 1:length(data.gbparams)
    bterm += data.gbparams[j] * Xbb^j
  end
  return data.gab0 + aterm + bterm
end

"""
Calculates configurational entropy of a Modified Quasichemical System
given mole factions and configuration. Eqn 10 of Pelton et al I.
"""
function Sconfig(data::BinaryMQCModel, molefracs, pairfracs)
  Xa, Xb = molefracs
  Xaa, Xbb, Xab = pairfracs
  Za, Zb = coordination(data, pairfracs)
  totpairs = (Xa*Za+Xb*Zb)/2
  #println(totpairs)
  naa, nbb, nab = pairfracs .* totpairs
  Ya = Xaa + Xab/2
  Yb = Xbb + Xab/2
  term1 = zero(eltype(molefracs))
  if Xa != zero(eltype(molefracs))
    term1 += Xa*log(Xa)
  end
  if Xb!= zero(eltype(molefracs))
    term1 += Xb*log(Xb)
  end
  term2 = zero(eltype(molefracs))
  if Xaa != zero(eltype(pairfracs))
    term2 += naa*log(Xaa/Ya^2)
  end
  if Xbb != zero(eltype(pairfracs))
    term2 += nbb*log(Xbb/Yb^2)
  end
  if Xab != zero(eltype(pairfracs))
    term2 += nab*log(Xab/(2*Ya*Yb))
  end
  return -R_GAS*(term1 + term2)
end

"""
Calculates overall molar Gibbs energy of solution for a Quasichemical
system. Eqn 9 of Pelton et al. I
"""
function gibbs_binary_solution(data::BinaryMQCModel,molefracs,
                               pairfracs, purecompdata,temp)
  Xa, Xb = molefracs
  if Xb == zero(eltype(molefracs))
    return gibbsenergy(purecompdata[1], temp)
  elseif Xa == zero(eltype(molefracs))
    return gibbsenergy(purecompdata[2], temp)
  end
  Xaa, Xbb, Xab = pairfracs
  Za, Zb = coordination(data, pairfracs)
  totpairs = (Xa*Za+Xb*Zb)/2
  #println(totpairs)
  naa, nbb, nab = pairfracs .* totpairs
  ΔSconfig = Sconfig(data, molefracs, pairfracs)
  Δgab = gab(data, pairfracs)
  ga = gibbsenergy(purecompdata[1], temp)
  gb = gibbsenergy(purecompdata[2], temp)
  return Xa*ga + Xb*gb - temp*ΔSconfig + (nab/2)*Δgab
end

"""
Calculate excess Gibbs energy using Eqn 35 from Pelton and Blander.
"""
function gibbs_excess_eq35(data::BinaryMQCModel, npairs, ndiff=missing)
  if !ismissing(ndiff)
    myzero = zero(typeof(npairs[ndiff]))
  else
    myzero = zero(Float64)
  end
  aterms = myzero
  bterms = myzero
  naa, nbb, nab = npairs
  totpairs = sum(npairs)
  Xaa, Xbb, Xab = npairs ./ totpairs
  for i in 1:length(data.gaparams)
    aterms += data.gaparams[i]*Xaa^(i-1)
  end
  for j in 1:length(data.gbparams)
    bterms += data.gbparams[j]*Xbb^(j-1)
  end
  return (Xaa*Xab*aterms + Xbb*Xab*bterms) * totpairs/2
end

function gibbs_excess2(data::BinaryMQCModel, molfracs, pairfracs,
                      purecompdata, temp)
  lgibbs = gibbs_binary_solution(data, molfracs, pairfracs, purecompdata, temp)
  puregibbs = sum([molfracs[i] * gibbsenergy(purecompdata[i], temp) for i in 1:length(molfracs)])
  idealmixpiece = R_GAS*temp*sum([molfracs[i]*log(molfracs[i]) for i in 1:length(molfracs)])
  return lgibbs - (puregibbs + idealmixpiece)
end

function entropy_excess(data::BinaryMQCModel, molfracs, pairfracs,
                       purecompdata, temp)
  return -FiniteDifferences.central_fdm(5,1)(T -> gibbs_excess2(data, molfracs,
                                pairfracs, purecompdata, T), temp)
end

function enthalpy_excess(data::BinaryMQCModel, molfracs, pairfracs,
                       purecompdata, temp)
  return ForwardDiff.derivative(inv_T -> gibbs_excess2(data, molfracs,
            pairfracs, purecompdata, 1/inv_T)*inv_T, 1/temp)
  #return gibbs_excess2(data, molfracs, pairfracs, purecompdata, temp) +
  #entropy_excess(data, molfracs, pairfracs, purecompdata, temp)*temp
end

function chemical_potential(data::BinaryMQCModel, purecompdata, molfracs,
                            npairs, temp, compnum=1)
  totpairs = sum(npairs)
  xpairs = npairs ./ totpairs
  if compnum == 1
    myfunction(Xa) = gibbs_binary_solution(data, [Xa, molfracs[2]],
                                          xpairs, purecompdata, temp)
    mycomp = molfracs[1]
  else
    myfunction(Xb) = gibbs_binary_solution(data, [molfracs[1], Xb],
                                          xpairs, purecompdata, temp)
    mycomp = molfracs[2]
  end
  g0 = gibbsenergy(purecompdata[compnum], temp)
  mu = ForwardDiff.derivative(myfunction, mycomp)
  gex = mu - g0
  #println("Pure Gibbs: "*string(g0)*".  Chemical potenital: " *string(mu) * ".
  #Gibbs Ex: " * string(gex))
  return mu
end

function gibbs_excess_comp(data::BinaryMQCModel, purecompdata, molfracs,
  npairs, temp, compnum=1)
  return chemical_potential(data, purecompdata, molfracs, npairs, temp,
  compnum) - gibbsenergy(purecompdata[compnum], temp)
end

# function gibbs_excess_comp2(data::BinaryMQCModel, purecompdata, molfracs,
#   npairs, temp, compnum=1)
#   pairfracs = npairs ./ sum(npairs)
#   Gextot = gibbs_excess2(data, molfracs, pairfracs, purecompdata, temp)
#   myfunc = if compnum == 1
#     myfunca(xa) = gibbs_excess2(data, [xa, 1-xa], pairfracs, purecompdata, temp)
#     myfunca
#   elseif compnum == 2
#     #println("Ought to get here")
#     myfuncb(xb) = gibbs_excess2(data, [1-xb, xb], pairfracs, purecompdata, temp)
#     myfuncb
#   else
#     println("SAD!")
#   end
#   #println("It's the right version")
#   mycomp = molfracs[compnum]
#   return Gextot - ForwardDiff.derivative(myfunc, mycomp) * mycomp
# end
function activity_coeff(data::BinaryMQCModel, purecompdata, molfracs,
  npairs, temp, compnum=1)
  return exp(gibbs_excess_comp(data, purecompdata, molfracs, npairs, temp,
  compnum) / (R_GAS*temp))
end

function activity(data::BinaryMQCModel, purecompdata, molfracs,
  npairs, temp, compnum=1)
  return activity_coeff(data, purecompdata, molfracs,
  npairs, temp, compnum) * molfracs[compnum]
end

function chemical_potential2(data::BinaryMQCModel, purecompdata, molfracs,
  npairs, temp, compnum=1)
  totpairs = sum(npairs)
  xpairs = npairs ./ totpairs
  myfunction = x-> x
  if compnum == 1
    myfunction(naa) = gibbs_excess_eq35(data,[naa,npairs[2],npairs[3]])
  elseif compnum == 2
    myfunction(nbb) = gibbs_excess_eq35(data,[npairs[1],nbb,npairs[3]])
  else
    throw(DomainError("compnum must be 1 or 2"))
  end
  mycomp = purecompdata[compnum]
  mymfrac = molfracs[compnum]
  mynp = npairs[compnum]
  mypcomp = purecompdata[compnum]
  mycoorddata = data.coordparams[compnum]
  myxp = xpairs[compnum]
  myY = xpairs[compnum] + xpairs[3]/2
  #@infiltrate
  part1 = gibbsenergy(mycomp,temp) + R_GAS*temp*log(mymfrac)
  #part2_der = ForwardDiff.derivative(myfunction, mynp)
  part2_der = FiniteDifferences.central_fdm(5,1,max_range=9e-4)(myfunction, mynp)
  part2a = R_GAS*temp*log(myxp/myY^2)
  total = part1 + (mycoorddata/2)*(part2a + part2_der)
  #print("Part 1: " * string(part1) * "  ")
  #print("Part 2a: " * string(part2a) * "  ")
  #print("Derivative: "*string(part2_der)*"  ")
  #println("Total: " * string(total))
  return part1 + (mycoorddata/2)*(part2a + part2_der)
end

function gibbs_excess_comp3(data::BinaryMQCModel, purecompdata, molfracs,
npairs, temp, compnum=1)
return chemical_potential2(data, purecompdata, molfracs, npairs, temp,
compnum) - gibbsenergy(purecompdata[compnum], temp)
end

function gibbs_excess_comp2(data::BinaryMQCModel, purecompdata, molfracs,
  npairs, temp, compnum=1)
  return molfracs[compnum]*(chemical_potential2(data, purecompdata, molfracs, npairs, temp,
  compnum) - gibbsenergy(purecompdata[compnum], temp))
  end

function activity_coeff3(data::BinaryMQCModel, purecompdata, molfracs,
npairs, temp, compnum=1)
return exp(gibbs_excess_comp2(data, purecompdata, molfracs, npairs, temp,
compnum) / (R_GAS*temp))
end

function activity_coeff2(data::BinaryMQCModel, purecompdata, molfracs,
  npairs, temp, compnum=1)
  return exp(-gibbs_excess_comp2(data, purecompdata, molfracs, npairs, temp,
  compnum) / (R_GAS*temp))
  end

function activity2(data::BinaryMQCModel, purecompdata, molfracs,
npairs, temp, compnum=1)
return activity_coeff2(data, purecompdata, molfracs,
npairs, temp, compnum) * molfracs[compnum]
end

struct PureComp{T}
  params::Vector{T}
end

function heatcapacity(pc::PureComp, T)
	A,B,a,b,c,d,e = pc.params
  return a + b*1e-3*T + c*1e5/(T^2) + d/sqrt(T) + e*1e-6*T^2
end

function enthalpy(pc::PureComp, T)
  A,B,a,b,c,d,e = pc.params
  T0 = 298.15
  return A + a*T + b*1e-3*T^2 / 2 - c*1e5/T + 2d*sqrt(T) + e*1e-6*T^3 /3 -
  (a*T0 + b*1e-3*T0^2 / 2 - c*1e5/T0 + 2d*sqrt(T0) + e*1e-6*T0^3 /3)
end

function entropy(pc::PureComp, T)
  A,B,a,b,c,d,e = pc.params
  T0 = 298.15
  return B + a*log(T) + b*1e-3*T - (c*1e5/2)/(T^2) - 2*d/sqrt(T) + (e*1e-6/2)*T^2 -
  (a*log(T0) + b*1e-3*T0 - (c*1e5/2)/(T0^2) - 2*d/sqrt(T0) + (e*1e-6/2)*T0^2)
end

# TODO: There's a problem here but I'm not sure what it is. Figure out how to fix!!!
function gibbsenergy(pc::PureComp, T)
  return enthalpy(pc, T) - T*entropy(pc, T)
end

# notation: Xa is mole fraction of a, Ya is coordiation-equivalent
# fraction of a (see Pelton and Blander's paper)
#
function find_configuration(data::BinaryMQCModel,molefracs,
                                purecompdata,temp,
                                x0 = [0.5,0.5,0.0])
  if molefracs[1] == 1.0
    return [1.0, 0.0, 0.0]
  elseif molefracs[2] == 1.0
    return [0.0,1.0, 0.0]
  end
  Za_aa, Zb_bb, Za_ab, Zb_ba = data.coordparams
  lower = [0.0,0.0,0.0]
  upper = [1.0, 1.0, 1.0]
  f(x) = gibbs_binary_solution(data, molefracs, x, purecompdata, temp)
  function con_c!(c, x)
    c[1] = x[1] + x[2] + x[3]
    yaa = x[1]*2/Za_aa + x[3]/Za_ab
    ybb = x[2]*2/Zb_bb + x[3]/Zb_ba
    c[2] = yaa /(yaa + ybb)
    c[3] = ybb /(yaa + ybb)
    c
  end
  function con_jacobian!(J, x)
    c = Vector{Real}([0.0,0.0,0.0])
    J .= ForwardDiff.jacobian(con_c!, c, x)
    J
  end
  function con_h!(h, x, λ)

    c = Vector{Real}([0.0,0.0,0.0])
    h .= ForwardDiff.hessian(y -> sum(λ .* con_c!(c, y)), x)
    h
  end
  lx = [0.0,0.0,0.0]
  ux = [1.0,1.0,1.0]
  lc = [1.0, molefracs[1], molefracs[2]]
  uc = [1.0, molefracs[1], molefracs[2]]
  mygrad!(g, x) = ForwardDiff.gradient!(g, f, x)
  myhess!(h, x) = ForwardDiff.hessian!(h,f, x)
  mydfc = TwiceDifferentiableConstraints(con_c!, con_jacobian!, con_h!,
                                        lx,ux,lc,uc)
  algo = IPNewton()
  #println("Function: ", f(x0))
  #println("Jacobian: ", ForwardDiff.jacobian(f, x0))
  #println("Hessian: ", ForwardDiff.hessian(f, x0))
  myans1 = optimize(f, mydfc, x0, algo; autodiff=:forward)
  #println(myans1)
  #println(Optim.minimizer(myans1))
  return myans1
end

function  makeguess(Xa, Xa_maxorder, Xab_max=0.66)

    Xaa_infl = (1-Xab_max)/2
    if Xa == Xa_maxorder
      x0 = [Xaa_infl, Xaa_infl, Xab_max]
    else
      if Xa < Xa_maxorder
        x1aa, x2aa, y1aa, y2aa = 0, Xa_maxorder, 1, (1-Xab_max)/2
        x1bb, x2bb, y1bb, y2bb = 0, Xa_maxorder, 0, (1-Xab_max)/2
        x1ab, x2ab, y1ab, y2ab = 0, Xa_maxorder, 0, Xab_max
      elseif Xa > Xa_maxorder
        x1aa, x2aa, y1aa, y2aa = Xa_maxorder, 1, (1-Xab_max)/2, 0
        x1bb, x2bb, y1bb, y2bb = Xa_maxorder, 1, (1-Xab_max)/2, 1
        x1ab, x2ab, y1ab, y2ab = Xa_maxorder, 1, Xab_max, 0
      end
      x0 = [(Xa-x1aa)*(y2aa-y1aa)/(x2aa-x1aa) + y1aa,
            (Xa-x1bb)*(y2bb-y1bb)/(x2bb-x1bb) + y1bb,
            (Xa-x1ab)*(y2ab-y1ab)/(x2ab-x1ab) + y1ab]
    end
    return x0
  end
function find_configuration2(data::BinaryMQCModel,molefracs,
                                purecompdata,temp,
                                xg = missing)
  Xa, Xb = molefracs
  Za_aa, Zb_bb, Za_ab,  Zb_ba= data.coordparams
  function objectives!(err, pfracs)
    Xaa, Xbb, Xab =pfracs
    yaa = Xaa*2/Za_aa + Xab/Za_ab
    ybb = Xbb*2/Zb_bb + Xab/Zb_ba
    err[1] = Xab^2/(Xaa*Xbb) - 4*exp(-gab(data, pfracs)/(R_GAS*temp))
    err[2] = yaa/(yaa+ybb) - Xa
    err[3] = Xaa + Xbb+ Xab - 1.0
  end
  if ismissing(xg) || length(xg) != 3
    # set an initital guess
    # At max short-range ordering, assume Xab = 2/3, Xaa = Xbb = 1/6
    # This is a significant assumtion, come back to it
    # Else linearly interpolate.
    Xa_maxorder = Za_ab /(Za_ab + Zb_ba)
    for Xab_max in [0.66, 0.75, 0.50, 0.25, 0.90, 0.10, 0.01, 0.99]
      x0 = makeguess(Xa, Xa_maxorder, Xab_max)
      answer = nlsolve(objectives!, x0, autodiff=:forward)
      xaag, xbbg, xabg = answer.zero
      if 0.0 <= xaag <= 1.0 && 0.0 <= xbbg <= 1.0 && 0.0 <= xabg <= 1.0
        return answer
      end
    end
    println("Warning, no good solution was found")
  else
    x0 = xg
  end
  answer = nlsolve(objectives!, x0, autodiff=:forward)
  #println(answer)
  answer
end
function find_configuration3(data::BinaryMQCModel,molefracs,
                                purecompdata,temp,
                                xg = missing)
  Xa, Xb = molefracs
  Za_aa, Zb_bb, Za_ab,  Zb_ba= data.coordparams
  function solvethis(nab)
    naa = (Xa - nab/Za_ab)*Za_aa/2
    nbb = (Xb - nab/Zb_ba)*Zb_bb/2
    ptot = naa+nbb+nab
    pairfracs = [naa, nbb, nab] ./ ptot
    Xaa, Xbb, Xab = pairfracs
    return Xab^2/(Xaa*Xbb) - 4*exp(-gab(data, pairfracs)/(R_GAS*temp))
  end
  if ismissing(xg) || length(xg) != 3
    # set an initital guess
    x0 = (0.0, max(Za_aa/2, Zb_bb/2))
  else
    x0 = xg
  end
  xl, xu = x0
  answer = optimize(solvethis, xl, xu)
  #println(answer)
  nab_final = Optim.minimizer(answer)
  naa_final = (Xa - nab_final/Za_ab)*Za_aa/2
  nbb_final = (Xb - nab_final/Zb_ba)*Zb_bb/2
  npairs = [naa_final, nbb_final, nab_final]
  xpairs = [i/sum(npairs) for i in npairs]
  return npairs, xpairs
end

function bruteforce_configuration(data::BinaryMQCModel,molefracs,
                                purecompdata,temp,
                                x0 = [0.5,0.5,0.0])
  XaaXbbspace = Iterators.product(0.00:0.01:1.00, 0.00:0.01:1.00, 0.00:0.01:1.00) |> collect
  paramspace = filter(x -> x[1] + x[2] + x[3] <= 1.0, XaaXbbspace)
end


"""
    VectorSpaceType

Abstract type for tangent spaces, cotangent spaces, their tensor products,
exterior products, etc.

Every vector space `fiber` is supposed to provide:
* a method of constructing vectors,
* basic operations: addition, subtraction, multiplication by a scalar
  and negation (unary minus),
* `zero_vector(fiber, p)` to construct zero vectors at point `p`,
* `allocate(X)` and `allocate(X, T)` for vector `X` and type `T`,
* `copyto!(X, Y)` for vectors `X` and `Y`,
* `number_eltype(v)` for vector `v`,
* [`vector_space_dimension`](@ref).

Optionally:
* inner product via `inner` (used to provide Riemannian metric on vector
  bundles),
* [`flat`](https://juliamanifolds.github.io/Manifolds.jl/stable/features/atlases.html#Manifolds.flat-Tuple{AbstractManifold,%20Any,%20Any}) and [`sharp`](https://juliamanifolds.github.io/Manifolds.jl/stable/features/atlases.html#Manifolds.sharp-Tuple{AbstractManifold,%20Any,%20Any}),
* `norm` (by default uses `inner`),
* [`project`](@ref) (for embedded vector spaces),
* [`representation_size`](@ref),
* broadcasting for basic operations.
"""
abstract type VectorSpaceType end

struct TangentSpaceType <: VectorSpaceType end

struct CotangentSpaceType <: VectorSpaceType end

TCoTSpaceType = Union{TangentSpaceType,CotangentSpaceType}

const TangentSpace = TangentSpaceType()
const CotangentSpace = CotangentSpaceType()

"""
    AbstractBasis{𝔽,VST<:VectorSpaceType}

Abstract type that represents a basis of vector space of type `VST` on a manifold or
a subset of it.

The type parameter `𝔽` denotes the [`AbstractNumbers`](@ref) that will be used
for the vectors elements.

# See also

[`VectorSpaceType`](@ref)
"""
abstract type AbstractBasis{𝔽,VST<:VectorSpaceType} end

"""
    DefaultBasis{𝔽,VST<:VectorSpaceType}

An arbitrary basis of vector space of type `VST` on a manifold. This will usually
be the fastest basis available for a manifold.

The type parameter `𝔽` denotes the [`AbstractNumbers`](@ref) that will be used
for the vectors elements.

# See also

[`VectorSpaceType`](@ref)
"""
struct DefaultBasis{𝔽,VST<:VectorSpaceType} <: AbstractBasis{𝔽,VST}
    vector_space::VST
end
function DefaultBasis(𝔽::AbstractNumbers = ℝ, vs::VectorSpaceType = TangentSpace)
    return DefaultBasis{𝔽,typeof(vs)}(vs)
end
function DefaultBasis{𝔽}(vs::VectorSpaceType = TangentSpace) where {𝔽}
    return DefaultBasis{𝔽,typeof(vs)}(vs)
end
function DefaultBasis{𝔽,TangentSpaceType}() where {𝔽}
    return DefaultBasis{𝔽,TangentSpaceType}(TangentSpace)
end

"""
    AbstractOrthogonalBasis{𝔽,VST<:VectorSpaceType}

Abstract type that represents an orthonormal basis of vector space of type `VST` on a
manifold or a subset of it.

The type parameter `𝔽` denotes the [`AbstractNumbers`](@ref) that will be used
for the vectors elements.

# See also

[`VectorSpaceType`](@ref)
"""
abstract type AbstractOrthogonalBasis{𝔽,VST<:VectorSpaceType} <: AbstractBasis{𝔽,VST} end

"""
    DefaultOrthogonalBasis{𝔽,VST<:VectorSpaceType}

An arbitrary orthogonal basis of vector space of type `VST` on a manifold. This will usually
be the fastest orthogonal basis available for a manifold.

The type parameter `𝔽` denotes the [`AbstractNumbers`](@ref) that will be used
for the vectors elements.

# See also

[`VectorSpaceType`](@ref)
"""
struct DefaultOrthogonalBasis{𝔽,VST<:VectorSpaceType} <: AbstractOrthogonalBasis{𝔽,VST}
    vector_space::VST
end
function DefaultOrthogonalBasis(𝔽::AbstractNumbers = ℝ, vs::VectorSpaceType = TangentSpace)
    return DefaultOrthogonalBasis{𝔽,typeof(vs)}(vs)
end
function DefaultOrthogonalBasis{𝔽}(vs::VectorSpaceType = TangentSpace) where {𝔽}
    return DefaultOrthogonalBasis{𝔽,typeof(vs)}(vs)
end
function DefaultOrthogonalBasis{𝔽,TangentSpaceType}() where {𝔽}
    return DefaultOrthogonalBasis{𝔽,TangentSpaceType}(TangentSpace)
end

struct VeeOrthogonalBasis{𝔽} <: AbstractOrthogonalBasis{𝔽,TangentSpaceType} end
VeeOrthogonalBasis(𝔽::AbstractNumbers = ℝ) = VeeOrthogonalBasis{𝔽}()

"""
    AbstractOrthonormalBasis{𝔽,VST<:VectorSpaceType}

Abstract type that represents an orthonormal basis of vector space of type `VST` on a
manifold or a subset of it.

The type parameter `𝔽` denotes the [`AbstractNumbers`](@ref) that will be used
for the vectors elements.

# See also

[`VectorSpaceType`](@ref)
"""
abstract type AbstractOrthonormalBasis{𝔽,VST<:VectorSpaceType} <:
              AbstractOrthogonalBasis{𝔽,VST} end

"""
    DefaultOrthonormalBasis(𝔽::AbstractNumbers = ℝ, vs::VectorSpaceType = TangentSpace)

An arbitrary orthonormal basis of vector space of type `VST` on a manifold. This will usually
be the fastest orthonormal basis available for a manifold.

The type parameter `𝔽` denotes the [`AbstractNumbers`](@ref) that will be used
for the vectors elements.

# See also

[`VectorSpaceType`](@ref)
"""
struct DefaultOrthonormalBasis{𝔽,VST<:VectorSpaceType} <: AbstractOrthonormalBasis{𝔽,VST}
    vector_space::VST
end

function DefaultOrthonormalBasis(𝔽::AbstractNumbers = ℝ, vs::VectorSpaceType = TangentSpace)
    return DefaultOrthonormalBasis{𝔽,typeof(vs)}(vs)
end
function DefaultOrthonormalBasis{𝔽}(vs::VectorSpaceType = TangentSpace) where {𝔽}
    return DefaultOrthonormalBasis{𝔽,typeof(vs)}(vs)
end
function DefaultOrthonormalBasis{𝔽,TangentSpaceType}() where {𝔽}
    return DefaultOrthonormalBasis{𝔽,TangentSpaceType}(TangentSpace)
end

"""
    ProjectedOrthonormalBasis(method::Symbol, 𝔽::AbstractNumbers = ℝ)

An orthonormal basis that comes from orthonormalization of basis vectors
of the ambient space projected onto the subspace representing the tangent space
at a given point.

The type parameter `𝔽` denotes the [`AbstractNumbers`](@ref) that will be used
for the vectors elements.

Available methods:
  - `:gram_schmidt` uses a modified Gram-Schmidt orthonormalization.
  - `:svd` uses SVD decomposition to orthogonalize projected vectors.
    The SVD-based method should be more numerically stable at the cost of
    an additional assumption (local metric tensor at a point where the
    basis is calculated has to be diagonal).
"""
struct ProjectedOrthonormalBasis{Method,𝔽} <: AbstractOrthonormalBasis{𝔽,TangentSpaceType} end

function ProjectedOrthonormalBasis(method::Symbol, 𝔽::AbstractNumbers = ℝ)
    return ProjectedOrthonormalBasis{method,𝔽}()
end

@doc raw"""
    GramSchmidtOrthonormalBasis{𝔽} <: AbstractOrthonormalBasis{𝔽}

An orthonormal basis obtained from a basis.

# Constructor
    GramSchmidtOrthonormalBasis(𝔽::AbstractNumbers = ℝ)
"""
struct GramSchmidtOrthonormalBasis{𝔽} <: AbstractOrthonormalBasis{𝔽,TangentSpaceType} end
GramSchmidtOrthonormalBasis(𝔽::AbstractNumbers = ℝ) = GramSchmidtOrthonormalBasis{𝔽}()

@doc raw"""
    DiagonalizingOrthonormalBasis{𝔽,TV} <: AbstractOrthonormalBasis{𝔽,TangentSpaceType}

An orthonormal basis `Ξ` as a vector of tangent vectors (of length determined by
[`manifold_dimension`](@ref)) in the tangent space that diagonalizes the curvature
tensor $R(u,v)w$ and where the direction `frame_direction` $v$ has curvature `0`.

The type parameter `𝔽` denotes the [`AbstractNumbers`](@ref) that will be used
for the vectors elements.

# Constructor

    DiagonalizingOrthonormalBasis(frame_direction, 𝔽::AbstractNumbers = ℝ)
"""
struct DiagonalizingOrthonormalBasis{𝔽,TV} <: AbstractOrthonormalBasis{𝔽,TangentSpaceType}
    frame_direction::TV
end
function DiagonalizingOrthonormalBasis(X, 𝔽::AbstractNumbers = ℝ)
    return DiagonalizingOrthonormalBasis{𝔽,typeof(X)}(X)
end
struct DiagonalizingBasisData{D,V,ET}
    frame_direction::D
    eigenvalues::ET
    vectors::V
end

const DefaultOrDiagonalizingBasis{𝔽} =
    Union{DefaultOrthonormalBasis{𝔽,TangentSpaceType},DiagonalizingOrthonormalBasis{𝔽}}

"""
    CachedBasis{𝔽,V,<:AbstractBasis{𝔽}} <: AbstractBasis{𝔽}

A cached version of the given `basis` with precomputed basis vectors. The basis vectors
are stored in `data`, either explicitly (like in cached variants of
[`ProjectedOrthonormalBasis`](@ref)) or implicitly.

# Constructor

    CachedBasis(basis::AbstractBasis, data)
"""
struct CachedBasis{𝔽,B,V} <:
       AbstractBasis{𝔽,TangentSpaceType} where {B<:AbstractBasis{𝔽,TangentSpaceType},V}
    data::V
end
function CachedBasis(::B, data::V) where {V,𝔽,B<:AbstractBasis{𝔽,<:TangentSpaceType}}
    return CachedBasis{𝔽,B,V}(data)
end
function CachedBasis(basis::CachedBasis) # avoid double encapsulation
    return basis
end
function CachedBasis(
    basis::DiagonalizingOrthonormalBasis,
    eigenvalues::ET,
    vectors::T,
) where {ET<:AbstractVector,T<:AbstractVector}
    data = DiagonalizingBasisData(basis.frame_direction, eigenvalues, vectors)
    return CachedBasis(basis, data)
end

# forward declarations
function get_coordinates end
function get_vector end

const all_uncached_bases{T} = Union{
    AbstractBasis{<:Any,T},
    DefaultBasis{<:Any,T},
    DefaultOrthogonalBasis{<:Any,T},
    DefaultOrthonormalBasis{<:Any,T},
}

"""
    allocate_coordinates(M::AbstractManifold, p, T, n::Int)

Allocate vector of coordinates of length `n` of type `T` of a vector at point `p`
on manifold `M`.
"""
allocate_coordinates(::AbstractManifold, p, T, n::Int) = allocate(p, T, n)
function allocate_coordinates(M::AbstractManifold, p::Int, T, n::Int)
    return (representation_size(M) == () && n == 0) ? zero(T) : zeros(T, n)
end
function allocate_result(
    M::AbstractManifold,
    f::typeof(get_coordinates),
    p,
    X,
    basis::AbstractBasis,
)
    T = allocate_result_type(M, f, (p, X))
    return allocate_coordinates(M, p, T, number_of_coordinates(M, basis))
end

@inline function allocate_result_type(
    M::AbstractManifold,
    f::Union{typeof(get_coordinates),typeof(get_vector)},
    args::Tuple{Any,Vararg{Any}},
)
    apf = allocation_promotion_function(M, f, args)
    return apf(
        invoke(allocate_result_type, Tuple{AbstractManifold,Any,typeof(args)}, M, f, args),
    )
end

"""
    allocation_promotion_function(M::AbstractManifold, f, args::Tuple)

Determine the function that must be used to ensure that the allocated representation is of
the right type. This is needed for [`get_vector`](@ref) when a point on a complex manifold
is represented by a real-valued vectors with a real-coefficient basis, so that
a complex-valued vector representation is allocated.
"""
allocation_promotion_function(M::AbstractManifold, f, args::Tuple) = identity

function combine_allocation_promotion_functions(f::T, ::T) where {T}
    return f
end
function combine_allocation_promotion_functions(::typeof(complex), ::typeof(identity))
    return complex
end
function combine_allocation_promotion_functions(::typeof(identity), ::typeof(complex))
    return complex
end

@doc raw"""
    dual_basis(M::AbstractManifold, p, B::AbstractBasis)

Get the dual basis to `B`, a basis of a vector space at point `p` from manifold `M`.

The dual to the $i$th vector $v_i$ from basis `B` is a vector $v^i$ from the dual space
such that $v^i(v_j) = δ^i_j$, where $δ^i_j$ is the Kronecker delta symbol:
````math
δ^i_j = \begin{cases}
1 & \text{ if } i=j, \\
0 & \text{ otherwise.}
\end{cases}
````
"""
dual_basis(M::AbstractManifold, p, B::AbstractBasis) = _dual_basis(M, p, B)

function _dual_basis(
    ::AbstractManifold,
    p,
    ::DefaultOrthonormalBasis{𝔽,TangentSpaceType},
) where {𝔽}
    return DefaultOrthonormalBasis{𝔽}(CotangentSpace)
end
function _dual_basis(
    ::AbstractManifold,
    p,
    ::DefaultOrthonormalBasis{𝔽,CotangentSpaceType},
) where {𝔽}
    return DefaultOrthonormalBasis{𝔽}(TangentSpace)
end

function _euclidean_basis_vector(p::StridedArray, i)
    X = zero(p)
    X[i] = 1
    return X
end
function _euclidean_basis_vector(p, i)
    # when p is for example a SArray
    X = similar(p)
    copyto!(X, zero(p))
    X[i] = 1
    return X
end

"""
    get_basis(M::AbstractManifold, p, B::AbstractBasis; kwargs...) -> CachedBasis

Compute the basis vectors of the tangent space at a point on manifold `M`
represented by `p`.

Returned object derives from [`AbstractBasis`](@ref) and may have a field `.vectors`
that stores tangent vectors or it may store them implicitly, in which case
the function [`get_vectors`](@ref) needs to be used to retrieve the basis vectors.

See also: [`get_coordinates`](@ref), [`get_vector`](@ref)
"""
function get_basis(M::AbstractManifold, p, B::AbstractBasis; kwargs...)
    return _get_basis(M, p, B; kwargs...)
end

function _get_basis(::AbstractManifold, ::Any, B::CachedBasis)
    return B
end
function _get_basis(M::AbstractManifold, p, B::ProjectedOrthonormalBasis{:svd,ℝ})
    S = representation_size(M)
    PS = prod(S)
    dim = manifold_dimension(M)
    # projection
    # TODO: find a better way to obtain a basis of the ambient space
    Xs = [
        convert(Vector, reshape(project(M, p, _euclidean_basis_vector(p, i)), PS)) for
        i in eachindex(p)
    ]
    O = reduce(hcat, Xs)
    # orthogonalization
    # TODO: try using rank-revealing QR here
    decomp = svd(O)
    rotated = Diagonal(decomp.S) * decomp.Vt
    vecs = [collect(reshape(rotated[i, :], S)) for i in 1:dim]
    # normalization
    for i in 1:dim
        i_norm = norm(M, p, vecs[i])
        vecs[i] /= i_norm
    end
    return CachedBasis(B, vecs)
end
function _get_basis(
    M::AbstractManifold,
    p,
    B::ProjectedOrthonormalBasis{:gram_schmidt,ℝ};
    kwargs...,
)
    E = [project(M, p, _euclidean_basis_vector(p, i)) for i in eachindex(p)]
    V = gram_schmidt(M, p, E; kwargs...)
    return CachedBasis(B, V)
end
function _get_basis(M::AbstractManifold, p, B::VeeOrthogonalBasis)
    return get_basis_vee(M, p, number_system(B))
end
function get_basis_vee(M::AbstractManifold, p, N)
    return get_basis(M, p, DefaultOrthogonalBasis(N))
end

function _get_basis(M::AbstractManifold, p, B::DefaultBasis)
    return get_basis_default(M, p, number_system(B))
end
function get_basis_default(M::AbstractManifold, p, N)
    return get_basis(M, p, DefaultOrthogonalBasis(N))
end

function _get_basis(M::AbstractManifold, p, B::DefaultOrthogonalBasis)
    return get_basis_orthogonal(M, p, number_system(B))
end
function get_basis_orthogonal(M::AbstractManifold, p, N)
    return get_basis(M, p, DefaultOrthonormalBasis(N))
end

function _get_basis(M::AbstractManifold, p, B::DiagonalizingOrthonormalBasis)
    return get_basis_diagonalizing(M, p, B)
end
function get_basis_diagonalizing end

function _get_basis(M::AbstractManifold, p, B::DefaultOrthonormalBasis)
    return get_basis_orthonormal(M, p, number_system(B))
end
function get_basis_orthonormal(M::AbstractManifold, p, N::AbstractNumbers; kwargs...)
    B = DefaultOrthonormalBasis(N)
    dim = number_of_coordinates(M, B)
    return CachedBasis(
        B,
        [get_vector(M, p, [ifelse(i == j, 1, 0) for j in 1:dim], B) for i in 1:dim],
    )
end

@doc raw"""
    get_coordinates(M::AbstractManifold, p, X, B::AbstractBasis)
    get_coordinates(M::AbstractManifold, p, X, B::CachedBasis)

Compute a one-dimensional vector of coefficients of the tangent vector `X`
at point denoted by `p` on manifold `M` in basis `B`.

Depending on the basis, `p` may not directly represent a point on the manifold.
For example if a basis transported along a curve is used, `p` may be the coordinate
along the curve. If a [`CachedBasis`](@ref) is provided, their stored vectors are used,
otherwise the user has to provide a method to compute the coordinates.

For the [`CachedBasis`](@ref) keep in mind that the reconstruction with [`get_vector`](@ref)
requires either a dual basis or the cached basis to be selfdual, for example orthonormal

See also: [`get_vector`](@ref), [`get_basis`](@ref)
"""
function get_coordinates(M::AbstractManifold, p, X, B::AbstractBasis)
    return _get_coordinates(M, p, X, B)
end

function _get_coordinates(M::AbstractManifold, p, X, B::VeeOrthogonalBasis)
    return get_coordinates_vee(M, p, X, number_system(B))
end
function get_coordinates_vee(M::AbstractManifold, p, X, N)
    return get_coordinates(M, p, X, DefaultOrthogonalBasis(N))
end

function _get_coordinates(M::AbstractManifold, p, X, B::DefaultBasis)
    return get_coordinates_default(M, p, X, number_system(B))
end
function get_coordinates_default(M::AbstractManifold, p, X, N::AbstractNumbers)
    return get_coordinates(M, p, X, DefaultOrthogonalBasis(N))
end

function _get_coordinates(M::AbstractManifold, p, X, B::DefaultOrthogonalBasis)
    return get_coordinates_orthogonal(M, p, X, number_system(B))
end
function get_coordinates_orthogonal(M::AbstractManifold, p, X, N)
    return get_coordinates_orthonormal(M, p, X, N)
end

function _get_coordinates(M::AbstractManifold, p, X, B::DefaultOrthonormalBasis)
    return get_coordinates_orthonormal(M, p, X, number_system(B))
end
function get_coordinates_orthonormal(M::AbstractManifold, p, X, N)
    Y = allocate_result(M, get_coordinates, p, X, DefaultOrthonormalBasis(N))
    return get_coordinates_orthonormal!(M, Y, p, X, N)
end

function _get_coordinates(M::AbstractManifold, p, X, B::DiagonalizingOrthonormalBasis)
    return get_coordinates_diagonalizing(M, p, X, B)
end
function get_coordinates_diagonalizing(
    M::AbstractManifold,
    p,
    X,
    B::DiagonalizingOrthonormalBasis,
)
    Y = allocate_result(M, get_coordinates, p, X, B)
    return get_coordinates_diagonalizing!(M, Y, p, X, B)
end

function _get_coordinates(M::AbstractManifold, p, X, B::CachedBasis)
    return get_coordinates_cached(M, number_system(M), p, X, B, number_system(B))
end
function get_coordinates_cached(
    M::AbstractManifold,
    ::ComplexNumbers,
    p,
    X,
    B::CachedBasis,
    ::RealNumbers,
)
    return map(vb -> conj(inner(M, p, X, vb)), get_vectors(M, p, B))
end
function get_coordinates_cached(
    M::AbstractManifold,
    ::𝔽,
    p,
    X,
    C::CachedBasis,
    ::𝔽,
) where {𝔽}
    return map(vb -> real(inner(M, p, X, vb)), get_vectors(M, p, C))
end

function get_coordinates!(M::AbstractManifold, Y, p, X, B::AbstractBasis)
    return _get_coordinates!(M, Y, p, X, B)
end
function _get_coordinates!(M::AbstractManifold, Y, p, X, B::VeeOrthogonalBasis)
    return get_coordinates_vee!(M, Y, p, X, number_system(B))
end
function get_coordinates_vee!(M::AbstractManifold, Y, p, X, N)
    return get_coordinates!(M, Y, p, X, DefaultOrthogonalBasis(N))
end

function _get_coordinates!(M::AbstractManifold, Y, p, X, B::DefaultBasis)
    return get_coordinates_default!(M, Y, p, X, number_system(B))
end
function get_coordinates_default!(M::AbstractManifold, Y, p, X, N)
    return get_coordinates!(M, Y, p, X, DefaultOrthogonalBasis(N))
end

function _get_coordinates!(M::AbstractManifold, Y, p, X, B::DefaultOrthogonalBasis)
    return get_coordinates_orthogonal!(M, Y, p, X, number_system(B))
end
function get_coordinates_orthogonal!(M::AbstractManifold, Y, p, X, N)
    return get_coordinates!(M, Y, p, X, DefaultOrthonormalBasis(N))
end

function _get_coordinates!(M::AbstractManifold, Y, p, X, B::DefaultOrthonormalBasis)
    return get_coordinates_orthonormal!(M, Y, p, X, number_system(B))
end
function get_coordinates_orthonormal! end

function _get_coordinates!(M::AbstractManifold, Y, p, X, B::DiagonalizingOrthonormalBasis)
    return get_coordinates_diagonalizing!(M, Y, p, X, B)
end
function get_coordinates_diagonalizing! end

function _get_coordinates!(M::AbstractManifold, Y, p, X, B::CachedBasis)
    return get_coordinates_cached!(M, number_system(M), Y, p, X, B, number_system(B))
end
function get_coordinates_cached!(
    M::AbstractManifold,
    ::ComplexNumbers,
    Y,
    p,
    X,
    B::CachedBasis,
    ::RealNumbers,
)
    map!(vb -> conj(inner(M, p, X, vb)), Y, get_vectors(M, p, B))
    return Y
end
function get_coordinates_cached!(
    M::AbstractManifold,
    ::𝔽,
    Y,
    p,
    X,
    C::CachedBasis,
    ::𝔽,
) where {𝔽}
    map!(vb -> real(inner(M, p, X, vb)), Y, get_vectors(M, p, C))
    return Y
end

"""
    X = get_vector(M::AbstractManifold, p, c, B::AbstractBasis)

Convert a one-dimensional vector of coefficients in a basis `B` of
the tangent space at `p` on manifold `M` to a tangent vector `X` at `p`.

Depending on the basis, `p` may not directly represent a point on the manifold.
For example if a basis transported along a curve is used, `p` may be the coordinate
along the curve.

For the [`CachedBasis`](@ref) keep in mind that the reconstruction from [`get_coordinates`](@ref)
requires either a dual basis or the cached basis to be selfdual, for example orthonormal

See also: [`get_coordinates`](@ref), [`get_basis`](@ref)
"""
function get_vector(M::AbstractManifold, p, c, B::AbstractBasis)
    return _get_vector(M, p, c, B)
end

function _get_vector(M::AbstractManifold, p, c, B::VeeOrthogonalBasis)
    return get_vector_vee(M, p, c, number_system(B))
end
function get_vector_vee(M::AbstractManifold, p, c, N)
    return get_vector(M, p, c, DefaultOrthogonalBasis(N))
end

function _get_vector(M::AbstractManifold, p, c, B::DefaultBasis)
    return get_vector_default(M, p, c, number_system(B))
end
function get_vector_default(M::AbstractManifold, p, c, N)
    return get_vector(M, p, c, DefaultOrthogonalBasis(N))
end

function _get_vector(M::AbstractManifold, p, c, B::DefaultOrthogonalBasis)
    return get_vector_orthogonal(M, p, c, number_system(B))
end
function get_vector_orthogonal(M::AbstractManifold, p, c, N)
    return get_vector_orthonormal(M, p, c, N)
end

function _get_vector(M::AbstractManifold, p, c, B::DefaultOrthonormalBasis)
    return get_vector_orthonormal(M, p, c, number_system(B))
end
function get_vector_orthonormal(M::AbstractManifold, p, c, N)
    B = DefaultOrthonormalBasis(N)
    Y = allocate_result(M, get_vector, p, c)
    return get_vector!(M, Y, p, c, B)
end

function _get_vector(M::AbstractManifold, p, c, B::DiagonalizingOrthonormalBasis)
    return get_vector_diagonalizing(M, p, c, B)
end
function get_vector_diagonalizing(
    M::AbstractManifold,
    p,
    c,
    B::DiagonalizingOrthonormalBasis,
)
    Y = allocate_result(M, get_vector, p, c)
    return get_vector!(M, Y, p, c, B)
end

function _get_vector(M::AbstractManifold, p, c, B::CachedBasis)
    return get_vector_cached(M, p, c, B)
end
_get_vector_cache_broadcast(::Any) = Val(true)
function get_vector_cached(M::AbstractManifold, p, X, B::CachedBasis)
    # quite convoluted but:
    #  1) preserves the correct `eltype`
    #  2) guarantees a reasonable array type `Y`
    #     (for example scalar * `SizedValidation` is an `SArray`)
    bvectors = get_vectors(M, p, B)
    if _get_vector_cache_broadcast(bvectors[1]) === Val(false)
        Xt = X[1] * bvectors[1]
        for i in 2:length(X)
            copyto!(Xt, Xt + X[i] * bvectors[i])
        end
    else
        Xt = X[1] .* bvectors[1]
        for i in 2:length(X)
            Xt .+= X[i] .* bvectors[i]
        end
    end
    return Xt
end
function get_vector!(M::AbstractManifold, Y, p, c, B::AbstractBasis)
    return _get_vector!(M, Y, p, c, B)
end

function _get_vector!(M::AbstractManifold, Y, p, c, B::VeeOrthogonalBasis)
    return get_vector_vee!(M, Y, p, c, number_system(B))
end
get_vector_vee!(M, Y, p, c, N) = get_vector!(M, Y, p, c, DefaultOrthogonalBasis(N))

function _get_vector!(M::AbstractManifold, Y, p, c, B::DefaultBasis)
    return get_vector_default!(M, Y, p, c, number_system(B))
end
function get_vector_default!(M::AbstractManifold, Y, p, c, N)
    return get_vector!(M, Y, p, c, DefaultOrthogonalBasis(N))
end

function _get_vector!(M::AbstractManifold, Y, p, c, B::DefaultOrthogonalBasis)
    return get_vector_orthogonal!(M, Y, p, c, number_system(B))
end
function get_vector_orthogonal!(M::AbstractManifold, Y, p, c, N)
    return get_vector!(M, Y, p, c, DefaultOrthonormalBasis(N))
end

function _get_vector!(M::AbstractManifold, Y, p, c, B::DefaultOrthonormalBasis)
    return get_vector_orthonormal!(M, Y, p, c, number_system(B))
end
function get_vector_orthonormal! end

function _get_vector!(M::AbstractManifold, Y, p, c, B::DiagonalizingOrthonormalBasis)
    return get_vector_diagonalizing!(M, Y, p, c, B)
end
function get_vector_diagonalizing! end

function _get_vector!(M::AbstractManifold, Y, p, c, B::CachedBasis)
    return get_vector_cached!(M, Y, p, c, B)
end
function get_vector_cached!(M::AbstractManifold, Y, p, X, B::CachedBasis)
    # quite convoluted but:
    #  1) preserves the correct `eltype`
    #  2) guarantees a reasonable array type `Y`
    #     (for example scalar * `SizedValidation` is an `SArray`)
    bvectors = get_vectors(M, p, B)
    return if _get_vector_cache_broadcast(bvectors[1]) === Val(false)
        Xt = X[1] * bvectors[1]
        copyto!(Y, Xt)
        for i in 2:length(X)
            copyto!(Y, Y + X[i] * bvectors[i])
        end
        return Y
    else
        Xt = X[1] .* bvectors[1]
        copyto!(Y, Xt)
        for i in 2:length(X)
            Y .+= X[i] .* bvectors[i]
        end
        return Y
    end
end

"""
    get_vectors(M::AbstractManifold, p, B::AbstractBasis)

Get the basis vectors of basis `B` of the tangent space at point `p`.
"""
function get_vectors(M::AbstractManifold, p, B::AbstractBasis)
    return _get_vectors(M, p, B)
end
function _get_vectors(::AbstractManifold, ::Any, B::CachedBasis)
    return _get_vectors(B)
end
_get_vectors(B::CachedBasis{𝔽,<:AbstractBasis,<:AbstractArray}) where {𝔽} = B.data
function _get_vectors(B::CachedBasis{𝔽,<:AbstractBasis,<:DiagonalizingBasisData}) where {𝔽}
    return B.data.vectors
end

@doc raw"""
    gram_schmidt(M::AbstractManifold{𝔽}, p, B::AbstractBasis{𝔽}) where {𝔽}
    gram_schmidt(M::AbstractManifold, p, V::AbstractVector)

Compute an ONB in the tangent space at `p` on the [`AbstractManifold`](@ref} `M` from either an
[`AbstractBasis`](@ref) basis ´B´ or a set of (at most) [`manifold_dimension`](@ref)`(M)`
many vectors.
Note that this method requires the manifold and basis to work on the same
[`AbstractNumbers`](@ref) `𝔽`, i.e. with real coefficients.

The method always returns a basis, i.e. linearly dependent vectors are removed.

# Keyword arguments

* `warn_linearly_dependent` (`false`) – warn if the basis vectors are not linearly
  independent
* `skip_linearly_dependent` (`false`) – whether to just skip (`true`) a vector that
  is linearly dependent to the previous ones or to stop (`false`, default) at that point
* `return_incomplete_set` (`false`) – throw an error if the resulting set of vectors is not
  a basis but contains less vectors

further keyword arguments can be passed to set the accuracy of the independence test.
Especially `atol` is raised slightly by default to `atol = 5*1e-16`.

# Return value

When a set of vectors is orthonormalized a set of vectors is returned.
When an [`AbstractBasis`](@ref) is orthonormalized, a [`CachedBasis`](@ref) is returned.
"""
function gram_schmidt(
    M::AbstractManifold{𝔽},
    p,
    B::AbstractBasis{𝔽};
    warn_linearly_dependent = false,
    return_incomplete_set = false,
    skip_linearly_dependent = false,
    kwargs...,
) where {𝔽}
    V = gram_schmidt(
        M,
        p,
        get_vectors(M, p, B);
        warn_linearly_dependent = warn_linearly_dependent,
        skip_linearly_dependent = skip_linearly_dependent,
        return_incomplete_set = return_incomplete_set,
        kwargs...,
    )
    return CachedBasis(GramSchmidtOrthonormalBasis(𝔽), V)
end
function gram_schmidt(
    M::AbstractManifold,
    p,
    V::AbstractVector;
    atol = eps(number_eltype(first(V))),
    warn_linearly_dependent = false,
    return_incomplete_set = false,
    skip_linearly_dependent = false,
    kwargs...,
)
    N = length(V)
    Ξ = empty(V)
    dim = manifold_dimension(M)
    N < dim && @warn "Input only has $(N) vectors, but manifold dimension is $(dim)."
    @inbounds for n in 1:N
        Ξₙ = copy(M, p, V[n])
        for k in 1:length(Ξ)
            Ξₙ .-= real(inner(M, p, Ξ[k], Ξₙ)) .* Ξ[k]
        end
        nrmΞₙ = norm(M, p, Ξₙ)
        if isapprox(nrmΞₙ / dim, 0; atol = atol, kwargs...)
            warn_linearly_dependent &&
                @warn "Input vector $(n) lies in the span of the previous ones."
            !skip_linearly_dependent && throw(
                ErrorException("Input vector $(n) lies in the span of the previous ones."),
            )
        else
            push!(Ξ, Ξₙ ./ nrmΞₙ)
        end
        if length(Ξ) == dim
            (n < N) &&
                @warn "More vectors ($(N)) entered than the dimension of the manifold ($dim). All vectors after the $n th ignored."
            return Ξ
        end
    end
    if return_incomplete_set # if we rech this point - length(Ξ) < dim
        return Ξ
    else
        throw(
            ErrorException(
                "gram_schmidt found only $(length(Ξ)) orthonormal basis vectors, but manifold dimension is $(dim).",
            ),
        )
    end
end

@doc raw"""
    hat(M::AbstractManifold, p, Xⁱ)

Given a basis $e_i$ on the tangent space at a point `p` and tangent
component vector $X^i$, compute the equivalent vector representation
$X=X^i e_i$, where Einstein summation notation is used:

````math
∧ : X^i ↦ X^i e_i
````

For array manifolds, this converts a vector representation of the tangent
vector to an array representation. The [`vee`](@ref) map is the `hat` map's
inverse.
"""
@inline hat(M::AbstractManifold, p, X) = get_vector(M, p, X, VeeOrthogonalBasis())
@inline hat!(M::AbstractManifold, Y, p, X) = get_vector!(M, Y, p, X, VeeOrthogonalBasis())

"""
    number_of_coordinates(M::AbstractManifold{𝔽}, B::AbstractBasis)
    number_of_coordinates(M::AbstractManifold{𝔽}, ::𝔾)

Compute the number of coordinates in basis of field type `𝔾` on a manifold `M`.
This also corresponds to the number of vectors represented by `B`,
or stored within `B` in case of a [`CachedBasis`](@ref).
"""
function number_of_coordinates(M::AbstractManifold{𝔽}, ::AbstractBasis{𝔾}) where {𝔽,𝔾}
    return number_of_coordinates(M, 𝔾)
end
function number_of_coordinates(M::AbstractManifold{𝔽}, f::𝔾) where {𝔽,𝔾}
    # for odd manifolds this first case has to match.
    (real_dimension(𝔽) == real_dimension(f)) && return manifold_dimension(M)
    return div(manifold_dimension(M), real_dimension(𝔽)) * real_dimension(f)
end

"""
    number_system(::AbstractBasis)

The number system for the vectors of the given basis.
"""
number_system(::AbstractBasis{𝔽}) where {𝔽} = 𝔽

function _show_basis_vector(io::IO, X; pre = "", head = "")
    sX = sprint(show, "text/plain", X, context = io, sizehint = 0)
    sX = replace(sX, '\n' => "\n$(pre)")
    return print(io, head, pre, sX)
end
function _show_basis_vector_range(io::IO, Ξ, range; pre = "", sym = "E")
    for i in range
        _show_basis_vector(io, Ξ[i]; pre = pre, head = "\n$(sym)$(i) =\n")
    end
    return nothing
end
function _show_basis_vector_range_noheader(io::IO, Ξ; max_vectors = 4, pre = "", sym = "E")
    nv = length(Ξ)
    return if nv ≤ max_vectors
        _show_basis_vector_range(io, Ξ, 1:nv; pre = "  ", sym = " E")
    else
        halfn = div(max_vectors, 2)
        _show_basis_vector_range(io, Ξ, 1:halfn; pre = "  ", sym = " E")
        print(io, "\n ⋮")
        _show_basis_vector_range(io, Ξ, (nv - halfn + 1):nv; pre = "  ", sym = " E")
    end
end

function show(io::IO, ::DefaultBasis{𝔽}) where {𝔽}
    return print(io, "DefaultBasis($(𝔽))")
end
function show(io::IO, ::DefaultOrthogonalBasis{𝔽}) where {𝔽}
    return print(io, "DefaultOrthogonalBasis($(𝔽))")
end
function show(io::IO, ::DefaultOrthonormalBasis{𝔽}) where {𝔽}
    return print(io, "DefaultOrthonormalBasis($(𝔽))")
end
function show(io::IO, ::GramSchmidtOrthonormalBasis{𝔽}) where {𝔽}
    return print(io, "GramSchmidtOrthonormalBasis($(𝔽))")
end
function show(io::IO, ::ProjectedOrthonormalBasis{method,𝔽}) where {method,𝔽}
    return print(io, "ProjectedOrthonormalBasis($(repr(method)), $(𝔽))")
end
function show(io::IO, ::MIME"text/plain", onb::DiagonalizingOrthonormalBasis)
    println(
        io,
        "DiagonalizingOrthonormalBasis($(number_system(onb))) with eigenvalue 0 in direction:",
    )
    sk = sprint(show, "text/plain", onb.frame_direction, context = io, sizehint = 0)
    sk = replace(sk, '\n' => "\n ")
    return print(io, sk)
end
function show(
    io::IO,
    ::MIME"text/plain",
    B::CachedBasis{𝔽,T,D},
) where {𝔽,T<:AbstractBasis,D}
    vectors = _get_vectors(B)
    print(
        io,
        "Cached basis of type $T with $(length(vectors)) basis vector$(length(vectors) == 1 ? "" : "s"):",
    )
    return _show_basis_vector_range_noheader(
        io,
        vectors;
        max_vectors = 4,
        pre = "  ",
        sym = " E",
    )
end
function show(
    io::IO,
    ::MIME"text/plain",
    B::CachedBasis{𝔽,T,D},
) where {𝔽,T<:DiagonalizingOrthonormalBasis,D<:DiagonalizingBasisData}
    vectors = _get_vectors(B)
    nv = length(vectors)
    sk = sprint(show, "text/plain", T(B.data.frame_direction), context = io, sizehint = 0)
    sk = replace(sk, '\n' => "\n ")
    print(io, sk)
    println(io, "\nand $(nv) basis vector$(nv == 1 ? "" : "s").")
    print(io, "Basis vectors:")
    _show_basis_vector_range_noheader(io, vectors; max_vectors = 4, pre = "  ", sym = " E")
    println(io, "\nEigenvalues:")
    sk = sprint(show, "text/plain", B.data.eigenvalues, context = io, sizehint = 0)
    sk = replace(sk, '\n' => "\n ")
    return print(io, ' ', sk)
end

@doc raw"""
    vee(M::AbstractManifold, p, X)

Given a basis $e_i$ on the tangent space at a point `p` and tangent
vector `X`, compute the vector components $X^i$, such that $X = X^i e_i$, where
Einstein summation notation is used:

````math
\vee : X^i e_i ↦ X^i
````

For array manifolds, this converts an array representation of the tangent
vector to a vector representation. The [`hat`](@ref) map is the `vee` map's
inverse.
"""
vee(M::AbstractManifold, p, X) = get_coordinates(M, p, X, VeeOrthogonalBasis())
vee!(M::AbstractManifold, Y, p, X) = get_coordinates!(M, Y, p, X, VeeOrthogonalBasis())


module CryptoSignatures

using CryptoGroups
using Random

rng() = RandomDevice()

# const _default_rng = Ref{RandomDevice}()
# function __init__()
#     _default_rng[] = RandomDevice()
# end

# default_rng() = _default_rng[]

abstract type AbstractSignature end

id(s::AbstractSignature) = s.pubkey ### One can overwrite this as one wishes

"""
Never use this for deployed application!!!
"""
verify(data,hashnum::UInt64) = hash(data)==hashnum
verify(data,s::AbstractSignature,G::AbstractGroup) = verify(s,G) && verify(data,s.hash)

abstract type AbstractSigner end
id(s::AbstractSigner) = s.pubkey

abstract type AbstractEncryptionKey end
abstract type AbstractDecryptionKey end

# The singer does store group to prevent the private key to be accidentally missused with different group which would lower the security. And the singature would be useless in such case.
struct Signer{K,P} <: AbstractSigner
    privkey::K
    pubkey::P
    G::AbstractGroup
end

function Signer(G::AbstractGroup;rng=rng())
    x = rand(1:order(G))
    y = binary(G^x)
    Signer(x,y,G)
end

### There are many different ways one could sing stuff.
# include("rsasignatures.jl")
include("dsasignatures.jl")

export verify, rsasign, id, Signer, DSASignature

end # module


if basename(pwd()) == "aoc"
    cd("2021/20")
end
using Base.Iterators: cycle, partition, Stateful

function loadstartingpositions(filename::AbstractString)
    [parse(Int, last(line)) for line in eachline(filename)]
end

part1(filename::AbstractString) = part1(loadstartingpositions(filename))

examplepositions = [4, 8]
inputpositions = [6, 7]

function part1(positions::Vector{Int})
    positions = copy(positions)
    scores = [0, 0]
    rolls = 0
    index = 0
    dice = Stateful(sum(p) for p in partition(cycle(1:100), 3))
    while all(<(1000), scores)
        index = offsetmod(index + 1, 2)
        positions[index] = offsetmod(positions[index] + popfirst!(dice), 10)
        scores[index] += positions[index]
        rolls += 3
    end
    rolls * minimum(scores)
end

offsetmod(x, n) = ((x - 1) % n) + 1