using DFTK
using Plots

# This example plots the free-electron bands for a 1D system.
# TODO Convert into an example in the docs
#      show how one could add a potential to this and see the bands change.

lattice = diagm([5., 0, 0])
model   = Model(lattice; n_electrons=4, terms=[Kinetic()])
basis   = PlaneWaveBasis(model; Ecut=300, kgrid=(1, 1, 1));

n_bands = 6
ρ0 = guess_density(basis)  # Just dummy, has no meaning in this model
p = plot_bandstructure(basis, ρ0, n_bands, kline_density=15)


function probabilityM1(s₁::BigInt, t₁::BigFloat, n::BigInt)
    pM1 = factorial(s₁) ./ (exp(t₁) * (n + 1) ^(s₁ + 1))
    pM2 = (factorial(n) * factorial(s₁)) ./ factorial(n + s₁ + 1)
    p = pM1 ./(pM1 + pM2)
    p = Float64(p)
    return p
end

s1calc(x) = sum(x)
t1calc(x::Array{BigInt, 1}) = Float64(sum(log.(map(a -> factorial(a), x))))
t1calc(x::Array{Int64, 1}) = sum(log.(map(a -> factorial(a), x)))

function poissonsimulator(params, cst, targetdata)

    λ = params[1]
    simdata = rand(Poisson(λ), 100)
    s₁ = s1calc(simdata)
    if sum(simdata.>19) > 0
        t₁ = t1calc(map(x -> BigInt(x), simdata))
    else
        t₁ = t1calc(simdata)
    end
    euclidean(targetdata, [s₁, t₁]), 1
    #euclidean(targetdata[2], [s₁, t₁][2]), 1
end

function geometricsimulator(params, cst, targetdata)

    μ = params[1]
    simdata = rand(Geometric(μ), 100)
    s₁ = s1calc(simdata)
    if sum(simdata.>19) > 0
        t₁ = t1calc(map(x -> BigInt(x), simdata))
    else
        t₁ = t1calc(simdata)
    end
    euclidean(targetdata, [s₁, t₁]), 1
    #euclidean(targetdata[2], [s₁, t₁][2]), 1
end

function generatedata()
    λ = 0.5
    n = 100
    data = rand(Poisson(λ), n)
    s₁ = s1calc(data)
    t₁ = t1calc(data)
    pM1 = probabilityM1(BigInt(s₁), BigFloat(t₁), BigInt(n))

  return [s₁, t₁], pM1
end

################################################################
println("Test Bayes factors are calculated correctly (within 5% of true value)")
srand(1234)

cst = [[i] for i in 1:2]

ABCsetupsmc = ABCSMCModel([poissonsimulator, geometricsimulator], [1, 1], 1.0,
[Prior([Exponential(1)]), Prior([Uniform(0.0, 1.0)])];
nparticles = 500, maxiterations = 10^7)

ABCsetuprej = ABCRejectionModel([poissonsimulator, geometricsimulator], [1, 1], 1.0,
[Prior([Exponential(1)]), Prior([Uniform(0.0, 1.0)])];
nparticles = 500, maxiterations = 10^7)

td, pM1 = generatedata()

println("\t Checking ABC SMC model selection")
@time abcressmc = runabc(ABCsetupsmc, td);
@test isapprox(pM1, abcressmc.modelprob[1], rtol = 0.05)

println("\t Checking ABC rejection model selection")
@time abcresrej = runabc(ABCsetuprej, td);
@test isapprox(pM1, abcresrej.modelfreq[1], rtol = 0.05)

println("\t Check no errors arising from plotting")

plotmodelposterior(abcressmc, save = true)
@test isfile("ABCSMCmodelposteriors.pdf")
rm("ABCSMCmodelposteriors.pdf")

plotmodelposterior(abcresrej, save = true)
@test isfile("ABCRejectionmodelposteriors.pdf")
rm("ABCRejectionmodelposteriors.pdf")

plotparameterposterior(abcressmc, 1, save = true)
@test isfile("ABCSMCparameterposteriors-model1.pdf")
rm(("ABCSMCparameterposteriors-model1.pdf"))

plotparameterposterior(abcresrej, 1, save = true)
@test isfile("ABCRejectionparameterposteriors-model1.pdf")
rm("ABCRejectionparameterposteriors-model1.pdf")

writeoutput(abcressmc)
@test isfile("SMCModel-outputmodel1.txt")
@test isfile("SMCModel-outputmodel2.txt")
@test isfile("SMCModel-outputmodelprobabilities.txt")
rm("SMCModel-outputmodel1.txt")
rm("SMCModel-outputmodel2.txt")
rm("SMCModel-outputmodelprobabilities.txt")

writeoutput(abcresrej)
@test isfile("RejectionModel-outputmodel1.txt")
@test isfile("RejectionModel-outputmodel2.txt")
@test isfile("RejectionModel-outputmodelprobabilities.txt")
rm("RejectionModel-outputmodel1.txt")
rm("RejectionModel-outputmodel2.txt")
rm("RejectionModel-outputmodelprobabilities.txt")


using GeometricFlux
using Flux
using Flux: onehotbatch, onecold, logitcrossentropy, throttle
using Flux: @epochs
using JLD2
using Statistics
using SparseArrays
using Graphs.SimpleGraphs
using CUDA
using Random

Random.seed!([0x6044b4da, 0xd873e4f9, 0x59d90c0a, 0xde01aa81])

@load "data/cora_features.jld2" features
@load "data/cora_labels.jld2" labels
@load "data/cora_graph.jld2" g

num_nodes = 2708
num_features = 1433
hidden = 16
target_catg = 7
epochs = 100

## Preprocessing data
train_X = Matrix{Float32}(features) |> gpu  # dim: num_features * num_nodes
train_y = Matrix{Float32}(labels) |> gpu  # dim: target_catg * num_nodes
fg = FeaturedGraph(g) |> gpu

## Model
model = Chain(GCNConv(fg, num_features=>hidden, relu),
              Dropout(0.5),
              GCNConv(fg, hidden=>target_catg),
              ) |> gpu

## Loss
loss(x, y) = logitcrossentropy(model(x), y)
accuracy(x, y) = mean(onecold(softmax(cpu(model(x)))) .== onecold(cpu(y)))

## Training
ps = Flux.params(model)
train_data = [(train_X, train_y)]
opt = ADAM(0.01)
evalcb() = @show(accuracy(train_X, train_y))

@epochs epochs Flux.train!(loss, ps, train_data, opt, cb=throttle(evalcb, 10))


module RSCG
    using LinearAlgebra
    using LinearMaps
    using SparseArrays

    export greensfunctions

    @doc raw"""
        greensfunctions(i::Integer,j::Integer,σ::Array{ComplexF64,1},A)

    Calculate the matrix element of the Green's function:
    ```math
    G_{ij}(\sigma_k) = \left[ (\sigma_k I - A)^{-1} \right]_{ij},
    ```
    with the use of the reduced-shifted conjugate gradient method
    (See, Y. Nagai, Y. Shinohara, Y. Futamura, and T. Sakurai,[arXiv:1607.03992v2 or DOI:10.7566/JPSJ.86.014708]).
    One can obtain ``G_{ij}(\sigma_k)`` with different frequencies ``\sigma_k``, simultaneously.

    Inputs:

    * `i` :index of the Green's function

    * `j` :index of the Green's function

    * `σ` :frequencies

    * `A` :hermitian matrix. We can use Arrays,LinearMaps, SparseArrays

    * `eps` :residual (optional) Default:`1e-12`

    * `maximumsteps` : maximum number of steps (optional) Default:`20000`

    Output:
    * `Gij[1:M]`: the matrix element Green's functions at M frequencies defined by ``\sigma_k``.
    """
    function greensfunctions(i::Integer,j::Integer,σ,A;eps=1e-12,maximumsteps=20000)

        M=length(σ)
        N=size(A,1)
        atype = eltype(A)
        σtype = eltype(σ)
        b = zeros(atype,N)
        b[j] = 1.0

    #--Line 2 in Table III.
        x = zeros(atype,N)
        r = copy(b)
        p = copy(b)
        αm = 1.0
        βm = 0.0

        m = 1
    #--
        Σ =zeros(atype,m)
        Σ[1] = b[i] #Line 3

        Θ = zeros(σtype,M)
        Π = ones(σtype,M,m)
        for mm=1:m
            Π[:,mm] *= Σ[mm]
        end
        ρk = ones(σtype,M)
        ρkm = copy(ρk)
        ρkp = copy(ρk)
        Ap = similar(p)

        for k=0:maximumsteps
            mul!(Ap,A,-p)
            #A_mul_B!(Ap,A,-p)
            rnorm = dot(r,r)
            α = rnorm/dot(p,Ap)
            @. x += α*p #Line 7
            @. r += -α*Ap #Line 8
            β = r'*r/rnorm #Line9
            @. p = r + β*p #Line 10

            Σ[1] = r[i] #Line 11

            for j = 1:M
                if abs(ρk[j]) > eps
                    ρkp[j] = ρk[j]*ρkm[j]*αm/(ρkm[j]*αm*(1.0+α*σ[j])+α*βm*(ρkm[j]-ρk[j]))#Line 13
                    αkj = α*ρkp[j]/ρk[j]#Line 14
                    Θ[j] += αkj*Π[j,1] #Line 15
                    βkj = ((ρkp[j]/ρk[j])^2)*β #Line 16
                    Π[j,:] = ρkp[j]*Σ+ βkj*Π[j,:] #Line 17
                    ρkm[j] = ρk[j]
                    ρk[j] = ρkp[j]
                end

            end
            αm = α
            βm = β
            hi = real(rnorm)*maximum(abs.(ρk))
            if hi < eps
                return Θ
            end
        end

        println("After $maximumsteps steps, this was not converged")
        return Θ

    end

    @doc raw"""
        greensfunctions(vec_left::Array{<:Integer,1},j::Integer,σ::Array{ComplexF64,1},A)

    Calculate the matrix element of the Green's function:
    ```math
    G_{ij}(\sigma_k) = \left[ (\sigma_k I - A)^{-1} \right]_{ij},
    ```
    with the use of the reduced-shifted conjugate gradient method
    (See, Y. Nagai, Y. Shinohara, Y. Futamura, and T. Sakurai,[arXiv:1607.03992v2 or DOI:10.7566/JPSJ.86.014708]).
    One can obtain ``G_{ij}(\sigma_k)`` with different frequencies ``\sigma_k``, simultaneously.

    Inputs:

    * `vec_left` :i indices of the Green's function

    * `j` :index of the Green's function

    * `σ` :frequencies

    * `A` :hermitian matrix. We can use Arrays,LinearMaps, SparseArrays

    * `eps` :residual (optional) Default:`1e-12`

    * `maximumsteps` : maximum number of steps (optional) Default:`20000`

    Output:
    * `Gij[1:M,1:length(vec_left)]`: the matrix element Green's functions at M frequencies defined by ``\sigma_k``.
    """
    function greensfunctions(vec_left::Array{<:Integer,1},j::Integer,σ,A;eps=1e-12,maximumsteps=20000)

        M=length(σ)
        N=size(A,1)
        atype = eltype(A)
        σtype = eltype(σ)
        b = zeros(atype,N)
        b[j] = 1.0
        m = length(vec_left)

    #--Line 2 in Table III.
        x = zeros(atype,N)
        r = copy(b)
        p = copy(b)
        αm = 1.0
        βm = 0.0

    #--
        Σ =zeros(atype,m)
        for mm=1:m
            Σ[mm] = b[vec_left[mm]] #Line 3
        end

        Θ = zeros(σtype,M,m)
        Π = ones(σtype,M,m)
        for mm=1:m
            Π[:,mm] *= Σ[mm]
        end
        ρk = ones(σtype,M)
        ρkm = copy(ρk)
        ρkp = copy(ρk)
        Ap = similar(p)

        for k=0:maximumsteps
            mul!(Ap,A,-p)
            #A_mul_B!(Ap,A,-p)
            rnorm = dot(r,r)
            α = rnorm/dot(p,Ap)
            @. x += α*p #Line 7
            @. r += -α*Ap #Line 8
            β = r'*r/rnorm #Line9
            @. p = r + β*p #Line 10

            for mm=1:m
                Σ[mm] = r[vec_left[mm]] #Line 11
            end

            for j = 1:M
                update = ifelse(abs(ρk[j]) > eps,true,false)
                if update
                    ρkp[j] = ρk[j]*ρkm[j]*αm/(ρkm[j]*αm*(1.0+α*σ[j])+α*βm*(ρkm[j]-ρk[j]))#Line 13
                    αkj = α*ρkp[j]/ρk[j]#Line 14
                    @. Θ[j,:] += αkj*Π[j,:] #Line 15
                    βkj = ((ρkp[j]/ρk[j])^2)*β #Line 16
                    Π[j,:] = ρkp[j]*Σ+ βkj*Π[j,:] #Line 17

                end
                ρkm[j] = ρk[j]
                ρk[j] = ρkp[j]
            end
            αm = α
            βm = β
            hi = real(rnorm)*maximum(abs.(ρk))
            if hi < eps
                return Θ
            end
        end

        println("After $maximumsteps steps, this was not converged")
        return Θ

    end

end # module


export ## Methods
       unitary_propagator,
       unitary_evolution,
       liouvillian_propagator,
       liouvillian_evolution

using ExpmV
import Distributed

function expm_eigen(A::Matrix, t)
    #Calculates exp(t*A) via eigenvalue decomposition and assuming Hermitian matrix
    F = LinearAlgebra.Hermitian(A)
    F_vecs = LinearAlgebra.eigvecs(F)
    F_vals = LinearAlgebra.eigvals(F)

    return F_vecs * LinearAlgebra.Diagonal(exp.(t*F_vals)) * F_vecs'
end

