module SpectralKit

export domain_extrema, roots, augmented_extrema, evaluate, Chebyshev, ChebyshevSemiInf,
    ChebyshevInf, ChebyshevInterval

using ArgCheck: @argcheck
using DocStringExtensions: FUNCTIONNAME, SIGNATURES, TYPEDEF
using Parameters: @unpack

####
#### utilities
####

flip_if(condition, x) = condition ? -x : x

one_like(::Type{T}) where {T} = cos(zero(T))

"""
$(TYPEDEF)

Abstract type for function families.

# Supported interface

For `F::FunctionFamily`, the supported API functions are

- [`domain_extrema`](@ref) for querying the domain,

- [`evaluate`](@ref) for function evaluation,

- [`roots`](@ref) and [`augmented_extrema`](@ref) to obtain collocation points.
"""
abstract type FunctionFamily end

Broadcast.broadcastable(family::FunctionFamily) = Ref(family)

"""
`$(FUNCTIONNAME)(family)`

Return the extrema of the domain of the given `family` as an ordered tuple.

Type is not specified, but guaranteed to be the same for both endpoints.
"""
function domain_extrema end

"""
`$(FUNCTIONNAME)(family, n, x, order)`

Evaluate the `n`th (starting from 0) function in `family` at `x`.

`order` determines the derivatives:

- `Val(d)` returns the `d`th derivatives, starting from `0` (for the function value)

- `Val(0:d)` returns the derivatives up to `d`, starting from the function value, as
   multiple values (ie a tuple).

The implementation is intended to be type stable.

Consequences are undefined for evaluating outside the domain.
"""
function evaluate end

"""
`$(FUNCTIONNAME)([T], family, N)`

Return the roots of the `N`th function in `family`, as a vector of `N` numbers with element
type `T` (default `Float64`).

In the context of collocation, this is also known as the “Gauss-Chebyshev” grid.

Order is monotone, but not guaranteed to be increasing.
"""
roots(family, N::Integer) = roots(Float64, family, N)

"""
`$(FUNCTIONNAME)([T], family, N)`

Return the augmented extrema (extrema + boundary values) of the `N-1`th function in
`family`, as a vector of `N` numbers with element type `T` (default `Float64`).

In the context of collocation, this is also known as the “Gauss-Lobatto” grid.

Order is monotone, but not guaranteed to be increasing.
"""
function augmented_extrema(family::FunctionFamily, N::Integer)
    augmented_extrema(Float64, family, N)
end

####
#### Chebyshev on [-1,1]
####

"""
$(TYPEDEF)

Chebyhev polynomials of the first kind, defined on `[-1,1]`.
"""
struct Chebyshev <: FunctionFamily end

@inline domain_extrema(::Chebyshev) = (-1, 1)

"""
$(SIGNATURES)

Evaluate the `n`th Chebyshev polynomial at `-1` for the given orders.
"""
chebyshev_min(::Type{T}, n::Integer, ::Val{0}) where {T} = flip_if(isodd(n), one_like(T))

"""
$(SIGNATURES)

Evaluate the `n`th Chebyshev polynomial at `1` for the given orders.
"""
chebyshev_max(::Type{T}, n::Integer, ::Val{0}) where {T} = one_like(T)

function chebyshev_min(::Type{T}, n::Integer, ::Val{1}) where {T}
    flip_if(iseven(n), one_like(T) * abs2(n))
end

chebyshev_max(::Type{T}, n::Integer, ::Val{1}) where {T} = one_like(T) * abs2(n)

function chebyshev_min(::Type{T}, n::Integer, ::Val{0:1}) where {T}
    chebyshev_min(T, n, Val(0)), chebyshev_min(T, n, Val(1))
end

function chebyshev_max(::Type{T}, n::Integer, ::Val{0:1}) where {T}
    chebyshev_max(T, n, Val(0)), chebyshev_max(T, n, Val(1))
end

"""
$(SIGNATURES)

Evaluate the `n`th Chebyshev polynomial at `-1 < x < 1` for the given orders.
"""
chebyshev_interior(n::Integer, x::Real, ::Val{0}) = cos(n * acos(x))

function chebyshev_interior(n::Integer, x::Real, ::Val{1})
    t = acos(x)
    n * sin(n * t) / sin(t)
end

function chebyshev_interior(n::Integer, x::Real, ::Val{0:1})
    t = acos(x)
    t′ = 1 / sin(t)
    s, c = sincos(n * t)
    c, s * n * t′
end

function evaluate(family::Chebyshev, n::Integer, x::T, order) where {T <: Real}
    if x == -1
        chebyshev_min(T, n, order)
    elseif x == 1
        chebyshev_max(T, n, order)
    else
        chebyshev_interior(n, x, order)
    end
end

function roots(::Type{T}, ::Chebyshev, N) where {T <: Real}
    cospi.(((2 * N - 1):-2:1) ./ T(2 * N))
end

function augmented_extrema(::Type{T}, family::Chebyshev, N) where {T}
    cospi.(((N-1):-1:0) ./ T(N - 1))
end

####
#### Transformation of the Chebyshev polynomials — generic code
####

"""
$(TYPEDEF)

Define a function family by transforming from the Chebyshev polynomials on `[-1,1]`.

For `family::TransformedChebyshev`, subtypes implement:

- `from_chebyshev(family, x)`, for transforming from `x ∈ [-1,1]` to `y` of the domain,

- `to_chebyshev(family, y, order)` for transforming `y` the domain to `x ∈ [-1,1]`, where
  `order` follows the semantics of [`evaluate`](@ref) and returns `x`, `∂x/∂y`, … as
  requested.

- `domain_extrema(family)` is optional.
"""
abstract type TransformedChebyshev <: FunctionFamily end

function roots(::Type{T}, family::TransformedChebyshev, N) where {T}
    from_chebyshev.(family, roots(T, Chebyshev(), N))
end

function augmented_extrema(::Type{T}, family::TransformedChebyshev, N) where {T}
    from_chebyshev.(family, augmented_extrema(T, Chebyshev(), N))
end

function evaluate(family::TransformedChebyshev, n::Integer, x::Real, order::Val{0})
    evaluate(Chebyshev(), n, to_chebyshev(family, x, order), order)
end

function evaluate(family::TransformedChebyshev, n::Integer, x::Real, ::Val{1})
    x, x′ = to_chebyshev(family, x, Val(0:1))
    t′ = evaluate(Chebyshev(), n, x, Val(1))
    t′ * x′
end

function evaluate(family::TransformedChebyshev, n::Integer, x::Real, ::Val{0:1})
    x, x′ = to_chebyshev(family, x, Val(0:1))
    t, t′ = evaluate(Chebyshev(), n, x, Val(0:1))
    t, t′ * x′
end

function domain_extrema(family::TransformedChebyshev)
    from_chebyshev.(family, domain_extrema(Chebyshev()))
end

####
#### Rational Chebyshev on [A,Inf) or (-Inf,A]
####

"""
$(TYPEDEF)

Chebyshev polynomials transformed to the domain `[A, Inf)` (when `L > 0`) or `(-Inf,A]`
(when `L < 0`) using ``y = A + L * (1 + x) / (1 - x)``.
"""
struct ChebyshevSemiInf{T <: Real} <: TransformedChebyshev
    "The finite endpoint `A`."
    A::T
    "Scale factor `L ≠ 0`."
    L::T
    function ChebyshevSemiInf(A::T, L::T) where {T <: Real}
        @argcheck L ≠ 0
        new{T}(A, L)
    end
end

ChebyshevSemiInf(A::Real, L::Real) = ChebyshevSemiInf(promote(A, L)...)

function domain_extrema(TL::ChebyshevSemiInf)
    @unpack A, L = TL
    if L > 0
        promote(A, Inf)
    else
        promote(-Inf, A)
    end
end

function from_chebyshev(TL::ChebyshevSemiInf, x)
    TL.A + TL.L * (1 + x) / (1 - x)
end

function chebyshev_semiinf_endpoints(y, L, x::T) where {T}
    if (y == Inf && L > 0) || (y == -Inf && L < 0)
        one_like(T)
    else
        x
    end
end

function to_chebyshev(TL::ChebyshevSemiInf, y, ::Val{0})
    @unpack A, L = TL
    z = y - A
    x = (z - L) / (z + L)
    chebyshev_semiinf_endpoints(y, L, x)
end

function to_chebyshev(TL::ChebyshevSemiInf, y, ::Val{1})
    @unpack A, L = TL
    2 * L / abs2(y - A + L)
end

function to_chebyshev(TL::ChebyshevSemiInf, y, ::Val{0:1})
    @unpack A, L = TL
    z = y - A
    num = z - L
    den = z + L
    chebyshev_semiinf_endpoints(y, L, num/den), 2 * L / abs2(den)
end

####
#### Rational Chebyshev on (-Inf,Inf)
####

"""
$(TYPEDEF)

Chebyshev polynomials transformed to the domain `(-Inf, Inf)`.
(when `L < 0`) using ``y = A + L * x / √(L^2 + x^2)``.
"""
struct ChebyshevInf{T <: Real} <: TransformedChebyshev
    "The center `A`."
    A::T
    "Scale factor `L > 0`."
    L::T
    function ChebyshevInf(A::T, L::T) where {T <: Real}
        @argcheck L > 0
        new{T}(A, L)
    end
end

ChebyshevInf(A::Real, L::Real) = ChebyshevInf(promote(A, L)...)

domain_extrema(TB::ChebyshevInf) = (-Inf, Inf)

function from_chebyshev(TB::ChebyshevInf, x)
    TB.A + TB.L * x / √(1 - abs2(x))
end

function chebyshev_inf_endpoints(y, x::T) where {T}
    if y == Inf
        one_like(T)
    elseif y == -Inf
        -one_like(T)
    else
        x
    end
end

function to_chebyshev(TB::ChebyshevInf, y, ::Val{0})
    @unpack A, L = TB
    z = y - A
    x = z / hypot(L, z)
    chebyshev_inf_endpoints(y, x)
end

function to_chebyshev(TB::ChebyshevInf, y, ::Val{1})
    @unpack A, L = TB
    abs2(L) / hypot(L, z)^3
end

function to_chebyshev(TB::ChebyshevInf, y, ::Val{0:1})
    @unpack A, L = TB
    z = y - A
    den = hypot(L, z)
    x = z / den
    x′ = abs2(L) / den^3
    chebyshev_inf_endpoints(y, x), x′
end

####
#### Chebyshev on a finite interval `[a,b]`
####

"""
$(TYPEDEF)

Chebyshev polynomials transformed to the domain `(a, b)`. using ``y = x ⋅ s + m``.

`m` and `s` are calculated and checked by the constructor; `a < b` is enforced.
"""
struct ChebyshevInterval{T <: Real} <: TransformedChebyshev
    "Start of interval `a`."
    a::T
    "End of interval `b`."
    b::T
    "Midpoint `m`."
    m::T
    "Scale `s`."
    s::T
    function ChebyshevInterval(a::T, b::T) where {T <: Real}
        @argcheck isfinite(a) && isfinite(b)
        s = (b - a) / 2
        m = (a + b) / 2
        @argcheck s > 0 "Need `a < b`."
        new{T}(a, b, m, s)
    end
end

ChebyshevInterval(A::Real, L::Real) = ChebyshevInterval(promote(A, L)...)

domain_extrema(TI::ChebyshevInterval) = (TI.a, TI.b)

function from_chebyshev(TI::ChebyshevInterval, x)
    @unpack m, s = TI
    x * s + m
end

function to_chebyshev(TI::ChebyshevInterval, y, ::Val{0})
    @unpack m, s = TI
    (y - m) / s
end

to_chebyshev(TI::ChebyshevInterval, y, ::Val{1}) = 1 / TI.s

function to_chebyshev(TI::ChebyshevInterval, y, ::Val{0:1})
    @unpack m, s = TI
    (y - m) / s, 1 / s
end

end # module


@testset "test Kaczmarz update" begin
    for T in [Float32,Float64,ComplexF32,ComplexF64]
        # set up
	M = 127
	N = 16

	A = rand(T,M,N)
	Aᵀ = transpose(A)
	b = zeros(T,M)
	β = rand(T)
	k = rand(1:N)
	# end set up

	RegularizedLeastSquares.kaczmarz_update!(Aᵀ,b,k,β)
	@test b ≈ β*conj(A[:,k])
    end

    for T in [Float32,Float64,ComplexF32,ComplexF64]
        # set up
        M = 127
        N = 16

        A = rand(T,N,M)
        b = zeros(T,M)
        β = rand(T)
        k = rand(1:N)
        # end set up

	RegularizedLeastSquares.kaczmarz_update!(A,b,k,β)
        @test b ≈ β*conj(A[k,:])
    end
end


# # Gross-Pitaevskii equation in one dimension
# In this example we will use DFTK to solve
# the Gross-Pitaevskii equation, and use this opportunity to explore a few internals.

# ## The model
# The [Gross-Pitaevskii equation](https://en.wikipedia.org/wiki/Gross%E2%80%93Pitaevskii_equation) (GPE)
# is a simple non-linear equation used to model bosonic systems
# in a mean-field approach. Denoting by ``ψ`` the effective one-particle bosonic
# wave function, the time-independent GPE reads in atomic units:
# ```math
#     H ψ = \left(-\frac12 Δ + V + 2 C |ψ|^2\right) ψ = μ ψ \qquad \|ψ\|_{L^2} = 1
# ```
# where ``C`` provides the strength of the boson-boson coupling.
# It's in particular a favorite model of applied mathematicians because it
# has a structure simpler than but similar to that of DFT, and displays
# interesting behavior (especially in higher dimensions with magnetic fields, see
# [Gross-Pitaevskii equation with magnetism](@ref)).

