include("operators.jl")

function calcforces(rvecs,charges,ρ,grid;rmax=grid.dx*norm(grid.sz))
    name = :inverse_squared_field
    rmin=2grid.dx
    efield_op = LinearOperator(name; dx,rmin, rmax)
    efield =efield_op(ρ)
hcat([charge*get(efield,grid,rvec) for (charge,rvec) in zip(charges,eachcol(rvecs))]...)
end
function calcfield(name,ρ,grid;rmax=grid.dx*norm(grid.sz))
@unpack dx=grid
    op = LinearOperator(name; dx, rmax)
    op(ρ)
end

function prep(positions, charges, grid)
    ρp = zeros(grid.sz..., 1)
    put_point_source!(
        ρp,
        grid,
        positions,
        reshape(charges, (1, length(charges))),
    )
    ψ=calcfield(:potential,ρp,grid)
    E=calcfield("inverse_squared_field",ρp,grid)
ρp,ψ,E
end
function predict_density(positions, charges, grid)
    ρp,ψ,E
    electronic_density = f(ρp)
    @assert sum(charges) ≈
            sum(electronic_density) * dV ≈
            sum(ρp) * dV
    electronic_density, ρp
end


abstract type DispersionFormula end

getindex(d::DispersionFormula, i) = getindex(d.coefs, i)

struct Sellmeier{N} <: DispersionFormula
    coefs::NTuple{N,Float64}
end

function (c::Sellmeier{N})(λ) where {N}
    rhs = c[1]
    for i = 2:2:N
        rhs += c[i]*λ^2 / (λ^2 - c[i+1]^2)
    end
    return sqrt(rhs + 1)
end

struct Sellmeier2{N} <: DispersionFormula
    coefs::NTuple{N,Float64}
end

function (c::Sellmeier2{N})(λ) where {N}
    rhs = c[1]
    for i = 2:2:N
        rhs += c[i]*λ^2 / (λ^2 - c[i+1])
    end
    return sqrt(rhs + 1)
end

struct Polynomial{N} <: DispersionFormula
    coefs::NTuple{N,Float64}
end

function (c::Polynomial{N})(λ) where {N}
    rhs = c[1]
    for i = 2:2:N
        rhs += c[i]*λ^c[i+1]
    end
    return sqrt(rhs)
end

struct RIInfo{N} <: DispersionFormula
    coefs::NTuple{N,Float64}
end

function (c::RIInfo{N})(λ) where {N}
    rhs = c[1]
    for i = 2:4:min(N, 9)
        rhs += (c[i]*λ^c[i+1]) / (λ^2 - c[i+2]^c[i+3])
    end
    for i = 10:2:N
        rhs += c[i]*λ^c[i+1]
    end
    return sqrt(rhs)
end

struct Cauchy{N} <: DispersionFormula
    coefs::NTuple{N,Float64}
end

function (c::Cauchy{N})(λ) where {N}
    rhs = c[1]
    for i = 2:2:N
        rhs += c[i]*λ^c[i+1]
    end
    return rhs
end

struct Gases{N} <: DispersionFormula
    coefs::NTuple{N,Float64}
end

function (c::Gases{N})(λ) where {N}
    rhs = c[1]
    for i = 2:2:N
        rhs += c[i] / (c[i+1] - 1/λ^2)
    end
    return rhs + 1
end

struct Herzberger{N} <: DispersionFormula
    coefs::NTuple{N,Float64}
end

function (c::Herzberger{N})(λ) where {N}
    rhs = c[1]
    rhs += c[2] / (λ^2 - 0.028)
    rhs += c[3] * (1/(λ^2 - 0.028))^2
    for i = 4:N
        pow = 2*(i - 3)
        rhs += c[i]*λ^pow
    end
    return rhs
end

struct Retro{N} <: DispersionFormula
    coefs::NTuple{N,Float64}
end

function (c::Retro{N})(λ) where {N}
    rhs = c[1] + c[2]*λ^2 / (λ^2 - c[3]) + c[4]*λ^2
    return sqrt((-2rhs - 1) / (rhs - 1))
end

struct Exotic{N} <: DispersionFormula
    coefs::NTuple{N,Float64}
end

function (c::Exotic{N})(λ) where {N}
    rhs = c[1] + c[2]/(λ^2 - c[3]) + c[4]*(λ - c[5]) / ((λ - c[5])^2 + c[6])
    return sqrt(rhs)
end

abstract type Tabulated <: DispersionFormula end

const ITP_TYPE = typeof(LinearInterpolation(sort(rand(2)), zeros(2)))

struct TabulatedNK <: Tabulated
    n::ITP_TYPE
    k::ITP_TYPE
end

function TabulatedNK(raw::Matrix{Float64})
    λ = raw[:, 1]
    n = raw[:, 2]
    k = raw[:, 3]
    TabulatedNK(LinearInterpolation(λ, n), LinearInterpolation(λ, k))
end

struct TabulatedN <: Tabulated
    n::ITP_TYPE
end

function TabulatedN(raw::Matrix{Float64})
    λ = raw[:, 1]
    n = raw[:, 2]
    TabulatedN(LinearInterpolation(λ, n))
end

struct TabulatedK <: Tabulated
    k::ITP_TYPE
end

function TabulatedK(raw::Matrix{Float64})
    λ = raw[:, 1]
    k = raw[:, 2]
    TabulatedK(LinearInterpolation(λ, k))
end


using SAIMFitKit

#-------------- OPTICAL PARAMETERS----------------------

opt = SAIMOptics()
opt.nB = 1.33;	                    #The refractive index of the ambient buffer / cytoplasm
opt.dOx = 1924.9;	                #The thickness of the SiO2 layer in units of nm
opt.λ_Ex_1 = 642.0;		        	#The wavelength of the microscope excitation laser #1 in units of nm
opt.nOx_1 = 1.4719;		            #The refractive index of SiO2
opt.nSi_1 = 3.8660 + 0.017933im;    #The complex refractive index of Si

#-------------- FIT PARAMETERS----------------------
p0 = [0.5, 1.0, 75.0]		    #Initial guesses for parameters [A, B, H]
lb = [0.0, 0.0, 0.0]			#Lower bounds for [A, B, H]
ub = [10000., 10000., 200.]		#Upper bounds for [A, B, H]

#-------------- IMAGE STACKS ---------------------
angles = range(5.0, length=32, stop=43.75)	    #Incidece angle in degrees for each image frame
files = ["21TR_5c"]                             #Names of image stacks; multiple experiments can be listed to run in batch
path = "C:\\Users\\matth\\.julia\\dev\\SAIMFitKit\\example\\TestImages" #Path to image files

#-------------- CONDUCT FITS ---------------------
for f in files
    fit_SAIM(path, f, opt, angles, p0, lb, ub, glb=true, step=40.0, show=true)
end


using Gen
import Random

#########
# model #
#########

@gen function datum(x::Float64, @ad(inlier_std), @ad(outlier_std), @ad(slope), @ad(intercept))
    is_outlier = @addr(bernoulli(0.5), :z)
    std = is_outlier ? inlier_std : outlier_std
    y = @addr(normal(x * slope + intercept, std), :y)
    return y
end

data = plate(datum)

@gen function model(xs::Vector{Float64})
    n = length(xs)
    inlier_std = exp(@addr(normal(0, 2), :inlier_std))
    outlier_std = exp(@addr(normal(0, 2), :outlier_std))
    slope = @addr(normal(0, 2), :slope)
    intercept = @addr(normal(0, 2), :intercept)
    if all([@change(addr) == NoChange() for addr in [:slope, :intercept, :inlier_std, :outlier_std]])
        change = NoChange()
    else
        change = nothing
    end
    ys = @addr(data(xs, fill(inlier_std, n), fill(outlier_std, n), fill(slope, n), fill(intercept, n)), :data, change)
    return ys
end

#######################
# inference operators #
#######################

@gen function is_outlier_proposal(prev, i::Int)
    prev_z = get_assignment(prev)[:data => i => :z]
    @addr(bernoulli(prev_z ? 0.0 : 1.0), :data => i => :z)
end

@gen function observer(ys::Vector{Float64})
    for (i, y) in enumerate(ys)
        @addr(dirac(y), :data => i => :y)
    end
end

Gen.load_generated_functions()

#####################
# generate data set #
#####################

Random.seed!(1)

prob_outlier = 0.5
true_inlier_noise = 0.5
true_outlier_noise = 5.0
true_slope = -1
true_intercept = 2
xs = collect(range(-5, stop=5, length=200))
ys = Float64[]
for (i, x) in enumerate(xs)
    if rand() < prob_outlier
        y = true_slope * x + true_intercept + randn() * true_inlier_noise
    else
        y = true_slope * x + true_intercept + randn() * true_outlier_noise
    end
    push!(ys, y)
end

##################
# run experiment #
##################

selection = DynamicAddressSet()
push_leaf_node!(selection, :slope)
push_leaf_node!(selection, :intercept)
push_leaf_node!(selection, :inlier_std)
push_leaf_node!(selection, :outlier_std)

function do_inference(n)
    observations = get_assignment(simulate(observer, (ys,)))

    # initial trace
    (trace, _) = generate(model, (xs,), observations)

    for i=1:n
        trace = mala(model, selection, trace, 0.0001)
        trace = hmc(model, selection, trace)

        # step on the outliers
        for j=1:length(xs)
            trace = mh(model, is_outlier_proposal, (j,), trace)
        end

        score = get_call_record(trace).score

        # print
        assignment = get_assignment(trace)
        slope = assignment[:slope]
        intercept = assignment[:intercept]
        inlier_std = assignment[:inlier_std]
        outlier_std = assignment[:outlier_std]
        println("score: $score, slope: $slope, intercept: $intercept, inlier_std: $inlier_std, outlier_std: $outlier_std")
    end
end

@time do_inference(1000)
@time do_inference(100)


module Braking
    export dist, speed

    const EARTH_GRAVITY = 9.81

    function dist(v::Number, μ::Number)::Real
        # convert from km/h to m/s
        v /= 3.6
        # Reaction time: 1
        v + v^2/2/μ/EARTH_GRAVITY
    end

    # Reaction time: 1
    function speed(d::Number, μ::Number)::Real
        μg = μ * EARTH_GRAVITY
        v = sqrt( μg^2 + 2d*μg ) - μg
        # Convert m/s in km/h
        3.6v
    end
end


using Test

using CompScienceMeshes
using BEAST
using StaticArrays
using LinearAlgebra

c = 3e8
μ = 4*π*1e-7
ε = 1/(μ*c^2)
f = 5e7
λ = c/f
k = 2*π/λ
ω = k*c
η = sqrt(μ/ε)

a = 1
Γ_orig = CompScienceMeshes.meshcuboid(a,a,a,0.1)
Γ = translate(Γ_orig,SVector(-a/2,-a/2,-a/2))

Φ, Θ = [0.0], range(0,stop=π,length=100)
pts = [point(cos(ϕ)*sin(θ), sin(ϕ)*sin(θ), cos(θ)) for ϕ in Φ for θ in Θ]

# This is an electric dipole
# The pre-factor (1/ε) is used to resemble
# (9.18) in Jackson's Classical Electrodynamics
E = (1/ε) * dipolemw3d(location=SVector(0.4,0.2,0),
                       orientation=1e-9.*SVector(0.5,0.5,0),
                       wavenumber=k)

n = BEAST.NormalVector()

𝒆 = (n × E) × n
H = (-1/(im*μ*ω))*curl(E)
𝒉 = (n × H) × n

𝓣 = Maxwell3D.singlelayer(wavenumber=k)
𝓝 = BEAST.NCross()
𝓚 = Maxwell3D.doublelayer(wavenumber=k)

X = raviartthomas(Γ)
Y = buffachristiansen(Γ)

T = Matrix(assemble(𝓣,X,X))
e = Vector(assemble(𝒆,X))
j_EFIE = T\e

nf_E_EFIE = potential(MWSingleLayerField3D(wavenumber=k), pts, j_EFIE, X)
nf_H_EFIE = potential(BEAST.MWDoubleLayerField3D(wavenumber=k), pts, j_EFIE, X) ./ η
ff_E_EFIE = potential(MWFarField3D(wavenumber=k), pts, j_EFIE, X)

@test norm(nf_E_EFIE - E.(pts))/norm(E.(pts)) ≈ 0 atol=0.01
@test norm(nf_H_EFIE - H.(pts))/norm(H.(pts)) ≈ 0 atol=0.01
@test norm(ff_E_EFIE - E.(pts, isfarfield=true))/norm(E.(pts, isfarfield=true)) ≈ 0 atol=0.001

K_bc = Matrix(assemble(𝓚,Y,X))
G_nxbc_rt = Matrix(assemble(𝓝,Y,X))
h_bc = η*Vector(assemble(𝒉,Y))
M_bc = -0.5*G_nxbc_rt + K_bc
j_BCMFIE = M_bc\h_bc

nf_E_BCMFIE = potential(MWSingleLayerField3D(wavenumber=k), pts, j_BCMFIE, X)
nf_H_BCMFIE = potential(BEAST.MWDoubleLayerField3D(wavenumber=k), pts, j_BCMFIE, X) ./ η
ff_E_BCMFIE = potential(MWFarField3D(wavenumber=k), pts, j_BCMFIE, X)

@test norm(nf_E_BCMFIE - E.(pts))/norm(E.(pts)) ≈ 0 atol=0.01
@test norm(nf_H_BCMFIE - H.(pts))/norm(H.(pts)) ≈ 0 atol=0.01
@test norm(ff_E_BCMFIE - E.(pts, isfarfield=true))/norm(E.(pts, isfarfield=true)) ≈ 0 atol=0.01

H = dipolemw3d(location=SVector(0.0,0.0,0.3),
               orientation=1e-9.*SVector(0.5,0.5,0),
               wavenumber=k)

𝒉 = (n × H) × n
E = (1/(im*ε*ω))*curl(H)
𝒆 = (n × E) × n

X = raviartthomas(Γ)
Y = buffachristiansen(Γ)

T = Matrix(assemble(𝓣,X,X))
e = Vector(assemble(𝒆,X))
j_EFIE = T\e

nf_E_EFIE = potential(MWSingleLayerField3D(wavenumber=k), pts, j_EFIE, X)
nf_H_EFIE = potential(BEAST.MWDoubleLayerField3D(wavenumber=k), pts, j_EFIE, X) ./ η
ff_E_EFIE = potential(MWFarField3D(wavenumber=k), pts, j_EFIE, X)

@test norm(nf_E_EFIE - E.(pts))/norm(E.(pts)) ≈ 0 atol=0.01
@test norm(nf_H_EFIE - H.(pts))/norm(H.(pts)) ≈ 0 atol=0.01
@test norm(ff_E_EFIE - E.(pts, isfarfield=true))/norm(E.(pts, isfarfield=true)) ≈ 0 atol=0.01

K_bc = Matrix(assemble(𝓚,Y,X))
G_nxbc_rt = Matrix(assemble(𝓝,Y,X))
h_bc = η*Vector(assemble(𝒉,Y))
M_bc = -0.5*G_nxbc_rt + K_bc
j_BCMFIE = M_bc\h_bc

