using Base.MathConstants

# barebones polynomial type supporting +, -, *
struct SimplePoly{T}
    coeffs::Vector{T}
end

Base.:*(p::SimplePoly, c) = SimplePoly(p.coeffs * c)
Base.:*(c, p::SimplePoly) = p * c

function Base.:+(p::SimplePoly{S}, q::SimplePoly{T}) where {S, T}
    n, m = length(p.coeffs), length(q.coeffs)
    ext1, ext2 = max(0, m - n), max(0, n - m)
    c1 = [p.coeffs ; zeros(S, ext1)]
    c2 = [q.coeffs ; zeros(T, ext2)]
    return SimplePoly(c1 + c2)
end

Base.:-(p::SimplePoly) = -1 * p
Base.:-(p::SimplePoly, q::SimplePoly) = p + (-q)

function Base.:*(p::SimplePoly{S}, q::SimplePoly{T}) where {S, T}
    n, m = length(p.coeffs) - 1, length(q.coeffs) - 1
    c = zeros(promote_type(S, T), m + n + 1)
    for i in 0:n, j in 0:m
        c[i + j + 1] += p.coeffs[i + 1] * q.coeffs[j + 1]
    end
    return SimplePoly(c)
end

function E₁_cfpoly_approx(n::Integer, ::Type{T}=BigInt) where {T<:Real}
    q = SimplePoly(T[1])
    p = x = SimplePoly(T[0,1])
    for i = n:-1:1
        p, q = x*p+(1+i)*q, p # from cf = x + (1+i)/cf = x + (1+i)*q/p
        p, q = p + i*q, p     # from cf = 1 + i/cf = 1 + i*q/p
    end
    # do final 1/(x + inv(cf)) = 1/(x + q/p) = p/(x*p + q)
    return p, x*p + q
end

macro E₁_cf64(x, n::Integer)
    # consider using BigFloat?
    p, q = E₁_cfpoly_approx(n, Float64)
    xesc = esc(x)

    num_expr =  :(@evalpoly $xesc)
    append!(num_expr.args, Float64.(p.coeffs))
    den_expr = :(@evalpoly $xesc)
    append!(den_expr.args, Float64.(q.coeffs))
    :( exp(-$xesc) * $num_expr / $den_expr )
end

function E₁_taylor_coefficients(::Type{T}, n::Integer) where {T<:Number}
    n < 0 && throw(ArgumentError("$n ≥ 0 is required"))
    n == 0 && return T[]
    n == 1 && return T[-eulergamma]
    # iteratively compute the terms in the series, starting with k=1
    term::T = 1
    terms = T[-eulergamma, term]
    for k=2:n
        term = -term * (k-1) / (k * k)
        push!(terms, term)
    end
    return terms
end

# inline the Taylor expansion for a given order n, in double precision
macro E₁_taylor64(z, n::Integer)
    c = E₁_taylor_coefficients(Float64, n)
    zesc = esc(z)
    taylor = :(@evalpoly $zesc)
    append!(taylor.args, c)
    :( $taylor - log($zesc) )
end

# adapted from Steven G Johnson's initial implementation: issue #19
function expint_opt(x::Float64)
    x < 0 && throw(DomainError(x, "negative argument, convert to complex first"))
    x == 0 && return Inf
    if x > 2.15
        # minimax rational approximations to E_1(x)/exp(-x):
        x < 4.0     && return exp(-x) *
            @evalpoly(x, 3.600530862438501481559423277418128014798, 28.73031134165011013783185685393062481126, 46.04314409968065653003548224846863877481, 21.47189493062368074985000918414086604187, 2.719957622921613321844755385973197500235, 1.508750885580864752293599048121678438568e-6) /
            @evalpoly(x, 1.0, 18.06743589038646654075831055159865459831, 61.19456872238615922515377354442679999566, 64.81772518730116701207299231777089576859, 24.19034591054828198408354214931112970741, 2.720026796991567940556850921390829046015)
        x < 10.0    && return exp(-x) *
            @evalpoly(x, 3.149019890512432117647119992448352099575, 14.77395058090815888166486507990452627136, 14.78214309058953358717796744960600201013, 4.559401130686434886620102186841739864936, 0.4027858394909585103775445204576054721422, 2.302781920509468929446800686773538387432e-9) /
            @evalpoly(x, 1.0, 11.65960373479520446458792926669115987821, 26.20023773503894444535165299118172674849, 18.93899893550582921168134979000319186841, 4.962178168140565906794561070524079194193, 0.4027860481050182948737116109665534358805)
        x < 20.0    && return exp(-x) *
            @evalpoly(x, 2.564801308922428705318296668924369454617, 5.482252510134574167659359513298970499768, 2.379528224853089764405551768869103662657, 0.2523431276282591480166881146593592650031, 1.444719769329975045925053905197199934930e-9, -8.977332061106791470409502623202677045468e-12) /
            @evalpoly(x, 1.0, 6.421214405318108272004472721910023284626, 7.609584052290707052877352911548283916247, 2.631866613851763364839413823973711355890, 0.2523432345539146248733539983749722854603)
        x < 200.0 && return @E₁_cf64(x, 8) # fallback continued fraction
        return x < 740.0 ? @E₁_cf64(x, 4) : 0.0 # underflow
    else
        # crossover point to taylor should be tuned more
        return x ≤ 0.6 ? (x ≤ 0.053 ? (x ≤ 4.4e-3 ? @E₁_taylor64(x,4) :
                                                       @E₁_taylor64(x,8)) :
                                       @E₁_taylor64(x,15)) :
                          @E₁_taylor64(x,37)
    end
end

function expint_opt(z::Complex{Float64})
    x² = real(z)^2
    y² = imag(z)^2
    if x² + 0.233*y² ≥ 7.84 # use cf expansion, ≤ 30 terms
        if (x² ≥ 546121) & (real(z) > 0) # underflow
            return zero(z)
        elseif x² + 0.401*y² ≥ 58.0 # ≤ 15 terms
            if x² + 0.649*y² ≥ 540.0 # ≤ 8 terms
                x² + y² ≥ 4e4 && return @E₁_cf64(z, 4)
                return @E₁_cf64(z, 8)
            end
            return @E₁_cf64(z, 15)
        end
        return @E₁_cf64(z, 30)
    else # use Taylor expansion, ≤ 37 terms
        r² = x² + y²
        return r² ≤ 0.36 ? (r² ≤ 2.8e-3 ? (r² ≤ 2e-7 ? @E₁_taylor64(z,4) :
                                                       @E₁_taylor64(z,8)) :
                                         @E₁_taylor64(z,15)) :
                          @E₁_taylor64(z,37)
    end
end

function expint(z::Complex{Float64})
    if real(z) < 0
        return expint(1, z)
    else
        return expint_opt(z)
    end
end
expint(x::Float64) = expint_opt(x)

function expint(x::BigFloat)
    iszero(x) && return Inf
    signbit(x) && throw(DomainError(x, "negative argument, convert to complex first"))
    return -expinti(-x)
end

expint(z::Union{T,Complex{T},Rational{T},Complex{Rational{T}}}) where {T<:Integer} = expint(float(z))
expint(x::Number) = expint(1, x)
expint(z::Float32) = Float32(expint(Float64(z)))
expint(z::ComplexF32) = ComplexF32(expint(ComplexF64(z)))
expint(z::Float16) = Float16(expint(Float64(z)))
expint(z::ComplexF16) = ComplexF16(expint(ComplexF64(z)))

# Continued fraction for En(ν, z) that doesn't use a term with
# the gamma function: https://functions.wolfram.com/GammaBetaErf/ExpIntegralE/10/0001/
function En_cf_nogamma(ν::Number, z::Number, n::Int=1000)
    B = float(z + ν)
    Bprev::typeof(B) = z
    A::typeof(B) = 1
    Aprev::typeof(B) = 1
    ϵ = 10*eps(real(B))
    scale = sqrt(floatmax(real(A)))

    # two recurrence steps / loop
    iters = 0
    for i = 2:n
        iters += 1

        A′ = A
        A = z*A + (i-1) * Aprev
        Aprev = A′
        B′ = B
        B = z*B + (i-1) * Bprev
        Bprev = B′

        A′ = A
        A = A + (ν+i-1) * Aprev
        Aprev = A′
        B′ = B
        B = B + (ν+i-1) * Bprev
        Bprev = B′

        conv = abs(Aprev*B - A*Bprev) < ϵ*abs(B*Bprev)
        conv && i > 4 && break

        # rescale
        if fastabs(A) > scale
            A     /= scale
            Aprev /= scale
            B     /= scale
            Bprev /= scale
        end
    end

    exppart = exp(-z)
    if isinf(exppart)
        return exp(-z + log(A) - log(B)), iters
    else
        cfpart = A/B
        return cfpart * exppart, iters
    end
end

# Calculate Γ(1 - ν) * z^(ν-1) safely
En_safe_gamma_term(ν::Number, z::Number) = exp((ν - 1)*log(z) + loggamma(1 - oftype(z, ν)))

# continued fraction for En(ν, z) that uses the gamma function:
# https://functions.wolfram.com/GammaBetaErf/ExpIntegralE/10/0005/
# returns the two terms from the above equation separately
function En_cf_gamma(ν::Number, z::Number, n::Int=1000)
    A = float(1 - ν)
    B::typeof(A) = 1
    Bprev::typeof(A) = 0
    Aprev::typeof(A) = 1
    ϵ = 10*eps(real(B))
    scale = sqrt(floatmax(real(A)))

    iters = 0
    j = 1
    for i = 2:n
        iters += 1

        A′ = A
        term = iseven(i) ? -(i÷2 - 1 - ν)*z : z*(i÷2)
        A = (i - ν)*A + term * Aprev
        Aprev = A′
        B′ = B
        B = (i - ν)*B + term * Bprev
        Bprev = B′

        conv = abs(Aprev*B - A*Bprev) < ϵ*abs(B*Bprev)
        conv && break

        if max(abs(real(A)), abs(imag(A))) > scale
            A     /= scale
            Aprev /= scale
            B     /= scale
            Bprev /= scale
        end
    end

    gammapart = En_safe_gamma_term(ν, z)
    cfpart = exp(-z)
    if isinf(cfpart)
        factor = sign(real(cfpart)) + sign(imag(cfpart))*im
        cfpart = exp(-z + log(B) - log(A))
    else
        cfpart *= B/A
    end
    return gammapart, -cfpart, iters
end

# picks between continued fraction representations in
# En_cf_nogamma and En_cf_gamma
# returns (evaluated result, # iterations used, whether En_cf_gamma was chosen)
function En_cf(ν::Number, z::Number, niter::Int=1000)
    gammapart, cfpart, iters = En_cf_gamma(ν, z, niter)
    gammaabs, cfabs = abs(gammapart), abs(cfpart)
    if gammaabs != Inf && gammaabs > 1.0 && gammaabs > cfabs
        # significant gamma part, use this
        return gammapart + cfpart, iters, true
    else
        return En_cf_nogamma(ν, z, niter)..., false
    end
end

# Compute expint(ν, z₀+Δ) given start = expint(ν, z₀), as described by [Amos 1980].
# This is used to incrementally approach the negative real axis.
function En_taylor(ν::Number, start::Number, z₀::Number, Δ::Number)
    a = exp(z₀) * start
    k, iters = 0, 0
    asum = a
    Δ_prod_fact = -Δ
    ϵ = 10*eps(real(asum))

    for k = 0:100
        a_pre = Δ_prod_fact + a*Δ*(ν - k - 1)/(k + 1)
        a = a_pre / z₀
        asum_prev = asum
        asum += a

        if abs(asum_prev - asum) < ϵ
            break
        end

        Δ_prod_fact *= -Δ / (k + 2)
    end

    res = exp(-z₀) * asum
    return res
end

# series about origin, general ν
# https://functions.wolfram.com/GammaBetaErf/ExpIntegralE/06/01/04/01/01/0003/
function En_expand_origin_general(ν::Number, z::Number)
    gammaterm = En_safe_gamma_term(ν, z)
    frac = one(real(z))
    sumterm = frac / (1 - ν)
    k, maxiter = 1, 100
    ϵ = 10*eps(real(sumterm))
    while k < maxiter
        frac *= -z / k
        prev = sumterm
        sumterm += frac / (k + 1 - ν)
        if abs(sumterm - prev) < ϵ
            break
        end
        k += 1
    end
    return gammaterm - sumterm
end

# series about the origin, special case for integer n > 0
# https://functions.wolfram.com/GammaBetaErf/ExpIntegralE/06/01/04/01/02/0005/
function En_expand_origin_posint(n::Integer, z::Number)
    gammaterm = 1 # (-z)^(n-1) / (n-1)!
    for i = 1:n-1
        gammaterm *= -z / i
    end

    frac = one(real(z))
    gammaterm *= digamma(oftype(frac,n)) - log(z)
    sumterm = n == 1 ? zero(frac) : frac / (1 - n)
    k, maxiter = 1, 100
    ϵ = 10*eps(real(sumterm))
    while k < maxiter
        frac *= -z / k
        # skip term with zero denominator
        if k != n-1
            prev = sumterm
            sumterm += frac / (k + 1 - n)
            if abs(sumterm - prev) < ϵ
                break
            end
        end
        k += 1
    end
    return gammaterm - sumterm
end

function En_expand_origin(ν::Number, z::Number)
    if isinteger(ν) && real(ν) > 0
        return En_expand_origin_posint(Integer(ν), z)
    else
        return En_expand_origin_general(ν, z)
    end
end

# can find imaginary part of E_ν(x) for x on negative real axis analytically
# https://functions.wolfram.com/GammaBetaErf/ExpIntegralE/04/05/01/0003/
function En_imagbranchcut(ν::Number, z::Number)
    a = real(z)
    e1 = exp(π*imag(ν))
    e2 = Complex(cospi(real(ν)), -sinpi(real(ν)))
    impart = π * im * e1 * e2 * exp((ν-1)*log(complex(a)) - loggamma(ν))
    impart *= signbit(imag(z)) ? -1 : 1
    return imag(impart) * im # get rid of any real error
end

"""
    expint(z)
    expint(ν, z)

Computes the exponential integral ``\\operatorname{E}_\\nu(z) = \\int_0^\\infty \\frac{e^{-zt}}{t^\\nu} dt``.
If ``\\nu`` is not specified, ``\\nu=1`` is used. Arbitrary complex ``\\nu`` and ``z`` are supported.

External links: [DLMF](https://dlmf.nist.gov/8.19), [Wikipedia](https://en.wikipedia.org/wiki/Exponential_integral)
"""
function expint(ν::Number, z::Number, niter::Int=1000)
    if abs(ν) > 50 && !(isreal(ν) && real(ν) > 0)
        throw(ArgumentError("Unsupported order |ν| > 50 off the positive real axis"))
    end

    z, = promote(float(z), ν)
    if isnan(ν) || isnan(z)
        return oftype(z, NaN) * z
    end

    if z isa Real && (isinteger(ν) ? (z < 0 && ν > 0) : (z < 0 || ν < 0))
        throw(DomainError(z, "En will only return a complex result if called with a complex argument"))
    end

    if z == 0
        return oftype(z, real(ν) > 0 ? 1/(ν-1) : Inf)
    end

    if ν == 0
        return exp(-z) / z
    elseif ν == 1 && real(z) > 0 && z isa Union{Float64, Complex{Float64}}
        return expint_opt(z)
    end
    # asymptotic test for underflow when Re z → ∞
    # https://functions.wolfram.com/GammaBetaErf/ExpIntegralE/06/02/0003/
    if real(z) > -log(nextfloat(zero(real(z))))+1 # exp(-z) is zero
        return zero(z)
    end

    if abs2(z) < 9
        # use Taylor series about the origin for small z
        return En_expand_origin(ν, z)
    end

    if z isa Real
        return first(z > 0 ? En_cf(ν, z, niter) : En_cf_nogamma(ν, z, niter))
    else
        # Procedure for z near the negative real axis based on
        # (without looking at the accompanying source code):
        #   Amos, D. E. (1990). Computation of exponential integrals
        #   of a complex argument. ACM Transactions on Mathematical Software,
        #   16(2), 169–177. https://doi.org/10.1145/78928.78933
        doconj = imag(z) < 0
        rez, imz = real(z), abs(imag(z))
        z = doconj ? conj(z) : z
        ν = doconj ? conj(ν) : ν

        quick_niter, nmax = 50, 45
        # start with small imaginary part if exactly on negative real axis
        imstart = (imz == 0) ? abs(z)*sqrt(eps(typeof(real(z)))) : imz
        z₀ = rez + imstart*im
        E_start, i, _ = En_cf(ν, z₀, quick_niter)
        isnan(E_start) && return E_start
        if imz > 0 && i < nmax
            # didn't need to take any steps
            return doconj ? conj(E_start) : E_start
        end
        while i > nmax
            # double imaginary part until in region with fast convergence
            imstart *= 2
            z₀ = rez + imstart*im
            E_start, i, _ = En_cf(ν, z₀, quick_niter)
        end

        # nsteps chosen so |Δ| ≤ 0.5
        nsteps = ceil(2 * (imstart - imz))
        Δ = (imz - imstart)*im / nsteps

        for j = 1:nsteps
            # take Δ sized steps towards the desired z
            E_start = En_taylor(ν, E_start, z₀, Δ)
            z₀ += Δ
        end

        # more exact imaginary part available for non-integer ν
        if imz == 0
            E_start = real(E_start) + En_imagbranchcut(ν, z)
        end

        return doconj ? conj(E_start) : E_start
    end
    throw("unreachable")
