module RK45
import Dates
import Logging
import Printf: @sprintf

#Get Butcher tableau etc from separate file (for convenience of changing if wanted)
include("dopri.jl")

function solve(f!, y0, t, dt, tmax;
               rtol=1e-6, atol=1e-10, safety=0.9, max_dt=Inf, min_dt=0, locextrap=true,
               norm=weaknorm,
               kwargs...)
    stepper = Stepper(f!, y0, t, dt,
                      rtol=rtol, atol=atol, safety=safety, max_dt=max_dt, min_dt=min_dt, locextrap=locextrap, norm=norm)
    return solve(stepper, tmax; kwargs...)
end

function solve_precon(f!, linop, y0, t, dt, tmax;
                    rtol=1e-6, atol=1e-10, safety=0.9, max_dt=Inf, min_dt=0, locextrap=true, norm=weaknorm,
                    kwargs...)
    stepper = PreconStepper(f!, linop, y0, t, dt,
                      rtol=rtol, atol=atol, safety=safety, max_dt=max_dt, min_dt=min_dt, locextrap=locextrap, norm=norm)
    return solve(stepper, tmax; kwargs...)
end

function solve(s, tmax; stepfun=donothing!, output=false, outputN=201,
                        status_period=1, repeat_limit=10)
    if output
        yout = Array{eltype(s.y)}(undef, (size(s.y)..., outputN))
        tout = range(s.t, stop=tmax, length=outputN)
        saved = 1
        yout[fill(:, ndims(s.y))..., 1] = s.y
    end

    steps = 0
    repeated = 0
    repeated_tot = 0

    Logging.@info "Starting propagation"
    start = Dates.now()
    tic = Dates.now()
    while s.tn <= tmax
        ok = step!(s)
        steps += 1
        if Dates.value(Dates.now()-tic) > 1000*status_period
            speed = s.tn/(Dates.value(Dates.now()-start)/1000)
            eta_in_s = (tmax-s.tn)/(speed)
            if eta_in_s > 356400
                Logging.@info @sprintf("Progress: %.2f %%, ETA: XX:XX:XX, stepsize %.2e, err %.2f, repeated %d",
                s.tn/tmax*100, s.dt, s.err, repeated_tot)
            else
                eta_in_ms = Dates.Millisecond(ceil(eta_in_s*1000))
                etad = Dates.DateTime(Dates.UTInstant(eta_in_ms))
                Logging.@info @sprintf("Progress: %.2f %%, ETA: %s, stepsize %.2e, err %.2f, repeated %d",
                    s.tn/tmax*100, Dates.format(etad, "HH:MM:SS"), s.dt, s.err, repeated_tot)
            end
            tic = Dates.now()
        end
        if ok
            if output
                while (saved<outputN) && tout[saved+1] < s.tn
                    ti = tout[saved+1]
                    yout[fill(:, ndims(s.y))..., saved+1] .= interpolate(s, ti)
                    saved += 1
                end
            end
            stepfun(s.yn, s.tn, s.dtn, t -> interpolate(s, t))
            repeated = 0
        else
            repeated += 1
            repeated_tot += 1
            if repeated > repeat_limit
                error("Reached limit for step repetition ($repeat_limit)")
            end
        end
    end
    Logging.@info @sprintf("Propagation finished in %.3f seconds, %d steps",
                           Dates.value(Dates.now()-start)/1000, steps)

    if output
        return collect(tout), yout, steps
    else
        return nothing
    end
end

mutable struct Stepper{T<:AbstractArray, F, nT}
    f!::F  # RHS function
    y::T  # Solution at current t
    yn::T  # Solution at t+dt
    yi::T  # Interpolant array (see interpolate())
    yerr::T  # solution error estimate (from embedded RK)
    ks::NTuple{7, T}  # k values (intermediate solutions for Runge-Kutta method)
    t::Float64  # current time (propagation variable)
    tn::Float64  # next time
    dt::Float64  # time step
    dtn::Float64  # time step for next step
    rtol::Float64  # relative tolerance on error
    atol::Float64  # absolute tolerance on error
    safety::Float64  # safety factor for stepsize control
    max_dt::Float64  # maximum value for dt (default Inf)
    min_dt::Float64  # minimum value for dt (default 0)
    locextrap::Bool  # true if using local extrapolation
    ok::Bool  # true if current step was successful
    err::Float64  # error metric to be compared to tol
    errlast::Float64  # error of the most recent successful step
    norm::nT # function to calculate error metric, defaults to RK45.weaknorm
end

function Stepper(f!, y0, t, dt;
                 rtol=1e-6, atol=1e-10, safety=0.9, max_dt=Inf, min_dt=0,
                 locextrap=true, norm=weaknorm)
    k1 = similar(y0)
    f!(k1, y0, t)
    ks = (k1, similar(k1), similar(k1), similar(k1), similar(k1), similar(k1), similar(k1))
    yerr = similar(y0)
    return Stepper(f!, copy(y0), copy(y0), similar(y0), yerr, ks,
        float(t), float(t), float(dt), float(dt),
        float(rtol), float(atol), float(safety), float(max_dt), float(min_dt),
        locextrap, false, 0.0, 0.0, norm)
end

mutable struct PreconStepper{T<:AbstractArray, F, P, nT}
    fbar!::F  # RHS callable
    prop!::P # linear propagator callable
    y::T  # Solution at current t
    yn::T  # Solution at t+dt
    yi::T  # Interpolant array (see interpolate())
    yerr::T  # solution error estimate (from embedded RK)
    ks::NTuple{7, T}  # k values (intermediate solutions for Runge-Kutta method)
    t::Float64  # current time (propagation variable)
    tn::Float64  # next time
    dt::Float64  # time step
    dtn::Float64  # time step for next step
    rtol::Float64  # relative tolerance on error
    atol::Float64  # absolute tolerance on error
    safety::Float64  # safety factor for stepsize control
    max_dt::Float64  # maximum value for dt (default Inf)
    min_dt::Float64  # minimum value for dt (default 0)
    locextrap::Bool  # true if using local extrapolation
    ok::Bool  # true if current step was successful
    err::Float64  # error metric to be compared to tol
    errlast::Float64  # error of the most recent successful step
    norm::nT  # function to calculate error metric, defaults to RK45.weaknorm
end

function PreconStepper(f!, linop, y0, t, dt;
                       rtol=1e-6, atol=1e-10, safety=0.9, max_dt=Inf, min_dt=0,
                       locextrap=true, norm=weaknorm)
    prop! = make_prop!(linop, y0)
    fbar! = make_fbar!(f!, prop!, y0)
    k1 = similar(y0)
    fbar!(k1, y0, t, t)
    ks = (k1, similar(k1), similar(k1), similar(k1), similar(k1), similar(k1), similar(k1))
    yerr = similar(y0)

    return PreconStepper(fbar!, prop!, copy(y0), copy(y0), similar(y0), yerr, ks,
        float(t), float(t), float(dt), float(dt), float(rtol), float(atol), float(safety),
        float(max_dt), float(min_dt), locextrap, false, 0.0, 0.0, norm)
end

function step!(s)
    evaluate!(s)

    if s.locextrap
        s.yn .= s.y
        for jj = 1:7
            b5[jj] == 0 || (s.yn .+= s.dt*b5[jj].*s.ks[jj])
        end
    end

    fill!(s.yerr, 0)
    for ii = 1:7
        errest[ii] == 0 || (@. s.yerr += s.dt*s.ks[ii]*errest[ii])
    end
    s.err = s.norm(s.yerr, s.y, s.yn, s.rtol, s.atol)
    s.ok = s.err <= 1
    stepcontrolPI!(s)
    if s.ok
        s.tn = s.t + s.dt
        s.ks[1] .= s.ks[end]
    else
        s.yn .= s.y
    end
    prop!_maybe(s) # propagate to new time to pass correct solution to stepfun
    return s.ok
end

function evaluate!(s::Stepper)
    # Set new time and stepsize values -- this happens at the beginning because
    # the interpolant still requires the old values after the step has finished
    s.dt = s.dtn
    s.t = s.tn
    s.y .= s.yn
    for ii = 1:6
        s.yn .= s.y
        for jj = 1:ii
            B[ii][jj] == 0 || (s.yn .+= s.dt*B[ii][jj].*s.ks[jj])
        end
        s.f!(s.ks[ii+1], s.yn, s.t+nodes[ii]*s.dt)
    end
end

function evaluate!(s::PreconStepper)
    # Set new time and stepsize values -- this happens at the beginning because
    # the interpolant still requires the old values after the step has finished
    s.y .= s.yn
    s.prop!(s.ks[1], s.t, s.tn)
    s.dt = s.dtn
    s.t = s.tn
    for ii = 1:6
        s.yn .= s.y
        for jj = 1:ii
            B[ii][jj] == 0 || (s.yn .+= s.dt*B[ii][jj].*s.ks[jj])
        end
        s.fbar!(s.ks[ii+1], s.yn, s.t, s.t+nodes[ii]*s.dt)
    end
end

prop!_maybe(s::PreconStepper) = s.prop!(s.yn, s.t, s.tn)
prop!_maybe(s) = nothing

"Interpolate solution, aka dense output."
function interpolate(s::Stepper, ti::Float64)
    if ti > s.tn
        error("Attempting to extrapolate!")
    end
    if ti == s.t
        return s.y
    elseif ti == s.tn
        return s.yn
    end
    σ = (ti - s.t)/s.dt
    σp = map(p -> σ^p, range(1, stop=4))
    b = sum(σp.*interpC, dims=1)
    fill!(s.yi, 0)
    for ii = 1:7
         s.yi .+= s.ks[ii].*b[ii]
    end
    return @. s.y + s.dt.*s.yi
end

"Interpolate solution, aka dense output."
function interpolate(s::PreconStepper, ti::Float64)
    if ti > s.tn
        error("Attempting to extrapolate!")
    end
    if ti == s.t
        return s.y
    elseif ti == s.tn
        return s.yn
    end
    σ = (ti - s.t)/s.dt
    σp = map(p -> σ^p, range(1, stop=4))
    b = sum(σp.*interpC, dims=1)
    fill!(s.yi, 0)
    for ii = 1:7
         s.yi .+= s.ks[ii].*b[ii]
    end
    out =  @. s.y + s.dt.*s.yi
    s.prop!(out, s.t, ti)
    return out
end

"Make propagator for the case of constant linear operator"
function make_prop!(linop::AbstractArray, y0)
    prop! = let linop=linop
        function prop!(y, t1, t2, bwd=false)
            if bwd
                @. y *= exp(linop*(t1-t2))
            else
                @. y *= exp(linop*(t2-t1))
            end
        end
    end
end

"Make propagator for the case of non-constant linear operator"
function make_prop!(linop!, y0)
    linop_int = similar(y0)
    lastt2 = [typemin(Float64)]
    function prop!(y, t1, t2, bwd=false)
        #= linop is always evaluated at later time, even for backward propagation
            therefore, linop is often evaluated at the same t2 twice in a row=#
        (lastt2[1] != t2) && linop!(linop_int, t2)
        lastt2[1] = t2
        dt = bwd ? (t1-t2) : (t2-t1)
        @. y *= exp(linop_int*dt)
    end
    return prop!
end

"Make closure for the pre-conditioned RHS function."
function make_fbar!(f!, prop!, y0)
    y = similar(y0)
    fbar! = let f! = f!, prop! = prop!, y=y
        function fbar!(out, ybar, t1, t2)
            y .= ybar
            prop!(y, t1, t2) # propagate to t2
            f!(out, y, t2) # evaluate RHS function
            prop!(out, t1, t2, true) # propagate back to t1
        end
    end
end

"Max-ish norm (from Dane Austin's code, no idea where he got it from)."
function maxnorm(yerr, y, yn, rtol, atol)
    maxerr = 0
    maxy = 0
    for ii in eachindex(yerr)
        maxerr = max(maxerr, abs(yerr[ii]))
        maxy = max(maxy, max(abs(y[ii]), abs(yn[ii])))
    end
    return maxerr/(atol + rtol*maxy)
end

"Alternative form of max-ish norm."
function maxnorm_ratio(yerr, y, yn, rtol, atol)
    m = 0
    for ii in eachindex(yerr)
        den = atol + rtol*max(abs(y[ii]), abs(yn[ii]))
        m = max(abs(yerr[ii])/den, m)
    end
    return m
end

