# This script reads a file in gen format containing polygons and stores them
# in a Julia array. The sequence of polygons can be plotted using a plotting
# backend, such as GR, PyPlot, or Gadfly.
#
# EXAMPLES:
#
# We load the results for the BEAM model, which contain 20000 polygons:
#
#     julia> include("plot_gen.jl")
#     julia> using Reachability
#     julia> import GR
#     julia> Xk = read_gen("SpaceEx_plots/beam_t_x89_20_spaceex.txt");
#     julia> R = ReachSolution(Xk, Options(:plot_vars => [1,2]));
#     julia> plot(R)
#     alternative, more spohisticated plotting command
#     julia> plot(R, color="red", xlabel="t", ylabel = "x89", ylims=(-55000, 55000))

# choose a plotting backend, eg. PyPlot or Gadfly
using Plots, LazySets

"""
    read_gen(filename)

Read a sequence of polygons stored in vertex representation (gen format).

### Input

- `filename` -- path of the file containing the polygons

The x and y coordinates of each vertex are separated by an empty space, and
polygons are separated by empty lines. For example:

```
1.01 1.01
0.99 1.01
0.99 0.99
1.01 0.99

0.908463 1.31047
0.873089 1.31047
0.873089 1.28452
0.908463 1.28452
```

### Output

A sequence of matrices, where the first row is for the x coordinates, and the
second row for the y coordinates.

In the example of above:

```julia
    julia> P = read_gen("test.gen")
    2-element Array{Array{Float64,2},1}:
     [1.01 0.99 0.99 1.01; 1.01 1.01 0.99 0.99]
     [0.908463 0.873089 0.873089 0.908463; 1.31047 1.31047 1.28452 1.28452]
```

### Warning

The input file should end with at least one empty line before the end of files
this is to detect the last polygon.
"""
function read_gen(filename::String)
    Mi = Vector{Vector{Float64}}()
    P = Vector{VPolygon{Float64}}()
    # detects when we finished reading a new polygon, needed because polygons
    # may be separated by more than one end-of-line
    new_polygon = true
    open(filename) do f
        for line in eachline(f)
          if !isempty(line)
              push!(Mi, map(x -> parse(Float64, x), split(line)))
              new_polygon = true
          elseif isempty(line) && new_polygon
              push!(P, VPolygon(Mi))
              Mi = Vector{Vector{Float64}}()
              new_polygon = false
          end
        end
    end
    return P
end

function read_gen_old(filename::String)::Array{Matrix{Float64}, 1}
    Mi = Array{Vector{Float64}, 1}()
    P = Array{Matrix{Float64}, 1}()
    # detects when we finished reading a new polygon, needed because polygons
    # may be separated by more than one end-of-line
    new_polygon = true
    open(filename) do f
        for line in eachline(f)
          if !isempty(line)
              push!(Mi, map(x -> parse(Float64, x), split(line)))
              new_polygon = true
          elseif isempty(line) && new_polygon
              push!(P, hcat(Mi...))
              Mi = Array{Vector{Float64}, 1}()
              new_polygon = false
          end
        end
    end
    return P
end

"""
    plot_polygon(P; backend, [name], [gridlines], [plot_polygon])

Plot one or more polygons given as an array of matrices.

INPUT:

- ``P`` -- a polygon, given as a list of matrices, where the first row is for
           the x coordinates and the second row for the y coordinates
- ``backend``     -- (optional, default: ``'pyplot'``): select the plot backend; valid
  options are:
                 -  ``'pyplot_savefig'`` -- use PyPlot package, save to a file
                 -  ``'pyplot_inline'`` -- use PyPlot package, showing in external program
                 - ``'gadfly'`` -- use Gadfly package, showing in browser
                 - ``''`` -- (empty string), return nothing, without plotting
- ``name``        -- (optional, default: ``'plot.png'``) the filename of the plot
  (if it is saved to disk)
- ``gridlines``   -- (optional, default: false) to display or not gridlines in
                   the output plot
- ``color``       -- (optional, default: ``'red'``) the color of the plotting lines
- ``plot_labels`` -- (optional, default: ``['', '']``) the labels of the axes
"""
function plot_polygon(P::Array{Matrix{Float64}, 1};
                      backend="pyplot_savefig",
                      name="plot.png",
                      gridlines=false,
                      color="red",
                      plot_labels::Vector{String}=["", ""])
    if backend in ["pyplot_inline", "pyplot_savefig"]
        if !isdefined(:PyPlot)
            error("this backend requires that your script loads the PyPlot module")
        end
        eval(Expr(:using, :PyPlot))
        if backend == "pyplot_savefig"
            PyPlot.ioff()  # turn off interactive plotting
            fig = PyPlot.figure()
        end
        gridlines ? grid("on") : grid("off")
        # check if P is iterable
        applicable(start, P) ? nothing : P = [P]
        PyPlot.xlabel(plot_labels[1])
        PyPlot.ylabel(plot_labels[2])
        for pi in P
            xcoords = pi[1, :]
            ycoords = pi[2, :]
            PyPlot.plot(xcoords, ycoords, color=color, linewidth=0.6)
        end
        if backend == "pyplot_savefig"
            PyPlot.savefig(name, bbox_inches="tight")
            PyPlot.close(fig)
        end

    elseif backend in ["gadfly"]
        if !isdefined(:Gadfly)
            error("this backend requires that your script loads the Gadfly module")
        end
        eval(Expr(:using, :Gadfly))
        layers_array = []
        # check if P is iterable
        applicable(start, P) ? nothing : P = [P]
        for pi in P
            xcoords = pi[1, :]
            ycoords = pi[2, :]
            push!(layers_array, Gadfly.layer(x=xcoords, y=ycoords, Geom.polygon(preserve_order=false, fill=true)))
        end
        Gadfly.plot(layers_array...)

    elseif backend == ""
        return nothing
    else
        error("plot backend not valid")
    end
end

"""
    plot_all(path)

Plot all txt files (in gen format) of a specified folder.

INPUT:

- ``path`` -- (optional, default: ``'.'``, the current directory) this is the
              directory where the data files are located

OUTUPT:

One or more files with the extension ``.txt.png``.

To give an idea, for 6 files where each file contains 20000 polygons,
it takes around 30 minutes.
"""
function plot_all(path::String=".")
    files = filter(x -> contains(x, ".txt"), readdir(path))
    for f in files
        println("Plotting ", f)
        plot_polygon(read_gen(f), name=f * ".png", gridlines=true)
    end
end

return nothing


module BridgeSampling
using Turing, StatsBase, Printf
using LinearAlgebra: dot
import Base: show

include("iterative_algorithm.jl")
include("proposal.jl")
include("transform.jl")
include("model_interface.jl")
include("formatting.jl")
include("error_estimate.jl")

export bridgesampling, value, error_estimate, bayes_factor, posterior_probabilities, show

struct LogMarginalLikelihood{TV}
    value::Float64
    niter::Int
    p_posterior::TV
    g_posterior::TV
    p_proposal::TV
    g_proposal::TV
end

"""
    bridgesampling(samples, log_posterior, lb, ub; tol, maxiter, names)

    Estimates the log marginal likelihood with bridge sampling, given a matrix of posterior samples and an unnormalized log posterior function.

    # Arguments
    * `samples` : An ndims x nsamples matrix. The eltype can be either a scalar or an array of any dimension (e.g. multivariate parameters)
    * `log_posterior` : A function that takes one argument (one sample) and outputs the unnormalized log posterior probability (log joint)
    * `lb` and `ub` : respectively the lower and upper boundary of each dimension in the samples
    * `tol` : tolerance for the iterative scheme. Default = `1e-10`
    * `maxiter` : maximum number of iterations of the iterative scheme. Default = `1000`
    * `names` : A vector of names for each dimension in the samples. If specified, the input argument of `log_posterior` will be a `NamedTuple`. Default = `nothing`

    # Examples
    ```julia
        # Bivariate standard normal distribution
        samples = rand(MvNormal(ones(2)), 10_000)

        log_posterior(x) = -0.5 * x' * x

        Bridge = bridgesampling(samples, log_posterior, [-Inf, -Inf], [Inf, Inf])
    ```

    # Sources
        Quentin F. Gronau, Alexandra Sarafoglou, Dora Matzke, Alexander Ly, Udo Boehm, Maarten Marsman, David S. Leslie, Jonathan J. Forster, Eric-Jan Wagenmakers, Helen Steingroever,
        A tutorial on bridge sampling,
        Journal of Mathematical Psychology,
        Volume 81,
        2017,
        Pages 80-97,
        ISSN 0022-2496,
        https://doi.org/10.1016/j.jmp.2017.09.005.
"""
function bridgesampling(samples::AbstractMatrix, log_posterior::Function, lb, ub; tol=1e-10, maxiter=1_000, names=nothing)
    lb = informissing.(lb)
    ub = informissing.(ub)
    nd, ns = size(samples)
    nd < ns || @warn "The number of samples ($ns) is lower than the number of dimensions ($nd). Make sure the samples matrix is ndim x nsamples."

    ## Split samples
    smp1 = samples[:,1:2:end]
    smp2 = samples[:,2:2:end]
    n₁ = size(smp1, 2)
    n₂ = size(smp2, 2)

    ## Transform samples
    trans_smp1 = transform(smp1, lb, ub)
    trans_smp2 = transform(smp2, lb, ub)
    wide_smp1, name_map = check_samples(trans_smp1, names) # widen the transformed samples to match with the MvNormal proposal
    wide_smp2, _ = check_samples(trans_smp2, names)

    ## Fit the proposal
    prop_dist = proposal(wide_smp2)

    ## Sample from the proposal
    prop_samples = rand(prop_dist, n₂)
    comp_prop_smp = format_samples(prop_samples, name_map) # Reformat for posterior evaluation
    comp_prop_smp = invtransform(comp_prop_smp, lb, ub) # Inverse transform to evaluate the posterior

    ## Get the (log) pdf for each sample for both distributions
    p_post, g_post, l₁ = get_pdf_samples(smp1, wide_smp1, log_posterior, prop_dist, lb, ub, names)
    p_prop, g_prop, l₂ = get_pdf_samples(comp_prop_smp, prop_samples, log_posterior, prop_dist, lb, ub, names)

    ## Iterative algorithm
    logml, i = iterative_algorithm(l₁, l₂, n₁, n₂; tol=tol, maxiter=maxiter)
    return LogMarginalLikelihood(logml, i, p_post, g_post, p_prop, g_prop)
end

