using PyPlot

type indtOutput
    method
    dstat
    pval_d
    wstat
    pval_w
    flag
end

type indirectTestOutput
    nboot
    n
    regfit
    sobel
    bootest
    bootci
    bootse
    p
end

indirectTestOutput()=indirectTestOutput(nothing,
                                        nothing,
                                        nothing,
                                        nothing,
                                        nothing,
                                        nothing,
                                        nothing,
                                        nothing)

function show(io::IO, object::indtOutput)
    if object.method!=nothing
        println(io, "$(object.method)")
    end
    if object.flag!=2
            @printf("Kolmogorov-Smirnov test statistic:  % .6f\n", object.dstat)
        if object.pval_d >=1
            @printf("Kolmogorov-Smirnov p value:          1.0\n")
        elseif object.pval_d < 10e-16
            @printf("Kolmogorov-Smirnov p value:         < 10e-16\n")
        else
            @printf("Kolmogorov-Smirnov p value:         % .6f\n", object.pval_d)
        end
    end
    if object.flag!=1
            @printf("Cramer-von Mises test statistic:    % .6f\n", object.wstat)
        if object.pval_w >=1
            @printf("Cramer-von Mises p value:            1.0\n")
        elseif object.pval_w < 10e-16
            @printf("Cramer-von Mises p value:           < 10e-16\n")
        else
            @printf("Cramer-von Mises p value:           % .6f\n", object.pval_w)
        end
    end
end

function show(io::IO, object::indirectTestOutput)
    @printf("\nTESTS OF INDIRECT EFFECT\n\n")
    @printf("Sample size:  %d\n", object.n)
    @printf("Number of bootstrap samples: %d\n\n", object.nboot)
    @printf("DIRECT AND TOTAL EFFECTS\n")
    @printf("          % 8s  %9s    %8s   %8s\n", "Estimate", "Std.Error", "t value", "Pr(>|t|)")
    @printf("b(YX):   % 8.6f   %8.6f   % 8.6f   %8.6f\n",
            object.regfit[1,1], object.regfit[1,2], object.regfit[1,3], object.regfit[1,4])
    @printf("b(MX):   % 8.6f   %8.6f   % 8.6f   %8.6f\n",
            object.regfit[2,1], object.regfit[2,2], object.regfit[2,3], object.regfit[2,4])
    @printf("b(YM.X): % 8.6f   %8.6f   % 8.6f   %8.6f\n",
            object.regfit[3,1], object.regfit[3,2], object.regfit[3,3], object.regfit[3,4])
    @printf("b(YX.M): % 8.6f   %8.6f   % 8.6f   %8.6f\n\n",
            object.regfit[4,1], object.regfit[4,2], object.regfit[4,3], object.regfit[4,4])

    @printf("INDIRECT EFFECT AND SIGNIFICANCE USING NORMAL DISTRIBUTION\n")
    @printf("          % 8s  %9s    %8s   %8s   %8s  %8s \n",
            "Estimate", "Std.Error", "z score", "CI lo", "CI hi", "Pr(>|z|)")
    @printf("Sobel:   % 8.6f   %8.6f   % 8.6f  % 8.6f  % 8.6f  %8.6f\n\n",
            object.sobel[1,1], object.sobel[1,2], object.sobel[1,3],
            object.sobel[1,4], object.sobel[1,5], object.sobel[1,6])

    @printf("BOOTSTRAP RESULTS OF INDIRECT EFFECT\n")
    @printf("          % 8s  %9s    %8s   %8s   %8s \n",
            "Estimate", "Std.Error", "CI lo", "CI hi", "P value")
    @printf("Effect:  % 8.6f   %8.6f   % 8.6f  % 8.6f   %8.6f\n",
            object.bootest, object.bootse, object.bootci[1], object.bootci[2], object.p)
end

# We have no idea what this does.
function stein1{S <: Real}(x::AbstractArray{S}, delta::Real; alpha::Real=0.05,
    pow::Real=0.8, oneside::Bool=false, n=nothing, variance=nothing)
    delta = abs(delta)
    if n==nothing; n=length(x); end
    if variance==nothing; variance = var(x); end
    if !oneside
        alpha = alpha/2
    end
    df       = n-1
    d        = (delta/(Rmath.qt(pow, df)-Rmath.qt(alpha, df)))*(delta/(Rmath.qt(pow, df)-Rmath.qt(alpha, df)))
    N        = max(n, floor(Int64, variance/d)+1)
    return N
end

# We have no idea what this does.
function stein2{S <: Real, T <: Real}(x1::AbstractArray{S}, x2::AbstractArray{T};
    mu0::Real=0.0, alpha::Real=0.05, method::Bool=true)
    n       = length(x1)
    df      = n-1
    N       = n+length(x2)
    xbar    = mean([x1, x2])
    test    = sqrt(N)*(xbar-mu0)/std(x1)
    crit    = Rmath.qt(1-alpha/2, df)
    lo, hi  = xbar-crit*std(x1), xbar+crit*std(x1)
    sig     = 2*(1-Rmath.pt(test, df))
    METHOD  = method?"The 2nd stage of Stein's method":nothing
    output  = testOutput()
    output.method    = METHOD
    output.df        = df
    output.estimate  = xbar
    output.ci        = [lo, hi]
    output.statistic = test
    output.crit      = crit
    output.p         = sig
    return output
end

#Extension of Stein's method based on the trimmed mean.
function stein1_tr{S <: Real}(x::AbstractArray{S}, del::Real; alpha::Real=0.05, pow::Real=0.8, tr::Real=0.2)
    if tr <0 || tr >= .5
        error("Argument tr must be between 0 and .5")
    end
    n =length(x)
    g::Int    = floor(Int64, tr*n)
    df::Int   = n-2*g-1
    t1        = Rmath.qt(pow, df)
    t2        = Rmath.qt(alpha./2, df)
    dv        = (del/(t1-t2))*(del/(t1-t2))
    nvec::Int = floor(Int64, trimse(x, tr=tr)./dv)+1
    n > nvec ? n : nvec
end

function stein1_tr{S <: Real}(x::Array{S, 2}, del::Real; alpha::Real=0.05, pow::Real=0.8, tr::Real=0.2)
    if tr<0||tr>=.5
        error("Argument tr must be between 0 and .5")
    end
    if size(x, 2)==1 || size(x, 1)==1
        temp=zeros(length(x))
        temp[:]=x
        return stein1_tr(temp, del, alpha=alpha, pow=pow, tr=tr)
    else
        J     = size(x,2)
        ic    = 0
        ntest::Integer = (J*J-J)/2
        n     = size(x, 1)
        g::Integer = floor(Int64, tr*n)
        df    = n-2g-1
        tdiff = Rmath.qt(pow, df)-Rmath.qt(alpha/2.0/ntest, df)
        dv    = (del/tdiff)*(del/tdiff)
        N     = zeros(Int, ntest)
        if ntest > 1
            for i = 1:J
                for j = 1:J
                    if i < j
                        N[ic+=1] = floor(Int64, trimse(x[:,i]-x[:,j], tr=tr)/dv)+1
                    end
                end
            end
            return max(vcat(N, n))
        elseif ntest == 1
            return floor(Int64, trimse(x[:,1], tr=tr)/dv)+1
        end
    end
end

#Extension of the second stage of Stein's method when performing all pairwise comparisons
#among J dependent groups.
function stein2_tr{S <: Real, T <: Real}(x::AbstractArray{S}, y::AbstractArray{T}; alpha::Real=0.05, tr::Real=0.2, method::Bool=true)
    if tr < 0 || tr >= .5
        error("Argument tr must be between 0 and .5")
    end
    m       = vcat(x, y)
    METHOD  = method? "Extension of the 2nd stage of Stein's method based on the trimmed mean\n":nothing
    output  = testOutput()
    output.method    = METHOD
    output.statistic = sqrt(length(m))*(1-2tr)*tmean(m, tr=tr)/winstd(m)
    output.crit         = Rmath.qt(1-alpha/2, floor(length(x)-2floor(tr*length(x))-1))
    return output
end

function stein2_tr(x::Array, y::Array; alpha::Real=0.05, tr::Real=.2, method::Bool=true)
    if tr < 0 || tr >= .5
        error("Argument tr must be between 0 and .5")
    end
    if size(x, 2) != size(y, 2)
        error("Number of variables in x not equal to number of variables in y")
    end
    if size(x, 2) == 1 || size(x, 1) ==1
        return stein2_tr(x[:], del, alpha=alpha, pow=pow, tr=tr, method=method)
    else
        g::Int  = floor(tr*size(x,1))
        df::Int = size(x,1)-2.*g-1
        ic::Int = 0
        J::Int  = size(x,2)
        ntest::Int = (J.*J-J)./2
        m       = vcat(x, y)
        nm      = size(m, 1)
        test=DataFrame([Integer, Integer, Float64], ["grp1", "grp2", "test_stat"], ntest)
        if ntest > 1
            for i=1:J
                for j=1:J
                    if i<j
                        temp  = m[:,i]-m[:,j]
                        test[ic+=1, 1], test[ic, 2] = i, j
                        test[ic, 3] = sqrt(nm)*(1-2tr)*tmean(temp, tr=tr)/winstd(temp)
                    end
                end
            end
        else ntest == 1
            test[1,1], test[1, 2] = 1, 2
            test[1, 3] = test[ic, 3] = sqrt(nm)*(1-2tr)*tmean(m[:,1], tr=tr)/winstd(m[:,1])
        end
        if method
            METHOD="Extension of the 2nd stage of Stein's method based on the trimmed mean\n"
        else
            METHOD=nothing
        end
        output = testOutput()
        output.method    = METHOD
        output.statistic = test
        output.crit      = Rmath.qt(1-alpha/2./ntest, df)
        return output
    end
end

#Compute adaptive kernel density estimate for univariate data
function akerd{S <: Real}(x::AbstractArray{S}; hval::Real=NaN, aval::Real=0.5,
               fr::Real=0.8, pts=NaN,
               plotit=true, xlab="", ylab="", title="", color="black")
    if isnan(pts)
       pts = x[:]
    end
    pts  = sort!(pts)

    m = _estimate_dispersion(x)
    fhat  = rdplot(x, pts=pts, plotit=false, fr=fr)
    const n = length(x)
    if isnan(hval)
        A = min(std(x), iqrn(x))
        if A==0.0; A = winstd(x)/0.64; end
        hval = 1.06*A/n^0.2
    end
    gm = 0.0
    gm_int = 0
    const nfhat = length(fhat)
    for i = 1:nfhat
        if fhat[i] > 0.0
            gm += log(fhat[i])
            gm_int += 1
        end
    end
    gm = exp(gm/gm_int)
    alam = (fhat/gm).^(-aval)
    dhat = akerd_loop(x, pts, hval, alam)
    if plotit
        plot(pts, dhat, color=color)
        plt[:title](title)
        plt[:xlabel](xlab)
        plt[:ylabel](ylab)
    end
    dhat
end

function akerd_loop(x, pts, hval, alam)
    npts  = length(pts)
    dhat  = zeros(npts)
    sqrt5 = sqrt(5)
    n     = length(x)
    temp  = zeros(n)
    for i = 1:npts
        epan_alam_hval = 0.0
        for j = 1:n
            temp[j] = (pts[i]-x[j])/(hval*alam[j])
            if abs(temp[j]) < sqrt5
                epan_alam_hval += (0.75*(1-0.2*temp[j]*temp[j])/sqrt5)/alam[j]
            end
        end
        dhat[i]=epan_alam_hval/npts
    end
    return dhat./hval
end

#Expected frequency curve. fr controls amount of smoothing, theta is the azimuthal direction and
#phi the colatitude
function rdplot{S <: Real}(x::AbstractArray{S}; fr::Real=NaN, pts=NaN,
                           plotit=true, title="", xlab="", ylab="", color="black")
    if fr == NaN; fr = 0.8; end
    if pts == NaN; pts = x[:];end
    rmd = [sum(near(x, pts[i], fr))*1.0 for i=1:length(pts)]
    rmd /= length(x)
    MAD = mad(x)
    if MAD != 0.0
        rmd /= 2fr*MAD
    end
    if plotit
        index = sortperm(pts);
        clf()
        plot(pts[index], rmd[index], color=color)
        plt[:title](title)
        plt[:xlabel](xlab)
        plt[:ylabel](ylab)
    end
    rmd
end

"""`near(x, pt, fr=1.0)`

Determine which values in `x` are near `pt`. Return a BitArray giving whether
each value of `x` is within `fr*m` of `pt`, where `m` is the dispersion measure
returned by `_estimate_dispersion(x)`"""
function near{S <: Real}(x::AbstractArray{S}, pt::Real, fr::Real=1.0)
    m = _estimate_dispersion(x)
    return abs(x-pt) .<= fr*m
end

function regts1(vstar, yhat, res, mflag, x, tr)
    const n=length(res)
    ystar=zeros(n)
    [ystar[i]=yhat+res[i].*vstar[i] for i=1:n]
    rval=zeros(n)
    ystar_bar=tmean(ystar, tr=tr)
    rval=zeros(n)
    [rval[i]= sum(ystar[mflag[:,i]]-ystar_bar) for i=1:n]
    return rval
end

