# MIT License

# Copyright (c) 2021 Dr. William A. Pisani

# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:

# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.
"""
    impropers(bonds::Array{Array{Int64,N} where N,1}) -> Array{NTuple{4,Int64},1}

Determines the impropers of a molecule or molecular system given the bonds.
"""
function impropers(bonds::Array{Array{Int64,N} where N,1})
    println("Determining impropers...")
    count_atomid1s = countmap(atomid[1] for atomid in bonds)
    count_atomid2s = countmap(atomid[2] for atomid in bonds)
    count_atomids = mergewith(+,count_atomid1s,count_atomid2s)

    # Get atomids with 3 or more bonds, those atoms have impropers
    atomids = [key for (key,value) in count_atomids if value >= 3]

    improper_array = Tuple{Int64,Int64,Int64,Int64}[]

    # Find atom ids connected to improper atoms
    for atomid in atomids
        atomid_connections = []
        for bond in bonds
            if atomid == bond[1]
                push!(atomid_connections,bond[2])
            elseif atomid == bond[2]
                push!(atomid_connections,bond[1])
            end
        end

        # Now that connections are found, get combinations of impropers
        if length(atomid_connections) == 3 # If only three bonds
            imp = (atomid_connections[1],atomid,atomid_connections[2],atomid_connections[3])
            push!(improper_array,imp)

        elseif length(atomid_connections) == 4 # If four bonds
            imp = (atomid_connections[1],atomid,atomid_connections[2],atomid_connections[3]) # 1-2-3
            push!(improper_array,imp)

            imp = (atomid_connections[2],atomid,atomid_connections[3],atomid_connections[4]) # 2-3-4
            push!(improper_array,imp)

            imp = (atomid_connections[1],atomid,atomid_connections[2],atomid_connections[4]) # 1-2-4
            push!(improper_array,imp)

            imp = (atomid_connections[1],atomid,atomid_connections[3],atomid_connections[4]) # 1-3-4
            push!(improper_array,imp)

        end
    end
    println("Impropers determined!")
    return improper_array
end


const ERFA_DPI = 3.141592653589793
const ERFA_D2PI = 6.283185307179586
const ERFA_DR2D = 57.29577951308232
const ERFA_DD2R = 0.017453292519943295
const ERFA_DR2AS = 206264.80624709636
const ERFA_DAS2R = 4.84813681109536e-6
const ERFA_DS2R = 7.27220521664304e-5
const ERFA_TURNAS = 1.296e6
const ERFA_DMAS2R = ERFA_DAS2R / 1000.0
const ERFA_DTY = 365.242198781
const ERFA_DAYSEC = 86400.0
const ERFA_DJY = 365.25
const ERFA_DJC = 36525.0
const ERFA_DJM = 365250.0
const ERFA_DJ00 = 2.451545e6
const ERFA_DJM0 = 2.4000005e6
const ERFA_DJM00 = 51544.5
const ERFA_DJM77 = 43144.0
const ERFA_TTMTAI = 32.184
const ERFA_DAU = 1.4959787e11
const ERFA_CMPS = 2.99792458e8
const ERFA_AULT = 499.004782
const ERFA_DC = ERFA_DAYSEC / ERFA_AULT
const ERFA_ELG = 6.969290134e-10
const ERFA_ELB = 1.550519768e-8
const ERFA_TDB0 = -6.55e-5
const ERFA_SRS = 1.97412574336e-8

# Skipping MacroDefinition: ERFA_DINT ( A ) ( ( A ) < 0.0 ? ceil ( A ) : floor ( A ) )
# Skipping MacroDefinition: ERFA_DNINT ( A ) ( ( A ) < 0.0 ? ceil ( ( A ) - 0.5 ) : floor ( ( A ) + 0.5 ) )
# Skipping MacroDefinition: ERFA_DSIGN ( A , B ) ( ( B ) < 0.0 ? - fabs ( A ) : fabs ( A ) )
# Skipping MacroDefinition: ERFA_GMAX ( A , B ) ( ( ( A ) > ( B ) ) ? ( A ) : ( B ) )
# Skipping MacroDefinition: ERFA_GMIN ( A , B ) ( ( ( A ) < ( B ) ) ? ( A ) : ( B ) )

const ERFA_WGS84 = 1
const ERFA_GRS80 = 2
const ERFA_WGS72 = 3

immutable Array_3_Cdouble
    d1::Cdouble
    d2::Cdouble
    d3::Cdouble
end

zero(::Type{Array_3_Cdouble}) = Array_3_Cdouble(fill(zero(Cdouble),3)...)

immutable Array_3_Array_3_Cdouble
    d1::Array_3_Cdouble
    d2::Array_3_Cdouble
    d3::Array_3_Cdouble
end

zero(::Type{Array_3_Array_3_Cdouble}) = Array_3_Array_3_Cdouble(fill(zero(Array_3_Cdouble),3)...)

type eraASTROM
    pmt::Cdouble
    eb::Array_3_Cdouble
    eh::Array_3_Cdouble
    em::Cdouble
    v::Array_3_Cdouble
    bm1::Cdouble
    bpn::Array_3_Array_3_Cdouble
    along::Cdouble
    phi::Cdouble
    xpl::Cdouble
    ypl::Cdouble
    sphi::Cdouble
    cphi::Cdouble
    diurab::Cdouble
    eral::Cdouble
    refa::Cdouble
    refb::Cdouble
end

immutable Array_2_Array_3_Cdouble
    d1::Array_3_Cdouble
    d2::Array_3_Cdouble
end

zero(::Type{Array_2_Array_3_Cdouble}) = Array_2_Array_3_Cdouble(fill(zero(Array_3_Cdouble),2)...)

immutable eraLDBODY
    bm::Cdouble
    dl::Cdouble
    pv::Array_2_Array_3_Cdouble
end

immutable Array_4_Cint
    d1::Cint
    d2::Cint
    d3::Cint
    d4::Cint
end

zero(::Type{Array_4_Cint}) = Array_4_Cint(fill(zero(Cint),4)...)

immutable Array_2_Cdouble
    d1::Cdouble
    d2::Cdouble
end

zero(::Type{Array_2_Cdouble}) = Array_2_Cdouble(fill(zero(Cdouble),2)...)


"""
    mutable struct Replica{AS<:AbstractSampler}

Replica type for replica exchange Monte Carlo. A Sunny sampler type must
be provided during construction.
"""
mutable struct Replica{AS <: AbstractSampler}
    rank::Int64             # MPI rank of sampler is ∈ [0, N_ranks-1]
    N_ranks::Int64          # Total number of MPI ranks (samplers, replicas)
    N_rex_up::Int64         # Count of total number of attempted exchanges btw. replicas (i, i+1)
    rex_dir::Int64          # Replica's current exchange direction ("up"=2, "down"=1)
    α::Float64              # The current value for control parameter
    nn_ranks::Vector{Int64} # MPI ranks of nearest-neighbor samplers, -1 signals no neighbor
    label::Int64            # Label for replica control parameter tracking. Starts as N_ranks+rank+1,
                            #   and updates as swaps occur. Label is < 0 when last α is most recently
                            #   visited and > 0 when first α most recently visited
    N_up::Int64             # Number of exchanges with replica most recently visiting first α
    N_down::Int64           # Number of exchanges with replica most recently visiting last α
    sampler::AS             # Sampler containing/updating this replica's system
end

"""
Initialize MPI and return process rank, number of ranks
"""
function init_MPI()
    if !MPI.Initialized()
        MPI.Init()
    end
    return (MPI.Comm_rank(MPI.COMM_WORLD), MPI.Comm_size(MPI.COMM_WORLD))
end

"""
Constructor which initializes MPI communicator and sets sampler. -> Use on
single communicator with no groups for now
"""
function Replica(sampler::AS, α::Float64) where {AS <: AbstractSampler}
    # MPI must be initialized by user after importing MPI
    if !MPI.Initialized()
        println("""MPI not initialized. Please add "MPI.Init()" at start of script""")
        exit(-1)
    end

    rank = MPI.Comm_rank(MPI.COMM_WORLD)
    N_ranks = MPI.Comm_size(MPI.COMM_WORLD)

    Random.seed!(round(Int64, time()*1000))

    # Even rank exch. down when rex_dir==1, up when rex_dir==2
    nn_ranks = [rank-1, rank+1]

    # First and last replicas only exch. in one dir.
    for i in 1:2
        if (nn_ranks[i] < 0) || (nn_ranks[i] > N_ranks-1)
            nn_ranks[i] = -1
        end
    end

    # Start extremal ranks with up/down trip direction
    if rank == 0
        label = 1
    elseif rank == N_ranks-1
        label = -N_ranks
    else
        label = N_ranks + rank+1
    end

    # Start even ranks exchanging down
    rex_dir = (rank % 2 == 0) ? 1 : 2

    return Replica(rank, N_ranks, 0, rex_dir, α, nn_ranks, label, 0, 0, 0, sampler)
end

"""
Propose and accept/reject a replica exchange. -> Swap spin configurations
instead of the α's for now (no bookkeeping or master proc. needed). -> Use
deterministic even/odd scheme.
"""
function replica_exchange!(replica::Replica)
    # First and last replicas only exch. in one dir.
    if replica.nn_ranks[replica.rex_dir] < 0
        return false
    end

    if replica.rex_dir == 2
        replica.N_rex_up += 1
    end

    # Rank of exchange partner
    rex_rank = replica.nn_ranks[replica.rex_dir]

    # Action of this rank's configuration
    S_curr = running_energy(replica.sampler) / get_temp(replica.sampler)

    # Backup current configuration
    backup_sites = deepcopy(replica.sampler.system.sites)

    # Swap trial configuration with partner
    MPI.Sendrecv!(
                        backup_sites, rex_rank, 1,
        replica.sampler.system.sites, rex_rank, 1,
        MPI.COMM_WORLD
    )

    # This rank's action with partner's configuration
    S_exch = energy(replica.sampler.system) / get_temp(replica.sampler)

    # change in action due to exchange
    ΔS = S_curr - S_exch

    # Calculate exchange probability
    rex_accept = false
    if replica.rank < rex_rank
        rex_ΔS = MPI.Recv(Float64, rex_rank, 2, MPI.COMM_WORLD)[1]
        ln_P = ΔS + rex_ΔS

        # Replica exchange acceptance criterion
        if (ln_P >= 0) || (rand() < exp(ln_P))
            rex_accept = true
        end

        MPI.Send(rex_accept, rex_rank, 3, MPI.COMM_WORLD)
    else
        MPI.Send(ΔS, rex_rank, 2, MPI.COMM_WORLD)

        rex_accept = MPI.Recv(Bool, rex_rank, 3, MPI.COMM_WORLD)[1]
    end

    # Reject exchange
    if !rex_accept
        replica.sampler.system.sites .= backup_sites
        return false
    end

    # Recalculate energy and magnetization of new state
    reset_running_energy!(replica.sampler)
    reset_running_mag!(replica.sampler)

    return true
end

"""
Exchange labels between two replicas.

Each replica has a label that starts as (N_ranks + rank+1) until the replica
reaches an extremal temperature, after which the label ∈ [1, N_ranks]. Labels
are > 0 after most recently visiting first α and < 0 after most recently
visiting lasst α

The label trip direction (±) is used to calculate replica flow for FBOPT and
used to track all replica trajectories.

TODO: use to calculate average round-trip time for replicas
"""
function label_exchange!(replica::Replica, rex_rank::Int64)
    # Exchange labels
    rex_label = [0]
    MPI.Sendrecv!(
        [replica.label], rex_rank, 4,
        rex_label,       rex_rank, 4,
        MPI.COMM_WORLD
    )
    replica.label = rex_label[1]

    # Set label of replica as initialized (has trip direction)
    if (replica.rank == 0) || (replica.rank == replica.N_ranks-1)
        if replica.label > replica.N_ranks
            replica.label -= replica.N_ranks
        end
    end

    # Change the trip direction when α extrema are reached
    if (replica.rank == 0) && (replica.label < 0)
        replica.label *= -1
    elseif (replica.rank == replica.N_ranks-1) && (replica.label > 0)
        replica.label *= -1
    end

    return nothing
end

"""
Gather data from each process and print to specified filename
-> only handle 1D data buffer right now
"""
function gather_print(replica::Replica, data, fname::String)
    # Have root (rank 0) gather data from all processes
    data_all = MPI.Gather(data, 0, MPI.COMM_WORLD)

    # Write gathered data to file w/ column formatting
    if replica.rank == 0
        data_all = reshape(data_all, :, replica.N_ranks)

        f = open(fname, "w")
        for data_c in eachcol(data_all)
            for val in data_c
                print(f, val, "\t")
            end
            print(f, "\n")
        end
        close(f)
    end

    return nothing
end

"""
Print xyz formatted (Lx, Ly, Lz, Sx, Sy, Sz) configurations to file
"""
function xyz_to_file(sys::SpinSystem, output::IOStream)
    sites = reinterpret(reshape, Float64, sys.lattice)
    spins = reinterpret(reshape, Float64, sys.sites)
    xyz = vcat(sites, spins)
    xyz = reshape(xyz, 6, :)

    for c in eachcol(xyz)
        @printf(output, "%f\t%f\t%f\t%f\t%f\t%f\n", c...)
    end
    println(output, "")

    return nothing
end

