# # Solve the heat conduction equation

# Synopsis: Compute the solution of the Poisson equation of heat conduction with a
# nonzero heat source. Quadrilateral four-node elements are used.

# The problem is linear heat conduction equation posed on a bi-unit square,
# solved with Dirichlet boundary conditions around the circumference. Uniform
# nonzero heat generation rate is present. The exact solution is in this way
# manufactured and hence known. That gives us an opportunity to calculate the
# true error.

# The complete code is in the file [`tut_poisson_q4.jl`](tut_poisson_q4.jl).

# The solution will be defined  within a module in order to eliminate conflicts
# with data or functions defined elsewhere.

module tut_poisson_q4

# We'll need some functionality from linear algebra, and the mesh libraries.
# Finally we will need the `Elfel` functionality.
using LinearAlgebra
using MeshCore.Exports
using MeshSteward.Exports
using Elfel.Exports

# This is the top level function.
function run()
    # Input parameters:
    A = 1.0 # length of the side of the square
    kappa =  1.0; # thermal conductivity of the material
    Q = -6.0; # internal heat generation rate
    tempf(x, y) =(1.0 + x^2 + 2.0 * y^2); # the exact distribution of temperature
    N = 1000; # number of element edges along the sides of the square domain

    # Generate the computational mesh.
    mesh = genmesh(A, N)

    # Create the finite element space to represent the temperature solution. The
    # degrees of freedom are real numbers (`Float64`), the quadrilaterals are
    # defined by the mesh, and each of the elements has the continuity ``H
    # ^1``, i. e. both the function values and the derivatives are square
    # integrable.
    Uh = FESpace(Float64, mesh, FEH1_Q4())

    # Apply the essential boundary conditions at the circumference of the square
    # domain. We find the boundary incidence relation (`boundary(mesh)`), and
    # then the list of all vertices connected by the boundary cells. The
    # function `tempf` defines the analytical temperature variation, and hence
    # for each of the vertices `i` on the boundary (they are of manifold
    # dimension  `0`), we set the component of the field (1) to the exact value
    # of the temperature at that location.
    vl = connectedv(boundary(mesh));
    locs = geometry(mesh)
    for i in vl
        setebc!(Uh, 0, i, 1, tempf(locs[i]...))
    end

    # Number the degrees of freedom, both the unknowns and the data
    # (prescribed) degrees of freedom.
    numberdofs!(Uh)
    @show ndofs(Uh), nunknowns(Uh)

    # Assemble the conductivity matrix and the vector of the heat loads. Refer
    # to the definition of this function below.
    K, F = assembleKF(Uh, kappa, Q)

    # This is a vector to hold all degrees of freedom in the system.
    T = fill(0.0, ndofs(Uh))
    # Here we collect the data degrees of freedom (the known values).
    gathersysvec!(T, Uh)

    # The system of linear algebraic equations is solved.
    solve!(T, K, F, nunknowns(Uh))

    # The values of all the degrees of freedom can now be introduced into the
    # finite element space.
    scattersysvec!(Uh, T)

    # Here we associate the values of the finite element space with the entities
    # of the mesh as an attribute.
    makeattribute(Uh, "T", 1)

    # The correctness of the solution is checked by comparing the values at the
    # vertices.
    checkcorrectness(Uh, tempf)

    # The attribute can now be written out for visualization into a VTK file.
    vtkwrite("q4-T", baseincrel(mesh), [(name = "T",)])

    true # return success
end

# The domain is a square, meshed with quadrilateral elements. The function
# `Q4block` creates an incidence relation that defines the quadrilateral
# element shapes by the vertices connected into the shapes. This incidence
# relation is then attached to the mesh and the mesh is returned.
function genmesh(A, N)
    conn = Q4block(A, A, N, N)
    return attach!(Mesh(), conn)
end

# The `assembleKF` function constructs the left-hand side coefficient matrix,
# conductivity matrix, as a sparse matrix, and a vector of the heat loads due
# to the internal heat generation rate `Q`.

# The boundary value problem is expressed in this weak form
# ```math
# \int_{V}(\mathrm{grad}\vartheta)\; \kappa (\mathrm{grad}T
#             )^T\; \mathrm{d} V
#             -\int_{V}  \vartheta Q \; \mathrm{d} V
#              = 0
# ```
# where the test function vanishes on the boundary where the temperature is
# prescribed, ``\vartheta(x) =0``  for  ``x \in{S_1}``
# Substituting ``\vartheta = N_j `` and ``T = \sum_i N_i T_i`` we obtain the
# linear algebraic equations
# ```math
# \sum_i T_i \int_{V} \mathrm{grad}N_j \; \kappa (\mathrm{grad}N_i)^T\; \mathrm{d} V
#  -\int_{V}  N_j Q \; \mathrm{d} V  = 0 , \quad \forall j.
# ```
# The volume element is ``\mathrm{d} V``, which in our case
# becomes ``1.0\times\mathrm{d} S``, since the thickness of the two
# dimensional domain is assumed to be 1.0.

function assembleKF(Uh, kappa, Q)
    # At the top of the `assembleKF` we look at the function `integrate!` to
    # evaluate the weak-form integrals. The key to making this calculation
    # efficient is type stability. All the arguments coming in must have
    # concrete types. This is why the `integrate!` function is an inner
    # function: the function barrier allows for all arguments to be resolved to
    # concrete types.
    function integrate!(am, av, elit, qpit, kappa, Q)
        nedof = ndofsperel(elit)
        # The local assemblers are just like matrices or vectors
        ke = LocalMatrixAssembler(nedof, nedof, 0.0)
        fe = LocalVectorAssembler(nedof, 0.0)
        for el in elit # Loop over all elements
            init!(ke, eldofs(el), eldofs(el)) # zero out elementwise matrix
            init!(fe, eldofs(el)) # and vector
            for qp in qpit # Now loop over the quadrature points
                Jac, J = jacjac(el, qp) # Calculate the Jacobian matrix, Jacobian
                gradN = bfungrad(qp, Jac) # Evaluate the spatial gradients
                JxW = J * weight(qp) # elementary volume
                N = bfun(qp) # Basis function values at the quadrature point
                # This double loop evaluates the elementwise conductivity
                # matrix and the heat load vector precisely as the formula of
                # the weak form  dictates; see above.
                for i in 1:nedof
                    for j in 1:nedof
                        ke[j, i] += dot(gradN[j], gradN[i]) * (kappa * JxW)
                    end
                    fe[j] += N[j] * Q * JxW
                end
            end
            # Assemble the calculated contributions from this element
            assemble!(am, ke)
            assemble!(av, fe)
        end
        return am, av # Return the updated assemblers
    end

    # In the `assembleKF` function we first we create the element iterator. We
    # can go through all the elements that define the domain of integration
    # using this iterator. Each time a new element is accessed, some data are
    # precomputed such as the element degrees of freedom.
    elit = FEIterator(Uh)
    # This is the quadrature point iterator. We know that the elements are
    # quadrilateral, which makes the Gauss integration rule the obvious choice.
    # We also select order 2 for accuracy. Quadrature-point iterators provide
    # access to basis function values and gradients, the Jacobian matrix and
    # the Jacobian determinant, the location of the quadrature point and so
    # on.
    qpit = QPIterator(Uh, (kind = :Gauss, order = 2))
    # Next we create assemblers, one for the sparse system matrix and one for
    # the system vector.
    am = start!(SysmatAssemblerSparse(0.0), ndofs(Uh), ndofs(Uh))
    av = start!(SysvecAssembler(0.0), ndofs(Uh))
    # Now we call the integration function. The assemblers are modified inside
    # this function...
    @time integrate!(am, av, elit, qpit, kappa, Q)
    # ...so that when the integration is done, we can materialize the sparse
    # matrix and the vector and return them.
    return finish!(am), finish!(av)
end

# The linear algebraic system is solved by partitioning. The vector `T` is
# initially all zero, except in the degrees of freedom which are prescribed as
# nonzero. Therefore the product of the conductivity matrix and the vector `T`
# are the heat loads due to nonzero essential boundary conditions. To this we
# add the vector of heat loads due to the internal heat generation rate. The
# submatrix of the heat conduction matrix corresponding to the free degrees of
# freedom (unknowns), `K[1:nu, 1:nu]` is then used to solve for the unknowns `T
# [1:nu]`.
function solve!(T, K, F, nu)
    @time KT = K * T
    @time T[1:nu] = K[1:nu, 1:nu] \ (F[1:nu] - KT[1:nu])
end

# The correctness can be checked in various ways. Here we calculate the mean
# deviation of the calculated temperatures at the nodes relative to the exact
# values of the temperature.
function checkcorrectness(Uh, tempf)
    geom = geometry(Uh.mesh)
    ir = baseincrel(Uh.mesh)
    T = attribute(ir.right, "T")
    std = 0.0
    for i in 1:length(T)
        std += abs(T[i][1] - tempf(geom[i]...))
    end
    @show (std / length(T)) <= 1.0e-9
end

end # module

# The module can now be used.
using .tut_poisson_q4
tut_poisson_q4.run()


"""
    complement(g)

Produces the [graph complement](https://en.wikipedia.org/wiki/Complement_graph)
of a graph.
"""
function complement(g::Graph)
    gnv = nv(g)
    h = Graph(gnv)
    for i=1:gnv
        for j=i+1:gnv
            if !has_edge(g, i, j)
                add_edge!(h,i,j)
            end
        end
    end
    return h
end

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

"""
    reverse(g::DiGraph)

Produces a graph where all edges are reversed from the
original.
"""
function reverse(g::DiGraph)
    gnv = nv(g)
    gne = ne(g)
    h = DiGraph(gnv)
    h.fadjlist = deepcopy(g.badjlist)
    h.badjlist = deepcopy(g.fadjlist)
    h.ne = gne
    h.vertices = g.vertices

    return h
end

"""
    reverse!(g::DiGraph)

In-place reverse (modifies the original graph).
"""
function reverse!(g::DiGraph)
    g.fadjlist, g.badjlist = g.badjlist, g.fadjlist
    return g
end

doc"""
    blkdiag(g, h)

Produces a graph with $|V(g)| + |V(h)|$ vertices and $|E(g)| + |E(h)|$
edges.

Put simply, the vertices and edges from graph `h` are appended to graph `g`.
"""
function blkdiag{T<:SimpleGraph}(g::T, h::T)
    gnv = nv(g)
    r = T(gnv + nv(h))
    for e in edges(g)
        add_edge!(r, e)
    end
    for e in edges(h)
        add_edge!(r, gnv+src(e), gnv+dst(e))
    end
    return r
end

"""
    intersect(g, h)

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

Note that this function may produce a graph with 0-degree vertices.
"""
function intersect{T<:SimpleGraph}(g::T, h::T)
    gnv = nv(g)
    hnv = nv(h)

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

"""
    difference(g, h)

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

Note that this function may produce a graph with 0-degree vertices.
"""
function difference{T<:SimpleGraph}(g::T, h::T)
    gnv = nv(g)
    hnv = nv(h)

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

"""
    symmetric_difference(g, h)

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

Note that this function may produce a graph with 0-degree vertices.
"""
function symmetric_difference{T<:SimpleGraph}(g::T, h::T)
    gnv = nv(g)
    hnv = nv(h)

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

"""
    union(g, h)

Merges graphs `g` and `h` by taking the set union of all vertices and edges.
"""
function union{T<:SimpleGraph}(g::T, h::T)
    gnv = nv(g)
    hnv = nv(h)

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

"""
    join(g, h)

Merges graphs `g` and `h` using `blkdiag` and then adds all the edges between
 the vertices in `g` and those in `h`.
"""
function join(g::Graph, h::Graph)
    r = blkdiag(g, h)
    for i=1:nv(g)
        for j=nv(g)+1:nv(g)+nv(h)
            add_edge!(r, i, j)
        end
    end
    return r
end

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

Replicate `len` times `h` and connect each vertex with its copies in a path
"""
crosspath(len::Integer, g::Graph) = cartesian_product(PathGraph(len), g)

"""
    induced_subgraph(g, iter)

Filters graph `g` to include only the vertices present in the iterable
argument `vs`. Returns the subgraph of `g` induced by `vs`.
"""
function induced_subgraph{T<:SimpleGraph}(g::T, iter)
    n = length(iter)
    isequal(n, length(unique(iter))) || error("Vertices in subgraph list must be unique")
    isequal(n, nv(g)) && return copy(g) # if iter is not a proper subgraph

    h = T(n)
    newvid = Dict{Int, Int}()
    i=1
    for (i,v) in enumerate(iter)
        newvid[v] = i
    end

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

# dispatch for g[[1,2,3]], g[1:3], g[Set([1,2,3])]
# these are the only allowed dispatches, everything else is slow
getindex(g::SimpleGraph, iter) = induced_subgraph(g, iter)

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

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

"""sum(g,i) provides 1:indegree or 2:outdegree vectors"""
function sum(g::SimpleGraph, dim::Int)
    dim == 1 && return indegree(g, vertices(g))
    dim == 2 && return outdegree(g, vertices(g))
    error("Graphs are only two dimensional")
end

size(g::SimpleGraph) = (nv(g), nv(g))
"""size(g,i) provides 1:nv or 2:nv else 1 """
size(g::Graph,dim::Int) = (dim == 1 || dim == 2)? nv(g) : 1

"""sum(g) provides the number of edges in the graph"""
sum(g::SimpleGraph) = ne(g)

"""sparse(g) is the adjacency_matrix of g"""
sparse(g::SimpleGraph) = adjacency_matrix(g)

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

"""
    cartesian_product(g, h)

