################################################################################
#
#   NfOrd/Ideal/Prime.jl : Prime ideals in orders of absolute number fields
#
# This file is part of Hecke.
#
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
# * Redistributions of source code must retain the above copyright notice, this
#   list of conditions and the following disclaimer.
#
# * Redistributions in binary form must reproduce the above copyright notice,
#   this list of conditions and the following disclaimer in the documentation
#   and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
#
#  Copyright (C) 2015, 2016, 2017 Tommy Hofmann
#  Copyright (C) 2015, 2016, 2017 Claus Fieker
#
################################################################################

export PrimeIdealsSet

doc"""
***
    isramified(O::NfOrd, p::Int) -> Bool

> Returns whether the integer $p$ is ramified in $\mathcal O$.
> It is assumed that $p$ is prime.
"""
function isramified(O::NfOrd, p::Union{Int, fmpz})
  @assert ismaximal_known(O) && ismaximal(O)

  return mod(discriminant(O), p) == 0
end

doc"""
***
    degree(P::NfOrdIdl) -> Int
> The inertia degree of the prime-ideal $P$.
"""
function degree(A::NfOrdIdl)
  @assert isprime(A)
  return A.splitting_type[2]
end

doc"""
***
    ramification_index(P::NfOrdIdl) -> Int
> The ramification index of the prime-ideal $P$.
"""
function ramification_index(A::NfOrdIdl)
  @assert isprime(A)
  return A.splitting_type[1]
end

doc"""
***
    splitting_type(P::NfOrdIdl) -> Int, Int
> The ramification index and inertia degree of the prime ideal $P$.
> First value is the ramificatio index, the second the degree of $P$.
"""
function splitting_type(A::NfOrdIdl)
  @assert isprime(A)
  return A.splitting_type
end

################################################################################
#
#  Prime decomposition
#
################################################################################
doc"""
    intersect_nonindex(f::Map, P::NfOrdIdl) -> NfOrdIdl
> Given a prime ideal $P$ in $K$ and the inclusion map $f:k \to K$
> of number fields, find the unique prime $p$ in $k$ below.
"""
function intersect_nonindex(f::Map, P::NfOrdIdl)
  @assert P.is_prime == 1
  #let g be minpoly of k, G minpoly of K and h in Qt the primitive
  #element of k in K (image of gen(k))
  #then
  #  g(h) = 0 mod G
  k = domain(f)
  K = codomain(f)
  G = K.pol
  Qx = parent(G)
  g = k.pol(gen(Qx))
  h = Qx(f(gen(k)))

  Fp, xp = PolynomialRing(ResidueRing(FlintZZ, Int(minimum(P)), cached=false), cached=false)
  gp = factor(Fp(g))
  hp = Fp(h)
  Gp = gcd(Fp(K(P.gen_two)), Fp(G))
  for (f, e) = gp.fac
    if f(hp) % Gp == 0
      Zk = maximal_order(k)
      p = ideal_from_poly(Zk, Int(minimum(P)), f, 1)
      return p
    end
  end
end

doc"""
    prime_decomposition_nonindex(f::Map, p::NfOrdIdl) -> Array{Tuple{NfOrdIdl, Int}, 1}
> Given a map $f: k\to K$ of number fields defined over $\mathbb Q$ and
> a prime ideal in the maximal order of $k$, find all prime ideals in
> the maximal order of $K$ above.
"""
function prime_decomposition_nonindex(f::Map, p::NfOrdIdl)
  @assert p.is_prime == 1
  k = domain(f)
  K = codomain(f)
  ZK = maximal_order(K)
  G = K.pol
  Qx = parent(G)

  Fp, xp = PolynomialRing(ResidueRing(FlintZZ, Int(minimum(p)), cached=false), cached=false)
  Gp = factor(gcd(Fp(f(K(p.gen_two))), Fp(G)))
  res = []
  Zk = maximal_order(k)
  for (f, e) = Gp.fac
    P = ideal_from_poly(ZK, Int(minimum(p)), f, 1)
    push!(res, (P, e))
  end
  return res
end

doc"""
    lift(K::AnticNumberField, f::nmod_poly) -> nf_elem
> Given a polynomial $f$ over a finite field, lift it to an element of the
> number field $K$. The lift if given by the eleemnt represented by the
> canonical lift of $f$ to a polynomial over the integers.
"""
function lift(K::AnticNumberField, f::nmod_poly)
  if degree(f)>=degree(K)
    f = mod(f, parent(f)(K.pol))
  end
  r = K()
  for i=0:f.length-1
    u = ccall((:nmod_poly_get_coeff_ui, :libflint), UInt, (Ptr{nmod_poly}, Int), &f, i)
    _num_setcoeff!(r, i, u)
  end
  return r
end

##TODO: make fmpz-safe!!!!
#return <p, lift(O, fi> in 2-element normal presentation given the data
function ideal_from_poly(O::NfOrd, p::Int, fi::nmod_poly, ei::Int)
  b = lift(nf(O), fi)
  idl = ideal(O, fmpz(p), O(b, false))
  idl.is_prime = 1
  idl.splitting_type = ei, degree(fi)
  idl.norm = FlintZZ(p)^degree(fi)
  idl.minimum = FlintZZ(p)

  # We have to do something to get 2-normal presentation:
  # if ramified or valuation val(b,P) == 1, (p,b)
  # is a P(p)-normal presentation
  # otherwise we need to take p+b
  # I SHOULD CHECK THAT THIS WORKS

  if !((mod(norm(b),(idl.norm)^2) != 0) || (ei > 1))
    idl.gen_two = idl.gen_two + O(p)
  end

  idl.gens_normal = p
  idl.gens_weakly_normal = true

  # Find an "anti-uniformizer" in case P is unramified
  # We don't call it anti-unfiformizer anymore

  #if ideal.splitting_type[1] == 1
  #  t = parent(f)(lift(Zx, divexact(fmodp, fi)))
  #  ideal.anti_uniformizer = O(K(t), false)
  #end

  if idl.splitting_type[2] == degree(O)
    # Prime number is inert, in particular principal
    idl.is_principal = 1
    idl.princ_gen = O(p)
  end
  return idl
end

doc"""
***
    prime_decomposition(O::NfOrd,
                        p::Integer,
                        degree_limit::Int = 0,
                        lower_limit::Int = 0) -> Array{Tuple{NfOrdIdl, Int}, 1}

> Returns an array of tuples $(\mathfrak p_i,e_i)$ such that $p \mathcal O$ is the product of
> the $\mathfrak p_i^{e_i}$ and $\mathfrak p_i \neq \mathfrak p_j$ for $i \neq j$.
>
> If `degree_limit` is a nonzero integer $k > 0$, then only those prime ideals
> $\mathfrak p$ with $\deg(\mathfrak p) \leq k$ will be returned.
> Similarly if `\lower_limit` is a nonzero integer $l > 0$, then only those prime ideals
> $\mathfrak p$ with $l \leq \deg(\mathfrak p)$ will be returned.
> Note that in this case it may happen that $p\mathcal O$ is not the product of the
> $\mathfrak p_i^{e_i}$.
"""
function prime_decomposition(O::NfAbsOrd{S, T}, p::Union{Integer, fmpz}, degree_limit::Int = 0, lower_limit::Int = 0, cached::Bool = true) where {S, T}
  if typeof(p) == fmpz && nbits(p) < 64
    return prime_decomposition(O, Int(p), degree_limit, lower_limit)
  end

  if mod(index(O),fmpz(p)) == 0 || !issimple(nf(O))
    if cached
      if haskey(O.index_div, fmpz(p))
        lp = O.index_div[fmpz(p)]
        z = Tuple{NfAbsOrdIdl{S, T}, Int}[]
        for (Q, e) in lp
          if degree(Q) <= degree_limit
            push!(z, (Q, e))
          end
        end
        return z
      end
    end
    return prime_dec_index(O, p, degree_limit, lower_limit)
  end
  return prime_dec_nonindex(O, p, degree_limit, lower_limit)
end

function _fac_and_lift(f::fmpz_poly, p, degree_limit, lower_limit)
  Zx = parent(f)
  Zmodpx = PolynomialRing(ResidueRing(FlintZZ, p, cached = false), "y", cached = false)[1]
  fmodp = Zmodpx(f)
  fac = factor(fmodp)
  lifted_fac = Array{Tuple{fmpz_poly, Int}, 1}()
  for (k, v) in fac
    if degree(k) <= degree_limit && degree(k) >= lower_limit
      push!(lifted_fac, (lift(Zx, k), v))
    end
  end
  return lifted_fac
end

function prime_dec_nonindex(O::NfOrd, p::Union{Integer, fmpz}, degree_limit::Int = 0, lower_limit::Int = 0)
  K = nf(O)
  f = K.pol
  R = parent(f)
  Zx, x = PolynomialRing(FlintIntegerRing(),"x")
  Zf = Zx(f)

  if degree_limit == 0
    degree_limit = degree(K)
  end

  fac = _fac_and_lift(Zf, p, degree_limit, lower_limit)

  result = Array{Tuple{ideal_type(O),Int}}(length(fac))

  for k in 1:length(fac)
    fi = fac[k][1]
    ei = fac[k][2]
    #ideal = ideal_from_poly(O, p, fi, ei)
    t = parent(f)(fi)
    b = K(t)
    ideal = NfAbsOrdIdl(O)
    ideal.gen_one = p
    ideal.gen_two = O(b, false)
    ideal.is_prime = 1
    ideal.splitting_type = ei, degree(fi)
    ideal.norm = FlintZZ(p)^degree(fi)
    ideal.minimum = FlintZZ(p)

    # We have to do something to get 2-normal presentation:
    # if ramified or valuation val(b,P) == 1, (p,b)
    # is a P(p)-normal presentation
    # otherwise we need to take p+b
    # I SHOULD CHECK THAT THIS WORKS

    if !((mod(norm(b),(ideal.norm)^2) != 0) || (ei > 1))
      ideal.gen_two = ideal.gen_two + O(p)
    end

    ideal.gens_normal = p
    ideal.gens_weakly_normal = true

    # Find an "anti-uniformizer" in case P is unramified
    # We don't call it anti-unfiformizer anymore

    #if ideal.splitting_type[1] == 1
    #  t = parent(f)(lift(Zx, divexact(fmodp, fi)))
    #  ideal.anti_uniformizer = O(K(t), false)
    #end

    if length(fac) == 1 && ideal.splitting_type[2] == degree(f)
      # Prime number is inert, in particular principal
      ideal.is_principal = 1
      ideal.princ_gen = O(p)
    end
    result[k] =  (ideal, ei)
    k += 1
  end
  return result
end

function prime_dec_index(O::NfOrd, p::Union{Integer, fmpz}, degree_limit::Int = 0, lower_limit::Int = 0)
  if degree_limit == 0
    degree_limit = degree(O)
  end

  Ip = pradical(O, p)
  A, OtoA = AlgAss(O, Ip, p)
  AtoO = inv(OtoA)
  AA = split(A)

  basisO = basis(O)

  ideals = Vector{NfOrdIdl}()
  m = zero_matrix(FlintZZ, 1, degree(O))
  for (B, BtoA) in AA
    f = dim(B)
    idem = BtoA(B[1]) # Assumes that B == idem*A
    M = representation_matrix(idem)
    ker = left_kernel(M)
    N = basis_mat(Ip)
    for i = 1:length(ker)
      b = elem_in_basis(AtoO(A(ker[i])))
      for j = 1:degree(O)
        m[1, j] = b[j]
      end
      N = vcat(N, m)
    end
    N = sub(_hnf_modular_eldiv(N, fmpz(p), :lowerleft), rows(N) - degree(O) + 1:rows(N), 1:degree(O))
    P = ideal(O, N)
    P.norm = fmpz(p)^f
    P.splitting_type = (0, f)
    #
    fromOtosimplealgebra = Hecke._compose(inv(BtoA), OtoA)
    compute_residue_field_data!(P, fromOtosimplealgebra)
    #primB, minprimB, getcoordpowerbasis = _as_field(B)
    #@assert degree(minprimB) == f
    #P.prim_elem = AtoO(BtoA(primB))
    #P.min_poly_prim_elem = fmpz_poly(fmpz[FlintZZ(coeff(minprimB, i)) for i in 0:degree(minprimB)])
    #P.min_poly_prim_elem.parent = FmpzPolyRing(:$, false)
    #P.basis_in_prim = Vector{fmpz_mat}(degree(O))
    #for i in 1:degree(O)
    #  P.basis_in_prim[i] = zero_matrix(FlintZZ, 1, f)
    #  t = getcoordpowerbasis(BtoA\(OtoA(basisO[i])))
    #  for j in 1:f
    #    P.basis_in_prim[i][1, j] = FlintZZ(t[1, j])
    #  end
    #end
    push!(ideals, P)
  end

  result = Vector{Tuple{NfOrdIdl, Int}}()

  for j in 1:length(ideals)
    P = ideals[j]
    f = P.splitting_type[2]

    if f > degree_limit || f < lower_limit
      continue
    end

    # The following does not work if there is only one prime ideal
    if length(ideals) > 1 && (1-1/BigInt(p))^degree(O) < 0.1
      # This is roughly Algorithm 6.4 of Belabas' "Topics in comptutational algebraic
      # number theory".

      # Compute Vp = P_1 * ... * P_j-1 * P_j+1 * ... P_g

      B, BtoA = AA[j]
      J = ideal(O, AtoO(BtoA(B[1])))
      N = sub(_hnf_modular_eldiv(vcat(basis_mat(Ip), basis_mat(J)), fmpz(p), :lowerleft), degree(O) + 1:2*degree(O), 1:degree(O))
      Vp = ideal(O, N)

      u, v = idempotents(P, Vp)

      x = zero(parent(u))

      if !iszero(mod(norm(u), norm(P)*p))
        x = u
      elseif !iszero(mod(norm(u + p), norm(P)*p))
        x = u + p
      elseif !iszero(mod(norm(u - p), norm(P)*p))
        x = u - p
      else
        for i in 1:degree(O)
          if !iszero(mod(norm(v*basis(P)[i] + u), norm(P)*p))
            x = v*basis(P)[i] + u
          end
        end
      end

      @hassert :NfOrd 1 !iszero(x)
      @hassert :NfOrd 2 O*O(p) + O*x == P

      P.gen_one = p
      P.gen_two = x
      P.gens_normal = p
      P.gens_weakly_normal = 1
    else
      @vprint :NfOrd 1 "Chances for finding second generator: ~$((1-1/p))\n"
      _assure_weakly_normal_presentation(P)
      assure_2_normal(P)
    end

    e = Int(valuation(nf(O)(p), P))
    P.splitting_type = e, f
    P.is_prime = 1
    push!(result, (P, e))
  end
  #=
  if degree_limit >= degree(O)
    O.index_div[fmpz(p)] = result
  end
  =#
  return result
end

function uniformizer(P::NfOrdIdl)
  p = minimum(P)
  if P.gens_normal == p
    return P.gen_two
  else
    if p > 250
      r = 500  # should still have enough elements...
    else
      r = Int(div(p, 2))
    end
    z = rand(P, r)
    while true
      if !iszero(z) && valuation(z, P) == 1
        break
      end
      z = rand(P, r)
    end
    return z
  end
end

# Belabas p. 40
function anti_uniformizer(P::NfOrdIdl)
  if isdefined(P, :anti_uniformizer)
    return P.anti_uniformizer
  else
    p = minimum(P)
    M = representation_matrix(uniformizer(P))
    Mp = MatrixSpace(ResidueRing(FlintZZ, p, cached=false), rows(M), cols(M), false)(M)
    K = kernel(Mp)
    @assert length(K) > 0
    P.anti_uniformizer = elem_in_nf(order(P)(_lift(K[1])))//p
    return P.anti_uniformizer
  end
end