# Test the hypothesis of independence between x and y by
# testing the hypothesis that the regression surface is a horizontal plane.
# Stute et al. (1998, JASA, 93, 141-149).
#
#  flag=1 gives Kolmogorov-Smirnov test statistic
#  flag=2 gives the Cramer-von Mises test statistic
#  flag=3 causes both test statistics to be reported.
#
#  tr=0 results in the Cramer-von Mises test statistic when flag=2
#      With tr>0, a trimmed version of the test statistic is used.
#
function indt(x::AbstractArray, y::AbstractArray; flag::Int=1, nboot::Int=599,
              tr::Float64=0.0, seed=2, method=true)
    if ndims(x)==1
        x=reshape(x,length(x),1)
    end
    if length(findin(flag, 1:3))==0
        error("flag must be set to 1, 2, or 3")
    end
    n=size(x,1)
    np=size(x,2)
    y=reshape(y, length(y), 1)
    if length(y)!=n
        error("Incondistent dimensions of x and y: number of x must match number of y")
    end
    mflag=indt_mflag(x)
    yhat=mean(y)
    res=zeros(n)
    [res[i]=y[i]-yhat for i=1:n]
    if isa(seed, Bool)
        if seed
            srand(2)
        end
    else
        srand(seed)
    end
    data=(rand(nboot, n)-0.5).*sqrt(12)
    rvalb=zeros(n, nboot)
    const sqrtn=sqrt(n)
    [rvalb[:,i]=regts1(data[i,:], yhat, res, mflag, x, 0) for i=1:nboot]
    [[rvalb[i,j]=abs(rvalb[i,j])/sqrtn for i=1:n] for j=1:nboot]

    dstatb=zeros(nboot)
    [dstatb[i]=max(rvalb[:,i]) for i=1:nboot]

    [[rvalb[i,j]=rvalb[i,j].*rvalb[i,j] for i=1:n] for j=1:nboot]
    wstatb=mean(rvalb, 1)
    rval=regts1(fill(1.0, n), yhat, res, mflag, x, tr)./sqrtn

    dstat=pval_d=wstat=pval_w=nothing
    if flag==1 || flag==3
        [rval[i]=abs(rval[i]) for i=1:n]
        dstat=max(rval)
        pval_d=0.0
        pval_d=sum(dstat.>=dstatb)./nboot
        pval_d=1.0-pval_d
    end
    if flag==2 || flag==3
        [rval[i]=rval[i].*rval[i] for i=1:n]
        wstat=tmean(rval, tr=tr)
        pval_w=0.0
        pval_w=sum(wstat.>=wstatb)./nboot
        pval_w=1.0-pval_w
    end
    if method
        METHOD::String="Test whether x and y are independent by testing the hypothesis\nthat the regression surface is a horizontal plane.\n"
    else
        METHOD=nothing
    end
    indtOutput(
        METHOD,
        dstat,
        pval_d,
        wstat,
        pval_w,
        flag
        )
end

function indirectTest{S <: Real, T <: Real, W <: Real}(dv::AbstractArray{S}, iv::AbstractArray{T}, m::Vector{W};
            nboot::Integer=5000, alpha::Real=0.05, scale::Bool=false, seed=2, plotit::Bool=false)
    if isa(seed, Bool)
        if seed
            srand(2)
        end
    else
        srand(seed)
    end
    n = length(iv)
    randid  = rand(1:n, n*nboot)
    bvec    = sort!(bootindirect(iv, dv, m, nboot))
    bbar    = mean(bvec)
    bootci  = [bvec[round(alpha*nboot/2)], bvec[nboot - round(alpha*nboot/2) + 1]]
    bootest = mean(bvec)
    bootse  = std(bvec)
    p       = mean(bvec .<0) + 0.5*mean(bvec .==0)
    p       = 2*min(p, 1-p)
    data    = DataFrame(iv, m, dv)
    regfit1 = coeftable(lm( :(x3 ~ x1     ), data))
    regfit2 = coeftable(lm( :(x2 ~ x1     ), data))
    regfit3 = coeftable(lm( :(x3 ~ x1 + x2), data))
    regfit  = rbind(regfit1[2,:], regfit2[2,:], regfit3[2:3,:])

    estimate  = regfit2[2,1]*regfit3[3,1]
    sobel_se  = sqrt(regfit[4, 1]*regfit[4, 1]*regfit[2, 2]*regfit[2, 2]+
                     regfit[2, 1]*regfit[2, 1]*regfit[4, 2]*regfit[4, 2]+
                     regfit[2, 2]*regfit[2, 2]*regfit[4, 2]*regfit[4, 2])
    sobel     = DataFrame(estimate,
                          sobel_se,
                          estimate/sobel_se,
                          estimate - Rmath.qnorm(.975)*sobel_se,
                          estimate + Rmath.qnorm(.975)*sobel_se,
                          2*(1-Rmath.pnorm(abs(estimate/sobel_se))))
    #return nboot, n, regfit, sobel, bootest, bootci, p
    if plotit
        dens = kde(bvec)
        plot(dens.x, dens.density)
    end
    output = indirectTestOutput()
    output.nboot   = nboot
    output.n       = n
    output.sobel   = sobel
    output.regfit  = regfit
    output.bootest = bootest
    output.bootci  = bootci
    output.p       = p
    output.bootse  = bootse
    output
end

function outer{S <: Real, T <: Real}(x::AbstractArray{S}, y::AbstractArray{T}, f::Function)
    nx      = length(x)
    ny      = length(y)
    output  = zeros(nx, ny)
    for i = 1:ny
        for j = 1:nx
            output[j, i] = f(x[j], y[i])
        end
    end
    return output
end

function hd{S <: Real}(x::AbstractArray{S}; q::Real=0.5)
    #Compute the Theil-Sen regression estimator.
    # Only a single predictor is allowed in this version
    const n = length(x)
    m1   = ( n + 1 )*q
    m2   = ( n + 1 )*(1 - q)
    vec1 = [1:n]./n
    vec2 = ([1:n] - 1)./n
    w    = Rmath.pbeta( vec1, m1, m2 ) - Rmath.pbeta( vec2,  m1, m2 )
    return sum( w.*sort(x) )
end

function tsp1reg{S <: Real, T <: Real}(x::AbstractArray{S}, y::AbstractArray{T}, HD::Bool)
    order = sortperm( x )
    xsort = x[ order ]
    ysort = y[ order ]
    vec1  = outer( ysort, ysort, - )
    vec2  = outer( xsort, xsort, - )
    v1    = vec1[ vec2 .> 0 ]
    v2    = vec2[ vec2 .> 0 ]
    b1    = median!( v1./v2 )
    b0    = 0.0
    if !HD
        b0 = median( y ) - b1 * median( x )
    else
        b0 = hd( y ) - b1*hd( x )
    end
    return [b0, b1]
end

function tsreg_coef(mf::ModelFrame, HD::Bool, iter::Integer)
    y     = vector( model_response( mf ) )
    x     = ModelMatrix(mf).m[:,2:end]
    np, n = size(x, 2), size(x, 1)

    #ONE PREDICTOR
    if np == 1
        coef = tsp1reg( x[:], y, false )
    #    coef[1], coef[2] =  output.intercept, output.slope
    #    res = output.res
    else
    #MULTIPLE PREDICTORS
        coef_temp = zeros( np )
        for p = 1:np
            coef_temp[p] = tsp1reg( x[:,p], y, false )[2]
        end
        res = y - x*coef_temp
        if !HD
            b0 = median!( res )
        else
            b0 = hd( res )
        end
        #r = zeros( n )
        #coef_old = coef_temp[:]
        for i = 1:iter
            for p = 1:np
                r = y - x*coef_temp - b0 + coef_temp[p].*x[:,p]
                coef_temp[p] = tsp1reg(x[:,p], r, false)[2]
            end
            if !HD
                b0 = median!( y - x*coef_temp )
            else
                b0 = hd( y - x*coef_temp )
            end
            coef_old = coef_temp[:]
        end
        coef = [b0, coef_temp]
    end
    return coef
end

function tsreg(formula::Expr, dataframe::AbstractDataFrame; varfun::Function=pbvar, corfun::Function=pbcor, HD::Bool=false, iter::Integer=10)
#  Compute Theil-Sen regression estimator
#  Gauss-Seidel algorithm is used when there is more than one predictor
    mf = ModelFrame( formula, dataframe )

    #WILL ADD THE ABILITY TO DO MULTIPLE REGRESSION
    output = regOut()
    coef   = zeros(2)
    res    = zeros(n)
    if np == 1
        output = tsp1reg( vector( mf[2] ), mr )
        coef[1], coef[2] =  output.intercept, output.slope
    else
        stop("Only 1 predictor is allowed.")
    end

    res  = temp1.res
    yhat = y - res

    epow   = pbvar(yhat)/pbvar(y)
    if epow >= 1
        epow = sqrt( pbcor(yhat, y).estimate )
    end
    stre   = sqrt(epow)
    output = DataFrame()
    output["b0"] = temp1.intercept
    output["b1"] = temp1.slope
    output["strength of assoc."] = stre
    output["explanatory power"]  = epow

    if np == 1
        lm_coef = coef(lm( formula, dataframe ))
        p     = FramedPlot()
        pts   = Points( vector(mf[2]), mr , "type", "dot")
        s1    = Slope( lm_coef[2], (0, lm_coef[1]), "type", "solid", "color", "blue")
        s2    = Slope( temp1.slope, (0, temp1.intercept), "type", "solid", "color", "red")
        add(p, pts, s1, s2)
        Winston.display(p)
    end
    output
end

function bootindirect{S <: Real, T <: Real, W <: Real}(x::Vector{S}, y::Vector{T}, m::Vector{W}, nboot::Integer)
    n = length(x)
    tempx  = hcat(rep(1.0, n), zeros(n))
    tempy  = zeros(n)
    tempm  = zeros(n)
    tempmx = hcat(rep(1.0, n), zeros(Real, n), zeros(Real, n))
    bvec   = zeros(nboot)
    randid = rand(1:n, n*nboot)
    for i = 1:nboot
        for j = 1:n
            tempx[j,2] = tempmx[j,2] = x[randid[(i-1)*n + j]]
            tempy[j]   = y[randid[(i-1)*n + j]]
            tempm[j]   = tempmx[j,3] = m[randid[(i-1)*n + j]]
        end
        bvec[i] = (inv(tempx'tempx)'*(tempx'tempm))[2]*(inv(tempmx'tempmx)'*(tempmx'tempy))[3]
    end
    bvec
end

#  A heteroscedastic one-way ANOVA for trimmed means using a generalization of Welch's method.

function t1way{S <: Real}(x::Array{S, 2}; tr::Real=0.2, method::Bool=true)
    n = size(x, 1)
    g = [1:size(x, 2)]
    grp = rep(g, rep(n, size(x, 2)))
    x = x[:]
    t1waycore(x, grp, tr, method)
end

function t1way{S <: Real}(x::AbstractArray{S}, grp::Vector; tr::Real=0.2, method::Bool=true)
    g = unique(grp)
    grpcopy = [find(g.==grp[i])[1] for i=1:length(grp)]
    t1waycore(x, grpcopy, tr, method)
end

function t1waycore(args...)
    x, grp, tr, method = args[1], args[2], args[3], args[4]
    g = unique(grp)
    J = length(g)
    h, w, xbar, n = zeros(J), zeros(J), zeros(J), zeros(J)

    for j = 1:J
        n[j] = sum(grp.==g[j])
        temp = x[grp.==g[j]]
        h[j] = n[j] - 2*floor(tr*n[j])
        w[j] = h[j]*(h[j] - 1)/((n[j] -1)*winvar(temp, tr=tr))
        xbar[j] = tmean(temp, tr=tr)
    end
    u = sum(w)
    xtil = sum(w .* xbar)/u
    A = sum(w .* (xbar - xtil).*(xbar - xtil))/(J - 1)
    B = 2*(J - 2)*sum((1 - w./u).*(1 - w./u)./(h - 1))/(J*J - 1)
    statistic = A/(B + 1)
    nu1 = J - 1
    nu2 = 1/(3 * B/2/(J-2))
    p   = 1 - Rmath.pf(statistic, nu1, nu2)
    if method
        METHOD="Heteroscedastic one-way ANOVA for trimmed means\nusing a generalization of Welch's method.\n"
    else
        METHOD=nothing
    end
    output    = testOutput()
    output.n  = n
    output.df = [nu1, nu2]
    output.statistic = statistic
    output.p  = p
    output.method = METHOD
    output
end

#  Compute a (1-α) confidence interval for the trimmed mean
#  using a bootstrap percentile t method.
#
#  The default amount of trimming is tr=.2
#  side=T, for true,  indicates the symmetric two-sided method
#
#
#  Side=F yields an equal-tailed confidence interval
#
#
#  NOTE: p.value is reported when side=T only.
#

function trimcibt{S <: Real}(x::AbstractArray{S}; tr::Real=0.2, alpha::Real=0.05, nboot::Integer=2000, side::Bool=true,
                             nullvalue::Real=0, seed=2, method::Bool=true)
    if isa(seed, Bool)
        if seed
            srand(2)
        end
    else
        srand(seed)
    end
    n=length(x)
    test=(tmean(x, tr=tr)-nullval)./trimse(x, tr=tr)
    randid=rand(1:n, n*nboot)
    tempout=trimcibt_loop(x, n, nboot, tr, side, randid, test)
    if side
        tval=tempout[1]
        pval=tempout[2]
    end
    icrit=floor((1-alpha)*nboot+0.5)
    ibot=round(alpha*nboot/2)+1
    itop=nboot-ibot-1
    ci=zeros(2)
    if method && side
        METHOD="Bootstrap (1-α) confidence interval for the trimmed mean\nusing a bootstrap percentile t method\n"
    elseif method && !side
        METHOD="Bootstrap (1-α) confidence interval for the trimmed mean\nusing a bootstrap percentile t method\n[NOTE: p value is computed only when side=true]\n"
    else
        METHOD=nothing
    end
    if !side
        ci[1]=tmean(x, tr=tr)-tempout[itop]*trimse(x, tr=tr)
        ci[2]=tmean(x, tr=tr)-tempout[ibot]*trimse(x, tr=tr)
        output = testOutput()
        output.method = METHOD
        output.estimate = tmean(x, tr=tr)
        output.ci = ci
        output.statistic = test
        return output
    else
        ci[1]=tmean(x, tr=tr)-tval[icrit]*trimse(x, tr=tr)
        ci[2]=tmean(x, tr=tr)+tval[icrit]*trimse(x, tr=tr)
        output = testOutput()
        output.method = METHOD
        output.estimate = tmean(x, tr=tr)
        output.ci = ci
        output.statistic = test
        output.p = pval
        return output
    end
