### A Pluto.jl notebook ###
# v0.17.7

using Markdown
using InteractiveUtils

# This Pluto notebook uses @bind for interactivity. When running this notebook outside of Pluto, the following 'mock version' of @bind gives bound variables a default value (instead of an error).
macro bind(def, element)
    quote
        local iv = try Base.loaded_modules[Base.PkgId(Base.UUID("6e696c72-6542-2067-7265-42206c756150"), "AbstractPlutoDingetjes")].Bonds.initial_value catch; b -> missing; end
        local el = $(esc(element))
        global $(esc(def)) = Core.applicable(Base.get, el) ? Base.get(el) : iv(el)
        el
    end
end

# ╔═╡ 87f59dc7-5149-4eb6-9d81-440ee8cecd72
begin
    using Pkg
	Pkg.activate(joinpath(Pkg.devdir(), "MLCourse"))
    using MLCourse, Plots, MLJ, DataFrames, Random, CSV, Flux, Distributions,
          StatsPlots, MLJFlux, OpenML, Random
    import MLCourse: heaviside
end

# ╔═╡ 83e2c454-042f-11ec-32f7-d9b38eeb7769
begin
    using PlutoUI
    PlutoUI.TableOfContents()
end

# ╔═╡ c95ad296-5191-4f72-a7d7-87ddebc43a65
md"# Solving the XOR Problem with Learned Feature Vectors

In the following example we define a loss function that learns the features (weights of the hidden neurons) and the \"regression coefficients\" (output weights) with gradient descent.
"

# ╔═╡ fde9639d-5f41-4037-ab7b-d3dbb09e8d3d
function xor_generator(; n = 200)
	x = 2 * rand(n, 2) .- 1
	DataFrame(X1 = x[:, 1], X2 = x[:, 2],
		      y = (x[:, 1] .> 0) .⊻ (x[:, 2] .> 0))
end

# ╔═╡ ea7fc5b6-79cc-4cc5-820e-5c55da83207e
begin
    xor_data = xor_generator()
    xor_input = Array(select(xor_data, Not(:y)))
    xor_target = xor_data.y
end;

# ╔═╡ a2539e77-943e-464c-9ad3-c8542eab36ab
begin
    f(x, w₁, w₂, w₃, w₄, β) = β[1] * relu.(x * w₁) .+
                              β[2] * relu.(x * w₂) .+
                              β[3] * relu.(x * w₃) .+
                              β[4] * relu.(x * w₄) .+
                              β[5]
    f(x, θ) = f(x, θ[1:2], θ[3:4], θ[5:6], θ[7:8], θ[9:13])
    function log_reg_loss(θ)
        p = σ.(f(xor_input, θ))
        -mean(@. xor_target * log(p) + (1 - xor_target) * log(1 - p))
    end
end

# ╔═╡ 258a3459-3fef-4655-830c-3bdf11eb282d
md"seed = $(@bind(seed, Select([string(i) for i in 1:20])))

t = $(@bind t Slider(1:10^2))
"

# ╔═╡ 49c2b3a1-50c0-4fb9-a06b-2de7be216702
begin
    Random.seed!(Meta.parse(seed))
    θ₀ = .1 * randn(13)
    path = [copy(θ₀)]
    MLCourse.gradient_descent(log_reg_loss, θ₀, .05, 10^4,
                              callback = x -> push!(path, copy(x)))
end;

# ╔═╡ 9aa58d2b-783a-4b74-ae36-f2ff0fb0be3f
md"The green arrows in the figure above are the weights w₁, …, w₄ of the four (hidden) neurons. The coloring of the dots is based on classification at decision threshold 0.5, i.e. if the activation of the output neuron is above 0.5 for a given input point, this point is classified as red (green, otherwise). Note that the initial configuration of the green vectors depends on the initialization of gradient descent and therefore on the seed. For some seeds the optimal solution to the xor-problem is not found by gradient descent."

# ╔═╡ b650ddb4-5854-4862-ba26-0bf92f77c3df
begin
    idxs = min.(max.(1:100, floor.(Int, 1.097.^(1:100))), 10^4)
    losses = log_reg_loss.(path[idxs])
end;

# ╔═╡ 16d0808e-4094-46ff-8f92-1ed21aa6191b
let idx = idxs[t]
    θ = path[idx]
    prediction = σ.(f(xor_input, θ)) .> .5
    p1 = scatter(xor_data.X1, xor_data.X2, c = prediction .+ 1,
                 xlim = (-1.5, 1.5), ylim = (-1.5, 1.5),
                 xlabel = "X1", ylabel = "X2")
    for i in 1:4
        plot!([0, θ[i*2 - 1]], [0, θ[i*2]], c = :green, w = 3, arrow = true)
    end
    hline!([0], c = :black)
    vline!([0], c = :black)
    p2 = plot(idxs, losses, ylim = (0, 1), xscale = :log10, xlabel = "gradient descent step t",
              ylabel = "loss", title = "learning curve")
    scatter!([idxs[t]], [losses[t]], c = :red)
    plot(p1, p2, layout = (1, 2), size = (700, 400), legend = false)
end

