# Mutation operators
# ==================

# Genetic mutations
# =================

# Binary mutations
# ---------------------

"""
    flip(recombinant)

Returns an in-place mutated binary `recombinant` with a bit flips at random positions.
"""
function flip(
    recombinant::T;
    rng::AbstractRNG = Random.default_rng(),
) where {T<:AbstractVector{Bool}}
    s = length(recombinant)
    pos = rand(rng, 1:s)
    recombinant[pos] = !recombinant[pos]
    return recombinant
end
flip(recombinant::T; rng::AbstractRNG = Random.default_rng(),) where {T<:AbstractIndividual} =
    T(flip(variables(recombinant), rng=rng))

"""
    bitinversion(recombinant)

Returns an in-place mutated binary `recombinant` with its bits inverted.
"""
bitinversion(recombinant::T) where {T<:AbstractVector{Bool}} =
    map!(!, recombinant, recombinant)
bitinversion(recombinant::T) where {T<:AbstractIndividual} =
    T(bitinversion(variables(recombinant)))

# Real-valued mutations
# ---------------------

"""
    uniform(r = 1.0)

Returns an in-place real valued mutation function that performs the uniform distributed mutation [^1].

The mutation operator randomly chooses a number ``z`` in from the uniform distribution on the interval ``[-r,r]``, the mutation range.
The mutated individual is given by

- ``x_i^\\prime = x_i + z_i``

"""
function uniform(r::Real = 1.0)
    function mutation(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:AbstractVector}
        d = length(recombinant)
        recombinant .+= 2r .* rand(rng, d) .- r
        return recombinant
    end
    function mutation(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:AbstractIndividual}
        T(mutation(variables(recombinant), rng=rng))
    end
    return mutation
end

"""
    gaussian(σ = 1.0)

Returns an in-place real valued mutation function that performs the normal distributed mutation [^1].

The mutation operator randomly chooses a number ``z`` in from the normal distribution ``\\mathcal{N}(0,\\sigma)`` with standard deviation ``\\sigma``.
The mutated individual is given by

- ``x_i^\\prime = x_i + z_i``

"""
function gaussian(σ::Real = 1.0)
    function mutation(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:AbstractVector}
        d = length(recombinant)
        recombinant .+= σ .* randn(rng, d)
        return recombinant
    end
    function mutation(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:AbstractIndividual}
        T(mutation(variables(recombinant), rng=rng))
    end
    return mutation
end

"""
    BGA(valrange, m = 20)

Returns an in-place real valued mutation function that performs the BGA mutation scheme with the mutation range `valrange` and the mutation probability `1/m` [^1].
"""
function BGA(valrange::Vector, m::Int = 20)
    prob = 1.0 / m
    function mutation(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:AbstractVector}
        d = length(recombinant)
        @assert length(valrange) == d "Range matrix must have $(d) columns"
        δ = zeros(m)
        for i = 1:length(recombinant)
            for j = 1:m
                δ[j] = (rand(rng) < prob) ? δ[j] = 2.0^(-j) : 0.0
            end
            if rand(rng, Bool)
                recombinant[i] += sum(δ) * valrange[i]
            else
                recombinant[i] -= sum(δ) * valrange[i]
            end
        end
        return recombinant
    end
    function mutation(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:AbstractIndividual}
        T(mutation(variables(recombinant), rng=rng))
    end
    return mutation
end

"""
    PM(lower, upper, p = 2)

Returns an in-place real valued mutation function that performs the Power Mutation (PM)
scheme within `lower` and `upper` bound, and an index of
mutation `p`[^3].

*Note:* The implementation is a degenerate case of Mixed Integer Power Mutation ([`MIPM`](@ref))
"""
function PM(lower::Vector, upper::Vector, p::Float64 = 5.0) # index of distribution p
    return mipmmutation(lower, upper, p)
end

"""
    MIPM(lower, upper, p_real = 10, p_int = 4)

Returns an in-place real valued mutation function that performs the Mixed Integer Power Mutation (MI-PM) scheme within `lower` and `upper` bound, and an index of mutation `p_real` for real value and `p_int` for integer values[^4].
"""
function MIPM(
    lowerBounds::Vector,
    upperBounds::Vector,
    p_real::Float64 = 10.0,
    p_int::Float64 = 4.0,
) # index of distribution p
    return mipmmutation(lowerBounds, upperBounds, p_real, p_int)
end

function mipmmutation(
    lowerBounds::Vector,
    upperBounds::Vector,
    p_real::Float64,
    p_int::Union{Nothing,Float64} = nothing,
)
    function pm_mutation(rng, x, l, u, s, d)
        x̄ = d < rand(rng) ? x - s * (x - l) : x + s * (u - x)
        if isa(x, Integer)
            if isinteger(x̄)
                Int(x̄)
            else
                floor(Int, x̄) + (rand(rng) > 0.5)
            end
        else
            x̄
        end
    end
    function mutation(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:Vector}
        d = length(recombinant)
        @assert length(lowerBounds) == d "Bounds vector must have $(d) columns"
        @assert length(upperBounds) == d "Bounds vector must have $(d) columns"
        @assert !(p_int === nothing && any(isa(x, Integer) for x in recombinant)) "Need to set p_int for integer variables"
        u = rand(rng)
        P = (isa(x, Integer) ? p_int : p_real for x in recombinant)
        S = u .^ (1 ./ P) # random var following power distribution
        D = (recombinant - lowerBounds) ./ (upperBounds - lowerBounds)
        broadcast!(
            (x, l, u, s, d) -> pm_mutation(rng, x, l, u, s, d),
            recombinant,
            recombinant,
            lowerBounds,
            upperBounds,
            S,
            D,
        )
        return recombinant
    end
    function mutation(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:AbstractIndividual}
        T(mutation(variables(recombinant), rng=rng))
    end
    return mutation
end

"""
    PLM(lower, upper, η = 2)

Returns an in-place real valued mutation function that performs the Polynomial Mutation (PLM) scheme
within `lower` and `upper` bounds, and a mutation distribution index `η`[^9].
"""
function PLM(Δ::Union{Real,Vector} = 1.0; η = 2, pm::Real = NaN) # index of distribution p
    function mutation(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:AbstractVector}
        d = length(recombinant)
        pm = isnan(pm) ? 1 / d : pm
        mask = rand(rng, d) .< pm
        u = rand(rng, d)
        mask_p = u .<= 0.5
        mask_n = u .> 0.5
        δpw = 1 / (η + 1)
        δ = similar(recombinant)
        δ[mask_p] .= (2 * u[mask_p]) .^ δpw .- 1
        δ[mask_n] .= 1 .- (2(1 .- u[mask_n])) .^ δpw
        recombinant[mask] .+= (Δ.*δ)[mask]
        return recombinant
    end
    function mutation(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:AbstractIndividual}
        T(mutation(variables(recombinant), rng=rng))
    end
    return mutation
end
PLM(lower::Vector, upper::Vector; η::Real = 2, pm::Real = NaN) =
    PLM(upper - lower; η = η, pm = pm)

# Combinatorial mutations (applicable to binary vectors)
# ------------------------------------------------------

"""
    inversion(recombinant)

Returns an in-place mutated individual with a random arbitrary length segment of the genome in the reverse order.
"""
function inversion(
    recombinant::T;
    rng::AbstractRNG = Random.default_rng(),
) where {T<:AbstractVector}
    l = length(recombinant)
    from, to = randseg(rng, l)
    l = round(Int, (to - from) / 2)
    if from + 1 == to
        swap!(recombinant, from, to)
    else
        for i = 0:(l-1)
            swap!(recombinant, from + i, to - i)
        end
    end
    return recombinant
end
inversion(recombinant::T; rng::AbstractRNG = Random.default_rng(),) where {T<:AbstractIndividual} =
    T(inversion(variables(recombinant), rng = rng))

"""
    insertion(recombinant)

Returns an in-place mutated individual with an arbitrary element of the genome moved in a random position.
"""
function insertion(
    recombinant::T;
    rng::AbstractRNG = Random.default_rng(),
) where {T<:AbstractVector}
    l = length(recombinant)
    from, to = randseg(rng, l)
    val = recombinant[from]
    deleteat!(recombinant, from)
    return insert!(recombinant, to, val)
end
insertion(recombinant::T; rng::AbstractRNG = Random.default_rng(),) where {T<:AbstractIndividual} =
    T(insertion(variables(recombinant), rng = rng))

"""
    swap2(recombinant)

Returns an in-place mutated individual with a two random elements of the genome are swapped.
"""
function swap2(
    recombinant::T;
    rng::AbstractRNG = Random.default_rng(),
) where {T<:AbstractVector}
    l = length(recombinant)
    from, to = randseg(rng, l)
    swap!(recombinant, from, to)
    return recombinant
end
swap2(recombinant::T; rng::AbstractRNG = Random.default_rng(),) where {T<:AbstractIndividual} =
    T(swap2(variables(recombinant), rng = rng))

"""
    scramble(recombinant)

Returns an in-place mutated individual with elements, on a random arbitrary length segment of the genome, been scrambled.
"""
function scramble(
    recombinant::T;
    rng::AbstractRNG = Random.default_rng(),
) where {T<:AbstractVector}
    l = length(recombinant)
    from, to = randseg(rng, l)
    diff = to - from + 1
    if diff > 1
        patch = recombinant[from:to]
        idx = randperm(rng, diff)
        for i = 1:diff
            recombinant[from+i-1] = patch[idx[i]]
        end
    end
    return recombinant
end
scramble(recombinant::T; rng::AbstractRNG = Random.default_rng(),) where {T<:AbstractIndividual} =
    T(scramble(variables(recombinant), rng = rng))

"""
    shifting(recombinant)

Returns an in-place mutated individual with a random arbitrary length segment of the genome been shifted to an arbitrary position.
"""
function shifting(
    recombinant::T;
    rng::AbstractRNG = Random.default_rng(),
) where {T<:AbstractVector}
    l = length(recombinant)
    from, to, where = sort(rand(rng, 1:l, 3))
    patch = recombinant[from:to]
    diff = where - to
    if diff > 0
        # move values after tail of patch to the patch head position
        for i = 1:diff
            recombinant[from+i-1] = recombinant[to+i]
        end
        # place patch values in order
        start = from + diff
        for i = 1:length(patch)
            recombinant[start+i-1] = patch[i]
        end
    end
    return recombinant
end
shifting(recombinant::T; rng::AbstractRNG = Random.default_rng(),) where {T<:AbstractIndividual} =
    T(shifting(variables(recombinant), rng = rng))

"""
    replace(pool,[minchange=1])(recombinant)

Replacement mutation operator changes an arbitrary number, no smaller then `minchange`,
of elements in the individual by replacing them with elements from the predefined `pool` that are not in the individual.
"""
function replace(pool::Vector{P}; minchange = 1) where {P}
    function rplc(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:AbstractVector}
        l = length(recombinant)
        p = length(pool)
        # how many values to change
        nchg = max(minchange, rand(rng, 1:min(l, p - l)))
        # select new elements
        idxs = randperm(rng, p)
        new_vals = P[]
        for i in idxs
            if pool[i] ∉ recombinant
                push!(new_vals, pool[i])
            end
            length(new_vals) == nchg && break
        end
        # update arbitrary positions with new values
        new_idxs = randperm(rng, l)[1:nchg]
        recombinant[new_idxs] .= new_vals
        return recombinant
    end
    function rplc(
        recombinant::T;
        rng::AbstractRNG = Random.default_rng(),
    ) where {T<:AbstractIndividual}
        T(rplc(variables(recombinant), rng = rng))
    end
    return rplc
end

# Differential Evolution
# ======================

"""
    differentiation(recombinant, mutators; F = 1.0)

Returns an in-place differently mutated individual ``x^\\prime`` from `recombinant` ``x``  by `mutators` ``\\{\\xi_1, \\ldots, \\xi_n \\}`` as follows

- ``x^\\prime = x + \\sum_{i=1}^{n/2} F (\\xi_{2i-1} - \\xi_{2i})``

"""
function differentiation!(
    recombinant::AbstractVector,
    mutators::AbstractMatrix;
    F::Real = 1.0,
)
    r, c = size(mutators)
    @assert r == 2 "mutators must be 2"
    recombinant .+= F .* (mutators[1,:] .- mutators[2,:])
    return recombinant
end
differentiation!(recombinant::T, mutators::Vector{T}; F::Real = 1.0,) where {T<:AbstractIndividual} =
    T(differentiation!(variables(recombinant), variables(mutators), F=F))


"""
Direct Stiffness Method
=======================

Plane truss/frame analysis using Direct stiffness method. It currently only supports two types of
beams: truss (both ends are pinned joints) and frame (both ends are fixed joints).

References
----------

- [hibbeler]: Hibbeler, R. C. "Structural Analysis 8th edition." (2012).

"""
module DirectStiffnessMethod

export
    Node, Member,
    JointType, FixedJoint, PinnedJoint, RollerJoint, RollerYJoint, SimpleJoint, FreeJoint,
    EndType, FixedConnection, PinnedConnection, RollerConnection, RollerYConnection,
        SimpleConnection, SimpleYConnection,
    Beam,
    Structure, num_nodes, num_members, node_indices,
    solve

using LinearAlgebra
using SparseArrays

#===== Supports & Connections =====#

"The joint (support) type."
@enum JointType begin
    FixedJoint
    PinnedJoint
    RollerJoint
    RollerYJoint
    SimpleJoint
    FreeJoint
end

"The end (connection) type."
@enum EndType begin
    FixedConnection
    PinnedConnection
    RollerConnection
    RollerYConnection
    SimpleConnection
    SimpleYConnection
end

function join_free_dims(j::JointType)::BitVector
    # The case [1, 1, 0] and [0, 1, 1] (SimpleY) seem very rare in real life.
    if j == FixedJoint
        [0, 0, 0]
    elseif j == PinnedJoint
        [0, 0, 1]
    elseif j == RollerJoint
        [1, 0, 0]
    elseif j == RollerYJoint
        [0, 1, 0]
    elseif j == SimpleJoint
        [1, 0, 1]
    elseif j == FreeJoint
        [1, 1, 1]
    end |> BitVector
end