end

function trimcibt_loop(x, n, nboot, tr, side, randid, test)
    xbar=tmean(x, tr=tr)
    temp=zeros(n)
    tval=zeros(nboot)
    if side
        test=abs(test)
        pval=0.0
        for i=1:(nboot*n)
            if (i%n)!=0
                temp[i%n]=x[randid[i]]-xbar
            else
                temp[n]=x[randid[i]]-xbar
                tval[div(i, n)]=abs(tmean(temp, tr=tr)./trimse(temp, tr=tr))
                pval += tval[div(i, n)]>=test? 1/nboot :0.0
            end
        end
        return sort!(tval), pval
    else
        for i=1:(nboot*n)
            if (i%n)!=0
                temp[i%n]=x[randid[i]]-xbar
            else
                temp[n]=x[randid[i]]-xbar
                tval[div(i, n)]=tmean(temp, tr=tr)./trimse(temp, tr=tr)
            end
        end
        return sort!(tval)
    end
end


Pkg.add("EchoJulia")
using EchoJulia
raw = SimradRaw.load(EK60_SAMPLE)
cal = EchoviewEcs.load(ECS_SAMPLE)
data = transform(raw, calibration=cal)
eg(data["Sv120"], range = maximum(data["r120"]), cmap=EK500, vmin=-95, vmax=-50)


test = """
    mxmxvkd kfcds sqjhc nhms (contains dairy, fish)
    trh fvjkl sbzzf mxmxvkd (contains dairy)
    sqjhc fvjkl (contains soy)
    sqjhc mxmxvkd sbzzf (contains fish)
    """

function parse_input(io)
    foods = []
    while !eof(io)
        line = readline(io)
        (ingredients, allergens) = split(line, " (contains ")
        ingredients = Symbol.(split(ingredients, r"\s+"; keepempty = false))
        allergens = isempty(allergens) ? String[] :
            Symbol.(split(rstrip(==(')'), allergens), ", "))
        push!(foods, (ingredients, allergens))
    end
    return foods
end

function q1(foods)::Int
    assmt = assignment(foods)
    allergic = values(assmt)
    ingredients = vcat(first.(foods)...)
    return deleteat!(ingredients, findall(∈(allergic), ingredients)) |> length
end

function q2(foods)::String
    assmt = sort(collect(assignment(foods)))
    return join(last.(assmt), ',')
end

function assignment(foods::AbstractVector)::Dict
    assmt = Dict{Symbol, Vector{Symbol}}()
    for (ingredients, allergens) in foods
        for allergen in allergens
            if !haskey(assmt, allergen)
                assmt[allergen] = copy(ingredients)
            else
                intersect!(assmt[allergen], ingredients)
            end
        end
    end

    n_unambig = 0
    unambig = findall(==(1) ∘ length, assmt)
    while n_unambig != length(unambig)
        covered = [only(v) for (k, v) in assmt if k ∈ unambig]
        for k in setdiff(keys(assmt), unambig)
            setdiff!(assmt[k], covered)
        end
        n_unambig = length(unambig)
        unambig = findall(==(1) ∘ length, assmt)
    end

    return Dict(k => only(v) for (k, v) in assmt)
end

let foods = parse_input(IOBuffer(test))
    @assert q1(foods) == 5
    @assert q2(foods) == "mxmxvkd,sqjhc,fvjkl"
end

open("day21.in", "r") do io
    foods = parse_input(io)
    println("Q1: ", q1(foods))
    println("Q2: ", q2(foods))
end


using SmartMeterAnalytics
using Base.Test

@test tou(DateTime(2012, 10, 10, 12)) == :OnPeak # Cooling weekday on-peak
@test tou(DateTime(2012, 10, 10, 8)) == :MidPeak # Cooling weekday mid-peak
@test tou(DateTime(2012, 10, 10, 2)) == :OffPeak # Cooling weekday off-peak

@test tou(DateTime(2012, 1, 10, 9)) == :OnPeak # Heating weekday on-peak
@test tou(DateTime(2012, 1, 10, 12)) == :MidPeak# Heating weekday mid-peak
@test tou(DateTime(2012, 1, 10, 22)) == :OffPeak # Heating weekday off-peak

@test tou(DateTime(2012, 10, 13, 12)) == :OffPeak # Cooling weekend on-peak
@test tou(DateTime(2012, 10, 13, 8)) == :OffPeak # Cooling weekend mid-peak
@test tou(DateTime(2012, 10, 13, 2)) == :OffPeak # Cooling weekend off-peak

@test tou(DateTime(2012, 1, 14, 9)) == :OffPeak # Heating weekend on-peak
@test tou(DateTime(2012, 1, 14, 12)) == :OffPeak# Heating weekend mid-peak
@test tou(DateTime(2012, 1, 14, 22)) == :OffPeak # Heating weekend off-peak

@test tou(DateTime(2012, 7, 1, 12)) == :OffPeak # Cooling holiday on-peak
@test tou(DateTime(2012, 7, 1, 8)) == :OffPeak # Cooling holiday mid-peak
@test tou(DateTime(2012, 7, 1, 2)) == :OffPeak # Cooling holiday off-peak

@test tou(DateTime(2012, 2, 20, 9)) == :OffPeak # Heating holiday on-peak
@test tou(DateTime(2012, 2, 20, 12)) == :OffPeak# Heating holiday mid-peak
@test tou(DateTime(2012, 2, 20, 22)) == :OffPeak # Heating holiday off-peak


module ImmersedBoundaries

using Adapt

using Oceananigans.Grids
using Oceananigans.Operators
using Oceananigans.Fields
using Oceananigans.Utils
using Oceananigans.TurbulenceClosures: AbstractTurbulenceClosure, time_discretization

using Oceananigans.TurbulenceClosures:
    viscous_flux_ux,
    viscous_flux_uy,
    viscous_flux_uz,
    viscous_flux_vx,
    viscous_flux_vy,
    viscous_flux_vz,
    viscous_flux_wx,
    viscous_flux_wy,
    viscous_flux_wz,
    diffusive_flux_x,
    diffusive_flux_y,
    diffusive_flux_z

using Oceananigans.Advection:
    advective_momentum_flux_Uu,
    advective_momentum_flux_Uv,
    advective_momentum_flux_Uw,
    advective_momentum_flux_Vu,
    advective_momentum_flux_Vv,
    advective_momentum_flux_Vw,
    advective_momentum_flux_Wu,
    advective_momentum_flux_Wv,
    advective_momentum_flux_Ww,
    advective_tracer_flux_x,
    advective_tracer_flux_y,
    advective_tracer_flux_z

import Oceananigans.Utils: cell_advection_timescale
import Oceananigans.Grids: with_halo
import Oceananigans.Coriolis: φᶠᶠᵃ
import Oceananigans.Grids: with_halo, xnode, ynode, znode, all_x_nodes, all_y_nodes, all_z_nodes

import Oceananigans.Advection:
    _advective_momentum_flux_Uu,
    _advective_momentum_flux_Uv,
    _advective_momentum_flux_Uw,
    _advective_momentum_flux_Vu,
    _advective_momentum_flux_Vv,
    _advective_momentum_flux_Vw,
    _advective_momentum_flux_Wu,
    _advective_momentum_flux_Wv,
    _advective_momentum_flux_Ww,
    _advective_tracer_flux_x,
    _advective_tracer_flux_y,
    _advective_tracer_flux_z

import Oceananigans.TurbulenceClosures:
    _viscous_flux_ux,
    _viscous_flux_uy,
    _viscous_flux_uz,
    _viscous_flux_vx,
    _viscous_flux_vy,
    _viscous_flux_vz,
    _viscous_flux_wx,
    _viscous_flux_wy,
    _viscous_flux_wz,
    _diffusive_flux_x,
    _diffusive_flux_y,
    _diffusive_flux_z,
    κᶠᶜᶜ,
    κᶜᶠᶜ,
    κᶜᶜᶠ,
    νᶜᶜᶜ,
    νᶠᶠᶜ,
    νᶜᶠᶠ,
    νᶠᶜᶠ

export AbstractImmersedBoundary

"""
AbstractImmersedBoundary

Abstract supertype for immersed boundary grids.
"""
abstract type AbstractImmersedBoundary end

struct ImmersedBoundaryGrid{FT, TX, TY, TZ, G, I} <: AbstractGrid{FT, TX, TY, TZ}
    grid :: G
    immersed_boundary :: I

    function ImmersedBoundaryGrid{TX, TY, TZ}(grid::G, ib::I) where {TX, TY, TZ, G <: AbstractUnderlyingGrid, I}
        FT = eltype(grid)
        return new{FT, TX, TY, TZ, G, I}(grid, ib)
    end
end

function ImmersedBoundaryGrid(grid, ib)
    @warn "ImmersedBoundaryGrid is unvalidated and may produce incorrect results. " *
              "Don't hesitate to help validate ImmersedBoundaryGrid by reporting any bugs " *
              "or unexpected behavior to https://github.com/CliMA/Oceananigans.jl/issues"

    TX, TY, TZ = topology(grid)
    return ImmersedBoundaryGrid{TX, TY, TZ}(grid, ib)
end

const IBG = ImmersedBoundaryGrid

@inline Base.getproperty(ibg::IBG, property::Symbol) = get_ibg_property(ibg, Val(property))
@inline get_ibg_property(ibg::IBG, ::Val{property}) where property = getfield(getfield(ibg, :grid), property)
@inline get_ibg_property(ibg::IBG, ::Val{:immersed_boundary}) = getfield(ibg, :immersed_boundary)
@inline get_ibg_property(ibg::IBG, ::Val{:grid}) = getfield(ibg, :grid)

Adapt.adapt_structure(to, ibg::IBG{FT, TX, TY, TZ}) where {FT, TX, TY, TZ} =
    ImmersedBoundaryGrid{TX, TY, TZ}(adapt(to, ibg.grid), adapt(to, ibg.immersed_boundary))

with_halo(halo, ibg::ImmersedBoundaryGrid) = ImmersedBoundaryGrid(with_halo(halo, ibg.grid), ibg.immersed_boundary)

@inline cell_advection_timescale(u, v, w, ibg::ImmersedBoundaryGrid) = cell_advection_timescale(u, v, w, ibg.grid)
@inline φᶠᶠᵃ(i, j, k, ibg::ImmersedBoundaryGrid) = φᶠᶠᵃ(i, j, k, ibg.grid)

@inline xnode(LX, LY, LZ, i, j, k, ibg::ImmersedBoundaryGrid) = xnode(LX, LY, LZ, i, j, k, ibg.grid)
@inline ynode(LX, LY, LZ, i, j, k, ibg::ImmersedBoundaryGrid) = ynode(LX, LY, LZ, i, j, k, ibg.grid)
@inline znode(LX, LY, LZ, i, j, k, ibg::ImmersedBoundaryGrid) = znode(LX, LY, LZ, i, j, k, ibg.grid)

all_x_nodes(loc, ibg::ImmersedBoundaryGrid) = all_x_nodes(loc, ibg.grid)
all_y_nodes(loc, ibg::ImmersedBoundaryGrid) = all_y_nodes(loc, ibg.grid)
all_z_nodes(loc, ibg::ImmersedBoundaryGrid) = all_z_nodes(loc, ibg.grid)

include("immersed_grid_metrics.jl")
include("grid_fitted_immersed_boundary.jl")
include("mask_immersed_field.jl")

#####
##### Diffusivities (for VerticallyImplicitTimeDiscretization)
#####

for (locate_coeff, loc) in ((:κᶠᶜᶜ, (f, c, c)),
                            (:κᶜᶠᶜ, (c, f, c)),
                            (:κᶜᶜᶠ, (c, c, f)),
                            (:νᶜᶜᶜ, (c, c, c)),
                            (:νᶠᶠᶜ, (f, f, c)),
                            (:νᶠᶜᶠ, (f, c, f)),
                            (:νᶜᶠᶠ, (c, f, f)))

    @eval begin
        @inline $locate_coeff(i, j, k, ibg::IBG{FT}, coeff) where FT =
            ifelse(solid_cell(loc..., i, j, k, ibg), $locate_coeff(i, j, k, ibg.grid, coeff), zero(FT))
    end
end

end # module


const KeyType = Union{Symbol, Int}

Base.@kwdef struct Entry
    plottype::PlotFunc=Any
    primary::NamedTuple=(;)
    positional::Tuple=()
    named::NamedTuple=(;)
    summaries::Dict{KeyType, Any}=Dict{KeyType, Any}()
    labels::Dict{KeyType, Any}=Dict{KeyType, Any}()
    attributes::Dict{Symbol, Any}=Dict{Symbol, Any}()
end

function Entry(e::Entry; kwargs...)
    nt = (; e.plottype, e.primary, e.positional, e.named, e.summaries, e.labels, e.attributes)
    return Entry(; merge(nt, values(kwargs))...)
end

"""
    AxisEntries(axis::Union{Axis, Nothing}, entries::Vector{Entry}, labels, scales)

Define all ingredients to make plots on an axis.
Each scale can be either a `CategoricalScale` (for discrete collections), such as
`CategoricalScale(["a", "b"], ["red", "blue"])`, or a function,
such as `log10`. Other scales may be supported in the future.
"""
struct AxisEntries
    axis::Union{Axis, Axis3}
    entries::Vector{Entry}
    scales::Dict{KeyType, Any}
    labels::Dict{KeyType, Any}