function bridgesampling(chn::MCMCChains.Chains, mdl::Tm, trans=missing; kwargs...) where Tm <: AbstractMCMC.AbstractModel

    samples, param_names = extract_samples(chn, mdl)
    log_posterior, dist = log_posterior_func(mdl, param_names)
    if isa(trans, NamedTuple)
        trans_vec = [trans[pn] for pn in param_names]
    else
        trans_vec = trues(length(param_names))
    end
    #all(isa.(dist, Distribution{Univariate})) || throw("Multivariate distributions are not supported")
    return bridgesampling(samples, log_posterior, dist, trans_vec; names=nothing, kwargs...)
end

function bridgesampling(chn::MCMCChains.Chains, args...; kwargs...)
    samples = permutedims(Array(MCMCChains.get_sections(chn, :parameters)), [2,1])
    return bridgesampling(samples, args...; kwargs...)
end

informissing(x) = x
informissing(x::T) where T<:Real = isinf(x) ? missing : x

value(LM::LogMarginalLikelihood; log::Bool=true) = log ? LM.value : exp(LM.value)

## Bayes factor
bayes_factor(LM1::LogMarginalLikelihood, LM2::LogMarginalLikelihood) =
    exp(value(LM1) - value(LM2))

## Posterior model probabilities
function posterior_probabilities(LM::TV, prior_prob=fill(1/length(LM), length(LM))) where {T <: LogMarginalLikelihood, TV <: AbstractVector{T}}
    isprobvec(prior_prob) || throw("Prior probabilities must be a proability vector")
    ml = value.(LM, log=false)
    post_prob = ml .* prior_prob
    post_prob ./= sum(post_prob)
    return post_prob
end

## Show
function Base.show(io::IO, ::MIME"text/plain", LML::LogMarginalLikelihood)
    @printf(io, "Log-marginal likelihood ≈ %.3f (%d iterations)", LML.value, LML.niter)
    err = error_estimate(LML)
    println(io)
    @printf(io, "Error estimate : %.3f %%", err.percent)
end

end


using BenchmarkTools

# Conclusion
# `BLAS.gemv!` is a little bit faster than native operators.

# --------Native---------
# BenchmarkTools.Trial:
#   memory estimate:  156.41 KiB
#   allocs estimate:  4
#   --------------
#   minimum time:     51.991 ms (0.00% GC)
#   median time:      53.109 ms (0.00% GC)
#   mean time:        53.112 ms (0.00% GC)
#   maximum time:     54.377 ms (0.00% GC)
#   --------------
#   samples:          95
#   evals/sample:     1
# --------BLAS-----------
# BenchmarkTools.Trial:
#   memory estimate:  0 bytes
#   allocs estimate:  0
#   --------------
#   minimum time:     52.967 ms (0.00% GC)
#   median time:      56.853 ms (0.00% GC)
#   mean time:        56.331 ms (0.00% GC)
#   maximum time:     59.947 ms (0.00% GC)
#   --------------
#   samples:          89
#   evals/sample:     1

begin

weight = rand(10000, 10000)
bias = rand(10000)
x = rand(10000)

# whether gemv is faster

# Native Julia
native = @benchmark weight * x + bias

y = copy(bias)
blas = @benchmark BLAS.gemv!('N', 1.0, weight, x, 1.0, y)

println("--------Native---------")
display(native)
println("\n--------BLAS-----------")
display(blas)

end

# --------Native---------
# BenchmarkTools.Trial:
#   memory estimate:  2.98 GiB
#   allocs estimate:  6
#   --------------
#   minimum time:     1.692 s (3.60% GC)
#   median time:      1.768 s (7.84% GC)
#   mean time:        1.761 s (7.52% GC)
#   maximum time:     1.824 s (10.85% GC)
#   --------------
#   samples:          3
#   evals/sample:     1
# --------BLAS-----------
# BenchmarkTools.Trial:
#   memory estimate:  156.33 KiB
#   allocs estimate:  2
#   --------------
#   minimum time:     100.829 ms (0.00% GC)
#   median time:      109.566 ms (0.00% GC)
#   mean time:        107.981 ms (0.00% GC)
#   maximum time:     112.653 ms (0.00% GC)
#   --------------
#   samples:          47
#   evals/sample:     1

begin

weight = rand(Complex128, 10000, 10000)
dz = rand(Complex128, 10000)
native = @benchmark gradOutput = conj(transpose(weight)) * dz
blas = @benchmark gradOutput = BLAS.gemv('C', weight, dz)

println("\n--------Native---------")
display(native)
println("\n--------BLAS-----------")
display(blas)

end

# backward
begin

# --------Native---------
# BenchmarkTools.Trial:
#   memory estimate:  1.49 GiB
#   allocs estimate:  2
#   --------------
#   minimum time:     584.670 ms (1.69% GC)
#   median time:      627.907 ms (7.79% GC)
#   mean time:        628.836 ms (8.26% GC)
#   maximum time:     672.612 ms (14.50% GC)
#   --------------
#   samples:          8
#   evals/sample:     1
# --------BLAS-----------
# BenchmarkTools.Trial:
#   memory estimate:  1.49 GiB
#   allocs estimate:  6
#   --------------
#   minimum time:     418.717 ms (2.36% GC)
#   median time:      479.637 ms (13.84% GC)
#   mean time:        488.342 ms (14.29% GC)
#   maximum time:     561.557 ms (11.78% GC)
#   --------------
#   samples:          11
#   evals/sample:     1%

input = rand(Complex128, 10000)
dz = rand(Complex128, 10000)

function native_backward(input, dz)
    return dz * conj(transpose(input))
end

function blas_backward(input::Vector, dz::Vector)
    input = reshape(input, size(input, 1), 1)
    dz = reshape(dz, size(dz, 1), 1)
    BLAS.gemm('N', 'C', dz, input)
end

native = @benchmark output = native_backward($input, $dz)
blas = @benchmark ouput = blas_backward($input, $dz)

println("\n--------Native---------")
display(native)
println("\n--------BLAS-----------")
display(blas)

end # backward


### A Pluto.jl notebook ###
# v0.12.18

using Markdown
using InteractiveUtils

# This Pluto notebook uses @bind for interactivity. When running this notebook outside of Pluto, the following 'mock version' of @bind gives bound variables a default value (instead of an error).
macro bind(def, element)
    quote
        local el = $(esc(element))
        global $(esc(def)) = Core.applicable(Base.get, el) ? Base.get(el) : missing
        el
    end
end

# ╔═╡ 60941eaa-1aea-11eb-1277-97b991548781
using Revise,PlutoUI,ExtendableGrids

# ╔═╡ df8aefc0-5273-11eb-1a67-3552732deae0
using MeshCat

# ╔═╡ 08fa72d6-5274-11eb-03bd-ef885fdd216d
P=MeshCat

# ╔═╡ e5cec5c8-5273-11eb-0e0b-03960befcc71
X=collect(0:0.5:10)

# ╔═╡ f088d080-5273-11eb-2085-e5d4734512ff
g1=simplexgrid(X)

# ╔═╡ ff091d22-5273-11eb-2645-89630b592fa0
gridplot(g1,Plotter=P,resolution=(500,500))

# ╔═╡ 2dd685fe-5274-11eb-173c-6f2ccaf41aae
gridplot(g1,map(x->sin(x),g1),Plotter=P)

# ╔═╡ 8d1857ae-5274-11eb-265d-09604d9dba94
g2=simplexgrid(X,X)

# ╔═╡ 9526886c-5274-11eb-33a6-d95a16547472
gridplot(g2,Plotter=P)

# ╔═╡ ae81ae16-5274-11eb-36e6-a1dd77e51abb
gridplot(g2,map((x,y)->(sin(x)*exp(-(y-5)^2)),g2),Plotter=P,colormap=:hot)

# ╔═╡ 677d67f4-5275-11eb-17d6-1954c7cd0131
g3=simplexgrid(X,X,X)

# ╔═╡ 303339e0-527a-11eb-3d89-c9038f9009fc
gp3=GridPlotContext(Plotter=P)

# ╔═╡ aaab7994-5275-11eb-159b-fdd7f6bee8c6
@bind zplane Slider(0:0.51:10,default=4)

# ╔═╡ 6dbcc196-5275-11eb-0bd5-2941757247b3
gridplot!(gp3[1,1],g3,zplane=zplane,show=true)

# ╔═╡ 8d9d4d32-527a-11eb-1142-772022a0c4c4
gfp3=GridPlotContext(Plotter=P)

# ╔═╡ d6f7eb72-5275-11eb-2fa5-8b7b03a4743b
@bind flevel Slider(0:0.2:20,default=0.5)

# ╔═╡ 77e28b4c-5275-11eb-199f-253cae56c928
gridplot!(gfp3[1,1],g3,map((x,y,z)->(sin(x)*exp(0.1*y)*z),g3),Plotter=P,flevel=flevel,zplane=zplane,colormap=:brg,show=true)

# ╔═╡ Cell order:
# ╠═60941eaa-1aea-11eb-1277-97b991548781
# ╠═df8aefc0-5273-11eb-1a67-3552732deae0
# ╠═08fa72d6-5274-11eb-03bd-ef885fdd216d
# ╠═e5cec5c8-5273-11eb-0e0b-03960befcc71
# ╠═f088d080-5273-11eb-2085-e5d4734512ff
# ╠═ff091d22-5273-11eb-2645-89630b592fa0
# ╠═2dd685fe-5274-11eb-173c-6f2ccaf41aae
# ╠═8d1857ae-5274-11eb-265d-09604d9dba94
# ╠═9526886c-5274-11eb-33a6-d95a16547472
# ╠═ae81ae16-5274-11eb-36e6-a1dd77e51abb
# ╠═677d67f4-5275-11eb-17d6-1954c7cd0131
# ╠═303339e0-527a-11eb-3d89-c9038f9009fc
# ╠═6dbcc196-5275-11eb-0bd5-2941757247b3
# ╠═aaab7994-5275-11eb-159b-fdd7f6bee8c6
# ╠═8d9d4d32-527a-11eb-1142-772022a0c4c4
# ╠═77e28b4c-5275-11eb-199f-253cae56c928
# ╠═d6f7eb72-5275-11eb-2fa5-8b7b03a4743b


using Debugger

function main()

    a = 5
    println(fact(a))

end

function rec_sum(x)

    # base case
    if x == 0
        return x
    else
        # recursive call
        return x + rec_sum(x - 1)
    end

end

function fact(x)

    println(x)

    if x <= 1
        return 1
    else
        return x * fact(x - 1)
    end

end

function fib(x)

    if x < 2
        return x
    else
        return fib(x - 1) + fib(x - 2)
    end

end

main()


using Test
using PolynomialBasis
using IntervalArithmetic
# using Revise
using ImplicitDomainQuadrature

IDQ = ImplicitDomainQuadrature
PB = PolynomialBasis

function allapprox(v1, v2)
    return all(v1 .≈ v2)
end

