# ------------------------------------------------------------------
# Copyright (c) 2017, Júlio Hoffimann Mendes <juliohm@stanford.edu>
# Licensed under the ISC License. See LICENCE in the project root.
# ------------------------------------------------------------------

"""
    Ellipsoidal(semiaxes, angles)

A distance defined by an ellipsoid with given `semiaxes` and rotation `angles`.

- For 2D ellipsoids, there are two semiaxes and one rotation angle.
- For 3D ellipsoids, there are three semiaxes and three rotation angles.

## Examples

2D ellipsoid making 45ᵒ with the horizontal axis:

```julia
julia> Ellipsoidal([1.0,0.5], [π/2])
```

3D ellipsoid rotated by 45ᵒ in the xy plane:

```julia
julia> Ellipsoidal([1.0,0.5,0.5], [π/2,0.0,0.0])
```
"""
struct Ellipsoidal{N,T} <: Metric
  dist::Mahalanobis{T}

  function Ellipsoidal{N,T}(semiaxes, angles) where {N,T<:Real}
    @assert length(semiaxes) == N "number of semiaxes must match spatial dimension"
    @assert all(semiaxes .> zero(T)) "semiaxes must be positive"
    @assert N ∈ [2,3] "dimension must be either 2 or 3"

    # scaling matrix
    Λ = Diagonal(one(T)./semiaxes.^2)

    # rotation matrix
    if N == 2
      θ = angles[1]

      cosθ = cos(θ)
      sinθ = sin(θ)

      P = [cosθ -sinθ
           sinθ  cosθ]
    end
    if N == 3
      θxy, θyz, θzx = angles

      cosxy = cos(θxy)
      sinxy = sin(θxy)
      cosyz = cos(θyz)
      sinyz = sin(θyz)
      coszx = cos(θzx)
      sinzx = sin(θzx)

      _1 = one(T)
      _0 = zero(T)

      Rxy = [cosxy -sinxy _0
             sinxy  cosxy _0
             _0     _0 _1]

      Ryz = [_1    _0     _0
             _0 cosyz -sinyz
             _0 sinyz  cosyz]

      Rzx = [ coszx _0 sinzx
             _0 _1    _0
             -sinzx _0 coszx]

      P = Rzx*Ryz*Rxy
    end

    # ellipsoid matrix
    Q = P*Λ*P'

    new(Mahalanobis(Q))
  end
end

Ellipsoidal(semiaxes::AbstractVector{T}, angles::AbstractVector{T}) where {T<:Real} =
  Ellipsoidal{length(semiaxes),T}(semiaxes, angles)

function Distances.evaluate(dist::Ellipsoidal{N,T}, a::AbstractVector, b::AbstractVector) where {N,T<:Real}
  evaluate(dist.dist, a, b)
end


using GeometryTypes
using SurfaceTopology
using LinearAlgebra

function quadraticform(vects,vnormal)

    Lx = [0 0 0; 0 0 -1; 0 1 0]
    Ly = [0 0 1; 0 0 0; -1 0 0]
    Lz = [0 -1 0; 1 0 0; 0 0 0]

    d = [0,0,1] + vnormal
    d /= norm(d)

    Ln = d[1]*Lx + d[2]*Ly + d[3]*Lz
    R = exp(pi*Ln)

    vects = copy(vects)
    for vj in 1:length(vects)
        vects[vj] = R*vects[vj]
    end

    ### Construction of the system
    A = Array{Float64}(undef,3,3)
    B = Array{Float64}(undef,3)

    vects_norm2 = Array{Float64}(undef,length(vects))
    for vj in 1:length(vects)
       vects_norm2[vj] = norm(vects[vj])^2
    end

    A[1,1] = sum((v[1]^4 for v in vects) ./ vects_norm2)
    A[1,2] = sum((v[1]^3*v[2] for v in vects) ./ vects_norm2)
    A[1,3] = sum((v[1]^2*v[2]^2 for v in vects) ./ vects_norm2)
    A[2,1] = A[1,2]
    A[2,2] = A[1,3]
    A[2,3] = sum( (v[2]^3*v[1] for v in vects) ./vects_norm2)
    A[3,1] = A[1,3]
    A[3,2] = A[2,3]
    A[3,3] = sum((v[2]^4 for v in vects) ./vects_norm2)

    B[1] = sum((v[3]*v[1]^2 for v in vects) ./vects_norm2)
    B[2] = sum((v[1]*v[2]*v[3] for v in vects) ./vects_norm2)
    B[3] = sum((v[2]^2*v[3] for v in vects) ./vects_norm2)

    C,D,E = A\B
    return C,D,E
end

function meancurvature(points,topology)
    curvatures = Array{Float64}(undef,length(points))
    for v in 1:length(points)

        s = Point(0,0,0)
        for (v1,v2) in EdgeRing(v,topology)
            s += cross(points[v2],points[v1])
        end
        normal = s ./ norm(s)

        vring = collect(VertexRing(v,topology))
        vects = [points[vi] - points[v] for vi in vring]

        C,D,E = quadraticform(vects,normal)

        A = [C D/2;D/2 E]
        k1,k2 = eigvals(-A)
        H = (k1 + k2)/2

        curvatures[v] = H
    end
    return curvatures
end

### Testing
t = ( 1 + sqrt( 5 ) ) / 2;

vertices = Point{3,Float64}[
    [ -1,  t,  0 ], [  1, t, 0 ], [ -1, -t,  0 ], [  1, -t,  0 ],
    [  0, -1,  t ], [  0, 1, t ], [  0, -1, -t ], [  0,  1, -t ],
    [  t,  0, -1 ], [  t, 0, 1 ], [ -t,  0, -1 ], [ -t,  0,  1 ]
] ./ sqrt(1 + t^2)

faces = Face{3,Int64}[
    [1, 12, 6], [1, 6, 2], [1, 2, 8], [1, 8, 11], [1, 11, 12], [2, 6, 10], [6, 12, 5],
    [12, 11, 3], [11, 8, 7], [8, 2, 9], [4, 10, 5], [4, 5, 3], [4, 3, 7], [4, 7, 9],
    [4, 9, 10], [5, 10, 6], [3, 5, 12], [7, 3, 11], [9, 7, 8], [10, 9, 2]
]

### As paraboloid grows faster than sphere the estimated curvature for a coarse mesh would be lower
curvatures = meancurvature(vertices,faces)


#===============================================================================

Using all of the digits 1 through 9 and concatenating them freely to form
decimal integers, different sets can be formed. Interestingly with the set
{2,5,47,89,631}, all of the elements belonging to it are prime.

How many distinct sets containing each of the digits one through nine exactly
once contain only prime elements?

--------------------------------------------------------------------------------

The algorithm proposed is based on the association of a number to its digits.

Let n=d1...dn be a number made of n digits. Then

    encode(n) = 0 if n contains 0 or if a digit appears multiple times.
              = (Σ 2^di)/2

The division by 2 results from the fact the 0 is not allowed, so Σ 2^di is
always odd. Thus the range of encode(n) is 1 to 511 (9 bits set to 1).

Each prime up to 987654321 are encoded as explained above, and each code is
associated with the number of primes it corresponds to, excepted for primes
encoded as 0, which are discarded.

A similar code is also associated to a set of primes, by computing it over all
the digits of all the primes belonging to the set.

With this, a prime p can be added to the set S if encode(p) and encode(S) have
no digits in common, i.e. if encode(p) & encode(S) is null. The code of the new
set is encode(p) | encode(S).

Of course, this applies to all primes whose code is the same as encode(p).

Then the solution is built by exploring recursively the tree of the
possibilities.

===============================================================================#

import Primes

function encode(n::Int)
    result::UInt16 = 0

    while (n != 0)
        n, digit = divrem(n, 10)

        bit = 1 << digit

        if (digit == 0 || result & bit != 0)
            return 0
        end

        result |= bit
    end

    result >> 1
end

primes = Primes.primes(1, 987654321);

function compute_codes(primes)
    result = zeros(Int64, 511)

    for p in primes
        code = encode(p)
        if code != 0
            result[code] += 1
        end
    end

    result;
end

const allcodes = compute_codes(primes)

const fullcode = encode(123456789)

function compute_nbr_sets(code_idx, code_of_set, nbr_of_prime_sets)

    if code_of_set == fullcode
        return nbr_of_prime_sets
    end

    if code_idx == 512
        return 0
    end

    result = compute_nbr_sets(code_idx+1, code_of_set, nbr_of_prime_sets);

    nbr_assoc_primes = allcodes[code_idx]

    if nbr_assoc_primes != 0 && code_of_set & code_idx == 0
        result += compute_nbr_sets(code_idx+1,
                                   code_of_set|code_idx,
                                   nbr_assoc_primes * nbr_of_prime_sets)
    end

    result
end

println("Euler 118: ", compute_nbr_sets(1, 0, 1));


"""
    heapify(array::Array{Int64,1})

The heapify function merges the two subroutines for:
    1) Put elements of the array in heap order
    2) Repair the heap elements `i` whose root element, if is not at the index `largest`
For more information see: https://en.wikipedia.org/wiki/Heapsort

# Arguments
- `array::Array{Int64,1}`: Unsorted array of integers
- `n::Int64`: Length of the array
- `i::Int64`: Current index of the array

"""
function heapify(array::Array{Int64,1}, n::Int64, i::Int64)
    # Initialize largest as root and left and right subarrays
    largest = i
    # Julia notations, which starts with 1
    left = 2 * i
    right = 2 * i + 1

    # See if left child of root exists and is greater than root
    if left <= n && array[i] < array[left]
        largest = left
    end
    # See if right child of root exists and is greater than root
    if right <= n && array[largest] < array[right]
        largest = right
    end
    # Change root, if needed
    if largest != i
        array[i], array[largest] = array[largest], array[i]
        # Heapify the root again
        array = heapify(array, n, largest)
    end
    return array
end

"""
    heap_sorting(array::Array{Int64,1})

As a comparison-based sorting algorithm, the heapsort algorithm (HSA) divides its input
into a sorted and an unsorted region, and it iteratively shrinks the unsorted region by
extracting the largest element from it and inserting it into the sorted region. A specialty
is that the HSA keeps the unsorted region in a heap data structure to find the largest
element in each step more quickly. In more detail, in the first part of the HSA
(while-loop), the largest value has to be found and set to position one. In the second part
of the HSA (while-loop), the array's first and largest value has to be swap to the last
index of the array, and the swapping-procedure starts again for a new interval n-1. For
more information see: [https://en.wikipedia.org/wiki/Heapsort](https://en.wikipedia.org/wiki/Heapsort)

# Arguments
- `array::Array{Int64,1}`: Unsorted array of integers

# Examples
```julia-repl
julia> import ClassicAlgorithmsCollections
julia> arr = [64, 34, 25, 12, 22, 11, 90]
julia> ClassicAlgorithmsCollections.heap_sorting(arr)
[11, 12, 22, 25, 34, 64, 90]
```
"""
function heap_sorting(array::Array{Int64,1})
    # Base case. A array of zero or one elements is sorted, by definition.
    n = length(array)

    # Shrink the active space
    i = fld(n, 2)
    # Build a maxheap
    while i > 0
        array = heapify(array, n, i)
        i -= 1

    end

    # One by one extract elements
    i = n
    while i > 1
        array[i], array[1] = array[1], array[i]
        # Julia specific reducing effectiv index
        array = heapify(array, i - 1, 1)
        i -= 1
    end

    return array
end


##  Eratosthenes' prime number sieve
function primesieve(n::Int64)
    if n <= 1
        return Integer[]
    end

    p = [i for i in 1:2:n]
    q = length(p)
    p[1] = 2
    if n >= 9
        for k in 3:2:isqrt(n)
            if p[(k+1)÷2] != 0
                p[(k*k+1).÷2:k:q] .= 0
            end
        end
    end

    return p[p .> 0]
end

##  Find all prime numbers in  a given interval
function primes2(n::Int64, m::Int64)
    if n > m
        error("Argument 'm' must be bigger than 'n'.")
    end
    if m <= 1000
        P = primesieve(m)
        return P[P .>= n]
    end

    myPrimes = primesieve(isqrt(m))
    N = [n:m]
    l = length(N)  # m-n+1
    A = zeros(Int8, l)
    if n == 1
        A[1] = -1
    end

    for p in myPrimes
        r = n % p
        if r == 0
            i = 1
        else
            i = p - r + 1
        end
        if i <= l && N[i] == p
            i = i + p
        end
        while i <= l
            A[i] = 1
            i = i + p
        end
    end
    return N[A .== 0]
end

##  Return unique prime factors of n sorted
function primefactors(n::Int64)
    if n <= 0
        error("Argument 'n' to be factored must be a positive integer.")
    end

    f = Primes.factor(n)
    return sort(collect(keys(f)))
end

##  Find prime number following n
function nextprime2(n::Int64)
    if n <= 1; return 2; end
    if n == 2; return 3; end
    if iseven(n)
        n += 1
    else
        n += 2
    end
    if isprime(n); return(n); end

    if mod(n, 3) == 1
        a = 4; b = 2
    elseif mod(n, 3) == 2
        a = 2; b = 4
    else
        n += 2
        a = 2; b = 4
    end

    p = n
    while !isprime(p)
        p += a
        if isprime(p); break; end
        p += b
    end

    return p
end

## Find prime number preceeding n
function prevprime2(n::Int64)
    if n <= 2
        return Array(typeof(n), 0)
    elseif n <= 3
        return 2
    end

    if iseven(n)
        n -= 1
    else
        n -= 2
    end
    if isprime(n); return n; end

    if mod(n, 3) == 1
        a = 2; b = 4
    elseif mod(n, 3) == 2
        a = 4; b = 2
    else
        n -= 2
        a = 2; b = 4
    end

    p = n
    while !isprime(p)
        p -= a
        if isprime(p); break; end
        p -= b
    end

    return p
end

##  Find all twin primes
function twinprimes(n::Int64, m::Int64)
    P = primes2(n, m)
    inds = findall(diff(P) .== 2)

    return hcat(P[inds], P[inds.+1])
end

