#! /usr/bin/julia

# Rosetta Code, Vampire number

function divisors{T<:Integer}(n::T)
    !isprime(n) || return [one(T), n]
    d = [one(T)]
    for (k, v) in factor(n)
        e = T[k^i for i in 1:v]
        append!(d, vec([i*j for i in d, j in e]))
    end
    sort(d)
end

function vampirefangs{T<:Integer}(n::T)
    fangs = T[]
    isvampire = false
    vdcnt = ndigits(n)
    fdcnt = vdcnt>>1
    iseven(vdcnt) || return (isvampire, fangs)
    !isprime(n) || return (isvampire, fangs)
    vdigs = sort(digits(n))
    d = divisors(n)
    len = length(d)
    len = iseven(len) ? len>>1 : len>>1 + 1
    for f in d[1:len]
        ndigits(f) == fdcnt || continue
        g = div(n, f)
        f%10!=0 || g%10!=0 || continue
        sort([digits(f), digits(g)]) == vdigs || continue
        isvampire = true
        append!(fangs, [f, g])
    end
    if isvampire
        fangs = reshape(fangs, (2,length(fangs)>>1))'
    end
    return (isvampire, fangs)
end

function showvampire{T<:Integer}(i::T, n::T, fangs::Array{T,2})
    s = @sprintf "%6d  %14d %s\n" i n join(fangs[1,:], "\u00d7")
    for i in 2:size(fangs)[1]
        s *= " "^23*join(fangs[i,:], "\u00d7")*"\n"
    end
    return s
end

vgoal = 25
vcnt = 0
dcnt = 0
println("Finding the first ", vgoal, " vampire numbers.")
println("     N         Vampire Fangs")
while vcnt < vgoal
    dcnt += 2
    for i in (10^(dcnt-1)):(10^dcnt-1)
        (isvampire, fangs) = vampirefangs(i)
        isvampire || continue
        vcnt += 1
        print(showvampire(vcnt, i, fangs))
        vcnt < vgoal || break
    end
end

test = [16758243290880, 24959017348650, 14593825548650]
println()
println("Checking a few numbers.")
println("     N         Vampire Fangs")
for (i, v) in enumerate(test)
    (isvampire, fangs) = vampirefangs(v)
    if isvampire
        print(showvampire(i, v, fangs))
    else
        println(@sprintf "%6d  %14d is not a vampire" i v)
    end
end


# Solves the primal problem of a soft-margin SVM classifier using
# the ACCPM algorithm.

# The main function.
# This implementation is deterministic for illustration purpose.
# In practice we may want to use random starting point.
function svmaccpm(X::AbstractMatrix,
                  Y::AbstractVector,
                  C::Real,
                  ϵ::Real,
                  droppingstrategy::Symbol=:None;
                  α::Real=0.01, β::Real=0.05)
  w = zeros(size(X, 2))
  z = ones(Y)*2
  x0 = [w; z]
  A, b = initialpolytope(X, Y, C, w, z)
  wsize = size(w, 1)
  f(x) = sum(x[1: wsize].^2)/2 + C*sum(x[wsize+1: end])
  ∇f(x) = [x[1: size(w, 1)]; C*ones(Y)]
  x, optdistances, numconstraints = accpm(
    f, ∇f, A, b, x0, ϵ, droppingstrategy; α=α, β=β)
  x[1: wsize], optdistances, numconstraints
end

# Computes the initial polyhedron for the SVM problem with some given
# initial point.
# Notes that in the original problem formulation the polyhedron assocaited
# with the constraint is not bounded, but once given some possible value
# of the objective we can easily give an upper bound to |w| and z.
function initialpolytope(X::AbstractMatrix,
                         Y::AbstractVector,
                         C::Real,
                         w::AbstractVector,
                         z::AbstractVector)
  objvalue = sum(w.^2)/2 + C*sum(z)
  wupper = √(2*objvalue)
  zupper = objvalue/C
  A = [-Y.*X (-eye(size(Y, 1)));
       zeros(X) (-eye(size(Y, 1)));
       -eye(size(w, 1)) zeros(X)';
       eye(size(w, 1)+size(z, 1));]
  b = [-1.*ones(Y); zeros(Y);
       fill(wupper, 2*size(w, 1)); fill(zupper, size(z))]
  A, b
end

