"""
    OptSummary

Summary of an `NLopt` optimization

# Members
* `initial`: a copy of the initial parameter values in the optimization
* `final`: a copy of the final parameter values from the optimization
* `fmin`: the final value of the objective
* `feval`: the number of function evaluations
* `optimizer`: the name of the optimizer used, as a `Symbol`
"""
type OptSummary
    initial::Vector{Float64}
    final::Vector{Float64}
    fmin::Float64
    feval::Int
    optimizer::Symbol
end
function OptSummary(initial::Vector{Float64}, optimizer::Symbol)
    OptSummary(initial, initial, Inf, -1, optimizer)
end

"""
    LinearMixedModel

Linear mixed-effects model representation

# Members
* `formula`: the formula for the model
* `mf`: the model frame, mostly used to get the `terms` component for labelling fixed effects
* `wttrms`: a length `nt` vector of weighted model matrices. The last two elements are `X` and `y`.
* `trms`: a vector of unweighted model matrices.  If `isempty(sqrtwts)` the same object as `wttrms`
* `Λ`: a length `nt - 2` vector of lower triangular matrices
* `sqrtwts`: the `Diagonal` matrix of the square roots of the case weights.  Allowed to be size 0
* `A`: an `nt × nt` symmetric matrix of matrices representing `hcat(Z,X,y)'hcat(Z,X,y)`
* `R`: a `nt × nt` matrix of matrices - the upper Cholesky factor of `Λ'AΛ+I`
* `opt`: an [`OptSummary`](@ref) object
"""
type LinearMixedModel{T <: AbstractFloat} <: MixedModel
    formula::Formula
    mf::ModelFrame
    wttrms::Vector
    trms::Vector
    sqrtwts::Diagonal{T}
    Λ::Vector{LowerTriangular{T, Matrix{T}}}
    A::Matrix{Any}        # symmetric cross-product blocks (upper triangle)
    R::Matrix{Any}        # right Cholesky factor in blocks.
    opt::OptSummary
end

"""
    densify(S::SparseMatrix, threshold=0.3)

Convert sparse `S` to `Diagonal` if `S` is diagonal or to `full(S)` if
the proportion of nonzeros exceeds `threshold`.
"""
function densify(S::SparseMatrixCSC, threshold::Real = 0.3)
    m,n = size(S)
    if m == n && isdiag(S)  # convert diagonal sparse to Diagonal
        return Diagonal(diag(S))
    end
    if nnz(S)/(*(size(S)...)) ≤ threshold # very sparse matrices left as is
        return S
    end
    if isbits(eltype(S))
        return full(S)
    end
    # densify a sparse matrix whose elements are arrays of bitstypes
    nzs = nonzeros(S)
    nz1 = nzs[1]
    T = typeof(nz1)
    if !isa(nz1, Array) || !isbits(eltype(nz1)) # branch not tested
        error("Nonzeros must be a bitstype or an array of same")
    end
    sz1 = size(nz1)
    if any(x->typeof(x) ≠ T || size(x) ≠ sz1, nzs) # branch not tested
        error("Inconsistent dimensions or types in array nonzeros")
    end
    M,N = size(S)
    m,n = size(nz1, 1), size(nz1, 2) # this construction allows for nz1 to be a vector
    res = Array(eltype(nz1), M * m, N * n)
    rv = rowvals(S)
    for j in 1:size(S,2)
        for k in nzrange(S, j)
            copy!(Compat.view(res, (rv[k] - 1) * m + (1 : m), (j - 1) * n + (1 : n)), nzs[k])
        end
    end
    res
end
densify(A::AbstractMatrix, threshold::Real = 0.3) = A

