# Essential elements of making quaternions into an a algebra

"""
    conj(q)

Return the quaternion conjugate, which flips the sign of each "vector"
component.

# Examples
```jldoctest
julia> conj(Quaternion(1,2,3,4))
1 - 2𝐢 - 3𝐣 - 4𝐤
```
"""
Base.conj(q::Q) where {Q<:AbstractQuaternion} = wrapper(Q)(q.w, -q.x, -q.y, -q.z)

Base.:-(q::Q) where {Q<:AbstractQuaternion} = wrapper(Q)(-q.components)

for TA ∈ [AbstractQuaternion, Rotor, QuatVec]
    for TB ∈ [AbstractQuaternion, Rotor, QuatVec]
        @eval begin
            Base.:+(q::T1, p::T2) where {T1<:$TA, T2<:$TB} = wrapper($TA, Val(+), $TB)(q.components+p.components)
            Base.:-(q::T1, p::T2) where {T1<:$TA, T2<:$TB} = wrapper($TA, Val(-), $TB)(q.components-p.components)
        end
    end
    for TB ∈ [Real, Symbolics.Num]
        @eval begin
            Base.:+(q::QT, p::$TB) where {QT<:$TA} = wrapper($TA, Val(+), $TB)(q.w+p, q.x, q.y, q.z)
            Base.:-(q::QT, p::$TB) where {QT<:$TA} = wrapper($TA, Val(-), $TB)(q.w-p, q.x, q.y, q.z)

            Base.:+(p::$TB, q::QT) where {QT<:$TA} = wrapper($TB, Val(+), $TA)(p+q.w, q.x, q.y, q.z)
            Base.:-(p::$TB, q::QT) where {QT<:$TA} = wrapper($TB, Val(-), $TA)(p-q.w, -q.x, -q.y, -q.z)
        end
    end
end

function Base.:*(q::Q1, p::Q2) where {Q1<:AbstractQuaternion, Q2<:AbstractQuaternion}
    wrapper(Q1, Val(*), Q2)(
        q.w*p.w - q.x*p.x - q.y*p.y - q.z*p.z,
        q.w*p.x + q.x*p.w + q.y*p.z - q.z*p.y,
        q.w*p.y - q.x*p.z + q.y*p.w + q.z*p.x,
        q.w*p.z + q.x*p.y - q.y*p.x + q.z*p.w
    )
end

function Base.:/(q::Q1, p::Q2) where {Q1<:AbstractQuaternion, Q2<:AbstractQuaternion}
    if p == q
        return one(promote_type(Q1, float(Q2)))
    end
    den = abs2(p)
    wrapper(Q1, Val(/), Q2)(
        (+q.w*p.w + q.x*p.x + q.y*p.y + q.z*p.z) / den,
        (-q.w*p.x + q.x*p.w - q.y*p.z + q.z*p.y) / den,
        (-q.w*p.y + q.x*p.z + q.y*p.w - q.z*p.x) / den,
        (-q.w*p.z - q.x*p.y + q.y*p.x + q.z*p.w) / den
    )
end

for S ∈ [Real, Symbolics.Num]
    @eval begin
        Base.:*(p::Q, s::$S) where {Q<:AbstractQuaternion} = wrapper(Q, Val(*), $S)(s*p.components)
        Base.:*(s::$S, p::Q) where {Q<:AbstractQuaternion} = wrapper($S, Val(*), Q)(s*p.components)
        Base.:/(p::Q, s::$S) where {Q<:AbstractQuaternion} = wrapper(Q, Val(/), $S)(p.components/s)
        function Base.:/(s::$S, p::Q) where {Q<:AbstractQuaternion}
            f = s / abs2(p)
            wrapper($S, Val(/), Q)(p.w * f, -p.x * f, -p.y * f, -p.z * f)
        end
    end
end

"""
    p ⋅ q

Evaluate the inner ("dot") product between two quaternions.  Equal to the
scalar part of `p * conj(q)`.

Note that this function is not very commonly used, except as a quick way to
determine whether the two quaternions are more anti-parallel than parallel, for
functions like [`unflip`](@ref).
"""
@inline function ⋅(p::AbstractQuaternion, q::AbstractQuaternion)
    p.w*q.w + p.x*q.x + p.y*q.y + p.z*q.z
end

"""
    a × b

Return the cross product of two pure-vector quaternions.  Equal to ½ of the
commutator product `a*b-b*a`.
"""
@inline function ×(a::QuatVec, b::QuatVec)
    QuatVec(
        a.y * b.z - a.z * b.y,
        a.z * b.x - a.x * b.z,
        a.x * b.y - a.y * b.x
    )
end

"""
    a ×̂ b

Return the *direction* of the cross product between `a` and `b`; the normalized
vector along `a×b` — unless the magnitude is zero, in which case the zero
vector is returned.
"""
@inline function ×̂(a::QuatVec, b::QuatVec)
    axb = a × b
    av = absvec(axb)
    if av == zero(av)
        return axb
    else
        return axb / av
    end
end

"""
    normalize(q)

Return a copy of this quaternion, normalized.

Note that this returns the same type as the input quaternion.  If you want to
convert to a `Rotor`, just call `Rotor(q)`, which includes a normalization
step.
"""
@inline function normalize(q::AbstractQuaternion)
    return q / abs(q)
end
@inline function normalize(q::Rotor)
    return Rotor(q)  # already normalizes
end


function cstrt_bezdek_ngon(n)
if mod(log2(n),1)==0 && n>=16
    # initialization
    v(u) = 4*pi/n-3*u;
    d(u) = (2*cos(2*u+v(u))+1)/(2*cos(u)+cos(3*u+v(u)));
    F(u) = 1+d(u)^2-2*d(u)*cos(u) - (2-2*cos(v(u)));
    u0 = find_zero(F,(pi/n, 4*pi/(3*n)));
    v0 = 4*pi/n-3*u0;
    d0 = (2*cos(2*u0+v0)+1)/(2*cos(u0)+cos(3*u0+v0));
    r = ones(Int(3*n/8));
    for i = 1:Int(3*n/16)
        r[2*i] = d0;
    end
    x = zeros(Int(3*n/8));
    for i = 1:Int(3*n/8)
        if mod(i,3) == 2
            x[i] = u0+v0;
        else
            x[i] = u0;
        end
    end
    p = zeros(Int(3*n/8-1)); q = zeros(Int(3*n/8-1));
    p[1] = r[1]*sin(x[1]); q[1] = r[1]*cos(x[1]);
    for i = 2:Int(3*n/8-1)
        p[i] = p[i-1] - (-1)^i*r[i]*sin(sum(x[1:i]));
        q[i] = q[i-1] - (-1)^i*r[i]*cos(sum(x[1:i]));
    end
    # construction
    a = zeros(n-1); b = zeros(n-1);
    a[Int(n/2-1)] = p[1]; a[Int(n/2+1)] = -a[Int(n/2-1)];
    b[Int(n/2-1)] = q[1]; b[Int(n/2+1)] = b[Int(n/2-1)];
    a[n-1] = a[Int(n/2-1)]-sin(x[1]+v0); a[1] = -a[n-1];
    b[n-1] = b[Int(n/2-1)]-cos(x[1]+v0); b[1] = b[n-1];
    a[n-2] = p[2]; a[2] = -a[n-2];
    b[n-2] = q[2]; b[2] = b[n-2];
    for i = 1:Int(n/8-1)
        a[Int(mod(n/2-1+i*(3*n/2-2),n))] = p[3*i+1];
        a[Int(n-mod(n/2-1+i*(3*n/2-2),n))] = -a[Int(mod(n/2-1+i*(3*n/2-2),n))];
        b[Int(mod(n/2-1+i*(3*n/2-2),n))] = q[3*i+1];
        b[Int(n-mod(n/2-1+i*(3*n/2-2),n))] = b[Int(mod(n/2-1+i*(3*n/2-2),n))];
        a[Int(mod(n-1+i*(3*n/2-2),n))] = a[Int(mod(n/2-1+i*(3*n/2-2),n))]-(-1)^i*sin(sum(x[1:3*i+1])+u0);
        a[Int(n-mod(n-1+i*(3*n/2-2),n))] = -a[Int(mod(n-1+i*(3*n/2-2),n))];
        b[Int(mod(n-1+i*(3*n/2-2),n))] = b[Int(mod(n/2-1+i*(3*n/2-2),n))]-(-1)^i*cos(sum(x[1:3*i+1])+u0);
        b[Int(n-mod(n-1+i*(3*n/2-2),n))] = b[Int(mod(n-1+i*(3*n/2-2),n))];
        a[Int(mod(n-2+i*(3*n/2-2),n))] = p[3*i+2];
        a[Int(n-mod(n-2+i*(3*n/2-2),n))] = -a[Int(mod(n-2+i*(3*n/2-2),n))];
        b[Int(mod(n-2+i*(3*n/2-2),n))] = q[3*i+2];
        b[Int(n-mod(n-2+i*(3*n/2-2),n))] = b[Int(mod(n-2+i*(3*n/2-2),n))];
        a[Int(mod(n+i*(3*n/2-2),n))] = p[3*i];
        a[Int(n-mod(n+i*(3*n/2-2),n))] = -a[Int(mod(n+i*(3*n/2-2),n))];
        b[Int(mod(n+i*(3*n/2-2),n))] = q[3*i];
        b[Int(n-mod(n+i*(3*n/2-2),n))] = b[Int(mod(n+i*(3*n/2-2),n))];
    end
    a[Int(n/2)] = 0; b[Int(n/2)] = d0;
    return(a,b)
end
end


# Example below has benn taken from https://diffeq.sciml.ai/stable/tutorials/advanced_ode_example/#Declaring-Jacobian-Functions
using DifferentialEquations
function rober(du,u,p,t)
  y₁,y₂,y₃ = u
  k₁,k₂,k₃ = p
  du[1] = -k₁*y₁+k₃*y₂*y₃
  du[2] =  k₁*y₁-k₂*y₂^2-k₃*y₂*y₃
  du[3] =  k₂*y₂^2
  nothing
end
prob = ODEProblem(rober,[1.0,0.0,0.0],(0.0,1e5),(0.04,3e7,1e4))
sol = solve(prob)


@testset ExtendedTestSet "chamfer" begin
    @testset ExtendedTestSet "chamfer" begin
        x = [
            1 1 0 0
            0 1 1 0
            0 1 0 1
            0 1 0 0
        ]
        tfm = Chamfer(x)
        answer = [
            0 0 3 4
            3 0 0 3
            3 0 3 0
            3 0 3 3
        ]
        @test transform(x, tfm) == answer
    end

    @testset ExtendedTestSet "chamfer" begin
        x = [
            1 1 0 0
            0 1 0 0
            0 1 0 0
            0 1 0 0
        ]
        tfm = Chamfer(x)
        answer = [
            0 0 3 6
            3 0 3 6
            3 0 3 6
            3 0 3 6
        ]
        @test transform(x, tfm) == answer
    end

    @testset ExtendedTestSet "chamfer" begin
        x1 = [
            1 1 0 0
            0 1 0 0
            0 1 0 0
            0 1 0 0
        ]
        x = cat(x1, x1; dims=3)
        tfm = Chamfer(x)

        a1 = [
            0 0 3 6
            3 0 3 6
            3 0 3 6
            3 0 3 6
        ]
        answer = cat(a1, a1; dims=3)
        @test transform(x, tfm) == answer
    end
end


module DelaunayTessellationFieldEstimator

# Implements the DTFE algoritm as found in
# Schaap, W.E., 2007. The delaunay tessellation field estimator. Ph. D. Thesis.
# https://www.rug.nl/research/portal/files/2816076/c2.pdf
# Author Harvey Devereux (h.devereux@warwick.ac.uk)
# License: MIT
# Any collaboration welcomed

# university wesite https://warwick.ac.uk/fac/sci/mathsys/people/students/2017intake/devereux/
# personal website https://harveydevereux.github.io/

# Works now but is slower than python (possibly due to pyimport overhead?)

# TODO See if GridInterpolations.jl SimplexGrid is faster than Py-importing
# TODO 3D -> N-D
# TODO Gif visualisation

using VoronoiDelaunay
import VoronoiDelaunay: delaunayedges
using GeometricalPredicates
using NearestNeighbors
import NearestNeighbors: knn, KDTree

# for the simplex based interpolation
using PyCall
@pyimport scipy.interpolate as si

export
DTFE,
Coordinates, GeomToDataAreaScalingFactor, BuildDelaunay!, FindTriangles,
ContiguousVoronoiCellArea, DelaunayTessellation2D, DelaunayTessellation,
Point, Point2D, getplotxyd, delaunayedges, UniquePoints, GeomToDataAreaScalingFactor,
DelaunayVertexDensity, DelaunayVertexGeometryDensity, Point2DToArray, DTFEMap,
Grid, meshgrid

const min_lim = VoronoiDelaunay.min_coord
const max_lim = VoronoiDelaunay.max_coord

"""Holds the original data and the rescaled geometric data to
    comform the VoronoiDelaunay\'s range requirements

    NB: GeometricalPredicates requires points ∈ [1,2] but
        VoronoiDelaunay requires points in [1+eps(float),2-2eps(float)]
"""
mutable struct Coordinates{T <: Array{<:Real,2}}
    DataCoordinates::T
    GeometryCoordinates::T
    DataLims::T
    GeomLims::T
end

"""Constructor to deal which automatically calculates the geometry scale
   data and holds the limits for future scaling.
"""
function Coordinates{T <: Array{<:Real,2}}(Points::T)
    Glim = [min_lim max_lim; min_lim max_lim]
    Dlim = [minimum(Points[:,1]) maximum(Points[:,1]); minimum(Points[:,2]) maximum(Points[:,2])]
    GPoints = Scaling(Points, Glim)
    return Coordinates(Points,GPoints,Dlim,Glim)
end

"""Min max scaling to the VoronoiDelaunay range requirement
"""
function Scaling{T <: Array{<:Real,2}}(coords::T,lim::T)
    Rescale = zeros(size(coords))
    for d in 1:2
        min = minimum(coords[:,d])
        max = maximum(coords[:,d])
        a = minimum(lim[d,:])
        b = maximum(lim[d,:])
        Rescale[:,d] = [ ((coords[i,d] - min)/(max-min))*(b-a)+a for i in 1:size(coords,1)]
    end
    return Rescale
end

"""Returns the scaling factor required to calculate the area in the original
   point space.

   Here M,m and the new min and max (assumed the same for all dimensions)
   and min,max are the dimensions maximum and minimum.

   If the scaling is x* = [(x-min)/(max-min)](M-m)+m by writing
   out (a₁-b₁)(a₂-b₂) in the form of x* you\'ll find
   (a₁-b₁)(a₂-b₂)*SF⁻¹
   where SF  = ∏ᵢ(M-m)/(maxᵢ-minᵢ)
"""
function GeomToDataAreaScalingFactor(C::Coordinates)
    prod = 1
    D = C.DataLims
    G = C.GeomLims
    for d in 1:size(D,1)
        prod *= (maximum(D[d,:])-minimum(D[d,:]))/(maximum(G[d,:])-minimum(G[d,:]))
    end
    return prod
end

"""Wrapper to build a Delaunay tessellation from an
   array of coordinates

   returns the points, the tess object is modified so
   no return necessary
"""
# TODO same function but with the coordinates object?
function BuildDelaunay!{A <: Array{<: Real,2}}(Coords::A)
    # doesnt't seem to exist
    # sizehint(tess,size(Coords,1))
    # This because if you try to push
    # to an old tess the function hangs
    # in an infinite loop
    # there is an issue for this in
    # VoronoiDelaunay.jl
    Tess = DelaunayTessellation()
    Points = Point2D[Point(Coords[i,1],Coords[i,2]) for i in 1:size(Coords,1)]
    push!(Tess, Points)
    return Tess,Points
end

"""Usefull for quikcly getting th triangles vertices
all at once, returns a T <: Point2D
"""
function UnpackVertices{T <: VoronoiDelaunay.DelaunayTriangle}(Triangle::T)
    return geta(Triangle), getb(Triangle), getc(Triangle)
end

"""Usefull for quikcly getting th triangles vertices
all at once, returns a T <: Array
"""
function UnpackVerticesAsArray{T <: VoronoiDelaunay.DelaunayTriangle}(Triangle::T)
    a = [getx(geta(Triangle)),gety(geta(Triangle))]
    b = [getx(getb(Triangle)),gety(getb(Triangle))]
    c = [getx(getc(Triangle)),gety(getc(Triangle))]
    return a,b,c
end