# ╔═╡ 8c54bfb2-54c5-4777-ad53-97926da97f7e
Markdown.parse("
## Avoiding Local Minima with Overparametrization
The following code fits 10 times with different initial guesses for the
parameters an MLP with 4 hidden neurons and 10 times an MLP with 10 hidden
neurons to our xor data. We see that training and test accuracy is better for
the larger network. The reason is that gradient descent for the the larger
network does not get stuck in suboptimal solutions.

Because it takes a bit of time to run the code, it is included here in text form.
Copy-paste it to a cell to run it.
```julia
begin
    using MLJFlux
    function fit_xor(n_hidden)
        x = select(xor_data, Not(:y))
        y = coerce(xor_data.y, Binary)
        builder = MLJFlux.Short(n_hidden = n_hidden,
                                dropout = 0,
                                σ = relu)
        mach = machine(NeuralNetworkClassifier(builder = builder,
                                               batch_size = 32,
                                               epochs = 10^4),
                       x, y) |> fit!
        xor_test = xor_generator(n = 10^4)
        x_test = select(xor_test, Not(:y))
        y_test = coerce(xor_test.y, Binary)
        DataFrame(n_hidden = n_hidden,
                  training_accuracy = mean(predict_mode(mach, x) .== y),
                  test_accuracy = mean(predict_mode(mach, x_test) .== y_test))
    end
    xor_results = vcat([fit_xor(n_hidden) for n_hidden in [4, 10], _ in 1:10]...)
    @df xor_results dotplot(:n_hidden, :training_accuracy,
                            xlabel = \"number of hidden units\",
                            ylabel = \"accuracy\",
                            label = \"training\",
                            yrange = (.5, 1.01),
                            aspect_ratio = 20,
                            legend = :bottomright,
                            xticks = [4, 10])
    @df xor_results dotplot!(:n_hidden, :test_accuracy, label = \"test\")
end
```
$(MLCourse.embed_figure("overparametrized.png"))
")

# ╔═╡ 5c2154ef-2a35-4d91-959d-f72100049894
md"# Multilayer Perceptrons

Below you see three equivalent ways to implement a neural network:
1. In the `expanded` form all parameters and activation functions are explicitely written out in \"one line\". With more neurons or hidden layers, this form quickly becomes annoying to write.
2. In the `neuron` form we see clearly that the neural network is composed of multiple simple neurons with different input weights and biases.
3. The `matrix` form is the most succinct form and most commonly used in modern implementations. In this form the biases of each layer are organized in a vector and the input weights of all neurons in the same layer are organized in a matrix.
"

# ╔═╡ 71dabb22-816b-4aa2-9a29-f2894989b2ea
begin
    function neural_net_expanded(x,
                                 w₁₀¹, w₁₁¹, w₂₀¹, w₂₁¹, w₃₀¹, w₃₁¹, w₄₀¹, w₄₁¹, g¹,
                                 w₁₀², w₁₁², w₁₂², w₁₃², w₁₄², g²)
        g²(w₁₀² +
           w₁₁² * g¹(w₁₀¹ + w₁₁¹ * x) +
           w₁₂² * g¹(w₂₀¹ + w₂₁¹ * x) +
           w₁₃² * g¹(w₃₀¹ + w₃₁¹ * x) +
           w₁₄² * g¹(w₄₀¹ + w₄₁¹ * x))
    end
    neuron(x, b, w, g) = g.(b .+ w' * x)
    function neural_net_neurons(x,
                                w₁₀¹, w₁₁¹, w₂₀¹, w₂₁¹, w₃₀¹, w₃₁¹, w₄₀¹, w₄₁¹, g¹,
                                w₁₀², w₁₁², w₁₂², w₁₃², w₁₄², g²)
        second_layer_input = [neuron(x, w₁₀¹, w₁₁¹, g¹),
                              neuron(x, w₂₀¹, w₂₁¹, g¹),
                              neuron(x, w₃₀¹, w₃₁¹, g¹),
                              neuron(x, w₄₀¹, w₄₁¹, g¹)]
        neuron(second_layer_input, w₁₀², [w₁₁², w₁₂², w₁₃², w₁₄²], g²)
    end
    function neural_net_matrix(x,
                               w₁₀¹, w₁₁¹, w₂₀¹, w₂₁¹, w₃₀¹, w₃₁¹, w₄₀¹, w₄₁¹, g¹,
                               w₁₀², w₁₁², w₁₂², w₁₃², w₁₄², g²)
        b¹ = [w₁₀¹, w₂₀¹, w₃₀¹, w₄₀¹]
        w¹ = [w₁₁¹
              w₂₁¹
              w₃₁¹
              w₄₁¹]
        b² = [w₁₀²]
        w² = [w₁₁² w₁₂² w₁₃² w₁₄²]
        neural_net_matrix(x, b¹, w¹, g¹, b², w², g²)
    end
    function neural_net_matrix(x, b¹, w¹, g¹, b², w², g²)
        g².(b² .+ w² * g¹.(b¹ .+ w¹ * x))
    end
end;

# ╔═╡ 653ea4e8-47b2-4d9f-bc5c-583468d6e1ae
md"## 1D to 1D
**First Layer** activation function ``g^{(1)}`` = $(@bind g1 Select(string.([relu, selu, sigmoid, tanh, identity, heaviside])))

``w_{10}^{(1)}`` = $(@bind w101 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{11}^{(1)}`` = $(@bind w111 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))

``w_{20}^{(1)}`` = $(@bind w201 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{21}^{(1)}`` = $(@bind w211 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))

``w_{30}^{(1)}`` = $(@bind w301 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{31}^{(1)}`` = $(@bind w311 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))

``w_{40}^{(1)}`` = $(@bind w401 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{41}^{(1)}`` = $(@bind w411 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))

**Second Layer** activation function ``g^{(2)}`` = $(@bind g2 Select(string.([identity, relu, selu, sigmoid, tanh, heaviside])))

``w_{10}^{(2)}`` = $(@bind w102 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{11}^{(2)}`` = $(@bind w112 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{12}^{(2)}`` = $(@bind w122 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))

``w_{13}^{(2)}`` = $(@bind w132 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{14}^{(2)}`` = $(@bind w142 Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
"

# ╔═╡ 1171bcb8-a2af-49f3-9a7e-2e7cac34f9f4
let
    x = -5:.01:5
    _g1 = getproperty(@__MODULE__, Symbol(g1))
    _g2 = getproperty(@__MODULE__, Symbol(g2))
    y = neural_net_expanded.(x, w101, w111, w201, w211, w301, w311, w401, w411, _g1, w102, w112, w122, w132, w142, _g2)
    py = plot(x, y, xlabel = "x", ylabel = "y")
    p1 = plot(x, neuron.(x, w101, w111, _g1), xlabel = "x", ylabel = "hidden neuron 1")
    p2 = plot(x, neuron.(x, w201, w211, _g1), xlabel = "x", ylabel = "hidden neuron 2")
    p3 = plot(x, neuron.(x, w301, w311, _g1), xlabel = "x", ylabel = "hidden neuron 3")
    p4 = plot(x, neuron.(x, w401, w411, _g1), xlabel = "x", ylabel = "hidden neuron 4")
    plot(plot(p1, p2, p3, p4, layout = (1, 4)), py, layout = (2, 1), legend = false)
end

# ╔═╡ 1c70c3c4-bded-44ec-ac40-c71268b7307e
md"## 2D to 1D
**First Layer** activation function ``g^{(1)}`` = $(@bind g1_2d Select(string.([relu, selu, sigmoid, tanh, identity, heaviside]), default = string(:heaviside)))

``w_{10}^{(1)}`` = $(@bind w101_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{11}^{(1)}`` = $(@bind w111_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{12}^{(1)}`` = $(@bind w121_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))

``w_{20}^{(1)}`` = $(@bind w201_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{21}^{(1)}`` = $(@bind w211_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{22}^{(1)}`` = $(@bind w221_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))

``w_{30}^{(1)}`` = $(@bind w301_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{31}^{(1)}`` = $(@bind w311_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{32}^{(1)}`` = $(@bind w321_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))

``w_{40}^{(1)}`` = $(@bind w401_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{41}^{(1)}`` = $(@bind w411_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{42}^{(1)}`` = $(@bind w421_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))

**Second Layer** activation function ``g^{(2)}`` = $(@bind g2_2d Select(string.([identity, relu, selu, sigmoid, tanh, heaviside])))

``w_{10}^{(2)}`` = $(@bind w102_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{11}^{(2)}`` = $(@bind w112_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{12}^{(2)}`` = $(@bind w122_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))

``w_{13}^{(2)}`` = $(@bind w132_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
``w_{14}^{(2)}`` = $(@bind w142_2d Slider(-3.:.1:3., default = floor(60*(rand()-.5))/10, show_value = true))
"

# ╔═╡ 15cd82d3-c255-4eb5-9f0d-1e662c488027
md"If you want to tinker more with simple neural networks there is [this nice web-application](http://playground.tensorflow.org/)."

# ╔═╡ 9e6ad99f-8cd4-4372-a4a2-f280e49e21a3
begin
    function tocol(y)
        ma, mi = maximum(y), minimum(y)
        palette(:jet1, 101)[min.(101, max.(1, reshape(floor.(Int, (y .+ 6) * 5) .+ 1, :)))]
    end
end;

# ╔═╡ 66bc40f3-7710-4892-ae9f-79b9c850b0ea
let x = -5:.1:5
    grid = MLCourse.grid(x, x, output_format = DataFrame)
    X = Array(Array(grid)')
    _g1 = getproperty(@__MODULE__, Symbol(g1_2d))
    _g2 = getproperty(@__MODULE__, Symbol(g2_2d))
    b1 = [w101_2d, w201_2d, w301_2d, w401_2d]
    w1 = [w111_2d w121_2d
          w211_2d w221_2d
          w311_2d w321_2d
          w411_2d w421_2d]
    b2 = [w102_2d]
    w2 = [w112_2d w122_2d w132_2d w142_2d]
    y = neural_net_matrix(X, b1, w1, _g1, b2, w2, _g2)
    p1 = scatter(grid.X, grid.Y, c = tocol(neuron(X, b1[1], w1[1, :], _g1)), title = "hidden 1")
    p2 = scatter(grid.X, grid.Y, c = tocol(neuron(X, b1[2], w1[2, :], _g1)), title = "hidden 2")
    p3 = scatter(grid.X, grid.Y, c = tocol(neuron(X, b1[3], w1[3, :], _g1)), title = "hidden 3")
    p4 = scatter(grid.X, grid.Y, c = tocol(neuron(X, b1[4], w1[4, :], _g1)), title = "hidden 4")
    py = scatter(grid.X, grid.Y, c = tocol(y), title = "y",)
    plot(plot(p1, p2, p3, p4, layout = (1, 4)),
         py, layout = (2, 1), markersize = 2, markerstrokewidth = 0,
                 xlabel = "x₁", ylabel = "x₂", legend = false, aspect_ratio = 1)
end

# ╔═╡ 9d3e7643-34fd-40ee-b442-9d2a434f30e0
Markdown.parse("# Regression with MLPs

## Fitting the Weather Data

Let us find out if with an MLP we can get better predictions than with multiple
linear regression on the weather data set.

The following code takes roughly 2 minutes to run.

```julia
weather = CSV.read(joinpath(@__DIR__, \"..\", \"data\", \"weather2015-2018.csv\"),
                   DataFrame)
weather_test = CSV.read(joinpath(@__DIR__, \"..\", \"data\", \"weather2019-2020.csv\"),
                        DataFrame)
weather_x = float.(select(weather, Not([:LUZ_wind_peak, :time]))[1:end-5, :])
weather_y = weather.LUZ_wind_peak[6:end]
weather_test_x = float.(select(weather_test, Not([:LUZ_wind_peak, :time]))[1:end-5, :])
weather_test_y = weather_test.LUZ_wind_peak[6:end]

Random.seed!(31)
nn = NeuralNetworkRegressor(builder = MLJFlux.Short(n_hidden = 128,
                                                    dropout = .5,
                                                    σ = relu),
                            optimiser = ADAMW(),
                            batch_size = 128,
                            epochs = 150)
mach = machine(Standardizer() |> nn,
               weather_x, weather_y)
fit!(mach, verbosity = 2)
```

!!! note

    We use here a `Pipeline` (`|>`) that standardizes with a `Standardizer`
    the input first to mean zero and standard deviation one.
    We do this, because the usual initializations
    of neural networks work best with standardized input.

    To learn more about the usual initializations you can have a look at this [blog post](https://towardsdatascience.com/weight-initialization-in-neural-networks-a-journey-from-the-basics-to-kaiming-954fb9b47c79) (optional).

!!! note

    Our builder constructs a neural network with one hidden layer of 128 relu neurons.
    In the construction we specify that we would like to train with 50% dropout
    to reduce the risk of overfitting.

Let us evalute the learned machine.

```julia
(training_error = rmse(predict(mach, weather_x), weather_y),
 test_error = rmse(predict(mach, weather_test_x), weather_test_y))
```
We find a training error of 7.38 and a test error of 8.65.
Both errors are lower than what we found with multiple linear regression
(training error ≈ 8.09, test_error ≈ 8.91). However, comparing the predictions
to the ground truth we see that a lot of the variability is still uncaptured
by the model. This means most likely that the irreducible error is pretty high in this dataset.
```julia
scatter(predict(mach, weather_test_x), weather_test_y,
        xlabel = \"predicted\", ylabel = \"data\")
plot!(identity, legend = false)
```
$(MLCourse.embed_figure("weather_mlp.png"))
")

# ╔═╡ 0ba71a2a-f2f9-4fc7-aa81-416799e79e57
Markdown.parse("## Parametrizing Variances of Log-Normal Distributions with MLPs

For this example we do not use the abstractions provided by MLJ. Instead we use
directly Flux. You only need to do this if you want to implement some non-standard neural network.

Let us load the data.
```julia
weather = CSV.read(joinpath(@__DIR__, \"..\", \"data\", \"weather2015-2018.csv\"),
                   DataFrame)
standardize(x) = (x .- mean(x)) ./ std(x)
weather_input = Float32.(standardize(weather.LUZ_pressure[1:end-5])')
weather_output = Float32.(standardize(log.(weather.LUZ_wind_peak[6:end])))
```

We define a simple neural network with one hidden layer of 50 tanh neurons.
```julia
nn = Chain(Dense(1, 50, tanh), Dense(50, 2))
```

Let us now define the negative log-likelihood loss function.
```julia
function loss(x, y)
    output = nn(x)
    m = output[1, :]
    s = softplus.(output[2, :])
    mean((m .- y) .^ 2 ./ (2 * s) .+ log.(s))
end
```
This function computes the two output dimensions of the neural network.
The first output dimension is our mean. The second output dimension is transformed
to positive values with the `softplus` function ``x \\mapsto \\log(\\exp(x) + 1)``
to enode the variance of the normal distribution. In the log-likelihood loss we
drop the constant term ``\\frac12\\log2\\pi``.

Now we train the neural network for 50 epochs.
```julia
opt = ADAMW()
p = Flux.params(nn) # these are the parameters to be adapted.
data = Flux.DataLoader((weather_input, weather_output), batchsize = 32)
for _ in 1:50
    Flux.Optimise.train!(loss, p, data, opt)
end
```

Let us now plot the result.
```julia
grid = collect(-5:.1:3.5)'
pred = nn(grid)
m = pred[1, :]
s = sqrt.(softplus.(pred[2, :]))
histogram2d(weather_input', weather_output, bins = (250, 200),
            markersize = 3, xlabel = \"LUZ_pressure [hPa]\",
            ylabel = \"LUZ_wind_peak [km/h]\", label = nothing, cbar = false)
plot!(grid', m, c = :red, w = 3, label = \"mean\")
plot!(grid', m .+ s, c = :red, linestyle = :dash, w = 3, label = \"± standard deviation\")
plot!(grid', m .- s, c = :red, linestyle = :dash, w = 3, label = nothing)
```

$(MLCourse.embed_figure("weather_mlp_normal.png"))

We see that the neural network found a slightly non-linear relationship between
input and average output and the variance of the noise is smaller for high
pressure values than for low pressure values.
")

# ╔═╡ 4bd63efb-0aef-41cd-a9b7-9fa78db107a0
Markdown.parse("
## Fitting a Polynomial in 1000 Input Dimensions
The following artificial data set has ``n=10^5`` points of ``p = 1000`` dimensions.
The response ``y = x_7^2 - 1`` depends only on the seventh input dimension.
Although neural networks are not specifically designed to fit polynomials,
this example demonstrates that with only 50 hidden relu-neurons an accurate fit
can be found.

WARNING: it takes more than 10 minutes to run this code.
```julia
let
    x = DataFrame(randn(10^5, 1000), :auto)
    y = x.x7 .^2 .- 1
    mach = fit!(machine(NeuralNetworkRegressor(builder = MLJFlux.Short(n_hidden = 50,
                                                                       dropout = 0,
                                                                       σ = relu),
                                               batch_size = 128,
                                               epochs = 10^2),
                        x, y), verbosity = 2)
    grid = -3:.1:3
    x_test = DataFrame(randn(length(grid), 1000), :auto)
    x_test.x7 = grid
    plot(grid, grid.^2 .- 1, label = \"ground truth\", w = 3, legend = :bottomright)
    plot!(grid, predict(mach, x_test),
          label = \"fit\", xlabel = \"x₇\", ylabel = \"y\", w = 3)
end
```

$(MLCourse.embed_figure("poly.png"))
")

# ╔═╡ 14a8eacb-352e-4c3b-8908-2a6f77ffc6fe
md"# Classification with MLPs

## Fitting MNIST

The following code to fit the MNIST data with a multilayer perceptron takes a
few minutes to run.

```julia
mnist_x, mnist_y = let df = OpenML.load(554) |> DataFrame
    coerce!(df, :class => Multiclass)
    coerce!(df, Count => MLJ.Continuous)
    Float32.(df[:, 1:end-1] ./ 255),
    df.class
end
mnist_mach = machine(NeuralNetworkClassifier(
                         builder = MLJFlux.@builder(Chain(Dense(n_in, 100, relu),
                                                          Dense(100, n_out))),
                         batch_size = 32,
                         epochs = 20),
                      mnist_x[1:60000, :],
                      mnist_y[1:60000])
fit!(mnist_mach, verbosity = 2)
mean(predict_mode(mnist_mach, mnist_x[60001:70000, :]) .!= mnist_y[60001:70000])
```
The result is a misclassification rate of approximately 2.2%, which is better
than our first nearest-neigbor result. Additionally, prediction of the class
for new images is much faster than with nearest neighbor approaches, because the
information about the training data is stored in the weights of the neural network
and no explicit comparison with all training images is required.
"

# ╔═╡ 2f034d19-1c00-4a10-a880-99436ab00957
md"# Exercises

## Conceptual
1. To get a feeling for the kind of functions of one predictor can be fitted with neural networks, we will draw ``y`` as a function of ``x`` for some values of the weights. It may be helpful to sketch this neural network with the input neuron, the hidden neurons and the output neuron and label the connections with the weights.
    * Draw in the same figure ``a_1^{(1)} = g(w_{10}^{(1)} + w_{11}^{(1)} x)``, ``a_2^{(1)}=g(w_{20}^{(1)} + w_{21}^{(1)} x)`` and ``\bar y = w_0^{(2)} + w_1^{(2)}a_1^{(1)} +  w_2^{(2)}a_2^{(1)}`` as a function of ``x``. Use ``w_{10}^{(1)} = 0``, ``w_{11}^{(1)} = 1``, ``w_{20}^{(1)} = - 2``, ``w_{21}^{(1)} = 2``,  ``w_0^{(2)} = 1``, ``w_1^{(2)} = 2``, ``w_2^{(2)} = 1`` and use the rectified linear activation function ``g = \mbox{relu}``. At which ``x``-values does the slope change? Give the answer in terms of the weights.
    * Draw a similar graph for ``w_{11}^{(1)} < 0`` and ``w_{10}^{(1)}/w_{11}^{(1)}<w_{20}^{(1)}/w_{21}^{(1)}``, e.g. with ``w_{10}^{(1)} = 0``, ``w_{11}^{(1)} = -1``, ``w_{20}^{(1)} = 2``, ``w_{21}^{(1)} = 2``,  ``w_0^{(2)} = 1``, ``w_1^{(2)} = 2``, ``w_2^{(2)} = 1``.
    * How does the graph above change, if ``w_1^{(2)} = -2`` and ``w_2^{(2)} = -1``?
    * Let us assume we add more neurons to the same hidden layer, i.e. we have ``a_1^{(1)}, \ldots, a_{d^{(1)}}^{(1)}`` activations in the first layer. How would the graph look differently in this case? Draw a sketch and describe in one sentence the qualitative difference.
    * Let us assume we add instead more hidden layers with relu-activations. Would the graph of this neural network look qualitatively different from the ones we have drawn so far in this exercise?
    * (optional) Show that a neural network with one hidden layer of 3 relu-neurons can perfectly fit any continuous piece-wise linear function of the form ``y = \left\{\begin{array}{ll} a_1 + b_1 x & x < c_1 \\ a_2 + b_2 x & c_1 \leq x < c_2 \\ a_3 + b_3 x & c_2 \leq x \end{array}\right. \hspace{1cm}  ``
                    with ``c_1 =  \frac{a_1 - a_2}{b_2 - b_1} < c_2 = \frac{a_2 - a_3}{b_3 - b_2}``. Express ``a_1, a_2, a_3`` and ``b_1, b_2, b_3`` in terms of the network weights. There are multiple solutions; find one of them.
1. Consider a neural network with two hidden layers: ``p = 4`` input units, ``2`` units in the first hidden layer, ``3`` units in the second hidden layer, and a single output.
    - Draw a picture of the network.
    - How many parameters are there?
    - Assume the output of this network is the mean of a conditional normal distribution. Write the negative log-likelihood loss using matrix notation.
1. Let us assume you want to predict the proportion ``y`` of citizens voting for one of two parties based on 113 different features that depend e.g. on the voting history, income distribution or demographics (see e.g. [here](https://www.ozy.com/news-and-politics/the-forecast-the-methodology-behind-our-2020-election-model/379778/) for an actual example). Because the proportion is a number between 0 and 1, it is reasonable to model it as a sample from a [beta distribution](https://en.wikipedia.org/wiki/Beta_distribution) ``p(y) = \frac{y^{\alpha - 1}(1-y)^{\beta - 1}}{B(\alpha, \beta)}``, where ``\alpha>0`` and ``\beta>0`` are shape parameters and ``B`` is the beta function. You want parametrize the conditional distribution of proportions ``y`` given predictors ``x`` with a neural network.
    * How many input units should this neural network have?
    * How many output units should this neural network have?
    * What kind of activation function would you choose for the output layer?
    * Which loss function would you use to estimate the network parameters?
1. (Optional) Grant Sanderson has some beautiful [videos about neural networks](https://www.3blue1brown.com/topics/neural-networks). Have a look at them, if you are interested.

## Applied
1. In this exercise our goal is to find a good machine learning model to predict the fat content of a meat sample on the basis of its near infrared absorbance spectrum. We use the Tecator data set `OpenML.describe_dataset(505)`. The first 100 columns of this data set contain measurements of near infrared absorbance at different frequencies for different pieces of meat. *Hint:* you can select all these columns based on name with `select(data, r\"absorbance\")` (The \"r\" in this command stands for Regex and it means that all columns with name containing the word \"absorbance\" should be selected). The column `:fat` contains the fat content of each piece of meat. We will use the first 172 data points for training and validation and the rest of the data points as a test set. Take our recipe for supervised learning (last slide of the presentation on \"Model Assessment and Hyperparameter Tuning\") as a guideline.
    - Have a look at the raw data by e.g. checking if there are missing values and looking at a correlation plot.
    - Fit some multiple linear regression models (with e.g. regularization constants tuned with cross-valdiation), compute the `rmse` of your best model on the test set and create a scatter plot that shows the actual fat content of the test data point versus the predicted fat content.
    - Fit some neural network model (with 2 hyper-paramters of your choice tuned by cross-validation; warning: it may take quite some time to fit if you use a high number for `nfolds`), compute the `rmse` of your best model on the test set and create a scatter plot that shows the actual fat content of the test data point versus the predicted fat content. *Hint 1:* standardization of input and output matters. *Hint 2:* If you want to tune some neural network parameters in a pipeline you can usually access them in the `range` function as `:(neural_network_regressor.builder.dropout)`, for example.
"

# ╔═╡ 7c6951e8-726a-4181-b15f-b629a2835d03
MLCourse.list_notebooks(@__FILE__)

# ╔═╡ 8c72c4b5-452d-4ba3-903b-866cac1c799d
MLCourse.footer()

# ╔═╡ Cell order:
# ╠═87f59dc7-5149-4eb6-9d81-440ee8cecd72
# ╟─c95ad296-5191-4f72-a7d7-87ddebc43a65
# ╠═fde9639d-5f41-4037-ab7b-d3dbb09e8d3d
# ╠═ea7fc5b6-79cc-4cc5-820e-5c55da83207e
# ╠═a2539e77-943e-464c-9ad3-c8542eab36ab
# ╠═49c2b3a1-50c0-4fb9-a06b-2de7be216702
# ╟─258a3459-3fef-4655-830c-3bdf11eb282d
# ╟─16d0808e-4094-46ff-8f92-1ed21aa6191b
# ╟─9aa58d2b-783a-4b74-ae36-f2ff0fb0be3f
# ╟─b650ddb4-5854-4862-ba26-0bf92f77c3df
# ╟─8c54bfb2-54c5-4777-ad53-97926da97f7e
# ╟─5c2154ef-2a35-4d91-959d-f72100049894
# ╠═71dabb22-816b-4aa2-9a29-f2894989b2ea
# ╟─653ea4e8-47b2-4d9f-bc5c-583468d6e1ae
# ╟─1171bcb8-a2af-49f3-9a7e-2e7cac34f9f4
# ╟─1c70c3c4-bded-44ec-ac40-c71268b7307e
# ╟─66bc40f3-7710-4892-ae9f-79b9c850b0ea
# ╟─15cd82d3-c255-4eb5-9f0d-1e662c488027
# ╟─9e6ad99f-8cd4-4372-a4a2-f280e49e21a3
# ╟─9d3e7643-34fd-40ee-b442-9d2a434f30e0
# ╟─0ba71a2a-f2f9-4fc7-aa81-416799e79e57
# ╟─4bd63efb-0aef-41cd-a9b7-9fa78db107a0
# ╟─14a8eacb-352e-4c3b-8908-2a6f77ffc6fe
# ╟─2f034d19-1c00-4a10-a880-99436ab00957
# ╟─7c6951e8-726a-4181-b15f-b629a2835d03
# ╟─83e2c454-042f-11ec-32f7-d9b38eeb7769
# ╟─8c72c4b5-452d-4ba3-903b-866cac1c799d


# ---
# title: 382. Linked List Random Node
# id: problem382
# author: zhwang
# date: 2022-02-15
# difficulty: Medium
# categories: Reservoir Sampling
# link: <https://leetcode.com/problems/linked-list-random-node/description/>
# hidden: true
# ---
#
# Given a singly linked list, return a random node's value from the linked list.
# Each node must have the **same probability** of being chosen.
#
# **Follow up:**
# What if the linked list is extremely large and its length is unknown to you?
# Could you solve this efficiently without using extra space?
#
# **Example:**
#
#
#
#     // Init a singly linked list [1,2,3].
#     ListNode head = new ListNode(1);
#     head.next = new ListNode(2);
#     head.next.next = new ListNode(3);
#     Solution solution = new Solution(head);
#
#     // getRandom() should return either 1, 2, or 3 randomly. Each element should have equal probability of returning.
#     solution.getRandom();
#
#
#
## @lc code=start
using LeetCode

function get_random(head::ListNode)::Int
    node, i, res = head, 1, 0
    while !isnothing(node)
        if rand(1:i) == 1  ## 1/i prob for value change
            res = node.val
        end
        node = node.next
        i += 1
    end
    res
end
## @lc code=end

## @lc test=start
@testset "382.linked-list-random-node.jl" begin
    node = ListNode{Int}([1, 2, 2, 3])
    @test begin
        freq = Dict{Int, Int}(1 => 0, 2 => 0, 3 => 0)
        for _ in 1:10000
            freq[get_random(node)] += 1
        end
        num = freq[1] + freq[2] + freq[3]
        !(freq[1] == 2 * freq[2] == freq[3]) &&
        abs(freq[1] / num - freq[3] / num) + abs(freq[1] / num - freq[2] / num / 2) <= 0.03
    end
end
## @lc test=end

## @lc info=start
# link: [solution to 382](https://leetcode-cn.com/problems/linked-list-random-node/solution/382-lian-biao-sui-ji-jie-dian-by-rex-rs-0g47/)
## @lc info=end


#---------------------------------------------------------
# # [Support mask](@id 2-mask)
#---------------------------------------------------------

# This page explains the `mask` aspects of the Julia package
# [`ImageGeoms`](https://github.com/JuliaImageRecon/ImageGeoms.jl).

# ### Setup

# Packages needed here.

using ImageGeoms
using MIRTjim: jim, prompt
using UnitfulRecipes
using Unitful: mm

# The following line is helpful when running this example.jl file as a script;
# this way it will prompt user to hit a key after each figure is displayed.

isinteractive() ? jim(:prompt, true) : prompt(:draw);

# ### Mask overview

# In tomographic image reconstruction, patients are usually more "round"
# than "square" so often we only want to estimate the pixels inside some
# support `mask`: a `Bool` array indicating which pixels are to be estimated.
# (The rest are constrained to be zero.)
# The `ImageGeom` struct has an entry to store this `mask`.
# The default is `Trues(dims)` which is a "lazy" Bool `AbstractArray`
# from the `FillArrays` package that is conceptually similar to `trues(dims)`
# but requires `O(1)` storage.  So there is essentially no memory penalty
# to storing this entry in the `ImageGeom` for users who do not want
# to think about a `mask`.
# For users who do want a `mask`, fortunately Julia uses a special `BitArray`
# type to store `Bool` arrays, so the storage is 8× less than using bytes
# in most other languages.

# Often we use a "circle inscribed in the square" as a generic support mask,
# and one of the built-in constructors can generate such a circular mask:

ig = ImageGeom(MaskCircle() ; dims=(40,32), deltas=(1mm,1mm))

# That last line shows that 716 of 1280=40*32 mask pixels are nonzero.

ImageGeoms.plot(ig, jim)

# Note that `jim` displays the axes with the units naturally;
# see [MIRTjim.jl](http://github.com/JeffFessler/MIRTjim.jl).

# A 3D mask can be hard to visualize, so there is a `mask_or` method
# that collapses it to 2D:

ig = ImageGeom(MaskAllButEdge() ; dims=(32,32,16))

ImageGeoms.plot(ig, jim)

# ### Mask operations

# Often we need to extract the pixel values within a mask:

ig = ImageGeom(MaskAllButEdge() ; dims=(6,4))
x = 1:size(ig,1)
y = 1:size(ig,2)
ramp = x .+ 10*y'

ig.mask

core = ramp[ig.mask]

# Or equivalently:
maskit(ramp, ig.mask)

# Conversely, we can embed that list of pixels back into an array:
array = embed(core, ig.mask)

# There are in-place versions of these two operations:
core = Array{Float32}(undef, sum(ig.mask))
getindex!(core, ramp, ig.mask)

#
array = collect(zeros(Float16, ig))
embed!(array, core, ig.mask)


"""
    salocd(A, C; evals, sdeg, disc = false, atol1 = 0, atol2 = 0, rtol) -> (K, Scl, blkdims)

Compute for the pair `(A,C)`, a matrix `K` such that all eigenvalues of the matrix `A+K*C` lie in the stability domain `Cs`
specified by the stability degree parameter `sdeg` and stability type parameter `disc`.
If `disc = false`, `Cs` is the set of complex numbers with real parts at most `sdeg`, while if `disc = true`,
`Cs` is the set of complex numbers with moduli at most `sdeg` (i.e., the interior of a disc of radius `sdeg` centered in the origin).
`evals` is a real or complex vector, which contains the desired eigenvalues of the matrix `A+K*C` within `Cs`.
For real data `A` and `C`, `evals` must be a self-conjugated complex set to ensure that the resulting `K` is also a real matrix.

For a pair `(A,C)` with `A` of order `n`, the number of assignable eigenvalues is `nc := n-nu`,
where `nu` is the number of fixed eigenvalues of `A`. The assignable eigenvalues are called the _observable eigenvalues_,
while the fixed eigenvalues are called the _unobservable eigenvalues_ (these are the zeros of the pencil `[A-λI; C]`).
The spectrum allocation is achieved by successively replacing the observable eigenvalues of `A` lying outside of the
stability domain `Cs` with eigenvalues provided in `evals`. All eigenvalues of `A` lying in `Cs` are kept unalterred.
If the number of specified eigenvalues in `evals` is less than the number of observable eigenvalues of `A` outside of `Cs`
(e.g., if `evals = missing`), then some of the observable eigenvalues of `A` are assigned to the nearest values
on the boundary of `Cs`. If `sdeg = missing` and `evals = missing`, the default value used for `sdeg` is -0.05
if  `disc = false` and 0.95 if `disc = true`.

The keyword arguments `atol1`, `atol2`, and `rtol`, specify, respectively, the absolute tolerance for the
nonzero elements of `A`, the absolute tolerance for the nonzero elements of `C`,
and the relative tolerance for the nonzero elements of `A` and `C`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the machine epsilon of the element type of `A`.

The resulting matrix `Acl := Z'*(A+K*C)*Z` in a Schur form, where `Z` is the orthogonal/unitary matrix used
to obtain the matrix `A+K*C` in Schur form, has the form

           ( Au  *   *  )
     Acl = ( 0   Aa  *  )
           ( 0   0   Ag )

where:  `Au` contains `nu` unobservable eigenvalues of `A` lying outside `Cs`,
`Aa` contains the `na` assigned eigenvalues in `Cs` and `Ag` contains the `ng` eigenvalues of `A` in `Cs`.
The matrices `Acl` and `Z` and the vector `α` of eigenvalues of `Acl` (also of `A+K*C`)
are returned in the `Schur` object `Scl`.
The values of `nu`, `na` and `ng` are returned in the 3-dimensional vector `blkdims = [nu, na, ng]`.

Method:  The Schur method of [1] is applied to the dual pair `(A',C')` (extended to possibly unobservable pairs).

References:

[1] A. Varga.
    A Schur method for pole assignment.
    IEEE Trans. on Automatic Control, vol. 26, pp. 517-519, 1981.
"""
function salocd(A::AbstractMatrix, C::AbstractMatrix; disc::Bool = false,
                evals::Union{AbstractVector,Missing} = missing, sdeg::Union{Real,Missing} = missing,
                atol1::Real = zero(real(eltype(A))), atol2::Real = zero(real(eltype(C))),
                rtol::Real = ((size(A,1)+1)*eps(real(float(one(eltype(A))))))*iszero(max(atol1,atol2)))

   n = LinearAlgebra.checksquare(A)
   n == size(C,2) || throw(DimensionMismatch("A and C must have the same number of columns"))
   K, S, blkdims = saloc(copy(transpose(A)), copy(transpose(C)), evals = evals, sdeg = sdeg, disc = disc, atol1 = atol1, atol2 = atol2, rtol = rtol)
   return copy(transpose(K)), Schur(reverse(reverse(transpose(S.T),dims = 1),dims = 2), reverse(conj(S.Z),dims=2), reverse(S.values)), reverse(blkdims)
end
"""
    salocd(A, E, C; evals, sdeg, disc = false, atol1 = 0, atol2 = 0, atol3 = 0, rtol, sepinf = true, fast = true) -> (K, Scl, blkdims)

Compute for the pair `(A-λE,C)`, with `A-λE` a regular pencil, a matrix `K` such that all finite eigenvalues of the
pencil `A+K*C-λE` lie in the stability domain `Cs` specified by the stability degree parameter `sdeg` and stability type parameter `disc`.
If `disc = false`, `Cs` is the set of complex numbers with real parts at most `sdeg`, while if `disc = true`,
`Cs` is the set of complex numbers with moduli at most `sdeg` (i.e., the interior of a disc of radius `sdeg` centered in the origin).
`evals` is a real or complex vector, which contains a set of finite desired eigenvalues for the pencil `A+K*C-λE`.
For real data `A`, `E`, and `B`, `evals` must be a self-conjugated complex set to ensure that the resulting `F` is also a real matrix.

For a pair `(A-λE,C)` with `A` of order `n`, the number of assignable finite eigenvalues is `nfc := n-ninf-nfu`,
where `ninf` is the number of infinite eigenvalues of `A-λE` and `nfu` is the number of fixed finite eigenvalues of `A-λE`.
The assignable finite eigenvalues are called the _observable finite eigenvalues_,
while the fixed finite eigenvalues are called the _unobservable finite eigenvalues_ (these are the finite zeros of the pencil `[A-λE; C]`).
The spectrum allocation is achieved by successively replacing the observable finite eigenvalues of `A-λE` lying outside of the
stability domain `Cs` with eigenvalues provided in `evals`. All finite eigenvalues of `A-λE` lying in `Cs` are kept unalterred.
If the number of specified eigenvalues in `evals` is less than the number of observable finite eigenvalues of `A-λE` outside of `Cs`
(e.g., if `evals = missing`), then some of the observable finite eigenvalues of `A-λE` are assigned to the nearest values
on the boundary of `Cs`. If `sdeg = missing` and `evals = missing`, the default value used for `sdeg` is -0.05
if  `disc = false` and 0.95 if `disc = true`.

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`.

The keyword argument `sepinf` specifies the option for a preliminary separation
of the infinite eigenvalues of the pencil `A-λE` as follows: if `sepinf = false`, no separation of infinite eigenvalues is performed,
while for `sepinf = true` (the default option), a preliminary separation of the infinite eigenvalues from the finite ones is performed.
If `E` is nonsingular, then `sepinf = false` is recommended to be used. If `E` is numerically singular, then the option `sepinf = false` is used.
The separation of finite and infinite eigenvalues 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 resulting pencil `Acl-λEcl := Q'*(A+K*C-λE)*Z`,  where `Q` and `Z` are the
orthogonal/unitary matrices used to obtain the pair `(Acl,Ecl)` in a generalized Schur form (GSF), has the form

                ( Afu-λEfu    *        *       *    )
     Acl-λEcl = (   0      Afa-λEfa    *       *    )
                (   0         0     Afg-λEfg   *    )
                (   0         0        0     Ai-λEi )

where: `Afu-λEfu` contains `nfu` unobservable finite eigenvalues of `A-λE` lying outside `Cs`,
`Afa-λEfa` contains `nfa` assigned finite generalized eigenvalues in `Cs`,
`Afg-λEfg` contains `nfg` finite eigenvalues of `A-λE` in `Cs`, and
`Ai-λEi`, with `Ai` upper triangular and invertible and `Ei` upper triangular and nilpotent,
contains the `ninf` infinite eigenvalues of `A-λE`.
The matrices `Acl`, `Ecl`, `Q`, `Z` and the vectors `α` and `β` such that `α./β` are the generalized eigenvalues of
the pair `(Acl,Ecl)` are returned in `GeneralizeSchur` object `Scl`.
The values of `nfu`, `nfa`, `nfg` and `ninf` and are returned in the 4-dimensional vector `blkdims = [nfu, nfa, nfg, ninf]`.

Method:  For a pair `(A-λE,C)` with `E = I`, the dual Schur method of [1] is used, while for a general pair `(A-λE,C)` the dual generalized Schur method of [2]
is used to solve the R-stabilzation problem of [2] for the dual pair `(A'-λE',C')`.

References:

[1] A. Varga.
    A Schur method for pole assignment.
    IEEE Trans. on Automatic Control, vol. 26, pp. 517-519, 1981.

[2] A. Varga.
    On stabilization methods of descriptor systems.
    Systems & Control Letters, vol. 24, pp.133-138, 1995.
"""
function salocd(A::AbstractMatrix, E::Union{AbstractMatrix,UniformScaling{Bool}}, C::AbstractMatrix; disc::Bool = false,
                evals::Union{AbstractVector,Missing} = missing, sdeg::Union{Real,Missing} = missing,
                atol1::Real = zero(real(eltype(A))), atol2::Real = zero(real(eltype(A))), atol3::Real = zero(real(eltype(C))),
                rtol::Real = ((size(A,1)+1)*eps(real(float(one(eltype(A))))))*iszero(max(atol1,atol2,atol3)),
                fast::Bool = true, sepinf::Bool = true)

   n = LinearAlgebra.checksquare(A)
   E == I || LinearAlgebra.checksquare(E) == n || throw(DimensionMismatch("E must be a $n x $n matrix"))

   n == size(C,2) || throw(DimensionMismatch("A and C must have the same number of columns"))
   K, S, blkdims = saloc(copy(transpose(A)), copy(transpose(E)), copy(transpose(C)), evals = evals, sdeg = sdeg, disc = disc, atol1 = atol1, atol2 = atol2, atol3 = atol3, sepinf = sepinf, fast = fast, rtol = rtol)
   return copy(transpose(K)), GeneralizedSchur(reverse(reverse(transpose(S.S),dims = 1),dims = 2), reverse(reverse(transpose(S.T),dims = 1),dims = 2),
                                                  reverse(S.α), reverse(S.β), reverse(conj(S.Z),dims=2), reverse(conj(S.Q),dims=2)), reverse(blkdims)
end
"""
    saloc(A, B; evals, sdeg, disc = false, atol1 = 0, atol2 = 0, rtol) -> (F, Scl, blkdims)

Compute for the pair `(A,B)`, a matrix `F` such that all eigenvalues of the matrix `A+B*F` lie in the stability domain `Cs`
specified by the stability degree parameter `sdeg` and stability type parameter `disc`.
If `disc = false`, `Cs` is the set of complex numbers with real parts at most `sdeg`, while if `disc = true`,
`Cs` is the set of complex numbers with moduli at most `sdeg` (i.e., the interior of a disc of radius `sdeg` centered in the origin).
`evals` is a real or complex vector, which contains the desired eigenvalues of the matrix `A+B*F` within `Cs`.
For real data `A` and `B`, `evals` must be a self-conjugated complex set to ensure that the resulting `F` is also a real matrix.

For a pair `(A,B)` with `A` of order `n`, the number of assignable eigenvalues is `nc := n-nu`,
where `nu` is the number of fixed eigenvalues of `A`. The assignable eigenvalues are called the controllable eigenvalues,
while the fixed eigenvalues are called the _uncontrollable eigenvalues_ (these are the zeros of the pencil `[A-λI B]`).
The spectrum allocation is achieved by successively replacing the _controllable eigenvalues_ of `A` lying outside of the
stability domain `Cs` with eigenvalues provided in `evals`. All eigenvalues of `A` lying in `Cs` are kept unalterred.
If the number of specified eigenvalues in `evals` is less than the number of controllable eigenvalues of `A` outside of `Cs`
(e.g., if `evals = missing`), then some of the controllable eigenvalues of `A` are assigned to the nearest values
on the boundary of `Cs`. If `sdeg = missing` and `evals = missing`, the default value used for `sdeg` is -0.05
if  `disc = false` and 0.95 if `disc = true`.

The keyword arguments `atol1`, `atol2`, and `rtol`, specify, respectively, the absolute tolerance for the
nonzero elements of `A`, the absolute tolerance for the nonzero elements of `B`,
and the relative tolerance for the nonzero elements of `A` and `B`.
The default relative tolerance is `n*ϵ`, where `ϵ` is the machine epsilon of the element type of `A`.

The resulting matrix `Acl := Z'*(A+B*F)*Z` in a Schur form, where `Z` is the orthogonal/unitary matrix used
to obtain the matrix `A+B*F` in Schur form, has the form

           ( Ag  *   *  )
     Acl = ( 0   Aa  *  )
           ( 0   0   Au )

where:  `Ag` contains the `ng` eigenvalues of `A` in `Cs`, `Aa` contains the `na` assigned eigenvalues in `Cs` and
`Au` contains `nu` uncontrollable eigenvalues of `A` lying outside `Cs`.
The matrices `Acl` and `Z` and the vector `α` of eigenvalues of `Acl` (also of `A+B*F`)
are returned in the `Schur` object `Scl`.
The values of `ng`, `na` and `nu` are returned in the 3-dimensional vector `blkdims = [ng, na, nu]`.

Method:  The Schur method of [1], extended to possibly uncontrollable pairs, is employed.

References:

[1] A. Varga.
    A Schur method for pole assignment.
    IEEE Trans. on Automatic Control, vol. 26, pp. 517-519, 1981.
"""
function saloc(A::AbstractMatrix, B::AbstractMatrix; disc::Bool = false,
               evals::Union{AbstractVector,Missing} = missing, sdeg::Union{Real,Missing} = missing,
               atol1::Real = zero(real(eltype(A))), atol2::Real = zero(real(eltype(B))),
               rtol::Real = ((size(A,1)+1)*eps(real(float(one(eltype(A))))))*iszero(max(atol1,atol2)))
   n = LinearAlgebra.checksquare(A)
   n1, m = size(B)
   n == n1 || throw(DimensionMismatch("A and B must have the same number of rows"))

   T = promote_type( eltype(A), eltype(B) )
   T <: BlasFloat || (T = promote_type(Float64,T))

   A1 = copy_oftype(A,T)
   B1 = copy_oftype(B,T)
   if ismissing(evals)
      evals1 = evals
   else
      T1 = promote_type(T,eltype(evals))
      evals1 = copy_oftype(evals,T1)
   end

   # quick exit if possible
   n == 0 && (return zeros(T,m,n), schur(zeros(T,n,n)), zeros(Int,4))

   ZERO = zero(T)

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

   # return if B = 0
   ilob > n && (return zeros(T,m,n), schur(A1), [0,0,n] )

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

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

   complx = (T <: 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

   # set default values of sdeg if evals = missing
   if ismissing(sdeg)
      if ismissing(evals1)
        sdeg = disc ? real(T)(0.95) : real(T)(-0.05)
        smarg = sdeg;
      else
         smarg = disc ? real(T)(0) : real(T)(-Inf)
      end
   else
      sdeg = real(T)(sdeg)
      disc && sdeg < 0 && error("sdeg must be non-negative if disc = true")
      smarg = sdeg;
   end

   nrmA = opnorm(A1,1)
   tola = max(atol1, rtol*nrmA)
   tolb = max(atol2, rtol*nrmB)

   #
   # 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', A1)

   if disc
      select = Int.(abs.(α) .<= smarg)
   else
      select = Int.(real.(α) .<= smarg)
   end
   _, _, α = LAPACK.trsen!(select, A1, Z)
   nb = length(select[select .== 0])

   ng = n-nb
   fnrmtol = 1000*nrmA/nrmB
   fnrmtol == 0 && (fnrmtol = 1000/nrmB)

   nu = 0; na = 0
   nc = n
   F = zeros(T,m,n);
   ia = n-nb+1
   ihf = 0
   while nb > 0
      noskip = true
      if nb == 1 || complx || A1[nc,nc-1] == 0
         k = 1
      else
         k = 2
      end
      kk = nc-k+1:nc
      a2 = view(A1,kk,kk)
      evb = ordeigvals(a2)
      b2 = view(Z,ib,kk)'*view(B1,ib,:)
      if norm(b2,Inf) <= tolb
         # deflate uncontrollable block
         nb = nb-k; nc = nc-k; nu = nu+k; noskip = false
      elseif k == 1 && nb > 1 && ismissing(evalsr) && !ismissing(evalsc)
         # form a 2x2 block if there are no real eigenvalues to assign
         k = 2
         kk = nc-k+1:nc
         a2 = view(A1,kk,kk)
         if nb > 2 && A1[nc-1,nc-2] != ZERO
            # interchange last two blocks
            LAPACK.trexc!('V', nc, nc-2, A1, Z)
            evb = ordeigvals(a2)
         else
            evb = disc ? maximum(abs.(ordeigvals(a2))) : maximum(real(ordeigvals(a2)))
         end
         b2 = view(Z,ib,kk)'*view(B1,ib,:)
         if norm(b2,Inf) <= tolb
            # deflate uncontrollable block
            nb = nb-k; nc = nc-k; nu = nu+k; noskip = false
         end
      end
      if noskip
         if k == 1
            # assign a single eigenvalue
            γ, evalsr = eigselect1(evalsr, sdeg, complx ? evb[1] : real(evb[1]), disc; cflag = complx);
            if γ === nothing
                # no real eigenvalue available, adjoin a new 1x1 block if possible
                if nb == 1
                    # incompatible eigenvalues with the eigenvalue structure
                    # assign the last real pole to the default value of sdeg
                    γ = disc ? real(T)(0.95) : real(T)(-0.05)
                    f2 = -b2\(a2-I*γ)
                 else
                    # adjoin a real block or interchange the last two blocks
                    k = 2; kk = nc-1:nc;
                    a2 = view(A1,kk,kk)
                    if nb > 2 && A1[nc-1,nc-2] != ZERO
                       # interchange last two blocks
                       LAPACK.trexc!('V', nc, nc-2, A1, Z)
                       # update evb
                       evb = ordeigvals(a2)
                    else
                       # update evb
                       evb = disc ? maximum(abs.(ordeigvals(a2))) : maximum(real(ordeigvals(a2)))
                    end
                    b2 = view(Z,ib,kk)'*view(B1,ib,:)
                end
            else
               f2 = -b2\(a2-I*γ);
            end
         end
         if k == 2
            # assign a pair of eigenvalues
            γ, evalsr, evalsc = eigselect2(evalsr,evalsc,sdeg,evb[end],disc)
            f2, u = saloc2(a2,b2,γ,tola,tolb)
            if f2 === nothing  # the case b2 = 0 can not occur
               irow = 1:nc; jcol = nc-1:n;
               A1[kk,jcol] = u'*view(A1,kk,jcol); A1[irow,kk] = view(A1,irow,kk)*u;
               A1[nc,nc-1] = ZERO
               Z[:,kk] = view(Z,:,kk)*u
               nb -= 1; nc -= 1; nu += 1;
               # recover the failed selection
               imag(γ[1]) == 0 ? (ismissing(evalsr) ? evalsr = γ : evalsr = [γ; evalsr]) : (ismissing(evalsc) ? evalsc = γ : evalsc = [γ; evalsc])
            end
         end
         if f2 !== nothing
            # check for numerical stability
            norm(f2,Inf) > fnrmtol && (ihf += 1)
            X = view(B1,ib,:)*f2
            A1[1:nc,kk] += view(Z,ib,1:nc)'*X
            F += f2*view(Z,:,kk)'
            if k == 2
               # standardization step is necessary to use trexc
               i1 = 1:nc-2; lcol = nc+1:n;
               # alternative computation
               # k1 = kk[1]; k2 = kk[2]
               # RT1R, RT1I, RT2R, RT2I, CS, SN = lanv2(A1[k1,k1], A1[k1,k2], A1[k2,k1], A1[k2,k2])
               _, Z2, _ = LAPACK.gees!('V', a2)
               A1[i1,kk] = view(A1,i1,kk)*Z2
               A1[kk,lcol] = Z2'*view(A1,kk,lcol)
               Z[:,kk] = view(Z,:,kk)*Z2;
               tworeals = (A1[nc,nc-1] == ZERO)
            else
               tworeals = false
            end
            # reorder eigenvalues
            if nb > k
               try
                  LAPACK.trexc!('V', nc-k+1, ia, A1, Z)
                  tworeals && LAPACK.trexc!('V', nc, ia+1, A1, Z)
               catch
               end
            end
            nb -= k
            ia += k
            na += k
         end
      end
   end
   ihf > 0 && @warn("Possible loss of numerical reliability due to high feedback gain")
   blkdims = [ng, na, nu]
   return F, Schur(A1, Z, ordeigvals(A1)), blkdims

   # end saloc
end
"""
    saloc(A, E, B; evals, sdeg, disc = false, atol1 = 0, atol2 = 0, atol3 = 0, rtol, sepinf = true, fast = true) -> (F, Scl, blkdims)

Compute for the pair `(A-λE,B)`, with `A-λE` a regular pencil, a matrix `F` such that all finite eigenvalues of the
pencil `A+B*F-λE` lie in the stability domain `Cs` specified by the stability degree parameter `sdeg` and stability type parameter `disc`.
If `disc = false`, `Cs` is the set of complex numbers with real parts at most `sdeg`, while if `disc = true`,
`Cs` is the set of complex numbers with moduli at most `sdeg` (i.e., the interior of a disc of radius `sdeg` centered in the origin).
`evals` is a real or complex vector, which contains a set of finite desired eigenvalues for the pencil `A+B*F-λE`.
For real data `A`, `E`, and `B`, `evals` must be a self-conjugated complex set to ensure that the resulting `F` is also a real matrix.

For a pair `(A-λE,B)` with `A` of order `n`, the number of assignable finite eigenvalues is `nfc := n-ninf-nfu`,
where `ninf` is the number of infinite eigenvalues of `A-λE` and `nfu` is the number of fixed finite eigenvalues of `A-λE`.
The assignable finite eigenvalues are called the _controllable finite eigenvalues_,
while the fixed finite eigenvalues are called the _uncontrollable finite eigenvalues_ (these are the finite zeros of the pencil `[A-λE B]`).
The spectrum allocation is achieved by successively replacing the controllable finite eigenvalues of `A-λE` lying outside of the
stability domain `Cs` with eigenvalues provided in `evals`. All finite eigenvalues of `A-λE` lying in `Cs` are kept unalterred.
If the number of specified eigenvalues in `evals` is less than the number of controllable finite eigenvalues of `A-λE` outside of `Cs`
(e.g., if `evals = missing`), then some of the controllable finite eigenvalues of `A-λE` are assigned to the nearest values
on the boundary of `Cs`. If `sdeg = missing` and `evals = missing`, the default value used for `sdeg` is -0.05
if  `disc = false` and 0.95 if `disc = true`.

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`.

The keyword argument `sepinf` specifies the option for a preliminary separation
of the infinite eigenvalues of the pencil `A-λE` as follows: if `sepinf = false`, no separation of infinite eigenvalues is performed,
while for `sepinf = true` (the default option), a preliminary separation of the infinite eigenvalues from the finite ones is performed.
If `E` is nonsingular, then `sepinf = false` is recommended to be used. If `E` is numerically singular, then the option `sepinf = false` is used.
The separation of finite and infinite eigenvalues 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 resulting pencil `Acl-λEcl := Q'*(A+B*F-λE)*Z`,  where `Q` and `Z` are the
orthogonal/unitary matrices used to obtain the pair `(Acl,Ecl)` in a generalized Schur form (GSF), has the form

                ( Ai-λEi    *        *       *      )
     Acl-λEcl = (   0    Afg-λEfg    *       *      )
                (   0       0     Afa-λEfa   *      )
                (   0       0        0     Afu-λEfu )

where: `Ai-λEi` with `Ai` upper triangular and invertible and `Ei` upper triangular and nilpotent, contains the `ninf` infinite eigenvalues of `A-λE`;
`Afg-λEfg` contains `nfg` finite eigenvalues of `A-λE` in `Cs`; `Afa-λEfa` contains `nfa` assigned finite generalized eigenvalues in `Cs`;
and `Afu-λEfu` contains `nfu` uncontrollable finite eigenvalues of `A-λE` lying outside `Cs`.
The matrices `Acl`, `Ecl`, `Q`, `Z` and the vectors `α` and `β` such that `α./β` are the generalized eigenvalues of
the pair `(Acl,Ecl)` are returned in the `GeneralizeSchur` object `Scl`.
The values of `ninf`, `nfg`, `nfa` and `nfu` are returned in the 4-dimensional vector `blkdims = [ninf, nfg, nfa, nfu]`.

Method:  For a pair `(A-λE,B)` with `E = I`, the Schur method of [1] is used, while for a general pair `(A-λE,B)` the generalized Schur method of [2]
is used to solve the R-stabilzation problem.

References:

[1] A. Varga.
    A Schur method for pole assignment.
    IEEE Trans. on Automatic Control, vol. 26, pp. 517-519, 1981.

[2] A. Varga.
    On stabilization methods of descriptor systems.
    Systems & Control Letters, vol. 24, pp.133-138, 1995.

"""
function saloc(A::AbstractMatrix, E::Union{AbstractMatrix,UniformScaling{Bool}}, B::AbstractMatrix;
                  disc::Bool = false, evals::Union{AbstractVector,Missing} = missing, sdeg::Union{Real,Missing} = missing,
                  atol1::Real = zero(real(eltype(A))), atol2::Real = zero(real(eltype(A))), atol3::Real = zero(real(eltype(B))),
                  rtol::Real = ((size(A,1)+1)*eps(real(float(one(eltype(A))))))*iszero(max(atol1,atol2,atol3)),
                  fast::Bool = true, sepinf::Bool = true)

   n = LinearAlgebra.checksquare(A)
   if E == I
      F, S, blkdims = saloc(A, B, evals = evals, sdeg = sdeg, atol1 = atol1, atol2 = atol3, rtol = rtol)
      TS = eltype(F)
      return F, GeneralizedSchur(S.T, Matrix{TS}(I,n,n), S.values, ones(TS,n), S.Z, S.Z), [[0]; blkdims]
   end

   LinearAlgebra.checksquare(E) == n || throw(DimensionMismatch("E must be a $n x $n matrix"))

   n1, m = size(B)
   n == n1 || throw(DimensionMismatch("A and B must have the same number of rows"))

   T = promote_type( eltype(A), eltype(B), eltype(E) )
   T <: BlasFloat || (T = promote_type(Float64,T))

   A1 = copy_oftype(A,T)
   E1 = copy_oftype(E,T)
   B1 = copy_oftype(B,T)
   if ismissing(evals)
      evals1 = evals
   else
      T1 = promote_type(T,eltype(evals))
      evals1 = copy_oftype(evals,T1)
   end

   # quick exit for n = 0 or B = 0

   # the following is not working for 0 dimensions
   # n == 0 || (return zeros(T,m,n), schur(zeros(T,n,n), ones(T,n,n)), zeros(T,n,m), zeros(Int,4))
   n == 0 && (return zeros(T,m,n), GeneralizedSchur(zeros(T,n,n),zeros(T,n,n),zeros(T,n),zeros(T,n),zeros(T,n,n),zeros(T,n,n)), zeros(Int,4))

   ZERO = zero(T)

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

   # return if B = 0
   ilob > n && (return zeros(T,m,n), schur(A1,E1), [0, 0, 0, n] )

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

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

   complx = (T <: 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

   # set default values of sdeg if evals = missing
   if ismissing(sdeg)
      if ismissing(evals1)
         sdeg = disc ? real(T)(0.95) : real(T)(-0.05)
         smarg = sdeg;
      else
         smarg = disc ? real(T)(0) : real(T)(-Inf)
      end
   else
      sdeg = real(T)(sdeg)
      disc && sdeg < 0 && error("sdeg must be non-negative if disc = true")
      smarg = sdeg;
   end

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

   Q = Matrix{T}(I,n,n)
   Z = Matrix{T}(I,n,n)

   if !sepinf
      # reduce (A,E) to generalized Schur form
      istriu(E1) ||  _qrE!(A1, E1, Q, missing; withQ = true)
      rcond = LAPACK.trcon!('1','U','N',E1)
      if rcond < eps(real(T))
         @warn("E is numerically singular: computations resumed with sepinf = true")
         sepinf = true
         A1 = copy_oftype(A,T)
         E1 = copy_oftype(E,T)
         Q = Matrix{T}(I,n,n)
      else
         gghrd!('V','V',1, n, A1, E1, Q, Z)
         _, _, α, β, _, _ = hgeqz!('V','V',1, n, A1, E1, Q, Z)
         ninf = 0
         if disc
            select = Int.((abs.(α) .<= smarg*abs.(β)))
         else
            select = Int.((real.(α ./ β) .< smarg))
         end
      end
   end

   if sepinf
      _, blkdims = fisplit!(A1, E1, Q, Z, missing, missing; fast = fast, atol1 = atol1, atol2 = atol2, rtol = rtol, withQ = true, withZ = true)
      ninf = blkdims[1]
      ilo = ninf+1;
      gghrd!('V','V',ilo, n, A1, E1, Q, Z)
      _, _, α, β, _, _ = hgeqz!('V','V',ilo, n, A1, E1, Q, Z)
      i2 = ilo:n
      if disc
         select2 = Int.(abs.(α[i2]) .<= smarg*abs.(β[i2]))
      else
         select2 = Int.(real.(α[i2] ./ β[i2]) .< smarg)
      end
      select = [ones(Int,ninf);select2]
   end

   # separate stable and unstable eigenvalues

   # compute orthogonal Q and Z such that
   #
   #                   [ Ai-λEi   *      *    ]
   #      Q*(A-λE)*Z = [   0    Ag-λEg   *    ]
   #                   [   0      0    Ab-λEb ]
   #
   # where Ag-λEg has eigenvalues within the stability degree region
   # and Ab-λEb has eigenvalues outside the stability degree region.

   _, _, α, β, _, _ = LAPACK.tgsen!(select, A1, E1, Q, Z)
   nb = length(select[select .== 0])

   nfg = n-nb-ninf
   fnrmtol = 1000*max(nrmA,1)/nrmB

   nfu = 0; nfa = 0
   nc = n
   F = zeros(T,m,n);
   ia = n-nb+1
   ihf = 0
   while nb > 0
      noskip = true
      if nb == 1 || complx || A1[nc,nc-1] == 0
         k = 1
      else
         k = 2
      end
      kk = nc-k+1:nc
      a2 = view(A1,kk,kk)
      e2 = view(E1,kk,kk)
      evb, = ordeigvals(a2,e2)
      b2 = view(Q,ib,kk)'*view(B1,ib,:)
      if norm(b2,Inf) <= tolb
         # deflate uncontrollable stable block
         nb = nb-k; nc = nc-k; nfu = nfu+k; noskip = false
      elseif k == 1 && nb > 1 && ismissing(evalsr) && !ismissing(evalsc)
         # form a 2x2 block if there are no real no real eigenvalues to assign
         k = 2
         kk = nc-k+1:nc
         a2 = view(A1,kk,kk)
         e2 = view(E1,kk,kk)
         if nb > 2 && A1[nc-1,nc-2] != ZERO
            # interchange last two blocks
            tgexc!(true, true, nc, nc-2, A1, E1, Q, Z)
            evb, = ordeigvals(a2,e2)
         else
            evb = disc ? maximum(abs.(ordeigvals(a2,e2)[1])) : maximum(real(ordeigvals(a2,e2)[1]))
         end
         b2 = view(Q,ib,kk)'*view(B1,ib,:)
         if norm(b2,Inf) <= tolb
            # deflate uncontrollable block
            nb = nb-k; nc = nc-k; nfu = nfu+k; noskip = false
         end
      end
      if noskip
         if k == 1
            # assign a single eigenvalue
            γ, evalsr = eigselect1(evalsr, sdeg, complx ? evb[1] : real(evb[1]), disc; cflag = complx);
            if γ === nothing
                # no real pole available, adjoin a new 1x1 block if possible
                if nb == 1
                    # incompatible eigenvalues with the eigenvalue structure
                    # assign the last real pole to the default value of sdeg
                    γ = disc ? real(T)(0.95) : real(T)(-0.05)
                    f2 = -b2\(a2-e2*γ)
                else
                    # adjoin a real block or interchange the last two blocks
                    k = 2; kk = nc-k+1:nc;
                    a2 = view(A1,kk,kk)
                    e2 = view(E1,kk,kk)
                    if nb > 2 && A1[nc-1,nc-2] != ZERO
                       # interchange last two blocks
                       tgexc!(true, true, nc, nc-2, A1, E1, Q, Z)
                    end
                    # update evb
                    evb = maximum(real(ordeigvals(a2,e2)[1]))
                    b2 = view(Q,ib,kk)'*view(B1,ib,:)
                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
               irow = 1:nc; jcol = nc-1:n;
               A1[kk,jcol] = u'*view(A1,kk,jcol); A1[irow,kk] = view(A1,irow,kk)*v;
               A1[nc,nc-1] = ZERO
               E1[kk,jcol] = u'*view(E1,kk,jcol); E1[irow,kk] = view(E1,irow,kk)*v;
               E1[nc,nc-1] = ZERO
               Q[:,kk] = view(Q,:,kk)*u;
               Z[:,kk] = view(Z,:,kk)*v;
               nb -= 1; nc -= 1; nfu += 1
               # recover the failed selection
               imag(γ[1]) == 0 ? (ismissing(evalsr) ? evalsr = γ : evalsr = [γ; evalsr]) : (ismissing(evalsc) ? evalsc = γ : evalsc = [γ; evalsc])
            end
         end
         if f2 !== nothing
            norm(f2,Inf) > fnrmtol && (ihf += 1)
            # update matrices Acl and F
            X = view(B1,ib,:)*f2
            A1[1:nc,kk] += view(Q,ib,1:nc)'*X
            F += f2*view(Z,:,kk)'
            if k == 2
               # standardization step is necessary to use tgsen
               i1 = 1:nc-2; lcol = nc+1:n;
               _, _, _, _, Q2, Z2 = LAPACK.gges!('V','V',a2,e2)
               A1[i1,kk] = view(A1,i1,kk)*Z2
               E1[i1,kk] = view(E1,i1,kk)*Z2
               A1[kk,lcol] = Q2'*view(A1,kk,lcol)
               E1[kk,lcol] = Q2'*view(E1,kk,lcol)
               Q[:,kk] = view(Q,:,kk)*Q2;
               Z[:,kk] = view(Z,:,kk)*Z2;
               tworeals = (A1[nc,nc-1] == 0)
            else
               tworeals = false
            end
            # reorder eigenvalues
            if nb > k
               tgexc!(true, true, nc-k+1, ia, A1, E1, Q, Z)
               tworeals && tgexc!(true, true, nc, ia+1, A1, E1, Q, Z)
            end
            nb -= k
            ia += k
            nfa += k
         end
      end
   end
   ihf > 0 && @warn("Possible loss of numerical reliability due to high feedback gain")
   blkdims = [ninf, nfg, nfa, nfu]
   _, α, β = ordeigvals(A1,E1)
   return F, GeneralizedSchur(A1, E1, α, β, Q, Z), blkdims

   # end saloc
end
"""
    salocinfd(A, E, C; atol1 = 0, atol2 = 0, atol3 = 0, rtol, sepinf = true, fast = true) -> (K, L, Scl, blkdims)

Compute for the pair `(A-λE,C)`, with `A-λE` a regular pencil, the matrices `K` and `L` such that all eigenvalues of the
pencil `A+K*C-λ(E+L*C)` are infinite. For a pair `(A-λE,C)` with fixed (unobservable) finite eigenvalues, only the assignable (observable)
finite eigenvalues are moved to infinity.

For a pair `(A-λE,C)` with `A` of order `n`, the number of assignable infinite eigenvalues is `nia := n-ninf-nfu`,
where `ninf` is the number of infinite eigenvalues of `A-λE` and `nfu` is the number of fixed finite eigenvalues of `A-λE`.
The assignable finite eigenvalues are called the _observable finite eigenvalues_,
while the fixed finite eigenvalues are called the _unobservable finite eigenvalues_ (these are the finite zeros of the pencil `[A-λE; C]`).
The spectrum allocation is achieved by successively replacing the observable finite eigenvalues of `A-λE` with infinite eigenvalues.
 All infinite eigenvalues of `A-λE` are kept unalterred.

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`.

The preliminary separation of finite and infinite eigenvalues 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 resulting pencil `Acl-λEcl := Q'*(A+K*C-λ(E+L*C))*Z`,  where `Q` and `Z` are the
orthogonal/unitary matrices used to obtain the pair `(Acl,Ecl)` in a generalized Schur form (GSF), has the form

                ( Afu-λEfu    *        *     )
     Acl-λEcl = (   0      Aia-λEia    *     )
                (   0         0     Aig-λEig )

where: `Afu-λEfu`, with the pair `(Afu,Efu)` in a generalized Schur form,  contains `nfu` fixed (unobservable) finite eigenvalues of `A-λE`,
`Aia-λEia`, with `Aia` upper triangular and invertible and `Eia` upper triangular and nilpotent, contains `nia` assigned infinite generalized eigenvalues;
`Aig-λEig`, with `Aig` upper triangular and invertible and `Eig` upper triangular and nilpotent, contains the `ninf` infinite eigenvalues of `A-λE`.
The matrices `Acl`, `Ecl`, `Q`, `Z` and the vectors `α` and `β` such that `α./β` are the generalized eigenvalues of
the pair `(Acl,Ecl)` are returned in the `GeneralizeSchur` object `Scl`.
The values of `nfu`, `nia` and `ninf` and are returned in the 3-dimensional vector `blkdims = [nfu, nia, ninf]`.

Method:  For a general pair `(A-λE,C)` the dual of the modified generalized Schur method of [1] is used to determine `K` and `L` such that the pair
`(A+K*C,E+L*G)` has only infinite eigenvalues.

References:

[1] A. Varga.
    On stabilization methods of descriptor systems.
    Systems & Control Letters, vol. 24, pp.133-138, 1995.
"""
function salocinfd(A::AbstractMatrix, E::AbstractMatrix, C::AbstractMatrix; fast::Bool = true,
                atol1::Real = zero(real(eltype(A))), atol2::Real = zero(real(eltype(A))), atol3::Real = zero(real(eltype(C))),
                rtol::Real = ((size(A,1)+1)*eps(real(float(one(eltype(A))))))*iszero(max(atol1,atol2,atol3)) )

   n = LinearAlgebra.checksquare(A)
   LinearAlgebra.checksquare(E) == n || throw(DimensionMismatch("E must be a $n x $n matrix"))

   n == size(C,2) || throw(DimensionMismatch("A and C must have the same number of columns"))
   K, L, S, blkdims = salocinf(copy(transpose(A)), copy(transpose(E)), copy(transpose(C)), atol1 = atol1, atol2 = atol2, atol3 = atol3, fast = fast, rtol = rtol)
   #return reverse(transpose(K), dims = 2), reverse(transpose(L), dims = 2),
   #return reverse(transpose(K), dims = 1), reverse(transpose(L), dims = 1),
   return copy(transpose(K)), copy(transpose(L)),
          GeneralizedSchur(reverse(reverse(transpose(S.S),dims = 1),dims = 2), reverse(reverse(transpose(S.T),dims = 1),dims = 2),
                           reverse(S.α), reverse(S.β), reverse(conj(S.Z),dims=2), reverse(conj(S.Q),dims=2)),
          reverse(blkdims)
end
"""
    salocinf(A, E, B; atol1 = 0, atol2 = 0, atol3 = 0, rtol, fast = true) -> (F, G, Scl, blkdims)

Compute for the controllable pair `(A-λE,B)`, with `A-λE` a regular pencil, two matrices `F` and `G` such that all eigenvalues of the
pencil `A+B*F-λ(E+B*G)` are infinite. For a pair `(A-λE,B)` with fixed (uncontrollable) finite eigenvalues, only the assignable (controllable)
 finite eigenvalues are moved to infinity.

For a pair `(A-λE,B)` with `A` of order `n`, the number of assignable infinite eigenvalues is `nia := n-ninf-nfu`,
where `ninf` is the number of infinite eigenvalues of `A-λE` and `nfu` is the number of fixed finite eigenvalues of `A-λE`.
The assignable finite eigenvalues are called the _controllable finite eigenvalues_,
while the fixed finite eigenvalues are called the _uncontrollable finite eigenvalues_ (these are the finite zeros of the pencil `[A-λE B]`).
The spectrum allocation is achieved by successively replacing the controllable finite eigenvalues of `A-λE` with infinite eigenvalues.
 All infinite eigenvalues of `A-λE` are kept unalterred.

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`.

The preliminary separation of finite and infinite eigenvalues 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 resulting pencil `Acl-λEcl := Q'*(A+B*F-λ(E+B*G))*Z`,  where `Q` and `Z` are the
orthogonal/unitary matrices used to obtain the pair `(Acl,Ecl)` in a generalized Schur form (GSF), has the form

                ( Aig-λEig    *        *     )
     Acl-λEcl = (   0      Aia-λEia    *     )
                (   0         0     Afu-λEfu )

where: `Aig-λEig` with `Aig` upper triangular and invertible and `Eig` upper triangular and nilpotent, contains the `ninf` infinite eigenvalues of `A-λE`;
`Aia-λEia`, with `Aia` upper triangular and invertible and `Eia` upper triangular and nilpotent, contains `nia` assigned infinite generalized eigenvalues;
and `Afu-λEfu`, with the pair `(Afu,Efu)` in a generalized Schur form,  contains `nfu` fixed (uncontrollable) finite eigenvalues of `A-λE`.
The matrices `Acl`, `Ecl`, `Q`, `Z` and the vectors `α` and `β` such that `α./β` are the generalized eigenvalues of
the pair `(Acl,Ecl)` are returned in the `GeneralizeSchur` object `Scl`.
The values of `ninf`, `nia` and `nfu` are returned in the 3-dimensional vector `blkdims = [ninf, nia, nfu]`.

Method:  For a general pair `(A-λE,B)` the modified generalized Schur method of [1] is used to determine `F` and `G` such that the pair
`(A+B*F,E+B*G)` has only infinite eigenvalues.

References:

[1] A. Varga.
    On stabilization methods of descriptor systems.
    Systems & Control Letters, vol. 24, pp.133-138, 1995.
"""
function salocinf(A::AbstractMatrix, E::AbstractMatrix, B::AbstractMatrix;
                  atol1::Real = zero(real(eltype(A))), atol2::Real = zero(real(eltype(A))), atol3::Real = zero(real(eltype(B))),
                  rtol::Real = ((size(A,1)+1)*eps(real(float(one(eltype(A))))))*iszero(max(atol1,atol2,atol3)),
                  fast::Bool = true)

   n = LinearAlgebra.checksquare(A)

   LinearAlgebra.checksquare(E) == n || throw(DimensionMismatch("E must be a $n x $n matrix"))

   n1, m = size(B)
   n == n1 || throw(DimensionMismatch("A and B must have the same number of rows"))

   T = promote_type( eltype(A), eltype(B), eltype(E) )
   T <: BlasFloat || (T = promote_type(Float64,T))

   A1 = copy_oftype(A,T)
   E1 = copy_oftype(E,T)
   B1 = copy_oftype(B,T)

   # quick exit for n = 0 or B = 0

   # the following is not working for 0 dimensions
   # n == 0 || (return zeros(T,m,n), schur(zeros(T,n,n), ones(T,n,n)), zeros(T,n,m), zeros(Int,4))
   n == 0 && (return zeros(T,m,n), zeros(T,m,n), GeneralizedSchur(zeros(T,n,n),zeros(T,n,n),zeros(T,n),zeros(T,n),zeros(T,n,n),zeros(T,n,n)), zeros(Int,3))

   ZERO = zero(T)

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

   # return if B = 0
   ilob > n && (return zeros(T,m,n), zeros(T,m,n), schur(A1,E1), [0, 0, n] )

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

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

   complx = (T <: Complex)

   nrmA = opnorm(A1,1)
   nrmE = opnorm(E1,1)
   tola = max(atol1, rtol*nrmA)
   tole = max(atol2, rtol*nrmE)
   tolb = max(atol3, rtol*nrmB)

   Q = Matrix{T}(I,n,n)
   Z = Matrix{T}(I,n,n)

   _, blkdims = fisplit!(A1, E1, Q, Z, missing, missing; fast = fast, atol1 = atol1, atol2 = atol2, rtol = rtol, withQ = true, withZ = true)
   ninf = blkdims[1]
   ilo = ninf+1;
   gghrd!('V','V',ilo, n, A1, E1, Q, Z)
   _, _, α, β, _, _ = hgeqz!('V','V',ilo, n, A1, E1, Q, Z)
   i2 = ilo:n

   nb = n-ninf
   fnrmtol = 1000*max(nrmA,nrmE,1)/nrmB
   scale = max(nrmA,1)/10

   nfu = 0; nia = 0
   nc = n
   F = zeros(T,m,n);
   G = zeros(T,m,n);
   ia = ninf+1
   ihf = 0

   while nb > 0
      noskip = true
      if nb == 1 || complx || A1[nc,nc-1] == 0
         k = 1
      else
         k = 2
      end
      kk = nc-k+1:nc
      a2 = view(A1,kk,kk)
      e2 = view(E1,kk,kk)
      b2 = view(Q,ib,kk)'*view(B1,ib,:)
      if norm(b2,Inf) <= tolb
         # deflate uncontrollable block
         nb = nb-k; nc = nc-k; nfu = nfu+k; noskip = false
      else
         # perturb a2 such that a2+b2*f2 is sufficiently nonzero
         if maximum(abs.(a2)) < maximum(abs.(e2)) /10000 || rank(a2,atol=tola) < k
            f2 = lmul!(scale/nrmB,rand(T,m,k).+1)
            # update A and F
            X = view(B1,ib,:)*f2
            A1[1:nc,kk] += view(Q,ib,1:nc)'*X
            F += f2*view(Z,:,kk)'
         end
         if k == 1
            # assign a single infinite eigenvalue
            g2 = -b2\e2
            X = view(B1,ib,:)*g2
            E1[1:nc,kk] += view(Q,ib,1:nc)'*X
            G += g2*view(Z,:,kk)'
            # reorder eigenvalues
            if nb > k
               tgexc!(true, true, nc-k+1, ia, A1, E1, Q, Z)
            end
            E1[ia,ia] = ZERO
         else
            # assign two infinite eigenvalues
            g2,  = saloc2(e2,a2,b2,zeros(T,2),tole,tolb)
            # update E and G
            X = view(B1,ib,:)*g2
            E1[1:nc,kk] += view(Q,ib,1:nc)'*X
            G += g2*view(Z,:,kk)'
            # perform standardization step to form two 1x1 blocks
            Q2, e2[1,1] = givens(e2[1,1],e2[2,1],1,2)
            e2[2,1] = ZERO;
            lmul!(Q2,view(E1,kk,nc:n))
            e2[2,2] = ZERO
            lmul!(Q2,view(A1,kk,nc-1:n))
            rmul!(view(Q,:,kk),Q2')
            Z2, r = givens(conj(a2[2,2]),conj(a2[2,1]),2,1)
            a2[2,2] = conj(r)
            a2[2,1] = ZERO
            rmul!(view(E1,1:nc-1,kk),Z2')
            rmul!(view(A1,1:nc-1,kk),Z2')
            rmul!(view(Z,:,kk),Z2')
            # reorder eigenvalues
            if nb > k
               tgexc!(true, true, nc-k+1, ia, A1, E1, Q, Z)
               tgexc!(true, true, nc, ia+1, A1, E1, Q, Z)
            end
            E1[ia,ia] = ZERO
            E1[ia+1,ia+1] = ZERO
         end
         nb -= k
         ia += k
         nia += k
      end
   end
   ihf > 0 && @warn("Possible loss of numerical reliability due to high feedback gain")
   blkdims = [ninf, nia, nfu]
   _, α, β = ordeigvals(A1,E1)
   return F, G, GeneralizedSchur(A1, E1, α, β, Q, Z), blkdims

   # end salocinf
end
"""
     ev = ordeigvals(A)

Compute the vector `ev` of eigenvalues of a Schur matrix `A` in their order of appearance down the diagonal of `A`.
`ordeigvals` is an order-preserving version of `eigvals` for triangular/quasitriangular matrices.
"""
function ordeigvals(A::AbstractMatrix{T}) where T
   isqtriu(A) || error("A must be in Schur form")
   n = size(A,1)
   ZERO = zero(T)
   if T <: Complex
      α = Vector{T}(undef, n)
      for i = 1:n
         α[i] = A[i,i]
      end
      return α
   else
      αr = Vector{T}(undef, n)
      αi = zeros(T,n)
      for i = 1:n
         αr[i] = A[i,i]
      end
      for i = 1:n-1
         if A[i+1,i] != ZERO
            if A[i,i] == A[i+1,i+1]
               # exploit LAPACK 2x2 block structure
               ei = sqrt(abs(A[i,i+1]))*sqrt(abs(A[i+1,i]))
               αi[i] = ei
               αi[i+1] = -ei
            else
               # an arbitrary 2x2 block
               αr[i], αi[i], αr[i+1], αi[i+1] = lanv2(A[i,i], A[i,i+1], A[i+1,i], A[i+1,i+1])
            end
            i +=1
         end
      end
      return iszero(αi) ? αr : Complex.(αr,αi)
   end
end
"""
    ordeigvals(A, B) -> (ev, α, β)

Compute the vector `ev` of generalized eigenvalues of the pair `(A,B)`, with `A` a Schur matrix and `B` an upper triangular matrix,
in their order of appearance down the diagonals of `A` and `B`.
`ordeigvals` is an order-preserving version of `eigvals` for (triangular/quasi-upper-triangular, triangular) pairs of matrices.
`α` is a complex vector and `β` is a real vector such that the generalized eigenvalues `ev` can be alternatively obtained with `α./β`.
"""
function ordeigvals(A::AbstractMatrix{T}, B::AbstractMatrix{T}) where T
   na, nb = LinearAlgebra.checksquare(A,B)
   na == nb ||  throw(DimensionMismatch("A and B must have the same size"))
   (isqtriu(A) && istriu(B)) || error("The pair (A,B) must be in a generalized Schur form")
   n = size(A,1)
   complx = T <: Complex
   if complx
      α = Vector{T}(undef, n)
      β = Vector{T}(undef, n)
      for i = 1:n
         α[i] = A[i,i]
         β[i] = B[i,i]
      end
      ev = α./β
      ev[iszero.(β)] .= Inf
      ev[iszero.(α) .& iszero.(β)] .= NaN + NaN*im
      return ev, α, β
   else
      αr = Vector{T}(undef, n)
      αi = Vector{T}(undef, n)
      β = Vector{T}(undef, n)
      ZERO = zero(T)
      small = safemin(T)
      i = 1
      while i <= n
         pair = (i < n && A[i+1,i] != ZERO)
         if pair
            ii = i:i+1
            β[i], β[i+1], αr[i], αr[i+1], wi  = lag2(A[ii,ii],B[ii,ii],small)
            iszero(wi) ? (αi[i] = wi; αi[i+1] = wi) : (αi[i] = wi; αi[i+1] = -wi; β[i+1] = β[i])
            i += 2
         else
            αr[i] = A[i,i]
            αi[i] = ZERO
            β[i] = B[i,i]
            i += 1
         end
      end
      α = iszero(αi) ? αr : Complex.(αr,αi)
      ev = α./β
      complx || (ev[imag.(ev) .> 0] = conj(ev[imag.(ev) .< 0]))
      ev[iszero.(β)] .= Inf
      ev[iszero.(α) .& iszero.(β)] .= NaN
      return ev, α, β
   end
end
"""
    saloc2(A, B, evc, tola, tolb) -> (F, U)

Compute for the real pair `(A,B)` with `A` of order two, a matrix `F` such that the eigenvalues
of the matrix `A+B*F` are equal to the complex conjugate pair contained in `evc`.
The absolute thresholds `tola` and `tolb` for the nonzero elements in `A` and `B`, respectively,
are used for controllability checks.

If the pair `(A,B)` is uncontrollable, then `F = nothing` and `U` contains an orthogonal transformation
matrix such that the transformed pair `(U'*A*U, U'*B)` is in the form

                     [ A1  X    B1 ]
    [ U'*A*U U'*B] = [             ] ,
                     [  0  A2   0  ]

where the pair `(A1,B1)` is controllable. If `norm(B) < tolb`, then `U` is the `2x2` identity matrix.
"""
function saloc2(A::AbstractMatrix{T},B::AbstractMatrix{T},evc::AbstractVector{T1},tola,tolb) where {T, T1}

   # check controllability and determine rank of B
   m = size(B,2);
   SF = svd(B; full=true); s1 = SF.S[1]
   U = SF.U
   v1 = SF.V
   if m == 1
      s2 = zero(T);
   else
      s2 = SF.S[2]
   end
   rankB = 0
   s1 > tolb && (rankB += 1)
   s2 > tolb && (rankB += 1)
   # return if norm(B) < tolb
   rankB == 0 && (return nothing, Matrix{T}(I,2,2))

   at = U'*A*U;
   if s2 <= tolb && abs(at[2,1]) <= tola
         # return if rank(B) == 1 and (A-lambda*I,B) uncontrollable
      return nothing, U
   end
   if rankB == 2
      # try with a direct solution, without inversion
      γ = [real(evc[1]) imag(evc[1]); imag(evc[2]) real(evc[2])];
      ftry = -B\(A-γ);
   end
   sc = at[1,1]+at[2,2];
   sp = real(evc[1]+evc[2]); pp = real(evc[1]*evc[2]);
   k11 = (sc-sp)/s1;
   k12 = at[2,2]/at[2,1]*k11+(pp-at[1,1]*at[2,2]+at[1,2]*at[2,1])/at[2,1]/s1;
   F = v1*[[-k11 -k12]; zeros(m-1,2)]*U';
   if rankB == 2 && norm(F) > norm(ftry)
     # choose the lower norm feedback
      F = ftry;
   end
   return F, U
   # end saloc2
end
"""
    saloc2(A, B, E, evc, tola, tolb) -> (F, U, V)

Compute for the real pair `(A-λE,B)` with `A-λE` of order two, a matrix `F` such that the
generalized eigenvalues of the matrix pair `(A+B*F,E)` are equal to the complex conjugate pair contained in `evc`.
The absolute thresholds `tola` and `tolb` for the nonzero elements in `A` and `B`, respectively,
are used for controllability checks.

If the pair `(A-λE,B)` is uncontrollable, then `F = nothing` and `U` and `V` contains orthogonal transformation
matrices such that the transformed pair `(U'*A*V-λU'*E*V, U'*B)` is in the form

                             [ A1-λE1   X    B1 ]
    [ U'*A*V-λU'*E*V U'*B] = [                  ] ,
                             [  0    A2-λE2  0  ]

where the pair `(A1-λE1,B1)` is controllable. If `norm(B) < tolb`, then `U` and `V` are `2x2` identity matrices.
"""

function saloc2(A::AbstractMatrix{T},E::AbstractMatrix{T},B::AbstractMatrix{T},evc::AbstractVector{T1},tola,tolb) where {T, T1}

    # check controllability and determine rank of B
    m = size(B,2);
    SF = svd(B; full=true); s1 = SF.S[1]
    U = SF.U
    v1 = SF.V
    if m == 1
      s2 = zero(T);
    else
      s2 = SF.S[2]
    end
    rankB = 0
    s1 > tolb && (rankB += 1)
    s2 > tolb && (rankB += 1)
    # return if norm(B) < tolb
    rankB == 0 && (return nothing, Matrix{T}(I,2,2), Matrix{T}(I,2,2))

    at = U'*A; et = U'*E;
    # determine V such that et = U'*E*V is upper triangular
    # FQ = qr([et[2,2]; et[2,1]]); V = FQ.Q*Matrix{T}(I,2,2); V = V[2:-1:1,2:-1:1]';
    G,  = LinearAlgebra.givens(et[2,2], et[2,1],1,2)
    # at = at*G;
    rmul!(at,G)
    if s2 <= tolb && abs(at[2,1]) <= tola
       # return if rank(B) == 1 and (A-lambda*E,B) uncontrollable
       # return nothing, U, V
       return nothing, U, [G.c G.s; -G.s G.c]
    end
    # reduce to standard case
    SF = svd(E\B; full=true);
    s1 = SF.S[1]; U = SF.U; v1 = SF.V
    at = U'*(E\A)*U;
    if rankB == 2
       # try with a direct solution, without inversion
       γ = [real(evc[1]) imag(evc[1]); imag(evc[2]) real(evc[2])];
       ftry = -B\(A-E*γ);
    end
    sc = at[1,1]+at[2,2];
    sp = real(evc[1]+evc[2]); pp = real(evc[1]*evc[2]);
    k11 = (sc-sp)/s1;
    k12 = at[2,2]/at[2,1]*k11+(pp-at[1,1]*at[2,2]+at[1,2]*at[2,1])/at[2,1]/s1;
    F = v1*[[-k11 -k12]; zeros(T,m-1,2)]*U'; V = Matrix{eltype(B)}(I,m,m)
    if rankB == 2 && norm(F) > norm(ftry)
      # choose the lower norm feedback
       F = ftry;
    end
    return F, U, V
    # end saloc2
end
"""
    eigselect1(ev, sdeg, evref, disc; cflag) -> (γ, evupd)

Select a real or complex eigenvalue `γ` to be assigned from a given set of eigenvalues
in the vector `ev`. The resulting `evupd` contains the remaining eigenvalues from `ev`.
The selected eigenvalue `γ` is the nearest one to the reference value `evref`.
If `ev = missing` and `disc = false`, then, if `cflag = false` (in the real case) `γ` is set equal to the
desired stability degree `sdeg`, while if `cflag = true` (in the complex case) `γ` is set
`γ = sdeg + im*imag(evref)`.
If `ev = missing` and `disc = true`, then, if `cflag = false` (in the real case) `γ` is set equal to the
desired stability degree `sdeg`, while if `cflag = true` (in the complex case) `γ` is set
`γ = sdeg/abs(evref))*evref`.
If `ev = missing` and `sdeg = missing`, then `γ = nothing`.
"""
function eigselect1(ev::Union{AbstractVector,Missing},sdeg::Union{Real,Missing},evref::Union{Real,Complex},disc::Bool = false; cflag::Bool = false )
   T = typeof(evref)
   if ismissing(ev)
      if ismissing(sdeg)
         γ = nothing
      else
         γ = disc ? (cflag ? (sdeg/abs(evref))*evref : sdeg) : (cflag ? sdeg+im*imag(evref) : sdeg)
      end
      evupd = missing
   else
      i = argmin(abs.(ev.-evref))
      γ = cflag ? ev[i] : real(ev[i]);
      evupd = [ev[1:i-1,1]; ev[i+1:end,1]]
      isempty(evupd) && (evupd = missing)
   end
   return γ, evupd

# end eigselect1
end
"""
    eigselect2(evr, evc, sdeg, evref, disc) -> (γ, evrupd, evcupd)

Select a pair of eigenvalues `γ[1]` and `γ[2]` to be assigned from given sets of real eigenvalues
in the vector `evr` and complex eigenvalues in the vector `evc`.
The selected eigenvalues are the nearest ones to the reference value `evref`.
A pair of complex eigenvalues is always selected, unless `evc = missing`, in which case a pair
of real eigenvalues is selected. The resulting `evrupd` contains the remaining real eigenvalues from `evr` and
the resulting `evcupd` contains the remaining complex eigenvalues from `evc`.
If the desired stability degree `sdeg` is missing, then a default value `sdeg = sdegdef` is used, where
`sdegdef = -0.05`, if `disc = false`, and `sdegdef = .95`, if `disc = true`.
If `evc = missing` and `evr` contains at least two eigenvalues, then
`γ[1]` and `γ[2]` are chosen the two nearest real eigenvalues to `evref`.
If `evc = missing` and `evr` contains only one value, then `γ[1] = evr` and `γ[2] = sdeg`.
If `evr = missing`, `evc = missing` and `disc = false`, then
`γ[1] = sdeg + im*imag(evref)` and `γ[2] = sdeg - im*imag(evref)`.
If `evr = missing`, `evc = missing` and `disc = true`, then
`γ[1] = sdeg/abs(evref))*evref[1]` and `γ[2] = sdeg/abs(evref))*evref[2]`.
"""
function eigselect2(evr::Union{AbstractVector,Missing},evc::Union{AbstractVector,Missing},sdeg::Union{Real,Missing},evref::Union{Real,Complex},disc::Bool)
   # corrected version to run under Julia 1.6
   evref = real(evref) + im*abs(imag(evref))
   if ismissing(evr) && ismissing(evc)
      if ismissing(sdeg)
         T = typeof(evref)
         sdegdef = disc ? real(T)(0.95) : real(T)(-0.05)
         evi = imag(evref)
         γ = [complex(sdegdef,evi), complex(sdegdef,-evi)]
      else
        if disc
           γ = [evref, conj(evref)]
           γ = (sdeg/abs(evref))*γ
        else
           evi = imag(evref)
           γ = [complex(sdeg,evi), complex(sdeg,-evi)]
        end
      end
      evrupd = missing
      evcupd = missing
   elseif ismissing(evc)
      # select two real eigenvalues
      if length(evr) < 2
         if ismissing(sdeg)
            T = typeof(evref)
            sdegdef = disc ? real(T)(0.95) : real(T)(-0.05)
            γ = [evr[1],sdegdef]
         else
            γ = [evr[1],sdeg]
         end
         evrupd = missing
         evcupd = missing
      else
         evr = evr[sortperm(abs.(evr .- evref))]
         γ = [ evr[1], evr[2]]
         evrupd = evr[3:end]
         isempty(evrupd) && (evrupd = missing)
         evcupd = missing
      end
   else
      i = argmin(abs.(evc .- evref))
      γ = [evc[i],evc[i+1]]
      evcupd = [evc[1:i-1]; evc[i+2:end]]
      isempty(evcupd) && (evcupd = missing)
      evrupd = evr
   end
   return γ, evrupd, evcupd

# end eigselect2
end

"""
    isqtriu(A::AbstractMatrix) -> Bool

Test whether `A` is a square matrix in a quasi upper triangular form
(e.g., in real or complex Schur form). In the real case, `A` may have 2x2
diagonal blocks, which however must not correspond to complex conjugate eigenvalues.
In the complex case, it is tested if `A` is upper triangular.
"""
function isqtriu(A)
   @assert !Base.has_offset_axes(A)
   m, n = size(A)
   m == n || (return false)
   m == 1 && (return true)
   eltype(A)<:Complex && (return istriu(A))
   m == 2 && (return true)
   istriu(A,-1) || (return false)
   for i = 2:m-1
       !iszero(A[i,i-1]) && !iszero(A[i+1,i]) && (return false)
   end
   return true
end
function eigvalsnosort(M; kwargs...)
   return eigvals(M; sortby=nothing, kwargs...)
end
function eigvalsnosort(M, N; kwargs...)
   ev = eigvals(M, N; sortby=nothing, kwargs...)
   eltype(M) <: Complex || (ev[imag.(ev) .> 0] = conj(ev[imag.(ev) .< 0]))
   return ev
end
function eigvalsnosort!(M; kwargs...)
   return eigvals!(M; sortby=nothing, kwargs...)
end
function eigvalsnosort!(M, N; kwargs...)
   ev = eigvals!(M, N; sortby=nothing, kwargs...)
   eltype(M) <: Complex || (ev[imag.(ev) .> 0] = conj(ev[imag.(ev) .< 0]))
   return ev
end


# Logistic map cobweb and timeseries
using DrWatson
@quickactivate "NonlinearDynamicsTextbook"
include(srcdir("colorscheme.jl"))
using GLMakie, DynamicalSystems, InteractiveDynamics

lo = Systems.logistic(0.4; r=rrange[1])
fkwargs = [(linewidth = 4.0, color = COLORSCHEME[i+1]) for i in 1:3]

rrange = 1:0.001:4.0
fig = interactive_cobweb(lo, rrange, 2; fkwargs)
record_interaction(fig, projectdir("animations", "4", "logistic_cobweb.mp4"))

# %% the second range is a convenience for intermittency example of logistic
rrange = (rc = 1 + sqrt(8); [rc - 1e-3, rc - 1e-5, rc])
fig = interactive_cobweb(lo, rrange, 3; fkwargs)
record_interaction(
    fig, projectdir("animations", "4", "logistic_intermittency.mp4");
    total_time=15, sleep_time = 2
)