/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import order.complete_lattice
import order.cover
import order.iterate

/-!
# Successor and predecessor

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines successor and predecessor orders. `succ a`, the successor of an element `a : α` is
the least element greater than `a`. `pred a` is the greatest element less than `a`. Typical examples
include `ℕ`, `ℤ`, `ℕ+`, `fin n`, but also `enat`, the lexicographic order of a successor/predecessor
order...

## Typeclasses

* `succ_order`: Order equipped with a sensible successor function.
* `pred_order`: Order equipped with a sensible predecessor function.
* `is_succ_archimedean`: `succ_order` where `succ` iterated to an element gives all the greater
  ones.
* `is_pred_archimedean`: `pred_order` where `pred` iterated to an element gives all the smaller
  ones.

## Implementation notes

Maximal elements don't have a sensible successor. Thus the naïve typeclass
```lean
class naive_succ_order (α : Type*) [preorder α] :=
(succ : α → α)
(succ_le_iff : ∀ {a b}, succ a ≤ b ↔ a < b)
(lt_succ_iff : ∀ {a b}, a < succ b ↔ a ≤ b)
```
can't apply to an `order_top` because plugging in `a = b = ⊤` into either of `succ_le_iff` and
`lt_succ_iff` yields `⊤ < ⊤` (or more generally `m < m` for a maximal element `m`).
The solution taken here is to remove the implications `≤ → <` and instead require that `a < succ a`
for all non maximal elements (enforced by the combination of `le_succ` and the contrapositive of
`max_of_succ_le`).
The stricter condition of every element having a sensible successor can be obtained through the
combination of `succ_order α` and `no_max_order α`.

## TODO

Is `galois_connection pred succ` always true? If not, we should introduce
```lean
class succ_pred_order (α : Type*) [preorder α] extends succ_order α, pred_order α :=
(pred_succ_gc : galois_connection (pred : α → α) succ)
```
`covby` should help here.
-/

open function order_dual set

variables {α : Type*}

/-- Order equipped with a sensible successor function. -/
@[ext] class succ_order (α : Type*) [preorder α] :=
(succ : α → α)
(le_succ : ∀ a, a ≤ succ a)
(max_of_succ_le {a} : succ a ≤ a → is_max a)
(succ_le_of_lt {a b} : a < b → succ a ≤ b)
(le_of_lt_succ {a b} : a < succ b → a ≤ b)

/-- Order equipped with a sensible predecessor function. -/
@[ext] class pred_order (α : Type*) [preorder α] :=
(pred : α → α)
(pred_le : ∀ a, pred a ≤ a)
(min_of_le_pred {a} : a ≤ pred a → is_min a)
(le_pred_of_lt {a b} : a < b → a ≤ pred b)
(le_of_pred_lt {a b} : pred a < b → a ≤ b)

instance [preorder α] [succ_order α] : pred_order αᵒᵈ :=
{ pred := to_dual ∘ succ_order.succ ∘ of_dual,
  pred_le := succ_order.le_succ,
  min_of_le_pred := λ _, succ_order.max_of_succ_le,
  le_pred_of_lt := λ a b h, succ_order.succ_le_of_lt h,
  le_of_pred_lt := λ a b, succ_order.le_of_lt_succ }

instance [preorder α] [pred_order α] : succ_order αᵒᵈ :=
{ succ := to_dual ∘ pred_order.pred ∘ of_dual,
  le_succ := pred_order.pred_le,
  max_of_succ_le := λ _, pred_order.min_of_le_pred,
  succ_le_of_lt := λ a b h, pred_order.le_pred_of_lt h,
  le_of_lt_succ := λ a b, pred_order.le_of_pred_lt }

section preorder
variables [preorder α]

/-- A constructor for `succ_order α` usable when `α` has no maximal element. -/
def succ_order.of_succ_le_iff_of_le_lt_succ (succ : α → α)
  (hsucc_le_iff : ∀ {a b}, succ a ≤ b ↔ a < b) (hle_of_lt_succ : ∀ {a b}, a < succ b → a ≤ b) :
  succ_order α :=
{ succ := succ,
  le_succ := λ a, (hsucc_le_iff.1 le_rfl).le,
  max_of_succ_le := λ a ha, (lt_irrefl a $ hsucc_le_iff.1 ha).elim,
  succ_le_of_lt := λ a b, hsucc_le_iff.2,
  le_of_lt_succ := λ a b, hle_of_lt_succ }

/-- A constructor for `pred_order α` usable when `α` has no minimal element. -/
def pred_order.of_le_pred_iff_of_pred_le_pred (pred : α → α)
  (hle_pred_iff : ∀ {a b}, a ≤ pred b ↔ a < b) (hle_of_pred_lt : ∀ {a b}, pred a < b → a ≤ b) :
  pred_order α :=
{ pred := pred,
  pred_le := λ a, (hle_pred_iff.1 le_rfl).le,
  min_of_le_pred := λ a ha, (lt_irrefl a $ hle_pred_iff.1 ha).elim,
  le_pred_of_lt := λ a b, hle_pred_iff.2,
  le_of_pred_lt := λ a b, hle_of_pred_lt }

end preorder

section linear_order
variables [linear_order α]

/-- A constructor for `succ_order α` for `α` a linear order. -/
@[simps] def succ_order.of_core (succ : α → α) (hn : ∀ {a}, ¬ is_max a → ∀ b, a < b ↔ succ a ≤ b)
  (hm : ∀ a, is_max a → succ a = a) : succ_order α :=
{ succ           := succ,
  succ_le_of_lt  := λ a b, classical.by_cases (λ h hab, (hm a h).symm ▸ hab.le) (λ h, (hn h b).mp),
  le_succ        := λ a, classical.by_cases (λ h, (hm a h).symm.le)
                                            (λ h, le_of_lt $ by simpa using (hn h a).not),
  le_of_lt_succ  := λ a b hab, classical.by_cases (λ h, hm b h ▸ hab.le)
                                                  (λ h, by simpa [hab] using (hn h a).not),
  max_of_succ_le := λ a, not_imp_not.mp $ λ h, by simpa using (hn h a).not }

/-- A constructor for `pred_order α` for `α` a linear order. -/
@[simps] def pred_order.of_core {α} [linear_order α] (pred : α → α)
  (hn : ∀ {a}, ¬ is_min a → ∀ b, b ≤ pred a ↔ b < a) (hm : ∀ a, is_min a → pred a = a) :
  pred_order α :=
{ pred           := pred,
  le_pred_of_lt  := λ a b, classical.by_cases (λ h hab, (hm b h).symm ▸ hab.le) (λ h, (hn h a).mpr),
  pred_le        := λ a, classical.by_cases (λ h, (hm a h).le)
                                            (λ h, le_of_lt $ by simpa using (hn h a).not),
  le_of_pred_lt  := λ a b hab, classical.by_cases (λ h, hm a h ▸ hab.le)
                                                  (λ h, by simpa [hab] using (hn h b).not),
  min_of_le_pred := λ a, not_imp_not.mp $ λ h, by simpa using (hn h a).not }

/-- A constructor for `succ_order α` usable when `α` is a linear order with no maximal element. -/
def succ_order.of_succ_le_iff (succ : α → α) (hsucc_le_iff : ∀ {a b}, succ a ≤ b ↔ a < b) :
  succ_order α :=
{ succ := succ,
  le_succ := λ a, (hsucc_le_iff.1 le_rfl).le,
  max_of_succ_le := λ a ha, (lt_irrefl a $ hsucc_le_iff.1 ha).elim,
  succ_le_of_lt := λ a b, hsucc_le_iff.2,
  le_of_lt_succ := λ a b h, le_of_not_lt ((not_congr hsucc_le_iff).1 h.not_le) }

/-- A constructor for `pred_order α` usable when `α` is a linear order with no minimal element. -/
def pred_order.of_le_pred_iff (pred : α → α) (hle_pred_iff : ∀ {a b}, a ≤ pred b ↔ a < b) :
  pred_order α :=
{ pred := pred,
  pred_le := λ a, (hle_pred_iff.1 le_rfl).le,
  min_of_le_pred := λ a ha, (lt_irrefl a $ hle_pred_iff.1 ha).elim,
  le_pred_of_lt := λ a b, hle_pred_iff.2,
  le_of_pred_lt := λ a b h, le_of_not_lt ((not_congr hle_pred_iff).1 h.not_le) }

end linear_order

/-! ### Successor order -/

namespace order
section preorder
variables [preorder α] [succ_order α] {a b : α}

/-- The successor of an element. If `a` is not maximal, then `succ a` is the least element greater
than `a`. If `a` is maximal, then `succ a = a`. -/
def succ : α → α := succ_order.succ

lemma le_succ : ∀ a : α, a ≤ succ a := succ_order.le_succ
lemma max_of_succ_le {a : α} : succ a ≤ a → is_max a := succ_order.max_of_succ_le
lemma succ_le_of_lt {a b : α} : a < b → succ a ≤ b := succ_order.succ_le_of_lt
lemma le_of_lt_succ {a b : α} : a < succ b → a ≤ b := succ_order.le_of_lt_succ

@[simp] lemma succ_le_iff_is_max : succ a ≤ a ↔ is_max a := ⟨max_of_succ_le, λ h, h $ le_succ _⟩

@[simp] lemma lt_succ_iff_not_is_max : a < succ a ↔ ¬ is_max a :=
⟨not_is_max_of_lt, λ ha, (le_succ a).lt_of_not_le $ λ h, ha $ max_of_succ_le h⟩

alias lt_succ_iff_not_is_max ↔ _ lt_succ_of_not_is_max

lemma wcovby_succ (a : α) : a ⩿ succ a :=
⟨le_succ a, λ b hb, (succ_le_of_lt hb).not_lt⟩

lemma covby_succ_of_not_is_max (h : ¬ is_max a) : a ⋖ succ a :=
(wcovby_succ a).covby_of_lt $ lt_succ_of_not_is_max h

lemma lt_succ_iff_of_not_is_max (ha : ¬ is_max a) : b < succ a ↔ b ≤ a :=
⟨le_of_lt_succ, λ h, h.trans_lt $ lt_succ_of_not_is_max ha⟩

lemma succ_le_iff_of_not_is_max (ha : ¬ is_max a) : succ a ≤ b ↔ a < b :=
⟨(lt_succ_of_not_is_max ha).trans_le, succ_le_of_lt⟩

lemma succ_lt_succ_iff_of_not_is_max (ha : ¬ is_max a) (hb : ¬ is_max b) :
  succ a < succ b ↔ a < b :=
by rw [lt_succ_iff_of_not_is_max hb, succ_le_iff_of_not_is_max ha]

lemma succ_le_succ_iff_of_not_is_max (ha : ¬ is_max a) (hb : ¬ is_max b) :
  succ a ≤ succ b ↔ a ≤ b :=
by rw [succ_le_iff_of_not_is_max ha, lt_succ_iff_of_not_is_max hb]

@[simp, mono] lemma succ_le_succ (h : a ≤ b) : succ a ≤ succ b :=
begin
  by_cases hb : is_max b,
  { by_cases hba : b ≤ a,
    { exact (hb $ hba.trans $ le_succ _).trans (le_succ _) },
    { exact succ_le_of_lt ((h.lt_of_not_le hba).trans_le $ le_succ b) } },
  { rwa [succ_le_iff_of_not_is_max (λ ha, hb $ ha.mono h), lt_succ_iff_of_not_is_max hb] }
end

lemma succ_mono : monotone (succ : α → α) := λ a b, succ_le_succ

lemma le_succ_iterate (k : ℕ) (x : α) : x ≤ (succ^[k] x) :=
begin
  conv_lhs { rw (by simp only [function.iterate_id, id.def] : x = (id^[k] x)) },
  exact monotone.le_iterate_of_le succ_mono le_succ k x,
end

lemma is_max_iterate_succ_of_eq_of_lt {n m : ℕ}
  (h_eq : (succ^[n] a) = (succ^[m] a)) (h_lt : n < m) :
  is_max (succ^[n] a) :=
begin
  refine max_of_succ_le (le_trans _ h_eq.symm.le),
  have : succ (succ^[n] a) = (succ^[n + 1] a), by rw function.iterate_succ',
  rw this,
  have h_le : n + 1 ≤ m := nat.succ_le_of_lt h_lt,
  exact monotone.monotone_iterate_of_le_map succ_mono (le_succ a) h_le,
end

lemma is_max_iterate_succ_of_eq_of_ne {n m : ℕ}
  (h_eq : (succ^[n] a) = (succ^[m] a)) (h_ne : n ≠ m) :
  is_max (succ^[n] a) :=
begin
  cases le_total n m,
  { exact is_max_iterate_succ_of_eq_of_lt h_eq (lt_of_le_of_ne h h_ne), },
  { rw h_eq,
    exact is_max_iterate_succ_of_eq_of_lt h_eq.symm (lt_of_le_of_ne h h_ne.symm), },
end

lemma Iio_succ_of_not_is_max (ha : ¬ is_max a) : Iio (succ a) = Iic a :=
set.ext $ λ x, lt_succ_iff_of_not_is_max ha

lemma Ici_succ_of_not_is_max (ha : ¬ is_max a) : Ici (succ a) = Ioi a :=
set.ext $ λ x, succ_le_iff_of_not_is_max ha

lemma Ioo_succ_right_of_not_is_max (hb : ¬ is_max b) : Ioo a (succ b) = Ioc a b :=
by rw [←Ioi_inter_Iio, Iio_succ_of_not_is_max hb, Ioi_inter_Iic]

lemma Icc_succ_left_of_not_is_max (ha : ¬ is_max a) : Icc (succ a) b = Ioc a b :=
by rw [←Ici_inter_Iic, Ici_succ_of_not_is_max ha, Ioi_inter_Iic]

lemma Ico_succ_left_of_not_is_max (ha : ¬ is_max a) : Ico (succ a) b = Ioo a b :=
by rw [←Ici_inter_Iio, Ici_succ_of_not_is_max ha, Ioi_inter_Iio]

section no_max_order
variables [no_max_order α]

lemma lt_succ (a : α) : a < succ a := lt_succ_of_not_is_max $ not_is_max a
@[simp] lemma lt_succ_iff : a < succ b ↔ a ≤ b := lt_succ_iff_of_not_is_max $ not_is_max b
@[simp] lemma succ_le_iff : succ a ≤ b ↔ a < b := succ_le_iff_of_not_is_max $ not_is_max a

lemma succ_le_succ_iff : succ a ≤ succ b ↔ a ≤ b := by simp
lemma succ_lt_succ_iff : succ a < succ b ↔ a < b := by simp

alias succ_le_succ_iff ↔ le_of_succ_le_succ _
alias succ_lt_succ_iff ↔ lt_of_succ_lt_succ succ_lt_succ

lemma succ_strict_mono : strict_mono (succ : α → α) := λ a b, succ_lt_succ

lemma covby_succ (a : α) : a ⋖ succ a := covby_succ_of_not_is_max $ not_is_max a

@[simp] lemma Iio_succ (a : α) : Iio (succ a) = Iic a := Iio_succ_of_not_is_max $ not_is_max _
@[simp] lemma Ici_succ (a : α) : Ici (succ a) = Ioi a := Ici_succ_of_not_is_max $ not_is_max _

@[simp] lemma Ico_succ_right (a b : α) : Ico a (succ b) = Icc a b :=
Ico_succ_right_of_not_is_max $ not_is_max _

@[simp] lemma Ioo_succ_right (a b : α) : Ioo a (succ b) = Ioc a b :=
Ioo_succ_right_of_not_is_max $ not_is_max _

@[simp] lemma Icc_succ_left (a b : α) : Icc (succ a) b = Ioc a b :=
Icc_succ_left_of_not_is_max $ not_is_max _

@[simp] lemma Ico_succ_left (a b : α) : Ico (succ a) b = Ioo a b :=
Ico_succ_left_of_not_is_max $ not_is_max _

end no_max_order
end preorder

section partial_order
variables [partial_order α] [succ_order α] {a b : α}

@[simp] lemma succ_eq_iff_is_max : succ a = a ↔ is_max a :=
⟨λ h, max_of_succ_le h.le, λ h, h.eq_of_ge $ le_succ _⟩