end

AbstractPlotting.Axis(ae::AxisEntries) = ae.axis

# Slightly complex machinery to recombine stacked barplots
function mergeable(e1::Entry, e2::Entry)
    for e in (e1, e2)
        e.plottype <: BarPlot || return false
        haskey(e.primary, :stack) || return false
    end
    return true
end

function lengthen_primary(e::Entry)
    N = length(first(e.positional))
    primary = map(t -> fill(only(t), N), e.primary)
    return Entry(e; primary)
end

# Combine entries as a unique entry with longer data
function stack(short_entries::AbstractVector{Entry})
    entries = map(lengthen_primary, short_entries)
    primary = map(vcat, map(entry -> entry.primary, entries)...)
    positional = map(vcat, map(entry -> entry.positional, entries)...)
    named = map(vcat, map(entry -> entry.named, entries)...)
    return Entry(first(entries); primary, positional, named)
end

mapkeys(f, tup::Tuple) = map(f, keys(tup))
mapkeys(f, ::NamedTuple{names}) where {names} = NamedTuple{names}(map(f, names))

function AbstractPlotting.plot!(ae::AxisEntries)
    axis, entries, labels, scales = ae.axis, ae.entries, ae.labels, ae.scales
    i, N = 1, length(entries)
    while i ≤ N
        j = i + 1
        while j ≤ N && mergeable(entries[i], entries[j])
            j += 1
        end
        entry, i = j == i + 1 ? entries[i] : stack(entries[i:j-1]), j
        attributes = copy(entry.attributes)
        primary, positional, named = map((entry.primary, entry.positional, entry.named)) do tup
            return mapkeys(tup) do key
                rescaled = rescale(tup[key], scales[key])
                return isempty(size(rescaled)) ? rescaled[] : rescaled
            end
        end
        merge!(attributes, pairs(primary), pairs(named))

        # Remove layout info
        for sym in [:col, :row, :layout]
            pop!(attributes, sym, nothing)
        end

        # Implement defaults
        for (key, val) in pairs(default_styles())
            key == :color && has_zcolor(entry) && continue # do not overwrite contour color
            get!(attributes, key, val)
        end

        # Set dodging information
        dodge = get(scales, :dodge, nothing)
        isa(dodge, CategoricalScale) && (attributes[:n_dodge] = maximum(dodge.plot))

        # Implement alpha transparency
        alpha = pop!(attributes, :alpha, nothing)
        color = get(attributes, :color, nothing)
        !isnothing(color) && alpha isa Number && (attributes[:color] = (color, alpha))

        plottype = AbstractPlotting.plottype(entry.plottype, positional...)
        plot!(plottype, axis, positional...; attributes...)
    end
    # TODO: support log colorscale
    ndims = isaxis2d(ae) ? 2 : 3
    for (i, var) in zip(1:ndims, (:x, :y, :z))
        label, scale = get(labels, i, nothing), get(scales, i, nothing)
        any(isnothing, (label, scale)) && continue
        axislabel, axisticks, axisscale = Symbol.(var, (:label, :ticks, :scale))
        getproperty(axis, axisticks)[] = ticks(scale)
        getproperty(axis, axislabel)[] = string(label)
    end
    return axis
end

entries(grid::AbstractMatrix{AxisEntries}) = Iterators.flatten(ae.entries for ae in grid)

struct FigureGrid
    figure::Figure
    grid::Matrix{AxisEntries}
end

Base.show(io::IO, fg::FigureGrid) = show(io, fg.figure)
Base.show(io::IO, m::MIME, fg::FigureGrid) = show(io, m, fg.figure)
Base.show(io::IO, ::MIME"text/plain", fg::FigureGrid) = print(io, "FigureGrid()")

Base.showable(mime::MIME{M}, fg::FigureGrid) where {M} = showable(mime, fg.figure)

Base.display(fg::FigureGrid) = display(fg.figure)

function FileIO.save(filename::String, fg::FigureGrid; kwargs...)
    return FileIO.save(FileIO.query(filename), fg; kwargs...)
end

function FileIO.save(file::FileIO.Formatted, fg::FigureGrid; kwargs...)
    return FileIO.save(file, fg.figure; kwargs...)
end

to_tuple(fg) = (fg.figure, fg.grid)

Base.iterate(fg::FigureGrid) = iterate(to_tuple(fg))
Base.iterate(fg::FigureGrid, i) = iterate(to_tuple(fg), i)


using Random

mutable struct Chain{Int,Int} <: AbstractEnvironment
    state::Int
    reward::Float64
    done::Bool
    size::Int
    time_step::Int
	stochastic::Bool
	randchance::Float64
    function Chain(size::Int, stochastic::Bool=false, chance::Float64=0.2)
        new{Int,Int}(1, 0., false, size, 0, stochastic, chance)
    end
end

function get_gamma(env::Chain)
	return 1.0
end

function randomize_env(::Type{T}, rng::AbstractRNG, size::Int, stochastic::Bool) where {T <: Chain}
	ϵ = rand(rng, Uniform(0., 0.25))
	return Chain(size, stochastic, ϵ)
end

function get_state_desc(env::Chain)::Int
    return env.size
end

function get_action_desc(env::Chain)::Int
    return 2
end

function step!(env::Chain, action::Int, rng::AbstractRNG)::Float64
    env.time_step += 1
    if action <= 0 || action > 2
        error("Action needs to be an integer in [1, 2]")
    end

    if env.stochastic
		tmp = rand(rng)
		if tmp < env.randchance / 2.  # if random 50% chance to not move
			action = 0
		elseif tmp < env.randchance  # if random 50% chance to move in oposite direction
			action = 3 - action
		end
	end

    if action == 1
        env.state -= 1
    elseif action == 2
        env.state += 1
    end

	env.state = clamp(env.state, 1, env.size)

    env.reward = -1.0
	max_steps = 20 * env.size#^2
    env.done = (env.state == env.size) | (env.time_step ≥ max_steps)

	if env.done
		env.reward = 0.
	end

    return env.reward
end

function get_state(env::Chain)::Int
    return env.state
end

function get_reward(env::Chain)::Float64
    return env.reward
end

function is_terminal(env::Chain)::Bool
    return env.done
end

function env_reset!(env::Chain, rng)
	env.time_step = 0
    env.state = 1
    env.done = false
end

function clone(env::Chain)::Chain
    env2 = Chain(env.size, env.stochastic, env.randchance)
    env2.time_step = deepcopy(env.time_step)
    env2.state = deepcopy(env.state)
    env2.done = deepcopy(env.done)
    env2.reward = deepcopy(env.reward)
    return env2
end


# This file includes intregrator construction

function construct_integrator(deproblem, input, righthandside, state, t, modelargs=(), solverargs=();
    alg=nothing, stateder=state, modelkwargs=NamedTuple(), solverkwargs=NamedTuple(), numtaps=3)
    # If needed, construct interpolant for input.
    interpolant = input === nothing ? nothing : Interpolant(numtaps, length(input))

    # Construct the problem
    if deproblem == SDEProblem
        problem = deproblem(righthandside[1], righthandside[2], state, (t, Inf), interpolant, modelargs...;
        modelkwargs...)
    elseif deproblem == DDEProblem
        problem = deproblem(righthandside[1], state, righthandside[2], (t, Inf), interpolant, modelargs...;
         modelkwargs...)
    elseif deproblem == DAEProblem
        problem = deproblem(righthandside, stateder, state, (t, Inf), interpolant, modelargs...;
        modelkwargs...)
    else
        problem = deproblem(righthandside, state, (t, Inf), interpolant, modelargs...;
        modelkwargs...)
    end

    # Initialize the integrator
    init(problem, alg, solverargs...; save_everystep=false, dense=true, solverkwargs...)
end

#= This function checks whether the syntax is of the form

    @my_macro_to_define_new_dynamical_system mutable struct NewSystem{T, S} <: SuperTypeName
        # fields
    end

    where @my_macro_to_define_new_dynamical_system is any macro used to define new dynamical system such as @def_ode_system, @def_sde_system, etc.
=#
function checksyntax(ex::Expr, supertypename::Symbol)
    ex.head == :struct && ex.args[1] ||
        error("Invalid usage. The expression should start with `mutable struct`.\n$ex")
    ex.args[2].head == :(<:) && ex.args[2].args[2] == supertypename ||
        error("Invalid usage. The type should be a subtype of $supertypename.\n$ex")
end

function appendcommonex!(ex)
    foreach(nex -> appendex!(ex, nex), [
    :( trigger::$TRIGGER_TYPE_SYMBOL = Inpin() ),
    :( handshake::$HANDSHAKE_TYPE_SYMBOL = Outpin{Bool}() ),
    :( callbacks::$CALLBACKS_TYPE_SYMBOL = nothing ),
    :( name::Symbol = Symbol() ),
    :( id::$ID_TYPE_SYMBOL = Causal.uuid4() ),
    :( t::Float64 = 0. ),
    :( modelargs::$MODEL_ARGS_TYPE_SYMBOL = ()  ),
    :( modelkwargs::$MODEL_KWARGS_TYPE_SYMBOL = NamedTuple()  ),
    :( solverargs::$SOLVER_ARGS_TYPE_SYMBOL = ()  ),
    :( solverkwargs::$SOLVER_KWARGS_TYPE_SYMBOL = NamedTuple()  ),
    ])
    ex
end

# For syntactic-sugar: ds.interpolant
function getproperty(ds::AbstractDynamicSystem, name::Symbol)
    name == :interpolant ? ds.integrator.sol.prob.p : getfield(ds, name)
end


__precompile__(false)

module ReviseTest

square(x) = x^2

cube(x) = error("cube")

fourth(x) = x^4  # this is an addition to the file

module Internal

mult2(x) = error("mult2")
mult3(x) = 3*x

end  # Internal

end


using Serialization, Statistics, DataFrames
import GEAS:MaCS, macs_2_base, macs_args, qtl_breeding, sim_QTL

function jenko_fork(fork, qtl, dic, nedit, esires, df, class)
    for t in nedit
        cc = "$class, $t edit"
        @info cc
        dic[:nEdit] = t         # how many (top) QTN to edit
        arg = (; dic...)
        base = deserialize(fork)
        ped, _ = qtl_breeding(base, arg, qtl, eSires = esires)
        tdf = combine(ped, :tbv => mean => :mtbv)
        tdf.sel .= cc
        append!(df, tdf)
    end
end

"""
    function jenko2015(; nid = 1000, nchr = 10, nsnp = 1000, maf = .05, dir = "dat/jenko2015")
---
## Description
This is to repeat Jenko 2015.
"""
function jenko2015(; nid = 1000, nchr = 10, nsnp = 1000, maf = .05, dir = "dat/jenko2015")
    @info "Simulation of a base with `MaCS`"
    par = macs_args(nid)
    tmp = joinpath(dir, "macs")
    isdir(tmp) || mkpath(tmp)

    # MaCS(par.cattle, nchr, dir = tmp)
    # base = macs_2_base(10, nsnp, dir = tmp)
    # serialize("$dir/base.ser", base)
    base = deserialize("$dir/base.ser")
    qtl = sim_QTL(base, nchr * nsnp)[1]

    dic = Dict(
        :nSire=> 25,
        :nDam => 500,
        :nSib => 2,             # such that selection is only on sires
        :nG8n => 21,
        :h²   => .5)            # dummy, only to utilize GEAS

    @info "Genomic selection on generation -20 → 0"

    arg = (; dic...)
    # Note, orginal work was just using TBV. No evaluation method envolved.
    ped, snp = qtl_breeding(base, arg, qtl)
    df = combine(ped, :tbv => mean => :mtbv)
    df.g8n[:] = arg.nG8n-1 : -1 : 0
    df.sel .= "pre-fork"        # 0 for generation -20 → 0

    # create new base, and insert editing option
    base.hap[:, :] = snp    # the new base, only to replace genotypes
    serialize("$dir/fork.ser", base) # this base will go through many different scenarios

    @info "Generation 1 → 20"
    dic[:nG8n] = 20

    @info "Continue selection with no editing"
    arg = (; dic...)
    ped, _ = qtl_breeding(base, arg, qtl)
    tdf = combine(ped, :tbv => mean => :mtbv)
    tdf.sel .= "GS only"     # 1 for continued normal selection from 0
    append!(df, tdf)

    # Editing the top 5 bulls, 25, 50, 100 QTN edits
    nedit = [25, 50, 100]
    esires = [ones(Int, 5); zeros(Int, 20)]
    jenko_fork("$dir/fork.ser", qtl, dic, nedit, esires, df, "top 5 sires")

    # Editing the top 10 bulls, 1, 5, 10, 20 QTN edits
    nedit = [1, 5, 10, 20]
    esires = [ones(Int, 10); zeros(Int, 15)]
    jenko_fork("$dir/fork.ser", qtl, dic, nedit, esires, df, "top 10 sires")

    # Editing the bottom 10 bulls, 1, 5, 10, 20 QTN edits
    esires = [zeros(Int, 15); ones(Int, 10)]
    jenko_fork("$dir/fork.ser", qtl, dic, nedit, esires, df, "bottom 10 sires")

    @info "Editing the all 25 bulls, 1, 5, 10 20 edits"
    esires = ones(Int, 25)
    jenko_fork("$dir/fork.ser", qtl, dic, nedit, esires, df, "all sires")

    df
end

function mytest(dic)
    dic[:tmp] => [1, 2, 3]
end


using DataFrames, Dates
import FileIO:save
# Tools for runners

function runner_eachlearner(learnerslist,
                    specs::Union{SpecsMultinomial, SpecsGaussian},
                    foldername::String, filename::String)
    for i in 1:length(learnerslist)
        println("learnersname" * " : " * learnerslist[i].name)
        runner_core([learnerslist[i]], specs, foldername, filename)
    end
    println("Finishing: " *Dates.format(Dates.now(), "yyyy-mm-dd_HH-MM-SS"))