"Semi-norm as used in DifferentialEquations.jl, see Hairer, Solving Ordinary Differential
Equations: Nonstiff Problems, eq. (4.11) (p.168 of the second revised edition)."
function normnorm(yerr, y, yn, rtol, atol)
    s = 0
    for ii in eachindex(yerr)
        s += abs2(yerr[ii]/(atol + rtol*max(abs(y[ii]), abs(yn[ii]))))
    end
    sqrt(s/length(yerr))
end

"'Weak' norm as used in fnfep."
function weaknorm(yerr, y, yn, rtol, atol)
    sy = 0
    syn = 0
    syerr = 0
    for ii in eachindex(yerr)
        sy += abs2(y[ii])
        syn += abs2(yn[ii])
        syerr += abs2(yerr[ii])
    end
    errwt = max(max(sqrt(sy), sqrt(syn)), atol)
    return sqrt(syerr)/rtol/errwt
end

"Simple proportional error controller, see e.g. Hairer eq. (4.13)."
function stepcontrolP!(s)
    if s.ok
        # if error is zero, there is no nonlinearity: increase step size by a lot
        s.dtn = s.err == 0 ? 1.5*s.dt : s.dt * min(5, s.safety*(s.err)^(-1/5))
    else
        if !isfinite(s.err) # check for NaN or Inf
            s.dtn = s.dt/2  # if we have one then we're in big trouble so halve the step size
        else
            s.dtn = s.dt * max(0.1, s.safety*(s.err)^(-1/5))
        end
    end
    steplims!(s)
end

"Proportional-integral error controller, aka Lund stabilisation.
See G. Söderlind and L. Wang, J. Comput. Appl. Math. 185, 225 (2006).
"
function stepcontrolPI!(s)
    β1 = 3/5 / 5
    β2 = -1/5 / 5
    ε = 0.8
    if s.ok
        s.errlast == 0 && (s.errlast = s.err) # if last error is zero, use current error instead
        if s.err == 0
            fac = 1.5 # zero error means no nonlinearity: increase step size by a lot
        else
            fac = s.safety * (ε/s.err)^β1 * (ε/s.errlast)^β2
        end
        # (0.99 <= fac <= 1.01) && (fac = 1.0)
        s.dtn = fac * s.dt
        s.errlast = s.err
    else
        if !isfinite(s.err) # check for NaN or Inf
            s.dtn = s.dt/2  # if we have one then we're in big trouble so halve the step size
        else
            s.dtn = s.dt * max(0.1, s.safety*(s.err)^(-1/5))
        end
    end
    steplims!(s)
end

"Apply user-defined limits on step size."
function steplims!(s)
    if s.dtn > s.max_dt
        s.dtn = s.max_dt
    elseif s.dtn < s.min_dt
        s.dtn = s.min_dt
        s.ok = true
    end
end

function donothing!(y, z, dz, interpolant)
end

end


module Observations

export SyntheticObservations, observation_times

using ..Utils: prettyvector

using Oceananigans
using Oceananigans: fields
using Oceananigans.Grids: AbstractGrid
using Oceananigans.Grids: cpu_face_constructor_x, cpu_face_constructor_y, cpu_face_constructor_z
using Oceananigans.Grids: pop_flat_elements, topology, halo_size, on_architecture
using Oceananigans.TimeSteppers: update_state!, reset!
using Oceananigans.Fields
using Oceananigans.Utils: SpecifiedTimes, prettytime
using Oceananigans.Architectures
using Oceananigans.Architectures: arch_array, architecture
using JLD2

import Oceananigans.Fields: set!

using ParameterEstimocean.Utils: field_name_pairs
using ParameterEstimocean.Transformations: Transformation, compute_transformation

abstract type AbstractObservation end

struct SyntheticObservations{F, R, G, T, P, M, Þ} <: AbstractObservation
    field_time_serieses :: F
    forward_map_names :: R
    grid :: G
    times :: T
    path :: P
    metadata :: M
    transformation :: Þ
end

"""
    SyntheticObservations(path=nothing;
                          field_names,
                          forward_map_names = field_names,
                          transformation = Transformation(),
                          times = nothing,
                          field_time_serieses = nothing,
                          architecture = CPU(),
                          regrid = nothing)

Return a time series of synthetic observations generated by Oceananigans.jl's simulations
gridded as Oceananigans.jl fields.
"""
function SyntheticObservations(path=nothing;
                               field_names,
                               forward_map_names = field_names,
                               transformation = Transformation(),
                               times = nothing,
                               field_time_serieses = nothing,
                               architecture = CPU(),
                               regrid = nothing)

    field_names = tupleit(field_names)
    forward_map_names = tupleit(forward_map_names)

    all(n ∈ field_names for n in forward_map_names) ||
        throw(ArgumentError("All of the forward map names $forward_map_names must be in field names $field_names"))

    if isnothing(field_time_serieses)
        raw_time_serieses = NamedTuple(name => FieldTimeSeries(path, string(name); times, architecture) for name in field_names)
    else
        raw_time_serieses = field_time_serieses
    end

    raw_grid = first(raw_time_serieses).grid
    times = first(raw_time_serieses).times
    boundary_conditions = first(raw_time_serieses).boundary_conditions

    if isnothing(regrid)
        field_time_serieses = raw_time_serieses
        grid = raw_grid

    else # Well, we're gonna regrid stuff
        if regrid isa Tuple
            grid = with_size(regrid, raw_grid)
        elseif regrid isa AbstractGrid
            grid = regrid
        else
            error("$regrid must be a Tuple specifying a new grid size, or a new grid!")
        end

        @info string("Regridding synthetic observations...", '\n',
                     "    original grid: ", summary(raw_grid), '\n',
                     "         new grid: ", summary(grid))

        field_time_serieses = Dict()

        # Re-grid the data in `field_time_serieses`
        for (field_name, ts) in zip(keys(raw_time_serieses), raw_time_serieses)

            #LX, LY, LZ = location(ts[1])
            LX, LY, LZ = infer_location(field_name)

            new_ts = FieldTimeSeries{LX, LY, LZ}(grid, times; boundary_conditions)

            # Loop over time steps to re-grid each constituent field in `field_time_series`
            for n = 1:length(times)
                regrid!(new_ts[n], ts[n])
            end

            field_time_serieses[field_name] = new_ts
        end

        field_time_serieses = NamedTuple(field_time_serieses)
    end

    # validate_data(fields, grid, times) # might be a good idea to validate the data...
    if !isnothing(path)
        file = jldopen(path)
        metadata = NamedTuple(Symbol(group) => read_group(file[group])
                              for group in filter(n -> n ∉ not_metadata_names, keys(file)))
        close(file)
    else
        metadata = nothing
    end

    transformation = field_name_pairs(transformation, forward_map_names, "transformation")
    transformation = Dict(name => compute_transformation(transformation[name], field_time_serieses[name])
                          for name in forward_map_names)

    return SyntheticObservations(field_time_serieses, forward_map_names,
                                 grid, times, path, metadata, transformation)
end

observation_names(observations::SyntheticObservations) = keys(observations.field_time_serieses)
forward_map_names(observations::SyntheticObservations) = observations.forward_map_names

function get_names(observations, name_getter)
    names = Set()
    for obs in observations
        push!(names, name_getter(obs)...)
    end

    return names
end

"""
    observation_names(observations::Vector{<:SyntheticObservations})

Return a Set representing the union of all names in `observations`.
"""
observation_names(observations::Vector{<:SyntheticObservations}) = get_names(observations, observation_names)

"""
    forward_map_names(observations::Vector{<:SyntheticObservations})

Return a Set representing the union of all names in `observations`.
"""
forward_map_names(observations::Vector{<:SyntheticObservations}) = get_names(observations, forward_map_names)

Base.summary(observations::SyntheticObservations) =
    "SyntheticObservations of $(keys(observations.field_time_serieses)) on $(summary(observations.grid))"

Base.summary(observations::Vector{<:SyntheticObservations}) =
    "Vector{<:SyntheticObservations} of $(keys(first(observations).field_time_serieses)) on $(summary(first(observations).grid))"

tupleit(t) = try
    Tuple(t)
catch
    tuple(t)
end

const not_metadata_names = ("serialized", "timeseries")

read_group(group::JLD2.Group) = NamedTuple(Symbol(subgroup) => read_group(group[subgroup]) for subgroup in keys(group))
read_group(group) = group

using Oceananigans.Grids: ZRegRectilinearGrid

function with_size(new_size, old_grid)

    old_grid isa ZRegRectilinearGrid ||
        error("Cannot remake stretched grid \n $grid \n with a new size!")

    topo = topology(old_grid)

    x = cpu_face_constructor_x(old_grid)
    y = cpu_face_constructor_y(old_grid)
    z = cpu_face_constructor_z(old_grid)

    # Remove elements of size and new_halo in Flat directions as expected by grid
    # constructor
    new_size = pop_flat_elements(new_size, topo)
    halo = pop_flat_elements(halo_size(old_grid), topo)

    new_grid = RectilinearGrid(architecture(old_grid), eltype(old_grid);
        size = new_size,
        x = x, y = y, z = z,
        topology = topo,
        halo = halo)

    return new_grid
end

location_guide = Dict(:u => (Face, Center, Center),
                      :v => (Center, Face, Center),
                      :w => (Center, Center, Face))

function infer_location(field_name)
    if field_name in keys(location_guide)
        return location_guide[field_name]
    else
        return (Center, Center, Center)
    end
end

function observation_times(data_path::String)
    file = jldopen(data_path)
    iterations = parse.(Int, keys(file["timeseries/t"]))
    times = [file["timeseries/t/$i"] for i in iterations]
    close(file)
    return times
end

observation_times(observation::SyntheticObservations) = observation.times

function observation_times(obs::Vector)
    @assert all([o.times ≈ obs[1].times for o in obs]) "Observations must have the same times."
    return observation_times(first(obs))
end

#####
##### set! for simulation models and observations
#####

"""
    column_ensemble_interior(observations::Vector{<:SyntheticObservations},
                             field_name, time_index, (Nensemble, Nbatch, Nz))

Return an `Nensemble × Nbatch × Nz` Array of `(1, 1, Nz)` `field_name` data,
given `Nbatch` `SyntheticObservations` objects. The `Nbatch × Nz` data for `field_name`
is copied `Nensemble` times to form a 3D Array.
"""
function column_ensemble_interior(observations::Vector{<:SyntheticObservations},
                                  field_name, time_index, (Nensemble, Nbatch, Nz))

    zeros_column = zeros(1, 1, Nz)
    Nt = length(first(observations).times)

    batched_data = []
    for observation in observations
        fts = observation.field_time_serieses
        if field_name in keys(fts) && time_index <= Nt
            field_column = interior(fts[field_name][time_index])
            push!(batched_data, interior(fts[field_name][time_index]))
        else
            push!(batched_data, zeros_column)
        end
    end

    # Make a Vector of 1D Array into a 3D Array
    flattened_data = cat(batched_data..., dims = 2) # (Nbatch, Nz)
    ensemble_interior = cat((flattened_data for i = 1:Nensemble)..., dims = 1) # (Nensemble, Nbatch, Nz)

    return ensemble_interior
end

function set!(model, obs::SyntheticObservations, time_index=1)
    for field_name in keys(fields(model))
        model_field = fields(model)[field_name]

        if field_name ∈ keys(obs.field_time_serieses)
            obs_field = obs.field_time_serieses[field_name][time_index]
            set!(model_field, obs_field)
        else
            fill!(parent(model_field), 0)
        end
    end

    update_state!(model)

    return nothing
end

function set!(model, observations::Vector{<:SyntheticObservations}, time_index=1)
    for field_name in keys(fields(model))
        model_field = fields(model)[field_name]
        model_field_size = size(model_field)
        Nensemble = model.grid.Nx

        observations_data = column_ensemble_interior(observations, field_name, time_index, model_field_size)

        # Reshape `observations_data` to the size of `model_field`'s interior
        reshaped_data = arch_array(architecture(model_field), reshape(observations_data, size(model_field)))

        # Sets the interior of field `model_field` to values of `reshaped_data`
        model_field .= reshaped_data
    end

    update_state!(model)

    return nothing
end

#####
##### FieldTimeSeriesCollector for collecting data while a simulation runs
#####

struct FieldTimeSeriesCollector{G, D, F}
    grid :: G
    times :: Vector{Float64}
    field_time_serieses :: D
    collected_fields :: F
    collection_times :: Vector{Float64}
end