alias succ_eq_iff_is_max ↔ _ _root_.is_max.succ_eq

lemma succ_eq_succ_iff_of_not_is_max (ha : ¬ is_max a) (hb : ¬ is_max b) :
  succ a = succ b ↔ a = b :=
by rw [eq_iff_le_not_lt, eq_iff_le_not_lt,
  succ_le_succ_iff_of_not_is_max ha hb, succ_lt_succ_iff_of_not_is_max ha hb]

lemma le_le_succ_iff : a ≤ b ∧ b ≤ succ a ↔ b = a ∨ b = succ a :=
begin
  refine ⟨λ h, or_iff_not_imp_left.2 $ λ hba : b ≠ a,
    h.2.antisymm (succ_le_of_lt $ h.1.lt_of_ne $ hba.symm), _⟩,
  rintro (rfl | rfl),
  { exact ⟨le_rfl, le_succ b⟩ },
  { exact ⟨le_succ a, le_rfl⟩ }
end

lemma _root_.covby.succ_eq (h : a ⋖ b) : succ a = b :=
(succ_le_of_lt h.lt).eq_of_not_lt $ λ h', h.2 (lt_succ_of_not_is_max h.lt.not_is_max) h'

lemma _root_.wcovby.le_succ (h : a ⩿ b) : b ≤ succ a :=
begin
  obtain h | rfl := h.covby_or_eq,
  { exact h.succ_eq.ge },
  { exact le_succ _ }
end

lemma le_succ_iff_eq_or_le : a ≤ succ b ↔ a = succ b ∨ a ≤ b :=
begin
  by_cases hb : is_max b,
  { rw [hb.succ_eq, or_iff_right_of_imp le_of_eq] },
  { rw [←lt_succ_iff_of_not_is_max hb, le_iff_eq_or_lt] }
end

lemma lt_succ_iff_eq_or_lt_of_not_is_max (hb : ¬ is_max b) : a < succ b ↔ a = b ∨ a < b :=
(lt_succ_iff_of_not_is_max hb).trans le_iff_eq_or_lt

lemma Iic_succ (a : α) : Iic (succ a) = insert (succ a) (Iic a) := ext $ λ _, le_succ_iff_eq_or_le

lemma Icc_succ_right (h : a ≤ succ b) : Icc a (succ b) = insert (succ b) (Icc a b) :=
by simp_rw [←Ici_inter_Iic, Iic_succ, inter_insert_of_mem (mem_Ici.2 h)]

lemma Ioc_succ_right (h : a < succ b) : Ioc a (succ b) = insert (succ b) (Ioc a b) :=
by simp_rw [←Ioi_inter_Iic, Iic_succ, inter_insert_of_mem (mem_Ioi.2 h)]

lemma Iio_succ_eq_insert_of_not_is_max (h : ¬is_max a) : Iio (succ a) = insert a (Iio a) :=
ext $ λ _, lt_succ_iff_eq_or_lt_of_not_is_max h

lemma Ico_succ_right_eq_insert_of_not_is_max (h₁ : a ≤ b) (h₂ : ¬is_max b) :
  Ico a (succ b) = insert b (Ico a b) :=
by simp_rw [←Iio_inter_Ici, Iio_succ_eq_insert_of_not_is_max h₂, insert_inter_of_mem (mem_Ici.2 h₁)]

lemma Ioo_succ_right_eq_insert_of_not_is_max (h₁ : a < b) (h₂ : ¬is_max b) :
  Ioo a (succ b) = insert b (Ioo a b) :=
by simp_rw [←Iio_inter_Ioi, Iio_succ_eq_insert_of_not_is_max h₂, insert_inter_of_mem (mem_Ioi.2 h₁)]

section no_max_order
variables [no_max_order α]

@[simp] lemma succ_eq_succ_iff : succ a = succ b ↔ a = b :=
succ_eq_succ_iff_of_not_is_max (not_is_max a) (not_is_max b)

lemma succ_injective : injective (succ : α → α) := λ a b, succ_eq_succ_iff.1
lemma succ_ne_succ_iff : succ a ≠ succ b ↔ a ≠ b := succ_injective.ne_iff

alias succ_ne_succ_iff ↔ _ succ_ne_succ

lemma lt_succ_iff_eq_or_lt : a < succ b ↔ a = b ∨ a < b := lt_succ_iff.trans le_iff_eq_or_lt

lemma succ_eq_iff_covby : succ a = b ↔ a ⋖ b :=
⟨by { rintro rfl, exact covby_succ _ }, covby.succ_eq⟩

lemma Iio_succ_eq_insert (a : α) : Iio (succ a) = insert a (Iio a) :=
Iio_succ_eq_insert_of_not_is_max $ not_is_max a

lemma Ico_succ_right_eq_insert (h : a ≤ b) : Ico a (succ b) = insert b (Ico a b) :=
Ico_succ_right_eq_insert_of_not_is_max h $ not_is_max b

lemma Ioo_succ_right_eq_insert (h : a < b) : Ioo a (succ b) = insert b (Ioo a b) :=
Ioo_succ_right_eq_insert_of_not_is_max h $ not_is_max b

end no_max_order

section order_top
variables [order_top α]

@[simp] lemma succ_top : succ (⊤ : α) = ⊤ := is_max_top.succ_eq

@[simp] lemma succ_le_iff_eq_top : succ a ≤ a ↔ a = ⊤ := succ_le_iff_is_max.trans is_max_iff_eq_top
@[simp] lemma lt_succ_iff_ne_top : a < succ a ↔ a ≠ ⊤ :=
lt_succ_iff_not_is_max.trans not_is_max_iff_ne_top

end order_top

section order_bot
variable [order_bot α]

@[simp] lemma lt_succ_bot_iff [no_max_order α] : a < succ ⊥ ↔ a = ⊥ :=
by rw [lt_succ_iff, le_bot_iff]

lemma le_succ_bot_iff : a ≤ succ ⊥ ↔ a = ⊥ ∨ a = succ ⊥ :=
by rw [le_succ_iff_eq_or_le, le_bot_iff, or_comm]

variable [nontrivial α]

lemma bot_lt_succ (a : α) : ⊥ < succ a :=
(lt_succ_of_not_is_max not_is_max_bot).trans_le $ succ_mono bot_le

lemma succ_ne_bot (a : α) : succ a ≠ ⊥ := (bot_lt_succ a).ne'

end order_bot
end partial_order

/-- There is at most one way to define the successors in a `partial_order`. -/
instance [partial_order α] : subsingleton (succ_order α) :=
⟨begin
  introsI h₀ h₁,
  ext a,
  by_cases ha : is_max a,
  { exact (@is_max.succ_eq _ _ h₀ _ ha).trans ha.succ_eq.symm },
  { exact @covby.succ_eq _ _ h₀ _ _ (covby_succ_of_not_is_max ha) }
end⟩

section complete_lattice
variables [complete_lattice α] [succ_order α]

lemma succ_eq_infi (a : α) : succ a = ⨅ b (h : a < b), b :=
begin
  refine le_antisymm (le_infi (λ b, le_infi succ_le_of_lt)) _,
  obtain rfl | ha := eq_or_ne a ⊤,
  { rw succ_top,
    exact le_top },
  exact infi₂_le _ (lt_succ_iff_ne_top.2 ha),
end

end complete_lattice

/-! ### Predecessor order -/

section preorder
variables [preorder α] [pred_order α] {a b : α}

/-- The predecessor of an element. If `a` is not minimal, then `pred a` is the greatest element less
than `a`. If `a` is minimal, then `pred a = a`. -/
def pred : α → α := pred_order.pred

lemma pred_le : ∀ a : α, pred a ≤ a := pred_order.pred_le
lemma min_of_le_pred {a : α} : a ≤ pred a → is_min a := pred_order.min_of_le_pred
lemma le_pred_of_lt {a b : α} : a < b → a ≤ pred b := pred_order.le_pred_of_lt
lemma le_of_pred_lt {a b : α} : pred a < b → a ≤ b := pred_order.le_of_pred_lt

@[simp] lemma le_pred_iff_is_min : a ≤ pred a ↔ is_min a := ⟨min_of_le_pred, λ h, h $ pred_le _⟩

@[simp] lemma pred_lt_iff_not_is_min : pred a < a ↔ ¬ is_min a :=
⟨not_is_min_of_lt, λ ha, (pred_le a).lt_of_not_le $ λ h, ha $ min_of_le_pred h⟩

alias pred_lt_iff_not_is_min ↔ _ pred_lt_of_not_is_min

lemma pred_wcovby (a : α) : pred a ⩿ a :=
⟨pred_le a, λ b hb, (le_of_pred_lt hb).not_lt⟩

lemma pred_covby_of_not_is_min (h : ¬ is_min a) : pred a ⋖ a :=
(pred_wcovby a).covby_of_lt $ pred_lt_of_not_is_min h

lemma pred_lt_iff_of_not_is_min (ha : ¬ is_min a) : pred a < b ↔ a ≤ b :=
⟨le_of_pred_lt, (pred_lt_of_not_is_min ha).trans_le⟩

lemma le_pred_iff_of_not_is_min (ha : ¬ is_min a) : b ≤ pred a ↔ b < a :=
⟨λ h, h.trans_lt $ pred_lt_of_not_is_min ha, le_pred_of_lt⟩

@[simp, mono] lemma pred_le_pred {a b : α} (h : a ≤ b) : pred a ≤ pred b := succ_le_succ h.dual

lemma pred_mono : monotone (pred : α → α) := λ a b, pred_le_pred

lemma pred_iterate_le (k : ℕ) (x : α) : (pred^[k] x) ≤ x :=
begin
  conv_rhs { rw (by simp only [function.iterate_id, id.def] : x = (id^[k] x)) },
  exact monotone.iterate_le_of_le pred_mono pred_le k x,
end

lemma is_min_iterate_pred_of_eq_of_lt {n m : ℕ}
  (h_eq : (pred^[n] a) = (pred^[m] a)) (h_lt : n < m) :
  is_min (pred^[n] a) :=
@is_max_iterate_succ_of_eq_of_lt αᵒᵈ _ _ _ _ _ h_eq h_lt

lemma is_min_iterate_pred_of_eq_of_ne {n m : ℕ}
  (h_eq : (pred^[n] a) = (pred^[m] a)) (h_ne : n ≠ m) :
  is_min (pred^[n] a) :=
@is_max_iterate_succ_of_eq_of_ne αᵒᵈ _ _ _ _ _ h_eq h_ne

lemma Ioi_pred_of_not_is_min (ha : ¬ is_min a) : Ioi (pred a) = Ici a :=
set.ext $ λ x, pred_lt_iff_of_not_is_min ha

lemma Iic_pred_of_not_is_min (ha : ¬ is_min a) : Iic (pred a) = Iio a :=
set.ext $ λ x, le_pred_iff_of_not_is_min ha

lemma Ioc_pred_left_of_not_is_min (ha : ¬ is_min a) : Ioc (pred a) b = Icc a b :=
by rw [←Ioi_inter_Iic, Ioi_pred_of_not_is_min ha, Ici_inter_Iic]

lemma Ioo_pred_left_of_not_is_min (ha : ¬ is_min a) : Ioo (pred a) b = Ico a b :=
by rw [←Ioi_inter_Iio, Ioi_pred_of_not_is_min ha, Ici_inter_Iio]

lemma Icc_pred_right_of_not_is_min (ha : ¬ is_min b) : Icc a (pred b) = Ico a b :=
by rw [←Ici_inter_Iic, Iic_pred_of_not_is_min ha, Ici_inter_Iio]

lemma Ioc_pred_right_of_not_is_min (ha : ¬ is_min b) : Ioc a (pred b) = Ioo a b :=
by rw [←Ioi_inter_Iic, Iic_pred_of_not_is_min ha, Ioi_inter_Iio]

section no_min_order
variables [no_min_order α]

lemma pred_lt (a : α) : pred a < a := pred_lt_of_not_is_min $ not_is_min a
@[simp] lemma pred_lt_iff : pred a < b ↔ a ≤ b := pred_lt_iff_of_not_is_min $ not_is_min a
@[simp] lemma le_pred_iff : a ≤ pred b ↔ a < b := le_pred_iff_of_not_is_min $ not_is_min b

lemma pred_le_pred_iff : pred a ≤ pred b ↔ a ≤ b := by simp
lemma pred_lt_pred_iff : pred a < pred b ↔ a < b := by simp

alias pred_le_pred_iff ↔ le_of_pred_le_pred _
alias pred_lt_pred_iff ↔ lt_of_pred_lt_pred pred_lt_pred

lemma pred_strict_mono : strict_mono (pred : α → α) := λ a b, pred_lt_pred

lemma pred_covby (a : α) : pred a ⋖ a := pred_covby_of_not_is_min $ not_is_min a

@[simp] lemma Ioi_pred (a : α) : Ioi (pred a) = Ici a := Ioi_pred_of_not_is_min $ not_is_min a
@[simp] lemma Iic_pred (a : α) : Iic (pred a) = Iio a := Iic_pred_of_not_is_min $ not_is_min a

@[simp] lemma Ioc_pred_left (a b : α) : Ioc (pred a) b = Icc a b :=
Ioc_pred_left_of_not_is_min $ not_is_min _

@[simp] lemma Ioo_pred_left (a b : α) : Ioo (pred a) b = Ico a b :=
Ioo_pred_left_of_not_is_min $ not_is_min _

@[simp] lemma Icc_pred_right (a b : α) : Icc a (pred b) = Ico a b :=
Icc_pred_right_of_not_is_min $ not_is_min _

@[simp] lemma Ioc_pred_right (a b : α) : Ioc a (pred b) = Ioo a b :=
Ioc_pred_right_of_not_is_min $ not_is_min _

end no_min_order
end preorder

section partial_order
variables [partial_order α] [pred_order α] {a b : α}

@[simp] lemma pred_eq_iff_is_min : pred a = a ↔ is_min a :=
⟨λ h, min_of_le_pred h.ge, λ h, h.eq_of_le $ pred_le _⟩

alias pred_eq_iff_is_min ↔ _ _root_.is_min.pred_eq

lemma pred_le_le_iff {a b : α} : pred a ≤ b ∧ b ≤ a ↔ b = a ∨ b = pred a :=
begin
  refine ⟨λ h, or_iff_not_imp_left.2 $ λ hba : b ≠ a,
    (le_pred_of_lt $ h.2.lt_of_ne hba).antisymm h.1, _⟩,
  rintro (rfl | rfl),
  { exact ⟨pred_le b, le_rfl⟩ },
  { exact ⟨le_rfl, pred_le a⟩ }
end

lemma _root_.covby.pred_eq {a b : α} (h : a ⋖ b) : pred b = a :=
(le_pred_of_lt h.lt).eq_of_not_gt $ λ h', h.2 h' $ pred_lt_of_not_is_min h.lt.not_is_min

lemma _root_.wcovby.pred_le (h : a ⩿ b) : pred b ≤ a :=
begin
  obtain h | rfl := h.covby_or_eq,
  { exact h.pred_eq.le },
  { exact pred_le _ }
end

lemma pred_le_iff_eq_or_le : pred a ≤ b ↔ b = pred a ∨ a ≤ b :=
begin
  by_cases ha : is_min a,
  { rw [ha.pred_eq, or_iff_right_of_imp ge_of_eq] },
  { rw [←pred_lt_iff_of_not_is_min ha, le_iff_eq_or_lt, eq_comm] }
end

lemma pred_lt_iff_eq_or_lt_of_not_is_min (ha : ¬ is_min a) : pred a < b ↔ a = b ∨ a < b :=
(pred_lt_iff_of_not_is_min ha).trans le_iff_eq_or_lt

lemma Ici_pred (a : α) : Ici (pred a) = insert (pred a) (Ici a) := ext $ λ _, pred_le_iff_eq_or_le

lemma Ioi_pred_eq_insert_of_not_is_min (ha : ¬ is_min a) :
  Ioi (pred a) = insert a (Ioi a) :=
begin
  ext x, simp only [insert, mem_set_of, @eq_comm _ x a],
  exact pred_lt_iff_eq_or_lt_of_not_is_min ha