end

function runner_core(learnerslist, specs::Union{SpecsMultinomial, SpecsGaussian},
                    foldername::String, filename::String)

    savepath = makehomesavepath(foldername)
    mkdir(savepath)

    if typeof(specs) == SpecsMultinomial
        settingslearner = collect(Iterators.product(collect(learnerslist),
                            specs.stochasticities, specs.changeprobabilities))
    elseif typeof(specs) == SpecsGaussian
        settingslearner = collect(Iterators.product(collect(learnerslist),
                            specs.sigmas, specs.changeprobabilities))
    end
    settings = collect(Iterators.product(settingslearner, 1:specs.nseeds))
    df = comparison(settings, specs)

    save(joinpath(savepath, filename * learnerslist[1].name * ".jld2"),
            Dict("df" => df, "specs" => specs))
end


type CuDNNPoolingState
  pooling_desc :: CuDNN.PoolingDescriptor
  inputs_desc  :: Vector{CuDNN.Tensor4dDescriptor}
  outputs_desc :: Vector{CuDNN.Tensor4dDescriptor}
end

function setup_etc(backend::GPUBackend, layer::PoolingLayer, inputs,
    pooled_width, pooled_height)

  dtype = eltype(inputs[1])

  if isa(layer.pooling, Pooling.Max)
    pooling_mode = CuDNN.CUDNN_POOLING_MAX
  elseif isa(layer.pooling, Pooling.Mean)
    pooling_mode = CuDNN.CUDNN_POOLING_AVERAGE
  else
    error("TODO: pooling mode $(layer.pooling) not supported by CuDNN")
  end
  pooling_desc = CuDNN.create_pooling_descriptor(pooling_mode, layer.kernel, layer.stride, layer.pad)
  inputs_desc = Array(CuDNN.Tensor4dDescriptor, length(inputs))
  outputs_desc = Array(CuDNN.Tensor4dDescriptor, length(inputs))

  for i = 1:length(inputs)
    width,height,channels,num = size(inputs[i])
    inputs_desc[i] = CuDNN.create_tensor4d_descriptor(dtype,(width,height,channels,num))
    outputs_desc[i] = CuDNN.create_tensor4d_descriptor(dtype,
        (pooled_width[i],pooled_height[i],channels,num))
  end
  etc = CuDNNPoolingState(pooling_desc, inputs_desc, outputs_desc)
  return etc
end

function shutdown(backend::GPUBackend, state::PoolingLayerState)
  map(destroy, state.blobs)
  map(destroy, state.blobs_diff)
  CuDNN.destroy_pooling_descriotpr(state.etc.pooling_desc)
  map(CuDNN.destroy_tensor4d_descriptor, state.etc.inputs_desc)
  map(CuDNN.destroy_tensor4d_descriptor, state.etc.outputs_desc)
end

function forward(backend::GPUBackend, state::PoolingLayerState, inputs::Vector{Blob})
  layer = state.layer
  alpha = one(eltype(inputs[1]))
  beta = zero(eltype(inputs[1]))
  for i = 1:length(inputs)
    CuDNN.pooling_forward(backend.cudnn_ctx, state.etc.pooling_desc, alpha,
        state.etc.inputs_desc[i], inputs[i].ptr, beta,
        state.etc.outputs_desc[i], state.blobs[i].ptr)
  end
end

function backward(backend::GPUBackend, state::PoolingLayerState, inputs::Vector{Blob}, diffs::Vector{Blob})
  layer = state.layer
  alpha = one(eltype(inputs[1]))
  beta = zero(eltype(inputs[1]))
  for i = 1:length(inputs)
    if isa(diffs[i], CuTensorBlob)
      CuDNN.pooling_backward(backend.cudnn_ctx, state.etc.pooling_desc, alpha,
          state.etc.outputs_desc[i], state.blobs[i].ptr,
          state.etc.outputs_desc[i], state.blobs_diff[i].ptr,
          state.etc.inputs_desc[i], inputs[i].ptr,
          beta, state.etc.inputs_desc[i], diffs[i].ptr)
    end
  end
end


@recipe(CanalPlot) do scene
    Attributes(
        color = :red
    )
end

@recipe(GriddedPlot) do scene
    Attributes(
        colormap = :jet
    )
end

@recipe(PlotGrid) do scene
    Attributes(
        marker = :square
    )
end

const CanalPlotArg = CanalPlot{<:Tuple{AbstractVector, CanalConfig}}
const GriddedPlotArg = GriddedPlot{<:Tuple{AbstractGrid}}
const PlotGridArg = PlotGrid{<:Tuple{AbstractGrid}}
# Makie.argument_names(::Type{<: CanalPlotArg}) = (:x, :canal,)

function Makie.plot!(cp::CanalPlotArg)
    xs = cp[1]
    canal = cp[2]
    newy = δ(xs.val, canal.val)

    h = canal.val.H
    hobs = Observable(h)
    ytop = Observable(h .- newy)

    ybot = Observable(-h .+ newy)
    # ys[] = newy
    # d[] = canal.val.d
    function update_plot(xs, canal)
        # colors[]

        # clear tde vectors inside tde observables
        empty!(ytop[])
        empty!(ybot[])
        newy = δ(xs, canal)
        hobs[] = canal.H
        ytop[] = hobs[] .- newy
        ysab[] = -hobs[] .+ newy
        # tden refill tdem witd our updated values
        # for (t, s) in zip(times, stockvalues)
        #     pusd!(ys[], Point2f(t, s.low))
        # end
        # append!(colors[], [x.close > x.open for x in stockvalues])
        # colors[] = colors[]
    end

    Makie.Observables.onany(update_plot, xs, canal)

    lines!(cp, xs, ytop, color = cp.color)
    lines!(cp, xs, ybot, color = cp.color)
    cp
end

function Makie.plot!(gp::GriddedPlotArg)
    grid = gp[1]

    # mat = Observable(trueview(grid.val))

    # function update_plot(grid)
    #     empty!(mat[])
    #     mat[] = trueview(grid)
    # end

    # Makie.Observables.onany(update_plot, grid)

    # z2nan = map(grid) do g
    #     replace(x -> isapprox(0., x) ? NaN : x, g)
    # end
    contourf!(gp, getxs(grid.val), getys(grid.val), grid, colormap = gp.colormap)
end

function Makie.plot!(gp::PlotGridArg)
    grid = gp[1]

    scatter!(gp, [(x, y) for x in getxs(grid.val) for y in getys(grid.val)], marker = gp.marker)
end


export add_type_D!, remove_type_D!

"""Returns True if left_kink and right_kink are entangled in a Type-D way
This does not check wether the two kinks are neighbouring"""
function is_type_D(left_kink::T4, right_kink::T4)
    if !(Set([left_kink.i, left_kink.j]) == Set([right_kink.k, right_kink.l])) &
        (Set([left_kink.k, left_kink.l]) == Set([right_kink.i, right_kink.j]))
        return true
    else
        return false
    end
end

"""Return pairs with indices of 'neighbouring' kinks that are Type-D entangled AND removable.
'neighbouring' refers to that only Tuples of Kinks that are the closest Kink to act on an orbital of the
other kink in the corresponding direktion are looked at.
The Tuples are always arranged in a way that the Kink who gets neighboured by
the opther stands first.(vice versa does not have to be the case)
The Set consists of the pairs where the Type-D-entanglement is oriented
#to the left of the first τ."""
function left_type_D_removable_pairs(ck)
    pairs_left = Set{Tuple{Int,Int}}()
    for (i,(τ,kink)) in enumerate(ck)
        i_left = prev_affecting(ck, orbs(kink) ,τ)
        if is_type_D(last(ck[i_left]), kink)
            if (norm(kink.i.vec-kink.k.vec) <= ex_radius)
                if kink.i.spin == kink.k.spin
                    push!(pairs_left, (i, i_left))
                end
            end
        end
    end
    return pairs_left
end

"""Return pairs with indices of 'neighbouring' Kinks that are Type-D-Entangeld AND removable.
'neighbouring' refers to that only Tuples of Kinks that are the closest Kink to act on an orbital of the
other kink in the corresponding direktion are looked at.
The Tuples are always arranged in a way that the Kink who gets neighboured by
the opther stands first.(vice versa does not have to be the case)
The Set consists of the pairs where the Type-D-entanglement is oriented
#to the right of the first τ."""
function right_type_D_removable_pairs(ck)
    pairs_right = Set{Tuple{Int,Int}}()
    for (i,(τ,kink)) in enumerate(ck)
        i_right = next_affecting(ck, orbs(kink), τ)
        if is_type_D(kink, last(ck[i_right]))
            if (norm(kink.i.vec-kink.k.vec) <= ex_radius)
                if kink.i.spin == kink.k.spin
                    push!(pairs_right, (i, i_right))
                end
            end
        end
    end
    return pairs_right
end

"""
    possible_new_orb1_D(occs, excite_orb1, excite_orb2, old_orb1, old_orb2)
This function will find possibilites for the choice of the first Orbital that should be part of both Kinks after an add_type_D!-update,
when the two old orbitals of the old Kink are already selected.
To check possibility this will in particular check conservation laws and the occupation of the resulting fourth orb.
"""
function possible_new_orb1_D(occs, excite_orb1, excite_orb2, old_orb1, old_orb2)
    opportunities = filter(new_orb_1 -> in(find_fourth_orb_for_kink(new_orb_1, old_orb1, old_orb2),occs) && (new_orb_1 != find_fourth_orb_for_kink(new_orb_1, old_orb1, old_orb2)),
                    intersect!(sphere_with_same_spin(excite_orb1, dk = ex_radius), occs))

    return setdiff!(opportunities, Set([excite_orb1, excite_orb2, old_orb1, old_orb2]))
end

function add_type_D!(m::Model, e::Ensemble, c::Configuration) :: Tuple{Float64,Step}
    prop_prob = 1.0
    if isempty(c.kinks)
        return 1.0, Step()
    end

    old_τ, old_kink = rand(c.kinks)
    prop_prob *= 1.0/length(c.kinks)
    occs = occupations_at(c, old_τ)
    prop_prob *= 0.5 #left or right

    direction = rand([:left, :right])

    if direction == :left
        old_orbs = annihilators(old_kink)
        retained_orbs = creators(old_kink)
    else
        old_orbs = creators(old_kink)
        retained_orbs = annihilators(old_kink)
    end

    opportunities_new_orb1 = possible_new_orb1_D(occs, retained_orbs..., old_orbs...)

    if isempty(opportunities_new_orb1)
        return 1.0, Step()
    end

    new_orb1 = rand(opportunities_new_orb1)
    prop_prob *= 1.0/length(opportunities_new_orb1)
    new_orbs = (new_orb1, find_fourth_orb_for_kink(new_orb1, retained_orbs...))

    @assert(in(new_orbs[2], occs) & (new_orbs[1] != new_orbs[2]))

    if direction == :left
        τ_interval = old_τ - τ_prev_affecting(c.kinks, (retained_orbs..., new_orbs...), old_τ)
    else
        τ_interval = τ_next_affecting(c.kinks, (retained_orbs..., new_orbs...), old_τ ) - old_τ
    end

    if τ_interval < 0
        τ_interval +=1
    end
    @assert τ_interval > 0

    delta_τ = ImgTime(rand()*τ_interval)

    if direction == :left
        τ_new_kink = old_τ - delta_τ
    else
        τ_new_kink = old_τ + delta_τ
    end

    if τ_new_kink < 0
        change_occupations = true
        τ_new_kink += 1
    elseif τ_new_kink >= 1
        change_occupations = true
        τ_new_kink -= 1
    else
        change_occupations = false
    end

    while haskey(c.kinks, τ_new_kink)
        delta_τ = ImgTime(rand()*τ_interval)
        if dir == :left
            τ_new_kink = old_τ - delta_τ
        else
            τ_new_kink = old_τ + delta_τ
        end
        if τ_new_kink < 0
            change_occupations = true
            τ_new_kink += 1
        elseif τ_new_kink > 1
            change_occupations = true
            τ_new_kink -= 1
        else
            change_occupations = false
        end
    end

    if direction == :left
        τ_left = τ_new_kink
        τ_right = old_τ
    else
        τ_left = old_τ
        τ_right = τ_new_kink
    end

    delta_τ = abs(delta_τ)

    prop_prob *= 1.0/float(τ_interval)

    if change_occupations
        orbs_drop = new_orbs
        orbs_add = retained_orbs
    else
        orbs_drop = nothing
        orbs_add = nothing
    end

    prop_prob *= 0.5# shuffle orbitals of the changed kink
    if direction == :left
        kinks_add = ( τ_left => T4(retained_orbs..., new_orbs...), τ_right => T4(random_shuffle(new_orbs...)..., old_orbs...) )
    else
        kinks_add = ( τ_left => T4(old_orbs..., random_shuffle(new_orbs...)...), τ_right => T4(new_orbs..., retained_orbs...) )
    end

    @assert is_type_D(last(first(kinks_add)), last(last(kinks_add)))

    kinks_drop = (old_τ => old_kink,)

    # MC Step generated by this update
    Δ = Step(orbs_drop, kinks_drop, orbs_add, kinks_add)
    delta_di = ΔWdiag_element(m, e, c, retained_orbs..., new_orbs..., τ_left, τ_right)
    apply_step!(c,Δ)

    # calculate weight differance
    dw_off_diag = abs( Woffdiag_element(m, e, last(first(kinks_add))) * Woffdiag_element(m, e, last(last(kinks_add))) / Woffdiag_element(m, e, old_kink) )
    dw = e.β * dw_off_diag * exp(-(e.β * delta_τ*(energy(m, retained_orbs[1]) + energy(m, retained_orbs[2]) - energy(m, new_orbs[1]) - energy(m, new_orbs[2])) + e.β * delta_di))

    if direction == :left
        inverse_prop_prob = 0.5 / length( right_type_D_removable_pairs( c.kinks ) )
    else
        inverse_prop_prob = 0.5 / length( left_type_D_removable_pairs( c.kinks ) )
    end
    @assert delta_τ > 0
    @assert !isinf((inverse_prop_prob/prop_prob)*dw)
    return (inverse_prop_prob/prop_prob)*dw, Δ