"""
    FieldTimeSeriesCollector(collected_fields, times;
                             architecture = Architectures.architecture(first(collected_fields)))

Return a `FieldTimeSeriesCollector` for `fields` of `simulation`.
`fields` is a `NamedTuple` of `AbstractField`s that are to be collected.
"""
function FieldTimeSeriesCollector(collected_fields, times;
                                  architecture = Architectures.architecture(first(collected_fields)))

    grid = on_architecture(architecture, first(collected_fields).grid)
    field_time_serieses = Dict{Symbol, Any}()

    for field_name in keys(collected_fields)
        field = collected_fields[field_name]
        LX, LY, LZ = location(field)
        field_time_series = FieldTimeSeries{LX, LY, LZ}(grid, times)
        field_time_serieses[field_name] = field_time_series
    end

    # Convert to NamedTuple
    field_time_serieses = NamedTuple(name => field_time_serieses[name] for name in keys(collected_fields))

    collection_times = similar(times)

    return FieldTimeSeriesCollector(grid, times, field_time_serieses, collected_fields, collection_times)
end

function (collector::FieldTimeSeriesCollector)(simulation)
    for field in collector.collected_fields
        compute!(field)
    end

    current_time = simulation.model.clock.time
    time_index = findfirst(t -> t ≈ current_time, collector.times)
    if isnothing(time_index)
        @warn string("Current time ", prettytime(current_time), " not found in
                     time collector times ", prettytime.(collector.times))
        return nothing
    end

    for field_name in keys(collector.collected_fields)
        field_time_series = collector.field_time_serieses[field_name]
        if architecture(collector.grid) != architecture(simulation.model.grid)
            arch = architecture(collector.grid)
            device_collected_field_data = arch_array(arch, parent(collector.collected_fields[field_name]))
            parent(field_time_series[time_index]) .= device_collected_field_data
        else
            set!(field_time_series[time_index], collector.collected_fields[field_name])
        end
    end

    # We _have_ collected data
    collector.collection_times[time_index] = current_time

    return nothing
end

#####
##### Initializing simulations
#####

nothingfunction(simulation) = nothing

function initialize_forward_run!(simulation, observations,
                                 time_series_collector, initialize_simulation! = nothingfunction)

    reset!(simulation)

    times = observation_times(observations)
    initial_time = times[1]
    simulation.model.clock.time = initial_time

    collected_fields = time_series_collector.collected_fields
    arch = architecture(time_series_collector.grid)

    # Clear potential NaNs from timestepper data.
    # Particularly important for Adams-Bashforth timestepping scheme.
    # Oceananigans ≤ v0.71 initializes the Adams-Bashforth scheme with an Euler step by *multiplying* the tendency
    # at time-step n-1 by 0. Because 0 * NaN = NaN, this fails when the tendency at n-1 contains NaNs.
    timestepper = simulation.model.timestepper
    for field in tuple(timestepper.Gⁿ..., timestepper.G⁻...)
        if !isnothing(field)
            parent(field) .= 0
        end
    end

    # Initialize FieldTimeSeriesCollector
    time_series_collector.collection_times .= 0
    for time_series in time_series_collector.field_time_serieses
        parent(time_series) .= 0
    end

    :nan_checker ∈ keys(simulation.callbacks) && pop!(simulation.callbacks, :nan_checker)
    :data_collector ∈ keys(simulation.callbacks) && pop!(simulation.callbacks, :data_collector)
    simulation.callbacks[:data_collector] = Callback(time_series_collector, SpecifiedTimes(times...))
    simulation.stop_time = times[end]

    set!(simulation.model, observations, 1)

    initialize_simulation!(simulation)

    return nothing
end

summarize_metadata(::Nothing) = ""
summarize_metadata(metadata) = keys(metadata)

function Base.show(io::IO, obs::SyntheticObservations)
    times_str = prettyvector(prettytime.(obs.times, false))

    print(io, "SyntheticObservations with fields $(propertynames(obs.field_time_serieses))", '\n',
              "├── times: $times_str", '\n',
              "├── grid: $(summary(obs.grid))", '\n',
              "├── path: \"$(obs.path)\"", '\n',
              "├── metadata: ", summarize_metadata(obs.metadata), '\n',
              "└── transformation: $(summary(obs.transformation))")
end

end # module


# This experiment will compare the behavior of pvalue, effect size, and
# product over a wide range of screen and library designs

function compare_methods(filepath; debug=false, quiet=false)

    runs = []

    if !debug
        num_runs = 25
        levels = (10, 100, 1000)
    else
        num_runs = 1
        levels = (10)
    end

    screen_combos = (((FacsScreen, NaN), (GrowthScreen, 10), (GrowthScreen, 20)),
                    levels,
                    (CRISPRi(), CRISPRn()),
                    (Linear(), Sigmoidal()))

    for (screentype, representation, crisprtype, genetype) in IterTools.product(screen_combos...)
        screen = screentype[1]()
        screen.representation = representation
        screen.bottleneck_representation = representation
        screen.seq_depth = representation
        if screentype[1] == FacsScreen
            screen.bin_info = OrderedDict{Symbol, Tuple{Float64, Float64}}(:bin1 => (0.0, 0.25), :bin2 => (0.75, 1.0))
            max_phenotype_dists = Dict{Symbol, Tuple{Float64, Sampleable}}(
                :inactive => (0.75, Delta(0.0)),
                :negcontrol => (0.05, Delta(0.0)),
                :increasing => (0.1, TruncatedNormal(0.55, 0.2, 0.1, 1)),
                :decreasing => (0.1, TruncatedNormal(-0.55, 0.2, -1, -0.1))
            )
        else
            screen.num_bottlenecks = screentype[2]
            max_phenotype_dists = Dict{Symbol, Tuple{Float64, Sampleable}}(
                :inactive => (0.85, Delta(0.0)),
                :negcontrol => (0.05, Delta(0.0)),
                :decreasing => (0.1, TruncatedNormal(-0.55, 0.2, -1, -0.1))
            )
        end

        kd_phenotype_relationships = Dict{Symbol, Tuple{Float64, KDPhenotypeRelationship}}(
            Symbol(typeof(genetype)) => (1.0, genetype)
        )

        if typeof(crisprtype) == CRISPRn
            knockdown_dist = Dict{Symbol, Tuple{Float64, Sampleable}}(
                    :high => (0.9, Delta(1.0)),
                    :low => (0.1, TruncatedNormal(0.05, 0.07, 0, 1))
                )
        else
            knockdown_dist = Dict{Symbol, Tuple{Float64, Sampleable}}(
                :high => (0.9, TruncatedNormal(0.90, 0.1, 0, 1)),
                :low => (0.1, TruncatedNormal(0.05, 0.07, 0, 1))
            )
        end

        lib = Library(knockdown_dist, max_phenotype_dists, kd_phenotype_relationships, crisprtype)

        for i in 1:num_runs
            push!(runs, (screen, lib, i))
        end
    end

    const overlap = intersect(fieldnames(FacsScreen), fieldnames(GrowthScreen))
    # custom function for handling both growth and a facs screen in the
    # same relational datastructure
    flatten_overlap = (setup, lib) -> begin
        local results = Any[typeof(setup)]
        for name in overlap
            push!(results, getfield(setup, name))
        end
        push!(results, typeof(setup) == GrowthScreen ? getfield(setup, :num_bottlenecks) : NaN)
        push!(results, as_array(lib)...)
        results
    end

    compare_reduction_methods = (bc_counts, genes) -> begin
        sig, noi = signal(bc_counts), noise(bc_counts)

        pvalmeanprod = auprc(abs.(genes[:pvalmeanprod_bin2_div_bin1]), genes[:class], Set([:increasing, :decreasing]))[1]
        pvalue = auprc(genes[:pvalue_bin2_div_bin1], genes[:class], Set([:increasing, :decreasing]))[1]
        effectsize = auprc(genes[:absmean_bin2_div_bin1], genes[:class], Set([:increasing, :decreasing]))[1]

        (sig, noi, pvalmeanprod, pvalue, effectsize)
    end

    before = time()
    results = pmap(args -> run_exp(args[1],
                                   args[2],
                                   compare_reduction_methods;
                                   flatten_func=flatten_overlap,
                                   run_idx=args[3]), runs)
    (!quiet) && println("$(time() - before) seconds")
    results = DataFrame(permutedims(hcat(results...), [2,1]))
    new_names = [:method; :score; :screentype; overlap...; :num_bottlenecks; array_names(Library)...; :run_idx]
    hierarchy = reshape([:signal, :noise, :product, :pvalue, :effectsize], 5, 1)
    results = construct_hierarchical_label(hierarchy, results, new_names)
    CSV.write(filepath, results)
end


###################################################
## networktypes.jl
## Types representing network timings problem (NetworkData) and network timings estimates (Network Timings)
###################################################

"""
    Represents the data about the trip orig=>dest in the network
    Origin and destination are represented as (edge, weight) pairs for generality.
    If origin and destination are nodes, then the edge is just a loop from that node to that
    node, with weight 0. So a path from node 1 to node 5 will be indicated as
     (1,1,0.0) to (5,5,0.0)
"""
struct NetworkTrip
    "Origin edge and weight of that edge"
    orig::Tuple{Int,Int,Float64}
    "Destination edge and weight of that edge"
    dest::Tuple{Int,Int,Float64}
    "Travel time"
    time::Float64
    "Number of rides"
    weight::Float64
    "Boolean that identifies if trip results from road projection"
    roadProj::Bool
end
function Base.show(io::IO, t::NetworkTrip)
    if t.roadProj
        @printf(io,"(%d,%d)=>(%d,%d), w=%.1f, t=%.1fs",t.orig[1],t.orig[2],t.dest[1],t.dest[2],t.weight,t.time)
    else
        @printf(io,"%d=>%d, w=%.2f, t=%.1fs",t.orig[1],t.dest[1],t.weight,t.time)
    end
end

"""
    `NetworkData`
    Represent all data to use for timings inference in Network
"""
mutable struct NetworkData
    "The city routing network"
    network::Network
    "The trips data"
    trips::Vector{NetworkTrip}
    "lower bounds on roads timing (maximum speed)"
    minTimes::AbstractArray{Float64,2}
end

NetworkData(n::Network, trips::Vector{NetworkTrip}) = NetworkData(n, trips, maxSpeedTimes(n))

function Base.show(io::IO, n::NetworkData)
    density = 100*length(n.trips)/((nv(n.network.graph)-1)*nv(n.network.graph))
    println(io,"NetworkData: trip information in network")
    @printf(io,"%d trips (%.2f%% density)",length(n.trips), density)
end

"""
    Contains timings from anywhere to anywhere in a network
    - represents a solution to a NetworkData problem
    - for now, just corresponds to RoutingPaths object
    useful attributes:
    - `times` : link times
    - `pathTimes`: all timings
"""
const NetworkTimings = RoutingNetworks.RoutingPaths


# features.jl
#
# author: Wade Shen
# swade@ll.mit.edu
# Copyright © 2014 Massachusetts Institute of Technology, Lincoln Laboratory
# version 0.1
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
export ngrams, count, tfnorm, sparse_count, norm, znorm, ngram_iterator, ngrams!

struct NgramStringIterator
  string :: AbstractString
  order :: Int32
  truncated_start :: Bool
end
Base.iteratorsize(::Type{NgramStringIterator}) = Base.SizeUnknown()

mutable struct StringPosition
  start  :: Int32
  fin    :: Int32
  nth    :: Int32
end

function start(ngi :: NgramStringIterator)
  if ngi.truncated_start
    idx = 1
    for i = 1:(ngi.order-1)
      idx = nextind(ngi.string, idx)
    end
    return StringPosition(1, idx, ngi.order)
  else
    return StringPosition(1, 1, 1)
  end
end

done(ngi :: NgramStringIterator, position) = position.fin > endof(ngi.string)
function next(ngi :: NgramStringIterator, position)
  str = make_string(ngi.string, position.start, position.fin)
  if position.nth >= ngi.order
    position.start = nextind(ngi.string, position.start)
  end
  position.nth += 1
  position.fin  = nextind(ngi.string, position.fin)
  return str, position
end

# -------------------------------------------------------------------------------------------------------------------------
# feature extractors
# -------------------------------------------------------------------------------------------------------------------------
make_string(words :: AbstractString, b, e) = SubString(words, b, e)
make_string(words :: Array, b, e) = join(words[b:e], " ")

function ngrams(words::Array; order = 2, truncated_start = false)
  ret = AbstractString[]

  if !truncated_start
    for wi = 1:min(order - 1, length(words))
      push!(ret, make_string(words, 1, wi))
    end
  end

  for wi = order:length(words)
    push!(ret, make_string(words, wi - order + 1, wi))
  end
  return ret
end

function ngrams(words :: AbstractString; order = 2, truncated_start = false)
  ret = AbstractString[]
  return ngrams!(ret, words, order = order, truncated_start = truncated_start)
end

function ngrams!(ret :: Array, words :: AbstractString; order = 2, truncated_start = false)
  for x in ngram_iterator(words, order = order, truncated_start = truncated_start)
    push!(ret, x)
  end
  return ret
end

ngram_iterator(words :: AbstractString; order = 2, truncated_start = false) = NgramStringIterator(words, order, truncated_start)

# -------------------------------------------------------------------------------------------------------------------------
# feature vector operations
# -------------------------------------------------------------------------------------------------------------------------
function sparse_count(text, bkg)
  vec = spzeros(vocab_size(bkg), 1)
  for token in text
    vec[bkg[token]] += 1
  end
  return vec
end

function dict_count(tokens)
  map = DefaultDict{AbstractString,Int32}()
  for w in tokens
    map[w] += 1
  end
end

function znorm(vector, mean, std)
  @devec ret = (vector - mean) ./ std
  return ret
end

function norm(counts, bkg; cutoff = 0.0)
  for r in counts.rowval
    counts[r] *= bkg.stats[r]
  end

  # prune
  nn = nonzeros(counts)
  for i = 1:length(nn)
    if nn[i] < cutoff
      nn[i] = 0.0
    end
  end

  return counts
end


module FindDifferences

using Images

"""
2つの画像を見つけ出す
2つの画像は重ならない
widthを半分にして，探す
差分率が最小となる二つの矩形を探索する
"""
function find_two_images(fn_img; max_count=3)
    dn_img = dirname(fn_img)
    fn_img1 = joinpath(dn_img, "img1.png")
    fn_img2 = joinpath(dn_img, "img2.png")
    fn_img_diff = joinpath(dn_img, "img_diff.png")
    # size(img) => (height, width)
    img = load(fn_img)
    img1t = nothing
    img2t = nothing

    height_0, width_0 = size(img)
    height = height_0
    width = floor(Int, width_0 / 2)

    diff_rate_min = Inf
    count_no_update = 0

    # widthを小さくしていく
    # widthを小さくしていき，小さくしても最小値が更新されない場合はstop
    while width > 0 && count_no_update <= max_count
        @show width
        begin_idx_width_1 = 0

        while begin_idx_width_1 + width < width_0
            # img1をずらしていく begin_idx_width_1を増やしていく
            begin_idx_width_1 += 1
            end_idx_width_1 = begin_idx_width_1 + width - 1
            # end_idx_width_1 + widthが元の画像サイズを超えていたらcontinue
            if end_idx_width_1 + width > width_0; continue; end
            img1 = img[1:height, begin_idx_width_1:end_idx_width_1]

            begin_idx_width_2 = 0 + end_idx_width_1
            while begin_idx_width_2 + width < width_0
                # img2をずらしていく
                begin_idx_width_2 += 1
                end_idx_width_2 = begin_idx_width_2 + width - 1
                img2 = img[1:height, begin_idx_width_2:end_idx_width_2]
                img_diff = img1 .- img2
                rgb_zero = zero(img_diff[1])
                # 差分が存在する面積を計算する
                is_diffs::BitArray{2} = img_diff .!= rgb_zero
                # 差分率 0 ~ 1
                diff_rate = sum(is_diffs) / length(is_diffs)
                if diff_rate < diff_rate_min
                    count_no_update = 0
                    diff_rate_min = diff_rate
                    @show diff_rate_min
                    # 画像を保存する
                    Images.save(fn_img1, img1)
                    Images.save(fn_img2, img2)
                    save_diff_image(fn_img_diff, img1, img2)
                    img1t = img1
                    img2t = img2
                end
            end
        end
        width -= 1
        count_no_update += 1
    end
    return img1t, img2t
end

"""
差分があるところを分かりやすくして保存する
"""
function save_diff_image(fn_img, img1, img2)
    img_diff = img1 .- img2
    rgb_zero = zero(img_diff[1])
    rgb_red = isa(rgb_zero, RGB) ? RGB(1, 0, 0) : RGBA(1, 0, 0, 0)
    # 差分があるところを塗り替える
    idx_diff = img_diff .!= rgb_zero
    img = copy(img1)
    img[idx_diff] .= rgb_red
    Images.save(fn_img, img)
end

end # module


########################
### Filter functions ###----------------------------------------------------------------------------
########################

#' Basic Eddy Covariance Data Filtering
#'
#' Filters time series of EC data for high-quality values and specified
#'              meteorological conditions.
#'
#' - data            DataFrame or matrix containing all required input variables in
#'                        half-hourly or hourly resolution. Including year, month, day information
#' - quality_control Should quality control be applied? Defaults to `true`.
#' - filter_growseas Should data be filtered for growing season? Defaults to `false`.
#' - filter_precip   Should precipitation filtering be applied? Defaults to `false`.
#' - filter_vars     Additional variables to be filtered. Vector of type character.
#' - filter_vals_min Minimum values of the variables to be filtered. Numeric vector of
#'                        the same length than `filter_vars`. Set to `missing` to be ignored.
#' - filter_vals_max Maximum values of the variables to be filtered. Numeric vector of
#'                        the same length than `filter_vars`. Set to `missing` to be ignored.
#' - NA_as_invalid   If `true` (the default) missing data are filtered out (applies to all variables).
#' - vars_qc         Character vector indicating the variables for which quality filter should
#'                        be applied. Ignored if `quality_control = false`.
#' - quality_ext     The extension to the variables' names that marks them as
#'                        quality control variables. Ignored if `quality_control = false`.
#' - good_quality    Which values indicate good quality (i.e. not to be filtered)
#'                        in the quality control (qc) variables? Ignored if `quality_control = false`.
#' - missing_qc_as_bad If quality control variable is `missing`, should the corresponding data point be
#'                          treated as bad quality? Defaults to `true`. Ignored if `quality_control = false`.
#' - precip          Precipitation (mm time-1)
#' - GPP             Gross primary productivity (umol m-2 s-1); Ignored if `filter_growseas = false`.
#' - doy             Day of year; Ignored if `filter_growseas = false`.
#' - year            Year; Ignored if `filter_growseas = false`.
#' - tGPP            GPP threshold (fraction of 95th percentile of the GPP time series).
#'                        Must be between 0 and 1. Ignored if `filter_growseas` is `false`.
#' - ws              Window size used for GPP time series smoothing.
#'                        Ignored if `filter_growseas = false`.
#' - min_int         Minimum time interval in days for a given state of growing season.
#'                        Ignored if `filter_growseas = false`.
#' - tprecip         Precipitation threshold used to identify a precipitation event (mm).
#'                        Ignored if `filter_precip = false`.
#' - precip_hours    Number of hours removed following a precipitation event (h).
#'                        Ignored if `filter_precip = false`.
#' - records_per_hour Number of observations per hour. I_e. 2 for half-hourly data.
#' - filtered_data_to_NA Logical. If `true` (the default), all variables in the input
#'                              DataFrame/matrix are set to `missing` for the time step where ANY of the
#'                              `filter_vars` were beyond their acceptable range (as
#'                              determined by `filter_vals_min` and `filter_vals_max`).
#'                              If `false`, values are not filtered, and an additional column 'valid'
#'                              is added to the DataFrame/matrix, indicating if any value of a row
#'                              did (1) or did not fulfill the filter criteria (0).
#' - constants frac2percent - conversion between fraction and percent
#'
#' # Details
 This routine consists of two parts:
#'
#'          1) Quality control: All variables included in `vars_qc` are filtered for
#'             good quality data. For these variables a corresponding quality variable with
#'             the same name as the variable plus the extension as specified in `quality_ext`
#'             must be provided. For time steps where the value of the quality indicator is not included
#'             in the argument `good_quality`, i.e. the quality is not considered as 'good',
#'             its value is set to `missing`.
#'
#'          2) Meteorological filtering. Under certain conditions (e.g. low ustar), the assumptions
#'             of the EC method are not fulfilled. Further, some data analysis require certain meteorological
#'             conditions, such as periods without rainfall, or active vegetation (growing season, daytime).
#'             The filter applied in this second step serves to exclude time periods that do not fulfill the criteria
#'             specified in the arguments. More specifically, time periods where one of the variables is higher
#'             or lower than the specified thresholds (`filter_vals_min` and `filter_vals_max`)
#'             are set to `missing` for all variables. If a threshold is set to `missing`, it will be ignored.
#'
#' # Value
 If `filtered_data_to_NA = true` (default), the input DataFrame/matrix with
#'         observations which did not fulfill the filter criteria set to `missing`.
#'         If `filtered_data_to_NA = false`, the input DataFrame/matrix with an additional
#'         column "valid", which indicates whether all the data of a time step fulfill the
#'         filtering criteria (1) or not (0).
#'
#' # Note
#' The thresholds set with `filter_vals_min` and `filter_vals_max` filter all data
#'       that are smaller than ("<"), or greater than (">") the specified thresholds. That means
#'       if a variable has exactly the same value as the threshold, it will not be filtered. Likewise,
#'       `tprecip` filters all data that are greater than `tprecip`.
#'
#'       Variables considered of bad quality (as specified by the corresponding quality control variables)
#'       will be set to `missing` by this routine. Data that do not fulfill the filtering criteria are set to
#'       `missing` if `filtered_data_to_NA = true`. Note that with this option *all* variables of the same
#'       time step are set to `missing`. Alternatively, if `filtered_data_to_NA = false` data are not set to `missing`,
#'       and a new column "valid" is added to the DataFrame/matrix, indicating if any value of a row
#'       did (1) or did not fulfill the filter criteria (0).
#'
#'
#' ```@example; output = false
#' ```
#' # Example of data filtering; data are for a month within the growing season,
#' # hence growing season is not filtered.
#' # If filtered_data_to_NA=true, all values of a row are set to missing if one filter
#' # variable is beyond its bounds.
#' DE_Tha_Jun_2014_2 = filter_data(DE_Tha_Jun_2014,quality_control=false,
#'                                  vars_qc=c("Tair","precip","H","LE"),
#'                                  filter_growseas=false,filter_precip=true,
#'                                  filter_vars=c("Tair","PPFD","ustar"),
#'                                  filter_vals_min=c(5,200,0.2),
#'                                  filter_vals_max=c(missing,missing,missing),NA_as_invalid=true,
#'                                  quality_ext="_qc",good_quality=c(0,1),
#'                                  missing_qc_as_bad=true,GPP="GPP",doy="doy",
#'                                  year="year",tGPP=0.5,ws=15,min_int=5,precip="precip",
#'                                  tprecip=0.1,precip_hours=24,records_per_hour=2,
#'                                  filtered_data_to_NA=true)
#'
#'  ## same, but with filtered_data_to_NA=false
#'  DE_Tha_Jun_2014_3 = filter_data(DE_Tha_Jun_2014,quality_control=false,
#'                                  vars_qc=c("Tair","precip","H","LE"),
#'                                  filter_growseas=false,filter_precip=true,
#'                                  filter_vars=c("Tair","PPFD","ustar"),
#'                                  filter_vals_min=c(5,200,0.2),
#'                                  filter_vals_max=c(missing,missing,missing),NA_as_invalid=true,
#'                                  quality_ext="_qc",good_quality=c(0,1),
#'                                  missing_qc_as_bad=true,GPP="GPP",doy="doy",
#'                                  year="year",tGPP=0.5,ws=15,min_int=5,precip="precip",
#'                                  tprecip=0.1,precip_hours=24,records_per_hour=2,
#'                                  filtered_data_to_NA=false)
#'
#'  # note the additional column 'valid' in DE_Tha_Jun_2014_3.
#'  # To remove time steps marked as filtered out (i.e. 0 values in column 'valid'):
#'  DE_Tha_Jun_2014_3[DE_Tha_Jun_2014_3["valid"] == 0,] = missing
#'
#'
#' @importFrom stats aggregate
#' @export
function filter_data(data,quality_control=true,filter_growseas=false,
                        filter_precip=false,filter_vars=nothing,
                        filter_vals_min,filter_vals_max,NA_as_invalid=true,
                        vars_qc=nothing,quality_ext="_qc",good_quality=c(0,1),
                        missing_qc_as_bad=true,GPP="GPP",doy="doy",
                        year="year",tGPP=0.5,ws=15,min_int=5,precip="precip",
                        tprecip=0.01,precip_hours=24,records_per_hour=2,
                        filtered_data_to_NA=true,constants=BigleafConstants())

  ### I) Quality control filter
  if (quality_control)

    if (isnothing(vars_qc))
      stop("quality_control (qc) is true, but no qc variables are provided!")
end

    if (any(!vars_qc in colnames(data)))

      missing_vars = vars_qc[which(!vars_qc in colnames(data))]
      stop(paste("Variable ",missing_vars," is included in 'vars_qc', but does not exist in the input data!"))

end

    vars_qc_qc = paste0(vars_qc,quality_ext)
    if (any(!vars_qc_qc in colnames(data)))

      missing_vars_qc = vars_qc_qc[which(!vars_qc_qc in colnames(data))]
      missing_vars2   = substr(missing_vars_qc,1,nchar(missing_vars_qc) - nchar(quality_ext))
      stop(paste("Quality control for variable ",missing_vars2,"(",missing_vars_qc,") does not exist in the input data!"))
end

    ## data quality
    cat("Quality control:",fill=true)
    for (var in vars_qc)
      var_qc = paste0(var,quality_ext)
      check_input(data,var)
      check_input(data,var_qc)

      if (missing_qc_as_bad)
        data[get(paste0(var,quality_ext)) > max(good_quality) | ismissing(get(paste0(var,quality_ext))),var] = missing   # exclude bad quality data or those where qc flag is not available
        qc_invalid      = sum(get(paste0(var,quality_ext)) > max(good_quality) | ismissing(get(paste0(var,quality_ext)))) # count & report
else { # same, but consider missing quality flag variables as good
        data[get(paste0(var,quality_ext)) > max(good_quality) & !ismissing(get(paste0(var,quality_ext))),var] = missing
        qc_invalid      = sum(get(paste0(var,quality_ext)) > max(good_quality) & !ismissing(get(paste0(var,quality_ext))))
end

      qc_invalid_perc = round((qc_invalid/nrow(data))*constants.frac2percent,2)

      cat(var,": ",qc_invalid," data points (",qc_invalid_perc,"%) set to missing",fill=true,sep="")
end
end

  #### II) Data filter
  valid = rep(1L,nrow(data))

  # 1) GPP
  growseas_invalid = numeric()
  if(filter_growseas)
    check_input(data,doy,year,GPP)
    date             = strptime(paste0(year,"-",doy),format="%Y-%j")
    GPP_daily        = aggregate(GPP,by=list(strftime(date)),mean,na_rm=true)[,2]
    growing_season   = filter_growingseason(GPP_daily,tGPP=tGPP,ws=ws,min_int=min_int)
    growseas_invalid = which(sapply(growing_season,rep,48) == 0)
end

  # 2) precipitation
  precip_invalid = numeric()
  if (filter_precip)
    check_input(data,precip)
    if (NA_as_invalid)
      precip_events = which(precip > tprecip | ismissing(precip))
else
      precip_events = which(precip > tprecip)
end
    precip_invalid = unique(as_numeric(unlist(sapply(precip_events, function(x) x:(min(x+precip_hours*records_per_hour,nrow(data),na_rm=true))))))
end

  # 3) all other filter variables (as defined in filter_vars)
  invalids = list(growseas_invalid,precip_invalid)

  if (!isnothing(filter_vars))
    for (var in filter_vars)
      v  = which(filter_vars == var)
      vf = v + 2
      check_input(data,var)
      if (NA_as_invalid)
        invalids[[vf]] = which(get(var) < filter_vals_min[v] | get(var) > filter_vals_max[v] | ismissing(get(var)))
else
        invalids[[vf]] = which(get(var) < filter_vals_min[v] | get(var) > filter_vals_max[v] & !ismissing(get(var)))
end
end
end

  # 4) calculate number and percentage of filtered values
  invalids_perc = sapply(invalids, function(x) round((length(x)/nrow(data))*constants.frac2percent,2))

  additional_invalids = sapply(2:length(invalids), function(x)
    length(setdiff(invalids[[x]],unique(unlist(invalids[1:(x-1)])))))

  additional_invalids_perc = round(additional_invalids/nrow(data)*constants.frac2percent,2)

  # 5) write to output
  if (filter_growseas | filter_precip | length(filter_vars) > 0)

    var_names = c("growing season","precipitation",filter_vars)

    if (quality_control)
      cat("-------------------------------------------------------------------",fill=true)
end

    cat("Data filtering:",fill=true)

    cat(length(growseas_invalid)," data points (",invalids_perc[1],"%) excluded by growing season filter",fill=true,sep="")

    invisible(sapply(c(1:(length(invalids)-1)), function(x) cat(additional_invalids[x]," additional data points (",
                                                                additional_invalids_perc[x],"%) excluded by ",var_names[x+1],
                                                                " filter (",length(unlist(invalids[x+1]))," data points = ",
                                                                invalids_perc[x+1]," % in total)",fill=true,sep="")))

    invalid        = unique(unlist(invalids))
    valid[invalid] = 0

    excl_perc = round((length(invalid)/nrow(data))*constants.frac2percent,2)

    cat(length(invalid)," data points (",excl_perc,"%) excluded in total",fill=true,sep="")
    cat(nrow(data) - length(invalid)," valid data points (",constants.frac2percent-excl_perc,"%) remaining.",fill=true,sep="")

    # 6) return input data frame with filtered time steps set to missing or an additional 'valid' column
    if (filtered_data_to_NA)
      data_filtered = data
      data_filtered[valid < 1,] = missing
else
      data_filtered = DataFrame(data,valid)
end

else

    data_filtered = data

end

  return(data_filtered)
end

#' GPP-based Growing Season Filter
#'
#' Filters annual time series for growing season based on smoothed daily GPP data.
#'
#' - GPPd    daily GPP (any unit)
#' - tGPP    GPP threshold (fraction of 95th percentile of the GPP time series).
#'                Takes values between 0 and 1.
#' - ws      window size used for GPP time series smoothing
#' - min_int minimum time interval in days for a given state of growing season
#'
#' # Details
 The basic idea behind the growing season filter is that vegetation is
#'          considered to be active when its carbon uptake (GPP) is above a specified
#'          threshold, which is defined relative to the peak GPP (95th percentile)
#'          observed in the year.
#'          The GPP-threshold is calculated as:
#'
#'          ``GPP_threshold = quantile(GPPd,0.95)*tGPP``
#'
#'          GPPd time series are smoothed with a moving average to avoid fluctuations
#'          in the delineation of the growing season. The window size defaults to 15
#'          days, but depending on the ecosystem, other values can be appropriate.
#'
#'          The argument `min_int` serves to avoid short fluctuations in the
#'          status growing season vs. no growing season by defining a minimum length
#'          of the status. If a time interval shorter than `min_int` is labeled
#'          as growing season or non-growing season, it is changed to the status of
#'          the neighboring values.
#'
#' # Value
 a vector of type integer of the same length as the input GPPd in which 0 indicate
#'         no growing season (dormant season) and 1 indicate growing season.
#'
#' @importFrom stats quantile filter
#' @export
function filter_growingseason(GPPd,tGPP,ws=15,min_int=5)

  if(sum(ismissing(GPPd)) < 0.5*length(GPPd))

    growseas      = rep(1,length(GPPd))
    GPP_threshold = quantile(GPPd,probs=0.95,na_rm=true)*tGPP

    ## smooth GPP
    GPPd_smoothed = filter(GPPd,method="convolution",filter=rep(1/ws,ws))

    ## set values at the beginning and end of the time series to the mean of the original values
    wsd = floor(ws/2)
    GPPd_smoothed[1:wsd] = mean(GPPd[1:(2*wsd)],na_rm=true)
    GPPd_smoothed[(length(GPPd)-(wsd-1)):length(GPPd)] = mean(GPPd[(length(GPPd)-(2*wsd-1)):length(GPPd)],na_rm=true)

    # check for occurence of missing values and set them to mean of the values surrounding them
    missing = which(ismissing(GPPd_smoothed))
    if (length(missing) > 0)
      if (length(missing) > 10){@warn"Attention, there is a gap in 'GPPd' of length n = ",length(missing))}
      replace_val = mean(GPPd_smoothed[max(1,missing[1] - 4):min((missing[length(missing)] + 4),length(GPPd_smoothed))],na_rm=true)
      GPPd_smoothed[missing] = replace_val
end

    # filter daily GPP
    growseas[GPPd_smoothed < GPP_threshold] = 0

    ## change short intervals to the surrounding values to avoid 'wrong' fluctuations
    intervals = rle(growseas)
    short_int = which(intervals$lengths <= min_int)

    if (length(short_int) > 0)
      start = numeric()
      end   = numeric()

      for (i in 1:length(short_int))

        start[i] = sum(intervals$lengths[1:short_int[i]-1]) + 1
        end[i]   = start[i]+intervals$lengths[short_int[i]] - 1

        val = unique(growseas[start[i]:end[i]])

        if (val == 0 & growseas[start[i]-1] == 1)
          growseas[start[i]:end[i]] = 1
elseif (val == 1 & growseas[start[i]-1] == 0)
          growseas[start[i]:end[i]] = 0
end
end
end

    growseas = as_integer(growseas)

else

    @warn"number of available GPPd data is less than half the total number of days per year. Filter is not applied!")
    growseas = as_integer(rep(1,length(GPPd)))

