# SPDX-License-Identifier: MIT

"""
    AbstractDirichlet{D} <: Distribution

Abstract type for Dirichlet distribution implementations.
"""
abstract type AbstractDirichlet{D} <: Distribution end

#######################################################################
# Parameter of the Dirichlet distribution.

function DefaultDirichletParameter(α)
    DefaultParameter(α)
end

#######################################################################
# Dirichlet distribution

"""
    mutable struct Dirichlet{D} <: AbstractDirichlet{D}
        param::P where P <: AbstractParameter
    end

Dirichlet distribution.

# Constructors

    Dirichlet(α)

where `α` is a vector of concentrations.

# Examples
```jldoctest
julia> Dirichlet([1.0, 2.0, 3.0])
Dirichlet{3}:
  α = [1.0, 2.0, 3.0]
```
"""
mutable struct Dirichlet{D} <: AbstractDirichlet{D}
    param::P where P <: AbstractParameter
end

function Dirichlet(α::AbstractVector)
    param = DefaultDirichletParameter(α)
    P = typeof(param)
    D = length(α)
    Dirichlet{D}(param)
end

#######################################################################
# Distribution interface.

basemeasure(::AbstractDirichlet, x::AbstractVector) = -log.(x)

function lognorm(d::AbstractDirichlet, η::AbstractVector = naturalform(d.param))
    sum(loggamma_dot(η)) - loggamma(sum(η))
end

function gradlognorm(d::AbstractDirichlet)
    α = stdparam(d).α
    digamma.(α) .- digamma(sum(α))
end

function sample(d::AbstractDirichlet{D}, size) where D
    α = stdparam(d).α
    retval = similar(α, D, size)
    d_ = Dists.Dirichlet(Array(α))
    retval[:, :] = Dists.rand(d_, size)
    retval
end

# vectorization is effect less
splitgrad(d::AbstractDirichlet, μ) = μ

stats(::AbstractDirichlet, x::AbstractVector) = log.(x)

function stdparam(d::AbstractDirichlet, η::AbstractVector = naturalform(d.param))
    (α = η,)
end


using Knet, KnetModules

include(Knet.dir("data","mnist.jl"))
xtrn, ytrn, xtst, ytst = mnist()
dtrn = minibatch(xtrn, ytrn, 100)
dtst = minibatch(xtst, ytst, 100)

function train(model, gradfn, data, optim)
    for (x, y) in data
        grads = gradfn(x, y)
        update!(model, grads, optim)
    end
end

model = Sequential(
    Conv(5, 5, 1,  20), ReLU(), MaxPool(),
    Conv(5, 5, 20, 50), ReLU(), MaxPool(),
    Linear(500, 800),   ReLU(),
    Linear(10,  500)
)
gpu!(model) #ignored if no GPU available

gradfn = grad(model, nll)
optim = optimizers(model, Adam)
report(epoch) =
    println((:epoch, epoch,
             :trn, accuracy(model, dtrn),
             :tst, accuracy(model, dtst)))

report(0)
for epoch = 1:10
    train(model, gradfn, dtrn, optim)
    report(epoch)
end

ser = false
if ser
    info("Saving module")
    save_module("lenet_seq.jld", model,
                Dict(["optim"=>optim]))
end


using StaticArrays
import Base.length

Vec3 = SVector{3};
## treating vector as location in space
x(v::Vec3) = v[1];
y(v::Vec3) = v[2];
z(v::Vec3) = v[3];
## treating vector as color
r(v::Vec3) = v[1];
g(v::Vec3) = v[2];
b(v::Vec3) = v[3];
## special operators
length(v::Vec3) = sqrt(v[1]^2 + v[2]^2 + v[3]^2);
squared_length(v::Vec3) = v[1]^2 + v[2]^2 + v[3]^2;
make_unit_vector(v::Vec3) = v/length(v);


distance(x, y; dist=Euclidean()) = dist(x, y)
distances(x; dist=Euclidean()) = pairwise(dist, x, dims=2)
distances(x, y; dist=Euclidean()) = pairwise(dist, x, y, dims=2)

function K(rs, x; dist=Euclidean())
    n = size(x, 2)
    d = distances(x; dist)
    N = n * (n - 1)
    cnt = [count(s -> s < r, d) - n for r in rs]
    cnt / N
end

function D(rs, x, maxk; dist=Euclidean())
    n = size(x, 2)
    d = distances(x; dist)

    nr = length(rs)
    cnt = zeros(Int, nr, maxk)

    for (i, r) in enumerate(rs)
        cnt_r = count(s -> s < r, d, dims=1) .- 1
        cnt[i, :] = [count(s -> s ≥ k, cnt_r) for k in 1:maxk]
    end
    cnt / n
end

function T(rs, x; dist=Euclidean())
    n = size(x, 2)
    d = distances(x; dist)

    nr = length(rs)
    cnt = zeros(Int, nr)

    for (i, r) in enumerate(rs)
        q = d .< r
        q[diagind(q)] .= false
        cnt[i] = sum(q^2 .* q)
    end

    N = n * (n - 1) * (n - 2)
    cnt / N
end

min_distance(x, y; dist=Euclidean()) = minimum(pairwise(dist, x, reshape(y, length(y), 1), dims=2))

function H(rs, x::AbstractMatrix, step::Real=rs.step.hi; dist=Euclidean())
    xs = 0.:step:1.
    H(rs, x, xs; dist)
end

function H(rs, x::AbstractMatrix, xs::AbstractRange=rs; dist=Euclidean())
    dim, n = size(x)
    x0 = Iterators.product(fill(xs, dim)...)
    H(rs, x, x0; dist)
end

function H(rs, x::AbstractMatrix, x0; dist=Euclidean())
    n = length(x0)
    mapreduce(y -> rs .>= min_distance(x, collect(y); dist), +, x0) / n
end


function mflows(cf, p, sval, rval, tracs, maxt; digits=ROUND_DIGITS)
    newtracs = [0., 0.]

    function update!(i, f)
        #newcf[i] = cf[i][tracs[i]] + f
        newtracs[i] = cvalarg(cf[i], cf[i][tracs[i]] + f, tracs[i], maxt[i])
    end

    if rval >= sum(sval)
        update!(1, sval[1]) #free
        update!(2, sval[2]) #free
    elseif sval[1] < 0.5*rval
        update!(1, sval[1]) #free
        update!(2, rval-sval[1]) #cong
    elseif sval[2] < 0.5*rval
        update!(1, rval-sval[2]) #free
        update!(2, sval[2]) #cong
    else
        update!(1, 0.5*rval) #cong
        update!(2, 0.5*rval) #cong
    end
    newtracs = round.(newtracs, digits=ROUND_DIGITS)

    newcf = round.([cf[i][newtracs[i]] for i in 1:2], digits=ROUND_DIGITS)

    newp = zeros(size(p[1])[2:end]...)
    for i in 1:2
        rng = tracs[i]:newtracs[i]
        if size(rng) > 0.
            newp .+= squeezesum(mucsum(cf[i], rng) .* p[i][indexify(rng),..], dims=1)
        end
    end
    if sum(newp) == 0.
        newp .= 1. /prod(size(newp))
    else
        newp ./= sum(newp)
    end

    return (newcf, newp, newtracs)
end

function dflows(cf, p, sr, sval, rval, trac, maxt; digits=ROUND_DIGITS)
    rng = trac:maxt
    fcut = [(mucsum(cf, rng) .* p[indexify(rng),..]) .* expand(sr[i], dims=1) for i in 1:2] # flow cut
    sva = valarg(sum(fcut), sval, 1)
    rva = min(valarg.(fcut, rval, 1)...)
    va = min(sva, rva)

    tmp = [squeezesum(fcut[i][0.:va,..], dims=1) for i in 1:2]
    newp = [(sum(tmptmp) == 0.) ? ones(size(tmptmp)...)*(1. /prod(size(tmptmp))) : (tmptmp ./ sum(tmptmp)) for tmptmp in tmp]

    newtrac = cvalarg(cf, cf[trac] + sum(sum(tmp)), trac, maxt)
    newtrac = round(newtrac, digits=ROUND_DIGITS)

    newcf = round(cf[newtrac], digits=ROUND_DIGITS)

    return (newcf, newp, newtrac, sum.(tmp))#[sum(tmptmp) for tmptmp in tmp])
end


@testset "permutations" begin
    for N = 1:4
        ps = collect(permutations(1:N))
        perminversion = [findfirst(isequal(invperm(p)), ps) for p in ps]
        permcomposition = [findfirst(isequal(p[q]), ps) for p in ps, q in ps]

        for i = 1:length(ps), j = 1:length(ps)
            @test inv(Bennu.Permutation{N}(i)) ==
                      Bennu.Permutation{N}(perminversion[i])
            @test Bennu.Permutation{N}(i) ∘ Bennu.Permutation{N}(j) ==
                      Bennu.Permutation{N}(permcomposition[i, j])
        end
    end

    for js in ([1,2,3,4], [1,3,2,4], [2,1,4,3], [2,4,1,3], [3,1,4,2], [3,4,1,2],
           [4,2,3,1], [4,3,2,1])
        p = inv(Bennu.tuplesortpermutation(js...))
        @test js == Bennu.getpermutedindex([1 3; 2 4], p, 1:4)
    end

    is = collect(LinearIndices((1:3,1:2)))
    @test [1,2,3,4,5,6] == Bennu.getpermutedindex(is, Bennu.Permutation{4}(1), 1:6)
    @test [1,4,2,5,3,6] == Bennu.getpermutedindex(is, Bennu.Permutation{4}(3), 1:6)
    @test [3,2,1,6,5,4] == Bennu.getpermutedindex(is, Bennu.Permutation{4}(8), 1:6)
    @test [3,6,2,5,1,4] == Bennu.getpermutedindex(is, Bennu.Permutation{4}(11), 1:6)
    @test [4,1,5,2,6,3] == Bennu.getpermutedindex(is, Bennu.Permutation{4}(14), 1:6)
    @test [4,5,6,1,2,3] == Bennu.getpermutedindex(is, Bennu.Permutation{4}(17), 1:6)
    @test [6,3,5,2,4,1] == Bennu.getpermutedindex(is, Bennu.Permutation{4}(22), 1:6)
    @test [6,5,4,3,2,1] == Bennu.getpermutedindex(is, Bennu.Permutation{4}(24), 1:6)

    is = collect(LinearIndices((1:3,)))
    @test [1,2,3] == Bennu.getpermutedindex(is, Bennu.Permutation{2}(1), 1:3)
    @test [3,2,1] == Bennu.getpermutedindex(is, Bennu.Permutation{2}(2), 1:3)
end


# TODO: add more target distributions and make them iteratable
# TODO: Integrate with https://github.com/xukai92/VecTargets.jl to achieve goal noted
#       above.

# Dimension of testing distribution
const D = 5
# Tolerance ratio
const TRATIO = Int == Int64 ? 1 : 2
# Deterministic tolerance
const DETATOL = 1e-3 * D * TRATIO
# Random tolerance
const RNDATOL = 5e-2 * D * TRATIO * 2

# Hand-coded multivariate Gaussian

const gaussian_m = zeros(D)
const gaussian_s = ones(D)

struct Gaussian{Tm, Ts}
    m::Tm
    s::Ts
end

function ℓπ_gaussian(g::AbstractVecOrMat{T}, s) where {T}
    return .-(log(2 * T(pi)) .+ 2 .* log.(s) .+ abs2.(g) ./ s.^2) ./ 2
end

ℓπ_gaussian(m, s, x) = ℓπ_gaussian(m .- x, s)

function ∇ℓπ_gaussianl(m, s, x)
    g = m .- x
    v = ℓπ_gaussian(g, s)
    return v, g
end

function get_ℓπ(g::Gaussian)
    ℓπ(x::AbstractVector) = sum(ℓπ_gaussian(g.m, g.s, x))
    ℓπ(x::AbstractMatrix) = dropdims(sum(ℓπ_gaussian(g.m, g.s, x); dims=1); dims=1)
    return ℓπ
end

function get_∇ℓπ(g::Gaussian)
    function ∇ℓπ(x::AbstractVector)
        val, grad = ∇ℓπ_gaussianl(g.m, g.s, x)
        return sum(val), grad
    end
    function ∇ℓπ(x::AbstractMatrix)
        val, grad = ∇ℓπ_gaussianl(g.m, g.s, x)
        return dropdims(sum(val; dims=1); dims=1), grad
    end
    return ∇ℓπ
end

ℓπ = get_ℓπ(Gaussian(gaussian_m, gaussian_s))
∂ℓπ∂θ = get_∇ℓπ(Gaussian(gaussian_m, gaussian_s))

# For the Turing model
# @model gdemo() = begin
#     s ~ InverseGamma(2, 3)
#     m ~ Normal(0, sqrt(s))
#     1.5 ~ Normal(m, sqrt(s))
#     2.0 ~ Normal(m, sqrt(s))
#     return s, m
# end

using Distributions: logpdf, InverseGamma, Normal
using Bijectors: invlink, logpdf_with_trans

function invlink_gdemo(θ)
    s = invlink(InverseGamma(2, 3), θ[1])
    m = θ[2]
    return [s, m]
end

function ℓπ_gdemo(θ)
    s, m = invlink_gdemo(θ)
    logprior = logpdf_with_trans(InverseGamma(2, 3), s, true) + logpdf(Normal(0, sqrt(s)), m)
    loglikelihood = logpdf(Normal(m, sqrt(s)), 1.5) + logpdf(Normal(m, sqrt(s)), 2.0)
    return logprior + loglikelihood
end

using Distributions: MvNormal
import Turing

Turing.@model function mvntest(θ=missing, x=missing)
    θ ~ MvNormal(zeros(D), 2)
    x ~ Normal(sum(θ), 1)
    return θ, x
end

function get_primitives(x, modelgen)
    spl_prior = Turing.SampleFromPrior()
    function ℓπ(θ)
        vi = Turing.VarInfo(model)
        vi[spl_prior] = θ
        model(vi, spl_prior)
        Turing.getlogp(vi)
    end
    adbackend = Turing.Core.ForwardDiffAD{40}
    alg_ad = Turing.HMC{adbackend}(0.1, 1)
    model = modelgen(missing, x)
    vi = Turing.VarInfo(model)
    spl = Turing.Sampler(alg_ad, model)
    Turing.Core.link!(vi, spl)
    ∂ℓπ∂θ = θ -> Turing.Core.gradient_logp(adbackend(), θ, vi, model, spl)
    θ₀ = Turing.VarInfo(model)[Turing.SampleFromPrior()]
    return ℓπ, ∂ℓπ∂θ, θ₀
