using BenchmarkTools
#global ⫙ = []
#=

#another idea: pass in middle function, as a whole
#function middleExtraction(middle,a,b) end
#---testing area 2
=#
"""returns a boolean
```input:

```

```output:

```
"""#testing purposes only
#= #Highly Experimental
function checkCriterion(ch, :operator = [%, +, -, *], operand)
    check = nothing
    check = ch
    condition = nothing
    condition = :check:operator:operand
    if condition == true
        return true #a.s.
    elseif condition == false
        return false #a.s.
    else # faulty Input or Unexpected Error Occured
        return check
    end
    return check
end
checkCriterion(3, %, 2)
 =#
#check #1 ϟ - \upkoppa
function ϟ(a, b)
    return abs(a) + abs(b)
end

#check #2:middle
#
"""evenCriterion
```input
  a: the `first()` in a range
  b:the `last()` in  a range
```
```output
 Returns `check`: the

 Output is Calculated by: `check b-a`

 `output = `
   If check is true

  If check if false

  Else, there must be an error in either input arguments: a, b (or an Unexpected error occured)
  Otherwise,  return the `check`

  **see also:** `iseven`

  ```
"""
#isEven Removed #Reason: unnecessary Overhead
#define sumInterval here
sumInterval(a::Int64, b::Int64) = (abs(max(a, b)) - abs(min(a, b))) # was (max(a, b) - abs(min(a, b))) #Unsymmetric
#=
function evenCriterion(a, b) #ok #double-Checked # depreciated # erroneous
    m = ϟ(a, b) # | b + a |   definition
    condition = m % 2 == 0 #isEven(m) #even (divisible by 2)
    check = nothing
    if condition == true  #ERROR double if!
        check = condition
    elseif condition == false
        check = condition
    else #if faulty input or Unexpected ERROR Occured
        check
    end
    return check #whether check is true, false, nothing
end
=#
#done!

res = evenCriterion(1, 3) #flase Infer no middle as a whole number
#=
function midCriterion(sumInterval)
    m = sumInterval #NO ERROR  #sumInterval(a, b) # | b - a |
    condition = m % 2 == 0 # isEven(m)
    check = nothing
    if condition == true
        check = condition
    elseif condition == false
        check = condition
    else #if faulty input or Unexpected ERROR Occured
        check
    end
    return check #whether check is true, false, nothing
end
=#
#--------------
#Recheck - cyclical code dedected! :mid to even , or even to mid  #Possible #depreciatable
function middleExtraction(condition, checkedValue; above = nothing, below = nothing) #at least one argument is given, besides condition
    ⫙ = []# reset is necessary detected
    criterion = condition
    if criterion == true # there is only 1 value
        # only get the checkedValue
        ⫙ = push!(⫙, checkedValue)
    elseif criterion == false
        #then we have above & below to get (know for sure that below is under above)
        ⫙ = push!(⫙, above)
        ⫙ = push!(⫙, below)
    else # faulty input or Unexpected error Occured
        return
    end
    return ⫙ #q
end
#---------------------------------------
function middleGet(condition)
    criterion = condition
    criterion ? ⫙ = (popat(checkedValue)) : ⫙ = popat(ceil)
    val = popat(below) #warning: unused  ⫙
    return val
end

function doublepush!(m = ⫙, above, below)
    push!(m, above)
    push!(m, below)
end

function middleSet(condition; m = ⫙, checkedValue, above, below)
    criterion = condition
    criterion ? push!(m, checkedValue) : doublepush(m, above, below) #push!(⫙, ceil)