# Don't use the following function. It does not work for index divisors
# TH: Or does it?
function prime_decomposition_type(O::NfOrd, p::Integer)
  if (mod(discriminant(O), p)) != 0 && (mod(fmpz(index(O)), p) != 0)
    K = nf(O)
    f = K.pol
    R = parent(f)
    Zx, x = PolynomialRing(FlintZZ,"x", cached=false)
    Zf = Zx(f)
    fmodp = PolynomialRing(ResidueRing(FlintZZ,p, cached = false), "y", cached = false)[1](Zf)
    fac = factor_shape(fmodp)
    g = sum([ x for x in values(fac)])
    res = Array{Tuple{Int, Int}}(g)
    k = 1
    for (fi, ei) in fac
      for j in 1:ei
        res[k] = (fi, 1)
        k = k + 1
      end
    end
  else
    lp = prime_decomposition(O, p)
    res = Array{Tuple{Int, Int}}(length(lp))
    for i in 1:length(lp)
      res[i] = (lp[i][1].splitting_type[2], lp[i][1].splitting_type[1])
    end
  end
  return res
end

doc"""
***
    prime_ideals_up_to(O::NfOrd,
                       B::Int;
                       degree_limit::Int = 0) -> Array{NfOrdIdl, 1}

> Computes the prime ideals $\mathcal O$ with norm up to $B$.
>
> If `degree_limit` is a nonzero integer $k$, then prime ideals $\mathfrak p$
> with $\deg(\mathfrak p) > k$ will be discarded.
"""
function prime_ideals_up_to(O::NfOrd, B::Int;
                            complete::Bool = false,
                            degree_limit::Int = 0)
  p = 1
  r = NfOrdIdl[]
  while p < B
    p = next_prime(p)
    if p > B
      return r
    end
    if !complete
      deg_lim = Int(floor(log(B)/log(p)))
      if degree_limit >0
        deg_lim = min(deg_lim, degree_limit)
      end
    else
      deg_lim = 0
    end
    @vprint :ClassGroup 2 "decomposing $p ... (bound is $B, deg_lim $deg_lim)\n"
    li = prime_decomposition(O, p, deg_lim)
    for P in li
      push!(r, P[1])
    end
  end
  return r
end

doc"""
***
    prime_ideals_over(O::NfOrd,
                       lp::AbstractArray{Int, 1};
                       degree_limit::Int = 0) -> Array{NfOrdIdl, 1}

> Computes the prime ideals $\mathcal O$ over prime numbers in $lp$.
>
> If `degree_limit` is a nonzero integer $k$, then prime ideals $\mathfrak p$
> with $\deg(\mathfrak p) > k$ will be discarded.
"""
function prime_ideals_over(O::NfOrd,
                           lp::AbstractArray{T};
                           degree_limit::Int = 0) where T <: Union{fmpz, Integer}
  p = 1
  r = NfOrdIdl[]
  for p in lp
    @vprint :ClassGroup 2 "decomposing $p ... (deg_lim $deg_lim)"
    li = prime_decomposition(O, p, degree_limit)
    for P in li
      push!(r, P[1])
    end
  end
  return r
end

doc"""
***
    prime_ideals_up_to(O::NfOrd,
                       B::Int;
                       complete::Bool = false,
                       degree_limit::Int = 0,
                       F::Function,
                       bad::fmpz)

> Computes the prime ideals $\mathcal O$ with norm up to $B$.
>
> If `degree_limit` is a nonzero integer $k$, then prime ideals $\mathfrak p$
> with $\deg(\mathfrak p) > k$ will be discarded.
>
> The function $F$ must be a function on prime numbers not dividing `bad` such that
> $F(p) = \deg(\mathfrak p)$ for all prime ideals $\mathfrak p$ lying above $p$.
"""
function prime_ideals_up_to(O::NfOrd, B::Int, F::Function, bad::fmpz = discriminant(O);
                            complete::Bool = false,
                            degree_limit::Int = 0)
  p = 1
  r = NfOrdIdl[]
  while p < B
    p = next_prime(p)
    if p > B
      return r
    end
    if !complete
      deg_lim = flog(fmpz(B), p) # Int(floor(log(B)/log(p)))
      if degree_limit > 0
        deg_lim = min(deg_lim, degree_limit)
      end
    else
      deg_lim = 0
    end
    @vprint :ClassGroup 2 "decomposing $p ... (bound is $B)"
    if mod(bad, p) == 0
      li = prime_decomposition(O, p, deg_lim)
      for P in li
        push!(r, P[1])
      end
    else
      if F(p) <= deg_lim
        li = prime_decomposition(O, p, deg_lim)
        for P in li
          push!(r, P[1])
        end
      end
    end
  end
  return r
end

################################################################################
#
#  Coprime
#
################################################################################

#TODO: do sth. useful here!!!
function divides(A::NfOrdIdl, B::NfOrdIdl)
  minimum(A) % minimum(B) == 0 || return false
  return valuation(A, B) > 0
end

function coprime_base(A::Array{NfOrdIdl, 1}, p::fmpz)
  #consider A^2 B and A B: if we do gcd with the minimum, we get twice AB
  #so the coprime base is AB
  #however using the p-part of the norm, the coprime basis becomes A, B...
  if iseven(p)
    lp = prime_decomposition(order(A[1]), 2)
    Ap = [x[1] for x = lp if any(y->divides(y, x[1]) > 0, A)]
    a = remove(p, 2)[2]
    if !isone(a)
      Bp = coprime_base(A, a)
      return vcat(Ap, Bp)
    else
      return Ap
    end
  else
    Ap = [gcd(x, p^valuation(norm(x), p)) for x = A if minimum(x) % p == 0]
  end
  return coprime_base_steel(Ap)
end

doc"""
***
    coprime_base(A::Array{NfOrdIdl, 1}) -> Array{NfOrdIdl, 1}
    coprime_base(A::Array{NfOrdElem, 1}) -> Array{NfOrdIdl, 1}
> A coprime base for the (principal) ideals in $A$, ie. the returned array
> generated multiplicatively the same ideals as the input and are pairwise
> coprime.
"""
function coprime_base(A::Array{NfOrdIdl, 1})
  a = collect(Set(map(minimum, A)))
  a = coprime_base(a)
  C = Array{NfOrdIdl, 1}()

  for p = a
    if p == 1
      continue
    end
    cp = coprime_base(A, p)
    append!(C, cp)
  end
  return C
end

function coprime_base(A::Array{NfOrdElem, 1})
  O = parent(A[1])
  return coprime_base([ideal(O, x) for x = A])
end

function integral_split(A::NfOrdIdl)
  return A, ideal(Order(A), fmpz(1))
end

################################################################################
#
#  Factorization into prime ideals
#
################################################################################

#TODO: factoring type??? (with unit)
doc"""
***
    factor(A::NfOrdIdl) -> Dict{NfOrdIdl, Int}

> Computes the prime ideal factorization $A$ as a dictionary, the keys being
> the prime ideal divisors:
> If `lp = factor_dict(A)`, then `keys(lp)` are the prime ideal divisors of A
> and `lp[P]` is the `P`-adic valuation of `A` for all `P` in `keys(lp)`.
"""
factor(A::NfOrdIdl) = factor_dict(A)

function factor_dict(A::NfOrdIdl)
  ## this should be fixed
  lf = factor(minimum(A))
  lF = Dict{NfOrdIdl, Int}()
  n = norm(A)
  O = order(A)
  for (i, (p, v)) in enumerate(lf)
    lP = prime_decomposition(O, p)
    for P in lP
      v = valuation(A, P[1])
      if v != 0
        lF[P[1]] = v
        n = n//norm(P[1])^v
      end
      if n == 1
        return lF
      end
    end
  end
  return lF
end

################################################################################
#
#  Functions for index divisor splitting
#
################################################################################

mutable struct quoringalg{T} <: Ring
  base_order::NfOrd
  ideal::NfOrdIdl
  prime::T
  basis::Array{NfOrdElem, 1}

  function quoringalg(O::NfOrd, I::NfOrdIdl, p::T) where {T}

    z = new{T}()
    z.base_order = O
    z.ideal = I
    z.prime = p

    # compute a basis
    Rp = ResidueRing(FlintZZ, p, cached=false)
    Amodp = MatrixSpace(Rp, degree(O), degree(O), false)(basis_mat(I))
    Amodp = vcat(Amodp, zero_matrix(Rp, 1, degree(O)))
    Amodp[1,1] = 1
    Amodp = sub(Amodp, 1:degree(O), 1:degree(O))

    r, B = _rref(Amodp)
    C = zero_matrix(Rp, degree(O)-r, degree(O))
    BB = Array{NfOrdElem}(degree(O) - r)
    pivots = Array{Int}(0)
#    # get he pivots of B
    for i in 1:r
      for j in 1:degree(O)
        if !iszero(B[i,j])
          push!(pivots, j)
          break
        end
      end
    end
    i = 1
    k = 1
    while i <= degree(O)-r
      for j in k:degree(O)
        if !in(j, pivots)
          BB[i] = basis(O)[j]
          C[i,j] = 1
          k = j + 1
          i = i + 1
          break
        end
      end
    end
    insert!(BB, 1, basis(O)[1])
    z.basis = BB
    return z
  end
end

mutable struct quoelem
  parent::quoringalg
  elem::NfOrdElem
  coord::Array{fmpz, 1}

  function quoelem(R::quoringalg, x::NfOrdElem)
    z = new()
    z.parent = R
    z.elem = x

    return z
  end
end

function _kernel_of_frobenius(R::quoringalg)
  O = R.base_order
  BB = R.basis
  p = R.prime
  Rp = ResidueRing(FlintZZ, R.prime, cached=false)
  C = zero_matrix(Rp, length(BB)+1, degree(O))
  D = zero_matrix(Rp, length(BB), degree(O))

  Q, mQ = quo(O, R.ideal)

  function g(x)
    return mQ\(mQ(x)^p)
  end

  for i in 1:length(BB)
    A = elem_in_basis(mod(g(BB[i]) - BB[i], R.ideal))
    for j in 1:degree(O)
      D[i,j] = A[j]
    end
  end

  DD = NfOrdElem[ dot(BB, _lift(r)) for r in kernel(D) ]

  return [ quoelem(R, r) for r in DD ]
end

function _lift(T::Array{Generic.Res{fmpz}, 1})
  return [ z.data for z in T ]
end

function _lift(T::Array{Nemo.nmod, 1})
  return [ fmpz(z.data) for z in T ]
end

function *(x::quoelem, y::quoelem)
  z = mod(x.elem * y.elem, x.parent.ideal)
  return quoelem(x.parent, z)
end

function ^(x::quoelem, y::Int)
  z = mod(x.elem^y, x.parent.ideal)
  return quoelem(x.parent, z)
end

function ^(x::quoelem, y::Union{Integer, fmpz})
  # Do something stupid
  R, m = quo(x.parent.base_order, x.parent.ideal)
  return quoelem(x.parent, (m\(m(x.elem)^y)))
end

function ==(x::quoelem, y::quoelem)
  z = mod(x.elem - y.elem, x.parent.ideal)
  return zero(parent(z)) == z
end

function minpoly(x::quoelem)
  O = x.parent.base_order
  p = x.parent.prime

  Rp = ResidueRing(FlintZZ, p, cached=false)
  A = zero_matrix(Rp, 0, degree(O))
  B = zero_matrix(Rp, 1, degree(O))

  for i in 0:degree(O)
    ar = elem_in_basis((x^i).elem)
    for j in 1:degree(O)
      B[1, j] = ar[j]
    end
    A = vcat(A, B)
    K = kernel(A)
    if length(K) > 0
      @assert length(K) == 1
      f = PolynomialRing(Rp, "x", cached=false)[1](K[1])
      return f
    end
  end
  error("cannot find minpoly")
end

function split(R::quoringalg)
  if length(R.basis) == 1
    return [ R ]
  end
  K = _kernel_of_frobenius(R)
  O = R.base_order
  p = R.prime

  k = length(K)

  if k == 1
    # the algebra is a field over F_p
    # the ideal Ip is a prime ideal!
    return [ R ]
  end

  maxit = 1

  while true
    maxit = maxit + 1
    r = rand(0:p-1, length(K))

    x = quoelem(R, dot([ x.elem for x in K], r))

    if mod((x^p).elem, R.ideal) != mod(x.elem, R.ideal)
      #println("element^p: $(mod((x^p).elem, R.ideal))")
      #println("element: $(mod(x.elem, R.ideal))")
      #println(R.ideal.basis_mat)
      #println(K)
      error("Strange")
    end

    f = minpoly(x)

    if degree(f) < 2
      continue
    end
    @assert  issquarefree(f)

#    # By theory, all factors should have degree 1 # exploit this if p is small!
    fac = factor(f)
    F = first(keys(fac.fac))
    @assert length(fac) == degree(f)
    H = divexact(f,F)
    E, U, V = gcdx(F, H)
    @assert E == 1
    H = U*F;
    idem = O(coeff(H,0).data)
    for i in 1:degree(H)
      idem = idem + coeff(H,i).data*x.elem^i
    end

    I1 = R.ideal + ideal(O, idem)
    I2 = R.ideal + ideal(O, O(1)-idem)

    return vcat(split(quoringalg(O, I1, p)), split(quoringalg(O, I2, p)))
    break
  end
end

################################################################################
#
#  Primality testing
#
################################################################################

doc"""
***
    isprime_known(A::NfOrdIdl) -> Bool

> Returns whether $A$ knows if it is prime.
"""
function isprime_known(A::NfOrdIdl)
  return A.is_prime != 0
end

doc"""
***
    isprime(A::NfOrdIdl) -> Bool

> Returns whether $A$ is a prime ideal.
"""
function isprime(A::NfOrdIdl)
  if isprime_known(A)
    return A.is_prime == 1
  elseif minimum(A) == 0
    A.is_prime = 2
    return false
  end

  (n, p) = ispower(norm(A, Val{false}))

  if !isprime(p)
    A.is_prime = 2
    return false
  end

  p > 2^62 && error("Not implemented (yet)")

  lp = prime_decomposition(order(A), Int(p))

  for (P, f) in lp
    e = valuation(A, P)
    if e == 1 && n == degree(P)
      A.is_prime = 1
      return true
    elseif e == 0
      continue
    else
      A.is_prime = 2
      return false
    end
  end

  error("Something wrong in isprime")
end

################################################################################
#
#  Valuation
#
################################################################################

# CF:
# Classical algorithm of Cohen, but take a valuation element with smaller (?)
# coefficients. Core idea is that the valuation elementt is, originally, den*gen_two(p)^-1
# where gen_two(p) is "small". Actually, we don't care about gen_two, we
# need gen_two^-1 to be small, hence this version.
function val_func_no_index(p::NfOrdIdl)
  P = p.gen_one
  K = nf(order(p))
  pi = inv(p)
  d = denominator(K(pi.num.gen_two))
  @assert gcd(d, P) == 1
  e = K(pi.num.gen_two)*d
  M = zero_matrix(FlintZZ, 1, degree(K))
  elem_to_mat_row!(M, 1, d, e)
  @assert d == 1
  P2 = P^2
  P22 = div(P2, 2)
  for i=1:degree(K)
    x = M[1,i] % P2
    if x>P22
      x -= P2
    end
    M[1,i] = x
  end
  e = elem_from_mat_row(K, M, 1, P)
  # e is still a valuation element, but with smaller coefficients.
  return function(x::nf_elem)
    v = 0
    d = denominator(x)
    x *= d
    x = x*e
    while denominator(x) % P != 0
      v += 1
      mul!(x, x, e)
    end
    return v-valuation(d, P)*p.splitting_type[1]
  end
end

# CF:
# The idea is that valuations are mostly small, eg. in the class group
# algorithm. So this version computes the completion and the embedding into it
# at small precision and can thus compute (small) valuation at the effective
# cost of an mod(nmod_poly, nmod_poly) operation.
# Isn't it nice?
function valuation(a::UInt, b::UInt)
  return ccall((:n_remove, :libflint), Int, (Ref{UInt}, UInt), a, b)
end

#=
function valuation(a::UInt, b::UInt, bi::Cdouble)
  return ccall((:n_remove2_precomp, :libflint), Int, (Ref{UInt}, UInt, Cdouble), a, b, bi)
end
=#