"""
Update α schedule using feedback-optimization scheme from
Katzgraber et. al. (https://arxiv.org/pdf/cond-mat/0602085v3.pdf).

Note: use f(α) that goes from fist α → last α instead of original paper
Note: use (k-1)/(M-1) as target for integral in Eq. 11 instead of k/M
"""
function feedback_update!(replica::Replica, set_α!::F; w::Float64=0.0, dα′::Float64=1e-5) where {F <: Function}
    # Storage for collecting updated α
    _α = [replica.α]

    # Replica flow
    N_labeled = (replica.N_up + replica.N_down)
    f = (N_labeled > 0) ? replica.N_down/N_labeled : 0.0

    # Gather α and replica flow 'f' from all replicas
    all_α_and_f = MPI.Gather([replica.α, f], 0, MPI.COMM_WORLD)

    if replica.rank == 0
        all_α_and_f = reshape(all_α_and_f, :, replica.N_ranks)
        α = all_α_and_f[1, :]
        f = all_α_and_f[2, :]

        M = replica.N_ranks
        L = collect(range(0, 1.0, length=M))

        # Use 'smoothed replica flow' from Hamze et. al. (https://arxiv.org/pdf/1004.2840.pdf)
        fs = (1-w).*f .+ (w .* L)

        # Use crude linear approximation for df/dα
        Δf = fs[2:end] .- fs[1:end-1]
        Δf[Δf .< 0] .= 0.0

        Δα = α[2:end] .- α[1:end-1]

        # Calculated normalized density for adjusted α's
        η = sqrt.( (Δf ./ Δα) ./ Δα )
        C = sum(η .* Δα)
        η ./= C

        # New α's have fixed end points
        α_new = zeros(M)
        α_new[1] = α[1]
        α_new[M] = α[M]

        α′= α[1]
        cηf = 0.0
        pos = 2

        # find new α's using Eq. 11 from Katzgraber et. al.
        for i in 1:M-1
            for j in 1:Int(round(Δα[i]/dα′))
                cηf += η[i]*dα′
                α′+= dα′

                if (cηf >= L[pos]) && (pos < M)
                    α_new[pos] = α′
                    pos += 1
                end
            end
        end

        # Send out updated α to all replicas
        MPI.Scatter!(MPI.UBuffer(α_new, 1), _α, 0, MPI.COMM_WORLD)
    else
        MPI.Scatter!(nothing, _α, 0, MPI.COMM_WORLD)
    end

    # Assign new value of α and set in replica sampler
    # -> corresponds to update of kT or other Hamiltonian parameter
    set_α!(replica, _α[1])

    return nothing
end

"""
Run a feedback-optimized parallel tempering simulation and return an optimized
temperature set. No measurements are made, but this is used to diagnose replica
flow in PT simulations.

# Arguments
- `replica::Replica`: Replica type that contains MPI info and system data

- `set_α!::Function`: User-provided function for setting control parameters
  in the replica's sampler or system. Needs form: set_α!(::Replica, ::Float64)

- `therm_mcs::Int64`: Number of initial thermalization MC sweeps

- `rex_interval::Int64`: Number of MC sweeps between replica exchange attempts

- `max_mcs_opt::Int64`: Maximum number of MC sweeps to allow during optimization

- `update_interval::Int64`: Number of MC sweeps between feedback updates

- `w::Float64`: Damping factor (w ∈ [0,1]) for feedback updates: 0 gives
  aggressive updates, 1 gives leaves set of α unchanged

- `dα′::Float64`: Step size for integration during feedback update

- `print_ranks_trajectory::Vector{Float64}`: If an MPI rank is in this array, the
  timeseries for the replica starting with this rank will printed to file

- `trajectory_interval::Int64`: Number of replica exchange attempts between printed
  timeseries points

"""
function run_FBO!(
    replica::Replica,
    set_α!::F;
    therm_mcs::Int64=1000,
    rex_interval::Int64=1,
    max_mcs::Int64=500_000,
    update_interval::Int64=100_000,
    w::Float64=0.0,
    dα′::Float64=1e-5,
    print_ranks_trajectory::Vector{Int64}=Int64[],
    trajectory_interval::Int64=500_000
) where {F <: Function}

    # Initialize energy and equilibrate replica to it's distribution
    reset_running_energy!(replica.sampler)
    reset_running_mag!(replica.sampler)

    thermalize!(replica.sampler, therm_mcs)

    replica.sampler.nsweeps = 1

    rex_accepts = zeros(Int64, 2)
    N_updates = 0
    N_rex = 0

    # Start feedback optimization simulation
    for mcs in 1:max_mcs
        sample!(replica.sampler)

        if (replica.rank == 0) && (mcs % 1000 == 0)
            println("FBO ", mcs, " mcs")
        end

        # Attempt replica exchange
        if mcs % rex_interval == 0
            N_rex += 1

            if replica_exchange!(replica)
                rex_accepts[replica.rex_dir] += 1

                # Exchange labels
                label_exchange!(replica, replica.nn_ranks[replica.rex_dir])
            end

            # Record replica flow
            if replica.nn_ranks[replica.rex_dir] != -1
                if replica.label < 0
                    replica.N_down += 1
                elseif replica.label < replica.N_ranks+1
                    replica.N_up += 1
                end
            end

            # Print out replica exchange timeseries -- inefficient IO
            if (N_rex % trajectory_interval == 0) && (abs(replica.label)-1 in print_ranks_trajectory)
                if replica.label <= replica.N_ranks
                    fname = @sprintf("FBO-update%03d_trajectory%03d.dat", N_updates, abs(replica.label)-1)
                    output = open(fname, "a")
                    println(output, replica.rank)
                    close(output)
                end
            end

            # Alternate up/down pairs of replicas for exchanges
            replica.rex_dir = 3 - replica.rex_dir
        end

        if mcs % update_interval == 0
            # Replica flow 'f' and smoothed replica flow 'fs'
            N_labeled = (replica.N_up + replica.N_down)
            f = (N_labeled > 0) ? replica.N_down/N_labeled : 0.0
            fs = (1-w)*f + w*replica.rank/(replica.N_ranks-1)

            # Acceptance rate between replicas i and i+1
            A = (replica.rank == replica.N_ranks-1) ? 0.0 : rex_accepts[2]/replica.N_rex_up

            # Print out α, replica flow, and acceptance rates for each update
            fname = @sprintf("FBO-update%03d.dat", N_updates)
            gather_print(
                replica,
                [replica.α, fs, A],
                fname
            )

            # Perform feedback optimization for control parameters
            feedback_update!(replica, set_α!; w=w, dα′=dα′)

            N_updates += 1
            rex_accepts[1] = rex_accepts[2] = 0
            reset_stats!(replica)
        end
    end

    rex_accepts[1] = rex_accepts[2] = 0
    reset_stats!(replica)

    # Return a vector of optimized α's
    return MPI.Allgather([replica.α], MPI.COMM_WORLD)
end

"""
Reset the exchange statistics and labels stored in replica
"""
function reset_stats!(replica::Replica)
    replica.N_up = replica.N_down = 0
    replica.N_rex_up = 0

    # Reset label
    if replica.rank == 0
        replica.label = 1
    elseif replica.rank == replica.N_ranks-1
        replica.label = -replica.N_ranks
    else
        replica.label = replica.N_ranks + replica.rank+1
    end
    return nothing
end

"""
Start a parallel tempering (PT) simulation that saves measured averages,
histograms, minimal energies, and configurations.

Run w/ the command "mpiexec -n [n_procs] julia --project [julia_script.jl]".

# Arguments
- `replica::Replica`: Replica type that contains MPI info and system data

- `therm_mcs::Int64`: Number of initial thermalization MC sweeps

- `measure_interval::Int64`: Number of MC sweeps between measurements

- `rex_interval::Int64`: Number of MC sweeps between replica exchange attempts

- `max_mcs::Int64`: Maximum number of MC sweeps to allow during simulation

- `bin_size::Float64`: Width in energy space for each histogram bin

- `print_hist::Bool`: Print energy histograms to file for each rank if true

- `print_xyz_ranks::Vector{Float64}`: If an MPI rank is in this array, the xyz
  coordinates for new minimal energies are printed to file

- `print_ranks_trajectory::Vector{Float64}`: If an MPI rank is in this array, the
  timeseries for the replica starting with this rank will printed to file

- `trajectory_interval::Int64`: Number of replica exchange attempts between printed
  timeseries points

- `measure_replica_flow::Bool`: If true, then the flux of downward replica flow in
  α space is measured and printed after the simulation

"""
function run_REMC!(
    replica::Replica;
    therm_mcs::Int64=1000,
    measure_interval::Int64=10,
    rex_interval::Int64=1,
    max_mcs::Int64=1_000_000,
    bin_size::Float64=1.0,
    print_hist::Bool=false,
    print_xyz_ranks::Vector{Int64}=Int64[],
    print_ranks_trajectory::Vector{Int64}=Int64[],
    trajectory_interval::Int64=1_000_000,
    measure_replica_flow::Bool=false
)
    # Initialize energy and equilibrate replica to it's distribution
    reset_running_energy!(replica.sampler)
    reset_running_mag!(replica.sampler)

    thermalize!(replica.sampler, therm_mcs)

    replica.sampler.nsweeps = 1

    # Manually include these basic measurements for now
    U  = 0.0
    U² = 0.0
    M⃗  = [0.0, 0.0, 0.0]
    M  = 0.0
    M² = 0.0
    C  = 0.0
    X  = 0.0

    system_size = length(replica.sampler.system)
    Emin = typemax(Float64)
    E_hist = BinnedArray{Float64, Int64}(bin_size=bin_size)
    m_hist = BinnedArray{Float64, Int64}(bin_size=1.0)
    rex_accepts = zeros(Int64, 2)
    N_measure = 0
    N_rex = 0

    # Start PT with finite length
    for mcs in 1:max_mcs
        sample!(replica.sampler)

        # Crude progress printing to stdout
        if (replica.rank == 0) && (mcs % 1000 == 0)
            println("REMC ", mcs, " mcs")
        end

        # Attempt replica exchange
        if mcs % rex_interval == 0
            N_rex += 1

            if replica_exchange!(replica)
                rex_accepts[replica.rex_dir] += 1

                # Exchange labels
                if measure_replica_flow
                    label_exchange!(replica, replica.nn_ranks[replica.rex_dir])
                end
            end

            # Record replica flow (for quality evaluation)
            if measure_replica_flow && replica.nn_ranks[replica.rex_dir] != -1
                if replica.label < 0
                    replica.N_down += 1
                elseif replica.label < replica.N_ranks+1
                    replica.N_up += 1
                end
            end

            # Print out replica exchange timeseries -- inefficient IO
            if (N_rex % trajectory_interval == 0) && (abs(replica.label)-1 in print_ranks_trajectory)
                if replica.label <= replica.N_ranks
                    fname = @sprintf("trajectory%03d.dat", abs(replica.label)-1)
                    rex_output = open(fname, "a")
                    println(rex_output, replica.rank)
                    close(rex_output)
                end
            end

            # Alternate up/down pairs of replicas for exchanges
            replica.rex_dir = 3 - replica.rex_dir
        end

        # Measurements
        if mcs % measure_interval == 0
            E = running_energy(replica.sampler)
            m⃗ = running_mag(replica.sampler)
            m = norm(m⃗)

            # New minimum energy measured
            if E < Emin
                Emin = E

                # Print out evolution of Emin w.r.t MC time
                f = open(@sprintf("Emin%03d.dat", replica.rank), "a")
                println(f, mcs," ",Emin)
                close(f)

                # Overwrite Emin coordinates in saved file
                if replica.rank in print_xyz_ranks
                    xyz_output = open(@sprintf("Emin%03d.xyz", replica.rank), "w")
                    xyz_to_file(replica.sampler.system, xyz_output)
                    close(xyz_output)
                end
            end

            U  += E
            U² += E^2
            M⃗ .+= m⃗
            M  += m
            M² += m^2
            N_measure += 1

            # Histograms for energy and magnetization
            E_hist[E] += 1
            m_hist[m] += 1
        end
    end

    # Normalize averages
    kT = get_temp(replica.sampler)
    U  /= N_measure
    U² /= N_measure
    M⃗ ./= N_measure
    M  /= N_measure
    M² /= N_measure
    C = 1.0/kT^2 * (U² - U^2)
    X = 1.0/kT   * (M² - M^2)

    # Acceptance rate between replicas i and i+1
    A = (replica.rank == replica.N_ranks-1) ? 0.0 : rex_accepts[2]/replica.N_rex_up

    # Gather and print: rank, "down" exch. accepts, "up" exch. accepts, acceptance ratio
    gather_print(
        replica,
        [replica.α, A],
        "replica_exchanges.dat"
    )

    # Gather and print thermodynamic measurements
    gather_print(
        replica,
        [replica.α, (M⃗ ./ system_size)..., M/system_size, X/system_size, U/system_size, C/system_size],
        "measurements.dat"
    )

    # Write histogram to file for each process if specified
    if print_hist
        f = open(@sprintf("E-hist%03d.dat", replica.rank), "w")
        println(f, E_hist)
        close(f)
        f = open(@sprintf("m-hist%03d.dat", replica.rank), "w")
        println(f, m_hist)
        close(f)
    end

    # Print replica flow 'f' to file
    if measure_replica_flow
        N_labeled = (replica.N_up + replica.N_down)
        f = (N_labeled > 0) ? replica.N_down/N_labeled : 0.0

        gather_print(
            replica,
            [replica.α, f],
            "replica_flow.dat"
        )
    end

    return :SUCCESS
end


using Random
using CUDAdrv
using CUDAnative
using CuArrays
using StaticArrays
using GPUifyLoops # for @unroll macro

# Base.@propagate_inbounds function Base.getindex(v::MArray, i::Int)
#     @boundscheck checkbounds(v,i)
#     T = eltype(v)
#
#     @assert isbitstype(T) "Only isbits is supported on the device"
#     return GC.@preserve v begin
#         ptr  = pointer_from_objref(v)
#         dptr = reinterpret(CUDAnative.DevicePtr{T, CUDAnative.AS.Local}, ptr)
#         unsafe_load(dptr, i)
#     end
# end
#
# Base.@propagate_inbounds function Base.setindex!(v::MArray, val, i::Int)
#     @boundscheck checkbounds(v,i)
#     T = eltype(v)
#
#     @assert isbitstype(T) "Only isbits is supported on the device"
#     GC.@preserve v begin
#     ptr  = pointer_from_objref(v)
#         dptr = reinterpret(CUDAnative.DevicePtr{T, CUDAnative.AS.Local}, ptr)
#         unsafe_store!(dptr, convert(T, val), i)
#     end
#
#     return val
# end