end

##############################################################################
# expinti function Ei

"""
    expinti(x::Real)

Computes the exponential integral function ``\\operatorname{Ei}(x) = \\int_{-\\infty}^x \\frac{e^t}{t} dt``,
which is equivalent to ``-\\Re[\\operatorname{E}_1(-x)]`` where ``\\operatorname{E}_1`` is the `expint` function.
"""
expinti(x::Real) = x ≤ 0 ? -expint(-x) : -real(expint(complex(-x)))

# inline the Taylor expansion of Ei for a given order n, in double precision
macro Ei_taylor64(z, n::Integer)
    c = .- E₁_taylor_coefficients(Float64, n) .* (-1).^(0:n)
    zesc = esc(z)
    taylor = :(@evalpoly $zesc)
    append!(taylor.args, c)
    :( $taylor + log($zesc) )
end

# optimized double-precision version
function expinti(x::Float64)
    x ≤ 0 && return -expint(-x)

    if x > 2.15
        # minimax rational approximants:
        x < 4 && return @evalpoly(x,-2.43791466332154621,3.09402100064798205,9.35202477109609955,0.152659977028953397,0.0157273683896079142,0.0345566671015011426,-0.000421531433157416203) /
                        @evalpoly(x,1.0,4.28055563991564399,0.537599625698465573,-0.511064414527643313,0.0867748262262250088,-0.00623913330836521800,0.000172066498182538260)
        x < 10 && return exp(x) *
            @evalpoly(x,-1.58447018083420958,4.71806833998906997,-0.587691572500210206,0.125012472861504555,-0.00178055441724967428,0.000633648975971195928,0.0000147213934578379204,2.12391754244415544e-6) /
            @evalpoly(x,1.0,1.93297600031287800,0.660790440069106542,0.198322636197663277,0.0272447293513279631,0.00399501571688512611,0.000362510989191199243,0.0000182930089855534336,2.06800780072894204e-6)
        x < 20 && return exp(x) *
            @evalpoly(x,-1.77183291754640123,0.795659966861260409,-0.221223333413388642,0.0328877243243796815,-0.00331846947191676458,0.000180945604349930285,-5.97641401680304362e-6,2.42151808626299747e-11) /
            @evalpoly(x,1.0,-2.10926998628216150,0.933357955421497965,-0.245433884954174394,0.0356954809772243699,-0.00348034743685382360,0.000186615220328647350,-5.97232581353392099e-6)

        x > 710 && return Inf # overflow
        x⁻¹ = inv(x)

        # minimax rational approximant in x⁻¹ for x ∈ [20,200]
        x < 200 && return exp(x) *
            @evalpoly(x⁻¹, -5.29842699621003563e-14, +1.00000000004732488, -60.4361334939888359, +1327.83891720487710, -6810.63668974273961, -177755.383525765400,+3.00773484037048848e6, -1.53642380695372707e7, +2.08174653368702692e7) /
            @evalpoly(x⁻¹, 1.0, -61.4361334756161381, +1387.27504658395142, -8081.03888544858393, -172104.333927401741, +3.18903576285551101e6, -1.81873890267574206e7, +3.37312131843327704e7, -1.22198734384213631e7)

        # asymptotic series eˣ/x ∑k!/xᵏ for x ≥ 200:
        return exp(x)*x⁻¹ * @evalpoly(x⁻¹, 1,1,2,6,24,120,720,5040)
    end

    root = 0.37250741078136663446 # OEIS A091723
    dx = x - root
    if abs(dx) < 0.03
        # taylor series around real root of Ei
        return dx * @evalpoly(dx, 3.896215733907167310, -3.281607866398561671, 6.52237614543892570, -12.96969738353651704, 27.88629796294204998, -62.3788015289154187, 143.5349488096750988, -337.155827178746892, 804.531839982138251, -1943.79664572349884, 4743.76565040243084, -11673.46399116716364, 28926.9553054354509)
    else
        # TODO: crossover points and degrees could be tuned more
        return x ≤ 0.6 ? (x ≤ 0.053 ? (x ≤ 4.4e-3 ? @Ei_taylor64(x,4) :
                                                    @Ei_taylor64(x,8)) :
                                       @Ei_taylor64(x,15)) :
                          @Ei_taylor64(x,37)
    end
end

expinti(z::Union{T,Rational{T}}) where {T<:Integer} = expinti(float(z))
expinti(z::Float32) = Float32(expinti(Float64(z)))
expinti(z::Float16) = Float16(expinti(Float64(z)))

function expinti(x::BigFloat)
    z = BigFloat()
    ccall((:mpfr_eint, :libmpfr), Int32, (Ref{BigFloat}, Ref{BigFloat}, Base.MPFR.MPFRRoundingMode), z, x, Base.MPFR.ROUNDING_MODE[])
    return z
end


# Cartesian product. See https://en.wikipedia.org/wiki/Cartesian_product

# nextTuple is a helper function which extracts all combinations of arrays by
# using the length of each array Yn and counting up from 0 at each index. For
# example, if we had an array X of lengths [2, 3, 3] nextTuple will adjust indices
# as follows: [0, 0, 0] -> [1, 0, 0] -> [0, 1, 0] -> [1, 1, 0] -> [0, 2, 0] ... [1, 2, 2]

function nextTuple!(indices::Array{Int,1}, sizes::Array{Int,1})::Bool
    for i in length(indices):-1:1
        if indices[i] < sizes[i]
            indices[i] += 1
            return true
        else
            indices[i] = 1
        end
    end
    false
end

# N fold Cartesian product
function cartesianProduct(aa::Array{Array{T, 1}, 1})::Array{Array{T, 1}, 1} where {T}
    result::Array{Array{T, 1}, 1} = []
    indices = ones(Int, length(aa))
    sizes = map(a -> length(a), aa)
    hasMore = length(indices) > 0
    while hasMore
        elt = [aa[i][indices[i]] for i in 1:length(indices)]
        push!(result, elt)
        hasMore = nextTuple!(indices, sizes)
    end

  return result
end


# Trying out derivatives of cel_bulirsch with respect to
# k_c, p, a, b:
include("cel_bulirsch.jl")

using ForwardDiff
using DiffRules

dcel_dn = m -> ForwardDiff.derivative(cel_bulirsch,m)

function cel_bad_grad(r::T,b::T) where {T <: Real}
x=[r,b]
function diff_cel(x::Array{T,1}) where {T <: Real}
r,b=x
onembpr2 = (1-b-r)*(1+b+r); onembmr2=(r-b+1)*(b-r+1); fourbr = 4b*r
k2 = onembpr2/fourbr+1
k2c = -onembpr2/fourbr; kc = sqrt(b+r-1)*sqrt(b+r+1)/sqrt(4*b*r)
#p=(b-r)^2*k2c; a=0.0; b_cel=3*k2c*(b-r)*(b+r)
p=(b-r)^2*k2c; a=0.0; b_cel=3*(b+r)*(b-r)*k2c
return cel_bulirsch(k2,kc,p,zero(b),b_cel)
end
out = DiffResults.GradientResult(x)
# Compute the Jacobian (and value):
out = ForwardDiff.gradient!(out,diff_cel,x)
# Place the value in the cel_b vector:
cel_b = DiffResults.value(out)
# And, place the Jacobian in an array:
cel_gradient= DiffResults.gradient(out)
return cel_b,cel_gradient
end

function cel_grad(kc::T,p::T,a::T,b::T) where {T <: Real}
  # Computes the derivative of cel(k_c,p,a,b) with respect to (k_c,p,a,b)
  # Create a vector for use with ForwardDiff
  x=[kc,p,a,b]
  # Now, define a wrapper of cel_bulirsch for use with ForwardDiff:
  function diff_cel(x::Array{T,1}) where {T <: Real}
  # x should be a four-element vector with values [kc,p,a,b]
  kc,p,a,b = x
  return cel_bulirsch(1.0-kc*kc,kc,p,a,b)
  end

  # Set up a type to store s_n and it's Jacobian with respect to x:
  out = DiffResults.GradientResult(x)
  # Compute the Jacobian (and value):
  out = ForwardDiff.gradient!(out,diff_cel,x)
  # Place the value in the cel_b vector:
  cel_b = DiffResults.value(out)
  # And, place the Jacobian in an array:
  cel_gradient= DiffResults.gradient(out)
return cel_b,cel_gradient
end

function cel_grad_anal(kc::T,p::T,a::T,b::T) where {T <: Real}
# Now, compute the gradients analytically:
kc2 = kc*kc
dcel_dkc = -kc/(p-kc2)*(cel_bulirsch(1-kc*kc,kc,kc2,a,b)-cel_b)
#dcel_dp = (2*p*b-p*a-b)/(2*p*(1-p))*cel_bulirsch(1-kc*kc,kc,p,zero(p),one(p))+
#  (b-a*p)/(2*p*(1-p)*(p-kc2))*cel_bulirsch(1-kc*kc,kc,one(p),one(p),kc2) -
#  (b-a*p)/(2*(1-p)*(p-kc2))*cel_bulirsch(1-kc*kc,kc,p,one(p),one(p))
dcel_dp = ((kc2*(b+a*p-2*b*p)+p*(3*b*p-a*p^2-2*b))*cel_bulirsch(1-kc*kc,kc,p,zero(p),one(p))+
  (b-a*p)*cel_bulirsch(1-kc*kc,kc,one(p),1-p,kc2-p))/(2*p*(1-p)*(p-kc2))
dcel_da = cel_bulirsch(1-kc*kc,kc,p,one(p),zero(p))
dcel_db = cel_bulirsch(1-kc*kc,kc,p,zero(p),one(p))
return [dcel_dkc,dcel_dp,dcel_da,dcel_db]
end

function cel_grad_num(kc::T,p::T,a::T,b::T) where {T <: Real}
# Now, compute the gradients numerically:
dq = 1e-24
dcel_dkc = convert(Float64,(cel_bulirsch(big(1)-(big(kc)+big(dq))^2,big(kc)+big(dq),big(p),big(a),big(b))-
  cel_bulirsch(big(1)-(big(kc)-big(dq))^2,big(kc)-big(dq),big(p),big(a),big(b)))/(2*big(dq)))
dcel_dp = convert(Float64,(cel_bulirsch(big(1)-big(kc)^2,big(kc),big(p)+big(dq),big(a),big(b))-
  cel_bulirsch(big(1)-big(kc)^2,big(kc),big(p)-big(dq),big(a),big(b)))/(2*big(dq)))
dcel_da = convert(Float64,(cel_bulirsch(big(1)-big(kc)^2,big(kc),big(p),big(a)+big(dq),big(b))-
  cel_bulirsch(big(1)-big(kc)^2,big(kc),big(p),big(a)-big(dq),big(b)))/(2*big(dq)))
dcel_db = convert(Float64,(cel_bulirsch(big(1)-big(kc)^2,big(kc),big(p),big(a),big(b)+big(dq))-
  cel_bulirsch(big(1)-big(kc)^2,big(kc),big(p),big(a),big(b)-big(dq)))/(2*big(dq)))
return [dcel_dkc,dcel_dp,dcel_da,dcel_db]
end

r = 100.0; b = 100.0-1e-12
onembpr2 = (1-b-r)*(1+b+r); onembmr2=(r-b+1)*(b-r+1); fourbr = 4b*r
k2 = onembpr2/fourbr+1
k2c = -onembpr2/fourbr; kc = sqrt(k2c)
p=(b-r)^2*k2c; a=0.0; b_cel=3*k2c*(b-r)*(b+r)

#kc = rand(); p = rand(); a=rand(); b= rand()
cel_b,cel_gradient= cel_grad(kc,p,a,b_cel)
dcel_anal = cel_grad_anal(kc,p,a,b_cel)
dcel_num  = cel_grad_num(kc,p,a,b_cel)
println("d cel/d kc: ",dcel_anal[1]," ",cel_gradient[1]," ",dcel_num[1]," diff 1-2: ",dcel_anal[1]-cel_gradient[1]," ",dcel_num[1]-cel_gradient[1])
println("d cel/d p: ",dcel_anal[2]," ",cel_gradient[2]," ",dcel_num[2]," diff 1-2: ",dcel_anal[2]-cel_gradient[2]," ",dcel_num[2]-cel_gradient[2])
println("d cel/d a: ",dcel_anal[3]," ",cel_gradient[3]," ",dcel_num[3]," diff 1-2: ",dcel_anal[3]-cel_gradient[3]," ",dcel_num[3]-cel_gradient[3])
println("d cel/d b: ",dcel_anal[4]," ",cel_gradient[4]," ",dcel_num[4]," diff 1-2: ",dcel_anal[4]-cel_gradient[4]," ",dcel_num[4]-cel_gradient[4])

function cel_bad_anal(r::T,b::T) where {T <: Real}
onembpr2 = (1-b-r)*(1+b+r); onembmr2=(r-b+1)*(b-r+1); fourbr = 4b*r
k2 = onembpr2/fourbr+1
k2c = -onembpr2/fourbr; kc = sqrt(k2c)
p=(b-r)^2*k2c; a=zero(r); b_cel=3*k2c*(b-r)*(b+r)
dcel_anal = cel_grad_anal(kc,p,a,b_cel)
dceldr = (dcel_anal[1]*(1-(b-r)*(b+r))/(2*kc)+dcel_anal[2]*(1-3r^2-b^2)*(b-r)*(b+r)-dcel_anal[4]*3*(3*r^4+b^4-b^2-r^2+4*b*r^3))/(4*b*r^2)
dceldb = (dcel_anal[1]*(1+(b-r)*(b+r))/(2*kc)+dcel_anal[2]*(r^2+3b^2-1)*(b-r)*(b+r)+dcel_anal[4]*3*(3*b^4+r^4-b^2-r^2+4*b^3*r))/(4*b^2*r)
return [dceldr,dceldb]
end

dcel_bad_anal = cel_bad_anal(big(r),big(b))
println("dcel/dr: ",dcel_bad_anal[1]," dcel/db: ",dcel_bad_anal[2])
dcel_bad_anal = cel_bad_anal(r,b)
println("dcel/dr: ",dcel_bad_anal[1]," dcel/db: ",dcel_bad_anal[2])
cel_bad,cel_bad_gradient=cel_bad_grad(big(r),big(b))
println("dcel/dr: ",cel_bad_gradient[1]," dcel/db: ",cel_bad_gradient[2])
cel_bad,cel_bad_gradient=cel_bad_grad(r,b)
println("dcel/dr: ",cel_bad_gradient[1]," dcel/db: ",cel_bad_gradient[2])