# We wish to model this equation in 1D using DFTK.
# First we set up the lattice. For a 1D case we supply two zero lattice vectors,
a = 10
lattice = a .* [[1 0 0.]; [0 0 0]; [0 0 0]];

# which is special cased in DFTK to support 1D models.
#
# For the potential term `V` we just pick a harmonic
# potential. The real-space grid is in ``[0,1)``
# in fractional coordinates( see
# [Lattices and lattice vectors](@ref conventions-lattice)),
# therefore:
pot(x) = (x - a/2)^2;

# We setup each energy term in sequence: kinetic, potential and nonlinear term.
# For the non-linearity we use the `PowerNonlinearity(C, α)` term of DFTK.
# This object introduces an energy term ``C ∫ ρ(r)^α dr``
# to the total energy functional, thus a potential term ``α C ρ^{α-1}``.
# In our case we thus need the parameters
C = 1.0
α = 2;

# ... and with this build the model
using DFTK
using LinearAlgebra

n_electrons = 1  # Increase this for fun
terms = [Kinetic(),
         ExternalFromReal(r -> pot(r[1])),
         PowerNonlinearity(C, α),
]
model = Model(lattice; n_electrons=n_electrons, terms=terms,
              spin_polarization=:spinless);  # use "spinless electrons"

# We discretize using a moderate Ecut (For 1D values up to `5000` are completely fine)
# and run a direct minimization algorithm:
Ecut = 500
basis = PlaneWaveBasis(model, Ecut)
scfres = direct_minimization(basis, tol=1e-8) # This is a constrained preconditioned LBFGS
scfres.energies

# ## Internals
# We use the opportunity to explore some of DFTK internals.
#
# Extract the converged density and the obtained wave function:
ρ = real(scfres.ρ.real)[:, 1, 1]  # converged density
ψ_fourier = scfres.ψ[1][:, 1];    # first kpoint, all G components, first eigenvector

# Transform the wave function to real space and fix the phase:
ψ = G_to_r(basis, basis.kpoints[1], ψ_fourier)[:, 1, 1]
ψ /= (ψ[div(end, 2)] / abs(ψ[div(end, 2)]));

# Check whether ``ψ`` is normalised:
x = a * vec(first.(DFTK.r_vectors(basis)))
N = length(x)
dx = a / N  # real-space grid spacing
@assert sum(abs2.(ψ)) * dx ≈ 1.0

# The density is simply built from ψ:
norm(scfres.ρ.real - abs2.(ψ))

# We summarize the ground state in a nice plot:
using Plots

p = plot(x, real.(ψ), label="real(ψ)")
plot!(p, x, imag.(ψ), label="imag(ψ)")
plot!(p, x, ρ, label="ρ")

# The `energy_hamiltonian` function can be used to get the energy and
# effective Hamiltonian (derivative of the energy with respect to the density matrix)
# of a particular state (ψ, occupation).
# The density ρ associated to this state is precomputed
# and passed to the routine as an optimization.
E, ham = energy_hamiltonian(basis, scfres.ψ, scfres.occupation; ρ=scfres.ρ)
@assert sum(values(E)) == sum(values(scfres.energies))

# Now the Hamiltonian contains all the blocks corresponding to kpoints. Here, we just have one kpoint:
H = ham.blocks[1];

# `H` can be used as a linear operator (efficiently using FFTs), or converted to a dense matrix:
ψ11 = scfres.ψ[1][:, 1] # first kpoint, first eigenvector
Hmat = Array(H) # This is now just a plain Julia matrix,
##                which we can compute and store in this simple 1D example
@assert norm(Hmat * ψ11 - H * ψ11) < 1e-10

# Let's check that ψ11 is indeed an eigenstate:
norm(H * ψ11 - dot(ψ11, H * ψ11) * ψ11)

# Build a finite-differences version of the GPE operator ``H``, as a sanity check:
A = Array(Tridiagonal(-ones(N - 1), 2ones(N), -ones(N - 1)))
A[1, end] = A[end, 1] = -1
K = A / dx^2 / 2
V = Diagonal(pot.(x) + C .* α .* (ρ.^(α-1)))
H_findiff = K + V;
maximum(abs.(H_findiff*ψ - (dot(ψ, H_findiff*ψ) / dot(ψ, ψ)) * ψ))


using MCIntegrals
const P = MCIntegrals
using Test
using StaticArrays
using LinearAlgebra
using Random
using Setfield
using Cuba: vegas
using HCubature

function isconsistent(truth, est; nstd=6, kw_approx...)
    val = est.value
    Δ = nstd * est.std
    if ≈(val, truth; kw_approx...)
        true
    else
        truth - Δ <= val <= truth + Δ
    end
end

ALGS = [Vegas(), MCVanilla()]

@testset "RNG Reproducibility" begin
    for alg in ALGS
        @set! alg.rng = MersenneTwister(1)
        res1 = ∫(cos, (0,1), alg)
        @set! alg.rng = MersenneTwister(1)
        res2 = ∫(cos, (0,1), alg)
        @test res1 === res2
        res3 = ∫(cos, (0,1), alg)
        @test !(res3 === res2)
    end
end

@testset "Domain" begin
    dom = Domain((1f0, 2f0))
    @test P.pointtype(typeof(dom)) === SVector{1, Float32}
    @test P.volume(dom) === 1f0
end

@testset "exotic types $(typeof(alg))" for alg in [
        MCVanilla(10),
        Vegas(10),
        CubaAlg(vegas),
       ]
    est = ∫(identity, (0f0, 1f0), alg)
    @test typeof(est.value) === Float32
    @test typeof(est.std) === Float32

    est = ∫(_ -> true, (0f0, 1f0), alg)
    @test typeof(est.value) === Float64
    @test typeof(est.std) === Float64

    est = ∫(identity, (0, 1), alg)
    @test typeof(est.value) === Float64
    @test typeof(est.std) === Float64

    est = ∫(identity, (big"0", big"1"), alg)
    @test typeof(est.value) === BigFloat
    @test typeof(est.std) === BigFloat

    v = @SVector[1.,2.]
    est = ∫(_ -> v, (0,1), alg)
    @test typeof(est.value) === typeof(v)
    @test typeof(est.std)   === typeof(est.value)
end

@testset "std bernoulli" begin
    p = 0.1 + 0.8*rand()
    f = x -> 0 <= x <= p

    neval = 1000
    true_value = p
    true_std = sqrt(p*(1-p)/neval)

    est = ∫(f, (0,1), MCVanilla(neval))
    @test est.std ≈ true_std rtol=0.2
    @test isconsistent(true_value, est)

    est = ∫(f, (0,1), Vegas(neval))
    @test est.std < 0.2*true_std
    @test isconsistent(true_value, est)
end

@testset "constant $(typeof(alg))" for alg in [
    Vegas(10^1),
    MCVanilla(10^1),
    CubaAlg(vegas),
    HCubatureAlg(),
    ]
    for dim in 1:4
        for _ in 1:10
            lower = @SVector randn(dim)
            upper = lower + @SVector rand(dim)
            val = randn()
            f = _ -> val
            dom = Domain(lower, upper)
            est = ∫(f, dom, alg)
            vol = prod(upper .- lower)
            truth = val * vol
            @test isconsistent(truth, est)
            @test est.std < 1e-3
        end
    end
end

@testset "∫x^2" begin
    est_vegas = ∫(x->x^2, (0,1), Vegas(10000))
    @test isconsistent(1/3, est_vegas)
    @test est_vegas.std < 1e-3

    est_vanilla = ∫(x->x^2, (0,1), MCVanilla(1000))
    @test isconsistent(1/3, est_vanilla)
    @test est_vanilla.std < 1e-2
end

@testset "∫(f, (a,b), $(typeof(alg)))" for alg in [
        MCVanilla(10^4),
        Vegas(10^4),
       ]

    funs = [
        (f = x -> x^2, F = x -> x^3/3),
        (f = cos, F = sin),
        let
            a = randn()
            (f = _ -> a, F = x -> a*x)
        end
    ]

    for (f,F) in funs
        for _ in 1:10
            a = 10randn()
            b = a + 10rand()
            est = ∫(f, (a,b), alg)
            truth = F(b) - F(a)
            @test isconsistent(truth, est)
        end
    end
end

@testset "Ball $(typeof(alg))" for alg in [
    MCVanilla(10^4),
    Vegas(10^4, rng=MersenneTwister(1))]

    f(x) = norm(x) < 1 ? 1. : 0.
    est = ∫(f, (-2,2), alg)
    @test isconsistent(2,est)

    est = ∫(f, ((-1,1),(-1,1)), alg)
    @test isconsistent(π, est)

    est = ∫(f, ((-1,1),(-1,1),(-1,1)), alg)
    @test isconsistent(4π/3, est)
end

@testset "Fubini $(typeof(alg))" for alg in [
    MCVanilla(10^4),
    Vegas(10^4)]
    for _ in 1:10
        a1,a2 = randn(2)
        b1 = a1 + 10rand()
        b2 = a2 + 10rand()
        dom1 = Domain((a1, b1))
        dom2 = Domain((a2, b2))
        dom = Domain(((a1, b1), (a2, b2)))
        f1 = x -> cos(x[1])
        F1 = x -> sin(x[1])
        f2 = x -> x[1]^2
        F2 = x -> x[1]^3/3
        f  = v -> f1(v[1]) * f2(v[2])
        est1 = ∫(f1, dom1, alg)
        est2 = ∫(f2, dom2, alg)
        est  = ∫(f , dom , alg)
        @test isconsistent(est1.value*est2.value, est)
    end
end

@testset "Simple Vegas Example" begin
    a = -0.237267860990952
    b = -0.19099487884978464
    val = 0.665843778891144
    truth = (b - a) * val
    f = _ -> val
    Ω = Domain((a,b))

    alg = Vegas(5)
    est = ∫(f, Ω, alg)
    @test est.value ≈ truth
    @test 0 <= est.std <= sqrt(eps(Float64))

    iq = P.initvr(f, Ω, alg)
    est = ∫(f, iq, alg)
    @test est.value ≈ truth
    @test 0 <= est.std <= sqrt(eps(Float64))

    iq2 = P.tune(f, Ω, alg)
    est = ∫(f, iq2, alg)
    @test est.value ≈ truth
    @test 0 <= est.std <= sqrt(eps(Float64))
    walls = iq2.boundaries[1]
    @test walls ≈ range(a,stop=b, length=length(walls))
end


"""
    maximum_weight_maximal_matching{T<:Real}(g, w::Dict{Edge,T})
    maximum_weight_maximal_matching{T<:Real}(g, w::Dict{Edge,T}, cutoff)

Given a bipartite graph `g` and an edgemap `w` containing weights associated to edges,
returns a matching with the maximum total weight among the ones containing the
greatest number of edges.

Edges in `g` not present in `w` will not be considered for the matching.

The algorithm relies on a linear relaxation on of the matching problem, which is
guaranteed to have integer solution on bipartite graps.

Eventually a `cutoff` argument can be given, to reduce computational times
excluding edges with weights lower than the cutoff.

The package JuMP.jl and one of its supported solvers is required.

The returned object is of type `MatchingResult`.
"""
function maximum_weight_maximal_matching end

function maximum_weight_maximal_matching(g::Graph, solver::AbstractMathProgSolver, w::AbstractMatrix{T}, cutoff::R) where {T<:Real, R<:Real}
    return maximum_weight_maximal_matching(g, solver, cutoff_weights(w, cutoff))
end

function maximum_weight_maximal_matching(g::Graph, solver::AbstractMathProgSolver, w::AbstractMatrix{T}) where {T<:Real}
# TODO support for graphs with zero degree nodes
# TODO apply separately on each connected component
    bpmap = bipartite_map(g)
    length(bpmap) != nv(g) && error("Graph is not bipartite")
    v1 = findin(bpmap, 1)
    v2 = findin(bpmap, 2)
    if length(v1) > length(v2)
        v1, v2 = v2, v1
    end

    nedg = 0
    edgemap = Dict{Edge,Int}()

    for j in 1:size(w,2)
        for i in 1:size(w,1)
            if w[i,j] > 0.0
                nedg += 1
                edgemap[Edge(i,j)] = nedg
                edgemap[Edge(j,i)] = nedg
            end
        end
    end

    model = Model(solver=solver)
    @variable(model, x[1:length(w)] >= 0)

    for i in v1
        idx = Vector{Int}()
        for j in neighbors(g, i)
            if haskey(edgemap, Edge(i,j))
                push!(idx, edgemap[Edge(i,j)])
            end
        end
        if length(idx) > 0
            @constraint(model, sum(x[id] for id = idx) == 1)
        end
    end

    for j in v2
        idx = Vector{Int}()
        for i in neighbors(g, j)
            if haskey(edgemap, Edge(i,j))
                push!(idx, edgemap[Edge(i,j)])
            end
        end

        if length(idx) > 0
            @constraint(model, sum(x[id] for id = idx) <= 1)
        end
    end

    @objective(model, Max, sum(w[src(e),dst(e)] * x[edgemap[e]] for e in keys(edgemap)))

    status = solve(model)
    status != :Optimal && error("JuMP solver failed to find optimal solution.")
    sol = getvalue(x)

    all(Bool[s == 1 || s == 0 for s in sol]) || error("Found non-integer solution.")

    cost = getobjectivevalue(model)

    mate = fill(-1, nv(g))
    for e in edges(g)
        if w[src(e),dst(e)] > zero(T)
            inmatch = convert(Bool, sol[edgemap[e]])
            if inmatch
                mate[src(e)] = dst(e)
                mate[dst(e)] = src(e)
            end
        end
    end

    return MatchingResult(cost, mate)
end

