/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import tactic.tfae
import order.atoms
import order.order_iso_nat
import order.sup_indep
import order.zorn
import data.finset.order

/-!
# Compactness properties for complete lattices

For complete lattices, there are numerous equivalent ways to express the fact that the relation `>`
is well-founded. In this file we define three especially-useful characterisations and provide
proofs that they are indeed equivalent to well-foundedness.

## Main definitions
 * `complete_lattice.is_sup_closed_compact`
 * `complete_lattice.is_Sup_finite_compact`
 * `complete_lattice.is_compact_element`
 * `complete_lattice.is_compactly_generated`

## Main results
The main result is that the following four conditions are equivalent for a complete lattice:
 * `well_founded (>)`
 * `complete_lattice.is_sup_closed_compact`
 * `complete_lattice.is_Sup_finite_compact`
 * `∀ k, complete_lattice.is_compact_element k`

This is demonstrated by means of the following four lemmas:
 * `complete_lattice.well_founded.is_Sup_finite_compact`
 * `complete_lattice.is_Sup_finite_compact.is_sup_closed_compact`
 * `complete_lattice.is_sup_closed_compact.well_founded`
 * `complete_lattice.is_Sup_finite_compact_iff_all_elements_compact`

 We also show well-founded lattices are compactly generated
 (`complete_lattice.compactly_generated_of_well_founded`).

## References
- [G. Călugăreanu, *Lattice Concepts of Module Theory*][calugareanu]

## Tags

complete lattice, well-founded, compact
-/

variables {α : Type*} [complete_lattice α]

namespace complete_lattice

variables (α)

/-- A compactness property for a complete lattice is that any `sup`-closed non-empty subset
contains its `Sup`. -/
def is_sup_closed_compact : Prop :=
  ∀ (s : set α) (h : s.nonempty), (∀ a b ∈ s, a ⊔ b ∈ s) → (Sup s) ∈ s

/-- A compactness property for a complete lattice is that any subset has a finite subset with the
same `Sup`. -/
def is_Sup_finite_compact : Prop :=
∀ (s : set α), ∃ (t : finset α), ↑t ⊆ s ∧ Sup s = t.sup id

/-- An element `k` of a complete lattice is said to be compact if any set with `Sup`
above `k` has a finite subset with `Sup` above `k`.  Such an element is also called
"finite" or "S-compact". -/
def is_compact_element {α : Type*} [complete_lattice α] (k : α) :=
∀ s : set α, k ≤ Sup s → ∃ t : finset α, ↑t ⊆ s ∧ k ≤ t.sup id

/-- An element `k` is compact if and only if any directed set with `Sup` above
`k` already got above `k` at some point in the set. -/
theorem is_compact_element_iff_le_of_directed_Sup_le (k : α) :
  is_compact_element k ↔
  ∀ s : set α, s.nonempty → directed_on (≤) s → k ≤ Sup s → ∃ x : α, x ∈ s ∧ k ≤ x :=
begin
  classical,
  split,
  { intros hk s hne hdir hsup,
    obtain ⟨t, ht⟩ := hk s hsup,
    -- certainly every element of t is below something in s, since ↑t ⊆ s.
    have t_below_s : ∀ x ∈ t, ∃ y ∈ s, x ≤ y, from λ x hxt, ⟨x, ht.left hxt, le_rfl⟩,
    obtain ⟨x, ⟨hxs, hsupx⟩⟩ := finset.sup_le_of_le_directed s hne hdir t t_below_s,
    exact ⟨x, ⟨hxs, le_trans ht.right hsupx⟩⟩, },
  { intros hk s hsup,
    -- Consider the set of finite joins of elements of the (plain) set s.
    let S : set α := { x | ∃ t : finset α, ↑t ⊆ s ∧ x = t.sup id },
    -- S is directed, nonempty, and still has sup above k.
    have dir_US : directed_on (≤) S,
    { rintros x ⟨c, hc⟩ y ⟨d, hd⟩,
      use x ⊔ y,
      split,
      { use c ∪ d,
        split,
        { simp only [hc.left, hd.left, set.union_subset_iff, finset.coe_union, and_self], },
        { simp only [hc.right, hd.right, finset.sup_union], }, },
      simp only [and_self, le_sup_left, le_sup_right], },
    have sup_S : Sup s ≤ Sup S,
    { apply Sup_le_Sup,
      intros x hx, use {x},
      simpa only [and_true, id.def, finset.coe_singleton, eq_self_iff_true, finset.sup_singleton,
        set.singleton_subset_iff], },
    have Sne : S.nonempty,
    { suffices : ⊥ ∈ S, from set.nonempty_of_mem this,
      use ∅,
      simp only [set.empty_subset, finset.coe_empty, finset.sup_empty,
        eq_self_iff_true, and_self], },
    -- Now apply the defn of compact and finish.
    obtain ⟨j, ⟨hjS, hjk⟩⟩ := hk S Sne dir_US (le_trans hsup sup_S),
    obtain ⟨t, ⟨htS, htsup⟩⟩ := hjS,
    use t, exact ⟨htS, by rwa ←htsup⟩, },
end

/-- A compact element `k` has the property that any directed set lying strictly below `k` has
its Sup strictly below `k`. -/
lemma is_compact_element.directed_Sup_lt_of_lt {α : Type*} [complete_lattice α] {k : α}
  (hk : is_compact_element k) {s : set α} (hemp : s.nonempty) (hdir : directed_on (≤) s)
  (hbelow : ∀ x ∈ s, x < k) : Sup s < k :=
begin
  rw is_compact_element_iff_le_of_directed_Sup_le at hk,
  by_contradiction,
  have sSup : Sup s ≤ k, from Sup_le (λ s hs, (hbelow s hs).le),
  replace sSup : Sup s = k := eq_iff_le_not_lt.mpr ⟨sSup, h⟩,
  obtain ⟨x, hxs, hkx⟩ := hk s hemp hdir sSup.symm.le,
  obtain hxk := hbelow x hxs,
  exact hxk.ne (hxk.le.antisymm hkx),
end

lemma finset_sup_compact_of_compact {α β : Type*} [complete_lattice α] {f : β → α}
  (s : finset β) (h : ∀ x ∈ s, is_compact_element (f x)) : is_compact_element (s.sup f) :=
begin
  classical,
  rw is_compact_element_iff_le_of_directed_Sup_le,
  intros d hemp hdir hsup,
  change f with id ∘ f, rw ←finset.sup_finset_image,
  apply finset.sup_le_of_le_directed d hemp hdir,
  rintros x hx,
  obtain ⟨p, ⟨hps, rfl⟩⟩ := finset.mem_image.mp hx,
  specialize h p hps,
  rw is_compact_element_iff_le_of_directed_Sup_le at h,
  specialize h d hemp hdir (le_trans (finset.le_sup hps) hsup),
  simpa only [exists_prop],
end

lemma well_founded.is_Sup_finite_compact (h : well_founded ((>) : α → α → Prop)) :
  is_Sup_finite_compact α :=
begin
  intros s,
  let p : set α := { x | ∃ (t : finset α), ↑t ⊆ s ∧ t.sup id = x },
  have hp : p.nonempty, { use [⊥, ∅], simp, },
  obtain ⟨m, ⟨t, ⟨ht₁, ht₂⟩⟩, hm⟩ := well_founded.well_founded_iff_has_max'.mp h p hp,
  use t, simp only [ht₁, ht₂, true_and], apply le_antisymm,
  { apply Sup_le, intros y hy, classical,
    have hy' : (insert y t).sup id ∈ p,
    { use insert y t, simp, rw set.insert_subset, exact ⟨hy, ht₁⟩, },
    have hm' : m ≤ (insert y t).sup id, { rw ← ht₂, exact finset.sup_mono (t.subset_insert y), },
    rw ← hm _ hy' hm', simp, },
  { rw [← ht₂, finset.sup_id_eq_Sup], exact Sup_le_Sup ht₁, },
end

lemma is_Sup_finite_compact.is_sup_closed_compact (h : is_Sup_finite_compact α) :
  is_sup_closed_compact α :=
