# # Vibration of a cube of nearly incompressible material

# Source code: [`unit_cube_modes_tut.jl`](unit_cube_modes_tut.jl)

# ## Description

# Compute the free-vibration spectrum of a unit cube of nearly
# incompressible isotropic material, E = 1, ν = 0.499, and ρ = 1 (refer to [1]).

# The solution with the `FinEtools` package is compared with a commercial
# software  solution, and hence we also export the model to Abaqus.

# ## References

# [1] Puso MA, Solberg J (2006) A stabilized nodally integrated tetrahedral.
# International Journal for Numerical Methods in Engineering 67: 841-867.
# [2] P. Krysl, Mean-strain 8-node hexahedron with optimized energy-sampling
# stabilization, Finite Elements in Analysis and Design 108 (2016) 41–53.

# ![](unit_cube-mode7.png)

# ## Goals

# - Show how to generate simple mesh.
# - Show how to set up the discrete model for a free vibration problem.
# - Show how to export the model to Abaqus.

##
# ## Definitions

# This is the finite element toolkit itself.
using FinEtools

# The linear stress analysis application is implemented in this package.
using FinEtoolsDeforLinear

# Convenience import.
using FinEtools.MeshExportModule

# The eigenvalue problem is solved with the Lanczos algorithm from this package.
using Arpack

# The material properties and dimensions are defined with physical units.
E = 1*phun("PA");
nu = 0.499;
rho = 1*phun("KG/M^3");
a = 1*phun("M"); # length of the side of the cube

# We generate a mesh of  5 x 5 x 5 serendipity 20-node hexahedral elements in a
# regular grid.
fens, fes  = H20block(a, a, a, 5, 5, 5);

# The problem is solved in three dimensions and hence we create the displacement
# field as three-dimensional with three displacement components per node. The
# degrees of freedom are then numbered  (note that no essential boundary
# conditions are applied, since the cube is free-floating).
geom = NodalField(fens.xyz)
u = NodalField(zeros(size(fens.xyz,1),3)) # displacement field
numberdofs!(u);

# The model is fully three-dimensional, and hence the material model  and the
# FEMM created below need to refer to an appropriate model-reduction scheme.
MR = DeforModelRed3D
material = MatDeforElastIso(MR, rho, E, nu, 0.0);

# Note that we compute the stiffness  and the mass matrix using different FEMMs.
# The difference  is only the quadrature rule chosen: in order to make the mass
# matrix  non-singular, an accurate  Gauss rule  needs to be used, whereas for
# the stiffness matrix we want to avoid the excessive stiffness  and therefore
# the reduced Gauss rule is used.
femm = FEMMDeforLinear(MR, IntegDomain(fes, GaussRule(3,2)), material);
K = stiffness(femm, geom, u)
femm = FEMMDeforLinear(MR, IntegDomain(fes, GaussRule(3,3)), material)
M = mass(femm, geom, u);

# The free vibration problem  can now be solved.   In order for the eigenvalue
# solver  to work well, we apply mass-shifting (otherwise the first matrix
# given to the solver – stiffness – would be singular). We specify the number
# of eigenvalues to solve for, and we  guess the frequency  with which to shift
# as 0.01 Hz.
neigvs = 20 # how many eigenvalues
OmegaShift = (0.01*2*pi)^2; # The frequency with which to shift

# The `eigs` routine can now be invoked to solve for a given number of
# frequencies from the smallest-magnitude end of the spectrum. Note that the
# mass shifting  needs to be undone when the solution is obtained.
evals, evecs, nconv = eigs(K+OmegaShift*M, M; nev=neigvs, which=:SM)
@show nconv == neigvs
evals = evals .- OmegaShift;
fs = real(sqrt.(complex(evals)))/(2*pi)
sigdig(n) = round(n * 10000) / 10000
println("Eigenvalues: $(sigdig.(fs)) [Hz]")
# The first nonzero frequency, frequency 7, should be around .263 Hz.

# The computed mode can be visualized in Paraview. Use the  "Animation view" to
# produce moving pictures for the mode.
mode = 7
scattersysvec!(u, evecs[:,mode])
File =  "unit_cube_modes.vtk"
vtkexportmesh(File, fens, fes; vectors=[("mode$mode", u.values)])
@async run(`"paraview.exe" $File`);

# Finally  we export the model to Abaqus.  Note that we specify the mass
# density property (necessary for dynamics).
AE = AbaqusExporter("unit_cube_modes_h20");
HEADING(AE, "Vibration modes of unit cube  of almost incompressible material.");
COMMENT(AE, "The  first six frequencies are rigid body modes.");
COMMENT(AE, "The  first nonzero frequency (7) should be around 0.26 Hz");
PART(AE, "part1");
END_PART(AE);
ASSEMBLY(AE, "ASSEM1");
INSTANCE(AE, "INSTNC1", "PART1");
NODE(AE, fens.xyz);
COMMENT(AE, "The hybrid form of the serendipity hexahedron is chosen because");
COMMENT(AE, "the material is  nearly incompressible.");
ELEMENT(AE, "C3D20RH", "AllElements", 1, connasarray(fes))
ORIENTATION(AE, "GlobalOrientation", vec([1. 0 0]), vec([0 1. 0]));
SOLID_SECTION(AE, "elasticity", "GlobalOrientation", "AllElements");
END_INSTANCE(AE);
END_ASSEMBLY(AE);
MATERIAL(AE, "elasticity")
ELASTIC(AE, E, nu)
DENSITY(AE, rho)
STEP_FREQUENCY(AE, neigvs)
END_STEP(AE)
close(AE)

# It remains is to load the model into Abaqus and execute it as a job.
# Alternatively Abaqus can be called on the input file to carry out the
# analysis at the command line as

# ```
# abaqus job=unit_cube_modes_h20.inp
# ```

# The output database `unit_cube_modes_h20.odb` can then be loaded for
# postprocessing, for instance from the command line as

# ```
# abaqus viewer database=unit_cube_modes_h20.odb
# ```

# Don't forget to compare the computed frequencies and the mode shapes.  For
# instance, the first six frequencies should be nearly 0, and the seventh
# frequency should be approximately  0.262 Hz. There may be  very minor
# differences due to the fact that  the FinEtools formulation is purely
# displacement-based, whereas the Abaqus model is hybrid (displacement plus
# pressure).


# Create example data
x = LinRange(-2, 2, 40)
y = x.^3 .+ x.^2 .+ x
# Draw a plot with panoramic ratio (16:9)
plot(x, y)
aspectratio(16/9)


abstract type ConvergenceMetric end

description(m::ConvergenceMetric) =
    error("`description` is not implemented for $(typeof(m)).")

"""
    converged(metric)

判断是否已收敛
"""
converged(m::ConvergenceMetric) = diff(m) <= tolerance(m)

diff(m::ConvergenceMetric) = m.Δ #error("`diff` is not implemented for $(typeof(m)).")

tolerance(m::ConvergenceMetric) = m.tol #error("`tolerance` is not implemented for $(typeof(m)).")

"""
    assess!(metric, state)

根据状态计算并判断是否已收敛
"""
assess!(m::ConvergenceMetric, s::AbstractOptimizerState) =
    error("`assess!` is not implemented for $(typeof(m)).")

const ConvergenceMetrics = Vector{ConvergenceMetric}

copy(cm::ConvergenceMetrics) = map(copy, cm)

# Utilities

abschange(curr, prev) = Float64(abs(curr - prev))
relchange(curr, prev) = Float64(abs(curr - prev) / abs(curr))

maxdiff(x::AbstractArray, y::AbstractArray) = mapreduce((a, b) -> abs(a - b), max, x, y)
abschange(curr::T, prev) where {T<:AbstractArray} = maxdiff(curr, prev)
relchange(curr::T, prev) where {T<:AbstractArray} = maxdiff(curr, prev) / maximum(abs, curr)

# Single value

"""
Absolute difference convergence for single objective optimization.

This convergence metric allows to estimate an absolute difference between consecutive
states of the optimization algorithm, and triggers convergence when,

- `|f(x) - f(x')| < ε`

where `ε` is a tolerance value, `x` and `x'` are previous and current minimizers
found by the optimization algorithm.
"""
mutable struct AbsDiff{T} <: ConvergenceMetric
    tol::T
    Δ::Float64
    value::T
end
AbsDiff(tol::T) where {T<:AbstractFloat} = AbsDiff(tol, Inf, zero(T))
AbsDiff() = AbsDiff(1e-12)
description(m::AbsDiff) = "|f(x) - f(x')|"
function assess!(m::AbsDiff, state::AbstractOptimizerState)
    val = value(state)
    m.Δ = abschange(val, m.value)
    m.value = val
    converged(m)
end
copy(m::AbsDiff) = AbsDiff(copy(m.tol), copy(m.Δ), copy(m.value))

"""
Relative difference convergence metric for single objective optimization.

This convergence metric allows to estimate a relative difference between consecutive
states of the optimization algorithm, and triggers convergence when,

- `|f(x) - f(x')|/|f(x')| < ε`

where `ε` is a tolerance value, `x` and `x'` are previous and current minimizers
found by the optimization algorithm.
"""
mutable struct RelDiff{T} <: ConvergenceMetric
    tol::T
    Δ::Float64
    value::T
end
RelDiff(tol::T) where {T<:AbstractFloat} = RelDiff(tol, Inf, zero(T))
RelDiff() = RelDiff(1e-12)
description(m::RelDiff) = "|f(x) - f(x')|/|f(x')|"
function assess!(m::RelDiff, state::AbstractOptimizerState)
    val = value(state)
    m.Δ = relchange(val, m.value)
    m.value = val
    converged(m)
end
copy(m::RelDiff) = RelDiff(copy(m.tol), copy(m.Δ), copy(m.value))

"""
    gd(A,R)

Calculate a generational distance between set `A` and the reference set `R`.
This metric measures the convergence, i.e. closeness of the non-dominated solutions
to the Pareto front, of a population.

*Note:* Parameters are column-major matrices.
"""
function gd(A::AbstractMatrix, R::AbstractMatrix)
    na, da = size(A)
    nr, dr = size(R)
    (na == 0 || nr == 0) && return Inf
    sum = 0
    for a in eachrow(A)
        sum += minimum(norm(a - r) for r in eachrow(R))
    end
    sum / na
end
gd(A::T, R::T) where {T<:Population} = gd(objectives(A), objectives(R))

"""
    igd(S,R)

Calculate an inverted generational distance, [`gd`](@ref), between set `S` and the reference set `R`.
Parameters are column-major matrices.
"""
igd(S, R) = gd(R, S)

"""
(Inverse) generational distance convergence metric for multi-objective optimization.

This convergence metric allows to estimate a (inverse) generational distance between
consecutive states of the multi-objective optimization algorithm, and triggers convergence when,

- ``GD(S,R) = \\frac{1}{|S|}\\left(\\sum_{s \\in S} \\min_{r \\in R}||f(s) - f(r)||^2\\right)^{1/2} < \\varepsilon``

where `ε` is a tolerance value, `S` and `R` are discrete Pareto front approximations
for previous and current state of the optimization algorithm.

The inverse generational distance calculated as `IGD(S,R) = GR(R,S)`.
To use, `IGD` metric pass `true` value to the metric constructor argument, e.g.

- `GD()` create a generational distance metric
- `GD(true)` create an inverse generational metric
"""
mutable struct GD{T} <: ConvergenceMetric
    tol::T
    Δ::Float64
    value::Matrix{T}
    inverted::Bool
end
GD(tol::T, inv = false) where {T<:AbstractFloat} = GD(tol, Inf, zeros(T, 0, 0), inv)
GD(inv = false) = GD(1e-5, inv)
function description(m::GD)
    prefix = m.inverted ? "I" : ""
    "|$(prefix)GD(P) - $(prefix)GD(P')|"
end
function assess!(m::GD, state::AbstractOptimizerState)
    val = value(state)
    m.Δ = m.inverted ? igd(val, m.value) : gd(val, m.value)
    m.value = val
    converged(m)
end
copy(m::GD) = GD(copy(m.tol), copy(m.Δ), copy(m.value), copy(m.inverted))

"""
    spread(S,R)

Returns a diversity metric of a population of set `S` to the reference set `R`.
"""
function spread(S::AbstractMatrix, R::AbstractMatrix)
    n = size(S, 2)
    m = size(R, 2)
    Δₖ = [
        minimum(
            norm(view(S, :, i) - view(R, :, j)) for
            i in 1:n if view(S, :, i) != view(R, :, j)
        ) for j = 1:m
    ]
    Δ = mean(Δₖ)
    sum(abs.(Δₖ .- Δ)) / m * Δ
end

function spread(S::AbstractMatrix)
    n = size(S, 2)
    n == 1 && return NaN
    Δₖ = [
        minimum(
            norm(view(S, :, i) - view(S, :, j)) for
            j in 1:n if view(S, :, i) != view(S, :, j)
        ) for i = 1:n
    ]
    Δ = mean(Δₖ)
    sum(abs.(Δₖ .- Δ)) / n * Δ
end

##########################
# Convergence Assessment #
##########################

function assess_convergence!(state)
    for metric in state.metrics
        converged = assess!(metric, state)
        if converged
            return true
        end
    end
    return false
end


### A Pluto.jl notebook ###
# v0.12.15

using Markdown
using InteractiveUtils

# ╔═╡ 2a872aae-33e9-11eb-09b2-5b2f2f54d419
md"""
## Individual Economics Formalism
"""

# ╔═╡ 847be240-33e9-11eb-3a0c-05989d6aa48e
md"""
This is how text rendering works.
"""

# ╔═╡ a470e230-33e9-11eb-1184-11506d5c302e
md"""This is how math rendering works.
	\begin{equation}
	i\hbar\frac{\partial \psi}{\partial t} = \hat H \psi
	\end{equation}
	"""

# ╔═╡ c40b3f00-33e9-11eb-3916-dff368cf3fbc
md"""
Let's take some notes.

>1. Initial conditions: Population, resources.
>2. Evolutionary traits: Population, resources, trade, demand and supply, currency.
"""

# ╔═╡ da9645d0-33e9-11eb-3e56-b58c1973201a
md"""
Sample codeblock for $Demand :: Person \times Person \to \mathbb R$.
```
demand(alice, bob) = ???
```
"""

# ╔═╡ 98695ad0-33e9-11eb-2dec-65f3e590b654
hint(text) = Markdown.MD(Markdown.Admonition("hint", "Hint", [text]));

# ╔═╡ 9419fde0-33e9-11eb-0127-c9fd0b722bb5
hint(md"""
	Click on the eye on the left to show the "code" that renders this box.
	""")

# ╔═╡ Cell order:
# ╟─2a872aae-33e9-11eb-09b2-5b2f2f54d419
# ╠═847be240-33e9-11eb-3a0c-05989d6aa48e
# ╠═a470e230-33e9-11eb-1184-11506d5c302e
# ╠═c40b3f00-33e9-11eb-3916-dff368cf3fbc
# ╠═da9645d0-33e9-11eb-3e56-b58c1973201a
# ╟─9419fde0-33e9-11eb-0127-c9fd0b722bb5
# ╟─98695ad0-33e9-11eb-2dec-65f3e590b654