"""
    cutoff_weights copies the weight matrix with all elements below cutoff set to 0
"""
function cutoff_weights(w::AbstractMatrix{T}, cutoff::R) where {T<:Real, R<:Real}
    wnew = copy(w)
    for j in 1:size(w,2)
        for i in 1:size(w,1)
            if wnew[i,j] < cutoff
                wnew[i,j] = zero(T)
            end
        end
    end
    wnew
end


module MultipleScatteringLearnMoments

using MultipleScattering
using LaTeXStrings
using JLD
using StatsBase
using GLMNet
using Plots

# The types exported
export ML_model, OptionsML, FeatureMap

# exporting global variables
export fmmoments, fmmean, fmofm_full

# The functions exported
export setup_ml, fit_L2, fit_L1, test_linear, get_crossvalid_parameters, predict_linear
export learning_saturation_curve_grid_volfrac_rad_crossvalidation, cross_valid_inner, load_moments

type ML_model
    fiterror::Float64
    parameters::Array{Float64}
    yscale::Float64
    ysmean::Float64
    ys::Array{Float64}
    Xmean::Array{Float64}
    Xstd::Array{Float64}
    name::AbstractString
    nfeatures::Int64
    numlabels::Int64
    X::Array{Float64}
    kernelname::AbstractString
    kernelparam::Float64
    kernelapply::Function
end

type OptionsML
    aux::Array{Int64} # Auxiliary array, Used for selecting the moments in moments_feature_map.jl
    pcts::Array{Float64}  # The percentages used in the quantiles regression
    plotfigures::Bool
end

#The apply function needs to follow a very particular pattern. See stack_rows_td_responses for an example
type FeatureMap
    apply::Function
    get_numfeatures::Function
    name::AbstractString
end

#calculates and save the best lambdas for a given feature map using cross validation over the training set
#include("cross_valid_lambdas.jl")
include("cross_valid_inner.jl")
# Receives a training data as an array of tds and returns a linear model
include("setup_ml.jl")
#include("train_linear.jl")
include("fit_L2.jl")
include("fit_L1.jl")
# Receives a response and a linear model (defined by ML_model) and returns a predicted label
include("predict_linear.jl")
# Receives a test response data set and a linear model (defined by ML_model) and returns the average test error
include("test_linear.jl")
# Plots a heatmap of the testover over each labelled pair.
include("testerror_heatmap.jl")
# The feature map that only uses the mean response curve
include("mean_feature_map.jl")
# The feature map that uses centered moments of response simulation
include("moments_feature_map.jl");
# The feature map that uses all moments or a given selection of centered moments of response simulation
include("mofm_full_feature_map.jl")
# Definitions and functions for defining different Kernenls
include("kernels.jl");
# Inclues the data transformation functions, such as centering and scaling
include("data_transformations.jl");
# Misc
include("get_crossvalid_parameters.jl");
# Calculate the curve of the R^2 error on the test data as we progressively use more training data
# in old folder: include("frequency_saturation.jl")
# in old folder: include("learning_saturation_curve_grid_volfrac_rad.jl")
include("learning_saturation_curve_grid_volfrac_rad_crossvalidation.jl")
# in old folder:include("feature_selection_L1.jl")
include("load_moments.jl")

end # module


# # Chapter 1

# ## Using Types
using BenchmarkTools

# Declare type of function argument
iam(x::Integer) = "an integer"
iam(x::String) = "a string"

function addme(a, b)
  #Declare type of local variable x
  x::Int64 = 2
  #Type of variable y will be inferred
  y = (a+b) / x
  return y
end

iam(1)

iam("1")

iam(1.5)

# ## Multiple Dispatch
sumsqr(x, y) = x^2 + y^2

sumsqr(1, 2)

sumsqr(1.5, 2.5)

sumsqr(1 + 2im , 2 + 3im)

sumsqr(2 + 2im, 2.5)

#Composite Types

struct Pixel
    x::Int64
    y::Int64
    color::Int64
end

p = Pixel(5,5, 100)

p.x = 10;

p.x

# immutable types

mutable struct MPixel
    x::Int64
    y::Int64
    color::Int64
end

p = MPixel(5,5, 100)

p.x=10;

p.x

# TYpe Parameters

struct PPixel{T}
    x::Int64
    y::Int64
    color::T
end

#Type Inference

[x for x=1:5]

# Type Stability

function pos(x)
   if x < 0
      return 0
   else
      return x
   end
end

pos(-1)

pos(-2.5)

pos(2.5)

typeof(pos(2.5))

typeof(pos(-2.5))

function pos_fixed(x)
    if x < 0
        return zero(x)
    else
        return x
    end
end

pos_fixed(-2.4)

pos_fixed(-2)

typeof(pos_fixed(-2.4))

typeof(pos_fixed(-2))

@btime pos(2.5)
@btime pos_fixed(2.5)

@code_warntype pos(2.5)
@code_warntype pos_fixed(2.5)
@code_llvm pos(2.5)
@code_llvm pos_fixed(2.5)

@code_native pos(2.5)
@code_native pos_fixed(2.5)

# Loop variables

function sumsqrtn(n)
    r = 0
    for i = 1:n
        r = r + sqrt(i)
    end
    return r
end

@code_warntype sumsqrtn(5)

function sumsqrtn_fixed(n)
     r = 0.0
     for i = 1:n
         r = r + sqrt(i)
     end
     return r
end

@code_warntype sumsqrtn_fixed(5)

@btime sumsqrtn(1000_000)

@btime sumsqrtn_fixed(1000_000)

#Kernel Methods

function string_zeros(s::AbstractString)
    n=1000_000
    x = s=="Int64" ?
        Vector{Int64}(undef,n) :
        Vector{Float64}(undef, n)
    for i in 1:length(x)
        x[i] = 0
    end
    return x
end

@btime string_zeros("Int64");

function string_zeros_stable(s::AbstractString)
    n = 1000_000
    x = s=="Int64" ?
        Vector{Int64}(undef, n) :
        Vector{Float64}(undef, n)
    return fill_zeros(x)
end

function fill_zeros(x)
    for i in 1:length(x)
        x[i] = 0
    end
    return x
end

@btime string_zeros_stable("Int64");

#Types in storage
## Arrays