nf_E_BCMFIE = potential(MWSingleLayerField3D(wavenumber=k), pts, j_BCMFIE, X)
nf_H_BCMFIE = potential(BEAST.MWDoubleLayerField3D(wavenumber=k), pts, j_BCMFIE, X) ./ η
ff_E_BCMFIE = potential(MWFarField3D(wavenumber=k), pts, j_BCMFIE, X)

@test norm(j_BCMFIE - j_EFIE)/norm(j_EFIE) ≈ 0 atol=0.02
@test norm(nf_E_BCMFIE - E.(pts))/norm(E.(pts)) ≈ 0 atol=0.01
@test norm(nf_H_BCMFIE - H.(pts))/norm(H.(pts)) ≈ 0 atol=0.01
@test norm(ff_E_BCMFIE - E.(pts, isfarfield=true))/norm(E.(pts, isfarfield=true)) ≈ 0 atol=0.01


using DitherPunk

A = [1 2; 3 4]

@test upscale(A, 3) == [
    1 1 1 2 2 2
    1 1 1 2 2 2
    1 1 1 2 2 2
    3 3 3 4 4 4
    3 3 3 4 4 4
    3 3 3 4 4 4
]


export PermGroup, perm, parity, elements, cycles, character, setpermstyle,
       order

###############################################################################
#
#   Type and parent object methods
#
###############################################################################

parent_type(::Type{perm}) = PermGroup

elem_type(::Type{PermGroup}) = perm

###############################################################################
#
#   Basic manipulation
#
###############################################################################

doc"""
    parent(a::perm)
> Return the parent of the given permutation group element.
"""
parent(a::perm) = a.parent

function deepcopy_internal(a::perm, dict::ObjectIdDict)
   G = parent(a)
   return G(deepcopy(a.d))
end

function Base.hash(a::perm, h::UInt)
   b = 0x595dee0e71d271d0%UInt
   for i in 1:length(a.d)
      b = xor(b, xor(hash(a[i], h), h))
      b = (b << 1) | (b >> (sizeof(Int)*8 - 1))
   end
   return b
end

doc"""
    parity(a::perm)
> Return the parity of the given permutation, i.e. the parity of the number of
> transpositions that compose it. The function returns $1$ if the parity is odd
> otherwise it returns $0$.
"""
# TODO: 2x slower than Flint
function parity(a::perm)
   to_visit = trues(a.d)
   parity = length(to_visit)
   k = 1
   while any(to_visit)
      parity -= 1
      k = findnext(to_visit, k)
      to_visit[k] = false
      next = a[k]
      while next != k
         to_visit[next] = false
         next = a[next]
      end
   end
   return parity%2
end

doc"""
    sign(a::perm)
> Returns the sign of the given permutations, i.e. `1` if `a` is even and `-1`
> if `a` is odd.
"""
sign(a::perm) = (-1)^parity(a)

function getindex(a::perm, n::Int)
   return a.d[n]
end

function setindex!(a::perm, d::Int, n::Int)
   a.d[n] = d
end

doc"""
    eye(G::PermGroup)
> Return the identity permutation for the given permutation group.
"""
eye(G::PermGroup) = G()

###############################################################################
#
#   String I/O
#
###############################################################################

function show(io::IO, G::PermGroup)
   print(io, "Permutation group over $(G.n) elements")
end

mutable struct PermDisplayStyle
   format::Symbol
end

const perm_display_style = PermDisplayStyle(:array)