using OrdinaryDiffEq, DifferentialEquations
using Flux

tspan = (0.0f0, 10.0f0)

"""
Simple ball in one spatial dimension, for 2 dimensions total:
    v, a
"""
function ball_system(du, u, p, t;
                     U_func_time=U_func_time_trivial,
                     U_func_space=U_func_space_trivial)
    g = p
    Ft = U_func_time(t, u)
    Fs = U_func_space(u)

    du[1] = u[2]
    du[2] = -g
    du .+= Ft .+ Fs
end

"""
Simple uncontrolled ball in one spatial dimension, for 2 dimensions total:
    v, a
Note: non-inplace version
"""
function ball_system(u, p, t)
    g = p

    du = zeros(eltype(p), size(u))
    du[1] = u[2]
    du[2] = -g
    return du
end

"""
Similar to the falling ball system, but with deformations recorded in a third
variable. Comes with nonlinearities, and requires an extra parameter to set
the strength

In words, the three variables now are:
    Position; normal
    Velocity; affected by gravity, increases (to 0) if close to the ground,
            and increases again as deformation decreases back to 0
    Deformation; 0 until near the ground, where it deforms at a certain rate
            and then reforms at an ideally slower rate
"""
function deformed_ball_system(du, u, p, t;
                     U_func_time=U_func_time_trivial,
                     U_func_space=U_func_space_trivial)
    # g, deformation_rate, restoration_rate = p
    g, r, k, damping = p

    Ft = U_func_time(t)
    Fs = U_func_space(u)

    # May allow the ball to go slightly negative
    # r = 0.1; # Radius of ball
    Δ = max(0.0, r - u[1])
    damping_force = Δ>0.0 ? -damping*u[2] : 0.0

    du[1] = u[2] + Fs[1]
    du[2] = -g + k*Δ + damping_force + Fs[2] + Ft

    # ground_closeness = deformation_rate*σ(100.0*(0.01-u[1]));
    # du3 = ground_closeness*(-u[2]) - restoration_rate*u[3] + Fs[3]

    # du[1] = u[2] + Fs[1]
    # du[2] = -g - du3 + Fs[2] + Ft
    # du[3] = du3
    # du[2] = -g + restoration_rate*u[3] + Fs[2] + Ft
    # du[3] = ground_closeness - restoration_rate*u[3] + Fs[3]
end

# Parameters
p1 = 9.81
u1 = [10.0f0, 0.0f0]

# p2 = [9.81, 1000.0, 100.0]
p2 = [9.81, 0.1, 10000.0, 5.0]
u2 = [1.0f0, 0.0f0]

ts = range(tspan[1], tspan[2], length=1000)

function solve_ball_system(;U_func_time = U_func_time_trivial,
                           U_func_space = U_func_space_trivial)
    prob = ODEProblem((du, u, p, t)->
                ball_system(du, u, p, t,
                            U_func_time=U_func_time,
                            U_func_space=U_func_space),
                    u1, tspan, p1)
    sol = solve(prob, Tsit5(), saveat=ts);
    return sol
end

function solve_deformed_ball_system(U_func_time = U_func_time_trivial,
                                    U_func_space = U_func_space_trivial)
    prob = ODEProblem((du, u, p, t)->
                deformed_ball_system(du, u, p, t,
                            U_func_time=U_func_time,
                            U_func_space=U_func_space),
                    u2, tspan, p2)
    sol = solve(prob, Tsit5(), saveat=ts);
    return Array(sol)
end

# Also define true dynamics in NN syntax
core_dyn_true = Dense(Float32.([0.0 1.0; 0.0 0.0]),
                      Float32.([0.0;-p1]),
                      identity)

export solve_ball_system, ball_system,
        solve_deformed_ball_system, deformed_ball_system,
        core_dyn_true

## Old scratch
# Try to define using a jump system
# bounce_rate(u,p,t) = u[1]<0.0 ? 1.0 : 0.0
# bounce_effect!(integrator) = integrator.u[2] += 10.0
# bounce_jump = VariableRateJump(bounce_rate, bounce_effect!)
#
# prob = ODEProblem(ball_system, u0, tspan, p)
# jump_problem = JumpProblem(prob, Direct(), bounce_jump)
# sol = solve(jump_problem, Tsit5())

# SCRATCH: Bounce using callbacks
# From: http://docs.juliadiffeq.org/latest/features/callback_functions.html#Example-1:-Bouncing-Ball-1
# function condition(u,t,integrator) # Event when event_f(u,t) == 0
#   u[1]
# end
# function affect!(integrator) # The actual bounce
#   integrator.u[2] = -integrator.u[2]
# end
# # Note: by default the callback will cause extra saves
# cb = ContinuousCallback(condition,affect!,
#                         save_positions = (false,false))
# prob = ODEProblem(ball_system, u0, tspan, p)
# sol = solve(prob, Tsit5(), saveat=ts, callback=cb)
            #initialize_save=false)
# plot(sol)


@testset "Grids" begin

    # with a shift to the grid element, check if produce the correct floored index
    function check(grid, range, shift, idx_shift)
        for i in range
            @test(floor(grid, grid[i] + shift) == i + idx_shift)
            # if floor(grid, grid[i] + shift) != i + idx_shift
            #     return false
            # end
        end
        return true
    end

    @testset "UniformGrid" begin
        uniform = Grid.Uniform{Float64,4}(0.0, 1.0, (true, true))
        @test floor(uniform, 0.0) == 1
        @test floor(uniform, uniform[1]) == 1

        δ = 1.0e-12
        check(uniform, 2:uniform.size - 1, δ, 0)
        check(uniform, 2:uniform.size - 1, -δ, -1)

        @test floor(uniform, uniform[end]) == uniform.size - 1
        @test floor(uniform, 1.0) == uniform.size - 1

        uniform = Grid.Uniform{Float64,2}(0.0, 1.0, (true, true))
        @test floor(uniform, 0.0) == 1
        @test floor(uniform, uniform[1]) == 1

        δ = 1.0e-12
        check(uniform, 2:uniform.size - 1, δ, 0)
        check(uniform, 2:uniform.size - 1, -δ, -1)

        @test floor(uniform, uniform[end]) == uniform.size - 1
        @test floor(uniform, 1.0) == uniform.size - 1
    end

    @testset "Log Grid for Tau" begin
        β = 10.0
        tau = Grid.tau(β, 0.2β, 8)
        @test floor(tau, 0.0) == 1
        @test floor(tau, tau[1]) == 1 # tau[1]=0^+ is special

        δ = 1.0e-12
        check(tau, 2:tau.size - 1, δ, 0)
        check(tau, 2:tau.size - 1, -δ, -1)

        @test floor(tau, tau[end]) == tau.size - 1
        @test floor(tau, β) == tau.size - 1
    end

    @testset "Log Grid for fermiK" begin
        kF, maxK, halfLife = 1.0, 3.0, 0.5
        K = Grid.fermiK(kF, maxK, halfLife, 16)
        # println(K.grid)
        @test floor(K, 0.0) == 1
        @test floor(K, K[1]) == 1

        δ = 1.0e-12
        check(K, 2:K.size - 1, δ, 0)
        check(K, 2:K.size - 1, -δ, -1)

        @test floor(K, K[end] - δ) == K.size - 1
        @test floor(K, K[end]) == K.size - 1
        @test floor(K, maxK) == K.size - 1
    end

    @testset "Log Grid for boseK" begin
        kF, maxK, halfLife = 1.0, 3.0, 0.5
        K = Grid.boseK(kF, maxK, halfLife, 16)
        # println(K.grid)
        @test floor(K, 0.0) == 1
        @test floor(K, K[1]) == 1

        δ = 1.0e-12
        check(K, 2:K.size - 1, δ, 0)
        check(K, 2:K.size - 1, -δ, -1)

        @test floor(K, K[end] - δ) == K.size - 1
        @test floor(K, K[end]) == K.size - 1
        @test floor(K, maxK) == K.size - 1
    end

end

@testset "UniLog Grids" begin
    function check(grid, range, shift, idx_shift)
        for i in range
            @test(floor(grid, grid[i] + shift) == i + idx_shift)
            # if floor(grid, grid[i] + shift) != i + idx_shift
            #     return false
            # end
        end
        return true
    end

    @testset "UniLog" begin
        EPS = 1e-9
        bound = @SVector[1.0, 3.0]
        init = 4
        minterval = 0.01
        M = 2
        N = 3
        isopen = @SVector[false,false]
        d2s = true
        g = Grid.UniLog{Float64}(bound, init, minterval, M, N, d2s,isopen)

        val = Grid._grid(g,init)
        @test Grid._floor(g,val-EPS) == init
        @test Grid._floor(g,val+EPS) == init
        for i = init+1:(M+1)*N+init
            val = Grid._grid(g,i)
            # @printf("%10.6f , %10.6f\n", i, val)
            # @printf("\t%10.6f , %10.6f\n", val-EPS, Grid._floor(g,val-EPS))
            # @printf("\t%10.6f , %10.6f\n", val+EPS, Grid._floor(g,val+EPS))
            @test Grid._floor(g,val-EPS) == i-1
            @test Grid._floor(g,val+EPS) == i
        end
    end

    @testset "UniLogs" begin
        EPS = 1e-9
        seg = 4
        bounds = @SVector[0.0,1.0,2.0,3.0]
        M=2
        N=3
        minterval = 0.01
        isopen = @SVector[false,false]
        g = Grid.UniLogs{Float64,(M+1)*N*seg+1,seg}(bounds,minterval,M,N,isopen,[true,true])

        val = g.grid[1]
        @test floor(g,val-EPS) == 1
        @test floor(g,val+EPS) == 1
        for i = 2:g.size-1
            val = g.grid[i]
            # @printf("%10.6f , %10.6f\n", i, val)
            # @printf("\t%10.6f , %10.6f\n", val-EPS, floor(g,val-EPS))
            # @printf("\t%10.6f , %10.6f\n", val+EPS, floor(g,val+EPS))
            @test floor(g,val-EPS) == i-1
            @test floor(g,val+EPS) == i
        end
        val = g.grid[g.size]
        @test floor(g,val-EPS) == g.size-1
        @test floor(g,val+EPS) == g.size-1

        for i =1:seg-1
            val = g.segment[i]
            # @printf("%10.6f , %10.6f\n", g.segindex[i], val)
            # @printf("\t%10.6f , %10.6f\n", val-EPS, floor(g,val-EPS))
            # @printf("\t%10.6f , %10.6f\n", val+EPS, floor(g,val+EPS))
            @test floor(g,val-EPS) == g.segindex[i]-1
            @test floor(g,val+EPS) == g.segindex[i]
        end
    end

    @testset "UniLog Grid for Tau" begin
        β = 10.0
        tau = Grid.tauUL(β, 0.001, 2,3)
        @test floor(tau, 0.0) == 1
        @test floor(tau, tau[1]) == 1 # tau[1]=0^+ is special

        δ = 1.0e-12
        check(tau, 2:tau.size - 1, δ, 0)
        check(tau, 2:tau.size - 1, -δ, -1)

        @test floor(tau, tau[end]) == tau.size - 1
        @test floor(tau, β) == tau.size - 1
    end

    @testset "UniLog Grid for fermiK" begin
        kF, maxK, minterval = 1.0, 3.0, 0.001
        K = Grid.fermiKUL(kF, maxK, minterval, 2,3)
        # println(K.grid)
        @test floor(K, 0.0) == 1
        @test floor(K, K[1]) == 1

        δ = 1.0e-12
        check(K, 2:K.size - 1, δ, 0)
        check(K, 2:K.size - 1, -δ, -1)

        @test floor(K, K[end] - δ) == K.size - 1
        @test floor(K, K[end]) == K.size - 1
        @test floor(K, maxK) == K.size - 1
    end

    @testset "UniLog Grid for boseK" begin
        kF, maxK, minterval = 1.0, 3.0, 0.001
        K = Grid.boseKUL(kF, maxK, minterval,2,3)
        # println(K.grid)
        @test floor(K, 0.0) == 1
        @test floor(K, K[1]) == 1

        δ = 1.0e-12
        check(K, 2:K.size - 1, δ, 0)
        check(K, 2:K.size - 1, -δ, -1)

        @test floor(K, K[end] - δ) == K.size - 1
        @test floor(K, K[end]) == K.size - 1
        @test floor(K, maxK) == K.size - 1
    end

end