function LinearMixedModel(f, mf, trms, Λ, wts)
    n = size(trms[1], 1)
    T = eltype(trms[end])
    optsum = OptSummary(mapreduce(x -> getθ(x), vcat, Λ), :None)
    sqrtwts = Diagonal([sqrt(x) for x in wts])
    wttrms =  isempty(sqrtwts) ? trms :
        size(sqrtwts, 2) == n ? [sqrtwts * t for t in trms] :
        throw(DimensionMismatch("length(wts) must be 0 or length(y)"))
    nt = length(trms)
    A, R = Array{Any}(nt, nt), Array{Any}(nt, nt)
    for j in 1 : nt, i in 1 : j
        A[i, j] = densify(wttrms[i]'wttrms[j])
        R[i, j] = copy(A[i, j])
    end
    for j in 2 : nt
        if isa(R[j, j], Diagonal) || isa(R[j, j], HBlkDiag)
            for i in 1 : (j - 1)     # check for fill-in
                if !isdiag(A[i, j]'A[i, j])
                    for k in j : nt
                        R[j, k] = full(R[j, k])
                    end
                end
            end
        end
    end
    LinearMixedModel(f, mf, wttrms, trms, sqrtwts, Λ, A, R, optsum)
end

"""
    lmm(f::DataFrames.Formula, fr::DataFrames.DataFrame; weights = [])

Create a [`LinearMixedModel`](@ref) from `f`, which contains both fixed-effects terms
and random effects, and `fr`.

The return value is ready to be `fit!` but has not yet been fit.
"""
function lmm(f::Formula, fr::AbstractDataFrame; weights::Vector = [])
    mf = ModelFrame(f, fr)
    X = ModelMatrix(mf)
    T = eltype(X.m)                                       # process the random-effects terms
    retrms = filter(x -> Meta.isexpr(x, :call) && x.args[1] == :|, mf.terms.terms)
    if isempty(retrms)
        throw(ArgumentError("$f has no random-effects terms"))
    end
    trms = Any[remat(e, mf.df) for e in retrms]
    if length(trms) > 1
        nl = [nlevs(t) for t in trms]
        trms = trms[sortperm(nl; rev = true)]
    end
    Λ = LowerTriangular{T, Matrix{T}}[LT(t) for t in trms]
    push!(trms, X.m)
    push!(trms, reshape(convert(Vector{T}, DataFrames.model_response(mf)), (size(X, 1), 1)))
    LinearMixedModel(f, mf, trms, Λ, convert(Vector{T}, weights))
end

function cfactor!(m::LinearMixedModel)
    A, Λ, R = m.A, m.Λ, m.R
    n = size(A, 1)
    for j in 1 : n, i in 1 : j
        inject!(R[i, j], A[i, j])
    end
    for i in eachindex(m.Λ)
        for j in i : n
            tscale!(Λ[i], R[i, j])
        end
        for ii in 1:i
            tscale!(R[ii,i], Λ[i])
        end
        inflate!(R[i, i])
    end
    cfactor!(R)
    m
end

StatsBase.coef(m::LinearMixedModel) = fixef(m)

"""
    fit!(m::LinearMixedModel[, verbose::Bool=false[, optimizer::Symbol=:LN_BOBYQA]])

Optimize the objective of a `LinearMixedModel`.

A value for `optimizer` should be the name of an `NLopt` derivative-free optimizer
allowing for box constraints.
"""
function StatsBase.fit!(m::LinearMixedModel, verbose::Bool=false, optimizer::Symbol=:LN_BOBYQA)
    th = getθ(m)
    k = length(th)
    opt = NLopt.Opt(optimizer, k)
    NLopt.ftol_rel!(opt, 1e-12)   # relative criterion on deviance
    NLopt.ftol_abs!(opt, 1e-8)    # absolute criterion on deviance
    NLopt.xtol_abs!(opt, 1e-10)   # criterion on parameter value changes
    NLopt.lower_bounds!(opt, lowerbd(m))
    feval = 0
    function obj(x::Vector{Float64}, g::Vector{Float64})
        length(g) == 0 || error("gradient not defined")
        feval += 1
        setθ!(m, x) |> cfactor! |> objective
    end
    if verbose
        function vobj(x::Vector{Float64}, g::Vector{Float64})
            length(g) == 0 || error("gradient not defined")
            feval += 1
            val = setθ!(m, x) |> cfactor! |> objective
            print("f_$feval: $(round(val, 5)), [")
            showcompact(x[1])
            for i in 2:length(x) print(","); showcompact(x[i]) end
            println("]")
            val
        end
        NLopt.min_objective!(opt, vobj)
    else
        NLopt.min_objective!(opt, obj)
    end
    fmin, xmin, ret = NLopt.optimize(opt, th)
    ## very small parameter values often should be set to zero
    xmin1 = copy(xmin)
    modified = false
    for i in eachindex(xmin1)
        if 0. < abs(xmin1[i]) < 0.001
            modified = true
            xmin1[i] = 0.
        end
    end
    if modified  # branch not tested
        ff = setθ!(m, xmin1) |> cfactor! |> objective
        if ff ≤ (fmin + 1.e-5)  # zero components if increase in objective is negligible
            fmin = ff
            copy!(xmin, xmin1)
        else
            setθ!(m, xmin) |> cfactor!
        end
    end
    m.opt = OptSummary(th, xmin, fmin, feval, optimizer)
    if verbose
        println(ret)
    end
    m
end

"""
    lowerbd(m::LinearMixedModel)

Return the vector of lower bounds on the covariance parameter vector `θ`
"""
lowerbd(m::LinearMixedModel) = mapreduce(lowerbd, vcat, m.Λ)

"""
    objective(m::LinearMixedModel)

Return negative twice the log-likelihood of model `m`
"""
objective(m::LinearMixedModel) = logdet(m) + nobs(m) * (1 + log2π + log(varest(m)))

"""
    fixef!{T}(v::Vector{T}, m::LinearMixedModel{T})

Overwrite `v` with the fixed-effects coefficients of model `m`
"""
function fixef!{T}(v::AbstractVector{T}, m::LinearMixedModel{T})
    if !isfit(m)
        throw(ArgumentError("Model m has not been fit"))
    end
    A_ldiv_B!(feR(m), copy!(v, m.R[end - 1, end]))
end

"""
    fixef(m::MixedModel)

Returns the fixed-effects parameter vector estimate.
"""
fixef{T}(m::LinearMixedModel{T}) = fixef!(Array(T, (size(m)[2],)), m)

StatsBase.df(m::LinearMixedModel) = size(m.wttrms[end - 1], 2) + sum(A -> nlower(A), m.Λ) + 1

StatsBase.loglikelihood(m::LinearMixedModel) = -deviance(m)/2

StatsBase.nobs(m::LinearMixedModel) = Int(length(m.trms[end]))

function Base.size(m::LinearMixedModel)
    k = length(m.Λ)
    trms = m.wttrms
    q = sum([size(trms[j], 2) for j in 1:k])
    n, p = size(trms[k + 1])
    n, p, q, k
end

"""
    sdest(m::LinearMixedModel)

Return the estimate of σ, the standard deviation of the per-observation noise.
"""
sdest{T}(m::LinearMixedModel{T}) = T(sqrtpwrss(m)/√nobs(m))

"""
    setθ!{T}(m::LinearMixedModel{T}, v::Vector{T})

Install `v` as the θ parameters in `m`.  Changes `m.Λ` only.
"""
function setθ!{T}(m::LinearMixedModel{T}, v::Vector{T})
    Λ = m.Λ
    offset = 0
    for i in eachindex(Λ)
        λ = Λ[i]
        nti = nlower(λ)
        setθ!(λ, Compat.view(v, offset + (1 : nti)))
        offset += nti
    end
    if length(v) ≠ offset
        throw(DimensionMismatch("length(v) = $(length(v)), should be $offset"))
    end
    m
end

"""
    sqrtpwrss(m::LinearMixedModel)

Return the square root of the penalized, weighted residual sum-of-squares (pwrss).

This value is the contents of the `1 × 1` bottom right block of `m.R`
"""
sqrtpwrss{T}(m::LinearMixedModel{T}) = T(m.R[end,end][1])

"""
    varest(m::LinearMixedModel)

Returns the estimate of σ², the variance of the conditional distribution of Y given B.
"""
varest{T}(m::LinearMixedModel{T}) = T(pwrss(m)/nobs(m))

"""
    pwrss(m::LinearMixedModel)

The penalized residual sum-of-squares.
"""
pwrss(m::LinearMixedModel) = abs2(sqrtpwrss(m))

"""
    chol2cor(L::LowerTriangular)

Return the correlation matrix (symmetric, positive definite with unit diagonal)
corresponding to `L * L'`.
"""
function chol2cor(L::LowerTriangular)
    size(L, 1) == 1 && return ones(1, 1)
    res = L * L'
    d = [inv(sqrt(res[i, i])) for i in 1:size(res, 1)]
    scale!(d, scale!(res, d))
end

Base.cor(m::LinearMixedModel) = map(chol2cor, m.Λ)

function StatsBase.deviance(m::LinearMixedModel)
    isfit(m) || error("Model has not been fit")
    objective(m)
end

"""
    isfit(m::LinearMixedModel)

Return a `Bool` indicating if the model has been fit.
"""
isfit(m::LinearMixedModel) = m.opt.fmin < Inf

"""
    lrt(mods::LinearMixedModel...)

Perform sequential likelihood ratio tests on a sequence of models.

The returned value is a `DataFrame` containing information on the likelihood ratio tests.
"""
function lrt(mods::LinearMixedModel...) # not tested
    if (nm = length(mods)) <= 1
        throw(ArgumentError("at least two models are required for a likelihood ratio test"))
    end
    m1 = mods[1]
    n = nobs(m1)
    for i in 2:nm
        if nobs(mods[i]) != n
            throw(ArgumentError("number of observations must be constant across models"))
        end
    end
    mods = mods[sortperm([df(m)::Int for m in mods])]
    degf = Int[df(m) for m in mods]
    dev = [deviance(m)::Float64 for m in mods]
    csqr = unshift!([(dev[i-1]-dev[i])::Float64 for i in 2:nm],NaN)
    pval = unshift!([ccdf(Chisq(degf[i]-degf[i-1]),csqr[i])::Float64 for i in 2:nm],NaN)
    DataFrame(Df = degf, Deviance = dev, Chisq=csqr,pval=pval)
end

"""
    reweight!{T}(m::LinearMixedModel{T}, wts::Vector{T})

Update `m.sqrtwts` from `wts` and `m.wttrms` from `m.trms`.  Recompute `m.A` and `m.R`.
"""
function reweight!{T}(m::LinearMixedModel{T}, weights::Vector{T})
    A, wttrms, trms, sqrtwts = m.A, m.wttrms, m.trms, m.sqrtwts
       # should be able to use map!(sqrt, sqrtwts.diag, weights) but that allocates storage in v0.4
    d = sqrtwts.diag
    if length(weights) ≠ length(d)
        throw(DimensionMismatch("length(weights) = $(length(weights)), should be $(length(d))"))
    end
    for i in eachindex(d)
        d[i] = sqrt(weights[i])
    end
    for j in eachindex(trms)
        A_mul_B!(sqrtwts, copy!(wttrms[j], trms[j]))
    end
    for j in 1 : size(A, 2), i in 1 : j
        Ac_mul_B!(A[i, j], wttrms[i], wttrms[j])
    end
    cfactor!(m)
end

function Base.show(io::IO, m::LinearMixedModel)
    if !isfit(m)
        warn("Model has not been fit")
        return nothing
    end
    n,p,q,k = size(m)
    println(io, "Linear mixed model fit by maximum likelihood")
    println(io, " ", m.formula)
    oo = objective(m)
    nums = showoff([-oo/ 2, oo, aic(m), bic(m)])
    fieldwd = max(maximum(length(nums)) + 2, 11)
    print(' ')
    for label in ["logLik", "-2 logLik", "AIC", "BIC"]
        print(io, Base.cpad(label, fieldwd))
    end
    println(io)
    print(' ')
    for num in nums
        print(io, lpad(num, fieldwd))
    end
    println(io); println(io)

    show(io,VarCorr(m))

    gl = grplevels(m)
    @printf(io," Number of obs: %d; levels of grouping factors: %d", n, gl[1])
    for l in gl[2:end] @printf(io, ", %d", l) end
    println(io)
    @printf(io,"\n  Fixed-effects parameters:\n")
    show(io,coeftable(m))
end

"""
    VarCorr

An encapsulation of information on the fitted random-effects
variance-covariance matrices.

# Members
* `Λ`: the vector of lower triangular matrices from the `MixedModel`
* `fnms`: a `Vector{ASCIIString}` of grouping factor names
* `cnms`: a `Vector{Vector{ASCIIString}}` of column names
* `s`: the estimate of σ, the standard deviation of the per-observation noise

The main purpose of defining this type is to isolate the logic in the show method.
"""
type VarCorr
    Λ::Vector
    fnms::Vector
    cnms::Vector
    s::Float64
    function VarCorr(Λ::Vector, fnms::Vector, cnms::Vector, s::Number)
        length(fnms) == length(cnms) == length(Λ) || throw(DimensionMismatch(""))
        if isfinite(s) && s < 0
            error("s must be non-negative")
        end
        new(Λ, fnms, cnms, s)
    end
end
function VarCorr(m::LinearMixedModel)
    Λ, trms = m.Λ, m.trms
    VarCorr(Λ, [string(trms[i].fnm) for i in eachindex(Λ)],
        [trms[i].cnms for i in eachindex(Λ)], sdest(m))
end

function Base.show(io::IO, vc::VarCorr)
    fnms = isfinite(vc.s) ? vcat(vc.fnms,"Residual") : vc.fnms
    nmwd = maximum(map(strwidth, fnms)) + 1
    write(io, "Variance components:\n")
    stdm = [rowlengths(λ) for λ in vc.Λ]
    cnms = vcat(vc.cnms...)
    if isfinite(vc.s)
        push!(stdm, [1.])
        stdm *= vc.s
        push!(cnms, "")
    end
    cnmwd = max(6, maximum(map(strwidth, cnms))) + 1
    tt = vcat(stdm...)
    vars = showoff(abs2(tt), :plain)
    stds = showoff(tt, :plain)
    varwd = 1 + max(length("Variance"), maximum(map(strwidth, vars)))
    stdwd = 1 + max(length("Std.Dev."), maximum(map(strwidth, stds)))
    write(io, " "^(2+nmwd))
    write(io, Base.cpad("Column", cnmwd))
    write(io, Base.cpad("Variance", varwd))
    write(io, Base.cpad("Std.Dev.", stdwd))
    any(s -> length(s) > 1, stdm) && write(io,"  Corr.")
    println(io)
    cor = [chol2cor(λ) for λ in vc.Λ]
    ind = 1
    for i in 1:length(fnms)
        stdmi = stdm[i]
        write(io, ' ')
        write(io, rpad(fnms[i], nmwd))
        write(io, rpad(cnms[i], cnmwd))
        write(io, lpad(vars[ind], varwd))
        write(io, lpad(stds[ind], stdwd))
        ind += 1
        println(io)
        for j in 2:length(stdmi)
            write(io, " "^(1 + nmwd))
            write(io, rpad(cnms[ind], cnmwd))
            write(io, lpad(vars[ind], varwd))
            write(io, lpad(stds[ind], stdwd))
            ind += 1
            for k in 1:(j-1)
                @printf(io, "%6.2f", cor[i][j, k])
            end
            println(io)
        end
    end
end


module AmbientForcing
include("AmbientForcingODE.jl")
include("RandInitVectors.jl")
export ambient_forcing
export ambient_forcing_problem
export random_force
export idx_exclusive
export constraint_equations
end


#=
    sources:

    Journal of the Optical Society of America

    Günter Wyszecki & G. H. Fiedler: New Color-Matching Ellipses, 1971

    Color matching data were obtained by the following observers:

    DLM: David L. MacAdam (after Brown & MacAdam)
    PGN: P.G. Nutting Jr.
    WRB: W. R. J. Brown (after Brown & MacAdam)
    GW: 42 years old observer
    AR: 27 years old observer
    GF: 32 years old observer
    B(original name 12B): Average ellipses of W. R. J. Brown’s group of 12 observers
    FMC: predicted ellipses by the Friele-MacAdam-Chickering formula optimized for best fit with PGN ellipses.
=#
#=

    All data are given in Yxy color space coordinates!

=#

# experiment luminance data in [cd/m²]
#  background | test field
const ELLIPSE_LUMINANCE_DATA =
    #PGN_bg, PGN_lum
   [24.0     48.0;
    #WSS_bg, WSS_lum
    24.0     48.0;
    #FMC_bg, FMC_lum
    24.0     48.0;
    #WRB_bg, WRB_lum
    0.0     999.0;
    #DLM
    0.0     999.0;
    #12B
    8.9     999.0;
    #GF
    6.0      12.0;
    #AR
    6.0      12.0;
    #GW
    6.0      12.0]

# MacAdam color matching ellipses obtained by observer
# P.G. Nutting Jr., which refer to 2° test colors.
# L0 = Y0 ≈ 48 cd/m² surrounded by a 42° white surround
# with a luminance of ≈ 24 cd/m².

# Ellipses refer to standard deviations of color matches
# Estimated by MacAdam to be ~1/3 of the corresponding JND

    #  x0  y0    θ(deg)    a        b
const PGN_ellipses =
   [0.160  0.057   62.5  0.85e-03  0.35e-03;
    0.187  0.118   77.0  2.20e-03  0.55e-03;
    0.253  0.125   55.5  2.50e-03  0.50e-03;
    0.150  0.680  105.0  9.60e-03  2.30e-03;
    0.131  0.521  112.5  4.70e-03  2.00e-03;
    0.212  0.550  100.0  5.80e-03  2.30e-03;
    0.258  0.450   92.0  5.00e-03  2.00e-03;
    0.152  0.365  110.0  3.80e-03  1.90e-03;
    0.280  0.385   75.5  4.00e-03  1.50e-03;
    0.380  0.498   70.0  4.40e-03  1.20e-03;
    0.160  0.200  104.0  2.10e-03  0.95e-03;
    0.228  0.250   72.0  3.10e-03  0.90e-03;
    0.305  0.323   58.0  2.30e-03  0.90e-03;
    0.385  0.303   65.5  3.80e-03  1.60e-03;
    0.472  0.399   51.0  3.20e-03  1.40e-03;
    0.527  0.350   20.0  2.60e-03  1.30e-03;
    0.475  0.300   28.5  2.90e-03  1.10e-03;
    0.510  0.236   29.5  2.40e-03  1.20e-03;
    0.596  0.283   13.0  2.60e-03  1.30e-03;
    0.344  0.284   60.0  2.30e-03  0.90e-03;
    0.390  0.237   47.0  2.50e-03  1.00e-03;
    0.441  0.198   34.5  2.80e-03  0.95e-03;
    0.278  0.223   57.5  2.40e-03  0.55e-03;
    0.300  0.163   54.0  2.90e-03  0.60e-03;
    0.365  0.153   40.0  3.60e-03  0.95e-03]

    #WSS ellipses are threshold loci based on a 50% chance of seeing a color difference.

    #  x0  y0    θ(deg)    a        b
const WSS_ellipses =
   [0.160  0.057   85.5   2.4e-03   1.4e-03;
    0.187  0.118   76.8   6.3e-03   2.9e-03;
    0.253  0.125   53.4   7.4e-03   2.8e-03;
    0.150  0.680  116.6  24.2e-03  11.4e-03;
    0.131  0.521  105.3  22.6e-03  10.3e-03;
    0.212  0.550  105.7  19.4e-03  10.9e-03;
    0.258  0.450   91.3  16.3e-03   9.9e-03;
    0.152  0.365   97.0  17.8e-03   7.6e-03;
    0.280  0.385   79.9  14.8e-03   8.8e-03;
    0.380  0.498  110.0  12.8e-03   9.6e-03;
    0.160  0.200   92.0  11.2e-03   4.5e-03;
    0.228  0.250   76.7  12.6e-03   5.9e-03;
    0.305  0.323   68.0  13.5e-03   7.4e-03;
    0.385  0.303   65.8  12.2e-03   8.6e-03;
    0.472  0.399   55.4   9.5e-03   8.0e-03;
    0.527  0.350   38.4   8.8e-03   6.1e-03;
    0.475  0.300   41.5  10.9e-03   5.3e-03;
    0.510  0.236   34.3  10.9e-03   3.2e-03;
    0.596  0.283   31.0   8.3e-03   3.5e-03;
    0.344  0.284   56.7  12.6e-03   6.2e-03;
    0.390  0.237   45.3  11.8e-03   4.5e-03;
    0.441  0.198   36.4  11.4e-03   2.9e-03;
    0.278  0.223   62.1  11.5e-03   5.1e-03;
    0.300  0.163   49.6   9.7e-03   3.4e-03;
    0.365  0.153   38.8  10.1e-03   2.5e-03]

    #  x0  y0    θ(deg)    a        b
const FMC_ellipses =
   [0.160  0.057   76.4  0.85e-03  0.35e-03;
    0.187  0.118   72.0  2.00e-03  0.53e-03;
    0.253  0.125   53.5  2.30e-03  0.49e-03;
    0.150  0.680  100.5  7.30e-03  3.10e-03;
    0.131  0.521  100.3  5.60e-03  2.60e-03;
    0.212  0.550   91.1  5.20e-03  2.40e-03;
    0.258  0.450   80.4  4.10e-03  1.80e-03;
    0.152  0.365   92.4  4.30e-03  1.80e-03;
    0.280  0.385   73.3  3.60e-03  1.40e-03;
    0.380  0.498   68.9  4.00e-03  1.70e-03;
    0.160  0.200   85.7  3.00e-03  1.00e-03;
    0.228  0.250   72.8  3.20e-03  0.99e-03;
    0.305  0.323   65.5  3.30e-03  1.10e-03;
    0.385  0.303   61.2  3.30e-03  1.30e-03;
    0.472  0.399   53.1  3.10e-03  1.40e-03;
    0.527  0.350   43.5  2.80e-03  1.40e-03;
    0.475  0.300   43.4  2.80e-03  1.20e-03;
    0.510  0.236   32.8  2.70e-03  1.20e-03;
    0.596  0.283   27.8  2.40e-03  1.50e-03;
    0.344  0.284   56.9  3.10e-03  0.97e-03;
    0.390  0.237   46.1  2.90e-03  0.94e-03;
    0.441  0.198   35.5  2.90e-03  1.00e-03;
    0.278  0.223   61.2  3.00e-03  0.79e-03;
    0.300  0.163   49.8  2.70e-03  0.64e-03;
    0.365  0.153   38.1  2.80e-03  0.77e-03]

#=  l0 = 0.2 * log10(Y0), with Y0 ≡ L0 in cd/m²
    Y0 = 10^(5 * l0) cd/m²

    based on ds² =  1
    Colors of varying lightness presented in a dark surround.
=#

    # x0     y0    l0     θ       a       b
const WRB_ellipses =
   [0.580  0.341  0.253  171  3.0e-03  1.6e-03;
    0.422  0.330  0.260   40  2.8e-03  1.3e-03;
    0.364  0.505  0.243   67  2.4e-03  1.1e-03;
    0.370  0.218  0.195   35  2.7e-03  1.0e-03;
    0.492  0.446  0.212   32  1.7e-03  1.3e-03;
    0.308  0.424  0.201   72  2.8e-03  0.8e-03;
    0.446  0.450  0.260   49  1.6e-03  1.1e-03;
    0.319  0.581  0.230   90  2.3e-03  1.5e-03;
    0.682  0.302  0.264  156  1.3e-03  0.6e-03;
    0.650  0.292  0.265    1  1.6e-03  0.8e-03;
    0.314  0.183  0.097   39  2.8e-03  0.8e-03;
    0.221  0.148  0.055   46  1.2e-03  0.4e-03;
    0.668  0.317  0.185  164  1.9e-03  1.1e-03;
    0.484  0.267  0.113   29  3.0e-03  1.1e-03;
    0.436  0.366  0.211   17  2.7e-03  1.1e-03;
    0.525  0.390  0.199    0  2.1e-03  1.5e-03;
    0.552  0.290  0.240   17  2.7e-03  1.1e-03;
    0.249  0.204  0.100   61  2.5e-03  1.0e-03;
    0.258  0.325  0.165   79  3.1e-03  1.3e-03;
    0.268  0.322  0.168   66  3.0e-03  0.9e-03;
    0.310  0.288  0.160   61  2.8e-03  1.1e-03;
    0.255  0.255  0.131   69  2.5e-03  0.9e-03;
    0.383  0.489  0.280   90  1.8e-03  1.2e-03;
    0.323  0.558  0.265   93  3.2e-03  1.4e-03;
    0.354  0.358  0.267   43  2.7e-03  1.1e-03;
    0.416  0.236  0.231   40  1.8e-03  1.1e-03;
    0.312  0.317  0.265  176  1.8e-03  0.9e-03;
    0.473  0.317  0.313   27  1.6e-03  1.0e-03;
    0.358  0.230  0.220   42  2.3e-03  0.8e-03;
    0.321  0.491  0.245   92  2.7e-03  1.3e-03;
    0.294  0.367  0.258   78  2.1e-03  1.1e-03;
    0.294  0.367  0.006   69  5.5e-03  1.6e-03;
    0.385  0.400  0.275   62  2.0e-03  0.9e-03;
    0.199  0.524  0.139   97  5.1e-03  2.3e-03;
    0.212  0.642  0.135   98  8.3e-03  1.8e-03;
    0.203  0.419  0.146  107  3.9e-03  1.1e-03;
    0.171  0.189  0.188   92  2.3e-03  0.6e-03;
    0.191  0.329  0.152   86  3.6e-03  1.0e-03]

    # x0    y0     l0     θ      a         b
const DLM_ellipses =
   [0.580  0.341  0.253  159  3.0e-03  1.5e-03;
    0.422  0.330  0.260   25  2.9e-03  1.4e-03;
    0.364  0.505  0.243   58  2.8e-03  1.8e-03;
    0.370  0.218  0.195   24  2.8e-03  1.0e-03;
    0.492  0.446  0.212   18  2.0e-03  1.0e-03;
    0.308  0.424  0.201   56  2.3e-03  0.9e-03;
    0.446  0.450  0.260    3  1.7e-03  1.0e-03;
    0.319  0.581  0.230    0    1e-08    1e-08;
    0.682  0.302  0.264  150  1.3e-03  0.8e-03;
    0.650  0.292  0.265  174  1.7e-03  0.8e-03;
    0.314  0.183  0.097   32  2.5e-03  0.7e-03;
    0.221  0.148  0.055   46  1.2e-03  0.4e-03;
    0.668  0.317  0.185  162  2.0e-03  0.9e-03;
    0.484  0.267  0.113   13  2.7e-03  1.5e-03;
    0.436  0.366  0.211   22  1.3e-03  0.7e-03;
    0.525  0.390  0.199  168  2.3e-03  1.0e-03;
    0.552  0.290  0.240   16  2.6e-03  1.1e-03;
    0.249  0.204  0.100   56  2.3e-03  0.8e-03;
    0.258  0.325  0.165   56  2.1e-03  1.1e-03;
    0.268  0.322  0.168   59  1.8e-03  0.9e-03;
    0.310  0.288  0.160   51  2.0e-03  0.8e-03;
    0.255  0.255  0.131   60  2.4e-03  0.9e-03;
    0.383  0.489  0.280   78  2.0e-03  1.5e-03;
    0.323  0.558  0.265   83  2.4e-03  1.4e-03;
    0.354  0.358  0.267   43  2.1e-03  0.8e-03;
    0.416  0.236  0.231   35  3.2e-03  1.4e-03;
    0.312  0.317  0.265  143  2.1e-03  1.0e-03;
    0.473  0.317  0.313   18  2.3e-03  1.1e-03;
    0.358  0.230  0.220   35  3.0e-03  1.0e-03;
    0.321  0.491  0.245   71  2.2e-03  1.1e-03;
    0.294  0.367  0.258   61  2.2e-03  0.8e-03;
    0.294  0.367  0.006   69  3.5e-03  1.2e-03;
    0.385  0.400  0.275   38  1.6e-03  1.3e-03;
    0.199  0.524  0.139   90  3.0e-03  1.3e-03;
    0.212  0.642  0.135   83  5.2e-03  2.3e-03;
    0.203  0.419  0.146  106  4.2e-03  1.6e-03;
    0.171  0.189  0.188   89  2.3e-03  0.4e-03;
    0.191  0.329  0.152  100  2.3e-03  1.1e-03]

#The color-matching ellipses are cross sections through the centers of (weighted) mean color-matching ellipsoids determined by a group of 12 observers for 10° test colors of different luminances (l0 = 0.2 log10 Y0), with Y0 = L0 in cd/m²) presented in a large near-white surround with a luminance of 8.9 cd/m² (that is, l0 = 0.190). For details see Ref. 15 or 3. Test color (13) is identical to test color 13 except that its angular subtense is reduced to 2°. Test colors marked with a prime, e.g. 1', 2', etc. are within the chromaticity gamut of Fig. 2 of this paper.

    # x0     y0    l0     Θ    a    b
const B_ellipses =
   [0.308  0.280  0.240   67  2.1e-03  1.1e-03;
    0.339  0.493  0.268   88  3.7e-03  1.6e-03;
    0.426  0.219  0.238   43  2.3e-03  1.3e-03;
    0.536  0.411  0.264  169  2.9e-03  1.4e-03;
    0.457  0.368  0.248    4  1.9e-03  1.0e-03;
    0.288  0.630  0.247  104  5.4e-03  2.0e-03;
    0.254  0.456  0.236  112  1.8e-03  1.0e-03;
    0.674  0.308  0.252  169  1.8e-03  0.7e-03;
    0.209  0.137  0.202   77  2.3e-03  0.7e-03;
    0.340  0.178  0.211   65  2.3e-03  1.1e-03;
    0.422  0.483  0.236   86  3.4e-03  2.1e-03;
    0.262  0.343  0.241   47  1.8e-03  1.5e-03;
    0.368  0.352  0.267  165  1.9e-03  1.0e-03;
    0.643  0.304  0.230  175  2.4e-03  0.9e-03;
    0.385  0.546  0.241  128  4.3e-03  2.9e-03;
    0.270  0.549  0.247  127  4.5e-03  2.0e-03;
    0.308  0.307  0.263   35  1.8e-03  1.4e-03;
    0.562  0.252  0.227   14  2.0e-03  0.9e-03;
    0.217  0.606  0.255  128  6.0e-03  2.4e-03;
    0.196  0.293  0.245    6  2.4e-03  1.5e-03;
    0.161  0.410  0.248  158  3.0e-03  1.6e-03;
    0.257  0.202  0.234   40  2.8e-03  1.0e-03]

#=
    GF, WR, GW ellipses

    ds² = 7.81 chosen according to χ² for 3 deg. of freedom.
    On average, ellipsoids contain 95% of any random set
    of color matches.

=#

    # x0      y0    g11    g12   g22    g23    g33   g13    Θ      a       b
const GF_ellipses =
   [0.4786  0.4327   492   -275   717    114   459    39   34  5.0e-03  2.9e-03;
    0.3909  0.4375   690   -678   999   -568   853   270   39  7.2e-03  2.2e-03;
    0.4932  0.3462   146    123  2637  -1151  1678  -215  177  7.5e-03  1.7e-03;
    0.3079  0.3595  1999   -572  1014   -474  1372  -428   65  3.2e-03  1.9e-03;
    0.4458  0.4809   567   -355   372     74   542    37   53  8.8e-03  3.0e-03;
    0.4382  0.3417   379    109  2250   -531  1391  -368  177  4.6e-03  1.9e-03;
    0.3822  0.3372   698   -409  1634   -162  1142  -587   21  3.8e-03  2.1e-03;
    0.2295  0.2987  1017   -556  1447   -331   991   109   34  3.5e-03  2.1e-03;
    0.3310  0.2749  1292   -645   844   -526  1092   402   55  4.5e-03  2.1e-03;
    0.2766  0.2551  1928  -1350  2262   -651  1516   280   41  3.3e-03  1.5e-03;
    0.2054  0.2544  1134   -499  1372   -592  1369  -179   38  3.2e-03  2.1e-03;
    0.5868  0.3360   102     56   901   -196   416   -24  176  8.9e-03  2.9e-03;
    0.3545  0.4518  1162   -411   306   -144   656   253   68  7.6e-03  2.4e-03;
    0.2618  0.2912  3006  -1389  1085   -156   578    50   62  4.7e-03  1.4e-03;
    0.3101  0.3163  2118   -910  1280     34   949   -99   59  3.3e-03  1.7e-03;
    0.3251  0.3325  3514   -312  1674   -494  1722   593   81  2.2e-03  1.5e-03;
    0.2959  0.3009  2572   -510  1560   -812  1947  -124   67  2.4e-03  1.7e-03;
    0.3144  0.3355  4825  -1690  3441   -232  1746  1786   56  1.8e-03  1.1e-03;
    0.3425  0.5280   525   -132   131    -79  1426   207   73  9.3e-03  3.7e-03;
    0.3022  0.4725  1946   -489   296     -4   781    14   75  6.9e-03  1.9e-03;
    0.4873  0.3994   408   -108  1422   -246  1942  -294    6  4.4e-03  2.3e-03;
    0.5428  0.3776   223    -29  1107   -151  1981   -75    2  5.9e-03  2.7e-03;
    0.2670  0.4240   991   -238   330    214  1239  -212   72  5.6e-03  2.7e-03;
    0.3753  0.3867  1285   -868  1007   -162  1016  -134   50  5.4e-03  2.0e-03;
    0.5242  0.3140   157    171  1008   -244   513   -14  169  8.0e-03  2.7e-03;
    0.2730  0.3701  1490   -654   951    311   798  -392   56  3.9e-03  2.0e-03;
    0.4650  0.3122   265    142   950   -275   556  -221  169  5.7e-03  2.8e-03;
    0.4058  0.2909   425   -174  1536   -407   926  -286    9  4.4e-03  2.2e-03]

    # x0      y0    g11    g12   g22   g23    g33   g13   Θ      a       b
    const AR_ellipses=
   [0.4786  0.4327   345   -389   866   152   483  -149  28  7.5e-03  2.7e-03;
    0.3909  0.4375   646   -344   479   -53   269     6  52  6.1e-03  2.9e-03;
    0.4932  0.3462  1105  -1088  2251    41   635  -147  31  2.2e-03  1.6e-03;
    0.3079  0.3595  2454   -788   933  -100   668   516  67  3.6e-03  1.7e-03;
    0.4458  0.4809   636   -391   515    -7   590   102  49  6.6e-03  2.8e-03;
    0.4382  0.3417  1082   -329  1573  -335  1226   456  27  2.9e-03  2.1e-03;
    0.3822  0.3372   771   -696  1442   273   986  -283  32  4.8e-03  2.0e-03;
    0.2295  0.2987  1684    652   958  -198  1129   135  60  3.7e-03  1.9e-03;
    0.3310  0.2749  1874  -1127  2103   -51  1026   358  42  3.0e-03  1.6e-03;
    0.2766  0.2551  4476  -1596  1181   124   577   -14  68  3.8e-03  1.2e-03;
    0.2054  0.2544  1448   -429   485  -109  1106     3  66  4.0e-03  2.2e-03;
    0.5868  0.3360   325    -14  1324   260   444   133   1  4.9e-03  2.4e-03;
    0.3545  0.4518  2537   -814   587  -163   721   488  70  5.2e-03  1.7e-03;
    0.2618  0.2912  2368  -1013  1011  -194   946   319  62  4.1e-03  1.6e-03;
    0.3101  0.3163  3291  -1049  1598    35   888   336  64  2.7e-03  1.4e-03;
    0.3251  0.3325  2718   -831  1565   220  1102   474  62  2.6e-03  1.6e-03;
    0.2959  0.3009  2387   -686  1110   142   815   -97  66  3.1e-03  1.7e-03;
    0.3144  0.3355  1639   -303   853   -85   708   196  71  3.2e-03  2.1e-03;
    0.3425  0.5280  1566   -242   182   -58   630   360  80  7.4e-03  2.2e-03;
    0.3022  0.4725  1835    -14   180   102  1025   761  90  6.6e-03  2.1e-03;
    0.4873  0.3994   516   -279   911   310   555   -84  27  4.6e-03  2.7e-03;
    0.5428  0.3776   335    -49  1130   341   447    24   4  4.8e-03  2.6e-03;
    0.2670  0.4240  1723   -169   206   -13   683   291  84  6.4e-03  2.1e-03;
    0.3753  0.3867  1160   -596   917  -312  1058    17  51  4.3e-03  2.2e-03;
    0.5242  0.3140   241    -94   692   178   587    63  11  5.9e-03  3.3e-03;
    0.2730  0.3701  1836   -459   577   -63   464    -3  72  4.3e-03  2.0e-03;
    0.4650  0.3122   383   -143   788  -107   677   -95  18  4.8e-03  3.1e-03;
    0.4058  0.2909   613   -447   815   -73   176   198  39  5.5e-03  2.6e-03]

    # x0      y0    g11    g12   g22   g23    g33   g13   Θ      a       b
    const GW_ellipses=
   [0.4786  0.43273  674   -695  1176    34   773    -6  35  5.5e-03  2.2e-03;
    0.3909  0.43753 1492  -1042  1251  -104   577   252  48  4.9e-03  1.8e-03;
    0.4932  0.34623  118     30  1491   -46  1501   136 179  8.2e-03  2.3e-03;
    0.3079  0.35953 1938   -629  1054  -268   751   382  63  3.3e-03  1.9e-03;
    0.4458  0.48093  692   -393   540    -1   668   144  50  6.0e-03  2.8e-03;
    0.4382  0.34173  532    -75  1328   113   689    56   5  3.9e-03  2.4e-03;
    0.3822  0.33723 1185  -1092  2074    -1   816   -67  34  4.2e-03  1.7e-03;
    0.2295  0.29873 1628   -508  1089  -741  3695    61  59  3.2e-03  2.0e-03;
    0.3310  0.27493 1512   -859   936  -389   805    79  54  5.0e-03  1.9e-03;
    0.2766  0.25513 6793  -2841  1855  -593  1898  1591  65  3.7e-03  1.0e-03;
    0.2054  0.25443 1242   -249   482   -75   954   242  73  4.4e-03  2.4e-03;
    0.5868  0.33603   78     10  1025   184   454   -59 179 10.0e-03  2.8e-03;
    0.3545  0.45183 1342   -374   284   -40   529  -136  72  6.9e-03  2.3e-03;
    0.2618  0.29123 4691  -1527  1068  -127   295   211  70  3.9e-03  1.2e-03;
    0.3101  0.31633 3406  -1554  1641  -691  1930   739  60  3.3e-03  1.4e-03;
    0.3251  0.33253 2717  -1656  2146  -141   901   572  50  3.2e-03  1.4e-03;
    0.2959  0.30093 2365  -1215  1261  -499  1683   358  57  4.0e-03  1.6e-03;
    0.3144  0.33553 3426  -1759  1525   128   994   306  59  4.0e-03  1.3e-03;
    0.3425  0.52803  769   -181    85   -37   875   247  76 14.0e-03  3.1e-03;
    0.3022  0.47253 2192   -501   225   -52   717   487  77  8.6e-03  1.8e-03;
    0.4873  0.39943  223   -331   959   211  1034  -229  21  9.0e-03  2.7e-03;
    0.5428  0.37763  119    -65   573  -191   968  -108   8  8.4e-03  3.7e-03;
    0.2670  0.42403  965   -114   186    98  1546   366  82  6.8e-03  2.8e-03;
    0.3753  0.38673  857   -874  1396    19  1165   137  36  6.1e-03  2.0e-03;
    0.5242  0.31403  136    -58   559    -6   280   -88   8  7.8e-03  3.7e-03;
    0.2730  0.37013 1251    178   511   -71   875    70 103  4.1e-03  2.5e-03;
    0.4650  0.31223  177   -122   653   228   755   -69  14  7.3e-03  3.4e-03;
    0.4058  0.29093  441   -167   504  -199   794    94  40  5.1e-03  3.5e-03]


doc"""
`Atom(Z; R=(0.,0.,0.), params...)`

creates an atom at `R` with nuclear charge `Z`,
with any additional parameters `params`.
"""
type Atom <: Associative{Symbol,Any}
    Z::Float64              # atomic number
    R::Point3f              # position
    d::Dict{Symbol,Any}     # additional properties
end

Base.delete!(at::Atom, key)                                    = delete!(at.d, key)
Base.done(at::Atom, i)                                         = done(at.d, i)
Base.empty!(at::Atom)                                          = empty!(at.d)
Base.copy(at::Atom)                                            = Atom(at.Z,at.R,copy(at.d))
Base.get(at::Atom, key, default)                               = get(at.d, key, default)
Base.get(default::Union{DataType,Function}, at::Atom, key)     = get(default, at.d, key)
Base.get!(at::Atom, key0, default)                             = get!(at.d, key0, default)
Base.get!(default::Union{DataType,Function}, at::Atom, key0)   = get!(default, at.d, key0)
Base.getindex(at::Atom, key)                                   = getindex(at.d, key)
Base.getkey(at::Atom, key, default)                            = getkey(at.d, key, default)
Base.haskey(at::Atom, key)                                     = haskey(at.d, key)
Base.isempty(at::Atom)                                         = isempty(at.d)
Base.length(at::Atom)                                          = length(at.d)
Base.next(at::Atom, i)                                         = next(at.d, i)
Base.pop!(at::Atom, key)                                       = pop!(at.d, key)
Base.pop!(at::Atom, key, default)                              = pop!(at.d, key, default)
Base.setindex!(at::Atom, v0, key0)                             = setindex!(at.d, v0, key0)
Base.similar(at::Atom)                                         = similar(at.d)
Base.sizehint!(at::Atom, newsz)                                = sizehint!(at.d, newsz)
Base.start(at::Atom)                                           = start(at.d)
Base.merge!(at::Atom, d::Dict)                                 = begin merge!(at.d, d); d end
Base.merge(at::Atom, d::Dict)                                  = Atom(merge(at.d, d))
Base.writemime(io::IO, mime::MIME"text/plain", at::Atom)       = show_symbol_dict(io,at)
Base.summary(at::Atom)                                         = string(typeof(at),"(Z=$(at.Z),R=$(at.R))")
Base.show(io::IO, at::Atom)                                    = print(io,summary(at))

function show_symbol_dict(io::IO, d::Associative{Symbol,Any}; cols=100)
    shown_set = get(task_local_storage(), :SHOWNSET, nothing)
    if shown_set === nothing
        shown_set = ObjectIdDict()
        task_local_storage(:SHOWNSET, shown_set)
    end
    d in keys(shown_set) && (print(io, "#= circular reference =#"); return)

    try
        println(io, summary(d))

        shown_set[d] = true
        ks = map(string,keys(d))
        keylen = length(ks) > 0 ? maximum(map(length,ks)) : 0

        for (i,k) in enumerate(keys(d))
            print(io, Base.rpad(ks[i], keylen))
            print(io, " = ")
            val = Base.with_output_limit(()->sprint(show, d[k]))
            val = Base._truncate_at_width_or_chars(val, cols - keylen, "\r\n")
            print(io, val)
            print(io, '\n')
        end
    finally
        delete!(shown_set, d)
    end
end

function Base.call(::Type{Atom};
        Z         ::Real         = 1.,
        R         ::Point3{Real} = (0.,0.,0.),
        makebasis ::Bool         = false,
        makegrid  ::Bool         = false,
        etacut    ::Float64      = 1e-4,
        a         ::Float64      = 10.,
        w         ::Float64      = 2.,
        r0max     ::Float64      = 20.,
        npts      ::Int          = 100,
        nr        ::Int          = 80,
        na        ::Int          = 38,
        params...)

    at = Atom(convert(Float64,Z), convert(Point3f,R), Dict{Symbol,Any}(params))

    if makebasis
        dft!(at)
        splineradial!(at;npts=npts)
        naobasis!(at;etacut=etacut,a=a,w=w,r0max=r0max,npts=npts)
    end

    if makegrid
        makegrid!(at;nr=nr,na=na)
    end

    at
end

typealias Atoms Vector{Atom}

doc"""
`setposition(at,R)`

sets the position of atom `at` to `R`
"""
function setposition(at::Atom, R::Point3f)
    at.R = R
    for k in keys(at)
        setposition(at[k],R)
    end
end

function setposition(a::AbstractArray, R::Point3f)
    for i in 1:length(a)
        setposition(a[i],R)
    end
end

setposition(a, R::Point3f) = return

doc"""
`deepcopy(at,R)`

returns a copy of `at` at the position `R`
"""
function Base.deepcopy(at::Atom, R::Point3f)
    at_ = deepcopy(at)
    setposition(at_,R)
    at_
end

doc"""
`splineradial!(at; npts=100)`

splines the electronic density `rho`, hartree potential `vh`,
and Kohn-Sham potential `vs` and creates radial functions.
Additionally, the Coulomb potential `v` is created.

assumes the `rho`, `vh` and `vs` have been calculated and are
given in `at` discretized on the radial grid `r`.

*sets*

`at[:v]` (see `CoulombPotential`)

`at[:rho]`, `at[:vh]`, `at[:vs]` (see `RadialFunc`).

`npts` - the number of evenly distributed spline points to use

e.g.
```julia
at = dft(Z=1.)
splineradial!(at)
plot(at[:rho].u,0,5,label="rho")
plot!(at[:vh].u,0,5,label="vh")
plot!(at[:vs].u,0,5,label="vs")
ylims!(-2,1)
```
"""
function splineradial!(at::Atom; npts::Int=100)
    r = at[:r]
    Y00 = 1/sqrt(4π)
    q = 4π*multipolemoment(r,at[:rho],0)/Y00
    at[:v]   = CoulombPotential(at.Z,R=at.R)
    at[:rho] = RadialFunc(r,at[:rho],R=at.R,rmax=r[end],npts=npts)
    at[:vh]  = MultipoleFunc(r,at[:vh]./Y00,l=0,m=0,R=at.R,q=q,rcut=r[end],npts=npts)
    at[:vs]  = RadialFunc(r,at[:vs],R=at.R,rmax=r[end],npts=npts)
    return
end

function splineradial(at::Atom; npts::Int=100)
    let at = copy(at)
        splineradial!(at;npts=npts)
        return at
    end
end

function makegrid!(at::Atom; nr::Int=80, na::Int=38, rmax::Float64=Inf)
    if isinf(rmax)
        @assert :basis in keys(at) "create an atomic basis before making a grid"
        rmax = maximum([φ.rmax for φ in at[:basis]])
    end
    r = atomicradgrid(nr,rmax)
    Ω = lebgrid(na)
    at[:g] = atomicgrid(r,Ω,R=at.R)
    return
end

function makegrid(at::Atom; nr::Int=80, na::Int=38, rmax::Float64=Inf)
    let at = copy(at)
        makegrid!(at;nr=nr,na=na,rmax=rmax)
        return at
    end
end

function makegrid!(atoms::Atoms; nr::Int=80, na::Int=38, rmax::Float64=Inf)
    for at in atoms
        makegrid!(at,nr=nr,na=na,rmax=rmax)
    end
end

function makegrid(atoms::Atoms; nr::Int=80, na::Int=38, rmax::Float64=Inf)
    let atoms = copy(atoms)
        makegrid!(atoms;nr=nr,na=na,rmax=rmax)
        return atoms
    end
end

hasbasis(at::Atom) = :basis in keys(at)
hasgrid(at::Atom) = :g in keys(at)

print_stats(at::Atom) = print_stats(at[:stats])


# """ REWRITE:
# initback initializes the fields used by Net.back:
# - dif0, tmp: allocated or size checked.
# - reg.incr: depends on seq.
# - reg.back: depends on which dx args specified.
# - op.save: read-only, used for popping only if seq.
# """
function initback(f::Net, ygold, loss, getdx, seq)
    seq == !stack_isempty(f) || error("")
    nextback = (f.lastforw, getdx, seq)
    if isvoid(f,:lastback) || f.lastback != nextback
        initgrad(f, getdx)
        initincr(f)
        inittype2(f)
        initdif0(f)
        inittmp(f)
        f.lastback = nextback
        gpusync()
    end
end

backregs(f::Net)=filter(r->getp(r,:grad), regs(f))

initdif0(f::Net)=(for p in reverse(backregs(f)); initdif0(f,p); end)

function initdif0(f::Net,p::Reg)
    at, et, sz = getp(p,:diftype), getp(p,:eltype), getp(p,:size)
    (isa(at,DataType) && isa(et,DataType) && isa(sz,Dims)) || error("Reg has missing info: $((p.name,at,et,sz))")
    if !checkarray(p, :dif0, at, et, sz)
        p.dif0 = newarray(at, et, sz)
        getp(p,:incr) && fillsync!(p.dif0,0)
    end
    if canoverwrite(p.op) && getp(p,:backoverwrite,true) && !getp(p,:incr)
        for i in reverse(p.argv) # consider overwriting the last input first
            q = reg(f,i)
            if (isvoid(q,:dif0) && !getp(q,:incr) && (at,et,sz)==(getp(q,:diftype),getp(q,:eltype),getp(q,:size)))
                q.dif0 = p.dif0
                break
            end
        end
    end
end

function inittmp(f::Net)
    for p in backregs(f)
        if getp(p,:incr)
            at, et, sz = getp(p,:tmptype), getp(p,:eltype), getp(p,:size)
            checkarray(p,:tmp,at,et,sz) || (p.tmp = newarray(at,et,sz))
        end
    end
end

# """ REWRITE:
# set_toback(f::Net) sets f.toback[n] which is true if dif[n] should be
# calculated for op[n] during back calculation.  This is only needed if
# op[n] is a par node or a par node descendent.  Or if the caller asked
# for dx for network inputs, those and their descendents.
# """
function initgrad(f::Net, getdx)
    for p in regs(f)
        setp(p,:grad,false)
    end
    lastinput = 0
    for p in regs(f)
        if ((isa(p.op, Par) && p.op.initialized) || (isa(p.op, Input) && getdx[lastinput+=1]))
            setp(p,:grad,true)  # :grad means we need the gradient of the output of this operation, does not mean go back on this operation.
        end
    end
    count_grad(f::Net)=mapreduce(r->getp(r,:grad), +, 0, regs(f))
    nback = count_grad(f)
    while true
        for p in regs(f)
            getp(p,:grad) && continue
            for i in inputregs(f,p)
                if getp(i,:grad)
                    setp(p,:grad,true)
                    break
                end
            end
        end
        nb = count_grad(f)
        nb == nback ? break : nback = nb
    end
end

# REWRITE:
# set_toincr(f::Net) sets f.toincr[n] which is true if dif[n] should be
# incrementally updated.  This is necessary if op[n] has multiple
# outputs, or it is a Par and we are processing a sequence.  This is the
# one place we can't seem to get rid of the seq flag.
#
# We can make all Par registers :incr.
# - TODO: efficiency cost for fnn.
# - who resets them to zero for rnn or for fnn.

function initincr(f::Net)
    seq = (stack_length(f) > 0)
    for p in backregs(f)
        setp(p,:incr,seq && isa(p.op,Par))
        setp(p,:fanout, isreturn(p) ? 1 : 0)
    end
    for p in backregs(f)
        for i in inputregs(f,p)
            if getp(i,:grad) && incp(i,:fanout) > 1
                setp(i,:incr,true)
            end
        end
    end
end

# Note about sparse arrays:
# If input x is sparse (example: matrix of one-hot word columns)
# and the first op is dot(w,x):
# w will be dense (example: word embedding matrix)
# y = w * x and all following forw outputs will be dense.
# Going back we have dw = dy * x' and dx = w' * dy
# We would like to keep dw sparse.
# The only sparse matrices are the dw and iw for w that dot sparse inputs.
# Regular sparse x is a right csc input.
# NCE adds noise and ygold matrices as left csr inputs.
# TODO: cleanup this mess: more generic code? more versatile sparse type?

function inittype2(f::Net)
    for p in backregs(f)
        setp(p,:diftype, gpu() ? CudaArray : Array)
        setp(p,:tmptype, gpu() ? CudaArray : Array)
    end
    for p in backregs(f)
        isa(p.op, Dot) || continue # We only know how to do sparse dot
        (a, b) = inputregs(f, p)
        if issparse(a.out0) && issparse(b.out0)
            error("Dot of two sparse matrices")
        elseif issparse(b.out0) && getp(a,:grad) # y = w * x  with sparse x in rnnlm
            if getp(a,:incr)
                setp(a,:diftype, gpu() ? CudaArray : Array)
                setp(a,:tmptype, gpu() ? CudaSparseMatrixCSRU : SparseMatrixCSC)
            else
                setp(a,:diftype, gpu() ? CudaSparseMatrixCSR : SparseMatrixCSC)
            end
        elseif issparse(a.out0) && getp(b,:grad) # rw = r * w  with sparse r in nce
            if getp(b,:incr)
                setp(b,:diftype, gpu() ? CudaArray : Array)
                setp(b,:tmptype, gpu() ? CudaSparseMatrixCSCU : SparseMatrixCSC)
            else
                setp(b,:diftype, gpu() ? CudaSparseMatrixCSC : SparseMatrixCSC)
            end
        end
    end
end

### DEAD CODE

# function inittype2(f::Net)
#     fillsync!(f.sparse, nothing)
#     for o=1:length(f.op)
#         if isa(f.op[o], Dot)
#             (i,j) = f.inputs[o]
#             if issparse(f.out0[i]) && issparse(f.out0[j])
#                 error("Dot of two sparse matrices")
#             elseif issparse(f.out0[j])
#                 f.sparse[i] = f.toincr[i] ? CudaSparseMatrixCSRU : CudaSparseMatrixCSR # todo: clean up this mess!
#             elseif issparse(f.out0[i])
#                 f.sparse[j] = f.toincr[i] ? CudaSparseMatrixCSCU : CudaSparseMatrixCSC
#             end
#         end
#     end
# end

# function finddif(f::Net, n)
#     dif0 = nothing
#     if !f.toincr[n]
#         if length(f.outputs[n]) == 0
#             # There are no outputs to try overwriting, this may happen with childless ops
#         elseif length(f.outputs[n]) == 1
#             o = f.outputs[n][1]     # first try overwriting the output dif
#             if (o > n
#                 && !f.toincr[o]
#                 && overwrites(f.op[o])
#                 && (f.dif0[o]!=nothing)
#                 && size(f.dif0[o]) == size(f.out0[n]))
#                 dif0 = f.dif0[o]
#             end
#         else
#             error("toincr==false for multi output op")
#         end
#     end
#     if dif0 == nothing
#         et = eltype(f.out0[n])
#         sz = size(f.out0[n])
#         dif0 = (
#                 ### This is sparse non-incremental dw: can't really have dense without
#                 # rewriting CUSPARSE.csrmm to take sparse matrix in second position.  As
#                 # it stands, we'd have to transpose all three matrices: dw = dy * x' -> dw' = x * dy'
#                 (f.sparse[n]!=nothing) && !f.toincr[n] && !gpu() ? spzeros(et, sz...) :
#                 (f.sparse[n]!=nothing) && !f.toincr[n] && gpu()  ? (f.sparse[n])(spzeros(et, sz...)) : # t:12.38
#                 ### CSRU speed 20% slower than CSR on mnist (atomicAdd conflicts?), also cannot compute vecnorm.
#                 # f.sparse[n] && !f.toincr[n] && gpu()  ? CudaSparseMatrixCSRU(et, sz...) : # t:14.69
#                 ### Uncomment this if you want sparse incremental dw:
#                 ### Speed similar to dense on rnnlm, less memory, cannot compute vecnorm.
#                 # f.sparse[n] && f.toincr[n] && gpu()   ? ArrayAccumulator(et, sz) :
#                 # f.sparse[n] && f.toincr[n] && !gpu()  ? ArrayAccumulator(et, sz) :
#                 gpu() ? fillsync!(CudaArray(et, sz),0) : zeros(et, sz))
#     end
#     return dif0
# end

# function findtmp(f::Net, n)
#     tmp = nothing
#     for i=n+1:length(f.op)
#         if ((f.tmp[i]!=nothing) &&
#             (size(f.tmp[i]) == size(f.dif0[n])) &&
#             (f.sparse[n]==nothing || typeof(f.tmp[i]) <: f.sparse[n]))
#             tmp = f.tmp[i]
#             break
#         end
#     end
#     if tmp == nothing
#         et = eltype(f.out0[n])
#         sz = size(f.out0[n])
#         tmp = (
#                # CSRU is 5% faster if no atomic op conflicts (rnnlm),
#                # but significantly slower when there are lots of conflicts (mnist)
#                # Not worth the risk until I implement uniq for CSRU
#                # Seems significantly faster on s2s, putting csru back on
#                gpu() && f.sparse[n]!=nothing ? (f.sparse[n])(et, sz...) :
#                # gpu() && f.sparse[n] ? CudaSparseMatrixCSR(spzeros(et, sz...)) :
#                !gpu() && f.sparse[n]!=nothing ? spzeros(et, sz...) :
#                gpu() ? CudaArray(et, sz) :
#                Array(et, sz))
#     end
#     return tmp
# end

# if isa(f.op[i], Input) && issparse(f.out0[i])
#     for o in f.outputs[i]
#         if isa(f.op[o], Dot)
#             w = f.inputs[o][1]
#             @assert isa(f.op[w], Par)
#             f.sparse[w] = true
#         end
#     end
# end

# # instead of changing the ops, record the eltype in net and use it when generating stuff.
#     # for o in f.op
#     #     t = eltype(o)
#     #     if t == nothing
#     #         continue
#     #     elseif it == nothing
#     #         it = t
#     #     elseif t != it
#     #         seteltype!(o, it)
#     #     end
#     # end

# #####

# function netinit(f::Net)
#     initout(f, inputs...)
#     initdif(f, inputs...)
#     inittmp(f, inputs...)
# end

# """

# initout(f::Net, inputs...) initializes f.out[n] which points to the
# array holding the output of op[n].  f.out0[n] holds the actual array,
# allowing f.out[n] point to stack elements when necessary during back
# calculation.  We optimize memory use by sharing arrays when we can.

# """
# function initout(f::Net)
#     N = length(f.op)
#     index = zeros(Int,N)          			# index==0 represents need for new register
#     for n=1:N
#         overwrites(f.op[n]) || continue                 # see if we can reuse our input for output
#         f.tosave[n] && continue                         # a saved register should only be written by op[n]
#         i = f.inputs[n][1]                              # see if we can overwrite the first input
#         f.tosave[i] && continue                         # do not overwrite if you are going to save for back
#         ow = true; k = n                                # todo: checkout other inputs if this one fails
#         while true                                      # see if anybody else uses i before its next update
#             k = mod1(k+1, N)                            # todo: This is suboptimal, gives 13 regs for LSTM
#             in(i, f.inputs[k]) && (ow = false; break)   # Should look for existing regs no longer used
#             k == i && break                             # this is nontrivial because the sizes are unknown
#             k == N && i > N && break                    # but can possibly be inferred
#         end                                             # fencepost check: N==1:OK, i==n:OK, i>N:OK
#         ow && (index[n]=i)
#     end
#     f.out0 = cell(N)
#     for n=1:N                                           # index==0 ops get their own registers
#         index[n]==0 || continue
#         f.out0[n] = Any[]
#     end
#     for n=1:N                                             # other ops will overwrite existing registers
#         index[n]==0 && continue
#         k = index[n]
#         while index[k]!=0; k=index[k]; end
#         f.out0[n] = f.out0[k]
#     end
#     f.out = fillsync!(cell(N), nothing)                       # use nothing to represent identity element: 0 for add, 1 for mul
# end

# """
# initdif(f::Net) initializes f.dif[n], which is the loss gradient of the last output of op[n].
# f.dif0[n] holds the actual array, f.dif[n] can point to this or be 'nothing' representing the zero matrix.
# """
# function initdif(f::Net)
#     # todo: this is not optimal for add: no need for two copies of dy when neither input is overwriting.
#     # todo: tmp register to replace dif1 and serve other needs

#     index = zeros(Int,nops(f))                                  # index==0 represents need for new register
#     for n=1:nops(f)                                             # find out if back(op[n]) can overwrite dif[n]
#         overwrites(f.op[n]) || continue                         # overwrites means potentially both forw x<-y and back dy<-dx
#         f.toincr[n] && continue                                  # don't share dif[n] with multi-output
#         n == nops(f) && continue                                # don't share last output, dy may come in sparse
#         for i in f.inputs[n]
#             f.toincr[i] && continue                              # don't share dif[n] with multi-output
#             index[i]==0 || error("should not happen")
#             index[i]=n; break                                   # op[n] will overwrite dif[n] to get dif[i]
#         end
#     end
#     f.dif0 = cell(nops(f))
#     for n=1:nops(f)
#         index[n]==0 || continue
#         f.dif0[n] = Any[]
#     end
#     for n=1:nops(f)
#         index[n]==0 && continue
#         k = index[n]
#         while index[k]!=0; k=index[k]; end
#         f.dif0[n] = f.dif0[k]
#     end
#     f.dif = fillsync!(cell(nops(f)), nothing)
# end

# """
# inittmp(f::Net) initializes f.tmp[n] which is an extra array for:
# (1) incremental updates if f.toincr[n].
# (2) for forw/back ops that need extra space (todo)
# """
# function inittmp(f::Net)
#     # todo: this is inefficient, could use a single tmp for each size.
#     f.tmp = cell(nops(f))
#     for n=1:length(f.tmp)
#         f.tmp[n] = f.toincr[n] ? Any[] : nothing
#     end
# end

# ### DEAD CODE:

#     # initop(f, a...)
#     # initinputs(f, a...)
#     # @assert length(f.op)==length(f.inputs)
#     # initninputs(f)
#     # initparams(f)
# # function initstack(f::Net)
# #     f.stack = Any[]
# #     f.sp = 0
# # end

# #    initstack(f)

# # f.op[n] is the n'th operation in the net
# # The user specifies the operations in the MLP constructor arguments
# # If an argument is another MLP, its operations are spliced in

# # function initop(f::Net, a...)
# #     f.op = Op[]
# #     for ai in a
# #         isa(ai,Tuple) && (ai=ai[1])
# #         isa(ai,Op) ?  push!(f.op, ai) :
# #         isa(ai,Net)   ?  append!(f.op, ai.op) :
# #         error("Bad op: $ai")
# #     end
# # end

# # f.inputs[n] is an array of k indices for the inputs of the n'th op.
# # k is typically 1 but can be 2 for Add2 and Mul2 operations
# # index i<=nops(f) indicates output of f.op[i], i>nops(f) indicates network inputs
# # By default an op takes the results of the previous k op outputs
# # (or network inputs for initial ops)
# # The user can override this by providing a tuple argument for an op
# # The first element of the tuple is the op, the rest are user indices for inputs
# # userindex j>0 indicates output of userarg[j], j<=0 indicates network input 1-j.

# # function initinputs(f::Net, a...)
# #     newindex = Array(Int, length(a))
# #     lastindex = 0
# #     for i=1:length(a)
# #         ai = isa(a[i],Tuple) ? a[i][1] : a[i]
# #         lastindex += (isa(ai,Op) ? 1 : length(ai.op))
# #         newindex[i] = lastindex
# #     end
# #     f.inputs = Any[]
# #     for i=1:length(a)
# #         ai = isa(a[i],Tuple) ? a[i][1] : a[i]
# #         bi = isa(a[i],Tuple) ? a[i][2:end] : ((i-ninputs(ai)):(i-1))
# #         length(bi) == ninputs(ai) || error("Wrong number of inputs for $i:$(typeof(ai))")
# #         if isa(ai, Op)
# #             push!(f.inputs, map(j->(j>0 ? newindex[j] : nops(f)+1-j), Int[bi...]))
# #         else
# #             j0 = length(f.inputs)
# #             for aii in ai.inputs
# #                 push!(f.inputs, map(j->(j<=nops(ai) ? j+j0 : (j=bi[j-nops(ai)]; j>0 ? newindex[j] : nops(f)+1-j)), aii))
# #             end
# #         end
# #     end
# # end

# # f.ninputs is the number of inputs the whole MLP expects
# # indices i>nops(f) in f.inputs refer to network inputs

# # function initninputs(f::Net)
# #     n = 0
# #     for ai in f.inputs
# #         for aij in ai
# #             aij - nops(f) > n && (n = aij - nops(f))
# #         end
# #     end
# #     f.ninputs = n
# # end

# # f.params points to all op parameters

# # function initparams(f::Net)
# #     f.params = Any[]
# #     for o in f.op
# #         if isa(o,par) && isupdated(o)
# #             push!(f.params, o)
# #         end
# #     end
# # end

# # isupdated(o)=true # todo: should be false for rand and const

#     #     @assert !haskey(dict, target)			# each target has to be unique
#     #     for x in args
#     #         @assert haskey(dict, x)                     #
#     #     end
#     #     if func == :input && inputs != nothing          # subroutines take their input registers from caller
#     #         @assert length(inputs) >= nextinput
#     #         dict[target] = inputs[nextinput]
#     #         nextinput += 1
#     #     end
#     #     op = eval(Expr(:call, func, pars...))
#     # end
#     #

# # initforw(f::Net,x...) is called at the beginning of a sequence or
# # before processing a stand-alone item.  It is not called between
# # elements of a sequence.  It allocates and/or resizes f.out0.

# # function initforw2(f::Net, inputs...; keepstate=false, a...)
# #     f.dbg && display((:initforw0,keepstate,vecnorm0(f.out),vecnorm0(f.stack[1:f.sp])))
# #     f.sp == 0 || error("Stack corruption")
# #     length(inputs) == ninputs(f) || error("Wrong number of inputs")
# #     out = fillsync!(cell(length(f.out0)), nothing)          # todo: (minor) can we get rid of alloc
# #     lastinput = 0
# #     while findfirst(out,nothing) > 0                            # allow multiple passes for size inference
# #         nnothing = count(x->(x==nothing), out)
# #         for n = 1:nops(f)
# #             if out[n] != nothing
# #                 continue
# #             elseif isa(f.op[n], Input)
# #                 out[n] = initarray(f.out0, n, inputs[lastinput += 1])
# #             elseif isempty(f.inputs[n])                         # par, rnd, con
# #                 s = psize(f, n)                                 # todo: write psize inference
# #                 s == nothing && continue                        # may happen first pass
# #                 out[n] = initarray(f.out0, n, inputs[1], s; dense=true)
# #             else
# #                 s = ysize(f.op[n], out[f.inputs[n]]...)
# #                 s == nothing && continue # may happen with recurrent connections
# #                 out[n] = initarray(f.out0, n, out[f.inputs[n]][1], s; dense=true)
# #             end
# #         end
# #         nnothing == count(x->(x==nothing), out) && error("Cannot determine size of array $(findfirst(out,nothing))")
# #     end
# #     # We recover or reset f.out:
# #     keepstate ? copysync!(f.out, f.out0) : fillsync!(f.out, nothing) # todo: f.out[i] = arr(f.out0[i]) elsewhere..
# #     f.dbg && display((:initforw1,keepstate,vecnorm0(f.out),vecnorm0(f.stack[1:f.sp])))
# # end

# # function initarray(a, i, x, dims=size(x); dense=false)
# #     (display((:initarray0,summary(a[i]),i,summary(x),dims,dense,summary(a)));println())
# #     if isempty(a[i])
# #         oldai = a[i]
# #         if !dense && issparse(x)
# #             a[i] = spzeros(eltype(x), dims...)
# #             gpu() && (a[i] = CudaSparseMatrixCSC(a[i]))
# #         else
# #             a[i] = fillsync!(KUdense(gpu()?CudaArray:Array, eltype(x), dims), 0)
# #         end
# #         for j=1:length(a); a[j]===oldai && (a[j]=a[i]); end # preserve array sharing
# #     elseif eltype(a[i]) != eltype(x)
# #         error("Element type mismatch")
# #     elseif size(a[i]) != dims
# #         warn("Resizing $(size(a[i]))->$dims")
# #         fillsync!(resize!(a[i], dims), 0) # todo: this does not work for sparse
# #     end
# #     (display((:initarray1,summary(a[i]),i,summary(x),dims,dense,summary(a)));println())
# #     return a[i]
# # end

#             # elseif in(nothing, dims[f.inputs[n]])
#             #     continue
#             # else
#             # end

#             # if isempty(f.inputs[n])                     # happens with par, rnd, con, input
#             #     elseif prod(size(f.op[n])) > 0
#             #         dims[n] = size(f.op[n])
#             #     end
#             # end
#             # if isa(op, Input)
#             #     dims[n] = size(inputs[lastinput += 1])
#             # elseif isa(op, Par) && prod(op.dims) > 0
#             #     dims[n] = op.dims
#             # elseif isa(op, Dot)
#             #     (i1,i2) = f.inputs[n]
#             #     (d1,d2) = dims[i1,i2]
#             #     if d1 == nothing || d2 == nothing
#             #         continue
#             #     end
#             #     m1 = prod(d1[1:end-1])                   # treat [d...,dn] as [prod(d...), dn] matrix
#             #     n1 = d1[end]
#             #     m2 = prod(d2[1:end-1])
#             #     n2 = d2[end]
#             #     if m1 == 0 || n2 == 0
#             #         continue
#             #     end
#             #     if n1 == m2 == 0
#             #         continue
#             #     elseif n1 == 0
#             #         setdims!(f.op[i1], (d1[1:end-1]..., m2))
#             #     elseif m2 == 0
#             #         length(d2) == 2 || error("Cannot infer size of tensor")
#             #         setdims!(f.op[i2], (n1, d2[2]))
#             #     elseif n1 == m2
#             #         dims[n] = (m1,n2)
#             #     else
#             #         error("Dot size mismatch")
#             #     end
#             # end
#             # # input, par, dot, add, mul, actf, loss, conv, pool

# function initback0(f::Net, dy; a...)
#     N = length(f.op)
#     firstwrite = zeros(Int, N)                          # dif[n] is read at t=n, find out when it is first written.
#     # todo: dif[N] is special!
#     for n=N:-1:1
#         f.toback[n] || continue
#         k = n
#         while true
#             in(n, f.inputs[k]) && (firstwrite[n] = k; break)
#             k = mod1(k-1, N)
#         end
#     end
#     return firstwrite
#     for n=N:-1:1
#         nsparse = false # todo
#         f.toback[n] || continue
#         f.dif[n] = finddif(f, n, nsparse)
#         f.toincr[n] && (f.tmp[n] = findtmp(f, n, nsparse))
#     end
# end

# function finddif(f::Net, n, nsparse)
#     isa(f.op[n], Par) && return                         # par difs should persist across iterations
#     N = length(f.op)
#     k = n; nw1 = 0                                      # dif[n] is read at t=n, find out when it is first written.
#     while true
#         in(n, f.inputs[k]) && (nw1 = k; break)          # it could potentially be written at t=n right after reading
#         k = mod1(k-1, N)
#     end
#     @assert nw1 > 0                                     # dif[n] will be busy from nw1 to n going back cyclical
#     free = nothing                                      # we need dif[i] that is free during this period
#     for i = n+1:N                                       # note that dif[i] may already be shared to some dif[j]
#         isa(f.op[i], Par) && return
#         size(f.dif[i]) == size(f.out0[n]) || continue
#         issparse(f.dif[i]) == nsparse || continue

#     end
#     return free
# end

# initback(f::Net, dy) called at the beginning of a sequence or a
# stand-alone item, never between elements of a sequence.

# function initback1(f::Net, dy; seq=false, a...)
#     fillsync!(f.dif, nothing)                           # why? (todo)
#     for n=1:length(f.dif0)
#         y = (n==nops(f) && dy!=nothing ? dy : f.out0[n])
#         initarray(f.dif0, n, y; dense=true) # x and dw may be sparse, dx and w always dense
#         if f.toincr[n]
#             initarray(f.tmp, n, f.dif0[n])
#         end
#     end
#     for n=1:length(f.dif0)
#         f.toincr[n] && fillsync!(f.dif0[n], 0)           # zeroed by back at every item in sequence
#     end
#     if seq
#         for w in params(f)       # zeroed only once at the beginning of the sequence
#             isdefined(w,:diff) && isdefined(w,:inc) && fillsync!(w.diff,0)
#         end
#     end
# end

# function initback0(f::Net, dy, dx...; a...)
#     N = length(f.op)
#     dxback = falses(N)
#     if !isempty(dx)                                     # todo: what if this changes after net init?
#         lastinput = 0
#         for n=1:N
#             isa(f.op[n], Input) || continue
#             dx[lastinput += 1] == nothing || (dxback[n] = true)
#         end
#     end
#     for n=N:-1:1
#         nsparse = difsparse(f, dy, n)
#         f.toback[n] || dxback[n] || continue
#         # f.dif0[n] = finddif(f, n, nsparse)  # todo-OPTIMIZATION
#         f.dif0[n] = newarray(gpu(), nsparse, eltype(f.out0[n]), size(f.out0[n]))
#         if f.toincr[n]    # todo: what if this changes after init?
#             # f.tmp[n] = findtmp(f, n, nsparse) # todo-OPTIMIZATION
#             f.tmp[n] = newarray(gpu(), nsparse, eltype(f.out0[n]), size(f.out0[n]))
#         end
#     end
# end

        # else                    # otherwise find one with matching size
        #     for k=o+1:length(f.op)
        #         if (!f.toincr[k]
        #             && (f.dif0[ k]!=nothing)
        #             && size(f.dif0[k]) == size(f.out0[n])
        #             && stype(f.dif0[k]) == st
        #             && f.outputs[k][1] > k)
        #             dif0 = f.dif0[k]
        #             # todo: However we need to check and see if this has been used between n..o
        #             # Also we don't know whether o > n for sure
        #             # This all needs more thinking
        #             break
        #         end
        #     end
# should be part of reset:
    # fillsync!(f.dif, nothing)
    # for n=1:length(f.op)
    #     (f.dif0[ n]!=nothing) && f.toincr[n] && fillsync!(f.dif0[n], 0)
    # end

# for n=length(f.op):-1:1
#     f.toback[n] || continue # we mix initback and initback0 here because if getdx or seq changes we may need to alloc new arrays.
#     if (f.dif0[n]!=nothing) # todo: implement batch size change
#         @assert (issimilar2(f.dif0[n], f.out0[n]) ) #todo: && issparse(f.dif0[n])==(f.sparse[n]!=nothing)
#     else
#         f.dif0[n] = finddif(f, n)
#         # f.dif[n] = nothing # Leave this to reset! otherwise s2s does not work
#     end
#     if f.toincr[n]
#         if (f.tmp[n]!=nothing)
#             @assert (issimilar2(f.tmp[n], f.out0[n]) && issparse(f.tmp[n])==(f.sparse[n]!=nothing))
#         else
#             f.tmp[n] = findtmp(f, n)
#             # fillsync!(f.dif0[n], 0)  # This will break s2s best if finddif zeros during alloc
#         end
#     end
# end

    # This is not true for nce; ygold and f.out0[end] have different dimensions.
    # @assert ygold == nothing || issimilar2(ygold, f.out0[end])


struct GPModel{TGP} <: AbstractMCMC.AbstractModel
    gp::TGP
end

struct GPSampler{TS} <: AbstractMCMC.AbstractSampler
    sampler::TS
end

function StatsBase.sample(model::MCGP, nSamples::Int; kwargs...)
    return sample(Random.GLOBAL_RNG, model, nSamples; kwargs...)
end
function StatsBase.sample(rng::Random.AbstractRNG, model::MCGP, nSamples::Int; kwargs...)
    sampler = inference(model)
    thinning = get(kwargs, :thinning, sampler.thinning)
    discard_initial = get(kwargs, :discard_initial, sampler.nBurnin)
    progressname = get(kwargs, :progressname, "Sampling with $sampler")
    return sample(
        rng,
        GPModel(model),
        GPSampler(sampler),
        nSamples;
        thinning,
        discard_initial,
        progressname,
        kwargs...,
    )
end
function AbstractMCMC.step(
    rng, model::GPModel, sampler::GPSampler{<:GibbsSampling}; kwargs...
)
    compute_kernel_matrices!(model.gp)
    sample_local!(likelihood(model.gp), yview(model.gp), means(model.gp))
    f = sample_global!.(∇E_μ(model.gp), ∇E_Σ(model.gp), Zviews(model.gp), getf(model.gp))
    sampler.sampler.nIter += 1
    return f, nothing
end

function AbstractMCMC.step(
    rng, model::GPModel, sampler::GPSampler{<:GibbsSampling}, state; kwargs...
)
    sample_local!(likelihood(model.gp), yview(model.gp), means(model.gp))
    f = sample_global!.(∇E_μ(model.gp), ∇E_Σ(model.gp), Zviews(model.gp), getf(model.gp))
    sampler.sampler.nIter += 1
    return f, nothing
end

function AbstractMCMC.bundle_samples(
    samples, model::GPModel, sampler::GPSampler, state, chain_type::Type; kwargs...
)
    resume = get(kwargs, :cat, true)
    if !resume || isempty(sampler.sampler.sample_store) # check if either one should restart sampling or if no samples was ever taken
        sampler.sampler.sample_store = samples
    else
        sampler.sampler.sample_store = vcat(sampler.sampler.sample_store, samples)
    end
    return samples
end


module EqualitySaturation

using Mixtape
using MacroTools
using BenchmarkTools

f(x) = (x - x) + (10 * 15)

@ctx (true, true, false) struct MyMix end
allow(ctx::MyMix, m::Module) = m == EqualitySaturation

swap(e) = e
function swap(e::Expr)
    new = MacroTools.postwalk(e) do s
        isexpr(s, :call) || return s
        s.args[1] == Base.literal_pow || return s
        return Expr(:call, apply, Base.:(*), s.args[3:end]...)
    end
    return new
end

function transform(::MyMix, b)
    return b
end

Mixtape.@load_call_interface()
display(call(MyMix(), f, 3))

end # module


# Author: Mikael Koli
# All rights reserved

module BotMarket

    # Functions and structs for the module
    export AbstractInvestor, AbstractMarket,
        # Structs
        DoubleAuctionMarket,

        ZeroIntelligentInvestor,
        ExternalWorld,
        AskLimitOrder, BidLimitOrder,
        RandomWalkAsset, FixedAsset,

        # Functions
        place!,
        clear!,
        cancel_all!,
        release_all!,
        update!,
        pay_cashflows!,

        # Generics
        generic_currency,
        generic_stock,

        # For debugging
        get_order,
        get_order_quantity,
        get_order_price,
        get_side,
        get_unreserved,
        # Abstracts
        AbstractAsset,
        Trade

    # Including the module files where the
    # the above structs and functions come
    # from

    include("abstracts.jl")

    include("market/orders.jl")
    include("market/trade.jl")
    include("market/clear.jl")
    include("market/limitorderbook.jl")

    include("investor/api.jl")
    include("investor/generic.jl")
    include("investor/position.jl")

    include("asset/api.jl")
    include("external_world/external_world.jl")

    # Built in
    include("builtin/zero_intelligent.jl")
    include("builtin/asset.jl")
    include("builtin/double_auction.jl")
    include("builtin/currency.jl")

    # Defining some generics for easier use
    generic_currency = RandomWalkAsset(0, 0, 0, 0, "ccy")
    generic_stock = RandomWalkAsset(0, 0, 0, 0, "stock")

end


#Defines the Guidance system type, including its discrete time behaviour
#include("DiscreteTimeSystem.jl")

#Define ControlSystem as a subtype of the DiscreteTimeSystem
abstract type AbstractGuidanceSystem <: DiscreteTimeSystem end

########### Template function ###########################
mutable struct GuidanceSystem{T<:Number} <: AbstractGuidanceSystem
  Active::Bool
  Ts::T #sample time
  GuidanceRelation::Function
  Tprev::T #storage for previous time it was updated, hence must be a mutable type
end
Guidance() = GuidanceSystem(false, 0.0, x -> nothing, 0.0)
GuidanceSystem(Ts::Number) = GuidanceSystem(false, Float64(Ts), x -> nothing, 0.0)
GuidanceSystem(Ts::Number, csfunc::Function) = GuidanceSystem(true, Float64(Ts), csfunc, 0.0)
GuidanceSystem(Active::Bool, Ts::Number, csfunc::Function) = GuidanceSystem(Active, Float64(Ts), csfunc, 0.0)
#Set the callback affect condition of the ControlSystem
#placeholder!
function affect!(int, dts::Type{<:AbstractGuidanceSystem})
    for cu in user_cache(int)
        cu.u = [dts.GuidanceRelation(int.u)...]
    end
  dts.Tprev = int.t
end


## TODO consolidate low-level part code. I thought newer code was better. Now, it seems the older code is useful

posnegi(x::Mxpr,n::Integer) = n >= 0 ? n : length(x) + n + 1
## WARNING: The following method is not the same as the others, it won't work in the general case (not for sequence specs)
## we may need to do something about this.
## In posnegi(obj,n) in general, obj is the object a part of which we want to get
## In posnegi below nmax is not this object
posnegi(nmax::Integer,n::Integer) = n >= 0 ? n : nmax + n + 1
posnegi(x,n::Integer) = n
posnegi(x,a) = a

# This *is* used. Eg 1[0] --> Integer
# FIXME: throw Symata error, not Julia
function get_part_one_ind(x, ind::Integer)
    ind != 0 && throw(BoundsError("part specification $ind is longer than the depth of the object."))
    return head(x)
end

function get_part_one_ind(texpr::V,ind::Integer) where V<:Union{Mxpr,Array}
    ind = posnegi(texpr,ind)
    texpr = ind == 0 ? mhead(texpr) : texpr[ind]
    return texpr
end
get_part_one_ind(texpr::Dict,tind) = texpr[tind]  # Part 0 can't return "Dict" because it could be a key.
get_part_one_ind(texpr::Tuple,tind) = texpr[tind]
function get_part_one_ind(texpr::Mxpr,tind::Mxpr{:Span})
    spanargs = margs(tind)
    lsp = length(spanargs)
    if lsp == 2
        nargs = view(margs(texpr),spanargs[1]:spanargs[2]) # need function to do this translation
    elseif lsp == 3
        nargs = view(margs(texpr),spanargs[1]:spanargs[3]:spanargs[2])
    end
    texpr = mxpr(mhead(texpr),nargs...) # we need splice to copy Int Array to Any Array
    return texpr
end

### Part

# Get part of expression. Julia :ref is mapped to :Part
# a[i] parses to Part(a,i), and a[i][j] to Part(Part(a,i),j)
# a[i,j] parses to Part(a,i,j).

@mkapprule Part  """
    Part(expr,n) or expr[n]

returns the `n`th element of expression `expr`.

    Part(expr,n1,n2,...) or expr[n1,n2,...]

return the subexpression at index `[n1,n2,...]`.

The same can be achieved less efficiently with `expr[n1][n2]...`.

    expr[n] = val

set the `n`th part of `expr` to `val`. `n` and `val` are evaluated
normally. `expr` is evaluated once.

`n` less than zero counts backward from the end of the expression or subexpression.

`expr[n]` also returns the `n`th element of instances of several
Julia types such as `Array`, or the element with key `n` for `Dict`'s.

`Part` also indexes into some sympy objects, such as sympy Tuples.
"""

@doap Part(texpr,tinds...) = getpart2(texpr,tinds...)

function getpart2(texpr,tinds...)
    for tind in tinds
        texpr = get_part_one_ind(texpr,tind)
    end
    return texpr
end

### Span

@sjdoc Span """
    Span(a,b) or a:b

represents elements `a` through `b`.

    Span(a,b,c) or a:b:c

represents elements `a` through `b` in steps of `c`.

`expr[a:b]` returns elements a through `b` of expr, with the same head as `expr`.
"""

### Position

@mkapprule Position """
    Position(expr,x)

return a list of part specifications (indices) of positions in
`expr` at which `x` occurs.
"""

@doap Position(expr,subx) = tolistoflists(find_positions(expr,subx))
@curry_second Position

"""
    find_positions(ex,subx)

return a list of part indices at which subexpression `subx` occurs in expression `ex`.
"""
function find_positions(ex,subx)
    posns = Array{Array{Int,1}}(undef, 0)
    lev = Array{Int}(undef, 100)
    clev::Int = 1
    lev[clev] = 0
    capt = capturealloc()
    psubx = patterntoBlank(subx)
    _find_positions(ex,psubx,lev,posns,clev,capt)
    return posns
end

# TODO: split out literal pattern code: This routine will be the main routine for
# finding positions, inlcuding when we know that the pattern is literal.
# The literal pattern code is commented out below
function _find_positions(ex::Mxpr,psubx,lev,posns,clev,capt)
    if clev > length(lev) push!(lev,0) end
    args = margs(ex)
    @inbounds for i in 1:length(args)
        lev[clev] = i
        _find_positions(args[i],psubx,lev,posns,clev+1,capt)
    end
    (gotmatch, capt) = match_and_capt(mhead(ex),psubx,capt)
    if gotmatch
#    if mhead(ex) == subx      # Use this for literal pattern
        lev[clev] = 0
        nlev = copy(lev)
        push!(posns,view(nlev,1:clev))
    end
    (gotmatch, capt) = match_and_capt(ex,psubx,capt)
    if gotmatch
#    if ex == subx
        nlev = copy(lev)
        push!(posns,view(nlev,1:clev-1))
    end
end

function _find_positions(ex,psubx,lev,posns,clev,capt)
    (gotmatch, capt) = match_and_capt(ex,psubx,capt)
    if gotmatch
#    if ex == subx
        nlev = copy(lev)
        push!(posns,view(nlev,1:clev-1))
    end
end

#### setpart

## setpart2! does the same, but I think it  is better and simpler and doesnt seem to be broken

## getpart is used only here. it is defined in mxpr.jl. It is probably not fast
## maybe getpart2 above is faster and handles more cases.
"""
    setpart!(mx::Mxpr,val,inds...)

set the part of `mx` indexed by `inds` to `val`.

The last index equal to zero means the head of the subexpression specified by the previous indices.
Because most heads are effectively immutable, we must replace the final subexpression in this case.
"""
function setpart!(mx::Mxpr,val,inds...)
    if length(inds) == 0
#        return mxpr(val,margs(mx))
        return mxprnewhead(mx, val)
    elseif length(inds) == 1
        if inds[1] == 0  # replacing head
#            mx = mxpr(val,margs(mx)...)
            mx = mxprnewhead(mx,val)
            # Function application is very slow if this branch is taken.
            return mx
        else
            margs(mx)[inds[1]] = val
        end
    elseif inds[end] == 0
        ninds = inds[1:end-2]
        if length(ninds) == 0
            symerror("Not implemented getting no part of $mx")
        end
        ex = getpart(mx, ninds...)
        ex1 = margs(ex)[inds[end-1]]
#        margs(ex)[inds[end-1]] = mxpr(val, margs(ex1))
        margs(ex)[inds[end-1]] = mxprnewhead(ex1,val)
    else
        ex = getpart(mx, inds[1:end-1]...)
        margs(ex)[inds[end]] = val
    end
    mx
end

## This is older, but seems better.
## This checks for negative indices. If calling setpart!, this checking must be done before calling
## setpart! is intended for dev code where negative indices won't appear. But, it is probably not
## necessary to have setpart!
##
## A complication arises because the head (Head) of an Mxpr cannot be changed because the head is
## also in the type Mxpr{sym}. If the head needs to be changed, a copy must be made. The exception
## is if the head is not a symbol. In this case, the type is Mxpr{GenHead}. The head is always stored
## in a field as well. It is possible, but undesirable for the type and field disagree.
## This is why the previous level expression is stored in setpart2!
function setpart2!(mx::Mxpr, val, inds...)
    ex = mx
    exlast = ex
    ninds = length(inds)
    for j in 1:ninds-1
        exlast = ex
        ex = get_part_one_ind(ex,inds[j])
    end
    ind = posnegi(ex,inds[ninds])
    if ind == 0
        exlast[inds[ninds-1]] = mxprnewhead(ex,val)
    else
        ex[ind] = val
    end
    val
end

## either setpart! or setpart2! works here.
Base.setindex!(mx::Mxpr, val, inds...) = setpart2!(mx,val,inds...)

#### localize variable

"""
    maybe_localize_variable(var::Symbol,expr)

If `var` is unbound (that is, evaluates to itself), return `(var,expr)`.
If `var` is bound, return `(var1,expr1)`, where `var1` is a new symbol (from `gensym`)
and `expr1` is a copy of `expr` with `var` replaced everywhere by `var1`.
"""
function maybe_localize_variable(var,expr::Mxpr)
    isbound(var) || return (var,expr)
    localize_variable(var,expr)
end

"""
    localize_variable(var::Symbol,expr)

return `(var1,expr1)`, where `var1` is a new symbol (from `gensym`)
and `expr1` is a copy of `expr` with `var` replaced everywhere by `var1`.
"""
function localize_variable(var,expr::Mxpr)
    sym = get_localized_symbol(var)  # not really necessary that named contains var
    positions = find_positions(expr,var)
    nexpr = deepcopy(expr)
    for pos in positions
        nexpr = setpart!(nexpr, sym, pos...)
    end
    (sym, nexpr)
end

function localize_variable(var,expr::SJSym)
    sym = get_localized_symbol(var)
    var == expr && return (sym,sym)
    return (sym, expr)
end

localize_variable(var,expr) = (get_localized_symbol(var), expr)

function localize_variables(vars::Array,expr::Mxpr)
    syms = map(get_localized_symbol, vars)
    nexpr = deepcopy(expr)
    for (sym,var) in zip(syms,vars)
        positions = find_positions(expr,var)
        for pos in positions
            setpart!(nexpr, sym, pos...)
        end
    end
    (syms, nexpr)
end

function localize_variables(vars::Array,expr::SJSym)
    syms = map(get_localized_symbol, vars)
    for (sym,var) in zip(syms,vars)
        var == expr && return (syms,sym)
    end
    return (syms, expr)
end

localize_variables(vars::Array,expr) = (map(get_localized_symbol, vars), expr)

### Take

@sjdoc Take """
    Take(expr,n)

returns `expr` keeping only the first `n` arguments.

    Take(expr,-n)

returns `expr` dropping all but the last `n` arguments.

    Take(expr,[n])

returns `expr` keeping only the `n`th arguments.

    Take(expr,[m,n])

returns `expr` keeping only the `m`th through `n`th arguments.

    Take(expr,[m,n,s])

returns `expr` keeping only the `m`th through `n`th arguments, with step `s`.

    Take(expr,spec1,spec2,...)

apply `spec1` at level `1`, `spec2` at level `2`...
"""
@mkapprule Take
@doap Take(x::Mxpr, rawspecs...) = take(x,map(sequencespec, rawspecs)...)
take(x, onespec, specs...) = mxpr(mhead(x),mapmargs(t -> take(t,specs...), margs(take(x,onespec)))...)
take(x,spec::SequenceN)     = mxpr(mhead(x), margs(x)[spec.n>=0 ? (1:spec.n) : (length(x)+spec.n+1:end)]...)
take(x,spec::SequenceUpToN) = mxpr(mhead(x), margs(x)[1:min(spec.n,length(x))]...)
take(x,spec::SequenceNOnly) = mxpr(mhead(x), margs(x)[posnegi(x,spec.n)])
take(x,spec::SequenceMN)    = mxpr(mhead(x), margs(x)[posnegi(x,spec.m):posnegi(x,spec.n)]...)
take(x,spec::SequenceMNS)   = mxpr(mhead(x), margs(x)[posnegi(x,spec.m):spec.s:posnegi(x,spec.n)]...)
take(x,spec::SequenceNone)  = mxpr(mhead(x))
take(x,spec::SequenceAll)   = mxpr(mhead(x), margs(x)...)

### Drop

# With a little work, we could raise an error if the user tries to drop more elements
# than exists. In fact, the behavior is as if we always use UpTo.
@sjdoc Drop """
    Drop(expr,n)
    Drop(expr,-n)
    Drop(expr,[m,n])

!!! note
    `Drop(expr,UpTo(n))` is not necessary because `Drop(expr,n)` already gives the
    desired behavior.
"""

@mkapprule Drop
@doap Drop(x::Mxpr, rawspecs...) = drop(x,map(sequencespec, rawspecs)...)
drop(x, onespec, specs...) = mxpr(mhead(x),map(t -> drop(t,specs...), margs(drop(x,onespec)))...)
drop(x,spec::SequenceN) = mxpr(mhead(x), margs(x)[spec.n>0 ? (((spec.n)+1):end) : (1:length(x)+spec.n)]...)
drop(x,spec::SequenceUpToN) = drop(x,SequenceN(spec.n))

function drop(x,spec::SequenceNOnly)
    n = posnegi(x,spec.n)
    ma = margs(x)
    mxpr(mhead(x), ma[1:n-1]..., ma[n+1:end]...)
end

function drop(x,spec::SequenceMN)
    m = posnegi(x,spec.m)
    n = posnegi(x,spec.n)
    ma = margs(x)
    mxpr(mhead(x), ma[1:m-1]..., ma[n+1:end]...)
end

### Extract

@sjdoc Extract """
    Extract(expr, list)

returns the subexpression specified by `list`.

    Extract(expr, [list1, list2, ...])

returns a list of subexpressions.

    Extract(expr, [list1, list2, ...], h)

wraps each subexpression with head `h`.

    Extract(list)

operator form of `Extract`.

`list` is a part specification as returned by `Part`.
"""
@mkapprule Extract

@doap function Extract(expr, p::ListT)
    isa(p[1],Integer) && return expr[margs(p)...]
    ! isa(p[1],ListT) && symerror("Extract: Bad part specification ", p)
    nargs = newargs(length(p))
    for i in 1:length(p)
        nargs[i] = expr[margs(p[i])...]
    end
    return MList(nargs)
end

@doap function Extract(expr, p::ListT, h)
    isa(p[1],Integer) && return mxpr(h,expr[margs(p)...])
    ! isa(p[1],ListT) && symerror("Extract: Bad part specification ", p)
    nargs = newargs(length(p))
    for i in 1:length(p)
        nargs[i] = mxpr(h,expr[margs(p[i])...])
    end
    return MList(nargs)
end

@curry_last Extract

### Replace

@sjdoc Replace """
    Replace(expr,rule)

replace parts in expr according to `rule`.

    Replace(expr,rule,n)

replace at levels less than or equal to `n`.

    Replace(expr,rule,[n])

replace at level `n` only.
"""

@sjseealso_group(Replace,ReplaceAll)
@sjexamp(Replace,
         ("Clear(a,b,c)",""),
         ("Replace( Cos(a+b)^2 + Sin(a+c)^2, Cos(x_)^2 + Sin(x_)^2 => 1)",
          "Cos(a + b)^2 + Sin(a + c)^2", "This expression does not match the pattern."),
         ("Replace( Cos(a+b)^2 + Sin(a+b)^2, Cos(x_)^2 + Sin(x_)^2 => 1)",
          "1", "This expression does match the pattern."))

@mkapprule Replace

# function apprules(mx::Mxpr{:Replace})
#     doreplace(mx,margs(mx)...)
# end

# function doreplace(mx,expr,r::Rules)
#     (success, result) = replace(expr,r)
#     result
# end

@doap function Replace(expr,r::Rules)
    (success, result) = replace(expr,r)
    result
end

@doap function Replace(expr,r::Rules,inlevelspec)
    levelspec = make_level_specification(expr,inlevelspec)
    (success, result) = replace(levelspec,expr,r)
    result
end

@curry_second Replace

#### ReplaceAll

@sjdoc ReplaceAll """
    ReplaceAll(expr,rule)

replace parts at all levels in expr according to `rule`. This includes
the `Head` of `expr`, and the entire `expr`.

    ReplaceAll(expr,List(rule1,rule2,...))

replace parts at all levels according to the
list of rules. If given explicitly, the rules should be given as `List(...)` rather than
`[...]` because of a parsing error.

    op = ReplaceAll(rule)

Define function `op(expr)` that returns `ReplaceAll(expr,rule)`.
"""

@mkapprule ReplaceAll

@doap ReplaceAll(expr,r::Rules) =replaceall(expr,r)

@doap function ReplaceAll(expr,rs::Mxpr{:List})
    if listoflistsq(rs)
        maplist( r ->  _doreplaceall(mx,expr,r), rs)
    else
        _doreplaceall(mx,expr,rs::Mxpr{:List})
    end
end

function _doreplaceall(mx,expr,rs::Mxpr{:List})
    rsa = Array{Any}(undef, 0)
    for i in 1:length(rs)
        if isa(rs[i],Rules)
            push!(rsa, rs[i])
        else
            @symwarn("ReplaceAll expected Rule  got ", rs[i])
            nothing  # do something better here, like return mx
        end
    end
    replaceall(expr,rsa)
end

@sjexamp( ReplaceAll,
         ("ClearAll(zz,b,c)",""),
         ("zz = 10 * b^2 * (c+d)","zz = 10 * b^2 * (c+d)"),
         ("ReplaceAll(zz, List(c => 3,d => 2) )", "50*b^2"))

@curry_second ReplaceAll

### ReplaceRepeated

@mkapprule ReplaceRepeated :options => Dict( :MaxIterations => 65536 )

@sjdoc ReplaceRepeated """
    ReplaceRepeated(expr,rules)

perform `ReplaceAll(expr,rules)` repeatedly until `expr` no longer changes.
"""

@doap ReplaceRepeated(expr,r::T; kws...) where {T<:Rules} = replacerepeated(expr,r; kws...)

## FIXME: use get to get keywords
#function do_ReplaceRepeated(mx::Mxpr{:ReplaceRepeated},expr,rs::Mxpr{:List}; kws...)
@doap function ReplaceRepeated(expr,rs::Mxpr{:List}; kws...)
    rsa = Array{Any}(undef, 0)
    for r in rs
        if isa(r,Rules)
            push!(rsa, r)
        else
            @symwarn("ReplaceRepeated expected Rule, got ", r)
            nothing  # do something better here, like return mx
        end
    end
    replacerepeated(expr,rsa; kws...)
end

@doap ReplaceRepeated(a,b; kws...) = mx

### MatchQ

@sjdoc MatchQ """
    MatchQ(expr,pattern)

return `True` if `expr` matches `pattern`.

    op = MatchQ(pattern)

Define a function `op(expr)` that returns `MatchQ(expr,pattern)`.
For example, `myintq = MatchQ(_Integer)`.
"""
@mkapprule MatchQ
@doap MatchQ(expr,pat) = matchq(expr,pat)
matchq(expr,pat) = match_no_capture(expr,patterntoBlank(pat))
@curry_last MatchQ

@sjexamp( MatchQ,
         ("MatchQ( 1, _Integer)", "true"),
         ("ClearAll(gg,xx,b)",""),
         ("MatchQ( gg(xx) , _gg)", "true"),
         ("MatchQ( b^2, _^2)","true"))


using Klimakoffer

Klimakoffer.upscale_world(joinpath(@__DIR__,"..","input","world"), "The_World128x65.dat",150)

upscaled = Klimakoffer.read_geography(joinpath(@__DIR__,"..","input","world","The_World150x76.dat"), 150, 76)

ref = Klimakoffer.read_geography(joinpath(@__DIR__,"..","examples","reference_data","world","ref_The_World150x76.dat"), 150, 76)

diff = ref-upscaled

res = sum(abs.(diff))


## Allows to iterate over kernels
Base.length(::Kernel) = 1
Base.iterate(k::Kernel) = (k, nothing)
Base.iterate(k::Kernel, ::Any) = nothing

printshifted(io::IO, o, shift::Int) = print(io, o)

# Fallback implementation of evaluate for `SimpleKernel`s.
(k::SimpleKernel)(x, y) = kappa(k, evaluate(metric(k), x, y))


# just to avoid magical constants in code
const CODON_LENGTH = 3

const BASES = DNASeq("ACGT")
const BASEINTS = Dict(DNA_A => 1, DNA_C => 2, DNA_G => 3, DNA_T => 4)

const DEBUG = true

"""Only assert when DEBUG is true"""
macro myassert(exp, msg)
    if DEBUG
        return :($exp || error($msg))
    end
    return :()
end

macro includeif(test, exp)
    if test
        return exp
    end
    return :()
end

"""LogSumExp in base 10.

Borrowed from StatsFuns.jl.
"""
function logsumexp10(x::AbstractArray{T}) where {T <: Real}
    S = typeof(exp10(zero(T)))    # because of 0.4.0
    isempty(x) && return -S(Inf)
    u = maximum(x)
    abs(u) == Inf && return any(isnan, x) ? S(NaN) : u
    s = zero(S)
    for i = 1:length(x)
        @inbounds s += exp10(x[i] - u)
    end
    log10.(s) + u
end

@generated function summax(a, b)
    return quote
        result = a[1] + b[1]
        for i = 2:min(length(a), length(b))
            result = max(result, a[i] + b[i])
        end
        return result
    end
end


# include generic methods
include("pred_ared.jl")
include("step_computation.jl")

# # include ARC methods
include("ARC1D/ARC-Cub.jl")
include("ARC1D/ARC-Nwt.jl")
include("ARC1D/ARC-Sec.jl")
include("ARC1D/ARC-SecA.jl")

include("ARC1D/ARC_generic.jl")
include("ARC1D/ARC_direction_computation.jl")

# include Trust Region methods
include("TR1D/TR-Cub.jl")
include("TR1D/TR-Nwt.jl")
include("TR1D/TR-Sec.jl")
include("TR1D/TR-SecA.jl")

include("TR1D/TR_generic.jl")
include("TR1D/TR_direction_computation.jl")

# # include zoom
include("Zoom1D/Trouve_IntervalleA.jl")
include("Zoom1D/zoom_generic.jl")
include("Zoom1D/zoom-Cub.jl")
include("Zoom1D/zoom-Nwt.jl")
include("Zoom1D/zoom-Sec.jl")
include("Zoom1D/zoom-SecA.jl")

# # include bissection
include("Bissection/Trouve_Intervalle.jl")
include("Bissection/Bissect.jl")
include("Bissection/BissectNwt.jl")
include("Bissection/BissectSec.jl")
include("Bissection/BissectSecA.jl")
include("Bissection/BissectCub.jl")


module RankingWrapper

using JavaCall

const Class = @jimport java.lang.Class
const Enum = @jimport java.lang.Enum
const JString = @jimport java.lang.String
const NaNStrategy = @jimport org.hipparchus.stat.ranking.NaNStrategy
const NaturalRanking = @jimport org.hipparchus.stat.ranking.NaturalRanking
const Object = @jimport java.lang.Object
const Optional = @jimport java.util.Optional
const RandomGenerator = @jimport org.hipparchus.random.RandomGenerator
const RankingAlgorithm = @jimport org.hipparchus.stat.ranking.RankingAlgorithm
const TiesStrategy = @jimport org.hipparchus.stat.ranking.TiesStrategy

export NaNStrategy
export NaturalRanking
export RankingAlgorithm
export TiesStrategy
export compare_to
export describe_constable
export equals
export get_class
export get_declaring_class
export get_nan_strategy
export get_ties_strategy
export hash_code
export name
export notify
export notify_all
export ordinal
export rank
export to_string
export value_of
export values
export wait

include("na_n_strategy.jl")
include("natural_ranking.jl")
include("ranking_algorithm.jl")
include("ties_strategy.jl")

end


module CrystalStructures

using   Printf
using   StaticArrays
using   LinearAlgebra
import  Crystalline

# Number of space groups
# OEIS: A006227
const NO_SGS = (2, 17, 230, 4985, 222097)
# Number of space groups, with chiral copies not distinct
# OEIS: A004029
const NO_SGS_PAIRED = (2, 17, 219, 4783, 222018, 28927915)

# List of elements
# You can convert a vector of element numbers to a vector of element names with ELEMENTS[v]
const ELEMENTS =
[
    "H",  "He", "Li", "Be", "B",  "C",  "N",  "O",  "F",  "Ne",
    "Na", "Mg", "Al", "Si", "P",  "S",  "Cl", "Ar", "K",  "Ca",
    "Sc", "Ti", "V",  "Cr", "Mn", "Fe", "Co", "Ni", "Cu", "Zn",
    "Ga", "Ge", "As", "Se", "Br", "Kr", "Rb", "Sr", "Y",  "Zr",
    "Nb", "Mo", "Tc", "Ru", "Rh", "Pd", "Ag", "Cd", "In", "Sn",
    "Sb", "Te", "I",  "Xe", "Cs", "Ba", "La", "Ce", "Pr", "Nd",
    "Pm", "Sm", "Eu", "Gd", "Tb", "Dy", "Ho", "Er", "Tm", "Yb",
    "Lu", "Hf", "Ta", "W",  "Re", "Os", "Ir", "Pt", "Au", "Hg",
    "Tl", "Pb", "Bi", "Po", "As", "Rn", "Fr", "Ra", "Ac", "Th",
    "Pa", "U",  "Np", "Pu", "Am", "Cm", "Bk", "Cf", "Es", "Fm",
    "Md", "No", "Lr", "Rf", "Db", "Sg", "Bh", "Hs", "Mt", "Ds",
    "Rg", "Cn", "Nh", "Fl", "Mc", "Lv", "Ts", "Og"
]

# TODO: can we modify this to make it unnecessary?
const ELEMENT_LOOKUP = Dict{String, Int}([(ELEMENTS[n] => n) for n in 1:length(ELEMENTS)])

# Metallic radii of the elements in angstroms
# Probably will be useful for sphere packing related things
const RADII_METALLIC_ANGSTROMS = Dict{String, Float64}(
    "Li" => 1.52,
    "Be" => 1.12,
    "Na" => 1.86,
    "Mg" => 1.60,
    "Al" => 1.43,
    "K"  => 2.27,
    "Ca" => 1.97,
    "Sc" => 1.62,
    "Ti" => 1.47,
    "V"  => 1.34,
    "Cr" => 1.28,
    "Mn" => 1.27,
    "Fe" => 1.26,
    "Co" => 1.25,
    "Ni" => 1.24,
    "Cu" => 1.28,
    "Zn" => 1.34,
    "Ga" => 1.35,
    "Rb" => 2.48,
    "Sr" => 2.15,
    "Y"  => 1.80,
    "Zr" => 1.60,
    "Nb" => 1.46,
    "Mo" => 1.39,
    "Tc" => 1.36,
)

include("vectors.jl")
include("datagrids.jl")
include("crystals.jl")
include("reciprocal.jl")
include("filetypes.jl")

# Types
export  AbstractCrystal, CrystalStructure, AbstractCrystalData, CrystalStructureWithData,
        AbstractKPoints, KPointGrid, KPointList
# Functions
export  formula, readXYZ, writeXYZ, readXSF3D, writeXSF3D

end # module


export sample!
using StatsBase: sample, Weights

"""
    sample!(model::ABM, n [, weight]; kwargs...)

Replace the agents of the `model` with a random sample of the current agents with
size `n`.

Optionally, provide a `weight`: Symbol (agent field) or function (input agent
out put number) to weight the sampling.
This means that the higher the `weight` of the agent, the higher the probability that
this agent will be chosen in the new sampling.

# Keywords
* `replace = true` : whether sampling is performed with replacement, i.e. all agents can
be chosen more than once.
* `rng = GLOBAL_RNG` : a random number generator to perform the sampling with.

Example usage in [Wright-Fisher model of evolution](@ref).
"""
function sample!(
    model::ABM,
    n::Int,
    weight = nothing;
    replace = true,
    rng::AbstractRNG = Random.GLOBAL_RNG,
)
    nagents(model) > 0 || return
    org_ids = collect(keys(model.agents))
    if weight != nothing
        weights = Weights([get_data(a, weight, identity) for a in values(model.agents)])
        newids = sample(rng, org_ids, weights, n, replace = replace)
    else
        newids = sample(rng, org_ids, n, replace = replace)
    end
    add_newids!(model, org_ids, newids)
end

"Used in sample!"
function add_newids!(model, org_ids, newids)
    n = nextid(model)
    for id in org_ids
        if !in(id, newids)
            kill_agent!(model.agents[id], model)
        else
            noccurances = count(x -> x == id, newids)
            for t in 2:noccurances
                newagent = deepcopy(model.agents[id])
                newagent.id = n
                add_agent_pos!(newagent, model)
                n += 1
            end
        end
    end
end


module Bloom
	import Base.contains, Base.show
	export BloomFilter, add!
	include("bloom-filter.jl")
end


module AdjacentFloat

!isdefined(Float) && typealias Float AbstractFloat;

export prevFloat, nextFloat, nFloatsSeparate, nextNearerToZero, nextAwayFromZero

include("adjacentFloats.jl")

end # module


#
# Copyright (c) 2021 Tobias Thummerer, Lars Mikelsons, Josef Kircher
# Licensed under the MIT license. See LICENSE file in the project root for details.
#

t_start = 0.0
t_stop = 8.0

pathToFMU = joinpath(dirname(@__FILE__), "..", "model", ENV["EXPORTINGTOOL"], "SpringFrictionPendulum1D.fmu")

myFMU = fmiLoad(pathToFMU)

comp = fmiInstantiate!(myFMU; loggingOn=false)
@test comp != 0

# choose FMU or FMUComponent
fmuStruct = nothing
envFMUSTRUCT = ENV["FMUSTRUCT"]
if envFMUSTRUCT == "FMU"
    fmuStruct = myFMU
elseif envFMUSTRUCT == "FMUCOMPONENT"
    fmuStruct = comp
end
@assert fmuStruct != nothing "Unknwon fmuStruct, environment variable `FMUSTRUCT` = `$envFMUSTRUCT`"

solution = fmiSimulateME(fmuStruct, t_start, t_stop)
@test length(solution.u) > 0
@test length(solution.t) > 0

@test solution.t[1] == t_start
@test solution.t[end] == t_stop

# reference values from Simulation in Dymola2020x (Dassl)
@test solution.u[1] == [0.5, 0.0]
@test sum(abs.(solution.u[end] - [1.06736, -1.03552e-10])) < 0.01

fmiUnload(myFMU)