end
arr = [10, 4, 2, 8]
middleGet(ϟ(first(arr), last(arr)))
#----------------------------------------
#middleExtraction()
check = Int(ϟ(a, b) // 2) # sumInterval(a, b) // 2 #* 1.0 # | b - a | // 2 isa Integer #sumInterval -to-> ϟ
#⫙ = []

function push!(⫙, ceil = above, floor = below)#warning: ⫙, floor are Unused
    push!(⫙, ceil)
    push!(⫙, below)
end
""" pops Double  """
function popDouble()
    ceil = popat(⫙, ceil)
    floor = popat(⫙, below)
    return ceil, floor
end
"""pushes ceil & floor """
function pushDouble(⫙, ceil = above, floor = below)
    ceil = push!(⫙, ceil)
    floor = push!(⫙, below)

    return ceil, floor
end
#=
"""pushes checked """
function push(checked = checkedValue)
    push!(⫙, checked)
end

function pop!()
    checked = pop!()
    return checked
end

#function pop!()
=#
#--------------------------
#---known error here
"""returns a middle(s)
```input:
a: lower bound range
b: upper bound range
```

```output:
condition: Bool flag informing user if got a 1 mid-point, 2 mid-poimts, or errors occured
check: 1 midpoint middle  (if condition is true)
above,below: 2 mid-point middles (the realized leaf-bounds between the theoretical mid-point)
```
"""
function middle(a, b) # working
    condition = evenCriterion(a, b) #   b-a
    # check = nothing;check = midCriterion(m) #b-a
    above = nothing
    below = nothing
    check = nothing
    q = []
    if condition == true
        #return true #a.s. #eucledian Distance divided by 2 returing a whole integer
        check = Int(ϟ(a, b) // 2) # | b + a | // 2 isa Integer #sumInterval -to-> ϟ#5
        #middleExtraction(condition, check) # Here we didn't get anything ! <------------- # check not defined here
        #return condition, check
        push!(q, check)
    elseif condition == false
        #return false #a.s.# check = sumInterval(a,b)//2*1.0
        #GET Ceil & Floor
        check = ϟ(a, b) / 2 # floating-point division sumInterval(a, b) / 2 * 1.0 # freely allowing floats, to be ceiled & floored
        above = Int(ceil(check)) #nearest index above
        below = Int(floor(check))
        push!(q, below)
        push!(q, above)

    else # faulty Input or Unexpected Error Occured
        #    return check  # nothing
        return q #condition, check, above, below
    end
    return q #condition, check, above, below
end

condition = nothing;
check = nothing;
# condition, check, above, below = middle(1, 3)
q = middle(1, 3)
typeof(q)
Q = zeros(length(q) + 1) # for future testing purposes
#Note: there should be a math formula to translate points into range (numbers)
l = length(q)      # <--- length of q mid-point(s)
#=
while  l >= 1

end
=#
val = popfirst!(q) #can only observe value once consumed & popped out

"""
gets number of total points, based on number of mid-point(s)

```input:
l: number of mid-points , a Julia's length function length(middle(lowerbound, upperbound) )
; modulo: (Optional) the modulo ,defaults to 2 (otherwise, untested )
```

```output:
if even, returns 4 (sumPts * _two (start ))
```
"""
function numPts(Length = l; modulo = 2)
    _two = modulo
    sumPts = _two
    if Length % _two == 0 # even
        sumPts = sumPts + _two # multiplier * 2 i.e. 2 * 2 = 4
    elseif Length % _two != 0
        sumPts = sumPts + (_two / _two)     #multiplier + 1 i.e. 2 + 1 = 3
    else
        return
    end
    return Int(sumPts)
end
q = middle(1, 10)
Length = length(q)
nPoints = numPts(Length)

using BenchmarkTools
@benchmark n = numPts(l)

numPts()

#-risk-free experiments below
lenpts = l * 2 + l # if l== 1 (1 midpoint), apply condition that you should add a + 1  (mid point)  #Got inspired the numPts function
for i ∈ (q)
    #   for j ∈(Q)
    i = q.pop()

end
ranges = []
#if condition == true
push!(ranges, 1:check)
push!(ranges, check:3)

popfirst!(ranges)

#bottleneck is the first middle
arr = [8, 5, 2, 7, 4]
q = []
push!(q, middle(arr[first(arr)], arr[last(arr)]))
#q = push!( middle(arr[first(arr)], arr[(last(arr))])) # find middle points #funto-watch!
q

function middle(arr, a, b)
    #ϟ(arr)
    q = []
    push!(q, middle(arr[a], arr[b])) # find middle point(s)
    return q
end
#done

#=
if condition == true # 1 midpoint
    #oldschoolComp()
    return #check
    #build range
if condition == false # 2 midpouts #done
    #above & below # compare them here
    below,above =  oldschoolComp(below,above)
    return below,above #<--- pplace here: #compare
     #end
end
=#
# comp(arr,a,b) = arr_a =  arr[a]; arr[b]  = arr_b; arr_a>arr_b ? oldschoolSwap(arr[a],arr[b])

function comp(arr, a, b)
    arr_a = arr[a]
    arr_b = arr[b]
    if arr_a > arr_b
        arr_a, arr_b = oldschoolSwap(arr[a], arr[b])
    end
    return arr_a, arr_b
end

#--------Demonstration

middle(1, 4) #false # (false, 2.5, 3, 2)
middle(1, 3) #true  #
#=sumInterval(1, 3) # (true, 2//1, nothing, nothing)=#

#---testing of testing
middle(1, 3)

"""
Assumes right most argument should be the lowest
Thus, if it has a higher value, swap it (with the other one)
```input:
a: Int(64,128) or float(64, or 128)
b: Int(64,128) or float(64, or 128)
```

```output:
returns an ordered pair of a & b
(comparison might be needed only if a is larger)
```
"""
function oldschoolComp(a, b)
    if a > b
        a, b = oldschoolswap(a, b)
        return a, b
    elseif a < b
        # move on
        return a, b
    else
        return 0, 0
    end
    return a, b
end
elementat() #returns element
indexOf()#returns index

#----new: Experimental------
isDiff(a, b, aVal, bVal) = aVal != a && bVal != b ? true : false
function oldschoolComp(arr, a = first(arr), b = last(arr))
    aVal = a = first(arr)
    bVal = b = last(arr)

    aVal, bVal = oldschoolComp(a, b)
    arr[aVal]
    ans = isDiff(a, b, aVal, bVal) #true
    ans == true ? arr[indexOf(a, arr)], arr[indexOf(b, arr)] = arr[indexOf(b, arr)], arr[indexOf(a, arr)] : arr
    arr[]

    if a > b
        a, b = oldschoolswap(a, b)
        return a, b
    elseif a < b
        # move on
        return a, b
    else
        return 0, 0
    end
    return a, b
end

aVal = first(arr)
bVal = last(arr)

aVal, bVal = oldschoolComp(a, b)

arr[aVal]

ans = isDiff(a, b, aVal, bVal) #true
ans == true ? arr[indexOf(a, arr)], arr[indexOf(b, arr)] = arr[indexOf(b, arr)], arr[indexOf(a, arr)] : """
                                                                                compares an arbitrary array
                                                                                based on it's first & last elements
                                                                                """
#=
function compare(arr) #errornous #warning becareful from its values
    aVal = first(arr) # arr[aIdx] # 5 v[1]= 5
    bVal = last(arr) #arr[bIdx] # v[last] = 1  5>1
    aIdx = firstindex(arr)
    bIdx = lastindex(arr) # bVal)

    #1. Heuristic#1: Check sumInterval

    total = ϟ(aIdx,bIdx)
    dist = sumInterval(aIdx,bIdx)
    midpoint

    if dist == 1 #1,2 ; 2,3 ; 3,4
       #final compare of values
      aVal,bVal =  oldschoolComp(aVal,bVal)#compare & swap, if applicable

    elseif dist > 1
        isEven = evenCriterion(aIdx, bIdx)
        if isEven == true #even #only 1-midpoint
            midpoint = pushfirst!(midpoint, Int(total // 2))
        elseif isEven == false # 2 midpoints
        #middle()

        end
        #if aVal < bVal
        if total > 1 # there are still unforseen ranges
            #if sumInterval(aIdx,bIdx) > 1 #reason to stay  #\upkoppa ?
            #if aVal > bVal compare function                               # a > b #should be a < b
            #1. Swap values
            aVal, bVal = comp(arr, aIdx, bIdx)  # oldschoolSwap(aVal, bVal) #correct #x, y) # (bVal, aVal) #ERROR T not defined
            #2. Swap  array indicies(with correct orders)
            #arr[aIdx], arr[bIdx] = oldschoolSwap(arr[aIdx], arr[bIdx])
            #3.decrement  - middle
            # middleExtraction() #error! #UncommentMe
            #elseif aVal < bVal # at that level (diff length) of indicies # the array is correct

            return aVal, bVal

        else #faulty input , Unexpected code
            println(strError)
            return
        end
        return aVal, bVal # , arr  #min, max #removed values
    end
end
=#

arr = [8, 5, 2, 7, 4]
#finished leaf example
aVal = first(arr)
bVal = last(arr)
aVal, bVal = oldschoolComp(aVal, bVal)

q = middle(first(arr), last(arr))

n = numPts(length(q)) # 3 middles

q = middle(first(arr), last(arr))
l = length(q) # length 1 # errornous process

ans = popfirst!(q)

count = 1
val = 2
#---new
if count <= n
    q = middle(first(arr), last(arr)) #
    val = firstindex(q) # findall(x -> x == val, arr) #popfirst!(q)
end
#---end

#method at least julia 1.7
#i = find(x -> x == val, arr) #removed

arr = [8, 5, 2, 7, 4]
elementat(arr, 8)
res = indexOf(1, arr)
_last = arr[indexOf(last(arr), arr)]
_first = arr[indexOf(first(arr), arr)]
ans = indexOf(arr, elementat(arr, 5)[1])

indexOf(elementat(7, arr), arr)

length(elementat(1, arr))
using BenchmarkTools
@benchmark last(arr)
#=
 Range (min … max):  18.236 ns … 182.966 ns  ┊ GC (min … max): 0.00% … 0.00%
 Time  (median):     19.639 ns               ┊ GC (median):    0.00%
 Time  (mean ± σ):   23.044 ns ±  12.668 ns  ┊ GC (mean ± σ):  0.00% ± 0.00%

  ▄█▄          ▁                                               ▁
  ████▅▅▅▄▄▃▂▂▅██▇█████▇▆▄▄▅▇▆▆▅▅▇▆▆▇▆▆▆▅▄▅▄▄▄▃▄▄▂▄▄▃▃▃▃▃▃▂▄▄▃ █
  18.2 ns       Histogram: log(frequency) by time      83.8 ns <

 Memory estimate: 0 bytes, allocs estimate: 0.
=#
length(arr)

if _first < _last
    arr[1], arr[length(arr)] = oldschoolComp(_first, _last)
end

@inbounds arr[1], arr[length(arr)] = arr[length(arr)], arr[1] #

function Swap(arr, a = arr[1], b = arr[length(arr)])
    return @inbounds arr[1], arr[length(arr)] = arr[length(arr)], arr[1]

end
#-------------------
#arr[1], arr[last(arr)] = oldschoolComp(arr[1], arr[last(arr)])

arr[1], arr[length(arr)] = comp(arr, 1, length(arr))
q = middle(1,length(arr))
newMid = q[1]
elementat(arr,newMid) #should be 2
arr[newMid]
arr
res = Int(ϟ(1, length(arr)) / 2)
res % 2 == 0 ? true : false #false - 2 midpoints
#Ceil =
#    floor =
check = res / 2 # floating-point division sumInterval(a, b) / 2 * 1.0 # freely allowing floats, to be ceiled & floored
above = Int(ceil(check)) #nearest index above
below = Int(floor(check))
arr[below]
arr[above]
elementat(arr,arr[below])
elementat(arr,arr[above])

arr
#=
1:2
2:
=#
arr[1+2], arr[length(arr)-1] = comp(arr, 1 + 1, length(arr) - 1)
arr[1+2], arr[length(arr)-1] = comp(arr, 1 + 1, length(arr) - 1)

arr

#----testing Area
arr[1], arr[last(arr)]

val = 2
ans = firstindex(q) #true
i = elementat(arr, 2) #
#i[1] #
ans = elementat(arr, 2)
ans # index

ans = indexOf(arr, i)

elementat(arr, 5) # working

#firstIndex()
#Q.how far 3 from start?
first(arr) #first val
ans = indexin(i[1], arr)

d1 = sumInterval(i[1], first(arr))

#valIdx = findall(arr, val)

val

#correct till this point
function goabove!(arr, middle, last) end

function gobelow!(arr, first, middle)
    #evaluate value

end

#-----

arr = [8, 5, 2, 7, 4]


using QuantumControlBase.QuantumPropagators: propstep!, write_to_storage!, get_from_storage!
using QuantumControlBase: evalcontrols!
using QuantumControlBase.Functionals: make_chi
using QuantumControlBase.ConditionalThreads: @threadsif
using LinearAlgebra
using Printf

"""Optimize a control problem using Krotov's method.

```julia
result = optimize_krotov(problem)
```

optimizes the given
control [`problem`](@ref QuantumControlBase.ControlProblem),
returning a [`KrotovResult`](@ref).

!!! note

    It is recommended to call [`optimize`](@ref QuantumControlBase.optimize)
    with `method=:krotov` instead of calling `optimize_krotov` directly.

Keyword arguments that control the optimization are taken from the keyword
arguments used in the instantiation of `problem`.

# Required problem keyword arguments

* `J_T`: A function `J_T(ϕ, objectives)` that evaluates the final time
  functional from a list `ϕ` of forward-propagated states and
  `problem.objectives`.

# Optional problem keyword arguments

The following keyword arguments are supported (with default values):

* `chi`: A function `chi!(χ, ϕ, objectives)` what receives a list `ϕ`
  of the forward propagates state and must set ``-χₖ=∂J_T/∂⟨ϕₖ|``. If not
  given, it will be automatically determined from `J_T` via [`make_chi`](@ref)
* `force_zygote=false`: Whether to force the use of automatic differentiation
  when calling [`make_chi`](@ref).
* `sigma=nothing`: Function that calculate the second-order contribution. If
  not given, the first-order Krotov method is used.
* `iter_start=0`: the initial iteration number
* `iter_stop=5000`: the maximum iteration number
* `prop_method`/`fw_prop_method`/`bw_prop_method`: The propagation method to
  use for each objective, see below.
* `update_hook`: A function that receives the Krotov workspace, the iteration
  number, the list of updated pulses and the list of guess pulses as
  positional arguments. The function may mutate any of its arguments. This may
  be used e.g. to apply a spectral filter to the updated pulses, or to update
  propagation workspaces inside the Krotov workspace.
* `info_hook`: A function that receives the same argumens as `update_hook`, in
  order to write information about the current iteration to the screen or to a
  file. The default `info_hook` prints a table with convergence information to
  the screen. Runs after `update_hook`. The `info_hook` function may return a
  tuple, which is stored in the list of `records` inside the
  [`KrotovResult`](@ref) object.
* `check_convergence`: a function to check whether convergence has been
  reached. Receives a [`KrotovResult`](@ref) object `result`, and should set
  `result.converged` to `true` and `result.message` to an appropriate string in
  case of convergence. Multiple convergence checks can be performed by chaining
  functions with `∘`. The convergence check is performed after any calls to
  `update_hook` and `info_hook`.
* `verbose=false`: If `true`, print information during initialization

The propagation method for the forward propagation of each objective is
determined by the first available item of the following:

* a `fw_prop_method` keyword argument
* a `prop_method` keyword argument
* a property `fw_prop_method` of the objective
* a property `prop_method` of the objective
* the value `:auto`

The propagation method for the backword propagation is determined similarly,
but with `bw_prop_method` instead of `fw_prop_method`.
"""
function optimize_krotov(problem)
    sigma = get(problem.kwargs, :sigma, nothing)
    iter_start = get(problem.kwargs, :iter_start, 0)
    update_hook! = get(problem.kwargs, :update_hook, (args...) -> nothing)
    info_hook = get(problem.kwargs, :info_hook, print_table)
    check_convergence! = get(problem.kwargs, :check_convergence, res -> res)
    # note: the default `check_convergence!` is a no-op. We still always check
    # for "Reached maximum number of iterations" in `update_result!`
    verbose = get(problem.kwargs, :verbose, false)
    skip_initial_forward_propagation =
        get(problem.kwargs, :skip_initial_forward_propagation, false)

    wrk = KrotovWrk(problem; verbose)

    ϵ⁽ⁱ⁾ = wrk.pulses0
    ϵ⁽ⁱ⁺¹⁾ = wrk.pulses1

    if skip_initial_forward_propagation
        @info "Skipping initial forward propagation"
    else
        @threadsif wrk.use_threads for (k, obj) in collect(enumerate(wrk.objectives))
            krotov_initial_fw_prop!(ϵ⁽ⁱ⁾, wrk.result.states[k], obj.initial_state, k, wrk)
        end
    end

    # TODO: if sigma, fw_storage0 = fw_storage
    update_result!(wrk, 0)
    update_hook!(wrk, 0, ϵ⁽ⁱ⁺¹⁾, ϵ⁽ⁱ⁾)
    info_tuple = info_hook(wrk, 0, ϵ⁽ⁱ⁺¹⁾, ϵ⁽ⁱ⁾)
    (info_tuple !== nothing) && push!(wrk.records, info_tuple)

    i = wrk.result.iter  # = 0, unless continuing from previous optimization
    while !wrk.result.converged
        i = i + 1
        krotov_iteration(wrk, ϵ⁽ⁱ⁾, ϵ⁽ⁱ⁺¹⁾)
        update_result!(wrk, i)
        update_hook!(wrk, i, ϵ⁽ⁱ⁺¹⁾, ϵ⁽ⁱ⁾)
        info_tuple = info_hook(wrk, i, ϵ⁽ⁱ⁺¹⁾, ϵ⁽ⁱ⁾)
        (info_tuple !== nothing) && push!(wrk.records, info_tuple)
        check_convergence!(wrk.result)
        ϵ⁽ⁱ⁾, ϵ⁽ⁱ⁺¹⁾ = ϵ⁽ⁱ⁺¹⁾, ϵ⁽ⁱ⁾
    end

    finalize_result!(ϵ⁽ⁱ⁾, wrk)

    return wrk.result

end

function krotov_initial_fw_prop!(ϵ⁽⁰⁾, ϕₖ, ϕₖⁱⁿ, k, wrk)
    Φ₀ = wrk.fw_storage[k]
    copyto!(ϕₖ, ϕₖⁱⁿ)
    (Φ₀ !== nothing) && write_to_storage!(Φ₀, 1, ϕₖⁱⁿ)
    N_T = length(wrk.result.tlist) - 1
    for n = 1:N_T
        G, dt = _fw_gen(ϵ⁽⁰⁾, k, n, wrk)
        propstep!(ϕₖ, G, dt, wrk.fw_prop_wrk[k])
        (Φ₀ !== nothing) && write_to_storage!(Φ₀, n + 1, ϕₖ)
    end
    # TODO: allow a custom propstep! routine
end

function krotov_iteration(wrk, ϵ⁽ⁱ⁾, ϵ⁽ⁱ⁺¹⁾)

    ϕ = wrk.result.states  # assumed to contain the results of forward propagation
    χ = wrk.bw_states
    J_T_func = wrk.kwargs[:J_T]
    force_zygote = get(wrk.kwargs, :get_zygote, false)
    chi! = get(wrk.kwargs, :chi, make_chi(J_T_func, wrk.objectives; force_zygote))
    N_T = length(wrk.result.tlist) - 1
    N = length(wrk.objectives)
    L = length(wrk.controls)
    X = wrk.bw_storage
    Φ = wrk.fw_storage  # TODO: pass in Φ₁, Φ₀ as parameters
    ∫gₐdt = wrk.g_a_int
    Im = imag

    # backward propagation
    chi!(χ, ϕ, wrk.objectives)
    @threadsif wrk.use_threads for k = 1:N
        write_to_storage!(X[k], N_T + 1, χ[k])
        for n = N_T:-1:1
            local (G, dt) = _bw_gen(ϵ⁽ⁱ⁾, k, n, wrk)
            propstep!(χ[k], G, dt, wrk.bw_prop_wrk[k])
            write_to_storage!(X[k], n, χ[k])
        end
    end

    # pulse update and forward propagation

    @threadsif wrk.use_threads for k = 1:N
        copyto!(ϕ[k], wrk.objectives[k].initial_state)
    end

    ∫gₐdt .= 0.0
    for n = 1:N_T  # `n` is the index for the time interval
        dt = wrk.result.tlist[n+1] - wrk.result.tlist[n]
        for k = 1:N
            get_from_storage!(χ[k], X[k], n)
        end
        ϵₙ⁽ⁱ⁺¹⁾ = [ϵ⁽ⁱ⁾[l][n] for l ∈ 1:L]  # ϵₙ⁽ⁱ⁺¹⁾ ≈ ϵₙ⁽ⁱ⁾ for non-linear controls
        # TODO: we could add a self-consistent loop here for ϵₙ⁽ⁱ⁺¹⁾
        Δuₙ′ = zeros(L)  # for step size 1
        for l = 1:L  # `l` is the index for the different controls
            ∂ϵₗ╱∂u::Function = wrk.parametrization[l].de_du_derivative
            uₗ = wrk.parametrization[l].u_of_epsilon
            for k = 1:N  # k is the index over the objectives
                ∂Hₖ╱∂ϵₗ::Union{Function,Nothing} = wrk.control_derivs[k][l]
                if !isnothing(∂Hₖ╱∂ϵₗ)
                    μₗₖₙ = (∂Hₖ╱∂ϵₗ)(ϵₙ⁽ⁱ⁺¹⁾[l])
                    if wrk.is_parametrized[l]
                        ∂ϵₗ╱∂uₗ = (∂ϵₗ╱∂u)(uₗ(ϵₙ⁽ⁱ⁺¹⁾[l]))
                        Δuₙ′[l] += ∂ϵₗ╱∂uₗ * Im(dot(χ[k], μₗₖₙ, ϕ[k]))
                    else
                        Δuₙ′[l] += Im(dot(χ[k], μₗₖₙ, ϕ[k]))
                    end
                end
            end
        end
        # TODO: second order update
        for l = 1:L
            Sₗ = wrk.update_shapes[l]
            λₐ = wrk.lambda_vals[l]
            αₗ = (Sₗ[n] / λₐ)  # Krotov step size
            Δuₗₙ = αₗ * Δuₙ′[l]
            if wrk.is_parametrized[l]
                uₗ = wrk.parametrization[l].u_of_epsilon
                ϵₗ = wrk.parametrization[l].epsilon_of_u
                ϵ⁽ⁱ⁺¹⁾[l][n] = ϵₗ(uₗ(ϵ⁽ⁱ⁾[l][n]) + Δuₗₙ)
            else
                Δϵₗₙ = Δuₗₙ
                ϵ⁽ⁱ⁺¹⁾[l][n] = ϵ⁽ⁱ⁾[l][n] + Δϵₗₙ
            end
            (∫gₐdt)[l] += αₗ * abs(Δuₙ′[l])^2 * dt
        end
        # TODO: end of self-consistent loop
        @threadsif wrk.use_threads for k = 1:N
            local (G, dt) = _fw_gen(ϵ⁽ⁱ⁺¹⁾, k, n, wrk)
            propstep!(ϕ[k], G, dt, wrk.fw_prop_wrk[k])
            write_to_storage!(Φ[k], n, ϕ[k])
        end
        # TODO: update sigma
    end  # time loop
end

# The dynamical generator for the forward propagation
function _fw_gen(ϵ, k, n, wrk)
    vals_dict = wrk.vals_dict[k]
    t = wrk.result.tlist
    for (l, control) in enumerate(wrk.controls)
        vals_dict[control] = ϵ[l][n]
    end
    dt = t[n+1] - t[n]
    evalcontrols!(wrk.G[k], wrk.objectives[k].generator, vals_dict)
    return wrk.G[k], dt
end

# The dynamical generator for the backward propagation
function _bw_gen(ϵ, k, n, wrk)
    vals_dict = wrk.vals_dict[k]
    t = wrk.result.tlist
    for (l, control) in enumerate(wrk.controls)
        vals_dict[control] = ϵ[l][n]
    end
    dt = t[n+1] - t[n]
    evalcontrols!(wrk.G[k], wrk.adjoint_objectives[k].generator, vals_dict)
    return wrk.G[k], -dt
end

function update_result!(wrk::KrotovWrk, i::Int64)
    res = wrk.result
    J_T_func = wrk.kwargs[:J_T]
    res.J_T_prev = res.J_T
    res.J_T = J_T_func(res.states, wrk.objectives)
    (i > 0) && (res.iter = i)
    if i >= res.iter_stop
        res.converged = true
        res.message = "Reached maximum number of iterations"
        # Note: other convergence checks are done in user-supplied
        # check_convergence routine
    end
    prev_time = res.end_local_time
    res.end_local_time = now()
    res.secs = Dates.toms(res.end_local_time - prev_time) / 1000.0
    # TODO: calculate τ values
end

function finalize_result!(ϵ_opt, wrk::KrotovWrk)
    res = wrk.result
    res.end_local_time = now()
    for l = 1:length(ϵ_opt)
        res.optimized_controls[l] = discretize(ϵ_opt[l], res.tlist)
    end
end

"""Print optimization progress as a table.

This functions serves as the default `info_hook` for an optimization with
Krotov's method.
"""
function print_table(wrk, iteration, args...)
    J_T = wrk.result.J_T
    g_a_int = sum(wrk.g_a_int)
    J = J_T + g_a_int
    ΔJ_T = J_T - wrk.result.J_T_prev
    ΔJ = ΔJ_T + g_a_int
    secs = wrk.result.secs

    iter_stop = "$(get(wrk.kwargs, :iter_stop, 5000))"
    widths = [max(length("$iter_stop"), 6), 11, 11, 11, 11, 11, 8]

    if iteration == 0
        header = ["iter.", "J_T", "∫gₐ(t)dt", "J", "ΔJ_T", "ΔJ", "secs"]
        for (header, w) in zip(header, widths)
            print(lpad(header, w))
        end
        print("\n")
    end

    strs = (
        "$iteration",
        @sprintf("%.2e", J_T),
        @sprintf("%.2e", g_a_int),
        @sprintf("%.2e", J),
        (iteration > 0) ? @sprintf("%.2e", ΔJ_T) : "n/a",
        (iteration > 0) ? @sprintf("%.2e", ΔJ) : "n/a",
        @sprintf("%.1f", secs),
    )
    for (str, w) in zip(strs, widths)
        print(lpad(str, w))
    end
    print("\n")
    flush(stdout)
end


export loaddata_analyze, savedata_analyze, read_analyze_data, read_analyze_hdr

#####################
#  Analyze export
#####################

baremodule ElementType
  FLOAT32 = 16
  INT16 = 4
  RGBA = 2304
  RGB = 128
end

function _bitpix(elemType)
  if elemType == ElementType.FLOAT32
    return 32
  elseif elemType == ElementType.INT16
    return 16
  elseif elemType == ElementType.RGBA
    return 32
  elseif elemType == ElementType.RGB
    return 24
  else
    error("elemType ", elemType, " not yet supported")
  end
end

function savedata_analyze(filename::AbstractString, image::ImageMeta{T};
                          kargs...) where {T<:ColorTypes.TransparentColor}
  rgbimage = convert(RGB{N0f8},image)
  savedata_analyze{T<:TransparentColor}(filename, rgbimage; kargs...)
end

function savedata_analyze(filename::AbstractString, im::ImageMeta; verbose = false, saveas16bit=false, perm=nothing, permRGBData=false)
  filenamebase, ext = splitext(filename)

  im[:permRGBData] = permRGBData

  if get(im,"dim",3) < 3
    warn("voxel size will be wrong for 1D/2D data")
  end
  T = eltype(im)
  if T <: AbstractFloat
    c = arraydata(im)
    im[:cmin] = minimum(c)
    im[:cmax] = maximum(c)
    if saveas16bit
        im[:scalingFactor] = 2^14 / maximum(c)
        c *= im[:scalingFactor]
        c = round(Int16,c)
        im[:datatype] = ElementType.INT16
    else
        im[:scalingFactor] = 1
        if eltype(c) != Float32
          #c = map(Float32,c) #this does not work for franzi
          c = AxisArray(map(f, c.data), c.axes...)
        end
        im[:datatype] = ElementType.FLOAT32
    end
    im[:size] = [size(c,i) for i=1:4]
    im[:ndims] = ndims(c)
  else
      c = arraydata(im).data
      im[:cmin] = 0
      im[:cmax] = 1
      im[:scalingFactor] = 1
    if T <: RGB
      # This is what is returned by colorize or blend
      im[:datatype] = ElementType.RGB
      im[:size] = [size(c,i) for i=1:4]
      im[:ndims] = ndims(c)

    elseif T == UInt8
      # This is what is returned by fusedVolumes
      im[:datatype] = ElementType.RGB
      c = reorderColor(c)
      im[:size] = [size(c,i) for i=1:4]
      im[:ndims] = ndims(c)

    else
      error("Colored data has to be passed as ...")
    end
    if permRGBData

      if ndims(c) == 3
        c = reinterpret(UInt8, c, (3, size(c,1), size(c,2), size(c,3)))
        c = permutedims(c,[2,3,1,4])
      else
        c = reinterpret(UInt8, c, (3, size(c,1), size(c,2), size(c,3), size(c,4)))
        c = permutedims(c,[2,3,1,4,5])
      end
    end
  end

  header = properties(im)
  header[:pixelspacing] = collect(ustrip.(pixelspacing(im)))
  header[:offset] = collect(imcenter(im))

  if ext == ".nii"
    im[:nii_file] = true
    im[:vox_offset] = 352

    open(filenamebase*".nii","w") do fd
      write_analyze_hdr(fd, header)
      write(fd, Int32(0))
      write(fd, c)
    end
  else
    im[:nii_file] = false
    im[:vox_offset] = 0
    # write data
    open(filenamebase*".img","w") do fd
      write(fd, c)
    end

    # write Header
    open(filenamebase*".hdr","w") do fd
      write_analyze_hdr(fd, header)
    end
  end

end

function loaddata_analyze(filename::AbstractString)
  filenamebase, ext = splitext(filename)

  header = nothing
  c = nothing

  if ext == ".nii"
    c = open(filenamebase*".nii","r") do fd
      header = read_analyze_hdr(fd)
      read(fd,Int32)
      read_analyze_data(fd,header)
    end
  else
    open(filenamebase*".hdr","r") do fd
      header = read_analyze_hdr(fd)
    end

    c = open(filenamebase*".img","r") do fd
      read_analyze_data(fd,header)
    end
  end

  pixspacing = header[:pixelspacing]*1000u"mm"
  offset = header[:offset]*1000u"mm" .- 0.5.*pixspacing.*header[:size][1:3] .+ 0.5.*pixspacing
  if ndims(c) == 4
    im = AxisArray(c, (:x,:y,:z,:time), tuple(pixspacing...,one(typeof(header[:pixelspacing][1]))*u"s"),
                                   tuple(offset..., zero(typeof(header[:offset][1]))*u"s"))
  else
    im = AxisArray(c, (:x,:y,:z), tuple(pixspacing...), tuple(offset... ))
  end

  delete!(header, "pixelspacing")
  delete!(header, "timedim")

  imMeta = ImageMeta(im, header)

  return imMeta
end

function read_analyze_data(fd,header)
  if header[:datatype] == ElementType.RGB
    # colored data
    s = header[:size]
    if header[:permRGBData] == false
      c = read!(fd, Array{RGB{N0f8}}(undef, header[:size]...))
    else
      if header[:dim] == 3
        @info "3D data"
        c = read!(fd, Array{Int8}(undef, s[1], s[2], 3, s[3]))
	#c = read(fd, UInt8, s[1], s[2], 3, s[3])
        c = permutedims(c,[3,1,2,4])
        c = reinterpret(RGB{N0f8}, c, (size(c,2),size(c,3),size(c,4)))
      else
        @info "4D data"
        c = read!(fd, Array{Int8}(undef, s[1], s[2], 3, s[3], s[4]))
        #c = read(fd, UInt8, s[1], s[2], 3, s[3], s[4])
        c = permutedims(c,[3,1,2,4,5])
        c = reinterpret(RGB{N0f8}, c, (size(c,2),size(c,3),size(c,4),size(c,5)))
      end
    end
  else
    if header[:datatype] == ElementType.FLOAT32
      c = read!(fd, Array{Float32}(undef, header[:size]...))
    else
      c = map(Float32, read!(fd, Array{Int16}(undef, header[:size]...)) )
    end

    if header[:scalingFactor] > 0
      c *= (1/header[:scalingFactor])
    end
  end
  return c
end

function write_analyze_hdr(fd, header)

    s = header[:pixelspacing].*1000

    write(fd, Int32(348)) #sizeof_hdr::Int32

    data_type = "MPI"
    write(fd, data_type)
    write(fd, zeros(Int8,10-length(data_type))) #char data_type[10];

    write(fd, zeros(Int8,18)) #char db_name[18];
    write(fd, Int32(16384)) #  int extents;
    write(fd, Int16(0)) #short int session_error;
    write(fd, 'r') #char regular;
    write(fd, '0') #char hkey_un0;

    write(fd, Int16(header[:ndims])) #short int dim[8];
    write(fd, Int16(header[:size][1]))
    write(fd, Int16(header[:size][2]))
    write(fd, Int16(header[:size][3]))
    write(fd, Int16(header[:size][4]))
    write(fd, ones(Int16,3))

    write(fd, "mm  ") #vox_units	uchar[4]		spatial units of measure for a voxel
    write(fd, "mmol(Fe)") # cal_units	uchar[8]	name of the calibration unit

    write(fd, zeros(Int16,1)) # unused1	Int16

    write(fd, Int16(header[:datatype])) #short int datatype; -> Float32
    write(fd, Int16(_bitpix(header[:datatype]))) #short int bitpix;
    write(fd, Int16(0)) #short int dim_un0;

    write(fd, Float32(0)) # number of spatial dims
    write(fd, Float32(s[1]))
    write(fd, Float32(s[2]))
    write(fd, Float32(s[3]))
    write(fd, zeros(Float32,4)) # float pixdim[8];

    write(fd, Float32(header[:vox_offset])) #float vox_offset;
    #float funused1;
    #float funused2;

    off = ustrip.(uconvert.(Unitful.mm,header[:offset]))
    write(fd, Float32(off[1]))
    write(fd, Float32(off[2]))
    write(fd, Float32(off[3])) #float funused3;
    write(fd, Float32(header[:scalingFactor])) #float cal_max;  HERE WE STORE THE SCALING FACTOR!
    write(fd, Float32(0)) #float cal_min;
    write(fd, Float32(header[:permRGBData])) #float compressed;
    write(fd, Float32(0)) #float verified;
    #write(fd, round(Int32,header[:cmin]))
    #write(fd, round(Int32,header[:cmax]))#int glmax,glmin;
    write(fd, zero(Int32))
    write(fd, Int32(typemax(Int32)))#int glmax,glmin;

    description = Vector{UInt8}(header[:experimentDescription])
    description = length(description) > 9 ? description[1:9] : description
    @debug "" description
    write(fd, description)
    write(fd, zeros(Int8,80-length(description))) #char descrip[80];

    write(fd, zeros(Int8,24)) #char aux_file[24];
    write(fd, Int8(0)) #char orient;
    write(fd, zeros(Int8,10)) #char originator[10];
    write(fd, zeros(Int8,10)) #char generated[10];

    scannum = Vector{UInt8}(string(header[:experimentNumber]))
    scannum = length(scannum) > 9 ? scannum[1:9] : scannum
    @debug "" scannum
    write(fd, scannum)
    write(fd, zeros(Int8,10-length(scannum))) #char scannum[10];

    subjName = Vector{UInt8}(header[:experimentSubject])
    subjName = length(subjName) > 9 ? subjName[1:9] : subjName
    @debug "" subjName
    write(fd, subjName)
    write(fd, zeros(Int8,10-length(subjName))) #char patient_id[10];

    dateStr, timeStr = split("$(header[:acqStartTime])","T")
    dateStr = prod(split(dateStr,"-"))
    timeStr = split(timeStr,".")[1]
    timeStr = prod(split(timeStr,":"))

    date = Vector{UInt8}(dateStr)
    date = length(date) > 9 ? date[1:9] : date
    write(fd, date)
    write(fd, zeros(Int8,10-length(date))) #char exp_date[10];

    time = Vector{UInt8}(timeStr)
    time = length(time) > 9 ? time[1:9] : time
    write(fd, time)
    write(fd, zeros(Int8,10-sizeof(time))) #char exp_time[10];

    write(fd, zeros(Int8,3)) #char hist_un0[3];
    write(fd, Int32(0)) #int views
    write(fd, Int32(0)) #  int vols_added;
    write(fd, Int32(0)) #  int start_field;
    write(fd, Int32(0)) #  int field_skip;
    write(fd, Int32(0))
    write(fd, Int32(0)) #  int omax, omin;
    write(fd, Int32(0)) #  int smax, smin;
    if !header[:nii_file]
      write(fd, UInt32(0x6E693100))
    else
      write(fd, UInt32(0x6E2B3100))
    end
end

function read_analyze_hdr(fd)
    header = Dict{Symbol,Any}()

    read(fd, Int32) #sizeof_hdr::Int32

    data_type = String( read!(fd, Array{UInt8}(undef, 10)) ) #char data_type[10];
    header[:data_type] = data_type

    read!(fd, Array{Int8}(undef, 18)) #char db_name[18];
    read(fd, Int32) #  int extents;
    read(fd, Int16) #short int session_error;
    read(fd, Int8) #char regular;
    read(fd, Int8) #char hkey_un0;

    dim = read(fd, Int16)
    header[:dim] = dim
    sizes = read!(fd, Array{Int16}(undef, 7)) #short int dim[8];
    header[:size] = sizes[1:dim]

    read!(fd, Array{Int8}(undef, 4)) #vox_units	uchar[4]		spatial units of measure for a voxel
    read!(fd, Array{Int8}(undef, 8)) # cal_units	uchar[8]									name of the calibration unit

    read(fd, Int16) # unused1	Int16

    header[:datatype] = read(fd, Int16) #short int datatype; -> Float32
    read(fd, Int16) #short int bitpix;
    read(fd, Int16) #short int dim_un0;

    read(fd, Float32)
    voxelSize = read!(fd, Array{Float32}(undef, 7)) # float pixdim[8];
    header[:pixelspacing] = voxelSize[1:3] ./ 1000 # this is restricted to 3D...

    if header[:dim] == 4
      header[:timedim] = 4
    else
      header[:timedim] = 0 #This is likely not always correct
    end

    read(fd, Float32) #float vox_offset;
    #float funused1;
    #float funused2;
    off = read!(fd, Array{Float32}(undef,3)) #float funused3;
    header[:offset] = off
    if header[:data_type][1:3]!="MPI"
      header[:offset][:] .= 0.0
    end
    header[:scalingFactor] = read(fd, Float32) #float cal_max; #HERE WE READ THE SCALING FACTOR
    read(fd, Float32) #float cal_min;
    header[:permRGBData] = (read(fd, Float32) != 0.0) #float compressed;
    read(fd, Float32) #float verified;
    cmin = read(fd, Int32)
    header[:cmin] = cmin
    cmax = read(fd, Int32)
    header[:cmax] = cmax #int glmax,glmin;

    descr = String( read!(fd, Array{UInt8}(undef, 80)) ) #char descrip[80];
    header[:experimentDescription] = descr

    read!(fd, Array{UInt8}(undef, 24)) #char aux_file[24];
    read(fd, UInt8) #char orient;
    read!(fd, Array{UInt8}(undef, 10)) #char originator[10];
    read!(fd, Array{UInt8}(undef, 10)) #char generated[10];

    scannum =  String( read!(fd, Array{UInt8}(undef, 10)) ) #char scannum[10];
    header[:experimentNumber] = scannum

    patient_id =  String( read!(fd, Array{UInt8}(undef, 10)) ) #char patient_id[10];
    header[:experimentSubject] = patient_id

    exp_date =  String( read!(fd, Array{UInt8}(undef, 10)) ) #char exp_date[10];
    header[:date] = exp_date

    exp_time =  String( read!(fd, Array{UInt8}(undef, 10)) ) #char exp_time[10];
    header[:time] = exp_time

    read!(fd, Array{UInt8}(undef, 3)) #char hist_un0[3];
    read(fd, Int32) #int views
    read(fd, Int32) #  int vols_added;
    read(fd, Int32) #  int start_field;
    read(fd, Int32) #  int field_skip;
    read(fd, Int32)
    read(fd, Int32) #  int omax, omin;
    read(fd, Int32)
    read(fd, Int32) #  int smax, smin;

  return header
end


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

    AmpModelFit.jl

    structs containing parameters
    of fitted amplification models

    Author: Tom Price
    Date:   June 2019

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

import DataStructures.OrderedDict
using JuMP

#==============================================================================================
    structs and constructors
==============================================================================================#

abstract type AmpModelFit end

struct MAK2Fit <: AmpModelFit
    max_d_idx   ::Int_T
    coef_strs   ::Vector{String}
    coefs       ::Vector{Float_T}
    status      ::Symbol
    obj_val     ::Float_T
    jmp_model   ::JuMP.Model
end

## constructor
MAK2Fit(;
    max_d_idx   ::Int_T             = 0,
    coef_strs   ::Vector{String}    = Vector{String}(),
    coefs       ::Vector{Float_T}   = zeros(0),
    status      ::Symbol            = :not_fitted,
    obj_val     ::Float_T           = 0.0,
    jmp_model   ::JuMP.Model        = JuMP.Model(),
) =
    MAK2Fit(max_d_idx, coef_strs, coefs,
        status, obj_val, jmp_model)

struct MAK3Fit <: AmpModelFit
    max_d_idx   ::Int_T
    fb_start    ::Float_T
    bl_k_start  ::Float_T
    coef_strs   ::Vector{String}
    coefs       ::Vector{Float_T}
    status      ::Symbol
    obj_val     ::Float_T
    jmp_model   ::JuMP.Model
end

## constructor
MAK3Fit(;
    max_d_idx   ::Int_T             = 0,
    fb_start    ::Float_T           = 0.0,
    bl_k_start  ::Float_T           = 0.0,
    coef_strs   ::Vector{String}    = Vector{String}(),
    coefs       ::Vector{Float_T}   = zeros(0),
    status      ::Symbol            = :not_fitted,
    obj_val     ::Float_T           = 0.0,
    jmp_model   ::JuMP.Model        = JuMP.Model()
) =
    MAK3Fit(max_d_idx, fb_start, bl_k_start,
        coef_strs, coefs, status, obj_val, jmp_model)

struct MAKERGAUL3Fit <: AmpModelFit
    max_of_idx  ::Int_T
    coef_strs   ::Vector{String}
    coefs       ::Vector{Float_T}
    status      ::Symbol
    obj_val     ::Float_T
    jmp_model   ::JuMP.Model
end

## constructor
MAKERGAUL3Fit(;
    max_of_idx  ::Int_T             = 0,
    coef_strs   ::Vector{String}    = Vector{String}(),
    coefs       ::Vector{Float_T}   = zeros(0),
    status      ::Symbol            = :not_fitted,
    obj_val     ::Float_T           = 0.0,
    jmp_model   ::JuMP.Model        = JuMP.Model()
) =
    MAKERGAUL3Fit(max_of_idx, coef_strs, coefs,
        status, obj_val, jmp_model)

struct MAKERGAUL4Fit <: AmpModelFit
    max_of_idx  ::Int_T
    fb_start    ::Float_T
    bl_k_start  ::Float_T
    coef_strs   ::Vector{String}
    coefs       ::Vector{Float_T}
    status      ::Symbol
    obj_val     ::Float_T
    jmp_model   ::JuMP.Model
end

## constructor
MAKERGAUL4Fit(;
    max_of_idx  ::Int_T             = 0,
    fb_start    ::Float_T           = 0.0,
    bl_k_start  ::Float_T           = 0.0,
    coef_strs   ::Vector{String}    = Vector{String}(),
    coefs       ::Vector{Float_T}   = zeros(0),
    status      ::Symbol            = :not_fitted,
    obj_val     ::Float_T           = 0.0,
    jmp_model   ::JuMP.Model        = JuMP.Model()
) =
    MAKERGAUL4Fit(max_of_idx, fb_start, bl_k_start,
        coef_strs, coefs, status, obj_val, jmp_model)

struct SFCFit <: AmpModelFit
    coef_strs   ::Vector{String}
    coefs       ::Vector{Float_T}
    status      ::Symbol
    obj_val     ::Float_T
    jmp_model   ::JuMP.Model
    init_coefs  ::OrderedDict{String,Float_T}
end

## constructor
SFCFit(;
    coef_strs   ::Vector{String}                = Vector{String}(),
    coefs       ::Vector{Float_T}               = zeros(0),
    status      ::Symbol                        = :not_fitted,
    obj_val     ::Float_T                 = 0.0,
    jmp_model   ::JuMP.Model                    = JuMP.Model(),
    init_coefs  ::OrderedDict{String,Float_T}   = OrderedDict{String,Float_T}()
) =
    SFCFit(coef_strs, coefs, status, obj_val, jmp_model, init_coefs)


include("Shape.jl")

"""
    morph_to(to_func::Function; object=:stroke)

A closure for the [`_morph_to`](@ref) function.
This makes it easier to write the function inside an `Object`.

Currently morphing is quite simple and only works for basic shapes.
It especially does not work with functions which produce more than one polygon
or which produce filled polygons.
Blending between fills of polygons is definitely coming at a later stage.

**Important:** The functions itself should not draw the polygon
i.e. use `circle(Point(100,100), 50)` instead of `circle(Point(100,100), 50, :stroke)`

# Arguments
- `to_func::Function`: Same as `from_func` but it defines the "result" polygon,
                       which will be displayed at the end of the Object

# Keywords
- `do_action::Symbol` defines whether the object has a fill or just a stroke. Defaults to `:stroke`.

# Example

This creates a star that morphs into a circle and back.

```
astar(args...; do_action=:stroke) = star(O, 50, 5, 0.5, 0, do_action)
acirc(args...; do_action=:stroke) = circle(Point(100,100), 50, do_action)

video = Video(500, 500)
back = Background(1:20, ground)
star_obj = Object(1:10, astar)
act!(star_obj, Action(linear(), morph_to(acirc)))
circle_obj = Object(11:20, acirc)
act!(circle_obj, Action(:same, morph_to(astar)))
```
"""
function morph_to(to_func::Function; do_action = :stroke)
    return (video, object, action, frame) ->
        _morph_to(video, object, action, frame, to_func; do_action = do_action)
end

"""
    _morph_to(video::Video, object::Object, action::Action, frame, to_func::Function; do_action=:stroke)

Internal version of [`morph_to`](@ref) but described there.
"""
function _morph_to(
    video::Video,
    object::Object,
    action::Action,
    frame,
    to_func::Function;
    do_action = :stroke,
)
    newpath()
    object.func(video, object, frame; do_action = :none)
    closepath()
    from_polys = pathtopoly()

    newpath()
    to_func(video, object, frame; do_action = :none)
    closepath()
    to_polys = pathtopoly()

    return morph_between(video, action, frame, from_polys, to_polys; do_action = do_action)
end

"""
    morph_between(video::Video, action::Action, frame,
        from_polys::Vector{Vector{Point}}, to_polys::Vector{Vector{Point}};
        do_action=:stroke)

Internal version of [`morph_to`](@ref) after the from poly is defined.
"""
function morph_between(
    video::Video,
    action::Action,
    frame,
    from_polys::Vector{Vector{Point}},
    to_polys::Vector{Vector{Point}};
    do_action = :stroke,
)
    cs = get_current_setting()
    cs.show_object = false

    # computation of the polygons and the best way to morph in the first frame
    if frame == first(get_frames(action))
        save_morph_polygons!(action, from_polys, to_polys)
    end

    # obtain the computed polygons. These polygons have the same number of points.
    number_of_shapes = length(action.defs[:from_shape])
    bool_move = ones(Bool, number_of_shapes)
    bool_appear = zeros(Bool, number_of_shapes)

    for si in 1:number_of_shapes
        from_shape = action.defs[:from_shape][si]
        to_shape = action.defs[:to_shape][si]
        inter_shape = action.defs[:inter_shape][si]

        if isempty(from_shape) || isempty(to_shape)
            if isempty(to_shape)
                action.defs[:inter_shape][si] = from_shape
            else
                action.defs[:inter_shape][si] = to_shape
                bool_appear[si] = true
            end
            bool_move[si] = false
            continue
        end

        # compute the interpolation variable `t` for the current frame
        t = get_interpolation(action, frame)
        interpolate_shape!(inter_shape, from_shape, to_shape, t)
        draw_shape(inter_shape, do_action)
    end

    # let new paths appear
    t = get_interpolation(action, frame)
    setopacity(t)

    shape_ids = [si for si in 1:number_of_shapes if (!bool_move[si] && bool_appear[si])]
    shapes = action.defs[:inter_shape][shape_ids]
    draw_shape.(shapes, do_action)

    # let old paths disappear
    t = get_interpolation(action, frame)
    setopacity(1 - t)

    shape_ids = [si for si in 1:number_of_shapes if (!bool_move[si] && !bool_appear[si])]
    shapes = action.defs[:inter_shape][shape_ids]
    draw_shape.(shapes, do_action)

    setopacity(1)
end

"""
    match_num_points(poly_1::Vector{Point}, poly_2::Vector{Point})

This is a helper function for [`morph_to`](@ref).
Given two polygons `poly_1` and `poly_2` points are added to the polygon with less points
until both polygons have the same number of points.
The polygon with less points gets mutated during this process.

# Arguments
- `poly_1::Vector{Point}`: The points which define the first polygon
- `poly_2::Vector{Point}`: The points which define the second polygon
"""
function match_num_points(poly_1::Vector{Point}, poly_2::Vector{Point})
    l1 = length(poly_1)
    l2 = length(poly_2)
    # if both have the same number of points => we are done
    l1 == l2 && return poly_1, poly_2

    new_poly_1 = simplify(poly_1)
    new_poly_2 = simplify(poly_2)
    l1 = length(new_poly_1)
    l2 = length(new_poly_2)

    # poly_1 should have less points than poly_2 so we flip if this is not the case
    flipped = false
    if l1 > l2
        new_poly_1, new_poly_2 = new_poly_2, new_poly_1
        l1, l2 = l2, l1
        flipped = true
    end
    # the difference of the length of points
    missing_nodes = l2 - l1

    add_points!(new_poly_1, missing_nodes)

    if flipped
        new_poly_1, new_poly_2 = new_poly_2, new_poly_1
    end
    @assert length(new_poly_1) == length(new_poly_2)
    return new_poly_1, new_poly_2
end

"""
    add_points!(poly, missing_nodes)

Add #`missing_nodes` to poly.
"""
function add_points!(poly, missing_nodes)
    pdists = polydistances(poly)
    every_dist = pdists[end] / missing_nodes
    pdiffs = diff(pdists)

    ct = 0.0
    poly_orig = copy(poly)
    npi = 1
    for pi in 1:length(poly_orig)
        add_nodes = convert(Int, round(pdiffs[pi] / every_dist))
        t = pdiffs[pi] / (add_nodes + 1)
        ct_local = ct
        for i in 1:add_nodes
            ct_local += t
            new_point = get_polypoint_at(poly_orig, ct_local / pdists[end]; pdist = pdists)
            npi += 1
            insert!(poly, npi, new_point)
        end
        npi += 1
        missing_nodes -= add_nodes
        ct += pdiffs[pi]
        every_dist = (pdists[end] - ct) / missing_nodes
    end
end

"""
    save_morph_polygons!(action::Action, from_func::Vector{Vector{Point}},
                                         to_func::Vector{Vector{Point}})

Calls the functions to polygons and calls [`match_num_points`](@ref)
such that both polygons have the same number of points.
This is done once inside [`_morph_to`](@ref).
Saves the two polygons inside `action.defs[:from_poly]` and `action.defs[:to_poly]`.

**Assumption:** Both functions create the same number of polygons.
"""
function save_morph_polygons!(
    action::Action,
    from_polys::Vector{Vector{Point}},
    to_polys::Vector{Vector{Point}},
)
    # delete polygons with less than 2 points
    for i in length(from_polys):-1:1
        length(from_polys[i]) <= 1 && splice!(from_polys, i)
    end
    for i in length(to_polys):-1:1
        length(to_polys[i]) <= 1 && splice!(to_polys, i)
    end

    if length(from_polys) != length(to_polys)
        try_merge_polygons(from_polys)
        try_merge_polygons(to_polys)
    end

    from_shapes = create_shapes(from_polys)
    to_shapes = create_shapes(to_polys)

    if length(from_shapes) > 1
        from_shapes, to_shapes = reorder_match(from_shapes, to_shapes)
    end

    action.defs[:from_shape] = Vector{Shape}()
    action.defs[:to_shape] = Vector{Shape}()
    action.defs[:inter_shape] = Vector{Shape}()

    counter = 0
    for (from_shape, to_shape) in zip(from_shapes, to_shapes)
        counter += 1
        if isempty(from_shape) || isempty(to_shape)
            if isempty(from_shape)
                push!(action.defs[:from_shape], EmptyShape())
                push!(action.defs[:to_shape], to_shape)
                push!(
                    action.defs[:inter_shape],
                    Shape(
                        length(to_shape.points),
                        [length(subpath) for subpath in to_shape.subpaths],
                    ),
                )
            else
                push!(action.defs[:from_shape], from_shape)
                push!(action.defs[:to_shape], EmptyShape())
                push!(
                    action.defs[:inter_shape],
                    Shape(
                        length(from_shape.points),
                        [length(subpath) for subpath in from_shape.subpaths],
                    ),
                )
            end
        else
            from_shape, to_shape = prepare_to_interpolate(from_shape, to_shape)

            push!(action.defs[:from_shape], from_shape)
            push!(action.defs[:to_shape], to_shape)
            push!(
                action.defs[:inter_shape],
                Shape(
                    length(from_shape.points),
                    [length(subpath) for subpath in from_shape.subpaths],
                ),
            )
        end
    end
end

"""
    try_merge_polygons(polys)

Try to merge polygons together to match the number of polygons that get morphed.
The only example I encountered is that the `[` of a 3xY matrix consists of 3 parts which
are merged together.
"""
function try_merge_polygons(polys)
    for pi in 1:length(polys)
        !ispolyclockwise(polys[pi]) && continue
        for pj in 1:length(polys)
            pi >= pj && continue
            !ispolyclockwise(polys[pj]) && continue
            smallest_dist = Inf
            found_Ap = O
            found_Bp = O
            start_with_A = true
            for (pA, pointA1, pointA2) in
                zip(1:length(polys[pi]), polys[pi], circshift(polys[pi], -1))
                for (pB, pointB1, pointB2) in
                    zip(1:length(polys[pj]), polys[pj], circshift(polys[pj], -1))
                    dist1 = distance(pointA1, pointB2)
                    dist2 = distance(pointA2, pointB1)
                    if dist1 <= 3 && dist2 <= 3
                        if isinside((pointB1 + pointB2) / 2, polys[pi]; allowonedge = true)
                            pB1 = pB + 1 <= length(polys[pj]) ? pB + 1 : 1
                            polys[pj][pB1] = pointA1 - (pointB2 - pointA1)
                            polys[pj][pB] = pointA2 - (pointB1 - pointA2)
                            pointB2 = polys[pj][pB1]
                            pointB1 = polys[pj][pB]
                        end
                        if ispolyclockwise([pointA1, pointA2, pointB1, pointB2])
                            start_with_A = false
                            smallest_dist = dist1
                            found_Ap = pA
                            found_Bp = pB + 1 <= length(polys[pj]) ? pB + 1 : 1
                        else
                            start_with_A = true
                            smallest_dist = dist2
                            found_Ap = pA + 1 <= length(polys[pi]) ? pA + 1 : 1
                            found_Bp = pB + 1
                        end
                    end
                end
            end
            if smallest_dist <= 3
                if start_with_A
                    tmp_polyA = circshift(polys[pi], length(polys[pi]) - found_Ap + 1)
                    tmp_polyB = circshift(polys[pj], length(polys[pj]) - found_Bp)
                    polys[pi] = vcat(tmp_polyA, tmp_polyB[1:(end - 1)])
                    polys[pj] = Point[]
                else
                    tmp_polyB = circshift(polys[pj], length(polys[pj]) - found_Bp + 1)
                    tmp_polyA = circshift(polys[pi], length(polys[pi]) - found_Ap)
                    polys[pi] = vcat(tmp_polyB, tmp_polyA)
                    polys[pj] = Point[]
                end
            end
        end
    end
    for pi in length(polys):-1:1
        if isempty(polys[pi])
            splice!(polys, pi)
        end
    end
end

"""
    compute_shortest_morphing_dist(from_poly::Vector{Point}, to_poly::Vector{Point})

Rotates `from_poly` internally to check which mapping produces the smallest morphing distance.
It returns the start index of the rotation of `from_poly` as well as the smallest distance.
"""
function compute_shortest_morphing_dist(from_poly::Vector{Point}, to_poly::Vector{Point})
    # find the smallest morphing distance to match the points in a more natural way
    # smallest_i holds the best starting point of from_path
    smallest_i = 1
    smallest_distance = typemax(Float64)

    for i in 1:length(from_poly)
        overall_distance = 0.0
        for j in 1:length(from_poly)
            p1 = from_poly[mod1(j + i - 1, length(from_poly))]
            p2 = to_poly[j]
            overall_distance += distance(p1, p2)
        end
        if overall_distance < smallest_distance
            smallest_distance = overall_distance
            smallest_i = i
        end
    end
    return smallest_i, smallest_distance
end

"""
    reorder_match(from_shapes::Vector{Shape}, to_shapes::Vector{Shape})

Computes the similiarty of the shapes and finds the best mapping such that the sum of similiarty
is maximized.

Additionally it creates empty shapes when needed such that
`reordered_from` and `reordered_to` contain the same number of shapes.

# Returns
- `reordered_from::Vector{Shape}`
- `reordered_to::Vector{Shape}`
"""
function reorder_match(from_shapes::Vector{Shape}, to_shapes::Vector{Shape})
    num_shapes = max(length(from_shapes), length(to_shapes))

    similiarity_matrix = zeros(length(from_shapes), length(to_shapes))
    for fi in 1:length(from_shapes)
        from_shape = from_shapes[fi]
        for ti in 1:length(to_shapes)
            to_shape = to_shapes[ti]
            similiarity_matrix[fi, ti] = -get_similarity(from_shape, to_shape)
        end
    end
    assignment, cost = hungarian(similiarity_matrix)

    new_from_shapes = Vector{Shape}(undef, num_shapes)
    for i in 1:num_shapes
        new_from_shapes[i] = EmptyShape()
    end

    new_to_shapes = Vector{Shape}(undef, num_shapes)
    for i in 1:num_shapes
        if i <= length(to_shapes)
            new_to_shapes[i] = to_shapes[i]
        else
            new_to_shapes[i] = EmptyShape()
        end
    end

    ptr = length(to_shapes) + 1
    for i in 1:length(from_shapes)
        if assignment[i] == 0
            new_from_shapes[ptr] = from_shapes[i]
            ptr += 1
        else
            new_from_shapes[assignment[i]] = from_shapes[i]
        end
    end
    return new_from_shapes, new_to_shapes
end