abstract type AbstractIonizationHistory{T, IT<:AbstractInterpolation{T}} end

abstract type IonizationIntegrator end
struct Peebles <: IonizationIntegrator end

struct IonizationHistory{T, IT} <: AbstractIonizationHistory{T, IT}
    Xₑ::IT
    τ::IT
    τ′::IT
    τ′′::IT
    g̃::IT
    g̃′::IT
    g̃′′::IT
end

# this Peebles history comes from Callin+06, peep the plots from examples/
# which match that paper perfectly
function IonizationHistory(integrator::Peebles, par::ACP, bg::AB) where
                           {T, ACP<:AbstractCosmoParams{T}, AB<:AbstractBackground}
    x_grid = bg.x_grid
    Xₑ_function = Bolt.saha_peebles_recombination(par)
    τ, τ′ = τ_functions(x_grid, Xₑ_function, par)
    g̃ = g̃_function(τ, τ′)

    Xₑ_ = spline(x_grid, Xₑ_function.(x_grid))
    τ_ = spline(x_grid, τ.(x_grid))
    g̃_ = spline(x_grid, g̃.(x_grid))
    IT = typeof(Xₑ_)

    # TO FIX, WHY DOES THIS CONSTRUCTOR REQUIRE {I, IT}???
    return IonizationHistory{T, IT}(
        Xₑ_,
        τ_,
        spline_∂ₓ(τ_, x_grid),
        spline_∂ₓ²(τ_, x_grid),
        g̃_,
        spline_∂ₓ(g̃_, x_grid),
        spline_∂ₓ²(g̃_, x_grid),
    )
end

# Saha Equation
# Useful for high ionization fractions.

# auxillary equations for saha_rhs
const T₀ = ustrip(natural(2.725u"K"))  # CMB temperature [K]  # TODO: make this a parameter of the ionization
n_b(a, par) = par.Ω_b * ρ_crit(par) / (m_H * a^3)
n_H(a, par) = n_b(a, par)  # ignoring helium for now
T_b(a, par) = T₀ / a
saha_rhs(a, par) = (m_e * T_b(a, par) / 2π)^(3/2) / n_H(a, par) *
    exp(-ε₀_H / T_b(a, par))  # rhs of Callin06 eq. 12

function saha_Xₑ(x, par::AbstractCosmoParams)
    rhs = saha_rhs(x2a(x), par)
    return  (√(rhs^2 + 4rhs) - rhs) / 2  # solve Xₑ² / (1-Xₑ) = RHS, it's a polynomial
end
saha_Xₑ(par) = (x -> saha_Xₑ(x, par))

# Peebles Equation
# Use this for Xₑ < 0.99, i.e. z < 1587.4

# recombination parameters for Saha/Peebles
const Λ_2s_to_1s = ustrip(natural(8.227u"s^-1"))  # rate of hydrogen double transition from 2s to 1s
const ε₀_H = ustrip(natural(13.605698u"eV"))  # ionization energy of hydrogen
const m_e = ustrip(natural(float(ElectronMass)))
const m_H = ustrip(natural(float(ProtonMass)))
const α = ustrip(natural(float(FineStructureConstant)))
const σ_T = ustrip(natural(float(ThomsonCrossSection)))

# auxillary equations
ϕ₂(T_b) = 0.448 * log(ε₀_H / T_b)
α⁽²⁾(T_b) = (64π / √(27π)) * (α^2 / m_e^2) * √(ε₀_H / T_b) * ϕ₂(T_b)
β(T_b) = α⁽²⁾(T_b) * (m_e * T_b / (2π))^(3/2) * exp(-ε₀_H / T_b)
β⁽²⁾(T_b) = β(T_b) * exp(3ε₀_H / 4T_b)
n₁ₛ(a, Xₑ, par) = (1 - Xₑ) * n_H(a, par)
Λ_α(a, Xₑ, par) = H_a(a, par) * (3ε₀_H)^3 / ((8π)^2 * n₁ₛ(a, Xₑ, par))
Cᵣ(a, Xₑ, T_b, par) = (Λ_2s_to_1s + Λ_α(a, Xₑ, par)) / (
    Λ_2s_to_1s + Λ_α(a, Xₑ, par) + β⁽²⁾(T_b))

# RHS of Callin06 eq. 13
function peebles_Xₑ′(Xₑ, par, x)
    a = exp(x)
    T_b_a = BigFloat(T_b(a, par))  # handle overflows by switching to bigfloat
    return float(Cᵣ(a, Xₑ, T_b_a, par) / H_a(a, par) * (
        β(T_b_a) * (1 - Xₑ) - n_H(a, par) * α⁽²⁾(T_b_a) * Xₑ^2))
end

"""
    peebles_Xₑ(par, Xₑ₀, x_start, x_end)

Solve the Peebles equation over a span of scale factors, and then
construct an interpolator mapping scale factor to the resulting
ionization fraction.

# Arguments:
- `par`: cosmological parameters
- ` Xₑ₀`: initial ionization fraction
- `x_start`: scale factor to begin integration
- `x_end`: scale factor to end integration

# Returns:
- `generic function`: interpolator for Xₑ(x)
"""
function peebles_Xₑ(par, Xₑ₀, x_start, x_end)
    # set up problem and integrate dXₑ/dx = peebles_Xₑ′
    prob = ODEProblem(peebles_Xₑ′, Xₑ₀, (x_start, x_end), par)
    sol = solve(prob, Tsit5(), reltol=1e-11, abstol=1e-11, dense=true)
    return sol  # ode solutions work as interpolator
end

"""
    saha_peebles_recombination(par::AbstractCosmoParams)

Utility function for generating a decent approximation to Xₑ in ΛCDM recombination,
using the Saha equation until z=1587.4 and then the Peebles equation for the rest.
"""
function saha_peebles_recombination(par::AbstractCosmoParams{T}) where {T}
    z_transition = 1587.4
    x_transition = z2x(z_transition)
    saha_z_grid = 1800:-10:z_transition
    peebles_z_grid = z_transition:-10:100
    early_time_Xₑ = Bolt.saha_Xₑ(par)
    late_time_Xₑ = Bolt.peebles_Xₑ(
        par, early_time_Xₑ(x_transition), x_transition, 0.0)
    Xₑ = x -> (x < x_transition) ? early_time_Xₑ(x) : late_time_Xₑ(x)
    return Xₑ
end

function τ_functions(x, Xₑ_function, par::AbstractCosmoParams)
    @assert x[2] > x[1]  # CONVENTION: x increasing always
    # do a reverse cumulative integrate
    rx = reverse(x)
    τ_primes = [τ′(x_, Xₑ_function, par) for x_ in x]
    τ_integrated = reverse(cumul_integrate(rx, reverse(τ_primes)))

    τ̂ = interpolate((x,),τ_integrated,Gridded(Linear()))
    τ̂′ = interpolate((x,),τ_primes,Gridded(Linear()))
    return τ̂, τ̂′
end

function τ̇(x, Xₑ_function, par)
    a = x2a(x)
    return Xₑ_function(x) * n_H(a, par) * a
end

function τ′(x, Xₑ_function, par)
    a = x2a(x)
    return -Xₑ_function(x) * n_H(a, par) * a * σ_T / ℋ_a(a, par)
end

function g̃_function(τ_x_function, τ′_x_function)
    return x -> -τ′_x_function(x) * exp(-τ_x_function(x))
end


using BilevelJuMP
using Cbc
using Ipopt
using JuMP
using QuadraticToBinary
using Test

# Example slide 9

model = BilevelModel(Cbc.Optimizer, mode = BilevelJuMP.SOS1Mode())

@variable(Upper(model), x)
@variable(Lower(model), y)

@objective(Upper(model), Min, -4x -3y)

@objective(Lower(model), Min, y)

@constraints(Lower(model), begin
    c1, 2x+y <= 4
    c2, x+2y <= 4
    c3, x >= 0
    c4, y >= 0
end)

optimize!(model)

@test value(x) ≈ 2
@test value(y) ≈ 0

# Power systems example NLP

model = BilevelModel(Ipopt.Optimizer,
            mode = BilevelJuMP.ProductMode(1e-5))

@variable(Upper(model), 0 <= qS <= 100, start = 15)

@variable(Lower(model), 0 <= gS, start = 20)
@variable(Lower(model), 0 <= gR1 <= 40, start = 40)
@variable(Lower(model), 0 <= gR2 <= 40, start = 40)
@variable(Lower(model), 0 <= gD <= 100, start = 0)

@objective(Lower(model), Min, 50gR1 + 100gR2 + 1000gD)
@constraint(Lower(model), b, gS + gR1 + gR2 + gD == 100)
@constraint(Lower(model), gS <= qS)

@variable(Upper(model), lambda, DualOf(b), start = 1_000)
@objective(Upper(model), Max, lambda*gS)

optimize!(model)

@test objective_value(model) ≈ 20_000  atol=1e-1
@test BilevelJuMP.lower_objective_value(model) ≈ 6_000  atol=1e-1
@test value(qS) ≈ 20 atol=1e-3
@test value.(gS) ≈ 20 atol=1e-3
@test value(lambda) ≈ 1_000 atol=1e-3

# Power systems example MIP

const CBC_OPTIMIZER = Cbc.Optimizer()
MOI.set(CBC_OPTIMIZER, MOI.Silent(), true)
const CBC_CACHE = MOIU.UniversalFallback(MOIU.Model{Float64}())
const CBC_CACHED = MOIU.CachingOptimizer(CBC_CACHE, CBC_OPTIMIZER)
const CBC_BRIDGED = MOI.Bridges.full_bridge_optimizer(CBC_CACHED, Float64)
            MOI.Bridges.add_bridge(CBC_BRIDGED, MOI.Bridges.Constraint.SOCtoNonConvexQuadBridge{Float64})

opt = QuadraticToBinary.Optimizer{Float64}(CBC_BRIDGED)
model = BilevelModel(() -> opt,
            mode = BilevelJuMP.SOS1Mode())

@variable(Upper(model), 0 <= qS <= 100)

@variable(Lower(model), 0 <= gS <= 1000)
@variable(Lower(model), 0 <= gR1 <= 40)
@variable(Lower(model), 0 <= gR2 <= 40)
@variable(Lower(model), 0 <= gD <= 100)

@objective(Lower(model), Min, 50gR1 + 100gR2 + 1000gD)
@constraint(Lower(model), b, gS + gR1 + gR2 + gD == 100)
@constraint(Lower(model), gS <= qS)

@variable(Upper(model), -10_000 <= lambda <= 10_000, DualOf(b))
@objective(Upper(model), Max, lambda*gS)

optimize!(model)

@test objective_value(model) ≈ 20_000  atol=20
@test BilevelJuMP.lower_objective_value(model) ≈ 6_000  atol=1e-1
@test value(qS) ≈ 20 atol=1e-3
@test value.(gS) ≈ 20 atol=1e-3
@test value(lambda) ≈ 1_000 atol=1e-3


