# This file is a part of Julia. License is MIT: http://julialang.org/license

# QR and Hessenberg Factorizations

struct QR{T,S<:AbstractMatrix} <: Factorization{T}
    factors::S
    τ::Vector{T}
    QR{T,S}(factors::AbstractMatrix{T}, τ::Vector{T}) where {T,S<:AbstractMatrix} = new(factors, τ)
end
QR(factors::AbstractMatrix{T}, τ::Vector{T}) where {T} = QR{T,typeof(factors)}(factors, τ)
# Note. For QRCompactWY factorization without pivoting, the WY representation based method introduced in LAPACK 3.4
struct QRCompactWY{S,M<:AbstractMatrix} <: Factorization{S}
    factors::M
    T::Matrix{S}
    QRCompactWY{S,M}(factors::AbstractMatrix{S}, T::AbstractMatrix{S}) where {S,M<:AbstractMatrix} = new(factors, T)
end
QRCompactWY(factors::AbstractMatrix{S}, T::AbstractMatrix{S}) where {S} = QRCompactWY{S,typeof(factors)}(factors, T)

struct QRPivoted{T,S<:AbstractMatrix} <: Factorization{T}
    factors::S
    τ::Vector{T}
    jpvt::Vector{BlasInt}
    QRPivoted{T,S}(factors::AbstractMatrix{T}, τ::Vector{T}, jpvt::Vector{BlasInt}) where {T,S<:AbstractMatrix} =
        new(factors, τ, jpvt)
end
QRPivoted(factors::AbstractMatrix{T}, τ::Vector{T}, jpvt::Vector{BlasInt}) where {T} =
    QRPivoted{T,typeof(factors)}(factors, τ, jpvt)

function qrfactUnblocked!{T}(A::AbstractMatrix{T})
    m, n = size(A)
    τ = zeros(T, min(m,n))
    for k = 1:min(m - 1 + !(T<:Real), n)
        x = view(A, k:m, k)
        τk = reflector!(x)
        τ[k] = τk
        reflectorApply!(x, τk, view(A, k:m, k + 1:n))
    end
    QR(A, τ)
end

# Find index for columns with largest two norm
function indmaxcolumn(A::StridedMatrix)
    mm = norm(view(A, :, 1))
    ii = 1
    for i = 2:size(A, 2)
        mi = norm(view(A, :, i))
        if abs(mi) > mm
            mm = mi
            ii = i
        end
    end
    return ii
end

function qrfactPivotedUnblocked!(A::StridedMatrix)
    m, n = size(A)
    piv = collect(UnitRange{BlasInt}(1,n))
    τ = Array{eltype(A)}(min(m,n))
    for j = 1:min(m,n)

        # Find column with maximum norm in trailing submatrix
        jm = indmaxcolumn(view(A, j:m, j:n)) + j - 1

        if jm != j
            # Flip elements in pivoting vector
            tmpp = piv[jm]
            piv[jm] = piv[j]
            piv[j] = tmpp

            # Update matrix with
            for i = 1:m
                tmp = A[i,jm]
                A[i,jm] = A[i,j]
                A[i,j] = tmp
            end
        end

        # Compute reflector of columns j
        x = view(A, j:m, j)
        τj = LinAlg.reflector!(x)
        τ[j] = τj

        # Update trailing submatrix with reflector
        LinAlg.reflectorApply!(x, τj, view(A, j:m, j+1:n))
    end
    return LinAlg.QRPivoted{eltype(A), typeof(A)}(A, τ, piv)
end

# LAPACK version
qrfact!(A::StridedMatrix{<:BlasFloat}, ::Type{Val{false}}) = QRCompactWY(LAPACK.geqrt!(A, min(minimum(size(A)), 36))...)
qrfact!(A::StridedMatrix{<:BlasFloat}, ::Type{Val{true}}) = QRPivoted(LAPACK.geqp3!(A)...)
qrfact!(A::StridedMatrix{<:BlasFloat}) = qrfact!(A, Val{false})

# Generic fallbacks

"""
    qrfact!(A, pivot=Val{false})

`qrfact!` is the same as [`qrfact`](@ref) when `A` is a subtype of
`StridedMatrix`, but saves space by overwriting the input `A`, instead of creating a copy.
An [`InexactError`](@ref) exception is thrown if the factorization produces a number not
representable by the element type of `A`, e.g. for integer types.
"""
qrfact!(A::StridedMatrix, ::Type{Val{false}}) = qrfactUnblocked!(A)
qrfact!(A::StridedMatrix, ::Type{Val{true}}) = qrfactPivotedUnblocked!(A)
qrfact!(A::StridedMatrix) = qrfact!(A, Val{false})

"""
    qrfact(A, pivot=Val{false}) -> F

Computes the QR factorization of `A`. The return type of `F` depends on the element type of
`A` and whether pivoting is specified (with `pivot==Val{true}`).

| Return type   | `eltype(A)`     | `pivot`      | Relationship between `F` and `A` |
|:--------------|:----------------|:-------------|:---------------------------------|
| `QR`          | not `BlasFloat` | either       | `A==F[:Q]*F[:R]`                 |
| `QRCompactWY` | `BlasFloat`     | `Val{false}` | `A==F[:Q]*F[:R]`                 |
| `QRPivoted`   | `BlasFloat`     | `Val{true}`  | `A[:,F[:p]]==F[:Q]*F[:R]`        |

`BlasFloat` refers to any of: `Float32`, `Float64`, `Complex64` or `Complex128`.

The individual components of the factorization `F` can be accessed by indexing:

| Component | Description                               | `QR`            | `QRCompactWY`      | `QRPivoted`     |
|:----------|:------------------------------------------|:----------------|:-------------------|:----------------|
| `F[:Q]`   | `Q` (orthogonal/unitary) part of `QR`     | ✓ (`QRPackedQ`) | ✓ (`QRCompactWYQ`) | ✓ (`QRPackedQ`) |
| `F[:R]`   | `R` (upper right triangular) part of `QR` | ✓               | ✓                  | ✓               |
| `F[:p]`   | pivot `Vector`                            |                 |                    | ✓               |
| `F[:P]`   | (pivot) permutation `Matrix`              |                 |                    | ✓               |

The following functions are available for the `QR` objects: [`size`](@ref)
and [`\\`](@ref). When `A` is rectangular, `\\` will return a least squares
solution and if the solution is not unique, the one with smallest norm is returned.

Multiplication with respect to either thin or full `Q` is allowed, i.e. both `F[:Q]*F[:R]`
and `F[:Q]*A` are supported. A `Q` matrix can be converted into a regular matrix with
[`full`](@ref) which has a named argument `thin`.

# Example

```jldoctest
julia> A = [3.0 -6.0; 4.0 -8.0; 0.0 1.0]
3×2 Array{Float64,2}:
 3.0  -6.0
 4.0  -8.0
 0.0   1.0

julia> F = qrfact(A)
Base.LinAlg.QRCompactWY{Float64,Array{Float64,2}} with factors Q and R:
[-0.6 0.0 0.8; -0.8 0.0 -0.6; 0.0 -1.0 0.0]
[-5.0 10.0; 0.0 -1.0]

julia> F[:Q] * F[:R] == A
true
```

!!! note
    `qrfact` returns multiple types because LAPACK uses several representations
    that minimize the memory storage requirements of products of Householder
    elementary reflectors, so that the `Q` and `R` matrices can be stored
    compactly rather as two separate dense matrices.

    The data contained in `QR` or `QRPivoted` can be used to construct the
    `QRPackedQ` type, which is a compact representation of the rotation matrix:

    ```math
    Q = \\prod_{i=1}^{\\min(m,n)} (I - \\tau_i v_i v_i^T)
    ```

    where ``\\tau_i`` is the scale factor and ``v_i`` is the projection vector
    associated with the ``i^{th}`` Householder elementary reflector.

    The data contained in `QRCompactWY` can be used to construct the
    `QRCompactWYQ` type, which is a compact representation of the rotation
    matrix

    ```math
    Q = I + Y T Y^T
    ```

    where `Y` is ``m \\times r`` lower trapezoidal and `T` is ``r \\times r``
    upper triangular. The *compact WY* representation [^Schreiber1989] is not
    to be confused with the older, *WY* representation [^Bischof1987]. (The
    LAPACK documentation uses `V` in lieu of `Y`.)

    [^Bischof1987]: C Bischof and C Van Loan, "The WY representation for products of Householder matrices", SIAM J Sci Stat Comput 8 (1987), s2-s13. [doi:10.1137/0908009](http://dx.doi.org/10.1137/0908009)

    [^Schreiber1989]: R Schreiber and C Van Loan, "A storage-efficient WY representation for products of Householder transformations", SIAM J Sci Stat Comput 10 (1989), 53-57. [doi:10.1137/0910005](http://dx.doi.org/10.1137/0910005)
"""
function qrfact{T}(A::AbstractMatrix{T}, arg)
    AA = similar(A, typeof(zero(T)/norm(one(T))), size(A))
    copy!(AA, A)
    return qrfact!(AA, arg)
end
function qrfact{T}(A::AbstractMatrix{T})
    AA = similar(A, typeof(zero(T)/norm(one(T))), size(A))
    copy!(AA, A)
    return qrfact!(AA)
end
qrfact(x::Number) = qrfact(fill(x,1,1))

"""
    qr(A, pivot=Val{false}; thin::Bool=true) -> Q, R, [p]

Compute the (pivoted) QR factorization of `A` such that either `A = Q*R` or `A[:,p] = Q*R`.
Also see [`qrfact`](@ref).
The default is to compute a thin factorization. Note that `R` is not
extended with zeros when the full `Q` is requested.
"""
qr(A::Union{Number, AbstractMatrix}, pivot::Union{Type{Val{false}}, Type{Val{true}}}=Val{false}; thin::Bool=true) =
    _qr(A, pivot, thin=thin)
function _qr(A::Union{Number, AbstractMatrix}, ::Type{Val{false}}; thin::Bool=true)
    F = qrfact(A, Val{false})
    full(getq(F), thin=thin), F[:R]::Matrix{eltype(F)}
end
function _qr(A::Union{Number, AbstractMatrix}, ::Type{Val{true}}; thin::Bool=true)
    F = qrfact(A, Val{true})
    full(getq(F), thin=thin), F[:R]::Matrix{eltype(F)}, F[:p]::Vector{BlasInt}
end

"""
    qr(v::AbstractVector) -> w, r

Computes the polar decomposition of a vector.
Returns `w`, a unit vector in the direction of `v`, and
`r`, the norm of `v`.

See also [`normalize`](@ref), [`normalize!`](@ref),
and [`LinAlg.qr!`](@ref).

# Example

```jldoctest
julia> v = [1; 2]
2-element Array{Int64,1}:
 1
 2

julia> w, r = qr(v)
([0.447214, 0.894427], 2.23606797749979)

julia> w*r == v
true
```
"""
function qr(v::AbstractVector)
    nrm = norm(v)
    if !isempty(v)
        vv = copy_oftype(v, typeof(v[1]/nrm))
        return __normalize!(vv, nrm), nrm
    else
        T = typeof(zero(eltype(v))/nrm)
        return T[], oneunit(T)
    end
end

"""
    LinAlg.qr!(v::AbstractVector) -> w, r

Computes the polar decomposition of a vector. Instead of returning a new vector
as `qr(v::AbstractVector)`, this function mutates the input vector `v` in place.
Returns `w`, a unit vector in the direction of `v` (this is a mutation of `v`),
and `r`, the norm of `v`.

See also [`normalize`](@ref), [`normalize!`](@ref),
and [`qr`](@ref).
"""
function qr!(v::AbstractVector)
    nrm = norm(v)
    __normalize!(v, nrm), nrm
end

# Conversions
convert{T}(::Type{QR{T}}, A::QR) = QR(convert(AbstractMatrix{T}, A.factors), convert(Vector{T}, A.τ))
convert{T}(::Type{Factorization{T}}, A::QR{T}) = A
convert{T}(::Type{Factorization{T}}, A::QR) = convert(QR{T}, A)
convert{T}(::Type{QRCompactWY{T}}, A::QRCompactWY) = QRCompactWY(convert(AbstractMatrix{T}, A.factors), convert(AbstractMatrix{T}, A.T))
convert{T}(::Type{Factorization{T}}, A::QRCompactWY{T}) = A
convert{T}(::Type{Factorization{T}}, A::QRCompactWY) = convert(QRCompactWY{T}, A)
convert(::Type{AbstractMatrix}, F::Union{QR,QRCompactWY}) = F[:Q] * F[:R]
convert(::Type{AbstractArray}, F::Union{QR,QRCompactWY}) = convert(AbstractMatrix, F)
convert(::Type{Matrix}, F::Union{QR,QRCompactWY}) = convert(Array, convert(AbstractArray, F))
convert(::Type{Array}, F::Union{QR,QRCompactWY}) = convert(Matrix, F)
full(F::Union{QR,QRCompactWY}) = convert(AbstractArray, F)
convert{T}(::Type{QRPivoted{T}}, A::QRPivoted) = QRPivoted(convert(AbstractMatrix{T}, A.factors), convert(Vector{T}, A.τ), A.jpvt)
convert{T}(::Type{Factorization{T}}, A::QRPivoted{T}) = A
convert{T}(::Type{Factorization{T}}, A::QRPivoted) = convert(QRPivoted{T}, A)
convert(::Type{AbstractMatrix}, F::QRPivoted) = (F[:Q] * F[:R])[:,invperm(F[:p])]
convert(::Type{AbstractArray}, F::QRPivoted) = convert(AbstractMatrix, F)
convert(::Type{Matrix}, F::QRPivoted) = convert(Array, convert(AbstractArray, F))
convert(::Type{Array}, F::QRPivoted) = convert(Matrix, F)
full(F::QRPivoted) = convert(AbstractArray, F)

function show(io::IO, F::Union{QR, QRCompactWY, QRPivoted})
    println(io, "$(typeof(F)) with factors Q and R:")
    show(io, F[:Q])
    println(io)
    show(io, F[:R])
end

function getindex(A::QR, d::Symbol)
    m, n = size(A)
    if d == :R
        return triu!(A.factors[1:min(m,n), 1:n])
    elseif d == :Q
        return getq(A)
    else
        throw(KeyError(d))
    end
end
function getindex(A::QRCompactWY, d::Symbol)
    m, n = size(A)
    if d == :R
        return triu!(A.factors[1:min(m,n), 1:n])
    elseif d == :Q
        return getq(A)
    else
        throw(KeyError(d))
    end
end
function getindex{T}(A::QRPivoted{T}, d::Symbol)
    m, n = size(A)
    if d == :R
        return triu!(A.factors[1:min(m,n), 1:n])
    elseif d == :Q
        return getq(A)
    elseif d == :p
        return A.jpvt
    elseif d == :P
        p = A[:p]
        n = length(p)
        P = zeros(T, n, n)
        for i in 1:n
            P[p[i],i] = one(T)
        end
        return P
    else
        throw(KeyError(d))
    end
end

# Type-stable interface to get Q
getq(A::QRCompactWY) = QRCompactWYQ(A.factors,A.T)
getq(A::Union{QR, QRPivoted}) = QRPackedQ(A.factors,A.τ)

struct QRPackedQ{T,S<:AbstractMatrix} <: AbstractMatrix{T}
    factors::S
    τ::Vector{T}
    QRPackedQ{T,S}(factors::AbstractMatrix{T}, τ::Vector{T}) where {T,S<:AbstractMatrix} = new(factors, τ)