for (f, T) in Base.Iterators.product((:add, :mul, :sub), (Float32, Float64))
    name = Symbol("$(f)_float_contract")
    if T === Float32
        llvmt = "float"
    elseif T === Float64
        llvmt = "double"
    end

    ir = """
    %x = f$f contract $llvmt %0, %1
    ret $llvmt %x
    """
    @eval begin
        # the @pure is necessary so that we can constant propagate.
        Base.@pure function $name(a::$T, b::$T)
            @Base._inline_meta
            Base.llvmcall($ir, $T, Tuple{$T, $T}, a, b)
        end
    end
end

import Base: +, *, -

+(a::Float64, b::Float64) = add_float_contract(a, b)
+(a::Float32, b::Float32) = add_float_contract(a, b)
*(a::Float64, b::Float64) = mul_float_contract(a, b)
*(a::Float32, b::Float32) = mul_float_contract(a, b)
-(a::Float64, b::Float64) = sub_float_contract(a, b)
-(a::Float32, b::Float32) = sub_float_contract(a, b)

# note the order of the fields below is also assumed in the code.
const _nstate = 5
const _ρ, _U, _V, _W, _E = 1:_nstate

const _nvgeo = 14
const _ξx, _ηx, _ζx, _ξy, _ηy, _ζy, _ξz, _ηz, _ζz, _MJ, _MJI,
       _x, _y, _z = 1:_nvgeo

Base.@irrational grav 9.81 BigFloat(9.81)
Base.@irrational gdm1 0.4 BigFloat(0.4)

function volumerhs!(::Val{N}, rhs, Q, vgeo, gravity, D, nelem) where {N}
    Nq = N + 1
    Np = Nq ^ 3

    s_D = @cuStaticSharedMem eltype(D) (Nq, Nq)
    s_F = @cuStaticSharedMem eltype(Q) (Nq, Nq, _nstate)
    s_G = @cuStaticSharedMem eltype(Q) (Nq, Nq, _nstate)

    r_rhsρ = MArray{Tuple{Nq},eltype(rhs)}(undef)
    r_rhsU = MArray{Tuple{Nq},eltype(rhs)}(undef)
    r_rhsV = MArray{Tuple{Nq},eltype(rhs)}(undef)
    r_rhsW = MArray{Tuple{Nq},eltype(rhs)}(undef)
    r_rhsE = MArray{Tuple{Nq},eltype(rhs)}(undef)

    e = blockIdx().x
    j = threadIdx().y
    i = threadIdx().x

    common_gid = i + (j-1)*Nq + (e-1)*Np*_nvgeo
    common_qid = i + (j-1)*Nq + (e-1)*Np*_nstate

    # fetch D into shared
    @inbounds s_D[i, j] = D[i, j]

    @inbounds @unroll for k in 1:Nq
        r_rhsρ[k] = zero(eltype(rhs))
        r_rhsU[k] = zero(eltype(rhs))
        r_rhsV[k] = zero(eltype(rhs))
        r_rhsW[k] = zero(eltype(rhs))
        r_rhsE[k] = zero(eltype(rhs))
    end

    @inbounds @unroll for k in 1:Nq
        sync_threads()

        gid = common_gid + (k-1)*Nq*Nq

        # Load values will need into registers
        MJ = ldg(vgeo, gid + (_MJ - 1) * Np)
        ξx = ldg(vgeo, gid + (_ξx - 1) * Np)
        ξy = ldg(vgeo, gid + (_ξy - 1) * Np)
        ξz = ldg(vgeo, gid + (_ξz - 1) * Np)
        ηx = ldg(vgeo, gid + (_ηx - 1) * Np)
        ηy = ldg(vgeo, gid + (_ηy - 1) * Np)
        ηz = ldg(vgeo, gid + (_ηz - 1) * Np)
        ζx = ldg(vgeo, gid + (_ζx - 1) * Np)
        ζy = ldg(vgeo, gid + (_ζy - 1) * Np)
        ζz = ldg(vgeo, gid + (_ζz - 1) * Np)
        z  = ldg(vgeo, gid + (_z - 1) * Np)

        qid = common_qid + (k-1)*Nq*Nq

        U  = ldg(Q, qid + (_U - 1) * Np)
        V  = ldg(Q, qid + (_V - 1) * Np)
        W  = ldg(Q, qid + (_W - 1) * Np)
        ρ  = ldg(Q, qid + (_ρ - 1) * Np)
        E  = ldg(Q, qid + (_E - 1) * Np)

        P = gdm1*(E - (U^2 + V^2 + W^2)/(2*ρ) - ρ*gravity*z)

        ρinv = 1 / ρ

        fluxρ_x = U
        fluxU_x = ρinv * U * U + P
        fluxV_x = ρinv * U * V
        fluxW_x = ρinv * U * W
        fluxE_x = ρinv * U * (E + P)

        fluxρ_y = V
        fluxU_y = ρinv * V * U
        fluxV_y = ρinv * V * V + P
        fluxW_y = ρinv * V * W
        fluxE_y = ρinv * V * (E + P)

        fluxρ_z = W
        fluxU_z = ρinv * W * U
        fluxV_z = ρinv * W * V
        fluxW_z = ρinv * W * W + P
        fluxE_z = ρinv * W * (E + P)

        s_F[i, j,  _ρ] = MJ * (ξx * fluxρ_x + ξy * fluxρ_y + ξz * fluxρ_z)
        s_F[i, j,  _U] = MJ * (ξx * fluxU_x + ξy * fluxU_y + ξz * fluxU_z)
        s_F[i, j,  _V] = MJ * (ξx * fluxV_x + ξy * fluxV_y + ξz * fluxV_z)
        s_F[i, j,  _W] = MJ * (ξx * fluxW_x + ξy * fluxW_y + ξz * fluxW_z)
        s_F[i, j,  _E] = MJ * (ξx * fluxE_x + ξy * fluxE_y + ξz * fluxE_z)

        s_G[i, j,  _ρ] = MJ * (ηx * fluxρ_x + ηy * fluxρ_y + ηz * fluxρ_z)
        s_G[i, j,  _U] = MJ * (ηx * fluxU_x + ηy * fluxU_y + ηz * fluxU_z)
        s_G[i, j,  _V] = MJ * (ηx * fluxV_x + ηy * fluxV_y + ηz * fluxV_z)
        s_G[i, j,  _W] = MJ * (ηx * fluxW_x + ηy * fluxW_y + ηz * fluxW_z)
        s_G[i, j,  _E] = MJ * (ηx * fluxE_x + ηy * fluxE_y + ηz * fluxE_z)

        r_Hρ = MJ * (ζx * fluxρ_x + ζy * fluxρ_y + ζz * fluxρ_z)
        r_HU = MJ * (ζx * fluxU_x + ζy * fluxU_y + ζz * fluxU_z)
        r_HV = MJ * (ζx * fluxV_x + ζy * fluxV_y + ζz * fluxV_z)
        r_HW = MJ * (ζx * fluxW_x + ζy * fluxW_y + ζz * fluxW_z)
        r_HE = MJ * (ζx * fluxE_x + ζy * fluxE_y + ζz * fluxE_z)

        # one shared access per 10 flops
        @unroll for n = 1:Nq
            Dnk = s_D[n, k]

            r_rhsρ[n] += Dnk * r_Hρ
            r_rhsU[n] += Dnk * r_HU
            r_rhsV[n] += Dnk * r_HV
            r_rhsW[n] += Dnk * r_HW
            r_rhsE[n] += Dnk * r_HE
        end

        r_rhsW[k] -= MJ * ρ * gravity

        sync_threads()

        # loop of ξ-grid lines
        @unroll for n = 1:Nq
            Dni = s_D[n, i]
            Dnj = s_D[n, j]

            r_rhsρ[k] += Dni * s_F[n, j, _ρ]
            r_rhsρ[k] += Dnj * s_G[i, n, _ρ]

            r_rhsU[k] += Dni * s_F[n, j, _U]
            r_rhsU[k] += Dnj * s_G[i, n, _U]

            r_rhsV[k] += Dni * s_F[n, j, _V]
            r_rhsV[k] += Dnj * s_G[i, n, _V]

            r_rhsW[k] += Dni * s_F[n, j, _W]
            r_rhsW[k] += Dnj * s_G[i, n, _W]

            r_rhsE[k] += Dni * s_F[n, j, _E]
            r_rhsE[k] += Dnj * s_G[i, n, _E]
        end
    end

    @inbounds @unroll for k in 1:Nq
        gid = common_gid + (k-1)*Nq*Nq
        MJI = ldg(vgeo, gid + (_MJI - 1) * Np)

        qid = common_qid + (k-1)*Nq*Nq

        rhs[qid + (_U - 1) * Np] += MJI*r_rhsU[k]
        rhs[qid + (_V - 1) * Np] += MJI*r_rhsV[k]
        rhs[qid + (_W - 1) * Np] += MJI*r_rhsW[k]
        rhs[qid + (_ρ - 1) * Np] += MJI*r_rhsρ[k]
        rhs[qid + (_E - 1) * Np] += MJI*r_rhsE[k]
    end

    nothing
end

function main()
    N = 4
    nelem = 4000
    ntrials = 1
    DFloat = Float32

    rnd = MersenneTwister(0)

    Nq = N + 1
    Q = 1 .+ CuArray(rand(rnd, DFloat, Nq, Nq, Nq, _nstate, nelem))
    Q[:, :, :, _E, :] .+= 20
    vgeo = CuArray(rand(rnd, DFloat, Nq, Nq, Nq, _nvgeo, nelem))

    # Make sure the entries of the mass matrix satisfy the inverse relation
    vgeo[:, :, :, _MJ, :] .+= 3
    vgeo[:, :, :, _MJI, :] .= 1 ./ vgeo[:, :, :, _MJ, :]

    D = CuArray(rand(rnd, DFloat, Nq, Nq))

    rhs = CuArray(zeros(DFloat, Nq, Nq, Nq, _nstate, nelem))

    @cuda(threads=(N+1, N+1), blocks=nelem, maxregs=255,
          volumerhs!(Val(N), rhs, Q, vgeo, DFloat(grav), D, nelem))

    CUDAdrv.@profile  begin
        @cuda(threads=(N+1, N+1), blocks=nelem, maxregs=255,
              volumerhs!(Val(N), rhs, Q, vgeo, DFloat(grav), D, nelem))
    end

    CUDAnative.@device_code dir="jlir" begin
        @cuda(threads=(N+1, N+1), blocks=nelem, maxregs=255,
              volumerhs!(Val(N), rhs, Q, vgeo, DFloat(grav), D, nelem))
    end

    nothing
end

main()


### Abstract MALA state

abstract MALAState{F<:VariateForm} <: LMCSamplerState{F}

### MALA state subtypes

## UnvMALAState holds the internal state ("local variables") of the MALA sampler for univariate parameters

type UnvMALAState <: MALAState{Univariate}
  pstate::ParameterState{Continuous, Univariate} # Parameter state used internally by MALA
  tune::MCTunerState
  ratio::Real
  μ::Real

  function UnvMALAState(pstate::ParameterState{Continuous, Univariate}, tune::MCTunerState, ratio::Real, μ::Real)
    if !isnan(ratio)
      @assert ratio > 0 "Acceptance ratio should be positive"
    end
    new(pstate, tune, ratio, μ)
  end
end

UnvMALAState(pstate::ParameterState{Continuous, Univariate}, tune::MCTunerState=BasicMCTune()) =
  UnvMALAState(pstate, tune, NaN, NaN)

## MuvMALAState holds the internal state ("local variables") of the MALA sampler for multivariate parameters

type MuvMALAState <: MALAState{Multivariate}
  pstate::ParameterState{Continuous, Multivariate} # Parameter state used internally by MALA
  tune::MCTunerState
  ratio::Real
  μ::RealVector

  function MuvMALAState(pstate::ParameterState{Continuous, Multivariate}, tune::MCTunerState, ratio::Real, μ::RealVector)
    if !isnan(ratio)
      @assert ratio > 0 "Acceptance ratio should be positive"
    end
    new(pstate, tune, ratio, μ)
  end
end

MuvMALAState(pstate::ParameterState{Continuous, Multivariate}, tune::MCTunerState=BasicMCTune()) =
  MuvMALAState(pstate, tune, NaN, Array(eltype(pstate), pstate.size))

### Metropolis-adjusted Langevin Algorithm (MALA)

immutable MALA <: LMCSampler
  driftstep::Real

  function MALA(driftstep::Real)
    @assert driftstep > 0 "Drift step is not positive"
    new(driftstep)
  end
end

MALA() = MALA(1.)

### Initialize MALA sampler

## Initialize parameter state

function initialize!{F<:VariateForm}(
  pstate::ParameterState{Continuous, F},
  parameter::Parameter{Continuous, F},
  sampler::MALA
)
  parameter.uptogradlogtarget!(pstate)
  @assert isfinite(pstate.logtarget) "Log-target not finite: initial value out of support"
  @assert all(isfinite(pstate.gradlogtarget)) "Gradient of log-target not finite: initial values out of support"
end

## Initialize MALA state

sampler_state(
  parameter::Parameter{Continuous, Univariate},
  sampler::MALA,
  tuner::MCTuner,
  pstate::ParameterState{Continuous, Univariate},
  vstate::VariableStateVector
) =
  UnvMALAState(generate_empty(pstate), tuner_state(parameter, sampler, tuner))

sampler_state(
  parameter::Parameter{Continuous, Multivariate},
  sampler::MALA,
  tuner::MCTuner,
  pstate::ParameterState{Continuous, Multivariate},
  vstate::VariableStateVector
) =
  MuvMALAState(generate_empty(pstate), tuner_state(parameter, sampler, tuner))

## Reset parameter state

