# vanderPol winding number arnold tongues
using DrWatson
@quickactivate "NonlinearDynamicsTextbook"
include(srcdir("style.jl"))
using DynamicalSystems, PyPlot

function winding_number(ds, ω, a, u0, Ttr, T)
    period = 2π/ω
    ds.p[2:3] .= (a, period)
    # T = period*ceil(T/period)   # no. of periods required for transient
    # Ttr = period*ceil(Ttr/period)     # no. of periods used for averaging
    tr = trajectory(ds, T, u0; Δt = period/20, Ttr)
    tvec = 0:period/20:T
    u1, u2 = columns(tr)
    θ = 0.0
    θ_old = atan(u2[1], u1[1])
    for (x, y) ∈ zip(u1, u2)
        θ_new = atan(y, x)
        θ += mod(θ_new - θ_old + π, 2π) - π
        θ_old = θ_new
    end
    W = abs(θ / (tvec[end] * 2π/period))
    return tr[end], W
end

using ProgressMeter

d = 5.0

a_min = 0.0
a_max = 1.0
na = 100
a_vec = LinRange(a_min, a_max, na)

ω_min = 0.2
ω_max = 2.0
nω =  1000
ω_vec = LinRange(ω_min, ω_max, nω)

ds = Systems.vanderpol(; μ = d)

wmat = zeros(nω,na)

Ttr =  5000 # transient time
T =   4000 #  time on the attractor used for estimating winding no.
u0 = ds.u0

W_vec = zeros(nω)
@showprogress 1 "Computing..." for ia = 1:na
    a = a_vec[ia]
    for iω = 1:length(ω_vec)
        ω = ω_vec[iω]
        u0, W = winding_number(ds, ω, a, u0, Ttr, T)
        wmat[iω,ia] = 1/W
    end # of frequency loop
end  # of amplitude loop