function val_func_no_index_small(p::NfOrdIdl)
  P = p.gen_one
  @assert P <= typemax(UInt)
  K = nf(order(p))
  Rx = PolynomialRing(ResidueRing(FlintZZ, UInt(P), cached=false), cached=false)[1]
  Zx = PolynomialRing(FlintZZ)[1]
  g = Rx(p.gen_two.elem_in_nf)
  f = Rx(K.pol)
  g = gcd!(g, g, f)
  g = lift(Zx, g)
  k = flog(fmpz(typemax(UInt)), P)
  g = hensel_lift(Zx(K.pol), g, P, k)
  Sx = PolynomialRing(ResidueRing(FlintZZ, UInt(P)^k, cached=false), cached=false)[1]
  g = Sx(g)
  h = Sx()
  uP = UInt(P)
  return function(x::nf_elem)
    d = denominator(x)
    nf_elem_to_nmod_poly!(h, x, false) # ignores the denominator
    h = rem!(h, h, g)
    c = Nemo.coeff_raw(h, 0)
    v = c==0 ? typemax(Int) : valuation(c, uP)
    for i=1:degree(h)
      c = Nemo.coeff_raw(h, i)
      v = min(v, c==0 ? typemax(Int) : valuation(c, uP))
    end
    return v-valuation(d, P)
  end
end

function val_func_index(p::NfOrdIdl)
  # We are in the index divisor case. In larger examples, a lot of
  # time is spent computing denominators of order elements.
  # By using the representation matrix to multiply, we can stay in the order
  # and still be fast (faster even than in field).

  pi = inv(p)
  M = representation_matrix(pi.num.gen_two)
  O = order(p)
  P = p.gen_one
  return function(x::nf_elem)
    v = 0
    d, x_mat = integral_split(x, O)
    Nemo.mul!(x_mat, x_mat, M)
    while gcd(content(x_mat), P) == P  # should divide and test in place
      divexact!(x_mat, x_mat, P)
      Nemo.mul!(x_mat, x_mat, M)
      v += 1
    end
    return v-valuation(d, P)*p.splitting_type[1]
  end
end

doc"""
***
    valuation(a::nf_elem, p::NfOrdIdl) -> fmpz
    valuation(a::NfOrdElem, p::NfOrdIdl) -> fmpz
    valuation(a::fmpz, p::NfOrdIdl) -> fmpz

> Computes the $\mathfrak p$-adic valuation of $a$, that is, the largest $i$
> such that $a$ is contained in $\mathfrak p^i$.
"""
function valuation(a::nf_elem, p::NfOrdIdl)
  @hassert :NfOrd 0 !iszero(a)
  #assert(a !=0) # can't handle infinity yet
  if isdefined(p, :valuation)
    return p.valuation(a)::Int
  end
  O = order(p)
  P = p.gen_one

  # for generic ideals
  if p.splitting_type[2] == 0
    #global bad_ideal = p
    p.valuation = function(a::nf_elem)
      d = denominator(a, O)
      x = O(d*a)
      return valuation_naive(O(x), p)::Int - valuation_naive(O(d), p)::Int
    end
    return p.valuation(a)::Int
  end

  if p.splitting_type[1]*p.splitting_type[2] == degree(O)
    p.valuation = function(a::nf_elem)
      return divexact(valuation(norm(a), P)[1], p.splitting_type[2])::Int
    end
  elseif mod(index(O),P) != 0 && p.splitting_type[1] == 1
    if p.gen_one^2 <= typemax(UInt)
      f1 = val_func_no_index_small(p)
      f2 = val_func_no_index(p)
      p.valuation = function(x::nf_elem)
        v = f1(x)
        if v > 100  # can happen ONLY if the precision in the .._small function
                    # was too small.
          return f2(x)::Int
        else
          return v::Int
        end
      end
    else
      p.valuation = val_func_no_index(p)
    end
  else
    p.valuation = val_func_index(p)
  end

  return p.valuation(a)::Int
end

doc"""
***
    valuation(a::nf_elem, p::NfOrdIdl) -> fmpz
    valuation(a::NfOrdElem, p::NfOrdIdl) -> fmpz
    valuation(a::fmpz, p::NfOrdIdl) -> fmpz

> Computes the $\mathfrak p$-adic valuation of $a$, that is, the largest $i$
> such that $a$ is contained in $\mathfrak p^i$.
"""
valuation(a::NfOrdElem, p::NfOrdIdl) = valuation(a.elem_in_nf, p)

doc"""
***
    valuation(a::nf_elem, p::NfOrdIdl) -> fmpz
    valuation(a::NfOrdElem, p::NfOrdIdl) -> fmpz
    valuation(a::fmpz, p::NfOrdIdl) -> fmpz

> Computes the $\mathfrak p$-adic valuation of $a$, that is, the largest $i$
> such that $a$ is contained in $\mathfrak p^i$.
"""
function valuation(a::fmpz, p::NfOrdIdl)
  if p.splitting_type[1] == 0
    return valuation_naive(order(p)(a), p)
  end
  P = p.gen_one
  return valuation(a, P)* p.splitting_type[1]
end
valuation(a::Integer, p::NfOrdIdl) = valuation(fmpz(a), p)

#TODO: some more intelligence here...
function valuation_naive(A::NfOrdIdl, B::NfOrdIdl)
  @assert !isone(B)
  Bi = inv(B)
  i = 0
  C = simplify(A* Bi)
  while denominator(C) == 1
    C = simplify(Bi*C)
    i += 1
  end
  return i
end

#TODO: some more intelligence here...
#      in non-maximal orders, interesting ideals cannot be inverted
#      maybe this needs to be checked...
function valuation_naive(x::NfOrdElem, B::NfOrdIdl)
  @assert !isone(B)
  i = 0
  C = B
  while x in C
    i += 1
    C *= B
  end
  return i
end

doc"""
***
    valuation(A::NfOrdIdl, p::NfOrdIdl) -> fmpz

> Computes the $\mathfrak p$-adic valuation of $A$, that is, the largest $i$
> such that $A$ is contained in $\mathfrak p^i$.
"""
function valuation(A::NfOrdIdl, p::NfOrdIdl)
  _assure_weakly_normal_presentation(A)
  if !isdefined(p, :splitting_type) || p.splitting_type[1] == 0 #ie. if p is non-prime...
    return valuation_naive(A, p)
  end
  return min(valuation(A.gen_one, p), valuation(elem_in_nf(A.gen_two), p))
end

################################################################################
#
#   Prime ideals iterator
#
################################################################################

mutable struct PrimeIdealsSet
  order::NfOrd
  from::fmpz
  to::fmpz
  primes::PrimesSet{fmpz}
  currentprime::fmpz
  currentindex::Int
  decomposition::Array{Tuple{NfOrdIdl, Int}, 1}
  proof::Bool
  indexdivisors::Bool
  ramified::Bool
  iscoprimeto::Bool
  coprimeto::NfOrdIdl
  degreebound::Int
  unbound::Bool

  function PrimeIdealsSet(O::NfOrd)
    z = new()
    z.order = O
    z.proof = false
    z.indexdivisors = true
    z.ramified = true
    z.unbound = false
    z.degreebound =  degree(O)
    z.iscoprimeto = false
    return z
  end
end

doc"""
***
    PrimeIdealsSet(O::NfOrd, f, t; proof = false,
                                   indexdivisors = true,
                                   ramified = true,
                                   degreebound = degree(O),
                                   coprimeto = false)

Returns an iterable object $S$ representing the prime ideals $\mathfrak p$
of $\mathcal O$ with $f \leq \min(\mathfrak p) \leq t$.

The optional arguments can be used to exclude index divisors, ramified prime
ideals and to include only prime ideals with degree less or equal than
`degreebound` and which are coprime to `coprimeto`.

If $t=-1$, then the upper bound is infinite.

If `coprimeto` is supplied, it must be either an integer, an element of $\mathcal O$,
or a non-zero ideal of $\mathcal O$.
"""
function PrimeIdealsSet(O::NfOrd, from::T, to::S;
                       proof::Bool = false,
                       indexdivisors::Bool = true,
                       ramified::Bool = true,
                       degreebound::Int = degree(O),
                       coprimeto = false) where {T <: Union{fmpz, Integer},
                                                 S <: Union{fmpz, Integer}}
  from < 0 && error("Lower bound must be non-negative")
  to < -1 && error("Upper bound must be non-negative or -1")

  z = PrimeIdealsSet(O)
  z.from = fmpz(from)
  z.to = fmpz(to)
  z.primes = PrimesSet(z.from, z.to)
  if to == -1
    z.unbound = true
  end
  z.proof = proof
  z.indexdivisors = indexdivisors
  z.ramified = ramified
  z.degreebound = degreebound
  if !(coprimeto isa Bool)
    if coprimeto isa NfOrdIdl
      z.coprimeto = coprimeto
    elseif coprimeto isa Union{Integer, fmpz, NfOrdElem}
      z.coprimeto = ideal(O, coprimeto)
    else
      error("Coprime argument of wrong type ($(typeof(coprimeto)))")
    end
    z.iscoprimeto = true
  end
  return z
end

function Base.start(S::PrimeIdealsSet)
  O = S.order
  pstate = start(S.primes)
  found_prime = false
  while !found_prime
    (p, pstate) = next(S.primes, pstate)
    if !S.indexdivisors && isindex_divisor(O, p)
      continue
    end
    lP = prime_decomposition(O, p)
    j = -1
    for i in 1:length(lP)
      e = lP[i][2]
      if !S.ramified && e > 1
        continue
      end
      P = lP[i][1]
      if P.splitting_type[2] > S.degreebound
        continue
      end
      if S.iscoprimeto && !iscoprime(P, S.coprimeto)
        continue
      end
      j = i
      break
    end
    if j != -1
      S.decomposition = lP
      S.currentprime = p
      S.currentindex = j
      return (p, j)
    end
  end
end

function Base.next(S::PrimeIdealsSet, x)
  pstate = x[1]
  j = x[2]
  Q = S.decomposition[j][1] # This we want to return
  newindex = -1
  lP = S.decomposition
  O = S.order

  # Find the next prime ideal in the current decomposition
  for i in (j + 1):length(S.decomposition)
    e = lP[i][2]
    if !S.ramified && e > 1
      continue
    end
    P = lP[i][1]
    if P.splitting_type[2] > S.degreebound
      continue
    end
    newindex = i
    break
  end

  if newindex != -1
    return Q, (pstate, newindex)
  else
    # We have to change the prime
    found_prime = false
    while !found_prime
      (p, pstate) = next(S.primes, pstate)
      if !S.indexdivisors && isindex_divisor(O, pstate)
        continue
      end
      lP = prime_decomposition(O, pstate)
      j = -1
      for i in 1:length(lP)
        e = lP[i][2]
        if !S.ramified && e > 1
          continue
        end
        P = lP[i][1]
        if P.splitting_type[2] > S.degreebound
          continue
        end
        if S.iscoprimeto && !iscoprime(P, S.coprimeto)
          continue
        end
        j = i
        break
      end
      if j != -1
        S.decomposition = lP
        S.currentprime = p
        S.currentindex = j
        return Q, (pstate, j)
      end
    end
  end
end

function Base.done(S::PrimeIdealsSet, x)
  pstate = x[1]
  index = x[2]
  return !S.unbound && pstate > S.to
end

Base.eltype(::PrimeIdealsSet) = NfOrdIdl

Base.iteratorsize(::Type{PrimeIdealsSet}) = Base.SizeUnknown()


# included from Potentials.jl
# part of the module JuLIP.Potentials

using JuLIP: JVec, JMat, neighbourlist
using LinearAlgebra: I
using JuLIP.Chemistry: atomic_number
using NeighbourLists

export ZeroPairPotential, ZBLPotential,
         LennardJones, lennardjones,
         Morse, morse

# For PairPotentials we do something kind of weird - we create an intentional
# stack overflow by redirecting
#    evaluate -> evaluate! -> evaluate -> evaluate! -> ...
# A concrete instance of PairPotential must overload either evaluate or
# evaluate! to break this infinite loop. The advantage though is that either
# can be implemented.

evaluate(V::PairPotential, r::Number, z1, z0) =
      evaluate!(alloc_temp(V, 1), V, r, z1, z0)
evaluate_d(V::PairPotential, r::Number, z1, z0) =
      evaluate_d!(alloc_temp_d(V, 1), V, r, z1, z0)
evaluate_dd(V::PairPotential, r::Number, z1, z0) =
      evaluate_dd!(alloc_temp_dd(V, 1), V, r, z1, z0)
evaluate!(tmp, V::PairPotential, r::Number, z1, z0) =
      evaluate(V, r, z1, z0)
evaluate_d!(tmp, V::PairPotential, r::Number, z1, z0) =
      evaluate_d(V, r, z1, z0)
evaluate_dd!(tmp, V::PairPotential, r::Number, z1, z0) =
      evaluate_dd(V, r, z1, z0)

# evaluate!(tmp, V::PairPotential, r::Union{Number, JVec}) = V(r)
# evaluate_d!(tmp, V::PairPotential, r::Number) = @D V(r)
# evaluate_dd!(tmp, V::PairPotential, r::Number) = @DD V(r)
# evaluate_d!(tmp, V::PairPotential, R::JVec) =
#       evaluate_d!(tmp, V, norm(R), R)
# evaluate_d!(tmp, V::PairPotential, r::Number, R::JVec) = ((@D V(r))/r) * R
# evaluate_dd!(tmp, V::PairPotential, r::Number) = @DD V(r)
# evaluate_dd!(tmp, V::PairPotential, R::JVec) =
#       evaluate_dd!(tmp, V, norm(R), R)
# evaluate_dd!(tmp, V::PairPotential, r::Number, R::JVec) =
#       _hess!(tmp, V, r, R)

function evaluate!(tmp, V::PairPotential,
                   R::AbstractVector{JVec{T}}, Z, z0) where {T}
   Es = zero(T)
   for i = 1:length(R)
      Es += T(0.5) * evaluate!(tmp, V, norm(R[i]), Z[i], z0)
   end
   return Es
end

function evaluate_d!(dEs, tmp, V::PairPotential,
                     R::AbstractVector{JVec{T}}, Z, z0) where {T}
   for i = 1:length(R)
      r = norm(R[i])
      dEs[i] = (T(0.5) * evaluate_d!(tmp, V, r, Z[i], z0) / r) * R[i]
   end
   return dEs
end

function evaluate_dd!(hEs, tmp, V::PairPotential,
                      R::AbstractVector{<: JVec}, Z, z0)
   n = length(R)
   for i = 1:n
      hEs[i,i] = 0.5 * _hess!(tmp, V, norm(R[i]), R[i], Z[i], z0)
   end
   return hEs
end

function _hess!(tmp, V::PairPotential, r::Number, R::JVec, z1, z0)
   R̂ = R/r
   P = R̂ * R̂'
   dV = evaluate_d!(tmp, V, r, z1, z0) / r
   ddV = evaluate_dd!(tmp, V, r, z1, z0)
   return (ddV - dV) * P + dV * I
end

function precon!(hEs, tmp, V::PairPotential,
                 R::AbstractVector{<: JVec{T}}, Z, z0,
                 innerstab=T(0.0)) where {T}
   n = length(R)
   for i = 1:n
      hEs[i,i] = precon!(tmp, V, norm(R[i]), R[i], Z[i], z0, innerstab)
   end
   return hEs
end

# an FF preconditioner for pair potentials
function precon!(tmp, V::PairPotential, r::T, R::JVec{T}, innerstab=T(0.1)
                 ) where {T <: Number}
   r = norm(R)
   dV = evaluate_d!(tmp, V, r)
   ddV = evaluate_dd!(tmp, V, r)
   R̂ = R/r
   return (1-innerstab) * (abs(ddV) * R̂ * R̂' + abs(dV / r) * (I - R̂ * R̂')) +
             innerstab  * (abs(ddV) + abs(dV / r)) * I
end

# ------- Implementation of SimplePairPotential