end

function remove_type_D!(m::Model, e::Ensemble, c::Configuration) :: Tuple{Float64,Step}
    prop_prob = 0.5
    direction = rand([:left, :right])

    if direction == :left
        #removed kink left of changed kink
        opportunities = right_type_D_removable_pairs(c.kinks)
    else
        #removed kink right of changed kink
        opportunities = left_type_D_removable_pairs(c.kinks)
    end

    if isempty(opportunities)
        return 1.0, Step()
    end

    i_removed, i_changed = rand(opportunities)

    (removed_kink_τ, removed_kink) = c.kinks[i_removed]
    (changed_kink_τ, changed_kink) = c.kinks[i_changed]
    if direction == :left
        τ_left = removed_kink_τ
        τ_right = changed_kink_τ
    else
        τ_left = changed_kink_τ
        τ_right = removed_kink_τ
    end

    prop_prob *= 1.0/length(opportunities)

    if direction == :left
        (retained_orb1, retained_orb2, removed_orb1, removed_orb2) = orbs(removed_kink)
        (_, _, changed_orb1, changed_orb2) = orbs(changed_kink)

        @assert removed_kink.i != removed_kink.k

        add_kinks = (changed_kink_τ => T4(retained_orb1, retained_orb2, changed_orb1, changed_orb2),)
    else
        (removed_orb1, removed_orb2, retained_orb1, retained_orb2) = orbs(removed_kink)
        (changed_orb1, changed_orb2, _, _) = orbs(changed_kink)

        add_kinks = (changed_kink_τ => T4( changed_orb1, changed_orb2, retained_orb1, retained_orb2),)
    end

    # see if c.occupations change
    if τ_right < τ_left
        drop_orbs = (retained_orb1, retained_orb2)
        add_orbs = (removed_orb1, removed_orb2)
    else
        drop_orbs = nothing
        add_orbs = nothing
    end

    drop_kinks = (changed_kink_τ => changed_kink, removed_kink_τ => removed_kink)

    # MC Step generated by this update
    Δ = Step(drop_orbs, drop_kinks, add_orbs, add_kinks)
    apply_step!(c,Δ)

    #calculate reverse_prop_prob
    occs = occupations_at(c, changed_kink_τ)

    opportunities_reverse_new_orb1 = possible_new_orb1_D(occs, retained_orb1, retained_orb2, changed_orb1, changed_orb2)

    if direction == :left
        τ_interval = changed_kink_τ - τ_prev_affecting( c.kinks, (removed_orb1, removed_orb2, retained_orb1, retained_orb2), changed_kink_τ )
    else
        τ_interval = τ_next_affecting( c.kinks, (removed_orb1, removed_orb2, retained_orb1, retained_orb2), changed_kink_τ ) - changed_kink_τ
    end

    @assert in(removed_orb1, opportunities_reverse_new_orb1)

    if τ_interval < 0
        τ_interval +=1
    end

    inverse_prop_prob = (0.5/(length(c.kinks))) * (1.0/length(opportunities_reverse_new_orb1)) * (1.0/float(τ_interval)) * (1/2)

    dw_off_diag = abs( Woffdiag_element(m, e, last(first(drop_kinks))) *
                       Woffdiag_element(m, e, last(last(drop_kinks))) /
                       Woffdiag_element(m, e, last(first(add_kinks)) ))

    delta_di = ΔWdiag_element(m, e, c, retained_orb1, retained_orb2, removed_orb1, removed_orb2, τ_left, τ_right)
    delta_τ = float(τ_right - τ_left)

    if delta_τ < 0
        delta_τ +=1
    end

    dw = (1.0/e.β)*(1.0/dw_off_diag) * exp(e.β * delta_τ * ( energy(m, retained_orb1) + energy(m, retained_orb2) - energy(m, removed_orb1) - energy(m, removed_orb2)) + e.β * delta_di)

    @assert delta_τ > 0
    @assert !isnan((inverse_prop_prob/prop_prob) * dw)
    return (inverse_prop_prob/prop_prob)*dw, Δ
end

function isuseful(c::Configuration, up::typeof(add_type_D!))
    if isempty(c.kinks)
        return false
    else
        return true
    end
end

function isuseful(c::Configuration, up::typeof(remove_type_D!))
    if length(c.kinks) < 3
        return false
    else
        return true
    end
end


module Optimizer

using ..Utils
using ..Profiler
import ..AutoTM
import nGraph

using ProgressMeter
using LightGraphs
using JuMP
using DocStringExtensions

# Scheduling Heuristic
include("affinity.jl")

include("abstractoptimizer.jl")
include("factory.jl")
include("configure.jl")

# Specific optimizer backends
include("ilp/ilp.jl")
include("numa/numa.jl")
include("memory_mode/memory_mode.jl")

#####
##### For gathering statistics
#####

_move_filter() = x -> ismove(x) && !ismoveasync(x)
_async_filter() = x -> ismoveasync(x)

# Hacky extensions for X-types
Utils.ismove(x::Profiler.XNode) = ismove(nGraph.Node(unx(x)))
Utils.ismoveasync(x::Profiler.XNode) = ismoveasync(nGraph.Node(unx(x)))
nGraph.is_persistent(x::Profiler.XTensor) = nGraph.is_persistent(unx(x))

function _move_filter(dest)
    is_persistent_result = (dest == PMEM) ? true : false

    return x -> ismove(x) && nGraph.is_persistent(first(outputs(x))) == is_persistent_result
end

function _async_filter(dest)
    is_persistent_result = (dest == PMEM) ? true : false

    return x -> _async_filter()(x) && nGraph.is_persistent(first(outputs(x))) == is_persistent_result
end

# Count metrics
_count(f, data; kw...) = _count(f, x -> 1, data; kw...)
function _count(f, g, data; filt = x -> true)
    count = 0
    for node in filter(filt, nodes(data))
        for tensor in f(node)
            count += g(tensor)
        end
    end
    return count
end

end


function parsecomment(s)

p = split(s, '=', keepempty=false);
n = length(p);

keys = Array{Any}(undef,n-1);
values = Array{Any}(undef,n-1);
for i = 1:n-1
    ii = findlast("\"", p[i]);
    if ii === nothing
        q = split(p[i], ' ', keepempty=false);
        if length(q) == 1
            keys[i] = q[1];
        elseif length(q)==2
            keys[i] = q[2];
            values[i-1] = q[1];
        end
    else
        t = split(p[i], '"', keepempty=false);
        q = split(t[1], ' ', keepempty=false);
        values[i-1] = map(x -> parse(Float64, x), q);
        keys[i] = t[2][2:end];
    end
end
t = split(p[n], '"', keepempty=false);
values[n-1] = t[1];

# handle energy
for i = 1:n-1
    if lowercase(string(keys[i])) == "energy"
        values[i] = parse(Float64, values[i]);
    end
end

# handle pbc
for i = 1:n-1
    if lowercase(string(keys[i])) == "pbc"
        values[i] = replace(values[i], "T" => "1");
        values[i] = replace(values[i], "F" => "0");
        q = split(values[i], ' ', keepempty=false);
        values[i] = map(x -> parse(Int64, x), q);
    end
end

# handle properties
indp = 0;
for i = 1:n-1
    if lowercase(string(keys[i])) == "properties"
        values[i] = split(values[i], ':', keepempty=false);
        indp = i;
        break;
    end
end

return keys, values, indp

end

function readEXTXYZ(filename, species)

config = initializeconfig(0);

f = readlines(filename);
n = length(f);

natomall = 0;
nframe = 0;
m = 0;
while (m<n)
    m = m + 1;
    nframe = nframe + 1
    natom = parse(Int64, f[m])
    config.natom = hcat(config.natom, reshape([natom],1,1))

    m = m + 1
    keys, values, indp = parsecomment(f[m]);
    for i = 1:length(keys)
        mystr = lowercase(string(keys[i]));
        if mystr == "lattice"
            d = reshape(values[i], length(values[i]), 1);
            if nframe == 1
                config.lattice = d;
            else
                config.lattice = hcat(config.lattice, d);
            end
            config.ncl = length(values[i]);
        elseif mystr == "energy"
            d = reshape([values[i]], 1, 1);
            if nframe == 1
                config.e = d;
            else
                config.e = hcat(config.e, d);
            end
            config.nce = 1;
        elseif mystr == "stress"
            d = reshape(values[i], length(values[i]), 1);
            if nframe == 1
                config.stress = d;
            else
                config.stress = hcat(config.stress, d);
            end
            config.ncs = length(values[i]);
        elseif mystr == "pbc"
            d = reshape(values[i], length(values[i]), 1);
            if nframe == 1
                config.pbc = d;
            else
                config.pbc = hcat(config.pbc, d);
            end
            config.ncp = length(values[i]);
        end
    end

    s = String.(reduce(vcat, split.(f[(m+1):(m+natom)])))
    s = reshape(s, (Int64(length(s)/natom), natom))
    m = m + natom

    # display(keys)
    # display(values)
    # display(indp)
    # display(values[indp])
    # handle properties
    prop = reshape(values[indp],(3, Int64(length(values[indp])/3)));
    nfield = size(prop,2);
    fieldtype = String.(prop[2,:]);
    fieldlength = parse.(Int64, prop[3,:]);
    fieldlength = Int64.(cumsum(fieldlength[:]));

    frame = Array{Any}(undef,nfield);
    for j = 1:nfield
        if j == 1
            k1 = 1;
            k2 = fieldlength[1];
        else
            k1 = fieldlength[j-1]+1;
            k2 = fieldlength[j];
        end
        if lowercase(fieldtype[j]) == "s" || lowercase(fieldtype[j]) == "l"
            frame[j] = s[k1,:];
            b = ones(Int64,1,natom);
            if lowercase(fieldtype[j]) == "l"
                ind = findall(frame[j][:] .== "F");
                b[ind] .= 0;
                frame[j] = b;
            else
                for k = 1:length(species)
                    ind = findall(frame[j][:] .== species[k]);
                    b[ind] .= k;
                end
                frame[j] = b;
            end
        else
           frame[j] = parse.(Float64, s[k1:k2,:]);
        end
    end

    for j = 1:nfield
        mystr = lowercase(prop[1,j]);
        if mystr == "species"
            if nframe == 1
                config.t = frame[j];
            else
                config.t = hcat(config.t, frame[j]);
            end
            config.nct = size(config.t,1);
        elseif mystr == "pos"
            if nframe == 1
                config.x = frame[j];
            else
                config.x = hcat(config.x, frame[j]);
            end
            config.ncx = size(config.x,1);
            config.dim = size(config.x,1);
        elseif mystr == "vel"
            if nframe == 1
                config.v = frame[j];
            else
                config.v = hcat(config.v, frame[j]);
            end
            config.ncv = size(config.v,1);
        elseif mystr == "forces"
            if nframe == 1
                config.f = frame[j];
            else
                config.f = hcat(config.f, frame[j]);
            end
            config.ncf = size(config.f,1);
        elseif mystr == "charge"
            if nframe == 1
                config.q = frame[j];
            else
                config.q = hcat(config.q, frame[j]);
            end
            config.ncq = size(config.q,1);
        elseif mystr == "mass"
            if nframe == 1
                config.mass = frame[j];
            else
                config.mass = hcat(config.mass, frame[j]);
            end
            config.ncm = size(config.mass,1);
        elseif mystr == "tags"
            if nframe == 1
                config.tags = frame[j];
            else
                config.tags = hcat(config.tags, frame[j]);
            end
            config.nci = size(config.tags,1);
        elseif mystr == "groups"
            if nframe == 1
                config.group = frame[j];
            else
                config.group = hcat(config.group, frame[j]);
            end
            config.ncg = size(config.group,1);
        elseif mystr == "move_mask"
            if nframe == 1
                config.move = frame[j];
            else
                config.move = hcat(config.move, frame[j]);
            end
            config.nco = size(config.move,1);
        elseif mystr == "z"
            if nframe == 1
                config.Z = frame[j];
            else
                config.Z = hcat(config.Z, frame[j]);
            end
            config.ncz = size(config.Z,1);
        end
    end
end

config.nconfigs = length(config.natom)

return config;

end


module CreateTsvForHeatmap

using CSV
using DataFrames

include("idMap.jl")
include("keyoutputs.jl")
include("pathwayList.jl")