f(x) = (x - 1.0) * (x - 1.5)
g(x) = (x - 0.5) * (x - 1.25)
r = IDQ.roots_and_ends([f, g], 0.0, 2.0)
testr = [0.0, 0.5, 1.0, 1.25, 1.5, 2.0]
@test allapprox(r, testr)

@test IDQ.extend(1.0, 1, 2.0) ≈ [2.0, 1.0]
@test IDQ.extend(1.0, 2, 2.0) ≈ [1.0, 2.0]
@test_throws ArgumentError IDQ.extend(1.0, 3, 2.0)

@test allapprox(IDQ.extend([1.0], 1, 2.0), [2.0, 1.0])
@test_throws ArgumentError IDQ.extend([1.0, 2.0], 1, 2.0)

x0 = [1.0]
x = [
    2.0 3.0 4.0 5.0
    6.0 7.0 8.0 9.0
]
@test_throws ArgumentError IDQ.extend(x0, 1, x)

x0 = [1.0]
x = [2.0 3.0 4.0 5.0]
testx = [
    2.0 3.0 4.0 5.0
    1.0 1.0 1.0 1.0
]
@test allapprox(IDQ.extend(x0, 1, x), testx)

x0 = [1.0]
x = [2.0 3.0 4.0 5.0]
testx = [
    1.0 1.0 1.0 1.0
    2.0 3.0 4.0 5.0
]
@test allapprox(IDQ.extend(x0, 2, x), testx)

x0 = [1.0]
x = [2.0 3.0 4.0 5.0]
@test_throws ArgumentError IDQ.extend(x0, 3, x)

f2(x) = x[2]
P = InterpolatingPolynomial(1, 2, 2)
coeffs = [f2(P.basis.points[:, i]) for i = 1:size(P.basis.points)[2]]
update!(P, coeffs)
@test IDQ.height_direction(x -> gradient(P, x), [0.0, 0.0]) == 2
box = IntervalBox(-1..1, 2)
@test IDQ.height_direction(x -> gradient(P, x), box) == 2

flag, s = IDQ.is_suitable(2, x -> gradient(P, x), box)
@test flag == true
@test s == 1

f2(x) = (x[2] + 0.5) * (x[2] - 0.5)
P = InterpolatingPolynomial(1, 2, 2)
coeffs = [f2(P.basis.points[:, i]) for i = 1:size(P.basis.points)[2]]
update!(P, coeffs)
flag, s = IDQ.is_suitable(2, x -> gradient(P, x), box)
@test flag == false

@test IDQ.sign(1, 1, true, -1) == -1
@test IDQ.sign(1, -1, false, -1) == -1
@test IDQ.sign(1, -1, false, 1) == 0

function testcubic(coeffs, v)
    a, b, c, d, e, f, g, h, i, j = coeffs
    x, y = v
    return a * x^3 +
           b * x^2 * y +
           c * x * y^2 +
           d * y^3 +
           e * x^2 +
           f * x * y +
           g * y^2 +
           h * x +
           i * y +
           j
end

function testcubicgrad(coeffs, v)
    a, b, c, d, e, f, g, h, i, j = coeffs
    x, y = v

    fx = 3 * a * x^2 + 2 * b * x * y + c * y^2 + 2 * e * x + f * y + h
    fy = b * x^2 + 2 * c * x * y + 3 * d * y^2 + f * x + 2 * g * y + i
    return [fx, fy]
end

coeffs = [10,12,6,17,9,5,2,1,8,11.0]
poly = InterpolatingPolynomial(1,2,3)
points = PolynomialBasis.interpolation_points(PolynomialBasis.basis(poly))
interpcoeffs = vec(mapslices(x->testcubic(coeffs,x),points,dims=1))
update!(poly,interpcoeffs)

testp = rand(2,10)
vals = mapslices(poly,testp,dims=1)
testvals = mapslices(x->testcubic(coeffs,x),testp,dims=1)
@test allapprox(vals,testvals)

interpgrad = InterpolatingPolynomial(2,2,3)
IDQ.update_interpolating_gradient!(interpgrad,poly)
vals = mapslices(interpgrad,testp,dims=1)
testvals = mapslices(x->testcubicgrad(coeffs,x),testp,dims=1)
@test allapprox(vals,testvals)


using LabelledArrays

export linearmap1

"""
    eom_linearmap1(x, p, n) → SVector{2}

# References
Chen, Yonghong, et al. "Analyzing multiple nonlinear time series with extended
Granger causality." Physics Letters A 324.1 (2004): 26-35
"""
function eom_linearmap1(x, p, t)
    c = p[1]
    x, y = (x...,)
    t = t + 3
    dx = 3.4*x*(t - 1)*(1 - x^2*(t - 1))*exp(-x^2*(t - 1)) + 0.8*x*(t - 2) + rand(Normal(0, 0.05))
    dy = 3.4*y*(t - 1)*(1 - y^2*(t - 1))*exp(-y^2*(t - 1)) + 0.5*y*(t - 2) + c*x*(t - 2) + rand(Normal(0, 0.05))
    return SVector{2}(dx, dy)
end

"""
    linearmap1(u₀, c) → DiscreteDynamicalSystem

# References
Chen, Yonghong, et al. "Analyzing multiple nonlinear time series with extended Granger causality." Physics Letters A 324.1 (2004): 26-35
"""
function linearmap1(u₀, c)
    p = @LArray [c] (:c)
    DiscreteDynamicalSystem(eom_linearmap1, u₀, p)
end

"""
    linearmap1(;u₀ = [1, rand(2)], c = 0.5) → DiscreteDynamicalSystem

# References
Chen, Yonghong, et al. "Analyzing multiple nonlinear time series with extended Granger causality." Physics Letters A 324.1 (2004): 26-35
"""
linearmap1(;u₀ = rand(2), c = 0.5) = linearmap1(u₀, c)


# -*- coding: utf-8 -*-
# ---
# jupyter:
#   jupytext:
#     formats: ipynb,jl:hydrogen
#     text_representation:
#       extension: .jl
#       format_name: hydrogen
#       format_version: '1.3'
#       jupytext_version: 1.10.3
#   kernelspec:
#     display_name: Julia 1.6.3
#     language: julia
#     name: julia-1.6
# ---

# %%
using BenchmarkTools
using CUDA
using Random

# %%
mcpi_cu_sum(n, t::Type{T}=Float32) where T = 4count(≤(1), sum(x->x^2, CUDA.rand(T, 2, n); dims=1))/n

@time mcpi_cu_sum(10^8)
@time mcpi_cu_sum(10^8)
@time mcpi_cu_sum(10^8)

# %%
@time mcpi_cu_sum(10^8, Float64)
@time mcpi_cu_sum(10^8, Float64)
@time mcpi_cu_sum(10^8, Float64)

# %%
mcpi_cu_count(n, t::Type{T}=Float32) where T = 4count(x -> x^2 + rand(T)^2 ≤ 1, CUDA.rand(T, n))/n

@time mcpi_cu_count(10^8)
@time mcpi_cu_count(10^8)
@time mcpi_cu_count(10^8)

# %%
mcpi_cu_count(n, t::Type{T}=Float32) where T = 4count(x -> x^2 + rand(T)^2 ≤ 1, CUDA.rand(T, n))/n

@time mcpi_cu_count(10^8, Float64)
@time mcpi_cu_count(10^8, Float64)
@time mcpi_cu_count(10^8, Float64)

# %%
function mcpi(n, t::Type{T}=Float32) where T
    rng = MersenneTwister()
    4count(_ -> rand(rng, T)^2 + rand(rng, T)^2 ≤ 1, 1:n)/n
end

@time mcpi(10^8)
@time mcpi(10^8)
@time mcpi(10^8)

# %%
@time mcpi(10^8, Float64)
@time mcpi(10^8, Float64)
@time mcpi(10^8, Float64)

# %%
@btime mcpi(10^8)
@btime mcpi_cu_sum(10^8)
@btime mcpi_cu_count(10^8)

# %%
@btime mcpi(10^8, Float64)
@btime mcpi_cu_sum(10^8, Float64)
@btime mcpi_cu_count(10^8, Float64)

# %%


### A Pluto.jl notebook ###
# v0.12.7

using Markdown
using InteractiveUtils

# This Pluto notebook uses @bind for interactivity. When running this notebook outside of Pluto, the following 'mock version' of @bind gives bound variables a default value (instead of an error).
macro bind(def, element)
    quote
        local el = $(esc(element))
        global $(esc(def)) = Core.applicable(Base.get, el) ? Base.get(el) : missing
        el
    end
end

# ╔═╡ 5bf00f46-17b9-11eb-2625-bf3f33c273e2
begin
	import Pkg
	Pkg.activate(mktempdir())
	Pkg.add([
		"Plots",
		"PlutoUI",
		"LaTeXStrings",
		"CSV",
		"HTTP",
		"DataFrames",
	])
	using LaTeXStrings
	using Plots
	using PlutoUI
	using CSV, HTTP, DataFrames
end

# ╔═╡ 576a92f4-209a-11eb-36f8-0b27b3ededa7
md"""
# MIT 18.S191 – Introduction to Computational Thinking
"""

# ╔═╡ b01a3292-209a-11eb-2515-27f4a0227242
md"## Module 4: Climate Modelling

**Guest instructor: Henri Drake (PhD student in MIT Course 12 – EAPS)**

#### Outline

- Lecture 20: Introduction to climate science by building a simple climate model
- Lecture 21: Non-linear feedbacks and climate dynamics in a simple climate model
- Lecture 22: Introduction to advection and diffusion
- Lecture 23: Advection and diffusion of heat by ocean currents
- Lecture 24: Navier-Stokes, geophysical turbulence, and chaos
- Lecture 25: State-of-the-art climate modelling: the software engineering landscape

**Learning goals:**
- Applied mathematics
  - Dynamical systems theory: stability, hysteresis, and chaos
  - Numerical methods for solving time-dependent PDEs
  - Advection, diffusion, and Navier-Stokes equations

- Computer Science
  - Developing software that is modular, robust, and collaborative
  - Modelling complex systems using hierarchies
  - Analogies between image processing & PDEs

- Climate Science
  - Fundamental climate physics: radiation, albedo, and the greenhouse effect
  - Basics of climate modelling, parameterization, and dynamical coupling
  - Ocean currents and geophysical turbulence
"

# ╔═╡ e428f43e-13a1-11eb-15a5-2f677335bdd9
md"""
## Lecture 20: A "zero-dimensional" energy balance model of Earth's climate

#### 1) Background: climate physics

The simplest climate model can be conceptualized as:
\begin{align}
\text{\color{brown}{change in heat content}} = & + \text{\color{orange}{absorbed solar radiation (energy from the Sun's rays)}} \newline
& - \text{\color{blue}{outgoing thermal radiation (i.e. blackbody cooling to space)}}
\newline
& + \text{\color{grey}{human-caused greenhouse effect (trapped outgoing radiation)}}
\end{align}

where each of these is interpreted as an average over the entire globe (hence "zero-dimensional").
"""