function reset!(
  pstate::ParameterState{Continuous, Univariate},
  x::Real,
  parameter::Parameter{Continuous, Univariate},
  sampler::MALA
)
  pstate.value = x
  parameter.uptogradlogtarget!(pstate)
end

function reset!(
  pstate::ParameterState{Continuous, Multivariate},
  x::RealVector,
  parameter::Parameter{Continuous, Multivariate},
  sampler::MALA
)
  pstate.value = copy(x)
  parameter.uptogradlogtarget!(pstate)
end

Base.show(io::IO, sampler::MALA) = print(io, "MALA sampler: drift step = $(sampler.driftstep)")

Base.writemime(io::IO, ::MIME"text/plain", sampler::MALA) = show(io, sampler)


# version 0.1

module EcoEvo3D

using StatsBase

function getSampleFromArray(items)
  return sample(items)
end

function readLocations(filename)
	dat = readdlm(filename,'\t');
	@inbounds w = hcat(dat[:,2],dat[:,3]);
	w;
end

function readDistanceMatrix(filename)
	dat = readdlm(filename,' ');
	dat;
end

function changediagonal!(MA,nrows,value)
	@inbounds for(i in 1:nrows)
		@inbounds MA[i,i]=value;
	end
end

function createMRM(MRM,Sti,Sp,ts)
	MRM = [Sti Sp 1 ts];
	MRM;
end

function createMC(MC,Sti,Sp,ts)
	MC = [Sti Sp 1 ts];
	return MC;
end

function createMA(MA,Sti,Stj,Sp,anaG)
	MA = [Sti Stj Sp anaG];
	return MA;
end

function updateMC(MC)
	if length(MC)>0
		MC[:,3] = MC[:,3].+1;#event: -1 for extinction; 1 for speciation
	end
	return MC;
end

function updateMA(MA)
	if length(MA)>0
		MA[:,4] = MA[:,4] .- 1;
	end
	return MA;
end

function checkIfThereIsMRM(MRM,Sti,Sp,ts)
	if length(MRM)==0
		MRM = createMRM(MRM,Sti,Sp,ts);
	else
		pos = find( (MRM[:,1].==Sti) & (MRM[:,2].==Sp))
		if length(pos)==0
			MRM = cat(1,MRM,[Sti Sp 1 ts]);
		end
	end
	return MRM;
end

function checkIfThereIsMC(MC,Sti,Sp,ts)
	if length(MC)==0
		MC = createMC(MC,Sti,Sp,ts);
	else
		pos = find( (MC[:,1].==Sti) & (MC[:,2].==Sp))#position in the matrix MA referred to the presence of individuals of species 'Sp' coming from site 'Stj' to site 'Sti'
		if length(pos)==0
			MC = cat(1,MC,[Sti Sp 1 ts]);
		end
	end
	return MC;
end

function GetGammaRichness(R,S)
	richnessspeciesR = [];
	#%gamma richness
	for (i in 1:S)
		AR = sort(R[i])
		richnessspeciesR = [richnessspeciesR; unique(AR)];
	end;
	extantR = length(unique(sort(richnessspeciesR)));
	gamma = extantR;

	return gamma;
end

function OutputPerGeneration(outputfilepergen,ri,cost,J,G,S,k,anaG,retG,mr,ml,v,lakesIsolation,lakesArea,gamma,alpharich,SpecANA,SpecCLA,SpecMR,DispersalRich)
	for i in 1:S
		writedlm(outputfilepergen, [ri cost J G k anaG retG mr ml v gamma i lakesIsolation[i] lakesArea[i] alpharich[i] SpecANA[i] SpecCLA[i] SpecMR[i] DispersalRich[i]],' ');
	end
	flush(outputfilepergen);#To print in the output file each realization
	return;
end

function printPhylogeny(phylogenyfile,old,new,ts,ri)
	writedlm(phylogenyfile,[ri old new ts],' ');
        flush(phylogenyfile);
end

function UAB(MA,MC)
	MC = updateMC(MC);
	MA = updateMA(MA);
	return MC,MA;
end

function UAC(MA)
	MA = updateMA(MA);
	return MA;
end

function UARM(MA,MC)
	MC = updateMC(MC);
	MA = updateMA(MA);
	return MC,MA;
end

function UALM(MA,MC,R,Sti,Stj,Sp,anaG,retG,ts)
	MC = updateMC(MC);
	MA = updateMA(MA);

	if length(MA)==0 #Si no hay MA
  	MA = createMA(MA,Sti,Stj,Sp,anaG);#Create MA
	else#Si hay MA
		pos = find( (MA[:,1].==Sti) & (MA[:,2].==Stj) & (MA[:,3].==Sp))#position in the matrix MA referred to the presence of individuals of species 'Sp' coming from site 'Stj' to site 'Sti'
		if length(pos)==0 #No hay la linea
			indalive = length(find(R[Sti].==Sp))#Hay individuos de la specie sp vivos en el sitio Sti
			if (indalive == 0) #Checking if there are individuals of species 'Sp' alive in site 'Sti'
#        			println("<<<<<<<<<<< A D D    R O W   T O    A N A G E N E S I S   <<<<<<<<<<<<<<<<<");
				MA = cat(1,MA,[Sti Stj Sp anaG]);#Create the row in MA matrix, starting by 1
      			end
		else #Ya hay la linea
#			println("<<<<<<<<<<< R E T A R D    A N A G E N E S I S   <<<<<<<<<<<<<<<<<");
			MA[pos,4] = MA[pos,4] .+ retG;#retards anagenesis by increasing the remaining
		end
	end
  	return MC,MA,R;
end

########################

function checkAna(MA,R,anaG,lastspecies,listofanagenesis,ts,phylogenyfile,ri)
	pos = [];
	if length(MA)>0
		pos = find(MA[:,4] .== 0)#find the anagenesis events
		if length(pos)>0#is there was an anagenesis event
		  @inbounds for (p in pos)
  			Sti=round(Integer,MA[p,1]);#pos represents the rows of the matrix. p is one row. MA[p,1] is the target site
  			Stj=round(Integer,MA[p,2]);#pos represents the rows of the matrix. p is one row. MA[p,2] is the source site
		  	Sp=round(Integer,MA[p,3]);#pos represents the rows of the matrix. p is one row. MA[p,3] is the ancient species
			  MA, R, lastspecies,listofanagenesis = AnagenesisSpeciation(MA,R,Sti,Stj,Sp,lastspecies,listofanagenesis,ts,phylogenyfile,ri);#speciation in target site
#			  MA, R, lastspecies,listofanagenesis = MA, R, lastspecies, listofanagenesis;
		  end
	  end
  end
  return MA,R,lastspecies,listofanagenesis;
end

function AnagenesisSpeciation(MA,R,Sti,Stj,Sp,lastspecies,listofanagenesis,ts,phylogenyfile,ri)
	newspeciesAna = lastspecies + 1;#the id of the new species
	ancientindividuals = find( R[Sti].==Sp )#the position of all the individuals of the ancient species 'Sp' in the target site
	R[Sti][ancientindividuals] = newspeciesAna;#the speciation itself: all the individuals of former species 'Sp' in the target site are now from a new species 'newspeciesAna'
        println("new ANAgenesis Speciation : Species ",newspeciesAna," - time: ",ts);
 	pos = find( (MA[:,1].==Sti) & (MA[:,3].==Sp))#position in the matrix MA referred to the presence of individuals of species 'Sp' in site 'Sti'
	MA = MA[1:size(MA,1).!=pos,:];#Borra la linea 'pos' de la matriz MA!!
	printPhylogeny(phylogenyfile,Sp,newspeciesAna,ts,ri);

  	if length(listofanagenesis)>0
		listofanagenesis = cat(1,listofanagenesis,[Sti newspeciesAna]);
	else
		listofanagenesis = cat(1,[Sti newspeciesAna]);
	end

	return MA,R,newspeciesAna,listofanagenesis;
end

function CladogenesisEvent(MC,R,Sti,Individual,lastspecies,ts,phylogenyfile,ri)
	newspeciesClado = lastspecies + 1;
	printPhylogeny(phylogenyfile,R[Sti][Individual],newspeciesClado,ts,ri);
        println("new CLADOgenesis Speciation : Species ",newspeciesClado," - time: ",ts);
   	R[Sti][Individual] = newspeciesClado;
	MC = checkIfThereIsMC(MC,Sti,newspeciesClado,ts);
	return MC,R,newspeciesClado;
end

function LocalMigrationEvent(R,KillHab,MigrantHab,KillInd,Dc,Ji,S)
	MigrantSpecies = -1;

	allpos = find(Dc[KillHab,:] .>= MigrantHab);#All the sites at a distance lower than the threshold 'MigrantHab'
	kr = minimum(allpos[find(allpos .!= KillHab)]);
	MigrantInd = rand(1:Ji[kr]);
	MigrantSpecies = R[kr][MigrantInd];
#        println("LOCAL Migration");
	R[KillHab][KillInd] = R[kr][MigrantInd];
	return kr,R,MigrantSpecies;
end;

function RegionalMigrationEvent(MRM,R,Sti,Individual,ts,lastspecies)
  newspeciesMR = lastspecies + 1;
  R[Sti][Individual] = newspeciesMR;
  println("new RegionalMig Speciation: Species ",newspeciesMR," - time: ",ts)
  MRM = checkIfThereIsMRM(MRM,Sti,newspeciesMR,ts);

  return MRM,R,newspeciesMR;
end;

function BirthEvent(R,BirthLocal,KillInd,KillHab)
	R[KillHab][KillInd] = R[KillHab][BirthLocal];
	return R;
end