##  Coprimality
function coprime(n::Int64, m::Int64)
    if n == 0 && m == 0
        return false
    end

    if gcd(n, m) > 1
        false
    else
        true
    end
end

##  Solve linear modulo equations
function linmod(a::Int64, b::Int64, m::Int64)
    m > 1 || error("Argument 'm' must be an integer greater 1")
    T = typeof(m)
    g, e, f = gcdx(a, m)

    x = T[]
    if mod(b, g) == 0
        x0 = mod(e * div(b, g), m)
        for i = 0:(g-1)
            x = [x, mod(x0 + i * div(m, g) , m)]
        end
    end

    return x
end

##  Order of the element n (in the ring) modulo m
function ordermod(n::Int64, m::Int64)
    if n <= 0 || m <= 0
        error("Arguments 'n' and 'm' must be positive integers.")
    end
    if m == 1 || gcd(n, m) > 1; return 0; end
    if n == 1; return 1; end

    r = mod(n, m)
    if r == 0; return 0; end

    k = 1
    while r != 1
        r = mod(n*r, m)
        k += 1
    end

    return k
end

##  Find a primitive root modulo m
function primroot(m::Int64)
    if !isprime(m)
        error("Argument 'm' must be a prime number")
    end
    if m == 2; return 1; end

    P = primefactors(m-1)
    for r = 2:(m-1)
        not_found = true
        for p in P
            if powermod(r, div(m-1, p), m) == 1
                not_found = false
            end
        end
        if not_found
            return r
        end
    end

    return 0
end

##  Euler's Phi (or: totient) function
function eulerphi(n::Int64)
    if n <= 0
        error("Argument 'n' must be a (positive) natural number.")
    end

    m = n
    for p in primefactors(n)    # must be unique
        m = m - div(m, p)       # m = m * (1 - 1/p)
    end

    return Integer(round(m))
end


# This program solves the Laplace-Beltrami PDE on a unit sphere.
# In strong form, the problem can be stated as:
# find u s.t.
#   -Δ_S(u) = f on \Omega
# Where Δ_S is the spherical Laplacian defined as Δ_S = ∇_S⋅(∇_S(u)),
# with ∇_S() and  ∇_S⋅ being the spherical gradient and spherical
# divergence, resp.

# Given a known analytical solution u(x), the program manufactures f(x)
# by applying -Δ_S to u, and then performs an error convergence analysis.
# For the discretization of the sphere, it uses the so-called cubed sphere
# mesh

function u(x)
  sin(π*x[1])*cos(π*x[2])*exp(x[3])
end
function uθϕ(θϕ)
  u(θϕ2xyz(θϕ))
end
function f(x)
  -(laplacian_unit_sphere(uθϕ)(xyz2θϕ(x)))
end
function Gridap.∇(::typeof(u))
  gradient_unit_sphere(uθϕ)
end

function solve_laplace_beltrami(model,order,degree,ls=BackslashSolver())
    V = FESpace(model,ReferenceFE(lagrangian,Float64,order); conformity=:H1)
    U = TrialFESpace(V)

    Ω = Triangulation(model)
    dΩ = Measure(Ω,degree)

    a(u,v) = ∫(∇(v)⋅∇(u))dΩ
    b(v)   = ∫(v*f)dΩ

    op = AffineFEOperator(a,b,U,V)
    fels = LinearFESolver(ls)
    uh = solve(fels,op)

    e=u-uh
    ∇e = ∇(uh)-∇(u)∘xyz2θϕ

    # H1-norm
    # sqrt(sum(∫( e*e + (∇e)⋅(∇e) )dΩ))
    sqrt(sum(∫( (∇e)⋅(∇e) )dΩ))#,uh
end


#=
  Two children problem in Turing.jl

  https://robeastaway.com/blog/boy-girl
  """
  I have two children, at least one of whom is a boy.
  What is the chance that the second child is also a boy?

  ...

  The classic, surprising answer is that the chance of a second
  boy is 1/3, not 1/2 as most would expect.  Why?  Because if I
  have two children, there is an equal chance that they will be
  Boy-Boy, Boy-Girl, Girl-Boy or Girl-Girl.  There are three
  equally likely combinations in which at least one child is
  a boy (BB, BG and GB) and only in the first scenario is the
  other child also a boy.
  """

  We assume the inital probability of a boy/girl as 0.5.

  Here we model two similiar but different problems to show
  the difference between these two views of the problem.

  Cf ~/webppl/two_children_problem.wppl

=#

using Turing
include("jl_utils.jl")

#=
  First model:
  """
  I have two children, _at least one of whom_ is a boy.
  What is the chance that the second child is also a boy?
  """

  Probability of 2 boys: 1/3.
  Probability of 1 boy and 1 girl: 2/3.

  Distributions of variable twoBoys (num:0)
  0.00000 =>    6601  (0.660100)
  1.00000 =>    3399  (0.339900)

  Distributions of variable oneBoyOneGirl (num:0)
  1.00000 =>    6601  (0.660100)
  0.00000 =>    3399  (0.339900)

=#
@model function two_children_problem_1()
    boy = 1
    girl = 2

    child1 ~ Categorical([0.5,0.5])
    child2 ~ Categorical([0.5,0.5])

    # Note: it's important that we state the condition
    #   "at least one of whom is a boy"
    # as something like this.
    true ~ Dirac((child1 == boy) + (child2 == boy) >= 1)

    twoBoys ~ Dirac((child1 == boy) + (child2 == boy) == 2)
    oneBoyOneGirl ~ Dirac((child1 == boy) + (child2 == boy) == 1)

end

println("\nModel 1")
model = two_children_problem_1()
# chns = sample(model, Prior(), 10_000)
# chns = sample(model, MH(), 10_000)
chns = sample(model, PG(5), 10_000)
# chns = sample(model, IS(), 10_000)
# chns = sample(model, SMC(), 10_000)
# chns = sample(model, NUTS(), 10_000)
# chns = sample(model, HMC(0.1,10), 10_000)

# display(chns)
show_var_dist_pct(chns,:twoBoys)
show_var_dist_pct(chns,:oneBoyOneGirl)

#=
 Second model:
  """
  I have two children, the eldest is a boy.
  What is the chance that the second child is also a boy?
  """

  Probability that the second child is also a boy: 1/2
  Probability that the second child is a girl: 1/2

  Distributions of variable twoBoys (num:0)
  0.00000 =>    5067  (0.506700)
  1.00000 =>    4933  (0.493300)
  Distributions of variable oneBoyOneGirl (num:0)
  1.00000 =>    5067  (0.506700)
  0.00000 =>    4933  (0.493300)

=#
@model function two_children_problem_2()
    boy = 1
    girl = 2

    child1 ~ Categorical([0.5,0.5])
    child2 ~ Categorical([0.5,0.5])

    # "The eldest is a boy"
    true ~ Dirac(child1 == boy)

    twoBoys ~ Dirac((child1 == boy) + (child2 == boy) == 2)
    oneBoyOneGirl ~ Dirac((child1 == boy) + (child2 == boy) == 1)

end

println("\nModel 2")
model = two_children_problem_2()
# chns = sample(model, Prior(), 10_000)
# chns = sample(model, MH(), 10_000)
chns = sample(model, PG(5), 10_000)
# chns = sample(model, IS(), 10_000)
# chns = sample(model, SMC(), 10_000)
# chns = sample(model, NUTS(), 10_000)
# chns = sample(model, HMC(0.1,10), 10_000)

# display(chns)
show_var_dist_pct(chns,:twoBoys)
show_var_dist_pct(chns,:oneBoyOneGirl)


"""
Discrete Laplacian in d dimensions and n equidistant discretization points in each direction
"""
function Lap(n::Integer,d::Integer) #returns the tensor of the discrete Laplacian in a box [0,1]^d with n equidistant discretization points in each direction
    A = zeros(n^d,n^d)
    for j in 0:n^d-1
        J = digits(j,base=n,pad=d) #corresponding index as d-tuples
        for k in 0:d-1
            if J[k+1]==0
                A[j+1,j+1] = 2*d
                A[j+1,j+n^k+1] = -1
            elseif J[k+1]==n-1
                A[j+1,j+1] = 2*d
                A[j+1,j-n^k+1] = -1
            else
                A[j+1,j+1] = 2*d
                A[j+1,j-n^k+1] = -1
                A[j+1,j+n^k+1] = -1
            end
        end
    end
    return A
end


"""
    legendre(x, b)

Compute Legendre polynomials.

Legendre polynomials are Jacobi polynomials with parameters a and b equals to zero.

Same interface as `jacobi`. `dlegendre` computes the derivative of the Legendre
polynomial.

# Example
```julia-repl
julia> x = legendre(0.4, 5)
0.27063999999999994

julia> x = legendre(2//5, 5)
3383//12500

julia> x = dlegendre(0.4, 5)
-1.3170000000000002

julia> x = dlegendre(2//5, 5)
-1317//1000
```
"""
function legendre(x, n)

    if n==0
        return one(x)
    elseif n==1
        return(x)
    end

    p0 = one(x)
    p1 = x

    for i = 2:n
        p2 = ( (2i-1)*x*p1 - (i-1)*p0 ) / i
        p0 = p1
        p1 = p2
    end

    return p1
end

dlegendre(x, n) = djacobi(x, n)

legendre_zeros(m) = jacobi_zeros(m)

@doc (@doc legendre) dlegendre
@doc (@doc jacobi_zeros!) legendre_zeros


"""
`prepare_interpolation(nodes::Matrix{T}, kernel::RK = RK_H0()) where {T <: AbstractFloat, RK <: ReproducingKernel_0}`

Prepare the interpolating normal spline by constructing and factoring Gram matrix of the problem.
Initialize the `NormalSpline` object.
# Arguments
- `nodes`: function value interpolation nodes.
           This should be an `n×n_1` matrix, where `n` is dimension of the sampled space and
           `n_1` is the number of function value nodes. It means that each column in the matrix defines one node.
- `kernel`: reproducing kernel of Bessel potential space the normal spline is constructed in.
            It must be a struct object of the following type:
              `RK_H0` if the spline is constructing as a continuous function,
              `RK_H1` if the spline is constructing as a differentiable function,
              `RK_H2` if the spline is constructing as a twice differentiable function.

Return: prepared `NormalSpline` object.
"""
function prepare_interpolation(nodes::Matrix{T},
                               kernel::RK = RK_H0()
                              ) where {T <: AbstractFloat, RK <: ReproducingKernel_0}
     spline = _prepare_interpolation(nodes, kernel)
     return spline
end

"""
`construct_interpolation(spline::NormalSpline{T, RK}, values::Vector{T}) where {T <: AbstractFloat, RK <: ReproducingKernel_0}`

Construct the interpolating normal spline by calculating its coefficients and
completely initializing the `NormalSpline` object.
# Arguments
- `spline`: the prepared `NormalSpline` object.
- `values`: function values at interpolation nodes.

Return: constructed `NormalSpline` object.
"""
function construct_interpolation(spline::NormalSpline{T, RK},
                                 values::Vector{T}
                                ) where {T <: AbstractFloat, RK <: ReproducingKernel_0}
    spline = _construct_interpolation(spline, values)
    return spline
end

"""
`interpolate(nodes::Matrix{T}, values::Vector{T}, kernel::RK = RK_H0()) where {T <: AbstractFloat, RK <: ReproducingKernel_0}`

Prepare and construct the interpolating normal spline.
# Arguments
- `nodes`: function value interpolation nodes.
           This should be an `n×n_1` matrix, where `n` is dimension of the sampled space
           and `n_1` is the number of function value nodes.
           It means that each column in the matrix defines one node.
- `values`: function values at interpolation nodes.
- `kernel`: reproducing kernel of Bessel potential space the normal spline is constructed in.
            It must be a struct object of the following type:
              `RK_H0` if the spline is constructing as a continuous function,
              `RK_H1` if the spline is constructing as a differentiable function,
              `RK_H2` if the spline is constructing as a twice differentiable function.
Return: constructed `NormalSpline` object.
"""
function interpolate(nodes::Matrix{T},
                     values::Vector{T},
                     kernel::RK = RK_H0()
                    ) where {T <: AbstractFloat, RK <: ReproducingKernel_0}
     spline = _prepare_interpolation(nodes, kernel)
     spline = _construct_interpolation(spline, values)
     return spline
end

########

"""
`prepare_interpolation(nodes::Matrix{T}, d_nodes::Matrix{T}, es::Matrix{T}, kernel::RK = RK_H1())
                       where {T <: AbstractFloat, RK <: ReproducingKernel_1}`

Prepare the spline by constructing and factoring a Gram matrix of the interpolation problem.
Initialize the `NormalSpline` object.
# Arguments
- `nodes`: function value interpolation nodes.
           This should be an `n×n_1` matrix, where `n` is dimension of the sampled space and
           `n_1` is the number of function value nodes.
            It means that each column in the matrix defines one node.
- `d_nodes`: function directional derivatives nodes.
             This should be an `n×n_2` matrix, where `n` is dimension of the sampled space and
             `n_2` is the number of function directional derivative nodes.
- `es`: Directions of the function directional derivatives.
        This should be an `n×n_2` matrix, where `n` is dimension of the sampled space and
        `n_2` is the number of function directional derivative nodes.
        It means that each column in the matrix defines one direction of the function directional derivative.
- `kernel`: reproducing kernel of Bessel potential space the normal spline is constructed in.
            It must be a struct object of the following type:
              `RK_H1` if the spline is constructing as a differentiable function,
              `RK_H2` if the spline is constructing as a twice differentiable function.

Return: prepared `NormalSpline` object.
"""
function prepare_interpolation(nodes::Matrix{T},
                               d_nodes::Matrix{T},
                               es::Matrix{T},
                               kernel::RK = RK_H1()
                              ) where {T <: AbstractFloat, RK <: ReproducingKernel_1}
     spline = _prepare_interpolation(nodes, d_nodes, es, kernel)
     return spline
end