end

function rand_θ_given(x, modelgen, metric, κ; n_samples=20)
    ℓπ, ∂ℓπ∂θ, θ₀ = get_primitives(x, modelgen)
    h = Hamiltonian(metric, ℓπ, ∂ℓπ∂θ)
    samples, stats = sample(h, κ, θ₀, n_samples; verbose=false, progress=false)
    s = samples[end]
    return length(s) == 1 ? s[1] : s
end

# Test function
geweke_g(θ, x) = cat(θ, x; dims=1)

test_show(x) = test_show(s -> length(s) > 0, x)
function test_show(pred, x)
    io = IOBuffer(; append = true)
    show(io, x)
    s = read(io, String)
    @test pred(s)
end


### test the mathematical part of the spline library ###

#+


module TestKalman

using QuantEcon
using Base.Test
using FactCheck

# set up
A = [.95 0; 0. .95]
Q = eye(2) .* 0.5
G = eye(2) .* .5
R = eye(2) .* 0.2
kf = Kalman(A, G, Q, R)

rough_kwargs = Dict(:atol => 1e-2, :rtol => 1e-4)

sig_inf, kal_gain = stationary_values(kf)

# Compute the Kalman gain and sigma infinity according to the
# recursive equations and compare
mat_inv = inv(G * sig_inf * G' + R)

kal_recursion = A * sig_inf * (G') * mat_inv
sig_recursion = A * sig_inf * A' - kal_recursion * G * sig_inf * A' + Q

facts("Testing kalman.jl") do
    # test stationary
    @fact sig_inf --> roughly(sig_recursion; rough_kwargs...)
    @fact kal_gain --> roughly(kal_recursion; rough_kwargs...)

    # test_update_using_stationary
    set_state!(kf, [0.0 0.0]', sig_inf)
    update!(kf, [0.0 0.0]')
    @fact kf.cur_sigma --> roughly(sig_inf; rough_kwargs...)
    @fact kf.cur_x_hat --> roughly([0.0 0.0]'; rough_kwargs...)

    # test update nonstationary
    curr_x, curr_sigma = ones(2, 1), eye(2) .* .75
    y_observed = fill(0.75, 2, 1)
    set_state!(kf, curr_x, curr_sigma)
    update!(kf, y_observed)
    mat_inv = inv(G * curr_sigma * G' + R)
    curr_k = A * curr_sigma * (G') * mat_inv
    new_sigma = A * curr_sigma * A' - curr_k * G * curr_sigma * A' + Q
    new_xhat = A * curr_x + curr_k * (y_observed - G * curr_x)
    @fact kf.cur_sigma --> roughly(new_sigma; rough_kwargs...)
    @fact kf.cur_x_hat --> roughly(new_xhat; rough_kwargs...)

end  # facts
end  # module


"""
    LKJCholesky(d::Int, η::Real, uplo='L')

The `LKJCholesky` distribution of size ``d`` with shape parameter ``\\eta`` is a
distribution over `LinearAlgebra.Cholesky` factorisations of ``d\\times d`` real correlation
matrices (positive-definite matrices with ones on the diagonal).

Variates or samples of the distribution are `LinearAlgebra.Cholesky` objects, as might
be returned by `F = LinearAlgebra.cholesky(R)`, so that `Matrix(F) ≈ R` is a variate or
sample of [`LKJ`](@ref).

Sampling `LKJCholesky` is faster than sampling `LKJ`, and often having the correlation
matrix in factorized form makes subsequent computations cheaper as well.

!!! note
    `LinearAlgebra.Cholesky` stores either the upper or lower Cholesky factor, related by
    `F.U == F.L'`. Both can be accessed with `F.U` and `F.L`, but if the factor
    not stored is requested, then a copy is made. The `uplo` parameter specifies whether the
    upper (`'U'`) or lower (`'L'`) Cholesky factor is stored when randomly generating
    samples. Set `uplo` to `'U'` if the upper factor is desired to avoid allocating a copy
    when calling `F.U`.

See [`LKJ`](@ref) for more details.

External links

* Lewandowski D, Kurowicka D, Joe H.
  Generating random correlation matrices based on vines and extended onion method,
  Journal of Multivariate Analysis (2009), 100(9): 1989-2001
  doi: [10.1016/j.jmva.2009.04.008](https://doi.org/10.1016/j.jmva.2009.04.008)
"""
struct LKJCholesky{T <: Real} <: Distribution{CholeskyVariate,Continuous}
    d::Int
    η::T
    uplo::Char
    logc0::T
end

#  -----------------------------------------------------------------------------
#  Constructors
#  -----------------------------------------------------------------------------

function LKJCholesky(d::Int, η::Real, _uplo::Union{Char,Symbol} = 'L'; check_args::Bool=true)
    @check_args(
        LKJCholesky,
        (d, d > 0, "matrix dimension must be positive"),
        (η, η > 0, "shape parameter must be positive"),
    )
    logc0 = lkj_logc0(d, η)
    uplo = _char_uplo(_uplo)
    T = Base.promote_eltype(η, logc0)
    return LKJCholesky(d, T(η), uplo, T(logc0))
end

# adapted from LinearAlgebra.char_uplo
function _char_uplo(uplo::Union{Symbol,Char})
    uplo ∈ (:U, 'U') && return 'U'
    uplo ∈ (:L, 'L') && return 'L'
    throw(ArgumentError("uplo argument must be either 'U' (upper) or 'L' (lower)"))
end

#  -----------------------------------------------------------------------------
#  REPL display
#  -----------------------------------------------------------------------------

Base.show(io::IO, d::LKJCholesky) = show(io, d, (:d, :η, :uplo))

#  -----------------------------------------------------------------------------
#  Conversion
#  -----------------------------------------------------------------------------

function Base.convert(::Type{LKJCholesky{T}}, d::LKJCholesky) where T <: Real
    return LKJCholesky{T}(d.d, T(d.η), d.uplo, T(d.logc0))
end
function convert(::Type{LKJCholesky{T}}, d::Integer, η::Real, uplo::Char, logc0::Real) where T <: Real
    return LKJCholesky{T}(Int(d), T(η), uplo, T(logc0))
end

#  -----------------------------------------------------------------------------
#  Properties
#  -----------------------------------------------------------------------------

Base.eltype(::Type{LKJCholesky{T}}) where {T} = T

function Base.size(d::LKJCholesky)
    p = d.d
    return (p, p)
end

function insupport(d::LKJCholesky, R::LinearAlgebra.Cholesky)
    p = d.d
    factors = R.factors
    (isreal(factors) && size(factors, 1) == p) || return false
    iinds, jinds = axes(factors)
    # check that the diagonal of U'*U or L*L' is all ones
    @inbounds if R.uplo === 'U'
        for (j, jind) in enumerate(jinds)
            col_iinds = view(iinds, 1:j)
            sum(abs2, view(factors, col_iinds, jind)) ≈ 1 || return false
        end
    else  # R.uplo === 'L'
        for (i, iind) in enumerate(iinds)
            row_jinds = view(jinds, 1:i)
            sum(abs2, view(factors, iind, row_jinds)) ≈ 1 || return false
        end
    end
    return true
end

function StatsBase.mode(d::LKJCholesky)
    factors = Matrix{eltype(d)}(LinearAlgebra.I, size(d))
    return LinearAlgebra.Cholesky(factors, d.uplo, 0)
end

StatsBase.params(d::LKJCholesky) = (d.d, d.η, d.uplo)

@inline partype(::LKJCholesky{T}) where {T <: Real} = T

#  -----------------------------------------------------------------------------
#  Evaluation
#  -----------------------------------------------------------------------------

function logkernel(d::LKJCholesky, R::LinearAlgebra.Cholesky)
    factors = R.factors
    p, η = params(d)
    c = p + 2(η - 1)
    p == 1 && return c * log(first(factors))
    # assuming D = diag(factors) with length(D) = p,
    # logp = sum(i -> (c - i) * log(D[i]), 2:p)
    logp = sum(Iterators.drop(enumerate(diagind(factors)), 1)) do (i, di)
        return (c - i) * log(factors[di])
    end
    return logp
end

function logpdf(d::LKJCholesky, R::LinearAlgebra.Cholesky)
    insupport(d, R) || throw(ArgumentError("provided point is not in the support"))
    return _logpdf(d, R)
end

_logpdf(d::LKJCholesky, R::LinearAlgebra.Cholesky) = logkernel(d, R) + d.logc0

pdf(d::LKJCholesky, R::LinearAlgebra.Cholesky) = exp(logpdf(d, R))

loglikelihood(d::LKJCholesky, R::LinearAlgebra.Cholesky) = logpdf(d, R)
function loglikelihood(d::LKJCholesky, Rs::AbstractArray{<:LinearAlgebra.Cholesky})
    return sum(R -> logpdf(d, R), Rs)
end

#  -----------------------------------------------------------------------------
#  Sampling
#  -----------------------------------------------------------------------------

function Base.rand(rng::AbstractRNG, d::LKJCholesky)
    factors = Matrix{eltype(d)}(undef, size(d))
    R = LinearAlgebra.Cholesky(factors, d.uplo, 0)
    return _lkj_cholesky_onion_sampler!(rng, d, R)
end
function Base.rand(rng::AbstractRNG, d::LKJCholesky, dims::Dims)
    p = d.d
    uplo = d.uplo
    T = eltype(d)
    TM = Matrix{T}
    Rs = Array{LinearAlgebra.Cholesky{T,TM}}(undef, dims)
    for i in eachindex(Rs)
        factors = TM(undef, p, p)
        Rs[i] = R = LinearAlgebra.Cholesky(factors, uplo, 0)
        _lkj_cholesky_onion_sampler!(rng, d, R)
    end
    return Rs
end

Random.rand!(d::LKJCholesky, R::LinearAlgebra.Cholesky) = Random.rand!(GLOBAL_RNG, d, R)
function Random.rand!(rng::AbstractRNG, d::LKJCholesky, R::LinearAlgebra.Cholesky)
    return _lkj_cholesky_onion_sampler!(rng, d, R)
end

function Random.rand!(
    rng::AbstractRNG,
    d::LKJCholesky,
    Rs::AbstractArray{<:LinearAlgebra.Cholesky{T,TM}},
    allocate::Bool,
) where {T,TM}
    p = d.d
    uplo = d.uplo
    if allocate
        for i in eachindex(Rs)
            Rs[i] = _lkj_cholesky_onion_sampler!(
                rng,
                d,
                LinearAlgebra.Cholesky(TM(undef, p, p), uplo, 0),
            )
        end
    else
        for i in eachindex(Rs)
            _lkj_cholesky_onion_sampler!(rng, d, Rs[i])
        end
    end
    return Rs
end
function Random.rand!(
    rng::AbstractRNG,
    d::LKJCholesky,
    Rs::AbstractArray{<:LinearAlgebra.Cholesky{<:Real}},
)
    allocate = any(!isassigned(Rs, i) for i in eachindex(Rs)) || any(R -> size(R, 1) != d.d, Rs)
    return Random.rand!(rng, d, Rs, allocate)
end

#
# onion method
#

function _lkj_cholesky_onion_sampler!(
    rng::AbstractRNG,
    d::LKJCholesky,
    R::LinearAlgebra.Cholesky,
)
    if R.uplo === 'U'
        _lkj_cholesky_onion_tri!(rng, R.factors, d.d, d.η, Val(:U))
    else
        _lkj_cholesky_onion_tri!(rng, R.factors, d.d, d.η, Val(:L))
    end
    return R
end

function _lkj_cholesky_onion_tri!(
    rng::AbstractRNG,
    A::AbstractMatrix,
    d::Int,
    η::Real,
    ::Val{uplo},
) where {uplo}
    # Section 3.2 in LKJ (2009 JMA)
    # reformulated to incrementally construct Cholesky factor as mentioned in Section 5
    # equivalent steps in algorithm in reference are marked.
    @assert size(A) == (d, d)
    A[1, 1] = 1
    d > 1 || return R
    β = η + (d - 2)//2
    #  1. Initialization
    w0 = 2 * rand(rng, Beta(β, β)) - 1
    @inbounds if uplo === :L
        A[2, 1] = w0
    else
        A[1, 2] = w0
    end
    @inbounds A[2, 2] = sqrt(1 - w0^2)
    #  2. Loop, each iteration k adds row/column k+1
    for k in 2:(d - 1)
        #  (a)
        β -= 1//2
        #  (b)
        y = rand(rng, Beta(k//2, β))
        #  (c)-(e)
        # w is directionally uniform vector of length √y
        @inbounds w = @views uplo === :L ? A[k + 1, 1:k] : A[1:k, k + 1]
        Random.randn!(rng, w)
        rmul!(w, sqrt(y) / norm(w))
        # normalize so new row/column has unit norm
        @inbounds A[k + 1, k + 1] = sqrt(1 - y)
    end
    #  3.
    return A
end


using IntervalArithmetic
include("utils.jl")
import ..AbstractUncertainIndexValueDataset

export
sequence_exists,
sequence_exists!

"""
    sequence_exists(x, c::SequentialSamplingConstraint)

Does a point-by-point sequence through the uncertain dataset `x` exist that satisfies the criteria `c`?

If `x` is an `UncertainIndexValueDataset`, then check for a sequence through the indices only.

Before the check is performed, the distributions in `x` are truncated to the quantiles provided
by `c` to ensure they have finite supports.

## Example

```julia
# Create a set of time indices
# We construct this is such a way that we *know* an increasing sequence exists.
t = [UncertainValue(Normal, i, 2) for i in 1:N];
sequence_exists(t, StrictlyIncreasing(StartToEnd()))
```
"""
function sequence_exists end

# If data has uncertainties both in indices and values, check only for indices.
sequence_exists(x::AbstractUncertainIndexValueDataset, c) = sequence_exists(x.indices, c)

function sequence_exists(x, c::SequentialSamplingConstraint)
    lqs, uqs = get_quantiles(x, c)

    return sequence_exists(lqs, uqs, c), lqs, uqs
end

function sequence_exists!(lqs, uqs, x::AbstractUncertainValueDataset, c)
    get_quantiles!(lqs, uqs, x, c)

    return sequence_exists(lqs, uqs, c)
end

sequence_exists(x::AbstractUncertainIndexValueDataset, c::StrictlyIncreasing{StartToEnd}) =
    sequence_exists(x.indices, c)

###########################
# Concrete implementations
###########################
"""
    sequence_exists(udata::AbstractUncertainValueDataset, c::StrictlyDecreasing{StartToEnd})

Does a strictly decreasing sequence through the dataset exist? I.e,  check that a strictly
decreasing sequence can be found after first
constraining each distribution to the provided quantile range (this
is necessary because some distributions may have infinite support).
"""
function sequence_exists(lqs, uqs, c::StrictlyIncreasing{StartToEnd})
    L = length(lqs)
    if any(lqs .> uqs) # ties are allowed, because we have `CertainValue`s
        error("Not all `lqs[i]` are lower than uqs[i]. Quantile calculations are not meaningful.")
        return false
    end

    for i = 1:L-1
        if lqs[i] >= minimum(uqs[i+1:end])
            return false
        end
    end
    return true
end

function sequence_exists(lqs, uqs, c::StrictlyDecreasing{StartToEnd})
    L = length(lqs)
    if any(lqs .> uqs) # ties are allowed, because we have `CertainValue`s
        error("Not all `lqs[i]` are lower than uqs[i]. Quantile calculations are not meaningful.")
        return false
    end

    for i = 1:L-1
        if uqs[i] < maximum(lqs[i+1:end])
            return false
        end
    end
    return true
end


## ExoplanetsSysSim/src/transit_observations.jl
## (c) 2015 Eric B. Ford

#using Distributions
#include("constants.jl")

#  Starting Section of Observables that are actually used
immutable TransitPlanetObs
  # ephem::ephemeris_type     # For now hardcode P and t0, see transit_observation_unused.jl to reinstate
  period::Float64             # days
  t0::Float64                 # days
  depth::Float64              # fractional
  duration::Float64           # days; Full-width, half-max-duration until further notice
  # ingress_duration::Float64   # days;  QUERY:  Will we want to use the ingress/egress duration for anything?
end
TransitPlanetObs() = TransitPlanetObs(0.0,0.0,0.0,0.0)

immutable StarObs
  radius::Float64      # in Rsol
  mass::Float64        # in Msol
end

semimajor_axis(P::Float64, M::Float64) = (grav_const/(4pi^2)*M*P*P)^(1/3)

function semimajor_axis(ps::PlanetarySystemAbstract, id::Integer)
  M = mass(ps.star) + ps.planet[id].mass   # TODO SCI DETAIL: Replace with Jacobi mass?  Probably not important unless start including TTVs at some point
  @assert(M>0.0)
  @assert(ps.orbit[id].P>0.0)
  return semimajor_axis(ps.orbit[id].P,M)
end

function calc_transit_depth(t::KeplerTarget, s::Integer, p::Integer)  # WARNING: IMPORTANT: Assumes non-grazing transit & no limb darkening
  depth = (t.sys[s].planet[p].radius/t.sys[s].star.radius)^2 # TODO SCI DETAIL: Include limb darkening?
  depth *=  flux(t.sys[s].star)/flux(t)                      # Flux ratio accounts for dillution
end

function calc_transit_duration_central_circ(ps::PlanetarySystemAbstract, pl::Integer)
  duration = rsol_in_au*ps.star.radius * ps.orbit[pl].P /(pi*semimajor_axis(ps,pl) )
end
calc_transit_duration_central_circ(t::KeplerTarget, s::Integer, p::Integer) = calc_transit_duration_central_circ(t.sys[s],p)

function calc_transit_duration_central(ps::PlanetarySystemAbstract, pl::Integer)
  ecc = ps.orbit[pl].ecc
  vel_fac = sqrt((1+ecc)*(1-ecc))/(1+ecc*sin(ps.orbit[pl].omega))
  duration = calc_transit_duration_central_circ(ps,pl) * vel_fac
end
calc_transit_duration_central(t::KeplerTarget, s::Integer, p::Integer) = calc_transit_duration_central(t.sys[s],p)

function calc_transit_duration(ps::PlanetarySystemAbstract, pl::Integer)
  a = semimajor_axis(ps,pl)
  @assert a>=zero(a)
  ecc = ps.orbit[pl].ecc
  @assert zero(ecc)<=ecc<=one(ecc)
  b = (a*abs(cos(ps.orbit[pl].incl))/(ps.star.radius*rsol_in_au)) * (1+ecc)*(1-ecc)/(1+ecc*sin(ps.orbit[pl].omega))
  @assert !isnan(b)
  @assert zero(b)<=b
  vel_fac = sqrt((1+ecc)*(1-ecc))/(1+ecc*sin(ps.orbit[pl].omega))
  duration = 0.0<=b<1.0 ? calc_transit_duration_central_circ(ps,pl) * vel_fac * sqrt((1-b)*(1+b)) : 0.0
end
calc_transit_duration(t::KeplerTarget, s::Integer, p::Integer ) = calc_transit_duration(t.sys[s],p)

function calc_expected_num_transits(t::KeplerTarget, s::Integer, p::Integer, sim_param::SimParam)
 period = t.sys[s].orbit[p].P
 exp_num_transits = t.duty_cycle * t.data_span/period
 #=
 if exp_num_transits <=6
 end
 # TODO SCI DETAIL: Calculate more accurat number of transits, perhaps using star and specific window function or perhaps specific times of data gaps more given module
 =#
 return exp_num_transits
end

include("transit_detection_model.jl")
include("transit_prob_geometric.jl")

type KeplerTargetObs                        # QUERY:  Do we want to make this type depend on whether the catalog is based on simulated or real data?
  obs::Vector{TransitPlanetObs}
  sigma::Vector{TransitPlanetObs}           # Simplistic approach to uncertainties for now.  QUERY: Should estimated uncertainties be part of Observations type?
  # snr::Vector{Float64}                      # Dimensionless SNR of detection for each planet QUERY: Should we store this here?
  # phys_id::Vector{tuple(Int32,Int32)}       # So we can lookup the system's properties for 0.3.*
  phys_id::Vector{Tuple{Int32,Int32}}     # So we can lookup the system's properties for 0.4

  prob_detect::SystemDetectionProbsAbstract  # QUERY: Specialize type of prob_detect depending on whether for simulated or real data?

  has_sc::Vector{Bool}                      # TODO OPT: Make Immutable Vector or BitArray to reduce memory use?  QUERY: Should this go in KeplerTargetObs?

  star::StarObs                             # TODO SCI DETAIL: Add more members to StarObs, so can used observed rather than actual star properties
end
KeplerTargetObs(n::Integer) = KeplerTargetObs( fill(TransitPlanetObs(),n), fill(TransitPlanetObs(),n), fill(tuple(0,0),n),  ObservedSystemDetectionProbsEmpty(),  fill(false,num_quarters), StarObs(0.0,0.0) )
num_planets(t::KeplerTargetObs) = length(t.obs)

function calc_target_obs_sky_ave(t::KeplerTarget, sim_param::SimParam)
  const max_tranets_in_sys = get_int(sim_param,"max_tranets_in_sys")
  const transit_noise_model = get_function(sim_param,"transit_noise_model")
  const min_detect_prob_to_be_included = 0.0  # get_real(sim_param,"min_detect_prob_to_be_included")
  const num_observer_samples = 1 # get_int(sim_param,"num_viewing_geometry_samples")

  np = num_planets(t)
  obs = Array{TransitPlanetObs}(np)
  sigma = Array{TransitPlanetObs}(np)
  #id = Array{Tuple{Int32,Int32}}(np)
  id = Array{Tuple{Int32,Int32}}(np)
  ns = length(t.sys)
  sdp_sys = Array{SystemDetectionProbsAbstract}(ns)
  i = 1
  for (s,sys) in enumerate(t.sys)
    pdet = zeros(num_planets(sys))
    for (p,planet) in enumerate(sys.planet)
      if get(sim_param,"verbose",false)
         println("# s=",s, " p=",p," num_sys= ",length(t.sys), " num_pl= ",num_planets(sys) )
      end
        ntr = calc_expected_num_transits(t, s, p, sim_param)
        period = sys.orbit[p].P
        # t0 = rand(Uniform(0.0,period))   # WARNING: Not being calculated from orbit
        depth = calc_transit_depth(t,s,p)
        duration_central = calc_transit_duration_central(t,s,p)
	snr_central = calc_snr_if_transit(t, depth, duration_central, sim_param, num_transit=ntr)
	pdet_ave = calc_ave_prob_detect_if_transit(t, snr_central, sim_param, num_transit=ntr)
	add_to_catalog = pdet_ave > min_detect_prob_to_be_included  # Include all planets with sufficient detection probability
	if add_to_catalog
	   const hard_max_num_b_tries = 100
	   max_num_b_tries = min_detect_prob_to_be_included == 0. ? hard_max_num_b_tries : min(hard_max_num_b_tries,convert(Int64,1/min_detect_prob_to_be_included))
           pdet_this_b = 0.0
           for j in 1:max_num_b_tries
              b = rand()  # WARNING: Making an approximation: Using a uniform distribution for b (truncated to ensure detection probability >0) when generating measurement uncertainties, rather than accounting for increased detection probability for longer duration transits
              transit_duration_factor = sqrt((1+b)*(1-b))
	      duration = duration_central * transit_duration_factor
	      snr = snr_central * transit_duration_factor
              pdet_this_b = calc_prob_detect_if_transit(t, snr, sim_param, num_transit=ntr)
              if pdet_this_b > 0.0
	         pdet[p] = pdet_ave
                 obs[i], sigma[i] = transit_noise_model(t, s, p, depth, duration, snr, ntr)   # WARNING: noise properties don't have correct dependance on b
                 id[i] = tuple(convert(Int32,s),convert(Int32,p))
      	         i += 1
                 break
              end
           end
	else
	   # Do anything for planets that are extremely unlikely to be detected even if they were to transit?
	end
    end
    resize!(obs,i-1)
    resize!(sigma,i-1)
    resize!(id,i-1)
    sdp_sys[s] = calc_simulated_system_detection_probs(sys, pdet, max_tranets_in_sys=max_tranets_in_sys, min_detect_prob_to_be_included=min_detect_prob_to_be_included, num_samples=num_observer_samples)
  end
  # TODO SCI DETAIL: Combine sdp_sys to allow for target to have multiple planetary systems
  s1 = findfirst(x->num_planets(x)>0,sdp_sys)  # WARNING IMPORTANT: For now just take first system with planets
  if s1 == 0
     s1 = 1
  end
  sdp_target = sdp_sys[s1]

  has_no_sc = fill(false,num_quarters)
  star_obs = StarObs( t.sys[1].star.radius, t.sys[1].star.mass )  # TODO SCI DETAIL: Could improve.  WARNING: ASSUMES STAR IS KNOWN PERFECTLY
  return KeplerTargetObs(obs, sigma, id, sdp_target, has_no_sc, star_obs )
end

function calc_target_obs_single_obs(t::KeplerTarget, sim_param::SimParam)
  #const max_tranets_in_sys = get_int(sim_param,"max_tranets_in_sys")
  const transit_noise_model = get_function(sim_param,"transit_noise_model")
  const min_detect_prob_to_be_included = 0.0  # get_real(sim_param,"min_detect_prob_to_be_included")

  np = num_planets(t)
  obs = Array{TransitPlanetObs}(np)
  sigma = Array{TransitPlanetObs}(np)
  #id = Array{Tuple{Int32,Int32}}(np)
  id = Array{Tuple{Int32,Int32}}(np)
  ns = length(t.sys)
  #sdp_sys = Array{SystemDetectionProbsAbstract}(ns)
  sdp_sys = Array{ObservedSystemDetectionProbs}(ns)
  i = 1
  for (s,sys) in enumerate(t.sys)
    pdet = zeros(num_planets(sys))
    for (p,planet) in enumerate(sys.planet)
      if get(sim_param,"verbose",false)
         println("# s=",s, " p=",p," num_sys= ",length(t.sys), " num_pl= ",num_planets(sys) )
      end
        duration = calc_transit_duration(t,s,p)
	if duration <= 0.
	   continue
	end
        ntr = calc_expected_num_transits(t, s, p, sim_param)
        period = sys.orbit[p].P
        # t0 = rand(Uniform(0.0,period))   # WARNING: Not being calculated from orbit
        depth = calc_transit_depth(t,s,p)
	snr = calc_snr_if_transit(t, depth, duration, sim_param, num_transit=ntr)
	pdet[p] = calc_prob_detect_if_transit(t, snr, sim_param, num_transit=ntr)
	if pdet[p] > min_detect_prob_to_be_included
           obs[i], sigma[i] = transit_noise_model(t, s, p, depth, duration, snr, ntr)
           id[i] = tuple(convert(Int32,s),convert(Int32,p))
      	   i += 1
	end
    end
    resize!(obs,i-1)
    resize!(sigma,i-1)
    resize!(id,i-1)
    sdp_sys[s] = ObservedSystemDetectionProbs(pdet)
  end
  # TODO SCI DETAIL: Combine sdp_sys to allow for target to have multiple planetary systems
  s1 = findfirst(x->num_planets(x)>0,sdp_sys)  # WARNING: For now just take first system with planets, assumes not two stars wht planets in one target
  if s1 == 0
     s1 = 1
  end
  sdp_target = sdp_sys[s1]

  has_no_sc = fill(false,num_quarters)
  star_obs = StarObs( t.sys[1].star.radius, t.sys[1].star.mass )  # TODO SCI DETAIL: Could improve.  WARNING: ASSUMES STAR IS KNOWN PERFECTLY
  return KeplerTargetObs(obs, sigma, id, sdp_target, has_no_sc, star_obs )
end

function test_transit_observations(sim_param::SimParam; verbose::Bool=false)  # TODO TEST: Add more tests
  #transit_param = TransitParameter( EphemerisLinear(10.0, 0.0), TransitShape(0.01, 3.0/24.0, 0.5) )
  generate_kepler_target = get_function(sim_param,"generate_kepler_target")
  const max_it = 100000
  local obs
  for i in 1:max_it
    target = generate_kepler_target(sim_param)::KeplerTarget
    while num_planets(target) == 0
      target = generate_kepler_target(sim_param)::KeplerTarget
    end
    calc_transit_prob_single_planet_one_obs(target,1,1)
    calc_transit_prob_single_planet_obs_ave(target,1,1)
    obs = calc_target_obs_single_obs(target,sim_param)
    obs = calc_target_obs_sky_ave(target,sim_param)
    if verbose && (num_planets(obs) > 0)
      println("# i= ",string(i)," np= ",num_planets(obs), " obs= ", obs )
      break
    end
  end
  return obs
end

randtn() = rand(TruncatedNormal(0.0,1.0,-0.999,0.999))

function transit_noise_model_no_noise(t::KeplerTarget, s::Integer, p::Integer, depth::Float64, duration::Float64, snr::Float64)
  period = t.sys[s].orbit[p].P
  t0 = rand(Uniform(0.0,period))    # WARNING: Not being calculated from orbit
  sigma_period = 0.0
  sigma_t0 = 0.0
  sigma_depth =  0.0
  sigma_duration =  0.0
  sigma = TransitPlanetObs( sigma_period, sigma_t0, sigma_depth, sigma_duration )
  obs = TransitPlanetObs( period, t0, depth,duration)
  return obs, sigma
end

function transit_noise_model_fixed_noise(t::KeplerTarget, s::Integer, p::Integer, depth::Float64, duration::Float64, snr::Float64, num_tr::Real)
  period = t.sys[s].orbit[p].P
  t0 = rand(Uniform(0.0,period))   # WARNING: Not being calculated from orbit

  sigma_period = 1e-6
  sigma_t0 = 1e-4
  sigma_depth =  0.01
  sigma_duration =  0.01

  sigma = TransitPlanetObs( sigma_period, sigma_t0, sigma_depth, sigma_duration)
  #obs = TransitPlanetObs( period, t0, depth, duration)
  obs = TransitPlanetObs( period*(1.0+sigma.period*randtn()), t0*(1.0+sigma.period*randtn()), depth*(1.0+sigma.depth*randtn()),duration*(1.0+sigma.duration*randtn()))
  return obs, sigma
end

function transit_noise_model_diagonal(t::KeplerTarget, s::Integer, p::Integer, depth::Float64, duration::Float64, snr::Float64, num_tr::Real)
  period = t.sys[s].orbit[p].P
  t0 = rand(Uniform(0.0,period))    # WARNING: Not being calculated from orbit

	# Use variable names from Price & Rogers
	one_minus_e2 = (1-t.sys[s].orbit[p].ecc)*(1+t.sys[s].orbit[p].ecc)
	a_semimajor_axis = semimajor_axis(t.sys[s],p)
	b = a_semimajor_axis *cos(t.sys[s].orbit[p].incl)/t.sys[s].star.radius
        b *= one_minus_e2/(1+t.sys[s].orbit[p].ecc*sin(t.sys[s].orbit[p].omega))
	tau0 = t.sys[s].star.radius*period/(a_semimajor_axis*2pi)
	tau0 *= sqrt(one_minus_e2)/(1+t.sys[s].orbit[p].ecc*sin(t.sys[s].orbit[p].omega))
	r = t.sys[s].planet[p].radius/t.sys[s].star.radius
	sqrt_one_minus_b2 = (0.0<=b<1.0) ? sqrt((1-b)*(1+b)) : 0.0
 	T = 2*tau0*sqrt_one_minus_b2
	tau = 2*tau0*r/sqrt_one_minus_b2
	Ttot = period
	I = LC_integration_time      # WARNING: Assumes LC only
	Lambda_eff = LC_rate * num_tr # calc_expected_num_transits(t, s, p, sim_param)
	delta = depth
	sigma = t.cdpp[1,1]

	# Price & Rogers Eqn A8 & Table 1 # WARNING: Someone should check Eqns
	tau3 = tau^3
	I3 = I^3
	#a1 = (10*tau3+2*I^3-5*tau*I^2)/tau3
	a2 = (5*tau3+I3-5*tau*tau*I)/tau3
	a3 = (9*I^5*Ttot-40*tau3+I*I*Ttot+120*tau^4*I*(3*Ttot-2*tau))/tau^6
	a4 = (a3*tau^5+I^4*(54*tau-35*Ttot)-12*tau*I3*(4*tau+Ttot)+360*tau^4*(tau-Ttot))/tau^5
	a5 = a2*(24T*T*(I-3*tau)-24*T*Ttot*(I-3*tau)+tau3*a4)/tau3
	#a6 = (3*tau*tau+T*(I-3*tau))/(tau*tau)
	#a7 = (-60*tau^4+12*a2*tau3*T-9*I^4+8*tau*I3+40*tau3*I)/(tau^4)
	#a8 = (2T-Ttot)/tau
	#a9 = (-3*tau*tau*I*(-10*T*T+10*T*Ttot+I*(2*I+5*Ttot))-I^4*Ttot+8*tau*I3*Ttot)/(tau^5)
	#a10 = ((a9+60)*tau*tau+10*(-9*T*T+9*T*Tot+I*(3*I+Tot))-75*tau*Ttot)/(tau*tau)
	a11 = (I*Ttot-3tau*(Ttot-2*tau))/(tau*tau)
	#a12 = (-360*tau^5-24*a2*tau3*T*(I-3tau)+9*I^5-35tau*I^4-12tau*tau*I3-40tau^3*I*I+360*tau^4*I)/(tau^5)
	a13 = (-3*I3*(8*T*T-8*T*Ttot+3*I*Ttot)+120*tau*tau*T*I*(T-Ttot)+8tau*I3*Ttot)/tau^5
	a14 = (a13*tau*tau+40*(-3*T*T+3*T*Ttot+I*Ttot)-60*tau*Ttot)/tau^5
	a15 = (2I-6tau)/tau
	b1  = (6*I*I-3*I*Ttot+tau*Ttot)/(I*I)
	b2  = (tau*T+3*I*(I-T))/(I*I)
	b3 = (tau3-12T*I*I+8I3+20tau*I*I-8*tau*tau*I)/I3
	b4 = (6*T*T-6*T*Ttot+I*(5Ttot-4I))/(I*I)
	b5 = (10I-3tau)/I
	b6 = (12b4*I3+4tau*(-6*T*T+6T*Ttot+I*(13*Ttot-30I)))/I3
	b7 = (b6*I^5+4*tau*tau*I*I*(12I-11Ttot)+tau3*I*(11Ttot-6I)-tau^4*Ttot)/I^5
	b8 = (3T*T-3*T*Ttot+I*Ttot)/(I*I)
	b9 = (8*b8*I^4+20*tau*I*I*Ttot-8*tau*tau*I*Ttot+tau3*Ttot)/I^4
	#b10 =  (-tau^4+24*T*I*I*(tau-3I)+60*I^4+52*tau*I3-44*tau*tau*I*I+11*tau3*I)/I^4
	#b11 =  (-15b4*i3+10b8*tau*I*I+15*tau*tau*(2I-Ttot))/I3
	#b12 =  (b11*I^5+2tau3*I*(4Ttot-3I)-tau^4*Ttot)/I^5
	#b13 =  (Ttot-2T)/I
	#b14 =  (6I-2tau)/I

        Q = snr/sqrt(num_tr)
        sigma_t0 = tau>=I ?  sqrt(0.5*tau*T/(1-I/(3tau)))/Q : sqrt(0.5*I  *T/(1-tau/(3I)))/Q
        sigma_period = sigma_t0/sqrt(num_tr)
        sigma_duration = tau>=I ? sigma*sqrt(abs(6*tau*a14/(delta*delta*a5)) /Lambda_eff )  : sigma*sqrt(abs(6*I*b9/(delta*delta*b7)) / Lambda_eff)
        sigma_depth = tau>=I ? sigma*sqrt(abs(-24*a11*a2/(tau*a5)) / Lambda_eff)  : sigma*sqrt(abs(24*b1/(I*b7)) / Lambda_eff)

  	sigma = TransitPlanetObs( sigma_period, sigma_t0, sigma_depth, sigma_duration )

        local obs
        if true     # Assume uncertainties uncorrelated (Diagonal)
  	    obs = TransitPlanetObs( period*(1.0+sigma.period*randtn()), t0*(1.0+sigma.period*randtn()), depth*(1.0+sigma.depth*randtn()),duration*(1.0+sigma.duration*randtn()))
        else        # TODO SCI DETAIL:  Account for correlated uncertaintties in transit parameters
            cov = zeros(4,4)
        if tau>=I
	#cov[0,0] = -3tau/(delta*delta*a15)
	cov[1,1] = 24*tau*a10/(delta*delta*a5)
	cov[1,2] = cov[2,1] = 36*a8*tau*a1/(delta*delta*a5)
	cov[1,3] = cov[3,1] = -12*a11*a1/(delta*a5)
	cov[1,4] = cov[4,1] = -12*a6*a1/(delta*a5)
	cov[2,2] = 6*tau*a14/(delta*delta*a5)
	cov[2,3] = cov[3,2] = 72*a8*a2/(delta*a5)
	cov[2,4] = cov[4,2] = 6*a7/(delta*a5)
	cov[3,3] = -24*a11*a2/(tau*a5)
	cov[3,4] = cov[4,3] = -24*a6*a2/(tau*a5)
	cov[4,4] = a12/(tau*a5)
        else
	#cov[0,0] = -3I/(delta*delta*b14)
	cov[1,1] = -24*I*I*b12/(delta*delta*b7)
	cov[1,2] = cov[2,1] = 36*I*b13*b5/(delta*delta*b7)
	cov[1,3] = cov[3,1] = 12*b5*b1/(delta*b7)
	cov[1,4] = cov[4,1] = 12*b5*b2/(delta*b7)
	cov[2,2] = 6*I*b9/(delta*delta*b7)
	cov[2,3] = cov[3,2] = 72*b13/(delta*b7)
	cov[2,4] = cov[4,2] = 6*b3/(delta*b7)
	cov[3,3] = 24*b1/(I*b7)
	cov[3,4] = cov[4,3] = 24*b2/(I*b7)
	cov[4,4] = b10/(I*b7)
	end
	cov .*= sigma*sigma/Lambda_eff
	obs_dist = MvNormal(zeros(4),cov)

	local obs_duration, obs_depth, sigma_duration, sigma_depth
        isvalid = false
	while !isvalid
	  obs_vec = rand(obs_dist)
          obs_duration = duration + obs_vec[2]
          obs_depth = depth + obs_vec[3]
          if (obs_duration>0.0) && (obs_depth>0.0)
             isvalid = true
	  end
	end
     	    obs = TransitPlanetObs( period*(1.0+sigma.period*randtn()), t0*(1.0+sigma.period*randtn()), obs_depth,obs_duration)
        end
  	return obs, sigma
end


# Create tensors with certain symmetry from medium parameters

"""
    iso(; vp=nothing, vs=nothing, lam=nothing, mu=nothing, K=nothing, G=nothing) -> C

Return an isotropic Voigt stiffness matrix `C` from a pair of the following:

`vp`, `vs` : Isotropic velocities in m/s

`lam`, `mu`: Lamé parameters **divided by density** in m^2/s^2

`K`, `G`   : Bulk and shear moduli **divided by density** in m^2/s^2
"""
function iso(; vp=nothing, vs=nothing, lam=nothing, mu=nothing, K=nothing, G=nothing)
    C = zero(EC)
    @inbounds begin
        if vp != nothing && vs != nothing
            C[1,1] = vp^2
            C[4,4] = vs^2
            C[1,2] = C[1,1] - 2C[4,4]
        elseif lam != nothing && mu != nothing
            C[1,1] = lam + 2mu
            C[4,4] = mu
            C[1,2] = lam
        elseif K != nothing && G != nothing
            C[1,1] = K + 4G/3
            C[4,4] = G
            C[1,2] = C[1,1] - 2C[4,4]
        else
            throw(ArgumentError("iso: Must request a pair of vp,vs; lam,mu; K,G"))
        end
        C[2,2] = C[3,3] = C[1,1]
        C[5,5] = C[6,6] = C[4,4]
        C[1,3] = C[2,3] = C[3,1] = C[3,2] = C[2,1] = C[1,2]
    end
    return C
end

"""
    vti(; vpv, vsv, vph, vsh, eta)

Return a density-normalised elastic tensor for a VTI medium defined using the velocities
Vpv, Vsv, Vph, Vsh and anisotropy parameter η.

    vti(; A, C, L, N, F)

Return an unnormalised elastic tensor for a VTI medium defined using Love's (1927) notation.

The constants are symmetric about the 3-axis.

### References

- Love AEH (1927) A Treatise on the Mathematical Theory of Elasticity. New York: Dover Publications.
"""
function vti(; vpv=nothing, vsv=nothing, vph=nothing, vsh=nothing, eta=nothing,
        A=nothing, C=nothing, L=nothing, N=nothing, F=nothing)
    if all(x->x!==nothing, (vpv, vsv, vph, vsh, eta))
        c = zero(EC)
        c[1,1] = c[2,2] = vph^2
        c[3,3] = vpv^2
        c[4,4] = c[5,5] = vsv^2
        c[6,6] = vsh^2
        c[1,3] = c[2,3] = c[3,1] = c[3,2] = eta*(c[1,1] - 2c[4,4])
        c[1,2] = c[2,1] = c[1,1] - 2c[6,6]
        c
    elseif all(x->x!==nothing, (A, C, L, N, F))
        EC{DEFAULT_FLOAT}((  A,  A-2N,  F,   0,   0,   0,
                           A-2N,   A,   F,   0,   0,   0,
                             F,    F,   C,   0,   0,   0,
                             0,    0,   0,   L,   0,   0,
                             0,    0,   0,   0,   L,   0,
                             0,    0,   0,   0,   0,   N))
    else
        throw(ArgumentError("Insufficient parameters defined."))
    end
end

"""
    thom(vp, vs, eps, gam, del) -> C

Return the 6x6 Voigt matrix defined `C` by the weak anisotropy parameters of
Thomsen (1986).

Output is density-normalised tensor.

### References

Thomsen, L. (1986).  Weak elastic anisotropy.  Geophysics, 51, 10, 1954-1966.
"""
function thom(vp, vs, eps, gam, del)
    if vp <= 0
        error("CIJ.thom: vp must be greater than 0")
    elseif vs < 0
        error("CIJ.thom: vs must be greater than or equal to 0")
    end

    C = zero(EC)
    @inbounds begin
        C[3,3] = vp^2
        C[1,1] = C[2,2] = C[3,3]*(2*eps + 1)
        C[4,4] = C[5,5] = vs^2
        C[6,6] = C[4,4]*(2*gam + 1)

        b = 2C[4,4]
        term = C[3,3] - C[4,4]
        c = C[4,4]^2 - (2*del*C[3,3]*term + term^2)
        d = b^2 - 4*c
        if (d < 0)
            error("CIJ.thom: S-velocity too high or delta too negative")
        end
        C[1,3] = C[2,3] = C[3,1] = C[3,2] = -b/2 + sqrt(d)/2
        C[1,2] = C[2,1] = C[1,1] - 2*C[6,6]
    end
    return C
end

"""
    thom_st(vp, vs, eps, gam, delst) -> C

Return the 6x6 Voigt matrix `C` defined by the general anisotropy parameters of
Thomsen (1986).

Output has same units as input.
"""
function thom_st(vp, vs, eps, gam, delst)
    if vp <= 0
        error("CIJ.thom: vp must be greater than 0")
    elseif vs < 0
        error("CIJ.thom: vs must be greater than or equal to 0")
    end

    C = zero(EC)
    @inbounds begin
        C[3,3] = vp^2
        C[1,1] = C[2,2] = C[3,3]*(2*eps + 1)
        C[4,4] = C[5,5] = vs^2
        C[6,6] = C[4,4]*(2*gam + 1)
        a = 2.0
        b = 4*C[4,4]
        c = C[4,4]^2 - 2*delst*C[3,3]^2 - (C[3,3] - C[4,4])*(C[1,1] + C[3,3] - 2*C[4,4])
        if b^2 - 4*a*c < 0
            error("CIJ.thom_st: S velocity too high or delta too negative")
        end
        C[1,3] = C[3,1] = C[2,3] = C[3,2] = (-b + sqrt(b^2 - 4*a*c))/(2*a)
        C[1,2] = C[2,1] = C[1,1] - 2C[6,6]
    end
    return C
end

"""
    global_VTI(vp, vs, xi, phi, eta) -> C

Return the 6x6 Voigt matrix `C` defined by the radial anisotropy parameters
as used typically in global seismology.
"""
function global_VTI(vp, vs, xi, phi, eta)
    if vp <= 0
        error("CIJ.global_VTI: vp must be greater than 0")
    elseif vs < 0
        error("CIJ.global_VTI: vs must be greater than or equal to 0")
    elseif xi <= 0 || phi <= 0 || eta <= 0
        error("CIJ.global_VTI: xi, phi and eta must be greater then 0")
    end

    L = 15*((3*phi + 8 + 4*eta)*vs^2 - (phi + 1 - 2*eta)*vp^2) /
        ((6 + 4*eta + 5*xi)*(3*phi + 8 +4*eta) - 8*(phi + 1 -2*eta)*(1 - eta))
    A = (15*vp^2 - 8*(1 - eta)*L) / (3*phi + 8 + 4*eta)
    F = eta*(A - 2L)
    C = phi*A
    N = xi*L
    C12 = A - 2N
    return EC{DEFAULT_FLOAT}(( A,  C12, F,  0,  0,  0,
                              C12,  A,  F,  0,  0,  0,
                               F,   F,  C,  0,  0,  0,
                               0,   0,  0,  L,  0,  0,
                               0,   0,  0,  0,  L,  0,
                               0,   0,  0,  0,  0,  N))
end

"""
    Panning_VTI(vp, vs, xi, phi, eta) -> C

Return the 6x6 Voigt matrix `C` defined by the radial anisotropy parameters
defined by Panning and Romanowicz as an approximation to general VTI.
"""
function Panning_VTI(vp, vs, xi, phi)
    L = 3*vs^2/(2 + xi)
    N = xi*L
    A = 5*vp^2/(4 + phi)
    C = phi*A
    F = A - 2*L
    C12 = A - 2*N
    return EC{DEFAULT_FLOAT}(( A,  C12, F,  0,  0,  0,
                              C12,  A,  F,  0,  0,  0,
                               F,   F,  C,  0,  0,  0,
                               0,   0,  0,  L,  0,  0,
                               0,   0,  0,  0,  L,  0,
                               0,   0,  0,  0,  0,  N))
end

"""
    lame(vp, vs, ρ) -> λ, μ, κ

Return the Lamé parameters `λ`, `μ` and `κ` from the velocities `vp` and `vs`
and density `ρ`.
"""
function lame(vp, vs, ρ)
    μ = ρ*vs^2
    λ = ρ*(vp^2 - 2vs^2)
    κ = ρ*vp^2 - 4/3*μ
    λ, μ, κ
end


#*******************************************************************************
#
#
#                Aplicação do split-operator em um sistema 2D
#               com condições de contorno tipo hardwall.
#
#
#*******************************************************************************

using PyPlot
using PyCall

@pyimport matplotlib.animation as anim # necessário para gerar vídeo da simulação

PyPlot.matplotlib[:rc]("text", usetex=true) # allow tex rendering
PyPlot.matplotlib[:rc]("font", family="serif")

# constantes físicas
Ry = 13.6056917253e3; # meV
a0 = 0.0529177208319; # nm
h2m = (Ry*a0^2); #  massa efetiva GaAs
hbar = 0.65821188926; # meV.ps

################################################################################
                    # Grid Bidimensional (Espaço real)
################################################################################
Lx = 1000; # Tamanho da dimensão "x" em nanometros (nm)
Ly = 200; # Tamanho da dimensão "y" em nanometros (nm)
Nx = div(Lx,3) # número de pontos na dimensão x
Ny = div(Ly,1) # número de pontos na dimensão y
# Nx = 2*Lx;
# Ny = 2*Ly;

x = linspace(-Lx/2, Lx/2, Nx+1)[1:end-1];
y = linspace(-Ly/2, Ly/2, Ny+1)[1:end-1];
dx = x[2] - x[1];
dy = y[2] - y[1];
X = kron(x', ones(Ny))
Y = kron(ones(Nx)', y)

################################################################################
                    # Espaço-k (na dimensão longitudinal à tira)
################################################################################
# A array "kx" deve ser 'invertida' via 'fftshift' para que todas as
# as funções de 'kx' possam ser multiplicadas elementwise sem confusão
# quando estivermos trabalhando com trasformadas de Fourier.

# Se houver interesse em observar como transformadas de Fourier e funções de
# 'kx' é interessante antes do 'plotting' reverter o 'shift'.

kx = fftshift(linspace(-pi/dx, pi/dx, Nx+1)[1:end]); # Valores possíveis de k_x
k0_x = pi/(2*dx);
k0_y = pi/(2*dy);

################################################################################
                    # Condição Inicial: Pacote Gaussiano
################################################################################

# Note que a condição inicial está representada no espaço de posição.

x_0 = -50; #  centro do pacote
y_0 = 0; #  centro do pacote
sigma_x = 30.0; # largura longitudinal
sigma_y = 30.0; # largura transversal
k0_x *= 0.5; # fração do kx_max
k0_y *= 0;   # fração do ky_max
# Norm = ((pi^2)*(sigma_x*sigma_y)^2)^(-1/4); # Fator para normalização
Norm = 1 ; # Fator para pacote NÃO normalizado

# pacote de ondas na representação de posições:
Ψ_0 = Norm * exp(-(X-x_0).^2/(2*sigma_x^2)-(Y-y_0).^2/(2*sigma_y^2)
                    + 1im*(k0_x*X + k0_y*Y))

################################################################################
                        # Hamiltoniano
################################################################################

#  O operador Hamiltoniano aqui é simplesmente aquele para uma partícula
# (Elétron) submetida a um potencial dependente da posição.

# Potencial:
α, β, γ = 10., .1, 50.;
V_degrau = α./(e.^(-β*(X-γ))+1);

# Cinética:
# matrizes Tridiagonais (Ny x Ny)
d2dy2 = 1/(dy^2) * SymTridiagonal(-2*ones(Ny), ones(Ny-1))

T_y  = - h2m * full(d2dy2)
T_kx =   h2m * kx.^2

################################################################################
                        # Funções para evolução temporal
################################################################################

function plot_simples(Ψ)
  pcolormesh(x,y,abs(Ψ).^2)
  ylim(-200,200)
  title("Gaussian distribution");
  xlabel(L"$x$");
  ylabel(L"$y$");
  return 0
end

function psi_dt(Ψ, Δt)
  # espaço de posições 'x'
  Ψ = [ exp(-1im*V_degrau[j,i]*Δt/(2*hbar)) * Ψ[j,i] for j=1:Ny, i=1:Nx ];

  # representação mista (kx,y)
  fft!(Ψ,2);
  for i = 1:Nx
    Ψ[:,i] = expm(-1im*(T_kx[i]*eye(Ny) + T_y)*Δt/hbar) * Ψ[:,i] ;
  end

  # espaço de posições 'x'
  ifft!(Ψ,2);
  Ψ = [exp(-1im*V_degrau[j,i]*Δt/(2*hbar)) * Ψ[j,i] for j=1:Ny, i=1:Nx ];

  return Ψ;
end

function psi_dt_animado(Δt)
  global Ψ_0
  if Δt == 0
    # Essa  condição existe para incluir a
    # cond. inicial no video da simulação
    clf()
    plot_simples(Ψ_0)
    return 0
  else
    # espaço de posições 'x'
    Ψ_0 = [ exp(-1im*V_degrau[j,i]*Δt/(2*hbar)) * Ψ_0[j,i] for j=1:Ny, i=1:Nx ];

    # representação mista (kx,y)
    fft!(Ψ_0,2);
    for i = 1:Nx
      Ψ_0[:,i] = expm(-1im*(T_kx[i]*eye(Ny) + T_y)*Δt/hbar) * Ψ_0[:,i] ;
    end

    # espaço de posições 'x'
    ifft!(Ψ_0,2);
    Ψ_0 = [exp(-1im*V_degrau[j,i]*Δt/(2*hbar)) * Ψ_0[j,i] for j=1:Ny, i=1:Nx ];

    clf()
    plot_simples(Ψ_0)
    return 0;
  end
end

function psit(Ψ, t_final, N_steps = 20)
  tspan = linspace(0, t_final, N_steps-1);
  delta_t = tspan[2]-tspan[1];

  for i = 1:N_steps
    psi_aux = psi_dt(Ψ,delta_t);
    Ψ = psi_aux;
  end
  Ψ
end

function psit_livre(Ψ, t)
  fft!(Ψ,2); # substitui Ψ por sua transformada de Fourier em "x"
  for i = 1:Nx
    Ψ[:,i] = expm(-1im*(T_kx[i]*eye(Ny) + T_y)* t/hbar)*Ψ[:,i] ;
  end
  ifft!(Ψ,2)
end

function simula_potencial(;t_final = 2.0, N_steps = 10, intervalo_frames = 100)

  Δt = t_final/N_steps;
  array_of_deltas = Δt*[0; ones(N_steps)];

  fig = figure();

  video = anim.FuncAnimation(fig,
                            psi_dt_animado,
                            frames = array_of_deltas,
                            interval = intervalo_frames);

  path = "/home/marcos/Dropbox/projetos/julia/split operator/";
  nome = string("simulação_com_potencial_degrau_em_x_50.mp4")

  video[:save](string(path,nome), extra_args=["-vcodec", "libx264"]);
  return 0
end

################################################################################
                        # Apresentação dos resultados
################################################################################

Ψ_1 = psit(Ψ_0, 2.0, 6)
# Ψ_1 = psit_livre(Ψ_0, 2)

figure(1)
pcolormesh(x,y,abs(Ψ_1).^2)
ylim(-200,200)
title("Gaussian distribution");
xlabel(L"$x$");
ylabel(L"$y$");

figure(2)
pcolormesh(X,Y,V_degrau)
ylim(-200,200)
title("Potential function");
xlabel(L"$x$");
ylabel(L"$y$");
colorbar()

# simula_potencial(t_final=10.0,N_steps=100,intervalo_frames=50)


let
    # Quadratic objective function
    # For (A*x-b)^2/2
    function quadratic!(x, g, AtA, Atb, tmp)
        calc_grad = !(g === nothing)
        A_mul_B!(tmp, AtA, x)
        v = dot(x,tmp)/2 + dot(Atb,x)
        if calc_grad
            for i = 1:length(g)
                g[i] = tmp[i] + Atb[i]
            end
        end
        return v
    end

    srand(1)
    N = 8
    boxl = 2.0
    outbox = false
    # Generate a problem where the bounds-free solution lies outside of the chosen box
    global objective
    while !outbox
        A = randn(N,N)
        AtA = A'*A
        b = randn(N)
        initial_x = randn(N)
        tmp = similar(initial_x)
        func = (x, g) -> quadratic!(x, g, AtA, A'*b, tmp)
        objective = Optim.DifferentiableFunction(x->func(x, nothing), (x,g)->func(x,g), func)
        results = Optim.optimize(objective, initial_x, ConjugateGradient())
        results = Optim.optimize(objective, Optim.minimizer(results), ConjugateGradient())  # restart to ensure high-precision convergence
        @test Optim.converged(results)
        g = similar(initial_x)
        @test func(Optim.minimizer(results), g) + dot(b,b)/2 < 1e-8
        @test norm(g) < 1e-4
        outbox = any(t -> abs(t) .> boxl, Optim.minimizer(results))
    end

    # fminbox
    l = fill(-boxl, N)
    u = fill(boxl, N)
    initial_x = (rand(N)-0.5)*boxl
    for _optimizer in (ConjugateGradient, GradientDescent, LBFGS, BFGS)
        results = Optim.optimize(objective, initial_x, l, u, Fminbox(), optimizer = _optimizer)
        @test Optim.converged(results)

        g = similar(initial_x)
        objective.fg!(Optim.minimizer(results), g)
        for i = 1:N
            @test abs(g[i]) < 3e-3 || (Optim.minimizer(results)[i] < -boxl+1e-3 && g[i] > 0) || (Optim.minimizer(results)[i] > boxl-1e-3 && g[i] < 0)
        end
    end

    # tests for #180
    results = Optim.optimize(objective, initial_x, l, u, Fminbox(); iterations = 2)
    @test Optim.iterations(results) == 2
    @test Optim.minimum(results) == objective.f(Optim.minimizer(results))

    # might fail if changes are made to Optim.jl
    # TODO: come up with a better test
    results = Optim.optimize(objective, initial_x, l, u, Fminbox(); optimizer_o = Optim.Options(iterations = 2))
    @test Optim.iterations(results) == 470
end


module BasicStats

    include("xlogx.jl")
    include("avg.jl")
    include("index.jl")
    export xlogx, avg, FisherIndex, normalization
end


# Keep this code as a library for future use. The JacobiSVD is significantly faster than the SVD that comes standard with Julia.

function ATA(A::AbstractArray{T,2}, j::Int, k::Int) where {T<:Real} # need AbstractArray instead of Array to handle Transpose, which is an AbstractArray but not an Array
    sum = zero(T)
    nrows, _ = size(A)
    @simd for i in 1:nrows
        sum += A[i, j] * A[i, k]
    end
    return sum
end

@inline epsilon(T::Real) = 4 * eps(T)

"this version will always perform iterations to high relative accuracy"
GivensRotation(ajj::T, ajk::T, akk::T) where {T<:Real} = GivensRotation(false, ajj, ajk, akk)

function GivensRotation(lowRelativeAccuracy::Bool, ajj::T, ajk::T, akk::T) where {T<:Real}
    local sinTheta, cosTheta, needToRotate

    product = ajj * akk # default value that may be overriden if computing small singular values to low relative accuracy

    if lowRelativeAccuracy
        println("using low relative accuracy")
        # less stringent accuracy requirement than requiring that the rotation matrices not change the diagonal elements of the matrix at all. The result is that small singular values may be computed with poor
        # relative accuracy, possibly having few significant digits of accuracy. For most applications computing the small singular values to high accuracy is not important so this is probably the way you would
        # want to compute most of the time.
        max = max(abs(ajj), abs(akk))
        min = min(abs(ajj), abs(akk))
        if min == 0 || max / min > 2^52  # this will cause the test "if (abs(ajk) >= eps * sqrt(product))" to fail with fewer iterations which makes the code significantly more efficient. This needs to be rewritten in terms of machine epsilon. This number pow(2,52) is correct only for Float64.
            product = max
        end
    end

    if ajk != zero(T) && abs(ajk) >= eps(T) * sqrt(product)
        local c, s, t, tau

        tau = (ajj - akk) / (2 * ajk)
        t = sign(tau) / (abs(tau) + sqrt(1 + tau * tau))
        c = 1 / sqrt(1 + t * t)
        s = c * t
        sinTheta = s
        cosTheta = c

        # NOTE: commented out this code because it greatly increased the residual Ax-b. Not sure how to include this without messing up accuracy in general. Leave it out for now.

        # when the matrix is singular it can be the case that the diagonal elements ajj, akk go to zero faster than ajk. This means the test "if (abs(ajk) >= eps * sqrt(ajj*akk))"
        # returns true until the diagonal and off diagonal elements become so small that the rotation matrix has no effect on any of the elements in the matrix (the rotation matrix becomes almost exactly
        # equal to the identity). If this happens the JacobiSVD function
        # will never stop iterating and you will get a max iterations exceeded exception. The following test detects when the diagonal elements are no longer being changed by rotation
        # and causes the iteration to stop if this is the case.
        # if abs((c * ajj - s * ajk) - ajj) < eps(T) && abs((s * ajk + c * akk) - akk) < eps(T)
        #     # c and s values are such that none of the diagonal elements in the matrix will change if the rotation is performed so don't rotate. More iterations than necessary since have to wait till diagonal and
        #     # off diagonal elements are reduced to values so small they are beyond the range of whatever precision float you are using. This is probably necessary if want high relative accuracy in small singular values but
        #     # there are many cases when this is not a requirement.
        #     # Have to use eps(T) instead of a test for equality because C# is apparently not using 64 bit IEEE double precision arithmetic. Instead it appears to be using the Intel extended precision
        #     # floating point. It takes many more iterations to reduce the diagonal elements to zero in this precision than in double precision.
        #     # an even more stringent requirement would be for the off diagonal elements also not to be changed by the rotation matrix but this can increase the number of iterations by 3-5 times for small
        #     # matrices, maybe more for big matrices. In some extreme cases exiting before the off diagonal elements cease to be changed may result in more error in the singular vectors than desirable but I have not observed this yet.
        #     needToRotate = false
        #     return sinTheta,cosTheta,needToRotate
        # else
        #     needToRotate = true
        #     return sinTheta,cosTheta,needToRotate
        # end

        needToRotate = true
        return sinTheta, cosTheta, needToRotate
    else
        # off diagonal elements essentially zero
        sinTheta = 0
        cosTheta = 0
        needToRotate = false
        return sinTheta, cosTheta, needToRotate
    end
end

function oneSidedJacobiRotation!(A::AbstractArray{T,2}, j::Int, k::Int, sinTheta::T, cosTheta::T) where {T<:Real} # need AbstractArray instead of Array to handle Transpose, which is an AbstractArray but not an Array
    s = sinTheta
    c = cosTheta
    numrows, _ = size(A)

    for i in 1:numrows
        Aij = A[i, j]
        Aik = A[i, k]
        A[i, j] = c * Aij + s * Aik
        A[i, k] = -s * Aij + c * Aik
    end
end

"use this version if you want to handle exceeding maximum number of iterations. DESTRUCTIVE: matrix A is overwritten. powerPercentage must be be between 0 and 1"
function JacobiSolve(A::AbstractArray{T,2}, b::AbstractArray{T,1}; computeToLowRelativeAccuracy::Bool = false, conditionNumber::T = T(1e20))::Array{T,1} where {T<:Real}  # don't like having to declare this as Real rather than AbstractFloat because eps(Real) wouldn't necessarily be defined. But that's the way the IntervalArithmetic package is designed so to make it work with intervals have to this. The ForwardDiff package is also designed to take Real arguments.
    local temp, total
    currentSum = zero(T)

    U, sigma, V, status = JacobiSVD(computeToLowRelativeAccuracy, A)
    temp = U' * b

    for i in 1:length(sigma)
        # println(S[0]/S[S.GetLength(0)-1]);
        if sigma[1] / sigma[i] > conditionNumber || sigma[i] == zero(T)
            temp[i] = zero(T)
        else
            temp[i] /= sigma[i]
        end
    end

    return V * temp

end

"DESTRUCTIVE: matrix A is overwritten. Returns U,sigma,V (not V'), iterationsexceeded   where iterationsexceeded will be either :exceededMax or :didNotExceedMax. If max iterations was exceeded it is possible the result is not accurate. But the results might also be fine."
function JacobiSVD(relativeaccuracy::Bool, A::AbstractArray{T,2}) where {T<:Real}
    acopy = copy(A)
    return JacobiSVD!(relativeaccuracy, acopy)
end

"sets flag to compute singular values to high relative accuracy. DESTRUCTIVE: matrix A is overwritten"
function JacobiSVD!(A::AbstractArray{T,2}) where {T<:Real}
    # out double[,] U, out double[] sigma, out double[,] V)
    return JacobiSVD!(false, A)
end

"DESTRUCTIVE: matrix A is overwritten. Returns U,sigma,V (not V'), iterationsexceeded   where iterationsexceeded will be either :exceededMax or :didNotExceedMax. If max iterations was exceeded it is possible the result is not accurate. But the results might also be fine."
function JacobiSVD!(computeToLowRelativeAccuracy::Bool, A::AbstractArray{T,2}) where {T<:Real}
    local status

    maxIterations = 35
    computingTranspose = false
    rowsA, colsA = size(A)

    # extend later
    if rowsA < colsA
        A = transpose(A)
        computingTranspose = true
        rowsA, colsA = size(A) # compute new size of transposed A
    end

    nrows = rowsA
    ncols = colsA
    n = colsA
    minRowsCols = min(nrows, ncols)
    sigma = Array{T,1}(undef, minRowsCols)
    localSigma = similar(sigma)

    numIterations = 0
    R = Matrix{T}(I, ncols, ncols)

    V = Array{T,2}(undef, n, n)
    U = Array{T,2}(undef, nrows, minRowsCols)
    while true

        rotatedThisIteration = false

        for j in 1:(n - 1)
            for k in (j + 1):n
                GTGjj = ATA(A, j, j)
                GTGjk = ATA(A, j, k)
                GTGkk = ATA(A, k, k)
                s, c, needToRotate = GivensRotation(computeToLowRelativeAccuracy, GTGjj, GTGjk, GTGkk)
                rotatedThisIteration = rotatedThisIteration || needToRotate
                if needToRotate
                    oneSidedJacobiRotation!(A, j, k, s, c)
                    oneSidedJacobiRotation!(R, j, k, s, c)
                end
            end
        end

        numIterations += 1
        if numIterations > maxIterations
            break
        end
        if !rotatedThisIteration
            break
        end
    end

    for i in 1:length(localSigma)
        localSigma[i] = 0
        for j in 1:rowsA
            # localSigma[i] += A[j, i] * A[j, i];
            localSigma[i] += A[j, i]^2 # use this instead of A[j,i]*A[j,i]. Interval arithmetic package will compute a much tighter inclusion
        end
        localSigma[i] = sqrt(localSigma[i])
    end

    # sort sigmas
    indices = sortperm(localSigma, rev = true)
    localSigma = localSigma[indices]

    for i in 1:minRowsCols
        sigma[i] = localSigma[i]  # copy just the true singular values

        for j in 1:rowsA
            if (sigma[i] != 0)
                U[j, i] = A[j, indices[i]] / sigma[i]
            else
                U[j, i] = 0
            end

        end
        for j in 1:n
            V[j, i] = R[j, indices[i]]
        end
    end

    if computingTranspose
        temp = V
        V = U
        U = temp
    end

    if numIterations > maxIterations
        status = :exceededMax
    else
        status = :didNotExceedMax
    end
    return (U = U, sigma = sigma, V = V, status = status)
end


ang = pi/3
c = DCM(ang,'x',false)
b = [6;2;6]
d = c*c*b
print(d)

Earth_a = 149600000
Mars_a = 227920000
Sun_mu = 1.3271*10^11
e = circHohmann(Earth_a, Mars_a, Sun_mu)


using LinearAlgebraicRepresentation
Lar = LinearAlgebraicRepresentation
using ViewerGL
GL = ViewerGL

function randombubbles()
	store = []
	mycircle(r,n) = Lar.circle(r)([n])
	for k=1:50
		r = rand()
		n = 8
		while true
			n = abs(rand(Int8)+1)
			if n>2 break end
		end
		scale = Lar.s(0.25,0.25)
		transl = Lar.t(rand(2)...)
		s = Lar.Struct([ transl, scale, mycircle(r,n) ])
		push!(store, Lar.struct2lar(s))
	end
	s = Lar.Struct(store)
	V,EV = Lar.struct2lar(s)
	V = GL.normalize2(V)
	GL.VIEW([ GL.GLLines(V,EV) ])

	W,EW = Lar.fragmentlines((V,EV))
	V,FVs,EVs = Lar.arrange2D(W,EW)
end

# ////////////////////////////////////////////////////////////
# generation of 2D arrangement
V,FVs,EVs = randombubbles()

# native OpenGL visualization
GL.VIEW(GL.GLExplode(V,FVs,1.2,1.2,1.2,1,1));
GL.VIEW(GL.GLExplode(V,FVs,1.2,1.2,1.2,3,1));
GL.VIEW(GL.GLExplode(V,FVs,1.,1.,1.,99,1));
GL.VIEW(GL.GLExplode(V,FVs,1.2,1.2,1.2,99,1));

GL.VIEW(GL.GLExplode(V,EVs,1.2,1.2,1.2,1,1));
GL.VIEW(GL.GLExplode(V,EVs,1,1,1,1,1));


"""
WaveEquationNonperiodicSemidiscretisation

A semidiscretisation of the linear wave equation
    \$\\partial_t^2 u(t,x) = \\partial_x^2 u(t,x)\$.
"""
struct WaveEquationNonperiodicSemidiscretisation{Derivative<:AbstractDerivativeOperator,
                                                 LeftBC, RightBC} <: AbstractSemidiscretisation
    derivative::Derivative
    left_bc::LeftBC
    right_bc::RightBC
end

function semidiscretise(du0func, u0func, semidisc::WaveEquationNonperiodicSemidiscretisation, tspan)
  du0 = compute_coefficients(du0func, semidisc.derivative)
  u0 = compute_coefficients(u0func, semidisc.derivative)
  ode = SecondOrderODEProblem(semidisc, du0, u0, tspan)
end

function Base.show(io::IO, semidisc::WaveEquationNonperiodicSemidiscretisation)
    print(io, "Semidiscretisation of the linear wave equation\n")
    print(io, "  \$ \\partial_t^2 u(t,x) = \\partial_x^2 u(t,x) \$ \n")
    print(io, "with nonperiodic boundaries using")
    print(io, semidisc.derivative)
end

function (disc::WaveEquationNonperiodicSemidiscretisation)(ddu, du, u, p, t)
    @unpack derivative, left_bc, right_bc = disc
    @boundscheck begin
        @argcheck length(u) == length(du)
        @argcheck length(u) == length(ddu)
    end

    # volume terms of the second derivative
    mul!(ddu, derivative, u)

    # boundary conditions using SATs
    if left_bc == Val(:HomogeneousNeumann)
        @inbounds ddu[1] += derivative_left(derivative, u, Val(1)) / left_boundary_weight(derivative)
    elseif left_bc == Val(:HomogeneousDirichlet)
        add_transpose_derivative_left!(ddu, derivative, Val(1), -u[1] / left_boundary_weight(derivative))
        # only a rough estimate, should probably be improved
        # see Mattsson, Ham, Iaccarino (2009) Stable boundary ...
        # parameter α in Table 1 instead of accuracy_order(derivative)
        @inbounds ddu[1] -= accuracy_order(derivative) * u[1] / left_boundary_weight(derivative)^2
    elseif left_bc == Val(:NonReflecting)
        @inbounds ddu[1] -= (du[1] - derivative_left(derivative, u, Val(1))) / left_boundary_weight(derivative)
    else
        throw(ArgumentError("Boundary condition $left_bc not implemented."))
    end

    if right_bc == Val(:HomogeneousNeumann)
       @inbounds ddu[end] -= derivative_right(derivative, u, Val(1)) / right_boundary_weight(derivative)
    elseif right_bc == Val(:HomogeneousDirichlet)
        add_transpose_derivative_right!(ddu, derivative, Val(1), u[end] / right_boundary_weight(derivative))
        # only a rough estimate, should probably be improved, see above
        @inbounds ddu[end] -= accuracy_order(derivative) * u[end] / right_boundary_weight(derivative)^2
    elseif right_bc == Val(:NonReflecting)
        @inbounds ddu[end] -= (du[end] + derivative_right(derivative, u, Val(1))) / right_boundary_weight(derivative)
    else
        throw(ArgumentError("Boundary condition $right_bc not implemented."))
    end

    nothing
end


#=
Copyright (c) 2018-2022 Chris Coey, Lea Kapelevich, and contributors

This Julia package Hypatia.jl is released under the MIT license; see LICENSE
file in the root directory or at https://github.com/chriscoey/Hypatia.jl

list of predefined matrix polynomials
=#

import DynamicPolynomials
const DP = DynamicPolynomials

function get_psdpoly_data(matpoly::Symbol)
    if matpoly == :matpoly1
        DP.@polyvar x
        M = [
            (x + 2x^3)  1;
            (-x^2 + 2)  (3x^2 - x + 1);
            ]
        MM = M' * M
        return ([x], MM, true)
    elseif matpoly == :matpoly2
        DP.@polyvar x
        poly = x^4 + 2x^2
        return ([x], poly, true)
    elseif matpoly == :matpoly3
        DP.@polyvar x y
        poly = (x + y)^4 + (x + y)^2
        return ([x, y], poly, true)
    elseif matpoly == :matpoly4
        n = 3
        m = 3
        d = 1
        DP.@polyvar x[1:n]
        Z = DP.monomials(x, 0:d)
        M = [sum(rand() * Z[l] for l in 1:length(Z)) for i in 1:m, j in 1:m]
        MM = M' * M
        MM = 0.5 * (MM + MM')
        return (x, MM, true)
    elseif matpoly == :matpoly5
        # example modified from
        # https://github.com/JuliaOpt/SumOfSquares.jl/blob/master/test/simplematrixsos.jl
        # Example 3.77 and 3.79 of Blekherman, G., Parrilo, P. A., & Thomas, R. R. (Eds.),
        # Semidefinite optimization and convex algebraic geometry SIAM 2013
        DP.@polyvar x
        P = [
            (x^2 - 2x + 2)  x;
            x               x^2;
            ]
        return ([x], P, true)
    elseif matpoly == :matpoly6
        # example modified from
        # https://github.com/JuliaOpt/SumOfSquares.jl/blob/master/test/choi.jl
        # verifies that a given polynomial matrix is not a Sum-of-Squares matrix
        # see Choi, M. D., "Positive semidefinite biquadratic forms",
        # Linear Algebra and its Applications, 1975, 12(2), 95-100
        DP.@polyvar x y z
        P = [
            (x^2 + 2y^2)    (-x * y)        (-x * z);
            (-x * y)        (y^2 + 2z^2)    (-y * z);
            (-x * z)        (-y * z)        (z^2 + 2x^2);
            ] .* (x * y * z)^0
        # TODO the (x * y * z)^0 can be removed when
        # https://github.com/JuliaOpt/SumOfSquares.jl/issues/106 is fixed
        return ([x, y, z], P, false)
    elseif matpoly == :matpoly7
        # example modified from
        # https://github.com/JuliaOpt/SumOfSquares.jl/blob/master/test/sosdemo9.jl
        # Section 3.9 of SOSTOOLS User's Manual, see
        # https://www.cds.caltech.edu/sostools/
        DP.@polyvar x y z
        P = hvcat((2, 2),
            (x^4 + x^2 * y^2 + x^2 * z^2),
            (x * y * z^2 - x^3 * y - x * y * (y^2 + 2 * z^2)),
            (x * y * z^2 - x^3 * y - x * y * (y^2 + 2 * z^2)),
            (x^2 * y^2 + y^2 * z^2 + (y^2 + 2 * z^2)^2))
        return ([x, y, z], P, true)
    end
end


"""
    Multivector3{T <: Real} <: AbstractMultivector{T}

An immutable 8-tuple of real numbers that represents a member
of a 3-dimensional multivector algebra.

Each `Multivector3` has the form
```math
    p+qC
```
where ``p`` and ``q`` are 2-dimensional multivectors, or
```math
    a+bA+cB+dAB+fC+gAC+hBC+j(AB)C
```
where ``a``, ``b``, ``c``, ``d``, ``f``, ``g``, ``h``, and ``j`` are real
(and of the same type), and ``A * A = 0``, ``B * B = 0``, `` C * C = 0``;
``AB = A * B = -B * A``, ``AC = A * C = -C * A``, ``BC = B * C = -C * B``;
and ``(AB)C = (A * B) * C``.
Here ``*`` is the wedge product.
"""
struct Multivector3{T <: Real} <: AbstractMultivector{T}
    l::Multivector2{T}
    r::Multivector2{T}

    Multivector3{U}(l::Multivector2{U}, r::Multivector2{U}) where {U <: Real} = new(l, r)
end

function Multivector3(x::Multivector2{T}, y::Multivector2{T}) where {T <: Real}
    Multivector3{T}(x, y)
end

function Multivector3(a::T, b::T, c::T, d::T, f::T, g::T, h::T, j::T) where {T <: Real}
    Multivector3{T}(Multivector2(a, b, c, d), Multivector2(f, g, h, j))
end

function Multivector3(a::T, b::T, c::T, d::T, f::T, g::T, h::T) where {T <: Real}
    Multivector3{T}(Multivector2(a, b, c, d), Multivector2(f, g, h))
end

function Multivector3(a::T, b::T, c::T, d::T, f::T, g::T) where {T <: Real}
    Multivector3{T}(Multivector2(a, b, c, d), Multivector2(f, g))
end

function Multivector3(a::T, b::T, c::T, d::T, f::T) where {T <: Real}
    Multivector3{T}(Multivector2(a, b, c, d), Multivector2(f))
end

function Multivector3(a::T, b::T, c::T, d::T) where {T <: Real}
    Multivector3{T}(Multivector2(a, b, c, d), zero(Multivector2{T}))
end

function Multivector3(a::T, b::T, c::T) where {T <: Real}
    Multivector3{T}(Multivector2(a, b, c), zero(Multivector2{T}))
end

function Multivector3(a::T, b::T) where {T <: Real}
    Multivector3{T}(Multivector2(a, b), zero(Multivector2{T}))
end

function Multivector3(a::T) where {T <: Real}
    Multivector3{T}(Multivector2(a), zero(Multivector2{T}))
end

function Multivector3(a::Real, b::Real, c::Real, d::Real, f::Real, g::Real, h::Real, j::Real)
    Multivector3(promote(a, b, c, d, f, g, h, j)...)
end

function Multivector3(a::Real, b::Real, c::Real, d::Real, f::Real, g::Real, h::Real)
    Multivector3(promote(a, b, c, d, f, g, h)...)
end

function Multivector3(a::Real, b::Real, c::Real, d::Real, f::Real, g::Real)
    Multivector3(promote(a, b, c, d, f, g)...)
end

function Multivector3(a::Real, b::Real, c::Real, d::Real, f::Real)
    Multivector3(promote(a, b, c, d, f)...)
end

function Multivector3(a::Real, b::Real, c::Real, d::Real)
    Multivector3(promote(a, b, c, d)...)
end

function Multivector3(a::Real, b::Real, c::Real)
    Multivector3(promote(a, b, c)...)
end

function Multivector3(a::Real, b::Real)
    Multivector3(promote(a, b)...)
end

function Multivector3(x::Multivector2, y::Multivector2)
    Multivector3(promote(asarray(x)..., asarray(y)...)...)
end

function Multivector3(x::Multivector2)
    Multivector3(x, zero(x))
end

function Multivector3(r::Multivector1, s::Multivector1, t::Multivector1, u::Multivector1)
    Multivector3(Multivector2(r, s), Multivector2(t, u))
end

function Multivector3(r::Multivector1, s::Multivector1, t::Multivector1)
    Multivector3(Multivector2(r, s), Multivector2(t))
end

function Multivector3(r::Multivector1, s::Multivector1)
    Multivector3(Multivector2(r, s), Multivector2(zero(s)))
end

function Multivector3(r::Multivector1)
    Multivector3(Multivector2(r))
end

function show(io::IO, z::Multivector3)
    print(io, "[1: ")
    print(io, z.l.l.l)
    print(io, ", A: ")
    print(io, z.l.l.r)
    print(io, ", B: ")
    print(io, z.l.r.l)
    print(io, ", AB: ")
    print(io, z.l.r.r)
    print(io, ", C: ")
    print(io, z.r.l.l)
    print(io, ", AC: ")
    print(io, z.r.l.r)
    print(io, ", BC: ")
    print(io, z.r.r.l)
    print(io, ", (AB)C: ")
    print(io, z.r.r.r)
    print(io, "]")
end

function real(z::Multivector3)
    real(z.l)
end

function unreal(z::Multivector3)
    vcat(unreal(z.l), asarray(z.r))
end

function zero(z::Multivector3{T}) where {T <: Real}
    Multivector3{T}(zero(z.l), zero(z.r))
end

function zero(::Type{Multivector3{T}}) where {T <: Real}
    Multivector3{T}(zero(T))
end

function one(z::Multivector3{T}) where {T <: Real}
    Multivector3{T}(one(z.l))
end

function one(::Type{Multivector3{T}}) where {T <: Real}
    Multivector3{T}(one(T))
end

"""
    conj{T <: Real}(z::Multivector3{T})

The `Multivector3` conjugate. If ``z=a+bA+cB+dAB+fC+gAC+hBC+j(AB)C``,
then `conj(z)` gives
```math
    a-bA-cB-dAB-fC-gAC-hBC-j(AB)C
```
This operation is an involution.
"""
function conj(z::Multivector3{T}) where {T <: Real}
    Multivector3{T}(conj(z.l), -z.r)
end

"""
    cloak{T <: Real}(z::Multivector3{T})

The cloak conjugate changes the sign of even blades. If ``z=a+bA+cB+dAB+fC+gAC+hBC+j(AB)C``,
then `cloak(z)` gives
```math
    -a+bA+cB-dAB+fC-gAC-hBC+j(AB)C
```
This operation is equivalent to `-dagger(z)` and thus is also an involution.
"""
function cloak(z::Multivector3{T}) where {T <: Real}
    Multivector3{T}(cloak(z.l), dagger(z.r))
end

"""
    dagger{T <: Real}(z::Multivector3{T})

The dagger conjugate changes the sign of odd blades. If ``z=a+bA+cB+dAB+fC+gAC+hBC+j(AB)C``, then `dagger(z)` gives
```math
    a-bA-cB+dAB-fC+gAC+hBC-j(AB)C
```
This operation is an involution.
"""
function dagger(z::Multivector3{T}) where {T <: Real}
    Multivector3{T}(dagger(z.l), cloak(z.r))
end

"""
    star{T <: Real}(z::Multivector3{T})

Returns the Hodge star conjugate. If ``z=a+bA+cB+dAB+fC+gAC+hBC+j(AB)C``, then `star(z)` gives
```math
    j+hA-gB+fAB+dC-cAC+bBC+a(AB)C
```
This operation is an involution.
"""
function star(z::Multivector3{T}) where {T <: Real}
    Multivector3{T}(dagger(star(z.r)), star(z.l))
end

"""
    selfstar(z::Multivector3)

The self-star-conjugate part.
In odd number of dimensions, this operation is idempotent.
"""
function selfstar(z::Multivector3)
    (z + star(z)) / 2
end

"""
    antiselfstar(z::Multivector3)

The anti-self-star-conjugate part.
In odd number of dimensions, this operation is idempotent.
"""
function antiselfstar(z::Multivector3)
    (z - star(z)) / 2
end

function (+)(x::Multivector3, y::Multivector3)
    Multivector3(x.l + y.l, x.r + y.r)
end

function (+)(x::Multivector3, y::Multivector2)
    Multivector3(x.l + y, x.r)
end

function (+)(x::Multivector2, y::Multivector3)
    Multivector3(x + y.l, y.r)
end

function (+)(x::Multivector3, y::Multivector1)
    Multivector3(x.l + y, x.r)
end

function (+)(x::Multivector1, y::Multivector3)
    Multivector3(x + y.l, y.r)
end

function (+)(z::Multivector3, a::Real)
    Multivector3(z.l + a, z.r)
end

function (+)(a::Real, z::Multivector3)
    Multivector3(z.l + a, z.r)
end

function (-)(z::Multivector3{T}) where {T <: Real}
    Multivector3{T}(-z.l, -z.r)
end

function (-)(x::Multivector3, y::Multivector3)
    Multivector3(x.l - y.l, x.r - y.r)
end

function (-)(x::Multivector3, y::Multivector2)
    Multivector3(x.l - y, x.r)
end

function (-)(x::Multivector2, y::Multivector3)
    Multivector3(x - y.l, -y.r)
end

function (-)(x::Multivector3, y::Multivector1)
    Multivector3(x.l - y, x.r)
end

function (-)(x::Multivector1, y::Multivector3)
    Multivector3(x - y.l, -y.r)
end

function (-)(z::Multivector3, a::Real)
    Multivector3(z.l - a, z.r)
end

function (-)(a::Real, z::Multivector3)
    Multivector3(a - z.l, -z.r)
end

"""
    (*)(x::Multivector3, y::Multivector3)

Wedge product of two 3-dimensional multivectors.
This operation is non-commutative and non-associative.
"""
function (*)(x::Multivector3, y::Multivector3)
    Multivector3(x.l * y.l,  (y.r * x.l) + (x.r * conj(y.l)))
end

function (*)(x::Multivector3, y::Multivector2)
    Multivector3(x.l * y, x.r * conj(y))
end

function (*)(x::Multivector2, y::Multivector3)
    Multivector3(x * y.l,  y.r * x)
end

function (*)(x::Multivector3, y::Multivector1)
    Multivector3(x.l * y, x.r * conj(y))
end

function (*)(x::Multivector1, y::Multivector3)
    Multivector3(x * y.l,  y.r * x)
end

"""
    (*)(z::Multivector3, a::Real)
    (*)(a::Real, z::Multivector3)

Scaling and/or reflection of a `Multivector3` by a real number.
"""
function (*)(z::Multivector3, a::Real)
    Multivector3(z.l * a, z.r * a)
end

function (*)(a::Real, z::Multivector3)
    Multivector3(a * z.l, a * z.r)
end

function (/)(x::Multivector3, y::Multivector3)
    if iszerodivisor(y)
        error(ZeroDivisorDenominator)
    end

    x * inv(y)
end

function (\)(y::Multivector3, x::Multivector3)
    if iszerodivisor(y)
        error(ZeroDivisorDenominator)
    end

    inv(y) * x
end

function (/)(z::Multivector3, a::Real)
    Multivector3(z.l / a, z.r / a)
end

function (\)(a::Real, z::Multivector3)
    Multivector3(a \ z.l, a \ z.r)
end

function random(::Type{Multivector3{T}}) where T <: Real
    Multivector3{T}(random(Multivector2{T}), random(Multivector2{T}))
end


# Copyright (c) 2021, Joseph M. Rutherford
# All rights reserved.
#
# Code provided under the license contained in the LICENSE file.
# Copyright (c) 2021, Joseph M. Rutherford
# All rights reserved.
#
# Code provided under the license contained in the LICENSE file.
#
# This file does not have any dependencies upon other scripts

"""
    puzzle_n(rank)

Given 2 <= rank <= 15, return a Sudoku integer array sized rank*rank.
"""
function puzzle_n(rank::Integer)
    if (rank < 2) || (rank > 15)
        throw(DomainError("Invalid puzzle rank outside [2,15]"))
    end
    rank_squared = rank*rank
    result = Array{Integer}(undef,(rank_squared,rank_squared))
    for col = 1:rank_squared
        col_shift = Integer(floor((col-1)/rank))
        for row = 1:rank_squared
            result[row,col] = ( (rank*(col-1) + (row-1)) + col_shift) % rank_squared + 1
        end
    end
    return result
end

"""
A maybe-unknown Sudoku value with possible values tracked.

If value > 0, the entry is known and 1<= value <= rank-squared.
If value == 0, the the entry is unknown, and possible values indices into a bit vector for which true is assigned.
"""
struct PuzzleEntry
    possibilities::UInt16 # Bitmask index = 1 iff index is allowed

    """
    Define entry with a value and a BitVector of possibilities.
    """
    function PuzzleEntry(possibilities::BitVector)
        rank = 0
        rank_squared = length(possibilities)
        if rank_squared == 4
            rank = 2
        elseif rank_squared == 9
            rank = 3
        elseif rank_squared == 16
            rank = 4
        else
            throw(DomainError("Possibilities vector length invalid"))
        end
        new(UInt16(possibilities.chunks[1])) # Use local new method
    end
end

"""
    make_entry(rank_squared,value)

Given a squared-rank > 3 and < 17, create a new PuzzleEntry.
A value of 0 is completely unknown.
A value in 1:rank_squared is completely known.
"""
function make_entry(rank_squared::Integer, value::Integer)
    if !(rank_squared in [4,9,16])
        throw(DomainError("Cannot instantiate an entry for rank < 2 or > 4"))
    end
    if value < 0 || value > rank_squared
        throw(DomainError("Cannot instantiate an entry from an value < 0 or > rank*rank"))
    end
    possibilities = BitVector(undef,rank_squared)
    if value == 0
        possibilities .= true
    else
        possibilities .= false
        possibilities[value] = true
    end
    return PuzzleEntry(possibilities)
end

function get_value(entry::PuzzleEntry)
    temp = BitVector(undef,16) # Driven by storage as Int16
    temp.chunks[1] = entry.possibilities # Convert int to BitVector
    possible_count = 0 # Number of possibilities found
    result = 0 # Default to unknown
    for i in 1:length(temp)
        if temp[i]
            possible_count += 1
            result = i
        end
    end
    if possible_count != 1
        result = 0
    end
    return result
end

"""
A square grid of PuzzleEntry instances.

See also [`random_puzzle`](@ref), [`solve_puzzle!`](@ref).
"""
struct SolvablePuzzle
    grid::Array{PuzzleEntry}
    """

    """
    function SolvablePuzzle(rank::Integer)
        solved_puzzle = puzzle_n(rank)
        puzzle = Array{PuzzleEntry}(undef,size(solved_puzzle))
        rank_squared = rank*rank
        for i = 1:length(solved_puzzle)
            v = Integer(solved_puzzle[i])
            puzzle[i] = make_entry(rank_squared,v)
        end
        return new(puzzle)
    end
end

"""
    assign_values!(puzzle,new_values)

Assign a grid of integers into a SolvablePuzzle.
Zero values are set as unknowns.

# Arguments
- puzzle::SolvablePuzzle: grid of Sudoku values to set.
- new_values::Array: input integers of same shape as SolvablePuzzle.grid
"""
function assign_values!(puzzle::SolvablePuzzle,new_values::Array)
    if size(puzzle.grid) != size(new_values)
        throw(DomainError("Mismatched shape of new values for puzzle"))
    end
    rank_squared = size(new_values)[1]
    for row = 1:rank_squared
        for col = 1:rank_squared
            value = new_values[row,col]
            if value < 0 || value > rank_squared
                throw(DomainError("Invalid new value; must be in [0 (unknown), rank-squared]"))
            elseif new_values[row,col] == 0
                # Unknown value
                set_unknown(puzzle,row,col)
            else
                v = Integer(value)
                puzzle.grid[row,col] = make_entry(rank_squared,v)
            end
        end
    end
end

"""
    get_rank(puzzle)

Return a Sudoku rank from the shape of a 2D aray.
"""
function get_rank(puzzle::Array)
    grid_shape = size(puzzle)
    if grid_shape == (4,4) || grid_shape == (16,)
        return 2
    elseif grid_shape == (9,9) || grid_shape == (81,)
        return 3
    elseif grid_shape == (16,16) || grid_shape == (256,)
        return 4
    else
        throw(DimensionMismatch("Puzzles must of shape (rank*rank,rank*rank), 1 < rank < 5"))
    end
end

"""
    get_rank(puzzle)

Return a Sudoku rank from a SolvablePuzzle.
"""
function get_rank(puzzle::SolvablePuzzle)
    return get_rank(puzzle.grid)
end

"""
    set_unknown(puzzle,row,col)

Assign a position in the grid of a SolvablePuzzle to known.
"""
function set_unknown(puzzle::SolvablePuzzle,row::Integer,col::Integer)
    p = BitVector(undef,size(puzzle.grid)[1])
    p .= true
    puzzle.grid[row,col] = PuzzleEntry(p)
    return nothing
end

"""
    as_text(puzzle)

Return the contents of the puzzle as a grid of strings.

Known values are integers greater than 0.
Unknown values are 0.
"""
function as_text(puzzle::SolvablePuzzle)
    result = fill(" ",size(puzzle.grid)) # unknowns!
    for i = 1:length(puzzle.grid)
        value = get_value(puzzle.grid[i])
        if value != 0 # fill in the knowns
            result[i] = string(value)
        end
    end
    return result
end

"""
    as_values(puzzle)

Return the contents of the puzzle as a grid of integers.

Known values are integers greater than 0.
Unknown values are 0.
"""
function as_values(puzzle::SolvablePuzzle)
    result = Array{Integer}(undef, size(puzzle.grid)) # invalid data
    for i = 1:length(puzzle.grid)
        result[i] = get_value(puzzle.grid[i])
    end
    return result
end

"""
    as_possibilities(puzzle)

Return the contents of the puzzle as a grid of integers representing possible values.

Known values are have one value set to true at that values index.
Unknown values are have more than one bit set to true.
"""
function as_possibilities(puzzle::SolvablePuzzle)
    result = Array{UInt16}(undef, size(puzzle.grid)) # invalid data
    for i = 1:length(puzzle.grid)
        result[i] = puzzle.grid[i].possibilities
    end
    return result
end

"""
    uncertainty(puzzle)

Assess the degree of uncertainty in a SolvablePuzzle.

Zero uncertainty is associated with solved puzzles.
Unsolved puzzles have uncertainty greater than zero.
"""
function uncertainty(puzzle::SolvablePuzzle)
    result::Integer = 0
    rank = get_rank(puzzle.grid)
    rank_squared = rank*rank
    error_detected = false
    for i = 1:length(puzzle.grid)
        temp = BitVector(undef,rank_squared)
        temp.chunks[1] = puzzle.grid[i].possibilities # Convert int to BitVector
        possibility_count = sum(temp)
        error_detected = error_detected || (possibility_count == 0)
        if possibility_count > 1
            result += sum(temp)
        end
    end
    if error_detected
        throw(DomainError("Puzzle entry with zero valid possibilities detected."))
    end
    return result
end


using Hip
using Base.Test

using Compat, BenchmarkTools
const hippath = Pkg.dir("Hip") * "/src";
const lib_hip_jl = Libdl.dlopen(hippath * "/hip_jl.so")

# write your own tests here
const N = 4096
a = randn(Float32, N, N);
b = randn(Float32, N, N);
c = zeros(a);

ah = HipArray(a);
bh = HipArray(b);
#ch = HipArray(c);
cht = HipArray(c);

tilesgemm!(cht, 1f0, ah, bh, 0f0)
A_mul_B!(c, a, b)
synchronize()
cres = Array(cht)

chh = HipArray(c);
sgemm!(chh, 1f0, ah, bh, 0f0)
synchronize()
cres2 = Array(chh)

free!(ah)
free!(bh)
free!(cht)
N2 = 32
a = randn(Float32, N2, N2);
b = randn(Float32, N2, N2);
c = zeros(a);
ah = HipArray(a);
bh = HipArray(b);
ch = HipArray(c);
tilesgemm!(ch, 1f0, ah, bh, 0f0)
A_mul_B!(c, a, b)
synchronize(); Array(ch)

A_mul_Bt!(c, a, b)
At_mul_B!(c, a, b)
At_mul_Bt!(c, a, b)
Array(ch)

function set_ab!(a, b, ia = 0.25f0, ja = 1f0, ib = 0.5f0, jb = 2f0)
    for i in 1:32
        for j in 1:32
            a[j,i] = ia*i + ja*j
            b[j,i] = ib*i + jb*j
        end
    end
end
free!(ah)
free!(bh)
ah = HipArray(a);
bh = HipArray(b);
tilesgemm!(ch, 1f0, ah, bh, 0f0)
A_mul_B!(c, a, b)
copy!(cha, ch); cha

chn = HipArray(c);
naivesgemm!(chn, 1f0, ah, bh, 0f0)

chh = HipArray(c);
sgemm!(chh, 1f0, ah, bh, 0f0)

function sync_func(f, c, alpha, a, b, beta)
    f(c, alpha, a, b, beta)
    synchronize()
end

copy!(cres, chn); cres
copy!(cres, chh); cres

@benchmark A_mul_B!($c, $a, $b)
@benchmark sync_func($naivesgemm!, $cht, 1f0, $ah, $bh, 0f0)
@benchmark sync_func($tilesgemm!, $cht, 1f0, $ah, $bh, 0f0)
@benchmark sync_func($sgemm!, $chh, 1f0, $ah, $bh, 0f0)

const THREADS_PER_BLOCK_X = 32
const THREADS_PER_BLOCK_Y = 32
const hipBlockDim_x = 32
const hipBlockDim_y = 32
const hipBlockIdx_x = 0
const hipBlockIdx_y = 0

function run_kern!(c, alpha, a, b, beta)

    M, K = size(a)
    N = size(b,2)

    c .*= beta

    num_tiles = div(K,THREADS_PER_BLOCK_X);

    tileA = Vector{Float32}(THREADS_PER_BLOCK_X * THREADS_PER_BLOCK_Y)
    tileB = Vector{Float32}(THREADS_PER_BLOCK_X * THREADS_PER_BLOCK_Y)
    for t in 0:num_tiles-1

        for i in 0:THREADS_PER_BLOCK_X-1, j in 0:THREADS_PER_BLOCK_Y-1
            kern_shared!(tileA, tileB, i, j, t, M, K, a, b)
        end
        for i in 0:THREADS_PER_BLOCK_X-1, j in 0:THREADS_PER_BLOCK_Y-1
            kern_tile!(c, a, b, i, j, alpha, tileA, tileB, M)
        end

    end
    c, tileA, tileB
end
function kern_shared!(tileA, tileB, hipThreadIdx_x, hipThreadIdx_y, t, M, K, A, B)
    idx_x = hipBlockIdx_x * hipBlockDim_x + hipThreadIdx_x;
    idx_y = hipBlockIdx_y * hipBlockDim_y + hipThreadIdx_y;

    id_local = hipThreadIdx_y + THREADS_PER_BLOCK_Y * hipThreadIdx_x;
    id_localT = hipThreadIdx_x + THREADS_PER_BLOCK_X * hipThreadIdx_y;

    t_col = t*THREADS_PER_BLOCK_X;
    tileA[id_localT+1] = A[(t_col + hipThreadIdx_x)*M + idx_y+1];
    tileB[id_local+1] = B[t_col + hipThreadIdx_y + K*idx_x+1];
end

function kern_tile!(C, A, B, hipThreadIdx_x, hipThreadIdx_y, alpha, tileA, tileB, M)

    idx_x = hipBlockIdx_x * hipBlockDim_x + hipThreadIdx_x;
    idx_y = hipBlockIdx_y * hipBlockDim_y + hipThreadIdx_y;

    myIdx = idx_y + idx_x * M;

    local_c = zero(eltype(C))

    idxA = hipThreadIdx_y * THREADS_PER_BLOCK_X ;
    idxB = hipThreadIdx_x * THREADS_PER_BLOCK_X ;

    for k in 0:THREADS_PER_BLOCK_X-1
        local_c += tileA[k + idxA+1] * tileB[k + idxB+1];
    end

    C[myIdx+1] += alpha * local_c;
end