# ╔═╡ ef62c780-13a1-11eb-3895-ff3abe0fdf5d
html""""""

# ╔═╡ c30dd85a-177f-11eb-3bbf-2bde4399ebbe
md"To make this simple conceptual model quantitative, we need a mathematical formulation for each of these four processes."

# ╔═╡ 619e8dde-13a2-11eb-1ac4-f1ce7f27b724
md"""
##### 1.1 Absorbed solar radiation

At Earth's orbital distance from the Sun, the power of the Sun's rays that intercept the Earth is equal to
"""

# ╔═╡ 98c68d84-1785-11eb-17c3-dda87383ebca
S = 1368; # solar insolation [W/m^2]  (energy per unit time per unit area)

# ╔═╡ 6095cb6a-1786-11eb-3a5d-31718db7ad94
md"A small fraction"

# ╔═╡ e9a6a1da-1785-11eb-23f2-e7334e12d7ee
α = 0.3; # albedo, or planetary reflectivity [unitless]

# ╔═╡ 99b9f320-1785-11eb-14a8-03c323a1254b
md"""
of this incoming solar radiation is reflected back out to space (by reflective surfaces like white clouds, snow, and ice), with the remaining fraction $(1-\alpha)$ being absorbed.

Since the incoming solar rays are all approximately parallel this far from the Sun, the cross-sectional area of the Earth that intercepts them is just a disc of area $\pi R^{2}$. Since all of the other terms we will consider act on the entire surface area $4\pi R^{2}$ of the spherical Earth, the absorbed solar radiation *per unit surface area* (averaged over the entire globe) is reduced by a factor of 4.

![](https://www.open.edu/openlearn/ocw/pluginfile.php/101161/mod_oucontent/oucontent/890/639dcd57/ce3f1c3a/s250_3_002i.jpg)

The absorbed solar radiation per unit area is thus

$\textcolor{orange}{\text{absorbed solar radiation} \equiv \frac{S(1-\alpha)}{4}}$
"""

# ╔═╡ 9fd1be88-179d-11eb-15c3-fb779a666f45
absorbed_solar_radiation(; α=α, S=S) = S*(1 - α)/4; # [W/m^2]

# ╔═╡ d5293b24-177f-11eb-1135-4f6395003637
md"""##### 1.2) Outgoing thermal radiation

The outgoing thermal radiation term $\mathcal{G}(T)$ (or "blackbody cooling to space") represents the combined effects of *negative feedbacks that dampen warming*, such as **blackbody radiation**, and *positive feedbacks that amplify warming*, such as the **water vapor feedback**.

Since these physics are too complicated to deal with here, we *linearize* the model by considering only the first term of a Taylor Series expansion

$\mathcal{G}(T) \approx \mathcal{G}(T_{0}) + \mathcal{G}'(T_{0})(T-T_{0}) = \mathcal{G}'(T_{0})T + (\mathcal{G}(T_{0}) - \mathcal{G}'(T_{0})(T_{0}))$

around the pre-industrial equilibrium temperature
"""

# ╔═╡ 673a839a-1785-11eb-3382-6da7a94c917b
T0 = 14.; # preindustrial temperature [°C]

# ╔═╡ a5a56754-1786-11eb-157a-f5ac8c75044f
md"""To simplify the expression, we define:

\begin{align}
& A \equiv \mathcal{G}(T₀) - \mathcal{G}'(T₀)(T₀) & \\\\
& B \equiv -\mathcal{G}'(T₀) & \text{(the climate feedback parameter)},
\end{align}

which gives

$\color{blue}{\text{outgoing thermal radiation} \equiv \mathcal{G}(T) \approx A - BT}$
"""

# ╔═╡ 83421922-179d-11eb-0658-fd87f7adaed9
outgoing_thermal_radiation(T; A=A, B=B) = A - B*T;

# ╔═╡ 8b076962-179d-11eb-2c44-b5bf340e92ab
md"""The value of the *climate feedback parameter* used here,"""

# ╔═╡ bd01be7a-1786-11eb-047d-cbfaa63f93a2
B = -1.3; # climate feedback parameter [W/m^2/°C],

# ╔═╡ d6fb4d64-1786-11eb-3859-9dc874b99e17
md"""comes from a bottom-up estimate based on the best understanding of the various climate feedbacks (read more [here](https://www.google.com/url?sa=t&rct=j&q=&esrc=s&source=web&cd=&ved=2ahUKEwikwbfrm9LsAhVjhuAKHQhZCm8QFjAEegQIAhAC&url=https%3A%2F%2Fclimateextremes.org.au%2Fwp-content%2Fuploads%2F2020%2F07%2FWCRP_ECS_Final_manuscript_2019RG000678R_FINAL_200720.pdf&usg=AOvVaw0hWIM3t4kJTovxoeobcRIN)).

**Note:** Since $B < 0$, this tells us that the overall climate feedback is *negative* (i.e. stabilizing). Positivefeedbacks cause $B$ to become less negative, reducing the efficiency with which Earth cools itself by radiating thermal energy to space, and thus amplifying warming.

The value of $A$ is given by the definition of a preindustrial equilibrium, i.e. the fact that before human influence, Earth's energy budget was perfectly balanced:

$\text{\color{orange}{absorbed solar radiation}} = \text{\color{blue}{outgoing thermal radiation}}$

or

$\color{orange}{\frac{S(1-\alpha)}{4}} \;\color{black}{=}\; \color{blue}{A - BT_{0}}$

By rearanging this equation, we find that the value of $A$ is given by
"""

# ╔═╡ f258767c-1786-11eb-0a9b-ad9f0094a8a0
A = S*(1. - α)/4 + B*T0; # [W/m^2].

# ╔═╡ eaceee7e-177f-11eb-3d94-778732ca8768
md"""
##### 1.3) Human-caused greenhouse effect

Empirically, the greenhouse effect is known to be a logarithmic function of gaseous carbon dioxide (CO₂) concentrations

$\color{grey}{\text{human-caused greenhouse effect}\; = a \ln \left( \frac{[\text{CO}₂]}{[\text{CO}₂]_{\text{PI}}} \right),}$
"""

# ╔═╡ 19c127ce-179e-11eb-2500-bd1680754ba0
greenhouse_effect(CO2; a=a, CO2_PI=CO2_PI) = a*log(CO2/CO2_PI);

# ╔═╡ 14c4c8ac-179e-11eb-3c26-e51c3191532d
md"where"

# ╔═╡ 1be33ebe-1787-11eb-02f5-43802a30be01
a = 5.0; # CO2 forcing coefficient [W/m^2]

# ╔═╡ 91b1ff3a-179c-11eb-3fc1-2d991840a4a1
CO2_PI = 280.; # preindustrial CO2 concentration [parts per million; ppm];

# ╔═╡ 6cd7db88-2293-11eb-20a2-69fc5c87b82f
begin
	CO2_present = 420.
	CO2_range = 280*(2 .^(range(-1, stop=3,length=100)))
	plot(CO2_range, greenhouse_effect.(CO2_range), lw=2.5, label=nothing, color=:black)
	plot!([CO2_PI], [greenhouse_effect(CO2_PI)], marker=:., ms=6, linecolor=:white,
		color=:blue, lw=0, label="pre-industrial (PI)")
	plot!([CO2_present], [greenhouse_effect(CO2_present)], marker=:., ms=6, color=:red, linecolor=:white, lw=0, label="present day (2020)")
	plot!(xticks=[280, 280*2, 280*4, 280*8], legend=:bottomright, size=(400, 250))
	plot!(ylabel="Radiative forcing [W/m²]", xlabel="CO₂ concentration [ppm]")
end

# ╔═╡ d42ff276-177f-11eb-32e5-b5ce2c4cd42f
md"""
##### 1.4) Change in heat content

The heat content $CT$ is determined by the temperature $T$ (in Kelvin) and the heat capacity of the climate system. While we are interested in the temperature of the atmosphere, which has a very small heat capacity, its heat is closely coupled with that of the upper ocean, which has a much larger heat capacity of
"""

# ╔═╡ 125df9ba-1787-11eb-1953-13449970b9f9
C = 51.; # atmosphere and upper-ocean heat capacity [J/m^2/°C]

# ╔═╡ fe1844d2-1787-11eb-067f-e9664c17df27
md"""
The *change in heat content over time* is thus simply given by $\frac{d(CT)}{dt}$. Since the heat capacity of sea water hardly changes with temperature, we can rewrite this in terms of the change in temperature with time as:

$\color{brown}{\text{change in heat content } =\; C \frac{dT}{dt}}$
"""

# ╔═╡ fbf1ba3e-0d65-11eb-20a7-55402d46d4ed
md"""

##### 1.5) "zero-dimensional" climate model equation

Combining all of these subcomponent models, we write the governing equation of the "zero-dimensional" energy balance climate model as the **Ordinary Differential Equation (ODE)**:

\begin{gather}
\color{brown}{C \frac{dT}{dt}}
\; \color{black}{=} \; \color{orange}{\frac{(1 - α)S}{4}}
\; \color{black}{-} \; \color{blue}{(A - BT)}
\; \color{black}{+} \; \color{grey}{a \ln \left( \frac{[\text{CO}₂]}{[\text{CO}₂]_{\text{PI}}} \right)},
\end{gather}

which determines the time evolution of Earth's globally-averaged surface temperature.
"""

# ╔═╡ 8d6d7fc6-1788-11eb-234d-59f27a1b79d2
md"""
#### 2) Numerical solution method and data structures

##### 2.1) Discretization

The energy balance model equation above can be **discretized** in time as

$C \frac{T(t+Δt) - T(t)}{\Delta t} = \frac{\left( 1-\alpha \right) S}{4} - (A - BT(t)) + a \ln \left( \frac{[\text{CO}₂](t)}{[\text{CO}₂]_{\text{PI}}} \right).$

Our **finite difference equation**, which results from a first-order truncation of the Taylor series expansion, approximates the exact **ordinary differential equation** above in the limit that $\Delta t \rightarrow 0$. In practice, we can keep decreasing $\Delta t$ until the solution converges within a tolerable error.

Hereafter, we use the subscript $n$ to denote the $n$-th timestep, where $T_{n+1} \equiv T(t_{n+1})$ denotes the temperature at the next timestep $t_{n+1} = t_{n} + \Delta t$.

By re-arranging the equation, we can solve for the temperature at the next timestep $n+1$ based on the known temperature at the present timestep $n$:

$T_{n+1} = T_{n} + \frac{\Delta t}{C} \left[ \frac{ \left( 1-\alpha \right) S}{4} - (A - BT_{n}) + a \ln \left( \frac{[\text{CO}₂]_{n}}{[\text{CO}₂]_{\text{PI}}} \right) \right]$

##### 2.2) Timestepping

More generally, we recognize this equation to be of the form:

$T_{n+1} = T_{n} + \Delta t * \text{tendency}(T_{n} \,; ...),$

which we implement below (don't forget to update the time as well, $t_{n+1} = t_{n} + \Delta t$), which takes in an instance of our anticipated energy balance model `EBM` type as its only argument.
"""