end

  return(growseas)
end


struct NotImplementedOperation <: AbstractGroupOperation end

struct NotImplementedManifold <: AbstractManifold{ℝ} end

struct NotImplementedGroupDecorator{M} <:
       AbstractDecoratorManifold{ℝ,TransparentGroupDecoratorType}
    manifold::M
end

struct DefaultTransparencyGroup{M,A<:AbstractGroupOperation} <:
       AbstractGroupManifold{ℝ,A,DefaultGroupDecoratorType}
    manifold::M
    op::A
end


basedir = realpath(joinpath(@__DIR__, ".."))
basedir = realpath("/home/raf/.julia/dev/SpottedWingPaper")
@show basedir
floattype = Float64
# Set the input data used in human dispersal models
humanactivity = :gdp
# humanactivity = :pop

# Opimisation and validation settings
cpu_cores = :multi
# cpu_cores = :single
ngroups = 5 # should be your physical cpu cores minus 1
# groupsize = 50 # Used in the paper - for 250 replicates when ngroups == 5
groupsize = 1 # Fast - ngroups total replicates, to check the scripts

### Load data and packages ###

include(joinpath(basedir, "src", "spreadsetup.jl"))
using Optim, LossFunctions, JLD2, FileIO, DataStructures, LabelledArrays, DynamicGridsGtk