begin
  intros s hne hsc, obtain ⟨t, ht₁, ht₂⟩ := h s, clear h,
  cases t.eq_empty_or_nonempty with h h,
  { subst h, rw finset.sup_empty at ht₂, rw ht₂,
    simp [eq_singleton_bot_of_Sup_eq_bot_of_nonempty ht₂ hne], },
  { rw ht₂, exact t.sup_closed_of_sup_closed h ht₁ hsc, },
end

lemma is_sup_closed_compact.well_founded (h : is_sup_closed_compact α) :
  well_founded ((>) : α → α → Prop) :=
begin
  refine rel_embedding.well_founded_iff_no_descending_seq.mpr ⟨λ a, _⟩,
  suffices : Sup (set.range a) ∈ set.range a,
  { obtain ⟨n, hn⟩ := set.mem_range.mp this,
    have h' : Sup (set.range a) < a (n+1), { change _ > _, simp [← hn, a.map_rel_iff], },
    apply lt_irrefl (a (n+1)), apply lt_of_le_of_lt _ h', apply le_Sup, apply set.mem_range_self, },
  apply h (set.range a),
  { use a 37, apply set.mem_range_self, },
  { rintros x ⟨m, hm⟩ y ⟨n, hn⟩, use m ⊔ n, rw [← hm, ← hn], apply rel_hom_class.map_sup a, },
end

lemma is_Sup_finite_compact_iff_all_elements_compact :
  is_Sup_finite_compact α ↔ (∀ k : α, is_compact_element k) :=
begin
  refine ⟨λ h k s hs, _, λ h s, _⟩,
  { obtain ⟨t, ⟨hts, htsup⟩⟩ := h s,
    use [t, hts],
    rwa ←htsup, },
  { obtain ⟨t, ⟨hts, htsup⟩⟩ := h (Sup s) s (by refl),
    have : Sup s = t.sup id,
    { suffices : t.sup id ≤ Sup s, by { apply le_antisymm; assumption },
      simp only [id.def, finset.sup_le_iff],
      intros x hx,
      exact le_Sup (hts hx) },
    use [t, hts, this] },
end

lemma well_founded_characterisations :
  tfae [well_founded ((>) : α → α → Prop),
        is_Sup_finite_compact α,
        is_sup_closed_compact α,
        ∀ k : α, is_compact_element k] :=
begin
  tfae_have : 1 → 2, by { exact well_founded.is_Sup_finite_compact α, },
  tfae_have : 2 → 3, by { exact is_Sup_finite_compact.is_sup_closed_compact α, },
  tfae_have : 3 → 1, by { exact is_sup_closed_compact.well_founded α, },
  tfae_have : 2 ↔ 4, by { exact is_Sup_finite_compact_iff_all_elements_compact α },
  tfae_finish,
end

lemma well_founded_iff_is_Sup_finite_compact :
  well_founded ((>) : α → α → Prop) ↔ is_Sup_finite_compact α :=
(well_founded_characterisations α).out 0 1

lemma is_Sup_finite_compact_iff_is_sup_closed_compact :
  is_Sup_finite_compact α ↔ is_sup_closed_compact α :=
(well_founded_characterisations α).out 1 2

lemma is_sup_closed_compact_iff_well_founded :
  is_sup_closed_compact α ↔ well_founded ((>) : α → α → Prop) :=
(well_founded_characterisations α).out 2 0

alias well_founded_iff_is_Sup_finite_compact ↔ _ is_Sup_finite_compact.well_founded
alias is_Sup_finite_compact_iff_is_sup_closed_compact ↔
      _ is_sup_closed_compact.is_Sup_finite_compact
alias is_sup_closed_compact_iff_well_founded ↔ _ well_founded.is_sup_closed_compact

end complete_lattice

/-- A complete lattice is said to be compactly generated if any
element is the `Sup` of compact elements. -/
class is_compactly_generated (α : Type*) [complete_lattice α] : Prop :=
(exists_Sup_eq :
  ∀ (x : α), ∃ (s : set α), (∀ x ∈ s, complete_lattice.is_compact_element x) ∧ Sup s = x)

section
variables {α} [is_compactly_generated α] {a b : α} {s : set α}

@[simp]
lemma Sup_compact_le_eq (b) : Sup {c : α | complete_lattice.is_compact_element c ∧ c ≤ b} = b :=
begin
  rcases is_compactly_generated.exists_Sup_eq b with ⟨s, hs, rfl⟩,
  exact le_antisymm (Sup_le (λ c hc, hc.2)) (Sup_le_Sup (λ c cs, ⟨hs c cs, le_Sup cs⟩)),
end

@[simp]
theorem Sup_compact_eq_top :
  Sup {a : α | complete_lattice.is_compact_element a} = ⊤ :=
begin
  refine eq.trans (congr rfl (set.ext (λ x, _))) (Sup_compact_le_eq ⊤),
  exact (and_iff_left le_top).symm,
end

theorem le_iff_compact_le_imp {a b : α} :
  a ≤ b ↔ ∀ c : α, complete_lattice.is_compact_element c → c ≤ a → c ≤ b :=
⟨λ ab c hc ca, le_trans ca ab, λ h, begin
  rw [← Sup_compact_le_eq a, ← Sup_compact_le_eq b],
  exact Sup_le_Sup (λ c hc, ⟨hc.1, h c hc.1 hc.2⟩),
end⟩

/-- This property is sometimes referred to as `α` being upper continuous. -/
theorem inf_Sup_eq_of_directed_on (h : directed_on (≤) s):
  a ⊓ Sup s = ⨆ b ∈ s, a ⊓ b :=
le_antisymm (begin
  rw le_iff_compact_le_imp,
  by_cases hs : s.nonempty,
  { intros c hc hcinf,
    rw le_inf_iff at hcinf,
    rw complete_lattice.is_compact_element_iff_le_of_directed_Sup_le at hc,
    rcases hc s hs h hcinf.2 with ⟨d, ds, cd⟩,
    exact (le_inf hcinf.1 cd).trans (le_supr₂ d ds) },
  { rw set.not_nonempty_iff_eq_empty at hs,
    simp [hs] }
end) supr_inf_le_inf_Sup

/-- This property is equivalent to `α` being upper continuous. -/
theorem inf_Sup_eq_supr_inf_sup_finset :
  a ⊓ Sup s = ⨆ (t : finset α) (H : ↑t ⊆ s), a ⊓ (t.sup id) :=
le_antisymm (begin
  rw le_iff_compact_le_imp,
  intros c hc hcinf,
  rw le_inf_iff at hcinf,
  rcases hc s hcinf.2 with ⟨t, ht1, ht2⟩,
  exact (le_inf hcinf.1 ht2).trans (le_supr₂ t ht1),
end)
  (supr_le $ λ t, supr_le $ λ h, inf_le_inf_left _ ((finset.sup_id_eq_Sup t).symm ▸ (Sup_le_Sup h)))

theorem complete_lattice.set_independent_iff_finite {s : set α} :
  complete_lattice.set_independent s ↔
    ∀ t : finset α, ↑t ⊆ s → complete_lattice.set_independent (↑t : set α) :=
⟨λ hs t ht, hs.mono ht, λ h a ha, begin
  rw [disjoint_iff, inf_Sup_eq_supr_inf_sup_finset, supr_eq_bot],
  intro t,
  rw [supr_eq_bot, finset.sup_id_eq_Sup],
  intro ht,
  classical,
  have h' := (h (insert a t) _ (t.mem_insert_self a)).eq_bot,
  { rwa [finset.coe_insert, set.insert_diff_self_of_not_mem] at h',
    exact λ con, ((set.mem_diff a).1 (ht con)).2 (set.mem_singleton a) },
  { rw [finset.coe_insert, set.insert_subset],
    exact ⟨ha, set.subset.trans ht (set.diff_subset _ _)⟩ }
end⟩

lemma complete_lattice.set_independent_Union_of_directed {η : Type*}
  {s : η → set α} (hs : directed (⊆) s)
  (h : ∀ i, complete_lattice.set_independent (s i)) :
  complete_lattice.set_independent (⋃ i, s i) :=
begin
  by_cases hη : nonempty η,
  { resetI,
    rw complete_lattice.set_independent_iff_finite,
    intros t ht,
    obtain ⟨I, fi, hI⟩ := set.finite_subset_Union t.finite_to_set ht,
    obtain ⟨i, hi⟩ := hs.finset_le fi.to_finset,
    exact (h i).mono (set.subset.trans hI $ set.Union₂_subset $
      λ j hj, hi j (fi.mem_to_finset.2 hj)) },
  { rintros a ⟨_, ⟨i, _⟩, _⟩,
    exfalso, exact hη ⟨i⟩, },
end

lemma complete_lattice.independent_sUnion_of_directed {s : set (set α)}
  (hs : directed_on (⊆) s)
  (h : ∀ a ∈ s, complete_lattice.set_independent a) :
  complete_lattice.set_independent (⋃₀ s) :=
by rw set.sUnion_eq_Union; exact
  complete_lattice.set_independent_Union_of_directed hs.directed_coe (by simpa using h)

end

namespace complete_lattice

lemma compactly_generated_of_well_founded (h : well_founded ((>) : α → α → Prop)) :
  is_compactly_generated α :=
begin
  rw [well_founded_iff_is_Sup_finite_compact, is_Sup_finite_compact_iff_all_elements_compact] at h,
  -- x is the join of the set of compact elements {x}
  exact ⟨λ x, ⟨{x}, ⟨λ x _, h x, Sup_singleton⟩⟩⟩,
end

/-- A compact element `k` has the property that any `b < k` lies below a "maximal element below
`k`", which is to say `[⊥, k]` is coatomic. -/
theorem Iic_coatomic_of_compact_element {k : α} (h : is_compact_element k) :
  is_coatomic (set.Iic k) :=
⟨λ ⟨b, hbk⟩, begin
  by_cases htriv : b = k,
  { left, ext, simp only [htriv, set.Iic.coe_top, subtype.coe_mk], },
  right,
  obtain ⟨a, a₀, ba, h⟩ := zorn_nonempty_partial_order₀ (set.Iio k) _ b (lt_of_le_of_ne hbk htriv),
  { refine ⟨⟨a, le_of_lt a₀⟩, ⟨ne_of_lt a₀, λ c hck, by_contradiction $ λ c₀, _⟩, ba⟩,
    cases h c.1 (lt_of_le_of_ne c.2 (λ con, c₀ (subtype.ext con))) hck.le,
    exact lt_irrefl _ hck, },
  { intros S SC cC I IS,
    by_cases hS : S.nonempty,
    { exact ⟨Sup S, h.directed_Sup_lt_of_lt hS cC.directed_on SC, λ _, le_Sup⟩, },
    exact ⟨b, lt_of_le_of_ne hbk htriv, by simp only [set.not_nonempty_iff_eq_empty.mp hS,
      set.mem_empty_eq, forall_const, forall_prop_of_false, not_false_iff]⟩, },
end⟩

lemma coatomic_of_top_compact (h : is_compact_element (⊤ : α)) : is_coatomic α :=
(@order_iso.Iic_top α _ _).is_coatomic_iff.mp (Iic_coatomic_of_compact_element h)

end complete_lattice

section
variables [is_modular_lattice α] [is_compactly_generated α]

@[priority 100]
instance is_atomic_of_is_complemented [is_complemented α] : is_atomic α :=
⟨λ b, begin
  by_cases h : {c : α | complete_lattice.is_compact_element c ∧ c ≤ b} ⊆ {⊥},
  { left,
    rw [← Sup_compact_le_eq b, Sup_eq_bot],
    exact h },
  { rcases set.not_subset.1 h with ⟨c, ⟨hc, hcb⟩, hcbot⟩,
    right,
    have hc' := complete_lattice.Iic_coatomic_of_compact_element hc,
    rw ← is_atomic_iff_is_coatomic at hc',
    haveI := hc',
    obtain con | ⟨a, ha, hac⟩ := eq_bot_or_exists_atom_le (⟨c, le_refl c⟩ : set.Iic c),
    { exfalso,
      apply hcbot,
      simp only [subtype.ext_iff, set.Iic.coe_bot, subtype.coe_mk] at con,
      exact con },
    rw [← subtype.coe_le_coe, subtype.coe_mk] at hac,
    exact ⟨a, ha.of_is_atom_coe_Iic, hac.trans hcb⟩ },
end⟩

/-- See Lemma 5.1, Călugăreanu -/
@[priority 100]
instance is_atomistic_of_is_complemented [is_complemented α] : is_atomistic α :=
⟨λ b, ⟨{a | is_atom a ∧ a ≤ b}, begin
  symmetry,
  have hle : Sup {a : α | is_atom a ∧ a ≤ b} ≤ b := (Sup_le $ λ _, and.right),
  apply (lt_or_eq_of_le hle).resolve_left (λ con, _),
  obtain ⟨c, hc⟩ := exists_is_compl (⟨Sup {a : α | is_atom a ∧ a ≤ b}, hle⟩ : set.Iic b),
  obtain rfl | ⟨a, ha, hac⟩ := eq_bot_or_exists_atom_le c,
  { exact ne_of_lt con (subtype.ext_iff.1 (eq_top_of_is_compl_bot hc)) },
  { apply ha.1,
    rw eq_bot_iff,
    apply le_trans (le_inf _ hac) hc.1,
    rw [← subtype.coe_le_coe, subtype.coe_mk],
    exact le_Sup ⟨ha.of_is_atom_coe_Iic, a.2⟩ }
end, λ _, and.left⟩⟩

/-- See Theorem 6.6, Călugăreanu -/
theorem is_complemented_of_Sup_atoms_eq_top (h : Sup {a : α | is_atom a} = ⊤) : is_complemented α :=
⟨λ b, begin
  obtain ⟨s, ⟨s_ind, b_inf_Sup_s, s_atoms⟩, s_max⟩ := zorn_subset
    {s : set α | complete_lattice.set_independent s ∧ b ⊓ Sup s = ⊥ ∧ ∀ a ∈ s, is_atom a} _,
  { refine ⟨Sup s, le_of_eq b_inf_Sup_s, _⟩,
    rw [← h, Sup_le_iff],
    intros a ha,
    rw ← inf_eq_left,
    refine (eq_bot_or_eq_of_le_atom ha inf_le_left).resolve_left (λ con, ha.1 _),
    rw [eq_bot_iff, ← con],
    refine le_inf (le_refl a) ((le_Sup _).trans le_sup_right),
    rw ← disjoint_iff at *,
    have a_dis_Sup_s : disjoint a (Sup s) := con.mono_right le_sup_right,
    rw ← s_max (s ∪ {a}) ⟨λ x hx, _, ⟨_, λ x hx, _⟩⟩ (set.subset_union_left _ _),
    { exact set.mem_union_right _ (set.mem_singleton _) },
    { rw [set.mem_union, set.mem_singleton_iff] at hx,
      by_cases xa : x = a,
      { simp only [xa, set.mem_singleton, set.insert_diff_of_mem, set.union_singleton],
        exact con.mono_right (le_trans (Sup_le_Sup (set.diff_subset s {a})) le_sup_right) },
      { have h : (s ∪ {a}) \ {x} = (s \ {x}) ∪ {a},
        { simp only [set.union_singleton],
          rw set.insert_diff_of_not_mem,
          rw set.mem_singleton_iff,
          exact ne.symm xa },
        rw [h, Sup_union, Sup_singleton],
        apply (s_ind (hx.resolve_right xa)).disjoint_sup_right_of_disjoint_sup_left
          (a_dis_Sup_s.mono_right _).symm,
        rw [← Sup_insert, set.insert_diff_singleton,
          set.insert_eq_of_mem (hx.resolve_right xa)] } },
    { rw [Sup_union, Sup_singleton, ← disjoint_iff],
      exact b_inf_Sup_s.disjoint_sup_right_of_disjoint_sup_left con.symm },
    { rw [set.mem_union, set.mem_singleton_iff] at hx,
      cases hx,
      { exact s_atoms x hx },
      { rw hx,
        exact ha } } },
  { intros c hc1 hc2,
    refine ⟨⋃₀ c, ⟨complete_lattice.independent_sUnion_of_directed hc2.directed_on
      (λ s hs, (hc1 hs).1), _, λ a ha, _⟩, λ _, set.subset_sUnion_of_mem⟩,
    { rw [Sup_sUnion, ← Sup_image, inf_Sup_eq_of_directed_on, supr_eq_bot],
      { intro i,
        rw supr_eq_bot,
        intro hi,
        obtain ⟨x, xc, rfl⟩ := (set.mem_image _ _ _).1 hi,
        exact (hc1 xc).2.1 },
      { rw directed_on_image,
        refine hc2.directed_on.mono (λ s t, Sup_le_Sup) } },
    { rcases set.mem_sUnion.1 ha with ⟨s, sc, as⟩,
      exact (hc1 sc).2.2 a as } }
end⟩

/-- See Theorem 6.6, Călugăreanu -/
theorem is_complemented_of_is_atomistic [is_atomistic α] : is_complemented α :=
is_complemented_of_Sup_atoms_eq_top Sup_atoms_eq_top

theorem is_complemented_iff_is_atomistic : is_complemented α ↔ is_atomistic α :=
begin
  split; introsI,
  { exact is_atomistic_of_is_complemented },
  { exact is_complemented_of_is_atomistic }
end

end


/-
Copyright (c) 2018  Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Chris Hughes, Michael Howes
-/
import data.fintype.basic
import algebra.group.hom
import algebra.group.semiconj
import data.equiv.mul_add_aut
import algebra.group_with_zero.basic

/-!
# Conjugacy of group elements

See also `mul_aut.conj` and `quandle.conj`.
-/

universes u v
variables {α : Type u} {β : Type v}

section monoid

variables [monoid α] [monoid β]

/-- We say that `a` is conjugate to `b` if for some unit `c` we have `c * a * c⁻¹ = b`. -/
def is_conj (a b : α) := ∃ c : αˣ, semiconj_by ↑c a b

@[refl] lemma is_conj.refl (a : α) : is_conj a a :=
⟨1, semiconj_by.one_left a⟩

@[symm] lemma is_conj.symm {a b : α} : is_conj a b → is_conj b a
| ⟨c, hc⟩ := ⟨c⁻¹, hc.units_inv_symm_left⟩

@[trans] lemma is_conj.trans {a b c : α} : is_conj a b → is_conj b c → is_conj a c
| ⟨c₁, hc₁⟩ ⟨c₂, hc₂⟩ := ⟨c₂ * c₁, hc₂.mul_left hc₁⟩

@[simp] lemma is_conj_iff_eq {α : Type*} [comm_monoid α] {a b : α} : is_conj a b ↔ a = b :=
⟨λ ⟨c, hc⟩, begin
  rw [semiconj_by, mul_comm, ← units.mul_inv_eq_iff_eq_mul, mul_assoc, c.mul_inv, mul_one] at hc,
  exact hc,
end, λ h, by rw h⟩

protected lemma monoid_hom.map_is_conj (f : α →* β) {a b : α} : is_conj a b → is_conj (f a) (f b)
| ⟨c, hc⟩ := ⟨units.map f c, by rw [units.coe_map, semiconj_by, ← f.map_mul, hc.eq, f.map_mul]⟩

end monoid

section group

variables [group α]

@[simp] lemma is_conj_iff {a b : α} :
  is_conj a b ↔ ∃ c : α, c * a * c⁻¹ = b :=
⟨λ ⟨c, hc⟩, ⟨c, mul_inv_eq_iff_eq_mul.2 hc⟩, λ ⟨c, hc⟩,
  ⟨⟨c, c⁻¹, mul_inv_self c, inv_mul_self c⟩, mul_inv_eq_iff_eq_mul.1 hc⟩⟩

@[simp] lemma is_conj_one_right {a : α} : is_conj 1 a  ↔ a = 1 :=
⟨λ ⟨c, hc⟩, mul_right_cancel (hc.symm.trans ((mul_one _).trans (one_mul _).symm)), λ h, by rw [h]⟩

@[simp] lemma is_conj_one_left {a : α} : is_conj a 1 ↔ a = 1 :=
calc is_conj a 1 ↔ is_conj 1 a : ⟨is_conj.symm, is_conj.symm⟩
... ↔ a = 1 : is_conj_one_right

@[simp] lemma conj_inv {a b : α} : (b * a * b⁻¹)⁻¹ = b * a⁻¹ * b⁻¹ :=
((mul_aut.conj b).map_inv a).symm

@[simp] lemma conj_mul {a b c : α} : (b * a * b⁻¹) * (b * c * b⁻¹) = b * (a * c) * b⁻¹ :=
((mul_aut.conj b).map_mul a c).symm

@[simp] lemma conj_pow {i : ℕ} {a b : α} : (a * b * a⁻¹) ^ i = a * (b ^ i) * a⁻¹ :=
begin
  induction i with i hi,
  { simp },
  { simp [pow_succ, hi] }
end

@[simp] lemma conj_zpow {i : ℤ} {a b : α} : (a * b * a⁻¹) ^ i = a * (b ^ i) * a⁻¹ :=
begin
  induction i,
  { simp },
  { simp [zpow_neg_succ_of_nat, conj_pow] }
end

lemma conj_injective {x : α} : function.injective (λ (g : α), x * g * x⁻¹) :=
(mul_aut.conj x).injective

end group

@[simp] lemma is_conj_iff₀ [group_with_zero α] {a b : α} :
  is_conj a b ↔ ∃ c : α, c ≠ 0 ∧ c * a * c⁻¹ = b :=
⟨λ ⟨c, hc⟩, ⟨c, begin
    rw [← units.coe_inv', units.mul_inv_eq_iff_eq_mul],
    exact ⟨c.ne_zero, hc⟩,
  end⟩, λ ⟨c, c0, hc⟩,
  ⟨units.mk0 c c0, begin
    rw [semiconj_by, ← units.mul_inv_eq_iff_eq_mul, units.coe_inv', units.coe_mk0],
    exact hc
  end⟩⟩

namespace is_conj
/- This small quotient API is largely copied from the API of `associates`;
where possible, try to keep them in sync -/

/-- The setoid of the relation `is_conj` iff there is a unit `u` such that `u * x = y * u` -/
protected def setoid (α : Type*) [monoid α] : setoid α :=
{ r := is_conj, iseqv := ⟨is_conj.refl, λa b, is_conj.symm, λa b c, is_conj.trans⟩ }

end is_conj

local attribute [instance, priority 100] is_conj.setoid

/-- The quotient type of conjugacy classes of a group. -/
def conj_classes (α : Type*) [monoid α] : Type* :=
quotient (is_conj.setoid α)

namespace conj_classes

section monoid
variables [monoid α] [monoid β]

/-- The canonical quotient map from a monoid `α` into the `conj_classes` of `α` -/
protected def mk {α : Type*} [monoid α] (a : α) : conj_classes α :=
⟦a⟧

instance : inhabited (conj_classes α) := ⟨⟦1⟧⟩

theorem mk_eq_mk_iff_is_conj {a b : α} :
  conj_classes.mk a = conj_classes.mk b ↔ is_conj a b :=
iff.intro quotient.exact quot.sound

theorem quotient_mk_eq_mk (a : α) : ⟦ a ⟧ = conj_classes.mk a := rfl

theorem quot_mk_eq_mk (a : α) : quot.mk setoid.r a = conj_classes.mk a := rfl

theorem forall_is_conj {p : conj_classes α → Prop} :
  (∀a, p a) ↔ (∀a, p (conj_classes.mk a)) :=
iff.intro
  (assume h a, h _)
  (assume h a, quotient.induction_on a h)

theorem mk_surjective : function.surjective (@conj_classes.mk α _) :=
forall_is_conj.2 (λ a, ⟨a, rfl⟩)

instance : has_one (conj_classes α) := ⟨⟦ 1 ⟧⟩

theorem one_eq_mk_one : (1 : conj_classes α) = conj_classes.mk 1 := rfl

lemma exists_rep (a : conj_classes α) : ∃ a0 : α, conj_classes.mk a0 = a :=
quot.exists_rep a

/-- A `monoid_hom` maps conjugacy classes of one group to conjugacy classes of another. -/
def map (f : α →* β) : conj_classes α → conj_classes β :=
quotient.lift (conj_classes.mk ∘ f) (λ a b ab, mk_eq_mk_iff_is_conj.2 (f.map_is_conj ab))

lemma map_surjective {f : α →* β} (hf : function.surjective f) :
  function.surjective (conj_classes.map f) :=
begin
  intros b,
  obtain ⟨b, rfl⟩ := conj_classes.mk_surjective b,
  obtain ⟨a, rfl⟩ := hf b,
  exact ⟨conj_classes.mk a, rfl⟩,
end

instance [fintype α] [decidable_rel (is_conj : α → α → Prop)] :
  fintype (conj_classes α) :=
quotient.fintype (is_conj.setoid α)

end monoid

section comm_monoid
variable [comm_monoid α]

lemma mk_injective : function.injective (@conj_classes.mk α _) :=
λ _ _, (mk_eq_mk_iff_is_conj.trans is_conj_iff_eq).1

lemma mk_bijective : function.bijective (@conj_classes.mk α _) :=
⟨mk_injective, mk_surjective⟩

/-- The bijection between a `comm_group` and its `conj_classes`. -/
def mk_equiv : α ≃ conj_classes α :=
⟨conj_classes.mk, quotient.lift id (λ (a : α) b, is_conj_iff_eq.1), quotient.lift_mk _ _,
  begin
    rw [function.right_inverse, function.left_inverse, forall_is_conj],
    intro x,
    rw [← quotient_mk_eq_mk, ← quotient_mk_eq_mk, quotient.lift_mk, id.def],
  end⟩

end comm_monoid
end conj_classes

section monoid

variables [monoid α]

/-- Given an element `a`, `conjugates a` is the set of conjugates. -/
def conjugates_of (a : α) : set α := {b | is_conj a b}

lemma mem_conjugates_of_self {a : α} : a ∈ conjugates_of a := is_conj.refl _

lemma is_conj.conjugates_of_eq {a b : α} (ab : is_conj a b) :
  conjugates_of a = conjugates_of b :=
set.ext (λ g, ⟨λ ag, (ab.symm).trans ag, λ bg, ab.trans bg⟩)

lemma is_conj_iff_conjugates_of_eq {a b : α} :
  is_conj a b ↔ conjugates_of a = conjugates_of b :=
⟨is_conj.conjugates_of_eq, λ h, begin
  have ha := mem_conjugates_of_self,
  rwa ← h at ha,
end⟩

end monoid

namespace conj_classes

variables [monoid α]

local attribute [instance] is_conj.setoid

/-- Given a conjugacy class `a`, `carrier a` is the set it represents. -/
def carrier : conj_classes α → set α :=
quotient.lift conjugates_of (λ (a : α) b ab, is_conj.conjugates_of_eq ab)

lemma mem_carrier_mk {a : α} : a ∈ carrier (conj_classes.mk a) := is_conj.refl _

lemma mem_carrier_iff_mk_eq {a : α} {b : conj_classes α} :
  a ∈ carrier b ↔ conj_classes.mk a = b :=
begin
  revert b,
  rw forall_is_conj,
  intro b,
  rw [carrier, eq_comm, mk_eq_mk_iff_is_conj, ← quotient_mk_eq_mk, quotient.lift_mk],
  refl,
end

lemma carrier_eq_preimage_mk {a : conj_classes α} :
  a.carrier = conj_classes.mk ⁻¹' {a} :=
set.ext (λ x, mem_carrier_iff_mk_eq)

end conj_classes


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import measure_theory.measure.measure_space_def

/-!
# Almost everywhere disjoint sets

We say that sets `s` and `t` are `μ`-a.e. disjoint (see `measure_theory.ae_disjoint`) if their
intersection has measure zero. This assumption can be used instead of `disjoint` in most theorems in
measure theory.
-/

open set function

namespace measure_theory

variables {ι α : Type*} {m : measurable_space α} (μ : measure α)

/-- Two sets are said to be `μ`-a.e. disjoint if their intersection has measure zero. -/
def ae_disjoint (s t : set α) := μ (s ∩ t) = 0

variables {μ} {s t u v : set α}

/-- If `s : ι → set α` is a countable family of pairwise a.e. disjoint sets, then there exists a
family of measurable null sets `t i` such that `s i \ t i` are pairwise disjoint. -/
lemma exists_null_pairwise_disjoint_diff [encodable ι] {s : ι → set α}
  (hd : pairwise (ae_disjoint μ on s)) :
  ∃ t : ι → set α, (∀ i, measurable_set (t i)) ∧ (∀ i, μ (t i) = 0) ∧
    pairwise (disjoint on (λ i, s i \ t i)) :=
begin
  refine ⟨λ i, to_measurable μ (s i ∩ ⋃ j ∈ ({i}ᶜ : set ι), s j),
    λ i, measurable_set_to_measurable _ _, λ i, _, _⟩,
  { simp only [measure_to_measurable, inter_Union, measure_bUnion_null_iff (countable_encodable _)],
    exact λ j hj, hd _ _ (ne.symm hj) },
  { simp only [pairwise, disjoint_left, on_fun, mem_diff, not_and, and_imp, not_not],
    intros i j hne x hi hU hj,
    replace hU : x ∉ s i ∩ ⋃ j ≠ i, s j := λ h, hU (subset_to_measurable _ _ h),
    simp only [mem_inter_eq, mem_Union, not_and, not_exists] at hU,
    exact (hU hi j hne.symm hj).elim }
end

namespace ae_disjoint

protected lemma eq (h : ae_disjoint μ s t) : μ (s ∩ t) = 0 := h

@[symm] protected lemma symm (h : ae_disjoint μ s t) : ae_disjoint μ t s :=
by rwa [ae_disjoint, inter_comm]

protected lemma symmetric : symmetric (ae_disjoint μ) := λ s t h, h.symm

protected lemma comm : ae_disjoint μ s t ↔ ae_disjoint μ t s := ⟨λ h, h.symm, λ h, h.symm⟩

lemma _root_.disjoint.ae_disjoint (h : disjoint s t) : ae_disjoint μ s t :=
by rw [ae_disjoint, disjoint_iff_inter_eq_empty.1 h, measure_empty]

lemma mono_ae (h : ae_disjoint μ s t) (hu : u ≤ᵐ[μ] s) (hv : v ≤ᵐ[μ] t) : ae_disjoint μ u v :=
measure_mono_null_ae (hu.inter hv) h

lemma mono (h : ae_disjoint μ s t) (hu : u ⊆ s) (hv : v ⊆ t) : ae_disjoint μ u v :=
h.mono_ae hu.eventually_le hv.eventually_le

@[simp] lemma Union_left_iff [encodable ι] {s : ι → set α} :
  ae_disjoint μ (⋃ i, s i) t ↔ ∀ i, ae_disjoint μ (s i) t :=
by simp only [ae_disjoint, Union_inter, measure_Union_null_iff]

@[simp] lemma Union_right_iff [encodable ι] {t : ι → set α} :
  ae_disjoint μ s (⋃ i, t i) ↔ ∀ i, ae_disjoint μ s (t i) :=
by simp only [ae_disjoint, inter_Union, measure_Union_null_iff]

@[simp] lemma union_left_iff : ae_disjoint μ (s ∪ t) u ↔ ae_disjoint μ s u ∧ ae_disjoint μ t u :=
by simp [union_eq_Union, and.comm]

@[simp] lemma union_right_iff : ae_disjoint μ s (t ∪ u) ↔ ae_disjoint μ s t ∧ ae_disjoint μ s u :=
by simp [union_eq_Union, and.comm]

lemma union_left (hs : ae_disjoint μ s u) (ht : ae_disjoint μ t u) : ae_disjoint μ (s ∪ t) u :=
union_left_iff.mpr ⟨hs, ht⟩

lemma union_right (ht : ae_disjoint μ s t) (hu : ae_disjoint μ s u) : ae_disjoint μ s (t ∪ u) :=
union_right_iff.2 ⟨ht, hu⟩

lemma diff_ae_eq_left (h : ae_disjoint μ s t) : (s \ t : set α) =ᵐ[μ] s :=
@diff_self_inter _ s t ▸ diff_null_ae_eq_self h

lemma diff_ae_eq_right (h : ae_disjoint μ s t) : (t \ s : set α) =ᵐ[μ] t := h.symm.diff_ae_eq_left

lemma measure_diff_left (h : ae_disjoint μ s t) : μ (s \ t) = μ s := measure_congr h.diff_ae_eq_left

lemma measure_diff_right (h : ae_disjoint μ s t) : μ (t \ s) = μ t :=
measure_congr h.diff_ae_eq_right

/-- If `s` and `t` are `μ`-a.e. disjoint, then `s \ u` and `t` are disjoint for some measurable null
set `u`. -/
lemma exists_disjoint_diff (h : ae_disjoint μ s t) :
  ∃ u, measurable_set u ∧ μ u = 0 ∧ disjoint (s \ u) t :=
⟨to_measurable μ (s ∩ t), measurable_set_to_measurable _ _, (measure_to_measurable _).trans h,
  disjoint_diff.symm.mono_left (λ x hx, ⟨hx.1, λ hxt, hx.2 $ subset_to_measurable _ _ ⟨hx.1, hxt⟩⟩)⟩

lemma of_null_right (h : μ t = 0) : ae_disjoint μ s t :=
measure_mono_null (inter_subset_right _ _) h

lemma of_null_left (h : μ s = 0) : ae_disjoint μ s t := (of_null_right h).symm

end ae_disjoint

lemma ae_disjoint_compl_left : ae_disjoint μ sᶜ s := (@disjoint_compl_left _ s _).ae_disjoint
lemma ae_disjoint_compl_right : ae_disjoint μ s sᶜ := (@disjoint_compl_right _ s _).ae_disjoint

end measure_theory


import algebra.periodic
import analysis.normed_space.basic

import to_mathlib.topology.separation

/-!

# Boundedness property of periodic function

The main purpose of that file it to prove
```
lemma continuous.bounded_of_one_periodic_of_compact {f : X → ℝ → E} (cont : continuous ↿f)
  (hper : ∀ x, one_periodic (f x)) {K : set X} (hK : is_compact K) (hfK : ∀ x ∉ K, f x = 0) :
  ∃ C, ∀ x t, ‖f x t‖ ≤ C
```

This is done by introducing the quotient 𝕊₁ = ℝ/ℤ as a compact topological space. Patrick is not sure
this is the optimal version.

In the first part, generalize many lemmas to any period and add to algebra/periodic.lean?

-/

noncomputable theory

open set function  filter topological_space int
open_locale topology

section one_periodic

variables {α : Type*}

/-- The integers as an additive subgroup of the reals. -/
def ℤ_sub_ℝ : add_subgroup ℝ := add_monoid_hom.range (int.cast_add_hom ℝ)

/-- The equivalence relation on `ℝ` corresponding to its partition as cosets of `ℤ`. -/
def trans_one : setoid ℝ := quotient_add_group.left_rel ℤ_sub_ℝ

/-- The proposition that a function on `ℝ` is periodic with period `1`. -/
def one_periodic (f : ℝ → α) : Prop := periodic f 1

lemma one_periodic.add_nat {f : ℝ → α} (h : one_periodic f) : ∀ k : ℕ, ∀ x, f (x + k) = f x :=
begin
  intros k x,
  induction k with k hk,
  { simp },
  rw [nat.cast_succ, ← add_assoc, h, hk]
end

lemma one_periodic.add_int {f : ℝ → α} (h : one_periodic f) : ∀ k : ℤ, ∀ x, f (x + k) = f x :=
begin
  intros k x,
  induction k with k k,
  { erw h.add_nat },
  have : x + -[1+ k] + (k + 1 : ℕ) = x, by { simp, ring },
  rw [← h.add_nat (k+1) (x + -[1+ k]), this]
end

/-- The circle `𝕊₁ := ℝ/ℤ`. -/
@[derive [topological_space, inhabited]]
def 𝕊₁ := quotient trans_one

lemma trans_one_rel_iff {a b : ℝ} : trans_one.rel a b ↔ ∃ k : ℤ, b = a + k :=
begin
  refine quotient_add_group.left_rel_apply.trans _,
  refine exists_congr (λ k, _),
  rw [coe_cast_add_hom, eq_neg_add_iff_add_eq, eq_comm]
end

section
local attribute [instance] trans_one

/-- The quotient map from the reals to the circle `ℝ ⧸ ℤ`. -/
def proj_𝕊₁ : ℝ → 𝕊₁ := quotient.mk

@[simp]
lemma proj_𝕊₁_add_int (t : ℝ) (k : ℤ) : proj_𝕊₁ (t + k) = proj_𝕊₁ t :=
begin
  symmetry,
  apply quotient.sound,
  exact (trans_one_rel_iff.mpr ⟨k, rfl⟩)
end

/-- The unique representative in the half-open interval `[0, 1)` for each coset of `ℤ` in `ℝ`,
regarded as a map from the circle `𝕊₁ → ℝ`. -/
def 𝕊₁.repr (x : 𝕊₁) : ℝ := let t := quotient.out x in fract t

lemma 𝕊₁.repr_mem (x : 𝕊₁) : x.repr ∈ (Ico 0 1 : set ℝ) :=
⟨fract_nonneg _, fract_lt_one _⟩

lemma 𝕊₁.proj_repr (x : 𝕊₁) : proj_𝕊₁ (x.repr) = x :=
begin
  symmetry,
  conv_lhs { rw ← quotient.out_eq x },
  rw ← fract_add_floor (quotient.out x),
  apply proj_𝕊₁_add_int
end

lemma image_proj_𝕊₁_Ico : proj_𝕊₁ '' (Ico 0 1) = univ :=
begin
  rw eq_univ_iff_forall,
  intro x,
  use [x.repr, x.repr_mem, x.proj_repr],
end

lemma image_proj_𝕊₁_Icc : proj_𝕊₁ '' (Icc 0 1) = univ :=
eq_univ_of_subset (image_subset proj_𝕊₁ Ico_subset_Icc_self) image_proj_𝕊₁_Ico

@[continuity]
lemma continuous_proj_𝕊₁ : continuous proj_𝕊₁ := continuous_quotient_mk

lemma is_open_map_proj_𝕊₁ : is_open_map proj_𝕊₁ :=
quotient_add_group.is_open_map_coe ℤ_sub_ℝ

lemma quotient_map_id_proj_𝕊₁ {X : Type*} [topological_space X] :
  quotient_map (λ p : X × ℝ, (p.1, proj_𝕊₁ p.2)) :=
(is_open_map.id.prod is_open_map_proj_𝕊₁).to_quotient_map (continuous_id.prod_map continuous_proj_𝕊₁)
  (surjective_id.prod_map quotient.exists_rep)

/-- A one-periodic function on `ℝ` descends to a function on the circle `ℝ ⧸ ℤ`. -/
def one_periodic.lift {f : ℝ → α} (h : one_periodic f) : 𝕊₁ → α :=
quotient.lift f (by { intros a b hab, rcases trans_one_rel_iff.mp hab with ⟨k, rfl⟩, rw h.add_int })

end

local notation `π` := proj_𝕊₁

instance : compact_space 𝕊₁ :=
⟨by { rw ← image_proj_𝕊₁_Icc, exact is_compact_Icc.image continuous_proj_𝕊₁ }⟩

lemma is_closed_int : is_closed (range (coe : ℤ → ℝ)) :=
begin
  refine is_closed_of_spaced_out (metric.uniformity_basis_dist.mem_of_mem $ zero_lt_one) _,
  rintros - ⟨p, rfl⟩ - ⟨q, rfl⟩ h (H : dist p q < 1),
  rw [int.dist_eq] at H,
  norm_cast at *,
  exact h (eq_of_sub_eq_zero $ int.abs_lt_one_iff.mp H)
end

instance : t2_space 𝕊₁ :=
begin
  have πcont : continuous π, from continuous_quotient_mk,
  rw t2_space_iff_of_continuous_surjective_open πcont quotient.surjective_quotient_mk' is_open_map_proj_𝕊₁,
  have : {q : ℝ × ℝ | π q.fst = π q.snd} = {q : ℝ × ℝ | ∃ k : ℤ, q.2 = q.1 + k},
  { ext ⟨a, b⟩,
    simp only [proj_𝕊₁, quotient.eq, mem_set_of_eq],
    exact trans_one_rel_iff },
  have : {q : ℝ × ℝ | π q.fst = π q.snd} = (λ q : ℝ × ℝ , q.2 - q.1) ⁻¹' (range $ (coe : ℤ → ℝ)),
  { rw this,
    ext ⟨a, b⟩,
    apply exists_congr (λ k, _),
    conv_rhs {rw [eq_comm, sub_eq_iff_eq_add'] } },
  rw this,
  exact is_closed.preimage (continuous_snd.sub continuous_fst) is_closed_int
end

variables {X E : Type*} [topological_space X] [normed_add_comm_group E]

lemma continuous.bounded_on_compact_of_one_periodic {f : X → ℝ → E} (cont : continuous ↿f)
  (hper : ∀ x, one_periodic (f x)) {K : set X} (hK : is_compact K) :
  ∃ C, ∀ x ∈ K, ∀ t, ‖f x t‖ ≤ C :=
begin
  let F : X × 𝕊₁ → E := λ p : X × 𝕊₁, (hper p.1).lift p.2,
  have Fcont : continuous F,
  { have qm : quotient_map (λ p : X × ℝ, (p.1, π p.2)) := quotient_map_id_proj_𝕊₁,
    let φ := ↿f, -- avoid weird elaboration issue
    have : φ = F ∘ (λ p : X × ℝ, (p.1, π p.2)), by { ext p, refl },
    dsimp [φ] at this,
    rwa [this,  ← qm.continuous_iff] at cont },
  obtain ⟨C, hC⟩ := (hK.prod is_compact_univ).bdd_above_image (continuous_norm.comp Fcont).continuous_on,
  exact ⟨C, λ x x_in t, hC ⟨(x, π t), ⟨x_in, mem_univ _⟩, rfl⟩⟩
end

lemma continuous.bounded_of_one_periodic_of_compact {f : X → ℝ → E} (cont : continuous ↿f)
  (hper : ∀ x, one_periodic (f x)) {K : set X} (hK : is_compact K) (hfK : ∀ x ∉ K, f x = 0) :
  ∃ C, ∀ x t, ‖f x t‖ ≤ C :=
begin
  obtain ⟨C, hC⟩ := cont.bounded_on_compact_of_one_periodic hper hK,
  use max C 0,
  intros x t,
  by_cases hx : x ∈ K,
  { exact le_max_of_le_left (hC x hx t) },
  { simp [hfK, hx] },
end

end one_periodic


import Rings.Rings
import Rings.Fields
import Rings.ToMathlib.list
import Rings.ToMathlib.nat
import Rings.ToMathlib.fol
import Rings.ToMathlib.mv_polynomial
import Rings.RealizeThings
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 λ i, 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],
    exact ⟨ (λ _, 0), by simp only [finset.mem_univ],
    (begin
      simp only [monom_of_bd_monom],
      funext,
      refl,
    end)⟩,
  },
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_ ⟨(list.index_of' f (monom_deg_le n d) + 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,
    ring_signature.mul, 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 , inj_formula_aux3 ⟩ ≃ x_ (⟨ i + n , inj_formula_aux4 ⟩)
)

-- 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_data (K : Type*) [comm_semiring K] (n : ℕ) : Type* :=
fin n → mv_polynomial (fin n) K

/-- a polynomial map evaluates those polynomials that it consists of -/
def poly_map {K : Type*} [comm_semiring K] {n : ℕ} :
  poly_map_data K n → (fin n → K) → (fin n → K) :=
λ ps as k, mv_polynomial.eval as (ps k)

/-- 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_data K n) (hinj : function.injective (poly_map ps)) :
  function.surjective (poly_map 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_data.coeffs_list
  {n : ℕ} (d : ℕ) (ps : poly_map_data 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_data.coeffs_dvector
  {n : ℕ} (d : ℕ) (ps : poly_map_data A n) :
  dvector A (poly_map_data.coeffs_list d ps).length :=
dvector.of_list (poly_map_data.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_data A n) :
  (n * (monom_deg_le n d).length)
  =
  (poly_map_data.coeffs_list d ps).length :=
begin
  simp only [poly_map_data.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_data.coeffs_dvector' {n : ℕ} (d : ℕ)
  (ps : poly_map_data A n) :
  dvector A (n * (monom_deg_le n d).length) :=
dvector.cast (symm (variable_bound_equal d ps))
  (poly_map_data.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],
      refine ⟨ λ k, ⟨ f k, hf_img_lt k⟩, _ , _ ⟩,
      {simp only [finset.mem_univ]},
      {funext, refl},
    },
    {
      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_data 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_data_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_data_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_data.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_data.coeffs_dvector'_nth_aux1
  {ps : poly_map_data 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_data.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_data.coeffs_dvector'_nth
  {A : Type*} [comm_ring A] {n d : ℕ}
  {ps : poly_map_data 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_data.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_data.coeffs_dvector'_nth_aux0 j f) :=
begin
  rw [poly_map_data.coeffs_dvector', dvector.nth_cast,
    poly_map_data.coeffs_dvector, dvector.nth_of_list],
  delta poly_map_data.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_data.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_data.coeffs_dvector'_nth_aux2 j f hf',
  -- {exact index_of_monom_deg_le₀_lt_length _},
end

lemma eval_poly_map_data_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_data.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_data.coeffs_dvector' d ps))).nth
             (i + n) inj_formula_aux4 ^ f i))
         )
    (monom_deg_le n d))
  :=
begin
  rw mv_polynomial.eval_eq',
  rw mv_polynomial_sum_eq_finset_map_monom_deg_le_finset_sum (ps j) (hdeg j),
  rw finset.sum_map,
  rw 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_data_xs_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_data.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_data_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_data.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_data.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_data_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_data_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_data.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_iff_injective
  {n d : ℕ}
  (ps : poly_map_data A n)
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d) :
  @realize_bounded_formula _ (struc_to_ring_struc.Structure A)
    _ _ (@poly_map_data.coeffs_dvector' A _ n d ps)
    (inj_formula n d) dvector.nil
  ↔
  function.injective (poly_map ps) :=
begin
  -- let xs0 := poly_map_data.coeffs_dvector' d ps,
  -- 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_data.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] 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_data_xs ps xs' ys' hdeg j),
      funext k,
      simp only [dvector.nth_of_fn, fin.eta],
    },
    {
      convert symm (eval_poly_map_data_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,
  clear hInj hImage himage,
  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 symm 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 ps (λ i, dvector.nth xs i i.2)
               = poly_map ps (λ i, dvector.nth ys i i.2),
  {
    funext j, -- for each i < n (... the tuples at i are equal)
    simp only [poly_map],
    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_data_xs ps xs ys hdeg j, refl },
    {rw eval_poly_map_data_ys ps xs ys hdeg j, refl },
  },
  -- by injectivity of poly_map 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_iff_surjective
  {n d : ℕ}
  (ps : poly_map_data A n)
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d) :
  (@realize_bounded_formula _ (struc_to_ring_struc.Structure A)
    _ _ (@poly_map_data.coeffs_dvector' A _ n d ps)
    (surj_formula n d) dvector.nil)
  ↔
  function.surjective (poly_map 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_data.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_data_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_data_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, 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 _ _),
  simp only [finset.sup_le_iff],
  intros f hf,
  simp only [function.comp],
  rw [mv_polynomial.total_degree_monomial],
  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,
  { simp only [if_pos h, bot_eq_zero, zero_le'] },
  { simp only [if_neg h, finsupp.sum],
    simp only [monom_deg_le_finset, finset.mem_filter] at hf,
    exact hf.2 },
  apply_instance, -- why??
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_data.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_data_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_data_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 injective_iff_realize_inj_formula
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length)) :
  function.injective
    (poly_map (λ 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
      (λ i : fin n, mv_polynomial_of_coeffs (dvector.ith_chunk i coeffs))
      (λ i, dvector.nth xs i i.2)
    =
    poly_map
      (λ 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, 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, 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 symm 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, 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, 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 symm hPreimage,
    rw fin.eta k,
    rw fin.eta k,
  },
end

lemma surjective_iff_realize_surj_formula
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length)) :
  function.surjective
    (poly_map (λ 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] 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],
    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_data K n),
    function.injective (poly_map ps) → function.surjective (poly_map ps)) :=