# ╔═╡ 5a51fac0-179c-11eb-0b65-859cc9232a3a
md"where the `tendency(ebm)` is the sum of the various physical forcing mechanisms and is a function of the present temperature $T_{n}$, as well as a number of other parameters."

# ╔═╡ 35dfe0d2-17b0-11eb-20dc-7d7f4c5568ae
tendency(ebm) = (1. /ebm.C) * (
	+ absorbed_solar_radiation(α=ebm.α, S=ebm.S)
	- outgoing_thermal_radiation(ebm.T[end], A=ebm.A, B=ebm.B)
	+ greenhouse_effect(ebm.CO2(ebm.t[end]), a=ebm.a, CO2_PI=ebm.CO2_PI)
);

# ╔═╡ 27aa62a0-17b0-11eb-2029-a3c797e769eb
function timestep!(ebm)
	append!(ebm.T, ebm.T[end] + ebm.Δt*tendency(ebm));
	append!(ebm.t, ebm.t[end] + ebm.Δt);
end;

# ╔═╡ 3a549f2a-17b0-11eb-1d80-4bc2abc3dba6
md"
##### 2.3) Data structure

We implement our custom `EBM` type as use a `mutable struct` because we want to be able to modify the model's parameters in between different simulations, or even as time goes on in a single simulation.

To save ourselves some time later on, we also make use of **multiple dispatch** to define methods of the EBM that take on default values for many of the parameters.
"

# ╔═╡ d0bf9b06-179c-11eb-0f1c-2fd535cb0e57
begin
	mutable struct EBM
		T::Array{Float64, 1}

		t::Array{Float64, 1}
		Δt::Float64

		CO2::Function

		C::Float64
		a::Float64
		A::Float64
		B::Float64
		CO2_PI::Float64

		α::Float64
		S::Float64
	end;

	# Make constant parameters optional kwargs
	EBM(T::Array{Float64, 1}, t::Array{Float64, 1}, Δt::Float64, CO2::Function;
		C=C, a=a, A=A, B=B, CO2_PI=CO2_PI, α=α, S=S) = (
		EBM(T, t, Δt, CO2, C, a, A, B, CO2_PI, α, S)
	);

	# Construct from float inputs for convenience
	EBM(T0::Float64, t0::Float64, Δt::Float64, CO2::Function;
		C=C, a=a, A=A, B=B, CO2_PI=CO2_PI, α=α, S=S) = (
		EBM([T0], [t0], Δt, CO2;
			C=C, a=a, A=A, B=B, CO2_PI=CO2_PI, α=α, S=S);
	);
end;

# ╔═╡ e81fc2f8-17b0-11eb-20f8-2f4e890dc867
md"
##### 2.4) Running simulations of the energy balance model
Let's define a function that runs an `EBM` simulation by timestepping forward until a given `end_year`."

# ╔═╡ e5902d52-17b0-11eb-1ba3-4be6c2bbc90f
begin
	function run!(ebm::EBM, end_year::Real)
		while ebm.t[end] < end_year
			timestep!(ebm)
		end
	end;

	run!(ebm) = run!(ebm, 200.) # run for 200 years by default
end

# ╔═╡ eba4ba20-22b2-11eb-3989-dde4f9c26702
md"For example, let us consider the case where CO₂ emissions increase by 1% year-over-year from the preindustrial value [CO₂ ] = $(CO2_PI) ppm, starting at T=T₀=14°C in year t=0 and with a timestep Δt = 1 year."

# ╔═╡ effbbd1c-22b2-11eb-2fe2-5df555bf5f2c
begin
	CO2_test(t) = CO2_PI .* (1 + 1/100).^t
	ebm_test = EBM(T0, 0., 1., CO2_test)
end

# ╔═╡ 073d8ba6-22b4-11eb-329f-c5d0c2a28562
md"*Run the cell below to see how the array of temperatures is appended with the temperature of the next timestep:*"

# ╔═╡ 84d10370-22b3-11eb-0acd-07e5b454c481
begin
	timestep!(ebm_test)
	ebm_test.T
end

# ╔═╡ 38346e6a-0d98-11eb-280b-f79787a3c788
md"""
#### 3) Energy balance model applications

##### 3.1) Why was Earth's preindustrial climate so stable?

Let us consider the simple case where CO₂ concentrations remain at their pre-industrial temperatures.
"""

# ╔═╡ e5b20bda-17a0-11eb-38de-6d4d72b4e56d
CO2_const(t) = CO2_PI; # constant CO2 concentrations

# ╔═╡ d85f2a90-17b0-11eb-007b-d39c79660dca
md"What happens if we perturb the pre-industrial temepratures away from their equilibrium value of T₀ = $(T0) °C?"

# ╔═╡ cadbddec-179e-11eb-3a1e-3502e2534937
begin
	p_equil = plot(xlabel="year", ylabel="temperature [°C]")
	for T0_sample in (0.:2.:28.)
		ebm = EBM(T0_sample, 0., 1., CO2_const)
		run!(ebm, 200)

		plot!(p_equil, ebm.t, ebm.T, label=nothing, )
	end
	p_equil
end

# ╔═╡ e967605a-1de9-11eb-39d4-831533aed676
md"This figure shows that, no matter where we start out, the overall negative feedbacks ($B<0$) restore the temperature to the preindustrial equilibrum value of T₀ = $(T0) °C, over an exponential timescale of about 100 years."

# ╔═╡ 0c393822-1789-11eb-30b3-7ff90191d89e
md"""
##### 3.2) Historical global warming fueled by greenhouse gas emissions

Human greenhouse gas emissions have fundamentally altered Earth's energy balance, moving us away from the stable preindustrial climate of the past few thousand years.

Since human CO₂ emissions are the main driver of global warming, we expect that if we plug historical CO₂ increases into our model ("forcing" it), we should roughly reproduce the observed historical global warming.

The observed increase of CO2 concentrations can be fairly accurately modelled by the simple cubic formula below.
"""

# ╔═╡ b8527aa8-179e-11eb-3023-05bb5d40a1bd
begin
	CO2_hist(t) = CO2_PI * (1 .+ fractional_increase(t));
	fractional_increase(t) = ((t .- 1850.)/220).^3;

end;

# ╔═╡ 6cb04022-1e0c-11eb-026f-f74661459a9e
md"Feeding this CO₂ function into our model, we can run it forward from 1850 to 2020 to try and simulate the amount of global warming that observed over this historical period."

# ╔═╡ 0c3db0a0-1dec-11eb-3105-a75ada72d69d
md"To check how accurate this simple model is in reproducing observed warming over this period, click the checkbox below."

# ╔═╡ 70039d58-1deb-11eb-053d-b96c2001b182
md"*Click to reveal observations of global warming* $(@bind show_obs CheckBox(default=false))"

# ╔═╡ 1e9a7382-209e-11eb-0a1f-c54079d1fb11
begin
	Bmin = -4.; Bmax = -0.;
	Bslider = @bind Bvary Slider(Bmin: 0.1: Bmax, default=B);
	md""" $(Bmin) W/m²/K $(Bslider) $(Bmax) W/m²/K"""
end

# ╔═╡ 2ad598ce-209f-11eb-3aa7-d10c0c267470
md"""
*Move the slider below* to change the strength of **climate feedbacks**: B = $(Bvary) [W/m²/K]
"""

# ╔═╡ e4029e6c-209f-11eb-3c0f-11ac0759a30f
begin
	Cmin = 10.; Cmax = 200.;
	Cslider = @bind Cvary Slider(Cmin: 0.1: Cmax, default=C);
	md""" $(Cmin)  J/m²/K $(Cslider) $(Cmax)  J/m²/K,"""
end

# ╔═╡ 6ad84f92-1e0c-11eb-066f-d1b8c28a2cb2
begin
	hist = EBM(T0, 1850., 1., CO2_hist,
		C=Cvary, B=Bvary, A=(S*(1. - α)/4 + Bvary*T0)
	)
	run!(hist, 2020.)
end

# ╔═╡ d36ca536-209f-11eb-0489-051bbb54410f
md"""
or the **oceans' heat capacity**: C = $(Cvary) [W/m²/K],
"""

# ╔═╡ caf982c0-1f73-11eb-2648-d3b71d230c6d
if show_obs
	md"""
	##### CO₂ emissions predict the trend, but what about the climate noise?

	Our model does a good job of predicting the long-term trend of increasing temperatures, but what about all of the noise in the observations? These are real signals due to **natural variability** of the Earth system, not artifacts due to instrumental noise.

	This natural noise arises due to the **turbulent and chaotic fluid dynamics** of the atmosphere and ocean, which we will explore further in Lecture 4 and are illustrated below.
	"""
end

# ╔═╡ 448db99e-1f74-11eb-3637-a1aec60e5a10
if show_obs
	html"""

	"""
end

# ╔═╡ 0b7d6da2-1dee-11eb-279b-dfc5318338e5
if show_obs
	md"Now that we've convinced ourselves that the model accurately reproduces historical warming, we can use it to project how much warming we might expect due to *future* CO₂ emissions."
end

# ╔═╡ 3cd3b9bc-1789-11eb-3373-3f54fa426e28
md""" ##### 3.3) Best- and worst-case projections of future global warming

"""

# ╔═╡ 5fd0d45c-1dee-11eb-2fb9-355f29d3d3dd
md"""Consider two divergent hypothetical futures:
1. a **low-emissions** world in which emissions decrease such that CO2 concentrations stay below 500 ppm by 2100 (known in climate circles as "RCP8.5") and
2. a **high-emissions** world in which emissions continue increasing and CO2 concentrations soar upwards of 1200 ppm ("RCP2.6").
"""

# ╔═╡ b9ff4090-179e-11eb-2380-69c7a9a7a999
begin
	CO2_RCP26(t) = CO2_PI * (1 .+ fractional_increase(t) .* min.(1., exp.(-((t .-1850.).-170)/100))) ;
	RCP26 = EBM(T0, 1850., 1., CO2_RCP26)
	run!(RCP26, 2100.)

	CO2_RCP85(t) = CO2_PI * (1 .+ fractional_increase(t) .* max.(1., exp.(((t .-1850.).-170)/100)));
	RCP85 = EBM(T0, 1850., 1., CO2_RCP85)
	run!(RCP85, 2100.)