"""
`construct_interpolation(spline::NormalSpline{T, RK}, values::Vector{T}, d_values::Vector{T})
                         where {T <: AbstractFloat, RK <: ReproducingKernel_1}`

Construct the interpolating normal spline by calculating its coefficients and
completely initializing the `NormalSpline` object.
# Arguments
- `spline`: the prepared `NormalSpline` object.
- `values`: function values at interpolation nodes.
- `d_values`: function directional derivative values at function derivative nodes.

Return: constructed `NormalSpline` object.
"""
function construct_interpolation(spline::NormalSpline{T, RK},
                                 values::Vector{T},
                                 d_values::Vector{T}
                                ) where {T <: AbstractFloat, RK <: ReproducingKernel_1}
     spline = _construct_interpolation(spline, values, d_values)
     return spline
end

"""
`interpolate(nodes::Matrix{T}, values::Vector{T}, d_nodes::Matrix{T}, es::Matrix{T}, d_values::Vector{T}, kernel::RK = RK_H1())
             where {T <: AbstractFloat, RK <: ReproducingKernel_1}`

Prepare and construct the interpolating normal spline.
# Arguments
- `nodes`: function value interpolation nodes.
           This should be an `n×n_1` matrix, where `n` is dimension of the sampled space
           and `n_1` is the number of function value nodes.
           It means that each column in the matrix defines one node.
- `values`: function values at interpolation nodes.
- `d_nodes`: function directional derivative nodes.
            This should be an `n×n_2` matrix, where `n` is dimension of the sampled space and
            `n_2` is the number of function directional derivative nodes.
- `es`: Directions of the function directional derivatives.
       This should be an `n×n_2` matrix, where `n` is dimension of the sampled space and
       `n_2` is the number of function directional derivative nodes.
       It means that each column in the matrix defines one direction of the function directional derivative.
- `d_values`: function directional derivative values at function derivative nodes.
- `kernel`: reproducing kernel of Bessel potential space the normal spline is constructed in.
            It must be a struct object of the following type:
              `RK_H1` if the spline is constructing as a differentiable function,
              `RK_H2` if the spline is constructing as a twice differentiable function.

Return: constructed `NormalSpline` object.
"""
function interpolate(nodes::Matrix{T},
                     values::Vector{T},
                     d_nodes::Matrix{T},
                     es::Matrix{T},
                     d_values::Vector{T},
                     kernel::RK = RK_H1()
                    ) where {T <: AbstractFloat, RK <: ReproducingKernel_1}
     spline = _prepare_interpolation(nodes, d_nodes, es, kernel)
     spline = _construct_interpolation(spline, values, d_values)
     return spline
end

############################## One-dimensional case