@testset "Interpolate" begin
    function kernelFermiT(t, ω, β=1)
        return exp(-ω * t) / (1 + exp(-ω * β))
    end

    @testset "Linear1D" begin
        β = π
        N,M= 3, 4
        tgrid = Grid.tauUL(β, 0.01β, M, N)
        # tugrid = Grid.Uniform{Float64,33}(0.0, β, (true, true))
        # kugrid = Grid.Uniform{Float64,33}(0.0, maxK, (true, true))
        f(t) = t
        data = zeros(tgrid.size)

        for (ti, t) in enumerate(tgrid.grid)
            data[ti] = f(t)
        end

        for ti = 1:tgrid.size - 1
            t = tgrid[ti] + 1.e-6
            fbar = Grid.linear1D(data, tgrid, t)
            @test abs(f(tgrid[ti]) - fbar) < 3.e-6 # linear interpolation, so error is δK+δt
            @test f(tgrid[ti]) < fbar
            @test f(tgrid[ti + 1]) > fbar
        end
        for ti = 2:tgrid.size
            t = tgrid[ti] - 1.e-6
            fbar = Grid.linear1D(data, tgrid, t)
            @test abs(f(tgrid[ti]) - fbar) < 3.e-6 # linear interpolation, so error is δK+δt
            @test f(tgrid[ti]) > fbar
            @test f(tgrid[ti - 1]) < fbar
        end

        t = tgrid[1] + eps(Float64)*1e3
        fbar = Grid.linear1D(data, tgrid, t)
        @test abs(f(t) - fbar) < 3.e-6 # linear interpolation, so error is δK+δt

        t = tgrid[tgrid.size] - eps(Float64)*1e3
        fbar = Grid.linear1D(data, tgrid, t)
        @test abs(f(t) - fbar) < 3.e-6 # linear interpolation, so error is δK+δt

        tlist = rand(10) * β
        # println(tlist)

        for (ti, t) in enumerate(tlist)
            fbar = Grid.linear1D(data, tgrid, t)
            # println("$k, $t, $fbar, ", f(k, t))
            @test abs(f(t) - fbar) < 3.e-6 # linear interpolation, so error is δK+δt
        end
    end

    @testset "Linear2D" begin
        β, kF, maxK = 10.0, 1.0, 3.0
        Nt, Nk = 8, 7
        tgrid = Grid.tau(β, 0.2β, Nt)
        kgrid = Grid.boseK(kF, maxK, 0.2kF, Nk)
        # tugrid = Grid.Uniform{Float64,33}(0.0, β, (true, true))
        # kugrid = Grid.Uniform{Float64,33}(0.0, maxK, (true, true))
        f(k, t) = k + t * 1.1
        data = zeros((Nk, Nt))

        for (ti, t) in enumerate(tgrid.grid)
            for (ki, k) in enumerate(kgrid.grid)
                data[ki, ti] = f(k, t)
            end
        end

        for ti = 1:tgrid.size - 1
            for ki = 1:kgrid.size - 1
                t = tgrid[ti] + 1.e-6
                k = kgrid[ki] + 1.e-6
                fbar = Grid.linear2D(data, kgrid, tgrid, k, t)
                @test abs(f(kgrid[ki], tgrid[ti]) - fbar) < 3.e-6 # linear interpolation, so error is δK+δt
                @test f(kgrid[ki], tgrid[ti]) < fbar
                @test f(kgrid[ki], tgrid[ti + 1]) > fbar
                @test f(kgrid[ki + 1], tgrid[ti]) > fbar
                @test f(kgrid[ki + 1], tgrid[ti + 1]) > fbar
            end
        end

        for ti = 2:tgrid.size
            for ki = 2:kgrid.size
                t = tgrid[ti] - 1.e-6
                k = kgrid[ki] - 1.e-6
                fbar = Grid.linear2D(data, kgrid, tgrid, k, t)
                @test abs(f(kgrid[ki], tgrid[ti]) - fbar) < 3.e-6 # linear interpolation, so error is δK+δt
                @test f(kgrid[ki], tgrid[ti]) > fbar
                @test f(kgrid[ki], tgrid[ti - 1]) < fbar
                @test f(kgrid[ki - 1], tgrid[ti]) < fbar
                @test f(kgrid[ki - 1], tgrid[ti - 1]) < fbar
            end
        end

        tlist = rand(10) * β
        klist = rand(10) * maxK
        # println(tlist)

        for (ti, t) in enumerate(tlist)
            for (ki, k) in enumerate(klist)
                fbar = Grid.linear2D(data, kgrid, tgrid, k, t)
                # println("$k, $t, $fbar, ", f(k, t))
                @test abs(f(k, t) - fbar) < 3.e-6 # linear interpolation, so error is δK+δt
            end
        end
    end

    @testset "TestInterpolation1D for tauUL" begin
        β, minterval = 1.0, 0.0001
        M, N = 11, 4
        tgrid1 = Grid.tauUL(β, minterval, M, N)
        tgrid2 = Grid.tauUL(β, minterval, 2M, 2N)
        # tugrid = Grid.Uniform{Float64,33}(0.0, β, (true, true))
        # kugrid = Grid.Uniform{Float64,33}(0.0, maxK, (true, true))
        f(t) = kernelFermiT(t/β,0.01)

        d_max, std = Grid.testInterpolation1D(f, tgrid1, tgrid2, true)
        println("Testing interpolation for tauUL grid")
        println("d_max=",d_max,"\t std=", std)
    end

    @testset "TestInterpolation1D for fermiKUL" begin
        M, N= 15, 8
        kF, maxK, minterval = 1.0, 3.0, 0.00001
        kgrid1 = Grid.fermiKUL(kF, maxK, minterval, M, N)
        kgrid2 = Grid.fermiKUL(kF, maxK, minterval, 2M, 2N)
        # tugrid = Grid.Uniform{Float64,33}(0.0, β, (true, true))
        # kugrid = Grid.Uniform{Float64,33}(0.0, maxK, (true, true))
        f(k) = 1.0/(0.0004π^2+(k^2-kF^2)^2)

        d_max, std = Grid.testInterpolation1D(f, kgrid1, kgrid2, true)
        println("Testing interpolation for fermiKUL grid")
        println("d_max=",d_max,"\t std=", std)
    end

    @testset "Optimize UniLog grid" begin
        struct Para
            β::Float64
            τ_min::Float64
            k_min::Float64
            k_max::Float64
            kF::Float64

            function Para()
                return new(10.0, 0.001, 0.0001, 3.0, 1.0)
            end
        end

        para = Para()
        MN = 64

        println("Testing optimization of tauUL")
        f(t) = kernelFermiT(t/para.β,1e0*para.kF^2*para.β)
        M, N, d_max = Grid.optimizeUniLog(Grid.tauUL, para, MN, f)
        println(MN,"\t", M,"\t", N,"\t", d_max)

        tgrid1 = Grid.tauUL(para, M, N)
        tgrid2 = Grid.tauUL(para, 2M, 2N)
        d_max, std = Grid.testInterpolation1D(f, tgrid1, tgrid2, true)
        println("Testing interpolation for tauUL grid")
        println("d_max=",d_max,"\t std=", std)

        MN = 64
        println("Testing optimization of fermiKUL")
        f2(k) = 1.0/((2π/para.β)^2+(k^2-para.kF^2)^2)
        M, N, d_max= Grid.optimizeUniLog(Grid.fermiKUL, para, MN, f2)
        println(MN,"\t", M,"\t", N,"\t", d_max)

        kgrid1 = Grid.fermiKUL(para, M, N)
        kgrid2 = Grid.fermiKUL(para, 2M, 2N)
        d_max, std, index = Grid.testInterpolation1D(f2, kgrid1, kgrid2, true, true)
        println("Testing interpolation for fermiKUL grid")
        println("d_max=",d_max,"\t std=", std)
        # println("index=", index, "\t x=", kgrid2[index])
        # index1=(floor(kgrid1, kgrid2[index]))
        # println(kgrid1[index1],"\t",kgrid1[index1+1])
        # println(kgrid1.grid)

    end

end


using Plots, StatsBase, Statistics, LaTeXStrings, JLD

function InitialNetwork(dim, P)
    Network = sample([-1,0], Weights([1-P, P]),(dim,dim))
    return Network
end

function FindNeighbors(i, j, Network, dim)
    Numbereds = 0
    colorList = []
    for neighbor in ([0,-1], [-1,0])
        if j + neighbor[2] >= 1 && i + neighbor[1] >= 1 && Network[([i, j] + neighbor)...] > 0
            push!(colorList,Network[([i, j] + neighbor)...])
            Numbereds += 1
        end
    end
    return colorList, Numbereds #colorList contain the node and its neighbors
end

function RecursionMapping(x, L)
    while L[x] != L[L[x]]
        x = L[x]
    end
    return L[x]
end

@inline function HKNetworkDynamic(dim, P)
    Network = InitialNetwork(dim, P)
    S = []
    L = []
    k = 1

    for j in 1:dim
        for i in 1:dim
            if Network[i,j] != 0
                continue
            end
            NColor, NNum = FindNeighbors(i,j,Network,dim)
            if NNum == 0
                Network[i,j] = k
                push!(L, k)
                push!(S, 1)
                k += 1
            elseif NNum == 1
                Network[i,j] = RecursionMapping(NColor[1],L)
                S[RecursionMapping(NColor[1],L)] += 1
            elseif NNum == 2 && RecursionMapping(NColor[1],L) == RecursionMapping(NColor[2],L)
                Network[i,j] = RecursionMapping(NColor[1],L)
                S[RecursionMapping(NColor[1],L)] += 1
            else
                S[RecursionMapping(NColor[1],L)] += 1 + S[RecursionMapping(NColor[2],L)]
                S[RecursionMapping(NColor[2],L)] = 0
                Network[i,j] = RecursionMapping(NColor[1],L)
                L[NColor[2]] = RecursionMapping(NColor[1],L)
            end
        end
    end
    return Network, S, L
end

function JoinColors(Network, L)
    dim = size(Network)[1]
    for i in 1:dim
        for j in 1:dim
            if Network[i,j]!= -1
                Network[i,j] = RecursionMapping(Network[i,j],L)
            end
        end
    end
    return Network
end

function FindCorrelationLength(Network, S)
    if length(Set(S)) <= 2
        return 0.0
    end
    if findfirst(x->x==max(S...),S) ∈ intersect(Network[1,:],Network[end,:])
        BiggestFinite = findfirst(x->x==sort(S, rev=true)[2],S)
    else
        BiggestFinite = findfirst(x->x==max(S...),S)
    end
    BFiniteCluster = Tuple.(findall(x->x==BiggestFinite,Network))
    BFiniteClusterSize = length(BFiniteCluster)
    MassCenter = reduce(.+, BFiniteCluster) ./ BFiniteClusterSize
    return √(sum(pos -> reduce(.+, (pos .- MassCenter).^2),Tuple.(BFiniteCluster))/BFiniteClusterSize)
end

dimlist = [10,20,40,80,160]
runnumlist = [10000,5000,3000,2000,1000]
PList = hcat(0:0.02:1)
totalData = load("../../Data/Q2/Q2-totdata.jld")["data"]

p1 = begin
    scatter(dpi = 200)
    for i in 1:5
        dim = dimlist[i]
        runnum = runnumlist[i]
        data = totalData[i]
        plot!(PList,data[1],linestyle = :dash, label = nothing, c = :black)
        scatter!(PList,data[1],label = L"Network\ %$dim\times%$dim,\ %$runnum\ runs",markersize = 3.5)
    end
    scatter!(
        title = L"Correlation\ Length",
        xlabel = L"P",
        ylabel = L"\xi_{(P)}")
end

p2 = begin
    scatter(dpi = 200)
    for i in 1:5
        dim = dimlist[i]
        runnum = runnumlist[i]
        data = totalData[i]
        scatter!(PList,data[1], ribbon= data[2],markersize = 1)
        plot!(PList,data[1],legend = nothing, c = :black,linestyle = :dot)
    end
    scatter!(
        title = L"Correlation\ Length",
        xlabel = L"P",
        ylabel = L"\xi_{(P)}")
end

p3 = begin
    plot(dpi = 200)
    for i in 1:5
        dim = dimlist[i]
        runnum = runnumlist[i]
        data = totalData[i]
        scatter!(PList,data[1],label = nothing,markersize = 3, c = :black, alpha = 0.5)
        plot!(PList,data[1], label = L"Network\ %$dim\times%$dim,\ %$runnum\ runs")
    end
    scatter!(
        title = L"Correlation\ Length",
        xlabel = L"P",
        ylabel = L"\xi_{(P)}")
end

totalData = load("../../Data/Q2/Q2-totdata-zoomed.jld")["data"]
dimlist = [80,160]
runnumlist = [2000,1000]
PList = hcat(0.5:0.005:0.7)

p4 = begin
    plot()
    col = [:purple,:steelblue]
    for i in 1:2
        dim = dimlist[i]
        runnum = runnumlist[i]
        data = totalData[i]
        plot!(PList,data[1],c = :black, label = nothing)
        scatter!(PList,data[1],ribbon =  data[2],yerr = data[2],label = L"Network\ %$dim\times%$dim,\ %$runnum\ runs", c = col[i])
    end
    scatter!(
        title = L"Correlation\ Length",
        xlabel = L"P",
        ylabel = L"\xi_{(P)}")
end
savefig("../../Figs/Q2/CL3.pdf")

plot(plot(p2,p1, layout= (2,1)),p4,size = (1200,750))
savefig("../../Figs/Q2/CL.pdf")

# for n in 1:5
#     dim = dimlist[n]
#     runnum = runnumlist[n]
#     CLAvg = []
#     CLSTD = []
#     for p in PList
#         totalruns = []
#         for i in 1:runnum
#             Network, S, L = HKNetworkDynamic(dim, p)
#             Network = JoinColors(Network, L)
#             push!(totalruns, FindCorrelationLength(Network, S))
#         end
#         push!(CLAvg, mean(totalruns))
#         push!(CLSTD, std(totalruns))
#         print("\r$p")
#     end
#     push!(totalData, (CLAvg,CLSTD))
# end
# save("../../Data/Q2/Q2-totdata.jld", "data", totalData)

# for n in 1:2
#     dim = dimlist[n]
#     runnum = runnumlist[n]
#     CLAvg = []
#     CLSTD = []
#     for p in PList
#         totalruns = []
#         for i in 1:runnum
#             Network, S, L = HKNetworkDynamic(dim, p)
#             Network = JoinColors(Network, L)
#             push!(totalruns, FindCorrelationLength(Network, S))
#         end
#         push!(CLAvg, mean(totalruns))
#         push!(CLSTD, std(totalruns))
#         print("\r$p")
#     end
#     push!(totalData, (CLAvg,CLSTD))
# end
# save("../../Data/Q2/Q2-totdata-zoomed.jld", "data", totalData)


using Tullio
cd(joinpath(dirname(pathof(Tullio)), "..", "benchmarks", "01"))
using Pkg; pkg"activate ."

# or

using Pkg; pkg"add LoopVectorization"
using Pkg; pkg"add TensorCast NNlib ForwardDiff Zygote"

# This example is a nice usage:
# https://discourse.julialang.org/t/help-to-improve-performance-of-gradient-calculation-on-tensor-operations/37773/3

using TensorCast

function cosinesim(a, b)
    @reduce similarity[i, j, k] := sum(s) a[s, j, k] * b[s, i, k] /
        sqrt( @reduce [_, j, k] := sum(s') a[s', j, k]^2) /
        sqrt( @reduce [_, i, k] := sum(s'') b[s'', i, k]^2)
end

function mysoftmax(a)
    @cast submax[i, j, k] := a[i, j, k] - @reduce [_, j, k] := maximum(i) a[i, j, k]
    @cast r[i, j, k] := exp(submax[i, j, k]) / @reduce [_, j, k] := sum(i) exp(submax[i, j, k])
end

pairwise2(a) = mysoftmax(cosinesim(a))

N, W, R, B = 16, 64, 4, 16;
a = rand(Float32, W, R, B);
b = rand(Float32, W, N, B);