end

lemma Icc_pred_left (h : pred a ≤ b) : Icc (pred a) b = insert (pred a) (Icc a b) :=
by simp_rw [←Ici_inter_Iic, Ici_pred, insert_inter_of_mem (mem_Iic.2 h)]

lemma Ico_pred_left (h : pred a < b) : Ico (pred a) b = insert (pred a) (Ico a b) :=
by simp_rw [←Ici_inter_Iio, Ici_pred, insert_inter_of_mem (mem_Iio.2 h)]

section no_min_order
variables [no_min_order α]

@[simp] lemma pred_eq_pred_iff : pred a = pred b ↔ a = b :=
by simp_rw [eq_iff_le_not_lt, pred_le_pred_iff, pred_lt_pred_iff]

lemma pred_injective : injective (pred : α → α) := λ a b, pred_eq_pred_iff.1
lemma pred_ne_pred_iff : pred a ≠ pred b ↔ a ≠ b := pred_injective.ne_iff

alias pred_ne_pred_iff ↔ _ pred_ne_pred

lemma pred_lt_iff_eq_or_lt : pred a < b ↔ a = b ∨ a < b := pred_lt_iff.trans le_iff_eq_or_lt

lemma pred_eq_iff_covby : pred b = a ↔ a ⋖ b :=
⟨by { rintro rfl, exact pred_covby _ }, covby.pred_eq⟩

lemma Ioi_pred_eq_insert (a : α) : Ioi (pred a) = insert a (Ioi a) :=
ext $ λ _, pred_lt_iff_eq_or_lt.trans $ or_congr_left' eq_comm

lemma Ico_pred_right_eq_insert (h : a ≤ b) : Ioc (pred a) b = insert a (Ioc a b) :=
by simp_rw [←Ioi_inter_Iic, Ioi_pred_eq_insert, insert_inter_of_mem (mem_Iic.2 h)]

lemma Ioo_pred_right_eq_insert (h : a < b) : Ioo (pred a) b = insert a (Ioo a b) :=
by simp_rw [←Ioi_inter_Iio, Ioi_pred_eq_insert, insert_inter_of_mem (mem_Iio.2 h)]

end no_min_order

section order_bot
variables [order_bot α]

@[simp] lemma pred_bot : pred (⊥ : α) = ⊥ := is_min_bot.pred_eq

@[simp] lemma le_pred_iff_eq_bot : a ≤ pred a ↔ a = ⊥ := @succ_le_iff_eq_top αᵒᵈ _ _ _ _
@[simp] lemma pred_lt_iff_ne_bot : pred a < a ↔ a ≠ ⊥ := @lt_succ_iff_ne_top αᵒᵈ _ _ _ _

end order_bot

section order_top

variable [order_top α]

@[simp] lemma pred_top_lt_iff [no_min_order α] : pred ⊤ < a ↔ a = ⊤ :=
@lt_succ_bot_iff αᵒᵈ _ _ _ _ _

lemma pred_top_le_iff : pred ⊤ ≤ a ↔ a = ⊤ ∨ a = pred ⊤ := @le_succ_bot_iff αᵒᵈ _ _ _ _

variable [nontrivial α]

lemma pred_lt_top (a : α) : pred a < ⊤ :=
(pred_mono le_top).trans_lt $ pred_lt_of_not_is_min not_is_min_top

lemma pred_ne_top (a : α) : pred a ≠ ⊤ := (pred_lt_top a).ne

end order_top
end partial_order

/-- There is at most one way to define the predecessors in a `partial_order`. -/
instance [partial_order α] : subsingleton (pred_order α) :=
⟨begin
  introsI h₀ h₁,
  ext a,
  by_cases ha : is_min a,
  { exact (@is_min.pred_eq _ _ h₀ _ ha).trans ha.pred_eq.symm },
  { exact @covby.pred_eq _ _ h₀ _ _ (pred_covby_of_not_is_min ha) }
end⟩

section complete_lattice
variables [complete_lattice α] [pred_order α]

lemma pred_eq_supr (a : α) : pred a = ⨆ b (h : b < a), b :=
begin
  refine le_antisymm _ (supr_le (λ b, supr_le le_pred_of_lt)),
  obtain rfl | ha := eq_or_ne a ⊥,
  { rw pred_bot,
    exact bot_le },
  { exact @le_supr₂ _ _ (λ b, b < a) _ (λ a _, a) (pred a) (pred_lt_iff_ne_bot.2 ha) }
end

end complete_lattice

/-! ### Successor-predecessor orders -/

section succ_pred_order
variables [partial_order α] [succ_order α] [pred_order α] {a b : α}

@[simp] lemma succ_pred_of_not_is_min (h : ¬ is_min a) : succ (pred a) = a :=
(pred_covby_of_not_is_min h).succ_eq
@[simp] lemma pred_succ_of_not_is_max (h : ¬ is_max a) : pred (succ a) = a :=
(covby_succ_of_not_is_max h).pred_eq

@[simp] lemma succ_pred [no_min_order α] (a : α) : succ (pred a) = a := (pred_covby _).succ_eq
@[simp] lemma pred_succ [no_max_order α] (a : α) : pred (succ a) = a := (covby_succ _).pred_eq

lemma pred_succ_iterate_of_not_is_max (i : α) (n : ℕ) (hin : ¬ is_max (succ^[n-1] i)) :
  pred^[n] (succ^[n] i) = i :=