### Load common sctipt functions ###

# Main parametrisation method
function parametrise_ruleset!(optimresults, parametriser, key)
    println("\n\n==== Model: ", key, now(), " ===================================================")
    ruleset = parametriser.ruleset
    initpars = flatten(rules(ruleset))
    println(initpars)
    # Make a labelled array so we can ignore the order
    parnames = fieldnameflatten(rules(ruleset), Number)
    # Get the lower and upper bounds for params with flatten
    bnds = metaflatten(rules(ruleset), FieldMetadata.bounds, Number)
    lower = first.(bnds)
    upper = last.(bnds)
    names = fieldnameflatten(rules(ruleset), Number)
    namedpars = @LArray [initpars...] parnames
    display(DataFrame(names=[names...], pars=[initpars...], lower=[lower...], upper=[upper...]))
    # Zero params to make sure parametrizer is working
    output.running = false
    ruleset.rules = reconstruct(ruleset.rules, initpars .* 0)
    println("Running optimiser...")
    @time res = Optim.optimize(
        parametriser, [lower...], [upper...], namedpars, SAMIN(),
        Optim.Options(iterations=iterations, show_trace=true, store_trace=true)
    )
    optimresults[key] = res
    println("Saving JLD2 file")
    save("output/optimresults_$key.jld2", "optimresults", optimresults)
    println("Calculating losses...")
    optimresults
end

# Method to add results to a dataframe table
function ruleset_results!(resultdf, rulesets, parametriser, params, location, scenario=:regular)
    for key in keys(params)
        println("\n==== Model: ", key, now(), " ===================================================")
        ruleparams = params[key]
        # Set the parameters to zero, to make sure they are updated in the optimizer
        ruleset = deepcopy(rulesets[key])
        ruleset.rules = reconstruct(ruleset.rules, ruleparams .* 0)
        parametriser = @set parametriser.ruleset = ruleset
        loss = parametriser(ruleparams)
        # Standard deviation of accuracy
        std_ = std(accuracy.(Ref(Dispersal.targets(parametriser.objective)),
                             vcat(parametriser.results...)))
        row = (
            location=location,
            model=key,
            scenario=scenario,
            loss=loss,
            std=std_,
            accuracy=accuracy(Dispersal.targets(parametriser.objective), loss)
        )
        push!(resultdf, row)
    end