### A Pluto.jl notebook ###
# v0.14.4

using Markdown
using InteractiveUtils

# ╔═╡ d01a9b4f-8b55-4607-abb6-717d227fcd48
begin
	using PlutoUI, LinearAlgebra
	PlutoUI.TableOfContents(aside=true)
end

# ╔═╡ 479a40d9-b81e-442b-9962-f972b110a4dd
# Pkg.checkout("SpecialMatrices")
using SpecialMatrices

# ╔═╡ 574e86bb-159c-4141-8d8a-21bdcc9b5304
# Plot the eigenvalues (singular values) and left singular vectors
using Plots

# ╔═╡ 5eb73af5-f78a-4811-83a5-ac39063a4516
# pkg> add Arrowhead#master
using Arrowhead

# ╔═╡ 5d95dc2c-bf94-4b13-b9d5-b7b261e86cf6
md"""
# Algorithms for Structured Matrices

For matrices with some special structure, it is possible to derive versions of algorithms which are faster and/or more accurate than the standard algorithms.

__Prerequisites__

The reader should be familiar with concepts of eigenvalues and eigen vectors, singular values and singular vectors, related perturbation theory, and algorithms.

__Competences__

The reader should be able to recognise matrices which have rank-revealing decomposition and apply adequate algorithms, and to apply forward stable algorithms to arrowhead and diagonal-plus-rank-one matrices.
"""

# ╔═╡ e3e43840-d0a3-4cde-9b1e-5785759912b2
md"""
# Rank revealing decompositions

For more details, see [Z. Drmač, Computing Eigenvalues and Singular Values to High Relative Accuracy](https://www.routledge.com/Handbook-of-Linear-Algebra/Hogben/p/book/9781138199897) and [J. Demmel et al, Computing the singular value decomposition with high relative accuracy](http://www.sciencedirect.com/science/article/pii/S0024379599001342), and the references therein.

Let $A\in\mathbb{R}^{m\times n}$ with $\mathop{\mathrm{rank}}(A)=n$ (therefore, $m\geq n$) and $A=U\Sigma V^T$ its thin SVD.

## Definitions

Let $A\in\mathbb{R}^{m\times n}$.

The singular values of $A$ are (__perfectly__) __well determined to high relative accuracy__ if changing any entry $A_{kl}$ to $\theta A_{kl}$, $\theta \neq 0$, causes perturbations in singular values bounded by

$$
\min\{|\theta|,1/|\theta|\}\sigma_j \leq\tilde \sigma_j \leq
\max\{|\theta|,1/|\theta|\}\sigma_j,\quad  \forall j.$$

The __sparsity pattern__ of $A$, $Struct(A)$, is the set of indices for which $A_{kl}$ is permitted to be non-zero.

The __bipartite graph__ of the sparsity pattern $S$, $\mathcal{G}(S)$, is the graph with vertices partitioned into row vertices $r_1,\ldots,r_m$ and column vertices $c_1,\ldots,c_n$, where $r_k$ and $c_l$ are connected if and only if $(k,l)\in S$.

If $\mathcal{G}(S)$ is acyclic, matrices with sparsity pattern $S$ are __biacyclic__.

A decomposition $A=XDY^T$ with diagonal matrix $D$ is called a __rank revealing decomposition__ (RRD) if $X$ and $Y$ are full-column rank well-conditioned matrices.

__Hilbert matrix__ is a square matrix $H$ with elements $H_{ij}=\displaystyle\frac{1}{i+j-1}$.

__Hankel matrix__ is a square matrix with constant elements along skew-diagonals.

__Cauchy matrix__ is an $m\times n$ matrix $C$ with elements $C_{ij}=\displaystyle\frac{1}{x_i+y_j}$ with $x_i+y_j\neq 0$ for all $i,j$.
"""

# ╔═╡ 03f797ac-8764-4688-9e7e-e144cafb3b4c
md"""
## Facts

1. The singular values of $A$ are perfectly well determined to high relative accuracy if and only if the bipartite graph $\mathcal{G}(S)$ is acyclic (forest of trees). Examples are bidiagonal and arrowhead matrices. Sparsity pattern $S$ of acyclic bipartite graph allows at most $m+n-1$ nonzero entries. A bisection algorithm computes all singular values of biacyclic matrices to high relative accuracy.

2. An RRD of $A$ can be given or computed to high accuracy by some method. Typical methods are Gaussian elimination with complete pivoting or QR factorization with complete pivoting.

3. Let $\hat X \hat D \hat Y^T$ be the computed RRD of $A$ satisfying $|D_{jj}-\hat D_{jj}| \leq O(\varepsilon)|D_{jj}|$, $\| X-\hat X\|\leq O(\varepsilon) \|X\|$, and $\| Y-\hat Y\|\leq O(\varepsilon) \|Y\|$. The following algorithm computes the EVD of $A$ with high relative accuracy:

    1. Perform QR factorization with pivoting to get $\hat X\hat D=QRP$, where $P$ is a permutation matrix. Thus $A=QRP\hat Y^T$.
    2. Multiply $W=RP\hat Y^T$ (_NOT_ Strassen's multiplication). Thus $A=QW$ and $W$ is well-scaled from the left.
    3. Compute the SVD of $W^T=V\Sigma^T \bar U^T$ using one-sided Jacobi method. Thus $A=Q\bar U \Sigma V^T$.
    4. Multiply $U=Q\bar U$. Thus $A=U\Sigma V^T$ is the computed SVD of $A$.

4. Let $R=D'R'$, where $D'$ is such that the _rows_ of $R'$ have unit norms.  Then the following error bounds hold:

$$
\frac{|\sigma_j-\tilde\sigma_j|}{\sigma_j}\leq O(\varepsilon \kappa(R')\cdot \max\{\kappa(X),\kappa(Y)\})\leq
O(\varepsilon n^{3/2}\kappa(X)\cdot \max\{\kappa(X),\kappa(Y)\}).$$

5. Hilbert matrix is Hankel matrix and Cauchy matrix, it is symmetric positive definite and _very_ ill-conditioned.

6. Every sumbatrix of a Cauchy matrix is itself a Cauchy matrix.

7. Determinant of a square Cauchy matrix is

$$
\det(C)=\frac{\prod_{1\leq i<j\leq n}(x_j-x_i)(y_j-y_i)}
{\prod_{1\leq i,j\leq n} (x_i+y_j)}.$$

It is computed with elementwise high relative accuracy.

8. Let $A$ be square and nonsingular and let $A=LDR$ be its decomposition with diagonal $D$, lower unit-triangular $L$, and upper unit-triangular $R$. The closed formulas using quotients of minors are (see [A. S. Householder, The Theory of Matrices in Numerical Analysis](https://books.google.hr/books?id=hCre109IpRcC&printsec=frontcover&hl=hr&source=gbs_ge_summary_r&cad=0#v=onepage&q&f=false)):

$$
\begin{aligned}
D_{11}&=A_{11}, \\
D_{jj}&=\frac{\det(A_{1:j,1:j})}{\det(A_{1:j-1,1:j-1})}, \quad j=2,\ldots,n, \\
L_{jj}&=1, \\
L_{ij}&=\frac{\det(A_{[1,2,\ldots,j-1,i],[1:j]}\, )}
{\det(A_{1:j,1:j})}, \quad j < i, \\
R_{jj}&=1, \\
R_{ji}&=\frac{\det(A_{[1,2,\ldots,j],[1,2, \ldots,j-1,i]}\, )}
{\det(A_{1:j,1:j})}, \quad i > j,
\end{aligned}$$

"""

# ╔═╡ f280b119-76a7-4ee8-b6fd-608d977af0c6
md"""
## Examples

### Positive definite matrix

Let $A=DA_S D$ be strongly scaled symmetric positive definite matrix. Then Cholesky factorization with complete (diagonal) pivoting is an RRD. Consider the following three step algorithm:

1. Compute $P^T A P=LL^T$ (_Cholesky factorization with complete pivoting_).
2. Compute the $L=\bar U\Sigma V^T$ (_one-sided Jacobi, V is not needed_).
3. Set $\Lambda=\Sigma^2$ and $U=P\bar U$. Thus $A=U\Lambda U^T$ is an EVD of $A$.

The Cholesky factorization with pivoting can be implemented very fast with block algorithm (see [C. Lucas, LAPack-Style Codes for Level 2 and 3 Pivoted Cholesky Factorizations](http://www.netlib.org/lapack/lawnspdf/lawn161.pdf)).

The eigenvalues $\tilde \lambda_j$ computed using the above algorithm satisfy relative error bounds:

$$
\frac{|\lambda_j-\tilde\lambda_j|}{\lambda_j} \leq O(n\varepsilon \|A_S\|_2^{-1}).$$

"""

# ╔═╡ 28c1a9e7-6c65-4184-b41b-b5cfd17645b5
function JacobiR(A₁::AbstractMatrix)
    A=deepcopy(A₁)
    m,n=size(A)
    T=typeof(A[1,1])
    V=Matrix{T}(I,n,n)
    # Tolerance for rotation
    tol=√n*eps(T)
    # Counters
    p=n*(n-1)/2
    sweep=0
    pcurrent=0
    # First criterion is for standard accuracy, second one is for relative accuracy
    # while sweep<30 && vecnorm(A-diagm(diag(A)))>tol
    while sweep<30 && pcurrent<p
        sweep+=1
        # Row-cyclic strategy
        for i = 1 : n-1
            for j = i+1 : n
                # Compute the 2 x 2 sumbatrix of A'*A
                # F=A[:,[i,j]]'*A[:,[i,j]]
				F=view(A,:,[i,j])'*view(A,:,[i,j])
                # Check the tolerance - the first criterion is standard,
                # the second one is for relative accuracy
                # if A[i,j]!=zero(T)
                #
                if abs(F[1,2])>tol*√(F[1,1]*F[2,2])
                    # Compute c and s
                    τ=(F[2,2]-F[1,1])/(2*F[1,2])
                    t=sign(τ)/(abs(τ)+√(1+τ^2))
                    c=1/√(1+t^2)
                    s=c*t
                    G=LinearAlgebra.Givens(i,j,c,s)
                    # A*=G'
                    rmul!(A,G)
                    # V*=G'
                    rmul!(V,G)
                    pcurrent=0
                else
                    pcurrent+=1
                end
            end
        end
    end
    σ=[norm(A[:,k]) for k=1:n]
    for k=1:n
        A[:,k]./=σ[k]
    end
    # A, σ, V
    SVD(A,σ,adjoint(V))
end