function run(resultsFolder, pathwayListFile, keyOutputsFile, verbose)
    keyoutputs = KeyOutputs.getKeyoutputs(keyOutputsFile)
    pathwayList = PathwayList.getPathwayList(pathwayListFile)

    printHeader = false
    if !isdir(resultsFolder)
       println("$resultsFolder is not a directory")
    else
       mergedResultsFile = "$(resultsFolder)keyoutput-results.tsv"
       mergedResultsPathwayLevelFile = "$(resultsFolder)pathway-level-results.tsv"

       outfile = open(mergedResultsFile, "w")
       outPathwayFile = open(mergedResultsPathwayLevelFile, "w")

       if verbose
           println("creating: $mergedResultsFile and $mergedResultsPathwayLevelFile")
       end

       pathwaysFolder= joinpath(resultsFolder, "pathways")
       dirContents = readdir(pathwaysFolder)
       println("Run Directory:")
       println(dirContents)
       println("pathways:")
       println(pathwaysFolder)
       columns = ()
       for pathwayName in dirContents
           path = "$pathwaysFolder/$pathwayName"
           if verbose
               println("Processing: $path")
           end
           if isdir(path)
               pathwayId = get(pathwayList[pathwayName][:pathway_id])
               colour = get(pathwayList[pathwayName][:colour])
               shortName = get(pathwayList[pathwayName][:short_name])
               resultsFile = joinpath(path, "results.tsv")
               df = CSV.read(resultsFile,
                             delim="\t",
                             datarow=2,
			     types=Dict(1=>String),
                             quotechar="\\",
                             nullable=false)

               if printHeader == false
                  printHeader = true
                  columns = names(df)
                  write(outfile, "nodes\t")
                  for col in columns
                      if col != :node
                         write(outfile, "$col\t")
                      end
                  end
                  write(outfile, "pathway_label\n")

                  write(outPathwayFile, "nodes\t")
                  for col in columns
                      if col != :node
                         write(outPathwayFile, "$col\t")
                      end
                  end
                  write(outPathwayFile, "pathway_label\n")
               end

               fivePercent = 0.05 * size(columns,1)

               averageValues = []
               for row in eachrow(df)
                  nodeId = string(row[:node])
                  if haskey(keyoutputs, pathwayName) && haskey(keyoutputs[pathwayName], nodeId)
                      countChanged = 0
                      for col in columns
                          if col != :node
                             if row[col] != 1
                                 countChanged += 1
                             end
                          end
                      end
                      if countChanged >= fivePercent
                          for col in columns
                              if col == :node
                                  write(outfile, "$(pathwayId)-$(nodeId)\t")
                              else
                                  value = row[col]
                                  write(outfile, "$value\t")
                              end
                          end
                          write(outfile, "$shortName\n")
                          push!(averageValues, row)
                      end
                  end
               end

               numElements = length(averageValues)

               if numElements > 0
                   write(outPathwayFile, "$(pathwayId)\t")
                   for col in columns
                      if col != :node
                          sum = 0
                          for row in averageValues
                              sum = sum + log(10, row[Symbol(col)])
                          end
                          average = 10 ^ (sum / numElements)
                          write(outPathwayFile, "$average\t")
                      end
                   end
                   write(outPathwayFile, "$shortName\n")
               end
           end
        end
    end
end

end


include("constants.jl")

"""
Parse input string s as a float, otherwise return original string.
"""
function parsestring(s)
    x = tryparse(Float64, s)
    if isnothing(x)
        x = s
    end
    return x
end

"""
Return non-comment (#) lines from input file parsed as 2D array
"""
function readfile(filename)
    lines = readlines(filename)
    dat = [parsestring.(split(strip(line))) for line in lines if line[1] ≠ '#']
    return hcat(dat...)'
end

function loadmethyls(filename)
    println("load methyls: $filename")
    return readlines(filename)
end

function loadR2(filename)
    println("load R2: $filename")

    tmp = readfile(filename)
    R2_zq = tmp[:,1:8:end] .± tmp[:,2:8:end]
    R2_dq = tmp[:,3:8:end] .± tmp[:,4:8:end]
    R2_dqq = tmp[:,5:8:end] .± tmp[:,6:8:end]
    R2_qq = tmp[:,7:8:end] .± tmp[:,8:8:end]

    return R2_zq, R2_dq, R2_dqq, R2_qq
end

function loadS2tc(filename)
    println("load S2tc: $filename")

    S2tc = readfile(filename)
    return S2tc[:,1] .± S2tc[:,2]
end

function load1Hcsa(ηHfilename, S2tc, B0_MHz)
    println("load and calculate 1H CSA:")
    println("   ηH filename: $ηHfilename")
    println("   B0 (1H, in MHz) = $B0_MHz")

    ηH = readfile(ηHfilename)
    ηH = ηH[:,1] .± ηH[:,2]

    B0 = B0_MHz * 1e6 * 2π / γH;

    ΔσH = @. 1e6*ηH/(-(4/15)*(μ₀/(4π))*ħ*γH^2*γC*P2cosβ*rCH^-3*B0*S2tc*1e-9)
    return ΔσH
end

function load13Ccsa(filename)
    println("load 13C csa: $filename")

    ΔσC = readfile(filename)
    return ΔσC[:,1] .± ΔσC[:,2]
end


function read_d_drp(drp)
    @info "  - Dutch data training set"
    dp = DataFrame(ID          = String[],  #  1. Interbull ID
                   Milk        = Float64[], #  2. milk yield DRP
                   Milk_ERC    = Float64[], #  3. milk yield ERC
                   Fat         = Float64[], #  4. fat yield DRP
                   Fat_ERC     = Float64[], #  5. fat yield ERC
                   Protein     = Float64[], #  6. protein yield DRP
                   Protein_ERC = Float64[], #  7. protein yield ERC
                   SCS         = Float64[], #  8. somatic cell score DRP
                   SCS_ERC     = Float64[], #  9. somatic cell score ERC
                   NR56        = Float64[], # 10. NR56 DRP
                   NR56_ERC    = Float64[], # 11. NR56 ERC
                   x12         = Float64[], # 12. calving to 1st ins DRP
                   x13         = Float64[], # 13. calving to 1st ins ERC
                   x14         = Float64[], # 14. 1st-Last ins. Cows DRP
                   x15         = Float64[], # 15. 1st-Last ins. Cows ERC
                   x16         = Float64[], # 16. calving interval DRP
                   x17         = Float64[], # 17. calving interval ERC
                   x18         = Int[]      # 18. Numerical ID (as in “all.ped”)
                   )
    for line in eachline(drp)
        v = split(line)
        id = v[1]
        y = parse.(Float64, v[2:end-1])
        n = parse(Int, v[end])
        push!(dp, [id; y; n])
    end
    dp
end

function read_g_drp(drp)
    @info "  - German data training set"
    gp = DataFrame(ID          = String[],  #  1. Interbull ID
                   Milk        = Float64[], #  2. milk yield DRP
                   Milk_ERC    = Float64[], #  3. milk yield ERC
                   Fat         = Float64[], #  4. fat yield DRP
                   Fat_ERC     = Float64[], #  5. fat yield ERC
                   Protein     = Float64[], #  6. protein yield DRP
                   Protein_ERC = Float64[], #  7. protein yield ERC
                   SCS         = Float64[], #  8. somatic cell score DRP
                   SCS_ERC     = Float64[], #  9. somatic cell score ERC
                   NR56        = Float64[], # 10. NR56 heifers DRP
                   NR56_ERC    = Float64[], # 11. NR56 heifers ERC
                   x12         = Float64[], # 12. calving to 1st ins DRP
                   x13         = Float64[], # 13. calving to 1st ins ERC
                   x14         = Float64[], # 14. NR56 cows DRP
                   x15         = Float64[], # 15. NR56 cows ERC
                   x16         = Float64[], # 16. 1st-Last ins. Cows DRP
                   x17         = Float64[], # 17. 1st-Last ins. Cows ERC
                   x18         = Float64[], # 18. Days open cows DRP
                   x19         = Float64[], # 19. Days open cows ERC
                   N           = Int[]      # 20. Numerical ID (as in “all.ped”)
                   )
    for line in eachline(drp)
        v = split(line)
        id = v[1]
        y = parse.(Float64, v[2:end-1])
        n = parse(Int, v[end])
        push!(gp, [id; y; n])
    end
    gp
end

function read_n_drp(drp)
    @info "  - Norwegian data training set"
    np = DataFrame(ID       = String[],
                   Milk     = Float64[],
                   Milk_ERC = Float64[],
                   SCS      = Float64[],
                   SCS_ERC  = Float64[],
                   N        = Int[])
    for line in eachline(drp)
        v = split(line)
        length(v) != 6 && continue # because two lines have only 2 columns in trnn set
        id = v[1]
        y = parse.(Float64, v[2:end-1])
        n = parse(Int, v[end])
        push!(np, [id; y; n])
    end
    np
end

"""
    function read_training_20210311()
---
## For bulls
I checked the DRP files: the weights in the files are ERC’s (Effective Record
Contributions) and not reliabilities, so that does seem to be correct.

The values do look somewhat funny, because I rescaled all heritabilities to be
0.5 (details are in the document attached, which I sent last year).

With `h² = 0.5, λ =(1 - h²)/h² = (1 - 0.5)/0.5 = 1`

With a reliability of 99.0 (on a 0-100% scale), the ERC becomes:
`ERC = λ⋅rel/(1-rel) = 1 × 0.99/(1-0.99) = 99.0` !
(note that `rel` is the reliability on a 0-1 scale).

With a reliability of 98.0 (on a 0-100% scale), the ERC becomes:
`ERC = λ⋅rel/(1-rel) = 1×0.98/(1-0.98) = 49.0`

## And for cows:

With a reliability of 63.0 (on a 0-100% scale), the ERC becomes:
`ERC = λ⋅rel/(1-rel) = 1×0.63/(1-0.63) = 1.7

So, I think we need to revert to simpler deregression (as we discussed last
time!) which simply is: `DRP = EBV/rel`, after first subtracting the mean EBV.

I have attached files with DRPs computed using this simpler deregression; the
files are in the same format as before.  The weights are still ERC’s.

## Two additional points:

I think there may have been a mistake in the file with Norwegian DRPs, where I
linked IDs to the wrong data.  That should be fixed now.

The difference between the Dutch bulls and cows (at least this is what I think
we saw from one of Xijiang’s plots), may be due to a different base pertaining
to the cow and bull EBVs.  So I wonder if I should do the deregression
separately for cows and bulls.  Note that with the deregression the mean of the
DRP is removed.  Doing it separately for cows and bulls would effectively give
both the same mean.

Anyway, I’m curious to see the results with these new DRPs.

-- Mario, 2021.3
"""
function read_training_20210311()
    trn_dir = joinpath(dat_dir, "mario/20210311")
    dp = read_n_drp(joinpath(trn_dir, "dutch_DRPs.txt"))
    gp = read_g_drp(joinpath(trn_dir, "german_DRPs.txt"))
    np = read_n_drp(joinpath(trn_dir, "norway_DRPs.txt"))
    return (dp, gp, np)
end

function refresh_drp_20210311()
    @info "Read phenotypes, EBV and CV sets"
    dts, gts, nts = read_training() # ts = training set
    @save joinpath(dat_dir, "jld/drp-training-20210311.jld") {compress=true} dts gts nts
end

function refresh_norsk_drp_210408()
    @info "Read phnotypes, EBV and CV sets"
    @load "$dat_dir/jld/drp-training-2021-03-11.jld" dts gts nts
    nts = read_n_drp(joinpath(dat_dir, "mario/20210408/norway_DRPs.txt"))
    @save joinpath(dat_dir, "jld/drp-training-2021-04-08.jld") {compress=true} dts gts nts
end

"""
The results for SCS look very plausible. These results also seem to confirm that for milk, the results where the German population is involved, do not match expectations.

The only reasonable explanation that I can come up with, is that the EBV (for milk) in the different countries refer to a different base. Before the deregression I make the scale of EBV the same in all countries (by dividing by the genetic standard deviation within population). During the deregression the mean is removed within each country. This may cause inconsistencies across populations, for instance, if the Dutch population has on average higher BV than the German population (on the “true” scale). Because the German data includes cows only, perhaps subtracting the mean EBV is not really appropriate, because the mean EBV in the data may not be representative for the mean in the entire population (see also histograms below; these include EBV that were used to compute deregressed EBV).

To test: could you re-do the analyses using the attached data for Germany? The only difference, is that in this case I did not remove the mean from the EBV for milk yield (during the deregression).

This function is together with
`RD2.cv_21_04_22("drp-training-2021-04-21.jld")`
"""
function refresh_german_drp_210421()
    @info "Read phenotypes, EBV and CV sets"
    @load "$dat_dir/jld/drp-training-2021-04-08.jld" dts gts nts
    gts = read_g_drp(joinpath(dat_dir, "mario/20210421/german_DRPs.txt"))
    @save joinpath(dat_dir, "jld/drp-training-2021-04-21.jld") {compress=true} dts gts nts
end


"""
    NStream{FT,I} <: AbstractOpticalPropsArry{FT,I}

Holds extinction optical depth `tau`, `ssa`, and phase function moments `p` with leading dimension nmom.

# Fields
$(DocStringExtensions.FIELDS)
"""
struct NStream{FT,I} <: AbstractOpticalPropsArry{FT,I}
  base
  tau#::Array{FT,3}
  ssa#::Array{FT,3}
  p#::Array{FT,4}
end

"""
    delta_scale!(...)

    class(NStream), intent(inout) :: this
    real(FT), dimension(:,:,:), optional,
                                 intent(in   ) :: for_
    character(128)                             :: err_message
"""
delta_scale!(this::NStream, for_) = "delta_scale_nstr: Not yet implemented"

"""

  class(NStream), intent(in) :: this
  character(len=128)                       :: err_message

  integer :: varSizes(3)
"""
function validate!(this::NStream{FT}) where FT

  #
  # Array allocation status, sizing
  #
  varSizes =   [size(this.tau, 1), size(this.tau, 2), size(this.tau, 3)]
  if      !all([size(this.ssa, 1), size(this.ssa, 2), size(this.ssa, 3)] == varSizes) ||
          !all([size(this.p,   2), size(this.p,   3), size(this.p,   4)] == varSizes)
    error("validate: arrays not sized consistently")
  end
  #
  # Valid values
  #
  any_vals_less_than(this.tau,  FT(0)) && error("validate: tau values out of range")
  any_vals_outside(this.ssa,  FT(0), FT(1)) && error("validate: ssa values out of range")
  any_vals_outside(this.p[1,:,:,:], FT(-1), FT(1)) && error("validate: p(1,:,:,:)  = g values out of range")