end
accuracy(target, loss) = one(loss) - loss/length(target)

# Plot accuracy heatmap
function lossplot(output::RegionOutput, ruleset)
    sim!(output, ruleset)
    diff = (transformfunc.(output[1]) - transformfunc.(output.objective.occurrence))
    sleep(0.5)
    println("Accuracy: $(1 - (sum(abs.(diff)) * 0.5 / length(diff)))")
    heatmap(diff; clims=(-1,1))
end

# Use ColorRegionFit in GtkOutput
function regionsim(ruleset, objective::RegionObjective,
        mask, popgrid, growthrates, tspan, carrycap; fps=20, outputtype=GtkOutput, filename="output/regionsim.gif")
    truescheme = Greyscale()
    falsescheme = reverse(ColorSchemes.Reds_3)
    truezerocolor =  (0.5, 0.5, 0.5)
    falsezerocolor = falsescheme[1]
    maskcolor =      (0.0, 1.0, 1.0)
    region_processor = ColorRegionFit(
        objective, truescheme, falsescheme,
        truezerocolor, falsezerocolor, maskcolor
    )
    gtkoutput = outputtype((population=popgrid,); filename=filename, mask=BitArray(collect(mask)), aux=(growthrates=growthrates,),
        store=true,
        tspan=tspan,
        processor=region_processor,
        minval=zero(carrycap),
        maxval=carrycap,
        fps=fps,
    )
    sim!(gtkoutput, ruleset)
    gtkoutput
end

# Sensitivity routines
function growthrate_sensitivity!(resultdf, rulesets, parametriser, params, stressors, change, selectors, location)
    output = parametriser.output
    crs_ = if output isa Output
        DynamicGrids.aux(output)[:growthrates]
    elseif output isa Vector{<:Output}
        DynamicGrids.aux(first(output))[:growthrates]
    end |> crs
    for s in stressors, c in change
        scenario = Symbol(s, :_, c)
        println(scenario)
        # Load growthrates file matching this scenario
        growthratesfilepath = joinpath(basedir, "output/sensitivity/growthrates_$(scenario).ncd")
        isfile(growthratesfilepath) || error("$growthratesfilepath not found")
        growthrates = NCDarray(growthratesfilepath; crs=crs_, dimcrs=EPSG(4326))[selectors...]  |>
            x -> setdims(x, (@set dims(x, Ti).mode.span = Regular(Month(1)))) |>
            x -> convertmode(Projected, x) |>
            x -> permutedims(x, (Lat, Lon, Ti)) |>
            x -> reverse(x; dims=Lat) |>
            x -> replace_missing(x, 0)
        # set the output aux to the new growthrates
        crs_ = if output isa Output
            @set! parametriser.output.extent.aux = (growthrates=growthrates,)
        elseif output isa Vector{<:Output}
            newoutputs = map(output) do o
                @set! o.extent.aux = (growthrates=growthrates,)
            end
            @set! parametriser.output = newoutputs
        end
        println("\n\n\n######### scenario: $scenario ########################################")
        ruleset_results!(resultdf, rulesets, parametriser, params, location, scenario)
    end
end

function param_sensitivity!(resultdf, rulesets, parametrizer, params, changekeys, change, location)
    # Rebuild all rulesets with adjusted params
    for paramkey in changekeys, c in change
        scenario = Symbol(paramkey, :_, c)
        modified_rulesets = Dict()
        for rulesetkey in keys(rulesets)
            rs = rulesets[rulesetkey]
            names = fieldnameflatten(rules(rs), Number)
            pars = NamedTuple{names}(flatten(rules(rs), Number))
            if paramkey in names
                ruleset = deepcopy(rs)
                # multiply the parameter by the amount of change
                pars = @set pars[paramkey] = pars[paramkey] * c
                # rebuild
                ruleset.rules = reconstruct(rules(ruleset), pars, Number)
                modified_rulesets[rulesetkey] = ruleset
            end
        end
        println("\n\n\n######### scenario: $scenario% ########################################")
        ruleset_results!(resultdf, modified_rulesets, parametrizer, params, location, scenario)
    end
end

function years_detected(df, years, nstates)
    occurrence = zeros(Bool, nstates, length(years))
    for y in eachindex(years), state in 1:nstates
        year = years[y]
        occurrence[state, y] = year >= df.year_detected[state]
    end
    occurrence
end

# Load US data to optimise the model:

timestep = Month(1)
us_df = CSV.read(joinpath(basedir, "data/region_year_detected_US.csv"))
us_years = Dates.year(first(us_tspan)):Dates.year(last(us_tspan))
us_nstates = round(Int, maximum(us_states))
us_occurrence = years_detected(us_df, us_years, us_nstates)

heatmap(us_occurrence; title="US occurrence", xlab="Year", ylab="State ID")

# Define model combinations for comparison

kwargs = (
    timestep=timestep,
    opt=SparseOpt(),
)
us_stochastic_rulesets = (
    full=Ruleset(us_humandisp, Chain(localdisp, allee, growth); kwargs...),
    nolocal=Ruleset(us_humandisp, Chain(allee, growth); kwargs...),
    noallee=Ruleset(us_humandisp, Chain(localdisp, growth); kwargs...),
    noclimate = Ruleset(us_humandisp, Chain(localdisp, allee, constant_growth); kwargs...),
)
null_rulesets = (
    null=Ruleset(; kwargs...),
)
null_params = (null=(),)

## Set up the optimiser

framesperstep = 12
startmonth = 5
transformfunc = x -> 2x - 1 # Transform to -1, +1 instead of 0, 1
lossfunc = ZeroOneLoss()
iterations = 1000
detectionthreshold = floattype(1e7)
threading = if cpu_cores == :multi
    ThreadedReplicates()
else
    SingleCoreReplicates()
end

us_objective = RegionObjective(
    detectionthreshold,
    parent(us_states),
    us_occurrence,
    framesperstep,
    startmonth,
)
us_aux = (growthrates=us_growthrates_zeromissing,)
us_ruleset = us_stochastic_rulesets[:full]
#us_ruleset = us_deterministic_rulesets[:nomodel]
us_output = RegionOutput((population=parent(us_populationgrid),);
    aux=us_aux,
    mask=BitArray(us_boolmask),
    tspan=us_tspan,
    objective=us_objective,
)

# rs = us_full_parametrized # If you have loaded the parametrised version
# rs = us_stochastic_rulesets[:full] # The initial version
# using DynamicGridsInteract
# InteractOutput((population=parent(us_populationgrid),);
    # ruleset=us_full_parametrized,
    # aux=us_aux,
    # mask=BitArray(us_boolmask),
    # tspan=us_tspan,
    # maxval=carrycap,
    # processor=inferno,
# ) |> display

#' ## Profile model performance
#'
#' It's good to check the everythign is running well
#' before starting a 24 hour simulation:
#'
#+

# simdata = DynamicGrids.SimData(us_output.extent, us_ruleset)
# using BenchmarkTools
# @btime sim!($us_output, $us_ruleset)
# @profiler for i = 1:10 sim!(us_output, us_ruleset; simdata=simdata) end
# isinferred(us_output, us_ruleset)

## Run the optimizer

# **WARNING** this might take a few days if there is no params file already saved

stochparamsfile = "output/stochparams_$humanactivity.jld2"
optimresultsfile = "output/optimresults_$humanactivity.jld2"
optimresults = OrderedDict()
if isfile(stochparamsfile)
    stochparams = load(stochparamsfile, "stochparams_$humanactivity")
    stochparams = load(stochparamsfile, "stochparams_$humanactivity")
    stochrulesetkeys = keys(stochparams)
    stochparamvals = values(stochparams)
else
    for key in keys(us_stochastic_rulesets)
        us_parametriser = Parametriser(
            us_stochastic_rulesets[key], us_output, us_objective, transformfunc, lossfunc, ngroups, groupsize, threading
        )
        parametrise_ruleset!(optimresults, us_parametriser, key)
        # Save as we go
        stochrulesetkeys = Tuple(keys(optimresults))
        stochparamvals = ((Optim.minimizer(optimresults[k]) for k in stochrulesetkeys)...,)
        stochparams = NamedTuple{stochrulesetkeys}(stochparamvals)
        save(optimresultsfile, "optimresults", optimresults)
        save("output/stochparams_$humanactivity.jld2", "stochparams_$humanactivity", stochparams)
    end
    optimresults
end

# Test the output:

us_full_paremetrized = reconstruct(us_stochastic_rulesets[:full], stochparams[:full])
lossplot(us_output, us_full_paremetrized)
# regionoutput = regionsim(us_full_paremetrized, us_objective, us_boolmask, us_populationgrid,
    # us_growthrates_zeromissing, us_tspan, carrycap)

# Add US results to dataframes

# Add parameters to DataFrame
allparamkeys = reduce(union, map(keys, stochparams); init=Symbol[])
colnames = [:lower, :upper, stochrulesetkeys...]
missingparams = [Any[missing for pk in allparamkeys] for rk in colnames]
paramdf = DataFrame([allparamkeys, missingparams...], [:param, colnames...])
fullbounds = metaflatten(us_stochastic_rulesets[:full].rules, FieldMetadata.bounds, Union{Real,Quantity})
fullkeys = fieldnameflatten(us_stochastic_rulesets[:full].rules, Union{Real,Quantity})
for key in stochrulesetkeys
    stochrulesetresults = stochparams[key]
    for (row, rowkey) in enumerate(allparamkeys)
        if rowkey in keys(stochparams[key])
            paramdf[key][row] = stochrulesetresults[rowkey]
        end
    end
end
# Add param bounds, using :full model
for (row, rowkey) in enumerate(allparamkeys)
    if rowkey in fullkeys
        paramdf[:lower][row], paramdf[:upper][row] = fullbounds[row]
    end
end
# Set intrinsicrate bounds from ExactLogisticGrowth model
select = paramdf.param .== :intrinsicrate
paramdf[select, :lower], paramdf[select, :upper] =
    FieldMetadata.bounds(ExactLogisticGrowth, :intrinsicrate)

# Add parameter names
stochparamnames = keys(stochparams[:full])

### Get the results in a dataframe: ###

# Loss/accuracy results dataframe
resultdf = DataFrame(location=[], model=[], scenario=[], loss=Float64[], std=Float64[], accuracy=Float64[])
us_parametriser = Parametriser(
    first(values(us_stochastic_rulesets)), us_output, us_objective, transformfunc,
    lossfunc, ngroups, groupsize, threading
)
us_null_parametriser = Parametriser(
    first(values(null_rulesets)), us_output, us_objective, transformfunc,
    lossfunc, ngroups, groupsize, threading
)
us_location = :US

# Get the results for all stochastic rulsets, and the null rulesets:

ruleset_results!(resultdf, us_stochastic_rulesets, us_parametriser, stochparams, us_location)
ruleset_results!(resultdf, null_rulesets, us_null_parametriser, null_params, us_location)

# Show the output in the plot pane:

display(paramdf)
display(resultdf)
showtable(resultdf)

stressors = (:heatstress, :coldstress, :wiltstress, :wetstress)
paramnames = (:human_exponent, :dist_exponent, :dispersalperpop, :max_dispersers)
change = 80, 120
selectors = us
growthrate_sensitivity!(resultdf, us_stochastic_rulesets, us_parametriser, stochparams, stressors, change, selectors, us_location)
param_sensitivity!(resultdf, us_stochastic_rulesets, us_parametriser, stochparams, paramnames, change, us_location)
showtable(resultdf)

# Load data for validation against the EU

eu_stochastic_rulesets = (
    full=Ruleset(eu_humandisp, Chain(localdisp, allee, growth); kwargs...),
    nolocal=Ruleset(eu_humandisp, Chain(allee, growth); kwargs...),
    noallee=Ruleset(eu_humandisp, Chain(localdisp, growth); kwargs...),
    noclimate = Ruleset(eu_humandisp, Chain(localdisp, allee, constant_growth); kwargs...)
)
eu_rulesets = map((r, p) -> reconstruct(r, p, Number), eu_stochastic_rulesets, stochparams)
eu_df = CSV.read(joinpath(basedir, "data/region_year_detected_EU.csv"))
eu_years = Dates.year(first(eu_tspan)):Dates.year(last(eu_tspan))
eu_occurrence = years_detected(eu_df, eu_years, maximum(eu_states))
eu_objective = RegionObjective(detectionthreshold, eu_states, eu_occurrence, framesperstep, startmonth)
eu_aux = (growthrates=eu_growthrates_zeromissing,)
eu_init = (population=eu_populationgrid,)
eu_output = RegionOutput(eu_init;
    aux=eu_aux,
    mask=eu_boolmask,
    tspan=eu_tspan,
    objective=eu_objective,
)
eu_parametriser = Parametriser(
    first(values(eu_rulesets)), eu_output, eu_objective,
    transformfunc, lossfunc, ngroups, groupsize, threading
)
eu_null_parametriser = Parametriser(
    first(values(null_rulesets)), eu_output, eu_objective, transformfunc,
    lossfunc, ngroups, groupsize, threading
)
eu_location = :EU