# ╔═╡ bc8b94b7-7e20-4cd3-be68-7e9152fe6d7b
begin
	n=20
	import Random
	Random.seed!(421)
	B=randn(n,n)
	# Scaled matrix
	As=Matrix(Symmetric(B'*B))
	# Scaling
	D₀=exp.(50*(rand(n).-0.5))
	# Parentheses are necessary!
	A=[As[i,j]*(D₀[i]*D₀[j]) for i=1:n, j=1:n]
	issymmetric(A), cond(As), cond(A)
end

# ╔═╡ 66dedda0-24a0-48a0-9286-4ce688e5da72
# ?cholesky;

# ╔═╡ cc924252-137a-4241-b178-2eabf653ff71
md"""
We will not use the Cholesky factorization with complete pivoting. Instead, we will just sort the diagonal of $A$ in advance, which is sufficient for this example.

_Write the function for Cholesky factorization with complete pivoting as an excercise._
"""

# ╔═╡ c41e4534-6b29-4cbe-9b17-2c69c89e5570
# ?sortperm;

# ╔═╡ bcee7b90-2dd4-47b0-a781-67d35962d5f2
begin
	p=sortperm(diag(A), rev=true)
	L=cholesky(A[p,p])
end

# ╔═╡ f471d60f-1c70-4bd5-bb67-2bb17c18f3f8
U,σ,V=JacobiR(Matrix(L.L));

# ╔═╡ c474702a-8af8-4640-9f45-bca748ab3952
begin
	U₁=U[invperm(p),:]
	λ=σ.^2
end

# ╔═╡ 25143fe5-3965-468a-8cb1-7c3e8e8027ea
U'*A[p,p]*U

# ╔═╡ 86dc734d-f45d-491f-9f80-7d958e642fbd
# Due to large condition number, this is not
# as accurate as expected
Ξ=U₁'*A*U₁

# ╔═╡ 001f801a-06d2-48be-a5ad-4c07f7a92890
# Orthogonality
norm(U₁'*U₁-I)

# ╔═╡ 5196b508-5aad-4811-bfc0-1c1fa00eec37
begin
	DΞ=sqrt.(diag(Ξ))
	Ξs=[Ξ[i,j]/(DΞ[i]*DΞ[j]) for i=1:n, j=1:n]
end

# ╔═╡ bcfdae20-040f-492e-bc67-60cf5f420cc0
begin
	K=U₁*Diagonal(σ)
	K'*K
end

# ╔═╡ 3ad5b60e-3fb9-443e-90eb-40b2fd78d9a3
# Explain why is the residual so large.
norm(A*U₁-U₁*Diagonal(λ))

# ╔═╡ 3e863b09-dc68-4560-adeb-e56ab22d9afd
# Relative residual is percfect
norm(A*U₁-U₁*Diagonal(λ))/norm(A)

# ╔═╡ a5555731-c229-43de-9d88-cc3b91d7db67
[λ sort(eigvals(A),rev=true)]

# ╔═╡ c3fcbaf1-b98f-401f-9244-aad632805ecb
md"""
### Hilbert matrix

We need the newest version of the package
[SpecialMatrices.jl](https://github.com/JuliaMatrices/SpecialMatrices.jl).
"""

# ╔═╡ 8d7e4960-9b04-4f5e-b2e6-acce80a6812f
varinfo(SpecialMatrices)

# ╔═╡ 80d64fc6-33e7-4069-a6f4-8e85369dad9f
C=Cauchy([1,2,3,4,5],[0,1,2,3,4])

# ╔═╡ 804c4972-bf3d-4284-8426-b50b3ea5bb1b
H=Hilbert(5)

# ╔═╡ e9bf2b02-a60d-495b-bbdb-d87e31d8d9e0
Hf=Matrix(H)

# ╔═╡ c113b7fe-87b9-454c-aeb9-166af79bbe61
begin
	# Exact formula for the determinant of a Cauchy matrix from Fact 7.
	import LinearAlgebra.det
	function det(C::Cauchy{T}) where T
	    n=length(C.x)
	    F=triu([(C.x[j]-C.x[i])*(C.y[j]-C.y[i]) for i=1:n, j=1:n],1)
	    num=prod(F[findall(!iszero,F)])
	    den=prod([(C.x[i]+C.y[j]) for i=1:n, j=1:n])
	    if all(isinteger,C.x)&all(isinteger,C.y)
	        return num//den
	    else
	        return num/den
	    end
	end
end

# ╔═╡ c6c0e7b2-400c-478e-90af-496659fed9c4
# This is exact
det(Hf)

# ╔═╡ d057146d-4a5c-415f-9332-9b3bb7e82fc4
det(C)

# ╔═╡ 66115e0a-a5c8-4a66-958b-27d9a7865855
md"""
Compute componentwise highly accurate $A=LDL ^T$ factorization of a Hilbert (Cauchy) matrix. Using `Rational` numbers gives high accuracy.
"""

# ╔═╡ 43656da7-93db-4de3-b420-098f64dfba85
# Exact LDLT factorization from Fact 8, no pivoting.
function LDLT(C::Cauchy)
    n=length(C.x)
    T=typeof(C.x[1])
    D=Array{Rational{T}}(undef,n)
    L=Matrix{Rational{T}}(I,n,n)
    δ=[det(Cauchy(C.x[1:j],C.y[1:j])) for j=1:n]
    D[1]=map(Rational{T},C[1,1])
    D[2:n]=δ[2:n]./δ[1:n-1]
    for i=2:n
        for j=1:i-1
            L[i,j]=det(Cauchy( C.x[[1:j-1;i]], C.y[1:j])) / δ[j]
        end
    end
    L,D
end

# ╔═╡ d0b35d9b-8b87-4831-846c-b63fe8912ec7
L₁,D₁=LDLT(C)

# ╔═╡ d25dcaa1-2448-49ec-b863-b224edc4ec2c
L₁*Diagonal(D₁)*L₁' # -Matrix(H)

# ╔═╡ d668a5a2-8060-48ef-adf0-6be0b1c3859e
# L*D*L' is an RRD
cond(L₁)

# ╔═╡ a4a40d52-94fc-4ccc-8e35-09c75c5de755
cond(C)

# ╔═╡ dbfbbb00-ab00-4c85-a4ce-32468f18088a
md"""
We now compute the accurate EVD of the Hilbert matrix of order $n=100$. We cannot use the function `LDLT()` since the _computation of determinant causes overflow_ and _there is no pivoting_. Instead, we use Algorithm 3 from [J. Demmel, Computing the singular value decomposition with high relative accuracy, SIAM J. Matrix Anal. Appl, 21 (1999) 562-580](http://www.netlib.org/lapack/lawnspdf/lawn130.pdf).
"""

# ╔═╡ 0176739c-2846-4b07-a8d3-68454c1251a6
function GECP(C::Cauchy)
    n=length(C.x)
    G=Matrix(C)
    x=copy(C.x)
    y=copy(C.y)
    pr=collect(1:n)
    pc=collect(1:n)
    # Find the maximal element
    for k=1:n-1
        i,j=Tuple(argmax(abs.(G[k:n,k:n])))
        i+=k-1
        j+=k-1
        if i!=k || j!=k
            G[[i,k],:]=G[[k,i],:]
            G[:, [j,k]]=G[:, [k,j]]
            x[[k,i]]=x[[i,k]]
            y[[k,j]]=y[[j,k]]
            pr[[i,k]]=pr[[k,i]]
            pc[[j,k]]=pc[[k,j]]
        end
        for r=k+1:n
            for s=k+1:n
                G[r,s]=G[r,s]*(x[r]-x[k])*(y[s]-y[k])/
                ((x[k]+y[s])*(x[r]+y[k]))
            end
        end
        G=Matrix(Symmetric(G))
    end
    D=diag(G)
    X=tril(G,-1)*Diagonal(1.0./D)+I
    Y=Diagonal(1.0./D)*triu(G,1)+I
    X,D,Y', pr,pc
end

# ╔═╡ 8b844cf7-c574-45e9-b682-fa9cc6e9cb73
X,D,Y,pr,pc=GECP(C)

# ╔═╡ b3877ea1-d479-4d08-af8c-26e17de77106
# Check
norm(X*Diagonal(D)*Y'-Matrix(C)[pr,pc]),
norm(X[invperm(pr),:]*Diagonal(D)*Y[invperm(pc),:]'-C)

# ╔═╡ 9bff72d8-68b6-41b6-a954-ee39f90ec7b0
begin
	# Now the big test.
	n₂=100
	H₂=Hilbert(n₂)
	C₂=Cauchy(collect(1:n₂), collect(0:n₂-1))
end

# ╔═╡ 72390bf0-c5d6-46de-b8d0-0bee2cbb0af7
md"""
We need a function to compute RRD from `GECP()`
"""

# ╔═╡ 46656cee-2202-4eb9-9725-1e3e3af4df42
function RRD(C::Cauchy)
    X,D,Y,pr,pc=GECP(C)
    X[invperm(pr),:], D, Y[invperm(pc),:]
end

# ╔═╡ 6b544eaf-858a-40e5-b59b-75cfa2237a6f
X₂,D₂,Y₂=RRD(C₂);

# ╔═╡ 8eb2d15e-53c0-40ab-98ce-7b0bbf4d6cd1
# Check
norm((X₂*Diagonal(D₂)*Y₂')-C₂)

# ╔═╡ c7fd604c-9e63-4ac0-8839-82371f968ba7
cond(C₂)

# ╔═╡ 23df1242-1b43-4d52-a8ed-1b12b0d5d4b9
# Is this RRD? here X=Y
cond(X₂), cond(Y₂)

# ╔═╡ 14374962-2eea-4c8f-9390-73ef886c25d9
# Algorithm from Fact 3
function RRDSVD(X,D,Y)
    Q,R,p=qr(X*Diagonal(D),Val(true))
    W=R[:,p]*Y'
    V,σ,U₁=JacobiR(W')
    U=Q*U₁
    U,σ,V
end

# ╔═╡ d4a86d03-0afe-4b1d-8828-52eae055aa9f
U₂,σ₂,V₂=RRDSVD(X₂,D₂,Y₂);

# ╔═╡ 1dfe86bf-7553-444b-a94e-340acccf5375
# Residual and orthogonality
norm(Matrix(C₂)*V₂-U₂*Diagonal(σ₂)), norm(U₂'*U₂-I), norm(V₂'*V₂-I)

# ╔═╡ cc123376-b657-4d8f-88e0-0f7577058c2b
# Observe the differences!!
[sort(σ₂) sort(svdvals(C₂)) sort(eigvals(Matrix(C₂)))]

# ╔═╡ 337ade70-accb-417b-b655-9640ed61b375
plot(σ₂,yscale = :log10,legend=false, title="Singular values of Hilbert matrix")

# ╔═╡ f7556414-693d-4d46-889b-ed6b091a235e
begin
	# Better spy
	# some options :bluesreds,clim=(-1.0,1.0)
	import Plots.spy
	spy(A)=heatmap(A, yflip=true, color=:bluesreds, aspectratio=1)
end

# ╔═╡ 9ee70a5d-59f7-460c-92af-8872966cec40
spy(U₂)

# ╔═╡ abb64f41-6817-49e9-9d44-81ef0ce32934
md"""
# Symmetric arrowhead and DPR1 matrices

For more details, see
[N. Jakovčević Stor, I. Slapničar and J. Barlow, Accurate eigenvalue decomposition of real symmetric arrowhead matrices and applications](https://arxiv.org/abs/1302.7203) and [N. Jakovčević Stor, I. Slapničar and J. Barlow, Forward stable eigenvalue decomposition of rank-one modifications of diagonal matrices](https://arxiv.org/abs/1405.7537).
"""

# ╔═╡ b24b1c96-c73e-4c8e-83af-f35e2b9df304
md"""
## Definitions

An __arrowhead matrix__ is a real symmetric matrix of order $n$ of the form $A=\begin{bmatrix} D & z \\ z^{T} & \alpha \end{bmatrix}$, where $D=\mathop{\mathrm{diag}}(d_{1},d_{2},\ldots ,d_{n-1})$, $z=\begin{bmatrix} \zeta _{1} & \zeta _{2} & \cdots & \zeta _{n-1} \end{bmatrix}^T$ is a vector, and $\alpha$ is a scalar.

An arrowhead matrix is __irreducible__ if $\zeta _{i}\neq 0$ for all $i$ and $d_{i}\neq d_{j}$ for all $i\neq j$.

A __diagonal-plus-rank-one matrix__ (DPR1 matrix) is a real symmetric matrix of order $n$ of the form $A= D +\rho z z^T$, where $D=\mathop{\mathrm{diag}}(d_{1},d_{2},\ldots ,d_{n})$, $z=\begin{bmatrix} \zeta _{1} & \zeta _{2} & \cdots & \zeta _{n} \end{bmatrix}^T$ is a vector, and $\rho \neq 0$ is a scalar.

A DPR1 matrix is __irreducible__ if $\zeta _{i}\neq 0$ for all $i$ and $d_{i}\neq d_{j}$ for all $i\neq j$.
"""

# ╔═╡ 5e068291-cb05-4fd5-acaa-8e5d766e375a
md"""
## Facts on arrowhead matrices

Let $A$ be an arrowhead matrix of order $n$ and let $A=U\Lambda U^T$ be its EVD.

1. If $d_i$ and $\lambda_i$ are nonincreasingy ordered, the Cauchy Interlace Theorem implies

$$\lambda _{1}\geq d_{1}\geq \lambda _{2}\geq d_{2}\geq \cdots \geq d_{n-2}\geq\lambda
_{n-1}\geq d_{n-1}\geq \lambda _{n}.$$

2. If $\zeta _{i}=0$ for some $i$, then $d_{i}$ is an eigenvalue whose corresponding eigenvector is the $i$-th unit vector, and we can reduce the size of the problem by deleting the $i$-th row and column of the matrix. If $d_{i}=d_{j}$, then $d_{i}$ is an eigenvalue of $A$ (this follows from the interlacing property) and we can reduce the size of the problem by annihilating $\zeta_j$ with a Givens rotation in the $(i,j)$-plane.

3. If $A$ is irreducible, the interlacing property holds with strict inequalities.

4. The eigenvalues of $A$ are the zeros of the __Pick function__ (also, _secular equation_)

$$
f(\lambda )=\alpha -\lambda -\sum_{i=1}^{n-1}\frac{\zeta _{i}^{2}}{%
d_{i}-\lambda }=\alpha -\lambda -z^{T}(D-\lambda I)^{-1}z,$$

and the corresponding eigenvectors are

$$
U_{:,i}=\frac{x_{i}}{\left\Vert x_{i}\right\Vert _{2}},\quad
x_{i}=\begin{bmatrix}
\left( D-\lambda _{i}I\right) ^{-1}z \\
-1%
\end{bmatrix},
\quad i=1,\ldots ,n.$$

5. Let $A$ be irreducible and nonsingular. If $d_i\neq 0$ for all $i$, then $A^{-1}$ is a DPR1 matrix

$$
A^{-1}=\begin{bmatrix} D^{-1} &  \\ & 0 \end{bmatrix} + \rho uu^{T},$$

where $u=\begin{bmatrix} D^{-1}z  \\ -1 \end{bmatrix}$, and $\rho =\displaystyle\frac{1}{\alpha-z^{T}D^{-1}z}$. If $d_i=0$, then $A^{-1}$ is a permuted arrowhead matrix,

$$
A^{-1}\equiv
\begin{bmatrix}
D_{1} & 0 & 0 & z_{1} \\
0 & 0 & 0 & \zeta _{i} \\
0 & 0 & D_{2} & z_{2} \\
z_{1}^{T} & \zeta _{i} & z_{2}^{T} & \alpha
\end{bmatrix}^{-1}
= \begin{bmatrix}
D_{1}^{-1} & w_{1} & 0 & 0 \\
w_{1}^{T} & b & w_{2}^{T} & 1/\zeta _{i} \\
0 & w_{2} & D_{2}^{-1} & 0 \\
0 & 1/\zeta _{i} & 0 & 0
\end{bmatrix},$$

where

$$
\begin{aligned}
w_{1}&=-D_{1}^{-1}z_{1}\displaystyle\frac{1}{\zeta _{i}},\\
w_{2}&=-D_{2}^{-1}z_{2}\displaystyle\frac{1}{\zeta _{i}},\\
b&= \displaystyle\frac{1}{\zeta _{i}^{2}}\left(-\alpha +z_{1}^{T}D_{1}^{-1}z_{1}+z_{2}^{T}D_{2}^{-1}z_{2}\right).
\end{aligned}$$

6. The algorithm based on the following approach computes all eigenvalues and _all components_ of the corresponding eigenvectors in a forward stable manner to almost full accuracy in $O(n)$ operations per eigenpair:

    1. Shift the irreducible $A$ to $d_i$ which is closer to $\lambda_i$ (one step of bisection on $f(\lambda)$).
    2. Invert the shifted matrix.
    3. Compute the absolutely largest eigenvalue of the inverted shifted matrix and the corresponding eigenvector.

7. The algorithm is implemented in the package [Arrowhead.jl](https://github.com/ivanslapnicar/Arrowhead.jl). In certain cases, $b$ or $\rho$ need to be computed with extended precision. For this, we use the functions from file [DoubleDouble.jl](https://github.com/ivanslapnicar/Arrowhead.jl/blob/master/src/DoubleDouble.jl), originally from the the package [DoubleDouble.jl](https://github.com/simonbyrne/DoubleDouble.jl).
"""

# ╔═╡ 6d7f330f-3c88-44bd-aff9-65daa7f1ea1c
md"
## Examples

### Extended precision arithmetic
"

# ╔═╡ eea30449-2410-448d-885f-e27b7aa657c0
begin
	# Extended precision arithmetic
	a=2.0
	b=3.0
	√a
end

# ╔═╡ 21f8e11a-09fe-49a9-91cd-b118876910a8
√BigFloat(a)

# ╔═╡ 6d484719-e545-4742-9e46-515525af8244
# Double numbers according to Dekker, 1971
ad=Arrowhead.Double(a)

# ╔═╡ 310ace86-6193-43ee-bdac-fe1a79a2cb26
bd=Arrowhead.Double(b)

# ╔═╡ be91a6f1-2594-4084-8b23-312c51f35553
roota=√ad

# ╔═╡ 5762ccae-2a28-4041-8a02-4bec918e192a
rootb=√bd

# ╔═╡ 4c1a73a1-bdfe-4939-8282-54b7fa193e5a
# 30 digits should match
BigFloat(roota.hi)+BigFloat(roota.lo)

# ╔═╡ f5b83025-64e7-44d1-a841-f9a7fc8614fb
√BigFloat(a)*√BigFloat(b)

# ╔═╡ 89e578d9-7608-42f2-a2f0-0ec2c89bd510
rootab=roota*rootb

# ╔═╡ 24f1cb57-ed20-4399-996f-80294c7b1bb2
BigFloat(rootab.hi)+BigFloat(rootab.lo)

# ╔═╡ 8339adb3-b0fa-45e4-b107-62954547345b
md"""
### Random arrowhead matrix
"""

# ╔═╡ 321070d6-c0c9-482d-9a5f-0e5a4f7b522f
varinfo(Arrowhead)

# ╔═╡ 9c207955-174d-474f-be95-061c71761023
methods(GenSymArrow)

# ╔═╡ bd8ea662-f4c2-4f2d-943b-b1a5f59cbe74
begin
	n₃=8
	A₃=GenSymArrow(n₃,n₃)
end

# ╔═╡ 9fe07467-4033-4374-b4f2-b0ceecf91a03
# Elements of the type SymArrow
A₃.D, A₃.z, A₃.a, A₃.i

# ╔═╡ a3ba9c15-1d55-4e2b-b32e-4202fbeca671
E₃,info₃=eigen(A₃)

# ╔═╡ 34d1bc3f-b703-4b31-887e-36d036e5c3f9
@which eigen(A₃)

# ╔═╡ 8677d8b8-f68b-4013-864c-89902ffff8fd
# Residual and orthogonality
norm(A₃*E₃.vectors-E₃.vectors*Diagonal(E₃.values)),
norm(E₃.vectors'*E₃.vectors-I)

# ╔═╡ 360829ce-2790-4d70-8699-687650fc51b4
begin
	# Timings - notice the O(n^2)
	@time eigen(GenSymArrow(1000,1000))
	@time eigen(GenSymArrow(2000,2000))
	1
end

# ╔═╡ 9f2a5e5d-a705-4d65-8ebf-6b6d9d548999
md"""
### Numerically demanding matrix
"""

# ╔═╡ 19d95a91-8c03-4b12-a8d3-46a6861991a1
A₄=SymArrow( [ 1e10+1.0/3.0, 4.0, 3.0, 2.0, 1.0 ],
    [ 1e10 - 1.0/3.0, 1.0, 1.0, 1.0, 1.0 ], 1e10, 6 )

# ╔═╡ 4a86007c-1137-4964-be3c-da51ab7fca3c
begin
	E₄,info₄=eigen(A₄)
	[sort(E₄.values) sort(eigvals(Matrix(A₄))) sort(E₄.values)-sort(eigvals(Matrix(A₄)))]
end

# ╔═╡ 33e70165-1fab-4996-99e6-a5d27bf976c5
# Residual and orthogonality
norm(A₄*E₄.vectors-E₄.vectors*Diagonal(E₄.values)),
norm(E₄.vectors'*E₄.vectors-I)

# ╔═╡ 65e00890-d4d7-4d36-a359-4606378401b7
md"""
## Facts on DPR1 matrices

The properties of DPR1 matrices are very similar to those of arrowhead matrices. Let $A$ be a DPR1 matrix of order $n$ and let $A=U\Lambda U^T$ be its EVD.

1. If $d_i$ and $\lambda_i$ are nonincreasingy ordered and $\rho>0$, then

$$\lambda _{1}\geq d_{1}\geq \lambda _{2}\geq d_{2}\geq \cdots \geq d_{n-2}\geq\lambda
_{n-1}\geq d_{n-1}\geq \lambda _{n}\geq d_n.$$

If $A$ is irreducible, the inequalities are strict.

2. Fact 2 on arrowhead matrices holds.

3. The eigenvalues of $A$ are the zeros of the __secular equation__

$$
f(\lambda )=1+\rho\sum_{i=1}^{n}\frac{\zeta _{i}^{2}}{d_{i}-\lambda }
=1 +\rho z^{T}(D-\lambda I)^{-1}z=0,$$

and the corresponding eigenvectors are

$$
U_{:,i}=\frac{x_{i}}{\left\Vert x_{i}\right\Vert _{2}},\quad
x_{i}=( D-\lambda _{i}I) ^{-1}z.$$

4. Let $A$ be irreducible and nonsingular. If $d_i\neq 0$ for all $i$, then

$$
A^{-1}=D^{-1} +\gamma uu^{T},\quad  u=D^{-1}z, \quad \gamma =-\frac{\rho}{1+\rho z^{T}D^{-1}z},$$

is also a DPR1 matrix. If $d_i=0$, then $A^{-1}$ is a permuted arrowhead matrix,

$$
A^{-1}\equiv \left(\begin{bmatrix} D_{1} & 0 & 0 \\  0 & 0 & 0  \\  0 & 0 & D_{2} \end{bmatrix}
+\rho \begin{bmatrix} z_{1} \\ \zeta _{i} \\ z_{2}
\end{bmatrix}
\begin{bmatrix}
z_{1}^{T} & \zeta _{i} & z_{2}^{T}
\end{bmatrix}\right)^{-1}=
\begin{bmatrix}
D_{1}^{-1} & w_{1} & 0 \\
w_{1}^{T} & b & w_{2}^{T} \\
0 & w_{2} & D_{2}^{-1}
\end{bmatrix},$$

where

$$
\begin{aligned}
w_{1}&=-D_{1}^{-1}z_{1}\displaystyle\frac{1}{\zeta _{i}},\\
w_{2}&=-D_{2}^{-1}z_{2}\displaystyle\frac{1}{\zeta _{i}},\\
b &=\displaystyle\frac{1}{\zeta _{i}^{2}}\left(
\frac{1}{\rho}+z_{1}^{T}D_{1}^{-1}z_{1}+z_{2}^{T}D_{2}^{-1}z_{2}\right).
\end{aligned}$$

5. The algorithm based on the same approach as above, computes all eigenvalues and all components of the corresponding eigenvectors in a forward stable manner to almost full accuracy in $O(n)$ operations per eigenpair. The algorithm is implemented in the package `Arrowhead.jl`. In certain cases, $b$ or $\gamma$ need to be computed with extended precision.
"""

# ╔═╡ 6b3c7336-f1fc-428b-8b1e-94546b6622e8
md"""

## Examples

### Random DPR1 matrix
"""

# ╔═╡ 71d0022d-3cd8-488c-80b8-4c3c958ed8fa
begin
	n₅=8
	A₅=GenSymDPR1(n₅)
end

# ╔═╡ 4655eb27-0ae8-46db-9deb-575c89d08e7e
# Elements of the type SymDPR1
A₅.D, A₅.u, A₅.r

# ╔═╡ 6642fa72-8b1b-40b2-87f2-91199a96d7f9
begin
	E₅,info₅=eigen(A₅)
	norm(A₅*E₅.vectors-E₅.vectors*Diagonal(E₅.values)),
	norm(E₅.vectors'*E₅.vectors-I)
end

# ╔═╡ 827bb865-c361-4a98-a6d6-90dca425eddc
md"""
### Numerically demanding DPR1 matrix
"""

# ╔═╡ 56c0c2ec-220f-4e04-a0cf-a144d89dd225
# Choose one
A₆=SymDPR1( [ 1e10, 5.0, 4e-3, 0.0, -4e-3,-5.0 ], [ 1e10, 1.0, 1.0, 1e-7, 1.0,1.0 ], 1.0 )

# ╔═╡ 31114bf7-450b-458d-9a1d-c22123f5f291
begin
	E₆,info₆=eigen(A₆)
	[sort(E₆.values) sort(eigvals(Matrix(A₆)))]
end

# ╔═╡ ad305a98-6cdc-424e-8f06-386b801b53e5
# Residual and orthogonality
norm(A₆*E₆.vectors-E₆.vectors*Diagonal(E₆.values)),
norm(E₆.vectors'*E₆.vectors-I)

# ╔═╡ Cell order:
# ╟─d01a9b4f-8b55-4607-abb6-717d227fcd48
# ╟─5d95dc2c-bf94-4b13-b9d5-b7b261e86cf6
# ╟─e3e43840-d0a3-4cde-9b1e-5785759912b2
# ╟─03f797ac-8764-4688-9e7e-e144cafb3b4c
# ╟─f280b119-76a7-4ee8-b6fd-608d977af0c6
# ╠═28c1a9e7-6c65-4184-b41b-b5cfd17645b5
# ╠═bc8b94b7-7e20-4cd3-be68-7e9152fe6d7b
# ╠═66dedda0-24a0-48a0-9286-4ce688e5da72
# ╟─cc924252-137a-4241-b178-2eabf653ff71
# ╠═c41e4534-6b29-4cbe-9b17-2c69c89e5570
# ╠═bcee7b90-2dd4-47b0-a781-67d35962d5f2
# ╠═f471d60f-1c70-4bd5-bb67-2bb17c18f3f8
# ╠═c474702a-8af8-4640-9f45-bca748ab3952
# ╠═25143fe5-3965-468a-8cb1-7c3e8e8027ea
# ╠═86dc734d-f45d-491f-9f80-7d958e642fbd
# ╠═001f801a-06d2-48be-a5ad-4c07f7a92890
# ╠═5196b508-5aad-4811-bfc0-1c1fa00eec37
# ╠═bcfdae20-040f-492e-bc67-60cf5f420cc0
# ╠═3ad5b60e-3fb9-443e-90eb-40b2fd78d9a3
# ╠═3e863b09-dc68-4560-adeb-e56ab22d9afd
# ╠═a5555731-c229-43de-9d88-cc3b91d7db67
# ╟─c3fcbaf1-b98f-401f-9244-aad632805ecb
# ╠═479a40d9-b81e-442b-9962-f972b110a4dd
# ╠═8d7e4960-9b04-4f5e-b2e6-acce80a6812f
# ╠═80d64fc6-33e7-4069-a6f4-8e85369dad9f
# ╠═804c4972-bf3d-4284-8426-b50b3ea5bb1b
# ╠═e9bf2b02-a60d-495b-bbdb-d87e31d8d9e0
# ╠═c6c0e7b2-400c-478e-90af-496659fed9c4
# ╠═c113b7fe-87b9-454c-aeb9-166af79bbe61
# ╠═d057146d-4a5c-415f-9332-9b3bb7e82fc4
# ╟─66115e0a-a5c8-4a66-958b-27d9a7865855
# ╠═43656da7-93db-4de3-b420-098f64dfba85
# ╠═d0b35d9b-8b87-4831-846c-b63fe8912ec7
# ╠═d25dcaa1-2448-49ec-b863-b224edc4ec2c
# ╠═d668a5a2-8060-48ef-adf0-6be0b1c3859e
# ╠═a4a40d52-94fc-4ccc-8e35-09c75c5de755
# ╟─dbfbbb00-ab00-4c85-a4ce-32468f18088a
# ╠═0176739c-2846-4b07-a8d3-68454c1251a6
# ╠═8b844cf7-c574-45e9-b682-fa9cc6e9cb73
# ╠═b3877ea1-d479-4d08-af8c-26e17de77106
# ╠═9bff72d8-68b6-41b6-a954-ee39f90ec7b0
# ╟─72390bf0-c5d6-46de-b8d0-0bee2cbb0af7
# ╠═46656cee-2202-4eb9-9725-1e3e3af4df42
# ╠═6b544eaf-858a-40e5-b59b-75cfa2237a6f
# ╠═8eb2d15e-53c0-40ab-98ce-7b0bbf4d6cd1
# ╠═c7fd604c-9e63-4ac0-8839-82371f968ba7
# ╠═23df1242-1b43-4d52-a8ed-1b12b0d5d4b9
# ╠═14374962-2eea-4c8f-9390-73ef886c25d9
# ╠═d4a86d03-0afe-4b1d-8828-52eae055aa9f
# ╠═1dfe86bf-7553-444b-a94e-340acccf5375
# ╠═cc123376-b657-4d8f-88e0-0f7577058c2b
# ╠═574e86bb-159c-4141-8d8a-21bdcc9b5304
# ╠═337ade70-accb-417b-b655-9640ed61b375
# ╠═f7556414-693d-4d46-889b-ed6b091a235e
# ╠═9ee70a5d-59f7-460c-92af-8872966cec40
# ╟─abb64f41-6817-49e9-9d44-81ef0ce32934
# ╟─b24b1c96-c73e-4c8e-83af-f35e2b9df304
# ╟─5e068291-cb05-4fd5-acaa-8e5d766e375a
# ╟─6d7f330f-3c88-44bd-aff9-65daa7f1ea1c
# ╠═5eb73af5-f78a-4811-83a5-ac39063a4516
# ╠═eea30449-2410-448d-885f-e27b7aa657c0
# ╠═21f8e11a-09fe-49a9-91cd-b118876910a8
# ╠═6d484719-e545-4742-9e46-515525af8244
# ╠═310ace86-6193-43ee-bdac-fe1a79a2cb26
# ╠═be91a6f1-2594-4084-8b23-312c51f35553
# ╠═5762ccae-2a28-4041-8a02-4bec918e192a
# ╠═4c1a73a1-bdfe-4939-8282-54b7fa193e5a
# ╠═f5b83025-64e7-44d1-a841-f9a7fc8614fb
# ╠═89e578d9-7608-42f2-a2f0-0ec2c89bd510
# ╠═24f1cb57-ed20-4399-996f-80294c7b1bb2
# ╟─8339adb3-b0fa-45e4-b107-62954547345b
# ╠═321070d6-c0c9-482d-9a5f-0e5a4f7b522f
# ╠═9c207955-174d-474f-be95-061c71761023
# ╠═bd8ea662-f4c2-4f2d-943b-b1a5f59cbe74
# ╠═9fe07467-4033-4374-b4f2-b0ceecf91a03
# ╠═a3ba9c15-1d55-4e2b-b32e-4202fbeca671
# ╠═34d1bc3f-b703-4b31-887e-36d036e5c3f9
# ╠═8677d8b8-f68b-4013-864c-89902ffff8fd
# ╠═360829ce-2790-4d70-8699-687650fc51b4
# ╟─9f2a5e5d-a705-4d65-8ebf-6b6d9d548999
# ╠═19d95a91-8c03-4b12-a8d3-46a6861991a1
# ╠═4a86007c-1137-4964-be3c-da51ab7fca3c
# ╠═33e70165-1fab-4996-99e6-a5d27bf976c5
# ╟─65e00890-d4d7-4d36-a359-4606378401b7
# ╟─6b3c7336-f1fc-428b-8b1e-94546b6622e8
# ╠═71d0022d-3cd8-488c-80b8-4c3c958ed8fa
# ╠═4655eb27-0ae8-46db-9deb-575c89d08e7e
# ╠═6642fa72-8b1b-40b2-87f2-91199a96d7f9
# ╟─827bb865-c361-4a98-a6d6-90dca425eddc
# ╠═56c0c2ec-220f-4e04-a0cf-a144d89dd225
# ╠═31114bf7-450b-458d-9a1d-c22123f5f291
# ╠═ad305a98-6cdc-424e-8f06-386b801b53e5

src/Module B - Eigenvalue and Singular Value Decompositions/L7 Algorithms for Structured Matrices.jl


using BenchmarkTools
using Printf
using Transducers

const BoardingPass = NamedTuple{(:row, :column, :seatId), Tuple{Int64, Int64, Int64}}

function toInt(s::AbstractString, zeroChar::Char, oneChar::Char)::Int64
    value = 0
    for i = 1:length(s)
        value *= 2
        if s[i] == oneChar
            value += 1
        elseif s[i] != zeroChar
            throw(DomainError(s, "valid characters are $zeroChar and $oneChar"))
        end
    end
    value
end

function toBoardingPass(s::AbstractString)::BoardingPass
    row = toInt(s[1:7], 'F', 'B')
    column = toInt(s[8:10], 'L', 'R')
    (row = row, column = column, seatId = row*8+column)
end

function toBoardingPass(seatId::Int64)::BoardingPass
    (row = seatId ÷ 8, column = seatId % 8, seatId = seatId)
end

#### basic tests

@assert toBoardingPass("FBFBBFFRLR") == (row = 44, column = 5, seatId = 357)
@assert toBoardingPass("BFFFBBFRRR") == (row = 70, column = 7, seatId = 567)
@assert toBoardingPass("FFFBBBFRRR") == (row = 14, column = 7, seatId = 119)
@assert toBoardingPass("BBFFBBFRLL") == (row = 102, column = 4, seatId = 820)

@assert toBoardingPass(357) == (row = 44, column = 5, seatId = 357)
@assert toBoardingPass(567) == (row = 70, column = 7, seatId = 567)
@assert toBoardingPass(119) == (row = 14, column = 7, seatId = 119)
@assert toBoardingPass(820) == (row = 102, column = 4, seatId = 820)

#### read data

boardingPasses = readlines("src/advent/day5/input.txt") |> Map(line -> toBoardingPass(line)) |> collect

#### part 1

function highestSeatId(boardingPasses)
    boardingPasses |> Map(pass -> pass.seatId) |> maximum
end

@printf("highestSeatId = %d\n", highestSeatId(boardingPasses))
#@btime highestSeatId(boardingPasses);

#### part 2

function findMySeatId(boardingPasses)
    map = Dict{Int64, BoardingPass}()
    for pass in boardingPasses
        map[pass.seatId] = pass
    end
    for pass in boardingPasses
        if haskey(map, pass.seatId - 2) && !haskey(map, pass.seatId - 1)
            return toBoardingPass(pass.seatId - 1)
        elseif haskey(map, pass.seatId + 2) && !haskey(map, pass.seatId + 1)
            return toBoardingPass(pass.seatId + 1)
        end
    end
end

@printf("mySeatId = %d\n", findMySeatId(boardingPasses).seatId)
#@btime findMySeatId(boardingPasses);

#### part 2: pure MapReduce

function merge(a::UnitRange{Int64}, b::UnitRange{Int64})::Tuple{UnitRange{Int64}, Vararg{UnitRange{Int64}}}
    a.stop + 1 == b.start && return (a.start:b.stop, )
    b.stop + 1 == a.start && return (b.start:a.stop, )
    (a, b)
end

@assert merge(1:1, 2:2) == (1:2, )
@assert merge(2:2, 1:1) == (1:2, )
@assert merge(2:2, 4:4) == (2:2, 4:4)

function merge!(ranges, range1)
    modified = false
    for i ∈ 1:length(ranges)
        results = merge(ranges[i], range1)
        if length(results) == 1
            ranges[i] = results[1]
            modified = true
            break
        end
    end
    if !modified
        push!(ranges, range1)
    end
    ranges
end

function merge!(ranges)
    modified = false
    while length(ranges) > 1
        changed = false
        i = 1
        while i < length(ranges)
            range = ranges[i]
            for j = i+1:length(ranges)
                results = merge(range, ranges[j])
                if length(results) == 1
                    ranges[i] = results[1]
                    deleteat!(ranges, j)
                    changed = true
                    modified = true
                    break
                end
            end
            i += 1
        end
        !changed && break
    end
    modified
end

function mergeRangeList(a, b)
    #before = (length(a), length(b))
    for range ∈ b
        merge!(a, range)
    end
    while merge!(a)
        # empty body
    end
    #after = length(a)
    #println("---- $before -> $after")
    a
end

function findMySeatId2(boardingPasses)
    ranges = foldxt(mergeRangeList, boardingPasses |> Map(pass -> [pass.seatId:pass.seatId])) |> collect
    sort!(ranges)
    1:length(ranges)-1 |> Map(i -> (ranges[i], ranges[i + 1])) |> Filter(ranges -> ranges[2].start - ranges[1].stop == 2) |> Map(ranges -> toBoardingPass(ranges[1].stop + 1)) |> first

    #for i = 1:length(ranges)-1
    #    range1 = ranges[i]
    #    range2 = ranges[i + 1]
    #    range2.start - range1.stop == 2 && return (seatId = range1.stop + 1, found = true)
    #end
    #(seatId = -1, found = false)
end

@printf("mySeatId2 = %d\n", findMySeatId2(boardingPasses).seatId)
#@btime findMySeatId2(boardingPasses);


struct SampleDistribution{T,K} <: Distribution{Multivariate, Discrete}
    dist::Categorical{T}
    map::Dict{K,Int}
    inverse_map::Dict{Int,K}
end

function SampleDistribution(p::AbstractVector{T}, dict::Dict{K,<:Integer}) where {T<:Real,K}
    SampleDistribution{T,K}(Categorical{T}(p), dict, inversedict(dict))
end

# this is a dict with probabilities as values
function SampleDistribution(dict::Dict{K,T}) where {K,T<:AbstractFloat}
    ks = collect(keys(dict))
    p = getindex.(dict, ks)
    SampleDistribution(p, Dict(ks[i]=>i for i ∈ 1:length(ks)))
end

# this is a dict with counts as values
function SampleDistribution(dict::Dict{K,T}) where {K,T<:Integer}
    total = sum(values(dict))
    SampleDistribution(Dict{K,Float64}(k=>Float64(v/total) for (k,v) ∈ dict))
end

export SampleDistribution

# this will do counts for you
SampleDistribution(v::AbstractVector) = SampleDistribution(proportionmap(v))

supportkeys(d::SampleDistribution) = keys(d.map)
support(d::SampleDistribution) = collect(supportkeys(d))

getsample(d::SampleDistribution, i::Integer) = d.inverse_map[i]

pdfbyindex(d::SampleDistribution, i::Integer) = pdf(d.dist, i)

"""
    expectation(d::SampleDistribution, f::Function)

Compute the expectation value of `f` over distribution `d`.  `f` should take a single argument
which is in the support of `d`.  Also supports `do` syntax.
"""
function expectation(d::SampleDistribution, f::Function)
    sum(pdfbyindex(d, i)*f(getsample(d, i)) for i ∈ 1:ncategories(d))
end
expectation(f::Function, d::SampleDistribution) = expectation(d, f)
export expectation


# ========== Perform 1 step of discrete wavelet transform ==========
# ----- 1 step of dwt for 1D signals -----
"""
    dwt_step(v, h, g)

Perform one level of the discrete wavelet transform (DWT) on the vector `v`, which is the
`d`-th level scaling coefficients (Note the 0th level scaling coefficients is the raw
signal). The vectors `h` and `g` are the detail and scaling filters.

# Arguments
- `v::AbstractVector{T} where T<:Number`: Vector of coefficients from a node at level `d`.
- `h::Vector{S} where S<:Number`: High pass filter.
- `g::Vector{S} where S<:Number`: Low pass filter.

# Returns
- `w₁::Vector{T}`: Output from the low pass filter.
- `w₂::Vector{T}`: Output from the high pass filter.

# Examples
```julia
using Wavelets, WaveletsExt

# Setup
v = randn(8)
wt = wavelet(WT.haar)
g, h = WT.makereverseqmfpair(wt, true)

# One step of DWT
DWT.dwt_step(v, h, g)
```

**See also:** [`dwt_step!`](@ref), [`idwt_step`](@ref)
"""
function dwt_step(v::AbstractVector{T}, h::Array{S,1}, g::Array{S,1}) where
                 {T<:Number, S<:Number}
    n = length(v)
    w₁ = zeros(T, n÷2)
    w₂ = zeros(T, n÷2)

    dwt_step!(w₁, w₂, v, h, g)
    return w₁, w₂
end

"""
    dwt_step!(w₂, w₂, v, h, g)

Same as `dwt_step` but without array allocation.

# Arguments
- `w₁::AbstractVector{T} where T<:Number`: Vector allocation for output from low pass
  filter.
- `w₂::AbstractVector{T} where T<:Number`: Vector allocation for output from high pass
  filter.
- `v::AbstractVector{T} where T<:Number`: Vector of coefficients from a node at level `d`.
- `h::Vector{S} where S<:Number`: High pass filter.
- `g::Vector{S} where S<:Number`: Low pass filter.

# Returns
- `w₁::Vector{T}`: Output from the low pass filter.
- `w₂::Vector{T}`: Output from the high pass filter.

# Examples
```julia
using Wavelets, WaveletsExt

# Setup
v = randn(8)
wt = wavelet(WT.haar)
g, h = WT.makereverseqmfpair(wt, true)
w₁ = zeros(8)
w₂ = zeros(8)

# One step of DWT
DWT.dwt_step!(w₁, w₂, v, 0, h, g)
```

**See also:** [`dwt_step`](@ref), [`idwt_step`](@ref)
"""
function dwt_step!(w₁::AbstractVector{T},
                   w₂::AbstractVector{T},
                   v::AbstractVector{T},
                   h::Array{S,1},
                   g::Array{S,1}) where {T<:Number, S<:Number}
    # Sanity check
    @assert length(w₁) == length(w₂) == length(v)÷2
    @assert length(h) == length(g)

    # Setup
    n = length(v)           # Parent length
    n₁ = length(w₁)         # Child length
    filtlen = length(h)     # Filter length

    # One step of discrete transform
    for i in 1:n₁
        k₁ = 2*i-1          # Start index for low pass filtering
        k₂ = 2*i            # Start index for high pass filtering
        @inbounds w₁[i] = g[end] * v[k₁]
        @inbounds w₂[i] = h[1] * v[k₂]
        for j in 2:filtlen
            k₁ = k₁+1 |> k₁ -> k₁>n ? mod1(k₁,n) : k₁
            k₂ = k₂-1 |> k₂ -> k₂≤0 ? mod1(k₂,n) : k₂
            @inbounds w₁[i] += g[end-j+1] * v[k₁]
            @inbounds w₂[i] += h[j] * v[k₂]
        end
    end
    return w₁, w₂
end

"""
    idwt_step(w₁, w₂, h, g)

Perform one level of the inverse discrete wavelet transform (IDWT) on the vectors `w₁` and
`w₂`, which are the scaling and detail coefficients. The vectors `h` and `g` are the detail
and scaling filters.

# Arguments
- `w₁::AbstractVector{T} where T<:Number`: Vector allocation for output from low pass
  filter.
- `w₂::AbstractVector{T} where T<:Number`: Vector allocation for output from high pass
  filter.
- `h::Vector{S} where S<:Number`: High pass filter.
- `g::Vector{S} where S<:Number`: Low pass filter.

# Returns
- `v::Vector{T}`: Reconstructed coefficients.

# Examples
```julia
using Wavelets, WaveletsExt

# Setup
v = randn(8)
wt = wavelet(WT.haar)
g, h = WT.makereverseqmfpair(wt, true)

# One step of SDWT
w₁, w₂ = DWT.dwt_step(v, h, g)

# One step of ISDWT
v̂ = DWT.idwt_step(w₁, w₂, h, g)
```

**See also:** [`idwt_step!`](@ref)
"""
function idwt_step(w₁::AbstractVector{T},
                   w₂::AbstractVector{T},
                   h::Array{S,1},
                   g::Array{S,1}) where {T<:Number, S<:Number}
    n = length(w₁)
    v = Vector{T}(undef, 2*n)
    idwt_step!(v, w₁, w₂, h, g)
    return v
end

"""
    idwt_step!(v, w₁, w₂, h, g)

Same as `idwt_step` but without array allocation.

# Arguments
- `v::AbstractVector{T} where T<:Number`: Vector allocation for reconstructed coefficients.
- `w₁::AbstractVector{T} where T<:Number`: Vector allocation for output from low pass
  filter.
- `w₂::AbstractVector{T} where T<:Number`: Vector allocation for output from high pass
  filter.
- `h::Vector{S} where S<:Number`: High pass filter.
- `g::Vector{S} where S<:Number`: Low pass filter.

# Returns
- `v::Vector{T}`: Reconstructed coefficients.

# Examples
```julia
using Wavelets, WaveletsExt

# Setup
v = randn(8)
v̂ = similar(v)
wt = wavelet(WT.haar)
g, h = WT.makereverseqmfpair(wt, true)

# One step of SDWT
w₁, w₂ = DWT.dwt_step(v, h, g)

# One step of ISDWT
DWT.idwt_step!(v̂, w₁, w₂, h, g)
```

**See also:** [`idwt_step`](@ref)
"""
function idwt_step!(v::AbstractVector{T},
                    w₁::AbstractVector{T},
                    w₂::AbstractVector{T},
                    h::Array{S,1},
                    g::Array{S,1}) where {T<:Number, S<:Number}
    # Sanity check
    @assert length(w₁) == length(w₂) == length(v)÷2
    @assert length(h) == length(g)

    # Setup
    n = length(v)           # Parent length
    n₁ = length(w₁)         # Child length
    filtlen = length(h)     # Filter length

    # One step of inverse discrete transform
    for i in 1:n
        j₀ = mod1(i,2)      # Pivot point to determine start index for filter
        j₁ = filtlen-j₀+1   # Index for low pass filter g
        j₂ = mod1(i+1,2)    # Index for high pass filter h
        k₁ = (i+1)>>1       # Index for approx coefs w₁
        k₂ = (i+1)>>1       # Index for detail coefs w₂
        @inbounds v[i] = g[j₁] * w₁[k₁] + h[j₂] * w₂[k₂]
        for j in (j₀+2):2:filtlen
            j₁ = filtlen-j+1
            j₂ = j + isodd(j) - iseven(j)
            k₁ = k₁-1 |> k₁ -> k₁≤0 ? mod1(k₁,n₁) : k₁
            k₂ = k₂+1 |> k₂ -> k₂>n₁ ? mod1(k₂,n₁) : k₂
            @inbounds v[i] += g[j₁] * w₁[k₁] + h[j₂] * w₂[k₂]
        end
    end
    return v
end

# ----- 1 step of dwt for 2D signals -----
"""
    dwt_step(v, h, g)

Compute 1 step of 2D discrete wavelet transform (DWT).

# Arguments
- `v::AbstractArray{T,2} where T<:Number`: Array of coefficients of size ``(n,m)``.
- `h::Array{S,1} where S<:Number`: High pass filter.
- `g::Array{S,1} where S<:Number`: Low pass filter.

# Returns
- `w₁::Array{T,2}`: Top left output. Result of low pass filter on columns + low pass filter
  on rows.
- `w₂::Array{T,2}`: Top left output. Result of low pass filter on columns + high pass filter
  on rows.
- `w₃::Array{T,2}`: Top left output. Result of high pass filter on columns + low pass filter
  on rows.
- `w₄::Array{T,2}`: Top left output. Result of high pass filter on columns + high pass filter
  on rows.

# Examples
```julia
using Wavelets, WaveletsExt

# Setup
v = randn(8,8)
wt = wavelet(WT.haar)
g, h = WT.makereverseqmfpair(wt, true)

# One step of DWT
DWT.dwt_step(v, h, g)
```

**See also:** [`dwt_step`](@ref), [`dwt_step!`](@ref), [`idwt_step`](@ref)
"""
function dwt_step(v::AbstractArray{T,2}, h::Array{S,1}, g::Array{S,1}) where
                 {T<:Number, S<:Number}
    n,m = size(v)
    n₁ = n÷2
    m₁ = m÷2
    w₁ = Array{T,2}(undef, (n₁,m₁))
    w₂ = Array{T,2}(undef, (n₁,m₁))
    w₃ = Array{T,2}(undef, (n₁,m₁))
    w₄ = Array{T,2}(undef, (n₁,m₁))
    temp = Array{T,2}(undef, (n,m))
    dwt_step!(w₁, w₂, w₃, w₄, v, h, g, temp)
    return w₁, w₂, w₃, w₄
end

"""
    dwt_step!(v, w₁, w₂, w₃, w₄, h, g, temp)

Same as 2D version of `dwt_step` but without array allocation.

# Arguments
- `w₁::AbstractArray{T,2} where T<:Number`: Array allocation for top left output.
- `w₂::AbstractArray{T,2} where T<:Number`: Array allocation for top right output.
- `w₃::AbstractArray{T,2} where T<:Number`: Array allocation for bottom left output.
- `w₄::AbstractArray{T,2} where T<:Number`: Array allocation for bottom right output.
- `v::AbstractArray{T,2} where T<:Number`: Array of coefficients to be transformed.
- `h::Array{S,1} where S<:Number`: High pass filter.
- `g::Array{S,1} where S<:Number`: Low pass filter.
- `temp::AbstractArray{T,2} where T<:Number`: Array allocation for intermediate
  computations.

# Returns
- `w₁::Array{T,2}`: Top left output. Result of low pass filter on columns + low pass filter
  on rows.
- `w₂::Array{T,2}`: Top left output. Result of low pass filter on columns + high pass filter
  on rows.
- `w₃::Array{T,2}`: Top left output. Result of high pass filter on columns + low pass filter
  on rows.
- `w₄::Array{T,2}`: Top left output. Result of high pass filter on columns + high pass filter
  on rows.

# Examples
```julia
using Wavelets, WaveletsExt

# Setup
v = randn(8,8)
temp = similar(v)
w₁ = Array{Float64,2}(undef, (4,4))
w₂ = Array{Float64,2}(undef, (4,4))
w₃ = Array{Float64,2}(undef, (4,4))
w₄ = Array{Float64,2}(undef, (4,4))
wt = wavelet(WT.haar)
g, h = WT.makereverseqmfpair(wt, true)

# One step of DWT
DWT.dwt_step!(w₁, w₂, w₃, w₄, v, h, g, temp)
```
"""
function dwt_step!(w₁::AbstractArray{T,2}, w₂::AbstractArray{T,2},
                   w₃::AbstractArray{T,2}, w₄::AbstractArray{T,2},
                   v::AbstractArray{T,2},
                   h::Array{S,1}, g::Array{S,1},
                   temp::AbstractArray{T,2}) where {T<:Number, S<:Number}
    # Sanity check
    @assert size(v) == size(temp)
    @assert size(w₁) == size(w₂) == size(w₃) == size(w₄)
    @assert size(w₁,1)*2 == size(v,1)
    @assert size(w₁,2)*2 == size(v,2)

    # Setup
    n,m = size(w₁)

    # --- Transform ---
    # Compute dwt for all columns
    for j in 1:(2*m)
        @inbounds temp₁ⱼ = @view temp[1:n,j]
        @inbounds temp₂ⱼ = @view temp[(n+1):end,j]
        @inbounds vⱼ = @view v[:,j]
        @inbounds dwt_step!(temp₁ⱼ, temp₂ⱼ, vⱼ, h, g)
    end
    # Compute dwt for all rows
    for i in 1:n
        @inbounds temp₁ᵢ = @view temp[i,:]
        @inbounds w₁ᵢ = @view w₁[i,:]
        @inbounds w₂ᵢ = @view w₂[i,:]
        @inbounds dwt_step!(w₁ᵢ, w₂ᵢ, temp₁ᵢ, h, g)

        @inbounds temp₂ᵢ = @view temp[n+i,:]
        @inbounds w₃ᵢ = @view w₃[i,:]
        @inbounds w₄ᵢ = @view w₄[i,:]
        @inbounds dwt_step!(w₃ᵢ, w₄ᵢ, temp₂ᵢ, h, g)
    end
    return w₁, w₂, w₃, w₄
end

"""
    idwt_step(w₁, w₂, w₃, w₄, h, g)

Computes one step of inverse discrete wavelet transform on 2D-signals.

# Arguments
- `w₁::AbstractArray{T,2} where T<:Number`: Top left child coefficients.
- `w₂::AbstractArray{T,2} where T<:Number`: Top right child coefficients.
- `w₃::AbstractArray{T,2} where T<:Number`: Bottom left child coefficients.
- `w₄::AbstractArray{T,2} where T<:Number`: Bottom right child coefficients.
- `h::Array{S,1} where S<:Number`: High pass filter.
- `g::Array{S,1} where S<:Number`: Low pass filter.

# Returns
- `::Array{T,2}`: Reconstructed coefficients.
"""
function idwt_step(w₁::AbstractArray{T,2}, w₂::AbstractArray{T,2},
                   w₃::AbstractArray{T,2}, w₄::AbstractArray{T,2},
                   h::Array{S,1}, g::Array{S,1}) where {T<:Number, S<:Number}
    n,m = size(w₁)
    v = Array{T,2}(undef, (2*n,2*m))
    temp = Array{T,2}(undef, (2*n,2*m))
    idwt_step!(v, w₁, w₂, w₃, w₄, h, g, temp)
    return v
end

"""
    idwt_step!(v, w₁, w₂, w₃, w₄, h, g, temp)

Same as 2D version of `idwt_step` but without array allocation.

# Arguments
- `v::AbstractArray{T,2} where T<:Number`: Array allocation for inverse transformed output.
- `w₁::AbstractArray{T,2} where T<:Number`: Array allocation for top left coefficients.
- `w₂::AbstractArray{T,2} where T<:Number`: Array allocation for top right coefficients.
- `w₃::AbstractArray{T,2} where T<:Number`: Array allocation for bottom left coefficients.
- `w₄::AbstractArray{T,2} where T<:Number`: Array allocation for bottom right coefficients.
- `h::Array{S,1} where S<:Number`: High pass filter.
- `g::Array{S,1} where S<:Number`: Low pass filter.
- `temp::AbstractArray{T,2} where T<:Number`: Array allocation for intermediate
  computations.

# Returns
- `v::Array{T,2}`: Reconstructed coefficients.
"""
function idwt_step!(v::AbstractArray{T,2},
                    w₁::AbstractArray{T,2}, w₂::AbstractArray{T,2},
                    w₃::AbstractArray{T,2}, w₄::AbstractArray{T,2},
                    h::Array{S,1}, g::Array{S,1},
                    temp::AbstractArray{T,2}) where {T<:Number, S<:Number}
    # Sanity check
    @assert size(v) == size(temp)
    @assert size(w₁) == size(w₂) == size(w₃) == size(w₄)
    @assert size(w₁,1)*2 == size(v,1)
    @assert size(w₁,2)*2 == size(v,2)

    # Setup
    n,m = size(w₁)

    # --- Inverse transform ---
    # Compute idwt for all rows
    for i in 1:n
        @inbounds temp₁ᵢ = @view temp[i,:]
        @inbounds w₁ᵢ = @view w₁[i,:]
        @inbounds w₂ᵢ = @view w₂[i,:]
        @inbounds idwt_step!(temp₁ᵢ, w₁ᵢ, w₂ᵢ, h, g)

        @inbounds temp₂ᵢ = @view temp[n+i,:]
        @inbounds w₃ᵢ = @view w₃[i,:]
        @inbounds w₄ᵢ = @view w₄[i,:]
        @inbounds idwt_step!(temp₂ᵢ, w₃ᵢ, w₄ᵢ, h, g)
    end
    # Compute idwt for all columns
    for j in 1:(2*m)
        @inbounds vⱼ = @view v[:,j]
        @inbounds temp₁ⱼ = @view temp[1:n,j]
        @inbounds temp₂ⱼ = @view temp[(n+1):end,j]
        @inbounds idwt_step!(vⱼ, temp₁ⱼ, temp₂ⱼ, h, g)
    end
    return v
end

# ----- 1 step of dwt for nD signals -----
# TODO: Implement this function


@safetestset "getpoints, getpointspec and getpointnum" begin
    using PoincareInvariants

    @test getpointspec(1, FirstFinDiffPlan) == 2
    @test getpointspec(50, FirstFinDiffPlan) == 50
    @test getpointspec(345, FirstFinDiffPlan) == 346

    @inferred Matrix{Float32} getpoints(x -> (x, 2x), Float32, 8, FirstFinDiffPlan)
    @inferred Vector{Float64} getpoints(x -> sin(x), Float64, 124, FirstFinDiffPlan)

    @test getpoints(identity, Float64, 4, FirstFinDiffPlan) ≈ [0, 0.25, 0.5, 0.75]
    @test getpoints(identity, Float64, 6, FirstFinDiffPlan) ≈ [n / 6 for n in 0:5]
    @test getpoints(cos, Float64, 124, FirstFinDiffPlan) ≈ [cos(n / 124) for n in 0:123]

    N = 6342
    testpnts = getpoints(identity, Float64, N, FirstFinDiffPlan)
    pnts3 = getpoints(Float32, N, FirstFinDiffPlan) do x
        x, x^2, sin(x)
    end
    @test pnts3 isa Matrix{Float32}
    @test size(pnts3) == (N, 3)

    @test pnts3[:, 1] ≈ testpnts
    @test pnts3[:, 2] ≈ testpnts .* testpnts
    @test pnts3[:, 3] ≈ sin.(testpnts)
end

@safetestset "compute! with FirstFinDiffPlan" begin
    using PoincareInvariants
    using StaticArrays: SVector
    using LinearAlgebra: dot

    T = Float64
    D = 3

    θ(z, t, p) = SVector{3}(p * z[2], -t * z[1], z[3])
    f(x) = ((s, c) = sincospi(2x); SVector{3}(2c,  5s, c + s))

    T = Float64
    D = 3
    N = 6
    fvals = getpoints(f, Float64, N, FirstFinDiffPlan)
    Δx = 1 / N

    testI = sum(1:6) do i
        dfi = if i == 1
            (fvals[2, :] .- fvals[6, :]) ./ (2 * Δx)
        elseif i == 6
            (fvals[1, :] .- fvals[5, :]) ./ (2 * Δx)
        else
            (fvals[i+1, :] .- fvals[i-1, :]) ./ (2 * Δx)
        end

        fi = fvals[i, :]
        return Δx * dot(θ(fi, 2, 3), dfi)
    end

    pinv = FirstPoincareInvariant{T, D}(θ, N, FirstFinDiffPlan{T, D}())
    @test compute!(pinv, fvals, 2, 3) ≈ testI atol=500eps()
end


# In this tutorial, we present the use of Stopping to specify an "unrelated"
# stopping criterion. A typical example is the so-called case of "overfitting",
# where the optimization process is actually designed to approximate another problem.

using ADNLPModels, LinearAlgebra, NLPModels, Plots, Printf, Random, Stopping

# In this tutorial, we will use the classical steepest descent method with an Armijo line-search.

import Stopping.armijo
function armijo(xk, dk, fk, slope, f)
  t = 1.0
  fk_new = f(xk + dk)
  while f(xk + t * dk) > fk + 1.0e-4 * t * slope
    t /= 1.5
    fk_new = f(xk + t * dk)
  end
  return t, fk_new
end

function steepest_descent(stp :: NLPStopping)

  xk = stp.current_state.x
  fk, gk = objgrad(stp.pb, xk)

  OK = update_and_start!(stp, fx = fk, gx = gk)

  @printf "%2s %9s %7s %7s %7s\n" "k" "fk" "||∇f(x)||" "t" "λ"
  @printf "%2d %7.1e %7.1e\n" stp.meta.nb_of_stop fk norm(stp.current_state.current_score)
  while !OK
    dk = - gk
    slope = dot(dk, gk)
    t, fk = armijo(xk, dk, fk, slope, x->obj(stp.pb, x))
    xk += t * dk
    fk, gk = objgrad(stp.pb, xk)

    OK = update_and_stop!(stp, x = xk, fx = fk, gx = gk)

    @printf "%2d %9.2e %7.1e %7.1e %7.1e\n" stp.meta.nb_of_stop fk norm(stp.current_state.current_score) t slope
  end
  return stp
end

# We also generate randomly some data.

Random.seed!(1234)
m, n = 50, 10
A  = rand(m, n)
b  = A * ones(n)
D  = vcat(A, A) + vcat(zeros(m,n), rand(m,n))
Db = vcat(b, b)
rperm = shuffle(1:2m)
Dr = D[rperm,:]
Dbr = Db[rperm,:]

# We initialize two different problems evaluating respectively a training set, and a test set.

f(x, A, b, λ) = norm(A * x - b)^2 + λ * norm(x)^2
train_pb = ADNLPModel(x -> f(x, Dr[1:m,:], Dbr[1:m], 1e-2), zeros(n))
test_pb = ADNLPModel(x -> f(x, Dr[m+1:2m,:], Dbr[m+1:2m], 0.0), zeros(n))

# In this tutorial, the motivation is to use the solver on the `test_pb`, and track the efficiency of the computed solution on the `train_pb`.
# We specialize the stopping structure to store the objective function of both problems in the `stopping_user_struct`, and evaluate them in the `stp.meta.user_check_func!`.

train_check(stp, b) = begin
  stp.stopping_user_struct[:test_obj][stp.meta.nb_of_stop+1] = obj(stp.stopping_user_struct[:test], stp.current_state.x)
  stp.stopping_user_struct[:train_obj][stp.meta.nb_of_stop+1] = obj(stp.pb, stp.current_state.x)
end
train_obj = NaN * ones(101)
test_obj  = NaN * ones(101)
train_stp = NLPStopping(train_pb, user_struct = Dict(:test => test_pb, :train_obj => train_obj, :test_obj => test_obj), user_check_func! = train_check, max_iter = 100)

# We now run the steepest descent algorithm with the `train_stp` stopping.

steepest_descent(train_stp)

# On the following plot in logarithmic scale, we can see that after a number of iterations, the progress made by the solver are no longer improving the other problem.

#hcat(log.(train_stp.stopping_user_struct[:train_obj]), log.(train_stp.stopping_user_struct[:test_obj]))
plot(log.(train_stp.stopping_user_struct[:train_obj]), label=["train obj"])
plot!(log.(train_stp.stopping_user_struct[:test_obj]), label=["test obj"], title="overfitting")

# ![](../assets/overfitting/overfitting.png)

# To overcome this issue, one possibility is to stop the solver when the second is no longer being minimized. The only modification is to set the entry `meta.stopbyuser` to `true`.

train_check_opt(stp, b) = begin
  k = stp.meta.nb_of_stop
  stp.stopping_user_struct[:test_obj][k+1] = obj(stp.stopping_user_struct[:test], stp.current_state.x)
  stp.stopping_user_struct[:train_obj][k+1] = obj(stp.pb, stp.current_state.x)
  diff = k!=0 && stp.stopping_user_struct[:test_obj][k+1] - stp.stopping_user_struct[:train_obj][k+1] > 10
  inc  = k!=0 && stp.stopping_user_struct[:test_obj][k+1] > stp.stopping_user_struct[:test_obj][k]
  if diff && inc
    stp.meta.stopbyuser = true
  end
end
train_stp.meta.user_check_func! = train_check_opt
reset!(train_stp.pb)
reinit!(train_stp, rstate=true, x = zeros(10))
steepest_descent(train_stp)

nb_iter = train_stp.meta.nb_of_stop
hcat(log.(train_stp.stopping_user_struct[:train_obj][1:nb_iter+1]), log.(train_stp.stopping_user_struct[:test_obj][1:nb_iter+1]))
plot(log.(train_stp.stopping_user_struct[:train_obj][1:nb_iter+1]), label=["train obj"])
plot!(log.(train_stp.stopping_user_struct[:test_obj][1:nb_iter+1]), label=["test obj"], title="overfitting")

# ![](../assets/overfitting/overfitting_cut.png)


using ContinuousWavelets, Wavelets, Interpolations, LinearAlgebra
using Test
using FFTW
using Logging
@testset "ContinuousWavelets.jl" begin
    # Write your tests here.
    include("basicTypesAndNumber.jl")
    include("deltaSpikes.jl")
    include("defaultProperties.jl")
    include("inversionTests.jl")
end
# TODO:
#       test averaging types
#            various extra dimensions
#            inverse is actually functional


struct Coordinate{T,F<:Function} <: AbstractArray{T,1}
    u::Vector{T} #Coordinates
    R::F         #Transformation (x,y,z,...) = R(u₁,u₂,u₃,...)
end

# Array Interface for Coordinates
parent(A::T) where {T<:Coordinate} = A.u
size(A::T) where {T<:Coordinate} = size(A.u)
axes(A::T) where {T<:Coordinate} = axes(A.u)
parenttype(::Type{Coordinate{T,F}}) where {T,F} = Vector{T}
IndexStyle(::Type{T}) where {T<:Coordinate} = IndexStyle(parenttype(T))

@propagate_inbounds getindex(A::T, i::Int) where {T<:Coordinate} = A.u[i]
@propagate_inbounds setindex!(A::Coordinate{T}, v::T, i::Int) where {T} = A.u[i] = v

similar(A::Coordinate{T,F}) where {T,F} = Coordinate(Array{T}(undef, size(A)), A.R)
similar(A::Coordinate, ::Type{T}) where {T} = Coordinate(Array{T}(undef, size(A)), A.R)
function similar(A::Coordinate, ::Type{T}, dims::Tuple{Vararg{Int64,N}}) where {T,N}
    return Coordinate(Array{T}(undef,dims), A.R)
end

# Standard Transformations
function Cartesian(u)
    u
end

function CartesianCoordinate(u)
    Coordinate(u,Cartesian)
end

function Cylindrical(u)
    # u -> (r,θ,z) r ∈ [0,∞), θ ∈ [0,2π), z ∈ (-∞,∞)
    r = u[1]
    θ = u[2]
    z = u[3]
    [r*cos(θ), r*sin(θ), z]
end

function CylindricalCoordinate(u)
    Coordinate(u,Cylindrical)
end

function Spherical(u)
    # u -> (r,θ,ϕ) r ∈ [0,∞), θ ∈ [0,2π), ϕ ∈ [0,π]
    r = u[1]
    θ = u[2]
    ϕ = u[3]
    [r*cos(θ)*sin(ϕ), r*sin(θ)*sin(ϕ), r*cos(ϕ)]
end

function SphericalCoordinate(u)
    Coordinate(u,Spherical)
end


using SparseArrays
using LinearAlgebra
using Random

"""
`hyperkron_graph`
==================
Code to generate a HyperKron Graph using the grass-hopping algorithm.

The original code for this method can be found at:
https://www.cs.purdue.edu/homes/dgleich/codes/hyperkron/

The model definition can be found in the following paper:
https://arxiv.org/abs/1809.03488

Input
-----
- `K`: The initiator tensor
- `k`: The power for the tensor
- `motif`: optional parameter. You can define your own motif to add to the model. Default is undirected triangle.

Functions
---------
-`hyperkron_graph(K,k)`
-`hyperkron_graph(K,k;triangle,False)`

Output
------
- A matrix network type for the hyperkron graph
- A list of hyperedges

Example
--------
A,hedges = hyperkron_graph(kron_params(0.99, 0.2, 0.3, 0.05), 5)
hyperkron_graph(K,k; motif=:triangle, onlytris::Bool=false)

The code calls "hypergraph_to_edges_with_" 'motif' in order
to generate the graph to return. Consequently, you can implement
your own motifs via this routine.
"""
function hyperkron_graph(K,k;
    motif_to_graph::Function = hyperedges_to_graph_with_triangles, kwargs...)

  hedges = fast_hyperkron_edges(K,k; kwargs...)
  return motif_to_graph(size(K,1)^k, hedges), hedges
end

"""
`_next_region!`
===============
Increment to the next region of a Kronecker graph

Input
-----
-`cur`: The current region
-`m`: The total number of elements in the initiated tensor (ie 8 for a 2x2x2 initiator tensor).

Output
------
Outputs the next region
"""
@inline function _next_region!(cur::AbstractArray{T,1}, m::Integer) where T <: Integer
  lastk = length(cur)
  for k=length(cur):-1:1
    lastk = k              # save the last state
    cur[k] += 1            # increment the last element
    if cur[k] == m+1       # if there is spill
      if k > 1             # if there is an array
        continue # recur on prefix
      else
        cur[k] = 0
      end
    end
    break
  end
  for k=lastk+1:length(cur)
    cur[k] = cur[k-1]
  end
  cur
end

"""
`_first_region`
===============
Gives the first region.

Input
-----
-`a`: The vectorized initiator tensor
-`k`: The power of the HyperKron model
Output
------
An array of all ones, representing the first region.
"""
function _first_region(a::AbstractArray,k::Integer)
  return ones(UInt32,k)
end

"""
`num_multiset_permutations`
===========================
Returns the number of multiset permutations of elements in the given array.

Input
-----
-`ms`: A sorted array of numbers, which represent the values in the multiset.
-`start_pos`: Default is 1.

Output
------
The number of multiset permutations.
"""
function num_multiset_permutations(ms::AbstractArray{T,1}, start_pos::Integer = 1) where T<:Integer
  nperm = 1
  count = 1
  countfac = 1
  @inbounds for i in start_pos+1:length(ms)
    nperm *= (i-start_pos+1)
    if ms[i] == ms[i-1]
      count += 1
      countfac *= count
    else
      nperm = div(nperm,countfac)
      # new element
      count = 1
      countfac = 1
    end
  end
  nperm = div(nperm,countfac)
end

"""
`_next_distinct_character`
==========================
Find the next distinct character after a[k]
Returns the index where it occurs or length(a)+1

Input
-----
-`a`: A region in the HyperKron tensor
-`k`: The current character (between 1 and m)
-`m`: Length of a.

Output
------
The index where the next character occurs.
"""
@inline function _next_distinct_character(a, k::Integer, m::Integer)
  # check for easy out
  if k>=m
    return m+1
  else
    ak = a[k]
    if ak != a[k+1] # many cases
      return k+1
    elseif ak == a[m] # some cases
      return m+1
    else
      # we have to search, so there are probably many dups
      # since we assume sorted, we can bisect
      lo = 1
      hi = m-k # we need to search [k+lo:k+hi]
      while hi - lo > 2
        mid = (hi + lo) >> 1
        if ak == a[k+mid]
          lo = mid
        else
          hi = mid
        end
      end
      ak != a[k+lo+1] && return k+lo+1
      return k+lo+2
    end
  end
end

"""
`unrank5!`
==========
This version doesn't use recursion, and unranks the sorted set ms in place
It also gets the multiplicity of each element to update nperm without
recomputing it from scratch, it also can take in the total number
of permutations and just update as we go.
This version tries to avoid integer division by storing nperm as a float

Input
-----
-`ms`: Multiset
-`n`: Current rank
-`nperm`: The number of multiset permutations of the region
-`m`: Length of ms

Output
------
Nothing, it modifies ms.
"""
@inline function unrank5!(ms::AbstractArray{T,1}, n::Integer, nperm, m) where T<:Integer
  multcur = 0
  imultcur = 1.0
  multnext = 0
  npermf = float(nperm)
  @inbounds for k=1:m # for each location in the output
    if n == 1
      break
    end

    if multcur == 0 # update
      multcur = _next_distinct_character(ms, k, m) - k # multiplicity of the current element
      imultcur = 1.0/multcur
    end

    # update nperm for removing multcur
    npermf *= multcur
    npermf /= (m-k+1) # shrink the length
    nperm = round(typeof(nperm),npermf)

    #=
    if nperm != num_multiset_permutations(ms, k+1)
      @show 0, ms, k, num_multiset_permutations(ms, k+1), nperm
    end
    @assert nperm == num_multiset_permutations(ms, k+1)
    =#

    if n <= nperm # this means we start with ms[k]
      multcur -= 1
      if multcur != 0
        imultcur = 1.0/multcur
      end
      continue
    else # we need to search
      n -= nperm

      if k+multcur <= m
        if ms[k] == ms[k+multcur]
          #@show ms, k, _next_distinct_character(ms,k,m), multcur
          @assert ms[k] != ms[k+multcur]
        end
      end

      pos = k+multcur
      while pos <= m
        # we are going to swap ms[k] and ms[pos]
        # but to update, we need to know the multiplicity of ms[pos]

        multnext = _next_distinct_character(ms,pos,m) - pos

        # so the element ms[pos] has multiplicity multnext
        # and element ms[k] has multiplicity multcur-1

        ms[pos], ms[k] = ms[k], ms[pos] # swap leading positions
        npermf *= multnext
        npermf *= imultcur
        nperm = round(typeof(nperm),npermf)

        #=
        if nperm != num_multiset_permutations(ms, k+1)
          @show 1, ms, k, num_multiset_permutations(ms, k+1), nperm
        end
        @assert nperm == num_multiset_permutations(ms, k+1)
        =#

        if n <= nperm
          break
        else
          n -= nperm
          pos += multnext
          multcur = multnext
          imultcur = 1.0/multcur
        end
      end

      multcur = 0 # reset the search
    end
  end
  return ms
end
unrank5!(ms, n) = unrank5!(ms, n, num_multiset_permutations(ms), length(ms))

"""
`_morton_decode3`
=================
Turns an index from a k-dimensional multiplication table into the corresponding index in the 3-dimensional tensor product.

Input
-----
-`mind`: Length k (where k is the number of kronecker products to take) array of indices in the k-dimensional multiplication table
-`n`: The side length of the initiator tensor
-`sz`: The full size of the initiator tensor

Output
------
Length 3 array, representing the corresponding indices in the tensor product.

Example
-------
_morton_decode3([8,8,8,8],2,(2,2,2))
"""
@inline function _morton_decode3(mind::AbstractArray{T,1}, n, sz) where T<:Integer
  row = 0
  col = 0
  tub = 0
  base = 1
  for val in mind
    # CU: ind2sub() was deprecated in Julia 0.7, changed to a new way instead
    s1,s2,s3 = Base._ind2sub(sz, val) #basically backward map where base keeps track of the block size n^
    row += base*(s1-1)
    col += base*(s2-1)
    tub += base*(s3-1)
    base *= n
  end
  return (row+1, col+1, tub+1)
end

#_randgeo(p) = ceil(Int,-randexp() / log1p(-p)) # jsut a copy of Distributions.jl
#_randgeo(p) = ceil(Int,-randexp() / log1p(-p)) # jsut a copy of Distributions.jl
#_randgeo_true(p) = ceil(Int,-randexp() / log1p(-p)) # jsut a copy of Distributions.jl
#_randgeo(p) = _randgeo_true(max(0.01*p, p + 0.0*p*randn()))
_randgeo(p) = ceil(Int,-randexp() / log1p(-p))

"""
`_generate_region!`
==================
Given a region of the tensor, do the grass-hopping procedure to generate hyperedges.

Input
-----
-`ei`: First indices of hyperedges
-`ej`: Second indices of hyperedges
-`ek`: Third indices of hyperedges
-`r`: Region
-`e`: Edge in Region
-`p`: The probability of edges within this particular region.
-`small_n`: The length of one dimension of the initiator matrix.
-`sz`: The full dimensions of the initiator tensor.
-`onlytris`: Boolean
-`onlysym`: Boolean

Output
------
Nothing, modifies input.
"""
function _generate_region!(
    ei::Array{Ta}, ej::Array{Ta}, ek::Array{Ta},
    r::AbstractArray{Tb,1},
    e::AbstractArray{Tb,1},
    p, small_n::Integer, sz,
    onlytris::Bool, onlysym::Bool) where {Ta, Tb <:Integer}

    N = num_multiset_permutations(r) # total area
    m = length(r)
    i = 0

    # ugh, do we need this? should make these tolerances.
    if N*p < 1.0e-12 || p < 1.0e-15
      return
    end

    gap = _randgeo(p)

    while i+gap <= N
      i += gap
      copy!(e, r)
      #@show e, i, N, m
      mult_edge = unrank5!(e, i, N, m) # generate the ith permutation
      #src, dst = _morton_decode(mult_edge, small_n)
      src,dst,tub = _morton_decode3(mult_edge, small_n, sz)
      # only add the edge if it's in the lower region of the matrix.
      # This means we are assuming a symmetric generation.
      if (onlysym && src <= dst <= tub) || !onlysym
        if (onlytris && (src != dst != tub != src)) || !onlytris
          push!(ei, src)
          push!(ej, dst)
          push!(ek, tub)
        end
      end
      gap = _randgeo(p)
    end
end

"""
`fast_hyperkron_edges`
======================
Returns the hyperedges of the Kronecker model

Input
-----
-`K`: Initial tensor for hyperkron model
-`k`: Power for the hyperkron model

Output
------
ei,ej,ek: Three arrays which hold the indices for hyperedges
"""
function fast_hyperkron_edges(K,k;
  noise::Float64=0.0,onlytris::Bool=false,onlysym::Bool=true)
  n = size(K,1)
  sz = size(K)
  v = vec(K) # vectorized

  vn = v/sum(v)
  V = collect(v for _ in 1:k) # create a set of parameters for each level
  #V = collect(max.(0.0,min.(2.0,sum(v).*normalize!(vec(kron_params(vn[1],vn[2]+noise*(2*rand()-1.0),vn[4]+noise*(2*rand()-1.0),vn[8])),1))) for _ in 1:k )
  #@show V

  # Dense = adjacency matrix, every spot is filled in, even if there's a 0. Very large graph = expensive to store
  # Sparse = Store a list of non-zeroes edges. For i and j, there will be two one-dimension array

  # hold edges
  ei = zeros(Int,0)
  ej = similar(ei)
  ek = similar(ei)

  nregions = 0
  # v is the vectoriezd tensor
  region = _first_region(v, k)

  edge_in_region = similar(region) # allocated once to avoid lots of allocs
  while region[1] != 0
    nregions += 1
    # compute the probability of erdos-reyes regions
    p = 1.0
    level = 1
    for j in region
      p *= V[level][j]
      level += 1
    end
    _generate_region!(ei, ej, ek, region, edge_in_region, p, n, sz, onlytris, onlysym)
    _next_region!(region, length(v))
  end
  return ei, ej, ek
end

"""
`kron_params`
=============
Turn 4 parameters into a 2x2x2 symmetric tensor representation for the hyperkron_graph function

Input
-----
-`a`: probability between 0 and 1
-`b`: probability between 0 and 1
-`c`: probability between 0 and 1
-`d`: probability between 0 and 1

Output
Correctly formatted tensor parameters

"""
function kron_params(a,b,c,d)
  K = zeros(2,2,2)
  K[1,1,1] = a
  K[1,1,2] = b; K[1,2,1] = b;   K[2,1,1] = b
  K[1,2,2] = c; K[2,1,2] = c;   K[2,2,1] = c
  K[2,2,2] = d
  return K
end

"""
`hyperedges_to_graph_with_triangles`
====================================
Turns a set of hyperedges into a graph.

Input
-----
-`n`: The size of the graph
-`hedges`: The hyperedges

Output
------
A MatrixNetwork graph based on the given hyperedges.
"""
function hyperedges_to_graph_with_triangles(n::Int, hedges)
  ei = zeros(Int64,0)
  ej = zeros(Int64,0)
  for i=1:length(hedges[1])
    push!(ei, hedges[1][i]); push!(ej, hedges[2][i]) # (i -> j)
    push!(ei, hedges[1][i]); push!(ej, hedges[3][i] ) # (i -> k)
    push!(ei, hedges[2][i]); push!(ej, hedges[3][i] ) # (j -> k)
  end
  A = sparse(ei,ej,1.0,n,n)
  A = max.(A,A') # symmetrize
  A = A - spdiagm(0 => diag(A)) #remove diagonal entries
  fill!(A.nzval, 1.0) # set all non-zeros
  return A
end


using Test
using LinearAlgebra
using PolynomialBasis
using ImplicitDomainQuadrature
using HDGElasticity

function curve_length(imap,quad)
    l = 0.0
    for (p,w) in quad
        detjac = HDGElasticity.determinant_jacobian(imap,p)
        l += detjac*w
    end
    return l
end

function curve_length(imap,quad,facescale)
    l = 0.0
    for (idx,(p,w)) in enumerate(quad)
        detjac = HDGElasticity.determinant_jacobian(imap,p)
        l += detjac*facescale[idx]*w
    end
    return l
end

function curve_normals(imap,points)
    npts = length(points)
    normals = zeros(2,npts)
    for (idx,x) in enumerate(points)
        t = gradient(imap,x)
        n = [-t[2],t[1]]
        normals[:,idx] .= n/norm(n)
    end
    return normals
end

imap = InterpolatingPolynomial(2,1,2)
icoeffs = [-1.,-1.,0.,0.,1.,-1.]
update!(imap,icoeffs)
quad = tensor_product_quadrature(1,5)
refl = curve_length(imap,quad)
testlength = sqrt(5) + 0.5*asinh(2.0)
@test isapprox(refl,testlength,atol=1e-2)

cellmap = HDGElasticity.CellMap([0.,0.],[2.,1.])
refnormals = curve_normals(imap,quad.points)
invjac = HDGElasticity.inverse_jacobian(cellmap)
transformed_normals = diagm(invjac)*refnormals
magnitude = mapslices(x->norm(x),transformed_normals,dims=1)
normals = hcat([transformed_normals[:,i]/magnitude[i] for i = 1:size(magnitude)[2]]...)
jac = HDGElasticity.jacobian(cellmap)
reftangents = hcat([gradient(imap,quad.points[:,i]) for i = 1:length(quad)]...)
tangents = diagm(jac)*reftangents

facescale = HDGElasticity.scale_area(cellmap,normals)
transformed_length = curve_length(imap,quad,facescale)
testlength = sqrt(2) + asinh(1)
@test isapprox(transformed_length,testlength,atol=1e-2)


puzzleinput = readlines("inputs/day18.txt")

# First Half

struct My1
    val::Int
end
# Define MY numbers that follow different rules

import Base.+, Base.-

+(x::My1, y::My1) = My1(x.val + y.val)
# For MY numbers, '+' acts like the regular one

-(x::My1, y::My1) = My1(x.val * y.val)
# For MY numbers, '*' has the same precedence of '-' so, to mantain
# conventional precedence rules, the '*' operator is replaced by '-'

function my1(s)
    s = replace(s, r"(\d)" => s"My1(\1)")
    replace(s, r"\*" => s"-")
end
# Replace in the expression, numbers with MY numbers
# and operators with MY operators

evaluate1(s) = eval(Meta.parse(my1(s))).val
# After reaplacement evaluation is done with MY rules

sum(evaluate1.(puzzleinput))

# Second Half

# As the firs half, only rules change: now for MY numbers, '+' has the
# precedence rule of '*' and viceversa

import Base.*

struct My2
    val::Int
end

+(x::My2, y::My2) = My2(x.val * y.val)
*(x::My2, y::My2) = My2(x.val + y.val)

function my2(s)
    s = replace(s, r"(\d)" => s"My2(\1)")
    s = replace(s, r"\*" => s".")
    s = replace(s, r"\+" => s"*")
    replace(s, r"\." => s"+")
end

evaluate2(s) = eval(Meta.parse(my2(s))).val

sum(evaluate2.(puzzleinput))