function unitary_propagator(sys::CompositeQSystem,
                            timeStep::Float64,
                            startTime::Float64,
                            endTime::Float64;
                            parallelize=true)

    #Preallocate Hamiltonian memory
    Ham = zeros(ComplexF64, (dim(sys), dim(sys)))

    times = startTime:timeStep:(endTime-timeStep)

    if length(times) < 1
        error("Time step is too small")
    end

    if parallelize
        Uprop = Distributed.@distributed (*) for time = times
            #a *= b expands to a = a*b
            hamiltonian_add!(Ham, sys, time)
            expm_eigen(Ham, 1im*2pi*timeStep)
        end
    else
        Uprop = eye(dim(sys))
        for time = times
            #a *= b expands to a = a*b
            hamiltonian_add!(Ham, sys, time)
            Uprop *= expm_eigen(Ham, 1im*2pi*timeStep)
        end
    end

    if (endTime-times[end]) > timeStep
        hamiltonian_add!(Ham, sys, times[end]+timeStep)
        Uprop *= expm_eigen(Ham, 1im*2pi*(endTime-times[end]-timeStep))
    end

    return Uprop'
end

function unitary_evolution(state::Vector{<:Number},
                           sys::CompositeQSystem,
                           timeStep::Float64,
                           startTime::Float64,
                           endTime::Float64)

    state_cp = copy(state)

    #Preallocate Hamiltonian memory
    Ham = spzeros(ComplexF64, dim(sys), dim(sys))

    times = startTime:timeStep:(endTime-timeStep)

    if length(times) < 1
        error("Time step is too small")
    end

    Uprop = eye(dim(sys))
    for time = times
        hamiltonian_add!(Ham, sys, time)
        state_cp = expmv(-1im*2pi*timeStep,Ham,state_cp)
    end

    if (endTime-times[end]) > timeStep
        hamiltonian_add!(Ham, sys, times[end]+timeStep)
        state_cp = expmv(-1im*2pi*(endTime-times[end]-timeStep),Ham,state_cp)
    end

    return state_cp
end

function liouvillian_propagator(sys::CompositeQSystem,
                                timeStep::Float64,
                                startTime::Float64,
                                endTime::Float64;
                                parallelize=true)

    #Preallocate memory
    liouv = zeros(ComplexF64, dim(sys)^2, dim(sys)^2)

    times = startTime:timeStep:(endTime-timeStep)

    if length(times) < 1
        error("Time step is too small")
    end

    if parallelize
        Lprop = Distributed.@distributed (*) for time = times
            liouvillian_dual_add!(liouv, sys, time)
            exp(2pi*timeStep*liouv)
        end
    else
        Lprop = eye(dim(sys))
        for time = times
            liouvillian_dual_add!(liouv, sys, time)
            Lprop *= exp(2pi*timeStep*liouv)
        end
    end

    if (endTime-times[end]) > timeStep
        liouvillian_dual_add!(liouv, sys, times[end]+timeStep)
        Lprop *= exp(2pi*(endTime-times[end]-timeStep)*liouv)
    end

    return Lprop'
end

function liouvillian_evolution(state::Matrix{<:Number},
                                          sys::CompositeQSystem,
                                          timeStep::Float64,
                                          startTime::Float64,
                                          endTime::Float64)

    state_cp = copy(state[:])

    #Preallocate memory
    liouv = spzeros(ComplexF64, dim(sys)^2, dim(sys)^2)

    times = startTime:timeStep:(endTime-timeStep)

    if length(times) < 1
        error("Time step is too small")
    end

    Lprop = speye(dim(sys))
    for time = times
        liouvillian_add!(liouv, sys, time)
        state_cp = expmv(2pi*timeStep,liouv,state_cp)
    end

    if (endTime-times[end]) > timeStep
        liouvillian_add!(liouv, sys, times[end]+timeStep)
        state_cp = expmv(2pi*(endTime-times[end]-timeStep),liouv,state_cp)
    end

    return reshape(state_cp,size(state,1),size(state,2))
end


f = x->0;
u_exact = x->x;

a = 0;
b = 1;
n = 9;

problem = FiniteDifferenceBVPProblem(0, 1, n, f, DirichletBC(0), DirichletBC(1));
assemble_system!(problem);
u = solve_bvp(problem);
err = @. problem.x - u;
# check error
norm(err, Inf)< 1e-14


module DA_Nlayer_functionTests

using Test
using LightPropagation

# CW comparison of N-layer cylinder to semi-infinite
# note that for large layer thicknesses and radii many more besselroots are needed

### test at multiple SDS

# ρ = 0.0 cm
cylinder_data = Nlayer_cylinder(ρ = 0.0, a = 100.0, l = (10.0, 10.0, 10.0, 10.0), N_J0Roots = 10000)
@test fluence_DA_semiinf_CW(0.0, 0.1, 10.0) ≈ fluence_DA_Nlay_cylinder_CW(cylinder_data)

# ρ = 1.0 cm
cylinder_data = Nlayer_cylinder(ρ = 1.0, a = 100.0, l = (10.0, 10.0, 10.0, 10.0), N_J0Roots = 10000)
@test fluence_DA_semiinf_CW(1.0, 0.1, 10.0) ≈ fluence_DA_Nlay_cylinder_CW(cylinder_data)

# ρ = 4.0 cm
cylinder_data = Nlayer_cylinder(ρ = 4.0, a = 100.0, l = (10.0, 10.0, 10.0, 10.0), N_J0Roots = 10000)
@test fluence_DA_semiinf_CW(4.0, 0.1, 10.0) ≈ fluence_DA_Nlay_cylinder_CW(cylinder_data)

# ρ = 8.0 cm; for long SDS you need more besselroots or decrease the dimensions of cylinder
cylinder_data = Nlayer_cylinder(ρ = 8.0, a = 100.0, l = (10.0, 10.0, 10.0, 10.0),N_J0Roots = 10000)
@test isapprox(fluence_DA_semiinf_CW(8.0, 0.1, 10.0), fluence_DA_Nlay_cylinder_CW(cylinder_data), rtol=1e-6)

### test that 2, 3, 4 layers equal with same optical properties
cylinder_4 = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0, 10.0, 10.0), μa = (0.1, 0.1, 0.1, 0.1), l = (10.0, 10.0, 10.0, 10.0), n_med = (1.0, 1.0, 1.0, 1.0), N_J0Roots = 10000)
cylinder_3 = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0, 10.0), μa = (0.1, 0.1, 0.1), l = (10.0, 10.0, 10.0), n_med = (1.0, 1.0, 1.0), N_J0Roots = 10000)
cylinder_2 = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0), μa = (0.1, 0.1), l = (10.0, 10.0), n_med = (1.0, 1.0), N_J0Roots = 10000)
@test fluence_DA_Nlay_cylinder_CW(cylinder_4) ≈  fluence_DA_Nlay_cylinder_CW(cylinder_3)  ≈ fluence_DA_Nlay_cylinder_CW(cylinder_2)

### test that arbitrary layers are equal
cylinder_5 = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0, 10.0, 10.0, 10.0), μa = (0.1, 0.1, 0.1, 0.1, 0.1), l = (2.0, 2.0, 2.0, 5.0, 5.0), n_med = (1.0, 1.0, 1.0, 1.0, 1.0), N_J0Roots = 10000)
cylinder_8 = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0), μa = (0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1), l = (2.0, 2.0, 2.0, 5.0, 5.0, 3.0, 3.0, 3.0), n_med = (1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0), N_J0Roots = 10000)

@test fluence_DA_Nlay_cylinder_CW(cylinder_4) ≈  fluence_DA_Nlay_cylinder_CW(cylinder_5) ≈  fluence_DA_Nlay_cylinder_CW(cylinder_8)
### test high scatterring
# SDS = 1.0, μsp = 60.0, once again need more besselroots if you want higher scattering coefficients
cylinder_data = Nlayer_cylinder(ρ = 1.0, μsp = (60.0, 60.0, 60.0, 60.0), μa = (0.1, 0.1, 0.1, 0.1), l = (2.0, 2.0, 2.0, 2.0), n_med = (1.0, 1.0, 1.0, 1.0), a = 20.0, N_J0Roots = 10000)
@test fluence_DA_semiinf_CW(1.0, 0.1, 60.0) ≈ fluence_DA_Nlay_cylinder_CW(cylinder_data)

### test for varying index of refractions
cyl_2 = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0), μa = (0.1, 0.1), l = (10.0, 10.0), n_med = (1.5, 1.5), n_ext = 1.4, a = 20.0, N_J0Roots = 10000)
cyl_3 = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0, 10.0), μa = (0.1, 0.1, 0.1), l = (10.0, 10.0, 10.0), n_med = (1.5, 1.5, 1.5), n_ext = 1.4, a = 20.0, N_J0Roots = 10000)
cyl_4 = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0, 10.0, 10.0), μa = (0.1, 0.1, 0.1, 0.1), l = (10.0, 10.0, 10.0, 10.0), n_med = (1.5, 1.5, 1.5, 1.5), n_ext = 1.4, a = 20.0, N_J0Roots = 10000)
@test fluence_DA_Nlay_cylinder_CW(cyl_4) ≈ fluence_DA_Nlay_cylinder_CW(cyl_3) ≈ fluence_DA_Nlay_cylinder_CW(cyl_2) ≈ fluence_DA_semiinf_CW(1.0, 0.1, 10.0, n_med = 1.5, n_ext = 1.4)

#### tests for CW fluence in the bottom layer GN
@test fluence_DA_Nlay_cylinder_CW(0.0, (0.1, 0.1), (10.0, 10.0), 1.0, (1.0, 1.0), (1.0, 1.0), 10.0, 2.0, 10000) ≈ fluence_DA_slab_CW(0.0, 0.1, 10.0; n_ext = 1.0, n_med = 1.0, s = 2.0, z = 2.0, xs = 50)
@test fluence_DA_Nlay_cylinder_CW(1.0, (0.1, 0.1), (10.0, 10.0), 1.0, (1.0, 1.0), (1.0, 1.0), 10.0, 2.0, 10000) ≈ fluence_DA_slab_CW(1.0, 0.1, 10.0; n_ext = 1.0, n_med = 1.0, s = 2.0, z = 2.0, xs = 50)
@test fluence_DA_Nlay_cylinder_CW(1.6, (0.21, 0.21), (12.1, 12.1), 1.0, (1.0, 1.0), (1.0, 1.0), 10.0, 2.0, 10000) ≈ fluence_DA_slab_CW(1.6, 0.21, 12.1; n_ext = 1.0, n_med = 1.0, s = 2.0, z = 2.0, xs = 50)
@test fluence_DA_Nlay_cylinder_CW(2.2, (0.31, 0.31, 0.31), (12.1, 12.1, 12.1), 1.0, (1.0, 1.0, 1.0), (1.0, 1.0, 1.0), 10.0, 3.0, 10000) ≈ fluence_DA_slab_CW(2.2, 0.31, 12.1; n_ext = 1.0, n_med = 1.0, s = 3.0, z = 3.0, xs = 50)
@test fluence_DA_Nlay_cylinder_CW(2.8, (0.41, 0.41, 0.41, 0.41), (13.1, 13.1, 13.1, 13.1), 1.0, (1.0, 1.0, 1.0, 1.0), (1.0, 1.0, 1.0, 1.0), 10.0, 4.0, 10000) ≈ fluence_DA_slab_CW(2.8, 0.41, 13.1; n_ext = 1.0, n_med = 1.0, s = 4.0, z = 4.0, xs = 50)

@test fluence_DA_Nlay_cylinder_CW(0.0, (0.1, 0.1), (10.0, 10.0), 1.0, (1.0, 1.0), (1.5, 1.5), 10.0, 3.0, 10000) ≈ fluence_DA_slab_CW(0.0, 0.1, 10.0; n_ext = 1.0, n_med = 1.0, s = 3.0, z = 3.0, xs = 50)

@test fluence_DA_Nlay_cylinder_CW(0.0, (0.1, 0.1, 0.1, 0.1, 0.1, 0.1), (10.0, 10.0, 10.0, 10.0, 10.0, 10.0), 1.0, (1.0, 1.0, 1.0, 1.0, 1.0, 1.0), (0.5, 0.5, 0.5, 0.5, 0.5, 0.5), 10.0, 3.0, 10000) ≈ fluence_DA_slab_CW(0.0, 0.1, 10.0; n_ext = 1.0, n_med = 1.0, s = 3.0, z = 3.0, xs = 50)
@test fluence_DA_Nlay_cylinder_CW(0.0, (0.1, 0.1, 0.1, 0.1, 0.1, 0.1), (10.0, 10.0, 10.0, 10.0, 10.0, 10.0), 1.0, (1.0, 1.0, 1.0, 1.0, 1.0, 1.0), (1.0, 1.0, 1.0, 1.0, 1.0, 1.0), 10.0, 6.0, 10000) ≈ fluence_DA_slab_CW(0.0, 0.1, 10.0; n_ext = 1.0, n_med = 1.0, s = 6.0, z = 6.0, xs = 50)

### test that scalar and vector ρ matches (they call different routines)
μsp = (10.0, 10.0, 10.0, 10.0); μa = (0.1, 0.1, 0.1, 0.1); n_ext = 1.0;
n_med = (1.0, 1.0, 1.0, 1.0); l = (0.5, 0.8, 1.0, 5.0); a = 5.0; z = 0.0
N_J0Roots = 1000
ρ1 = (1.0, 1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2.0)
@test [fluence_DA_Nlay_cylinder_CW(ρ1, μa, μsp, n_ext, n_med, l, a, z, N_J0Roots)...] ≈ map(ρ -> fluence_DA_Nlay_cylinder_CW(ρ, μa, μsp, n_ext, n_med, l, a, z, N_J0Roots), 1.0:0.1:2.0)

#########
# Time-Domain
##########

## test reflectance in first layer
# test long times at SDS = 0.5 cm
t = range(0.03, 8.0, length = 60)
cylinder_data = Nlayer_cylinder(a = 8.0, ρ = 0.5, N_J0Roots = 600)

si = fluence_DA_semiinf_TD(t, 0.5, 0.1, 10.0)

a72 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 72)
a96 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 96)

@test a72 ≈ si
@test a96 ≈ si