doc"""
    setpermstyle(format::Symbol)
> Nemo can display (in REPL or in general as string) permutations by either
> array of integers whose `n`-th position represents value at `n`, or as
> (an array of) disjoint cycles, where the value of permutation at `n` is
> represented as the entry immediately following `n` in the cycle.
> The style can be switched by calling `setpermstyle` with `:array` or
> `:cycles` argument.
"""
function setpermstyle(format::Symbol)
   format in (:array, :cycles) || throw("Permutations can be displayed
   only as :array or :cycles.")
   perm_display_style.format = format
   return format
end

function show(io::IO, a::perm)
   if perm_display_style.format == :array
      print(io, "[" * join(a.d, ", ") * "]")
   elseif perm_display_style.format == :cycles
      if a == parent(a)()
         print(io, "()")
      else
         print(io, join(["("*join(c, ",")*")" for c in cycles(a) if
            length(c)>1],""))
      end
   end
end

###############################################################################
#
#   Comparison
#
###############################################################################

doc"""
    ==(a::perm, b::perm)
> Return `true` if the given permutations are equal, otherwise return `false`.
"""
function ==(a::perm, b::perm)
   parent(a) == parent(b) || return false
   a.d == b.d || return false
   return true
end

###############################################################################
#
#   Binary operators
#
###############################################################################

doc"""
    *(a::perm, b::perm)
> Return the composition of the two permutations, i.e. $a\circ b$. In other
> words, the permutation corresponding to applying $b$ first, then $a$, is
> returned.
"""
function *(a::perm, b::perm)
   d = similar(a.d)
   for i in 1:length(d)
      d[i] = a[b[i]]
   end
   return parent(a)(d, false)
end

doc"""
    ^(a::perm, n::Int)
> Return the `n`-th power of a permutation `a`. By default Nemo computes powers
> by cycle decomposition of `a`. `Nemo.power_by_squaring` provides a different
> method for powering which may or may not be faster, depending on the
> particuar case. Due to caching of cycle structure repeatedly powering should
> be faster with the default method. NOTE: cycle structure is not computed
> for `n<4`.
"""
function ^(a::perm, n::Int)
   if n <0
      return inv(a)^-n
   elseif n == 0
      return parent(a)()
   elseif n == 1
      return deepcopy(a)
   elseif n == 2
      return parent(a)(a.d[a.d])
   elseif n == 3
      return parent(a)(a.d[a.d[a.d]])
   else
      new_perm = similar(a.d)
      cyls = cycles(a)
      for cycle in cyls
         k = n % length(cycle)
         shifted = circshift(cycle, -k)
         for (idx,j) in enumerate(cycle)
            new_perm[j] = shifted[idx]
         end
      end
      return parent(a)(new_perm, false)
   end
end

function power_by_squaring(a::perm, b::Int)
   if n <0
      return inv(a)^-n
   elseif n == 0
      return parent(a)()
   elseif n == 1
      return deepcopy(a)
   elseif n == 2
      return parent(a)(a.d[a.d])
   elseif n == 3
      return parent(a)(a.d[a.d[a.d]])
   else
      bit = ~((~UInt(0)) >> 1)
      while (UInt(bit) & b) == 0
         bit >>= 1
      end
      cache1 = deepcopy(a.d)
      cache2 = deepcopy(a.d)
      bit >>= 1
      while bit != 0
         cache2 = cache1[cache1]
         cache1 = cache2
         if (UInt(bit) & b) != 0
            cache1 = cache1[a.d]
         end
         bit >>= 1
      end
      return parent(a)(cache1, false)
   end
end

###############################################################################
#
#   Inversion
#
###############################################################################

doc"""
    inv(a::perm)
> Return the inverse of the given permutation, i.e. the permuation $a^{-1}$
> such that $a\circ a^{-1} = a^{-1}\circ a$ is the identity permutation.
"""
function inv(a::perm)
   d = similar(a.d)
   for i in 1:length(a.d)
      d[a[i]] = i
   end
   G = parent(a)
   return G(d, false)
end

# TODO: can we do that in place??
function inv!(a::perm)
   d = similar(a.d)
   for i in 1:length(a.d)
      d[a[i]] = i
   end
   a.d = d
end

###############################################################################
#
#   Iterating over all permutations
#
###############################################################################

Base.start(A::AllPerms) = (collect(1:A.n), 1, 1, ones(Int, A.n))
Base.next(A::AllPerms, state) = all_perms(state...)
Base.done(A::AllPerms, state) = state[2] > A.all
Base.eltype(::Type{AllPerms}) = Vector{Int}
length(A::AllPerms) = A.all

function all_perms(elts, counter, i, c)
   if counter == 1
      return (copy(elts), (elts, counter+1, i, c))
   end
   n = length(elts)
   while i <= n
      if c[i] < i
         if isodd(i)
            elts[1], elts[i] = elts[i], elts[1]
         else
            elts[c[i]], elts[i] = elts[i], elts[c[i]]
         end
         c[i] += 1
         i = 1
         return (copy(elts), (elts, counter+1, i, c))
      else
         c[i] = 1
         i += 1
      end
   end
end

doc"""
    elements(G::PermGroup)
> Returns an iterator over all elements in the group $G$. You may use
> `collect(elements(G))` to get an array of all elements.
"""
elements(G::PermGroup) = (G(p, false) for p in AllPerms(G.n))

###############################################################################
#
#   Misc
#
###############################################################################

doc"""
    order(G::PermGroup)
> Returns the order of the full permutation group.
"""
order(G::PermGroup) = factorial(G.n)

doc"""
    cycles(a::perm)
> Decomposes permutation into disjoint cycles.
"""
function cycles(a::perm)
   if isdefined(a, :cycles)
      return a.cycles
   else
      to_visit = trues(a.d)
      cycles = Vector{Vector{Int}}()
      k = 1
      while any(to_visit)
         cycle = Vector{Int}()
         k = findnext(to_visit, k)
         to_visit[k] = false
         push!(cycle, k)
         next = a[k]
         while next != k
            push!(cycle, next)
            to_visit[next] = false
            next = a[next]
         end
         push!(cycles, cycle)
      end
      a.cycles = cycles
      return cycles
   end
end

doc"""
    order(a::perm)
> Returns the order of permutation `a`.
"""
order(a::perm) = lcm([length(c) for c in cycles(a)])

doc"""
    permtype(a::perm, rev=true)
> Returns the type of permutation `a`, i.e. lengths of disjoint cycles building
> `a`. This fully determines the conjugacy class of `a`. The lengths are sorted
> in reverse order by default.
"""
permtype(a::perm) = sort([length(c) for c in cycles(a)], rev=true)

doc"""
    matrix_repr(a::perm)
> Return the permutation matrix representing `a` via natural embedding of the
> permutation group into general linear group over ZZ
"""
function matrix_repr(a::perm)
   A = eye(Int, parent(a).n)
   return A[a.d,:]
end

doc"""
    emb!(result::perm, p::perm, V::Vector{Int})
> Embedds permutation `p` into `result` on the indices given by `V`. This
> corresponds to natural embedding of $S_k$ into $S_n$ as the subgroup
> permuting points indexed by `V`.
"""
function emb!(result::perm, p::perm, V::Vector{Int})
    result.d[V] = (result.d[V])[p.d]
    return result
end

doc"""
    emb(G::PermGroup, V::Vector{Int})
> Returns the natural embedding of a permutation group into `G` as the
> subgroup permuting points indexed by `V`.
"""
function emb(G::PermGroup, V::Vector{Int}, check::Bool=true)
   if check
      @assert length(Base.Set(V)) == length(V)
      @assert all(V .<= G.n)
   end
   return p -> Nemo.emb!(G(), p, V)
end

doc"""
    rand(G::PermGroup)
> Returns a random element from group `G`.
"""
rand(G::PermGroup) = G(randperm(G.n), false)

###############################################################################
#
#   Parent object call overloads
#
###############################################################################

function (G::PermGroup)()
   z = perm(G.n)
   z.parent = G
   return z
end

function (G::PermGroup)(a::Array{Int, 1}, check::Bool=true)
   length(a) != G.n && error("Unable to coerce to permutation: lengths differ")
   if check
      Base.Set(a) != Base.Set(1:length(a)) && error("Unable to coerce to
         permutation: non-unique elements in array")
   end
   z = perm(a)
   z.parent = G
   return z
end

function (G::PermGroup)(a::perm)
   parent(a) != G && error("Unable to coerce to permutation: wrong parent")
   return a
end

###############################################################################
#
#   PermGroup constructor
#
###############################################################################

# handled by inner constructors

##############################################################################
#
#   Irreducible Characters
#
##############################################################################

doc"""
    character(lambda::Partition)
> Returns the $\lambda$-th irreducible character of permutation group on
> `lambda.n` generators. The returned character function
>     `chi(p::perm, check::Bool=true)`
> can be evaluated on a permutation `p::perm`. Checking in $\chi$ if `p`
> belongs to the appropriate group can be switched off by calling
> `chi(p, false)`. The values computed by $\chi$ are stored in look-up table.
>
> The computation follows the Murnaghan-Nakayama formula:
> $$\chi_\lambda(\sigma) = \sum_{\text{rimhook }\xi\subset \lambda}
(-1)^{ll(\lambda\backslash\xi)} \chi_{\lambda \backslash\xi}(\tilde\sigma)$$
> where $\lambda\backslash\xi$ denotes partition associated with Young Diagram
> of $\lambda$ with $\xi$ removed, $ll$ denotes the leg-length (i.e. number of
> rows - 1) and $\tilde\sigma$ is permutation obtained from $\sigma$ by the
> removal of the longest cycle.
>
> For more details see e.g. Chapter 2.8 of _Group Theory and Physics_ by
> S.Sternberg.
"""
function character(lambda::Partition)
   R = partitionseq(lambda)

   function char(p::perm, check::Bool=true)
      if check
         lambda.n == length(p.d) || throw("Can't evaluate character on $p : lengths differ.")
      end
      return MN1inner(R, Partition(permtype(p)), 1, _charvalsTable)
   end

   return char
end

doc"""
    character(lambda::Partition, p::perm, check::Bool=true)
> Returns the value of `lambda`-th irreducible character on permutation `p`.
"""
function character(lambda::Partition, p::perm, check::Bool=true)
   if check
      lambda.n == length(p.d) || throw("lambda-th irreducible character can be evaluated only on permutations of length $(lambda.n).")
   end

   return MN1inner(partitionseq(lambda), Partition(permtype(p)), 1, _charvalsTable)
end

doc"""
    character(lambda::Partition, mu::Partition)
> Returns the value of `lambda-th` irreducible character on the conjugacy class
> represented by partition `mu`. Values of characters computed by this method
> are not cached _globally_.
"""
character(lambda::Partition, mu::Partition) = MN1inner(partitionseq(lambda), mu, 1)


mutable struct WordVectors{S<:AbstractString, T<:Real, H<:Integer}
    vocab::Vector{S} # vocabulary
    vectors::Array{T, 2} # the vectors computed from word2vec
    vocab_hash::Dict{S, H}
end

function WordVectors(vocab::AbstractArray{S,1},
                     vectors::AbstractArray{T,2}) where {S<: AbstractString, T<:Real}
    length(vocab) == size(vectors, 2) ||
        throw(DimensionMismatch("Dimension of vocab and vectors are inconsistent."))
    vocab_hash = Dict{S, Int}()
    for (i, word) in enumerate(vocab)
        vocab_hash[word] = i
    end
    WordVectors(vocab, vectors, vocab_hash)
end

function Base.show(io::IO, wv::WordVectors{S,T}) where {S,T}
    len_vecs, num_words = size(wv.vectors)
    print(io, "WordVectors $(num_words) words, $(len_vecs)-element $(T) vectors")
end

"""
    vocabulary(wv)

Return the vocabulary as a vector of words of the WordVectors `wv`.
"""
vocabulary(wv::WordVectors) = wv.vocab

"""
    in_vocabulary(wv, word)

Return `true` if `word` is part of the vocabulary of the WordVector `wv` and
`false` otherwise.
"""
in_vocabulary(wv::WordVectors, word::AbstractString) = word in wv.vocab

"""
    size(wv)

Return the word vector length and the number of words as a tuple.
"""
size(wv::WordVectors) = size(wv.vectors)

"""
    index(wv, word)

Return the index of `word` from the WordVectors `wv`.
"""
index(wv::WordVectors, word) = wv.vocab_hash[word]

"""
    get_vector(wv, word)

Return the vector representation of `word` from the WordVectors `wv`.
"""
get_vector(wv::WordVectors, word) =
      (idx = wv.vocab_hash[word]; wv.vectors[:,idx])

"""
    cosine(wv, word, n=10)

Return the position of `n` (by default `n = 10`) neighbors of `word` and their
cosine similarities.
"""
function cosine(wv::WordVectors, word, n=10)
    metrics = wv.vectors'*get_vector(wv, word)
    topn_positions = sortperm(metrics[:], rev = true)[1:n]
    topn_metrics = metrics[topn_positions]
    return topn_positions, topn_metrics
end

"""
    similarity(wv, word1, word2)

Return the cosine similarity value between two words `word1` and `word2`.
"""
function similarity(wv::WordVectors, word1, word2)
    return get_vector(wv, word1)'*get_vector(wv, word2)
end

"""
    cosine_similar_words(wv, word, n=10)

Return the top `n` (by default `n = 10`) most similar words to `word`
from the WordVectors `wv`.
"""
function cosine_similar_words(wv::WordVectors, word, n=10)
    indx, metr = cosine(wv, word, n)
    return vocabulary(wv)[indx]
end

"""
    analogy(wv, pos, neg, n=5)

Compute the analogy similarity between two lists of words. The positions
and the similarity values of the top `n` similar words will be returned.
For example,
`king - man + woman = queen` will be
`pos=[\"king\", \"woman\"], neg=[\"man\"]`.
"""
function analogy(wv::WordVectors{S,T,H}, pos::AbstractArray, neg::AbstractArray, n= 5
                ) where {S<:AbstractString, T<:Real, H<:Integer}
    m, n_vocab = size(wv)
    n_pos = length(pos)
    n_neg = length(neg)
    anal_vecs = Matrix{T}(undef, m, n_pos + n_neg)

    for (i, word) in enumerate(pos)
        anal_vecs[:,i] = get_vector(wv, word)
    end
    for (i, word) in enumerate(neg)
        anal_vecs[:,i+n_pos] = -get_vector(wv, word)
    end
    mean_vec = mean(anal_vecs, dims=2)
    metrics = wv.vectors'*mean_vec
    top_positions = sortperm(metrics[:], rev = true)[1:n+n_pos+n_neg]
    for word in [pos;neg]
        idx = index(wv, word)
        loc = findfirst(x->x==idx, top_positions)
        if loc != nothing
            splice!(top_positions, loc)
        end
    end
    topn_positions = top_positions[1:n]
    topn_metrics = metrics[topn_positions]
    return topn_positions, topn_metrics
end

"""
    analogy_words(wv, pos, neg, n=5)

Return the top `n` words computed by analogy similarity between
positive words `pos` and negaive words `neg`. from the WordVectors `wv`.
"""
function analogy_words(wv::WordVectors, pos, neg, n=5)
    indx, metr = analogy(wv, pos, neg, n)
    return vocabulary(wv)[indx]
end

"""
    wordvectors(filename [,type=Float64][; kind=:text, skip=false, normalize=true, fasttext=false])

Generate a WordVectors type object from a file.

# Arguments
  * `filename::AbstractString` the embeddings file name
  * `type::Type` type of the embedding vector elements; default `Float64`

# Keyword arguments
  * `kind::Symbol` specifies whether the embeddings file is textual (`:text`)
or binary (`:binary`); default `:text`
  * `skip::Bool` in binary embeddings files specifies whether the newline
byte is missing or not (use `true` for Google pre-trained models); default `false`
  * `normalize:Bool` specifies whether to normalize the embedding vectors
i.e. return unit vectors; default `true`
  * `delim:Char` delimiter; default `' '`
  * `fasttext::Bool` setting to `true` fixes a bug that occurs when loading
FastText generated text embeddings by not stripping the line before parsing.
The option is ignored for the binary format; default `false`
"""
function wordvectors(filename::AbstractString,
                     ::Type{T};
                     kind::Symbol=:text,
                     skip::Bool=false,
                     normalize::Bool=true,
                     delim::Char=' ',
                     fasttext::Bool=false) where T <: Real
    if kind == :binary
        return _from_binary(T, filename, skip, normalize, delim)
    elseif kind == :text
        return _from_text(T, filename, normalize, delim, fasttext)
    else
        throw(ArgumentError("Unknown embedding file kind $(kind)"))
    end
end

wordvectors(filename::AbstractString;
            kind::Symbol=:text,
            skip::Bool=false,
            normalize::Bool=true,
            delim::Char=' ',
            fasttext::Bool=false) =
    wordvectors(filename, Float64, kind=kind,
                normalize=normalize, delim=delim, fasttext=fasttext)

# Generate a WordVectors object from binary file
function _from_binary(::Type{T},
                      filename::AbstractString,
                      skip::Bool=true,
                      normalize::Bool=true,
                      delim::Char=' ') where T<:Real
    sb = ifelse(skip, 0, 1)
    open(filename) do f
        header = strip(readline(f))
        vocab_size,vector_size = map(x -> parse(Int, x), split(header, delim))
        vocab = Vector{String}(undef, vocab_size)
        vectors = zeros(T, vector_size, vocab_size)
        binary_length = sizeof(Float32) * vector_size
        for i in 1:vocab_size
            vocab[i] = strip(readuntil(f, delim))
            vector = reinterpret(Float32, read(f, binary_length))
            if normalize
                vector = vector ./ norm(vector)  # unit vector
            end
            vectors[:,i] = T.(vector)
            read(f, sb) # new line
        end
        return WordVectors(vocab, vectors)
    end
end

# Generate a WordVectors object from text file
function _from_text(::Type{T},
                    filename::AbstractString,
                    normalize::Bool=true,
                    delim::Char=' ',
                    fasttext::Bool=false) where T<:Real
    open(filename) do f
        header = strip(readline(f))
        vocab_size,vector_size = map(x -> parse(Int, x), split(header, delim))
        vocab = Vector{String}(undef, vocab_size)
        vectors = Matrix{T}(undef, vector_size, vocab_size)
        for (i, line) in enumerate(readlines(f))
            !fasttext && (line = strip(line))
            parts = split(line, delim)
            word = parts[1]
            vector = map(x-> parse(T, x), parts[2:end])
            vocab[i] = word
            if normalize
                vector = vector ./ norm(vector)  # unit vector
            end
            vectors[:, i] = vector
        end
       return WordVectors(vocab, vectors)
    end
end


using Poirot.Abstract, IRTools, Test
using Poirot.Abstract: Const, Partial, Inference, return_type, @trace, exprtype, returntype
using IRTools: var, returnvalue

ir = @code_ir identity(1)
@test return_type(ir, Nothing, Int) == Int

add(a, b) = a+b

ir = @code_ir add(1, 2)

@test return_type(ir, Nothing, Const(1.0), Const(2)) == Const(3.0)

@test return_type(ir, Nothing, Int, Const(2.0)) == Float64

g = 2
addg(x) = x+g
ir = @code_ir addg(2)
@test return_type(ir, Nothing, Const(2)) == Const(4)
@test return_type(ir, Nothing, Float64) == Float64

f() = rand() < 0.5 ? "foo" : "bar"

ir = @code_ir f()
@test return_type(ir, Nothing) == String

function pow(x, n)
  r = 1
  while n > 0
    n -= 1
    r *= x
  end
  return r
end

ir = @code_ir pow(2, 3)
@test return_type(ir, Nothing, Int64, Const(5)) == Int
@test return_type(ir, Nothing, Float64, Int) == Union{Float64, Int}
@test return_type(ir, Nothing, Float64, Const(5)) == Float64
@test return_type(ir, Nothing, Const(2), Const(3)) == Const(8)

foo(a, b) = a + b
bar(a, b) = foo(a, b)

ir = @code_ir bar(1, 1)
@test return_type(ir, Nothing, Int, Int) == Int

fact(n) = n == 0 ? 1 : n*fact(n-1)

ir = @code_ir fact(1)
@test return_type(ir, Nothing, Int) == Int

# Tracing

tr = @trace f()
@test returntype(tr) == String

tr = @trace pow(Int, 3)
@test length(tr.blocks) == 1
@test returntype(tr) == Int

tr = @trace pow(2, 3)
@test length(tr.blocks) == 1
@test returntype(tr) == Const(8)

tr = @trace pow(2, Int)
@test returntype(tr) == Int

tr = @trace pow(2.0, Int)
@test returntype(tr) == Union{Float64,Int}

tr = @trace pow(1, Int)
@test returntype(tr) == Const(1)

tr = @trace bar(Int, Int)
@test returntype(tr) == Int

function foo(x)
  r = Ref{Any}()
  r[] = x
  return r[]
end

tr = @trace foo(1)
@test returntype(tr) == Const(1)

tr = @trace foo(Int)
@test returntype(tr) == Int

function foo(x)
  r = Ref{Any}()
  r[] = x
  if rand(Bool)
    r[] = 1
  end
  return r[]
end

tr = @trace foo(1)
@test returntype(tr) == Const(1)

tr = @trace foo(2)
@test returntype(tr) == Int

struct Foo
  x
end

function foo(x)
  r = Foo(x)
  return r.x
end

tr = @trace foo(2)
@test returntype(tr) == Const(2)

foo(x) = Foo(x)

tr = @trace foo(1)
@test returntype(tr) == Const(Foo(1))

function pow(x, n)
  env = Dict()
  env[:r] = 1
  env[:n] = n
  while env[:n] > 0
    env[:r] *= x
    env[:n] -= 1
  end
  return env[:r]
end

tr = @trace pow(2, 3)
@test returntype(tr) == Const(8)

tr = @trace pow(Int, Int)
@test returntype(tr) == Int


immutable NoncentralChisq <: ContinuousUnivariateDistribution
    ν::Float64
    λ::Float64
    function NoncentralChisq(ν::Real, λ::Real)
        @check_args(NoncentralChisq, ν > zero(ν))
        @check_args(NoncentralChisq, λ >= zero(λ))
    	new(ν, λ)
    end
end

@distr_support NoncentralChisq 0.0 Inf

### Parameters

params(d::NoncentralChisq) = (d.ν, d.λ)

### Statistics

mean(d::NoncentralChisq) = d.ν + d.λ
var(d::NoncentralChisq) = 2.0*(d.ν + 2.0*d.λ)
skewness(d::NoncentralChisq) = 2.0*sqrt2*(d.ν + 3.0*d.λ)/sqrt(d.ν + 2.0*d.λ)^3
kurtosis(d::NoncentralChisq) = 12.0*(d.ν + 4.0*d.λ)/(d.ν + 2.0*d.λ)^2

function mgf(d::NoncentralChisq, t::Float64)
    exp(d.λ * t/(1.0 - 2.0 * t))*(1.0 - 2.0 * t)^(-d.ν / 2.0)
end

function cf(d::NoncentralChisq, t::Float64)
    cis(d.λ * t/(1.0 - 2.0 * im * t))*(1.0 - 2.0 * im * t)^(-d.ν / 2.0)
end

### Evaluation & Sampling

@_delegate_statsfuns NoncentralChisq nchisq ν λ

rand(d::NoncentralChisq) = StatsFuns.Rmath.nchisqrand(d.ν, d.λ)


using Unitful
function unitful_testfunction(Vi)
    if Vi ≤ 0.0u"V"
        return 0.0u"V"
    elseif Vi ≥ 1.0u"V"
        return 1.0u"V"
    else
        return Vi
    end
end

register_primitive(unitful_testfunction) # must be outside testset

@testset "Unitful" begin
    @info "Testing Unitful"

    PT = Particles
    for PT in (Particles, StaticParticles)
        p1 = PT(100, Uniform(-0.5,1.5)) * 1u"V"
        p2 = PT(100, Uniform(-0.5,1.5)) * u"V"
        @test_nowarn println(p1)
        @test_nowarn display(p1)

        @test_nowarn println(0p1)
        @test_nowarn display(0p1)

        @test typeof(p1) == typeof(p2)

        p3 = unitful_testfunction(p1)
        @test pextrema(p3) == (0.0u"V", 1.0u"V")

        @test (1 ± 0.5)u"m" * (1 ± 0)u"kg" ≈ (1 ± 0.5)u"kg*m"
        @test (1 ± 0.5)u"m" * 1u"kg" ≈ (1 ± 0.5)u"kg*m"

        @test (1 ± 0.5)u"m" / (1 ± 0)u"kg" ≈ (1 ± 0.5)u"m/kg"
        @test (1 ± 0.5)u"m" / 1u"kg" ≈ (1 ± 0.5)u"m/kg"

        @test (1 ± 0.5)u"m" + (1 ± 0)u"m" ≈ (2 ± 0.5)u"m"
        @test (1 ± 0.5)u"m" + 1u"m" ≈ (2 ± 0.5)u"m"

        @test 1u"m" * (1 ± 0.5)u"kg" ≈ (1 ± 0.5)u"kg*m"
        @test 1u"m" / (1 ± 0.5)u"kg" ≈ (1 ± 0.5)u"m/kg"
        @test 1u"m" + (1 ± 0.5)u"m" ≈ (2 ± 0.5)u"m"

        typeof(promote(1u"V", (1.0 ± 0.1)u"V")) <: Tuple{Particles{<:Quantity}, Particles{<:Quantity}}

        ρ = (2.7 ± 0.2)u"g/cm^3"
        mass = (250 ± 10)u"g"
        width = (30.5 ± 0.2)u"cm"
        l = (14.24 ± 0.2)u"m"
        thickness = u"μm"(mass/(ρ*width*l))
        @test thickness ≈ (21.3 ± 1.8)u"μm"

    end

end


### A Pluto.jl notebook ###
# v0.12.21

using Markdown
using InteractiveUtils

# ╔═╡ 9778402c-ff65-11ea-2af4-0fb4c0d1e78e
using Pkg, DrWatson

# ╔═╡ 977878f8-ff65-11ea-356c-8b889c8037b4
begin
	using Distributions
	using StatsPlots
	using StatsBase
	using LaTeXStrings
	using CSV
	using DataFrames
	using LinearAlgebra
	using Random
	using LinearAlgebra
	using StatisticalRethinking
end

# ╔═╡ 6426d13e-ff65-11ea-0e72-732d3a4de0f1
md"## clip-09-02s.jl"

# ╔═╡ 9778f07e-ff65-11ea-3d7f-35819188f757
md"### Snippet 9.2"

# ╔═╡ 97850170-ff65-11ea-16e9-af62429b511f
md"##### Number of samples."

# ╔═╡ 9785681a-ff65-11ea-3216-2b23598b1bef
T = 1000

# ╔═╡ 9793e066-ff65-11ea-2067-01c3caab76bf
md"##### Compute radial distance."

# ╔═╡ 97946ee6-ff65-11ea-0c08-43c9a52edf8d
rad_dist(x) = sqrt(sum(x .^ 2))

# ╔═╡ 979c7abe-ff65-11ea-2001-336b1bb02638
md"##### Plot densities."

# ╔═╡ 97ad992a-ff65-11ea-1e52-43039c4f5462
begin
	fig = density(xlabel="Radial distance from mode", ylabel="Density")
	for d in [1, 10, 100, 1000]
		m = MvNormal(zeros(d), Diagonal(ones(d)))
		local y = rand(m, T)
		rd = [rad_dist( y[:, i] ) for i in 1:T]
		density!(rd, lab="d=$d")
	end
	fig
end

# ╔═╡ 97b95942-ff65-11ea-1da3-23a8c109072b
md"## End of clip-09-02s.jl"

# ╔═╡ Cell order:
# ╟─6426d13e-ff65-11ea-0e72-732d3a4de0f1
# ╠═9778402c-ff65-11ea-2af4-0fb4c0d1e78e
# ╠═977878f8-ff65-11ea-356c-8b889c8037b4
# ╟─9778f07e-ff65-11ea-3d7f-35819188f757
# ╟─97850170-ff65-11ea-16e9-af62429b511f
# ╠═9785681a-ff65-11ea-3216-2b23598b1bef
# ╟─9793e066-ff65-11ea-2067-01c3caab76bf
# ╠═97946ee6-ff65-11ea-0c08-43c9a52edf8d
# ╟─979c7abe-ff65-11ea-2001-336b1bb02638
# ╠═97ad992a-ff65-11ea-1e52-43039c4f5462
# ╟─97b95942-ff65-11ea-1da3-23a8c109072b


function budget_test(retired :: Bool)
    lastWorkAge = 30;
    b = init_test_budget(lastWorkAge);
    @test validate_budget(b);

    if retired
        t = lastWorkAge + 1;
        efficiency = 0.0;
    else
        t = lastWorkAge;
        efficiency = [0.9, 2.1];
    end

    k = [1.2, 2.4];

    y = income(b, t, k, efficiency);
    @test size(y) == size(k)

    kp = kprime(b, t, k, 0.0, efficiency);
    @test isapprox(y, kp)

    c = 0.6;
    kp = kprime(b, t, k, c, efficiency);
    @test size(kp) == size(k)

    c2 = consumption(b, t, k, kp, efficiency);
    @test size(c2) == size(k)
    @test all(isapprox.(c, c2))
end

# function retired_test()
#     b = init_test_budget();
#     k = [1.2, 2.4];

#     y = retired_income(b, k);
#     @test size(y) == size(k)

#     kp = retired_kprime(b, k, 0.0);
#     @test isapprox(y, kp)

#     c = 0.6;
#     kp = retired_kprime(b, k, c);
#     @test size(kp) == size(k)

#     c2 = retired_consumption(b, k, kp);
#     @test size(c2) == size(k)
#     @test all(isapprox.(c, c2))
# end

@testset "Budget" begin
    for retired in [true, false]
        budget_test(retired);
    end
    # retired_test();
end

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


"""
This BellComm submodule provides methods for polyhedral analysis and transformations.
"""
module ConvexPolytope

using XPORTA, LinearAlgebra

include("./ConvexPolytope/adjacency_decomposition.jl")

# """
# facet_constraints(vertices, filename)
#
#     Uses xporta software to compute the facet inequalities given a set of
#     polytope vertices.
#
# Side-effect:
#     filename.poi and filename.poi.ieq files are saved to porta_tmp. porta_tmp
#     is optionally deleted at the end of function's execution.
#
# Inputs:
#     vertices: Array, contains polytope vertices.
#     filename: String (optional), name of .poi and .ieq files
#     dir: String (optional), directory where porta_tmp is created
#     cleanup: Boolean, if true tmp files are removed
#     suppress: Boolean, if true xporta does not print to STDOUT
#
# Outputs:
#     constraints: Tuple, contains arrays of dual vectors to vertices, (e.g. facets).
#       The constraint tupe is ordered in the following way
#           1: less than constraints <= 0
#           2: equal to constraints == 0
#           3: greater than constraints >= 0
# """
function facet_constraints(vertices; filename="facet_constraints_tmp", dir="./", cleanup=true, suppress=true)
    ieq = traf(POI( vertices=convert.(Int, vcat(map(v -> v', vertices)...))), filename=filename, dir=dir, cleanup=cleanup, verbose=!suppress)

    equalities = map(eq -> cat(-1*eq[end], eq[1:end-1]', dims=2) , eachrow(ieq.equalities))
    inequalities = map(ineq -> cat(-1*ineq[end], ineq[1:end-1]', dims=2) , eachrow(ieq.inequalities))

    (inequalities, equalities, [])
end

# """
# linear_interpolation(x1, x2; dw=0.1)
#
#     Creates an array of points which lie on the line connecting x1 to x2. Points
#     are interpolated by a step interval of dw where 0:dw:1.
#
# Inputs:
#     x1: Col Vector, point in convex polytope space
#     x2: Col Vector, point in convex polytope space
#     dw: float, 0<dw<1, sets the number of steps used in the interpolation
#
# Output:
#     interpolation: Array, contains points in convex polytope which scan across
#                    the line starting from x1 going to x2.
# """
function linear_interpolation(x1, x2; dw=0.1)
    ws = 0:dw:1
    dim = length(x1)
    interpolation = map(w -> reshape((1 - w)*x1 + w*x2,(dim, 1)), ws)

    interpolation
end

# """
# facet_contains(facet, x)
#
#     Returns true if the point x lies approximately on the facet.
#
# Inputs:
#     facet: Row Vector, contains hyperplane constant and normal vector of hyperplane.
#     x: Col Vector, a point the convex polytope space.
#
# Outputs:
#     Boolean, true if point x lies on the facet.
# """
function facet_contains(facet, x)
    isapprox(1 + facet_violation(facet, x), 1)
end

# """
# contains(facets, x):
#
#     Checks if the convex polytope contains the point x by checking each facet
#     for violation.
#
# Inputs:
#     facets: Array, contains facet inequalities
#     x: Col Vector, the point to test
#
# Output:
#     Boolean, true if the polytope contains point x
# """
function contains(facets, x)
    length(violated_facets(facets, x)) == 0
end

# """
# violated_facets(facets, x)
#
#     Returns the list of facets which are violated by the provided point, x. If
#     no facets are violated, an empty array is returned.
#
# Inputs:
#     facet: Row Vector, contains hyperplane constant and normal vector of hyperplane.
#     x: Col Vector, a point the convex polytope space.
#
# Outputs:
#     violations: Array, contains the facet inequalities which were violated by x.
# """
function violated_facets(facets, x)
    violations = filter(
        facet -> facet_violation(facet, x) > 0 && !facet_contains(facet, x),
        facets
    )

    violations
end

# """
# facets_contain(facets, x)
#
#     Returns true if point x satisfies all facet inequalities.
#
# Inputs:
#     facet: Row Vector, contains hyperplane constant and normal vector of hyperplane.
#     x: Col Vector, a point the convex polytope space.
#
# Outputs:
#     x_is_contained: Boolean, true if x lies within or along the polytope boundary.
# """
function facets_contain(facets, x)
    x_is_contained = all(map(
        facet -> facet_violation(facet, x) <= 0,
        facets
    ))

    x_is_contained
end

# """
# facet_violation(facet, x)
#
#     Computes the violation quantity of point x for a given facet. A violation > 0
#     indicates a point which does not satisfy the facet inequality.
#
# Inputs:
#     facet: Row Vector, contains hyperplane constant and normal vector of hyperplane.
#     x: Col Vector, a point the convex polytope space.
#
# Outputs:
#     violation: Float, Inequality is satisfied for violation <= 0.
# """
function facet_violation(facet, x)
    violation = NaN
    if length(x) == length(facet)
        violation = (facet*x)[1]
    elseif (length(x) + 1) == length(facet)
        violation = facet[1] + (facet[2:end]'*x)[1]
    else
        throw(ArgumentError("dimension mismatch: facet not 'dual' to coordinate"))
    end

    violation
end

# """
# facet_distance(facet, x)
#
#     Computes the (shortest) distance between point x and a given facet. A
#     distance < 0 indicates that the point lies within the polytope.
#
# Inputs:
#     facet: Row Vector, contains hyperplane constant and normal vector of hyperplane.
#     x: Col Vector, a point the convex polytope space.
#
# Outputs:
#     dist: Float, distance a point is from a bounding hyperplane.
# """
function facet_distance(facet, x)
    dist = ConvexPolytope.facet_violation(facet, x)/norm(facet[2:end])
    dist
end

# """
# distance(x1, x2)
#     Computes the distance between two points in behavior space.
#
# Inputs:
#     x1/2: Col Vector, represents a point in behavior space.
#
# Output:
#     dist: Integer, the Euclidean distance between the two point.
# """
function vertex_distance(x1, x2)
    dist = norm(x1 - x2)
    dist
end

# """
# collect_vertices(facets, vertices):
#
#     For each facet, find all vertices that lie on that facet and construct a
#     dictionary linking the facet to the set of vertices.
#
# Input:
#     facets: Array, contains valid facet inequalities
#     vertices: Array, contains valid vertices
#
# Output:
#     Array, contains dictionaries in the following form
#         {
#             "facet": [facet inequality],
#             "vertices": [[v1],[v2],...,[vN]]
#         }
# """
function collect_vertices(facets, vertices)
    fv_groups = map(
        (f)->Dict(
            "facet" => f,
            "vertices" => filter(v->ConvexPolytope.facet_contains(f, v), vertices)
        ), facets)

    fv_groups
end

# """
# collect_facets(vertices, facets):
#
#     For each vertex, find all facets which that vertex lies on and construct
#     a dictionary linking each vertex to all of its facets.
#
# Input:
#     vertices: Array, contains valid vertices
#     facets: Array, contains valid facet inequalities
#
# Output:
#     Array, contains dictionaries of the following form
#         {
#             "vertex": [vertex]
#             "facets": [[f1],[f2],...,[fN]]
#         }
# """
function collect_facets(vertices, facets)
    vf_groups = map(
        (v)->Dict(
            "vertex" => v,
            "facets" => filter(f->ConvexPolytope.facet_contains(f, v), facets)
        ), vertices)

    vf_groups
end

end


# uses variables from setup_tests.jl

sym_implied_pop_m, sym_implied_pop_f = eqm_consistency(mgmkt.surplus, mgmkt.msingle, mgmkt.fsingle)
asym_implied_pop_m, asym_implied_pop_f = eqm_consistency(mgmkt2.surplus, mgmkt2.msingle, mgmkt2.fsingle)

# ensure convergence to valid equilibrium
@testset "validity of equilibrium population measures" begin
	match_tol = 1e-12
	@test mgmkt.matches ≈ match_matrix(mgmkt.surplus, mgmkt.msingle, mgmkt.fsingle) atol = match_tol
	@test sym_implied_pop_m ≈ mgmkt.mdist atol = match_tol
	@test sym_implied_pop_f ≈ mgmkt.fdist atol = match_tol

	@test mgmkt2.matches ≈ match_matrix(mgmkt2.surplus, mgmkt2.msingle, mgmkt2.fsingle) atol = match_tol
	@test asym_implied_pop_m ≈ mgmkt2.mdist atol = match_tol
	@test asym_implied_pop_f ≈ mgmkt2.fdist atol = match_tol
end

# check symmetry
@test mgmkt.msingle ≈ mgmkt.fsingle

# check that supermodular surplus results in positive assortative matching
@test mgmkt2.matches[1,1,1,1] + mgmkt2.matches[end,end,end,end] > mgmkt2.matches[1,1,end,end] + mgmkt2.matches[end,end,1,1]


using DiffEqBayesStan, MCMCChains
using OrdinaryDiffEq
using ParameterizedFunctions
using RecursiveArrayTools
using Distributions
using StatsPlots
using DataFrames, MonteCarloMeasurements
using StanSample

ProjDir = @__DIR__

println("\nFour parameter case\n")

f1 = @ode_def begin
    dx = a*x - b*x*y
    dy = -c*y + d*x*y
end a b c d

u0 = [1.0,1.0]
tspan = (0.0,10.0)
p = [1.5,1.0,3.0,1.0]
prob1 = ODEProblem(f1,u0,tspan,p)
sol = solve(prob1,Tsit5())

t = collect(range(1,stop=10,length=50))
randomized = VectorOfArray([(sol(t[i]) + .3randn(2)) for i in 1:length(t)])
data_array = convert(Array, randomized)

priors = [truncated(Normal(1.5,0.1),0.5,2),truncated(Normal(1.0,0.1),0.5,1.5),
          truncated(Normal(3.0,0.1),0.5,4),truncated(Normal(1.0,0.1),0.5,2)]

@time bayesian_result = stan_inference(prob1, t, data_array, priors;
    num_chains=4, num_samples=1000, num_warmups=1000,
    vars =(DiffEqBayesStan.StanODEData(), InverseGamma(4,1)),
    output_format=:dataframe)

if success(bayesian_result.return_code)
    df = bayesian_result.chains

    # Quick summary of results
    parts = read_samples(bayesian_result.model, :particles)
    parts |> display

    # Read in chains as a vector of DataFrames
    dfs = read_samples(bayesian_result.model, :dataframes)

    for j in 1:4
        for i in 1:4
            if i == 1
                plot(dfs[i][:, "theta_$j"], lab="chain[$i]")
            else
                plot!(dfs[i][:, "theta_$j"], lab="chain[$i]")
            end
            title!("theta_$j")
        end
    savefig(joinpath(ProjDir, "theta_$j.png"))
    end

    println()
    stan_summary(bayesian_result.model, true)
    println()

end


function gwr(data,MAXNUMBEROFNODES)

#the initial parameters for the algorithm:
global maxnodes, at, en, eb, h0, ab, an, tb, tn, amax, A, C

maxnodes = MAXNUMBEROFNODES; #maximum number of nodes/neurons in the gas
at = 0.95; #activity threshold
en = 0.006; #epsilon subscript n
eb = 0.2; #epsilon subscript b
h0 = 1;
ab = 0.95;
an = 0.95;
tb = 3.33;
tn = 3.33;
amax = 50; #greatest allowed age

t0 = time();
STATIC = true;
RANDOMSTART = true;
DOOVER = 1;

#test some algorithm conditions:
if !(0 < en || en < eb || eb < 1)
    error("en and/or eb definitions are wrong. They are as: 0<en<eb<1.")
end
# (1)
# pick n1 and n2 from data
ni1 = 1;
ni2 = 2;
if RANDOMSTART
    n = randperm(size(data,2));
    ni1 = n[1];
    ni2 = n[2];
end
n1 = data[:,ni1]; n2 = data[:,ni2];

#println(strcat("Initial parameters ","n1 =  ",num2str(ni1)," n2 =  ",num2str(ni2)))

A = zeros(size(n1,1),maxnodes);
    A[:,[1,2]] = hcat(n1, n2)

# (2)
# initialize empty set C

C = spzeros(maxnodes,maxnodes);
C_age = C;

r = 3;
h = zeros(1,maxnodes);
datasetsize = size(data,2);

#some variables to display the graphs
activations = [];
nodecount = [];
epoch = 1;

### SPEEDUP CHANGE
if STATIC
    hizero = hi(0)*ones(1,maxnodes);
    hszero = hs(0);
else
    timetime = 0;
end
OldA = A;
# start of the loop
for epochscounter = 1:DOOVER
for k = 1:datasetsize #step 1
	#global A
        eta = data[:,k]; # this the k-th data sample
        ws, (), s, t, () = findnearest(eta, A); #step 2 and 3
    if C[s,t]==0 #step 4
        C = spdi_bind(C,s,t);
    else
        C_age = spdi_del(C_age,s,t);
    end
    a = exp(-norm(eta-ws)); #step 5

    neighbours = findneighbours(s, C);

    num_of_neighbours = size(neighbours,1);

    if a < at && r <= maxnodes #step 6
        wr = 0.5*(ws+eta); #too low activity, needs to create new node r
        A[:,r] = wr;
        C = spdi_bind(C,t,r);
        C = spdi_bind(C,s,r);
        C = spdi_del(C,s,t);
        r = r+1;
    else #step 7
        for j = 1:num_of_neighbours # check this for possible indexing errors
            i = neighbours[j];
            wi = A[:,i];
            A[:,i] = wi + en*h[i]*(eta-wi);
        end
        A[:,s] = ws + eb*h[s]*(eta-ws);
    end
    #step 8 : age edges with end at s
    #first we need to find if the edges connect to s

    for j = 1:num_of_neighbours # check this for possible indexing errors
           i = neighbours[j];
           C_age = spdi_add(C_age,s,i);
    end

    #step 9: again we do it inverted, for loop first
    #### this strange check is a speedup for the case when the algorithm is static
    if STATIC # skips this if algorithm is static
        h = hizero;
        h[s] = hszero;
    else
        for i = 1:r
            h[i] = hi(time);
        end
        h[s] = hs(timetime);
        timetime = (time - t0)*1;
    end

    #step 10: check if a node has no edges and delete them
    if r>2 # don't remove everything
        C, C_age  = removeedge(C, C_age);
        C, A, C_age, h, r  = removenode(C, A, C_age, h, r);  #inverted order as it says on the algorithm to remove points faster
    end
    #activations = vcat(activations, a);
    epoch += 1;

end
end
return A,C,ni1,ni2
end

function spdi_add(sparsemat, a, b) #increases the number
sparsemat[a,b] = sparsemat[a,b] + 1;
sparsemat[b,a] = sparsemat[a,b] + 1;
return sparsemat
end

function spdi_bind(sparsemat, a, b) # adds a 2 way connection
sparsemat[a,b] = 1;
sparsemat[b,a] = 1;
return sparsemat
end

function spdi_del(sparsemat, a, b) # removes a 2 way connection
sparsemat[a,b] = 0;
sparsemat[b,a] = 0;
return sparsemat
end

function S(t)
    X = 1;
return X
end

function hs(t)
global h0,ab,tb
X = h0 - S(t)/ab*(1-exp(-ab*t/tb));
return X
end

function hi(t)
global h0, an, tn
X = h0 - S(t)/an*(1-exp(-an*t/tn));
return X
end


## Exercise 8-11
## A Caesar cypher is a weak form of encryption that involves “rotating” each letter by a fixed number of places. To rotate a letter means to shift it through the alphabet, wrapping around to the beginning if necessary, so ’A’ rotated by 3 is ’D’ and ’Z’ rotated by 1 is ’A’.

## To rotate a word, rotate each letter by the same amount. For example, "cheer" rotated by 7 is "jolly" and "melon" rotated by -10 is "cubed". In the movie 2001: A Space Odyssey, the ship computer is called HAL, which is IBM rotated by -1.

## Write a function called rotateword that takes a string and an integer as parameters, and returns a new string that contains the letters from the original string rotated by the given amount.

## TIP
## You might want to use the built-in function Int, which converts a character to a numeric code, and Char, which converts numeric codes to characters. Letters of the alphabet are encoded in alphabetical order, so for example:

## julia> Int('c') - Int('a')
## 2
## Because c is the third letter of the alphabet. But beware: the numeric codes for uppercase letters are different.

## julia> Char(Int('A') + 32)
## 'a': ASCII/Unicode U+0061 (category Ll: Letter, lowercase)

## Potentially offensive jokes on the Internet are sometimes encoded in ROT13, which is a Caesar cypher with rotation 13. If you are not easily offended, find and decode some of them.

println("Ans:")

function ceasarCypher(input::AbstractString, rotator::Int)
    output = ""
    for c in input
        c = Int(c) + rotator
        # if !( 65 < c < 90 || 97 < c < 122 )
        #     if c < 65 || c < 97
        #         c += 26
        #     elseif c > 90 || c > 122
        #         c -= 26
        #     end
        # end
        output *= Char(c)
    end
    output
end

print("Please enter a string: ")
str = strip(readline())
out = ceasarCypher(str, 13)
println("Cyphered string: $out")

println("End.")


using Revise, Test, FourierCore, LinearAlgebra

include("test_domain.jl")
include("test_grid.jl")


#=
Alternating Projections methods, first try
- Julia version: 1.1.0
- Author: Oleg Soloviev
- Date: 2019-09-01 =#

"""
AlternatingProjections

Module contains types and functions for formulation and solving feasibility problem
    using projections-based methods.
"""
module AlternatingProjections

using LinearAlgebra
using FFTW
import Base.size # to add size method for FeasibleSet's subtypes

include("AbstractProblems.jl")
export Problem, Algorithm, IterativeAlgorithm, solve

export ProjectionsMethod, FeasibleSet, FeasibilityProblem, project, project!, reflect, reflect!, ConvexSet, apsolve, TwoSetsFP, TransformedSet, LinearTransformedSet,
FourierTransformedSet, forward!, backward!, generatingset

# Common type of a problem is feasibility problem, for which we need to introduce concept of
# a feasuible set
"""
    FeasibleSet

Abstract type representing a set for feasibility problem.
    For any set we should be able to take it's representative element.

    Fro any concrete subtype, we define a project operator (maybe set-valued) to be defined.

"""
abstract type FeasibleSet end

getelement(s::FeasibleSet) = error("Don't know how to take an element of $typeof(s)")

"""
Big class of feasibility problems./
"""
abstract type FeasibilityProblem <: Problem end

"""
    TwoSetsFP(A,B)

Two sets feasibility problem: for given sets A and B find x∈A∩B, if A∩B≠∅, or x∈A closest to B in some sense.

"""
struct TwoSetsFP <: FeasibilityProblem
    A::FeasibleSet
    B::FeasibleSet
end

"""
    ConvexSet

General type, no projection method is specified. For a convex set a projection is unique.

"""
abstract type ConvexSet <: FeasibleSet end

# Projections

"""
    project!(xp, x, A)

Project `x` on set `A` using preallocated `xp`.
"""
function project!(xp, x, feasset::FeasibleSet)
    error("Don't know how to project on ", typeof(feasset))
end

"""
    project!(x, A)

Project `x` on set `A` and storing result in `x`.
"""
function project!(x, feasset::FeasibleSet)
    error("Don't know how to project on ", typeof(feasset))
end

"""
    project(x, A)

Project `x` on set `A` and return the result of projection.
"""
project(x, feasset::FeasibleSet) = project!(copy(x), x, feasset)

# Reflections
"""
    reflect!(xr, x, A)

Reflect `x` on set `A` using preallocated `xp`, R(x) = 2P(x) -x, where P is projection on the set.
"""
function reflect!(xr, x, feasset::FeasibleSet)
    project!(xr,x,feasset)
    #  xr .= 2 .* xr .- x
    @. xr = 2 * xr - x
    return xr
end

reflect(x, feasset::FeasibleSet) = 2 * project(x, feasset) - x

"""
ProjectionsMethod is class of iterative algorithms for solving feasibility problems based on projections on the feasible sets.
    Examples are Alternating Projections (AP), also known in the literature as Projections on the Convex Sets (POCS),
    Douglas-Rachford algorithm (DR), their combination DRAP and many others.

"""
abstract type  ProjectionsMethod <: IterativeAlgorithm end

include("AP.jl")
include("DR.jl")
include("DRAP.jl")

include("TransformedSet.jl")

# Constraints
include("SupportConstraint.jl")
include("AmplitudeConstraint.jl")

# Iterators
include("iterators.jl")

end # module


#import Winston

@testset "DelaunayMeshTests" begin
  @testset "AddConstraint" begin
    local mesh = DelaunayMeshes.Mesh()
    DelaunayMeshes.setboundingbox(mesh, [-15.0, 15.0, -15.0, 15.0])
    # seed rng and store seed in file
    local seed = 4139605370
    #local seed = rand(UInt32)
    local fs = open("AddConstraint.seed", "w")
    write(fs, string(seed))
    close(fs)

    # push some random vertices
    srand(seed)
    local nvertices = 200
    local points = rand(Float64, nvertices, 2)*30. - 15.
    push!(mesh, points)

    local nringvertices = 40

    # push inner ring constraint vertices
    local θ = linspace(0., 2.*π, nringvertices + 1)[1:end-1]
    local rinner = 5.
    local router = 10.
    local innerRing = rinner * [cos(θ'); sin(θ')]'
    local outerRing = router * [cos(θ'); sin(θ')]'

    push!(mesh, innerRing)
    push!(mesh, outerRing)

    local faultyTriangles = testdelaunayness(mesh.tesselation)
    @test length(faultyTriangles) == 0
    @test length(mesh.tesselation.vertices) == (nvertices + 3 + 2*nringvertices)

    # add constraints
    local innerConstraintVertexList = [x for x in (nvertices+3+nringvertices):-1:(nvertices+3+1)]
    local outerConstraintVertexList = [x for x in (nvertices+3+nringvertices+1):(nvertices + 3 + 2*nringvertices)]

    DelaunayMeshes.addconstraint!(mesh, innerConstraintVertexList)
    DelaunayMeshes.addconstraint!(mesh, outerConstraintVertexList)

    # check that constraints are in
    local innerConstrMatrix = [innerConstraintVertexList'; circshift(innerConstraintVertexList, -1)']'
    local outerConstrMatrix = [outerConstraintVertexList'; circshift(outerConstraintVertexList, -1)']'
    local constraints = [innerConstrMatrix; outerConstrMatrix]

    validateconstraints(mesh.tesselation, constraints)
    testvertexcache(mesh.tesselation)

    # get voronoiVertices
    local vorVert = DelaunayMeshes.getvoronoivertices(mesh)

    # mark all that are between inner and outer circle
    local unScaledVorVert = DelaunayMeshes.unscalepoints(mesh, vorVert)
    local unScaledSquare = unScaledVorVert.*unScaledVorVert
    local rVor = sqrt(unScaledSquare[:,1] + unScaledSquare[:,2])
    local interiorVerticesBool = (rVor .>= rinner * ones(rVor)) & (rVor .<= router * ones(rVor))

    # plot it
    #=
    xc, yc = DelaunayMeshes.getdelaunaycoordinates(mesh.tesselation)
    p = Winston.FramedPlot(aspect_ratio=1
      #,xrange=[1.496 1.50], yrange=[1.256, 1.26]
      )
    Winston.add(p, Winston.Curve(xc, yc))
    #Winston.add(p, Winston.Points(vorVert[interiorVerticesBool,1], vorVert[interiorVerticesBool,2], kind="circle", color="green"))
    Winston.add(p, Winston.Points(
      vorVert[mesh.faceLocation,1], vorVert[mesh.faceLocation,2],
      kind="circle", color="red"))
    Winston.savefig(p, "AddConstraint.svg")
    =#

    # check that this agrees with the interior array of the triangulation
    @test length(interiorVerticesBool) == length(mesh.faceLocation)
    if !(interiorVerticesBool == mesh.faceLocation)
      for (i,e) in enumerate(interiorVerticesBool)
        if (e != mesh.faceLocation[i])
          local pos = unScaledVorVert[i, :]
          local r = sqrt(pos[1]^2 + pos[2]^2)
          println("Pos $i: expecting $e, got $(mesh.faceLocation[i]). $pos and $r (scaled:$(vorVert[i,:]))")
        end
      end
    end

    @test interiorVerticesBool == mesh.faceLocation
  end

  @testset "FindConstrainedTriangles" begin
    local mesh = DelaunayMeshes.Mesh()

    # seed rng and store seed in file
    #local seed = 2572853444
    local seed = rand(UInt32)
    local fs = open("FindConstrainedTriangles.seed", "w")
    write(fs, string(seed))
    close(fs)

    # push some random vertices
    srand(seed)
    local nvertices = 20
    local points = rand(Float64, nvertices, 2)*5.0 - 2.5
    push!(mesh, points)

   # push constraint vertices
    local constraintVertices = [
      -1.0 -1.0;
      -0.5 -1.0;
      -0.5 0.0;
      0.5 0.0;
      0.5 -1.0;
      1.0 -1.0;
      1.0 1.0;
      -1.0 1.0;
    ]
    push!(mesh, constraintVertices)

    local faultyTriangles = testdelaunayness(mesh.tesselation)
    #=
    if (length(faultyTriangles) > 0)
      for f in faultyTriangles
        local ftIndex = [f[1], f[2], f[3], f[4]]
        local vertexPoints = reduce(hcat, mesh.tesselation.vertices[ftIndex])'
        PyPlot.plot(vertexPoints[:,1], vertexPoints[:,2], "o")
      end
    end
    =#
    @test length(faultyTriangles) == 0
    @test length(mesh.tesselation.vertices) == (nvertices + 8 + 3)

    # constraints
    local n = nvertices + 3

    local constraints = [
      n+1 n+2;
      n+2 n+3;
      n+3 n+4;
      n+4 n+5;
      n+5 n+6;
      n+6 n+7;
      n+7 n+8;
      n+8 n+1;
    ]
    for i=1:size(constraints, 1)
      DelaunayMeshes.insertconstraint!(mesh.tesselation, constraints[i, 1], constraints[i,2])
    end

    validateconstraints(mesh.tesselation, constraints)
    testvertexcache(mesh.tesselation)

    # get voronoiVertices
    local vorVert = DelaunayMeshes.getvoronoivertices(mesh)

    # get faces in connected region
    local startEdge = findedgeconnectingvertices(mesh.tesselation, n+1, n+2)
    local startDualEdge = DelaunayMeshes.sym(DelaunayMeshes.rot(startEdge))
    local connectedVertices = DelaunayMeshes.getfacesinsideregion(mesh, startDualEdge)
    local connectedBool = fill(false, size(mesh.tesselation.faces, 1))
    connectedBool[connectedVertices] = true

    # get all faces inside constraint for comparison
    local insideConstraint = pointsinconstrainedregion(mesh, vorVert)

    @test connectedBool == insideConstraint

    # plot it
    #=
    xc, yc = Triangulation.GetDelaunayCoordinates(mesh.tesselation)
    PyPlot.clf()
    PyPlot.plot(xc, yc)
    PyPlot.plot(get(mesh.voronoiVertices)[insideConstraint,1], get(mesh.voronoiVertices)[insideConstraint,2], "o")
    PyPlot.savefig("FindConstrainedTriangles.svg")
    =#

  end

  @testset "push" begin
    local mesh = DelaunayMeshes.Mesh()

    # seed rng and store seed in file
    #local seed = 1985005665
    local seed = rand(UInt32)
    local fs = open("DelaunayMeshPushRandom.seed", "w")
    write(fs, string(seed))
    close(fs)

    # get dimensions of bounding box
    local testBB = [rand(), rand(), rand(), rand()] * 1e5 - 0.5e4

    # push some random vertices
    srand(seed)
    local nvertices = 200
    local points = getrandomnumbersinsideboundingbox(testBB, nvertices)
    push!(mesh, points)

    # check they are inside bounding box
    local vertexPoints = reduce(hcat, mesh.tesselation.vertices[4:end])'
    local minX = minimum(vertexPoints[:,1])
    local maxX = maximum(vertexPoints[:,1])
    local minY = minimum(vertexPoints[:,2])
    local maxY = maximum(vertexPoints[:,2])

    local dh = 0.05/2.
    @test minX >= (1.5 - dh)
    @test maxX <= (1.5 + dh)
    @test minY >= (1.25 - dh)
    @test maxY <= (1.25 + dh)

    # push some more vertices that are guaranteed to be inside
    local smallBB = [
      minimum(points[:,1]), maximum(points[:,1]),
      minimum(points[:,2]), maximum(points[:,2]),
    ]

    local morePoints = getrandomnumbersinsideboundingbox(smallBB, nvertices)
    push!(mesh, morePoints)

    # check they are still inside bounding box
    vertexPoints = reduce(hcat, mesh.tesselation.vertices[4:end])'
    minX = minimum(vertexPoints[:,1])
    maxX = maximum(vertexPoints[:,1])
    minY = minimum(vertexPoints[:,2])
    maxY = maximum(vertexPoints[:,2])

    @test minX >= (1.5 - dh)
    @test maxX <= (1.5 + dh)
    @test minY >= (1.25 - dh)
    @test maxY <= (1.25 + dh)

    # check that the vertex locations are correct
    @test length(mesh.faceLocation) == length(mesh.tesselation.faces)
    @test mesh.faceLocation[1]
    @test !mesh.faceLocation[2]
    @test all(mesh.faceLocation[3:end])
  end
end


@testset "SmithWilson" begin

    @testset "InstrumentQuotes" begin

        maturities = [1.3, 2.7]
        prices = [1.1, 0.8]
        zcq = Yields.ZeroCouponQuote.(prices, maturities)
        @test isa(first(zcq), Yields.ZeroCouponQuote)

        @test_throws DimensionMismatch Yields.ZeroCouponQuote.([1.3, 2.4, 0.9], maturities)

        rates = [0.4, -0.7]
        swq = Yields.SwapQuote.(rates, maturities, 3)
        @test first(swq).frequency == 3

        @test_throws DimensionMismatch Yields.SwapQuote.([1.3, 2.4, 0.9], maturities, 3)
        @test_throws DomainError Yields.SwapQuote.(rates, maturities, 0)
        @test_throws DomainError Yields.SwapQuote.(rates, maturities, -2)

        rates = [0.4, -0.7]
        bbq = Yields.BulletBondQuote.(rates, prices, maturities, 3)
        @test first(bbq).frequency == 3
        @test first(bbq).yield == first(rates)

        @test_throws DimensionMismatch Yields.BulletBondQuote.([1.3, 2.4, 0.9], prices, maturities, 3)
        @test_throws DimensionMismatch Yields.BulletBondQuote.(rates, prices, [4.3, 5.6, 4.4, 4.4], 3)
        @test first(Yields.BulletBondQuote.(rates, [5.7], maturities, 3)).price == 5.7
        @test_throws DomainError Yields.BulletBondQuote.(rates, prices, maturities, 0)
        @test_throws DomainError Yields.BulletBondQuote.(rates, prices, maturities, -4)

    end

    @testset "SmithWilson" begin

        ufr = 0.03
        α = 0.1
        u = [5.0, 7.0]
        qb = [2.3, -1.2]

        # Basic behaviour
        sw = Yields.SmithWilson(u, qb; ufr = ufr, α = α)
        @test sw.ufr == ufr
        @test sw.α == α
        @test sw.u == u
        @test sw.qb == qb
        @test_throws DomainError Yields.SmithWilson(u, [2.4, -3.4, 8.9], ufr = ufr, α = α)

        # Empty u and Qb should result in a flat yield curve
        # Use this to test methods expected from <:AbstractYieldCurve
        # Only discount and zero are explicitly implemented, so the others should follow automatically
        sw_flat = Yields.SmithWilson(Float64[], Float64[], ufr = ufr, α = α)
        @test discount(sw_flat, 10.0) == exp(-ufr * 10.0)
        @test accumulation(sw_flat, 10.0) ≈ exp(ufr * 10.0)
        @test rate(convert(Yields.Continuous(), zero(sw_flat, 8.0))) ≈ ufr
        @test discount.(sw_flat, [5.0, 10.0]) ≈ exp.(-ufr .* [5.0, 10.0])
        @test rate(convert(Yields.Continuous(), forward(sw_flat, 5.0, 8.0))) ≈ ufr

        # A trivial Qb vector (=0) should result in a flat yield curve
        ufr_curve = Yields.SmithWilson(u, [0.0, 0.0], ufr = ufr, α = α)
        @test discount(ufr_curve, 10.0) == exp(-ufr * 10.0)

        # A single payment at time 4, zero interest
        curve_with_zero_yield = Yields.SmithWilson([4.0], reshape([1.0], 1, 1), [1.0], ufr = ufr, α = α)
        @test discount(curve_with_zero_yield, 4.0) == 1.0

        # In the long end it's still just UFR
        @test rate(convert(Yields.Continuous(), forward(curve_with_zero_yield, 1000.0, 2000.0))) ≈ ufr

        # Three maturities have known discount factors
        times = [1.0, 2.5, 5.6]
        prices = [0.9, 0.7, 0.5]
        cfs = [1 0 0
            0 1 0
            0 0 1]

        curve_three = Yields.SmithWilson(times, cfs, prices, ufr = ufr, α = α)
        @test transpose(cfs) * discount.(curve_three, times) ≈ prices

        # Two cash flows with payments at three times
        prices = [1.0, 0.9]
        cfs = [0.1 0.1
            1.0 0.1
            0.0 1.0]
        curve_nondiag = Yields.SmithWilson(times, cfs, prices, ufr = ufr, α = α)
        @test transpose(cfs) * discount.(curve_nondiag, times) ≈ prices

        # Round-trip zero coupon quotes
        zcq_times = [1.2, 4.5, 5.6]
        zcq_prices = [1.0, 0.9, 1.2]
        zcq = Yields.ZeroCouponQuote.(zcq_prices, zcq_times)
        sw_zcq = Yields.SmithWilson(zcq, ufr = ufr, α = α)
        @testset "ZeroCouponQuotes round-trip" for idx = 1:length(zcq_times)
            @test discount(sw_zcq, zcq_times[idx]) ≈ zcq_prices[idx]
        end

        # uneven frequencies
        swq_maturities = [1.2, 2.5, 3.6]
        swq_interests = [-0.02, 0.3, 0.04]
        frequency = [2, 1, 2]
        swq = Yields.SwapQuote.(swq_interests, swq_maturities, frequency)
        swq_times = 0.5:0.5:3.5   # Maturities are rounded down to multiples of 1/frequency, [1.0, 2.5, 3.5]
        swq_payments = [
            -0.01 0.3 0.02
            0.99 0 0.02
            0 0.3 0.02
            0 0 0.02
            0 1.3 0.02
            0 0 0.02
            0 0 1.02
        ]

        # Round-trip swap quotes
        swq_maturities = [1.2, 2.5, 3.6]
        swq_interests = [-0.02, 0.3, 0.04]
        frequency = 2
        swq = Yields.SwapQuote.(swq_interests, swq_maturities, frequency)
        swq_times = 0.5:0.5:3.5   # Maturities are rounded down to multiples of 1/frequency, [1.0, 2.5, 3.5]
        swq_payments = [-0.01 0.15 0.02
            0.99 0.15 0.02
            0.0 0.15 0.02
            0.0 0.15 0.02
            0.0 1.15 0.02
            0.0 0.0 0.02
            0.0 0.0 1.02]
        sw_swq = Yields.SmithWilson(swq, ufr = ufr, α = α)
        @testset "SwapQuotes round-trip" for swapIdx = 1:length(swq_interests)
            @test sum(discount.(sw_swq, swq_times) .* swq_payments[:, swapIdx]) ≈ 1.0
        end

        # Round-trip bullet bond quotes (reuse data from swap quotes)
        bbq_prices = [1.3, 0.1, 4.5]
        bbq = Yields.BulletBondQuote.(swq_interests, bbq_prices, swq_maturities, frequency)
        sw_bbq = Yields.SmithWilson(bbq, ufr = ufr, α = α)
        @testset "BulletBondQuotes round-trip" for bondIdx = 1:length(swq_interests)
            @test sum(discount.(sw_bbq, swq_times) .* swq_payments[:, bondIdx]) ≈ bbq_prices[bondIdx]
        end

        @testset "SW ForwardStarting" begin
            fwd_time = 1.0
            fwd = Yields.ForwardStarting(sw_swq, fwd_time)

            @test discount(fwd, 3.7) ≈ discount(sw_swq, fwd_time, fwd_time + 3.7)
        end

        # EIOPA risk free rate (no VA), 31 August 2021.
        # https://www.eiopa.europa.eu/sites/default/files/risk_free_interest_rate/eiopa_rfr_20210831.zip
        eiopa_output_qb = [-0.59556534586390800
            -0.07442224713453920
            -0.34193181987682400
            1.54054875814153000
            -2.15552046042343000
            0.73559290752221900
            1.89365225129089000
            -2.75927773116240000
            2.24893737130629000
            -1.51625404117395000
            0.19284859623817400
            1.13410725406271000
            0.00153268224642171
            0.00147942301778158
            -1.85022125156483000
            0.00336230229850928
            0.00324546553910162
            0.00313268874430658
            0.00302383083427276
            1.36047951448615000]
        eiopa_output_u = 1:20
        eiopa_ufr = log(1.036)
        eiopa_α = 0.133394
        sw_eiopa_expected = Yields.SmithWilson(eiopa_output_u, eiopa_output_qb; ufr = eiopa_ufr, α = eiopa_α)

        eiopa_eurswap_maturities = [1:12; 15; 20]
        eiopa_eurswap_rates = [-0.00615, -0.00575, -0.00535, -0.00485, -0.00425, -0.00375, -0.003145,
            -0.00245, -0.00185, -0.00125, -0.000711, -0.00019, 0.00111, 0.00215]   # Reverse engineered from output curve. This is the full precision of market quotes.
        eiopa_eurswap_quotes = Yields.SwapQuote.(eiopa_eurswap_rates, eiopa_eurswap_maturities, 1)
        sw_eiopa_actual = Yields.SmithWilson(eiopa_eurswap_quotes, ufr = eiopa_ufr, α = eiopa_α)

        @testset "Match EIOPA calculation" begin
            @test sw_eiopa_expected.u ≈ sw_eiopa_actual.u
            @test sw_eiopa_expected.qb ≈ sw_eiopa_actual.qb
        end
    end
end


include("exact_slater.jl")

function test_hydrogenic_slater_integrals!(data, tests,
                                           eq, term::Symbol, expected, rtol;
                                           print_res=false)
    eng = energy(eq, term)
    expectedf = convert(Float64, expected)
    δ = eng-expectedf
    test = :(isapprox($eng, $expected; rtol=$rtol))
    pass = @eval $test
    push!(data, [eq.orbital Dict(:onebody => "⟨h⟩", :direct => "⟨J⟩", :exchange => "⟨K⟩")[term] expected expectedf eng δ δ/abs(1e-10+abs(expectedf)) pass])
    push!(tests, test)
end

function test_hydrogenic_slater_integrals(fun::Function, fock::Fock, do_test::Bool=true)
    data = []
    tests = []

    for (i,eq) in enumerate(fock.equations.equations)
        cases = fun(i)
        for case in cases
            test_hydrogenic_slater_integrals!(data, tests, eq, case...)
        end
    end

    println("Orbital energies pre-optimization:")
    pass = Highlighter((data,i,j) -> j == 8 && data[i,j], bold = true, foreground = :green)
    fail = Highlighter((data,i,j) -> j == 8 && !data[i,j], bold = true, foreground = :red)
    pretty_table(vcat(data...), ["Orbital", "Term", "Expected", "Expected", "Actual", "Error", "Relative error", "Pass"],
                 highlighters=(pass,fail))
    do_test || return
    for test in tests
        @eval @test $test
    end
end


module QuasiNewtonMethods

using StrideArrays, LoopVectorization, VectorizationBase

using VectorizationBase: gep
using StrideArrays: PtrArray, StrideArray

function logdensity end
function ∂logdensity! end

export optimize!

abstract type AbstractProbabilityModel{D} end# <: LogDensityProblems.AbstractLogDensityProblem end
dimension(::AbstractProbabilityModel{D}) where {D} = StaticInt{D}()
Base.length(::AbstractProbabilityModel{D}) where {D} = D
function Base.show(io::IO, ℓ::AbstractProbabilityModel{D}) where {D}
    print(io, "$D-dimensional Probability Model")
end

function update_state!(s, x_old, α)
    @avx for i ∈ eachindex(s)
        sᵢ = α * s[i]
        s[i] = sᵢ
        x_old[i] += sᵢ
    end
end

"""

Updates B⁻¹ and sets yₖ as the new search direction.
"""
function BFGS_update!(B⁻¹::AbstractMatrix{T}, B⁻¹yₖ, yₖ, sₖ, ∇_new, ∇_old) where {T}
    sₖᵀyₖ = zero(T)
    @avx for i ∈ eachindex(sₖ)
        # yₖᵢ = ∇_new[i] - ∇_old[i]
        yₖᵢ = ∇_old[i] - ∇_new[i]
        sₖᵀyₖ += sₖ[i] * yₖᵢ
        yₖ[i] = yₖᵢ
    end
    sₖᵀyₖ⁻¹ = inv(sₖᵀyₖ)
    yₖᵀB⁻¹yₖ = zero(T)
    @avx for c ∈ axes(B⁻¹,2)
        t = zero(yₖᵀB⁻¹yₖ)
        for r ∈ axes(B⁻¹,1)
            # t += yₖ[r] * B⁻¹[r,c]
            t += yₖ[r] * B⁻¹[c,r]
        end
        B⁻¹yₖ[c] = t * sₖᵀyₖ⁻¹
        yₖᵀB⁻¹yₖ += t * yₖ[c]
    end
    # c₁ = (one(T) + yₖᵀB⁻¹yₖ * sₖᵀyₖ⁻¹) * sₖᵀyₖ⁻¹
    c₁ = muladd(yₖᵀB⁻¹yₖ, sₖᵀyₖ⁻¹, one(T)) * sₖᵀyₖ⁻¹
    m = zero(T)
    @avx for c ∈ axes(B⁻¹,2)
        sₙ = zero(eltype(yₖ))
        for r ∈ axes(B⁻¹,1)
            # B⁻¹ᵣ = B⁻¹[r,c] + c₁ * sₖ[r] * sₖ[c] - B⁻¹yₖ[r]*sₖ[c] - B⁻¹yₖ[c]*sₖ[r]
            # B⁻¹[r,c] = B⁻¹ᵣ
            B⁻¹ᵣ = B⁻¹[c,r] + c₁ * sₖ[r] * sₖ[c] - B⁻¹yₖ[r]*sₖ[c] - B⁻¹yₖ[c]*sₖ[r]
            B⁻¹[c,r] = B⁻¹ᵣ
            sₙ += B⁻¹ᵣ * ∇_new[r]
        end
        yₖ[c] = sₙ
        m += sₙ * ∇_new[c]
    end
    m
end

struct BackTracking{O}
    c₁::Float64
    ρₕ::Float64
    ρₗ::Float64
    iterations::Int
end
# BackTracking{O}(c₁ = 1e-4, ρₕ = 0.5, ρₗ = 0.1, iterations = 1_000) where {O} = BackTracking{O}(c₁, ρₕ, ρₗ, iterations)
BackTracking{O}(c₁ = 1e-4, ρₕ = 0.5, ρₗ = 0.1) where {O} = BackTracking{O}(c₁, ρₕ, ρₗ, 1_000)
BackTracking(c₁ = 1e-4, ρₕ = 0.5, ρₗ = 0.1, iterations = 1_000) = BackTracking{2}(c₁, ρₕ, ρₗ, iterations)

abstract type AbstractBFGSState{P,T,L,LT} end

mutable struct BFGSState{P,T,L,LT} <: AbstractBFGSState{P,T,L,LT}
    x_old::NTuple{L,T}
    ∇_new::NTuple{L,T}
    x_new::NTuple{L,T}
    ∇_old::NTuple{L,T}
    y::NTuple{L,T}
    s::NTuple{L,T}
    B⁻¹y::NTuple{L,T}
    B⁻¹::NTuple{LT,T}
    function BFGSState{P,T,L,LT}(::UndefInitializer) where {P,T,L,LT}
        new{P,T,L,LT}()
    end
    @generated function BFGSState{P}(::UndefInitializer) where {P}
        L =  VectorizationBase.align(P,VectorizationBase.pick_vector_width(Float64))
        :(BFGSState{$P,Float64,$L,$(P*L)}(undef))
    end
    @generated function BFGSState{P,T}(::UndefInitializer) where {P,T}
        L =  VectorizationBase.align(P,VectorizationBase.pick_vector_width(T))
        :(BFGSState{$P,$T,$L,$(P*L)}(undef))
    end
end
BFGSState(::Val{P}, ::Type{T} = Float64) where {P,T} = BFGSState{P,T}(undef)
@inline Base.pointer(s::BFGSState{P,T})  where {P,T} = Base.unsafe_convert(Ptr{T}, pointer_from_objref(s))

function VectorizationBase.lifetime_start!(state::AbstractBFGSState{P,T,L}) where {P,T,L}
    nothing
    # VectorizationBase.lifetime_start!(pointer(ref_x_new(state)), Val(VectorizationBase.staticmul(T, StaticInt{L}()*(StaticInt{5}()+StaticInt{L}()))))
end
function VectorizationBase.lifetime_end!(state::AbstractBFGSState{P,T,L}) where {P,T,L}
    nothing
    # VectorizationBase.lifetime_end!(pointer(ref_x_new(state)), Val(VectorizationBase.staticmul(T, StaticInt{L}()*(StaticInt{5}()+StaticInt{L}()))))
end

struct PtrBFGSState{P,T,L,LT,NI<:Union{Int,Nothing}} <: AbstractBFGSState{P,T,L,LT}
    ptr::Ptr{T}
    offset::NI
end
@inline Base.pointer(state::PtrBFGSState) = state.ptr

@inline function dense_vector(ptr::Ptr{T}, ::StaticInt{P}) where {T,P}
    PtrArray(ptr, (StaticInt{P}(),), (VectorizationBase.static_sizeof(T),), Val{(true,)}())
end
@inline function square_matrix(ptr::Ptr{T}, ::StaticInt{P}, ::StaticInt{X}) where {T,P,X}
    st = VectorizationBase.static_sizeof(T)
    PtrArray(ptr, (StaticInt{P}(),StaticInt{P}()), (st,st*StaticInt{X}()), Val{(true,false)}())
end
@inline function square_matrix(ptr::Ptr{T}, ::StaticInt{P}, ::StaticInt{P}) where {T,P}
    st = VectorizationBase.static_sizeof(T)
    PtrArray(ptr, (StaticInt{P}(),StaticInt{P}()), (st,st*StaticInt{P}()), Val{(true,true)}())
end

@inline ref_x_old(s::AbstractBFGSState{P,T,L,LT}) where {P,T,L,LT} = dense_vector(pointer(s), StaticInt{P}())
@inline ref_∇_old(s::AbstractBFGSState{P,T,L,LT}) where {P,T,L,LT} = dense_vector(gep(pointer(s), fieldoffset(BFGSState{P,T,L,LT}, 4)), StaticInt{P}())
@inline ref_x_new(s::AbstractBFGSState{P,T,L,LT}) where {P,T,L,LT} = dense_vector(gep(pointer(s), fieldoffset(BFGSState{P,T,L,LT}, 3)), StaticInt{P}())
@inline ref_∇_new(s::AbstractBFGSState{P,T,L,LT}) where {P,T,L,LT} = dense_vector(gep(pointer(s), fieldoffset(BFGSState{P,T,L,LT}, 2)), StaticInt{P}())
@inline ref_y(s::AbstractBFGSState{P,T,L,LT}) where {P,T,L,LT} = dense_vector(gep(pointer(s), fieldoffset(BFGSState{P,T,L,LT}, 5)), StaticInt{P}())
@inline ref_s(s::AbstractBFGSState{P,T,L,LT}) where {P,T,L,LT} = dense_vector(gep(pointer(s), fieldoffset(BFGSState{P,T,L,LT}, 6)), StaticInt{P}())
@inline ref_B⁻¹y(s::AbstractBFGSState{P,T,L,LT}) where {P,T,L,LT} = dense_vector(gep(pointer(s), fieldoffset(BFGSState{P,T,L,LT}, 7)), StaticInt{P}())
@inline ref_B⁻¹(s::AbstractBFGSState{P,T,L,LT}) where {P,T,L,LT} = square_matrix(gep(pointer(s), fieldoffset(BFGSState{P,T,L,LT}, 8)), StaticInt{P}(), StaticInt{L}())

function initial_B⁻¹!(B⁻¹::AbstractMatrix)
    @avx for c ∈ axes(B⁻¹,2), r ∈ axes(B⁻¹,1)
        B⁻¹[r,c] = (r == c)
    end
end
@inline optimum(s::AbstractBFGSState) = ref_x_old(s)
@inline gradient(s::AbstractBFGSState) = ref_∇_new(s)

nanmin(a, b) = a < b ? a : (isnan(b) ? a : b)
nanmax(a, b) = a < b ? b : (isnan(a) ? b : a)

sqrttolerance(::Type{T}) where {T} = T(1 / (1 << (Base.Math.significand_bits(T) >> 1)))

function step!(x_new, x_old, s, obj, α)
    @avx for i ∈ eachindex(x_new)
        x_new[i] = x_old[i] + α*s[i]
    end
    logdensity(obj, x_new)
end

function linesearch!(x_new::AbstractVector{T}, x_old, s, obj, ℓ₀, m, ls::BackTracking{order}) where {T, order}
    c₁, ρₕ, ρₗ, iterations = T(ls.c₁), T(ls.ρₕ), T(ls.ρₗ), ls.iterations
    sqrttol = sqrttolerance(T)

    α₀ = one(T)

    # Count the total number of iterations
    ℓx₀, ℓx₁ = ℓ₀, ℓ₀
    α₁, α₂ = α₀, α₀
    ℓx₁ = step!(x_new, x_old, s, obj, α₁)

    # Hard-coded backtrack until we find a finite function value
    # Halve α₂ until function value is finite
    iterfinite = 0
    iterfinitemax = Base.Math.significand_bits(T)
    while !isfinite(ℓx₁) && iterfinite < iterfinitemax
        iterfinite += 1
        α₁, α₂ = (α₂, Base.FastMath.mul_fast(T(0.5), α₂))
        ℓx₁ = step!(x_new, x_old, s, obj, α₂)
    end
    iteration = 0
    # Backtrack until we satisfy sufficient decrease condition
    while !(ℓx₁ ≥ @fastmath(ℓ₀ + α₂*c₁*m))
        # @show α₂, ℓx₁, ℓ₀ + α₂*c₁*m, ℓ₀, α₂, c₁, m
        # Increment the number of steps we've had to perform
        iteration += 1

        # Ensure termination
        iteration > iterations && return zero(T) # linesearch_failure(iterations)

        # Shrink proposed step-size:
        if order == 2 || iteration == 1
            # backtracking via quadratic interpolation:
            # This interpolates the available data
            #    f(0), f'(0), f(α)
            # with a quadractic which is then minimised; this comes with a
            # guaranteed backtracking factor 0.5 * (1-c_1)^{-1} which is < 1
            # provided that c_1 < 1/2; the backtrack_condition at the beginning
            # of the function guarantees at least a backtracking factor ρ.
            # https://github.com/JuliaNLSolvers/LineSearches.jl/blob/0c182ce25c32a385a6156304dc24ff72afbfa308/src/backtracking.jl#L84
            αₜ = @fastmath - (m * α₂*α₂) / ( T(2) * (ℓx₁ - ℓ₀ - m*α₂) )
        else
            denom = @fastmath one(T) / (α₁*α₁ * α₂*α₂ * (α₂ - α₁))
            a = @fastmath (α₁*α₁*(ℓx₁ - ℓ₀ - m*α₂) - α₂*α₂*(ℓx₀ - ℓ₀ - m*α₁))*denom
            b = @fastmath (-α₁*α₁*α₁*(ℓx₁ - ℓ₀ - m*α₂) + α₂*α₂*α₂*(ℓx₀ - ℓ₀ - m*α₁))*denom

            if abs(a) <= eps(T) + sqrttol*abs(a)
                αₜ = @fastmath m / (T(2)*b)
            else
                # discriminant
                d = nanmax(@fastmath(b*b - T(3)*a*m), zero(T))
                # quadratic equation root
                # αₜ = @fastmath (sqrt(d) - b) / (3a)
                αₜ = @fastmath (sqrt(d) + b) / (-3a)
            end
        end
        # @show α₂, ℓx₁, ℓ₀ + α₂*c₁*m, ℓ₀, α₂, c₁, m
        α₁ = α₂

        αₜ = nanmin(αₜ, α₂*ρₕ) # avoid too small reductions
        α₂ = nanmax(αₜ, α₂*ρₗ) # avoid too big reductions

        # Evaluate f(x) at proposed position
        ℓx₀, ℓx₁ = ℓx₁, step!(x_new, x_old, s, obj, α₂)
        # @show α₂, ℓx₁, ℓ₀ + α₂*c₁*m, ℓ₀, α₂, c₁, m
    end
    α₂
end

"""
Optimum value is stored in state.x_old.
"""
function optimize!(state, obj, x::AbstractStrideArray{Tuple{StaticInt{P}},D,T}, ls = BackTracking(), tol = 1e-8) where {P,T,D}
    VectorizationBase.lifetime_start!(state)
    x_old = ref_x_old(state)
    ∇_old = ref_∇_old(state)
    x_new = ref_x_new(state)
    ∇_new = ref_∇_new(state)
    y = ref_y(state)
    s = ref_s(state)
    B⁻¹y = ref_B⁻¹y(state)
    B⁻¹ = ref_B⁻¹(state)
    copyto!(x_old, x)
    # initial_invH!(invH)
    N = 1000
    # f_calls = 0
    # g_calls = 0
    for n ∈ 1:N
        ℓ₀ = ∂logdensity!(∇_new, obj, x_old)#; f_calls +=1; g_calls +=1;
        Base.isfinite(ℓ₀) || break
        # @show (n-1), ℓ₀, maximum(abs, ∇_new), tol ∇_new
        if maximum(abs, ∇_new) < tol
            ∇_new_original = ref_∇_new(state)
            pointer(∇_new) == pointer(∇_new_original) || copyto!(∇_new_original, ∇_new)
            VectorizationBase.lifetime_end!(state)
            return ℓ₀
        end
        if isone(n)
            m = -one(T) # reset search direction
        else
            # @assert false
            m = BFGS_update!(B⁻¹, B⁻¹y, y, s, ∇_new, ∇_old)
            s, y = y, s
            # @show B⁻¹ x_old
            # @show pointer(s) - pointer(y)
        end
        if m <= zero(T) # If bad, reset search direction
            initial_B⁻¹!(B⁻¹)
            m = zero(T)
            @avx for i ∈ eachindex(x)
                sᵢ = ∇_new[i]
                s[i] = sᵢ
                m += sᵢ * sᵢ
            end
        end
        # @show s
        #### Perform line search
        α₂ = linesearch!(x_new, x_old, s, obj, ℓ₀, m, ls)
        iszero(α₂) && break
        update_state!(s, x_old, α₂)
        ∇_old, ∇_new = ∇_new, ∇_old
        # isone(n) && (s = ref_s(state))
    end
    VectorizationBase.lifetime_end!(state)
    T(NaN)
end

# include("precompile.jl")
# _precompile_()

end # module


using Test, Random, Zygote, Distributions, SpecialFunctions, FiniteDifferences
import TruncatedNormal as TN

for a = -10:10
    d = truncated(Normal(), a, Inf)
    @test TN.tnmean(a) ≈ mean(d)
    @test TN.tnstd(a)  ≈ std(d)
    @test TN.tnvar(a)  ≈ var(d)
    @test a ≤ TN.tnmean(a) < Inf
    @test 0 ≤ TN.tnvar(a) ≤ 1
end
@test 1e20 ≤ TN.tnmean(1e20) < Inf
@test_broken 0 ≤ TN.tnvar(1e80) ≤ 1

for a = -2:2
    @test mean(TN.randnt'(a) for _ = 1:10^6) ≈ TN.tnmean'(a) rtol=0.1
    z, da = TN.∇randnt(Random.GLOBAL_RNG, a)
    @test da ≈ erfc(z/√2) / erfc(a/√2) * exp((z^2 - a^2)/2)
end

@testset "randnt_half gradient" begin
    for μ = -1:1, σ = 1:2
        dμ_ = mean(gradient(TN.randnt_half, μ, σ)[1] for _ = 1:10^6)
        dσ_ = mean(gradient(TN.randnt_half, μ, σ)[2] for _ = 1:10^6)
        dμ, dσ = gradient(μ, σ) do μ, σ
            μ + σ * TN.tnmean(-μ/σ)
        end
        @test dμ ≈ dμ_ rtol=0.1
        @test dσ ≈ dσ_ rtol=0.1
    end
end

@testset "sqrt1half" begin
    @test TN.sqrt1half(5) ≈ 5.1925824035672520156
    @test TN.sqrt1half(0) == 1
    @test TN.sqrt1half(-1) == TN.sqrt1half(1) ≈ 1.6180339887498948482
    @test isnan(TN.sqrt1half(NaN))
    @test TN.sqrt1half(Inf) == TN.sqrt1half(-Inf) == Inf
    @test TN.sqrt1half(1e300) ≈ 1e300
end

@testset "randnt" begin
    @test TN.randnt(0) > 0
    @test TN.randnt(1e300) == 1e300
    @test TN.randnt(Inf) == Inf
    @test isnan(TN.randnt(NaN))
    @test TN.randnt(floatmax(Float64)) == floatmax(Float64)
end


struct LRTestResult{N}
    nobs::Int
    deviance::NTuple{N, Float64}
    dof::NTuple{N, Int}
    pval::NTuple{N, Float64}
end

_diff(t::NTuple{N}) where {N} = ntuple(i->t[i+1]-t[i], N-1)

"""
    isnested(m1::StatisticalModel, m2::StatisticalModel; atol::Real=0.0)

Indicate whether model `m1` is nested in model `m2`, i.e. whether
`m1` can be obtained by constraining some parameters in `m2`.
Both models must have been fitted on the same data.
"""
function isnested end

"""
    lrtest(mods::StatisticalModel...; atol::Real=0.0)

For each sequential pair of statistical models in `mods...`, perform a likelihood ratio
test to determine if the first one fits significantly better than the next.

A table is returned containing degrees of freedom (DOF),
difference in DOF from the preceding model, deviance, difference in deviance
from the preceding model, and likelihood ratio and p-value for the comparison
between the two models.

Optional keyword argument `atol` controls the numerical tolerance when testing whether
the models are nested.

# Examples

Suppose we want to compare the effects of two or more treatments on some result.
Our null hypothesis is that `Result ~ 1` fits the data as well as
`Result ~ 1 + Treatment`.

```jldoctest
julia> using DataFrames, GLM

julia> dat = DataFrame(Result=[1, 0, 1, 1, 1, 0, 0, 0, 1, 0, 1, 1],
                       Treatment=[1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2],
                       Other=categorical([1, 1, 2, 1, 2, 1, 3, 1, 1, 2, 2, 1]));

julia> nullmodel = glm(@formula(Result ~ 1), dat, Binomial(), LogitLink());

julia> model = glm(@formula(Result ~ 1 + Treatment), dat, Binomial(), LogitLink());

julia> bigmodel = glm(@formula(Result ~ 1 + Treatment + Other), dat, Binomial(), LogitLink());

julia> lrtest(nullmodel, model, bigmodel)
┌ Warning: Could not check whether models are nested as model type TableRegressionModel does not implement isnested: results may not be meaningful
└ @ StatsModels ~/.julia/dev/StatsModels/src/lrtest.jl:108
Likelihood-ratio test: 3 models fitted on 12 observations
──────────────────────────────────────────────
     DOF  ΔDOF  Deviance  ΔDeviance  p(>Chisq)
──────────────────────────────────────────────
[1]    1         16.3006
[2]    2     1   15.9559    -0.3447     0.5571
[3]    4     2   14.0571    -1.8988     0.3870
──────────────────────────────────────────────

julia> lrtest(bigmodel, model, nullmodel)
┌ Warning: Could not check whether models are nested as model type TableRegressionModel does not implement isnested: results may not be meaningful
└ @ StatsModels ~/.julia/dev/StatsModels/src/lrtest.jl:108
Likelihood-ratio test: 3 models fitted on 12 observations
──────────────────────────────────────────────
     DOF  ΔDOF  Deviance  ΔDeviance  p(>Chisq)
──────────────────────────────────────────────
[1]    4         14.0571
[2]    2    -2   15.9559     1.8988     0.3870
[3]    1    -1   16.3006     0.3447     0.5571
──────────────────────────────────────────────
```
"""
function lrtest(mods::StatisticalModel...; atol::Real=0.0)
    if length(mods) < 2
        throw(ArgumentError("At least two models are needed to perform LR test"))
    end
    T = typeof(mods[1])
    df = dof.(mods)
    forward = df[1] <= df[2]
    if !all(m -> typeof(m) == T, mods)
        throw(ArgumentError("LR test is only valid for models of the same type"))
    end
    if !all(==(nobs(mods[1])), nobs.(mods))
        throw(ArgumentError("LR test is only valid for models fitted on the same data, " *
                            "but number of observations differ"))
    end
    checknested = hasmethod(isnested, Tuple{T, T})
    if forward
        for i in 2:length(mods)
            if df[i-1] >= df[i] ||
                (checknested && !isnested(mods[i-1], mods[i], atol=atol))
                throw(ArgumentError("LR test is only valid for nested models"))
            end
        end
    else
        for i in 2:length(mods)
            if df[i] >= df[i-1] ||
                (checknested && !isnested(mods[i], mods[i-1], atol=atol))
                throw(ArgumentError("LR test is only valid for nested models"))
            end
        end
    end
    if !checknested
        @warn "Could not check whether models are nested as model type " *
            "$(nameof(T)) does not implement isnested: results may not be meaningful"
    end

    dev = deviance.(mods)
    Δdev = _diff(dev)

    Δdf = _diff(df)
    dfr = Int.(dof_residual.(mods))

    if (forward && any(x -> x > 0, Δdev)) || (!forward && any(x -> x < 0, Δdev))
        throw(ArgumentError("Residual deviance must be strictly lower " *
                            "in models with more degrees of freedom"))
    end

    pval = (NaN, chisqccdf.(abs.(Δdf), abs.(Δdev))...)
    return LRTestResult(Int(nobs(mods[1])), dev, df, pval)
end

function Base.show(io::IO, lrr::LRTestResult{N}) where N
    Δdf = _diff(lrr.dof)
    Δdev = _diff(lrr.deviance)

    nc = 6
    nr = N
    outrows = Matrix{String}(undef, nr+1, nc)

    outrows[1, :] = ["", "DOF", "ΔDOF", "Deviance", "ΔDeviance", "p(>Chisq)"]

    outrows[2, :] = ["[1]", @sprintf("%.0d", lrr.dof[1]), " ",
                     @sprintf("%.4f", lrr.deviance[1]), " ", " "]

    for i in 2:nr
        outrows[i+1, :] = ["[$i]", @sprintf("%.0d", lrr.dof[i]),
                           @sprintf("%.0d", Δdf[i-1]),
                           @sprintf("%.4f", lrr.deviance[i]), @sprintf("%.4f", Δdev[i-1]),
                           string(StatsBase.PValue(lrr.pval[i])) ]
    end
    colwidths = length.(outrows)
    max_colwidths = [maximum(view(colwidths, :, i)) for i in 1:nc]
    totwidth = sum(max_colwidths) + 2*5

    println(io, "Likelihood-ratio test: $N models fitted on $(lrr.nobs) observations")
    println(io, '─'^totwidth)

    for r in 1:nr+1
        for c in 1:nc
            cur_cell = outrows[r, c]
            cur_cell_len = length(cur_cell)

            padding = " "^(max_colwidths[c]-cur_cell_len)
            if c > 1
                padding = "  "*padding
            end

            print(io, padding)
            print(io, cur_cell)
        end
        print(io, "\n")
        r == 1 && println(io, '─'^totwidth)
    end
    print(io, '─'^totwidth)
end


### A Pluto.jl notebook ###
# v0.12.21

using Markdown
using InteractiveUtils

# ╔═╡ 9820cc3a-fe50-11ea-3fb6-991358edb7ff
using Pkg, DrWatson

# ╔═╡ 98210cc2-fe50-11ea-0fec-cfe81a89d0cb
begin
  using Distributions
  using StatsPlots
  using StatsBase
  using LaTeXStrings
  using CSV
  using DataFrames
  using LinearAlgebra
  using Random
	using StanSample, GLM
	using StatisticalRethinking
end

# ╔═╡ c5f141c2-fe4f-11ea-03d2-e5eb5d2349f6
md"## Clip-09-30s.jl"

# ╔═╡ 9831d8b8-fe50-11ea-38fd-c99a2b5fd0bc
md"### Snippet 6.1"

# ╔═╡ 98328740-fe50-11ea-3008-27d3dda98cd2
begin
	N = 100
	df = DataFrame(
		height = rand(Normal(10, 2), N),
		leg_prop = rand(Uniform(0.4, 0.5), N),
	)
	df.leg_left = df.leg_prop .* df.height + rand(Normal(0, 0.02), N)
	df.leg_right = df.leg_prop .* df.height + rand(Normal(0, 0.02), N)
end;

# ╔═╡ 9842396a-fe50-11ea-217d-2bba5fa44fb5
md"### Snippet 6.2"

# ╔═╡ 9842dbb8-fe50-11ea-158e-cbc2873c64bd
stan6_1 = "
data {
  int <lower=1> N;
  vector[N] H;
  vector[N] LL;
  vector[N] LR;
}
parameters {
  real a;
  real bL;
  real bR;
  real <lower=0> sigma;
}
model {
  vector[N] mu;
  mu = a + bL * LL + bR * LR;
  a ~ normal(10, 100);
  bL ~ normal(2, 10);
  bR ~ normal(2, 10);
  sigma ~ exponential(1);
  H ~ normal(mu, sigma);
}
";

# ╔═╡ 239f66a6-840f-11eb-3858-a3ae035d21f7
stan6_2 = "
data {
  int <lower=1> N;
  vector[N] H;
  vector[N] LL;
  vector[N] LR;
}
parameters {
  real a;
  real bL;
  real <lower=0> bR;
  real <lower=0> sigma;
}
model {
  vector[N] mu;
  mu = a + bL * LL + bR * LR;
  a ~ normal(10, 100);
  bL ~ normal(2, 10);
  bR ~ normal(2, 10);
  sigma ~ exponential(1);
  H ~ normal(mu, sigma);
}
";

# ╔═╡ 9851b4a8-fe50-11ea-083b-17e3c182a55a
begin
	m6_1s = SampleModel("m6.1s", stan6_1,
		method=StanSample.Sample(num_samples=1000))
	data = (H = df.height, LL = df.leg_left, LR = df.leg_right, N = size(df, 1))
	rc6_1s = stan_sample(m6_1s; data)
	if success(rc6_1s)
		post6_1s_df = read_samples(m6_1s, :dataframe)
	end
	m6_2s = SampleModel("m6.2s", stan6_2,
		method=StanSample.Sample(num_samples=1000))
	rc6_2s = stan_sample(m6_2s; data)

	if success(rc6_2s)
		post6_2s_df = read_samples(m6_2s, :dataframe)
	end
end;

# ╔═╡ 64b0dad4-8410-11eb-1986-815525832db2
md"
```
rethinking simulation:
> precis(m5.8s)
      mean   sd  5.5% 94.5% n_eff Rhat4
a     0.97 0.29  0.52  1.43  1034     1
bl    0.18 2.52 -3.90  4.18   532     1
br    1.81 2.53 -2.18  5.94   530     1
sigma 0.64 0.05  0.57  0.71  1100     1
> precis(m5.8s2)
       mean   sd  5.5% 94.5% n_eff Rhat4
a      0.95 0.29  0.48  1.42   479  1.02
bl    -1.13 2.06 -4.65  1.75   377  1.00
br     3.13 2.06  0.28  6.64   379  1.00
sigma  0.64 0.04  0.57  0.71   773  1.00
```
"

# ╔═╡ 81b75f90-8410-11eb-3910-396d9d0ebdeb
success(rc6_1s) && PRECIS(post6_1s_df)

# ╔═╡ 4903312c-840f-11eb-0973-a91f30c64a1a
success(rc6_2s) && PRECIS(post6_2s_df)

# ╔═╡ 6aac1dd2-840f-11eb-1e9c-6392658b0a67
if success(rc6_1s) && success(rc6_2s)
	(s2, p2) = plot_model_coef([m6_1s, m6_2s], [:a, :bL, :bR, :sigma];
		title="Multicollinearity between bL and bR, bR > 0")
	p2
end

# ╔═╡ ebb2b764-8418-11eb-06d9-53ff20d9a4bb
trankplot(m6_1s, :bL)[1]

# ╔═╡ 297c0caa-8419-11eb-2842-1d9dcab60688
trankplot(m6_2s, :bL)[1]

# ╔═╡ 9862bdb4-fe50-11ea-1402-bbac3257c25d
md"## End of clip-06-02-06s.jl"

# ╔═╡ Cell order:
# ╟─c5f141c2-fe4f-11ea-03d2-e5eb5d2349f6
# ╠═9820cc3a-fe50-11ea-3fb6-991358edb7ff
# ╠═98210cc2-fe50-11ea-0fec-cfe81a89d0cb
# ╟─9831d8b8-fe50-11ea-38fd-c99a2b5fd0bc
# ╠═98328740-fe50-11ea-3008-27d3dda98cd2
# ╟─9842396a-fe50-11ea-217d-2bba5fa44fb5
# ╠═9842dbb8-fe50-11ea-158e-cbc2873c64bd
# ╠═239f66a6-840f-11eb-3858-a3ae035d21f7
# ╠═9851b4a8-fe50-11ea-083b-17e3c182a55a
# ╟─64b0dad4-8410-11eb-1986-815525832db2
# ╠═81b75f90-8410-11eb-3910-396d9d0ebdeb
# ╠═4903312c-840f-11eb-0973-a91f30c64a1a
# ╠═6aac1dd2-840f-11eb-1e9c-6392658b0a67
# ╠═ebb2b764-8418-11eb-06d9-53ff20d9a4bb
# ╠═297c0caa-8419-11eb-2842-1d9dcab60688
# ╟─9862bdb4-fe50-11ea-1402-bbac3257c25d