function end_effective_dims(e::EndType)::BitVector
    # The "Free" connection makes no sense, so it is excluded. The real life connections are mostly
    # "Fixed" and "Pinned".
    if e == FixedConnection
        [1, 1, 1]
    elseif e == PinnedConnection
        [1, 1, 0]
    elseif e == RollerConnection
        [0, 1, 1]
    elseif e == RollerYConnection
        [1, 0, 1]
    elseif e == SimpleConnection
        [0, 1, 0]
    elseif e == SimpleYConnection
        [1, 0, 0]
    end |> BitVector
end

# Both ends must have the same connection type. If one end is pinned and the other is fixed, we
# should use the "condensation method", which has not been implemented here.
function beam_effective_dims(e1::EndType, e2::EndType)::BitVector
    if (e1, e2) == (FixedConnection, FixedConnection)
        [1, 1, 1, 1, 1, 1]
    elseif (e1, e2) == (PinnedConnection, PinnedConnection)
        [1, 0, 0, 1, 0, 0]
    else
        error("unimplemented")
    end |> BitVector
end

#===== Node & Member =====#

"Represents joints, supports, or ends of a member."
struct Node
    id::Int
    x::Float64
    y::Float64
    joint_type::JointType
end

struct Member
    id::Int
    from::Int
    to::Int

    near_end::EndType
    far_end::EndType

    "Young's modulus"
    E::Float64

    "The area"
    A::Float64

    "The area moment of inertia"
    I::Float64
end

#===== Beam =====#

struct Beam
    "The length"
    l::Float64

    "Cosine of the sloping angle"
    λ_x::Float64

    "Sine of the sloping angle"
    λ_y::Float64

    "E * A"
    EA::Float64

    "E * I"
    EI::Float64

    "Effective indices of connection"
    conn_indices::BitVector
end

# Truss beam is treated as a special case of frame beam.
#
#     k_m = EA / l *
#         [
#              1.0    -1.0
#             -1.0     1.0
#         ]
#
#     T =
#     [
#         c       s       0.0     0.0
#         0.0     0.0     c       s
#     ]
#

raw"""
Computes member stiffness matrix $k_m$.

In the local coordinate system, the origin is at the "near" node and X axis extends toward the "far"
node.
"""
function compute_member_k(beam::Beam)::Matrix{Float64}
    l = beam.l
    EA = beam.EA
    EI = beam.EI
    l2 = l * l
    l3 = l * l2

    Symmetric(
        [
            EA / l      0.0         0.0         -EA / l     0.0         0.0
            0.0         12EI / l3   6EI / l2    0.0         -12EI / l3  6EI / l2
            0.0         0.0         4EI / l     0.0         -6EI / l2   2EI / l
            0.0         0.0         0.0         EA / l      0.0         0.0
            0.0         0.0         0.0         0.0         12EI / l3   -6EI / l2
            0.0         0.0         0.0         0.0         0.0         4EI / l
        ],
        :U,
    ) |> Matrix
end

function compute_transform_mat(beam::Beam)::Matrix{Float64}
    (c, s) = (beam.λ_x, beam.λ_y)

    [
        c       s       0.0     0.0     0.0     0.0
        -s      c       0.0     0.0     0.0     0.0
        0.0     0.0     1.0     0.0     0.0     0.0
        0.0     0.0     0.0     c       s       0.0
        0.0     0.0     0.0     -s      c       0.0
        0.0     0.0     0.0     0.0     0.0     1.0
    ]
end

#===== Structure =====#

"Represents a planar structure."
mutable struct Structure
    nodes::Vector{Node}
    members::Vector{Member}
end

@inline function num_nodes(s::Structure)::Int
    length(s.nodes)
end

@inline function num_members(s::Structure)::Int
    length(s.members)
end

function node_indices(node_id::Int)::UnitRange{Int}
    (3 * (node_id - 1) + 1):(3 * node_id)
end

"Creates beams from nodes and members."
function assemble_beam(s::Structure, member_id::Int)::Beam
    mem = s.members[member_id]
    from_node = s.nodes[mem.from]
    to_node = s.nodes[mem.to]

    lx = to_node.x - from_node.x
    ly = to_node.y - from_node.y
    l = sqrt(lx ^ 2 + ly ^ 2)
    λ_x = lx / l
    λ_y = ly / l

    EA = mem.E * mem.A
    EI = mem.E * mem.I

    conn_indices = vcat(end_effective_dims(mem.near_end), end_effective_dims(mem.far_end))
    Beam(l, λ_x, λ_y, EA, EI, conn_indices)
end

raw"""
Computes member global stiffness matrix $k$.
"""

function compute_global_k(
    beam::Beam,
    near_end::EndType=FixedConnection,
    far_end::EndType=FixedConnection,
)::Matrix{Float64}
    # - Displacement transformation matrix `T`, which transforms global displacements to local
    #   displacements.
    # - Member stiffness matrix `k_m`, which transforms local displacements to local forces.
    # - Displacement transformation matrix `T'`, which transforms local forces to global forces.
    #
    # k = T' * k_m * T

    k_m = compute_member_k(beam)
    T = compute_transform_mat(beam)
    selection = beam_effective_dims(near_end, far_end)
    T' * (selection .* k_m * T)
end

raw"""
Assembles structure stiffness matrix $K$.
"""
function assemble_struct_k(s::Structure)::SparseMatrixCSC{Float64}
    n_nodes = num_nodes(s)
    n_members = num_members(s)
    K = sparse([], [], Float64[], 3n_nodes, 3n_nodes)
    for i in 1:n_members
        mem = s.members[i]

        b = assemble_beam(s, i)
        k = compute_global_k(b, mem.near_end, mem.far_end)

        from_node = mem.from
        to_node = mem.to
        indices = [node_indices(from_node); node_indices(to_node)]

        K_view = @view K[indices, indices]
        ix = b.conn_indices
        K_view[ix, ix] .+= k[ix, ix]
    end
    K
end

function free_displacement_indices(s::Structure)::BitVector
    n_nodes = num_nodes(s)
    free_ix = BitVector(undef, 3 * n_nodes)
    for i in 1:n_nodes
        ix = node_indices(i)
        free_ix[ix] = join_free_dims(s.nodes[i].joint_type)
    end
    free_ix
end

#=

The structure stiffness equation (Subscript `k`: known variable; `u`: unknown variable):

    [ f_k     [ K_11 K_12     [ d_u
      f_u ] =   K_21 K_22 ] *   d_k ]

`d_k` is usually 0.

    d_u = K_11^{-1} f_k
    f_u = K_21 d_u

=#

function solve(
    s::Structure,
    loads::AbstractVector{Float64}
)::Tuple{SparseVector{Float64}, SparseVector{Float64}}
    free_disp_ix = free_displacement_indices(s)
    unknown_force_ix = .!free_disp_ix

    K = assemble_struct_k(s)
    K_11 = K[free_disp_ix, free_disp_ix]
    d_u = qr(K_11) \ Vector(loads[free_disp_ix])
    K_21 = K[unknown_force_ix, free_disp_ix]
    f_u = K_21 * d_u

    n_dims = length(free_disp_ix)
    d = sparsevec((1:n_dims)[free_disp_ix], d_u, n_dims)
    f = sparsevec((1:n_dims)[unknown_force_ix], f_u, n_dims)
    (d, f)
end

end # module


#=  ======================
    LINEAR REGRESSOR (OLS)
    ====================== =#

@with_kw_noshow mutable struct LinearRegressor <: MLJBase.Deterministic
    fit_intercept::Bool    = true
    solver::Option{Solver} = nothing
end

glr(m::LinearRegressor) = LinearRegression(fit_intercept=m.fit_intercept)

descr(::Type{LinearRegressor}) = "Regression with objective function ``|Xθ - y|₂²/2``."

#=  ===============
    RIDGE REGRESSOR
    =============== =#

@with_kw_noshow mutable struct RidgeRegressor <: MLJBase.Deterministic
    lambda::Real             = 1.0
    fit_intercept::Bool      = true
    penalize_intercept::Bool = false
    solver::Option{Solver}   = nothing
end

glr(m::RidgeRegressor) = RidgeRegression(m.lambda, fit_intercept=m.fit_intercept,
                                         penalize_intercept=m.penalize_intercept)

descr(::Type{RidgeRegressor}) = "Regression with objective function ``|Xθ - y|₂²/2 + λ|θ|₂²/2``."

#=  ===============
    LASSO REGRESSOR
    =============== =#

@with_kw_noshow mutable struct LassoRegressor <: MLJBase.Deterministic
    lambda::Real             = 1.0
    fit_intercept::Bool      = true
    penalize_intercept::Bool = false
    solver::Option{Solver}   = nothing
end

glr(m::LassoRegressor) = LassoRegression(m.lambda, fit_intercept=m.fit_intercept,
                                         penalize_intercept=m.penalize_intercept)

descr(::Type{LassoRegressor}) = "Regression with objective function ``|Xθ - y|₂²/2 + λ|θ|₁``."

#=  =====================
    ELASTIC NET REGRESSOR
    ===================== =#

@with_kw_noshow mutable struct ElasticNetRegressor <: MLJBase.Deterministic
    lambda::Real             = 1.0
    gamma::Real              = 0.0
    fit_intercept::Bool      = true
    penalize_intercept::Bool = false
    solver::Option{Solver}   = nothing
end

glr(m::ElasticNetRegressor) = ElasticNetRegression(m.lambda, m.gamma,
                                                   fit_intercept=m.fit_intercept,
                                                   penalize_intercept=m.penalize_intercept)

descr(::Type{ElasticNetRegressor}) = "Regression with objective function ``|Xθ - y|₂²/2 + λ|θ|₂²/2 + γ|θ|₁``."

#=  ==========================
    ROBUST REGRESSOR (General)
    ========================== =#

@with_kw_noshow mutable struct RobustRegressor <: MLJBase.Deterministic
    rho::RobustRho           = HuberRho(0.1)
    lambda::Real             = 1.0
    gamma::Real              = 0.0
    penalty::Symbol          = :l2
    fit_intercept::Bool      = true
    penalize_intercept::Bool = false
    solver::Option{Solver}   = nothing
end

glr(m::RobustRegressor) = RobustRegression(m.rho, m.lambda, m.gamma; penalty=m.penalty,
                                           fit_intercept=m.fit_intercept,
                                           penalize_intercept=m.penalize_intercept)

descr(::Type{RobustRegressor}) = "Robust regression with objective ``∑ρ(Xθ - y) + λ|θ|₂² + γ|θ|₁`` for a given robust `ρ`."

#=  ===============
    HUBER REGRESSOR
    =============== =#

@with_kw_noshow mutable struct HuberRegressor <: MLJBase.Deterministic
    delta::Real              = 0.5
    lambda::Real             = 1.0
    gamma::Real              = 0.0
    penalty::Symbol          = :l2
    fit_intercept::Bool      = true
    penalize_intercept::Bool = false
    solver::Option{Solver}   = nothing
end

glr(m::HuberRegressor) = HuberRegression(m.delta, m.lambda, m.gamma; penalty=m.penalty,
                                         fit_intercept=m.fit_intercept,
                                         penalize_intercept=m.penalize_intercept)

descr(::Type{HuberRegressor}) = "Robust regression with objective ``∑ρ(Xθ - y) + λ|θ|₂² + γ|θ|₁`` where `ρ` is the Huber Loss."

#=  ==================
    QUANTILE REGRESSOR
    ================== =#

@with_kw_noshow mutable struct QuantileRegressor <: MLJBase.Deterministic
    delta::Real              = 0.5
    lambda::Real             = 1.0
    gamma::Real              = 0.0
    penalty::Symbol          = :l2
    fit_intercept::Bool      = true
    penalize_intercept::Bool = false
    solver::Option{Solver}   = nothing
end

glr(m::QuantileRegressor) = QuantileRegression(m.delta, m.lambda, m.gamma; penalty=m.penalty,
                                               fit_intercept=m.fit_intercept,
                                               penalize_intercept=m.penalize_intercept)

descr(::Type{QuantileRegressor}) = "Robust regression with objective ``∑ρ(Xθ - y) + λ|θ|₂² + γ|θ|₁`` where `ρ` is the Quantile Loss."

#=  ==================================
    LEAST ABSOLUTE DEVIATION REGRESSOR
    ================================== =#

@with_kw_noshow mutable struct LADRegressor <: MLJBase.Deterministic
    lambda::Real             = 1.0
    gamma::Real              = 0.0
    penalty::Symbol          = :l2
    fit_intercept::Bool      = true
    penalize_intercept::Bool = false
    solver::Option{Solver}   = nothing
end

glr(m::LADRegressor) = LADRegression(m.lambda, m.gamma; penalty=m.penalty,
                                     fit_intercept=m.fit_intercept,
                                     penalize_intercept=m.penalize_intercept)

descr(::Type{LADRegressor}) = "Robust regression with objective ``∑ρ(Xθ - y) + λ|θ|₂² + γ|θ|₁`` where `ρ` is the Absolute Loss."


module SBTestBoundaries

using SpatialBoundaries
using Test

A = fill(1.0, 10, 12)
W = wombling(A)
@test all(W.m .== zero(eltype(W.m)))
@test all(W.θ .== zero(eltype(W.θ)))
B = boundaries(W)
@test length(B) == prod(size(A).-1)

A[4, 8] = 5.0
A[5, 8] = 5.0
W = wombling(A)
B = boundaries(W; threshold=0.03)
@test length(B) == 5

A = rand(Float64, 10, 10)
n = rand(eachindex(A), 10)
A[n] .= NaN
W = wombling(A)
B = boundaries(W)
@test !any(map(isnan, W.m[B]))

end


module TimeOfDay_tests

export
  millisInOneSecond,
  microsInOnSecond,
  nanosInOneSecond,
  nanosInOneMilli,
  nanosInOneMicro,
  secondsInOneMinute,
  secondsInOneHour,
  secondsInOneDay,
  nanosInOneMinute,
  nanosInOneHour,
  nanosInOneDay,
  TimeOfDay,
  NegativeTimeOfDayError