"""Finds all the delaunay triangles with the common vertex of \'point\'
   returns an array of these triangles.
"""
function FindTriangles{T <: VoronoiDelaunay.DelaunayTessellation2D,
                       P <: GeometricalPredicates.Point2D}(tess::T,point::P)
    Triangles = Array{VoronoiDelaunay.DelaunayTriangle,1}()
    for triangle in tess
        a, b, c = UnpackVertices(triangle)
        if point == a || point == b || point == c
            push!(Triangles,triangle)
        end
    end
    return Triangles
end

"""The contiguous voronoi cell at a point i (Schaap, 2007 PhD) is the union of
   all delaunay triangles with the coomon vertex i

   returns the Geometry scale area of the union of the triangles
   in \'Triangles\', use FindTriangles to get these for a point.
"""
function ContiguousVoronoiCellArea{T <: VoronoiDelaunay.DelaunayTriangle}(Triangles::Array{T,1})
    Area=0
    for triangle in Triangles
        Area+=GeometricalPredicates.area(triangle)
    end
    return Area
end

"""Finds the set of unique points within a contigous
   Voronoi cell

   returns the array of unique points
"""
function UniquePoints{T <: VoronoiDelaunay.DelaunayTriangle}(Triangles::Array{T,1})
    Uniques = []
    for triangle in Triangles
        for v in UnpackVertices(triangle)
            if !(v in Uniques)
                push!(Uniques,v)
            end
        end
    end
    return Uniques
end

"""Finds the density in the geometry space (no scaling)
   for a single Delaunay vertex point
"""
function DelaunayVertexGeometryDensity{T <: VoronoiDelaunay.DelaunayTessellation2D,
                                       P <: GeometricalPredicates.Point2D}(tess::T,point::P,mass::Float64=1.0)
    Triangles = FindTriangles(tess,point)
    A = ContiguousVoronoiCellArea(Triangles)
    ρ = mass*length(UniquePoints(Triangles))/A
    return ρ
end

"""Wraps around DelaunayVertexGeometryDensity to calculate
   the density in data space for every delaunay vertex point

   Masses can be set to some field value other than mass. The
   default is a uniform unit mass.

   Returns an array of densities scaled to the data space
"""
function DelaunayVertexDensity{T <: VoronoiDelaunay.DelaunayTessellation2D}(tess::T,C::Coordinates,Masses=ones(length(C.GeometryCoordinates)))
    G = C.GeometryCoordinates
    ρ = zeros(size(G,1))
    for i in 1:size(G,1)
        P = Point2D(G[i,1],G[i,2])
        ρ[i] = DelaunayVertexGeometryDensity(tess,P,Masses[i])
    end
    return ρ./GeomToDataAreaScalingFactor(C)
end

