/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro

! This file was ported from Lean 3 source module logic.equiv.set
! leanprover-community/mathlib commit aba57d4d3dae35460225919dcd82fe91355162f9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Function
import Mathlib.Logic.Equiv.Defs

/-!
# Equivalences and sets

In this file we provide lemmas linking equivalences to sets.

Some notable definitions are:

* `Equiv.ofInjective`: an injective function is (noncomputably) equivalent to its range.
* `Equiv.setCongr`: two equal sets are equivalent as types.
* `Equiv.Set.union`: a disjoint union of sets is equivalent to their `Sum`.

This file is separate from `Equiv/Basic` such that we do not require the full lattice structure
on sets before defining what an equivalence is.
-/

open Function Set

universe u v w z

variable {α : Sort u} {β : Sort v} {γ : Sort w}

namespace Equiv

@[simp]
theorem range_eq_univ {α : Type _} {β : Type _} (e : α ≃ β) : range e = univ :=
  eq_univ_of_forall e.surjective
#align equiv.range_eq_univ Equiv.range_eq_univ

protected theorem image_eq_preimage {α β} (e : α ≃ β) (s : Set α) : e '' s = e.symm ⁻¹' s :=
  Set.ext fun _ => mem_image_iff_of_inverse e.left_inv e.right_inv
#align equiv.image_eq_preimage Equiv.image_eq_preimage

theorem _root_.Set.mem_image_equiv {α β} {S : Set α} {f : α ≃ β} {x : β} :
    x ∈ f '' S ↔ f.symm x ∈ S :=
  Set.ext_iff.mp (f.image_eq_preimage S) x
#align set.mem_image_equiv Set.mem_image_equiv

/-- Alias for `Equiv.image_eq_preimage` -/
theorem _root_.Set.image_equiv_eq_preimage_symm {α β} (S : Set α) (f : α ≃ β) :
    f '' S = f.symm ⁻¹' S :=
  f.image_eq_preimage S
#align set.image_equiv_eq_preimage_symm Set.image_equiv_eq_preimage_symm

/-- Alias for `Equiv.image_eq_preimage` -/
theorem _root_.Set.preimage_equiv_eq_image_symm {α β} (S : Set α) (f : β ≃ α) :
    f ⁻¹' S = f.symm '' S :=
  (f.symm.image_eq_preimage S).symm
#align set.preimage_equiv_eq_image_symm Set.preimage_equiv_eq_image_symm

/- Porting note: Removed `simp` attribute. LHS not in normal form -/
protected theorem subset_image {α β} (e : α ≃ β) (s : Set α) (t : Set β) :
    e.symm '' t ⊆ s ↔ t ⊆ e '' s := by rw [image_subset_iff, e.image_eq_preimage]
#align equiv.subset_image Equiv.subset_image

/- Porting note: Removed `simp` attribute. LHS not in normal form  -/
protected theorem subset_image' {α β} (e : α ≃ β) (s : Set α) (t : Set β) :
    s ⊆ e.symm '' t ↔ e '' s ⊆ t :=
  calc
    s ⊆ e.symm '' t ↔ e.symm.symm '' s ⊆ t := by rw [e.symm.subset_image]
    _ ↔ e '' s ⊆ t := by rw [e.symm_symm]

#align equiv.subset_image' Equiv.subset_image'

@[simp]
theorem symm_image_image {α β} (e : α ≃ β) (s : Set α) : e.symm '' (e '' s) = s :=
  e.leftInverse_symm.image_image s
#align equiv.symm_image_image Equiv.symm_image_image

theorem eq_image_iff_symm_image_eq {α β} (e : α ≃ β) (s : Set α) (t : Set β) :
    t = e '' s ↔ e.symm '' t = s :=
  (e.symm.injective.image_injective.eq_iff' (e.symm_image_image s)).symm
#align equiv.eq_image_iff_symm_image_eq Equiv.eq_image_iff_symm_image_eq

@[simp]
theorem image_symm_image {α β} (e : α ≃ β) (s : Set β) : e '' (e.symm '' s) = s :=
  e.symm.symm_image_image s
#align equiv.image_symm_image Equiv.image_symm_image

@[simp]
theorem image_preimage {α β} (e : α ≃ β) (s : Set β) : e '' (e ⁻¹' s) = s :=
  e.surjective.image_preimage s
#align equiv.image_preimage Equiv.image_preimage

@[simp]
theorem preimage_image {α β} (e : α ≃ β) (s : Set α) : e ⁻¹' (e '' s) = s :=
  e.injective.preimage_image s
#align equiv.preimage_image Equiv.preimage_image

protected theorem image_compl {α β} (f : Equiv α β) (s : Set α) : f '' sᶜ = (f '' s)ᶜ :=
  image_compl_eq f.bijective
#align equiv.image_compl Equiv.image_compl

@[simp]
theorem symm_preimage_preimage {α β} (e : α ≃ β) (s : Set β) : e.symm ⁻¹' (e ⁻¹' s) = s :=
  e.rightInverse_symm.preimage_preimage s
#align equiv.symm_preimage_preimage Equiv.symm_preimage_preimage

@[simp]
theorem preimage_symm_preimage {α β} (e : α ≃ β) (s : Set α) : e ⁻¹' (e.symm ⁻¹' s) = s :=
  e.leftInverse_symm.preimage_preimage s
#align equiv.preimage_symm_preimage Equiv.preimage_symm_preimage

@[simp]
theorem preimage_subset {α β} (e : α ≃ β) (s t : Set β) : e ⁻¹' s ⊆ e ⁻¹' t ↔ s ⊆ t :=
  e.surjective.preimage_subset_preimage_iff
#align equiv.preimage_subset Equiv.preimage_subset

-- Porting note: Removed `simp` attribute. `simp` can prove it.
theorem image_subset {α β} (e : α ≃ β) (s t : Set α) : e '' s ⊆ e '' t ↔ s ⊆ t :=
  image_subset_image_iff e.injective
#align equiv.image_subset Equiv.image_subset

@[simp]
theorem image_eq_iff_eq {α β} (e : α ≃ β) (s t : Set α) : e '' s = e '' t ↔ s = t :=
  image_eq_image e.injective
#align equiv.image_eq_iff_eq Equiv.image_eq_iff_eq

theorem preimage_eq_iff_eq_image {α β} (e : α ≃ β) (s t) : e ⁻¹' s = t ↔ s = e '' t :=
  Set.preimage_eq_iff_eq_image e.bijective
#align equiv.preimage_eq_iff_eq_image Equiv.preimage_eq_iff_eq_image

theorem eq_preimage_iff_image_eq {α β} (e : α ≃ β) (s t) : s = e ⁻¹' t ↔ e '' s = t :=
  Set.eq_preimage_iff_image_eq e.bijective
#align equiv.eq_preimage_iff_image_eq Equiv.eq_preimage_iff_image_eq

@[simp]
theorem prod_assoc_preimage {α β γ} {s : Set α} {t : Set β} {u : Set γ} :
    Equiv.prodAssoc α β γ ⁻¹' s ×ˢ t ×ˢ u = (s ×ˢ t) ×ˢ u := by
  ext
  simp [and_assoc]
#align equiv.prod_assoc_preimage Equiv.prod_assoc_preimage

@[simp]
theorem prod_assoc_symm_preimage {α β γ} {s : Set α} {t : Set β} {u : Set γ} :
    (Equiv.prodAssoc α β γ).symm ⁻¹' (s ×ˢ t) ×ˢ u = s ×ˢ t ×ˢ u := by
  ext
  simp [and_assoc]
#align equiv.prod_assoc_symm_preimage Equiv.prod_assoc_symm_preimage