const millisInOneSecond = Int64(1e3)
const microsInOnSecond = Int64(1e6)
const nanosInOneSecond = Int64(1e9)
const nanosInOneMilli = Int64(1e6)
const nanosInOneMicro = Int64(1e3)
const secondsInOneMinute = Int64(60)
const secondsInOneHour = Int64(3600)
const secondsInOneDay = secondsInOneHour * Int64(24)
const nanosInOneMinute = nanosInOneSecond * secondsInOneMinute
const nanosInOneHour = nanosInOneSecond * secondsInOneHour
const nanosInOneDay = nanosInOneSecond * secondsInOneDay

type NegativeTimeOfDayError{T} <: Exception
  val::T
end

immutable TimeOfDay <: Number
  nanosSinceMidnight::Int64

  function TimeOfDay{T<:Number}(val::T)
    rv = round(Int64, val)
    if (rv < 0)
      throw(NegativeTimeOfDayError(val))
    end
    new(rv)
  end
end

function TimeOfDay(str::AbstractString)
  tmp = split(str,":")
  minutes = 0
  seconds = 0
  nanos = 0

  hours = parse(Int64, tmp[1])
  if length(tmp) > 1
    minutes = parse(Int64, tmp[2])
  end

  if length(tmp) > 2
    tmp2 = split(tmp[3], ".")
    seconds = parse(Int64, tmp2[1])
    if length(tmp2) > 1
      nanos = parse(Int64, rpad(tmp2[2],9,"0")[1:9])
    end
  end

  TimeOfDay(hours * nanosInOneHour + minutes * nanosInOneMinute + seconds * nanosInOneSecond + nanos)
end

function Base.string(timeOfDay::TimeOfDay)
  secsSinceMidnight, nanos = divrem(timeOfDay.nanosSinceMidnight, nanosInOneSecond)
  hours, hourrem = divrem(secsSinceMidnight, secondsInOneHour)
  minutes, seconds = divrem(hourrem, secondsInOneMinute)
  microseconds = div(nanos, millisInOneSecond)
  string(lpad(hours,2,"0"), ":", lpad(minutes,2,"0"), ":", lpad(seconds,2,"0"), ".", lpad(microseconds,6,"0"))
end
Base.print(io::IO, time::TimeOfDay) = print(io, string(time))
Base.show(io::IO, time::TimeOfDay) = print(io, string(time))

# define how numbers get promoted to TimeOfDay
Base.promote_rule{T<:Real}(::Type{TimeOfDay}, ::Type{T}) = TimeOfDay
Base.convert(::Type{TimeOfDay}, str::AbstractString) = TimeOfDay(str)
Base.convert(::Type{TimeOfDay}, x::Real) = TimeOfDay(x)
Base.convert{T<:Number}(::Type{T}, x::TimeOfDay) = T(x.nanosSinceMidnight)

# now for each op, we define the op between TimeOfDay's, then the generic "promote" version of the op will handle conversion
Base.typemin(::Type{TimeOfDay}) = TimeOfDay(0)
Base.typemax(::Type{TimeOfDay}) = TimeOfDay(typemax(Int64))

for op in (:<, :>, :(==), :<=, :>=, :(Base.isless))
  @eval $op(t1::TimeOfDay, t2::TimeOfDay) = $op(t1.nanosSinceMidnight, t2.nanosSinceMidnight)
end
for op in (:+, :-, :(Base.rem))
  @eval $op(t1::TimeOfDay, t2::TimeOfDay) = TimeOfDay($op(t1.nanosSinceMidnight, t2.nanosSinceMidnight))
end

# some helpers for creating ranges of the form "timestart:timestep:timestop"
Base.colon(start::TimeOfDay, step::TimeOfDay, stop::TimeOfDay) = map(TimeOfDay, start.nanosSinceMidnight : step.nanosSinceMidnight : stop.nanosSinceMidnight)
Base.colon(start::TimeOfDay, step::Number, stop::TimeOfDay) = colon(start, TimeOfDay(step), stop)

iszero(t::TimeOfDay) = t.nanosSinceMidnight == 0

using FactCheck

facts("TimeOfDay") do
  @fact TimeOfDay("10") => 10 * nanosInOneHour
  @fact TimeOfDay("10:30") => 10 * nanosInOneHour + 30 * nanosInOneMinute
  @fact TimeOfDay("10:30:05") => 10 * nanosInOneHour + 30 * nanosInOneMinute + 5 * nanosInOneSecond
  @fact TimeOfDay("10:30:05.00001") => 10 * nanosInOneHour + 30 * nanosInOneMinute + 5 * nanosInOneSecond + 10 * nanosInOneMicro

  t = TimeOfDay("10:30:05")
  buf = IOBuffer()
  print(buf, t)
  @fact bytestring(buf) => "10:30:05.000000"

  tdiff = TimeOfDay(nanosInOneMinute)
  trange = t : tdiff : t + 5 * nanosInOneMinute
  @fact length(trange) => 6
  @fact trange[2] => TimeOfDay("10:31:05")

  @fact iszero(TimeOfDay(0)) => true
  @fact iszero(TimeOfDay(1)) => false
  @fact_throws TimeOfDay(-1)
end

end # module
tod = TimeOfDay_tests


"""
    BinomialExpert(n, p)

PMF:

```math
P(X = k) = {n \\choose k}p^k(1-p)^{n-k},  \\quad \\text{ for } k = 0,1,2, \\ldots, n.
```

See also: [Binomial Distribution](https://en.wikipedia.org/wiki/Binomial_distribution) (Wikipedia)

"""
struct BinomialExpert{T<:Real} <: NonZIDiscreteExpert
    n::Int
    p::T
    BinomialExpert{T}(n, p) where {T<:Real} = new{T}(n, p)
end

function BinomialExpert(n::Integer, p::T; check_args=true) where {T <: Real}
    check_args && @check_args(BinomialExpert, 0 <= p <= 1 && isa(n, Integer))
    return BinomialExpert{T}(n, p)
end

## Outer constructors
# BinomialExpert(n::Integer, p::Real) = BinomialExpert(n, float(p))
BinomialExpert(n::Integer, p::Integer) = BinomialExpert(n, float(p))
BinomialExpert() = BinomialExpert(2, 0.50)

## Conversion
function convert(::Type{BinomialExpert{T}}, n::Int, p::S) where {T <: Real, S <: Real}
    BinomialExpert(n, T(p))
end
function convert(::Type{BinomialExpert{T}}, d::BinomialExpert{S}) where {T <: Real, S <: Real}
    BinomialExpert(d.n, T(d.p), check_args=false)
end
copy(d::BinomialExpert) = BinomialExpert(d.n, d.p, check_args=false)

## Loglikelihood of Expoert
logpdf(d::BinomialExpert, x...) = isinf(x...) ? 0.0 : Distributions.logpdf.(Distributions.Binomial(d.n, d.p), x...)
pdf(d::BinomialExpert, x...) = isinf(x...) ? -Inf : Distributions.pdf.(Distributions.Binomial(d.n, d.p), x...)
logcdf(d::BinomialExpert, x...) = isinf(x...) ? 0.0 : Distributions.logcdf.(Distributions.Binomial(d.n, d.p), x...)
cdf(d::BinomialExpert, x...) = isinf(x...) ? 1.0 : Distributions.cdf.(Distributions.Binomial(d.n, d.p), x...)

## expert_ll, etc
expert_ll_exact(d::BinomialExpert, x::Real) = LRMoE.logpdf(d, x)
function expert_ll(d::BinomialExpert, tl::Real, yl::Real, yu::Real, tu::Real)
    expert_ll = (yl == yu) ? logpdf.(d, yl) : logcdf.(d, yu) + log1mexp.(logcdf.(d, ceil.(yl) .- 1) - logcdf.(d, yu))
    return expert_ll
end
function expert_tn(d::BinomialExpert, tl::Real, yl::Real, yu::Real, tu::Real)
    expert_tn = (tl == tu) ? logpdf.(d, tl) : logcdf.(d, tu) + log1mexp.(logcdf.(d, ceil.(tl) .- 1) - logcdf.(d, tu))
    return expert_tn
end
function expert_tn_bar(d::BinomialExpert, tl::Real, yl::Real, yu::Real, tu::Real)
    expert_tn_bar = (tl == tu) ? log1mexp.(logpdf.(d, tl)) : log1mexp.(logcdf.(d, tu) + log1mexp.(logcdf.(d, ceil.(tl) .- 1) - logcdf.(d, tu)))
    return expert_tn_bar
end

exposurize_expert(d::BinomialExpert; exposure = 1) = d

## Parameters
params(d::BinomialExpert) = (d.n, d.p)
function params_init(y, d::BinomialExpert)
    n_init = Int(maximum(vec(y))) + 2
    p_init = mean(y) / n_init
    try
        return BinomialExpert(n_init, p_init)
    catch;
        return BinomialExpert()
    end
end

## Simululation
sim_expert(d::BinomialExpert) = Distributions.rand(Distributions.Binomial(d.n, d.p), 1)[1]

## penalty
penalty_init(d::BinomialExpert) = []
no_penalty_init(d::BinomialExpert) = []
penalize(d::BinomialExpert, p) = 0.0

## statistics
mean(d::BinomialExpert) = mean(Distributions.Binomial(d.n, d.p))
var(d::BinomialExpert) = var(Distributions.Binomial(d.n, d.p))
quantile(d::BinomialExpert, p) = quantile(Distributions.Binomial(d.n, d.p), p)

## Misc functions for E-Step

function _sum_densy_series(d::BinomialExpert, yl, yu)
    if isinf(yu)
        series = 0:(max(yl-1, 0))
        return d.n*d.p - sum(pdf.(d, series) .* series)[1]
    else
        series = yl:(min(yu, d.n))
        return sum(pdf.(d, series) .* series)[1]
    end
end

function _int_obs_Y_raw(d::BinomialExpert, yl, yu)
    return _sum_densy_series(d, yl, yu)
end

function _int_lat_Y_raw(d::BinomialExpert, tl, tu)
    return max(d.n*d.p - _sum_densy_series(d, tl, tu), 0)
end

## EM: M-Step
function EM_M_expert(d::BinomialExpert,
                    tl, yl, yu, tu,
                    exposure,
                    z_e_obs, z_e_lat, k_e;
                    penalty = true, pen_pararms_jk = [2.0 1.0])

    # Not affected by Exposurize
    expert_ll_pos = expert_ll.(d, tl, yl, yu, tu)
    expert_tn_bar_pos = expert_tn_bar.(d, tl, yl, yu, tu)

    # Further E-Step
    yl_yu_unique = unique_bounds(yl, yu)
    int_obs_Y_tmp = _int_obs_Y_raw.(d, yl_yu_unique[:,1], yl_yu_unique[:,2])
    Y_e_obs = exp.(-expert_ll_pos) .* int_obs_Y_tmp[match_unique_bounds(hcat(vec(yl), vec(yu)), yl_yu_unique)]
    nan2num(Y_e_obs, 0.0) # get rid of NaN
    inf2num(Y_e_obs, 0.0) # get rid of inf

    tl_tu_unique = unique_bounds(tl, tu)
    int_lat_Y_tmp = _int_lat_Y_raw.(d, tl_tu_unique[:,1], tl_tu_unique[:,2])
    Y_e_lat = exp.(-expert_tn_bar_pos) .* int_lat_Y_tmp[match_unique_bounds(hcat(vec(tl), vec(tu)), tl_tu_unique)]
    nan2num(Y_e_lat, 0.0) # get rid of NaN
    inf2num(Y_e_lat, 0.0) # get rid of inf

    # Update parameters
    term_zkz_Y = (z_e_obs .* Y_e_obs) .+ (z_e_lat .* k_e .* Y_e_lat)
    term_zkz_n_Y = (z_e_obs .* (d.n .- Y_e_obs)) .+ (z_e_lat .* k_e .* (d.n .- Y_e_lat))

    p_new = sum(term_zkz_Y)[1] / (sum(term_zkz_Y)[1] + sum(term_zkz_n_Y)[1])

    # Deal with zero mass
    if ((1-p_new)^d.n > 0.999999) || (isnan((1-p_new)^d.n))
        p_new = d.p
    end

    return BinomialExpert(d.n, p_new)

end

## EM: M-Step, exact observations
function EM_M_expert_exact(d::BinomialExpert,
                    ye, exposure,
                    z_e_obs;
                    penalty = true, pen_pararms_jk = [Inf 1.0 Inf])

    # Update parameters
    term_zkz_Y = z_e_obs .* ye
    term_zkz_n_Y = z_e_obs .* (d.n .- ye)

    p_new = sum(term_zkz_Y)[1] / (sum(term_zkz_Y)[1] + sum(term_zkz_n_Y)[1])

    # Deal with zero mass
    if (1-p_new)^d.n > 0.999999 || (isnan((1-p_new)^d.n))
        p_new = d.p
    end

    return BinomialExpert(d.n, p_new)

end


# ------------------------------------------------------------------------------
#
#  Gmsh Python tutorial 16
#
#  Constructive Solid Geometry, OpenCASCADE geometry kernel
#
# ------------------------------------------------------------------------------
# Instead of constructing a model in a bottom-up fashion with Gmsh's built-in
# geometry kernel, starting with version 3 Gmsh allows you to directly use
# alternative geometry kernels. Here we will use the OpenCASCADE kernel.
import gmsh

gmsh.initialize()

gmsh.model.add("t16")

# Let's build the same model as in `t5.py', but using constructive solid
# geometry.
# We first create two cubes:
gmsh.model.occ.addBox(0,0,0, 1,1,1, 1)
gmsh.model.occ.addBox(0,0,0, 0.5,0.5,0.5, 2)
# We apply a boolean difference to create the "cube minus one eigth" shape:
gmsh.model.occ.cut([(3,1)], [(3,2)], 3)

# Boolean operations with OpenCASCADE always create new entities. By default the
# extra arguments `removeObject' and `removeTool' in `cut()' are set to `True',
# which will delete the original entities.

# We then create the five spheres:
x = 0; y = 0.75; z = 0; r = 0.09

holes = []
for t in 1:5
    global x, z
    x += 0.166
    z += 0.166
    gmsh.model.occ.addSphere(x,y,z,r, 3 + t)
    t = (3, 3 + t)
    push!(holes, t)
end