end
QRPackedQ(factors::AbstractMatrix{T}, τ::Vector{T}) where {T} = QRPackedQ{T,typeof(factors)}(factors, τ)

struct QRCompactWYQ{S, M<:AbstractMatrix} <: AbstractMatrix{S}
    factors::M
    T::Matrix{S}
    QRCompactWYQ{S,M}(factors::AbstractMatrix{S}, T::Matrix{S}) where {S,M<:AbstractMatrix} = new(factors, T)
end
QRCompactWYQ(factors::AbstractMatrix{S}, T::Matrix{S}) where {S} = QRCompactWYQ{S,typeof(factors)}(factors, T)

convert{T}(::Type{QRPackedQ{T}}, Q::QRPackedQ) = QRPackedQ(convert(AbstractMatrix{T}, Q.factors), convert(Vector{T}, Q.τ))
convert{T}(::Type{AbstractMatrix{T}}, Q::QRPackedQ{T}) = Q
convert{T}(::Type{AbstractMatrix{T}}, Q::QRPackedQ) = convert(QRPackedQ{T}, Q)
convert{S}(::Type{QRCompactWYQ{S}}, Q::QRCompactWYQ) = QRCompactWYQ(convert(AbstractMatrix{S}, Q.factors), convert(AbstractMatrix{S}, Q.T))
convert{S}(::Type{AbstractMatrix{S}}, Q::QRCompactWYQ{S}) = Q
convert{S}(::Type{AbstractMatrix{S}}, Q::QRCompactWYQ) = convert(QRCompactWYQ{S}, Q)
convert{T}(::Type{Matrix}, A::Union{QRPackedQ{T},QRCompactWYQ{T}}) = A_mul_B!(A, eye(T, size(A.factors, 1), minimum(size(A.factors))))
convert(::Type{Array}, A::Union{QRPackedQ,QRCompactWYQ}) = convert(Matrix, A)

"""
    full(A::Union{QRPackedQ,QRCompactWYQ}; thin::Bool=true) -> Matrix

Converts an orthogonal or unitary matrix stored as a `QRCompactWYQ` object, i.e. in the
compact WY format [^Bischof1987], or in the `QRPackedQ` format, to a dense matrix.

Optionally takes a `thin` Boolean argument, which if `true` omits the columns that span the
rows of `R` in the QR factorization that are zero. The resulting matrix is the `Q` in a thin
QR factorization (sometimes called the reduced QR factorization). If `false`, returns a `Q`
that spans all rows of `R` in its corresponding QR factorization.
"""
function full{T}(A::Union{QRPackedQ{T},QRCompactWYQ{T}}; thin::Bool = true)
    if thin
        convert(Array, A)
    else
        A_mul_B!(A, eye(T, size(A.factors, 1)))
    end
end

size(A::Union{QR,QRCompactWY,QRPivoted}, dim::Integer) = size(A.factors, dim)
size(A::Union{QR,QRCompactWY,QRPivoted}) = size(A.factors)
size(A::Union{QRPackedQ,QRCompactWYQ}, dim::Integer) = 0 < dim ? (dim <= 2 ? size(A.factors, 1) : 1) : throw(BoundsError())
size(A::Union{QRPackedQ,QRCompactWYQ}) = size(A, 1), size(A, 2)

function getindex(A::Union{QRPackedQ,QRCompactWYQ}, i::Integer, j::Integer)
    x = zeros(eltype(A), size(A, 1))
    x[i] = 1
    y = zeros(eltype(A), size(A, 2))
    y[j] = 1
    return dot(x, A_mul_B!(A, y))
end

## Multiplication by Q
### QB
A_mul_B!{T<:BlasFloat}(A::QRCompactWYQ{T}, B::StridedVecOrMat{T}) = LAPACK.gemqrt!('L','N',A.factors,A.T,B)
A_mul_B!{T<:BlasFloat}(A::QRPackedQ{T}, B::StridedVecOrMat{T}) = LAPACK.ormqr!('L','N',A.factors,A.τ,B)
function A_mul_B!(A::QRPackedQ, B::AbstractVecOrMat)
    mA, nA = size(A.factors)
    mB, nB = size(B,1), size(B,2)
    if mA != mB
        throw(DimensionMismatch("matrix A has dimensions ($mA,$nA) but B has dimensions ($mB, $nB)"))
    end
    Afactors = A.factors
    @inbounds begin
        for k = min(mA,nA):-1:1
            for j = 1:nB
                vBj = B[k,j]
                for i = k+1:mB
                    vBj += conj(Afactors[i,k])*B[i,j]
                end
                vBj = A.τ[k]*vBj
                B[k,j] -= vBj
                for i = k+1:mB
                    B[i,j] -= Afactors[i,k]*vBj
                end
            end
        end
    end
    B
end

function (*)(A::Union{QRPackedQ,QRCompactWYQ}, b::StridedVector)
    TAb = promote_type(eltype(A), eltype(b))
    Anew = convert(AbstractMatrix{TAb}, A)
    if size(A.factors, 1) == length(b)
        bnew = copy_oftype(b, TAb)
    elseif size(A.factors, 2) == length(b)
        bnew = [b; zeros(TAb, size(A.factors, 1) - length(b))]
    else
        throw(DimensionMismatch("vector must have length either $(size(A.factors, 1)) or $(size(A.factors, 2))"))
    end
    A_mul_B!(Anew, bnew)
end
function (*)(A::Union{QRPackedQ,QRCompactWYQ}, B::StridedMatrix)
    TAB = promote_type(eltype(A), eltype(B))
    Anew = convert(AbstractMatrix{TAB}, A)
    if size(A.factors, 1) == size(B, 1)
        Bnew = copy_oftype(B, TAB)
    elseif size(A.factors, 2) == size(B, 1)
        Bnew = [B; zeros(TAB, size(A.factors, 1) - size(B,1), size(B, 2))]
    else
        throw(DimensionMismatch("first dimension of matrix must have size either $(size(A.factors, 1)) or $(size(A.factors, 2))"))
    end
    A_mul_B!(Anew, Bnew)
end

### QcB
Ac_mul_B!{T<:BlasReal}(A::QRCompactWYQ{T}, B::StridedVecOrMat{T}) = LAPACK.gemqrt!('L','T',A.factors,A.T,B)
Ac_mul_B!{T<:BlasComplex}(A::QRCompactWYQ{T}, B::StridedVecOrMat{T}) = LAPACK.gemqrt!('L','C',A.factors,A.T,B)
Ac_mul_B!{T<:BlasReal}(A::QRPackedQ{T}, B::StridedVecOrMat{T}) = LAPACK.ormqr!('L','T',A.factors,A.τ,B)
Ac_mul_B!{T<:BlasComplex}(A::QRPackedQ{T}, B::StridedVecOrMat{T}) = LAPACK.ormqr!('L','C',A.factors,A.τ,B)
function Ac_mul_B!(A::QRPackedQ, B::AbstractVecOrMat)
    mA, nA = size(A.factors)
    mB, nB = size(B,1), size(B,2)
    if mA != mB
        throw(DimensionMismatch("matrix A has dimensions ($mA,$nA) but B has dimensions ($mB, $nB)"))
    end
    Afactors = A.factors
    @inbounds begin
        for k = 1:min(mA,nA)
            for j = 1:nB
                vBj = B[k,j]
                for i = k+1:mB
                    vBj += conj(Afactors[i,k])*B[i,j]
                end
                vBj = conj(A.τ[k])*vBj
                B[k,j] -= vBj
                for i = k+1:mB
                    B[i,j] -= Afactors[i,k]*vBj
                end
            end
        end
    end
    B
end
function Ac_mul_B(Q::Union{QRPackedQ,QRCompactWYQ}, B::StridedVecOrMat)
    TQB = promote_type(eltype(Q), eltype(B))
    return Ac_mul_B!(convert(AbstractMatrix{TQB}, Q), copy_oftype(B, TQB))
end

### QBc/QcBc
for (f1, f2) in ((:A_mul_Bc, :A_mul_B!),
                 (:Ac_mul_Bc, :Ac_mul_B!))
    @eval begin
        function ($f1)(Q::Union{QRPackedQ,QRCompactWYQ}, B::StridedVecOrMat)
            TQB = promote_type(eltype(Q), eltype(B))
            Bc = similar(B, TQB, (size(B, 2), size(B, 1)))
            ctranspose!(Bc, B)
            return ($f2)(convert(AbstractMatrix{TQB}, Q), Bc)
        end
    end
end

### AQ
A_mul_B!{T<:BlasFloat}(A::StridedVecOrMat{T}, B::QRCompactWYQ{T}) = LAPACK.gemqrt!('R','N', B.factors, B.T, A)
A_mul_B!{T<:BlasFloat}(A::StridedVecOrMat{T}, B::QRPackedQ{T}) = LAPACK.ormqr!('R', 'N', B.factors, B.τ, A)
function A_mul_B!(A::StridedMatrix,Q::QRPackedQ)
    mQ, nQ = size(Q.factors)
    mA, nA = size(A,1), size(A,2)
    if nA != mQ
        throw(DimensionMismatch("matrix A has dimensions ($mA,$nA) but matrix Q has dimensions ($mQ, $nQ)"))
    end
    Qfactors = Q.factors
    @inbounds begin
        for k = 1:min(mQ,nQ)
            for i = 1:mA
                vAi = A[i,k]
                for j = k+1:mQ
                    vAi += A[i,j]*Qfactors[j,k]
                end
                vAi = vAi*Q.τ[k]
                A[i,k] -= vAi
                for j = k+1:nA
                    A[i,j] -= vAi*conj(Qfactors[j,k])
                end
            end
        end
    end
    A
end

function (*)(A::StridedMatrix, Q::Union{QRPackedQ,QRCompactWYQ})
    TAQ = promote_type(eltype(A), eltype(Q))
    return A_mul_B!(copy_oftype(A, TAQ), convert(AbstractMatrix{TAQ}, Q))
end

### AQc
A_mul_Bc!{T<:BlasReal}(A::StridedVecOrMat{T}, B::QRCompactWYQ{T}) = LAPACK.gemqrt!('R','T',B.factors,B.T,A)
A_mul_Bc!{T<:BlasComplex}(A::StridedVecOrMat{T}, B::QRCompactWYQ{T}) = LAPACK.gemqrt!('R','C',B.factors,B.T,A)
A_mul_Bc!{T<:BlasReal}(A::StridedVecOrMat{T}, B::QRPackedQ{T}) = LAPACK.ormqr!('R','T',B.factors,B.τ,A)
A_mul_Bc!{T<:BlasComplex}(A::StridedVecOrMat{T}, B::QRPackedQ{T}) = LAPACK.ormqr!('R','C',B.factors,B.τ,A)
function A_mul_Bc!(A::AbstractMatrix,Q::QRPackedQ)
    mQ, nQ = size(Q.factors)
    mA, nA = size(A,1), size(A,2)
    if nA != mQ
        throw(DimensionMismatch("matrix A has dimensions ($mA,$nA) but matrix Q has dimensions ($mQ, $nQ)"))
    end
    Qfactors = Q.factors
    @inbounds begin
        for k = min(mQ,nQ):-1:1
            for i = 1:mA
                vAi = A[i,k]
                for j = k+1:mQ
                    vAi += A[i,j]*Qfactors[j,k]
                end
                vAi = vAi*conj(Q.τ[k])
                A[i,k] -= vAi
                for j = k+1:nA
                    A[i,j] -= vAi*conj(Qfactors[j,k])
                end
            end
        end
    end
    A
end
function A_mul_Bc(A::AbstractMatrix, B::Union{QRCompactWYQ,QRPackedQ})
    TAB = promote_type(eltype(A),eltype(B))
    BB = convert(AbstractMatrix{TAB}, B)
    if size(A,2) == size(B.factors, 1)
        AA = similar(A, TAB, size(A))
        copy!(AA, A)
        return A_mul_Bc!(AA, BB)
    elseif size(A,2) == size(B.factors,2)
        return A_mul_Bc!([A zeros(TAB, size(A, 1), size(B.factors, 1) - size(B.factors, 2))], BB)
    else
        throw(DimensionMismatch("matrix A has dimensions $(size(A)) but matrix B has dimensions $(size(B))"))
    end
end
@inline A_mul_Bc(rowvec::RowVector, B::Union{LinAlg.QRCompactWYQ,LinAlg.QRPackedQ}) = ctranspose(B*ctranspose(rowvec))

### AcQ/AcQc
for (f1, f2) in ((:Ac_mul_B, :A_mul_B!),
                 (:Ac_mul_Bc, :A_mul_Bc!))
    @eval begin
        function ($f1)(A::StridedVecOrMat, Q::Union{QRPackedQ,QRCompactWYQ})
            TAQ = promote_type(eltype(A), eltype(Q))
            Ac = similar(A, TAQ, (size(A, 2), size(A, 1)))
            ctranspose!(Ac, A)
            return ($f2)(Ac, convert(AbstractMatrix{TAQ}, Q))
        end
    end
end

A_ldiv_B!{T<:BlasFloat}(A::QRCompactWY{T}, b::StridedVector{T}) = (A_ldiv_B!(UpperTriangular(A[:R]), view(Ac_mul_B!(A[:Q], b), 1:size(A, 2))); b)
A_ldiv_B!{T<:BlasFloat}(A::QRCompactWY{T}, B::StridedMatrix{T}) = (A_ldiv_B!(UpperTriangular(A[:R]), view(Ac_mul_B!(A[:Q], B), 1:size(A, 2), 1:size(B, 2))); B)

# Julia implementation similarly to xgelsy
function A_ldiv_B!{T<:BlasFloat}(A::QRPivoted{T}, B::StridedMatrix{T}, rcond::Real)
    mA, nA = size(A.factors)
    nr = min(mA,nA)
    nrhs = size(B, 2)
    if nr == 0 return zeros(T, 0, nrhs), 0 end
    ar = abs(A.factors[1])
    if ar == 0 return zeros(T, nr, nrhs), 0 end
    rnk = 1
    xmin = ones(T, 1)
    xmax = ones(T, 1)
    tmin = tmax = ar
    while rnk < nr
        tmin, smin, cmin = LAPACK.laic1!(2, xmin, tmin, view(A.factors, 1:rnk, rnk + 1), A.factors[rnk + 1, rnk + 1])
        tmax, smax, cmax = LAPACK.laic1!(1, xmax, tmax, view(A.factors, 1:rnk, rnk + 1), A.factors[rnk + 1, rnk + 1])
        tmax*rcond > tmin && break
        push!(xmin, cmin)
        push!(xmax, cmax)
        for i = 1:rnk
            xmin[i] *= smin
            xmax[i] *= smax
        end
        rnk += 1
    end
    C, τ = LAPACK.tzrzf!(A.factors[1:rnk,:])
    A_ldiv_B!(UpperTriangular(C[1:rnk,1:rnk]),view(Ac_mul_B!(getq(A),view(B, 1:mA, 1:nrhs)),1:rnk,1:nrhs))
    B[rnk+1:end,:] = zero(T)
    LAPACK.ormrz!('L', eltype(B)<:Complex ? 'C' : 'T', C, τ, view(B,1:nA,1:nrhs))
    B[1:nA,:] = view(B, 1:nA, :)[invperm(A[:p]::Vector{BlasInt}),:]
    return B, rnk
