## preallocation

function _preallocate_spmatrix(::Type{T}, sizes::Tuple, sizehint) where {T}
    res = spzeros(T, sizes...)
    @static if VERSION >= v"1.7"
        sizehint!(res, first(sizes) * sizehint)
    end

    return res
end

__an_elt(χ::Character) = first(first(conjugacy_classes(χ)))
__an_elt(α::AlgebraElement) = first(basis(parent(α)))

_projection_size(p::PermutationGroups.AbstractPerm) = (d = degree(p); (d, d))
_projection_size(m::AbstractMatrix) = size(m)

_projection_size(::Nothing, χ::Character) = _projection_size(__an_elt(χ))
_projection_size(::Nothing, α::AlgebraElement) = _projection_size(__an_elt(α))
_projection_size(hom::InducedActionHomomorphism, χ::Character) =
    _projection_size(induce(hom, __an_elt(χ)))
_projection_size(hom::InducedActionHomomorphism, α::AlgebraElement) =
    _projection_size(induce(hom, __an_elt(α)))

_hint(χ::Character) = length(conjugacy_classes(χ))
_hint(α::AlgebraElement) = count(!iszero, StarAlgebras.coeffs(α))

preallocate(::Type{T}, χ::Union{Character,AlgebraElement}) where {T} =
    preallocate(T, nothing, χ)

function preallocate(
    hom::InducedActionHomomorphism,
    χ::Union{Character,AlgebraElement},
)
    T = Base._return_type(*, (coeff_type(hom), eltype(χ)))
    return preallocate(T, hom, χ)
end

function preallocate(
    ::Type{T},
    a::Union{Nothing,InducedActionHomomorphism},
    χ::Union{Character,AlgebraElement},
) where {T}
    sizes = _projection_size(a, χ)
    return _preallocate_spmatrix(T, sizes, _hint(χ))
end

## matrix projection [irreducible]
"""
    matrix_projection([hom::InducedActionHomomorphism, ]χ::Character{T})
Compute matrix projection associated to character `χ`.

Returned `M<:AbstractMatrix{T}` of size `(d, d)` where the degree `d` of the
projecion is determined by elements in `conjugacy_classes(χ)`. E.g. `d` could
be equal to the `degree` when conjugacy classes consist of `AbstractPerms`.
If the homomorphism is passed, the dimension will be derived in similar
manner from the elements of the image of the homomorphism.

The precise type of `M` can be altered by overloading

```
preallocate(::Type{T}, [hom::InducedActionHomomorphism, ]χ::Character)
```
"""
matrix_projection(χ::Character{T}) where {T} =
    _mproj_outsT!(preallocate(T, χ), χ)

function matrix_projection(
    hom::InducedActionHomomorphism,
    χ::Character{T},
) where {T}
    return _mproj_outsT!(preallocate(hom, χ), hom, χ)
end

function matrix_projection(χ::Character{T}) where {T<:Rational}
    if all(isone ∘ Cyclotomics.conductor, table(χ))
        return _mproj_fitsT!(preallocate(T, χ), χ)
    else
        return _mproj_outsT!(preallocate(T, χ), χ)
    end
end

matrix_projection(χ::Character{T}) where {T<:Union{Cyclotomic,Complex}} =
    _mproj_fitsT!(preallocate(T, χ), χ)
function matrix_projection(
    hom::InducedActionHomomorphism,
    χ::Character{T},
) where {T<:Union{Cyclotomic,Complex}}
    return _mproj_fitsT!(preallocate(hom, χ), hom, χ)
end

function matrix_projection(χ::Character{T}) where {T<:AbstractFloat}
    if all(isreal, table(χ))
        return _mproj_fitsT!(preallocate(T, χ), χ)
    else
        return _mproj_outsT!(preallocate(T, χ), χ)
    end
end

function matrix_projection(
    hom::InducedActionHomomorphism,
    χ::Character{T},
) where {T<:AbstractFloat}
    if all(isreal, table(χ))
        return _mproj_fitsT!(preallocate(hom, χ), hom, χ)
    else
        return _mproj_outsT!(preallocate(hom, χ), hom, χ)
    end
end

_mproj_fitsT!(args...) = _mproj_outsT!(args...)

function _mproj_outsT!(mproj::AbstractMatrix{T}, χ::Character) where {T}
    mproj .= sum(
        c .* matrix_projection_irr(Character(table(χ), i)) for
        (i, c) in pairs(constituents(χ)) if !iszero(c)
    )
    return mproj
end

function _mproj_outsT!(
    mproj::AbstractMatrix{T},
    hom::InducedActionHomomorphism,
    χ::Character,
) where {T}
    mproj .= sum(
        c .* matrix_projection_irr(hom, Character(table(χ), i)) for
        (i, c) in pairs(constituents(χ)) if !iszero(c)
    )
    return mproj
end

"""
    matrix_projection_irr([::Type, ]χ::Character)
    matrix_projection_irr(hom::InducedActionHomomorphism, χ::Character)
Compute matrix projection associated to an *irreducible* character `χ`.

The returned matrix defines so called *isotypical* projection.

See also [matrix_projection](@ref).
"""
matrix_projection_irr(χ::Character{T}) where {T} = matrix_projection_irr(T, χ)
matrix_projection_irr(::Type{T}, χ::Character) where {T} =
    matrix_projection_irr_acc!(preallocate(T, χ), χ, 1)

matrix_projection_irr(hom::InducedActionHomomorphism, χ::Character) =
    matrix_projection_irr_acc!(preallocate(hom, χ), hom, χ, 1)

function matrix_projection_irr_acc!(
    result::AbstractMatrix,
    χ::Character,
    weight,
)
    @assert isirreducible(χ)
    LinearAlgebra.checksquare(result)
    ccls = conjugacy_classes(χ)
    vals = collect(values(χ))
    weight *= degree(χ) // sum(length, ccls)
    matrix_projection_irr_acc!(result, vals, ccls, weight)
    return result
end

function matrix_projection_irr_acc!(
    result::AbstractMatrix,
    vals,
    ccls::AbstractVector{<:AbstractOrbit{<:PermutationGroups.AbstractPerm}},
    weight,
) where {T}
    iszero(weight) && return result
    for (val, cc) in zip(vals, ccls)
        iszero(val) && continue
        w = weight * val
        for g in cc
            for i in 1:size(result, 1)
                result[i, i^g] += w
            end
        end
    end

    return result
end

function matrix_projection_irr_acc!(
    result::AbstractMatrix,
    vals,
    ccls::AbstractVector{<:AbstractOrbit{<:AbstractMatrix}},
    weight,
)
    # TODO: call to inv(Matrix(g)) is a dirty hack, since if `g`
    # is given by a sparse matrix `inv(g)` will fail.
    for (val, cc) in zip(vals, ccls)
        iszero(val) && continue
        for g in cc
            res .+= (weight * val) .* inv(convert(Matrix, g))
        end
    end
    return res
end

function matrix_projection_irr_acc!(
    result::AbstractMatrix,
    hom::InducedActionHomomorphism,
    χ::Character,
    weight,
)
    @assert isirreducible(χ)
    LinearAlgebra.checksquare(result)
    vals = collect(values(χ))
    ccls = conjugacy_classes(χ)
    weight *= degree(χ) // sum(length, ccls)
    matrix_projection_irr_acc!(result, hom, vals, ccls, weight)
    return result
end

function matrix_projection_irr_acc!(
    result::AbstractMatrix,
    hom::InducedActionHomomorphism{<:ByPermutations},
    class_values,
    conjugacy_cls,
    weight,
)
    iszero(weight) && return result
    for (val, ccl) in zip(class_values, conjugacy_cls)
        iszero(val) && continue
        w = weight * val
        for g in ccl
            h = induce(hom, g)
            @assert h isa PermutationGroups.Perm
            for i in 1:size(result, 1)
                result[i, i^h] += w
            end
        end
    end
    return result
end

function matrix_projection_irr_acc!(
    result::AbstractMatrix,
    hom::InducedActionHomomorphism{<:ByLinearTransformation},
    class_values,
    conjugacy_cls,
    weight,
)
    iszero(weight) && return result
    for (val, cc) in zip(class_values, conjugacy_cls)
        iszero(val) && continue
        w = weight * val
        for g in cc
            result .+= w .* induce(hom, inv(g))
        end
    end
    return result
end

"""
    matrix_representation([::Type{T}, ]α::AlgebraElement)
    matrix_representation([::Type{T}, ]hom::InducedActionHomomorphism, α::AlgebraElement)
Compute matrix representative of the given algebra element `α`.

If `α` is an element of the group (or monoid) algebra `RG` of `G`, then every
linear representation `π : G → GL(V)` gives rise to an algebra homomorphism
`π : RG → B(V)` (bounded operators on `V`). This function evaluates this
representation given either by
 * the natural action of `G` on some `V` (e.g. every permutation group of degree
 `d` acts on `d`-dimensional `V` by basis vector permutation), or
 * by action homomorphism `hom`.

See also [matrix_projection](@ref).
"""
matrix_representation(α::AlgebraElement) = matrix_representation(eltype(α), α)
matrix_representation(::Type{T}, α::AlgebraElement) where {T} =
    matrix_representation_acc!(preallocate(T, α), α)

matrix_representation(hom::InducedActionHomomorphism, α::AlgebraElement) =
    matrix_representation_acc!(preallocate(hom, α), hom, α)

function matrix_representation_acc!(
    result::AbstractMatrix,
    α::AlgebraElement{
        <:StarAlgebra{<:PermutationGroups.AbstractPermutationGroup},
    },
)
    b = basis(parent(α))
    for (idx, val) in StarAlgebras._nzpairs(StarAlgebras.coeffs(α))
        g = b[idx]
        iszero(val) && continue
        for i in 1:size(result, 1)
            result[i, i^g] += val
        end
    end

    return result
end

function matrix_representation_acc!(
    result::AbstractMatrix,
    hom::InducedActionHomomorphism{<:ByPermutations},
    α::AlgebraElement,
)
    b = basis(parent(α))
    for (idx, val) in StarAlgebras._nzpairs(StarAlgebras.coeffs(α))
        iszero(val) && continue
        g = induce(hom, b[idx])
        @assert g isa PermutationGroups.Perm
        for i in 1:size(result, 1)
            result[i, i^g] += val
        end
    end

    return result
end

function matrix_representation_acc!(
    result::AbstractMatrix,
    hom::InducedActionHomomorphism{<:ByLinearTransformation},
    α::AlgebraElement,
)
    b = basis(parent(α))
    for (idx, val) in StarAlgebras._nzpairs(StarAlgebras.coeffs(α))
        iszero(val) && continue
        result .+= val .* induce(hom, inv(b[idx]))
    end

    return result
end

## Finding basis of the row-space (right image) of an AbstractMatrix

"""
    image_basis(A::AbstractMatrix)
    image_basis([hom::InducedActionHomomorphism, ]χ::Character)
    image_basis([hom::InducedActionHomomorphism, ]α::AlgebraElement)
Return basis of the row-space of a matrix.

For characters or algebra elements return a basis of the row-space of
`matrix_projection([hom, ]χ)` or `matrix_representation([hom, ]α)`.

Two methods are employed to achieve the goal.
* By default (symbolic, exact) row echelon form is produced, and therefore there is no guarantee on the orthogonality of the returned basis vectors (rows).
* If `eltype(A) <: AbstractFloat` this is followed by a call to `svd` and the appropriate rows of its `Vt` are returned, thus the basis is (numerically) orthonormal.

# Examples:
```julia
julia> a = rand(-3:3, 3,3).//rand(1:4, 3,3);

julia> a[3, :] .= 2a[1, :] .- 1a[2, :]; a
3×3 Matrix{Rational{Int64}}:
  3//2   0//1  1//1
 -1//2  -2//1  1//2
  7//2   2//1  3//2

julia> ib = SymbolicWedderburn.image_basis(a)
2×3 Matrix{Rational{Int64}}:
 1//1  0//1   2//3
 0//1  1//1  -5//12

julia> ibf = SymbolicWedderburn.image_basis(float.(a))
2×3 Matrix{Float64}:
 -0.666651  0.416657  -0.618041
  0.529999  0.847998  -8.85356e-17

```
"""
image_basis(A::AbstractMatrix) =
    ((m, p) = image_basis!(deepcopy(A)); m[1:length(p), :])

function image_basis(χ::Character)
    mpr = isirreducible(χ) ? matrix_projection_irr(χ) : matrix_projection(χ)
    image, pivots = image_basis!(mpr)
    return image[1:length(pivots), :]
end

function image_basis(hom::InducedActionHomomorphism, χ::Character)
    mpr =
        isirreducible(χ) ? matrix_projection_irr(hom, χ) :
        matrix_projection(hom, χ)
    image, pivots = image_basis!(mpr)
    return image[1:length(pivots), :]
end

function image_basis(α::AlgebraElement)
    image, pivots = image_basis!(matrix_representation(α))
    return image[1:length(pivots), :]
end