#=
First look just at the numerator. This should be easy with `NNlib.batched_mul`,
but there is [this issue](https://github.com/FluxML/Zygote.jl/issues/552)
so I'm using [my PR](https://github.com/FluxML/NNlib.jl/pull/191)...
but the end result is a gradient 4x faster.

Almost as fast as Tullio! (which is faster without multi-threading today, something is broken)
=#

using Zygote, NNlib

reducemul(a, b) = @reduce z[i, j, k] := sum(s) a[s, j, k] * b[s, i, k]
reducemul(a, b) ≈ batched_mul(batched_transpose(b), a) # true

@btime reducemul($a, $b); # 98.262 μs (52 allocations: 342.41 KiB)
@btime batched_mul(batched_transpose($b), $a); # 13.605 μs (5 allocations: 4.20 KiB) -> 6.447 μs (2 allocations: 4.14 KiB) with MKL

using Tullio, LoopVectorization, ForwardDiff

tullio_mul(a, b) = @tullio z[i, j, k] := a[s, j, k] * b[s, i, k]
tullio_mul2(a, b) = @tullio z[i, j, k] := a[s, j, k] * b[s, i, k]  grad=Dual
reducemul(a, b) ≈ tullio_mul(a, b) # true

@btime tullio_mul($a, $b); # 2.696 μs (1 allocation: 4.13 KiB) -- improved!

#=
For gradients, I've inserted `(x->x).()` into these because sum creates a `FillArray`
which some methods don't like, but any useful calculation would have something else after this.

Now not needed for @tullio!
=#

grad_a = gradient((a,b) -> sum(reducemul(a, b)), a, b)[1];
grad_a ≈ gradient((a,b) -> sum((x->x), batched_mul(PermutedDimsArray(b, (2,1,3)), a)), a, b)[1] # true
grad_a ≈ gradient((a,b) -> sum(tullio_mul(a, b)), a, b)[1] # true
grad_a ≈ gradient((a,b) -> sum(tullio_mul2(a, b)), a, b)[1] # true

@btime gradient((a,b) -> sum(reducemul(a, b)), $a, $b);       # 307.836 μs (193 allocations: 1.17 MiB)
@btime gradient((a,b) -> sum(x->x, reducemul(a, b)), $a, $b); # 378.264 μs (3316 allocations: 1.23 MiB)

@btime gradient((a,b) -> sum(x->x, batched_mul(PermutedDimsArray(b, (2,1,3)), a)), $a, $b); # 101.782 μs (3159 allocations: 151.52 KiB) -> 218.180 μs (3334 allocations: 161.70 KiB) MKL?

@btime gradient((a,b) -> sum(tullio_mul(a, b)), $a, $b);       # 21.190 μs (41 allocations: 85.89 KiB)
@btime gradient((a,b) -> sum(x->x, tullio_mul(a, b)), $a, $b); # 79.291 μs (3156 allocations: 151.19 KiB)

# version with ForwardDiff:
@btime gradient((a,b) -> sum(tullio_mul2(a, b)), $a, $b);      # 25.168 μs (37 allocations: 85.70 KiB)

#=
Tullio ought to make it easy to fuse that multiplication with the division, perhaps?
But this is slow!
=#

function cosine_nnlib(a, b)
    @reduce den1[j, k] := sum(s) a[s, j, k]^2
    @reduce den2[i, k] := sum(s) b[s, i, k]^2
    bmm = batched_mul(PermutedDimsArray(b, (2,1,3)), a)
    @cast similarity[i, j, k] := bmm[i, j, k] / sqrt(den1[j, k] * den2[i, k])
end

function cosine_fused(a, b)
    @tullio den1[j, k] := a[s, j, k]^2
    @tullio den2[i, k] := b[s, i, k]^2
    @tullio similarity[i, j, k] := a[s, j, k] * b[s, i, k] / sqrt(den1[j, k] * den2[i, k])
end

function cosine_separated(a, b)
    @tullio bmm[i, j, k] := a[s, j, k] * b[s, i, k]

    @tullio den1[j, k] := a[s, j, k]^2
    @tullio den2[i, k] := b[s, i, k]^2

    @tullio f1[j, k] := 1/sqrt(den1[j, k])
    @tullio f2[i, k] := 1/sqrt(den2[i, k])
    @tullio similarity[i, j, k] := bmm[i, j, k] * f1[j, k] * f2[i, k]
end

cosinesim(a, b) ≈ cosine_nnlib(a, b) # true
cosinesim(a, b) ≈ cosine_fused(a, b) # true
cosinesim(a, b) ≈ cosine_separated(a, b) # true

@btime cosinesim($a, $b);    # 318.341 μs (87 allocations: 425.14 KiB)
@btime cosine_nnlib($a, $b); #  34.407 μs (42 allocations: 91.20 KiB) -> 112.308 μs (179 allocations: 99.05 KiB) MKL
@btime cosine_fused($a, $b);   #  7.678 μs (3 allocations: 5.59 KiB)
@btime cosine_separated($a, $b);   #  4.672 μs (6 allocations: 11.19 KiB)

grad_a2 = gradient((a,b) -> sum(cosinesim(a, b)), a, b)[1];
grad_a2 ≈ gradient((a,b) -> sum(cosine_nnlib(a, b)), a, b)[1] # true
grad_a2 ≈ gradient((a,b) -> sum(cosine_fused(a, b)), a, b)[1] # true
grad_a2 ≈ gradient((a,b) -> sum(cosine_separated(a, b)), a, b)[1] # true

@btime gradient((a,b) -> sum(cosinesim(a, b)), $a, $b);    #  984.351 μs (1414 allocations: 3.51 MiB)
@btime gradient((a,b) -> sum(cosine_nnlib(a, b)), $a, $b); #  232.991 μs (6375 allocations: 579.78 KiB) -> 280.876 μs (3442 allocations: 520.61 KiB) MKL
@btime gradient((a,b) -> sum(cosine_fused(a, b)), $a, $b);     # 80.207 μs (129 allocations: 252.86 KiB)
@btime gradient((a,b) -> sum(cosine_separated(a, b)), $a, $b); # 80.367 μs (207 allocations: 267.08 KiB)

# cosine_fused might end up computing / sqrt N^3 times, instead of 2N^2 times,
# so it's not obviously a great idea.
# But I like LoopVectorization is smart enough to avoid that? Gradient is as fast now.

# Its gradient now looks like this:

Tullio.@printgrad x/sqrt(y*z)   x y z

#=
Aside, things about softmax:
=#

mysoftmax(a) ≈ softmax(a, dims=1)

@btime mysoftmax($a);       # 77.517 μs (37 allocations: 50.17 KiB)
@btime softmax($a, dims=1); # 45.405 μs (8 allocations: 33.03 KiB)

@btime gradient(a -> sum(mysoftmax(a)), $a);      # 640.619 μs
@btime gradient(a -> sum(softmax(a, dims=1)), $a); # 95.622 μs
@btime gradient(a -> sum(x->x, mysoftmax(a)), $a);      #
@btime gradient(a -> sum(x->x, softmax(a, dims=1)), $a); # 322.103 μs (12358 allocations: 356.17 KiB)

# add avx to versions from https://github.com/FluxML/NNlib.jl/pull/135/
function NNlib.softmax(xs::Array; dims=1)
    max_ = maximum(xs, dims=dims)
    out = @avx exp.(xs .- max_)
    @avx out .= out ./ sum!(max_, out)
end

@btime softmax($a, dims=1); # 16.084 μs -- 3x quicker

function NNlib.∇softmax(Δ::Array, xs::Array; dims=1)
    sf = softmax(xs, dims=dims)
    @avx sf .* (Δ .- sum(Δ .* sf; dims=dims))
end

@btime gradient(a -> sum(x->x, softmax(a, dims=1)), $a); # 260.441 μs (12358 allocations: 323.36 KiB)
# also 3x quicker, once you subtract the big cost of broadcasting (x->x)!

using Tracker # quicker at broadcasting, not sure it has NNlib gradient at all

@btime Tracker.gradient(a -> sum(mysoftmax(a)), $a);       # 324.806 μs
@btime Tracker.gradient(a -> sum(softmax(a, dims=1)), $a); # 252.686 μs

using ReverseDiff

@btime ReverseDiff.gradient(a -> sum(mysoftmax(a)), $a); # 6.359 ms


"""
    F = JopAtan(spc, c)

where `F` is the shifted arc tangent operator F = arctan( x(t)/c ) + π/2

x(t) = 0 corresponds to F = π/2
if |x(t)| ≤ c, then π/4 ≤ F ≤ 3π/4
"""
JopAtan(spc::JetSpace{T}, c = 1) where {T} = JopNl(dom = spc, rng = spc, f! = JopAtan_f!, df! = JopAtan_df!, df′! = JopAtan_df′!, s = (c=T(c),))
export JopAtan

function JopAtan_f!(d::AbstractArray, m::AbstractArray; c)
    d .= atan.(m ./ c) .+ (π/2)
end

function JopAtan_df!(δd::AbstractArray, δm::AbstractArray; mₒ, c)
    δd .= (c ./ (c^2 .+ mₒ.^2)) .* δm
end

function JopAtan_df′!(δm::AbstractArray, δd::AbstractArray; mₒ, c)
    δm .= conj(c ./ (c^2 .+ mₒ.^2)) .* δd
end


"""
## shape_der!

This subroutine produces derivatives of shape functions with respect
to local coordinates.

### Function
```julia
shape_der!(der, point, i)
```

### Arguments
```julia
* der::Matrix{Float64}       : Function derivative (Updated)
* points::Matrix{Float64}    : Local coordinates of integration points
* i::Int                   : Integration point
```
"""
function shape_der!(der::Matrix{Float64}, points::Matrix{Float64}, i::Int)
  #
  #   This subroutine produces derivatives of shape functions with respect
  #   to local coordinates.
  #

  ndim = size(der, 1)
  nod = size(der, 2)

  if ndim == 1                                          # 1.0 dimensional fin_els
   xi = points[i, 1]
   if nod == 2
     der[1,1] = -0.5
     der[1,2] =  0.5
   elseif nod == 3
     t1=-1.0-xi
     t2=-xi
     t3=1.0-xi
     der[1,1] = -(t3+t2)/2.0
     der[1,2] = (t3+t1)
     der[1,3] = -(t2+t1)/2.0
   elseif nod == 4
     t1=-1.0-xi
     t2=-1.0/3.0-xi
     t3=1.0/3.0-xi
     t4=1.0-xi
     der[1,1] = -(t3*t4+t2*t4+t2*t3)*9.0/16.0
     der[1,2] = (t3*t4+t1*t4+t1*t3)*27.0/16.0
     der[1,3] = -(t2*t4+t1*t4+t1*t2)*27.0/16.0
     der[1,4] = (t2*t3+t1*t3+t1*t2)*9.0/16.0
   elseif nod == 5
     t1=-1.0-xi
     t2=-0.5-xi
     t3=-xi
     t4=0.5-xi
     t5=1.0-xi
     der[1,1] = -(t3*t4*t5+t2*t4*t5+t2*t3*t5+t2*t3*t4)*2.0/3.0
     der[1,2] = (t3*t4*t5+t1*t4*t5+t1*t3*t5+t1*t3*t4)*8.0/3.0
     der[1,3] = -(t2*t4*t5+t1*t4*t5+t1*t2*t5+t1*t2*t4)*4.0
     der[1,4] = (t2*t3*t5+t1*t3*t5+t1*t2*t5+t1*t2*t3)*8.0/3.0
     der[1,5] = -(t2*t3*t4+t1*t3*t4+t1*t2*t4+t1*t2*t3)*2.0/3.0
   else
     println("Wrong number of nodes in shape_der.")
   end
  elseif ndim == 2                                      # 2.0 dimensional fin_els
   xi=points[i, 1]
   eta=points[i, 2]
   c1=xi
   c2=eta
   c3=1.0-c1-c2
   etam=0.25*(1.0-eta)
   etap=0.25*(1.0+eta)
   xim= 0.25*(1.0-xi)
   xip= 0.25*(1.0+xi)
   x2p1=2.0*xi+1.0
   x2m1=2.0*xi-1.0
   e2p1=2.0*eta+1.0
   e2m1=2.0*eta-1.0
   if nod == 3
     der[1,1] = 1.0
     der[1,3] = 0.0
     der[1,2] = -1.0
     der[2,1] = 0.0
     der[2,3] = 1.0
     der[2,2] = -1.0
   elseif nod == 6
     der[1,1] = 4.0*c1-1.0
     der[1,6] = 4.0*c2
     der[1,5] = 0.0
     der[1,4] = -4.0*c2
     der[1,3] = -(4.0*c3-1.0)
     der[1,2] = 4.0*(c3-c1)
     der[2,1] = 0.0
     der[2,6] = 4.0*c1
     der[2,5] = 4.0*c2-1.0
     der[2,4] = 4.0*(c3-c2)
     der[2,3] = -(4.0*c3-1.0)
     der[2,2] = -4.0*c1
   elseif nod == 10
     der[1,1] = (27.0*c1*c1-18.0*c1+2.0)/2.0
     der[1,9] = (9.0*(6.0*c1-1.0)*c2)/2.0
     der[1,8] = (9.0*(3.0*c2-1.0)*c2)/2.0
     der[1,7] = 0.0
     der[1,6] = -(9.0*(3.0*c2-1.0)*c2)/2.0
     der[1,5] =  (9.0*(6.0*c1+6.0*c2-5.0)*c2)/2.0
     der[1,4] = -(27.0*c1*c1+54.0*c1*c2-36.0*c1+27.0*c2*c2-36.0*c2+11.0)/2.0
     der[1,3] =  (9.0*(9.0*c1*c1+12.0*c1*c2-10.0*c1+3.0*c2*c2-5.0*c2+2.0))/2.0
     der[1,2] = -(9.0*(9.0*c1*c1+6.0*c1*c2-8.0*c1-c2+1.0))/2.0
     der[1,10] = -27.0*(((c2-1.0)+c1)+c1)*c2
     der[2,1] = 0.0
     der[2,9] =  (9.0*(3.0*c1-1.0)*c1)/2.0
     der[2,8] =  (9.0*(6.0*c2-1.0)*c1)/2.0
     der[2,7] = (27.0*c2*c2-18.0*c2+2.0)/2.0
     der[2,6] = -(9.0*((c1+c2-1.0)*(6.0*c2-1.0)+(3.0*c2-1.0)*c2))/2.0
     der[2,5] =  (9.0*(3.0*c1*c1+12.0*c1*c2-5.0*c1+9.0*c2*c2-10.0*c2+2.0))/2.0
     der[2,4] = -(27.0*c1*c1+54.0*c1*c2-36.0*c1+27.0*c2*c2-36.0*c2+11.0)/2.0
     der[2,3] =  (9.0*(6.0*c1+6.0*c2-5.0)*c1)/2.0
     der[2,2] = -(9.0*(3.0*c1-1.0)*c1)/2.0
     der[2,10] = -27.0*(((c2-1.0)+c1)+c2)*c1
   elseif nod == 15
     t1=c1-0.25
     t2=c1-0.5
     t3=c1-0.75
     t4=c2-0.25
     t5=c2-0.5
     t6=c2-0.75
     t7=c3-0.25
     t8=c3-0.5
     t9=c3-0.75
     der[1,1] = 32.0/3.0*(t2*t3*(t1+c1)+c1*t1*(t3+t2))
     der[1,12] = 128.0/3.0*c2*(t2*(t1+c1)+c1*t1)
     der[1,11] = 64.0*c2*t4*(t1+c1)
     der[1,10] = 128.0/3.0*c2*t4*t5
     der[1,9] = 0.0
     der[1,8] = -128.0/3.0*c2*t4*t5
     der[1,7] = -64.0*c2*t4*(t7+c3)
     der[1,6] = -128.0/3.0*c2*(t8*(t7+c3)+c3*t7)
     der[1,5] = -32.0/3.0*(t8*t9*(t7+c3)+c3*t7*(t8+t9))
     der[1,4] = 128.0/3.0*(c3*t7*t8-c1*(t8*(t7+c3)+c3*t7))
     der[1,3] = 64.0*(c3*t7*(t1+c1)-c1*t1*(t7+c3))
     der[1,2] = 128.0/3.0*(c3*(t2*(t1+c1)+c1*t1)-c1*t1*t2)
     der[1,13] = 128.0*c2*(c3*(t1+c1)-c1*t1)
     der[1,15] = 128.0*c2*t4*(c3-c1)
     der[1,14] = 128.0*c2*(c3*t7-c1*(t7+c3))
     der[2,1] = 0.0
     der[2,12] = 128.0/3.0*c1*t1*t2
     der[2,11] = 64.0*c1*t1*(t4+c2)
     der[2,10] = 128.0/3.0*c1*(t5*(t4+c2)+c2*t4)
     der[2,9] = 32.0/3.0*(t5*t6*(t4+c2)+c2*t4*(t6+t5))
     der[2,8] = 128.0/3.0*((c3*(t5*(t4+c2)+c2*t4))-c2*t4*t5)
     der[2,7] = 64.0*(c3*t7*(t4+c2)-c2*t4*(t7+c3))
     der[2,6] = 128.0/3.0*(c3*t7*t8-c2*(t8*(t7+c3)+c3*t7))
     der[2,5] = -32.0/3.0*(t8*t9*(t7+c3)+c3*t7*(t8+t9))
     der[2,4] = -128.0/3.0*c1*(t8*(t7+c3)+c3*t7)
     der[2,3] = -64.0*c1*t1*(t7+c3)
     der[2,2] = -128.0/3.0*c1*t1*t2
     der[2,13] = 128.0*c1*t1*(c3-c2)
     der[2,15] = 128.0*c1*(c3*(t4+c2)-c2*t4)
     der[2,14] = 128.0*c1*(c3*t7-c2*(c3+t7))
   elseif nod == 4
     der[1,1] = -etam
     der[1,2] = -etap
     der[1,3] = etap
     der[1,4] = etam
     der[2,1] = -xim
     der[2,2] = xim
     der[2,3] = xip
     der[2,4] = -xip
   elseif nod == 5
     der[1,1] = -etam+0.5*xi*(1.0-eta*eta)
     der[1,2] = -etap+0.5*xi*(1.0-eta*eta)
     der[1,3] = etap+0.5*xi*(1.0-eta*eta)
     der[1,4] = etam+0.5*xi*(1.0-eta*eta)
     der[1,5] = -2.0*xi*(1.0-eta*eta)
     der[2,1] = -xim+0.5*eta*(1.0-xi*xi)
     der[2,2] = xim+0.5*eta*(1.0-xi*xi)
     der[2,3] = xip+0.5*eta*(1.0-xi*xi)
     der[2,4] = -xip+0.5*eta*(1.0-xi*xi)
     der[2,5] = -2.0*eta*(1.0-xi*xi)
   elseif nod == 8
     der[1,1] = etam*(2.0*xi+eta)
     der[1,2] = -8.0*etam*etap
     der[1,3] = etap*(2.0*xi-eta)
     der[1,4] = -4.0*etap*xi
     der[1,5] = etap*(2.0*xi+eta)
     der[1,6] = 8.0*etap*etam
     der[1,7] = etam*(2.0*xi-eta)
     der[1,8] = -4.0*etam*xi
     der[2,1] = xim*(xi+2.0*eta)
     der[2,2] = -4.0*xim*eta
     der[2,3] = xim*(2.0*eta-xi)
     der[2,4] = 8.0*xim*xip
     der[2,5] = xip*(xi+2.0*eta)
     der[2,6] = -4.0*xip*eta
     der[2,7] = xip*(2.0*eta-xi)
     der[2,8] = -8.0*xim*xip
   elseif nod == 9
     etam=eta-1.0
     etap=eta+1.0
     xim=xi-1.0
     xip=xi+1.0
     der[1,1] = 0.25*x2m1*eta*etam
     der[1,2] = -0.5*x2m1*etap*etam
     der[1,3] = 0.25*x2m1*eta*etap
     der[1,4] = -xi*eta*etap
     der[1,5] = 0.25*x2p1*eta*etap
     der[1,6] = -0.5*x2p1*etap*etam
     der[1,7] = 0.25*x2p1*eta*etam
     der[1,8] = -xi*eta*etam
     der[1,9] = 2.0*xi*etap*etam
     der[2,1] = 0.25*xi*xim*e2m1
     der[2,2] = -xi*xim*eta
     der[2,3] = 0.25*xi*xim*e2p1
     der[2,4] = -0.5*xip*xim*e2p1
     der[2,5] = 0.25*xi*xip*e2p1
     der[2,6] = -xi*xip*eta
     der[2,7] = 0.25*xi*xip*e2m1
     der[2,8] = -0.5*xip*xim*e2m1
     der[2,9] = 2.0*xip*xim*eta
   else
     println("Wrong number of nodes in shape_der.")
   end
  elseif ndim == 3                                          # 3.0 dimensional fin_els
   xi=points[i, 1]
   eta=points[i, 2]
   zeta=points[i, 3]
   etam=1.0-eta
   xim=1.0-xi
   zetam=1.0-zeta
   etap=eta+1.0
   xip=xi+1.0
   zetap=zeta+1.0
   if nod == 4
     der[1:3,1:4] .= 0.0
     der[1,1] = 1.0
     der[2,2] = 1.0
     der[3,3] = 1.0
     der[1,4] = -1.0
     der[2,4] = -1.0
     der[3,4] = -1.0
   elseif nod == 8
     der[1,1] = -0.125*etam*zetam
     der[1,2] = -0.125*etam*zetap
     der[1,3] =  0.125*etam*zetap
     der[1,4] =  0.125*etam*zetam
     der[1,5] = -0.125*etap*zetam
     der[1,6] = -0.125*etap*zetap
     der[1,7] =  0.125*etap*zetap
     der[1,8] =  0.125*etap*zetam
     der[2,1] = -0.125*xim*zetam
     der[2,2] = -0.125*xim*zetap
     der[2,3] = -0.125*xip*zetap
     der[2,4] = -0.125*xip*zetam
     der[2,5] =  0.125*xim*zetam
     der[2,6] =  0.125*xim*zetap
     der[2,7] =  0.125*xip*zetap
     der[2,8] =  0.125*xip*zetam
     der[3,1] = -0.125*xim*etam
     der[3,2] =  0.125*xim*etam
     der[3,3] =  0.125*xip*etam
     der[3,4] = -0.125*xip*etam
     der[3,5] = -0.125*xim*etap
     der[3,6] =  0.125*xim*etap
     der[3,7] =  0.125*xip*etap
     der[3,8] = -0.125*xip*etap
   elseif nod == 14                                     # type 6 fin_el
     der[1,1] =  (2.0*xi*eta+2.0*xi*zeta+4.0*xi+eta*zeta+eta+zeta)*
       (eta-1.0)*(zeta-1.0)/8.0
     der[1,2] = -(2.0*xi*eta-2.0*xi*zeta+4.0*xi-eta*zeta+eta-zeta)*
       (eta-1.0)*(zeta+1.0)/8.0
     der[1,3] = -(2.0*xi*eta-2.0*xi*zeta+4.0*xi+eta*zeta-eta+zeta)*
       (eta-1.0)*(zeta+1.0)/8.0
     der[1,4] =  (2.0*xi*eta+2.0*xi*zeta+4.0*xi-eta*zeta-eta-zeta)*
       (eta-1.0)*(zeta-1.0)/8.0
     der[1,5] =  -(eta-1.0)*(zeta+1.0)*(zeta-1.0)*xi
     der[1,6] = -(eta+1.0)*(eta-1.0)*(zeta+1.0)*(zeta-1.0)/2.0
     der[1,7] =   (eta+1.0)*(eta-1.0)*(zeta+1.0)*xi
     der[1,8] =  (eta+1.0)*(eta-1.0)*(zeta+1.0)*(zeta-1.0)/2.0
     der[1,9] =  -(eta+1.0)*(eta-1.0)*(zeta-1.0)*xi
     der[1,10] =  (2.0*xi*eta-2.0*xi*zeta-4.0*xi+eta*zeta+eta-zeta)*
       (eta+1.0)*(zeta-1.0)/8.0
     der[1,11] = -(2.0*xi*eta+2.0*xi*zeta-4.0*xi-eta*zeta+eta+zeta)*
       (eta+1.0)*(zeta+1.0)/8.0
     der[1,12] = -(2.0*xi*eta+2.0*xi*zeta-4.0*xi+eta*zeta-eta-zeta)*
       (eta+1.0)*(zeta+1.0)/8.0
     der[1,13] =  (2.0*xi*eta-2.0*xi*zeta-4.0*xi-eta*zeta-eta+zeta)*
       (eta+1.0)*(zeta-1.0)/8.0
     der[1,14] =   (eta+1.0)*(zeta+1.0)*(zeta-1.0)*xi
     der[2,1] =  (2.0*xi*eta+xi*zeta+xi+2.0*eta*zeta+4.0*eta+zeta)*
       (xi-1.0)*(zeta-1.0)/8.0
     der[2,2] = -(2.0*xi*eta-xi*zeta+xi-2.0*eta*zeta+4.0*eta-zeta)*
       (xi-1.0)*(zeta+1.0)/8.0
     der[2,3] = -(2.0*xi*eta-xi*zeta+xi+2.0*eta*zeta-4.0*eta+zeta)*
       (xi+1.0)*(zeta+1.0)/8.0
     der[2,4] =  (2.0*xi*eta+xi*zeta+xi-2.0*eta*zeta-4.0*eta-zeta)*
       (xi+1.0)*(zeta-1.0)/8.0
     der[2,5] = -(xi+1.0)*(xi-1.0)*(zeta+1.0)*(zeta-1.0)/2.0
     der[2,6] =  -(xi-1.0)*(zeta+1.0)*(zeta-1.0)*eta
     der[2,7] =   (xi+1.0)*(xi-1.0)*(zeta+1.0)*eta
     der[2,8] =   (xi+1.0)*(zeta+1.0)*(zeta-1.0)*eta
     der[2,9] =  -(xi+1.0)*(xi-1.0)*(zeta-1.0)*eta
     der[2,10] =  (2.0*xi*eta-xi*zeta-xi+2.0*eta*zeta+4.0*eta-zeta)*
       (xi-1.0)*(zeta-1.0)/8.0
     der[2,11] = -(2.0*xi*eta+xi*zeta-xi-2.0*eta*zeta+4.0*eta+zeta)*
       (xi-1.0)*(zeta+1.0)/8.0
     der[2,12] = -(2.0*xi*eta+xi*zeta-xi+2.0*eta*zeta-4.0*eta-zeta)*
       (xi+1.0)*(zeta+1.0)/8.0
     der[2,13] =  (2.0*xi*eta-xi*zeta-xi-2.0*eta*zeta-4.0*eta+zeta)*
       (xi+1.0)*(zeta-1.0)/8.0
     der[2,14] =  (xi+1.0)*(xi-1.0)*(zeta+1.0)*(zeta-1.0)/2.0
     der[3,1] =  (xi*eta+2.0*xi*zeta+xi+2.0*eta*zeta+eta+4.0*zeta)*
       (xi-1.0)*(eta-1.0)/8.0
     der[3,2] = -(xi*eta-2.0*xi*zeta+xi-2.0*eta*zeta+eta-4.0*zeta)*
       (xi-1.0)*(eta-1.0)/8.0
     der[3,3] = -(xi*eta-2.0*xi*zeta+xi+2.0*eta*zeta-eta+4.0*zeta)*
       (xi+1.0)*(eta-1.0)/8.0
     der[3,4] =  (xi*eta+2.0*xi*zeta+xi-2.0*eta*zeta-eta-4.0*zeta)*
       (xi+1.0)*(eta-1.0)/8.0
     der[3,5] =  -(xi+1.0)*(xi-1.0)*(eta-1.0)*zeta
     der[3,6] =  -(xi-1.0)*(eta+1.0)*(eta-1.0)*zeta
     der[3,7] =  (xi+1.0)*(xi-1.0)*(eta+1.0)*(eta-1.0)/2.0
     der[3,8] =   (xi+1.0)*(eta+1.0)*(eta-1.0)*zeta
     der[3,9] = -(xi+1.0)*(xi-1.0)*(eta+1.0)*(eta-1.0)/2.0
     der[3,10] =  (xi*eta-2.0*xi*zeta-xi+2.0*eta*zeta+eta-4.0*zeta)*
       (xi-1.0)*(eta+1.0)/8.0
     der[3,11] = -(xi*eta+2.0*xi*zeta-xi-2.0*eta*zeta+eta+4.0*zeta)*
       (xi-1.0)*(eta+1.0)/8.0
     der[3,12] = -(xi*eta+2.0*xi*zeta-xi+2.0*eta*zeta-eta-4.0*zeta)*
       (xi+1.0)*(eta+1.0)/8.0
     der[3,13] =  (xi*eta-2.0*xi*zeta-xi-2.0*eta*zeta-eta+4.0*zeta)*
       (xi+1.0)*(eta+1.0)/8.0
     der[3,14] =   (xi+1.0)*(xi-1.0)*(eta+1.0)*zeta
   elseif nod == 20
     xii = [-1,-1,-1,0,1,1,1,0,-1,-1,1,1,-1,-1,-1,0,1,1,1,0]
     etai = [-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,1,1,1,1,1,1,1,1]
     zetai = [-1,0,1,1,1,0,-1,-1,-1,1,1,-1,-1,0,1,1,1,0,-1,-1]
     for l in 1:20
       xi0=xi*xii[l]
       eta0=eta*etai[l]
       zeta0=zeta*zetai[l]
       if l == 4 || l == 8 || l == 16 || l == 20
         der[1,l] = -0.5*xi*(1.0+eta0)*(1.0+zeta0)
         der[2,l] = 0.25*etai[l]*(1.0-xi*xi)*(1.0+zeta0)
         der[3,l] = 0.25*zetai[l]*(1.0-xi*xi)*(1.0+eta0)
       elseif l >= 9 && l <= 12
         der[1,l] = 0.25*xii[l]*(1.0-eta*eta)*(1.0+zeta0)
         der[2,l] = -0.5*eta*(1.0+xi0)*(1.0+zeta0)
         der[3,l] = 0.25*zetai[l]*(1.0+xi0)*(1.0-eta*eta)
       elseif l == 2 || l == 6 || l == 14 || l == 18
         der[1,l] = 0.25*xii[l]*(1.0+eta0)*(1.0-zeta*zeta)
         der[2,l] = 0.25*etai[l]*(1.0+xi0)*(1.0-zeta*zeta)
         der[3,l] = -0.5*zeta*(1.0+xi0)*(1.0+eta0)
       else
         der[1,l] = 0.125*xii[l]*(1.0+eta0)*(1.0+zeta0)*
           (2.0*xi0+eta0+zeta0-1.0)
         der[2,l] = 0.125*etai[l]*(1.0+xi0)*(1.0+zeta0)*
           (xi0+2.0*eta0+zeta0-1.0)
         der[3,l] = 0.125*zetai[l]*(1.0+xi0)*(1.0+eta0)*
           (xi0+eta0+2.0*zeta0-1.0)
       end
     end
   else
     println("Wrong number of nodes in shape_der.")
   end
  else
   println("Wrong number of dimensions in shape_der.")
  end
end


using SymbolicIntegration, SymbolicUtils
@syms x

#Integration Test Problems from
#https://rulebasedintegration.org/testProblems.html

#1 Algebraic functions\1.3 Miscellaneous\1.3.1 Rational functions.input
#Problems from Calculus textbooks and competitions
problems = [
#Ayres Calculus, 1964 edition
[(3*x-4*x^2+3*x^3)//(1+x^2),x,4,"-4*x+3/2*x^2+4*atan(x)"],
[(5+3*x)//(1-x-x^2+x^3),x,3,"4/(1-x)+atanh(x)"],
[(-1-x-x^3+x^4)//(-x^2+x^3),x,3,"(-1)/x+1/2*x^2-2*log(1-x)+2*log(x)"],
[(2+x+x^2+x^3)//(2+3*x^2+x^4),x,6,"atan(x)+1/2*log(2+x^2)"],
[(-4+8*x-4*x^2+4*x^3-x^4+x^5)//(2+x^2)^3,x,5,"(-1)/(2+x^2)^2+1/2*log(2+x^2)-atan(x/sqrt(2))/sqrt(2)"],
[(-1-3*x+x^2)//(-2*x+x^2+x^3),x,3,"-log(1-x)+1/2*log(x)+3/2*log(2+x)"],
[(3-x+3*x^2-2*x^3+x^4)//(3*x-2*x^2+x^3),x,4,"1/2*x^2+log(x)-1/2*log(3-2*x+x^2)"],
[(-1+x+x^3)//(1+x^2)^2,x,4,"-1/2*x/(1+x^2)-1/2*atan(x)+1/2*log(1+x^2)"],
[(1+2*x-x^2+8*x^3+x^4)//((x+x^2)*(1+x^3)),x,7,"(-3)/(1+x)+log(x)-2*log(1+x)+log(1-x+x^2)-2*atan((1-2*x)/sqrt(3))/sqrt(3)"],
[(15-5*x+x^2+x^3)//((5+x^2)*(3+2*x+x^2)),x,7,"1/2*log(3+2*x+x^2)+5*atan((1+x)/sqrt(2))/sqrt(2)-atan(x/sqrt(5))*sqrt(5)"],
[(-3+25*x+23*x^2+32*x^3+15*x^4+7*x^5+x^6)//((1+x^2)^2*(2+x+x^2)^2),x,6,"(-3)/(1+x^2)+1/(2+x+x^2)+log(1+x^2)-log(2+x+x^2)"],

#Edwards and Penney Calculus
[1//((1+x^2)*(4+x^2)),x,3,"-1/6*atan(1/2*x)+1/3*atan(x)"],
#[(a+b*x^3)//(1+x^2),x,5,"1/2*b*x^2+a*atan(x)-1/2*b*log(1+x^2)"],
[(x+x^2)//((4+x)*(-4+x^2)),x,4,"-1/2*atanh(1/2*x)+log(4+x)"],
[(4+x^2)//((1+x^2)*(2+x^2)),x,3,"3*atan(x)-atan(x/sqrt(2))*sqrt(2)"],
[(5-4*x+3*x^2+x^4)//((-1+x)^2*(1+x^2)),x,5,"5/2/(1-x)+x+2*atan(x)+1/2*log(1-x)+3/4*log(1+x^2)"],
[(1+x^4)//(2+x^2),x,3,"-2*x+1/3*x^3+5*atan(x/sqrt(2))/sqrt(2)"],
[(2+2*x+x^4)//(x^4+x^5),x,3,"(-2/3)/x^3+log(1+x)"],
[(-1-5*x+2*x^2)//(2-x-2*x^2+x^3),x,2,"2*log(1-x)-log(2-x)+log(1+x)"],
[(2+x+x^3)//(1+2*x^2+x^4),x,5,"x/(1+x^2)+atan(x)+1/2*log(1+x^2)"],
[(1+2*x+x^2+x^3)//(1+2*x^2+x^4),x,5,"(-1/2)/(1+x^2)+atan(x)+1/2*log(1+x^2)"],
[(3+4*x)//((1+x^2)*(2+x^2)),x,8,"3*atan(x)+2*log(1+x^2)-2*log(2+x^2)-3*atan(x/sqrt(2))/sqrt(2)"],
[(2+x)//((1+x^2)*(4+x^2)),x,8,"-1/3*atan(1/2*x)+2/3*atan(x)+1/6*log(1+x^2)-1/6*log(4+x^2)"],

#Grossman Calculus
[(2-x+x^3)//(-7-6*x+x^2),x,5,"6*x+1/2*x^2+169/4*log(7-x)-1/4*log(1+x)"],
[(-1+x^5)//(-1+x^2),x,4,"1/2*x^2+1/4*x^4+log(1+x)"],
[(5+2*x-x^2+x^3)//(1+x+x^2),x,6,"-2*x+1/2*x^2+3/2*log(1+x+x^2)+11*atan((1+2*x)/sqrt(3))/sqrt(3)"],
[(-3+x-2*x^3+x^4)//(10-8*x+2*x^2),x,6,"3/2*x+1/2*x^2+1/6*x^3+6*atan(2-x)+3/4*log(5-4*x+x^2)"],
[(1+2*x+3*x^2+x^3)//((-3+x)*(-2+x)*(-1+x)),x,2,"x+7/2*log(1-x)-25*log(2-x)+61/2*log(3-x)"],
[(2-7*x+x^2-x^3+x^4)//(-24-14*x+x^2+x^3),x,2,"-2*x+1/2*x^2+13/3*log(4-x)-22/3*log(2+x)+20*log(3+x)"],
[(2+x^2)//((-1+x)^2*x*(1+x)),x,2,"3/2/(1-x)-5/4*log(1-x)+2*log(x)-3/4*log(1+x)"],
[(3+x^2+x^3)//(2+x^2)^2,x,4,"1/4*(4+x)/(2+x^2)+1/2*log(2+x^2)+5/4*atan(x/sqrt(2))/sqrt(2)"],
[(-35+70*x-4*x^2+2*x^3)//((26-10*x+x^2)*(17-2*x+x^2)),x,10,"-15033/1025*atan(5-x)-4607/4100*atan(1/4*(-1+x))+1003/1025*log(26-10*x+x^2)+22/1025*log(17-2*x+x^2)"],
[(2+x^2)//((-5+x)*(-3+x)*(4+x)),x,2,"-11/14*log(3-x)+3/2*log(5-x)+2/7*log(4+x)"],
[x^4//((-1+x)*(2+x^2)),x,5,"x+1/2*x^2+1/3*log(1-x)-2/3*log(2+x^2)-2/3*atan(x/sqrt(2))*sqrt(2)"],

#Spivak Calculus
[(-1+7*x+2*x^2)//(-1-x+x^2+x^3),x,2,"(-3)/(1+x)+2*log(1-x)"],
[(1+2*x)//(-1+3*x-3*x^2+x^3),x,2,"(-3/2)/(1-x)^2+2/(1-x)"],
[(5-5*x+7*x^2+x^3)//((-1+x)^2*(1+x)^3),x,2,"1/(1-x)+(-2)/(1+x)^2"],
[(1+3*x+3*x^2)//(1+2*x+2*x^2+x^3),x,6,"log(1+x)+log(1+x+x^2)-2*atan((1+2*x)/sqrt(3))/sqrt(3)"],

#Stewart Calculus
[(-1+2*x+x^2)//(-2*x+3*x^2+2*x^3),x,3,"1/10*log(1-2*x)+1/2*log(x)-1/10*log(2+x)"],
[(1+4*x-2*x^2+x^4)//(1-x-x^2+x^3),x,2,"2/(1-x)+x+1/2*x^2+log(1-x)-log(1+x)"],
[(4-x+2*x^2)//(4*x+x^3),x,6,"-1/2*atan(1/2*x)+log(x)+1/2*log(4+x^2)"],
[(1+x^2+x^3)//((-1+x)*x*(1+x^2)^3*(1+x+x^2)),x,14,"1/8*(1+x)/(1+x^2)^2-3/8*(1-x)/(1+x^2)+3/16*x/(1+x^2)+7/16*atan(x)+1/8*log(1-x)-log(x)+15/16*log(1+x^2)-1/2*log(1+x+x^2)-atan((1+2*x)/sqrt(3))/sqrt(3)"],
[(1-3*x+2*x^2-x^3)//(1+x^2)^2,x,4,"1/2*(2-x)/(1+x^2)+3/2*atan(x)-1/2*log(1+x^2)"],
[(1-3*x+2*x^2-x^3)//(x*(1+x^2)^2),x,6,"1/2*(-1-2*x)/(1+x^2)-2*atan(x)+log(x)-1/2*log(1+x^2)"],
[(1-x-x^2+x^3+x^4)//(-x+x^3),x,4,"x+1/2*x^2-log(x)+1/2*log(1-x^2)"],
[(2-4*x^2+x^3)//((1+x^2)*(2+x^2)),x,8,"6*atan(x)-1/2*log(1+x^2)+log(2+x^2)-5*atan(x/sqrt(2))*sqrt(2)"],
[(1+x^2+x^4)//((1+x^2)*(4+x^2)^2),x,6,"-13/24*x/(4+x^2)+25/144*atan(1/2*x)+1/9*atan(x)"],
[(1+x^2+x^3)//(2*x^2+x^3+x^4),x,7,"(-1/2)/x-1/4*log(x)+5/8*log(2+x+x^2)+1/4*atan((1+2*x)/sqrt(7))/sqrt(7)"],
[(1-12*x+x^2+x^3)//(-12+x+x^2),x,5,"1/2*x^2-2/7*atanh(1/7*(1+2*x)),1/2*x^2+1/7*log(3-x)-1/7*log(4+x)"],
[(-3+5*x+6*x^2)//(-3*x+2*x^2+x^3),x,3,"2*log(1-x)+log(x)+3*log(3+x)"],
[(-2+3*x+5*x^2)//(2*x^2+x^3),x,3,"1/x+2*log(x)+3*log(2+x)"],
[(18-2*x-4*x^2)//(-6+x+4*x^2+x^3),x,2,"log(1-x)-2*log(2+x)-3*log(3+x)"],
[(1+x-2*x^2+x^3)//(4+5*x^2+x^4),x,7,"-3/2*atan(1/2*x)+atan(x)+1/2*log(4+x^2)"],
[(-32+5*x-27*x^2+4*x^3)//(-70-299*x-286*x^2+50*x^3-13*x^4+30*x^5),x,6,"-3146/80155*log(7-3*x)-334/323*log(1+2*x)+4822/4879*log(2+5*x)+11049/260015*log(5+x+x^2)+3988/13685*atan((1+2*x)/sqrt(19))/sqrt(19)"],
[(8-13*x^2-7*x^3+12*x^5)//(4-20*x+41*x^2-80*x^3+116*x^4-80*x^5+100*x^6),x,7,"5828/9075/(2-5*x)+1/1452*(-313-502*x)/(1+2*x^2)-59096/99825*log(2-5*x)+2843/7986*log(1+2*x^2)+503/7986*atan(x*sqrt(2))/sqrt(2),5828/9075/(2-5*x)+1/1452*(-313-502*x)/(1+2*x^2)-59096/99825*log(2-5*x)+2843/7986*log(1+2*x^2)-251/726*atan(x*sqrt(2))/sqrt(2)+272/1331*atan(x*sqrt(2))*sqrt(2)"],

#Thomas Calculus, 8th Edition
[(9+x^4)//(x^2*(9+x^2)),x,3,"(-1)/x+x-10/3*atan(1/3*x)"],
[(2*x+x^4)//(1+x^2),x,6,"-x+1/3*x^3+atan(x)+log(1+x^2)"],
[(-x+x^3)//((-1+x)^2*(1+x^2)),x,5,"atan(x)+log(1-x)"],
[(2+5*x+3*x^2+2*x^3)//(1+x+x^2),x,3,"x+x^2+log(1+x+x^2)"],
[(3-4*x-5*x^2+3*x^3)//(x^3*(-1+x+x^2)),x,5,"3/2/x^2+(-1)/x+3*log(x)-1/10*log(1+2*x-sqrt(5))*(15-sqrt(5))-1/10*log(1+2*x+sqrt(5))*(15+sqrt(5))"],
[(4+8*x+5*x^2+2*x^3)//(2+2*x+x^2)^2,x,5,"(-1)/(2+2*x+x^2)-atan(1+x)+log(2+2*x+x^2)"],
[(-1+x)^4*x^4//(1+x^2),x,3,"4*x-4/3*x^3+x^5-2/3*x^6+1/7*x^7-4*atan(x)"],
[(-20*x+4*x^2)//(9-10*x^2+x^4),x,-11,"log(1-x)-1/2*log(3-x)+3/2*log(1+x)-2*log(3+x)"],
[(-1+x+4*x^3)//((-1+x)*x^2*(1+x^2)),x,5,"(-1)/x+atan(x)+2*log(1-x)-log(1+x^2)"],
[(1-3*x+2*x^2-4*x^3+x^4)//(1+x^2)^3,x,4,"(-1/4)/(1+x^2)^2+2/(1+x^2)+atan(x)"],
[(1-3*x+2*x^2-4*x^3+x^4)//(1+3*x^2+3*x^4+x^6),x,5,"(-1/4)/(1+x^2)^2+2/(1+x^2)+atan(x)"],

#North Texas University Integration Competition
[(1+x+2*x^2+2*x^3)//(x^2+x^3+x^4),x,4,"(-1)/x+log(1+x+x^2)"],
]

for prob in problems
    result = integrate(prob[1], x)
    println("∫", prob[1], "dx = ", result)
    println("expected: ", prob[4])
    println("--------------------------------------------------------------------")
end


using Flux
# Demo for Perceptron =====================================================
function Perceptron(units)
    ϕ(x) = x >= 0 ? 1 : -1       # Stimulus
    Chain(
    Dense(3,units, ϕ),           # Hidden Layer
    Dense(units,1, x-> ϕ.(x)))   # Output Layer
end

function demoperceptron(lr,epochs, units, X,y)
    # Setting the strategy for learning
    opt = Descent(lr)

    # Defining a 1 Laye Perceptron with `units` no of nodes
    model = Perceptron(units)

    # Defining the loss function
    loss(x, y) = sum(Flux.Losses.logitbinarycrossentropy(model(X'), y))

    # Model Training ==========================
    ps = Flux.params(model)                   #
    for i in 1:epochs                         #
        Flux.train!(loss, ps,zip(X',y), opt)  #
    end                                       #
    # =========================================
    return model
end

println("""
How to run demoperceptron (an example) ?
=========================================

learning_rate = 1.0
learning_trials = 50
hidden_units = 10

X = [-1 -1 1;
     -1 1 1;
     1 -1 1;
     1 1 1]

R = [1 -1 -1 1]
model = demoperceptron(learning_rate, learning_trials,
                        hidden_units, X, R)
W = params(m)[1]
V = params(m)[2]
""")


import GSL.deriv_central
using Base.Test

# verify derivatives of f by finite differences for functions of
# numeric vectors that return a tuple (value, derivient).
function test_deriv(f::Function, x::FloatingPoint, claimed_deriv::FloatingPoint)
    numeric_deriv, abs_err = deriv_central(f, x, 1e-3)
    info("deriv expected $numeric_deriv; got $(claimed_deriv) [tol: $abs_err]")
    obs_err = abs(numeric_deriv - claimed_deriv)
    @test obs_err < 1e-11 || abs_err < 1e-4 || abs_err / abs(numeric_deriv) < 1e-4
    @test_approx_eq_eps numeric_deriv claimed_deriv 10abs_err
end

# test the test
test_deriv( (x)->x^2, 4., 8. )


module Common

using Statistics
using NumericalDataManipulation.CommonMath

function relative_Δ(a¹::Float64, a²::Float64, b¹::Float64, b²::Float64)
    return (a² - a¹) / (b² - b¹)
end

function relative_Δ(a¹::Float64, a²::Float64, b::Float64)
    return (a² - a¹) / b
end

function relative(a::Float64, b::Float64)
    @debug "Relation: a=$a, b=$b, rel=$(a / b)"
    return a / b
end

function issmall(a::Float64, b::Float64; ϵʳᵉˡ=1e-2::Float64)
    return relative(a, b) < ϵʳᵉˡ
end

function Δknot_values(knots::Vector{Float64})
    @assert(!isempty(knots), "An empty knot vector is given.")
    @assert(issorted(knots), "The knot vector must be sorted in an ascending order.")
    @assert(length(knots) ≥ 2, "The knot vector must have 2 knots at least.")
    Δknots = knots[2:end] - knots[1:end-1]
    return Δknots
end

function nonzero(V::Vector{Float64})
    return filter(v -> v ≠ 0.0, V)
end

function finity(a::Float64, b::Float64, c::Float64)
    return (finity(a), finity(b), finity(c))
end
function finity(triple::Tuple{Float64, Float64, Float64})
    return map(number -> finity(number), triple)
end
function finity(v::Vector{Float64})
    return map(number -> finity(number), v)
end

function finity(number::Float64)
    if number == ∞⁻
        return ∞⁻
    elseif number == ∞
        return ∞
    else
        return 1
    end
end

function relfinity(a::Float64, b::Float64, c::Float64; D::Float64 = 1.0, ϵʳᵉˡ::Float64=1e-2)
    return (relfinity(a; D = D, ϵʳᵉˡ = ϵʳᵉˡ),
        relfinity(b; D = D, ϵʳᵉˡ = ϵʳᵉˡ),
        relfinity(c; D = D, ϵʳᵉˡ = ϵʳᵉˡ))
end
function relfinity(triple::Tuple{Float64, Float64, Float64}; D::Float64 = 1.0, ϵʳᵉˡ::Float64=1e-2)
    return map(number -> relfinity(number; D = D, ϵʳᵉˡ = ϵʳᵉˡ), triple)
end
function relfinity(vector::Vector{Float64}; D::Float64 = 1.0, ϵʳᵉˡ::Float64=1e-2)
    return map(number -> relfinity(number; D = D, ϵʳᵉˡ = ϵʳᵉˡ), vector)
end
function relfinity(number::Float64; D::Float64 = 1.0, ϵʳᵉˡ::Float64=1e-2)
    if number == ∞⁻
        return ∞⁻
    elseif number == ∞
        return ∞
    else
        if issmall(number, D; ϵʳᵉˡ = ϵʳᵉˡ)
            return 0
        else
            return 1
        end
    end
end

function sum_until(upper_bound_reached::Function, V::Vector{Float64})
    Σ = 0.0; iᵉ = 0
    for (i, v) ∈ enumerate(V)
        if upper_bound_reached(v, Σ + v)
            break
        end
        if v == ∞ || v == ∞⁻ || v == NaN
            @warn "v = $v with index $i; vector: $V"
        end
        Σ += v; iᵉ = i
    end
    return (Σ, iᵉ)
end

flatten(arr::Array) = mapreduce(x -> isa(x, Array) ? flatten(x) : x, append!, arr,init=[])
flatten(arr::Tuple) = mapreduce(x -> isa(x, Tuple) ? flatten(x) : x, append!, arr,init=[])
flatten(arr::Base.KeySet) = mapreduce(x -> isa(x, Base.KeySet) ? flatten(x) : x, append!, arr,init=[])

export relative_Δ, relative, issmall
export Δknot_values
export nonzero, finity, relfinity
export sum_until
export flatten

end  # module Common


"""
The `Richardson` module provides a function `extrapolate` that
extrapolates a given function `f(x)` to `f(x0)`, evaluating
`f` only  at a geometric sequence of points `> x0`
(or optionally `< x0`).

The key algorithm is Richardson extrapolation using a Neville—Aitken
tableau, which adaptively increases the degree of an extrapolation
polynomial until convergence is achieved to a desired tolerance
(or convergence stalls due to e.g. floating-point errors).  This
allows one to obtain `f(x0)` to high-order accuracy, assuming
that `f(x0+h)` has a Taylor series or some other power
series in `h`.
"""
module Richardson

using LinearAlgebra

export extrapolate, extrapolate!

"""
    extrapolate(f, h; contract=0.125, x0=zero(h), power=1,
                      atol=0, rtol=atol>0 ? 0 : sqrt(ε),
                      maxeval=typemax(Int), breaktol=2)

Extrapolate `f(x)` to `f₀ ≈ f(x0)`, evaluating `f` only at `x > x0` points
(or `x < x0` if `h < 0`) using Richardson extrapolation starting at
`x=x₀+h`.  It returns a tuple `(f₀, err)` of the estimated `f(x0)`
and an error estimate.

The return value of `f` can be any type supporting `±` and `norm`
operations (i.e. a normed vector space).
Similarly, `h` and `x0` can be in any normed vector space,
in which case `extrapolate` performs Richardson extrapolation
of `f(x0+s*h)` to `s=0⁺` (i.e. it takes the limit as `x` goes
to `x0` along the `h` direction).

On each step of Richardson extrapolation, it shrinks `x-x0` by
a factor of `contract`, stopping when the estimated error is
`< max(rtol*norm(f₀), atol)`, when the estimated error
increases by more than `breaktol` (e.g. due to numerical errors in the
computation of `f`), when `f` returns a non-finite value (`NaN` or `Inf`),
 or when `f` has been evaluated `maxeval` times.   Note that
if the function may converge to zero, you may want
specify a nonzero `atol` (which cannot be set by default
because it depends on the scale/units of `f`); alternatively,
in such cases `extrapolate` will halt when it becomes
limited by the floating-point precision.   (Passing `breaktol=Inf`
can be useful to force `extrapolate` to continue shrinking `h` even
if polynomial extrapolation is initially failing to converge,
possibly at the cost of extraneous function evaluations.)

If `x0 = ±∞` (`±Inf`), then `extrapolate` computes the limit of
`f(x)` as `x ⟶ ±∞` using geometrically *increasing* values
of `h` (by factors of `1/contract`).

In general, the starting `h` should be large enough that `f(x0+h)`
can be computed accurately and efficiently (e.g. without
severe cancellation errors), but small enough that `f` does not
oscillate much between `x0` and `h`.  i.e. `h` should be a typical
scale over which the function `f` varies significantly.

Technically, Richardson extrapolation assumes that `f(x0+h)` can
be expanded in a power series in `h^power`, where the default
`power=1` corresponds to an ordinary Taylor series (i.e. assuming
`f` is analytic at `x0`).  If this is not true, you may obtain
slow convergence from `extrapolate`, but you can pass a different
value of `power` (e.g. `power=0.5`) if your `f` has some different
(Puiseux) power-series expansion.   Conversely, if `f` is
an *even* function around `x0`, i.e. `f(x0+h) == f(x0-h)`,
so that its Taylor series contains only *even* powers of `h`,
you can accelerate convergence by passing `power=2`.
"""
function extrapolate(f, h_::Number; contract::Number=oftype(float(real(h_)), 0.125), x0::Number=zero(h_), power::Number=1,
                     atol::Real=0, rtol::Real = atol > zero(atol) ? zero(one(float(real(x0+h_)))) : sqrt(eps(typeof(one(float(real(x0+h_)))))),
                     maxeval::Integer=typemax(Int), breaktol::Real=2)
    if isinf(x0)
        # use a change of variables x = 1/u
        return extrapolate(u -> f(inv(u)), inv(h_); rtol=rtol, atol=atol, maxeval=maxeval, contract = abs(contract) > 1 ? inv(contract) : contract, x0=inv(x0), power=power)
    end
    (rtol ≥ 0 && atol ≥ zero(atol)) || throw(ArgumentError("rtol and atol must be nonnegative"))
    breaktol > 0 || throw(ArgumentError("breaktol must be positive"))
    0 < abs(contract) < 1 || throw(ArgumentError("contract must be in (0,1)"))
    h::typeof(float(x0+h_*contract)) = h_
    invcontract = inv(contract)^power
    neville = [f(x0+h)] # the current diagonal of the Neville tableau
    f₀ = neville[1]
    err::typeof(float(norm(f₀))) = Inf
    numeval = 1
    while numeval < maxeval
        numeval += 1
        h *= contract
        push!(neville, f(x0+h))
        c = invcontract
        minerr′ = oftype(err, Inf)
        for i = length(neville)-1:-1:1
            old = neville[i]
            neville[i] = neville[i+1] + (neville[i+1] - neville[i]) / (c - 1)
            err′ = norm(neville[i] - old)
            minerr′ = min(minerr′, err′)
            if err′ < err
                f₀, err = neville[i], err′
            end
            c *= invcontract
        end
        (minerr′ > breaktol*err || !isfinite(minerr′)) && break # stop early if error increases too much
        err ≤ max(rtol*norm(f₀), atol) && break # converged
    end
    return (f₀, err)
end

# support non-numeric h as long as it is in a vector space
extrapolate(f, h; x0=zero(h), kws...) =
    extrapolate(s -> f(x0+s*h), one(norm(h)); kws...)

"""
    extrapolate(fh_itr; power=1,
                        atol=0, rtol=0, maxeval=typemax(Int), breaktol=Inf)

Similar to `extrapolate(f, h)`, performs Richardson extrapolation of a sequence of
values `f(h)` to `h → 0`, but takes an iterable collection `fh_itr` of a
sequence of `(f(h), h)` tuples (in order of decreasing `|h|`).

There is no `contract` keyword argument since the contraction factors are determined
by the sequence of `h` values (which need not contract by the same amount).  The
tolerances `atol` and `rtol` both default to `0` so that by default it examines
*all* of the values in the `fh_itr` collection.   Otherwise, the keyword arguments
have the same meanings as in `extrapolate(f, h)`.
"""
function extrapolate(fh_itr; power::Number=1, atol::Real=0, rtol::Real = 0,
                             breaktol::Real=Inf, maxeval::Integer=typemax(Int))
    (rtol ≥ 0 && atol ≥ zero(atol)) || throw(ArgumentError("rtol and atol must be nonnegative"))
    breaktol > 0 || throw(ArgumentError("breaktol must be positive"))
    Base.IteratorSize(fh_itr) isa Base.IsInfinite && iszero(atol) && iszero(rtol) && breaktol==Inf && maxeval==typemax(Int) &&
        throw(ArgumentError("stopping criteria must be supplied for infinite iterators"))
    itr = iterate(fh_itr)
    itr === nothing && throw(ArgumentError("(f,h) iterator must be non-empty"))
    (f,h), state = itr
    neville = [f] # the current diagonal of the Neville tableau
    f₀ = neville[1]
    hvals = [h]
    if Base.IteratorSize(fh_itr) isa Base.HasLength
        n = length(fh_itr)
        sizehint!(neville, n)
        sizehint!(hvals, n)
    end
    err::typeof(float(norm(f₀))) = Inf
    numeval = 1
    while numeval < maxeval
        numeval += 1
        itr = iterate(fh_itr, state)
        itr === nothing && break
        (f′,h′), state = itr
        push!(neville, f′)
        push!(hvals, h′)
        abs(h) > abs(h′) || throw(ArgumentError("|$h′| ≥ |$h| is not decreasing"))
        h = h′
        minerr′ = oftype(err, Inf)
        for i = length(neville)-1:-1:1
            c = (hvals[i] / h′)^power
            old = neville[i]
            neville[i] = neville[i+1] + (neville[i+1] - neville[i]) / (c - 1)
            err′ = norm(neville[i] - old)
            minerr′ = min(minerr′, err′)
            if err′ < err
                f₀, err = neville[i], err′
            end
        end
        (minerr′ > breaktol*err || !isfinite(minerr′)) && break # stop early if error increases too much
        err ≤ max(rtol*norm(f₀), atol) && break # converged
    end
    return (f₀, err)
end

"""
    extrapolate!(fh::AbstractVector; power=1, atol=0, rtol=0, maxeval=typemax(Int), breaktol=Inf)

Similar to `extrapolate(fh)`, performs Richardson extrapolation on an array `fh`
of `(f(h), h)` tuples (in order of decreasing `|h|`), but overwrites the array
`fh` in-place with intermediate calculations.

(Thus, the array `fh` must be a vector of `Tuple{T,H}` values, where `H<:Number` is
the type of `h` and `T` is the type of the extrapolated `f(0)` **result**.  This `T`
should be a floating-point type, i.e. `fh` should contain `float(f(h))` if the
function you are extrapolating is not already floating-point-valued.)
"""
function extrapolate!(fh::AbstractVector{<:Tuple{<:Any,<:Number}}; power::Number=1, atol::Real=0, rtol::Real = 0,
                      breaktol::Real=Inf, maxeval::Integer=typemax(Int))
    (rtol ≥ 0 && atol ≥ zero(atol)) || throw(ArgumentError("rtol and atol must be nonnegative"))
    breaktol > 0 || throw(ArgumentError("breaktol must be positive"))
    isempty(fh) && throw(ArgumentError("(f,h) array must be non-empty"))
    (f₀,h) = first(fh)
    err::typeof(float(norm(f₀))) = Inf
    numeval = 1
    maxeval = min(maxeval, length(fh))
    while numeval < maxeval
        numeval += 1
        (f′,h′) = fh[numeval + (firstindex(fh)-1)]
        abs(h) > abs(h′) || throw(ArgumentError("|$h′| ≥ |$h| is not decreasing"))
        h = h′
        minerr′ = oftype(err, Inf)
        fᵢ₊₁ = f′
        for i = numeval-1:-1:1
            fᵢ,hᵢ = fh[i + (firstindex(fh)-1)]
            c = (hᵢ / h′)^power
            fᵢ₊₁ += (fᵢ₊₁ - fᵢ) / (c - 1)
            fh[i + (firstindex(fh)-1)] = (fᵢ₊₁,hᵢ)
            err′ = norm(fᵢ₊₁ - fᵢ)
            minerr′ = min(minerr′, err′)
            if err′ < err
                f₀, err = fᵢ₊₁, err′
            end
        end
        (minerr′ > breaktol*err || !isfinite(minerr′)) && break # stop early if error increases too much
        err ≤ max(rtol*norm(f₀), atol) && break # converged
    end
    return (f₀, err)
end

end # module


# ---
# title: 1200. Minimum Absolute Difference
# id: problem1200
# author: Tian Jun
# date: 2020-10-31
# difficulty: Easy
# categories: Array
# link: <https://leetcode.com/problems/minimum-absolute-difference/description/>
# hidden: true
# ---
#
# Given an array of **distinct**  integers `arr`, find all pairs of elements
# with the minimum absolute difference of any two elements.
#
# Return a list of pairs in ascending order(with respect to pairs), each pair
# `[a, b]` follows
#
#   * `a, b` are from `arr`
#   * `a < b`
#   * `b - a` equals to the minimum absolute difference of any two elements in `arr`
#
#
#
# **Example 1:**
#
#
#
#     Input: arr = [4,2,1,3]
#     Output: [[1,2],[2,3],[3,4]]
#     Explanation: The minimum absolute difference is 1. List all pairs with difference equal to 1 in ascending order.
#
# **Example 2:**
#
#
#
#     Input: arr = [1,3,6,10,15]
#     Output: [[1,3]]
#
#
# **Example 3:**
#
#
#
#     Input: arr = [3,8,-10,23,19,-4,-14,27]
#     Output: [[-14,-10],[19,23],[23,27]]
#
#
#
#
# **Constraints:**
#
#   * `2 <= arr.length <= 10^5`
#   * `-10^6 <= arr[i] <= 10^6`
#
#
## @lc code=start
using LeetCode

## add your code here:
## @lc code=end


## File with graph search algorithms (BFS, path, etc...)

# BFS algorithm for Network
function bfsPath(g::Network, flows = zeros(length(g.links)))
  n = length(g.tails) - 1
  colors = zeros(Int,n) # unvisited = 0; open = 1; closed = 2
  paths = zeros(Int,n,n)

  # Init
  colors[1] = 1
  queue = [(g.source,typemax(Float64),1)]

  while !isempty(queue)
    v, flow, endofpath = pop!(queue)
    paths[v,endofpath] = v
    if v == g.target
          return (paths[v,1:endofpath], flow)
    end
    for (id,e) in enumerate(g.links[g.tails[v]:(g.tails[v+1]-1)])
      x = e.cap - flows[g.tails[v] + id - 1]
      if (x > 0) && (colors[e.head] == 0)
        pathflow = min(flow,x)
        q = (e.head, pathflow, endofpath + 1)
        push!(queue,q)
        colors[e.head] = 1
        paths[e.head,:] = paths[v,:]
      end
    end
    colors[v] = 2
  end
  return ([0],0.)
end

function bfsMinCut(g::Network, flows = zeros(length(g.links)))
  n = length(g.tails) - 1
  colors = zeros(Int,n) # unvisited = 0; open = 1; closed = 2
  cutedges = Vector{Int}()

  # Init
  colors[g.source] = 1
  queue = [g.source]

  while !isempty(queue)
    v = pop!(queue)
#    println(g.links[g.tails[v]:(g.tails[v+1]-1)])
    for (id,e) in enumerate(g.links[g.tails[v]:(g.tails[v+1]-1)])
#      println("colors[e.head]",colors[e.head])
#      println("e.cap > flows[id]",e.cap > flows[g.tails[v] + id - 1])
      if (e.cap > flows[g.tails[v] + id - 1]) && (colors[e.head] == 0)
        colors[v]=1
        q = e.head
        push!(queue,q)
      end
    end
    colors[v] = 2
  end

#  println(colors)
#  printflow(g,flows)

  for (tail,v) in enumerate(g.tails[1:n])
    for (id,a) in enumerate(g.links[g.tails[tail]:(g.tails[tail+1]-1)])
      if (colors[tail] - colors[a.head] == 2)
#        push!(cutedges,g.links[id+v-1].sym)
       push!(cutedges,id+v-1)
      end
    end
  end
  return cutedges
end

function bfs(g::Network, request::Symbol, flows = zeros(length(g.links)))
  if request == :Path
    bfsPath(g,flows)
  elseif request == :MinCut
    bfsMinCut(g, flows)
  end
end


# module Sorting
#
# using LightGraphs
# using Random

export
    topological_sort,
    find_index_in_sorted_array,
    insert_to_sorted_array!,
    linear_interp,
    get_interp_interval,
    resample_array

"""
    `topological_sort(G)`

Returns a topological sort of the vertices of a graph, with the property that
v1 < v2 iff there is not forward path through the graph from v2 to v1.
G must be non-cyclic. Can handle disjoint graphs.
"""
function topological_sort(G)
    @assert(!is_cyclic(G))
    frontier = Set{Int}(rand(1:nv(G)))
    # explored = Set{Int}()
    explored = fill!(Vector{Bool}(undef,nv(G)), false)
    ordering = []
    while any(explored .!= true)
        while length(frontier) > 0
            v = pop!(frontier)
            tip = true # check whether all downstream nodes are explored
            for v2 in inneighbors(G,v)
                if !explored[v2]
                    tip = false
                    push!(frontier,v2)
                    break
                end
            end
            if tip == true
                # push!(explored,v)
                explored[v] = true
                push!(ordering, v)
                for v2 in outneighbors(G,v)
                    push!(frontier,v2)
                end
            end
        end
        for v in 1:nv(G)
            if !explored[v]
                push!(frontier, v)
            end
        end
    end
    ordering
end

"""
    `find_index_in_sorted_array(array, x)`

    Assumes that array is already sorted. Returns index at which x would need to
    be inserted in order to maintain ordering of array. Chooses the smallest
    index in the case of a tie.

    Looks like  "Base.searchsorted" does the same thing as this.
"""
function find_index_in_sorted_array(array, x)
    A = 0
    C = length(array)+1
    B = max(1,Int(round((A+C) / 2)))
    while C-A > 1
        if x < array[B] || ( !(array[B] < x) && !(x < array[B]))
            A = A
            C = B
            B = Int(ceil((A+C) / 2))
        else
            A = B
            C = C
            B = Int(ceil((A+C) / 2))
        end
    end
    return B
end

"""
    `insert_to_sorted_array!(array, x)`

    Assumes that array is already sorted. Inserts new element x so that
    array remains sorted. Requires that Base.isless(a::C,b::C) where
    C==typeof(x) be implemented.
"""
function insert_to_sorted_array!(array, x)
    B = find_index_in_sorted_array(array, x)
    insert!(array, B, x)
    array
end

"""
    linear_interpolation
"""
function linear_interp(a,b,t)
    return a*(1-t) + b*t
end
function linear_interp(a,b,t1,t2,t)
    lin_interp(a,b,(t-t1)/(t-t2))
    return a*(1-t) + b*t
end
function get_interp_interval(array,x)
    idx = find_index_in_sorted_array(array, x)
    if idx == 1
        return idx,idx+1
    elseif idx > length(array)
        return max(1,idx-2),idx-1
    else
        return idx-1,idx
    end
end

"""
    resample array
"""
function resample_array(array::Matrix{Float64},old_t_vec,new_t_vec)
    new_array = Vector{Vector{Float64}}()
    for t in new_t_vec
        idx1,idx2 = get_interp_interval(old_t_vec,t)
        push!(new_array, linear_interp(array[idx1,:],array[idx2,:],(t-old_t_vec[idx1])/(old_t_vec[idx2]-old_t_vec[idx1])))
    end
    return collect(hcat(new_array...)')
end
function resample_array(array::A,old_t_vec,new_t_vec) where {A}
    new_array = Vector{Vector{Float64}}()
    for t in new_t_vec
        idx1,idx2 = get_interp_interval(old_t_vec,t)
        push!(new_array, linear_interp(array[idx1],array[idx2],(t-old_t_vec[idx1])/(old_t_vec[idx2]-old_t_vec[idx1])))
    end
    return new_array
end

export
    clip
"""
    `clip(a,b,c)`

    Returns the closest element to `a` on the interval `[b,c]`
"""
clip(a,b,c) = max.(min.(a,c),b)

export
    draw_random_uniform

"""
    draw_random_elements(vec,n)

Draw `n` elements uniformly at random (without replacement) from vec.
"""
function draw_random_uniform(vec,n)
    N = length(vec)
    @assert N >= n "Cannot draw $n elements from vector of length $N"
    idxs = collect(1:N)
    selected_elements = Vector{eltype(vec)}()
    for i in 1:n
        k = rand(1:length(idxs))
        push!(selected_elements, vec[idxs[k]])
        deleteat!(idxs,k)
    end
    return selected_elements
end

# end # End of module GraphSorting


@testset "SGHMC" begin
    #-------------------
    # test inplace addition vs reference
    #-------------------
    function sample_reference!(s::SGHMCState, grad)
        #increase iteration counter
        s.t += 1

        # improve readability
        x = s.x
        p = s.p
        D = s.D
        t = s.t
        stepsize = s.stepsize(t)
        m = s.mass

        p[:] += - stepsize*(D .* p) ./ m + stepsize*grad(x) + sqrt(2*stepsize.*D).*randn(length(x))
        x[:] += stepsize*p ./ m
        s
    end

    srand(1)
    s = SGHMCState(ones(2),0.01)
    srand(1)
    ref_s = SGHMCState(ones(2),0.01)
    sghmcgrad(x) = x.*x

    srand(2)
    sample!(s,sghmcgrad)

    srand(2)
    sample_reference!(ref_s,sghmcgrad)

    @test s.x == ref_s.x

    #------------------
    # Gaussian sanity check.
    #------------------
    dm = GaussianMixtureModel([0.],[1.],[1.])

    gradient = DataModel.getgrad(dm)
    s = SGHMCState(zeros(1),0.1)

    x_avg = [0.]
    x2_avg = [0.]
    for i in 1:50000
        sample!(s,gradient)
        x_avg =(i-1)/i*x_avg + s.x/i
        x2_avg = (i-1)/i*x2_avg + s.x.^2/i
    end

    @test abs(x_avg-0)[1] < 0.1
    @test abs(x2_avg-1)[1] < 0.2
end


using Test
using CSVFiles
using DataFrames
using Distributions

regenerate = false # do a large MC run, to regenerate information needed for std. errors
samplesize = 1000 # normal MC sample size (takes ~5 seconds)
confidence = 2.576 # 99% CI by default; use 1.96 to apply a 95% CI, but expect more spurious errors

# Monte Carlo distribution information
# Filled in from a run with regenerate = true
information = Dict(
    :td => Dict(:transform => x -> log(x), :mu => 20.814327104215817, :sigma => 0.7007588482770571),
    :tpc => Dict(:transform => x -> x, :mu => 3.23416123428041e7, :sigma => 6.374797685068551e7),
    :tac => Dict(:transform => x -> log(x), :mu => 14.944386813804241, :sigma => 0.46207147966982504),
    :te => Dict(:transform => x -> log(x), :mu => 20.84214660784536, :sigma => 0.6995498063474193),
    :c_co2concentration => Dict(:transform => x -> x, :mu => 651134.5999874412, :sigma => 46363.450549201516),
    :ft => Dict(:transform => x -> x, :mu => 6.216834969325794, :sigma => 0.4011489912917528),
    :rt_g => Dict(:transform => x -> x, :mu => 4.366704203451731, :sigma => 1.219601225681128),
    :sealevel => Dict(:transform => x -> x, :mu => 3.026419413461323, :sigma => 1.1459316083150264)
)

output_path = joinpath(@__DIR__, "../output")
compare = DataFrame(load(joinpath(@__DIR__, "validationdata/PAGE2020montecarloquantiles.csv")))

if regenerate
    println("Regenerating MC distribution information")

    # Perform a large MC run and extract statistics for std. errors
    do_monte_carlo_runs(100_000, "RCP4.5 & SSP2", output_path)
    df = DataFrame(load(joinpath(output_path, "mimipagemontecarlooutput.csv")))

    for ii in 1:nrow(compare)
        name = Symbol(compare[ii, :Variable_Name])
        if kurtosis(df[!, name]) > 2.9 # exponential distribution

            # in PAGE 2009 :tpc was negative across all quantiles so we took log(-x)
            # for the transform, in PAGE2020 they are not all negative so this
            # has been removed but may need to be revisited if we see high kurtosis
            # for :tpc since we cann't take log(negative value)

            # if name == :tpc # negative across all quantiles
                # print("    :$name => Dict(:transform => x -> log(-x), :mu => $(mean(log(-df[df[name] .< 0, name]))), :sigma => $(std(log(-df[df[name] .< 0, name]))))")
            # else
                # print("    :$name => Dict(:transform => x -> log(x), :mu => $(mean(log(df[df[name] .> 0, name]))), :sigma => $(std(log(df[df[name] .> 0, name]))))")
            # end

            print("    :$name => Dict(:transform => x -> log(x), :mu => $(mean(log.(df[df[!, name] .> 0, name]))), :sigma => $(std(log.(df[df[!, name] .> 0, name]))))")
        else
            print("    :$name => Dict(:transform => x -> x, :mu => $(mean(df[!, name])), :sigma => $(std(df[!, name])))")
        end
        if ii != nrow(compare)
            println(",")
        end
    end
else
    println("Performing MC sample")
    # Perform a small MC run
    do_monte_carlo_runs(samplesize, "RCP4.5 & SSP2", output_path)
    df = DataFrame(load(joinpath(output_path, "mimipagemontecarlooutput.csv")))
end

# Compare all known quantiles
for ii in 1:nrow(compare)
    name = Symbol(compare[ii, :Variable_Name])
    transform = information[name][:transform]
    distribution = Normal(information[name][:mu], information[name][:sigma])
    for qval in [.05, .10, .25, .50, .75, .90, .95]
        estimated = transform(quantile(collect(Missings.skipmissing(df[!, name])), qval)) # perform transform *after* quantile, so captures effect of all values
        stderr = sqrt(qval * (1 - qval) / (samplesize * pdf(distribution, estimated)^2))

        expected = transform(compare[ii, Symbol("perc_$(trunc(Int, qval * 100))")])

        # println("$name x $qval: $estimated ≈ $expected rtol=$(ceil(confidence * stderr; digits = -trunc(Int, log10(stderr))))")
        @test estimated ≈ expected rtol = ceil(confidence * stderr; digits=-trunc(Int, log10(stderr)))
    end
end

##
## Used to produce testing files on May 21, 2021 with master
##

# using DataFrames
# using CSV

# # get quantiles
# output_path = joinpath(@__DIR__, "../output")
# do_monte_carlo_runs(100_000, "RCP4.5 & SSP2", output_path)
# df_outputs = DataFrame(load(joinpath(output_path, "mimipagemontecarlooutput.csv")))

# # build and save quantiles dataframe
# Variable_Names = [:td, :tpc, :tac, :te, :c_co2concentration, :ft, :rt_g, :sealevel]
# Quantiles_Placeholder = Array{Any}(fill(missing, length(Variable_Names)))
# df_quantiles = DataFrame(Variable_Name = Variable_Names,
#                             perc_5 = Quantiles_Placeholder,
#                             perc_10 = Quantiles_Placeholder,
#                             perc_25 = Quantiles_Placeholder,
#                             perc_50 = Quantiles_Placeholder,
#                             perc_75 = Quantiles_Placeholder,
#                             perc_90 = Quantiles_Placeholder,
#                             perc_95 = Quantiles_Placeholder)
# quantiles = [5, 10, 25, 50, 75, 90, 95]

# for (i, variable) in enumerate(Variable_Names)
#     _name = Symbol(df_quantiles[i, :Variable_Name])
#     for quant in quantiles
#         df_quantiles[i, Symbol("perc_$(trunc(Int, quant))")] = quantile(collect(Missings.skipmissing(df_outputs[!, _name])), quant/100)
#     end
# end

# CSV.write(joinpath(@__DIR__, "validationdata/PAGE2020montecarloquantiles.csv"), df_quantiles)

# # save a smaller run with n = 1000
# do_monte_carlo_runs(1000, "RCP4.5 & SSP2", output_path)
# df = DataFrame(load(joinpath(output_path, "mimipagemontecarlooutput.csv")))
# CSV.write(joinpath(@__DIR__, "validationdata/mimipagemontecarlooutput.csv"), df)