meshgrid(x,y) = (repmat(x',length(y),1),repmat(y,1,length(x)))

"""Computes the interpolated DTFE grid from the given points
   with resolution given by Size
"""
function DTFE(Points,Size=500)
    C = Coordinates(Points)
    tess,P = BuildDelaunay!(C.GeometryCoordinates)
    x,y = meshgrid(linspace(C.DataLims[1,:]...,Size),linspace(C.DataLims[2,:]...,Size))

    D = DelaunayTessellationFieldEstimator.DelaunayVertexDensity(tess,C)
    grid = si.griddata(C.DataCoordinates,D,(x,y),method="linear",fill_value=0)
    return grid
end

end # module DelaunayTessellationFieldEstimator


using Makie, GLMakie, GeometryBasics, Rotations

"""
    conformal_cubed_sphere_mapping(x, y)

Conformal mapping of a cube onto a sphere. Maps `(x, y)` on the north-pole face of a cube
to (X, Y, Z) coordinates in physical space. The face is oriented normal to Z-axis with
X and Y increasing with x and y.

The input coordinates must lie within the range -1 <= x <= 1,  -1 <= y <= 1.

This numerical conformal mapping is described by Rančić et al. (1996).

This is a Julia translation of MATLAB code from MITgcm [1] that is based on
Fortran 77 code from Jim Purser & Misha Rančić.

[1] http://wwwcvs.mitgcm.org/viewvc/MITgcm/MITgcm_contrib/high_res_cube/matlab-grid-generator/map_xy2xyz.m?view=markup
Author of conformal_cubed_sphere_mapping: ["ali.hh.ramadhan@gmail.com <ali.hh.ramadhan@gmail.com>"]
"""
A_Rancic = [
    +0.00000000000000,
    +1.47713062600964,
    -0.38183510510174,
    -0.05573058001191,
    -0.00895883606818,
    -0.00791315785221,
    -0.00486625437708,
    -0.00329251751279,
    -0.00235481488325,
    -0.00175870527475,
    -0.00135681133278,
    -0.00107459847699,
    -0.00086944475948,
    -0.00071607115121,
    -0.00059867100093,
    -0.00050699063239,
    -0.00043415191279,
    -0.00037541003286,
    -0.00032741060100,
    -0.00028773091482,
    -0.00025458777519,
    -0.00022664642371,
    -0.00020289261022,
    -0.00018254510830,
    -0.00016499474461,
    -0.00014976117168,
    -0.00013646173946,
    -0.00012478875823,
    -0.00011449267279,
    -0.00010536946150,
    -0.00009725109376
]

function conformal_cubed_sphere_mapping(x, y)
    X = xᶜ = abs(x)
    Y = yᶜ = abs(y)

    kxy = yᶜ > xᶜ

    xᶜ = 1 - xᶜ
    yᶜ = 1 - yᶜ

    kxy && (xᶜ = 1 - Y)
    kxy && (yᶜ = 1 - X)

    Z = ((xᶜ + im * yᶜ) / 2)^4
    W = W_Rancic(Z)

    im³ = im^(1/3)
    ra = √3 - 1
    cb = -1 + im
    cc = ra * cb / 2

    W = im³ * (W * im)^(1/3)
    W = (W - ra) / (cb + cc * W)
    X, Y = reim(W)

    H = 2 / (1 + X^2 + Y^2)
    X = X * H
    Y = Y * H
    Z = H - 1

    if kxy
        X, Y = Y, X
    end

    y < 0 && (Y = -Y)
    x < 0 && (X = -X)

    # Fix truncation for x = 0 or y = 0.
    x == 0 && (X = 0)
    y == 0 && (Y = 0)

    return X, Y, Z
end

W_Rancic(Z) = sum(A_Rancic[k] * Z^(k-1) for k in 1:length(A_Rancic))

function cubed_sphere_warp(
    a,
    b,
    c,
    R = max(abs(a), abs(b), abs(c)),
)

    # @show (a,b,c)
    fdim = argmax(abs.((a, b, c)))
    # @show fdim
    M = max(abs.((a, b, c))...)
    if fdim == 1 && a < 0
        # left face
        x1, x2, x3 = conformal_cubed_sphere_mapping(-b / M, c / M)
        x1, x2, x3 = RotX(π/2) * RotY(-π/2) * [x1, x2, x3]
    elseif fdim == 2 && b < 0
        # front face
        x1, x2, x3 = conformal_cubed_sphere_mapping(a / M, c / M)
        x1, x2, x3 = RotX(π/2) * [x1, x2, x3]
    elseif fdim == 1 && a > 0
        # right face
        x1, x2, x3 = conformal_cubed_sphere_mapping(b / M, c / M)
        x1, x2, x3 = RotX(π/2) * RotY(π/2) * [x1, x2, x3]
    elseif fdim == 2 && b > 0
        # back face
        x1, x2, x3 = conformal_cubed_sphere_mapping(a / M, -c / M)
        x1, x2, x3 = RotX(-π/2) * [x1, x2, x3]
    elseif fdim == 3 && c > 0
        # top face
        x1, x2, x3 = conformal_cubed_sphere_mapping(a / M, b / M)
    elseif fdim == 3 && c < 0
        # bottom face
        x1, x2, x3 = conformal_cubed_sphere_mapping(a / M, -b / M)
        x1, x2, x3 = RotX(π) * [x1, x2, x3]
    else
        error("invalid case for cubed_sphere_warp(::ConformalCubedSphere): $a, $b, $c")
    end

    return x1 * R, x2 * R, x3 * R

end

n = 6

r = range(-1,1,length=n+1)

xa = zeros(n+1,n+1)
xb = zeros(n+1,n+1)
xc = zeros(n+1,n+1)

# top face coordinates
xa .= r
xb .= r'
xc .= 1

a = [cubed_sphere_warp(a,b,c)[1] for (a,b,c) in zip(xa,xb,xc)]
b = [cubed_sphere_warp(a,b,c)[2] for (a,b,c) in zip(xa,xb,xc)]
c = [cubed_sphere_warp(a,b,c)[3] for (a,b,c) in zip(xa,xb,xc)]

sc = Scene(limits = HyperRectangle(Vec3f0(-2), Vec3f0(2)))

wireframe!(sc,
           a,b,c,
           show_axis=false,
           linewidth=1.2)
wireframe!(sc,
           a,b,-c,
           show_axis=false,
           linewidth=1.2)
wireframe!(sc,
           c,a,b,
           show_axis=false,
           linewidth=1.2)
wireframe!(sc,
           -c,a,b,
           show_axis=false,
           linewidth=1.2)
wireframe!(sc,
           b,c,a,
           show_axis=false,
           linewidth=1.2)
wireframe!(sc,
           b,-c,a,
           show_axis=false,
           linewidth=1.2)

sc


"""

## stability

Function spabac! performs Cholesky forward and back-substitution on
a symmetric skyline global matrix. The loads vector is updated.

###Arguments
```julia
stability(gsm, ggm, tol, limit)
```

### Arguments
```julia
* gsm::SparseMatrixCSC{Float64,Int}   : Factored global stiffness matrix
* ggm::SparseMatrixCSC{Float64,Int}   : Factored geometric matrix
* tol::Float64                          : Convergence tolerance
* limit::Int                          : Iteration limit
```
"""
function stability(gsm::SparseMatrixCSC{Float64,Int},
  ggm::SparseMatrixCSC{Float64,Int}, tol::Float64, limit::Int)
  #
  # This subroutine computes the smallest eigenvalue in a beam
  # stability analysis. This is the Julia version. Notice no !.
  #
  # Updateds iters, evec, ival
  #
  converged = true
  neq=size(gsm, 1)
  x0 = zeros(neq+1)
  x1 = zeros(neq+1)
  big = 0.0

  cfgsm = cholesky(gsm)

  iters = 0
  x0[2] = 1.0

  while true
   iters = iters+1
   x1[2:end] = ggm * x0[2:end]
   x1[2:end] = cfgsm \ x1[2:end]
   big = maximum(x1[2:end])
   if abs(minimum(x1[2:end])) > big
     big = minimum(x1[2:end])
   end
   x1 = x1 / big
   converged = (maximum(abs.(x1[2:end]-x0[2:end]))/maximum(abs.(x1[2:end])) < tol)
   x0 = copy(x1)
   if converged || iters==limit
     break
   end
  end
  x1[2:end]=x1[2:end] / sqrt(sum(x1[2:end] .^ 2))
  ival = 1.0 / big
  (iters, x1, ival)
end


# diff from CosSpace -> SinSpace

function cosspacediff(v::AbstractVector{T}) where T<:Number
    if length(v)==1
        w = zeros(T,1)
    else
        w = Array{T}(undef, length(v)-1)
        for k=1:length(v)-1
            @inbounds w[k] = -k*v[k+1]
        end
    end

    w
end

# diff from SinSpace -> CosSpace

function sinspacediff(v::AbstractVector{T}) where T<:Number
    w = Array{T}(undef, length(v)+1)
    w[1] = zero(T)
    for k=1:length(v)
        @inbounds w[k+1] = k*v[k]
    end

    w
end

# diff from Fourier -> Fourier

function fourierdiff(v::AbstractVector{T}) where T<:Number
    n = 2(length(v)÷2)+1
    w = Array{T}(undef, n)
    w[1] = zero(T)
    n > 1 && (w[n-1] = zero(T))
    for k=1:n÷2-1
        @inbounds w[2k] = -k*v[2k+1]
        @inbounds w[2k+1] = k*v[2k]
    end
    n > 1 && (w[n] = (n÷2)*v[n-1]; n == length(v) && (w[n-1] = -(n÷2)*v[n]))

    w
end

# diff from Taylor -> Taylor

function taylor_diff(v::AbstractVector{T}) where T<:Number
    w = Array{T}(undef, length(v))
    for k=1:length(v)
        @inbounds w[k] = (k-1)*v[k]
    end

    w
end

# diff from Hardy{false} -> Hardy{false}

function hardyfalse_diff(v::AbstractVector{T}) where T<:Number
    w = Array{T}(undef, length(v))
    for k=1:length(v)
        @inbounds w[k] = -k*v[k]
    end

    w
end

# diff from Laurent -> Laurent

function laurentdiff(v::AbstractVector{T}) where T<:Number
    n = length(v)
    w = Array{T}(undef, n)
    w[1] = zero(T)
    n=length(v)

    for k=1:(isodd(n) ? n÷2 : n÷2-1)
        @inbounds w[2k] = -k*v[2k]
        @inbounds w[2k+1] = k*v[2k+1]
    end

    if iseven(n)
        @inbounds w[n] = -(n÷2)*v[n]
    end

    w
end


using Knet, Base.Test

# x* = f(1, · · · , 1)
# f(x*) = 0

rosenbrock(x) = sum((1-x[1:end-1]).^2 + 100*(x[2:end]-x[1:end-1].^2).^2)

grads = grad(rosenbrock)
srand(123456789)

function test_base(w, params)
	prev = 0
	i = 1

	current = rosenbrock(w)
	while i <= 1000000 && abs(current - prev) > 1e-10 && current > 1e-3
		g = grads(w)
		w, params = update!(w, g, params)
		prev = current
		current = rosenbrock(w)

		i += 1
	end

	@test current <= 1e-3
	info("$(typeof(params)) Passed!\nConverged to $(current) at epoch $(i-1)")
end

function test_sgd(w)
	params = Sgd(;lr=0.0005)
	test_base(w, params)
end

function test_momentum(w)
	params = Momentum(w;lr=0.00005, gamma=0.95, velocity=zeros(w))
	test_base(w, params)
end

function test_adam(w)
	params = Adam(w; lr=0.005, beta1=0.9, beta2=0.95, t=1, eps=1e-8, fstm=zeros(w), scndm=zeros(w))
	test_base(w, params)
end

function test_adagrad(w)
	params = Adagrad(w; lr=0.35, eps=1e-6, G=zeros(w))
	test_base(w, params)
end

function test_adadelta(w)
	params = Adadelta(w; lr=0.001, rho=0.9, eps=1e-6, G=zeros(w), delta=zeros(w))
	test_base(w, params)
end

function test_rmsprop(w)
	params = Rmsprop(w; lr=0.0002, rho=0.9, eps=1e-6, G=zeros(w))
	test_base(w, params)
end

#GPU Tests
info("GPU Tests")
raw = randn(100, 1)
w = convert(KnetArray, raw)
@time test_sgd(copy(w))
@time test_momentum(copy(w))
@time test_adam(copy(w))
@time test_adagrad(copy(w))
@time test_adadelta(copy(w))
@time test_rmsprop(copy(w))

#CPU Tests
gpu(-1)
info("CPU Tests")
w = randn(100, 1)
@time test_sgd(copy(w))
@time test_momentum(copy(raw))
@time test_adam(copy(raw))
@time test_adagrad(copy(raw))
@time test_adadelta(copy(raw))
@time test_rmsprop(copy(raw))


# ============================================================
# Methods of Particle Velocity Space
# ============================================================

"""
    struct VSpace1D{TR<:Real,TI<:Integer,TA<:AbstractArray,TB<:AbstractArray{<:Real,1}} <: AbstractVelocitySpace
        u0::TR
        u1::TR
        nu::TI
        u::TA
        du::TA
        weights::TB
    end

1D velocity space

"""
struct VSpace1D{TR<:Real,TI<:Integer,TA<:AbstractArray,TB<:AbstractArray{<:Real,1}} <:
       AbstractVelocitySpace1D
    u0::TR
    u1::TR
    nu::TI
    u::TA
    du::TA
    weights::TB
end

function VSpace1D(
    U0,
    U1,
    NU::TI,
    TYPE = "rectangle",
    NG = zero(NU)::TI,
    PRECISION = Float64,
) where {TI<:Integer}

    δ = (U1 - U0) / NU
    u = OffsetArray{PRECISION}(undef, 1-NG:NU+NG)
    du = similar(u)
    weights = similar(u)

    if TYPE == "rectangle" # rectangular
        for i in eachindex(u)
            u[i] = U0 + (i - 0.5) * δ
            du[i] = δ
            weights[i] = δ
        end
    elseif TYPE == "newton" # newton-cotes
        for i in eachindex(u)
            u[i] = U0 + (i - 0.5) * δ
            du[i] = δ
            weights[i] = newton_cotes(i + NG, NU + NG * 2) * δ
        end
    elseif TYPE == "algebra" # algebraic
        _nu = NU + 1
        _u = [U1 / (_nu - 1)^3 * (-_nu + 1 + 2 * (i - 1))^3 for i = 1:_nu]
        u .= (_u[1:end-1] .+ _u[2:end]) ./ 2
        du .= _u[2:end] - _u[1:end-1]
        weights .= du
    else
        throw("No velocity quadrature available")
    end

    return VSpace1D{PRECISION,TI,typeof(u),typeof(weights)}(U0, U1, NU, u, du, weights)

end

VSpace1D() = VSpace1D(-5, 5, 50)
VSpace1D(U0::T, U1::T) where {T<:Real} = VSpace1D(U0, U1, 50)

"""
    struct VSpace2D{TR<:Real,TI<:Integer,TA<:AbstractArray{<:Real,2}} <: AbstractVelocitySpace
        u0::TR
        u1::TR
        nu::TI
        v0::TR
        v1::TR
        nv::TI
        u::TA
        v::TA
        du::TA
        dv::TA
        weights::TA
    end

2D velocity space

"""
struct VSpace2D{TR<:Real,TI<:Integer,TA<:AbstractArray{<:Real,2}} <: AbstractVelocitySpace2D
    u0::TR
    u1::TR
    nu::TI
    v0::TR
    v1::TR
    nv::TI
    u::TA
    v::TA
    du::TA
    dv::TA
    weights::TA
end

function VSpace2D(
    U0,
    U1,
    NU::TI,
    V0,
    V1,
    NV::TI,
    TYPE = "rectangle",
    NGU = zero(NU)::TI,
    NGV = zero(NV)::TI,
    PRECISION = Float64,
) where {TI<:Integer}

    δu = (U1 - U0) / NU
    δv = (V1 - V0) / NV
    u = OffsetArray{PRECISION}(undef, 1-NGU:NU+NGU, 1-NGV:NV+NGV)
    v = similar(u)
    du = similar(u)
    dv = similar(u)
    weights = similar(u)

    if TYPE == "rectangle" # rectangular
        for j in axes(u, 2)
            for i in axes(u, 1)
                u[i, j] = U0 + (i - 0.5) * δu
                v[i, j] = V0 + (j - 0.5) * δv
                du[i, j] = δu
                dv[i, j] = δv
                weights[i, j] = δu * δv
            end
        end
    elseif TYPE == "newton" # newton-cotes
        for j in axes(u, 2)
            for i in axes(u, 1)
                u[i, j] = U0 + (i - 0.5) * δu
                v[i, j] = V0 + (j - 0.5) * δv
                du[i, j] = δu
                dv[i, j] = δv
                weights[i, j] =
                    newton_cotes(i + NGU, NU + NGU * 2) *
                    δu *
                    newton_cotes(j + NGV, NV + NGV * 2) *
                    δv
            end
        end
    elseif TYPE == "algebra"
        _nu = NU + 1
        _nv = NV + 1
        _u = [U1 / (_nu - 1)^3 * (-_nu + 1 + 2 * (i - 1))^3 for i = 1:_nu]
        _v = [V1 / (_nv - 1)^3 * (-_nv + 1 + 2 * (j - 1))^3 for j = 1:_nv]
        __u = (_u[1:end-1] .+ _u[2:end]) ./ 2
        __v = (_v[1:end-1] .+ _v[2:end]) ./ 2
        u1, v1 = meshgrid(__u, __v)
        u .= u1 |> permutedims
        v .= v1 |> permutedims

        #_wx = [ 3.0 * (-_nu/2 + i - 0.5)^2 / (_nu/2 - 0.5)^3 for i = 1:_nu]
        #_wy = [ 3.0 * (-_nv/2 + j - 0.5)^2 / (_nv/2 - 0.5)^3 for j = 1:_nv]
        #wx = (_wx[1:end-1] .+ _wx[2:end]) ./ 2
        #wy = (_wy[1:end-1] .+ _wy[2:end]) ./ 2

        _du = _u[2:end] - _u[1:end-1]
        _dv = _v[2:end] - _v[1:end-1]
        du1, dv1 = meshgrid(_du, _dv)
        du .= du1 |> permutedims
        dv .= dv1 |> permutedims

        for j in axes(u, 2)
            for i in axes(u, 1)
                weights[i, j] = du[i, j] * dv[i, j]
                #weights[i, j] = wx[i] * wy[j]
            end
        end
    elseif TYPE == "maxwell"
        _u, _uw = maxwell_quadrature(NU, U1 / 5.76)
        _v, _vw = maxwell_quadrature(NV, V1 / 5.76)
        u1, v1 = meshgrid(_u, _v)
        u .= u1 |> permutedims
        v .= v1 |> permutedims
        for j in axes(weights, 2), i in axes(weights, 1)
            weights[i, j] = _uw[i] * _vw[j]
        end

        _du = zero(_u)
        for i in eachindex(_u)
            if i == 1
                _du[i] = _u[2] - _u[1]
            elseif i == length(_u)
                _du[i] = _u[end] - _u[end-1]
            else
                _du[i] = (_u[i+1] - _u[i-1]) / 2
            end
        end
        _dv = zero(_v)
        for i in eachindex(_v)
            if i == 1
                _dv[i] = _v[2] - _v[1]
            elseif i == length(_v)
                _dv[i] = _v[end] - _v[end-1]
            else
                _dv[i] = (_v[i+1] - _v[i-1]) / 2
            end
        end
        du1, dv1 = meshgrid(_du, _dv)
        du .= du1 |> permutedims
        dv .= dv1 |> permutedims
    else
        throw("No velocity quadrature available")
    end

    return VSpace2D{PRECISION,TI,typeof(u)}(U0, U1, NU, V0, V1, NV, u, v, du, dv, weights)

end

VSpace2D() = VSpace2D(-5, 5, 28, -5, 5, 28)
VSpace2D(U0::T, U1::T, V0::T, V1::T) where {T<:Real} = VSpace2D(U0, U1, 28, V0, V1, 28)

"""
    struct VSpace3D{TR<:Real,TI<:Integer,TA<:AbstractArray{<:Real,3}} <: AbstractVelocitySpace
        u0::TR
        u1::TR
        nu::TI
        v0::TR
        v1::TR
        nv::TI
        w0::TR
        w1::TR
        nw::TI
        u::TA
        v::TA
        w::TA
        du::TA
        dv::TA
        dw::TA
        weights::TA
    end

3D velocity space

"""
struct VSpace3D{TR<:Real,TI<:Integer,TA<:AbstractArray{<:Real,3}} <: AbstractVelocitySpace3D
    u0::TR
    u1::TR
    nu::TI
    v0::TR
    v1::TR
    nv::TI
    w0::TR
    w1::TR
    nw::TI
    u::TA
    v::TA
    w::TA
    du::TA
    dv::TA
    dw::TA
    weights::TA
end

function VSpace3D(
    U0,
    U1,
    NU::TI,
    V0,
    V1,
    NV::TI,
    W0,
    W1,
    NW::TI,
    TYPE = "rectangle",
    NGU = zero(NU)::TI,
    NGV = zero(NV)::TI,
    NGW = zero(NW)::TI,
    PRECISION = Float64,
) where {TI<:Integer}

    δu = (U1 - U0) / NU
    δv = (V1 - V0) / NV
    δw = (W1 - W0) / NW
    u = OffsetArray{PRECISION}(undef, 1-NGU:NU+NGU, 1-NGV:NV+NGV, 1-NGW:NW+NGW)
    v = similar(u)
    w = similar(u)
    du = similar(u)
    dv = similar(u)
    dw = similar(u)
    weights = similar(u)

    if TYPE == "rectangle" # rectangular
        for k in axes(u, 3), j in axes(u, 2), i in axes(u, 1)
            u[i, j, k] = U0 + (i - 0.5) * δu
            v[i, j, k] = V0 + (j - 0.5) * δv
            w[i, j, k] = W0 + (k - 0.5) * δw
            du[i, j, k] = δu
            dv[i, j, k] = δv
            dw[i, j, k] = δw
            weights[i, j, k] = δu * δv * δw
        end
    elseif TYPE == "newton" # newton-cotes
        for k in axes(u, 3), j in axes(u, 2), i in axes(u, 1)
            u[i, j, k] = U0 + (i - 0.5) * δu
            v[i, j, k] = V0 + (j - 0.5) * δv
            w[i, j, k] = W0 + (k - 0.5) * δw
            du[i, j, k] = δu
            dv[i, j, k] = δv
            dw[i, j, k] = δw
            weights[i, j, k] =
                newton_cotes(i + NGU, NU + NGU * 2) *
                δu *
                newton_cotes(j + NGV, NV + NGV * 2) *
                δv *
                newton_cotes(k + NGW, NW + NGW * 2) *
                δw
        end
    elseif TYPE == "algebra"
        _nu = NU + 1
        _nv = NV + 1
        _nw = NW + 1
        _u = [U1 / (_nu - 1)^3 * (-_nu + 1 + 2 * (i - 1))^3 for i = 1:_nu]
        _v = [V1 / (_nv - 1)^3 * (-_nv + 1 + 2 * (j - 1))^3 for j = 1:_nv]
        _w = [W1 / (_nw - 1)^3 * (-_nw + 1 + 2 * (k - 1))^3 for k = 1:_nw]
        __u = (_u[1:end-1] .+ _u[2:end]) ./ 2
        __v = (_v[1:end-1] .+ _v[2:end]) ./ 2
        __w = (_w[1:end-1] .+ _w[2:end]) ./ 2
        u1, v1, w1 = meshgrid(__u, __v, __w)
        u .= permutedims(u1, [3, 2, 1])
        v .= permutedims(v1, [3, 2, 1])
        w .= permutedims(w1, [3, 2, 1])

        _du = _u[2:end] - _u[1:end-1]
        _dv = _v[2:end] - _v[1:end-1]
        _dw = _w[2:end] - _w[1:end-1]
        du1, dv1, dw1 = meshgrid(_du, _dv, _dw)
        du .= permutedims(du1, [3, 2, 1])
        dv .= permutedims(dv1, [3, 2, 1])
        dw .= permutedims(dw1, [3, 2, 1])

        for k in axes(u, 3), j in axes(u, 2), i in axes(u, 1)
            weights[i, j, k] = du[i, j, k] * dv[i, j, k] * dw[i, j, k]
        end
    else
        throw("No velocity quadrature available")
    end

    return VSpace3D{PRECISION,TI,typeof(u)}(
        U0,
        U1,
        NU,
        V0,
        V1,
        NV,
        W0,
        W1,
        NW,
        u,
        v,
        w,
        du,
        dv,
        dw,
        weights,
    )

end

VSpace3D() = VSpace3D(-5, 5, 28, -5, 5, 28, -5, 5, 28)
VSpace3D(U0::T, U1::T, V0::T, V1::T, W0::T, W1::T) where {T<:Real} =
    VSpace3D(U0, U1, 28, V0, V1, 28, W0, W1, 28)

"""
    struct MVSpace1D{TR<:AbstractArray{<:Real,1},TI<:Integer,TA<:AbstractArray{<:Real,2}} <: AbstractVelocitySpace
        u0::TR
        u1::TR
        nu::TI
        u::TA
        du::TA
        weights::TA
    end

1D multi-component velocity space

"""
struct MVSpace1D{TR<:AbstractArray{<:Real,1},TI<:Integer,TA<:AbstractArray{<:Real,2}} <:
       AbstractVelocitySpace1D
    u0::TR
    u1::TR
    nu::TI
    u::TA
    du::TA
    weights::TA
end

function MVSpace1D(
    Ui0,
    Ui1,
    Ue0,
    Ue1,
    NU::TI,
    TYPE = "rectangle",
    NG = zero(NU)::TI,
    PRECISION = Float64,
) where {TI<:Integer}

    u0 = PRECISION.([Ui0, Ue0])
    u1 = PRECISION.([Ui1, Ue1])
    δ = (u1 .- u0) ./ NU
    u = OffsetArray{PRECISION}(undef, 1-NG:NU+NG, 1:2)
    du = similar(u)
    weights = similar(u)

    if TYPE == "rectangle" # rectangular
        for j in axes(u, 2), i in axes(u, 1)
            u[i, j] = u0[j] + (i - 0.5) * δ[j]
            du[i, j] = δ[j]
            weights[i, j] = δ[j]
        end
    elseif TYPE == "newton" # newton-cotes
        for j in axes(u, 2), i in axes(u, 1)
            u[i, j] = u0[j] + (i - 0.5) * δ[j]
            du[i, j] = δ[j]
            weights[i, j] = newton_cotes(i + NG, NU + NG * 2) * δ[j]
        end
    else
        throw("No velocity quadrature available")
    end

    return MVSpace1D{typeof(u0),TI,typeof(u)}(u0, u1, NU, u, du, weights)

end

MVSpace1D() = MVSpace1D(-5, 5, -10, 10, 28)
MVSpace1D(U0::T, U1::T, V0::T, V1::T) where {T<:Real} = MVSpace1D(U0, U1, V0, V1, 28)

"""
    struct MVSpace2D{TR<:AbstractArray{<:Real,1},TI<:Integer,TA<:AbstractArray{Float64,3}} <: AbstractVelocitySpace
        u0::TR
        u1::TR
        nu::TI
        v0::TR
        v1::TR
        nv::TI
        u::TA
        v::TA
        du::TA
        dv::TA
        weights::TA
    end

2D multi-component velocity space

"""
struct MVSpace2D{TR<:AbstractArray{<:Real,1},TI<:Integer,TA<:AbstractArray{Float64,3}} <:
       AbstractVelocitySpace2D
    u0::TR
    u1::TR
    nu::TI
    v0::TR
    v1::TR
    nv::TI
    u::TA
    v::TA
    du::TA
    dv::TA
    weights::TA
end

function MVSpace2D(
    Ui0,
    Ui1,
    Ue0,
    Ue1,
    NU::TI,
    Vi0,
    Vi1,
    Ve0,
    Ve1,
    NV::TI,
    TYPE = "rectangle",
    NGU = zero(NU)::TI,
    NGV = zero(NV)::TI,
    PRECISION = Float64,
) where {TI<:Integer}

    u0 = PRECISION.([Ui0, Ue0])
    u1 = PRECISION.([Ui1, Ue1])
    δu = (u1 .- u0) ./ NU
    v0 = PRECISION.([Vi0, Ve0])
    v1 = PRECISION.([Vi1, Ve1])
    δv = (v1 .- v0) ./ NV
    u = OffsetArray{PRECISION}(undef, 1-NGU:NU+NGU, 1-NGV:NV+NGV, 1:2)
    v = similar(u)
    du = similar(u)
    dv = similar(u)
    weights = similar(u)

    if TYPE == "rectangle" # rectangular
        for k in axes(u, 3), j in axes(u, 2), i in axes(u, 1)
            u[i, j, k] = u0[k] + (i - 0.5) * δu[k]
            v[i, j, k] = v0[k] + (j - 0.5) * δv[k]
            du[i, j, k] = δu[k]
            dv[i, j, k] = δv[k]
            weights[i, j, k] = δu[k] * δv[k]
        end
    elseif TYPE == "newton" # newton-cotes
        for k in axes(u, 3), j in axes(u, 2), i in axes(u, 1)
            u[i, j, k] = u0[k] + (i - 0.5) * δu[k]
            v[i, j, k] = v0[k] + (j - 0.5) * δv[k]
            du[i, j, k] = δu[k]
            dv[i, j, k] = δv[k]
            weights[i, j, k] =
                newton_cotes(i + NGU, NU + NGU * 2) *
                δu[k] *
                newton_cotes(j + NGV, NV + NGV * 2) *
                δv[k]
        end
    else
        throw("No velocity quadrature available")
    end

    return MVSpace2D{typeof(u0),TI,typeof(u)}(u0, u1, NU, v0, v1, NV, u, v, du, dv, weights)

end

MVSpace2D() = MVSpace2D(-5, 5, -10, 10, 28, -5, 5, -10, 10, 28)
MVSpace2D(U0::T, U1::T, V0::T, V1::T) where {T<:Real} =
    MVSpace2D(U0, U1, U0, U1, 28, V0, V1, V0, V1, 28)

"""
    struct MVSpace3D{TR<:AbstractArray{<:Real,1},TI<:Integer,TA<:AbstractArray{<:Real,4}} <: AbstractVelocitySpace
        u0::TR
        u1::TR
        nu::TI
        v0::TR
        v1::TR
        nv::TI
        w0::TR
        w1::TR
        nw::TI
        u::TA
        v::TA
        w::TA
        du::TA
        dv::TA
        dw::TA
        weights::TA
    end

3D multi-component velocity space

"""
struct MVSpace3D{TR<:AbstractArray{<:Real,1},TI<:Integer,TA<:AbstractArray{<:Real,4}} <:
       AbstractVelocitySpace3D
    u0::TR
    u1::TR
    nu::TI
    v0::TR
    v1::TR
    nv::TI
    w0::TR
    w1::TR
    nw::TI
    u::TA
    v::TA
    w::TA
    du::TA
    dv::TA
    dw::TA
    weights::TA
end

function MVSpace3D(
    Ui0,
    Ui1,
    Ue0,
    Ue1,
    NU::TI,
    Vi0,
    Vi1,
    Ve0,
    Ve1,
    NV::TI,
    Wi0,
    Wi1,
    We0,
    We1,
    NW::TI,
    TYPE = "rectangle",
    NGU = zero(NU)::TI,
    NGV = zero(NV)::TI,
    NGW = zero(NW)::TI,
    PRECISION = Float64,
) where {TI<:Integer}

    u0 = PRECISION.([Ui0, Ue0])
    u1 = PRECISION.([Ui1, Ue1])
    δu = (u1 .- u0) ./ NU
    v0 = PRECISION.([Vi0, Ve0])
    v1 = PRECISION.([Vi1, Ve1])
    δv = (v1 .- v0) ./ NV
    w0 = PRECISION.([Wi0, We0])
    w1 = PRECISION.([Wi1, We1])
    δw = (w1 .- w0) ./ NW

    u = OffsetArray{PRECISION}(undef, 1-NGU:NU+NGU, 1-NGV:NV+NGV, 1-NGW:NW+NGW, 1:2)
    v = similar(u)
    w = similar(u)
    du = similar(u)
    dv = similar(u)
    dw = similar(u)
    weights = similar(u)

    if TYPE == "rectangle" # rectangular
        for l in axes(u, 4), k in axes(u, 3), j in axes(u, 2), i in axes(u, 1)
            u[i, j, k, l] = u0[l] + (i - 0.5) * δu[l]
            v[i, j, k, l] = v0[l] + (j - 0.5) * δv[l]
            w[i, j, k, l] = w0[l] + (k - 0.5) * δw[l]
            du[i, j, k, l] = δu[l]
            dv[i, j, k, l] = δv[l]
            dw[i, j, k, l] = δw[l]
            weights[i, j, k, l] = δu[l] * δv[l] * δw[l]
        end
    elseif TYPE == "newton" # newton-cotes
        for l in axes(u, 4), k in axes(u, 3), j in axes(u, 2), i in axes(u, 1)
            u[i, j, k, l] = u0[l] + (i - 0.5) * δu[l]
            v[i, j, k, l] = v0[l] + (j - 0.5) * δv[l]
            w[i, j, k, l] = w0[l] + (k - 0.5) * δw[l]
            du[i, j, k, l] = δu[l]
            dv[i, j, k, l] = δv[l]
            dw[i, j, k, l] = δw[l]
            weights[i, j, k, l] =
                newton_cotes(i + NGU, NU + NGU * 2) *
                δu[l] *
                newton_cotes(j + NGV, NV + NGV * 2) *
                δv[l] *
                newton_cotes(k + NGW, NW + NGW * 2) *
                δw[l]
        end
    else
        throw("No velocity quadrature available")
    end

    return MVSpace3D{typeof(u0),TI,typeof(u)}(
        u0,
        u1,
        NU,
        v0,
        v1,
        NV,
        w0,
        w1,
        NW,
        u,
        v,
        v,
        du,
        dv,
        dw,
        weights,
    )

end

MVSpace3D() = MVSpace3D(-5, 5, -10, 10, 20, -5, 5, -10, 10, 20, -5, 5, -10, 10, 20)
MVSpace3D(U0::T, U1::T, V0::T, V1::T, W0::T, W1::T) where {T<:Real} =
    MVSpace3D(U0, U1, U0, U1, 20, V0, V1, V0, V1, 20, W0, W1, W0, W1, 20)

"""
    struct UnstructVSpace{TR<:Real,TI<:Integer,TA<:AbstractArray,TB<:AbstractArray{<:Real,1}} <: AbstractVelocitySpace
        u0::TR
        u1::TR
        nu::TI
        u::TA
        weights::TB
    end

Unstructured velocity space

"""
struct UnstructVSpace{
    TR<:Union{Real,AbstractVector},
    TI<:Union{Integer,AbstractVector},
    TA<:AbstractArray,
    TB<:AbstractVector{<:Real},
} <: AbstractVelocitySpace
    u0::TR
    u1::TR
    nu::TI
    u::TA
    weights::TB
end

"""
    newton_cotes(idx::T, num::T) where {T<:Integer}

Evaluate quadrature weight from Newton-Cotes rule
"""
function newton_cotes(idx::T, num::T) where {T<:Integer}
    if idx == 1 || idx == num
        nc_coeff = 14.0 / 45.0
    elseif (idx - 5) % 4 == 0
        nc_coeff = 28.0 / 45.0
    elseif (idx - 3) % 4 == 0
        nc_coeff = 24.0 / 45.0
    else
        nc_coeff = 64.0 / 45.0
    end

    return nc_coeff
end

# ------------------------------------------------------------
# Extended Base.show()
# ------------------------------------------------------------
function Base.show(io::IO, vs::VSpace1D{TR,TI,TA,TB}) where {TR,TI,TA,TB}
    print(
        io,
        "VelocitySpace1D{$TR,$TI,$TA,$TB}\n",
        "domain: ($(vs.u0),$(vs.u1))\n",
        "resolution: $(vs.nu)\n",
        "ghost: $(1-firstindex(vs.u))\n",
    )
end

function Base.show(io::IO, vs::VSpace2D{TR,TI,TA}) where {TR,TI,TA}
    print(
        io,
        "VelocitySpace2D{$TR,$TI,$TA}\n",
        "domain: ($(vs.u0),$(vs.u1)) × ($(vs.v0),$(vs.v1))\n",
        "resolution: $(vs.nu) × $(vs.nv)\n",
        "ghost in u: $(1-firstindex(vs.u[:, 1]))\n",
        "ghost in v: $(1-firstindex(vs.v[1, :]))\n",
    )
end

function Base.show(io::IO, vs::VSpace3D{TR,TI,TA}) where {TR,TI,TA}
    print(
        io,
        "VelocitySpace3D{$TR,$TI,$TA}\n",
        "domain: ($(vs.u0),$(vs.u1)) × ($(vs.v0),$(vs.v1)) × ($(vs.w0),$(vs.w1))\n",
        "resolution: $(vs.nu) × $(vs.nv) × $(vs.nw)\n",
        "ghost in u: $(1-firstindex(vs.u[:, 1, 1]))\n",
        "ghost in v: $(1-firstindex(vs.v[1, :, 1]))\n",
        "ghost in w: $(1-firstindex(vs.w[1, 1, :]))\n",
    )
end

function maxwell_quadrature(N::Integer, C = 1::Real)
    @assert N <= 33

    py"""
    import numpy as np
    from numpy import linalg as LA

    def dvGH(N2,C):
        N = N2//2

        a = np.zeros(N)
        b = np.zeros(N)
        a[0] = 1.0/np.sqrt(np.pi)
        a[1] = 2.0/np.sqrt(np.pi)/(np.pi-2.0)
        b[1] = a[0]/( a[0] + a[1])/2.0

        for i in range(2,N):
            b[i] = (i-1)+1.0/2.0-b[i-1]-a[i-1]**2
            a[i] = (i**2/4.0/b[i]-b[i-1]-1.0/2)/a[i-1]-a[i-1]

        J = np.diag(a) + np.diag(np.sqrt(b[1:N]),1) \
        + np.diag(np.sqrt(b[1:N]),-1)

        v,V = LA.eig(J)

        w = V[0,:]*V[0,:]*np.sqrt(np.pi)/2.0

        vw = np.transpose(np.vstack((v,w)))
        vw = vw[vw[:,0].argsort()]
        v = vw[:,0]
        w = vw[:,1]

        Xis = np.hstack((-np.flipud(v),v))
        weights = np.hstack((np.flipud(w),w))
        weights = weights*np.exp(Xis**2)*C
        Xis = Xis*C
        return (Xis, weights)
    """

    p, w = py"dvGH"(N, C)
end


module Day5

parseint(s) = parse(Int, s, base=10)

point_pairs(input::String) = begin
    lines = split(input, "\n")
    result = []
    for line in lines
        if isempty(line)
            continue
        end
        first, second = split(line, " -> ")
        a1, b1 = map(parseint, split(first, ","))
        a2, b2 = map(parseint, split(second, ","))
        push!(result, ((a1, b1), (a2, b2)))
    end
    result
end

maxima(point_pairs::Vector) = begin
    x_max = y_max = -1
    for pair in point_pairs
        first, second = pair
        a1, b1 = first
        a2, b2 = second
        x_max = max(x_max, a1, a2)
        y_max = max(y_max, b1, b2)
    end
    return (x_max, y_max)
end

score_point_pair!(array::Matrix{Int}, point_pair; orthogonal_only=true) = begin
    first, second = point_pair
    x1, y1 = first
    x2, y2 = second
    len = max(abs(x2 - x1), abs(y2 - y1))
    xinc = (x2 - x1) ÷ len
    yinc = (y2 - y1) ÷ len

    if orthogonal_only && (xinc != 0 && yinc != 0)
        return
    end

    x = x1 + 1
    y = y1 + 1
    for i in 0:len
        array[y, x] += 1
        x += xinc
        y += yinc
    end
end

dopart(input; orthogonal_only) = begin
    pairs = point_pairs(input)
    cols, rows = maxima(pairs)
    A = zeros(Int, cols+2, rows+2)
    for pair in pairs
        score_point_pair!(A, pair, orthogonal_only=orthogonal_only)
    end
    return sum(A .≥ 2)
end

part1(input) = begin
    dopart(input, orthogonal_only=true)
end

part2(input) = begin
    dopart(input, orthogonal_only=false)
end

test = """
0,9 -> 5,9
8,0 -> 0,8
9,4 -> 3,4
2,2 -> 2,1
7,0 -> 7,4
6,4 -> 2,0
0,9 -> 2,9
3,4 -> 1,4
0,0 -> 8,8
5,5 -> 8,2
"""

@assert part1(test) == 5
@assert part2(test) == 12
input = read("resources/day5_input.txt", String)
part1(input) |> display
part2(input) |> display

end


@inline function apply_nonlinearity(x::Real,::NLRelu)
  return max(x,0.0)
end
struct NLRectifiedQuadratic <: AbstractNonlinearity end
@inline function apply_nonlinearity(x::R,::NLRectifiedQuadratic) where R<:Real
  if x <= 0.0
    return 0.0
  else
    return x*x
  end
end


export Curve

struct IntervalCurve{S<:Space,T,VT} <: SegmentDomain{T}
    curve::Fun{S,T,VT}
end

struct PeriodicCurve{S<:Space,T,VT} <: PeriodicDomain{T}
    curve::Fun{S,T,VT}
end

"""
`Curve` Represents a domain defined by the image of a Fun.  Example
usage would be

```julia
x=Fun(1..2)
Curve(exp(im*x))  # represents an arc
```
"""
const Curve{S,T} = Union{IntervalCurve{S,T},PeriodicCurve{S,T}}

==(a::Curve, b::Curve) = a.curve == b.curve
isempty(::Curve) = false

for TYP in (:IntervalCurve,:PeriodicCurve)
    @eval points(c::$TYP,n::Integer) = c.curve.(points(domain(c.curve),n))
end

checkpoints(d::Curve) = fromcanonical.(Ref(d),checkpoints(domain(d.curve)))

for op in (:(leftendpoint),:(rightendpoint),:(rand))
    @eval $op(c::Curve)=c.curve($op(domain(c.curve)))
end

canonicaldomain(c::Curve) = domain(c.curve)

fromcanonical(c::Curve{S,T},x) where {S<:Space,T<:Number} = c.curve(x)
function tocanonical(c::Curve,x)
    rts=roots(c.curve-x)
    @assert length(rts)==1
    first(rts)
end

fromcanonicalD(c::Curve,x)=differentiate(c.curve)(x)

function indomain(x,c::Curve)
    rts=roots(c.curve-x)
    if length(rts) ≠ 1
        false
    else
        in(first(rts),canonicaldomain(c))
    end
end

reverseorientation(d::IntervalCurve) = IntervalCurve(reverseorientation(d.curve))
reverseorientation(d::PeriodicCurve) = PeriodicCurve(reverseorientation(d.curve))

isambiguous(d::Curve) = ncoefficients(d.curve)==0 && isambiguous(domain(d.curve))
convert(::Type{IntervalCurve{S,T}},::AnyDomain) where {S,T}=Fun(S(AnyDomain()),[NaN])
convert(::Type{PeriodicCurve{S,T}},::AnyDomain) where {S,T}=Fun(S(AnyDomain()),[NaN])

arclength(d::Curve) = linesum(ones(d))


# # Wiring Diagrams as Attributed C-Sets
# Catlab supports many different flavors of diagrammatic syntax. These support the different combinatorial data structures that we use for representing categorical constructions. We will discuss DirectedWiringDiagrams, UndirectedWiringDiagrams, and CPortGraphs in this document.
using Catlab, Catlab.Theories
using Catlab.CategoricalAlgebra
using Catlab.WiringDiagrams
using Catlab.Graphics
using Catlab.Graphics.Graphviz
using Catlab.Programs
using Catlab.WiringDiagrams

draw(d::WiringDiagram) = to_graphviz(d,
  orientation=LeftToRight,
  labels=true, label_attr=:xlabel,
  node_attrs=Graphviz.Attributes(
    :fontname => "Courier",
  ),
  edge_attrs=Graphviz.Attributes(
    :fontname => "Courier",
  )
)

draw(uwd::AbstractUWD) = to_graphviz(uwd, junction_labels=:variable, box_labels=:name)

# ## Directed Wiring Diagrams

# DWDs are used to represent the morphisms in a symmetric monoidal category. You can get started by presenting a `FreeSymmetricMonoidalCategory` with the `@present` macro.
@present P(FreeSymmetricMonoidalCategory) begin
  (A,B,C,D)::Ob
  f::Hom(A,B)
  g::Hom(B,A)
  h::Hom(A⊗B, C)
  k::Hom(C,D⊗A)
end
generators(P)

# These presentations are very syntactic objects and expose an API for manipulating expressions.
for g in generators(P)
  "$g is a $(gat_typeof(g)) with arguments $(gat_type_args(g))"
end

# The `gat_typeof` function computes the algebraic type of a term by analogy to `Base.typeof` which computes the Julia type of a value.

homs_P = filter(generators(P)) do g
  gat_typeof(g) == :Hom
end

# When the term is a Hom, you can get the domain and codomain of the morphism with the `dom` and `codom` functions.
map(homs_P) do f
  "$f: $(dom(f)) → $(codom(f))"
end

# With the presentation you can build up morphism expressions using a formula syntax.
P[:h]⋅P[:k]

# This syntactic API is useful for manipulating terms in an arbitrary GAT and is the formal language of Catlab for representing and manipulating algebraic structures.
# However, when we want to work with big expressions in an SMC, the tree structure inherent to formulas is too verbose, and we want to move to a port-graph structure called `DirectedWiringDiagrams`. This gives us the benefits of combinatorial data structures like graphs with the right expressional power for representing the morphisms in an SMC.
wd = @program P (a::A, b::B) begin
  c = h(a,b)
  return k(c)
end

draw(wd)

# Catlab gives you the tools for drawing wiring diagrams. Visualization of wiring diagrams is the oldest part of Catlab and the original motivation for its development. The `@program` macro allows you to define wiring diagrams using a syntax that feels like Julia code.
wd = @program P (a::A, b::B) begin
  c = h(a,b)
  d,a₁ = k(c)
  return d, f(a₁)
end
draw(wd)

# The input wires are declared as *arguments* to the program, and the output wires are declared as *returns* from the function. Variables that are not consumed or by another function or returned by the program are automatically dropped.
wd = @program P (a::A, b::B) begin
  c = h(a,b)
  d,a₁ = k(c)
  return f(a₁)
end
draw(wd)

# You can copy a value by using it more than once. This is visualized as a wire being split into two wires.
wd = @program P (b::B) begin
  h(g(b),b)
end
draw(wd)

# You can visualize the copy and delete morphisms explicitly with the `add_junctions` function. The dots with one wire input and multiple outputs are copying values and dots with no wires out are deletions (discarding values). Not all instances of a `SymmetricMonoidalCategory` support copy and delete, for example, in manufacturing you can't duplicate a resource, and in chemistry you can't discard species. Catlab would enforce that when you tried to interpret the wiring diagram in a specific SMC.
wd = @program P (b::B) begin
  c = h(g(b),b)
  d, a₁ = k(c)
  return f(a₁)
end
draw(add_junctions(wd))

# For more details about working with wiring diagrams in Catlab, you should look at the other vignettes in this section which explain how wiring diagrams interact with SMC expressions and the basics of constructing and manipulation wiring diagrams.

# ## Diagrams as C-Sets

# The underlying data of a wiring diagram is combinatorial. That means we can represent it as a C-Set
wd.diagram

# Ok, there is a lot in there. The columns with integer entries are the combinatorial data encoding the connectivity of the wiring diagram. The columns with Symbols in them are encoding the labels for the diagram, the `value` of a box is the content of the box. Ports have types and wires have values. When we define the wiring diagram with the `@program` macro, we get a diagram that has labels and types, but no values. These values are initialized to nothing, but could be filled with values to be carried down the wires in an application.

# The schema of for wiring diagrams is called TheoryAttributedWiringDiagrams and is a little overwhelming, so we can explore how to build it up with C-Set schema inheritance.
to_graphviz(WiringDiagrams.DirectedWiringDiagrams.TheoryAttributedWiringDiagram)

# From the file Catlab/src/WiringDiagrams/Directed.jl
# ```julia
# @present TheoryWiringDiagram(FreeSchema) begin
#   Box::Ob
#   (InPort, OutPort, OuterInPort, OuterOutPort)::Ob
#   (Wire, InWire, OutWire, PassWire)::Ob

#   src::Hom(Wire, OutPort)
#   tgt::Hom(Wire, InPort)
#   in_src::Hom(InWire, OuterInPort)
#   in_tgt::Hom(InWire, InPort)
#   out_src::Hom(OutWire, OutPort)
#   out_tgt::Hom(OutWire, OuterOutPort)
#   pass_src::Hom(PassWire, OuterInPort)
#   pass_tgt::Hom(PassWire, OuterOutPort)

#   in_port_box::Hom(InPort, Box)
#   out_port_box::Hom(OutPort, Box)
# end

# @abstract_acset_type AbstractWiringDiagram <: AbstractGraph

# @present TheoryTypedWiringDiagram <: TheoryWiringDiagram begin
#   PortValue::AttrType
#   in_port_type::Attr(InPort, PortValue)
#   out_port_type::Attr(OutPort, PortValue)
#   outer_in_port_type::Attr(OuterInPort, PortValue)
#   outer_out_port_type::Attr(OuterOutPort, PortValue)
# end

# @present TheoryAttributedWiringDiagram <: TheoryTypedWiringDiagram begin
#   WireValue::AttrType
#   BoxValue::AttrType
#   BoxType::AttrType

#   value::Attr(Box, BoxValue)
#   box_type::Attr(Box, BoxType)
#   wire_value::Attr(Wire, WireValue)
#   in_wire_value::Attr(InWire, WireValue)
#   out_wire_value::Attr(OutWire, WireValue)
#   pass_wire_value::Attr(PassWire, WireValue)
# end
# ```

# The bare minimum diagram language is:
to_graphviz(WiringDiagrams.DirectedWiringDiagrams.TheoryWiringDiagram)

# And then you can add back in the types.
to_graphviz(WiringDiagrams.DirectedWiringDiagrams.TheoryTypedWiringDiagram)

#Layout is hard, so if you want to understand the `TheoryAttributedWiringDiagrams`, you should do the layout by hand as an exercise.

# We can create our own version of the theory of DWDs to see how it works:
@present MyTheoryWiringDiagram(FreeSchema) begin
  Box::Ob
  (InPort, OutPort, OuterInPort, OuterOutPort)::Ob
  (Wire, InWire, OutWire, PassWire)::Ob

  src::Hom(Wire, OutPort)
  tgt::Hom(Wire, InPort)
  in_src::Hom(InWire, OuterInPort)
  in_tgt::Hom(InWire, InPort)
  out_src::Hom(OutWire, OutPort)
  out_tgt::Hom(OutWire, OuterOutPort)
  pass_src::Hom(PassWire, OuterInPort)
  pass_tgt::Hom(PassWire, OuterOutPort)

  in_port_box::Hom(InPort, Box)
  out_port_box::Hom(OutPort, Box)
end

# If your application of wiring diagrams needs to attach numeric or textual information to the boxes of a wiring diagram, you would extend the `TheoryWiringDiagram` with the attributes that you need. That will give you a custom data structure that has those fields. One of the goals of Catlab is to make it so much easier to generate custom data structures that interoperate, that you don't need to create generic structures that can be used for many purposes. Just snap your fingers and create a new structure perfectly tailored to your needs, when your needs change, snap again to get a new version of that structure.

# The `@acset_type` macro does the hard work of generating the data structure and accessors and mutators for you. The form of this call is `@acset_type NewStructName(Schema, index=[morphisms in Schema]) <: Supertype`. You should index any morphism where you need to use `incident` frequently. For wiring diagrams you will often want to know what all the wires that are incident to a port.
@acset_type MyWiringDiagramACSet(MyTheoryWiringDiagram,
  index=[:src, :tgt, :in_src, :in_tgt, :out_src, :out_tgt, :pass_src, :pass_tgt]) <: WiringDiagrams.DirectedWiringDiagrams.AbstractWiringDiagram

# We get the `@acset` macro from Catlab and can create DWDs by hand. It is very tedious, which is why the `@program` macro exists!
md = @acset MyWiringDiagramACSet begin
  Box = 3
  InPort = 6
  OutPort = 3
  Wire = 3
  src = [1,2,3]
  tgt = [3,4,5]
  in_port_box = [1,1,2,2,3,3]
  out_port_box = [1,2,3]
end

# ## Undirected Wiring Diagrams
# A much simpler structure than DWDs are known as undirected wiring diagrams. They are called undirected because ports boxes have one set of ports that aren't divided into inputs and outputs, and the wires are undirected. Wires connect junctions to ports (which live on boxes).
to_graphviz(WiringDiagrams.UndirectedWiringDiagrams.TheoryUWD)

# These UWDs are combinatorial syntax for relations. The junctions are variables and the boxes are the relations. A relation R ⊆ X × Y has two ports one for the value of X and one for the value of Y. The expression R(x:X, y:Y) says to connect the X port of R to the junction for the variable x, and the Y port of R to the y variable junction. If two ports are attached to the same junction, then you have a constraint that those values must be equal. The outer ports are the components of the final relation. For example the following UWD encodes the relation {(x,y,z) | R(x,y) and S(y,z) for all x∈X, y∈Y, z∈Z}.
uwd = @relation (x, y, z) begin
  R(x,y)
  S(y,z)
end

# These UWDs are drawn with circular boxes and undirected wires. Note that since all wires go from junction to port, they are not *symmetric* wires.
draw(uwd)

# By adding more relations we can get bigger relations.
uwd₂ = @relation (x, z) begin
  R(x,y)
  S(y,z)
  T(x,z,y)
end

# Not all of the junctions have to be exposed to the outside world. Note that there is no distinction between arguments and return values in the relation macro. This is because relations are inherently undirected, unlike functions.
draw(uwd₂)

# ## Circular Port Graphs
# CPGs are the natural data structure for representing process of interconnected systems that share information along wires, but send different information to their different neighbors.
to_graphviz(ThCPortGraph)

# They are also a kind of CSet, so we can use the `@acset` macro to construct them.
cpg = @acset CPortGraph begin
  Box = 3
  Port = 6
  Wire = 5

  box = [1,1,2,2,3,3]
  src = [1,2,5,2,6]
  tgt = [3,4,2,4,1]
end

# the layout for CPGs is not great with graphviz.
to_graphviz(cpg, port_labels=true, graph_attrs=Dict("nodesep"=>"2", "ranksep"=>"2"))

# Almost every application of graphs in computer science could be better served by using one of these extensions to the basic graph data structure.


module GraphModels
using LightGraphs

using SemanticModels.ModelTools
using SemanticModels.ModelTools.CategoryTheory
import SemanticModels.ModelTools.CategoryTheory: ⊔, FinSetMorph, dom, codom, func
import SemanticModels.ModelTools: model
export GraphModel, model, ⊔, GraphMorph, dom, codom, func, verify

struct GraphModel <: AbstractModel
  model::AbstractGraph
end

function model(::Type{GraphModel}, g::AbstractGraph)
    return GraphModel(g)
end

⊔(g::GraphModel, h::GraphModel) = GraphModel(blockdiag(g.model,h.model))

function (f::FinSetMorph)(gModel::G) where G <: GraphModel
    g = gModel.model
    dom(f) == vertices(g) || throw(DomainError(vertices(g), "dom(f) = $(dom(f)) but nv(g) = $(nv(g))"))
    ϕ = func(f)
    GraphModel(map(edges(g)) do e
        s,t = e.src, e.dst
        LightGraphs.Edge(ϕ(s), ϕ(t))
      end |> Graph)
end

"""    GraphMorph{T,F} <: Morph

morphisms in the category of Finite Graphs. The objects must be a subtype of AbstractGraph.

You can take a `FinSetMorph` and lift it to a graph homomorphism. This is the functor that
takes the finite set `1:n`, to the empty graph with `n` vertices.

"""
struct GraphMorph{T, F} <: AbstractMorph
    dom::T
    codom::T
    fun::F
end

"""    GraphMorph(g::AbstractGraph, f::FinSetMorph)

is defined to be the graph homomorphism you get by functorially lifting `f`.
That is, `f` acts on the vertex set of `g` as an `Int->Int` function, and then
must act on the edges consistently.
"""
GraphMorph(g::GraphModel, f::FinSetMorph) = GraphMorph(g, f(g), f)

dom(m::GraphMorph) = m.dom
codom(m::GraphMorph) = m.codom
func(m::GraphMorph) = begin
    f = func(m.fun)
    return i->f(i)
end

"""    verify(m::GraphMorph)

validate a graph homomorphism by checking that all the edges in `dom(m)` and map to edges in `codom(m)`.
"""
verify(m::GraphMorph) = begin
    dom(m.fun) == vertices(dom(m)) || return false
    codom(m.fun) == vertices(codom(m)) || return false
    E = Set(edges(codom(m)))
    f = func(m)
    map(edges(dom(m))) do e
        u,v = f(e.src), f(e.dst)
        if u > v
            u,v = v,u
        end
        LightGraphs.Edge(u,v) in E
    end |> all
end

end


@doc raw"""
    TranslationAction(
        M::Manifold,
        Rn::TranslationGroup,
        AD::ActionDirection = LeftAction(),
    )

Space of actions of the [`TranslationGroup`](@ref) $\mathrm{T}(n)$ on a Euclidean-like
manifold `M`.

The left and right actions are equivalent.
"""
struct TranslationAction{TM<:Manifold,TRn<:TranslationGroup,TAD<:ActionDirection} <:
       AbstractGroupAction{TAD}
    manifold::TM
    Rn::TRn
end

function TranslationAction(
    M::Manifold,
    Rn::TranslationGroup,
    ::TAD = LeftAction(),
) where {TAD<:ActionDirection}
    return TranslationAction{typeof(M),typeof(Rn),TAD}(M, Rn)
end

function show(io::IO, A::TranslationAction)
    print(io, "TranslationAction($(A.manifold), $(A.Rn), $(direction(A)))")
end

base_group(A::TranslationAction) = A.Rn

g_manifold(A::TranslationAction) = A.manifold

function switch_direction(A::TranslationAction{TM,TRN,TAD}) where {TM,TRN,TAD}
    return TranslationAction(A.manifold, A.Rn, switch_direction(TAD()))
end

apply(A::TranslationAction, a, p) = p + a

apply!(A::TranslationAction{M,G}, q, a, p) where {M,G} = (q .= p .+ a)
apply!(A::TranslationAction{M,G}, q, e::Identity{G}, p) where {M,G} = copyto!(q, p)

inverse_apply(A::TranslationAction, a, p) = p - a

inverse_apply!(A::TranslationAction{M,G}, q, a, p) where {M,G} = (q .= p .- a)
inverse_apply!(A::TranslationAction{M,G}, q, e::Identity{G}, p) where {M,G} = copyto!(q, p)

apply_diff(A::TranslationAction, a, p, X) = X

apply_diff!(A::TranslationAction, Y, a, p, X) = copyto!(Y, X)

inverse_apply_diff(A::TranslationAction, a, p, X) = X

inverse_apply_diff!(A::TranslationAction, Y, a, p, X) = copyto!(Y, X)


function SINDYPI(X, DX, Polyorder, Trigorder)
    s = []
    for i = 1:1:size(X,2)
        push!(s, string("x", string(i)))
    end

    number_states_guess = size(X, 2)

    Training_frac = 0.5

    λ_span = (0.1,0.1)
    datasize = 1
    λ = range(λ_span[1], λ_span[2], length = datasize)

    Store_Result = Array{Any}(undef,length(λ), number_states_guess)
    Index_nonzero = Array{Any}(undef,length(λ), number_states_guess)

    Error = zeros(length(λ) , number_states_guess)

    Xi = Array{Any}(undef,length(λ), number_states_guess)

    X_train = X[1:Int(floor(Training_frac*size(X,1))),:]
    DX_train = DX[1:Int(floor(Training_frac*size(DX,1))),:]

    X_test = X[Int(floor(Training_frac*size(X,1)))+1:end,:]
    DX_test = DX[Int(floor(Training_frac*size(DX,1)))+1:end,:]

    for w = 1:number_states_guess
    for i = 1:datasize
    Basis_train = Basis_SINDY_PI(X_train, DX_train, Polyorder[w], Trigorder[w], w)

    Left_train = Basis_train[2]
    Right_train = Basis_train[1]

    Xi[i,w] = Sparse_matrix_SINDYPI(Right_train,Left_train, λ[i], 1, 10)

    String_table= Table_SINDY_PI(s, Xi[i,w], Polyorder[w], Trigorder[w], w)

    Store_Result[i, w] = String_table

    Index_nonzero[i,w] = findall(x->x !=0, Store_Result[i, w][:,2])

    Basis_test =  Basis_SINDY_PI(X_test, DX_test, Polyorder[w], Trigorder[w], w)

    Left_test = Basis_test[2]
    Right_test = Basis_test[1]

    Error[i,w] = norm(Left_test - Right_test[:, Index_nonzero[i,w]] * Xi[i,w][Index_nonzero[i,w]])

    end

    Ind_min = argmin(Error[:, w])

    ODE_Index = Index_nonzero[Ind_min, w]

    ODE_Strings = Store_Result[Ind_min, w][:,1][ODE_Index]

    ODE_values = Xi[Ind_min,w][ODE_Index]

    ODE_Print = []
    push!(ODE_Print, "dot", s[w])
    push!(ODE_Print, "", "=")

    global count = 0
    for i = 1:length(ODE_Strings)
        global count
     if count >0
        if string(round(ODE_values[i]))[1] == '-'
            pop!(ODE_Print)
        end
      end

        push!(ODE_Print, string(string(round(ODE_values[i], digits = 2)), ODE_Strings[i]))
        push!(ODE_Print, "", "+")

        count += 1
    end

    pop!(ODE_Print)

    ODE_Print = join(ODE_Print)

    println("The differential equation for ", s[w], " is"  )

    println(ODE_Print)
    end

end


function triple(::Type{T}, x::BigFloat) where {T<:IEEEFloat}
    prec = precision(BigFloat)
    setprecision(BigFloat, 768)
    hi = T(x)
    md = T(x - hi)
    lo = T(x - hi - md)
    setprecision(BigFloat, prec)
    return hi, md, lo
end

function triple(::Type{T}, x::String) where {T<:IEEEFloat}
    prec = precision(BigFloat)
    setprecision(BigFloat, 768)
    z = parse(BigFloat, x)
    hi = T(z)
    md = T(z - hi)
    lo = T(z - hi - md)
    setprecision(BigFloat, prec)
    return hi,md,lo
end

triple64(x::BigFloat) = triple(Float64, x)
triple32(x::BigFloat) = triple(Float32, x)
triple16(x::BigFloat) = triple(Float16, x)

triple64(x::String) = triple(Float64, x)
triple32(x::String) = triple(Float32, x)
triple16(x::String) = triple(Float16, x)

@inline function clean0s(hi::T, md::T, lo::T) where {T}
    if !iszero(hi)
        hi, md, lo
    elseif iszero(md)
        lo, md, hi
    else
        md, lo, hi
    end
end

@inline function clean0s(hi::T, lo::T) where {T}
    if !iszero(hi)
        hi, lo
    else
        lo, hi
    end
end

function triple_inv(::Type{T}, x::BigFloat) where {T<:IEEEFloat}
    prec = precision(BigFloat)
    setprecision(BigFloat, 768)
    x = inv(x)
    hi = T(x)
    md = T(x - hi)
    lo = T(x - hi - md)
    setprecision(BigFloat, prec)
    return hi,md,lo
end

triple64inv(x::BigFloat) = triple_inv(Float64, x)
triple32inv(x::BigFloat) = triple_inv(Float32, x)
triple16inv(x::BigFloat) = triple_inv(Float16, x)

#=
Basic building blocks for a triple-double intermediate format
Christoph Quirin Lauter
Thème NUM — Systèmes numériques, Projet Arénaire
Rapport de recherche n 5702 — Septembre 2005 — 67 pages
=#

# Algorithm 3.3 [Triple-Double Building Blocks]

function renorm(hi::T, md::T, lo::T) where {T<:AbstractFloat}
    md, lo = two_sum(md, lo)
    hi, m  = two_sum(hi, md)
    md, lo = two_sum(m,  md)
    return hi, md, lo
end

function renorm_hilo(hi::T, md::T, lo::T) where {T<:AbstractFloat}
    md, lo = two_hilo_sum(md, lo)
    hi, m  = two_hilo_sum(hi, md)
    md, lo = two_hilo_sum(m,  md)
    return hi, md, lo
end

# Algorithm 4.1  (relerr 4.5 .. 16 u^2) [Triple-Double Building Blocks]

function add222(ahilo, bhilo)
    ahi, alo = ahilo
    bhi, blo = bhilo
    t1 = ahi + bhi
    if abs(ahi) >= abs(bhi)
        t2 = ahi - t1
        t3 = t2  + bhi
        t4 = t3  + blo
        t5 = t4  + alo
    else
        t2 = bhi - t1
        t3 = t2  + ahi
        t4 = t3  + alo
        t5 = t4  + blo
    end
    zhi, zlo = two_sum(t1, t5)
    zhi, zlo = clean0s(zhi, zlo)
    return zhi, zlo
end

"""
    _Basic building blocks for a triple-double intermediate format_

Christoph Quirin Lauter, 2005
""" TripleDouble_BuildingBlocks

# Algorithm 4.6  (relerr 16 u^2) [Triple-Double Building Blocks]
"""
    mul222( (ahi, alo), (bhi, blo) ) ↦ (chi, clo)

### Preconditions
- abs(alo) ≤ abs(ahi) * pow(2, -53)
- abs(blo) ≤ abs(bhi) * pow(2, -53)

### Postconditions
- abs(clo) ≤ abs(ahi) * pow(2, -53)
- chi + clo == ((ahi + alo) * (bhi + blo)) * (1 + ε), abs(ε) ≤ pow(2, -102)
- chi + clo == chi

#### [TripleDouble_BuildingBlocks](@ref)
"""
function mul222(ahilo, bhilo)
    ahi, alo = ahilo
    bhi, blo = bhilo
    t1, t2 = two_prod(ahi, bhi)
    t3 = ahi * blo
    t4 = alo * bhi
    t5 = t3 + t4
    t6 = t2 + t5
    zhi, zlo = two_sum(t1, t6)
    return zhi, zlo
end

# addition

# Algorithm 5.1 (Add33) [Triple-Double Building Blocks]
# (ahi,amd,alo) + (bhi,bmd,blo) :: (zhi,zmd,zlo)

function add333(ahi::T, amd::T, alo::T, bhi::T, bmd::T, blo::T) where {T<:AbstractFloat}
    zhi, t1 = two_sum(ahi, bhi)
    t2, t3 = two_sum(amd, bmd)
    t7, t4 = two_sum(t1, t2)
    t6 = alo + blo
    t5 = t3 + t4
    t8 = t5 + t6
    zmd, zlo = two_sum(t7, t8)
    zhi, zmd, zlo = clean0s(zhi,zmd,zlo)
    return zhi, zmd, zlo
end

@inline function add333(a::Tuple{T,T,T}, b::Tuple{T,T,T}) where {T<:AbstractFloat}
    return add333(a[1], a[2], a[3], b[1], b[2], b[3])
end

function add332(ahi::T, amd::T, alo::T, bhi::T, bmd::T, blo::T) where {T<:AbstractFloat}
    zhi, t1 = two_sum(ahi, bhi)
    t2, t3 = two_sum(amd, bmd)
    t7, t4 = two_sum(t1, t2)
    t6 = alo + blo
    t5 = t3 + t4
    zmd = t5 + t6
    zmd += t7
    zhi, zmd = clean0s(zhi, zmd)
    return zhi, zmd
end

@inline function add332(a::Tuple{T,T,T}, b::Tuple{T,T,T}) where {T<:AbstractFloat}
    return add332(a[1], a[2], a[3], b[1], b[2], b[3])
end

function add323(ahi::T, amd::T, alo::T, bhi::T, blo::T) where {T<:AbstractFloat}
    zhi, t1 = two_sum(ahi, bhi)
    t2, t3 = two_sum(amd, blo)
    t7, t4 = two_sum(t1, t2)
    t5 = t3 + t4
    t8 = t5 + alo
    zmd, zlo = two_sum(t7, t8)
    zhi, zmd, zlo = clean0s(zhi,zmd,zlo)
    return zhi, zmd, zlo
end

@inline function add323(a::Tuple{T,T,T}, b::Tuple{T,T}) where {T<:AbstractFloat}
    return add323(a[1], a[2], a[3], b[1], b[2])
end

function add322(ahi::T, amd::T, alo::T, bhi::T, blo::T) where {T<:AbstractFloat}
    zhi, t1 = two_sum(ahi, bhi)
    t2, t3 = two_sum(amd, blo)
    t7, t4 = two_sum(t1, t2)
    t5 = t3 + t4
    zmd = t5 + alo
    zmd += t7
    zhi, zmd = clean0s(zhi, zmd)
    return zhi, zmd
end

@inline function add322(a::Tuple{T,T,T}, b::Tuple{T,T}) where {T<:AbstractFloat}
    return add322(a[1], a[2], a[3], b[1], b[2])
end

function add223(ahi::T, amd::T, bhi::T, bmd::T) where {T<:AbstractFloat}
    zhi, t1 = two_sum(ahi, bhi)
    t2, t3 = two_sum(amd, bmd)
    t7, t4 = two_sum(t1, t2)
    t5 = t3 + t4
    zmd, zlo = two_sum(t7, t5)
    zhi, zmd, zlo = clean0s(zhi,zmd,zlo)
    return zhi, zmd, zlo
end

@inline function add223(a::Tuple{T,T}, b::Tuple{T,T}) where {T<:AbstractFloat}
    return add223(a[1], a[2], b[1], b[2])
end

function add313(ahi::T, amd::T, alo::T, b::T) where {T<:AbstractFloat}
    zhi, t1 = two_sum(ahi, b)
    t7, t4 = two_sum(t1, amd)
    t8 = t4 + alo
    zmd, zlo = two_sum(t7, t8)
    zhi, zmd, zlo = clean0s(zhi,zmd,zlo)
    return zhi, zmd, zlo
end

add133(b::T, ahi::T, amd::T, alo::T) where {T<:AbstractFloat} = add313(ahi, amd, alo, b)

add313(a::NTuple{3,T}, b::NTuple{1,T}) where {T<:AbstractFloat} =
    add313(a[1], a[2], a[3], b[1])

add133(b::NTuple{1,T}, a::NTuple{3,T}) where {T<:AbstractFloat} =
    add313(a[1], a[2], a[3], b[1])

# subtraction

function sub333(ahi::T, amd::T, alo::T, bhi::T, bmd::T, blo::T) where {T<:AbstractFloat}
    zhi, t1 = two_diff(ahi, bhi)
    t2, t3 = two_diff(amd, bmd)
    t7, t4 = two_sum(t1, t2)
    t6 = alo - blo
    t5 = t3 + t4
    t8 = t5 + t6
    zmd, zlo = two_sum(t7, t8)
    zhi, zmd, zlo = clean0s(zhi,zmd,zlo)
    return zhi, zmd, zlo
end

@inline function sub333(a::Tuple{T,T,T}, b::Tuple{T,T,T}) where {T<:AbstractFloat}
    return sub333(a[1], a[2], a[3], b[1], b[2], b[3])
end

function sub332(ahi::T, amd::T, alo::T, bhi::T, bmd::T, blo::T) where {T<:AbstractFloat}
    zhi, t1 = two_diff(ahi, bhi)
    t2, t3 = two_diff(amd, bmd)
    t7, t4 = two_sum(t1, t2)
    t6 = alo - blo
    t5 = t3 + t4
    t8 = t5 + t6
    zmd = t7 + t8
    zhi, zmd = clean0s(zhi, zmd)
    return zhi, zmd
end

@inline function sub332(a::Tuple{T,T,T}, b::Tuple{T,T,T}) where {T<:AbstractFloat}
    return sub332(a[1], a[2], a[3], b[1], b[2], b[3])
end

function sub323(ahi::T, amd::T, alo::T, bhi::T, bmd::T) where {T<:AbstractFloat}
    zhi, t1 = two_diff(ahi, bhi)
    t2, t3 = two_diff(amd, bmd)
    t7, t4 = two_sum(t1, t2)
    t5 = t3 + t4
    t8 = t5 + alo
    zmd, zlo = two_sum(t7, t8)
    zhi, zmd, zlo = clean0s(zhi,zmd,zlo)
    return zhi, zmd, zlo
end

@inline function sub323(a::Tuple{T,T,T}, b::Tuple{T,T}) where {T<:AbstractFloat}
    return sub323(a[1], a[2], a[3], b[1], b[2])
end

function sub322(ahi::T, amd::T, alo::T, bhi::T, bmd::T) where {T<:AbstractFloat}
    zhi, t1 = two_diff(ahi, bhi)
    t2, t3 = two_diff(amd, bmd)
    t7, t4 = two_sum(t1, t2)
    t5 = t3 + t4
    zmd = t5 + alo
    zmd += t7
    zhi, zmd = clean0s(zhi, zmd)
    return zhi, zmd
end

@inline function sub322(a::Tuple{T,T,T}, b::Tuple{T,T}) where {T<:AbstractFloat}
    return sub322(a[1], a[2], a[3], b[1], b[2])
end

function sub233(ahi::T, amd::T, bhi::T, bmd::T, blo::T) where {T<:AbstractFloat}
    zhi, t1 = two_diff(ahi, bhi)
    t2, t3 = two_diff(amd, bmd)
    t7, t4 = two_sum(t1, t2)
    t5 = t3 + t4
    t8 = t5 - blo
    zmd, zlo = two_sum(t7, t8)
    zhi, zmd, zlo = clean0s(zhi,zmd,zlo)
    return zhi, zmd, zlo
end

@inline function sub233(a::Tuple{T,T}, b::Tuple{T,T,T}) where {T<:AbstractFloat}
    return sub233(a[1], a[2], b[1], b[2], b[3])
end

function sub232(ahi::T, amd::T, bhi::T, bmd::T, blo::T) where {T<:AbstractFloat}
    zhi, t1 = two_diff(ahi, bhi)
    t2, t3 = two_diff(amd, bmd)
    t7, t4 = two_sum(t1, t2)
    t5 = t3 + t4
    zmd = t5 - blo
    zmd += t7
    zhi, zmd = clean0s(zhi, zmd)
    return zhi, zmd
end

@inline function sub232(a::Tuple{T,T}, b::Tuple{T,T,T}) where {T<:AbstractFloat}
    return sub232(a[1], a[2], b[1], b[2], b[3])
end

function sub223(ahi::T, amd::T, bhi::T, bmd::T) where {T<:AbstractFloat}
    zhi, t1 = two_diff(ahi, bhi)
    t2, t3 = two_diff(amd, bmd)
    t7, t4 = two_sum(t1, t2)
    t5 = t3 + t4
    zmd, zlo = two_sum(t7, t5)
    zhi, zmd, zlo = clean0s(zhi,zmd,zlo)
    return zhi, zmd, zlo
end

@inline function sub223(a::Tuple{T,T}, b::Tuple{T,T}) where {T<:AbstractFloat}
    return sub223(a[1], a[2], b[1], b[2])
end

function sub313(ahi::T, amd::T, alo::T, b::T) where {T<:AbstractFloat}
    zhi, t1 = two_diff(ahi, b)
    t7, t4 = two_sum(t1, amd)
    t8 = t4 + alo
    zmd, zlo = two_sum(t7, t8)
    zhi, zmd, zlo = clean0s(zhi,zmd,zlo)
    return zhi, zmd, zlo
end

function sub312(ahi::T, amd::T, alo::T, b::T) where {T<:AbstractFloat}
    zhi, t1 = two_diff(ahi, b)
    t7, t4 = two_sum(t1, amd)
    zlo = t4 + alo
    zlo += t7
    zhi, zlo = clean0s(zhi, zlo)
    return zhi, zlo
end

sub313(a::NTuple{3,T}, b::NTuple{1,T}) where {T<:AbstractFloat} =
    sub313(a[1], a[2], a[3], b)

sub312(a::NTuple{3,T}, b::NTuple{1,T}) where {T<:AbstractFloat} =
    sub312(a[1], a[2], a[3], b)

# Algorithm 6.1 [Triple-Double Building Blocks]
# (ahi,alo) * (bhi,blo) :: (zhi,zmd,zlo)

function mul223(ahi::T, alo::T, bhi::T, blo::T) where {T<:AbstractFloat}
    zhi, t1 = two_prod(ahi, bhi)
    t2, t3 = two_prod(ahi, blo)
    t4, t5 = two_prod(alo, bhi)
    t6 = alo * blo
    t7, t8 = two_sum(t2, t3, t4, t5)
    t9, t10 = two_sum(t1, t6)
    zmd, zlo = two_sum(t7, t8, t9, t10)
    return zhi, zmd, zlo
end

@inline function mul223(a::Tuple{T,T}, b::Tuple{T,T}) where {T<:AbstractFloat}
    return mul223(a[1], a[2], b[1], b[2])
end

function mul323(a::Tuple{T,T,T}, b::Tuple{T,T}) where {T<:AbstractFloat}
  ahi, amd, alo = a
  bhi, blo = b
  p0,q0 = two_prod(ahi, bhi)
  p1,q1 = two_prod(ahi, blo)
  p2,q2 = two_prod(amd, bhi)
  p4,q4 = two_prod(amd, blo)
  p5,q5 = two_prod(alo, bhi)

  # Start Accumulation
  p1,p2,q0 = three_sum(p1, p2, q0)

  # Six-Three Sum  of p2, q1, q2, p3, p4, p5
  p2,q1,q2 = three_sum(p2, q1, q2)
  p3,p4 = two_sum(p4, p5)
  # compute (s0, s1, s2) = (p2, q1, q2) + (p3, p4, p5)
  s0,t0 = two_sum(p2, p3)
  s1,t1 = two_sum(q1, p4)
  s2 = q2
  s1,t0 = two_sum(s1, t0)
  s2 += (t0 + t1)

  # O(eps^3) order terms
  s1 += alo*blo + q0 + q4 + q5
  #p0,p1,s0 = renormAs3(p0, p1, s0, s1+s2)
  s1 += s2
  s0,s1 = two_hilo_sum(s0,s1)
  p1,s0 = two_hilo_sum(p1,s0)
  p0,p1 = two_hilo_sum(p0,p1)

  return p0,p1,s0
end

mul323(a::Tuple{Float64, Float64, Float64}, b::Tuple{Float32, Float32}) =
    mul323(a, (Float64(b[1]), Float64(b[2])) )
mul323(a::Tuple{Float32, Float32, Float32}, b::Tuple{Float64, Float64}) =
    mul323((Float64(a[1]), Float64(a[2]), Float64(a[3])), b)

function mul322(a::Tuple{T,T,T}, b::Tuple{T,T}) where {T<:AbstractFloat}
  ahi, amd, alo = a
  bhi, blo = b
  p0,q0 = two_prod(ahi, bhi)
  p1,q1 = two_prod(ahi, blo)
  p2,q2 = two_prod(amd, bhi)
  p4,q4 = two_prod(amd, blo)
  p5,q5 = two_prod(alo, bhi)

  # Start Accumulation
  p1,p2,q0 = three_sum(p1, p2, q0)

  # Six-Three Sum  of p2, q1, q2, p3, p4, p5
  p2,q1,q2 = three_sum(p2, q1, q2)
  p3,p4 = two_sum(p4, p5)
  # compute (s0, s1, s2) = (p2, q1, q2) + (p3, p4, p5)
  s0,t0 = two_sum(p2, p3)
  s1,t1 = two_sum(q1, p4)
  s2 = q2
  s1,t0 = two_sum(s1, t0)
  s2 += (t0 + t1)

  # O(eps^3) order terms
  s1 += alo*blo + q0 + q4 + q5
  #p0,p1,s0 = renormAs3(p0, p1, s0, s1+s2)
  s1 += s2
  s0 += s1
  p1 += s0
  p0,p1 = two_hilo_sum(p0,p1)

  return p0,p1
end

mul322(a::Tuple{Float64, Float64, Float64}, b::Tuple{Float32, Float32}) =
    mul322(a, (Float64(b[1]), Float64(b[2])) )
mul322(a::Tuple{Float32, Float32, Float32}, b::Tuple{Float64, Float64}) =
    mul322((Float64(a[1]), Float64(a[2]), Float64(a[3])), b)

mul233(a::Tuple{T,T}, b::Tuple{T,T,T}) where {T<:AbstractFloat} =
    mul323(b,a)

mul232(a::Tuple{T,T}, b::Tuple{T,T,T}) where {T<:AbstractFloat} =
    mul322(b,a)

function mul333(a::Tuple{T,T,T}, b::Tuple{T,T,T}) where {T<:AbstractFloat}
    ahi, amd, alo = a
    bhi, bmd, blo = b

    hi,t1 = two_prod(ahi, bhi)
    t2,t3 = two_prod(ahi, bmd)
    t4,t5 = two_prod(amd, bhi)
    t6,t7 = two_prod(amd, bmd)

    t8  = ahi * blo
    t9  = alo * bhi
    t10 = amd * blo
    t11 = alo * bmd
    t12 = t8  + t9
    t13 = t10 + t11

    t14, t15 = two_hilo_sum(t1, t6)

    t16 = t7  + t15
    t17 = t12 + t13
    t18 = t16 + t17

    t19, t20 = two_hilo_sum(t14, t18)
    t21, t22 = two_hilo_sum(t2, t3, t4, t5)
    md,  lo  = two_hilo_sum(t21, t22, t19, t20)

    return hi, md, lo
end

mul333(a::Tuple{Float64, Float64, Float64}, b::Tuple{Float32, Float32, Float32}) =
    mul333(a, (Float64(b[1]), Float64(b[2]), Float64(b[3])) )
mul333(a::Tuple{Float32, Float32, Float32}, b::Tuple{Float64, Float64, Float64}) =
    mul333((Float64(a[1]), Float64(a[2]), Float64(a[3])), b)

function mul332(a::Tuple{T,T,T}, b::Tuple{T,T,T}) where {T<:AbstractFloat}
    ahi, amd, alo = a
    bhi, bmd, blo = b

    hi,t1 = two_prod(ahi, bhi)
    t2,t3 = two_prod(ahi, bmd)
    t4,t5 = two_prod(amd, bhi)
    t6,t7 = two_prod(amd, bmd)

    t8  = ahi * blo
    t9  = alo * bhi
    t10 = amd * blo
    t11 = alo * bmd

    t14, lo = two_hilo_sum(t1, t6)

    lo += t7
    lo += t8  + t9
    lo += t10 + t11
    lo += t16 + t17
    lo += t14
    lo += t5  + t4
    lo += t3  + t2

    return hi, lo
end

mul332(a::Tuple{Float64, Float64, Float64}, b::Tuple{Float32, Float32, Float32}) =
    mul332(a, (Float64(b[1]), Float64(b[2]), Float64(b[3])) )
mul332(a::Tuple{Float32, Float32, Float32}, b::Tuple{Float64, Float64, Float64}) =
    mul332((Float64(a[1]), Float64(a[2]), Float64(a[3])), b)

function mul313(a::Tuple{T,T,T}, b::Tuple{T}) where {T<:AbstractFloat}
  ahi, amd, alo = a
  bhi = b[1]
  p0,q0 = two_prod(ahi, bhi)
  p2,q2 = two_prod(amd, bhi)
  p5,q5 = two_prod(alo, bhi)

  # Start Accumulation
  p1,p2 = two_sum(p2, q0)

  p2,q1 = two_sum(p2, q2)

  s0,t0 = two_sum(p2, p5)
  s1,t0 = two_sum(q1, t0)

  # O(eps^3) order terms
  s1 += q5
  #p0,p1,s0 = renormAs3(p0, p1, s0, s1+s2)
  s1 += t0
  s0,s1 = two_hilo_sum(s0,s1)
  p1,s0 = two_hilo_sum(p1,s0)
  p0,p1 = two_hilo_sum(p0,p1)

  return p0,p1,s0
end

mul133(a::NTuple{1,T}, b::NTuple{3,T}) where {T<:AbstractFloat} = mul313(b, a)

function mul312(a::Tuple{T,T,T}, b::Tuple{T}) where {T<:AbstractFloat}
  ahi, amd, alo = a
  bhi = b[1]
  p0,q0 = two_prod(ahi, bhi)
  p2,q2 = two_prod(amd, bhi)
  p5,q5 = two_prod(alo, bhi)

  # Start Accumulation
  p1,p2 = two_sum(p2, q0)

  p2,q1 = two_sum(p2, q2)

  s0,t0 = two_sum(p2, p5)
  s1,t0 = two_sum(q1, t0)

  # O(eps^3) order terms
  s1 += q5
  #p0,p1,s0 = renormAs3(p0, p1, s0, s1+s2)
  s1 += t0
  p1 = p1 + (s0 + s1)
  p0,p1 = two_hilo_sum(p0,p1)

  return p0,p1
end

mul132(a::NTuple{1,T}, b::NTuple{3,T}) where {T<:AbstractFloat} = mul312(b, a)

function muladd222(a::Tuple{T,T}, b::Tuple{T,T}, c::Tuple{T,T}) where {T<:AbstractFloat}
    m = mul223(a, b)
    hi, lo = add322(m, c)
    return hi, lo
end


### The hamiltonian for all calculations
### Time to use multiple dispatch for collecting all stuff

immutable Parameters
    hw::Tuple{Float64,Float64,Float64}
    I::Tuple{Float64,Float64,Float64}
    phi::Tuple{Float64,Float64,Float64}
end

divf(x,y) = y==0 ? 0 : x/y

const sigmax = [0 1;1 0]
const sigmay = [0 -1im;1im 0]
const sigmaz = [1 0;0 -1]

δ(m,n) = m==n ? 1 : 0

function H(l_,m_,n_,a_,l,m,n,a,p::Parameters)

    hw,I,phi= p.hw,p.I,p.phi

    sigma = (sigmax[a_,a],sigmay[a_,a],sigmaz[a_,a]) # vector of sigma matricies

    bc = (sqrt(l+1)*δ(l_,l+1), sqrt(m+1)*δ(m_,m+1), sqrt(n+1)*δ(n_,n+1))
    ba = (sqrt(l)*δ(l_,l-1),sqrt(m)*δ(m_,m-1),sqrt(n)*δ(n_,n-1))

    E = δ(l_,l)*δ(m_,m)*δ(n_,n)

    ### Collecting terms
    ### Maybe can be made a bit faster

    s::Complex{Float64} = 0

    s += sum(p.hw.*(l+1/2,m+1/2,n+1/2).*E.*δ(a_,a))
    s += sum(sigma.*I.*(bc.+ba).*(δ(m_,m)*δ(n_,n),δ(l_,l)*δ(n_,n),δ(l_,l)*δ(m_,m)))
    s += sum(sigma.*I.*phi)*E
    return s
end

function FillOperator(H::Function,Nx::Int,Ny::Int,Nz::Int,p::Parameters)
    ### Need to do special care if Is becomes nondiognal!
    #Hm[:,:] = 0
    Hm = Array{Complex}(0)
    I = Array{Int}(0)
    J = Array{Int}(0)

    s(l,m,n,a) = 2*(Ny+1)*(Nz+1)*l+2*(Nz+1)*m+2*n+a
    for l in 0:Nx
        for m in 0:Ny
            for n in 0:Nz
                elements = [
                    (l-1,m,n)
                    (l,m,n)
                    (l+1,m,n)
                    (l,m-1,n)
                    (l,m+1,n)
                    (l,m,n-1)
                    (l,m,n+1)
                ]

                for (l_,m_,n_) in elements
                    ### A continue routine
                    if (l_<0) || (m_<0) || (n_<0) || (l_>Nx) || (m_>Ny) || (n_>Nz)
                        continue
                    end
                    for a in 1:2
                        for a_ in 1:2
                            sbra = s(l_,m_,n_,a_)
                            sket = s(l,m,n,a)
                            Hmi = H(l_,m_,n_,a_,l,m,n,a,p)
                            if Hmi!=0
                                push!(I,sbra)
                                push!(J,sket)
                                push!(Hm,Hmi)
                            end
                        end
                    end
                end
            end
        end
    end
    return sparse(I,J,Hm)
end

function FillHamiltonian(Nx::Int,Ny::Int,Nz::Int,p::Parameters)
    return FillOperator(H,Nx,Ny,Nz,p)
end

### A simple operators

OPphix(l_,m_,n_,a_,l,m,n,a,p::Parameters) = (sqrt(l+1)*δ(l_,l+1) + sqrt(l)*δ(l_,l-1)) * δ(m_,m)*δ(n_,n)*δ(a_,a)

OPphiy(l_,m_,n_,a_,l,m,n,a,p::Parameters) = (sqrt(m+1)*δ(m_,m+1) + sqrt(m)*δ(m_,m-1)) * δ(l_,l)*δ(n_,n)*δ(a_,a)

OPphiz(l_,m_,n_,a_,l,m,n,a,p::Parameters) = (sqrt(n+1)*δ(n_,n+1) + sqrt(n)*δ(n_,n-1)) * δ(l_,l)*δ(m_,m)*δ(a_,a)

_p = Parameters((0,0,0),(0,0,0),(0,0,0))

@time const Phix = FillOperator(OPphix,N...,_p)
@time const Phiy = FillOperator(OPphiy,N...,_p)
@time const Phiz = FillOperator(OPphiz,N...,_p)


using QuasiGeostrophy
using LinearAlgebra, FFTW, BenchmarkTools, Plots

a = 0; b = 22.0
Δt = 1e-1 / 2
Ω = S¹(a,b) # Domain
Nx = 2^6;
fourier_grid = FourierGrid(Nx, Ω) # Grid
x = fourier_grid.grid[1]
kx = fourier_grid.wavenumbers[1]
f = @. sin( 4 * 2π * x / (b-a)) + 0im
f̂ = copy(f)
FFTW.set_num_threads(Threads.nthreads())
P = plan_fft(f) # typeof(iP) <: AbstractFFTs.ScaledPlan
iP = plan_ifft(f)
mul!(f̂, P, f)
∂x = FourierOperator(im .* kx)
argmax(real.((-∂x^2 - ∂x^4).op))

function closure_rhs(∂x, P, iP)
    function closed_rhs(state)
        f̂ = state[1]
        ff = convolve(f̂, f̂, P, iP)
        return [ ∂x( -0.5 .* ff - ∂x(f̂))]
    end
end

ks_rhs = closure_rhs(∂x, P, iP)

function closure_lhs(∂x, Δt)
    function lhs()
        q1_lhs = 1 + Δt * ∂x^4
        return [q1_lhs]
    end
end

ks_lhs = closure_lhs(∂x, Δt)
operators = ks_lhs()
lhs_operator = [inv(operator) for operator in operators]

function imex_step!(state, lhs_operator, rhs, Δt)
    rhs_state = rhs(state)
    current_state = copy(state)
    for i in eachindex(state)
        tmp = lhs_operator[i](current_state[i] .+ Δt .* rhs_state[i])
        @. state[i] =  tmp
    end
end
##
f = @. sin( 8π * x / (b-a)) + 0im
f̂ = copy(f)
mul!(f̂, P, f)
state = [f̂]
nsteps = 40*200
total_array = zeros(length(f), nsteps)
##
gr(size = (400,400))
for i in 1:nsteps
    imex_step!(state, lhs_operator, ks_rhs, Δt)
    u = state[1]
    total_array[:, i] .= real.(iP * u)
    if (i%100) == 0
        mul!(f, iP, f̂)
        p1 = plot(x, real.(f), ylims = (-2.0,2.0), label = "real space", xlabel = "position", ylabel  = "amplitude")
        p2 = scatter(log.(abs.(f̂))[1:div(length(f̂),2)+1], label = "spectrum", ylims = (-7, 3), xlabel = "wavenumber", ylabel = "spectral amplitude")
        display(plot(p1,p2))
        sleep(0.1)
    end
end
##
contourf(total_array, linewidth = 0, color = :thermometer)


### A Pluto.jl notebook ###
# v0.14.7

using Markdown
using InteractiveUtils

# ╔═╡ e166839c-7451-471f-b10f-3cc8d3d751f3
begin
	using PlutoUI, Plots, LinearAlgebra, Statistics, DelimitedFiles, Clustering, DataFrames
	import Random, CSV
	plotly()
end

# ╔═╡ d6b500f1-5d54-4cdb-8d74-56e8a9ab367e
# For binder, uncomment this cell ...
#=
begin
	import Pkg
    Pkg.activate(mktempdir())
    Pkg.add([
		Pkg.PackageSpec(name="PlutoUI"),
        Pkg.PackageSpec(name="Plots"),
		Pkg.PackageSpec(name="Statistics"),
		Pkg.PackageSpec(name="DelimitedFiles"),
		Pkg.PackageSpec(name="Distributions"),
		Pkg.PackageSpec(name="Clustering"),
		Pkg.PackageSpec(name="CSV"),
		Pkg.PackageSpec(name="DataFrames")
    ])
end
=#

# ╔═╡ c810e2a4-03a5-4d19-8717-3de25f013269
TableOfContents(title="📚 Table of Contents", aside=true)

# ╔═╡ d7ef9ec9-1acf-48e6-bfbc-55ec01b36b0b
md"""
# Principal Component Analysis

PCA is an orthogonal linear transformation that transforms the data to a new coordinate system such that the greatest variance by some projection of the data comes to lie on the first coordinate (called the first principal component), the second greatest variance on the second coordinate, and so on. PCA analysis is perfromed either using EVD of the covariance matrix or the SVD of the mean-centered data.

__Prerequisites__

The reader should be familiar with linear algebra and statistics concepts.

__Competences__

The reader should be able to perform PCA on a given data set.

__References__

For more details see

* [Principal Component Analysis](https://en.wikipedia.org/wiki/Principal_component_analysis),
* [L. I. Smith, A tutorial on Principal Components Analysis](http://www.cs.otago.ac.nz/cosc453/student_tutorials/principal_components.pdf),
* [J. Shlens, A Tutorial on Principal Components Analysis](http://arxiv.org/abs/1404.1100).

"""

# ╔═╡ 728f10ec-2843-41ae-ae8e-c913155fe303
md"""
## Definitions

A __data matrix__ is a matrix $X\in\mathbb{R}^{m\times n}$, where each column corresponds to a feature (say, certain gene), and each row correspond to an observation (say, individual).

A __mean__ of a vector $x\in\mathbb{R}^{n}$ is $\mu(x)=\displaystyle \frac{x_1+x_2+\cdots x_n}{n}$.

A __standard deviation__  of a vector $x$ is $\sigma(x)=\displaystyle \sqrt{\frac{\sum_{i=1}^n (x_i-\mu(x))^2}{n-1}}$. A __variance__ of a vector $x$ is $\mathop{\mathrm{var}}(x)=\sigma^2(x)$.

A __vector of means__ of a data matrix $X$ is a row-vector of means of the columns of $X$, $\mu(X)=\begin{bmatrix}\mu(X_{:,1}) & \mu(X_{:,2}) & \ldots & \mu(X_{:,n})\end{bmatrix}$.

A __zero-mean centered data matrix__ is a matrix $\bar X$ obtained from a data matrix $X$ by subtracting from each column the mean of this column,

$$
\bar X= \begin{bmatrix} X_{:,1}-\mu(X_{:,1}) & X_{:,2}-\mu(X_{:,2}) & \cdots &
X_{:,n}-\mu(X_{:,n}) \end{bmatrix}\equiv
X-\mathbf{1}\mu(X),$$

where $\mathbf{1}=[1,1,\ldots,1]^T$.

A __covariance matrix__ of a data matrix $X$ is a matrix

$$
\mathop{\mathrm{cov}}(X)=\displaystyle \frac{1}{n-1}[X-\mathbf{1}\mu(X)]^T[X-\mathbf{1}\mu(X)]
\equiv \frac{\bar X^T \bar X}{n-1}.$$
"""

# ╔═╡ 1eec2efb-62b7-493b-8a9c-d3784d2e7825
md"""
## Facts

Given a data matrix $X$, let $\mathop{\mathrm{cov}}(X)=U\Lambda U^T$ be the EVD with non-increasingly ordered eigenvalues, $\lambda_1\geq \lambda_2\geq \cdots \geq \lambda_n$.

1.  $\mathop{\mathrm{cov}}(X)$  is a symmetric PSD matrix.

2.  $\mathop{\mathrm{cov}}(X)=\mathop{\mathrm{cov}}(\bar X)$.

3. Let $T=\bar X U$. The columns of $T$ are the __principal components__ of $\bar X$. In particular:
    1. The first principal component of $\bar X$ (or $X$) is the first column, $T_{:,1}$. It is a projection of the zero-mean centered data set $\bar X$ on the line defined by $U_{:,1}$. This is the direction along which the data have the largest variance.
    2. The second column (the second principal component), $T_{:,1}$, is a projection of $\bar X$ on the line defined by $U_{:,2}$, which is orthogonal to the first projection. This is direction with the largest variance _after_ subtracting the first principal component from $\bar X$.
    3. The $k$-th principal component is the direction with the largest variance _after_ subtracting the first $k-1$ principal components from $\bar X$, that is, the first principal component of the matrix

$$
\hat X=\bar X-\sum_{i=1}^{k-1} \bar X U_{:,i} U_{:,i}^T.$$

4. Let $\bar X=\bar U \Sigma V^T$ be the SVD of $\bar X$. Then $V=U$ and $T=\bar U\Sigma V^T V\equiv \bar U \Sigma$.

5. Reconstruction of the principal components is the following:
    1. Full reconstruction is $X=T U^T +\mathbf{1} \mu(X)$.
    2. Reconstruction from the first $k$ principal components is

$$\tilde X =T U_{:,1:k}^T +\mathbf{1} \mu(X).$$

6. Partial reconstructions can help obtaining various insights about the data. For example, the rows of the matrix $T_{:,1:k}$ can be clustered by the $k$-means algorithm, and the points defined by first three columns of $T$ can be plotted to visualize projections of clusters. Afterwards, the computed clusters can be mapped back to original data.

7. Heuristical guess for number of important clusters is given be the location of the "knee" in the plot of the singular values of $\bar X$.
"""

# ╔═╡ 63929a68-2407-4b46-80bc-91c5da382931
md"""

## Examples

### Elliptical data set

We generate a "quasi" elliptical set of points and compute its principal components.
"""

# ╔═╡ 1c25240c-d396-4661-b3f3-fd2b30876a00
begin
	# Generate data points
	Random.seed!(456)
	n=3
	m=500
	ax=[8,3,1]
	X=Array{Float64}(undef,m,n)
	for i=1:n
	    X[:,i]=Random.rand!(X[:,i])*ax[i]
	end
	# Parameters
	u=(rand(m).-0.5)*π
	v=(rand(m).-0.5)*2*π
	for i=1:m
	    X[i,1]=X[i,1]*cos(u[i])*cos(v[i])
	    X[i,2]=X[i,2]*cos(u[i])*sin(v[i])
	    X[i,3]=X[i,3]*sin(u[i])
	end
end

# ╔═╡ 61435c77-989b-4490-ba29-acc23420d021
X₀=copy(X)

# ╔═╡ 4bb4a5d4-4cfd-4ddc-b3a8-6b59f1e6f562
sum(abs.(X₀),dims=1)

# ╔═╡ 9ce6a3e8-b706-4014-92e9-4c03b5eb381b
# Plot the set
scatter(X₀[:,1],X₀[:,2],X₀[:,3],legend=false,ms=2,aspect_ratio=:equal,xlabel="x")

# ╔═╡ 7f033a55-ebf3-4265-85c1-f3358d165ab9
# Compute the means. How good is the RNG?
μ₀=mean(X₀,dims=1)

# ╔═╡ f427adaa-c41f-4017-ada6-cd018bbc642c
begin
	# Subtract the means, rotate by a random orthogonal matrix Q and
	# translate by S
	Q,r=qr(rand(3,3))
	S=[3,-2,4]
	X₁=(X₀.-μ₀)*Q .+S'
	scatter(X₁[:,1],X₁[:,2],X₁[:,3],legend=false,ms=2,aspect_ratio=:equal,xlabel="x")
end

# ╔═╡ 66a8e281-4709-4548-b13b-5dd5c23805e6
C₁=cov(X₁)

# ╔═╡ 685bdf11-79bd-4070-9b30-3dfa0341e779
μ₁=mean(X₁,dims=1)

# ╔═╡ 5533faf5-7847-468b-bd62-244b2581cad6
# Fact 2
cov(X₁.-μ₁), (X₁.-μ₁)'*(X₁.-μ₁)/(m-1)

# ╔═╡ db7e0f78-0a05-4719-81f1-cd007ff1163b
# Principal components, evals are non-decreasing
λ₁,U₁=eigen(C₁)

# ╔═╡ 0e179343-1f3e-4b5f-8560-c5acbfa8f6e6
begin
	# Largest principal component
	T₁=(X₁.-μ₁)*U₁[:,3]
	p₁=scatter(T₁,zero(T₁),marker=:plus,ms=2)
	p₂=scatter(T₁)
	plot(p₁,p₂,layout=(1,2),legend=false,m=:plus,ms=2)
end

# ╔═╡ 5b208afb-13cc-4937-82f8-df67830a4914
begin
	# Two largest principal components
	T₂=(X₁.-μ₁)*U₁[:,[3,2]]
	scatter(T₂[:,1],T₂[:,2],legend=false,m=:plus,ms=2,ratio=:equal)
end

# ╔═╡ d2dacf61-8728-4046-9dae-0bafe842cebf
begin
	# All  three principal components
	T₃=(X₁.-μ₁)*U₁[:,[3,2,1]]
	scatter(T₃[:,1],T₃[:,2],T₃[:,3],legend=false,m=:plus,ms=2,ratio=:equal)
end

# ╔═╡ e1b16942-6e32-45f6-a3c8-eb259ccd9e5b
begin
	# Fact 5 - Recovery of the largest component
	Y₁=T₁*U₁[:,3]'.+μ₁
	scatter(Y₁[:,1],Y₁[:,2],Y₁[:,3],legend=false,m=:plus,ms=2,ratio=:equal)
end

# ╔═╡ 56ddc45c-9b40-4c76-8ea1-8235f9690d73
begin
	# Recovery of the two largest components
	Y₂=T₂*U₁[:,[3,2]]'.+μ₁
	scatter(Y₂[:,1],Y₂[:,2],Y₂[:,3],legend=false,m=:plus,ms=2,ratio=:equal)
end

# ╔═╡ d06b73ae-1556-4c04-8f39-b7b12ae5bc72
begin
	# Recovery of all three components (exact)
	Y₃=T₃*U₁[:,[3,2,1]]'.+μ₁
	scatter(Y₃[:,1],Y₃[:,2],Y₃[:,3],legend=false,m=:plus,ms=2,ratio=:equal)
	scatter!(X₁[:,1],X₁[:,2],X₁[:,3],legend=false,m=:circle,ms=2,mc=:red,ratio=:equal)
end

# ╔═╡ e50ce490-bf7e-40b0-9dd5-7e2ee5a057cb
# Fact 4 - PCA using SVD
function PCA(X::Array{T}, k::Int) where T
    μ=mean(X,dims=1)
    U=svd(X.-μ)
    U.U[:,1:k]*Diagonal(U.S[1:k])
end

# ╔═╡ 12580ca2-5703-4933-ae1a-eb69c3e22109
begin
	T₁s=PCA(X,1)
	[T₁s T₁]
end

# ╔═╡ 38318bfc-d72a-4da0-9862-235fb43f7c61
begin
	# The two largest components using SVD
	T₂s=PCA(X,2)
	[T₂s T₂]
end

# ╔═╡ ff6f6c9f-0e14-47a5-8bcf-29337a45d042
md"""
### Real data 1

We will cluster three datasets from [Workshop "Principal Manifolds-2006"](http://www.ihes.fr/~zinovyev/princmanif2006/):

Data set | # of genes (m) | # of samples (n)
:---:|---:|---:
D1 | 17816 | 286
D2 | 3036 | 40
D3 | 10383| 103
"""

# ╔═╡ 8c5c604c-5043-4dd0-a604-99c958860c14
# Data set D₁
# readdlm("files/d1.txt")

# ╔═╡ 73c0571b-60c9-4a85-bbfa-39a6f42192a2
D₁=map(Float64,readdlm("files/d1.txt")[2:end,2:end])

# ╔═╡ d70d8dd7-a9a5-48bf-8a1b-789d02c35d02
sizeof(D₁)

# ╔═╡ 21bc5eee-ebd9-4192-a240-59cd3f4a33b2
# Fact 7 - Plot σ's and observe the knee
scatter(svdvals(D₁.-mean(D₁,dims=1)),leg=false,ms=2)

# ╔═╡ 83660bc1-8116-476e-9c88-0ea176120875
begin
	# PCA on D₁, keep 20 singular values
	k₁=20
	T=PCA(D₁,k₁)
end

# ╔═╡ 500d16ac-0dbe-4815-8fbb-922adf751d9f
# Find k clusters
out=kmeans(T',k₁);

# ╔═╡ 8c6255cb-60f4-4c63-b4b2-e403d74360e1
# Plot points defined by the first three principal components
function Plot(C::Vector, T::Array, k::Int)
    P=Array{Any}(undef,k)
	scatter(legend=false)
    for j=1:k
        P[j]=T[C.==j,1:3]
        scatter!(P[j][:,1],P[j][:,2],P[j][:,3],ms=2)
    end
	scatter!()
end

# ╔═╡ dff6d995-3753-4c70-b286-dd5aaf7f6461
Plot(out.assignments,T,k₁)

# ╔═╡ 54d17292-195e-4ad4-8848-c725d1cbf8bf
md"
### Real data 2
"

# ╔═╡ e133dab4-f9fe-47ed-a9a5-2644c1a954c9
# Data set D₂
D₂=readdlm("files/d2fn.txt")

# ╔═╡ 69016fc2-4249-4ce8-9d02-4371ba4ac6d7
# Plot σ's and observe knee
scatter(svdvals(D₂.-mean(D₂,dims=1)),leg=false,ms=2)

# ╔═╡ d5713d68-6413-4873-9d40-d8a5134ceb3d
begin
	k₂=5
	T²=PCA(D₂,k₂)
	out₂=kmeans(T²',k₂)
	Plot(out₂.assignments,T²,k₂)
end

# ╔═╡ 60d2fab0-9951-48b1-a9e4-81ff10b1bf40
md"""

### Real data 3

We use the package [CSV.jl](https://github.com/JuliaData/CSV.jl) and replace the "NULL" string with `missing`.
"""

# ╔═╡ dcef3495-9a8b-4e7f-bbda-865cac3e894e
sf = CSV.read("files/d3efn.txt",DataFrame,header=0,missingstring="NULL")

# ╔═╡ 5cabfc3e-54a1-40aa-8979-bc5cc10d2ffd
# sf[:,103]

# ╔═╡ 53191664-ec06-441c-b1ee-5ee8034c4984
typeof(sf)

# ╔═╡ 9ab1ba2b-30fd-4cca-be25-3090608d18be
# Set missing values to zero
D₃=coalesce.(Matrix(sf[:,1:end-1]),0.0)

# ╔═╡ a4ea64d4-57f3-4d43-9083-3e52b8e213d7
# Plot σ's and observe knee
scatter(svdvals(D₃.-mean(D₃,dims=1)),leg=false,ms=2)

# ╔═╡ d6143ca0-ba0e-406a-8b3f-fbcd348777bb
begin
	k₃=10
	T³=PCA(D₃,k₃)
	out₃=kmeans(T³',k₃)
	Plot(out₃.assignments,T³,k₃)
end

# ╔═╡ 2a85afb0-a3e8-477b-bc9b-e97701c40eae
begin
	# Clustering the transpose
	k₄=20
	T⁴=PCA(Matrix(D₃'),k₄)
	out₄=kmeans(T⁴',k₄)
	Plot(out₄.assignments,T⁴,k₄)
end

# ╔═╡ Cell order:
# ╠═d6b500f1-5d54-4cdb-8d74-56e8a9ab367e
# ╠═e166839c-7451-471f-b10f-3cc8d3d751f3
# ╠═c810e2a4-03a5-4d19-8717-3de25f013269
# ╟─d7ef9ec9-1acf-48e6-bfbc-55ec01b36b0b
# ╟─728f10ec-2843-41ae-ae8e-c913155fe303
# ╟─1eec2efb-62b7-493b-8a9c-d3784d2e7825
# ╟─63929a68-2407-4b46-80bc-91c5da382931
# ╠═1c25240c-d396-4661-b3f3-fd2b30876a00
# ╠═61435c77-989b-4490-ba29-acc23420d021
# ╠═4bb4a5d4-4cfd-4ddc-b3a8-6b59f1e6f562
# ╠═9ce6a3e8-b706-4014-92e9-4c03b5eb381b
# ╠═7f033a55-ebf3-4265-85c1-f3358d165ab9
# ╠═f427adaa-c41f-4017-ada6-cd018bbc642c
# ╠═66a8e281-4709-4548-b13b-5dd5c23805e6
# ╠═685bdf11-79bd-4070-9b30-3dfa0341e779
# ╠═5533faf5-7847-468b-bd62-244b2581cad6
# ╠═db7e0f78-0a05-4719-81f1-cd007ff1163b
# ╠═0e179343-1f3e-4b5f-8560-c5acbfa8f6e6
# ╠═5b208afb-13cc-4937-82f8-df67830a4914
# ╠═d2dacf61-8728-4046-9dae-0bafe842cebf
# ╠═e1b16942-6e32-45f6-a3c8-eb259ccd9e5b
# ╠═56ddc45c-9b40-4c76-8ea1-8235f9690d73
# ╠═d06b73ae-1556-4c04-8f39-b7b12ae5bc72
# ╠═e50ce490-bf7e-40b0-9dd5-7e2ee5a057cb
# ╠═12580ca2-5703-4933-ae1a-eb69c3e22109
# ╠═38318bfc-d72a-4da0-9862-235fb43f7c61
# ╟─ff6f6c9f-0e14-47a5-8bcf-29337a45d042
# ╠═8c5c604c-5043-4dd0-a604-99c958860c14
# ╠═73c0571b-60c9-4a85-bbfa-39a6f42192a2
# ╠═d70d8dd7-a9a5-48bf-8a1b-789d02c35d02
# ╠═21bc5eee-ebd9-4192-a240-59cd3f4a33b2
# ╠═83660bc1-8116-476e-9c88-0ea176120875
# ╠═500d16ac-0dbe-4815-8fbb-922adf751d9f
# ╠═8c6255cb-60f4-4c63-b4b2-e403d74360e1
# ╠═dff6d995-3753-4c70-b286-dd5aaf7f6461
# ╟─54d17292-195e-4ad4-8848-c725d1cbf8bf
# ╠═e133dab4-f9fe-47ed-a9a5-2644c1a954c9
# ╠═69016fc2-4249-4ce8-9d02-4371ba4ac6d7
# ╠═d5713d68-6413-4873-9d40-d8a5134ceb3d
# ╟─60d2fab0-9951-48b1-a9e4-81ff10b1bf40
# ╠═dcef3495-9a8b-4e7f-bbda-865cac3e894e
# ╠═5cabfc3e-54a1-40aa-8979-bc5cc10d2ffd
# ╠═53191664-ec06-441c-b1ee-5ee8034c4984
# ╠═9ab1ba2b-30fd-4cca-be25-3090608d18be
# ╠═a4ea64d4-57f3-4d43-9083-3e52b8e213d7
# ╠═d6143ca0-ba0e-406a-8b3f-fbcd348777bb
# ╠═2a85afb0-a3e8-477b-bc9b-e97701c40eae

src/Module C - Applications/L16 Principal Component Analysis.jl


using Test, MLToolkit
using Distributions: Beta

dims = (10, 5)

@testset "Activations" begin
    @testset "break_stick_ibp" begin
        ν = ones(2, 3) ./ 2
        π = break_stick_ibp(ν)
        @test π ≈ [0.5 0.5 0.5; 0.25 0.25 0.25]
    end
    @testset "break_logstick_ibp" begin
        for _ = 1:10
            ν = rand(Beta(2, 1), dims...)
            logν = log.(ν)
            @test all(log.(break_stick_ibp(ν)) .≈ break_logstick_ibp(logν))
        end
    end
end