import tactic

import data.list.basic
import data.list.infix

universe u
variables {α : Type u} [decidable_eq α]

namespace list

def is_lcp (l l₁ l₂ : list α) : Prop := l <+: l₁ ∧ l <+: l₂ ∧ ∀ t, t <+: l₁ → t <+: l₂ → t <+: l

lemma lcp_unique {l l' l₁ l₂ : list α} : l.is_lcp l₁ l₂ → l'.is_lcp l₁ l₂ → l = l' := by
{ rintros ⟨hl₁, hl₂, hl⟩ ⟨hl'₁, hl'₂, hl'⟩,
  specialize hl l' hl'₁ hl'₂,
  specialize hl' l hl₁ hl₂,
  exact antisymm hl' hl, }

/-- Longest common prefix. -/
def lcp : list α → list α → list α
| []      _       := []
| _       []      := []
| (a::as) (b::bs) := if a = b then a::(lcp as bs) else []

lemma lcp_spec : ∀ (l₁ l₂ : list α), (lcp l₁ l₂).is_lcp l₁ l₂
| []      []      := ⟨prefix_rfl, nil_prefix _, λ _ h _, h⟩
| []      (b::bs) := ⟨prefix_rfl, nil_prefix _, λ _ h _, h⟩
| (a::as) []      := ⟨nil_prefix _, prefix_rfl, λ _ _ h, h⟩
| (a::as) (b::bs) := if h : a = b then by
{ rw [lcp, if_pos h, is_lcp],
  simp [cons_prefix_iff, h],
  rcases lcp_spec as bs with ⟨ha, hb, h⟩,
  refine ⟨ha, hb, λ t ha' hb', _⟩,
  cases t with hd tl, { exact nil_prefix _, },
  rw [cons_prefix_iff] at *,
  exact ⟨ha'.1, h tl ha'.2 hb'.2⟩, }
else by
{ rw [lcp, if_neg h],
  refine ⟨nil_prefix _, nil_prefix _, λ t ha hb, _⟩,
  cases t with hd tl, { exact prefix_rfl, },
  { rw [cons_prefix_iff] at *,
    exact absurd (ha.1.symm.trans hb.1) h, }, }

def psigma_lcp (l₁ l₂ : list α) : Σ' (l : list α), l.is_lcp l₁ l₂ :=
⟨lcp l₁ l₂, lcp_spec l₁ l₂⟩

lemma exists_lcp (l₁ l₂ : list α) : ∃ (l : list α), l.is_lcp l₁ l₂ :=
⟨lcp l₁ l₂, lcp_spec l₁ l₂⟩

lemma exists_unique_lcp (l₁ l₂ : list α) : ∃! (l : list α), l.is_lcp l₁ l₂ := by
{ cases exists_lcp l₁ l₂ with l hl,
  use l, dsimp, exact ⟨hl, λ t ht, lcp_unique ht hl⟩, }

lemma lcp_is_prefix_left {l₁ l₂ : list α} : lcp l₁ l₂ <+: l₁ :=
(lcp_spec l₁ l₂).1

lemma lcp_is_prefix_right {l₁ l₂ : list α} : lcp l₁ l₂ <+: l₂ :=
(lcp_spec l₁ l₂).2.1

lemma prefix_of_lcp {l₁ l₂ l₃ : list α} : l₁ <+: l₂ → l₁ <+: l₃ → l₁ <+: lcp l₂ l₃ :=
(lcp_spec l₂ l₃).2.2 l₁

def with_prefix (α : Type*) := list α

namespace with_prefix

instance : partial_order (with_prefix α) :=
{ le          := is_prefix,
  le_refl     := prefix_refl,
  le_trans    := λ _ _ _, is_prefix.trans,
  le_antisymm := λ _ _ h₁ h₂, eq_of_prefix_of_length_eq h₁ $ h₁.length_le.antisymm h₂.length_le }

instance : order_bot (with_prefix α) := ⟨[], nil_prefix⟩
instance : inhabited (with_prefix α) := ⟨⊥⟩

instance : semilattice_inf (with_prefix α) :=
{ inf              := lcp,
  inf_le_left      := λ _ _, lcp_is_prefix_left,
  inf_le_right     := λ _ _, lcp_is_prefix_right,
  le_inf           := λ _ _ _, prefix_of_lcp,
  ..(by apply_instance : partial_order (with_prefix α)) }

end with_prefix

instance with_prefix.has_le : has_le (with_prefix α) := ⟨is_prefix⟩

def is_lcs (l l₁ l₂ : list α) : Prop := l <:+ l₁ ∧ l <:+ l₂ ∧ ∀ t, t <:+ l₁ → t <:+ l₂ → t <:+ l

lemma lcs_unique {l l' l₁ l₂ : list α} : l.is_lcs l₁ l₂ → l'.is_lcs l₁ l₂ → l = l' := by
{ rintros ⟨hl₁, hl₂, hl⟩ ⟨hl'₁, hl'₂, hl'⟩,
  specialize hl l' hl'₁ hl'₂,
  specialize hl' l hl₁ hl₂,
  exact antisymm hl' hl, }

/-- Longest common suffix. -/
def lcs (l₁ l₂ : list α) : list α :=
(lcp l₁.reverse l₂.reverse).reverse

lemma lcs_spec (l₁ l₂ : list α) : (lcs l₁ l₂).is_lcs l₁ l₂ := by
{ unfold is_lcs lcs,
  simp_rw [← reverse_prefix, reverse_reverse],
  convert lcp_spec l₁.reverse l₂.reverse, ext,
  refine ⟨λ h t, _, λ h t, h t.reverse⟩,
  convert h t.reverse, simp_rw [reverse_reverse], }

def psigma_lcs (l₁ l₂ : list α) : Σ' (l : list α), l.is_lcs l₁ l₂ :=
⟨lcs l₁ l₂, lcs_spec l₁ l₂⟩

lemma exists_lcs (l₁ l₂ : list α) : ∃ (l : list α), l.is_lcs l₁ l₂ :=
⟨lcs l₁ l₂, lcs_spec l₁ l₂⟩

lemma exists_unique_lcs (l₁ l₂ : list α) : ∃! (l : list α), l.is_lcs l₁ l₂ := by
{ cases exists_lcs l₁ l₂ with l hl,
  use l, dsimp, exact ⟨hl, λ t ht, lcs_unique ht hl⟩, }

lemma lcs_is_suffix_left {l₁ l₂ : list α} : lcs l₁ l₂ <:+ l₁ :=
(lcs_spec l₁ l₂).1

lemma lcs_is_suffix_right {l₁ l₂ : list α} : lcs l₁ l₂ <:+ l₂ :=
(lcs_spec l₁ l₂).2.1

lemma suffix_of_lcs {l₁ l₂ l₃ : list α} : l₁ <:+ l₂ → l₁ <:+ l₃ → l₁ <:+ lcs l₂ l₃ :=
(lcs_spec l₂ l₃).2.2 l₁

def with_suffix (α : Type*) := list α

namespace with_suffix

instance : partial_order (with_suffix α) :=
{ le          := is_suffix,
  le_refl     := suffix_refl,
  le_trans    := λ _ _ _, is_suffix.trans,
  le_antisymm := λ _ _ h₁ h₂, eq_of_suffix_of_length_eq h₁ $ h₁.length_le.antisymm h₂.length_le }

instance : order_bot (with_suffix α) := ⟨[], nil_suffix⟩
instance : inhabited (with_suffix α) := ⟨⊥⟩

instance : semilattice_inf (with_suffix α) :=
{ inf              := lcs,
  inf_le_left      := λ _ _, lcs_is_suffix_left,
  inf_le_right     := λ _ _, lcs_is_suffix_right,
  le_inf           := λ _ _ _, suffix_of_lcs,
  ..(by apply_instance : partial_order (with_suffix α)) }

end with_suffix

def reverse_order_iso : with_prefix α ≃o with_suffix α :=
{ to_equiv := ⟨reverse, reverse, reverse_reverse, reverse_reverse⟩,
  map_rel_iff' := λ l₁ l₂, reverse_suffix }

def is_border (l₁ l₂ : list α) : Prop :=
l₁.is_prefix l₂ ∧ l₁.is_suffix l₂

lemma nil_border (l : list α) : [].is_border l := ⟨nil_prefix l, nil_suffix l⟩

@[refl] lemma border_refl (l : list α) : l.is_border l := ⟨prefix_refl l, suffix_refl l⟩

lemma border_rfl {l : list α} : l.is_border l := border_refl _

@[trans] lemma is_border.trans :
  ∀ {l₁ l₂ l₃ : list α}, l₁.is_border l₂ → l₂.is_border l₃ → l₁.is_border l₃
| _ _ _ ⟨hp₁, hs₁⟩ ⟨hp₂, hs₂⟩ := ⟨hp₁.trans hp₂, hs₁.trans hs₂,⟩

protected lemma is_border.sublist {l₁ l₂ : list α}
  (h : l₁.is_border l₂) : l₁ <+ l₂ := h.1.is_infix.sublist

@[simp] lemma reverse_border {l₁ l₂ : list α} :
  (reverse l₁).is_border (reverse l₂) ↔ l₁.is_border l₂ :=
⟨ λ h, ⟨reverse_suffix.mp h.2, reverse_prefix.mp h.1⟩,
  λ h, ⟨reverse_prefix.mpr h.2, reverse_suffix.mpr h.1⟩ ⟩

lemma is_border.length_le {l₁ l₂ : list α}
  (h : l₁.is_border l₂) : l₁.length ≤ l₂.length := length_le_of_sublist h.sublist

lemma eq_of_border_of_length_eq {l₁ l₂ : list α}
  (h : l₁.is_border l₂) : l₁.length = l₂.length → l₁ = l₂ :=
eq_of_sublist_of_length_eq h.sublist

instance : is_partial_order (list α) is_border :=
{ refl     := border_refl,
  trans    := λ _ _ _, is_border.trans,
  antisymm := λ _ _ h₁ h₂, eq_of_border_of_length_eq h₁ $ h₁.length_le.antisymm h₂.length_le }

instance decidable_border (l₁ l₂ : list α) : decidable (l₁.is_border l₂) := and.decidable

lemma drop_border_of_take_border (l : list α) {p : ℕ} (h : (l.take p).is_border l) :
  (l.drop (l.length - p)).is_border l :=
if hp : p ≤ l.length then by
{ have h' := suffix_iff_eq_drop.mp h.2,
  rwa [h', length_take, min_eq_left hp] at h, }
else by rw [tsub_eq_zero_of_le (le_of_not_ge hp), drop]

lemma take_border_of_drop_border (l : list α) {p : ℕ} (h : (l.drop p).is_border l) :
  (l.take (l.length - p)).is_border l := by
{ have h' := prefix_iff_eq_take.mp h.1,
  rwa [h', length_drop] at h, }

lemma take_border_iff_drop_border (l : list α) {p : ℕ} :
  (l.take p).is_border l ↔ (l.drop (l.length - p)).is_border l :=
⟨ l.drop_border_of_take_border, λ h, if hp : p ≤ l.length then
    by convert l.take_border_of_drop_border h; rw [tsub_tsub_cancel_of_le hp]
  else by rw [take_all_of_le (le_of_not_ge hp)] ⟩

lemma drop_border_iff_take_border (l : list α) {p : ℕ} :
  (l.drop p).is_border l ↔ (l.take (l.length - p)).is_border l :=
⟨ l.take_border_of_drop_border, λ h, if hp : p ≤ l.length then
    by convert l.drop_border_of_take_border h; rw [tsub_tsub_cancel_of_le hp]
  else by rw [drop_eq_nil_of_le (le_of_not_ge hp)]; exact nil_border _ ⟩

def longest_prefix_suffix : list α → list α → list α
| l []      := []
| l (b::bs) := if b::bs <+: l then b::bs else l.longest_prefix_suffix bs

lemma longest_prefix_suffix_spec : ∀ (l₁ l₂ : list α),
  longest_prefix_suffix l₁ l₂ <+: l₁ ∧ longest_prefix_suffix l₁ l₂ <:+ l₂ ∧
  ∀ (l : list α), l <+: l₁ ∧ l <:+ l₂ → l.is_border (longest_prefix_suffix l₁ l₂)
| _ []  := by rw [longest_prefix_suffix]; exact ⟨nil_prefix _, suffix_rfl,
                                                 λ l hl, by rw [suffix_nil_iff.mp hl.2]⟩
| l₁ (b::bs) := if h : b::bs <+: l₁ then by
{ rw [longest_prefix_suffix, if_pos h],
  refine ⟨h, suffix_rfl, λ l hl, ⟨prefix_of_prefix_length_le hl.1 h hl.2.length_le, hl.2⟩⟩, }
else by
{ rw [longest_prefix_suffix, if_neg h],
  obtain ⟨h₁, h₂, h'⟩ := longest_prefix_suffix_spec l₁ bs,
  refine ⟨h₁, suffix_cons_iff.mpr (or.inr h₂), λ l hl, _⟩,
  refine h' l ⟨hl.1, (suffix_cons_iff.mp hl.2).resolve_left _⟩,
  rintro rfl, exact h hl.1, }

def is_proper_border (l₁ l₂ : list α) : Prop :=
l₁.is_border l₂ ∧ ¬ l₂.is_border l₁

def longest_proper_border : list α → list α
| []      := []
| (a::as) := longest_prefix_suffix (a::as) as

lemma longest_proper_border_lenght_lt : ∀ (l : list α) (h : l ≠ []),
  l.longest_proper_border.length < l.length
| []      h := absurd rfl h
| (a::as) _ := (longest_prefix_suffix_spec (a::as) as).2.1.length_le.trans_lt
  (lt_of_add_lt_add_right (lt_add_of_le_of_pos (length_cons a as).ge zero_lt_one))

lemma longest_proper_border_spec : ∀ (l : list α), l = [] ∨
  l.longest_proper_border.is_proper_border l ∧
  ∀ (t : list α), t.is_proper_border l → t.is_border l.longest_proper_border
| []      := or.inl rfl
| (a::as) := by
{ obtain ⟨h₁, h₂, h⟩ := longest_prefix_suffix_spec (a::as) as,
  refine or.inr ⟨_, λ t ht, _⟩,
  { refine ⟨⟨h₁, suffix_cons_iff.mpr (or.inr h₂)⟩, _⟩,
    intro h, have hle := h.length_le,
    have hlt := longest_proper_border_lenght_lt (a::as) (λ h, list.no_confusion h),
    exact hlt.not_le hle, },
  { refine h t ⟨ht.1.1, _⟩,
    refine (suffix_cons_iff.mp ht.1.2).resolve_left _,
    rintro rfl, exact ht.2 border_rfl, } }

def is_lcb (l l₁ l₂ : list α) : Prop :=
  l.is_border l₁ ∧ l.is_border l₂ ∧ ∀ t : list α, t.is_border l₁ → t.is_border l₂ → t.is_border l

lemma lcb_unique {l l' l₁ l₂ : list α} : l.is_lcb l₁ l₂ → l'.is_lcb l₁ l₂ → l = l' := by
{ rintros ⟨hl₁, hl₂, hl⟩ ⟨hl'₁, hl'₂, hl'⟩,
  specialize hl l' hl'₁ hl'₂,
  specialize hl' l hl₁ hl₂,
  exact antisymm hl' hl, }

/-- Longest common border. -/
def lcb (l₁ l₂ : list α) : list α :=
longest_prefix_suffix (lcp l₁ l₂) (lcs l₁ l₂)

lemma lcb_spec (l₁ l₂ : list α) : (lcb l₁ l₂).is_lcb l₁ l₂ := by
{ obtain ⟨h₁, h₂, h⟩ := longest_prefix_suffix_spec (lcp l₁ l₂) (lcs l₁ l₂),
  obtain ⟨hp₁, hp₂, hp⟩ := lcp_spec l₁ l₂,
  obtain ⟨hs₁, hs₂, hs⟩ := lcs_spec l₁ l₂,
  refine ⟨⟨h₁.trans hp₁, h₂.trans hs₁⟩, ⟨h₁.trans hp₂, h₂.trans hs₂⟩, λ t ht₁ ht₂, _⟩,
  exact h t ⟨hp t ht₁.1 ht₂.1, hs t ht₁.2 ht₂.2⟩, }

lemma exists_lcb (l₁ l₂ : list α) : ∃ (l : list α), l.is_lcb l₁ l₂ :=
⟨lcb l₁ l₂, lcb_spec l₁ l₂⟩

lemma exists_unique_lcb (l₁ l₂ : list α) : ∃! (l : list α), l.is_lcb l₁ l₂ := by
{ cases exists_lcb l₁ l₂ with l hl,
  use l, dsimp, exact ⟨hl, λ t ht, lcb_unique ht hl⟩, }

lemma lcb_is_border_left {l₁ l₂ : list α} : (lcb l₁ l₂).is_border l₁ :=
(lcb_spec l₁ l₂).1

lemma lcb_is_border_right {l₁ l₂ : list α} : (lcb l₁ l₂).is_border l₂ :=
(lcb_spec l₁ l₂).2.1

lemma border_of_lcb {l₁ l₂ l₃ : list α} :
  l₁.is_border l₂ → l₁.is_border l₃ → l₁.is_border (lcb l₂ l₃) :=
(lcb_spec l₂ l₃).2.2 l₁

def with_border (α : Type*) := list α

namespace with_border

instance : partial_order (with_border α) :=
{ le          := is_border,
  le_refl     := border_refl,
  le_trans    := λ _ _ _, is_border.trans,
  le_antisymm := λ _ _ h₁ h₂, eq_of_border_of_length_eq h₁ $ h₁.length_le.antisymm h₂.length_le }

instance : order_bot (with_border α) := ⟨[], nil_border⟩
instance : inhabited (with_border α) := ⟨⊥⟩

instance : semilattice_inf (with_border α) :=
{ inf              := lcb,
  inf_le_left      := λ _ _, lcb_is_border_left,
  inf_le_right     := λ _ _, lcb_is_border_right,
  le_inf           := λ _ _ _, border_of_lcb,
  ..(by apply_instance : partial_order (with_border α)) }

end with_border

def has_period (l : list α) (p : ℕ) : Prop :=
p ≤ l.length ∧ ∀ (i j : ℕ) (hij : i + p = j) (hi hj),
  l.nth_le i hi = l.nth_le j hj

lemma period_zero (l : list α) : l.has_period 0 :=
⟨zero_le _, λ i j h _ _, by simp_rw [← h, add_zero]⟩

@[refl] lemma period_length (l : list α) : l.has_period l.length :=
⟨le_rfl, λ i j h hi hj, by rw [← h] at hj; exact absurd hj le_add_self.not_lt ⟩

lemma period_of_border {l : list α} {l' : list α} (h : l'.is_border l) :
  l.has_period (l.length - l'.length) := by
{ refine ⟨nat.sub_le _ _, λ i j hij _ hj, _⟩,
  have hi : i < l'.length :=
    by rwa [← hij, ← lt_tsub_iff_right, tsub_tsub_cancel_of_le h.length_le] at hj,
  rw [add_comm] at hij,
  simp_rw [hij.symm, l.nth_le_take _ hi, nth_le_drop,
    (prefix_iff_eq_take.mp h.1).symm, (suffix_iff_eq_drop.mp h.2).symm], }

lemma drop_border_of_period {l : list α} {p : ℕ} (h : l.has_period p) :
  (l.drop p).is_border l := by
{ refine ⟨_, l.drop_suffix p⟩, convert l.take_prefix (l.length - p),
  apply list.ext_le, rw [l.length_take _, l.length_drop _, min_eq_left (nat.sub_le _ _)],
  intros n h₁ h₂, simp_rw [nth_le_take', nth_le_drop', add_comm p n],
  rw [h.2 n], refl, }

lemma take_border_of_period {l : list α} {p : ℕ} (h : l.has_period p) :
  (l.take (l.length - p)).is_border l := by
{ have h' := drop_border_of_period h,
  have x := prefix_iff_eq_take.mp h'.1,
  rwa [x, length_drop] at h', }

lemma period_iff_drop_border {l : list α} {p : ℕ} (h : p ≤ l.length) :
  l.has_period p ↔ (l.drop p).is_border l :=
⟨ drop_border_of_period, λ hl, by
  { convert period_of_border hl,
    simp_rw [length_drop, tsub_tsub_cancel_of_le h], }⟩

lemma period_iff_take_border {l : list α} {p : ℕ} (h : p ≤ l.length) :
  l.has_period p ↔ (l.take (l.length - p)).is_border l :=
by convert period_iff_drop_border h using 1; rw [drop_border_iff_take_border]

lemma reverse_period {l : list α} {p : ℕ} (h : l.has_period p) :
  l.reverse.has_period p := by
{ have hp : p = l.reverse.length - (l.drop p).reverse.length :=
    by simp_rw [length_reverse, length_drop, tsub_tsub_assoc le_rfl h.1, tsub_self, zero_add],
  rw [hp], apply period_of_border, rw [reverse_border],
  exact drop_border_of_period h, }

lemma reverse_period_iff (l : list α) (p : ℕ) :
  l.reverse.has_period p ↔ l.has_period p :=
⟨λ h, by rw [← l.reverse_reverse]; exact reverse_period h, reverse_period⟩

lemma take_period {l : list α} {p : ℕ} (h : l.has_period p)
  {n : ℕ} (hn : n ≤ l.length) (hnp : p ≤ n) : (l.take n).has_period p := by
{ refine ⟨by rwa [length_take, min_eq_left hn], λ i j hij hi hj, _⟩,
  simp_rw [nth_le_take'], rwa [h.2], }

lemma prefix_period {l : list α} {p : ℕ} (h : l.has_period p)
  {l' : list α} (hl : l' <+: l) (hp : p ≤ l'.length) : l'.has_period p :=
by rw [prefix_iff_eq_take.mp hl]; exact take_period h hl.length_le hp

lemma drop_period {l : list α} {p : ℕ} (h : l.has_period p)
  {n : ℕ} (hn : n ≤ l.length) (hnp : p ≤ n) : (l.drop (l.length - n)).has_period p := by
{ refine ⟨by rwa [length_drop, tsub_tsub_cancel_of_le hn], λ i j hij hi hj, _⟩,
  simp_rw [nth_le_drop'], exact h.2 (l.length - n + i) (l.length - n + j)
                            (by rw [← hij, add_assoc]) _ _, }

lemma suffix_period {l : list α} {p : ℕ} (h : l.has_period p)
  {l' : list α} (hl : l' <:+ l) (hp : p ≤ l'.length) : l'.has_period p := by
by rw [suffix_iff_eq_drop.mp hl]; exact drop_period h hl.length_le hp

lemma infix_period {l : list α} {p : ℕ} (h : l.has_period p)
  {l' : list α} (hl : l' <:+: l) (hp : p ≤ l'.length) : l'.has_period p := by
{ rw [infix_iff_prefix_suffix] at hl, obtain ⟨t, ht₁, ht₂⟩ := hl,
  apply prefix_period _ ht₁ hp,
  exact suffix_period h ht₂ (hp.trans ht₁.length_le), }

lemma drop_period_sub_of_period_period {l : list α} {p q : ℕ}
  (hp : l.has_period p) (hq : l.has_period q) (h : p ≤ q) : (l.drop p).has_period (q - p) := by
{ refine ⟨by rw [length_drop]; exact tsub_le_tsub_right hq.1 p, λ n m hnm hn hm, _⟩,
  simp_rw [nth_le_drop', p.add_comm],
  have hnp := hn, have hnq := hm,
  rw [length_drop, lt_tsub_iff_right] at hnp hnq,
  simp_rw [hnm.symm, add_assoc, tsub_add_cancel_of_le h] at hnq ⊢,
  have hp' := hp.2 n (n + p) rfl (lt_of_add_lt_of_nonneg_left hnp p.zero_le) hnp,
  have hq' := hq.2 n (n + q) rfl (lt_of_add_lt_of_nonneg_left hnq q.zero_le) hnq,
  simp_rw [← hp', ← hq'], }

lemma take_period_sub_of_period_period {l : list α} {p q : ℕ}
  (hp : l.has_period p) (hq : l.has_period q) (h : p ≤ q) :
  (l.take (l.length - p)).has_period (q - p) := by
{ rw [← l.reverse_reverse, reverse_take, l.reverse_reverse, reverse_period_iff],
  rw [← reverse_period_iff] at hp hq,
  convert drop_period_sub_of_period_period hp hq h,
  rw [reverse_period_iff] at hp hq,
  rwa [length_reverse, tsub_tsub_cancel_of_le hp.1],
  simp_rw [length_reverse, tsub_le_self], }

lemma period_iff_forall_mod_eq (l : list α) (p : ℕ) : l.has_period p ↔
  ∃ (hp : p ≤ l.length), ∀ (i : ℕ) (hi), l.nth_le i hi = l.nth_le (i % p)
  ( if p0 : p = 0 then (by rwa [p0, nat.mod_zero])
    else (i.mod_lt (pos_iff_ne_zero.mpr p0)).trans_le hp ) := by
{ split,
  { cases dec_em (p = 0) with p0 p0, { simp [p0], },
    replace p0 := pos_iff_ne_zero.mpr p0,
    rintro ⟨h₁, h₂⟩, use h₁,
    intros i hi,
    induction i using nat.strong_rec_on with i h,
    { cases dec_em (i < p) with hip hip, { simp_rw [nat.mod_eq_of_lt hip], },
      { replace hip := le_of_not_gt hip,
        simp_rw [nat.mod_eq_sub_mod hip],
        have hip' : i - p < l.length := tsub_le_self.trans_lt hi,
        convert ← h (i - p) (tsub_lt_self (p0.trans_le hip) p0) hip' using 1,
        apply h₂, exact tsub_add_cancel_of_le hip, }, }, },
  { rintro ⟨h₁, h₂⟩, use h₁,
    intros i j hij hi hj, simp_rw [h₂ i hi, h₂ j hj, ← hij,
      nat.mod_eq_sub_mod (self_le_add_left p i), add_tsub_cancel_right], }, }

lemma nth_le_prefix {l : list α} {l' : list α} (hl : l' <+: l) {i : ℕ} (h : i < l'.length) :
  l'.nth_le i h = l.nth_le i (h.trans_le hl.length_le) :=
by rw [prefix_iff_eq_take] at hl; conv_lhs { congr, rw [hl], }; rwa [← nth_le_take]

lemma period_of_prefix_period_dvd {l : list α} {p : ℕ} (p0 : 0 < p) (hp : l.has_period p)
  {l' : list α} (hl : l' <+: l) (hpl : p ≤ l'.length)
  {d : ℕ} (hd : l'.has_period d) (hdp : d ∣ p) :
  l.has_period d := by
{ rw [period_iff_forall_mod_eq] at *,
  use hd.fst.trans hl.length_le,
  intros i hi, rw [hp.snd],
  convert hd.snd (i % p) ((i.mod_lt p0).trans_le hpl) using 1,
  rw [nth_le_prefix hl], simp_rw [nth_le_prefix hl, i.mod_mod_of_dvd hdp], }

lemma period_of_take_period_dvd {l : list α} {p : ℕ} (p0 : 0 < p) (hp : l.has_period p)
  {n : ℕ} (hpn : p ≤ n) {d : ℕ} (hd : (l.take n).has_period d) (hdp : d ∣ p) :
  l.has_period d :=
if hnl : n ≤ l.length then
  period_of_prefix_period_dvd p0 hp (l.take_prefix n)
    (by rwa [length_take, min_eq_left hnl]) hd hdp
else by rwa [take_all_of_le (le_of_not_ge hnl)] at hd

lemma period_of_suffix_period_dvd {l : list α} {p : ℕ} (p0 : 0 < p) (hp : l.has_period p)
  {l' : list α} (hl : l' <:+ l) (hpl : p ≤ l'.length)
  {d : ℕ} (hd : l'.has_period d) (hdp : d ∣ p) :
  l.has_period d := by
{ rw [← reverse_period_iff],
  exact period_of_prefix_period_dvd p0 (reverse_period hp) (reverse_prefix.mpr hl)
    (by rwa [length_reverse]) (reverse_period hd) hdp, }

lemma period_of_drop_period_dvd {l : list α} {p : ℕ} (p0 : 0 < p) (hp : l.has_period p)
  {n : ℕ} (hpn : p ≤ n) {d : ℕ} (hd : (l.drop (l.length - n)).has_period d) (hdp : d ∣ p) :
  l.has_period d :=
if hnl : n ≤ l.length then
  period_of_suffix_period_dvd p0 hp (l.drop_suffix (l.length - n))
    (by rwa [length_drop, tsub_tsub_cancel_of_le hnl]) hd hdp
else by rwa [tsub_eq_zero_of_le (le_of_not_ge hnl)] at hd

lemma period_of_infix_period_dvd {l : list α} {p : ℕ} (p0 : 0 < p) (hp : l.has_period p)
  {l' : list α} (hl : l' <:+: l) (hpl : p ≤ l'.length)
  {d : ℕ} (hd : l'.has_period d) (hdp : d ∣ p) :
  l.has_period d := by
{ rw [infix_iff_prefix_suffix] at hl, obtain ⟨t, ht₁, ht₂⟩ := hl,
  have hpt : p ≤ t.length := hpl.trans ht₁.length_le,
  apply period_of_suffix_period_dvd p0 hp ht₂ hpt _ hdp,
  exact period_of_prefix_period_dvd p0 (suffix_period hp ht₂ hpt) ht₁ hpl hd hdp, }

lemma periodicity_lemma_aux (l : list α) (p q : ℕ) (hp : l.has_period p) (hq : l.has_period q)
  (h : p + q ≤ l.length + p.gcd q) (k : ℕ) (k_def : p / p.gcd q + q / p.gcd q = k)
  (hk : ∀ (m : ℕ), m < k → ∀ {l : list α} {p q : ℕ},
    p + q ≤ l.length + p.gcd q → l.has_period p → l.has_period q →
    p / p.gcd q + q / p.gcd q = m → l.has_period (p.gcd q))
  (p0 : 0 < p) (q0 : 0 < q) (d0 : 0 < p.gcd q) (hpq : p < q) : l.has_period (p.gcd q) := by
{ have dvd_p : p.gcd q ∣ p := p.gcd_dvd_left q,
  have dvd_q : p.gcd q ∣ q := p.gcd_dvd_right q,
  have dvd_sub := nat.dvd_sub' dvd_q dvd_p,
  have : p ≤ l.length - p := by
  { apply le_tsub_of_add_le_left, rw [← add_le_add_iff_right (p.gcd q)],
    apply trans _ h, rw [add_assoc, add_le_add_iff_left],
    apply add_le_of_le_tsub_left_of_le hpq.le,
    exact nat.le_of_dvd (tsub_pos_of_lt hpq) dvd_sub, },
  have hp' : (drop (l.length - (l.length - p)) l).has_period p :=
    drop_period hp tsub_le_self this,
  rw [tsub_tsub_cancel_of_le hp.1] at hp',
  have hq' := drop_period_sub_of_period_period hp hq hpq.le,
  have gcd_eq : p.gcd (q - p) = p.gcd q :=
    by rw [← nat.gcd_add_self_right, tsub_add_cancel_of_le hpq.le],
  have h' : p + (q - p) ≤ (drop p l).length + p.gcd (q - p) :=
    by rwa [length_drop, add_tsub_cancel_of_le hpq.le, gcd_eq,
      tsub_add_eq_add_tsub hp.1, le_tsub_iff_left (hp.1.trans le_self_add)],
  have hm : p / p.gcd q + (q - p) / p.gcd q < k := by
  { rw [← k_def, add_lt_add_iff_left], apply lt_of_mul_lt_mul_right _ d0.le,
    simp_rw [nat.div_mul_cancel dvd_q, nat.div_mul_cancel dvd_sub],
    exact tsub_lt_self q0 p0, },
  specialize hk (p / p.gcd q + (q - p) / p.gcd q) hm h' hp' hq' _;
  simp_rw [gcd_eq] at ⊢ hk,
  refine period_of_drop_period_dvd p0 hp this _ dvd_p,
  convert hk, rw [tsub_tsub_cancel_of_le hp.1], }

lemma periodicity_lemma {l : list α} {p q : ℕ} (hp : l.has_period p) (hq : l.has_period q)
  (h : p + q ≤ l.length + p.gcd q) : l.has_period (p.gcd q) := by
{ induction k_def : p / (p.gcd q) + q / (p.gcd q) using nat.strong_rec_on with k hk
                                                  generalizing l p q h,
  dsimp at hk,
  cases dec_em (p = 0) with p0 p0, rwa [p0, nat.gcd_zero_left],
  cases dec_em (q = 0) with q0 q0, rwa [q0, nat.gcd_zero_right],
  replace p0 := pos_iff_ne_zero.mpr p0,
  replace q0 := pos_iff_ne_zero.mpr q0,
  have d0 := nat.gcd_pos_of_pos_left q p0,
  rcases nat.lt_trichotomy p q with (hpq | hpq | hpq),
  { exact periodicity_lemma_aux l p q hp hq h k k_def hk p0 q0 d0 hpq, },
  { rwa [hpq, nat.gcd_self] at *, },
  { rw [nat.gcd_comm] at *, rw [add_comm] at h k_def,
    exact periodicity_lemma_aux l q p hq hp h k k_def hk q0 p0 d0 hpq, }, }

end list


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import data.real.ereal
import topology.algebra.order.monotone_continuity
import topology.instances.ennreal

/-!
# Topological structure on `ereal`

We endow `ereal` with the order topology, and prove basic properties of this topology.

## Main results

* `coe : ℝ → ereal` is an open embedding
* `coe : ℝ≥0∞ → ereal` is an embedding
* The addition on `ereal` is continuous except at `(⊥, ⊤)` and at `(⊤, ⊥)`.
* Negation is a homeomorphism on `ereal`.

## Implementation

Most proofs are adapted from the corresponding proofs on `ℝ≥0∞`.
-/

noncomputable theory

open classical set filter metric topological_space
open_locale classical topological_space ennreal nnreal big_operators filter

variables {α : Type*} [topological_space α]

namespace ereal

instance : topological_space ereal := preorder.topology ereal

instance : order_topology ereal := ⟨rfl⟩

instance : t2_space ereal := by apply_instance

instance : second_countable_topology ereal :=
⟨begin
  refine ⟨⋃ (q : ℚ), {{a : ereal | a < (q : ℝ)}, {a : ereal | ((q : ℝ) : ereal) < a}},
    countable_Union (λ a, (countable_singleton _).insert _), _⟩,
  refine le_antisymm
    (le_generate_from $ by simp [or_imp_distrib, is_open_lt', is_open_gt'] {contextual := tt}) _,
  apply le_generate_from (λ s h, _),
  rcases h with ⟨a, hs | hs⟩;
  [ rw show s = ⋃q∈{q:ℚ | a < (q : ℝ)}, {b | ((q : ℝ) : ereal) < b},
      by { ext x, simpa only [hs, exists_prop, mem_Union] using lt_iff_exists_rat_btwn },
    rw show s = ⋃q∈{q:ℚ | ((q : ℝ) : ereal) < a}, {b | b < ((q : ℝ) : ereal)},
      by { ext x, simpa only [hs, and_comm, exists_prop, mem_Union] using lt_iff_exists_rat_btwn }];
  { apply is_open_Union, intro q,
    apply is_open_Union, intro hq,
    apply generate_open.basic,
    exact mem_Union.2 ⟨q, by simp⟩ },
end⟩

/-! ### Real coercion -/

lemma embedding_coe : embedding (coe : ℝ → ereal) :=
⟨⟨begin
  refine le_antisymm _ _,
  { rw [@order_topology.topology_eq_generate_intervals ereal _,
      ← coinduced_le_iff_le_induced],
    refine le_generate_from (assume s ha, _),
    rcases ha with ⟨a, rfl | rfl⟩,
    show is_open {b : ℝ | a < ↑b},
    { induction a using ereal.rec,
      { simp only [is_open_univ, bot_lt_coe, set_of_true] },
      { simp only [ereal.coe_lt_coe_iff], exact is_open_Ioi },
      { simp only [set_of_false, is_open_empty, not_top_lt] } },
    show is_open {b : ℝ | ↑b < a},
    { induction a using ereal.rec,
      { simp only [not_lt_bot, set_of_false, is_open_empty] },
      { simp only [ereal.coe_lt_coe_iff], exact is_open_Iio },
      { simp only [is_open_univ, coe_lt_top, set_of_true] } } },
  { rw [@order_topology.topology_eq_generate_intervals ℝ _],
    refine le_generate_from (assume s ha, _),
    rcases ha with ⟨a, rfl | rfl⟩,
    exact ⟨Ioi a, is_open_Ioi, by simp [Ioi]⟩,
    exact ⟨Iio a, is_open_Iio, by simp [Iio]⟩ }
  end⟩,
  assume a b, by simp only [imp_self, ereal.coe_eq_coe_iff]⟩

lemma open_embedding_coe : open_embedding (coe : ℝ → ereal) :=
⟨embedding_coe,
begin
  convert @is_open_Ioo ereal _ _ _ ⊥ ⊤,
  ext x,
  induction x using ereal.rec,
  { simp only [left_mem_Ioo, mem_range, coe_ne_bot, exists_false, not_false_iff] },
  { simp only [mem_range_self, mem_Ioo, bot_lt_coe, coe_lt_top, and_self] },
  { simp only [mem_range, right_mem_Ioo, exists_false, coe_ne_top] }
end⟩

@[norm_cast] lemma tendsto_coe {α : Type*} {f : filter α} {m : α → ℝ} {a : ℝ} :
  tendsto (λ a, (m a : ereal)) f (𝓝 ↑a) ↔ tendsto m f (𝓝 a) :=
embedding_coe.tendsto_nhds_iff.symm

lemma _root_.continuous_coe_real_ereal : continuous (coe : ℝ → ereal) :=
embedding_coe.continuous

lemma continuous_coe_iff {f : α → ℝ} :
  continuous (λa, (f a : ereal)) ↔ continuous f :=
embedding_coe.continuous_iff.symm

lemma nhds_coe {r : ℝ} : 𝓝 (r : ereal) = (𝓝 r).map coe :=
(open_embedding_coe.map_nhds_eq r).symm

lemma nhds_coe_coe {r p : ℝ} :
  𝓝 ((r : ereal), (p : ereal)) = (𝓝 (r, p)).map (λp:ℝ × ℝ, (p.1, p.2)) :=
((open_embedding_coe.prod open_embedding_coe).map_nhds_eq (r, p)).symm

lemma tendsto_to_real {a : ereal} (ha : a ≠ ⊤) (h'a : a ≠ ⊥) :
  tendsto ereal.to_real (𝓝 a) (𝓝 a.to_real) :=
begin
  lift a to ℝ using and.intro ha h'a,
  rw [nhds_coe, tendsto_map'_iff],
  exact tendsto_id
end

lemma continuous_on_to_real : continuous_on ereal.to_real ({⊥, ⊤} : set ereal).compl :=
λ a ha, continuous_at.continuous_within_at (tendsto_to_real
  (by { simp [not_or_distrib] at ha, exact ha.2 }) (by { simp [not_or_distrib] at ha, exact ha.1 }))

/-- The set of finite `ereal` numbers is homeomorphic to `ℝ`. -/
def ne_bot_top_homeomorph_real : ({⊥, ⊤} : set ereal).compl ≃ₜ ℝ :=
{ continuous_to_fun := continuous_on_iff_continuous_restrict.1 continuous_on_to_real,
  continuous_inv_fun := continuous_subtype_mk _ continuous_coe_real_ereal,
  .. ne_top_bot_equiv_real }

/-! ### ennreal coercion -/

lemma embedding_coe_ennreal : embedding (coe : ℝ≥0∞ → ereal) :=
⟨⟨begin
  refine le_antisymm _ _,
  { rw [@order_topology.topology_eq_generate_intervals ereal _,
      ← coinduced_le_iff_le_induced],
    refine le_generate_from (assume s ha, _),
    rcases ha with ⟨a, rfl | rfl⟩,
    show is_open {b : ℝ≥0∞ | a < ↑b},
    { induction a using ereal.rec with x,
      { simp only [is_open_univ, bot_lt_coe_ennreal, set_of_true] },
      { rcases le_or_lt 0 x with h|h,
        { have : (x : ereal) = ((id ⟨x, h⟩ : ℝ≥0) : ℝ≥0∞) := rfl,
          rw this,
          simp only [id.def, coe_ennreal_lt_coe_ennreal_iff],
          exact is_open_Ioi, },
        { have : ∀ (y : ℝ≥0∞), (x : ereal) < y := λ y,
            (ereal.coe_lt_coe_iff.2 h).trans_le (coe_ennreal_nonneg _),
          simp only [this, is_open_univ, set_of_true] } },
      { simp only [set_of_false, is_open_empty, not_top_lt] } },
    show is_open {b : ℝ≥0∞ | ↑b < a},
    { induction a using ereal.rec with x,
      { simp only [not_lt_bot, set_of_false, is_open_empty] },
      { rcases le_or_lt 0 x with h|h,
        { have : (x : ereal) = ((id ⟨x, h⟩ : ℝ≥0) : ℝ≥0∞) := rfl,
          rw this,
          simp only [id.def, coe_ennreal_lt_coe_ennreal_iff],
          exact is_open_Iio, },
        { convert is_open_empty,
          apply eq_empty_iff_forall_not_mem.2 (λ y hy, lt_irrefl (x : ereal) _),
          exact ((ereal.coe_lt_coe_iff.2 h).trans_le (coe_ennreal_nonneg y)).trans hy } },
      { simp only [← coe_ennreal_top, coe_ennreal_lt_coe_ennreal_iff],
        exact is_open_Iio } } },
  { rw [@order_topology.topology_eq_generate_intervals ℝ≥0∞ _],
    refine le_generate_from (assume s ha, _),
    rcases ha with ⟨a, rfl | rfl⟩,
    exact ⟨Ioi a, is_open_Ioi, by simp [Ioi]⟩,
    exact ⟨Iio a, is_open_Iio, by simp [Iio]⟩ }
  end⟩,
  assume a b, by simp only [imp_self, coe_ennreal_eq_coe_ennreal_iff]⟩

@[norm_cast] lemma tendsto_coe_ennreal {α : Type*} {f : filter α} {m : α → ℝ≥0∞} {a : ℝ≥0∞} :
  tendsto (λ a, (m a : ereal)) f (𝓝 ↑a) ↔ tendsto m f (𝓝 a) :=
embedding_coe_ennreal.tendsto_nhds_iff.symm

lemma _root_.continuous_coe_ennreal_ereal : continuous (coe : ℝ≥0∞ → ereal) :=
embedding_coe_ennreal.continuous

lemma continuous_coe_ennreal_iff {f : α → ℝ≥0∞} :
  continuous (λa, (f a : ereal)) ↔ continuous f :=
embedding_coe_ennreal.continuous_iff.symm

/-! ### Neighborhoods of infinity -/

lemma nhds_top : 𝓝 (⊤ : ereal) = ⨅ a ≠ ⊤, 𝓟 (Ioi a) :=
nhds_top_order.trans $ by simp [lt_top_iff_ne_top, Ioi]

lemma nhds_top' : 𝓝 (⊤ : ereal) = ⨅ a : ℝ, 𝓟 (Ioi a) :=
begin
  rw [nhds_top],
  apply le_antisymm,
  { exact infi_mono' (λ x, ⟨x, by simp⟩) },
  { refine le_infi (λ r, le_infi (λ hr, _)),
    induction r using ereal.rec,
    { exact (infi_le _ 0).trans (by simp) },
    { exact infi_le _ _ },
    { simpa using hr, } }
end

lemma mem_nhds_top_iff {s : set ereal} :
  s ∈ 𝓝 (⊤ : ereal) ↔ ∃ (y : ℝ), Ioi (y : ereal) ⊆ s :=
begin
  rw [nhds_top', mem_infi_of_directed],
  { refl },
  exact λ x y, ⟨max x y, by simp [le_refl], by simp [le_refl]⟩,
end

lemma tendsto_nhds_top_iff_real {α : Type*} {m : α → ereal} {f : filter α} :
  tendsto m f (𝓝 ⊤) ↔ ∀ x : ℝ, ∀ᶠ a in f, ↑x < m a :=
by simp only [nhds_top', mem_Ioi, tendsto_infi, tendsto_principal]

lemma nhds_bot : 𝓝 (⊥ : ereal) = ⨅ a ≠ ⊥, 𝓟 (Iio a) :=
nhds_bot_order.trans $ by simp [bot_lt_iff_ne_bot]

lemma nhds_bot' : 𝓝 (⊥ : ereal) = ⨅ a : ℝ, 𝓟 (Iio a) :=
begin
  rw [nhds_bot],
  apply le_antisymm,
  { exact infi_mono' (λ x, ⟨x, by simp⟩) },
  { refine le_infi (λ r, le_infi (λ hr, _)),
    induction r using ereal.rec,
    { simpa using hr },
    { exact infi_le _ _ },
    { exact (infi_le _ 0).trans (by simp) } }
end

lemma mem_nhds_bot_iff {s : set ereal} :
  s ∈ 𝓝 (⊥ : ereal) ↔ ∃ (y : ℝ), Iio (y : ereal) ⊆ s :=
begin
  rw [nhds_bot', mem_infi_of_directed],
  { refl },
  exact λ x y, ⟨min x y, by simp [le_refl], by simp [le_refl]⟩,
end

lemma tendsto_nhds_bot_iff_real {α : Type*} {m : α → ereal} {f : filter α} :
  tendsto m f (𝓝 ⊥) ↔ ∀ x : ℝ, ∀ᶠ a in f, m a < x :=
by simp only [nhds_bot', mem_Iio, tendsto_infi, tendsto_principal]

/-! ### Continuity of addition -/

lemma continuous_at_add_coe_coe (a b :ℝ) :
  continuous_at (λ (p : ereal × ereal), p.1 + p.2) (a, b) :=
by simp only [continuous_at, nhds_coe_coe, ← coe_add, tendsto_map'_iff, (∘),
    tendsto_coe, tendsto_add]

lemma continuous_at_add_top_coe (a : ℝ) :
  continuous_at (λ (p : ereal × ereal), p.1 + p.2) (⊤, a) :=
begin
  simp only [continuous_at, tendsto_nhds_top_iff_real, top_add, nhds_prod_eq],
  assume r,
  rw eventually_prod_iff,
  refine ⟨λ z, ((r - (a - 1): ℝ) : ereal) < z, Ioi_mem_nhds (coe_lt_top _),
          λ z, ((a - 1 : ℝ) : ereal) < z, Ioi_mem_nhds (by simp [zero_lt_one]),
          λ x hx y hy, _⟩,
  dsimp,
  convert add_lt_add hx hy,
  simp,
end

lemma continuous_at_add_coe_top (a : ℝ) :
  continuous_at (λ (p : ereal × ereal), p.1 + p.2) (a, ⊤) :=
begin
  change continuous_at ((λ (p : ereal × ereal), p.2 + p.1) ∘ prod.swap) (a, ⊤),
  apply continuous_at.comp _ continuous_swap.continuous_at,
  simp_rw add_comm,
  exact continuous_at_add_top_coe a
end

lemma continuous_at_add_top_top :
  continuous_at (λ (p : ereal × ereal), p.1 + p.2) (⊤, ⊤) :=
begin
  simp only [continuous_at, tendsto_nhds_top_iff_real, top_add, nhds_prod_eq],
  assume r,
  rw eventually_prod_iff,
  refine ⟨λ z, (r : ereal) < z, Ioi_mem_nhds (coe_lt_top _),
          λ z, ((0 : ℝ) : ereal) < z, Ioi_mem_nhds (by simp [zero_lt_one]),
          λ x hx y hy, _⟩,
  dsimp,
  convert add_lt_add hx hy,
  simp,
end

lemma continuous_at_add_bot_coe (a : ℝ) :
  continuous_at (λ (p : ereal × ereal), p.1 + p.2) (⊥, a) :=
begin
  simp only [continuous_at, tendsto_nhds_bot_iff_real, nhds_prod_eq, bot_add_coe],
  assume r,
  rw eventually_prod_iff,
  refine ⟨λ z, z < ((r - (a + 1): ℝ) : ereal), Iio_mem_nhds (bot_lt_coe _),
          λ z, z < ((a + 1 : ℝ) : ereal), Iio_mem_nhds (by simp [-coe_add, zero_lt_one]),
          λ x hx y hy, _⟩,
  dsimp,
  convert add_lt_add hx hy,
  dsimp,
  ring,
end

lemma continuous_at_add_coe_bot (a : ℝ) :
  continuous_at (λ (p : ereal × ereal), p.1 + p.2) (a, ⊥) :=
begin
  change continuous_at ((λ (p : ereal × ereal), p.2 + p.1) ∘ prod.swap) (a, ⊥),
  apply continuous_at.comp _ continuous_swap.continuous_at,
  simp_rw add_comm,
  exact continuous_at_add_bot_coe a
end

lemma continuous_at_add_bot_bot :
  continuous_at (λ (p : ereal × ereal), p.1 + p.2) (⊥, ⊥) :=
begin
  simp only [continuous_at, tendsto_nhds_bot_iff_real, nhds_prod_eq, bot_add_bot],
  assume r,
  rw eventually_prod_iff,
  refine ⟨λ z, z < r, Iio_mem_nhds (bot_lt_coe _),
          λ z, z < 0, Iio_mem_nhds (bot_lt_coe _),
          λ x hx y hy, _⟩,
  dsimp,
  convert add_lt_add hx hy,
  simp
end

/-- The addition on `ereal` is continuous except where it doesn't make sense (i.e., at `(⊥, ⊤)`
and at `(⊤, ⊥)`). -/
lemma continuous_at_add {p : ereal × ereal} (h : p.1 ≠ ⊤ ∨ p.2 ≠ ⊥) (h' : p.1 ≠ ⊥ ∨ p.2 ≠ ⊤) :
  continuous_at (λ (p : ereal × ereal), p.1 + p.2) p :=
begin
  rcases p with ⟨x, y⟩,
  induction x using ereal.rec; induction y using ereal.rec,
  { exact continuous_at_add_bot_bot },
  { exact continuous_at_add_bot_coe _ },
  { simpa using h' },
  { exact continuous_at_add_coe_bot _ },
  { exact continuous_at_add_coe_coe _ _ },
  { exact continuous_at_add_coe_top _ },
  { simpa using h },
  { exact continuous_at_add_top_coe _ },
  { exact continuous_at_add_top_top },
end

/-! ### Negation-/

/-- Negation on `ereal` as a homeomorphism -/
def neg_homeo : ereal ≃ₜ ereal :=
neg_order_iso.to_homeomorph

end ereal


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker
-/

import algebra.associated
import algebra.group_power.lemmas
import algebra.ring.regular

/-!
# Monoids with normalization functions, `gcd`, and `lcm`

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

This file defines extra structures on `cancel_comm_monoid_with_zero`s, including `is_domain`s.

## Main Definitions

* `normalization_monoid`
* `gcd_monoid`
* `normalized_gcd_monoid`
* `gcd_monoid_of_gcd`, `gcd_monoid_of_exists_gcd`, `normalized_gcd_monoid_of_gcd`,
  `normalized_gcd_monoid_of_exists_gcd`
* `gcd_monoid_of_lcm`, `gcd_monoid_of_exists_lcm`, `normalized_gcd_monoid_of_lcm`,
  `normalized_gcd_monoid_of_exists_lcm`

For the `normalized_gcd_monoid` instances on `ℕ` and `ℤ`, see `ring_theory.int.basic`.

## Implementation Notes

* `normalization_monoid` is defined by assigning to each element a `norm_unit` such that multiplying
by that unit normalizes the monoid, and `normalize` is an idempotent monoid homomorphism. This
definition as currently implemented does casework on `0`.

* `gcd_monoid` contains the definitions of `gcd` and `lcm` with the usual properties. They are
  both determined up to a unit.

* `normalized_gcd_monoid` extends `normalization_monoid`, so the `gcd` and `lcm` are always
  normalized. This makes `gcd`s of polynomials easier to work with, but excludes Euclidean domains,
  and monoids without zero.

* `gcd_monoid_of_gcd` and `normalized_gcd_monoid_of_gcd` noncomputably construct a `gcd_monoid`
  (resp. `normalized_gcd_monoid`) structure just from the `gcd` and its properties.

* `gcd_monoid_of_exists_gcd` and `normalized_gcd_monoid_of_exists_gcd` noncomputably construct a
  `gcd_monoid` (resp. `normalized_gcd_monoid`) structure just from a proof that any two elements
  have a (not necessarily normalized) `gcd`.

* `gcd_monoid_of_lcm` and `normalized_gcd_monoid_of_lcm` noncomputably construct a `gcd_monoid`
  (resp. `normalized_gcd_monoid`) structure just from the `lcm` and its properties.

* `gcd_monoid_of_exists_lcm` and `normalized_gcd_monoid_of_exists_lcm` noncomputably construct a
  `gcd_monoid` (resp. `normalized_gcd_monoid`) structure just from a proof that any two elements
  have a (not necessarily normalized) `lcm`.

## TODO

* Port GCD facts about nats, definition of coprime
* Generalize normalization monoids to commutative (cancellative) monoids with or without zero

## Tags

divisibility, gcd, lcm, normalize
-/

variables {α : Type*}

/-- Normalization monoid: multiplying with `norm_unit` gives a normal form for associated
elements. -/
@[protect_proj] class normalization_monoid (α : Type*)
  [cancel_comm_monoid_with_zero α] :=
(norm_unit : α → αˣ)
(norm_unit_zero      : norm_unit 0 = 1)
(norm_unit_mul       : ∀{a b}, a ≠ 0 → b ≠ 0 → norm_unit (a * b) = norm_unit a * norm_unit b)
(norm_unit_coe_units : ∀(u : αˣ), norm_unit u = u⁻¹)

export normalization_monoid (norm_unit norm_unit_zero norm_unit_mul norm_unit_coe_units)

attribute [simp] norm_unit_coe_units norm_unit_zero norm_unit_mul

section normalization_monoid
variables [cancel_comm_monoid_with_zero α] [normalization_monoid α]

@[simp] theorem norm_unit_one : norm_unit (1:α) = 1 :=
norm_unit_coe_units 1

/-- Chooses an element of each associate class, by multiplying by `norm_unit` -/
def normalize : α →*₀ α :=
{ to_fun := λ x, x * norm_unit x,
  map_zero' := by simp,
  map_one' := by rw [norm_unit_one, units.coe_one, mul_one],
  map_mul' := λ x y,
  classical.by_cases (λ hx : x = 0, by rw [hx, zero_mul, zero_mul, zero_mul]) $ λ hx,
  classical.by_cases (λ hy : y = 0, by rw [hy, mul_zero, zero_mul, mul_zero]) $ λ hy,
  by simp only [norm_unit_mul hx hy, units.coe_mul]; simp only [mul_assoc, mul_left_comm y], }

theorem associated_normalize (x : α) : associated x (normalize x) :=
⟨_, rfl⟩

theorem normalize_associated (x : α) : associated (normalize x) x :=
(associated_normalize _).symm

lemma associated_normalize_iff {x y : α} :
  associated x (normalize y) ↔ associated x y :=
⟨λ h, h.trans (normalize_associated y), λ h, h.trans (associated_normalize y)⟩

lemma normalize_associated_iff {x y : α} :
  associated (normalize x) y ↔ associated x y :=
⟨λ h, (associated_normalize _).trans h, λ h, (normalize_associated _).trans h⟩

lemma associates.mk_normalize (x : α) : associates.mk (normalize x) = associates.mk x :=
associates.mk_eq_mk_iff_associated.2 (normalize_associated _)

@[simp] lemma normalize_apply (x : α) : normalize x = x * norm_unit x := rfl

@[simp] lemma normalize_zero : normalize (0 : α) = 0 := normalize.map_zero

@[simp] lemma normalize_one : normalize (1 : α) = 1 := normalize.map_one

lemma normalize_coe_units (u : αˣ) : normalize (u : α) = 1 := by simp

lemma normalize_eq_zero {x : α} : normalize x = 0 ↔ x = 0 :=
⟨λ hx, (associated_zero_iff_eq_zero x).1 $ hx ▸ associated_normalize _,
  by rintro rfl; exact normalize_zero⟩

lemma normalize_eq_one {x : α} : normalize x = 1 ↔ is_unit x :=
⟨λ hx, is_unit_iff_exists_inv.2 ⟨_, hx⟩, λ ⟨u, hu⟩, hu ▸ normalize_coe_units u⟩

@[simp] theorem norm_unit_mul_norm_unit (a : α) : norm_unit (a * norm_unit a) = 1 :=
begin
  nontriviality α using [subsingleton.elim a 0],
  obtain rfl|h := eq_or_ne a 0,
  { rw [norm_unit_zero, zero_mul, norm_unit_zero] },
  { rw [norm_unit_mul h (units.ne_zero _), norm_unit_coe_units, mul_inv_eq_one] }
end

theorem normalize_idem (x : α) : normalize (normalize x) = normalize x := by simp

theorem normalize_eq_normalize {a b : α}
  (hab : a ∣ b) (hba : b ∣ a) : normalize a = normalize b :=
begin
  nontriviality α,
  rcases associated_of_dvd_dvd hab hba with ⟨u, rfl⟩,
  refine classical.by_cases (by rintro rfl; simp only [zero_mul]) (assume ha : a ≠ 0, _),
  suffices : a * ↑(norm_unit a) = a * ↑u * ↑(norm_unit a) * ↑u⁻¹,
    by simpa only [normalize_apply, mul_assoc, norm_unit_mul ha u.ne_zero, norm_unit_coe_units],
  calc a * ↑(norm_unit a) = a * ↑(norm_unit a) * ↑u * ↑u⁻¹:
      (units.mul_inv_cancel_right _ _).symm
    ... = a * ↑u * ↑(norm_unit a) * ↑u⁻¹ : by rw mul_right_comm a
end

lemma normalize_eq_normalize_iff {x y : α} : normalize x = normalize y ↔ x ∣ y ∧ y ∣ x :=
⟨λ h, ⟨units.dvd_mul_right.1 ⟨_, h.symm⟩, units.dvd_mul_right.1 ⟨_, h⟩⟩,
λ ⟨hxy, hyx⟩, normalize_eq_normalize hxy hyx⟩

theorem dvd_antisymm_of_normalize_eq {a b : α}
  (ha : normalize a = a) (hb : normalize b = b) (hab : a ∣ b) (hba : b ∣ a) :
  a = b :=
ha ▸ hb ▸ normalize_eq_normalize hab hba

--can be proven by simp
lemma dvd_normalize_iff {a b : α} : a ∣ normalize b ↔ a ∣ b :=
units.dvd_mul_right

--can be proven by simp
lemma normalize_dvd_iff {a b : α} : normalize a ∣ b ↔ a ∣ b :=
units.mul_right_dvd

end normalization_monoid

namespace associates
variables [cancel_comm_monoid_with_zero α] [normalization_monoid α]

local attribute [instance] associated.setoid

/-- Maps an element of `associates` back to the normalized element of its associate class -/
protected def out : associates α → α :=
quotient.lift (normalize : α → α) $ λ a b ⟨u, hu⟩, hu ▸
normalize_eq_normalize ⟨_, rfl⟩ (units.mul_right_dvd.2 $ dvd_refl a)

@[simp] lemma out_mk (a : α) : (associates.mk a).out = normalize a := rfl

@[simp] lemma out_one : (1 : associates α).out = 1 :=
normalize_one

lemma out_mul (a b : associates α) : (a * b).out = a.out * b.out :=
quotient.induction_on₂ a b $ assume a b,
by simp only [associates.quotient_mk_eq_mk, out_mk, mk_mul_mk, normalize.map_mul]

lemma dvd_out_iff (a : α) (b : associates α) : a ∣ b.out ↔ associates.mk a ≤ b :=
quotient.induction_on b $
  by simp [associates.out_mk, associates.quotient_mk_eq_mk, mk_le_mk_iff_dvd_iff]

lemma out_dvd_iff (a : α) (b : associates α) : b.out ∣ a ↔ b ≤ associates.mk a :=
quotient.induction_on b $
  by simp [associates.out_mk, associates.quotient_mk_eq_mk, mk_le_mk_iff_dvd_iff]

@[simp] lemma out_top : (⊤ : associates α).out = 0 :=
normalize_zero

@[simp] lemma normalize_out (a : associates α) : normalize a.out = a.out :=
quotient.induction_on a normalize_idem

@[simp] lemma mk_out (a : associates α) : associates.mk (a.out) = a :=
quotient.induction_on a mk_normalize

lemma out_injective : function.injective (associates.out : _ → α) :=
function.left_inverse.injective mk_out

end associates

/-- GCD monoid: a `cancel_comm_monoid_with_zero` with `gcd` (greatest common divisor) and
`lcm` (least common multiple) operations, determined up to a unit. The type class focuses on `gcd`
and we derive the corresponding `lcm` facts from `gcd`.
-/
@[protect_proj] class gcd_monoid (α : Type*) [cancel_comm_monoid_with_zero α] :=
(gcd : α → α → α)
(lcm : α → α → α)
(gcd_dvd_left   : ∀a b, gcd a b ∣ a)
(gcd_dvd_right  : ∀a b, gcd a b ∣ b)
(dvd_gcd        : ∀{a b c}, a ∣ c → a ∣ b → a ∣ gcd c b)
(gcd_mul_lcm    : ∀a b, associated (gcd a b * lcm a b) (a * b))
(lcm_zero_left  : ∀a, lcm 0 a = 0)
(lcm_zero_right : ∀a, lcm a 0 = 0)

/-- Normalized GCD monoid: a `cancel_comm_monoid_with_zero` with normalization and `gcd`
(greatest common divisor) and `lcm` (least common multiple) operations. In this setting `gcd` and
`lcm` form a bounded lattice on the associated elements where `gcd` is the infimum, `lcm` is the
supremum, `1` is bottom, and `0` is top. The type class focuses on `gcd` and we derive the
corresponding `lcm` facts from `gcd`.
-/
class normalized_gcd_monoid (α : Type*) [cancel_comm_monoid_with_zero α]
  extends normalization_monoid α, gcd_monoid α :=
(normalize_gcd : ∀a b, normalize (gcd a b) = gcd a b)
(normalize_lcm : ∀a b, normalize (lcm a b) = lcm a b)

export gcd_monoid (gcd lcm gcd_dvd_left gcd_dvd_right dvd_gcd  lcm_zero_left lcm_zero_right)

attribute [simp] lcm_zero_left lcm_zero_right

section gcd_monoid
variables [cancel_comm_monoid_with_zero α]

@[simp] theorem normalize_gcd [normalized_gcd_monoid α] : ∀a b:α, normalize (gcd a b) = gcd a b :=
normalized_gcd_monoid.normalize_gcd

theorem gcd_mul_lcm [gcd_monoid α] : ∀a b:α, associated (gcd a b * lcm a b) (a * b) :=
gcd_monoid.gcd_mul_lcm

section gcd

theorem dvd_gcd_iff [gcd_monoid α] (a b c : α) : a ∣ gcd b c ↔ (a ∣ b ∧ a ∣ c) :=
iff.intro
  (assume h, ⟨h.trans (gcd_dvd_left _ _), h.trans (gcd_dvd_right _ _)⟩)
  (assume ⟨hab, hac⟩, dvd_gcd hab hac)

theorem gcd_comm [normalized_gcd_monoid α] (a b : α) : gcd a b = gcd b a :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))

theorem gcd_comm' [gcd_monoid α] (a b : α) : associated (gcd a b) (gcd b a) :=
associated_of_dvd_dvd
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))

theorem gcd_assoc [normalized_gcd_monoid α] (m n k : α) : gcd (gcd m n) k = gcd m (gcd n k) :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (dvd_gcd
    ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_left m n))
    (dvd_gcd ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_right m n))
      (gcd_dvd_right (gcd m n) k)))
  (dvd_gcd
    (dvd_gcd (gcd_dvd_left m (gcd n k)) ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_left n k)))
    ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_right n k)))

theorem gcd_assoc' [gcd_monoid α] (m n k : α) : associated (gcd (gcd m n) k) (gcd m (gcd n k)) :=
associated_of_dvd_dvd
  (dvd_gcd
    ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_left m n))
    (dvd_gcd ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_right m n))
      (gcd_dvd_right (gcd m n) k)))
  (dvd_gcd
    (dvd_gcd (gcd_dvd_left m (gcd n k)) ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_left n k)))
    ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_right n k)))

instance [normalized_gcd_monoid α] : is_commutative α gcd := ⟨gcd_comm⟩
instance [normalized_gcd_monoid α] : is_associative α gcd := ⟨gcd_assoc⟩

theorem gcd_eq_normalize [normalized_gcd_monoid α] {a b c : α}
  (habc : gcd a b ∣ c) (hcab : c ∣ gcd a b) :
  gcd a b = normalize c :=
normalize_gcd a b ▸ normalize_eq_normalize habc hcab

@[simp] theorem gcd_zero_left [normalized_gcd_monoid α] (a : α) : gcd 0 a = normalize a :=
gcd_eq_normalize (gcd_dvd_right 0 a) (dvd_gcd (dvd_zero _) (dvd_refl a))

theorem gcd_zero_left' [gcd_monoid α] (a : α) : associated (gcd 0 a) a :=
associated_of_dvd_dvd (gcd_dvd_right 0 a) (dvd_gcd (dvd_zero _) (dvd_refl a))

@[simp] theorem gcd_zero_right [normalized_gcd_monoid α] (a : α) : gcd a 0 = normalize a :=
gcd_eq_normalize (gcd_dvd_left a 0) (dvd_gcd (dvd_refl a) (dvd_zero _))

theorem gcd_zero_right' [gcd_monoid α] (a : α) : associated (gcd a 0) a :=
associated_of_dvd_dvd (gcd_dvd_left a 0) (dvd_gcd (dvd_refl a) (dvd_zero _))

@[simp] theorem gcd_eq_zero_iff [gcd_monoid α] (a b : α) : gcd a b = 0 ↔ a = 0 ∧ b = 0 :=
iff.intro
  (assume h, let ⟨ca, ha⟩ := gcd_dvd_left a b, ⟨cb, hb⟩ := gcd_dvd_right a b in
    by rw [h, zero_mul] at ha hb; exact ⟨ha, hb⟩)
  (assume ⟨ha, hb⟩, by
    { rw [ha, hb, ←zero_dvd_iff],
      apply dvd_gcd; refl })

@[simp] theorem gcd_one_left [normalized_gcd_monoid α] (a : α) : gcd 1 a = 1 :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) normalize_one (gcd_dvd_left _ _) (one_dvd _)

@[simp] theorem gcd_one_left' [gcd_monoid α] (a : α) : associated (gcd 1 a) 1 :=
associated_of_dvd_dvd (gcd_dvd_left _ _) (one_dvd _)

@[simp] theorem gcd_one_right [normalized_gcd_monoid α] (a : α) : gcd a 1 = 1 :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) normalize_one (gcd_dvd_right _ _) (one_dvd _)

@[simp] theorem gcd_one_right' [gcd_monoid α] (a : α) : associated (gcd a 1) 1 :=
associated_of_dvd_dvd (gcd_dvd_right _ _) (one_dvd _)

theorem gcd_dvd_gcd [gcd_monoid α] {a b c d: α} (hab : a ∣ b) (hcd : c ∣ d) : gcd a c ∣ gcd b d :=
dvd_gcd ((gcd_dvd_left _ _).trans hab) ((gcd_dvd_right _ _).trans hcd)

@[simp] theorem gcd_same [normalized_gcd_monoid α] (a : α) : gcd a a = normalize a :=
gcd_eq_normalize (gcd_dvd_left _ _) (dvd_gcd (dvd_refl a) (dvd_refl a))

@[simp] theorem gcd_mul_left [normalized_gcd_monoid α] (a b c : α) :
  gcd (a * b) (a * c) = normalize a * gcd b c :=
classical.by_cases (by rintro rfl; simp only [zero_mul, gcd_zero_left, normalize_zero]) $
assume ha : a ≠ 0,
suffices gcd (a * b) (a * c) = normalize (a * gcd b c),
  by simpa only [normalize.map_mul, normalize_gcd],
let ⟨d, eq⟩ := dvd_gcd (dvd_mul_right a b) (dvd_mul_right a c) in
gcd_eq_normalize
  (eq.symm ▸ mul_dvd_mul_left a $ show d ∣ gcd b c, from
    dvd_gcd
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_left _ _)
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_right _ _))
  (dvd_gcd
    (mul_dvd_mul_left a $ gcd_dvd_left _ _)
    (mul_dvd_mul_left a $ gcd_dvd_right _ _))

theorem gcd_mul_left' [gcd_monoid α] (a b c : α) : associated (gcd (a * b) (a * c)) (a * gcd b c) :=
begin
  obtain rfl|ha := eq_or_ne a 0,
  { simp only [zero_mul, gcd_zero_left'] },
  obtain ⟨d, eq⟩ := dvd_gcd (dvd_mul_right a b) (dvd_mul_right a c),
  apply associated_of_dvd_dvd,
  { rw eq,
    apply mul_dvd_mul_left,
    exact dvd_gcd
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_left _ _)
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_right _ _) },
  { exact (dvd_gcd
      (mul_dvd_mul_left a $ gcd_dvd_left _ _)
      (mul_dvd_mul_left a $ gcd_dvd_right _ _)) },
end

@[simp] theorem gcd_mul_right [normalized_gcd_monoid α] (a b c : α) :
  gcd (b * a) (c * a) = gcd b c * normalize a :=
by simp only [mul_comm, gcd_mul_left]

@[simp] theorem gcd_mul_right' [gcd_monoid α] (a b c : α) :
  associated (gcd (b * a) (c * a)) (gcd b c * a) :=
by simp only [mul_comm, gcd_mul_left']

theorem gcd_eq_left_iff [normalized_gcd_monoid α] (a b : α) (h : normalize a = a) :
  gcd a b = a ↔ a ∣ b :=
iff.intro (assume eq, eq ▸ gcd_dvd_right _ _) $
  assume hab, dvd_antisymm_of_normalize_eq (normalize_gcd _ _) h (gcd_dvd_left _ _)
    (dvd_gcd (dvd_refl a) hab)

theorem gcd_eq_right_iff [normalized_gcd_monoid α] (a b : α) (h : normalize b = b) :
  gcd a b = b ↔ b ∣ a :=
by simpa only [gcd_comm a b] using gcd_eq_left_iff b a h

theorem gcd_dvd_gcd_mul_left [gcd_monoid α] (m n k : α) : gcd m n ∣ gcd (k * m) n :=
gcd_dvd_gcd (dvd_mul_left _ _) dvd_rfl

theorem gcd_dvd_gcd_mul_right [gcd_monoid α] (m n k : α) : gcd m n ∣ gcd (m * k) n :=
gcd_dvd_gcd (dvd_mul_right _ _) dvd_rfl

theorem gcd_dvd_gcd_mul_left_right [gcd_monoid α] (m n k : α) : gcd m n ∣ gcd m (k * n) :=
gcd_dvd_gcd dvd_rfl (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right_right [gcd_monoid α] (m n k : α) : gcd m n ∣ gcd m (n * k) :=
gcd_dvd_gcd dvd_rfl (dvd_mul_right _ _)

theorem associated.gcd_eq_left [normalized_gcd_monoid α] {m n : α} (h : associated m n) (k : α) :
  gcd m k = gcd n k :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (gcd_dvd_gcd h.dvd dvd_rfl)
  (gcd_dvd_gcd h.symm.dvd dvd_rfl)

theorem associated.gcd_eq_right [normalized_gcd_monoid α] {m n : α} (h : associated m n) (k : α) :
  gcd k m = gcd k n :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (gcd_dvd_gcd dvd_rfl h.dvd)
  (gcd_dvd_gcd dvd_rfl h.symm.dvd)

lemma dvd_gcd_mul_of_dvd_mul [gcd_monoid α] {m n k : α} (H : k ∣ m * n) : k ∣ (gcd k m) * n :=
(dvd_gcd (dvd_mul_right _ n) H).trans (gcd_mul_right' n k m).dvd

lemma dvd_mul_gcd_of_dvd_mul [gcd_monoid α] {m n k : α} (H : k ∣ m * n) : k ∣ m * gcd k n :=
by { rw mul_comm at H ⊢, exact dvd_gcd_mul_of_dvd_mul H }

/-- Represent a divisor of `m * n` as a product of a divisor of `m` and a divisor of `n`.

In other words, the nonzero elements of a `gcd_monoid` form a decomposition monoid
(more widely known as a pre-Schreier domain in the context of rings).

Note: In general, this representation is highly non-unique.

See `nat.prod_dvd_and_dvd_of_dvd_prod` for a constructive version on `ℕ`.  -/
lemma exists_dvd_and_dvd_of_dvd_mul [gcd_monoid α] {m n k : α} (H : k ∣ m * n) :
  ∃ d₁ d₂, d₁ ∣ m ∧ d₂ ∣ n ∧ k = d₁ * d₂ :=
begin
  by_cases h0 : gcd k m = 0,
  { rw gcd_eq_zero_iff at h0,
    rcases h0 with ⟨rfl, rfl⟩,
    refine ⟨0, n, dvd_refl 0, dvd_refl n, _⟩,
    simp },
  { obtain ⟨a, ha⟩ := gcd_dvd_left k m,
    refine ⟨gcd k m, a, gcd_dvd_right _ _, _, ha⟩,
    suffices h : gcd k m * a ∣ gcd k m * n,
    { cases h with b hb,
      use b,
      rw mul_assoc at hb,
      apply mul_left_cancel₀ h0 hb },
    rw ← ha,
    exact dvd_gcd_mul_of_dvd_mul H }
end

lemma dvd_mul [gcd_monoid α] {k m n : α} :
  k ∣ (m * n) ↔ ∃ d₁ d₂, d₁ ∣ m ∧ d₂ ∣ n ∧ k = d₁ * d₂ :=
begin
  refine ⟨exists_dvd_and_dvd_of_dvd_mul, _⟩,
  rintro ⟨d₁, d₂, hy, hz, rfl⟩,
  exact mul_dvd_mul hy hz,
end

theorem gcd_mul_dvd_mul_gcd [gcd_monoid α] (k m n : α) : gcd k (m * n) ∣ gcd k m * gcd k n :=
begin
  obtain ⟨m', n', hm', hn', h⟩ := exists_dvd_and_dvd_of_dvd_mul (gcd_dvd_right k (m * n)),
  replace h : gcd k (m * n) = m' * n' := h,
  rw h,
  have hm'n' : m' * n' ∣ k := h ▸ gcd_dvd_left _ _,
  apply mul_dvd_mul,
  { have hm'k : m' ∣ k := (dvd_mul_right m' n').trans hm'n',
    exact dvd_gcd hm'k hm' },
  { have hn'k : n' ∣ k := (dvd_mul_left n' m').trans hm'n',
    exact dvd_gcd hn'k hn' }
end

theorem gcd_pow_right_dvd_pow_gcd [gcd_monoid α] {a b : α} {k : ℕ} :
  gcd a (b ^ k) ∣ (gcd a b) ^ k :=
begin
  by_cases hg : gcd a b = 0,
  { rw gcd_eq_zero_iff at hg,
    rcases hg with ⟨rfl, rfl⟩,
    exact (gcd_zero_left' (0 ^ k : α)).dvd.trans
      (pow_dvd_pow_of_dvd (gcd_zero_left' (0 : α)).symm.dvd _) },
  { induction k with k hk,
    { simp only [pow_zero],
      exact (gcd_one_right' a).dvd, },
    rw [pow_succ, pow_succ],
    transitivity gcd a b * gcd a (b ^ k),
    apply gcd_mul_dvd_mul_gcd a b (b ^ k),
    exact (mul_dvd_mul_iff_left hg).mpr hk }
end

theorem gcd_pow_left_dvd_pow_gcd [gcd_monoid α] {a b : α} {k : ℕ} :
  gcd (a ^ k) b ∣ (gcd a b) ^ k :=
calc gcd (a ^ k) b
    ∣ gcd b (a ^ k) : (gcd_comm' _ _).dvd
... ∣ (gcd b a) ^ k : gcd_pow_right_dvd_pow_gcd
... ∣ (gcd a b) ^ k : pow_dvd_pow_of_dvd (gcd_comm' _ _).dvd _

theorem pow_dvd_of_mul_eq_pow [gcd_monoid α] {a b c d₁ d₂ : α} (ha : a ≠ 0)
  (hab : is_unit (gcd a b)) {k : ℕ} (h : a * b = c ^ k) (hc : c = d₁ * d₂)
  (hd₁ : d₁ ∣ a) : d₁ ^ k ≠ 0 ∧ d₁ ^ k ∣ a :=
begin
  have h1 : is_unit (gcd (d₁ ^ k) b),
  { apply is_unit_of_dvd_one,
    transitivity (gcd d₁ b) ^ k,
    { exact gcd_pow_left_dvd_pow_gcd },
    { apply is_unit.dvd, apply is_unit.pow, apply is_unit_of_dvd_one,
      apply dvd_trans _ hab.dvd,
      apply gcd_dvd_gcd hd₁ (dvd_refl b) } },
  have h2 : d₁ ^ k ∣ a * b, { use d₂ ^ k, rw [h, hc], exact mul_pow d₁ d₂ k },
  rw mul_comm at h2,
  have h3 : d₁ ^ k ∣ a,
  { apply (dvd_gcd_mul_of_dvd_mul h2).trans,
    rw is_unit.mul_left_dvd _ _ _ h1 },
  have h4 : d₁ ^ k ≠ 0,
  { intro hdk, rw hdk at h3, apply absurd (zero_dvd_iff.mp h3) ha },
  exact ⟨h4, h3⟩,
end

theorem exists_associated_pow_of_mul_eq_pow [gcd_monoid α] {a b c : α}
  (hab : is_unit (gcd a b)) {k : ℕ}
  (h : a * b = c ^ k) : ∃ (d : α), associated (d ^ k) a :=
begin
  casesI subsingleton_or_nontrivial α,
  { use 0, rw [subsingleton.elim a (0 ^ k)] },
  by_cases ha : a = 0,
  { use 0, rw ha,
    obtain (rfl | hk) := k.eq_zero_or_pos,
    { exfalso, revert h, rw [ha, zero_mul, pow_zero], apply zero_ne_one },
    { rw zero_pow hk } },
  by_cases hb : b = 0,
  { use 1, rw [one_pow],
    apply (associated_one_iff_is_unit.mpr hab).symm.trans,
    rw hb,
    exact gcd_zero_right' a },
  obtain (rfl | hk) := k.eq_zero_or_pos,
  { use 1, rw pow_zero at h ⊢, use units.mk_of_mul_eq_one _ _ h,
    rw [units.coe_mk_of_mul_eq_one, one_mul] },
  have hc : c ∣ a * b, { rw h, exact dvd_pow_self _ hk.ne' },
  obtain ⟨d₁, d₂, hd₁, hd₂, hc⟩ := exists_dvd_and_dvd_of_dvd_mul hc,
  use d₁,
  obtain ⟨h0₁, ⟨a', ha'⟩⟩ := pow_dvd_of_mul_eq_pow ha hab h hc hd₁,
  rw [mul_comm] at h hc,
  rw (gcd_comm' a b).is_unit_iff at hab,
  obtain ⟨h0₂, ⟨b', hb'⟩⟩ := pow_dvd_of_mul_eq_pow hb hab h hc hd₂,
  rw [ha', hb', hc, mul_pow] at h,
  have h' : a' * b' = 1,
  { apply (mul_right_inj' h0₁).mp, rw mul_one,
    apply (mul_right_inj' h0₂).mp, rw ← h,
    rw [mul_assoc, mul_comm a', ← mul_assoc _ b', ← mul_assoc b', mul_comm b'] },
  use units.mk_of_mul_eq_one _ _ h',
  rw [units.coe_mk_of_mul_eq_one, ha']
end

theorem exists_eq_pow_of_mul_eq_pow [gcd_monoid α] [unique αˣ] {a b c : α}
  (hab : is_unit (gcd a b)) {k : ℕ}
  (h : a * b = c ^ k) : ∃ (d : α), a = d ^ k :=
let ⟨d, hd⟩ := exists_associated_pow_of_mul_eq_pow hab h in ⟨d, (associated_iff_eq.mp hd).symm⟩

lemma gcd_greatest {α : Type*} [cancel_comm_monoid_with_zero α] [normalized_gcd_monoid α]
  {a b d : α} (hda : d ∣ a) (hdb : d ∣ b)
  (hd : ∀ e : α, e ∣ a → e ∣ b → e ∣ d) : gcd_monoid.gcd a b = normalize d :=
begin
  have h := hd _ (gcd_monoid.gcd_dvd_left a b) (gcd_monoid.gcd_dvd_right a b),
  exact gcd_eq_normalize h (gcd_monoid.dvd_gcd hda hdb),
end

lemma gcd_greatest_associated {α : Type*} [cancel_comm_monoid_with_zero α] [gcd_monoid α]
  {a b d : α} (hda : d ∣ a) (hdb : d ∣ b)
  (hd : ∀ e : α, e ∣ a → e ∣ b → e ∣ d) : associated d (gcd_monoid.gcd a b) :=
begin
  have h := hd _ (gcd_monoid.gcd_dvd_left a b) (gcd_monoid.gcd_dvd_right a b),
  exact associated_of_dvd_dvd (gcd_monoid.dvd_gcd hda hdb) h,
end

lemma is_unit_gcd_of_eq_mul_gcd {α : Type*} [cancel_comm_monoid_with_zero α] [gcd_monoid α]
  {x y x' y' : α} (ex : x = gcd x y * x') (ey : y = gcd x y * y') (h : gcd x y ≠ 0) :
  is_unit (gcd x' y') :=
begin
  rw ← associated_one_iff_is_unit,
  refine associated.of_mul_left _ (associated.refl $ gcd x y) h,
  convert (gcd_mul_left' _ _ _).symm using 1,
  rw [← ex, ← ey, mul_one],
end

lemma extract_gcd {α : Type*} [cancel_comm_monoid_with_zero α] [gcd_monoid α] (x y : α) :
  ∃ x' y', x = gcd x y * x' ∧ y = gcd x y * y' ∧ is_unit (gcd x' y') :=
begin
  by_cases h : gcd x y = 0,
  { obtain ⟨rfl, rfl⟩ := (gcd_eq_zero_iff x y).1 h,
    simp_rw ← associated_one_iff_is_unit,
    exact ⟨1, 1, by rw [h, zero_mul], by rw [h, zero_mul], gcd_one_left' 1⟩ },
  obtain ⟨x', ex⟩ := gcd_dvd_left x y,
  obtain ⟨y', ey⟩ := gcd_dvd_right x y,
  exact ⟨x', y', ex, ey, is_unit_gcd_of_eq_mul_gcd ex ey h⟩,
end

end gcd

section lcm

lemma lcm_dvd_iff [gcd_monoid α] {a b c : α} : lcm a b ∣ c ↔ a ∣ c ∧ b ∣ c :=
begin
  by_cases this : a = 0 ∨ b = 0,
  { rcases this with rfl | rfl;
    simp only [iff_def, lcm_zero_left, lcm_zero_right, zero_dvd_iff, dvd_zero,
      eq_self_iff_true, and_true, imp_true_iff] {contextual:=tt} },
  { obtain ⟨h1, h2⟩ := not_or_distrib.1 this,
    have h : gcd a b ≠ 0, from λ H, h1 ((gcd_eq_zero_iff _ _).1 H).1,
    rw [← mul_dvd_mul_iff_left h, (gcd_mul_lcm a b).dvd_iff_dvd_left,
      ←(gcd_mul_right' c a b).dvd_iff_dvd_right, dvd_gcd_iff, mul_comm b c,
      mul_dvd_mul_iff_left h1, mul_dvd_mul_iff_right h2, and_comm] }
end

lemma dvd_lcm_left [gcd_monoid α] (a b : α) : a ∣ lcm a b :=
(lcm_dvd_iff.1 (dvd_refl (lcm a b))).1

lemma dvd_lcm_right [gcd_monoid α] (a b : α) : b ∣ lcm a b :=
(lcm_dvd_iff.1 (dvd_refl (lcm a b))).2

lemma lcm_dvd [gcd_monoid α] {a b c : α} (hab : a ∣ b) (hcb : c ∣ b) : lcm a c ∣ b :=
lcm_dvd_iff.2 ⟨hab, hcb⟩

@[simp] theorem lcm_eq_zero_iff [gcd_monoid α] (a b : α) : lcm a b = 0 ↔ a = 0 ∨ b = 0 :=
iff.intro
  (assume h : lcm a b = 0,
    have associated (a * b) 0 := (gcd_mul_lcm a b).symm.trans $
      by rw [h, mul_zero],
    by simpa only [associated_zero_iff_eq_zero, mul_eq_zero])
  (by rintro (rfl | rfl); [apply lcm_zero_left, apply lcm_zero_right])

@[simp] lemma normalize_lcm [normalized_gcd_monoid α] (a b : α) : normalize (lcm a b) = lcm a b :=
normalized_gcd_monoid.normalize_lcm a b

theorem lcm_comm [normalized_gcd_monoid α] (a b : α) : lcm a b = lcm b a :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))

theorem lcm_comm' [gcd_monoid α] (a b : α) : associated (lcm a b) (lcm b a) :=
associated_of_dvd_dvd
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))

theorem lcm_assoc [normalized_gcd_monoid α] (m n k : α) : lcm (lcm m n) k = lcm m (lcm n k) :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd
    (lcm_dvd (dvd_lcm_left _ _) ((dvd_lcm_left _ _).trans (dvd_lcm_right _ _)))
    ((dvd_lcm_right _ _).trans (dvd_lcm_right _ _)))
  (lcm_dvd
    ((dvd_lcm_left _ _).trans (dvd_lcm_left _ _))
    (lcm_dvd ((dvd_lcm_right _ _).trans (dvd_lcm_left _ _)) (dvd_lcm_right _ _)))

theorem lcm_assoc' [gcd_monoid α] (m n k : α) : associated (lcm (lcm m n) k) (lcm m (lcm n k)) :=
associated_of_dvd_dvd
  (lcm_dvd
    (lcm_dvd (dvd_lcm_left _ _) ((dvd_lcm_left _ _).trans (dvd_lcm_right _ _)))
    ((dvd_lcm_right _ _).trans (dvd_lcm_right _ _)))
  (lcm_dvd
    ((dvd_lcm_left _ _).trans (dvd_lcm_left _ _))
    (lcm_dvd ((dvd_lcm_right _ _).trans (dvd_lcm_left _ _)) (dvd_lcm_right _ _)))

instance [normalized_gcd_monoid α] : is_commutative α lcm := ⟨lcm_comm⟩
instance [normalized_gcd_monoid α] : is_associative α lcm := ⟨lcm_assoc⟩

lemma lcm_eq_normalize [normalized_gcd_monoid α] {a b c : α}
  (habc : lcm a b ∣ c) (hcab : c ∣ lcm a b) :
  lcm a b = normalize c :=
normalize_lcm a b ▸ normalize_eq_normalize habc hcab

theorem lcm_dvd_lcm [gcd_monoid α] {a b c d : α} (hab : a ∣ b) (hcd : c ∣ d) :
  lcm a c ∣ lcm b d :=
lcm_dvd (hab.trans (dvd_lcm_left _ _)) (hcd.trans (dvd_lcm_right _ _))

@[simp] theorem lcm_units_coe_left [normalized_gcd_monoid α] (u : αˣ) (a : α) :
  lcm ↑u a = normalize a :=
lcm_eq_normalize (lcm_dvd units.coe_dvd dvd_rfl) (dvd_lcm_right _ _)

@[simp] theorem lcm_units_coe_right [normalized_gcd_monoid α] (a : α) (u : αˣ) :
  lcm a ↑u = normalize a :=
(lcm_comm a u).trans $ lcm_units_coe_left _ _

@[simp] theorem lcm_one_left [normalized_gcd_monoid α] (a : α) : lcm 1 a = normalize a :=
lcm_units_coe_left 1 a

@[simp] theorem lcm_one_right [normalized_gcd_monoid α] (a : α) : lcm a 1 = normalize a :=
lcm_units_coe_right a 1

@[simp] theorem lcm_same [normalized_gcd_monoid α] (a : α) : lcm a a = normalize a :=
lcm_eq_normalize (lcm_dvd dvd_rfl dvd_rfl) (dvd_lcm_left _ _)

@[simp] theorem lcm_eq_one_iff [normalized_gcd_monoid α] (a b : α) : lcm a b = 1 ↔ a ∣ 1 ∧ b ∣ 1 :=
iff.intro
  (assume eq, eq ▸ ⟨dvd_lcm_left _ _, dvd_lcm_right _ _⟩)
  (assume ⟨⟨c, hc⟩, ⟨d, hd⟩⟩,
    show lcm (units.mk_of_mul_eq_one a c hc.symm : α) (units.mk_of_mul_eq_one b d hd.symm) = 1,
      by rw [lcm_units_coe_left, normalize_coe_units])

@[simp] theorem lcm_mul_left [normalized_gcd_monoid α] (a b c : α) :
  lcm (a * b) (a * c) = normalize a * lcm b c :=
classical.by_cases (by rintro rfl; simp only [zero_mul, lcm_zero_left, normalize_zero]) $
assume ha : a ≠ 0,
suffices lcm (a * b) (a * c) = normalize (a * lcm b c),
  by simpa only [normalize.map_mul, normalize_lcm],
have a ∣ lcm (a * b) (a * c), from (dvd_mul_right _ _).trans (dvd_lcm_left _ _),
let ⟨d, eq⟩ := this in
lcm_eq_normalize
  (lcm_dvd (mul_dvd_mul_left a (dvd_lcm_left _ _)) (mul_dvd_mul_left a (dvd_lcm_right _ _)))
  (eq.symm ▸ (mul_dvd_mul_left a $ lcm_dvd
    ((mul_dvd_mul_iff_left ha).1 $ eq ▸ dvd_lcm_left _ _)
    ((mul_dvd_mul_iff_left ha).1 $ eq ▸ dvd_lcm_right _ _)))

@[simp] theorem lcm_mul_right [normalized_gcd_monoid α] (a b c : α) :
  lcm (b * a) (c * a) = lcm b c * normalize a :=
by simp only [mul_comm, lcm_mul_left]

theorem lcm_eq_left_iff [normalized_gcd_monoid α] (a b : α) (h : normalize a = a) :
  lcm a b = a ↔ b ∣ a :=
iff.intro (assume eq, eq ▸ dvd_lcm_right _ _) $
  assume hab, dvd_antisymm_of_normalize_eq (normalize_lcm _ _) h (lcm_dvd (dvd_refl a) hab)
    (dvd_lcm_left _ _)

theorem lcm_eq_right_iff [normalized_gcd_monoid α] (a b : α) (h : normalize b = b) :
  lcm a b = b ↔ a ∣ b :=
by simpa only [lcm_comm b a] using lcm_eq_left_iff b a h

theorem lcm_dvd_lcm_mul_left [gcd_monoid α] (m n k : α) : lcm m n ∣ lcm (k * m) n :=
lcm_dvd_lcm (dvd_mul_left _ _) dvd_rfl

theorem lcm_dvd_lcm_mul_right [gcd_monoid α] (m n k : α) : lcm m n ∣ lcm (m * k) n :=
lcm_dvd_lcm (dvd_mul_right _ _) dvd_rfl

theorem lcm_dvd_lcm_mul_left_right [gcd_monoid α] (m n k : α) : lcm m n ∣ lcm m (k * n) :=
lcm_dvd_lcm dvd_rfl (dvd_mul_left _ _)

theorem lcm_dvd_lcm_mul_right_right [gcd_monoid α] (m n k : α) : lcm m n ∣ lcm m (n * k) :=
lcm_dvd_lcm dvd_rfl (dvd_mul_right _ _)

theorem lcm_eq_of_associated_left [normalized_gcd_monoid α] {m n : α}
  (h : associated m n) (k : α) : lcm m k = lcm n k :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd_lcm h.dvd dvd_rfl)
  (lcm_dvd_lcm h.symm.dvd dvd_rfl)

theorem lcm_eq_of_associated_right [normalized_gcd_monoid α] {m n : α}
  (h : associated m n) (k : α) : lcm k m = lcm k n :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd_lcm dvd_rfl h.dvd)
  (lcm_dvd_lcm dvd_rfl h.symm.dvd)

end lcm

namespace gcd_monoid

theorem prime_of_irreducible [gcd_monoid α] {x : α} (hi: irreducible x) : prime x :=
⟨hi.ne_zero, ⟨hi.1, λ a b h,
begin
  cases gcd_dvd_left x a with y hy,
  cases hi.is_unit_or_is_unit hy with hu hu,
  { right, transitivity (gcd (x * b) (a * b)), apply dvd_gcd (dvd_mul_right x b) h,
    rw (gcd_mul_right' b x a).dvd_iff_dvd_left,
    exact (associated_unit_mul_left _ _ hu).dvd },
  { left,
    rw hy,
    exact dvd_trans (associated_mul_unit_left _ _ hu).dvd (gcd_dvd_right x a) }
end ⟩⟩

theorem irreducible_iff_prime [gcd_monoid α] {p : α} : irreducible p ↔ prime p :=
⟨prime_of_irreducible, prime.irreducible⟩

end gcd_monoid
end gcd_monoid

section unique_unit

variables [cancel_comm_monoid_with_zero α] [unique αˣ]

@[priority 100] -- see Note [lower instance priority]
instance normalization_monoid_of_unique_units : normalization_monoid α :=
{ norm_unit := λ x, 1,
  norm_unit_zero := rfl,
  norm_unit_mul := λ x y hx hy, (mul_one 1).symm,
  norm_unit_coe_units := λ u, subsingleton.elim _ _ }

instance unique_normalization_monoid_of_unique_units : unique (normalization_monoid α) :=
{ default := normalization_monoid_of_unique_units,
  uniq := λ ⟨u, _, _, _⟩, by simpa only [(subsingleton.elim _ _ : u = λ _, 1)] }

instance subsingleton_gcd_monoid_of_unique_units : subsingleton (gcd_monoid α) :=
⟨λ g₁ g₂, begin
  have hgcd : g₁.gcd = g₂.gcd,
  { ext a b,
    refine associated_iff_eq.mp (associated_of_dvd_dvd _ _);
    apply dvd_gcd (gcd_dvd_left _ _) (gcd_dvd_right _ _) },
  have hlcm : g₁.lcm = g₂.lcm,
  { ext a b,
    refine associated_iff_eq.mp (associated_of_dvd_dvd _ _);
    apply lcm_dvd_iff.2 ⟨dvd_lcm_left _ _, dvd_lcm_right _ _⟩ },
  cases g₁, cases g₂,
  dsimp only at hgcd hlcm,
  simp only [hgcd, hlcm],
end⟩

instance subsingleton_normalized_gcd_monoid_of_unique_units :
  subsingleton (normalized_gcd_monoid α) :=
⟨begin
  intros a b,
  cases a with a_norm a_gcd,
  cases b with b_norm b_gcd,
  have := subsingleton.elim a_gcd b_gcd,
  subst this,
  have := subsingleton.elim a_norm b_norm,
  subst this
end⟩

@[simp] lemma norm_unit_eq_one (x : α) : norm_unit x = 1 := rfl

@[simp] lemma normalize_eq (x : α) : normalize x = x := mul_one x

/-- If a monoid's only unit is `1`, then it is isomorphic to its associates. -/
@[simps]
def associates_equiv_of_unique_units : associates α ≃* α :=
{ to_fun := associates.out,
  inv_fun := associates.mk,
  left_inv := associates.mk_out,
  right_inv := λ t, (associates.out_mk _).trans $ normalize_eq _,
  map_mul' := associates.out_mul }

end unique_unit

section is_domain

variables [comm_ring α] [is_domain α] [normalized_gcd_monoid α]

lemma gcd_eq_of_dvd_sub_right {a b c : α} (h : a ∣ b - c) : gcd a b = gcd a c :=
begin
  apply dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _);
  rw dvd_gcd_iff; refine ⟨gcd_dvd_left _ _, _⟩,
  { rcases h with ⟨d, hd⟩,
    rcases gcd_dvd_right a b with ⟨e, he⟩,
    rcases gcd_dvd_left a b with ⟨f, hf⟩,
    use e - f * d,
    rw [mul_sub, ← he, ← mul_assoc, ← hf, ← hd, sub_sub_cancel] },
  { rcases h with ⟨d, hd⟩,
    rcases gcd_dvd_right a c with ⟨e, he⟩,
    rcases gcd_dvd_left a c with ⟨f, hf⟩,
    use e + f * d,
    rw [mul_add, ← he, ← mul_assoc, ← hf, ← hd, ← add_sub_assoc, add_comm c b, add_sub_cancel] }
end

lemma gcd_eq_of_dvd_sub_left {a b c : α} (h : a ∣ b - c) : gcd b a = gcd c a :=
by rw [gcd_comm _ a, gcd_comm _ a, gcd_eq_of_dvd_sub_right h]

end is_domain

section constructors
noncomputable theory

open associates

variables [cancel_comm_monoid_with_zero α]

private lemma map_mk_unit_aux [decidable_eq α] {f : associates α →* α}
  (hinv : function.right_inverse f associates.mk) (a : α) :
    a * ↑(classical.some (associated_map_mk hinv a)) = f (associates.mk a) :=
classical.some_spec (associated_map_mk hinv a)

/-- Define `normalization_monoid` on a structure from a `monoid_hom` inverse to `associates.mk`. -/
def normalization_monoid_of_monoid_hom_right_inverse [decidable_eq α] (f : associates α →* α)
  (hinv : function.right_inverse f associates.mk) :
  normalization_monoid α :=
{ norm_unit := λ a, if a = 0 then 1 else
    classical.some (associates.mk_eq_mk_iff_associated.1 (hinv (associates.mk a)).symm),
  norm_unit_zero := if_pos rfl,
  norm_unit_mul := λ a b ha hb, by
  { rw [if_neg (mul_ne_zero ha hb), if_neg ha, if_neg hb, units.ext_iff, units.coe_mul],
    suffices : (a * b) * ↑(classical.some (associated_map_mk hinv (a * b))) =
      (a * ↑(classical.some (associated_map_mk hinv a))) *
      (b * ↑(classical.some (associated_map_mk hinv b))),
    { apply mul_left_cancel₀ (mul_ne_zero ha hb) _,
      simpa only [mul_assoc, mul_comm, mul_left_comm] using this },
    rw [map_mk_unit_aux hinv a, map_mk_unit_aux hinv (a * b), map_mk_unit_aux hinv b,
        ← monoid_hom.map_mul, associates.mk_mul_mk] },
  norm_unit_coe_units := λ u, by
  { nontriviality α,
    rw [if_neg (units.ne_zero u), units.ext_iff],
    apply mul_left_cancel₀ (units.ne_zero u),
    rw [units.mul_inv, map_mk_unit_aux hinv u,
      associates.mk_eq_mk_iff_associated.2 (associated_one_iff_is_unit.2 ⟨u, rfl⟩),
      associates.mk_one, monoid_hom.map_one] } }

/-- Define `gcd_monoid` on a structure just from the `gcd` and its properties. -/
noncomputable def gcd_monoid_of_gcd [decidable_eq α] (gcd : α → α → α)
  (gcd_dvd_left   : ∀a b, gcd a b ∣ a)
  (gcd_dvd_right  : ∀a b, gcd a b ∣ b)
  (dvd_gcd        : ∀{a b c}, a ∣ c → a ∣ b → a ∣ gcd c b) :
  gcd_monoid α :=
{ gcd := gcd,
  gcd_dvd_left := gcd_dvd_left,
  gcd_dvd_right := gcd_dvd_right,
  dvd_gcd := λ a b c, dvd_gcd,
  lcm := λ a b, if a = 0 then 0 else classical.some ((gcd_dvd_left a b).trans (dvd.intro b rfl)),
  gcd_mul_lcm := λ a b, by
  { split_ifs with a0,
    { rw [mul_zero, a0, zero_mul] },
    { rw ←classical.some_spec ((gcd_dvd_left a b).trans (dvd.intro b rfl)) } },
  lcm_zero_left := λ a, if_pos rfl,
  lcm_zero_right := λ a, by
  { split_ifs with a0, { refl },
    have h := (classical.some_spec ((gcd_dvd_left a 0).trans (dvd.intro 0 rfl))).symm,
    have a0' : gcd a 0 ≠ 0,
    { contrapose! a0,
      rw [←associated_zero_iff_eq_zero, ←a0],
      exact associated_of_dvd_dvd (dvd_gcd (dvd_refl a) (dvd_zero a)) (gcd_dvd_left _ _) },
    apply or.resolve_left (mul_eq_zero.1 _) a0',
    rw [h, mul_zero] } }

/-- Define `normalized_gcd_monoid` on a structure just from the `gcd` and its properties. -/
noncomputable def normalized_gcd_monoid_of_gcd [normalization_monoid α] [decidable_eq α]
  (gcd : α → α → α)
  (gcd_dvd_left   : ∀a b, gcd a b ∣ a)
  (gcd_dvd_right  : ∀a b, gcd a b ∣ b)
  (dvd_gcd        : ∀{a b c}, a ∣ c → a ∣ b → a ∣ gcd c b)
  (normalize_gcd  : ∀a b, normalize (gcd a b) = gcd a b) :
  normalized_gcd_monoid α :=
{ gcd := gcd,
  gcd_dvd_left := gcd_dvd_left,
  gcd_dvd_right := gcd_dvd_right,
  dvd_gcd := λ a b c, dvd_gcd,
  normalize_gcd := normalize_gcd,
  lcm := λ a b, if a = 0 then 0 else classical.some (dvd_normalize_iff.2
          ((gcd_dvd_left a b).trans (dvd.intro b rfl))),
  normalize_lcm := λ a b, by
  { dsimp [normalize],
    split_ifs with a0,
    { exact @normalize_zero α _ _ },
    { have := (classical.some_spec (dvd_normalize_iff.2
                  ((gcd_dvd_left a b).trans (dvd.intro b rfl)))).symm,
      set l := classical.some (dvd_normalize_iff.2
          ((gcd_dvd_left a b).trans (dvd.intro b rfl))),
      obtain rfl|hb := eq_or_ne b 0,
      { simp only [normalize_zero, mul_zero, mul_eq_zero] at this,
        obtain ha|hl := this,
        { apply (a0 _).elim,
          rw [←zero_dvd_iff, ←ha],
          exact gcd_dvd_left _ _ },
        { convert @normalize_zero α _ _ } },
      have h1 : gcd a b ≠ 0,
      { have hab : a * b ≠ 0 := mul_ne_zero a0 hb,
        contrapose! hab,
        rw [←normalize_eq_zero, ←this, hab, zero_mul] },
      have h2 : normalize (gcd a b * l) = gcd a b * l,
      { rw [this, normalize_idem] },
      rw ←normalize_gcd at this,
      rwa [normalize.map_mul, normalize_gcd, mul_right_inj' h1] at h2 } },
  gcd_mul_lcm := λ a b, by
  { split_ifs with a0,
    { rw [mul_zero, a0, zero_mul] },
    { rw ←classical.some_spec (dvd_normalize_iff.2 ((gcd_dvd_left a b).trans (dvd.intro b rfl))),
      exact normalize_associated (a * b) } },
  lcm_zero_left := λ a, if_pos rfl,
  lcm_zero_right := λ a, by
  { split_ifs with a0, { refl },
    rw ← normalize_eq_zero at a0,
    have h := (classical.some_spec (dvd_normalize_iff.2
                  ((gcd_dvd_left a 0).trans (dvd.intro 0 rfl)))).symm,
    have gcd0 : gcd a 0 = normalize a,
    { rw ← normalize_gcd,
      exact normalize_eq_normalize (gcd_dvd_left _ _) (dvd_gcd (dvd_refl a) (dvd_zero a)) },
    rw ← gcd0 at a0,
    apply or.resolve_left (mul_eq_zero.1 _) a0,
    rw [h, mul_zero, normalize_zero] },
  .. (infer_instance : normalization_monoid α) }

/-- Define `gcd_monoid` on a structure just from the `lcm` and its properties. -/
noncomputable def gcd_monoid_of_lcm [decidable_eq α] (lcm : α → α → α)
  (dvd_lcm_left   : ∀a b, a ∣ lcm a b)
  (dvd_lcm_right  : ∀a b, b ∣ lcm a b)
  (lcm_dvd        : ∀{a b c}, c ∣ a → b ∣ a → lcm c b ∣ a):
  gcd_monoid α :=
let exists_gcd := λ a b, lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl) in
{ lcm := lcm,
  gcd := λ a b, if a = 0 then b else (if b = 0 then a else
    classical.some (exists_gcd a b)),
  gcd_mul_lcm := λ a b, by
  { split_ifs,
    { rw [h, eq_zero_of_zero_dvd (dvd_lcm_left _ _), mul_zero, zero_mul] },
    { rw [h_1, eq_zero_of_zero_dvd (dvd_lcm_right _ _), mul_zero] },
    rw [mul_comm, ←classical.some_spec (exists_gcd a b)] },
  lcm_zero_left := λ a, eq_zero_of_zero_dvd (dvd_lcm_left _ _),
  lcm_zero_right := λ a, eq_zero_of_zero_dvd (dvd_lcm_right _ _),
  gcd_dvd_left := λ a b, by
  { split_ifs with h h_1,
    { rw h, apply dvd_zero },
    { exact dvd_rfl },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd a b),
        mul_comm, mul_dvd_mul_iff_right h],
    apply dvd_lcm_right },
  gcd_dvd_right := λ a b, by
  { split_ifs with h h_1,
    { exact dvd_rfl },
    { rw h_1, apply dvd_zero },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd a b),
        mul_dvd_mul_iff_right h_1],
    apply dvd_lcm_left },
  dvd_gcd := λ a b c ac ab, by
  { split_ifs,
    { exact ab },
    { exact ac },
    have h0 : lcm c b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left c rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd c b)],
    rcases ab with ⟨d, rfl⟩,
    rw mul_eq_zero at h_1,
    push_neg at h_1,
    rw [mul_comm a, ← mul_assoc, mul_dvd_mul_iff_right h_1.1],
    apply lcm_dvd (dvd.intro d rfl),
    rw [mul_comm, mul_dvd_mul_iff_right h_1.2],
    apply ac } }

/-- Define `normalized_gcd_monoid` on a structure just from the `lcm` and its properties. -/
noncomputable def normalized_gcd_monoid_of_lcm [normalization_monoid α] [decidable_eq α]
  (lcm : α → α → α)
  (dvd_lcm_left   : ∀a b, a ∣ lcm a b)
  (dvd_lcm_right  : ∀a b, b ∣ lcm a b)
  (lcm_dvd        : ∀{a b c}, c ∣ a → b ∣ a → lcm c b ∣ a)
  (normalize_lcm  : ∀a b, normalize (lcm a b) = lcm a b) :
  normalized_gcd_monoid α :=
let exists_gcd := λ a b, dvd_normalize_iff.2 (lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl)) in
{ lcm := lcm,
  gcd := λ a b, if a = 0 then normalize b else (if b = 0 then normalize a else
    classical.some (exists_gcd a b)),
  gcd_mul_lcm := λ a b, by
  { split_ifs with h h_1,
    { rw [h, eq_zero_of_zero_dvd (dvd_lcm_left _ _), mul_zero, zero_mul] },
    { rw [h_1, eq_zero_of_zero_dvd (dvd_lcm_right _ _), mul_zero, mul_zero] },
    rw [mul_comm, ←classical.some_spec (exists_gcd a b)],
    exact normalize_associated (a * b) },
  normalize_lcm := normalize_lcm,
  normalize_gcd := λ a b, by
  { dsimp [normalize],
    split_ifs with h h_1,
    { apply normalize_idem },
    { apply normalize_idem },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    apply mul_left_cancel₀ h0,
    refine trans _ (classical.some_spec (exists_gcd a b)),
    conv_lhs { congr, rw [← normalize_lcm a b] },
    erw [← normalize.map_mul, ← classical.some_spec (exists_gcd a b), normalize_idem] },
  lcm_zero_left := λ a, eq_zero_of_zero_dvd (dvd_lcm_left _ _),
  lcm_zero_right := λ a, eq_zero_of_zero_dvd (dvd_lcm_right _ _),
  gcd_dvd_left := λ a b, by
  { split_ifs,
    { rw h, apply dvd_zero },
    { exact (normalize_associated _).dvd },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd a b),
        normalize_dvd_iff, mul_comm, mul_dvd_mul_iff_right h],
    apply dvd_lcm_right },
  gcd_dvd_right := λ a b, by
  { split_ifs,
    { exact (normalize_associated _).dvd },
    { rw h_1, apply dvd_zero },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd a b),
        normalize_dvd_iff, mul_dvd_mul_iff_right h_1],
    apply dvd_lcm_left },
  dvd_gcd := λ a b c ac ab, by
  { split_ifs,
    { apply dvd_normalize_iff.2 ab },
    { apply dvd_normalize_iff.2 ac },
    have h0 : lcm c b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left c rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (dvd_normalize_iff.2
        (lcm_dvd (dvd.intro b rfl) (dvd.intro_left c rfl))), dvd_normalize_iff],
    rcases ab with ⟨d, rfl⟩,
    rw mul_eq_zero at h_1,
    push_neg at h_1,
    rw [mul_comm a, ← mul_assoc, mul_dvd_mul_iff_right h_1.1],
    apply lcm_dvd (dvd.intro d rfl),
    rw [mul_comm, mul_dvd_mul_iff_right h_1.2],
    apply ac },
  .. (infer_instance : normalization_monoid α) }

/-- Define a `gcd_monoid` structure on a monoid just from the existence of a `gcd`. -/
noncomputable def gcd_monoid_of_exists_gcd [decidable_eq α]
  (h : ∀ a b : α, ∃ c : α, ∀ d : α, d ∣ a ∧ d ∣ b ↔ d ∣ c) :
  gcd_monoid α :=
gcd_monoid_of_gcd
  (λ a b, (classical.some (h a b)))
  (λ a b,
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).1)
  (λ a b,
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).2)
  (λ a b c ac ab, ((classical.some_spec (h c b) a).1 ⟨ac, ab⟩))

/-- Define a `normalized_gcd_monoid` structure on a monoid just from the existence of a `gcd`. -/
noncomputable def normalized_gcd_monoid_of_exists_gcd [normalization_monoid α] [decidable_eq α]
  (h : ∀ a b : α, ∃ c : α, ∀ d : α, d ∣ a ∧ d ∣ b ↔ d ∣ c) :
  normalized_gcd_monoid α :=
normalized_gcd_monoid_of_gcd
  (λ a b, normalize (classical.some (h a b)))
  (λ a b, normalize_dvd_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).1)
  (λ a b, normalize_dvd_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).2)
  (λ a b c ac ab, dvd_normalize_iff.2 ((classical.some_spec (h c b) a).1 ⟨ac, ab⟩))
  (λ a b, normalize_idem _)

/-- Define a `gcd_monoid` structure on a monoid just from the existence of an `lcm`. -/
noncomputable def gcd_monoid_of_exists_lcm [decidable_eq α]
  (h : ∀ a b : α, ∃ c : α, ∀ d : α, a ∣ d ∧ b ∣ d ↔ c ∣ d) :
  gcd_monoid α :=
gcd_monoid_of_lcm
  (λ a b, (classical.some (h a b)))
  (λ a b,
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).1)
  (λ a b,
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).2)
  (λ a b c ac ab, ((classical.some_spec (h c b) a).1 ⟨ac, ab⟩))

/-- Define a `normalized_gcd_monoid` structure on a monoid just from the existence of an `lcm`. -/
noncomputable def normalized_gcd_monoid_of_exists_lcm [normalization_monoid α] [decidable_eq α]
  (h : ∀ a b : α, ∃ c : α, ∀ d : α, a ∣ d ∧ b ∣ d ↔ c ∣ d) :
  normalized_gcd_monoid α :=
normalized_gcd_monoid_of_lcm
  (λ a b, normalize (classical.some (h a b)))
  (λ a b, dvd_normalize_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).1)
  (λ a b, dvd_normalize_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).2)
  (λ a b c ac ab, normalize_dvd_iff.2 ((classical.some_spec (h c b) a).1 ⟨ac, ab⟩))
  (λ a b, normalize_idem _)

end constructors

namespace comm_group_with_zero

variables (G₀ : Type*) [comm_group_with_zero G₀] [decidable_eq G₀]

@[priority 100] -- see Note [lower instance priority]
instance : normalized_gcd_monoid G₀ :=
{ norm_unit := λ x, if h : x = 0 then 1 else (units.mk0 x h)⁻¹,
  norm_unit_zero := dif_pos rfl,
  norm_unit_mul := λ x y x0 y0, units.eq_iff.1 (by simp [x0, y0, mul_comm]),
  norm_unit_coe_units := λ u, by { rw [dif_neg (units.ne_zero _), units.mk0_coe], apply_instance },
  gcd := λ a b, if a = 0 ∧ b = 0 then 0 else 1,
  lcm := λ a b, if a = 0 ∨ b = 0 then 0 else 1,
  gcd_dvd_left := λ a b, by { split_ifs with h, { rw h.1 }, { exact one_dvd _ } },
  gcd_dvd_right := λ a b, by { split_ifs with h, { rw h.2 }, { exact one_dvd _ } },
  dvd_gcd := λ a b c hac hab, begin
    split_ifs with h, { apply dvd_zero },
    cases not_and_distrib.mp h with h h;
      refine is_unit_iff_dvd_one.mp (is_unit_of_dvd_unit _ (is_unit.mk0 _ h));
      assumption
  end,
  gcd_mul_lcm := λ a b, begin
    by_cases ha : a = 0, { simp [ha] },
    by_cases hb : b = 0, { simp [hb] },
    rw [if_neg (not_and_of_not_left _ ha), one_mul, if_neg (not_or ha hb)],
    exact (associated_one_iff_is_unit.mpr ((is_unit.mk0 _ ha).mul (is_unit.mk0 _ hb))).symm
  end,
  lcm_zero_left := λ b, if_pos (or.inl rfl),
  lcm_zero_right := λ a, if_pos (or.inr rfl),
  -- `split_ifs` wants to split `normalize`, so handle the cases manually
  normalize_gcd := λ a b, if h : a = 0 ∧ b = 0 then by simp [if_pos h] else by simp [if_neg h],
  normalize_lcm := λ a b, if h : a = 0 ∨ b = 0 then by simp [if_pos h] else by simp [if_neg h] }

@[simp]
lemma coe_norm_unit {a : G₀} (h0 : a ≠ 0) : (↑(norm_unit a) : G₀) = a⁻¹ :=
by simp [norm_unit, h0]

lemma normalize_eq_one {a : G₀} (h0 : a ≠ 0) : normalize a = 1 :=
by simp [normalize_apply, h0]

end comm_group_with_zero


import Lean

def Set (α : Type u) := α → Prop

namespace Set

def mem (s : Set α) (a : α) := s a

notation:50 a " ∈ " s:50 => Set.mem s a

notation:55 a " ∉ " s:55 => ¬Set.mem s a

def pred (p : α → Prop) : Set α := p

notation "{" a "|" p "}" => Set.pred (λ a => p)
-- TODO look into how we can implement notation like { a ∈ S | p a }

def union (s₁ s₂ : Set α) : Set α :=
  { a | a ∈ s₁ ∨ a ∈ s₂ }

infix:65 " ∪ " => Set.union

def inter (s₁ s₂ : Set α) : Set α :=
  { a | a ∈ s₁ ∧ a ∈ s₂ }

infix:70 " ∩ " => Set.inter

def subseteq (s₁ s₂ : Set α) : Prop :=
  ∀ a, a ∈ s₁ → a ∈ s₂

infix:75 " ⊆ " => Set.subseteq

def subset (s₁ s₂ : Set α) : Prop :=
  s₁ ⊆ s₂ ∧ s₁ ≠ s₂

infix:75 " ⊂ " => Set.subset

def sdiff (s₁ s₂ : Set α) : Set α :=
  { a | a ∈ s₁ ∧ a ∉ s₂ }

infix:80 " \\ " => Set.sdiff

def empty : Set α := λ x => False

notation (priority := high) "∅" => empty

def univ : Set α := λ x => True

def compl (s₁ : Set α) : Set α := univ \ s₁

postfix:max "ᶜ" => compl

def powerset (s : Set α) : Set (Set α) := {t | t ⊆ s}

prefix:60 "𝒫" => powerset

def cartesian (s₁ : Set α) (s₂ : Set β) : Set (α × β) :=
  {t | t.fst ∈ s₁ ∧ t.snd ∈ s₂}

-- This section provides usability lemmas so people don't have to
-- see the guts of the definition they are working with.
section usability

theorem mem_union (x : α) (A B : Set α) : x ∈ A ∪ B ↔ x ∈ A ∨ x ∈ B := Iff.rfl
theorem mem_union_of_left (x : α) (A B : Set α) : x ∈ A → x ∈ A ∪ B := Or.inl
theorem mem_union_of_right (x : α) (A B : Set α) : x ∈ B → x ∈ A ∪ B := Or.inr

theorem mem_inter (x : α) (A B : Set α) : x ∈ A ∩ B ↔ x ∈ A ∧ x ∈ B := Iff.rfl
theorem mem_inter_of_left_right (x : α) (A B : Set α) : x ∈ A → x ∈ B → x ∈ A ∩ B := And.intro

theorem subseteq_def (A B : Set α) : A ⊆ B ↔ (∀ x, x ∈ A → x ∈ B) := Iff.rfl

theorem subsete_def (A B : Set α) : A ⊂ B ↔ (A ⊆ B ∧ A ≠ B) := Iff.rfl

theorem mem_sdiff (x : α) (A B : Set α) : x ∈ A \ B ↔ x ∈ A ∧ x ∉ B := Iff.rfl

theorem not_mem_empty (x : α) : x ∉ ∅ := id

theorem mem_univ (x : α) : x ∈ univ := True.intro

theorem mem_compl (x : α) (A : Set α) : x ∈ Aᶜ ↔ x ∉ A :=
  Iff.intro (λ h1 h2 => h1.right h2) (λ h => ⟨True.intro, h⟩)

theorem mem_powerset (A B : Set α) : A ∈ (𝒫 B) ↔ A ⊆ B := Iff.rfl

theorem mem_cartesian (x : α × β) (A : Set α) (B : Set β) : x ∈ cartesian A B ↔ x.fst ∈ A ∧ x.snd ∈ B := Iff.rfl

theorem mem_cartesian_of_left_right (x : α × β) (A : Set α) (B : Set β) : x.fst ∈ A → x.snd ∈ B → x ∈ cartesian A B := And.intro

end usability

theorem setext {A B : Set α} (h : ∀ x, x ∈ A ↔ x ∈ B) : A = B :=
  funext (λ x => propext (h x))

theorem inter_self_eq_self {A : Set α} : A ∩ A = A :=
  setext λ x => Iff.intro
    (λ ⟨h, _⟩ => h)
    (λ h => ⟨h, h⟩)

theorem inter_empty_eq_empty {A : Set α} : A ∩ ∅ = ∅ :=
  setext λ x => Iff.intro
    (λ ⟨_, h⟩ => h)
    (λ h => False.elim h)

theorem eq_empty_iff_all_notin {A : Set α} : (A = ∅) ↔ (∀ x, x ∉ A) := by
  apply Iff.intro
  case mp =>
    intro hA x xiA
    rw [hA] at xiA
    exact xiA
  case mpr =>
    intro hA
    apply setext
    intro x
    apply Iff.intro
    case h.mp =>
      intro xiA
      exact hA x xiA
    case h.mpr =>
      intro xiE
      exact False.elim $ xiE

theorem inter_comm {A B : Set α} : A ∩ B = B ∩ A :=
  setext λ x => Iff.intro
    (λ ⟨l, r⟩ => ⟨r, l⟩)
    (λ ⟨l, r⟩ => ⟨r, l⟩)

theorem union_comm {A B : Set α} : A ∪ B = B ∪ A := by
  apply setext
  intro x
  apply Iff.intro <;>
  {
    intro h;
    cases h with
    | inl h2 => exact Or.inr h2
    | inr h2 => exact Or.inl h2
  }

theorem subseteq_iff_inter_eq {A B : Set α} : A ⊆ B ↔ A ∩ B = A := by
  apply Iff.intro
  case mp =>
    intro seq
    apply setext
    intro x
    apply Iff.intro
    case mp =>
      intro xiab
      apply And.left xiab
    case mpr =>
      intro x₂
      have h : x ∈ B := (seq x) x₂
      exact And.intro x₂ h
  case mpr =>
    intro xs x xia
    rw [xs.symm] at xia
    exact And.right xia

theorem subseteq_iff_union_eq {A B : Set α} : A ⊆ B ↔ A ∪ B = B := by
  apply Iff.intro
  case mp =>
    intro seq
    apply setext
    intro x
    apply Iff.intro
    case mp =>
      intro xiaob
      apply (Or.elim xiaob) (seq x)
      exact id
    case mpr =>
      intro xib
      exact Or.inr xib
  case mpr =>
    intro xs x xia
    have h : x ∈ A ∪ B := Or.inl xia
    rw [xs] at h
    exact h

theorem sdiff_inter_eq_sdiff {A B : Set α} : A \ (A ∩ B) = A \ B := by
  apply setext
  intro x
  apply Iff.intro <;>
  {
    intro h;
    apply And.intro;
    case left =>
      exact h.left
    case right =>
      intro h₂
      apply h.right
      first | exact And.intro h.left h₂ | exact h₂.right
  }

theorem any_subseteq_univ (A : Set α) : A ⊆ univ := λ _ _ => True.intro

theorem any_subseteq_cartesian_univ_univ (A : Set (α × α)) :  A ⊆ cartesian Set.univ Set.univ := by
  intro _ _
  apply And.intro <;> exact True.intro

end Set