# Test output

heatmap(eu_occurrence; title="EU occurrence", xlab="Year", ylab="State ID")
eu_output.extent.init.population |> plot
lossplot(eu_output, null_rulesets[:null])
savefig("output/eu_null_loss.png")

eu_full = reconstruct(eu_stochastic_rulesets[:full], stochparams[:full])
lossplot(eu_output, eu_full)
savefig("output/eu_full_loss.png")
# regionoutput = regionsim(eu_full, eu_objective, eu_boolmask, eu_populationgrid,
          # eu_growthrates_zeromissing, eu_tspan, carrycap; fps=10)#, outputtype=GifOutput, filename="eu_gdp.gif")

### Validate US/EU ###

selectors = eu
ruleset_results!(resultdf, null_rulesets, eu_null_parametriser, null_params, eu_location)
ruleset_results!(resultdf, eu_stochastic_rulesets, eu_parametriser, stochparams, eu_location)
growthrate_sensitivity!(resultdf, eu_stochastic_rulesets, eu_parametriser, stochparams, stressors, change, selectors, eu_location)
param_sensitivity!(resultdf, eu_stochastic_rulesets, eu_parametriser, stochparams, paramnames, change, eu_location)
display(resultdf)
@save "output/resultdf_$(humanactivity).jld2" resultdf
CSV.write("output/sensitivity_$(humanactivity).csv", resultdf)
CSV.write("output/params_$(humanactivity).csv", paramdf)

### NoHuman model ###

# This needs to be separated out so that we can
# optimise the no-human model with a free λ parameter.

println("==== Running nohuman model ==============================================")

λ = floattype(0.0125)
radius = 6

@time hood = DispersalKernel{radius}(
    formulation=ExponentialKernel(λ),
    distancemethod=AreaToArea(30),
    cellsize=floattype(1.0)
)

free_localdisp = InwardsPopulationDispersal{:population,:population}(hood)
log.(hood.kernel) |> heatmap

nohuman = Ruleset(Chain(free_localdisp, allee, growth); kwargs...)
nohuman_rulesets = (nohuman=nohuman,)
# Parametrise λ - it's now a general spread model, not local movement
@flattenable @bounds ExponentialKernel begin
    λ | true | (0.0, 100.0)
end

# This model is deteministic so we don't need replicates
ngroups = 1
groupsize = 1
threading = SingleCoreReplicates()
us_nohuman_parametriser = Parametriser(
    nohuman, us_output, us_objective, transformfunc, lossfunc, ngroups, groupsize, threading
)
eu_nohuman_parametriser = Parametriser(
    nohuman, eu_output, eu_objective, transformfunc, lossfunc, ngroups, groupsize, threading
)

# Parametrise unless an output is already saved
nohumanfile = joinpath(basedir, "output/params_$(humanactivity)_nohuman.jld2")
if isfile(nohumanfile)
    nohuman_params = load(nohumanfile, "nohuman_params")
    nohuman_paramvals = values(nohuman_params)
else
    parametrise_ruleset!(optimresults, us_nohuman_parametriser, :nohuman)
    nohuman_rulesetkeys = (:nohuman,)
    nohuman_paramvals = Optim.minimizer(optimresults[:nohuman])
    nohuman_params = NamedTuple{(:nohuman,)}((nohuman_paramvals,))
end

parametrized_nohuman = reconstruct(nohuman, nohuman_paramvals, Number)
lossplot(us_output, parametrized_nohuman)
# regionoutput = regionsim(
    # parametrized_nohuman, us_objective, us_boolmask, us_populationgrid,
    # us_growthrates_zeromissing, us_tspan, carrycap;
    #outputtype=GifOutput, filename="output/us_nohuman_regionsim.gif", fps=10,
# )
lossplot(eu_output, nohuman)
# regionoutput = regionsim(
    # parametrized_nohuman, eu_objective, eu_boolmask, eu_populationgrid,
    # eu_growthrates_zeromissing, eu_tspan, carrycap;
    #outputtype=GifOutput, filename="output/eu_nohuman_regionsim.gif", fps=10,
# )

# Regular results
ruleset_results!(resultdf, nohuman_rulesets, us_nohuman_parametriser, nohuman_params, us_location)
ruleset_results!(resultdf, nohuman_rulesets, eu_nohuman_parametriser, nohuman_params, eu_location)
# Growth rate sensitivity
growthrate_sensitivity!(resultdf, nohuman_rulesets, us_nohuman_parametriser, nohuman_params, stressors, change, selectors, us_location)
growthrate_sensitivity!(resultdf, nohuman_rulesets, eu_nohuman_parametriser, nohuman_params, stressors, change, selectors, eu_location)
# Dispersal parameter sensitivity
nohuman_paramnames = keys(nohuman_params[:nohuman])
param_sensitivity!(resultdf, nohuman_rulesets, us_nohuman_parametriser, nohuman_params, nohuman_paramnames, change, us_location)
param_sensitivity!(resultdf, nohuman_rulesets, eu_nohuman_parametriser, nohuman_params, nohuman_paramnames, change, eu_location)

nohumancol = deepcopy(paramdf.full) .= missing
insert!(paramdf, 8, nohumancol, :nohuman)
select = paramdf.param .== :minfounders
paramdf[select, :nohuman] = nohuman_params[1].minfounders
newrow = [:λ, 0.0, 100.0, missing, missing, missing, missing, nohuman_params[1].λ]
push!(paramdf, newrow)
showtable(paramdf)
showtable(resultdf)
display(paramdf)
display(resultdf)

# Save results as a csv file

@save "output/params_$(humanactivity)_nohuman.jld2" nohuman_params
CSV.write(joinpath(basedir, "output/sensitivity_$(humanactivity)_nohuman.csv"), resultdf)
CSV.write(joinpath(basedir, "output/params_$(humanactivity)_nohuman.csv"), paramdf)


searchdir(path, key) = filter(x -> occursin(key, x), readdir(path))
checkpoints = searchdir(pwd(), filename_1 * "_checkpoint_iteration")
if length(checkpoints) > 0
    checkpointed = true
    checkpoint_filepath = joinpath(pwd(), checkpoints[end])
    @info "Restoring from checkpoint: $checkpoint_filepath"
    model = restore_from_checkpoint(checkpoint_filepath, boundary_conditions = bcs, forcing = forcings, advection = advection_scheme)
else
    checkpointed = false
	model = IncompressibleModel(
	           architecture = arch,
	             float_type = FT,
	                   grid = grid,
	               coriolis = coriolis,
	               buoyancy = buoyancy,
	                closure = closure,
	                tracers = (:b,),
        boundary_conditions = bcs,
                    forcing = forcings,
                   advection = advection_scheme,
                   timestepper = timestepping_scheme,
	)
end

if !checkpointed
    if !geostrophic_balance
        set!(model, b=B₀)
    else
        set!(model, u = U₀, b=B₀)
    end
end

if !checkpointed
	Δt= 120.0
else
	Δt = 300.0
end


include("../imports.jl")

@testset ExtendedTestSet "`ProjectiveTransforms`" begin
    @testset ExtendedTestSet "image" begin
        encoding = ProjectiveTransforms((32, 32))
        image = rand(RGB, 64, 96)
        block = FastAI.Image{2}()

        ## We run `ProjectiveTransforms` in the different [`Context`]s:
        imagetrain = encode(encoding, Training(), block, image)
        @test size(imagetrain) == (32, 32)

        imagevalid = encode(encoding, Validation(), block, image)
        @test size(imagevalid) == (32, 32)

        imageinference = encode(encoding, Inference(), block, image)
        @test size(imageinference) == (32, 48)

        ## During inference, the aspect ratio should stay the same
        @test size(image, 1) / size(image, 2) == size(imageinference, 1) / size(imageinference, 2)
    end

    @testset ExtendedTestSet "keypoints" begin
        encoding = ProjectiveTransforms((32, 48))
        ks = [SVector(0., 0), SVector(64, 96)]
        block = FastAI.Keypoints{2}(10)
        bounds = DataAugmentation.Bounds((1:32, 1:48))
        r = DataAugmentation.getrandstate(encoding.tfms[Training()])
        kstrain = encode(encoding, Training(), block, ks; state = (bounds, r))
        ksvalid = encode(encoding, Validation(), block, ks; state = (bounds, r))
        ksinference = encode(encoding, Inference(), block, ks; state = (bounds, r))

        @test kstrain == ksvalid == ksinference
    end

    @testset ExtendedTestSet "image and keypoints" begin
        encoding = ProjectiveTransforms((32, 32))
        image = rand(RGB, 64, 96)
        ks = [SVector(0., 0), SVector(64, 96)]
        blocks = (FastAI.Image{2}(), FastAI.Keypoints{2}(10))

        @test_nowarn encode(encoding, Training(), blocks, (image, ks))
        @test_nowarn encode(encoding, Validation(), blocks, (image, ks))
        @test_nowarn encode(encoding, Inference(), blocks, (image, ks))
    end

    #= depends on buffered interface
    @testset ExtendedTestSet "`run!`" begin
        encoding = ProjectiveTransforms((32, 32))
        image1 = rand(RGB, 64, 96)
        image2 = rand(RGB, 64, 96)
        buf = encode(encoding, Validation(), image1)
        cbuf = copy(buf)
        encode!(buf, encoding, Validation(), image1)
        # run and run! should return the same result
        @test buf ≈ cbuf

        encode!(buf, encoding, Validation(), image2)
        # buf should be modified on different input
        @test !(buf ≈ cbuf)
    end
    =#
end


module TestExamples1DEulerGravity

using Test
using Trixi

include("test_trixi.jl")

# pathof(Trixi) returns /path/to/Trixi/src/Trixi.jl, dirname gives the parent directory
EXAMPLES_DIR = joinpath(pathof(Trixi) |> dirname |> dirname, "examples", "1d")

@testset "Compressible Euler with self-gravity" begin
  @trixi_testset "elixir_eulergravity_eoc_test.jl" begin
    @test_trixi_include(joinpath(EXAMPLES_DIR, "elixir_eulergravity_eoc_test.jl"),
      l2   = [0.0002170799126638106, 0.0002913792848717502, 0.0006112320856262327],
      linf = [0.0004977401033188222, 0.0013594223337776157, 0.002041891084400227])
  end
end

end # module


cache(args...) = joinpath(@__DIR__, "..", "cache", args...)

"""
    get_id(x)

Get unique id of arbitrary struct `x`. Works by serializing the struct and computing the
SHA256 checksum of the serialization.
"""
function get_id(x)
    buff = IOBuffer()
    serialize(buff, x)
    id = bytes2hex(sha256(buff.data))
end

"""
    reference(H; force_recompute=false) -> (E0, reference_vector)

Get the exact ground-state energy a wave function of Hamiltonian `H`. Values are cached to
`Sekira/cache`.
"""
function reference(H; force_recompute=false)
    !isdir(cache()) && mkpath(cache())

    Hs = Rimu.Hamiltonians
    id = get_id(H)
    if !force_recompute && isfile(cache("$id.bson"))
        @mpi_root @info "Reference found."
        ref = RimuIO.load_dvec(cache("$id.bson"))
        E0 = read(cache("$id.energy"), Float64)
    else
        @mpi_root @info "Computing reference."
        dv = DVec(starting_address(H) => 1.0)
        ishermitian = Hs.LOStructure(H) == Hs.Hermitian()
        issymmetric = ishermitian && eltype(H) <: Real
        vals, vecs, info = eigsolve(H, dv, 1, :SR; issymmetric, ishermitian)
        ref = vecs[1]
        E0 = vals[1]
        @assert info.converged ≥ 1

        RimuIO.save_dvec(cache("$id.bson"), ref)
        write(cache("$id.energy"), E0)
    end
    return E0, ref
end

function deterministic_reference(H)
    ref = MPIData(DVec(starting_address(H) => 1.0, style=IsDeterministic()))
    r_strat = ReportToFile(
        chunk_size=100, save_if=is_mpi_root(), io=stderr, filename="ref.arrow"
    )
    lomc!(H, ref; laststep=10_000, r_strat)

    RimuIO.save_dvec("ref.bson", ref)