end
A_ldiv_B!{T<:BlasFloat}(A::QRPivoted{T}, B::StridedVector{T}) = vec(A_ldiv_B!(A,reshape(B,length(B),1)))
A_ldiv_B!{T<:BlasFloat}(A::QRPivoted{T}, B::StridedVecOrMat{T}) = A_ldiv_B!(A, B, maximum(size(A))*eps(real(float(one(eltype(B))))))[1]
function A_ldiv_B!{T}(A::QR{T}, B::StridedMatrix{T})
    m, n = size(A)
    minmn = min(m,n)
    mB, nB = size(B)
    Ac_mul_B!(A[:Q], view(B, 1:m, :))
    R = A[:R]
    @inbounds begin
        if n > m # minimum norm solution
            τ = zeros(T,m)
            for k = m:-1:1 # Trapezoid to triangular by elementary operation
                x = view(R, k, [k; m + 1:n])
                τk = reflector!(x)
                τ[k] = τk'
                for i = 1:k - 1
                    vRi = R[i,k]
                    for j = m + 1:n
                        vRi += R[i,j]*x[j - m + 1]'
                    end
                    vRi *= τk
                    R[i,k] -= vRi
                    for j = m + 1:n
                        R[i,j] -= vRi*x[j - m + 1]
                    end
                end
            end
        end
        Base.A_ldiv_B!(UpperTriangular(view(R, :, 1:minmn)), view(B, 1:minmn, :))
        if n > m # Apply elementary transformation to solution
            B[m + 1:mB,1:nB] = zero(T)
            for j = 1:nB
                for k = 1:m
                    vBj = B[k,j]
                    for i = m + 1:n
                        vBj += B[i,j]*R[k,i]'
                    end
                    vBj *= τ[k]
                    B[k,j] -= vBj
                    for i = m + 1:n
                        B[i,j] -= R[k,i]*vBj
                    end
                end
            end
        end
    end
    return B
end
A_ldiv_B!(A::QR, B::StridedVector) = A_ldiv_B!(A, reshape(B, length(B), 1))[:]
function A_ldiv_B!(A::QRPivoted, b::StridedVector)
    A_ldiv_B!(QR(A.factors,A.τ), b)
    b[1:size(A.factors, 2)] = view(b, 1:size(A.factors, 2))[invperm(A.jpvt)]
    b
end
function A_ldiv_B!(A::QRPivoted, B::StridedMatrix)
    A_ldiv_B!(QR(A.factors, A.τ), B)
    B[1:size(A.factors, 2),:] = view(B, 1:size(A.factors, 2), :)[invperm(A.jpvt),:]
    B
end

# convenience methods
## return only the solution of a least squares problem while avoiding promoting
## vectors to matrices.
_cut_B(x::AbstractVector, r::UnitRange) = length(x)  > length(r) ? x[r]   : x
_cut_B(X::AbstractMatrix, r::UnitRange) = size(X, 1) > length(r) ? X[r,:] : X

## append right hand side with zeros if necessary
function _append_zeros(b::AbstractVector, T::Type, n)
    if n > length(b)
        x = zeros(T, n)
        return copy!(x, b)
    else
        return copy_oftype(b, T)
    end
end
function _append_zeros(B::AbstractMatrix, T::Type, n)
    if n > size(B, 1)
        X = zeros(T, (n, size(B, 2)))
        X[1:size(B,1), :] = B
        return X
    else
        return copy_oftype(B, T)
    end
end

function (\){TA,TB}(A::Union{QR{TA},QRCompactWY{TA},QRPivoted{TA}}, B::AbstractVecOrMat{TB})
    S = promote_type(TA,TB)
    m, n = size(A)
    m == size(B,1) || throw(DimensionMismatch("left hand side has $m rows, but right hand side has $(size(B,1)) rows"))

    AA = convert(Factorization{S}, A)

    X = A_ldiv_B!(AA, _append_zeros(B, S, n))

    return _cut_B(X, 1:n)
end

# With a real lhs and complex rhs with the same precision, we can reinterpret the complex
# rhs as a real rhs with twice the number of columns.

# convenience methods to compute the return size correctly for vectors and matrices
_ret_size(A::Factorization, b::AbstractVector) = (max(size(A, 2), length(b)),)
_ret_size(A::Factorization, B::AbstractMatrix) = (max(size(A, 2), size(B, 1)), size(B, 2))

function (\){T<:BlasReal}(A::Union{QR{T},QRCompactWY{T},QRPivoted{T}}, BIn::VecOrMat{Complex{T}})
    m, n = size(A)
    m == size(BIn, 1) || throw(DimensionMismatch("left hand side has $m rows, but right hand side has $(size(BIn,1)) rows"))

# |z1|z3|  reinterpret  |x1|x2|x3|x4|  transpose  |x1|y1|  reshape  |x1|y1|x3|y3|
# |z2|z4|      ->       |y1|y2|y3|y4|     ->      |x2|y2|     ->    |x2|y2|x4|y4|
#                                                 |x3|y3|
#                                                 |x4|y4|
    B = reshape(transpose(reinterpret(T, BIn, (2, length(BIn)))), size(BIn, 1), 2*size(BIn, 2))

    X = A_ldiv_B!(A, _append_zeros(B, T, n))

# |z1|z3|  reinterpret  |x1|x2|x3|x4|  transpose  |x1|y1|  reshape  |x1|y1|x3|y3|
# |z2|z4|      <-       |y1|y2|y3|y4|     <-      |x2|y2|     <-    |x2|y2|x4|y4|
#                                                 |x3|y3|
#                                                 |x4|y4|
    XX = reinterpret(Complex{T}, transpose(reshape(X, div(length(X), 2), 2)), _ret_size(A, BIn))
    return _cut_B(XX, 1:n)
end

##TODO:  Add methods for rank(A::QRP{T}) and adjust the (\) method accordingly
##       Add rcond methods for Cholesky, LU, QR and QRP types
## Lower priority: Add LQ, QL and RQ factorizations

# FIXME! Should add balancing option through xgebal


using Pipe

function parse_line(l)
    lhs, rhs = split(l, " -> ")
    x₁, y₁ = 1 .+ parse.(Int, split(lhs, ","))
    x₂, y₂ = 1 .+ parse.(Int, split(rhs, ","))
    @pipe ((x₁,x₂), (y₁,y₂)) .|> make_range(_...)
end

make_range(u, v) = u ≤ v ? (u:v) : (u:-1:v)

const data = parse_line.(readlines())

grid = zeros(Int, (1000, 1000))
for (r_x, r_y) in data
    (length(r_x) > 1) ⊻ (length(r_y) > 1) && (grid[r_x, r_y] .+= 1)

    # Comment for Part 1
    length(r_y) == length(r_x) && for (xx, yy) in zip(r_x, r_y)
        grid[xx, yy] += 1
    end
end

@pipe grid |> count(≥(2), _) |> println


module TestScikitLearn

import MLJModels, ScikitLearn
using MLJBase, Tables, Test, LinearAlgebra, Random, MLJModels.ScikitLearn_, CategoricalArrays, RDatasets
include("../testutils.jl")

include("svm.jl")
include("linear-regressors.jl")
include("linear-classifiers.jl")
include("gaussian-process.jl")
include("ensemble.jl")
include("discriminant-analysis.jl")
include("misc.jl")

end
true


function test_dropout_layer(backend::Backend, T, eps)
  println("-- Testing Dropout on $(typeof(backend)){$T}...")

  tensor_dim = abs(rand(Int)) % 6 + 1
  dims = tuple((abs(rand(Int, tensor_dim)) % 8 + 1)...)
  println("    > $dims")

  ratio = convert(T, 0.6)
  input = rand(T, dims)
  input_blob = make_blob(backend, input)
  diff_blob  = make_blob(backend, input)

  println("    > Setup")
  layer = DropoutLayer(bottoms=[:input], ratio=ratio)
  state = setup(backend, layer, Blob[input_blob], Blob[diff_blob])

  println("    > Forward")
  forward(backend, state, Blob[input_blob])
  got_output = zeros(T, size(input))
  copy!(got_output, input_blob)
  rand_vals = zeros(T, size(input))
  copy!(rand_vals, state.rand_vals)
  expected_output = input .* (rand_vals .> ratio) / (1-ratio)
  @test all(abs(got_output - expected_output) .< eps)

  println("    > Backward")
  top_diff = rand(T, size(input))
  copy!(diff_blob, top_diff)
  backward(backend, state, Blob[input_blob], Blob[diff_blob])
  expected_grad = top_diff .* (rand_vals .> ratio) / (1-ratio)
  got_grad = zeros(T, size(expected_grad))
  copy!(got_grad, diff_blob)
  @test all(abs(got_grad - expected_grad) .< eps)

  shutdown(backend, state)
end
function test_dropout_layer(backend::Backend)
  test_dropout_layer(backend, Float64, 1e-10)
  test_dropout_layer(backend, Float32, 1e-4)
end

if test_cpu
  test_dropout_layer(backend_cpu)
end
if test_gpu
  test_dropout_layer(backend_gpu)
end


struct Vertex{T, U<:Complex, V<:AbstractVector{T}}
  position::V
  value::U
end
Vertex(x::AbstractVector, f::F) where {F} = Vertex(x, f(x))

value(v::Vertex) = v.value
position(v::Vertex) = v.position
newposition(a, ϵ, b) = a + ϵ .* (a - b)