begin
  split,
  {
    intros H ps hinj,
    set d := max_total_deg ps,
    specialize H d,
    let coeffs := poly_map_data.coeffs_dvector' d ps,
    simp only [realize_sentence_bd_alls, Ax_Groth_formula] at H,
    -- injective -> realize inj_formula
    have hInj : @realize_bounded_formula _ (struc_to_ring_struc.Structure K) _ _
      (poly_map_data.coeffs_dvector' d ps) (inj_formula n d) dvector.nil,
    {
      rw realize_inj_formula_iff_injective ps (total_deg_le_max_total_deg ps),
      exact hinj,
    },
  rw ← realize_surj_formula_iff_surjective ps (total_deg_le_max_total_deg ps),
  -- apply realize_Ax_Groth to ps, i.e. apply hAG to its coefficients
  exact H coeffs hInj,
  },
  {
    intros H d,
    simp only [Ax_Groth_formula],
    simp only [realize_sentence_bd_alls],
    intro coeffs,
    simp only [realize_bounded_formula_imp],
    intro hinj,
    rw ← surjective_iff_realize_surj_formula,
    apply H,
    rw injective_iff_realize_inj_formula,
    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

/-- Ax_Groth_formula is true in ACFₚ, corollary of Lefschetz part 1. (ACFₚ is_complete') and the axiom-/
lemma ACFₚ_ssatisfied_Ax_Groth_formula {p : ℕ} (hp : nat.prime p) (n : ℕ) :
  ∀ d, (ACFₚ hp) ⊨ Ax_Groth_formula n d :=
begin
  have h : ∀ d, (instances.algebraic_closure_of_zmod hp) ⊨ Ax_Groth_formula n d,
  {
    rw realize_Ax_Groth_formula,
    apply Ax_Groth_of_locally_finite hp
      (@algebraic_closure.of_ulift_zmod.char_p p ⟨ hp ⟩),
  },
  intro d,
  exact Lefschetz.is_complete''_ACFₚ hp
    (instances.algebraic_closure_of_zmod hp) ⟨ 0 ⟩ (Ax_Groth_formula n d)
    (instances.algebraic_closure_of_zmod_models_ACFₚ hp) (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 _ _ _,
  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₀

theorem Ax_Groth
  (h0 : char_zero K) {n : ℕ}
  {ps : poly_map_data K n} (hinj : function.injective (poly_map ps)) :
  function.surjective (poly_map ps) :=
realize_Ax_Groth_formula.mp (realize_Ax_Groth_formula_of_char_zero h0 _)
  _ hinj

end alg_closed_field
end AxGroth

#check prod


import data.set.basic
import data.fintype.basic
import data.finset.basic
import tactic

import automata.dfa

namespace nfa
open set list DFA finset

variables {S Q : Type} [fintype S] [fintype Q] [decidable_eq Q]

structure NFA (S : Type) (Q : Type) [fintype S] [fintype Q] [decidable_eq Q] :=
    (start : Q) -- starting state
    (term : set Q) -- terminal states
    (next : Q → S → set Q) -- transitions

inductive go (nfa : NFA S Q) : Q → list S → Q → Prop
| finish : Π {q : Q}, go q [] q
| step   : Π {head : S} {tail : list S} {q n f : Q} (h : n ∈ nfa.next q head),
    go n tail f → go q (head::tail) f

@[simp] def nfa_accepts_word (nfa : NFA S Q) (w : list S) : Prop :=
    ∃ {t}, go nfa nfa.start w t ∧ t ∈ nfa.term

@[simp] def lang_of_nfa (nfa : NFA S Q) := {w | nfa_accepts_word nfa w}

def nfa_lang (lang : set (list S)) :=
    ∃ {Q : Type} [fintype Q] [decidable_eq Q], by exactI ∃ (nfa : NFA S Q), lang = lang_of_nfa nfa

lemma nfa_go_append {nfa : NFA S Q} {a b c : Q} {left right : list S}:
    go nfa a left b → go nfa b right c → go nfa a (left ++ right) c :=
begin
    induction left generalizing a,
    case list.nil : {
        rintro ⟨_⟩ hbc,
        exact hbc,
    },
    case list.cons : head tail ih {
        rintro (⟨_⟩ | ⟨head, tail, _, nxt, _, h, hab⟩) hbc,
        specialize @ih nxt,
        exact go.step h (ih hab hbc),
    }
end

def dfa_to_nfa (dfa : DFA S Q) : NFA S Q := {
    start := dfa.start,
    term := dfa.term,
    next := λ q c, {dfa.next q c}
}

lemma dfa_to_nfa_goes_to
    {d : DFA S Q} {w : list S} {q r : Q}
    : go (dfa_to_nfa d) q w r ↔ DFA.go d q w = r :=
begin
    split, {
        intro go_nfa,
        induction go_nfa,
        case nfa.go.finish {
            rw DFA.go_finish,
        },
        case nfa.go.step : head tail q nxt f hnxt go_tail ih {
            rw DFA.go_step,
            convert ih,
            simp only [dfa_to_nfa, mem_singleton_iff] at hnxt,
            exact hnxt.symm,
        }
    }, {
        intro go_dfa,
        induction w generalizing q,
        case list.nil {
            cases go_dfa, exact go.finish,
        },
        case list.cons : head tail ih {
            cases go_dfa,
            specialize @ih (d.next q head) go_dfa,
            refine go.step _ ih,
            simp only [dfa_to_nfa, set.mem_singleton],
        }
    }
end

theorem dfa_to_nfa_eq {L : set (list S)} (hdfa : dfa_lang L) : nfa_lang L :=
begin
    rcases hdfa with ⟨Q, fQ, dQ, d, rfl⟩,
    letI := fQ,
    existsi [Q, _, _, dfa_to_nfa d],

    ext x,
    rw [lang_of_dfa, lang_of_nfa, mem_set_of_eq, mem_set_of_eq],
    split, {
        rintro dfa_go,
        dsimp at dfa_go,
        use [DFA.go d (d.start) x],
        rw dfa_to_nfa_goes_to,
        use [rfl, dfa_go],
    }, {
        rintro ⟨t, t_go, t_term⟩,
        rw dfa_to_nfa_goes_to at t_go,
        subst t_go,
        use t_term,
    }
end

noncomputable def nfa_to_dfa (nfa : NFA S Q) : DFA S (set Q) := {
    start := {nfa.start},
    term := {q | ∃ t, t ∈ q ∧ t ∈ nfa.term},
    next := λ q c, (⋃ t ∈ q, nfa.next t c),
}

lemma nfa_to_dfa_goes_to
    {n : NFA S Q} {d : DFA S (set Q)} (w : list S) {S1 : set Q}
    : d = nfa_to_dfa n → DFA.go d S1 w = {e2 : Q | ∃ (s2 : Q), s2 ∈ S1 ∧ go n s2 w e2} :=
begin
    rintro rfl,
    induction w with head tail ih generalizing S1, {
        ext, split,
        { intro xe1, use [x, xe1, go.finish] },
        { rintro ⟨s2, s2ins1, ⟨s2go⟩⟩, exact s2ins1 },
    }, {
        specialize @ih ((nfa_to_dfa n).next S1 head),
        ext value, split, {
            intro dfa_go,
            rw [go_step, ih] at dfa_go,
            rcases dfa_go with ⟨s2, s2innext, s2go⟩,
            rw [nfa_to_dfa, mem_bUnion_iff] at s2innext,
            rcases s2innext with ⟨x, x_in_s1, x_next⟩,
            use [x, x_in_s1, go.step x_next s2go],
        }, {
            rintro ⟨s2, s2ins1, s2go⟩,
            rw [DFA.go_step, ih],
            cases s2go,
            use s2go_n,
            split, {
                dsimp [nfa_to_dfa],
                rw mem_bUnion_iff,
                use [s2, s2ins1, s2go_h],
            }, {
                assumption,
            }
        },
    },
end

theorem nfa_to_dfa_eq {L : set (list S)} (hnfa : nfa_lang L) : dfa_lang L :=
begin
    rcases hnfa with ⟨Q, fQ, dQ, nfa, rfl⟩,
    letI := fQ,
    existsi [set Q, _, _, nfa_to_dfa nfa],
    ext x,
    split, {
        rintro ⟨tset, tsetgo, tsetterm⟩,
        use tset,
        rw (nfa_to_dfa_goes_to x rfl),
        simp,
        use [nfa.start],
        simp [nfa_to_dfa, tsetgo],
        exact tsetterm,
    }, {
        rintro ⟨tset, tsetgo, tsetterm⟩,
        simp only [nfa_to_dfa_goes_to x rfl, mem_set_of_eq] at tsetgo,
        rcases tsetgo with ⟨s2, s2start, s2go⟩,
        use [tset],
        simp [nfa_to_dfa] at s2start,
        subst s2start,
        use [s2go, tsetterm],
    },
end

end nfa