end

# ------------------------------------------------------------------------------------------
#
#  Routines for array classes: subsetting of optical properties arrays along x (col) direction
#
# Allocate class, then arrays; copy. Could probably be more efficient if
#   classes used pointers internally.
#
# This set takes start position and number as scalars
#
# ------------------------------------------------------------------------------------------

"""
  class(OneScalar), intent(inout) :: full
  integer,                      intent(in   ) :: start, n
  class(AbstractOpticalPropsArry), intent(inout) :: subset
  character(128)                              :: err_message

  integer :: ncol, nlay, ngpt, nmom
"""
function subset_range!(full::OneScalar{FT}, start, n, subset) where FT
  ncol = get_ncol(full)
  nlay = get_nlay(full)
  ngpt = get_ngpt(full)
  if start < 1 || start + n-1 > get_ncol(full)
     error("optical_props%subset: Asking for columns outside range")
  end

  init!(subset, full)
  # Seems like the deallocation statements should be needed under Fortran 2003
  #   but Intel compiler doesn't run without them

  if subset isa OneScalar
      alloc!(subset, n, nlay)
  elseif subset isa TwoStream
      alloc!(subset, n, nlay)
      subset.ssa[1:n,:,:] .= FT(0)
      subset.g[1:n,:,:] .= FT(0)
  elseif subset isa NStream
      if allocated(subset.p)
        nmom = get_nmom(subset)
      else
        nmom = 1
      end
      alloc!(subset, nmom, n, nlay)
      subset.ssa[1:n,:,:] .= FT(0)
      subset.p[:,1:n,:,:] .= FT(0)
  else
    error("Uncaught case in subset_range!(full::OneScalar{FT}")
  end
  extract_subset!(ncol, nlay, ngpt, full.tau, start, start+n-1, subset.tau)

end
# ------------------------------------------------------------------------------------------

"""
  subset_range!(...)

  class(TwoStream), intent(inout) :: full
  integer,                      intent(in   ) :: start, n
  class(AbstractOpticalPropsArry), intent(inout) :: subset
  character(128)                              :: err_message

  integer :: ncol, nlay, ngpt, nmom
"""
function subset_range!(full::TwoStream{FT}, start, n, subset) where FT

  ncol = get_ncol(full)
  nlay = get_nlay(full)
  ngpt = get_ngpt(full)
  if start < 1 || start + n-1 > get_ncol(full)
     error("optical_props%subset: Asking for columns outside range")
  end

  init!(subset, full)

  if subset isa OneScalar # TODO: check logic
    alloc!(subset, n, nlay)
    extract_subset!(ncol, nlay, ngpt, full.tau, full.ssa, start, start+n-1, subset.tau)
  elseif subset isa TwoStream
    alloc!(subset, n, nlay)
    extract_subset!(ncol, nlay, ngpt, full.tau, start, start+n-1, subset.tau)
    extract_subset!(ncol, nlay, ngpt, full.ssa, start, start+n-1, subset.ssa)
    extract_subset!(ncol, nlay, ngpt, full.g  , start, start+n-1, subset.g  )
  elseif subset isa NStream
    if allocated(subset.p)
      nmom = get_nmom(subset)
    else
      nmom = 1
    end
    alloc!(subset, nmom, n, nlay)
    extract_subset!(ncol, nlay, ngpt, full.tau, start, start+n-1, subset.tau)
    extract_subset!(ncol, nlay, ngpt, full.ssa, start, start+n-1, subset.ssa)
    subset.p[1,1:n,:,:] .= full.g[start:start+n-1,:,:]
    subset.p[2:end,:, :,:] .= FT(0) # TODO Verify this line
  else
    error("Uncaught case in subset_range!(full::TwoStream{FT}")
  end
end

"""
    subset_range!(full::NStream, start, n, subset)

    class(NStream), intent(inout) :: full
    integer,                      intent(in   ) :: start, n
    class(AbstractOpticalPropsArry), intent(inout) :: subset
    character(128)                              :: err_message

    integer :: ncol, nlay, ngpt, nmom
"""
function subset_range!(full::NStream, start, n, subset)

  ncol = get_ncol(full)
  nlay = get_nlay(full)
  ngpt = get_ngpt(full)
  if(start < 1 || start + n-1 > get_ncol(full))
     error("optical_props%subset: Asking for columns outside range")
  end

  init!(subset, full)

  if subset isa OneScalar # TODO: check logic
    alloc!(subset, n, nlay)
    extract_subset!(ncol, nlay, ngpt, full.tau, full.ssa, start, start+n-1, subset.tau)
  elseif subset isa TwoStream
    alloc!(subset, n, nlay)
    extract_subset!(ncol, nlay, ngpt, full.tau, start, start+n-1, subset.tau)
    extract_subset!(ncol, nlay, ngpt, full.ssa, start, start+n-1, subset.ssa)
    subset.g[1:n,:,:] .= full.p[1,start:start+n-1,:,:]
  elseif subset isa NStream
    alloc!(subset, nmom, n, nlay)
    extract_subset!(      ncol, nlay, ngpt, full.tau, start, start+n-1, subset.tau)
    extract_subset!(      ncol, nlay, ngpt, full.ssa, start, start+n-1, subset.ssa)
    extract_subset!(nmom, ncol, nlay, ngpt, full.p  , start, start+n-1, subset.p  )
  else
    error("Uncaught case in subset_range!(full::NStream, start, n, subset)")
  end
end

"""
    class(NStream), intent(in   ) :: this
    integer                                     :: get_nmom
"""
get_nmom(this::NStream) = size(this.p, 1)

"""
    combine_and_reorder_nstr!(...)

Combine absoprtion and Rayleigh optical depths for total tau, ssa, p
using Rayleigh scattering phase function

integer, intent(in) :: ncol, nlay, ngpt, nmom
real(FT), dimension(ngpt,nlay,ncol), intent(in ) :: tau_abs, tau_rayleigh
real(FT), dimension(ncol,nlay,ngpt), intent(inout) :: tau, ssa
real(FT), dimension(ncol,nlay,ngpt,nmom),
                                     intent(inout) :: p
# -----------------------
integer :: icol, ilay, igpt, imom
real(FT) :: t
# -----------------------
"""
function combine_and_reorder_nstr!(ncol, nlay, ngpt, nmom, tau_abs, tau_rayleigh, tau, ssa, p)
  FT = eltype(tau_abs)

  for icol in 1:ncol
    for ilay in 1:nlay
      for igpt in 1:ngpt
        t = tau_abs[igpt,ilay,icol] + tau_rayleigh[igpt,ilay,icol]
        tau[icol,ilay,igpt] = t
        if (t > FT(2) * realmin(FT))
          ssa[icol,ilay,igpt] = tau_rayleigh[igpt,ilay,icol] / t
        else
          ssa[icol,ilay,igpt] = FT(0)
        end
        for imom = 1:nmom
          p[imom,icol,ilay,igpt] = FT(0)
        end
        if (nmom >= 2)
          p[2,icol,ilay,igpt] = FT(0.1)
        end
      end
    end
  end
end


@testset "EmbedOnehot" begin
    using Flux: data
    multi(x, n) = collect(Iterators.repeated(x, n))

    after_enc = [2,2,4,5,6,1,1]
    multi_after_enc = hcat(multi(after_enc, 5)...)

    e = Embed(10, 6)

    @test data(e(after_enc)) == data(hcat(map(i->e.embedding[:,i], after_enc)...))
    @test eltype(data(e(after_enc, 0.5))) == Float32

    @test size(e) == (10, 6)
    @test size(e, 1) == 10
    @test size(e, 2) == 6
end


#
println("Ha) Tests of the HighHarmonic module to calculate a high-harmonic spectrum in single-electron approximation.")
#
setDefaults("print summary: open", "zzz-HHG.sum")
grid       = JAC.Radial.Grid(true)
setDefaults("standard grid", grid::Radial.Grid; printout=true)

observable = HighHarmonic.HhgSpectrum()
approach   = HighHarmonic.HhgHydrogenicSaddlePoint()
pulse      = HighHarmonic.HhgLinearPlaneWaveLaser(2.0, intensity=3.51e16)   ## omega = 2.0 eV; intensity = 10^14 W/cm^2
timeMesh   = HighHarmonic.computeTimeMesh(2, 50)                                    ## 2 cycles with 50 time points / cycle
initialOrb = Radial.Orbital(Subshell("1s_1/2"), 0.5)
target     = HighHarmonic.TargetCloud( HighHarmonic.LocalizedTargetModel( CartesianVector(0., 0., 0.)), WeightedCartesian[])
detector   = HighHarmonic.DetectorScreen( HighHarmonic.LocalizedDetectorModel( CartesianVector(0., 0., 0.)), WeightedCartesian[])

wa = HighHarmonic.Computation( observable, approach, pulse, timeMesh, Nuclear.Model(2.0), initialOrb, target, detector)

wb = HighHarmonic.perform(wa; output=true)
setDefaults("print summary: close", "")


function discretizebranches!(system::CVSystem,old=Dict("a"=>0),restart="no")
    h = [];

    # branch grid spacing
    for i in 1:length(system.branches.ID)
        push!(system.branches.k,system.branches.lengthincm[i]*cmTom/
            (system.solverparams.JL-1));
        push!(h,system.solverparams.CFL*system.branches.k[i]/
            system.branches.c0[i][end]);
    end

    # time step guaranteed to satisfy CFL for all branches
    # system.solverparams.h = minimum(h);

    # fix time step size to couple with 3D liver model
    system.solverparams.h = 1e-4;

    if restart == "no"
        system.solverparams.numsteps = ceil(system.heart.activation.th[1]/
            system.solverparams.h);

        # allocate space for 1D domain solution variables
        for i in 1:length(system.branches.ID)
            push!(system.branches.A,
                zeros(system.solverparams.JL,system.solverparams.numsteps+1));
            push!(system.branches.Q,
                zeros(system.solverparams.JL,system.solverparams.numsteps+1));
            push!(system.branches.P,
                zeros(system.solverparams.JL,system.solverparams.numsteps+1));
            push!(system.branches.Fp,
                zeros(2*system.solverparams.JL));
            push!(system.branches.Fbarforward,
                zeros(2*system.solverparams.JL-4));
            push!(system.branches.Fbarbackward,
                zeros(2*system.solverparams.JL-4));
            push!(system.branches.Abackward,
                zeros(system.solverparams.JL-2));
            push!(system.branches.Aforward,
                zeros(system.solverparams.JL-2));
            push!(system.branches.Qbackward,
                zeros(system.solverparams.JL-2));
            push!(system.branches.Qforward,
                zeros(system.solverparams.JL-2));
            push!(system.branches.W1end,0.);
            push!(system.branches.W1,0.);
            push!(system.branches.W2,0.);
        end

        # discretize time for first cardiac cycle
        system.t = system.solverparams.h*[0:1:size(system.branches.A[1],2)-1;];
    elseif restart == "yes"
        # determine time shift
        temp = old["heart"];
        temp = temp["activation"];
        system.solverparams.tshift = old["t"][end] - sum(temp["th"][1:end-1]);

        # change grid spacing (e.g., for grid refinement study)
        JLnew = 11;

        if JLnew != system.solverparams.JL
            system.solverparams.JL = JLnew;
            for i = 1:length(system.branches.ID)
                system.branches.k[i] = system.branches.lengthincm[i]*cmTom/
                    (system.solverparams.JL-1);
                h[i] = system.solverparams.CFL*system.branches.k[i]/
                    system.branches.c0[i][end];
            end

            # fix other index ranges
            system.solverparams.acols = [1:system.solverparams.JL;];
            system.solverparams.qcols = [system.solverparams.JL+1:2*system.solverparams.JL;];
            system.solverparams.acolspre = [2:system.solverparams.JL-1;];
            system.solverparams.qcolspre = [system.solverparams.JL+2:2*system.solverparams.JL-1;];
            system.solverparams.acolscor = [1:system.solverparams.JL-2;];
            system.solverparams.qcolscor = [system.solverparams.JL-1:2*system.solverparams.JL-4;];
            system.solverparams.colsint = [2:system.solverparams.JL-1;];

            # time step guaranteed to satisfy CFL for all branches
            system.solverparams.h = minimum(h);
        end

        # update total number of time steps
        ntoadd = ceil((system.heart.activation.th[end]-
            system.solverparams.tshift)/system.solverparams.h);
        system.solverparams.numsteps=ntoadd;

        # update discrete times
        ttoadd = [0:1:ntoadd;]*system.solverparams.h + system.solverparams.tshift;
        system.t = ttoadd;

        # allocate space for 1D domain solution variables
        for i in 1:length(system.branches.ID)
            push!(system.branches.A,
                zeros(system.solverparams.JL,system.solverparams.numsteps+1));
            push!(system.branches.Q,
                zeros(system.solverparams.JL,system.solverparams.numsteps+1));
            push!(system.branches.P,
                zeros(system.solverparams.JL,system.solverparams.numsteps+1));
            push!(system.branches.Fp,
                zeros(2*system.solverparams.JL));
            push!(system.branches.Fbarforward,
                zeros(2*system.solverparams.JL-4));
            push!(system.branches.Fbarbackward,
                zeros(2*system.solverparams.JL-4));
            push!(system.branches.Abackward,
                zeros(system.solverparams.JL-2));
            push!(system.branches.Aforward,
                zeros(system.solverparams.JL-2));
            push!(system.branches.Qbackward,
                zeros(system.solverparams.JL-2));
            push!(system.branches.Qforward,
                zeros(system.solverparams.JL-2));
            push!(system.branches.W1end,0.);
            push!(system.branches.W1,0.);
            push!(system.branches.W2,0.);
        end
    end
    print("Number of nodes per branch: ")
    println(system.solverparams.JL)
    return system
end