evaluate!(tmp, V::SimplePairPotential, r::Number, z1, z0) = evaluate!(tmp, V, r)
evaluate_d!(tmp, V::SimplePairPotential, r::Number, z1, z0) = evaluate_d!(tmp, V, r)
evaluate_dd!(tmp, V::SimplePairPotential, r::Number, z1, z0) = evaluate_dd!(tmp, V, r)
evaluate!(tmp, V::SimplePairPotential, r) = evaluate(V, r)
evaluate_d!(tmp, V::SimplePairPotential, r) = evaluate_d(V, r)
evaluate_dd!(tmp, V::SimplePairPotential, r) = evaluate_dd(V, r)
evaluate(V::SimplePairPotential, r::Number) = evaluate!(alloc_temp(V, 1), V, r)
evaluate_d(V::SimplePairPotential, r::Number) = evaluate_d!(alloc_temp_d(V, 1), V, r)
evaluate_dd(V::SimplePairPotential, r::Number) = evaluate_dd!(alloc_temp_dd(V, 1), V, r)

evaluate_d(V::SimplePairPotential, r::Number, R::JVec) =
      (evaluate_d(V, r)/r) * R

function evaluate_dd(V::SimplePairPotential, r::Number, R::JVec)
   dV = evaluate_d(V, r) / r
   ddV = evaluate_dd(V, r)
   return ((ddV - dV)/r^2) * R * R'  + dV * I
end

# ------- Implementation of ExplicitPairPotential

evaluate(p::ExplicitPairPotential, r::Number) = p.f(r)
evaluate_d(p::ExplicitPairPotential, r::Number) = p.f_d(r)
evaluate_dd(p::ExplicitPairPotential, r::Number) = p.f_dd(r)

# ------- Some concrete potentials

"""
`LennardJones(σ, e0):` constructs the 6-12 Lennard-Jones potential [wiki](https://en.wikipedia.org/wiki/Lennard-Jones_potential)

   e0 * 4 * ( (σ/r)¹² - (σ/r)⁶ )

Constructor with kw arguments: `LennardJones(; kwargs...)`

* `e0, σ` : standard LJ parameters, default `e0 = 1.0, σ = 1.0`
* `r0` : equilibrium distance - if `r0` is specified then `σ` is ignored
* `a0` : FCC lattice parameter, if `a0` is specified then `σ` is ignored

(`r0, a0` cannot both be specified at the same time)
"""
LennardJones(σ, e0) = (@analytic r -> e0 * 4.0 * ((σ/r)^(12) - (σ/r)^(6)))

function ljparams(; σ=1.0, e0=1.0, r0 = nothing, a0 = nothing)
   if r0 != nothing && a0 != nothing
      error("`LenndardJones`: cannot specify both `r0` and `a0`")
   end
   if a0 != nothing    # r0 = nn-dist = a0/sqrt(2) in FCC
      r0 = a0 / sqrt(2)
   end
   if r0 != nothing    # standard LJ is minimised at r = 2^(1/6)
      σ =  r0 / 2^(1/6)
   end
   return σ, e0
end

LennardJones(; kwargs...) = LennardJones(ljparams(;kwargs...)...)

"""
`lennardjones(; kwargs...)`

simplified constructor for `LennardJones` (note this is type unstable!)

In addition to the `kwargs` of `LennardJones`, this accepts also

* `rcut` : default `:auto` which gives `rcut = (1.9*σ, 2.7*σ)`. Use
`nothing` or `Inf` to specify no cutoff, or specify a tuple or
array with two elements specifying the lower and upper cut-off radii to be
used with `SplineCutoff`.
"""
function lennardjones(; rcut = :auto, kwargs...)
   σ, e0 = ljparams(; kwargs...)
   if (rcut == nothing || rcut == Inf)
      return LennardJones(σ, e0)
   elseif rcut == :auto
      rcut = (1.9*σ, 2.7*σ)
   end
   return SplineCutoff(rcut[1], rcut[2]) * LennardJones(σ, e0)
end

"""
`Morse(A, e0, r0)` or `Morse(;A=4.0, e0=1.0, r0=1.0)`: constructs a
`PairPotential` for
```
   e0 ( exp( -2 A (r/r0 - 1) ) - 2 exp( - A (r/r0 - 1) ) )
```
"""
Morse(A, e0, r0) = @analytic(
   r -> e0 * ( exp(-(2.0*A) * (r/r0 - 1.0)) - 2.0 * exp(-A * (r/r0 - 1.0)) ) )
Morse(;A=4.0, e0=1.0, r0=1.0) = Morse(A, e0, r0)

"""
`morse(A=4.0, e0=1.0, r0=1.0, rcut=(1.9*r0, 2.7*r0))`

simplified constructor for `Morse` (type unstable)
"""
morse(;A=4.0, e0=1.0, r0=1.0, rcut=(1.9*r0, 2.7*r0)) = (
   (rcut == nothing || rcut == Inf)
         ?  Morse(A, e0, r0)
         :  SplineCutoff(rcut[1], rcut[2]) * Morse(A, e0, r0) )

"""
`ZeroPairPotential()`: creates a potential that just returns zero
"""
struct ZeroPairPotential <: SimplePairPotential end

@pot ZeroPairPotential

evaluate(p::ZeroPairPotential, r::T) where {T <: Number} = T(0.0)
evaluate_d(p::ZeroPairPotential, r::T) where {T <: Number} = T(0.0)
evaluate_dd(p::ZeroPairPotential, r::T) where {T <: Number} = T(0.0)
cutoff(p::ZeroPairPotential) = Bool(0) # the weakest number type

# ====================================================================
#   A product of two pair potentials: primarily used for cutoff mechanisms

"product of two `SimplePairPotential`"
mutable struct SimpleProdPot{P1, P2} <: SimplePairPotential
   p1::P1
   p2::P2
end

@pot SimpleProdPot

import Base.*
*(p1::SimplePairPotential, p2::SimplePairPotential) = SimpleProdPot(p1, p2)
evaluate(p::SimpleProdPot, r::Number) = p.p1(r) * p.p2(r)
evaluate_d(p::SimpleProdPot, r::Number) = (p.p1(r) * (@D p.p2(r)) + (@D p.p1(r)) * p.p2(r))
evaluate_dd(p::SimpleProdPot, r::Number) = (p.p1(r) * (@DD p.p2(r)) +
              2 * (@D p.p1(r)) * (@D p.p2(r)) + (@DD p.p1(r)) * p.p2(r))
cutoff(p::SimpleProdPot) = min(cutoff(p.p1), cutoff(p.p2))

"product of two `PairPotential`"
mutable struct ProdPot{P1, P2} <: PairPotential
   p1::P1
   p2::P2
end

@pot ProdPot

import Base.*
*(p1::PairPotential, p2::PairPotential) = ProdPot(p1, p2)
evaluate(p::ProdPot, r::Number, z1, z0) =
      p.p1(r, z1, z0) * p.p2(r, z1, z0)
evaluate_d(p::ProdPot, r::Number, z1, z0) =
      (p.p1(r, z1, z0) * (@D p.p2(r, z1, z0)) + (@D p.p1(r, z1, z0)) * p.p2(r, z1, z0))
evaluate_dd(p::ProdPot, r::Number, z1, z0) =
      (   p.p1(r, z1, z0) * (@DD p.p2(r, z1, z0))
        + 2 * (@D p.p1(r, z1, z0)) * (@D p.p2(r, z1, z0))
        + (@DD p.p1(r, z1, z0)) * p.p2(r, z1, z0)
      )
cutoff(p::ProdPot) = min(cutoff(p.p1), cutoff(p.p2))

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

"""
`struct WrappedPairPotential`

wraps a pairpotential using `FunctionWrappers` in order to allow
type-stable storage of multiple potentials. This is the main technique
required at the moment to work with multi-component systems.
Otherwise, this is not advisable since it disables a range of
possible compiler optimisations.
"""
struct WrappedPairPotential <: ExplicitPairPotential
   f::F64fun
   f_d::F64fun
   f_dd::F64fun
   rcut::Float64
end

@pot WrappedPairPotential

cutoff(V::WrappedPairPotential) = V.rcut
# evaluate, etc are all derived from SimplePairPotential

function WrappedPairPotential(V::AnalyticFunction, rcut)
   @assert (0 < rcut < Inf)
   f, f_d, f_dd = let V=V, rc = rcut
      (F64fun(r -> evaluate(V, r) * (r<rc)),
              F64fun(r -> evaluate_d(V, r) * (r<rc)),
              F64fun(r -> evaluate_dd(V, r) * (r<rc)))
   end
   return WrappedPairPotential(f, f_d, f_dd, cutoff(V))
end

function WrappedPairPotential(V::PairPotential)
   @assert (0 < cutoff(V) < Inf)
   f, f_d, f_dd = let V=V, rc = cutoff(V)
      (F64fun(r -> evaluate(V, r) * (r<rc)),
              F64fun(r -> evaluate_d(V, r) * (r<rc)),
              F64fun(r -> evaluate_dd(V, r) * (r<rc)))
   end
   return WrappedPairPotential(f, f_d, f_dd, cutoff(V))
end

# ------------------------------------------------------------------------

# TODO: write more docs + tests for ZBL

"""
Implementation of the ZBL potential to model close approach.
"""
struct ZBLPotential{TV} <: PairPotential
   V::TV   # analytic "inner" potential
end

@pot ZBLPotential

ZBLPotential() = (
   let
      # au = 0.8854 * 0.529 / (Z1^0.23 + Z2^0.23)
      ϵ0 = 0.00552634940621
      C = 1/(4*π*ϵ0)
      E1, E2, E3, E4 = 0.1818, 0.5099, 0.2802, 0.02817
      A1, A2, A3, A4 = 3.2, 0.9423, 0.4028, 0.2016
      V = @analytic(r -> C * (E1*exp(-A1*r) + E2*exp(-A2*r) +
                              E3*exp(-A4*r) + E4*exp(-A4*r) ) / r)
      ZBLPotential(V)
   end)

_zbl_au(Z1, Z2) = (0.8854 * 0.529) / (Z1^0.23 + Z2^0.23)

function evaluate(V::ZBLPotential, r::Number, z1, z0)
   au = _zbl_au(z1, z0)
   return evaluate(V.V, r / au)
end

function evaluate_d(V::ZBLPotential, r::Number, z1, z0)
   au = _zbl_au(z1, z0)
   return evaluate_d(V.V, r / au) / au
end

cutoff(::ZBLPotential) = Inf

write_dict(V::ZBLPotential) = Dict("__id__" => "JuLIP_ZBLPotential")
read_dict(::Val{:JuLIP_ZBLPotential}, D::Dict) = ZBLPotential()


@inline incrementp(A::AbstractStridedPointer{T,3} where T, a::Ptr) = VectorizationBase.increment_ptr(A, a, (Zero(), Zero(), One()))
@inline increment2(B::AbstractStridedPointer{T,2} where T, b::Ptr, ::StaticInt{nᵣ}) where {nᵣ} = VectorizationBase.increment_ptr(B, b, (Zero(), StaticInt{nᵣ}()))
@inline increment1(C::AbstractStridedPointer{T,2} where T, c::Ptr, ::StaticInt{mᵣW}) where {mᵣW} = VectorizationBase.increment_ptr(C, c, (StaticInt{mᵣW}(), Zero()))
macro kernel(pack::Bool, ex::Expr)
  ex.head === :for || throw(ArgumentError("Must be a matmul for loop."))
  mincrements = Expr[:(c = increment1(C, c, mᵣW)), :(ãₚ = incrementp(Ãₚ, ãₚ)), :(m = vsub_nsw(m, mᵣW))]
  # massumes = Expr[:(assume(m < mᵣW)),
  #                 :(assume(VectorizationBase.vgt(ãₚ, VectorizationBase.increment_ptr($(esc(:Ãₚ)), ãₚ, (vsub_nsw($(esc(:M)), mᵣW), LoopVectorization.Zero())), $(esc(:Ãₚ))))),
  #                 :(assume(VectorizationBase.vgt(c, VectorizationBase.increment_ptr($(esc(:C)), c, (vsub_nsw($(esc(:M)), mᵣW), LoopVectorization.Zero())), $(esc(:C)))))]
  offsetprecalc = GlobalRef(VectorizationBase,:offsetprecalc)
  preheader = quote
    mᵣ, nᵣ = matmul_params(Val($(esc(:T))))
    mᵣW = pick_vector_width($(esc(:T))) * mᵣ
    m = $(esc(:M)) % Int32
    n = $(esc(:N)) % Int32
    Ãₚ = $(esc(:Ãₚ))
    B = $offsetprecalc($(esc(:B)), Val{(9,9)}())
    C = $offsetprecalc($(esc(:C)), Val{(9,9)}())
    b = pointer(B); c = pointer(C); ãₚ = pointer(Ãₚ)
  end
  if pack
    push!(mincrements, :(a = increment1(A, a, mᵣW)))
    push!(preheader.args, :(A = $(esc(:A))), :(a = pointer(A)))
    areconstruct = Expr[:($(esc(:A)) = VectorizationBase.reconstruct_ptr(A, a))]
    # push!(massumes, :(assume(VectorizationBase.vgt(a, VectorizationBase.increment_ptr($(esc(:A)), a, (vsub_nsw($(esc(:M)), mᵣW), LoopVectorization.Zero())), $(esc(:A))))))
  else
    Ainit = areconstruct = Expr[]
  end
  lvkern = esc(:(@turbo inline=true $ex))

  loopnest = quote
    let ãₚ = ãₚ, c = c, $(esc(:B)) = VectorizationBase.reconstruct_ptr(B, b), m = m
      while m ≥ mᵣW#VectorizationBase.vle(a, amax, A)
        let $(esc(:M)) = mᵣW, $(esc(:N)) = nᵣ, $(esc(:Ãₚ)) = VectorizationBase.reconstruct_ptr(droplastdim(Ãₚ), ãₚ), $(esc(:C)) = VectorizationBase.reconstruct_ptr(C, c), $(areconstruct...)
          $lvkern
          $(mincrements...)
        end
      end
      if m > zero(Int32)#vne(a, amax, A)
        let $(esc(:M)) = UpperBoundedInteger((m%UInt)%Int, mᵣW - One()), $(esc(:N)) = nᵣ, $(esc(:Ãₚ)) = VectorizationBase.reconstruct_ptr(droplastdim(Ãₚ), ãₚ), $(esc(:C)) = VectorizationBase.reconstruct_ptr(C, c), $(areconstruct...)
          # $(massumes...)
          $lvkern
        end
      end
    end
  end

  if !pack
    loopnest = quote
      while n ≥ nᵣ#VectorizationBase.vle(c, cmax, C)
        $loopnest
        c = increment2(C, c, nᵣ)
        b = increment2(B, b, nᵣ)
        n = vsub_nsw(n, nᵣ)
      end
      if n > zero(Int32)#vne(c, cmax, C)
        let $(esc(:B)) = VectorizationBase.reconstruct_ptr(B, b), m = m
          while m ≥ mᵣW#VectorizationBase.vle(a, amax, A)
            let $(esc(:M)) = mᵣW, $(esc(:N)) = UpperBoundedInteger((n%UInt)%Int, nᵣ - One()), $(esc(:Ãₚ)) = VectorizationBase.reconstruct_ptr(droplastdim(Ãₚ), ãₚ), $(esc(:C)) = VectorizationBase.reconstruct_ptr(C, c), $(areconstruct...)
              # assume(n < nᵣ)
              # assume((VectorizationBase.vgt(c, VectorizationBase.increment_ptr($(esc(:C)), c, (Zero(), vsub_nsw($(esc(:N)), nᵣ))), $(esc(:C)))))
              # assume((VectorizationBase.vgt(b, VectorizationBase.increment_ptr($(esc(:B)), b, (Zero(), vsub_nsw($(esc(:N)), nᵣ))), $(esc(:B)))))
              $lvkern
              $(mincrements...)
            end
          end
          if m > zero(Int32)#vne(a, amax, A)
            let $(esc(:M)) = UpperBoundedInteger((m%UInt)%Int, mᵣW - One()), $(esc(:N)) = UpperBoundedInteger((n%UInt)%Int, nᵣ - One()), $(esc(:Ãₚ)) = VectorizationBase.reconstruct_ptr(droplastdim(Ãₚ), ãₚ), $(esc(:C)) = VectorizationBase.reconstruct_ptr(C, c), $(areconstruct...)
              # $(massumes...)
              # assume(n < nᵣ)
              # assume((VectorizationBase.vgt(c, VectorizationBase.increment_ptr($(esc(:C)), c, (Zero(), vsub_nsw($(esc(:N)), nᵣ))), $(esc(:C)))))
              # assume((VectorizationBase.vgt(b, VectorizationBase.increment_ptr($(esc(:B)), b, (Zero(), vsub_nsw($(esc(:N)), nᵣ))), $(esc(:B)))))
              $lvkern
            end
          end
        end
      end
    end
  end
  Expr(:block, preheader, loopnest)