# test long times at SDS = 3.0
t = range(0.04, 8.0, length = 60)
cylinder_data = Nlayer_cylinder(a = 8.0, ρ = 3.0, l = (4.0, 4.0, 4.0, 5.0), N_J0Roots = 600)

si = fluence_DA_semiinf_TD(t, 3.0, 0.1, 10.0)

a72 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 72)
a96 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 96)

@test a72 ≈ si
@test a96 ≈ si

# test high scattering at SDS = 1.5 cm
t = range(0.04, 8.0, length = 60)
cylinder_data = Nlayer_cylinder(a = 8.0, ρ = 1.5, l = (4.0, 4.0, 4.0, 5.0), μsp = (60.0, 60.0, 60.0, 60.0), N_J0Roots = 600)

si = fluence_DA_semiinf_TD(t, 1.5, 0.1, 60.0)

a72 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 72)
a96 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 96)

@test a72 ≈ si
@test a96 ≈ si

## in general the error in the TD is like 1e-14..

## test transmittance in bottom layer
t = range(0.03, 8.0, length = 60)
cylinder_data = Nlayer_cylinder(μa = (0.1, 0.1), μsp = (10.0, 10.0), n_ext = 1.0, n_med = (1.0, 1.0), l = (1.0, 1.0), a = 8.0, ρ = 0.5, z = 2.0, N_J0Roots = 600)

slab = fluence_DA_slab_TD(t, 0.5, 0.1, 10.0; s = 2.0, z = 2.0, xs = 50)

a72 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 72)
a96 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 96)

@test a72 ≈ slab
@test a96 ≈ slab

t = range(0.03, 8.0, length = 60)
cylinder_data = Nlayer_cylinder(μa = (0.1, 0.1), μsp = (10.0, 10.0), n_ext = 1.0, n_med = (1.0, 1.0), l = (1.5, 1.5), a = 8.0, ρ = 0.5, z = 3.0, N_J0Roots = 600)

slab = fluence_DA_slab_TD(t, 0.5, 0.1, 10.0; s = 3.0, z = 3.0, xs = 50)

a72 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 72)
a96 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 96)

@test a72 ≈ slab
@test a96 ≈ slab

t = range(0.03, 8.0, length = 60)
cylinder_data = Nlayer_cylinder(μa = (0.1, 0.1), μsp = (10.0, 10.0), n_ext = 1.0, n_med = (1.0, 1.0), l = (1.5, 1.5), a = 8.0, ρ = 1.5, z = 3.0, N_J0Roots = 600)

slab = fluence_DA_slab_TD(t, 1.5, 0.1, 10.0; s = 3.0, z = 3.0, xs = 50)

a72 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 72)
a96 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 96)

@test a72 ≈ slab
@test a96 ≈ slab

t = range(0.03, 8.0, length = 60)
cylinder_data = Nlayer_cylinder(μa = (0.1, 0.1), μsp = (10.0, 10.0), n_ext = 1.3, n_med = (1.2, 1.2), l = (1.0, 1.0), a = 8.0, ρ = 0.5, z = 2.0, N_J0Roots = 600)

slab = fluence_DA_slab_TD(t, 0.5, 0.1, 10.0; s = 2.0, z = 2.0, xs = 50, n_ext = 1.3, n_med = 1.2)

a72 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 72)
a96 = fluence_DA_Nlay_cylinder_TD(t, cylinder_data, N = 96)

@test a72 ≈ slab
@test a96 ≈ slab

### Flux tests

# CW
cylinder_data = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0), μa = (0.1, 0.1), l = (10.0, 10.0), n_med = (1.0, 1.0), n_ext = 1.0, a = 40.0, N_J0Roots = 10000)
@test flux_DA_Nlay_cylinder_CW(cylinder_data) ≈ flux_DA_semiinf_CW(1.0, 0.1, 10.0; n_ext = 1.0, n_med = 1.0)

cylinder_data = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0), μa = (0.1, 0.1), l = (2.0, 2.0), z = 4.0, n_med = (1.0, 1.0), n_ext = 1.0, a = 40.0, N_J0Roots = 10000)
@test flux_DA_Nlay_cylinder_CW(cylinder_data) ≈ flux_DA_slab_CW(1.0, 0.1, 10.0; n_ext = 1.0, n_med = 1.0, s = 4.0, z = 4.0, xs = 15)

# TD
t = 1.0
cylinder_data = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0), μa = (0.1, 0.1), l = (10.0, 10.0), n_med = (1.0, 1.0), n_ext = 1.0, a = 40.0, N_J0Roots = 10000)
@test flux_DA_Nlay_cylinder_TD(t, cylinder_data) ≈ flux_DA_semiinf_TD(t, 1.0, 0.1, 10.0; n_ext = 1.0, n_med = 1.0)

cylinder_data = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0), μa = (0.1, 0.1), l = (2.0, 2.0), z = 4.0, n_med = (1.0, 1.0), n_ext = 1.0, a = 40.0, N_J0Roots = 10000)
@test flux_DA_Nlay_cylinder_TD(t, cylinder_data) ≈ flux_DA_slab_TD(t, 1.0, 0.1, 10.0; n_ext = 1.0, n_med = 1.0, s = 4.0, z = 4.0, xs = 15)

t = 0.5:0.1:1.5
cylinder_data = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0), μa = (0.1, 0.1), l = (10.0, 10.0), n_med = (1.0, 1.0), n_ext = 1.0, a = 40.0, N_J0Roots = 10000)
@test flux_DA_Nlay_cylinder_TD(t, cylinder_data) ≈ flux_DA_semiinf_TD(t, 1.0, 0.1, 10.0; n_ext = 1.0, n_med = 1.0)

cylinder_data = Nlayer_cylinder(ρ = 1.0, μsp = (10.0, 10.0), μa = (0.1, 0.1), l = (2.0, 2.0), z = 4.0, n_med = (1.0, 1.0), n_ext = 1.0, a = 40.0, N_J0Roots = 10000)
@test flux_DA_Nlay_cylinder_TD(t, cylinder_data) ≈ flux_DA_slab_TD(t, 1.0, 0.1, 10.0; n_ext = 1.0, n_med = 1.0, s = 4.0, z = 4.0, xs = 15)

end # module


import Base.identity
import Base.*
import Base.inv
import Base.show
import Base.one

"""
Artin's braid group of order `n`.
"""
struct BraidGroup
    n::Int
end

"""
An element of Artin's braid group.
"""
struct BraidElement
    group::BraidGroup
    crossings::Array{Tuple{Int,Int},1}
end

"""
Alias for the identity on `g`.
"""
function identity(g::BraidGroup)
    one(g)
end

"""
The identity on `g`.
"""
function one(g::BraidGroup)
    BraidElement(g, [])
end

"""
A generator `sigma_i^sgn` of the group `g`.
"""
function generator(g::BraidGroup, i::Int, sgn::Bool)
    sgnn = sgn ? 1 : -1
    BraidElement(g, [(i % g.n, sgnn)])
end

"""
Get braid from integer encoding of generators.
"""
function braidfromintrep(g::BraidGroup, rep::Array{Int,1})
    crossings = [(abs(x), x > 0 ? 1 : -1) for x in rep]
    BraidElement(g, crossings)
end

"""
Free reduction on the braid word crossings.
"""
function simplifybraidcrossings(crossings::Array{Tuple{Int,Int},1})
    xings0 = crossings
    xings1 = []
    nchanged = 1
    # Simplify exprssion to extent possible
    while nchanged > 0
        lchanged = 0
        if length(xings0) > 1
            for i = 1:length(xings0)
                if (i < length(xings0)) && (xings0[i][1] == xings0[i+1][1]) && (xings0[i][2] == -xings0[i+1][2])
                    # In theory these should always cancel but let's check
                    newpow = xings0[i][2] + xings0[i+1][2]
                    if newpow != 0
                        push!(xings1, (xings0[i][1], newpow))
                    end
                    lchanged += 1
                elseif (i > 1) && ((xings0[i][1] != (xings0[i-1][1])) || (xings0[i][2] != -xings0[i-1][2]))
                    push!(xings1, xings0[i])
                elseif (i == 1) && xings0[i][1] != xings0[i+1][1]
                    push!(xings1, xings0[i])
                elseif (i == 1) && xings0[i][1] == xings0[i+1][1]
                    push!(xings1, xings0[i])
                end
            end
            nchanged = lchanged
            xings0 = xings1
            xings1 = []
        else
            nchanged = 0
        end
    end
    xings = filter(x -> x[2] != 0, xings0) # Remove identities and ^0s
    xings
end

"""
Free reduction on the braid word.
"""
function simplifybraid(b::BraidElement)
    BraidElement(b.group, simplifybraidcrossings(b.crossings))
end

"""
Simplify a braid word.
"""
function simplify(b::BraidElement)
    prettybraid(BraidElement(b.group, simplifybraidcrossings(b.crossings)))
end

"""
Multiplication of braid words.
"""
function *(b1::BraidElement, b2::BraidElement)
    xings0 = cat(1, b1.crossings, b2.crossings)
    xings = simplifybraidcrossings(xings0)
    prettybraid(BraidElement(b1.group, xings))
end

"""
Finds crossing of lowest index in `b`.
"""
function lowestindex(b::BraidElement)
    if length(b.crossings) == 0
        0
    else
        minimum([x[1] for x in b.crossings])
    end
end

"""
Determines whether `b` is reduced in the sense of Dehornoy.
"""
function isreduced(b::BraidElement)
    minidx = lowestindex(b)
    genpows = [q[2] for q in find(z -> z[1] == minidx, b.crossings)]
    (minimum(genpows) < 0) == (maximum(genpows) < 0)
end

"""
Get the inverse of `b`.
"""
function inv(b::BraidElement)
    newxings = [(q[1], -1 * q[2]) for q in b.crossings[length(b.crossings):-1:1]]
    BraidElement(b.group, newxings)
end

"""
Convert `b` to a string.
"""
function Base.show(io::IO, b0::BraidElement)
    b = prettybraid(b0)
    getexp(i) = (i == 1 ? "" : (i == -1 ? "′" : string("^", i)))
    if length(b.crossings) > 0
        sx = [string("σ_", string(i[1]), getexp(i[2])) for i in b.crossings]
        s = join(sx, "⋅")
        #s = s[length("String")+1:end] # Hackety hack
        print(io, s)
    else
        print(io, "ϵ")
    end
end

"""
Convert representation from pure generators to powers of generators.
"""
function prettybraid(b::BraidElement)
    if length(b.crossings) == 0
        return b
    end
    c = []
    curexp = [b.crossings[1][2]]
    curbase = b.crossings[1][1]
    for i in 2:length(b.crossings)
        x = b.crossings[i]
        if x[1] == curbase
            push!(curexp, x[2])
        else
            push!(c, (curbase, sum(curexp)))
            curbase = x[1]
            curexp = [x[2]]
        end
    end
    push!(c, (curbase, sum(curexp)))
    simplifybraid(BraidElement(b.group, c))
end

"""
Convert representation from powers of generators to pure generators.
"""
function unprettybraid(b::BraidElement)
    c = []
    for x in b.crossings
        sgn = x[2] < 0 ? -1 : 1
        for i = 1:abs(x[2])
            push!(c, (x[1], sgn))
        end
    end
    simplifybraid(BraidElement(b.group, c))
end


instructions = []
for line in eachline(STDIN, chomp = true)
  push!(instructions, parse(Int, line))
end
len = length(instructions)

index = 1
steps = 0
while index > 0 && index <= len
  jump = instructions[index]
  instructions[index] += (jump >= 3) ? -1 : 1
  index += jump
  steps += 1
end

println("Step count for part 2: $steps")


module MLDataUtils

using StatsBase
using LearnBase
using MLLabelUtils
using MLDataPattern
using DataFrames

using LearnBase: ObsDimension
import LearnBase: nobs, getobs, getobs!, datasubset, default_obsdim

using Statistics
using DelimitedFiles

eval(Expr(:toplevel, Expr(:export, setdiff(names(MLLabelUtils), [:MLLabelUtils])...)))
eval(Expr(:toplevel, Expr(:export, setdiff(names(MLDataPattern), [:MLDataPattern])...)))

export

    noisy_function,
    noisy_sin,
    noisy_poly,
    noisy_spiral,

    center!,
    rescale!,

    FeatureNormalizer,

    expand_poly,

    load_iris,
    load_line,
    load_sin,
    load_poly,
    load_spiral,

    fit,
    predict,
    predict!

include("feature_scaling.jl")
include("basis_expansion.jl")
include("noisy_function.jl")
include("datasets.jl")
include("datapattern.jl")

end


module LapackUtil2

const liblapack = Base.liblapack_name

import LinearAlgebra.BLAS.@blasfunc

import LinearAlgebra: BlasFloat, BlasReal, BlasComplex, BlasInt, LAPACKException,
       DimensionMismatch, SingularException, PosDefException, chkstride1, checksquare

using Base: iszero, has_offset_axes

export larfg!, larfgl!, larf!

function chkside(side::AbstractChar)
    # Check that left/right hand side multiply is correctly specified
    side == 'L' || side == 'R' ||
        throw(ArgumentError("side argument must be 'L' (left hand multiply) or 'R' (right hand multiply), got $side"))
    side
end
function chklapackerror(ret::BlasInt)
    ret == 0 ? (return) :
              (ret < 0 ? throw(ArgumentError("invalid argument #$(-ret) to LAPACK call")) : throw(LAPACKException(ret)))
end

for (fn, elty) in ((:dlanv2_, :Float64),
                   (:slanv2_, :Float32))
    @eval begin
        function lanv2(A::$elty, B::$elty, C::$elty, D::$elty)
           """
           SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )

           DOUBLE PRECISION A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
           """
           RT1R = Ref{$elty}(1.0)
           RT1I = Ref{$elty}(1.0)
           RT2R = Ref{$elty}(1.0)
           RT2I = Ref{$elty}(1.0)
           CS = Ref{$elty}(1.0)
           SN = Ref{$elty}(1.0)
           ccall((@blasfunc($fn), liblapack), Cvoid,
                 (Ref{$elty},Ref{$elty},Ref{$elty},Ref{$elty},
                 Ref{$elty},Ref{$elty},Ref{$elty},Ref{$elty},Ref{$elty},Ref{$elty}),
                 A, B, C, D,
                 RT1R, RT1I, RT2R, RT2I, CS, SN)
           return RT1R[], RT1I[], RT2R[], RT2I[], CS[], SN[]
        end
    end