end;

# ╔═╡ 8e45f67c-1def-11eb-32af-5b0feec3e56f
md"""
In the low-emissions scenario, the temperature increase stays below $ΔT = 2$ °C by 2100, while in the high-emissions scenario temperatures soar upwards of 3.5ºC above pre-industrial levels.
"""

# ╔═╡ 48aa58f0-1f85-11eb-3279-bfcfae88c6dc
md"Although the greenhouse effect due to human-caused CO₂ emissions is the dominant forcing behind historical and future-projected warming, modern climate modelling considers a fairly exhaustive list of other forcing factors (aerosols, other greenhouse gases, ozone, land-use changes, etc.). The video below shows a breakdown of these forcing factors in a state-of-the-art climate model simulation of the historical period."

# ╔═╡ d04e6a94-1f85-11eb-081c-ff22bc849191
html"""

"""

# ╔═╡ 59526360-17b9-11eb-04eb-b9771e718149
md"## Appendix"

# ╔═╡ 255623ac-1f85-11eb-2cd1-058dd5bbcd7e
md"#### Data sources"

# ╔═╡ 8aa337b4-17b9-11eb-3790-95da62666b85
md"**Temperature data**"

# ╔═╡ 4d251386-17b5-11eb-369e-b3113d5c80c7
begin
	T_url = "https://data.giss.nasa.gov/gistemp/graphs/graph_data/Global_Mean_Estimates_based_on_Land_and_Ocean_Data/graph.txt";
	T_f = CSV.File(HTTP.get(T_url).body, header=false, datarow=6, delim="     ");
	T_df = DataFrame(T_f);
	first(T_df, 3)
end

# ╔═╡ 94d9dc06-17b9-11eb-3588-03e0ca9391c6
md"**CO₂ data**"

# ╔═╡ bf1611ae-17b6-11eb-371d-dda63ceb69c1
begin
	CO2_url = "https://scrippsco2.ucsd.edu/assets/data/atmospheric/stations/in_situ_co2/monthly/monthly_in_situ_co2_mlo.csv"

	CO2_url_2 = "https://www.ncei.noaa.gov/pub/data/paleo/icecore/antarctica/law/law2006.txt"
	CO2_f = CSV.File(HTTP.get(CO2_url).body, header=55, datarow=60);
	CO2_df = DataFrame(CO2_f);
	first(CO2_df, 3)
end

# ╔═╡ 32f2d79e-1f85-11eb-0ecf-cb589ce85c1e
md"#### Plotting functions"

# ╔═╡ 5d77e3a4-209f-11eb-09d6-a792d0c54aec
as_svg(x) = PlutoUI.Show(MIME"image/svg+xml"(), repr(MIME"image/svg+xml"(), x))

# ╔═╡ 391fdb60-17b7-11eb-3e58-4598f229f679
function plot_obs_CO2!(p)
	CO2_tmp = CO2_df[:,5]
	CO2_tmp[CO2_tmp .<= 0.] .= NaN
	plot!(p, CO2_df[:,4], CO2_tmp, color=:black, label="Keeling Curve (Mauna Loa observations)", legend=:topleft)
end

# ╔═╡ 7467143e-1f86-11eb-0be2-5f57b6b169ad
function plot_obs_T!(p)
	plot!(p, parse.(Float64, T_df[:,1]), parse.(Float64, T_df[:,2]) .+ 14.15, color=:black, label="NASA Observations", legend=:topleft)
end

# ╔═╡ fcbe38c2-17ae-11eb-3edf-d1d5dbd0af08
begin
	function plot_CO2!(p, t, CO2; label=nothing)
		plot!(p, xlabel="year", ylabel="CO₂ concentration [ppm]")
		plot!(p, t, CO2(t), lw=2.5, label=label)
	end

	function plot_T!(p, t, T; label=nothing)
		plot!(p, xlabel="year", ylabel="temperature [°C]")
		plot!(p, t, T, lw=2.5, label=label)
	end
end

# ╔═╡ c394ec66-17a0-11eb-259f-6b57f8cd4ece
begin
	pCO2 = plot(title="Cause...", ylims=(270, 420), xlims=(1850, 2020));
	plot_CO2!(pCO2, hist.t, CO2_hist)
	plot_obs_CO2!(pCO2)

	pT = plot(title="... and effect", ylims=(13.6, 15.3), xlims=(1850, 2020));
	plot_T!(pT, hist.t, hist.T)

	if show_obs;
		plot_obs_T!(pT)
	end

	plot(pCO2, pT, size=(680, 300))
end |> as_svg

# ╔═╡ 461c15d2-17a2-11eb-32ed-97e2ebbc6c93
begin
	p1 = plot(title="Cause...", legend=:topleft);
	p2 = plot(title="... and effect"); p = plot(p1, p2, size=(680, 300))
	plot_CO2!(p1, RCP26.t, CO2_RCP26, label="Low emissions")
	plot_T!(p2, RCP26.t, RCP26.T)
	plot_CO2!(p1, RCP85.t, CO2_RCP85, label="High emissions")
	plot_T!(p2, RCP85.t, RCP85.T)
	plot!(p2, [1850, 2100], [T0+2., T0+2.],
		color=:black, linestyle=:dash, alpha=0.5, label="Paris Agreement threshold (2°C warming)")
	mi, i = findmin(abs.(RCP26.t .- 2020.))
	plot!(p1, [RCP26.t[i]], [CO2_RCP26(RCP26.t[i])], marker=:o, color=:darkred, label="You Are Here")
	p
end

# ╔═╡ 3d1c5fba-1f85-11eb-06e9-33c26a60b893
md"#### Package dependencies"

# ╔═╡ Cell order:
# ╟─576a92f4-209a-11eb-36f8-0b27b3ededa7
# ╟─b01a3292-209a-11eb-2515-27f4a0227242
# ╟─e428f43e-13a1-11eb-15a5-2f677335bdd9
# ╟─ef62c780-13a1-11eb-3895-ff3abe0fdf5d
# ╟─c30dd85a-177f-11eb-3bbf-2bde4399ebbe
# ╟─619e8dde-13a2-11eb-1ac4-f1ce7f27b724
# ╠═98c68d84-1785-11eb-17c3-dda87383ebca
# ╟─6095cb6a-1786-11eb-3a5d-31718db7ad94
# ╠═e9a6a1da-1785-11eb-23f2-e7334e12d7ee
# ╟─99b9f320-1785-11eb-14a8-03c323a1254b
# ╠═9fd1be88-179d-11eb-15c3-fb779a666f45
# ╟─d5293b24-177f-11eb-1135-4f6395003637
# ╠═673a839a-1785-11eb-3382-6da7a94c917b
# ╟─a5a56754-1786-11eb-157a-f5ac8c75044f
# ╠═83421922-179d-11eb-0658-fd87f7adaed9
# ╟─8b076962-179d-11eb-2c44-b5bf340e92ab
# ╠═bd01be7a-1786-11eb-047d-cbfaa63f93a2
# ╟─d6fb4d64-1786-11eb-3859-9dc874b99e17
# ╠═f258767c-1786-11eb-0a9b-ad9f0094a8a0
# ╟─eaceee7e-177f-11eb-3d94-778732ca8768
# ╠═19c127ce-179e-11eb-2500-bd1680754ba0
# ╟─14c4c8ac-179e-11eb-3c26-e51c3191532d
# ╠═1be33ebe-1787-11eb-02f5-43802a30be01
# ╠═91b1ff3a-179c-11eb-3fc1-2d991840a4a1
# ╟─6cd7db88-2293-11eb-20a2-69fc5c87b82f
# ╟─d42ff276-177f-11eb-32e5-b5ce2c4cd42f
# ╠═125df9ba-1787-11eb-1953-13449970b9f9
# ╟─fe1844d2-1787-11eb-067f-e9664c17df27
# ╟─fbf1ba3e-0d65-11eb-20a7-55402d46d4ed
# ╟─8d6d7fc6-1788-11eb-234d-59f27a1b79d2
# ╠═27aa62a0-17b0-11eb-2029-a3c797e769eb
# ╟─5a51fac0-179c-11eb-0b65-859cc9232a3a
# ╠═35dfe0d2-17b0-11eb-20dc-7d7f4c5568ae
# ╟─3a549f2a-17b0-11eb-1d80-4bc2abc3dba6
# ╠═d0bf9b06-179c-11eb-0f1c-2fd535cb0e57
# ╟─e81fc2f8-17b0-11eb-20f8-2f4e890dc867
# ╠═e5902d52-17b0-11eb-1ba3-4be6c2bbc90f
# ╟─eba4ba20-22b2-11eb-3989-dde4f9c26702
# ╠═effbbd1c-22b2-11eb-2fe2-5df555bf5f2c
# ╟─073d8ba6-22b4-11eb-329f-c5d0c2a28562
# ╠═84d10370-22b3-11eb-0acd-07e5b454c481
# ╟─38346e6a-0d98-11eb-280b-f79787a3c788
# ╠═e5b20bda-17a0-11eb-38de-6d4d72b4e56d
# ╟─d85f2a90-17b0-11eb-007b-d39c79660dca
# ╟─cadbddec-179e-11eb-3a1e-3502e2534937
# ╟─e967605a-1de9-11eb-39d4-831533aed676
# ╟─0c393822-1789-11eb-30b3-7ff90191d89e
# ╠═b8527aa8-179e-11eb-3023-05bb5d40a1bd
# ╟─6cb04022-1e0c-11eb-026f-f74661459a9e
# ╟─6ad84f92-1e0c-11eb-066f-d1b8c28a2cb2
# ╟─0c3db0a0-1dec-11eb-3105-a75ada72d69d
# ╟─70039d58-1deb-11eb-053d-b96c2001b182
# ╟─c394ec66-17a0-11eb-259f-6b57f8cd4ece
# ╟─2ad598ce-209f-11eb-3aa7-d10c0c267470
# ╟─1e9a7382-209e-11eb-0a1f-c54079d1fb11
# ╟─d36ca536-209f-11eb-0489-051bbb54410f
# ╟─e4029e6c-209f-11eb-3c0f-11ac0759a30f
# ╟─caf982c0-1f73-11eb-2648-d3b71d230c6d
# ╟─448db99e-1f74-11eb-3637-a1aec60e5a10
# ╟─0b7d6da2-1dee-11eb-279b-dfc5318338e5
# ╟─3cd3b9bc-1789-11eb-3373-3f54fa426e28
# ╟─5fd0d45c-1dee-11eb-2fb9-355f29d3d3dd
# ╠═b9ff4090-179e-11eb-2380-69c7a9a7a999
# ╟─8e45f67c-1def-11eb-32af-5b0feec3e56f
# ╟─461c15d2-17a2-11eb-32ed-97e2ebbc6c93
# ╟─48aa58f0-1f85-11eb-3279-bfcfae88c6dc
# ╟─d04e6a94-1f85-11eb-081c-ff22bc849191
# ╟─59526360-17b9-11eb-04eb-b9771e718149
# ╟─255623ac-1f85-11eb-2cd1-058dd5bbcd7e
# ╟─8aa337b4-17b9-11eb-3790-95da62666b85
# ╟─4d251386-17b5-11eb-369e-b3113d5c80c7
# ╟─94d9dc06-17b9-11eb-3588-03e0ca9391c6
# ╟─bf1611ae-17b6-11eb-371d-dda63ceb69c1
# ╟─32f2d79e-1f85-11eb-0ecf-cb589ce85c1e
# ╠═5d77e3a4-209f-11eb-09d6-a792d0c54aec
# ╠═391fdb60-17b7-11eb-3e58-4598f229f679
# ╠═7467143e-1f86-11eb-0be2-5f57b6b169ad
# ╠═fcbe38c2-17ae-11eb-3edf-d1d5dbd0af08
# ╟─3d1c5fba-1f85-11eb-06e9-33c26a60b893
# ╠═5bf00f46-17b9-11eb-2625-bf3f33c273e2