function image_basis(hom::InducedActionHomomorphism, α::AlgebraElement)
    image, pivots = image_basis!(matrix_representation(hom, α))
    return image[1:length(pivots), :]
end

image_basis!(A::AbstractMatrix) = row_echelon_form!(A)
function image_basis!(A::AbstractSparseMatrix)
    A, p = row_echelon_form!(A)
    dropzeros!(A)
    return A, p
end

function image_basis!(A::AbstractMatrix{T}) where {T<:Union{AbstractFloat,Complex}}
    A, p = row_echelon_form!(A)
    fact = svd!(convert(Matrix{T}, @view(A[1:length(p), :])))
    m = T <: Complex ? 2eps(real(T)) : eps(T)
    A_rank = sum(fact.S .> maximum(size(A)) * m)
    @assert A_rank == length(p)
    return fact.Vt, 1:length(p)
end


struct FakeScalar
end

@testset "polynomials" begin
    @polyvar x y z

    @testset "variables" begin
        @test @inferred(x * x) == @inferred(x^2)
        @test @inferred(x^1) == x
        @test @inferred(x^0) == 1
        @test (@wrappedallocs x * x) == 0
        @test (@wrappedallocs x^2) == 0
        @test (@wrappedallocs x^1) == 0
        @test (@wrappedallocs x^0) == 0
        @test @inferred(zero(x)) == @inferred(zero(typeof(x)))
        @test @inferred(one(x)) == 1
        @test @inferred(zero(x)) == @inferred(0 * x)
        @test nvariables(x) == 1
        @test nvariables(y) == 1
    end

    @testset "orderings" begin
        @test Monomial(y) < Monomial(x)
        @test Monomial(x) > Monomial(y)
        @test Monomial(y) < x
        @test y < Monomial(x)
        @test y < x
        @test x > y
        @test x > Monomial(y)
        @test Monomial(x) > y

        @test x == x
        @test x == Monomial(x)
        @test x == 1x
        @test x != y
        @test x != Monomial(y)
        @test x != 1y
        @test x != nothing
        @test x != 0

        @test x > y
        @test x^1 > y
        @test x^1 > y^1
        @test 1x^1 > 1y^1
        @test x^1 > 1y^1
        @test 1x^1 > y^1
        @test y < x
        @test y < x^1
        @test y^1 < x
        @test 1y^1 < x
        @test 1y^1 < 1x^1
        @test 1x < 2x
        @test 2x > 1x
    end

    @testset "monomials" begin
        m = x^2
        @test isa(m, Monomial)
        @test variables(m) == (x,)
        @test exponents(m) == (2,)
        @test degree(m, x) == 2
        @test degree(m, y) == 0
        @test degree(m, z) == 0
        @test nvariables(m) == 1

        m = x * y
        @test isa(m, Monomial)
        @test variables(m) == (x, y)
        @test exponents(m) == (1, 1)
        @test degree(m, x) == 1
        @test degree(m, y) == 1
        @test degree(m, z) == 0
        @test nvariables(m) == 2

        m = y * x
        @test isa(m, Monomial)
        @test variables(m) == (x, y)
        @test exponents(m) == (1, 1)
        @test degree(m, x) == 1
        @test degree(m, y) == 1
        @test degree(m, z) == 0

        m = y * x^2 * y^3
        @test isa(m, Monomial)
        @test variables(m) == (x, y)
        @test exponents(m) == (2, 4)
        @test degree(m, x) == 2
        @test degree(m, y) == 4

        @test x * y < x^2

        @test @wrappedallocs((x * y) < x^2) == 0

        @test @inferred(zero(m)) == @inferred(zero(typeof(m)))
        @test zero(m) == 0 * m

        @test @inferred(Monomial{tuple(), 0}()) == @inferred(x^0)

        @test @inferred(Monomial{(x, y)}([1, 2])) == Monomial{(x, y)}((1, 2))
    end

    @testset "terms" begin
        t = @inferred 3x
        @test isa(t, Term)
        @test variables(t) == (x,)
        @test coefficient(t) == 3
        @test monomial(t) == Monomial(x)

        t = @inferred x * 3
        @test isa(t, Term)
        @test variables(t) == (x,)
        @test coefficient(t) == 3
        @test monomial(t) == Monomial(x)

        t = @inferred (2x) * y * x
        @test isa(t, Term)
        @test variables(t) == (x, y)
        @test coefficient(t) == 2
        @test exponents(t) == (2, 1)
        @test degree(t, x) == 2
        @test degree(t, y) == 1

        @test @inferred(zero(t)) == @inferred(zero(typeof(t)))
        @test zero(t) == 0 * t
        @test @inferred(one(t)) == @inferred(one(typeof(t)))
        @test 1 == one(t) == 1 * t^0

        m1 = x * y * z^3 * x^2 * y
        m2 = x^3 * y^3 * z^2
        t1 = 2m1
        t2 = 2m2
        @test (@wrappedallocs t1 < t2) == 0

        @test -(2x^2 * y ) == -1 * (2y * x^2)

        @test TypedPolynomials.monomialtype(5 * x * y) == Monomial{(x, y), 2}
    end

    @testset "polynomials" begin
        p = @inferred x + 1
        @test isa(p, Polynomial)
        @test p.terms[1] == Term(x)
        @test variables(p) == (x,)

        @test @inferred(zero(p)) == @inferred(zero(typeof(p)))
        @test zero(p) == 0 * p
        @test @inferred(one(p)) == @inferred(one(typeof(p)))
        @test one(p) == 1

        @test mindegree(p) == 0
        @test maxdegree(p) == 1
        @test extdegree(p) == (0, 1)
        @test nvariables(p) == 1

        p = @inferred x^2 + x * x
        @test isa(p, Polynomial)
        @test length(terms(p)) == 1
        @test coefficient(terms(p)[1]) == 2

        @test mindegree(p) == 2
        @test maxdegree(p) == 2
        @test extdegree(p) == (2, 2)
        @test nvariables(p) == 1

        p = @inferred (1 + x) + (y + 2)
        @test coefficient(terms(p)[3]) == 3
        @test exponents(terms(p)[3]) == (0, 0)
        @test variables(p) == (x, y)
        @test coefficient(terms(p)[2]) == 1
        @test exponents(terms(p)[2]) == (0, 1)
        @test coefficient(terms(p)[1]) == 1
        @test exponents(terms(p)[1]) == (1, 0)

        @test mindegree(p) == 0
        @test maxdegree(p) == 1
        @test extdegree(p) == (0, 1)
        @test nvariables(p) == 2

        p = @inferred x^2 + y + x * x + 3 * x * y + x * y^2
        @test length(terms(p)) == 4
        @test coefficient.(terms(p)) == [1, 2, 3, 1]
        @test exponents.(terms(p)) == [(1, 2), (2, 0), (1, 1), (0, 1)]

        @test mindegree(p) == 1
        @test maxdegree(p) == 3
        @test extdegree(p) == (1, 3)
        @test nvariables(p) == 2

        @test (@wrappedallocs x^2 + y + x * x + 3 * x * y + x * y) <= 1376
        @test (@wrappedallocs x^2 + 1) <= 384

        @test (1 + x) * (x + 3) == 3 + 4x + x^2
        @test (2.0 + x) * (y + 1) == 2 + 2y + x + x * y
        @test (x + 1) - 1 == x

        @test @inferred(Polynomial(x) * x^2) == x^3
        @test @inferred((x + y) * x^2) == @inferred(x^3 + x^2 * y)

        @test @inferred(Polynomial([x, y])) == y + x
    end

    @testset "equality" begin
        @test 1 + x == 1 + x
        @test 1 + x == x + 1
        @test 1 + (1 + 1e-16) * x ≈ 1 + x
        @test 2 + 3 + x != 3 + x
        @test 2 + 3 + x == 5 + x
        @test x * y + 2 != y
        @test x * y + 2 == x * y + 2 * x^0
        @test x != nothing
        @test x^2 != nothing
        @test 3x != nothing
        @test x + 1 != nothing
        @test nothing != x
        @test nothing != x^2
        @test nothing != 3x
        @test nothing != x + 1

        @test Polynomial([1, 0 * x, y]) == Polynomial([1, y])
        @test Polynomial([1, 1 * x, y]) != Polynomial([1, y])
        @test Polynomial([1, y]) == Polynomial([1, 0 * x, y])
        @test Polynomial([1, y]) != Polynomial([1, 1 * x, y])
    end

    @testset "ordering" begin
        @test x > y
        @test Monomial(x) > Monomial(y)
        @test y < x
        @test Monomial(y) < Monomial(x)
        @test x^2 > x
        @test y^2 > x
        @test y^2 < x^2
        @test 3x < 5x
        @test 3x^2 > 5x
        @test 5x < x^2
        @test 1x^3 > 10y^3
    end

    @testset "linear algebra" begin
        @test @inferred([x, y]' * [1 2; 3 4] * [x, y]) == x^2 + 5 * x * y + 4 * y^2
        @test @inferred([x, y]' * [1 2; 3 4]) == [(x + 3y) (2x + 4y)]
        @test @inferred([x, y]' * [-1, 3]) == 3y - x
    end

    function testmonomials(var, degree)
        [var^i for i in 0:degree]
    end

    @testset "monomial vector" begin
        ms = @inferred testmonomials(x, 3)
        @test eltype(ms) == Monomial{(x,), 1}
    end

    @testset "operators" begin
        @test !iszero(x)
        @test !iszero(x^2)
        @test !iszero(5x)
        @test !iszero(5x + 1)
        @test iszero(0 * x)
        @test iszero(0 * x + 0)

        @test (x)' == x
        @test (x^2)' == x^2
        @test (Term([1 2; 3 4], x))' == Term([1 2; 3 4]', x)

        @test @inferred(dot(1, x)) == 1x
        @test @inferred(dot(x, 5)) == 5x
        @test @inferred(dot(Term([1, 2], x), Term([3, 4], y))) == [1, 2]' * [3, 4] * x * y
    end

    @testset "linear algebra with tuples" begin
        @polyvar x[1:2] y z

        @test x .+ x == 2 .* x
        @test x .- y == (x[1] - y, x[2] - y)

        @test dot(x, x) == x[1]^2 + x[2]^2
        @test dot(x, [y, z]) == x[1]*y + x[2]*z
        @test dot([y, z], x) == x[1]*y + x[2]*z

        xv = @inferred(vec(x))
        @test @inferred(dot(xv, xv)) == x[1]^2 + x[2]^2
        @test @inferred(dot(xv, [y, z])) == x[1]*y + x[2]*z
        @test @inferred(dot([y, z], xv)) == x[1]*y + x[2]*z

        @test @inferred([1 2; 3 4] * xv) == [x[1] + 2x[2], 3x[1] + 4x[2]]
        @test @inferred(dot(xv, [1 2; 3 4] * xv)) == x[1]^2 + 5x[1]*x[2] + 4x[2]^2
    end

    @testset "Term construction shortcut" begin
        @polyvar x y z

        # Verify that our shortcut that (*)(x, m::MonomialLike) = Term(x, m) works
        @test typeof(@inferred(FakeScalar() * x)) == Term{FakeScalar, Monomial{(x,), 1}}
        @test typeof(@inferred(FakeScalar() * x^2)) == Term{FakeScalar, Monomial{(x,), 1}}
        @test typeof(@inferred(x * FakeScalar())) == Term{FakeScalar, Monomial{(x,), 1}}
        @test typeof(@inferred(x^2 * FakeScalar())) == Term{FakeScalar, Monomial{(x,), 1}}
    end
end


"""
    ExplainedVariance(PCA::PCA)

Calculates the explained variance of each singular value in a pca object.
"""
ExplainedVariance(PCA::PCA) = ( PCA.Values .^ 2 ) ./ sum( PCA.Values .^ 2 )

"""
    ExplainedVariance(lda::LDA)

Calculates the explained variance of each singular value in an LDA object.
"""
ExplainedVariance(lda::LDA) = (lda.Values .^ 2) ./ sum(lda.Values .^ 2)

"""
    ExplainedVarianceX(X,Y, pls::PartialLeastSquares)

Calculates the explained variance in `X` & `Y` of each latent variable in a PartialLeastSquares object.
"""
function ExplainedVariance( X,Y, pls::PartialLeastSquares )
    total_x_var = sum(pls.XVariance)
    total_y_var = sum(pls.YVariance)
    expvarx = zeros(Float64, pls.Factors)
    expvary = zeros(Float64, pls.Factors)
    for lv in 1:pls.Factors
        X_residuals = Statistics.var( ( pls.XScores[:,1:lv] * pls.XLoadings[:,1:lv]') .- X, dims = 1)
        expvarx[lv] = (total_x_var - sum(X_residuals)) / total_x_var
        Y_residuals = Statistics.var( ( pls.YScores[:,1:lv] * pls.YLoadings[:,1:lv]') .- Y, dims = 1)
        expvary[lv] = (total_y_var - sum(Y_residuals)) / total_y_var
    end
    return Dict( "X" => expvarx, "Y" => expvary )
end

"""
    ExplainedVarianceX(X,Y, pls::PartialLeastSquares)

Calculates the explained variance in `X` of each latent variable in a PartialLeastSquares object.
"""
function ExplainedVarianceX( X, pls::PartialLeastSquares )
    total_x_var = sum(pls.XVariance)
    expvarx = zeros(Float64, pls.Factors)
    for lv in 1:pls.Factors
        X_residuals = Statistics.var( ( pls.XScores[:,1:lv] * pls.XLoadings[:,1:lv]') .- X, dims = 1)
        expvarx[lv] = (total_x_var - sum(X_residuals)) / total_x_var
    end
    return expvarx
end

"""
    ExplainedVarianceY(Y, pls::PartialLeastSquares)

Calculates the explained variance in `Y` of each latent variable in a PartialLeastSquares object.
"""
function ExplainedVarianceY( Y, pls::PartialLeastSquares )
    total_y_var = sum(pls.YVariance)
    expvary = zeros(Float64, pls.Factors)
    for lv in 1:pls.Factors
        Y_residuals = Statistics.var( ( pls.YScores[:,1:lv] * pls.YLoadings[:,1:lv]') .- Y, dims = 1)
        expvary[lv] = (total_y_var - sum(Y_residuals)) / total_y_var
    end
    return expvary
end

"""
    Leverage(X::Array)

Calculates the leverage of samples in a `X` from the perspective of a linearly addative model.
"""
Leverage(X::Array) = LinearAlgebra.diag( X * Base.inv(transpose(X)*X)*transpose(X) )

"""
    Leverage(pca::PCA)

Calculates the leverage of samples in a `pca` object.
"""
function Leverage(pca::PCA)
    H = LinearAlgebra.diag(pca.Scores * Base.inv(pca.Scores' * pca.Scores) * pca.Scores')
    if any(H .< 1e-9)
        @warn("Negative Leverage values. Please center X matrix.")
    end
    return H
end

"""
    Leverage(pls::PartialLeastSquares)

Calculates the leverage of samples in a `pls` object.
"""
function Leverage(pls::PartialLeastSquares)
    H = diag(pls.XScores * Base.inv(pls.XScores' * pls.XScores) * pls.XScores')
    if any(H .< 1e-9)
        @warn("Negative Leverage values. Please center X & Y matrices.")
    end
    return H
end

struct Hotelling
    Lambda::Array
    Rotations::Array
    UpperLimit::Float64
end

"""
    Hotelling(X, pca::PCA; Quantile = 0.05, Variance = 1.0)

Computes the hotelling Tsq and upper control limit cut off of a `pca` object using a specified `Quantile` and
cumulative variance explained `Variance` for new or old data `X`. Stores this to a struct which can be used for new data.

A review of PCA-based statistical process monitoring methodsfor time-dependent, high-dimensional data. Bart De Ketelaere
https://wis.kuleuven.be/stat/robust/papers/2013/deketelaere-review.pdf
"""
function Hotelling(X, pca::PCA; Quantile = 0.05, Variance = 1.0)
    (Obs,Vars) = size(X)
    CumVar = cumsum( ExplainedVariance( pca ) )
    PCs = sum( CumVar .<= Variance )
    @assert PCs > 0
    #Truncate loadings & scores
    Scores = pca(X; Factors = PCs)
    #Hotelling Statistic: T 2 = (X^T) W Λ − 1 W ˆ T X
    #Λ ˆ = diag ( l 1 , l 2 ,.., l l )
    Lambda = sqrt.( LinearAlgebra.Diagonal( 1.0 ./ ( pca.Values[1:PCs] ) ) )
    if Obs < 100#vetted this threshold, the calculations are correct.
        Scalar = ( PCs * ((Obs^2) - 1) ) / ( Obs * ( Obs - PCs ) )
        Threshold = Scalar * quantile(Distributions.FDist( PCs, Obs - PCs ), Quantile)
    else
        Threshold =  quantile( Chisq( PCs ),  Quantile )
    end
    return Hotelling( Lambda, (Diagonal( 1.0 ./ pca.Values[1:PCs]) * pca.Loadings[1:PCs,:])', Threshold)
end

"""
    Hotelling(X, PLS::PartialLeastSquares; Quantile = 0.05, LVs = 1)

Computes the hotelling Tsq and upper control limit cut off of a `PartialLeastSquares` object using a specified `Quantile` and
cumulative variance explained `Variance` for new or old data `X`. Stores this to a struct which can be used for new data.

Note: The number of latent variables cannot be automatically set by the explained variance in X. It is not computed cumulatively.

Informative PLS score-loading plots for processunderstanding and monitoring. Rolf Ergon.
Journal of Process Control 14 (2004) 889-897
https://pdfs.semanticscholar.org/89b6/677a592dbe05a9b754d377ade416d7a17393.pdf
"""
function Hotelling(X, pls::PartialLeastSquares; Quantile = 0.05, LVs = 1)
    (Obs,Vars) = size(X)
    @assert LVs > 0
    #Truncate loadings & scores
    normloads = pls.XLoadings[:,1:LVs] ./ sum( pls.XLoadings[:,1:LVs] .^ 2, dims = 1) ;
    Scores = X * normloads #* pls.RWeights[ : , 1:LVs ]
    #Hotelling Statistic: T 2 = (X^T) W Λ − 1 W ˆ T X
    #Λ ˆ = diag ( l 1 , l 2 ,.., l l )
    Lambda = LinearAlgebra.Diagonal( 1. ./ LinearAlgebra.diag( Scores' * Scores )  )
    if Obs < 100
        Scalar = ( LVs * ((Obs^2) - 1) ) / ( Obs * ( Obs - LVs ) )
        Threshold = Scalar * quantile(Distributions.FDist( LVs, Obs - LVs ), Quantile)
    else
        Threshold = quantile( Chisq( LVs ),  Quantile )
    end
    return Hotelling( Lambda, normloads, Threshold )
end

"""
    (H::Hotelling)(X)

Retrieves the `T^2` statistic from a saved Hotelling model.
Note 1: This does not automatically center or scale `X`.
Note 2: if the model used to generate the Hotelling struct changes, so will the Hotelling struct(pass by reference).

"""
function (H::Hotelling)(X)
    Scores = X * H.Rotations
    return diag( Scores * H.Lambda * Scores' )
end

struct Q
    Rotations::Array
    Projection::Array
    UpperLimit::Float64
end

"""
    Q(X, pca::PCA; Quantile = 0.95, Variance = 1.0)

Computes the Q-statistic and upper control limit cut off of a `pca` object using a specified `Quantile` and
cumulative variance explained `Variance` for new or old data `X`.

A review of PCA-based statistical process monitoring methodsfor time-dependent, high-dimensional data. Bart De Ketelaere
https://wis.kuleuven.be/stat/robust/papers/2013/deketelaere-review.pdf
"""
function Q(X, pca::PCA; Quantile = 0.95, Variance = 1.0)
    (Obs,Vars) = size(X)
    CumVar = cumsum( ExplainedVariance( pca ) )
    PCs = sum(CumVar .<= Variance)
    #Q = diag(X * (LinearAlgebra.Diagonal(ones(Vars)) - pca.Loadings[1:PCs,:]' * pca.Loadings[1:PCs,:]) * X')
    L = [ sum(pca.Values[(PCs + 1) : end] .^ order) for order in [ 1, 2, 3 ] ]
    H0 = 1.0 - ( ( 2.0 * L[ 1 ] * L[ 3 ] ) / ( 3.0 * L[ 2 ]^2 ) )
    if H0 < 1e-5
        H0 = 1e-5
    end
    Gauss = quantile( Normal(),  Quantile )
    FirstTerm = ( Gauss * sqrt( 2.0 * L[2] * (H0^2.0) ) ) / L[1]
    SecondTerm =  (L[2] * H0 * ( 1.0 - H0 ) ) / (L[1] ^ 2.0)
    Upper = L[1] * ( FirstTerm + 1.0 + SecondTerm ) ^ 2.0
    return Q( pca.Loadings[1:PCs,:]',
              LinearAlgebra.I - pca.Loadings[1:PCs,:]' * pca.Loadings[1:PCs,:],
              Upper )
end

"""
    Q(X, pls::PartialLeastSquares; Quantile = 0.95, Variance = 1.0)

Computes the Q-statistic and upper control limit cut off of a `pca` object using a specified `Quantile` and
cumulative variance explained `Variance` for new or old data `X`.

Note: The number of latent variables cannot be automatically set by the explained variance in X. It is not computed cumulatively.

A review of PCA-based statistical process monitoring methodsfor time-dependent, high-dimensional data. Bart De Ketelaere
https://wis.kuleuven.be/stat/robust/papers/2013/deketelaere-review.pdf
"""
function Q(X, pls::PartialLeastSquares; Quantile = 0.95,  LVs = 1)
    (Obs,Vars) = size(X)
    normloads = pls.XLoadings[:,1:LVs] ./ sum( pls.XLoadings[:,1:LVs] .^ 2, dims = 1);
    proj = X * normloads * normloads'
    resids = proj .- X
    #Q = LinearAlgebra.diag(resids * (LinearAlgebra.I - normloads * normloads') * resids')
    eigvals = LinearAlgebra.svd( resids; full = false ).S #.^ 2
    L = [ sum(eigvals[(LVs + 1) : end] .^ order) for order in [ 1, 2, 3 ] ]
    H0 = 1.0 - ( ( 2.0 * L[ 1 ] * L[ 3 ] ) / ( 3.0 * L[ 2 ]^2 ) )
    if H0 < 1e-5
        H0 = 1e-5
    end
    Gauss = quantile( Normal(),  Quantile )
    FirstTerm = ( Gauss * sqrt( 2.0 * L[2] * (H0^2.0) ) ) / L[1]
    SecondTerm =  (L[2] * H0 * ( 1.0 - H0 ) ) / (L[1] ^ 2.0)
    Upper = L[1] * ( FirstTerm + 1.0 + SecondTerm ) ^ 2.0
    return Q(normloads, LinearAlgebra.I - normloads * normloads', Upper)
end

function (qr::Q)(X)
    proj = X * qr.Rotations * qr.Rotations'
    resids = proj .- X
    return LinearAlgebra.diag(resids * qr.Projection * resids')
end


## hclust.jl (c) 2014 David A. van Leeuwen
## Hierarchical clustering, similar to R's hclust()

## Algorithms are based upon C. F. Olson, Parallel Computing 21 (1995) 1313--1325.

## This is also in types.jl, but that is not read...
## Mostly following R's hclust class
type Hclust{T<:Real}
    merge::Matrix{Int}
    height::Vector{T}
    order::Vector{Int}
    labels::Vector
    method::Symbol
end

function assertdistancematrix(d::AbstractMatrix)
    nr, nc = size(d)
    nr == nc || throw(DimensionMismatch("Distance matrix should be square."))
    issym(d) || error("Distance matrix should be symmetric.")
end

## This seems to work like R's implementation, but it is extremely inefficient
## This probably scales O(n^3) or worse. We can use it to check correctness
function hclust_n3{T<:Real}(d::AbstractMatrix{T}, method::Function)
    assertdistancematrix(d)
    mr = Int[]                  # min row
    mc = Int[]                  # min col
    h = T[]                     # height
    nc = size(d,1)              # number of clusters
    cl = -[1:nc]                # segment to cluster attribution, initially negative
    next = 1                    # next cluster label
    while next < nc
        mindist = Inf
        mi = mj = 0
        cli = unique(cl)
        mask = BitVector(nc)
        for j in 1:length(cli)           # loop over for lower triangular indices, i>j
            cols = cl .== cli[j]
            for i in (j+1):length(cli)
                rows = cl.==cli[i]
                distance = method(d[rows,cols]) # very expensive
                if distance < mindist
                    mindist = distance
                    mi = cli[i]
                    mj = cli[j]
                    mask = cols | rows
                end
            end
        end
        ## simulate R's order
        if mi < 0 && mj < 0 && mi > mj ||
            mi > 0 && mj > 0 && mi < mj ||
            mi < 0 && mj > 0
            push!(mr, mi)
            push!(mc, mj)
        else
            push!(mr, mj)
            push!(mc, mi)
        end
        push!(h, mindist)
        cl[mask] = next
        next += 1
    end
    hcat(mr, mc), h
end

## Efficient single link algorithm, according to Olson, O(n^2), fig 2.
## Verified against R's implementation, correct, and about 2.5 x faster
## For each i < j compute D(i,j) (this is already given)
## For each 0 < i <= n compute Nearest Neighbor N(i)
## Repeat n-1 times
##   find i,j that minimize D(i,j)
##   merge clusters i and j
##   update D(i,j) and N(i) accordingly
function hclust_minimum{T<:Real}(ds::Symmetric{T})
    ## For each i < j compute d[i,j] (this is already given)
    d = full(ds)                #  we need a local copy
    nc = size(d,1)
    mr = Array(Int, nc-1)       # min row
    mc = Array(Int, nc-1)       # min col
    h = Array(T, nc-1)          # height
    merges = -[1:nc]
    next = 1
    ## For each 0 < i <= n compute Nearest Neighbor N[i]
    N = zeros(Int, nc)
    for k = 1:nc
        mindist = Inf
        mk = 0
        for i = 1:(k-1)
            if d[i,k] < mindist
                mindist = d[i,k]
                mk = i
            end
        end
        for j = (k+1):nc
            if d[k,j] < mindist
                mindist = d[k,j]
                mk = j
            end
        end
        N[k] = mk
    end
    ## the main loop
    while nc > 1                # O(n)
        mindist = d[1,N[1]]
        i = 1
        for k in 2:nc           # O(n)
            if k < N[k]
                distance = d[k,N[k]]
            else
                distance = d[N[k],k]
            end
            if distance < mindist
                mindist = distance
                i = k
            end
        end
        j = N[i]
        if i > j
            i, j = j, i     # make sure i < j
        end
        ## update result, compatible to R's order.  It must be possible to do this simpler than this...
        if merges[i] < 0 && merges[j] < 0 && merges[i] > merges[j] ||
            merges[i] > 0 && merges[j] > 0 && merges[i] < merges[j] ||
            merges[i] < 0 && merges[j] > 0
            mr[next] = merges[i]
            mc[next] = merges[j]
        else
            mr[next] = merges[j]
            mc[next] = merges[i]
        end
        h[next] = mindist
        merges[i] = next
        merges[j] = merges[nc]
        ## update d, split in ranges k<i, i<k<j, j<k<=nc
        for k = 1:(i-1)         # k < i
            if d[k,i] > d[k,j]
                d[k,i] = d[k,j]
            end
        end
        for k = (i+1):(j-1)     # i < k < j
            if d[i,k] > d[k,j]
                d[i,k] = d[k,j]
            end
        end
        for k = (j+1):nc        # j < k <= nc
            if d[i,k] > d[j,k]
                d[i,k] = d[j,k]
            end
        end
        ## move the last row/col into j
        for k=1:(j-1)           # k==nc,
            d[k,j] = d[k,nc]
        end
        for k=(j+1):(nc-1)
            d[j,k] = d[k,nc]
        end
        ## update N[k], k !in (i,j)
        for k=1:nc
            if N[k] == j       # update nearest neigbors != i
                N[k] = i
            elseif N[k] == nc
                N[k] = j
            end
        end
        N[j] = N[nc]            # update N[j]
        ## update nc, next
        nc -= 1
        next += 1
        ## finally we need to update N[i], because it was nearest to j
        mindist = Inf
        mk = 0
        for k=1:(i-1)
            if d[k,i] < mindist
                mindist = d[k,i]
                mk = k
            end
        end
        for k = (i+1):nc
            if d[i,k] < mindist
                mindist = d[i,k]
                mk = k
            end
        end
        N[i] = mk
#        for n in N[1:nc] print(n, " ") end; println()
    end
    return hcat(mr, mc), h
end

## functions to compute maximum, minimum, mean for just a slice of an array

function slicemaximum{T<:Real}(d::AbstractMatrix{T}, cl1::Vector{Int}, cl2::Vector{Int})
    maxdist = -Inf
    for i in cl1 for j in cl2
        if d[i,j] > maxdist
            maxdist = d[i,j]
        end
    end end
    maxdist
end

function sliceminimum{T<:Real}(d::AbstractMatrix{T}, cl1::Vector{Int}, cl2::Vector{Int})
    mindist = Inf
    for i in cl1 for j in cl2
        if d[i,j] < mindist
            mindist = d[i,j]
        end
    end end
    mindist
end

function slicemean{T<:Real}(d::AbstractMatrix{T}, cl1::Vector{Int}, cl2::Vector{Int})
    s = zero(T)
    for i in cl1 for j in cl2
        s += d[i,j]
    end end
    s / (length(cl1)*length(cl2))
end

## This reorders the pairs to be compatible with R's hclust()
function rorder!(mr, mc, h)
    o = sortperm(h)
    io = invperm(o)
    for i in 1:length(mr)
        if mr[i] > 0
            mr[i] = io[mr[i]]
        end
        if mc[i] > 0
            mc[i] = io[mc[i]]
        end
        ## R's order of pairs
        if ! (mr[i] < 0 && mc[i] < 0 && mr[i] > mc[i] ||
              mr[i] > 0 && mc[i] > 0 && mr[i] < mc[i] ||
              mr[i] < 0 && mc[i] > 0)
            mr[i], mc[i] = mc[i], mr[i]
        end
    end
    return o
end

## Another nearest neighbor algorithm, for reducible metrics
## From C. F. Olson, Parallel Computing 21 (1995) 1313--1325, fig 5
## Verfied against R implementation for mean and maximum, correct but ~ 5x slower
## Pick c1: 0 <= c1 <= n random
## i <- 1
## repeat n-1 times
##   repeat
##     i++
##     c[i] = nearest neigbour c[i-1]
##   until c[i] = c[i-2] ## nearest of nearest is cluster itself
##   merge c[i] and nearest neigbor c[i]
##   if i>3 i -= 3 else i <- 1
function hclust2{T<:Real}(d::Symmetric{T}, method::Function)
    nc = size(d,1)                      # number of clusters
    mr = Array(Int, nc-1)               # min row
    mc = Array(Int, nc-1)               # min col
    h = Array(T, nc-1)                  # height
    cl = [[x] for x in 1:nc]            # clusters
    merges = -[1:nc]
    next = 1
    i = 1
    N = Array(Int, nc+1)
    N[1] = 1                            # arbitrary choice
    while nc > 1
        found=false
        mindist = Inf
        while !found
            i += 1
            mi = 0
            mindist = Inf
            Nim1 = N[i-1]
            ## c[i] = nearest neigbour c[i-1]
            for j = 1:nc if Nim1 != j
                distance = method(d, cl[Nim1], cl[j])
                if distance < mindist
                    mindist = distance
                    mi = j
                end
            end end
            N[i] = mi           # N[i+1] is nearest neigbor to N[i]
            found = i > 2 && N[i] == N[i-2]
        end
        ## merge c[i] and nearest neigbor c[i], i.e., c[i-1]
        if N[i-1] < N[i]
            lo, high = N[i-1], N[i]
        else
            lo, high = N[i], N[i-1]
        end
        ## first, store the result
        mr[next] = merges[lo]
        mc[next] = merges[high]
        h[next] = mindist
        merges[lo] = next
        merges[high] = merges[nc]
        next += 1
        ## then perform the actual merge
        cl[lo] = vcat(cl[lo], cl[high])
        cl[high] = cl[nc]
        if i>3
            i -= 3
        else
            i = 1
        end
        ## replace any nearest neighbor referring to nc
        for k=1:i
            if N[k] == nc
                N[k] = high
            end
        end
        nc -= 1
    end
    ## fix order for presenting result
    o = rorder!(mr, mc, h)
    hcat(mr[o], mc[o]), h[o]
end

## this calls the routine that gives the correct answer, fastest
## method names are inspired by R's hclust
function hclust{T<:Real}(d::Symmetric{T}, method::Symbol)
    nc = size(d,1)
    if method == :single
        h = hclust_minimum(d)
    elseif method == :complete
        h = hclust2(d, slicemaximum)
    elseif method == :average
        h = hclust2(d, slicemean)
    else
        error("Unsupported method ", method)
    end
    ## order and label are placeholders for the moment
    Hclust(h..., [1:nc], [1:nc], method)
end

## uplo may be Char for v0.3, Symbol for v0.4
hclust{T<:Real}(d::AbstractMatrix{T}, method::Symbol, uplo) = hclust(Symmetric(d, uplo), method)

function hclust{T<:Real}(d::AbstractMatrix{T}, method::Symbol)
    assertdistancematrix(d)
    hclust(Symmetric(d), method)
end

## cut a tree at height `h' or to `k' clusters
function cutree(hclust::Hclust; k::Int=1,
                h::Real=maximum(hclust.height))
    clusters = Vector{Int}[]
    nnodes = length(hclust.labels)
    nodes = [[i::Int] for i=1:nnodes]
    N = nnodes - k
    i = 1
    while i<=N && hclust.height[i] <= h
        both = vec(hclust.merge[i,:])
        new = Int[]
            for x in both
                if x<0
                    push!(new, -x)
                    nodes[-x] = []
                else
                    append!(new, clusters[x])
                    clusters[x] = []
                end
            end
        push!(clusters, new)
        i += 1
    end
    all = vcat(clusters, nodes)
    all = all[map(length, all) .> 0]
    ## convert to a single array of cluster indices
    res = Array(Int, nnodes)
    for (i,cl) in enumerate(all)
        res[cl] = i
    end
    res
end

## some diagnostic functions, not exported
function printupper(d::Matrix)
    n = size(d,1)
    for i = 1:(n-1)
        print(" " ^ ((i-1) * 6))
        for j = (i+1):n
            print(@sprintf("%5.2f ", d[i,j]))
        end
        println()
    end
end


export AdaGrad

"""
    AdaGrad

AdaGrad Optimizer.

# References
* Duchi t al., ["Adaptive Subgradient Methods for Online Learning and Stochastic Optimization"](http://www.jmlr.org/papers/volume12/duchi11a/duchi11a.pdf), JMLR 2011.
"""
mutable struct AdaGrad
    alpha::Float64
    states::IdDict
end

AdaGrad(alpha::Float64) = AdaGrad(alpha, IdDict())

function (opt::AdaGrad)(value::Array{T}, grad::Array{T}) where T
    state = get!(opt.states, value, nothing)
    if state == nothing
        sqgrad = zeros(T, length(value))
        opt.states[value] = sqgrad
    else
        sqgrad = state::Array{T}
    end
    @inbounds for i = 1:length(grad)
        sqgrad[i] += grad[i] * grad[i]
        if abs(sqgrad[i]) > T(1e-8)
            value[i] -= T(opt.alpha) * grad[i] / sqrt(sqgrad[i])
        end
    end
    fill!(grad, T(0.0))
end
(opt::AdaGrad)(x::Var) = opt(x.data, x.grad)


# Find the smallest order of magnitude that is larger than xspan This is a
# little opaque because I want to avoid assuming the log function is defined
# over typeof(xspan)
function bounding_order_of_magnitude(xspan)
    DT = typeof(xspan)
    one_dt = one(DT)

    a = 1
    step = 1
    while xspan < 10.0^a * one_dt
        a -= step
    end

    b = 1
    step = 1
    while xspan > 10.0^b * one_dt
        b += step
    end

    while a + 1 < b
        c = div(a + b, 2)
        if xspan < 10.0^c * one_dt
            b = c
        else
            a = c
        end
    end

    return b
end

# Empty catchall
optimize_ticks() = {}

# Find some reasonable values for tick marks.
#
# This is basically Wilkinson's ad-hoc scoring method that tries to balance
# tight fit around the data, optimal number of ticks, and simple numbers.
#
# Args:
#   x_min: minimum value occuring in the data.
#   x_max: maximum value occuring in the data.
#   Q: tick intervals and scores
#   k_min: minimum number of ticks
#   k_max: maximum number of ticks
#   k_ideal: ideal number of ticks
#   strict_span: true if no ticks should be outside [x_min, x_max].
#
# Returns:
#   A Float64 vector containing tick marks.
#
function optimize_ticks{T}(x_min::T, x_max::T; extend_ticks::Bool=false,
                           Q=[(1.0,1.0), (5.0, 0.9), (2.0, 0.7), (2.5, 0.5), (3.0, 0.2)],
                           k_min=2, k_max=10, k_ideal=5,
                           strict_span=false)

    Qv = [(float64(q[1]), float64(q[2])) for q in Q]
    optimize_ticks_typed(x_min, x_max, extend_ticks, Qv, k_min, k_max, k_ideal, strict_span)
end

function optimize_ticks_typed{T}(x_min::T, x_max::T, extend_ticks, Q::Vector{(Float64,Float64)}, k_min,
                           k_max, k_ideal, strict_span)
    one_t = one(T)
    if x_min == x_max
        R = typeof(1.0 * one_t)
        return R[x_min], x_min - one_t, x_min + one_t
    end

    const n = length(Q)

    # generalizing "order of magnitude"
    xspan = x_max - x_min
    z = bounding_order_of_magnitude(xspan)

    high_score = -Inf
    z_best = 0.0
    k_best = 0.0
    r_best = 0.0
    q_best = 0.0

    while k_max * 10.0^(z+1) * one_t > xspan
        for k in k_min:k_max
            for (q, qscore) in Q
                span = (k - 1) * q * 10.0^z * one_t
                if span < xspan
                    continue
                end

                r = ceil((x_max - span) / (q*10.0^z * one_t))
                while r*q*10.0^z * one_t <= x_min
                    has_zero = r <= 0 && abs(r) < k

                    # simplicity
                    s = has_zero ? 1.0 : 0.0

                    # granularity
                    g = 0 < k < 2k_ideal ? 1 - abs(k - k_ideal) / k_ideal : 0.0

                    # coverage
                    c = 1.5 * xspan/span

                    score = (1/4)g + (1/6)s + (1/3)c + (1/4)qscore

                    # strict limits on coverage
                    if strict_span && span > xspan
                        core -= 10000
                    elseif !strict_span && (span >= 2.0*xspan || span < xspan)
                        score -= 1000
                    end

                    if score > high_score
                        (q_best, r_best, k_best, z_best) = (q, r, k, z)
                        high_score = score
                    end
                    r += 1
                end
            end
        end
        z -= 1
    end

    span = q_best * 10.0^z_best * one_t
    if extend_ticks
        S = Array(typeof(1.0 * one_t), int(3 * k_best))
        for i in 0:(3*k_best - 1)
            S[i+1] = (r_best + i - k_best) * span
        end
        viewmin, viewmax = S[k_best + 1], S[2 * k_best]
    else
        S = Array(typeof(1.0 * one_t), int(k_best))
        for i in 0:(k_best - 1)
            S[i+1] = (r_best + i) * span
        end
        viewmin, viewmax = S[1], S[end]
    end

    S, viewmin, viewmax
end

function optimize_ticks(x_min::Date, x_max::Date; extend_ticks::Bool=false,
                        k_min=nothing, k_max=nothing,
                        scale=:auto)
    # This can be pretty simple. We are choosing ticks on one of three
    # scales: years, months, days.
    if year(x_max) - year(x_min) <= 1 && scale != :year
        if year(x_max) == year(x_min) && month(x_max) - month(x_min) <= 1 && scale != :month
            ticks = Date[]
            if x_max - x_min > Day(7) && scale != :day
                # This will probably need to be smarter
                push!(ticks, x_min)
                while true
                    next_month = Date(year(ticks[end]), month(ticks[end])) + Month(1)
                    while ticks[end] + Week(1) < next_month - Day(2)
                        push!(ticks, ticks[end] + Week(1))
                    end
                    push!(ticks, next_month)
                    if next_month >= x_max
                        break
                    end
                end
            else
                push!(ticks, x_min)
                while ticks[end] < x_max
                    push!(ticks, ticks[end] + day(1))
                end
            end

            viewmin, viewmax = ticks[1], ticks[end]
            ticks, viewmin, viewmax
        else
            ticks = Date[]
            push!(ticks, Date(year(x_min), month(x_min)))
            while ticks[end] < x_max
                push!(ticks, ticks[end] + Month(1))
            end
            viewmin, viewmax = ticks[1], ticks[end]

            ticks, x_min, x_max
        end
    else
        ticks, viewmin, viewmax =
            optimize_ticks(year(x_min), year(x_max), extend_ticks=extend_ticks)
        return Date[Date(round(y)) for y in ticks],
                   Date(round(viewmin)), Date(round(viewmax))
    end
end

# Generate ticks suitable for multiple scales.
function multilevel_ticks{T}(viewmin::T, viewmax::T;
                             scales=[0.5, 5.0, 10.0])

    ticks = Dict()
    for scale in scales
        ticks[scale] = optimize_ticks(viewmin, viewmax,
                                       k_min=2*scale,
                                       k_max=max(3, 10*scale),
                                       k_ideal=max(2, 15*scale))[1]
    end

    return ticks
end

function multilevel_ticks(viewmin::Date, viewmax::Date;
                          scales=[:year, :month, :day])
    span = viewmax - viewmin
    ticks = Dict()
    for scale in scales
        if scale == :year
            s = span / Day(360)
        elseif scale == :month
            s = span / Day(90)
        else
            s = span / Day(1)
        end

        ticks[s/20] = optimize_ticks(viewmin, viewmax, scale=scale)[1]
    end

    return ticks
end


module WorkingGeoMakieCombo

using GeoMakie, Makie
export testmap1, testmap2

function testmap1()
    lons = LinRange(-179.5, 179.5, 360)
    lats = LinRange(-89.5, 89.5, 180)

    field = [exp(cosd(l)) + 3(y/90) for l in lons, y in lats]

    source = LonLat()
    dest = WinkelTripel()

    xs, ys = xygrid(lons, lats)
    Proj4.transform!(source, dest, vec(xs), vec(ys))

    scene = surface(xs, ys; color = field, shading = false, show_axis = false, scale_plot = false)

    geoaxis!(scene, extrema(lons), extrema(lats); crs = (src = source, dest = dest,))

    # coastlines!(scene; crs = (src = source, dest = dest,))
end

function testmap2()
    lons = LinRange(1, 30, 360)
    lats = LinRange(51, 74, 180)

    field = [exp(cosd(l)) + 3(y/90) for l in lons, y in lats]

    source = LonLat()
    dest = WinkelTripel()

    xs, ys = xygrid(lons, lats)
    Proj4.transform!(source, dest, vec(xs), vec(ys))

    scene = surface(xs, ys; color = field, shading = false, show_axis = false, scale_plot = false)

    geoaxis!(scene, extrema(lons), extrema(lats); crs = (src = source, dest = dest,))

    # coastlines!(scene; crs = (src = source, dest = dest,))
end

end # module


BASIC_NUMBER_RULES = let
    [@rule(identity(~x) => ~x)
     @rule(-(~x, ~y) => ~x + -1(~y))
     @rule(~x / ~y => ~x * pow(~y, -1))
     #@rule(*(~~x, *(~~y), ~~z) => *((~~x)..., (~~y)..., (~~z)...))
     @rule(*(~~x::isnotflat(*)) => flatten_term(*, ~~x))
     @rule(*(~~x::!(issortedₑ)) => sort_args(*, ~~x))
     @acrule(~a::isnumber * ~b::isnumber => ~a * ~b)

     #@rule(+(~~x, +(~~y), ~~z) => +((~~x)..., (~~y)..., (~~z)...))
     @rule(+(~~x::isnotflat(+)) => flatten_term(+, ~~x))
     @rule(+(~~x::!(issortedₑ)) => sort_args(+, ~~x))
     @acrule(~a::isnumber + ~b::isnumber => ~a + ~b)

     @acrule(*(~~x) + *(~β, ~~x) => *(1 + ~β, (~~x)...))
     @acrule(*(~α, ~~x) + *(~β, ~~x) => *(~α +  ~β, (~~x)...))
     @acrule(*(~~x, ~α) + *(~~x, ~β,) => *(~α +  ~β, (~~x)...))

     @acrule(~x + *(~β, ~x) => *(1 + ~β, ~x))
     @acrule(*(~α::isnumber, ~x) + ~x => *(~α + 1, ~x))

     # group stuff
     @rule(^(*(~~x), ~y) => *(map(a->pow(a, ~y), ~~x)...))
     @acrule((~y)^(~n) * ~y => (~y)^(~n+1))
     @acrule((~x)^(~n) * (~x)^(~m) => (~x)^(~n + ~m))
     @rule((((~x)^(~p))^(~q)) => (~x)^((~p)*(~q)))
     @rule(+(~~x::hasrepeats) => +(merge_repeats(*, ~~x)...))
     @rule(*(~~x::hasrepeats) => *(merge_repeats(^, ~~x)...))

     @acrule((~z::_iszero *  ~x) => ~z)

     # remove the idenitities
     @acrule((~z::_isone  * ~x) => ~x)
     @acrule((~z::_iszero + ~x) => ~x)
     @rule(^(~x, ~z::_iszero) => 1)
     @rule(^(~x, ~z::_isone) => ~x)
     @rule(+(~x) => ~x)
     @rule(*(~x) => ~x)
    ]
end

TRIG_RULES = let
    [
     @acrule(sin(~x)^2 + cos(~x)^2 => one(~x))
     @acrule(sin(~x)^2 + -1        => cos(~x)^2)
     @acrule(cos(~x)^2 + -1        => sin(~x)^2)

     @acrule(tan(~x)^2 + -1*sec(~x)^2 => one(~x))
     @acrule(tan(~x)^2 +  1 => sec(~x)^2)
     @acrule(sec(~x)^2 + -1 => tan(~x)^2)

     @acrule(cot(~x)^2 + -1*csc(~x)^2 => one(~x))
     @acrule(cot(~x)^2 +  1 => csc(~x)^2)
     @acrule(csc(~x)^2 + -1 => cot(~x)^2)
     ]
end

SIMPLIFY_RULES = vcat(BASIC_NUMBER_RULES, TRIG_RULES)

OLD_BASIC_NUMBER_RULES = let # Keep these around for benchmarking purposes
    [
     @rule(~x - ~y => ~x + (-1 * ~y)),
     @rule(~x / ~y => ~x * pow(~y, -1)),
     #@rule(*(~~x, *(~~y), ~~z) => *((~~x)..., (~~y)..., (~~z)...)),
     @rule(*(~~x::isnotflat(*)) => flatten_term(*, ~~x)),
     @rule(*(~~x::!(issortedₑ)) => sort_args(*, ~~x)),
     @rule(*(~a::isnumber, ~b::isnumber, ~~x) => *(~a * ~b, (~~x)...)),

     #@rule(+(~~x, +(~~y), ~~z) => +((~~x)..., (~~y)..., (~~z)...)),
     @rule(+(~~x::isnotflat(+)) => flatten_term(+, ~~x)),
     @rule(+(~~x::!(issortedₑ)) => sort_args(+, ~~x)),
     @rule(+(~a::isnumber, ~b::isnumber, ~~x) => +((~~x)..., ~a + ~b)),

     @rule(+(~~a, *(~~x), *(~β::isnumber, ~~x), ~~b) =>
           +((~~a)..., *(1 + ~β, (~x)...), (~b)...)),
     @rule(+(~~a, *(~α::isnumber, ~x), ~~b, ~x, ~~c) =>
           +((~~a)..., *(+(~α+1), ~x), (~~b)..., (~~c)...)),
     @rule(+(~~a, *(~α::isnumber, ~~x), *(~β::isnumber, ~~x), ~~b) =>
           +((~~a)..., *(~α + ~β, (~x)...), (~b)...)),

     # group stuff
     @rule(^(*(~~x), ~y) => *(map(a->a ^ (~y), ~~x)...)),
     @rule(*(~~x, ^(~y, ~n), ~y, ~~z) => *((~~x)..., ^(~y, ~n+1), (~~z)...)),
     @rule(*(~~a, ^(~x, ~e1), ^(~x, ~e2), ~~b) =>
           *((~~a)..., ^(~x, (~e1 + ~e2)), (~b)...)),
     @rule((((~x)^(~p))^(~q)) => (~x)^((~p)*(~q))),
     @rule(+(~~x::hasrepeats) => +(merge_repeats(*, ~~x)...)),
     @rule(*(~~x::hasrepeats) => *(merge_repeats(^, ~~x)...)),

     @rule(*(~z::_iszero, ~~x) => ~z),

     # remove the idenitities
     @rule(*(~z::_isone, ~~x::(!isempty)) => *((~~x)...)),
     @rule(+(~z::_iszero, ~~x::(!isempty)) => +((~~x)...)),
     @rule(^(~x, ~z::_iszero) => 1),
     @rule(^(~x, ~z::_isone) => ~x),
     ]
end


using DataFrames, Gadfly

set_default_plot_size(2*3.3inch, 2*3.3inch)

D = DataFrame(x1=[76.5763, 93.611, 67.2219, 39.6499],
              x2=[31.5112, 66.0929, 58.5162, 5.66118],
              x3=[27.0953, 11.2782, 16.7029, 47.3287],
              x4=[86.1758, 61.6317, 28.7841, 46.4209])

xsc  = Scale.x_continuous(minvalue=0.0, maxvalue=100)
ysc  = Scale.y_continuous(minvalue=0.0, maxvalue=100)

p1 = plot(D, x=:x1, y=:x2, xend=:x3, yend=:x4, Geom.segment(arrow=true), xsc, ysc);
p2 = plot(D, x=:x1, y=:x2, xend=:x3, yend=:x4, color=[colorant"orange"], linestyle=[:dash], Geom.vector, xsc, ysc);

p3 = plot(z=(x,y)->x*exp(-(x^2+y^2)),
        xmin=[-2], xmax=[2], ymin=[-2], ymax=[2],
        Geom.vectorfield(scale=0.4, samples=17),
        Scale.x_continuous(minvalue=-2.0, maxvalue=2.0),
        Scale.y_continuous(minvalue=-2.0, maxvalue=2.0),
        Guide.xlabel("x"), Guide.ylabel("y"), Guide.colorkey(title="z"));

Z = fill(1.0, 5, 5)
Z[2:4, 2:4] .= 2.0
Z[3,3] = 3.0

p4 = plot(z=Z,
        Geom.vectorfield,
        Scale.x_continuous(minvalue=1.0, maxvalue=5.0),
        Scale.y_continuous(minvalue=1.0, maxvalue=5.0),
        Guide.xlabel("x"), Guide.ylabel("y"),
        Theme(key_position=:none));

gridstack([p1 p2; p3 p4])


module ThreadedStockCorr

# Threaded implementation of test case from Issue #445

using Base.Threads
if VERSION >= v"0.7.0-DEV.3406"
    using Random
end
if VERSION >= v"0.7.0-DEV.3449"
    using LinearAlgebra
else
    using Base.LinAlg
    const LinearAlgebra = Base.LinAlg
end

# Run paths in parallel (has to be in its own function due to #10718)
if VERSION >= v"0.7.0-DEV.3204"
    function runpath!(n, Wiener, CorrWiener, SA, SB, T, UpperTriangle, k11, k12, k21, k22, rngs)
        @threads for i = 1:n
            randn!(rngs[threadid()], Wiener)
            LinearAlgebra.mul!(CorrWiener, Wiener, UpperTriangle)
            @simd for j = 2:T
                @inbounds SA[j, i] = SA[j-1, i] * exp(k11 + k12*CorrWiener[j-1, 1])
                @inbounds SB[j, i] = SB[j-1, i] * exp(k21 + k22*CorrWiener[j-1, 2])
            end
        end
    end
else
    function runpath!(n, Wiener, CorrWiener, SA, SB, T, UpperTriangle, k11, k12, k21, k22, rngs)
        @threads for i = 1:n
            randn!(rngs[threadid()], Wiener)
            A_mul_B!(CorrWiener, Wiener, UpperTriangle)
            @simd for j = 2:T
                @inbounds SA[j, i] = SA[j-1, i] * exp(k11 + k12*CorrWiener[j-1, 1])
                @inbounds SB[j, i] = SB[j-1, i] * exp(k21 + k22*CorrWiener[j-1, 2])
            end
        end
    end
end

function perf_pstockcorr(n)
    ## Correlated asset information
    const CurrentPrice = [78. 102.]     # Initial Prices of the two stocks
    const Corr = [1. 0.4; 0.4 1.]       # Correlation Matrix
    const T = 500                       # Number of days to simulate = 2years = 500days
    const dt = 1/250                    # Time step (1year = 250days)
    const Div = [0.01 0.01]               # Dividend
    const Vol = [0.2 0.3]                 # Volatility

    ## Market Information
    const r = 0.03                      # Risk-free rate

    ## Define storages
    SimulPriceA = zeros(T,n)            # Simulated Price of Asset A
    SimulPriceA[1,:] = CurrentPrice[1]
    SimulPriceB = zeros(T,n)            # Simulated Price of Asset B
    SimulPriceB[1,:] = CurrentPrice[2]

    ## Generating the paths of stock prices by Geometric Brownian Motion
    const UpperTriangle = full(chol(Corr))    # UpperTriangle Matrix by Cholesky decomposition

    # Optimization: pre-allocate these for performance
    # NOTE: the new GC will hopefully fix this, but currently GC time
    # kills performance if we don't do in-place computations
    Wiener = Matrix{Float64}(undef, T-1, 2)
    CorrWiener = Matrix{Float64}(undef, T-1, 2)

    # Runtime requirement: need per-thread RNG since it stores state
    rngs = [MersenneTwister(777+x) for x in 1:nthreads()]

    # Optimization: pre-computable factors
    # NOTE: this should be automatically hoisted out of the loop
    k11 = (r-Div[1]-Vol[1]^2/2)*dt
    k12 = Vol[1]*sqrt(dt)
    k21 = (r-Div[2]-Vol[2]^2/2)*dt
    k22 = Vol[2]*sqrt(dt)

    runpath!(n, Wiener, CorrWiener, SimulPriceA, SimulPriceB, T, UpperTriangle, k11, k12, k21, k22, rngs)

    return (SimulPriceA, SimulPriceB)
end

end # module


using Pkg
pwd()
cd("../ChemometricsTools.jl/")
Pkg.activate(".")

using ChemometricsTools

#View the data in the package space
ChemometricsToolsDatasets()
#Load the data from package-space
DF = ChemometricsToolsDataset("tecator.csv");

Xindices = findall(occursin.( "absorbance", string.(names(DF) ) ) );
Tecator = convert(Matrix,  DF[:,Xindices]);

#Let's check the Tecator data for duplicate entries ;)
length(AssessHealth(Tecator)["Duplicates"])
#Eeek plenty of duplicates, oh well this is a shoot out not a real analysis...

using Plots
plot(Tecator', legend = false, ylabel = "Absorbance", xlabel = "bins")
using Statistics
BC = boxcar(Tecator[1,:]; windowsize = 5, fn = mean);
AS = ALSSmoother(Tecator[1,:]; lambda = 100, p = 0.1, maxiters = 10);
PS = PerfectSmoother(Tecator[1,:]; lambda = 100);
SG = SavitzkyGolay(convert.(Float64, Tecator[1,:])', 0, 1, 3);

plot( [ Tecator[1,:], BC', AS', PS', SG' ], xlabel = "bins", ylabel = "Smoothed Signal",
        label = [ "Original", "BC", "AS", "PS", "SG" ], ylim = (2.5,3.75) )

FD = FirstDerivative(Tecator[1,:]);
SD = SecondDerivative(Tecator[1,:]);
HD = FractionalDerivative(convert.(Float64, Tecator[1,:]); Order = 1.5);

plot( [ FD', SD', HD' ], xlabel = "bins", ylabel = "Differentiated Signal",
        label = [ "First Derivative", "Second Derivative", "1(1/2) Derivative" ],
        ylim = (-0.1,0.1) )


using BCTRNN
using DiffEqSensitivity
using OrdinaryDiffEq
import DiffEqFlux: FastChain, FastDense
import Flux: ClipValue, ADAM

# Not in Project.toml
using Plots
gr()

include("sine_wave_dataloader.jl")

function train_sine_ss_fc(epochs, solver=Tsit5();
  sensealg=InterpolatingAdjoint(autojacvec=ReverseDiffVJP(true)),
  T=Float32, model_size=5,
  mtkize=false, gen_jac=false, lr=0.02, kwargs...)

  train_dl = generate_2d_data(T)

  f_in = 2
  f_out = 1

  im = BCTRNN.InputAllToAll()
  sm = BCTRNN.SynsFullyConnected()
  #om = BCTRNN.OutputAll()
  om = BCTRNN.OutputIdxs(collect(1:model_size))
  wiring = BCTRNN.WiringConfig(f_in, model_size, im,sm,om)

  model = FastChain(BCTRNN.Mapper(f_in),
                    BCTRNN.LTCSynState(wiring, solver, sensealg; T, mtkize, gen_jac, kwargs...),
                    FastDense(wiring.n_out, f_out))

  hs = []
  for (k,v) in wiring.matrices
    push!(hs, heatmap(v, title=k))
  end
  display(plot(hs..., layout=length(hs)))

  cb = BCTRNN.MyCallback(T; ecb=mycb, nepochs=epochs, nsamples=length(train_dl))
  #opt = GalacticOptim.Flux.Optimiser(ClipValue(0.5), ADAM(0.02))
  opt = BCTRNN.ClampBoundOptim(BCTRNN.get_bounds(model,T)..., ClipValue(T(1.0)), ADAM(T(lr)))
  BCTRNN.optimize(model, BCTRNN.loss_seq, cb, opt, train_dl, epochs, T), model
end

@time train_sine_ss_fc(1000, AutoTsit5(Rosenbrock23(autodiff=false)); model_size=5, mtkize=true, lr=0.004)


@testset "Canonisation and Compression" begin

D = 10
Dcut = 5

d = 2
sites = 5

T = Float32

ψ = CUDA.randn(CuMPS{T}, sites, D, d)
ϕ = CUDA.randn(CuMPS{T}, sites, D, d)
χ = CUDA.randn(CuMPS{T}, sites, D, d)
Φ = CUDA.randn(CuMPS{T}, sites, D, d)

@testset "Canonisation (left)" begin
    canonise!(ψ, :left)

    is_left_normalized = true
    for i ∈ 1:length(ψ)
        A = ψ[i]
        DD = size(A, 3)

        @cutensor Id[x, y] := conj(A[α, σ, x]) * A[α, σ, y] order = (α, σ)
        is_left_normalized *= norm(Id - cu(I(DD))) < 1e-5
    end

    @test is_left_normalized
    @test dot(ψ, ψ) ≈ 1
end

@testset "Canonisation (right)" begin
    canonise!(ϕ, :right)

    is_right_normalized = true
    for i ∈ 1:length(ϕ)
        B = ϕ[i]
        DD = size(B, 1)

        @cutensor Id[x, y] := B[x, σ, α] * conj(B[y, σ, α]) order = (α, σ)
        is_right_normalized *= norm(Id - cu(I(DD))) < 1e-5
    end

    @test is_right_normalized
    @test dot(ϕ, ϕ) ≈ 1
end

@testset "Cauchy-Schwarz inequality (after truncation)" begin
    @test abs(dot(ϕ, ψ)) <= norm(ϕ) * norm(ψ)
end

@testset "Canonisation (both)" begin
    canonise!(χ)
    @test dot(χ, χ) ≈ 1
end

@testset "Truncation (SVD, right)" begin
    truncate!(ψ, :right, Dcut)
    @test dot(ψ, ψ) ≈ 1
end

@testset "Truncation (SVD, left)" begin
    truncate!(ψ, :left, Dcut)
    @test dot(ψ, ψ) ≈ 1
end

@testset "Variational compression" begin
    Dcut = 5
    tol = 1E-4
    max_sweeps = 5

    canonise!(Φ, :right)
    @test dot(Φ, Φ) ≈ 1

    Ψ = compress(Φ, Dcut, tol, max_sweeps)

    @test dot(Ψ, Ψ) ≈ 1

    overlap = dot(Ψ, Φ)
    dist1 = 2 - 2 * real(overlap)
    dist2 = norm(Ψ)^2 + norm(Φ)^2 - 2 * real(overlap)

    @test abs(dist1 - dist2) < 1e-5
end

end


using ChaosTools, Test, DelayEmbeddings, DelimitedFiles, Downloads

@testset "exponential-chirp" begin
	file = "exponential-chirp-440-880-5.csv" #generated initially with y = librosa.chirp(440, 880, duration=5.0)
	println("Downloading 2MB file into $(file) in current dir.")
	Downloads.download("https://raw.githubusercontent.com/JuliaDynamics/JuliaDynamics/master/timeseries/$(file)", file)
	y = readdlm(file)[:,1]
	sr = Int64(length(y)/5)
	F0s, time_scale = yin(y, sr, f0_min=200, f0_max=1000, f_step=512, w_len=1024)
	t = range(0,5,length=length(F0s))
	chirp_freqs = 440 .*exp.(log(2)/5 .* t)
	@test all(abs.(F0s .- chirp_freqs) .< 5)
	println("Removing the file.")
	rm(file)
end


module StructuredDistances

using Distances

# Write your package code here.

include("utils.jl")
include("threaded_pairwise.jl")
include("distances/helpers.jl")

# Path distances
include("distances/paths.jl")

# Multiset distances
include("distances/multisets/matching_distances.jl")
include("distances/multisets/matching_distances_generalised.jl")
include("distances/multisets/matching_distances_eval.jl")
include("distances/multisets/earth_movers_distance.jl")

# Sequence distances
include("distances/sequences/edit_distance.jl")
include("distances/sequences/dtw_distance.jl")

# Basic set distances (Hamming + Jaccard)
include("distances/set_distances.jl")

# Graph distances
include("distances/graph_distances.jl")

# Normalised distances (normalises any metric)
include("distances/normalised.jl")

# Plotting recipies
include("plot_recipes/seq_plot.jl")
include("plot_recipes/pathseq_plot.jl")

end


# include("../../../src/plotSol.jl")
# include("../../../src/simulate.jl")
# include("../../../src/linearize.jl")
# include("../../../src/OrientationConversion.jl")
# include("../../../src/trim_kronLazy.jl");
using UdKaDyn, LinearAlgebra
# using Revise, UdKaDyn
# using BenchmarkTools

include("simplePendulumMinReal.jl")
##
# clearconsole()
j1 = Nothing
##
m = 1.0; l = 1.0; # Mass and length of bar
# Assuming bar revolves about Y axis
I1 = [1 0 0; 0 m * l^2 / 12 0; 0 0 1];

# Testing Dynamics with Revolute Joint
R1 = RigidBody(m, I1, 2)
RbI = InertialFrameAsRB()

# Suspended at an angle theta from vertical
theta = deg2rad(30)
x_temp = [l/2*sin(theta); 0.0; -l/2*cos(theta)];
x0R1 = ([x_temp;[1;zeros(3)];zeros(3);zeros(4)]);
initialiseRigidBody!(R1,x0R1)

# Axis about which bar is revolving
axisY = [0.0 1.0 0.0][:];

rj1 = [0.0 0.0 0.0][:]; # Joint Location in body frame of first body
rj2 = -R1.x[1:3];

j1 = Joint(RbI, R1, rj1, rj2, type="Revolute", axis=axisY)

# External Forces Definition
g = [0.0,0.0,-9.806]; # Gravity Vector.

j = [j1];

## Linearization
# x0, u0 = getXU_0(j);
# A,B = linearize(x0, u0, j, g);

## Simulation and checking
tEnd = (10.0);
tInt = 1e-2; # Only for fixed step solver, currently using adaptive step.
tSim, solFinal = simulate(tEnd, tInt, j, g=g)
solPend1  = solFinal[1];
println("Simulation complete., plotting results:");

##
# Check if joint location has moved
ωSol, jointLoc1 = checkRevJointIn(solPend1, rj2)
## Plots
close("all");
# errors
plotErrNorm(tSim,solPend1.β) # Drift in quaternion unit norm constraint
plotPos(tSim,jointLoc1) # Location of joint connecting inertial frame to pendulum. Should be zero.

# trajectory
plotQuat(tSim, solPend1.β)
plotPos(tSim, solPend1.r)
plotAngVel(tSim, ωSol)

## Compare with MinReal
rMin, vMin, ωMin = PendulumMinReal(m, l, theta, tInt, tEnd);
# # Plotting errors
plotPos(tSim,rMin-solPend1.r)
plotVel(tSim,vMin-solPend1.v)
plotAngVel(tSim,ωMin-ωSol)


using CUSPARSE
using CUDArt
using Base.Test

m = 25
n = 35
k = 10
blockdim = 5

##############
# test_hybsv #
##############

function test_hybsv(elty)
    A = rand(elty,m,m)
    A = triu(A)
    x = rand(elty,m)
    alpha = rand(elty)
    beta = rand(elty)
    d_x = CudaArray(x)
    d_A = CudaSparseMatrixCSR(sparse(A))
    d_A = CUSPARSE.switch2hyb(d_A)
    d_y = CUSPARSE.sv('N','T','U',alpha,d_A,d_x,'O')
    h_y = to_host(d_y)
    y = A\(alpha * x)
    @test_approx_eq(y,h_y)

    d_y = UpperTriangular(d_A) \ d_x
    h_y = to_host(d_y)
    @test h_y ≈ A\x

    d_x = CudaArray(rand(elty,n))
    info = CUSPARSE.sv_analysis('N','T','U',d_A,'O')
    @test_throws(DimensionMismatch, CUSPARSE.sv_solve('N','U',alpha,d_A,d_x,info,'O'))
    A = sparse(rand(elty,m,n))
    d_A = CudaSparseMatrixCSR(A)
    d_A = CUSPARSE.switch2hyb(d_A)
    @test_throws(DimensionMismatch, CUSPARSE.sv_analysis('T','T','U',d_A,'O'))
    CUSPARSE.cusparseDestroySolveAnalysisInfo(info)
end

types = [Float32,Float64,Complex64,Complex128]
for elty in types
    tic()
    test_hybsv(elty)
    println("hybsv took ", toq(), " for ", elty)
end


using Test
using GeoParams
@testset "Density.jl" begin

#Set alias for density function
@use GeoParamsAliases density=ρ

#Make sure that structs are isbits
x = ConstantDensity()
@test isbits(x)

x = PT_Density()
@test isbits(x)

x = Compressible_Density()
@test isbits(x)

# This tests the MaterialParameters structure
CharUnits_GEO   =   GEO_units(viscosity=1e19, length=1000km);

# Define a linear viscous creep law
x1      =   ConstantDensity(ρ=2900kg/m^3)
@test x1.ρ.val == 2900

x1 = nondimensionalize(x1,CharUnits_GEO)
@test x1.ρ.val ≈ 2.9e-16

x2      =   PT_Density()
@test x2.α.val==3e-5
@test x2.ρ0.val==2900.0

x2 = nondimensionalize(x2,CharUnits_GEO)
@test x2.T0.val≈0.21454659702313156

# Compute with density while specifying P & T (not used in case of )
@test compute_density(x2,1.0,1.0) ≈ 2.8419999999999996e-16
@test compute_density(x1,1.0,1.0) ≈ 2.9e-16

# test to allocations
rho = [0.0]
P   = 1.0;
T   = 1.0

x   = ConstantDensity()
num_alloc = @allocated compute_density!(rho, x, P, T)
num_alloc = @allocated compute_density!(rho, x, P, T)
@show num_alloc
@test num_alloc == 0

#Test allocations using ρ alias
num_alloc = @allocated ρ!(rho, x, P, T)
num_alloc = @allocated ρ!(rho, x, P, T)
@test num_alloc == 0

# This does NOT allocate if I test this with @btime;
#   yet it does while running the test here
x   = PT_Density()
num_alloc = @allocated compute_density!(rho, x, P, T)
num_alloc = @allocated compute_density!(rho, x, P, T)
@show num_alloc
@test num_alloc <= 32

# This does NOT allocate if I test this with @btime;
#   yet it does while running the test here
x   = Compressible_Density()
num_alloc = @allocated compute_density!(rho, x, P, T)
num_alloc = @allocated compute_density!(rho, x, P, T)
@show num_alloc
@test num_alloc <=32

# Read Phase diagram interpolation object
fname   =   "./test_data/Peridotite.in"
PD_data =   PerpleX_LaMEM_Diagram(fname);
@test PD_data.meltFrac(1500,1e7) ≈ 0.24368492372485706
@test PD_data.Rho(1500,1e7) ≈ 3042.836820256982
@test PD_data.meltRho(1500,1e7) ≈ 2662.227167592414
@test PD_data.rockRho(1500,1e7) ≈ 3165.467673917775

@test compute_density(PD_data, 1e7, 1500.0) ≈ 3042.836820256982

# Do the same but non-dimensionalize the result
CharDim  =  GEO_units();
PD_data1 =  PerpleX_LaMEM_Diagram(fname, CharDim=CharDim);

rho_ND   =  PD_data1.Rho(nondimensionalize(1500.0K,CharDim), nondimensionalize(1e8*Pa,CharDim))
Vp_ND    =  PD_data1.Vp( nondimensionalize(1500.0K,CharDim), nondimensionalize(1e8*Pa,CharDim))
Vs_ND    =  PD_data1.Vs( nondimensionalize(1500.0K,CharDim), nondimensionalize(1e8*Pa,CharDim))

# redimensionalize and check with value from original structure that did not use non-dimensionalization
@test   ustrip(dimensionalize(rho_ND,kg/m^3,CharDim)) ≈ PD_data.Rho(1500.0,1e8)
@test   ustrip(dimensionalize(Vp_ND, km/s,  CharDim)) ≈ PD_data.Vp( 1500.0,1e8)
@test   ustrip(dimensionalize(Vs_ND, km/s,  CharDim)) ≈ PD_data.Vs( 1500.0,1e8)

# Test computation of density for the whole computational domain, using arrays
MatParam    =   Vector{AbstractMaterialParamsStruct}(undef, 4)

MatParam[1] =   SetMaterialParams(Name="Mantle", Phase=0,
                        CreepLaws= (PowerlawViscous(), LinearViscous(η=1e23Pa*s)),
                        Density   = PerpleX_LaMEM_Diagram("test_data/Peridotite.in"));

MatParam[2] =   SetMaterialParams(Name="Crust", Phase=1,
                        CreepLaws= (PowerlawViscous(), LinearViscous(η=1e23Pa*s)),
                        Density   = ConstantDensity(ρ=2900kg/m^3));

MatParam[3] =   SetMaterialParams(Name="UpperCrust", Phase=2,
                        CreepLaws= (PowerlawViscous(), LinearViscous(η=1e23Pa*s)),
                        Density   = PT_Density());
MatParam[4] =   SetMaterialParams(Name="UpperCrust", Phase=3,
                        CreepLaws= (PowerlawViscous(), LinearViscous(η=1e23Pa*s)),
                        Density   = Compressible_Density());

Mat_tup = Tuple(MatParam);  # create a tuple to avoid allocations

MatParam1 = Vector{AbstractMaterialParamsStruct}(undef, 4)
MatParam1[1] = SetMaterialParams(Name="Crust", Phase=0,
                            CreepLaws= (PowerlawViscous(), LinearViscous(η=1e23Pas)),
                            Density   = ConstantDensity(ρ=2900kg/m^3))
MatParam1[2] = SetMaterialParams(Name="Lower Crust", Phase=1,
                            CreepLaws= (PowerlawViscous(n=5.), LinearViscous(η=1e21Pas)),
                            Density  = Compressible_Density(ρ0=3000kg/m^3))
MatParam1[3] = SetMaterialParams(Name="Lower Crust", Phase=2,
                            CreepLaws= LinearViscous(η=1e21Pas),
                            Density  = ConstantDensity())
MatParam1[4] = SetMaterialParams(Name="Lower Crust", Phase=3,
                            CreepLaws= LinearViscous(η=1e21Pas),
                            Density  = ConstantDensity())
Mat_tup1 = Tuple(MatParam1)

# test computing material properties
Phases              = ones(Int64,400,400)*0;
Phases[:,20:end]   .= 1
Phases[:,200:end]  .= 2
Phases[:,300:end]  .= 3

#Phases .= 2;
rho     = zeros(size(Phases))
T       =  ones(size(Phases))
P       =  ones(size(Phases))*10

# Test computing density when Mat_tup1 is provided as a tuple
compute_density!(rho, Mat_tup1, Phases, P,T)
num_alloc = @allocated compute_density!(rho, Mat_tup1, Phases, P,T)   #      287.416 μs (0 allocations: 0 bytes)
@test sum(rho)/400^2 ≈ 2945.000013499999
@test num_alloc == 0

#Same test using function alias
rho     = zeros(size(Phases))
ρ!(rho, Mat_tup1, Phases, P,T)
num_alloc = @allocated compute_density!(rho, Mat_tup1, Phases, P,T)
@test sum(rho)/400^2 ≈ 2945.000013499999
@test num_alloc == 0

# If we employ a phase diagram many allocations occur:
compute_density!(rho, Mat_tup, Phases, P,T)   #        37.189 ms (1439489 allocations: 26.85 MiB)     - the allocations are from the phase diagram
@test sum(rho)/400^2 ≈ 2920.6151145725003

# test computing material properties when we have PhaseRatios, instead of Phase numbers
PhaseRatio  = zeros(size(Phases)...,length(Mat_tup1));
for i in CartesianIndices(Phases)
    iz = Phases[i]
    I = CartesianIndex(i,iz+1)
    PhaseRatio[I] = 1.0
end

compute_density!(rho, Mat_tup1, PhaseRatio, P, T)
num_alloc = @allocated compute_density!(rho, Mat_tup1, PhaseRatio, P,T) #   136.776 μs (0 allocations: 0 bytes)
# using BenchmarkTools
# @btime compute_density!($rho, $Mat_tup1, $PhaseRatio, P=$P,T=$T)
@test sum(rho)/400^2 ≈ 2945.000013499999
@test num_alloc == 0           # for some reason this does indicate allocations but @btime does not

# Test calling the routine with only pressure as input.
# This is ok for Mat_tup1, as it only has constant & P-dependent densities.
# Note, however, that if you have P & T dependent densities and do this it will use 0 as defualt value for T
compute_density!(rho, Mat_tup1, PhaseRatio, P)
@test sum(rho)/400^2 ≈ 2945.000013499999

# In case we only want to compute with T, do this:
#  NOTE that in this example the results are actually wrong (as some functions require P as well)
compute_density!(rho, Mat_tup, PhaseRatio, nothing, T)
@test sum(rho)/400^2 ≈ 2920.6151

#Test computation of density given a single phase and P,T as scalars
Phase, P, T = 0, 1., 1.
@test compute_density(Mat_tup1, Phase, P, T) == 2900.0

end

#= Testing more than one density per field (change ln:205 in MaterialParameters.jl)
MatParam = Vector{AbstractMaterialParamsStruct}(undef, 4)
MatParam[1] = SetMaterialParams(Name="Crust", Phase=0,
                            CreepLaws= (PowerlawViscous(), LinearViscous(η=1e23Pas)),
                            Density   = (PT_Density(), ConstantDensity()))
MatParam[2] = SetMaterialParams(Name="Lower Crust", Phase=1,
                            CreepLaws= (PowerlawViscous(n=5.), LinearViscous(η=1e21Pas)),
                            Density  = (Compressible_Density(ρ0=3000kg/m^3), ConstantDensity()))
MatParam[3] = SetMaterialParams(Name="Lower Crust", Phase=2,
                            CreepLaws= LinearViscous(η=1e21Pas),
                            Density  = (ConstantDensity(), PT_Density(), Compressible_Density(ρ0=3000kg/m^3)))
MatParam[4] = SetMaterialParams(Name="Lower Crust", Phase=3,
                            CreepLaws= LinearViscous(η=1e21Pas),
                            Density  = (ConstantDensity(), PT_Density()))

Mat_tup = Tuple(MatParam)

P,T = 1.,1.
@btime compute_density($Mat_tup, $P, $T)
=#


"""
$(TYPEDEF)

Two sample superiority test for proportion

Constructors
------------
* `TwoSamplePropSuperior(p1::Real, p2::Real, k::Real, delta::Real)`

Arguments
---------
* `p1`: Proportion of group 1

* `p2`: Proportion of group 2

* `k`: Allocation ratio of the groups, k = n(group1) / n(group 2)

* `delta`: Non-inferiority Margin

Fields
------
$(FIELDS)
"""
type TwoSamplePropSuperior <: TrialTest
    p1::Real
    p2::Real
    k::Real
    delta::Real

    # Validator
    function TwoSamplePropSuperior(p1, p2, k, delta)

        if !((0 < p1 < 1) & (0 < p2 < 1))

            error("Proportion values must be in (0, 1)")

        end # end if

        if !(0 < k < Inf)

            error("Allocation ratio must be in (0, Inf)")

        end # end if

        if !(0 <= delta < 1)

            error("The superiority margin δ must be in [0, 1)")

        end # end if

        new(p1, p2, k, delta)

    end # end function

end # function

# Two sample superiority test for proportion
function hypotheses{T <: TwoSamplePropSuperior}(test::T, n::Real, std::Union{Real, Tuple{Real, Real}, Void}, alpha::Real, side::String)

    diff = test.p1 - test.p2 - test.delta
    se = sqrt(1 / (test.k * n) * test.p1 * (1 - test.p1) + 1 / n * test.p2 * (1 - test.p2))
    z = diff / se
    p = cdf(ZDIST, z - quantile(ZDIST, 1 - alpha)) + cdf(ZDIST, -z - quantile(ZDIST, 1 - alpha))
    return p

end # end function


################################################################################
######          Particle filter and help functions for pf                  #####
################################################################################

doc"""
    pf(y::Array{Float64}, theta::Array{Float64},theta_known::Float64,N::Int64,
plotflag::Bool=false, return_weigths_and_particles::Bool=false)

pf runs the bootstrap particel filter for the Ricker model.
"""
function pf(y::Array{Float64}, theta::Array{Float64},theta_known::Float64,N::Int64,
plotflag::Bool=false, return_weigths_and_particles::Bool=false)

  # set parameter values
  r = exp(theta[1])
  phi = exp(theta[2])
  sigma = exp(theta[3])

  # set startvalue for loglik
  loglik = 0.

  # set length pf data
  T = length(y)

  # pre-allocate matriceis
  x = zeros(N,T) # particels
  w = zeros(N,T) # weigts
  x_anc = zeros(N,T+1) # ancestral particels

  # set start values
  xint = rand(Uniform(1,30),N,1)
  #xint = rand(Uniform(1,200),N,1)

  x_anc[:,1] = xint # set anc particels for t = 1

  # set gaussian noise
  e = rand(Normal(0,sigma), N,T)

  for t = 1:T

  if t == 1 # first iteration

    # propagate particels
    x[:,1] = r*xint.*exp(-xint .+ e[:,1]);

    # calc weigths and update loglik
    (w[:,t], loglik) = calc_weigths(y[t],x[:,t],phi,loglik,N)

  else

    # resample particels
    ind = stratresample(w[:,t-1], N)
    x_resample = x[ind,t-1]

    x_anc[:,t+1] = x_resample # store ancestral particels

    # propagate particels
    x[:,t] = r*x_resample.*exp(-x_resample .+ e[:,t])

    # calc weigths and update loglik
    (w[:,t], loglik) = calc_weigths(y[t],x[:,t],phi,loglik,N)
  end

  end

  if plotflag # plot ESS at last iteration
  @printf "ESS: %.4f\n" 1/sum(w[:,end].^2)
  end

  if return_weigths_and_particles
  # return loglik, weigths and particels
  loglik, w, x
  else
  # return loglik
  return loglik
  end
end

# help functions for particle filter

doc"""
    calc_weigths(y::Array{Float64},x::Array{Float64},phi::Float64,loglik::Float64,N::Int64)

Calculates the weigths in the particel filter and the estiamtes the loglikelihood value.
"""
function calc_weigths(y::Float64,x::Array{Float64},phi::Float64,loglik::Float64,N::Int64)
  logweigths = y*log(x.*phi)  .- x*phi # compute logweigths
  constant = maximum(logweigths) # find largets wegith
  weigths = exp(logweigths - constant) # subtract largets weigth and compute weigths
  loglik =  loglik + constant + log(sum(weigths)) - log(N) # update loglik
  return weigths/sum(weigths), loglik
end

doc"""
    stratresample(p , N)

Stratified resampling.

Sample N times with repetitions from a distribution on [1:length(p)] with probabilities p. See [link](http://www.cornebise.com/julien/publis/isba2012-slides.pdf).
"""
function stratresample(p , N)

  p = p/sum(p)  # normalize, just in case...

  cdf_approx = cumsum(p)
  cdf_approx[end] = 1
  #I = zeros(N,1)
  indx = zeros(Int64, N)
  U = rand(N,1)
  U = U/N + (0:(N - 1))/N
  index = 1
  for k = 1:N
    while (U[k] > cdf_approx[index])
      index = index + 1
    end
    indx[k] = index
  end

  return indx

end


using Test
using CollectiveSpins.effective_interaction
using CollectiveSpins.effective_interaction_simple

@testset "effective-interaction" begin

a = 0.3
b = 0.7
c = 0.4
eps = 1e-12

Ωeff0, Γeff0 = effective_interaction_simple.triangle_orthogonal(a)
Ωeff1, Γeff1 = effective_interaction.triangle_orthogonal(a)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

Ωeff0, Γeff0 = effective_interaction_simple.square_orthogonal(a)
Ωeff1, Γeff1 = effective_interaction.square_orthogonal(a)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

Ωeff0, Γeff0 = effective_interaction_simple.rectangle_orthogonal(a, b)
Ωeff1, Γeff1 = effective_interaction.rectangle_orthogonal(a, b)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

Ωeff0, Γeff0 = effective_interaction_simple.cube_orthogonal(a)
Ωeff1, Γeff1 = effective_interaction.cube_orthogonal(a)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

Ωeff0, Γeff0 = effective_interaction_simple.box_orthogonal(a, b, c)
Ωeff1, Γeff1 = effective_interaction.box_orthogonal(a, b, c)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

Ωeff0, Γeff0 = effective_interaction_simple.chain(a, 0.21, 5)
Ωeff1, Γeff1 = effective_interaction.chain(a, 0.21, 5)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

Ωeff0, Γeff0 = effective_interaction_simple.chain_orthogonal(a, 5)
Ωeff1, Γeff1 = effective_interaction.chain_orthogonal(a, 5)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

Ωeff0, Γeff0 = effective_interaction_simple.squarelattice_orthogonal(a, 5)
Ωeff1, Γeff1 = effective_interaction.squarelattice_orthogonal(a, 5)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

Ωeff0, Γeff0 = effective_interaction_simple.hexagonallattice_orthogonal(a, 5)
Ωeff1, Γeff1 = effective_interaction.hexagonallattice_orthogonal(a, 5)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

Ωeff0, Γeff0 = effective_interaction_simple.cubiclattice_orthogonal(a, 3)
Ωeff1, Γeff1 = effective_interaction.cubiclattice_orthogonal(a, 3)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

Ωeff0, Γeff0 = effective_interaction_simple.tetragonallattice_orthogonal(a, 1.2*a, 3)
Ωeff1, Γeff1 = effective_interaction.tetragonallattice_orthogonal(a, 1.2*a, 3)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

Ωeff0, Γeff0 = effective_interaction_simple.hexagonallattice3d_orthogonal(a, b, 4)
Ωeff1, Γeff1 = effective_interaction.hexagonallattice3d_orthogonal(a, b, 4)
@test abs(Ωeff0-Ωeff1)<eps
@test abs(Γeff0-Γeff1)<eps

end # testset


function CN(ALPHA,BETA)
      A=[0    0.0180    0.0380    0.0560    0.0640    0.0740    0.0790
         0    0.0190    0.0420    0.0570    0.0770    0.0860    0.0900
         0    0.0180    0.0420    0.0590    0.0760    0.0930    0.1060
         0    0.0190    0.0420    0.0580    0.0740    0.0890    0.1060
         0    0.0190    0.0430    0.0580    0.0730    0.0800    0.0960
         0    0.0180    0.0390    0.0530    0.0570    0.0620    0.0800
         0    0.0130    0.0300    0.0320    0.0290    0.0490    0.0680
         0    0.0070    0.0170    0.0120    0.0070    0.0220    0.0300
         0    0.0040    0.0040    0.0020    0.0120    0.0280    0.0640
         0   -0.0140   -0.0350   -0.0460   -0.0340   -0.0120    0.0150
         0   -0.0170   -0.0470   -0.0710   -0.0650   -0.0020    0.0110
         0   -0.0330   -0.0570   -0.0730   -0.0410   -0.0130   -0.0010]
      #
      S= 0.2 * ALPHA
      K= floor(S)+3
      if(K <= 1)
          K= 2
      end
      if(K >=  12)
          K=  11
      end
      DA= S - K +3
      L = K + fix( 1.1*sign(DA) )
      #
      S= .2* abs(BETA)
      M= floor(S) + 1
      if(M <=  1)
          M= 2
      end
      if(M >=  7)
          M= 6
      end
      DB= S - M +1
      N= M + fix( 1.1*sign(DB) )
      #
      K=convert(Int64, K)
      L=convert(Int64, L)
      M=convert(Int64, M)
      N=convert(Int64, N)
      T= A[K,M]
      U= A[K,N]
      V= T + abs(DA) * (A[L,M] - T)
      W= U + abs(DA) * (A[L,N] - U)
      DUM= V + (W-V)  * abs(DB)
      return cnv = DUM * sign(BETA)
end


using LAR

V = [rand(2) for k=1:10000]
p.VIEW(p.STRUCT(p.AA(p.MK)(V)))


"""
Synthesizing units bind multiple substrates to synthesize compounds,
depending on their availability
"""
abstract type AbstractSynthesizingUnit end

"""
    synthesizing_unit(::AbstractSynthesizingUnit, v, w)

Apply a synthesizing unit formulation to substrates
`v` and `w`, returning the amount of compound.
"""
function synthesizing_unit end

"""
    ParallelComplementarySU(k)

0-parameter synthesizing unit that merges two compounds stoichiometrically.

See Ledder et al 2019. for details.

$(FIELDDOCTABLE)
"""
struct ParallelComplementarySU <: AbstractSynthesizingUnit end

synthesizing_unit(::ParallelComplementarySU, v, w) = v * w * (v + w) / (v^2 + w^2 + v * w)

"""
    MinimumRuleSU(k)

0-parameter synthesizing unit where law of the minimum controls
the production of one compound form two other compounds.

$(FIELDDOCTABLE)
"""
struct MinimumRuleSU <: AbstractSynthesizingUnit end

synthesizing_unit(::MinimumRuleSU, v, w) = min(v, w)

"""
    KfamilySU(k)

Flexible 1-parameter synthesizing unit with variable curve. Both `MinimumRuleSU`
and `ParallelComplementarySU` can be approximated with this rule.

$(FIELDDOCTABLE)
"""
@columns struct KfamilySU{K} <: AbstractSynthesizingUnit
    k::K | 1.0 | _ | (0.0, 10.0)  | _ | "Synthesizing unit parameter. Effiency = 2^-1/k"
end

synthesizing_unit(f::KfamilySU, v, w) = (v^-f.k + w^-f.k)^(-1/f.k)

"""
    stoich_merge(Ja, Jb, ya, yb)

Merge fluxes stoichiometrically into general reserve Eab based on yield
fractions ya and yb. An unmixed proportion is returned as unmixed reserves Ea and Eb.
"""
stoich_merge(su, Jv, Jw, yv, yw) = begin
    JEvw = synthesizing_unit(su, Jv * yv, Jw * yw)
    (Jv - JEvw / yv), (Jw - JEvw / yw), JEvw
end


module BenchEquilibria

using BenchmarkTools
using LatticeBoltzmann

import LatticeBoltzmann: equilibrium, equilibrium!

suite = BenchmarkGroup()

function initialize_benchmark(q = D2Q9(), τ = 1.0, scale = 2)
    benchmark_problem = LatticeBoltzmann.TGV(q, τ, scale)

    LatticeBoltzmann.initialize(
        LatticeBoltzmann.ZeroVelocityInitialCondition(),
        q,
        benchmark_problem,
    )
end

for q in LatticeBoltzmann.Quadratures
    suite[string(q)] = BenchmarkGroup([string(q), "maxwell boltzmann equilibrium"])

    suite[string(q)]["initial equilibrium"] = @benchmarkable(
        equilibrium($q, ρ, u, T),
        setup = (ρ = 1.0;
        u = zeros(eltype($q.weights), dimension($q));
        T = 1.0)
    )

    suite[string(q)]["compute equilibrium"] = @benchmarkable(
        equilibrium!($q, ρ, u, T, f),
        setup = (ρ = 1.0;
        u = zeros(eltype($q.weights), dimension($q));
        T = 1.0;
        f = zeros(eltype($q.weights), length($q.weights)))
    )
end

end  # module
BenchEquilibria.suite