Returns the (cartesian product)[https://en.wikipedia.org/wiki/Tensor_product_of_graphs] of `g` and `h`
"""
function cartesian_product{G<:SimpleGraph}(g::G, h::G)
    z = G(nv(g)*nv(h))
    id(i, j) = (i-1)*nv(h) + j
    for (i1, i2) in edges(g)
        for j=1:nv(h)
            add_edge!(z, id(i1,j), id(i2,j))
        end
    end

    for e in edges(h)
        j1, j2 = src(e), dst(e)
        for i=1:nv(g)
            add_edge!(z, id(i,j1), id(i,j2))
        end
    end
    return z
end

"""
    tensor_product(g, h)

Returns the (tensor product)[https://en.wikipedia.org/wiki/Tensor_product_of_graphs] of `g` and `h`
"""
function tensor_product{G<:SimpleGraph}(g::G, h::G)
    z = G(nv(g)*nv(h))
    id(i, j) = (i-1)*nv(h) + j
    for (i1, i2) in edges(g)
        for (j1, j2) in edges(h)
            add_edge!(z, id(i1, j1), id(i2, j2))
        end
    end
    return z
end


"Solve Computing Eccentric Anomaly from Mean Anomally via Kepler's Equation"
module KeplerEqn

export calc_ecc_anom
export calc_ecc_anom_cpu, calc_ecc_anom_gpu
using CUDAnative

"""   ecc_anom_init_guess_danby(M, ecc)
Initial guess for eccentric anomaly given mean anomaly (M) and eccentricity (ecc)
    Based on "The Solution of Kepler's Equations - Part Three"
    Danby, J. M. A. (1987) Journal: Celestial Mechanics, Volume 40, Issue 3-4, pp. 303-312  1987CeMec..40..303D
"""
function ecc_anom_init_guess_danby(M, ecc)
    k = convert(typeof(ecc),0.85)
    if(M<zero(M)) M += 2pi end
    (M<pi) ? M + k*ecc : M - k*ecc;
end

"""   update_ecc_anom_laguerre(E, M, ecc)
Update the current guess (E) for the solution to Kepler's equation given mean anomaly (M) and eccentricity (ecc)
   Based on "An Improved Algorithm due to Laguerre for the Solution of Kepler's Equation"
   Conway, B. A.  (1986) Celestial Mechanics, Volume 39, Issue 2, pp.199-211  1986CeMec..39..199C
"""
function update_ecc_anom_laguerre(E, M, ecc)
  es = ecc*sin(E)
  ec = ecc*cos(E)
  F = (E-es)-M
  Fp = one(E)-ec
  Fpp = es
  n = 5
  root = sqrt(abs((n-1)*((n-1)*Fp*Fp-n*F*Fpp)))
  denom = Fp>zero(E) ? Fp+root : Fp-root
  return E-n*F/denom
end

"Same as update_ecc_anom_laguerre_cpu, except uses GPU math functions"
function update_ecc_anom_laguerre_gpu(E, M, ecc)
  es = ecc*CUDAnative.sin(E)
  ec = ecc*CUDAnative.cos(E)
  F = (E-es)-M
  Fp = one(E)-ec
  Fpp = es
  n = 5
  root = CUDAnative.sqrt(abs((n-1)*((n-1)*Fp*Fp-n*F*Fpp)))
  denom = Fp>zero(E) ? Fp+root : Fp-root
  return E-n*F/denom
end

"Loop to update the current estimate of the solution to Kepler's equation"
function calc_ecc_anom_itterative_laguerre(mean_anom, ecc, tol, max_its)
    M = mod(mean_anom,convert(typeof(mean_anom),2pi))
    E = ecc_anom_init_guess_danby(M,ecc)
    for i in 1:max_its
       E_old = E
       E = update_ecc_anom_laguerre(E_old, M, ecc)
       if abs(E-E_old)<convert(typeof(mean_anom),tol) break end
    end
    return E
end

"Loop to update the current estimate of the solution to Kepler's equation.  Calls GPU update"
function calc_ecc_anom_itterative_laguerre_gpu(mean_anom, ecc, tol, max_its)
    @assert zero(ecc) <= ecc < one(ecc)
    @assert tol*100 <= one(tol)
    M = mod(mean_anom,convert(typeof(mean_anom),2pi))
    E = ecc_anom_init_guess_danby(M,ecc)
    for i in 1:max_its
       E_old = E
       E = update_ecc_anom_laguerre_gpu(E_old, M, ecc)
       if abs(E-E_old)<convert(typeof(mean_anom),tol) break end
    end
    return E
end

const default_max_its_laguerre = 200
const default_ecc_anom_tol = 1e-8
"Calculate eccentric anomaly given mean anomaly and eccentricty (in radians)"
calc_ecc_anom_cpu(mean_anom, ecc) = calc_ecc_anom_itterative_laguerre(mean_anom, ecc, default_ecc_anom_tol, default_max_its_laguerre)
calc_ecc_anom_gpu(mean_anom, ecc) = calc_ecc_anom_itterative_laguerre_gpu(mean_anom, ecc, default_ecc_anom_tol, default_max_its_laguerre)
calc_ecc_anom(mean_anom, ecc) = calc_ecc_anom_cpu(mean_anom, ecc)

end # module KeplerEqn


using Revise, Random, LinearAlgebra, Optim, StatsBase,
  Statistics, Distributions, COSMO, BenchmarkTools, Plots

Random.seed!(11)

#compute the minvol portfolio given a return target, expected returns z, and Σ
function minvolw(μ, z, Σ, Σinv = Σ\I)
  K= length(z)
  some1s = ones(K)

  A = some1s' * Σinv * some1s
  B = some1s' * Σinv * z
  C = z' * Σinv * z

  λ =(μ * B - C) /(B^2 - A*C)
  γ = (μ * A - B) /(A*C -B^2)

  w = λ * Σinv * some1s .+ γ * Σinv * z

  return w
end

#same as before but acquires the solution numerically
function nminvolw(μ, z, Σ)
  K= length(z)
  some1s = ones(K)

  m = COSMO.Model()
  c1 = COSMO.Constraint(ones(1,K), -1.0, COSMO.ZeroSet)
  c2 = COSMO.Constraint(z', -μ, COSMO.ZeroSet)
  COSMO.assemble!(m, Σ, zeros(K), [c1; c2])
  res = COSMO.optimize!(m)

  return res.x

  #return w
end

function gengraphs(;N=10^5, K=15, Δ=0.001)
  Erm = 0.08 #expected market reutn
  rf = 0.02 #risk free rate
  σm = 0.1 #market standard deviation

  ivol = rand(K)*0.4 .+ 0.1 #stock ivols
  beta = rand(Normal(1,0.2), K) #stock betas

  rm = rand(Normal(Erm, σm), N) #the market returns
  noise = reduce(hcat, (σe->rand(Normal(0, σe), N)).(ivol))
  r = rm .* beta' .+ noise

  z = mean(r, dims=1) |> vec
  Σ = cov(r)

  #sanity check
  Σinv = Σ\I
  w = minvolw(0.1, z, Σ, Σinv)
  nw = nminvolw(0.1, z, Σ)
  @assert w ≈ nw

  minvolσ(μ) = minvolw(μ, z, Σ, Σinv) |> (w)->(w'*Σ*w)^0.5
  nminvolσ(μ) = nminvolw(μ, z, Σ) |> (w)->(w'*Σ*w)^0.5

  #compute the minimum variance frontier
  μs = 0.01:Δ:0.2 |> collect
  σs = similar(μs)
  Threads.@threads for i ∈ 1:length(μs)
    σs[i] = minvolσ(μs[i])
  end

  #compute global min var portfolio
  some1s = ones(K)
  A = some1s' * Σinv * some1s
  B = some1s' * Σinv * z

  wg = Σinv * some1s / A
  σg = (wg'*Σ*wg)^(0.5)
  rg = z' * wg

  #compute the tangency portfolio
  wt = Σinv * (z .- some1s .* rf) ./ (B-rf*A)
  rt = z'*wt
  σt = (wt'*Σ*wt)^(0.5)

  pth = "C:\\Users\\Clinton\\Dropbox\\AAtawork\\ChernovInvestments\\Investments\\2020\\Exams\\final"
  p = plot(σs, μs,
    yaxis = ("E(r)", (0.0,0.16), :none),
    yticks=(0.0:0.02:0.16),
    xaxis=("vol", (0.0,0.4),),
    xticks=(0.0:0.05:0.4),
    title="Minimum Variance Frontier",
    legend=:none,
    linestyle=:dot,
    linecolor=:black)

  pans = p |> deepcopy

  plot!(pans, [0.0; σt; σs[μs .> rt]], [rf; rt; μs[μs .> rt]],
    linestyle=:dash, seriestype=:path, linecolor=:black, linewidth=4,
    annotations=(σt*1.5, rt*1.2,
    Plots.text("min var frontier\n (rf asset, no borrowing)", :left, 7,)))
  plot!(pans, [0.0; σt; σt*10], [rf; rt; (rt-rf)*10],
    linestyle=:solid, seriestype=:path, linecolor=:black, linewidth=2,
    annotations=(σt*1.1, rt*1.6,
    Plots.text("min varfrontier\n (rf asset, borrowing)", :left, 7,)))

  #scatter!(pans, [0.0], [rf], markersize=6)
  scatter!(pans, [σt], [rt], markersize=6,
    annotations=(σt+0.005, rt-0.0025, Plots.text("tangency portfolio", :left, 7,)))
  scatter!(pans, [σg], [rg],markersize=6,
    annotations=(σg+0.005, rg-0.0025, Plots.text("global min var portfolio", :left, 7,)))
  savefig(p, "$pth\\problem3.pdf")
  savefig(pans, "$pth\\problemans3.pdf")

end

@time gengraphs()


using OrdinaryDiffEq, Distributions,
      DiffEqUncertainty, Test, Quadrature, Cubature

function f(du,u,p,t)
  @inbounds begin
    du[1] = dx = p[1]*u[1] - u[1]*u[2]
    du[2] = dy = -3*u[2] + u[1]*u[2]
  end
  nothing
end

u0 = [1.0;1.0]
tspan = (0.0,10.0)
p = [1.5]
prob = ODEProblem(f,u0,tspan,p)
sol = solve(remake(prob,u0=u0),Tsit5())
cost(sol) = sum(max(x[1]-6,0) for x in sol.u)
u0s = [Uniform(0.25,5.5),Uniform(0.25,5.5)]
ps  = [Uniform(0.5,2.0)]
@time sol = koopman_expectation(cost,u0s,ps,prob,Tsit5();iabstol=1e-3,ireltol=1e-3,maxiters=1000,saveat=0.1)
c1, e1 = sol.u, sol.resid
@time sol = koopman_expectation(cost,u0s,ps,prob,Tsit5(),EnsembleThreads();quadalg=CubatureJLh(),
                         batch=1000,iabstol=1e-3,ireltol=1e-3,
                         maxiters=2000,saveat=0.1)
c2, e2 = sol.u, sol.resid
@test abs(c1 - c2) < 0.1

@time c3 = montecarlo_expectation(cost,u0s,ps,prob,Tsit5(),EnsembleThreads();trajectories=100000,saveat=0.1)
@test abs(c1 - c3) < 0.1

#=
using DiffEqGPU
@time sol = koopman_expectation(cost,u0s,ps,prob,Tsit5(),EnsembleGPUArray();quadalg=CubatureJLh(),
                         batch=1000,iabstol=1e-3,ireltol=1e-3,
                         maxiters=2000,saveat=0.1)
c2, e2 = sol.u, sol.resid
@test abs(c1 - c2) < 0.1

@time c3 = montecarlo_expectation(cost,u0s,ps,prob,Tsit5(),EnsembleGPUArray();trajectories=100000,saveat=0.1)
@test abs(c1 - c3) < 0.1
=#


import JuLIP.Potentials: @pot, @D, evaluate, evaluate_d, PairPotential, @analytic

@pot type Morseold <: PairPotential
   e0::Float64
   A::Float64
   r0::Float64
end
evaluate(p::Morseold, r) = p.e0 * (exp(-2*p.A*(r/p.r0-1.0)) - 2.0*exp(-p.A*(r/p.r0-1.0)))
evaluate_d(p::Morseold, r) = -2.0*p.e0*p.A/p.r0*(exp(-2*p.A*(r/p.r0-1.0)) - exp(-p.A*(r/p.r0-1.0)))

const e0 = 0.99
const r0 = 1.05
const A = 4.1

morse = @analytic( r -> e0 * (exp(-2*A*(r/r0-1.0)) - 2.0*exp(-A*(r/r0-1.0))) )
@show typeof(morse)
morseold = Morseold(e0, A, r0)

rr = collect(linspace(0.9, 2.1, 100))
morse_r = morse.(rr)
morseold_r = morseold.(rr)
dmorse_r = [(@D morse(r)) for r in rr]
dmorseold_r = [ (@D morseold(r)) for r in rr ]

println("Check consistency of hand-coded and analytic Morse potentials...")
@test vecnorm(morse_r - morseold_r, Inf) < 1e-12
@test vecnorm(dmorse_r - dmorseold_r, Inf) < 1e-12

function test(N, p)
   r = 1.234
   s = 0.0
   for n = 1:N
      s += p(r)
   end
   return s
end

function testgrad(N, p)
   r = 1.234
   s = 0.0
   for n = 1:N
      s += @D p(r)
   end
   return s
end

test(10, morse);
test(10, morseold);
testgrad(10, morse);
testgrad(10, morseold);

println("1M evaluations of Analytic Potential")
@time test(1_000_000, morse)
println("1M evaluations of old Potential")
@time test(1_000_000, morseold)
println("1M ∇ evaluations of Analytic Potential")
@time testgrad(1_000_000, morse)
println("1M ∇ evaluations of old Potential")
@time testgrad(1_000_000, morseold)


@safetestset "CanonicalSymplecticMatrix" begin
    using PoincareInvariants: CanonicalSymplecticMatrix
    using LinearAlgebra: dot

    @test CanonicalSymplecticMatrix{Int}(2) == [0 -1; 1 0]
    @test CanonicalSymplecticMatrix{Int}(4) == [0 0 -1 0; 0 0 0 -1; 1 0 0 0; 0 1 0 0]
    @test CanonicalSymplecticMatrix{Int}(6) == [0  0  0 -1  0  0;
                                                0  0  0  0 -1  0;
                                                0  0  0  0  0 -1;
                                                1  0  0  0  0  0;
                                                0  1  0  0  0  0;
                                                0  0  1  0  0  0]

    function test_canonicalmatrix(mat, n, ::Type{T}) where T
        mid = n ÷ 2

        for i in 1:n, j in 1:n
            if i == j - mid
                mat[i, j] === T(-1) || return false
            elseif i - mid == j
                mat[i, j] === T(1) || return false
            else
                mat[i, j] === T(0) || return false
            end
        end

        return true
    end

    @testset "CanonicalSymplecticMatrix{$T}($n)" for T in [Int, Float64], n in [10, 100, 1000]
        @test CanonicalSymplecticMatrix(n) === CanonicalSymplecticMatrix{Int}(n)

        C = CanonicalSymplecticMatrix{T}(n)
        @test size(C) == (n, n)
        @test eltype(C) == T

        mid = n ÷ 2

        @test test_canonicalmatrix(C, n, T)

        @test C * collect(1:n) == [(-mid-1:-1:-n)..., 1:mid...]

        @test dot(ones(n), C, ones(n)) == 0

        @test_throws ArgumentError CanonicalSymplecticMatrix{T}(n + 1)
    end
end


function get_non_dominated_solutions_perm(population)
    ids = Int[1]
    n = length(population)

    for i in 2:n
        j = 1
        while j <= length(ids)
            jj = ids[j]
            relation = compare(population[i], population[jj])

            if relation == 2 # j dominates i
                break
            elseif relation == 1 # i dominates j
                deleteat!(ids, j)
                continue
            end

            j += 1
        end

        if j > length(ids)
            push!(ids, i)
        end

    end

    return ids
end

function get_non_dominated_solutions(population)

    mask = get_non_dominated_solutions_perm(population)
    return population[mask]

end

"""
    gen_ref_dirs(dimension, n_paritions)
Generates Das and Dennis's structured reference points. `dimension` could be
the number of objective functions in multi-objective functions.
"""
function gen_ref_dirs(dimension, n_paritions)
    return  gen_weights(dimension, n_paritions)
end

function gen_weights(a, b)
    nobj = a;
    H    = b;
    a    = zeros(nobj);
    d    = H;
    w    = [];
    produce_weight!(a, 1, d, H, nobj, w)
    return Array.(w)
end

function  produce_weight!(a, i, d, H, nobj, w)
    for k=0:d
        if i<nobj
            a[i] = k;
            d2   = d - k;
            produce_weight!(a, i+1, d2, H, nobj, w);
        else
            a[i] = d;
            push!(w, a/H)
            break;
        end
    end
end

"""
    ideal(points)

Computes the ideal point from a provided array of `Vector`s or a population or row vectors
in a `Matrix`.
"""
function ideal(points::Array{Vector{T}}) where T <: Real

    isempty(points) && isempty(points[1]) && return zeros(0)

    ideal = points[1]

    for point in points
        ideal = min.(ideal, point)
    end

    return ideal

end

"""
    nadir(points)

Computes the nadir point from a provided array of `Vector`s or a population or row vectors
in a `Matrix`.
"""
function nadir(points::Array{Vector{T}})  where T <: Real

    isempty(points) && isempty(points[1]) && return zeros(0)

    nadir = points[1]

    for point in points
        nadir = max.(nadir, point)
    end

    return nadir
end

function ideal(population::Array{xFgh_indiv})
    mask = sum_violations.(population) .== 0

    ideal(fval.(population[mask]))
end
ideal(A::Matrix) = ideal([A[i,:]  for i in 1:size(A,1)])

function nadir(population::Array{xFgh_indiv})
    mask = sum_violations.(population) .== 0

    nadir(fval.(population[mask]))
end

nadir(A::Matrix) = nadir([A[i,:]  for i in 1:size(A,1)])


"""
    $(SIGNATURES)

Discretize given percentiles (unweighted). The smallest `pctV[1]` of values in `inV` end up in bin 1, etc.
"""
function discretize_given_percentiles(inV :: AbstractVector{F1},
    pctV :: AbstractVector{F2}) where {F1, F2}

    edgeV = bin_edges_from_percentiles(inV, pctV);
    return discretize(inV, edgeV)
end

"""
    $(SIGNATURES)

Discretize given percentiles (weighted). The smallest `pctV[1]` of values in `inV` end up in bin 1, etc.
"""
function discretize_given_percentiles(inV :: AbstractVector{F1},
    wtV :: AbstractVector{F2},
    pctV :: AbstractVector{F3}) where {F1, F2, F3}

   edgeV = bin_edges_from_percentiles(inV, wtV, pctV);
   return discretize(inV, edgeV)
end

## Discretize given bounds
# Equivalent to Discretizers LinearDiscretizer
function discretize(inV :: AbstractVector{F1},
    edgeV :: AbstractVector{F2}) where {F1, F2}

    n = length(edgeV);
    outV = zeros(Int64, size(inV));
    for i1 = n : -1 : 2
        outV[inV .<= edgeV[i1]] .= i1 - 1;
    end
    outV[inV .<= edgeV[1]] .= 0;
    return outV
end

"""
Bin edges from percentiles (unweighted)
Lowest bin includes minimum of inV
"""
function bin_edges_from_percentiles(inV :: AbstractVector{F1},
    pctV :: AbstractVector{F2}) where {F1, F2}

    edgeV = quantile(inV, [zero(F2); pctV]);
    # Ensure that lowest point is inside edges
    edgeV[1] -= F1(1e-8);
    return edgeV
end

## Bin edges from percentiles (weighted)
function bin_edges_from_percentiles(inV :: AbstractVector{F1},
    wtV :: AbstractVector{F2}, pctV :: AbstractVector{F3}) where {F1, F2, F3}

    @assert check_weights(wtV)  "Invalid weights"
    # Quantile is also a built in function
    edgeV = [minimum(inV) - F1(1e-8); quantile(inV, Weights(wtV), pctV)];
    edgeV[end] += F1(1e-8);
    return edgeV
end

"""
	$(SIGNATURES)

Count how many cases occur in each bin. Unweighted.
"""
function count_bins(inV :: AbstractVector{F1},
    edgeV :: AbstractVector{F2}) where {F1, F2}

    nBins = length(edgeV) - 1;
    cntV = Vector{Int}(undef, nBins);
    for iBin = 1 : nBins
        cntV[iBin] = sum(x -> inbin(x, edgeV, iBin), inV);
    end
    return cntV
end

"""
	$(SIGNATURES)

Count how many cases occur in each bin. Weighted.
"""
function count_bins(inV :: AbstractVector{F1},
    wtV :: AbstractVector{F2},
    edgeV :: AbstractVector{F3}) where {F1, F2, F3}

    @assert check_weights(wtV)  "Invalid weights"
    nBins = length(edgeV) - 1;
    massV = Vector{Float64}(undef, nBins);
    for iBin = 1 : nBins
        massV[iBin] = mapreduce(
            (x, wt) -> (inbin(x, edgeV, iBin) ? wt : zero(F2)),
            +, inV, wtV);
    end
    return massV
end

inbin(x, edgeV, iBin) = (x > edgeV[iBin])  &&  (x <= edgeV[iBin+1]);

function check_weights(wtV :: AbstractVector{F1}) where F1
    isValid = true;
    if any_less(wtV, zero(F1))
        @warn "Negative weights"
        isValid = false;
    end
    return isValid
end

# ------------


#*******************************************************/
#* Copyright(c) 2018 by Artelys                        */
#* This source code is subject to the terms of the     */
#* MIT Expat License (see LICENSE.md)                  */
#*******************************************************/

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#  This example demonstrates how to use Knitro to solve the following
#  simple quadratically constrained quadratic programming problem(QCQP).
#
#  min   1000 - x0^2 - 2 x1^2 - x2^2 - x0 x1 - x0 x2 #  s.t.  8 x0 + 14 x1 + 7 x2 = 56
#        x0^2 + x1^2 + x2^2 >= 25
#        x0 >= 0, x1 >= 0, x2 >= 0
#
#  The start point(2, 2, 2) converges to the minimum at(0, 0, 8),
#  with final objective = 936.0.  From a different start point,
#  Knitro may converge to an alternate local solution at(7, 0, 0),
#  with objective = 951.0.
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

using KNITRO
using Test

function example_qcqp1(; verbose=true)
    # Create a new Knitro solver instance.
    kc = KNITRO.KN_new()

    # Illustrate how to override default options by reading from
    # the knitro.opt file.
    options = joinpath(dirname(@__FILE__), "..", "examples", "knitro.opt")
    KNITRO.KN_load_param_file(kc, options)
    kn_outlev = verbose ? KNITRO.KN_OUTLEV_ITER : KNITRO.KN_OUTLEV_NONE
    KNITRO.KN_set_param(kc, KNITRO.KN_PARAM_OUTLEV, kn_outlev)

    # Initialize Knitro with the problem definition.

    # Add the variables and set their bounds and initial values.
    # Note: unset bounds assumed to be infinite.
    KNITRO.KN_add_vars(kc, 3)
    KNITRO.KN_set_var_lobnds_all(kc, [0.0, 0.0, 0.0])
    KNITRO.KN_set_var_primal_init_values_all(kc, [2.0, 2.0, 2.0])

    # Add the constraints and set their bounds.
    KNITRO.KN_add_cons(kc, 2)
    KNITRO.KN_set_con_eqbnd(kc, 0, 56.0)
    KNITRO.KN_set_con_lobnd(kc, 1, 25.0)

    # Add coefficients for linear constraint.
    lconIndexVars = Int32[0, 1, 2]
    lconCoefs = [8.0, 14.0, 7.0]
    KNITRO.KN_add_con_linear_struct_one(kc, 3, 0, lconIndexVars, lconCoefs)

    # Add coefficients for quadratic constraint
    qconIndexVars1 = Int32[0, 1, 2]
    qconIndexVars2 = Int32[0, 1, 2]
    qconCoefs = [1.0, 1.0, 1.0]
    KNITRO.KN_add_con_quadratic_struct_one(
        kc,
        3,
        1,
        qconIndexVars1,
        qconIndexVars2,
        qconCoefs,
    )

    # Set minimize or maximize(if not set, assumed minimize)
    KNITRO.KN_set_obj_goal(kc, KNITRO.KN_OBJGOAL_MINIMIZE)

    # Add constant value to the objective.
    KNITRO.KN_add_obj_constant(kc, 1000.0)

    # Set quadratic objective structure.
    qobjIndexVars1 = Int32[0, 1, 2, 0, 0]
    qobjIndexVars2 = Int32[0, 1, 2, 1, 2]
    qobjCoefs = [-1.0, -2.0, -1.0, -1.0, -1.0]

    KNITRO.KN_add_obj_quadratic_struct(kc, 5, qobjIndexVars1, qobjIndexVars2, qobjCoefs)

    # Solve the problem.
    #
    # Return status codes are defined in "knitro.h" and described
    # in the Knitro manual.
    nStatus = KNITRO.KN_solve(kc)
    nStatus, objSol, x, lambda_ = KNITRO.KN_get_solution(kc)

    # An example of obtaining solution information.
    if verbose
        println("Knitro converged with final status = ", nStatus)
        println("  optimal objective value  = ", objSol)
        println("  optimal primal values x  = ", x)
        println("  feasibility violation    = ", KNITRO.KN_get_abs_feas_error(kc))
        println("  KKT optimality violation = ", KNITRO.KN_get_abs_opt_error(kc))
    end

    # Delete the Knitro solver instance.
    KNITRO.KN_free(kc)

    @testset "Example QCQP1" begin
        @test nStatus == 0
        @test objSol ≈ 936.0
        @test x ≈ [0.0, 0.0, 8.0]
    end
end

example_qcqp1(; verbose=isdefined(Main, :KN_VERBOSE) ? KN_VERBOSE : true)


import JuLIP.Potentials: @pot, @D, evaluate!, evaluate_d!, PairPotential, @analytic
using LinearAlgebra: norm
using BenchmarkTools
using JuLIP, Test

h3("generate hand-coded morse potential")

mutable struct Morseold <: PairPotential
   e0::Float64
   A::Float64
   r0::Float64
end

@pot Morseold

evaluate!(tmp, p::Morseold, r::Number) =
      p.e0 * (exp(-2*p.A*(r/p.r0-1.0)) - 2.0*exp(-p.A*(r/p.r0-1.0)))
evaluate_d!(tmp, p::Morseold, r::Number) =
      -2.0*p.e0*p.A/p.r0*(exp(-2*p.A*(r/p.r0-1.0)) - exp(-p.A*(r/p.r0-1.0)))

A = 4.1
e0 = 0.99
r0 = 1.05

morseold = Morseold(e0, A, r0)

h3("generate AD morse potential")

morse1 = let A = A, e0 = e0, r0 = r0
   @analytic( r -> e0 * (exp(-2*A*(r/r0-1.0)) - 2.0*exp(-A*(r/r0-1.0))) )
end
@show typeof(morse1)

h3("Check consistency of hand-coded and analytic Morse potentials...")
rr = collect(range(0.9, stop=2.1, length=100))
morse_r = morse1.(rr)
morseold_r = morseold.(rr)
dmorse_r = [(@D morse1(r)) for r in rr]
dmorseold_r = [ (@D morseold(r)) for r in rr ]

println(@test norm(morse_r - morseold_r, Inf) < 1e-12)
println(@test norm(dmorse_r - dmorseold_r, Inf) < 1e-12)

function runn(f, x, N)
   s = 0.0
   for n = 1:N
      x += 0.0001
      s += f(x)
   end
   return s
end

function runn_d(f, x, N)
   s = 0.0
   for n = 1:N
      x += 0.0001
      s += @D f(x)
   end
   return s
end

h2("Performance tests: @analytic vs hand-coded")
x = 1.0+rand()
println("Evaluations of @analytic Potential")
@btime runn($morse1, $x, 1_000)
println("Evaluations hand-coded Potential")
@btime runn($morseold, $x, 1_000)
println("Grad of @analytic Potential")
@btime runn_d($morse1, $x, 1_000)
println("Grad of hand-coded Potential")
@btime runn_d($morseold, $x, 1_000)


mutable struct TrackedReal{T<:Real}
    data::T
    grad::Union{Nothing,T}
    children::Dict
    # this field is only need for printing the graph. you can safely remove it.
    name::String
end

track(x::Real,name="") = TrackedReal(x,nothing,Dict(),name)

function Base.show(io::IO, x::TrackedReal)
    t = isempty(x.name) ? "(tracked)" : "(tracked $(x.name))"
    print(io, "$(x.data) $t")
end

function accum!(x::TrackedReal)
    if isnothing(x.grad)
        x.grad = sum(accum!(v)*w for (v,w) in x.children)
    end
    x.grad
end

function gradient(f, args::Real...)
    ts = track.(args)
    y  = f(ts...)
    y.grad = 1.0
    accum!.(ts)
end

##########  RULES  #############################################################

function Base.:*(a::TrackedReal, b::TrackedReal)
    z = track(a.data * b.data, "*")
    a.children[z] = b.data  # dz/da=b
    b.children[z] = a.data  # dz/db=a
    z
end
function Base.:+(a::TrackedReal{T}, b::TrackedReal{T}) where T
    z = track(a.data + b.data, "+")
    a.children[z] = one(T)
    b.children[z] = one(T)
    z
end
function Base.sin(x::TrackedReal)
    z = track(sin(x.data), "sin")
    x.children[z] = cos(x.data)
    z
end

##########  Optimizion 2D function  ############################################

using Plots
g(x,y) = y*y + sin(x)
cscheme = cgrad(:RdYlBu_5, rev=true)
p1 = contour(-4:0.1:4, -2:0.1:2, g, fill=true, c=cscheme, xlabel="x", ylabel="y")
display(p1)

function descend(f::Function, λ::Real, args::Real...)
    Δargs = gradient(f, args...)
    args .- λ .* Δargs
end

function minimize(f::Function, args::T...; niters=20, λ=0.01) where T<:Real
    paths = ntuple(_->Vector{T}(undef,niters), length(args))
    for i in 1:niters
        args = descend(f, λ, args...)
        @info f(args...)
        for j in 1:length(args)
            paths[j][i] = args[j]
        end
    end
    paths
end

xs1, ys1 = minimize(g, 1.5, -2.4, λ=0.2, niters=34)
xs2, ys2 = minimize(g, 1.8, -2.4, λ=0.2, niters=16)

scatter!(p1, [xs1[1]], [ys1[1]], markercolor=:black, marker=:star, ms=7, label="Minimum")
scatter!(p1, [xs2[1]], [ys2[1]], markercolor=:black, marker=:star, ms=7, label=false)
scatter!(p1, [-π/2], [0], markercolor=:red, marker=:star, ms=7, label="Initial Point")
scatter!(p1, xs1[1:1], ys1[1:1], markercolor=:black, label="GD Path", xlims=(-4,4), ylims=(-2,2))

anim = @animate for i in 1:max(length(xs1), length(xs2))
    if i <= length(xs1)
        scatter!(p1, xs1[1:i], ys1[1:i], mc=:black, lw=3, xlims=(-4,4), ylims=(-2,2), label=false)
    end
    if i <= length(xs2)
        scatter!(p1, xs2[1:i], ys2[1:i], mc=:black, lw=3, label=false)
    end
    p1
end

gif(anim, "gd-path.gif", fps=15)


	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	#	Using librarys
	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	# GNU Scientific Library
	using GSL ;

	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	#	Special functions related
	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	# Spherical Bessel function first kind j_n(x)
	function Sbessj( i::Int64 , x )
		return sqrt(pi*(1/(2*x)))*besselj(i+1.0/2,x) ;
	end

	# Spherical Bessel function second kind n_n(x) [Neumann]
	function Sneum( i::Int64 ,x )
		sqrt(pi*(1/(2*x)))*bessely(i+1.0/2,x) ;
	end

	# Spherical Bessel function first kind derivative ( Morse & Feshbach definition )
	function Sbessj_p( i::Int64 , x )
 		return (1/(2*i+1))*(i*Sbessj(i-1,x) - (i+1)*Sbessj(i+1,x)) ;
	end

	# Spherical Bessel second kind ( Neumann ) derivative
	function Sneum_p( i::Int64 , x )
		return Sneum(i-1,x) - ((i+1)/x)*Sneum(i,x) ;
	end

	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	#	Liquid Sphere
	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	# Liquid sphere coefficient
	function Coef_LiquidSphere( n::Int64, x1::Float64 )
		return x1*Sbessj_p( n, x1 )/Sbessj( n, x1 ) ;
	end

	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	#	Prolate/Oblate auxiliar
	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	function Index( M::Int64, i::Int64, j::Int64 )
		if j < i # Domain errors
			return	display("ERROR: j < i");
		end
		if i > M + 1 || j > M + 1
			return	display("ERROR: M < i-1, j-1");
		end
		return map( Int64, j + ( M + 1 )*( i - 1 ) - i*( i - 1 )/2 );
	end

	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	#	File I/O
	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	function ReadFileToArrayBF( file::AbstractString, sep::Char, elem::Int )
	#	Read 'file' (as BigFloat) with values 'sep' separated.
	#	A newline in the 'file' means that the retrieved structure will be a matrix
	# 	The 'elem' parameter selects all the entries (elem = 0) or a particular value
	# 	(elem = number)
		if elem == 0 # Return entire vector or matrix
			return map( x -> parse(BigFloat,x), readdlm( file, sep ,ASCIIString) );
		else # Return only the specified element
			return map( x -> parse(BigFloat,x), [readdlm( file, sep ,ASCIIString)[elem]] )[ 1 ] ;
		end
	end

	function ReadFileToArrayBF2( file::AbstractString, sep::Char, row::Any, col::Any )
	#	Read 'file' (as BigFloat) with values 'sep' separated.
	# 	Returned value is a matrix in general.
		return map( x -> parse(BigFloat,x), collect( readdlm( file, sep ,ASCIIString)[row,col] ) ) ;
	end

	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	#	Eigenvalues (prolate)
	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	function pro_lambdamn_approx( c::Any, m::Int64, n::Int64 )
		# Transcription to Julia of the AGD (Adelman, Gumerov & Duraiswami) MATLAB code.
		# View ' pro_calculate_lambdamn_approx.m ' in the AGD source directory
		convert( Float64, c ) ;
		const N = m + n + 200 ; # Size of the matrix
		const A = zeros( Float64, N, N ) ;
		if ( mod( n - m, 2) == 0 )
			r = 0 ; # even
		else
			r = 1 ; # odd
		end
		# Fill in the A matrix
		for i = 1 : N
			if i == 1
				A[ 1, 1 ] = calculate_betar( c, m, r ) ;
				A[ 1, 2 ] = calculate_alphar( c, m, r ) ;
			elseif  i == N
				A[ N, N - 1 ] = calculate_gammar( c, m, r ) ;
				A[ N, N ] = calculate_betar( c, m, r ) ;
			else
				A[ i, i - 1 ] = calculate_gammar( c, m, r ) ;
				A[ i, i ] = calculate_betar( c, m, r ) ;
				A[ i, i + 1 ] = calculate_alphar( c, m, r ) ;
			end
			r = r + 2;
		end
		const d = eigvals!(A);
		if ( mod(n - m, 2) == 0 )
			const lambda_approx = real(d[ Int( (n - m + 2) / 2 ) ]) ;
		else
			const lambda_approx = real(d[ Int( (n - m + 1) / 2 ) ]) ;
		end
		filename = @ sprintf("data/pro_%08d_%03d_%03d_lambda_approx.txt", trunc( Int, c*1000 ), m, n ) ;
		writedlm( filename,lambda_approx );
	end

	function calculate_alphar( c::Float64, m::Int64, r::Int64 )
		return ((( 2 * m + r + 2 )*( 2 * m + r + 1 ))/
		(( 2 * m + 2 * r + 5 )*( 2 * m + 2 * r + 3 )))*( c*c );
	end

	function calculate_betar( c::Float64, m::Int64, r::Int64 )
		return ( m + r )*( m + r + 1 ) + (( 2*( m + r )*( m + r + 1 ) - 2*(m*m) - 1) /
		(( 2*m + 2*r - 1 )*( 2*m + 2 * r + 3 )))*(c*c);
	end

	function calculate_gammar( c::Float64, m::Int64, r::Int64 )
		return (( r * (r - 1) )/(( 2*m + 2*r - 3 )*( 2*m + 2*r - 1 )))*(c*c);
	end

	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	#	Eigenvalues (oblate)
	# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	function obl_lambdamn_approx( c::Any, m::Int64, n::Int64 )
		# Transcription to Julia of the AGD (Adelman, Gumerov & Duraiswami) MATLAB code.
		# View ' obl_calculate_lambdamn_approx.m ' in the AGD source directory
		convert( Float64, c ) ;
		const N = m + n + 200 ; # Size of the matrix
		const A = zeros( Float64, N, N ) ;
		if ( mod( n - m, 2) == 0 )
			r = 0 ; # even
		else
			r = 1 ; # odd
		end
		# Fill in the A matrix
		for i = 1 : N
			if i == 1
				A[ 1, 1 ] = calculate_betar_obl( c, m, r ) ;
				A[ 1, 2 ] = calculate_alphar_obl( c, m, r ) ;
			elseif  i == N
				A[ N, N - 1 ] = calculate_gammar_obl( c, m, r ) ;
				A[ N, N ] = calculate_betar_obl( c, m, r ) ;
			else
				A[ i, i - 1 ] = calculate_gammar_obl( c, m, r ) ;
				A[ i, i ] = calculate_betar_obl( c, m, r ) ;
				A[ i, i + 1 ] = calculate_alphar_obl( c, m, r ) ;
			end
			r = r + 2;
		end
		const d = eigvals!(A);
		if ( mod( n - m, 2 ) == 0 )
			const lambda_approx = real(d[ Int( (n - m + 2) / 2 ) ]) ;
		else
			const lambda_approx = real(d[ Int( (n - m + 1) / 2 ) ]) ;
		end
		filename = @ sprintf("data/obl_%08d_%03d_%03d_lambda_approx.txt", trunc( Int, c*1000 ), m, n ) ;
		writedlm( filename,lambda_approx );
	end

	function calculate_alphar_obl( c::Float64, m::Int64, r::Int64 )
		return ((( 2 * m + r + 2 )*( 2 * m + r + 1 ))/
		(( 2 * m + 2 * r + 5 )*( 2 * m + 2 * r + 3 )))*( -c*c );
	end

	function calculate_betar_obl( c::Float64, m::Int64, r::Int64 )
		return ( m + r )*( m + r + 1 ) + (( 2*( m + r )*( m + r + 1 ) - 2*(m*m) - 1) /
		(( 2*m + 2*r - 1 )*( 2*m + 2 * r + 3 )))*(-c*c);
	end

	function calculate_gammar_obl( c::Float64, m::Int64, r::Int64 )
		return (( r * (r - 1) )/(( 2*m + 2*r - 3 )*( 2*m + 2*r - 1 )))*(-c*c);
	end


using MinFEM
using LinearAlgebra

function semilinear(mesh::Mesh, L::AbstractMatrix, M::AbstractMatrix,
                    s::AbstractVector, BoundaryIndices::Set{Int64}=[], tol=1e-10)

  y = zeros(mesh.nnodes)

  pde = PDESystem(A=L, b=M*s, bc=zeros(mesh.nnodes), DI=BoundaryIndices)

  res = Inf
  while res > tol
    pde.A = L + asmCubicDerivativeMatrix(mesh, y)
    pde.b = -L*y + M*s - asmCubicTerm(mesh, y)
    refresh(pde)
    solve(pde)

    y += pde.state
    res = norm(pde.state)
    println(res)
  end
  return y
end

mesh = import_mesh("../meshes/semilinear.msh")

L = asmLaplacian(mesh)
M = asmMassMatrix(mesh)

# y = 3*sin(x[1]*pi)*sin(x[2]*pi)
f(x) = 3*2*pi^2*sin(x[1]*pi)*sin(x[2]*pi) + (3*sin(x[1]*pi)*sin(x[2]*pi))^3
s = evaluateMeshFunction(mesh, f)

boundary = union(mesh.Boundaries[1001].Nodes,
                 mesh.Boundaries[1002].Nodes,
                 mesh.Boundaries[1003].Nodes,
                 mesh.Boundaries[1004].Nodes);

y = semilinear(mesh, L, M, s, boundary);

vtkfile = open_vtk_file(mesh, "semilinear.vtu")
write_point_data(vtkfile, y, "y")
write_point_data(vtkfile, s, "s")
save_vtk_file(vtkfile)


const year = 365.25 * 24. * 60. * 60.

GtCO2_to_ppm(GtCO2) = GtCO2 / (2.13 * (44. /12.))
tCO2_to_ppm(tCO2) = GtCO2_to_ppm(tCO2) * 1.e-9

ppm_to_GtCO2(ppm) = ppm * (2.13 * (44. /12.))
ppm_to_tCO2(ppm) = ppm_to_GtCO2(ppm) * 1.e9


module BaryTrees

    using Plots, LinearAlgebra

    import Base.∈, Base.∉, Plots.Shape, Base.insert!

    export BaryTree, Point, insert!, ∈, ∉, Draw, Draw!, Query, BaryCentric,
           Cartesian2BaryCentric, BaryCentric2Cartesian

    const Point = Tuple{Float64,Float64}

    Point(x::Float64,y::Float64) = Point((x,y))

    struct BaryCentric
        """
            Represents the 3 cartesian (2D) points of a Barycentric
            coordinate system
        """
        r₁::Point
        r₂::Point
        r₃::Point
    end

    function BaryCentric2Cartesian(λ₁,λ₂,λ₃,p::BaryCentric)
        return Point(
            λ₁*p.r₁[1]+λ₂*p.r₂[1]+λ₃*p.r₃[1],
            λ₁*p.r₁[2]+λ₂*p.r₂[2]+λ₃*p.r₃[2],
        )
    end

    function Cartesian2BaryCentric(p::Point,b::BaryCentric)
        x,y = p
        x1,x2,x3 = b.r₁[1],b.r₂[1],b.r₃[1]
        y1,y2,y3 = b.r₁[2],b.r₂[2],b.r₃[2]

        l1 = ( (y2-y3)*(x-x3)+(x3-x2)*(y-y3) ) / ( (y2-y3)*(x1-x3) + (x3-x2)*(y1-y3) )
        l2 = ( (y3-y1)*(x-x3) + (x1-x3)*(y-y3) ) / ( (y2-y3)*(x1-x3) + (x3-x2)*(y1-y3) )
        return (
            l1,l2,1.0-l1-l2,
        )
    end

    function Medians(b::BaryCentric)::Vector{Point}
        """
            Returns the three mid points of each triangular edge of
            the triangle defining b in cartesian units
        """
        return [
            BaryCentric2Cartesian(1/2,0,1/2,b)
            BaryCentric2Cartesian(0,1/2,1/2,b)
            BaryCentric2Cartesian(1/2,1/2,0,b)
        ]
    end

    struct AxisAlignedTriangle
        """
            wrapper around BaryCentric
        """
        b::BaryCentric
    end

    Medians(t::AxisAlignedTriangle)::Vector{Point} = Medians(t.b)

    mutable struct BaryTree
        root::Bool
        boundary::AxisAlignedTriangle
        point::Union{Nothing,Point}
        c::Union{Nothing,BaryTree}
        t::Union{Nothing,BaryTree}
        l::Union{Nothing,BaryTree}
        r::Union{Nothing,BaryTree}
    end

    function ∈(p::Point,t::AxisAlignedTriangle)::Bool
        """
            Test if a cartesian point is inside a triangle
                using BaryCentric Coordinates of the triangle
        """
        b = Cartesian2BaryCentric(p,t.b)
        if (b[1] >= 0 && b[2] >= 0 && b[1]+b[2] < 1)
            return true
        else
            return false
        end
    end

    function points(a::AxisAlignedTriangle)::Vector{Point}
        """
            Short hand for the corners of an AxisAlignedTriangle
        """
        return  Point.([
                a.b.r₁,
                a.b.r₂,
                a.b.r₃
            ])
    end

    function intersects(a::AxisAlignedTriangle,b::AxisAlignedTriangle)::Bool
        """
            Tests if any of the corners of triangle a are in triangle b
        """
        for p in points(a)
            if p ∈ b
                return true
            end
        end
        return false
    end

    ∉(p::Point,t::AxisAlignedTriangle)::Bool = !∈(p,t)

    function subdivide(t::AxisAlignedTriangle)::Vector{AxisAlignedTriangle}
        """
            Subdivides a triangle (as in the Sierpinski construction) and returns
            them each initialised with their own coordinate systems
        """
        m1,m2,m3 = Medians(t)
        return AxisAlignedTriangle.([
            BaryCentric(t.b.r₁,m3,m1),
            BaryCentric(m3,m2,m1),
            BaryCentric(m3,t.b.r₂,m2),
            BaryCentric(m1,m2,t.b.r₃)
        ])

    end

    ∈(p::Point,q::BaryTree)::Bool = ∈(p,q.boundary)
    ∉(p::Point,q::BaryTree)::Bool = ∉(p,q.boundary)
    isempty(q::BaryTree)::Bool = q.point == nothing

    BaryTree(a::AxisAlignedTriangle)::BaryTree = BaryTree(false,a,nothing,nothing,nothing,nothing,nothing)
    BaryTree(r::Bool,a::AxisAlignedTriangle)::BaryTree = BaryTree(r,a,nothing,nothing,nothing,nothing,nothing)
    BaryTree(a::BaryCentric)::BaryTree = BaryTree(AxisAlignedTriangle(a))

    function subdivide!(q::BaryTree)::Nothing
        """
            Subdivide this tree node as in the Sierpinski construction
            and store it in t,c,l,r child nodes
        """
        trigs = subdivide(q.boundary)
        q.t = BaryTree(trigs[1])
        q.c = BaryTree(trigs[2])
        q.l = BaryTree(trigs[3])
        q.r = BaryTree(trigs[4])
        nothing
    end

    function insert!(p::Point,q::BaryTree)::Bool
        """
            Trial an insert of point p (cartesian) in q's
            triangular boundary
        """
        if (p ∉ q)
            return false
        end

        if isempty(q) && q.t == nothing
            subdivide!(q)
            if p ∈ q.t
                q.t.point = p
            end

            if p ∈ q.c
                q.c.point = p
            end
            if p ∈ q.l
                q.l.point = p
            end
            if p ∈ q.r
                q.r.point = p
            end
            return true
        end

        if (q.t == nothing)
            subdivide!(q)
        end

        if insert!(p,q.t)
            return true
        end
        if insert!(p,q.c)
            return true
        end
        if insert!(p,q.l)
            return true
        end
        if insert!(p,q.r)
            return true
        end

        return false
    end

    Shape(a::AxisAlignedTriangle) = Shape(
        Shape([a.b.r₁[1],a.b.r₂[1],a.b.r₃[1]],[a.b.r₁[2],a.b.r₂[2],a.b.r₃[2]])
    )

    function Draw!(a::AxisAlignedTriangle)
        plot!(Shape(a),label="",fillalpha=0.0)
    end

    function Draw(Q::BaryTree,points=true)
        p = plot(aspect_ratio=:equal,label="")
        Draw!(Q.boundary)
        for q in [Q.t,Q.c,Q.l,Q.r]
            q != nothing ? Draw!(q,points) : nothing
        end
        return p
    end

    function Draw!(Q::BaryTree,points=true)
        Draw!(Q.boundary)
        for q in [Q.t,Q.c,Q.l,Q.r]
            q != nothing ? Draw!(q) : nothing
        end
    end

    function query(a::AxisAlignedTriangle, Q::BaryTree)
        if ~intersects(a,Q.boundary)
            return Vector{Point}([])
        end

        if Q.point == nothing
            return Vector{Point}([])
        end

        result = Vector{Point}()

        if (Q.point ∈ a)
            push!(result,Q.point)
        end

        for q in [Q.t,Q.c,Q.l,Q.r]
            if q != nothing
                for p in query(a,q)
                    push!(result,p)
                end
            end
        end

        return result
    end

    function size(Q::BaryTree)
        s = 1
        for q in [Q.t,Q.c,Q.l,Q.r]
            if q != nothing
                s += size(q)
            end
        end
        return s
    end
end


#using Parameters
@with_kw mutable struct Params
# BWH parameters

# Mathematical model parameters
    α::Float64 = 33.3333         # infiltration rate in vegetated soil
    f::Float64 = 0.1             # infiltration contrast
    η::Float64 = 3.5             # root augmentation
    γ::Float64 = 16.6667         # soil water consumption rate
    ρ::Float64 = 0.95            # shading parameter
    ν::Float64 = 3.3333          # soil water evaporation rate
    q::Float64 = 0.05            # infiltration shape parameter
    db::Float64 = 0.0333333      # b diffusivity
    dw::Float64 = 3.33333        # w diffusivity
    dh::Float64 = 333.333        # h diffusivity
    p::Float64 = 1.2             # precipitation rate

# Domain size
    Lx::Float64 = 28             # nondimensional X Domain size
    Ly::Float64 = 28             # nondimensional Y domain size

# Numerical code options
    nx::Int64 = 128              # X resolution
    ny::Int64 = 128              # Y resolution
    dx::Float64 = Lx/nx
    nsigma::Int64 = 12           # Number of sigmas in the integral approximation (12-16 probably ok)
    nint::Int64 = 3              # Frequency for b and w integral calculation (could be 1, but not much more than 3)

# Run control options
    outfile = "bwh.dat"          # Name of output file
    initfile = "bwh.init.dat"    # Name of initialization file (used if freadinit==true)
    finalfile = "bwh.final.dat"  # Name of final state
    freadinit::Bool = false      # Start from restart
    fplot::Bool = false          # if to show plots during run
    fsave::Bool = true           # if to save intermediate results
    dt::Float64 = 0.1            # Length of a single integration chunk (this value seems ok)
    nsave::Int64 = 10            # How often (in chunks) to save
    nstep::Int64 = 100           # How many chuncks to run  (total runtime = nstep*dt)
end


"""
    belief_ellipse(b::GaussianBelief, P::Float=0.95; δ::Number=5)

Construct and return the x and y points of a 2D gaussian belief,
with P being the total probability captured by the ellipse (P ∈ (0,1)),
and δ the degree increment between points.
"""
function belief_ellipse(b::GaussianBelief, P::Number=0.95; δ::Number=5)
    @assert 0<P<1
    @assert 0<δ<360

    θ = (pi/180)*collect(0:δ:360)
    rad_w = (-2*log(1-P))^0.5

    w1 = rad_w*cos.(θ)
    w2 = rad_w*sin.(θ)

    Sig12 = cholesky(b.Σ)
    x=Sig12.L*[w1 w2]' .+ b.μ
    return x[1,:], x[2,:]
end

"""
    belief_ellipse(μ::AbstractVector, Σ::AbstractMatrix, P::Float=0.95; δ::Number=5)

Construct and return the x and y points of a 2D gaussian belief,
with P being the total probability captured by the ellipse (P ∈ (0,1)),
and δ the degree increment between points.
"""

function belief_ellipse(μ::AbstractVector, Σ::AbstractMatrix, P::Number=0.95; δ::Number=5)
    @assert 0<P<1
    @assert 0<δ<360

    θ = (pi/180)*collect(0:δ:360)
    rad_w = (-2*log(1-P))^0.5

    w1 = rad_w*cos.(θ)
    w2 = rad_w*sin.(θ)

    Sig12 = cholesky(Σ)
    x = Sig12.L*[w1 w2]' .+ μ
    return x[1,:], x[2,:]
end


using Match
using Test

input = joinpath(@__DIR__, "input")
raw = readlines(input)

struct Operation
    name::String
    value::Int
end

function operations(lines)
    acc = []
    for line in lines
        if startswith(line, "cut")
            _, n = split(line)
            push!(acc, Operation("cut", parse(Int, n)))
        elseif startswith(line, "deal into")
            push!(acc, Operation("reverse", 0))
        elseif startswith(line, "deal with")
            _, _, _, n = split(line)
            push!(acc, Operation("deal", parse(Int, n)))
        end
    end
    return acc
end

deal = (c, n) -> return mod(-1 * c - 1, n)
inc = (c, n, i) -> return mod(c * i, n)
cut = (c, n, i) -> return mod(c - i, n)

function shuffle(idx, deck, ops)
    c = idx
    n = deck
    for op in ops
        @match op.name begin
            "cut" => begin
                c = cut(c, n, op.value)
            end
            "reverse" => begin
                c = deal(c, n)
            end
            "deal" => begin
                c = inc(c, n, op.value)
            end
        end
    end
    return c
end

function fshuffle(idx, deck, ops, iterations)
    offset, increment = BigInt(0), BigInt(1)
    for op in ops
        @match op.name begin
            "cut" => begin
                n = mod(op.value, deck)
                offset = mod(offset + n, deck)
            end
            "reverse" => begin
                increment = mod(-1 * increment, deck)
                offset = mod(-1 * offset - 1, deck)
            end
            "deal" => begin
                n = invmod(mod(op.value, deck), deck)
                increment = mod(increment * n, deck)
                offset = mod(offset * n, deck)
            end
        end
    end
    i = powermod(increment, iterations, deck)
    o = if increment != 1
        (i - 1) * invmod(increment - 1, deck)
    else
        iterations
    end
    return mod(i * idx + o * offset, deck)
end

ops = operations(raw)
p1 = shuffle(2019, 10007, ops)
@assert p1 == 3589

reverse!(ops)
p2 = fshuffle(2020, 119315717514047, ops, 101741582076661)
@assert p2 == 4893716342290

print("-----------------------------------------------------------------------\n")
print("slam shuffle -- part one\n    card: $p1\n")
print("slam shuffle -- part two\n    card: $p2\n")
print("-----------------------------------------------------------------------\n")


export add_gate, gate, gate_help

# These are tables of the gates and their descriptions
gate_table = Dict{Symbol, Matrix{CC}}()
gate_descr = Dict{Symbol,String}()

"""
`add_gate(S::Symbol, M::Matrix, descr::String)` adds a new gate to the
library of gates.
* `S` is the symbol associated with this gate.
* `M` is the matrix for this gate.
* `descr` is a description of the action of the gate.
"""
function add_gate(S::Symbol, M::Matrix, descr::String="No description available")
    gate_table[S] = M
    gate_descr[S] = descr
end

"""
`gate(S::Symbol)` returns the gate associated with the symbol `S`.
"""
function gate(S::Symbol)
    if haskey(gate_table,S)
        return gate_table[S]
    end
    throw(error("No such gate, $S"))
end

"""
`gate_help(S::Symbol)` prints a short help message describing gate `S`.
"""
function gate_help(S::Symbol)
    if haskey(gate_descr,S)
        println(":$S\t",gate_descr[S])
        return
    end
    println("Unknown gate, $S")
end

add_gate(:I, [1 0; 0 1], "Identity (nop) gate")
add_gate(:X, [0 1; 1 0], "Qubit swap (Pauli X)")
add_gate(:H, [1 1; 1 -1]/sqrt(2), "Hadammard gate")


using Random
using Soss
using DataFrames
using StatsPlots
using BenchmarkTools

@inline function rate_to_proportion(r::Float64,t::Float64)
    1-exp(-r*t)
end;

sir_markov = @model state,p begin
    # Unpack parameters
    β = p.β
    c = p.c
    γ = p.γ
    δt = p.δt

    # Unpack starting counts
    t0 = state.t
    S0 = state.S
    I0 = state.I
    R0 = state.R
    N = S0 + I0 + R0

    # Transitions between states
    S_I ~ Binomial(S0, rate_to_proportion(β*c*I0/N,δt))
    I_R ~ Binomial(I0, rate_to_proportion(γ,δt))

    # Updated state
    t = t0 + δt
    S = S0 - S_I
    I = I0 + S_I - I_R
    R = R0 + I_R

    next = (p=p, state=(t=t,S=S,I=I,R=R))
end;

sir_model = @model u0,p begin
    x ~ MarkovChain(p, sir_markov(state=u0,p=p))
end;

δt = 0.1
nsteps = 400
tmax = nsteps*δt;

u0 = (t=0.0, S=990, I=10, R=0); # t,S,I,R

p = (β=0.05, c=10.0, γ=0.25, δt=δt);

Random.seed!(1234);

r = rand(sir_model(u0=u0,p=p));
data = [u0]
for (n,s) in enumerate(r.x)
    n>nsteps && break
    push!(data,s)
end;

df_markov = DataFrame(data);

@df df_markov plot(:t,
    [:S :I :R],
    label=["S" "I" "R"],
    xlabel="Time",
    ylabel="Number")

@benchmark begin
    r = rand(sir_model(u0=u0,p=p));
    data = [u0]
    for (n,s) in enumerate(r.x)
        n>nsteps && break
        push!(data,s)
    end
end


using BSplineFit, Plots

knots = [0.0,1.0,2.0,4.0,7.0]
data_x = sort(rand(100)*7)
data_y = rand(100)*0.1 .+ 0.5 .+ sin.(data_x)./2

plts = []
for order ∈ 1:3
    p = scatter(data_x, data_y, label="", title="Fit with BSpline of order $(order).")
    for id ∈ 1:length(knots)+order
        b = BSplineFit.BSpline1DBasis(order, knots, id)
        plot!(t->b(t), 0, 7, lw=2, ls=:dash, label="")
    end

    bf = fit(data_x, data_y, order, knots)
    plot!(t->bf(t), 0, 7, lc=:black, lw=2, label="", ylims=(-0.5,1.5))

    push!(plts, p)
end

p = plot(plts..., layout=grid(3,1), size=(800,800))

savefig(p, "examples/fit.svg")


# Description:
# Dimensions: d
#
# The Styblinski-Tang function is shown here in its two-dimensional form.
#
# Input Domain:
# The function is usually evaluated on the hypercube xi ∈ [-5, 5], for all i = 1, …, d.
#
# Global Minimum:
# https://www.sfu.ca/~ssurjano/stybtang3.png

function styblinskiTang(xx)
    d = length(xx);
    sum = 0;
    for ii = 1:d
       	xi = xx[ii];
       	new = xi^4 - 16 * xi^2 + 5 * xi;
       	sum = sum + new;
    end

    y = sum / 2;

    return [y]
end


using MLDatasets, JLD

function sigmoid(x)
    return 1 / (1 + exp(-x))
end

function softmax(a)
    c = maximum(a)
    exp_a = exp.(a .- c)  # オーバーフロー対策
    sum_exp_a = sum(exp_a)
    y = exp_a ./ sum_exp_a

    return y
end

function get_data()
    # x_train, t_train = MNIST.traindata()
    x_test, t_test = MNIST.testdata()
    x_test = reshape(x_test, (784, :))
    return x_test, t_test
end

function init_network()
    network = load("sample_weight.jld")
    return network
end

function predict(network, x)
    W1, W2, W3 = network["W1"], network["W2"], network["W3"]
    b1, b2, b3 = network["b1"], network["b2"], network["b3"]

    a1 = W1 * x .+ b1
    z1 = sigmoid.(a1)
    a2 = W2 * z1 .+ b2
    z2 = sigmoid.(a2)
    a3 = W3 * z2 .+ b3
    y = softmax(a3)

    return y
end

function main()
    x, t = get_data()
    network = init_network()

    accuracy_cnt = 0
    for i in 1:length(t)
        y = predict(network, x[:,i])
        p = argmax(y) - 1
        if p == t[i]
            accuracy_cnt += 1
        end
    end
    accuracy = accuracy_cnt / length(t)
    println("Accuracy: $accuracy")  # 0.9352
end

main()


export nrmsd

"""
    nrmsd(I,Ireco)

computes the normalized root mean squared error of the image `Ireco`
with respect to the image `I`.
"""
function nrmsd(I,Ireco)
  N = length(I)

  # This is a little trick. We usually are not interested in simple scalings
  # and therefore "calibrate" them away
  alpha = (dot(vec(I),vec(Ireco))+dot(vec(Ireco),vec(I))) /
          (2*dot(vec(Ireco),vec(Ireco)))
  Ireco[:] .*= alpha

  RMS =  1.0/sqrt(N)*norm(vec(I)-vec(Ireco))
  NRMS = RMS/(maximum(abs.(I))-minimum(abs.(I)) )
  return NRMS
end


# Test cornerfeatures.jl

println("testing cornerfeatures")

using ImageProjectiveGeometry
using Base.Test

tol = 1;

# structuretensor, harris, noble, shi_tomasi, coherence
# hessianfeatures
# fastradial
# nonmaxsuppts

# Create an image with an isolated point
img = zeros(100,100)
r0 = 20;
c0 = 40;
img[r0,c0] = 10

(cimg, r, c) = harris(img, N=1,radius=5,subpixel=false)
@test abs(r[1]-r0) < tol && abs(c[1]-c0) < tol

(cimg, r, c) = noble(img, N=1,radius=5,subpixel=false)
@test abs(r[1]-r0) < tol && abs(c[1]-c0) < tol

(cimg, r, c) = shi_tomasi(img, N=1,radius=5,subpixel=false)
@test abs(r[1]-r0) < tol && abs(c[1]-c0) < tol

hdet = hessianfeatures(img, 1)
(r,c) = nonmaxsuppts(hdet, radius=5, N=1)
@test abs(r[1]-r0) < tol && abs(c[1]-c0) < tol

(S,So) = fastradial(img, [1, 3, 5])
(r,c) = nonmaxsuppts(S, radius=5, thresh=maximum(S)/2);
@test abs(r[1]-r0) < tol && abs(c[1]-c0) < tol

# Check nonmaxsuppts does subpixel precision. Create a 2x2 block of
# pixels in the image and locate the centre of that
img[r0:r0+1, c0:c0+1] = 10
(cimg, r, c) = shi_tomasi(img, N=1,radius=5,subpixel=true)
tol = 0.1
@test abs(r[1]-(r0+0.5)) < tol && abs(c[1]-(c0+0.5)) < tol


doc"""
    Exponential(θ)

The *Exponential distribution* with scale parameter `θ` has probability density function

$f(x; \theta) = \frac{1}{\theta} e^{-\frac{x}{\theta}}, \quad x > 0$

```julia
Exponential()      # Exponential distribution with unit scale, i.e. Exponential(1)
Exponential(b)     # Exponential distribution with scale b

params(d)          # Get the parameters, i.e. (b,)
scale(d)           # Get the scale parameter, i.e. b
rate(d)            # Get the rate parameter, i.e. 1 / b
```

External links

* [Exponential distribution on Wikipedia](http://en.wikipedia.org/wiki/Exponential_distribution)

"""
immutable Exponential{T<:Real} <: ContinuousUnivariateDistribution
    θ::T		# note: scale not rate

    Exponential(θ::Real) = (@check_args(Exponential, θ > zero(θ)); new(θ))
end

Exponential{T<:Real}(θ::T) = Exponential{T}(θ)
Exponential(θ::Integer) = Exponential(Float64(θ))
Exponential() = Exponential(1.0)

@distr_support Exponential 0.0 Inf

### Conversions
convert{T <: Real, S <: Real}(::Type{Exponential{T}}, θ::S) = Exponential(T(θ))
convert{T <: Real, S <: Real}(::Type{Exponential{T}}, d::Exponential{S}) = Exponential(T(d.θ))

#### Parameters

scale(d::Exponential) = d.θ
rate(d::Exponential) = 1 / d.θ

params(d::Exponential) = (d.θ,)
@inline partype{T<:Real}(d::Exponential{T}) = T

#### Statistics

mean(d::Exponential) = d.θ
median(d::Exponential) = logtwo * d.θ
mode{T<:Real}(d::Exponential{T}) = zero(T)

var(d::Exponential) = d.θ^2
skewness{T<:Real}(d::Exponential{T}) = T(2)
kurtosis{T<:Real}(d::Exponential{T}) = T(6)

entropy(d::Exponential) = 1 + log(d.θ)

#### Evaluation

zval(d::Exponential, x::Real) = x / d.θ
xval(d::Exponential, z::Real) = z * d.θ

pdf(d::Exponential, x::Real) = (λ = rate(d); x < 0 ? zero(λ) : λ * exp(-λ * x))
function logpdf{T<:Real}(d::Exponential{T}, x::Real)
    (λ = rate(d); x < 0 ? -T(Inf) : log(λ) - λ * x)
end

cdf{T<:Real}(d::Exponential{T}, x::Real) = x > 0 ? -expm1(-zval(d, x)) : zero(T)
ccdf{T<:Real}(d::Exponential{T}, x::Real) = x > 0 ? exp(-zval(d, x)) : zero(T)
logcdf{T<:Real}(d::Exponential{T}, x::Real) = x > 0 ? log1mexp(-zval(d, x)) : -T(Inf)
logccdf{T<:Real}(d::Exponential{T}, x::Real) = x > 0 ? -zval(d, x) : zero(T)

quantile(d::Exponential, p::Real) = -xval(d, log1p(-p))
cquantile(d::Exponential, p::Real) = -xval(d, log(p))
invlogcdf(d::Exponential, lp::Real) = -xval(d, log1mexp(lp))
invlogccdf(d::Exponential, lp::Real) = -xval(d, lp)

gradlogpdf{T<:Real}(d::Exponential{T}, x::Real) = x > 0 ? -rate(d) : zero(T)

mgf(d::Exponential, t::Real) = 1/(1 - t * scale(d))
cf(d::Exponential, t::Real) = 1/(1 - t * im * scale(d))

#### Sampling

rand(d::Exponential) = xval(d, randexp())

#### Fit model

immutable ExponentialStats <: SufficientStats
    sx::Float64   # (weighted) sum of x
    sw::Float64   # sum of sample weights

    ExponentialStats(sx::Real, sw::Real) = new(sx, sw)
end

suffstats{T<:Real}(::Type{Exponential}, x::AbstractArray{T}) = ExponentialStats(sum(x), length(x))
suffstats{T<:Real}(::Type{Exponential}, x::AbstractArray{T}, w::AbstractArray{Float64}) = ExponentialStats(dot(x, w), sum(w))

fit_mle(::Type{Exponential}, ss::ExponentialStats) = Exponential(ss.sx / ss.sw)


# This test case is copied from http://hakank.org/julia/constraints/monks_and_doors.jl
# which is a website by Håkan Kjellerstrand
# please check it out :)

@testset "Monks & Doors" begin
    all_solutions = true
    model = Model(optimizer_with_attributes(CS.Optimizer,
        "all_solutions"=> all_solutions,
        # "all_optimal_solutions"=>all_solutions,
        "logging"=>[],

        "traverse_strategy"=>:BFS,
        "branch_split"=>:InHalf,

        "branch_strategy" => :IMPS, # default
    ))

    num_doors = 4
    num_monks = 8
    @variable(model, doors[1:num_doors], Bin)
    da,db,dc,dd = doors
    door_names = ["A","B","C","D"]

    @variable(model, monks[1:num_monks], Bin)
    m1,m2,m3,m4,m5,m6,m7,m8 = monks

    # Monk 1: Door A is the exit.
    # M1 #= A (Picat constraint)
    @constraint(model, m1 == da)

    #  Monk 2: At least one of the doors B and C is the exit.
    # M2 #= 1 #<=> (B #\/ C)
    @constraint(model, m2 := { db == 1 || dc == 1})

    #  Monk 3: Monk 1 and Monk 2 are telling the truth.
    # M3 #= 1 #<=> (M1 #/\ M2)
    @constraint(model, m3 := { m1 == 1 && m2 == 1})

    #  Monk 4: Doors A and B are both exits.
    # M4 #= 1 #<=> (A #/\ B)
    @constraint(model, m4 := { da == 1 && db == 1})

    #  Monk 5: Doors A and C are both exits.
    # M5 #= 1 #<=> (A #/\ C)
    @constraint(model, m5 := { da == 1 && dc == 1})

    #  Monk 6: Either Monk 4 or Monk 5 is telling the truth.
    # M6 #= 1 #<=> (M4 #\/ M5)
    @constraint(model, m6 := { m4 == 1|| m5 == 1})

    #  Monk 7: If Monk 3 is telling the truth, so is Monk 6.
    # M7 #= 1 #<=> (M3 #=> M6)
    @constraint(model, m7 := { m3 => {m6 == 1}})

    #  Monk 8: If Monk 7 and Monk 8 are telling the truth, so is Monk 1.
    # M8 #= 1 #<=> ((M7 #/\ M8) #=> (M1))
    b1 = @variable(model, binary=true)
    @constraint(model, b1 := {m7 == 1 && m8 == 1})
    @constraint(model, m8 := {b1 => {m1 == 1}})

    # Exactly one door is an exit.
    # (A + B + C + D) #= 1
    @constraint(model, da + db + dc + dd == 1)

    # Solve the problem
    optimize!(model)

    status = JuMP.termination_status(model)
    # println("status:$status")
    num_sols = 0
    @test status == MOI.OPTIMAL
    num_sols = MOI.get(model, MOI.ResultCount())
    @test num_sols == 1
    doors_val = convert.(Integer,JuMP.value.(doors))
    monks_val = convert.(Integer,JuMP.value.(monks))
    # exit door is A
    @test doors_val[1] == 1
    @test sum(doors_val) == 1
    @test sum(monks_val) == 3
    # monks 1,7,8 are the only ones who tell the truth
    @test monks_val[1] == monks_val[7] == monks_val[8] == 1
end


using StatsBase
using Test

X = Float64[1 0; 2 1; 3 0; 4 1; 5 10]

x1 = X[:,1]
x2 = X[:,2]
y = [5, 3, 4, 2, 5]

# corspearman

@test corspearman(x1, y) ≈ -0.102597835208515
@test corspearman(x2, y) ≈ -0.081110710565381

@test corspearman(X, y) ≈ [-0.102597835208515, -0.081110710565381]
@test corspearman(y, X) ≈ [-0.102597835208515 -0.081110710565381]

c11 = corspearman(x1, x1)
c12 = corspearman(x1, x2)
c22 = corspearman(x2, x2)
@test c11 ≈ 1.0
@test c22 ≈ 1.0
@test corspearman(X, X) ≈ [c11 c12; c12 c22]
@test corspearman(X)    ≈ [c11 c12; c12 c22]

# corkendall

@test corkendall(x1, y) ≈ -0.105409255338946
@test corkendall(x2, y) ≈ -0.117851130197758

@test corkendall(X, y) ≈ [-0.105409255338946, -0.117851130197758]
@test corkendall(y, X) ≈ [-0.105409255338946 -0.117851130197758]

c11 = corkendall(x1, x1)
c12 = corkendall(x1, x2)
c22 = corkendall(x2, x2)

@test c11 ≈ 1.0
@test c22 ≈ 1.0
@test corkendall(X, X) ≈ [c11 c12; c12 c22]
@test corkendall(X)    ≈ [c11 c12; c12 c22]


"""
Graph Laplacian of a `m×n` lattice.
"""
function gridlaplacian(T, m, n)
    S = sparse(T(0.0)I, n*m, n*m)
    linear = LinearIndices((1:m, 1:n))
    for i in 1:m
        for j in 1:n
            for (i2, j2) in ((i + 1, j), (i, j + 1))
                if i2 <= m && j2 <= n
                    S[linear[i, j], linear[i2, j2]] -= 1
                    S[linear[i2, j2], linear[i, j]] -= 1

                    S[linear[i, j], linear[i, j]] += 1
                    S[linear[i2, j2], linear[i2, j2]] += 1
                end
            end
        end
    end
    S
end


using Distributions
using GaussianMixtureTest
using Test

mu_true = [-2.0858,-1.4879]
wi_true = [0.0828,0.9172]
sigmas_true = [0.6735,0.2931]

m = MixtureModel(map((u, v) -> Normal(u, v), mu_true, sigmas_true), wi_true)
x = rand(m, 1000);

wi, mu, sigmas, ml = gmm(x, 2)
mhat = MixtureModel(map((u, v) -> Normal(u, v), mu, sigmas), wi)
@test loglikelihood(mhat, x) >= loglikelihood(m, x)

asymptoticdistribution(x, wi_true, mu_true, sigmas_true);
T, p = kstest(x, 2)

@test T >= 0
# write your own tests here


fib(n) = n < 2 ? n : fib(n-1) + fib(n-2)


using DifferentialEquations
using Plots
plotlyjs()

#constants
m = 1.0                             # mass[Kg]
g = 9.81                            # gravitational acceleration [m/s²]

#function to compute the ODEs
function pendulum!(du,u,p,t)
    r,v,θ,ω=u
    du[1]=dr=v
    du[2]=dv=r*ω^2+g*cos(θ)
    du[3]=dθ=ω
    du[4] =dω=-(g\r)*sin(θ) - (2*v*ω)/r
end

#initial conditions
r₀=4                            #initial radial distance
v₀=-0.1                          #initial radial velocity
θ₀ = 1π/18                        # initial angular deflection [rad]
ω₀ = 1                       # initial angular velocity [rad/s]
u₀ = [r₀,v₀,θ₀, ω₀]                   # initial state vector
tspan = (0.0,5.0)             # time interval

#defining the problem and solving
prob = ODEProblem(pendulum!,u₀,tspan)
sol = solve(prob,saveat=0.1)

#plotting
p1=plot(sol,vars=(0,1),label="r",
    color="purple", xaxis="t (s)", yaxis="r (m)")
p2=plot(sol,vars=(0,2),label="v",
    color="blue", xaxis="t (s)", yaxis="v (m/s)")
p3=plot(sol,vars=(0,3),label="θ",
    color="green", xaxis="t (s)", yaxis="θ (rad)")
p4=plot(sol,vars=(0,4),label="ω",
    color="orange", xaxis="t (s)", yaxis="ω (rad/s)")
display(plot(p1,p2,p3,p4,layout=(2,2)))
savefig("./plots/simple length changing pendulum-plot.png")

#trajectory
t=sol.t
U=sol[1:end,:]
(r,v,θ,ω)=[U[x,:] for x in 1:size(U,1)]
x=r.*sin.(θ)
y=zeros(size(t))
z=r.*cos.(θ)
display(plot(x,y,z,linewidth=2,label="trajectory",
    xaxis="x (m)",yaxis="y (m)",zaxis="z (m)",grid=(:on,:black)))
savefig("./plots/simple length changing pendulum-trajectory.png")

Modeling the Dragon Module as a Pendulum/Scripts/length changing pendulum.jl


#!/usr/bin/julia

# Trizen
# Date: 19 August 2016
# https://github.com/trizen

# Count the number of partitions of n, using a recursive relation.

# See also: https://oeis.org/A000041
#           https://en.wikipedia.org/wiki/Partition_(number_theory)

function partitions_count(n::Int64, cache::Dict{Int,Int})

    n <= 1 && return n

    if haskey(cache, n)
        return cache[n]
    end

    sum_1 = 0
    for i in 1:Int64(floor((sqrt(24*n + 1) + 1)/6))
        sum_1 += ((-1)^(i-1) * partitions_count(n - div(i*(3*i - 1), 2), cache))
    end

    sum_2 = 0
    for i in 1:Int64(ceil((sqrt(24*n + 1) - 7)/6))
        sum_2 += ((-1)^(i-1) * partitions_count(n - div((-i) * (-3*i - 1), 2), cache))
    end

    x = (sum_1 + sum_2)
    cache[n] = x
    x
end

println("P(200) = ", partitions_count(200+1, Dict{Int64, Int64}()))        # 3972999029388


"""
    min_even_theta_char(R)

Compute the even theta characteristic for which the theta constant at the input matrix in R has the smallest absolute value.
"""
function min_even_theta_char(R::RiemannMatrix)
    z = zeros(R.g);
    even_chars = even_theta_char(R.g);
    min_theta, char_index = findmin([abs(theta(z, R, char=c)) for c in even_chars])
    char = even_chars[char_index];
    return char
end

"""
    hessian(z, R, char=[])

Compute the hessian matrix of the theta function at input z and input matrix in R, with optional characteristics.
"""
function hessian(z::Array{<:Number}, R::RiemannMatrix, char::Array{}=[])
    M = zeros(Complex{Float64}, R.g, R.g);
    for i=1:R.g
        for j=i:R.g
            derivs = [zeros(R.g), zeros(R.g)];
            derivs[1][i] = 1;
            derivs[2][j] = 1;
            M[i,j] = theta(z, R, char=char, derivs=derivs);
            M[j,i] = M[i,j];
        end
    end
    return M
end

"""
    hessian(z, τ, char=[], siegel=true, ϵ=1.0e-12)

Compute the hessian matrix of the theta function at inputs z and τ, with optional characteristics, and optional inputs specifying whether to compute the Siegel transformation and the error in the value of the theta function.
"""
function hessian(z::Array{<:Number}, τ::Array{<:Number}, char::Array{}=[]; siegel::Bool=true, ϵ::Real=1.0e-12)
    R = RiemannMatrix(τ, siegel=siegel, ϵ=ϵ, nderivs=2);
    return hessian(z, R, char)
end

"""
    schottky_null(R, tol=1.0e-8)

Compute the even theta characteristic where the theta constant vanishes and the hessian matrix at the characteristic, as well as its nonzero eigenvalues, up to the input tolerance. Returns an array containing the characteristic, the hessian and the nonzero eigenvalues. If there is no such characteristic, return the absolute value of the theta constant at the smallest even characteristic.
"""
function schottky_null(R::RiemannMatrix, tol::Real=1.0e-8)
    char = min_even_theta_char(R);
    z = zeros(R.g);
    theta_value = abs(theta(z, R, char=char));
    if theta_value < tol # check that there is a vanishing theta null
        H = hessian(z, R, char);
        hessian_eigvals = filter(x -> abs(x) > tol, eigvals(H));
        return [char, H, hessian_eigvals]
    end
    return theta_value
end

"""
    schottky_null(τ, tol=1.0e-8)

Compute the even theta characteristic where the theta constant vanishes and the hessian matrix at the characteristic, as well as its nonzero eigenvalues, up to the input tolerance. Returns an array containing the characteristic, the hessian and the nonzero eigenvalues. If there is no such characteristic, return the absolute value of the theta constant at the smallest even characteristic.
"""
function schottky_null(τ::Array{<:Number}, tol::Real=1.0e-8)
    R = RiemannMatrix(τ, ϵ=tol, nderivs=2);
    return schottky_null(R, tol)
end


module cheb
using LinearAlgebra

export chebdif, projmat

"""
flippy():
    Utility function that flips matrix up-down and left-right
        (or, equivalently, rotates it by 180deg).
"""
function flippy(M)
    M[end:-1:1,end:-1:1]
end

"""
chebdif():

Julia translation of the MATLAB routine by J.A.C. Weideman & S.C. Reddy (1998).

Original MATAB documentation:

%  The function DM =  chebdif(N,M) computes the differentiation
%  matrices D1, D2, ..., DM on Chebyshev nodes.
%
%  Input:
%  N:        Size of differentiation matrix.
%  M:        Number of derivatives required (integer).
%  Note:     0 < M <= N-1.
%
%  Output:
%  DM:       DM(1:N,1:N,ell) contains ell-th derivative matrix, ell=1..M.
%
%  The code implements two strategies for enhanced
%  accuracy suggested by W. Don and S. Solomonoff in
%  SIAM J. Sci. Comp. Vol. 6, pp. 1253--1268 (1994).
%  The two strategies are (a) the use of trigonometric
%  identities to avoid the computation of differences
%  x(k)-x(j) and (b) the use of the "flipping trick"
%  which is necessary since sin t can be computed to high
%  relative precision when t is small whereas sin (pi-t) cannot.
%
% J.A.C. Weideman, S.C. Reddy 1998.

"""
function chebdif(N::Integer,M::Integer)
    I  = diagm(ones(N))             # Identity matrix
    L  = I.!=0                      # Logical identity matrix

    n1 = N÷2;    n2 = n1 + N%2      # Indices used for flipping trick.

    k  = collect(0:N-1)             # Compute theta vector.
    th = k * π/(N-1)

    temp = collect(N-1:-2:1-N)
    x  = sin.(π*temp/(2.0*(N-1)))   # Compute Chebyshev points

    T  = repeat(th/2,1,N)
    DX = 2*sin.(T'+T) .* sin.(T'-T) # Trigonometric identity.

    DX = [DX[1:n1,:]; -flippy(DX[1:n2,:])]
    DX[L] .= 1.0

    temp = (-1.0).^k
    C = temp * temp'  # generates a Toeplitz matrix with diagonal of +1 and alternating signs on diags
    C[1,:]   *= 2;      C[end,:] *= 2
    C[:,1]   *= 0.5;    C[:,end] *= 0.5

    Z = 1.0./DX
    Z[L] .= 0.0
    D = diagm(ones(N))

    s = size(D)
    DM = zeros(s...,M)
    De = zeros(n2,n2,M)
    Do = zeros(n2,n2,M)
    (Pe,Po,Qe,Qo) = projmat(N)

    for ell in 1:M
        D = ell * Z .* (C .* repeat(diag(D),1,N) - D)
        D[L] = -sum(D,dims=2)
        DM[:,:,ell] = D
        if ell%2 == 0 # 2nd, 4th, 6th etc derivatives do not change parity
            De[:,:,ell] = Pe * D * Qe
            Do[:,:,ell] = Po * D * Qo
        else # 1st, 3rd, 5th etc derivatives change parity
            De[:,:,ell] = Po * D * Qe
            Do[:,:,ell] = Pe * D * Qo
        end
    end
    return (x,DM,De,Do)
end

"""
projmat():

    Constructs projection matrices to project (and de-project) onto space of
    even and odd functions, from general space of functions.

    I could try to be clever here, dealing with N odd or even, but I forgo
    cleverness in favor of readability. (In all likelihood this could be done
    in far fewer lines, I'm sure.)

    2*Peve' de-projects an even function back onto the full function space.
    2*Podd' de-projects an odd function back onto the full function space.

    Peve is the inverse of dPeve
    Podd is the inverse of dPodd
"""
function projmat(N::Integer)
    n1 = N÷2;  n2 = n1 + N%2
    isNodd = (n2>n1) # is N odd?
    top = diagm(ones(n2))
    if isNodd
        Qodd = [ top[1:n2,:] ; -top[n1:-1:1,:] ]
        Qodd[n2,:] .*= 0
        Podd = Qodd' *0.5
        Qeve = [ top[1:n2,:] ; top[n1:-1:1,:] ]
        Peve = Qeve' *0.5
        Peve[:,n2] .*= 2
    else
        Qodd = [ top[1:n1,:] ; -top[n1:-1:1,:] ]
        Qeve = [ top[1:n1,:] ;  top[n1:-1:1,:] ]
        Podd = Qodd' *0.5
        Peve = Qeve' *0.5
    end
    return (Peve,Podd,Qeve,Qodd)
end

end#module


using Base.Threads

"""
    euler_matrix(α::Real, β::Real, γ::Real)

Returns the rotation matrix A based on rotation along the euler angles α, β and γ corresponding to rotations around the x, y, and z-axis respectively.
"""
function euler_matrix(α::Real, β::Real, γ::Real)
    [
        (cos(β)*cos(γ))                         (-cos(β)*sin(γ))                        sin(β)
        (cos(α)*sin(γ) + cos(γ)*sin(α)*sin(β))  (cos(α)*cos(γ) - sin(α)*sin(β)*sin(γ))  (-cos(β)*sin(α))
        (sin(α)*sin(γ) - cos(α)*cos(γ)*sin(β))  (cos(γ)*sin(β) + cos(α)*sin(β)*sin(γ))  (cos(α)*cos(β))

    ]
end

"""
    rotate_3D_quantity(x, α, β, γ)

Rotates a 3D vector along the x-axis with angle α, y-axis with angle β and z-axis with angle γ.
"""
function rotate_3D_quantity(x::Array{<:Real}, α::Real, β::Real, γ::Real)

    A = euler_matrix(α, β, γ)

    return A * x
end

"""
    rotate_3D(x::Array{<:Real}, alpha::Real, beta::Real, gamma::Real)

Rotates and array of 3D positions around the euler angles α, β and γ corresponding to rotations around the x, y, and z-axis respectively.
α, β and γ need to be given in degrees.
"""
function rotate_3D(x::Array{<:Real}, alpha::Real, beta::Real, gamma::Real)

    α = deg2rad(alpha)
    β = deg2rad(beta)
    γ = deg2rad(gamma)

    N = size(x,2)
    ret = Array{eltype(x[1]),2}(undef, 3, N)
    @threads for i = 1:N
        @inbounds ret[:,i] = rotate_3D_quantity(x[:,i], α, β, γ)
    end

    return ret
end

"""
    rotate_3D!(x::Array{<:Real}, alpha::Real, beta::Real, gamma::Real)

Rotates and array of 3D positions around the euler angles α, β and γ corresponding to rotations around the x, y, and z-axis respectively.
α, β and γ need to be given in degrees.
"""
function rotate_3D!(x::Array{<:Real}, alpha::Real, beta::Real, gamma::Real)

    α = deg2rad(alpha)
    β = deg2rad(beta)
    γ = deg2rad(gamma)

    @threads for i = 1:size(x,2)
        @inbounds x[:,i] = rotate_3D_quantity(x[:,i], α, β, γ)
    end

    return x
end

"""
    rotate_to_xz_plane!(x::Array{<:Real})

Rotates an array of 3D positions into the xz-plane.
"""
function rotate_to_xz_plane!(x::Array{<:Real})

    @inbounds for i = 1:size(x,2)
        pos3   = copy(x[2,i])
        x[2,i] = x[3,i]
        x[3,i] = pos3
    end
    x
end

"""
    rotate_to_xz_plane!(x::Array{<:Real})

Rotates an array of 3D positions into the xz-plane.
"""
function rotate_to_xz_plane!(x::Array{<:Real}, x_in::Array{<:Real})

    @inbounds for i = 1:size(x,2)
        x[1,i] = x_in[1,i]
        x[2,i] = x_in[3,i]
        x[3,i] = x_in[2,i]
    end
    x
end

"""
    rotate_to_yz_plane(x::Array{<:Real})

Rotates an array of 3D positions into the yz-plane.
"""
function rotate_to_yz_plane!(x::Array{<:Real})

    @inbounds for i = 1:size(x,2)
        pos3   = copy(x[1,i])
        x[1,i] = x[2,i]
        x[2,i] = x[3,i]
        x[3,i] = pos3
    end
    x
end

"""
    rotate_to_yz_plane(x::Array{<:Real}, x_in::Array{<:Real})

Rotates an array of 3D positions into the yz-plane.
"""
function rotate_to_yz_plane!(x::Array{<:Real}, x_in::Array{<:Real})

    @inbounds for i = 1:size(x,1)
        x[1,i] = x_in[2,i]
        x[2,i] = x_in[3,i]
        x[3,i] = x_in[1,i]
    end
    x
end

"""
    project_along_axis!(x::Array{<:Real}, projection_axis::Integer=3)

Projects and array of 3D along one of the principle axes.
projection_axis ∈ {1, 2, 3} => x, y, z axis.
"""
function project_along_axis!(x::Array{<:Real}, projection_axis::Integer=3)

    # rotation to xy-plane -> nothing is done
    if projection_axis == 3
        return x
    end

    # rotation to xz-plane
    if projection_axis == 2
        return rotate_to_xz_plane!(x)
    end

    # rotation to yz-plane
    if projection_axis == 1
        return rotate_to_yz_plane!(x)
    end
end

"""
    project_along_axis!(x::Array{<:Real}, projection_axis::Integer=3)

Projects and array of 3D along one of the principle axes.
projection_axis ∈ {1, 2, 3} => x, y, z axis.
"""
function project_along_axis!(x::Array{<:Real}, x_in::Array{<:Real}, projection_axis::Integer=3)

    # rotation to xy-plane -> nothing is done
    if projection_axis == 3
        return x_in
    end

    # rotation to xz-plane
    if projection_axis == 2
        return rotate_to_xz_plane!(x, x_in)
    end

    # rotation to yz-plane
    if projection_axis == 1
        return rotate_to_yz_plane!(x, x_in)
    end
end

"""
    project_along_axis!(x::Array{<:Real}, projection_axis::Integer=3)

Projects and array of 3D along one of the principle axes.
projection_axis ∈ {1, 2, 3} => x, y, z axis.
"""
function project_along_axis(x::Array{<:Real}, projection_axis::Integer=3)

    # allocate new array
    ret = Array{eltype(x[1]),2}(undef, 3, size(x,2))

    # rotation to xy-plane -> nothing is done
    if projection_axis == 3
        return x
    end

    # rotation to xz-plane
    if projection_axis == 2
        return rotate_to_xz_plane!(ret, x)
    end

    # rotation to yz-plane
    if projection_axis == 1
        return rotate_to_yz_plane!(ret, x)
    end
end


#    Problem : GROUP A
#    *********
#	 Shanno's TRIDIA quadratic tridiagonal problem
#
#    Origonal SIF Source:problem 8 in
#    Ph.L. Toint,
#    "Test problems for partially separable optimization and results
#    for the routine PSPMIN",
#    Report 83/4, Department of Mathematics, FUNDP (Namur, B), 1983.
#
#    See also Buckley#40 (p.96)
#
#    TRIDIA.SIF classification QUR2-AN-V-0
#
#	 This problem is decomposed in n linear groups, the last n-1 of which
#    are 2 x 2 and singular.
#
#    Number of variables is variable

f = (x) -> begin
	fx   = (x[1]-1)^2
	for i in firstindex(x)+1:lastindex(x)
		item    = 2x[i]-x[i-1]
    	fx     += item^2*i
	end
    return fx
end

g! = (g, x) -> begin
	g[1] = 2(x[1]-1)
	for i in firstindex(x)+1:lastindex(x)
		item    = 2x[i]-x[i-1]
        g[i]   += 4item*i
	    g[i-1] -= 2item*i
	end
    return g
end

fg! = (g, x) -> begin
	fx   = (x[1]-1)^2
	g[1] = 2(x[1]-1)
	for i in firstindex(x)+1:lastindex(x)
		item    = 2x[i]-x[i-1]
    	fx     += item^2*i
        g[i]   += 4item*i
	    g[i-1] -= 2item*i
	end
    return fx, g
end

init = (n::Int=5000) -> begin
    return n, ones(n)
end

TestSet["TRIDIA"] = UncProgram("TRIDIA",f, g!, fg!, init)


import RowEchelon

#=
Homework 5
Section 2.1
Problem 2
=#

# Initialize all Matrices
A = [2 0 -1 ; 4 -5 2]
B = [7 -5 1 ; 1 -4 -3]
C = [1 2 ;-2 1]
D = [3 5 ; -1 4]
E = [-5 ; 3]

println("A + 3B: ")
println(A+(3*B))

# After this point, products may not exist
# Use try/catch to find nonexistent products.
println("2C - 3E:")
try
	println((2*C) - (3*E))
catch
	println("2C - 3E cannot be computed.")
end

println("DB:")
try
	println(D*B)
catch
	println("DB cannot be computed.")
end

println("EC:")
try
	println(E*C)
catch
	println("EC cannot be computed.")
end


module FameSVD
using LinearAlgebra

export fsvd

function fsvd(A::Array{R, 2}) where R<:AbstractFloat
  dim = size(A)

  V = Array{R, 2}(undef, dim[2], dim[2])
  U = Array{R, 2}(undef, dim[1], dim[2])
  S = Array{R, 1}(undef, dim[2])

  V = BLAS.syrk('U', 'T', 1.0, A)
  (S, V) = LAPACK.syevr!('V', 'A', 'U', V, 0., 0., 0, 0, 0.)

  reverse!(S)
  @inbounds for i = 1:dim[2]
    @fastmath S[i] = sqrt(S[i])
  end

  V = reverse(V; dims = 2)
  U = BLAS.gemm('N', 'N', A, V)

  # TODO check if the loop order is optimal
  @inbounds for i = 1:dim[2]
    @inbounds for j = 1:dim[1]
      U[j, i] /= S[i]
    end
  end

  return LinearAlgebra.SVD(U, S, V')
end

end # module


using Flux
println("NNPDE_tests")
using DiffEqFlux
println("Starting Soon!")
using ModelingToolkit
using DiffEqBase
using Test, NeuralPDE
using GalacticOptim
using Optim
using CUDA

using Random
Random.seed!(100)

cb = function (p,l)
    println("Current loss is: $l")
    return false
end

## Example 1, 3D PDE
@parameters x y t θ
@variables u(..)
@derivatives Dxx''~x
@derivatives Dyy''~y
@derivatives Dt'~t

# 3D PDE
eq  = Dt(u(x,y,t,θ)) ~ Dxx(u(x,y,t,θ)) + Dyy(u(x,y,t,θ))
# Initial and boundary conditions
bcs = [u(x,y,0,θ) ~ exp(x+y)*cos(x+y) ,
      # u(x,y,2,θ) ~ exp(x+y)*cos(x+y+4*2) ,
      u(0,y,t,θ) ~ exp(y)*cos(y+4t),
      u(2,y,t,θ) ~ exp(2+y)*cos(2+y+4t) ,
      u(x,0,t,θ) ~ exp(x)*cos(x+4t),
      u(x,2,t,θ) ~ exp(x+2)*cos(x+2+4t)]
# Space and time domains
domains = [x ∈ IntervalDomain(0.0,2.0),
          y ∈ IntervalDomain(0.0,2.0),
          t ∈ IntervalDomain(0.0,2.0)]

# Discretization
dx = 0.25; dy= 0.25; dt = 0.25
# Neural network
chain = FastChain(FastDense(3,16,Flux.σ),FastDense(16,16,Flux.σ),FastDense(16,1)) |>gpu

discretization = NeuralPDE.PhysicsInformedNN([dx,dy,dt],
                                             chain,
                                             strategy = NeuralPDE.GridTraining())
pde_system = PDESystem(eq,bcs,domains,[x,y,t],[u])
prob = NeuralPDE.discretize(pde_system,discretization)

res = GalacticOptim.solve(prob, ADAM(0.1), progress = false; cb = cb, maxiters=1000)
phi = discretization.phi

xs,ys,ts = [domain.domain.lower:dx:domain.domain.upper for (dx,domain) in zip([dx,dy,dt],domains)]
analytic_sol_func(x,y,t) = exp(x+y)*cos(x+y+4t)
u_real = [reshape([analytic_sol_func(x,y,t) for x in xs  for y in ys], (length(xs),length(ys)))  for t in ts ]
u_predict = [reshape([first(phi([x,y,t],res.minimizer)) for x in xs  for y in ys], (length(xs),length(ys)))  for t in ts ]
@test u_predict ≈ u_real atol = 200.0

# p1 =plot(xs, ys, u_predict, st=:surface);
# p2 = plot(xs, ys, u_real, st=:surface);
# plot(p1,p2)

## Example 2, ## Fokker-Planck equation
# the example took from this article https://arxiv.org/abs/1910.10503
@parameters x θ
@variables p(..)
@derivatives Dx'~x
@derivatives Dxx''~x

#2D PDE
α = 0.3
β = 0.5
_σ = 0.5
# Discretization
dx = 0.05
# here we use normalization condition: dx*p(x,θ) ~ 1, in order to get non-zero solution.
eq  = [(α - 3*β*x^2)*p(x,θ) + (α*x - β*x^3)*Dx(p(x,θ)) ~ (_σ^2/2)*Dxx(p(x,θ)),
       dx*p(x,θ) ~ 1.]

# Initial and boundary conditions
bcs = [p(-2.2,θ) ~ 0. ,p(2.2,θ) ~ 0. , p(-2.2,θ) ~ p(2.2,θ)]

# Space and time domains
domains = [x ∈ IntervalDomain(-2.2,2.2)]

# Neural network
chain = FastChain(FastDense(1,12,Flux.σ),FastDense(12,12,Flux.σ),FastDense(12,1)) |>gpu

discretization = NeuralPDE.PhysicsInformedNN(dx,
                                             chain,
                                             strategy= NeuralPDE.GridTraining())

pde_system = PDESystem(eq,bcs,domains,[x],[p])
prob = NeuralPDE.discretize(pde_system,discretization)

res = GalacticOptim.solve(prob, BFGS(); cb = cb, maxiters=8000)
phi = discretization.phi

analytic_sol_func(x) = 28*exp((1/(2*_σ^2))*(2*α*x^2 - β*x^4))

xs = [domain.domain.lower:dx:domain.domain.upper for domain in domains][1]
u_real  = [analytic_sol_func(x) for x in xs]
u_predict  = [first(phi(x,res.minimizer)) for x in xs]

@test u_predict ≈ u_real atol = 20.0

# plot(xs ,u_real, label = "analytic")
# plot!(xs ,u_predict, label = "predict")


using GalerkinSparseGrids
using Base.Test
using Cubature

#---------------------------------------
# Testing regular hier DG reconstruction
#---------------------------------------

print("Testing full discontinuous Galerkin (DG) reconstruction 1-D... ")

for k in 1:5
    for l in 1:6
        dict = coeffs_DG(1, k, l, x->sin(4*x[1]); scheme="full")
        err = x->(reconstruct_DG(dict, [x])-sin(4*x))^2
        @test hquadrature(err, 0, 1; abstol=1.0e-10)[1] < 1/(1<<(l+k-1))
    end
end

for k in 1:5
    for l in 1:6
        dict = coeffs_DG(1, k, l, x->sin(4*x[1]); scheme="sparse")
        err = x->(reconstruct_DG(dict, [x])-sin(4*x))^2
        @test hquadrature(err, 0, 1; abstol=1.0e-10)[1] < 1/(1<<(l+k-1))
    end
end

println("Test Passed.")

# Sparsification should be trivial in 1D

print("Testing that both reconstructions are equivalent... ")

for k in 1:5
    for l in 1:6
        full_coeffs = coeffs_DG(1, k, l, x->sin(4*x[1]); scheme="full")
        sparse_coeffs = coeffs_DG(1, k, l, x->sin(4*x[1]); scheme="full")
        diff_full = x->(reconstruct_DG(full_coeffs, [x])-sin(4*x))^2
        diff_sparse = x->(reconstruct_DG(sparse_coeffs, [x])-sin(4*x))^2
        diff_both = x->(reconstruct_DG(full_coeffs, [x])-reconstruct_DG(sparse_coeffs, [x]))^2

        @test abs(hquadrature(diff_full,0,1;abstol=1.0e-9)[1]-
                  hquadrature(diff_sparse,0,1;abstol=1.0e-9)[1]) < 1.0e-14
        @test hquadrature(diff_both,0,1;abstol=1.0e-9)[1] < 1.0e-14
    end
end

println("Test Passed.")

# Testing sparse DG reconstruction in multidimensional space:

print("Testing sparse DG basis reconstruction 2-D... ")

for k in 1:5
    for l in 1:6
        dict = coeffs_DG(2, k, l, x->sin(4*x[1]+x[2]))
        err = x->(reconstruct_DG(dict, [x[1],x[2]])-sin(4*x[1]+x[2]))^2
        @test hcubature(err, [0,0], [1,1]; abstol=1.0e-10, maxevals=500)[1] < 1/(1<<(l+k-2))
    end
end

println("Test Passed.")


function L2norm(x)
    local l2::eltype(x) = 0
    for xᵢ in x
        l2 += xᵢ^2
    end
    l2
end

function l2norm(x)
    sqrt(L2norm(x))
end


#= matrixlib.jl
=#

function matrixlib(::Type{T}, name::Symbol, args...) where T
  if     name == :cauchy   return matrixlib_cauchy(T, args...)
  elseif name == :fourier  return matrixlib_fourier(T, args...)
  elseif name == :hilb     return matrixlib_hilb(T, args...)
  else                     throw(ArgumentError("name"))
  end
end
matrixlib(name::Symbol, args...) = matrixlib(Float64, name, args...)

function matrixlib_cauchy(::Type{T}, x::AbstractVector, y::AbstractVector) where T
  m = length(x)
  n = length(y)
  A = Array{T}(undef, m, n)
  @inbounds for j = 1:n
    @simd for i = 1:m
      A[i,j] = 1/(x[i] - y[j])
    end
  end
  A
end

function matrixlib_fourier(::Type{T}, x::AbstractVector, y::AbstractVector) where T
  S = eltype(complex(zero(T)))
  m = length(x)
  n = length(y)
  A = Array{S}(undef, m, n)
  @inbounds for j = 1:n, i = 1:m
    A[i,j] = exp(-2im*pi*x[i]*y[j])
  end
  A
end
matrixlib_fourier(::Type{T}, m::Integer, n::Integer) where {T} =
  matrixlib_fourier(T, 0:m-1, (0:n-1)/n)
matrixlib_fourier(::Type{T}, n::Integer) where {T} = matrixlib_fourier(T, n, n)

function matrixlib_hilb(::Type{T}, m::Integer, n::Integer) where T
  m >= 0 || throw(ArgumentError("m"))
  n >= 0 || throw(ArgumentError("n"))
  A = Array{T}(undef, m, n)
  @inbounds for j = 1:n, i = 1:m
    A[i,j] = 1/(i + j - 1)
  end
  A
end
matrixlib_hilb(::Type{T}, n::Integer) where {T} = matrixlib_hilb(T, n, n)