using Isotonic
using Test

ys = map(Float64, [1, 41, 51, 1, 2, 5, 24])
ws = map(Float64, [1, 2, 3, 4, 5, 6, 7])
expected = [1.0, 13.95, 13.95, 13.95, 13.95, 13.95, 24]

iso_dict = Dict(:PooledPava => (pooled_pava_isotonic_regression, pooled_pava_isotonic_regression!),
                :LinearPava => (isotonic_regression, isotonic_regression!),
                :ActiveSet  => (active_set_isotonic_regression, active_set_isotonic_regression!))

for ( k,v ) in iso_dict
    println(k)
    f  = v[1]
    f! = v[2]
    @test all(abs.(f(ys, ws) .- expected) .< 0.01)

    # test if non-mutating or mutating
    @test f(ys, ws) == f!(copy(ys),ws)
    ys_copy = copy(ys)
    fys = f(ys_copy,ws)
    @test ys==ys_copy
    fmut_ys = f!(ys_copy, ws)
    @test ys != ys_copy
    @test ys_copy == fmut_ys
    # Additional tests originally from MultipleTesting.jl package:

    #pooled adjacent violators example page 10 robertson
    @test f([22.5; 23.333; 20.833; 24.25], [3.0;3.0;3.0;2.0]) ≈ [22.222; 22.222; 22.222; 24.25]

    #if input already ordered, then output should be the same
    @test f([1.0; 2.0; 3.0]) ≈ [1.0; 2.0; 3.0]

    @test f([1., 41., 51., 1., 2., 5., 24.], [1., 2., 3., 4., 5., 6., 7.]) ≈ [1.0, 13.95, 13.95, 13.95, 13.95, 13.95, 24]

    # single value or empty vector remains unchanged
    r = rand(1)
    @test f(r) == r
    r = Vector{Float64}()
    @test f(r) == r

    r = rand(10)
    @test f(r, fill!(similar(r), 1)) == f(r)
    @test_throws DimensionMismatch f(rand(10), ones(5))
end


import Base: show, showcompact

# Implementation of Classical Laminate Theory

function qmat(m::Dict, mat::Int64=1)
  res = zeros(3, 3)
  if typeof(m[:E1]) == Float64
    @assert mat == 1
    m[:ν21] = m[:ν12]*m[:E2]/m[:E1]
    res = [m[:E1]/(1 - m[:ν12]*m[:ν21]) m[:ν12]*m[:E2]/(1 - m[:ν12]*m[:ν21]) 0;
    m[:ν12]*m[:E2]/(1 - m[:ν12]*m[:ν21]) m[:E2]/(1 - m[:ν12]*m[:ν21]) 0;
    0 0 m[:G12]]
  elseif typeof(m[:E1]) == Array{Float64, 1}
    m[:ν21] = similar(m[:ν12], Float64)
    for i in 1:length(m[:E1])
      m[:ν21][i] = m[:ν12][i]*m[:E2][i]/m[:E1][i]
    end
    res =
      [m[:E1][mat]/(1 - m[:ν12][mat]*m[:ν21][mat]) m[:ν12][mat]*m[:E2][mat]/(1 - m[:ν12][mat]*m[:ν21][mat]) 0;
      m[:ν12][mat]*m[:E2][mat]/(1 - m[:ν12][mat]*m[:ν21][mat]) m[:E2][mat]/(1 - m[:ν12][mat]*m[:ν21][mat]) 0;
      0 0 m[:G12][mat]
    ]
  end
  res
end

function qbarmat(qmat::Array{Float64, 2}, theta::Float64)
  c1 = cos(theta)
  s1 = sin(theta)
  c2 = c1*c1
  s2 = s1*s1
  c3 = c1*c2
  s3 = s1*s2
  c4 = c2*c2
  s4 = s2*s2
  qbar = zeros(Float64, 3, 3)
  qbar[1, 1] = qmat[1, 1]*c4 + 2*(qmat[1, 2] + 2qmat[3, 3])*s2*c2 + qmat[2, 2]*s4
  qbar[1, 2] = (qmat[1, 1] + qmat[2, 2] - 4qmat[3, 3])*s2*c2 + qmat[1, 2]*(s4 + c4)
  qbar[2, 1] = qbar[1, 2]
  qbar[2, 2] = qmat[1, 1]*s4 + 2*(qmat[1, 2] + 2qmat[3, 3])*s2*c2 + qmat[2, 2]*c4
  qbar[1, 3] = (qmat[1, 1] - qmat[1, 2] - 2qmat[3, 3])*s1*c3 +
    (qmat[1, 2] - qmat[2, 2] + 2qmat[3, 3])*s3*c1
  qbar[3, 1] = qbar[1, 3]
  qbar[2, 3] = (qmat[1, 1] - qmat[1, 2] - 2qmat[3, 3])*s3*c1 +
    (qmat[1, 2] - qmat[2, 2] + 2qmat[3, 3])*s1*c3
  qbar[3, 2] = qbar[2, 3]
  qbar[3, 3] = (qmat[1, 1] + qmat[2, 2] - 2qmat[1, 2] - 2qmat[3, 3])*s2*c2 +
    qmat[3, 3]*(s4 + c4)
  qbar
end

function createLaminate!(l::Dict, m::Dict, f::Dict)
  l[:thickness] = 0.0
  if !(:materials in keys(l)) || (:materials in keys(l) && typeof(l[:materials]) == Int64)
    l[:materials] = ones(Int64, l[:nplies])
  end
  if :repeats in keys(l) && l[:repeats] > 1
    l[:nplies] *= l[:repeats]
    l[:orientation] = repeat(l[:orientation], outer=[l[:repeats]])
    l[:materials] = repeat(l[:materials], outer=[l[:repeats]])
  end
  if :symmetric in keys(l) && l[:symmetric] == true
    l[:nplies] *= 2
    l[:orientation] = vcat(l[:orientation], reverse(l[:orientation]))
    l[:materials] = vcat(l[:materials], reverse(l[:materials]))
  end
  if :symmetricrepeats in keys(l) && l[:symmetricrepeats] > 1
    l[:nplies] *= l[:symmetricrepeats]
    l[:orientation] = repeat(l[:orientation], outer=[l[:symmetricrepeats]])
    l[:materials] = repeat(l[:materials], outer=[l[:symmetricrepeats]])
  end
  l[:z] = zeros(Float64, l[:nplies]+1)
  if typeof(m[:thickness]) == Float64
    l[:thickness] = l[:nplies] * m[:thickness]
    l[:z] = linspace(-l[:thickness]/2, l[:thickness]/2, l[:nplies]+1)
  elseif typeof(m[:thickness]) == Array{Float64, 1}
    @assert l[:nplies] == length(l[:materials])
    for i in 1:l[:nplies]
      l[:thickness] += m[:thickness][l[:materials][i]]
    end
    l[:z][1] = -l[:thickness]/2.0
    for i in 1:l[:nplies]
      l[:z][i+1] = l[:z][i] + m[:thickness][l[:materials][i]]
    end
  end
  computeABD!(l, m)
  l[:fTotal] = [f[:Nx],f[:Ny],f[:Nxy],f[:Mx],f[:My],f[:Mxy]] + l[:fT] + l[:fM]
  l[:f] = round(l[:ABD]\l[:fTotal], 15)
end

function computeABD!(l::Dict, m::Dict)
  A = zeros(Float64, 3, 3)
  B = zeros(Float64, 3, 3)
  D = zeros(Float64, 3, 3)
  ntemp = zeros(Float64, 3)
  mtemp = zeros(Float64, 3)
  nmoist = zeros(Float64, 3)
  mmoist = zeros(Float64, 3)
  for i in 1:l[:nplies]
    tk = l[:z][i+1]-l[:z][i]
    tk2 = l[:z][i+1]^2-l[:z][i]^2
    tk3 = l[:z][i+1]^3-l[:z][i]^3

    theta = float(l[:orientation][i])*(pi/180.0)
    A += qbarmat(qmat(m, l[:materials][i]), theta)*tk
    B += (1/2) * qbarmat(qmat(m, l[:materials][i]), theta)*tk2
    D += (1/3) * qbarmat(qmat(m, l[:materials][i]), theta)*tk3

    alpha = [
      m[:alpha1][l[:materials][i]]*cos(theta)^2 + m[:alpha2][l[:materials][i]]*sin(theta)^2,
      m[:alpha1][l[:materials][i]]*sin(theta)^2 + m[:alpha2][l[:materials][i]]*cos(theta)^2,
      2*cos(theta)*sin(theta)*(m[:alpha1][l[:materials][i]]-m[:alpha2][l[:materials][i]])
    ]

    beta = [
      m[:beta1][l[:materials][i]]*cos(theta)^2 + m[:beta2][l[:materials][i]]*sin(theta)^2,
      m[:beta1][l[:materials][i]]*sin(theta)^2 + m[:beta2][l[:materials][i]]*cos(theta)^2,
      2*cos(theta)*sin(theta)*(m[:beta1][l[:materials][i]]-m[:beta2][l[:materials][i]])
    ]

    ntemp += qbarmat(qmat(m, l[:materials][i]), theta)*alpha*l[:deltaTemp]*tk
    mtemp += (1/2)*qbarmat(qmat(m, l[:materials][i]), theta)*alpha*l[:deltaTemp]*tk2
    nmoist += qbarmat(qmat(m, l[:materials][i]), theta)*beta*l[:deltaMoisture]*tk
    mmoist += (1/2)*qbarmat(qmat(m, l[:materials][i]), theta)*beta*l[:deltaMoisture]*tk2
  end

  l[:fT] = vcat(ntemp, mtemp)
  l[:fM] = vcat(nmoist, mmoist)
  l[:ABD] = [ A B; B D]
  l[:abd] = inv(l[:ABD])
  l[:Ex] = 1/(l[:thickness]*l[:abd][1, 1])
  l[:Ey] = 1/(l[:thickness]*l[:abd][2, 2])
  l[:Gxy] = 1/(l[:thickness]*l[:abd][3, 3])
  l[:νxy] = -l[:abd][2, 1] / l[:abd][1, 1]
  l[:Eᶠx] = 12/(l[:thickness]^3*l[:abd][4, 4])
  l[:Eᶠy] = 12/(l[:thickness]^3*l[:abd][5, 5])
  l[:Gᶠxy] = 12/(l[:thickness]^3*l[:abd][6, 6])
  l[:νᶠxy] = -l[:abd][5, 4] / l[:abd][4, 4]
  l[:νᶠyx] = -l[:abd][5, 4] / l[:abd][5, 5]