-- `@[simp]` doesn't like these lemmas, as it uses `set.image_congr'` to turn `equiv.prod_assoc`
-- into a lambda expression and then unfold it.
theorem prod_assoc_image {α β γ} {s : Set α} {t : Set β} {u : Set γ} :
    Equiv.prodAssoc α β γ '' (s ×ˢ t) ×ˢ u = s ×ˢ t ×ˢ u := by
  simpa only [Equiv.image_eq_preimage] using prod_assoc_symm_preimage
#align equiv.prod_assoc_image Equiv.prod_assoc_image

theorem prod_assoc_symm_image {α β γ} {s : Set α} {t : Set β} {u : Set γ} :
    (Equiv.prodAssoc α β γ).symm '' s ×ˢ t ×ˢ u = (s ×ˢ t) ×ˢ u := by
  simpa only [Equiv.image_eq_preimage] using prod_assoc_preimage
#align equiv.prod_assoc_symm_image Equiv.prod_assoc_symm_image

/-- A set `s` in `α × β` is equivalent to the sigma-type `Σ x, {y | (x, y) ∈ s}`. -/
def setProdEquivSigma {α β : Type _} (s : Set (α × β)) :
    s ≃ Σx : α, { y : β | (x, y) ∈ s } where
  toFun x := ⟨x.1.1, x.1.2, by simp⟩
  invFun x := ⟨(x.1, x.2.1), x.2.2⟩
  left_inv := fun ⟨⟨x, y⟩, h⟩ => rfl
  right_inv := fun ⟨x, y, h⟩ => rfl
#align equiv.set_prod_equiv_sigma Equiv.setProdEquivSigma

/-- The subtypes corresponding to equal sets are equivalent. -/
@[simps! apply]
def setCongr {α : Type _} {s t : Set α} (h : s = t) : s ≃ t :=
  subtypeEquivProp h
#align equiv.set_congr Equiv.setCongr
#align equiv.set_congr_apply Equiv.setCongr_apply

-- We could construct this using `Equiv.Set.image e s e.injective`,
-- but this definition provides an explicit inverse.
/-- A set is equivalent to its image under an equivalence.
-/
@[simps]
def image {α β : Type _} (e : α ≃ β) (s : Set α) :
    s ≃ e '' s where
  toFun x := ⟨e x.1, by simp⟩
  invFun y :=
    ⟨e.symm y.1, by
      rcases y with ⟨-, ⟨a, ⟨m, rfl⟩⟩⟩
      simpa using m⟩
  left_inv x := by simp
  right_inv y := by simp
#align equiv.image Equiv.image
#align equiv.image_symm_apply_coe Equiv.image_symm_apply_coe
#align equiv.image_apply_coe Equiv.image_apply_coe

namespace Set

--Porting note: Removed attribute @[simps apply symm_apply]
/-- `univ α` is equivalent to `α`. -/
protected def univ (α) : @univ α ≃ α :=
  ⟨Subtype.val, fun a => ⟨a, trivial⟩, fun ⟨_, _⟩ => rfl, fun _ => rfl⟩
#align equiv.set.univ Equiv.Set.univ

/-- An empty set is equivalent to the `Empty` type. -/
protected def empty (α) : (∅ : Set α) ≃ Empty :=
  equivEmpty _
#align equiv.set.empty Equiv.Set.empty

/-- An empty set is equivalent to a `PEmpty` type. -/
protected def pempty (α) : (∅ : Set α) ≃ PEmpty :=
  equivPEmpty _
#align equiv.set.pempty Equiv.Set.pempty

/-- If sets `s` and `t` are separated by a decidable predicate, then `s ∪ t` is equivalent to
`s ⊕ t`. -/
protected def union' {α} {s t : Set α} (p : α → Prop) [DecidablePred p] (hs : ∀ x ∈ s, p x)
    (ht : ∀ x ∈ t, ¬p x) : (s ∪ t : Set α) ≃ s ⊕ t where
  toFun x :=
    if hp : p x then Sum.inl ⟨_, x.2.resolve_right fun xt => ht _ xt hp⟩
    else Sum.inr ⟨_, x.2.resolve_left fun xs => hp (hs _ xs)⟩
  invFun o :=
    match o with
    | Sum.inl x => ⟨x, Or.inl x.2⟩
    | Sum.inr x => ⟨x, Or.inr x.2⟩
  left_inv := fun ⟨x, h'⟩ => by by_cases h : p x <;> simp [h]
  right_inv o := by
    rcases o with (⟨x, h⟩ | ⟨x, h⟩) <;> [simp [hs _ h], simp [ht _ h]]
#align equiv.set.union' Equiv.Set.union'

/-- If sets `s` and `t` are disjoint, then `s ∪ t` is equivalent to `s ⊕ t`. -/
protected def union {α} {s t : Set α} [DecidablePred fun x => x ∈ s] (H : s ∩ t ⊆ ∅) :
    (s ∪ t : Set α) ≃ s ⊕ t :=
  Set.union' (fun x => x ∈ s) (fun _ => id) fun _ xt xs => H ⟨xs, xt⟩
#align equiv.set.union Equiv.Set.union

theorem union_apply_left {α} {s t : Set α} [DecidablePred fun x => x ∈ s] (H : s ∩ t ⊆ ∅)
    {a : (s ∪ t : Set α)} (ha : ↑a ∈ s) : Equiv.Set.union H a = Sum.inl ⟨a, ha⟩ :=
  dif_pos ha
#align equiv.set.union_apply_left Equiv.Set.union_apply_left

theorem union_apply_right {α} {s t : Set α} [DecidablePred fun x => x ∈ s] (H : s ∩ t ⊆ ∅)
    {a : (s ∪ t : Set α)} (ha : ↑a ∈ t) : Equiv.Set.union H a = Sum.inr ⟨a, ha⟩ :=
  dif_neg fun h => H ⟨h, ha⟩
#align equiv.set.union_apply_right Equiv.Set.union_apply_right

@[simp]
theorem union_symm_apply_left {α} {s t : Set α} [DecidablePred fun x => x ∈ s] (H : s ∩ t ⊆ ∅)
    (a : s) : (Equiv.Set.union H).symm (Sum.inl a) = ⟨a, subset_union_left _ _ a.2⟩ :=
  rfl
#align equiv.set.union_symm_apply_left Equiv.Set.union_symm_apply_left

@[simp]
theorem union_symm_apply_right {α} {s t : Set α} [DecidablePred fun x => x ∈ s] (H : s ∩ t ⊆ ∅)
    (a : t) : (Equiv.Set.union H).symm (Sum.inr a) = ⟨a, subset_union_right _ _ a.2⟩ :=
  rfl
#align equiv.set.union_symm_apply_right Equiv.Set.union_symm_apply_right

/-- A singleton set is equivalent to a `PUnit` type. -/
protected def singleton {α} (a : α) : ({a} : Set α) ≃ PUnit.{u} :=
  ⟨fun _ => PUnit.unit, fun _ => ⟨a, mem_singleton _⟩, fun ⟨x, h⟩ => by
    simp at h
    subst x
    rfl, fun ⟨⟩ => rfl⟩
#align equiv.set.singleton Equiv.Set.singleton

/-- Equal sets are equivalent.

TODO: this is the same as `Equiv.setCongr`! -/
@[simps! apply symm_apply]
protected def ofEq {α : Type u} {s t : Set α} (h : s = t) : s ≃ t :=
  Equiv.setCongr h
#align equiv.set.of_eq Equiv.Set.ofEq

/-- If `a ∉ s`, then `insert a s` is equivalent to `s ⊕ punit`. -/
protected def insert {α} {s : Set.{u} α} [DecidablePred (· ∈ s)] {a : α} (H : a ∉ s) :
    (insert a s : Set α) ≃ Sum s PUnit.{u + 1} :=
  calc
    (insert a s : Set α) ≃ ↥(s ∪ {a}) := Equiv.Set.ofEq (by simp)
    _ ≃ Sum s ({a} : Set α) := Equiv.Set.union fun x ⟨hx, _⟩ => by simp_all
    _ ≃ Sum s PUnit.{u + 1} := sumCongr (Equiv.refl _) (Equiv.Set.singleton _)

#align equiv.set.insert Equiv.Set.insert

@[simp]
theorem insert_symm_apply_inl {α} {s : Set.{u} α} [DecidablePred (· ∈ s)] {a : α} (H : a ∉ s)
    (b : s) : (Equiv.Set.insert H).symm (Sum.inl b) = ⟨b, Or.inr b.2⟩ :=
  rfl
#align equiv.set.insert_symm_apply_inl Equiv.Set.insert_symm_apply_inl

@[simp]
theorem insert_symm_apply_inr {α} {s : Set.{u} α} [DecidablePred (· ∈ s)] {a : α} (H : a ∉ s)
    (b : PUnit.{u + 1}) : (Equiv.Set.insert H).symm (Sum.inr b) = ⟨a, Or.inl rfl⟩ :=
  rfl
#align equiv.set.insert_symm_apply_inr Equiv.Set.insert_symm_apply_inr

@[simp]
theorem insert_apply_left {α} {s : Set.{u} α} [DecidablePred (· ∈ s)] {a : α} (H : a ∉ s) :
    Equiv.Set.insert H ⟨a, Or.inl rfl⟩ = Sum.inr PUnit.unit :=
  (Equiv.Set.insert H).apply_eq_iff_eq_symm_apply.2 rfl
#align equiv.set.insert_apply_left Equiv.Set.insert_apply_left

@[simp]
theorem insert_apply_right {α} {s : Set.{u} α} [DecidablePred (· ∈ s)] {a : α} (H : a ∉ s) (b : s) :
    Equiv.Set.insert H ⟨b, Or.inr b.2⟩ = Sum.inl b :=
  (Equiv.Set.insert H).apply_eq_iff_eq_symm_apply.2 rfl
#align equiv.set.insert_apply_right Equiv.Set.insert_apply_right

/-- If `s : Set α` is a set with decidable membership, then `s ⊕ sᶜ` is equivalent to `α`. -/
protected def sumCompl {α} (s : Set α) [DecidablePred (· ∈ s)] : Sum s (sᶜ : Set α) ≃ α :=
  calc
    Sum s (sᶜ : Set α) ≃ ↥(s ∪ sᶜ) := (Equiv.Set.union (by simp [Set.ext_iff])).symm
    _ ≃ @univ α := Equiv.Set.ofEq (by simp)
    _ ≃ α := Equiv.Set.univ _

#align equiv.set.sum_compl Equiv.Set.sumCompl

@[simp]
theorem sumCompl_apply_inl {α : Type u} (s : Set α) [DecidablePred (· ∈ s)] (x : s) :
    Equiv.Set.sumCompl s (Sum.inl x) = x :=
  rfl
#align equiv.set.sum_compl_apply_inl Equiv.Set.sumCompl_apply_inl

@[simp]
theorem sumCompl_apply_inr {α : Type u} (s : Set α) [DecidablePred (· ∈ s)] (x : (sᶜ : Set α)) :
    Equiv.Set.sumCompl s (Sum.inr x) = x :=
  rfl
#align equiv.set.sum_compl_apply_inr Equiv.Set.sumCompl_apply_inr

theorem sumCompl_symm_apply_of_mem {α : Type u} {s : Set α} [DecidablePred (· ∈ s)] {x : α}
    (hx : x ∈ s) : (Equiv.Set.sumCompl s).symm x = Sum.inl ⟨x, hx⟩ := by
  have : ((⟨x, Or.inl hx⟩ : (s ∪ sᶜ : Set α)) : α) ∈ s := hx
  rw [Equiv.Set.sumCompl]
  simpa using Set.union_apply_left (by simp) this
#align equiv.set.sum_compl_symm_apply_of_mem Equiv.Set.sumCompl_symm_apply_of_mem

theorem sumCompl_symm_apply_of_not_mem {α : Type u} {s : Set α} [DecidablePred (· ∈ s)] {x : α}
    (hx : x ∉ s) : (Equiv.Set.sumCompl s).symm x = Sum.inr ⟨x, hx⟩ := by
  have : ((⟨x, Or.inr hx⟩ : (s ∪ sᶜ : Set α)) : α) ∈ sᶜ := hx
  rw [Equiv.Set.sumCompl]
  simpa using Set.union_apply_right (by simp) this
#align equiv.set.sum_compl_symm_apply_of_not_mem Equiv.Set.sumCompl_symm_apply_of_not_mem

@[simp]
theorem sumCompl_symm_apply {α : Type _} {s : Set α} [DecidablePred (· ∈ s)] {x : s} :
    (Equiv.Set.sumCompl s).symm x = Sum.inl x := by
  cases' x with x hx; exact Set.sumCompl_symm_apply_of_mem hx
#align equiv.set.sum_compl_symm_apply Equiv.Set.sumCompl_symm_apply

@[simp]
theorem sumCompl_symm_apply_compl {α : Type _} {s : Set α} [DecidablePred (· ∈ s)]
    {x : (sᶜ : Set α)} : (Equiv.Set.sumCompl s).symm x = Sum.inr x := by
  cases' x with x hx; exact Set.sumCompl_symm_apply_of_not_mem hx
#align equiv.set.sum_compl_symm_apply_compl Equiv.Set.sumCompl_symm_apply_compl

/-- `sumDiffSubset s t` is the natural equivalence between
`s ⊕ (t \ s)` and `t`, where `s` and `t` are two sets. -/
protected def sumDiffSubset {α} {s t : Set α} (h : s ⊆ t) [DecidablePred (· ∈ s)] :
    Sum s (t \ s : Set α) ≃ t :=
  calc
    Sum s (t \ s : Set α) ≃ (s ∪ t \ s : Set α) :=
      (Equiv.Set.union (by simp [inter_diff_self])).symm
    _ ≃ t := Equiv.Set.ofEq (by simp [union_diff_self, union_eq_self_of_subset_left h])

#align equiv.set.sum_diff_subset Equiv.Set.sumDiffSubset

@[simp]
theorem sumDiffSubset_apply_inl {α} {s t : Set α} (h : s ⊆ t) [DecidablePred (· ∈ s)] (x : s) :
    Equiv.Set.sumDiffSubset h (Sum.inl x) = inclusion h x :=
  rfl
#align equiv.set.sum_diff_subset_apply_inl Equiv.Set.sumDiffSubset_apply_inl

@[simp]
theorem sumDiffSubset_apply_inr {α} {s t : Set α} (h : s ⊆ t) [DecidablePred (· ∈ s)]
    (x : (t \ s : Set α)) : Equiv.Set.sumDiffSubset h (Sum.inr x) = inclusion (diff_subset t s) x :=
  rfl
#align equiv.set.sum_diff_subset_apply_inr Equiv.Set.sumDiffSubset_apply_inr

theorem sumDiffSubset_symm_apply_of_mem {α} {s t : Set α} (h : s ⊆ t) [DecidablePred (· ∈ s)]
    {x : t} (hx : x.1 ∈ s) : (Equiv.Set.sumDiffSubset h).symm x = Sum.inl ⟨x, hx⟩ := by
  apply (Equiv.Set.sumDiffSubset h).injective
  simp only [apply_symm_apply, sumDiffSubset_apply_inl]
  exact Subtype.eq rfl
#align equiv.set.sum_diff_subset_symm_apply_of_mem Equiv.Set.sumDiffSubset_symm_apply_of_mem

theorem sumDiffSubset_symm_apply_of_not_mem {α} {s t : Set α} (h : s ⊆ t) [DecidablePred (· ∈ s)]
    {x : t} (hx : x.1 ∉ s) : (Equiv.Set.sumDiffSubset h).symm x = Sum.inr ⟨x, ⟨x.2, hx⟩⟩ := by
  apply (Equiv.Set.sumDiffSubset h).injective
  simp only [apply_symm_apply, sumDiffSubset_apply_inr]
  exact Subtype.eq rfl
#align equiv.set.sum_diff_subset_symm_apply_of_not_mem Equiv.Set.sumDiffSubset_symm_apply_of_not_mem

/-- If `s` is a set with decidable membership, then the sum of `s ∪ t` and `s ∩ t` is equivalent
to `s ⊕ t`. -/
protected def unionSumInter {α : Type u} (s t : Set α) [DecidablePred (· ∈ s)] :
    Sum (s ∪ t : Set α) (s ∩ t : Set α) ≃ Sum s t :=
  calc
    Sum (s ∪ t : Set α) (s ∩ t : Set α)
      ≃ Sum (s ∪ t \ s : Set α) (s ∩ t : Set α) := by rw [union_diff_self]
    _ ≃ Sum (Sum s (t \ s : Set α)) (s ∩ t : Set α) :=
      sumCongr (Set.union <| subset_empty_iff.2 (inter_diff_self _ _)) (Equiv.refl _)
    _ ≃ Sum s (Sum (t \ s : Set α) (s ∩ t : Set α)) := sumAssoc _ _ _
    _ ≃ Sum s (t \ s ∪ s ∩ t : Set α) :=
      sumCongr (Equiv.refl _)
        (by
          refine' (Set.union' (· ∉ s) _ _).symm
          exacts[fun x hx => hx.2, fun x hx => not_not_intro hx.1])
    _ ≃ Sum s t := by
      { rw [(_ : t \ s ∪ s ∩ t = t)]
        rw [union_comm, inter_comm, inter_union_diff] }

#align equiv.set.union_sum_inter Equiv.Set.unionSumInter

/-- Given an equivalence `e₀` between sets `s : Set α` and `t : Set β`, the set of equivalences
`e : α ≃ β` such that `e ↑x = ↑(e₀ x)` for each `x : s` is equivalent to the set of equivalences
between `sᶜ` and `tᶜ`. -/
protected def compl {α : Type u} {β : Type v} {s : Set α} {t : Set β} [DecidablePred (· ∈ s)]
    [DecidablePred (· ∈ t)] (e₀ : s ≃ t) :
    { e : α ≃ β // ∀ x : s, e x = e₀ x } ≃ ((sᶜ : Set α) ≃ (tᶜ : Set β)) where
  toFun e :=
    subtypeEquiv e fun a =>
      not_congr <|
        Iff.symm <|
          MapsTo.mem_iff (mapsTo_iff_exists_map_subtype.2 ⟨e₀, e.2⟩)
            (SurjOn.mapsTo_compl
              (surjOn_iff_exists_map_subtype.2 ⟨t, e₀, Subset.refl t, e₀.surjective, e.2⟩)
              e.1.injective)
  invFun e₁ :=
    Subtype.mk
      (calc
        α ≃ Sum s (sᶜ : Set α) := (Set.sumCompl s).symm
        _ ≃ Sum t (tᶜ : Set β) := e₀.sumCongr e₁
        _ ≃ β := Set.sumCompl t
        )
      fun x => by
      simp only [Sum.map_inl, trans_apply, sumCongr_apply, Set.sumCompl_apply_inl,
        Set.sumCompl_symm_apply, Trans.trans]
  left_inv e := by
    ext x
    by_cases hx : x ∈ s
    · simp only [Set.sumCompl_symm_apply_of_mem hx, ← e.prop ⟨x, hx⟩, Sum.map_inl, sumCongr_apply,
        trans_apply, Subtype.coe_mk, Set.sumCompl_apply_inl, Trans.trans]
    · simp only [Set.sumCompl_symm_apply_of_not_mem hx, Sum.map_inr, subtypeEquiv_apply,
        Set.sumCompl_apply_inr, trans_apply, sumCongr_apply, Subtype.coe_mk, Trans.trans]
  right_inv e :=
    Equiv.ext fun x => by
      simp only [Sum.map_inr, subtypeEquiv_apply, Set.sumCompl_apply_inr, Function.comp_apply,
        sumCongr_apply, Equiv.coe_trans, Subtype.coe_eta, Subtype.coe_mk, Trans.trans,
        Set.sumCompl_symm_apply_compl]
#align equiv.set.compl Equiv.Set.compl

/-- The set product of two sets is equivalent to the type product of their coercions to types. -/
protected def prod {α β} (s : Set α) (t : Set β) : ↥(s ×ˢ t) ≃ s × t :=
  @subtypeProdEquivProd α β s t
#align equiv.set.prod Equiv.Set.prod

/-- The set `Set.pi Set.univ s` is equivalent to `Π a, s a`. -/
@[simps]
protected def univPi {α : Type _} {β : α → Type _} (s : ∀ a, Set (β a)) :
    pi univ s ≃ ∀ a, s a where
  toFun f a := ⟨(f : ∀ a, β a) a, f.2 a (mem_univ a)⟩
  invFun f := ⟨fun a => f a, fun a _ => (f a).2⟩
  left_inv := fun ⟨f, hf⟩ => by
    ext a
    rfl
  right_inv f := by
    ext a
    rfl
#align equiv.set.univ_pi Equiv.Set.univPi
#align equiv.set.univ_pi_symm_apply_coe Equiv.Set.univPi_symm_apply_coe
#align equiv.set.univ_pi_apply_coe Equiv.Set.univPi_apply_coe

/-- If a function `f` is injective on a set `s`, then `s` is equivalent to `f '' s`. -/
protected noncomputable def imageOfInjOn {α β} (f : α → β) (s : Set α) (H : InjOn f s) :
    s ≃ f '' s :=
  ⟨fun p => ⟨f p, mem_image_of_mem f p.2⟩, fun p =>
    ⟨Classical.choose p.2, (Classical.choose_spec p.2).1⟩, fun ⟨_, h⟩ =>
    Subtype.eq
      (H (Classical.choose_spec (mem_image_of_mem f h)).1 h
        (Classical.choose_spec (mem_image_of_mem f h)).2),
    fun ⟨_, h⟩ => Subtype.eq (Classical.choose_spec h).2⟩
#align equiv.set.image_of_inj_on Equiv.Set.imageOfInjOn

/-- If `f` is an injective function, then `s` is equivalent to `f '' s`. -/
@[simps! apply]
protected noncomputable def image {α β} (f : α → β) (s : Set α) (H : Injective f) : s ≃ f '' s :=
  Equiv.Set.imageOfInjOn f s (H.injOn s)
#align equiv.set.image Equiv.Set.image
#align equiv.set.image_apply Equiv.Set.image_apply

@[simp]
protected theorem image_symm_apply {α β} (f : α → β) (s : Set α) (H : Injective f) (x : α)
    (h : x ∈ s) : (Set.image f s H).symm ⟨f x, ⟨x, ⟨h, rfl⟩⟩⟩ = ⟨x, h⟩ := by
  apply (Set.image f s H).injective
  simp [(Set.image f s H).apply_symm_apply]
#align equiv.set.image_symm_apply Equiv.Set.image_symm_apply

theorem image_symm_preimage {α β} {f : α → β} (hf : Injective f) (u s : Set α) :
    (fun x => (Set.image f s hf).symm x : f '' s → α) ⁻¹' u = Subtype.val ⁻¹' (f '' u) := by
  ext ⟨b, a, has, rfl⟩
  have : ∀ h : ∃ a', a' ∈ s ∧ a' = a, Classical.choose h = a := fun h => (Classical.choose_spec h).2
  simp [Equiv.Set.image, Equiv.Set.imageOfInjOn, hf.eq_iff, this]
#align equiv.set.image_symm_preimage Equiv.Set.image_symm_preimage

/-- If `α` is equivalent to `β`, then `Set α` is equivalent to `Set β`. -/
@[simps]
protected def congr {α β : Type _} (e : α ≃ β) : Set α ≃ Set β :=
  ⟨fun s => e '' s, fun t => e.symm '' t, symm_image_image e, symm_image_image e.symm⟩
#align equiv.set.congr Equiv.Set.congr
#align equiv.set.congr_apply Equiv.Set.congr_apply
#align equiv.set.congr_symm_apply Equiv.Set.congr_symm_apply

/-- The set `{x ∈ s | t x}` is equivalent to the set of `x : s` such that `t x`. -/
protected def sep {α : Type u} (s : Set α) (t : α → Prop) :
    ({ x ∈ s | t x } : Set α) ≃ { x : s | t x } :=
  (Equiv.subtypeSubtypeEquivSubtypeInter s t).symm
#align equiv.set.sep Equiv.Set.sep

/-- The set `𝒫 S := {x | x ⊆ S}` is equivalent to the type `Set S`. -/
protected def powerset {α} (S : Set α) :
    𝒫 S ≃ Set S where
  toFun := fun x : 𝒫 S => Subtype.val ⁻¹' (x : Set α)
  invFun := fun x : Set S => ⟨Subtype.val '' x, by rintro _ ⟨a : S, _, rfl⟩; exact a.2⟩
  left_inv x := by ext y;exact ⟨fun ⟨⟨_, _⟩, h, rfl⟩ => h, fun h => ⟨⟨_, x.2 h⟩, h, rfl⟩⟩
  right_inv x := by ext; simp
#align equiv.set.powerset Equiv.Set.powerset

/-- If `s` is a set in `range f`,
then its image under `rangeSplitting f` is in bijection (via `f`) with `s`.
-/
@[simps]
noncomputable def rangeSplittingImageEquiv {α β : Type _} (f : α → β) (s : Set (range f)) :
    rangeSplitting f '' s ≃ s where
  toFun x :=
    ⟨⟨f x, by simp⟩, by
      rcases x with ⟨x, ⟨y, ⟨m, rfl⟩⟩⟩
      simpa [apply_rangeSplitting f] using m⟩
  invFun x := ⟨rangeSplitting f x, ⟨x, ⟨x.2, rfl⟩⟩⟩
  left_inv x := by
    rcases x with ⟨x, ⟨y, ⟨m, rfl⟩⟩⟩
    simp [apply_rangeSplitting f]
  right_inv x := by simp [apply_rangeSplitting f]
#align equiv.set.range_splitting_image_equiv Equiv.Set.rangeSplittingImageEquiv
#align equiv.set.range_splitting_image_equiv_symm_apply_coe Equiv.Set.rangeSplittingImageEquiv_symm_apply_coe
#align equiv.set.range_splitting_image_equiv_apply_coe_coe Equiv.Set.rangeSplittingImageEquiv_apply_coe_coe

/-- Equivalence between the range of `Sum.inl : α → α ⊕ β` and `α`. -/
@[simps symm_apply_coe]
def rangeInl (α β : Type _) : Set.range (Sum.inl : α → α ⊕ β) ≃ α where
  toFun
  | ⟨.inl x, _⟩ => x
  | ⟨.inr _, h⟩ => False.elim <| by rcases h with ⟨x, h'⟩; cases h'
  invFun x := ⟨.inl x, mem_range_self _⟩
  left_inv := fun ⟨_, _, rfl⟩ => rfl
  right_inv x := rfl

@[simp] lemma rangeInl_apply_inl {α : Type _} (β : Type _) (x : α) :
    (rangeInl α β) ⟨.inl x, mem_range_self _⟩ = x :=
  rfl

/-- Equivalence between the range of `Sum.inr : β → α ⊕ β` and `β`. -/
@[simps symm_apply_coe]
def rangeInr (α β : Type _) : Set.range (Sum.inr : β → α ⊕ β) ≃ β where
  toFun
  | ⟨.inl _, h⟩ => False.elim <| by rcases h with ⟨x, h'⟩; cases h'
  | ⟨.inr x, _⟩ => x
  invFun x := ⟨.inr x, mem_range_self _⟩
  left_inv := fun ⟨_, _, rfl⟩ => rfl
  right_inv x := rfl

@[simp] lemma rangeInr_apply_inr (α : Type _) {β : Type _} (x : β) :
    (rangeInr α β) ⟨.inr x, mem_range_self _⟩ = x :=
  rfl

end Set

/-- If `f : α → β` has a left-inverse when `α` is nonempty, then `α` is computably equivalent to the
range of `f`.

While awkward, the `Nonempty α` hypothesis on `f_inv` and `hf` allows this to be used when `α` is
empty too. This hypothesis is absent on analogous definitions on stronger `Equiv`s like
`LinearEquiv.ofLeftInverse` and `RingEquiv.ofLeftInverse` as their typeclass assumptions
are already sufficient to ensure non-emptiness. -/
@[simps]
def ofLeftInverse {α β : Sort _} (f : α → β) (f_inv : Nonempty α → β → α)
    (hf : ∀ h : Nonempty α, LeftInverse (f_inv h) f) :
    α ≃ range f where
  toFun a := ⟨f a, a, rfl⟩
  invFun b := f_inv (nonempty_of_exists b.2) b
  left_inv a := hf ⟨a⟩ a
  right_inv := fun ⟨b, a, ha⟩ =>
    Subtype.eq <| show f (f_inv ⟨a⟩ b) = b from Eq.trans (congr_arg f <| ha ▸ hf _ a) ha
#align equiv.of_left_inverse Equiv.ofLeftInverse
#align equiv.of_left_inverse_apply_coe Equiv.ofLeftInverse_apply_coe
#align equiv.of_left_inverse_symm_apply Equiv.ofLeftInverse_symm_apply

/-- If `f : α → β` has a left-inverse, then `α` is computably equivalent to the range of `f`.

Note that if `α` is empty, no such `f_inv` exists and so this definition can't be used, unlike
the stronger but less convenient `ofLeftInverse`. -/
abbrev ofLeftInverse' {α β : Sort _} (f : α → β) (f_inv : β → α) (hf : LeftInverse f_inv f) :
    α ≃ range f :=
  ofLeftInverse f (fun _ => f_inv) fun _ => hf
#align equiv.of_left_inverse' Equiv.ofLeftInverse'

/-- If `f : α → β` is an injective function, then domain `α` is equivalent to the range of `f`. -/
@[simps! apply]
noncomputable def ofInjective {α β} (f : α → β) (hf : Injective f) : α ≃ range f :=
  Equiv.ofLeftInverse f (fun _ => Function.invFun f) fun _ => Function.leftInverse_invFun hf
#align equiv.of_injective Equiv.ofInjective
#align equiv.of_injective_apply Equiv.ofInjective_apply

theorem apply_ofInjective_symm {α β} {f : α → β} (hf : Injective f) (b : range f) :
    f ((ofInjective f hf).symm b) = b :=
  Subtype.ext_iff.1 <| (ofInjective f hf).apply_symm_apply b
#align equiv.apply_of_injective_symm Equiv.apply_ofInjective_symm

@[simp]
theorem ofInjective_symm_apply {α β} {f : α → β} (hf : Injective f) (a : α) :
    (ofInjective f hf).symm ⟨f a, ⟨a, rfl⟩⟩ = a := by
  apply (ofInjective f hf).injective
  simp [apply_ofInjective_symm hf]
#align equiv.of_injective_symm_apply Equiv.ofInjective_symm_apply

theorem coe_ofInjective_symm {α β} {f : α → β} (hf : Injective f) :
    ((ofInjective f hf).symm : range f → α) = rangeSplitting f := by
  ext ⟨y, x, rfl⟩
  apply hf
  simp [apply_rangeSplitting f]
#align equiv.coe_of_injective_symm Equiv.coe_ofInjective_symm

@[simp]

theorem ofLeftInverse_eq_ofInjective {α β : Type _} (f : α → β) (f_inv : Nonempty α → β → α)
    (hf : ∀ h : Nonempty α, LeftInverse (f_inv h) f) :
    ofLeftInverse f f_inv hf =
      ofInjective f ((isEmpty_or_nonempty α).elim (fun h _ _ _ => Subsingleton.elim _ _)
        (fun h => (hf h).injective)) := by
  ext
  simp
#align equiv.of_left_inverse_eq_of_injective Equiv.ofLeftInverse_eq_ofInjective

theorem ofLeftInverse'_eq_ofInjective {α β : Type _} (f : α → β) (f_inv : β → α)
    (hf : LeftInverse f_inv f) : ofLeftInverse' f f_inv hf = ofInjective f hf.injective := by
  ext
  simp
#align equiv.of_left_inverse'_eq_of_injective Equiv.ofLeftInverse'_eq_ofInjective

protected theorem set_forall_iff {α β} (e : α ≃ β) {p : Set α → Prop} :
    (∀ a, p a) ↔ ∀ a, p (e ⁻¹' a) :=
  e.injective.preimage_surjective.forall
#align equiv.set_forall_iff Equiv.set_forall_iff

theorem preimage_piEquivPiSubtypeProd_symm_pi {α : Type _} {β : α → Type _} (p : α → Prop)
    [DecidablePred p] (s : ∀ i, Set (β i)) :
    (piEquivPiSubtypeProd p β).symm ⁻¹' pi univ s =
      (pi univ fun i : { i // p i } => s i) ×ˢ pi univ fun i : { i // ¬p i } => s i := by
  ext ⟨f, g⟩
  simp only [mem_preimage, mem_univ_pi, prod_mk_mem_set_prod_eq, Subtype.forall, ← forall_and]
  refine' forall_congr' fun i => _
  dsimp only [Subtype.coe_mk]
  -- Porting note: Two lines below were `by_cases hi <;> simp [hi]`
  by_cases hi : p i
  . simp [forall_prop_of_true hi, forall_prop_of_false (not_not.2 hi), hi]
  . simp [forall_prop_of_false hi, hi, forall_prop_of_true hi]
#align equiv.preimage_pi_equiv_pi_subtype_prod_symm_pi Equiv.preimage_piEquivPiSubtypeProd_symm_pi

-- See also `Equiv.sigmaFiberEquiv`.
/-- `sigmaPreimageEquiv f` for `f : α → β` is the natural equivalence between
the type of all preimages of points under `f` and the total space `α`. -/
@[simps!]
def sigmaPreimageEquiv {α β} (f : α → β) : (Σb, f ⁻¹' {b}) ≃ α :=
  sigmaFiberEquiv f
#align equiv.sigma_preimage_equiv Equiv.sigmaPreimageEquiv
#align equiv.sigma_preimage_equiv_symm_apply_snd_coe Equiv.sigmaPreimageEquiv_symm_apply_snd_coe
#align equiv.sigma_preimage_equiv_apply Equiv.sigmaPreimageEquiv_apply
#align equiv.sigma_preimage_equiv_symm_apply_fst Equiv.sigmaPreimageEquiv_symm_apply_fst

-- See also `Equiv.ofFiberEquiv`.
/-- A family of equivalences between preimages of points gives an equivalence between domains. -/
@[simps!]
def ofPreimageEquiv {α β γ} {f : α → γ} {g : β → γ} (e : ∀ c, f ⁻¹' {c} ≃ g ⁻¹' {c}) : α ≃ β :=
  Equiv.ofFiberEquiv e
#align equiv.of_preimage_equiv Equiv.ofPreimageEquiv
#align equiv.of_preimage_equiv_apply Equiv.ofPreimageEquiv_apply
#align equiv.of_preimage_equiv_symm_apply Equiv.ofPreimageEquiv_symm_apply

theorem ofPreimageEquiv_map {α β γ} {f : α → γ} {g : β → γ} (e : ∀ c, f ⁻¹' {c} ≃ g ⁻¹' {c})
    (a : α) : g (ofPreimageEquiv e a) = f a :=
  Equiv.ofFiberEquiv_map e a
#align equiv.of_preimage_equiv_map Equiv.ofPreimageEquiv_map

end Equiv

/-- If a function is a bijection between two sets `s` and `t`, then it induces an
equivalence between the types `↥s` and `↥t`. -/
noncomputable def Set.BijOn.equiv {α : Type _} {β : Type _} {s : Set α} {t : Set β} (f : α → β)
    (h : BijOn f s t) : s ≃ t :=
  Equiv.ofBijective _ h.bijective
#align set.bij_on.equiv Set.BijOn.equiv

/-- The composition of an updated function with an equiv on a subset can be expressed as an
updated function. -/
theorem dite_comp_equiv_update {α : Type _} {β : Sort _} {γ : Sort _} {s : Set α} (e : β ≃ s)
    (v : β → γ) (w : α → γ) (j : β) (x : γ) [DecidableEq β] [DecidableEq α]
    [∀ j, Decidable (j ∈ s)] :
    (fun i : α => if h : i ∈ s then (Function.update v j x) (e.symm ⟨i, h⟩) else w i) =
      Function.update (fun i : α => if h : i ∈ s then v (e.symm ⟨i, h⟩) else w i) (e j) x := by
  ext i
  by_cases h : i ∈ s
  · rw [dif_pos h, Function.update_apply_equiv_apply, Equiv.symm_symm,
      Function.update_apply, Function.update_apply, dif_pos h]
    have h_coe : (⟨i, h⟩ : s) = e j ↔ i = e j := Subtype.ext_iff.trans (by rw [Subtype.coe_mk])
    simp [h_coe]
  · have : i ≠ e j := by
      contrapose! h
      have : (e j : α) ∈ s := (e j).2
      rwa [← h] at this
    simp [h, this]
#align dite_comp_equiv_update dite_comp_equiv_update


import data.polynomial.div
import data.polynomial.field_division
import algebra.polynomial.big_operators

open_locale big_operators

section

universes u

parameter {F : Type u}
parameter [field F]

 -- /-- t is the polynomial divisibility by which is used to verify satisfaction of the SSP -/
-- def t : polynomial R := ∏ i in (finset.fin_range m), (polynomial.X - polynomial.C (r i))
-- TODO this and the following lemmas about this could potentially be spun off
-- make a `monic_from_roots` function for mathlib

/-- t has degree m -/
lemma nat_degree_product_form (m : ℕ) (f : fin m → F) :
  polynomial.nat_degree (∏ i : fin m in finset.univ, (polynomial.X - polynomial.C (f i))) = m :=
begin
  -- rw t,
  rw polynomial.nat_degree_prod,
  simp,
  intros i hi,
  exact polynomial.X_sub_C_ne_zero (f i),
end

lemma monic_of_product_form (m : ℕ) (f : fin m → F) :
  (∏ i : fin m in finset.univ, (polynomial.X - polynomial.C (f i))).monic :=
begin
  apply polynomial.monic_prod_of_monic,
  intros i hi,
  exact polynomial.monic_X_sub_C (f i),
end

end


import MultiplicationWorld.Level1
import MultiplicationWorld.Level2
import MultiplicationWorld.Level3
import MultiplicationWorld.Level4
import MultiplicationWorld.Level5
import MultiplicationWorld.Level6
import MultiplicationWorld.Level7
import MultiplicationWorld.Level8
import MultiplicationWorld.Level9
/-!
# Multiplication World

A new import `import MyNat.Multiplication`!

This import gives you the definition of multiplication on your natural numbers. It is defined by
recursion, just like addition. Here are the two new axioms:

  * `mul_zero (a : MyNat) : a * 0 = 0`
  * `mul_succ (a b : MyNat) : a * succ b = a * b + a`

In words, we define multiplication by "induction on the second variable", with `a * 0` defined to be
`0` and, if we know `a * b`, then `a` times the number after `b` is defined to be `a * b + a`.

You can keep all the theorems you proved about addition, but for multiplication, those two results
above are what you've got right now.

What's going on in multiplication world? Like addition, we need to go for the proofs that
multiplication is commutative and associative, but as well as that we will need to prove facts about
the relationship between multiplication and addition, for example `a * (b + c) = a * b + a * c`, so
now there is a lot more to do. Good luck!

You have been given `mul_zero`, and the first thing to prove is `zero_mul`.
Like `zero_add`, we of course prove it by induction.

Let's get started with  [Multiplication Level 1](./MultiplicationWorld/Level1.lean.md).
-/


/-
Copyright (c) 2021 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/

import topology.algebra.valuation
import topology.algebra.with_zero_topology
import topology.algebra.uniform_field

/-!
# Valued fields and their completions

In this file we study the topology of a field `K` endowed with a valuation (in our application
to adic spaces, `K` will be the valuation field associated to some valuation on a ring, defined in
valuation.basic).

We already know from valuation.topology that one can build a topology on `K` which
makes it a topological ring.

The first goal is to show `K` is a topological *field*, ie inversion is continuous
at every non-zero element.

The next goal is to prove `K` is a *completable* topological field. This gives us
a completion `hat K` which is a topological field. We also prove that `K` is automatically
separated, so the map from `K` to `hat K` is injective.

Then we extend the valuation given on `K` to a valuation on `hat K`.
-/

open filter set
open_locale topological_space

section division_ring

variables {K : Type*} [division_ring K] {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]

section valuation_topological_division_ring

section inversion_estimate
variables (v : valuation K Γ₀)

-- The following is the main technical lemma ensuring that inversion is continuous
-- in the topology induced by a valuation on a division ring (ie the next instance)
-- and the fact that a valued field is completable
-- [BouAC, VI.5.1 Lemme 1]
lemma valuation.inversion_estimate {x y : K} {γ : Γ₀ˣ} (y_ne : y ≠ 0)
  (h : v (x - y) < min (γ * ((v y) * (v y))) (v y)) :
  v (x⁻¹ - y⁻¹) < γ :=
begin
  have hyp1 : v (x - y) < γ * ((v y) * (v y)),
    from lt_of_lt_of_le h (min_le_left _ _),
  have hyp1' : v (x - y) * ((v y) * (v y))⁻¹ < γ,
    from mul_inv_lt_of_lt_mul₀ hyp1,
  have hyp2 : v (x - y) < v y,
    from lt_of_lt_of_le h (min_le_right _ _),
  have key : v x = v y, from valuation.map_eq_of_sub_lt v hyp2,
  have x_ne : x ≠ 0,
  { intro h,
    apply y_ne,
    rw [h, v.map_zero] at key,
    exact v.zero_iff.1 key.symm },
  have decomp : x⁻¹ - y⁻¹ = x⁻¹ * (y - x) * y⁻¹,
  by rw [mul_sub_left_distrib, sub_mul, mul_assoc,
        show y * y⁻¹ = 1, from mul_inv_cancel y_ne,
        show x⁻¹ * x = 1, from inv_mul_cancel x_ne, mul_one, one_mul],
  calc
    v (x⁻¹ - y⁻¹) = v (x⁻¹ * (y - x) * y⁻¹) : by rw decomp
    ... = (v x⁻¹) * (v $ y - x) * (v y⁻¹) : by repeat { rw valuation.map_mul }
    ... = (v x)⁻¹ * (v $ y - x) * (v y)⁻¹ : by rw [v.map_inv, v.map_inv]
    ... = (v $ y - x) * ((v y) * (v y))⁻¹ : by
      { rw [mul_assoc, mul_comm, key, mul_assoc, mul_inv_rev₀] }
    ... = (v $ y - x) * ((v y) * (v y))⁻¹ : rfl
    ... = (v $ x - y) * ((v y) * (v y))⁻¹ : by rw valuation.map_sub_swap
    ... < γ : hyp1',
end
end inversion_estimate

open valued

/-- The topology coming from a valuation on a division ring makes it a topological division ring
    [BouAC, VI.5.1 middle of Proposition 1] -/
@[priority 100]
instance valued.topological_division_ring [valued K Γ₀] : topological_division_ring K :=
{ continuous_at_inv₀ :=
    begin
      intros x x_ne s s_in,
      cases valued.mem_nhds.mp s_in with γ hs, clear s_in,
      rw [mem_map, valued.mem_nhds],
      change ∃ (γ : Γ₀ˣ), {y : K | (v (y - x) : Γ₀) < γ} ⊆ {x : K | x⁻¹ ∈ s},
      have vx_ne := (valuation.ne_zero_iff $ v).mpr x_ne,
      let γ' := units.mk0 _ vx_ne,
      use min (γ * (γ'*γ')) γ',
      intros y y_in,
      apply hs,
      simp only [mem_set_of_eq] at y_in,
      rw [units.min_coe, units.coe_mul, units.coe_mul] at y_in,
      exact valuation.inversion_estimate _ x_ne y_in
    end,
  ..(by apply_instance : topological_ring K) }

/-- A valued division ring is separated. -/
@[priority 100]
instance valued_ring.separated [valued K Γ₀] : separated_space K :=
begin
  apply topological_add_group.separated_of_zero_sep,
  intros x x_ne,
  refine ⟨{k | v k < v x}, _, λ h, lt_irrefl _ h⟩,
  rw valued.mem_nhds,
  have vx_ne := (valuation.ne_zero_iff $ v).mpr x_ne,
  let γ' := units.mk0 _ vx_ne,
  exact ⟨γ', λ y hy, by simpa using hy⟩,
end

section
local attribute [instance] linear_ordered_comm_group_with_zero.topological_space

open valued

lemma valued.continuous_valuation [valued K Γ₀] : continuous (v : K → Γ₀) :=
begin
  rw continuous_iff_continuous_at,
  intro x,
  classical,
  by_cases h : x = 0,
  { rw h,
    change tendsto _ _ (𝓝 (v (0 : K))),
    erw valuation.map_zero,
    rw linear_ordered_comm_group_with_zero.tendsto_zero,
    intro γ,
    rw valued.mem_nhds_zero,
    use [γ, set.subset.refl _] },
  { change tendsto _ _ _,
    have v_ne : (v x : Γ₀) ≠ 0, from (valuation.ne_zero_iff _).mpr h,
    rw linear_ordered_comm_group_with_zero.tendsto_of_ne_zero v_ne,
    apply valued.loc_const v_ne },
end
end

end valuation_topological_division_ring

end division_ring

section valuation_on_valued_field_completion
open uniform_space

variables {K : Type*} [field K] {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]
  [hv: valued K Γ₀]

include hv

open valued uniform_space

local notation `hat ` := completion

/-- A valued field is completable. -/
@[priority 100]
instance valued.completable : completable_top_field K :=
{ nice := begin
    rintros F hF h0,
    have : ∃ (γ₀ : Γ₀ˣ) (M ∈ F), ∀ x ∈ M, (γ₀ : Γ₀) ≤ v x,
    { rcases filter.inf_eq_bot_iff.mp h0 with ⟨U, U_in, M, M_in, H⟩,
      rcases valued.mem_nhds_zero.mp U_in with ⟨γ₀, hU⟩,
      existsi [γ₀, M, M_in],
      intros x xM,
      apply le_of_not_lt _,
      intro hyp,
      have : x ∈ U ∩ M := ⟨hU hyp, xM⟩,
      rwa H at this },
    rcases this with ⟨γ₀, M₀, M₀_in, H₀⟩,
    rw valued.cauchy_iff at hF ⊢,
    refine ⟨hF.1.map _, _⟩,
    replace hF := hF.2,
    intros γ,
    rcases hF (min (γ * γ₀ * γ₀) γ₀) with ⟨M₁, M₁_in, H₁⟩, clear hF,
    use (λ x : K, x⁻¹) '' (M₀ ∩ M₁),
    split,
    { rw mem_map,
      apply mem_of_superset (filter.inter_mem M₀_in M₁_in),
      exact subset_preimage_image _ _ },
    { rintros _ ⟨x, ⟨x_in₀, x_in₁⟩, rfl⟩ _ ⟨y, ⟨y_in₀, y_in₁⟩, rfl⟩,
      simp only [mem_set_of_eq],
      specialize H₁ x x_in₁ y y_in₁,
      replace x_in₀ := H₀ x x_in₀,
      replace y_in₀ := H₀ y y_in₀, clear H₀,
      apply valuation.inversion_estimate,
      { have : (v x : Γ₀) ≠ 0,
        { intro h, rw h at x_in₀, simpa using x_in₀, },
        exact (valuation.ne_zero_iff _).mp this },
      { refine lt_of_lt_of_le H₁ _,
        rw units.min_coe,
        apply min_le_min _ x_in₀,
        rw mul_assoc,
        have : ((γ₀ * γ₀ : Γ₀ˣ) : Γ₀) ≤ v x * v x,
          from calc ↑γ₀ * ↑γ₀ ≤ ↑γ₀ * v x : mul_le_mul_left' x_in₀ ↑γ₀
                          ... ≤ _ : mul_le_mul_right' x_in₀ (v x),
        rw units.coe_mul,
        exact mul_le_mul_left' this γ } }
  end,
  ..valued_ring.separated }

local attribute [instance] linear_ordered_comm_group_with_zero.topological_space

/-- The extension of the valuation of a valued field to the completion of the field. -/
noncomputable def valued.extension : hat K → Γ₀ :=
completion.dense_inducing_coe.extend (v : K → Γ₀)

lemma valued.continuous_extension : continuous (valued.extension : hat K → Γ₀) :=
 begin
  refine completion.dense_inducing_coe.continuous_extend _,
  intro x₀,
  by_cases h : x₀ = coe 0,
  { refine ⟨0, _⟩,
    erw [h, ← completion.dense_inducing_coe.to_inducing.nhds_eq_comap]; try { apply_instance },
    rw linear_ordered_comm_group_with_zero.tendsto_zero,
    intro γ₀,
    rw valued.mem_nhds,
    exact ⟨γ₀, by simp⟩ },
  { have preimage_one : v ⁻¹' {(1 : Γ₀)} ∈ 𝓝 (1 : K),
    { have : (v (1 : K) : Γ₀) ≠ 0, { rw valuation.map_one, exact zero_ne_one.symm },
      convert valued.loc_const this,
      ext x,
      rw [valuation.map_one, mem_preimage, mem_singleton_iff, mem_set_of_eq] },
    obtain ⟨V, V_in, hV⟩ : ∃ V ∈ 𝓝 (1 : hat K), ∀ x : K, (x : hat K) ∈ V → (v x : Γ₀) = 1,
    { rwa [completion.dense_inducing_coe.nhds_eq_comap, mem_comap] at preimage_one },

    have : ∃ V' ∈ (𝓝 (1 : hat K)), (0 : hat K) ∉ V' ∧ ∀ x y ∈ V', x*y⁻¹ ∈ V,
    { have : tendsto (λ p : hat K × hat K, p.1*p.2⁻¹) ((𝓝 1).prod (𝓝 1)) (𝓝 1),
      { rw ← nhds_prod_eq,
        conv {congr, skip, skip, rw ← (one_mul (1 : hat K))},
        refine tendsto.mul continuous_fst.continuous_at
                           (tendsto.comp _ continuous_snd.continuous_at),
        convert continuous_at_inv₀ (zero_ne_one.symm : 1 ≠ (0 : hat K)),
        exact inv_one.symm },
      rcases tendsto_prod_self_iff.mp this V V_in with ⟨U, U_in, hU⟩,
      let hatKstar := ({0}ᶜ : set $ hat K),
      have : hatKstar ∈ 𝓝 (1 : hat K),
      from compl_singleton_mem_nhds zero_ne_one.symm,
      use  [U ∩ hatKstar, filter.inter_mem U_in this],
      split,
      { rintro ⟨h, h'⟩,
        rw mem_compl_singleton_iff at h',
        exact h' rfl },
      { rintros x ⟨hx, _⟩ y ⟨hy, _⟩,
        apply hU ; assumption } },
    rcases this with ⟨V', V'_in, zeroV', hV'⟩,
    have nhds_right : (λ x, x*x₀) '' V' ∈ 𝓝 x₀,
    { have l : function.left_inverse (λ x : hat K, x * x₀⁻¹) (λ x : hat K, x * x₀),
      { intro x,
        simp only [mul_assoc, mul_inv_cancel h, mul_one] },
      have r: function.right_inverse (λ x : hat K, x * x₀⁻¹) (λ x : hat K, x * x₀),
      { intro x,
        simp only [mul_assoc, inv_mul_cancel h, mul_one] },
      have c : continuous  (λ x : hat K, x * x₀⁻¹),
        from continuous_id.mul continuous_const,
      rw image_eq_preimage_of_inverse l r,
      rw ← mul_inv_cancel h at V'_in,
      exact c.continuous_at V'_in },
    have : ∃ (z₀ : K) (y₀ ∈ V'), coe z₀ = y₀*x₀ ∧ z₀ ≠ 0,
    { rcases completion.dense_range_coe.mem_nhds nhds_right with ⟨z₀, y₀, y₀_in, H : y₀ * x₀ = z₀⟩,
      refine ⟨z₀, y₀, y₀_in, ⟨H.symm, _⟩⟩,
      rintro rfl,
      exact mul_ne_zero (ne_of_mem_of_not_mem y₀_in zeroV') h H },
    rcases this with ⟨z₀, y₀, y₀_in, hz₀, z₀_ne⟩,
    have vz₀_ne: (v z₀ : Γ₀) ≠ 0 := by rwa valuation.ne_zero_iff,
    refine ⟨v z₀, _⟩,
    rw [linear_ordered_comm_group_with_zero.tendsto_of_ne_zero vz₀_ne, mem_comap],
    use [(λ x, x*x₀) '' V', nhds_right],
    intros x x_in,
    rcases mem_preimage.1 x_in with ⟨y, y_in, hy⟩, clear x_in,
    change y*x₀ = coe x at hy,
    have : (v (x*z₀⁻¹) : Γ₀) = 1,
    { apply hV,
      have : ((z₀⁻¹ : K) : hat K) = z₀⁻¹,
      from ring_hom.map_inv (completion.coe_ring_hom : K →+* hat K) z₀,
      rw [completion.coe_mul, this, ← hy, hz₀, mul_inv₀, mul_comm y₀⁻¹, ← mul_assoc, mul_assoc y,
          mul_inv_cancel h, mul_one],
      solve_by_elim },
    calc v x = v (x*z₀⁻¹*z₀) : by rw [mul_assoc, inv_mul_cancel z₀_ne, mul_one]
         ... = v (x*z₀⁻¹)*v z₀ : valuation.map_mul _ _ _
         ... = v z₀ : by rw [this, one_mul]  },
end

@[norm_cast]
lemma valued.extension_extends (x : K) : (valued.extension (x : hat K) : Γ₀) = v x :=
begin
  haveI : t2_space Γ₀ := regular_space.t2_space _,
  refine completion.dense_inducing_coe.extend_eq_of_tendsto _,
  rw ← completion.dense_inducing_coe.nhds_eq_comap,
  exact valued.continuous_valuation.continuous_at,
end

/-- the extension of a valuation on a division ring to its completion. -/
noncomputable def valued.extension_valuation :
  valuation (hat K) Γ₀ :=
{ to_fun := valued.extension,
  map_zero' := by { rw [← v.map_zero, ← valued.extension_extends (0 : K)], refl, },
  map_one' := by { rw [← completion.coe_one, valued.extension_extends (1 : K)],
                   exact valuation.map_one _ },
  map_mul' := λ x y, begin
    apply completion.induction_on₂ x y,
    { have c1 : continuous (λ (x : hat K × hat K), valued.extension (x.1 * x.2)),
        from valued.continuous_extension.comp (continuous_fst.mul continuous_snd),

      have c2 : continuous (λ (x : hat K × hat K), valued.extension x.1 * valued.extension x.2),
        from (valued.continuous_extension.comp continuous_fst).mul
              (valued.continuous_extension.comp continuous_snd),
      exact is_closed_eq c1 c2 },
    { intros x y,
      norm_cast,
      exact valuation.map_mul _ _ _ },
  end,
  map_add_le_max' := λ x y, begin
    rw le_max_iff,
    apply completion.induction_on₂ x y,
    { have cont : continuous (valued.extension : hat K → Γ₀) := valued.continuous_extension,
      exact  (is_closed_le (cont.comp continuous_add) $ cont.comp continuous_fst).union
        (is_closed_le (cont.comp continuous_add) $ cont.comp continuous_snd) },
    { intros x y,
      dsimp,
      norm_cast,
      rw ← le_max_iff,
      exact v.map_add x y, },
  end }

end valuation_on_valued_field_completion


import data.polynomial.erase_lead
import analysis.calculus.deriv
import analysis.asymptotic_equivalent
import equivalent

open polynomial asymptotics filter finset function
open_locale big_operators topological_space asymptotics

section

variables {α β : Type*} [linear_ordered_field α]
variables {l : filter β} {f g : β → α}

lemma tendsto_at_bot_mul_left' {r : α} (hr : r < 0) (hf : tendsto f l at_top) :
  tendsto (λx, r * f x) l at_bot :=
begin
  apply tendsto_at_bot.2 (λb, _),
  filter_upwards [tendsto_at_top.1 hf (b/r)],
  assume x hx,
  simpa [div_le_iff_of_neg' hr] using hx
end

end

variables {α : Type*}

lemma tendsto_abs_at_bot_at_top [linear_ordered_add_comm_group α] :
  tendsto (abs : α → α) at_bot at_top :=
begin
  convert show tendsto (abs ∘ has_neg.neg : α → α) at_bot at_top,
    from tendsto_abs_at_top_at_top.comp tendsto_neg_at_bot_at_top,
  ext,
  simp
end

lemma is_o_pow_pow_at_top_of_lt' {α : Type*} [normed_linear_ordered_field α]
  [order_topology α] {p q : ℕ} (hpq : p < q) :
  is_o (λ (x : α), x^p) (λ (x : α), x^q) at_top :=
begin
  refine (is_o_iff_tendsto' _).mpr (tendsto_pow_div_pow_at_top_of_lt hpq),
  rw eventually_iff_exists_mem,
  exact ⟨set.Ioi 0, Ioi_mem_at_top 0, λ x (hx : 0 < x) hxq, (pow_ne_zero q hx.ne.symm hxq).elim⟩,
end

lemma polynomial.eval_eq_range_sum [semiring α] (P : polynomial α) (x : α) :
  eval x P = ∑ i in range (P.nat_degree + 1), P.coeff i * x ^ i :=
begin
  rw eval_eq_sum,
  refine P.sum_of_support_subset _ _ _,
  { intros a,
    rw [mem_range, nat.lt_add_one_iff],
    exact le_nat_degree_of_mem_supp a },
  { intros,
    exact zero_mul _ }
end

lemma polynomial.eval_eq_range_sum' [semiring α] (P : polynomial α) :
  (λ x, eval x P) = (λ x, ∑ i in range (P.nat_degree + 1), P.coeff i * x ^ i) :=
begin
  ext,
  exact P.eval_eq_range_sum x
end

lemma polynomial.eval_is_equivalent_at_top_eval_lead
  [normed_linear_ordered_field α] [order_topology α] (P : polynomial α) :
  (λ x, eval x P) ~[at_top] (λ x, P.leading_coeff * x ^ P.nat_degree) :=
begin
  by_cases h : P = 0,
  { simp [h] },
  { conv
    { congr,
      funext,
      rw [polynomial.eval_eq_range_sum, sum_range_succ, add_comm] },
    exact is_equivalent.refl.add_is_o (is_o.sum $ λ i hi, is_o.const_mul_left
      (is_o.const_mul_right (λ hz, h $ leading_coeff_eq_zero.mp hz) $
        is_o_pow_pow_at_top_of_lt' (mem_range.mp hi)) _) }
end

noncomputable
instance : normed_linear_ordered_field ℝ :=
⟨dist_eq_norm, normed_field.norm_mul⟩

lemma polynomial.eval_div_tendsto_zero_of_degree_lt [normed_linear_ordered_field α]
  [order_topology α] (P Q : polynomial α) (hdeg : P.degree < Q.degree) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top (𝓝 0) :=
begin
  refine (P.eval_is_equivalent_at_top_eval_lead.symm.div
          Q.eval_is_equivalent_at_top_eval_lead.symm).tendsto_nhds _,
  conv
  { congr,
    funext,
    rw ← div_mul_div },
  by_cases hPQ : P = 0 ∨ Q = 0,
  { rcases hPQ with hP | hQ,
    { simp [hP, tendsto_const_nhds] },
    { simp [hQ, tendsto_const_nhds] } },
  { push_neg at hPQ,
    rw ← mul_zero _,
    rw [degree_eq_nat_degree hPQ.1, degree_eq_nat_degree hPQ.2] at hdeg,
    refine tendsto.const_mul _ (tendsto_pow_div_pow_at_top_of_lt _),
    exact_mod_cast hdeg }
end

lemma polynomial.eval_div_tendsto_leading_coeff_div_of_degree_eq [normed_linear_ordered_field α]
  [order_topology α] (P Q : polynomial α) (hdeg : P.degree = Q.degree) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top (𝓝 $ P.leading_coeff / Q.leading_coeff) :=
begin
  refine (P.eval_is_equivalent_at_top_eval_lead.symm.div
          Q.eval_is_equivalent_at_top_eval_lead.symm).tendsto_nhds _,
  conv
  { congr,
    funext,
    rw ← div_mul_div,
    rw nat_degree_eq_of_degree_eq hdeg,
    skip, skip,
    rw ← mul_one (P.leading_coeff / Q.leading_coeff) },
  exact tendsto.const_mul _ (tendsto_const_nhds.congr' $ (eventually_gt_at_top 0).mono $
    λ x (hx : 0 < x), (div_self (pow_pos hx Q.nat_degree).ne.symm).symm),
end

lemma polynomial.eval_div_tendsto_at_top_of_degree_gt [normed_linear_ordered_field α]
  [order_topology α] (P Q : polynomial α) (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) (hnng : 0 ≤ P.leading_coeff/Q.leading_coeff) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_top :=
begin
  refine (P.eval_is_equivalent_at_top_eval_lead.symm.div
          Q.eval_is_equivalent_at_top_eval_lead.symm).tendsto_at_top _,
  conv
  { congr,
    funext,
    rw ← div_mul_div },
  have hP : P ≠ 0,
  { rw ← degree_nonneg_iff_ne_zero at ⊢ hQ, exact hQ.trans hdeg.le },
  have ratio_pos : 0 < P.leading_coeff/Q.leading_coeff :=
    lt_of_le_of_ne hnng (div_ne_zero (λ h, hP $ leading_coeff_eq_zero.mp h)
      (λ h, hQ $ leading_coeff_eq_zero.mp h)).symm,
  rw [degree_eq_nat_degree hP, degree_eq_nat_degree hQ] at hdeg,
  norm_cast at hdeg,
  have one_le_nat_degree_sub : 1 ≤ P.nat_degree - Q.nat_degree :=
    (nat.le_sub_left_iff_add_le hdeg.le).mpr (nat.lt_iff_add_one_le.mp hdeg),
  exact tendsto_at_top_mul_left' ratio_pos ((tendsto_pow_at_top one_le_nat_degree_sub).congr' $
    (eventually_gt_at_top 0).mono $ λ x hx, pow_sub' x hx.ne.symm hdeg.le)
end

lemma polynomial.eval_div_tendsto_at_bot_of_degree_gt [normed_linear_ordered_field α]
  [order_topology α] (P Q : polynomial α) (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) (hnng : P.leading_coeff/Q.leading_coeff ≤ 0) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_bot :=
begin
  refine (P.eval_is_equivalent_at_top_eval_lead.symm.div
          Q.eval_is_equivalent_at_top_eval_lead.symm).tendsto_at_bot _,
  conv
  { congr,
    funext,
    rw ← div_mul_div },
  have hP : P ≠ 0,
  { rw ← degree_nonneg_iff_ne_zero at ⊢ hQ, exact hQ.trans hdeg.le },
  have ratio_neg : P.leading_coeff/Q.leading_coeff < 0 :=
    lt_of_le_of_ne hnng (div_ne_zero (λ h, hP $ leading_coeff_eq_zero.mp h)
      (λ h, hQ $ leading_coeff_eq_zero.mp h)),
  rw [degree_eq_nat_degree hP, degree_eq_nat_degree hQ] at hdeg,
  norm_cast at hdeg,
  have one_le_nat_degree_sub : 1 ≤ P.nat_degree - Q.nat_degree :=
    (nat.le_sub_left_iff_add_le hdeg.le).mpr (nat.lt_iff_add_one_le.mp hdeg),
  exact tendsto_at_bot_mul_left' ratio_neg ((tendsto_pow_at_top one_le_nat_degree_sub).congr' $
    (eventually_gt_at_top 0).mono $ λ x hx, pow_sub' x hx.ne.symm hdeg.le)
end

lemma polynomial.abs_eval_div_tendsto_at_top_of_degree_gt [normed_linear_ordered_field α]
  [order_topology α] (P Q : polynomial α) (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) :
  tendsto (λ x, abs ((eval x P)/(eval x Q))) at_top at_top :=
begin
  by_cases h : 0 ≤ P.leading_coeff/Q.leading_coeff,
  { exact tendsto_abs_at_top_at_top.comp (P.eval_div_tendsto_at_top_of_degree_gt Q hdeg hQ h) },
  { push_neg at h,
    exact tendsto_abs_at_bot_at_top.comp (P.eval_div_tendsto_at_bot_of_degree_gt Q hdeg hQ h.le) }
end

example : tendsto (λ x : ℝ, (3*x^2 - 6*x + 7)/(12*x^2 + 4)) at_top (𝓝 (1/4)) :=
begin
  have key1 : ∀ x:ℝ, 3*x^2-6*x+7 = eval x (monomial 2 3 - monomial 1 6 + monomial 0 7) := by simp,
  have key2 : ∀ x:ℝ, 12*x^2+4 = eval x (monomial 2 12 + monomial 0 4) := by simp,
  simp_rw [key1, key2],
  set A : polynomial ℝ := monomial 2 3 - monomial 1 6 + monomial 0 7,
  set B : polynomial ℝ := monomial 2 12 + monomial 0 4,

  have degA1 : (monomial 2 3 : polynomial ℝ).degree = (2:ℕ) := degree_monomial _ (by norm_num),
  have degA2 : (monomial 1 6 : polynomial ℝ).degree = (1:ℕ) := degree_monomial _ (by norm_num),
  have degA3 : (monomial 0 7 : polynomial ℝ).degree = (0:ℕ) := degree_monomial _ (by norm_num),
  have degA4 : (monomial 2 3 - monomial 1 6 : polynomial ℝ).degree = (2:ℕ) :=
    degA1 ▸ degree_sub_eq_left_of_degree_lt (by rw [degA1, degA2] ; dec_trivial),
  have degA : A.degree = (2:ℕ) :=
    degA4 ▸ degree_add_eq_left_of_degree_lt (by rw [degA3, degA4] ; dec_trivial),

  have degB1 : (monomial 2 12 : polynomial ℝ).degree = (2:ℕ) := degree_monomial _ (by norm_num),
  have degB2 : (monomial 0 4 : polynomial ℝ).degree = (0:ℕ) := degree_monomial _ (by norm_num),
  have degB : B.degree = (2:ℕ) :=
    degB1 ▸ degree_add_eq_left_of_degree_lt (by rw [degB1, degB2] ; dec_trivial),

  have leadA : A.leading_coeff = 3,
  { unfold leading_coeff nat_degree,
    rw degA,
    simp only [coeff_add,coeff_sub,coeff_monomial,if_true,option.get_or_else_coe,eq_self_iff_true],
    norm_num },

  have leadB : B.leading_coeff = 12,
  { unfold leading_coeff nat_degree,
    rw degB,
    simp only [coeff_add,coeff_sub,coeff_monomial,if_true,option.get_or_else_coe,eq_self_iff_true],
    norm_num },

  convert A.eval_div_tendsto_leading_coeff_div_of_degree_eq B (degA.trans degB.symm) using 2,
  rw [leadA, leadB],
  norm_num
end

/-variables [ordered_ring α]

set_option profiler true
lemma polynomial.eval_is_equivalent_at_top_eval_lead
  [normed_linear_ordered_field α] [order_topology α] (P : polynomial α) :
  (λ x, eval x P) ~[at_top] (λ x, eval x ((C P.leading_coeff) * X ^ P.nat_degree)) :=
begin
  rw is_equivalent,
  have : (λ x, eval x P) - (λ x, eval x ((C P.leading_coeff) * X ^ P.nat_degree)) =
    λ x, eval x P.erase_lead,
  { simp_rw [← self_sub_C_mul_X_pow, eval_sub], refl },
  rw [this, C_mul_X_pow_eq_monomial, is_o_iff_tendsto'],
  { conv
    { congr,
      funext,
      rw [eval_monomial, polynomial.eval_eq_range_sum, sum_div,
          sum_congr rfl (λ n hn, (div_mul_div (P.erase_lead.coeff n)
            (P.leading_coeff) (x^n) (x^P.nat_degree)).symm)],
      skip,
      skip,
      congr,
      rw ← sum_eq_zero (λ n (hn : n ∈ range (P.erase_lead.nat_degree + 1)), rfl) },
    refine tendsto_finset_sum _ (λ c hc, _),
    rcases P.erase_lead_nat_degree_lt_or_erase_lead_eq_zero with h | h,
    { rw ← mul_zero (P.erase_lead.coeff c / P.leading_coeff),
      refine tendsto_const_nhds.mul _,
      rw [mem_range, nat.lt_add_one_iff] at hc,
      have : c < P.nat_degree := by linarith,
      suffices h : tendsto (λ (x : α), x ^ ((c : ℤ) - P.nat_degree)) at_top (𝓝 0),
      { refine (tendsto_congr' ((eventually_gt_at_top (0 : α)).mono (λ x hx, _))).mp h,
        simp [fpow_sub hx.ne.symm] },
      rw [← neg_sub, ← int.coe_nat_sub this.le],
      have : 1 ≤ P.nat_degree - c := nat.sub_pos_of_lt this,
      exact @tendsto_pow_neg_at_top α _ _ (by apply_instance) _ this, },
    { simp [h, tendsto_const_nhds] } },
  { sorry },
end

#check int.coe_nat_sub

lemma polynomial.eval_is_equivalent_at_top_eval_lead [normed_field α] (P : polynomial α) :
  (λ x, eval x P) ~[at_top] (λ x, eval x ((C P.leading_coeff) * X ^ P.nat_degree)) :=
begin
  rw is_equivalent,
  have : (λ x, eval x P) - (λ x, eval x ((C P.leading_coeff) * X ^ P.nat_degree)) =
    λ x, eval x P.erase_lead,
  { simp_rw [← self_sub_C_mul_X_pow, eval_sub], refl },
  rw [this, is_o_iff_exists_eq_mul, C_mul_X_pow_eq_monomial],
  use (λ x, (eval x P.erase_lead) / (P.leading_coeff * x ^ P.nat_degree)),
  split,
  { conv
    { congr,
      funext,
      rw [polynomial.eval_eq_range_sum, sum_div,
          sum_congr rfl (λ n hn, (div_mul_div (P.erase_lead.coeff n)
            (P.leading_coeff) (x^n) (x^P.nat_degree)).symm)],
      skip,
      skip,
      congr,
      rw ← sum_eq_zero (λ n (hn : n ∈ range (P.erase_lead.nat_degree + 1)), rfl) },
    refine tendsto_finset_sum _ (λ c hc, _),
    rw ← mul_zero (P.erase_lead.coeff c / P.leading_coeff),
    refine tendsto_const_nhds.mul _,
    rw mem_range at hc,
    rw nat.lt_add_one_iff at hc,
    have := P.erase_lead_nat_degree_lt_or_erase_lead_eq_zero,
    rcases this with h | h,
    { have : c + 1 ≤ P.nat_degree := by linarith,
      simp [div_eq_mul_inv, ← pow_sub'], sorry },
    { simp only [h, le_zero_iff_eq, nat_degree_zero] at hc,
      simp only [hc, one_div, pow_zero],
      refine tendsto_inv_at_top_zero.comp tendsto_pow_at_t, } },
  { simp,
    symmetry,
     },
end

lemma polynomial.eval_is_o_at_top_eval_of_degree_lt [normed_ring α] {P Q : polynomial α} (h : P.degree < Q.degree) :
  is_o (λ x, eval x P) (λ x, eval x Q) at_top :=
begin
  sorry
end

lemma polynomial.eval_is_equivalent_at_top_eval_lead [normed_ring α] (P : polynomial α) :
  (λ x, eval x P) ~[at_top] (λ x, eval x ((C P.leading_coeff) * X ^ P.nat_degree)) :=
begin
  rw is_equivalent,
  have : (λ x, eval x P) - (λ x, eval x ((C P.leading_coeff) * X ^ P.nat_degree)) =
    λ x, eval x P.erase_lead,
  { simp_rw [← self_sub_C_mul_X_pow, eval_sub], refl },
  rw this,
  sorry
end-/

#lint


/-
Copyright (c) 2022 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning
-/

import analysis.complex.polynomial
import data.polynomial.mirror

/-!
# Unit Trinomials

This file defines irreducible trinomials and proves an irreducibility criterion.

## Main definitions

- `polynomial.is_unit_trinomial`

## Main results

- `polynomial.irreducible_of_coprime`: An irreducibility criterion for unit trinomials.

-/

namespace polynomial
open_locale polynomial

open finset

section semiring

variables {R : Type*} [semiring R] (k m n : ℕ) (u v w : R)

/-- Shorthand for a trinomial -/
noncomputable def trinomial := C u * X ^ k + C v * X ^ m + C w * X ^ n

lemma trinomial_def : trinomial k m n u v w = C u * X ^ k + C v * X ^ m + C w * X ^ n := rfl

variables {k m n u v w}

lemma trinomial_leading_coeff' (hkm : k < m) (hmn : m < n) :
  (trinomial k m n u v w).coeff n = w :=
by rw [trinomial_def, coeff_add, coeff_add, coeff_C_mul_X_pow, coeff_C_mul_X_pow,
  coeff_C_mul_X_pow, if_neg (hkm.trans hmn).ne', if_neg hmn.ne', if_pos rfl, zero_add, zero_add]

lemma trinomial_middle_coeff (hkm : k < m) (hmn : m < n) :
  (trinomial k m n u v w).coeff m = v :=
by rw [trinomial_def, coeff_add, coeff_add, coeff_C_mul_X_pow, coeff_C_mul_X_pow,
  coeff_C_mul_X_pow, if_neg hkm.ne', if_pos rfl, if_neg hmn.ne, zero_add, add_zero]

lemma trinomial_trailing_coeff' (hkm : k < m) (hmn : m < n) :
  (trinomial k m n u v w).coeff k = u :=
by rw [trinomial_def, coeff_add, coeff_add, coeff_C_mul_X_pow, coeff_C_mul_X_pow,
  coeff_C_mul_X_pow, if_pos rfl, if_neg hkm.ne, if_neg (hkm.trans hmn).ne, add_zero, add_zero]

lemma trinomial_nat_degree (hkm : k < m) (hmn : m < n) (hw : w ≠ 0) :
  (trinomial k m n u v w).nat_degree = n :=
begin
  refine nat_degree_eq_of_degree_eq_some ((finset.sup_le $ λ i h, _).antisymm $
    le_degree_of_ne_zero $ by rwa trinomial_leading_coeff' hkm hmn),
  replace h := support_trinomial' k m n u v w h,
  rw [mem_insert, mem_insert, mem_singleton] at h,
  rcases h with rfl | rfl | rfl,
  { exact with_bot.coe_le_coe.mpr (hkm.trans hmn).le },
  { exact with_bot.coe_le_coe.mpr hmn.le },
  { exact le_rfl },
end

lemma trinomial_nat_trailing_degree (hkm : k < m) (hmn : m < n) (hu : u ≠ 0) :
  (trinomial k m n u v w).nat_trailing_degree = k :=
begin
  refine nat_trailing_degree_eq_of_trailing_degree_eq_some ((finset.le_inf $ λ i h, _).antisymm $
    le_trailing_degree_of_ne_zero $ by rwa trinomial_trailing_coeff' hkm hmn).symm,
  replace h := support_trinomial' k m n u v w h,
  rw [mem_insert, mem_insert, mem_singleton] at h,
  rcases h with rfl | rfl | rfl,
  { exact le_rfl },
  { exact with_top.coe_le_coe.mpr hkm.le },
  { exact with_top.coe_le_coe.mpr (hkm.trans hmn).le },
end

lemma trinomial_trailing_coeff (hkm : k < m) (hmn : m < n) (hu : u ≠ 0) :
  (trinomial k m n u v w).trailing_coeff = u :=
by rw [trailing_coeff, trinomial_nat_trailing_degree hkm hmn hu, trinomial_trailing_coeff' hkm hmn]

lemma trinomial_monic (hkm : k < m) (hmn : m < n) : (trinomial k m n u v 1).monic :=
begin
  casesI subsingleton_or_nontrivial R with h h,
  { apply subsingleton.elim },
  { exact trinomial_leading_coeff hkm hmn one_ne_zero },
end

lemma trinomial_mirror (hkm : k < m) (hmn : m < n) (hu : u ≠ 0) (hw : w ≠ 0) :
  (trinomial k m n u v w).mirror = trinomial k (n - m + k) n w v u :=
by rw [mirror, trinomial_nat_trailing_degree hkm hmn hu, reverse, trinomial_nat_degree hkm hmn hw,
  trinomial_def, reflect_add, reflect_add, reflect_C_mul_X_pow, reflect_C_mul_X_pow,
  reflect_C_mul_X_pow, rev_at_le (hkm.trans hmn).le, rev_at_le hmn.le, rev_at_le le_rfl,
  add_mul, add_mul, mul_assoc, mul_assoc, mul_assoc, ←pow_add, ←pow_add, ←pow_add,
  nat.sub_add_cancel (hkm.trans hmn).le, nat.sub_self, zero_add, add_comm, add_comm (C u * X ^ n),
  ←add_assoc, ←trinomial_def]

lemma trinomial_support (hkm : k < m) (hmn : m < n) (hu : u ≠ 0) (hv : v ≠ 0) (hw : w ≠ 0) :
  (trinomial k m n u v w).support = {k, m, n} :=
support_trinomial hkm hmn hu hv hw

end semiring

variables (p q : ℤ[X])

/-- A unit trinomial is a trinomial with unit coefficients. -/
def is_unit_trinomial := ∃ {k m n : ℕ} (hkm : k < m) (hmn : m < n) {u v w : units ℤ},
  p = trinomial k m n u v w

variables {p q}

namespace is_unit_trinomial

lemma not_is_unit (hp : p.is_unit_trinomial) : ¬ is_unit p :=
begin
  obtain ⟨k, m, n, hkm, hmn, u, v, w, rfl⟩ := hp,
  exact λ h, ne_zero_of_lt hmn ((trinomial_nat_degree hkm hmn w.ne_zero).symm.trans
    (nat_degree_eq_of_degree_eq_some (degree_eq_zero_of_is_unit h))),
end

lemma card_support_eq_three (hp : p.is_unit_trinomial) : p.support.card = 3 :=
begin
  obtain ⟨k, m, n, hkm, hmn, u, v, w, rfl⟩ := hp,
  exact card_support_trinomial hkm hmn u.ne_zero v.ne_zero w.ne_zero,
end

lemma ne_zero (hp : p.is_unit_trinomial) : p ≠ 0 :=
begin
  rintro rfl,
  exact nat.zero_ne_bit1 1 hp.card_support_eq_three,
end

lemma coeff_is_unit (hp : p.is_unit_trinomial) {k : ℕ} (hk : k ∈ p.support) :
  is_unit (p.coeff k) :=
begin
  obtain ⟨k, m, n, hkm, hmn, u, v, w, rfl⟩ := hp,
  have := support_trinomial' k m n ↑u ↑v ↑w hk,
  rw [mem_insert, mem_insert, mem_singleton] at this,
  rcases this with rfl | rfl | rfl,
  { refine ⟨u, by rw trinomial_trailing_coeff' hkm hmn⟩ },
  { refine ⟨v, by rw trinomial_middle_coeff hkm hmn⟩ },
  { refine ⟨w, by rw trinomial_leading_coeff' hkm hmn⟩ },
end

lemma leading_coeff_is_unit (hp : p.is_unit_trinomial) : is_unit p.leading_coeff :=
hp.coeff_is_unit (nat_degree_mem_support_of_nonzero hp.ne_zero)

lemma trailing_coeff_is_unit (hp : p.is_unit_trinomial) : is_unit p.trailing_coeff :=
hp.coeff_is_unit (nat_trailing_degree_mem_support_of_nonzero hp.ne_zero)

end is_unit_trinomial

lemma is_unit_trinomial_iff :
  p.is_unit_trinomial ↔ p.support.card = 3 ∧ ∀ k ∈ p.support, is_unit (p.coeff k) :=
begin
  refine ⟨λ hp, ⟨hp.card_support_eq_three, λ k, hp.coeff_is_unit⟩, λ hp, _⟩,
  obtain ⟨k, m, n, hkm, hmn, x, y, z, hx, hy, hz, rfl⟩ := card_support_eq_three.mp hp.1,
  rw [support_trinomial hkm hmn hx hy hz] at hp,
  replace hx := hp.2 k (mem_insert_self k {m, n}),
  replace hy := hp.2 m (mem_insert_of_mem (mem_insert_self m {n})),
  replace hz := hp.2 n (mem_insert_of_mem (mem_insert_of_mem (mem_singleton_self n))),
  simp_rw [coeff_add, coeff_C_mul, coeff_X_pow_self, mul_one, coeff_X_pow] at hx hy hz,
  rw [if_neg hkm.ne, if_neg (hkm.trans hmn).ne] at hx,
  rw [if_neg hkm.ne', if_neg hmn.ne] at hy,
  rw [if_neg (hkm.trans hmn).ne', if_neg hmn.ne'] at hz,
  simp_rw [mul_zero, zero_add, add_zero] at hx hy hz,
  exact ⟨k, m, n, hkm, hmn, hx.unit, hy.unit, hz.unit, rfl⟩,
end

lemma is_unit_trinomial_iff' : p.is_unit_trinomial ↔ (p * p.mirror).coeff
  (((p * p.mirror).nat_degree + (p * p.mirror).nat_trailing_degree) / 2) = 3 :=
begin
  rw [nat_degree_mul_mirror, nat_trailing_degree_mul_mirror, ←mul_add,
      nat.mul_div_right _ zero_lt_two, coeff_mul_mirror],
  refine ⟨_, λ hp, _⟩,
  { rintros ⟨k, m, n, hkm, hmn, u, v, w, rfl⟩,
    rw [sum_def, trinomial_support hkm hmn u.ne_zero v.ne_zero w.ne_zero,
      sum_insert (mt mem_insert.mp (not_or hkm.ne (mt mem_singleton.mp (hkm.trans hmn).ne))),
      sum_insert (mt mem_singleton.mp hmn.ne), sum_singleton, trinomial_leading_coeff' hkm hmn,
      trinomial_middle_coeff hkm hmn, trinomial_trailing_coeff' hkm hmn],
    simp_rw [←units.coe_pow, int.units_sq, units.coe_one, ←add_assoc, bit1, bit0] },
  { have key : ∀ k ∈ p.support, (p.coeff k) ^ 2 = 1 :=
    λ k hk, int.sq_eq_one_of_sq_le_three ((single_le_sum
      (λ k hk, sq_nonneg (p.coeff k)) hk).trans hp.le) (mem_support_iff.mp hk),
    refine is_unit_trinomial_iff.mpr ⟨_, λ k hk, is_unit_of_pow_eq_one (key k hk) two_ne_zero⟩,
    rw [sum_def, sum_congr rfl key, sum_const, nat.smul_one_eq_coe] at hp,
    exact nat.cast_injective hp },
end

lemma is_unit_trinomial_iff'' (h : p * p.mirror = q * q.mirror) :
  p.is_unit_trinomial ↔ q.is_unit_trinomial :=
by rw [is_unit_trinomial_iff', is_unit_trinomial_iff', h]

namespace is_unit_trinomial

lemma irreducible_aux1 {k m n : ℕ} (hkm : k < m) (hmn : m < n) (u v w : units ℤ)
  (hp : p = trinomial k m n u v w) :
  C ↑v * (C ↑u * X ^ (m + n) + C ↑w * X ^ (n - m + k + n)) =
    ⟨finsupp.filter (set.Ioo (k + n) (n + n)) (p * p.mirror).to_finsupp⟩ :=
begin
  have key : n - m + k < n := by rwa [←lt_tsub_iff_right, tsub_lt_tsub_iff_left_of_le hmn.le],
  rw [hp, trinomial_mirror hkm hmn u.ne_zero w.ne_zero],
  simp_rw [trinomial_def, C_mul_X_pow_eq_monomial, add_mul, mul_add, monomial_mul_monomial,
    to_finsupp_add, to_finsupp_monomial, finsupp.filter_add],
  rw [finsupp.filter_single_of_neg, finsupp.filter_single_of_neg, finsupp.filter_single_of_neg,
      finsupp.filter_single_of_neg, finsupp.filter_single_of_neg, finsupp.filter_single_of_pos,
      finsupp.filter_single_of_neg, finsupp.filter_single_of_pos, finsupp.filter_single_of_neg],
  { simp only [add_zero, zero_add, of_finsupp_add, of_finsupp_single],
    rw [C_mul_monomial, C_mul_monomial, mul_comm ↑v ↑w, add_comm (n - m + k) n] },
  { exact λ h, h.2.ne rfl },
  { refine ⟨_, add_lt_add_left key n⟩,
    rwa [add_comm, add_lt_add_iff_left, lt_add_iff_pos_left, tsub_pos_iff_lt] },
  { exact λ h, h.1.ne (add_comm k n) },
  { exact ⟨add_lt_add_right hkm n, add_lt_add_right hmn n⟩ },
  { rw [←add_assoc, add_tsub_cancel_of_le hmn.le, add_comm],
    exact λ h, h.1.ne rfl },
  { intro h,
    have := h.1,
    rw [add_comm, add_lt_add_iff_right] at this,
    exact asymm this hmn },
  { exact λ h, h.1.ne rfl },
  { exact λ h, asymm ((add_lt_add_iff_left k).mp h.1) key },
  { exact λ h, asymm ((add_lt_add_iff_left k).mp h.1) (hkm.trans hmn) },
end

lemma irreducible_aux2 {k m m' n : ℕ}
  (hkm : k < m) (hmn : m < n) (hkm' : k < m') (hmn' : m' < n)
  (u v w : units ℤ)
  (hp : p = trinomial k m n u v w) (hq : q = trinomial k m' n u v w)
  (h : p * p.mirror = q * q.mirror) :
  q = p ∨ q = p.mirror :=
begin
  let f : ℤ[X] → ℤ[X] :=
  λ p, ⟨finsupp.filter (set.Ioo (k + n) (n + n)) p.to_finsupp⟩,
  replace h := congr_arg f h,
  replace h := (irreducible_aux1 hkm hmn u v w hp).trans h,
  replace h := h.trans (irreducible_aux1 hkm' hmn' u v w hq).symm,
  rw (is_unit_C.mpr v.is_unit).mul_right_inj at h,
  rw binomial_eq_binomial u.ne_zero w.ne_zero at h,
  simp only [add_left_inj, units.eq_iff] at h,
  rcases h with ⟨rfl, -⟩ | ⟨rfl, rfl, h⟩ | ⟨-, hm, hm'⟩,
  { exact or.inl (hq.trans hp.symm) },
  { refine or.inr _,
    rw [←trinomial_mirror hkm' hmn' u.ne_zero u.ne_zero, eq_comm, mirror_eq_iff] at hp,
    exact hq.trans hp },
  { suffices : m = m',
    { rw this at hp,
      exact or.inl (hq.trans hp.symm) },
    rw [tsub_add_eq_add_tsub hmn.le, eq_tsub_iff_add_eq_of_le, ←two_mul] at hm,
    rw [tsub_add_eq_add_tsub hmn'.le, eq_tsub_iff_add_eq_of_le, ←two_mul] at hm',
    exact mul_left_cancel₀ two_ne_zero (hm.trans hm'.symm),
    exact hmn'.le.trans (nat.le_add_right n k),
    exact hmn.le.trans (nat.le_add_right n k) },
end

lemma irreducible_aux3 {k m m' n : ℕ}
  (hkm : k < m) (hmn : m < n) (hkm' : k < m') (hmn' : m' < n) (u v w x z : units ℤ)
  (hp : p = trinomial k m n u v w) (hq : q = trinomial k m' n x v z)
  (h : p * p.mirror = q * q.mirror) :
  q = p ∨ q = p.mirror :=
begin
  have hmul := congr_arg leading_coeff h,
  rw [leading_coeff_mul, leading_coeff_mul, mirror_leading_coeff, mirror_leading_coeff, hp, hq,
      trinomial_leading_coeff hkm hmn w.ne_zero, trinomial_leading_coeff hkm' hmn' z.ne_zero,
      trinomial_trailing_coeff hkm hmn u.ne_zero,
      trinomial_trailing_coeff hkm' hmn' x.ne_zero] at hmul,

  have hadd := congr_arg (eval 1) h,
  rw [eval_mul, eval_mul, mirror_eval_one, mirror_eval_one, ←sq, ←sq, hp, hq] at hadd,
  simp only [eval_add, eval_C_mul, eval_pow, eval_X, one_pow, mul_one, trinomial_def] at hadd,
  rw [add_assoc, add_assoc, add_comm ↑u, add_comm ↑x, add_assoc, add_assoc] at hadd,
  simp only [add_sq', add_assoc, add_right_inj, ←units.coe_pow, int.units_sq] at hadd,
  rw [mul_assoc, hmul, ←mul_assoc, add_right_inj,
      mul_right_inj' (show 2 * (v : ℤ) ≠ 0, from mul_ne_zero two_ne_zero v.ne_zero)] at hadd,
  replace hadd := (int.is_unit_add_is_unit_eq_is_unit_add_is_unit w.is_unit u.is_unit
    z.is_unit x.is_unit).mp hadd,
  simp only [units.eq_iff] at hadd,

  rcases hadd with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩,
  { exact irreducible_aux2 hkm hmn hkm' hmn' u v w hp hq h },
  { rw [←mirror_inj, trinomial_mirror hkm' hmn' w.ne_zero u.ne_zero] at hq,
    rw [mul_comm q, ←q.mirror_mirror, q.mirror.mirror_mirror] at h,
    rw [←mirror_inj, or_comm, ←mirror_eq_iff],
    exact irreducible_aux2 hkm hmn (lt_add_of_pos_left k (tsub_pos_of_lt hmn'))
      ((lt_tsub_iff_right).mp ((tsub_lt_tsub_iff_left_of_le hmn'.le).mpr hkm')) u v w hp hq h },
end

lemma irreducible_of_coprime (hp : p.is_unit_trinomial)
  (h : ∀ q : ℤ[X], q ∣ p → q ∣ p.mirror → is_unit q) :
  irreducible p :=
begin
  refine irreducible_of_mirror hp.not_is_unit (λ q hpq, _) h,
  have hq : is_unit_trinomial q := (is_unit_trinomial_iff'' hpq).mp hp,
  obtain ⟨k, m, n, hkm, hmn, u, v, w, hp⟩ := hp,
  obtain ⟨k', m', n', hkm', hmn', x, y, z, hq⟩ := hq,
  have hk : k = k',
  { rw [←mul_right_inj' (show 2 ≠ 0, from two_ne_zero),
      ←trinomial_nat_trailing_degree hkm hmn u.ne_zero, ←hp, ←nat_trailing_degree_mul_mirror, hpq,
      nat_trailing_degree_mul_mirror, hq, trinomial_nat_trailing_degree hkm' hmn' x.ne_zero] },
  have hn : n = n',
  { rw [←mul_right_inj' (show 2 ≠ 0, from two_ne_zero),
      ←trinomial_nat_degree hkm hmn w.ne_zero, ←hp, ←nat_degree_mul_mirror, hpq,
      nat_degree_mul_mirror, hq, trinomial_nat_degree hkm' hmn' z.ne_zero] },
  subst hk,
  subst hn,
  rcases eq_or_eq_neg_of_sq_eq_sq ↑y ↑v
    ((int.is_unit_sq y.is_unit).trans (int.is_unit_sq v.is_unit).symm) with h1 | h1,
  { rw h1 at *,
    rcases irreducible_aux3 hkm hmn hkm' hmn' u v w x z hp hq hpq with h2 | h2,
    { exact or.inl h2 },
    { exact or.inr (or.inr (or.inl h2)) } },
  { rw h1 at *,
    rw trinomial_def at hp,
    rw [←neg_inj, neg_add, neg_add, ←neg_mul, ←neg_mul, ←neg_mul, ←C_neg, ←C_neg, ←C_neg] at hp,
    rw [←neg_mul_neg, ←mirror_neg] at hpq,
    rcases irreducible_aux3 hkm hmn hkm' hmn' (-u) (-v) (-w) x z hp hq hpq with rfl | rfl,
    { exact or.inr (or.inl rfl) },
    { exact or.inr (or.inr (or.inr p.mirror_neg)) } },
end

/-- A unit trinomial is irreducible if it is coprime with its mirror -/
lemma irreducible_of_is_coprime (hp : p.is_unit_trinomial) (h : is_coprime p p.mirror) :
  irreducible p :=
irreducible_of_coprime hp (λ q, h.is_unit_of_dvd')

/-- A unit trinomial is irreducible if it has no complex roots in common with its mirror -/
lemma irreducible_of_coprime' (hp : is_unit_trinomial p)
  (h : ∀ z : ℂ, ¬ (aeval z p = 0 ∧ aeval z (mirror p) = 0)) : irreducible p :=
begin
  refine hp.irreducible_of_coprime (λ q hq hq', _),
  suffices : ¬ (0 < q.nat_degree),
  { rcases hq with ⟨p, rfl⟩,
    replace hp := hp.leading_coeff_is_unit,
    rw leading_coeff_mul at hp,
    replace hp := is_unit_of_mul_is_unit_left hp,
    rw [not_lt, le_zero_iff] at this,
    rwa [eq_C_of_nat_degree_eq_zero this, is_unit_C, ←this] },
  intro hq'',
  rw nat_degree_pos_iff_degree_pos at hq'',
  rw ← degree_map_eq_of_injective (algebra_map ℤ ℂ).injective_int at hq'',
  cases complex.exists_root hq'' with z hz,
  rw [is_root, eval_map, ←aeval_def] at hz,
  refine h z ⟨_, _⟩,
  { cases hq with g' hg',
    rw [hg', aeval_mul, hz, zero_mul] },
  { cases hq' with g' hg',
    rw [hg', aeval_mul, hz, zero_mul] },
end

-- TODO: Develop more theory (e.g., it suffices to check that `aeval z p ≠ 0` for `z = 0`
-- and `z` a root of unity)

end is_unit_trinomial

end polynomial


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.modeq
import Mathlib.tactic.ring
import Mathlib.PostPort

namespace Mathlib

namespace int

/-- `a ≡ b [ZMOD n]` when `a % n = b % n`. -/
def modeq (n : ℤ) (a : ℤ) (b : ℤ) :=
  a % n = b % n

namespace modeq

protected theorem refl {n : ℤ} (a : ℤ) : modeq n a a :=
  rfl

protected theorem symm {n : ℤ} {a : ℤ} {b : ℤ} : modeq n a b → modeq n b a :=
  Eq.symm

protected theorem trans {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} : modeq n a b → modeq n b c → modeq n a c :=
  Eq.trans

theorem coe_nat_modeq_iff {a : ℕ} {b : ℕ} {n : ℕ} : modeq ↑n ↑a ↑b ↔ nat.modeq n a b := sorry

protected instance decidable {n : ℤ} {a : ℤ} {b : ℤ} : Decidable (modeq n a b) :=
  eq.mpr sorry (int.decidable_eq (a % n) (b % n))

theorem modeq_zero_iff {n : ℤ} {a : ℤ} : modeq n a 0 ↔ n ∣ a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n a 0 ↔ n ∣ a)) (equations._eqn_1 n a 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a % n = 0 % n ↔ n ∣ a)) (zero_mod n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a % n = 0 ↔ n ∣ a)) (propext (dvd_iff_mod_eq_zero n a)))) (iff.refl (a % n = 0))))

theorem modeq_iff_dvd {n : ℤ} {a : ℤ} {b : ℤ} : modeq n a b ↔ n ∣ b - a := sorry

theorem modeq_of_dvd_of_modeq {n : ℤ} {m : ℤ} {a : ℤ} {b : ℤ} (d : m ∣ n) (h : modeq n a b) : modeq m a b :=
  iff.mpr modeq_iff_dvd (dvd_trans d (iff.mp modeq_iff_dvd h))

theorem modeq_mul_left' {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} (hc : 0 ≤ c) (h : modeq n a b) : modeq (c * n) (c * a) (c * b) := sorry

theorem modeq_mul_right' {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} (hc : 0 ≤ c) (h : modeq n a b) : modeq (n * c) (a * c) (b * c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq (n * c) (a * c) (b * c))) (mul_comm a c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (modeq (n * c) (c * a) (b * c))) (mul_comm b c)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (modeq (n * c) (c * a) (c * b))) (mul_comm n c))) (modeq_mul_left' hc h)))

theorem modeq_add {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (h₁ : modeq n a b) (h₂ : modeq n c d) : modeq n (a + c) (b + d) := sorry

theorem modeq_add_cancel_left {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (h₁ : modeq n a b) (h₂ : modeq n (a + c) (b + d)) : modeq n c d := sorry

theorem modeq_add_cancel_right {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (h₁ : modeq n c d) (h₂ : modeq n (a + c) (b + d)) : modeq n a b :=
  modeq_add_cancel_left h₁
    (eq.mp (Eq._oldrec (Eq.refl (modeq n (c + a) (b + d))) (add_comm b d))
      (eq.mp (Eq._oldrec (Eq.refl (modeq n (a + c) (b + d))) (add_comm a c)) h₂))

theorem mod_modeq (a : ℤ) (n : ℤ) : modeq n (a % n) a :=
  mod_mod a n

theorem modeq_neg {n : ℤ} {a : ℤ} {b : ℤ} (h : modeq n a b) : modeq n (-a) (-b) := sorry

theorem modeq_sub {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (h₁ : modeq n a b) (h₂ : modeq n c d) : modeq n (a - c) (b - d) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n (a - c) (b - d))) (sub_eq_add_neg a c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (modeq n (a + -c) (b - d))) (sub_eq_add_neg b d))) (modeq_add h₁ (modeq_neg h₂)))

theorem modeq_mul_left {n : ℤ} {a : ℤ} {b : ℤ} (c : ℤ) (h : modeq n a b) : modeq n (c * a) (c * b) := sorry

theorem modeq_mul_right {n : ℤ} {a : ℤ} {b : ℤ} (c : ℤ) (h : modeq n a b) : modeq n (a * c) (b * c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n (a * c) (b * c))) (mul_comm a c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (modeq n (c * a) (b * c))) (mul_comm b c))) (modeq_mul_left c h))

theorem modeq_mul {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (h₁ : modeq n a b) (h₂ : modeq n c d) : modeq n (a * c) (b * d) :=
  modeq.trans (modeq_mul_left a h₂) (modeq_mul_right d h₁)

theorem modeq_of_modeq_mul_left {n : ℤ} {a : ℤ} {b : ℤ} (m : ℤ) (h : modeq (m * n) a b) : modeq n a b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n a b)) (propext modeq_iff_dvd)))
    (dvd.trans (dvd_mul_left n m) (eq.mp (Eq._oldrec (Eq.refl (modeq (m * n) a b)) (propext modeq_iff_dvd)) h))

theorem modeq_of_modeq_mul_right {n : ℤ} {a : ℤ} {b : ℤ} (m : ℤ) : modeq (n * m) a b → modeq n a b :=
  mul_comm m n ▸ modeq_of_modeq_mul_left m

theorem modeq_and_modeq_iff_modeq_mul {a : ℤ} {b : ℤ} {m : ℤ} {n : ℤ} (hmn : nat.coprime (nat_abs m) (nat_abs n)) : modeq m a b ∧ modeq n a b ↔ modeq (m * n) a b := sorry

theorem gcd_a_modeq (a : ℕ) (b : ℕ) : modeq (↑b) (↑a * nat.gcd_a a b) ↑(nat.gcd a b) := sorry

theorem modeq_add_fac {a : ℤ} {b : ℤ} {n : ℤ} (c : ℤ) (ha : modeq n a b) : modeq n (a + n * c) b := sorry

theorem mod_coprime {a : ℕ} {b : ℕ} (hab : nat.coprime a b) : ∃ (y : ℤ), modeq (↑b) (↑a * y) 1 := sorry

theorem exists_unique_equiv (a : ℤ) {b : ℤ} (hb : 0 < b) : ∃ (z : ℤ), 0 ≤ z ∧ z < b ∧ modeq b z a := sorry

theorem exists_unique_equiv_nat (a : ℤ) {b : ℤ} (hb : 0 < b) : ∃ (z : ℕ), ↑z < b ∧ modeq b (↑z) a := sorry

end modeq

@[simp] theorem mod_mul_right_mod (a : ℤ) (b : ℤ) (c : ℤ) : a % (b * c) % b = a % b :=
  modeq.modeq_of_modeq_mul_right c (modeq.mod_modeq a (b * c))

@[simp] theorem mod_mul_left_mod (a : ℤ) (b : ℤ) (c : ℤ) : a % (b * c) % c = a % c :=
  modeq.modeq_of_modeq_mul_left b (modeq.mod_modeq a (b * c))