end
@inline function loopmul!(C, A, B, α, β, M, K, N)
    @turbo for n ∈ CloseOpen(N), m ∈ CloseOpen(M)
        Cₘₙ = zero(eltype(C))
        for k ∈ CloseOpen(K)
            Cₘₙ += A[m,k] * B[k,n]
        end
        C[m,n] = α * Cₘₙ + β * C[m,n]
    end
    nothing
end
@inline function ploopmul!(C::AbstractStridedPointer{T}, Ãₚ, B, α, β, M, K, N) where {T}
  @kernel false for n ∈ CloseOpen(N), m ∈ CloseOpen(M)
    Cₘₙ = zero(eltype(C))
    for k ∈ CloseOpen(K)
      Cₘₙ += Ãₚ[m,k] * B[k,n]
    end
    C[m,n] = α * Cₘₙ + β * C[m,n]
  end
  nothing
end
@inline function packamul!(
    C::AbstractStridedPointer{T}, Ãₚ, A, B,
    α, β, M, K, N
  ) where {T}
  @kernel true for n ∈ CloseOpen(N), m ∈ CloseOpen(M)
    Cₘₙ = zero(eltype(C))
    for k ∈ CloseOpen(K)
      Aₘₖ = A[m,k]
      Cₘₙ += Aₘₖ * B[k,n]
      Ãₚ[m,k] = Aₘₖ
    end
    C[m,n] = α * Cₘₙ + β * C[m,n]
  end
end
@inline function alloc_a_pack(K, ::Val{T}) where {T}
  buffer = first_cache_buffer(Val(T))
  alloc_a_pack(K, buffer), buffer
end
@inline alloc_a_pack(K, buffer::MemoryBuffer) = alloc_a_pack(K, align(pointer(buffer)))
@inline function alloc_a_pack(K, bufferptr::Ptr{T}) where {T}
  mᵣ, nᵣ = matmul_params(Val(T))
  mᵣW = mᵣ * pick_vector_width(T)
  Apack = default_zerobased_stridedpointer(bufferptr, (One(), mᵣW, mᵣW * K)) # mᵣW x K x cld(M, mᵣW)
  Apack
end
function packaloopmul!(
    C::AbstractStridedPointer{T},
    A::AbstractStridedPointer,
    B::AbstractStridedPointer,
    α, β, M, K, N
) where {T}
  Ãₚ, buffer = alloc_a_pack(K, Val(T))
  GC.@preserve buffer begin
    Mᵣ, Nᵣ = matmul_params(Val(T))
    packamul!(C, Ãₚ, A, B, α, β, M, K, Nᵣ)
    ploopmul!(gesp(C, (Zero(), Nᵣ)), Ãₚ, gesp(B, (Zero(), Nᵣ)), α, β, M, K, N - Nᵣ)
  end
  nothing
end

@inline function inlineloopmul!(C, A, B, α, β, M, K, N)
    @turbo inline=true for m ∈ CloseOpen(M), n ∈ CloseOpen(N)
        Cₘₙ = zero(eltype(C))
        for k ∈ CloseOpen(K)
            Cₘₙ += A[m,k] * B[k,n]
        end
        C[m,n]  = α * Cₘₙ + β * C[m,n]
    end
    C
end


"""
```
forecast(m, system, z0; enforce_zlb = false, shocks = Matrix{S}(0,0))

forecast(system, z0, shocks; enforce_zlb = false)
```

### Inputs

- `m::AbstractModel`: model object. Only needed for the method in which `shocks`
  are not provided.
- `system::System{S}`: state-space system matrices
- `kal::Kalman{S}` or `z0::Vector{S}`: result of running the Kalman filter or
  state vector in the final historical period (aka initial forecast period)

where `S<:AbstractFloat`.

### Keyword Arguments

- `cond_type::Symbol`: one of `:none`, `:semi`, or `:full`, used to determine
  how many periods to forecast ahead. If `cond_type in [:semi, :full]`, the
  forecast horizon is reduced by the number of periods of conditional
  data. Defaults to `:none`.
- `enforce_zlb::Bool`: whether to enforce the zero lower bound. Defaults to
  `false`.
- `shocks::Matrix{S}`: matrix of size `nshocks` x `shock_horizon` of shock
  innovations under which to forecast. If `shock_horizon > horizon`, the extra
  periods of shocks will be ignored; if `shock_horizon < horizon`, zeros will be
  filled in for the shocks hitting the remaining forecasted periods.
- `draw_shocks::Bool`: if `isempty(shocks)`, indicates whether to draw shocks
  according to:

  1. If `forecast_tdist_shocks(m)`, draw `horizons` many shocks from a
     `Distributions.TDist(forecast_tdist_df_val(m))`
  2. Otherwise, draw `horizons` many shocks from a
     `DegenerateMvNormal(zeros(nshocks), sqrt(system[:QQ]))`

  or to set `shocks` to a `nshocks` x `horizon` matrix of zeros. Defaults to
  `false`. If `shocks` is provided as a keyword argument, this flag has no
  effect.

### Outputs

- `states::Matrix{S}`: matrix of size `nstates` x `horizon` of forecasted states
- `obs::Matrix{S}`: matrix of size `nobs` x `horizon` of forecasted observables
- `pseudo::Matrix{S}`: matrix of size `npseudo` x `horizon` of forecasted
  pseudo-observables
- `shocks::Matrix{S}`: matrix of size `nshocks` x `horizon` of shock innovations
"""
function forecast{S<:AbstractFloat}(m::AbstractModel, system::System{S},
    z0::Vector{S}; cond_type::Symbol = :none, enforce_zlb::Bool = false,
    shocks::Matrix{S} = Matrix{S}(0, 0), draw_shocks::Bool = false)

    # Numbers of things
    nshocks = n_shocks_exogenous(m)
    horizon = forecast_horizons(m; cond_type = cond_type)

    if isempty(shocks)
        # Populate shocks matrix
        if draw_shocks
            μ = zeros(S, nshocks)
            σ = sqrt.(system[:QQ])
            dist = if forecast_tdist_shocks(m)
                # Use t-distributed shocks
                ν = forecast_tdist_df_val(m)
                DegenerateDiagMvTDist(μ, σ, ν)
            else
                # Use normally distributed shocks
                DegenerateMvNormal(μ, σ)
            end

            shocks = rand(dist, horizon)

            # Forecast without anticipated shocks
            if n_anticipated_shocks(m) > 0
                ind_ant1 = m.exogenous_shocks[:rm_shl1]
                ind_antn = m.exogenous_shocks[Symbol("rm_shl$(n_anticipated_shocks(m))")]
                ant_shock_inds = ind_ant1:ind_antn
                shocks[ant_shock_inds, :] = 0
            end
        else
            shocks = zeros(S, nshocks, horizon)
        end
    else
        # Adjust size of shocks matrix, padding with zeros or cutting off
        # periods of shocks if necessary
        shock_horizon = size(shocks, 2)
        if shock_horizon <= horizon
            shocks0 = zeros(nshocks, horizon - shock_horizon)
            shocks = hcat(shocks, shocks0)
        else
            shocks = shocks[:, 1:horizon]
        end
    end

    # Populate shocks matrix under alternative policy, if
    # user has specified a function to do so
    alt_policy = alternative_policy(m)
    if alt_policy.solve != identity &&
        alt_policy.forecast_init != identity

        shocks, z0 = alt_policy.forecast_init(m, shocks, z0, cond_type = cond_type)
    end

    # Get variables necessary to enforce the zero lower bound in the forecast
    ind_r = m.observables[:obs_nominalrate]
    ind_r_sh = m.exogenous_shocks[:rm_sh]
    zlb_value = forecast_zlb_value(m)

    forecast(system, z0, shocks; enforce_zlb = enforce_zlb,
        ind_r = ind_r, ind_r_sh = ind_r_sh, zlb_value = zlb_value)
end

function forecast{S<:AbstractFloat}(system::System{S}, z0::Vector{S},
    shocks::Matrix{S}; enforce_zlb::Bool = false, ind_r::Int = -1,
    ind_r_sh::Int = -1, zlb_value::S = 0.13/4)

    # Unpack system
    T, R, C = system[:TTT], system[:RRR], system[:CCC]
    Q, Z, D = system[:QQ], system[:ZZ], system[:DD]
    Z_pseudo, D_pseudo = system[:ZZ_pseudo], system[:DD_pseudo]

    # Setup
    nshocks = size(R, 2)
    nstates = size(T, 2)
    nobs    = size(Z, 1)
    npseudo = size(Z_pseudo, 1)
    horizon = size(shocks, 2)

    # Define our iteration function
    function iterate(z_t1, ϵ_t)
        z_t = C + T*z_t1 + R*ϵ_t

        # Change monetary policy shock to account for 0.13 interest rate bound
        if enforce_zlb
            interest_rate_forecast = getindex(D + Z*z_t, ind_r)
            if interest_rate_forecast < zlb_value
                # Solve for interest rate shock causing interest rate forecast to be exactly ZLB
                ϵ_t[ind_r_sh] = 0.
                z_t = C + T*z_t1 + R*ϵ_t
                ϵ_t[ind_r_sh] = getindex((zlb_value - D[ind_r] - Z[ind_r, :]'*z_t) / (Z[ind_r, :]' * R[:, ind_r_sh]), 1)

                # Forecast again with new shocks
                z_t = C + T*z_t1 + R*ϵ_t

                # Confirm procedure worked
                interest_rate_forecast = getindex(D + Z*z_t, ind_r)
                @assert interest_rate_forecast >= zlb_value - 0.01 "interest_rate_forecast = $interest_rate_forecast must be >= zlb_value - 0.01 = $(zlb_value - 0.01)"
            end
        end
        return z_t, ϵ_t
    end

    # Iterate state space forward
    states = zeros(S, nstates, horizon)
    states[:, 1], shocks[:, 1] = iterate(z0, shocks[:, 1])
    for t in 2:horizon
        states[:, t], shocks[:, t] = iterate(states[:, t-1], shocks[:, t])
    end

    # Apply measurement and pseudo-measurement equations
    obs    = D .+ Z*states
    pseudo = D_pseudo .+ Z_pseudo * states

    # Return forecasts
    return states, obs, pseudo, shocks
end


module ActifMPCCmod

import Relaxation
import ParamSetmod
import NLPModels

"""
Type MPCC_actif : problème MPCC pénalisé avec slack et ensemble des contraintes actives

liste des constructeurs :
MPCC_actif(nlp::NLPModels.AbstractNLPModel,r::Float64,s::Float64,t::Float64,nb_comp::Int64,paramset::ParamSetmod.ParamSet,direction::Function,linesearch::Function)
MPCC_actif(nlp::NLPModels.AbstractNLPModel,r::Float64,s::Float64,t::Float64,w::Any,paramset::ParamSetmod.ParamSet,direction::Function,linesearch::Function)

liste des méthodes :
updatew(ma::MPCC_actif)
setf(ma::MPCC_actif, f::Function, xj::Any)
setw(ma::MPCC_actif, w::Any)
setbeta(ma::MPCC_actif,b::Float64)
sethess(ma::MPCC_actif,Hess::Array{Float64,2})

liste des accesseurs :
evalx(ma::MPCC_actif,x::Vector)
evald(ma::MPCC_actif,d::Vector)
redd(ma::MPCC_actif,d::Vector)
obj(ma::MPCC_actif,x::Vector)
ExtddDirection(ma::ActifMPCCmod.MPCC_actif,dr::Vector,xp::Vector,step::Float64)
grad(ma::MPCC_actif,x::Vector)
grad(ma::MPCC_actif,x::Vector,gradf::Vector)
hess(ma::MPCC_actif,x::Vector)
hess(ma::MPCC_actif,x::Vector,H::Array{Float64,2})

liste des fonctions :
LSQComputationMultiplier(ma::MPCC_actif,gradpen::Vector,xj::Vector)
RelaxationRule(ma::ActifMPCCmod.MPCC_actif,xj::Vector,lg::Vector,lh::Vector,lphi::Vector,wmax::Any)
PasMaxComp(ma::MPCC_actif,x::Vector,d::Vector)
AlphaChoix(alpha::Float64,alpha1::Float64,alpha2::Float64)
AlphaChoix(alpha::Float64,alpha1::Float64,alpha2::Float64,alpha3::Float64,alpha4::Float64)
PasMaxBound(ma::MPCC_actif,x::Vector,d::Vector) #TO DO
PasMax(ma::MPCC_actif,x::Vector,d::Vector)
"""

#TO DO List :
#Major :
#- Changer les w en set ou en liste
#- intégrer les contraintes de bornes sur x dans PasMax
#Minor :
#- copie de code dans PasMax
#- Plutôt que de passer le point courant -> stocker en point initial de mpcc ?

type MPCC_actif
 nlp::NLPModels.AbstractNLPModel # en fait on demande juste une fonction objectif, point initial, contraintes de bornes
 r::Float64
 s::Float64
 t::Float64

 w::Array{Bool,2} #matrice à 2 colonnes et de longueur 2nb_comp -- sparse

 n::Int64 #dans le fond est optionnel si on a nb_comp
 nb_comp::Int64

 #ensembles d'indices :
 w1::Array{Int64,1} # ensemble des indices (entre 0 et nb_comp) où la contrainte yG>=-r est active
 w2::Array{Int64,1} # ensemble des indices (entre 0 et nb_comp) où la contrainte yH>=-r est active
 w3::Array{Int64,1} # ensemble des indices (entre 0 et nb_comp) où la contrainte yG<=s+t*theta(yH,r) est active
 w4::Array{Int64,1} # ensemble des indices (entre 0 et nb_comp) où la contrainte yH<=s+t*theta(yG,r) est active
 wcomp::Array{Int64,1} #ensemble des indices (entre 0 et nb_comp) où la contrainte Phi<=0 est active
 w13c::Array{Int64,1} #ensemble des indices où les variables yG sont libres
 w24c::Array{Int64,1} #ensemble des indices où les variables yH sont libres
 wc::Array{Int64,1} #ensemble des indices des contraintes où yG et yH sont libres
 wcc::Array{Int64,1} #ensemble des indices des contraintes où yG et yH sont fixés

 wnew::Array{Bool,2} #dernières contraintes ajoutés

 #paramètres pour le calcul de la direction de descente
 crho::Float64 #constant such that : ||c(x)||_2 \approx crho*rho
 beta::Float64 #paramètre pour gradient conjugué
 Hess::Array{Float64,2} #inverse matrice hessienne approximée
 #Hd::Vector #produit inverse matrice hessienne et gradient (au lieu de la hessienne entière)

 paramset::ParamSetmod.ParamSet
 direction::Function #fonction qui calcul la direction de descente
 linesearch::Function #fonction qui calcul la recherche linéaire
end

"""
Constructeur recommandé pour MPCC_actif
"""
function MPCC_actif(nlp::NLPModels.AbstractNLPModel,r::Float64,s::Float64,t::Float64,nb_comp::Int64,paramset::ParamSetmod.ParamSet,direction::Function,linesearch::Function)

  n=length(nlp.meta.x0)-2*nb_comp
  xk=nlp.meta.x0[1:n]
  ygk=nlp.meta.x0[n+1:n+nb_comp]
  yhk=nlp.meta.x0[n+nb_comp+1:n+2*nb_comp]

  w=zeros(Bool,2*nb_comp,2)

  for l=1:nb_comp
   if ygk[l]==nlp.meta.lvar[n+l]
    w[l,1]=true;
   elseif ygk[l]==Relaxation.psi(yhk[l],r,s,t)
    w[l+nb_comp,1]=true;
   end
   if yhk[l]==nlp.meta.lvar[n+l+nb_comp]
    w[l,2]=true;
   elseif yhk[l]==Relaxation.psi(ygk[l],r,s,t)
    w[l+nb_comp,2]=true;
   end
  end

 return MPCC_actif(nlp,r,s,t,w,paramset,direction,linesearch)