end
"""
    lanv2(A, B, C, D) -> (RT1R, RT1I, RT2R, RT2I, CS, SN)

Compute the Schur factorization of a real 2-by-2 nonsymmetric matrix `[A,B;C,D]` in
standard form. `A`, `B`, `C`, `D` are overwritten on output by the corresponding elements of the
standardised Schur form. `RT1R+im*RT1I` and `RT2R+im*RT2I` are the resulting eigenvalues.
`CS` and `SN` are the parameters of the rotation matrix.
Interface to the LAPACK subroutines DLANV2/SLANV2.
"""
lanv2(A::BlasReal, B::BlasReal, C::BlasReal, D::BlasReal)

for (fn, elty) in ((:dlag2_, :Float64),
                   (:slag2_, :Float32))
    @eval begin
        function lag2(A::StridedMatrix{$elty}, B::StridedMatrix{$elty}, SAFMIN::$elty)
           """
           SUBROUTINE DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, WR2, WI )

           INTEGER            LDA, LDB
           DOUBLE PRECISION   SAFMIN, SCALE1, SCALE2, WI, WR1, WR2
           DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
           """
           LDA = stride(A,2)
           LDB = stride(B,2)
           SCALE1 = Ref{$elty}(1.0)
           SCALE2 = Ref{$elty}(1.0)
           WR1 = Ref{$elty}(1.0)
           WR2 = Ref{$elty}(1.0)
           WI = Ref{$elty}(1.0)
           ccall((@blasfunc($fn), liblapack), Cvoid,
                (Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ref{$elty},
                Ref{$elty},Ref{$elty},Ref{$elty},Ref{$elty},Ref{$elty}),
                A, LDA, B, LDB, SAFMIN,
                SCALE1, SCALE2, WR1, WR2, WI)
           return SCALE1[], SCALE2[], WR1[], WR2[], WI[]
        end
    end
end
"""
    lag2(A, B, SAFMIN) -> (SCALE1, SCALE2, WR1, WR2, WI)

Compute the eigenvalues of a 2-by-2 generalized real eigenvalue problem for
the matrix pair `(A,B)`, with scaling as necessary to avoid over-/underflow.
`SAFMIN` is the smallest positive number s.t. `1/SAFMIN` does not overflow.
If `WI = 0`, `WR1/SCALE1` and `WR2/SCALE2` are the resulting real eigenvalues, while
if `WI <> 0`, then `(WR1+/-im*WI)/SCALE1` are the resulting complex eigenvalues.
Interface to the LAPACK subroutines DLAG2/SLAG2.
"""
lag2(A::StridedMatrix{BlasReal}, B::StridedMatrix{BlasReal}, SAFMIN::BlasReal)

#lag2(A::StridedMatrix{T}, B::StridedMatrix{T}) where T <: BlasReal = lag2(A,B,safemin(T))

function safemin(::Type{T}) where T <: BlasReal
    SMLNUM = (T == Float64) ? reinterpret(Float64, 0x2000000000000000) : reinterpret(Float32, 0x20000000)
    return SMLNUM * 2/ eps(T)
end

## Tools to compute and apply elementary reflectors
for (larfg, elty) in
    ((:dlarfg_, Float64),
     (:slarfg_, Float32),
     (:zlarfg_, ComplexF64),
     (:clarfg_, ComplexF32))
    @eval begin
        #
        #    larfg!(x) -> (τ, β)
        #
        # Wrapper to LAPACK function family _LARFG.F to compute the parameters
        # v and τ of a Householder reflector H = I - τ*v*v' which annihilates
        # the N-1 trailing elements of x and to provide τ and β, where β is the
        # first element of the transformed vector H*x. The vector v has its first
        # component set to 1 and is returned in x.
        #
        #        .. Scalar Arguments ..
        #        INTEGER            incx, n
        #        DOUBLE PRECISION   alpha, tau
        #        ..
        #        .. Array Arguments ..
        #        DOUBLE PRECISION   x( * )
        function larfg!(x::AbstractVector{$elty})
            N    = BlasInt(length(x))
            incx = stride(x, 1)
            τ    = Ref{$elty}(0)
            ccall((@blasfunc($larfg), liblapack), Cvoid,
                (Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ref{$elty}),
                N, x, pointer(x, 2), incx, τ)
            β = x[1]
            @inbounds x[1] = one($elty)
            return τ[], β
        end
    end
end

for (larfg, elty) in
    ((:dlarfg_, Float64),
     (:slarfg_, Float32),
     (:zlarfg_, ComplexF64),
     (:clarfg_, ComplexF32))
    @eval begin
        #
        #    larfgl!(x) -> (τ, β)
        #
        # Wrapper to LAPACK function family _LARFG.F to compute the parameters
        # v and τ of a Householder reflector H = I - τ*v*v' which annihilates
        # the N-1 leading elements of x and to provide τ and β, where β is the
        # last element of the transformed vector H*x. The vector v has its last
        # component set to 1 and is returned in x.
        #
        #        .. Scalar Arguments ..
        #        INTEGER            incx, n
        #        DOUBLE PRECISION   alpha, tau
        #        ..
        #        .. Array Arguments ..
        #        DOUBLE PRECISION   x( * )
        function larfgl!(x::AbstractVector{$elty})
            N    = BlasInt(length(x))
            incx = stride(x, 1)
            τ    = Ref{$elty}(0)
            ccall((@blasfunc($larfg), liblapack), Cvoid,
                (Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ref{$elty}),
                N, pointer(x, N), x, incx, τ)
            β = x[N]
            @inbounds x[N] = one($elty)
            return τ[], β
        end
    end
end

for (larf, elty) in
    ((:dlarf_, Float64),
     (:slarf_, Float32),
     (:zlarf_, ComplexF64),
     (:clarf_, ComplexF32))
    @eval begin
        #
        #    larf!(side,v,τ,C)
        #
        # Wrapper to LAPACK function family _LARF.F to apply a Householder reflector
        # H = I - τ*v*v' from left, if side = 'L', or from right, if side = 'R', to
        # the matrix C. H*C, if side = 'L' or C*H, if side = 'R', are returned in C.
        #
        #        .. Scalar Arguments ..
        #        CHARACTER          side
        #        INTEGER            incv, ldc, m, n
        #        DOUBLE PRECISION   tau
        #        ..
        #        .. Array Arguments ..
        #        DOUBLE PRECISION   c( ldc, * ), v( * ), work( * )
        function larf!(side::AbstractChar, v::AbstractVector{$elty},
                       τ::$elty, C::AbstractMatrix{$elty}, work::AbstractVector{$elty})
            m, n = size(C)
            chkside(side)
            ldc = max(1, stride(C, 2))
            l = side == 'L' ? n : m
            #incv  = BlasInt(1)
            incv = stride(v, 1)
            ccall((@blasfunc($larf), liblapack), Cvoid,
                (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
                 Ref{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Clong),
                side, m, n, v, incv,
                τ, C, ldc, work, 1)
            return C
        end

        function larf!(side::AbstractChar, v::AbstractVector{$elty},
                       τ::$elty, C::AbstractMatrix{$elty})
            m, n = size(C)
            chkside(side)
            lwork = side == 'L' ? n : m
            return larf!(side, v, τ, C, Vector{$elty}(undef,lwork))
        end
    end
end

for (gghrd, elty) in
    ((:dgghrd_, Float64),
     (:sgghrd_, Float32),
     (:zgghrd_, ComplexF64),
     (:cgghrd_, ComplexF32))
    @eval begin
        #       SUBROUTINE DGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
        #                          LDQ, Z, LDZ, INFO )
        #
        #       .. Scalar Arguments ..
        #       CHARACTER          COMPQ, COMPZ
        #       INTEGER            IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, N
        #       ..
        #       .. Array Arguments ..
        #       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), Q( LDQ, * ), Z( LDZ, * )
        function gghrd!(compq::AbstractChar, compz::AbstractChar,  ilo::BlasInt, ihi::BlasInt,
                        A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty}, Z::AbstractMatrix{$elty})
            chkstride1(A, B, Q, Z)
            n, nb, nq, nz = checksquare(A, B, Q, Z)
            n == nb || throw(DimensionMismatch("dimensions of A, ($n,$n), and B, ($nb,$nb), must match"))
            n == nq || throw(DimensionMismatch("dimensions of A, ($n,$n), and Q, ($nq,$nq), must match"))
            n == nz || throw(DimensionMismatch("dimensions of A, ($n,$n), and Z, ($nz,$nz), must match"))
            lda = max(1, stride(A, 2))
            ldb = max(1, stride(B, 2))
            ldq = max(1, stride(Q, 2))
            ldz = max(1, stride(Z, 2))
            compq == 'N' || compq == 'V' || compq == 'I' ||
                  throw(ArgumentError("compq argument must be 'N', 'V' or 'I', got $compq"))
            compz == 'N' || compz == 'V' || compz == 'I' ||
                  throw(ArgumentError("compz argument must be 'N', 'V' or 'I', got $compz"))
            n > 0 && (ilo < 1 || ihi > n || ihi < ilo) &&
                    throw(ArgumentError("ilo and ihi arguments must satisfy 1 ≤ ilo ≤ ihi ≤ $n, got ilo = $ilo and ihi = $ihi"))
            n == 0 && (ilo != 1 || ihi != 0) &&
                    throw(ArgumentError("for n = 0, ilo must be 1 and ihi must be zero, got ilo = $ilo and ihi = $ihi"))
            info = Ref{BlasInt}()
            ccall((@blasfunc($gghrd), liblapack), Cvoid,
                      (Ref{UInt8}, Ref{UInt8},  Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
                      Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
                      Ptr{BlasInt}),
                      compq, compz, n, ilo, ihi,
                      A, lda, B, ldb, Q, ldq, Z, ldz,
                      info)
                chklapackerror(info[])
           return A, B, Q, Z
        end
    end
end

for (hgeqz, elty) in
    ((:dhgeqz_,:Float64),
     (:shgeqz_,:Float32))
     @eval begin
        #       SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
        #                          ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO )
        #
        #       .. Scalar Arguments ..
        #       CHARACTER          COMPQ, COMPZ, JOB
        #       INTEGER            IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
        #       ..
        #       .. Array Arguments ..
        #       DOUBLE PRECISION   ALPHAI( * ), ALPHAR( * ), BETA( * ),
        #      $                   H( LDH, * ), Q( LDQ, * ), T( LDT, * ),
        #      $                   WORK( * ), Z( LDZ, * )
        function hgeqz!(compq::AbstractChar, compz::AbstractChar,  ilo::BlasInt, ihi::BlasInt,
                        H::AbstractMatrix{$elty}, T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty}, Z::AbstractMatrix{$elty})
            chkstride1(H, T, Q, Z)
            n, nt, nq, nz = checksquare(H, T, Q, Z)
            n == nt || throw(DimensionMismatch("dimensions of H, ($n,$n), and T, ($nt,$nt), must match"))
            n == nq || throw(DimensionMismatch("dimensions of H, ($n,$n), and Q, ($nq,$nq), must match"))
            n == nz || throw(DimensionMismatch("dimensions of H, ($n,$n), and Z, ($nz,$nz), must match"))
            compq == 'N' || compq == 'V' || compq == 'I' ||
                  throw(ArgumentError("compq argument must be 'N', 'V' or 'I', got $compq"))
            compz == 'N' || compz == 'V' || compz == 'I' ||
                  throw(ArgumentError("compz argument must be 'N', 'V' or 'I', got $compz"))
            n > 0 && (ilo < 1 || ihi > n || ihi < ilo) &&
                    throw(ArgumentError("ilo and ihi arguments must satisfy 1 ≤ ilo ≤ ihi ≤ $n, got ilo = $ilo and ihi = $ihi"))
            n == 0 && (ilo != 1 || ihi != 0) &&
                    throw(ArgumentError("for n = 0, ilo must be 1 and ihi must be zero, got ilo = $ilo and ihi = $ihi"))
            alphar = similar(H, $elty, n)
            alphai = similar(H, $elty, n)
            beta = similar(H, $elty, n)
            ldh = max(1, stride(H, 2))
            ldt = max(1, stride(T, 2))
            ldq = compq == 'N' ? 1 : max(1, stride(Q, 2))
            ldz = compz == 'N' ? 1 : max(1, stride(Z, 2))
            work = Vector{$elty}(undef, 1)
            lwork = BlasInt(-1)
            info = Ref{BlasInt}()
            for i = 1:2  # first call returns lwork as work[1]
                ccall((@blasfunc($hgeqz), liblapack), Cvoid,
                      (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
                       Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty},
                       Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
                       Ptr{$elty}, Ref{BlasInt},
                       Ptr{BlasInt}),
                    'S', compq, compz, n, ilo, ihi,
                    H, ldh, T, ldt, alphar, alphai, beta,
                    Q, ldq, Z, ldz,
                    work, lwork,
                    info)
                chklapackerror(info[])
                if i == 1
                    lwork = BlasInt(real(work[1]))
                    resize!(work, lwork)
                end
            end
            H, T, complex.(alphar, alphai), beta, Q, Z
        end
    end