# If we had wanted five empty holes we would have used `cut()' again. Here we
# want five spherical inclusions, whose mesh should be conformal with the mesh
# of the cube: we thus use `fragment()', which intersects all volumes in a
# conformal manner (without creating duplicate interfaces):
ov = gmsh.model.occ.fragment([(3,3)], holes)
gmsh.model.occ.synchronize()

# Creating entities using constructive solid geometry is very powerful, but can
# lead to practical issues for e.g. setting mesh sizes at points, or identifying
# boundaries.

# To identify points or other bounding entities you can take advantage of the
# `getEntities()', `getBoundary()' and `getEntitiesInBoundingBox()' functions:
lcar1 = .1
lcar2 = .0005
lcar3 = .055

# Assign a mesh size to all the points:
ov = gmsh.model.getEntities(0);
gmsh.model.mesh.setSize(ov, lcar1);

# Override this constraint on the points of the five spheres:
ov = gmsh.model.getBoundary(holes, false, false, true);
gmsh.model.mesh.setSize(ov, lcar3);

# Select the corner point by searching for it geometrically:
eps = 1e-3
ov = gmsh.model.getEntitiesInBoundingBox(0.5-eps, 0.5-eps, 0.5-eps,
                                         0.5+eps, 0.5+eps, 0.5+eps, 0)
gmsh.model.mesh.setSize(ov, lcar2)

gmsh.model.mesh.generate(3)

gmsh.write("t16.msh")

gmsh.finalize()


# Additive Kernel References

composition_classes = (
    ExponentialClass,
    GammaExponentialClass,
    RationalClass,
    GammaRationalClass,
    MaternClass,
    ExponentiatedClass,
    PolynomialClass,
    PowerClass,
    LogClass,
    GammaLogClass,
    SigmoidClass
)

additive_kernels = (
    SquaredDistanceKernel,
    SineSquaredKernel,
    ChiSquaredKernel,
    ScalarProductKernel
)

composition_pairs = Dict(
    ExponentialClass      => Dict(SquaredDistanceKernel=>true, SineSquaredKernel=>true,
                                  ChiSquaredKernel=>true),
    GammaExponentialClass => Dict(SquaredDistanceKernel=>true, SineSquaredKernel=>true,
                                  ChiSquaredKernel=>true),
    RationalClass         => Dict(SquaredDistanceKernel=>true, SineSquaredKernel=>true,
                                  ChiSquaredKernel=>true),
    GammaRationalClass    => Dict(SquaredDistanceKernel=>true, SineSquaredKernel=>true,
                                  ChiSquaredKernel=>true),
    MaternClass           => Dict(SquaredDistanceKernel=>true, SineSquaredKernel=>true,
                                  ChiSquaredKernel=>true),
    ExponentiatedClass    => Dict(ScalarProductKernel=>true),
    PolynomialClass       => Dict(ScalarProductKernel=>true),
    PowerClass            => Dict(SquaredDistanceKernel=>true, SineSquaredKernel=>true,
                                  ChiSquaredKernel=>true),
    LogClass              => Dict(SquaredDistanceKernel=>true, SineSquaredKernel=>true,
                                  ChiSquaredKernel=>true),
    GammaLogClass         => Dict(SquaredDistanceKernel=>true, SineSquaredKernel=>true,
                                  ChiSquaredKernel=>true),
    SigmoidClass          => Dict(ScalarProductKernel=>true)
)

all_default_args = Dict(
    SquaredDistanceKernel => ([], Int[]),
    SineSquaredKernel     => ([π], Int[]),
    ChiSquaredKernel      => ([], Int[]),
    ScalarProductKernel   => ([], Int[]),
    ExponentialClass      => ([1,], Int[]),
    GammaExponentialClass => ([1,0.5],  Int[]),
    RationalClass         => ([1,1], Int[]),
    GammaRationalClass    => ([1,1,0.5], Int[]),
    MaternClass           => ([1,1], Int[]),
    ExponentiatedClass    => ([1,0], Int[]),
    PolynomialClass       => ([1,1], Int[3]),
    PowerClass            => ([1,0,1], Int[]),
    LogClass              => ([1,], Int[]),
    GammaLogClass         => ([1,0.5], Int[]),
    SigmoidClass          => ([1,0], Int[])
)

all_phifunctions = Dict(
    SquaredDistanceKernel => (x,y)     -> ((x-y)^2),
    SineSquaredKernel     => (p,x,y)   -> (sin(p*(x-y))^2),
    ChiSquaredKernel      => (x,y)     -> (x == y == 0) ? zero(typeof(x)) : ((x-y)^2/(x+y)),
    ScalarProductKernel   => (x,y)     -> x*y,
    ExponentialClass      => (α,z)     -> exp(-α*z^γ),
    GammaExponentialClass => (α,γ,z)   -> exp(-α*z^γ),
    RationalClass         => (α,β,z)   -> (1 + α*z)^(-β),
    GammaRationalClass    => (α,β,γ,z) -> (1 + α*z^γ)^(-β),
    MaternClass           => (ν,θ,z)   -> begin
                                              v1 = sqrt(2*ν) * z / θ
                                              v1 = v1 < eps(typeof(z)) ? eps(typeof(z)) : v1
                                              2*(v1/2)^ν * besselk(ν,v1)/gamma(ν)
                                          end,
    ExponentiatedClass    => (a,c,z)   -> exp(a*z+c),
    PolynomialClass       => (a,c,d,z) -> (a*z+c)^d,
    PowerClass            => (a,c,γ,z) -> (a*z+c)^γ,
    LogClass              => (α,z)     -> log(α*z+1),
    GammaLogClass         => (α,γ,z)   -> log(α*z^γ+1),
    SigmoidClass          => (a,c,z)   -> tanh(a*z+c)

)

all_kernelproperties = Dict( #|mercer |negdef |neg    |zero   |pos
    SineSquaredKernel =>      (false,  true,   false,  true,   true),
    ExponentiatedClass =>     (true,   false,  false,  false,  true),
    ScalarProductKernel =>    (true,   false,  true,   true,   true),
    SquaredDistanceKernel =>  (false,  true,   false,  true,   true),
    SigmoidClass =>           (false,  false,  true,   true,   true),
    ExponentialClass =>       (true,   false,  false,  false,  true),
    GammaLogClass =>          (false,  true,   false,  true,   true),
    GammaRationalClass =>     (true,   false,  false,  false,  true),
    LogClass =>               (false,  true,   false,  true,   true),
    MaternClass =>            (true,   false,  false,  false,  true),
    PolynomialClass =>        (true,   false,  true,   true,   true),
    PowerClass =>             (false,  true,   false,  true,   true),
    GammaExponentialClass =>  (true,   false,  false,  false,  true),
    ChiSquaredKernel =>       (false,  true,   false,  true,   true),
    RationalClass =>          (true,   false,  false,  false,  true)
 )

composition_kernels = (
    GaussianKernel,
    SquaredExponentialKernel,
    RadialBasisKernel,
    LaplacianKernel,
    PeriodicKernel,
    RationalQuadraticKernel,
    MaternKernel,
    MatérnKernel,
    PolynomialKernel,
    LinearKernel,
    SigmoidKernel
)

#=
all_test_args = Dict(
    SquaredDistanceKernel  => ([:t],[1],[0.5]),
    SineSquaredKernel      => ([:p, :t],[π,1],[2π,0.5]),
    ChiSquaredKernel       => ([:t],[1],[0.5]),
    ScalarProductKernel    => (Symbol[], Int[], Int[]),
    GammaExponentialClass  => ([:alpha, :gamma], [1,0.5], [2,1]),
    ExponentialClass       => ([:alpha], [1,], [2,]),
    GammaRationalClass     => ([:alpha, :beta, :gamma], [1,1,0.5], [2,2,1]),
    RationalClass          => ([:alpha, :beta], [1,1], [2,2]),
    MaternClass            => ([:nu, :theta], [1,1], [2,2]),
    ExponentiatedClass     => ([:a, :c], [1,0], [2,1]),
    PolynomialClass        => ([:a, :c, :d], [1,1,2], [2,2,3]),
    PowerClass             => ([:a, :c, :gamma], [1,0,1], [2,1,0.5]),
    GammaLogClass          => ([:alpha, :gamma], [1,0.5], [2,1]),
    LogClass               => ([:alpha], [1,], [2,]),
    SigmoidClass           => ([:a, :c], [1, 0], [2, 1])
)

all_testinputs = Dict(
    SquaredDistanceKernel  => ([1,1],[1,0],[0,1],[0,0],[-1,-1],[-1,0],[0,-1]),
    SineSquaredKernel      => ([1,1],[1,0],[0,1],[0,0],[-1,-1],[-1,0],[0,-1]),
    ChiSquaredKernel       => ([1,1],[1,0],[0,1],[0,0],[2,1],[1,2],[2,0],[0,2]),
    ScalarProductKernel    => ([1,1],[1,0],[0,1],[0,0],[-1,-1],[-1,0],[0,-1]),
    ExponentialClass       => ([0],[1e-10],[0.5],[1]),
    RationalClass => ([0],[1e-10],[0.5],[1]),
    MaternClass            => ([0],[1e-10],[0.5],[1]),
    PowerClass             => ([0],[1e-10],[0.5],[1]),
    LogClass               => ([0],[1e-10],[0.5],[1]),
    PolynomialClass        => ([0],[1e-10],[0.5],[1],[-1e-10],[-0.5],[-1]),
    ExponentiatedClass     => ([0],[1e-10],[0.5],[1],[-1e-10],[-0.5],[-1]),
    SigmoidClass           => ([0],[1e-10],[0.5],[1],[-1e-10],[-0.5],[-1])

)

all_phicases = Dict(
    SquaredDistanceKernel  => ([0.25],[0.5],[1]),
    SineSquaredKernel      => ([π,0.25],[π,0.5],[π,1]),
    ChiSquaredKernel       => ([0.25],[0.5],[1]),
    ScalarProductKernel    => (Int[],),
    ExponentialClass       => ([1,1], [1,0.5]),
    RationalClass => ([1,1,1], [1,1,0.5], [1,2,1], [2,2,0.5]),
    MaternClass            => ([1,1], [2,1]),
    PowerClass             => ([1,0,0.5], [1,0,1]),
    LogClass               => ([1,0.5], [1,1]),
    PolynomialClass        => ([1,1,2],[1,1,1]),
    ExponentiatedClass     => ([1,0],),
    SigmoidClass           => ([1,1],)
)

all_errorcases = Dict(
    SquaredDistanceKernel  => ([1.1], [0]),
    SineSquaredKernel      => ([π,1.1], [π,0], [0,1]),
    ChiSquaredKernel       => ([1.1], [0]),
    ExponentialClass       => ([0,1], [1,1.1], [1,0]),
    RationalClass => ([0,1,1], [1,0,1], [1,1,0], [1,1,1.1]),
    MaternClass            => ([1,0], [0,1]),
    PowerClass             => ([0,1,1], [0,-1,1], [1,0,0], [1,0,1.1]),
    LogClass               => ([0,1], [1,0], [1,1.1]),
    PolynomialClass        => ([0,1,1],[1,-0.1,1],[1,1,1.5],[1,1,0]),
    ExponentiatedClass     => ([0],),
    SigmoidClass           => ([0,1],[1,-0.1])
)

=#


"""
    μ ± σ

Creates $DEFAUL_NUM_PARTICLES `Particles` with mean `μ` and std `σ`.
If `μ` is a vector, the constructor `MvNormal` is used, and `σ` is thus treated as std if it's a scalar, and variances if it's a matrix or vector.
"""
±(μ::Real,σ) = μ + σ*Particles(DEFAUL_NUM_PARTICLES)
±(μ::AbstractVector,σ) = Particles(DEFAUL_NUM_PARTICLES, MvNormal(μ, σ))
∓(μ::Real,σ) = μ + σ*StaticParticles(DEFAUL_STATIC_NUM_PARTICLES)
∓(μ::AbstractVector,σ) = StaticParticles(DEFAUL_STATIC_NUM_PARTICLES, MvNormal(μ, σ))

(..)(a,b) = Particles(DEFAUL_NUM_PARTICLES, Uniform(a,b))

"""
    ⊗(μ,σ) = outer_product(Normal.(μ,σ))

See also `outer_product`
"""
⊗(μ,σ) = outer_product(Normal.(μ,σ))

"""
    p = outer_product(dists::Vector{<:Distribution}, N=100_000)

Creates a multivariate systematic sample where each dimension is sampled according to the corresponding univariate distribution in `dists`. Returns `p::Vector{Particles}` where each Particles has a length approximately equal to `N`.
The particles form the outer product between `d` systematically sampled vectors with length given by the d:th root of N, where `d` is the length of `dists`, All particles will be independent and have marginal distributions given by `dists`.

See also `MonteCarloMeasurements.⊗`
"""
function outer_product(dists::AbstractVector{<:Distribution}, N=100_000)
    d = length(dists)
    N = floor(Int,N^(1/d))
    dims = map(dists) do dist
        v = systematic_sample(N,dist; permute=true)
    end
    cart_prod = vec(collect(Iterators.product(dims...)))
    p = map(1:d) do i
        Particles(getindex.(cart_prod,i))
    end
end

# StaticParticles(N::Integer = DEFAUL_NUM_PARTICLES; permute=true) = StaticParticles{Float64,N}(SVector{N,Float64}(systematic_sample(N, permute=permute)))

function print_functions_to_extend()
    excluded_functions = [fill, |>, <, display, show, promote, promote_rule, promote_type, size, length, ndims, convert, isapprox, ≈, <, (<=), (==), zeros, zero, eltype, getproperty, fieldtype, rand, randn]
    functions_to_extend = setdiff(names(Base), Symbol.(excluded_functions))
    for fs in functions_to_extend
        ff = @eval $fs
        ff isa Function || continue
        isempty(methods(ff)) && continue # Sort out intrinsics and builtins
        f = nameof(ff)
        if !isempty(methods(ff, (Real,Real)))
            println(f, ",")
        end
    end
end
"""
    shortform(p::AbstractParticles)
Return a short string describing the type
"""
shortform(p::Particles) = "Part"
shortform(p::StaticParticles) = "SPart"
shortform(p::WeightedParticles) = "WPart"
function to_num_str(p, d=3)
    s = std(p)
    if s < eps(p)
        string(round(mean(p), sigdigits=d))
    else
        string(round(mean(p), sigdigits=d), " ± ", round(s, sigdigits=d-1))
    end