end

function MPCC_actif(nlp::NLPModels.AbstractNLPModel,r::Float64,s::Float64,t::Float64,w::Array{Bool,2},paramset::ParamSetmod.ParamSet,direction::Function,linesearch::Function)

 nb_comp=Int(size(w,1)/2)
 n=length(nlp.meta.x0)-2*nb_comp
 w1=find(w[1:nb_comp,1])
 w2=find(w[1:nb_comp,2])
 w3=find(w[nb_comp+1:2*nb_comp,1])
 w4=find(w[nb_comp+1:2*nb_comp,2])
 wcomp=find(w[nb_comp+1:2*nb_comp,1] .| w[nb_comp+1:2*nb_comp,2])
 w13c=find(.!w[1:nb_comp,1] .& .!w[nb_comp+1:2*nb_comp,1])
 w24c=find(.!w[1:nb_comp,2] .& .!w[nb_comp+1:2*nb_comp,2])
 wc=find(.!w[1:nb_comp,1] .& .!w[1:nb_comp,2] .& .!w[nb_comp+1:2*nb_comp,1] .& .!w[nb_comp+1:2*nb_comp,2])
 wcc=find((w[1:nb_comp,1] .| w[nb_comp+1:2*nb_comp,1]) .& (w[1:nb_comp,2] .| w[nb_comp+1:2*nb_comp,2]))

 wnew=zeros(Bool,0,0)

 crho=1.0
 beta=0.0
 Hess=eye(n+2*nb_comp)

 return MPCC_actif(nlp,r,s,t,w,n,nb_comp,w1,w2,w3,w4,wcomp,w13c,w24c,wc,wcc,wnew,crho,beta,Hess,paramset,direction,linesearch)
end

"""
Methodes pour le MPCC_actif
"""
#Mise à jour des composantes liés à w
function updatew(ma::MPCC_actif)

 ma.w1=find(ma.w[1:ma.nb_comp,1])
 ma.w2=find(ma.w[1:ma.nb_comp,2])
 ma.w3=find(ma.w[ma.nb_comp+1:2*ma.nb_comp,1])
 ma.w4=find(ma.w[ma.nb_comp+1:2*ma.nb_comp,2])
 ma.wcomp=find(ma.w[ma.nb_comp+1:2*ma.nb_comp,1] .| ma.w[ma.nb_comp+1:2*ma.nb_comp,2])
 ma.w13c=find(.!ma.w[1:ma.nb_comp,1] .& .!ma.w[ma.nb_comp+1:2*ma.nb_comp,1])
 ma.w24c=find(.!ma.w[1:ma.nb_comp,2] .& .!ma.w[ma.nb_comp+1:2*ma.nb_comp,2])
 ma.wc=find(.!ma.w[1:ma.nb_comp,1] .& .!ma.w[1:ma.nb_comp,2] .& .!ma.w[ma.nb_comp+1:2*ma.nb_comp,1] .& .!ma.w[ma.nb_comp+1:2*ma.nb_comp,2])
 ma.wcc=find((ma.w[1:ma.nb_comp,1] .| ma.w[ma.nb_comp+1:2*ma.nb_comp,1]) .& (ma.w[1:ma.nb_comp,2] .| ma.w[ma.nb_comp+1:2*ma.nb_comp,2]))
 return ma
end

#Mise à jour de w
function setw(ma::MPCC_actif, w::Array{Bool,2})

 ma.wnew=w .& .!ma.w
 ma.w=w
 return updatew(ma)
end

function setbeta(ma::MPCC_actif,b::Float64)
 ma.beta=b
 return ma
end

function setcrho(ma::MPCC_actif,crho::Float64)
 ma.crho=crho
 return ma
end

function sethess(ma::MPCC_actif,Hess::Array{Float64,2})
 ma.Hess=Hess
 return ma
end

"""
Renvoie le vecteur x=[x,yg,yh] au complet
"""
function evalx(ma::MPCC_actif,x::Vector)
 #construction du vecteur de taille n+2nb_comp que l'on évalue :
 xf=ma.s*ones(ma.n+2*ma.nb_comp)
 xf[1:ma.n]=x[1:ma.n]
 xf[ma.w13c+ma.n]=x[ma.n+1:ma.n+length(ma.w13c)]
 xf[ma.w24c+ma.n+ma.nb_comp]=x[ma.n+length(ma.w13c)+1:ma.n+length(ma.w13c)+length(ma.w24c)]

 #on regarde les variables yG fixées :
 xf[ma.w1+ma.n]=ma.nlp.meta.lvar[ma.w1+ma.n]
 xf[ma.w3+ma.n]=Relaxation.psi(xf[ma.w3+ma.n+ma.nb_comp],ma.r,ma.s,ma.t)
 #on regarde les variables yH fixées :
 xf[ma.w2+ma.n+ma.nb_comp]=ma.nlp.meta.lvar[ma.w2+ma.n+ma.nb_comp]
 xf[ma.w4+ma.n+ma.nb_comp]=Relaxation.psi(xf[ma.w4+ma.n],ma.r,ma.s,ma.t)

 return xf
end

"""
Renvoie la direction d au complet (avec des 0 aux actifs)
"""
function evald(ma::MPCC_actif,d::Vector)
 df=zeros(ma.n+2*ma.nb_comp)
 df[1:ma.n]=d[1:ma.n]
 df[ma.w13c+ma.n]=d[ma.n+1:ma.n+length(ma.w13c)]
 df[ma.w24c+ma.nb_comp+ma.n]=d[ma.n+length(ma.w13c)+1:ma.n+length(ma.w13c)+length(ma.w24c)]
 return df
end

"""
Renvoie la direction d réduite
"""
function redd(ma::MPCC_actif,d::Vector)

  df=zeros(ma.n+length(ma.w13c)+length(ma.w24c))
  df[1:ma.n]=d[1:ma.n]
  df[ma.n+1:ma.n+length(ma.w13c)]=d[ma.w13c+ma.n]
  df[ma.n+length(ma.w13c)+1:ma.n+length(ma.w13c)+length(ma.w24c)]=d[ma.w24c+ma.nb_comp+ma.n]

 return df
end

function redd(ma::MPCC_actif,d::Vector,w::Array{Int64,1})

  df=zeros(length(w))
  df[1:length(w)]=d[w]

 return df
end

"""
Evalue la fonction objectif d'un MPCC actif : x
"""
function obj(ma::MPCC_actif,x::Vector)

 if length(x)==ma.n+2*ma.nb_comp
  return NLPModels.obj(ma.nlp,x)
 else
  return NLPModels.obj(ma.nlp,evalx(ma,x))
 end

end

"""
Calcul la direction étendue à partir de la direction du sous-domaine
complète une version étendue de la direction de descente :
dr : la direction dans le sous-espace actif
xp : le nouvel itéré
step : le pas utilisé pour calculé xp

utilise la formule suivante :
yG+=yG+alpha*dyG --> dyG=(yG+-yG)/alpha
"""
function ExtddDirection(ma::ActifMPCCmod.MPCC_actif,dr::Vector,xp::Vector,step::Float64)
 d=evald(ma,dr) #evald rempli les trous par des 0
 x=evalx(ma,xp)

 d[1:ma.n]=dr[1:ma.n]

 psip=Relaxation.psi(x[ma.n+1:ma.n+2*ma.nb_comp],ma.r,ma.s,ma.t)
 psi=Relaxation.psi(x[ma.n+1:ma.n+2*ma.nb_comp]-step*d[ma.n+1:ma.n+2*ma.nb_comp],ma.r,ma.s,ma.t)
 #d[ma.w1]=0 #yG fixé
 #d[ma.w2]=0 #yH fixé

 d[ma.n+ma.w3]=(psip[ma.w3+ma.nb_comp]-psi[ma.w3+ma.nb_comp])/step #yG fixé
 d[ma.n+ma.nb_comp+ma.w4]=(psip[ma.w4]-psi[ma.w4])/step #yH fixé
 #d[ma.n+ma.w13c]=dr[ma.n+ma.w13c] #yG est libre
 #d[ma.n+ma.nb_comp+ma.w24c]=dr[ma.n+ma.nb_comp+ma.w24c] #yG est libre

 return d
end

"""
Evalue le gradient de la fonction objectif d'un MPCC actif
x est le vecteur réduit
"""
function grad(ma::MPCC_actif,x::Vector)

 #on calcul xf le vecteur complet
 xf=evalx(ma,x)
 #construction du vecteur gradient de taille n+2nb_comp
 gradf=NLPModels.grad(ma.nlp,xf)

 return length(x)==ma.n+2*ma.nb_comp?gradf:grad(ma,x,gradf)
end

function grad(ma::MPCC_actif,x::Vector,gradf::Vector)

 #on calcul xf le vecteur complet
 xf=evalx(ma,x)
 #construction du vecteur gradient de taille n+2nb_comp
 #gradf=NLPModels.grad(ma.nlp,xf)

 gradg=Array{Float64}
 # Conditionnelles pour gérer le cas où w1 et w3 est vide
 #if isempty(ma.w1) && isempty(ma.w3)
 if isempty(ma.w4)
  gradg=zeros(length(ma.w13c))
 #elseif !isempty(ma.w13c) #certaines variables sont fixés
 elseif !isempty(ma.w4) #certaines variables sont fixés
  tmp=zeros(ma.nb_comp)
  #tmp[ma.w3]=Relaxation.dpsi(xf[ma.w3+ma.n+ma.nb_comp],ma.r,ma.s,ma.t).*gradf[ma.w3+ma.n]
  tmp[ma.w4]=Relaxation.dpsi(xf[ma.w4+ma.n],ma.r,ma.s,ma.t).*gradf[ma.w4+ma.nb_comp+ma.n]
  gradg=redd(ma,tmp,ma.w13c)
 else #ma.w13c est vide
  gradg=Float64[]
 end

 gradh=Array{Float64,1}
 #if isempty(ma.w2) && isempty(ma.w4)
 if isempty(ma.w3)
  gradh=zeros(length(ma.w24c))
 #elseif !isempty(ma.w24c)
 elseif !isempty(ma.w3)
  tmp=zeros(ma.nb_comp)
  #tmp[ma.w4]=Relaxation.dpsi(xf[ma.w4+ma.n],ma.r,ma.s,ma.t).*gradf[ma.w4+ma.nb_comp+ma.n]
  tmp[ma.w3]=Relaxation.dpsi(xf[ma.w3+ma.n+ma.nb_comp],ma.r,ma.s,ma.t).*gradf[ma.w3+ma.n]
  gradh=redd(ma,tmp,ma.w24c)
 else
  gradh=Float64[]
 end

 return vcat(gradf[1:ma.n],gradf[ma.w13c+ma.n]+gradg,gradf[ma.w24c+ma.nb_comp+ma.n]+gradh)
end

"""
Evalue la matrice hessienne de la fonction objectif d'un MPCC actif
x est le vecteur réduit
"""
function hess(ma::MPCC_actif,x::Vector)

 #on calcul xf le vecteur complet
 xf=evalx(ma,x)

 #construction de la hessienne de taille (n+2nb_comp)^2

 #H=NLPModels.hess(ma.nlp,xf) #renvoi la triangulaire inférieure tril(H,-1)'
 #H=H+tril(H,-1)'

 H=ma.nlp.H(xf)
 H=H+tril(H,-1)'

 if ma.nb_comp>0
  return hess(ma,x,H)
 else
  return H
 end
end

"""
A partir de la hessienne complète (ou une approximation) : calcul la hessienne dans le sous-espace actif
"""
function hess(ma::MPCC_actif,x::Vector,H::Array{Float64,2})

 #on calcul xf le vecteur complet
 xf=evalx(ma,x)
 nred=length(x)
 nnb=ma.n+ma.nb_comp;nnbt=ma.n+2*ma.nb_comp;
 #construction du vecteur gradient de taille n+2nb_comp
 gradf=NLPModels.grad(ma.nlp,xf)

#la hessienne des variables du sous-espace (nredxnred)
 Hred=vcat(hcat(H[1:ma.n,1:ma.n],H[1:ma.n,ma.n+ma.w13c],H[1:ma.n,nnb+ma.w24c]),
             hcat(H[ma.n+ma.w13c,1:ma.n],H[ma.n+ma.w13c,ma.n+ma.w13c],H[ma.n+ma.w13c,nnb+ma.w24c]),
             hcat(H[nnb+ma.w24c,1:ma.n],H[nnb+ma.w24c,ma.n+ma.w13c],H[nnb+ma.w24c,ma.n+ma.nb_comp+ma.w24c]))

 if isempty(ma.w4)
  hessg=sparse(zeros(length(ma.w13c),nred))
 else
  hessg=sparse(zeros(length(ma.w13c),nred))

  w4r=zeros(Int64,length(ma.w4))
  for i=1:length(ma.w4)
   w4r[i]=findfirst(x->x==ma.w4[i],ma.w13c)
  end
  hessg=diagm(Relaxation.ddpsi(xf[ma.w4+ma.n],ma.r,ma.s,ma.t).*gradf[ma.w4+ma.nb_comp+ma.n])
  hessg+=diagm(Relaxation.dpsi(xf[ma.w4+ma.n],ma.r,ma.s,ma.t))*H[ma.w4+ma.nb_comp+ma.n,ma.w4+ma.nb_comp+ma.n]

  Hred[ma.n+w4r,ma.n+w4r]+=hessg
 end

 if isempty(ma.w3)
  hessh=sparse(zeros(length(ma.w24c),nred))
 else
  hessh=sparse(zeros(length(ma.w24c),nred))

  w3r=zeros(Int64,length(ma.w3))
  for i=1:length(ma.w3)
   w3r[i]=findfirst(x->x==ma.w3[i],ma.w24c)
  end
  hessh=diagm(Relaxation.ddpsi(xf[ma.w3+ma.nb_comp+ma.n],ma.r,ma.s,ma.t).*gradf[ma.w3+ma.n])
  hessh+=diagm(Relaxation.dpsi(xf[ma.w3+ma.nb_comp+ma.n],ma.r,ma.s,ma.t))*H[ma.w3+ma.n,ma.w3+ma.n]

  Hred[ma.n+length(ma.w13c)+w3r,ma.n+length(ma.w13c)+w3r]+=hessh
 end

 return Hred
end