end
for (hgeqz, elty, relty) in
    ((:zhgeqz_,:ComplexF64,:Float64),
     (:chgeqz_,:ComplexF32,:Float32))
     @eval begin
        #       SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
        #                          ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, INFO )
        #
        #       .. Scalar Arguments ..
        #       CHARACTER          COMPQ, COMPZ, JOB
        #       INTEGER            IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
        #       ..
        #       .. Array Arguments ..
        #       REAL               RWORK( * )
        #       COMPLEX*16         ALPHA( * ), BETA( * ), H( LDH, * ),
        #      $                   Q( LDQ, * ), T( LDT, * ), WORK( * ),
        #      $                   Z( LDZ, * )
        function hgeqz!(compq::AbstractChar, compz::AbstractChar,  ilo::BlasInt, ihi::BlasInt,
                        H::AbstractMatrix{$elty}, T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty}, Z::AbstractMatrix{$elty})
            chkstride1(H, T, Q, Z)
            n, nt, nq, nz = checksquare(H, T, Q, Z)
            n == nt || throw(DimensionMismatch("dimensions of H, ($n,$n), and T, ($nt,$nt), must match"))
            n == nq || throw(DimensionMismatch("dimensions of H, ($n,$n), and Q, ($nq,$nq), must match"))
            n == nz || throw(DimensionMismatch("dimensions of H, ($n,$n), and Z, ($nz,$nz), must match"))
            compq == 'N' || compq == 'V' || compq == 'I' ||
                  throw(ArgumentError("compq argument must be 'N', 'V' or 'I', got $compq"))
            compz == 'N' || compz == 'V' || compz == 'I' ||
                  throw(ArgumentError("compz argument must be 'N', 'V' or 'I', got $compz"))
            n > 0 && (ilo < 1 || ihi > n || ihi < ilo) &&
                    throw(ArgumentError("ilo and ihi arguments must satisfy 1 ≤ ilo ≤ ihi ≤ n, got ilo = $ilo and ihi = $ihi"))
            n == 0 && (ilo != 1 || ihi != 0) &&
                    throw(ArgumentError("for n = 0, ilo must be 1 and ihi must be zero, got ilo = $ilo and ihi = $ihi"))
            alpha = similar(H, $elty, n)
            beta = similar(H, $elty, n)
            ldh = max(1, stride(H, 2))
            ldt = max(1, stride(T, 2))
            ldq = compq == 'N' ? 1 : max(1, stride(Q, 2))
            ldz = compz == 'N' ? 1 : max(1, stride(Z, 2))
            work = Vector{$elty}(undef, 1)
            lwork = BlasInt(-1)
            rwork = Vector{$relty}(undef, n)
            info = Ref{BlasInt}()
            for i = 1:2  # first call returns lwork as work[1]
                ccall((@blasfunc($hgeqz), liblapack), Cvoid,
                      (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
                       Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty},
                       Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
                       Ptr{$elty}, Ref{BlasInt}, Ptr{$relty},
                       Ptr{BlasInt}),
                    'S', compq, compz, n, ilo, ihi,
                    H, ldh, T, ldt, alpha, beta,
                    Q, ldq, Z, ldz,
                    work, lwork, rwork,
                    info)
                chklapackerror(info[])
                if i == 1
                    lwork = BlasInt(real(work[1]))
                    resize!(work, lwork)
                end
            end
            H, T, alpha, beta, Q, Z
        end
    end
end

for (tgexc, elty) in ((:dtgexc_, :Float64), (:stgexc_, :Float32))
    @eval begin
        #
        #       SUBROUTINE DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
        #                          LDZ, IFST, ILST, WORK, LWORK, INFO )
        #
        #       .. Scalar Arguments ..
        #       LOGICAL            WANTQ, WANTZ
        #       INTEGER            IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
        #       ..
        #       .. Array Arguments ..
        #       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
        #      $                   WORK( * ), Z( LDZ, * )
        function tgexc!(wantq::Bool, wantz::Bool,  ifst::BlasInt, ilst::BlasInt,
                        S::AbstractMatrix{$elty}, T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty}, Z::AbstractMatrix{$elty})
            chkstride1(S, T, Q, Z)
            n, nt, nq, nz = checksquare(S, T, Q, Z)
            n == nt || throw(DimensionMismatch("dimensions of S, ($n,$n), and T, ($nt,$nt), must match"))
            n == nq || throw(DimensionMismatch("dimensions of S, ($n,$n), and Q, ($nq,$nq), must match"))
            n == nz || throw(DimensionMismatch("dimensions of S, ($n,$n), and Z, ($nz,$nz), must match"))
            (ifst < 1 || ifst > n || ilst < 1 || ilst > n) &&
                    throw(ArgumentError("ifst and ilst arguments must satisfy 1 ≤ ifst, ilst ≤ $n, got ifst = $ifst and ilst = $ilst"))
            lds = max(1, stride(S, 2))
            ldt = max(1, stride(T, 2))
            ldq = wantq ? max(1, stride(Q, 2)) : 1
            ldz = wantz ? max(1, stride(Z, 2)) : 1
            lwork = BlasInt(-1)
            work = Vector{$elty}(undef, 1)
            info = Ref{BlasInt}()
            for i = 1:2  # first call returns lwork as work[1]
                ccall((@blasfunc($tgexc), liblapack), Cvoid,
                      (Ref{BlasInt},  Ref{BlasInt},  Ref{BlasInt},
                      Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
                      Ref{BlasInt}, Ref{BlasInt},
                      Ptr{$elty}, Ref{BlasInt},
                      Ptr{BlasInt}),
                      BlasInt(wantq), BlasInt(wantz), n,
                      S, lds, T, ldt, Q, ldq, Z, ldz,
                      ifst, ilst,
                      work, lwork,
                      info)
                chklapackerror(info[])
                if i == 1 # only estimated optimal lwork
                    lwork  = BlasInt(real(work[1]))
                    resize!(work, lwork)
                end
            end
            return S, T, Q, Z
        end
    end
end
for (tgexc, elty) in ((:ztgexc_, :ComplexF64), (:ctgexc_, :ComplexF32))
    @eval begin
        #
        #       SUBROUTINE ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
        #                          LDZ, IFST, ILST, INFO )
        #
        #       .. Scalar Arguments ..
        #       LOGICAL            WANTQ, WANTZ
        #       INTEGER            IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, N
        #       ..
        #       .. Array Arguments ..
        #       COMPLEX*16   A( LDA, * ), B( LDB, * ), Q( LDQ, * ), Z( LDZ, * )
        function tgexc!(wantq::Bool, wantz::Bool,  ifst::BlasInt, ilst::BlasInt,
                        S::AbstractMatrix{$elty}, T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty}, Z::AbstractMatrix{$elty})
            chkstride1(S, T, Q, Z)
            n, nt, nq, nz = checksquare(S, T, Q, Z)
            n == nt || throw(DimensionMismatch("dimensions of S, ($n,$n), and T, ($nt,$nt), must match"))
            n == nq || throw(DimensionMismatch("dimensions of S, ($n,$n), and Q, ($nq,$nq), must match"))
            n == nz || throw(DimensionMismatch("dimensions of S, ($n,$n), and Z, ($nz,$nz), must match"))
            (ifst < 1 || ifst > n || ilst < 1 || ilst > n) &&
                    throw(ArgumentError("ifst and ilst arguments must satisfy 1 ≤ ifst, ilst ≤ $n, got ifst = $ifst and ilst = $ilst"))
            lds = max(1, stride(S, 2))
            ldt = max(1, stride(T, 2))
            ldq = wantq ? max(1, stride(Q, 2)) : 1
            ldz = wantz ? max(1, stride(Z, 2)) : 1
            info = Ref{BlasInt}()
            ccall((@blasfunc($tgexc), liblapack), Cvoid,
                  (Ref{BlasInt},  Ref{BlasInt},  Ref{BlasInt},
                   Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
                    Ref{BlasInt}, Ref{BlasInt},
                    Ptr{BlasInt}),
                    BlasInt(wantq), BlasInt(wantz), n,
                    S, lds, T, ldt, Q, ldq, Z, ldz,
                    ifst, ilst,
                    info)
            chklapackerror(info[])
            return S, T, Q, Z
        end
    end
end

"""
    tgexc!(wantq, wantz, ifst, ilst, S, T, Q, Z) -> (S, T, Q, Z)

Reorder the generalized Schur factorization of a matrix pair (S,T) in generalized Schur form,
so that the diagonal blocks of (S, T) with row index `ifst` are moved to row `ilst`.
If `wantq = true`, the left Schur vectors `Q` are reordered, and if `wantq = false` they are not modified.
If `wantz = true`, the right Schur vectors `Z` are reordered, and if `wantz = false` they are not modified.
"""
tgexc!(wantq::Bool, wantz::Bool, ifst::BlasInt, ilst::BlasInt,
       S::AbstractMatrix, T::AbstractMatrix, Q::AbstractMatrix, Z::AbstractMatrix)

for (tgsen, elty) in
    ((:dtgsen_, :Float64),
     (:stgsen_, :Float32))
    @eval begin
        #        .. Scalar Arguments ..
        #        LOGICAL            WANTQ, WANTZ
        #        INTEGER            IJOB, INFO, LDA, LDB, LDQ, LDZ, LIWORK, LWORK,
        #       $                   M, N
        #        DOUBLE PRECISION   PL, PR
        #        ..
        #        .. Array Arguments ..
        #        LOGICAL            SELECT( * )
        #        INTEGER            IWORK( * )
        #        DOUBLE PRECISION   A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
        #       $                   B( LDB, * ), BETA( * ), DIF( * ), Q( LDQ, * ),
        #       $                   WORK( * ), Z( LDZ, * )
        #        ..
        function tgsen!(wantq::Bool, wantz::Bool, select::AbstractVector{BlasInt}, S::AbstractMatrix{$elty}, T::AbstractMatrix{$elty},
                        Q::AbstractMatrix{$elty}, Z::AbstractMatrix{$elty})
            chkstride1(select, S, T, Q, Z)
            n, nt, nq, nz = checksquare(S, T, Q, Z)
            n == nt || throw(DimensionMismatch("dimensions of S, ($n,$n), and T, ($nt,$nt), must match"))
            n == nq || throw(DimensionMismatch("dimensions of S, ($n,$n), and Q, ($nq,$nq), must match"))
            n == nz || throw(DimensionMismatch("dimensions of S, ($n,$n), and Z, ($nz,$nz), must match"))
            lds = max(1, stride(S, 2))
            ldt = max(1, stride(T, 2))
            ldq = max(1, stride(Q, 2))
            ldz = max(1, stride(Z, 2))
            m = sum(select)
            alphai = similar(T, $elty, n)
            alphar = similar(T, $elty, n)
            beta = similar(T, $elty, n)
            lwork = BlasInt(-1)
            work = Vector{$elty}(undef, 1)
            liwork = BlasInt(-1)
            iwork = Vector{BlasInt}(undef, 1)
            info = Ref{BlasInt}()
            select = convert(Array{BlasInt}, select)
            for i = 1:2  # first call returns lwork as work[1] and liwork as iwork[1]
                ccall((@blasfunc($tgsen), liblapack), Cvoid,
                       (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{BlasInt},
                        Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
                        Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty},
                        Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
                        Ref{BlasInt}, Ptr{Cvoid}, Ptr{Cvoid}, Ptr{Cvoid},
                        Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ref{BlasInt},
                        Ptr{BlasInt}),
                    0, BlasInt(wantq), BlasInt(wantz), select,
                    n, S, lds, T,
                    ldt, alphar, alphai, beta,
                    Q, ldq, Z, ldz,
                    m, C_NULL, C_NULL, C_NULL,
                    work, lwork, iwork, liwork,
                    info)
                chklapackerror(info[])
                if i == 1 # only estimated optimal lwork, liwork
                    lwork  = BlasInt(real(work[1]))
                    resize!(work, lwork)
                    liwork = BlasInt(real(iwork[1]))
                    resize!(iwork, liwork)
                end
            end
            S, T, complex.(alphar, alphai), beta, Q, Z
        end
    end
end
for (tgsen, elty, relty) in
    ((:ztgsen_, :ComplexF64, :Float64),
     (:ctgsen_, :ComplexF32, :Float32))
    @eval begin
        function tgsen!(wantq::Bool, wantz::Bool, select::AbstractVector{BlasInt}, S::AbstractMatrix{$elty}, T::AbstractMatrix{$elty},
                        Q::AbstractMatrix{$elty}, Z::AbstractMatrix{$elty})
            chkstride1(select, S, T, Q, Z)
            n, nt, nq, nz = checksquare(S, T, Q, Z)
            n == nt || throw(DimensionMismatch("dimensions of S, ($n,$n), and T, ($nt,$nt), must match"))
            n == nq || throw(DimensionMismatch("dimensions of S, ($n,$n), and Q, ($nq,$nq), must match"))
            n == nz || throw(DimensionMismatch("dimensions of S, ($n,$n), and Z, ($nz,$nz), must match"))
            lds = max(1, stride(S, 2))
            ldt = max(1, stride(T, 2))
            ldq = max(1, stride(Q, 2))
            ldz = max(1, stride(Z, 2))
            m = sum(select)
            alpha = similar(T, $elty, n)
            beta = similar(T, $elty, n)
            lwork = BlasInt(-1)
            work = Vector{$elty}(undef, 1)
            liwork = BlasInt(-1)
            iwork = Vector{BlasInt}(undef, 1)
            info = Ref{BlasInt}()
            select = convert(Array{BlasInt}, select)
            for i = 1:2  # first call returns lwork as work[1] and liwork as iwork[1]
                ccall((@blasfunc($tgsen), liblapack), Cvoid,
                       (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{BlasInt},
                        Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
                        Ref{BlasInt}, Ptr{$elty}, Ptr{$elty},
                        Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
                        Ref{BlasInt}, Ptr{Cvoid}, Ptr{Cvoid}, Ptr{Cvoid},
                        Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ref{BlasInt},
                        Ptr{BlasInt}),
                    0, BlasInt(wantq), BlasInt(wantz), select,
                    n, S, lds, T,
                    ldt, alpha, beta,
                    Q, ldq, Z, ldz,
                    m, C_NULL, C_NULL, C_NULL,
                    work, lwork, iwork, liwork,
                    info)
                chklapackerror(info[])
                if i == 1 # only estimated optimal lwork, liwork
                    lwork  = BlasInt(real(work[1]))
                    resize!(work, lwork)
                    liwork = BlasInt(real(iwork[1]))
                    resize!(iwork, liwork)
                end
            end
            S, T, alpha, beta, Q, Z
        end
    end