end


#
# This file is part of module
#   ModiaMedia (ModiaMedia/src/ModiaMedia.jl)
#

"""
    data = SimpleMediumData(;cp_const=nothing, cv_const=nothing, d_const=nothing, eta_const=nothing,
                             lambda_const=nothing, a_const=nothing, T0=nothing, MM_const=nothing)

Generate a `SimpleMediumData` object containing the data
for a SimpleMedium medium.
"""
mutable struct SimpleMediumData
    cp_const::Float64       # "Constant specific heat capacity at constant pressure";
    cv_const::Float64       # "Constant specific heat capacity at constant volume";
    d_const::Float64        # "Constant density";
    eta_const::Float64      # "Constant dynamic viscosity";
    lambda_const::Float64   # "Constant thermal conductivity";
    a_const::Float64        # "Constant velocity of sound";
    T_min::Float64          # Minimum temperature valid for medium model
    T_max::Float64          # Maximum temperature valid for medium model
    T0::Float64             # "Zero enthalpy temperature";
    MM_const                # "Molar mass";

    SimpleMediumData(;cp_const=nothing, cv_const=nothing, d_const=nothing, eta_const=nothing,
                      lambda_const=nothing, a_const=nothing, T_min=nothing, T_max=nothing,
                      T0=nothing, MM_const=nothing) =
         new(cp_const, cv_const, d_const, eta_const, lambda_const, a_const, T_min, T_max, T0, MM_const)
end

"""
    medium = SimpleMedium(; mediumName     = nothing,
                            reference_p    = 101325.0,
                            reference_T    = 298.15,
                            p_default      = 101325.0,
                            T_default      = 293.15,
                            fluidConstants = nothing,
                            data           = nothing)

Generate a `SimpleMedium <: PureSubstance` medium object.
"""
mutable struct SimpleMedium <: PureSubstance
    infos::FluidInfos
    fluidConstants::SVector{1,BasicFluidConstants}
    fluidLimits::FluidLimits
    data::SimpleMediumData
end

"""
    state = SimpleMediumState(Medium, p, T)

Generate a `SimpleMediumState <: ThermodynamicState` object containing
pressure `p` [Pa] and temperature `T` [K] as thermodynamic states.
"""
mutable struct SimpleMediumState <: ThermodynamicState
    Medium::SimpleMedium
    p::Float64
    T::Float64
end

function SimpleMedium(; mediumName=nothing,
                        reference_p=101325.0,
                        reference_T=298.15,
                        p_default=101325.0,
                        T_default=293.15,
                        fluidConstants=nothing,
                        data=nothing)

    infos = FluidInfos(mediumName           = mediumName,
                       substanceNames       = [mediumName],
                       extraPropertiesNames = fill("",0),
                       ThermoStates         = IndependentVariables_pT,
                       singleState          = true,
                       reducedX             = true,
                       fixedX               = false,
                       reference_p          = reference_p,
                       reference_T          = reference_T,
                       reference_X          = fill(1.0,1),
                       p_default            = p_default,
                       T_default            = T_default)

    fluidLimits = FluidLimits(TMIN = data.T_min,
                              TMAX = data.T_max)

    Medium = SimpleMedium(infos, fill(fluidConstants,1), fluidLimits, data)

    infos.h_default  = specificEnthalpy(data, SimpleMediumState(Medium,p_default,T_default))
    fluidLimits.HMIN = specificEnthalpy(data, SimpleMediumState(Medium,p_default,data.T_min))
    fluidLimits.HMAX = specificEnthalpy(data, SimpleMediumState(Medium,p_default,data.T_max))

    return Medium
end

setState_pTX(m::SimpleMedium,p,T,X) = SimpleMediumState(m,p,T)
setState_phX(m::SimpleMedium,p,h,X) = SimpleMediumState(m,p,m.data.T0+h/m.data.cp_const)
setState_psX(m::SimpleMedium,p,s,X) = SimpleMediumState(m,p,exp(s/m.data.cp_const + log(m.infos.reference_T)))
setState_dTX(m::SimpleMedium,d,T,X) = error("From setState_dTX: Pressure cannot be computed from temperature and density for the incompressible fluid $(m.infos.mediumName)!")
isenthalpicState(m::SimpleMedium, state::SimpleMediumState, dp::Float64) = SimpleMediumState(m,state.p+dp, state.T)

setState_pTX!(state::SimpleMediumState,p,T,X) = begin state.p=p; state.T=T; nothing end
setState_phX!(state::SimpleMediumState,p,h,X) = begin state.p=p; state.T=state.Medium.data.T0+h/state.Medium.data.cp_const; nothing end
setState_psX!(state::SimpleMediumState,p,s,X) = begin state.p=p; state.T=exp(s/state.Medium.data.cp_const + log(state.Medium.infos.reference_T)); nothing end
setState_dTX!(state::SimpleMediumState,d,T,X) = error("From setState_dTX!: Pressure cannot be computed from temperature and density for the incompressible fluid $(state.Mediumm.infos.mediumName)!")
isenthalpicState!(state_b::SimpleMediumState, state_a::SimpleMediumState, dp::Float64) = begin state_b.p = state_a.p+dp; state_b.T = state_a.T; nothing end

specificEnthalpy(data::SimpleMediumData, state::SimpleMediumState)::Float64 = data.cp_const*(state.T - data.T0)
pressure(               m::SimpleMedium, state::SimpleMediumState)::Float64 = state.p
temperature(            m::SimpleMedium, state::SimpleMediumState)::Float64 = state.T
density(                m::SimpleMedium, state::SimpleMediumState)::Float64 = m.data.d_const
specificEnthalpy(       m::SimpleMedium, state::SimpleMediumState)::Float64 = specificEnthalpy(m.data,state)
specificInternalEnergy( m::SimpleMedium, state::SimpleMediumState)::Float64 = m.data.cv_const*(state.T - m.data.T0)
specificHeatCapacityCp( m::SimpleMedium, state::SimpleMediumState)::Float64 = m.data.cp_const
dynamicViscosity(       m::SimpleMedium, state::SimpleMediumState)::Float64 = m.data.eta_const

specificEnthalpy_T(m::SimpleMedium, T)::Float64 = m.data.cp_const*(T - m.data.T0)

### Functions for mass and energy balance

density(      m::SimpleMedium)::Float64 = m.data.d_const
density_der_1(m::SimpleMedium)::Float64 = 0.0

specificInternalEnergy_T(      m::SimpleMedium,T)::Float64 = m.data.cv_const*(T - m.data.T0)
specificInternalEnergy_T_der_1(m::SimpleMedium,T)::Float64 = 0.0
specificInternalEnergy_T_der_2(m::SimpleMedium,T)::Float64 = m.data.cv_const

function standardCharacteristics(m::SimpleMedium)::Dict{AbstractString,Any}
    p = m.infos.reference_p
    T = collect( range(m.fluidLimits.TMIN, stop=m.fluidLimits.TMAX, length=101) )
    h = zeros(length(T))
    u = zeros(length(T))
    state = setState_pT(m,p,T[1])

    for i in 1:length(T)
        setState_pT!(state,p,T[i])
        h[i] = specificEnthalpy(state)
        u[i] = specificInternalEnergy(state)
    end

    mediumDict = Dict{AbstractString,Any}()
    mediumDict["T"]   = uconvert.(u"°C", T*1u"K")
    mediumDict["h"]   = h*u"J/kg"
    mediumDict["u"]   = u*u"J/kg"
    mediumDict["d"]   = to_DensityDisplayUnit(density(state))*1u"g/cm^3"

    return mediumDict
end

function standardPlot(m::SimpleMedium; figure=1)
    mediumDict = standardCharacteristics(m)
    ModiaMath.plot(mediumDict, [("h", "u"), "d"], xAxis="T", heading=m.infos.mediumName, figure=figure)
end


@testset "Dual Type" begin
    model = JuMP.Model()
    x = @variable(model, [1:2])
    @constraint(model, sum(x) == 1)
    h = hrep(model)
    p = polyhedron(h)
    @test p isa Polyhedra.DefaultPolyhedron{Float64, LPHRep{Float64}, Polyhedra.Hull{Float64, Vector{Float64}, Int}}
    h = hrep(zeros(Int, 2, 2), zeros(Int, 2))
    p = polyhedron(h)
    @test p isa Polyhedra.DefaultPolyhedron{Rational{BigInt}, MixedMatHRep{Rational{BigInt}, Matrix{Rational{BigInt}}}, MixedMatVRep{Rational{BigInt}, Matrix{Rational{BigInt}}}}
    h = hrep(spzeros(2, 2), zeros(2))
    p = polyhedron(h)
    @test p isa Polyhedra.DefaultPolyhedron{Float64, MixedMatHRep{Float64, SparseMatrixCSC{Float64, Int}}, MixedMatVRep{Float64, Matrix{Float64}}}
    v = vrep(zeros(2, 3))
    p = polyhedron(v)
    @test p isa Polyhedra.DefaultPolyhedron{Float64, MixedMatHRep{Float64, Matrix{Float64}}, MixedMatVRep{Float64, Matrix{Float64}}}
    v = vrep(spzeros(2, 3))
    p = polyhedron(v)
    @test p isa Polyhedra.DefaultPolyhedron{Float64, MixedMatHRep{Float64, Matrix{Float64}}, MixedMatVRep{Float64, SparseMatrixCSC{Float64, Int}}}
end

struct BadPoly{T} <: Polyhedra.Polyhedron{T}
end

@testset "Unimplemented methods" begin
    p = BadPoly{Int}()
    @test_throws ErrorException detectvlinearity!(p)
    @test_throws ErrorException detecthlinearity!(p)
    @test_throws ErrorException eliminate(p, [1], FourierMotzkin())
    @test_throws ErrorException eliminate(p, [1], BlockElimination())
    @test_throws ErrorException hrep(p)
    @test_throws ErrorException vrep(p)
    @test_throws ErrorException loadpolyhedron!(p, "a", "b")
    @test_throws ErrorException loadpolyhedron!(p, "a", "ine")
    @test_throws ErrorException loadpolyhedron!(p, "a", "ext")
end

@testset "Polyhedra.DefaultPolyhedron constructor with nothing" begin
    vr = convexhull([-1, 0], [0, -1]) + conichull([1, 1], [-1, 1])
    hr = HalfSpace([-1, -1], 1) ∩ HalfSpace([1, -1], 1)
    p = Polyhedra.DefaultPolyhedron{Int, typeof(hr), typeof(vr)}(hr, nothing, lp_solver)
    @test hrep(p) === hr
    @test !vrepiscomputed(p)
    @test p.solver === lp_solver
    p = Polyhedra.DefaultPolyhedron{Int, typeof(hr), typeof(vr)}(nothing, vr, lp_solver)
    @test !hrepiscomputed(p)
    @test vrep(p) === vr
    @test p.solver === lp_solver
end


using Pkg
Pkg.activate(".")
Pkg.instantiate()

using ScoreDrivenERGM
using LightGraphs

using Libdl
using RCall
R""" library("ergm") """

ergmC = Libdl.dlopen("C:\\Users\\digan\\Documents\\R\\win-library\\4.0\\ergm\\libs\\x64\\ergm")

# define test matrix
N = 100
A = rand(Bool,N,N)

g = SimpleDiGraph(A)

edgeList = collect(edges(g))
tails = getproperty.(edgeList, :src)
heads = getproperty.(edgeList, :dst)
dnedges = ne(g)
dflag = Int(is_directed(g))

# try to understand what is wl input
@rput A
R" net <- network(A)"
R"to_ergm_Cdouble(net)"

# store the sufficient statistics and change statistics in R
R"""
    net <- network(A)
    chStat_t <- ergmMPLE(formula_ergm)
    changeStats_t_R <- cbind(chStat_t$response, chStat_t$predictor,     chStat_t$weights)
        """

# create julia variables (Refs ) that can be passed to MPLE_wrapper fun

# test MPLE_wrapper function
tailsIn = Ref(tails)
headsIn = Ref(heads)
ccall(:GetRNGstate, Int32)

# MPLE_wrapper(int *tails, int *heads, int *dnedges,
# 		  double *wl,
# 		  int *dn, int *dflag, int *bipartite, int *nterms,
# 		  char **funnames, char **sonames, double *inputs,
# 		  int *responsevec, double *covmat,
# 		  int *weightsvector,
# 		  int *maxDyads, int *maxDyadTypes)

# ABANDONING THE IDEA BECAUSE IT WOULD REQUIRE TOO MUCH WORK FOR THE MOMENT