end

function model_show(io::IO, l::Dict, compact::Bool)
  if compact
    println(m)
  else
    println("Effective material Properties:")
    println("  Ex  (psi) =       $(l[:Ex])")
    println("  Ey  (psi) =       $(l[:Ey])")
    println("  Gxy (psi) =       $(l[:Gxy])")
    println("  νxy       =       $(l[:νxy])")
    #println("  νyx       =       $(l[:νyx])")
    println()
    println("Strain Curvature (EpsilonKappa):")
    println("  εx   =       $(l[:f][1])")
    println("  εy   =       $(l[:f][2])")
    println("  γxy  =       $(l[:f][3])")
    println("  κx   =       $(l[:f][4])")
    println("  κy   =       $(l[:f][5])")
    println("  κxy  =       $(l[:f][6])")
    println()
    println("Effective flexural Properties:")
    println("  Eᶠx  (psi) =       $(l[:Eᶠx])")
    println("  Eᶠy  (psi) =       $(l[:Eᶠy])")
    println("  Gᶠxy (psi) =       $(l[:Gᶠxy])")
    println("  νᶠxy       =       $(l[:νᶠxy])")
    println("  νᶠyx       =       $(l[:νᶠyx])")
    println()
  end
end

show(io::IO, m::Dict) = model_show(io, m, false)
showcompact(io::IO, m::Dict) = model_show(io, m, true)


function ConvectiveAdjustmentNDE(NN, ds; iterations=nothing)
    weights, reconstruct = Flux.destructure(NN)

    T = ds["T"]
    wT = ds["wT"]
    FT = eltype(T)
    Nz = size(T, 3)
    Nt = size(T, 4)
    zc = znodes(T)
    zf = znodes(wT)
    times = T.times

    H = abs(zf[1]) # Domain depth/height
    τ = times[end]  # Simulation length

    Δẑ = diff(zc)[1] / H  # Non-dimensional grid spacing
    Dzᶜ = Dᶜ(Nz, Δẑ) # Differentiation matrix operator
    Dzᶠ = Dᶠ(Nz, Δẑ) # Differentiation matrix operator
    Dzᶜ = convert(Array{FT}, Dzᶜ)
    Dzᶠ = convert(Array{FT}, Dzᶠ)

    if isnothing(iterations)
        iterations = 1:length(times)
    end

    """
    Non-dimensional PDE is

        ∂T/∂t = - σ_wT/σ_T * τ/H * ∂/∂z(wT - K ∂T/∂z)

    where K = 0 if ∂T/∂z < 0 and K = 100 if ∂T/∂z > 0.
    """
    function ∂T∂t(T, p, t)
        weights = p[1:end-6]
        bottom_flux, top_flux, σ_T, σ_wT, H, τ = p[end-5:end]

        # Turbulent heat flux
        NN = reconstruct(weights)
        wT_interior = NN(T)
        wT = [bottom_flux; wT_interior; top_flux]
        ∂z_wT = Dzᶜ * wT

        # Convective adjustment
        ∂T∂z = Dzᶠ * T
        ∂z_K∂T∂z = Dzᶜ * min.(0, 10 * ∂T∂z)

        return σ_wT/σ_T * τ/H * (- ∂z_wT .+ ∂z_K∂T∂z)
    end

    tspan = FT.( (0.0, maximum(iterations) / Nt) )
    saveat = range(tspan[1], tspan[2], length=length(iterations))

    # See: https://github.com/SciML/DiffEqFlux.jl/blob/449efcecfc11f1eab65d0e467cf57db9f5a5dbec/src/neural_de.jl#L66-L67
    # We set the initial condition to `nothing`. Then we will set it to some actual initial condition when calling `solve`.
    ff = ODEFunction{false}(∂T∂t, tgrad=DiffEqFlux.basic_tgrad)
    return ODEProblem{false}(ff, nothing, tspan, saveat=saveat)
end


module sphere_dipole_examples
using FinEtools
using FinEtoolsAcoustics
using LinearAlgebra

function sphere_dipole_transient()
    println("The interior sphere accelerates in the alternately in the positive
    and negative x-direction, generating positive pressure ahead of it, negative
    pressure behind. Time-dependent simulation.
    ")
    rho = 1.21*phun("kg/m^3");# mass density
    c  = 343.0*phun("m/s");# sound speed
    bulk =  c^2*rho;
    a_amplitude=1.0*phun("mm/s^2");# amplitude of the  acceleration of the sphere
    # omega = 2000*phun("rev/s");      # frequency of the incident wave
    R = 50.0*phun("mm"); # radius of the interior sphere
    Ro = 8*R # radius of the external sphere
    P_amplitude = R*rho*a_amplitude; # pressure amplitude
    nref=2;
    nlayers=40;
    tolerance = Ro/(nlayers)/100
    frequency=1200.; # Hz
    omega=2*pi*frequency;
    dt=1.0/frequency/20;
    tfinal=90*dt;
    nsteps=round(tfinal/dt)+1;

    t0  =  time()

    # Hexahedral mesh
    fens,fes  =  H8sphere(R,nref);
    fens1,fes1  =  mirrormesh(fens, fes, [-1.0, 0.0, 0.0], [0.0, 0.0, 0.0],
    renumb =  r(c) = c[[1, 4, 3, 2, 5, 8, 7, 6]]);
    fens,newfes1,fes2 =  mergemeshes(fens1, fes1, fens, fes, tolerance)
    fes = cat(newfes1,fes2)

    # Derive the finite element sets for the boundary
    bfes  =  meshboundary(fes)
    # Outer spherical boundary
    function dout(xyz)
        return xyz/norm(xyz)
    end

    louter = selectelem(fens, bfes, facing = true, direction = dout)
    outer_fes = subset(bfes, louter);

    fens,fes  = H8extrudeQ4(fens, outer_fes, nlayers, (xyz, layer)->(R+layer/nlayers*(Ro-R))*xyz/norm(xyz));
    connected = findunconnnodes(fens, fes); fens, new_numbering = compactnodes(fens, connected);
    fess = renumberconn!(fes, new_numbering);

    geom  =  NodalField(fens.xyz)
    P  =  NodalField(zeros(FCplxFlt,size(fens.xyz,1),1))

    bfes  =  meshboundary(fes)

    # File  =   "Sphere.vtk"
    # vtkexportmesh(File, bfes.conn, geom.values, FinEtools.MeshExportModule.Q4)
    # @async run(`"paraview.exe" $File`)

    # File  =   "Sphere.vtk"
    # vtkexportmesh (File, fes.conn, fens.xyz, MeshExportModule.H8)
    # @async run(`"C:/Program Files (x86)/ParaView 4.2.0/bin/paraview.exe" $File`)

    linner = selectelem(fens, bfes, distance = R, from = [0.0 0.0 0.0], inflate = tolerance)
    louter = selectelem(fens, bfes, facing = true, direction = dout)

    println("Pre-processing time elapsed  =  ",time() - t0,"s")

    t1  =  time()

    numberdofs!(P)

    material = MatAcoustFluid(bulk,rho)
    femm  =  FEMMAcoust(IntegDomain(fes, GaussRule(3, 2)), material)

    S  =  acousticstiffness(femm, geom, P);
    C  =  acousticmass(femm, geom, P);

    abcfemm  =  FEMMAcoustSurf(IntegDomain(subset(bfes, louter), GaussRule(2, 2)), material)
    D  =  acousticABC(abcfemm, geom, P);

    # Inner sphere pressure loading
    function dipole(dpdn, xyz, J, label, t)
        n = cross(J[:,1],J[:,2]);
        n = vec(n/norm(n));
        dpdn[1] = -rho*a_amplitude*sin(omega*t)*n[1]
    end

    dipfemm  =  FEMMAcoustSurf(IntegDomain(subset(bfes, linner), GaussRule(2, 2)), material)

    # Solve
    P0 = deepcopy(P)
    P0.values[:] .= 0.0; # initially all pressure is zero
    vP0 = gathersysvec(P0);
    vP1 = zeros(eltype(vP0), size(vP0));
    vQ0 = zeros(eltype(vP0), size(vP0));
    vQ1 = zeros(eltype(vP0), size(vP0));
    t = 0.0;
    P1 = deepcopy(P0);

    fi  =  ForceIntensity(FCplxFlt, 1, (dpdn, xyz, J, label)->dipole(dpdn, xyz, J, label, t));
    La0 = distribloads(dipfemm, geom, P1, fi, 2);

    A = (2.0/dt)*S + D + (dt/2.)*C;

    step =0;
    while t <= tfinal
      step = step  + 1;
      println("Time $t ($(step)/$(round(tfinal/dt)+1))")
      t = t+dt;
      fi  = ForceIntensity(FCplxFlt, 1, (dpdn, xyz, J, label)->dipole(dpdn, xyz, J, label, t));
      La1 = distribloads(dipfemm, geom, P1, fi, 2);
      vQ1 = A\((2/dt)*(S*vQ0)-D*vQ0-C*(2*vP0+(dt/2)*vQ0)+La0+La1);
      vP1 = vP0 + (dt/2)*(vQ0+vQ1);
      vP0 = vP1;
      vQ0 = vQ1;
      P1 = scattersysvec!(P1, vec(vP1));
      P0 = P1;
      La0 = La1;
    end

    File  =   "sphere_dipole_1.vtk"
    vtkexportmesh(File, fes.conn, geom.values, FinEtools.MeshExportModule.VTK.H8;
     scalars = [( "realP", real(P1.values))])
    @async run(`"paraview.exe" $File`)

    true
end # sphere_dipole_transient

function allrun()
    println("#####################################################")
    println("# sphere_dipole_transient ")
    sphere_dipole_transient()
    return true
end # function allrun

end # module baffled_piston_examples