end
"""
    tgsen!(wantq, wantz, select, S, T, Q, Z) -> (S, T, Q, Z)

Reorder the diagonal 1x1 and 2x2 blocks of a matrix pair (S,T) in generalized Schur form, such that
their eigenvalues correspond to the cluster specified in `select`.
If `wantq = true`, the left Schur vectors `Q` are reordered, and if `wantq = false` they are not modified.
If `wantz = true`, the right Schur vectors `Z` are reordered, and if `wantz = false` they are not modified.
"""
tgsen!(wantq::Bool, wantz::Bool, select::AbstractVector, S::AbstractMatrix, T::AbstractMatrix, Q::AbstractMatrix, Z::AbstractMatrix)

for (fn, elty, relty) in ((:dtgsyl_, :Float64, :Float64),
                   (:stgsyl_, :Float32, :Float32),
                   (:ztgsyl_, :ComplexF64, :Float64),
                   (:ctgsyl_, :ComplexF32, :Float32))
    @eval begin
        function tgsyl!(trans::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty}, C::AbstractMatrix{$elty},
                        D::AbstractMatrix{$elty}, E::AbstractMatrix{$elty}, F::AbstractMatrix{$elty})
            @assert !has_offset_axes(A, B, C, D, E, F)
            chkstride1(A, B, C, D, E, F)
            m, n = checksquare(A, B)
            lda = max(1, stride(A, 2))
            ldb = max(1, stride(B, 2))
            ldc = max(1, stride(C, 2))
            m1, n1 = size(C)
            (m == m1 && n == n1) ||
                throw(DimensionMismatch("dimensions of A($m,$m),  B($n,$n), and C($m1,$n1) must match"))
            m2, n2 = checksquare(D, E)
            m == m2 || throw(DimensionMismatch("dimensions of A($m,$m) and D($m2,$m2) must match"))
            n == n2 || throw(DimensionMismatch("dimensions of B($n,$n) and E($n2,$n2), must match"))
            ldd = max(1, stride(D, 2))
            lde = max(1, stride(E, 2))
            ldf = max(1, stride(F, 2))
            m3, n3 = size(F)
            (m2 == m3 && n2 == n3) ||
                throw(DimensionMismatch("dimensions of D($m,$m),  E($n,$n), and F($m3,$n3) must match"))
            dif = Vector{$relty}(undef, 1)
            scale = Vector{$relty}(undef, 1)
            info  = Ref{BlasInt}()
            ijob = 0
            work = Vector{$elty}(undef, 1)
            lwork = 1
            iwork = Vector{BlasInt}(undef,m+n+6)
            #SUBROUTINE DTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
            #       LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK,
            #       IWORK, INFO )
            ccall((@blasfunc($fn), liblapack), Cvoid,
                (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
                 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
                 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
                 Ptr{$relty}, Ptr{$relty}, Ptr{$relty}, Ref{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}),
                 trans, ijob, m, n,
                 A, lda, B, ldb, C, ldc, D, ldd, E, lde, F, ldf,
                 scale, dif, work, lwork, iwork, info)
            chklapackerror(info[])
            C, F, scale[1]
        end
    end
end

"""
    tgsyl!(A, B, C, D, E, F) -> (C, F, scale)

Solve the Sylvester system of matrix equations

      AX - YB = scale*C
      DX - YE = scale*F ,

where `X` and `Y` are unknown matrices, the pairs `(A, D)`, `(B, E)` and  `(C, F)`
have the same sizes, and the pairs `(A, D)` and `(B, E)` are in
generalized (real) Schur canonical form, i.e. `A`, `B` are upper quasi
triangular and `D`, `E` are upper triangular.
Returns `X` (overwriting `C`), `Y` (overwriting `F`) and `scale`.

    tgsyl!(trans, A, B, C, D, E, F) -> (C, F, scale)

Solve for `trans = 'T'` and real matrices or for `trans = 'C'` and complex
matrices,  the (adjoint) Sylvester system of matrix equations

      A'X + D'Y = scale*C
      XB' + YE' = scale*(-F) .

`tgsyl!('N', A, B, C, D, E, F)` corresponds to the call `tgsyl!(A, B, C, D, E, F)`.

Interface to the LAPACK subroutines DTGSYL/STGSYL/ZTGSYL/CTGSYL.
"""
tgsyl!(trans::AbstractChar,A::AbstractMatrix, B::AbstractMatrix, C::AbstractMatrix, D::AbstractMatrix, E::AbstractMatrix, F::AbstractMatrix)

tgsyl!(A::AbstractMatrix, B::AbstractMatrix, C::AbstractMatrix, D::AbstractMatrix, E::AbstractMatrix, F::AbstractMatrix) =
tgsyl!('N',A::AbstractMatrix, B::AbstractMatrix, C::AbstractMatrix, D::AbstractMatrix, E::AbstractMatrix, F::AbstractMatrix)

end # Module


@testset "1000.minimum-cost-to-merge-stones.jl" begin
    @test merge_stones([3,2,4,1], 3) == -1
    @test merge_stones([3,5,1,2,6], 3) == 25
    @test merge_stones([3,2,4,1], 2) == 20
end


# # Car travel in 1D
#
# How a car travels back and forth between two locations.

using Plots

# On my computer GR, the default backend crashes Julia, thus this:
try
    pyplot() # run with PyPlot.jl backend, if installed
catch
    nothing # run with GR.jl backend
end

if !@isdefined plotyes
    plotyes = true
end

"""
    update_position(X, V, dir, dt, L)

Return updated position of car and new travel direction;
given, old postion `X`, speed `V`, direction `dir`, time step `dt`
and domain size `L`.

## Example
```jldoctest
julia> update_position(0.0, 10, 1, 1, 200)
(10.0, 1)
```
"""
function update_position(X, V, dir, dt, L)
    X = X + dir*V*dt
    if X > L
        dir = -1      # if beyond L, go back (left)
    elseif X < 0
        dir = 1       # if beyond 0, go back (right)
    end
    return X, dir
end

"""
    car_travel_1D()

Run the model.
"""
function car_travel_1D()
    ## Physical parameters
    V     = 43.0           # speed, km/h
    L     = 200.0          # length of segment, km
    dir   = 1              # switch 1 = go right, -1 = go left
    ttot  = 16.0           # total time, h
    ## Numerical parameters
    dt    = 0.1            # time step, h
    nt    = Int(cld(ttot, dt))  # number of time steps
    ## Array initialisation
    T     = zeros(nt)
    X     = zeros(nt)
    ## Time loop
    for it = 2:nt
        T[it] = T[it-1] + dt
        X[it], dir = update_position(X[it-1], V, dir, dt, L)
    end
    ## Visualisation
    return T, X
end

#-

## Only run this in an interactive session:
if plotyes
    println("Running model")
    T, X = car_travel_1D()
    plot(T, X, markersize=5, xlabel="time, hrs", ylabel="distance, km", framestyle=:box, legend=:none)
end
# Figure showing how the car bounces back and forth, nice!


# This file was generated, do not modify it.

using MLJ, RDatasets
MLJ.color_off() # hide
auto = dataset("ISLR", "Auto")
y, X = unpack(auto, ==(:MPG), col->true)
train, test = partition(eachindex(y), 0.5, shuffle=true, rng=444);

@load LinearRegressor pkg=MLJLinearModels

using PyPlot

figure(figsize=(8,6))
plot(X.Horsepower, y, ls="none", marker="o")

xlabel("Horsepower", fontsize=14)
xticks(50:50:250, fontsize=12)
yticks(10:10:50, fontsize=12)
ylabel("MPG", fontsize=14)

savefig(joinpath(@OUTPUT, "ISL-lab-5-g1.svg")) # hide

lm = LinearRegressor()
mlm = machine(lm, select(X, :Horsepower), y)
fit!(mlm, rows=train)
rms(predict(mlm, rows=test), y[test])^2

xx = (Horsepower=range(50, 225, length=100) |> collect, )
yy = predict(mlm, xx)

figure(figsize=(8,6))
plot(X.Horsepower, y, ls="none", marker="o")
plot(xx.Horsepower, yy, lw=3)

xlabel("Horsepower", fontsize=14)
xticks(50:50:250, fontsize=12)
yticks(10:10:50, fontsize=12)
ylabel("MPG", fontsize=14)

savefig(joinpath(@OUTPUT, "ISL-lab-5-g2.svg")) # hide

hp = X.Horsepower
Xhp = DataFrame(hp1=hp, hp2=hp.^2, hp3=hp.^3);

@pipeline LinMod(fs = FeatureSelector(features=[:hp1]),
                 lr = LinearRegressor());

lrm = LinMod()
lr1 = machine(lrm, Xhp, y) # poly of degree 1 (line)
fit!(lr1, rows=train)

lrm.fs.features = [:hp1, :hp2] # poly of degree 2
lr2 = machine(lrm, Xhp, y)
fit!(lr2, rows=train)

lrm.fs.features = [:hp1, :hp2, :hp3] # poly of degree 3
lr3 = machine(lrm, Xhp, y)
fit!(lr3, rows=train)

get_mse(lr) = rms(predict(lr, rows=test), y[test])^2

@show get_mse(lr1)
@show get_mse(lr2)
@show get_mse(lr3)

hpn  = xx.Horsepower
Xnew = DataFrame(hp1=hpn, hp2=hpn.^2, hp3=hpn.^3)

yy1 = predict(lr1, Xnew)
yy2 = predict(lr2, Xnew)
yy3 = predict(lr3, Xnew)

figure(figsize=(8,6))
plot(X.Horsepower, y, ls="none", marker="o")
plot(xx.Horsepower, yy1, lw=3, label="Order 1")
plot(xx.Horsepower, yy2, lw=3, label="Order 2")
plot(xx.Horsepower, yy3, lw=3, label="Order 3")

legend(fontsize=14)

xlabel("Horsepower", fontsize=14)
xticks(50:50:250, fontsize=12)
yticks(10:10:50, fontsize=12)
ylabel("MPG", fontsize=14)

savefig(joinpath(@OUTPUT, "ISL-lab-5-g3.svg")) # hide

Xhp = DataFrame([hp.^i for i in 1:10])

cases = [[Symbol("x$j") for j in 1:i] for i in 1:10]
r = range(lrm, :(fs.features), values=cases)

tm = TunedModel(model=lrm, ranges=r, resampling=CV(nfolds=10), measure=rms)

mtm = machine(tm, Xhp, y)
fit!(mtm)
rep = report(mtm)

res = rep.plotting

@show round.(res.measurements.^2, digits=2)
@show argmin(res.measurements)

Xnew = DataFrame([hpn.^i for i in 1:10])
yy5 = predict(mtm, Xnew)

figure(figsize=(8,6))
plot(X.Horsepower, y, ls="none", marker="o")
plot(xx.Horsepower, yy5, lw=3)

xlabel("Horsepower", fontsize=14)
xticks(50:50:250, fontsize=12)
yticks(10:10:50, fontsize=12)
ylabel("MPG", fontsize=14)

savefig(joinpath(@OUTPUT, "ISL-lab-5-g4.svg")) # hide

PyPlot.close_figs() # hide


struct Params{FT}
    θ0 :: FT
    π0 :: FT
    Π :: FT
    S :: FT
    f :: FT
end

function Params(T = Float64;
    θ0 = 285, θT = 340, π0 = 1000, πT = 500, f = 4π/86400*sind(45)
)
    Π = π0 - πT
    S = (θT - θ0)/Π
    θ0 = θ0/(S*Π)
    π0 = π0/Π
    return Params(T(θ0), T(π0), T(Π), T(S), T(f))
end

get_Rd(p::Params) = sqrt(p.S*p.Π^2/p.f^2)
float_type(p::Params{T}) where {T} = T

struct Domain{R,I,FT,A}
    x :: R
    y :: R
    z :: R
    nx :: I
    ny :: I
    nz :: I
    hx :: I
    hy :: I
    hz :: I
    Δx :: FT
    Δy :: FT
    Δz :: FT
    xc :: A
    yc :: A
    zc :: A
end

function Domain(p::Params{T};
    x = (-3, 3), y = (-3, 3),
    size = (32, 32, 32), halo = (1,1,1)
) where {T}

    π0 = p.π0
    x = T.(x)
    y = T.(y)
    z = (π0, π0 - 1)
    nx, ny, nz = size
    hx, hy, hz = halo
    Δx = (x[2] - x[1])/nx
    Δy = (y[2] - y[1])/ny
    Δz = (z[2] - z[1])/nz
    xc = range(x[1] + (0.5 - hx)*Δx, x[2] - (0.5 - hx)*Δx, length = nx + 2*hx)
    xc = OffsetArray(xc, -hx)
    yc = range(y[1] + (0.5 - hy)*Δy, y[2] - (0.5 - hy)*Δy, length = ny + 2*hy)
    yc = OffsetArray(yc, -hy)
    zc = range(z[1] + (0.5 - hz)*Δz, z[2] - (0.5 - hz)*Δz, length = nz + 2*hz)
    zc = OffsetArray(zc, -hz)
    return Domain(x, y, z, nx, ny, nz, hx, hy, hz, T(Δx), T(Δy), T(Δz), xc, yc, zc)

end

halo(d::Domain) = (d.hx, d.hy, d.hz)
Base.size(d::Domain) = (d.nx, d.ny, d.nz)
Base.IteratorsMD.CartesianIndices(d::Domain) = CartesianIndices((d.nx, d.ny, d.nz))
Base.LinearIndices(d::Domain) = LinearIndices((d.nx, d.ny, d.nz))
Base.getindex(d::Domain, I::CartesianIndex{3}) = (d.xc[I[1]], d.yc[I[2]], d.zc[I[3]])
Base.getindex(d::Domain, i, j, k) = (d.xc[i], d.yc[j], d.zc[k])
const dx = CartesianIndex(1,0,0)
const dy = CartesianIndex(0,1,0)
const dz = CartesianIndex(0,0,1)
function new_field(d::Domain)
    underlying_data = zeros(d.nx + 2d.hx, d.ny + 2d.hy, d.nz + 2d.hz)
    return OffsetArray(underlying_data, -d.hx, -d.hy, -d.hz)