"""
`prepare_interpolation(nodes::Vector{T}, kernel::RK = RK_H0()) where {T <: AbstractFloat, RK <: ReproducingKernel_0}`

Prepare the 1D interpolating normal spline by constructing and factoring a Gram matrix of the problem.
Initialize the `NormalSpline` object.
# Arguments
- `nodes`: function value interpolation nodes.
           This should be an `n_1` vector where `n_1` is the number of function value nodes.
- `kernel`: reproducing kernel of Bessel potential space the normal spline is constructed in.
            It must be a struct object of the following type:
              `RK_H0` if the spline is constructing as a continuous function,
              `RK_H1` if the spline is constructing as a differentiable function,
              `RK_H2` if the spline is constructing as a twice differentiable function.

Return: prepared `NormalSpline` object.
"""
function prepare_interpolation(nodes::Vector{T},
                               kernel::RK = RK_H0()
                              ) where {T <: AbstractFloat, RK <: ReproducingKernel_0}
     spline = _prepare_interpolation(Matrix(nodes'), kernel)
     return spline
end

"""
`interpolate(nodes::Vector{T}, values::Vector{T}, kernel::RK = RK_H0()) where {T <: AbstractFloat, RK <: ReproducingKernel_0}`

Prepare and construct the 1D interpolating normal spline.
# Arguments
- `nodes`: function value interpolation nodes.
           This should be an `n_1` vector where `n_1` is the number of function value nodes.
- `values`: function values at `n_1` interpolation nodes.
- `kernel`: reproducing kernel of Bessel potential space the normal spline is constructed in.
            It must be a struct object of the following type:
              `RK_H0` if the spline is constructing as a continuous function,
              `RK_H1` if the spline is constructing as a differentiable function,
              `RK_H2` if the spline is constructing as a twice differentiable function.

Return: constructed `NormalSpline` object.
"""
function interpolate(nodes::Vector{T},
                     values::Vector{T},
                     kernel::RK = RK_H0()
                    ) where {T <: AbstractFloat, RK <: ReproducingKernel_0}
     spline = _prepare_interpolation(Matrix(nodes'), kernel)
     spline = _construct_interpolation(spline, values)
     return spline
end

"""
`prepare_interpolation(nodes::Vector{T}, d_nodes::Vector{T}, kernel::RK = RK_H1()) where {T <: AbstractFloat, RK <: ReproducingKernel_1}`

Prepare the 1D interpolating normal spline by constructing and factoring a Gram matrix of the problem.
Initialize the `NormalSpline` object.
# Arguments
- `nodes`: function value interpolation nodes.
           This should be an `n_1` vector where `n_1` is the number of function value nodes.
- `d_nodes`: The function derivatives nodes.
             This should be an `n_2` vector where `n_2` is the number of function derivatives nodes.
- `kernel`: reproducing kernel of Bessel potential space the normal spline is constructed in.
            It must be a struct object of the following type:
              `RK_H1` if the spline is constructing as a differentiable function,
              `RK_H2` if the spline is constructing as a twice differentiable function.

Return: prepared `NormalSpline` object.
"""
function prepare_interpolation(nodes::Vector{T},
                               d_nodes::Vector{T},
                               kernel::RK = RK_H1()
                              ) where {T <: AbstractFloat, RK <: ReproducingKernel_1}

     es = ones(T, length(d_nodes))
     spline = _prepare_interpolation(Matrix(nodes'), Matrix(d_nodes'), Matrix(es'), kernel)
     return spline
end

"""
`interpolate(nodes::Vector{T}, values::Vector{T}, d_nodes::Vector{T}, d_values::Vector{T},
             kernel::RK = RK_H1())
             where {T <: AbstractFloat, RK <: ReproducingKernel_1}`

prepare_interpolation and construct the 1D interpolating normal spline.
# Arguments
- `nodes`: function value interpolation nodes.
           This should be an `n_1` vector where `n_1` is the number of function value nodes.
- `values`: function values at `nodes` nodes.
- `d_nodes`: The function derivatives nodes.
             This should be an `n_2` vector where `n_2` is the number of function derivatives nodes.
- `d_values`: function derivative values at function derivative nodes.
- `kernel`: reproducing kernel of Bessel potential space the normal spline is constructed in.
            It must be a struct object of the following type:
              `RK_H1` if the spline is constructing as a differentiable function,
              `RK_H2` if the spline is constructing as a twice differentiable function.

Return: constructed `NormalSpline` object.
"""
function interpolate(nodes::Vector{T},
                     values::Vector{T},
                     d_nodes::Vector{T},
                     d_values::Vector{T},
                     kernel::RK = RK_H1()
                    ) where {T <: AbstractFloat, RK <: ReproducingKernel_1}
     es = ones(T, length(d_nodes))
     spline = _prepare_interpolation(Matrix(nodes'), Matrix(d_nodes'), Matrix(es'), kernel)
     spline = _construct_interpolation(spline, values, d_values)
     return spline
end


using Pkg
Pkg.activate(pwd())

# # Linear regression
# ## Loading and preparing data

using Plots
using StatsPlots
using RDatasets

iris = dataset("datasets", "iris")
iris[1:5,:]

# ### Exercise:
# We will simplify the goal and estimate the dependence of petal width on petal length. # Create the data $X$ (do not forget to add the bias) and the labels $y$.
#
# Make a graph of the dependence of petal width on petal length.
#
# ---
# ### Solution:

# ---
#
# ## Training the classifier
# ### Exercise:
# Use the closed-form formula to get the coefficients $w$ for the linear regression. Then
# use the `optim` method derived in the previous lecture to solve the optimization problem
# via gradient descent. The results should be identical.
#
#---
#### Solution:

abstract type Step end

struct GD <: Step
    α::Real
end

optim_step(s::GD, f, g, x) = -s.α*g(x)

function optim(f, g, x, s::Step; max_iter=100)
    for i in 1:max_iter
        x += optim_step(s, f, g, x)
    end
    return x
end

# ---
#
# ### Exercise:
# Write the dependence on the petal width on the petal length. Plot it in the previous
# graph.
#
# ---
# ### Solution:


#=

# 107: 1D Nonlinear Storage
([source code](SOURCE_URL))

This equation comes from the transformation of the nonlinear diffuision equation.
```math
\partial_t u^\frac{1}{m} -\Delta u = 0
```
in $\Omega=(-1,1)$ with homogeneous Neumann boundary conditions.
We can derive an exact solution from the Barenblatt solution of the previous
example.

=#

module Example107_NonlinearStorage1D
using Printf
using VoronoiFVM
using ExtendableGrids
using GridVisualize

function barenblatt(x,t,m)
    tx=t^(-1.0/(m+1.0))
    xx=x*tx
    xx=xx*xx
    xx=1- xx*(m-1)/(2.0*m*(m+1));
    if xx<0.0
        xx=0.0
    end
    return tx*xx^(1.0/(m-1.0))
end

function main(;n=20,m=2.0,Plotter=nothing,verbose=false, unknown_storage=:sparse,tend=0.01,tstep=0.0001)

    ## Create a one-dimensional discretization
    h=1.0/convert(Float64,n/2)
    X=collect(-1:h:1)
    grid=VoronoiFVM.Grid(X)

    ## Flux function which describes the flux
    ## between neigboring control volumes
    function flux!(f,u0,edge)
        u=unknowns(edge,u0)
        f[1]=u[1,1]-u[1,2]
    end

    ϵ=1.0e-10

    ## Storage term
    ## This needs to be regularized as its derivative
    ## at 0 is infinity
    function storage!(f,u,node)
        f[1]=(ϵ+u[1])^(1.0/m)
    end

    ## Create a physics structure
    physics=VoronoiFVM.Physics(
        flux=flux!,
        storage=storage!)

    ## Create a finite volume system - either
    ## in the dense or  the sparse version.
    ## The difference is in the way the solution object
    ## is stored - as dense or as sparse matrix
    sys=VoronoiFVM.System(grid,physics,unknown_storage=unknown_storage)

    ## Add species 1 to region 1
    enable_species!(sys,1,[1])

    ## Create a solution array
    inival=unknowns(sys)
    solution=unknowns(sys)
    t0=0.001

    ## Broadcast the initial value
    inival[1,:].=map(x->barenblatt(x,t0,m)^m,X)
    solution.=inival

    ## Create solver control info
    control=VoronoiFVM.NewtonControl()
    control.verbose=verbose
    time=t0
    p=GridVisualizer(Plotter=Plotter,layout=(2,1))
    while time<tend
        time=time+tstep
        solve!(solution,inival,sys,control=control,tstep=tstep)
        inival.=solution
        scalarplot!(p[1,1],grid,solution[1,:],title=@sprintf("numerical, t=%.5f",time),clear=true)
        scalarplot!(p[2,1],grid,map(x->barenblatt(x,time,m)^m,grid),title=@sprintf("exact, t=%.4f",time),clear=true)
        sleep(1.0e-5)
#        yield()
    end
    return sum(solution)
end

function test()
    testval=173.84998139534142
    main(unknown_storage=:sparse) ≈ testval && main(unknown_storage=:dense) ≈ testval
end

end


import Distributions: logpdf, DiscreteUnivariateDistribution

"""
Numerically stable Poisson log likelihood function. Accepts log of rate parameter.
"""
struct LogPoisson{T<:Real} <: DiscreteUnivariateDistribution
    logλ::T
end

function logpdf(lp::LogPoisson, k::Int)
    return k * lp.logλ - exp(lp.logλ) - loggamma(k + 1)
end

@model AHMCpoisson(y, x, idx, N, Ns) = begin
  a0 ~ Normal(0, 10)
  a1 ~ Normal(0, 1)
  a0_sig ~ Truncated(Cauchy(0, 1), 0.0, Inf)
  a0s ~ MvNormal(zeros(Ns), a0_sig)
  for i ∈ 1:N
    λ = a0 + a0s[idx[i]] + a1 * x[i]
    y[i] ~ LogPoisson(λ)
  end
end

AHMCconfig = Turing.NUTS(1000, .80)

function simulatePoisson(; Nd=1, Ns=10, a0=1.0, a1=.5, a0_sig=.3, kwargs...)
  N = Nd * Ns
  y = fill(0, N)
  x = fill(0.0, N)
  idx = similar(y)
  i = 0
  for s in 1:Ns
    a0s = rand(Normal(0, a0_sig))
    logpop = rand(Normal(9, 1.5))
    λ = exp(a0 + a0s + a1 * logpop)
    for nd in 1:Nd
      i += 1
      x[i] = logpop
      idx[i] = s
      y[i] = rand(Poisson(λ))
    end
  end
  return (y=y, x=x, idx=idx, N=N, Ns=Ns)
 end

CmdStanPoisson = "
data {
  int N;
  int y[N];
  int Ns;
  int idx[N];
  real x[N];
}
parameters {
  real a0;
  vector[Ns] a0s;
  real a1;
  real<lower=0> a0_sig;
}
model {
  vector[N] mu;
  a0 ~ normal(0, 10);
  a1 ~ normal(0, 1);
  a0_sig ~ cauchy(0, 1);
  a0s ~ normal(0, a0_sig);
  for(i in 1:N) mu[i] = exp(a0 + a0s[idx[i]] + a1 * x[i]);
  y ~ poisson(mu);
}
"

CmdStanConfig = Stanmodel(
  name="CmdStanPoisson", model=CmdStanPoisson, nchains=1, output_format=:mcmcchains,
  Sample(num_samples=1000, num_warmup=1000, adapt=CmdStan.Adapt(delta=0.8), save_warmup=true)
)

struct PoissonProb
  y::Array{Int64,1}
  x::Array{Float64,1}
  idx::Array{Int64,1}
  N::Int64
  Ns::Int64
end

function (problem::PoissonProb)(θ)
  @unpack y, x, idx, N, Ns = problem   # extract the data
  @unpack a0, a1, a0s, a0_sig = θ
  LL = 0.0
  LL += logpdf(Truncated(Cauchy(0, 1), 0.0, Inf), a0_sig)
  LL += sum(logpdf(MvNormal(zeros(Ns), a0_sig), a0s))
  LL += logpdf.(Normal(0, 10), a0)
  LL += logpdf.(Normal(0, 1), a1)
  for i in 1:N
    λ = a0 + a0s[idx[i]] + a1 * x[i]
    LL += logpdf(LogPoisson(λ), y[i])
  end
  return LL
end

# Define problem with data and inits.
function sampleDHMC(y, x, idx, N, Ns, nsamples, autodiff)
  p = PoissonProb(y, x, idx, N, Ns)
  p((a0=0.0, a1=0.0, a0s=fill(0.0, Ns), a0_sig=.3))
  # Write a function to return properly dimensioned transformation.
  trans = as((a0=asℝ, a1=asℝ, a0s=as(Array, Ns), a0_sig=asℝ₊))
  P = TransformedLogDensity(trans, p)
  ∇P = ADgradient(autodiff, P)
  # Sample from the posterior.
  results = mcmc_with_warmup(Random.GLOBAL_RNG, ∇P, nsamples; reporter = NoProgressReport())
  # Undo the transformation to obtain the posterior from the chain.
  posterior = TransformVariables.transform.(trans, results.chain)
  chns = nptochain(results, posterior)
  return chns
end


"""
    kompsimp(f,a,b,M)
adalah fungsi yang digunakan untuk menghitung nilai integral `f` secara numerik
pada interval `[a,b]` menggunakan komposit Simpson dengan `M` sub-interval.

# Example
```jl
julia> a = 1; b = 6;

julia> f(x) = 2+sin(2*sqrt(x));

julia> y = kompsimp(f,a,b,10)
8.183447496636239
```
return solusi `y`
"""
function kompsimp(f,a,b,M)
  h = (b-a)/(2*M);
  s1 = 0;   s2 = 0;
  for k = 1:M
    x = a + (2*k-1)*h;
    s1 = s1 + f(x);
  end
  for k = 1:M-1
    x = a + (2*k)*h;
    s2 = s2 + f(x);
  end
  y = h/3*(f(a)+f(b)+4*s1+2*s2)
end


"""
    function length_conversion(value, from_type, to_type)

A function that converts a value from a measurement unit to another one

Accepted units are: millimeter(s), centimeter(s), meter(s), kilometer(s),
inch(es), feet, foot, yard(s), mile(s). Abbreviations are also supported.

# Examples/Tests (optional but recommended)
```julia
length_conversion(10, "METERS", "cm")
length_conversion(12345, "yards", "FEET")
```

Because the algorithm converts values to meters, and from meters to the final type,
some imperial system units may have errors:
length_conversion(1, "yards", "FEET") returns 3.000000096, intead of 3.

# Contributed by:- [Fernanda Kawasaki](https://github.com/fernandakawasaki)
"""

# Lookup table that returns conversion of 1 unit of type to meters
METER_CONVERSION = Dict{String,Float64}(
    "mm" => 0.001,
    "cm" => 0.01,
    "m" => 1,
    "km" => 1000,
    "in" => 0.0254,
    "ft" => 0.3048,
    "yd" => 0.9144,
    "mi" => 1609.34,
)

# Lookup table that returns the conversion of 1 meter to type
TYPE_CONVERSION = Dict{String,Float64}(
    "mm" => 1000,
    "cm" => 100,
    "m" => 1,
    "km" => 0.001,
    "in" => 39.3701,
    "ft" => 3.28084,
    "yd" => 1.09361,
    "mi" => 0.000621371,
)

NAME_CONVERSION = Dict{String,String}(
    "millimeter" => "mm",
    "millimeters" => "mm",
    "centimeter" => "cm",
    "centimeters" => "cm",
    "meter" => "m",
    "meters" => "m",
    "kilometer" => "km",
    "kilometers" => "km",
    "inch" => "in",
    "inches" => "in",
    "feet" => "ft",
    "foot" => "ft",
    "yard" => "yd",
    "yards" => "yd",
    "mile" => "mi",
    "miles" => "mi",
)

function normalize_type(type)
    l_type = lowercase(type)
    if !haskey(METER_CONVERSION, l_type)
        if !haskey(NAME_CONVERSION, l_type)
            throw(
                error(
                    "Invalid 'type' value: $(type)\n",
                    "Supported values are: $(keys(NAME_CONVERSION))\n",
                    "Supported abbreviations are: $(keys(METER_CONVERSION))\n",
                ),
            )
        end
        return NAME_CONVERSION[l_type]
    end
    return l_type
end

function length_conversion(value, from_type, to_type)
    from_type_norm = normalize_type(from_type)
    to_type_norm = normalize_type(to_type)
    value_in_meters = value * METER_CONVERSION[from_type_norm]
    return value_in_meters * TYPE_CONVERSION[to_type_norm]
end


####################################################################################
#               Constains activation functions and its derivatives
####################################################################################
export CosineSquasher
export HardTanh
export @IndicatorFunction
export @LReLU
export RampFunction
export ReLU
export Sigmoid
export @ThresholdFunction
# derivatives
export derivativeRampFunction
export derivativeReLU
"""
Threshold(polynomial, t)
Return a Threshold Function defined by `polynomial`and `t`.
Output in {-1,1}

# Arguments
- `polynomial`: A functions from real to real numbers
- `t`: A real number
"""
macro ThresholdFunction(polynomial, t::Real)
    return :( f(x)=sign($(esc(polynomial))(x) - $(esc(t))) )
end

"""
    CosineSquasher(x::Real) :: Real
Return activation function Cosine Squasher
"""
function CosineSquasher(x::Real) :: Real
    salida = 1
    if x < - pi/2
        salida =  0
    elseif x <=  pi/2
        salida =  1/2 * (1 + cos( x - pi/2))
    end
    return salida
end

"""
    IndicatorFunction(t::Real)
Return an indicator function giving its threshold `t`.
"""
macro IndicatorFunction(t::Real)
    return :( f(x)=(($(esc(t)) < x) ? 1 : 0 ) )
end

"""
    RampFunction(x::Real)
Return Ramp  function a bounded ReLU function
"""
function RampFunction(x::Real)
    return min(1,max(0,x))
end
"""
    derivateveRampFunction(x::Real)
Return the derivate of the Ramp function
"""
function derivativeRampFunction(x::Real)
    return (0<=x<=1) ? 1 : 0
end

"""
    ReLU(x::Real)
ReLU function
"""
function ReLU(x::Real)
    return max(0,x)
end
"""
    derivativeReLU(x::Real)
ReLU function
"""
function derivativeReLU(x::Real)
    return (x<0) ? 0 : 1
end

"""
    Sigmoid(x::Real)
Sigmoid activation function
"""
function Sigmoid(x::Real)
    return 1/(1+ exp(-x))
end

"""
    HardTanh(x::Real)
Hard Hyperbolic Function
"""
function HardTanh(x::Real)
    if x <= -1
        return -1
    elseif x <= 1
        return x
    else
        return 1
    end
end

"""
    LReLU(a::Real)
Leaky ReLU
"""
macro LReLU(a::Real)
    return :( f(x::Real)=(x<0) ? $(esc(a))*x : x )
end


### Error functions.

function error_function_selector(error::ASCIIString)
	if error == "absolute_error"
		return "absolute_error", absolute_error!, absolute_error_prime!
	elseif error == "cross_entropy"
		return "cross_entropy", cross_entropy!, cross_entropy_prime!
	else
		return "squared_error", squared_error!, squared_error_prime!
	end
end

function absolute_error!{T<:FloatingPoint}(YH::AbstractVector{T}, Y::AbstractVector{T}, E::AbstractVector{T}; eta::T=1e-10)
	@inbounds begin
		for i = 1:length(E)
			if YH[i] > Y[i]
				E[i] = YH[i] - Y[i]
			else
				E[i] = Y[i] - YH[i]
			end
		end
	end
end

function absolute_error_prime!{T<:FloatingPoint}(YH::AbstractVector{T}, Y::AbstractVector{T}, DE_DYH::AbstractVector{T}; eta::T=1e-10)
	@inbounds begin
		for i = 1:length(Y)
			if YH[i] > Y[i]
				DE_DYH[i] = 1.0
			else
				DE_DYH[i] = -1.0
			end
		end
	end
end

function cross_entropy!{T<:FloatingPoint}(YH::AbstractVector{T}, Y::AbstractVector{T}, E::AbstractVector{T}; eta::T=1e-10)
	@inbounds begin
		for i = 1:length(E)
			E[i] = -((Y[i] * log(YH[i] + eta)) + ((1.0 - Y[i]) * log(1.0 - YH[i] + eta)))
		end
	end
end

function cross_entropy_prime!{T<:FloatingPoint}(YH::AbstractVector{T}, Y::AbstractVector{T}, DE_DYH::AbstractVector{T}; eta::T=1e-10)
	@inbounds begin
		for i = 1:length(Y)
			DE_DYH[i] = ((1.0 - Y[i]) / (1.0 - YH[i] + eta)) - (Y[i] / (YH[i] + eta))
		end
	end
end

function squared_error!{T<:FloatingPoint}(YH::AbstractVector{T}, Y::AbstractVector{T}, E::AbstractVector{T})
	@inbounds begin
		for i = 1:length(E)
			E[i] = 0.5 * abs2(YH[i] - Y[i])
		end
	end
end

function squared_error_prime!{T<:FloatingPoint}(YH::AbstractVector{T}, Y::AbstractVector{T}, DE_DYH::AbstractVector{T})
	@inbounds begin
		for i = 1:length(Y)
			DE_DYH[i] = YH[i] - Y[i]
		end
	end
end


using Random, Distributions, StatsPlots; pyplot()
Random.seed!(0)

mu1, sigma1 = 10, 5
mu2, sigma2 = 40, 12
dist1, dist2 = Normal(mu1,sigma1), Normal(mu2,sigma2)
p = 0.3
mixRv() = (rand() <= p) ? rand(dist1) : rand(dist2)

n = 2000
data = [mixRv() for _ in 1:n]

density(data, c=:blue, label="Density via StatsPlots",
        xlims=(-20,80), ylims=(0,0.035))
stephist!(data, bins=50, c=:black, norm=true,
    label="Histogram", xlabel="x", ylabel = "Density")


"""
```
initialize_stategrid(method::Symbol, dims::Vector{Int})
```
constructs a state grid (using the implementation in EconPDEs)
using various methods, such as Chebyshev points.
"""
function initialize_stategrid(method::Symbol, grid_info::OrderedDict{Symbol, Tuple{T, T, Int}};
                              get_stategrid::Bool = true) where {T <: Real}
    stategrid_init = OrderedDict{Symbol, Vector{T}}()
    if method == :uniform
        for (k, v) in grid_info
            stategrid_init[k] = range(v[1], stop = v[2], length = v[3])
        end
    elseif method == :chebyshev
        for (k, v) in grid_info
            stategrid_init[k] = v[1] .+ 1. / 2. * (v[2] - v[1]) .* (1. .- cos(pi * (0:(v[3] - 1))' / (v[3] - 1)))
        end
    elseif method == :exponential
        for (k, v) in grid_info
            stategrid_init[k] = exp.(range(log(v[1]), stop = log(v[2]), length = v[3]))
        end
    elseif method == :smolyak
        error("Construction of a Smolyak interpolation grid has not been implemented yet.")
        # This should make a call to BasisMatrices from QuantEcon, as they have a nice user-friendly implementation of Smolyak.
        # Alternatively, we can try SmolyakApprox, tho QuantEcon seems more likely to be well-maintained.
    else
        error("Grid construction method $method has not been implemented.")
    end

    if get_stategrid
        return StateGrid(stategrid_init)
    else
        return stategrid_init
    end
end


using Test
using LinearAlgebra
using NonNegLeastSquares
using PyCall

# wrapper functions for convienence
nnls(A,b) = nonneg_lsq(A,b;alg=:nnls)
pivot(A,b) = nonneg_lsq(A,b;alg=:pivot)

# Solve A*x = b for x, subject to x >=0
A = [ 0.53879488  0.65816267
      0.12873446  0.98669198
      0.24555042  0.00598804
      0.80491791  0.32793762 ]

b = [0.888,  0.562,  0.255,  0.077]

# Test that nnls produces the same solution as scipy
x = [0.15512102, 0.69328985] # approx solution from scipy
@test norm(pivot(A,b)-x) < 1e-5

## A second test case
A2 = [ -0.24  -0.82   1.35   0.36   0.35
       -0.53  -0.20  -0.76   0.98  -0.54
        0.22   1.25  -1.60  -1.37  -1.94
       -0.51  -0.56  -0.08   0.96   0.46
        0.48  -2.25   0.38   0.06  -1.29 ]
b2 = [-1.6,  0.19,  0.17,  0.31, -1.27]
x2 = [2.2010416, 1.19009924, 0.0, 1.55001345, 0.0]
@test norm(pivot(A2,b2)-x2) < 1e-5

## Test a bunch of random cases against python

for i = 1:100
  	m,n = rand(1:10),rand(1:10)
  	A3 = randn(m,n)
  	b3 = randn(m)
  	x3,resid = pyopt.nnls(A3,b3)
    resid = norm(b3-A3*pivot(A3,b3))
    if resid > 1e-5
        @test norm(pivot(A3,b3)-x3) < 1e-5
    end
end

## Test a bunch of random cases against nnls
for i = 1:100
    m,n = rand(1:10),rand(1:10)
    A4 = randn(m,n)
    b4 = randn(m)
    x4 = nnls(A4,b4)
    resid = norm(b4-A4*pivot(A4,b4))
    if resid > 1e-5
        @test norm(pivot(A4,b4)-x4) < 1e-5
    end
end


#__precompile__()
module AnalyticDomains

# Curve parametrization
struct CurveDesc
    tau
    dtau
    d2tau
    normal
    tangent
end

export starfish, CurveDesc

using SymPy

# Use any curve parametrized in t in [0, 2 pi), described as string
# Ex. desc = paramcurve("(1 + 0.3*cos(5*t))*exp(I*t)")
# !Note that imaginary unit is I
function paramcurve(str::String)
    desc = Sym(str)
    t = symbols("t")
    # Differentiate curve
    diff1 = diff(desc, t)
    diff2 = diff(diff1, t)
    tang = diff1 / abs(diff1)
    normal = 1im*tang
    return CurveDesc(
        lambdify(desc),
        lambdify(diff1),
        lambdify(diff2),
        lambdify(normal),
        lambdify(tang)
    )
end

function starfish(;n_arms = 5, amplitude = 0.3, radius = 1.0, center=(0,0), rotation=0.0, interior=false)
    if interior
        s = -1.0
    else
        s = 1.0
    end
    R = exp(1im*rotation)
    desc(t) = R*radius*((1 + amplitude*cos(n_arms*t)).*exp(1im*s*t)) + (center[1] + 1im*center[2])
    diff1(t) = R*radius*(exp(t*1im*s)*(amplitude*cos(n_arms*t) + 1)*1im*s - amplitude*n_arms*exp(t*1im*s)*sin(n_arms*t))
    diff2(t) = R*radius*(- exp(t*1im*s)*(amplitude*cos(n_arms*t) + 1) - amplitude*n_arms*exp(t*1im*s)*sin(n_arms*t)*2*1im*s - amplitude*n_arms^2*exp(t*1im*s)*cos(n_arms*t))
    tang(t) = diff1(t) / abs(diff1(t))
    normal(t) = 1im*tang(t)
    return CurveDesc(
        desc,
        diff1,
        diff2,
        normal,
        tang
    )
end

function rectangle(;width = 1, height = 1, order = 10, interior=false)
    @assert iseven(order)
    a = width
    b = height
    p = order;
    desc(t) = (a*cos(t) + b*sin(t)*1im)/(cos(t)^p + sin(t)^p)^(1/p)
    _diff1(t) = -(a*cos(t)*sin(t)^p - b*cos(t)^p*sin(t)*1im)/(cos(t)*sin(t)*(cos(t)^p + sin(t)^p)^((p + 1)/p))
    _diff2(t) = (-(a*cos(t)^(p + 1)*sin(t)^p + b*cos(t)^(2*p + 2)*sin(t)*2im - 2*a*cos(t)^3*sin(t)^(2*p) - 2*a*cos(t)^(p + 3)*sin(t)^p - b*cos(t)^p*sin(t)^(p + 1)*1im - b*cos(t)^(2*p)*sin(t)*2im + b*cos(t)^(p + 2)*sin(t)^(p + 1)*2im + a*p*cos(t)^(p + 1)*sin(t)^p + b*p*cos(t)^p*sin(t)^(p + 1)*1im)/(cos(t)^2*sin(t)^2*(cos(t)^p + sin(t)^p)^((2*p + 1)/p)))

    # Fudge because derivative expression is NaN at t=0
    diff1(t) = _diff1(t + eps(t))
    diff2(t) = _diff2(t + eps(t))

    tang(t) = diff1(t) / abs(diff1(t))
    normal(t) = 1im*tang(t)

    return CurveDesc(
        desc,
        diff1,
        diff2,
        normal,
        tang
    )
end

end


"""
nonparametric regression and quantile regression
* uses pre-generated kernel weights
* can be local constant, local linear, or local quadratic

y is n X p

x is n X dimx

xeval is neval X dimx

weights is n X neval (different weights for each eval. point)

weights should sum to one by columns, they are typical
nonparametric weights from a kernel.

keyword order=0,1 or 2 for local consant, local linear, or local quadratic
(default local linear)

keyword do_median (default false)
keyword do_ci to compute .05 and 0.95 quantiles

execute npreg() for an example
"""

using Random, Econometrics, Plots
function npreg(bandwidth=-1)
    println("npreg(), with no arguments, runs a simple example")
    println("npreg(bw) will run the example with your chosen bandwidth (Float64)")
    println("execute edit(npreg,()) to see the code")
    k = 1 # number of regressors
    Random.seed!(1) # set seed to
    n = 1000
    bandwidth == -1 ? bandwidth = 0.25*n^(-1.0/(4 + k)) : nothing
    neval = 100
    x = rand(n)*pi*2.0 # from 0 to 2π
    xeval = collect(range(pi/2., stop=pi*1.5, length=neval)) # from π/2 to 3π/2
    y = cos.(x) .+ 0.25 .* cos.(3.0.*x) + 0.1*randn(n)
    # npreg wants args to be matrices, not vectors, so convert them
    y = reshape(y,n,1)
    x = reshape(x,n,1)
    xeval = reshape(xeval,neval,1)
    ytrue = cos.(xeval) .+ 0.25.*cos.(3.0*xeval)
    weights = kernelweights(x, xeval, bandwidth, true, "knngaussian", 200)
    yhat, y50, y05, y95 = npreg(y, x, xeval, weights, order=1, do_median=true, do_ci=true)
    labels = ["true" "mean" "median" "0.05 quantile" "0.95 quantile"]
    title = "Kernel regression and quantiles"
    p = Plots.plot(xeval, [ytrue yhat y50 y05 y95], labels=labels, title=title)
    display(p)
    nothing
end

function npreg(y, x, xeval, weights; order=1, do_median=false, do_ci=false)
    weights = sqrt.(weights)
    neval, dimx = size(xeval)
    n, dimy = size(y)
    # local constant
    if order==0
        X = ones(n,1)
        Xeval = ones(neval,1)
    elseif order==1
    # local linear
        X = [ones(n,1) x]
        Xeval = [ones(neval,1) xeval]
    else
    # local quadratic
        stacked = [x; xeval]
        # cross products
        CP = zeros(n+neval, Int((dimx-1)*dimx/2))
        cpind = 0
        for i = 1:dimx-1
            for j = (i+1):dimx
                cpind += 1
                CP[:,cpind] = stacked[:,[i]].*stacked[:,[j]]
            end
        end
        ZZ = [ones(n+neval,1) stacked CP]
        X = view(ZZ,1:n,:)
        Xeval = view(ZZ,(n+1):n+neval,:)
    end
    # do the fit
    yhat = zeros(neval, dimy)
    y50 = nothing
    y05 = nothing
    y95 = nothing
    if do_median y50 = zeros(neval, dimy) end
    if do_ci
        y05 = zeros(neval, dimy)
        y95 = zeros(neval, dimy)
    end
    for i = 1:neval
        WX = weights[:,i] .* X
        Wy = weights[:,i] .* y
        b = WX\Wy
        yhat[i,:] = Xeval[i:i,:]*b
        if do_median
            for j = 1:dimy
                y50[i,j] = (Xeval[i:i,:]*qreg_coef(Wy[:,j], WX, 0.5))[1,1]
            end
        end
        if do_ci
            for j = 1:dimy
                y05[i,j] = (Xeval[i:i,:]*qreg_coef(Wy[:,j], WX, 0.05))[1,1]
                y95[i,j] = (Xeval[i:i,:]*qreg_coef(Wy[:,j], WX, 0.95))[1,1]
            end
        end
    end
    if do_median==false
        return yhat
    elseif do_ci==false
        return yhat, y50
    else
        return yhat, y50, y05, y95
    end
end


using LinearAlgebra
using Random

Random.seed!(843)

include("feast.jl")
using ..feastLinear
using IterativeSolvers

n=100

#generate B-matrix eigenvectors and eigenvalues
#vectors:
R=rand(n,n)
(Xb,R)=qr(R)
#values:
Lb=rand(n)*0.5 .+ 0.5 #random positive numbers

#generate A-matrix eigenvectors:
R=rand(n,n)
(X1,R)=qr(R)

#generate A-matrix eigenvalues
L1=zeros(n)
for i in 1:n
    L1[i]=i
end

#generate eigenvalue problem matrices
A=Xb*diagm(0 => sqrt.(Lb))*X1*diagm(0 => L1)*X1'*diagm(0 => sqrt.(Lb))*Xb'
B=Xb*diagm(0 => Lb)*Xb'

#FEAST parameters
emid=1.0+0.0*im #contour center
ra=0.5 #contour radius 1
rb=0.5 #contour radius 2
nc=6 #number of contour points
m0=2 #subspace dimension
eps=1e-5 #residual convergence tolerance
maxit=100 #maximum FEAST iterations
x0=rand(n,m0) #eigenvector initial guess

println("Standard FEAST")
(lf,xf)=feast_linear(A,B,x0,nc,emid,ra,rb,eps,maxit)
p=sortperm(real(lf))
println(lf[p])

println("Iterative FEAST BiCGSTAB")
alpha=0.01 #relative accuracy of linear system solves
isMaxit=220  #maximum number of linear system iterations per FEAST iteration
(lf,xf,data)=ifeast_linear(A,B,x0,alpha,isMaxit,nc,emid,ra,rb,eps,maxit;log=true)
p=sortperm(real(lf))
println(lf[p])


module TestIntegrate
    using Calculus2
    using Base.Test

    @test isapprox(
        integrate(x -> 1 / x, 1.0, 2.0),
        log(2) - log(1)
    )

    @test isapprox(
        integrate(x -> -sin(x), 0.0, pi),
        (cos(pi) - cos(0.0))
    )

    @test isapprox(
        integrate(x -> 1, 0, 1),
        1.0 - 0.0,
    )

    @test isapprox(
        integrate(x -> x, 0, 1),
        1//2 * 1.0^2 - 1//2 * 0.0^2
    )

    @test isapprox(
        integrate(x -> x * x, 0, 1),
        1//3 * 1.0^3 - 1//3 * 0.0^3
    )

    @test isapprox(
        integrate(sin, 0, pi),
        -cos(pi) - (-cos(0))
    )

    @test isapprox(
        integrate(cos, 0, pi),
        sin(pi) - sin(0)
    )

    @test isapprox(
        integrate(x -> sin(x)^2 + sin(x)^2, 0, pi),
        pi
    )

    @test isapprox(
        integrate(x -> 1 / x, 0.01, 1),
        4.60517
    )

    @test isapprox(
        integrate(x -> cos(x)^8, 0, 2 * pi),
        35 * pi / 64
    )

    @test isapprox(
        integrate(x -> sin(x) - sin(x^2) + sin(x^3), pi, 2 * pi),
        -1.830467
    )

    @test isapprox(
        integrate(sin, 0.0, pi, method = :quadrature),
        sqrt(2),
        atol = 10e-1
    )

    @test isapprox(
        integrate(sin, 0.0, pi, method = :simpsons),
        sqrt(2),
        atol = 10e-1
    )

    @test isapprox(
        integrate(sin, 0.0, pi, method = :monte_carlo),
        sqrt(2),
        atol = 10e-1
    )

    @test isapprox(
        ∫(cos, 0.0, 1.0),
        sin(1.0) - sin(0.0)
    )
end


function harmonic(n::Integer)
    H = 0.0
    for i in n:-1:1
        H += 1 / i
    end
    return H
end

function harmonic(n::Integer, m::Integer)
    H = 0.0
    for i in n:-1:1
        H += 1 / (i ^ m)
    end
    return H
end

td_a1(n::Integer) = harmonic(n - 1)

td_a2(n::Integer) = harmonic(n - 1, 2)

td_b1(n::Integer) = (n + 1) / (3 * (n - 1))

function td_b2(n::Integer)
    return (2 * ((n ^ 2) + n + 3)) / ((9 * n) * (n - 1))
end

td_c1(a1::AbstractFloat, b1::AbstractFloat) = b1 - 1 / a1

function td_c2(n::Integer, a1::AbstractFloat, a2::AbstractFloat, b2::AbstractFloat)
    return b2 - ((n + 2) / (a1 * n)) + a2 / (a1 ^ 2)
end

td_e1(a1::AbstractFloat, c1::AbstractFloat) = c1 / a1

td_e2(a1::AbstractFloat, a2::AbstractFloat, c2::AbstractFloat) = c2 / (a1 ^ 2 + a2)

function tajimad(π::AbstractFloat, S::Integer, a1::AbstractFloat, e1::AbstractFloat, e2::AbstractFloat)
    return (π - S / a1) / sqrt(e1 * S + e2 * S * (S - 1))
end

"""
    tajimad(π::AbstractFloat, S::Integer, n::Integer)

Compute Tajima's D from:

* `π`: The average number of SNPs found in (n choose 2) pairwise comparisons of
       a sample of sequences.

* `S`: The number of segregating sites in a sample of sequences.

* `n`: The number of sequences in your sample.

*Example*

```julia
tajimad(3.88888, 16, 10)
```

"""
function tajimad(π::AbstractFloat, S::Integer, n::Integer)
    a1 = td_a1(n)
    a2 = td_a2(n)
    b1 = td_b1(n)
    b2 = td_b2(n)
    c1 = td_c1(a1, b1)
    c2 = td_c2(n, a1, a2, b2)
    e1 = td_e1(a1, c1)
    e2 = td_e2(a1, a2, c2)
    return tajimad(π, S, a1, e1, e2)
end

"""
    tajimad(seqs)

Compute Tajima's D from a collection of BioSequences{DNAAlphabet{n}} (n = 2 or 4).

This will estimate the `π`, `S`, and `n` parameters from the sequences and use
those parameters to estimate Tajima's D.

*Example*

```julia

sample = [dna"ATAATAAAAAAATAATAAAAAAATAAAAAAAATAAAAAAAA",
          dna"AAAAAAAATAAATAATAAAAAAATAAAAAAAAAAAAAAAAA",
          dna"AAAATAAAAATATAATAAAAAAATATAAAAAAAAAAAAAAA",
          dna"AAAAAAAAAAAATAATAAAAAAATAAATAAATAAAAAAAAA",
          dna"AAAATAAAAAAAATATAAAAAAATAAAAAAAAAAAAAAAAA",
          dna"AAAATAAAAAAAAAATAAAAAAAAAAAAAAAAAAATAAAAA",
          dna"AAAAAATAAAAATAATAAAAAAATAAAAAAAAAAAAAAAAA",
          dna"AAAAAAAAAAAAAAATAAAAAAATAAAAAAAAAAAAAAATA",
          dna"AAAAAAAAAAAAAAAAAAAAAAATAAAAAAAAAAAAAAAAA",
          dna"AAAAAAAAAAAAAAATAAAAAAATAATAAAAAAAAAAAAAA"]

tajimad(sample)
```

"""
function tajimad(seqs)
    π = avg_mut(seqs)
    S = count(Segregating, seqs)
    n = length(seqs)
    return tajimad(π, S[1], n)
end


module Excercise_4

# Exercise 4 (JULIA)
# 1. Create two matrices of the same layout and test if addition and subtraction of the matrix works as expected: C = A + B
# 2. Now compare matrix multiplication either this way A * B and this way A .* B. Whats the difference?!
# 3. What about matrix division with "/" or "\"?!
# 4. Create a 3x3 integer matrix A with useful numbers. Now try A+1, A-1, A*2, A/2.
# 5. Now multiply a 3x4 matrix with a suitable (4)vector.

# Part 1
matrix_a = rand(0:10, 4,4)
matrix_b = rand(0:10, 4,4)
println("Matrix A:")
println(matrix_a)
println("Matrix B:")
println(matrix_b)
println("A + B:")
addition = matrix_a + matrix_b
println(addition)
println("A - B:")
subtraction = matrix_a -matrix_b
println(subtraction)

# Part 2

# Matrix multiplication
println("A * B")
multi_1 = matrix_a * matrix_b
println(multi_1)

# Element-wise multiplication
println("A .* B:")
multi_2 = matrix_a .* matrix_b
println(multi_2)
# Part 3

# Part 4

matrix_c = [1 2 3; 3 2 1; 2 3 1]
println("Matrix C:")
println(matrix_c)
println("C+1:")
# println(matrix_c-1)
println("C*2:")
println(matrix_c*2)
println("C/2:")
println(matrix_c/2)

# Part 5

matrix_d = rand(0:10, 3,4)

println("Matrix D:")
println(matrix_d)

end


# Energy

function NbodyEnergy(u,Gm)
"""
     Nbody problem Hamiltonian (Cartesian Coordinates)
"""

    dim=2
    nbody=length(Gm)

 @inbounds begin
    x = view(u,1:7)   # x
    y = view(u,8:14)  # y
    v = view(u,15:21) # x′
    w = view(u,22:28) # y′

    H=zero(eltype(u))
    P=zero(eltype(u))

    for i in 1:nbody
        H+=Gm[i]*(v[i]*v[i]+w[i]*w[i])
        for j in i+1:nbody
            r = ((x[i]-x[j])^2+(y[i]-y[j])^2)^(1/2)
            P+=(Gm[i]/r)*Gm[j]
        end
    end

    return(H/2-P)
    end

end

# OdeProblem

function f(du,u,p,t)
  @inbounds begin
  x = view(u,1:7)   # x
  y = view(u,8:14)  # y
  v = view(u,15:21) # x′
  w = view(u,22:28) # y′
  du[1:7] .= v
  du[8:14].= w
  for i in 15:28
    du[i] = zero(u[1])
  end
  for i=1:7,j=1:7
    if i != j
      r = ((x[i]-x[j])^2 + (y[i] - y[j])^2)^(3/2)
      du[14+i] += j*(x[j] - x[i])/r
      du[21+i] += j*(y[j] - y[i])/r
    end
  end
  end
end

# DynamicalOdeProblem

function dotv(dv,q,v,par,t)
@inbounds begin
  x = view(q,1:7)   # x
  y = view(q,8:14)  # y
  vx = view(v,1:7)   # x′
  vy = view(v,8:14)  # y′
  for i in 1:14
    dv[i] = zero(x[1])
  end
  for i=1:7,j=1:7
    if i != j
      r = ((x[i]-x[j])^2 + (y[i] - y[j])^2)^(3/2)
      dv[i] += j*(x[j] - x[i])/r
      dv[7+i] += j*(y[j] - y[i])/r
    end
  end
  end
end

function dotq(dq,q,v,par,t)
@inbounds begin
  x = view(q,1:7)   # x
  y = view(q,8:14)  # y
  vx = view(v,1:7)   # x′
  vy = view(v,8:14)  # y′
  dq[1:7] .= vx
  dq[8:14].= vy
  end
end

#
#  Second Order Problem
#

function f2nd!(ddu,du,u,p,t)
  @inbounds begin
  x = view(u,1:7)   # x
  y = view(u,8:14)  # y
  vx = view(du,1:7) # x′
  vy = view(du,8:14) # y′

  for i in 1:14
    ddu[i] = zero(x[1])
  end

  for i=1:7,j=1:7
    if i != j
      r = ((x[i]-x[j])^2 + (y[i] - y[j])^2)^(3/2)
      ddu[i] += j*(x[j] - x[i])/r
      ddu[7+i] += j*(y[j] - y[i])/r
    end
  end
  end
end


module PassiveCable

using Unitful: uconvert, NoUnits

export cable_normalize, cable, rallpack1

# Compute solution g(x, t) to
#
#     ∂²g/∂x² - g - ∂g/∂t = 0
#
# on [0, L] × [0,∞), subject to:
#
#     g(x, 0) = 0
#     ∂g/∂x (0, t) = 1
#     ∂g/∂x (L, t) = 0
#
# Parameters:
#     x, t, L:  as described above
#   tol:  absolute error tolerance in result
#
# Return:
#     g(x, t)
#
# TODO: verify correctness when L≠1

function cable_normalized(x::Float64, t::Float64, L::Float64; tol=1e-8)
    if t<=0
        return 0.0
    else
        ginf = -cosh(L-x)/sinh(L)
        sum = exp(-t/L)
        Ltol = L*tol

        for k = Iterators.countfrom(1)
            a = k*pi/L
            b = exp(-t*(1+a^2))

            sum += 2*b*cos(a*x)/(1+a^2)
            resid_ub = b/(a^3*t)

            if resid_ub<Ltol
                break
            end
        end
        return ginf+sum/L;
     end
end

# Compute solution f(x, t) to
#
#     λ²∂²f/∂x² - f - τ∂f/∂t = 0
#
# on [0, L] x [0, ∞), subject to:
#
#     f(x, 0) = V
#     ∂f/∂x (0, t) = I·r
#     ∂f/∂x (L, t) = 0
#
# where:
#
#     λ² = 1/(r·g)   length constant
#     τ  = r·c       time constant
#
# In the physical model, the parameters correspond to the following:
#
#     L:  length of cable
#     r:  linear axial resistivity
#     g:  linear membrane conductivity
#     c:  linear membrane capacitance
#     V:  membrane reversal potential
#     I:  injected axial current on the left end (x = 0) of the cable.
#
# Note that r, g and c are specific 1-d quantities that differ from
# the cable resistivity r_L, specific membrane conductivity ḡ and
# specific membrane capacitance c_m as used elsewhere. If the
# cross-sectional area is A and cable circumference is f, then
# these quantities are related by:
#
#     r = r_L/A
#     g = ḡ·f
#     c = c_m·f
#
# Parameters:
#     x:  displacement along cable
#     t:  time
#     L, lambda, tau, r, V, I:  as described above
#   tol:  absolute error tolerance in result
#
# Return:
#     computed potential at (x,t) on cable.

function cable(x, t, L, lambda, tau, r, V, I; tol=1e-8)
    scale = I*r*lambda;
    if scale == 0
        return V
    else
        tol_n = abs(tol/scale)
        return scale*cable_normalized(uconvert(NoUnits, x/lambda), uconvert(NoUnits, t/tau), uconvert(NoUnits, L/lambda), tol=tol_n) + V
    end
end

# Rallpack 1 test
#
# One sided cable model with the following parameters:
#
#     RA = 1 Ω·m    bulk axial resistivity
#     RM = 4 Ω·m²   areal membrane resistivity
#     CM = 0.01 F/m²  areal membrane capacitance
#     d  = 1 µm     cable diameter
#     EM = -65 mV   reversal potential
#     I  = 0.1 nA   injected current
#     L  = 1 mm     cable length.
#
# (This notation aligns with that used in the Rallpacks paper.)
#
# Note that the injected current as described in the Rallpack model
# is trans-membrane, not axial. Consequently we need to swap the
# sign on I when passing to the cable function.
#
# Parameters:
#     x:  displacement along cable [m]
#     t:  time [s]
#   tol:  absolute tolerance for reported potential.
#
# Return:
#     computed potential at (x,t) on cable.

function rallpack1(x, t; tol=1e-8)
    RA = 1
    RM = 4
    CM = 1e-2
    d  = 1e-6
    EM = -65e-3
    I  = 0.1e-9
    L  = 1e-3

    r = 4*RA/(pi*d*d)
    lambda = sqrt(d/4 * RM/RA)
    tau = CM*RM

    return cable(x, t, L, lambda, tau, r, EM, -I, tol=tol)
end

end # module PassiveCable


using ViewerGL, LinearAlgebraicRepresentation
GL = ViewerGL
Lar = LinearAlgebraicRepresentation

# input of primitive shape
V, (VV,EV,FV) = Lar.cuboid([1,1], true)
square = (V,EV)
model = Lar.Struct([ square,
			Lar.r(π), square ])
V,EV = Lar.struct2lar(model)
VV = [[k] for k=1:size(V,2)]

GL.VIEW( GL.numbering(.4)((V,[VV, EV]),GL.COLORS[1]) );

# arrangement of input data
W = convert(Lar.Points, V')
cop_EV = Lar.coboundary_0(EV)
V, copEV, copFE = Lar.planar_arrangement(W, cop_EV)

# compute containment graph of components
bicon_comps = Lar.Arrangement.biconnected_components(copEV)

# compute euler characteristic
χ = Lar.euler_characteristic(V, copEV, copFE)
println("χ = $χ ; bicon_comps = $(length(bicon_comps))");

EW = Lar.cop2lar(copEV)
W = convert(Lar.Points, V')
comps = [ GL.GLLines(W,EW[comp],GL.COLORS[(k-1)%12+1]) for (k,comp) in enumerate(bicon_comps) ];
GL.VIEW(comps);

# final solid visualization
triangulated_faces = Lar.triangulate2D(V, [copEV, copFE])
V = convert(Lar.Points, V')
FVs = convert(Array{Lar.Cells}, triangulated_faces)
GL.VIEW(GL.GLExplode(V,FVs,1.2,1.2,1.2,99,1));

# polygonal face boundaries
EVs = Lar.FV2EVs(copEV, copFE)
EVs = convert(Array{Array{Array{Int64,1},1},1}, EVs)
GL.VIEW(GL.GLExplode(V,EVs,1.2,1.2,1.2,1,1));


function circHohmann(r₁,r₂,μ)
#[dV1,dV2,T] = circHohmann(r1,r2,μ)
#   calculates circular Hohmann transfer details given two radii
#   input and output are the same units
#
# Alex Hoffman
# 10/31/2020

aₜ   = 0.5(r₁ + r₂) #transfer semi-major axis
v1 = sqrt(μ/r₁)
v2 = sqrt(μ/r₂)
vt1 = sqrt(μ*(2/r₁-1/aₜ))
vt2 = sqrt(μ*(2/r₂-1/aₜ))
dV1 = vt1 - v1
dV2 = v2 - vt2
T = 2pi*sqrt(aₜ^3/μ)

return [dV1, dV2, T]
end


module GaussianProcesses

export k, K, GP_Regressor

using LinearAlgebra, Distributions

# exponential quadratic kernel
k(a::Array, b::Array; h::Real, d::Function) = exp(-d(a,b)^2 / (2 * h^2))
k(a::Real, b::Real; h::Real, d::Function) = k([a], [b]; h=h, d=d)

# kernel matrix
K(A::Vector, B::Vector; h::Real, d::Function) = [k(a, b; h = h, d = d) for a in A, b in B]

# prior distribution: mean 0, covariance K
mutable struct GP_Regressor
	"MVN distribution of prior"
	prior::Distributions.MvNormal
	"MVN distribution of posterior"
	posterior::Distributions.MvNormal
	"equivalent smoothing kernel weights (rows of matrix)"
	equiv_weights::Array
	"input points for sampling and plotting"
	x_grid::Vector
	"sample observations"
	x_train::Vector
	"sample outcomes"
	y_train::Vector
	"standard deviation of iid Gaussian noise in observations"
	σ::Real
	"characteristic length scale"
	h::Real
	"distance function"
	d::Function

	# inner constructor: call this function to instantiate
	function GP_Regressor(X_train::Vector, y_train::Vector, X::Vector; σ::Real, h::Real, d::Function)

		# prior
		Kpred = K(X, X; h=h, d=d)  # covariance
		prior = MvNormal(Kpred)

		# posterior terms
		Kinv = inv(K(X_train, X_train; h=h, d=d) + σ^2 * I)
		Kcross = K(X, X_train; h=h, d=d)
		Kequiv = Kcross * Kinv  # equivalent smoothing kernel weights (each row)

		mean_posterior = Kequiv * y_train
		cov_posterior = Kpred .- Kequiv * Kcross'

		posterior = MvNormal(mean_posterior, Matrix(Hermitian(cov_posterior)))

		new(prior, posterior, Kequiv, X, X_train, y_train, σ, h, d)
	end
end

end  # module


function rk4(f::Function, x₀::Float64, y₀::Float64, x₁::Float64, n)
    vx = Vector{Float64}(n + 1)
    vy = Vector{Float64}(n + 1)
    vx[1] = x = x₀
    vy[1] = y = y₀
    h = (x₁ - x₀) / n
    for i in 1:n
        k₁ = h * f(x, y)
        k₂ = h * f(x + 0.5h, y + 0.5k₁)
        k₃ = h * f(x + 0.5h, y + 0.5k₂)
        k₄ = h * f(x + h, y + k₃)
        vx[i + 1] = x = x₀ + i * h
        vy[i + 1] = y = y + (k₁ + 2k₂ + 2k₃ + k₄) / 6
    end
    return vx, vy
end

vx, vy = rk4(f, 0.0, 1.0, 10.0, 100)
for (x, y) in Iterators.take(zip(vx, vy), 10)
    @printf("%4.1f %10.5f %+12.4e\n", x, y, y - theoric(x))
end


# Solves the SVM classification problem using the barrier method.

# The main function.
# This implementation is deterministic for illustration purpose.
# In practice we may want to use random starting point.
function svmbarrier(X::AbstractMatrix,
                    Y::AbstractVector,
                    C::Real,
                    ϵ::Real;
                    t0::Real=1.,
                    μ::Real=100.,
                    α::Real=0.01, β::Real=0.05)
  w = zeros(size(X, 2))
  z = ones(Y)*2
  x0 = [w; z]
  A = [-Y.*X (-eye(size(Y, 1))); zeros(X) (-eye(size(Y, 1)))]
  b = [-1.*ones(Y); zeros(Y)]
  wsize = size(w, 1)
  f(x) = sum(x[1: wsize].^2)/2 + C*sum(x[wsize+1: end])
  ∇f(x) = [x[1: size(w, 1)]; C*ones(Y)]
  Hf(x) = Diagonal([ones(wsize); zeros(Y)])
  x, αdual, numstepsarray = barriermethod(
    f, ∇f, Hf, A, b, x0; ϵ=ϵ, t0=t0, μ=μ, α=α, β=β)
  x[1: wsize], αdual[1: size(Y, 1)], numstepsarray
end

# Implements the barrier method given the objective function and its
# first and second derivatives.
# The problem is supposed to have a linear constraint Ax ≤ b.
function barriermethod(f, ∇f, Hf,
                       A::AbstractMatrix,
                       b::AbstractVector,
                       x0::AbstractVector;
                       ϵ::Real=1e-3,
                       t0::Real=1.,
                       μ::Real=100.,
                       α::Real=0.01, β::Real=0.05)
  (all(A*x0.<b)
   || throw(DomainError("x0 must be strictly feasible.")))
  m = float(size(Y, 1))
  x, t = x0, t0
  numstepsarray::Vector{Int} = []
  while true
    x, numsteps = centeringstep(f, ∇f, Hf, A, b, x, t; α=α, β=β)
    push!(numstepsarray, numsteps)
    m/t < ϵ && break
    t *= μ
  end
  αdual = 1./(t*(b-A*x))
  x, αdual, numstepsarray
end

# Carries out a single centering step of the barrier method.
# The problem is supposed to have a linear constraint Ax ≤ b.
function centeringstep(f, ∇f, Hf,
                       A::AbstractMatrix,
                       b::AbstractVector,
                       x0::AbstractVector,
                       t::Real;
                       ϵ::Real=1e-8,
                       α::Real=0.01, β::Real=0.05)
  x = copy(x0)
  numsteps = 0
  obj(x) = t*f(x)-sum(log.(b-A*x))
  while true
    d = 1./(b-A*x)
    ∇ = t*∇f(x)+A'*d
    H = t*Hf(x)+A'*Diagonal(d)^2*A
    Δxnt = -H\∇
    λ² = -∇⋅Δxnt
    λ²/2 < ϵ && break
    tbacktrace = 1
    xtest = x + tbacktrace*Δxnt
    while(any(A*xtest .≥ b) || obj(xtest) > obj(x)-tbacktrace*α*λ²)
      tbacktrace *= β
      xtest = x + tbacktrace*Δxnt
    end
    # numeric limit
    obj(xtest) == obj(x) && break
    x = xtest
    numsteps += 1
  end
  x, numsteps
end


function isPalindrome(n)
    s = string(n)
    s == reverse(s)
end

max = 0
for i in collect(999:-1:100)
    for j in collect(999:-1:100)
        n = i*j
        if (isPalindrome(n) && n > max)
            max = n
        end
    end
end

println(max)

004 - Largest Palindrome Product/004 - Largest_Palindrome_Product.jl


#############################################################################
#############################################################################
#
# This file implements polynomial addition
#
#############################################################################
#############################################################################

"""
Add two polynomials.
"""
function +(p1::Polynomial, p2::Polynomial)::Polynomial
    p1, p2 = deepcopy(p1), deepcopy(p2)
    p3 = Polynomial()
    while !iszero(p1) && !iszero(p2)
        t1, t2 = trailing(p1), trailing(p2)
        if t1.degree == t2.degree
            push!(p3, popfirst!(p1)+popfirst!(p2))
        elseif t1.degree < t2.degree
            push!(p3,popfirst!(p1))
        else
            push!(p3,popfirst!(p2))
        end
    end
    while !iszero(p1)
        push!(p3,popfirst!(p1))
    end
    while !iszero(p2)
        push!(p3,popfirst!(p2))
    end
    return p3
end

"""
Add a polynomial and a term.
"""
+(p::Polynomial, t::Term) = p + Polynomial(t)
+(t::Term, p::Polynomial) = p + t

"""
Add a polynomial and an integer.
"""
+(p::Polynomial, n::Int) = p + Term(n,0)
+(n::Int, p::Polynomial) = p + Term(n,0)


include("/home/jefter66/Workspace/lablib/src/calcs/Uncertainty.jl")

function I1()
    Δr = 0.01
    r1 = 0.0335
    r2 = 0.06

    m = 2.2429
    Δm = 0.0001

    I1 = (1/2)*m*(r1^2 + r2^2)
    ΔI1 = (1/2)*((Δm*(r1^2 + r2^2) + 2*m*(r1*Δr + r2*Δr)))
    println(" Ig ± Δ Ig = ", I1, " ± ", ΔI1)
#    return [I1,ΔI1]
end

function I2(ω1, ω)
   Δω=1e-3
   I2 = I1()[1]*( ω1/(ω1 - ω))
   ΔI2   =  (I1()[2]  + (I1()[2]*ω +  Δω*I1()[1])/(ω^2))
    println("I2 ± Δ I2 = ", I2, " ± ", ΔI2)
    return [I2, ΔI2]
end

function equivalencia(v1,v2,σ1, σ2)
    abs(v1-v2) < 2*(σ1 + σ2)
end

function ΔE(ω1, ω,I1, I2)
    Δω = 0.001
    Ef = (1/2)*(I1[1] + I2[1])*ω^2
    Ei = (1/2)*(I1[1])*ω1^2

    δE = ((1/2)*(I1[2] + I2[2])*ω^2 + (I1[1] + I2[1])*ω*Δω) + (1/2)*(I1[2]*ω1^2 + 2*ω1*Δω*I1[1])

    println("E ± ΔE = ", Ef - Ei, " ± ", δE)
end

function results()
ω1 = [14.444, 22.765,24.353]
ω   = [7.453,12.777,13.629]
print("(1) : ")
I2_1 = I2(ω1[1], ω[1])
print("(2) : ")
I2_2 = I2(ω1[2],ω[2])
print("(3) : ")
I2_3 = I2(ω1[3],ω[3])

println("==============================================")

println("(1) & (2) : ", equivalencia(I2_1[1], I2_1[2], I2_2[1] , I2_2[2]))
println("(1) & (3) : ", equivalencia(I2_1[1],I2_1[2], I2_3[1],I2_3[2]))
println("(2) & (3) : ", equivalencia(I2_2[1],I2_2[2], I2_3[1], I2_3[2]))

println("==========================")

E1 = ΔE(ω1[1], ω[1], I1(), I2_1)
E2 = ΔE(ω1[2], ω[2], I1(), I2_2)
E3 = ΔE(ω1[3], ω[3], I1(), I2_3)
#println("ΔE1 ± δ E1 = ", E1[1], " ± ", E1[2])
#println("ΔE2 ± δ E2 =",  E2[1], " ± ", E2[2])
#println("ΔE3 ± δ E3 = ", E3[1] , " ± ", E3[2])

end


module StokesTaylorHoodTests

using Test
using Gridap
import Gridap: ∇

#using LinearAlgebra: tr, ⋅

# Using automatic differentiation
u(x) = VectorValue( x[1]^2 + 2*x[2]^2, -x[1]^2 )
p(x) = x[1] + 3*x[2]
f(x) = -Δ(u)(x) + ∇(p)(x)
g(x) = (∇⋅u)(x)
∇u(x) = ∇(u)(x)

#u(x) = VectorValue( x[1]^2 + 2*x[2]^2, -x[1]^2 )
#∇u(x) = TensorValue( 2*x[1], 4*x[2], -2*x[1], zero(x[1]) )
#Δu(x) = VectorValue( 6, -2 )
#
#p(x) = x[1] + 3*x[2]
#∇p(x) = VectorValue(1,3)
#
#f(x) = -Δu(x) + ∇p(x)
#g(x) = tr(∇u(x))
#
#∇(::typeof(u)) = ∇u
#∇(::typeof(p)) = ∇p

domain = (0,2,0,2)
partition = (3,3)
model = CartesianDiscreteModel(domain,partition)

labels = get_face_labeling(model)
add_tag_from_tags!(labels,"dirichlet",[1,2,5])
add_tag_from_tags!(labels,"neumann",[6,7,8])

order = 2

reffe_u = ReferenceFE(lagrangian,VectorValue{2,Float64},order)
reffe_p = ReferenceFE(lagrangian,Float64,order-1)

V = TestFESpace(model,reffe_u,labels=labels,dirichlet_tags="dirichlet",conformity=:H1)
Q = TestFESpace(model,reffe_p,labels=labels,conformity=:H1)

U = TrialFESpace(V,u)
P = TrialFESpace(Q)

Y = MultiFieldFESpace([V,Q])
X = MultiFieldFESpace([U,P])

Ω = Triangulation(model)
Γ = BoundaryTriangulation(model,labels,tags="neumann")
n_Γ = get_normal_vector(Γ)

degree = order
dΩ = Measure(Ω,degree)
dΓ = Measure(Γ,degree)

a((u,p),(v,q)) = ∫( ∇(v)⊙∇(u) - (∇⋅v)*p + q*(∇⋅u) )*dΩ

l((v,q)) = ∫( v⋅f + q*g )*dΩ + ∫( v⋅(n_Γ⋅∇u) - (n_Γ⋅v)*p )*dΓ

op = AffineFEOperator(a,l,X,Y)

uh, ph = solve(op)

eu = u - uh
ep = p - ph

l2(u) = sqrt(sum( ∫( u⊙u )*dΩ ))
h1(u) = sqrt(sum( ∫( u⊙u + ∇(u)⊙∇(u) )*dΩ ))

eu_l2 = l2(eu)
eu_h1 = h1(eu)
ep_l2 = l2(ep)

tol = 1.0e-9
@test eu_l2 < tol
@test eu_h1 < tol
@test ep_l2 < tol

end # module


using Diagonalizations, LinearAlgebra, PosDefManifold, Test

# Method (1) real
t, n, k=10, 20, 10
Xset = [genDataMatrix(t, n) for i = 1:k]
Xfixed=randn(t, n)./1
for i=1:length(Xset) Xset[i]+=Xfixed end
C1=Hermitian( mean((X'*X)/t for X∈Xset) )
C2=Hermitian( mean((X*X')/n for X∈Xset) )
Xbar=mean(Xset)
c=cstp(Xbar, C1, C2; simple=true)
@test c.F[1]'*C2*c.F[1]≈I
@test c.F[2]'*C1*c.F[2]≈I
Z=c.F[1]'*Xbar*c.F[2]
n=minimum(size(Z))
@test norm(Z[1:n, 1:n]-Diagonal(Z[1:n, 1:n]))+1. ≈ 1.
cX=cstp(Xset; simple=true)
@test c==cX

# Method (1) complex
t, n, k=10, 20, 10
Xcset = [genDataMatrix(ComplexF64, t, n) for i = 1:k]
Xcfixed=randn(ComplexF64, t, n)./1
for i=1:length(Xcset) Xcset[i]+=Xcfixed end
C1c=Hermitian( mean((Xc'*Xc)/t for Xc∈Xcset) )
C2c=Hermitian( mean((Xc*Xc')/n for Xc∈Xcset) )
Xcbar=mean(Xcset)
cc=cstp(Xcbar, C1c, C2c; simple=true)
@test cc.F[1]'*C2c*cc.F[1]≈I
@test cc.F[2]'*C1c*cc.F[2]≈I
Zc=cc.F[1]'*Xcbar*cc.F[2]
n=minimum(size(Zc))
@test norm(Zc[1:n, 1:n]-Diagonal(Zc[1:n, 1:n]))+1. ≈ 1.
cXc=cstp(Xcset; simple=true)
@test cc==cXc

# Method (2) real
c=cstp(Xset)

# ... selecting subspace dimension allowing an explained variance = 0.9
c=cstp(Xset; eVar=0.9)

# ... giving weights `w` to the covariance matrices
c=cstp(Xset; w=abs2.(randn(k)), eVar=0.9)

# ... subtracting the means
c=cstp(Xset; meanXd₁=nothing, meanXd₂=nothing, w=abs2.(randn(k)), eVar=0.9)

# explained variance
c.eVar

# name of the filter
c.name

using Plots
# plot the original covariance matrices and the transformed counterpart
c=cstp(Xset)

C1Max=maximum(abs.(C1));
 h1 = heatmap(C1, clim=(-C1Max, C1Max), title="C1", yflip=true, c=:bluesreds);
 D1=c.F[1]'*C2*c.F[1];
 D1Max=maximum(abs.(D1));
 h2 = heatmap(D1, clim=(0, D1Max), title="F[1]'*C2*F[1]", yflip=true, c=:amp);
 C2Max=maximum(abs.(C2));
 h3 = heatmap(C2, clim=(-C2Max, C2Max), title="C2", yflip=true, c=:bluesreds);
 D2=c.F[2]'*C1*c.F[2];
 D2Max=maximum(abs.(D2));
 h4 = heatmap(D2, clim=(0, D2Max), title="F[2]'*C1*F[2]", yflip=true, c=:amp);

XbarMax=maximum(abs.(Xbar));
 h5 = heatmap(Xbar, clim=(-XbarMax, XbarMax), title="Xbar", yflip=true, c=:bluesreds);
 DX=c.F[1]'*Xbar*c.F[2];
 DXMax=maximum(abs.(DX));
 h6 = heatmap(DX, clim=(0, DXMax), title="F[1]'*Xbar*F[2]", yflip=true, c=:amp);
 📈=plot(h1, h3, h5, h2, h4, h6, size=(800,400))
# savefig(📈, homedir()*"\\Documents\\Code\\julia\\Diagonalizations\\docs\\src\\assets\\FigCSTP.png")

# Method (2) complex
cc=cstp(Xcset)

# ... selecting subspace dimension allowing an explained variance = 0.9
cc=cstp(Xcset; eVar=0.9)

# ... giving weights `w` to the covariance matrices
cc=cstp(Xcset; w=abs2.(randn(k)), eVar=0.9)

# ... subtracting the mean
cc=cstp(Xcset; meanXd₁=nothing, meanXd₂=nothing,
        w=abs2.(randn(k)), eVar=0.9)

# explained variance
c.eVar

# name of the filter
c.name


g = [
  [08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08]
  [49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00]
  [81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65]
  [52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91]
  [22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80]
  [24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50]
  [32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70]
  [67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21]
  [24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72]
  [21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95]
  [78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92]
  [16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57]
  [86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58]
  [19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40]
  [04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66]
  [88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69]
  [04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36]
  [20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16]
  [20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54]
  [01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48]
]

l = 4
m, n = size(g)
maxsofar = 0
for i = 1:m-(l-1)
  global maxsofar
  for j = 1:n-(l-1)
    p_col = prod(g[i:i+(l-1), j])
    p_row = prod(g[i,j:j+(l-1)])
    p_dia1 = g[i,j] * g[i+1,j+1] * g[i+2,j+2] * g[i+3,j+3]
    p_dia2 = g[i,j+3] * g[i+1,j+2] * g[i+2,j+1] * g[i+3,j]
    maxsofar = max(maxsofar, p_col)
    maxsofar = max(maxsofar, p_row)
    maxsofar = max(maxsofar, p_dia1)
    maxsofar = max(maxsofar, p_dia2)
  end
end
println(maxsofar)


# Copyright (c) 2021 Idiap Research Institute, http://www.idiap.ch/
#  Niccolò Antonello <nantonel@idiap.ch>

export TropicalWeight

"""
`TropicalWeight(x)`

| Set                                 | ``\\oplus``|   ``\\otimes`` | ``\\bar{0}`` | ``\\bar{1}`` |
|:-----------------------------------:|:----------:|:--------------:|:------------:|:------------:|
|``\\mathbb{R}\\cup\\{\\pm\\infty\\}``|  ``\\min`` |     ``+``      |``\\infty``   |   ``0``      |
"""
struct TropicalWeight{T <: AbstractFloat} <: Semiring
  x::T
end

zero(::Type{TropicalWeight{T}}) where T = TropicalWeight{T}(T(Inf))
one(::Type{TropicalWeight{T}}) where T = TropicalWeight{T}(zero(T))

*(a::TropicalWeight{T}, b::TropicalWeight{T}) where {T <: AbstractFloat} = TropicalWeight{T}(a.x + b.x)
+(a::TropicalWeight{T}, b::TropicalWeight{T}) where {T <: AbstractFloat} = TropicalWeight{T}( min(a.x,b.x) )
/(a::TropicalWeight{T}, b::TropicalWeight{T}) where {T <: AbstractFloat} = TropicalWeight{T}( a.x-b.x )

# parsing
parse(::Type{S},str) where {T, S <: TropicalWeight{T}} = S(parse(T,str))

#properties
isidempotent(::Type{W}) where {W <: TropicalWeight} = true
iscommulative(::Type{W}) where {W <: TropicalWeight} = true
isleft(::Type{W}) where {W <: TropicalWeight}= true
isright(::Type{W}) where {W <: TropicalWeight}= true
isweaklydivisible(::Type{W}) where {W <: TropicalWeight}= true
iscomplete(::Type{W}) where {W <: TropicalWeight}= true
ispath(::Type{W}) where {W <: TropicalWeight}= true


"""
    bresenham(start::Tuple{<:T, <:T}, stop::Tuple{<:T, <:T}) where T<:Number

Implements the [Bresenham's line algorithm](https://en.wikipedia.org/wiki/Bresenham%27s_line_algorithm).

# Examples

```jldoctest
julia> bresenham()

```
"""
function bresenham(start::Tuple{T, T}, stop::Tuple{T, T}) where T<:Integer
    x0, y0 = start
    x1, y1 = stop
    if abs(y1 - y0) < abs(x1 - x0)
        if x0 > x1
            reverse!(low_line(stop, start))
        else
            low_line(start, stop)
        end
    else
        if y0 > y1
            reverse!(high_line(stop, start))
        else
            high_line(start, stop)
        end
    end
end

"""
    low_line(start::Tuple{T, T}, stop::Tuple{T, T}) where T<:Integer

# Examples

```jldoctest
julia> low_line()

```
"""
function low_line(start::Tuple{T, T}, stop::Tuple{T, T}) where T<:Integer
    x0, y0 = start
    x1, y1 = stop
    line = fill((zero(T), zero(T)), length(x0:x1))
    dx = x1 - x0
    dy = y1 - y0
    yi = 1
    if dy < 0
        yi = -1
        dy = -dy
    end
    D = 2*dy - dx
    y = y0

    for x in x0:x1
        line[x - x0 + 1] =  (x, y)
        if D > 0
            y = y + yi
            D = D - 2*dx
        end
        D = D + 2*dy
    end

    line
end

"""
    high_line(start::Tuple{T, T}, stop::Tuple{T, T}) where T<:Integer

# Examples

```jldoctest
julia> high_line()

```
"""
function high_line(start::Tuple{T, T}, stop::Tuple{T, T}) where T<:Integer
    x0, y0 = start
    x1, y1 = stop
    line = fill((zero(T), zero(T)), length(y0:y1))
    dx = x1 - x0
    dy = y1 - y0
    xi = 1
    if dx < 0
        xi = -1
        dx = -dx
    end
    D = 2*dx - dy
    x = x0

    for y in y0:y1
        line[y - y0 + 1] =  (x, y)
        if D > 0
            x = x + xi
            D = D - 2*dy
        end
        D = D + 2*dx
    end

    line
end


#=
    Cheating model.

    From
    https://discourse.julialang.org/t/fitting-a-observed-value-to-a-binomial-distribution-turing/66619
    """
    Fitting a observed value to a Binomial Distribution Turing

    I am new to Turing and trying to learn it by trying to replicate the Chapters from the book
    https://github.com/CamDavidsonPilon/Probabilistic-Programming-and-Bayesian-Methods-for-Hackers 2 .

    Here is my problem (from Chapter 2) :

    1.) Have a probability p ~ Uniform(0,1) which I have to infer the “number_of_cheaters”
    2.) p_skewed = p*(0.5) + (0.25) (deterministic value)
    3.) with model:
    yes_responses = pm.Binomial(“number_of_cheaters”, 100, p_skewed, observed=35)

    How do I write this in Turing ?

    ...

    @model function model(yes_responses,N)
        p ~ Uniform(0,1)
        p_skewed = p*(0.5)+0.25
        rv_yes_responses ~ Binomial(N,p_skewed)

        // This line on how to include yes_responses i am unable to figure out

        return p_skewed

    end
   """

   The model refered to is in
   https://github.com/CamDavidsonPilon/Probabilistic-Programming-and-Bayesian-Methods-for-Hackers/blob/master/Chapter2_MorePyMC/Ch2_MorePyMC_PyMC3.ipynb

    Output of this Turing.jl model:
        Summary Statistics
    parameters      mean       std   naive_se      mcse        ess      rhat   ess_per_sec
        Symbol   Float64   Float64    Float64   Float64    Float64   Float64       Float64

               p    0.2042    0.0993     0.0031    0.0040   446.4728    0.9990      394.4106
        p_skewed    0.3521    0.0497     0.0016    0.0020   446.4728    0.9990      394.4106

    Quantiles
    parameters      2.5%     25.0%     50.0%     75.0%     97.5%
        Symbol   Float64   Float64   Float64   Float64   Float64

               p    0.0349    0.1325    0.2020    0.2749    0.3981
        p_skewed    0.2674    0.3162    0.3510    0.3875    0.4490

    Summary Stats:
    Length:         1000
    Missing Count:  0
    Mean:           0.352105
    Minimum:        0.250395
    1st Quartile:   0.316228
    Median:         0.350993
    3rd Quartile:   0.387453
    Maximum:        0.494718

=#

using Turing, StatsPlots, Distributions, StatsBase
using CSV
include("jl_utils.jl")

@model function cheating_model2(yes_responses,N)
    p ~ Uniform(0,1)
    # Using Dirac(.) makes p_skewed in the chain
    p_skewed ~ Dirac(p*(0.5)+0.25)
    # p_skewed = p*(0.5)+0.25
    yes_responses ~ Binomial(N,p_skewed)

    # An alternative is to return the variable (see below how to handle this)
    return p_skewed
end

yes_response = 35
N = 100
model = cheating_model2(yes_response,N)

# chns = sample(model, Prior(), 10_000)
# chns = sample(model, MH(), 10_000)
chns = sample(model, PG(5),  1_000)
# chns = sample(model, PG(5),  MCMCThreads(), 10_000, 4)
# chns = sample(model, SMC(), 10_000)
# chns = sample(model, IS(), 10_000)

# chns = sample(model, HMC(0.1,6), 1_000)
# chns = sample(model, NUTS(), 1_000)

display(chns)
# display(plot(chns))

chains_params = Turing.MCMCChains.get_sections(chns, :parameters)
genq = generated_quantities(model, chains_params)
display(summarystats(vcat(genq...)))


#    Problem : GROUP A
#    *********
#	 The extended Woods problem.
#	 This problem is a sum of n/4 sets of 6 terms, each of which is
#    assigned its own group.  For a given set i, the groups are
#    A(i), B(i), C(i), D(i), E(i) and F(i). Groups A(i) and C(i) contain 1
#    nonlinear element each, denoted Y(i) and Z(i).
#
#    The problem dimension is defined from the number of these sets.
#    The number of problem variables is then 4 times larger.
#
#	 This version uses a slightly unorthodox expression of Woods
#    function as a sum of squares (see Buckley)
#
#    Origonal SIF Source: problem 14 in
#    J.J. More', B.S. Garbow and K.E. Hillstrom,
#    "Testing Unconstrained Optimization Software",
#    ACM Transactions on Mathematical Software, vol. 7(1), pp. 17-41, 1981.
#
#    See also Toint#27, Buckley#17 (p. 101), Conn, Gould, Toint#7
#
#    WOODS.SIF classification SUR2-AN-V-0
#
#	 This problem is decomposed in n linear groups, the last n-1 of which
#    are 2 x 2 and singular.
#
#    NS is the number of sets (= n/4)
#
# Daniel Henderson, 08/2021

f = (x) -> begin
	fx = 0.0
	for i in 1:Int(lastindex(x)/4)
		fx += (100*(x[4*i-2]-x[4*i-3]^2)^2 + (1-x[4*i-3])^2 + 90*(x[4*i]-x[4*i-1]^2)^2 + (1-x[4*i-1])^2 + 10*(x[4*i-2]+x[4*i]-2)^2 + 0.1*(x[4*i-2]-x[4*i])^2)
	end
    return fx
end

g! = (g, x) -> begin
	for i in 1:Int(lastindex(x)/4)
		g[4i-3] = -2(1-x[4i-3]) - 400*x[4i-3]*(x[4i-2]-x[4i-3]^2)
		g[4i-2] = 200(x[4i-2]-x[4i-3]^2) + 0.2(x[4i-2]-x[4i]) + 20(x[4i-2] + x[4i]-2)
		g[4i-1] = -2(1-x[4i-1]) - 360*x[4i-1]*(x[4i]-x[4i-1]^2)
		g[4i] = -0.2(x[4i-2]-x[4i]) + 20(x[4i-2] + x[4i]-2) + 180(x[4i]-x[4i-1]^2)
	end
    return g
end

fg! = (g, x) -> begin
	fx = 0.0
	for i in 1:Int(lastindex(x)/4)
		fx += (100*(x[4*i-2]-x[4*i-3]^2)^2 + (1-x[4*i-3])^2 + 90*(x[4*i]-x[4*i-1]^2)^2 + (1-x[4*i-1])^2 + 10*(x[4*i-2]+x[4*i]-2)^2 + 0.1*(x[4*i-2]-x[4*i])^2)
		g[4i-3] = -2(1-x[4i-3]) - 400*x[4i-3]*(x[4i-2]-x[4i-3]^2)
		g[4i-2] = 200(x[4i-2]-x[4i-3]^2) + 0.2(x[4i-2]-x[4i]) + 20(x[4i-2] + x[4i]-2)
		g[4i-1] = -2(1-x[4i-1]) - 360*x[4i-1]*(x[4i]-x[4i-1]^2)
		g[4i] = -0.2(x[4i-2]-x[4i]) + 20(x[4i-2] + x[4i]-2) + 180(x[4i]-x[4i-1]^2)
	end
    return fx, g
end

init = (n::Int=4000) -> begin
	mod(n, 4) > 0 && @warn "WOODS: number of variables must be divisible by 4"
	q = max(1, div(n, 4))
	n = 4*q

	x0 = [j % 2 == 1 ? -3.0 : -1.0 for j in 1:n]
    return n, x0
end

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


using OrdinaryDiffEq, ParameterizedFunctions, ForwardDiff

f = @ode_def begin
  dx = a*x - b*x*y
  dy = -c*y + x*y
end a b c

p = [1.5,1.0,3.0]
prob = ODEProblem(f,[1.0;1.0],(0.0,10.0),p)
t = 0.0:0.5:10.0

function G(p)
  tmp_prob = remake(prob,u0=convert.(eltype(p),prob.u0),p=p)
  sol = solve(tmp_prob,Vern9(),abstol=1e-14,reltol=1e-14,saveat=t)
  A = convert(Array,sol)
  sum(((1 .- A).^2)./2)
end
# G([1.5,1.0,3.0])
# res2 = ForwardDiff.gradient(G,[1.5,1.0,3.0])

@info("Running forwarddiff")
# G([1.5,1.0,3.0])
es2 = ForwardDiff.gradient(G,[1.5,1.0,3.0])
# using Zygote
# Zygote.gradient(G,[1.5,1.0,3.0])