"""
     sysf = glsfg(sys, γ; fast = true, stabilize = true, offset = β,
                  atol = 0, atol1 = atol, atol2 = atol, rtol = n*ϵ)

Compute for the descriptor system `sys = (A-λE,B,C,D)` with the transfer function matrix `G(λ)`
and ``{\\small γ > \\|G(λ)\\|_∞}``, the minimum-phase right spectral factor `sysf = (Af-λEf,Bf,Cf,Df)`
with the transfer-function matrix `F(λ)`, such that `F(λ)*F(λ)' = γ^2*I-G(λ)*G(λ)'`.
If `stabilize = true` (the default), a preliminary stabilization of `sys` is performed.
In this case, `sys` must not have poles on the imaginary-axis in the continuous-time case or
on the unit circle in the discrete-time case.
If `stabilize = false`, then no preliminary stabilization is performed. In this case, `sys` must be stable.

To assess the presence of poles on the boundary of the stability domain `Cs`, a boundary offset  `β`
can be specified via the keyword parameter `offset = β`.
Accordingly, for a continuous-time system,
the boundary of `Cs` contains the complex numbers with real parts within the interval `[-β,β]`,
while for a discrete-time system, then the boundary of `Cs` contains
the complex numbers with moduli within the interval `[1-β,1+β]`.
The default value used for `β` is `sqrt(ϵ)`, where `ϵ` is the working machine precision.

If `stabilize = true`, a preliminary separation of finite and infinite eigenvalues of `A-λE`is performed
using rank decisions based on rank revealing QR-decompositions with column pivoting
if `fast = true` or the more reliable SVD-decompositions if `fast = false`.

The keyword arguments `atol1`, `atol2`, `atol3`, and `rtol`, specify, respectively,
the absolute tolerance for the nonzero elements of `A`,
the absolute tolerance for the nonzero elements of `E`,
the absolute tolerance for the nonzero elements of `C`,
and the relative tolerance for the nonzero elements of `A`, `E` and `C`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the working machine epsilon.
The keyword argument `atol` can be used
to simultaneously set `atol1 = atol`, `atol2 = atol`, `atol3 = atol`.

_Method:_ Extensions of the factorization approaches of [1] are used.

_References:_

[1] K. Zhou, J. C. Doyle, and K. Glover. Robust and Optimal Control. Prentice Hall, 1996.
"""
function glsfg(sys::DescriptorStateSpace{T},γ::Real; stabilize::Bool = true,
               offset::Real = sqrt(eps(float(real(T)))), atol::Real = zero(real(T)),
               atol1::Real = atol, atol2::Real = atol, atol3::Real = atol,
               rtol::Real = sys.nx*eps(real(float(one(T))))*iszero(max(atol1,atol2,atol3)),
               fast::Bool = true) where T

   # Compute the RCF with inner denominator if stabilize = true
   stabilize && (sys = grcfid(sys; mininf = true, fast = fast, offset = offset,
                          atol1 = atol1, atol2 = atol2, atol3 = atol3, rtol = rtol)[1])

   epsm2 = sqrt(eps(float(real(T))))

   if sys.E != I && (norm(sys.E,Inf) < atol2 || rcond(sys.E) < epsm2 )
      sys = gss2ss(sys; atol1 = atol1, atol2 = atol2, rtol = rtol)
      sys.E != I && rcond(sys.E) < epsm2 && error("Improper input system sys")
   end
   a, e, b, c, d = dssdata(sys)
   discr = (sys.Ts != 0)

   # Compute the stabilizing solution of the corresponding Riccati equation
   p, n = size(c)
   r = γ*γ*I-d*d'

   if n > 0
      if discr
         xric, _, kric, = gared(a', e', c', -r, b*b', b*d'; rtol = rtol); #fric = -fric;
         SF = schur(xric)
         rdiag = Diagonal(sqrt.(max.(real.(SF.values),0)))
         SV = svd([d c*SF.Z*rdiag],full=true)
      else
         _, _, kric, = garec(a', e', c', -r, b*b', b*d'; rtol = rtol); #fric = -fric;
         SV = svd(d,full=true)
      end
   else
      SV = svd(d,full=true)
      if !isempty(SV.S) && SV.S[1] > abs(γ)
         error("The condition γ > ||sys||∞ is not fulfilled")
      end
      kric = zeros(T,p,n)
   end

   # compute square-root factor
   s = SV.S
   rsq = [s;zeros(eltype(s),p-length(s))]
   rsqrt = SV.U*Diagonal(sqrt.(max.(γ*γ .- rsq.^2,0)))

   # assemble the spectral factor
   sysf = dss(a, e, kric'*rsqrt, c, rsqrt, Ts = sys.Ts)

   # end GLSFG
end
"""
     sysf = grsfg(sys, γ; fast = true, stabilize = true, offset = β,
                  atol = 0, atol1 = atol, atol2 = atol, rtol = n*ϵ)

Compute for the descriptor system `sys = (A-λE,B,C,D)` with the transfer function matrix `G(λ)`
and ``{\\small γ > \\|G(λ)\\|_∞}``, the minimum-phase right spectral factor `sysf = (Af-λEf,Bf,Cf,Df)`
with the transfer-function matrix `F(λ)`, such that `F(λ)'*F(λ) = γ^2*I-G(λ)'*G(λ)`.
If `stabilize = true` (the default), a preliminary stabilization of `sys` is performed.
In this case, `sys` must not have poles on the imaginary-axis in the continuous-time case or
on the unit circle in the discrete-time case.
If `stabilize = false`, then no preliminary stabilization is performed. In this case, `sys` must be stable.

To assess the presence of poles on the boundary of the stability domain `Cs`, a boundary offset  `β`
can be specified via the keyword parameter `offset = β`.
Accordingly, for a continuous-time system,
the boundary of `Cs` contains the complex numbers with real parts within the interval `[-β,β]`,
while for a discrete-time system, then the boundary of `Cs` contains
the complex numbers with moduli within the interval `[1-β,1+β]`.
The default value used for `β` is `sqrt(ϵ)`, where `ϵ` is the working machine precision.

If `stabilize = true`, a preliminary separation of finite and infinite eigenvalues of `A-λE`is performed
using rank decisions based on rank revealing QR-decompositions with column pivoting
if `fast = true` or the more reliable SVD-decompositions if `fast = false`.

The keyword arguments `atol1`, `atol2`, `atol3`, and `rtol`, specify, respectively,
the absolute tolerance for the nonzero elements of `A`,
the absolute tolerance for the nonzero elements of `E`,
the absolute tolerance for the nonzero elements of `C`,
and the relative tolerance for the nonzero elements of `A`, `E` and `C`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the working machine epsilon.
The keyword argument `atol` can be used
to simultaneously set `atol1 = atol`, `atol2 = atol`, `atol3 = atol`.

_Method:_ Extensions of the factorization approaches of [1] are used.

_References:_

[1] K. Zhou, J. C. Doyle, and K. Glover. Robust and Optimal Control. Prentice Hall, 1996.
"""
function grsfg(sys::DescriptorStateSpace{T},γ::Real; stabilize::Bool = true,
               offset::Real = sqrt(eps(float(real(T)))), atol::Real = zero(real(T)),
               atol1::Real = atol, atol2::Real = atol, atol3::Real = atol,
               rtol::Real = sys.nx*eps(real(float(one(T))))*iszero(max(atol1,atol2,atol3)),
               fast::Bool = true) where T

   # Compute the LCF with inner denominator if stabilize = true
   stabilize && (sys = glcfid(sys; mininf = true, fast = fast, offset = offset,
                          atol1 = atol1, atol2 = atol2, atol3 = atol3, rtol = rtol)[1])

   epsm2 = sqrt(eps(float(real(T))))

   if sys.E != I && (norm(sys.E,Inf) < atol2 || rcond(sys.E) < epsm2 )
      sys = gss2ss(sys; atol1 = atol1, atol2 = atol2, rtol = rtol)
      sys.E != I && rcond(sys.E) < epsm2 && error("Improper input system sys")
   end
   a, e, b, c, d = dssdata(sys)
   discr = (sys.Ts != 0)

   # Compute the stabilizing solution of the corresponding Riccati equation
   n, m = size(b)
   r = γ*γ*I-d'*d

   if n > 0
      if discr
         xric, _, fric, = gared(a, e, b, -r, c'*c, c'*d; rtol = rtol); #fric = -fric;
         SF = schur(xric)
         rdiag = Diagonal(sqrt.(max.(real.(SF.values),0)))
         SV = svd([d;rdiag*SF.Z'*b],full=true)
      else
         _, _, fric, = garec(a, e, b, -r, c'*c, c'*d; rtol = rtol); #fric = -fric;
         SV = svd(d,full=true)
      end
   else
      SV = svd(d,full=true)
      if !isempty(SV.S) && SV.S[1] > abs(γ)
         error("The condition γ > ||sys||∞ is not fulfilled")
      end
      fric = zeros(T,m,n);
   end

   # compute square-root factor
   s = SV.S
   rsq = [s;zeros(eltype(s),m-length(s))]
   rsqrt = Diagonal(sqrt.(max.(γ*γ .- rsq.^2,0)))*SV.Vt

   # assemble the spectral factor
   sysf = dss(a, e, b, rsqrt*fric, rsqrt, Ts = sys.Ts)

   # end GRSFG
end
"""
    gnlcf(sys; fast = true, ss = false,
         atol = 0, atol1 = atol, atol2 = atol, rtol = n*ϵ) -> (sysn, sysm)

Compute for the descriptor system `sys = (A-λE,B,C,D)`, the factors
`sysn = (An-λEn,Bn,Cn,Dn)` and `sysm = (An-λEn,Bm,Cn,Dm)` of its normalized
right coprime factorization. If `sys`, `sysn` and `sysm`
have the transfer function matrices `G(λ)`, `N(λ)` and `M(λ)`, respectively, then
`G(λ) = inv(M(λ))*N(λ)`, with `N(λ)` and `M(λ)` proper and stable transfer
function matrices and `[N(λ) M(λ)]` coinner. The resulting `En = I` if `ss = true`.

Pencil reduction algorithms are employed which perform rank decisions based on rank
revealing QR-decompositions with column pivoting
if `fast = true` or the more reliable SVD-decompositions if `fast = false`.

The keyword arguments `atol1`, `atol2` and `rtol`, specify, respectively,
the absolute tolerance for the nonzero elements of `A`, `B`, `C` and `D`,
the absolute tolerance for the nonzero elements of `E`,
and the relative tolerance for the nonzero elements of `A`, `E`, `B`, `C` and `D`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the machine epsilon of the element type of `A`
and `n` is the order of the system `sys`.
The keyword argument `atol` can be used to simultaneously set `atol1 = atol`, `atol2 = atol`.

_Method:_ Pencil reduction algorithms are employed to determine the coinner coimage space `R(λ)` of the
transfer function matrix `[G(λ) I]` using the dual of method described in [1], which is based on
the reduction algorithm of [2]. Then the factors `N(λ)` and `M(λ)` result from the partitioning of
`R(λ)` as `R(λ) = [N(λ) M(λ)]`.

_References:_

[1] Varga, A.
    A note on computing the range of rational matrices.
    arXiv:1707.0048, [https://arxiv.org/abs/1707.0048](https://arxiv.org/abs/1707.004), 2017.

[2] C. Oara.
    Constructive solutions to spectral and inner–outer factorizations
    respect to the disk. Automatica,  41, pp. 1855–1866, 2005.
"""
function gnlcf(sys::DescriptorStateSpace{T}; fast::Bool = true, ss::Bool = false,
              atol::Real = zero(real(T)), atol1::Real = atol, atol2::Real = atol,
              rtol::Real = sys.nx*eps(real(float(one(T))))*iszero(max(atol1,atol2))) where T

   # compute the coinner coimage of [G(λ) I]
   p, m = size(sys)
   sysr, = gcrange([sys I], zeros = "none", coinner = true, fast = fast, atol1 = atol1, atol2 = atol2, rtol = rtol)

   # compute a standard state-space realization if requested
   ss && (sysr = gss2ss(sysr, Eshape = "ident", atol1 = atol1, atol2 = atol2, rtol = rtol)[1])

   # extract the factors N(λ) and M(λ)
   return sysr[1:p,1:m], sysr[1:p,m+1:end]

   # end GNRCF
end
"""
    gnrcf(sys; fast = true, ss = false,
         atol = 0, atol1 = atol, atol2 = atol, rtol = n*ϵ) -> (sysn, sysm)

Compute for the descriptor system `sys = (A-λE,B,C,D)`, the factors
`sysn = (An-λEn,Bn,Cn,Dn)` and `sysm = (An-λEn,Bn,Cm,Dm)` of its normalized
right coprime factorization. If `sys`, `sysn` and `sysm`
have the transfer function matrices `G(λ)`, `N(λ)` and `M(λ)`, respectively, then
`G(λ) = N(λ)*inv(M(λ))`, with `N(λ)` and `M(λ)` proper and stable transfer
function matrices and `[N(λ);M(λ)]` inner. The resulting `En = I` if `ss = true`.

Pencil reduction algorithms are employed which perform rank decisions based on rank
revealing QR-decompositions with column pivoting
if `fast = true` or the more reliable SVD-decompositions if `fast = false`.

The keyword arguments `atol1`, `atol2` and `rtol`, specify, respectively,
the absolute tolerance for the nonzero elements of `A`, `B`, `C` and `D`,
the absolute tolerance for the nonzero elements of `E`,
and the relative tolerance for the nonzero elements of `A`, `E`, `B`, `C` and `D`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the machine epsilon of the element type of `A`
and `n` is the order of the system `sys`.
The keyword argument `atol` can be used to simultaneously set `atol1 = atol`, `atol2 = atol`.

_Method:_ Pencil reduction algorithms are employed to determine the inner range space `R(λ)` of the
transfer function matrix `[G(λ); I]` using the method described in [1], which is based on
the reduction algorithm of [2]. Then the factors `N(λ)` and `M(λ)` result from the partitioning of
`R(λ)` as `R(λ) = [N(λ);M(λ)]`.

_References:_

[1] Varga, A.
    A note on computing the range of rational matrices.
    arXiv:1707.0048, [https://arxiv.org/abs/1707.0048](https://arxiv.org/abs/1707.004), 2017.

[2] C. Oara.
    Constructive solutions to spectral and inner–outer factorizations
    respect to the disk. Automatica,  41, pp. 1855–1866, 2005.
"""
function gnrcf(sys::DescriptorStateSpace{T}; fast::Bool = true, ss::Bool = false,
              atol::Real = zero(real(T)), atol1::Real = atol, atol2::Real = atol,
              rtol::Real = sys.nx*eps(real(float(one(T))))*iszero(max(atol1,atol2))) where T

   # compute the inner range of [G(λ);I]
   p, m = size(sys)
   sysr, = grange([sys;I], zeros = "none", inner = true, fast = fast, atol1 = atol1,atol2 = atol2, rtol = rtol)

   # compute a standard state-space realization if requested
   ss && (sysr = gss2ss(sysr, Eshape = "ident", atol1 = atol1, atol2 = atol2, rtol = rtol)[1])

   # extract the factors N(λ) and M(λ)
   return sysr[1:p,1:m], sysr[p+1:end,1:m]

   # end GNRCF
end
"""
    goifac(sys; atol = 0, atol1 = atol, atol2 = atol, atol3 = atol, rtol,
           fast = true, minphase = true, offset = sqrt(ϵ)) -> (sysi, syso, info)

Compute for the descriptor system `sys = (A-λE,B,C,D)` with the transfer function matrix `G(λ)`,
the square inner factor `sysi = (Ai-λEi,Bi,Ci,Di)` with the transfer function matrix `Gi(λ)`
and the minimum-phase quasi-outer factor or the full column rank factor `syso = (Ao-λEo,Bo,Co,Do)`
with the transfer function matrix `Go(λ)` such that

     G(λ) = Go(λ)*Gi[1:r,:](λ)    (*),

where `r` is the normal rank of `G(λ)`. The resulting proper and stable inner factor satisfies
`Gi'(λ)*Gi(λ) = I`. If `sys` is stable (proper), then the resulting `syso` is stable (proper).
The resulting factor `Go(λ)` has full column rank `r`. Depending on the selected factorization option,
if `minphase = true`, then `Go(λ)` is minimum phase,  excepting possibly zeros on the
boundary of the appropriate stability domain `Cs`, or if `minphase = false`, then `Go(λ)`
contains all zeros of `G(λ)`, in which case (*) is the extended RQ-like factorization of `G(λ)`.
For a continuous-time system `sys`, the stability domain `Cs` is defined as the set of
complex numbers with real parts at most `-β`,
while for a discrete-time system `sys`, `Cs` is the set of complex numbers with
moduli at most `1-β` (i.e., the interior of a disc of radius `1-β` centered in the origin).
The boundary offset  `β` to be used to assess the stability of zeros and their number
on the boundary of `Cs` can be specified via the keyword parameter `offset = β`.
Accordingly, for a continuous-time system,
the boundary of `Cs` contains the complex numbers with real parts within the interval `[-β,β]`,
while for a discrete-time system, the boundary of `Cs` contains
the complex numbers with moduli within the interval `[1-β,1+β]`.
The default value used for `β` is `sqrt(ϵ)`, where `ϵ` is the working machine precision.

The resulting named triple `info` contains `(nrank, nfuz, niuz) `, where `info.nrank = r`,
the normal rank of `G(λ)`, `info.nfuz` is the number of finite zeros of `syso` on
the boundary of `Cs`, and `info.niuz` is the number of infinite zeros of `syso`.
`info.nfuz` is set to `missing` if `minphase = false`.

_Note:_ `syso` may generally contain a _free inner factor_, which can be eliminated by
removing the finite unobservable eigenvalues.

The keyword arguments `atol1`, `atol2`, `atol3`, and `rtol`, specify, respectively,
the absolute tolerance for the nonzero elements of `A` and `C`,
the absolute tolerance for the nonzero elements of `E`,
the absolute tolerance for the nonzero elements of `B` and `D`,
and the relative tolerance for the nonzero elements of `A`, `E`, `B`, `C` and `D`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the working machine epsilon
and `n` is the order of the system `sys`. The keyword argument `atol` can be used
to simultaneously set `atol1 = atol`, `atol2 = atol`, `atol3 = atol`.

For the assessment of zeros, the dual system pencil `transpose([A-λE B; C D])` is reduced to a
special Kronecker-like form (see [2]). In this reduction, the
performed rank decisions are based on rank revealing QR-decompositions with column pivoting
if `fast = true` or the more reliable SVD-decompositions if `fast = false`.

_Method:_  For a continuous-time system, the dual system is formed and the factorization algorithm
of [1] is used, while for a discrete-time system, the factorization algorithm of [1] is used.

_References:_

[1] C. Oara and A. Varga.
    Computation of the general inner-outer and spectral factorizations.
    IEEE Trans. Autom. Control, vol. 45, pp. 2307--2325, 2000.

[2] C. Oara.
    Constructive solutions to spectral and inner–outer factorizations
    respect to the disk. Automatica,  41, pp. 1855–1866, 2005.
"""
function goifac(sys::DescriptorStateSpace; kwargs...)
   sysi, syso, info = giofac(gdual(sys); kwargs...)
   return gdual(sysi), gdual(syso), info
end
"""
    giofac(sys; atol = 0, atol1 = atol, atol2 = atol, atol3 = atol, rtol,
           fast = true, minphase = true, offset = sqrt(ϵ)) -> (sysi, syso, info)

Compute for the descriptor system `sys = (A-λE,B,C,D)` with the transfer function matrix `G(λ)`,
the square inner factor `sysi = (Ai-λEi,Bi,Ci,Di)` with the transfer function matrix `Gi(λ)`
and the minimum-phase quasi-outer factor or the full row rank factor `syso = (Ao-λEo,Bo,Co,Do)`
with the transfer function matrix `Go(λ)` such that

     G(λ) = Gi[:,1:r](λ)*Go(λ)    (*),

where `r` is the normal rank of `G(λ)`. The resulting proper and stable inner factor satisfies
`Gi'(λ)*Gi(λ) = I`. If `sys` is stable (proper), then the resulting `syso` is stable (proper).
The resulting factor `Go(λ)` has full row rank `r`. Depending on the selected factorization option,
if `minphase = true`, then `Go(λ)` is minimum phase,  excepting possibly zeros on the
boundary of the appropriate stability domain `Cs`, or if `minphase = false`, then `Go(λ)`
contains all zeros of `G(λ)`, in which case (*) is the extended QR-like factorization of `G(λ)`.
For a continuous-time system `sys`, the stability domain `Cs` is defined as the set of
complex numbers with real parts at most `-β`,
while for a discrete-time system `sys`, `Cs` is the set of complex numbers with
moduli at most `1-β` (i.e., the interior of a disc of radius `1-β` centered in the origin).
The boundary offset  `β` to be used to assess the stability of zeros and their number
on the boundary of `Cs` can be specified via the keyword parameter `offset = β`.
Accordingly, for a continuous-time system,
the boundary of `Cs` contains the complex numbers with real parts within the interval `[-β,β]`,
while for a discrete-time system, the boundary of `Cs` contains
the complex numbers with moduli within the interval `[1-β,1+β]`.
The default value used for `β` is `sqrt(ϵ)`, where `ϵ` is the working machine precision.

The resulting named triple `info` contains `(nrank, nfuz, niuz) `, where `info.nrank = r`,
the normal rank of `G(λ)`, `info.nfuz` is the number of finite zeros of `syso` on
the boundary of `Cs`, and `info.niuz` is the number of infinite zeros of `syso`.
`info.nfuz` is set to `missing` if `minphase = false`.

_Note:_ `syso` may generally contain a _free inner factor_, which can be eliminated by
removing the finite unobservable eigenvalues.

The keyword arguments `atol1`, `atol2`, `atol3`, and `rtol`, specify, respectively,
the absolute tolerance for the nonzero elements of `A` and `B`,
the absolute tolerance for the nonzero elements of `E`,
the absolute tolerance for the nonzero elements of `C` and `D`,
and the relative tolerance for the nonzero elements of `A`, `E`, `B`, `C` and `D`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the working machine epsilon
and `n` is the order of the system `sys`. The keyword argument `atol` can be used
to simultaneously set `atol1 = atol`, `atol2 = atol`, `atol3 = atol`.

For the assessment of zeros, the system pencil `[A-λE B; C D]` is reduced to a
special Kronecker-like form (see [2]). In this reduction, the
performed rank decisions are based on rank revealing QR-decompositions with column pivoting
if `fast = true` or the more reliable SVD-decompositions if `fast = false`.

_Method:_  For a continuous-time system, the factorization algorithm of [1] is used, while
for a discrete-time system, the factorization algorithm of [1] is used.

_References:_

[1] C. Oara and A. Varga.
    Computation of the general inner-outer and spectral factorizations.
    IEEE Trans. Autom. Control, vol. 45, pp. 2307-2325, 2000.

[2] C. Oara.
    Constructive solutions to spectral and inner–outer factorizations
    respect to the disk. Automatica,  41, pp. 1855–1866, 2005.
"""
function giofac(sys::DescriptorStateSpace{T}; atol::Real = zero(real(T)),
             atol1::Real = atol, atol2::Real = atol, atol3::Real = atol,
             rtol::Real = sys.nx*eps(real(float(one(T))))*iszero(max(atol1,atol2,atol3)),
             offset::Real = sqrt(eps(float(real(T)))), fast::Bool = true, minphase::Bool = true) where T

   disc = !iszero(sys.Ts)

   # enforce controllability of sys
   sys = gir(sys, atol1 = atol1, atol2 = atol2, obs = false)

   #  Reduce the system matrix pencil to the special Kronecker-like form
   #
   #                 ( Arg-λ*Erg     *        *   *   )
   #                 (   0        Abl-λ*Ebl  Bbl  *   )
   #       At-λ*Et = (   0           0        0   Bn  )
   #                 (--------------------------------)
   #                 (   0          Cbl      Dbl  *   )
   #
   # where the subpencil
   #                           ( Abl-λ*Ebl  Bbl )
   #                           (   Cbl      Ddl )
   #
   # is full column rank, the pair (Abl-λ*Ebl,Bbl) is stabilizable, and
   # Abl-λ*Ebl contains either no zeros of sys if
   # minphase = false, or contains all unstable zeros of sys if minphase = true.

   At, Et, _, Z, dimsc, nmszer, nizer = gsklf(dssdata(sys)...; disc = disc,
                jobopt = minphase ? "unstable" : "none",
                offset = offset, fast = fast, atol1 = atol1, atol2 = atol2, rtol = rtol,
                withQ = false, withZ = true)

   n, m = size(sys.B); p = size(sys.D,1);

   # form the reduced system (Abl-λ*Ebl,Bbl,Cbl,Dbl)
   nr = dimsc[1]; nric = dimsc[2]; mric = dimsc[3]; nsinf = dimsc[4];
   il = n-nsinf-nric+1:n-nsinf; jal = nr+1:nr+nric; jbl = nr+nric+1:nr+nric+mric; icl = n+1:n+p
   # A = At[il,jal]; E = Et[il,jal]; B = At[il,jbl]; C = At[icl,jal]; D = At[icl,jbl];
   A = view(At,il,jal); E = view(Et,il,jal); B = view(At,il,jbl); C = view(At,icl,jal); D = view(At,icl,jbl)

   # move unstable zeros to stable positions and compress the reduced system to one
   # with full row rank transfer function matrix
   if disc
      # X, _,F, = gared(A,E,B,D'*D,C'*C,C'*D);
      X, _,F, = try
         gared(A,E,B,D'*D,C'*C,C'*D)
      catch err
         findfirst("dichotomic",string(err)) === nothing ? error("$err") :
            error("Solution of the DARE failed: Symplectic pencil has eigenvalues on the unit circle")
      end
   else
      # X, _, F, = garec(A,E,B,D'*D,C'*C,C'*D);
      X, _, F, = try
         garec(A,E,B,D'*D,C'*C,C'*D)
      catch err
         findfirst("dichotomic",string(err)) === nothing ? error("$err") :
            error("Solution of the CARE failed: Hamiltonian pencil has jw-axis eigenvalues")
      end
   end

   # assemble the inner and outer factors
   if disc
      mm1 = p-mric
      H = cholesky(Hermitian(D'*D+B'*X*B)).U
      if mm1 > 0
         V2 = svd([A'*X C'; B'*X D'], full = true).V[:,nric+mric+1:nric+p]
         Y = view(V2,1:nric,:)
         W = view(V2,nric+1:nric+p,:)
         U = cholesky(Hermitian(W'*W+Y'*X*Y)).U;
         rdiv!(V2,U)  # compute Y/U and W/U
      else
         Y = zeros(T,nric,mm1); W = zeros(T,p,mm1)
      end
   else
      FQR = qr(D);
      H = FQR.R[1:mric,:]; W = FQR.Q[:,mric+1:p]
      rank(X) < nric ? Y = -pinv(X)*((E')\C'*W) : Y = -(E'*X)\C'*W
   end

   # construct the square inner factor
   agi = A-B*F; bgi = [B/H Y]; cgi = C-D*F; dgi = [D/H W];

   # convert the inner factor to a standard state-space realization if sys
   # is in a standard state-space form
   sys.E == I ? (E = UpperTriangular(E); sysi = dss(rdiv!(agi,E), bgi, rdiv!(cgi,E), dgi, Ts = sys.Ts) ) :
                 (sysi = dss(agi, copy(E), bgi, cgi, dgi, Ts = sys.Ts))

   # construct the outer factor
   CDt = [H*F H]*Z[:,nr+1:n+m-nsinf]'
   syso = dss(sys.A, sys.E, sys.B, CDt[:,1:n], CDt[:,n+1:n+m], Ts = sys.Ts);

   info = (nrank = mric, nfuz = nmszer, niuz = nizer)

   return sysi, syso, info

end
"""
    glcf(sys; smarg, sdeg, evals, mindeg = false, mininf = false, fast = true,
         atol = 0, atol1 = atol, atol2 = atol, atol3 = atol, rtol = n*ϵ) -> (sysn, sysm)

Compute for the descriptor system `sys = (A-λE,B,C,D)`, the factors
`sysn = (An-λEn,Bn,Cn,Dn)` and `sysm = (Am-λEm,Bm,Cm,Dm)` of its stable and proper
left coprime factorization. If `sys`, `sysn` and `sysm`
have the transfer function matrices `G(λ)`, `N(λ)` and `M(λ)`, respectively, then
`G(λ) = inv(M(λ))*N(λ)`, with `N(λ)` and `M(λ)` proper and stable transfer
function matrices.
The resulting matrix pairs `(An,En)` and `(Am,Em)` are in (generalized) Schur form.
The stability domain `Cs` of poles is defined by
the keyword argument `smarg` for the stability margin, as follows:
for a continuous-time system `sys`, `Cs` is the set of complex numbers
with real parts at most `smarg`,
while for a discrete-time system `sys`, `Cs` is the set of complex numbers with
moduli at most `smarg < 1` (i.e., the interior of a disc of radius `smarg` centered in the origin).
If `smarg` is missing, then the employed default values are `smarg = -sqrt(eps)`
for a continuous-time system and `smarg = 1-sqrt(eps)` for a discrete-time system.

The keyword argument `sdeg` specifies the prescribed stability degree for the
assigned eigenvalues of the factors. If both `sdeg` and `smarg` are missing,
then the employed  default values are `sdeg = -0.05` for a continuous-time system and
`sdeg = 0.95` for a discrete-time system, while if `smarg` is specified,
then `sdeg = smarg` is used.

The keyword argument `evals` is a real or complex vector, which contains a set
of finite desired eigenvalues for the factors.
For a system with real data, `evals` must be a self-conjugated complex set
to ensure that the resulting factors are also real.

If `mindeg = false`, both factors `sysn` and `sysm` have descriptor realizations
with the same order and with `An = Am`, `En = Em` and `Cn = Cm`. If `mindeg = true`,
the realization of `sysm` is minimal. The number of (finite) poles of `sysm` is
equal to the number of unstable finite poles of `sys`.

If `mininf = false`, then `An-λEn` and `Am-λEm` may have simple infinite eigenvalues.
If `mininf = true`,  then `An-λEn` and `Am-λEm` have no simple infinite eigenvalues.
Note that the removing of simple infinite eigenvalues involves matrix inversions.

The keyword arguments `atol1`, `atol2`, `atol3`, and `rtol`, specify, respectively,
the absolute tolerance for the nonzero elements of `A`,
the absolute tolerance for the nonzero elements of `E`,
the absolute tolerance for the nonzero elements of `C`,
and the relative tolerance for the nonzero elements of `A`, `E` and `C`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the machine epsilon of the element type of `A`
and `n` is the order of the system `sys`.
The keyword argument `atol` can be used
to simultaneously set `atol1 = atol`, `atol2 = atol`, `atol3 = atol`.

The preliminary separation of finite and infinite eigenvalues of `A-λE` is performed
using rank decisions based on rank revealing QR-decompositions with column pivoting
if `fast = true` or the more reliable SVD-decompositions if `fast = false`.

_Method:_  The dual of Procedure GRCF from [2] is used, which represents
an extension of the recursive factorization approach of [1] to cope with
infinite poles. All infinite eigenvalues are assigned to finite real values.
If `evals` is missing or does not contain a sufficient
number of real values, then a part or all of infinite eigenvalues of `A-λE` are
assigned to the value specified by `sdeg`.
The pairs `(An,En)` and `(Am,Em)`  result in _generalized Schur form_ with
both `An` and `Am` quasi-upper triangular
and `En` and `Em` either both upper triangular or both UniformScalings.

_References:_

[1] A. Varga. Computation of coprime factorizations of rational matrices.
    Linear Algebra and Its Applications, vol. 271, pp.88-115, 1998.

[2] A. Varga. On recursive computation of coprime factorizations of rational matrices.
    arXiv:1703.07307, https://arxiv.org/abs/1703.07307, 2020. (to appear in Linear Algebra and Its Applications)
"""
function glcf(sys::DescriptorStateSpace; kwargs...)
              sysn, sysm = grcf(gdual(sys,rev = true); kwargs...)
   return gdual(sysn,rev = true), gdual(sysm,rev = true)
end
"""
    grcf(sys; smarg, sdeg, evals, mindeg = false, mininf = false, fast = true,
         atol = 0, atol1 = atol, atol2 = atol, atol3 = atol, rtol = n*ϵ) -> (sysn, sysm)

Compute for the descriptor system `sys = (A-λE,B,C,D)`, the factors
`sysn = (An-λEn,Bn,Cn,Dn)` and `sysm = (Am-λEm,Bm,Cm,Dm)` of its stable and proper
right coprime factorization. If `sys`, `sysn` and `sysm`
have the transfer function matrices `G(λ)`, `N(λ)` and `M(λ)`, respectively, then
`G(λ) = N(λ)*inv(M(λ))`, with `N(λ)` and `M(λ)` proper and stable transfer
function matrices.
The resulting matrix pairs `(An,En)` and `(Am,Em)` are in (generalized) Schur form.
The stability domain `Cs` of poles is defined by
the keyword argument `smarg` for the stability margin, as follows:
for a continuous-time system `sys`, `Cs` is the set of complex numbers
with real parts at most `smarg < 0`,
while for a discrete-time system `sys`, `Cs` is the set of complex numbers with
moduli at most `smarg < 1` (i.e., the interior of a disc of radius `smarg` centered in the origin).
If `smarg` is missing, then the employed default values are `smarg = -sqrt(eps)`
for a continuous-time system and `smarg = 1-sqrt(eps)` for a discrete-time system.

The keyword argument `sdeg` specifies the prescribed stability degree for the
assigned eigenvalues of the factors. If both `sdeg` and `smarg` are missing,
then the employed  default values are `sdeg = -0.05` for a continuous-time system and
`sdeg = 0.95` for a discrete-time system, while if `smarg` is specified,
then `sdeg = smarg` is used.

The keyword argument `evals` is a real or complex vector, which contains a set
of finite desired eigenvalues for the factors.
For a system with real data, `evals` must be a self-conjugated complex set
to ensure that the resulting factors are also real.

If `mindeg = false`, both factors `sysn` and `sysm` have descriptor realizations
with the same order and with `An = Am`, `En = Em` and `Bn = Bm`. If `mindeg = true`,
the realization of `sysm` is minimal. The number of (finite) poles of `sysm` is
equal to the number of unstable finite poles of `sys`.

If `mininf = false`, then `An-λEn` and `Am-λEm` may have simple infinite eigenvalues.
If `mininf = true`,  then `An-λEn` and `Am-λEm` have no simple infinite eigenvalues.
Note that the removing of simple infinite eigenvalues involves matrix inversions.

The keyword arguments `atol1`, `atol2`, `atol3`, and `rtol`, specify, respectively,
the absolute tolerance for the nonzero elements of `A`,
the absolute tolerance for the nonzero elements of `E`,
the absolute tolerance for the nonzero elements of `B`,
and the relative tolerance for the nonzero elements of `A`, `E` and `B`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the machine epsilon of the element type of `A`
and `n` is the order of the system `sys`.
The keyword argument `atol` can be used
to simultaneously set `atol1 = atol`, `atol2 = atol`, `atol3 = atol`.

The preliminary separation of finite and infinite eigenvalues of `A-λE` is performed
using rank decisions based on rank revealing QR-decompositions with column pivoting
if `fast = true` or the more reliable SVD-decompositions if `fast = false`.

_Method:_  The Procedure GRCF from [2] is implemented, which represents
an extension of the recursive factorization approach of [1] to cope with
infinite eigenvalues. All infinite poles are assigned to finite real values.
If `evals` is missing or does not contain a sufficient
 number of real values, then a part or all of infinite eigenvalues of `A-λE` are
 assigned to the value specified by `sdeg`. The pairs `(An,En)` and `(Am,Em)`
 result in _generalized Schur form_ with both `An` and `Am` quasi-upper triangular
 and `En` and `Em` either both upper triangular or both UniformScalings.

_References:_

[1] A. Varga. Computation of coprime factorizations of rational matrices.
    Linear Algebra and Its Applications, vol. 271, pp.88-115, 1998.

[2] A. Varga. On recursive computation of coprime factorizations of rational matrices.
    arXiv:1703.07307, https://arxiv.org/abs/1703.07307, 2020. (to appear in Linear Algebra and Its Applications)
"""
function grcf(sys::DescriptorStateSpace{T};
              evals::Union{AbstractVector,Missing} = missing, sdeg::Union{Real,Missing} = missing, smarg::Union{Real,Missing} = missing,
              atol::Real = zero(real(T)), atol1::Real = atol, atol2::Real = atol, atol3::Real = atol,
              rtol::Real = sys.nx*eps(real(float(one(T))))*iszero(max(atol1,atol2,atol3)),
              fast::Bool = true, mindeg::Bool = false, mininf::Bool = false) where T

   T1 = T <: BlasFloat ? T : promote_type(Float64,T)
   disc = !iszero(sys.Ts)
   missingsmarg = ismissing(smarg)
   if missingsmarg
      offset = sqrt(eps(real(T1)));
      smarg = disc ?  1-offset : -offset
   else
      disc && (smarg < 0 || smarg >= 1) && error("smarg must be non-negative and subunitary for a discrete system")
      !disc && smarg >= 0 && error("smarg must be negative for a continuous system")
   end

   if ismissing(evals)
      evals1 = missing
   else
      evals1 = copy_oftype(evals,promote_type(T1,eltype(evals)))
   end

   # set default values of sdeg if evals = missing
   if ismissing(sdeg)
      if missingsmarg
         sdeg = disc ? real(T1)(0.95) : real(T1)(-0.05)
      else
         sdeg = smarg
      end
   else
      sdeg = real(T1)(sdeg)
      sdeg <= smarg || error("sdeg must be must be at most $smarg")
   end

   At, Et, Bt, CN, DN = dssdata(T1,sys)
   n, m = size(Bt)
   standsys = (Et == I)

   # quick exit for n = 0 or B = 0
   DM = Matrix{T1}(I,m,m)

   n == 0 && (return sys, dss(DM,Ts = sys.Ts))

   ZERO = zero(T1)
   ZEROR = zero(real(T1))
   ONE = one(T1)

   #  # check for zero rows in the leading positions
   #  ilob = n+1
   #  for i = 1:n
   #      !iszero(view(Bt,i,:)) && (ilob = i; break)
   #  end

   #  # return if B = 0
   #  ilob > n && (return sys, dss(DM,Ts = sys.Ts) )

   #  # check for zero rows in the trailing positions
   #  ihib = ilob
   #  for i = n:-1:ilob+1
   #      !iszero(view(Bt,i,:)) && (ihib = i; break)
   #  end

   #  # operate only on the nonzero rows of B
   #  ib = ilob:ihib
   #  nrmB = opnorm(view(Bt,ib,:),1)

   nrmB = opnorm(Bt,1)
   # return if B = 0
   iszero(nrmB) && (return gsvselect(sys,Int[]), dss(DM,Ts = sys.Ts) )

   complx = (T1 <: Complex)

   # sort desired eigenvalues
   if ismissing(evals1)
      evalsr = missing
      evalsc = missing
   else
      if complx
         evalsr = copy(evals1)
         evalsc = missing
      else
         evalsr = evals1[imag.(evals1) .== 0]
         isempty(evalsr) && (evalsr = missing)
         tempc = evals1[imag.(evals1) .> 0]
         if isempty(tempc)
            evalsc = missing
         else
            tempc1 = conj(evals1[imag.(evals1) .< 0])
            isequal(tempc[sortperm(real(tempc))],tempc1[sortperm(real(tempc1))]) ||
                    error("evals must be a self-conjugated complex vector")
            evalsc = [transpose(tempc[:]); transpose(conj.(tempc[:]))][:]
         end
      end
      # check that all eigenvalues are inside of the stability region
      !ismissing(sdeg) && ((disc && any(abs.(evals1) .> sdeg) )  || (!disc && any(real.(evals1) .> sdeg)))  &&
            error("The elements of evals must lie in the stability region")
   end

   nrmA = opnorm(At,1)
   tola = max(atol1, rtol*nrmA)
   tolb = max(atol3, rtol*nrmB)

   if standsys
      #
      # separate stable and unstable parts with respect to sdeg
      # compute orthogonal Z  such that
      #
      #      Z^T*A*Z = [ Ag   * ]
      #                [  0  Ab ]
      #
      # where Ag has eigenvalues within the stability degree region
      # and Ab has eigenvalues outside the stability degree region.

      _, Z, α = LAPACK.gees!('V', At)

      if disc
         select = Int.(abs.(α) .<= smarg)
      else
         select = Int.(real.(α) .<= smarg)
      end
      nsinf = 0; nb = length(select[select .== 0]); ng = n-nb; nb = n-ng; nbi = 0;
      nb == 0 && (Bt = Z'*Bt; return dss(At,I,Bt,CN*Z,DN,Ts=sys.Ts), mindeg ? dss(DM,Ts = sys.Ts) : dss(At,I,Bt,zeros(T1,m,n),DM,Ts=sys.Ts)  )

       _, _, α = LAPACK.trsen!(select, At, Z)
       Bt = Z'*Bt; CN = CN*Z
   else
      # reduce the pair (A,E) to the specially ordered generalized real Schur
      # form (At,Et) = (Q'*A*Z,Q'*E*Z), with
      #
      #             [ Ai  *   *   *  ]          [ 0  *    *   *  ]
      #        At = [  0  Ag  *   *  ]  ,  Et = [ 0  Eg   *   *  ] ,
      #             [  0  0  Abf  *  ]          [ 0  0   Ebf  *  ]
      #             [  0  0   0  Abi ]          [ 0  0    0  Ebi ]
      #
      # where
      #    (Ai,0)    contains the firt order inifinite eigenvalues
      #    (Ag,Eg)   contains the "good" finite eigenvalues
      #    (Abf,Ebf) contains the "bad" finite eigenvalues
      #    (Abi,Ebi) contains the "bad" (higher order) infinite eigenvalues

      At, Et, Q, Z, _, (nsinf, ng, nbf, nbi) = sfischursep(At, Et, smarg = smarg, disc = disc,
                                                          fast = fast, finite_infinite = true, stable_unstable = true,
                                                          atol1 = atol1, atol2 = atol2, rtol = rtol, withQ = true, withZ = true);
      # finish if SYS is stable and Et is invertible or
      # SYS is stable and simple infinite eigenvalues have not to be removed
      Bt = Q'*Bt; CN = CN*Z;
      (nbf+nsinf == 0 || (nbf+nbi == 0 && !mininf)) && (return dss(At,Et,Bt,CN,DN,Ts=sys.Ts), mindeg ? dss(DM,Ts = sys.Ts) : dss(At,Et,Bt,zeros(T1,m,n),DM,Ts=sys.Ts) )
      nb = nbf+nbi
   end
   #return dss(At,Et,Bt,CN,DN,Ts=sys.Ts), dss(DM,Ts = sys.Ts)
   # initialization of the recursive factorization CN, DN and DM already initialized
   CM = zeros(T1,m,n);
   fnrmtol = 10000*max(1,nrmA)/nrmB;  # set threshold for high feedback
   fwarn = 0;
   while nb > 0
      if nbi > 0 || nb == 1 || complx || At[n,n-1] == 0
         k = 1
      else
         k = 2
      end
      kk = n-k+1:n;
      if standsys
         evb = ordeigvals(view(At,kk,kk));
      else
         evb = ordeigvals(view(At,kk,kk),view(Et,kk,kk))[1]
      end
      if norm(view(Bt,kk,:)) <= tolb
         nb -= k; n -= k;
         nbi > 0 && (nbi -= 1)
      else
         a2 = At[kk,kk]; b2 = Bt[kk,:];
         e2 = standsys ? Matrix{T1}(I,k,k) : Et[kk,kk]
         if !standsys && k == 1 && nbi > 0
            # move infinite eigenvalue to a stable (finite) position
            γ, evalsr = eigselect1(evalsr, sdeg, sdeg, disc; cflag = complx);
            γ === nothing && (γ = sdeg)
            F = qr(b2')
            q2 = Matrix(F.Q)
            f2 = -(q2/F.R)*a2; W =  I-q2*q2';
            # update matrices
            i1 = 1:n-1;
            mul!(view(At,i1,kk),view(Bt,i1,:),f2,ONE,ONE); At[n,n] = γ; Et[n,n] = ONE;
            mul!(view(CN,:,kk),DN,f2,ONE,ONE)
            mul!(view(CM,:,kk),DM,f2,ONE,ONE)
            Bt[i1,:] = view(Bt,i1,:)*W; DN = DN*W; DM = DM*W;
            i2 = n-nb+1:n; i1 = 1:n-nb;
            if nb > 1
               Q3 = Matrix{T1}(I,nb,nb); Z3 = Matrix{T1}(I,nb,nb)
               MatrixPencils.tgexc!(true, true, nb, 1, view(At,i2,i2), view(Et,i2,i2), Q3, Z3)
               At[i1,i2] = view(At,i1,i2)*Z3; Et[i1,i2] = view(Et,i1,i2)*Z3;
               Bt[i2,:] = Q3'*view(Bt,i2,:);
               CN[:,i2] = view(CN,:,i2)*Z3; CM[:,i2] = view(CM,:,i2)*Z3;
            end
            nb -= 1; nbi -= 1;
         else
            if k == 1
               if !(nb > 1 && ismissing(evalsr) && !ismissing(evalsc))
                   # assign a single eigenvalue
                   γ, evalsr = eigselect1(evalsr, sdeg, complx ? evb[1] : real(evb[1]), disc; cflag = complx);
               else
                  γ = nothing
               end
               if γ === nothing
                  # no real pole available, adjoin a new 1x1 block if possible
                  if nb == 1
                     # incompatible poles with the eigenvalue structure
                     # assign the last real pole to SDEG (if possible)
                     # warning(['No real eigenvalue available for assignment: assigning instead SDEG = ', num2str(sdeg)])
                     f2 = -b2\(a2-e2*sdeg);
                  else
                     # adjoin a real block or interchange the last two blocks
                     k = 2; kk = n-k+1:n;
                     if n == 2 || iszero(At[n-1,n-2])
                        # adjoin blocks and update evb
                        if standsys
                           evb = ordeigvals(view(At,kk,kk));
                        else
                           evb = ordeigvals(view(At,kk,kk),view(Et,kk,kk))[1];
                        end
                     else
                        # interchange last two blocks
                        i1 = 1:n-3; i2 = n-2:n; i3 = n-1:n
                        if standsys
                           Z3 = Matrix{T1}(I,3,3)
                           ac = view(At,i3,i3)
                           if nb > 2 && At[n-1,n-2] != ZERO
                              # interchange last two blocks
                              LAPACK.trexc!('V', 3, 1, view(At,i2,i2), Z3)
                              evb = ordeigvals(ac)
                           else
                              evb = disc ? maximum(abs.(ordeigvals(ac))) : maximum(real(ordeigvals(ac)))
                           end
                           At[i1,i2] = view(At,i1,i2)*Z3; Bt[i2,:] = Z3'*view(Bt,i2,:);
                           CN[:,i2] = view(CN,:,i2)*Z3; CM[:,i2] = view(CM,:,i2)*Z3;
                        else
                           Q3 = Matrix{T1}(I,3,3); Z3 = Matrix{T1}(I,3,3)
                           ac = view(At,i3,i3); ec = view(Et,i3,i3);
                           if nb > 2 && At[n-1,n-2] != ZERO
                              # interchange last two blocks
                              MatrixPencils.tgexc!(true, true, 3, 1, view(At,i2,i2), view(Et,i2,i2), Q3, Z3)
                              evb = ordeigvals(ac,ec)[1]
                           else
                              evb = disc ? maximum(abs.(ordeigvals(ac,ec)[1])) : maximum(real(ordeigvals(ac,ec)[1]))
                           end
                           At[i1,i2] = view(At,i1,i2)*Z3; Et[i1,i2] = view(Et,i1,i2)*Z3;
                           Bt[i2,:] = Q3'*view(Bt,i2,:);
                           CN[:,i2] = view(CN,:,i2)*Z3; CM[:,i2] = view(CM,:,i2)*Z3;
                        end
                     end
                     a2 = At[kk,kk]; b2 = Bt[kk,:];
                     e2 = standsys ? Matrix{T1}(I,k,k) : Et[kk,kk]
                  end
               else
                  f2 = -b2\(a2-e2*γ);
               end
            end
            if k == 2
               # assign a pair of eigenvalues
               γ, evalsr, evalsc = eigselect2(evalsr,evalsc,sdeg,evb[end],disc)
               f2, u, v = saloc2(a2,e2,b2,γ,tola,tolb)
               if f2 === nothing  # the case b2 = 0 can not occur
                  i1 = 1:n;
                  At[kk,kk] = u'*view(At,kk,kk); At[i1,kk] = view(At,i1,kk)*v;
                  At[n,n-1] = ZERO
                  if !standsys
                     Et[kk,kk] = u'*view(Et,kk,kk); Et[i1,kk] = view(Et,i1,kk)*v;
                     Et[n,n-1] = ZERO
                  end
                  nb -= 1; n -= 1;
                  # recover the failed selection
                  imag(γ[1]) == 0 ? (ismissing(evalsr) ? evalsr = γ : evalsr = [γ; evalsr]) : (ismissing(evalsc) ? evalsc = γ : evalsc = [γ; evalsc])
                  Bt[kk,:] = u'*view(Bt,kk,:);
                  CN[:,kk] = view(CN,:,kk)*v; CM[:,kk] = view(CM,:,kk)*v;
               end
            end
            if f2 !== nothing
               norm(f2,Inf) > fnrmtol && (fwarn += 1)
               i1 = 1:n
               mul!(view(At,i1,kk),view(Bt,i1,:),f2,ONE,ONE)
               mul!(view(CN,:,kk),DN,f2,ONE,ONE)
               mul!(view(CM,:,kk),DM,f2,ONE,ONE)
               select = [zeros(Int,nb-k); ones(Int,k)];
               i2 = n-nb+1:n; i1 = 1:n-nb;
               if standsys
                  if k == 2
                     # standardization step is necessary to use trsen
                     k1 = kk[1]; k2 = kk[2]
                     RT1R, RT1I, RT2R, RT2I, CS, SN = lanv2(At[k1,k1], At[k1,k2], At[k2,k1], At[k2,k2])
                     Z2 = LinearAlgebra.Givens(1, 2, CS, -SN)
                     rmul!(view(At,1:n,kk),Z2)
                     lmul!(Z2',view(At,kk,kk));
                     At[k1,k1] = RT1R; At[k2,k2] = RT2R;
                     rmul!(view(CN,:,kk),Z2)
                     rmul!(view(CM,:,kk),Z2)
                     lmul!(Z2',view(Bt,kk,:))
                     tworeals = iszero(At[n,n-1])
                  else
                     tworeals = false
                  end
                  # reorder eigenvalues
                  if nb > k
                     Z3 = Matrix{T1}(I,nb,nb)
                     LAPACK.trexc!('V', nb-k+1, 1, view(At,i2,i2), Z3)
                     tworeals && LAPACK.trexc!('V', nb, 2, view(At,i2,i2), Z3)
                     At[i1,i2] = view(At,i1,i2)*Z3; Bt[i2,:] = Z3'*view(Bt,i2,:);
                     CN[:,i2] = view(CN,:,i2)*Z3; CM[:,i2] = view(CM,:,i2)*Z3;
                  end
               else
                  if k == 2
                     # standardization step is necessary to use tgsen
                     it = 1:n-2;
                     _, _, _, _, Q2, Z2 = LAPACK.gges!('V','V',view(At,kk,kk),view(Et,kk,kk))
                     At[it,kk] = view(At,it,kk)*Z2
                     Et[it,kk] = view(Et,it,kk)*Z2
                     Bt[kk,:] = Q2'*view(Bt,kk,:)
                     CN[:,kk] = view(CN,:,kk)*Z2; CM[:,kk] = view(CM,:,kk)*Z2;
                     tworeals = iszero(At[n,n-1])
                  else
                     tworeals = false
                  end
                  if nb > k
                     Q3 = Matrix{T1}(I,nb,nb); Z3 = Matrix{T1}(I,nb,nb)
                     MatrixPencils.tgexc!(true, true, nb-k+1, 1, view(At,i2,i2), view(Et,i2,i2), Q3, Z3)
                     tworeals && MatrixPencils.tgexc!(true, true, nb, ia+1, view(At,i2,i2), view(Et,i2,i2), Q3, Z3)
                     At[i1,i2] = view(At,i1,i2)*Z3; Et[i1,i2] = view(Et,i1,i2)*Z3;
                     Bt[i2,:] = Q3'*view(Bt,i2,:);
                     CN[:,i2] = view(CN,:,i2)*Z3; CM[:,i2] = view(CM,:,i2)*Z3;
                  end
               end
               nb -= k;
            end
         end
      end
   end

   if mininf && nsinf > 0
      # remove the simple infinite eigenvalues
      i1 = 1:nsinf; i2 = nsinf+1:n;
      ca = view(CN,:,i1)/view(At,i1,i1); ee = view(Et,i1,i2)/view(Et,i2,i2);
      DN = DN-ca*Bt[i1,:]+ca*ee*Bt[i2,:];
      CN = CN[:,i2]-ca*At[i1,i2]+ca*ee*At[i2,i2]; CM = CM[:,i2];
      At = At[i2,i2]; Et = Et[i2,i2]; Bt = Bt[i2,:];
      n = n-nsinf;
   end

   if standsys
      i1 = 1:n
      sysn = dss(At[i1,i1],I,Bt[i1,:],CN[:,i1],DN,Ts=sys.Ts);
      mindeg && (i1 = ng+1:n)
      sysm = dss(At[i1,i1],I,Bt[i1,:],CM[:,i1],DM,Ts=sys.Ts);
   else
      i1 = 1:n
      sysn = dss(At[i1,i1],Et[i1,i1],Bt[i1,:],CN[:,i1],DN,Ts=sys.Ts);
      mindeg && (i1 = ng+1:n)
      sysm = dss(At[i1,i1],Et[i1,i1],Bt[i1,:],CM[:,i1],DM,Ts=sys.Ts);
   end

   fwarn > 0 && @warn("Possible loss of numerical reliability due to high feedback gain")
   return sysn, sysm

# end GRCF
end
"""
    glcfid(sys; mindeg = false, mininf = false, fast = true, offset = sqrt(ϵ),
           atol = 0, atol1 = atol, atol2 = atol, atol3 = atol, rtol = n*ϵ) -> (sysni, sysmi)

Compute for the descriptor system `sys = (A-λE,B,C,D)`, the factors
`sysni = (Ani-λEni,Bni,Cni,Dni)` and `sysmi = (Ami-λEmi,Bmi,Cmi,Dmi)` of its
left coprime factorization with inner denominator. If `sys`, `sysni` and `sysmi`
have the transfer function matrices `G(λ)`, `N(λ)` and `M(λ)`, respectively, then
`G(λ) = inv(M(λ))*N(λ)`, with `N(λ)` and `M(λ)` proper and stable transfer
function matrices and the denominator factor `M(λ)` inner.
The resulting matrix pairs `(Ani,Eni)` and `(Ami,Emi)` are in Schur forms.
The system `sys` must not have poles on the boundary of the stability domain `Cs`.
In terms of eigenvalues, this requires for a continuous-time system, that
`A-λE` must not have controllable eigenvalues on the imaginary axis
(excepting simple infinite eigenvalues), while for a discrete-time system,
`A-λE` must not have controllable eigenvalues on the unit circle centered
in the origin.

To assess the presence of poles on the boundary of `Cs`, a boundary offset  `β`
can be specified via the keyword parameter `offset = β`.
Accordingly, for a continuous-time system,
the boundary of `Cs` contains the complex numbers with real parts within the interval `[-β,β]`,
while for a discrete-time system, then the boundary of `Cs` contains
the complex numbers with moduli within the interval `[1-β,1+β]`.
The default value used for `β` is `sqrt(ϵ)`, where `ϵ` is the working machine precision.

If `mindeg = false`, both factors `sysni` and `sysmi` have descriptor realizations
with the same order and with `Ani = Ami`, `Eni = Emi` and `Cni = Cmi`. If `mindeg = true`,
the realization of `sysmi` is minimal. The number of (finite) poles of `sysmi` is
equal to the number of unstable finite poles of `sys`.

If `mininf = false`, then `Ani-λEni` and `Ami-λEmi` may have simple infinite eigenvalues.
If `mininf = true`,  then `Ani-λEni` and `Ami-λEmi` have no simple infinite eigenvalues.
Note that the removing of simple infinite eigenvalues involves matrix inversions.

The keyword arguments `atol1`, `atol2`, `atol3`, and `rtol`, specify, respectively,
the absolute tolerance for the nonzero elements of `A`,
the absolute tolerance for the nonzero elements of `E`,
the absolute tolerance for the nonzero elements of `C`,
and the relative tolerance for the nonzero elements of `A`, `E` and `C`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the working machine epsilon.
The keyword argument `atol` can be used
to simultaneously set `atol1 = atol`, `atol2 = atol`, `atol3 = atol`.

The preliminary separation of finite and infinite eigenvalues of `A-λE`is performed
using rank decisions based on rank revealing QR-decompositions with column pivoting
if `fast = true` or the more reliable SVD-decompositions if `fast = false`.

_Method:_ An extension of the recursive factorization approach of [1] is used
to the dual system (see [2] for details). The pairs `(Ani,Eni)` and `(Ami,Emi)`
result in _generalized Schur form_ with both `Ani` and `Ami` quasi-upper triangular
and `Eni` and `Emi` either both upper triangular or both UniformScalings.

_References:_

[1] A. Varga. Computation of coprime factorizations of rational matrices.
    Linear Algebra and Its Applications, vol. 271, pp.88-115, 1998.

[2] A. Varga. On recursive computation of coprime factorizations of rational matrices.
    arXiv:1703.07307, https://arxiv.org/abs/1703.07307, 2020. (to appear in Linear Algebra and Its Applications)
"""
function glcfid(sys::DescriptorStateSpace; kwargs...)
   sysn, sysm = grcfid(gdual(sys,rev = true); kwargs...)
   return gdual(sysn,rev = true), gdual(sysm,rev = true)
end
"""
    grcfid(sys; mindeg = false, mininf = false, fast = true, offset = sqrt(ϵ),
           atol = 0, atol1 = atol, atol2 = atol, atol3 = atol, rtol = n*ϵ) -> (sysni, sysmi)

Compute for the descriptor system `sys = (A-λE,B,C,D)`, the factors
`sysni = (Ani-λEni,Bni,Cni,Dni)` and `sysmi = (Ami-λEmi,Bmi,Cmi,Dmi)` of its
right coprime factorization with inner denominator. If `sys`, `sysni` and `sysmi`
have the transfer function matrices `G(λ)`, `N(λ)` and `M(λ)`, respectively, then
`G(λ) = N(λ)*inv(M(λ))`, with `N(λ)` and `M(λ)` proper and stable transfer
function matrices and the denominator factor `M(λ)` inner.
The resulting matrix pairs `(Ani,Eni)` and `(Ami,Emi)` are in (generalized) Schur form.
The system `sys` must not have poles on the boundary of the stability domain `Cs`.
In terms of eigenvalues, this requires for a continuous-time system, that
`A-λE` must not have controllable eigenvalues on the imaginary axis
(excepting simple infinite eigenvalues), while for a discrete-time system,
`A-λE` must not have controllable eigenvalues on the unit circle centered
in the origin.

To assess the presence of poles on the boundary of `Cs`, a boundary offset  `β`
can be specified via the keyword parameter `offset = β`.
Accordingly, for a continuous-time system,
the boundary of `Cs` contains the complex numbers with real parts within the interval `[-β,β]`,
while for a discrete-time system, then the boundary of `Cs` contains
the complex numbers with moduli within the interval `[1-β,1+β]`.
The default value used for `β` is `sqrt(ϵ)`, where `ϵ` is the working machine precision.

If `mindeg = false`, both factors `sysni` and `sysmi` have descriptor realizations
with the same order and with `Ani = Ami`, `Eni = Emi` and `Bni = Bmi`. If `mindeg = true`,
the realization of `sysmi` is minimal. The number of (finite) poles of `sysmi` is
equal to the number of unstable finite poles of `sys`.

If `mininf = false`, then `Ani-λEni` and `Ami-λEmi` may have simple infinite eigenvalues.
If `mininf = true`,  then `Ani-λEni` and `Ami-λEmi` have no simple infinite eigenvalues.
Note that the removing of simple infinite eigenvalues involves matrix inversions.

The keyword arguments `atol1`, `atol2`, `atol3`, and `rtol`, specify, respectively,
the absolute tolerance for the nonzero elements of `A`,
the absolute tolerance for the nonzero elements of `E`,
the absolute tolerance for the nonzero elements of `B`,
and the relative tolerance for the nonzero elements of `A`, `E` and `B`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the working machine epsilon.
The keyword argument `atol` can be used
to simultaneously set `atol1 = atol`, `atol2 = atol`, `atol3 = atol`.

The preliminary separation of finite and infinite eigenvalues of `A-λE`is performed
using rank decisions based on rank revealing QR-decompositions with column pivoting
if `fast = true` or the more reliable SVD-decompositions if `fast = false`.

_Method:_ An extension of the recursive factorization approach of [1]
is used (see [2] for details). The pairs `(Ani,Eni)` and `(Ami,Emi)`
result in _generalized Schur form_ with both `Ani` and `Ami` quasi-upper triangular
and `Eni` and `Emi` either both upper triangular or both UniformScalings.

_References:_

[1] A. Varga. Computation of coprime factorizations of rational matrices.
    Linear Algebra and Its Applications, vol. 271, pp.88-115, 1998.

[2] A. Varga. On recursive computation of coprime factorizations of rational matrices.
    arXiv:1703.07307, https://arxiv.org/abs/1703.07307, 2020. (to appear in Linear Algebra and Its Applications)
"""
function grcfid(sys::DescriptorStateSpace{T}; offset::Real = sqrt(eps(float(real(T)))),
             atol::Real = zero(real(T)), atol1::Real = atol, atol2::Real = atol, atol3::Real = atol,
             rtol::Real = sys.nx*eps(real(float(one(T))))*iszero(max(atol1,atol2,atol3)),
             fast::Bool = true, mindeg::Bool = false, mininf::Bool = false) where T

   T1 = T <: BlasFloat ? T : promote_type(Float64,T)
   disc = !iszero(sys.Ts)

   smarg = disc ?  1-offset : -offset

   At, Et, Bt, CN, DN = dssdata(T1,sys)
   n, m = size(Bt)
   standsys = (Et == I)

   # quick exit for n = 0 or B = 0
   DM = Matrix{T1}(I,m,m)
   n == 0 && (return sys, dss(DM,Ts = sys.Ts) )

   ZERO = zero(T1)
   ZEROR = zero(real(T1))
   ONE = one(T1)

   #  # check for zero rows in the leading positions
   #  ilob = n+1
   #  for i = 1:n
   #      !iszero(view(Bt,i,:)) && (ilob = i; break)
   #  end

   #  # return if B = 0
   #  ilob > n && (return sys, dss(DM,Ts = sys.Ts) )

   #  # check for zero rows in the trailing positions
   #  ihib = ilob
   #  for i = n:-1:ilob+1
   #      !iszero(view(Bt,i,:)) && (ihib = i; break)
   #  end

   #  # operate only on the nonzero rows of B
   #  ib = ilob:ihib
   #  nrmB = opnorm(view(Bt,ib,:),1)

   nrmB = opnorm(Bt,1)
   # return if B = 0
   iszero(nrmB) && (return gsvselect(sys,Int[]), dss(DM,Ts = sys.Ts) )

   complx = (T1 <: Complex)

   nrmA = opnorm(At,1)
   tola = max(atol1, rtol*nrmA)
   tolb = max(atol3, rtol*nrmB)

   if standsys
      #
      # separate stable and unstable parts with respect to sdeg
      # compute orthogonal Z  such that
      #
      #      Z^T*A*Z = [ Ag   * ]
      #                [  0  Ab ]
      #
      # where Ag has eigenvalues within the stability degree region
      # and Ab has eigenvalues outside the stability degree region.
      _, Z, α = LAPACK.gees!('V', At)
      if disc
         select = Int.(abs.(α) .<= smarg)
      else
         select = Int.(real.(α) .<= smarg)
      end
      nsinf = 0; nb = length(select[select .== 0]); ng = n-nb; nb = n-ng; nbi = 0;
      nb == 0 && (Bt = Z'*Bt; return dss(At,I,Bt,CN*Z,DN,Ts=sys.Ts), mindeg ? dss(DM,Ts = sys.Ts) : dss(At,I,Bt,zeros(T1,m,n),DM,Ts=sys.Ts)  )

       _, _, α = LAPACK.trsen!(select, At, Z)
       Bt = Z'*Bt; CN = CN*Z
    else
      # reduce the pair (A,E) to the specially ordered generalized real Schur
      # form (At,Et) = (Q'*A*Z,Q'*E*Z), with
      #
      #             [ Ai  *   *   *  ]          [ 0  *    *   *  ]
      #        At = [  0  Ag  *   *  ]  ,  Et = [ 0  Eg   *   *  ] ,
      #             [  0  0  Abf  *  ]          [ 0  0   Ebf  *  ]
      #             [  0  0   0  Abi ]          [ 0  0    0  Ebi ]
      #
      # where
      #    (Ai,0)    contains the firt order inifinite eigenvalues
      #    (Ag,Eg)   contains the "good" finite eigenvalues
      #    (Abf,Ebf) contains the "bad" finite eigenvalues
      #    (Abi,Ebi) contains the "bad" (higher order) infinite eigenvalues

      At, Et, Q, Z, _, (nsinf, ng, nbf, nbi) = sfischursep(At, Et, smarg = smarg, disc = disc,
                                                          fast = fast, finite_infinite = true, stable_unstable = true,
                                                          atol1 = atol1, atol2 = atol2, rtol = rtol, withQ = true, withZ = true);
      #!discr && nbi > 0 && error("The continuous-time system SYS is improper")
      # finish if SYS is stable and Et is invertible or
      # SYS is stable and simple infinite eigenvalues have not to be removed
      Bt = Q'*Bt; CN = CN*Z;
      (nbf+nsinf == 0 || (nbf+nbi == 0 && !mininf)) && (return dss(At,Et,Bt,CN,DN,Ts=sys.Ts), mindeg ? dss(DM,Ts = sys.Ts) : dss(At,Et,Bt,zeros(T1,m,n),DM,Ts=sys.Ts) )
      nb = nbf+nbi
   end

   # initialization of the recursive factorization CN, DN and DM already initialized
   CM = zeros(T1,m,n);
   fnrmtol = 10000*max(1,nrmA)/nrmB;  # set threshold for high feedback
   fwarn = 0;
   while nb > 0
      if nbi > 0 || nb == 1 || complx || At[n,n-1] == 0
         k = 1
      else
         k = 2
      end
      kk = n-k+1:n;
      if standsys
         evb = ordeigvals(view(At,kk,kk));
      else
         evb = ordeigvals(view(At,kk,kk),view(Et,kk,kk))[1]
      end
      if norm(view(Bt,kk,:)) <= tolb
         nb -= k; n -= k;
         nbi > 0 && (nbi -= 1)
      else
         a2 = At[kk,kk]; b2 = Bt[kk,:];
         e2 = standsys ? Matrix{T1}(I,k,k) : Et[kk,kk]
         if !standsys && k == 1 && nbi > 0
            !disc && error("The continuous-time system SYS is improper")
            # reflect infinite eigenvalue to the origin
            F = qr(b2')
            q2 = Matrix(F.Q)
            f2 = -(q2/F.R)*a2; W =  I-q2*q2';
            # update matrices
            i1 = 1:n-1;
            mul!(view(At,i1,kk),view(Bt,i1,:),f2,ONE,ONE); At[n,n] = ZERO;
            Bt[i1,:] = view(Bt,i1,:)*W;
            if complx
               en = -a2[1,1]
               (iszero(imag(en)) && real(en) > ZEROR) ? Et[n,n] = en :
                  (tmp = conj(en)/abs(en); Et[n,n] = tmp*en; [@inbounds Bt[n,j] *= tmp for j = 1:m])
            else
               a2[1,1] > 0 ? (Et[n,n] = a2[1,1]; Bt[n,:] = -Bt[n,:]) : Et[n,n] = -a2[1,1]
            end
            mul!(view(CN,:,kk),DN,f2,ONE,ONE)
            mul!(view(CM,:,kk),DM,f2,ONE,ONE)
            DN = DN*W; DM = DM*W;
            i2 = n-nb+1:n; i1 = 1:n-nb;
            if nb > 1
               Q3 = Matrix{T1}(I,nb,nb); Z3 = Matrix{T1}(I,nb,nb)
               MatrixPencils.tgexc!(true, true, nb, 1, view(At,i2,i2), view(Et,i2,i2), Q3, Z3)
               At[i1,i2] = view(At,i1,i2)*Z3; Et[i1,i2] = view(Et,i1,i2)*Z3;
               Bt[i2,:] = Q3'*view(Bt,i2,:);
               CN[:,i2] = view(CN,:,i2)*Z3; CM[:,i2] = view(CM,:,i2)*Z3;
            end
            nb -= 1; nbi -= 1;
         else
            if disc
               abs(abs(evb[1])-1) < offset && error("Eigenvalue(s) on the unit circle present")
            else
               abs(real(evb[1])) < offset && error("Eigenvalue(s) on the imaginary axis present")
            end
            if disc
               # solve a2*y*a2'-e2*y*e2'-b2*b2' = 0 for y=S*S'
               S = plyapas2!(a2,e2,copy(b2),disc = true)
               y = S*S'
               f2 = -(S'\(S\(a2\b2)))' # f2 = -b2.'/(y*a2.');
               # update At <- At + Bt*[0 f2]
               mul!(view(At,kk,kk),view(Bt,kk,:),f2,ONE,ONE)
               x = transpose((e2*S)\b2);
               W = inv(UpperTriangular(qrupdate!(Matrix{T1}(I,m,m),x)))
            else
               # solve a2*y*e2'+e2*y*a2'-b2*b2' = 0 for y=S*S'
               S = plyapas2!(a2, e2, copy(b2), disc = false)
               y = S*S'
               f2 = -(S'\(S\(e2\b2)))'; # f2 = -b2.'/(y*e2.');
               mul!(view(At,kk,kk),view(Bt,kk,:),f2,ONE,ONE)
            end
            norm(f2,Inf) > fnrmtol && (fwarn += 1)
            # update the rest of (sub)matrices
            i1 = 1:n-k
            mul!(view(At,i1,kk),view(Bt,i1,:),f2,ONE,ONE)
            mul!(view(CN,:,kk),DN,f2,ONE,ONE)
            mul!(view(CM,:,kk),DM,f2,ONE,ONE)
            # update DN, DM and Bt: exploit W upper triangular
            disc && (rmul!(DN,W); rmul!(DM,W); rmul!(view(Bt,1:n,:),W))
            i2 = n-nb+1:n; i1 = 1:n-nb;
            if standsys
               if k == 2
                  # standardization step is necessary to use trsen
                  k1 = kk[1]; k2 = kk[2]
                  RT1R, RT1I, RT2R, RT2I, CS, SN = lanv2(At[k1,k1], At[k1,k2], At[k2,k1], At[k2,k2])
                  Z2 = LinearAlgebra.Givens(1, 2, CS, -SN)
                  rmul!(view(At,1:n,kk),Z2)
                  lmul!(Z2',view(At,kk,kk));
                  At[k1,k1] = RT1R; At[k2,k2] = RT2R;
                  rmul!(view(CN,:,kk),Z2)
                  rmul!(view(CM,:,kk),Z2)
                  lmul!(Z2',view(Bt,kk,:))
               end
               if nb > k
                  Z3 = view(Z,i2,i2)
                  Z3 = Matrix{T1}(I,nb,nb)
                  LAPACK.trexc!('V', nb-k+1, 1, view(At,i2,i2), Z3)
                  At[i1,i2] = view(At,i1,i2)*Z3; Bt[i2,:] = Z3'*view(Bt,i2,:);
                  CN[:,i2] = view(CN,:,i2)*Z3; CM[:,i2] = view(CM,:,i2)*Z3;
               end
            else
               if nb > k
                  Q3 = view(Q,i2,i2); Z3 = view(Z,i2,i2)
                  Q3 = Matrix{T1}(I,nb,nb); Z3 = Matrix{T1}(I,nb,nb)
                  MatrixPencils.tgexc!(true, true, nb-k+1, 1, view(At,i2,i2), view(Et,i2,i2), Q3, Z3)
                  At[i1,i2] = view(At,i1,i2)*Z3; Et[i1,i2] = view(Et,i1,i2)*Z3;
                  Bt[i2,:] = Q3'*view(Bt,i2,:);
                  CN[:,i2] = view(CN,:,i2)*Z3; CM[:,i2] = view(CM,:,i2)*Z3;
               end
            end
            nb -= k
         end
      end
   end

   if mininf && nsinf > 0
      # remove the simple infinite eigenvalues
      i1 = 1:nsinf; i2 = nsinf+1:n;
      ca = view(CN,:,i1)/view(At,i1,i1); ee = view(Et,i1,i2)/view(Et,i2,i2);
      DN = DN-ca*Bt[i1,:]+ca*ee*Bt[i2,:];
      CN = CN[:,i2]-ca*At[i1,i2]+ca*ee*At[i2,i2]; CM = CM[:,i2];
      At = At[i2,i2]; Et = Et[i2,i2]; Bt = Bt[i2,:];
      n = n-nsinf;
   end

   if standsys
      i1 = 1:n
      sysn = dss(At[i1,i1],I,Bt[i1,:],CN[:,i1],DN,Ts=sys.Ts);
      mindeg && (i1 = ng+1:n)
      sysm = dss(At[i1,i1],I,Bt[i1,:],CM[:,i1],DM,Ts=sys.Ts);
   else
      i1 = 1:n
      #sysn = dss(view(At,i1,i1),view(Et,i1,i1),view(Bt,i1,:),view(CN,:,i1),DN,Ts=sys.Ts);
      sysn = dss(At[i1,i1],Et[i1,i1],Bt[i1,:],CN[:,i1],DN,Ts=sys.Ts);
      mindeg && (i1 = ng+1:n)
      #sysm = dss(view(At,i1,i1),view(Et,i1,i1),view(Bt,i1,:),view(CM,:,i1),DM,Ts=sys.Ts);
      sysm = dss(At[i1,i1],Et[i1,i1],Bt[i1,:],CM[:,i1],DM,Ts=sys.Ts);
   end

   fwarn > 0 && @warn("Possible loss of numerical reliability due to high feedback gain")
   return sysn, sysm

# end GRCFID
end
function plyapas2!(A::AbstractMatrix{T1}, E::AbstractMatrix{T1}, B::AbstractMatrix{T1}; disc = false) where T1 <: BlasFloat
   n, m = size(B)
   TR = real(T1)
   ONE = one(TR)
   ZERO = zero(TR)
   TWO = 2*ONE
   small = MatrixEquations.safemin(TR)*n*n
   BIGNUM = ONE / small
   SMIN = eps(max(maximum(abs.(A)),maximum(abs.(E))))

   tau = similar(B,min(n,m))
   B, tau = LinearAlgebra.LAPACK.gerqf!(B,tau)
   if m < n
      U = UpperTriangular([zeros(T1,n,n-m) B])
   else
      U = UpperTriangular(B[1:n,m-n+1:m])
   end

   if disc
      if n == 1
         abs(E[1,1]) >= abs(A[1,1]) && error("A-λE must have only eigenvalues with moduli greater than one")
         TEMP = sqrt( real((A[1,1] - E[1,1])'*(A[1,1] + E[1,1])) )
         TEMP < SMIN && (TEMP = SMIN)
         DR = abs( U[1,1] )
         TEMP < ONE && DR > ONE && DR > BIGNUM*TEMP &&
            error("Singular generalized discrete Lyapunov equation")
         iszero(DR) || (TEMP = sign(U[1,1])*TEMP)
         U[1,1] = U[1,1]/TEMP
      else
         MatrixEquations.pglyap2!(E, A, U, adj = false, disc = true)
      end
   else
      if n == 1
         δ = TWO*real(E[1,1]'*A[1,1])
         δ <= ZERO && error("A-λE has stable eigenvalues")
         TEMP = sqrt( δ )
         TEMP < SMIN && (TEMP = SMIN)
         DR = abs( U[1,1] )
         TEMP < ONE && DR > ONE && DR > BIGNUM*TEMP && error("Singular generalized Lyapunov equation")
         iszero(DR) || (TEMP = sign(U[1,1])*TEMP)
         U[1,1] = U[1,1]/TEMP
      else
         MatrixEquations.pglyap2!(-A, E, U, adj = false, disc = false)
      end
   end
   return U
end


using OptimalTransport

using Distances
using Distributions

using Random
using Test

Random.seed!(100)

@testset "wasserstein.jl" begin
    @testset "p2distance" begin
        for metric in (Euclidean(), Euclidean(0.01), TotalVariation())
            @test OptimalTransport.p2distance(metric, Val(1)) === metric
        end

        @test OptimalTransport.p2distance(Euclidean(), Val(2)) == SqEuclidean()
        @test OptimalTransport.p2distance(Euclidean(0.01), Val(2)) == SqEuclidean(0.01)

        p = randexp()
        x = randn(10)
        y = randn(10)
        for metric in (Euclidean(), TotalVariation())
            for _p in (p, Val(p))
                pmetric = OptimalTransport.p2distance(metric, _p)
                @test pmetric(x, y) ≈ metric(x, y)^p
            end
        end
    end

    @testset "prt" begin
        x = randexp()
        for p in (1, 2, 3, randexp())
            @test OptimalTransport.prt(x, p) ≈ x^(1 / p)
            @test OptimalTransport.prt(x, Val(p)) ≈ x^(1 / p)
        end
    end

    @testset "wasserstein" begin
        μ = Normal(randn(), randexp())
        ν = Normal(randn(), randexp())
        for p in (1, 2, 3, randexp()), metric in (Euclidean(), TotalVariation())
            for _p in (p, Val(p))
                # without additional keyword arguments
                w = wasserstein(μ, ν; p=_p, metric=metric)
                @test w ≈ ot_cost((x, y) -> metric(x, y)^p, μ, ν)^(1 / p)

                # with pre-computed plan (random `ν` ensures that plan is used)
                T = ot_plan((x, y) -> metric(x, y)^p, μ, ν)
                w2 = wasserstein(μ, Normal(randn(), rand()); p=_p, metric=metric, plan=T)
                @test w ≈ w2
            end
        end

        # check that `Euclidean` is the default `metric`
        for p in (1, 2, 3, randexp()), _p in (p, Val(p))
            w = wasserstein(μ, ν; p=_p)
            @test w ≈ wasserstein(μ, ν; p=_p, metric=Euclidean())
        end

        # check that `Val(1)` is the default `p`
        for metric in (Euclidean(), TotalVariation())
            w = wasserstein(μ, ν; metric=metric)
            @test w ≈ wasserstein(μ, ν; p=Val(1), metric=metric)
        end
    end

    @testset "squared2wasserstein" begin
        μ = Normal(randn(), randexp())
        ν = Normal(randn(), randexp())
        for metric in (Euclidean(), TotalVariation())
            # without additional keyword arguments
            w = squared2wasserstein(μ, ν; metric=metric)
            @test w ≈ ot_cost((x, y) -> metric(x, y)^2, μ, ν)

            # with pre-computed plan (random `ν` ensures that plan is used)
            T = ot_plan((x, y) -> metric(x, y)^2, μ, ν)
            w2 = squared2wasserstein(μ, Normal(randn(), rand()); metric=metric, plan=T)
            @test w ≈ w2
        end

        # check that `Euclidean` is the default `metric`
        w = squared2wasserstein(μ, ν)
        @test w ≈ squared2wasserstein(μ, ν; metric=Euclidean())
    end
end


using Flux.Data.MNIST, DecisionTree, Random
Random.seed!(0)

trainImgs   = MNIST.images()
trainLabels = MNIST.labels()
nTrain = length(trainImgs)
trainData = vcat([hcat(float.(trainImgs[i])...) for i in 1:nTrain]...)

testImgs = MNIST.images(:test)
testLabels = MNIST.labels(:test)
nTest = length(testImgs)
testData = vcat([hcat(float.(testImgs[i])...) for i in 1:nTest]...)

numFeaturesPerTree = 10
numTrees = 40
portionSamplesPerTree = 0.7
maxTreeDepth = 10

model = build_forest(trainLabels, trainData,
                    numFeaturesPerTree, numTrees,
                    portionSamplesPerTree, maxTreeDepth)
println("Trained model:")
println(model)

predicted_labels = [apply_forest(model, testData[k,:]) for k in 1:nTest]
accuracy = sum(predicted_labels .== testLabels)/nTest
println("\nPrediction accuracy (measured on test set of size $nTest): ",accuracy)


using LinearAlgebra, SparseArrays
using LogisticOptTools
using BenchmarkTools

const LOT = LogisticOptTools

function dense_callbacks(;n=2_000, p=2_000, intercept=false)
    A = randn(n, p)
    b = sign.(randn(n))
    x = randn(p)

    dat = LOT.LogitData(A, b)
    logit = LOT.LogisticRegressor(dat, LOT.L2Penalty(1.0))
    logit.fit_intercept = intercept

    println("Benchmark f")
    @time LOT.loss(x, dat)
    @time LOT.loss(x, logit)

    println("Benchmark ∇f")
    g = zeros(p)
    @time LOT.gradient!(g, x, dat)
    @time LOT.gradient!(g, x, logit)

    println("Benchmark ∇^2f v")
    hvec = zeros(p)
    vec = zeros(p)
    @time LOT.hessvec!(hvec, x, vec, dat)
    @time LOT.hessvec!(hvec, x, vec, logit)

    println("Benchmark diag(∇^2f)")
    @time LOT.diaghess!(hvec, x, dat)

    println("Benchmark ∇^2f")
    p = 54
    A = randn(p, p)
    b = sign.(randn(p))
    dat = LOT.LogitData(A, b)
    logit = LOT.LogisticRegressor(dat, LOT.L2Penalty(1.0))
    hess = zeros(div(p * (p+1), 2))
    x = randn(p)
    @time LOT.hessian!(hess, x, dat)
    @time LOT.hessian!(hess, x, logit)
end

function sparse_callbacks(;n=2_000, p=2_000)
    # sparse matrix
    A = sprandn(n, p, .25)
    # dense vector
    b = sign.(randn(n))

    dat = LOT.SparseLogitData(A, b)
    logit = LOT.LogisticRegressor(dat, LOT.L2Penalty(1.0))

    n = LOT.nfeatures(dat)
    x = randn(p)
    println("Benchmark f")
    LOT.loss(x, dat)
    @time LOT.loss(x, dat)

    println("Benchmark ∇f")
    g = zeros(p)
    LOT.gradient!(g, x, dat)
    @time LOT.gradient!(g, x, dat)

    println("Benchmark ∇^2f v")
    hvec = zeros(p)
    vec = zeros(p)
    LOT.hessvec!(hvec, x, vec, dat)
    @time LOT.hessvec!(hvec, x, vec, dat)

    #= println("Benchmark ∇^2f") =#
    #= p = 54 =#
    #= A = randn(T, p, p) =#
    #= b = sign.(randn(T, p)) =#
    #= dat = LOT.LogitData(A, b) =#
    #= logit = LOT.GeneralizedLinearModel(dat, LOT.L2Penalty(1.0)) =#
    #= hess = zeros(T, div(p * (p+1), 2)) =#
    #= x = randn(T, p) =#
    #= LOT.hess!(hess, x, dat) =#
    #= @time LOT.hess!(hess, x, dat) =#
    #= @time LOT.hess!(hess, x, logit) =#
end


using LinearAlgebra
using Nystrom
using StaticArrays
using Random
using Plots
plotlyjs()
Random.seed!(1)

## general definitions
xs = SVector(3,3,3)
ops = (
    Laplace(;dim=3),
    Helmholtz(;dim=3,k=1.2),
    Elastostatic(;dim=3,μ=2,λ=3),
    Maxwell(;k=2)
)
pde = ops[1] # chose your pde here
T    = Nystrom.default_density_eltype(pde)
c    = rand(T)

## place to store dofs and error
ndofs = []
ee = []

npatches = [2,4,8]
qorder   =  6
for n in npatches
    ## generate mesh
    Geometry.clear_entities!()
    Ω   = ParametricSurfaces.Sphere() |> Geometry.Domain
    Γ   = boundary(Ω)
    M   = meshgen(Γ,(n,n))
    mesh = NystromMesh(view(M,Γ),order=qorder)
    push!(ndofs,length(Nystrom.dofs(mesh)))
    ## create exact solution
    u    = (qnode) -> SingleLayerKernel(pde)(xs,qnode)*c
    dudn = (qnode) -> transpose(DoubleLayerKernel(pde)(xs,qnode))*c
    γ₀u   = Density(u,mesh)
    γ₁u   = Density(dudn,mesh)
    γ₀u_norm = norm(norm.(γ₀u,Inf),Inf)

    ## compute error
    S,D  = Nystrom.single_doublelayer_dim(pde,mesh)
    e1    = Nystrom.error_interior_green_identity(S,D,γ₀u,γ₁u)/γ₀u_norm
    push!(ee,norm(e1,Inf))
    @info ndofs[end],ee[end]
end

xx = sqrt.(ndofs)
fig = plot(xx,ee,xscale=:log10,yscale=:log10,m=:o,label="error",lc=:black)
plot!(xlabel="√n",ylabel="error",title="$pde")
for p in 1:5
    c = ee[end]*xx[end]^p
    plot!(fig,xx,c ./ xx.^(p),xscale=:log10,yscale=:log10,label="h^$p",ls=:dash)
end
display(fig)


using TupleTools
export i_einsum!

"""
	i_einsum!(ixs, xs, iy, y::AbstractArray{T})

A naive reversible implementation of `i_einsum` function for tropical numbers.
    * `ixs`: input tensor indices,
    * `xs`: input tensors,
    * `iy`: output tensor indices,
    * `y`: accumulated tensor, notice it is initialized to 0 as output!

# NOTE: this function is general purposed and slow!
"""
@i function i_einsum!(ixs, xs, iy, y::AbstractArray{T}) where {T<:Tropical}
	@routine @invcheckoff begin
	    # outer legs and inner legs
	    outer_indices ← unique(iy)
	    inner_indices ← setdiff(TupleTools.vcat(ixs...), outer_indices)

	    # find size for each leg
	    all_indices ← TupleTools.vcat(ixs..., iy)
	    all_sizes ← TupleTools.vcat(size.(xs)..., size(y))
	    outer_sizes ← [map(i->all_sizes[i], indexin(outer_indices, [all_indices...]))...]
	    inner_sizes ← [map(i->all_sizes[i], indexin(inner_indices, [all_indices...]))...]

	    # cartesian indices for outer and inner legs
	    outer_ci ← CartesianIndices((outer_sizes...,))
	    inner_ci ← CartesianIndices((inner_sizes...,))

	    # for indexing tensors (leg binding)
	    indices ← (outer_indices..., inner_indices...)
	    locs_xs ← map(ix->map(i->findfirst(isequal(i), indices), ix), ixs)
    	locs_y ← map(i->findfirst(isequal(i), outer_indices), iy)
	end
    i_loop!(locs_xs, xs, locs_y, y, outer_ci, inner_ci)
	~@routine
end

"""take an index subset from `ind`"""
index_map(ind::CartesianIndex, locs::Tuple) = CartesianIndex(TupleTools.getindices(Tuple(ind), locs))

"""
loop and accumulate products to y, the GPU version, the CPU version.
"""
@i function i_loop!(locs_xs::NTuple{N}, xs::NTuple{N, AbstractArray}, locs_y, y::AbstractArray{T}, outer_ci::CartesianIndices, inner_ci::CartesianIndices) where {N, T<:Tropical}
    @invcheckoff @inbounds for i in outer_ci
		@routine begin
            ind_y ← outer_ci[i]
            iy ← index_map(ind_y, locs_y)
            branch_keeper ← zeros(Bool, length(inner_ci))
            pl ← ones(T, length(inner_ci))
            el ← zero(T)
            for ind_x in inner_ci
                @routine ind_xy ← CartesianIndex(TupleTools.vcat(ind_y.I, ind_x.I))
                #y[iy] += map_prod(T, xs, ind_xy, locs_xs)
                for I=1:N
                    pl[ind_x] *= xs[I][index_map(ind_xy, locs_xs[I])]
                end
                if (el.n < pl[ind_x].n, branch_keeper[ind_x])
                    FLIP(branch_keeper[ind_x])
                    NiLang.SWAP(el, pl[ind_x])
                end
                ~@routine
            end
        end
        y[iy] *= el
        ~@routine
    end
end


# Manifold interface: every manifold (subtype of Manifold) defines the functions
# project_tangent!(m, g, x): project g on the tangent space to m at x
# retract!(m, x): map x back to a point on the manifold m
# out-of-place versions are defined by default

# For mathematical references, see e.g.

# The Geometry of Algorithms with Orthogonality Constraints
# Alan Edelman, Tomás A. Arias, and Steven T. Smith
# SIAM. J. Matrix Anal. & Appl., 20(2), 303–353. (51 pages)

# Optimization Algorithms on Matrix Manifolds
# P.-A. Absil, R. Mahony, R. Sepulchre
# Princeton University Press, 2008

module Manifolds

export Manifold,
       project_tangent, project_tangent!, retract, retract!,
       Flat, Sphere, Stiefel, PowerManifold, ProductManifold

abstract type Manifold
end

# fallback for out-of-place ops
project_tangent(M::Manifold,g,x) = project_tangent!(M, copy(x), x)
retract(M::Manifold,x) = retract!(M, copy(x))

"""Flat Euclidean space {R,C}^N, with projections equal to the identity."""
struct Flat <: Manifold
end
# all the functions below are no-ops, and therefore the generated code
# for the flat manifold should be exactly the same as the one with all
# the manifold stuff removed
retract(M::Flat, x) = x
retract!(M::Flat,x) = x
project_tangent(M::Flat, g, x) = g
project_tangent!(M::Flat, g, x) = g

"""Spherical manifold {|x| = 1}."""
struct Sphere <: Manifold
end
retract!(S::Sphere, x) = normalize!(x)
project_tangent!(S::Sphere,g,x) = (g .= g .- real(vecdot(x,g)).*x)

"""
N x n matrices with orthonormal columns, i.e. such that X'X = I.
Special cases: N x 1 = sphere, N x N = orthogonal/unitary group.
Stiefel() uses a SVD algorithm to compute the retraction. To use a Cholesky-based orthogonalization, use Stiefel_CholQR()
"""
abstract type Stiefel <: Manifold end
struct Stiefel_CholQR <: Stiefel end
struct Stiefel_SVD <: Stiefel end
function Stiefel(retraction=:SVD)
    if retraction == :CholQR
        Stiefel_CholQR()
    elseif retraction == :SVD
        Stiefel_SVD()
    else
        error("Unsupported argument.")
    end
end
function retract!(S::Stiefel_SVD, X)
    U,S,V = svd(X)
    X .= U*V'
end
function retract!(S::Stiefel_CholQR, X)
    overlap = X'X
    X .= X/chol(overlap)
end
project_tangent!(S::Stiefel, G, X) = (G .-= X*((X'G .+ G'X)./2))

"""
Multiple copies of the same manifold. Points are stored as inner_dims x outer_dims,
e.g. the product of 2x2 Stiefel manifolds of dimension N x n would be a N x n x 2 x 2 matrix.
"""
struct PowerManifold<:Manifold
    "Type of embedded manifold"
    inner_manifold::Manifold
    "Dimension of the embedded manifolds"
    inner_dims::Tuple
    "Number of embedded manifolds"
    outer_dims::Tuple
end
function retract!(m::PowerManifold, x)
    for i=1:prod(m.outer_dims)
        retract!(m.inner_manifold,get_inner(m, x, i))
    end
    x
end
function project_tangent!(m::PowerManifold, g, x)
    for i=1:prod(m.outer_dims)
        project_tangent!(m.inner_manifold,get_inner(m, g, i),get_inner(m, x, i))
    end
    g
end
@inline function get_inner(m::PowerManifold, x, i::Int)
    size_inner = prod(m.inner_dims)
    size_outer = prod(m.outer_dims)
    @assert 1 <= i <= size_outer
    return reshape(view(x, (i-1)*size_inner+1:i*size_inner), m.inner_dims)
end
@inline get_inner(m::PowerManifold, x, i::Tuple) = get_inner(m, x, ind2sub(m.outer_dims, i...))

"""
Product of two manifolds {P = (x1,x2), x1 ∈ m1, x2 ∈ m2}.
P is stored as a flat 1D array, and x1 is before x2 in memory.
Use get_inner(m, x, {1,2}) to access x1 and x2 in their original format.
"""
struct ProductManifold<:Manifold
    m1::Manifold
    m2::Manifold
    dims1::Tuple
    dims2::Tuple
end
function retract!(m::ProductManifold, x)
    retract!(m.m1, get_inner(m,x,1))
    retract!(m.m2, get_inner(m,x,2))
    x
end
function project_tangent!(m::ProductManifold, g, x)
    project_tangent!(m.m1, get_inner(m, g, 1), get_inner(m, x, 1))
    project_tangent!(m.m2, get_inner(m, g, 2), get_inner(m, x, 2))
    g
end
function get_inner(m::ProductManifold, x, i)
    N1 = prod(m.dims1)
    N2 = prod(m.dims2)
    @assert length(x) == N1+N2
    if i == 1
        return reshape(view(x, 1:N1),m.dims1)
    elseif i == 2
        return reshape(view(x, N1+1:N1+N2), m.dims2)
    else
        error("Only two components in a product manifold")
    end
end
end


"""
# module kernels

- Julia version: 1.4
- Author: niallcullinane
- Date: 2020-06-07

functions to create LAMINART kernels for lgn -> L6, L4 and W kernel
"""

module LaminartKernels

export kern_d, kern_b

# lgn to l6/l4
using NNlib, ImageFiltering, Images, OffsetArrays

function kern_d_ph(σ::Real, θ::Real, l = 4 * ceil(Int, σ) + 1)
    isodd(l) || throw(ArgumentError("length must be odd"))
    w = l >> 1
    g = σ == 0 ? [1f0] : [exp(-x * cos(θ) / (2f0 * σ)) for x = -w:w]
    centered(g / sum(g))
end

function kern_d_pv(σ::Real, θ::Real, l = 4 * ceil(Int, σ) + 1)
    isodd(l) || throw(ArgumentError("length must be odd"))
    w = l >> 1
    g = σ == 0 ? [1f0] : [exp(-x * sin(θ) / (2f0 * σ)) for x = -w:w]
    centered(g / sum(g))
end

function kern_d_mh(σ::Real, θ::Real, l = 4 * ceil(Int, σ) + 1)
    isodd(l) || throw(ArgumentError("length must be odd"))
    w = l >> 1
    g = σ == 0 ? [1f0] : [exp(x * cos(θ) / (2f0 * σ)) for x = -w:w]
    centered(g / sum(g))
end

function kern_d_mv(σ::Real, θ::Real, l = 4 * ceil(Int, σ) + 1)
    isodd(l) || throw(ArgumentError("length must be odd"))
    w = l >> 1
    g = σ == 0 ? [1f0] : [exp(x * sin(θ) / (2f0 * σ)) for x = -w:w]
    centered(g / sum(g))
end

function kern_d_p(σ::Real, θ::Real, l = 4 * ceil(Int, σ) + 1)
    kern_d_pv(σ, θ, l) .* transpose(kern_d_ph(σ, θ, l))
end

function kern_d_m(σ::Real, θ::Real, l = 4 * ceil(Int, σ) + 1)
    kern_d_mv(σ, θ, l) .* transpose(kern_d_mh(σ, θ, l))
end

function kern_d(σ::Real, θ::Real, l = 4 * ceil(Int, σ) + 1)
    kern_d_p(σ, θ, l) .- kern_d_m(σ, θ, l)
end

# function kern_d(σ::Real, θ::Real, l = 4*ceil(Int,σ)+1)
#     relu.(kern_d(σ, θ, l)) .- relu.(-1 .*(kern_d(σ, θ, l)))
# end

function kern_b(σ::Real, θ::Real, l = 4 * ceil(Int, σ) + 1)
    relu.(kern_d(σ, θ, l)) .+ relu.(-1f0 .* (kern_d(σ, θ, l)))
end

"""
used to make W kernels
returns 2D kernel with elongated Gaussian rotated
"""
function gaussian_rot(
    σ_x::Real,
    σ_y::Real,
    θ::Real,
    l = 4 * ceil(Int, max(σ_a, σ_b)) + 1,
)
    isodd(l) || throw(ArgumentError("length must be odd"))
    w = l >> 1
    g = OffsetArray(fill(0.0f0, l, l), -w:w, -w:w)
    #todo add when σ_x or/and σ_y == 0
    for x ∈ -w:w, y ∈ -w:w
        g[x, y] = exp(
            -1f0 / 2f0 * (
                (((x * cos(θ) - y * sin(θ)) / σ_x)^2f0) +
                (((x * sin(θ) + y * cos(θ)) / σ_y)^2f0)
            ),
        )
    end
    centered(g / sum(g))
end

# Rotating function
function fun_R(x, y, θ)
    x * cos(θ) - y * sin(θ), x * sin(θ) + y * cos(θ)
end

end


#=
assume two populations and assign observations to the populations and simultaneously fit
polynomial functions to these populations; on a given domain containing the observations,
the functions must satisfy certain shape constraints

given domain D ⊆ ℝⁿ, observations (Xᵢ ∈ D, Yᵢ ∈ ℝ₊), solve for p₁(x), p₂(x):
min  ‖z‖ :                              residual loss
p₂(x) ≥ 0, ∀x ∈ D                       p2 nonnegative
p₁(x) ≥ p₂(x), ∀x ∈ D                   p1 above p2
1 ≥ p₁(x), ∀x ∈ D                       p1 below 1
bᵢ ∈ {0,1}, ∀i                          assignment of points
0.4m <= Σᵢbᵢ <= 0.6m                    approximately balance assignments
|zᵢ - (Yᵢ - p₁(Xᵢ))| ≤ Mᵢ(1 - bᵢ), ∀i   residuals for p1
|zᵢ - (Yᵢ - p₂(Xᵢ))| ≤ Mᵢbᵢ, ∀i         residuals for p2
=#

struct PolyRegression <: ExampleInstance
    n::Int # dimension of independent variables / polynomial domain
    halfdeg::Int # polynomial regressor half-degree
    m::Int # number of observations
    signal_ratio::Float64 # signal-to-noise ratio (zero if no noise)
    use_nat::Bool # use WSOS cone formulation, else SDP formulation
end

function build(inst::PolyRegression)
    (n, m, signal_ratio) = (inst.n, inst.m, inst.signal_ratio)
    @assert m > n >= 1

    # setup interpolation
    D = PolyUtils.BoxDomain{Float64}(zeros(n), ones(n))
    (U, _, Ps, V) = PolyUtils.interpolate(D, inst.halfdeg, calc_V = true)
    @assert m >= 2U
    F = qr!(Array(V'), ColumnNorm())

    # generate noisy data in D = [0, 1]ⁿ from two underlying functions
    X = rand(m, n)
    V_X = PolyUtils.make_chebyshev_vandermonde(X, 2 * inst.halfdeg)
    p_X = F \ V_X'

    fs = make_nonneg_polys(2, Ps)
    f1 = fs[1]
    f2 = fs[2]
    @assert minimum(p_X' * f1) >= -1e-4
    @assert minimum(p_X' * f2) >= -1e-4

    f1 .+= f2
    f1_max = -find_poly_min(-f1, Ps)
    @assert f1_max >= -1e-4
    f1 ./= f1_max
    f2 ./= f1_max

    m1 = div(m, 2)
    Y1 = p_X' * f1
    Y2 = p_X' * f2
    @assert minimum(Y1) >= -1e-4
    @assert maximum(Y1) <= 1 + 1e-4
    @assert minimum(Y2) >= -1e-4
    @assert maximum(Y2) <= 1 + 1e-4
    Y = vcat(Y1[1:m1], Y2[(m1 + 1):m])

    if !iszero(signal_ratio)
        noise = randn(m)
        noise .*= norm(Y) / sqrt(signal_ratio) / norm(noise)
        Y .+= noise
        Y = max.(Y, 0.0)
        Y = min.(Y, 1.0)
    end
    @assert all(0 .<= Y .<= 1)

    # build model
    model = JuMP.Model()
    JuMP.@variable(model, p1[1:U])
    JuMP.@variable(model, p2[1:U])
    JuMP.@variable(model, r1[1:m])
    JuMP.@variable(model, r2[1:m])
    JuMP.@variable(model, z[1:m])
    JuMP.@variable(model, b[1:m], Bin)

    JuMP.@variable(model, epi)
    JuMP.@objective(model, Min, epi)

    # TODO tighten big-Ms, inefficient sparsity
    JuMP.@constraints(model, begin
        vcat(epi, z) in Hypatia.EpiNormEuclCone{Float64}(1 + m)
        r1 .== z - Y + p_X' * p1
        r2 .== z - Y + p_X' * p2
        ceil(0.4 * m) <= sum(b)
        sum(b) <= floor(0.6 * m)
        -(1 .- b) .<= r1
        r1 .<= 1 .- b
        -b .<= r2
        r2 .<= b
    end)

    # shape constraints
    add_wsos(aff) = (inst.use_nat ? add_wsos_nat : add_wsos_ext)(Ps, aff, model)
    add_wsos(p2)
    add_wsos(p1 - p2)
    add_wsos(1 .- p1)

    # save for use in tests
    model.ext[:b] = b
    model.ext[:p1] = p1
    model.ext[:p2] = p2
    model.ext[:Ps] = Ps

    return model
end

function test_extra(inst::PolyRegression, model::JuMP.Model)
    stat = JuMP.termination_status(model)
    @test stat in OPT_OR_LIMIT
    (stat == MOI.OPTIMAL) || return

    tol = eps()^0.2
    b = JuMP.value.(model.ext[:b])
    @test b ≈ round.(Int, b) atol = tol rtol = tol
    @test all(-tol .<= b .<= 1 + tol)
    # check WSOS feasibility
    Ps = model.ext[:Ps]
    p1 = JuMP.value.(model.ext[:p1])
    p2 = JuMP.value.(model.ext[:p2])
    @test check_nonneg(p2 .+ tol, Ps)
    @test check_nonneg(p1 - p2 .+ tol, Ps)
    @test check_nonneg((1 + tol) .- p1, Ps)
    # objective is 0 if no noise
    if iszero(inst.signal_ratio)
        @test JuMP.objective_value(model) ≈ 0 atol = tol rtol = tol
    end
    return
end


import SolveIPlusOrMinusAkronB: IPlusAtKronBWS, solvi_real_eliminate!,
                                QuasiUpperTriangular, solve1!, transformation1,
                                generalized_sylvester_solver!
using Test

n = 3
x = randn(n,n*n)
a = randn(n,n)
b = randn(n,n)
c = randn(n,n)

ws = IPlusAtKronBWS(n, n, n, 2)

index = [n,n]
j = 1
depth = 2
t = QuasiUpperTriangular(lu(a\b).U)
s = QuasiUpperTriangular(lu(c).U)
d = zeros(n^(depth+1))
d[1:n*n] = ones(n*n)
d_orig = copy(d)
nd = n*n^(depth-1)
drange1 = 1:nd
r = 1.0
solvi_real_eliminate!(1, n, nd, drange1, depth - 1, r, t, s, d, ws)
@test ws.work1[drange1] ≈ kron(s', t)*d_orig[drange1]
kst = kron(s', t)
d_target = -kron(s[1, 2:n], kst*d_orig[drange1])
@test d[nd + 1:end] ≈ d_target

index = [1,2]
drange1 = drange1 .+ nd
d = zeros(n^(depth+1))
d[drange1] = ones(nd)
d_orig = copy(d)
r = 1.0

@show drange1
solvi_real_eliminate!(2, n, nd, drange1, depth - 1, r, t, s, d, ws)
d_target = -kron(s[2, 3:n], kst*d_orig[drange1])
@show ws.work1
@show d
@test d[2*nd + 1:end] ≈ d_target

aa = a\b
t = lu(aa).U
s = lu(c).U

r = 1.0
d = randn(n)
d_orig = copy(d)
depth = 0
s2 = QuasiUpperTriangular(s*s)
t2 = QuasiUpperTriangular(t*t)

t = QuasiUpperTriangular(t)
s = QuasiUpperTriangular(s)

solve1!(r, depth,t, t2, s, s2, d, ws)
d_target = (I(n) + t)\d_orig
@test d_target ≈ d

r = 1.0
d = randn(n*n)
d_orig = copy(d)
depth = 1
index = zeros(Int64,depth)
d_block_number = n^depth
solve1!(r, depth,t, t2, s, s2, d, ws)

d_target = (I(n^2) + kron(s,t))\d_orig

@test d ≈ d_target

r = 1.0
d = randn(n*n*n)
d_orig = copy(d)
depth = 2
index = zeros(Int64,depth)
d_block_number = n^depth
solve1!(r, depth,t, t2, s, s2, d, ws)

d_target = (I(n^3) + kron(kron(s,s),t))\d_orig

@test d ≈ d_target

a = 0.5
b1 = 0.1
b2 = 1.3
depth = 2
tt = QuasiUpperTriangular(t)
ss = QuasiUpperTriangular(s)
d = randn(2*n^depth)
d_orig = copy(d)
transformation1(a, b1, b2, depth, tt, ss, d, ws)
d_target = d_orig + kron([a -b1; -b2 a],kron(s,t))*d_orig

@test d ≈ d_target

d = a*x + b*x*kron(c,c)
generalized_sylvester_solver!(a, b, c, d, 2, ws)

@test d ≈ x