end

function new_rhs(d::Domain)
    return zeros(prod(size(d)))
end
function new_linearized_rhs(d::Domain)
    return zeros(2*prod(size(d)))
end
function field_from_rhs!(f, rhs, d::Domain)
    l = LinearIndices(d)
    c = CartesianIndices(d)
    for I = c
        f[I] = rhs[l[I]]
    end
    return f
end
function field_from_rhs(rhs, d::Domain)
    f = new_field(d)
    return field_from_rhs!(f, rhs, d)
end
function fields_from_linearized_rhs!(ϕ, ψ, rhs, d::Domain)
    c = CartesianIndices(d)
    l = LinearIndices(d)
    ol = last(l)
    xϕ = @view rhs[1:ol]
    xψ = @view rhs[ol+1:end]
    for I = c
        ϕ[I] = xϕ[l[I]]
        ψ[I] = xψ[l[I]]
    end
    return (ϕ, ψ)
end
function fields_from_linearized_rhs(rhs, d::Domain)
    ϕ = new_field(d)
    ψ = new_field(d)
    return fields_from_linearized_rhs!(ϕ, ψ, rhs, d)
end
function rhs_from_field!(rhs, f, d::Domain)
    l = LinearIndices(d)
    c = CartesianIndices(d)
    for I = c
        rhs[l[I]] = f[I]
    end
    return rhs
end
function rhs_from_field(f, d::Domain)
    rhs = new_rhs(d)
    return rhs_from_field!(rhs, f, d)
end

mutable struct Convergence{FT,I}
    Δ :: FT
    n :: I
end

struct Solver{FT}
    atol :: FT
    convergence :: Convergence{FT}
    ω :: FT
end

function Solver(p::Params; atolϕ = 1e0, ω = 0.7)
    S = p.S
    Π = p.Π
    atol = atolϕ/(S*Π^2)
    T = float_type(p)
    return Solver(T(atol), Convergence(T(0), 0), T(ω))
end

function is_converged(s::Solver)
    return s.convergence.Δ ≤ s.atol
end

function set_Δ!(s::Solver, Δ)
    s.convergence.Δ = Δ
    return s
end

function increment!(s::Solver, n = 1)
    s.convergence.n += n
    return s
end

function print_convergence_info(s::Solver)
    n = s.convergence.n
    Δ = s.convergence.Δ
    tol = s.atol
    print(n, "\tΔ = ", Δ, "; ", Δ/tol, "x tolerance\n")
end


using DiffEqJump, DiffEqBase

rate = (u,p,t) -> p[1]*u[1]*u[2]
affect! = function (integrator)
  integrator.u[1] -= 1
  integrator.u[2] += 1
end
jump = ConstantRateJump(rate,affect!)

rate = (u,p,t) -> p[2]*u[2]
affect! = function (integrator)
  integrator.u[2] -= 1
  integrator.u[3] += 1
end
jump2 = ConstantRateJump(rate,affect!)

u0 = [999,1,0]
p = (.1/1000,.01)
tspan = (0.0,2500.0)

dprob  = DiscreteProblem(u0,tspan,p)
jprob = JumpProblem(dprob,Direct(),jump,jump2,save_positions=(false,false))
sol = solve(jprob, SSAStepper())
@test sol[1,end] == 0

u02 = [1000,1,0]
p2 = (.1/1000,0.0)
dprob2 = remake(dprob, u0=u02, p=p2)
jprob2 = remake(jprob, prob=dprob2)
sol2 = solve(jprob2, SSAStepper())
@test sol2[2,end] == 1001

tspan2 = (0.0, 25000.0)
jprob3 = remake(jprob, p=p2, tspan=tspan2)
sol3 = solve(jprob3, SSAStepper())
@test sol3[2,end] == 1000
@test sol3.t[end] == 25000.0

# test error handling
@test_throws ErrorException jprob4 = remake(jprob, prob=dprob2, p=p2)
@test_throws ErrorException jprob5 = remake(jprob, aggregator=RSSA())