end
function Base.show(io::IO, ::MIME"text/plain", p::AbstractParticles{T,N}) where {T,N}
    sPT = shortform(p)
    print(io, "$(sPT)$N(", to_num_str(p, 4),")")
end

function Base.show(io::IO, p::AbstractParticles{T,N}) where {T,N}
    print(io, to_num_str(p, 3))
end
# function Base.show(io::IO, p::MvParticles)
#     sPT = shortform(p)
#     print(io, "(", N, " $sPT with mean ", round.(mean(p), sigdigits=3), " and std ", round.(sqrt.(diag(cov(p))), sigdigits=3),")")
# end
for mime in (MIME"text/x-tex", MIME"text/x-latex")
    @eval function Base.show(io::IO, ::$mime, p::AbstractParticles)
        print(io, "\$"); show(io, p); print("\$")
    end
end

# Two-argument functions
foreach(register_primitive_multi, [+,-,*,/,//,^,
max,min,mod,mod1,atan,atand,add_sum,hypot])
# One-argument functions
foreach(register_primitive_single, [*,+,-,/,
exp,exp2,exp10,expm1,
log,log10,log2,log1p,
sin,cos,tan,sind,cosd,tand,sinh,cosh,tanh,
asin,acos,atan,asind,acosd,atand,asinh,acosh,atanh,
zero,sign,abs,sqrt,rad2deg,deg2rad])

for PT in (:Particles, :StaticParticles)
    # Constructors
    @eval begin
        $PT(v::Vector) = $PT{eltype(v),length(v)}(v)
        function $PT{T,N}(n::Real) where {T,N} # This constructor is potentially dangerous, replace with convert?
            v = fill(n,N)
            $PT{T,N}(v)
        end

        """
            ℝⁿ2ℝⁿ_function(f::Function, p::AbstractArray{T})
        Applies  `f : ℝⁿ → ℝⁿ` to an array of particles.
        """
        function ℝⁿ2ℝⁿ_function(f::F, p::AbstractArray{$PT{T,N}}) where {F,T,N}
            individuals = map(1:length(p[1])) do i
                f(getindex.(p,i))
            end
            RT = promote_type(T,eltype(eltype(individuals)))
            PRT = $PT{RT,N}
            out = similar(p, PRT)
            for i = 1:length(p)
                out[i] = PRT(getindex.(individuals,i))
            end
            reshape(out, size(p))
        end

        function ℝⁿ2ℝⁿ_function(f::F, p::AbstractArray{$PT{T,N}}, p2::AbstractArray{$PT{T,N}}) where {F,T,N}
            individuals = map(1:length(p[1])) do i
                f(getindex.(p,i), getindex.(p2,i))
            end
            RT = promote_type(T,eltype(eltype(individuals)))
            PRT = $PT{RT,N}
            out = similar(p, PRT)
            for i = 1:length(p)
                out[i] = PRT(getindex.(individuals,i))
            end
            reshape(out, size(p))
        end
    end
    for ff in (var, std)
        f = nameof(ff)
        @eval function (Statistics.$f)(p::$PT{T,N},args...;kwargs...) where {T,N}
            N == 1 && (return zero(T))
            $f(p.particles, args...;kwargs...)
        end
    end
    @forward @eval($PT).particles Statistics.mean, Statistics.cov, Statistics.median, Statistics.quantile, Statistics.middle
end