"""
LSQComputationMultiplier(ma::MPCC_actif,x::Vector) :
ma MPCC_Actif
xj in n+2nb_comp
gradpen in n+2nb_comp

calcul la valeur des multiplicateurs de Lagrange pour la contrainte de complémentarité en utilisant moindre carré
"""
function LSQComputationMultiplier(ma::MPCC_actif,gradpen::Vector,xj::Vector)

 dg=Relaxation.dphi(xj[ma.n+1:ma.n+ma.nb_comp],xj[ma.n+ma.nb_comp+1:ma.n+2*ma.nb_comp],ma.r,ma.s,ma.t)
 gx=dg[1:ma.nb_comp];gy=dg[ma.nb_comp+1:2*ma.nb_comp]

 #matrices des contraintes actives : (lg,lh,lphi)'*A=b
 nw1=length(ma.w1)
 nw2=length(ma.w2)
 nwcomp=length(ma.wcomp)
 Dlg=-diagm(ones(nw1))
 Dlh=-diagm(ones(nw2))
 Dlphig=diagm(collect(gx)[ma.wcomp])
 Dlphih=diagm(collect(gy)[ma.wcomp])
 A=[hcat(Dlg,zeros(nw1,nw2+2*nwcomp));hcat(zeros(nw2,nw1),Dlh,zeros(nw2,2*nwcomp));hcat(zeros(nwcomp,nw1+nw2),Dlphig,Dlphih)] # nw1+nw2+nwcomp x nw1+nw2+2nwcomp
 #second membre
 b=-[gradpen[ma.w1+ma.n];gradpen[ma.wcomp+ma.n];gradpen[ma.w2+ma.n+ma.nb_comp];gradpen[ma.wcomp+ma.n+ma.nb_comp]] #nw1+nw2+2nwcomp
 #on calcule la solution par pseudo-inverse :
 l=pinv(A')*b

 lk=zeros(3*ma.nb_comp)
 lk[ma.w1]=l[1:nw1]
 lk[ma.nb_comp+ma.w2]=l[nw1+1:nw1+nw2]
 lk[2*ma.nb_comp+ma.wcomp]=l[nw1+nw2+1:nw1+nw2+nwcomp]

 return lk[1:ma.nb_comp],lk[ma.nb_comp+1:2*ma.nb_comp],lk[2*ma.nb_comp+1:3*ma.nb_comp]
end

"""
Définit la règle de relaxation de l'ensemble des contraintes
RelaxationRule(ma::ActifMPCCmod.MPCC_actif,xj::Vector,lg,lh,lphi,wmax)
xj          : de taille n+2nb_comp
(lg,lh,phi) : valeur multiplicateurs
wmax        : ensemble des contraintes qui viennent d'être ajouté

output : MPCC_actif (avec les ensembles de contraintes actives mis à jour
"""
function RelaxationRule(ma::ActifMPCCmod.MPCC_actif,xj::Vector,lg::Vector,lh::Vector,lphi::Vector,wmax::Array{Bool,2})

  copy_wmax=copy(wmax)

  # Relaxation de l'ensemble d'activation : désactive toutes les contraintes négatives
  ma.w[find(x -> x<0,[lg;lphi;lh;lphi])]=zeros(Bool,length(find(x -> x<0,[lg;lphi;lh;lphi])))
  # Règle d'anti-cyclage : on enlève pas une contrainte qui vient d'être ajouté.
  ma.w[find(x->x==1.0,copy_wmax)]=ones(Bool,length(find(x->x==1.0,copy_wmax)))

 return ActifMPCCmod.updatew(ma)
end

"""
Calcul le pas maximum que l'on peut prendre dans une direction d (par rapport à la contrainte de complémentarité relaxé)
d : direction réduit
xj : itéré réduit

output :
alpha : le pas maximum
w_save : l'ensemble des contraintes qui vont devenir actives si choisit alphamax
"""
function PasMaxComp(ma::MPCC_actif,x::Vector,d::Vector)

 #initialisation
 alpha=Inf #pas maximum que l'on peut prendre
 w_save=copy(ma.w) #double tableau des indices avec les contraintes activent en x+alpha*d

 #les indices où la première composante est libre
 for i in ma.w13c
  wr13=findfirst(x->x==i,ma.w13c) #l'indice relatif dans les variables libre
  iw13c=ma.n+wr13

  bloque=(i in ma.w2) && (i in ma.w4)
  if !(i in ma.w24c) && !bloque && d[iw13c]<0
   #on prend le plus petit entre x+alpha*dx>=-r et s+tTheta(x+alpha*dx-s)>=-r
   alpha11=(ma.nlp.meta.lvar[iw13c]-x[iw13c])/d[iw13c]
   alpha12=(Relaxation.invpsi(ma.nlp.meta.lvar[iw13c],ma.r,ma.s,ma.t)-x[iw13c])/d[iw13c]

   alphag=AlphaChoix(alpha,alpha11,alpha12)
   if alphag<=alpha
    alpha=alphag
    w_save=copy(ma.w)
   end

   #update of the active set
   if alpha11==alpha
    w_save[i,1]=true
   end
   if alpha12==alpha
    w_save[i+ma.nb_comp,2]=true
    w_save[i,2]=true
   end

  elseif bloque
   alpha=0.0
  end
 end

 #c'est un copie coller d'au dessus => exporter dans une fonction
 #les indices où la deuxième composante est libre
 for i in ma.w24c
  wr24=findfirst(x->x==i,ma.w24c) #l'indice relatif dans les variables libre
  iw24c=ma.n+length(ma.w13c)+wr24

  bloque=(i in ma.w1) && (i in ma.w3)
  if !(i in ma.w13c) && !bloque && d[iw24c]<0
   #on prend le plus petit entre y+alpha*dy>=-r et s+tTheta(y+alpha*dy-s)>=-r
   alpha21=(ma.nlp.meta.lvar[iw24c]-x[iw24c])/d[iw24c]
   alpha22=(Relaxation.invpsi(ma.nlp.meta.lvar[iw24c],ma.r,ma.s,ma.t)-x[iw24c])/d[iw24c]

   alphah=AlphaChoix(alpha,alpha21,alpha22)
   if alphah<=alpha
    alpha=alphah
    w_save=copy(ma.w)
   end

   #on met à jour les contraintes
   if alpha21==alpha
    w_save[i,2]=true
   end
   if alpha22==alpha
    w_save[i+ma.nb_comp,1]=true
    w_save[i,1]=true
   end
  elseif bloque
   alpha=0.0
  end
 end

 #enfin les indices où les deux sont libres
 for i in ma.wc
  #yG-psi(yH)=0 ou yH-psi(yG)=0
  wr1=findfirst(x->x==i,ma.w13c) #l'indice relatif dans les variables libre
  wr2=findfirst(x->x==i,ma.w24c) #l'indice relatif dans les variables libre
  iwr1=wr1+ma.n;iwr2=wr2+length(ma.w13c)+ma.n;

  #alphac=Relaxation.AlphaThetaMax(x[i+ma.n],d[i+ma.n],x[i+length(ma.w13c)+ma.n],d[i+length(ma.w13c)+ma.n],ma.r,ma.s,ma.t)
  alphac=Relaxation.AlphaThetaMax(x[iwr1],d[iwr1],x[iwr2],d[iwr2],ma.r,ma.s,ma.t)
  #yG-tb=0
  #alphac11=d[i+ma.n]<0 ? (ma.nlp.meta.lvar[ma.n+i]-x[i+ma.n])/d[i+ma.n] : Inf
  alphac11=d[iwr1]<0 ? (ma.nlp.meta.lvar[iwr1]-x[iwr1])/d[iwr1] : Inf
  #yH-tb=0
  #alphac21=d[i+length(ma.w13c)+ma.n]<0 ? (ma.nlp.meta.lvar[ma.n+length(ma.w13c)+i]-x[i+length(ma.w13c)+ma.n])/d[i+length(ma.w13c)+ma.n] : Inf
  alphac21=d[iwr2]<0 ? (ma.nlp.meta.lvar[iwr2]-x[iwr2])/d[iwr2] : Inf

  alphagh=AlphaChoix(alpha,alphac[1],alphac[2],alphac11,alphac21)

  if alphagh<=alpha
   alpha=alphagh
   w_save=copy(ma.w)
  end

   if alphac[1]==alpha
    w_save[i+ma.nb_comp,1]=true
   end
   if alphac[2]==alpha
    w_save[i+ma.nb_comp,2]=true
   end
   if alphac11==alpha
    w_save[i,1]=true
   end
   if alphac21==alpha
    w_save[i,2]=true
   end

 end #fin boucle for ma.wc

 return alpha,w_save,Array(w_save .& .!ma.w)
end

"""
Met à jour alpha si :
1) il est plus petit
2) il est non-nul
"""
function AlphaChoix(alpha::Float64,alpha1::Float64,alpha2::Float64)
 return AlphaChoix(alpha,alpha1,alpha2,0.0,0.0)
end

function AlphaChoix(alpha::Float64,alpha1::Float64,alpha2::Float64,alpha3::Float64,alpha4::Float64)
 prec=eps(Float64)
 a=alpha1,alpha2,alpha3,alpha4
 a=a[find(x->x>=prec,collect(a))]
 if isempty(a)
  a=max(alpha1,alpha2,alpha3,alpha4)
 end

 return min(minimum(a),alpha)
end

"""
Calcul le pas maximum que l'on peut prendre dans une direction d par rapport aux contraintes de bornes sur x.
d : direction réduit
xj : itéré réduit

output :
alpha : le pas maximum
w_save : l'ensemble des contraintes qui vont devenir actives si choisit alphamax
"""
function PasMaxBound(ma::MPCC_actif,x::Vector,d::Vector)
 if max(l-x)>0 || max(x-u)>0
  println("Error PasMaxBound: infeasible x")
 end
 #ma.nlp.meta.lvar[1:ma.n]
 #ma.nlp.meta.uvar[1:ma.n]
 return #TO DO : nécessite d'ajouter les x dans l'ensemble des contraintes actives
end

"""
Calcul le pas maximum que l'on peut prendre dans une direction d
d : direction réduit
xj : itéré réduit

output :
alpha : le pas maximum
w_save : l'ensemble des contraintes qui vont devenir actives si choisit alphamax
"""
function PasMax(ma::MPCC_actif,x::Vector,d::Vector)

 if ma.nb_comp>0
  #on récupère les infos sur la contrainte de complémentarité
  alpha,w_save,w_new=PasMaxComp(ma,x,d)
 else
  alpha=Inf;w_save=zeros(Bool,0,0);w_new=ma.w;
 end
 #alpha,w_save,w_new=PasMaxBound(ma,x,d)

 if alpha<0.0
  println("PasMax error: pas maximum négatif.")
  return
 end

 return alpha,w_save,w_new
end

#end of module
end


du[1]=(-4).*(2+P1.^2+(-2).*2.^(1/2).*P2+P2.^2+2.*P1.*((-1).*2.^(1/2)+P2) +(Q1+(-1).*Q2).^2).^(-2).*(2+P1.^2+2.*2.^(1/2).*P2+P2.^2+2.*P1.*(   2.^(1/2)+P2)+(Q1+(-1).*Q2).^2).^(-2).*(P2.^2+Q2.^2).*(2+P1.^2+2.*   P1.*(2.^(1/2)+(-1).*P2)+(-2).*2.^(1/2).*P2+P2.^2+(Q1+Q2).^2).^(-2)   .*(2+P1.^2+2.*2.^(1/2).*P2+P2.^2+(-2).*P1.*(2.^(1/2)+P2)+(Q1+Q2) .^2).^(-2).*((P1.^2+Q1.^2).*(2+(-2).*2.^(1/2).*(P1+P2)+(P1+P2).^2+  (Q1+(-1).*Q2).^2).^(-1).*(2+2.*2.^(1/2).*(P1+P2)+(P1+P2).^2+(Q1+(   -1).*Q2).^2).^(-1).*(P2.^2+Q2.^2).*(2+2.*2.^(1/2).*(P1+(-1).*P2)+(   P1+(-1).*P2).^2+(Q1+Q2).^2).^(-1).*(2+(P1+(-1).*P2).^2+2.*2.^(1/2)  .*((-1).*P1+P2)+(Q1+Q2).^2).^(-1)).^(-1/2).*(3.*P1.^9+24.*P1.^6.*   P2.*Q1.*Q2+4.*P1.^7.*((-4)+(-2).*P2.^2+3.*Q1.^2+2.*Q2.^2)+8.*   P1.^4.*P2.*Q1.*Q2.*(4+(-2).*P2.^2+7.*Q1.^2+2.*Q2.^2)+4.*P1.^3.*   Q1.^2.*(12+3.*P2.^4+3.*Q1.^4+(-4).*Q2.^2+3.*Q2.^4+2.*Q1.^2.*((-2)+   Q2.^2)+(-2).*P2.^2.*((-2)+Q1.^2+Q2.^2))+8.*P2.*Q1.^3.*Q2.*(P2.^4+(   Q1.^2+(-1).*Q2.^2).^2+2.*P2.^2.*(2+Q1.^2+Q2.^2)+(-4).*(3+Q1.^2+   Q2.^2))+2.*P1.^5.*(12+3.*P2.^4+9.*Q1.^4+(-4).*Q2.^2+3.*Q2.^4+8.*   Q1.^2.*((-2)+Q2.^2)+(-2).*P2.^2.*((-2)+4.*Q1.^2+Q2.^2))+(-8).*   P1.^2.*P2.*Q1.*Q2.*(P2.^4+(-5).*Q1.^4+Q2.^4+(-8).*Q1.^2.*(2+Q2.^2)   +(-4).*(3+Q2.^2)+2.*P2.^2.*(2+4.*Q1.^2+Q2.^2))+P1.*((-1).*P2.^8+   3.*Q1.^8+8.*Q1.^2.*((-2)+Q2.^2).*(2+Q2.^2).^2+(-1).*(2+Q2.^2).^4+(   -4).*P2.^6.*((-2)+2.*Q1.^2+Q2.^2)+(-2).*Q1.^4.*(20+36.*Q2.^2+5.*   Q2.^4)+(-2).*P2.^4.*(12+5.*Q1.^4+(-4).*Q2.^2+3.*Q2.^4+4.*Q1.^2.*((   -2)+Q2.^2))+4.*P2.^2.*((-1).*((-2)+Q2.^2).*(2+Q2.^2).^2+Q1.^4.*(   18+23.*Q2.^2)+2.*Q1.^2.*(4+20.*Q2.^2+Q2.^4))));
du[2]=4.*(P1.^2+Q1.^2).*(2+P1.^2+(-2).*2.^(1/2).*P2+P2.^2+2.*P1.*((-1).*  2.^(1/2)+P2)+(Q1+(-1).*Q2).^2).^(-2).*(2+P1.^2+2.*2.^(1/2).*P2+  P2.^2+2.*P1.*(2.^(1/2)+P2)+(Q1+(-1).*Q2).^2).^(-2).*(2+P1.^2+2.*   P1.*(2.^(1/2)+(-1).*P2)+(-2).*2.^(1/2).*P2+P2.^2+(Q1+Q2).^2).^(-2)   .*(2+P1.^2+2.*2.^(1/2).*P2+P2.^2+(-2).*P1.*(2.^(1/2)+P2)+(Q1+Q2)   .^2).^(-2).*((P1.^2+Q1.^2).*(2+(-2).*2.^(1/2).*(P1+P2)+(P1+P2).^2+   (Q1+(-1).*Q2).^2).^(-1).*(2+2.*2.^(1/2).*(P1+P2)+(P1+P2).^2+(Q1+(   -1).*Q2).^2).^(-1).*(P2.^2+Q2.^2).*(2+2.*2.^(1/2).*(P1+(-1).*P2)+(   P1+(-1).*P2).^2+(Q1+Q2).^2).^(-1).*(2+(P1+(-1).*P2).^2+2.*2.^(1/2)   .*((-1).*P1+P2)+(Q1+Q2).^2).^(-1)).^(-1/2).*((-3).*P2.^9+(-24).*   P1.*P2.^6.*Q1.*Q2+8.*P1.*P2.^4.*Q1.*Q2.*((-4)+2.*P1.^2+(-2).*   Q1.^2+(-7).*Q2.^2)+4.*P2.^7.*(4+2.*P1.^2+(-2).*Q1.^2+(-3).*Q2.^2)+  P2.*((P1.^4+2.*P1.^2.*((-2)+Q1.^2)+(2+Q1.^2).^2).^2+8.*(P1.^6+  P1.^4.*((-2)+Q1.^2)+(-1).*((-2)+Q1.^2).*(2+Q1.^2).^2+(-1).*P1.^2.*  (4+20.*Q1.^2+Q1.^4)).*Q2.^2+2.*(20+5.*P1.^4+36.*Q1.^2+5.*Q1.^4+(-2).*P1.^2.*(18+23.*Q1.^2)).*Q2.^4+(-3).*Q2.^8)+(-4).*P2.^3.*  Q2.^2.*(12+3.*P1.^4+(-4).*Q1.^2+3.*Q1.^4+2.*((-2)+Q1.^2).*Q2.^2+   3.*Q2.^4+(-2).*P1.^2.*((-2)+Q1.^2+Q2.^2))+(-8).*P1.*Q1.*Q2.^3.*(   P1.^4+(Q1.^2+(-1).*Q2.^2).^2+2.*P1.^2.*(2+Q1.^2+Q2.^2)+(-4).*(3+   Q1.^2+Q2.^2))+(-2).*P2.^5.*(12+3.*P1.^4+(-4).*Q1.^2+3.*Q1.^4+8.*((  -2)+Q1.^2).*Q2.^2+9.*Q2.^4+(-2).*P1.^2.*((-2)+Q1.^2+4.*Q2.^2))+8.*  P1.*P2.^2.*Q1.*Q2.*((-12)+P1.^4+(-4).*Q1.^2+Q1.^4+(-8).*(2+Q1.^2)   .*Q2.^2+(-5).*Q2.^4+2.*P1.^2.*(2+Q1.^2+4.*Q2.^2)));
du[3]=4.*(2+P1.^2+(-2).*2.^(1/2).*P2+P2.^2+2.*P1.*((-1).*2.^(1/2)+P2)+(Q1+(-1).*Q2).^2).^(-2).*(2+P1.^2+2.*2.^(1/2).*P2+P2.^2+2.*P1.*( 2.^(1/2)+P2)+(Q1+(-1).*Q2).^2).^(-2).*(P2.^2+Q2.^2).*(2+P1.^2+2.* P1.*(2.^(1/2)+(-1).*P2)+(-2).*2.^(1/2).*P2+P2.^2+(Q1+Q2).^2).^(-2) .*(2+P1.^2+2.*2.^(1/2).*P2+P2.^2+(-2).*P1.*(2.^(1/2)+P2)+(Q1+Q2) .^2).^(-2).*((P1.^2+Q1.^2).*(2+(-2).*2.^(1/2).*(P1+P2)+(P1+P2).^2+(Q1+(-1).*Q2).^2).^(-1).*(2+2.*2.^(1/2).*(P1+P2)+(P1+P2).^2+(Q1+( -1).*Q2).^2).^(-1).*(P2.^2+Q2.^2).*(2+2.*2.^(1/2).*(P1+(-1).*P2)+(P1+(-1).*P2).^2+(Q1+Q2).^2).^(-1).*(2+(P1+(-1).*P2).^2+2.*2.^(1/2).*((-1).*P1+P2)+(Q1+Q2).^2).^(-1)).^(-1/2).*(3.*Q1.^9+24.*P1.*P2.*Q1.^6.*Q2+4.*Q1.^7.*(4+3.*P1.^2+2.*P2.^2+(-2).*Q2.^2)+8.*P1.*P2.* Q1.^4.*Q2.*((-4)+7.*P1.^2+2.*P2.^2+(-2).*Q2.^2)+4.*P1.^2.*Q1.^3.*(12+3.*P1.^4+4.*P2.^2+3.*P2.^4+(-2).*(2+P2.^2).*Q2.^2+3.*Q2.^4+2.*P1.^2.*(2+P2.^2+(-1).*Q2.^2))+2.*Q1.^5.*(12+9.*P1.^4+4.*P2.^2+3.*P2.^4+(-2).*(2+P2.^2).*Q2.^2+3.*Q2.^4+8.*P1.^2.*(2+P2.^2+(-1).* Q2.^2))+8.*P1.*P2.*Q1.^2.*Q2.*(5.*P1.^4+8.*P1.^2.*((-2)+P2.^2+(-1) .*Q2.^2)+4.*(3+(-1).*P2.^2+Q2.^2)+(-1).*(P2.^2+Q2.^2).^2)+8.*P1.^3.*P2.*Q2.*(P1.^4+4.*((-3)+P2.^2+(-1).*Q2.^2)+2.*P1.^2.*(2+( -1).*P2.^2+Q2.^2)+(P2.^2+Q2.^2).^2)+Q1.*(3.*P1.^8+(-1).*(P2.^4+2.* P2.^2.*((-2)+Q2.^2)+(2+Q2.^2).^2).^2+(-2).*P1.^4.*(20+5.*P2.^4+ 36.*Q2.^2+5.*Q2.^4+(-2).*P2.^2.*(18+23.*Q2.^2))+8.*P1.^2.*(P2.^6+ P2.^4.*((-2)+Q2.^2)+(-1).*((-2)+Q2.^2).*(2+Q2.^2).^2+(-1).*P2.^2.*(4+20.*Q2.^2+Q2.^4))));
du[4]=(-4).*(P1.^2+Q1.^2).*(2+P1.^2+(-2).*2.^(1/2).*P2+P2.^2+2.*P1.*((-1).*2.^(1/2)+P2)+(Q1+(-1).*Q2).^2).^(-2).*(2+P1.^2+2.*2.^(1/2).*P2+P2.^2+2.*P1.*(2.^(1/2)+P2)+(Q1+(-1).*Q2).^2).^(-2).*((-8).*P1.*P2.^3.*Q1.*(P1.^4+4.*((-3)+P2.^2+(-1).*Q1.^2)+2.*P1.^2.*(2+(-1).*P2.^2+Q1.^2)+(P2.^2+Q1.^2).^2)+(P1.^8+(-3).*P2.^8+8.*P2.^2.*((-2)+Q1.^2).*(2+Q1.^2).^2+(2+Q1.^2).^4+4.*P1.^6.*((-2)+(-2).*P2.^2+Q1.^2)+2.*P1.^4.*(12+8.*P2.^2+5.*P2.^4+(-4).*(1+P2.^2).*Q1.^2+3.*Q1.^4)+2.*P2.^4.*(20+36.*Q1.^2+5.*Q1.^4)+4.*P1.^2.*(((-2)+Q1.^2).*(2+Q1.^2).^2+(-1).*P2.^4.*(18+23.*Q1.^2)+2.*P2.^2.*(4+20.*Q1.^2+Q1.^4))).*Q2+8.*P1.*P2.*Q1.*(P1.^4+(-5).*P2.^4+Q1.^4+8.*P2.^2.*(2+Q1.^2)+(-4).*(3+Q1.^2)+2.*P1.^2.*(2+(-4).*P2.^2+Q1.^2)).*Q2.^2+( -4).*P2.^2.*(12+3.*P1.^4+4.*P2.^2+3.*P2.^4+(-2).*(2+P2.^2).*Q1.^2+3.*Q1.^4+2.*P1.^2.*(2+P2.^2+(-1).*Q1.^2)).*Q2.^3+(-8).*P1.*P2.* Q1.*(2.*P1.^2+7.*P2.^2+(-2).*(2+Q1.^2)).*Q2.^4+(-2).*(12+3.*P1.^4+ 9.*P2.^4+(-4).*Q1.^2+3.*Q1.^4+P1.^2.*(4+8.*P2.^2+(-2).*Q1.^2)+(-8) .*P2.^2.*((-2)+Q1.^2)).*Q2.^5+(-24).*P1.*P2.*Q1.*Q2.^6+(-4).*(4+ 2.*P1.^2+3.*P2.^2+(-2).*Q1.^2).*Q2.^7+(-3).*Q2.^9).*(2+P1.^2+2.* P1.*(2.^(1/2)+(-1).*P2)+(-2).*2.^(1/2).*P2+P2.^2+(Q1+Q2).^2).^(-2) .*(2+P1.^2+2.*2.^(1/2).*P2+P2.^2+(-2).*P1.*(2.^(1/2)+P2)+(Q1+Q2) .^2).^(-2).*((P1.^2+Q1.^2).*(2+(-2).*2.^(1/2).*(P1+P2)+(P1+P2).^2+ (Q1+(-1).*Q2).^2).^(-1).*(2+2.*2.^(1/2).*(P1+P2)+(P1+P2).^2+(Q1+(-1).*Q2).^2).^(-1).*(P2.^2+Q2.^2).*(2+2.*2.^(1/2).*(P1+(-1).*P2)+( P1+(-1).*P2).^2+(Q1+Q2).^2).^(-1).*(2+(P1+(-1).*P2).^2+2.*2.^(1/2) .*((-1).*P1+P2)+(Q1+Q2).^2).^(-1)).^(-1/2);


function write_nl_file(f::IO, m::AmplNLMathProgModel)
    write_nl_header(f, m)

    if m.ncon > 0
        write_nl_c_blocks(f, m)
    end

    if has_objective(m)
        write_nl_o_block(f, m)
    end

    if m.ncon > 0
        write_nl_d_block(f, m)
    end

    write_nl_x_block(f, m)

    if m.ncon > 0
        write_nl_r_block(f, m)
    end

    write_nl_b_block(f, m)

    if m.ncon > 0
        write_nl_k_block(f, m)
        write_nl_j_blocks(f, m)
    end

    if has_objective(m)
        write_nl_g_block(f, m)
    end
end

function has_objective(m::AmplNLMathProgModel)
    return !isempty(m.lin_obj) || (isa(m.obj, Expr))
end

function write_nl_header(f, m::AmplNLMathProgModel)
    # Line 1: Always the same
    println(f, "g3 1 1 0")
    # Line 2: vars, constraints, objectives, ranges, eqns, logical constraints
    n_ranges = sum(m.r_codes .== 0)
    n_eqns = sum(m.r_codes .== 4)
    nobj = has_objective(m) ? 1 : 0
    println(f, " $(m.nvar) $(m.ncon) $nobj $n_ranges $n_eqns 0")
    # Line 3: nonlinear constraints, objectives
    nlc = sum(m.conlinearities .== :Nonlin)
    nlo = m.objlinearity == :Nonlin ? 1 : 0
    println(f, " $nlc $nlo")
    # Line 4: network constraints: nonlinear, linear
    println(f, " 0 0")
    # Line 5: nonlinear vars in constraints, objectives, both
    nonlinear_obj = m.varlinearities_obj .== :Nonlin
    nonlinear_con = m.varlinearities_con .== :Nonlin
    nonlinear = (nonlinear_con + nonlinear_obj) .> 0
    nonlinear_both = (nonlinear_con + nonlinear_obj) .> 1
    nlvc = sum(nonlinear_con .> 0)
    nlvo = sum(nonlinear_obj .> 0)
    nlvb = sum(nonlinear_both)
    println(f, " $nlvc $nlvo $nlvb")
    # Line 6: linear network variables; functions; arith, flags
    println(f, " 0 0 0 1")  # flags set to 1 to get suffixes in .sol file
    # Line 7: discrete variables: binary, integer, nonlinear (b,c,o)
    binary = m.vartypes .== :Bin
    integer = m.vartypes .== :Int
    discrete = binary + integer .> 0
    # Julia 0.6 syntax
    nbv = sum(binary + .!nonlinear .> 1)
    niv = sum(integer + .!nonlinear .> 1)
    nlvbi = sum(nonlinear_both + discrete .> 1)
    nlvci = sum(nonlinear_con - nonlinear_obj + discrete .> 1)
    nlvoi = sum(nonlinear_obj - nonlinear_con + discrete .> 1)
    println(f, " $nbv $niv $nlvbi $nlvci $nlvoi")
    # Line 8: nonzeros in Jacobian, gradients
    nzc = sum(m.j_counts)
    nzo = length(m.lin_obj)
    println(f, " $nzc $nzo")
    # Line 9: max name lengths: constraints, variables
    println(f, " 0 0")
    # Line 10: common exprs: b,c,o,c1,o1
    println(f, " 0 0 0 0 0")
end

# Nonlinear constraint trees
function write_nl_c_blocks(f, m::AmplNLMathProgModel)
    for index in 0:(m.ncon - 1)
        i = m.c_index_map_rev[index]
        println(f, "C$index")
        write_nl_expr(f, m, m.constrs[i])
    end
end

# Nonlinear objective tree
function write_nl_o_block(f, m::AmplNLMathProgModel)
    println(f, string("O0 ", sense_to_nl[m.sense]))
    write_nl_expr(f, m, m.obj)
end

# Initial dual guesses - unused
function write_nl_d_block(f, m::AmplNLMathProgModel)
    println(f, "d$(m.ncon)")
    for index in 0:(m.ncon - 1)
        i = m.c_index_map_rev[index]
        println(f, "$index 0")
    end
end

# Initial primal guesses
function write_nl_x_block(f, m::AmplNLMathProgModel)
    println(f, "x$(m.nvar)")
    for index in 0:(m.nvar - 1)
        i = m.v_index_map_rev[index]
        println(f, "$index $(m.x_0[i])")
    end
end

# Constraint bounds
function write_nl_r_block(f, m::AmplNLMathProgModel)
    println(f, "r")
    for index in 0:(m.ncon - 1)
        i = m.c_index_map_rev[index]
        lower = m.g_l[i]
        upper = m.g_u[i]
        rel = m.r_codes[i]
        if rel == 0
            println(f, "$rel $lower $upper")
        elseif rel == 1
            println(f, "$rel $upper")
        elseif rel == 2
            println(f, "$rel $lower")
        elseif rel == 3
            println(f, "$rel")
        elseif rel == 4
            println(f, "$rel $lower")
        end
    end
end

# Variable bounds
function write_nl_b_block(f, m::AmplNLMathProgModel)
    println(f, "b")
    for index in 0:(m.nvar - 1)
        i = m.v_index_map_rev[index]
        lower = m.x_l[i]
        upper = m.x_u[i]
        if lower == -Inf
            if upper == Inf
                println(f, "3")
            else
                println(f, "1 $upper")
            end
        else
            if lower == upper
                println(f, "4 $lower")
            elseif upper == Inf
                println(f, "2 $lower")
            else
                println(f, "0 $lower $upper")
            end
        end
    end
end

# Jacobian counts
function write_nl_k_block(f, m::AmplNLMathProgModel)
    println(f, "k$(m.nvar - 1)")
    total = 0
    for index = 0:(m.nvar - 2)
        i = m.v_index_map_rev[index]
        total += m.j_counts[i]
        println(f, total)
    end
end

# Linear constraint expressions
function write_nl_j_blocks(f, m::AmplNLMathProgModel)
    for index in 0:(m.ncon - 1)
        i = m.c_index_map_rev[index]
        num_vars = length(m.lin_constrs[i])
        # Only print linear blocks with vars, .nl file is malformed otherwise
        if num_vars > 0
            println(f, "J$index $num_vars")

            # We need to output .nl index and constraint coeff, ordered by .nl
            # index. `lin_constrs` contains our variable index as the key and
            # constraint coeff as the value

            # Assemble tuples of (.nl index, constraint value)
            output = collect(zip(
                (m.v_index_map[j] for j in keys(m.lin_constrs[i])),
                values(m.lin_constrs[i]))
            )

            # Loop through output in .nl index order
            for (index2, value) in sort(output)
                println(f, "$index2 $value")
            end
        end
    end
end

# Linear objective expression
function write_nl_g_block(f, m::AmplNLMathProgModel)
    println(f, string("G0 ", length(m.lin_obj)))
    for index in 0:(m.nvar - 1)
        i = m.v_index_map_rev[index]
        if i in keys(m.lin_obj)
            println(f, "$index $(m.lin_obj[i])")
        end
    end
end

# Convert an expression tree (with .nl formulae only) to .nl format
write_nl_expr(f, m, c) = println(f, string(c))
# Handle numerical constants e.g. pi
write_nl_expr(f, m, c::Symbol) =  write_nl_expr(f, m, float(eval(c)))
function write_nl_expr(f, m, c::Real)
    println(f, nl_number(c == round(Integer, c) ? round(Integer, c) : c))
end
write_nl_expr(f, m, c::LinearityExpr) = write_nl_expr(f, m, c.c)
function write_nl_expr(f, m, c::Expr)
    if c.head == :ref
        # Output variable as `v$index`
        if c.args[1] == :x
            @assert isa(c.args[2], Int)
            println(f, nl_variable(m.v_index_map[c.args[2]]))
        else
            error("Unrecognized reference expression $c")
        end
    elseif c.head == :call
        # Output function as `o$opcode`
        println(f, nl_operator(c.args[1]))
        if c.args[1] in nary_functions
            # Output nargs on subsequent line if n-ary function
            println(f, (string(length(c.args) - 1)))
        end
        map(arg -> write_nl_expr(f, m, arg), c.args[2:end])

    elseif c.head == :comparison
        # .nl only handles binary comparison
        @assert length(c.args) == 3
        # Output comparison type first, followed by args
        println(f, nl_operator(c.args[2]))
        map(arg -> write_nl_expr(f, m, arg), c.args[1:2:end])

    elseif c.head in [:&&, :||]
        # Only support binary and/or for now
        @assert length(c.args) == 2
        println(f, nl_operator(c.head))
        map(arg -> write_nl_expr(f, m, arg), c.args)
    else
        error("Unrecognized expression $c")
    end
end

nl_variable(index::Integer) = "v$index"
nl_number(value::Real) = "n$value"

function nl_operator(operator::Symbol)
    if !haskey(func_to_nl, operator)
        error("translation of the function \"$operator\" to NL is not defined")
    end
    return "o$(func_to_nl[operator])"
end