a = Int64[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
b = Number[1,2,3,4,5,6,7,8,9,10]

function arr_sumsqr(x::Array{T}) where T <: Number
    r = zero(T)
    for i = 1:length(x)
        r = r + x[i] ^ 2
    end
    return r
end

 @btime arr_sumsqr(a)
 @btime arr_sumsqr(b)

## Composite Types
struct Point
    x
    y
end

struct ConcretePoint
    x::Float64
    y::Float64
end

function sumsqr_points(a)
    s=0.0
    for x in a
        s = s + x.x^2 + x.y^2
    end
    return s
end

p_array = [Point(rand(), rand()) for i in 1:1000_000];
cp_array = [ConcretePoint(rand(), rand()) for i in 1:1000_000];

@btime sumsqr_points(p_array)
@btime sumsqr_points(cp_array)

## Parametric Composite Types

struct PointWithAbstract
    x::AbstractFloat
    y::AbstractFloat
end

struct ParametricPoint{T <: AbstractFloat}
    x::T
    y::T
end

pp_array = [ParametricPoint(rand(), rand()) for i in 1:1000_000];

@btime sumsqr_points(pp_array)


using Base.Test
using PValueAdjust

newPvalues = padjust([0.05, 0.03, 0.01, 0.5], Hochberg)
@test_approx_eq newPvalues [0.1, 0.09, 0.04, 0.5]

@test_approx_eq padjust([1, 0.5, 0.1, 0.001, 0.0001, 0.002], Hochberg) [1e+00, 1e+00, 3e-01, 5e-03, 6e-04, 8e-03]
@test_approx_eq padjust([0.05, 0.05, 0.05], Hochberg) [0.05, 0.05, 0.05]

@test all(padjust([1,1,1], Hochberg) .<= 1)

@test_throws DomainError padjust([-1], Hochberg)
@test_throws DomainError padjust([2], Hochberg)

@test padjust([0.5], Hochberg) == [0.5]


#
# InterpolationKernels.jl --
#
# Kernel functions used for linear filtering, windowing or linear
# interpolation.
#
#------------------------------------------------------------------------------
#
# This file is part of the InterpolationKernels package licensed under the MIT
# "Expat" License.
#
# Copyright (C) 2016-2021, Éric Thiébaut.
#

module InterpolationKernels

export
    BSpline,
    BSplinePrime,
    CardinalCubicSpline,
    CardinalCubicSplinePrime,
    CatmullRomSpline,
    CatmullRomSplinePrime,
    CubicSpline,
    CubicSplinePrime,
    Kernel,
    LanczosKernel,
    LanczosKernelPrime,
    MitchellNetravaliSpline,
    MitchellNetravaliSplinePrime,
    iscardinal,
    isnormalized

import Base: convert, adjoint, values

# List and union of floating-point types which are specially handled.
const FLOATS = (:BigFloat, :Float16, :Float32, :Float64)
const Floats = @eval $(Expr(:curly, :Union, FLOATS...))

#------------------------------------------------------------------------------
# SUPPORTS

abstract type Bound end
struct Open <: Bound end
struct Closed <: Bound end

"""

`InterpolationKernels.Support{T,S,L,R}` is the abstract type for the support of
an interpolation kernel parameterized by the floating-point type `T` used for
computations, the integer size `S` of the support and the types `L` and `R` of
the left and right bounds which can be `InterpolationKernels.Open` or
`InterpolationKernels.Closed`.

"""
abstract type Support{T<:AbstractFloat,S,L<:Bound,R<:Bound} end

Base.length(sup::Support) = length(typeof(sup))
Base.length(::Type{<:Support{T,S}}) where {T,S} = S

Base.eltype(sup::Support) = eltype(typeof(sup))
Base.eltype(::Type{<:Support{T,S}}) where {T,S} = T

"""
    InterpolationKernels.SymmetricSupport{T,S,L,R}() -> sup

yields an instance of a symmetric support parameterized by the floating-point
type `T`, the integer size `S` of the support and the types `L` and `R` of the
left and right bounds which can be `InterpolationKernels.Open` or
`InterpolationKernels.Closed`.

Depending on `L` and `R`, the support is:

    (L,R) = (Open,Open) -------> sup = (-S/2,S/2)
    (L,R) = (Closed,Open) -----> sup = [-S/2,S/2)
    (L,R) = (Open,Closed) -----> sup = (-S/2,S/2]
    (L,R) = (Closed,Closed) ---> sup = [-S/2,S/2]

"""
struct SymmetricSupport{T<:AbstractFloat,S,L,R} <: Support{T,S,L,R} end

"""
    InterpolationKernels.LeftAnchoredSupport{T,S,L,R}(a)

yields an instance of a support with lower bound `a` and parameterized by the
floating-point type `T`, the integer size `S` of the support and the types `L`
and `R` of the left and right bounds which can be `InterpolationKernels.Open`
or `InterpolationKernels.Closed`.

Depending on `L` and `R`, the support is:

    (L,R) = (Open,Open) -------> sup = (a,a+S)
    (L,R) = (Closed,Open) -----> sup = [a,a+S)
    (L,R) = (Open,Closed) -----> sup = (a,a+S]
    (L,R) = (Closed,Closed) ---> sup = [a,a+S]

"""
struct LeftAnchoredSupport{T,S,L,R} <: Support{T,S,L,R}
    a::T
end

"""
    InterpolationKernels.RightAnchoredSupport{T,S,L,R}(b)

yields an instance of a support with upper bound `b` and parameterized by the
floating-point type `T`, the integer size `S` of the support and the types `L`
and `R` of the left and right bounds which can be `InterpolationKernels.Open`
or `InterpolationKernels.Closed`.

Depending on `L` and `R`, the support is:

    (L,R) = (Open,Open) -------> sup = (b-S,b)
    (L,R) = (Closed,Open) -----> sup = [b-S,b)
    (L,R) = (Open,Closed) -----> sup = (b-S,b]
    (L,R) = (Closed,Closed) ---> sup = [b-S,b]

"""
struct RightAnchoredSupport{T,S,L,R} <: Support{T,S,L,R}
    b::T
end

"""
    InterpolationKernels.supremum(sup) -> b

yields the least upper bound `b` of the kernel support `sup`.

"""
supremum(::SymmetricSupport{T,S}) where {T,S} = T(S)/2
supremum(sup::LeftAnchoredSupport{T,S}) where {T,S} = infimum(sup) + T(S)
supremum(sup::RightAnchoredSupport) = sup.b

"""
    InterpolationKernels.infimum(sup) -> a

yields the greatest lower bound `a` of the kernel support `sup`.

"""
infimum(::SymmetricSupport{T,S}) where {T,S} = T(-S)/2
infimum(sup::LeftAnchoredSupport) = sup.a
infimum(sup::RightAnchoredSupport{T,S}) where {T,S} = supremum(sup) - T(S)

#------------------------------------------------------------------------------
# INTERPOLATION KERNELS

"""
# Interpolation Kernels

An interpolation kernel `Kernel{T,S}` is parameterized by the floating-point
type `T` of its coefficients and by the integer size `S` of its support.  For
efficiency reasons, only kernels with (small) finite size supports are
implemented in `InterpolationKernels`.

A kernel `ker` is a callable object which may be used as a function with a real
argument:

    ker(x::Real)

yields kernel value at offset `x`.  Whatever the type of `x`, `ker(x)` is
always of type `T = eltype(ker)` the floating-point type associated with `ker`.
All kernel supports are symmetric; that is `ker(x)` is zero if `abs(x) > S/2`
with `S = length(ker)` the size of the kernel support.

## Kernel floating-point type conversion

Called as a function with a real argument, a given kernel returns a value of
its associated floating-point type.  This has been chosen to have fast
interpolation methods.  Converting a kernel `ker` to use floating-point type
`T` is simply done by one of:

    T(ker)
    Kernel{T}(ker)
    convert(Kernel{T}, ker)

Beware that changing the floating-point type may lead to a loss of precision if
the kernel has numerical parameters.

## Common methods

A few common methods are specialized for any interpolation kernel `ker`:

    eltype(ker) -> T

yields the floating-point type for calculations,

    length(ker) -> S

yield the size the support of `ker` which is also the number of neighbors
involved in an interpolation by this kernel,

    values(ker)

yields a tuple of the parameters of `ker` such that an identical instance can
be built by:

    typeof(ker)(values(ker)...)

finally:

    compute_offset_and_weights(ker, x) -> off, (w1, w2, ..., wS)

yields the offset `off` and an `S`-tuple of interpolation weights to
interpolate an array at coordinate `x` (in fractional index units).

"""
abstract type Kernel{T<:AbstractFloat,S} <: Function end

Base.eltype(ker::Kernel) = eltype(typeof(ker))
Base.eltype(::Type{<:Kernel{T,S}}) where {T,S} = T

Base.length(ker::Kernel) = length(typeof(ker))
Base.length(::Type{<:Kernel{T,S}}) where {T,S} = S

"""
    isnormalized(ker)

yields whether the kernel `ker` has the partition of unity property.  That is,
the sum of the values computed by the kernel `ker` on a unit spaced grid is
equal to one.

""" isnormalized

"""
    iscardinal(ker)

yields whether the kernel `ker` is zero for any non-zero integer argument.
Cardinal kernels are directly suitable for interpolation.

""" iscardinal

"""
    InterpolationKernels.compute_offset_and_weights(ker, x) -> off, wgt

yields the index offset `off` and the weights `wgt` to interpolate with kernel
`ker` at position `x` in fractional index units.  The offset is a scalar and
the weights are an `n`-tuple with `n = length(ker)` the size of the support of
the kernel, all returned values have the same floating point type `eltype(ker)`
as the kernel.

Not taking into account boundary conditions, interpolating a vector `A` at
position `x` would then write:

    off, wgt = InterpolationKernels.compute_offset_and_weights(ker, x)
    k = Int(off)
    result = wgt[1]*A[k+1] + ... + wgt[n]*A[k+n]

Note that 1-based indexing is assumed by `compute_offset_and_weights` to
interpret the position `x` and compute the offset `off`.  If this is not the
case, the code should be:

    j1 = first(axes(A,1)) # first index in A
    off, wgt = InterpolationKernels.compute_offset_and_weights(ker, x - (j1 - 1))
    k = Int(off) + (j1 - 1)
    result = wgt[1]*A[k+1] + ... + wgt[n]*A[k+n]

where expression `x - (j1 - 1)` is assuming that the position `x` is in
fractional index for `A`, that is `x = j1` at the first entry of `A`.

!!! note
    For fast computations, this method should be specialized for specific
    kernel types.  For kernels with symmetric support, the method
    [`InterpolationKernels.compute_weights`](@ref) is called by
    `compute_offset_and_weights` to calculate the interpolation weights; for
    such kernels it is sufficient to specialize `compute_weights` instead of
    `compute_offset_and_weights`.

""" compute_offset_and_weights

@inline compute_offset_and_weights(ker::Kernel{T}, x::T) where {T} =
    compute_offset_and_weights(support(ker), ker, x)

# The following version is specialized for symmetric supports and rely on an
# optimized version of `compute_weights`.
@generated function compute_offset_and_weights(sup::SymmetricSupport{T,S},
                                               ker::Kernel{T,S},
                                               x::T) where {T,S}
    if isodd(S)
        quote
            $(Expr(:meta, :inline))
            round_x = round(x)
            wgts = compute_weights(ker, x - round_x)
            off = round_x - $((S + 1) >> 1)
            return off, wgts
        end
    else
        quote
            $(Expr(:meta, :inline))
            floor_x = floor(x)
            wgts = compute_weights(ker, x - floor_x)
            off = floor_x - $(S >> 1)
            return off, wgts
        end
    end
end

# This version is to call the generic version by default.
@inline function compute_offset_and_weights(sup::Support{T,S},
                                            ker::Kernel{T}, x::T) where {T,S}
    generic_compute_offset_and_weights(sup, ker, x)
end

# The generic version is only called if no optimized version exists.  It can
# also be used to check code implementing an optimized version.
@inline generic_compute_offset_and_weights(ker::Kernel{T}, x::T) where {T} =
    generic_compute_offset_and_weights(support(ker), ker, x)

@generated function generic_compute_offset_and_weights(sup::Support{T,S},
                                                       ker::Kernel{T,S},
                                                       x::T) where {T,S}
    wgt = ntuple(j -> Symbol("w_", j), Val(S))
    exprs = [:($(wgt[j]) = ker(u - $j)) for j in 1:S]
    quote
        $(Expr(:meta, :inline))
        off = offset(sup, x)
        u = x - off
        $(exprs...)
        return off, $(Expr(:tuple, wgt...))
    end
end

"""
    InterpolationKernels.offset(sup, x) -> off

yields the coordinate offset for computing the interpolation weights
at coordinate `x` for a kernel whose support is `sup`:

    off = floor(x - b)       if `sup` is right-open
          ceil(x - b) - 1    if `sup` is left-open

with `b = supremum(sup)` the upper bound of the support.

""" offset

offset(sup::Support{T,S,<:Bound,Open}, x::T) where {T,S} =
    floor(x - supremum(sup))

offset(sup::Support{T,S,Open,Closed}, x::T) where {T,S} =
    ceil(x - (supremum(sup) - 1))

"""
    InterpolationKernels.compute_weights(ker, t) -> wgt

computes the interpolation weights returned by
[`InterpolationKernels.compute_offset_and_weights`](@ref) for kernel `ker` with
symmetric support.  Assuming interpolation is performed at position `x`,
argument `t` is given by:

     t = x - floor(x)     if length(ker) is even, hence t ∈ [0,1)
     t = x - round(x)     if length(ker) is odd,  hence t ∈ [-1/2,+1/2]

The returned weights are then:

     wgt = ntuple(i -> ker(t + k - i), length(ker))

where `k = (length(ker) + 1) >> 1` (i.e., integer division of `length(ker)+1`
by 2).  These conventions have been adopted so that, by specializing the
`compute_weights` method, computing the `length(ker)` weights at the same time
may be done in much fewer operations than calling `ker` as a function for each
weight.

""" compute_weights

# Call generic version by default.  The generic version has a different name so
# that it can be used to check optimized versions.  Must be in-lined.
@inline compute_weights(ker::Kernel{T}, t::T) where {T} =
    generic_compute_weights(ker, t)

@generated function generic_compute_weights(ker::Kernel{T,S}, t::T) where {T,S}
    k = ((S + 1) >> 1)
    exprs = [(j < 0 ? :(ker(t + $(-j))) :
              j > 0 ? :(ker(t - $j)) : :(ker(t))) for j in 1-k:S-k]
    return quote
        $(Expr(:meta, :inline))
        return $(Expr(:tuple, exprs...))
    end
end

"""
    values(ker::InterpolationKernels.Kernel)

yields a tuple of the parameters of the interpolation kernel `ker` such that an
identical instance can be built by:

    typeof(ker)(values(ker)...)

"""
values(::Kernel) = ()

"""
    InterpolationKernels.support(ker) -> sup

yields the support of the interpolation kernel `ker`.

""" support

#------------------------------------------------------------------------------
# B-SPLINES

"""
    BSpline{S,T}()

yields a B-spline (short for *basis spline*) of order `S` that is a piecewise
polynomial function of degree `S - 1` on a support of length `S`.  The
parameter `T` is the floating-point type for computations, `T = Float64` is
assuled if this parameter is not specified.

Fr now, not all B-spline are implemented in `InterpolationKernels`, `S` must
be: `1` (for a **rectangular** B-spline), `2` (for a **linear** B-spline), `3`
(for a **quadratic** B-spline), or `4` (for a **cubic** B-spline).

If `ker` is a B-spline, then `ker'` is its derivative which can also be
directly constructed by calling [`BSplinePrime`](@ref).

!!! warning
    The derivative of B-splines of order `S ≤ 2` is not defined everywhere.  It
    is allowed to take their derivative but it (arbitrarily) yields zero where
    not defined.  Returning `NaN` would have been more correct but it has been
    considered that it would do more harm than good in practice.

""" BSpline

struct BSpline{S,T} <: Kernel{T,S} end

"""
    BSplinePrime{S,T}()

yields the derivative of a B-spline of order `S` for floating-point `T`.

See the caveats in [`BSpline`](@ref) about taking the derivative of B-splines of
order `S ≤ 2`.

""" BSplinePrime

struct BSplinePrime{S,T} <: Kernel{T,S} end

# Outer Constructors.
BSpline{S}() where {S} = BSpline{S,Float64}()
BSplinePrime{S}() where {S} = BSplinePrime{S,Float64}()

# Support is right-open for 1st order splines and open for all others.
support(::BSpline{1,T}) where {T} = SymmetricSupport{T,1,Closed,Open}()
support(::BSplinePrime{1,T}) where {T} = SymmetricSupport{T,1,Closed,Open}()
support(::BSpline{S,T}) where {S,T} = SymmetricSupport{T,S,Open,Open}()
support(::BSplinePrime{S,T}) where {S,T} = SymmetricSupport{T,S,Open,Open}()

# Only the 2 first B-splines are interpolating.
iscardinal(::Union{K,Type{K}}) where {K<:BSpline{1}} = true
iscardinal(::Union{K,Type{K}}) where {K<:BSpline{2}} = true
iscardinal(::Union{K,Type{K}}) where {K<:BSpline} = false
iscardinal(::Union{K,Type{K}}) where {K<:BSplinePrime} = false

# All B-splines are normalized, not their derivative.
isnormalized(::Union{K,Type{K}}) where {K<:BSpline} = true
isnormalized(::Union{K,Type{K}}) where {K<:BSplinePrime} = false

#
# Rectangular B-spline
# --------------------
#
@inline (::BSpline{1,T})(x::T) where {T} =
    ifelse((x < frac(T,-1,2))|(x ≥ frac(T,1,2)), zero(T), one(T))
compute_offset_and_weights(::BSpline{1,T}, x::T) where {T} =
    (round(x) - 1, (one(T),))
compute_weights(::BSpline{1,T}, t::T) where {T} = (one(T),)

(::BSplinePrime{1,T})(x::T) where {T} = zero(T)
compute_offset_and_weights(::BSplinePrime{1,T}, x::T) where {T} =
    (round(x) - 1, (zero(T),))
compute_weights(::BSplinePrime{1,T}, t::T) where {T} = (zero(T),)

#
# Linear B-splines
# ----------------
#
@inline function (::BSpline{2,T})(x::T) where {T}
    abs_x = abs(x)
    return ifelse(abs_x < 1, 1 - abs_x, zero(T))
end

compute_weights(ker::BSpline{2,T}, t::T) where {T} = (1 - t, t)

# The linear B-spline is not C¹ continuous, its left and right derivatives do
# not match at x ∈ (-1,0,1).  Setting h'(x) = NaN for x ∈ (-1,0,1) is correct
# but not useful in practice.  Taking the mean of the left and right
# derivatives yiedls h'(±1) = ∓1/2 and h'(0) = 0 but, then the support would no
# longer be semi-open interval of size 2.  For now, h'(x) = 0 for x ∈ (-1,0,1).
@inline function (::BSplinePrime{2,T})(x::T) where {T}
    if (-1 < x)&(x < 0)
        return one(T)
    elseif (0 < x)&(x < 1)
        return -one(T)
    else
        return zero(T)
    end
end

compute_weights(ker::BSplinePrime{2,T}, t::T) where {T} =
    ifelse(t > 0, (-one(T), one(T)), (zero(T), zero(T)))

#
# Quadratic B-spline
# ------------------
#
@inline function (::BSpline{3,T})(x::T) where {T}
    abs_x = abs(x)
    if abs_x ≥ frac(T,3,2)
        return zero(T)
    elseif abs_x ≤ frac(T,1,2)
        return frac(T,3,4) - abs_x*abs_x
    else
        return square(abs_x - frac(T,3,2))*frac(T,1,2)
    end
end

@inline function compute_weights(ker::BSpline{3,T}, t::T) where {T}
    #
    # Given `t = x - round(x)`, the weights are:
    #
    #     w1 = (1/8)*(1 - 2*t)^2 = (1/2)*(1/sqrt(2) - t)^2
    #     w2 = (3/4) - t^2
    #     w3 = (1/8)*(1 + 2*t)^2 = (1/2)*(1/sqrt(2) + t)^2
    #
    # which can be computed in 9 operations using the following factorized
    # expressions:
    #
    #     w1 = (1/2)*(1/sqrt(2) - t)^2
    #     w2 = (3/4) - t^2
    #     w3 = (1/2)*(1/sqrt(2) + t)^2
    #
    # or in 6 operations:
    #
    ht = t/2
    w = frac(T,1,8) + ht*t
    w1 = w - ht
    w2 = frac(T,3,4) - t*t
    w3 = w + ht
    return (w1, w2, w3)
end

@inline function (::BSplinePrime{3,T})(x::T) where {T}
    if (x ≤ frac(T,-3,2))|(x ≥ frac(T,3,2))
        return zero(T)
    elseif x < frac(T,-1,2)
        return x + frac(T,3,2)
    elseif x ≤ frac(T,1,2)
        return -2x
    else
        return x - frac(T,3,2)
    end
end

@inline function compute_weights(ker::BSplinePrime{3,T}, t::T) where {T}
    # 3 operations
    h = frac(T,1,2)
    return (t - h, -2t, t + h)
end

#
# Cubic B-spline
# --------------
#
@inline function (::BSpline{4,T})(x::T) where {T}
    abs_x = abs(x)
    if abs_x ≥ 2
        return zero(T)
    elseif abs_x ≥ 1
        return cube(2 - abs_x)*frac(T,1,6)
    else
        return (frac(T,1,2)*abs_x - 1)*abs_x*abs_x + frac(T,2,3)
    end
end

@inline function compute_weights(ker::BSpline{4,T}, t::T) where {T}
    #
    # With `t = x - floor(x)`, the weights are given by:
    #
    #     w1 = 1/6 - t/2 + t^2/2 - t^3/6
    #        = 1/6 + (t^2 - t)/2 - t^3/6
    #        = (1 - t)^3/6
    #     w2 = 2/3 - t^2 + t^3/2
    #        = 2/3 + (t/2 - 1)*t^2
    #     w3 = 1/6 + t/2 + t^2/2 - t^3/2
    #        = 1/6 + (t + t^2 - t^3)/2
    #        = 1/6 - ((t - 1)*t - 1)*t/2
    #        = 4/6 - (1 - t)^2*(t + 1)/2
    #     w4 = t^3/6
    #
    # Horner's scheme takes 6 operations per cubic polynomial, 24 operations
    # for the 4 weights.  Precomputing the powers of t, t^2 and t^3, takes 2
    # operations, then 6 operations per cubic polynomial are needed.
    #
    # Using factorizations, I manage to only use 15 operations:
    #
    h = frac(T,1,2)
    p = frac(T,2,3)
    q = frac(T,1,6)
    u = 1 - t
    u2 = u*u
    t2 = t*t
    w1 = q*u2*u
    w2 = p + (h*t - 1)*t2
    w3 = p - (h*u2)*(t + 1)
    w4 = q*t2*t
    return (w1, w2, w3, w4)
end

@inline function (::BSplinePrime{4,T})(x::T) where {T}
    if (x ≤ -2)|(x ≥ 2)
        return zero(T)
    elseif x < -1
        return frac(T,1,2)*square(x + 2)
    elseif x <  0
        return frac(T,-3,2)*x*(x + frac(T,4,3))
    elseif x <  1
        return frac(T,+3,2)*x*(x - frac(T,4,3))
    else
        return frac(T,-1,2)*square(x - 2)
    end
end

@inline function compute_weights(ker::BSplinePrime{4,T}, t::T) where {T}
    w1 = frac(T,-1,2)*(t - 1)^2
    w2 = frac(T, 3,2)*(t - frac(T,4,3))*t
    w3 = frac(T, 1,2) + (1 - frac(T,3,2)*t)*t
    w4 = frac(T, 1,2)*t^2
    return (w1, w2, w3, w4)
end

#------------------------------------------------------------------------------
# GENERIC CUBIC SPLINE

# Abstract types to implement common traits of cubic splines.
abstract type AbstractCubicSpline{T} <: Kernel{T,4} end
abstract type AbstractCubicSplinePrime{T} <: Kernel{T,4} end

support(::AbstractCubicSpline{T}) where {T} =
    SymmetricSupport{T,4,Open,Open}()
support(::AbstractCubicSplinePrime{T}) where {T} =
    SymmetricSupport{T,4,Open,Open}()

"""
    CubicSpline{T}(a, b) -> ker

yields an instance of a generic cubic spline for floating-point type `T` and
parameters `a = ker'(1)` and `b = ker(1)` the slope and the value of the
function `ker(x)` at `x = 1`.

A cubic spline kernel is at least C¹ continuous, the expression `ker'` yields a
kernel instance implementing the 1st derivative of the generic cubic spline
`ker` (see [`CubicSplinePrime`](@ref) to directly build a derivative).

Depending on the values of the parameters `a` and `b`, more specific cubic
spline kernels can be emulated:

* `CubicSpline{T}(-1/2,1/6)` yields a cubic B-spline as built by
  `BSpline{4,T}()`.

* `CubicSpline{T}(a,0)` yields a cardinal cubic spline as built by
  `CardinalCubicSpline{T}(a)`.

* `CubicSpline{T}(-1/2,0)` yields a Catmull-Rom kernel as built by
  `CatmullRomSpline{T}()`.

* `CubicSpline{T}(-b/2-c,b/6)` yields Mitchell & Netravali cubic spline as
  built by `MitchellNetravaliSpline{T}(b,c)`.

Instances of `CubicSpline` are very well optimized and, in practice, they may
be as fast or even faster than these more specialized counterparts.

""" CubicSpline

"""
    CubicSplinePrime{T}(a, b)

yields a kernel instance that is the 1st derivative of the generic cubic spline
of parameters `a` and `b` (see [`CubicSpline`](@ref)) for floating-point
type `T` (`Float64` by default).

""" CubicSplinePrime

struct CubicSpline{T} <: AbstractCubicSpline{T}
    a::T
    b::T
    c0::T
    c1::T
    c2::T
    c3::T
    c4::T
    c5::T
    c6::T
    function CubicSpline{T}(_a::Real, _b::Real) where {T}
        # NOTE: Paramaters must be signed in the expressions of the kernel
        # constants.  Since there is no loss of precision in computing these
        # constants with floating-point arithmetic even though parameters are
        # integers, we convert the parameters to type T.
        a, b = T(_a), T(_b)
        new{T}(a, b,
               1 - 2b,     # c0
               9b - a - 3, # c1
               2 + a - 6b, # c2
               -a - b,     # c3
               a + 2b,     # c4
               3b - 1,     # c5
               a + 3b)     # c6
    end
end

@inline function (ker::CubicSpline{T})(x::T) where {T}
    abs_x = abs(x)
    if abs_x ≤ 1
        return (ker.c2*abs_x + ker.c1)*abs_x^2 + ker.c0
    elseif abs_x < 2
        return (ker.c3 + ker.c4*abs_x)*(abs_x - 2)^2
    else
        return zero(T)
    end
end

@inline function compute_weights(ker::CubicSpline{T}, t::T) where {T}
    #
    # With `t = x - floor(x)`, the weights are given by:
    #
    #     w1 = (1 - t)^2 (b + (a + 2b) t)
    #        = u^2 (b + c4*t)
    #     w2 = (1 - 2b) + t^2 ((-3 - a + 9b) + (2 + a - 6b) t)
    #        = c0 + t^2 (c1 + c2*t)
    #     w3 = (1 - 2b) + (1 - t)^2 ((3b - 1) - (2 + a - 6b) t)
    #        = c0 + u^2 (c5 - c2*t)
    #     w4 = t^2 ((a + 3b) - (a + 2b) t)
    #        = t^2 (c6 - c4 t)
    #
    # where:
    #
    #     u = 1 - t
    #     c5 = 3b - 1
    #     c6 = a + 3b
    #
    # can be done in 15 operations:
    #
    u = 1 - t
    c4t = ker.c4*t
    c2t = ker.c2*t
    u2 = u*u
    t2 = t*t
    w1 = (ker.b  + c4t)*u2
    w2 = (ker.c1 + c2t)*t2 + ker.c0
    w3 = (ker.c5 - c2t)*u2 + ker.c0
    w4 = (ker.c6 - c4t)*t2
    return (w1, w2, w3, w4)
end

struct CubicSplinePrime{T} <: AbstractCubicSplinePrime{T}
    a::T
    b::T
    c1::T
    c2::T
    c3::T
    c4::T
    c5::T
    function CubicSplinePrime{T}(_a::Real, _b::Real) where {T}
        a, b = T(_a), T(_b)
        new{T}(a, b,
               -6 - 2a + 18b, # c1
               6 + 3a - 18b,  # c2
               -4a - 6b,      # c3
               3a + 6b,       # c4
               2a + 6b)       # c5
    end
end

@inline function (ker::CubicSplinePrime{T})(x::T) where {T}
    sign_x, abs_x = signabs(x)
    if abs_x ≤ 1
        return (ker.c1 + ker.c2*abs_x)*x
    elseif abs_x < 2
        return sign_x*(abs_x - 2)*(ker.c3 + ker.c4*abs_x)
    else
        return zero(T)
    end
end

@inline function compute_weights(ker::CubicSplinePrime{T}, t::T) where {T}
    #
    # With `t = x - floor(x)`, the weights are given by:
    #
    #     w1 = (a - (6b + 3a) t) (1 - t)
    #        = (a - c4 t) (1 - t)
    #     w2 = ((-6 - 2a + 18b) + (6 + 3a - 18b) t) t
    #        = (c1 + c2 t) t
    #     w3 = ((6 + 3a - 18b) t - a) (1 - t)
    #        = (c2 t - a) (1 - t)
    #     w4 = ((2a + 6b) - (3a + 6b) t) t
    #        = (c5 - c4 t) t
    #
    # can be computed in 11 operations in total:
    #
    u = 1 - t
    c4t = ker.c4*t
    c2t = ker.c2*t
    w1 = (ker.a - c4t)*u
    w2 = (ker.c1 + c2t)*t
    w3 = (c2t - ker.a)*u
    w4 = (ker.c5 - c4t)*t
    return (w1, w2, w3, w4)
end

# Outer constructors, traits and standard methods.
for K in (:CubicSpline, :CubicSplinePrime)
    @eval begin
        $K(a::Real, b::Real) = $K(promote(a, b)...)
        $K(a::Integer, b::Integer) = $K{Float64}(a, b)
        $K(a::T, b::T) where {T<:AbstractFloat} = $K{T}(a, b)
        values(ker::$K) = (ker.a, ker.b)
        iscardinal(::Union{K,Type{K}}) where {K<:$K} = false
        isnormalized(::Union{K,Type{K}}) where {K<:$K} =
            $(K === :CubicSpline)
    end
end

#------------------------------------------------------------------------------
# KEYS' CARDINAL CUBIC SPLINE

# Abstract types to implement common traits of cardinal cubic splines.
abstract type AbstractCardinalCubicSpline{T} <: AbstractCubicSpline{T} end
abstract type AbstractCardinalCubicSplinePrime{T} <: AbstractCubicSplinePrime{T} end

"""
    CardinalCubicSpline{T}(a)

yields an instance of the Keys family of cardinal cubic splines for
floating-point type `T` and parameter `a = ker'(1)` the slope of the function
`ker(x)` at `x = 1`.

These kernels are C¹ continuous piecewise normalized cardinal cubic spline
which depend on one parameter `a` and defined by:

    ker(x) = 1 + ((2 + a)*|x| - (3 + a))*x^2    if |x| ≤ 1
             a*(|x| - 1)*(|x| - 2)^2            if 1 ≤ |x| ≤ 2
             0                                  if |x| ≥ 2

The expression `ker'` yields a kernel instance which is the 1st derivative of
the Keys kernel `ker` (also see the constructor
[`CardinalCubicSplinePrime`](@ref)).

Reference:

* Keys, Robert, G., "*Cubic Convolution Interpolation for Digital Image
  Processing*", IEEE Trans. Acoustics, Speech, and Signal Processing,
  Vol. ASSP-29, No. 6, December 1981, pp. 1153-1160.

""" CardinalCubicSpline

struct CardinalCubicSpline{T} <: AbstractCardinalCubicSpline{T}
    a::T   # a
    ap2::T # a + 2
    ap3::T # a + 3
    am2::T # a - 2
    function CardinalCubicSpline{T}(_a::Real) where {T}
        a = T(_a)
        new{T}(a, a + 2, a + 3, a - 2)
    end
end

@inline function (ker::CardinalCubicSpline{T})(x::T) where {T}
    abs_x = abs(x)
    if abs_x ≥ 2
        return zero(T)
    elseif abs_x ≤ 1
        return 1 + (ker.ap2*abs_x - ker.ap3)*abs_x^2
    else
        return ker.a*(abs_x - 1)*(abs_x - 2)^2
    end
end

@inline function compute_weights(ker::CardinalCubicSpline{T}, t::T) where {T}
    #
    # Given `t = x - floor(x)`, compute:
    #
    #     w1 = a*(1 - t)^2*t
    #     w2 = (1 + t - (2 + a) t^2)*(1 - t)
    #     w3 = -t (a - (2a + 3)*t + (a + 2)*t^2)
    #     w4 = a*(1 - t)*t^2
    #
    # Noting that, with `u = 1 - t` and `v = a*t*u`(1 - t)`, the following
    # hold:
    #
    #     w1 = v*u
    #     w4 = v*t
    #     w1 + w4 = v
    #     w2 + w3 = 1 - v
    #     w2 = 1 - (1 + (2 + a)*u)*t^2
    #
    # can be done in in 11 operations:
    #
    u = 1 - t
    v = ker.a*t*u
    w = (1 + ker.ap2*u)*(t*t) # ap2 = a + 2
    w1 = v*u
    w2 = 1 - w
    w3 = w - v
    w4 = v*t
    return (w1, w2, w3, w4)
end

"""
    CardinalCubicSplinePrime{T}(a)

yields a kernel instance that is the 1st derivative of the Keys cardinal cubic
spline (see [`CardinalCubicSpline`](@ref)) for floating-point type `T` and
parameter `a`.  This derivative is given by:

    ker′(x) = (3(a + 2)*|x| - 2(a + 3))*x           if |x| ≤ 1
              (3a)*(|x| - 2)*(|x| - 4/3)*sign(x)    if 1 ≤ |x| ≤ 2
              0                                     if |x| ≥ 2

""" CardinalCubicSplinePrime

struct CardinalCubicSplinePrime{T} <: AbstractCardinalCubicSplinePrime{T}
    a ::T
    c1::T # 3(a + 2)
    c2::T # 2(a + 3)
    c3::T # 3a
    CardinalCubicSplinePrime{T}(a::Real) where {T} =
        new{T}(a, 3(a + 2), 2(a + 3), 3a)
end

@inline function (ker::CardinalCubicSplinePrime{T})(x::T) where {T}
    sign_x, abs_x = signabs(x)
    if abs_x ≥ 2
        return zero(T)
    elseif abs_x ≤ 1
        return (ker.c1*abs_x - ker.c2)*x
    else
        return (sign_x*ker.c3)*(abs_x - 2)*(abs_x - frac(T,4,3))
    end
end

# FIXME: optimize compute_weights for CardinalCubicSplinePrime

# Traits and outer constructors.
for K in (:CardinalCubicSpline, :CardinalCubicSplinePrime)
    @eval begin
        $K(a::Real) = $K{Float64}(a)
        $K(a::T) where {T<:AbstractFloat} = $K{T}(a)
        values(ker::$K) = (ker.a,)
        iscardinal(::Union{K,Type{K}}) where {K<:$K} =
            $(K === :CardinalCubicSpline)
        isnormalized(::Union{K,Type{K}}) where {K<:$K} =
            $(K === :CardinalCubicSpline)
    end
end

#------------------------------------------------------------------------------
# CATMULL-ROM INTERPOLATION KERNEL

"""
    CatmullRomSpline{T}()

yields an instance of the Catmull-Rom interpolation kernel for floating-point
type `T` which is assumed to be `Float64` if omitted.

Catmull-Rom interpolation kernel is a cardinal piecewise cubic spline defined
by:

    ker(x) = ((3/2)*|x| - (5/2))*x^2 + 1             if |x| ≤ 1
             (((5/2) - (1/2)*|x|)*|x| - 4)*|x| + 2   if 1 ≤ |x| ≤ 2
             0                                       if |x| ≥ 2

The expression `ker'` yields a kernel instance which is the 1st derivative of
the Catmull-Rom interpolation kernel `ker` (also see the constructor
[`CatmullRomSplinePrime`](@ref)).

""" CatmullRomSpline

struct CatmullRomSpline{T} <: AbstractCardinalCubicSpline{T} end

@inline function (::CatmullRomSpline{T})(x::T) where {T}
    abs_x = abs(x)
    if abs_x ≥ 2
        return zero(T)
    elseif abs_x ≤ 1
        # (((3/2)*x - (5/2))*x^2 + 1)
        return ((T(3)/2)*abs_x - T(5)/2)*abs_x*abs_x + 1
    else
        # (((5/2) - (1/2)*x)*x - 4)*x + 2
        # = (2 - x)^2 (1 - x)/2
        return (2 - abs_x)^2*(1 - abs_x)/2
    end
end

@inline function compute_weights(::CatmullRomSpline{T}, t::T) where {T}
    # 10 operations:
    u = 1 - t
    v = frac(T,-1,2)*t*u
    w1 = v*u
    w4 = v*t
    w = w4 - w1
    w2 = u - w1 + w
    w3 = t - w4 - w
    return (w1, w2, w3, w4)
end

"""
    CatmullRomSplinePrime{T}()

yields a kernel instance that is the 1st derivative of the Catmull-Rom
interpolation kernel (see [`CatmullRomSpline`](@ref)) for floating-point type
`T` which is assumed to be `Float64` if omitted.

The 1st derivative of the Catmull-Rom interpolation kernel is given by:

    ker′(x) = ((9/2)*|x| - 5)*x                      if a = |x| ≤ 1
              (5 - (3/2)*|x|)*x - 4*sign(x)          if 1 ≤ |x| ≤ 2
              0                                      if |x| ≥ 2

""" CatmullRomSplinePrime

struct CatmullRomSplinePrime{T} <: AbstractCardinalCubicSplinePrime{T} end

@inline function (::CatmullRomSplinePrime{T})(x::T) where {T}
    if x < 0
        if x ≤ -2
            return zero(T)
        elseif x ≥ -1
            return (frac(T,-9,2)*x - 5)*x
        else
            return (5 + frac(T,3,2)*x)*x + 4
        end
    else
        if x ≥ 2
            return zero(T)
        elseif x ≤ 1
            return (frac(T,9,2)*x - 5)*x
        else
            return (5 - frac(T,3,2)*x)*x - 4
        end
    end
end

@inline function compute_weights(::CatmullRomSplinePrime{T}, t::T) where {T}
    #
    # Weights are given by (18 operations):
    #
    #   w1 = -(3/2)*t^2 + 2*t - (1/2);
    #   w2 =  (9/2)*t^2 - 5*t;
    #   w3 = -(9/2)*t^2 + 4*t + (1/2);
    #   w4 =  (3/2)*t^2 - t;
    #
    #   w4 = ((3/2)*t - 1)*t;
    #   w1 = t - w4 - (1/2);
    #   w2 = 3*w4 - 2*t;
    #   w3 = t - 3*w4 + (1/2);
    #
    # can be computed in 11 operations:
    #
    w4 = frac(T,3,2)*t*t - t;
    w1 = t - w4 - frac(T,1,2);
    w2 = T(3)*w4 - 2*t;
    w3 = t - T(3)*w4 + frac(T,1,2);
    return (w1, w2, w3, w4)
end

# Traits and outer constructors.
for K in (:CatmullRomSpline, :CatmullRomSplinePrime)
    @eval begin
        $K() = $K{Float64}()
        iscardinal(::Union{K,Type{K}}) where {K<:$K} =
            $(K === :CatmullRomSpline)
        isnormalized(::Union{K,Type{K}}) where {K<:$K} =
            $(K === :CatmullRomSpline)
    end
end

#------------------------------------------------------------------------------
# MITCHELL & NETRAVALI KERNELS

"""
    MitchellNetravaliSpline{T}(b=1/3, c=1/3)

yields an instance of the Mitchell & Netravali family of kernels for
floating-point type `T` and parameters `(b,c)`.

These kernels are cubic splines which depends on 2 parameters, `b` and `c`.
Whatever the values of `(b,c)`, Mitchell & Netravali kernels are normalized,
even and C¹ continuous functions (these kernels and their first derivatives are
continuous).

Taking `b = 0` yields the family of cardinal cubic splines (see
[`CardinalCubicSpline`](@ref)) and is a sufficient and necessary condition to
have Mitchell & Netravali kernels be cardinal functions.

Using the constraint: `b + 2c = 1` yields a cubic filter with, at least,
quadratic order approximation.

Some specific values of `(b,c)` yield other well known kernels:

    (b,c) = (1,0)      --> cubic B-spline
    (b,c) = (0,-a)     --> Keys's cardinal cubic spline CardinalCubicSpline(a)
    (b,c) = (0,1/2)    --> Catmull-Rom kernel CatmullRomSpline()
    (b,c) = (b,0)      --> Duff's tensioned B-spline
    (b,c) = (6β,-α-3β) --> generic cubic spline CubicSpline(α,β)
    (b,c) = (1/3,1/3)  --> recommended by Mitchell-Netravali

The expression `ker'` yields a kernel instance which is the 1st derivative of
the Mitchell & Netravali kernel `ker` (also see the constructor
[`MitchellNetravaliSplinePrime`](@ref)).

Mitchell & Netravali family of kernels are currently instances of
[`CubicSpline`](@ref).

Reference:

* [Mitchell & Netravali, "*Reconstruction Filters in Computer Graphics*", in
  Computer Graphics, Vol. 22, Num. 4
  (1988)](http://www.cs.utexas.edu/users/fussell/courses/cs384g/lectures/mitchell/Mitchell.pdf).

""" MitchellNetravaliSpline

abstract type MitchellNetravaliSpline{T} <: AbstractCubicSpline{T} end

"""
    MitchellNetravaliSplinePrime([T=Float64,] [b=1/3, c=1/3,] B=Flat)

yields a kernel instance that is the 1st derivative of the Mitchell & Netravali
kernel (see [`MitchellNetravaliSpline`](@ref)) for floating-point type `T`,
parameters `b` and `c` and boundary conditions `B`.

""" MitchellNetravaliSplinePrime

abstract type MitchellNetravaliSplinePrime{T} <: AbstractCubicSplinePrime{T} end

for K in (:MitchellNetravaliSpline, :MitchellNetravaliSplinePrime)
    @eval begin
        $K() = $K{Float64}()
        $K{T}() where {T<:AbstractFloat} = $K{T}(one(T)/3, one(T)/3)
        $K(b::Real, c::Real) = $K{floating_point_type(b, c)}(b, c)
        function $K{T}(_b::Real, _c::Real) where {T<:AbstractFloat}
            b, c = T(_b), T(_c)
            return CubicSpline{T}(-(b/2 + c), b/6)
        end
    end
end

floating_point_type(x::Real) = floating_point_type(typeof(x))
floating_point_type(args::Real...) =
    floating_point_type(map(typeof, args)...)

floating_point_type(T::Type{<:AbstractFloat}) = T
floating_point_type(T::Type{<:Real}) = Float64
floating_point_type(types::Type{<:Real}...) =
    floating_point_type(promote_type(types...))

#------------------------------------------------------------------------------
# LANCZOS RESAMPLING KERNEL

"""
    LanczosKernel{S,T}()

yields an instance of a Lanczos re-sampling kernel of support size `S` (which
must be even) and for floating-point type `T`.

The Lanczos re-sampling kernels are even cardinal functions which tend to be
normalized for large support size.  They are defined by:

    ker(x) = S/(2*(π*x)^2)*sin(π*x)*sin(2*π*x/S)     if |x| ≤ S/2
             0                                       if |x| ≥ S/2

The expression `ker'` yields the first derivative of a Lanczos re-sampling
kernel `ker` (also see the constructor [`LanczosKernelPrime`](@ref)).

""" LanczosKernel

"""
    LanczosKernelPrime{S,T}()

yields a kernel instance that is the 1st derivative of the Lanczos re-sampling
kernel (see [`LanczosKernel`](@ref)) of support size `S` and for floating-point
type `T`.

""" LanczosKernelPrime

struct LanczosKernel{S,T} <: Kernel{T,S}
    a::T   # 1/2 support
    b::T   # a/pi^2
    c::T   # pi/a
    function LanczosKernel{S,T}() where {S,T}
        (typeof(S) == Int && S > 0 && iseven(S)) || bad_lanczos_kernel_size()
        a = T(S>>1)
        new{S,T}(a, a/T(π)^2, T(π)/a)
    end
end

struct LanczosKernelPrime{S,T} <: Kernel{T,S}
    a::T   # 1/2 support
    c::T   # pi/a
    function LanczosKernelPrime{S,T}() where {S,T}
        (typeof(S) == Int && S > 0 && iseven(S)) || bad_lanczos_kernel_size()
        a = T(S>>1)
        new{S,T}(a, T(π)/a)
    end
end

@noinline bad_lanczos_kernel_size() =
    throw(ArgumentError("Lanczos kernel size must be an even integer"))

# Outer constructors.
LanczosKernel{S}(T::Type{<:AbstractFloat} = Float64) where {S} =
    LanczosKernel{S,T}()
LanczosKernelPrime{S}(T::Type{<:AbstractFloat} = Float64) where {S} =
    LanczosKernelPrime{S,T}()

iscardinal(::Union{K,Type{K}}) where {K<:LanczosKernel} = true
iscardinal(::Union{K,Type{K}}) where {K<:LanczosKernelPrime} = false

isnormalized(::Union{K,Type{K}}) where {K<:LanczosKernel} = false
isnormalized(::Union{K,Type{K}}) where {K<:LanczosKernelPrime} = false

support(::LanczosKernel{S,T}) where {S,T} = SymmetricSupport{T,S,Open,Open}()
support(::LanczosKernelPrime{S,T}) where {S,T} = SymmetricSupport{T,S,Open,Open}()

# Expression for non-zero argument in the range (-S/2,S/2).
@inline _p(ker::LanczosKernel{S,T}, x::T) where {S,T} =
    ker.b*sin(π*x)*sin(ker.c*x)/(x*x)

# Expression for non-zero argument in the range (-S/2,S/2).
@inline function _p(ker::LanczosKernelPrime{S,T}, x::T) where {S,T}
    x1 = π*x
    s1, c1 = sin(x1), cos(x1)
    r1 = s1/x1
    x2 = ker.c*x # π*x/a
    s2, c2 = sin(x2), cos(x2)
    r2 = s2/x2
    return (c1*r2 + c2*r1 - 2*r1*r2)/x
end

(ker::LanczosKernel{S,T})(x::T) where {S,T} =
    (abs(x) ≥ ker.a ? zero(T) : x == 0 ? one(T) : _p(ker, x))

(ker::LanczosKernelPrime{S,T})(x::T) where {S,T} =
    (abs(x) ≥ ker.a ? zero(T) : x == 0 ? one(T) : _p(ker, x))

@generated function compute_weights(ker::LanczosKernel{S,T}, t::T) where {S,T}
    c = (S >> 1) # central index
    W = [Symbol("w",i) for i in 1:S] # all weights
    Expr(:block,
         Expr(:meta, :inline),
         Expr(:local, [:($w::T) for w in W]...),
         Expr(:if, :(t == zero(T)),
              Expr(:block, [:($(W[i]) = $(i == c ? 1 : 0)) for i in 1:S]...),
              Expr(:block,
                   [:($(W[i]) = _p(ker, t + $(c - i))) for i in 1:c-1]...,
                   :($(W[c]) = _p(ker, t)),
                   [:($(W[i]) = _p(ker, t - $(i - c))) for i in c+1:S]...)),
         Expr(:return, Expr(:tuple, W...)))
end

@generated function compute_weights(ker::LanczosKernelPrime{S,T},
                                    t::T) where {S,T}
    c = (S >> 1) # central index
    W = [Symbol("w",i) for i in 1:S] # all weights
    Expr(:block,
         #Expr(:meta, :inline),
         Expr(:local, [:($w::T) for w in W]...),
         [:($(W[i]) = ker(t + $(c - i))) for i in 1:c-1]...,
         :($(W[c]) = ker(t)),
         [:($(W[i]) = ker(t - $(i - c))) for i in c+1:S]...,
         Expr(:return, Expr(:tuple, W...)))
end

#------------------------------------------------------------------------------

@inline frac(::Type{T}, a::Integer, b::Integer) where {T<:AbstractFloat} = (T(a)/T(b))
@inline square(x) = x*x
@inline cube(x) = x*x*x

"""
    signabs(x) -> sign(x), abs(x)

yields the sign and absolute value of `x` both with the same type as `x`.

"""
@inline signabs(x::Unsigned) = (one(x), x)
@inline signabs(x::Real) = ifelse(x > 0, (one(x), x),
                                  ifelse(x < 0, (oftype(one(x),-1), -x),
                                         (zero(x), zero(x))))

#------------------------------------------------------------------------------

# Manage to call the short version of `show` for MIME output.
Base.show(io::IO, ::MIME"text/plain", ker::Kernel) = show(io, ker)

function Base.show(io::IO, ker::Kernel)
    summary(io, ker)
    print(io, '(')
    join(io, values(ker), ',')
    print(io, ')')
end

"""
    InterpolationKernels.with_eltype(T, ker)

yields an instance (resp. a type) of interpolation kernel instance (resp. type)
`ker` but with floating-point type `T`.

"""
with_eltype(::Type{T}, ::Type{K}) where {T<:AbstractFloat,K<:Kernel{T}} = K
with_eltype(::Type{T}, ker::Kernel{T}) where {T<:AbstractFloat} = ker

# The first instance below is needed to automatically do nothing when
# converting to a kernel of the same type (remmeber that convert is called to
# instanciate structure fields).
convert(::Type{K}, ker::K) where {K<:Kernel} = ker
convert(::Type{K}, ker::Kernel) where {K<:Kernel} = K(ker)

Kernel(ker::Kernel) = ker
Kernel{T}(ker::Kernel) where {T<:AbstractFloat} = with_eltype(T, ker)
Kernel{T,S}(ker::Kernel{<:Any,S}) where {T<:AbstractFloat,S} = with_eltype(T, ker)

for T in FLOATS
    @eval Base.$T(ker::Kernel) = with_eltype($T, ker)
end

"""
    InterpolationKernels.brief(ker)

yields a brief description of the kernel type or instance `ker`.

"""
brief(ker::Kernel) = brief(typeof(ker))

brief(::Type{<:BSpline{1}}) = "rectangular B-spline"
brief(::Type{<:BSplinePrime{1}}) = "derivative of rectangular B-spline"

brief(::Type{<:BSpline{2}}) = "linear B-spline"
brief(::Type{<:BSplinePrime{2}}) = "derivative of linear B-spline"

brief(::Type{<:BSpline{3}}) = "quadratic B-spline"
brief(::Type{<:BSplinePrime{3}}) = "derivative of quadratic B-spline"

brief(::Type{<:BSpline{4}}) = "cubic B-spline"
brief(::Type{<:BSplinePrime{4}}) = "derivative of cubic B-spline"

@noinline brief(::Type{<:BSpline{S}}) where {S} = "B-spline of order $S"
@noinline brief(::Type{<:BSplinePrime{S}}) where {S} =
    "derivative of B-spline of order $S"

brief(::Type{<:CubicSpline}) = "generic cubic spline"
brief(::Type{<:CubicSplinePrime}) = "derivative of generic cubic spline"

brief(::Type{<:CardinalCubicSpline}) = "cardinal cubic spline"
brief(::Type{<:CardinalCubicSplinePrime}) =
    "derivative of cardinal cubic spline"

brief(::Type{<:CatmullRomSpline}) = "Catmull & Rom cubic spline"
brief(::Type{<:CatmullRomSplinePrime}) =
    "derivative of Catmull & Rom cubic spline"

@noinline brief(::Type{<:LanczosKernel{S}}) where {S} =
    "Lanczos resampling kernel of size $S"
@noinline brief(::Type{<:LanczosKernelPrime{S}}) where {S} =
    "derivative of Lanczos resampling kernel of size $S"

# Manage to yield the derivative of (some) kernels when the notation `ker'` is
# used.
adjoint(ker::BSpline{S,T}) where {S,T} = BSplinePrime{S,T}()
adjoint(ker::CubicSpline{T}) where {T} = CubicSplinePrime{T}(ker.a, ker.b)
adjoint(ker::CardinalCubicSpline{T}) where {T} = CardinalCubicSplinePrime{T}(ker.a)
adjoint(ker::CatmullRomSpline{T}) where {T} = CatmullRomSplinePrime{T}()
adjoint(ker::LanczosKernel{S,T}) where {S,T} = LanczosKernelPrime{S,T}()

# Provide methods for all kernels.
for K in (:BSpline,             :BSplinePrime,
          :CubicSpline,         :CubicSplinePrime,
          :CardinalCubicSpline, :CardinalCubicSplinePrime,
          :CatmullRomSpline,    :CatmullRomSplinePrime,
          :LanczosKernel,       :LanczosKernelPrime)

    has_size = (K === :BSpline || K === :BSplinePrime ||
        K === :LanczosKernel || K === :LanczosKernelPrime)

    # We want that calling the kernel on a different type of real argument than
    # the floting-point type of the kernel convert the argument.
    # Unfortunately, defining:
    #
    #     (ker::$K{T})(x::Real) where {T<:AbstractFloat} = ker(convert(T,x))
    #
    # leads to ambiguities, the following is ugly but works...
    for T in FLOATS, R in (FLOATS..., :Integer)
        if R != T
            if has_size
                @eval @inline (ker::$K{S,$T})(x::$R) where {S} = ker($T(x))
            else
                @eval @inline (ker::$K{$T})(x::$R) = ker($T(x))
            end
        end
    end

    # Calling the kernel on an array.  FIXME: should be deprecated!
    if has_size
        @eval (ker::$K{S,T})(A::AbstractArray) where {S,T<:AbstractFloat} =
            map(ker, A)
    else
        @eval (ker::$K{T})(A::AbstractArray) where {T<:AbstractFloat} =
            map(ker, A)
    end

    # Change floating-point type.
    @eval $K{T}(ker::$K) where {T<:AbstractFloat} = with_eltype(T, ker)
    if has_size
        @eval begin
            $K{S,T}(ker::$K{S}) where {S,T<:AbstractFloat} = with_eltype(T, ker)
            with_eltype(::Type{T}, ::Type{<:$K{S}}) where {S,T<:AbstractFloat} = $K{S,T}
            with_eltype(::Type{T}, ker::$K{S}) where {S,T<:AbstractFloat} = $K{S,T}(values(ker)...)
            with_eltype(::Type{T}, ker::$K{T,S}) where {S,T<:AbstractFloat} = ker
        end
    else
        @eval begin
            with_eltype(::Type{T}, ::Type{<:$K}) where {T<:AbstractFloat} = $K{T}
            with_eltype(::Type{T}, ker::$K{T}) where {T<:AbstractFloat} = ker
            with_eltype(::Type{T}, ker::$K) where {T<:AbstractFloat} = $K{T}(values(ker)...)
        end
    end

    # Method `summary` prints the type of an object.
    if has_size
        @eval Base.summary(io::IO, ::$K{S,T}) where {S,T} =
            print(io, $(string(K, "{")), S, ',', T, '}')
    else
        @eval Base.summary(io::IO, ::$K{T}) where {T} =
            print(io, $(string(K, "{")), T, '}')
    end
end

end # module


@testset "bfs" begin
    A = load_matrix_network("bfs_example")
    A_ref = [1 0 1 1; 0 1 1 1; 1 1 0 1; 1 1 1 0]
    d_ref = [0,2,1,1]
    dt_ref = [0,3,1,2]
    pred_ref = [1,3,1,1]

    @testset "MatrixNetwork" begin
        bfs(MatrixNetwork(A), 1)

        (d,dt,pred) = bfs(MatrixNetwork(sparse(A_ref)), 1)
        @test d == d_ref
        @test dt_ref == dt
        @test pred_ref == pred

        bfs(MatrixNetwork(A), 1, 0)
        @test d == d_ref
        @test dt_ref == dt
        @test pred_ref == pred
    end
    @testset "SparseMatrixCSC" begin
        bfs(A,1)

        (d,dt,pred) = bfs(sparse(A_ref), 1)
        @test d == d_ref
        @test dt_ref == dt
        @test pred_ref == pred

        bfs(A,1,0)
        (d,dt,pred) = bfs(sparse(A_ref ),1,0)
        @test d == d_ref
        @test dt_ref == dt
        @test pred_ref == pred
    end
    @testset "triplet" begin
        bfs(findnz(A)[1], findnz(A)[2], 1)

        (d,dt,pred) = bfs(findnz(sparse(A_ref))[1], findnz(sparse(A_ref))[2],1)
        @test d == d_ref
        @test dt_ref == dt
        @test pred_ref == pred

        bfs(findnz(A)[1], findnz(A)[2], 1, 0)

        (d,dt,pred) = bfs(findnz(sparse(A_ref))[1], findnz(sparse(A_ref))[2], 1, 0)
        @test d == d_ref
        @test dt_ref == dt
        @test pred_ref == pred
    end
    @testset "CSR" begin
        A_csr = sparse_to_csr(A)
        bfs(A_csr..., 1)

        (d,dt,pred) = bfs(sparse_to_csr(sparse(A_ref))..., 1)
        @test d == d_ref
        @test dt_ref == dt
        @test pred_ref == pred

        bfs(A_csr..., 1, 0)

        (d,dt,pred) = bfs(sparse_to_csr(sparse(A_ref))..., 1, 0)
        @test d == d_ref
        @test dt_ref == dt
        @test pred_ref == pred
    end
end


#=
    http://cplint.eu/example/inference/dice.swinb

    """
    A six-sided die is repeatedly thrown until the outcome is six. on(T,F)
    means that on the Tth throw the face F came out.
    """

    What is the probability that the die lands on face 1 at time 0?

    Cf ~/blog/dice_6_throws.blog
     ~/psi/dice_6_throws.psi
     ~/webppl/dice_6_throws.wppl

     Also see the related problem rolling_dice4.jl where we investigate
     the probability of the length of this (stopping) sequence.

=#

using Turing, StatsPlots, DataFrames
include("jl_utils.jl")

# ix: Throw index
# val: The value to check
@model function dice_6_throws(ix=1,val=1)

    max_len = 100
    function throws(a)
        # Note: If t is a random variable then we got StackOverflowError
        # t ~  DiscreteUniform(1,6) # Don't work!
        # Hence we draw a "plain" random value
        t = rand(DiscreteUniform(1,6))
        if t == 6
            return a
        else
            return throws(vcat(a,t))
        end
    end

    a = throws(Int16[])
    len ~ Dirac(length(a))

    # Probability that the die lands on face val on throw ix
    test ~ Dirac(length(a) >= ix && a[ix] == val)
end

function run_model(ix, val)
    model = dice_6_throws(ix,val)

    num_chns = 4

    # chns = sample(model, Prior(), 10_000)

    # chns = sample(model, MH(), MCMCThreads(), 100_000, num_chns)
    # chns = sample(model, MH(), MCMCThreads(), 10_000, num_chns)

    # chns = sample(model, MH(), 10_000)
    # chns = sample(model, MH(), 1_000)

    # chns = sample(model, PG(15), MCMCThreads(), 1_000, num_chns)

    # chns = sample(model, SMC(1000), MCMCThreads(), 10_000, num_chns)
    # chns = sample(model, SMC(1000), 10_000)
    chns = sample(model, IS(), 10_000)

    display(chns)
    # display(plot(chns))

    show_var_dist_pct(chns,:test)
    show_var_dist_pct(chns,:len)

end

for i in 1:10
    println("\nix:$i val:1")
    run_model(i,1)
end


module CellFieldsBench

using Gridap
using Gridap.FieldValues
using Gridap.CellValues
using Gridap.CellFunctions
using Gridap.Geometry
using Gridap.Geometry.Cartesian

l = 1000000

include("../test/CellFunctionsTestsMocks.jl")

function doloop(x)
  for xi in x
  end
end

println("+++ CellFieldsBench ( length = $l ) +++")

tiff = varinner(tbv,tbv)

print("TensorBasisBasisInner ->"); @time doloop(tiff)
print("TensorBasisBasisInner ->"); @time doloop(tiff)

vexpand = expand(vbv,sfv2)

print("VectorScalarExpand ->"); @time doloop(vexpand)
print("VectorScalarExpand ->"); @time doloop(vexpand)

using Gridap.Geometry
using Gridap.Quadratures
using Gridap.CellQuadratures
using Gridap.CellIntegration

grid = CartesianGrid(partition=(1000,1000))
trian = Triangulation(grid)

meshcoords = cellcoordinates(trian)
quad = CellQuadrature(trian,degree=2)
points = coordinates(quad)
phi = geomap(trian)
basis = CellBasis(trian)
physbasis = attachgeomap(basis,phi)
physbasisgrad = gradient(physbasis)
valsgrad = evaluate(physbasisgrad,points)
xg = evaluate(phi,points)
vals = evaluate(basis,points)

print("DummyMeshCoords2D ->"); @time doloop(meshcoords)
print("DummyMeshCoords2D ->"); @time doloop(meshcoords)

print("DummyCellBasis2D ->"); @time doloop(vals)
print("DummyCellBasis2D ->"); @time doloop(vals)

print("xg ->"); @time doloop(xg)
print("xg ->"); @time doloop(xg)

print("PhysBasisGradVals ->"); @time doloop(valsgrad)
print("PhysBasisGradVals ->"); @time doloop(valsgrad)

kmatg = varinner(valsgrad, valsgrad)

print("DummyStiffnessMatrix2DAtQPoints ->"); @time doloop(kmatg)
print("DummyStiffnessMatrix2DAtQPoints ->"); @time doloop(kmatg)

a(v,u) = inner(∇(v),∇(u)) + inner(v,u)
V = physbasis
U = physbasis
kmat = integrate(a(V,U),trian,quad)

print("DummyStiffnessMatrix2D ->"); @time doloop(kmat)
print("DummyStiffnessMatrix2D ->"); @time doloop(kmat)

end


using Flux
using Flux: Chain, Dense, params, train!, glorot_uniform
using Flux.Tracker: Params, gradient, update!

f = x -> (1/(0.82+x))^12 -2 * (1/(.82+x))^6
#f = x -> sin.(x.*7.0)

nsamples = 200
XS = rand(nsamples)
YS = f.(XS)
samples = zip(XS,YS)
#samples = [(x, f(x)) for x in XS]
#samples= [(XS, YS)]

xerr = range(0, 1, length=1000)
eval_nn(model, x) = model(x).data
maxfit_nn(model) = maximum(abs, f.(XS) - model(XS)')

struct Linear{F,S,T}
  W::S
  b::T
  σ::F
end

Linear(W, b) = Linear(W, b, identity)

function Linear(in::Integer, out::Integer, σ = identity)
  return Linear(param(randn(out, in)), param(randn(out)), σ)
end

@Flux.treelike Linear

function (a::Linear)(x::AbstractArray)
    W, b, σ = a.W, a.b, a.σ
    σ.(W * x' .+ b)
end

# Try to avoid hitting generic matmul in some simple cases
# Base's matmul is so slow that it's worth the extra conversion to hit BLAS
(a::Linear{<:Any,W})(x::AbstractArray{T}) where {T <: Union{Float32,Float64}, W <: AbstractArray{T}} =
  invoke(a, Tuple{AbstractArray}, x)

(a::Linear{<:Any,W})(x::AbstractArray{<:Real}) where {T <: Union{Float32,Float64}, W <: AbstractArray{T}} =
  a(T.(x))

function train_nn(nnodes, η)
    model = Chain(Linear(1, nnodes, Flux.tanh),   # first hidden layer
                  #Dense(nnodes, nnodes), # second hidden layer
                  Dense(nnodes, 1))      # output layer

    loss(x, y) = Flux.mse(model(x), y)

    θ = Flux.params(model)
    #println(θ)

    for i=1:5000
        #Flux.train!(loss, model_weights, samples, Descent(0.1))
        for j=1:length(XS)
            g = gradient(() -> loss([XS[j]], YS[j]), θ)
        #g = gradient(() -> loss(XS, YS), θ)
            for x in θ
                update!(x, -g[x]*η)
            end
        end
        if i%100==1
            @show loss(XS, YS)
            #println(size(model(XS)),size(YS))
            @show maxfit_nn(model)
        end
        if i%200==1
            η = η * 1.1
        end
    end
    return model
end

η = 0.000005 # Learning rate (should be smaller corresponding to the complex regression times the # of nodes)
NN_nodes = 5:5:15
errs_nn = Float64[]

for N in NN_nodes
    @show N
    nn = train_nn(N,η)
    println(Flux.params(nn))
    #@show e = err_nn(nn)
    #push!(errs_nn, e)
end
@show errs_nn


# using Plots
# using DataFrames
#
# function regression(Y,Phi,lambda=0.000001)
#     #Inputs
#     #Y: vector containing exact values for the samples
#     #Phi: matrix containing values for the basis functions
#     #lambda: real - regularization parameter
#
#     #Output:
#     #vector of weights for each basis functions
#     nb_basis_fcts = size(Phi,1)
#     Q, R = qr(Phi')
#     weights = (lambda*eye(nb_basis_fcts) + R'*R) \ (Phi * Y)
#     return weights
# end
#
#
# # F(t) = sqrt(t)
# # rho(r) = exp(-r)
# #
# # function Energy_tot(x)
# #     #total energy computation for a given configuration x
# #
# #     #Input: matrix containing the configurations in row
# #     # Ntrain = size(x,1)
# #     # Nvariables = size(x,2)
# #
# #     return F.(rho.(x[:,1])+rho.(x[:,2])) +F.(rho.(x[:,2])+rho.(x[:,3])) +F.(rho.(x[:,3])+rho.(x[:,1])) #total energy
# #     # return   F.(rho.(x[:,1])+rho.(x[:,2])+rho.(x[:,3])) #site energy
# #
# # end
#
# # N = 3; #number of particles
# #
# #
# #
# # #Generate samples
# # Ntrain = 1000;
# # Ntest = 2000;
# # LeftRcuttrain = 0.5;
# # RightRcuttrain = 3;
# #
# # LeftRcuttest = 0.5;
# # RightRcuttest = 3;
# #
# #
# # r1train = (RightRcuttrain-LeftRcuttrain)*rand(Ntrain) + LeftRcuttrain; #sample variables
# # r2train = (RightRcuttrain-LeftRcuttrain)*rand(Ntrain) + LeftRcuttrain;
# # r3train = (RightRcuttrain-LeftRcuttrain)*rand(Ntrain) + LeftRcuttrain;
# #
# # r1test = (RightRcuttest-LeftRcuttest)*rand(Ntest) + LeftRcuttest; #test variables
# # r2test = (RightRcuttest-LeftRcuttest)*rand(Ntest) + LeftRcuttest;;
# # r3test = (RightRcuttest-LeftRcuttest)*rand(Ntest) + LeftRcuttest;;
# #
# # Config_train = [r1train r2train r3train]; #configuration matrix
# # Etrain = Energy_tot(Config_train) #energies for the samples
# #
# # Config_test = [r1test r2test r3test]; #configuration matrix
# # Etest_exact = Energy_tot(Config_test); #energies for the test
# #
# #
# # Deg = collect(1:10);
#
#
#
#
#
#
#
#
# a = 1; #parameter for the exponentials
#
# Poly = (["y^0","y^1","y^2","y^3","y^4","y^5","y^6","y^7","y^8","y^9","y^10","y^11"],"Polynomials");
# Rationals = (["y^0","y^(-1)","y^(-2)","y^(-3)","y^(-4)","y^(-5)","y^(-6)","y^(-7)","y^(-8)","y^(-9)","y^(-10)","y^(-11)"],"Rationals");
# Exponentials = (["y^0","exp(-$a*y)","exp(-$a*2*y)","exp(-$a*3*y)","exp(-$a*4*y)","exp(-$a*5*y)","exp(-$a*6*y)","exp(-$a*7*y)","exp(-$a*8*y)","exp(-$a*9*y)","exp(-$a*10*y)","exp(-$a*11*y)"],"Exponentials");
# Polytimesexp = (["y^0","y^1*exp(-$a*y)","y^2*exp(-$a*y)","y^3*exp(-$a*y)","y^4*exp(-$a*y)","y^5*exp(-$a*y)","y^6*exp(-$a*y)","y^7*exp(-$a*y)","y^8*exp(-$a*y)","y^9*exp(-$a*y)","y^10*exp(-$a*y)","y^11*exp(-$a*y)"],"Polynomials times exp")
# Ratiotimesexp = ["y^0","y^(-1)*exp(-$a*y)","y^(-2)*exp(-$a*y)","y^(-3)*exp(-$a*y)","y^(-4)*exp(-$a*y)","y^(-5)*exp(-$a*y)","y^(-6)*exp(-$a*y)","y^(-7)*exp(-$a*y)","y^(-8)*exp(-$a*y)","y^(-9)*exp(-$a*y)","y^(-10)*exp(-$a*y)","y^(-11)*exp(-$a*y)"],"Rationals times exp"
#
# Basis_fct_list = (Poly, Rationals, Exponentials, Polytimesexp, Ratiotimesexp);
#
# Linfty_err = zeros(length(Deg),length(Basis_fct_list))
# RMSE = zeros(length(Deg),length(Basis_fct_list))
# NB_BASIS_FCTS = zeros(length(Deg),length(Basis_fct_list));
#
#
# for (ibf,bf) in enumerate(Basis_fct_list)
#     println(Basis_fct_list[ibf][2]);
#
#     for (ideg,deg) in enumerate(Deg)
#         #generate permutation-invariant polynomials (or other functions) - uncomment the wanted basis functions
#         Perm_inv_polys = PermPolys(deg, N, Basis_fct_list[ibf][1])
#
#         #generate the basis functions
#         basis_functions = Perm_inv_polys.polys
#
#         Nb_basis_fcts = length(basis_functions)
#         NB_BASIS_FCTS[ideg,ibf] = Nb_basis_fcts
#
#         println("the maximal degree is $deg and the number of basis functions is $Nb_basis_fcts")
#
#
#         #generate the values of the basis functions in the samples points to construct
#         #the regression matrix
#         Phitrain = zeros(Nb_basis_fcts,Ntrain)
#
#         for i = 1:Ntrain
#             for j=1:Nb_basis_fcts
#                 Phitrain[j,i] = basis_functions[j](Config_train[i,:])
#             end
#         end
#
#         #compute the regression ie weights
#         Weights = regression(Etrain,Phitrain,1e-9)
#
#
#         #compute the test energy
#         Phitest = zeros(Nb_basis_fcts,Ntest)
#         for i = 1:Ntest
#             for j=1:Nb_basis_fcts
#                     Phitest[j,i] = basis_functions[j](Config_test[i,:])
#             end
#         end
#         Etest_approx = Phitest'*Weights
#
#         #compute the error
#         Linfty_err[ideg,ibf] = maximum(abs.(Etest_approx-Etest_exact))
#         RMSE[ideg,ibf] = sqrt(mean((Etest_approx-Etest_exact).*(Etest_approx-Etest_exact)))
#
#     end
# end
#

# df1 = DataFrame( deg = Deg )
# df1[Symbol("Nb_basis_fcts")] = NB_BASIS_FCTS[:,1];
# for k = 1:length(Basis_fct_list)
#     df1[Symbol(Basis_fct_list[k][2])] = RMSE[1:end,k];
# end
# println("RMSE")
#
# display(df1)

# df2 = DataFrame( deg = Deg )
# df2[Symbol("Nb_basis_fcts")] = NB_BASIS_FCTS[:,1];
# for k = 1:length(Basis_fct_list)
#     df2[Symbol(Basis_fct_list[k][2])] = Linfty_err[1:end,k];
# end
# println("Linfty_error")
#
# display(df2)
#
#
# Q = plot(Deg,RMSE[1:end,1], yscale = :log10, ylabel = "Root Mean Square Error", xlabel = "Polynomial degree",title = "Mean error versus polynomial degree",label = Basis_fct_list[1][2])
#
# for k=2:length(Basis_fct_list)
#     plot!(Deg,RMSE[1:end,k], label = Basis_fct_list[k][2])
# end
# display(Q)
#
# P = plot(NB_BASIS_FCTS[1:end,1],RMSE[1:end,1], yscale = :log10, ylabel = "Root Mean Square Error", xlabel = "Number of basis functions",title = "Mean error versus nb of basis functions",label = Basis_fct_list[1][2])
#
# for k=2:length(Basis_fct_list)
#     plot!(NB_BASIS_FCTS[1:end,1],RMSE[1:end,k], label = Basis_fct_list[k][2])
# end
# display(P)


#=
Functions for constructing noise operators
=#
using SparseArrays

"""
    σ_j(j, n, direction)

Return a sparse matrix representing the Pauli operator on the ``j``-th of ``n`` spins in the computational basis.

`direction` must be `(:x, :y, :z)`
"""
function σ_j(direction::Symbol, j::Int, n::Int)
    @assert direction ∈ (:x, :y, :z) "Direction must be :x, :y, :z"
    @assert j <= n "j must be less or equal than n"

    sigma = Dict(:x => sparse([0im 1.; 1. 0.] ),
        :y => sparse([0. -1im; 1im 0.]),
        :z => sparse([1. 0im; 0. -1.]))

    if n == 1
        return sigma[direction]
    else
        return kron(
            vcat([SparseMatrixCSC{ComplexF64}(I, 2, 2) for i = j + 1:n],
                [sigma[direction]],
                [SparseMatrixCSC{ComplexF64}(I, 2, 2) for i = 1:j-1])...)
    end
end

"""
    σ(direction, n)

Return a sparse matrix representing the collective noise operator
``\\σ_d = \\sum \\σ^{(d)}_j`` where d is the
`direction` and must be one of `(:x, :y, :z)`

# Examples
```jldoctest
julia> full(σ(:x, 1))
2×2 Array{Complex{Float64},2}:
 0.0+0.0im  0.5+0.0im
 0.5+0.0im  0.0+0.0im
```
"""
function σ(direction::Symbol, n::Int)
    σ = spzeros(2^n, 2^n)
    for i = 1:n
        σ += σ_j(direction, i, n)
    end
    return σ
end


module IrrationalConstants

using Base: @irrational

export
    twoπ,       # 2π
    fourπ,      # 4π
    halfπ,      # π / 2
    quartπ,     # π / 4
    invπ,       # 1 / π
    twoinvπ,    # 2 / π
    fourinvπ,   # 4 / π
    inv2π,      # 1 / (2π)
    inv4π,      # 1 / (4π)
    sqrt2,      # √2
    sqrt3,      # √3
    sqrtπ,      # √π
    sqrt2π,     # √2π
    sqrt4π,     # √4π
    sqrthalfπ,  # √(π / 2)
    invsqrt2,   # 1 / √2
    invsqrtπ,   # 1 / √π
    invsqrt2π,  # 1 / √2π
    loghalf,    # log(1 / 2)
    logtwo,     # log(2)
    logten,     # log(10)
    logπ,       # log(π)
    log2π,      # log(2π)
    log4π       # log(4π)

include("stats.jl")

end # module