function calculateSpeciationMA(listofanagenesis,R)
	S = length(R);#number of sites equals the number of rows in R
	speciatedMA = zeros(S);
	if (length(listofanagenesis) > 0)
		@inbounds for i in 1:S
			@inbounds speciesR = unique(sort(R[i]))';
			pos = find(listofanagenesis[:,1].== i);
			if length(pos)>0
				speciesMA = listofanagenesis[pos,2];
				speciatedMA[i] = length(setdiff(speciesMA,setdiff(speciesMA,speciesR))');
			end
		end
	end
	return speciatedMA;
end

function calculateSpeciationMC(MC,R,S,k,Ji)
	speciatedMC = zeros(S);
	if (length(MC) > 0)
		@inbounds for i in 1:S
		@inbounds speciesR = unique(sort(R[i]))';
			pos = find( (MC[:,1].== i) & (MC[:,3].>= k) );#Only the species that are in the system for more than k time steps (Protracted)
			if length(pos)>0
				speciesMC = unique(sort(MC[pos,2]));
				speciatedMC[i] = length(setdiff(speciesMC,setdiff(speciesMC,speciesR))');
			end
		end
	end
	return speciatedMC;
end

function calculateSpeciationMR(MRM,R,S,Ji)
	speciatedMRM = zeros(S);
	if (length(MRM) > 0)
		@inbounds for i in 1:S
      @inbounds speciesR = unique(sort(R[i]))';
      pos = find(MRM[:,1].== i);#check for site i
      if length(pos)>0
        speciesMRM = unique(sort(MRM[pos,2]));
        @inbounds speciatedMRM[i] = length(setdiff(speciesMRM,setdiff(speciesMRM,speciesR))');
      end
		end
	end
#	writedlm("MRMmatrix.dat",MRM,' ');
	return speciatedMRM;
end

function richnessanalysis!(S,R,Ji,richnessspeciesR,alpharich)
	#%gamma richness
	@inbounds for (i in 1:S)
		@inbounds AR = sort(R[i]);
		richnessspeciesR = [richnessspeciesR; unique(AR)];
		@inbounds alpharich[i] = length(unique(AR));
	end;
	gamma = length(unique(sort(richnessspeciesR)));
	return gamma,alpharich;
end

function normalizeDc!(Dc,S)
  for(i in 1:S)
    Dc[i,:] = Dc[i,:]/maximum(Dc[i,:]);
  end
end

function repeatval(x,N)
  return map(v -> v=x,1:N);
end

#Each site starts with one different species
function initialPopulation(R,Ji)
  lastspecies = 0;
  for(iJ in Ji)#iterating over columns
     lastspecies = lastspecies+1;
     popi = repeatval(lastspecies,iJ);
     push!(R,popi);
  end
  return R,lastspecies;
end

function dynamic(seed,nreal,Gmax,J,v,mr,ml,anaG,retG,distmatfile,verticesdata,model)
	DI = readDistanceMatrix(distmatfile);#the location of the points of the landscape.
	Dc = cumsum(DI,2);#Should we divide
  dT = sum(DI,2);
	const S = length(DI[:,1]);#Number of sites
  normalizeDc!(Dc,S);
#### To get the cost
        substring = distmatfile[search(distmatfile,'_')+1:end];
        modelstop = search(substring,'_');
        coststop = search(substring,'t');
	const cost = float(substring[coststop+1:modelstop-1]);

	sitesdata = readdlm(verticesdata,' ',header=true)[1];#Proportion of individuals of each site
#	Pj = ones(S);#Proportion of individuals of each site - if an input file is not defined, the proportion is the same for each site
        lakesVolume = sitesdata[:,2];
        lakesArea = sitesdata[:,3];
	Pj = lakesVolume;#In case we define different carrying capacities for each site we consider the volume of the lakes (third column)
	mins = find(sitesdata.==minimum(sitesdata[:,1]));#the first column represents the height of the lakes
	entrypoint = mins[rand(1:length(mins))];
	t=1;#Sites have different sizes and are located at different height.
	Ji=round(Integer,J * Pj/sum(Pj));

	outputfilepergen = open(string("RichnessPerGen_AnaG_",anaG,"_retG_",retG,"_cost_",cost,"_MR_",signif(mr,3),"_VR_",signif(v,3),".txt"),"a")
	writedlm(outputfilepergen, ["Real Cost J G Gi anaG retG mr ml v gamma Site dT lakeArea alpharich SpecANA SpecCLA SpecMR DispersalRich"]);

	outputfile = open(string("RichnessPerSite_AnaG_",anaG,"_retG_",retG,"_cost_",cost,"_MR_",signif(mr,3),"_VR_",signif(v,3),".txt"),"a")
	writedlm(outputfile,["Real Cost Model J G anaG retG Site lakeArea Ji dT mr ml v gamma alpharich SpecANA SpecCLA SpecMR DispersalRich"]);

	phylogenyfile = open(string("Phylogeny_AnaG_",anaG,"_retG_",retG,"_cost_",cost,"_MR_",signif(mr,3),"_VR_",signif(v,3),".txt"),"a")
	writedlm(phylogenyfile,["Repl Ancestral Derived Age"]);

  @inbounds for (ri in 1:nreal)#realizations
 	  lastspecies = 0;
  	ts=0;
    R=[];
    R,lastspecies = initialPopulation(R,Ji)
	  MA = Array(Number,0,0);#Matrix to calculate Anagenesis speciation (MA = [Sti, Stj, S, C])
	  MC = Array(Number,0,0);#Matrix to control Cladogenesis speciation (MC = [Sti, S, E])
	  MRM = Array(Number,0,0);#Matrix to control events of Regional Migration (MRM = [Sti, S, ts])
		srand(seed+(7*ri));
		listofanagenesis = Array(Number,0,0);

		#%Resources
#		G = rand(15:Gmax);#Minimum of 15 generations
		G = Gmax;#Minimum of 15 generations

		@inbounds for (k = 1:G)#%population-metapopulation-metacommunity dynamics (not-tracking multitrophic metacommunity dynamics!)
			@inbounds for (j = 1:J)#For each individual in each site
				ts = ts+1;#Time step increases
				mvb = rand();
		       		#Demography - Resources
    				KillHab = rand(1:S);#which site to kill
				KillInd = rand(1:Ji[KillHab]);#which individual to kill
        			KillIndEntryPoint = rand(1:Ji[entrypoint]);
				MigrantHab = rand()*maximum(Dc[KillHab,:]);
				BirthLocal = getSampleFromArray(1:length(R[KillHab]));#which individual to born

				if mvb <= ml;#Local Migration event
					kr,R,MigrantSpecies = LocalMigrationEvent(R,KillHab,MigrantHab,KillInd,Dc,Ji,S);
					MC,MA,R = UALM(MA,MC,R,KillHab,kr,MigrantSpecies,anaG,retG,ts);#Update Anagenesis after Local Migration event
				elseif (ml < mvb <= (ml+mr));#Regional Migration event
					MRM,R,lastspecies = RegionalMigrationEvent(MRM,R,entrypoint,KillIndEntryPoint,ts,lastspecies);#Speciation through the entry point
					MC,MA = UARM(MA,MC);#Update Anagenesis after Regional Migration event
				elseif ((ml+mr) < mvb <= (ml+mr+v))
					if(v > 0)#we only simulate Cladogenesis when the probability is higher than 0
						MC,R,lastspecies = CladogenesisEvent(MC,R,KillHab,KillInd,lastspecies,ts,phylogenyfile,ri);
						MA = UAC(MA);#Update Anagenesis after Cladogenesis Speciation
					end
				else #Birth event
					R = BirthEvent(R,BirthLocal,KillInd,KillHab);#Birth event
					MC,MA = UAB(MA,MC);#Update MA after Birth event
		       		end;
####ANAGENESIS
				lengthlistbefore = length(listofanagenesis);#Size of Anagenesis Matrix before checking for Anagenesis
				MA,R,lastspecies,listofanagenesis = checkAna(MA,R,anaG,lastspecies,listofanagenesis,ts,phylogenyfile,ri); #After the update of matrix MA, we check for events of Anagenesis
				lengthlistafter = length(listofanagenesis);#Size of Anagenesis Matrix after checking for Anagenesis
####CLADOGENESIS
#				if ((lengthlistafter - lengthlistbefore) > 0)#If there is at least one Anagenesis Speciation Event
#					mvc = rand();
#					if (mvc <= v);#Probability to occur a Cladogenesis Speciation event
#						allInd = find(R[St,:].==lastspecies);#All individuals from the new species
#						if (length(allInd)>0)
#							KillInd = allInd[rand(1:length(allInd))];#Randomly choose an individual from the new species
#							MC,R,lastspecies = CladogenesisEvent(MC,R,KillHab,KillInd,lastspecies,ts,phylogenyfile,ri);#Cladogenesis event
#							MA = UAC(MA);#Update Anagenesis after Cladogenesis Speciation event
#						end #if allInd
#					end #if mvc
#				end #if lengthlistafter
			end;#end S*Ji
			richnessspeciesR = [];
			alpharich = zeros(S);
			gamma,alpharich = richnessanalysis!(S,R,Ji,richnessspeciesR,alpharich);
			SpecANA = calculateSpeciationMA(listofanagenesis,R);
			SpecCLA = calculateSpeciationMC(MC,R,S,anaG,Ji);
			SpecMR = calculateSpeciationMR(MRM,R,S,Ji);
			DispersalRich = alpharich - (SpecANA + SpecCLA + SpecMR);
			OutputPerGeneration(outputfilepergen,ri,cost,J,G,S,k,anaG,retG,mr,ml,v,dT,lakesArea,gamma,alpharich,SpecANA,SpecCLA,SpecMR,DispersalRich);
		end;#end Gmax

		#To analyze the resulting richness
		richnessspeciesR = [];
		alpharich = zeros(S);
		gamma,alpharich = richnessanalysis!(S,R,Ji,richnessspeciesR,alpharich);
		SpecANA = calculateSpeciationMA(listofanagenesis,R);
		SpecCLA = calculateSpeciationMC(MC,R,S,anaG,Ji);
		SpecMR = calculateSpeciationMR(MRM,R,S,Ji);
		DispersalRich = alpharich - (SpecANA + SpecCLA + SpecMR);
#		matrixfile = open("Rmatrix.txt","a");
		for i in 1:S
			writedlm(outputfile,[ri cost model J G anaG retG i lakesArea[i] Ji[i] dT[i] mr ml v gamma alpharich[i] SpecANA[i] SpecCLA[i] SpecMR[i] DispersalRich[i]],' ');
#                        for j in 1:length(R[i])
#	                        print(matrixfile,R[i][j],' ');
#			end
#	                print(matrixfile,'\n');
		end
		flush(outputfile);
#		ANAfile = open("ANAmatrix.txt","a");
#		MRMfile = open("MRMmatrix.txt","a");
#		rowsANA = size(listofanagenesis,1);rowsMRM = size(MRM,1);
#		colsANA = size(listofanagenesis,2);colsMRM = size(MRM,2);
#		for i in 1:rowsANA #number of rows
#			for j in 1:colsANA
#	                        print(ANAfile,listofanagenesis[i,j],' ');
#			end
#	                print(ANAfile,'\n');
#		end
#		for i in 1:rowsMRM #number of rows
#			for j in 1:colsMRM
#	                        print(MRMfile,MRM[i,j],' ');
#			end
#	                print(MRMfile,'\n');
#		end

	end#%ri
	close(outputfile);
	close(outputfilepergen);
	close(phylogenyfile);
#	close(logfile);
end#ecoevo3d function

end #module


using ForwardDiff: value

"""
    AbstractObsScheme

Types inheriting from abstract type `AbstractObsScheme` define the scheme
according to which a stochastic process has been observed
"""
abstract type AbstractObsScheme end

"""
    PartObs <: AbstractObsScheme

Type acting as a flag for partially observed diffusions
"""
struct PartObs <: AbstractObsScheme end

"""
    FPT <: AbstractObsScheme

Observation scheme in which only first passage times are observed
"""
struct FPT <: AbstractObsScheme end

"""
    ParamUpdateType

Types inheriting from abstract type `ParamUpdateType` define the way in which
parameters are to be updated by the MCMC sampler
"""
abstract type ParamUpdateType end

"""
    ConjugateUpdt <: ParamUpdateType

Type acting as a flag for update from full conditional (conjugate to a prior)
"""
struct ConjugateUpdt <: ParamUpdateType end

"""
    MetropolisHastingsUpdt <: ParamUpdateType

Flag for performing update according to Metropolis Hastings step
"""
struct MetropolisHastingsUpdt <: ParamUpdateType end

"""
    setBlocking(𝔅::NoBlocking, ::Any, ::Any, ::Any, ::Any)

No blocking is to be done, do nothing
"""
setBlocking(𝔅::NoBlocking, ::Any, ::Any, ::Any, ::Any) = 𝔅

"""
    setBlocking(::ChequeredBlocking, blockingParams, P, WW, XX)

Blocking pattern is chosen to be a chequerboard.
"""
function setBlocking(::ChequeredBlocking, blockingParams, P, WW, XX)
    ChequeredBlocking(blockingParams..., P, WW, XX)
end

"""
    FPTInfo{S,T}

The struct
```
struct FPTInfo{S,T}
    condCoord::NTuple{N,S}
    upCrossing::NTuple{N,Bool}
    autoRenewed::NTuple{N,Bool}
    reset::NTuple{N,T}
end
```
serves as a container for the information regarding first passage time
observations. `condCoord` is an NTuple of coordinates that are conditioned on
the first passage time nature of the observations. `upCrossing` indicates
whether observations of the corresponding coordinate are up-crossings or
down-crossings. `autoRenewed` indicates whether process starts from the
renewed state (i.e. normally the process is unconstrained until it hits level
`reset` for the first time, however `autoRenewed` process is constrained on the
first passage time from the very beginnig). `reset` level is the level that
needs to be reached before the process starts to be conditioned on the first
passage time.
"""
struct FPTInfo{S,T,N}
    condCoord::NTuple{N,S}
    upCrossing::NTuple{N,Bool}
    autoRenewed::NTuple{N,Bool}
    reset::NTuple{N,T}

    FPTInfo(condCoord::NTuple{N,S}, upCrossing::NTuple{N,Bool},
            reset::NTuple{N,T},
            autoRenewed::NTuple{N,Bool} = Tuple(fill(false,length(condCoord)))
            ) where {S,T,N} = new{S,T,N}(condCoord, upCrossing,
                                         autoRenewed, reset)
end

"""
    checkSingleCoordFpt(XXᵒ, c, cidx, fpt)

Verify whether coordinate `c` (with index number `cidx`) of path `XXᵒ`.yy
adheres to the first passage time observation scheme specified by the object
`fpt`.
"""
function checkSingleCoordFpt(XXᵒ, c, cidx, fpt)
    k = length(XXᵒ.yy)
    thrsd = XXᵒ.yy[end][c]
    renewed = fpt.autoRenewed[cidx]
    s = fpt.upCrossing[cidx] ? 1 : -1
    for i in 1:k
        if !renewed && (s*XXᵒ.yy[i][c] <= s*fpt.reset[cidx])
            renewed = true
        elseif renewed && (s*XXᵒ.yy[i][c] > s*thrsd)
            return false
        end
    end
    return renewed
end

"""
    checkFpt(::PartObs, XXᵒ, fpt)

First passage time constrains are automatically satisfied for the partially
observed scheme
"""
checkFpt(::PartObs, XXᵒ, fpt) = true

"""
    checkFpt(::FPT, XXᵒ, fpt)

Verify whether path `XXᵒ`.yy adheres to the first passage time observation
scheme specified by the object `fpt`.
"""
function checkFpt(::FPT, XXᵒ, fpt)
    for (cidx, c) in enumerate(fpt.condCoord)
        if !checkSingleCoordFpt(XXᵒ, c, cidx, fpt)
            return false
        end
    end
    return true
end

"""
    checkFullPathFpt(::PartObs, ::Any, ::Any, ::Any)

First passage time constrains are automatically satisfied for the partially
observed scheme
"""
checkFullPathFpt(::PartObs, ::Any, ::Any, ::Any) = true

"""
    checkFullPathFpt(::PartObs, XXᵒ, m, fpt)

Verify whether all paths in the range `iRange`, i.e. `XXᵒ`[i].yy, i in `iRange`
adhere to the first passage time observation scheme specified by the object
`fpt`
"""
function checkFullPathFpt(::FPT, XXᵒ, iRange, fpt)
    for i in iRange
        if !checkFpt(FPT(), XXᵒ[i], fpt[i])
            return false
        end
    end
    return true
end

"""
    findProposalLaw(xx, tt, P˟, P̃, Ls, Σs; dt=1/5000, timeChange=true,
                    solver::ST=Ralston3())

Initialise the object with proposal law and all the necessary containers needed
for the simulation of the guided proposals
"""
function findProposalLaw(::Type{K}, xx, tt, P˟, P̃, Ls, Σs, τ; dt=1/5000,
                         solver::ST=Ralston3(),
                         changePt::ODEChangePt=NoChangePt()) where {K,ST}
    m = length(xx) - 1
    P = Array{ContinuousTimeProcess,1}(undef,m)
    for i in m:-1:1
        numPts = Int64(ceil((tt[i+1]-tt[i])/dt))+1
        t = τ(tt[i], tt[i+1]).( range(tt[i], stop=tt[i+1], length=numPts) )
        P[i] = ( (i==m) ? GuidPropBridge(K, t, P˟, P̃[i], Ls[i], xx[i+1], Σs[i];
                                         changePt=changePt, solver=ST()) :
                          GuidPropBridge(K, t, P˟, P̃[i], Ls[i], xx[i+1], Σs[i],
                                         P[i+1].H[1], P[i+1].Hν[1], P[i+1].c[1];
                                         changePt=changePt, solver=ST()) )
    end
    P
end

"""
    initialise(::ObsScheme, P, m, y::StartingPtPrior{T}, ::S, fpt)

Initialise the workspace for MCMC algorithm. Initialises containers for driving
Wiener processes `WWᵒ` & `WW`, for diffusion processes `XXᵒ` & `XX`, for
diffusion Law `Pᵒ` (parametetrised by proposal parameters) and defines the type
of Wiener process `Wnr`.
"""
function initialise(::ObsScheme, P, m, yPr::StartingPtPrior{T}, ::S,
                    fpt) where {ObsScheme <: AbstractObsScheme,T,S}
    y = startPt(yPr)
    Pᵒ = deepcopy(P)
    TW = typeof(sample([0], Wiener{S}()))
    TX = typeof(SamplePath([], zeros(T, 0)))
    XXᵒ = Vector{TX}(undef,m)
    WWᵒ = Vector{TW}(undef,m)
    Wnr = Wiener{S}()
    for i in 1:m
        WWᵒ[i] = Bridge.samplepath(P[i].tt, zero(S))
        sample!(WWᵒ[i], Wnr)
        XXᵒ[i] = solve(Euler(), y, WWᵒ[i], P[i])
        while !checkFpt(ObsScheme(), XXᵒ[i], fpt[i])
            sample!(WWᵒ[i], Wnr)
            solve!(Euler(), XXᵒ[i], y, WWᵒ[i], P[i])
        end
        y = XXᵒ[i].yy[end]
    end
    y = startPt(yPr)
    ll = logpdf(yPr, y)
    ll += pathLogLikhd(ObsScheme(), XXᵒ, P, 1:m, fpt, skipFPT=true)
    ll += lobslikelihood(P[1], y)

    XX = deepcopy(XXᵒ)
    WW = deepcopy(WWᵒ)
    # needed for proper initialisation of the Crank-Nicolson scheme
    yPr = invStartPt(y, yPr, P[1])

    Wnr, WWᵒ, WW, XXᵒ, XX, Pᵒ, ll, yPr
end

"""
    savePath!(Paths, XX, saveMe, skip)

If `saveMe` flag is true, then save the entire path spanning all segments in
`XX`. Only 1 in  every `skip` points is saved to reduce storage space.
"""
function savePath!(Paths, XX, saveMe, skip)
    if saveMe
        push!(Paths, collect(Iterators.flatten(XX[i].yy[1:skip:end-1]
                                               for i in 1:length(XX))))
    end
end

"""
    acceptSample(logThreshold, verbose=false)

Make a random MCMC decision for whether to accept a sample or reject it.
"""
function acceptSample(logThreshold, verbose=false)
    if rand(Exponential(1.0)) > -logThreshold # Reject if NaN
        verbose && print("\t ✓\n")
        return true
    else
        verbose && print("\t .\n")
        return false
    end
end

"""
    solveBackRec!(P, solver::ST=Ralston3()) where ST

Solve backward recursion to find H, Hν, c and Q, which together define r̃(t,x)
and p̃(x, 𝓓) under the auxiliary law, when no blocking is done
"""
function solveBackRec!(::NoBlocking, P, solver::ST=Ralston3()) where ST
    m = length(P)
    gpupdate!(P[m]; solver=ST())
    for i in (m-1):-1:1
        gpupdate!(P[i], P[i+1].H[1], P[i+1].Hν[1], P[i+1].c[1]; solver=ST())
    end
end

"""
    solveBackRec!(P, solver::ST=Ralston3()) where ST

Solve backward recursion to find H, Hν, c and Q, which together define r̃(t,x)
and p̃(x, 𝓓) under the auxiliary law, when blocking is done
"""
function solveBackRec!(𝔅::BlockingSchedule, P, solver::ST=Ralston3()) where ST
    for block in reverse(𝔅.blocks[𝔅.idx])
        gpupdate!(P[block[end]]; solver=ST())
        for i in reverse(block[1:end-1])
            gpupdate!(P[i], P[i+1].H[1], P[i+1].Hν[1], P[i+1].c[1]; solver=ST())
        end
    end
end

"""
    proposalStartPt(::BlockingSchedule, ::Val{1}, ::Any, yPr, P, ρ)

Set a new starting point for the proposal path when sampling the first block in
a blocking scheme.

...
# Arguments
- `::BlockingSchedule`: indicator that a blocking scheme is used
- `::Val{1}`: indicator that it's the first block, so starting point needs updating
- `yPr`: prior over the starting point
- `P`: diffusion law
- `ρ`: memory parameter in the Crank-Nicolson scheme
...
"""
function proposalStartPt(::BlockingSchedule, ::Val{1}, ::Any, yPr, P, ρ)
    proposalStartPt(NoBlocking(), nothing, nothing, yPr, P, ρ)
end

"""
    proposalStartPt(::BlockingSchedule, ::Any, y₀, yPr, ::Any, ::Any)

Default behaviour of dealing with a starting point in the blocking scheme is
to do nothing
"""
function proposalStartPt(::BlockingSchedule, ::Any, y₀, yPr, ::Any, ::Any)
    y₀, yPr
end

"""
    proposalStartPt(::NoBlocking, ::Any, y₀, yPr, P, ρ)

Set a new starting point for the proposal path when no blocking is done
...
# Arguments
- `::NoBlocking`: indicator that no blocking is done
- `yPr`: prior over the starting point
- `P`: diffusion law
- `ρ`: memory parameter in the Crank-Nicolson scheme
...
"""
function proposalStartPt(::NoBlocking, ::Any, ::Any, yPr, P, ρ)
    yPrᵒ = rand(yPr, ρ)
    y = startPt(yPrᵒ, P)
    y, yPrᵒ
end

"""
    printInfo(verbose::Bool, it::Integer, ll, llᵒ, msg="update")

Print information to the console about current likelihood values

...
# Arguments
- `verbose`: flag for whether to print anything at all
- `it`: iteration of the Markov chain
- `ll`: likelihood of the previous, accepted sample
- `llᵒ`: likelihood of the proposal sample
- `msg`: message to start with
...
"""
function printInfo(verbose::Bool, it::Integer, ll, llᵒ, msg="update")
    verbose && print(msg, ": ", it, " ll ", round(ll, digits=3), " ",
                     round(llᵒ, digits=3), " diff_ll: ", round(llᵒ-ll,digits=3))
end

"""
    pathLogLikhd(::ObsScheme, XX, P, iRange, fpt; skipFPT=false)

Compute likelihood for path `XX` to be observed under `P`. Only segments with
index numbers in `iRange` are considered. `fpt` contains relevant info about
checks regarding adherence to first passage time pattern. `skipFPT` if set to
`true` can skip the step of checking adherence to fpt pattern (used for
conjugate updates, or any updates that keep `XX` unchanged)
"""
function pathLogLikhd(::ObsScheme, XX, P, iRange, fpt; skipFPT=false
                      ) where ObsScheme <: AbstractObsScheme
    ll = 0.0
    for i in iRange
        ll += llikelihood(LeftRule(), XX[i], P[i])
    end
    !skipFPT && (ll = checkFullPathFpt(ObsScheme(), XX, iRange, fpt) ? ll : -Inf)
    ll
end

"""
    swap!(A, Aᵒ, iRange)

Swap contents between containers A & Aᵒ in the index range iRange
"""
function swap!(A, Aᵒ, iRange)
    for i in iRange
        A[i], Aᵒ[i] = Aᵒ[i], A[i]
    end
end

"""
    swap!(A, Aᵒ, B, Bᵒ, iRange)

Swap contents between containers A & Aᵒ in the index range iRange, do the same
for containers B & Bᵒ
"""
function swap!(A, Aᵒ, B, Bᵒ, iRange)
    swap!(A, Aᵒ, iRange)
    swap!(B, Bᵒ, iRange)
end

"""
    crankNicolson!(yᵒ, y, ρ)

Preconditioned Crank Nicolson update with memory parameter `ρ`, previous vector
`y` and new vector `yᵒ`
"""
crankNicolson!(yᵒ, y, ρ) = (yᵒ .= √(1-ρ)*yᵒ + √(ρ)*y)

"""
    sampleSegment!(i, Wnr, WW, WWᵒ, P, y, XX, ρ)

Sample `i`th path segment using preconditioned Crank-Nicolson scheme
...
# Arguments
- `i`: index of the segment to be sampled
- `Wnr`: type of the Wiener process
- `WW`: containers with old Wiener paths
- `WWᵒ`: containers where proposal Wiener paths will be stored
- `P`: laws of the diffusion to be sampled
- `y`: starting point of the segment
- `XX`: containers for proposal diffusion path
- `ρ`: memory parameter for the Crank-Nicolson scheme
...
"""
function sampleSegment!(i, Wnr, WW, WWᵒ, P, y, XX, ρ)
    sample!(WWᵒ[i], Wnr)
    crankNicolson!(WWᵒ[i].yy, WW[i].yy, ρ)
    solve!(Euler(), XX[i], y, WWᵒ[i], P[i])
    XX[i].yy[end]
end

"""
    sampleSegments!(iRange, Wnr, WW, WWᵒ, P, y, XX, ρ)

Sample paths segments in index range `iRange` using preconditioned
Crank-Nicolson scheme
...
# Arguments
- `iRange`: range of indices of the segments that need to be sampled
- `Wnr`: type of the Wiener process
- `WW`: containers with old Wiener paths
- `WWᵒ`: containers where proposal Wiener paths will be stored
- `P`: laws of the diffusion to be sampled
- `y`: starting point of the segment
- `XX`: containers for proposal diffusion path
- `ρ`: memory parameter for the Crank-Nicolson scheme
...
"""
function sampleSegments!(iRange, Wnr, WW, WWᵒ, P, y, XX, ρ)
    for i in iRange
        y = sampleSegment!(i, Wnr, WW, WWᵒ, P, y, XX, ρ)
    end
end

"""
    impute!(::ObsScheme, 𝔅::NoBlocking, Wnr, yPr, WWᵒ, WW, XXᵒ, XX, P, ll, fpt;
            ρ=0.0, verbose=false, it=NaN, headStart=false) where
            ObsScheme <: AbstractObsScheme -> acceptedLogLikhd, acceptDecision

Imputation step of the MCMC scheme (without blocking).
...
# Arguments
- `::ObsScheme`: observation scheme---first-passage time or partial observations
- `Wnr`: type of the Wiener process
- `yPr`: prior over the starting point of the diffusion path
- `WWᵒ`: containers for proposal Wiener paths
- `WW`: containers with old Wiener paths
- `XXᵒ`: containers for proposal diffusion paths
- `XX`: containers with old diffusion paths
- `P`: laws of the diffusion path (proposal and target)
- `11`: log-likelihood of the old (previously accepted) diffusion path
- `fpt`: info about first-passage time conditioning
- `ρ`: memory parameter for the Crank-Nicolson scheme
- `verbose`: whether to print updates info while sampling
- `it`: iteration index of the MCMC algorithm
- `headStart`: flag for whether to 'ease into' fpt conditions
...
"""
function impute!(::ObsScheme, 𝔅::NoBlocking, Wnr, yPr, WWᵒ, WW, XXᵒ, XX, P, ll,
                 fpt; ρ=0.0, verbose=false, it=NaN, headStart=false,
                 solver::ST=Ralston3()) where
                 {ObsScheme <: AbstractObsScheme, ST}
    # sample proposal starting point
    yᵒ, yPrᵒ = proposalStartPt(𝔅, nothing, nothing, yPr, P[1], ρ)

    # sample proposal path
    m = length(WWᵒ)
    yᵗᵉᵐᵖ = copy(yᵒ)
    for i in 1:m
        sampleSegment!(i, Wnr, WW, WWᵒ, P, yᵗᵉᵐᵖ, XXᵒ, ρ)
        if headStart
            while !checkFpt(ObsScheme(), XXᵒ[i], fpt[i])
                sampleSegment!(i, Wnr, WW, WWᵒ, P, yᵗᵉᵐᵖ, XXᵒ, ρ)
            end
        end
        yᵗᵉᵐᵖ = XXᵒ[i].yy[end]
    end

    llᵒ = logpdf(yPrᵒ, yᵒ)
    llᵒ += pathLogLikhd(ObsScheme(), XXᵒ, P, 1:m, fpt)
    llᵒ += lobslikelihood(P[1], yᵒ)

    printInfo(verbose, it, value(ll), value(llᵒ), "impute")

    if acceptSample(llᵒ-ll, verbose)
        swap!(XX, XXᵒ, WW, WWᵒ, 1:m)
        return llᵒ, true, 𝔅, yPrᵒ
    else
        return ll, false, 𝔅, yPr
    end
end

#NOTE deprecated
"""
    swapXX!(𝔅::ChequeredBlocking, XX)

Swap containers between `XX` and `𝔅.XX`
"""
function swapXX!(𝔅::BlockingSchedule, XX)
    for block in 𝔅.blocks[𝔅.idx]
        swap!(XX, 𝔅.XX, block)
    end
end

#NOTE deprecated
"""
    swapXX!(𝔅::NoBlocking, XX)

nothing to do
"""
swapXX!(𝔅::NoBlocking, XX) = nothing

"""
    noiseFromPath!(𝔅::BlockingSchedule, XX, WW, P)

Compute driving Wiener noise `WW` from path `XX` drawn under law `P`
"""
function noiseFromPath!(𝔅::BlockingSchedule, XX, WW, P)
    for block in 𝔅.blocks[𝔅.idx]
        for i in block
            invSolve!(Euler(), XX[i], WW[i], P[i])
        end
    end
end

"""
    startPtLogPdf(::Val{1}, yPr::StartingPtPrior, y)

Compute the log-likelihood contribution of the starting point for a given prior
under a blocking scheme (intended to be used with a first block only)
"""
startPtLogPdf(::Val{1}, yPr::StartingPtPrior, y) = logpdf(yPr, y)

"""
    startPtLogPdf(::Any, yPr::StartingPtPrior, y)

Default contribution to log-likelihood from the startin point under blocking
"""
startPtLogPdf(::Any, yPr::StartingPtPrior, y) = 0.0

#NOTE deprecated
"""
    impute!(::ObsScheme, 𝔅::ChequeredBlocking, Wnr, y, WWᵒ, WW, XXᵒ, XX, P, ll,
            fpt; ρ=0.0, verbose=false, it=NaN, headStart=false) where
            ObsScheme <: AbstractObsScheme -> acceptedLogLikhd, acceptDecision

Imputation step of the MCMC scheme (without blocking).
...
# Arguments
- `::ObsScheme`: observation scheme---first-passage time or partial observations
- `𝔅`: object with relevant information about blocking
- `Wnr`: type of the Wiener process
- `yPr`: prior over the starting point of the diffusion path
- `WWᵒ`: containers for proposal Wiener paths
- `WW`: containers with old Wiener paths
- `XXᵒ`: containers for proposal diffusion paths
- `XX`: containers with old diffusion paths
- `P`: laws of the diffusion path (proposal and target)
- `11`: log-likelihood of the old (previously accepted) diffusion path
- `fpt`: info about first-passage time conditioning
- `ρ`: memory parameter for the Crank-Nicolson scheme
- `verbose`: whether to print updates info while sampling
- `it`: iteration index of the MCMC algorithm
- `headStart`: flag for whether to 'ease into' fpt conditions
...
"""
function impute!_deprecated(::ObsScheme, 𝔅::ChequeredBlocking, Wnr, yPr, WWᵒ, WW, XXᵒ, XX,
                 P, ll, fpt; ρ=0.0, verbose=false, it=NaN, headStart=false,
                 solver::ST=Ralston3()) where
                 {ObsScheme <: AbstractObsScheme, ST}
    θ = params(P[1].Target)             # current parameter
    𝔅 = next(𝔅, XX, θ)
    solveBackRec!(𝔅, 𝔅.P, ST())         # compute (H, Hν, c) for given blocks

    swapXX!(𝔅, XX)                      # move current path to object 𝔅
    noiseFromPath!(𝔅, 𝔅.XX, 𝔅.WW, 𝔅.P) # find noise WW that generates XX under 𝔅

    # compute white noise generating starting point under 𝔅
    yPr𝔅 = invStartPt(𝔅.XX[1].yy[1], yPr, 𝔅.P[1])

    for (blockIdx, block) in enumerate(𝔅.blocks[𝔅.idx])
        blockFlag = Val{block[1]}()
        y = 𝔅.XX[block[1]].yy[1]       # current starting point

        # set the starting point for the block
        yᵒ, yPrᵒ = proposalStartPt(𝔅, blockFlag, y, yPr𝔅, 𝔅.P[block[1]], ρ)

        # sample path in block
        sampleSegments!(block, Wnr, 𝔅.WW, 𝔅.WWᵒ, 𝔅.P, yᵒ, 𝔅.XXᵒ, ρ)
        setEndPtManually!(𝔅, blockIdx, block)

        # loglikelihoods
        llᵒ = startPtLogPdf(blockFlag, yPrᵒ, yᵒ)
        llᵒ += pathLogLikhd(ObsScheme(), 𝔅.XXᵒ, 𝔅.P, block, fpt)
        llᵒ += lobslikelihood(𝔅.P[block[1]], yᵒ)

        llPrev = startPtLogPdf(blockFlag, yPr𝔅, y)
        llPrev += pathLogLikhd(ObsScheme(), 𝔅.XX, 𝔅.P, block, fpt; skipFPT=true)
        llPrev += lobslikelihood(𝔅.P[block[1]], y)

        printInfo(verbose, it, value(llPrev), value(llᵒ), "impute")
        if acceptSample(llᵒ-llPrev, verbose)
            swap!(𝔅.XX, 𝔅.XXᵒ, block)
            registerAccpt!(𝔅, blockIdx, true)
            yPr𝔅 = yPrᵒ # can do something non-trivial only for the first block
        else
            registerAccpt!(𝔅, blockIdx, false)
        end
    end
    swapXX!(𝔅, XX) # move accepted path from object 𝔅 to general container XX
    noiseFromPath!(𝔅, XX, WW, P) # compute noise WW that generated XX under law P
    # compute white noise generating starting point under P
    y = XX[1].yy[1]
    yPr = invStartPt(y, yPr𝔅, P[1])

    ll = logpdf(yPr, y) # starting point contribution
    ll += pathLogLikhd(ObsScheme(), XX, P, 1:length(P), fpt; skipFPT=true)
    ll += lobslikelihood(P[1], y)

    # acceptance indicator does not matter for sampling with blocking
    return ll, true, 𝔅, yPr
end

"""
    impute!(::ObsScheme, 𝔅::ChequeredBlocking, Wnr, y, WWᵒ, WW, XXᵒ, XX, P, ll,
            fpt; ρ=0.0, verbose=false, it=NaN, headStart=false) where
            ObsScheme <: AbstractObsScheme -> acceptedLogLikhd, acceptDecision

Imputation step of the MCMC scheme (without blocking).
...
# Arguments
- `::ObsScheme`: observation scheme---first-passage time or partial observations
- `𝔅`: object with relevant information about blocking
- `Wnr`: type of the Wiener process
- `yPr`: prior over the starting point of the diffusion path
- `WWᵒ`: containers for proposal Wiener paths
- `WW`: containers with old Wiener paths
- `XXᵒ`: containers for proposal diffusion paths
- `XX`: containers with old diffusion paths
- `P`: laws of the diffusion path (proposal and target)
- `11`: log-likelihood of the old (previously accepted) diffusion path
- `fpt`: info about first-passage time conditioning
- `ρ`: memory parameter for the Crank-Nicolson scheme
- `verbose`: whether to print updates info while sampling
- `it`: iteration index of the MCMC algorithm
- `headStart`: flag for whether to 'ease into' fpt conditions
...
"""
function impute!(::ObsScheme, 𝔅::ChequeredBlocking, Wnr, yPr, WWᵒ, WW, XXᵒ, XX,
                 P, ll, fpt; ρ=0.0, verbose=false, it=NaN, headStart=false,
                 solver::ST=Ralston3()
                 ) where {ObsScheme <: AbstractObsScheme, ST}
    θ = params(𝔅.P[1].Target)             # current parameter
    𝔅 = next(𝔅, 𝔅.XX, θ)
    solveBackRec!(𝔅, 𝔅.P, ST())         # compute (H, Hν, c) for given blocks
    noiseFromPath!(𝔅, 𝔅.XX, 𝔅.WW, 𝔅.P) # find noise WW that generates XX under 𝔅.P

    # compute white noise generating starting point under 𝔅
    yPr = invStartPt(𝔅.XX[1].yy[1], yPr, 𝔅.P[1])

    ll_total = 0.0
    for (blockIdx, block) in enumerate(𝔅.blocks[𝔅.idx])
        blockFlag = Val{block[1]}()
        y = 𝔅.XX[block[1]].yy[1]       # accepted starting point

        # proposal starting point for the block (can be non-y only for the first block)
        yᵒ, yPrᵒ = proposalStartPt(𝔅, blockFlag, y, yPr, 𝔅.P[block[1]], ρ)

        # sample path in block
        sampleSegments!(block, Wnr, 𝔅.WW, 𝔅.WWᵒ, 𝔅.P , yᵒ, 𝔅.XXᵒ, ρ)
        setEndPtManually!(𝔅, blockIdx, block)

        # starting point, path and observations contribution
        llᵒ = startPtLogPdf(blockFlag, yPrᵒ, yᵒ)
        llᵒ += pathLogLikhd(ObsScheme(), 𝔅.XXᵒ, 𝔅.P, block, fpt)
        llᵒ += lobslikelihood(𝔅.P[block[1]], yᵒ)

        llPrev = startPtLogPdf(blockFlag, yPr, y)
        llPrev += pathLogLikhd(ObsScheme(), 𝔅.XX, 𝔅.P, block, fpt; skipFPT=true)
        llPrev += lobslikelihood(𝔅.P[block[1]], y)

        printInfo(verbose, it, value(llPrev), value(llᵒ), "impute")
        if acceptSample(llᵒ-llPrev, verbose)
            swap!(𝔅.XX, 𝔅.XXᵒ, block)
            registerAccpt!(𝔅, blockIdx, true)
            yPr = yPrᵒ # can do something non-trivial only for the first block
            ll_total += llᵒ
        else
            registerAccpt!(𝔅, blockIdx, false)
            ll_total += llPrev
        end
    end
    # acceptance indicator does not matter for sampling with blocking
    return ll_total, true, 𝔅, yPr
end

"""
    updateLaws!(Ps, θᵒ)

Set new parameter `θᵒ` for the laws in vector `Ps`
"""
function updateLaws!(Ps, θᵒ)
    m = length(Ps)
    for i in 1:m
        Ps[i] = GuidPropBridge(Ps[i], θᵒ)
    end
end

"""
    updateTargetLaws!(𝔅::NoBlocking, θᵒ)

Nothing to do
"""
updateTargetLaws!(𝔅::NoBlocking, θᵒ) = nothing

"""
    updateTargetLaws!(𝔅::BlockingSchedule, θᵒ)

Set new parameter `θᵒ` for the target laws in blocking object `𝔅`
"""
function updateTargetLaws!(𝔅::BlockingSchedule, θᵒ)
    for block in 𝔅.blocks[𝔅.idx]
        for i in block
            𝔅.P[i] = GuidPropBridge(𝔅.P[i], θᵒ)
        end
    end
end

"""
    updateProposalLaws!(𝔅::BlockingSchedule, θᵒ)

Set new parameter `θᵒ` for the proposal laws inside blocking object `𝔅`
"""
function updateProposalLaws!(𝔅::BlockingSchedule, θᵒ)
    for block in 𝔅.blocks[𝔅.idx]
        for i in block
            𝔅.Pᵒ[i] = GuidPropBridge(𝔅.Pᵒ[i], θᵒ)
        end
    end
end

"""
    findPathFromWiener!(XX, y, WW, P, iRange)

Find path `XX` (that starts from `y`) that is generated under law `P` from the
Wiener process `WW`. Only segments with indices in range `iRange` are considered
"""
function findPathFromWiener!(XX, y, WW, P, iRange)
    for i in iRange
        solve!(Euler(), XX[i], y, WW[i], P[i])
        y = XX[i].yy[end]
    end
end

"""
    priorKernelContrib(tKern, priors, θ, θᵒ)

Contribution to the log-likelihood ratio from transition kernel `tKernel` and
`priors`.
"""
function priorKernelContrib(tKern, priors, θ, θᵒ)
    llr = logpdf(tKern, θᵒ, θ) - logpdf(tKern, θ, θᵒ)
    for prior in priors
        llr += logpdf(prior, θᵒ) - logpdf(prior, θ)
    end
    llr
end

"""
    setEndPtManually!(𝔅::BlockingSchedule, blockIdx, block)

Manually set the end-point of the proposal path under blocking so that it agrees
with the end-point of the previously accepted path. If it is the last block,
then do nothing
"""
function setEndPtManually!(𝔅::BlockingSchedule, blockIdx, block)
    if blockIdx < length(𝔅.blocks[𝔅.idx])
        𝔅.XXᵒ[block[end]].yy[end] = 𝔅.XX[block[end]].yy[end]
    end
end

"""
    updateParam!(::ObsScheme, ::MetropolisHastingsUpdt, tKern, θ, ::UpdtIdx,
                 yPr, WW, Pᵒ, P, XXᵒ, XX, ll, prior, fpt, recomputeODEs;
                 solver::ST=Ralston3(), verbose=false,
                 it=NaN) where {ObsScheme <: AbstractObsScheme, ST, UpdtIdx}
                 -> acceptedLogLikhd, acceptDecision
Update parameters
...
# Arguments
- `::ObsScheme`: observation scheme---first-passage time or partial observations
- `::MetropolisHastingsUpdt()`: type of the parameter update
- `tKern`: transition kernel
- `θ`: current value of the parameter
- `updtIdx`: object declaring indices of the updated parameter
- `yPr`: prior over the starting point of the diffusion path
- `WW`: containers with Wiener paths
- `Pᵒ`: container for the laws of the diffusion path with new parametrisation
- `P`: laws of the diffusion path with old parametrisation
- `XXᵒ`: containers for proposal diffusion paths
- `XX`: containers with old diffusion paths
- `11`: likelihood of the old (previously accepted) parametrisation
- `priors`: list of priors
- `fpt`: info about first-passage time conditioning
- `recomputeODEs`: whether auxiliary law depends on the updated params
- `verbose`: whether to print updates info while sampling
- `it`: iteration index of the MCMC algorithm
...
"""
function updateParam!(::ObsScheme, ::MetropolisHastingsUpdt, 𝔅::NoBlocking,
                      tKern, θ, ::UpdtIdx, yPr, WW, Pᵒ, P, XXᵒ, XX, ll, priors,
                      fpt, recomputeODEs; solver::ST=Ralston3(), verbose=false,
                      it=NaN) where {ObsScheme <: AbstractObsScheme, ST, UpdtIdx}
    m = length(WW)
    θᵒ = rand(tKern, θ, UpdtIdx())               # sample new parameter
    updateLaws!(Pᵒ, θᵒ)
    recomputeODEs && solveBackRec!(NoBlocking(), Pᵒ, ST()) # compute (H, Hν, c)

    # find white noise which for a given θᵒ gives a correct starting point
    y = XX[1].yy[1]
    yPrᵒ = invStartPt(y, yPr, Pᵒ[1])

    findPathFromWiener!(XXᵒ, y, WW, Pᵒ, 1:m)

    llᵒ = logpdf(yPrᵒ, y)
    llᵒ += pathLogLikhd(ObsScheme(), XXᵒ, Pᵒ, 1:m, fpt)
    llᵒ += lobslikelihood(Pᵒ[1], y)

    printInfo(verbose, it, ll, llᵒ)

    llr = ( llᵒ - ll + priorKernelContrib(tKern, priors, θ, θᵒ))

    # Accept / reject
    if acceptSample(llr, verbose)
        swap!(XX, XXᵒ, P, Pᵒ, 1:m)
        return llᵒ, true, θᵒ, yPrᵒ
    else
        return ll, false, θ, yPr
    end
end

"""
    updateParam!(::ObsScheme, ::MetropolisHastingsUpdt, tKern, θ, ::UpdtIdx,
                 yPr, WW, Pᵒ, P, XXᵒ, XX, ll, prior, fpt, recomputeODEs;
                 solver::ST=Ralston3(), verbose=false,
                 it=NaN) where {ObsScheme <: AbstractObsScheme, ST, UpdtIdx}
                 -> acceptedLogLikhd, acceptDecision
Update parameters
...
# Arguments
- `::ObsScheme`: observation scheme---first-passage time or partial observations
- `::MetropolisHastingsUpdt()`: type of the parameter update
- `tKern`: transition kernel
- `θ`: current value of the parameter
- `updtIdx`: object declaring indices of the updated parameter
- `yPr`: prior over the starting point of the diffusion path
- `WW`: containers with Wiener paths
- `Pᵒ`: container for the laws of the diffusion path with new parametrisation
- `P`: laws of the diffusion path with old parametrisation
- `XXᵒ`: containers for proposal diffusion paths
- `XX`: containers with old diffusion paths
- `11`: likelihood of the old (previously accepted) parametrisation
- `priors`: list of priors
- `fpt`: info about first-passage time conditioning
- `recomputeODEs`: whether auxiliary law depends on the updated params
- `verbose`: whether to print updates info while sampling
- `it`: iteration index of the MCMC algorithm
...
"""
function updateParam!(::ObsScheme, ::MetropolisHastingsUpdt,
                      𝔅::ChequeredBlocking, tKern, θ, ::UpdtIdx,
                      yPr, WW, Pᵒ, P, XXᵒ, XX, ll, priors, fpt, recomputeODEs;
                      solver::ST=Ralston3(), verbose=false,
                      it=NaN) where {ObsScheme <: AbstractObsScheme, ST, UpdtIdx}
    m = length(WW)
    θᵒ = rand(tKern, θ, UpdtIdx())               # sample new parameter
    updateProposalLaws!(𝔅, θᵒ)                   # update law `Pᵒ` accordingly
    solveBackRec!(𝔅, 𝔅.Pᵒ, ST())                 # compute (H, Hν, c)

    llᵒ = logpdf(yPr, 𝔅.XX[1].yy[1])
    for (blockIdx, block) in enumerate(𝔅.blocks[𝔅.idx])
        y = 𝔅.XX[block[1]].yy[1]
        findPathFromWiener!(𝔅.XXᵒ, y, 𝔅.WW, 𝔅.Pᵒ, block)
        setEndPtManually!(𝔅, blockIdx, block)

        # Compute log-likelihood ratio
        llᵒ += pathLogLikhd(ObsScheme(), 𝔅.XXᵒ, 𝔅.Pᵒ, block, fpt)
        llᵒ += lobslikelihood(𝔅.Pᵒ[block[1]], y)
    end
    printInfo(verbose, it, ll, llᵒ)

    llr = ( llᵒ - ll + priorKernelContrib(tKern, priors, θ, θᵒ))

    # Accept / reject
    if acceptSample(llr, verbose)
        swap!(𝔅.XX, 𝔅.XXᵒ, 𝔅.P, 𝔅.Pᵒ, 1:m)
        return llᵒ, true, θᵒ, yPr
    else
        return ll, false, θ, yPr
    end
end

fetchTargetLaw(𝔅::NoBlocking, P) = P[1].Target

fetchTargetLaw(𝔅::BlockingSchedule, P) = 𝔅.P[1].Target

"""
    updateParam!(::PartObs, ::ConjugateUpdt, tKern, θ, ::UpdtIdx, yPr, WW, Pᵒ,
                 P, XXᵒ, XX, ll, priors, fpt, recomputeODEs;
                 solver::ST=Ralston3(), verbose=false, it=NaN
                 ) -> acceptedLogLikhd, acceptDecision
Update parameters
see the definition of  updateParam!(…, ::MetropolisHastingsUpdt, …) for the
explanation of the arguments.
"""
function updateParam!(::ObsScheme, ::ConjugateUpdt, 𝔅::NoBlocking,
                      tKern, θ, ::UpdtIdx, yPr, WW, Pᵒ, P, XXᵒ, XX, ll, priors,
                      fpt, recomputeODEs; solver::ST=Ralston3(), verbose=false,
                      it=NaN) where {ObsScheme <: AbstractObsScheme, ST, UpdtIdx}
    m = length(P)
    ϑ = conjugateDraw(θ, XX, P[1].Target, priors[1], UpdtIdx())   # sample new parameter
    θᵒ = moveToProperPlace(ϑ, θ, UpdtIdx())     # align so that dimensions agree

    updateLaws!(P, θᵒ)
    recomputeODEs && solveBackRec!(NoBlocking(), P, ST()) # compute (H, Hν, c)

    for i in 1:m    # compute wiener path WW that generates XX
        invSolve!(Euler(), XX[i], WW[i], P[i])
    end
    # compute white noise that generates starting point
    y = XX[1].yy[1]
    yPr = invStartPt(y, yPr, P[1])

    llᵒ = logpdf(yPr, y)
    llᵒ += pathLogLikhd(ObsScheme(), XX, P, 1:m, fpt; skipFPT=true)
    llᵒ += lobslikelihood(P[1], y)
    printInfo(verbose, it, value(ll), value(llᵒ))
    return llᵒ, true, θᵒ, yPr
end

"""
    updateParam!(::PartObs, ::ConjugateUpdt, tKern, θ, ::UpdtIdx, yPr, WW, Pᵒ,
                 P, XXᵒ, XX, ll, priors, fpt, recomputeODEs;
                 solver::ST=Ralston3(), verbose=false, it=NaN
                 ) -> acceptedLogLikhd, acceptDecision
Update parameters
see the definition of  updateParam!(…, ::MetropolisHastingsUpdt, …) for the
explanation of the arguments.
"""
function updateParam!(::ObsScheme, ::ConjugateUpdt, 𝔅::BlockingSchedule,
                      tKern, θ, ::UpdtIdx, yPr, WW, Pᵒ, P, XXᵒ, XX, ll, priors,
                      fpt, recomputeODEs; solver::ST=Ralston3(), verbose=false,
                      it=NaN) where {ObsScheme <: AbstractObsScheme, ST, UpdtIdx}
    m = length(P)
    ϑ = conjugateDraw(θ, 𝔅.XX, 𝔅.P[1].Target, priors[1], UpdtIdx())   # sample new parameter
    θᵒ = moveToProperPlace(ϑ, θ, UpdtIdx())     # align so that dimensions agree

    updateTargetLaws!(𝔅, θᵒ)
    recomputeODEs && solveBackRec!(𝔅, 𝔅.P, ST())
    for i in 1:m    # compute wiener path WW that generates XX
        invSolve!(Euler(), 𝔅.XX[i], 𝔅.WW[i], 𝔅.P[i])
    end
    # compute white noise that generates starting point
    y = 𝔅.XX[1].yy[1]
    yPr = invStartPt(y, yPr, 𝔅.P[1])
    llᵒ = logpdf(yPr, y)
    for block in 𝔅.blocks[𝔅.idx]
        llᵒ += pathLogLikhd(ObsScheme(), 𝔅.XX, 𝔅.P, block, fpt; skipFPT=true)
        llᵒ += lobslikelihood(𝔅.P[block[1]], 𝔅.XX[block[1]].yy[1])
    end
    printInfo(verbose, it, value(ll), value(llᵒ))
    return llᵒ, true, θᵒ, yPr
end

"""
    mcmc(::ObsScheme, obs, obsTimes, yPr::StartingPtPrior, w, P˟, P̃, Ls, Σs,
         numSteps, tKernel, priors; fpt=fill(NaN, length(obsTimes)-1), ρ=0.0,
         dt=1/5000, timeChange=true, saveIter=NaN, verbIter=NaN,
         updtCoord=(Val((true,)),), paramUpdt=true, skipForSave=1,
         updtType=(MetropolisHastingsUpdt(),), solver::ST=Ralston3(), warmUp=0)

Gibbs sampler alternately imputing unobserved parts of the path and updating
unknown coordinates of the parameter vector (the latter only if paramUpdt==true)
...
# Arguments
- `::ObsScheme`: observation scheme---first-passage time or partial observations
- `obs`: vector with observations
- `obsTimes`: times of the observations
- `yPr`: prior over the starting point of the diffusion path
- `w`: dummy variable whose type must agree with the type of the Wiener process
- `P˟`: law of the target diffusion (with initial θ₀ set)
- `P̃`: law of the auxiliary process (with initial θ₀ set)
- `Ls`: vector of observation operators (one per each observation)
- `Σs`: vector of covariance matrices of the noise (one per each observaiton)
- `numSteps`: number of mcmc iterations
- `tKernel`: transition kernel (also with initial θ₀ set)
- `priors`: a list of lists of priors
- `τ`: time-change transformation
- `fpt`: info about first-passage time conditioning
- `ρ`: memory parameter for the Crank-Nicolson scheme
- `dt`: time-distance for the path imputation
- `saveIter`: save path `XX` once every `saveIter` many iterations
- `verbIter`: print out progress info once every `verbIter` many iterations
- `updtCoord`: list of objects declaring indices of to-be-updated parameters
- `paramUpdt`: flag for whether to update parameters at all
- `skipForSave`: when saving paths, save only one in every `skipForSave` points
- `updtType`: list of types of updates to cycle through
- `solver`: numerical solver used for computing backward ODEs
- `warmUp`: number of steps for which no parameter update is to be made
...
"""
function mcmc(::Type{K}, ::ObsScheme, obs, obsTimes, yPr::StartingPtPrior, w,
              P˟, P̃, Ls, Σs, numSteps, tKernel, priors, τ;
              fpt=fill(NaN, length(obsTimes)-1), ρ=0.0, dt=1/5000, saveIter=NaN,
              verbIter=NaN, updtCoord=(Val((true,)),), paramUpdt=true,
              skipForSave=1, updtType=(MetropolisHastingsUpdt(),),
              blocking::Blocking=NoBlocking(),
              blockingParams=([], 0.1, NoChangePt()),
              solver::ST=Ralston3(), changePt::CP=NoChangePt(), warmUp=0
              ) where {K, ObsScheme <: AbstractObsScheme, ST, Blocking, CP}
    P = findProposalLaw( K, obs, obsTimes, P˟, P̃, Ls, Σs, τ; dt=dt, solver=ST(),
                         changePt=CP(getChangePt(blockingParams[3])) )
    m = length(obs)-1
    updtLen = length(updtCoord)
    Wnr, WWᵒ, WW, XXᵒ, XX, Pᵒ, ll, yPr = initialise(ObsScheme(), P, m, yPr, w,
                                                    fpt)
    Paths = []
    accImpCounter = 0
    accUpdtCounter = [0 for i in 1:updtLen]
    θ = params(P˟)
    θchain = Vector{typeof(θ)}(undef, (numSteps-warmUp)*updtLen+1)
    θchain[1] = copy(θ)
    recomputeODEs = [any([e in dependsOnParams(P[1].Pt) for e
                         in idx(uc)]) for uc in updtCoord]

    updtStepCounter = 1
    𝔅 = setBlocking(blocking, blockingParams, P, WW, XX)
    display(𝔅)
    for i in 1:numSteps
        verbose = (i % verbIter == 0)
        i > warmUp && savePath!(Paths, blocking == NoBlocking() ? XX : 𝔅.XX,
                                (i % saveIter == 0), skipForSave)
        ll, acc, 𝔅, yPr = impute!(ObsScheme(), 𝔅, Wnr, yPr, WWᵒ, WW, XXᵒ, XX,
                                  P, ll, fpt, ρ=ρ, verbose=verbose, it=i,
                                  solver=ST())
        accImpCounter += 1*acc
        if paramUpdt && i > warmUp
            for j in 1:updtLen
                (ll, acc, θ,
                 yPr) = updateParam!(ObsScheme(), updtType[j], 𝔅, tKernel, θ,
                                     updtCoord[j], yPr, WW, Pᵒ, P, XXᵒ, XX, ll,
                                     priors[j], fpt, recomputeODEs[j];
                                     solver=ST(), verbose=verbose, it=i)
                accUpdtCounter[j] += 1*acc
                updtStepCounter += 1
                θchain[updtStepCounter] = copy(θ)
                verbose && print("\n")
            end
            verbose && print("------------------------------------------------",
                             "------\n")
        end
    end
    displayAcceptanceRate(𝔅)
    Time = collect(Iterators.flatten(p.tt[1:skipForSave:end-1] for p in P))
    θchain, accImpCounter/numSteps, accUpdtCounter./numSteps, Paths, Time
end


"""
@axpy
@ascal
@dot

BLAS Level 1 functions.
"""

macro axpy(a, x, y)
    expr = quote
        let u = $(esc(a))
            for i in eachindex($(esc(x)))
                @inbounds $(esc(y))[i] += u * $(esc(x))[i]
            end
        end
    end
    expr
end

macro scal(a, x)
    expr = quote
        let u = $(esc(a))
            for i in eachindex($(esc(x)))
                @inbounds $(esc(x))[i] *= u
            end
        end
    end
    expr
end

macro dot(x, y)
    expr = quote
        s = 0
        for i in eachindex($(esc(x)))
            @inbounds s += $(esc(x))[i] * $(esc(y))[i]
        end
        s
    end
    expr
end

"""
itime(t)

Get interval time from a given cumulative time vector t.
The first element is t[1]

Retuen value:
dt: interval time vector
maxt: maximum interval time
"""

function itime(t::AbstractVector{Tv}) where Tv
    dt = similar(t)
    prev = Tv(0)
    maxt = Tv(0)
    @inbounds for i = eachindex(t)
        dt[i] = t[i] - prev
        prev = t[i]
        if dt[i] > maxt
            maxt = dt[i]
        end
    end
    return dt, maxt
end