function FNA2_kappa_lambda(platform, N, M, threshold; options...)
    # Computation of the Gram matrix may be expensive: check if it was passed as an argument
    if haskey(options, :G_N)
        G_N = options[:G_N]
    else
        G_N = matrix(discretization(platform, N, samplingstyle=GramStyle(); options...))
    end

    G_MN = solver(platform, N, samplingstyle=OversamplingStyle(), M=M, solverstyle=DirectStyle(), directsolver=:svd, options...)
    U = G_MN.solver.U
    S = G_MN.solver.S
    V = collect(G_MN.solver.V)
    I = findlast(S .>= threshold)
    U_reg = U[:,1:I]
    V_reg = V[:,1:I]
    S_reg = S[1:I]

    # Computation of kappa
    B_MN = V_reg * inv(Diagonal(S_reg)) * U_reg'
    Q = svdvals(B_MN' * G_N * B_MN)
    kappa = sqrt(Q[1])

    # Computation of lambda
    V_eps = V[:,I+1:end]
    C_MN = V_eps * V_eps'
    Q2 = svdvals(C_MN' * G_N * C_MN)
    lambda = sqrt(Q2[1])/threshold

    kappa, lambda
end


using Roots

"""
	EulerExact(ρ1, u1, p1, ρ4, u4, p4, tEnd, n)

Classical Gas Exact Riemann Solver for shock tube problems
This programs is based on the code of
P. Wesseling. PRINCIPLES OF COMPUTATIONAL FLUID DYNAMICS Springer-Verlag, Berlin etc., 2001.
ISBN 3-540-67853-0
NOTE:
A Cavitation Check is incorporated in the code. It further prevents plotting for
 possible but physically unlikely case of expansion shocks.
# Arguments
- `ρ1::Float64`: left density at t=0.
- `u1::Float64`: left velocity at t=0.
- `p1::Float64`: left pressure at t=0.
- `ρ4::Float64`: right density at t=0.
- `u4::Float64`: right velocity at t=0.
- `p4::Float64`: right pressure at t=0.
- `tEnd::Float64`: final solution time.
- `n::Integer64`: the gas Degree of freedom.
Coded by Manuel Diaz, IAM, NTU 03/09/2011.
Migrated by Hongyang Zhou from MATLAB to Julia, 11/05/2019
"""
function EulerExact(ρ1, u1, p1, ρ4, u4, p4, tEnd, n)

   # Gamma values
   γ = (n+2)/n; α = (γ+1)/(γ-1)

   # Assumed structure of exact solution
   #
   #    \         /      |con |       |s|
   #     \   f   /       |tact|       |h|
   # left \  a  /  state |disc| state |o| right
   # state \ n /    2    |cont|   3   |c| state
   #   1    \ /          |tinu|       |k|   4
   #         |           |ity |       | |

   PRL      = p4/p1
   cright   = √(γ*p4/ρ4)
   cleft    = √(γ*p1/ρ1)
   CRL      = cright/cleft
   MachLeft = (u1-u4)/cleft

   # Basic shock tube relation equation (10.51)
   f(P) = (1 + MachLeft*(γ-1)/2 - (γ-1)*CRL*(P-1)/√(2*γ*(γ-1+(γ+1)*P)))^(2*γ/
      (γ-1))/P - PRL

   # solve for P = p34 = p3/p4
   p34 = find_zero(f, 3)

   p3 = p34*p4
   ρ3 = ρ4*(1+α*p34)/(α+p34)
   ρ2 = ρ1*(p34*p4/p1)^(1/γ)
   u2 = u1 -u4 + (2/(γ-1))*cleft*(1-(p34*p4/p1)^((γ-1)/(2*γ)))
   c2 = √(γ*p3/ρ2)
   spos = 0.5 + tEnd*cright*√((γ-1)/(2*γ)+(γ+1)/(2*γ)*p34) + tEnd*u4

   x0 = 0.5
   conpos=x0 + u2*tEnd + tEnd*u4	   # Position of contact discontinuity
   pos1 = x0 + (u1 - cleft)*tEnd	   # Start of expansion fan
   pos2 = x0 + (u2 + u4 - c2)*tEnd	# End of expansion fan

   # Plot structures
   x = 0:0.002:1
   xsize = size(x)
   p = zeros(xsize)
   ux= zeros(xsize)
   ρ = zeros(xsize)
   Mach = zeros(xsize)
   cexact = zeros(xsize)

   for i = 1:length(x)
      if x[i] ≤ pos1
         ρ[i], p[i], ux[i] = ρ1, p1, u1
         cexact[i] = √(γ*p[i]/ρ[i])
         Mach[i] = ux[i]/cexact[i]
      elseif x[i] ≤ pos2
         p[i] = p1*(1+(pos1-x[i])/(cleft*α*tEnd))^(2*γ/(γ-1))
         ρ[i] = ρ1*(1+(pos1-x[i])/(cleft*α*tEnd))^(2/(γ-1))
         ux[i] = u1 + (2/(γ+1))*(x[i]-pos1)/tEnd
         cexact[i] = √(γ*p[i]/ρ[i])
         Mach[i] = ux[i]/cexact[i]
      elseif x[i] ≤ conpos
         ρ[i], p[i], ux[i] = ρ2, p3, u2+u4
         cexact[i] = √(γ*p[i]/ρ[i])
         Mach[i] = ux[i]/cexact[i]
      elseif x[i] ≤ spos
         ρ[i], p[i], ux[i] = ρ3, p3, u2+u4
         cexact[i] = √(γ*p[i]/ρ[i])
         Mach[i] = ux[i]/cexact[i]
      else
         ρ[i], p[i], ux[i] = ρ4, p4, u4
         cexact[i] = √(γ*p[i]/ρ[i])
         Mach[i] = ux[i]/cexact[i]
      end
   end
   entro = @. log(p/ρ^γ) # entropy
   e = @. p/((γ-1)*ρ)	 # internal energy
   t = @. 2/n*e          # temperature

   return x, ρ, ux, p, e, t, Mach, entro
end

# Vector x version
function EulerExact(ρ1, u1, p1, ρ4, u4, p4, tEnd, n, x)

   # Gamma values
   γ=(n+2)/n; α=(γ+1)/(γ-1)

   # Assumed structure of exact solution
   #
   #    \         /      |con |       |s|
   #     \   f   /       |tact|       |h|
   # left \  a  /  state |disc| state |o| right
   # state \ n /    2    |cont|   3   |c| state
   #   1    \ /          |tinu|       |k|   4
   #         |           |ity |       | |

   PRL      = p4/p1
   cright   = √(γ*p4/ρ4)
   cleft    = √(γ*p1/ρ1)
   CRL      = cright/cleft
   MachLeft = (u1-u4)/cleft

   # Basic shock tube relation equation (10.51)
   f(P) = (1 + MachLeft*(γ-1)/2 - (γ-1)*CRL*(P-1)/√(2*γ*(γ-1+(γ+1)*P)))^(2*γ/
      (γ-1))/P - PRL

   # solve for P = p34 = p3/p4
   p34 = find_zero(f, 3)

   p3 = p34*p4
   ρ3 = ρ4*(1+α*p34)/(α+p34)
   ρ2 = ρ1*(p34*p4/p1)^(1/γ)
   u2 = u1 -u4 + (2/(γ-1))*cleft*(1-(p34*p4/p1)^((γ-1)/(2*γ)))
   c2 = √(γ*p3/ρ2)
   spos = 0.5 + tEnd*cright*√((γ-1)/(2*γ)+(γ+1)/(2*γ)*p34) + tEnd*u4

   x0 = 0.5
   conpos=x0 + u2*tEnd + tEnd*u4	   # Position of contact discontinuity
   pos1 = x0 + (u1 - cleft)*tEnd	   # Start of expansion fan
   pos2 = x0 + (u2 + u4 - c2)*tEnd	# End of expansion fan

   # Plot structures
   xsize = size(x)
   p = zeros(xsize)
   ux= zeros(xsize)
   ρ = zeros(xsize)
   Mach = zeros(xsize)
   cexact = zeros(xsize)

   for i = 1:length(x)
      if x[i] ≤ pos1
         ρ[i], p[i], ux[i] = ρ1, p1, u1
         cexact[i] = √(γ*p[i]/ρ[i])
         Mach[i] = ux[i]/cexact[i]
      elseif x[i] ≤ pos2
         p[i] = p1*(1+(pos1-x[i])/(cleft*α*tEnd))^(2*γ/(γ-1))
         ρ[i] = ρ1*(1+(pos1-x[i])/(cleft*α*tEnd))^(2/(γ-1))
         ux[i] = u1 + (2/(γ+1))*(x[i]-pos1)/tEnd
         cexact[i] = √(γ*p[i]/ρ[i])
         Mach[i] = ux[i]/cexact[i]
      elseif x[i] ≤ conpos
         ρ[i], p[i], ux[i] = ρ2, p3, u2+u4
         cexact[i] = √(γ*p[i]/ρ[i])
         Mach[i] = ux[i]/cexact[i]
      elseif x[i] ≤ spos
         ρ[i], p[i], ux[i] = ρ3, p3, u2+u4
         cexact[i] = √(γ*p[i]/ρ[i])
         Mach[i] = ux[i]/cexact[i]
      else
         ρ[i], p[i], ux[i] = ρ4, p4, u4
         cexact[i] = √(γ*p[i]/ρ[i])
         Mach[i] = ux[i]/cexact[i]
      end
   end
   entro = @. log(p/ρ^γ) # entropy
   e = @. p/((γ-1)*ρ)	 # internal energy
   t = @. 2/n*e          # temperature

   return x, ρ, ux, p, e, t, Mach, entro
end


using SatelliteToolbox
using Dates
using LinearAlgebra

"""
external_model(current_time,r_ecef, r_geod, cal_year=2020)

衛星外環境モデルに関わる全ての計算

# Arguments
- `current_time`: 現在時刻
- `r_ecef`: 衛星位置@ECEF
- `r_geod`: 衛星位置@Geodetic
- `cal_year`: 2020

# Returns
- `mag_vec_ecef`: 地磁場方向ベクトル@ECEF
- `sun_vecs`: 太陽方向ベクトル@SEOF
- `atoms_dens`: 大気密度スカラー

"""
function external_model(current_time,r_ecef, r_geod,r_eci_1st, eop_IAU2000A, sunvector_index, cal_year=2020)
    # 筑波大 総合研究棟B r_ecef = [3.957729931663941e6,3.3091914769971482e6,3.737926200042794e6]

    # ユリウス通日への変換
    jd = DatetoJD(current_time)

    # 地磁場ベクトル計算 @Geodetic to Geocentric
    # X軸：右手形をなすように設定
    # Y軸：東
    # Z軸：地球中心
    geoc_lat, geoc_h = GeodetictoGeocentric(r_geod[1], r_geod[3])
    mag_vec_geoc = igrf12(cal_year,geoc_h,geoc_lat,r_geod[2],Val{:geocentric})

    # mag_vec_geocのECEFへの変換
    # DCMの取得
    ez = - r_ecef/ norm(r_ecef,2) # 地球中心方向をz軸の単位ベクトルに
    ey = cross(ez,[0,0,1]) # ECEFのz軸との外積をy軸の単位ベクトルに
    ex = cross(ey,ez)
    C = DCM([ex;ey;ez])
    mag_vec_ecef = C * mag_vec_geoc

    # 太陽方向ベクトルの計算
     # 基準ベクトル(シミュレーション初期衛星位置@ECI)とのなす角を求める
    r_eci = rECEFtoECI(ITRF(), GCRF(), jd, eop_IAU2000A)*r_ecef
    cθ = dot(r_eci_1st,r_eci) / (norm(r_eci_1st)*norm(r_eci))
    rcross = cross(r_eci_1st, r_eci)
    if cθ > 1
        θ = π/2
    else
        θ = acos(cθ)
    end
    if rcross[3] < 0
        θ = 2π - θ
    end
     # indexからどの要素を抜き出すか
    index_num = round(Int64, 10*rad2deg(θ)) +1
    sun_vecs = sunvector_index[index_num, 2:4]

    # 大気密度計算
    atoms_dens = expatmosphere(ECEFtoGeodetic(r_ecef)[3])

    return mag_vec_ecef, sun_vecs, atoms_dens
end

"""
sun_vec = sunvector_model(JD_log, tles)

太陽方向ベクトルの計算

# Arguments
- `JD_1st`: シミュレート開始時刻＠ユリウス日
- `tles`: シミュレートに用いるTLE情報 SatelliteToolbox.read_tle(Name)の出力形式

# Returns
- `sun_vec`: 衛星位置 - 太陽方向ベクトル@SEOF座標系 対応の行列
             1列目が衛星位置　（時刻JD_1stにおける衛星位置ベクトルとのなす角
             2-4列目がx,y,z方向成分

"""
function sunvector_model(JD_1st, tles)
    μ = 3.98600441* (10^14)  # 重力定数
    a = (μ / ((tles[1].n * 2π / 86400)^2))^(1/3)  # 軌道長半径

     # x方向成分
    sun_angle_xp = satellite_sun_angle_earth_pointing(JD_1st, a, tles[1].e, tles[1].i, tles[1].M, tles[1].Ω, 1, [1, 0, 0])
    sun_angle_xm = satellite_sun_angle_earth_pointing(JD_1st, a, tles[1].e, tles[1].i, tles[1].M, tles[1].Ω, 1, [-1, 0, 0])
    sun_vec = zeros(length(sun_angle_xp), 4)

    #位置情報
    for i = 2:length(sun_angle_xp)
        sun_vec[i, 1] = sun_vec[i-1, 1] + 0.1
    end

    # x方向成分
    for i = 1:length(sun_angle_xp)
        if isnan(sun_angle_xp[i]) && isnan(sun_angle_xm[i])
            sun_vec[i, 2] = 0.
        elseif isnan(sun_angle_xp[i])
            sun_vec[i, 2] = -1*cos(sun_angle_xm[i])
        else
            sun_vec[i, 2] = cos(sun_angle_xp[i])
        end
    end

    # y方向成分
    sun_angle_yp = satellite_sun_angle_earth_pointing(JD_1st, a, tles[1].e, tles[1].i, tles[1].M, tles[1].Ω, 1, [0, 1, 0])
    sun_angle_ym = satellite_sun_angle_earth_pointing(JD_1st, a, tles[1].e, tles[1].i, tles[1].M, tles[1].Ω, 1, [0, -1, 0])
    for i = 1:length(sun_angle_yp)
        if isnan(sun_angle_yp[i]) && isnan(sun_angle_ym[i])
            sun_vec[i, 3] = 0.
        elseif isnan(sun_angle_yp[i])
            sun_vec[i, 3] = -1*cos(sun_angle_ym[i])
        else
            sun_vec[i, 3] = cos(sun_angle_yp[i])
        end
    end

    # z方向成分
    sun_angle_zp = satellite_sun_angle_earth_pointing(JD_1st, a, tles[1].e, tles[1].i, tles[1].M, tles[1].Ω, 1, [0, 0, 1])
    sun_angle_zm = satellite_sun_angle_earth_pointing(JD_1st, a, tles[1].e, tles[1].i, tles[1].M, tles[1].Ω, 1, [0, 0, -1])
    for i = 1:length(sun_angle_zp)
        if isnan(sun_angle_zp[i]) && isnan(sun_angle_zm[i])
            sun_vec[i, 4] = 0.
        elseif isnan(sun_angle_zp[i])
            sun_vec[i, 4] = -1*cos(sun_angle_zm[i])
        else
            sun_vec[i, 4] = cos(sun_angle_zp[i])
        end
    end

    return sun_vec

end


# equations 11-13 for spatial frequencies converted as cosh = e^x - e^-x /2
function fluence_spatial_freq(z, s, μa, μsp, l)

    D = @. 1/3μsp
    α = @. sqrt((D*s^2 + μa)/D)
    A = 1
    zb = 2*A*D[1]
    z0 = 1/(μsp[1] + μa[1])

    if z < l

        ϕ = D[1]*α[1]*(1 + exp(-2*α[1]*(l - z))) +  D[2]*α[2]*(1 - exp(-2*α[1]*(l - z)))
        ϕ = ϕ/(D[1]*α[1]*(1 + exp(-2*α[1]*(l + zb))) +  D[2]*α[2]*(1 - exp(-2*α[1]*(l + zb))))
        ϕ = ϕ*(1 + exp(-2*α[1]*(zb + z0)))/(2*D[1]*α[1])
        ϕ = ϕ*exp(α[1]*z0 - α[1]*z)

        if z < z0
            ϕ = ϕ - ((exp(α[1]*(z0 - z))*(1 - exp(-2*α[1]*(z0 - z))))/(2*D[1]*α[1]))
        end

    else

        ϕ = exp(α[1]*(z0 - l) + α[2]*(l - z))
        ϕ = ϕ*(1 - exp(-2*α[1]*(zb + z0)))
        ϕ = ϕ/(D[1]*α[1]*(1 + exp(-2*α[1]*(l + zb))) + D[2]*α[2]*(1 - exp(-2*α[1]*(l + zb))))
    end

    if isnan(ϕ) || isinf(ϕ)
        ϕ = 0
    end

    return ϕ
end

# compute equation 14 integrand
function compute_integral(ρ, z, s, μa, μsp, l)
    return fluence_spatial_freq(z, s, μa, μsp, l)*s*besselj0(ρ*s)
end

# numerically integrate equation 14
function fluence_steadystate(ρ, z, μa, μsp, l)

    ϕ = quadgk((s) -> compute_integral(ρ, z, s, μa, μsp, l), 0, Inf, rtol=1e-8)
    return ϕ[1]/2π

 end

function ss_compare(ρ, z, μa, μsp)

    D = 1/3μsp
    A = 1
    z0 = 1/(μsp + μa)
    zb = 2*A*D
    μe = sqrt(3*μa*(μa + μsp))

    ϕ = exp(-μe*sqrt((z - z0)^2 + ρ^2))/sqrt((z - z0)^2 + ρ^2)
    ϕ = ϕ - exp(-μe*sqrt((z + z0 + 2*zb)^2 + ρ^2))/sqrt((z + z0 + 2*zb)^2 + ρ^2)
    ϕ = ϕ/(4*π*D)
end

function fluence_spatial_freq(z, s, μa, μsp, l)

    D = @. 1/3μsp
    α = @. sqrt((D*s^2 + μa)/D)
    A = 1
    zb = 2*A*D[1]
    z0 = 1/(μsp[1] + μa[1])
    tolr = 1e-50
    ϕ = []

    ## equation 11
    if z < z0

        # limit as neg exp gets large
        if exp(-2*α[1]*z0) < tolr
            ϕ = 0.0
        elseif exp(-2*l) < tolr
            ϕ = exp(α[1]*z0 - α[1]*z)/(2*D[1]*α[1])
            ϕ = ϕ*(exp(-2*α[1]*(z0 - z)) - exp(-2*α[1]*(zb + z0)))
        elseif exp(-2*l*α[1]) < tolr
            ϕ = 0.0
        else
            ϕ = D[1]*α[1]*(1 + exp(-2*α[1]*(l - z))) +  D[2]*α[2]*(1 - exp(-2*α[1]*(l - z)))
            ϕ = ϕ/(D[1]*α[1]*(1 + exp(-2*α[1]*(l + zb))) +  D[2]*α[2]*(1 - exp(-2*α[1]*(l + zb))))
            ϕ = ϕ*(1 + exp(-2*α[1]*(zb + z0)))/(2*D[1]*α[1])
            ϕ = ϕ*exp(α[1]*z0 - α[1]*z)
            ϕ = ϕ - ((exp(α[1]*(z0 - z))*(1 - exp(-2*α[1]*(z0 - z))))/(2*D[1]*α[1]))
        end

    ## equation 12
    elseif z > z0 && z < l
        ϕ = D[1]*α[1]*(1 + exp(-2*α[1]*(l - z))) +  D[2]*α[2]*(1 - exp(-2*α[1]*(l - z)))
        ϕ = ϕ/(D[1]*α[1]*(1 + exp(-2*α[1]*(l + zb))) +  D[2]*α[2]*(1 - exp(-2*α[1]*(l + zb))))
        ϕ = ϕ*(1 + exp(-2*α[1]*(zb + z0)))/(2*D[1]*α[1])
        ϕ = ϕ*exp(α[1]*z0 - α[1]*z)

    #equation 13
    elseif z > l

        ϕ = exp(α[1]*(z0 - l) + α[2]*(l - z))
        ϕ = ϕ*(1 - exp(-2*α[1]*(zb + z0)))
        ϕ = ϕ/(D[1]*α[1]*(1 + exp(-2*α[1]*(l + zb))) + D[2]*α[2]*(1 - exp(-2*α[1]*(l + zb))))
    end

    return ϕ
end

function fluence_spatial_freq(z, s, μa, μsp, l)
    #get numerical instabillity at large s

    D = @. 1/(3(μsp + μa))
    α = @. sqrt((D*s^2 + μa)/D)
    A = 0.493
    zb = 2*A*D[1]
    z0 = 1/(μsp[1] + μa[1])
    tolr = 1e-50
    ϕ = zeros(Float64, 1)

    ## equation 11
    if z < z0

        # have to account for exp blowing up to inf
        if exp(α[1]*z0 - α[1]*z) > 1e8
            ϕ = 0.0
        else
            ϕ = D[1]*α[1]*(1 + exp(-2*α[1]*(l - z))) +  D[2]*α[2]*(1 - exp(-2*α[1]*(l - z)))
            ϕ = ϕ/(D[1]*α[1]*(1 + exp(-2*α[1]*(l + zb))) +  D[2]*α[2]*(1 - exp(-2*α[1]*(l + zb))))
            ϕ = ϕ*(1 + exp(-2*α[1]*(zb + z0)))/(2*D[1]*α[1])
            ϕ = ϕ*exp(α[1]*z0 - α[1]*z)
            ϕ = ϕ - ((exp(α[1]*(z0 - z))*(1 - exp(-2*α[1]*(z0 - z))))/(2*D[1]*α[1]))
        end

    ## equation 12
    elseif z > z0 && z < l
        ϕ = D[1]*α[1]*(1 + exp(-2*α[1]*(l - z))) +  D[2]*α[2]*(1 - exp(-2*α[1]*(l - z)))
        ϕ = ϕ/(D[1]*α[1]*(1 + exp(-2*α[1]*(l + zb))) +  D[2]*α[2]*(1 - exp(-2*α[1]*(l + zb))))
        ϕ = ϕ*(1 + exp(-2*α[1]*(zb + z0)))/(2*D[1]*α[1])
        ϕ = ϕ*exp(α[1]*z0 - α[1]*z)

    #equation 13
    elseif z >= l

        ϕ = exp(α[1]*(z0 - l) + α[2]*(l - z))
        ϕ = ϕ*(1 - exp(-2*α[1]*(zb + z0)))
        ϕ = ϕ/(D[1]*α[1]*(1 + exp(-2*α[1]*(l + zb))) + D[2]*α[2]*(1 - exp(-2*α[1]*(l + zb))))
    end

    return ϕ
end

function manual_integral(ρ, z, μa, μsp, l)

    xs = 0:0.001:300
    a = map((s) -> fluence_spatial_freq(z, s, μa, μsp, l), xs)
    b = a.*xs
    c  = b.*[besselj0(ρ*x) for x in xs]
    return c
end

# compute equation 14 integrand
function compute_integral(ρ, z, s, μa, μsp, l)
    return fluence_spatial_freq(z, s, μa, μsp, l)*s*besselj0(ρ*s)
end

# numerically integrate equation 14
function fluence_steadystate(ρ, z, μa, μsp, l)

    ϕ = quadgk((s) -> compute_integral(ρ, z, s, μa, μsp, l), 0, Inf, rtol=1e-8)
    return ϕ[1]/2π

 end


function compute()

	n=BigInt(100)
	str=string(factorial(n));
	ans=0
	for i=1:length(str)
		ans+=str[i]-'0'
	end
	return ans

end

println(compute())