# %% Plot with all numbers
fig = figure(figsize=(0.6*figx,figy))
im1 = plt.pcolormesh(ω_vec,a_vec,wmat',cmap = "gnuplot" )

xlabel(L"\omega")
ylabel(L"a")

ax = gca()
ax.set_xlim([ω_min,ω_max])

cbar = plt.colorbar(im1)  # , ticks=[-0.2, 0.2, 0.6, 1.], orientation="horizontal")
cbar.set_label(L"W")

fig.tight_layout(pad=0.3)

# %% Plot version with only wanted numbers
figure()
qmat = 4*ones(nω,na)   # array with winding numbers to be displayed

rat_num = [1/2, 2/3,   1, 4/3, 3/2, 5/3, 2,  7/3, 5/2, 8/3,  3,  10/3,  7/2]
nrn = length(rat_num)
for ia = 1:na
    for iomega = 1:nω
        wind_no = wmat[iomega,ia]
        # check whether equal p/q
        for rat in rat_num
            if abs(rat - wind_no) < 0.008  # this threshold should be as small as possible
               qmat[iomega,ia] = rat
            end
        end
    end
end

im1 = plt.pcolormesh(ω_vec,a_vec,qmat',cmap = "CMRmap") # a color map which ends with white
plt.clim(0.,4.)
ylabel(L"a")
xlabel(L"\omega"; labelpad = -10)
cbar = plt.colorbar(im1)
cbar.set_label(L"W")
fig.tight_layout(pad=0.3)
wsave(plotsdir("9", "vanderPol_tongues"), fig)


# Many derivative free methods of different orders
#
# TODO: rework Order5 #https://pdfs.semanticscholar.org/ce50/3210d96f653a14b28da96600d5990d2abe97.pdf
# https://content.sciendo.com/view/journals/tmj/10/4/article-p103.xml 7 and 8
# order8: https://www.hindawi.com/journals/ijmms/2012/493456/ref/

## Order0 and 1 are secant type
function init_state(method::AbstractSecant, fs, x::Number)
    x1 = float(x)
    x0 = _default_secant_step(x1)
    init_state(method, fs, (x0, x1))
end

function init_state(method::AbstractSecant, fs, x::Union{Tuple, Vector})
    x0, x1 = promote(float(x[1]), float(x[2]))
    fx0, fx1 = fs(x0), fs(x1)
    state = UnivariateZeroState(x1, x0, eltype(x1)[],
                                fx1, fx0, eltype(fx1)[],
                                0, 2,
                                false, false, false, false, "")

    state
end

function init_state!(state::UnivariateZeroState{T, S}, method::AbstractSecant, fs, x::Number) where {T, S}
    x1::T = float(x)
    x0::T = _default_secant_step(x1)
    init_state!(state, method, fs, (x0, x1))
end

function init_state!(state::UnivariateZeroState{T, S}, ::AbstractSecant, f, x::Union{Tuple, Vector}) where {T, S}
    x0,x1 = promote(float.(x)...)
    fx0, fx1 = promote(f(x0), f(x1))
    init_state!(state, x1, x0, T[], fx1, fx0, S[])
    state.fnevals = 2
    nothing
end

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

## Order0 and Secant are related
"""
    Order0()

The `Order0` method is engineered to be a more robust, though possibly
slower, alternative to to the other derivative-free root-finding
methods. The implementation roughly follows the algorithm described in
*Personal Calculator Has Key to Solve Any Equation f(x) = 0*, the
SOLVE button from the
[HP-34C](http://www.hpl.hp.com/hpjournal/pdfs/IssuePDFs/1979-12.pdf).
The basic idea is to use a secant step. If along the way a bracket is
found, switch to bisection, using `AlefeldPotraShi`.  If the secant
step fails to decrease the function value, a quadratic step is used up
to 3 times.

"""
struct Order0 <: AbstractSecant end

function find_zero(fs, x0, method::Order0;
                   tracks::AbstractTracks=NullTracks(),
                   verbose=false,
                   kwargs...)
    M = Order1()
    N = AlefeldPotraShi()
    _find_zero(fs, x0, M, N; tracks=tracks,verbose=verbose, kwargs...)
end

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

## Secant
## https://en.wikipedia.org/wiki/Secant_method
"""
    Order1()

The `Order1()` method is an alias for `Secant`. It specifies the
[secant method](https://en.wikipedia.org/wiki/Secant_method).
This method keeps two values in its state, `x_n` and `x_n1`. The
updated point is the intersection point of x axis with the secant line
formed from the two points. The secant method uses 1 function
evaluation per step and has order `(1+sqrt(5))/2`.

"""
struct Secant <: AbstractSecant end
const Order1 = Secant

function update_state(method::Secant, fs, o::UnivariateZeroState{T,S}, options)  where {T, S}

    if (o.fxn0 == o.fxn1) || (o.xn0 == o.xn1)
         o.stopped = true
         o.message = "Derivative approximation had issues"
         return
     end

    dx = o.fxn1 * (o.xn1 - o.xn0) / (o.fxn1 - o.fxn0)
    o.xn0, o.xn1 = o.xn1, o.xn1 - dx
    o.fxn0, o.fxn1 = o.fxn1, fs(o.xn1)
    incfn(o)

    nothing

end

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

### Steffensen
## https://en.wikipedia.org/wiki/Steffensen's_method#Simple_description
struct Steffensen <: AbstractUnivariateZeroMethod
end

"""
    Order2()

The quadratically converging
[Steffensen](https://en.wikipedia.org/wiki/Steffensen's_method#Simple_description)
method is used for the derivative-free `Order2()` algorithm. Unlike
the quadratically converging Newton's method, no derivative is
necessary, though like Newton's method, two function calls per step
are. This algorithm is more sensitive than Newton's method to poor
initial guesses.

"""
const Order2 = Steffensen

function update_state(method::Steffensen, fs, o::UnivariateZeroState{T,S}, options) where {T, S}

    wn::T = o.xn1 + steff_step(o.xn1, o.fxn1)

    fwn::S = fs(wn)
    incfn(o)

    fp, issue = _fbracket(o.xn1, wn, o.fxn1, fwn)

    if issue
        o.stopped = true
        o.message = "Derivative approximation had issues"
        return
    end

    o.xn0 = o.xn1
    o.fxn0 = o.fxn1
    o.xn1 = o.xn1 - o.fxn1 / fp #xn1
    o.fxn1 = fs(o.xn1)
    incfn(o)

    nothing
end

steffenson(f, x0; kwargs...) = find_zero(f, x0, Steffensen(); kwargs...)

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

"""
    Order5()

Implements an order 5 algorithm from *A New Fifth Order Derivative
Free Newton-Type Method for Solving Nonlinear Equations* by Manoj
Kumar, Akhilesh Kumar Singh, and Akanksha, Appl. Math. Inf. Sci. 9,
No. 3, 1507-1513 (2015), DOI: 10.12785/amis/090346. Four function
calls per step are needed.

"""
struct Order5 <: AbstractUnivariateZeroMethod end

## If we have a derivative, we have this
function update_state(method::Order5, fs::Union{FirstDerivative,SecondDerivative},
                      o::UnivariateZeroState{T,S}, options)  where {T, S}

    xn, fxn = o.xn1, o.fxn1

    fpxn::S = fs(xn, 1)
    incfn(o)

    if isissue(fpxn)
        o.stopped  = true
        return
    end

    yn::T = xn - fxn / fpxn
    fyn::S, fpyn::S = fs(yn), fs(yn, 1)
    incfn(o, 2)

    if isissue(fpyn)
        o.xn0, o.xn1 = xn, yn
        o.fxn0, o.fxn1 = fxn, fyn
        o.stopped  = true
        return
    end

    zn::T = xn  - (fxn + fyn) / fpxn
    fzn::S = fs(zn)
    incfn(o, 1)

    xn1 = zn - fzn / fpyn
    fxn1 = fs(xn1)
    incfn(o, 1)

    o.xn0, o.xn1 = xn, xn1
    o.fxn0, o.fxn1 = fxn, fxn1

    nothing
end

function update_state(method::Order5, fs, o::UnivariateZeroState{T,S}, options) where {T, S}

    xn = o.xn1
    fxn = o.fxn1

    wn::T = o.xn1 + steff_step(o.xn1, o.fxn1)

    fwn::S = fs(wn)
    incfn(o)

    fp, issue = _fbracket(o.xn1, wn, o.fxn1, fwn)
    if issue
        o.xn0, o.xn1 = o.xn1, wn
        o.fxn0, o.fxn1 = o.fxn1, fwn
        o.message = "Issue with divided difference f[xn, wn]"
        o.stopped  = true
        return
    end

    yn::T = o.xn1 - o.fxn1 / fp
    fyn::S = fs(yn)
    incfn(o)

    zn::T = xn - (fxn + fyn) / fp
    fzn::S = fs(zn)
    incfn(o)

    fp, issue = _fbracket_ratio(yn, o.xn1, wn, fyn, o.fxn1, fwn)
    if issue
        o.xn0, o.xn1 = o.xn1, yn
        o.fxn0, o.fxn1 = o.fxn1, fyn
        o.message = "Issue with f[xn,yn]*f[yn,wn] / f[xn, wn]"
        o.stopped = true
        return
    end

    o.xn0 = o.xn1
    o.fxn0 = o.fxn1
    o.xn1 = zn  - fzn  / fp
    o.fxn1 = fs(o.xn1)
    incfn(o)

    nothing
end

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

## cf also: https://doi.org/10.1515/tmj-2017-0049
"""
    Order8()

Implements an eighth-order algorithm from *New Eighth-Order
Derivative-Free Methods for Solving Nonlinear Equations* by Rajinder
Thukral, International Journal of Mathematics and Mathematical
Sciences Volume 2012 (2012), Article ID 493456, 12 pages DOI:
10.1155/2012/493456. Four function calls per step are required.

"""
struct Order8 <: AbstractUnivariateZeroMethod
end

function update_state(method::Order8, fs, o::UnivariateZeroState{T,S}, options) where {T, S}

    xn = o.xn1
    fxn = o.fxn1

    wn::T = xn + steff_step(xn, fxn)
    fwn::S = fs(wn)
    incfn(o)

    if isissue(fwn)
        o.xn0,o.xn1 = xn, wn
        o.fxn0,o.fxn1 = fxn, fwn
        o.stopped = true
        o.message = "issue with Steffensen step fwn"
        return
    end

    fp, issue = _fbracket(xn, wn, fxn, fwn)

    if issue
        o.stopped = true
        o.message = "issue with divided difference f[xn, wn]"
        return
    end

    yn::T = xn - fxn / fp
    fyn::S = fs(yn)
    incfn(o)

    fp, issue = _fbracket(yn, xn, fyn, fxn)
    if issue #fp
        o.xn0,o.xn1 = xn, yn
        o.fxn0,o.fxn1 = fxn, fyn
        o.stopped = true
        o.message = "issue with divided difference f[xn, yn]"
        return
    end

    phi = (1 + fyn / fwn)           # pick one of options
    zn =  yn - phi * fyn / fp
    fzn::S = fs(zn)
    incfn(o)

    fp, issue =  _fbracket_diff(xn, yn, zn, fxn, fyn, fzn)
    if issue
        o.xn0,o.xn1 = xn, zn
        o.fxn0,o.fxn1 = fxn, fzn
        o.message = "issue with divided difference  f[y,z] - f[x,y] + f[x,z]"
        o.stopped = true
        return
    end

    w = 1 / (1 - fzn/fwn)

    xi = (1 - 2fyn*fyn*fyn / (fwn * fwn * fxn))

    xn1 = zn - w * xi * fzn / fp
    fxn1::S = fs(xn1)
    incfn(o)

    o.xn0,o.xn1 = xn, xn1
    o.fxn0,o.fxn1 = fxn, fxn1

    nothing
end

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

"""
    Order16()

Implement the algorithm from
*New Sixteenth-Order Derivative-Free Methods for Solving Nonlinear Equations*
by R. Thukral,
American Journal of Computational and Applied Mathematics
p-ISSN: 2165-8935;    e-ISSN: 2165-8943; 2012;  2(3): 112-118
doi: 10.5923/j.ajcam.20120203.08.

Five function calls per step are required. Though rapidly converging,
this method generally isn't faster (fewer function calls/steps) over
other methods when using `Float64` values, but may be useful for
solving over `BigFloat`.

"""
struct Order16 <: AbstractUnivariateZeroMethod
end

function update_state(method::Order16, fs, o::UnivariateZeroState{T,S}, options) where {T, S}
    xn = o.xn1
    fxn = o.fxn1

    wn::T = xn + steff_step(xn, fxn)
    fwn::S = fs(wn)
    incfn(o)

    fp, issue = _fbracket(xn, wn, fxn, fwn)

    if issue
        o.xn0, o.xn1 = xn, wn
        o.fxn0, o.fxn1 = fxn, fwn
        o.message = "issue with f[xn,wn]"
        o.stopped = true
        return
    end

    yn::T = xn - fxn / fp
    fyn::S = fs(yn)
    incfn(o)

    fp, issue = _fbracket_ratio(yn, xn, wn, fyn, fxn, fwn)
    if issue
        o.xn0, o.xn1 = xn, yn
        o.fxn0, o.fxn1 = fxn, fyn
        o.message = "issue with f[xn,yn]*f[yn,wn]/f[xn,wn]"
        o.stopped = true
        return
    end

    zn = yn - fyn / fp
    fzn::S = fs(zn)
    incfn(o)

    fp, issue = _fbracket_diff(xn, yn, zn, fxn, fyn, fzn)
    u2, u3, u4 = fzn/fwn, fyn/fxn, fyn/fwn

    eta = 1 / (1 + 2*u3*u4^2) / (1 - u2)
    if issue
        o.xn0, o.xn1 = xn, zn
        o.fxn0, o.fxn1 = fxn, fzn
        o.stopped = true
        o.message = "Approximate derivative failed"
        return
    end

    an = zn - eta * fzn / fp
    fan::S = fs(an)
    incfn(o)

    fp, issue = _fbracket_ratio(an, yn, zn, fan, fyn, fzn)
    if issue
        o.xn0, o.xn1 = xn, an
        o.fxn0, o.fxn1 = fxn, fan
        o.stopped = true
        o.message = "Approximate derivative failed"
        return
    end

    u1, u5, u6 = fzn/fxn, fan/fxn, fan/fwn

    fp1, issue = _fbracket(xn,yn, fxn, fyn)

    sigma =  1 + u1*u2 - u1*u3*u4^2 + u5 + u6 + u1^2*u4 +
    u2^2*u3 + 3*u1*u4^2*(u3^2 - u4^2)/(fp1/oneunit(fp1))

    xn1 = an - sigma * fan / fp
    fxn1::S = fs(xn1)
    incfn(o)

    o.xn0, o.xn1 = xn, xn1
    o.fxn0, o.fxn1 = fxn, fxn1

    nothing
end


"""

```
eulermat(beta, gamma, theta, deg::String)
```

This routine was added because it defines
the rotation in the "human" way, an is thus used
to set the position of the fixed molecules. `deg` can only be `"degree"`, in which
case the angles with be considered in degrees. If no `deg` argument
is provided, radians are used.

That means: `beta` is a counterclockwise rotation around `x` axis.
            `gamma` is a counterclockwise rotation around `y` axis.
            `theta` is a counterclockwise rotation around `z` axis.

"""
function eulermat(beta, gamma, theta, deg::String)

    if deg != "degree"
        error("ERROR: to use radians just omit the last parameter")
    end

    beta = beta * π / 180
    gamma = gamma * π / 180
    theta = theta * π / 180

    return eulermat(beta, gamma, theta)
end

function eulermat(beta::T, gamma::T, theta::T) where {T}
    c1 = cos(beta)
    s1 = sin(beta)
    c2 = cos(gamma)
    s2 = sin(gamma)
    c3 = cos(theta)
    s3 = sin(theta)
    @SMatrix [
        c2*c3 -c2*s3 s2
        (c1*s3+c3*s1*s2) (c1*c3-s1*s2*s3) -c2*s1
        (s1*s3-c1*c3*s2) (c1*s2*s3+c3*s1) c1*c2
    ]
end


# This file includes chaotic maps

export Logistic, Cubic, Tent, Henon, Bernoulli,
    Lorenz, Chua, Rossler,
    trajectory!, normalize

abstract type AbstractOscillator end
abstract type AbstractDiscreteOscillator <: AbstractOscillator  end
abstract type AbstractContinuousOscillator <: AbstractOscillator  end

# ----------------------------- Discrete Time Maps --------------------------------- #

struct Cubic <: AbstractDiscreteOscillator
    a::Float64
    b::Float64
    x::Vector{Float64}
    t::Float64
end
Cubic() = Cubic(4, 3, rand(1), 0.)
(cmap::Cubic)(dx, x, u, t) = ( dx[1] = cmap.a * x[1]^3 - cmap.b * x[1] )

struct Tent <: AbstractDiscreteOscillator
    a::Float64
    b::Float64
    c::Float64
    x::Vector{Float64}
    t::Float64
end
Tent() = Tent(0.6, 0.6, 0.4, rand(1), 0.)
(cmap::Tent)(dx, x, u, t) = ( dx[1] = 0 ≤ x[1] ≤ cmap.a ? x[1] / cmap.b : (1 - x[1]) / cmap.c )

struct Henon <: AbstractDiscreteOscillator
    a::Float64
    b::Float64
    x::Vector{Float64}
    t::Float64
end
Henon() = Henon(1.4, 0.3, rand(2), 0.)

function (cmap::Henon)(dx, x, u, t)
    dx[1] = 1 + x[2] - cmap.a * x[1]^2
    dx[2] = cmap.b * x[1]
end

struct Bernoulli <: AbstractDiscreteOscillator
    a::Float64
    x::Vector{Float64}
    t::Float64
end
Bernoulli() = Bernoulli(1.2, rand(1), 0.)
(cmap::Bernoulli)(dx, x, u, t) = ( dx[1] = x[1] < 0 ? cmap.a * x[1] + 1 : cmap.a * x[1] - 1 )

# ----------------------------- Continuous Time Maps --------------------------------- #

struct Lorenz <: AbstractContinuousOscillator
    σ::Float64
    β::Float64
    ρ::Float64
    γ::Float64
    x::Vector{Float64}
    t::Float64
end
Lorenz() = Lorenz(10, 8 / 3, 28, 1, rand(3), 0)

function (cmap::Lorenz)(dx, x, u, t)
    dx[1] = cmap.σ * (x[2] - x[1])
    dx[2] = x[1] * (cmap.ρ - x[3]) - x[2]
    dx[3] = x[1] * x[2] - cmap.β * x[3]
end

struct Diode
    a::Float64
    b::Float64
    bp::Float64
end
Diode() = Diode(-1.143, -0.714, 1.)
function (diode::Diode)(x)
    if x < -cmap.bp
        cmap.b * x + (cmap.b - cmap.a) * cmap.bp
    elseif -cmap.bp ≤ x ≤ cmap.bp
        cmap.a * x
    elseif x > cmap.bp
        cmap.b * x +  (cmap.a - cmap.b) * bp1
    end
end

struct Chua <: AbstractContinuousOscillator
    α::Float64
    β::Float64
    h::Diode
    x::Vector{Float64}
    t::Float64
end
Chua() = Chua(15, 28, Diode(), rand(3), 0.)

function (cmap::Chua)(dx, x, u, t)
    dx[1] = cmap.α * (x[2] - x[1] - cmap.h(x[1]))
    dx[2] = x[1] - x[2] + x[3]
    dx[3] = -β * x[2]
end

struct Rossler <: AbstractContinuousOscillator
    a::Float64
    b::Float64
    c::Float64
    x::Vector{Float64}
    t::Float64
end
Rossler() = Rossler(0.38, 0.3, 4.82, rand(3), 0.)

function (cmap::Rossler)(dx, x, u, t)
    dx[1] = -x[2] - x[3]
    dx[2] = x[1] + cmap.a * x[2]
    dx[3] = cmap.b + x[3] * (x[1] - cmap.c)
end

# --------------------------------------- Methods  -------------------------------------- #

"""
   $SIGNATURES

Normalizes (zero mean and unity variance)  `x`.
"""
normalize(x) = (x .- mean(x)) / std(x)

"""
    $SIGNATURES

Returns the dimension of the state space of `cmap`.
"""
statedim(cmap::AbstractOscillator) = length(cmap.x)

"""
    $SIGNATURES

Returns a trajectory! of `camp` for a time span of `trange`. `idx` is the indices of trajectory! to be returned.
"""
function trajectory! end

function trajectory!(cmap::AbstractDiscreteOscillator, trange, idx=1)
    sol = solve(DiscreteProblem(cmap, cmap.x, (cmap.t, cmap.t + trange)))
    cmap.t = sol.t[end]
    cmap.x = sol.u[end]
    map(i -> normalize(getindex.(sol.u, i)), idx)
end

function trajectory!(cmap::AbstractContinuousOscillator, trange, tsample, idx=1)
    sol = solve(ODEProblem(cmap, cmap.x, (cmap.t, cmap.t + trange)), saveat=tsample)
    cmap.t = sol.t[end]
    cmap.x = sol.u[end]
    map(i -> normalize(getindex.(sol.u, i)), idx)
end


"""
Solving the travelling salesman problem.

if you have a costs square symetric matrix with diagonal equal to zero use the function solve_TSP()
if you have the set of (x,y) coordinates then use the function hacematrixdedistancias() first to generate the costs matrix

The function solve_TSP give the minimun costs posible and the elements of the costs matrix that minimize the costs the travel
"""
function solve_TSP(costs_matrix)
    N=size(costs_matrix)[1]
    if N==size(costs_matrix)[2];
        m = JuMP.Model(JuMP.with_optimizer(GLPK.Optimizer))
        @variable(m, x[1:N,1:N], Bin)

        @objective(m, Min, sum(costs_matrix.*x))
        @constraint(m, notself[i=1:N], x[i,i] == 0)
        @constraint(m, goto[i=1:N], sum(x[i,1:N]) == 1)
        @constraint(m, cometo[j=1:N], sum(x[1:N,j]) == 1)
        @variable(m, t[1:N], Int)
        for i=1:N,j=2:N
            if i!=j
                @constraint(m,t[j]>=t[i]+1-N*(1-x[i,j]))
            end
        end

        optimize!(m)
        println("El coste optimo es: ")
        println(objective_value(m))
        for i=1:N
            for j=1:N
                if value(x[i,j])!=0
                    println("d[$i,$j]=",costs_matrix[i,j])
                end
            end
        end
    else println("La matriz debe ser cuadrada, con diagonal principal =0 y simetrica")
    end

end

function hacematrixdedistancias(listadeptos)
    distmatrix=zeros(Float64,(length(listadeptos),length(listadeptos)));
    for i=1:length(listadeptos)
        for j=1:length(listadeptos)
            distmatrix[i,j]=distanciacartesiana(listadeptos[i],listadeptos[j])
        end
    end
    return distmatrix;
end

function distanciacartesiana(pto1,pto2)
    dis=sqrt((pto1[1]-pto2[1])^2+(pto1[2]-pto2[2])^2);
    return dis;
end


using Printf
using PyPlot

function inverse_const(r)
    B = [ 1 / (i+j-1) for i = 1:r+1, j=1:r+1 ]
    D = zeros(r+1, r+1)
    for j = 2:r+1
        for i = 2:r+1
            D[i,j] = (i-1)*(j-1) / (i+j-3)
        end
    end
    F = eigen(D, B)
    λmax = F.values[r+1]
    amax = F.vectors[:,r+1]
    return λmax, amax
end

figure(1)
ξ = range(0, stop=1, length=201)
@printf("\n%4s %8s\n\n", "r", "Cr")
for r = 0:3
    Cr, ar = inverse_const(r)
    pr = Poly(ar, :ξ)
    plot(ξ, polyval(pr, ξ))
    @printf("%4d& %8.2f\\\\\n", r, Cr)
end
grid(true)


include("Graph.jl")

using SparseArrays
using LinearAlgebra

function OutDegree(G)
    C = zeros(G.n)
    for (u, v, w) in G.E
        C[u] += w
    end
    return C
end

function spA(G)
    Is = zeros(Int, G.m)
    Js = zeros(Int, G.m)
    Vs = zeros(G.m)
    ID = 0
    for (u, v, w) in G.E
        ID += 1
        Is[ID] = u
        Js[ID] = v
        Vs[ID] = w
    end
    return sparse(Is, Js, Vs, G.n, G.n)
end

function alpP(G, alp)
    d = OutDegree(G)
    Is = zeros(Int, G.m)
    Js = zeros(Int, G.m)
    Vs = zeros(G.m)
    ID = 0
    for (u, v, w) in G.E
        ID += 1
        Is[ID] = v
        Js[ID] = u
        Vs[ID] = alp * w / d[u]
    end
    return sparse(Is, Js, Vs, G.n, G.n)
end

function PageRank(G; alpha = 0.85)
    aP = alpP(G, alpha)
    C = zeros(G.n)
    C[1] = 1.0
    adC = ((1.0 - alpha) / G.n) * ones(G.n)

    while true
        pC = copy(C)
        C = aP * C + adC
        if norm(C - pC) < 1e-12
            break
        end
    end

    return C
end

function EigenvectorCentrality(G)
    C = zeros(G.n)
    C[1] = 1.0
    A = spA(G)

    while true
        pC = copy(C)
        C = A * C
        C ./= C[argmax(C)]
        if norm(C - pC) < 1e-9
            break
        end
    end

    return C
end

function getPc(C; eps = 1e-9)
    A = copy(C)
    n = size(A, 1)
    sort!(A)
    sum = 0.0
    for i = 1 : n
        ts = 0.0
        for j = i-1 : -1 : 1
            if abs(A[i] - A[j]) < eps
                ts += 1.0
            else
                break
            end
        end
        for j = i+1 : n
            if abs(A[i] - A[j]) < eps
                ts += 1.0
            else
                break
            end
        end
        sum += ts
    end
    sum /= (n * (n - 1))
    return (1.0 - sum) * 100
end


# example showing how to do maximum likelihood estimation
# for data generated by CLRM with normality
# sample size
using Econometrics, Distributions
function main()
n = 1000
# random true parameters
theta = [1.0,-1.0,0.0,1.0]
b = theta[1:3]
sig = theta[4]
# generate random data
x = [ones(n,1) rand(n,2)]
e = sig*randn(n,1)
y = x*b + e
# do ML
obj = theta -> -mean(normal(theta, y, x))
thetahat, logL, junk = fminunc(obj, theta)
logL = -logL
# restricted ML
R = [0 1 0 0]
r = -1.5
thetahatr, logLr, junk = fmincon(obj, theta, R, r)
logLr = -logLr
# LR rest
LR = 2.0*n*(logL-logLr)
# results
println("the true parameters: ", theta)
println("the ML estimates: ", thetahat)
println("the restricted ML estimates: ", thetahatr)
println("the LR test: ", LR);
println("p-value of the LR test: ", 1.0-cdf(Chisq(1),LR))
end
main()


module Arithmetic
export evaluate, Constant, BinaryOp, ADD, SUB, MUL, DIV

abstract type Expression end

struct Constant{T} <: Expression
  value::T
end

@enum Op begin
  ADD = 1
  SUB = 2
  MUL = 3
  DIV = 4
end

struct BinaryOp{T1, T2} <: Expression
  left::T1
  op::Op
  right::T2
end

evaluate(expr::Constant) = expr.value

function evaluate(expr::BinaryOp)
  left_val = evaluate(expr.left)
  right_val = evaluate(expr.right)
  if expr.op == ADD
    return left_val + right_val
  elseif expr.op == SUB
    return left_val - right_val
  elseif expr.op == MUL
    return left_val * right_val
  elseif expr.op == DIV
    return left_val / right_val
  else
    throw(error("Unknown op while evaluating BinaryOp"))
  end
end

end # module


using LinearAlgebra
using Plots

# sphere to capsule

# capsule points
ca = [0.0; 0.0; 0.0]
cb = [0.0; 0.0; 1.0]

# sphere point
s = [0.0; 1.0; -1.0]

dab = cb - ca
das = s - ca

len = dot(dab, dab)

t = dot(das, dab) ./ dot(dab, dab)
t_clamp = min(max(t, 0.0), 1.0)

# closest point
if t <= 0.0
    p = ca
elseif t >= 1.0
    p = cb
else
    p = ca + t * dab
end

###
# https://stackoverflow.com/questions/44824512/how-to-find-the-closest-point-on-a-right-rectangular-prism-3d-rectangle/44824522#44824522
using LinearAlgebra
p = [0.0; 1.0; 1.0]
origin = [0.0; 0.0; 0.0]
r = 0.5
v1 = [r; 0.0; 0.0]
v2 = [0.0; r; 0.0]
v3 = [0.0; 0.0; r]

tx = dot(p - origin, v1) / dot(v1, v1)
ty = dot(p - origin, v2) / dot(v2, v2)
tz = dot(p - origin, v3) / dot(v3, v3)

tx_clamp = min(max(tx, 0.0), 1.0)
ty_clamp = min(max(ty, 0.0), 1.0)
tz_clamp = min(max(tz, 0.0), 1.0)

cp = tx_clamp * v1 + ty_clamp * v2 + tz_clamp * v3 + origin


module TargetFunction

immutable ObjFun
    name::ASCIIString
    f_x::Function
    g_x::Function
    about_alpha::Function
    about_alpha_prime::Function
end

function f_x(x::Array{Float64, 1})
    f = 10.0 * (x[2] - x[1]*x[1])*(x[2] - x[1]*x[1]) + (1 - x[1])*(1 - x[1])
    return f
end

function g_x(x::Array{Float64, 1})
    g1 = -40.0 * (x[1]*x[2] - x[1]*x[1]*x[1]) - 2.0 + 2.0 * x[1]
    g2 = 20.0 * (x[2] - x[1]*x[1])
    return [g1; g2]
end

function about_alpha(x::Array{Float64, 1}, s::Array{Float64, 1})
    function along_s(alpha::Float64)
        return f_x(x + s*alpha)
    end
    return along_s
end

function about_alpha_prime(x::Array{Float64, 1}, s::Array{Float64, 1})
    function along_s(alpha::Float64)
        return g_x(x + alpha * s)' * s
    end
    return along_s
end

rosenbrock = ObjFun("Rosenbrock", f_x, g_x, about_alpha, about_alpha_prime)

end


using StanModels, StanSample, MCMCChains, CSV

df = CSV.read(stanmodels_path("..", "data", "WaffleDivorce.csv"), DataFrame)
StanModels.scale!(df, [:MedianAgeMarriage])

# Define the Stan language model

m5_1s = "
data {
 int < lower = 1 > N; // Sample size
 vector[N] divorce; // Predictor
 vector[N] median_age; // Outcome
}

parameters {
 real a; // Intercept
 real bA; // Slope (regression coefficients)
 real < lower = 0 > sigma; // Error SD
}

model {
  # priors
  a ~ normal(10, 10);
  bA ~ normal(0, 1);
  sigma ~ uniform(0, 10);

  # model
  divorce ~ normal(a + bA*median_age , sigma);
}
";

# Define the Stanmodel and set the output format to :mcmcchains.

m_5_1s = SampleModel("m5.1s", m5_1s);

# Input data for cmdstan

m5_1_data = Dict("N" => length(df[!, :Divorce]), "divorce" => df[!, :Divorce],
    "median_age" => df[!, :MedianAgeMarriage_s]);

# Sample using cmdstan

rc = stan_sample(m_5_1s, data=m5_1_data);

# Result rethinking

rethinking = "
       mean   sd  5.5% 94.5% n_eff Rhat
a      9.69 0.22  9.34 10.03  2023    1
bA    -1.04 0.21 -1.37 -0.71  1882    1
sigma  1.51 0.16  1.29  1.79  1695    1
"

# Describe the draws
if success(rc)
  chn = read_samples(m_5_1s; output_format=:mcmcchains)
  show(chn)
end


module Forward

export Dual, ind_var

struct Dual{T<:AbstractFloat} <: AbstractFloat
    value::T
    grad::T
end

#===== Operations =====#
# https://en.wikipedia.org/wiki/Automatic_differentiation#Automatic_differentiation_using_dual_numbers

import Base: +, -, *, /, ^
u::Dual + v::Dual = Dual(u.value + v.value, u.grad + v.grad)
u::Dual - v::Dual = Dual(u.value - v.value, u.grad - v.grad)
u::Dual * v::Dual = Dual(u.value * v.value, v.value * u.grad + u.value * v.grad)
u::Dual / v::Dual = Dual(u.value * v.value, (v.value * u.grad - u.value * v.grad) / (v.value ^ 2))

u::Dual ^ k::Int = Dual(u.value ^ k, k * (u.value ^ (k - 1)) * u.grad)

Base.sin(u::Dual) = Dual(sin(u.value), u.grad * cos(u.value))
Base.cos(u::Dual) = Dual(cos(u.value), -u.grad * sin(u.value))

Base.exp(u::Dual) = begin
    exp_u = exp(u.value)
    Dual(exp_u, u.grad * exp_u)
end
Base.log(u::Dual) = Dual(log(u.value), u.grad / u.value)

#===== Conversions =====#

function Base.convert(::Type{Dual{T}}, x::Dual) where T
    Dual(convert(T, x.value), convert(T, x.grad))
end

function Base.convert(::Type{Dual{T}}, x::AbstractFloat) where T
    Dual(convert(T, x), zero(T))
end

function Base.promote_rule(::Type{Dual{T}}, ::Type{U}) where {T, U}
    Dual{promote_type(T, U)}
end

"Independent variable"
ind_var(x::AbstractFloat) = Dual(x, one(x))

end


# generalised OU
include("common.jl")
import SDELab2
################### problem parameters
T=1 # time step, final time
x0=1. # initial data
alp=-1/2 # drift parameter
bet= 4/5 # drift parameter
sig=sqrt(1/2) # diffusion param
quad0=SDELab2.delta_measure(x0)
###########################################
function drift(u,alp,bet)
  x=u[1]; mf=u[2]
  return alp*x+bet*mf
end
##########################################
function diff(u,sig)
  return sig
end
#######################################
function mf_r(x)
  return [x]
end
##########################################
fcn=SDELab2.set_fcn_mf(u->drift(u,alp,bet),
          u->diff(u,sig),
          x->mf_r(x))
# test function
phi=x->[x;x.^2]
###################################### exact
exact_mean=x0*exp((alp+bet));
exact_var=(sig^2)/(2*alp)*exp(2*alp)-sig^2/(2*alp);
exact_mom2=exact_var+exact_mean^2;
exact=[exact_mean,exact_mom2];
println("ode soln ",exact)
##################################### method parameters
dt=1e-3
solver="MFEM0"
params=SDELab2.set_opt(dt,solver)
params["cutoff"]=10 # radius R for Alg 3.1
params["const"]=1e3 # for no_Gauss_points
params["length_scale"]=1 # for no_Gauss_points
params["skiphalf"]=true
params["periodic"]=false
params["no_partition"]=1
dtpts=[0.2,0.1,0.05,0.025,0.01,0.005]#,0.0025,0.001]
errors=zeros(length(dtpts),2)
errors_no=deepcopy(errors)
errors_nd=deepcopy(errors)
cpu_times=zeros(length(dtpts))
cpu_times_no=deepcopy(cpu_times)
cpu_times_nd=deepcopy(cpu_times)

params["Solver"]="MFEM0"
dtpts_no=dtpts/4
for i=1:(length(dtpts))
    params["MaxStepSize"]=dtpts_no[i]
    qoi,cpu_time,stats,q=get_soln(fcn,quad0,params,phi,false)
    errors_no[i,:],cpu_times_no[i]=helper(qoi, exact, cpu_time, "normal")
end
########################
params["Solver"]="MFEM0"
for i=1:(length(dtpts))
    params["MaxStepSize"]=dtpts[i]
    qoi,cpu_time,stats,q=get_soln(fcn,quad0,params,phi,true)
    errors[i,:],cpu_times[i]=helper(qoi, exact, cpu_time, "normal")
end
################
params["Solver"]="MFEM2"
for i=1:(length(dtpts))
    params["MaxStepSize"]=dtpts[i]
    qoi,cpu_time,stats,q=get_soln(fcn,quad0,params,phi,false)
    errors_nd[i,:],cpu_times_nd[i]=helper(qoi, exact, cpu_time, "normal")
end
#########################################

figure(1);
# first functional
i=1
time_step_err(dtpts,errors[:,i],
  dtpts_no,errors_no[:,i],
  dtpts,errors_nd[:,i],[1e0,1e0],utf8("mom1.pdf"))
err_cpu(errors[:,i],cpu_times[:],
  errors_no[:,i],cpu_times_no[:],
  errors_nd[:,i],cpu_times_nd[:],[1e0,1e0], utf8("mom1_.pdf"))
# second functional
i=2
time_step_err(dtpts,errors[:,i],
      dtpts_no,errors_no[:,i],
      dtpts,errors_nd[:,i],[1e0,1],utf8("mom2.pdf"))
err_cpu(errors[:,i], cpu_times[:],
      errors_no[:,i],cpu_times_no[:],
      errors_nd[:,i],cpu_times_nd[:],[1e0,1], utf8("mom2_.pdf"))
#########################################
println("finished preparing plots")


"""
    power_method(x0,Hop,PARAM)
POWER_METHOD: Power iteration method to computes max eigenvalue of H'H
              where H and H' are given by Hop. This function is
              needed to evaluate the step parameter of FISTA.
# Arguments
- `x0`:initial seed with dimensions such that H'*H*x0 does not abort
- `Hop`:liner operator that encapsulates H and H' such that
        Hop(x,PARAM, 1) = H x
        Hop(y,PARAM,-1) = H'y
- `PARAM`:parameters to run Hop and it's adjoint

"""
function power_method(x0,Hop,PARAM)
   #x = x0;
   x=copy(x0);
   value=0;
    for k = 1:10;
       aux = Hop(x,PARAM,1);
       y = Hop(aux,PARAM,-1);
       n = norm(y);
       x = y/n;
       value = n;
    end
    return value
end


function frenet_serret(coordinate::Matrix{T_Number}) where {T_Number<:Number}
    r = copy(coordinate)
    n_points = size(r, 1)
    if size(r, 2) == 2
        r = cat(r, zeros(eltype(r), size(r, 1)), dims = 2)
    end
    t = 1.0:size(r,1)
    dt = (maximum(t) - minimum(t)) / length(r)
    dr = gradient(r)
    ddr = gradient(dr)
    dddr = gradient(ddr)

    T = similar(dr)
    N = similar(dr)
    B = similar(dr)

    for i = 1:n_points

        T[i, :] = LinearAlgebra.normalize(dr[i, :])

        B[i, :] = LinearAlgebra.normalize(cross(dr[i, :], ddr[i, :]))

        N[i, :] = LinearAlgebra.normalize(cross(B[i, :], T[i, :]))

    end

    ds = Array{eltype(dr),1}(undef, n_points)
    curvature = similar(ds)
    torsion = similar(ds)

    for i in eachindex(ds)
        selected_dr = dr[i, :]
        selected_ddr = ddr[i, :]
        selected_dddr = dddr[i, :]
        ds[i] = norm(selected_dr)

        dr_cross_ddr = cross(selected_dr, selected_ddr)
        curvature_num = norm(dr_cross_ddr) # || dr X ddr ||
        curvature_denom = norm(selected_dr)^3 # || dr ||^3
        curvature[i] = curvature_num / curvature_denom

        torsion_num = dot(dr_cross_ddr, selected_dddr) # (dr X ddr) . dddr
        torsion_denom = norm(dr_cross_ddr)^2 # || dr X ddr ||^2
        torsion[i] = torsion_num / torsion_denom
    end
    speed = ds ./ dt
    return T,N,B,curvature,torsion,speed
end


using LinearAlgebra

function positive_definite(x,y)
    Q = [6 -2; -2 6]
    q = [0 ; 0]
    return quadratic_function(x,y,Q,q)
end

function semi_positive_definite(x,y)
    Q = [0 1; 0 1]
    q = [0 ; 0]
    return quadratic_function(x,y,Q,q)
end

function not_positive_definite(x,y)
    Q = [-5 -2; -4 -2]
    q = [0 ; 0]
    return quadratic_function(x,y,Q,q)
end

function quadratic_function(x,y,Q,q)
    Q_f = ([x y]*Q*[x ; y])[1] * 0.5
    q_f = q' * [x ; y]
    return Q_f + q_f
end

#derivatives

function positive_definite_d(x,y)
    Q = [6 -2; -2 6]
    q = [0 ; 0]
    return quadratic_function_d(x,y,Q,q)
end

function semi_positive_definite_d(x,y)
    Q = [0 1; 0 1]
    q = [0 ; 0]
    return quadratic_function_d(x,y,Q,q)
end

function not_positive_definite_d(x,y)
    Q = [-5 -2; -4 -2]
    q = [0 ; 0]
    return quadratic_function_d(x,y,Q,q)
end

function quadratic_function_d(x,y,Q,q)
    return (Q*[x ; y]) + q
end


# Copyright (c) 2021 Idiap Research Institute, http://www.idiap.ch/
#  Niccolò Antonello <nantonel@idiap.ch>

export NLogWeight

"""
`NLogWeight(x)`

| Set                                 |     ``\\oplus``         |  ``\\otimes``  | ``\\bar{0}`` | ``\\bar{1}`` |
|:-----------------------------------:|:-----------------------:|:--------------:|:------------:|:------------:|
|``\\mathbb{R}\\cup\\{\\pm\\infty\\}``|``-\\log(e^{-x}+e^{-y})``|     ``+``      |``\\infty``   |   ``0``      |
"""
struct NLogWeight{T <: AbstractFloat} <: Semiring
  x::T
end

NLogWeight(x::Number) = NLogWeight(float(x))

zero(::Type{NLogWeight{T}}) where T = NLogWeight{T}(T(Inf))
one(::Type{NLogWeight{T}}) where T = NLogWeight{T}(zero(T))

*(a::NLogWeight{T}, b::NLogWeight{T}) where {T <: AbstractFloat} = NLogWeight{T}(a.x + b.x)
+(a::NLogWeight{T}, b::NLogWeight{T}) where {T <: AbstractFloat} = NLogWeight{T}(-logadd(-a.x,-b.x))
/(a::NLogWeight{T}, b::NLogWeight{T}) where {T <: AbstractFloat} = NLogWeight{T}(a.x - b.x)
reverse(a::NLogWeight) = a

# parsing
parse(::Type{S},str) where {T, S <: NLogWeight{T}} = S(parse(T,str))

#properties
iscommulative(::Type{W}) where {W <: NLogWeight} = true
isleft(::Type{W}) where {W <: NLogWeight} = true
isright(::Type{W}) where {W <: NLogWeight}= true
isweaklydivisible(::Type{W}) where {W <: NLogWeight}= true
iscomplete(::Type{W}) where {W <: NLogWeight}= true


# simplified model from Chakrawal21

function chak21_simp_system()
    #using ModelingToolkit, DifferentialEquations, Plots
    @parameters t ks km kd Y HS HB
    # t in hours
    # masses per soilmass in mol/g
    @variables s(t) b(t) cr_tot(t) r_tot(t) q(t) dec_s(t) tvr_b(t)
    D = Differential(t)
    HG = HS - Y * HB # can take out of system because does not involve t
    eqs = [
        dec_s ~ (ks*s*b)/(s + km),
        tvr_b ~ kd*b,
        D(s) ~ -dec_s + tvr_b,
        D(b) ~ Y * dec_s - tvr_b,
        r_tot ~ (1-Y) * dec_s,
        D(cr_tot) ~ r_tot,
        q ~ -HG * dec_s,
        ]
    @named chak21_simp = ODESystem(eqs)
    chak21_simp_s = structural_simplify(chak21_simp) # omit r,q
    p_straw = Dict(
        :parms => [ks => 0.15, km => 2.62e-6, kd => 1.35e-2, Y => 0.72,
            HB => -492, HS => -469],
        #:x0 => [s => 4.17e-6, b => 1.14e-5, cr => 0] # twutz: wrong in paper
        :x0 => [s => 4.17e-5, b => 1.14e-5, cr_tot => 0]
    ) # see S5
    chak21_simp_s, chak21_simp, p_straw
end


struct QStructs{FT<:Real}
	A  :: FT
	Lx :: FT
	Qx :: FT
	Ly :: FT
	Qy :: FT
end

function QfieldProperties(
	FT = Float64;
	A  :: Real = 1.,
	Lx :: Real = 2.,
	Qx :: Real = 0.,
	Ly :: Real = 2.,
	Qy :: Real = 0.
)

	return QStructs{FT}(A,Lx,Qx,Ly,Qy)

end

function createQ(
	QParams::Array{QStructs{FT}},
	g::Grid{FT},
) where FT <: Real

	xc = g.xc
	yc = g.yc
	nQ = length(QParams)
	Q  = zeros(FT,g.nx,g.ny)

	for Qs in QParams, jj = 1 : g.ny, ii = 1 : g.nx
		if abs(xc[ii]-Qs.Qx) < Qs.Lx
			Q[ii,jj] += Qs.A * cos(pi*(xc[ii]-Qs.Qx)*0.5/Qs.Lx) *
							   exp(-((yc[jj]-Qs.Qy)/Qs.Ly)^2)
		end
	end

	return Q

end

function show(io::IO, Q::QStructs{FT}) where FT <: Real
    print(
		io,
		"The Q{$FT}-field forcing is defined as follows:\n",
		"           Amplitude : ", Q.A, '\n',
		"        Size (Lx,Ly) : ", (Q.Lx,Q.Ly), '\n',
		"    Position (Qx,Qy) : ", (Q.Qx,Q.Qy), '\n'
	)
end


include("07_two_site_operator.jl")

println("
#######################################################
# Tutorial 8                                          #
#                                                     #
# 2-site custom operator/gate definition              #
#######################################################
")

import ITensors: op

# Controlled-Ry rotation gate
function op(::OpName"CRy", ::SiteType"S=1/2"; θ)
  return [
    1 0 0           0
    0 1 0           0
    0 0 cos(θ / 2) -sin(θ / 2)
    0 0 sin(θ / 2) cos(θ / 2)
  ]
end

# CRy(θ=π/2)
θ = π / 2
CRyθ = op("CRy", i1, i2; θ)

# |10⟩ = |Z-Z+⟩
ZmZp = Zm1 * Zp2

# CRyθ|Z-Z+⟩ = |Z-X+⟩
@show apply(CRyθ, ZmZp) ≈ Zm1 * Xp2


module LogisticRegression

using LinearAlgebra

"""
    sigmoid(z)

Compute the sigmoid of z.
"""
@inline function sigmoid(z::Number)
    return 1.0 / (1.0 + exp(-z))
end

"""
    logistic_loss(y, a)

Calculate logistic loss or cross-entropy loss for sample.
"""
@inline function logistic_loss(y::Number, a::Number)
    return -1.0 * (y * log(a) + (1.0 - y) * log(1.0 - a))
end

"""
    evaluate_linear!(z, W, b, x)

Evaluate linear layer, i.e. calculate `z = W*x + b`.
"""
@inline function evaluate_linear!(
    z::AbstractVector,
    W::AbstractMatrix,
    b::AbstractVector,
    x::AbstractVector)
    mul!(z, W, x)
    z .+= b
    return z
end

"""
    propagate!(J, dw, db, W, b, X, Y, z, a, dz)

Forward- and backpropagation.

Given set of samples (X, Y), calculate total cost and partial derivatives with
respect to w and b. X and Y must be iterables with length of m, where m is the
number of samples. Algoritm writes to J, dw, db, z, a, and dz. The last three
auxiliary vectors for intemediate results and they size needs to equal b.
"""
function propagate!(
    J::AbstractVector,
    dW::AbstractMatrix,
    db::AbstractVector,
    W::AbstractMatrix,
    b::AbstractVector,
    X::AbstractVector{V},
    Y::AbstractVector,
    z::AbstractVector,
    a::AbstractVector,
    dz::AbstractVector
) where {V<:AbstractVector}
    @assert length(X) == length(Y)
    m = length(X)
    @assert m > 0
    fill!(J, 0.)
    fill!(dW, 0.0)
    fill!(db, 0.0)
    for (x, y) in zip(X, Y)
        z = evaluate_linear!(z, W, b, x)
     @. a = sigmoid(z)
     @. dz = a - y
     @. J += logistic_loss(y, a)
     @. dW += x' * dz
     @. db += dz
    end
 @. J /= m
 @. dW /= m
 @. db /= m
    return
end

"""
    optimize!(J, W, b, X, Y; num_iterations = 1000, learning_rate = 1.0)

Given initial model (J, W, b) and data (X, Y), optimize model parameters using
gradient descent method. Model optimization is done in place.
"""
function optimize!(
    J::AbstractVector,
    W::AbstractMatrix,
    b::AbstractVector,
    X::AbstractVector{T},
    Y::AbstractVector;
    num_iterations::Integer = 1000,
    learning_rate::Float64 = 1.0,
) where {T<:AbstractVector}
    dW = zero(W)
    db = zero(b)
    z = zero(b)
    a = zero(b)
    dz = zero(b)
    for i in 1:num_iterations
        propagate!(J, dW, db, W, b, X, Y, z, a, dz)
     @. W = W - learning_rate * dW
     @. b = b - learning_rate * db
    end
    return J, W, b
end

"""
    predict(W, b, x)

Given model (W, b) and sample x, predict the class y.
"""
@inline function predict(W, b, x)
    return 1 * (sigmoid.(W*x .+ b) .> 0.5)
end

end # module


"""
    Monomials(n) = [ x-> x^k for k = 0:n-1 ]
"""
struct Monomials <: AbstractBasis
    n::Int
end

Base.length(B::Monomials) = B.n

approxpoints(B::Monomials) = exp.(2π*im/length(B).*(0:length(B)-1))
approxtransform(B::Monomials,f) = fft(convert(Array,f),1)./length(B)

function iterate_basis(B::Monomials, x)
    length(B) == 0 && return nothing
    p = one(x)
    return p,(2,p)
end
function iterate_basis(B::Monomials, x, (i,p))
    i > length(B) && return nothing
    p = x*p
    return p,(i+1,p)
end

evaluate_basis(B::Monomials,i,x) = x^(i-1)


function mse(semantics::Vector{T}, data) where T
    res = 0
    @simd for i in 1:length(semantics)
        res += (data.target[i] - semantics[i])^2
    end
    res /= length(data.target)
end

function mse(tree, data)
    res = 0
    for i in 1:length(data.target)
        output = evaluate(tree, view(data.input, :, i))
        res += (data.target[i] - output)^2
    end
    res /= length(data.target)
end

rmse(x, data) = sqrt(mse(x, data))

function se(tree, data)
    res = 0
    for i in 1:length(data.target)
        output = evaluate(tree, view(data.input, :, i))
        res += (data.target[i] - output)^2
    end
    res
end

function se(semantics::Vector{T}, data) where T
    res = 0
    @simd for i in 1:length(semantics)
        res += (data.target[i] - semantics[i])^2
    end
    res
end


"""
Generates a non-trivial random MOI linear program by adding variables
and constraints to MOI-compatible Optimizer `optimizer`

minimize `c' * x`
subject to `Ax <= b, x >= 0`
where `x in R^{n}, A in R^{m*n}, b in R^{m}, c in R^{n}`

Note: Mutates the `optimizer` object
"""
function generate_lp(optimizer, n, m)
    s = rand(m)
    s = 2*s .- 1
    λ = max.(-s, 0)
    s = max.(s, 0)
    x̂ = rand(n)
    A = rand(m, n)
    b = A * x̂ .+ s
    c = -A' * λ

    x = MOI.add_variables(optimizer, n)

    # define objective
    objective_function = MOI.ScalarAffineFunction(MOI.ScalarAffineTerm.(c, x), 0.0)
    MOI.set(optimizer, MOI.ObjectiveFunction{MOI.ScalarAffineFunction{Float64}}(), objective_function)
    MOI.set(optimizer, MOI.ObjectiveSense(), MOI.MIN_SENSE)

    # set constraints
    for i in 1:m
        MOI.add_constraint(
            optimizer,
            MOI.ScalarAffineFunction(MOI.ScalarAffineTerm.(A[i,:], x), 0.), MOI.LessThan(b[i]),
        )
    end

    for i in 1:n
        MOI.add_constraint(optimizer, MOI.SingleVariable(x[i]), MOI.GreaterThan(0.0))
    end
end

"""
Generates a non-trivial random MOI convex quadratic program
by adding variables and constraints to MOI compatible Optimizer `optimizer`

minimize `0.5 * x' * Q * x  + q' * x`
subject to `Gx <= h, Ax == b`
where `x in R^{n}, Q in R^{n*n}, q in R^{n}, G in R^{m,n}, h in R^{m}, A in R^{p*n}, b in R^{p}`

Note: (1) Mutates the `optimizer` object
      (2) Matrix `Q` is Positive Semidefinite
"""
function generate_qp(optimizer,n,m,p)
    x̂ = rand(n)
    Q = rand(n, n)
    Q = Q' * Q # ensure PSD
    q = rand(n)
    G = rand(m, n)
    h = G * x̂ + rand(m)
    A = rand(p, n)
    b = A * x̂

    x = MOI.add_variables(optimizer, n)

    # define objective
    quadratic_terms = MOI.ScalarQuadraticTerm{Float64}[]
    for i in 1:n
        for j in i:n # indexes (i,j), (j,i) will be mirrored. specify only one kind
            push!(quadratic_terms, MOI.ScalarQuadraticTerm(Q[i,j],x[i],x[j]))
        end
    end

    objective_function = MOI.ScalarQuadraticFunction(MOI.ScalarAffineTerm.(q, x), quadratic_terms, 0.0)
    MOI.set(optimizer, MOI.ObjectiveFunction{MOI.ScalarQuadraticFunction{Float64}}(), objective_function)
    MOI.set(optimizer, MOI.ObjectiveSense(), MOI.MIN_SENSE)

    # set constraints
    for i in 1:m
        MOI.add_constraint(
            optimizer,
            MOI.ScalarAffineFunction(MOI.ScalarAffineTerm.(G[i,:], x), 0.),MOI.LessThan(h[i])
        )
    end

    for i in 1:p
        MOI.add_constraint(
            optimizer,
            MOI.ScalarAffineFunction(MOI.ScalarAffineTerm.(A[i,:], x), 0.),MOI.EqualTo(b[i])
        )
    end
end


export spectral!

"""
`spectral!(X::GraphEmbedding)` gives the graph held in `X` an
embedding based on the eigenvectors of the Laplacian matrix of the
graph. Specifically, the `x`-coordinates come from the eigenvector
associated with the second smallest eigenvalue, and the
`y`-coordinates come from the eigenveector associated with the third
smallest.

This may also be invoked as `spectral!(X,xcol,ycol)` to choose other
eigenvectors to use for the x and y coordinates of the embedding.
"""
function spectral!(X::GraphEmbedding,xcol::Int=2,ycol::Int=3)
    L = laplace(X.G)
    EV = eigvecs(L)
    x = EV[:,xcol]
    y = EV[:,ycol]

    VV = vlist(X.G)
    n = length(VV)

    for k=1:n
        v = VV[k]
        X.xy[v] = [x[k],y[k]]
    end
    rescale!(X)
    return X
end


# Equation references to
#
# - Bethe, H., & Salpeter, E. (1977). Quantum mechanics of one-and
#   two-electron atoms. New York: Plenum Pub. Corp.

@doc raw"""
    non_relativistic_energy(n[, Z=1])

Returns the non-relativistic energy of a hydrogen orbital with
principal quantum number ``n`` (and an effective nuclear charge ``Z``)
according to

```math
\begin{equation}
\tag{BS2.11}
E_n =
-\frac{Z^2}{2n^2}
\end{equation}
```

"""
non_relativistic_energy(n, Z=1) = -Z^2/2n^2

"""
    non_relativistic_energy(o)

Return the non-relativistic energy of the orbital `o`.

# Examples

```jldoctest
julia> non_relativistic_energy(o"1s")
-0.5

julia> non_relativistic_energy(o"2p")
-0.125

julia> non_relativistic_energy(ro"2p")
-0.125

julia> non_relativistic_energy(ro"2p-")
-0.125
```
"""
non_relativistic_energy(o::AbstractOrbital) = non_relativistic_energy(o.n)
non_relativistic_energy(o::SpinOrbital) = non_relativistic_energy(o.orb)

@doc raw"""
    relativistic_energy(n, κ[, Z=1])

Returns the relativistic energy of a hydrogen orbital with principal
quantum number ``n`` and "angular momentum" quantum number ``κ`` (and
an effective nuclear charge ``Z``) according to

```math
\begin{equation}
\tag{BS14.29*}
E_{nκ} =
c^2\left[
-1+
\frac{1}{\sqrt{1 +
\left(
\frac{Zα}{n - \abs{κ} + \sqrt{κ^2-Z^2α^2}}
\right)^2}}
\right]
\end{equation}
```

where the energy has been shifted by ``-c^2`` compared to
``\mathrm{(BS14.29)}``.

"""
function relativistic_energy(n, κ, Z=1)
    r = Z*α/(n-abs(κ)+√(κ^2-Z^2*α^2))
    -c^2*(1-inv(√(1+r^2)))
end

"""
    relativistic_energy(o::RelativisticOrbital)

Return the relativistic energy for the orbital `o`.

# Example

```jldoctest
julia> relativistic_energy(ro"1s")
-0.5000066565961734

julia> relativistic_energy(ro"2p-")
-0.12500208019062972

julia> relativistic_energy(ro"2p")
-0.1250004160284539
```
"""
relativistic_energy(o::RelativisticOrbital) = relativistic_energy(o.n, o.κ)
relativistic_energy(o::SpinOrbital) = relativistic_energy(o.orb)

"""
    orbital_energy(o)

Return the energy of orbital `o`, automatically choosing between
[`non_relativistic_energy`](@ref) and [`relativistic_energy`](@ref),
depending on the type of `o`.

# Examples

```jldoctest
julia> orbital_energy(o"1s")
-0.5

julia> orbital_energy(ro"1s")
-0.5000066565961734

julia> orbital_energy(o"2p")
-0.125

julia> orbital_energy(ro"2p")
-0.1250004160284539
```

"""
orbital_energy(o::Orbital) = non_relativistic_energy(o)
orbital_energy(o::RelativisticOrbital) = relativistic_energy(o)
orbital_energy(o::SpinOrbital) = orbital_energy(o.orb)

ground_state( ::Orbital) = o"1s"
ground_state( ::RelativisticOrbital) = ro"1s"
ground_state(o::SpinOrbital) = ground_state(o.orb)

"""
    atomic_hamiltonian(orbitals[; Efun=orbital_energy, neutral_zero=true])

Return the diagonal matrix whose elements corresponds to the energies
of each of the `orbitals`, by default [`orbital_energy`](@ref) is used
to determine the energy, which dispatches on the orbital type to
return the appropriate energy (non-relativistic or relativistic), and
all energies are shifted such that `1s` has zero energy, if
`neutral_zero==true`.

# Examples

```jldoctest
julia> atomic_hamiltonian(os"1[s] 2[s-p]")
3×3 LinearAlgebra.Diagonal{Float64,Array{Float64,1}}:
 0.0   ⋅      ⋅
  ⋅   0.375   ⋅
  ⋅    ⋅     0.375

julia> atomic_hamiltonian(ros"1[s] 2[s-p]")
4×4 LinearAlgebra.Diagonal{Float64,Array{Float64,1}}:
 0.0   ⋅         ⋅         ⋅
  ⋅   0.375005   ⋅         ⋅
  ⋅    ⋅        0.375005   ⋅
  ⋅    ⋅         ⋅        0.375006
```
"""
function atomic_hamiltonian(orbitals; Efun::Function=orbital_energy,
                            neutral_zero=true)
    E = zeros(length(orbitals))

    for (i,o) in enumerate(orbitals)
        E[i] = Efun(o)
    end

    if neutral_zero && !isempty(orbitals)
        E .-= Efun(ground_state(first(orbitals)))
    end

    Diagonal(E)
end

export non_relativistic_energy, relativistic_energy, orbital_energy, atomic_hamiltonian


using Statistics, StatsBase

function MNmodel(θ, rndseed=1234)
    n = 1000
    μ1, μ2, σ1, σ2, prob = θ
    d1=randn(n).*σ1 .+ μ1
    d2=randn(n).*(σ1+σ2) .+ (μ1 - μ2) # second component lower mean and higher variance
    ps=rand(n).<prob
    data=zeros(n)
    data[ps].=d1[ps]
    data[.!ps].=d2[.!ps]
    return data
end

function auxstat(data)
    r = 0.0 : 0.1 : 1.0
    sqrt(1000.).*vcat(mean(data), std(data), skewness(data), kurtosis(data),
        quantile.(Ref(data),r))
end

function auxstat(θ, reps)
    auxstat.([MNmodel(θ, rand(1:Int64(1e12))) for i = 1:reps])
end

function TrueParameters()
    [1.0, 1.0, 0.2, 1.8, 0.4] # first component N(1,0.2) second component N(0,2)
end

function PriorSupport()
    lb = [0.0, 0.0, 0.0, 0.0, 0.05] # there is always at least 5% prob for each component
    ub = [3.0, 3.0, 1.0, 3.0, 0.95]
    lb,ub
end

function PriorDraw()
    lb, ub = PriorSupport()
    θ = (ub-lb).*rand(size(lb,1)) + lb
end

function InSupport(θ)
    lb,ub = PriorSupport()
    all(θ .>= lb) & all(θ .<= ub)
end

# prior should be an array of distributions, one for each parameter
lb, ub = PriorSupport() # need these in Prior
macro Prior()
    return :( arraydist([Uniform(lb[i], ub[i]) for i = 1:size(lb,1)]) )
end


@doc raw"""
    HomogeneousPoissonPointProcess{T<:Vector{Float64}} <: AbstractSpatialPointProcess{T}

Homegeneous [Poisson point process](https://en.wikipedia.org/wiki/Poisson_point_process) with intensity ``\beta > 0``, denoted ``\operatorname{Poisson}(\beta)``.

``\operatorname{Poisson}(\beta)`` has density (w.r.t. the homogenous Poisson point process with unit intensity ``\operatorname{Poisson}(1)``) proportional to

```math
    \prod_{x \in X}
        \beta.
```
"""
struct HomogeneousPoissonPointProcess{T<:Vector{Float64}} <: AbstractSpatialPointProcess{T}
    β::Float64
    window::AbstractSpatialWindow{Float64}
end

function Base.show(io::IO, pp::HomogeneousPoissonPointProcess{T}) where {T}
    print(io, "HomogeneousPoissonPointProcess{$T}\n- β = $(pp.β)\n- window = $(pp.window)")
end

@doc raw"""
    HomogeneousPoissonPointProcess(
        β::Real,
        window::Union{Nothin,AbstractSpatialWindow}=nothing
    )

Construct a [`PRS.HomogeneousPoissonPointProcess`](@ref) with intensity `β` restricted to `window`.

Default window (`window=nothing`) is [`PRS.SquareWindow`](@ref)`()`.

```jldoctest; output = true
using PartialRejectionSampling

β = 40
win = PRS.SquareWindow(zeros(2), 1)
PRS.HomogeneousPoissonPointProcess(β, win)

# output

HomogeneousPoissonPointProcess{Array{Float64,1}}
- β = 40.0
- window = SquareWindow [0.0, 1.0]^2
```
"""
function HomogeneousPoissonPointProcess(
    β::Real,
    window::Union{Nothing,AbstractSpatialWindow}=nothing
)
    @assert β > 0
    win = isnothing(window) ? SquareWindow() : window
    return HomogeneousPoissonPointProcess{Vector{Float64}}(β, win)
end

"""
    intensity(pp::HomogeneousPoissonPointProcess) = pp.β
"""
intensity(pp::HomogeneousPoissonPointProcess) = pp.β

## Sampling

"""
    generate_sample(
        [rng::Random.AbstractRNG,]
        pp::HomogeneousPoissonPointProcess{Vector{T}},
        win::Union{Nothing,AbstractWindow}=nothing
    )::Matrix{T} where {T<:Float64}

Generate an exact sample from [`PRS.HomogeneousPoissonPointProcess`](@ref) on window `win`.
Sampled points are stored as columns of the output matrix.

Default window (`win=nothing`) is `window(pp)`.
"""
function generate_sample(
    rng::Random.AbstractRNG,
    pp::HomogeneousPoissonPointProcess{Vector{T}},
    win::Union{Nothing,AbstractWindow}=nothing
)::Matrix{T} where {T<:Float64}
    window_ = isnothing(win) ? window(pp) : win
    n = rand(rng, Distributions.Poisson(pp.β * volume(window_)))
    return rand(rng, window_, n)
end

# function generate_sample(
#     pp::HomogeneousPoissonPointProcess,
#     win::Union{Nothing,AbstractWindow}=nothing
# )
#     return generate_sample(Random.default_rng(), pp, win=win)
# end

@doc raw"""
    generate_sample_poisson_union_balls(
        [rng::Random.AbstractRNG,]
        β::Real,
        centers::Matrix,
        radius::Real,
        win::Union{Nothing,AbstractWindow}=nothing
    )::Matrix{Float64}

Generate an exact sample from a homogenous [`PRS.HomogeneousPoissonPointProcess`](@ref) Poisson(β) on ``\bigcup_{i} B(c_i, r)`` (union of balls centered at ``c_i`` with the same radius ``r``).

If `win ≂̸ nothing`, returns the points falling in `win`.

!!! hint

    Use the independence property of the Poisson point process on disjoint subsets in order to

    - Sample from Poisson(β) on ``B(c_1, r)``,
    - Sample from Poisson(β) on ``B(c_2, r) \setminus B(c_1, r)``,
    - Sample from Poisson(β) on ``B(c_j, r) \setminus \bigcup_{i<j} B(c_i, r)``,
    - ...
"""
function generate_sample_poisson_union_balls(
    rng::Random.AbstractRNG,
    β::Real,
    centers::Matrix,
    radius::Real,
    win::Union{Nothing,AbstractWindow}=nothing
)::Matrix{Float64}
    d = size(centers, 1)
    !(isnothing(win)) && @assert dimension(win) == d

    𝒫 = Distributions.Poisson(β * volume(BallWindow(zeros(d), radius)))
    points = Matrix{Float64}(undef, d, 0)
    for (i, c) in enumerate(eachcol(centers))
        n = rand(rng, 𝒫)
        n == 0 && continue
        proposed = rand(rng, BallWindow(c, radius), n)
        if i == 1
            points = hcat(points, proposed)
            continue
        end
        centers_ = @view centers[:, 1:i-1]
        accept = vec(all(pairwise_distances(centers_, proposed) .> radius, dims=1))
        points = hcat(points, proposed[:, accept])
    end

    if isnothing(win) || isempty(points)
        return points
    end
    return points[:, vec(mapslices(x -> x in win, points; dims=1))]
end

function generate_sample_poisson_union_balls(
    β::Real,
    centers::Matrix,
    radius::Real,
    win::Union{Nothing,AbstractWindow}=nothing
)
    generate_sample_poisson_union_balls(Random.default_rng(), β, centers, radius, win)
end


function dataTransf(x::AbstractVecOrMat, transfId::Vector{Int})
    y = similar(x)
    n_loss = 0
    for i = 1:size(x, 2)
        (y[:,i], n_loss_temp) = dataTransf(x[:,i], transfId[i])
        n_loss = max(n_loss, n_loss_temp)
    end
    return (y = y, n_loss = n_loss)
end

function dataTransf(x::AbstractVecOrMat, transfId::Int)
#   Categories:
#   ------------------------------------------------------------------------
#   1. Levels (Y_{t})
#   2. First Difference (Y_{t}-Y_{t-1})
#   3. Seasonal difference in quarterly data ((Y_{t})-(Y_{t-4}))
#   4. Seasonal difference in monthly data ((Y_{t})-(Y_{t-12}))
#   5. Log-levels (Ln(Y_{t}))
#   6. Log-First Difference (Ln(Y_{t})-Ln(Y_{t-1}))
#   7. Seasonal log difference in quarterly data (Ln(Y_{t})-Ln(Y_{t-4}))
#   8. Seasonal log difference in monthly data (Ln(Y_{t})-Ln(Y_{t-12}))
#   9. Detrending Ln(Y_{t}) by HP filter using quarterly data
#   10. Detrending Ln(Y_{t}) by HP filter using monthly data
#   11. Seasonal difference of a detrended Ln(Y_{t}) by HP filter using quarterly data
#   12. Seasonal difference of a detrended Ln(Y_{t}) by HP filter using monthly data
#   13. Seasonal difference of a detrended Ln(Y_{t}) by removing a linear trend
#   14. Detrended Y_{t} by removing a linear trend (for already SA data)
#   15. Detrended Ln(Y_{t}) by removing a linear trend (for already SA data)
#  =========================================================================
    y = similar(x)

    if transfId == 1
        y = copy(x)
        n_loss = 0
    elseif transfId == 2
        y[2:end,:] = x[2:end,:] - x[1:end - 1,:]
        n_loss = 1
    elseif transfId == 3
        y[5:end,:] = x[5:end,:] - x[1:end - 4,:]
        n_loss = 4
    elseif transfId == 4
        y[13:end,:] = x[13:end,:] - x[1:end - 12,:]
        n_loss = 12
    elseif transfId == 5
        y = log.(x)
        n_loss = 0
    elseif transfId == 6
        y[2:end,:] = log.(x[2:end,:]) - log.(x[1:end - 1,:])
        n_loss = 1
    elseif transfId == 7
        y[5:end,:] = log.(x[5:end,:]) - log.(x[1:end - 4,:])
        n_loss = 4
    elseif transfId == 8
        y[13:end,:] = log.(x[13:end,:]) - log.(x[1:end - 12,:])
        n_loss = 12
        # case 7
        #     yt=hpfilter(log(x),1600);
        #     y=log(x)-yt;
        #     n_loss=0;
        # case 8
        #     yt=hpfilter(log(x),14400);
        #     y=log(x)-yt;
        #     n_loss=0;
        # case 9
        #     yt=hpfilter(log(x),1600);
        #     yt=log(x)-yt;
        #     y(5:end,:)=yt(5:end,:)-yt(1:end-4,:);
        #     n_loss=4;
        # case 10
        #     yt=hpfilter(log(x),14400);
        #     yt=log(x)-yt;
        #     y(13:end,:)=yt(13:end,:)-yt(1:end-12,:);
        #     n_loss=12;
    elseif transfId == 13
        yt = log.(x)
        yt = yt[13:end,:] - yt[1:end - 12,:]
        y[14:end,:] = yt[2:end,:] - yt[1:end - 1,:]
        n_loss = 13
    elseif transfId == 14
        y = detrend(x, power=1)
        n_loss = 0
    elseif transfId == 15
        y = detrend(log.(x), power=1)
        n_loss = 0
    else
        error("Please specify a valid transformation index")
    end

    return (y = y, n_loss = n_loss)
end

function detrend(y::AbstractVecOrMat;power::Int = 1)
    T = size(y, 1)
    X = similar(y, T, power + 1)
    X[:,1] = ones(T)
    if power > 0
        for i = 1:power
            X[:,i + 1] = collect(1:T).^i
        end
    end
    b = X \ y
    return y - X * b
end


#   Unit "tapers" of the FourierAnalysis Package for julia language
#
#   MIT License
#   Copyright (c) 2019-2022,
#   Marco Congedo, CNRS, Grenobe, France:
#   https://sites.google.com/site/marcocongedo/home

# ? CONTENTS :
#   This unit implements several tapering windows in the time domain.
#
#   See F.J. Harris
#   "On the Use of Windows for Harmonic Analysis with the Discrete Fourier Transform"
#   Proc. IEEE, 66, 51-53, 1978
#   http://www.utdallas.edu/~cpb021000/EE%204361/Great%20DSP%20Papers/Harris%20on%20Windows.pdf
#
#   D. Slepian
#   "Prolate Spheroidal Wave Functions. Fourier Analysis, and Uncertainty—V: The Discrete Case"
#   The Bell System Technical Journal,VoL 57, No. 5. May-June 1978
#   https://ieeexplore-ieee-org.gaelnomade-1.grenet.fr/stamp/stamp.jsp?tp=&arnumber=6771595
#
#   D.J. Thomson
#   "Spectrum estimation and harmonic analysis."
#   Proc. IEEE 70: 1055-1096, 1982.
#   http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.471.1278&rep=rep1&type=pdf

#   Other resources :
#   https://pdfs.semanticscholar.org/752d/1a551b96559458064323eb3de7faaaef4c4e.pdf
#   ~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~  #
#                                                                             #
#   ~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~~¤~  #

# time-domain tapering windows.
@enum TaperKind begin
    rectangular = 1
    triangular  = 2
    hann        = 3
    hamming     = 4
    blackman    = 5
    harris4     = 6
    riesz       = 7
    parzen      = 8
    slepian     = 9
end

TaperData=Union{Vector{T}, Matrix{T}} where T<:Union{Real, Complex}

struct Taper
    y    :: TaperData # here is the taper
    kind :: TaperKind # enumerated type; see here above
    α    :: Real # 1-parameter tapers are supported
    n    :: Int # number of tapers; >1 only for slepians
end

### Time-domain tapering ###
###############################################################################
"""
```julia
function taper( kind  :: TaperKind,
                wl    :: Int;
            α       :: Real    = 2.,
            n       :: Int     = ceil(Int, 2*α)-1,
            padding :: Int     = 0,
            type    :: Type{T} = Float64) where T<:Union{Real, Complex}

```
Universal constructor of [Taper](@ref) objects, given a tapering window
`kind`, of type [TaperKind](@ref) and the window length `wl`.
NB: for the `hamming` and `blackman` type use `FourierAnalysis.hamming` and `FourierAnalysis.blackman`
to avoid conflicts with the DSP package.

Return a vector of length `wl` for all types of tapers, but for the dpss
(Slepian multi-tapers), for which return a matrix of size `wl` x `n`.

If optional keyword argument `padding` is >0, then the actual window length
will be `wl` + `padding`.

The `type` optional keyword argument can be use to specify the the type of
elements of the typering window. By default, this is the `Float64` type.

Optional keywords arguments `α` and `n` currently apply only for slepian
multi-tapering (*discrete prolate spheroidal sequences*):

`α` is the *half bandwidth* (hbw) parameter as per the DSP.jl package.
This unit is used in many dpss implementations and it is often reported
that "typical values" for `α` are 2, 2.5, 3, 3.5 or 4.
However, the optimal smoothing increases with the ratio between window length
and sampling rate, thus these values in absolute terms are not useful.
In fact, the larger the *hbw* and the higher `n`, the smoother the
spectra will be (variance reduction). In order to overcome these
difficulties, for Slepian's multitapering
*FourirAnalysis* implements the [`slepians`](@ref) constructor,
which allows the bandwidth parameter to be given in Hz and the
number of tapering windows to be chosen automatically.

`n` is the number of tapering windows. For slepian tapers this is
the number of the discrete prolate spheroidal sequences.
As in the DSP package, by default it is set to
`ceil(Int, 2*α)-1`, however, depending on how large this number is,
low eigenvalues may correspond to the last sequences, therefore
those should be discarded.

**See**: [plot tapering windows](@ref).

**See also**: [`slepians`](@ref), [`taperinfo`](@ref)

**Examples**:
```julia
using FourierAnalysis

## Use the constructor
sr, t, f, a = 128, 128, 10, 0.5
# create a sinusoidal superimposed to white noise
v=sinusoidal(a, f, sr, t*16, 0) + randn(t*16)
# create a data matrix
X=broadcast(+, v, randn(t*16, 3))*randn(3, 3)
# compute spectra using hamming tapering window
# we need to prepend 'FourierAnalysis.' since `hamming`
# is declared also in DSP.jl
H=taper(FourierAnalysis.hamming, t)
S=spectra(X, sr, t; tapering=H)
# you can obtain the same thing with
S=spectra(X, sr, t; tapering=H)
# which will create the hamming tapering window on the fly,
# thus calling explicitly the constructor is interesting
# only if you need to reuse the same tapering window many times.

## Plot tapering windows using the standard plot function
using Plots
tapers=[TaperKind(i) for i=1:8]
X=zeros(t, 8)
for i=1:8 X[:, i] = taper(tapers[i], t).y end
mylabels=Array{String}(undef, 1, 8)
for i=1:8 mylabels[1, i]=string(tapers[i]) end
plot(X; labels=mylabels)

## using the recipe declared in recipes.jl
plot(taper(parzen, 256))
plot(taper(slepian, 256, α=4, n=7))

```
"""
function taper( kind :: TaperKind,
                wl   :: Int;  # wl is the window length
            α        :: Real    = 2.,    # only for splepians;
            n        :: Int     = ceil(Int, 2*α)-1, #ceil : Int greater then or equal to
            padding  :: Int     = 0,
            type     :: Type{T} = Float64) where T<:Union{Real, Complex}

    if      kind ∉ (rectangular, slepian)
            wl₋₁     = wl-1
            wl₋₁½    = wl₋₁/2
            c(i::Int) = cos(2π*(i-1)/wl₋₁)
            c(i::Int, j::Int) = cos(2π*j*(i-1)/wl₋₁)
    end

    if      kind == rectangular v = ones(type, wl)
    elseif  kind == triangular  v = Vector{type}([1 - abs(2*(i-1)-wl₋₁)/wl₋₁ for i=1:wl]) # zero at the edge
    elseif  kind == hann        v = Vector{type}([0.5*(1-c(i)) for i=1:wl])
    elseif  kind == hamming     v = Vector{type}([0.54 - 0.46*c(i) for i=1:wl])
    elseif  kind == blackman    v = Vector{type}([0.42 + 0.50*-c(i) + 0.08*c(i, 2) for i=1:wl])
                                     v[1]=0.; v[end]=0.
    elseif  kind == harris4     v = Vector{type}([0.35875 - 0.48829*c(i) + 0.14128*c(i, 2) - 0.01168*c(i, 3) for i=1:wl])
    elseif  kind == riesz       v = Vector{type}([1 - ((i-1-wl₋₁½)/wl₋₁½)^2 for i=1:wl])
    elseif  kind == parzen
            v=Vector{type}(undef, wl)
            wl½, wl¼= wl÷2, wl÷4
            for i=1:wl¼        v[i] = 2*((1 - (abs(i-wl½)/wl½))^3) end
            for i=wl¼+1:wl½    v[i] = 1 - 6*(abs(i-wl½)/wl½ )^2 + 6*(abs(i-wl½)/wl½)^3 end
            for i=wl½+1:wl-wl¼ v[i] = 1 - 6*(abs(i-1-wl½)/wl½)^2 + 6*(abs(i-1-wl½)/wl½)^3 end
            for i=wl-wl¼+1:wl  v[i] = 2*((1 - (abs(i-1-wl½)/wl½))^3) end
    elseif  kind == slepian    v    = Matrix{type}(dpss(wl, α, n, zerophase=false))
    end

    # This has to be checked:

    # normalize to unit mean or unit mean of absolute values
    if      kind ∉ (rectangular, slepian) v ./= mean(v) end
    if      kind == slepian v./=mean(abs.(a) for a in v) end

    # if      kind == slepian v./=mean(v.^2; dims=1) end
    # if      kind ∉ (rectangular, slepian) v ./= mean(v) end

    # normalization in DSP.jl
    #    if      taper == slepian for i=1:size(v, 2) v[:, i]./= (norm(v[:, i])/wl) end end
    # as above but givin less and less weight to the sequences
    #    if      taper == slepian for i=1:size(v, 2) v[:, i]./= √i*(norm(v[:, i])/wl) end end

    p=padding
    p>0 && (kind == slepian ? v=[v; zeros(type, p, n)] : v=[v; zeros(type, p)])

    return kind == slepian ? Taper(v, kind, α, n) : Taper(v, kind, 0., 1)
end

"""
Construct a [Taper](@ref) objects holding Slepian's multi-tapering
*discrete prolate spheroidal sequences*,
given sampling rate `sr`, window length `wl` and
the `bandwidth` argument in Hz.
For EEG data, 1<=bandwidth<=2 is an adequate choice.

The 'half-bandwidth' parameter `α` used in the DSP package and in the
universal [Taper](@ref) constructor is set as

        `α=(bandwidth/2)*wl/sr`.

The optimal number of dpss is heuristically set to

        `n=max(1, trunc(Int, 2*α)-trunc(Int, log(2*α)))`.

The created object can be passed as argument
in constructors [`spectra`](@ref), [`crossSpectra`](@ref) and
[`coherence`](@ref).

**See**: [plot tapering windows](@ref).

**Examples**:
```julia
using FourierAnalysis
sr, t, f, a = 128, 128, 10, 0.5
# create a sinusoidal superimposed to white noise
v=sinusoidal(a, f, sr, t*16, 0) + randn(t*16)
# create a data matrix
X=broadcast(+, v, randn(t*16, 3))*randn(3, 3)
# compute spectra using slepian multi-tapering with bandwidth 1.5
H=slepians(sr, t, 2)
S=spectra(X, sr, t; tapering=H)

using Plots
plot(H)
plot(S)
```
"""
function slepians( sr    :: Int,
                   wl    :: Int,
               bandwidth :: Real = 1.5)
    α=(bandwidth/2)*wl/sr # α parameter
    # heuristic to eliminate eigenfunctions with small eigenvalues
    n=max(1, trunc(Int, 2*α)-trunc(Int, log(2*α)))
    return taper(slepian, wl, α=α, n=n)
end
###############################################################################

"""
```julia
function taperinfo(taper::Taper)
```

Return the name of the
tapering window(s) encapsulated in the [Taper](@ref) object
as a string.

Only for Slepian's discrete prolate spheroidal sequences (dpss),
their parameters, namely, ``α`` (half-bandwidth)
and ``n`` (number of windows), are reported within parentheses as well.

**Examples**:
```julia
H=taper(hamming, 128*8)
taperinfo(H)

H=slepians(128, 128*8, 2)
taperinfo(H)
```
"""
taperinfo(taper::Taper) =
     taper.kind==slepian ? string(taper.kind)*"'s dpss (alpha=$(taper.α), n=$(taper.n))" :
                           string(taper.kind)

# ++++++++++++++++++++  Show override  +++++++++++++++++++ # (REPL output)
function Base.show(io::IO, ::MIME{Symbol("text/plain")}, 𝜏::Taper)
println(io, titleFont, "⍓ Taper type; $(size(𝜏.y, 1))-samples")
#println(io, "□  □    □      □        □           □", defaultFont)
println(io, separatorFont, "⭒  ⭒    ⭒      ⭒        ⭒           ⭒", defaultFont)
println(io, "taper kind   (.kind): ", string(𝜏.kind))
println(io, "half-bandwidth  (.α): $(𝜏.α)")
println(io, "number of tapers(.n): $(𝜏.n)")
𝜏.kind==slepian ? println(io, "data            (.y): $(size(𝜏.y, 1))x$(size(𝜏.y, 2))-", typeof(𝜏.y)) :
                 println(io, "data            (.y): $(length(𝜏.y))-", typeof(𝜏.y))

end
# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ #


"""
    complement(g)

Return the [graph complement](https://en.wikipedia.org/wiki/Complement_graph)
of a graph

### Implementation Notes
Preserves the eltype of the input graph.
"""
function complement(g::Graph)
    gnv = nv(g)
    h = Graph(gnv)
    for i=1:gnv
        for j=i+1:gnv
            if !has_edge(g, i, j)
                add_edge!(h,i,j)
            end
        end
    end
    return h
end

function complement(g::DiGraph)
    gnv = nv(g)
    h = DiGraph(gnv)
    for i in vertices(g), j in vertices(g)
      if i != j && !has_edge(g,i,j)
        add_edge!(h,i,j)
      end
    end
    return h
end

"""
    reverse(g)

Return a directed graph where all edges are reversed from the
original directed graph.

### Implementation Notes
Preserves the eltype of the input graph.
"""
function reverse end
@traitfn function reverse(g::::IsDirected)
    gnv = nv(g)
    gne = ne(g)
    h = DiGraph(gnv)
    h.fadjlist = deepcopy(g.badjlist)
    h.badjlist = deepcopy(g.fadjlist)
    h.ne = gne
    return h
end

"""
    reverse!(g)

In-place reverse of a directed graph (modifies the original graph).
"""
function reverse! end
@traitfn function reverse!(g::::IsDirected)
    g.fadjlist, g.badjlist = g.badjlist, g.fadjlist
    return g
end

doc"""
    blkdiag(g, h)

Return a graph with ``|V(g)| + |V(h)|`` vertices and ``|E(g)| + |E(h)|``
edges where the vertices an edges from graph `h` are appended to graph `g`.

### Implementation Notes
Preserves the eltype of the input graph. Will error if the
number of vertices in the generated graph exceeds the eltype.
"""
function blkdiag(g::T, h::T) where T<:AbstractGraph
    gnv = nv(g)
    r = T(gnv + nv(h))
    for e in edges(g)
        add_edge!(r, e)
    end
    for e in edges(h)
        add_edge!(r, gnv+src(e), gnv+dst(e))
    end
    return r
end

"""
    intersect(g, h)

Return a graph with edges that are only in both graph `g` and graph `h`.

### Implementation Notes
This function may produce a graph with 0-degree vertices.
Preserves the eltype of the input graph.
"""
function intersect(g::T, h::T) where T<:AbstractGraph
    gnv = nv(g)
    hnv = nv(h)

    r = T(min(gnv, hnv))
    for e in intersect(edges(g),edges(h))
        add_edge!(r,e)
    end
    return r
end

"""
    difference(g, h)

Return a graph with edges in graph `g` that are not in graph `h`.

### Implementation Notes
Note that this function may produce a graph with 0-degree vertices.
Preserves the eltype of the input graph.
"""
function difference(g::T, h::T) where T<:AbstractGraph
    gnv = nv(g)
    hnv = nv(h)

    r = T(gnv)
    for e in edges(g)
        !has_edge(h, e) && add_edge!(r,e)
    end
    return r
end

"""
    symmetric_difference(g, h)

Return a graph with edges from graph `g` that do not exist in graph `h`,
and vice versa.

### Implementation Notes
Note that this function may produce a graph with 0-degree vertices.
Preserves the eltype of the input graph. Will error if the
number of vertices in the generated graph exceeds the eltype.
"""
function symmetric_difference(g::T, h::T) where T<:AbstractGraph
    gnv = nv(g)
    hnv = nv(h)

    r = T(max(gnv, hnv))
    for e in edges(g)
        !has_edge(h, e) && add_edge!(r, e)
    end
    for e in edges(h)
        !has_edge(g, e) && add_edge!(r, e)
    end
    return r
end

"""
    union(g, h)

Return a graph that combines graphs `g` and `h` by taking the set union
of all vertices and edges.

### Implementation Notes
Preserves the eltype of the input graph. Will error if the
number of vertices in the generated graph exceeds the eltype.
"""
function union(g::T, h::T) where T<:AbstractGraph
    gnv = nv(g)
    hnv = nv(h)

    r = T(max(gnv, hnv))
    r.ne = ne(g)
    for i in vertices(g)
        r.fadjlist[i] = deepcopy(g.fadjlist[i])
        if is_directed(g)
            r.badjlist[i] = deepcopy(g.badjlist[i])
        end
    end
    for e in edges(h)
        add_edge!(r, e)
    end
    return r
end

"""
    join(g, h)

Return a graph that combines graphs `g` and `h` using `blkdiag` and then
adds all the edges between the vertices in `g` and those in `h`.

### Implementation Notes
Preserves the eltype of the input graph. Will error if the number of vertices
in the generated graph exceeds the eltype.
"""
function join(g::T, h::T) where T<:AbstractGraph
    r = blkdiag(g, h)
    for i in vertices(g)
        for j=nv(g)+1:nv(g)+nv(h)
            add_edge!(r, i, j)
        end
    end
    return r
end

"""
    crosspath(len::Integer, g::Graph)

Return a graph that duplicates `g` `len` times and connects each vertex
with its copies in a path.

### Implementation Notes
Preserves the eltype of the input graph. Will error if the number of vertices
in the generated graph exceeds the eltype.
"""
function crosspath end
@traitfn function crosspath(len::Integer, g::::(!IsDirected))
    T = eltype(g)
    p = PathGraph(len)
    h = Graph{T}(p)
    return cartesian_product(h, g)
end

# The following operators allow one to use a LightGraphs.Graph as a matrix in eigensolvers for spectral ranking and partitioning.
# """Provides multiplication of a graph `g` by a vector `v` such that spectral
# graph functions in [GraphMatrices.jl](https://github.com/jpfairbanks/GraphMatrices.jl) can utilize LightGraphs natively.
# """
function *(g::Graph, v::Vector{T}) where T<:Real
    length(v) == nv(g) || error("Vector size must equal number of vertices")
    y = zeros(T, nv(g))
    for e in edges(g)
        i = src(e)
        j = dst(e)
        y[i] += v[j]
        y[j] += v[i]
    end
    return y
end

function *(g::DiGraph, v::Vector{T}) where T<:Real
    length(v) == nv(g) || error("Vector size must equal number of vertices")
    y = zeros(T, nv(g))
    for e in edges(g)
        i = src(e)
        j = dst(e)
        y[i] += v[j]
    end
    return y
end

"""
    sum(g, i)

Return a vector of indegree (`i`=1) or outdegree (`i`=2) values for graph `g`.
"""
function sum(g::AbstractGraph, dim::Int)
    dim == 1 && return indegree(g, vertices(g))
    dim == 2 && return outdegree(g, vertices(g))
    error("Graphs are only two dimensional")
end

size(g::AbstractGraph) = (nv(g), nv(g))
"""
    size(g, i)

Return the number of vertices in `g` if `i`=1 or `i`=2, or `1` otherwise.
"""
size(g::Graph,dim::Int) = (dim == 1 || dim == 2)? nv(g) : 1

"""
    sum(g)

Return the number of edges in `g`
"""
sum(g::AbstractGraph) = ne(g)

"""
    sparse(g)

Return the default adjacency matrix of `g`.
"""
sparse(g::AbstractGraph) = adjacency_matrix(g)

#arrayfunctions = (:eltype, :length, :ndims, :size, :strides, :issymmetric)
# eltype(g::AbstractGraph) = Float64
length(g::AbstractGraph) = nv(g)*nv(g)
ndims(g::AbstractGraph) = 2
issymmetric(g::AbstractGraph) = !is_directed(g)

"""
    cartesian_product(g, h)

Return the (cartesian product)[https://en.wikipedia.org/wiki/Tensor_product_of_graphs]
of `g` and `h`.

### Implementation Notes
Preserves the eltype of the input graph. Will error if the number of vertices
in the generated graph exceeds the eltype.
"""
function cartesian_product(g::G, h::G) where G<:AbstractGraph
    z = G(nv(g)*nv(h))
    id(i, j) = (i-1)*nv(h) + j
    for e in edges(g)
        i1, i2 = Tuple(e)
        for j=1:nv(h)
            add_edge!(z, id(i1,j), id(i2,j))
        end
    end

    for e in edges(h)
        j1, j2 = Tuple(e)
        for i in vertices(g)
            add_edge!(z, id(i,j1), id(i,j2))
        end
    end
    return z
end

"""
    tensor_product(g, h)

Return the (tensor product)[https://en.wikipedia.org/wiki/Tensor_product_of_graphs]
of `g` and `h`.

### Implementation Notes
Preserves the eltype of the input graph. Will error if the number of vertices
in the generated graph exceeds the eltype.
"""
function tensor_product(g::G, h::G) where G<:AbstractGraph
    z = G(nv(g)*nv(h))
    id(i, j) = (i-1)*nv(h) + j
    for e1 in edges(g)
        i1, i2 = Tuple(e1)
        for e2 in edges(h)
            j1, j2 = Tuple(e2)
            add_edge!(z, id(i1, j1), id(i2, j2))
        end
    end
    return z
end

## subgraphs ###

"""
    induced_subgraph(g, vlist)
    induced_subgraph(g, elist)

Return the subgraph of `g` induced by the vertices in  `vlist` or edges in `elist`
along with a vector mapping the new vertices to the old ones
(the  vertex `i` in the subgraph corresponds to the vertex `vmap[i]` in `g`.)

The returned graph has `length(vlist)` vertices, with the new vertex `i`
corresponding to the vertex of the original graph in the `i`-th position
of `vlist`.

### Usage Examples
```doctestjl
julia> g = CompleteGraph(10)

julia> sg, vmap = induced_subgraph(g, 5:8)

julia> @assert g[5:8] == sg

julia> @assert nv(sg) == 4

julia> @assert ne(sg) == 6

julia> @assert vm[4] == 8

julia> sg, vmap = induced_subgraph(g, [2,8,3,4])

julia> @assert sg == g[[2,8,3,4]]

julia> elist = [Edge(1,2), Edge(3,4), Edge(4,8)]

julia> sg, vmap = induced_subgraph(g, elist)

julia> @assert sg == g[elist]
```
"""
function induced_subgraph(g::T, vlist::AbstractVector{U}) where T<:AbstractGraph where U<:Integer
    allunique(vlist) || error("Vertices in subgraph list must be unique")
    h = T(length(vlist))
    newvid = Dict{U, U}()
    vmap =Vector{U}(length(vlist))
    for (i,v) in enumerate(vlist)
        newvid[v] = U(i)
        vmap[i] = v
    end

    vset = Set(vlist)
    for s in vlist
        for d in out_neighbors(g, s)
            # println("s = $s, d = $d")
            if d in vset && has_edge(g, s, d)
                newe = Edge(newvid[s], newvid[d])
                add_edge!(h, newe)
            end
        end
    end
    return h, vmap
end

function induced_subgraph(g::T, elist::AbstractVector{U}) where T<:AbstractGraph where U<:AbstractEdge
    h = zero(g)
    et = eltype(h)
    newvid = Dict{et, et}()
    vmap = Vector{et}()

    for e in elist
        u, v = Tuple(e)
        for i in (u,v)
            if !haskey(newvid, i)
                add_vertex!(h)
                newvid[i] = nv(h)
                push!(vmap, i)
            end
        end
        add_edge!(h, newvid[u], newvid[v])
    end
    return h, vmap
end

"""
    g[iter]

Return the subgraph induced by `iter`.
Equivalent to [`induced_subgraph`](@ref)`(g, iter)[1]`.
"""
getindex(g::AbstractGraph, iter) = induced_subgraph(g, iter)[1]

"""
    egonet(g, v:, d)

Return the subgraph of `g` induced by the neighbors of `v` up to distance
`d`.
This is equivalent to [`induced_subgraph`](@ref)`(g, neighborhood(g, v, d, dir=dir))[1].`

### Optional Arguments
- `dir=:out`: if `g` is directed, this argument specifies the edge direction
with respect to `v` (i.e. `:in` or `:out`).
"""
egonet(g::AbstractGraph, v::Integer, d::Integer; dir=:out) = g[neighborhood(g, v, d, dir=dir)]


function gausshermite( n::Int )
# GAUSSHERMITE(n) COMPUTE THE GAUSS-HERMITE NODES AND WEIGHTS IN O(n) time.

if n < 0
    x = (Float64[],Float64[])
    return x
elseif n == 0
    x = (Float64[],Float64[])
    return x
elseif n == 1
    x = ([0.0],[sqrt(pi)])
    return x
elseif n <= 20
   # GW algorithm
   x = hermpts_gw( n )
elseif n <= 200
   # REC algorithm
   x = hermpts_rec( n )
else
   # ASY algorithm
   x = hermpts_asy( n )
end

if mod(n,2) == 1                              # fold out
    w = [flipdim(x[2][:],1); x[2][2:end]]
    w = (sqrt(pi)/sum(w))*w
    x = ([-flipdim(x[1],1) ; x[1][2:end]], w)
else
    w = [flipdim(x[2][:],1); x[2][:]]
    w = (sqrt(pi)/sum(w))*w
    x = ([-flipdim(x[1],1) ; x[1]], w)
end

end

function hermpts_asy( n::Int )
# Compute Hermite nodes and weights using asymptotic formula

x0 = HermiteInitialGuesses( n ) # get initial guesses
t0 = x0./sqrt(2n+1)
theta0 = acos(t0)               # convert to theta-variable
val = x0;
for k = 1:20
    val = hermpoly_asy_airy(n, theta0);
    dt = -val[1]./(sqrt(2)*sqrt(2n+1)*val[2].*sin(theta0))
    theta0 = theta0 - dt;                        # Newton update
    if norm(dt,Inf) < sqrt(eps(Float64))/10
       break
    end
end
t0 = cos(theta0)
x = sqrt(2n+1)*t0                          #back to x-variable
ders = x.*val[1] + sqrt(2)*val[2]
w = (exp(-x.^2)./ders.^2)';            # quadrature weights

x = (x, w)
end

function hermpts_rec( n::Int )
# Compute Hermite nodes and weights using recurrence relation.

x0 = HermiteInitialGuesses( n )
x0 = x0.*sqrt(2)
val = x0
for kk = 1:10
    val = hermpoly_rec(n, x0)
    dx = val[1]./val[2]
    dx[ isnan( dx ) ] = 0
    x0 = x0 - dx
    if norm(dx, Inf)<sqrt(eps(Float64))
        break
    end
end
x = x0/sqrt(2)
w = exp(-x.^2)./val[2].^2           # quadrature weights

x = (x, w)
end

function hermpoly_rec( n::Int, x0)
# HERMPOLY_rec evaluation of scaled Hermite poly using recurrence

# evaluate:
Hold = exp(-x0.^2/4)
H = x0.*exp(-x0.^2/4)
for k = 1:n-1
    Hold, H = H, (x0.*H./sqrt(k+1) - Hold./sqrt(1+1/k))
end
# return (value, derivative):
val = (H, (-x0.*H + sqrt(n)*Hold))
end

function hermpoly_asy_airy(n::Int, theta)
# HERMPOLY_ASY evaluation hermite poly using Airy asymptotic formula in
# theta-space.

musq = 2n+1;
cosT = cos(theta)
sinT = sin(theta)
sin2T = 2*cosT.*sinT
eta = .5*theta - .25*sin2T
chi = -(3*eta/2).^(2/3)
phi = (-chi./sinT.^2).^(1/4)
C = 2*sqrt(pi)*musq^(1/6)*phi
Airy0 = real(airy(musq.^(2/3)*chi))
Airy1 = real(airy(1,musq.^(2/3)*chi))

# Terms in (12.10.43):
a0 = 1; b0 = 1
a1 = 15/144; b1 = -7/5*a1
a2 = 5*7*9*11/2/144^2; b2 = -13/11*a2
a3 = 7*9*11*13*15*17/6/144^3
b3 = -19/17*a3

# u polynomials in (12.10.9)
u0 = 1; u1 = (cosT.^3-6*cosT)/24
u2 = (-9*cosT.^4 + 249*cosT.^2 + 145)/1152
u3 = (-4042*cosT.^9+18189*cosT.^7-28287*cosT.^5-151995*cosT.^3-259290*cosT)/414720

#first term
A0 = 1
val = A0*Airy0

#second term
B0 = -(a0*phi.^6.*u1+a1*u0)./chi.^2
val = val + B0.*Airy1./musq.^(4/3)

# third term
A1 = (b0*phi.^12.*u2 + b1*phi.^6.*u1 + b2*u0)./chi.^3
val = val + A1.*Airy0/musq.^2

# fourth term
B1 = -(phi.^18.*u3 + a1*phi.^12.*u2 + a2*phi.^6.*u1 + a3*u0)./chi.^5
val = val + B1.*Airy1./musq.^(4/3+2)

val = C.*val

## Derivative

eta = .5*theta - .25*sin2T
chi = -(3*eta/2).^(2/3)
phi = (-chi./sinT.^2).^(1/4)
C = sqrt(2*pi)*musq^(1/3)./phi

# v polynomials in (12.10.10)
v0 = 1; v1 = (cosT.^3+6*cosT)/24
v2 = (15*cosT.^4-327*cosT.^2-143)/1152
v3 = (259290*cosT + 238425*cosT.^3 - 36387*cosT.^5 + 18189*cosT.^7 - 4042*cosT.^9)/414720

# first term
C0 = -(b0*phi.^6.*v1 + b1.*v0)./chi
dval = C0.*Airy0/musq.^(2/3)

# second term
D0 =  a0*v0
dval = dval + D0*Airy1

# third term
C1 = -(phi.^18.*v3 + b1*phi.^12.*v2 + b2*phi.^6.*v1 + b3*v0)./chi.^4
dval = dval + C1.*Airy0/musq.^(2/3+2)

#fourth term
D1 = (a0*phi.^12.*v2 + a1*phi.^6.*v1 + a2*v0)./chi.^3
dval = dval + D1.*Airy1/musq.^2

dval = C.*dval

val = (val, dval)
end

function HermiteInitialGuesses( n::Int )
#HERMITEINTITIALGUESSES(N), Initial guesses for Hermite zeros.
#
# [1] L. Gatteschi, Asymptotics and bounds for the zeros of Laguerre
# polynomials: a survey, J. Comput. Appl. Math., 144 (2002), pp. 7-27.
#
# [2] F. G. Tricomi, Sugli zeri delle funzioni di cui si conosce una
# rappresentazione asintotica, Ann. Mat. Pura Appl. 26 (1947), pp. 283-300.

# Error if n < 20 because initial guesses are based on asymptotic expansions:
@assert n>=20

# Gatteschi formula involving airy roots [1].
# These initial guess are good near x = sqrt(n+1/2);
if mod(n,2) == 1
    m = (n-1)>>1
    bess = collect(1:m)*pi
    a = .5
else
    m = n>>1
    bess = (collect(0:m-1)+.5)*pi
    a = -.5
end
nu = 4*m + 2*a + 2
T(t) = t.^(2/3).*(1+5/48*t.^(-2)-5/36*t.^(-4)+(77125/82944)*t.^(-6) -108056875/6967296*t.^(-8)+162375596875/334430208*t.^(-10));
airyrts = -T(3/8*pi*(4*collect(1:m)-1))

airyrts_exact = [-2.338107410459762           # Exact Airy roots.
    -4.087949444130970
    -5.520559828095555
    -6.786708090071765
    -7.944133587120863
    -9.022650853340979
    -10.040174341558084
    -11.008524303733260
    -11.936015563236262
    -12.828776752865757]
airyrts[1:10] = airyrts_exact  # correct first 10.

x_init = sqrt(abs(nu + 2^(2/3)*airyrts*nu^(1/3) + 1/5*2^(4/3)*airyrts.^2*nu^(-1/3) +
    (11/35-a^2-12/175*airyrts.^3)/nu + (16/1575*airyrts+92/7875*airyrts.^4)*2^(2/3)*nu^(-5/3) -
    (15152/3031875*airyrts.^5+1088/121275*airyrts.^2)*2^(1/3)*nu^(-7/3)))
x_init_airy = real( flipdim(x_init,1) )

# Tricomi initial guesses. Equation (2.1) in [1]. Originally in [2].
# These initial guesses are good near x = 0 . Note: zeros of besselj(+/-.5,x)
# are integer and half-integer multiples of pi.
# x_init_bess =  bess/sqrt(nu).*sqrt((1+ (bess.^2+2*(a^2-1))/3/nu^2) );
Tnk0 = pi/2*ones(m)
nu = (4*m+2*a+2)
rhs = (4*m-4*collect(1:m)+3)./nu*pi

for k = 1:7
    val = Tnk0 - sin(Tnk0) - rhs
    dval = 1 - cos(Tnk0)
    dTnk0 = val./dval
    Tnk0 = Tnk0 - dTnk0
end

tnk = cos(Tnk0/2).^2
x_init_sin = sqrt(nu*tnk - (5./(4*(1-tnk).^2) - 1./(1-tnk)-1+3*a^2)/3/nu)

# Patch together
p = 0.4985+eps(Float64)
x_init = [x_init_sin[1:convert(Int,floor(p*n))] ;
x_init_airy[convert(Int,ceil(p*n)):end]]

if mod(n, 2) == 1
    x_init = [0 ; x_init]
    x_init = x_init[1:m+1]
else
    x_init = x_init[1:m]
end

return x_init
end

function hermpts_gw( n::Int )
# Golub--Welsch algorithm. Used here for n<=20.

    beta = sqrt(.5*(1:n-1))              # 3-term recurrence coeffs
    T = diagm(beta, 1) + diagm(beta, -1)   # Jacobi matrix
    (D, V) = eig(T)                      # Eigenvalue decomposition
    indx = sortperm(D)                  # Hermite points
    x = D[indx]
    w = sqrt(pi)*V[1,indx].^2            # weights

    # Enforce symmetry:
    ii = floor(Int, n/2)+1:n
    x = x[ii]
    w = w[ii]
    return (x,w)
end


using LinearAlgebra: checksquare

"""
    quadratic_expansion(A::IntervalMatrix, α::Real, β::Real)

Compute the quadratic expansion of an interval matrix, ``αA + βA^2``, using
interval arithmetics.

### Input

- `A` -- interval matrix
- `α` -- linear coefficient
- `β` -- quadratic coefficient

### Output

An interval matrix that encloses ``B := αA + βA^2``.

### Algorithm

This a variation of the algorithm in [1, Section 6]. If ``A = (aᵢⱼ)`` and
``B := αA + βA^2 = (bᵢⱼ)``, the idea is to compute each ``bᵢⱼ`` by factoring
out repeated expressions (thus the term *single-use expressions*).

First, let ``i = j``. In this case,

```math
bⱼⱼ = β\\sum_\\{k, k ≠ j} a_{jk} a_{kj} + (α + βa_{jj}) a_{jj}.
```

Now consider ``i ≠ j``. Then,

```math
bᵢⱼ = β\\sum_\\{k, k ≠ i, k ≠ j} a_{ik} a_{kj} + (α + βa_{ii} + βa_{jj}) a_{ij}.
```

[1] Kosheleva, Kreinovich, Mayer, Nguyen. Computing the cube of an interval
matrix is NP-hard. SAC 2005.
"""
function quadratic_expansion(A::IntervalMatrix, α::Real, β::Real)
    B = similar(A)
    n = checksquare(A)

    # case i = j
    @inbounds for j in 1:n
        B[j, j] = quadratic_expansion(A[j, j], α, β)
        for k in 1:n
            k == j && continue
            B[j, j] += β * (A[j, k] * A[k, j])
        end
    end

    # case i ≠ j
    @inbounds for j in 1:n
        for i in 1:n
            i == j && continue
            B[i, j] = A[i, j] * (α + β*(A[j, j] + A[i, i]))
            for k in 1:n
                (k == i || k == j) && continue
                B[i, j] += β * (A[i, k] * A[k, j])
            end
        end
    end
    return B
end

function quadratic_expansion(x::Interval, α::Real, β::Real)
    iszero(β) && return α * x

    return ((2 * β * x + α) ^ 2 - α ^ 2) / (4 * β)
end

function _truncated_exponential_series(A::IntervalMatrix{T}, t, p::Integer;
                                       n=checksquare(A)) where {T}
    if p == 0
        # index i = 0 (identity matrix)
        return IntervalMatrix(Interval(one(T)) * I, n)
    elseif p == 1
        # index i = 1
        S = A * t
    else
        # indices i = 1 and i = 2
        S = quadratic_expansion(A, t, t^2/2)
    end

    # index i = 0, (identity matrix, added implicitly)
    for i in 1:n
        S[i, i] += one(T)
    end

    if p < 3
        return S
    end

    # indices i >= 3
    pow = IntervalMatrixPower(A)
    increment!(pow)
    fact_num = t^2
    fact_denom = 2
    for i in 3:p
        fact_num *= t
        fact_denom *= i
        Aⁱ = increment!(pow)
        S += Aⁱ * (fact_num / fact_denom)
    end

    return S
end

"""
    exp_overapproximation(A::IntervalMatrix{T, Interval{T}}, t, p) where {T}

Overapproximation of the exponential of an interval matrix.

### Input

- `A` -- interval matrix
- `t` -- non-negative time value
- `p` -- order of the approximation

### Algorithm

See Theorem 1 in *Reachability Analysis of Linear Systems with Uncertain
Parameters and Inputs* by M. Althoff, O. Stursberg, M. Buss.
"""
function exp_overapproximation(A::IntervalMatrix{T, Interval{T}}, t, p) where {T}
    n = checksquare(A)
    S = _truncated_exponential_series(A, t, p; n=n)
    E = _exp_remainder(A, t, p; n=n)
    return S + E
end

# Implementation of Prop. 1 in Althoff, Matthias, Bruce H. Krogh, and Olaf Stursberg.
# "Analyzing reachability of linear dynamic systems with parametric uncertainties."
# Modeling, Design, and Simulation of Systems with Uncertainties. Springer, Berlin, Heidelberg, 2011. 69-94.
function _exp_remainder(A::IntervalMatrix{T}, t, p; n=checksquare(A)) where {T}
    C = max.(abs.(inf(A)), abs.(sup(A)))
    # compute Q = I + Ct + (Ct)^2/2! + ... + (Ct)^p/p!
    Q = Matrix(Diagonal(ones(T, n)))

    tⁱ = 1
    i! = 1
    Cⁱ = copy(C)
    for i in 1:p
        i! *= i
        tⁱ *= t
        Q += Cⁱ * tⁱ/i!
        Cⁱ *= C
    end
    M = exp(C*t)
    Y = M - Q
    Γ = IntervalMatrix(fill(zero(T)±one(T), (n, n)))
    E = Γ * Y
    return E
end

# Estimates the sum of the series in the matrix exponential. See Theorem 1
# in [1] Althoff, Matthias, Olaf Stursberg, and Martin Buss.
# Reachability analysis of nonlinear systems with uncertain parameters using conservative linearization.
# 2008 47th IEEE Conference on Decision and Control. IEEE, 2008.
function _exp_remainder_series(A::IntervalMatrix{T}, t, p; n=checksquare(A)) where {T}
    nA = opnorm(A, Inf)
    c = nA * t / (p + 2)
    @assert c < 1 "the remainder of the matrix exponential could not be " *
        "computed because a convergence condition is not satisfied: $c ≥ 1 " *
        "but it should be smaller than 1; try choosing a larger order"
    Γ = IntervalMatrix(fill(zero(T)±one(T), (n , n)))
    return Γ * ((nA*t)^(p+1) * (1/factorial(p + 1) * 1/(1-c)))
end

"""
    horner(A::IntervalMatrix{T}, K::Integer; [validate]::Bool=true)

Compute the matrix exponential using the Horner scheme.

### Input

- `A` -- interval matrix
- `K` -- number of expansions in the Horner scheme
- `validate` -- (optional; default: `true`) option to validate the precondition
                of the algorithm

### Algorithm

We use the algorithm in [1, Section 4.2].

[1] Goldsztejn, Alexandre, Arnold Neumaier. "On the exponentiation of interval
matrices". Reliable Computing. 2014.
"""
function horner(A::IntervalMatrix{T}, K::Integer;
                       validate::Bool=true) where {T}
    if validate
        nA = opnorm(A, Inf)
        c = K + 2
        if c <= nA
            throw(ArgumentError("the precondition for the " *
                "Horner-scheme algorithm is not satisfied: $c <= $nA; " *
                "try choosing a larger order"))
        end
    end
    if K <= 0
        throw(ArgumentError("the Horner evaluation requires a positive " *
            "number of expansions but received $K"))
    end

    n = checksquare(A)
    Iₙ = IntervalMatrix(Interval(one(T)) * I, n)
    H = Iₙ + A/K
    for i in (K-1):-1:1
        H = Iₙ + A / i * H
    end

    # remainder; the paper uses a less precise computation here
    R = _exp_remainder(A, one(T), K)

    return H + R
end

"""
    scale_and_square(A::IntervalMatrix{T}, l::Integer, t, p;
                     [validate]::Bool=true)

Compute the matrix exponential using scaling and squaring.

### Input

- `A` -- interval matrix
- `l` -- scaling-and-squaring order
- `t` -- non-negative time value
- `p` -- order of the approximation
- `validate` -- (optional; default: `true`) option to validate the precondition
                of the algorithm

### Algorithm

We use the algorithm in [1, Section 4.3], which first scales `A` by factor
``2^{-l}``, computes the matrix exponential for the scaled matrix, and then
squares the result ``l`` times.

```math
    \\exp(A * 2^{-l})^{2^l}
```

[1] Goldsztejn, Alexandre, Arnold Neumaier. "On the exponentiation of interval
matrices". Reliable Computing. 2014.
"""
function scale_and_square(A::IntervalMatrix{T}, l::Integer, t, p;
                          validate::Bool=true) where {T}
    if validate
        nA = opnorm(A, Inf) * t
        c = (p + 2) * 2.0^l
        if c <= nA
            throw(ArgumentError("the precondition for the " *
                "scaling-and-squaring algorithm is not satisfied: $c <= $nA; " *
                "try choosing a larger order"))
        end
    end

    A_scaled = A / Interval(T(2))^l
    E = exp_overapproximation(A_scaled, t, p)
    for i in 1:l
        E = square(E)
    end
    return E
end

"""
    exp_underapproximation(M::IntervalMatrix{T, Interval{T}}, t, p) where {T}

Overapproximation of the exponential of an interval matrix.

### Input

- `A` -- interval matrix
- `t` -- non-negative time value
- `p` -- order of the approximation

### Algorithm

See Theorem 2 in *Reachability Analysis of Linear Systems with Uncertain
Parameters and Inputs* by M. Althoff, O. Stursberg, M. Buss.
"""
function exp_underapproximation(A::IntervalMatrix{T, Interval{T}}, t, p) where {T}
    @assert p > 1 "the order $p < 2 is not supported"
    n = checksquare(A)

    Y = zeros(n, n)
    LA = inf(A)
    Aⁱl = LA^2
    Z = zeros(n, n)
    RA = sup(A)
    Aⁱr = RA^2
    fact_num = t^2
    fact_denom = 2
    for i in 3:p
        fact_num *= t
        fact_denom *= i
        fact = fact_num / fact_denom
        Aⁱl *= LA
        Y += Aⁱl * fact
        Aⁱr *= RA
        Z += Aⁱr * fact
    end

    B = IntervalMatrix{T}(undef, n , n)
    @inbounds for j in 1:n
        for i in 1:n
            minYZ = min(Y[i, j], Z[i, j])
            maxYZ = max(Y[i, j], Z[i, j])
            B[i, j] = Interval(minYZ, maxYZ)
        end
    end

    W = quadratic_expansion(A, t, t^2/2)
    res = W + B

    # add identity matrix implicitly
    for i in 1:n
        @inbounds res[i, i] += one(T)
    end
    return res
end


using LinearAlgebraicRepresentation
Lar = LinearAlgebraicRepresentation
using Plasm

V,EV = Lar.randomcuboids(100, .2)
V = Plasm.normalize(V,flag=true)
model2d = V,EV

Sigma =  Lar.spaceindex(model2d);
for k=1:length(Sigma) println(k,Sigma[k]) end

Plasm.view(Plasm.numbering(.15)((V,[[[k] for k=1:size(V,2)], EV])))
Plasm.viewexploded(V,EV)(1.2,1.2,1.2) 	# no numerical errors

W,EW = Lar.fragmentlines((V,EV))
Plasm.viewexploded(W,EW)(1.2,1.2,1.2)
Plasm.view(Plasm.numbering(.015)((W,[[[k] for k=1:size(W,2)], EW])))

V,EVs = Lar.biconnectedComponent((W,EW::Lar.Cells)) # 2-connected components (H & T)
hpcs = [ Plasm.lar2hpc(V,EVs[i]) for i=1:length(EVs) ]
Plasm.view([ Plasm.color(Plasm.colorkey[(k%12)==0 ? 12 : k%12])(hpcs[k]) for k=1:(length(hpcs)) ])

W = convert(Lar.Points, V')
cop_EV = Lar.coboundary_0(EW::Lar.Cells)
cop_EW = convert(Lar.ChainOp, cop_EV)
V, copEV, copFE = Lar.Arrangement.planar_arrangement(W::Lar.Points, cop_EW::Lar.ChainOp)

triangulated_faces = Lar.triangulate2D(V, [copEV, copFE])
FVs = convert(Array{Lar.Cells}, triangulated_faces)
W = convert(Lar.Points, V')
Plasm.viewcolor(W::Lar.Points, FVs::Array{Lar.Cells})