begin
  induction n with n hn,
  { simp only [function.iterate_zero, id.def], },
  rw [nat.succ_sub_succ_eq_sub, nat.sub_zero] at hin,
  have h_not_max : ¬ is_max (succ^[n - 1] i),
  { cases n,
    { simpa using hin, },
    rw [nat.succ_sub_succ_eq_sub, nat.sub_zero] at hn ⊢,
    have h_sub_le : (succ^[n] i) ≤ (succ^[n.succ] i),
    { rw function.iterate_succ',
      exact le_succ _, },
    refine λ h_max, hin (λ j hj, _),
    have hj_le : j ≤ (succ^[n] i) := h_max (h_sub_le.trans hj),
    exact hj_le.trans h_sub_le, },
  rw [function.iterate_succ, function.iterate_succ'],
  simp only [function.comp_app],
  rw pred_succ_of_not_is_max hin,
  exact hn h_not_max,
end

lemma succ_pred_iterate_of_not_is_min (i : α) (n : ℕ) (hin : ¬ is_min (pred^[n-1] i)) :
  succ^[n] (pred^[n] i) = i :=
@pred_succ_iterate_of_not_is_max αᵒᵈ _ _ _ i n hin

end succ_pred_order

end order

open order

/-! ### `with_bot`, `with_top`
Adding a greatest/least element to a `succ_order` or to a `pred_order`.

As far as successors and predecessors are concerned, there are four ways to add a bottom or top
element to an order:
* Adding a `⊤` to an `order_top`: Preserves `succ` and `pred`.
* Adding a `⊤` to a `no_max_order`: Preserves `succ`. Never preserves `pred`.
* Adding a `⊥` to an `order_bot`: Preserves `succ` and `pred`.
* Adding a `⊥` to a `no_min_order`: Preserves `pred`. Never preserves `succ`.
where "preserves `(succ/pred)`" means
`(succ/pred)_order α → (succ/pred)_order ((with_top/with_bot) α)`.
-/

namespace with_top

/-! #### Adding a `⊤` to an `order_top` -/

section succ
variables [decidable_eq α] [partial_order α] [order_top α] [succ_order α]

instance : succ_order (with_top α) :=
{ succ := λ a, match a with
    | ⊤        := ⊤
    | (some a) := ite (a = ⊤) ⊤ (some (succ a))
  end,
  le_succ := λ a, begin
    cases a,
    { exact le_top },
    change _ ≤ ite _ _ _,
    split_ifs,
    { exact le_top },
    { exact some_le_some.2 (le_succ a) }
  end,
  max_of_succ_le := λ a ha, begin
    cases a,
    { exact is_max_top },
    change ite _ _ _ ≤ _ at ha,
    split_ifs at ha with ha',
    { exact (not_top_le_coe _ ha).elim },
    { rw [some_le_some, succ_le_iff_eq_top] at ha,
      exact (ha' ha).elim }
  end,
  succ_le_of_lt := λ a b h, begin
    cases b,
    { exact le_top },
    cases a,
    { exact (not_top_lt h).elim },
    rw some_lt_some at h,
    change ite _ _ _ ≤ _,
    split_ifs with ha,
    { rw ha at h,
      exact (not_top_lt h).elim },
    { exact some_le_some.2 (succ_le_of_lt h) }
  end,
  le_of_lt_succ := λ a b h, begin
    cases a,
    { exact (not_top_lt h).elim },
    cases b,
    { exact le_top },
    change _ < ite _ _ _ at h,
    rw some_le_some,
    split_ifs at h with hb,
    { rw hb,
      exact le_top },
    { exact le_of_lt_succ (some_lt_some.1 h) }
  end }

@[simp] lemma succ_coe_top : succ ↑(⊤ : α) = (⊤ : with_top α) := dif_pos rfl
lemma succ_coe_of_ne_top {a : α} (h : a ≠ ⊤) : succ (↑a : with_top α) = ↑(succ a) :=
dif_neg h

end succ

section pred
variables [preorder α] [order_top α] [pred_order α]

instance : pred_order (with_top α) :=
{ pred := λ a, match a with
    | ⊤        := some ⊤
    | (some a) := some (pred a)
  end,
  pred_le := λ a, match a with
    | ⊤        := le_top
    | (some a) := some_le_some.2 (pred_le a)
  end,
  min_of_le_pred := λ a ha, begin
    cases a,
    { exact ((coe_lt_top (⊤ : α)).not_le ha).elim },
    { exact (min_of_le_pred $ some_le_some.1 ha).with_top }
  end,
  le_pred_of_lt := λ a b h, begin
    cases a,
    { exact ((le_top).not_lt h).elim },
    cases b,
    { exact some_le_some.2 le_top },
    exact some_le_some.2 (le_pred_of_lt $ some_lt_some.1 h),
  end,
  le_of_pred_lt := λ a b h, begin
    cases b,
    { exact le_top },
    cases a,
    { exact (not_top_lt $ some_lt_some.1 h).elim },
    { exact some_le_some.2 (le_of_pred_lt $ some_lt_some.1 h) }
  end }

@[simp] lemma pred_top : pred (⊤ : with_top α) = ↑(⊤ : α) := rfl
@[simp] lemma pred_coe (a : α) : pred (↑a : with_top α) = ↑(pred a) := rfl

@[simp] lemma pred_untop : ∀ (a : with_top α) (ha : a ≠ ⊤),
  pred (a.untop ha) = (pred a).untop (by induction a using with_top.rec_top_coe; simp)
| ⊤ ha := (ha rfl).elim
| (a : α) ha := rfl

end pred

/-! #### Adding a `⊤` to a `no_max_order` -/

section succ
variables [preorder α] [no_max_order α] [succ_order α]

instance succ_order_of_no_max_order : succ_order (with_top α) :=
{ succ := λ a, match a with
    | ⊤        := ⊤
    | (some a) := some (succ a)
  end,
  le_succ := λ a, begin
    cases a,
    { exact le_top },
    { exact some_le_some.2 (le_succ a) }
  end,
  max_of_succ_le := λ a ha, begin
    cases a,
    { exact is_max_top },
    { exact (not_is_max _ $ max_of_succ_le $ some_le_some.1 ha).elim }
  end,
  succ_le_of_lt := λ a b h, begin
    cases a,
    { exact (not_top_lt h).elim },
    cases b,
    { exact le_top},
    { exact some_le_some.2 (succ_le_of_lt $ some_lt_some.1 h) }
  end,
  le_of_lt_succ := λ a b h, begin
    cases a,
    { exact (not_top_lt h).elim },
    cases b,
    { exact le_top },
    { exact some_le_some.2 (le_of_lt_succ $ some_lt_some.1 h) }
  end }

@[simp] lemma succ_coe (a : α) : succ (↑a : with_top α) = ↑(succ a) := rfl

end succ

section pred
variables [preorder α] [no_max_order α]

instance [hα : nonempty α] : is_empty (pred_order (with_top α)) :=
⟨begin
  introI,
  cases h : pred (⊤ : with_top α) with a ha,
  { exact hα.elim (λ a, (min_of_le_pred h.ge).not_lt $ coe_lt_top a) },
  { obtain ⟨c, hc⟩ := exists_gt a,
    rw [←some_lt_some, ←h] at hc,
    exact (le_of_pred_lt hc).not_lt (some_lt_none _) }
end⟩

end pred

end with_top

namespace with_bot

/-! #### Adding a `⊥` to an `order_bot` -/

section succ
variables [preorder α] [order_bot α] [succ_order α]

instance : succ_order (with_bot α) :=
{ succ := λ a, match a with
    | ⊥        := some ⊥
    | (some a) := some (succ a)
  end,
  le_succ := λ a, match a with
    | ⊥        := bot_le
    | (some a) := some_le_some.2 (le_succ a)
  end,
  max_of_succ_le := λ a ha, begin
    cases a,
    { exact ((none_lt_some (⊥ : α)).not_le ha).elim },
    { exact (max_of_succ_le $ some_le_some.1 ha).with_bot }
  end,
  succ_le_of_lt := λ a b h, begin
    cases b,
    { exact (not_lt_bot h).elim },
    cases a,
    { exact some_le_some.2 bot_le },
    { exact some_le_some.2 (succ_le_of_lt $ some_lt_some.1 h) }
  end,
  le_of_lt_succ := λ a b h, begin
    cases a,
    { exact bot_le },
    cases b,
    { exact (not_lt_bot $ some_lt_some.1 h).elim },
    { exact some_le_some.2 (le_of_lt_succ $ some_lt_some.1 h) }
  end }

@[simp] lemma succ_bot : succ (⊥ : with_bot α) = ↑(⊥ : α) := rfl
@[simp] lemma succ_coe (a : α) : succ (↑a : with_bot α) = ↑(succ a) := rfl

@[simp] lemma succ_unbot : ∀ (a : with_bot α) (ha : a ≠ ⊥),
  succ (a.unbot ha) = (succ a).unbot (by induction a using with_bot.rec_bot_coe; simp)
| ⊥ ha := (ha rfl).elim
| (a : α) ha := rfl

end succ

section pred
variables [decidable_eq α] [partial_order α] [order_bot α] [pred_order α]

instance : pred_order (with_bot α) :=
{ pred := λ a, match a with
    | ⊥        := ⊥
    | (some a) := ite (a = ⊥) ⊥ (some (pred a))
  end,
  pred_le := λ a, begin
    cases a,
    { exact bot_le },
    change ite _ _ _ ≤ _,
    split_ifs,
    { exact bot_le },
    { exact some_le_some.2 (pred_le a) }
  end,
  min_of_le_pred := λ a ha, begin
    cases a,
    { exact is_min_bot },
    change _ ≤ ite _ _ _ at ha,
    split_ifs at ha with ha',
    { exact (not_coe_le_bot _ ha).elim },
    { rw [some_le_some, le_pred_iff_eq_bot] at ha,
      exact (ha' ha).elim }
  end,
  le_pred_of_lt := λ a b h, begin
    cases a,
    { exact bot_le },
    cases b,
    { exact (not_lt_bot h).elim },
    rw some_lt_some at h,
    change _ ≤ ite _ _ _,
    split_ifs with hb,
    { rw hb at h,
      exact (not_lt_bot h).elim },
    { exact some_le_some.2 (le_pred_of_lt h) }
  end,
  le_of_pred_lt := λ a b h, begin
    cases b,
    { exact (not_lt_bot h).elim },
    cases a,
    { exact bot_le },
    change ite _ _ _ < _ at h,
    rw some_le_some,
    split_ifs at h with ha,
    { rw ha,
      exact bot_le },
    { exact le_of_pred_lt (some_lt_some.1 h) }
  end }

@[simp] lemma pred_coe_bot : pred ↑(⊥ : α) = (⊥ : with_bot α) := dif_pos rfl
lemma pred_coe_of_ne_bot {a : α} (h : a ≠ ⊥) : pred (↑a : with_bot α) = ↑(pred a) :=
dif_neg h

end pred

/-! #### Adding a `⊥` to a `no_min_order` -/

section succ
variables [preorder α] [no_min_order α]

instance [hα : nonempty α] : is_empty (succ_order (with_bot α)) :=
⟨begin
  introI,
  cases h : succ (⊥ : with_bot α) with a ha,
  { exact hα.elim (λ a, (max_of_succ_le h.le).not_lt $ bot_lt_coe a) },
  { obtain ⟨c, hc⟩ := exists_lt a,
    rw [←some_lt_some, ←h] at hc,
    exact (le_of_lt_succ hc).not_lt (none_lt_some _) }
end⟩

end succ

section pred
variables [preorder α] [no_min_order α] [pred_order α]

instance pred_order_of_no_min_order : pred_order (with_bot α) :=
{ pred := λ a, match a with
    | ⊥        := ⊥
    | (some a) := some (pred a)
  end,
  pred_le := λ a, begin
    cases a,
    { exact bot_le },
    { exact some_le_some.2 (pred_le a) }
  end,
  min_of_le_pred := λ a ha, begin
    cases a,
    { exact is_min_bot },
    { exact (not_is_min _ $ min_of_le_pred $ some_le_some.1 ha).elim }
  end,
  le_pred_of_lt := λ a b h, begin
    cases b,
    { exact (not_lt_bot h).elim },
    cases a,
    { exact bot_le },
    { exact some_le_some.2 (le_pred_of_lt $ some_lt_some.1 h) }
  end,
  le_of_pred_lt := λ a b h, begin
    cases b,
    { exact (not_lt_bot h).elim },
    cases a,
    { exact bot_le },
    { exact some_le_some.2 (le_of_pred_lt $ some_lt_some.1 h) }
  end }

@[simp] lemma pred_coe (a : α) : pred (↑a : with_bot α) = ↑(pred a) := rfl

end pred
end with_bot

/-! ### Archimedeanness -/

/-- A `succ_order` is succ-archimedean if one can go from any two comparable elements by iterating
`succ` -/
class is_succ_archimedean (α : Type*) [preorder α] [succ_order α] : Prop :=
(exists_succ_iterate_of_le {a b : α} (h : a ≤ b) : ∃ n, succ^[n] a = b)

/-- A `pred_order` is pred-archimedean if one can go from any two comparable elements by iterating
`pred` -/
class is_pred_archimedean (α : Type*) [preorder α] [pred_order α] : Prop :=
(exists_pred_iterate_of_le {a b : α} (h : a ≤ b) : ∃ n, pred^[n] b = a)

export is_succ_archimedean (exists_succ_iterate_of_le)
export is_pred_archimedean (exists_pred_iterate_of_le)

section preorder
variables [preorder α]

section succ_order
variables [succ_order α] [is_succ_archimedean α] {a b : α}

instance : is_pred_archimedean αᵒᵈ := ⟨λ a b h, by convert exists_succ_iterate_of_le h.of_dual⟩

lemma has_le.le.exists_succ_iterate (h : a ≤ b) : ∃ n, succ^[n] a = b :=
exists_succ_iterate_of_le h

lemma exists_succ_iterate_iff_le : (∃ n, succ^[n] a = b) ↔ a ≤ b :=
begin
  refine ⟨_, exists_succ_iterate_of_le⟩,
  rintro ⟨n, rfl⟩,
  exact id_le_iterate_of_id_le le_succ n a,
end

/-- Induction principle on a type with a `succ_order` for all elements above a given element `m`. -/
@[elab_as_eliminator] lemma succ.rec {P : α → Prop} {m : α}
  (h0 : P m) (h1 : ∀ n, m ≤ n → P n → P (succ n)) ⦃n : α⦄ (hmn : m ≤ n) : P n :=
begin
  obtain ⟨n, rfl⟩ := hmn.exists_succ_iterate, clear hmn,
  induction n with n ih,
  { exact h0 },
  { rw [function.iterate_succ_apply'], exact h1 _ (id_le_iterate_of_id_le le_succ n m) ih }
end

lemma succ.rec_iff {p : α → Prop} (hsucc : ∀ a, p a ↔ p (succ a)) {a b : α} (h : a ≤ b) :
  p a ↔ p b :=
begin
  obtain ⟨n, rfl⟩ := h.exists_succ_iterate,
  exact iterate.rec (λ b, p a ↔ p b) (λ c hc, hc.trans (hsucc _)) iff.rfl n,
end

end succ_order

section pred_order
variables [pred_order α] [is_pred_archimedean α] {a b : α}

instance : is_succ_archimedean αᵒᵈ := ⟨λ a b h, by convert exists_pred_iterate_of_le h.of_dual⟩

lemma has_le.le.exists_pred_iterate (h : a ≤ b) : ∃ n, pred^[n] b = a :=
exists_pred_iterate_of_le h

lemma exists_pred_iterate_iff_le : (∃ n, pred^[n] b = a) ↔ a ≤ b :=
@exists_succ_iterate_iff_le αᵒᵈ _ _ _ _ _

/-- Induction principle on a type with a `pred_order` for all elements below a given element `m`. -/
@[elab_as_eliminator] lemma pred.rec {P : α → Prop} {m : α}
  (h0 : P m) (h1 : ∀ n, n ≤ m → P n → P (pred n)) ⦃n : α⦄ (hmn : n ≤ m) : P n :=
@succ.rec αᵒᵈ _ _ _ _ _ h0 h1 _ hmn

lemma pred.rec_iff {p : α → Prop} (hsucc : ∀ a, p a ↔ p (pred a)) {a b : α} (h : a ≤ b) :
  p a ↔ p b :=
(@succ.rec_iff αᵒᵈ _ _ _ _ hsucc _ _ h).symm

end pred_order
end preorder

section linear_order
variables [linear_order α]

section succ_order
variables [succ_order α] [is_succ_archimedean α] {a b : α}

lemma exists_succ_iterate_or : (∃ n, succ^[n] a = b) ∨ ∃ n, succ^[n] b = a :=
(le_total a b).imp exists_succ_iterate_of_le exists_succ_iterate_of_le

lemma succ.rec_linear {p : α → Prop} (hsucc : ∀ a, p a ↔ p (succ a)) (a b : α) : p a ↔ p b :=
(le_total a b).elim (succ.rec_iff hsucc) (λ h, (succ.rec_iff hsucc h).symm)

end succ_order

section pred_order
variables [pred_order α] [is_pred_archimedean α] {a b : α}

lemma exists_pred_iterate_or : (∃ n, pred^[n] b = a) ∨ ∃ n, pred^[n] a = b :=
(le_total a b).imp exists_pred_iterate_of_le exists_pred_iterate_of_le

lemma pred.rec_linear {p : α → Prop} (hsucc : ∀ a, p a ↔ p (pred a)) (a b : α) : p a ↔ p b :=
(le_total a b).elim (pred.rec_iff hsucc) (λ h, (pred.rec_iff hsucc h).symm)

end pred_order
end linear_order

section is_well_order
variables [linear_order α]

@[priority 100]
instance is_well_order.to_is_pred_archimedean [h : is_well_order α (<)] [pred_order α] :
  is_pred_archimedean α :=
⟨λ a, begin
  refine well_founded.fix h.wf (λ b ih hab, _),
  replace hab := hab.eq_or_lt,
  rcases hab with rfl | hab,
  { exact ⟨0, rfl⟩ },
  cases le_or_lt b (pred b) with hb hb,
  { cases (min_of_le_pred hb).not_lt hab },
  obtain ⟨k, hk⟩ := ih (pred b) hb (le_pred_of_lt hab),
  refine ⟨k + 1, _⟩,
  rw [iterate_add_apply, iterate_one, hk],
end⟩

@[priority 100]
instance is_well_order.to_is_succ_archimedean [h : is_well_order α (>)] [succ_order α] :
  is_succ_archimedean α :=
by convert @order_dual.is_succ_archimedean αᵒᵈ _ _ _

end is_well_order

section order_bot
variables [preorder α] [order_bot α] [succ_order α] [is_succ_archimedean α]

lemma succ.rec_bot (p : α → Prop) (hbot : p ⊥) (hsucc : ∀ a, p a → p (succ a)) (a : α) : p a :=
succ.rec hbot (λ x _ h, hsucc x h) (bot_le : ⊥ ≤ a)

end order_bot

section order_top
variables [preorder α] [order_top α] [pred_order α] [is_pred_archimedean α]

lemma pred.rec_top (p : α → Prop) (htop : p ⊤) (hpred : ∀ a, p a → p (pred a)) (a : α) : p a :=
pred.rec htop (λ x _ h, hpred x h) (le_top : a ≤ ⊤)

end order_top


import Rings.Rings
import Rings.Fields
import Rings.ToMathlib.list
import Rings.ToMathlib.nat
import Rings.ToMathlib.fol
import Rings.ToMathlib.mv_polynomial
import algebra.big_operators.finprod
import data.finset.basic
import Rings.Lefschetz

namespace AxGroth

noncomputable theory

universe u

open fol
open Rings

/-- composition by coe : fin d → ℕ -/
def monom_of_bd_monom {n d : ℕ} :
  (fin n → fin d) ↪ fin n → ℕ :=
⟨
  λ f, coe ∘ f ,
  λ f g h,
  begin
    funext i,
    have h' := congr_fun h i,
    apply fin.coe_injective h',
  end
⟩

/-- converts map from fin n to same map with finite support -/
def finsupp_of_fin_dom {A : Type*} [has_zero A] {n : ℕ} :
  (fin n → A) → fin n →₀ A :=
finsupp.equiv_fun_on_fintype.inv_fun

def finsupp_of_fin_dom_emb {A : Type*} [has_zero A] {n : ℕ} :
  (fin n → A) ↪ (fin n →₀ A) :=
equiv.to_embedding finsupp.equiv_fun_on_fintype.symm

@[simp] lemma to_fun_finsupp_of_fin_dom {A : Type*} [has_zero A] {n : ℕ}
  (f : fin n → A) : (finsupp_of_fin_dom f).to_fun = f :=
begin
  simp only [finsupp_of_fin_dom],
  funext k,
  refl,
end

@[simp] lemma finsupp_of_fin_dom_to_fun {A : Type*} [has_zero A] {n : ℕ}
  (f : fin n →₀ A) : finsupp_of_fin_dom f.to_fun = f :=
begin
  simp only [finsupp_of_fin_dom],
  apply finsupp.ext,
  intro k,
  refl,
end

lemma to_fun_finsupp_of_fin_dom_emb {A : Type*} [has_zero A] {n : ℕ}
  (f : fin n → A) : (finsupp_of_fin_dom_emb f).to_fun = f :=
begin
  simp only [finsupp_of_fin_dom_emb],
  exact to_fun_finsupp_of_fin_dom f,
end

/-- {f : fin n → ℕ | ∀ i, f i < d.succ }-/
@[simp] def n_var_bd_monom (n d : ℕ) : finset (fin n → ℕ) :=
finset.map (@monom_of_bd_monom n d.succ)
finset.univ

-- then convert these to maps f : fin n → ℕ
/-- { f : fin n → ℕ | sum f ≤ d } -/
@[simp] def monom_deg_le_finset (n d : ℕ) : finset (fin n → ℕ) :=
finset.filter
  (λ f : fin n → ℕ, (finsupp_of_fin_dom f).support.sum f ≤ d)
  (n_var_bd_monom n d)

/-- list of all n-variable monomials of degree ≤ d -/
def monom_deg_le (n d : ℕ) : list (fin n → ℕ) :=
(monom_deg_le_finset n d).to_list

/-- lists all n-variable monomials of degree ≤ d as finsupp maps-/
@[simp] def monom_deg_le₀ (n d : ℕ) : list (fin n →₀ ℕ) :=
list.map (finsupp_of_fin_dom) $ monom_deg_le n d

-- no restriction on degree
/-- takes a polynomial in n variables and gives a list of its coefficients-/
@[simp] def coeffs_list_of_mv_polynomial
  {K : Type*} [comm_semiring K] {n : ℕ} (d : ℕ)
  (p : mv_polynomial (fin n) K) : list K :=
list.map (λ m, mv_polynomial.coeff m p) (monom_deg_le₀ n d)

/-- there is always a monomial of degree ≤ d,
  namely the constant polynomial 0 -/
lemma monom_deg_le_length_ne_zero (n d : ℕ) :
  (monom_deg_le n d).length ≠ 0 :=
begin
  simp only [monom_deg_le,
    finset.length_to_list, finset.card_map,
    monom_deg_le_finset],
  apply finset.card_ne_zero_of_mem _,
  {exact λ _, 0},
  {
    simp only [finset.mem_univ, finset.sum_const_zero,
      finset.mem_filter, n_var_bd_monom, and_true, finset.mem_map,
      zero_le', exists_true_left, monom_of_bd_monom],
    exact ⟨ (λ _, 0) , rfl ⟩,
  },
end

lemma zero_lt_monom_deg_le_length (n d : ℕ) :
  0 < (monom_deg_le n d).length :=
  nat.pos_of_ne_zero (monom_deg_le_length_ne_zero n d)

lemma monom_deg_le₀_nth_le {n d k : ℕ}
  (hk : k < (monom_deg_le n d).length) :
  (monom_deg_le₀ n d).nth_le k (by simp [hk]) =
  finsupp_of_fin_dom_emb ((monom_deg_le n d).nth_le k hk) :=
begin
  simp only [list.length_map, list.length,
    list.nth_le, monom_deg_le₀, list.map, finsupp_of_fin_dom_emb,
    finsupp_of_fin_dom],
  simp only [equiv.to_embedding_apply, list.nth_le_map', equiv.inv_fun_as_coe],
end

lemma index_of_monom_deg_le_lt_length {n d : ℕ} (f : fin n → ℕ) :
  list.index_of' f (monom_deg_le_finset n d).to_list
  < (monom_deg_le n d).length :=
list.index_of'_lt_length (zero_lt_monom_deg_le_length n d)

lemma index_of_monom_deg_le₀_lt_length {n d : ℕ} (f : fin n → ℕ) :
  list.index_of' f (monom_deg_le_finset n d).to_list
  < (monom_deg_le₀ n d).length :=
begin
  rw monom_deg_le₀,
  rw list.length_map,
  apply list.index_of'_lt_length (zero_lt_monom_deg_le_length n d),
end

/-- the bound hndc is enough in poly_indexed_by_monoms -/
lemma poly_indexed_by_monoms_aux0 (n d s c : ℕ)
  (hndc : (monom_deg_le n d).length + s ≤ c) (f : fin n → ℕ) :
  list.index_of' f (monom_deg_le n d) + s < c :=
begin
  apply nat.lt_of_lt_of_le _ hndc,
  apply nat.add_lt_add_right,
  apply list.index_of'_lt_length,
  apply nat.pos_of_ne_zero (monom_deg_le_length_ne_zero n d),
end

/-- if i ∈ fin n and n + p ≤ c then i + p < c -/
lemma fin_add_lt_of_add_le (n p c : ℕ) (hnpc : n + p ≤ c) (i : fin n) :
(i : ℕ) + p < c :=
begin
  apply nat.lt_of_lt_of_le _ hnpc,
  apply nat.add_lt_add_right i.2,
end

/-- ∑_{f ∈ monom_deg_le n d} xⱼ₊ₛ ∏ {0 ≤ i < n} xᵢ₊ₚᶠ⁽ⁱ⁾ in "context c"
 where j is the index of f in monom_deg_le n d
 the context should at least include the variables xⱼ₊ₛ -- this is hndc
 the context should at least include the variables xᵢ₊ₚ -- this is hpc -/
@[simp] def poly_indexed_by_monoms (n d s p c : ℕ)
  (hndsc : (monom_deg_le n d).length + s ≤ c)
  (hnpc : n + p ≤ c) :
  bounded_ring_term c :=
-- sum indexed by the n-variable monom of degree < d
list.sumr
(list.map
  (
    λ f : (fin n → ℕ),
    let
      x_js : bounded_ring_term c :=
      x_ ⟨((monom_deg_le n d).index_of' f + s) ,
        poly_indexed_by_monoms_aux0 n d s c hndsc f ⟩,
      x_ip (i : fin n) : bounded_ring_term c :=
      x_ ⟨ (i : ℕ) + p , fin_add_lt_of_add_le n p c hnpc i ⟩
    in
    x_js * (n.non_comm_prod $ λ i, npow_rec (f i) (x_ip i))
  )
  (monom_deg_le n d)
)

lemma realize_poly_indexed_by_monoms
  {A : Type*} [comm_ring A] {n d s p c : ℕ}
  (hndsc : (monom_deg_le n d).length + s ≤ c)
  (hnpc : n + p ≤ c)
  {xs : dvector (struc_to_ring_struc.Structure A) c}  :
  realize_bounded_term xs
    (poly_indexed_by_monoms n d s p c hndsc hnpc) dvector.nil
  =
  list.sumr
  (list.map
    (λ f,
    (dvector.nth xs (list.index_of' f (monom_deg_le n d) + s)
      (poly_indexed_by_monoms_aux0 n d s c hndsc f))
    *
    (n.non_comm_prod $ λ i,
    ((dvector.nth xs (i + p) (fin_add_lt_of_add_le n p c hnpc i)) ^ (f i) ))
    )
  (monom_deg_le n d)
  ) :=
begin
  simp only [poly_indexed_by_monoms],
  rw realize_ring_term.sumr,
  rw ← list.comp_map,
  congr,
  funext f,
  simp only [realize_ring_term.add_zero_hom, function.comp_app],
  simp only [struc_to_ring_struc.func_map, fin.val_eq_coe, dvector.last,
    struc_to_ring_struc.binaries_map, realize_bounded_term,
    dvector.nth],
  congr,
  rw realize_ring_term.nat_non_comm_prod,
  congr,
  funext i,
  simp only [realize_ring_term.pow, realize_bounded_term],
end

lemma inj_formula_aux0 {n d : ℕ} {j : fin n} :
  (monom_deg_le n d).length +
    (j * ((monom_deg_le n d).length) + n + n)
  ≤
  n * (monom_deg_le n d).length + n + n :=
begin
  let c := n * ((monom_deg_le n d).length) + n + n,
  let monom := (monom_deg_le n d).length,
  repeat {rw ← nat.add_assoc, apply nat.add_le_add_right},
  cases nat.exists_eq_succ_of_ne_zero (ne_zero_of_lt j.2) with k hk,
  have hrw : n * (monom_deg_le n d).length = (monom_deg_le n d).length + k * (monom_deg_le n d).length,
  {
    rw hk,
    rw nat.succ_mul,
    rw nat.add_comm,
  },
  rw hrw,
  apply nat.add_le_add_left,
  apply nat.mul_le_mul_of_nonneg_right,
  apply nat.le_of_lt_succ,
  rw ← hk,
  exact j.2,
end

lemma inj_formula_aux1 {n d : ℕ} :
  n + 0
  ≤
  n * (monom_deg_le n d).length + n + n :=
begin
  rw add_comm,
  apply nat.add_le_add_right,
  apply nat.zero_le,
end

lemma inj_formula_aux2 {n d : ℕ} :
  n + n
  ≤
  n * (monom_deg_le n d).length + n + n :=
begin
  rw nat.add_assoc,
  apply nat.le_add_left,
end

lemma inj_formula_aux3 {n m : ℕ} {i : fin n} :
  (i : ℕ)
  <
  n * m + n + n :=
begin
  apply nat.lt_of_lt_of_le i.2,
  apply nat.le_add_left,
end

lemma inj_formula_aux4 {n m : ℕ} {i : fin n} :
  (i : ℕ) + n < n * m + n + n :=
begin
  rw nat.add_assoc,
  apply nat.lt_add_left,
  apply nat.add_lt_add_right,
  exact i.2,
end

-- in the context of having n polynomials pⱼ indexed by
-- their monomial coefficients,
-- if for all xᵢ and all yᵢ, every polynomial satisfies pⱼ xᵢ = pⱼ yᵢ
-- then each xᵢ = yᵢ.
-- This says the polynomial map formed by the pⱼs is injective
/-- Injectivity of polynomial maps stated model-theoretically-/
def inj_formula (n d : ℕ) :
  bounded_ring_formula (n * (monom_deg_le n d).length) :=
  let monom := (monom_deg_le n d).length in
-- for all pairs in the domain x₋ ∈ Kⁿ and ...
bd_alls' n _
$
-- ... y₋ ∈ Kⁿ
bd_alls' n _
$
-- if at each pⱼ
(bd_big_and n
-- pⱼ x₋ = pⱼ y₋
  (λ j,
    (poly_indexed_by_monoms n d (j * monom + n + n) n _ -- note n
      inj_formula_aux0 inj_formula_aux2)
    ≃
    (poly_indexed_by_monoms n d (j * monom + n + n) 0 _ -- note 0
      inj_formula_aux0 inj_formula_aux1)
  )
)
-- then
⟹
-- at each 0 ≤ i < n,
(bd_big_and n $ λ i,
-- xᵢ = yᵢ (where yᵢ is written as xᵢ₊ₙ₊₁)
  x_ (⟨ i + n , inj_formula_aux4 ⟩) ≃ x_ ⟨ i , inj_formula_aux3 ⟩
)

-- in the context of having n polynomials pⱼ indexed by
-- their monomial coefficients,
-- for all z₋ ∈ Kⁿ, there exists x₋ ∈ Kⁿ such that each zⱼ = pⱼ x₋
-- This says the polynomial map formed by the pⱼs is surjective
/-- Surjectivity of polynomial maps stated model-theoretically-/
def surj_formula (n d : ℕ) :
  bounded_ring_formula (n * (monom_deg_le n d).length) :=
let monom := (monom_deg_le n d).length in
-- for all x₋ ∈ Kⁿ in the codomain
bd_alls' n _
$
-- there exists y₋ ∈ Kⁿ in the domain such that
bd_exs' n _
$
-- at each 0 ≤ j < n
bd_big_and n
$
-- pⱼ y₋ = xⱼ
λ j,
  poly_indexed_by_monoms n d (j * monom + n + n) 0 _
    inj_formula_aux0 inj_formula_aux1
  ≃
  x_ ⟨ j + n , inj_formula_aux4 ⟩

/-- Ax-Grothendieck stated model-theoretically -/
def Ax_Groth_formula (n d : ℕ) : sentence ring_signature :=
-- quantify over n many (n-variable polynomials) called ps;
-- i.e. the data of a polynomial map
-- by quantifying over (n * monom_of_bounded_degree) monomial coefficients
bd_alls (n * ((monom_deg_le n d).length))
-- if the polynomial function is injective then it is surjective
$ inj_formula n d ⟹ surj_formula n d

/-- the data of a polynomial map consists of n polynomials in n variables -/
@[simp] def poly_map (K : Type*) [comm_semiring K] (n : ℕ) : Type* :=
fin n → mv_polynomial (fin n) K

namespace poly_map

open mv_polynomial

variables {K : Type*} [comm_semiring K] {n : ℕ}

/-- a polynomial map evaluates those polynomials that it consists of -/
def eval :
  poly_map K n → (fin n → K) → (fin n → K) :=
λ ps as k, mv_polynomial.eval as (ps k)

lemma eval_mem_aux [decidable_eq K] {σ : Type*}
  (p : fin n → mv_polynomial σ K) (s : subsemiring K)
  (hs : ∀ i, ↑((p i).support.image (λ x, coeff x (p i))) ⊆ (s : set K)) :
  ∀ (v : σ → K) (hv : ∀ i, v i ∈ s) (i : fin n), mv_polynomial.eval v (p i) ∈ s :=
begin
  induction n with n ih,
  { intros _ _ i,
    exact i.elim0 },
  { intros v hv i,
    refine fin.cases _ _ i,
    { apply mv_polynomial.eval_mem (p 0) s,
      { intros m,
        by_cases hm : m ∈ (p 0).support,
        { exact hs 0 (finset.mem_image.2 ⟨m, hm, rfl⟩) },
        { rw [not_mem_support_iff.1 hm],
          exact subsemiring.zero_mem _ } },
      { assumption } },
    { intro j,
      apply ih (λ i, p i.succ) _ _ hv,
      intro k,
      apply hs } }
end

lemma eval_mem [decidable_eq K]
  (p : poly_map K n) (s : subsemiring K)
  (hs : ∀ i, ↑((p i).support.image (λ x, coeff x (p i))) ⊆ (s : set K)) :
  ∀ (v : fin n → K) (hv : ∀ i, v i ∈ s) (i : fin n), mv_polynomial.eval v (p i) ∈ s :=
eval_mem_aux p s hs

end poly_map

-- /-- Any injective polynomial map over an algerbaically closed field of char p is surjective -/
-- axiom Ax_Groth_of_locally_finite
--   {K : Type*} [field K] [is_alg_closed K]
--   {p : ℕ} (hprime : nat.prime p) (hchar : char_p K p) {n : ℕ}
--   (ps : poly_map K n) (hinj : function.injective (poly_map.eval ps)) :
--   function.surjective (poly_map.eval ps)
-- not the focus of the project so we take it as an axiom

section semiring

variables {A : Type*} [comm_semiring A] {n : ℕ}

/-- takes a polynomial map
  (preferably of total deg < d) and gives list of coeffs of each monomial -/
@[simp] def poly_map.coeffs_list
  {n : ℕ} (d : ℕ) (ps : poly_map A n) : list A :=
list.join (list.of_fn (λ i : fin n, coeffs_list_of_mv_polynomial d (ps i)))

/- Writes polynomial map into a dvector of its coefficients -/
def poly_map.coeffs_dvector
  {n : ℕ} (d : ℕ) (ps : poly_map A n) :
  dvector A (poly_map.coeffs_list d ps).length :=
dvector.of_list (poly_map.coeffs_list d ps)

/-- the number of coefficients of mv_polynomial = number of monomials -/
lemma coeffs_list_length_eq_monom_deg_le_length {d : ℕ}
  (p : mv_polynomial (fin n) A) :
  (coeffs_list_of_mv_polynomial d p).length
  =
  (monom_deg_le n d).length := by simp

/-- lemma for matching up lengths of contexts for mv_polynomials -/
lemma variable_bound_equal {n : ℕ} (d : ℕ) (ps : poly_map A n) :
  (n * (monom_deg_le n d).length)
  =
  (poly_map.coeffs_list d ps).length :=
begin
  simp only [poly_map.coeffs_list, list.length_join],
  rw list.sum_map_length_of_fn_const_length,
  intro i,
  apply coeffs_list_length_eq_monom_deg_le_length,
end

/-- Writes polynomial map into a dvector of its coefficients
  (with a replaced variable context) -/
def poly_map.coeffs_dvector' {n : ℕ} (d : ℕ)
  (ps : poly_map A n) :
  dvector A (n * (monom_deg_le n d).length) :=
dvector.cast (symm (variable_bound_equal d ps))
  (poly_map.coeffs_dvector d ps)

end semiring

section injectivity_and_surjectivity_from_mv_polynomial

variables {A : Type*} [comm_ring A] {n d : ℕ}
  (p : mv_polynomial (fin n) A)

/-- the support of a polynomial of degree ≤ d is contained in the set of monomials of degree ≤ d -/
lemma support_sub_monom_deg_le_finset (hdeg : p.total_degree ≤ d) :
  p.support ⊆ finset.map finsupp_of_fin_dom_emb (monom_deg_le_finset n d) :=
begin
  intros f hf,
  simp only [true_and, exists_prop, finset.mem_univ,
    finset.mem_map, monom_deg_le_finset, finset.mem_filter],
  exact ⟨ f.to_fun,
  begin
    have hf_img_lt : ∀ i : fin n, f i < d.succ,
    {
      intro i,
      rw nat.lt_succ_iff,
      apply le_trans _ hdeg,
      exact mv_polynomial.support_le_total_degree i f hf,
    },
    refine ⟨ ⟨ _ , _ ⟩ , _ ⟩ ,
    {
      simp only [n_var_bd_monom, monom_of_bd_monom, finset.mem_map,
        finset.mem_univ],
      exact ⟨ λ k, ⟨ f k, hf_img_lt k⟩, trivial , rfl ⟩,
    },
    {
      apply le_trans _ hdeg,
      rw finsupp_of_fin_dom_to_fun,
      apply finset.le_sup hf,
    },
    {exact finsupp_of_fin_dom_to_fun f},
  end ⟩,
end

/-- the support union its complement (in monom_deg_le_finset) is equal to the whole thing-/
lemma support_union_compl_eq_monom_deg_le_finset
  [decidable_eq (mv_polynomial (fin n) A)] (hdeg : p.total_degree ≤ d) :
  p.support ∪
    (finset.map finsupp_of_fin_dom_emb (monom_deg_le_finset n d)
      \ p.support) =
  finset.map finsupp_of_fin_dom_emb (monom_deg_le_finset n d) :=
finset.union_sdiff_of_subset $ support_sub_monom_deg_le_finset _ hdeg

lemma mv_polynomial_sum_eq_finset_map_monom_deg_le_finset_sum
  [decidable_eq (mv_polynomial (fin n) A)]
  (hdeg : p.total_degree ≤ d)
  (as : (fin n →₀ ℕ) → A)
  :
  p.support.sum (λ (f : fin n →₀ ℕ), mv_polynomial.coeff f p * as f)
  =
  (finset.map finsupp_of_fin_dom_emb (monom_deg_le_finset n d)).sum
  (λ (f : fin n →₀ ℕ), mv_polynomial.coeff f p * as f)
  :=
begin
  rw ← support_union_compl_eq_monom_deg_le_finset p hdeg,
  rw finset.sum_union,
  {
    set LHS :=
      p.support.sum (λ (f : fin n →₀ ℕ), mv_polynomial.coeff f p * as f)
      with hLHS,
    rw ← add_zero LHS,
    rw ← hLHS,
    congr,
    symmetry,
    apply finset.sum_eq_zero,
    intros f hf,
    rw finset.mem_sdiff at hf,
    cases hf with hfl hfr,
    unfold mv_polynomial.coeff,
    rw finsupp.not_mem_support_iff.1 hfr,
    exact zero_mul _,
  },
  {exact disjoint_sdiff_self_right},
end

variables (ps : poly_map A n)
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d)
  (xs ys : dvector ↥(struc_to_ring_struc.Structure A) n)

lemma eval_poly_map_xs_aux_prod
  {m} (f : fin n → ℕ)
  (coeffs : dvector ↥(struc_to_ring_struc.Structure A) (n * m)) :
  n.non_comm_prod
  (λ (i : fin n),
    (ys.append (xs.append coeffs)).nth
    (i + n) inj_formula_aux4 ^ f i) =
  finset.univ.prod (λ (i : fin n), xs.nth i i.2 ^ f i) :=
begin
  rw nat.non_comm_prod_eq_prod,
  congr,
  funext i,
  rw dvector.nth_append_big
    (nat.le_add_left n _) inj_formula_aux4,
  simp only [nat.add_sub_cancel i n],
  rw dvector.nth_append_small,
end

lemma eval_poly_map_ys_aux_prod
  {m} (f : fin n → ℕ)
  (coeffs : dvector ↥(struc_to_ring_struc.Structure A) (n * m)) :
  n.non_comm_prod
  (λ (i : fin n),
    (ys.append (xs.append coeffs)).nth
    (i + 0) inj_formula_aux3 ^ f i) =
  finset.univ.prod (λ (i : fin n), ys.nth i i.2 ^ f i) :=
begin
  rw nat.non_comm_prod_eq_prod,
  congr,
  funext i,
  simp only [add_zero],
  rw ← @dvector.nth_append_small _ _ _ ys,
end

lemma poly_map.coeffs_dvector'_nth_aux0
  (j : fin n) (f : fin n → ℕ) :
  list.index_of' f (monom_deg_le_finset n d).to_list
    + ↑j * (monom_deg_le_finset n d).to_list.length
  <
    n * (monom_deg_le n d).length :=
begin
  have h1 : (1 + ↑j) * (monom_deg_le n d).length ≤ n * (monom_deg_le n d).length,
  {
    rw [mul_le_mul_right (zero_lt_monom_deg_le_length _ _),
      nat.one_add, nat.succ_le_iff],
    exact j.2,
  },
  apply lt_of_lt_of_le _ h1,
  rw add_mul,
  apply add_lt_add_right,
  rw one_mul,
  apply list.index_of'_lt_length (zero_lt_monom_deg_le_length _ _),
end

lemma poly_map.coeffs_dvector'_nth_aux1
  {ps : poly_map A n} :
  ∀ (i : fin n),
  ((λ (i : fin n), coeffs_list_of_mv_polynomial d (ps i)) i).length
  = (monom_deg_le n d).length :=
λ i, coeffs_list_length_eq_monom_deg_le_length (ps i)

lemma poly_map.coeffs_dvector'_nth_aux2
  (j : fin n) (f : fin n → ℕ)
  (hf : f ∈ monom_deg_le n d) :
  finsupp_of_fin_dom_emb.to_fun f
  =
  (monom_deg_le₀ n d).nth_le
    (list.index_of' f (monom_deg_le_finset n d).to_list)
    (index_of_monom_deg_le₀_lt_length f) :=
begin
  rw monom_deg_le₀_nth_le (index_of_monom_deg_le_lt_length f),
  apply congr_arg,
  simp only,
  delta monom_deg_le,
  have h := @list.index_of'_nth_le _ _
    f (monom_deg_le_finset n d).to_list hf,
  funext i,
  rw ← congr_fun h i,
  congr,
end

lemma poly_map.coeffs_dvector'_nth
  {A : Type*} [comm_ring A] {n d : ℕ}
  {ps : poly_map A n} (j : fin n) (f : fin n → ℕ)
  (hf : f ∈ monom_deg_le_finset n d) :
  (ps j).to_fun (finsupp_of_fin_dom_emb f) =
    (poly_map.coeffs_dvector' d ps).nth
      (list.index_of' f (monom_deg_le_finset n d).to_list +
        ↑j * (monom_deg_le n d).length)
      (poly_map.coeffs_dvector'_nth_aux0 j f) :=
begin
  rw [poly_map.coeffs_dvector', dvector.nth_cast,
    poly_map.coeffs_dvector, dvector.nth_of_list],
  delta poly_map.coeffs_list,
  unfold_coes,
  rw list.nth_le_join_of_fn_const_length
    (λ (i : fin n), coeffs_list_of_mv_polynomial d (ps i))
    poly_map.coeffs_dvector'_nth_aux1
    j.2
    (index_of_monom_deg_le_lt_length _),
  have h :
    ((λ (i : fin n), coeffs_list_of_mv_polynomial d (ps i)) ⟨ j.1 , j.2⟩)
    =
    coeffs_list_of_mv_polynomial d (ps ⟨ j.1 , j.2 ⟩),
  {refl},
  simp only [h],
  delta coeffs_list_of_mv_polynomial,
  delta mv_polynomial.coeff,
  rw list.nth_le_map,
  have hj : (⟨ j.1, j.2 ⟩ : fin n) = j := fin.eta j j.2,
  rw [hj],
  apply congr_arg,
  have hf' : f ∈ (monom_deg_le_finset n d).to_list :=
  (finset.mem_to_list _).2 hf,
  exact poly_map.coeffs_dvector'_nth_aux2 j f hf',
  -- {exact index_of_monom_deg_le₀_lt_length _},
end

lemma eval_poly_map_xs
  [decidable_eq (mv_polynomial (fin n) A)]
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d) (j : fin n) :
  mv_polynomial.eval (λ (i : fin n), xs.nth i i.2) (ps j)
  =
  list.sumr (list.map
    (λ (f : fin n → ℕ),
       (ys.append (xs.append (poly_map.coeffs_dvector' d ps))).nth
         (list.index_of' f (monom_deg_le_finset n d).to_list +
            (j * (monom_deg_le_finset n d).to_list.length + n + n))
         (poly_indexed_by_monoms_aux0 n d _ _ inj_formula_aux0 f)
         *
         (n.non_comm_prod
           (λ (i : fin n),
             (ys.append (xs.append (poly_map.coeffs_dvector' d ps))).nth
             (i + n) inj_formula_aux4 ^ f i))
         )
    (monom_deg_le n d))
  :=
begin
  rw [mv_polynomial.eval_eq',
    mv_polynomial_sum_eq_finset_map_monom_deg_le_finset_sum (ps j) (hdeg j),
    finset.sum_map, list.sumr_eq_sum],
  delta monom_deg_le,
  rw finset.sum_to_list,
  apply finset.sum_congr rfl,
  intros f hf,
  rw eval_poly_map_xs_aux_prod xs ys f,
  congr,
  rw [mv_polynomial.coeff, dvector.nth_append_big],
  {
    rw dvector.nth_append_big,
    {
      simp only [add_assoc],
      simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list)
        (j * (monom_deg_le_finset n d).to_list.length ) (n + n))],
      simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list
        + j * (monom_deg_le_finset n d).to_list.length) n n)],
      simp only [nat.add_sub_cancel],
      exact poly_map.coeffs_dvector'_nth _ f hf,
    },
    {
      rw ← add_assoc,
      rw nat.add_sub_cancel,
      rw ← add_assoc,
      apply nat.le_add_left,
    },
  },
  {
    rw ← add_assoc,
    apply nat.le_add_left,
  },
end

lemma eval_poly_map_ys
  [decidable_eq (mv_polynomial (fin n) ↥(struc_to_ring_struc.Structure A))]
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d) (j : fin n) :
  mv_polynomial.eval (λ (i : fin n), ys.nth i i.2) (ps j)
  =
  list.sumr (list.map
    (λ (f : fin n → ℕ),
      (ys.append (xs.append (poly_map.coeffs_dvector' d ps))).nth
        (list.index_of' f (monom_deg_le_finset n d).to_list +
           (j * (monom_deg_le_finset n d).to_list.length + n + n))
        (poly_indexed_by_monoms_aux0 n d _ _ inj_formula_aux0 f)
        *
        (n.non_comm_prod
          (λ (i : fin n),
            (ys.append (xs.append (poly_map.coeffs_dvector' d ps))).nth
            (i + 0) inj_formula_aux3 ^ f i))
        )
    (monom_deg_le_finset n d).to_list)
  :=
begin
  rw mv_polynomial.eval_eq',
  -- rw ← eval_poly_map_ys_aux_prod ps xs ys,
  rw mv_polynomial_sum_eq_finset_map_monom_deg_le_finset_sum (ps j) (hdeg j),
  rw finset.sum_map,
  delta monom_deg_le,
  rw list.sumr_eq_sum,
  rw finset.sum_to_list,
  apply finset.sum_congr rfl,
  intros f hf,
  rw eval_poly_map_ys_aux_prod xs ys f,
  congr,
  rw mv_polynomial.coeff,
  rw dvector.nth_append_big,
  {
    rw dvector.nth_append_big,
    {
      simp only [add_assoc],
      simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list)
        (j * (monom_deg_le_finset n d).to_list.length ) (n + n))],
      simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list
        + j * (monom_deg_le_finset n d).to_list.length) n n)],
      simp only [nat.add_sub_cancel],
      exact poly_map.coeffs_dvector'_nth _ f hf,
    },
    {
      rw ← add_assoc,
      rw nat.add_sub_cancel,
      rw ← add_assoc,
      apply nat.le_add_left,
    },
  },
  {
    rw ← add_assoc,
    apply nat.le_add_left,
  },
end

variable [decidable_eq A]

lemma realize_inj_formula_of_ring
  {n d : ℕ}
  (ps : poly_map A n)
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d) :
  @realize_bounded_formula _ (struc_to_ring_struc.Structure A)
    _ _ (@poly_map.coeffs_dvector' A _ n d ps)
    (inj_formula n d) dvector.nil
  ↔
  function.injective ps.eval :=
begin
  -- open up the definition of inj_formula and what it means to realize it
  simp only [inj_formula,
      realize_bounded_formula_bd_alls',
      realize_bounded_formula_bd_alls',
      realize_bounded_formula_imp,
      realize_bounded_formula_bd_big_and],
  split,
    -- forward implication
  { intros hInj xs ys himage,
    set xs' : dvector (struc_to_ring_struc.Structure A) n := dvector.of_fn xs with hxs',
    set ys' : dvector (struc_to_ring_struc.Structure A) n := dvector.of_fn ys with hys',
    have hImage :  ∀ (k : fin n),
      realize_bounded_formula (ys'.append (xs'.append (poly_map.coeffs_dvector' d ps)))
        (poly_indexed_by_monoms n d (↑k * (monom_deg_le n d).length + n + n) n (n * (monom_deg_le n d).length + n + n)
             inj_formula_aux0
             inj_formula_aux2 ≃
           poly_indexed_by_monoms n d (↑k * (monom_deg_le n d).length + n + n) 0 (n * (monom_deg_le n d).length + n + n)
             inj_formula_aux0
             inj_formula_aux1)
        dvector.nil,
    { intro j,
      simp only [poly_map.eval] at himage,
      have himagej := congr_fun himage j,
      simp only [realize_bounded_formula,
        monom_deg_le, realize_poly_indexed_by_monoms],
      convert himagej,
      { convert symm (eval_poly_map_xs ps xs' ys' hdeg j),
        funext k,
        simp only [dvector.nth_of_fn, fin.eta], },
      { convert symm (eval_poly_map_ys ps xs' ys' hdeg j),
        funext k,
        simp only [dvector.nth_of_fn, fin.eta], }, },
    funext i, -- for each input (... they are equal)
    have hPreimage := hInj xs' ys' hImage i,
    simp only [realize_bounded_formula,
      realize_bounded_term,
      @dvector.nth_append_small _ _ _ ys' _ i i.2,
    dvector.nth_append_big (nat.le_add_left _ _),
    nat.add_sub_cancel,
    @dvector.nth_append_small _ _ _ xs' _ i i.2] at hPreimage,
    convert hPreimage,
    {rw [hxs', dvector.nth_of_fn, fin.eta] },
    {rw [hys', dvector.nth_of_fn, fin.eta] }, },
  -- backward implication
  { intro hinj, -- assume injectivity
    intros xs ys, -- n tuples in the domain
    -- we are showing that ps xs = ps yx implies xs = ys
    intro hImage, -- assume the images are all equal (expressed model theoretically)
    -- we must translate this to the images are equal
    -- (expressed algebraically / in the ring)
    have himage : poly_map.eval ps (λ i, dvector.nth xs i i.2)
                 = poly_map.eval ps (λ i, dvector.nth ys i i.2),
    { funext j, -- for each i < n (... the tuples at i are equal)
      simp only [poly_map.eval],
      have hImagej := hImage j,
      simp only [realize_bounded_formula,
        monom_deg_le, realize_poly_indexed_by_monoms] at hImagej,
      convert hImagej,
      {rw eval_poly_map_xs ps xs ys hdeg j, refl },
      {rw eval_poly_map_ys ps xs ys hdeg j, refl }, },
    -- by injectivity of poly_map.eval ps we have the preimages are equal (pointwise)
    intro i, -- for each input (... they are equal)
    have hpreimage : dvector.nth xs i i.2 = dvector.nth ys i i.2,
    { apply congr_fun (hinj himage) i },
    simp only [realize_bounded_formula,
      realize_bounded_term,
      @dvector.nth_append_small _ _ _ ys _ i i.2,
      dvector.nth_append_big (nat.le_add_left _ _),
      nat.add_sub_cancel,
      @dvector.nth_append_small _ _ _ xs _ i i.2,
      hpreimage], },
end

lemma realize_surj_formula_of_ring
  {n d : ℕ}
  (ps : poly_map A n)
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d) :
  (@realize_bounded_formula _ (struc_to_ring_struc.Structure A)
    _ _ (@poly_map.coeffs_dvector' A _ n d ps)
    (surj_formula n d) dvector.nil)
  ↔
  function.surjective (poly_map.eval ps)
  :=
begin
  simp only [surj_formula,
    realize_bounded_formula_bd_alls',
    realize_bounded_formula_bd_exs',
    realize_bounded_formula_bd_big_and,
    realize_bounded_formula],
  split,
{
  intros hSurj xs, -- for any n tuple xs in the codomain
  obtain ⟨ ys , hys ⟩ := hSurj (dvector.of_fn xs),
  use (dvector.nth' ys), -- there exists an n tuple ys in the domain
  funext k,
  have hysk := hys k,
  have hrw0 : realize_bounded_term
    (ys.append ((dvector.of_fn xs).append (poly_map.coeffs_dvector' d ps)))
    x_⟨ k + n , inj_formula_aux4 ⟩ dvector.nil = xs k,
  {
    simp only [realize_bounded_term, symm (fin.val_eq_coe _)],
    rw dvector.nth_append_big (nat.le_add_left _ _) _,
    rw dvector.nth_append_small,
    { simp only [nat.add_sub_cancel,
      dvector.nth_of_fn, fin.val_eq_coe, fin.eta] },
    { rw nat.add_sub_cancel, exact k.2 },
  },
  rw hrw0 at hysk,
  simp only [monom_deg_le, realize_poly_indexed_by_monoms] at hysk,
  have hrw1 := eval_poly_map_ys ps (dvector.of_fn xs) ys hdeg k,
  simpa only [symm (eq.trans hrw1 hysk), fin.val_eq_coe],
 },
 {
   intros hsurj xs,
   obtain ⟨ ys , hys ⟩ := hsurj xs.nth',
   use dvector.of_fn ys,
   intro k,
   simp only [monom_deg_le, realize_poly_indexed_by_monoms],
   have hrw1 :=
     symm (eval_poly_map_ys ps xs (dvector.of_fn ys) hdeg k),
   convert hrw1,
   simp only [realize_bounded_term, symm (fin.val_eq_coe _)],
   rw dvector.nth_append_big (nat.le_add_left _ _) _,
   rw dvector.nth_append_small,
   {
     have hysk := congr_fun hys k,
     dsimp only [poly_map.eval, dvector.nth'] at hysk, -- remove
     simp only [nat.add_sub_cancel,
       dvector.nth_of_fn, fin.val_eq_coe, fin.eta, hysk],
   },
   { rw nat.add_sub_cancel, exact k.2 },
 },
end

end injectivity_and_surjectivity_from_mv_polynomial

section injectivity_and_surjectivity_from_coeffs

variables {A : Type*} [comm_ring A]

def mv_polynomial_of_coeffs {n d : ℕ}
  (coeffs : dvector A (monom_deg_le n d).length) :
  mv_polynomial (fin n) A :=
-- sum indexed by the n-variable monom of degree < d
list.sumr
(list.map
  (
    λ f : (fin n → ℕ),
    -- each entry of the sum is a monomial f with "index-of-f-th"
    -- coefficient from "coeff"
    mv_polynomial.monomial (finsupp_of_fin_dom f)
      (coeffs.nth (list.index_of' f (monom_deg_le n d))
        (index_of_monom_deg_le_lt_length _))
  )
  (monom_deg_le n d)
)

lemma mv_polynomial_of_coeffs_deg
  [decidable_eq A]
  {n d : ℕ}
  (coeffs : dvector A (monom_deg_le n d).length) (i : fin n) :
  (mv_polynomial_of_coeffs coeffs).total_degree ≤ d :=
begin
  simp only [mv_polynomial_of_coeffs,
    list.sumr_eq_sum, monom_deg_le, finset.sum_to_list],
  apply le_trans (mv_polynomial.total_degree_sum _ _),
  work_on_goal 1 { apply_instance }, --why?
  simp only [finset.sup_le_iff],
  intros f hf,
  simp only [function.comp],
  by_cases h :
    coeffs.nth (list.index_of' f (monom_deg_le_finset n d).to_list)
      (index_of_monom_deg_le_lt_length _) = 0,
  { rw h, simp, },
  { simp only [mv_polynomial.total_degree_monomial _ h, finsupp.sum],
    simp only [monom_deg_le_finset, finset.mem_filter] at hf,
    exact hf.2 },
end

lemma realize_surj_formula_aux {n d : ℕ}
  (coeffs : dvector A (n * (monom_deg_le n d).length))
  (xs : dvector ↥(struc_to_ring_struc.Structure A) n)
  (ys : dvector ↥(struc_to_ring_struc.Structure A) n) (k : fin n) :
  realize_bounded_term
    (ys.append (xs.append coeffs))
x_⟨ k + n , inj_formula_aux4 ⟩ dvector.nil
  = xs.nth' k :=
begin
    simp only [realize_bounded_term, symm (fin.val_eq_coe _)],
    rw dvector.nth_append_big (nat.le_add_left _ _) _,
    rw dvector.nth_append_small,
    { simp only [nat.add_sub_cancel,
      dvector.nth_of_fn, fin.val_eq_coe, fin.eta, dvector.nth'] },
    { rw nat.add_sub_cancel, exact k.2 },
end

variable [decidable_eq A]

lemma filter_coeff_monomial
  {n d : ℕ} (a : (fin n → ℕ) → A)
  {f : fin n → ℕ} (hf : f ∈ monom_deg_le_finset n d) :
  (finset.filter
    (λ (x : fin n → ℕ),
      mv_polynomial.coeff (finsupp_of_fin_dom_emb f)
        (mv_polynomial.monomial (finsupp_of_fin_dom x) (a x))
        ≠ 0
    )
       (monom_deg_le_finset n d))
  = if a f = 0 then ∅ else { f }
  :=
begin
  simp only [mv_polynomial.coeff_monomial],
  by_cases hf0 : a f = 0,
  {
    simp only [if_pos hf0, finset.eq_empty_iff_forall_not_mem,
      finset.eq_singleton_iff_nonempty_unique_mem,
      finset.mem_filter, exists_prop, ite_eq_right_iff, ne.def, not_forall],
    intros x hx,
    obtain ⟨ _ , hx , hne ⟩ := hx,
    apply hne,
    rw ← hf0,
    congr,
    have hx' := congr_arg finsupp.equiv_fun_on_fintype hx,
    simp only [finsupp_of_fin_dom, finsupp_of_fin_dom_emb,
      equiv.to_embedding_apply, equiv.apply_symm_apply,
      equiv.inv_fun_as_coe] at hx',
    exact hx',
  },
  {
    simp only [if_neg hf0, finset.eq_singleton_iff_nonempty_unique_mem,
      finset.mem_filter, exists_prop, ite_eq_right_iff, ne.def, not_forall],
    split,
    {
      use f,
      simp only [finset.mem_filter],
      refine ⟨ hf , rfl , hf0 ⟩,
    },
    {
      intros x hx,
      obtain ⟨ _ , hx , _ ⟩ := hx,
      have hx' := congr_arg finsupp.equiv_fun_on_fintype hx,
      simp only [finsupp_of_fin_dom, finsupp_of_fin_dom_emb,
        equiv.to_embedding_apply, equiv.apply_symm_apply,
        equiv.inv_fun_as_coe] at hx',
      exact hx',
    },
  },
end

lemma mv_polynomial_of_coeffs_eq_nth_index_of'
  {n d : ℕ}
  (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (f : fin n → ℕ) (hf : f ∈ monom_deg_le_finset n d) (k : fin n) :
  (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs)).coeff
    (finsupp_of_fin_dom_emb f)
  =
  coeffs.nth
    (list.index_of' f (monom_deg_le_finset n d).to_list
      + ↑k * (monom_deg_le_finset n d).to_list.length)
      (poly_map.coeffs_dvector'_nth_aux0 _ _) :=
begin
  simp only [mv_polynomial_of_coeffs],
  rw mv_polynomial.finsupp_coeff_sumr,
  rw list.map_map,
  simp only [function.comp, list.sumr_eq_sum,
    monom_deg_le, finset.sum_to_list],
  rw ← finset.sum_filter_ne_zero,
  rw filter_coeff_monomial _ hf,
  by_cases h :
    (dvector.ith_chunk k coeffs).nth
      (list.index_of' f (monom_deg_le_finset n d).to_list)
      (index_of_monom_deg_le_lt_length _) = 0,
  {
    simp only [if_pos h, finset.sum_empty],
    rw dvector.ith_chunk_nth at h,
    simp only [add_comm
      (list.index_of' f (monom_deg_le_finset n d).to_list)
      (↑k * (monom_deg_le_finset n d).to_list.length)],
    convert symm h,
  },
  {
    simp only [if_neg h, finset.sum_singleton,
      mv_polynomial.coeff_monomial,
      finsupp_of_fin_dom, finsupp_of_fin_dom_emb],
    rw [dvector.ith_chunk_nth, if_pos],
    { congr1, apply add_comm },
    {refl},
  },
end

lemma eval_mv_polynomial_of_coeffs_ys0
  {n d : ℕ}
  (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (xs ys : dvector ↥(struc_to_ring_struc.Structure A) n) (k : fin n) :
  mv_polynomial.eval ys.nth' (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs))
  =
  list.sumr (list.map
    (λ (f : fin n → ℕ),
      (ys.append (xs.append coeffs)).nth
        (list.index_of' f (monom_deg_le_finset n d).to_list +
           (k * (monom_deg_le_finset n d).to_list.length + n + n))
        (poly_indexed_by_monoms_aux0 n d _ _ inj_formula_aux0 f)
        *
        (n.non_comm_prod
          (λ (i : fin n),
            (ys.append (xs.append coeffs)).nth
            (i + 0) inj_formula_aux3 ^ f i))
        )
    (monom_deg_le_finset n d).to_list)
  :=
begin
  rw mv_polynomial.eval_eq',
  rw mv_polynomial_sum_eq_finset_map_monom_deg_le_finset_sum _
    (mv_polynomial_of_coeffs_deg (dvector.ith_chunk k coeffs) k),
  rw finset.sum_map,
  delta monom_deg_le,
  rw list.sumr_eq_sum,
  rw finset.sum_to_list,
  apply finset.sum_congr rfl,
  intros f hf,
  rw eval_poly_map_ys_aux_prod xs ys f,
  congr,
  rw dvector.nth_append_big,
  {
     rw dvector.nth_append_big,
     {
       simp only [add_assoc],
       simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list)
        (k * (monom_deg_le_finset n d).to_list.length ) (n + n))],
      simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list
        + k * (monom_deg_le_finset n d).to_list.length) n n)],
      simp only [nat.add_sub_cancel],
      rw mv_polynomial_of_coeffs_eq_nth_index_of' _ _ hf,
      refl,
      {apply_instance}, --why???
     },
     {
      rw ← add_assoc,
      rw nat.add_sub_cancel,
      rw ← add_assoc,
      apply nat.le_add_left,
    },
  },
  {
    rw ← add_assoc,
    apply nat.le_add_left,
  },
end

lemma eval_mv_polynomial_of_coeffs_xs0
  {n d : ℕ}
  (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (xs ys : dvector ↥(struc_to_ring_struc.Structure A) n) (k : fin n) :
  mv_polynomial.eval xs.nth' (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs))
  =
  list.sumr (list.map
    (λ (f : fin n → ℕ),
      (ys.append (xs.append coeffs)).nth
        (list.index_of' f (monom_deg_le_finset n d).to_list +
           (k * (monom_deg_le_finset n d).to_list.length + n + n))
        (poly_indexed_by_monoms_aux0 n d _ _ inj_formula_aux0 f)
        *
        (n.non_comm_prod
          (λ (i : fin n),
            (ys.append (xs.append coeffs)).nth
            (i + n) inj_formula_aux4 ^ f i))
        )
    (monom_deg_le_finset n d).to_list)
  :=
begin
  rw mv_polynomial.eval_eq',
  rw mv_polynomial_sum_eq_finset_map_monom_deg_le_finset_sum _
    (mv_polynomial_of_coeffs_deg (dvector.ith_chunk k coeffs) k),
  rw finset.sum_map,
  delta monom_deg_le,
  rw list.sumr_eq_sum,
  rw finset.sum_to_list,
  apply finset.sum_congr rfl,
  intros f hf,
  rw eval_poly_map_xs_aux_prod xs ys f,
  congr,
  rw dvector.nth_append_big,
  {
     rw dvector.nth_append_big,
     {
       simp only [add_assoc],
       simp only [symm (add_assoc
         (list.index_of' f (monom_deg_le_finset n d).to_list)
         (k * (monom_deg_le_finset n d).to_list.length ) (n + n))],
      simp only [symm (add_assoc
        (list.index_of' f (monom_deg_le_finset n d).to_list
        + k * (monom_deg_le_finset n d).to_list.length) n n)],
      simp only [nat.add_sub_cancel],
      rw mv_polynomial_of_coeffs_eq_nth_index_of' _ _ hf,
      refl,
      {apply_instance}, --why???
     },
     {
      rw ← add_assoc,
      rw nat.add_sub_cancel,
      rw ← add_assoc,
      apply nat.le_add_left,
    },
  },
  {
    rw ← add_assoc,
    apply nat.le_add_left,
  },
end

lemma eval_mv_polynomial_of_coeffs_ys1
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (xs : fin n → A)
  (ys : dvector ↥(struc_to_ring_struc.Structure A) n) (k : fin n) :
  mv_polynomial.eval ys.nth'
    (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs))
  =
  realize_bounded_term (ys.append ((dvector.of_fn xs).append coeffs))
    (poly_indexed_by_monoms n d
      (↑k * (monom_deg_le n d).length + n + n) 0
      (n * (monom_deg_le n d).length + n + n)
         inj_formula_aux0
         inj_formula_aux1)
      dvector.nil :=
by simpa only [realize_poly_indexed_by_monoms,
    eval_mv_polynomial_of_coeffs_ys0 _ (dvector.of_fn xs),
    monom_deg_le]

lemma eval_mv_polynomial_of_coeffs_xs1
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (xs : fin n → A)
  (ys : dvector ↥(struc_to_ring_struc.Structure A) n) (k : fin n) :
  (mv_polynomial.eval xs) (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs))
  =
  realize_bounded_term (ys.append ((dvector.of_fn xs).append coeffs))
    (poly_indexed_by_monoms n d
      (↑k * (monom_deg_le n d).length + n + n) n
      (n * (monom_deg_le n d).length + n + n)
         inj_formula_aux0
         inj_formula_aux2)
      dvector.nil :=
begin
  rw ← dvector.nth'_of_fn1 xs,
  simp only [realize_poly_indexed_by_monoms,
    eval_mv_polynomial_of_coeffs_xs0 _ (dvector.of_fn xs) ys,
    monom_deg_le],
  simpa only [dvector.nth'_of_fn1],
end

lemma eval_mv_polynomial_of_coeffs_ys2
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (xs : dvector (struc_to_ring_struc.Structure A) n)
  (ys : fin n → (struc_to_ring_struc.Structure A)) (k : fin n) :
  (mv_polynomial.eval ys) (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs))
  =
  realize_bounded_term ((dvector.of_fn ys).append (xs.append coeffs))
      (poly_indexed_by_monoms n d (↑k * (monom_deg_le n d).length + n + n) 0 (n * (monom_deg_le n d).length + n + n)
         inj_formula_aux0
         inj_formula_aux1)
      dvector.nil :=
begin
  simp only [realize_poly_indexed_by_monoms, monom_deg_le],
  convert eval_mv_polynomial_of_coeffs_ys0 coeffs xs (dvector.of_fn ys) k,
  funext,
  rw dvector.nth'_of_fn,
end

lemma realize_inj_formula_of_model
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length)) :
  function.injective
    (poly_map.eval (λ i : fin n, mv_polynomial_of_coeffs (dvector.ith_chunk i coeffs)))
  ↔
  realize_bounded_formula coeffs (inj_formula n d) dvector.nil
  :=
begin
  simp only [inj_formula,
      realize_bounded_formula_bd_alls',
      realize_bounded_formula_bd_big_and,
      realize_bounded_formula],
  split,
  {
    intros hinj xs ys hImage k,
    have himage :
    poly_map.eval
      (λ i : fin n, mv_polynomial_of_coeffs (dvector.ith_chunk i coeffs))
      (λ i, dvector.nth xs i i.2)
    =
    poly_map.eval
      (λ i : fin n, mv_polynomial_of_coeffs (dvector.ith_chunk i coeffs))
      (λ i, dvector.nth ys i i.2),
   {
     funext j,
     convert hImage j,
     { simpa only [poly_map.eval, dvector.nth'_eq,
         eval_mv_polynomial_of_coeffs_xs0 coeffs xs ys j,
         realize_poly_indexed_by_monoms,
         monom_deg_le] },
     { simpa only [poly_map.eval, dvector.nth'_eq,
         eval_mv_polynomial_of_coeffs_ys0 coeffs xs ys j,
         realize_poly_indexed_by_monoms,
         monom_deg_le] },
   },
   have hpreimage := congr_fun (hinj himage) k,
   simp only [realize_bounded_term,
     @dvector.nth_append_small _ _ _ ys _ k k.2,
     dvector.nth_append_big (nat.le_add_left _ _),
     nat.add_sub_cancel,
     @dvector.nth_append_small _ _ _ xs _ k k.2],
   exact hpreimage,
  },
  {
    intros hInj xs ys himage,
    set ys' := dvector.of_fn ys with hys,
    set xs' := dvector.of_fn xs with hxs,
    have hImage : ∀ (k : fin n),
      realize_bounded_term (ys'.append (xs'.append coeffs))
        (poly_indexed_by_monoms n d (k * (monom_deg_le n d).length + n + n) n
          (n * (monom_deg_le n d).length + n + n)
          inj_formula_aux0
          inj_formula_aux2)
        dvector.nil =
      realize_bounded_term (ys'.append (xs'.append coeffs))
        (poly_indexed_by_monoms n d (k * (monom_deg_le n d).length + n + n) 0
          (n * (monom_deg_le n d).length + n + n)
          inj_formula_aux0
          inj_formula_aux1)
        dvector.nil,
    {
      intro j,
      convert congr_fun himage j,
     { simp only [poly_map.eval, dvector.nth'_eq,
         eval_mv_polynomial_of_coeffs_xs1 coeffs xs ys' j,
         realize_poly_indexed_by_monoms,
         monom_deg_le] },
     {
       simp only [poly_map.eval, dvector.nth'_eq,
         eval_mv_polynomial_of_coeffs_ys2 coeffs xs' ys j,
         realize_poly_indexed_by_monoms,
         monom_deg_le] },
    },
    funext k,
    have hPreimage := hInj xs' ys' hImage k,
    simp only [realize_bounded_term,
      @dvector.nth_append_small _ _ _ ys' _ k k.2,
      dvector.nth_append_big (nat.le_add_left _ _),
      nat.add_sub_cancel,
      @dvector.nth_append_small _ _ _ xs' _ k k.2,
      hys, hxs, dvector.nth_of_fn] at hPreimage,
    convert hPreimage,
    repeat {rw fin.eta k},
  },
end

lemma realize_surj_formula_of_model
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length)) :
  function.surjective
    (poly_map.eval (λ i : fin n, mv_polynomial_of_coeffs (dvector.ith_chunk i coeffs)))
  ↔
  realize_bounded_formula coeffs (surj_formula n d) dvector.nil
  :=
begin
  simp only [surj_formula,
      realize_bounded_formula_bd_alls',
      realize_bounded_formula_bd_exs',
      realize_bounded_formula_bd_big_and,
      realize_bounded_formula],
  split,
  {
    intros hsurj xs,
    obtain ⟨ ys , hys ⟩ := hsurj (dvector.nth' xs),
    refine ⟨ dvector.of_fn ys , _ ⟩,
    intro k,
    have hysk := congr_fun hys k,
    simp only [poly_map.eval] at hysk,
    rw realize_surj_formula_aux coeffs,
    convert hysk,
    rw eval_mv_polynomial_of_coeffs_ys2,
  },
  {
    intros hSurj xs,
    obtain ⟨ ys , hys ⟩ := hSurj (dvector.of_fn xs),
    refine ⟨ ys.nth' , _ ⟩,
    funext k,
    have hysk := hys k,
    simp only [poly_map.eval],
    simp only [realize_surj_formula_aux coeffs (dvector.of_fn xs) ys k,
      dvector.nth'_of_fn] at hysk,
    convert hysk,
    rw [eval_mv_polynomial_of_coeffs_ys1],
  },
end

end injectivity_and_surjectivity_from_coeffs

section max_total_deg

variables {K : Type*} [comm_semiring K]

@[simp] def max_total_deg :
  Π {n m : ℕ}, (fin n → mv_polynomial (fin m) K) → ℕ
| 0 _ ps := 0
| (n + 1) _ ps :=
  max (max_total_deg (λ (i : fin n), ps i)) (mv_polynomial.total_degree (ps n))

def total_deg_le_max_total_deg :
  Π {n m : ℕ} (ps : fin n → mv_polynomial (fin m) K) (i : fin n),
  mv_polynomial.total_degree (ps i) ≤ max_total_deg ps
| 0 _ ps i := fin_zero_elim i
| (n + 1) _ ps i :=
begin
  simp only [max_total_deg],
  rw le_max_iff,
  cases fin.lt_or_eq_fin i with h,
  {
    left,
    have hlt : (i : ℕ) < n,
    {
      rw fin.lt_coe_iff_val_lt i (nat.lt_succ_self _),
      exact h,
    },
    have hind :=
    @total_deg_le_max_total_deg n _ (λ j, ps j.val.cast) ⟨ i , hlt ⟩,
    simp only [fin.coe_eq_cast_succ, fin.cast_succ_mk, fin.eta] at hind,
    rw ← fin.coe_coe_eq_self i,
    exact hind,
  },
  {
    right,
    rw h,
  },
end

end max_total_deg

section alg_closed_field
open classical
local attribute [instance] prop_decidable

variables {K : Type*} [field K] [is_alg_closed K]

open Rings.struc_to_ring_struc

theorem realize_Ax_Groth_formula {n : ℕ} :
  (∀ d : ℕ, Structure K ⊨ Ax_Groth_formula n d)
  ↔
  (∀ (ps : poly_map K n),
    function.injective (poly_map.eval ps) → function.surjective (poly_map.eval ps)) :=
begin
  split,
  { intros H ps,
    rw ← realize_surj_formula_of_ring ps (total_deg_le_max_total_deg ps),
    rw ← realize_inj_formula_of_ring ps (total_deg_le_max_total_deg ps),
    simp only [realize_sentence_bd_alls, Ax_Groth_formula] at H,
    apply H (max_total_deg ps), },
  { intros H d,
    simp only [Ax_Groth_formula, realize_sentence_bd_alls],
    intro coeffs,
    simp only [realize_bounded_formula_imp, ← realize_surj_formula_of_model],
    intro hinj,
    apply H,
    rw realize_inj_formula_of_model,
    exact hinj, },
end

-- lemma realize_Ax_Groth_formula_of_char_p
--   {p : ℕ} (hprime : nat.prime p) (hchar : char_p K p) (n d : ℕ) :
--   Structure K ⊨ Ax_Groth_formula n d :=
-- realize_Ax_Groth_formula.mpr (Ax_Groth_of_locally_finite hprime hchar) d

open Fields

-- Credit to Chris Hughes
/-- Any injective polynomial map over an algerbaically closed field of char p is surjective -/
lemma Ax_Groth_of_locally_finite (K₀ : Type*) {K : Type*} [field K₀] [fintype K₀] [comm_ring K]
  [algebra K₀ K] (alg : algebra.is_algebraic K₀ K)
  (n) (ps : poly_map K n) (hinj : function.injective (poly_map.eval ps)) :
  function.surjective (poly_map.eval ps) :=
begin
  have is_int : ∀ x : K, is_integral K₀ x,
    from λ x, is_algebraic_iff_is_integral.1 (alg x),
  classical,
  intros v,
  let s : finset K :=
    finset.bUnion (finset.univ : finset (fin n))
      (λ i, (ps i).support.image (λ x, mv_polynomial.coeff x (ps i)))
    ∪ (finset.univ : finset (fin n)).image v,
  have hs₁ : ∀ (i : fin n),
    (finset.image (λ (x : fin n →₀ ℕ), mv_polynomial.coeff x (ps i)) (ps i).support : set K) ⊆
      subsemiring.closure (s : set K),
    from λ j x hx, subsemiring.subset_closure
      (finset.mem_union_left _
        (finset.mem_bUnion.2 ⟨j, finset.mem_univ _, hx⟩)),
  have hv₁ : ∀ i, v i ∈ subsemiring.closure (s : set K),
    from λ j, subsemiring.subset_closure
        (finset.mem_union_right _
          (finset.mem_image.2 ⟨j, finset.mem_univ _, rfl⟩)),
  have hs : ∀ i, poly_map.eval ps v i ∈ subsemiring.closure (s : set K),
    from poly_map.eval_mem ps _ hs₁ v hv₁,
  letI : fintype (subsemiring.closure (s : set K)),
  { letI := is_noetherian_adjoin_finset s (λ x _, is_int x),
    letI := module.is_noetherian.finite K₀ (algebra.adjoin K₀ (s : set K)),
    have alg_fintype := finite_dimensional.fintype_of_fintype
      K₀ (algebra.adjoin K₀ (s : set K)),
    have hsubset : subsemiring.closure (s : set K) ≤
      (algebra.adjoin K₀ (s : set K)).to_subsemiring,
      from subsemiring.closure_le.2
        (galois_connection.le_u_l algebra.gc _),
    exact (set.finite.subset ⟨alg_fintype⟩ hsubset).fintype },
  let res : (fin n → subsemiring.closure (s : set K)) →
      (fin n → subsemiring.closure (s : set K)) :=
    λ x i, ⟨poly_map.eval ps (λ j, (x j)) i, poly_map.eval_mem _ _ hs₁ _ (λ j, (x j).2) _⟩,
  have hres_inj : function.injective res,
  { intros x y hxy,
    funext i,
    ext,
    simp only [res, subtype.ext_iff, function.funext_iff] at hxy,
    exact congr_fun (hinj (funext hxy)) i },
  have hres_surj : function.surjective res,
    from fintype.injective_iff_surjective.1 hres_inj,
  cases hres_surj (λ i, ⟨v i, hv₁ i⟩) with w hw,
  use λ i, w i,
  simp only [res, subtype.ext_iff, function.funext_iff] at hw,
  exact funext hw
end

lemma Ax_Groth_algebraic_closure_zmod (p : ℕ) [hp : fact (nat.prime p)] {n} :
  ∀ (ps : poly_map (algebraic_closure.of_ulift_zmod.{u} p) n),
    function.injective (poly_map.eval ps) → function.surjective (poly_map.eval ps) :=
Ax_Groth_of_locally_finite (ulift.{u} (zmod p))
    (algebraic_closure.is_algebraic (ulift.{u} (zmod p))) n

/-- Ax_Groth_formula is true in ACFₚ, corollary of Lefschetz part 1. (ACFₚ is_complete')-/
lemma ACFₚ_ssatisfied_Ax_Groth_formula {p : ℕ} [hp : fact p.prime] (n : ℕ) :
  ∀ d, (ACFₚ hp.1) ⊨ Ax_Groth_formula n d :=
begin
  have h : ∀ d, (instances.algebraic_closure_of_zmod hp.1) ⊨ Ax_Groth_formula n d,
  { rw realize_Ax_Groth_formula,
    exact Ax_Groth_algebraic_closure_zmod p },
  intro d,
  exact Lefschetz.is_complete''_ACFₚ hp.1
    (instances.algebraic_closure_of_zmod hp.1) ⟨ 0 ⟩ (Ax_Groth_formula n d)
    (instances.algebraic_closure_of_zmod_models_ACFₚ hp.1) (h d),
end

/-- Ax_Groth_formula is true in ACF₀, corollary of Lefschetz part 3. and char_p case -/
lemma ACF₀_ssatisfied_Ax_Groth_formula (n d : ℕ) :
  ACF₀ ⊨ Ax_Groth_formula n d :=
begin
  rw Lefschetz.characteristic_change,
  use 0,
  intros p hp _,
  haveI : fact p.prime := ⟨ hp ⟩,
  apply ACFₚ_ssatisfied_Ax_Groth_formula,
end

/-- The main result: algebraically closed fields of characteristic zero
   satisfy Ax-Grothendieck formula; follows from soundness -/
lemma realize_Ax_Groth_formula_of_char_zero
  (h0 : char_zero K) (n d : ℕ) :
  Rings.struc_to_ring_struc.Structure K ⊨ Ax_Groth_formula n d :=
@ACF₀_ssatisfied_Ax_Groth_formula n d (Structure K) ⟨ 0 ⟩
    is_alg_closed_to.realize_ACF₀

/-- We also get the statement for all char_p fields, not just the locally finite ones -/
lemma realize_Ax_Groth_formula_of_char_p
  (hchar : (ring_char K).prime) (n d : ℕ) :
  Rings.struc_to_ring_struc.Structure K ⊨ Ax_Groth_formula n d :=
begin
  apply @ACFₚ_ssatisfied_Ax_Groth_formula (ring_char K) ⟨ hchar ⟩ n d (Structure K) ⟨ 0 ⟩,
  haveI : fact (Structure K ⊨ Fields.ACF) := ⟨ is_alg_closed_to.realize_ACF ⟩,
  rw Fields.models_ACFₚ_iff,
  rw char_p.ring_char_of_prime_eq_zero hchar,
  have h : ∀ n : ℕ, (n : K) = 0 ↔ (n : Structure K) = 0,
  { intro n, induction n with n hn, repeat { simp } },
  rw ← h,
  { rw ring_char.spec },
  { apply_instance },
end

private lemma Ax_Groth_char_p (hchar : (ring_char K).prime) {n : ℕ} {ps : poly_map K n} :
  function.injective (poly_map.eval ps) → function.surjective (poly_map.eval ps) :=
realize_Ax_Groth_formula.mp (realize_Ax_Groth_formula_of_char_p hchar _) _

private lemma Ax_Groth_char_zero (h0 : char_zero K) {n : ℕ} {ps : poly_map K n} :
  function.injective (poly_map.eval ps) → function.surjective (poly_map.eval ps) :=
realize_Ax_Groth_formula.mp (realize_Ax_Groth_formula_of_char_zero h0 _) _

/-- The main result: injective polynomial maps on algebraically closed fields are surjective -/
theorem Ax_Groth {n : ℕ} {ps : poly_map K n} :
  function.injective (poly_map.eval ps) → function.surjective (poly_map.eval ps) :=
begin
  rcases char_p.char_is_prime_or_zero K (ring_char K) with hp | hp,
  { exact Ax_Groth_char_p hp },
  { apply Ax_Groth_char_zero,
    rw ring_char.eq_iff at hp,
    apply @char_p.char_p_to_char_zero _ _ hp },
end

end alg_closed_field
end AxGroth


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

Suppose we have a list `l` in a type `α`.  Suppose we also have a
subset `s` of `α`, formalised in the usual way as a term of type
`set α`, or equivalently a predicate `α → Prop`.  Associated to
this we have a subtype `s' = {a : α // a ∈ s}`, and coercions
have been defined so that Lean will interpret `s` as `s'` where
necessary.  If all elements of `l` satisfy the predicate defining
`s`, then a mathematician would say that `l` can be regarded as
an element of `list s`.  In Lean we still have a corresponding term
`l'` of type `s`, but it is not literally the same as `l`.  This
story is not just relevant for lists; there are similar
considerations for pairs, finsets, elements of the free group and
so on.

In this file we use the notation `qualify h l` for `l'`, where
`h` is a proof that the elements of `l` satisfy the relevant
predicate.  We prove various basic lemmas about this operation
and its inverse.  We have tried to write things in a way that
could be smoothly generalised to functors other than `list`,
but there should probably be some apparatus of type classes
which we have not yet set up.  Also, Mario has suggested that
`cod_restrict` would be a better name than `qualify`, for
compatibility with some existing code.
-/

import data.list.basic
import data.list.nodup

variables {α : Type*}

namespace list
open list

def qualify {s : set α} (l : list α) (h : ∀ {a}, a ∈ l → s a) : list s :=
 pmap subtype.mk l @h

lemma length_qualify {s : set α} (l : list α) (h : ∀ {a}, a ∈ l → s a) :
 (qualify l @h).length = l.length := length_pmap

def unqualify {s : set α} (l : list s) : list α := l.map subtype.val

@[simp]
lemma unqualify_nil {s : set α} : unqualify (@nil s) = nil := rfl

@[simp]
lemma unqualify_cons {s : set α} (a : s) (l : list s) :
 unqualify (a :: l) = a.val :: (unqualify l) := rfl

lemma unqualify_eq {s : set α} {l₁ l₂ : list s} :
 l₁ = l₂ ↔ (unqualify l₁ = unqualify l₂) :=
begin
 split,
 {exact congr_arg unqualify,},
 {induction l₁ with x₁ l₁ ih generalizing l₂,
  {rw[unqualify_nil],
   rcases l₂ with _ | ⟨x₂,l₂⟩,
   {intro,refl},
   {rw[unqualify_cons],intro eu,exact false.elim (list.no_confusion eu)}
  },{
   rw[unqualify_cons],
   rcases l₂ with _ | ⟨x₂,l₂⟩,
   {intro eu,exact false.elim (list.no_confusion eu)},
   {rw[unqualify_cons],intro eu,injection eu with euh eut,congr,
    exact subtype.eq euh,exact ih eut,
   }
  }
 }
end

@[simp]
lemma length_unqualify {s : set α} (l : list s) : (unqualify l).length = l.length :=
 length_map subtype.val l

lemma mem_unqualify {s : set α} {l : list s} {a : α} :
 a ∈ unqualify l ↔ (∃ h : s a, subtype.mk a h ∈ l) :=
begin
 rcases (@mem_map s α subtype.val a l) with ⟨h0,h1⟩,
 split,
 {intro h2,rcases h0 h2 with ⟨⟨a,a_in_s⟩,⟨a_in_l,rfl⟩⟩,exact ⟨a_in_s,a_in_l⟩ },
 {rintro ⟨a_in_s,a_in_l⟩,exact h1 ⟨⟨a,a_in_s⟩,⟨a_in_l,rfl⟩⟩}
end

lemma mem_unqualify' {s : set α} {l : list s} {a : s} :
 a.val ∈ unqualify l ↔ a ∈ l :=
begin
 split,
 {intro h0,
  rcases (mem_unqualify.mp h0) with ⟨a_in_s,a_in_l⟩ ,
  have h1 : a = ⟨a.val,a_in_s⟩ := subtype.eq rfl,
  rw[h1],exact a_in_l,
  },
  {intro h0,exact mem_map_of_mem _ h0,}
end

@[simp]
lemma un_qualify {s : set α} (l : list α) (h : ∀ {a}, a ∈ l → s a) :
 unqualify (qualify l @h) = l :=
begin
 dsimp[qualify],
 induction l with x l ih,
 {refl},
 {rw[unqualify,pmap,map],congr,
  exact ih (λ a a_in_l, h (mem_cons_of_mem x a_in_l)),
 }
end

def requalify {s t : set α} (l : list s) (h : ∀ {u : s}, u ∈ l → t u) : list t :=
 qualify (unqualify l)
  (λ a a_in_l,
   begin rcases (mem_unqualify.mp a_in_l) with ⟨a_in_s,a_in_l⟩, exact h a_in_l, end )

@[simp]
lemma un_requalify {s t : set α} (l : list s) (h : ∀ {u : s}, u ∈ l → t u) :
 unqualify (requalify l @h) = unqualify l :=
begin
 dsimp[requalify],rw[un_qualify]
end

lemma nodup_unqualify {s : set α} : ∀ {l : list s}, (unqualify l).nodup ↔ l.nodup
| [] := by { rw[unqualify_nil],simp only [nodup_nil], }
| (a :: l) := begin
   rw[unqualify_cons,nodup_cons,nodup_cons,nodup_unqualify,@mem_unqualify' α s l a],
  end

lemma nodup_qualify {s : set α} (l : list α) (h : ∀ {a}, a ∈ l → s a) :
 (qualify l @h).nodup ↔ l.nodup := by { rw[← nodup_unqualify,un_qualify], }

end list