function vertexpositions(ic::T, initial_steps::AbstractVector{V}
    ) where {U, T<:AbstractVector{U}, V<:Number}
  if any(iszero, initial_steps)
    throw(ArgumentError("initial_steps, $initial_steps  must not have any zero
                        values"))
  end
  if length(ic) != length(initial_steps)
    throw(ArgumentError("ic, $ic must be same length as initial_steps
                        $initial_steps"))
  end
  dim = length(ic)
  fx(i) = T([@inbounds ic[j] + (j == i) * initial_steps[j] for j ∈ 1:dim])
  positions = map(fx, 1:dim+1)
  return positions
end

# must explicitly use <= and >= because == can't overridden and will
# be used in conjunction with < to create a <=
import Base: isless, +, -, <=, >=, isequal, isnan, hash
Base.isless(a::Vertex, b::Vertex) = abs(value(a)) < abs(value(b))
Base.:<=(a::Vertex, b::Vertex) = abs(value(a)) <= abs(value(b))
Base.:>=(a::Vertex, b::Vertex) = abs(value(a)) >= abs(value(b))
Base.:-(a::Vertex, b::Vertex) = position(a) - position(b)
Base.:-(a::AbstractVector, b::Vertex) = a - position(b)
Base.:+(a::Vertex, b::AbstractVector) = position(a) + b
function Base.isequal(a::Vertex, b::Vertex)
  values_equal = value(a) == value(b) || (isnan(a) && isnan(b))
  positions_equal = position(a) == position(b)
  return values_equal && positions_equal
end
Base.hash(v::Vertex) = hash(hash(v.value), hash(v.position))

Base.isnan(a::Vertex) = isnan(value(a))


using LinearAlgebraicRepresentation
using Plasm, LinearAlgebra
Lar = LinearAlgebraicRepresentation
using SparseArrays

store = []
scaling = 1.75
V,(VV,EV,FV,CV) = Lar.cuboid([0.25,0.25,0.25],true,[-0.25,-0.25,-0.25])
mybox = (V,CV,FV,EV)
for k=1:10
	size = rand()*scaling
	scale = Lar.s(size,size,size)
	transl = Lar.t(rand(3)...)
	alpha = 2*pi*rand()
	rx = Lar.r(alpha,0,0); ry = Lar.r(0,alpha,0); rz = Lar.r(0,0,alpha)
	rot = rx * ry * rz
	s = Lar.Struct([ transl, scale, rot, mybox ])
	push!(store, Lar.struct2lar(s))
end

s = Lar.Struct(store)
V,CV,FV,EV = Lar.struct2lar(s)
# V = Plasm.normalize3D(V) TODO:  solve MethodError bug
Plasm.view(V,CV)

cop_EV = Lar.coboundary_0(EV::Lar.Cells);
cop_EW = convert(Lar.ChainOp, cop_EV);
cop_FE = Lar.coboundary_1(V, FV::Lar.Cells, EV::Lar.Cells);
W = convert(Lar.Points, V');

V, copEV, copFE, copCF = Lar.space_arrangement(
	W::Lar.Points, cop_EW::Lar.ChainOp, cop_FE::Lar.ChainOp)

cc = [copEV, copFE, copCF]
output = Lar.lar2obj(V::Lar.Points, cc::Lar.ChainComplex)

f = open("test/out3d.obj", "w")
print(f, output)
close(f)

V,EVs,FVs = Lar.obj2lar("test/out3d.obj")

for k=1:length(FVs)
	Plasm.view(V, FVs[k])
end

Plasm.view(V, FVs[1])


module DarcyFEOperatorsTests

##
using Test
using Gridap
import Gridap: ∇

import LinearAlgebra: det
using Base: transpose
##

# model = CartesianDiscreteModel(domain=(0.0,1.0,0.0,1.0), partition=(2,2))
# model.cgrid
# ps = points(model.cgrid)
# typeof(ps)
# collect(ps)
#
#
#
# f(x) = Point(x[1],5*x[2])
#
# broadcast(f,ps)
#
#
# struct MappedCartesianGrid <: CartesianGrid
#   map
#
# end
# with mapping
#
#
# trian = Triangulation(model)
#
#
# phi = CellGeomap(trian)
# jac = gradient(phi)
# jact = transpose(jac)
#
#
# piola_map = inv(jact)
#
#
# graph = GridGraph(model)
# pols = CellPolytopes(Grid(model))
# pt = pols.value
#
# order = 1
# _reffe = NedelecRefFE(pt,Float64,order)
#
# _labels = FaceLabels(model)
#
# # V = ConformingFESpace(_reffe,trian,graph,_labels,[5,6])
# V = CurlConformingFESpace(_reffe,trian,graph,_labels,[5,6])
##

u(x) = VectorValue(x[1]*x[2], -0.5*x[2]^2)
∇u(x) = TensorValue(x[2],0.0,x[1],-x[2])
divu(x) = 0.0
∇(::typeof(u)) = ∇u

const kinv_1 = TensorValue(1.0,0.0,0.0,1.0)
r(x) = kinv_1*u(x)

model = CartesianDiscreteModel(domain=(0.0,1.0,0.0,1.0), partition=(1,1))
order = 2
V = FESpace( reffe=:RaviartThomas, conformity=:HDiv, order=order, model=model, diritags = [5,6])

V_0 = TestFESpace(V)
V_g = TrialFESpace(V,u)

trian = Triangulation(model)
quad = CellQuadrature(trian,degree=order*2)

@law σ(x,u) = kinv_1*u

function a(v,u)
  inner(v,σ(u))
end

function b_Ω(v)
  inner(v,r)
end

t_Ω = AffineFETerm(a,b_Ω,trian,quad)

# op = LinearFEOperator(V_0,V_g,t_Ω)

w = weights(quad)
z = coordinates(quad)

evaluate(V.cellbasis,z)

phi = CellGeomap(trian)
jac = gradient(phi)
detjac = det(jac)
#
piola_map = (1.0/detjac)*jac
s = V.cellbasis
pbasis = Gridap.CellFieldsOperations._merge_val_and_grad(piola_map*s.val,piola_map*s.grad)
#
vpm = evaluate(piola_map,z)
size(vpm[1])
vs = evaluate(kinv_1*s,z)
aaa = kinv_1*s
typeof(aaa)
length(vs[1])
@show vs[1]
@show vpm[1]
evaluate(piola_map.*transpose(s.val),z)

(vpm[1].*vs[1]')'
length(z[1])
evaluate(s,z)

uh = solve(op)

e1 = u - uh

# Define norms to measure the error
l2(u) = inner(u,u)

# Compute errors
e1l2 = sqrt(sum( integrate(l2(e1),trian,quad) ))

# writevtk(trian,"/home/santiago/github-repos/Gridap/tmp/darcyresults",
         # cellfields=["uh"=>uh,"ph"=>ph, "euh"=> e1, "eph"=> e2])

@test e1l2 < 1.e-8
##
end # module


using RegisterQD
using LinearAlgebra
using RegisterQD.StaticArrays
using RegisterQD.Interpolations
using RegisterQD.Images
using RegisterQD.CoordinateTransformations
using RegisterQD.Rotations

g = 0.2:0.2:1.2
gradcube = g .* reshape(g, 1, 6) .* reshape(g, 1, 1, 6)
gradcube[1,4,2] = 0
gradcube[4,5,2] = 0 #break up any potential rotational symmetry

mxshift = (1,1,1);
mxrot = (0.01,0.01,0.01);

EYE =Matrix(1.0*I, 3,3)

@testset "initial_tfm improves rigid rotational alignment" begin
    testimage1 = zeros(Float64,10,10,10)
    testimage1 .= NaN
    testimage1[3:8,3:8,3:8] = gradcube
    testimage1 = centered(testimage1)

    tform = RotXYZ(0.1,0.1,0.1)
    mytform = AffineMap(tform, [0,0,0])
    testimage2 = warp(testimage1, mytform, axes(testimage1))

    # insufficient parameters + no initiat_tfm causes large misalignment

    tformtest1, mm1 = qd_rigid(testimage2, testimage1, mxshift, mxrot; print_interval=typemax(Int)) #
    @test !(mm1 < 1e-8)
    @test !isapprox(tformtest1, mytform, atol = 0.1)

    #initial_tfm improves alignment

    tformtest2, mm2 = qd_rigid(testimage2, testimage1, mxshift, mxrot; print_interval=typemax(Int), initial_tfm = mytform) #
 #with the initial_tfm being the true tfm, this should give back the true rotation

    @test mm2 < 1e-8
    @test isapprox(tformtest2, mytform, atol = 0.0001)
    @test isrotation(tformtest2.linear)
end #Test initial_tfm improves rotational alignment for rigid

@testset "initial_tfm improves rigid translational alignment" begin
    testimage3 = zeros(10,20,10)
    testimage3 .= NaN
    testimage3[3:8,3:8,3:8] = gradcube
    testimage3 = centered(testimage3)

    testimage4 = zeros(10,20,10)
    testimage4 .= NaN
    testimage4[3:8,13:18,3:8] = gradcube
    testimage4 = centered(testimage4)

    init_tfm = AffineMap(diagm(0 => fill(1.0,3)), [0.0,10.0,0.0])

    tformtest3 = nothing
    mm3 = nothing

    #no initial_tfm should fail due to total lack of overlap
    @test try
        tformtest3, mm3 = qd_rigid(testimage3, testimage4, mxshift, mxrot; print_interval=typemax(Int)) #
        false
    catch err
        true  # this should break
    end

    tformtest4, mm4 = qd_rigid(testimage3, testimage4, mxshift, mxrot; print_interval=typemax(Int), initial_tfm = init_tfm) #

    @test mm4 < 1e-8 #this mismatch should be lower!
    @test isapprox(tformtest4.translation, [0, 10, 0])
    @test isapprox(tformtest4.linear, EYE)
end

@testset "Test initial_tfm creates real rotations." begin #some of this seems redundant
    testimage1 = zeros(Float64,10,10,10)
    testimage1 .= NaN
    testimage1[3:8,3:8,3:8] = gradcube
    testimage1 = centered(testimage1)

    tform = RotXYZ(0.1,0.1,0.1)
    mytform = AffineMap(tform, [0,0,0])
    testimage2 = warp(testimage1, mytform, axes(testimage1))

    mxrot2 = (0.2,0.2,0.2);
    minwidth_rot = RegisterQD.default_minwidth_rot(CartesianIndices(testimage2), EYE)

    # tests with equal spaces produces real rotations
    # TODO: the next test is machine-dependent, figure out why
    tformtest0, mm0 = qd_rigid(testimage2, testimage1, mxshift, mxrot2; fvalue=1e-5, rtol=0, print_interval=typemax(Int))

    @test mm0 < 1e-5
    @test isapprox(tformtest0, mytform, atol = 0.1)
    @test isrotation(tformtest0.linear)

    tformtest01, mm01 = RegisterQD.qd_rigid_coarse(testimage2, testimage1, mxshift, [mxrot2...], minwidth_rot; SD=EYE, print_interval=typemax(Int))
    @test isrotation(tformtest01.linear)

    tformtest02 = nothing
    mm02 = nothing
    tformtest02, mm02 = RegisterQD.qd_rigid_fine(testimage2, testimage1, [mxrot2...]./2, minwidth_rot; SD=EYE, print_interval=typemax(Int))
    @test isrotation(tformtest02.linear)

    #with skewed spacing produces real rotations.
    testimage5 = testimage1[:,:,-4:2:5]
    testimage6 = testimage2[:,:,-4:2:5]
    ps = (1, 1, 2)
    SD =SArray{Tuple{3,3}}(Diagonal(SVector(ps) ./ minimum(ps)))

    tformtest5, mm5 = qd_rigid(testimage6, testimage5, mxshift, mxrot2; SD=SD, print_interval=typemax(Int))
    @test mm5 <1e-4
    @test isapprox(tformtest5, mytform, atol = 1)
    @test isrotation(tformtest5.linear)
    @test !isrotation(SD*tformtest5.linear*inv(SD))

    tformtest55, mm55 = qd_rigid(testimage6, testimage5, mxshift, mxrot2; SD=SD, print_interval=typemax(Int), initial_tfm = tformtest5)
    @test mm55 <1e-4
    @test isapprox(tformtest55, mytform, atol = 1)
    @test isrotation(tformtest55.linear)
    @test !isrotation(SD*tformtest55.linear*inv(SD))

    #coarse and fine produce real rotations
    tformtest6, mm6 = RegisterQD.qd_rigid_coarse(testimage6, testimage5, mxshift, mxrot2, minwidth_rot; SD=SD, print_interval=typemax(Int))
    @test mm6 <1e-4
    @test isrotation(tformtest6.linear)
    @test !isrotation(SD*tformtest6.linear*inv(SD))

    tformtest66, mm66 = RegisterQD.qd_rigid_coarse(testimage6, testimage5, mxshift, mxrot2, minwidth_rot; SD=SD, print_interval=typemax(Int), initial_tfm = tformtest6)
    @test mm66 <1e-4
    @test isrotation(tformtest66.linear)
    @test !isrotation(SD*tformtest66.linear*inv(SD))

    tformtest7, mm7 = RegisterQD.qd_rigid_fine(testimage6, testimage5, [mxrot2...]./2, minwidth_rot; SD=SD, print_interval=typemax(Int))
    @test mm7 <1e-4
    @test isrotation(tformtest7.linear)
    @test !isrotation(SD*tformtest7.linear*inv(SD))

    tformtest77, mm77 = RegisterQD.qd_rigid_fine(testimage6, testimage5, [mxrot2...]./2, minwidth_rot; SD=SD, print_interval=typemax(Int), initial_tfm = tformtest7)
    @test mm77 <1e-4
    @test isrotation(tformtest77.linear)
    @test !isrotation(SD*tformtest77.linear*inv(SD))
    #fails due to specific error in qd_rigid_fine

    # a non rigid initial_tfm does not return a rigid transformation and prints an error message (?)
    tformtest8, mm8 = qd_rigid(testimage6, testimage5, mxshift, mxrot2; SD=SD, print_interval=typemax(Int), initial_tfm = AffineMap(SD\tformtest5.linear*SD, SD\tformtest5.translation))
    @test mm8 <1e-4
    @test isapprox(tformtest8, mytform, atol = 1)
    @test !isrotation(tformtest8.linear)

    mktemp() do path, io
        redirect_stdout(io) do
            tformtest8, mm8 = qd_rigid(testimage6, testimage5, mxshift, mxrot2; SD=SD, print_interval=typemax(Int), initial_tfm = AffineMap(SD\tformtest5.linear*SD, SD\tformtest5.translation))
        end
        flush(io)
        str = read(path, String)
        @test !isempty(str)
    end

end

@testset "Test initial_tfm improves translational alignment for affine" begin
    testimage3 = zeros(10,20,10)
    testimage3 .= NaN
    testimage3[3:8,3:8,3:8] = gradcube
    testimage3 = centered(testimage3)

    testimage4 = zeros(10,20,10)
    testimage4 .= NaN
    testimage4[3:8,13:18,3:8] = gradcube
    testimage4 = centered(testimage4)

    init_tfm = AffineMap(diagm(0 => fill(1.0,3)), [0.0,10.0,0.0])

    tformtest3 = nothing
    mm3 = nothing

    @test try
        tformtest3, mm3 = qd_affine(testimage3, testimage4, mxshift; print_interval=typemax(Int)) #
        false
    catch err
        true  # this should break
    end

    tformtest4, mm4 = qd_affine(testimage3, testimage4, mxshift;  print_interval = typemax(Int), initial_tfm = init_tfm, fvalue = 1e-5) #
    @test mm4 < 1e-4#this mismatch should be lower!
    @test isapprox(tformtest4.translation, [0.0, 10.0, 0.0])

end

@testset "Test initial_tfm improves general alignment for affine" begin
    testimage1 = zeros(Float64,10,10,10)
    testimage1 .= NaN
    testimage1[3:8,3:8,3:8] = gradcube
    testimage1 = centered(testimage1)

    tform = RotXYZ(0.1,0.1,0.1)
    mytform = AffineMap(tform, [0.0,0.0,0.0])
    testimage2 = warp(testimage1, mytform, axes(testimage1))

    tformtest1, mm1 = qd_affine(testimage2, testimage1, mxshift; print_interval=typemax(Int)) #
    #as the max-rotation is set too low, this should give a bad mismatch, but should still work
    @test !(mm1 < 1e-8)
    @test !isapprox(tformtest1, mytform, atol = 0.1)

    tformtest2, mm2 = qd_affine(testimage2, testimage1, mxshift; print_interval=typemax(Int), initial_tfm = mytform, fvalue = 1e-5) #
    #with the initial_tfm being the true tfm, this should give back the true rotation

    @test mm2 < 1e-8
    @test isapprox(tformtest2, mytform, atol = 0.0001) #this may not work so well. see qd_standard.
end #Test initial_tfm improves rotational alignment for rigid


# julia> include("/Users/ian/jd/10-19 Code/12 Julia/12.03 PE/pe4.jl")

function ispal(x::Int64)
    if sum(abs.([parse(Int64,i) for i=string(x)].-reverse([parse(Int64,i) for i=string(x)]))) == 0
        return true
    else
        return false
    end
end

pals = [k for k=[i*j for i=1:999 for j=1:i] if ispal(k)]
println("ans = $(sort(pals)[end])")


using MAT
using DataStructures
using StatsBase
f = readlines("Facebook_Sets.txt")
graphs = split(f[1])
include("../src/pdensity_algorithms.jl")

# insert appropriate path to datasets
pathtoFB100 = homedir()*"/data/Facebook100/"

Ps = [collect(0.25:0.25:2); 1.05]
for i = 1:100
    graph = graphs[i]
    F = matread(pathtoFB100*"$graph.mat")
    A = F["A"]
    n = size(A,1)
    # Ssets = zeros(n,length(Ps))
    Times = zeros(length(Ps))
    Objectives = zeros(length(Ps))
    Sizes = zeros(length(Ps))
    EdgeDens = zeros(length(Ps))
    MeanDegree = zeros(length(Ps))
    Mean2Degree = zeros(length(Ps))
    MaxDegree = zeros(length(Ps))
    for i = 1:length(Ps)
        p = Ps[i]
        tic = time()
        S, objS, Objs, ranking = GenPeel(A,p)
        timers = time()-tic
        Times[i] = timers
        # Ssets[S,i] .= 1
        Objectives[i] = maximum(Objs)
        Sizes[i] = length(S)

        As = A[S,S]
        ds = vec(sum(As,dims = 2))
        edges = sum(As)/2
        posedges = binomial(length(S),2)
        EdgeDens[i] = edges/posedges
        MeanDegree[i] = StatsBase.mean(ds)
        Mean2Degree[i] = StatsBase.mean(ds.^2)
        mdeg = StatsBase.mean(ds)
        MaxDegree[i] = maximum(ds)

        println("$graph \t $p \t $(length(S)) \t $objS \t $timers \t $(mdeg)")
    end

    matwrite("fb_output/$(graph)_output.mat",Dict( #"Ssets"=>Ssets,
    "Ps"=>Ps,"Times"=>Times,"Objectives"=>Objectives,
    "Sizes"=>Sizes,"MeanDegree"=>MeanDegree,"Mean2Degree"=>Mean2Degree,
    "MaxDegree"=>MaxDegree,"EdgeDens"=>EdgeDens))

end


@inline lassoonA!(args...) = lassoonA_glmnet!(args...)

################################################################## Helpers
function getβfromC(βs, C)
    p, K = size(βs)
    nprev = norm(βs[:, 1], 1) # = 0.
    for k in 2:K
        ncurr = norm(βs[:, k], 1)
        if C < ncurr
            # @debug format("\t{:6.4f}({}) < {} < {:6.4f}({})", nprev, k-1, C, ncurr, k)
            return (βs[:,k-1]*(ncurr-C) + βs[:,k]*(C-nprev))/(ncurr-nprev)
        end
        nprev = ncurr
    end
    # @debug format("\t{:6.4f}({}) < {}", nprev, K, C)
    return βs[:, end]
end

getdist(::Type{MSELoss}) = Normal()
getdist(::Type{LogitLoss}) = Binomial()

################################################################## GLMNet
using GLMNet

_gety(prob::Problem) = copy(prob.y)
_gety(prob::Problem{LogitLoss}) = [1-prob.y prob.y]

function lassoonA_glmnet!(ens::FWEnsemble, prob::Problem{L}, C) where L
  Z = getZ(ens)
  path = glmnet!(Z, _gety(prob), getdist(L), intercept=false, standardize=false)
  updateβ!(ens, getβfromC(path.betas, C))
end

################################################################## Lasso.jl
# using Lasso
#
# function lassoonA_lassojl(prob::Problem{L}, ens::Ensemble, C) where L
#     lfit = fit(LassoPath, Z, prob.y, getdist(L),
#                 intercept=false, standardize=false)
#     β = getβfromC(lfit.coefs, C)
# end


module Movement

import Params
export Point, randomwalk

type Point{T}
    x :: T
    y :: T
end

function Point{T}(arr :: Array{T, 1})
    if length(arr) != 2
        error("Points are in 2D.")
    end
    new(arr[1], arr[2])
end

function Point(T :: DataType)
    Point(zero(T), zero(T))
end

+(a :: Point, b :: Point) = Point(a.x + b.x, a.y + b.y)

#=
Return a function that makes a random walk according to a
Wiener process with given parameters.

Parameters:

- speed: Speed of random walk (m/s)
- unit_interval: Interval of a jump (timeslots)

Returns:
- a function that returns the difference (dx, dy) of random walk

=#
function randomwalk(speed :: Float64, unit_interval :: Int64)
    unit_speed :: Float64 = speed * sqrt(Params.t_slot)
    phi :: Float64 = rand() * 2*pi
    return t -> begin
        r = unit_speed * randn()
        if t % unit_interval == 0
            phi = rand() * 2*pi
        end
        return Point(r*cos(phi), r*sin(phi))
    end
end

end


include(joinpath("Molenaar", "molenaar-basic.jl"))
import .MolenaarBasic

res = MolenaarBasic.molenaar_basic(2)

# Figures
results = []
for sext in [0.01:0.05:5;]
    push!(results, MolenaarBasic.molenaar_basic(sext))
end

# Test for the remake of the molenaar model
include(joinpath("Molenaar", "molenaar_remake2.jl"))
import .MolenaarRemake2

#res = MolenaarRemake2.molenaar_remake2(5.0)

results_test = []
for sext in [0.01:0.05:5;]
    push!(results_test, MolenaarRemake2.molenaar_remake2(sext))
end

#########

include(joinpath("Molenaar", "molenaar-Fig4A.jl"))
import .MolenaarAlt

res = MolenaarAlt.molenaar_alt(2)

# Figure 4A
stats = []
for sext in [0.01:0.05:5;]
    push!(stats, MolenaarAlt.molenaar_alt(sext))
end

#########

include(joinpath("Molenaar", "molenaar-Fig4B.jl"))
import .MolenaarAltB

res = MolenaarAltB.molenaar_altb(2)

# Figure 4B
statsb = []
for sext = 0.001:20
    push!(statsb, MolenaarAltB.molenaar_altb(sext))
end


function maketinfo(cinfo,n)
tinfo = Tinfo()

@unpack en,P,M,Ω,basis = cinfo
x,wx,Tx,y,wy,Ty = makealltrans(M,n,Ω,basis)
W = wx.*wy'
@pack tinfo = Tx,Ty,W

return tinfo
end


#================
Predictive
    Learning
        Models
================#
include("Distributions.jl")
@doc """
      |====== Lathe.models =====\n
      |____________/ Accessories ___________\n
      |_____models.Pipeline([steps])\n
      |____________/ Continuous models ___________\n
      |_____models.meanBaseline(y)\n
      |_____models.LinearRegression(x,y)\n
      |_____models.LeastSquare(x,y,Type)\n
      |_____models.PowerLog(prob1,prob2)\n
      |____________/ Categorical Models ___________\n
      |_____models.LogisticRegression(x,y)\n
      |_____models.majBaseline(y)\n
       """
module models
#==
Base
    Models
        Functions
==#
using Lathe
using Random
using DataFrames
#===========
Accessories
===========#
@doc """
      Pipelines can contain a predictable Lathe model with preprocessing that
      occurs automatically. This is done by putting X array processing methods
      into the iterable steps, and then putting your Lathe model in.\n
      --------------------\n
      ==PARAMETERS==\n
      [steps] <- An iterable list of methods to call for X modification. These mutations should
      have ALREADY BEEN MADE TO THE TRAIN X.\n
      pipl = Pipeline([StandardScalar(),LinearRegression(trainX,trainy)])\n
      --------------------\n
      ==Functions==\n
      predict(xt) <- Returns a prediction from the model based on the xtrain value passed (xt)
      """
function Pipeline(steps)
    predict(xt) = [object.predict(xt) for object in steps]
    (var)->(steps;model;predict)
end
#==============
========================================================
=======================================================================
            CONTINUOS MODELS               CONTINUOS MODELS
            CONTINUOS MODELS               CONTINUOS MODELS
======================================================================
======================================================================#
#==
Mean
    Baseline
==#
 # Model Type
 @doc """
       A mean baseline is great for getting a basic accuracy score in order
           to make a valid direction for your model.\n
         --------------------\n
         ==PARAMETERS==\n
        [y] <- Fill with your trainY values. Should be an array of shape (0,1) or (1,0)\n
        pipl = Pipeline([StandardScalar(),LinearRegression(trainX,trainy)])\n
        --------------------\n
        ==Functions==\n
        predict(xt) <- Returns a prediction from the model based on the xtrain value passed (xt)
                     """
function MeanBaseline(y)
    m = Lathe.stats.mean(m.y)
    predict(xt) =
    xt = [v = m for v in xt]
    (test)->(m;predict)
end
#==
Linear
    Regression
==#

@doc """
      Linear Regression is a well-known linear function used for predicting
      continuous features with a mostly linear or semi-linear slope.\n
      --------------------\n
      ==PARAMETERS==\n
     [y] <- Fill with your trainY values. Should be an array of shape (0,1) or (1,0)\n
     [x] <- Fill in with your trainX values. Should be an array of shape (0,1) or (1,0)\n
     --------------------\n
     ==Functions==\n
     predict(xt) <- Returns a prediction from the model based on the xtrain value passed (xt)
       """
function LinearRegression(x,y)
    # a = ((∑y)(∑x^2)-(∑x)(∑xy)) / (n(∑x^2) - (∑x)^2)
    # b = (x(∑xy) - (∑x)(∑y)) / n(∑x^2) - (∑x)^2
    if length(x) != length(y)
        throw(ArgumentError("The array shape does not match!"))
    end
    # Get our Summations:
    Σx = sum(x)
    Σy = sum(y)
    # dot x and y
    xy = x .* y
    # ∑dot x and y
    Σxy = sum(xy)
    # dotsquare x
    x2 = x .^ 2
    # ∑ dotsquare x
    Σx2 = sum(x2)
    # n = sample size
    n = length(x)
    # Calculate a
    a = (((Σy) * (Σx2)) - ((Σx * (Σxy)))) / ((n * (Σx2))-(Σx^2))
    # Calculate b
    b = ((n*(Σxy)) - (Σx * Σy)) / ((n * (Σx2)) - (Σx ^ 2))
    # The part that is super struct:
    predict(xt) = (xt = [i = a + (b * i) for i in xt])
    (test)->(a;b;predict)
end
#==
Linear
    Least
     Square
==#
@doc """
      Least Squares is ideal for predicting continous features.
      Many models use Least Squares as a base to build off of.\n
      --------------------\n
      x = [7,6,5,6,5]\n
      y  = [3.4.5.6.3]\n
      xtrain = [7,5,4,5,3,5,7,8]\n
      Type = :LIN\n
      model = Lathe.models.LeastSquare(x,y,Type)\n
      y_pred = Lathe.models.predict(model,xtrain)\n
      -------------------\n
      HYPER PARAMETERS\n
      Type <- Type determines which Linear Least Square algorithm to use,
      :LIN, :OLS, :WLS, and :GLS are the three options.\n
      - :LIN = Linear Least Square Regression\n
      - :OLS = Ordinary Least Squares\n
      - :WLS = Weighted Least Squares\n
      - :GLS = General Least Squares
      --------------------\n
      ==Functions==\n
      predict(xt) <- Returns a prediction from the model based on the xtrain value passed (xt)
       """
function LeastSquare(x,y,Type)
    if length(x) != length(y)
        throw(ArgumentError("The array shape does not match!"))
    end
    if Type == :LIN
        xy = x .* y
        sxy = sum(xy)
        n = length(x)
        x2 = x .^ 2
        sx2 = sum(x2)
        sx = sum(x)
        sy = sum(y)
        # Calculate the slope:
        slope = ((n*sxy) - (sx * sy)) / ((n * sx2) - (sx)^2)
     # Calculate the y intercept
        b = (sy - (slope*sx)) / n
    end
    predict(xt) =
    if Type == :LIN
        (xt = [z = (slope * x) + b for x in xt])
    end
    (test)->(slope;b;predict)
end
#==
Ridge
    Regression
==#
@doc """
      Ridge Regression is another regressor ideal for predicting linear,
          continuous features.\n
      --------------------\n
      array = [5,10,15]\n
      scaled_feature = Lathe.preprocess.OneHotEncode(array)\n
       """
function RidgeRegression(x,y)

end

#======================================================================
=======================================================================
            CATEGORICAL MODELS             CATEGORICAL MODELS
            CATEGORICAL MODELS             CATEGORICAL MODELS
======================================================================
======================================================================#
#==
Majority
    Class
        Baseline
==#
@doc """
      Majority class baseline is used to find the most often interpreted
      classification in an array.\n
      --------------------\n
      ==PARAMETERS==\n
     [y] <- Fill with your trainY values. Should be an array of shape (0,1) or (1,0)\n
     --------------------\n
     ==Functions==\n
     predict(xt) <- Returns a prediction from the model based on the xtrain value passed (xt)\n
     counts() <- Returns a dictionary with the counts of all inserted keys.\n
     highest() <- Will return a Dictionary key with the count as well as the value for the most interpreted classification.
       """
function majClassBaseline(y)
    u=unique(y)
    d=Dict([(i,count(x->x==i,y)) for i in u])
    d = sort(collect(d), by=x->x[2])
    maxkey = d[length(d)]
    predict(xt) = [p = maxkey[1] for p in xt]
    counts() = d
    highest() = maxkey
    (var)->(y;maxkey;d;predict;counts;highest)
end
#==
Power Log
==#
@doc """
      A powerlog can be used to perform a one-tailed test, as well as get the proper sample size for a testing population.\n
      --------------------\n
      ==PARAMETERS==\n
     p1 <- A Float64 percentage representing the probability of scenario one.\n
     p2 <- A Float64 percentage representing the probability of scenario two. These two probability values should follow these guidelines: p1 = p1 + x = p2\n
     alpha = 0.05 <- Sets an alpha value\n
     --------------------\n
     Returns power, sample_size
       """
function PowerLog(p1::Float64,p2::Float64; alpha::Float64 = 0.05, rsq::Real = 0)
    pd = p2 - p1
    l1 = p1/(1-p1)
    l2 = p2/(1-p2)
    θ = l2 / l1
    or = θ
    λ = log(θ)
    λ2 = λ^2
    za = quantile(normal(),1-alpha)
    println("One-tailed test: alpha = ",alpha,", p1 = ",p1,", p2 = ",p2,", rsq = ",rsq,", odds ratio = ",or)
    δ = (1 + (1 + λ2)*exp(5 * λ2/4))/(1 + exp(-1*λ2/4))
    pwr = zeros(Float64,8)
    nn = zeros(Int64,8)
    i = 1
    for power = 0.6:.05:.95
        zb = quantile(normal(),power)

        N = ((za + zb*exp(-1 * λ2/4))^2 * (1 + 2*p1*δ))/(p1*λ2)
        N /= (1 - rsq)
        pwr[i] = power
        nn[i] = ceil(Int64,N)
        i += 1
    end
    return(pwr, nn)
end
#==
Multinomial
    Naive
        Bayes
==#
function MultinomialNB(x,y)

end
#==
Logistic
    Regression
==#
@doc """
      Majority class baseline is used to find the most often interpreted
      classification in an array.\n
      --------------------\n
      ==PARAMETERS==\n
     [X] <- Fill with your trainX values. Should be an array of shape (0,1) or (1,0)\n
     [y] <- Fill with your trainy values. Should be an array of shape (0,1) or (1,0)\n
     λ = .0001 <- Lambda Value\n
     fit_intercept = true <- Boolean determines whether to fit an intercept.\n
     max_iter = 1000 <- Determines the maximum number of iterations for the model to perform.\n
     --------------------\n
     ==Functions==\n
     predict(xt) <- Returns a prediction from the model based on the xtrain value passed (xt)\n
       """
function LogisticRegression(X, y, λ=0.0001, fit_intercept=true, η=0.01, max_iter=1000)
    θ, 𝐉 = logistic_regression_sgd(X, y, 0.0001, true, 0.3, 3000);
    predict(xt) = yhat = predict_class(predict_proba(xt,0))
    cost = 𝐉
    (var) -> (predict;cost)
end
function sigmoid(z)
    return 1 ./ (1 .+ exp.(.-z))
end
function logistic_regression_sgd(X, y, λ, fit_intercept=true, η=0.01, max_iter=1000)

    # Initialize some useful values
    m = length(y); # number of training examples

    if fit_intercept
        # Add a constant of 1s if fit_intercept is specified
        constant = ones(m, 1)
        X = hcat(constant, X)
    else
        X # Assume user added constants
    end

    # Use the number of features to initialise the theta θ vector
    n = size(X)[2]
    θ = zeros(n)

    # Initialise the cost vector based on the number of iterations
    𝐉 = zeros(max_iter)

    for iter in range(1, stop=max_iter)

        # Calcaluate the cost and gradient (∇𝐉) for each iter
        𝐉[iter], ∇𝐉 = regularised_cost(X, y, θ, λ)

        # Update θ using gradients (∇𝐉) for direction and (η) for the magnitude of steps in that direction
        θ = θ - (η * ∇𝐉)
    end

    return (θ, 𝐉)
end
function regularised_cost(X, y, θ, λ)
    m = length(y)
    h = sigmoid(X * θ)
    positive_class_cost = ((-y)' * log.(h))
    negative_class_cost = ((1 .- y)' * log.(1 .- h))
    lambda_regularization = (λ/(2*m) * sum(θ[2 : end] .^ 2))
    𝐉 = (1/m) * (positive_class_cost - negative_class_cost) + lambda_regularization
    ∇𝐉 = (1/m) * (X') * (h-y) + ((1/m) * (λ * θ))
    ∇𝐉[1] = (1/m) * (X[:, 1])' * (h-y)
           return (𝐉, ∇𝐉)
end
function predict_proba(X, θ, fit_intercept=true)
    m = size(X)[1]

    if fit_intercept
        constant = ones(m, 1)
        X = hcat(constant, X)
    else
        X
    end

    h = sigmoid(X * θ)
    return h
end

function predict_class(proba, threshold=0.5)
    return proba .>= threshold
end
#==
Nueral
    Network
        Framework
==#
function calculate_activation_forward(A_pre , W , b , function_type)
    if (function_type == "sigmoid")
        Z , linear_step_cache = forward_linear(A_pre , W , b)
        A , activation_step_cache = sigmoid(Z)
    elseif (function_type == "relu")
        Z , linear_step_cache = forward_linear(A_pre , W , b)
        A , activation_step_cache = relu(Z)
    end
    cache = (linear_step_cache , activation_step_cache)
    return A , cache
end

function model_forward_step(X , params)
    all_caches = []
    A = X
    L = length(params)/2
    for l=1:L-1
        A_pre = A
        A , cache = calculate_activation_forward(A_pre , params[string("W_" , string(Int(l)))] , params[string("b_" , string(Int(l)))] , "relu")
        push!(all_caches , cache)
    end
    A_l , cache = calculate_activation_forward(A , params[string("W_" , string(Int(L)))] , params[string("b_" , string(Int(L)))] , "sigmoid")
    push!(all_caches , cache)
    return A_l , all_caches
end
function cost_function(AL , Y)
    cost = -mean(Y.*log.(AL) + (1 .- Y).*log.(1 .- AL))
    return cost
end
function forward_linear(A , w , b)
    Z = w*A .+ b
    cache = (A , w , b)
    return Z,cache
end
function init_param(layer_dimensions)
    param = Dict()
    for l=0:length(layer_dimensions)
        param[string("W_" , string(l-1))] = rand(layer_dimensions[l] ,
				layer_dimensions[l-1])*0.1
        param[string("b_" , string(l-1))] = zeros(layer_dimensions[l] , 1)
    end
    return param
end

function backward_linear_step(dZ , cache)
    A_prev , W , b = cache
    m = size(A_prev)[2]
    dW = dZ * (A_prev')/m
    db = sum(dZ , dims = 2)/m
    dA_prev = (W')* dZ
    return dW , db , dA_prev
end
function relu(X)
    rel = max.(0,X)
    return rel , X
end
function backward_relu(dA , cache_activation)
    return dA.*(cache_activation.>0)
end
function backward_sigmoid(dA , cache_activation)
    return dA.*(sigmoid(cache_activation)[1].*(1 .- sigmoid(cache_activation)[1]))
end
function backward_activation_step(dA , cache , activation)
    linear_cache , cache_activation = cache
    if (activation == "relu")
        dZ = backward_relu(dA , cache_activation)
        dW , db , dA_prev = backward_linear_step(dZ , linear_cache)
    elseif (activation == "sigmoid")
        dZ = backward_sigmoid(dA , cache_activation)
        dW , db , dA_prev = backward_linear_step(dZ , linear_cache)
    end
    return dW , db , dA_prev

end
function model_backwards_step(A_l , Y , caches)
    grads = Dict()
    L = length(caches)
    m = size(A_l)[2]
    Y = reshape(Y , size(A_l))
    dA_l = (-(Y./A_l) .+ ((1 .- Y)./( 1 .- A_l)))
    current_cache = caches[L]
    grads[string("dW_" , string(L))] , grads[string("db_" , string(L))] , grads[string("dA_" , string(L-1))] = backward_activation_step(dA_l , current_cache , "sigmoid")
    for l=reverse(0:L-2)
        current_cache = caches[l+1]
        grads[string("dW_" , string(l+1))] , grads[string("db_" , string(l+1))] , grads[string("dA_" , string(l))] = backward_activation_step(grads[string("dA_" , string(l+1))] , current_cache , "relu")

    end
    return grads
end

function update_param(parameters , grads , learning_rate)
    L = Int(length(parameters)/2)
    for l=0:(L-1)
        parameters[string("W_" , string(l+1))] -= learning_rate.*grads[string("dW_" , string(l+1))]
        parameters[string("b_",string(l+1))] -= learning_rate.*grads[string("db_",string(l+1))]
    end
    return parameters
end
@doc """
      'Network' specifically constructs a convolutional nueral network,\n
      though this network is still being worked on in both methodology\n
      and in a physical manner,\n thanks for understanding.
       """
function Network(X,Y,layers_dimensions,n_iter)
    params = init_param(layers_dimensions)
    costs = []
    iters = []
    accuracy = []
    for i=1:n_iter
        A_l , caches  = model_forward_step(X , params)
        cost = cost_function(A_l , Y)
        acc = check_accuracy(A_l , Y)
        grads  = model_backwards_step(A_l , Y , caches)
        params = update_param(params , grads , learning_rate)
        println("Iteration ->" , i)
        println("Cost ->" , cost)
        println("Accuracy -> " , acc)
        push!(iters , i)
        push!(costs , cost)
        push!(accuracy , acc)
    end
    predict(xt) = (xt + 4)
    (test)->(costs;params;predict)
end

#
#----------------------------------------------
end


using Random
using Test
using SSHT

bitsign(b::Bool) = b ? -1 : 1
bitsign(i::Integer) = bitsign(isodd(i))

chop(x) = abs2(x) < 100eps(x) ? zero(x) : x
chop(x::Complex) = Complex(chop(real(x)), chop(imag(x)))

function integrate(f::AbstractArray{T,2}, g::AbstractArray{U,2}, L::Integer) where {T,U}
    nphi = SSHT.sampling_dh_nphi(L)
    ntheta = SSHT.sampling_dh_ntheta(L)
    @assert size(f) == size(g) == (nphi, ntheta)

    s = zero(T) * zero(U) * zero(Float64)
    for p in 1:nphi, t in 1:ntheta
        phi = SSHT.sampling_dh_p2phi(p, L)
        theta = SSHT.sampling_dh_t2theta(t, L)
        dtheta = SSHT.sampling_weight_dh(theta, L)
        dphi = 2π / nphi
        s += conj(f[p, t]) * g[p, t] * dtheta * dphi
    end

    return s
end

################################################################################

# Half angle formulae:
#     sin(θ/2)^2 = (1-cos(θ))/2
#     cos(θ/2)^2 = (1+cos(θ))/2

# These sYlm are taken from Wikipedia and black-holes.org:
# <https://en.wikipedia.org/wiki/Spherical_harmonics> and
# <https://en.wikipedia.org/wiki/Spin-weighted_spherical_harmonics>
# <https://www.black-holes.org/SpinWeightedSphericalHarmonics.nb>
function sYlm(s::Integer, l::Integer, m::Integer, θ::Real, ϕ::Real)
    @assert abs(s) ≤ l
    @assert -l ≤ m ≤ l

    # Parity:
    s < 0 && return bitsign(s + m) * conj(sYlm(-s, l, -m, θ, ϕ))

    (s, l, m) == (0, 0, 0) && return sqrt(1 / 4π)
    (s, l, m) == (0, 1, -1) && return sqrt(3 / 8π) * sin(θ) * cis(-ϕ)
    (s, l, m) == (0, 1, 0) && return sqrt(3 / 4π) * cos(θ)
    (s, l, m) == (0, 1, +1) && return -sqrt(3 / 8π) * sin(θ) * cis(ϕ)
    (s, l, m) == (0, 2, -2) && return sqrt(15 / 2π) * cos(θ / 2)^2 * sin(θ / 2)^2 * cis(-2ϕ)
    (s, l, m) == (0, 2, -1) && return -sqrt(15 / 2π) * cos(θ / 2) * sin(θ / 2) * (-cos(θ / 2)^2 + sin(θ / 2)^2) * cis(-ϕ)
    (s, l, m) == (0, 2, 0) && return sqrt(5 / 4π) * (cos(θ / 2)^4 - 4 * cos(θ / 2)^2 * sin(θ / 2)^2 + sin(θ / 2)^4)
    (s, l, m) == (0, 2, +1) && return -sqrt(15 / 2π) * cos(θ / 2) * sin(θ / 2) * (cos(θ / 2)^2 - sin(θ / 2)^2) * cis(ϕ)
    (s, l, m) == (0, 2, +2) && return sqrt(15 / 2π) * cos(θ / 2)^2 * sin(θ / 2)^2 * cis(2ϕ)

    (s, l, m) == (+1, 1, -1) && return -sqrt(3 / 16π) * (1 + cos(θ)) * cis(-ϕ)
    (s, l, m) == (+1, 1, 0) && return sqrt(3 / 8π) * sin(θ)
    (s, l, m) == (+1, 1, +1) && return -sqrt(3 / 16π) * (1 - cos(θ)) * cis(ϕ)
    (s, l, m) == (+1, 2, -2) && return -sqrt(5 / π) * cos(θ / 2)^3 * sin(θ / 2) * cis(-2ϕ)
    (s, l, m) == (+1, 2, -1) && return -sqrt(5 / 4π) * cos(θ / 2)^2 * (cos(θ / 2)^2 - 3 * sin(θ / 2)^2) * cis(-ϕ)
    (s, l, m) == (+1, 2, 0) && return sqrt(15 / 2π) * cos(θ / 2) * sin(θ / 2) * (cos(θ / 2)^2 - sin(θ / 2)^2)
    (s, l, m) == (+1, 2, +1) && return sqrt(5 / 4π) * sin(θ / 2)^2 * (-3 * cos(θ / 2)^2 + sin(θ / 2)^2) * cis(ϕ)
    (s, l, m) == (+1, 2, +2) && return sqrt(5 / π) * cos(θ / 2) * sin(θ / 2)^3 * cis(2ϕ)

    (s, l, m) == (+2, 2, -2) && return sqrt(5 / 4π) * cos(θ / 2)^4 * cis(-2ϕ)
    (s, l, m) == (+2, 2, -1) && return -sqrt(5 / π) * cos(θ / 2)^3 * sin(θ / 2) * cis(-ϕ)
    (s, l, m) == (+2, 2, 0) && return sqrt(15 / 2π) * cos(θ / 2)^2 * sin(θ / 2)^2
    (s, l, m) == (+2, 2, +1) && return -sqrt(5 / π) * cos(θ / 2) * sin(θ / 2)^3 * cis(ϕ)
    (s, l, m) == (+2, 2, +2) && return sqrt(5 / 4π) * sin(θ / 2)^4 * cis(2ϕ)

    @assert false
end

# ð F = - (sin θ)^s (∂_θ + i / sin(θ) ∂_ϕ) (sin θ)^-s F
# (Calculated manually from sYlm above)
function ðsYlm(s::Integer, l::Integer, m::Integer, θ::Real, ϕ::Real)
    @assert abs(s) ≤ l
    @assert -l ≤ m ≤ l

    (s, l, m) == (0, 0, 0) && return 0
    (s, l, m) == (0, 1, -1) && return -sqrt(3 / 8π) * (1 + cos(θ)) * cis(-ϕ)
    (s, l, m) == (0, 1, 0) && return sqrt(3 / 4π) * sin(θ)
    (s, l, m) == (0, 1, +1) && return -sqrt(3 / 8π) * (1 - cos(θ)) * cis(ϕ)
    (s, l, m) == (0, 2, -2) && return -sqrt(15 / 8π) * (1 + cos(θ)) * sin(θ) * cis(-2ϕ)
    (s, l, m) == (0, 2, -1) && return -sqrt(15 / 2π) * cos(θ / 2)^2 * (-1 + 2 * cos(θ)) * cis(-ϕ)
    (s, l, m) == (0, 2, 0) && return sqrt(45 / 16π) * sin(2θ)
    (s, l, m) == (0, 2, +1) && return -sqrt(15 / 2π) * (1 + 2 * cos(θ)) * sin(θ / 2)^2 * cis(ϕ)
    (s, l, m) == (0, 2, +2) && return -sqrt(15 / 8π) * (-1 + cos(θ)) * sin(θ) * cis(2ϕ)

    (s, l, m) == (+1, 1, -1) && return 0
    (s, l, m) == (+1, 1, 0) && return 0
    (s, l, m) == (+1, 1, +1) && return 0
    (s, l, m) == (+1, 2, -2) && return sqrt(5 / π) * cos(θ / 2)^4 * cis(-2ϕ)
    (s, l, m) == (+1, 2, -1) && return -sqrt(5 / π) * cos(θ / 2)^2 * sin(θ) * cis(-ϕ)
    (s, l, m) == (+1, 2, 0) && return sqrt(15 / 8π) * sin(θ)^2
    (s, l, m) == (+1, 2, +1) && return -sqrt(5 / π) * sin(θ / 2)^2 * sin(θ) * cis(ϕ)
    (s, l, m) == (+1, 2, +2) && return sqrt(5 / π) * sin(θ / 2)^4 * cis(2ϕ)

    (s, l, m) == (+2, 2, -2) && return 0
    (s, l, m) == (+2, 2, -1) && return 0
    (s, l, m) == (+2, 2, 0) && return 0
    (s, l, m) == (+2, 2, +1) && return 0
    (s, l, m) == (+2, 2, +2) && return 0

    @assert false
end

# ð̄ F = - (sin θ)^-s (∂_θ - i / sin(θ) ∂_ϕ) (sin θ)^s F
# (Calculated manually from sYlm above)
function ð̄sYlm(s::Integer, l::Integer, m::Integer, θ::Real, ϕ::Real)
    @assert abs(s) ≤ l
    @assert -l ≤ m ≤ l

    (s, l, m) == (0, 0, 0) && return 0
    (s, l, m) == (0, 1, -1) && return sqrt(3 / 8π) * (1 - cos(θ)) * cis(-ϕ)
    (s, l, m) == (0, 1, 0) && return sqrt(3 / 4π) * sin(θ)
    (s, l, m) == (0, 1, +1) && return sqrt(3 / 8π) * (1 + cos(θ)) * cis(ϕ)
    (s, l, m) == (0, 1, +1) && return -sqrt(3 / 8π) * (1 - cos(θ)) * cis(ϕ)
    (s, l, m) == (0, 2, -2) && return -sqrt(15 / 8π) * (-1 + cos(θ)) * sin(θ) * cis(-2ϕ)
    (s, l, m) == (0, 2, -1) && return sqrt(15 / 2π) * (1 + 2 * cos(θ)) * sin(θ / 2)^2 * cis(-ϕ)
    (s, l, m) == (0, 2, 0) && return sqrt(45 / 16π) * sin(2θ)
    (s, l, m) == (0, 2, +1) && return sqrt(15 / 2π) * cos(θ / 2)^2 * (-1 + 2 * cos(θ)) * cis(ϕ)
    (s, l, m) == (0, 2, +2) && return -sqrt(15 / 8π) * (1 + cos(θ)) * sin(θ) * cis(2ϕ)

    (s, l, m) == (+1, 1, -1) && return -sqrt(3 / 4π) * sin(θ) * cis(-ϕ)
    (s, l, m) == (+1, 1, 0) && return -sqrt(3 / 2π) * cos(θ)
    (s, l, m) == (+1, 1, +1) && return sqrt(3 / 4π) * sin(θ) * cis(ϕ)
    (s, l, m) == (+1, 2, -2) && return -sqrt(45 / 16π) * sin(θ)^2 * cis(-2ϕ)
    (s, l, m) == (+1, 2, -1) && return -sqrt(45 / 16π) * sin(2θ) * cis(-ϕ)
    (s, l, m) == (+1, 2, 0) && return -sqrt(15 / 32π) * (1 + 3 * cos(2θ))
    (s, l, m) == (+1, 2, +1) && return sqrt(45 / 16π) * sin(2θ) * cis(ϕ)
    (s, l, m) == (+1, 2, +2) && return -sqrt(45 / 16π) * sin(θ)^2 * cis(2ϕ)

    (s, l, m) == (+2, 2, -2) && return sqrt(5 / 4π) * (1 + cos(θ)) * sin(θ) * cis(-2ϕ)
    (s, l, m) == (+2, 2, -1) && return sqrt(5 / 4π) * (cos(θ) + cos(2θ)) * cis(-ϕ)
    (s, l, m) == (+2, 2, 0) && return -sqrt(15 / 2π) * cos(θ) * sin(θ)
    (s, l, m) == (+2, 2, +1) && return sqrt(5 / 4π) * (cos(θ) - cos(2θ)) * cis(ϕ)
    (s, l, m) == (+2, 2, +2) && return -sqrt(5 / π) * sin(θ / 2)^2 * sin(θ) * cis(2ϕ)

    @assert false
end

################################################################################

@testset "Grid point counts (Driscoll & Healy)" begin
    for L in 1:10
        n = SSHT.sampling_dh_n(L)
        nphi = SSHT.sampling_dh_nphi(L)
        ntheta = SSHT.sampling_dh_ntheta(L)
        @test nphi == 2 * L - 1
        @test ntheta == 2 * L
        @test n == nphi * ntheta
    end
end

@testset "Coordinates (Driscoll & Healy)" begin
    for L in 1:100
        nphi = SSHT.sampling_dh_nphi(L)
        ntheta = SSHT.sampling_dh_ntheta(L)
        for p in 1:nphi
            phi = SSHT.sampling_dh_p2phi(p, L)
            @test phi ≈ 2π * (p - 1) / nphi
        end
        for t in 1:ntheta
            theta = SSHT.sampling_dh_t2theta(t, L)
            @test theta ≈ π * (t - 1 / 2) / ntheta
        end
    end
end

@testset "Grid point counts (McEwen & Wiaux)" begin
    for L in 1:2:10
        n = SSHT.sampling_mw_n(L)
        nphi = SSHT.sampling_mw_nphi(L)
        ntheta = SSHT.sampling_mw_ntheta(L)
        @test nphi == 2 * L - 1
        @test ntheta == L
        # The south pole is covered only by a single point
        @test n == nphi * (ntheta - 1) + 1
    end
end

@testset "Coordinates (McEwen & Wiaux)" begin
    for L in 1:100
        nphi = SSHT.sampling_mw_nphi(L)
        ntheta = SSHT.sampling_mw_ntheta(L)
        for p in 1:nphi
            phi = SSHT.sampling_mw_p2phi(p, L)
            @test phi ≈ 2π * (p - 1) / nphi
        end
        for t in 1:ntheta
            theta = SSHT.sampling_mw_t2theta(t, L)
            @test theta ≈ π * (2 * t - 1) / (2 * ntheta - 1)
        end
    end
end

@testset "Mode layout and counts" begin
    for L in 1:10
        mode_seen = falses(L^2)
        for l in 0:(L - 1), m in (-l):l
            ind = SSHT.sampling_elm2ind(l, m)
            @test 1 ≤ ind ≤ L^2
            @test SSHT.sampling_ind2elm(ind) == (l, m)
            @test !mode_seen[ind]
            mode_seen[ind] = true
        end
        @test all(mode_seen)
    end
end

################################################################################

# TODO: Test phase and parity of sYlm
#
# {\displaystyle Y_{\ell }^{m}(\theta ,\phi )\to Y_{\ell }^{m}(\pi -\theta ,\pi +\phi )=(-1)^{\ell }Y_{\ell }^{m}(\theta ,\phi )}
#
# <math display="block">Y_\ell^m(\theta,\phi) \to Y_\ell^m(\pi-\theta,\pi+\phi) = (-1)^\ell Y_\ell^m(\theta,\phi)</math>
#
# {}_s\bar Y_{l m} &= \left(-1\right)^{s+m}{}_{-s}Y_{l(-m)}\\
#
# {}_sY_{l m}(\pi-\theta,\phi+\pi) &= \left(-1\right)^l {}_{-s}Y_{l m}(\theta,\phi).

Random.seed!(100)
modes = [(name="(l=0,m=0)", fun=(θ, ϕ) -> sYlm(0, 0, 0, θ, ϕ), modes=[1, 0, 0, 0]),
         (name="(l=1,m=-1)", fun=(θ, ϕ) -> im * sYlm(0, 1, +1, θ, ϕ) + im * sYlm(0, 1, -1, θ, ϕ), modes=[0, im, 0, im]),
         (name="(l=1,m=0)", fun=(θ, ϕ) -> sYlm(0, 1, 0, θ, ϕ), modes=[0, 0, 1, 0]),
         (name="(l=1,m=+1)", fun=(θ, ϕ) -> sYlm(0, 1, +1, θ, ϕ) - sYlm(0, 1, -1, θ, ϕ), modes=[0, -1, 0, 1])]
@testset "Simple real transforms: $(mode.name)" for mode in modes
    for L in 2:20
        nphi = SSHT.sampling_dh_nphi(L)
        ntheta = SSHT.sampling_dh_ntheta(L)

        f = Array{Float64}(undef, nphi, ntheta)
        for p in 1:nphi, t in 1:ntheta
            ϕ = SSHT.sampling_dh_p2phi(p, L)
            θ = SSHT.sampling_dh_t2theta(t, L)
            f[p, t] = mode.fun(θ, ϕ)
        end

        flm = SSHT.core_dh_forward_sov_real(f, L)
        @assert L ≥ 2
        @test flm[1:4] ≈ mode.modes
        if L > 2
            @test all(isapprox(0; atol=100eps()), flm[5:end])
        end

        f′ = SSHT.core_dh_inverse_sov_real(flm, L)
        @test isapprox(f′, f; atol=1000eps())
    end
end

Random.seed!(100)
modes = [(name="(s=$s,l=$l,m=$m)", spin=s, el=l, fun=(θ, ϕ) -> sYlm(s, l, m, θ, ϕ),
          modes=L -> [l == l′ && m == m′ for l′ in 0:(L - 1) for m′ in (-l′):l′]) for s in -2:+2 for l in abs(s):2 for m in (-l):l]
@testset "Simple complex transforms: $(mode.name)" for mode in modes
    for L in (mode.el + 1):20
        nphi = SSHT.sampling_dh_nphi(L)
        ntheta = SSHT.sampling_dh_ntheta(L)

        f = Array{Complex{Float64}}(undef, nphi, ntheta)
        for p in 1:nphi, t in 1:ntheta
            ϕ = SSHT.sampling_dh_p2phi(p, L)
            θ = SSHT.sampling_dh_t2theta(t, L)
            f[p, t] = mode.fun(θ, ϕ)
        end

        flm = SSHT.core_dh_forward_sov(f, L, mode.spin)
        @test flm ≈ mode.modes(L)

        f′ = SSHT.core_dh_inverse_sov(flm, L, mode.spin)
        @test isapprox(f′, f; atol=1000eps())
    end
end

Random.seed!(100)
@testset "Linearity of real transforms" begin
    for iter in 1:100
        L = rand(1:100)
        nphi = SSHT.sampling_dh_nphi(L)
        ntheta = SSHT.sampling_dh_ntheta(L)

        f = randn(Float64, nphi, ntheta)
        g = randn(Float64, nphi, ntheta)
        α = randn(Float64)
        h = f + α * g

        flm = SSHT.core_dh_forward_sov_real(f, L)
        glm = SSHT.core_dh_forward_sov_real(g, L)
        hlm = SSHT.core_dh_forward_sov_real(h, L)

        @test flm + α * glm ≈ hlm
    end
end

Random.seed!(100)
@testset "Linearity of complex transforms" begin
    for iter in 1:100
        L = rand(1:100)
        nphi = SSHT.sampling_dh_nphi(L)
        ntheta = SSHT.sampling_dh_ntheta(L)

        spin = rand(-4:4)

        f = randn(Complex{Float64}, nphi, ntheta)
        g = randn(Complex{Float64}, nphi, ntheta)
        α = randn(Complex{Float64})
        h = f + α * g

        flm = SSHT.core_dh_forward_sov(f, L, spin)
        glm = SSHT.core_dh_forward_sov(g, L, spin)
        hlm = SSHT.core_dh_forward_sov(h, L, spin)

        @test flm + α * glm ≈ hlm

        flm = randn(Complex{Float64}, L^2)
        glm = randn(Complex{Float64}, L^2)
        hlm = flm + α * glm

        f = SSHT.core_dh_inverse_sov(flm, L, spin)
        g = SSHT.core_dh_inverse_sov(glm, L, spin)
        h = SSHT.core_dh_inverse_sov(hlm, L, spin)

        @test f + α * g ≈ h
    end
end

Random.seed!(100)
@testset "Orthonormality of complex transforms" begin
    for iter in 1:100
        L = rand(1:100)
        nphi = SSHT.sampling_dh_nphi(L)
        ntheta = SSHT.sampling_dh_ntheta(L)

        smax = min(4, L - 1)
        spin = rand((-smax):smax)

        flm = zeros(Complex{Float64}, L^2)
        glm = zeros(Complex{Float64}, L^2)

        lf = rand(abs(spin):(L - 1))
        mf = rand((-lf):lf)
        lg = rand(abs(spin):(L - 1))
        mg = rand((-lg):lg)

        flm[SSHT.sampling_elm2ind(lf, mf)] = 1
        glm[SSHT.sampling_elm2ind(lg, mg)] = 1

        f = SSHT.core_dh_inverse_sov(flm, L, spin)
        g = SSHT.core_dh_inverse_sov(glm, L, spin)

        @test isapprox(integrate(f, f, L), 1; atol=1 / L^2)
        @test isapprox(integrate(f, g, L), (lf == lg) * (mf == mg); atol=1 / L^2)

        h = conj(f) .* f
        hlm = SSHT.core_dh_forward_sov(h, L, 0)
        @test isapprox(hlm[SSHT.sampling_elm2ind(0, 0)], sqrt(1 / 4π); atol=sqrt(eps()))

        h = conj(f) .* g
        hlm = SSHT.core_dh_forward_sov(h, L, 0)
        @test isapprox(hlm[SSHT.sampling_elm2ind(0, 0)], (lf == lg) * (mf == mg) * sqrt(1 / 4π); atol=sqrt(eps()))
    end
end

Random.seed!(100)
modes = [(name="(s=$s,l=$l,m=$m)", spin=s, el=l, fun=(θ, ϕ) -> sYlm(s, l, m, θ, ϕ), ðfun=(θ, ϕ) -> ðsYlm(s, l, m, θ, ϕ),
          ð̄fun=(θ, ϕ) -> ð̄sYlm(s, l, m, θ, ϕ)) for s in 0:+2 for l in abs(s):2 for m in (-l):l]
@testset "Simple derivatives (eth, eth-bar): $(mode.name)" for mode in modes
    for L in (mode.el + 1):20
        nphi = SSHT.sampling_dh_nphi(L)
        ntheta = SSHT.sampling_dh_ntheta(L)

        f = Array{Complex{Float64}}(undef, nphi, ntheta)
        ðf₀ = Array{Complex{Float64}}(undef, nphi, ntheta)
        ð̄f₀ = Array{Complex{Float64}}(undef, nphi, ntheta)
        for p in 1:nphi, t in 1:ntheta
            ϕ = SSHT.sampling_dh_p2phi(p, L)
            θ = SSHT.sampling_dh_t2theta(t, L)
            f[p, t] = mode.fun(θ, ϕ)
            ðf₀[p, t] = mode.ðfun(θ, ϕ)
            ð̄f₀[p, t] = mode.ð̄fun(θ, ϕ)
        end

        flm = SSHT.core_dh_forward_sov(f, L, mode.spin)

        ðflm = SSHT.eth(flm, L, mode.spin)
        ðf = SSHT.core_dh_inverse_sov(ðflm, L, mode.spin + 1)
        @test isapprox(ðf, ðf₀; atol=10000eps())

        ð̄flm = SSHT.ethbar(flm, L, mode.spin)
        ð̄f = SSHT.core_dh_inverse_sov(ð̄flm, L, mode.spin - 1)
        @test isapprox(ð̄f, ð̄f₀; atol=10000eps())
    end
end


#
# This file is a part of MolecularGraph.jl
# Licensed under the MIT License http://opensource.org/licenses/MIT
#

export
    MaxCardMatchState,
    maxcardmap,
    maxcard,
    maxcardmatch!

mutable struct MaxCardMatchState
    U::Set{Int}
    V::Set{Int}
    adj::Dict{Int,Set{Int}}
    dist::Dict{Union{Int,Nothing},Union{Int,Nothing}}
    utov::Dict{Int,Union{Int,Nothing}}
    vtou::Dict{Int,Union{Int,Nothing}}

    function MaxCardMatchState(U, V, adj::Dict)
        new(Set(U), Set(V), adj, Dict(),
            Dict(u => nothing for u in U), Dict(v => nothing for v in V))
    end
end

function MaxCardMatchState(U, V, efunc::Function)
    # Generate bipartite relationship
    adj = Dict{Int,Set{Int}}()
    for u in U
        adj[u] = Set{Int}()
        for v in V
            if efunc(u, v)
                push!(adj[u], v)
            end
        end
    end
    MaxCardMatchState(Set(U), Set(V), adj)
end

function maxcardmap(U, V, adj)
    # Maximum cardinality mapping
    state = MaxCardMatchState(U, V, adj)
    maxcardmatch!(state)
    mapping = Dict{Int,Int}()
    for (u, v) in state.utov
        if u !== nothing && v !== nothing
            mapping[u] = v
        end
    end
    return mapping
end

maxcard(U, V, adj) = length(maxcardmap(U, V, adj))

function maxcardmatch!(state::MaxCardMatchState)
    # Hopcroft-Karp method
    while bfs!(state)
        for u in state.U
            if state.utov[u] === nothing
                dfs!(state, u)
            end
        end
    end
end

function bfs!(state::MaxCardMatchState)
    queue = []
    for u in state.U
        if state.utov[u] === nothing
            state.dist[u] = 0
            push!(queue, u)
        else
            state.dist[u] = nothing
        end
    end
    state.dist[nothing] = nothing
    while !isempty(queue)
        u = popfirst!(queue)
        ndist = state.dist[nothing]
        if ndist === nothing || state.dist[u] < ndist
            for v in state.adj[u]
                m = state.vtou[v]
                if state.dist[m] === nothing
                    state.dist[m] = state.dist[u] + 1
                    push!(queue, m)
                end
            end
        end
    end
    return state.dist[nothing] !== nothing
end

function dfs!(state::MaxCardMatchState, u)
    if u === nothing
        return true
    end
    for v in state.adj[u]
        m = state.vtou[v]
        if state.dist[m] == state.dist[u] + 1
            if dfs!(state, m)
                state.vtou[v] = u
                state.utov[u] = v
                return true
            end
        end
    end
    state.dist[u] = nothing
    return false
end


function build_nabla2_y(LF)

  D2jl = LF.LFy.D2jl

  Nx = LF.Nx
  Ny = LF.Ny
  Nz = LF.Nz

  Npoints = Nx*Ny*Nz

  # initialize with
  rowval = zeros(Int64,Ny*Npoints)
  colptr = zeros(Int64,Npoints+1)
  colptr[1] = 1
  nzval = zeros(Float64,Ny*Npoints)

  # XXX Move these arrays here ?
  rowGbl_init = zeros(Int64,Ny)
  rowGbl = zeros(Int64,Ny)

  idx = 0
  idxCol = 1

  for ix = 1:Nx

    rowGbl_init[1] = 1 + (ix-1)*Ny*Nz
    for i = 2:Ny
      rowGbl_init[i] = rowGbl_init[i-1] + Nz
    end

    for colLoc = 1:Ny
      colGbl_start = (colLoc-1)*Nz + 1 + (ix-1)*Ny*Nz
      colGbl_stop = colLoc*Nz + (ix-1)*Ny*Nz
      for colGbl = colGbl_start:colGbl_stop
        for rowLoc = 1:Ny
          idx = idx + 1
          rowval[idx] = rowGbl_init[rowLoc] + colGbl - 1 - (colLoc-1)*Nz - (ix-1)*Ny*Nz
          nzval[idx] = D2jl[colLoc,rowLoc]
        end
        idxCol = idxCol + 1
        colptr[idxCol] = colptr[idxCol-1] + Ny
      end
    end

  end # ix = 1:Nx

  return SparseMatrixCSC( Npoints, Npoints, colptr, rowval, nzval )
end


using SumProductNetworks
using Distributions
using Test

@testset "indicator node" begin
    value = 1
    dim = 2
    node = IndicatorNode(value, dim)

    @test logpdf(node, [1, 2]) == -Inf
    @test logpdf(node, [1, 1]) == 0
    @test logpdf(node, [1, 2], 2) == 0
end

@testset "univariate node" begin
    dist = Normal()
    node = UnivariateNode(dist, 2)

    @test logpdf(node, [0.1, 1.0]) ≈ logpdf(dist, 1.0)
    @test logpdf(node, [0.1, 1.0], 1.0, 0.5) ≈ logpdf(Normal(1.0, 0.5), 1.0)
end

@testset "multivariate node" begin
    dist = MvNormal(ones(2))
    node = MultivariateNode(dist, [1, 2])

    @test logpdf(node, [1., 0.2, 2.]) ≈ logpdf(dist, [1., 0.2])
end

@testset "sum node" begin

    node = FiniteSumNode()

    add!(node, IndicatorNode(0, 1), log(0.3))
    add!(node, IndicatorNode(1, 1), log(0.7))
    updatescope!(node)

    @test logpdf(node, [0]) ≈ log(0.3)
    @test logpdf(node, [1]) ≈ log(0.7)

    @test first(logpdf(node, ones(1, 1))) ≈ log(0.7)
    @test logpdf(node, reshape([1, 0], 2, 1)) ≈ log.([0.7, 0.3])

    spn = SumProductNetwork(node)

    @test exp.(logpdf(spn, reshape([1, 0], 2, 1))) ≈ [0.7, 0.3]
    @test exp.(logpdf(spn, reshape([1, 2], 2, 1))) ≈ [0.7, 0]

    n = FiniteSumNode(D = 2)
    p1 = FiniteProductNode(D = 2)
    add!(p1, IndicatorNode(1, 1))
    add!(p1, IndicatorNode(1, 2))

    p2 = FiniteProductNode(D = 2)
    add!(p2, IndicatorNode(2, 1))
    add!(p2, IndicatorNode(2, 2))

    add!(n, p1, log(0.8))
    add!(n, p2, log(0.2))

    updatescope!(n)

    @test logpdf(n, [1, 1]) == log(0.8)
    @test logpdf(n, [2, 2]) == log(0.2)
    @test logpdf(n, [1, 2]) == log(0.0)
end

@testset "product node" begin

    node = FiniteProductNode()
    add!(node, IndicatorNode(1, 1))
    add!(node, IndicatorNode(1, 2))

    # Product nodes without scope always return p(x) = 1.
    @test logpdf(node, [0, 0]) == 0

    updatescope!(node)

    @test logpdf(node, [0, 1]) == -Inf
    @test logpdf(node, [1, 0]) == -Inf
    @test logpdf(node, [1, 1]) == 0

    n = FiniteProductNode(D = 2)
    s1 = FiniteSumNode(D = 1)
    add!(s1, IndicatorNode(1, 1), log(0.8))
    add!(s1, IndicatorNode(2, 1), log(0.2))

    s2 = FiniteSumNode(D = 1)
    add!(s2, IndicatorNode(1, 2), log(0.2))
    add!(s2, IndicatorNode(2, 2), log(0.8))

    add!(n, s1)
    add!(n, s2)

    updatescope!(n)

    @test logpdf(n, [1, 1]) == log(0.8) + log(0.2)
    @test logpdf(n, [2, 1]) == log(0.2) + log(0.2)
end


# # [Implicit-Explicit (IMEX) Additively-Partitioned Runge-Kutta Timestepping](@id Single-rate-IMEXARK-Timestepping)

# In this tutorial, we shall explore the use of IMplicit-EXplicit (IMEX) methods
# for the solution of nonautonomous (or non time-invariant) equations.
# For our model problem, we shall reuse the acoustic wave test in the GCM
# configuration. See its [code](@ref Acoustic-Wave-Configuration)
# for details on the model and parameters. For the purposes of this tutorial,
# we will only run the experiment for a total of 3600 simulation seconds.
# Details on this test case can be found in Sec. 4.3 of [Giraldo2013](@cite).

using ClimateMachine
const clima_dir = dirname(dirname(pathof(ClimateMachine)));
include(joinpath(
    clima_dir,
    "tutorials",
    "Numerics",
    "TimeStepping",
    "tutorial_acousticwave_config.jl",
));

# The acoustic wave test case used in this tutorial represents a global-scale
# problem with inertia-gravity waves traveling around the entire planet.
# It has a hydrostatically balanced initial state that is given a pressure
# perturbation.
# This initial pressure perturbation causes an acoustic wave to travel to
# the antipode, coalesce, and return to the initial position. The exact solution
# of this test case is simple in that the (linear) acoustic theory allows one
# to verify the analytic speed of sound based on the thermodynamics variables.
# The initial condition is defined as a hydrostatically balanced atmosphere
# with background (reference) potential temperature.

# To fully demonstrate the advantages of using an IMEX scheme over fully explicit
# schemes, we start here by going over a simple, fully explicit scheme. The
# reader can refer to the [Single-rate Explicit Timestepping tutorial](@ref Single-rate-Explicit-Timestepping)
# for detailes on such schemes. Here we use the the 14-stage LSRK method
# [`LSRK144NiegemannDiehlBusch`]((@ref ClimateMachine.ODESolvers.LSRK144NiegemannDiehlBusch)), which contains the largest stability region of
# the low-storage methods available in `ClimateMachine.jl`.

FT = Float64
timeend = FT(100)

ode_solver = ClimateMachine.ExplicitSolverType(
    solver_method = LSRK144NiegemannDiehlBusch,
);

# In the following example, the timestep calculation is based on the CFL condition
# for horizontally-propogating acoustic waves. We use a Courant number ``C = 0.002``
# (denoted by `CFL` in the code bellow) in the horizontal, which corresponds
# to a timestep size of approximately ``1`` second.

CFL = FT(0.002)
cfl_direction = HorizontalDirection()
run_acousticwave(ode_solver, CFL, cfl_direction, timeend);

# However, as it is imaginable, for real-world climate processes a time step
# of 1 second would lead to extemely long time-to-solution simulations.
# How can we do better? To be able to take larger time step, we can treat the
# most restrictive wave speeds (vertical acoustic) implicitly rather than
# explicitly. This motivates the use of an IMplicit-EXplicit (IMEX) methods.

# In general, a single step of an ``s``-stage, ``N``-part additive RK method
# (`ARK_N`) is defined by its generalized Butcher tableau:

# ```math
# \begin{align}
#     \begin{array}{c|c|c|c}
#     \boldsymbol{c} &\boldsymbol{A}_{1} & \cdots & \boldsymbol{A}_{N}\\
#     \hline
#     & \boldsymbol{b}_1^T & \cdots & \boldsymbol{b}_N^T\\
#     \hline
#     & \widehat{\boldsymbol{b}}_1^T & \cdots & \widehat{\boldsymbol{b}}_N^T
#     \end{array} =
#     \begin{array}{c|c c c | c | c c c }
#     c_1 & a^{[ 1 ]}_{1,1} & \cdots & a^{[ 1 ]}_{1,s} & \cdots
#     & a^{[ \nu ]}_{1,1} & \cdots & a^{[ \nu ]}_{1,s}\\
#     \vdots & \vdots & \ddots & \vdots & \cdots
#     & \vdots & \ddots & \vdots \\
#     c_s & a^{[ 1 ]}_{s,1} & \cdots & a^{[ 1 ]}_{s,s} & \cdots
#     & a^{[ \nu ]}_{s,1} & \cdots & a^{[ \nu ]}_{s,s}\\
#     \hline
#     & b^{[ 1 ]}_1 & \cdots & b^{[ 1 ]}_s & \cdots
#     & b^{[ \nu ]}_1 & \cdots & b^{[ \nu ]}_s\\
#     \hline
#     & \widehat{b}^{[ 1 ]}_1 & \cdots & \widehat{b}^{[ 1 ]}_s &
#     & \widehat{b}^{[ \nu ]}_1 & \cdots & \widehat{b}^{[ \nu ]}_s
#     \end{array}
# \end{align}
# ```

# and is given by

# ``
# 	\boldsymbol{q}^{n+1} = \boldsymbol{q}^n + \Delta t \left( \underbrace{\sum_{i=1}^{s}}_{\textrm{Stages}} \underbrace{\sum_{\nu=1}^{N}}_{\textrm{Components}} b_i^{[ \nu ]} {\mathcal{T}}^{[ \nu ]}(\boldsymbol{Q}^i)) \right)
# ``

# where ``s`` denotes the stages and ``N`` the components, and where the stage values are given by:
#
# ``
# 	\boldsymbol{Q}^i = \boldsymbol{q}^n + \Delta t \sum_{j=1}^{s} \sum_{\nu = 1}^{N} a_{i,j}^{[ \nu ]}
# 	{\mathcal{T}}^{[ \nu]}(\boldsymbol{Q}^j).
# ``
#
# Similar to standard RK methods, the stage vectors are approximations to the state at each stage
# of the ARK method. Moreover, the temporal coefficients ``c_i`` satisfy a similar
# row-sum condition, holding for all ``\nu = 1, \cdots, N``:

# ``
# 	c_i = \sum_{j=1}^{s} a_{i, j}^{[ \nu ]}, \quad \forall \nu = 1, \cdots, N.
# ``
#
# The Butcher coefficients ``\boldsymbol{c}``, ``\boldsymbol{b}_{\nu}``, ``\boldsymbol{A}_{\nu}``, and ``\widehat{\boldsymbol{b}}_{\nu}``
# are constrained by certain accuracy and stability requirements, which are summarized in
# [Kennedy2001](@cite).

# A common setting is the case ``N = 2``. This gives the typical context for
# Implicit-Explicit (IMEX) splitting methods, where the tendency ``{\mathcal{T}}``
# is assumed to have the decomposition:
#
# ``
# 	\dot{\boldsymbol{q}} = \mathcal{T}(\boldsymbol{q}) \equiv
# 	{\mathcal{T}}_{s}(\boldsymbol{q}) + {\mathcal{T}}_{ns}(\boldsymbol{q}),
# ``
# where the right-hand side has been split into a "stiff" component ``{\mathcal{T}}_{s}``,
# to be treated implicitly, and a non-stiff part ``{\mathcal{T}}_{ns}`` to be treated explicitly.

# Referencing the canonical form introduced in [Time integration](@ref
# Time-integration) we have that in this particular forumlation
# ``\mathcal{T}_{ns}(t, \boldsymbol{q}) \equiv \mathcal{G}(t, \boldsymbol{q})`` and
# ``\mathcal{T}_{s}(t, \boldsymbol{q}) \equiv \mathcal{F}(t, \boldsymbol{q})``.

# Two different RK methods are applied to ``{\mathcal{T}}_{s}`` and ``{\mathcal{T}}_{ns}``
# separately, which have been specifically designed and coupled. Examples can be found in
# [Giraldo2013](@cite). The Butcher Tableau for an `ARK_2` method will have the
# form
#
# ```math
# \begin{align}
#     \begin{array}{c|c|c}
#     \boldsymbol{c} &\boldsymbol{A}_E &\boldsymbol{A}_I\\
#     \hline
#     & \boldsymbol{b}_E^T & \boldsymbol{b}_I^T \\
#     \hline
#     & \widehat{\boldsymbol{b}}_E^T & \widehat{\boldsymbol{b}}_I^T
#     \end{array},
# \end{align}
# ```
#
# with
#
# ``
# 	\boldsymbol{A}_O = \left\lbrace a_{i, j}^O \right\rbrace, \quad
# 	\boldsymbol{b}_O = \left\lbrace b_{i}^O \right\rbrace, \quad
# 	\widehat{\boldsymbol{b}}_O = \left\lbrace \widehat{b}_{i}^O \right\rbrace,
# ``
#
# where ``O`` denotes the label (either ``E`` for explicit or ``I`` for implicit).

# For the acoustic wave example used here, we use 4th order polynomials in
# our discontinuous Galerkin approximation, with 6 elements in each horizontal
# direction and 4 elements in the vertical direction, on the cubed-sphere.
# This gives an effective minimal node-distance (distance between LGL nodes)
# of roughly 203000 m.
# As in the [previous tutorial](@ref Single-rate-Explicit-Timestepping),
# we can determine our ``\Delta t`` by specifying our desired horizontal
# Courant number ``C`` (the timestep calculation is based on the CFL condition
# for horizontally-propogating acoustic waves). In this very simple test case,
# we can use a value of 0.5, which corresponds to a time-step size of
# around 257 seconds. But for this particular example, even higher values
# might work.

timeend = FT(3600)
ode_solver = ClimateMachine.IMEXSolverType(
    solver_method = ARK2GiraldoKellyConstantinescu,
)
CFL = FT(0.5)
cfl_direction = HorizontalDirection()
run_acousticwave(ode_solver, CFL, cfl_direction, timeend);

# ## References
# - [Giraldo2013](@cite)
# - [Kennedy2001](@cite)


using Flux.Optimise
using Flux.Optimise: runall
using Flux: Params, gradient
using Test

@testset "Optimise" begin
  w = randn(10, 10)
  @testset for opt in [ADAMW(), ADAGrad(0.1), AdaMax(), ADADelta(0.9), AMSGrad(),
                       NADAM(), RADAM(), Descent(0.1), ADAM(), Nesterov(), RMSProp(),
                       Momentum()]
    w′ = randn(10, 10)
    loss(x) = Flux.mse(w*x, w′*x)
    for t = 1: 10^5
      θ = Params([w′])
      x = rand(10)
      θ̄ = gradient(() -> loss(x), θ)
      Optimise.update!(opt, θ, θ̄)
    end
    @test loss(rand(10, 10)) < 0.01
  end
end

@testset "Optimiser" begin
  w = randn(10, 10)
  @testset for Opt in [InvDecay, WeightDecay, ExpDecay]
    w′ = randn(10, 10)
    loss(x) = Flux.mse(w*x, w′*x)
    opt = Optimiser(Opt(), ADAM(0.001))
    for t = 1:10^5
      θ = Params([w′])
      x = rand(10)
      θ̄ = gradient(() -> loss(x), θ)
      Optimise.update!(opt, θ, θ̄)
    end
    @test loss(rand(10, 10)) < 0.01
  end
end

@testset "Training Loop" begin
  i = 0
  l = 1

  Flux.train!(() -> (sleep(0.1); i += 1; l),
              (),
              Iterators.repeated((), 100),
              Descent(),
              cb = Flux.throttle(() -> (i > 3 && Flux.stop()), 1))

  @test 3 < i < 50

  # Test multiple callbacks
  x = 0
  fs = [() -> (), () -> x = 1]
  cbs = runall(fs)
  cbs()
  @test x == 1
end

@testset "ExpDecay" begin
    w = randn(10, 10)
    o = ExpDecay(0.1, 0.1, 1000, 1e-4)
    w1 = randn(10,10)
    loss(x) = Flux.mse(w*x, w1*x)
    flag = 1
    decay_steps = []
    for t = 1:10^5
      prev_eta = o.eta
      θ = Params([w1])
      x = rand(10)
      θ̄ = gradient(() -> loss(x), θ)
      prev_grad = collect(θ̄[w1])
      delta = Optimise.apply!(o, w1, θ̄[w1])
      w1 .-= delta
      new_eta = o.eta
      if new_eta != prev_eta
        push!(decay_steps, t)
      end
      array = fill(o.eta, size(prev_grad))
      if array .* prev_grad != delta
        flag = 0
      end
    end
    @test flag == 1
    # Test to check if decay happens at decay steps. Eta reaches clip value eventually.
    ground_truth = []
    for i in 1:11
      push!(ground_truth, 1000*i)  # Expected decay steps for this example.
    end
    @test decay_steps == ground_truth
    @test o.eta == o.clip
end