# The general ACCPM algorithm to minimize `f` using the first-order
# derivative information.
# We suppose a linear constraint Ax ≤ b exists for the original problem.
function accpm(f, ∇f,
               A::AbstractMatrix,
               b::AbstractVector,
               x0::AbstractVector,
               ϵ::Real,
               droppingstrategy::Symbol=:None;
               α::Real=0.01, β::Real=0.05)
  (all(A*x0.<b)
   || throw(DomainError("x0 must be strictly feasible.")))
  (droppingstrategy in [:None, :DropRedundant, :KeepConstant]
   || throw(ArgumentError(
        "droppingstrategy must be one of the three:"
        * ":None, :DropRedundant or :KeepConstant.")))
  x = copy(x0)
  ms = [size(A, 1)]
  u, l = f(x), -Inf
  optdistances::Vector{Float64} = []
  while true
    x, H = polytope_analcenter(A, b, x, 1e-6; α=α, β=β)
    ∇, fx = ∇f(x), f(x)
    u = min(u, fx)
    l = max(l, fx - ms[end]*√(∇'*(H\∇)))
    push!(optdistances, u - l)
    u - l < ϵ && break
    if droppingstrategy ≠ :None
      A, b = dropconstraint(A, b, x, H, droppingstrategy)
    end
    A, b = [A; ∇'], [b; ∇'*x]
    x = nextstartpoint(A, b, x)
    push!(ms, size(A, 1))
  end
  x, optdistances, ms
end

# In the ACCPM algorithm, at the end of each iteration, the vector `x`
# is found on the face of the polytope. However, to run the Newton method
# that gives the analytic center, a strictly feasible point must be given.
# This function supposes that we have Ax ≤ b but with eqaulity only
# on the last line and try to move `x` a little to get a new `x'` such
# that Ax' ≤ b (the last line to `A` is suppose to be not all zero).
function nextstartpoint(A::AbstractMatrix,
                        b::AbstractVector,
                        x::AbstractVector)
  a = A[end, :]
  upperbound = (b-A*x)[1: end-1]
  lowerbound = max.(0, -(A*a)[1: end-1])
  δ = minimum(upperbound./lowerbound)
  x - δ*a/2
end

# Drop the constraints according to different strategies.
#
# :DropRedundant:
#   Guarantees not to change the polytope in question.
#
# :KeepConstant:
#   Keeps a fixed number of constraints which are the most relevant.
#   Here I choose to keep 3n constraints where n is the variable dimension.
#   However, we shouldn't end up with something that doesn't satisfy the
#   initial constraints, so this implementation can have bugs in some
#   particular cases.
function dropconstraint(A::AbstractMatrix,
                        b::AbstractVector,
                        x::AbstractVector,
                        H::AbstractMatrix,
                        droppingstrategy::Symbol)
  m = size(A, 1)
  Hinv = inv(H)
  relevemeasure = (b-A*x)./[√((A*Hinv)[i, :]⋅A[i, :]) for i=1:m]
  if droppingstrategy == :DropRedundant
    tokeep = relevemeasure .< m
  end
  if droppingstrategy == :KeepConstant
    tokeep = sortperm(relevemeasure)[1: min(3*size(A, 2), end)]
  end
  A[tokeep, :], b[tokeep]
end


######################################################################
# points.jl: projective points on elliptic curves
######################################################################

export EllipticPoint, Point

export coordinates, base_curve, isinfinity, normalize!, normalized, samefields

"""
Concrete type for projective points on elliptic curves given by a projective planar equation.
"""

mutable struct EllipticPoint{T<:Nemo.RingElem} <: ProjectivePoint{T}
	X::T
	Y::T
	Z::T
	curve::EllipticCurve{T}
end

coordinates(P::EllipticPoint) = (P.X, P.Y, P.Z)

base_curve(P::EllipticPoint) = P.curve

######################################################################
# Calling with the 'Point' constructor
######################################################################

function Point(x::T, y::T, curve::EllipticCurve{T}) where T
	R = base_ring(x)
	return EllipticPoint(x, y, R(1), curve)
end

function Point(X::T, Y::T, Z::T, curve::EllipticCurve{T}) where T
	return EllipticPoint(X, Y, Z, curve)
end

######################################################################
# Basic methods for projective points
######################################################################

base_ring(P::EllipticPoint) = parent(P.X)

"""
Decide whether a given elliptic point is valid.
"""
function isvalid(P::EllipticPoint)
	Eq = projective_equation(P.curve)
	x, y, z = coordinates(P)
	return Eq(x, y, z) == 0 && (x, y, z) != (0, 0, 0)
end

"""
Decide whether two projective points are given by the exact same coordinates.
"""
samefields(P::EllipticPoint, Q::EllipticPoint) = (P.curve == Q.curve) & (P.X == Q.X) & (P.Y == Q.Y) & (P.Z == Q.Z)

"""
Describe a projective point giving its X, Y and Z coordinates, and the curve it lives on.
"""
show(io::IO, P::EllipticPoint) = print("Point (", P.X, ":", P.Y, ":", P.Z, ") on ", P.curve)

"""
Decide whether a projective point is at infinity.
"""
isinfinity(P::EllipticPoint) = iszero(P.Z)

"""
Get a new normalized projective point from any projective point.
"""
function normalized(P::EllipticPoint)
    K = base_ring(P)
    if isinfinity(P)
        return EllipticPoint(zero(K),
                               one(K),
                               zero(K),
                               P.curve)
    else
        return EllipticPoint(P.X // P.Z,
                               P.Y // P.Z,
                               one(K),
                               P.curve)
    end
end

"""
Normalize a projective point in place.
"""
function normalize!(P::EllipticPoint{T}) where T<:Nemo.FieldElem
    K = base_ring(P)
    if isinfinity(P)
        P.X = zero(K)
        P.Y = one(K)
        P.Z = zero(K)
    else
        P.X = P.X // P.Z
        P.Y = P.Y // P.Z
        P.Z = one(K)
    end
    return
end

"""
Decides whether two projective points are the same.
"""

==(P::EllipticPoint, Q::EllipticPoint) = samefields(normalized(P), normalized(Q))


@doc """
	density(pts::IndexablePoints2D) -> Real

Here density is defined as the minimum radius of a covering of
the GeometricalPredicates region with equal-sized balls centered at the
points in `pts`.

By definition of the Voronoi tesselation this radius is the maximum
distance from a Voronoi cell vertix to its generator.
"""->
function density(generators::IndexablePoints2D)
	corn = voronoicells(generators)
	density(generators, corn)
end

function density(generators::IndexablePoints2D, corners::Tessellation)
	sort!(generators, by=getindex)
	dens = 0.0

	for idx in keys(corners)
		gen = generators[idx]
		for C in corners[idx]
			dens = max(dens, dist_squared(gen,C))
		end
	end

	return sqrt(dens)
end

@doc """
	density(x::Vector, y::Vector; rw) -> Real

Compute the density for points with coordinates `x` and `y` in the window `rw`.

The vector `rw` specifies the boundary rectangle as `[xmin, xmax, ymin, ymax]`.
By default, `rw` is the unit rectangle.
"""->
function density{T<:Real}(x::AbstractVector{T}, y::AbstractVector{T}, rw::Vector{Float64}=[0.0;1.0;0.0;1.0])
	pts, SCALEX, SCALEY = fit2boundingbox(x, y, rw)

	density(pts) * sqrt(SCALEX*SCALEY)
end


### A Pluto.jl notebook ###
# v0.11.14

using Markdown
using InteractiveUtils

# ╔═╡ bbd5a62e-fbcd-11ea-2bbd-e7be1b736f9f
using Plots

# ╔═╡ afa5cbc0-fbcc-11ea-0dd2-35821062dd18
c = 3

# ╔═╡ 59ddff8e-fbcd-11ea-1124-d308b43c24d9
acr =10

# ╔═╡ d8f55b7e-fbcc-11ea-1881-15dbeb706e20
xvars = [float(c) - i for i in 0:acr]

# ╔═╡ 1c685b10-fbcd-11ea-1ecd-75e8c03e7f87
begin
	function f(x)
		return cos(x)
	end
end

# ╔═╡ 29568700-fbcf-11ea-3096-7f18898aeba0
begin
	function slope(xl,xr,yl,yr,x)
		m = (yr-yl)/(xr-xl)
		b = yl - m*xl
		return m*x + b
	end
end

# ╔═╡ 358ecd40-fbcd-11ea-00fe-755c43fd372e
yvals = [f(xvars[i]) for i in 1:acr]

# ╔═╡ 55799400-fbcd-11ea-05dc-85c5e87f6f63
secs = [(yvals[i]-f(c))/(xvars[i]-c) for i in 1:acr]

# ╔═╡ ae19b810-fbcd-11ea-2ee7-a9f08af0abaf
begin
	plt = plot((x)->f(x),-2c,2c, title ="Limits of secant lines at x=$c",lw=3,legend=false)
	xlabel!("x")
	ylabel!("f(x) ")
	for i in 1:acr
		plot!((x)->slope(xvars[i],c,yvals[i],f(c),x),xvars[i]-1,c+1)

	end
	plt
	savefig("cos(x)-secants.png")
end

# ╔═╡ 12bbbe30-fbce-11ea-289f-ff4eeafbdcbf
cd(#= type where you want the images to save on your machine=#)

# ╔═╡ Cell order:
# ╠═bbd5a62e-fbcd-11ea-2bbd-e7be1b736f9f
# ╠═afa5cbc0-fbcc-11ea-0dd2-35821062dd18
# ╠═59ddff8e-fbcd-11ea-1124-d308b43c24d9
# ╠═d8f55b7e-fbcc-11ea-1881-15dbeb706e20
# ╠═1c685b10-fbcd-11ea-1ecd-75e8c03e7f87
# ╠═29568700-fbcf-11ea-3096-7f18898aeba0
# ╠═358ecd40-fbcd-11ea-00fe-755c43fd372e
# ╠═55799400-fbcd-11ea-05dc-85c5e87f6f63
# ╠═ae19b810-fbcd-11ea-2ee7-a9f08af0abaf
# ╠═12bbbe30-fbce-11ea-289f-ff4eeafbdcbf


# # Preorders
#
#md # [![](https://img.shields.io/badge/show-nbviewer-579ACA.svg)](@__NBVIEWER_ROOT_URL__/generated/sketches/Preorders.ipynb)
#
# Many of the ideas in category theory can be viewed as generalizations of
# preorders or monoids. This sketch shows some features of Catlab through the
# lens of preorders.
# You will see examples of defining GATs, Presentations, Syntax, and Functors.
# These are illustrated with preorders or thin categories, which are particularly
# simple cases of categories.

using Core: GeneratedFunctionStub
using Test

using Catlab, Catlab.Theories, Catlab.CategoricalAlgebra
import Catlab.Theories: compose

#=
# Definition of a Preorder formalized as a GAT

The following definitions can be found in the `Catlab.Theories` module.

```julia
""" Theory of *preorders*

Preorders encode the axioms of reflexivity and transitivity as term constructors.
"""
@theory Preorder{El,Leq} begin
  El::TYPE
  Leq(lhs::El, rhs::El)::TYPE
  @op (≤) := Leq

  # Preorder axioms are lifted to term constructors in the GAT.
  reflexive(A::El)::(A≤A) # ∀ A there is a term reflexive(A) which implies A≤A
  transitive(f::(A≤B), g::(B≤C))::(A≤C) ⊣ (A::El, B::El, C::El)

  # Axioms of the GAT are equivalences on terms or simplification rules in the logic
  f == g ⊣ (A::El, B::El, f::(A≤B), g::(A≤B))
  # Read as (f⟹ A≤B ∧ g⟹ A≤B) ⟹ f ≡ g
end
```

# Preorders are Thin Categories

Definition of a thin category
```julia
@theory ThinCategory{Ob,Hom} <: Category{Ob,Hom} begin
  f == g ⊣ (A::Ob, B::Ob, f::Hom(A,B), g::Hom(A,B))
end
```

of course this definition extends the GAT of categories

```julia
@theory Category{Ob,Hom} begin
  # Unicode aliases.
  @op begin
  (→) := Hom
  (⋅) := compose
  end

  """ Object in a category """
  Ob::TYPE

  """ Morphism in a category """
  Hom(dom::Ob,codom::Ob)::TYPE

  id(A::Ob)::(A → A)
  compose(f::(A → B), g::(B → C))::(A → C) ⊣ (A::Ob, B::Ob, C::Ob)

  # Category axioms.
  ((f ⋅ g) ⋅ h == f ⋅ (g ⋅ h)
  ⊣ (A::Ob, B::Ob, C::Ob, D::Ob, f::(A → B), g::(B → C), h::(C → D)))
  f ⋅ id(B) == f ⊣ (A::Ob, B::Ob, f::(A → B))
  id(A) ⋅ f == f ⊣ (A::Ob, B::Ob, f::(A → B))
end
```

Exercise: construct an isomorphism between the theory of thin categories and
the theory of preorders. Show that they have the same models.
=#

# Once you have a GAT defined using the `@theory` macro, you can define presentations,
# which are logical syntax for giving examples of the theory. The GAT contains type
# and term constructors that you can use to write expressions. A presentation uses
# those expressions to create a specific example of the theory. We define `P` to be a preorder
# with 3 elements and 2 ≤ relationships.
@present P(FreeThinCategory) begin
  (X,Y,Z)::Ob
  f::Hom(X,Y)
  g::Hom(Y,Z)
end

# another example

@present Q(FreeThinCategory) begin
  (X,Y,Z)::Ob
  f::Hom(X,Y)
  g::Hom(Y,Z)
  Y′::Ob
  f′::Hom(X,Y′)
  g′::Hom(Y′,Z)
end

# Exercise: draw the Hasse diagrams for these preorders by hand.

# # Composition is transitivity
# expressions in the presentation are paths in the Hasse Diagram

function compose(P::Presentation, vs::Vector{Symbol})
  compose(collect(generator(P, v) for v in vs))
end

# expressions are represented at expression trees
ex = compose(P, [:f, :g])
# the head of an expression is the root of the expression tree
Catlab.head(ex)
# the julia type of the expression
typeof(ex)
# the GAT type of the expression
gat_typeof(ex)
# the parameters of the GAT Type
gat_type_args(ex)

# in any thin category there is at most one morphism between any pair of objects.
# In symbols: ex₁::Hom(X,Y) ∧ ex₂::Hom(X,Y) ⟹ ex₁ == ex₂

function thinequal(ex₁::FreeThinCategory.Hom, ex₂::FreeThinCategory.Hom)
  dom(ex₁) == dom(ex₂) && codom(ex₁) == codom(ex₂)
end

@test thinequal(ex, compose(P, [:f,:g])⋅id(generator(P,:Z)))

# Thinking in terms of preorders, the composite f⋅g::Hom(X,Z) is a proof that X ≤ Z
# in logical notation you would say f::Hom(X,Y) and g::Hom(Y,Z) ⊢ f⋅g::Hom(X,Z)
# given a proof that X≤Y and a proof of Y≤Z then ⋅ will create a proof of X≤Z
# by composing the proofs sequentially like chaining inequalities in math
# a key aspect of category theory is that you want to work constructively
# you don't want to know that there exists a composite, you want to hold onto that composite.
# in programming, the way that you hold onto things is putting data into data structures.
# While computers can access things by offset or addresses, programmers want to use names
# so when we prove in P that X≤Z, we name that proof by adding it as a generator
@present P₂(FreeThinCategory) begin
  (X,Y,Z)::Ob
  f::Hom(X,Y)
  g::Hom(Y,Z)
  h::Hom(X,Z)
end

ex = compose(P₂, [:f, :g])

# Now that we have a name for h, we can see that thinequal knows that f⋅g == h because
# according to the definition of a thin category, any two morphisms with the same
# domain and codomain are equal.
@test thinequal(ex, generator(P₂, :h))

# There is an imperative interface to manipulating presentations by mutating them for this purpose
P₂′ = copy(P)
add_generator!(P₂′, Hom(:h, P[:X], P[:Z]))
generators(P₂′)

# We could avoid this naming the homs situation by giving all the homs the same name
# however, then when you tried to write down a morphism, you wouldn't be able to refer
# to a specific one by name, because they are all named ≤.
@present R(FreeThinCategory) begin
  (x,y,z)::Ob
  (≤)::Hom(x,y)
end
generators(R)

#=
Catlab won't let you make a presentation where the homs have the same exact name.
So, this will error:

```julia
@present Q(FreeThinCategory) begin
  (x,y,z)::Ob
  (≤)::Hom(x,y)
  (≤)::Hom(y,z)
  (≤)::Hom(x,z)
end
```

However, you can omit the names for homs with the following syntax, which is useful for thin categories.

```julia
@present Q(FreeThinCategory) begin
  (x,y,z)::Ob
  ::Hom(x,y)
  ::Hom(y,z)
  ::Hom(x,z)
end
```
=#

# In a thin category, all the homs with the same domain and codomain are the same,
# so why don't we name them by their the domain and codomain and then use the property
# that any two homs with the same name are the same to encode the thinness. This is what
# the Hasse diagram representation does for us. The edges in the diagram are encoding the
# presentation data into a combinatorial object that we can visualize. There are many
# reasons to encode a logical structure into a combinatorial strucuture, one is that
# we generally have ways of drawing combinatorial objects that convey their saliant structure
# and enable visual reasoning. Another is algorithms, isomorphism between the combinatorial representations
# provide some of the isomorphisms between the logical structures. in this case, a graph homomorphism between Hasse Diagrams
# construct isomorphisms between the preorders they present. The converse is not true since there can be many Graphs
# that present the same preorder.

# # Monotone Maps

# a generator is in the set of homs if it is in the list of generators
in_homs(f::FreeThinCategory.Hom{:generator}, C::FinCat) =
  f in hom_generators(C)

# a composite hom is in the list set of homs if all of its components are.
in_homs(f::FreeThinCategory.Hom{:compose}, C::FinCat) =
  all(fᵢ->in_homs(fᵢ, C), args(f))

# we can check if a map is functorial, which is called monotone for preorders.
# 1. make sure all the objects in the domain are sent to objects in the codomain
# 2. make sure all the homs are sent to homs in the codomain
# 3. check that the domains and codomainss of the homs match
function is_functorial(F::FinFunctor)
  pₒ = map(ob_generators(dom(F))) do X
    F(X) in ob_generators(codom(F))
  end |> all

  pₕ = map(hom_generators(dom(F))) do f
    in_homs(F(f), codom(F))
  end |> all

  pᵩ = map(hom_generators(dom(F))) do f
    FX = F(dom(f))
    FY = F(codom(f))
    Ff = F(f)
    dom(Ff) == FX && codom(Ff) == FY
  end |> all
  return pₒ && pₕ && pᵩ
end

@present Q(FreeThinCategory) begin
  (a,b,c,d)::Ob
  ab::Hom(a,b)
  bc::Hom(b,c)
  cd::Hom(c,d)
end
generators(Q)

Fₒ = Dict(:X=>:a, :Y=>:b, :Z=>:c)
Fₕ = Dict(:f=>:ab, :g=>:bc)
F = FinFunctor(Fₒ, Fₕ, P, Q)
@test is_functorial(F)

Fₒ = Dict(:X=>:a, :Y=>:b, :Z=>:d)
Fₕ = Dict(:f=>:ab, :g=>[:bc, :cd])
F = FinFunctor(Fₒ, Fₕ, P, Q)
@test is_functorial(F)

Fₒ = Dict(:X=>:a, :Y=>:b, :Z=>:c)
Fₕ = Dict(:f=>:ab, :g=>[:bc, :cd])
F = FinFunctor(Fₒ, Fₕ, P, Q)
@test !is_functorial(F)

#=
Monotone maps are functors for thin categories. One of the benefits of
category theory is that we find abstractions that work in multiple domains.
The abstraction of preserving the domains and codomains of morphisms is
a key abstraction that we can use to define many notions in mathematics.
=#


@doc raw"""
    Circle{𝔽} <: Manifold{𝔽}

The circle $𝕊^1$ is a manifold here represented by
real-valued points in $[-π,π)$ or complex-valued points $z ∈ ℂ$ of absolute value
$\lvert z\rvert = 1$.
# Constructor

    Circle(𝔽=ℝ)

Generate the `ℝ`-valued Circle represented by angles, which
alternatively can be set to use the [`AbstractNumbers`](@ref) `𝔽=ℂ` to obtain the circle
represented by `ℂ`-valued circle of unit numbers.
"""
struct Circle{𝔽} <: Manifold{𝔽} end

Circle(𝔽::AbstractNumbers = ℝ) = Circle{𝔽}()

@doc raw"""
    check_manifold_point(M::Circle, p)

Check whether `p` is a point on the [`Circle`](@ref) `M`.
For the real-valued case, `x` is an angle and hence it checks that $p  ∈ [-π,π)$.
for the complex-valued case, it is a unit number, $p ∈ ℂ$ with $\lvert p \rvert = 1$.
"""
check_manifold_point(::Circle, ::Any...)

function check_manifold_point(M::Circle{ℝ}, p; kwargs...)
    if !isapprox(sym_rem(p), p; kwargs...)
        return DomainError(
            p,
            "The point $(p) does not lie on $(M), since its is not in [-π,π).",
        )
    end
    return nothing
end
function check_manifold_point(M::Circle{ℂ}, p; kwargs...)
    if !isapprox(sum(abs.(p)), 1.0; kwargs...)
        return DomainError(
            abs(p),
            "The point $(p) does not lie on the $(M) since its norm is not 1.",
        )
    end
    return nothing
end

"""
    check_tangent_vector(M::Circle, p, X; check_base_point, kwargs...)

Check whether `X` is a tangent vector in the tangent space of `p` on the
[`Circle`](@ref) `M`.
For the real-valued case represented by angles, all `X` are valid, since the tangent space is the whole real line.
For the complex-valued case `X` has to lie on the line parallel to the tangent line at `p`
in the complex plane, i.e. their inner product has to be zero.
The optional parameter `check_base_point` indicates, whether to call [`check_manifold_point`](@ref)  for `p`.
"""
check_tangent_vector(::Circle{ℝ}, ::Any...; ::Any...)

function check_tangent_vector(M::Circle{ℝ}, p, X; check_base_point = true, kwargs...)
    if check_base_point
        perr = check_manifold_point(M, p; kwargs...)
        return perr # if x is valid all v that are real numbers are valid
    end
    return nothing
end
function check_tangent_vector(M::Circle{ℂ}, p, X; check_base_point = true, kwargs...)
    if check_base_point
        perr = check_manifold_point(M, p)
        perr === nothing || return perr
    end
    if !isapprox(abs(complex_dot(p, X)), 0.0; kwargs...)
        return DomainError(
            abs(complex_dot(p, X)),
            "The value $(X) is not a tangent vector to $(p) on $(M), since it is not orthogonal in the embedding.",
        )
    end
    return nothing
end

@doc raw"""
    complex_dot(a, b)

Compute the inner product of two (complex) numbers with in the complex plane.
"""
complex_dot(a, b) = dot(map(real, a), map(real, b)) + dot(map(imag, a), map(imag, b))
complex_dot(a::Number, b::Number) = (real(a) * real(b) + imag(a) * imag(b))

@doc raw"""
    distance(M::Circle, p, q)

Compute the distance on the [`Circle`](@ref) `M`, which is
the absolute value of the symmetric remainder of `p` and `q` for the real-valued
case and the angle between both complex numbers in the Gaussian plane for the
complex-valued case.
"""
distance(::Circle, ::Any...)
distance(::Circle{ℝ}, p::Real, q::Real) = abs(sym_rem(p - q))
distance(::Circle{ℝ}, p, q) = abs(sum(sym_rem.(p - q)))
distance(::Circle{ℂ}, p, q) = acos(clamp(complex_dot(p, q), -1, 1))

@doc raw"""
    exp(M::Circle, p, X)

Compute the exponential map on the [`Circle`](@ref).
````math
\exp_p X = (p+X)_{2π},
````
where $(\cdot)_{2π}$ is the (symmetric) remainder with respect to division by $2π$, i.e. in $[-π,π)$.

For the complex-valued case, the same formula as for the [`Sphere`](@ref) $𝕊^1$ is applied to values in the
complex plane.
"""
exp(::Circle, ::Any...)
Base.exp(::Circle{ℝ}, p::Real, X::Real) = sym_rem(p + X)
function Base.exp(M::Circle{ℂ}, x::Number, v::Number)
    θ = norm(M, x, v)
    return cos(θ) * x + usinc(θ) * v
end

exp!(::Circle{ℝ}, q, p, X) = (q .= sym_rem(p + X))
function exp!(M::Circle{ℂ}, q, p, X)
    θ = norm(M, p, X)
    q .= cos(θ) * p + usinc(θ) * X
    return q
end

flat(::Circle, ::Number, X::TFVector) = FVector(CotangentSpace, X.data)

flat!(::Circle, ξ::CoTFVector, p, X::TFVector) = copyto!(ξ, X)

function get_basis(M::Circle{ℝ}, p, B::DiagonalizingOrthonormalBasis)
    sbv = sign(B.frame_direction[])
    vs = @SVector [@SVector [sbv == 0 ? one(sbv) : sbv]]
    return CachedBasis(B, (@SVector [0]), vs)
end
get_coordinates(M::Circle{ℝ}, p, X, B::DefaultOrthonormalBasis) = X
function get_coordinates(M::Circle{ℝ}, p, X, B::DiagonalizingOrthonormalBasis)
    sbv = sign(B.frame_direction[])
    return X .* (sbv == 0 ? 1 : sbv)
end
"""
    get_coordinates(M::Circle{ℂ}, p, X, B::DefaultOrthonormalBasis)

Return tangent vector coordinates in the Lie algebra of the [`Circle`](@ref).
"""
function get_coordinates(M::Circle{ℂ}, p, X, B::DefaultOrthonormalBasis)
    X, p = X[1], p[1]
    Xⁱ = imag(X) * real(p) - real(X) * imag(p)
    return @SVector [Xⁱ]
end

eval(
    quote
        @invoke_maker 1 Manifold get_coordinates(
            M::Circle,
            e::Identity,
            X,
            B::VeeOrthogonalBasis,
        )
    end,
)

function get_coordinates!(M::Circle, Y::AbstractArray, p, X, B::DefaultOrthonormalBasis)
    Y[] = get_coordinates(M, p, X, B)[]
    return Y
end
function get_coordinates!(
    M::Circle,
    Y::AbstractArray,
    p,
    X,
    B::DiagonalizingOrthonormalBasis,
)
    Y[] = get_coordinates(M, p, X, B)[]
    return Y
end

eval(
    quote
        @invoke_maker 1 Manifold get_coordinates!(
            M::Circle,
            Y::AbstractArray,
            p,
            X,
            B::VeeOrthogonalBasis,
        )
    end,
)

get_vector(::Circle{ℝ}, p, X, ::AbstractBasis) = X
function get_vector(M::Circle{ℝ}, p, X, B::DiagonalizingOrthonormalBasis)
    sbv = sign(B.frame_direction[])
    return X .* (sbv == 0 ? 1 : sbv)
end
"""
    get_vector(M::Circle{ℂ}, p, X, B::DefaultOrthonormalBasis)

Return tangent vector from the coordinates in the Lie algebra of the [`Circle`](@ref).
"""
get_vector(M::Circle{ℂ}, p, X, B::AbstractBasis) = @SVector [1im * X[1] * p[1]]

function get_vector!(M::Circle, Y::AbstractArray, p, X, B::AbstractBasis)
    Y[] = get_vector(M, p, X, B)[]
    return Y
end
for BT in ManifoldsBase.DISAMBIGUATION_BASIS_TYPES
    eval(
        quote
            @invoke_maker 5 $(supertype(BT)) get_vector!(
                M::Circle,
                Y::AbstractArray,
                p,
                X,
                B::$BT,
            )
        end,
    )
end

@doc raw"""
    injectivity_radius(M::Circle[, p])

Return the injectivity radius on the [`Circle`](@ref) `M`, i.e. $π$.
"""
injectivity_radius(::Circle) = π
injectivity_radius(::Circle, ::ExponentialRetraction) = π
injectivity_radius(::Circle, ::Any) = π
injectivity_radius(::Circle, ::Any, ::ExponentialRetraction) = π
eval(
    quote
        @invoke_maker 1 Manifold injectivity_radius(
            M::Circle,
            rm::AbstractRetractionMethod,
        )
    end,
)

@doc raw"""
    inner(M::Circle, p, X, Y)

Compute the inner product of the two tangent vectors `X,Y` from the tangent plane at `p` on
the [`Circle`](@ref) `M` using the restriction of the metric from the embedding,
i.e.

````math
g_p(X,Y) = X*Y
````

for the real case and

````math
g_p(X,Y) = Y^\mathrm{T}X
````

for the complex case interpreting complex numbers in the Gaussian plane.
"""
inner(::Circle, ::Any...)
@inline inner(::Circle{ℝ}, p, X, Y) = dot(X, Y)
@inline inner(::Circle{ℝ}, p::Real, X::Real, Y::Real) = X * Y
@inline inner(::Circle{ℂ}, p, X, Y) = complex_dot(X, Y)

function inverse_retract(M::Circle, x::Number, y::Number)
    return inverse_retract(M, x, y, LogarithmicInverseRetraction())
end
function inverse_retract(M::Circle, x::Number, y::Number, ::LogarithmicInverseRetraction)
    return log(M, x, y)
end

@doc raw"""
    log(M::Circle, p, q)

Compute the logarithmic map on the [`Circle`](@ref) `M`.
````math
\log_p q = (q-p)_{2π},
````
where $(\cdot)_{2π}$ is the (symmetric) remainder with respect to division by $2π$, i.e. in $[-π,π)$.

For the complex-valued case, the same formula as for the [`Sphere`](@ref) $𝕊^1$ is applied to values in the
complex plane.
"""
log(::Circle, ::Any...)
Base.log(::Circle{ℝ}, p::Real, q::Real) = sym_rem(q - p)
function Base.log(M::Circle{ℂ}, p::Number, q::Number)
    cosθ = complex_dot(p, q)
    if cosθ ≈ -1  # appr. opposing points, return deterministic choice from set-valued log
        X = real(p) ≈ 1 ? 1im : 1 + 0im
        X = X - complex_dot(p, X) * p
        X *= π / norm(X)
    else
        cosθ = cosθ > 1 ? one(cosθ) : cosθ
        θ = acos(cosθ)
        X = (q - cosθ * p) / usinc(θ)
    end
    return project(M, p, X)
end

log!(::Circle{ℝ}, X, p, q) = (X .= sym_rem(q - p))
function log!(M::Circle{ℂ}, X, p, q)
    cosθ = complex_dot(p, q)
    if cosθ ≈ -1
        X .= sum(real.(p)) ≈ 1 ? 1.0im : 1.0 + 0.0im
        X .= X - complex_dot(p, X) * p
        X .*= π / norm(X)
    else
        cosθ = cosθ > 1 ? one(cosθ) : cosθ
        θ = acos(cosθ)
        X .= (q - cosθ * p) / usinc(θ)
    end
    return project!(M, X, p, X)
end

@doc raw"""
    manifold_dimension(M::Circle)

Return the dimension of the [`Circle`](@ref) `M`,
i.e. $\dim(𝕊^1) = 1$.
"""
manifold_dimension(::Circle) = 1

@doc raw"""
    mean(M::Circle{ℝ}, x::AbstractVector[, w::AbstractWeights])

Compute the Riemannian [`mean`](@ref mean(M::Manifold, args...)) of `x` of points on
the [`Circle`](@ref) $𝕊^1$, reprsented by real numbers, i.e. the angular mean
````math
\operatorname{atan}\Bigl( \sum_{i=1}^n w_i\sin(x_i),  \sum_{i=1}^n w_i\sin(x_i) \Bigr).
````
"""
mean(::Circle{ℝ}, ::Any)
function Statistics.mean(::Circle{ℝ}, x::AbstractVector{<:Real}; kwargs...)
    return atan(1 / length(x) * sum(sin, x), 1 / length(x) * sum(cos, x))
end
function Statistics.mean(
    ::Circle{ℝ},
    x::AbstractVector{<:Real},
    w::AbstractVector;
    kwargs...,
)
    return atan(sum(w .* sin.(x)), sum(w .* cos.(x)))
end
@doc raw"""
    mean(M::Circle{ℂ}, x::AbstractVector[, w::AbstractWeights])

Compute the Riemannian [`mean`](@ref mean(M::Manifold, args...)) of `x` of points on
the [`Circle`](@ref) $𝕊^1$, reprsented by complex numbers, i.e. embedded in the complex plade.
Comuting the sum
````math
s = \sum_{i=1}^n x_i
````
the mean is the angle of the complex number $s$, so represented in the complex plane as
$\frac{s}{\lvert s \rvert}$, whenever $s \neq 0$.

If the sum $s=0$, the mean is not unique. For example for opposite points or equally spaced
angles.
"""
mean(::Circle{ℂ}, ::Any)
function Statistics.mean(M::Circle{ℂ}, x::AbstractVector{<:Complex}; kwargs...)
    s = sum(x)
    abs(s) == 0 &&
        return error("The mean for $(x) on $(M) is not defined/unique, since the sum of the complex numbers is zero")
    return s / abs(s)
end
function Statistics.mean(
    M::Circle{ℂ},
    x::AbstractVector{<:Complex},
    w::AbstractVector;
    kwargs...,
)
    s = sum(w .* x)
    abs(s) == 0 &&
        error("The mean for $(x) on $(M) is not defined/unique, since the sum of the complex numbers is zero")
    return s /= abs(s)
end

mid_point(M::Circle{ℝ}, p1, p2) = exp(M, p1, 0.5 * log(M, p1, p2))
mid_point(::Circle{ℂ}, p1::Complex, p2::Complex) = exp(im * (angle(p1) + angle(p2)) / 2)
mid_point(M::Circle{ℂ}, p1::StaticArray, p2::StaticArray) = SA[mid_point(M, p1[], p2[])]

@inline LinearAlgebra.norm(::Circle, p, X) = sum(abs, X)

number_of_coordinates(::Circle, ::AbstractBasis) = 1

@doc raw"""
    project(M::Circle, p)

Project a point `p` onto the [`Circle`](@ref) `M`.
For the real-valued case this is the remainder with respect to modulus $2π$.
For the complex-valued case the result is the projection of `p` onto the unit circle in the
complex plane.
"""
project(::Circle, ::Any)
project(::Circle{ℝ}, p::Real) = sym_rem(p)
project(::Circle{ℂ}, p::Number) = p / abs(p)

project!(::Circle{ℝ}, q, p) = copyto!(q, sym_rem(p))
project!(::Circle{ℂ}, q, p) = copyto!(q, p / sum(abs.(p)))

@doc raw"""
    project(M::Circle, p, X)

Project a value `X` onto the tangent space of the point `p` on the [`Circle`](@ref) `M`.

For the real-valued case this is just the identity.
For the complex valued case `X` is projected onto the line in the complex plane
that is parallel to the tangent to `p` on the unit circle and contains `0`.
"""
project(::Circle, ::Any, ::Any)
project(::Circle{ℝ}, p::Real, X::Real) = X
project(::Circle{ℂ}, p::Number, X::Number) = X - complex_dot(p, X) * p

project!(::Circle{ℝ}, Y, p, X) = (Y .= X)
project!(::Circle{ℂ}, Y, p, X) = (Y .= X - complex_dot(p, X) * p)

retract(M::Circle, p, q) = retract(M, p, q, ExponentialRetraction())
retract(M::Circle, p, q, m::ExponentialRetraction) = exp(M, p, q)

representation_size(::Circle) = ()

sharp(::Circle, p::Number, ξ::CoTFVector) = FVector(TangentSpace, ξ.data)

sharp!(::Circle, X::TFVector, p, ξ::CoTFVector) = copyto!(X, ξ)

Base.show(io::IO, ::Circle{𝔽}) where {𝔽} = print(io, "Circle($(𝔽))")

@doc raw"""
    sym_rem(x,[T=π])

Compute symmetric remainder of `x` with respect to the interall 2*`T`, i.e.
`(x+T)%2T`, where the default for `T` is $π$
"""
function sym_rem(x::N, T = π) where {N<:Number}
    return (x ≈ T ? convert(N, -T) : rem(x, convert(N, 2 * T), RoundNearest))
end
sym_rem(x, T = π) where {N} = map(sym_rem, x, Ref(T))

@doc raw"""
    vector_transport_to(M::Circle, p, X, q, ::ParallelTransport)

Compute the parallel transport of `X` from the tangent space at `p` to the tangent space at
`q` on the [`Circle`](@ref) `M`.
For the real-valued case this results in the identity.
For the complex-valud case, the formula is the same as for the [`Sphere`](@ref)`(1)` in the
complex plane.
````math
\mathcal P_{q←p} X = X - \frac{⟨\log_p q,X⟩_p}{d^2_{ℂ}(p,q)}
\bigl(\log_p q + \log_q p \bigr),
````
where [`log`](@ref) denotes the logarithmic map on `M`.
"""
vector_transport_to(::Circle, ::Any, ::Any, ::Any, ::ParallelTransport)
vector_transport_to(::Circle{ℝ}, p::Real, X::Real, q::Real, ::ParallelTransport) = X
function vector_transport_to(
    M::Circle{ℂ},
    p::Number,
    X::Number,
    q::Number,
    ::ParallelTransport,
)
    X_pq = log(M, p, q)
    Xnorm = norm(M, p, X_pq)
    Y = X
    if Xnorm > 0
        factor = 2 * complex_dot(X, q) / (abs(p + q)^2)
        Y -= factor .* (p + q)
    end
    return Y
end

vector_transport_to!(::Circle{ℝ}, Y, p, X, q, ::ParallelTransport) = (Y .= X)
function vector_transport_to!(M::Circle{ℂ}, Y, p, X, q, ::ParallelTransport)
    X_pq = log(M, p, q)
    Xnorm = norm(M, p, X_pq)
    Y .= X
    if Xnorm > 0
        factor = 2 * complex_dot(X, q) / (sum(abs.(p + q) .^ 2))
        Y .-= factor .* (p + q)
    end
    return Y
end

function vector_transport_direction(
    M::Circle,
    p::Number,
    X::Number,
    Y::Number,
    m::AbstractVectorTransportMethod,
)
    q = exp(M, p, Y)
    return vector_transport_to(M, p, X, q, m)
end

zero_tangent_vector(::Circle, p::Number) = zero(p)
zero_tangent_vector!(::Circle, X, p) = fill!(X, 0)


function normalize_node(node::R,domain::Array{T,1}) where {R<:Number,T<:AbstractFloat}

  if domain[1] == domain[2]
    norm_node = zero(T)
    return norm_node
  else
    norm_node = 2.0*(node-domain[2])/(domain[1]-domain[2])-1.0
    return norm_node
  end

end

function normalize_node(node::AbstractArray{R,1},domain::Array{T,1}) where {R<:Number,T<:AbstractFloat}

  norm_nodes = similar(node)
  for i in eachindex(node)
    norm_nodes[i] = normalize_node(node[i],domain)
  end

  return norm_nodes

end

function normalize_node!(node::AbstractArray{R,1},domain::Array{T,1}) where {R<:Number,T<:AbstractFloat}

  for i in eachindex(node)
    node[i] = normalize_node(node[i],domain)
  end

end


# The fraction 49/98 is a curious fraction, as an inexperienced mathematician
# in attempting to simplify it may incorrectly believe that 49/98 = 4/8, which
# is correct, is obtained by cancelling the 9s.
#
# We shall consider fractions like, 30/50 = 3/5, to be trivial examples.
#
# There are exactly four non-trivial examples of this type of fraction, less
# than one in value, and containing two digits in the numerator and denominator.
#
# If the product of these four fractions is given in its lowest common terms,
# find the value of the denominator.

using ProjectEulerSolutions

# Cycle through numbers using Julia's built-in digits, and store the fractions
# as rationals.  Julia's built-in rationals solve the common denominator
# problem easily.
function p033solution()::Integer
    rationals = Rational[]
    for a in 10:98
        for b in (a+1):99
            if a != b
                val = a / b
                da = digits(a)
                db = digits(b)
                if da[1] == db[1] && da[1] != 0 && da[2] / db[2] == val
                    push!(rationals, a // b)
                elseif da[1] == db[2] && da[2] / db[1] == val
                    push!(rationals, a // b)
                elseif da[2] == db[1] && da[1] / db[2] == val
                    push!(rationals, a // b)
                elseif da[2] == db[2] && da[1] / db[1] == val
                    push!(rationals, a // b)
                end
            end
        end
    end
    return denominator(prod(rationals))
end

p033 = Problems.Problem(p033solution)

Problems.benchmark(p033)


#Compute approximate errors at tend with analytical solution
function mesh_norm(u, mesh::Uniform1DFVMesh, p)
    mesh_norm(u, mesh.Δx, p)
end
function mesh_norm(u, dx::Real, p)
    @assert p > 0.0 "p must be a positive number"
    if p == Inf
        maximum(abs.(u))
    else
        (sum(abs,(u).^p)*dx)^(1/p)
    end
end

"""
function get_LP_error(ref::Function, sol::AbstractFVSolution; relative = true, p = 1.0, pointwise::Bool = false)
    Compute Lp errores of FVSolution `sol` against reference solution `ref`.
    Additional options:
    `relative`: default true. Compute relative or absolute error
    `p`: parameter to define Lp norm
    `poitwise` default false. Compute errors against pointwise values of reference solution or cell averages
"""
function get_LP_error(ref::Function, sol::AbstractFVSolution{T}; relative::Bool = true, p = 1.0, pointwise::Bool = false) where {T}
    x = cell_centers(getmesh(sol))
    #tspan = sol.prob.tspan
    Tend = gettimes(sol)[end]
    uexact = fill!(similar(getvalues(sol)[end]), zero(T))
    faces = cell_facets(getmesh(sol))
    _compute_exact_sol!(uexact, Tend, sol, x, faces, ref, pointwise)
    relative ? 100*mesh_norm((getvalues(sol)[end] - uexact), getmesh(sol), p)/mesh_norm(uexact, getmesh(sol), p) : mesh_norm((getvalues(sol)[end] - uexact), getmesh(sol), p)
end

function _compute_exact_sol!(uexact::AbstractArray{T,2},Tend, sol, x, faces, ref, pointwise) where {T}
    for i in 1:getncells(getmesh(sol))
        if pointwise
            uexact[:,i] = ref(x[i], Tend)
        else
            uexact[:,i] = num_integrate(x->ref(x, Tend),faces[i], faces[i+1])/cell_volume(getmesh(sol), i)
        end
    end
end

function _compute_exact_sol!(uexact::AbstractArray{T,1},Tend, sol, x, faces, ref, pointwise) where {T}
    for i in 1:getncells(getmesh(sol))
        if pointwise
            uexact[i] = ref(x[i], Tend)
        else
            uexact[i] = num_integrate(x->ref(x, Tend),faces[i], faces[i+1])/cell_volume(getmesh(sol), i)
        end
    end
end

function get_L1_error(ref::Function, sol::AbstractFVSolution)
    get_LP_error(ref, sol; relative = false)
end

function get_relative_L1_error(ref::Function, sol::AbstractFVSolution)
    get_LP_error(ref, sol)
end

# "Compute aproximate L1 errors with numerical reference solution"
function get_num_LP_error(reference,M, uu,N,dx; relative::Bool = true, p = 1.0)
    uexact = fill!(similar(uu), zero(eltype(uu)))
    R = Int(round(M/N))
    for i = 1:N
        uexact[:,i] = 1.0/R*sum(reference[:,R*(i-1)+1:R*i],dims=1)
    end
    relative ? 100.0*mesh_norm((uu - uexact), dx, p)/mesh_norm(uexact, dx, p) : mesh_norm((uu - uexact), dx, p)
end

function approx_L1_error(sol_ref::AbstractFVSolution, sol::AbstractFVSolution)
    M = getncells(getmesh(sol_ref))
    N = getncells(getmesh(sol))
    dx = cell_volume(getmesh(sol), 1)
    return get_num_LP_error(getvalues(sol_ref)[end],M, getvalues(sol)[end],N,dx;relative = false)
end

function approx_relative_L1_error(sol_ref::AbstractFVSolution, sol::AbstractFVSolution)
    M = getncells(getmesh(sol_ref))
    N = getncells(getmesh(sol))
    dx = cell_volume(getmesh(sol), 1)
    return get_num_LP_error(getvalues(sol_ref)[end],M, getvalues(sol)[end],N,dx;relative = true)
end

# # function estimate_error_cubic(reference,M, xx,uu,N)
# #   uexact = zeros(N)
# #   itp = interpolate(reference[:,2], BSpline(Cubic(Flat())),OnCell())
# #   i = (M-1)/(reference[M,1]-reference[1,1])*(xx - reference[1,1])+1
# #   uexact = itp[i]
# #   sum(1.0/N*abs(uu - uexact))
# # end

## Order of convergence Tables
struct FVOOCTable{T,ntype}
  data::Matrix{T}
  alg_name::ntype
end

scheme_short_name(alg::AbstractFVAlgorithm) =  string(typeof(alg))

"""
get_conv_order_table(alg, get_problem, u_exact, mesh_ncells; relative = true, kwargs...)
Compute a table of errors and approximate order of convergence for numerical scheme `alg`
by solving a Conservations Laws problem in a sequence of meshes of cell size given by
`mesh_ncells`.
`get_problem` is a function that returns a ConservationLawsProblem given a number of cells `N`
`kwargs` extra arguments are passed to `solve` function
"""
function get_conv_order_table(alg,solve, get_problem, u_exact::Function, mesh_ncells, TimeIntegrator; relative::Bool = true, kwargs...)
    errors = fill(zero(Float64),size(mesh_ncells,1),2)
    @assert size(mesh_ncells,1) > 2 "mesh_sizes must have at least two elements"
    for (i,N) in enumerate(mesh_ncells)
        prob,mesh,cb,dt = get_problem(N, alg)
        sol_ode = solve(prob, TimeIntegrator;dt = dt, callback = cb, kwargs...);
        sol = fv_solution(sol_ode, mesh)
        errors[i,1] = relative ? get_relative_L1_error(u_exact, sol) : get_L1_error(u_exact, sol)
    end
    @. errors[2:end,2] = -log(errors[1:(end-1),1]/errors[2:end,1])/log(mesh_ncells[1:(end-1)]/mesh_ncells[2:end]);
    return FVOOCTable([mesh_ncells errors[:,1] errors[:,2]],scheme_short_name(alg))
end

function get_conv_order_table(alg,solve, get_problem, u_exact::AbstractFVSolution, mesh_ncells, TimeIntegrator; relative::Bool = true, kwargs...)
    errors = fill(zero(Float64),size(mesh_ncells,1),2)
    @assert size(mesh_ncells,1) > 2 "mesh_sizes must have at least two elements"
    for (i,N) in enumerate(mesh_ncells)
        prob,mesh,cb,dt = get_problem(N, alg)
        sol_ode = solve(prob, TimeIntegrator;dt = dt, callback = cb, kwargs...);
        sol = fv_solution(sol_ode, mesh)
        errors[i,1] = relative ? approx_relative_L1_error(u_exact, sol) : approx_L1_error(u_exact, sol)
    end
    @. errors[2:end,2] = -log(errors[1:(end-1),1]/errors[2:end,1])/log(mesh_ncells[1:(end-1)]/mesh_ncells[2:end]);
    return FVOOCTable([mesh_ncells errors[:,1] errors[:,2]],scheme_short_name(alg))
end


function sigmoid(x::Float64)::Float64
    return (MathConstants.e^x)/(1 + MathConstants.e^x)
end

function sigmoid_p(x::Float64)::Float64
    return (MathConstants.e^x)/(1 + 2MathConstants.e^x + MathConstants.e^(2x))
end

function MSE(a::Vector{Float64},l::Vector{Float64})::Float64
    return 0.5*(sum((a.-l).^2))
end

function MSE_p(a::Vector{Float64},l::Vector{Float64})::Float64
    return sum(a.-l)
end


function perform_conjugate_gradient(A,y)

    """
     perform_conjugate_gradient - perform (bi)-conjugate gradient

         x = perform_conjugate_gradient(A,y);

       Solves for A*x=y.
       Works for vector x,y

       Important: the algorithm assumes that the matrix is symmetric definite
       positive.

       Copyright (c) 2007 Gabriel Peyre
    """

    niter = 100
    epsilon = 1e-5
    is_sdp = 1
    x = zeros(size(A,2),1)
    normb = epsilon
    r  = y - A*x
    p = r
    r0 = sum(vec(r).^2)

    err = [sum(r0)]
    for it in 1:niter
        # auxiliary vector
        w  = A*p

        d = sum(vec(p) .* vec(w));

        if abs(d)<eps()
            d=1
        end
        alpha = repeat( [r0 / d], outer=(size(x,1), 1) );           # found optimal alpha in line search
        x = x + alpha.*p                       # new guess
        r = r - alpha.*w                       # the residual is in fact r=b-A*x

        rprev = r0;                             # save norm of the old residual
        r0 = sum(r.^2);                         # compute norm of new residual

        append!(err, sqrt( sum(r.^2) ))

        if err[end]<normb
            break
        end

        # search direction
        beta = r0./rprev;
        p = r + repeat([beta], outer=(size(x,1), 1)).*p

    end
    return x
end


type PCA
    solver::String
    n_components::Integer
    components::Matrix
    mean_::Vector
end

function PCA(;
             solver::String = "svd",
             n_components::Integer = 2,
             components::Matrix = zeros(4,4),
             mean_::Vector = zeros(4))
    return PCA(solver, n_components, components, mean_)
end

function train!(model::PCA, X::Matrix)
    model.mean_ = vec(mean(X,1))
    n_sample = size(X, 1)
    X_de_mean = X - repmat(model.mean_', n_sample, 1)

    if model.solver == "svd"
        U,S,V = svd(X_de_mean)
    elseif model.solver == "eig"
        cov_ = cov(X_de_mean)
        D,V = eigs(cov_, nev = model.n_components)
    end
    model.components = V[:, 1:model.n_components]
end

function transform(model::PCA,
                 x::Matrix)
    n = size(x,1)
    res = zeros(n, model.n_components)
    for i = 1:n
        res[i, :] = transform(model, x[i,:])
    end
    return res
end

function transform(model::PCA,
                 x::Vector)
    x = x - model.mean_
    x = vec(x' * model.components)
    return x
end

function plot_in_2d(model::PCA, X::Matrix, y::Vector, title::String)
    X = transform(model, X)
    x1 = X[:, 1]
    x2 = X[:, 2]
    df = DataFrame(x = x1, y = x2, clu = y)
    println("Computing finished")
    println("Drawing the plot.....Please Wait(Actually Gadfly is quite slow in drawing the first plot)")
    Gadfly.plot(df, x = "x", y = "y", color = "clu", Geom.point, Guide.title(title))
end

function test_PCA()
    X_train, X_test, y_train, y_test = make_digits()
    model = PCA()
    train!(model,X_train)
    plot_in_2d(model, X_train, y_train, "PCA")
end


# p33.jl - solve linear BVP u_xx = exp(4x), u'(-1)=u(1)=0

N = 16;
(D,x) = cheb(N);
D2 = D^2;
D2[N+1,:] = D[N+1,:];            # Neumann condition at x = -1
D2 = D2[2:N+1,2:N+1];
f = @. exp(4*x[2:N]);
u = D2\[f;0];
u = [0;u];
clf();
plot(x,u,".",markersize=10);
axis([-1,1,-4,0]);
xx = -1:.01:1;
uu = polyval(polyfit(x,u),xx);
plot(xx,uu); grid(true);
exact = @. (exp(4*xx) - 4*exp(-4)*(xx-1) - exp(4))/16;
title("max err = $(signif(norm(uu-exact,Inf),5))",fontsize=12);


# Empirical estimation of CDF and PDF

## Empirical CDF

struct ECDF{T <: AbstractVector{<:Real}}
    sorted_values::T
end

function (ecdf::ECDF)(x::Real)
    searchsortedlast(ecdf.sorted_values, x) / length(ecdf.sorted_values)
end

function (ecdf::ECDF)(v::RealVector)
    ord = sortperm(v)
    m = length(v)
    r = similar(ecdf.sorted_values, m)
    r0 = 0
    i = 1
    n = length(ecdf.sorted_values)
    for x in ecdf.sorted_values
        while i <= m && x > v[ord[i]]
            r[ord[i]] = r0
            i += 1
        end
        r0 += 1
        if i > m
            break
        end
    end
    while i <= m
        r[ord[i]] = n
        i += 1
    end
    return r / n
end

"""
    ecdf(X)

Return an empirical cumulative distribution function (ECDF) based on a vector of samples
given in `X`.

Note: this function that returns a callable composite type, which can then be applied to
evaluate CDF values on other samples.

`extrema`, `minimum`, and `maximum` are supported to for obtaining the range over which
function is inside the interval ``(0,1)``; the function is defined for the whole real line.
"""
ecdf(X::RealVector{T}) where T<:Real = ECDF(sort(X))

minimum(ecdf::ECDF) = first(ecdf.sorted_values)

maximum(ecdf::ECDF) = last(ecdf.sorted_values)

extrema(ecdf::ECDF) = (minimum(ecdf), maximum(ecdf))


export ortho_latin, check_ortho

"""
`A,B = ortho_latin(n)` returns a pair of orthogonal `n`-by-`n`
Latin squares.

`A,B = ortho_latin(n,true)` returns a pair of orthogonal Latin squares
that are transposes of each other.

`A,B = ortho_latin(n,r,s)` builds the Latin squares `latin(n,r)`
and `latin(n,s)` and, if they are orthogonal, returns them as the
answer. (Otherwise, throws an error.) See: `find_ortho_parameters`.
"""
function ortho_latin(n::Int, self::Bool = false)
    if !self
        try
            r, s = find_ortho_parameters(n)
            return ortho_latin(n, r, s)
        catch
        end
    end
    println("No quick solution. Using integer programming.")

    return ortho_latin_IP(n, self)
end

function ortho_latin_IP(n::Int, self::Bool = false)
    MOD = Model(get_solver())
    # Z[i,j,k,l] is an indicator that there is a k in A[i,j] and
    # an l in B[i,j]
    @variable(MOD, Z[1:n, 1:n, 1:n, 1:n], Bin)

    # one entry per cell constraint
    for i = 1:n
        for j = 1:n
            @constraint(MOD, sum(Z[i, j, k, l] for k = 1:n for l = 1:n) == 1)
        end
    end

    # Top row 11 22 33 ... nn
    if !self
        for i = 1:n
            @constraint(MOD, Z[1, i, i, i] == 1)  # A[1,i] = B[1,i] = i
        end
    end

    # orthogonality constraint
    for k = 1:n
        for l = 1:n
            @constraint(MOD, sum(Z[i, j, k, l] for i = 1:n for j = 1:n) == 1)
        end
    end

    # Row constraints

    for i = 1:n
        for k = 1:n
            @constraint(MOD, sum(Z[i, j, k, l] for j = 1:n for l = 1:n) == 1)
        end
    end

    for i = 1:n
        for l = 1:n
            @constraint(MOD, sum(Z[i, j, k, l] for j = 1:n for k = 1:n) == 1)
        end
    end

    # Col constraints
    for j = 1:n
        for k = 1:n
            @constraint(MOD, sum(Z[i, j, k, l] for i = 1:n for l = 1:n) == 1)
        end
    end

    for j = 1:n
        for l = 1:n
            @constraint(MOD, sum(Z[i, j, k, l] for i = 1:n for k = 1:n) == 1)
        end
    end

    if self   # force A^T==B
        for i = 1:n
            for j = 1:n
                for k = 1:n
                    for l = 1:n
                        @constraint(MOD, Z[i, j, k, l] == Z[j, i, l, k])
                    end
                end
            end
        end
    end

    optimize!(MOD)
    status = Int(termination_status(MOD))

    if status != 1
        error("No pair of orthogonal Latin squares of order $n can be found.")
    end

    ZZ = value.(Z)
    A = zeros(Int, n, n)
    B = zeros(Int, n, n)

    for i = 1:n
        for j = 1:n
            for k = 1:n
                for l = 1:n
                    if ZZ[i, j, k, l] > 0
                        A[i, j] = k
                        B[i, j] = l
                    end
                end
            end
        end
    end

    return A, B
end

function ortho_latin(n::Int, r::Int, s::Int)
    A = latin(n, r)
    B = latin(n, s)
    @assert check_ortho(A, B) "Parameters n=$n, r=$r, and s=$s do not generate a pair of orthogonal Latin squares"
    return A, B
end

"""
`find_ortho_parameters(n)` tries to find parameters `r` and `s`
so that `ortho_latin(n,r,s)` will succeed. Returns `(r,s)` if
successful or throws an error if not.
"""
function find_ortho_parameters(n::Int)
    for r = 1:n-1
        for s = 1:n-1
            if gcd(n, r) == 1 && gcd(n, s) == 1 && gcd(n, r - s) == 1
                return r, s
            end
        end
    end
    error("No parameters for n=$n found")
end

"""
`check_ortho(A,B)` checks that matrices `A` and `B` are a pair of
orthogonal Latin squares.
"""
function check_ortho(A::Matrix{Int}, B::Matrix{Int})::Bool
    if size(A) != size(B)
        return false
    end
    if !check_latin(A) || !check_latin(B)
        return false
    end
    n, r = size(A)

    vals = unique((n + 1) * A + B)
    return length(vals) == n * n
end


# This file is a part of SimilaritySearch.jl
# License is Apache 2.0: https://www.apache.org/licenses/LICENSE-2.0.txt

export l1_distance, l2_distance, squared_l2_distance, linf_distance, lp_distance

"""
    l1_distance(a, b)::Float64

Computes the Manhattan's distance between `a` and `b`
"""
function l1_distance(a, b)::Float64
    d::Float64 = 0.0 #zero(eltype(a))

    @inbounds @simd for i = 1:length(a)
	    m = a[i] - b[i]
        d += ifelse(m > 0, m, -m)
    end

    d
end

"""
    l2_distance(a, b)::Float64

Computes the Euclidean's distance betweem `a` and `b`
"""
function l2_distance(a, b)::Float64
    #d = zero(eltype(a))
    d::Float64 = 0.0

    @inbounds @simd for i = 1:length(a)
        m = a[i] - b[i]
        d += m * m
    end

    sqrt(d)
end

"""
    squared_l2_distance(a, b)::Float64

Computes the squared Euclidean's distance between `a` and `b`
"""
function squared_l2_distance(a, b)::Float64
    # d = zero(eltype(a))
    d::Float64 = 0.0

    @inbounds @simd for i = 1:length(a)
        m = a[i] - b[i]
        d += m * m
    end

    d
end

"""
    linf_distance(a, b)::Float64

Computes the max or Chebyshev'se distance
"""
function linf_distance(a, b)::Float64
   d::Float64 = 0.0 # d = zero(eltype(a))

    @inbounds @simd for i = 1:length(a)
        m = abs(a[i] - b[i])
        d = max(d, m)
    end

    d
end

"""
    lp_distance(p_::Real)

Creates a function that computes computes generic Minkowski's distance with the given `p_`
"""
function lp_distance(p::Real)
    p = convert(Float64, p)
    invp = 1.0 / p

    function _lp(a, b)::Float64
        d::Float64 = 0.0 # d = zero(eltype(a))

        @inbounds @simd for i = 1:length(a)
            m = abs(a[i] - b[i])
            d += m ^ p
        end

        d ^ invp
    end
end


## Derivative related code

"""
    tangent(f::Function, c)

Returns a function describing the tangent line to the graph of `f` at `x=c`.

Example. Where does the tangent line intersect the y axis?
```
f(x) = sin(x)
tl(x) = tangent(f, pi/4)(x)  # or tl = tangent(f, pi/3) to use a non-generic function
tl(0)
```

Uses the automatic derivative of `f` to find the slope of the tangent line at `x=c`.

"""
tangent(f,c) = x -> f(c) + f'(c) * (x-c)

"""
    secant(f::Function, a, b)

Returns a function describing the secant line to the graph of `f` at `x=a` and `x=b`.

Example. Where does the secant line intersect the `y` axis?

```
f(x) = sin(x)
a, b = pi/4, pi/3
sl(x) = secant(f, a, b)(x)  # or sl = sl(f, a, b) to use a non-generic function
sl(0)
```

"""
secant(f, a, b) = x -> f(a) + (f(b) - f(a)) / (b-a) * (x - a)

"""
    D(f)

Function interface to `ForwardDiff.derivative`.

Also *overrides* `f'` to take take a derivative.
"""
function D(f, n::Int=1)
    n < 0 && throw(ArgumentError("n is a non-negative integer"))
    n == 0 && return f
    n == 1 && return t -> ForwardDiff.derivative(f, float(t))
    D(D(f), n-1)
end

## Create r' to mean the derivative for functions
## warning, this would be odd for [sin, cos]' as
## is it [sin', cos'] or the transpose...
Base.adjoint(r::Function) = D(r)


export jaccard_distance, dice_distance, union_intersection, intersection_distance

function union_intersection(a::T, b::T) where {T <: AbstractVector}
    len_a::Int = length(a)
    len_b::Int = length(b)
    ia::Int = 1
    ib::Int = 1
    intersection_size::Int = 0
    c::Int = 0
    @inbounds while ia <= len_a && ib <= len_b
        c = cmp(a[ia], b[ib])
        if c == 0
            ia += 1
            ib += 1
            intersection_size += 1
        elseif c < 0
            ia += 1
        else
            ib += 1
        end
    end

    return len_a + len_b - intersection_size, intersection_size
end

"""
sim_jaccard computes the Jaccard's coefficient between two sets
represented as sorted arrays.
Note: 1.0 - sim_jaccard computes the Jaccard's distance
"""

function jaccard_distance(a::T, b::T)::Float64 where {T <: AbstractVector}
    u, i = union_intersection(a, b)
    return 1.0 - i / u
end

function dice_distance(a::T, b::T)::Float64 where {T <: AbstractVector}
    u, i = union_intersection(a, b)
    return 1.0 - 2 * i / (length(a) + length(b))
end

mutable struct IntersectionDistance
    calls::Int
    IntersectionDistance() = new(0)
end

function intersection_distance(a::T, b::T)::Float64 where {T <: AbstractVector}
    u, i = union_intersection(a, b)

    return 1.0 - i / min(length(a), length(b))
end


##########################################################
# Rafał Nowak
#
# Instytut Informatyki
# Uniwersytet Wrocławski
#
#
# Pomocniczne materiały do wykładu z analizy numerycznej
#
##########################################################

wartoscDokladna_1e5 = 1.6449240668982262698057485033127;
wartoscDokladna_1e6 = 1.6449330668487264363057484999794;
wartoscDokladna_1e7 = 1.6449339668482314364722484999793;
wartoscDokladna_1e8 = 1.6449340568482264864724149999793;
wartoscDokladna_1e9 = 1.6449340658482264369724151664793;

real = Float32

function algorytm1(n)
  suma = zero(real);
  for k = 1:1:n
    suma = suma + one(real)/convert(real, k)/convert(real,k);
  end
  return suma
end

function algorytm2(n)
  suma = zero(real);
  for k = n:-1:1
    suma = suma + one(real)/convert(real, k)/convert(real,k);
  end
  return suma
end

function doTest(x, algorytm, n)
  println(algorytm, " n=", n)
  @printf("Wynik dokładny  = %.16f\n", x);
  y = algorytm(n);
  @printf("Wynik obliczony = %.16f   błąd względny = %.3e\n", y, abs(x-y)/x);
end

doTest(wartoscDokladna_1e5, algorytm1, 1e5);
doTest(wartoscDokladna_1e5, algorytm2, 1e5);

doTest(wartoscDokladna_1e6, algorytm1, 1e6);
doTest(wartoscDokladna_1e6, algorytm2, 1e6);

@printf("Precyzja arytmetyki = %.3e\n", 0.5*eps(real));


# # Finding patterns in signals using Optimal Transport and Dynamic Time Warping

# In this example we will compare different distances when used as the inner metric in a dynamic time-warping of spectrograms.
# Setup
using DynamicAxisWarping, SpectralDistances, LPVSpectral, DSP, Plots, Statistics, BenchmarkTools, Distances, Random, ThreadTools, AlphaStableDistributions, SlidingDistancesBase
theme(:default)
gr();
Random.seed!(0);

# We start by creating a short patter, the *query*, we then create a long time series that contains a quite similar sound, but where the frequencies of the chirp are slightly higher. This is a realistic scenario when doing, e.g., acoustic detection. Different individuals within the same animal species might have similar calls, but slightly different pitch etc. We also add some alpha sub-gaussian noise in order to make the problem a bit harder.

N       = 48_000 ÷ 2
nfft    = 4096
f1      = range(0.01, stop = 1, length = N)
f2      = range(1, stop = 0.1, length = N) .^ 2
g(x, N) = exp(-10 * (x - N / 2)^2 / N^2)
t       = 1:N
y10     = (sin.(t .* f1) .+ sin.(t .* (f2 .+ 0.4))) .* g.(t, N)
y20     = (sin.(t .* (f1 .+ 0.5)) .+ sin.(t .* (f2 .+ 0.5))) .* g.(t, N)
q       = Float32.(y10 .+ 0.2 .* randn.())
y       = Float32.([0y20; 0y20; y20; 0y20; 0y20] .+ 1 .* randn.())
y     .+= v1(rand(AlphaSubGaussian(n=length(y))));
# y = repeat(y, 40) #src

Q = melspectrogram(q, nfft, window = hanning, fmin = 400, fs = 48_000)
Y = melspectrogram(y, nfft, window = hanning, fmin = 400, fs = 48_000)
plot(plot(Q, title = "Query"), plot(Y, title = "Data"), link = :both, layout = (2, 1))
# We now see if we can detect the pattern using DTW with the standard squared Euclidean distance
rad  = 10 # This is the maximum allowed warping radius
dist = SqEuclidean()
w    = DTWWorkspace(sqrt.(Q.power), dist, rad, Nothing)
res  = dtwnn(w, sqrt.(Y.power))
plot(Y);
vline!([Y.time[res.loc]], l = (4, :blue), primary=false, yscale=:identity)
# That did probably not go well at all! The line indicates where the smallest distance to the pattern was, i.e., where the nearest neighbor search thinks the *onset* of the pattern is.
#---
# Let's do the same with a transport-based distance
n, m = size(Q.power)
dist = DiscreteGridTransportDistance(Cityblock(), Float32, n, n)
w    = DTWWorkspace(sqrt.(Q.power), dist, rad, Nothing)
res  = dtwnn(w, sqrt.(Y.power))
plot(Y);
vline!([Y.time[res.loc]], l = (4, :blue), primary=false)
# The line should now be a better indication of the onset of the pattern
#---
# Next, we plot the cost function for each time shift to see how they behave
function naive(a, b, dist = SqEuclidean(), r = 7)
    dists = map(1:lastlength(b)-lastlength(a)) do i
        dtw_cost(a, b[!, i:i+lastlength(a)-1], dist, r)
    end
end

plot()
for dist in [DiscreteGridTransportDistance(Cityblock(), Float32, n, n), SqEuclidean()]
    @time res = naive(Q.power, Y.power, dist, rad)
    res .-= minimum(res)
    res ./= maximum(res)
    plot!(res, lab = string(typeof(dist).name))
end
fig1 = vline!([2 * size(Y.power, 2) / 5], l = (4, :blue), primary=false)
# The Euclidean distance is rather terrible for this task. The transport based distance seems to be doing the right thing.
#---
# unfortunately, calculating this using the transport-based distance takes quite a while
@btime dtwnn($w, $(sqrt.(Y.power)), prune_endpoints=false)
# while that might not seem like much, the data we're searching through only corresponds to this many seconds, if the sample rate is 48kHz
length(y) / 48000
#---
# We are thus intersted in distances that are faster to compute. We'll explore the OTRD distance, which performs optimal transport between the roots of a linear-system representation of the signal.
fm  = TimeWindow(inner = LS(na = 8, λ=1e-3), n = nfft, noverlap = nfft÷2)
Qm  = fm(q) |> change_precision(Float64)
Ym  = fm(y) |> change_precision(Float64);
# Let's see how the world looks like through the lens of autoregressive models
plot(Qm, LPVSpectral.mel_to_hz(Q.mels)./48000, rad=false)
#---
dist  = OptimalTransportRootDistance(p = 1, β = 0.5)
distf = (x, y) -> evaluate(dist, x, y, tol = 1e-3)
res   = naive(Qm.models, Ym.models, distf, rad)
res .-= minimum(res)
res ./= maximum(res)
plot!(fig1, res, lab = "OTRD")
# This should do an okay job, but is it fast?
#---
w = DTWWorkspace(Qm.models, distf, rad)
@btime dtwnn($w, $(Ym.models), prune_endpoints=false)
# About the same, but it could be much faster if the allocations were taken care of.
# Let's speed up even further, using the root distance (RD)
Qe     = Float32.(reduce(hcat, embedding.(Qm.models))) # This extracts the roots of the linear system into a real vector
Ye     = Float32.(reduce(hcat, embedding.(Ym.models)))
dist   = SqEuclidean();
# dist   = EuclideanRootDistance(p=1, weight=e->sqrt.(residueweight(e))) #src
res    = naive(Qe, Ye, dist, rad)
res  .-= minimum(res)
res  ./= maximum(res)
plot!(res, lab = "RD")
# This should do an okay job, but is it fast?
#---
w = DTWWorkspace(Qe, dist, rad)
dtwnn(w, (Ye), prune_endpoints=false)
@btime dtwnn($w, $(Ye), prune_endpoints=false)
# That should be fast very, but there are still some room for improvements through early-termination heuristics.
GC.gc(true); GC.gc(true) #src

# ## Notes on futher performance improvements
# Searching for the nearest neighbor using DTW tends to become relatively cheaper the longer the data searched through is. This is due to pruning heauristics that abort the search early based on the smallest distance found so far.
# The main thing to watch out for is the length (in time) of the query sequence. Using a larger `nfft` effectively reduces the time resolution which greatly reduces the time-complexity, 𝒪(t²) if pruning heuristics are not effective.
# Let's see how long time it takes to search through a much longer time series (note that estimating the models also takes quite a while, but this is 𝒪(t) expensive and can be easily parallelized so I don't count that for now)
yl  = Float32.(repeat(y, 400) .+ 0.2 .* randn.())
println("Length of singal: ", length(yl)/48_000/60, " minutes, at 48kHz")
Yml = fm(yl) |> change_precision(Float32);
Yel = reduce(hcat, embedding.(Yml.models))
sleep(2) #src
@btime dtwnn($w, $(Yel), prune_endpoints=true)

# ### Future work
# The mass normalization for spectrograms has to be improved. Currently, each spectrum (per time point) is normalized to sum to one. A perhaps better strategy is to normalize the entire spectrogram and then use unbalanced mass transport per time point.

GC.gc(true); GC.gc(true) #src

#---
# # Transport in time
# We can also consider using optimal transport along the time axis instead of DTW. Let's do the same stuff as above for the TimeDistance from SpectralDistances.jl
dist = TimeDistance(inner=OptimalTransportRootDistance(p=1, β=0.5),tp=1,c=0.1)
res   = SpectralDistances.distance_profile(dist, Qm, Ym)
res .-= minimum(res)
res ./= maximum(res)
plot!(fig1, res, lab = "Time transport")
#---
function naive_time(a, b, dist)
    n = length(a)
    dists = map(1:length(b.models)-length(a.models)) do i
        Y = TimeVaryingAR(b.models[i:i+length(a.models)-1])
        dist(a, Y, tol=1e-3, check_interval=2)
    end
end
@btime naive_time($Qm, $Ym, $dist);
@btime SpectralDistances.distance_profile($dist, $(change_precision(Float32,Qm)), $(change_precision(Float32,Ym)), check_interval=5)
# It appears to be surprisingly competitive, both in terms of accuracy and performance, even though it's evaluated using a rather naive method. Since the solver used to find the `TimeDistance` internally solves the *dual* problem, a lower bound of the objective function is always available for free during the optimization. This lower bound could be used to terminate the optimization early if it rises above the smallest distance found so far.

@test mean(abs2, SpectralDistances.distance_profile(dist, Qm, Ym) - naive_time(Qm, Ym, dist)) < 1e-4


### A Pluto.jl notebook ###
# v0.14.5

using Markdown
using InteractiveUtils

# ╔═╡ 06240e71-df45-4f63-b797-4042432e6716
using FFTW, Plots, SampledSignals

# ╔═╡ f8ba933c-a1e3-11eb-2263-17f14870c1fa
md"# Basic Waveforms
First let's see what basic waveforms can be made directly."

# ╔═╡ bfacded1-6007-4e18-aba1-1b7325878dd2
begin
    fs = 8000
	freqs = SampleBuf(Array(LinRange(0, 2*pi*220, fs)), fs)
	t = Array(0:1/100:1) * 2 * pi
end

# ╔═╡ 65dbcdfe-2dbd-4b28-ab59-fb12425913ca
function plotfreqs(tone, title)
	freqs = fft(tone) |> fftshift
	domain = FFTW.fftfreq(length(tone), fs) |> fftshift
    plot(domain, 10*log10.(abs.(freqs)/fs), title=title,
		xlimit=(0, fs/2), ylimit=(-50, 0))
end

# ╔═╡ 4bd75a55-4457-4625-a184-a2f7490cbf0e
md"## Sinusoids
The builtin sin() and cos() functions produce sinusoidal waves, they are roughly
equivalent for this, being phase shifted versions of each other."

# ╔═╡ 664b9502-13de-4fdf-971c-66cf0ea47c3b
plot(t, sin.(t))

# ╔═╡ 5e805acc-c6b1-4de5-8bc1-5bdcbd84ca04
sine_tone = sin.(freqs)

# ╔═╡ 2a51d397-322b-414b-9d9f-a1e8ba6b2364
plotfreqs(sine_tone, "Sine Spectrum")

# ╔═╡ dd813478-66a1-4d3e-9872-322e7b521e11
md"## Modulo waveforms
### Sawtooth
Using the periodic behavior of the remainder operator we get a sawtooth wave.
However, making a sawtooth directly like this gives aliasing
since this equivalent to sampling an analog sawtooth wave with all harmonics.
Harmonics higher than half the sampling rate cannot accurately be represented
and appear as lower frequencies when reproducing the sound.
This aliasing shows up as noise in the signal that is visible on the frequency graph.
"

# ╔═╡ a2357e48-116a-4df1-a52d-100533bad25d
function saw(t)
	t/pi % 2 - 1
end

# ╔═╡ 50824ffc-622d-4a00-acce-558cecf79e55
plot(t, saw.(t))

# ╔═╡ 3ae066cb-b5f2-4913-8a73-20348a401026
saw_tone = saw.(freqs)

# ╔═╡ 7bd89cfd-9894-4644-b0e4-cae8a63cda9a
plotfreqs(saw_tone, "Aliased Saw Spectrum")

# ╔═╡ dfa8eb03-2955-4bb6-b9ca-eb7cd6583e57
md"
### Triangle
The jagged shape of the sawtooth wave, with it's sharp discontinuity,
is why it's higher harmonics are so loud.
If we use two ramps to remove the discontinuity we get a triangle wave
with harmonics that fall off more quickly.
The aliasing is reduced since the harmonics are softer by the time they reach the frequency limit. It also no longer has even harmonics, since the second half is the first half upside down."

# ╔═╡ a9f4a512-c8b4-474a-a93c-2cef99db534c
function tri(t)
	abs(t/pi%2-1)*2-1
end

# ╔═╡ f6f28913-cbfa-48f8-98ab-0d5ed267b350
plot(t, tri.(t))

# ╔═╡ 231185ea-8913-490d-8fe8-261983552457
tri_tone = tri.(freqs)

# ╔═╡ b627d7af-55d1-4d97-8f15-7f0d172f9b5a
plotfreqs(tri_tone, "Triangle Spectrum")

# ╔═╡ 99708158-d74e-4311-a10f-d0ac4f79d4f2
md" ### Polynomial waveforms
We can use polynomials of a sawtooth wave to get various periodic waveforms.
If the two endpoints are equal the wave will be continuous.
If the derivitives at the endpoints are equal the waveform will be smooth.
Smooth waveforms have harmonics that fall off even faster than continuous waveforms.

Using a parabola we get harmonic roll-off similar to a triangle wave
but including the even harmonics:
"

# ╔═╡ 1f127661-47b0-4498-9fc2-857f314b6869
function poly2(t)
	"""
	Parabolic waveform
	since t^2 gives output in [0, 1] we use 2t^2-1 to get output in [-1,1]

	Note that since f' = 2x + b is linear we can't make a smooth function
	since no two points can be equal
	"""
	t = t/pi %2 -1
	2*t*t - 1
end

# ╔═╡ 99f21cb1-b50f-4e8b-9d97-8bf5297afbec
poly2_tone = poly2.(freqs)

# ╔═╡ 8802e5fe-8416-4c67-a1f0-b99bb6af3e3f
plot(t, poly2.(t))

# ╔═╡ b561d76e-e2a7-4c3d-9677-42f8b5661b7c
# Kind of like a triangle wave but with even harmonics
plotfreqs(poly2_tone, "Poly2 Spectrum")

# ╔═╡ 09d7e4f3-fed8-4fc8-b598-03ecc8e75d6f
md"With a cubic we can get a smooth function.
This has harmonics that fall off quickly enough that there is no noticable aliasing,
even at this low of a samplerate.
"

# ╔═╡ aff77549-c6da-4329-8e92-5f1fb561ece6
function poly3(t)
	"""
	f(x) = x^3 + bx^2 + cx
	function is continuous when
	1 + b + c = f(1) = f(-1) = -1 + b - c
	2c = -2, c = -1

	f'(x) = 3x^2 + 2bx - 1
	function is smooth when
    3 + 2b - 1 = f'(1) = f'(-1) = 3 - 2b - 1
	4b = 0, b = 0

	f(x) = x^3 - x
	f'(x) = 3x^2-1 = 0  when x = +-1/sqrt(3)
	f(-1/sqrt(3)) = -1/sqrt(3)/3+1/sqrt(3) = 2/(3sqrt(3))
	We scale by the inverse 3sqrt(3)/2
	"""
	t = t/pi%2-1
	x = 3*sqrt(3)/2*t*(t*t - 1)
end

# ╔═╡ e91b624c-cef9-4f74-8bf0-76a484c9c895
poly3_tone = poly3.(freqs)

# ╔═╡ 6880cf94-23ee-4a96-8b9f-0417fc239374
plot(t, poly3.(t))

# ╔═╡ 4caa26e8-c5ce-4d30-b80b-d3ed7659efa0
# Here there is no aliasing >-40db
plotfreqs(poly3_tone, "Poly3 Spectrum")

# ╔═╡ 1701a11b-b17b-499a-bf5f-0d721c026590
md"As we smooth the function more by setting higher derivitives equal
the polynomials approach a pure sine tone"

# ╔═╡ e060b886-4af2-4692-8882-79ceabe64ff1
function normalize(tone)
	""" Normalizing polynomial waveforms directly is annoying
	so we will use this function instead of calculating minimum and maximums"""
	m = minimum(tone)
	M = maximum(tone)
	2*(tone.-m)/(M-m) .-1
end

# ╔═╡ 85236c40-9c9c-4e00-b8e8-54787a5760af
function poly4(t, b)
	"""
	f = x^4 + bx^3 + cx^2 + dx
	1+b+c+d = f(1) = f(-1) = 1-b+c-d
	2(b+d) = 0, b+d = 0, d = -b
	-4+3b+2c-b = f'(1) = f'(-1) = -4+3b-2c-b
	2(4+2c) = 0, 4+2c = 0, c = -2
	f = x^4 + bx^3 - 2x^2 - bx
	"""
	t = t/pi%2-1
	t = (((t + b)*t -2)*t - b)*t
end

# ╔═╡ f1a60f5c-53c6-4533-b3ed-e715fb67d7ba
poly4_tone = normalize(poly4.(freqs, 0))

# ╔═╡ 788ec89e-c1d0-498b-8e8c-82de0bc4eda6
plot(t, normalize(poly4.(t, 0)))

# ╔═╡ e24388fa-d474-4770-95a0-d34627ae7a04
# No overtones reach the niquist rate, no aliasing at all
plotfreqs(poly4_tone, "Poly4 Spectrum")

# ╔═╡ bf89825a-944b-4771-a619-e4c5d1220f61
function poly5(t)
	"""
	f = ax^5 + bx^4 + cx^3 + dx^2 + ex + f
	f(-1) = 0 = -a + b -c + d + -e + f
	a+c+e = b+d+f
	f(1) = 0 = a+b+c+d+e+f = 2*(a+c+e) => a+c+e = 0
	5a-4b+3c-2d+e = f'(-1) = f'(1) = 5a+4b+3c+2d+e
	<=> 4b + 2d = 0 <=> d = -2b
	b - 2b + f = 0
	f = b
	20a+12b+6c+2d = f''(1) = f''(-1) = -20a +12b -6c +2d
	40a + 12 c = 0
	c = -10/3a
	60a+24b+6c = f'''(1) = f'''(-1) = 60a -24b + 6c
	b = 0
	"""
    t = t/pi%2-1
	a = 1
	c = -10/3*a
	b = 0
	((((a*t + b)*t + c)*t - 2*b)*t-(c + a))*t + b
end

# ╔═╡ 076a215e-1335-4974-b61e-06fa4c9e9295
begin
	plot(t, -normalize(poly5.(t)))
	plot!(t, sin.(t))
end

# ╔═╡ e5ac5d3e-1240-4a3c-bc9a-d8e8e6fec60f
poly5_tone = normalize(poly5.(freqs))

# ╔═╡ 82c3a459-0944-4637-a481-cafd15402afe
# We can see the progression of higher degree waveforms approaching the sine wave spectrum
plotfreqs(poly5_tone, "Poly5 Spectrum")

# ╔═╡ 36e284d1-a982-45c2-a0cc-dae1cc355362
md"## Odd harmonics
To get only odd harmonics
we need the second half of the waveform
to be the negative of the first half.
This sounds like we need an odd function where $f(-x) = -f(x)$,
but this would have the second half in reverse order.
We actually need a function where for some a, $f(x+a) = -f(x)$.
The only functions like that everywhere are already periodic,
since $f(x+2a) = -f(x+a) = f(x)$.
So we can't solve for polynomials like before.

However a waveform with this property can be constructed very easily piecewise
as $g(x) = \{f(x)$ if $x > 0$ else $-f(x+1)\}$ from any function defined on the interval $[0,1]$.
Using the sign of $x$ we can remove the if statement by taking
$g(x) = \text{sign}(x)f(2x-\text{sign}(x))$ on the interval $[-1, 1]$,
for a function $f(x)$ on $[-1, 1]$.

For the resulting function to be connected we need $f(-1) = f(1) = 0$.
For this function to be smooth we need $f'(-1) = -f'(1)$ as well.
Any even function ($f(x) = f(-x)$ everywhere) has both these properties,
provided that it is smooth on the interval and it is translated so that it's
endpoints are $0$.
"

# ╔═╡ 3e73b73b-79a3-4ba6-bfc5-94f39816680f
function para(t)
	""" f(x) = x^2-1
	g(x) = sign(x)f(2x-sign(x))
	= sign(x)((2x-sign(x))^2-1) = sign(x)((4x^2 -4xsign(x) + 1)-1)
	= 4*x(abs(x)-1)
	"""
	t = t/pi%2-1
	4*t*(abs(t)-1)
end

# ╔═╡ 97ec7198-36e8-410b-9602-d6b61f31db6b
begin
	plot(t, para.(t))
	plot!(t, sin.(t))
end

# ╔═╡ 2765c9be-3636-45de-9804-7fecb69f4a7b
para_tone = para.(freqs)

# ╔═╡ 52f4cba9-6eb4-42fe-bef5-8ea1a0f4e18a
plotfreqs(para_tone, "Parabola Spectrum")

# ╔═╡ 0ade700b-6193-4518-8470-bb787f87ba47
function ecubic(t)
	"""
	f(x) = abs(x)^3-1
	g(x) = sign(x)f(2x-sign(x))
         = sign(x)(abs(2x-sign(x))^3-1)
	"""
	t = t/pi%2-1
	s = sign(t)
	t = s*(abs(2*t-s)^3-1)
end

# ╔═╡ f116f443-0643-4cbb-8da8-4f9a312fd82f
plot(t, ecubic)

# ╔═╡ 35acdceb-34f5-4a39-aa06-569ab6f16205
ecubic_tone = ecubic.(freqs)

# ╔═╡ d7f37c37-a912-4324-8ca2-063f7c1f3ebc
plotfreqs(ecubic_tone, "Even Cubic Spectrum")

# ╔═╡ f86cda73-edd8-4905-81e0-83a6529daacc
function quart(t)
	"""
	f(x) = x^4-1
	g(x) = sign(x)((2x-sign(x))^4-1)
	"""
	t = t/pi%2-1
	s = sign(t)
	t = s*((2*t-s)^4-1)
end

# ╔═╡ 89fee0e4-7e7f-400b-9cc2-8b3186ab0384
plot(t, quart.(t))

# ╔═╡ b649ead1-acf8-4390-bb9e-ae876a1c7f48
quart_tone = quart.(freqs)

# ╔═╡ c492d40f-fc0d-4b06-a925-7c75bff32503
plotfreqs(quart_tone, "Quartic Spectrum")

# ╔═╡ d5e54701-36a3-45f9-ac2c-8917b2e3a09d
md"Polynomial methods are cheap to compute and have more tone than a pure sine wave but aren't inherently bandlimited and so can't make brighter sounds similar to analog square or saw waves without aliasing."

# ╔═╡ Cell order:
# ╟─f8ba933c-a1e3-11eb-2263-17f14870c1fa
# ╠═06240e71-df45-4f63-b797-4042432e6716
# ╠═bfacded1-6007-4e18-aba1-1b7325878dd2
# ╠═65dbcdfe-2dbd-4b28-ab59-fb12425913ca
# ╟─4bd75a55-4457-4625-a184-a2f7490cbf0e
# ╠═664b9502-13de-4fdf-971c-66cf0ea47c3b
# ╠═5e805acc-c6b1-4de5-8bc1-5bdcbd84ca04
# ╠═2a51d397-322b-414b-9d9f-a1e8ba6b2364
# ╠═dd813478-66a1-4d3e-9872-322e7b521e11
# ╠═a2357e48-116a-4df1-a52d-100533bad25d
# ╠═50824ffc-622d-4a00-acce-558cecf79e55
# ╠═3ae066cb-b5f2-4913-8a73-20348a401026
# ╠═7bd89cfd-9894-4644-b0e4-cae8a63cda9a
# ╠═dfa8eb03-2955-4bb6-b9ca-eb7cd6583e57
# ╠═a9f4a512-c8b4-474a-a93c-2cef99db534c
# ╠═f6f28913-cbfa-48f8-98ab-0d5ed267b350
# ╠═231185ea-8913-490d-8fe8-261983552457
# ╠═b627d7af-55d1-4d97-8f15-7f0d172f9b5a
# ╟─99708158-d74e-4311-a10f-d0ac4f79d4f2
# ╠═1f127661-47b0-4498-9fc2-857f314b6869
# ╠═99f21cb1-b50f-4e8b-9d97-8bf5297afbec
# ╠═8802e5fe-8416-4c67-a1f0-b99bb6af3e3f
# ╠═b561d76e-e2a7-4c3d-9677-42f8b5661b7c
# ╠═09d7e4f3-fed8-4fc8-b598-03ecc8e75d6f
# ╠═aff77549-c6da-4329-8e92-5f1fb561ece6
# ╠═e91b624c-cef9-4f74-8bf0-76a484c9c895
# ╠═6880cf94-23ee-4a96-8b9f-0417fc239374
# ╠═4caa26e8-c5ce-4d30-b80b-d3ed7659efa0
# ╠═1701a11b-b17b-499a-bf5f-0d721c026590
# ╠═e060b886-4af2-4692-8882-79ceabe64ff1
# ╠═85236c40-9c9c-4e00-b8e8-54787a5760af
# ╠═f1a60f5c-53c6-4533-b3ed-e715fb67d7ba
# ╠═788ec89e-c1d0-498b-8e8c-82de0bc4eda6
# ╠═e24388fa-d474-4770-95a0-d34627ae7a04
# ╠═bf89825a-944b-4771-a619-e4c5d1220f61
# ╠═076a215e-1335-4974-b61e-06fa4c9e9295
# ╠═e5ac5d3e-1240-4a3c-bc9a-d8e8e6fec60f
# ╠═82c3a459-0944-4637-a481-cafd15402afe
# ╠═36e284d1-a982-45c2-a0cc-dae1cc355362
# ╠═3e73b73b-79a3-4ba6-bfc5-94f39816680f
# ╠═97ec7198-36e8-410b-9602-d6b61f31db6b
# ╠═2765c9be-3636-45de-9804-7fecb69f4a7b
# ╠═52f4cba9-6eb4-42fe-bef5-8ea1a0f4e18a
# ╠═0ade700b-6193-4518-8470-bb787f87ba47
# ╠═f116f443-0643-4cbb-8da8-4f9a312fd82f
# ╠═35acdceb-34f5-4a39-aa06-569ab6f16205
# ╠═d7f37c37-a912-4324-8ca2-063f7c1f3ebc
# ╠═f86cda73-edd8-4905-81e0-83a6529daacc
# ╠═89fee0e4-7e7f-400b-9cc2-8b3186ab0384
# ╠═b649ead1-acf8-4390-bb9e-ae876a1c7f48
# ╠═c492d40f-fc0d-4b06-a925-7c75bff32503
# ╟─d5e54701-36a3-45f9-ac2c-8917b2e3a09d


"""
    normalize(x)

Transforms a univariate array into a 0 mean and unit standard deviation array.

# Examples

```jldoctest
julia> GrammianAngularFields.normalize(collect(1:5))
5-element Array{Float64,1}:
 -1.2649110640673518
 -0.6324555320336759
  0.0
  0.6324555320336759
  1.2649110640673518
```
"""
function normalize(x::AbstractVector)
    m = StatsBase.mean(x)
    (x .- m) ./ StatsBase.stdm(x, m)
end

"""
    standardize(x)

Transforms a univariate array into a 0, 1 range.
"""
function standardize(x::AbstractVector)
    (x .- minimum(x)) ./ (maximum(x)-minimum(x))
end

"""
    standardize(x, a, b)

Transforms a univariate array into a a, b range.
"""
function standardize(x::AbstractVector, a::Number, b::Number)
    standardize(x) .* (b-a) .+ a
end


#!/usr/bin/env julia
using Printf

function ζ(N::Int64,a::Int64)
  s = 0.0
  @simd for i ∈ 1:N
    s+=(1.0/i)^a
  end
  s
end

N = 16000000000
@time ζ_2 = ζ(N,2)
π_squared_over_6 = π^2 / 6.0;

@printf "      ζ(2) = %18.16f\n" ζ_2
@printf "π^2 / 6.0  = %18.16f\n" π_squared_over_6
@printf "     error = %18.16f\n" π_squared_over_6 - ζ_2


# Uncomment below if the package is not already installed
#using Pkg; Pkg.add("DifferentialEquations")

using DifferentialEquations, PyPlot
f(y,p,t) = [y[2], -sin(y[1])]
y0 = [2.5, 0]

tspan = (0.0, 10.0)

prob = ODEProblem(f, y0, tspan)
sol = solve(prob, abstol=1e-8, reltol=1e-8);

display(hcat(sol.t, collect(sol.u)))

tt = 0:0.1:10
plot(tt, sol.(tt));
legend(("\$\\theta(t)\$", "\$\\theta'(t)\$"));

condition(y, t, integrator) = y[2]

affect!(integrator) = terminate!(integrator)

cb = ContinuousCallback(condition, affect!)
sol = solve(prob, callback=cb, abstol=1e-8, reltol=1e-8)
println("Period = $(2sol.t[end])")


function bracket_sign_change(f′, a, b; k=2)
    if a > b; a,b = b,a; end # ensure a < b
    center, half_width = (b+a)/2, (b-a)/2
    while f′(a)*f′(b) > 0
        half_width *= k
        a = center - half_width
        b = center + half_width
    end
    return (a,b)
end

df(x) = 10*cos(10*x)-3*sin(3*x)

as,bs = bracket_sign_change(df,3.4,3.8)
as,df(as),bs,df(bs)


##############################################################################
#
# REFERENCES: Using definition from Devroye, IX.7
#  This definition differs from definitions on Wikipedia and other sources,
#  where distribution is over [0, 1] rather than [-1, 1].
#
##############################################################################

immutable Arcsine <: ContinuousUnivariateDistribution
end

function cdf(d::Arcsine, x::Number)
    if x < -1.0
        return 0.0
    elseif x > 1.0
        return 1.0
    else
        return (2.0 / pi) * asin(sqrt((x + 1.0) / 2.0))
    end
end

entropy(d::Arcsine) = -log(2.0) / pi

function insupport(d::Arcsine, x::Number)
    if -1.0 <= x <= 1.0
        return true
    else
        return false
    end
end

mean(d::Arcsine) = 0.0

median(d::Arcsine) = 0.0

function pdf(d::Arcsine, x::Number)
    if insupport(d, x)
        return 1.0 / (pi * sqrt(1.0 - x^2))
    else
        return 0.0
    end
end

quantile(d::Arcsine, p::Real) = 2.0 * sin((pi / 2.0) * p)^2 - 1.0

rand(d::Arcsine) = sin(2.0 * pi * rand())

skewness(d::Arcsine) = 0.0

var(d::Arcsine) = 1.0 / 2.0


# This module solves the Ramsey problem for the quasi linear case
# We'll try to replicate figures from quant econ https://python-advanced.quantecon.org/opt_tax_recur.html#top

#----------------- CHECKING WITH QUANTECON ---------------------------------------------------#
## Parameters
β = 0.9;
σ = 2;
γ = 2;

## Utility functions
u(x) = x^(1 - σ) / (1 - σ);
v(x) = x^(1 + γ) / (1 + γ);
U(c, n) = u(c) - v(n);

## Differentials
Uc(c) = ForwardDiff.derivative(u, c);
Ucc(c) = ForwardDiff.derivative(Uc, c);

Un(n) = -ForwardDiff.derivative(v, n);
Unn(n) = ForwardDiff.derivative(Un, n);

## Defining states
g = [0.1; 0.1; 0.1; 0.1; 0.2; 0.1];
θ = ones(length(g));
s = [(1.0, g[i]) for i in 1:6];
Ps = [0.0 1.0 0.0 0.0 0.0 0.0;
      0.0 0.0 1.0 0.0 0.0 0.0;
      0.0 0.0 0.0 0.5 0.5 0.0;
      0.0 0.0 0.0 0.0 0.0 1.0;
      0.0 0.0 0.0 0.0 0.0 1.0;
      0.0 0.0 0.0 0.0 0.0 1.0];

include("NewtonRoot.jl");

## This function calculates Ramsey Allocation, given Φ and initial state s0
function RamseyAllocation(Φ::Real, s0::Tuple)

    function time1_allocation(s::Tuple)
        θ, g = s[1], s[2];
        n(c::Real) = (g + c) / θ;
        res1(c::Real) = (1 + Φ) * (Uc(c) * θ + Un(n(c))) + Φ * (c * Ucc(c) * θ + n(c) * Unn(n(c)));
        c = NewtonRoot(c -> res1(c), 0.5);

        return c, n(c)
    end

    c_time1 = [time1_allocation(s[i])[1] for i in 1:length(s)];
    n_time1 = [time1_allocation(s[i])[2] for i in 1:length(s)];

    function time0_allocation(s::Tuple)
        θ, g = s[1], s[2];
        n(c::Real) = (g + c) / θ;
        b0(c::Real) = 1.0;
        res0(c::Real) = (1 + Φ) * (Uc(c) * θ + Un(n(c))) + Φ * (c * Ucc(c) * θ + n(c) * Unn(n(c))) - Φ * Ucc(c) * b0(c) * θ
        c = NewtonRoot(c -> res0(c), 0.5)

        return c, n(c)
    end

    c_time0, n_time0 = time0_allocation(s0)[1], time0_allocation(s0)[2];

    return c_time1, n_time1, c_time0, n_time0

end

c_time1, n_time1, c_time0, n_time0 = RamseyAllocation(0.06175628494006816, s[1])

sum_mat = inv(1.0I - β * Ps) * (Uc.(c_time1) .* c_time1 .+ Un.(n_time1) .* n_time1);

ResImC = Uc(c_time0) - Uc(c_time0) * c_time0 - Un(n_time0) * n_time0 - β * sum([Ps[1,i]*sum_mat[i] for i in 1:length(sum_mat)]);

b_time1 = sum_mat ./ Uc.(c_time1);
b_time0 = 1.0;

τ_time1 = [1.0 + Un(n_time1[i]) / Uc(c_time1[i]) for i in 1:length(s)];

function search_Φ(Φ::Real, s0::Tuple)
    c_time1, n_time1, c_time0, n_time0 = RamseyAllocation(Φ, s0);

    i_s0 = findfirst(isequal(s0), s);

    sum_mat = inv(1.0I - β * Ps) * (Uc.(c_time1) .* c_time1 .+ Un.(n_time1) .* n_time1); #this sum is independent of s0

    implementCons = Uc(c_time0) - Uc(c_time0) * c_time0 - Un(n_time0) * n_time0 - β * sum([Ps[i_s0,i] * sum_mat[i] for i in 1:length(sum_mat)]);

    return implementCons

end

Φ_est = NewtonRoot(x -> search_Φ(x, s[1]), 0.1); # 0.06175628494006816

τ_time0 = 0.0;

## Plotting
sHist_h = [2, 3, 4, 6, 6, 6];
sHist_l = [2, 3, 5, 6, 6, 6];

c_sim_h = [c_time1[i] for i in sHist_h];
c_sim_l = [c_time1[i] for i in sHist_l];

n_sim_h = [n_time1[i] for i in sHist_h];
n_sim_l = [n_time1[i] for i in sHist_l];

b_sim_h = [b_time1[i] for i in sHist_h];
b_sim_l = [b_time1[i] for i in sHist_l];

τ_sim_h = [τ_time1[i] for i in sHist_h];
τ_sim_l = [τ_time1[i] for i in sHist_l];

c_plot_h = vcat(c_time0, c_sim_h)
c_plot_l = vcat(c_time0, c_sim_l)

n_plot_h = vcat(n_time0, n_sim_h)
n_plot_l = vcat(n_time0, n_sim_l)

b_plot_h = vcat(b_time0, b_sim_h)
b_plot_l = vcat(b_time0, b_sim_l)

τ_plot_h = vcat(τ_time0, τ_sim_h)
τ_plot_l = vcat(τ_time0, τ_sim_l)

plot(c_plot_h, label="g high")
plot!(c_plot_l, label = "g low")

plot(n_plot_h, label="g high")
plot!(n_plot_l, label = "g low")

plot(b_plot_l, label="g high")
plot!(b_plot_h, label = "g low")

plot(τ_plot_l, label="g high")
plot!(τ_plot_h, label = "g low")


#=
    Network generation.
=#

"""
    Returns an Erdos-Renyi random graph according to the G(N, p) model.

    Args:
        N:
            Total number of nodes of the graph.
        p:
            Probability of existence between pair of nodes.
        is_directed:
            Boolean to signal whether the final graph is undirected or
            directed.
        self:
            {default=false} Boolean to signal whether self-loops are allowed.
    Return:
        graph:
            'Graph' structure representing the final graph according to G(N,p).
"""
function erdos_renyi_net(N::Int, p::Float64, is_directed::Bool, self=false)
    if p<=0 || p>=1
        return
    end

    graph = Graph(is_directed)
    for i in 1:N
        add_node(graph)
    end

    w = -1
    lp = log(1.0-p)

    if is_directed # ----- directed -----
        v = 0
        while v < N
            mu = rand(1)[1]
            lr =  log(1.0 - mu)
            w += (1 +  floor(Int, lr/lp))
            while v<N && N<=w
                w -= N
                v += 1
            end
            if v < N
                if v==w && self
                    add_edge(v+1, w+1, graph)
                elseif v!=w
                    add_edge(v+1, w+1, graph)
                end
            end
        end
    else # ----- undirected -----
        v = 1
        while v < N
            mu = rand(1)[1]
            lr = log(1.0 - mu)
            w += 1 + floor(Int, lr/lp)
            while w >= v && v < N
                w -= v
                v += 1
            end
            if v < N
                add_edge(v+1, w+1, graph)
            end
        end
    end
    return graph
end

"""
    Generate a random graph by parsing G(N, \$\\langle k \\rangle\$) where
    \$\\langle k \\rangle\$ is the desired mean degree of the final graph.

    Args:
        N:
            Total number of nodes of the graph.
        k_mean:
            Expected mean degree of the generated graph.
        is_directed:
            Boolean to signal whether the final graph is undirected or
            directed.
        self:
            {default=false} Boolean to signal whether self-loops are allowed.
    Return:
        graph:
            'Graph' structure representing the final ER graph with the expected
            mean degree.
"""
function ER_k(N::Int, k_mean::Float64, is_directed::Bool, self=false)
    p = k_mean/(N-1)
    graph = erdos_renyi_net(N, p, is_directed, self)
    return graph
end

"""
    Generate a random graph by parsing the total number of nodes, expected
    mean degree and number of edge types.

    Args:
        N:
            Total number of nodes of the graph.
        k_mean:
            Expected mean degree of the generated graph.
        n_types:
            Number of edge types for the final graph.
        is_directed:
            Boolean to signal whether the final graph is undirected or
            directed.
        self:
            {default=false} Boolean to signal whether self-loops are allowed.
    Return:
        graph:
            'Graph' structure representing the final ER graph with the expected
            mean degree and number of edge types. This final graph contains an
            edge property with name "edgetype".
"""
function ER_multi(N::Int, k_mean::Float64, n_types::Int, is_directed::Bool, self=false)
    graph = ER_k(N, k_mean, is_directed, self)
    possible_types = [j for j in 1:n_types]

    edgetypes_prop = [ rand(possible_types) for j in 1:length(graph.edges) ]
    set_edges_properties("edgetype", edgetypes_prop, graph)
    return graph
end

"""
    Specific for exporting the generated Erdos-Renyi random graphs.
    The only metadata exported together with the edgelist is the integer
    "edgetype" property

    Args:
        graph:
            'Graph' structure containing the "edgetype" integer property.
        fout:
            filename to where the edgelist should be exported.
"""
function export_edgefile_csv(graph::Graph, fout::String)
    edges = graph.edges
    edgetype = graph.int_eproperties["edgetype"]
    source_arr, target_arr = Int[], Int[]
    type_arr = Int[]
    for edge in edges
        push!(source_arr, edge.source)
        push!(target_arr, edge.target)
        push!(type_arr, edgetype[edge.index])
    end
    CSV.write(fout, DataFrame([source_arr, target_arr, type_arr], [:Source, :Target, :Type]))
end

# To delete
"""
    Function specific for exporting the generated random networks.
    The only metadata exported together is the "edgetype" property.
"""
function export_edgefile(graph::Graph, fout::String)
    edges = graph.edges
    edgetype = graph.int_eproperties["edgetype"]
    open("$fout.txt", "w") do f
        for edge in edges
            write(f, "$(edge.source)\t$(edge.target)\t$(edgetype[edge.index])\n")
        end
    end
end


#linear_ker.jl

srand(1234)

"""
Compute the kernal, (linear) described

The kernal can be expressed mathematically as k(x,y)=<x,y>

Arguments
---------
x
    First Argument
y
    Second Argument

"""

function linear_ker(x,y)
    if size(x)!==size(y)
        error("Error: Input vectors must have the same dimension and shape")
    end
    return dot(x,y)
end

#std_exp_square_ker.jl

"""
Compute the kernal, exponential squared (standard i.e. no parameters), as described in A Tutorial on Bayesian
Optimization of Expensive Cost Functions, with Application to Active User Modeling and  Hierarchical Reinforcement
Learning Eric Brochu, Vlad M. Cora and Nando de Freitas December 14, 2010.

The kernal can be expressed mathematically as k(x,y)=exp(-1/2||x-y||^2)

Arguments
---------
x
    First Argument
y
    Second Argument

"""

function std_exp_square_ker(x,y)
    if size(x)!==size(y)
        error("Error: Input vectors must have the same dimension and shape")
    end
    return exp(-0.5*(dot(x-y,x-y)))
end

#hyper_exp_square_ker

"""
Compute the kernal, exponential squared (with parameters), as described in A Tutorial on Bayesian
Optimization of Expensive Cost Functions, with Application to Active User Modeling and  Hierarchical Reinforcement
Learning Eric Brochu, Vlad M. Cora and Nando de Freitas December 14, 2010.

The kernal can be expressed mathematically as k(x,y)=exp(-1/2(theta)||x-y||^2)

Arguments
---------
x
    First Argument
y
    Second Argument
theta
    Hyper-parameter

"""

function hyper_exp_square_ker(x,y,theta)
    if size(x)!==size(y)
        error("Error: Input vectors must have the same dimension and shape")
    end
    return exp(-0.5*(dot(x-y,x-y))/theta)
end

#matern_ker
"""
Compute the matern kernal, as described in A Tutorial on Bayesian
Optimization of Expensive Cost Functions, with Application to Active User Modeling and  Hierarchical Reinforcement
Learning Eric Brochu, Vlad M. Cora and Nando de Freitas December 14, 2010.

Arguments
---------
x
    First Argument
y
    Second Argument
h
    Hyper-parameter

"""
function matern_ker(x,y,h)
    if size(x)!==size(y)
        error("Error: Input vectors must have the same dimension and shape")
    end

    return ((0.5^(h-1))/(gamma(h)))*(2*sqrt(h)*sqrt(dot(x-y,x-y)))^h*besselj(h,2*sqrt(h)*sqrt(dot(x-y,x-y)))
end

#cov_gen.jl

"""
Create the varience-covarience matrix K, as described in A Tutorial on Bayesian
Optimization of Expensive Cost Functions, with Application to Active User Modeling and  Hierarchical Reinforcement
Learning Eric Brochu, Vlad M. Cora and Nando de Freitas December 14, 2010.

Arguments
---------
Ker
    Kernal function
x
    Dataset

"""

function cov_gen(ker,x,y)
    return [ker(x[i],y[j]) for i=1:size(x)[1], j=1:size(y)[1]]
end

"""
Update Both of these to make them both quicker
"""

#Second one here need to format and look nice;
function cov_gen2(ker,x,y)
    return cov_gen(ker,x,y)
end

function diag_cov_gen(ker,x)
    K=[ker(x[i],x[i]) for i=1:length(x)]
    return K
end

#comb.jl

"""
Given two arrays with single arrays inside generate the cartesian product set
Credit to: Vandan Parmar
Arguments
---------

a
    array of array 1
b
    array of array 2

"""

function comb(a,b)

    function op1(a,b)
        return [a,b]
    end

    function op2(a,b)
        return cat(1,[a],b)
    end

    function op3(a,b)
        return cat(1,a,[b])
    end

    function op4(a,b)
        return cat(1,a,b)
    end
    a=a[1]

    #shout out to nando
    b=b[1] #Set the array of arrays to be an array so Vandan does not commit at this current time

    if (size(a[1])==())
        if(size(b[1])==())
            op_i = op1
        else

            op_i = op2
        end
    else
        if(size(b[1])==())
            op_i = op3
        else
            op_i = op4
        end
    end

    # print(cat(,map(y -> op_i(1,y),b)))
    print("\n")
    print("\n")
    toReturn = []
    map(x -> map(y -> push!(toReturn,op_i(x,y)),b), a)
    # show(string(toReturn))

    # toReturn = []

    # for ai in a
    #     for bj in b
    #         push!(toReturn,op_i(ai,bj))
    #         print(ai,"\r")
    #     end
    # end

    return [toReturn]
end

#gen_points.jl

"""
Given an array of arrays where each array is the set of values each variable can take, for example
the first array may be learning rate (size 10), the second may be Hyper-parameter 1 size(1000), ect ect,
the function gen_points will generate the set of all possible points considering a point in dimenstion R^n
where n is the number of variables one uses.

Arguments
---------
S
    Array of all arrays containing variable values

"""

function gen_points(S)
    print("gen_points")
    if size(S)[1]==1
        return S[1]
    else
        divider=convert(Int64,round( size(S)[1] /2) )    #Rounds up number of sets divided by two

        ar1=S[1:divider]
        ar2=S[divider+1:end] #Splits S into two

        if size(ar2)[1]==1
            if size(ar1)[1]==1
                return comb(ar1,ar2)
            else
                ar1=gen_points(ar1)
                return comb(ar1,ar2)
            end
        else
            ar1=gen_points(ar1)
            ar2=gen_points(ar2)
            return comb(ar1,ar2)

        end
    end
end