for PT in (:WeightedParticles,)
    # Constructors
    @eval begin
        $PT(v::Vector, w=fill(-log(length(v)), length(v))) = $PT{eltype(v),length(v)}(v,w)
        function $PT{T,N}(n::Real) where {T,N} # This constructor is potentially dangerous, replace with convert?
            v = fill(n,N)
            w = fill(-log(N),N)
            $PT{T,N}(v,w)
        end
    end
    # Two-argument functions
    for ff in (+,-,*,/,//,^, max,min,mod,mod1,atan,add_sum)
        f = nameof(ff)
        @eval begin
            function (Base.$f)(p::$PT{T,N},a::Real...) where {T,N}
                # $PT{T,N}(map(x->$f(x,a...), p.particles),p.logweights)
                $PT{T,N}($f.(p.particles, maybe_particles.(a)...), .+(p.logweights, maybe_logweights.(a)...))
            end
            function (Base.$f)(a::Real,p::$PT{T,N}) where {T,N}
                $PT{T,N}(map(x->$f(a,x), p.particles),p.logweights)
            end
            function (Base.$f)(p1::$PT{T,N},p2::$PT{T,N}) where {T,N} # TODO: add logweights for multiplication but not for addition
                sf = string($f)
                $f == Base.:(*) || @warn("p1 $sf p2 not yet fully supported for WeightedParticles")
                $PT{T,N}(map($f, p1.particles, p2.particles),p1.logweights+p2.logweights)
            end
            function (Base.$f)(p1::$PT{T,N},p2::$PT{S,N}) where {T,S,N} # Needed for particles of different float types :/
                $PT{promote_type(T,S),N}(map($f, p1.particles, p2.particles),p1.logweights+p2.logweights)
            end
        end
    end
    # One-argument functions
    for ff in [*,+,-,/,
        exp,exp2,exp10,expm1,
        log,log10,log2,log1p,
        sin,cos,tan,sind,cosd,tand,sinh,cosh,tanh,
        asin,acos,atan,asind,acosd,atand,asinh,acosh,atanh,
        zero,sign,abs,sqrt,rad2deg,deg2rad]
        f = nameof(ff)
        @eval function (Base.$f)(p::$PT)
            $PT(map($f, p.particles), p.logweights)
        end
    end
    for ff in [mean, median, quantile]
        f = nameof(ff)
        @eval function (Statistics.$f)(p::$PT,args...;kwargs...)
            $f(p.particles, Weights(exp.(p.logweights)), args...;kwargs...)
        end
    end
    for ff in [var, std]
        f = nameof(ff)
        @eval function (Statistics.$f)(p::$PT{T,N},args...;kwargs...) where {T,N}
            N == 1 && (return zero(T))
            $f(p.particles, AnalyticWeights(exp.(p.logweights)), args...;kwargs...)
        end
    end
    @eval Statistics.cov(p::$PT,args...;kwargs...) = var(p,args...;kwargs...)
end

function Particles(d::Distribution;kwargs...)
    Particles(DEFAUL_NUM_PARTICLES, d; kwargs...)
end

function StaticParticles(d::Distribution;kwargs...)
    StaticParticles(DEFAUL_STATIC_NUM_PARTICLES, d; kwargs...)
end

for PT in (:Particles, :StaticParticles, :WeightedParticles)
    @forward @eval($PT).particles Base.iterate, Base.extrema, Base.minimum, Base.maximum

    @eval begin
        $PT{T,N}(p::$PT{T,N}) where {T,N} = p

        function $PT(m::Matrix)
            map(1:size(m,2)) do i
                $PT{eltype(m),size(m,1)}(@view(m[:,i]))
            end
        end

        function $PT(N::Integer=DEFAUL_NUM_PARTICLES, d::Distribution=Normal(0,1); permute=true, systematic=true)
            if systematic
                v = systematic_sample(N,d; permute=permute)
            else
                v = rand(d, N)
            end
            $PT{eltype(v),N}(v)
        end

        function $PT(N::Integer, d::MultivariateDistribution)
            v = rand(d,N)' |> copy # For cache locality
            $PT(v)
        end

        nakedtypeof(p::$PT{T,N}) where {T,N} = $PT
        nakedtypeof(::Type{$PT{T,N}}) where {T,N} = $PT
    end
    # @eval begin

    # end
    @eval begin
        Base.length(::Type{$PT{T,N}}) where {T,N} = N
        Base.eltype(::Type{$PT{T,N}}) where {T,N} = $PT{T,N}
        Base.promote_rule(::Type{S}, ::Type{$PT{T,N}}) where {S,T,N} = $PT{promote_type(S,T),N} # This is hard to hit due to method for real 3 lines down
        Base.promote_rule(::Type{Bool}, ::Type{$PT{T,N}}) where {T,N} = $PT{promote_type(Bool,T),N} # Needed since above is not specific enough.

        Base.convert(::Type{StaticParticles{T,N}}, p::$PT{T,N}) where {T,N} = StaticParticles(p.particles)
        Base.convert(::Type{$PT{T,N}}, f::Real) where {T,N} = $PT{T,N}(fill(T(f),N))
        Base.convert(::Type{$PT{T,N}}, f::$PT{S,N}) where {T,N,S} = $PT{promote_type(T,S),N}(promote_type(T,S).(f.particles))
        function Base.convert(::Type{S}, p::$PT{T,N}) where {S<:ConcreteFloat,T,N}
            N == 1 && (return S(p[1]))
            std(p) < eps(S) || throw(ArgumentError("Cannot convert a particle distribution to a float if not all particles are the same."))
            return S(p[1])
        end
        function Base.convert(::Type{S}, p::$PT{T,N}) where {S<:ConcreteInt,T,N}
            isinteger(p) || throw(ArgumentError("Cannot convert a particle distribution to an int if not all particles are the same."))
            return S(p[1])
        end
        Base.zeros(::Type{$PT{T,N}}, dim::Integer) where {T,N} = [$PT(zeros(eltype(T),N)) for d = 1:dim]
        Base.zero(::Type{$PT{T,N}}) where {T,N} = $PT(zeros(eltype(T),N))
        Base.isfinite(p::$PT{T,N}) where {T,N} = isfinite(mean(p))
        Base.round(p::$PT{T,N}, r::RoundingMode, args...; kwargs...) where {T,N} = round(mean(p), r, args...; kwargs...)
        Base.round(::Type{S}, p::$PT{T,N}, args...; kwargs...) where {S,T,N} = round(S, mean(p), args...; kwargs...)
        function Base.AbstractFloat(p::$PT{T,N}) where {T,N}
            N == 1 && (return p[1])
            std(p) < eps(T) || throw(ArgumentError("Cannot convert a particle distribution to a number if not all particles are the same."))
            return p[1]
        end

        """
        union(p1::AbstractParticles, p2::AbstractParticles)

        A `Particles` containing all particles from both `p1` and `p2`. Note, this will be twice as long as `p1` or `p2` and thus of a different type.
        `pu = Particles([p1.particles; p2.particles])`
        """
        function Base.union(p1::$PT{T,NT},p2::$PT{T,NS}) where {T,NT,NS}
            $PT([p1.particles; p2.particles])
        end

        """
        intersect(p1::AbstractParticles, p2::AbstractParticles)

        A `Particles` containing all particles from the common support of `p1` and `p2`. Note, this will be of undetermined length and thus undetermined type.
        """
        function Base.intersect(p1::$PT,p2::$PT)
            mi = max(minimum(p1),minimum(p2))
            ma = min(maximum(p1),maximum(p2))
            f = x-> mi <= x <= ma
            $PT([filter(f, p1.particles); filter(f, p2.particles)])
        end

        Base.:^(p::$PT, i::Integer) = $PT(p.particles.^i) # Resolves ambiguity
        Base.:\(p::Vector{<:$PT}, p2::Vector{<:$PT}) = Matrix(p)\Matrix(p2) # Must be here to be most specific
    end

end

Base.length(p::AbstractParticles{T,N}) where {T,N} = N
Base.ndims(p::AbstractParticles{T,N}) where {T,N} = ndims(T)
Base.:\(H::MvParticles,p::AbstractParticles) = Matrix(H)\p.particles
# Base.:\(p::AbstractParticles, H) = p.particles\H
# Base.:\(p::MvParticles, H) = Matrix(p)\H
# Base.:\(H,p::MvParticles) = H\Matrix(p)

Base.Broadcast.broadcastable(p::AbstractParticles) = Ref(p)
Base.setindex!(p::AbstractParticles, val, i::Integer) = setindex!(p.particles, val, i)
Base.getindex(p::AbstractParticles, i::Integer) = getindex(p.particles, i)
# Base.getindex(v::MvParticles, i::Int, j::Int) = v[j][i] # Defining this methods screws with show(::MvParticles)

Base.Matrix(v::MvParticles) = reduce(hcat, getfield.(v,:particles))
# function Statistics.var(v::MvParticles,args...;kwargs...) # Not sure if it's a good idea to define this. Is needed for when var(v::AbstractArray) is used
#     s2 = map(1:length(v[1])) do i
#         var(getindex.(v,i))
#     end
#     eltype(v)(s2)
# end

Statistics.mean(v::MvParticles) = mean.(v)
Statistics.cov(v::MvParticles,args...;kwargs...) = cov(Matrix(v), args...; kwargs...)
Distributions.fit(d::Type{<:MultivariateDistribution}, p::MvParticles) = fit(d,Matrix(p)')
Distributions.fit(d::Type{<:Distribution}, p::AbstractParticles) = fit(d,p.particles)
check_similar_weights(v) = all(v[i].logweights ≈ v[1].logweights for i in 2:length(v))
function Statistics.cov(v::MvWParticles,args...;kwargs...)
    check_similar_weights(v)
    cov(Matrix(v), AnalyticWeights(v[1].logweights); kwargs...)
end
Distributions.fit(d::Type{<:MultivariateDistribution}, p::MvWParticles) = error("Not implemented for weighted particles yet")
Distributions.fit(d::Type{<:Distribution}, p::WeightedParticles) = error("Not implemented for weighted particles yet")
Distributions.fit(d::Type{<:MvNormal}, p::MvWParticles) = MvNormal(p)
Distributions.fit(d::Type{<:Normal}, p::WeightedParticles) = Normal(p)
Distributions.Normal(p::AbstractParticles) = Normal(mean(p), std(p))
Distributions.MvNormal(p::AbstractParticles) = MvNormal(mean(p), cov(p))
Distributions.MvNormal(p::MvParticles) = MvNormal(mean(p), cov(p))

meanstd(p::AbstractParticles) = std(p)/sqrt(length(p))
meanvar(p::AbstractParticles) = var(p)/length(p)

Base.:(==)(p1::AbstractParticles{T,N},p2::AbstractParticles{T,N}) where {T,N} = p1.particles == p2.particles
Base.:(!=)(p1::AbstractParticles{T,N},p2::AbstractParticles{T,N}) where {T,N} = p1.particles != p2.particles

function _comparison_operator(p)
    length(p) == 1 && return
    USE_UNSAFE_COMPARIONS[] || error("Comparison operators are not well defined for uncertain values and are currently turned off. Call `unsafe_comparisons(true)` to enable comparison operators for particles using the current reduction function $(COMPARISON_FUNCTION[]). Change this function using `set_comparison_function(f)`.")
end

function Base.:<(a::Real,p::AbstractParticles)
    _comparison_operator(p)
    a < COMPARISON_FUNCTION[](p)
end
function Base.:<(p::AbstractParticles,a::Real)
    _comparison_operator(p)
    COMPARISON_FUNCTION[](p) < a
end
function Base.:<(p::AbstractParticles, a::AbstractParticles)
    _comparison_operator(p)
    COMPARISON_FUNCTION[](p) < COMPARISON_FUNCTION[](a)
end
function Base.:(<=)(p::AbstractParticles{T,N}, a::AbstractParticles{T,N}) where {T,N}
    _comparison_operator(p)
    COMPARISON_FUNCTION[](p) <= COMPARISON_FUNCTION[](a)
end

"""
    p1 ≈ p2

Determine if two particles are not significantly different
"""
Base.:≈(p::AbstractParticles, a::AbstractParticles, lim=2) = abs(mean(p)-mean(a))/(2sqrt(std(p)^2 + std(a)^2)) < lim
Base.:≈(a::Real,p::AbstractParticles, lim=2) = abs(mean(p)-a)/std(p) < lim
Base.:≈(p::AbstractParticles, a::Real, lim=2) = abs(mean(p)-a)/std(p) < lim
Base.:≈(p::MvParticles, a::AbstractVector) = all(a ≈ b for (a,b) in zip(a,p))
Base.:≈(a::AbstractVector, p::MvParticles) = all(a ≈ b for (a,b) in zip(a,p))
Base.:≈(a::MvParticles, p::MvParticles) = all(a ≈ b for (a,b) in zip(a,p))
Base.:≉(a,b::AbstractParticles,lim=2) = !(≈(a,b,lim))
Base.:≉(a::AbstractParticles,b,lim=2) = !(≈(a,b,lim))
"""
    p1 ≉ p2

Determine if two particles are significantly different
"""
Base.:≉(a::AbstractParticles,b::AbstractParticles,lim=2) = !(≈(a,b,lim))

Base.sincos(x::AbstractParticles) = sin(x),cos(x)
Base.minmax(x::AbstractParticles,y::AbstractParticles) = (min(x,y), max(x,y))

Base.:!(p::AbstractParticles) = all(p.particles .== 0)

Base.isinteger(p::AbstractParticles) = all(isinteger, p.particles)
Base.iszero(p::AbstractParticles) = all(iszero, p.particles)
Base.iszero(p::AbstractParticles, tol) = abs(mean(p.particles)) < tol

≲(a::Real,p::AbstractParticles,lim=2) = (mean(p)-a)/std(p) > lim
≲(p::AbstractParticles,a::Real,lim=2) = (a-mean(p))/std(p) > lim
≲(p::AbstractParticles,a::AbstractParticles,lim=2) = (mean(p)-mean(a))/(2sqrt(std(p)^2 + std(a)^2)) > lim
≳(a::Real,p::AbstractParticles,lim=2) = ≲(p,a,lim)
≳(p::AbstractParticles,a::Real,lim=2) = ≲(a,p,lim)
≳(p::AbstractParticles,a::AbstractParticles,lim=2) = ≲(a,p,lim)
Base.eps(p::Type{<:AbstractParticles{T,N}}) where {T,N} = eps(T)
Base.eps(p::AbstractParticles{T,N}) where {T,N} = eps(T)
Base.eps(p::AbstractParticles{<:Complex{T},N}) where {T,N} = eps(T)

"""
    norm(x::AbstractParticles, p=2)

if p == 2: return abs(mean(x))
elseif p == Inf: return max(extrema(x)...)
"""
function LinearAlgebra.norm(x::AbstractParticles, p::Union{AbstractFloat, Integer}=2)
    if p == 2
        return abs(mean(x))
    elseif p == Inf
        return max(extrema(x)...)
    end
    throw(ArgumentError("Cannot take $(p)-norm of particles"))
end

Base.exp(p::AbstractMatrix{<:AbstractParticles}) = ℝⁿ2ℝⁿ_function(exp, p)
LinearAlgebra.lyap(p1::Matrix{<:AbstractParticles}, p2::Matrix{<:AbstractParticles}) = ℝⁿ2ℝⁿ_function(lyap, p1, p2)

# OBS: defining this was a very bad idea, eigvals jump around and get confused with each other etc.
# function LinearAlgebra.eigvals(p::Matrix{$PT{T,N}}) where {T,N} # Special case to propte types differently
#     individuals = map(1:length(p[1])) do i
#         eigvals(getindex.(p,i))
#     end
#
#     PRT = Complex{$PT{T,N}}
#     out = Vector{PRT}(undef, length(individuals[1]))
#     for i = eachindex(out)
#         c = getindex.(individuals,i)
#         out[i] = complex($PT{T,N}(real(c)),$PT{T,N}(imag(c)))
#     end
#     out
# end


@testset "prob1" begin
    @markov midplane(lam, mu) begin
        @tr begin
            :up => :down, lam
            :down => :up, mu
        end
        @reward :r begin
            :up, 1
        end
    end

    begin
        lam = 0.4
        mu = 1.5
        delta = 1.5
    end

    m = ctmc(midplane(lam, mu))
    println(sprob(m))
end

@testset "sprob2" begin
    @markov midplane(lam, mu) begin
        @tr begin
            :up => :down, lam
            :down => :up, mu
        end
        @reward :r begin
            :up, 1
        end
    end

    begin
        lam = 0.4
        mu = 1.5
        delta = 1.5
    end

    m = ctmc(midplane(lam, mu), :DenseCTMC)
    println(sprob(m))
end

@testset "sprob2" begin
    @markov midplane(lam, mu) begin
        @tr begin
            :up => :down, lam
            :down => :up, mu
        end
        @reward :r begin
            :up, 1
        end
    end

    begin
        lam = 0.4
        mu = 1.5
        delta = 1.5
    end

    m = ctmc(midplane(lam, mu), :DenseCTMC)
    println(sprob(m, states=[:up]))
end

@testset "sprob4" begin
    @markov midplane(lam, mu) begin
        @tr begin
            :up => :down, lam
            :down => :up, mu
        end
        @reward :r begin
            :up, 1
        end
    end

    @bind begin
        lam = 0.4
        mu = 1.5
        delta = 1.5
    end

    m = ctmc(midplane(lam, mu), :DenseCTMC)
    println(seval(sprob(m)))
    println(seval(sprob(m), :lam))
    println(seval(sprob(m), (:lam, :lam)))
end

@testset "sprob5" begin
    @markov midplane(lam, mu) begin
        @tr begin
            :up => :down, lam
            :down => :up, mu
        end
        @reward :r begin
            :up, 1
        end
    end

    @bind begin
        lam = 0.4
        mu = 1.5
        delta = 1.5
    end

    m = ctmc(midplane(lam, mu), :DenseCTMC)
    println(seval(sprob(m, states=[:up])))
    println(seval(sprob(m, states=[:up]), :lam))
    println(seval(sprob(m, states=[:up]), (:lam, :lam)))
end


using ModelingToolkit
using Test

const PType = ModelingToolkit.Parameter{Number}

@parameters t
@variables x(t) y(t) # test multi-arg
@variables z(t) # test single-arg
x1 = Variable(:x)(t)
y1 = Variable(:y)(t)
z1 = Variable(:z)(t)
@test isequal(x1, x)
@test isequal(y1, y)
@test isequal(z1, z)

@parameters begin
    t
    s
end
@parameters σ(..)

t1 = Variable{PType}(:t)()
s1 = Variable{PType}(:s)()
σ1 = Variable(:σ)
@test isequal(t1, t)
@test isequal(s1, s)
@test isequal(σ1, σ)

@derivatives D'~t
D1 = Differential(t)
@test D1 == D

@test isequal(x ≤ y + 1, (x < y + 1) | (x == y + 1))

@test @macroexpand(@parameters x, y, z(t)) == @macroexpand(@parameters x y z(t))
@test @macroexpand(@variables x, y, z(t)) == @macroexpand(@variables x y z(t))

# Test array expressions
@parameters begin
    t[1:2]
    s[1:2:4,1:2]
end
@parameters σ[1:2](..)

t1 = [Variable{PType}(:t, 1)(),
      Variable{PType}(:t, 2)()]
s1 = [Variable{PType}(:s, 1, 1)() Variable{PType}(:s, 1, 2)()
      Variable{PType}(:s, 3, 1)() Variable{PType}(:s, 3, 2)()]
σ1 = [Variable(:σ, 1),
      Variable(:σ, 2)]
@test isequal(t1, t)
@test isequal(s1, s)
@test isequal(σ1, σ)

@parameters t
@variables x[1:2](t)
x1 = [Variable(:x, 1)(t), Variable(:x, 2)(t)]
@test isequal(x1, x)

@variables a[1:11,1:2]
@variables a()


function is_palidrome(n::Int64)
	a=Int64[]
	while n>=1
		push!(a,n%10);
		n=n-n%10;
		n/=10
		n=Int64(n)

	end
	len=length(a);
	if( len==1)  return true
	end
	for i=1:len
		if a[i]!=a[len+1-i]
			return false
		end
	end
	return true
end

function compute()
	N=1000
	ans=0
	for i=1:N
		for j=1:N
			if is_palidrome(i*j)
				ans=max(ans,i*j)
			end
		end
	end
	return ans
end

print(compute())


#=
Copyright 2021 BlackRock, Inc.

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.
=#

"""
    Interval(lb::Real, ub::Real)

Represents a univariate interval.

The fields represent:
- `lb`: Lower bound of the interval
- `ub`: Upper bound of the interval

# Example
```jldoctest
julia> interval = Interval(0., 1.)
[0.00000, 1.00000]

julia> Interval()
ℝ

```
"""
mutable struct Interval
    lb::Float64
    ub::Float64
    function Interval(lb::Real, ub::Real)
        @assert !isnan(lb)
        @assert !isnan(ub)
        return new(lb, ub)
    end
end

Interval() = Interval(-Inf, Inf)

function Base.show(io::IO, A::Interval)
    if A.lb == -Inf && A.ub == Inf
        @printf(io, "ℝ\n")
    else
        @printf(io, "[%.5f, %.5f]\n", A.lb, A.ub)
    end
end

#####
##### Boolean
#####

"""
    isempty(A::Interval)

Return `true` if the interval `A` is empty (`isempty(A::Interval)`).
"""
isempty(A::Interval) = A.lb > A.ub

∈(x::Real, A::Interval) = (x ≥ A.lb) & (x ≤ A.ub)

function ⊆(A::Interval, B::Interval)
    return (A.lb ∈ B) & (A.ub ∈ B)
end

==(A::Interval, B::Interval) = (A.lb == B.lb) && (A.ub == B.ub)

≈(A::Interval, B::Interval) = (A.lb ≈ B.lb) && (A.ub ≈ B.ub)

function <(A::Interval, B::Interval)
    return A.ub < B.lb
end

function >(A::Interval, B::Interval)
    return B < A
end

∩(A::Interval, B::Interval) = Interval(max(A.lb, B.lb), min(A.ub, B.ub))


include("codegen.jl")

sqrt = "(define (square x) (* x x))
(define (average x y) (/ (+ x y) 2))
(define (abs x) (if (< x 0) (* -1 x) x))
(define (improve guess x) (average guess (/ x guess)))
(define (good-enough? guess x)
  (< (abs (- (square guess) x)) 0.001))

(define (sqrt-iter guess x) (if (good-enough? guess x)
      guess
      (sqrt-iter (improve guess x) x)))
(define (sqrt x) (sqrt-iter 1.00 x))
(sqrt 9)
"
abs = "(define (abs x) (if (< x 0) (* -1 x) x))"
prod = "(define (produtorio x tot)
    (if (== x 1) tot (produtorio (- x 1) (* x tot))))"
str3 = "(define var 3)
(define (foo x) (+ x var))
(foo 2)
(define (fatorial x tot)
(if (== x 1) tot (fatorial (- x 1) (* x tot))))
(fatorial 5 1)
(if (> 3 var) 1 3)
"

ctx = LLVM.Context()
mod = generate_IR(str2, ctx)
run(mod,"0")


using PtFEM

ProjDir = dirname(@__FILE__)

data = Dict(
  # Beam(ndim, nst, nxe, nip, direction, finite_element(nod, nodof), axisymmetric)
  :struc_el => Beam(2, 1, 100, 1, :x, Line(2, 1), false),
  :properties => [1.0 100.0;],
  :x_coords => 0.0:0.01:1.0,
  :support => [
    (1, [0 1]),
    #(51, [0 1]),
    (101, [0 1])
    ],
  :limit => 100,
  :tol => 0.00001
)

data |> display
println()

@time m = p46(data)
println()

if VERSION.minor > 5
  println("\nThe buckling load = $(m[1])")
  m[4][1] = 0.0
  println("\nThe buckling mode ($(m[2]) iterations):\n")
  for i in 1:m[3]
    println("$i    $(m[4][m[5][:, i]+1])")
  end
  println()
else
  println("\nThe buckling load = $(m[1]) ($(m[2]) iterations):\n")
  buckling_df = DataFrame(
    translation = m[4][m[5][1,:]+1],
    rotation = m[4][m[5][2,:]+1]
  )
  display(buckling_df)
  println()

  using Plots
  gr(size=(400,600))

  p = Vector{Plots.Plot{Plots.GRBackend}}(undef, 2)
  titles = ["p46.2a translation", "p46.2a rotation"]
  p[1] = plot(convert(Array, buckling_df[:translation]),
    ylim=(-0.1, 0.1), xlabel="node",
    ylabel="y translation [m]", color=:blue,
    marker=(:circle,1,0.1,stroke(1,:black)),
    title=titles[1], leg=false)
  p[2] = plot(convert(Array, buckling_df[:rotation]),
    ylim=(-1.0, 1.0), xlabel="node",
    ylabel="rotation [radians]", color=:red,
    marker=(:circle,1,0.1,stroke(1,:black)),
    title=titles[2], leg=false)

  plot(p..., layout=(2, 1))
  savefig(ProjDir*"/Ex46.2a.png")

end


@auto_hash_equals mutable struct Transition
    id::Int
end

mutable struct Place
    id::Int
    marking::Int
end

mutable struct PetriNet
    places::Array{Place}
    transitions::Array{Transition}
    arcs::Array{Union{Tuple{Place, Transition}, Tuple{Transition, Place}}}
end

function fire!(transition::Transition, model::PetriNet)
    if is_enabled(transition, model)
        update_markings!(transition, model)
    else
        print("Transition is not enabled\nDid not fire")
    end
    return model
end

function is_enabled(transition::Transition, model::PetriNet)
    predecessors = get_predecessors(transition, model)
    return sum([place.marking > 0 for place in predecessors]) == length(predecessors)
end

function get_predecessors(transition::Transition, model::PetriNet)
    return [arc[1] for arc in model.arcs if arc[2] == transition]
end

function get_successors(transition::Transition, model::PetriNet)
    return [arc[2] for arc in model.arcs if arc[1] == transition]
end

function update_markings!(transition::Transition, model::PetriNet)
    for predecessor in get_predecessors(transition, model)
        predecessor.marking -= 1
    end
    for successor in get_successors(transition, model)
        successor.marking += 1
    end
    return model
end

function add_place!(model::PetriNet, marking::Int)
    new_place_id = length(model.places) + 1
    push!(model.places, Place(new_place_id, marking))
    return model
end

function add_transition!(model::PetriNet)
    new_transition_id = length(model.transitions) + 1
    push!(model.transitions, Transition(new_transition_id))
    return model
end

function add_arc!(model::PetriNet, from::Place, to::Transition)
    push!(model.arcs, (from, to))
    return model
end

function add_arc!(model::PetriNet, from::Transition, to::Place)
    push!(model.arcs, (from, to))
    return model
end

mutable struct WorkFlowNet <: PetriNet
    source::Int
    sink::Int
    # places::Array{Place}
    # transitions::Array{Transition}
    # arcs::Array{Union{Tuple{Place, Transition}, Tuple{Transition, Place}}}
end

# light weight version test
# places = [Place(1, 2), Place(2, 0)]
# transitions = [Transition(1)]
# arcs = [(places[1], transitions[1]), (transitions[1], places[2])]
# model = PetriNet(places, transitions, arcs)
# fire(model.transitions[1], model)
# model
# add_place!(model, 3)
# add_transition!(model)
# add_arc!(model, model.places[1], model.transitions[2])
# add_arc!(model, model.transitions[2], model.places[2])
# print(model)

# ----- MORE IDEAS ----- #
# reachability graph
# boundedness
# safeness
# deadlocks
# liveness


using PtFEM
using Test

# write your own tests here

code_tests = [
  "p41.1.jl",
  "p41.2.jl",
  "p42.2.jl",
  "p43.1b.jl",
  "p44.2.jl",
  "p45.2.jl",
  "p46.2.jl",
  "p47.1.jl",

  "p51.1.jl",
  "p51.2.jl",
  "p51.3.jl",
  "p51.4.jl",
  "p51.5.jl",
  "p52.1.jl",
  "p53.1.jl",
  "p54.1.jl",
  "p54.2.jl",
  "p55.1.jl",
  "p56.1.jl",

  "p61.1.jl",
  "p62.1.jl",
  "p63.1.jl"
]

println("\n\nRunning PtFEM/PtFEM.jl tests:\n\n")

@testset "PtFEM.jl" begin
  for test in code_tests
      println("\n\n  * $(test) *\n")
      include("test_"*test)
  end
end


# Parts of this code were taken / derived from Graphs.jl. See LICENSE for
# licensing details.

"""
    connected_components!(label::Vector{Int}, g::AGraph)

Fills `label` with the `id` of the connected component to which it belongs.

Arguments:
    label: a place to store the output
    g: the graph
Output:
    c = labels[i] => vertex i belongs to component c.
    c is the smallest vertex id in the component.
"""
function connected_components!(label::Vector{Int}, g::AGraph)
    # this version of connected components uses Breadth First Traversal
    # with custom visitor type in order to improve performance.
    # one BFS is performed for each component.
    # This algorithm is linear in the number of edges of the graph
    # each edge is touched once. memory performance is a single allocation.
    # the return type is a vector of labels which can be used directly or
    # passed to components(a)
    nvg = nv(g)
    visitor = Erdos.ComponentVisitorVector(label, 0)
    colormap = VertexMap(g, fill(0, nvg))
    queue = Vector{Int}()
    sizehint!(queue, nvg)
    for v in 1:nvg
        if label[v] == 0
            visitor.labels[v] = v
            visitor.seed = v
            traverse_graph!(g, BreadthFirst(), v, visitor; vcolormap=colormap, queue=queue)
        end
    end
    return label
end

"""components_dict(labels) converts an array of labels to a Dict{Int,Vector{Int}} of components

Arguments:
    c = labels[i] => vertex i belongs to component c.
Output:
    vs = d[c] => vertices in vs belong to component c.
"""
function components_dict(labels::Vector{Int})
    d = Dict{Int,Vector{Int}}()
    for (v,l) in enumerate(labels)
        vec = get(d, l, Vector{Int}())
        push!(vec, v)
        d[l] = vec
    end
    return d
end

"""
    components(labels::Vector{Int})

Converts an array of labels to a Vector{Vector{Int}} of components

Arguments:
    c = labels[i] => vertex i belongs to component c.
Output:
    vs = c[i] => vertices in vs belong to component i.
    a = d[i] => if labels[v]==i then v in c[a] end
"""
function components(labels::Vector{Int})
    d = Dict{Int, Int}()
    c = Vector{Vector{Int}}()
    i = 1
    for (v,l) in enumerate(labels)
        index = get!(d, l, i)
        if length(c) >= index
            push!(c[index], v)
        else
            push!(c, [v])
            i += 1
        end
    end
    return c, d
end

"""
    connected_components(g::AGraph)

Returns the [connected components](https://en.wikipedia.org/wiki/Connectivity_(graph_theory))
of `g` as a vector of components, each represented by a
vector of vertices belonging to the component.

See also [`weakly_connected_components`](@ref) and [`strongly_connected_components`](@ref)
for directed graphs.
"""
function connected_components(g::AGraph)
    nv(g) == 0 && return Vector{Int}[Int[]]
    label = zeros(Int, nv(g))
    connected_components!(label, g)
    c, d = components(label)
    return c
end

"""
    is_connected(g)

Returns `true` if `g` is connected.
For DiGraphs, this is equivalent to a test of weak connectivity.
"""
is_connected(g::AGraph) = length(connected_components(g)) == 1

"""
    weakly_connected_components(g::ADiGraph)

Returns the weakly connected components of undirected graph `g`.
It is equivalent to the connected components of the corresponding
undirected graph, i.e. `connected_components(graph(g))`.
"""
weakly_connected_components(g::ADiGraph) = connected_components(graph(g))

"""
    is_weakly_connected(g::ADiGraph)

Returns `true` if the undirected graph `g` is weakly connected.

See also [`weakly_connected_components`](@ref).
"""
is_weakly_connected(g::ADiGraph) = length(weakly_connected_components(g)) == 1

# Adapated from Graphs.jl
mutable struct TarjanVisitor <: SimpleGraphVisitor
    stack::Vector{Int}
    onstack::BitVector
    lowlink::Vector{Int}
    index::Vector{Int}
    components::Vector{Vector{Int}}
end

TarjanVisitor(n) = TarjanVisitor(
    Vector{Int}(),
    falses(n),
    Vector{Int}(),
    zeros(Int, n),
    Vector{Vector{Int}}()
)

function discover_vertex!(vis::TarjanVisitor, v)
    vis.index[v] = length(vis.stack) + 1
    push!(vis.lowlink, length(vis.stack) + 1)
    push!(vis.stack, v)
    vis.onstack[v] = true
    return true
end

function examine_neighbor!(vis::TarjanVisitor, v, w, vcolor, w_color, ecolor)
    if w_color != 0 && vis.onstack[w] # != 0 means seen
        while vis.index[w] > 0 && vis.index[w] < vis.lowlink[end]
            pop!(vis.lowlink)
        end
    end
    return true
end

function close_vertex!(vis::TarjanVisitor, v)
    if vis.index[v] == vis.lowlink[end]
        component = splice!(vis.stack, vis.index[v]:length(vis.stack))
        vis.onstack[component] = false
        pop!(vis.lowlink)
        push!(vis.components, component)
    end
    return true
end

"""
    strongly_connected_components(g::ADiGraph)

Computes the strongly connected components of a directed graph.
"""
function strongly_connected_components(g::ADiGraph)
    nvg = nv(g)
    cmap = VertexMap(g, zeros(Int, nvg))
    nv(g) == 0 && return Vector{Int}[Int[]]
    components = Vector{Vector{Int}}()

    for v in vertices(g)
        if cmap[v] == 0 # 0 means not visited yet
            visitor = TarjanVisitor(nvg)
            traverse_graph!(g, DepthFirst(), v, visitor, vcolormap=cmap)
            for component in visitor.components
                push!(components, component)
            end
        end
    end
    return components
end

"""
    is_strongly_connected(g::ADiGraph)

Returns `true` if `g` is strongly connected.

See also [`strongly_connected_components`](@ref)
"""
is_strongly_connected(g::ADiGraph) = length(strongly_connected_components(g)) == 1

"""
    period(g::ADiGraph)

Computes the common period for all nodes in a strongly connected graph.
"""
function period(g::ADiGraph)
    !is_strongly_connected(g) && error("Graph must be strongly connected")

    # First check if there's a self loop
    has_self_loops(g) && return 1

    g_bfs_tree  = bfs_tree(g,1)
    levels      = gdistances(g_bfs_tree,1)
    tree_diff   = difference(g,g_bfs_tree)
    edge_values = Vector{Int}()

    divisor = 0
    for e in edges(tree_diff)
        @inbounds value = levels[src(e)] - levels[dst(e)] + 1
        divisor = gcd(divisor,value)
        isequal(divisor,1) && return 1
    end

    return divisor
end

"""Computes the condensation graph of the strongly connected components."""
function _condensation(g::T, scc::Vector{Vector{Int}}) where T<:ADiGraph
    h = T(length(scc))

    component = Vector{Int}(nv(g))

    for (i,s) in enumerate(scc)
        @inbounds component[s] = i
    end

    @inbounds for e in edges(g)
        s, d = component[src(e)], component[dst(e)]
        if (s != d)
            add_edge!(h, s, d)
        end
    end
    return h
end

"""
    condensation(g::ADiGraph)

Returns the condensation graph associated with `g`. The condensation `h` of
a graph `g` is the directed graph where every node in `h` represents a strongly
connected component in `g`, and the presence of an edge between between nodes
in `h` indicates that there is at least one edge between the associated
strongly connected components in `g`. The node numbering in `h` corresponds to
the ordering of the components output from [`strongly_connected_components`](@ref).
"""
condensation(g::ADiGraph) = _condensation(g, strongly_connected_components(g))

"""
    attracting_components(g::ADiGraph)

Returns a vector of vectors of integers representing lists of attracting
components in `g`. The attracting components are a subset of the strongly
connected components in which the components do not have any leaving edges.
"""
function attracting_components(g::ADiGraph)
    scc  = strongly_connected_components(g)
    cond = _condensation(g, scc)

    attracting = Vector{Int}()

    for v in vertices(cond)
        if out_degree(cond,v) == 0
            push!(attracting,v)
        end
    end
    return scc[attracting]
end

mutable struct NeighborhoodVisitor{V} <: SimpleGraphVisitor
    d::Int
    neigs::Vector{V}
end

NeighborhoodVisitor(g::AGraphOrDiGraph, d::Integer) =
    (V=vertextype(g); NeighborhoodVisitor{V}(d, Vector{V}()))

function examine_neighbor!(visitor::NeighborhoodVisitor, u, v, ucolor, vcolor, ecolor)
    -ucolor > visitor.d && return false # color is negative for non-closed vertices
    if vcolor == 0
        push!(visitor.neigs, v)
    end
    return true
end

"""
    neighborhood(g, v, d; dir=:out)

Returns a vector of the vertices in `g` at distance less or equal to `d`
from `v`. If `g` is a `DiGraph` the `dir` optional argument specifies the edge direction
the edge direction with respect to `v` (i.e. `:in` or `:out`) to be considered.
"""
function neighborhood(g::AGraphOrDiGraph, v::Integer, d::Integer; dir=:out)
    @assert d >= 0 "Distance has to be greater then zero."
    visitor = NeighborhoodVisitor(g, d)
    push!(visitor.neigs, v)
    traverse_graph!(g, BreadthFirst(), v, visitor,
        vcolormap=VertexMap(g, Int), dir=dir)
    return visitor.neigs
end


## R code 14.12
m14.1 <- ulam(
    alist(
        wait ~ normal( mu , sigma ),
        mu <- a_cafe[cafe] + b_cafe[cafe]*afternoon,
        c(a_cafe,b_cafe)[cafe] ~ multi_normal( c(a,b) , Rho , sigma_cafe ),
        a ~ normal(5,2),
        b ~ normal(-1,0.5),
        sigma_cafe ~ exponential(1),
        sigma ~ exponential(1),
        Rho ~ lkj_corr(2)
    ) , data=d , chains=4 , cores=4 )

## R code 14.18
library(rethinking)
data(chimpanzees)
d <- chimpanzees
d$block_id <- d$block
d$treatment <- 1L + d$prosoc_left + 2L*d$condition

dat <- list(
    L = d$pulled_left,
    tid = d$treatment,
    actor = d$actor,
    block_id = as.integer(d$block_id) )

m14.2 <- ulam(
    alist(
        L ~ binomial(1,p),
        logit(p) <- g[tid] + alpha[actor,tid] + beta[block_id,tid],

        # adaptive priors
        vector[4]:alpha[actor] ~ multi_normal(0,Rho_actor,sigma_actor),
        vector[4]:beta[block_id] ~ multi_normal(0,Rho_block,sigma_block),

        # fixed priors
        g[tid] ~ dnorm(0,1),
        sigma_actor ~ dexp(1),
        Rho_actor ~ dlkjcorr(4),
        sigma_block ~ dexp(1),
        Rho_block ~ dlkjcorr(4)
    ) , data=dat , chains=4 , cores=4 )

## R code 14.19
m14.3 <- ulam(
    alist(
        L ~ binomial(1,p),
        logit(p) <- g[tid] + alpha[actor,tid] + beta[block_id,tid],

        # adaptive priors - non-centered
        transpars> matrix[actor,4]:alpha <-
                compose_noncentered( sigma_actor , L_Rho_actor , z_actor ),
        transpars> matrix[block_id,4]:beta <-
                compose_noncentered( sigma_block , L_Rho_block , z_block ),
        matrix[4,actor]:z_actor ~ normal( 0 , 1 ),
        matrix[4,block_id]:z_block ~ normal( 0 , 1 ),

        # fixed priors
        g[tid] ~ normal(0,1),
        vector[4]:sigma_actor ~ dexp(1),
        cholesky_factor_corr[4]:L_Rho_actor ~ lkj_corr_cholesky( 2 ),
        vector[4]:sigma_block ~ dexp(1),
        cholesky_factor_corr[4]:L_Rho_block ~ lkj_corr_cholesky( 2 ),

        # compute ordinary correlation matrixes from Cholesky factors
        gq> matrix[4,4]:Rho_actor <<- multiply_lower_tri_self_transpose(L_Rho_actor),
        gq> matrix[4,4]:Rho_block <<- multiply_lower_tri_self_transpose(L_Rho_block)
    ) , data=dat , chains=4 , cores=4 , log_lik=TRUE )

## R code 14.24
m14.4 <- ulam(
    alist(
        W ~ dnorm( mu , sigma ),
        mu <- aW + bEW*E,
        aW ~ dnorm( 0 , 0.2 ),
        bEW ~ dnorm( 0 , 0.5 ),
        sigma ~ dexp( 1 )
    ) , data=dat_sim , chains=4 , cores=4 )
precis( m14.4 )

## R code 14.25
m14.5 <- ulam(
    alist(
        c(W,E) ~ multi_normal( c(muW,muE) , Rho , Sigma ),
        muW <- aW + bEW*E,
        muE <- aE + bQE*Q,
        c(aW,aE) ~ normal( 0 , 0.2 ),
        c(bEW,bQE) ~ normal( 0 , 0.5 ),
        Rho ~ lkj_corr( 2 ),
        Sigma ~ exponential( 1 )
    ), data=dat_sim , chains=4 , cores=4 )

## R code 14.30
kl_data <- list(
    N = nrow(kl_dyads),
    N_households = max(kl_dyads$hidB),
    did = kl_dyads$did,
    hidA = kl_dyads$hidA,
    hidB = kl_dyads$hidB,
    giftsAB = kl_dyads$giftsAB,
    giftsBA = kl_dyads$giftsBA
)

m14.4 <- ulam(
    alist(
        giftsAB ~ poisson( lambdaAB ),
        giftsBA ~ poisson( lambdaBA ),
        log(lambdaAB) <- a + gr[hidA,1] + gr[hidB,2] + d[did,1] ,
        log(lambdaBA) <- a + gr[hidB,1] + gr[hidA,2] + d[did,2] ,
        a ~ normal(0,1),

       ## gr matrix of varying effects
        vector[2]:gr[N_households] ~ multi_normal(0,Rho_gr,sigma_gr),
        Rho_gr ~ lkj_corr(4),
        sigma_gr ~ exponential(1),

       ## dyad effects
        transpars> matrix[N,2]:d <-
                compose_noncentered( rep_vector(sigma_d,2) , L_Rho_d , z ),
        matrix[2,N]:z ~ normal( 0 , 1 ),
        cholesky_factor_corr[2]:L_Rho_d ~ lkj_corr_cholesky( 8 ),
        sigma_d ~ exponential(1),

       ## compute correlation matrix for dyads
        gq> matrix[2,2]:Rho_d <<- Chol_to_Corr( L_Rho_d )
    ), data=kl_data , chains=4 , cores=4 , iter=2000 )

## R code 14.38
data(Kline2) # load the ordinary data, now with coordinates
d <- Kline2
d$society <- 1:10 # index observations

dat_list <- list(
    T = d$total_tools,
    P = d$population,
    society = d$society,
    Dmat=islandsDistMatrix )

m14.7 <- ulam(
    alist(
        T ~ dpois(lambda),
        lambda <- (a*P^b/g)*exp(k[society]),
        vector[10]:k ~ multi_normal( 0 , SIGMA ),
        matrix[10,10]:SIGMA <- cov_GPL2( Dmat , etasq , rhosq , 0.01 ),
        c(a,b,g) ~ dexp( 1 ),
        etasq ~ dexp( 2 ),
        rhosq ~ dexp( 0.5 )
    ), data=dat_list , chains=4 , cores=4 , iter=2000 )

## R code 14.45
m14.7nc <- ulam(
    alist(
        T ~ dpois(lambda),
        lambda <- (a*P^b/g)*exp(k[society]),

        # non-centered Gaussian Process prior
        transpars> vector[10]: k <<- L_SIGMA * z,
        vector[10]: z ~ normal( 0 , 1 ),
        transpars> matrix[10,10]: L_SIGMA <<- cholesky_decompose( SIGMA ),
        transpars> matrix[10,10]: SIGMA <- cov_GPL2( Dmat , etasq , rhosq , 0.01 ),

        c(a,b,g) ~ dexp( 1 ),
        etasq ~ dexp( 2 ),
        rhosq ~ dexp( 0.5 )
    ), data=dat_list , chains=4 , cores=4 , iter=2000 )

## R code 14.48
dat_list <- list(
    N_spp = nrow(dstan),
    M = standardize(log(dstan$body)),
    B = standardize(log(dstan$brain)),
    G = standardize(log(dstan$group_size)),
    Imat = diag( nrow(dstan) )
)

m14.8 <- ulam(
    alist(
        B ~ multi_normal( mu , SIGMA ),
        mu <- a + bM*M + bG*G,
        matrix[N_spp,N_spp]: SIGMA <- Imat * sigma_sq,
        a ~ normal( 0 , 1 ),
        c(bM,bG) ~ normal( 0 , 0.5 ),
        sigma_sq ~ exponential( 1 )
    ), data=dat_list , chains=4 , cores=4 )

# Brownian motion model
m14.9 <- ulam(
    alist(
        B ~ multi_normal( mu , SIGMA ),
        mu <- a + bM*M + bG*G,
        matrix[N_spp,N_spp]: SIGMA <- R * sigma_sq,
        a ~ normal( 0 , 1 ),
        c(bM,bG) ~ normal( 0 , 0.5 ),
        sigma_sq ~ exponential( 1 )
    ), data=dat_list , chains=4 , cores=4 )
precis( m14.9 )

## R code 14.51
# add scaled and reordered distance matrix
dat_list$Dmat <- Dmat[ spp_obs , spp_obs ] / max(Dmat)

m14.10 <- ulam(
    alist(
        B ~ multi_normal( mu , SIGMA ),
        mu <- a + bM*M + bG*G,
        matrix[N_spp,N_spp]: SIGMA <- cov_GPL1( Dmat , etasq , rhosq , 0.01 ),
        a ~ normal(0,1),
        c(bM,bG) ~ normal(0,0.5),
        etasq ~ half_normal(1,0.25),
        rhosq ~ half_normal(3,0.25)
    ), data=dat_list , chains=4 , cores=4 )


macro same_behavior(ex1, ex2)
    quote
        v = try
            $ex2
        catch e
            e
        end
        isa(v, Exception) ? @test_throws(typeof(v), $ex1) : @test isapprox($ex1, v)
    end
end

@testset "Reduce" begin
    Random.seed!(1337)

    ## extended test of sum

    for skipmissing in (true, false)
        @test sum(@data(Int8[]); skipmissing=skipmissing) === Int32(0)
        @test sum(@data(Int[]); skipmissing=skipmissing) === 0
        @test sum(@data(Float64[]); skipmissing=skipmissing) === 0.0

        @test sum(@data([Int8(3)]); skipmissing=skipmissing) === Int32(3)
        @test sum(@data([3]); skipmissing=skipmissing) === 3
        @test sum(@data([3.0]); skipmissing=skipmissing) === 3.0

        z = DataArray(reshape(1:16, (2,2,2,2)))
        fz = convert(DataArray{Float64}, z)
        bfz = convert(DataArray{BigFloat}, z)
        @test sum(z) === 136
        @test sum(fz) === 136.0
        @test sum(bfz) == 136
    end

    @test sum(@data(Int[missing])) === missing
    @test sum(@data(Int[missing]); skipmissing=true) === 0
    @test sum(@data(Int[missing, missing])) === missing
    @test sum(@data(Int[missing, missing]); skipmissing=true) === 0
    @test sum(@data(Int[missing, missing, 1]); skipmissing=true) === 1
    @test sum(@data(Int[missing, missing, 1, 2]); skipmissing=true) === 3
    @test sum(@data(Int[missing, 1, missing, 1, 2]); skipmissing=true) === 4

    z = DataArray(reshape(1:16, (2,2,2,2)))
    z[6] = missing
    fz = convert(DataArray{Float64}, z)
    bfz = convert(DataArray{BigFloat}, z)
    @test ismissing(sum(z))
    @test ismissing(sum(fz))
    @test ismissing(sum(bfz))
    @test sum(z; skipmissing=true) === 130
    @test sum(fz; skipmissing=true) === 130.0
    @test sum(bfz; skipmissing=true) == 130

    bs = DataArrays.sum_pairwise_blocksize(identity)
    for n in [bs-64, bs-1, bs, bs+1, bs+2, 2*bs-2:2*bs+3..., 4*bs-2:4*bs+3...]
        da = DataArray(randn(n))
        s = sum(da.data)
        @test sum(da) ≈ s
        @test sum(da; skipmissing=true) ≈ s

        da2 = copy(da)
        da2[1:2:end] = missing
        @test ismissing(sum(da2))
        @test sum(da2; skipmissing=true) ≈ sum(skipmissing(da2))

        da2 = convert(DataArray{BigFloat}, da2)
        @test ismissing(sum(da2))
        @test sum(da2; skipmissing=true) ≈ sum(skipmissing(da2))

        da2 = copy(da)
        da2[2:2:end] = missing
        @test ismissing(sum(da2))
        @test sum(da2; skipmissing=true) ≈ sum(skipmissing(da2))

        da2 = convert(DataArray{BigFloat}, da2)
        @test ismissing(sum(da2))
        @test sum(da2; skipmissing=true) ≈ sum(skipmissing(da2))
    end

    ## other reductions

    _varuc(x; kw...) = var(x; corrected=false, kw...)
    _varzm(x; kw...) = var(x; mean=0, kw...)
    _varzmuc(x; kw...) = var(x; corrected=false, mean=0, kw...)
    _var1m(x; kw...) = var(x; mean=1, kw...)
    _var1muc(x; kw...) = var(x; corrected=false, mean=1, kw...)
    _std1m(x; kw...) = stdm(x, 1; kw...)

    for fn in (prod, minimum, maximum, mean,
               var, _varuc, _varzm, _varzmuc, _var1m, _var1muc,
               std, _std1m)
        for n in [0, 1, 2, 62, 63, 64, 65, 66]
            da = DataArray(randn(n))
            @same_behavior fn(da) fn(da.data)
            @same_behavior fn(da; skipmissing=true) fn(da.data)

            da2 = copy(da)
            da2[1:2:end] = missing
            n > 0 && @test ismissing(fn(da2))
            @same_behavior fn(da2; skipmissing=true) fn(skipmissing(da2))

            da2 = convert(DataArray{BigFloat}, da2)
            n > 0 && @test ismissing(fn(da2))
            @same_behavior fn(da2; skipmissing=true) fn(skipmissing(da2))

            da2 = copy(da)
            da2[2:2:end] = missing
            n > 1 && @test ismissing(fn(da2))
            @same_behavior fn(da2; skipmissing=true) fn(skipmissing(da2))

            da2 = convert(DataArray{BigFloat}, da2)
            n > 1 && @test ismissing(fn(da2))
            @same_behavior fn(da2; skipmissing=true) fn(skipmissing(da2))
        end
    end

    ## reduce and mapreduce drivers

    for fn in (+, *, |, &)
        da = convert(DataArray, bitrand(10))

        s = mapreduce(identity, fn, da.data)
        @test mapreduce(identity, fn, da) == s
        @test mapreduce(identity, fn, da; skipmissing=true) == s
        @test reduce(fn, da) == s
        @test reduce(fn, da; skipmissing=true) == s
    end

    # make sure reductions of & and | are still calling Base
    @test ismissing(reduce(&, @data([true, missing])))
    @test !reduce(&, @data([false, missing]))
    @test reduce(|, @data([true, missing]))
    @test ismissing(reduce(|, @data([false, missing])))

    # weighted mean
    da1 = DataArray(randn(128))
    da2 = DataArray(randn(128))
    @same_behavior mean(da1, weights(da2)) mean(da1.data, weights(da2.data))
    @same_behavior mean(da1, weights(da2.data)) mean(da1.data, weights(da2.data))
    @same_behavior mean(da1, weights(da2); skipmissing=true) mean(da1.data, weights(da2.data))
    @same_behavior mean(da1, weights(da2.data); skipmissing=true) mean(da1.data, weights(da2.data))

    da1[1:3:end] = missing
    @same_behavior mean(da1, weights(da2); skipmissing=true) mean(skipmissing(da1), weights(da2.data[(!).(da1.na)]))
    @same_behavior mean(da1, weights(da2.data); skipmissing=true) mean(skipmissing(da1), weights(da2.data[(!).(da1.na)]))

    da2[1:2:end] = missing
    keep = .!da1.na .& .!da2.na
    @same_behavior mean(da1, weights(da2); skipmissing=true) mean(da1.data[keep], weights(da2.data[keep]))
end