/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import topology.constructions

/-!
# Neighborhoods and continuity relative to a subset

This file defines relative versions

* `nhds_within`           of `nhds`
* `continuous_on`         of `continuous`
* `continuous_within_at`  of `continuous_at`

and proves their basic properties, including the relationships between
these restricted notions and the corresponding notions for the subtype
equipped with the subspace topology.

## Notation

* `𝓝 x`: the filter of neighborhoods of a point `x`;
* `𝓟 s`: the principal filter of a set `s`;
* `𝓝[s] x`: the filter `nhds_within x s` of neighborhoods of a point `x` within a set `s`.

-/

open set filter
open_locale topological_space filter

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
variables [topological_space α]

@[simp] lemma nhds_bind_nhds_within {a : α} {s : set α} :
  (𝓝 a).bind (λ x, 𝓝[s] x) = 𝓝[s] a :=
bind_inf_principal.trans $ congr_arg2 _ nhds_bind_nhds rfl

@[simp] lemma eventually_nhds_nhds_within {a : α} {s : set α} {p : α → Prop} :
  (∀ᶠ y in 𝓝 a, ∀ᶠ x in 𝓝[s] y, p x) ↔ ∀ᶠ x in 𝓝[s] a, p x :=
filter.ext_iff.1 nhds_bind_nhds_within {x | p x}

lemma eventually_nhds_within_iff {a : α} {s : set α} {p : α → Prop} :
  (∀ᶠ x in 𝓝[s] a, p x) ↔ ∀ᶠ x in 𝓝 a, x ∈ s → p x :=
eventually_inf_principal

@[simp] lemma eventually_nhds_within_nhds_within {a : α} {s : set α} {p : α → Prop} :
  (∀ᶠ y in 𝓝[s] a, ∀ᶠ x in 𝓝[s] y, p x) ↔ ∀ᶠ x in 𝓝[s] a, p x :=
begin
  refine ⟨λ h, _, λ h, (eventually_nhds_nhds_within.2 h).filter_mono inf_le_left⟩,
  simp only [eventually_nhds_within_iff] at h ⊢,
  exact h.mono (λ x hx hxs, (hx hxs).self_of_nhds hxs)
end

theorem nhds_within_eq (a : α) (s : set α) :
  𝓝[s] a = ⨅ t ∈ {t : set α | a ∈ t ∧ is_open t}, 𝓟 (t ∩ s) :=
((nhds_basis_opens a).inf_principal s).eq_binfi

theorem nhds_within_univ (a : α) : 𝓝[set.univ] a = 𝓝 a :=
by rw [nhds_within, principal_univ, inf_top_eq]

lemma nhds_within_has_basis {p : β → Prop} {s : β → set α} {a : α} (h : (𝓝 a).has_basis p s)
  (t : set α) :
  (𝓝[t] a).has_basis p (λ i, s i ∩ t) :=
h.inf_principal t

lemma nhds_within_basis_open (a : α) (t : set α) :
  (𝓝[t] a).has_basis (λ u, a ∈ u ∧ is_open u) (λ u, u ∩ t) :=
nhds_within_has_basis (nhds_basis_opens a) t

theorem mem_nhds_within {t : set α} {a : α} {s : set α} :
  t ∈ 𝓝[s] a ↔ ∃ u, is_open u ∧ a ∈ u ∧ u ∩ s ⊆ t  :=
by simpa only [exists_prop, and_assoc, and_comm] using (nhds_within_basis_open a s).mem_iff

lemma mem_nhds_within_iff_exists_mem_nhds_inter {t : set α} {a : α} {s : set α} :
  t ∈ 𝓝[s] a ↔ ∃ u ∈ 𝓝 a, u ∩ s ⊆ t :=
(nhds_within_has_basis (𝓝 a).basis_sets s).mem_iff

lemma diff_mem_nhds_within_compl {X : Type*} [topological_space X] {x : X} {s : set X}
  (hs : s ∈ 𝓝 x) (t : set X) : s \ t ∈ 𝓝[tᶜ] x :=
diff_mem_inf_principal_compl hs t

lemma nhds_of_nhds_within_of_nhds
  {s t : set α} {a : α} (h1 : s ∈ 𝓝 a) (h2 : t ∈ 𝓝[s] a) : (t ∈ 𝓝 a) :=
begin
  rcases mem_nhds_within_iff_exists_mem_nhds_inter.mp h2 with ⟨_, Hw, hw⟩,
  exact (nhds a).sets_of_superset ((nhds a).inter_sets Hw h1) hw,
end

lemma mem_nhds_within_of_mem_nhds {s t : set α} {a : α} (h : s ∈ 𝓝 a) :
  s ∈ 𝓝[t] a :=
mem_inf_sets_of_left h

theorem self_mem_nhds_within {a : α} {s : set α} : s ∈ 𝓝[s] a :=
mem_inf_sets_of_right (mem_principal_self s)

theorem inter_mem_nhds_within (s : set α) {t : set α} {a : α} (h : t ∈ 𝓝 a) :
  s ∩ t ∈ 𝓝[s] a :=
inter_mem_sets self_mem_nhds_within (mem_inf_sets_of_left h)

theorem nhds_within_mono (a : α) {s t : set α} (h : s ⊆ t) : 𝓝[s] a ≤ 𝓝[t] a :=
inf_le_inf_left _ (principal_mono.mpr h)

lemma pure_le_nhds_within {a : α} {s : set α} (ha : a ∈ s) : pure a ≤ 𝓝[s] a :=
le_inf (pure_le_nhds a) (le_principal_iff.2 ha)

lemma mem_of_mem_nhds_within {a : α} {s t : set α} (ha : a ∈ s) (ht : t ∈ 𝓝[s] a) :
  a ∈ t :=
pure_le_nhds_within ha ht

lemma filter.eventually.self_of_nhds_within {p : α → Prop} {s : set α} {x : α}
  (h : ∀ᶠ y in 𝓝[s] x, p y) (hx : x ∈ s) : p x :=
mem_of_mem_nhds_within hx h

lemma tendsto_const_nhds_within {l : filter β} {s : set α} {a : α} (ha : a ∈ s) :
  tendsto (λ x : β, a) l (𝓝[s] a) :=
tendsto_const_pure.mono_right $ pure_le_nhds_within ha

theorem nhds_within_restrict'' {a : α} (s : set α) {t : set α} (h : t ∈ 𝓝[s] a) :
  𝓝[s] a = 𝓝[s ∩ t] a :=
le_antisymm
  (le_inf inf_le_left (le_principal_iff.mpr (inter_mem_sets self_mem_nhds_within h)))
  (inf_le_inf_left _ (principal_mono.mpr (set.inter_subset_left _ _)))

theorem nhds_within_restrict' {a : α} (s : set α) {t : set α} (h : t ∈ 𝓝 a) :
  𝓝[s] a = 𝓝[s ∩ t] a :=
nhds_within_restrict'' s $ mem_inf_sets_of_left h

theorem nhds_within_restrict {a : α} (s : set α) {t : set α} (h₀ : a ∈ t) (h₁ : is_open t) :
  𝓝[s] a = 𝓝[s ∩ t] a :=
nhds_within_restrict' s (mem_nhds_sets h₁ h₀)

theorem nhds_within_le_of_mem {a : α} {s t : set α} (h : s ∈ 𝓝[t] a) :
  𝓝[t] a ≤ 𝓝[s] a :=
begin
  rcases mem_nhds_within.1 h with ⟨u, u_open, au, uts⟩,
  have : 𝓝[t] a = 𝓝[t ∩ u] a := nhds_within_restrict _ au u_open,
  rw [this, inter_comm],
  exact nhds_within_mono _ uts
end

theorem nhds_within_eq_nhds_within {a : α} {s t u : set α}
    (h₀ : a ∈ s) (h₁ : is_open s) (h₂ : t ∩ s = u ∩ s) :
  𝓝[t] a = 𝓝[u] a :=
by rw [nhds_within_restrict t h₀ h₁, nhds_within_restrict u h₀ h₁, h₂]

theorem nhds_within_eq_of_open {a : α} {s : set α} (h₀ : a ∈ s) (h₁ : is_open s) :
  𝓝[s] a = 𝓝 a :=
inf_eq_left.2 $ le_principal_iff.2 $ mem_nhds_sets h₁ h₀

@[simp] theorem nhds_within_empty (a : α) : 𝓝[∅] a = ⊥ :=
by rw [nhds_within, principal_empty, inf_bot_eq]

theorem nhds_within_union (a : α) (s t : set α) :
  𝓝[s ∪ t] a = 𝓝[s] a ⊔ 𝓝[t] a :=
by { delta nhds_within, rw [←inf_sup_left, sup_principal] }

theorem nhds_within_inter (a : α) (s t : set α) :
  𝓝[s ∩ t] a = 𝓝[s] a ⊓ 𝓝[t] a :=
by { delta nhds_within, rw [inf_left_comm, inf_assoc, inf_principal, ←inf_assoc, inf_idem] }

theorem nhds_within_inter' (a : α) (s t : set α) :
  𝓝[s ∩ t] a = (𝓝[s] a) ⊓ 𝓟 t :=
by { delta nhds_within, rw [←inf_principal, inf_assoc] }

theorem nhds_within_inter_of_mem {a : α} {s t : set α} (h : s ∈ 𝓝[t] a) :
  𝓝[s ∩ t] a = 𝓝[t] a :=
by { rw [nhds_within_inter, inf_eq_right], exact nhds_within_le_of_mem h }

@[simp] theorem nhds_within_singleton (a : α) : 𝓝[{a}] a = pure a :=
by rw [nhds_within, principal_singleton, inf_eq_right.2 (pure_le_nhds a)]

@[simp] theorem nhds_within_insert (a : α) (s : set α) :
  𝓝[insert a s] a = pure a ⊔ 𝓝[s] a :=
by rw [← singleton_union, nhds_within_union, nhds_within_singleton]

lemma mem_nhds_within_insert {a : α} {s t : set α} :
  t ∈ 𝓝[insert a s] a ↔ a ∈ t ∧ t ∈ 𝓝[s] a :=
by simp

lemma insert_mem_nhds_within_insert {a : α} {s t : set α} (h : t ∈ 𝓝[s] a) :
  insert a t ∈ 𝓝[insert a s] a :=
by simp [mem_sets_of_superset h]

lemma nhds_within_prod_eq {α : Type*} [topological_space α] {β : Type*} [topological_space β]
  (a : α) (b : β) (s : set α) (t : set β) :
  𝓝[s.prod t] (a, b) = 𝓝[s] a ×ᶠ 𝓝[t] b :=
by { delta nhds_within, rw [nhds_prod_eq, ←filter.prod_inf_prod, filter.prod_principal_principal] }

lemma nhds_within_prod {α : Type*} [topological_space α] {β : Type*} [topological_space β]
  {s u : set α} {t v : set β} {a : α} {b : β}
  (hu : u ∈ 𝓝[s] a) (hv : v ∈ 𝓝[t] b) :
  (u.prod v) ∈ 𝓝[s.prod t] (a, b) :=
by { rw nhds_within_prod_eq, exact prod_mem_prod hu hv, }

lemma nhds_within_pi_eq' {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  {I : set ι} (hI : finite I) (s : Π i, set (α i)) (x : Π i, α i) :
  𝓝[pi I s] x = ⨅ i, comap (λ x, x i) (𝓝 (x i) ⊓ ⨅ (hi : i ∈ I), 𝓟 (s i)) :=
by simp only [nhds_within, nhds_pi, comap_inf, comap_infi, pi_def, comap_principal,
  ← infi_principal_finite hI, ← infi_inf_eq]

lemma nhds_within_pi_eq {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  {I : set ι} (hI : finite I) (s : Π i, set (α i)) (x : Π i, α i) :
  𝓝[pi I s] x = (⨅ i ∈ I, comap (λ x, x i) (𝓝[s i] (x i))) ⊓
    ⨅ (i ∉ I), comap (λ x, x i) (𝓝 (x i)) :=
begin
  simp only [nhds_within, nhds_pi, pi_def, ← infi_principal_finite hI, comap_inf, comap_principal,
    function.eval],
  rw [infi_split _ (λ i, i ∈ I), inf_right_comm],
  simp only [infi_inf_eq]
end

lemma nhds_within_pi_univ_eq {ι : Type*} {α : ι → Type*} [fintype ι] [Π i, topological_space (α i)]
  (s : Π i, set (α i)) (x : Π i, α i) :
  𝓝[pi univ s] x = ⨅ i, comap (λ x, x i) 𝓝[s i] (x i) :=
by simpa [nhds_within] using nhds_within_pi_eq finite_univ s x

lemma nhds_within_pi_univ_eq_bot {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  {s : Π i, set (α i)} {x : Π i, α i} :
  𝓝[pi univ s] x = ⊥ ↔ ∃ i, 𝓝[s i] (x i) = ⊥ :=
begin
  classical,
  split,
  { haveI : Π i, inhabited (α i) := λ i, ⟨x i⟩,
    simp only [nhds_within, nhds_pi, inf_principal_eq_bot, mem_infi_iff', mem_comap_sets],
    rintro ⟨I, hIf, V, hV, hVs⟩, choose! t htx htV using hV,
    contrapose! hVs,
    change ∀ i, ∃ᶠ y in 𝓝 (x i), y ∈ s i at hVs,
    have : ∀ i ∈ I, (s i ∩ t i).nonempty, from λ i hi, ((hVs i).and_eventually (htx i hi)).exists,
    choose! y hys hyt,
    choose z hzs using λ i, (hVs i).exists,
    suffices : I.piecewise y z ∈ (⋂ i ∈ I, V i) ∩ (pi univ s),
      from λ H, H this.1 this.2,
    refine ⟨mem_bInter $ λ i hi, htV i hi _, λ i hi', _⟩,
    { simp only [mem_preimage, piecewise_eq_of_mem _ _ _ hi, hyt i hi] },
    { by_cases hi : i ∈ I; simp * } },
  { rintro ⟨i, eq⟩,
    rw [← @map_eq_bot_iff _ _ _ (λ x : Π i, α i, x i)],
    refine eq_bot_mono _ eq,
    exact ((continuous_apply i).tendsto x).inf
      (tendsto_principal_principal.2 $ λ y hy, hy i trivial) }
end

lemma nhds_within_pi_eq_bot {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  {I : set ι} {s : Π i, set (α i)} {x : Π i, α i} :
  𝓝[pi I s] x = ⊥ ↔ ∃ i ∈ I, 𝓝[s i] (x i) = ⊥ :=
begin
  classical,
  rw [← univ_pi_piecewise I, nhds_within_pi_univ_eq_bot],
  refine exists_congr (λ i, _),
  by_cases hi : i ∈ I; simp [*, nhds_within_univ, nhds_ne_bot.ne]
end

lemma nhds_within_pi_ne_bot {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  {I : set ι} {s : Π i, set (α i)} {x : Π i, α i} :
  (𝓝[pi I s] x).ne_bot ↔ ∀ i ∈ I, (𝓝[s i] (x i)).ne_bot :=
by simp [ne_bot_iff, nhds_within_pi_eq_bot]

theorem filter.tendsto.piecewise_nhds_within {f g : α → β} {t : set α} [∀ x, decidable (x ∈ t)]
  {a : α} {s : set α} {l : filter β}
  (h₀ : tendsto f (𝓝[s ∩ t] a) l) (h₁ : tendsto g (𝓝[s ∩ tᶜ] a) l) :
  tendsto (piecewise t f g) (𝓝[s] a) l :=
by apply tendsto.piecewise; rwa ← nhds_within_inter'

theorem filter.tendsto.if_nhds_within {f g : α → β} {p : α → Prop} [decidable_pred p]
    {a : α} {s : set α} {l : filter β}
    (h₀ : tendsto f (𝓝[s ∩ {x | p x}] a) l)
    (h₁ : tendsto g (𝓝[s ∩ {x | ¬ p x}] a) l) :
  tendsto (λ x, if p x then f x else g x) (𝓝[s] a) l :=
h₀.piecewise_nhds_within h₁

lemma map_nhds_within (f : α → β) (a : α) (s : set α) :
  map f (𝓝[s] a) = ⨅ t ∈ {t : set α | a ∈ t ∧ is_open t}, 𝓟 (f  '' (t ∩ s)) :=
((nhds_within_basis_open a s).map f).eq_binfi

theorem tendsto_nhds_within_mono_left {f : α → β} {a : α}
    {s t : set α} {l : filter β} (hst : s ⊆ t) (h : tendsto f (𝓝[t] a) l) :
  tendsto f (𝓝[s] a) l :=
h.mono_left $ nhds_within_mono a hst

theorem tendsto_nhds_within_mono_right {f : β → α} {l : filter β}
    {a : α} {s t : set α} (hst : s ⊆ t) (h : tendsto f l (𝓝[s] a)) :
  tendsto f l (𝓝[t] a) :=
h.mono_right (nhds_within_mono a hst)

theorem tendsto_nhds_within_of_tendsto_nhds {f : α → β} {a : α}
    {s : set α} {l : filter β} (h : tendsto f (𝓝 a) l) :
  tendsto f (𝓝[s] a) l :=
h.mono_left inf_le_left

theorem principal_subtype {α : Type*} (s : set α) (t : set {x // x ∈ s}) :
  𝓟 t = comap coe (𝓟 ((coe : s → α) '' t)) :=
by rw [comap_principal, set.preimage_image_eq _ subtype.coe_injective]

lemma mem_closure_iff_nhds_within_ne_bot {s : set α} {x : α} :
  x ∈ closure s ↔ ne_bot (𝓝[s] x) :=
mem_closure_iff_cluster_pt

lemma nhds_within_ne_bot_of_mem {s : set α} {x : α} (hx : x ∈ s) :
  ne_bot (𝓝[s] x) :=
mem_closure_iff_nhds_within_ne_bot.1 $ subset_closure hx

lemma is_closed.mem_of_nhds_within_ne_bot {s : set α} (hs : is_closed s)
  {x : α} (hx : ne_bot $ 𝓝[s] x) : x ∈ s :=
by simpa only [hs.closure_eq] using mem_closure_iff_nhds_within_ne_bot.2 hx

lemma dense_range.nhds_within_ne_bot {ι : Type*} {f : ι → α} (h : dense_range f) (x : α) :
  ne_bot (𝓝[range f] x) :=
mem_closure_iff_cluster_pt.1 (h x)

lemma mem_closure_pi {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  {I : set ι} {s : Π i, set (α i)} {x : Π i, α i} :
  x ∈ closure (pi I s) ↔ ∀ i ∈ I, x i ∈ closure (s i) :=
by simp only [mem_closure_iff_nhds_within_ne_bot, nhds_within_pi_ne_bot]

lemma closure_pi_set {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  (I : set ι) (s : Π i, set (α i)) :
  closure (pi I s) = pi I (λ i, closure (s i)) :=
set.ext $ λ x, mem_closure_pi

lemma dense_pi {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)] {s : Π i, set (α i)}
  (I : set ι) (hs : ∀ i ∈ I, dense (s i)) :
  dense (pi I s) :=
by simp only [dense_iff_closure_eq, closure_pi_set,
  pi_congr rfl (λ i hi, (hs i hi).closure_eq), pi_univ]

lemma eventually_eq_nhds_within_iff {f g : α → β} {s : set α} {a : α} :
  (f =ᶠ[𝓝[s] a] g) ↔ ∀ᶠ x in 𝓝 a, x ∈ s → f x = g x :=
mem_inf_principal

lemma eventually_eq_nhds_within_of_eq_on {f g : α → β} {s : set α} {a : α} (h : eq_on f g s) :
  f =ᶠ[𝓝[s] a] g :=
mem_inf_sets_of_right h

lemma set.eq_on.eventually_eq_nhds_within {f g : α → β} {s : set α} {a : α} (h : eq_on f g s) :
  f =ᶠ[𝓝[s] a] g :=
eventually_eq_nhds_within_of_eq_on h

lemma tendsto_nhds_within_congr {f g : α → β} {s : set α} {a : α} {l : filter β}
  (hfg : ∀ x ∈ s, f x = g x) (hf : tendsto f (𝓝[s] a) l) : tendsto g (𝓝[s] a) l :=
(tendsto_congr' $ eventually_eq_nhds_within_of_eq_on hfg).1 hf

lemma eventually_nhds_with_of_forall {s : set α} {a : α} {p : α → Prop} (h : ∀ x ∈ s, p x) :
  ∀ᶠ x in 𝓝[s] a, p x :=
mem_inf_sets_of_right h

lemma tendsto_nhds_within_of_tendsto_nhds_of_eventually_within {a : α} {l : filter β}
  {s : set α} (f : β → α) (h1 : tendsto f l (𝓝 a)) (h2 : ∀ᶠ x in l, f x ∈ s) :
  tendsto f l (𝓝[s] a) :=
tendsto_inf.2 ⟨h1, tendsto_principal.2 h2⟩

@[simp] lemma tendsto_nhds_within_range {a : α} {l : filter β} {f : β → α} :
  tendsto f l (𝓝[range f] a) ↔ tendsto f l (𝓝 a) :=
⟨λ h, h.mono_right inf_le_left, λ h, tendsto_inf.2
  ⟨h, tendsto_principal.2 $ eventually_of_forall mem_range_self⟩⟩

lemma filter.eventually_eq.eq_of_nhds_within {s : set α} {f g : α → β} {a : α}
  (h : f =ᶠ[𝓝[s] a] g) (hmem : a ∈ s) : f a = g a :=
h.self_of_nhds_within hmem

lemma eventually_nhds_within_of_eventually_nhds {α : Type*} [topological_space α]
  {s : set α} {a : α} {p : α → Prop} (h : ∀ᶠ x in 𝓝 a, p x) :
  ∀ᶠ x in 𝓝[s] a, p x :=
mem_nhds_within_of_mem_nhds h

/-!
### `nhds_within` and subtypes
-/

theorem mem_nhds_within_subtype {s : set α} {a : {x // x ∈ s}} {t u : set {x // x ∈ s}} :
  t ∈ 𝓝[u] a ↔ t ∈ comap (coe : s → α) (𝓝[coe '' u] a) :=
by rw [nhds_within, nhds_subtype, principal_subtype, ←comap_inf, ←nhds_within]

theorem nhds_within_subtype (s : set α) (a : {x // x ∈ s}) (t : set {x // x ∈ s}) :
  𝓝[t] a = comap (coe : s → α) (𝓝[coe '' t] a) :=
filter.ext $ λ u, mem_nhds_within_subtype

theorem nhds_within_eq_map_subtype_coe {s : set α} {a : α} (h : a ∈ s) :
  𝓝[s] a = map (coe : s → α) (𝓝 ⟨a, h⟩) :=
by simpa only [subtype.range_coe] using (embedding_subtype_coe.map_nhds_eq ⟨a, h⟩).symm

theorem tendsto_nhds_within_iff_subtype {s : set α} {a : α} (h : a ∈ s) (f : α → β) (l : filter β) :
  tendsto f (𝓝[s] a) l ↔ tendsto (s.restrict f) (𝓝 ⟨a, h⟩) l :=
by simp only [tendsto, nhds_within_eq_map_subtype_coe h, filter.map_map, restrict]

variables [topological_space β] [topological_space γ] [topological_space δ]

/-- A function between topological spaces is continuous at a point `x₀` within a subset `s`
if `f x` tends to `f x₀` when `x` tends to `x₀` while staying within `s`. -/
def continuous_within_at (f : α → β) (s : set α) (x : α) : Prop :=
tendsto f (𝓝[s] x) (𝓝 (f x))

/-- If a function is continuous within `s` at `x`, then it tends to `f x` within `s` by definition.
We register this fact for use with the dot notation, especially to use `tendsto.comp` as
`continuous_within_at.comp` will have a different meaning. -/
lemma continuous_within_at.tendsto {f : α → β} {s : set α} {x : α}
  (h : continuous_within_at f s x) :
  tendsto f (𝓝[s] x) (𝓝 (f x)) := h

/-- A function between topological spaces is continuous on a subset `s`
when it's continuous at every point of `s` within `s`. -/
def continuous_on (f : α → β) (s : set α) : Prop := ∀ x ∈ s, continuous_within_at f s x

lemma continuous_on.continuous_within_at {f : α → β} {s : set α} {x : α} (hf : continuous_on f s)
  (hx : x ∈ s) : continuous_within_at f s x :=
hf x hx

theorem continuous_within_at_univ (f : α → β) (x : α) :
  continuous_within_at f set.univ x ↔ continuous_at f x :=
by rw [continuous_at, continuous_within_at, nhds_within_univ]

theorem continuous_within_at_iff_continuous_at_restrict (f : α → β) {x : α} {s : set α}
  (h : x ∈ s) :
  continuous_within_at f s x ↔ continuous_at (s.restrict f) ⟨x, h⟩ :=
tendsto_nhds_within_iff_subtype h f _

theorem continuous_within_at.tendsto_nhds_within {f : α → β} {x : α} {s : set α} {t : set β}
  (h : continuous_within_at f s x) (ht : maps_to f s t) :
  tendsto f (𝓝[s] x) (𝓝[t] (f x)) :=
tendsto_inf.2 ⟨h, tendsto_principal.2 $ mem_inf_sets_of_right $ mem_principal_sets.2 $ ht⟩

theorem continuous_within_at.tendsto_nhds_within_image {f : α → β} {x : α} {s : set α}
  (h : continuous_within_at f s x) :
  tendsto f (𝓝[s] x) (𝓝[f '' s] (f x)) :=
h.tendsto_nhds_within (maps_to_image _ _)

lemma continuous_within_at.prod_map {f : α → γ} {g : β → δ} {s : set α} {t : set β}
  {x : α} {y : β}
  (hf : continuous_within_at f s x) (hg : continuous_within_at g t y) :
  continuous_within_at (prod.map f g) (s.prod t) (x, y) :=
begin
  unfold continuous_within_at at *,
  rw [nhds_within_prod_eq, prod.map, nhds_prod_eq],
  exact hf.prod_map hg,
end

lemma continuous_within_at_pi {ι : Type*} {π : ι → Type*} [∀ i, topological_space (π i)]
  {f : α → Π i, π i} {s : set α} {x : α} :
  continuous_within_at f s x ↔ ∀ i, continuous_within_at (λ y, f y i) s x :=
tendsto_pi

lemma continuous_on_pi {ι : Type*} {π : ι → Type*} [∀ i, topological_space (π i)]
  {f : α → Π i, π i} {s : set α} :
  continuous_on f s ↔ ∀ i, continuous_on (λ y, f y i) s :=
⟨λ h i x hx, tendsto_pi.1 (h x hx) i, λ h x hx, tendsto_pi.2 (λ i, h i x hx)⟩

theorem continuous_on_iff {f : α → β} {s : set α} :
  continuous_on f s ↔ ∀ x ∈ s, ∀ t : set β, is_open t → f x ∈ t → ∃ u, is_open u ∧ x ∈ u ∧
    u ∩ s ⊆ f ⁻¹' t :=
by simp only [continuous_on, continuous_within_at, tendsto_nhds, mem_nhds_within]

theorem continuous_on_iff_continuous_restrict {f : α → β} {s : set α} :
  continuous_on f s ↔ continuous (s.restrict f) :=
begin
  rw [continuous_on, continuous_iff_continuous_at], split,
  { rintros h ⟨x, xs⟩,
    exact (continuous_within_at_iff_continuous_at_restrict f xs).mp (h x xs) },
  intros h x xs,
  exact (continuous_within_at_iff_continuous_at_restrict f xs).mpr (h ⟨x, xs⟩)
end

theorem continuous_on_iff' {f : α → β} {s : set α} :
  continuous_on f s ↔ ∀ t : set β, is_open t → ∃ u, is_open u ∧ f ⁻¹' t ∩ s = u ∩ s :=
have ∀ t, is_open (s.restrict f ⁻¹' t) ↔ ∃ (u : set α), is_open u ∧ f ⁻¹' t ∩ s = u ∩ s,
  begin
    intro t,
    rw [is_open_induced_iff, set.restrict_eq, set.preimage_comp],
    simp only [subtype.preimage_coe_eq_preimage_coe_iff],
    split; { rintros ⟨u, ou, useq⟩, exact ⟨u, ou, useq.symm⟩ }
  end,
by rw [continuous_on_iff_continuous_restrict, continuous_def]; simp only [this]

theorem continuous_on_iff_is_closed {f : α → β} {s : set α} :
  continuous_on f s ↔ ∀ t : set β, is_closed t → ∃ u, is_closed u ∧ f ⁻¹' t ∩ s = u ∩ s :=
have ∀ t, is_closed (s.restrict f ⁻¹' t) ↔ ∃ (u : set α), is_closed u ∧ f ⁻¹' t ∩ s = u ∩ s,
  begin
    intro t,
    rw [is_closed_induced_iff, set.restrict_eq, set.preimage_comp],
    simp only [subtype.preimage_coe_eq_preimage_coe_iff, eq_comm]
  end,
by rw [continuous_on_iff_continuous_restrict, continuous_iff_is_closed]; simp only [this]

lemma continuous_on.prod_map {f : α → γ} {g : β → δ} {s : set α} {t : set β}
  (hf : continuous_on f s) (hg : continuous_on g t) :
  continuous_on (prod.map f g) (s.prod t) :=
λ ⟨x, y⟩ ⟨hx, hy⟩, continuous_within_at.prod_map (hf x hx) (hg y hy)

lemma continuous_on_empty (f : α → β) : continuous_on f ∅ :=
λ x, false.elim

theorem nhds_within_le_comap {x : α} {s : set α} {f : α → β} (ctsf : continuous_within_at f s x) :
  𝓝[s] x ≤ comap f (𝓝[f '' s] (f x)) :=
map_le_iff_le_comap.1 ctsf.tendsto_nhds_within_image

theorem continuous_within_at_iff_ptendsto_res (f : α → β) {x : α} {s : set α} :
  continuous_within_at f s x ↔ ptendsto (pfun.res f s) (𝓝 x) (𝓝 (f x)) :=
tendsto_iff_ptendsto _ _ _ _

lemma continuous_iff_continuous_on_univ {f : α → β} : continuous f ↔ continuous_on f univ :=
by simp [continuous_iff_continuous_at, continuous_on, continuous_at, continuous_within_at,
         nhds_within_univ]

lemma continuous_within_at.mono {f : α → β} {s t : set α} {x : α} (h : continuous_within_at f t x)
  (hs : s ⊆ t) : continuous_within_at f s x :=
h.mono_left (nhds_within_mono x hs)

lemma continuous_within_at.mono_of_mem {f : α → β} {s t : set α} {x : α}
  (h : continuous_within_at f t x) (hs : t ∈ 𝓝[s] x) : continuous_within_at f s x :=
h.mono_left (nhds_within_le_of_mem hs)

lemma continuous_within_at_inter' {f : α → β} {s t : set α} {x : α} (h : t ∈ 𝓝[s] x) :
  continuous_within_at f (s ∩ t) x ↔ continuous_within_at f s x :=
by simp [continuous_within_at, nhds_within_restrict'' s h]

lemma continuous_within_at_inter {f : α → β} {s t : set α} {x : α} (h : t ∈ 𝓝 x) :
  continuous_within_at f (s ∩ t) x ↔ continuous_within_at f s x :=
by simp [continuous_within_at, nhds_within_restrict' s h]

lemma continuous_within_at_union {f : α → β} {s t : set α} {x : α} :
  continuous_within_at f (s ∪ t) x ↔ continuous_within_at f s x ∧ continuous_within_at f t x :=
by simp only [continuous_within_at, nhds_within_union, tendsto_sup]

lemma continuous_within_at.union {f : α → β} {s t : set α} {x : α}
  (hs : continuous_within_at f s x) (ht : continuous_within_at f t x) :
  continuous_within_at f (s ∪ t) x :=
continuous_within_at_union.2 ⟨hs, ht⟩

lemma continuous_within_at.mem_closure_image  {f : α → β} {s : set α} {x : α}
  (h : continuous_within_at f s x) (hx : x ∈ closure s) : f x ∈ closure (f '' s) :=
by haveI := (mem_closure_iff_nhds_within_ne_bot.1 hx);
exact (mem_closure_of_tendsto h $
  mem_sets_of_superset self_mem_nhds_within (subset_preimage_image f s))

lemma continuous_within_at.mem_closure {f : α → β} {s : set α} {x : α} {A : set β}
  (h : continuous_within_at f s x) (hx : x ∈ closure s) (hA : s ⊆ f⁻¹' A) : f x ∈ closure A :=
closure_mono (image_subset_iff.2 hA) (h.mem_closure_image hx)

lemma continuous_within_at.image_closure {f : α → β} {s : set α}
  (hf : ∀ x ∈ closure s, continuous_within_at f s x) :
  f '' (closure s) ⊆ closure (f '' s) :=
begin
  rintros _ ⟨x, hx, rfl⟩,
  exact (hf x hx).mem_closure_image hx
end

lemma continuous_on.image_closure {f : α → β} {s : set α} (hf : continuous_on f (closure s)) :
  f '' (closure s) ⊆ closure (f '' s) :=
continuous_within_at.image_closure $ λ x hx, (hf x hx).mono subset_closure

@[simp] lemma continuous_within_at_singleton {f : α → β} {x : α} : continuous_within_at f {x} x :=
by simp only [continuous_within_at, nhds_within_singleton, tendsto_pure_nhds]

@[simp] lemma continuous_within_at_insert_self {f : α → β} {x : α} {s : set α} :
  continuous_within_at f (insert x s) x ↔ continuous_within_at f s x :=
by simp only [← singleton_union, continuous_within_at_union, continuous_within_at_singleton,
  true_and]

alias continuous_within_at_insert_self ↔ _ continuous_within_at.insert_self

lemma continuous_within_at.diff_iff {f : α → β} {s t : set α} {x : α}
  (ht : continuous_within_at f t x) :
  continuous_within_at f (s \ t) x ↔ continuous_within_at f s x :=
⟨λ h, (h.union ht).mono $ by simp only [diff_union_self, subset_union_left],
  λ h, h.mono (diff_subset _ _)⟩

@[simp] lemma continuous_within_at_diff_self {f : α → β} {s : set α} {x : α} :
  continuous_within_at f (s \ {x}) x ↔ continuous_within_at f s x :=
continuous_within_at_singleton.diff_iff

theorem is_open_map.continuous_on_image_of_left_inv_on {f : α → β} {s : set α}
  (h : is_open_map (s.restrict f)) {finv : β → α} (hleft : left_inv_on finv f s) :
  continuous_on finv (f '' s) :=
begin
  refine continuous_on_iff'.2 (λ t ht, ⟨f '' (t ∩ s), _, _⟩),
  { rw ← image_restrict, exact h _ (ht.preimage continuous_subtype_coe) },
  { rw [inter_eq_self_of_subset_left (image_subset f (inter_subset_right t s)),
      hleft.image_inter'] },
end

theorem is_open_map.continuous_on_range_of_left_inverse {f : α → β} (hf : is_open_map f)
  {finv : β → α} (hleft : function.left_inverse finv f) :
  continuous_on finv (range f) :=
begin
  rw [← image_univ],
  exact (hf.restrict is_open_univ).continuous_on_image_of_left_inv_on (λ x _, hleft x)
end

lemma continuous_on.congr_mono {f g : α → β} {s s₁ : set α} (h : continuous_on f s)
  (h' : eq_on g f s₁) (h₁ : s₁ ⊆ s) : continuous_on g s₁ :=
begin
  assume x hx,
  unfold continuous_within_at,
  have A := (h x (h₁ hx)).mono h₁,
  unfold continuous_within_at at A,
  rw ← h' hx at A,
  exact A.congr' h'.eventually_eq_nhds_within.symm
end

lemma continuous_on.congr {f g : α → β} {s : set α} (h : continuous_on f s) (h' : eq_on g f s) :
  continuous_on g s :=
h.congr_mono h' (subset.refl _)

lemma continuous_on_congr {f g : α → β} {s : set α} (h' : eq_on g f s) :
  continuous_on g s ↔ continuous_on f s :=
⟨λ h, continuous_on.congr h h'.symm, λ h, h.congr h'⟩

lemma continuous_at.continuous_within_at {f : α → β} {s : set α} {x : α} (h : continuous_at f x) :
  continuous_within_at f s x :=
continuous_within_at.mono ((continuous_within_at_univ f x).2 h) (subset_univ _)

lemma continuous_within_at.continuous_at {f : α → β} {s : set α} {x : α}
  (h : continuous_within_at f s x) (hs : s ∈ 𝓝 x) : continuous_at f x :=
begin
  have : s = univ ∩ s, by rw univ_inter,
  rwa [this, continuous_within_at_inter hs, continuous_within_at_univ] at h
end

lemma continuous_on.continuous_at {f : α → β} {s : set α} {x : α}
  (h : continuous_on f s) (hx : s ∈ 𝓝 x) : continuous_at f x :=
(h x (mem_of_nhds hx)).continuous_at hx

lemma continuous_at.continuous_on {f : α → β} {s : set α} (hcont : ∀ x ∈ s, continuous_at f x) :
  continuous_on f s :=
λ x hx, (hcont x hx).continuous_within_at

lemma continuous_within_at.comp {g : β → γ} {f : α → β} {s : set α} {t : set β} {x : α}
  (hg : continuous_within_at g t (f x)) (hf : continuous_within_at f s x) (h : s ⊆ f ⁻¹' t) :
  continuous_within_at (g ∘ f) s x :=
hg.tendsto.comp (hf.tendsto_nhds_within h)

lemma continuous_within_at.comp' {g : β → γ} {f : α → β} {s : set α} {t : set β} {x : α}
  (hg : continuous_within_at g t (f x)) (hf : continuous_within_at f s x) :
  continuous_within_at (g ∘ f) (s ∩ f⁻¹' t) x :=
hg.comp (hf.mono (inter_subset_left _ _)) (inter_subset_right _ _)

lemma continuous_on.comp {g : β → γ} {f : α → β} {s : set α} {t : set β}
  (hg : continuous_on g t) (hf : continuous_on f s) (h : s ⊆ f ⁻¹' t) :
  continuous_on (g ∘ f) s :=
λx hx, continuous_within_at.comp (hg _ (h hx)) (hf x hx) h

lemma continuous_on.mono {f : α → β} {s t : set α} (hf : continuous_on f s) (h : t ⊆ s)  :
  continuous_on f t :=
λx hx, (hf x (h hx)).mono_left (nhds_within_mono _ h)

lemma continuous_on.comp' {g : β → γ} {f : α → β} {s : set α} {t : set β}
  (hg : continuous_on g t) (hf : continuous_on f s) :
  continuous_on (g ∘ f) (s ∩ f⁻¹' t) :=
hg.comp (hf.mono (inter_subset_left _ _)) (inter_subset_right _ _)

lemma continuous.continuous_on {f : α → β} {s : set α} (h : continuous f) :
  continuous_on f s :=
begin
  rw continuous_iff_continuous_on_univ at h,
  exact h.mono (subset_univ _)
end

lemma continuous.continuous_within_at {f : α → β} {s : set α} {x : α} (h : continuous f) :
  continuous_within_at f s x :=
h.continuous_at.continuous_within_at

lemma continuous.comp_continuous_on {g : β → γ} {f : α → β} {s : set α}
  (hg : continuous g) (hf : continuous_on f s) :
  continuous_on (g ∘ f) s :=
hg.continuous_on.comp hf subset_preimage_univ

lemma continuous_on.comp_continuous {g : β → γ} {f : α → β} {s : set β}
  (hg : continuous_on g s) (hf : continuous f) (hs : ∀ x, f x ∈ s) : continuous (g ∘ f) :=
begin
  rw continuous_iff_continuous_on_univ at *,
  exact hg.comp hf (λ x _, hs x),
end

lemma continuous_within_at.preimage_mem_nhds_within {f : α → β} {x : α} {s : set α} {t : set β}
  (h : continuous_within_at f s x) (ht : t ∈ 𝓝 (f x)) : f ⁻¹' t ∈ 𝓝[s] x :=
h ht

lemma set.left_inv_on.map_nhds_within_eq {f : α → β} {g : β → α} {x : β} {s : set β}
  (h : left_inv_on f g s) (hx : f (g x) = x) (hf : continuous_within_at f (g '' s) (g x))
  (hg : continuous_within_at g s x) :
  map g (𝓝[s] x) = 𝓝[g '' s] (g x) :=
begin
  apply le_antisymm,
  { exact hg.tendsto_nhds_within (maps_to_image _ _) },
  { have A : g ∘ f =ᶠ[𝓝[g '' s] (g x)] id,
      from h.right_inv_on_image.eq_on.eventually_eq_of_mem self_mem_nhds_within,
    refine le_map_of_right_inverse A _,
    simpa only [hx] using hf.tendsto_nhds_within (h.maps_to (surj_on_image _ _)) }
end

lemma function.left_inverse.map_nhds_eq {f : α → β} {g : β → α} {x : β}
  (h : function.left_inverse f g) (hf : continuous_within_at f (range g) (g x))
  (hg : continuous_at g x) :
  map g (𝓝 x) = 𝓝[range g] (g x) :=
by simpa only [nhds_within_univ, image_univ]
  using (h.left_inv_on univ).map_nhds_within_eq (h x) (by rwa image_univ) hg.continuous_within_at

lemma continuous_within_at.preimage_mem_nhds_within' {f : α → β} {x : α} {s : set α} {t : set β}
  (h : continuous_within_at f s x) (ht : t ∈ 𝓝[f '' s] (f x)) :
  f ⁻¹' t ∈ 𝓝[s] x :=
h.tendsto_nhds_within (maps_to_image _ _) ht

lemma continuous_within_at.congr_of_eventually_eq {f f₁ : α → β} {s : set α} {x : α}
  (h : continuous_within_at f s x) (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) :
  continuous_within_at f₁ s x :=
by rwa [continuous_within_at, filter.tendsto, hx, filter.map_congr h₁]

lemma continuous_within_at.congr {f f₁ : α → β} {s : set α} {x : α}
  (h : continuous_within_at f s x) (h₁ : ∀y∈s, f₁ y = f y) (hx : f₁ x = f x) :
  continuous_within_at f₁ s x :=
h.congr_of_eventually_eq (mem_sets_of_superset self_mem_nhds_within h₁) hx

lemma continuous_within_at.congr_mono {f g : α → β} {s s₁ : set α} {x : α}
  (h : continuous_within_at f s x) (h' : eq_on g f s₁) (h₁ : s₁ ⊆ s) (hx : g x = f x):
  continuous_within_at g s₁ x :=
(h.mono h₁).congr h' hx

lemma continuous_on_const {s : set α} {c : β} : continuous_on (λx, c) s :=
continuous_const.continuous_on

lemma continuous_within_at_const {b : β} {s : set α} {x : α} :
  continuous_within_at (λ _:α, b) s x :=
continuous_const.continuous_within_at

lemma continuous_on_id {s : set α} : continuous_on id s :=
continuous_id.continuous_on

lemma continuous_within_at_id {s : set α} {x : α} : continuous_within_at id s x :=
continuous_id.continuous_within_at

lemma continuous_on_open_iff {f : α → β} {s : set α} (hs : is_open s) :
  continuous_on f s ↔ (∀t, is_open t → is_open (s ∩ f⁻¹' t)) :=
begin
  rw continuous_on_iff',
  split,
  { assume h t ht,
    rcases h t ht with ⟨u, u_open, hu⟩,
    rw [inter_comm, hu],
    apply is_open_inter u_open hs },
  { assume h t ht,
    refine ⟨s ∩ f ⁻¹' t, h t ht, _⟩,
    rw [@inter_comm _ s (f ⁻¹' t), inter_assoc, inter_self] }
end

lemma continuous_on.preimage_open_of_open {f : α → β} {s : set α} {t : set β}
  (hf : continuous_on f s) (hs : is_open s) (ht : is_open t) : is_open (s ∩ f⁻¹' t) :=
(continuous_on_open_iff hs).1 hf t ht

lemma continuous_on.preimage_closed_of_closed {f : α → β} {s : set α} {t : set β}
  (hf : continuous_on f s) (hs : is_closed s) (ht : is_closed t) : is_closed (s ∩ f⁻¹' t) :=
begin
  rcases continuous_on_iff_is_closed.1 hf t ht with ⟨u, hu⟩,
  rw [inter_comm, hu.2],
  apply is_closed_inter hu.1 hs
end

lemma continuous_on.preimage_interior_subset_interior_preimage {f : α → β} {s : set α} {t : set β}
  (hf : continuous_on f s) (hs : is_open s) : s ∩ f⁻¹' (interior t) ⊆ s ∩ interior (f⁻¹' t) :=
calc s ∩ f ⁻¹' (interior t) ⊆ interior (s ∩ f ⁻¹' t) :
  interior_maximal (inter_subset_inter (subset.refl _) (preimage_mono interior_subset))
    (hf.preimage_open_of_open hs is_open_interior)
... = s ∩ interior (f ⁻¹' t) : by rw [interior_inter, hs.interior_eq]

lemma continuous_on_of_locally_continuous_on {f : α → β} {s : set α}
  (h : ∀x∈s, ∃t, is_open t ∧ x ∈ t ∧ continuous_on f (s ∩ t)) : continuous_on f s :=
begin
  assume x xs,
  rcases h x xs with ⟨t, open_t, xt, ct⟩,
  have := ct x ⟨xs, xt⟩,
  rwa [continuous_within_at, ← nhds_within_restrict _ xt open_t] at this
end

lemma continuous_on_open_of_generate_from {β : Type*} {s : set α} {T : set (set β)} {f : α → β}
  (hs : is_open s) (h : ∀t ∈ T, is_open (s ∩ f⁻¹' t)) :
  @continuous_on α β _ (topological_space.generate_from T) f s :=
begin
  rw continuous_on_open_iff,
  assume t ht,
  induction ht with u hu u v Tu Tv hu hv U hU hU',
  { exact h u hu },
  { simp only [preimage_univ, inter_univ], exact hs },
  { have : s ∩ f ⁻¹' (u ∩ v) = (s ∩ f ⁻¹' u) ∩ (s ∩ f ⁻¹' v),
      by { ext x, simp, split, finish, finish },
    rw this,
    exact is_open_inter hu hv },
  { rw [preimage_sUnion, inter_bUnion],
    exact is_open_bUnion hU' },
  { exact hs }
end

lemma continuous_within_at.prod {f : α → β} {g : α → γ} {s : set α} {x : α}
  (hf : continuous_within_at f s x) (hg : continuous_within_at g s x) :
  continuous_within_at (λx, (f x, g x)) s x :=
hf.prod_mk_nhds hg

lemma continuous_on.prod {f : α → β} {g : α → γ} {s : set α}
  (hf : continuous_on f s) (hg : continuous_on g s) : continuous_on (λx, (f x, g x)) s :=
λx hx, continuous_within_at.prod (hf x hx) (hg x hx)

lemma inducing.continuous_on_iff {f : α → β} {g : β → γ} (hg : inducing g) {s : set α} :
  continuous_on f s ↔ continuous_on (g ∘ f) s :=
begin
  simp only [continuous_on_iff_continuous_restrict, restrict_eq],
  conv_rhs { rw [function.comp.assoc, ← (inducing.continuous_iff hg)] },
end

lemma embedding.continuous_on_iff {f : α → β} {g : β → γ} (hg : embedding g) {s : set α} :
  continuous_on f s ↔ continuous_on (g ∘ f) s :=
inducing.continuous_on_iff hg.1

lemma continuous_within_at_of_not_mem_closure {f : α → β} {s : set α} {x : α} :
  x ∉ closure s → continuous_within_at f s x :=
begin
  intros hx,
  rw [mem_closure_iff_nhds_within_ne_bot, ne_bot_iff, not_not] at hx,
  rw [continuous_within_at, hx],
  exact tendsto_bot,
end

lemma continuous_on.piecewise' {s t : set α} {f g : α → β} [∀ a, decidable (a ∈ t)]
  (hpf : ∀ a ∈ s ∩ frontier t, tendsto f (𝓝[s ∩ t] a) (𝓝 (piecewise t f g a)))
  (hpg : ∀ a ∈ s ∩ frontier t, tendsto g (𝓝[s ∩ tᶜ] a) (𝓝 (piecewise t f g a)))
  (hf : continuous_on f $ s ∩ t) (hg : continuous_on g $ s ∩ tᶜ) :
  continuous_on (piecewise t f g) s :=
begin
  intros x hx,
  by_cases hx' : x ∈ frontier t,
  { exact (hpf x ⟨hx, hx'⟩).piecewise_nhds_within (hpg x ⟨hx, hx'⟩) },
  { rw [← inter_univ s, ← union_compl_self t, inter_union_distrib_left] at hx ⊢,
    cases hx,
    { apply continuous_within_at.union,
      { exact (hf x hx).congr (λ y hy, piecewise_eq_of_mem _ _ _ hy.2)
          (piecewise_eq_of_mem _ _ _ hx.2) },
      { have : x ∉ closure tᶜ,
          from λ h, hx' ⟨subset_closure hx.2, by rwa closure_compl at h⟩,
        exact continuous_within_at_of_not_mem_closure
          (λ h, this (closure_inter_subset_inter_closure _ _ h).2) } },
    { apply continuous_within_at.union,
      { have : x ∉ closure t,
          from (λ h, hx' ⟨h, (λ (h' : x ∈ interior t), hx.2 (interior_subset h'))⟩),
        exact continuous_within_at_of_not_mem_closure
          (λ h, this (closure_inter_subset_inter_closure _ _ h).2) },
      { exact (hg x hx).congr
          (λ y hy, piecewise_eq_of_not_mem _ _ _ hy.2)
          (piecewise_eq_of_not_mem _ _ _ hx.2) } } }
end

lemma continuous_on.if' {s : set α} {p : α → Prop} {f g : α → β} [∀ a, decidable (p a)]
  (hpf : ∀ a ∈ s ∩ frontier {a | p a},
    tendsto f (𝓝[s ∩ {a | p a}] a) (𝓝 $ if p a then f a else g a))
  (hpg : ∀ a ∈ s ∩ frontier {a | p a},
    tendsto g (𝓝[s ∩ {a | ¬p a}] a) (𝓝 $ if p a then f a else g a))
  (hf : continuous_on f $ s ∩ {a | p a}) (hg : continuous_on g $ s ∩ {a | ¬p a}) :
  continuous_on (λ a, if p a then f a else g a) s :=
hf.piecewise' hpf hpg hg

lemma continuous_on.if {α β : Type*} [topological_space α] [topological_space β] {p : α → Prop}
  [∀ a, decidable (p a)] {s : set α} {f g : α → β}
  (hp : ∀ a ∈ s ∩ frontier {a | p a}, f a = g a) (hf : continuous_on f $ s ∩ closure {a | p a})
  (hg : continuous_on g $ s ∩ closure {a | ¬ p a}) :
  continuous_on (λa, if p a then f a else g a) s :=
begin
  apply continuous_on.if',
  { rintros a ha,
    simp only [← hp a ha, if_t_t],
    apply tendsto_nhds_within_mono_left (inter_subset_inter_right s subset_closure),
    exact hf a ⟨ha.1, ha.2.1⟩ },
  { rintros a ha,
    simp only [hp a ha, if_t_t],
    apply tendsto_nhds_within_mono_left (inter_subset_inter_right s subset_closure),
    rcases ha with ⟨has, ⟨_, ha⟩⟩,
    rw [← mem_compl_iff, ← closure_compl] at ha,
    apply hg a ⟨has, ha⟩ },
  { exact hf.mono (inter_subset_inter_right s subset_closure) },
  { exact hg.mono (inter_subset_inter_right s subset_closure) }
end

lemma continuous_on.piecewise {s t : set α} {f g : α → β} [∀ a, decidable (a ∈ t)]
  (ht : ∀ a ∈ s ∩ frontier t, f a = g a) (hf : continuous_on f $ s ∩ closure t)
  (hg : continuous_on g $ s ∩ closure tᶜ) :
  continuous_on (piecewise t f g) s :=
hf.if ht hg

lemma continuous_if' {p : α → Prop} {f g : α → β} [∀ a, decidable (p a)]
  (hpf : ∀ a ∈ frontier {x | p x}, tendsto f (𝓝[{x | p x}] a) (𝓝 $ ite (p a) (f a) (g a)))
  (hpg : ∀ a ∈ frontier {x | p x}, tendsto g (𝓝[{x | ¬p x}] a) (𝓝 $ ite (p a) (f a) (g a)))
  (hf : continuous_on f {x | p x}) (hg : continuous_on g {x | ¬p x}) :
  continuous (λ a, ite (p a) (f a) (g a)) :=
begin
  rw continuous_iff_continuous_on_univ,
  apply continuous_on.if'; simp *; assumption
end

lemma continuous_if {p : α → Prop} {f g : α → β} [∀ a, decidable (p a)]
  (hp : ∀ a ∈ frontier {x | p x}, f a = g a) (hf : continuous_on f (closure {x | p x}))
  (hg : continuous_on g (closure {x | ¬p x})) :
  continuous (λ a, if p a then f a else g a) :=
begin
  rw continuous_iff_continuous_on_univ,
  apply continuous_on.if; simp; assumption
end

lemma continuous.if {p : α → Prop} {f g : α → β} [∀ a, decidable (p a)]
  (hp : ∀ a ∈ frontier {x | p x}, f a = g a) (hf : continuous f) (hg : continuous g) :
  continuous (λ a, if p a then f a else g a) :=
continuous_if hp hf.continuous_on hg.continuous_on

lemma continuous_piecewise {s : set α} {f g : α → β} [∀ a, decidable (a ∈ s)]
  (hs : ∀ a ∈ frontier s, f a = g a) (hf : continuous_on f (closure s))
  (hg : continuous_on g (closure sᶜ)) :
  continuous (piecewise s f g) :=
continuous_if hs hf hg

lemma continuous.piecewise {s : set α} {f g : α → β} [∀ a, decidable (a ∈ s)]
  (hs : ∀ a ∈ frontier s, f a = g a) (hf : continuous f) (hg : continuous g) :
  continuous (piecewise s f g) :=
hf.if hs hg

lemma is_open.ite' {s s' t : set α}
  (hs : is_open s) (hs' : is_open s') (ht : ∀ x ∈ frontier t, x ∈ s ↔ x ∈ s') :
  is_open (t.ite s s') :=
begin
  classical,
  simp only [is_open_iff_continuous_mem, set.ite] at *,
  convert continuous_piecewise (λ x hx, propext (ht x hx)) hs.continuous_on hs'.continuous_on,
  ext x, by_cases hx : x ∈ t; simp [hx]
end

lemma is_open.ite {s s' t : set α} (hs : is_open s) (hs' : is_open s')
  (ht : s ∩ frontier t = s' ∩ frontier t) :
  is_open (t.ite s s') :=
hs.ite' hs' $ λ x hx, by simpa [hx] using ext_iff.1 ht x

lemma ite_inter_closure_eq_of_inter_frontier_eq {s s' t : set α}
  (ht : s ∩ frontier t = s' ∩ frontier t) :
  t.ite s s' ∩ closure t = s ∩ closure t :=
by rw [closure_eq_self_union_frontier, inter_union_distrib_left, inter_union_distrib_left,
  ite_inter_self, ite_inter_of_inter_eq _ ht]

lemma ite_inter_closure_compl_eq_of_inter_frontier_eq {s s' t : set α}
  (ht : s ∩ frontier t = s' ∩ frontier t) :
  t.ite s s' ∩ closure tᶜ = s' ∩ closure tᶜ :=
by { rw [← ite_compl, ite_inter_closure_eq_of_inter_frontier_eq], rwa [frontier_compl, eq_comm] }

lemma continuous_on_piecewise_ite' {s s' t : set α} {f f' : α → β} [∀ x, decidable (x ∈ t)]
  (h : continuous_on f (s ∩ closure t)) (h' : continuous_on f' (s' ∩ closure tᶜ))
  (H : s ∩ frontier t = s' ∩ frontier t) (Heq : eq_on f f' (s ∩ frontier t)) :
  continuous_on (t.piecewise f f') (t.ite s s') :=
begin
  apply continuous_on.piecewise,
  { rwa ite_inter_of_inter_eq _ H },
  { rwa ite_inter_closure_eq_of_inter_frontier_eq H },
  { rwa ite_inter_closure_compl_eq_of_inter_frontier_eq H }
end

lemma continuous_on_piecewise_ite {s s' t : set α} {f f' : α → β} [∀ x, decidable (x ∈ t)]
  (h : continuous_on f s) (h' : continuous_on f' s')
  (H : s ∩ frontier t = s' ∩ frontier t) (Heq : eq_on f f' (s ∩ frontier t)) :
  continuous_on (t.piecewise f f') (t.ite s s') :=
continuous_on_piecewise_ite' (h.mono (inter_subset_left _ _)) (h'.mono (inter_subset_left _ _))
  H Heq

lemma continuous_on_fst {s : set (α × β)} : continuous_on prod.fst s :=
continuous_fst.continuous_on

lemma continuous_within_at_fst {s : set (α × β)} {p : α × β} :
  continuous_within_at prod.fst s p :=
continuous_fst.continuous_within_at

lemma continuous_on_snd {s : set (α × β)} : continuous_on prod.snd s :=
continuous_snd.continuous_on

lemma continuous_within_at_snd {s : set (α × β)} {p : α × β} :
  continuous_within_at prod.snd s p :=
continuous_snd.continuous_within_at


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl

! This file was ported from Lean 3 source module algebra.order.monoid.with_zero.defs
! leanprover-community/mathlib commit 4dc134b97a3de65ef2ed881f3513d56260971562
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.WithOne.Defs
import Mathlib.Algebra.Order.Monoid.Canonical.Defs
import Mathlib.Algebra.Order.ZeroLEOne

/-!
# Adjoining a zero element to an ordered monoid.
-/

universe u

variable {α : Type u}

/-- A linearly ordered commutative monoid with a zero element. -/
class LinearOrderedCommMonoidWithZero (α : Type _) extends LinearOrderedCommMonoid α,
  CommMonoidWithZero α where
  /-- `0 ≤ 1` in any linearly ordered commutative monoid. -/
  zero_le_one : (0 : α) ≤ 1
#align linear_ordered_comm_monoid_with_zero LinearOrderedCommMonoidWithZero

instance (priority := 100) LinearOrderedCommMonoidWithZero.toZeroLeOneClass
    [LinearOrderedCommMonoidWithZero α] : ZeroLEOneClass α :=
  { ‹LinearOrderedCommMonoidWithZero α› with }
#align linear_ordered_comm_monoid_with_zero.to_zero_le_one_class LinearOrderedCommMonoidWithZero.toZeroLeOneClass

instance (priority := 100) CanonicallyOrderedAddMonoid.toZeroLeOneClass
    [CanonicallyOrderedAddMonoid α] [One α] : ZeroLEOneClass α :=
  ⟨zero_le 1⟩
#align canonically_ordered_add_monoid.to_zero_le_one_class CanonicallyOrderedAddMonoid.toZeroLeOneClass

namespace WithZero

instance preorder [Preorder α] : Preorder (WithZero α) :=
  WithBot.preorder

instance partialOrder [PartialOrder α] : PartialOrder (WithZero α) :=
  WithBot.partialOrder

instance orderBot [Preorder α] : OrderBot (WithZero α) :=
  WithBot.orderBot

theorem zero_le [Preorder α] (a : WithZero α) : 0 ≤ a :=
  bot_le
#align with_zero.zero_le WithZero.zero_le

theorem zero_lt_coe [Preorder α] (a : α) : (0 : WithZero α) < a :=
  WithBot.bot_lt_coe a
#align with_zero.zero_lt_coe WithZero.zero_lt_coe

theorem zero_eq_bot [Preorder α] : (0 : WithZero α) = ⊥ :=
  rfl
#align with_zero.zero_eq_bot WithZero.zero_eq_bot

@[simp, norm_cast]
theorem coe_lt_coe [Preorder α] {a b : α} : (a : WithZero α) < b ↔ a < b :=
  WithBot.coe_lt_coe
#align with_zero.coe_lt_coe WithZero.coe_lt_coe

@[simp, norm_cast]
theorem coe_le_coe [Preorder α] {a b : α} : (a : WithZero α) ≤ b ↔ a ≤ b :=
  WithBot.coe_le_coe
#align with_zero.coe_le_coe WithZero.coe_le_coe

instance lattice [Lattice α] : Lattice (WithZero α) :=
  WithBot.lattice

instance linearOrder [LinearOrder α] : LinearOrder (WithZero α) :=
  WithBot.linearOrder

instance covariantClass_mul_le [Mul α] [Preorder α]
    [CovariantClass α α (· * ·) (· ≤ ·)] :
    CovariantClass (WithZero α) (WithZero α) (· * ·) (· ≤ ·) := by
  refine ⟨fun a b c hbc => ?_⟩
  induction a using WithZero.recZeroCoe; · exact zero_le _
  induction b using WithZero.recZeroCoe; · exact zero_le _
  rcases WithBot.coe_le_iff.1 hbc with ⟨c, rfl, hbc'⟩
  refine le_trans ?_ (le_of_eq <| coe_mul)
  -- rw [← coe_mul, ← coe_mul, coe_le_coe]
  -- Porting note: rewriting `coe_mul` here doesn't work because of some difference between
  -- `coe` and `WithBot.some`, even though they're definitionally equal as shown by the `refine'`
  rw [← coe_mul, coe_le_coe]
  exact mul_le_mul_left' hbc' _
#align with_zero.covariant_class_mul_le WithZero.covariantClass_mul_le

-- Porting note: `simp` can prove these mathlib3 lemmas, so they are omitted.
#noalign with_zero.le_max_iff
#noalign with_zero.min_le_iff

instance orderedCommMonoid [OrderedCommMonoid α] : OrderedCommMonoid (WithZero α) :=
  { WithZero.commMonoidWithZero.toCommMonoid, WithZero.partialOrder with
    mul_le_mul_left := fun _ _ => mul_le_mul_left' }

-- FIXME: `WithOne.coe_mul` and `WithZero.coe_mul` have inconsistent use of implicit parameters

-- Porting note: same issue as `covariantClass_mul_le`
protected theorem covariantClass_add_le [AddZeroClass α] [Preorder α]
    [CovariantClass α α (· + ·) (· ≤ ·)] (h : ∀ a : α, 0 ≤ a) :
    CovariantClass (WithZero α) (WithZero α) (· + ·) (· ≤ ·) := by
  refine ⟨fun a b c hbc => ?_⟩
  induction a using WithZero.recZeroCoe
  · rwa [zero_add, zero_add]
  induction b using WithZero.recZeroCoe
  · rw [add_zero]
    induction c using WithZero.recZeroCoe
    · rw [add_zero]
    · rw [← coe_add, coe_le_coe]
      exact le_add_of_nonneg_right (h _)
  · rcases WithBot.coe_le_iff.1 hbc with ⟨c, rfl, hbc'⟩
    refine le_trans ?_ (le_of_eq <| coe_add _ _)
    rw [← coe_add, coe_le_coe]
    exact add_le_add_left hbc' _
#align with_zero.covariant_class_add_le WithZero.covariantClass_add_le

/-
Note 1 : the below is not an instance because it requires `zero_le`. It seems
like a rather pathological definition because α already has a zero.
Note 2 : there is no multiplicative analogue because it does not seem necessary.
Mathematicians might be more likely to use the order-dual version, where all
elements are ≤ 1 and then 1 is the top element.
-/
/-- If `0` is the least element in `α`, then `WithZero α` is an `OrderedAddCommMonoid`.
See note [reducible non-instances].
-/
@[reducible]
protected def orderedAddCommMonoid [OrderedAddCommMonoid α] (zero_le : ∀ a : α, 0 ≤ a) :
    OrderedAddCommMonoid (WithZero α) :=
  { WithZero.partialOrder, WithZero.addCommMonoid with
    add_le_add_left := @add_le_add_left _ _ _ (WithZero.covariantClass_add_le zero_le).. }
#align with_zero.ordered_add_comm_monoid WithZero.orderedAddCommMonoid

section CanonicallyOrderedMonoid

instance existsAddOfLE [Add α] [Preorder α] [ExistsAddOfLE α] :
    ExistsAddOfLE (WithZero α) :=
  ⟨fun {a b} => by
    induction a using WithZero.cases_on
    · exact fun _ => ⟨b, (zero_add b).symm⟩
    induction b using WithZero.cases_on
    · exact fun h => (WithBot.not_coe_le_bot _ h).elim
    intro h
    obtain ⟨c, rfl⟩ := exists_add_of_le (WithZero.coe_le_coe.1 h)
    exact ⟨c, rfl⟩⟩
#align with_zero.has_exists_add_of_le WithZero.existsAddOfLE

-- This instance looks absurd: a monoid already has a zero
/-- Adding a new zero to a canonically ordered additive monoid produces another one. -/
instance canonicallyOrderedAddMonoid [CanonicallyOrderedAddMonoid α] :
    CanonicallyOrderedAddMonoid (WithZero α) :=
  { WithZero.orderBot,
    WithZero.orderedAddCommMonoid _root_.zero_le,
    WithZero.existsAddOfLE with
    le_self_add := fun a b => by
      induction a using WithZero.cases_on
      · exact bot_le
      induction b using WithZero.cases_on
      · exact le_rfl
      · exact WithZero.coe_le_coe.2 le_self_add }
#align with_zero.canonically_ordered_add_monoid WithZero.canonicallyOrderedAddMonoid

end CanonicallyOrderedMonoid

section CanonicallyLinearOrderedMonoid

instance canonicallyLinearOrderedAddMonoid (α : Type _)
    [CanonicallyLinearOrderedAddMonoid α] : CanonicallyLinearOrderedAddMonoid (WithZero α) :=
  { WithZero.canonicallyOrderedAddMonoid, WithZero.linearOrder with }
#align with_zero.canonically_linear_ordered_add_monoid WithZero.canonicallyLinearOrderedAddMonoid

end CanonicallyLinearOrderedMonoid

end WithZero


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.basic
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
## Counit morphisms for multivariate polynomials

One may consider the ring of multivariate polynomials `mv_polynomial A R` with coefficients in `R`
and variables indexed by `A`. If `A` is not just a type, but an algebra over `R`,
then there is a natural surjective algebra homomorphism `mv_polynomial A R →ₐ[R] A`
obtained by `X a ↦ a`.

### Main declarations

* `mv_polynomial.acounit R A` is the natural surjective algebra homomorphism `mv_polynomial A R →ₐ[R] A`
     obtained by `X a ↦ a`
* `mv_polynomial.counit` is an “absolute” variant with `R = ℤ`
* `mv_polynomial.counit_nat` is an “absolute” variant with `R = ℕ`

-/

namespace mv_polynomial

/-- `mv_polynomial.acounit A B` is the natural surjective algebra homomorphism
`mv_polynomial B A →ₐ[A] B` obtained by `X a ↦ a`.

See `mv_polynomial.counit` for the “absolute” variant with `A = ℤ`,
and `mv_polynomial.counit_nat` for the “absolute” variant with `A = ℕ`. -/
def acounit (A : Type u_1) (B : Type u_2) [comm_semiring A] [comm_semiring B] [algebra A B] : alg_hom A (mv_polynomial B A) B :=
  aeval id

@[simp] theorem acounit_X (A : Type u_1) {B : Type u_2} [comm_semiring A] [comm_semiring B] [algebra A B] (b : B) : coe_fn (acounit A B) (X b) = b :=
  aeval_X id b

@[simp] theorem acounit_C {A : Type u_1} (B : Type u_2) [comm_semiring A] [comm_semiring B] [algebra A B] (a : A) : coe_fn (acounit A B) (coe_fn C a) = coe_fn (algebra_map A B) a :=
  aeval_C id a

theorem acounit_surjective (A : Type u_1) (B : Type u_2) [comm_semiring A] [comm_semiring B] [algebra A B] : function.surjective ⇑(acounit A B) :=
  fun (b : B) => Exists.intro (X b) (acounit_X A b)

/-- `mv_polynomial.counit R` is the natural surjective ring homomorphism
`mv_polynomial R ℤ →+* R` obtained by `X r ↦ r`.

See `mv_polynomial.acounit` for a “relative” variant for algebras over a base ring,
and `mv_polynomial.counit_nat` for the “absolute” variant with `R = ℕ`. -/
def counit (R : Type u_3) [comm_ring R] : mv_polynomial R ℤ →+* R :=
  ↑(acounit ℤ R)

/-- `mv_polynomial.counit_nat A` is the natural surjective ring homomorphism
`mv_polynomial A ℕ →+* A` obtained by `X a ↦ a`.

See `mv_polynomial.acounit` for a “relative” variant for algebras over a base ring
and `mv_polynomial.counit` for the “absolute” variant with `A = ℤ`. -/
def counit_nat (A : Type u_1) [comm_semiring A] : mv_polynomial A ℕ →+* A :=
  ↑(acounit ℕ A)

theorem counit_surjective (R : Type u_3) [comm_ring R] : function.surjective ⇑(counit R) :=
  acounit_surjective ℤ R

theorem counit_nat_surjective (A : Type u_1) [comm_semiring A] : function.surjective ⇑(counit_nat A) :=
  acounit_surjective ℕ A

theorem counit_C (R : Type u_3) [comm_ring R] (n : ℤ) : coe_fn (counit R) (coe_fn C n) = ↑n :=
  acounit_C R n

theorem counit_nat_C (A : Type u_1) [comm_semiring A] (n : ℕ) : coe_fn (counit_nat A) (coe_fn C n) = ↑n :=
  acounit_C A n

@[simp] theorem counit_X {R : Type u_3} [comm_ring R] (r : R) : coe_fn (counit R) (X r) = r :=
  acounit_X ℤ r

@[simp] theorem counit_nat_X {A : Type u_1} [comm_semiring A] (a : A) : coe_fn (counit_nat A) (X a) = a :=
  acounit_X ℕ a


/-
Copyright (c) 2020 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro
-/
import tactic.by_contra
import data.set.basic

/-!
# Well-founded relations

A relation is well-founded if it can be used for induction: for each `x`, `(∀ y, r y x → P y) → P x`
implies `P x`. Well-founded relations can be used for induction and recursion, including
construction of fixed points in the space of dependent functions `Π x : α , β x`.

The predicate `well_founded` is defined in the core library. In this file we prove some extra lemmas
and provide a few new definitions: `well_founded.min`, `well_founded.sup`, and `well_founded.succ`.
-/

variables {α : Type*}

namespace well_founded

theorem not_gt_of_lt {α : Sort*} {r : α → α → Prop} (h : well_founded r) :
  ∀ ⦃a b⦄, r a b → ¬ r b a
| a := λ b hab hba, not_gt_of_lt hba hab
using_well_founded { rel_tac := λ _ _, `[exact ⟨_, h⟩],
                     dec_tac := tactic.assumption }

protected theorem is_asymm {α : Sort*} {r : α → α → Prop} (h : well_founded r) : is_asymm α r :=
⟨h.not_gt_of_lt⟩

instance {α : Sort*} [has_well_founded α] : is_asymm α has_well_founded.r :=
has_well_founded.wf.is_asymm

protected theorem is_irrefl {α : Sort*} {r : α → α → Prop} (h : well_founded r) : is_irrefl α r :=
(@is_asymm.is_irrefl α r h.is_asymm)

instance {α : Sort*} [has_well_founded α] : is_irrefl α has_well_founded.r :=
is_asymm.is_irrefl

/-- If `r` is a well-founded relation, then any nonempty set has a minimal element
with respect to `r`. -/
theorem has_min {α} {r : α → α → Prop} (H : well_founded r)
  (s : set α) : s.nonempty → ∃ a ∈ s, ∀ x ∈ s, ¬ r x a
| ⟨a, ha⟩ := (acc.rec_on (H.apply a) $ λ x _ IH, not_imp_not.1 $ λ hne hx, hne $
  ⟨x, hx, λ y hy hyx, hne $ IH y hyx hy⟩) ha

/-- A minimal element of a nonempty set in a well-founded order.

If you're working with a nonempty linear order, consider defining a
`conditionally_complete_linear_order_bot` instance via
`well_founded.conditionally_complete_linear_order_with_bot` and using `Inf` instead. -/
noncomputable def min {r : α → α → Prop} (H : well_founded r)
  (p : set α) (h : p.nonempty) : α :=
classical.some (H.has_min p h)

theorem min_mem {r : α → α → Prop} (H : well_founded r)
  (p : set α) (h : p.nonempty) : H.min p h ∈ p :=
let ⟨h, _⟩ := classical.some_spec (H.has_min p h) in h

theorem not_lt_min {r : α → α → Prop} (H : well_founded r)
  (p : set α) (h : p.nonempty) {x} (xp : x ∈ p) : ¬ r x (H.min p h) :=
let ⟨_, h'⟩ := classical.some_spec (H.has_min p h) in h' _ xp

theorem well_founded_iff_has_min {r : α → α → Prop} : (well_founded r) ↔
  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, ¬ r x m :=
begin
  classical,
  split,
  { exact has_min, },
  { set counterexamples := { x : α | ¬ acc r x},
    intro exists_max,
    fconstructor,
    intro x,
    by_contra hx,
    obtain ⟨m, m_mem, hm⟩ := exists_max counterexamples ⟨x, hx⟩,
    refine m_mem (acc.intro _ ( λ y y_gt_m, _)),
    by_contra hy,
    exact hm y hy y_gt_m, },
end

lemma eq_iff_not_lt_of_le {α} [partial_order α] {x y : α} : x ≤ y → y = x ↔ ¬ x < y :=
begin
  split,
  { intros xle nge,
    cases le_not_le_of_lt nge,
    rw xle left at nge,
    exact lt_irrefl x nge },
  { intros ngt xle,
    contrapose! ngt,
    exact lt_of_le_of_ne xle (ne.symm ngt) }
end

theorem well_founded_iff_has_max' [partial_order α] : (well_founded ((>) : α → α → Prop) ↔
  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, m ≤ x → x = m) :=
by simp only [eq_iff_not_lt_of_le, well_founded_iff_has_min]

theorem well_founded_iff_has_min' [partial_order α] : (well_founded (has_lt.lt : α → α → Prop)) ↔
  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, x ≤ m → x = m :=
@well_founded_iff_has_max' αᵒᵈ _

open set
/-- The supremum of a bounded, well-founded order -/
protected noncomputable def sup {r : α → α → Prop} (wf : well_founded r) (s : set α)
  (h : bounded r s) : α :=
wf.min { x | ∀a ∈ s, r a x } h

protected lemma lt_sup {r : α → α → Prop} (wf : well_founded r) {s : set α} (h : bounded r s)
  {x} (hx : x ∈ s) : r x (wf.sup s h) :=
min_mem wf { x | ∀a ∈ s, r a x } h x hx

section
open_locale classical
/-- A successor of an element `x` in a well-founded order is a minimal element `y` such that
`x < y` if one exists. Otherwise it is `x` itself. -/
protected noncomputable def succ {r : α → α → Prop} (wf : well_founded r) (x : α) : α :=
if h : ∃y, r x y then wf.min { y | r x y } h else x

protected lemma lt_succ {r : α → α → Prop} (wf : well_founded r) {x : α} (h : ∃y, r x y) :
  r x (wf.succ x) :=
by { rw [well_founded.succ, dif_pos h], apply min_mem }
end

protected lemma lt_succ_iff {r : α → α → Prop} [wo : is_well_order α r] {x : α} (h : ∃y, r x y)
  (y : α) : r y (wo.wf.succ x) ↔ r y x ∨ y = x :=
begin
  split,
  { intro h', have : ¬r x y,
    { intro hy, rw [well_founded.succ, dif_pos] at h',
      exact wo.wf.not_lt_min _ h hy h' },
    rcases trichotomous_of r x y with hy | hy | hy,
    exfalso, exact this hy,
    right, exact hy.symm,
    left, exact hy },
  rintro (hy | rfl), exact trans hy (wo.wf.lt_succ h), exact wo.wf.lt_succ h
end

section linear_order

variables {β : Type*} [linear_order β] (h : well_founded ((<) : β → β → Prop))
  {γ : Type*} [partial_order γ]

theorem min_le {x : β} {s : set β} (hx : x ∈ s) (hne : s.nonempty := ⟨x, hx⟩) :
  h.min s hne ≤ x :=
not_lt.1 $ h.not_lt_min _ _ hx

private theorem eq_strict_mono_iff_eq_range_aux {f g : β → γ} (hf : strict_mono f)
  (hg : strict_mono g) (hfg : set.range f = set.range g) {b : β} (H : ∀ a < b, f a = g a) :
  f b ≤ g b :=
begin
  obtain ⟨c, hc⟩ : g b ∈ set.range f := by { rw hfg, exact set.mem_range_self b },
  cases lt_or_le c b with hcb hbc,
  { rw [H c hcb] at hc,
    rw hg.injective hc at hcb,
    exact hcb.false.elim },
  { rw ←hc,
    exact hf.monotone hbc }
end

include h
theorem eq_strict_mono_iff_eq_range {f g : β → γ} (hf : strict_mono f)
  (hg : strict_mono g) : set.range f = set.range g ↔ f = g :=
⟨λ hfg, begin
  funext a,
  apply h.induction a,
  exact λ b H, le_antisymm
    (eq_strict_mono_iff_eq_range_aux hf hg hfg H)
    (eq_strict_mono_iff_eq_range_aux hg hf hfg.symm (λ a hab, (H a hab).symm))
end, congr_arg _⟩

theorem self_le_of_strict_mono {φ : β → β} (hφ : strict_mono φ) : ∀ n, n ≤ φ n :=
by { by_contra' h₁, have h₂ := h.min_mem _ h₁, exact h.not_lt_min _ h₁ (hφ h₂) h₂ }

end linear_order

end well_founded

namespace function

variables {β : Type*} (f : α → β)

section has_lt

variables [has_lt β] (h : well_founded ((<) : β → β → Prop))

/-- Given a function `f : α → β` where `β` carries a well-founded `<`, this is an element of `α`
whose image under `f` is minimal in the sense of `function.not_lt_argmin`. -/
noncomputable def argmin [nonempty α] : α :=
well_founded.min (inv_image.wf f h) set.univ set.univ_nonempty

lemma not_lt_argmin [nonempty α] (a : α) : ¬ f a < f (argmin f h) :=
well_founded.not_lt_min (inv_image.wf f h) _ _ (set.mem_univ a)

/-- Given a function `f : α → β` where `β` carries a well-founded `<`, and a non-empty subset `s`
of `α`, this is an element of `s` whose image under `f` is minimal in the sense of
`function.not_lt_argmin_on`. -/
noncomputable def argmin_on (s : set α) (hs : s.nonempty) : α :=
well_founded.min (inv_image.wf f h) s hs

@[simp] lemma argmin_on_mem (s : set α) (hs : s.nonempty) :
  argmin_on f h s hs ∈ s :=
well_founded.min_mem _ _ _

@[simp] lemma not_lt_argmin_on (s : set α) {a : α} (ha : a ∈ s)
  (hs : s.nonempty := set.nonempty_of_mem ha) :
  ¬ f a < f (argmin_on f h s hs) :=
well_founded.not_lt_min (inv_image.wf f h) s hs ha

end has_lt

section linear_order

variables [linear_order β] (h : well_founded ((<) : β → β → Prop))

@[simp] lemma argmin_le (a : α) [nonempty α] : f (argmin f h) ≤ f a :=
not_lt.mp $ not_lt_argmin f h a

@[simp] lemma argmin_on_le (s : set α) {a : α} (ha : a ∈ s)
  (hs : s.nonempty := set.nonempty_of_mem ha) : f (argmin_on f h s hs) ≤ f a :=
not_lt.mp $ not_lt_argmin_on f h s ha hs

end linear_order

end function


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.set.n_ary
import order.upper_lower.basic

/-!
# Set family operations

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

This file defines a few binary operations on `set α` for use in set family combinatorics.

## Main declarations

* `s ⊻ t`: Set of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t`.
* `s ⊼ t`: Set of elements of the form `a ⊓ b` where `a ∈ s`, `b ∈ t`.

## Notation

We define the following notation in locale `set_family`:
* `s ⊻ t`
* `s ⊼ t`

## References

[B. Bollobás, *Combinatorics*][bollobas1986]
-/

open function

variables {α : Type*}

/-- Notation typeclass for pointwise supremum `⊻`. -/
class has_sups (α : Type*) :=
(sups : α → α → α)

/-- Notation typeclass for pointwise infimum `⊼`. -/
class has_infs (α : Type*) :=
(infs : α → α → α)

-- This notation is meant to have higher precedence than `⊔` and `⊓`, but still within the realm of
-- other binary operations
infix ` ⊻ `:74 := has_sups.sups
infix ` ⊼ `:75 := has_infs.infs

namespace set
section sups
variables [semilattice_sup α] (s s₁ s₂ t t₁ t₂ u v : set α)

/-- `s ⊻ t` is the set of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t`. -/
protected def has_sups : has_sups (set α) := ⟨image2 (⊔)⟩

localized "attribute [instance] set.has_sups" in set_family

variables {s s₁ s₂ t t₁ t₂ u} {a b c : α}

@[simp] lemma mem_sups : c ∈ s ⊻ t ↔ ∃ (a ∈ s) (b ∈ t), a ⊔ b = c := by simp [(⊻)]

lemma sup_mem_sups : a ∈ s → b ∈ t → a ⊔ b ∈ s ⊻ t := mem_image2_of_mem
lemma sups_subset : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ ⊻ t₁ ⊆ s₂ ⊻ t₂ := image2_subset
lemma sups_subset_left : t₁ ⊆ t₂ → s ⊻ t₁ ⊆ s ⊻ t₂ := image2_subset_left
lemma sups_subset_right : s₁ ⊆ s₂ → s₁ ⊻ t ⊆ s₂ ⊻ t := image2_subset_right

lemma image_subset_sups_left : b ∈ t → (λ a, a ⊔ b) '' s ⊆ s ⊻ t := image_subset_image2_left
lemma image_subset_sups_right : a ∈ s → (⊔) a '' t ⊆ s ⊻ t := image_subset_image2_right

lemma forall_sups_iff {p : α → Prop} : (∀ c ∈ s ⊻ t, p c) ↔ ∀ (a ∈ s) (b ∈ t), p (a ⊔ b) :=
forall_image2_iff

@[simp] lemma sups_subset_iff : s ⊻ t ⊆ u ↔ ∀ (a ∈ s) (b ∈ t), a ⊔ b ∈ u := image2_subset_iff

@[simp] lemma sups_nonempty : (s ⊻ t).nonempty ↔ s.nonempty ∧ t.nonempty := image2_nonempty_iff

protected lemma nonempty.sups : s.nonempty → t.nonempty → (s ⊻ t).nonempty := nonempty.image2
lemma nonempty.of_sups_left : (s ⊻ t).nonempty → s.nonempty := nonempty.of_image2_left
lemma nonempty.of_sups_right : (s ⊻ t).nonempty → t.nonempty := nonempty.of_image2_right

@[simp] lemma empty_sups : ∅ ⊻ t = ∅ := image2_empty_left
@[simp]

@[simp] lemma singleton_sups : {a} ⊻ t = t.image (λ b, a ⊔ b) := image2_singleton_left
@[simp] lemma sups_singleton : s ⊻ {b} = s.image (λ a, a ⊔ b) := image2_singleton_right

lemma singleton_sups_singleton : ({a} ⊻ {b} : set α) = {a ⊔ b} := image2_singleton

lemma sups_union_left : (s₁ ∪ s₂) ⊻ t = s₁ ⊻ t ∪ s₂ ⊻ t := image2_union_left
lemma sups_union_right : s ⊻ (t₁ ∪ t₂) = s ⊻ t₁ ∪ s ⊻ t₂ := image2_union_right

lemma sups_inter_subset_left : (s₁ ∩ s₂) ⊻ t ⊆ s₁ ⊻ t ∩ s₂ ⊻ t := image2_inter_subset_left
lemma sups_inter_subset_right : s ⊻ (t₁ ∩ t₂) ⊆ s ⊻ t₁ ∩ s ⊻ t₂ := image2_inter_subset_right

variables (s t u v)

lemma Union_image_sup_left : (⋃ a ∈ s, (⊔) a '' t) = s ⊻ t := Union_image_left _
lemma Union_image_sup_right : (⋃ b ∈ t, (⊔ b) '' s) = s ⊻ t := Union_image_right _

@[simp] lemma image_sup_prod (s t : set α) : (s ×ˢ t).image (uncurry (⊔)) = s ⊻ t :=
image_uncurry_prod _ _ _

lemma sups_assoc : (s ⊻ t) ⊻ u = s ⊻ (t ⊻ u) := image2_assoc $ λ _ _ _, sup_assoc
lemma sups_comm : s ⊻ t = t ⊻ s := image2_comm $ λ _ _, sup_comm
lemma sups_left_comm : s ⊻ (t ⊻ u) = t ⊻ (s ⊻ u) := image2_left_comm sup_left_comm
lemma sups_right_comm : (s ⊻ t) ⊻ u = (s ⊻ u) ⊻ t := image2_right_comm sup_right_comm
lemma sups_sups_sups_comm : (s ⊻ t) ⊻ (u ⊻ v) = (s ⊻ u) ⊻ (t ⊻ v) :=
image2_image2_image2_comm sup_sup_sup_comm

end sups

section infs
variables [semilattice_inf α] (s s₁ s₂ t t₁ t₂ u v : set α)

/-- `s ⊼ t` is the set of elements of the form `a ⊓ b` where `a ∈ s`, `b ∈ t`. -/
protected def has_infs : has_infs (set α) := ⟨image2 (⊓)⟩

localized "attribute [instance] set.has_infs" in set_family

variables {s s₁ s₂ t t₁ t₂ u} {a b c : α}

@[simp] lemma mem_infs : c ∈ s ⊼ t ↔ ∃ (a ∈ s) (b ∈ t), a ⊓ b = c := by simp [(⊼)]

lemma inf_mem_infs : a ∈ s → b ∈ t → a ⊓ b ∈ s ⊼ t := mem_image2_of_mem
lemma infs_subset : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ ⊼ t₁ ⊆ s₂ ⊼ t₂ := image2_subset
lemma infs_subset_left : t₁ ⊆ t₂ → s ⊼ t₁ ⊆ s ⊼ t₂ := image2_subset_left
lemma infs_subset_right : s₁ ⊆ s₂ → s₁ ⊼ t ⊆ s₂ ⊼ t := image2_subset_right

lemma image_subset_infs_left : b ∈ t → (λ a, a ⊓ b) '' s ⊆ s ⊼ t := image_subset_image2_left
lemma image_subset_infs_right : a ∈ s → (⊓) a '' t ⊆ s ⊼ t := image_subset_image2_right

lemma forall_infs_iff {p : α → Prop} : (∀ c ∈ s ⊼ t, p c) ↔ ∀ (a ∈ s) (b ∈ t), p (a ⊓ b) :=
forall_image2_iff

@[simp] lemma infs_subset_iff : s ⊼ t ⊆ u ↔ ∀ (a ∈ s) (b ∈ t), a ⊓ b ∈ u := image2_subset_iff

@[simp] lemma infs_nonempty : (s ⊼ t).nonempty ↔ s.nonempty ∧ t.nonempty := image2_nonempty_iff

protected lemma nonempty.infs : s.nonempty → t.nonempty → (s ⊼ t).nonempty := nonempty.image2
lemma nonempty.of_infs_left : (s ⊼ t).nonempty → s.nonempty := nonempty.of_image2_left
lemma nonempty.of_infs_right : (s ⊼ t).nonempty → t.nonempty := nonempty.of_image2_right

@[simp] lemma empty_infs : ∅ ⊼ t = ∅ := image2_empty_left
@[simp] lemma infs_empty : s ⊼ ∅ = ∅ := image2_empty_right
@[simp] lemma infs_eq_empty : s ⊼ t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff

@[simp] lemma singleton_infs : {a} ⊼ t = t.image (λ b, a ⊓ b) := image2_singleton_left
@[simp] lemma infs_singleton : s ⊼ {b} = s.image (λ a, a ⊓ b) := image2_singleton_right
lemma singleton_infs_singleton : ({a} ⊼ {b} : set α) = {a ⊓ b} := image2_singleton

lemma infs_union_left : (s₁ ∪ s₂) ⊼ t = s₁ ⊼ t ∪ s₂ ⊼ t := image2_union_left
lemma infs_union_right : s ⊼ (t₁ ∪ t₂) = s ⊼ t₁ ∪ s ⊼ t₂ := image2_union_right

lemma infs_inter_subset_left : (s₁ ∩ s₂) ⊼ t ⊆ s₁ ⊼ t ∩ s₂ ⊼ t := image2_inter_subset_left
lemma infs_inter_subset_right : s ⊼ (t₁ ∩ t₂) ⊆ s ⊼ t₁ ∩ s ⊼ t₂ := image2_inter_subset_right

variables (s t u v)

lemma Union_image_inf_left : (⋃ a ∈ s, (⊓) a '' t) = s ⊼ t := Union_image_left _
lemma Union_image_inf_right : (⋃ b ∈ t, (⊓ b) '' s) = s ⊼ t := Union_image_right _

@[simp] lemma image_inf_prod (s t : set α) : (s ×ˢ t).image (uncurry (⊓)) = s ⊼ t :=
image_uncurry_prod _ _ _

lemma infs_assoc : (s ⊼ t) ⊼ u = s ⊼ (t ⊼ u) := image2_assoc $ λ _ _ _, inf_assoc
lemma infs_comm : s ⊼ t = t ⊼ s := image2_comm $ λ _ _, inf_comm
lemma infs_left_comm : s ⊼ (t ⊼ u) = t ⊼ (s ⊼ u) := image2_left_comm inf_left_comm
lemma infs_right_comm : (s ⊼ t) ⊼ u = (s ⊼ u) ⊼ t := image2_right_comm inf_right_comm
lemma infs_infs_infs_comm : (s ⊼ t) ⊼ (u ⊼ v) = (s ⊼ u) ⊼ (t ⊼ v) :=
image2_image2_image2_comm inf_inf_inf_comm

end infs

open_locale set_family

section distrib_lattice
variables [distrib_lattice α] (s t u : set α)

lemma sups_infs_subset_left : s ⊻ (t ⊼ u) ⊆ (s ⊻ t) ⊼ (s ⊻ u) :=
image2_distrib_subset_left $ λ _ _ _, sup_inf_left

lemma sups_infs_subset_right : (t ⊼ u) ⊻ s ⊆ (t ⊻ s) ⊼ (u ⊻ s) :=
image2_distrib_subset_right $ λ _ _ _, sup_inf_right

lemma infs_sups_subset_left : s ⊼ (t ⊻ u) ⊆ (s ⊼ t) ⊻ (s ⊼ u) :=
image2_distrib_subset_left $ λ _ _ _, inf_sup_left

lemma infs_sups_subset_right : (t ⊻ u) ⊼ s ⊆ (t ⊼ s) ⊻ (u ⊼ s) :=
image2_distrib_subset_right $ λ _ _ _, inf_sup_right

end distrib_lattice

end set

open_locale set_family

@[simp] lemma upper_closure_sups [semilattice_sup α] (s t : set α) :
  upper_closure (s ⊻ t) = upper_closure s ⊔ upper_closure t :=
begin
  ext a,
  simp only [set_like.mem_coe, mem_upper_closure, set.mem_sups, exists_and_distrib_left,
    exists_prop, upper_set.coe_sup, set.mem_inter_iff],
  split,
  { rintro ⟨_, ⟨b, hb, c, hc, rfl⟩, ha⟩,
    exact ⟨⟨b, hb, le_sup_left.trans ha⟩, c, hc, le_sup_right.trans ha⟩ },
  { rintro ⟨⟨b, hb, hab⟩, c, hc, hac⟩,
    exact ⟨_, ⟨b, hb, c, hc, rfl⟩, sup_le hab hac⟩ }
end

@[simp] lemma lower_closure_infs [semilattice_inf α] (s t : set α) :
  lower_closure (s ⊼ t) = lower_closure s ⊓ lower_closure t :=
begin
  ext a,
  simp only [set_like.mem_coe, mem_lower_closure, set.mem_infs, exists_and_distrib_left,
    exists_prop, lower_set.coe_sup, set.mem_inter_iff],
  split,
  { rintro ⟨_, ⟨b, hb, c, hc, rfl⟩, ha⟩,
    exact ⟨⟨b, hb, ha.trans inf_le_left⟩, c, hc, ha.trans inf_le_right⟩ },
  { rintro ⟨⟨b, hb, hab⟩, c, hc, hac⟩,
    exact ⟨_, ⟨b, hb, c, hc, rfl⟩, le_inf hab hac⟩ }
end


import Math.CategoryTheory.NatTrans

namespace CategoryTheory

open Category

structure Monad (α : Sort u) [C : Category α] where
  T : Functor α α
  μ : T.comp T ⇒ T
  η : Functor.id α ⇒ T
  assoc : ∀ (X : α), μ.app X ∘ T.map (μ.app X) = μ.app X ∘ μ.app (T.obj X)
  mul_one : ∀ (X : α), μ.app X ∘ η.app (T.obj X) = 𝟙 (T.obj X)
  one_mul : ∀ (X : α), μ.app X ∘ T.map (η.app X) = 𝟙 (T.obj X)

attribute [simp] Monad.assoc Monad.mul_one Monad.one_mul

namespace Monad

variable [Category α]

@[simp]
theorem μ_natural (M : Monad α) (f : hom X Y) : M.μ.app Y ∘ M.T.map (M.T.map f) = M.T.map f ∘ M.μ.app X := M.μ.natural f

end Monad

end CategoryTheory


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Chris Hughes

! This file was ported from Lean 3 source module ring_theory.multiplicity
! leanprover-community/mathlib commit ceb887ddf3344dab425292e497fa2af91498437c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Associated
import Mathlib.Algebra.BigOperators.Basic
import Mathlib.RingTheory.Valuation.Basic

/-!
# Multiplicity of a divisor

For a commutative monoid, this file introduces the notion of multiplicity of a divisor and proves
several basic results on it.

## Main definitions

* `multiplicity a b`: for two elements `a` and `b` of a commutative monoid returns the largest
  number `n` such that `a ^ n ∣ b` or infinity, written `⊤`, if `a ^ n ∣ b` for all natural numbers
  `n`.
* `multiplicity.Finite a b`: a predicate denoting that the multiplicity of `a` in `b` is finite.
-/

variable {α : Type _}

open Nat Part

open BigOperators

/-- `multiplicity a b` returns the largest natural number `n` such that
  `a ^ n ∣ b`, as an `PartENat` or natural with infinity. If `∀ n, a ^ n ∣ b`,
  then it returns `⊤`-/
def multiplicity [Monoid α] [DecidableRel ((· ∣ ·) : α → α → Prop)] (a b : α) : PartENat :=
  PartENat.find fun n => ¬a ^ (n + 1) ∣ b
#align multiplicity multiplicity

namespace multiplicity

section Monoid

variable [Monoid α]

/-- `multiplicity.Finite a b` indicates that the multiplicity of `a` in `b` is finite. -/
@[reducible]
def Finite (a b : α) : Prop :=
  ∃ n : ℕ, ¬a ^ (n + 1) ∣ b
#align multiplicity.finite multiplicity.Finite

theorem finite_iff_dom [DecidableRel ((· ∣ ·) : α → α → Prop)] {a b : α} :
    Finite a b ↔ (multiplicity a b).Dom :=
  Iff.rfl
#align multiplicity.finite_iff_dom multiplicity.finite_iff_dom

theorem finite_def {a b : α} : Finite a b ↔ ∃ n : ℕ, ¬a ^ (n + 1) ∣ b :=
  Iff.rfl
#align multiplicity.finite_def multiplicity.finite_def

theorem not_dvd_one_of_finite_one_right {a : α} : Finite a 1 → ¬a ∣ 1 := fun ⟨n, hn⟩ ⟨d, hd⟩ =>
  hn ⟨d ^ (n + 1), (pow_mul_pow_eq_one (n + 1) hd.symm).symm⟩
#align multiplicity.not_dvd_one_of_finite_one_right multiplicity.not_dvd_one_of_finite_one_right

@[norm_cast]
theorem Int.coe_nat_multiplicity (a b : ℕ) : multiplicity (a : ℤ) (b : ℤ) = multiplicity a b := by
  apply Part.ext'
  · rw [← @finite_iff_dom ℕ, @finite_def ℕ, ← @finite_iff_dom ℤ, @finite_def ℤ]
    norm_cast
  · intro h1 h2
    apply _root_.le_antisymm <;>
      · apply Nat.find_mono
        norm_cast
        simp
#align multiplicity.int.coe_nat_multiplicity multiplicity.Int.coe_nat_multiplicity

theorem not_finite_iff_forall {a b : α} : ¬Finite a b ↔ ∀ n : ℕ, a ^ n ∣ b :=
  ⟨fun h n =>
    Nat.casesOn n
      (by
        rw [_root_.pow_zero]
        exact one_dvd _)
      (by simpa [Finite, Classical.not_not] using h),
    by simp [Finite, multiplicity, Classical.not_not]; tauto⟩
#align multiplicity.not_finite_iff_forall multiplicity.not_finite_iff_forall

theorem not_unit_of_finite {a b : α} (h : Finite a b) : ¬IsUnit a :=
  let ⟨n, hn⟩ := h
  hn ∘ IsUnit.dvd ∘ IsUnit.pow (n + 1)
#align multiplicity.not_unit_of_finite multiplicity.not_unit_of_finite

theorem finite_of_finite_mul_right {a b c : α} : Finite a (b * c) → Finite a b := fun ⟨n, hn⟩ =>
  ⟨n, fun h => hn (h.trans (dvd_mul_right _ _))⟩
#align multiplicity.finite_of_finite_mul_right multiplicity.finite_of_finite_mul_right

variable [DecidableRel ((· ∣ ·) : α → α → Prop)]

theorem pow_dvd_of_le_multiplicity {a b : α} {k : ℕ} :
    (k : PartENat) ≤ multiplicity a b → a ^ k ∣ b := by
  rw [← PartENat.some_eq_natCast]
  exact
    Nat.casesOn k
      (fun _ => by
        rw [_root_.pow_zero]
        exact one_dvd _)
      fun k ⟨_, h₂⟩ => by_contradiction fun hk => Nat.find_min _ (lt_of_succ_le (h₂ ⟨k, hk⟩)) hk
#align multiplicity.pow_dvd_of_le_multiplicity multiplicity.pow_dvd_of_le_multiplicity

theorem pow_multiplicity_dvd {a b : α} (h : Finite a b) : a ^ get (multiplicity a b) h ∣ b :=
  pow_dvd_of_le_multiplicity (by rw [PartENat.natCast_get])
#align multiplicity.pow_multiplicity_dvd multiplicity.pow_multiplicity_dvd

theorem is_greatest {a b : α} {m : ℕ} (hm : multiplicity a b < m) : ¬a ^ m ∣ b := fun h => by
  rw [PartENat.lt_coe_iff] at hm; exact Nat.find_spec hm.fst ((pow_dvd_pow _ hm.snd).trans h)
#align multiplicity.is_greatest multiplicity.is_greatest

theorem is_greatest' {a b : α} {m : ℕ} (h : Finite a b) (hm : get (multiplicity a b) h < m) :
    ¬a ^ m ∣ b :=
  is_greatest (by rwa [← PartENat.coe_lt_coe, PartENat.natCast_get] at hm)
#align multiplicity.is_greatest' multiplicity.is_greatest'

theorem pos_of_dvd {a b : α} (hfin : Finite a b) (hdiv : a ∣ b) : 0 < (multiplicity a b).get hfin :=
  by
  refine' zero_lt_iff.2 fun h => _
  simpa [hdiv] using is_greatest' hfin (lt_one_iff.mpr h)
#align multiplicity.pos_of_dvd multiplicity.pos_of_dvd

theorem unique {a b : α} {k : ℕ} (hk : a ^ k ∣ b) (hsucc : ¬a ^ (k + 1) ∣ b) :
    (k : PartENat) = multiplicity a b :=
  le_antisymm (le_of_not_gt fun hk' => is_greatest hk' hk) <| by
    have : Finite a b := ⟨k, hsucc⟩
    rw [PartENat.le_coe_iff]
    exact ⟨this, Nat.find_min' _ hsucc⟩
#align multiplicity.unique multiplicity.unique

theorem unique' {a b : α} {k : ℕ} (hk : a ^ k ∣ b) (hsucc : ¬a ^ (k + 1) ∣ b) :
    k = get (multiplicity a b) ⟨k, hsucc⟩ := by
  rw [← PartENat.natCast_inj, PartENat.natCast_get, unique hk hsucc]
#align multiplicity.unique' multiplicity.unique'

theorem le_multiplicity_of_pow_dvd {a b : α} {k : ℕ} (hk : a ^ k ∣ b) :
    (k : PartENat) ≤ multiplicity a b :=
  le_of_not_gt fun hk' => is_greatest hk' hk
#align multiplicity.le_multiplicity_of_pow_dvd multiplicity.le_multiplicity_of_pow_dvd

theorem pow_dvd_iff_le_multiplicity {a b : α} {k : ℕ} :
    a ^ k ∣ b ↔ (k : PartENat) ≤ multiplicity a b :=
  ⟨le_multiplicity_of_pow_dvd, pow_dvd_of_le_multiplicity⟩
#align multiplicity.pow_dvd_iff_le_multiplicity multiplicity.pow_dvd_iff_le_multiplicity

theorem multiplicity_lt_iff_neg_dvd {a b : α} {k : ℕ} :
    multiplicity a b < (k : PartENat) ↔ ¬a ^ k ∣ b := by rw [pow_dvd_iff_le_multiplicity, not_le]
#align multiplicity.multiplicity_lt_iff_neg_dvd multiplicity.multiplicity_lt_iff_neg_dvd

theorem eq_coe_iff {a b : α} {n : ℕ} :
    multiplicity a b = (n : PartENat) ↔ a ^ n ∣ b ∧ ¬a ^ (n + 1) ∣ b := by
  rw [← PartENat.some_eq_natCast]
  exact
    ⟨fun h =>
      let ⟨h₁, h₂⟩ := eq_some_iff.1 h
      h₂ ▸ ⟨pow_multiplicity_dvd _, is_greatest (by
              rw [PartENat.lt_coe_iff]
              exact ⟨h₁, lt_succ_self _⟩)⟩,
      fun h => eq_some_iff.2 ⟨⟨n, h.2⟩, Eq.symm <| unique' h.1 h.2⟩⟩
#align multiplicity.eq_coe_iff multiplicity.eq_coe_iff

theorem eq_top_iff {a b : α} : multiplicity a b = ⊤ ↔ ∀ n : ℕ, a ^ n ∣ b :=
  (PartENat.find_eq_top_iff _).trans <|
    by
    simp only [Classical.not_not]
    exact
      ⟨fun h n =>
        Nat.casesOn n
          (by
            rw [_root_.pow_zero]
            exact one_dvd _)
          fun n => h _,
        fun h n => h _⟩
#align multiplicity.eq_top_iff multiplicity.eq_top_iff

@[simp]
theorem isUnit_left {a : α} (b : α) (ha : IsUnit a) : multiplicity a b = ⊤ :=
  eq_top_iff.2 fun _ => IsUnit.dvd (ha.pow _)
#align multiplicity.is_unit_left multiplicity.isUnit_left

-- @[simp] Porting note: simp can prove this
theorem one_left (b : α) : multiplicity 1 b = ⊤ :=
  isUnit_left b isUnit_one
#align multiplicity.one_left multiplicity.one_left

@[simp]
theorem get_one_right {a : α} (ha : Finite a 1) : get (multiplicity a 1) ha = 0 := by
  rw [PartENat.get_eq_iff_eq_coe, eq_coe_iff, _root_.pow_zero]
  simp [not_dvd_one_of_finite_one_right ha]
#align multiplicity.get_one_right multiplicity.get_one_right

-- @[simp] Porting note: simp can prove this
theorem unit_left (a : α) (u : αˣ) : multiplicity (u : α) a = ⊤ :=
  isUnit_left a u.isUnit
#align multiplicity.unit_left multiplicity.unit_left

theorem multiplicity_eq_zero {a b : α} : multiplicity a b = 0 ↔ ¬a ∣ b := by
  rw [← Nat.cast_zero, eq_coe_iff]
  simp only [_root_.pow_zero, isUnit_one, IsUnit.dvd, zero_add, pow_one, true_and]
#align multiplicity.multiplicity_eq_zero multiplicity.multiplicity_eq_zero

theorem multiplicity_ne_zero {a b : α} : multiplicity a b ≠ 0 ↔ a ∣ b :=
  multiplicity_eq_zero.not_left
#align multiplicity.multiplicity_ne_zero multiplicity.multiplicity_ne_zero

theorem eq_top_iff_not_finite {a b : α} : multiplicity a b = ⊤ ↔ ¬Finite a b :=
  Part.eq_none_iff'
#align multiplicity.eq_top_iff_not_finite multiplicity.eq_top_iff_not_finite

theorem ne_top_iff_finite {a b : α} : multiplicity a b ≠ ⊤ ↔ Finite a b := by
  rw [Ne.def, eq_top_iff_not_finite, Classical.not_not]
#align multiplicity.ne_top_iff_finite multiplicity.ne_top_iff_finite

theorem lt_top_iff_finite {a b : α} : multiplicity a b < ⊤ ↔ Finite a b := by
  rw [lt_top_iff_ne_top, ne_top_iff_finite]
#align multiplicity.lt_top_iff_finite multiplicity.lt_top_iff_finite

theorem exists_eq_pow_mul_and_not_dvd {a b : α} (hfin : Finite a b) :
    ∃ c : α, b = a ^ (multiplicity a b).get hfin * c ∧ ¬a ∣ c := by
  obtain ⟨c, hc⟩ := multiplicity.pow_multiplicity_dvd hfin
  refine' ⟨c, hc, _⟩
  rintro ⟨k, hk⟩
  rw [hk, ← mul_assoc, ← _root_.pow_succ'] at hc
  have h₁ : a ^ ((multiplicity a b).get hfin + 1) ∣ b := ⟨k, hc⟩
  exact (multiplicity.eq_coe_iff.1 (by simp)).2 h₁
#align multiplicity.exists_eq_pow_mul_and_not_dvd multiplicity.exists_eq_pow_mul_and_not_dvd

open Classical

theorem multiplicity_le_multiplicity_iff {a b c d : α} :
    multiplicity a b ≤ multiplicity c d ↔ ∀ n : ℕ, a ^ n ∣ b → c ^ n ∣ d :=
  ⟨fun h n hab => pow_dvd_of_le_multiplicity (le_trans (le_multiplicity_of_pow_dvd hab) h), fun h =>
    if hab : Finite a b then by
      rw [← PartENat.natCast_get (finite_iff_dom.1 hab)];
        exact le_multiplicity_of_pow_dvd (h _ (pow_multiplicity_dvd _))
    else by
      have : ∀ n : ℕ, c ^ n ∣ d := fun n => h n (not_finite_iff_forall.1 hab _)
      rw [eq_top_iff_not_finite.2 hab, eq_top_iff_not_finite.2 (not_finite_iff_forall.2 this)]
      apply le_refl⟩
#align multiplicity.multiplicity_le_multiplicity_iff multiplicity.multiplicity_le_multiplicity_iff

theorem multiplicity_eq_multiplicity_iff {a b c d : α} :
    multiplicity a b = multiplicity c d ↔ ∀ n : ℕ, a ^ n ∣ b ↔ c ^ n ∣ d :=
  ⟨fun h n =>
    ⟨multiplicity_le_multiplicity_iff.mp h.le n, multiplicity_le_multiplicity_iff.mp h.ge n⟩,
    fun h =>
    le_antisymm (multiplicity_le_multiplicity_iff.mpr fun n => (h n).mp)
      (multiplicity_le_multiplicity_iff.mpr fun n => (h n).mpr)⟩
#align multiplicity.multiplicity_eq_multiplicity_iff multiplicity.multiplicity_eq_multiplicity_iff

theorem multiplicity_le_multiplicity_of_dvd_right {a b c : α} (h : b ∣ c) :
    multiplicity a b ≤ multiplicity a c :=
  multiplicity_le_multiplicity_iff.2 fun _ hb => hb.trans h
#align multiplicity.multiplicity_le_multiplicity_of_dvd_right multiplicity.multiplicity_le_multiplicity_of_dvd_right

theorem eq_of_associated_right {a b c : α} (h : Associated b c) :
    multiplicity a b = multiplicity a c :=
  le_antisymm (multiplicity_le_multiplicity_of_dvd_right h.dvd)
    (multiplicity_le_multiplicity_of_dvd_right h.symm.dvd)
#align multiplicity.eq_of_associated_right multiplicity.eq_of_associated_right

theorem dvd_of_multiplicity_pos {a b : α} (h : (0 : PartENat) < multiplicity a b) : a ∣ b := by
  rw [← pow_one a]
  apply pow_dvd_of_le_multiplicity
  simpa only [Nat.cast_one, PartENat.pos_iff_one_le] using h
#align multiplicity.dvd_of_multiplicity_pos multiplicity.dvd_of_multiplicity_pos

theorem dvd_iff_multiplicity_pos {a b : α} : (0 : PartENat) < multiplicity a b ↔ a ∣ b :=
  ⟨dvd_of_multiplicity_pos, fun hdvd =>
    lt_of_le_of_ne (zero_le _) fun heq =>
      is_greatest
        (show multiplicity a b < ↑1 by
          simpa only [heq, Nat.cast_zero] using PartENat.coe_lt_coe.mpr zero_lt_one)
        (by rwa [pow_one a])⟩
#align multiplicity.dvd_iff_multiplicity_pos multiplicity.dvd_iff_multiplicity_pos

theorem finite_nat_iff {a b : ℕ} : Finite a b ↔ a ≠ 1 ∧ 0 < b := by
  rw [← not_iff_not, not_finite_iff_forall, not_and_or, Ne.def, Classical.not_not, not_lt,
    le_zero_iff]
  exact
    ⟨fun h =>
      or_iff_not_imp_right.2 fun hb =>
        have ha : a ≠ 0 := fun ha => hb <| zero_dvd_iff.mp <| by rw [ha] at h; exact h 1
        Classical.by_contradiction fun ha1 : a ≠ 1 =>
          have ha_gt_one : 1 < a :=
            lt_of_not_ge fun _ =>
              match a with
              | 0 => ha rfl
              | 1 => ha1 rfl
              | b+2 => by linarith
          not_lt_of_ge (le_of_dvd (Nat.pos_of_ne_zero hb) (h b)) (lt_pow_self ha_gt_one b),
      fun h => by cases h <;> simp [*]⟩
#align multiplicity.finite_nat_iff multiplicity.finite_nat_iff

alias dvd_iff_multiplicity_pos ↔ _ _root_.has_dvd.dvd.multiplicity_pos

end Monoid

section CommMonoid

variable [CommMonoid α]

theorem finite_of_finite_mul_left {a b c : α} : Finite a (b * c) → Finite a c := by
  rw [mul_comm]; exact finite_of_finite_mul_right
#align multiplicity.finite_of_finite_mul_left multiplicity.finite_of_finite_mul_left

variable [DecidableRel ((· ∣ ·) : α → α → Prop)]

theorem isUnit_right {a b : α} (ha : ¬IsUnit a) (hb : IsUnit b) : multiplicity a b = 0 :=
  eq_coe_iff.2
    ⟨show a ^ 0 ∣ b by simp only [_root_.pow_zero, one_dvd], by
      rw [pow_one]
      exact fun h => mt (isUnit_of_dvd_unit h) ha hb⟩
#align multiplicity.is_unit_right multiplicity.isUnit_right

theorem one_right {a : α} (ha : ¬IsUnit a) : multiplicity a 1 = 0 :=
  isUnit_right ha isUnit_one
#align multiplicity.one_right multiplicity.one_right

theorem unit_right {a : α} (ha : ¬IsUnit a) (u : αˣ) : multiplicity a u = 0 :=
  isUnit_right ha u.isUnit
#align multiplicity.unit_right multiplicity.unit_right

open Classical

theorem multiplicity_le_multiplicity_of_dvd_left {a b c : α} (hdvd : a ∣ b) :
    multiplicity b c ≤ multiplicity a c :=
  multiplicity_le_multiplicity_iff.2 fun n h => (pow_dvd_pow_of_dvd hdvd n).trans h
#align multiplicity.multiplicity_le_multiplicity_of_dvd_left multiplicity.multiplicity_le_multiplicity_of_dvd_left

theorem eq_of_associated_left {a b c : α} (h : Associated a b) :
    multiplicity b c = multiplicity a c :=
  le_antisymm (multiplicity_le_multiplicity_of_dvd_left h.dvd)
    (multiplicity_le_multiplicity_of_dvd_left h.symm.dvd)
#align multiplicity.eq_of_associated_left multiplicity.eq_of_associated_left

-- Porting note: this was doing nothing in mathlib3 also
-- alias dvd_iff_multiplicity_pos ↔ _ _root_.has_dvd.dvd.multiplicity_pos

end CommMonoid

section MonoidWithZero

variable [MonoidWithZero α]

theorem ne_zero_of_finite {a b : α} (h : Finite a b) : b ≠ 0 :=
  let ⟨n, hn⟩ := h
  fun hb => by simp [hb] at hn
#align multiplicity.ne_zero_of_finite multiplicity.ne_zero_of_finite

variable [DecidableRel ((· ∣ ·) : α → α → Prop)]

@[simp]
protected theorem zero (a : α) : multiplicity a 0 = ⊤ :=
  Part.eq_none_iff.2 fun _ ⟨⟨_, hk⟩, _⟩ => hk (dvd_zero _)
#align multiplicity.zero multiplicity.zero

@[simp]
theorem multiplicity_zero_eq_zero_of_ne_zero (a : α) (ha : a ≠ 0) : multiplicity 0 a = 0 :=
  multiplicity.multiplicity_eq_zero.2 <| mt zero_dvd_iff.1 ha
#align multiplicity.multiplicity_zero_eq_zero_of_ne_zero multiplicity.multiplicity_zero_eq_zero_of_ne_zero

end MonoidWithZero

section CommMonoidWithZero

variable [CommMonoidWithZero α]

variable [DecidableRel ((· ∣ ·) : α → α → Prop)]

theorem multiplicity_mk_eq_multiplicity
    [DecidableRel ((· ∣ ·) : Associates α → Associates α → Prop)] {a b : α} :
    multiplicity (Associates.mk a) (Associates.mk b) = multiplicity a b := by
  by_cases h : Finite a b
  · rw [← PartENat.natCast_get (finite_iff_dom.mp h)]
    refine'
        (multiplicity.unique
            (show Associates.mk a ^ (multiplicity a b).get h ∣ Associates.mk b from _) _).symm <;>
      rw [← Associates.mk_pow, Associates.mk_dvd_mk]
    · exact pow_multiplicity_dvd h
    · exact is_greatest
          ((PartENat.lt_coe_iff _ _).mpr (Exists.intro (finite_iff_dom.mp h) (Nat.lt_succ_self _)))
  · suffices ¬Finite (Associates.mk a) (Associates.mk b) by
      rw [finite_iff_dom, PartENat.not_dom_iff_eq_top] at h this
      rw [h, this]
    refine'
      not_finite_iff_forall.mpr fun n =>
        by
        rw [← Associates.mk_pow, Associates.mk_dvd_mk]
        exact not_finite_iff_forall.mp h n
#align multiplicity.multiplicity_mk_eq_multiplicity multiplicity.multiplicity_mk_eq_multiplicity

end CommMonoidWithZero

section Semiring

variable [Semiring α] [DecidableRel ((· ∣ ·) : α → α → Prop)]

theorem min_le_multiplicity_add {p a b : α} :
    min (multiplicity p a) (multiplicity p b) ≤ multiplicity p (a + b) :=
  (le_total (multiplicity p a) (multiplicity p b)).elim
    (fun h => by
      rw [min_eq_left h, multiplicity_le_multiplicity_iff];
        exact fun n hn => dvd_add hn (multiplicity_le_multiplicity_iff.1 h n hn))
    fun h => by
    rw [min_eq_right h, multiplicity_le_multiplicity_iff];
      exact fun n hn => dvd_add (multiplicity_le_multiplicity_iff.1 h n hn) hn
#align multiplicity.min_le_multiplicity_add multiplicity.min_le_multiplicity_add

end Semiring

section Ring

variable [Ring α] [DecidableRel ((· ∣ ·) : α → α → Prop)]

@[simp]
protected theorem neg (a b : α) : multiplicity a (-b) = multiplicity a b :=
  Part.ext' (by simp only [multiplicity, PartENat.find, dvd_neg]) fun h₁ h₂ =>
    PartENat.natCast_inj.1 (by
      rw [PartENat.natCast_get]
      exact Eq.symm
        (unique ((dvd_neg _ _).2 (pow_multiplicity_dvd _))
          (mt (dvd_neg _ _).1 (is_greatest' _ (lt_succ_self _)))))
#align multiplicity.neg multiplicity.neg

theorem Int.natAbs (a : ℕ) (b : ℤ) : multiplicity a b.natAbs = multiplicity (a : ℤ) b := by
  cases' Int.natAbs_eq b with h h <;> conv_rhs => rw [h]
  · rw [Int.coe_nat_multiplicity]
  · rw [multiplicity.neg, Int.coe_nat_multiplicity]
#align multiplicity.int.nat_abs multiplicity.Int.natAbs

theorem multiplicity_add_of_gt {p a b : α} (h : multiplicity p b < multiplicity p a) :
    multiplicity p (a + b) = multiplicity p b := by
  apply le_antisymm
  · apply PartENat.le_of_lt_add_one
    cases' PartENat.ne_top_iff.mp (PartENat.ne_top_of_lt h) with k hk
    rw [hk]
    rw_mod_cast [multiplicity_lt_iff_neg_dvd]
    intro h_dvd
    rw [← dvd_add_iff_right] at h_dvd
    · apply multiplicity.is_greatest _ h_dvd
      rw [hk, ←Nat.succ_eq_add_one]
      norm_cast
      apply Nat.lt_succ_self k
    · rw [pow_dvd_iff_le_multiplicity, Nat.cast_add, ← hk, Nat.cast_one]
      exact PartENat.add_one_le_of_lt h
  · have := @min_le_multiplicity_add α _ _ p a b
    rwa [← min_eq_right (le_of_lt h)]
#align multiplicity.multiplicity_add_of_gt multiplicity.multiplicity_add_of_gt

theorem multiplicity_sub_of_gt {p a b : α} (h : multiplicity p b < multiplicity p a) :
    multiplicity p (a - b) = multiplicity p b := by
  rw [sub_eq_add_neg, multiplicity_add_of_gt] <;> rw [multiplicity.neg]; assumption
#align multiplicity.multiplicity_sub_of_gt multiplicity.multiplicity_sub_of_gt

theorem multiplicity_add_eq_min {p a b : α} (h : multiplicity p a ≠ multiplicity p b) :
    multiplicity p (a + b) = min (multiplicity p a) (multiplicity p b) := by
  rcases lt_trichotomy (multiplicity p a) (multiplicity p b) with (hab | hab | hab)
  · rw [add_comm, multiplicity_add_of_gt hab, min_eq_left]
    exact le_of_lt hab
  · contradiction
  · rw [multiplicity_add_of_gt hab, min_eq_right]
    exact le_of_lt hab
#align multiplicity.multiplicity_add_eq_min multiplicity.multiplicity_add_eq_min

end Ring

section CancelCommMonoidWithZero

variable [CancelCommMonoidWithZero α]

/- Porting note: removed previous wf recursion hints and added termination_by
Also pulled a b intro parameters since Lean parses that more easily -/
theorem finite_mul_aux {p : α} (hp : Prime p) {a b : α}:
    ∀ {n m : ℕ}, ¬p ^ (n + 1) ∣ a → ¬p ^ (m + 1) ∣ b → ¬p ^ (n + m + 1) ∣ a * b
  | n, m => fun ha hb ⟨s, hs⟩ =>
    have : p ∣ a * b := ⟨p ^ (n + m) * s, by simp [hs, pow_add, mul_comm, mul_assoc, mul_left_comm]⟩
    (hp.2.2 a b this).elim
      (fun ⟨x, hx⟩ =>
        have hn0 : 0 < n :=
          Nat.pos_of_ne_zero fun hn0 => by simp [hx, hn0] at ha
        have hpx : ¬p ^ (n - 1 + 1) ∣ x := fun ⟨y, hy⟩ =>
          ha (hx.symm ▸ ⟨y, mul_right_cancel₀ hp.1 <| by
                  rw [tsub_add_cancel_of_le (succ_le_of_lt hn0)] at hy;
                    simp [hy, pow_add, mul_comm, mul_assoc, mul_left_comm]⟩)
        have : 1 ≤ n + m := le_trans hn0 (Nat.le_add_right n m)
        finite_mul_aux hp hpx hb
          ⟨s, mul_right_cancel₀ hp.1 (by
                rw [tsub_add_eq_add_tsub (succ_le_of_lt hn0), tsub_add_cancel_of_le this]
                simp_all [mul_comm, mul_assoc, mul_left_comm, pow_add])⟩)
      fun ⟨x, hx⟩ =>
        have hm0 : 0 < m :=
          Nat.pos_of_ne_zero fun hm0 => by simp [hx, hm0] at hb
        have hpx : ¬p ^ (m - 1 + 1) ∣ x := fun ⟨y, hy⟩ =>
          hb
            (hx.symm ▸
              ⟨y,
                mul_right_cancel₀ hp.1 <| by
                  rw [tsub_add_cancel_of_le (succ_le_of_lt hm0)] at hy;
                    simp [hy, pow_add, mul_comm, mul_assoc, mul_left_comm]⟩)
        finite_mul_aux hp ha hpx
        ⟨s, mul_right_cancel₀ hp.1 (by
              rw [add_assoc, tsub_add_cancel_of_le (succ_le_of_lt hm0)]
              simp_all [mul_comm, mul_assoc, mul_left_comm, pow_add])⟩
termination_by finite_mul_aux _ _ n m  => n+m
#align multiplicity.finite_mul_aux multiplicity.finite_mul_aux

theorem finite_mul {p a b : α} (hp : Prime p) : Finite p a → Finite p b → Finite p (a * b) :=
  fun ⟨n, hn⟩ ⟨m, hm⟩ => ⟨n + m, finite_mul_aux hp hn hm⟩
#align multiplicity.finite_mul multiplicity.finite_mul

theorem finite_mul_iff {p a b : α} (hp : Prime p) : Finite p (a * b) ↔ Finite p a ∧ Finite p b :=
  ⟨fun h => ⟨finite_of_finite_mul_right h, finite_of_finite_mul_left h⟩, fun h =>
    finite_mul hp h.1 h.2⟩
#align multiplicity.finite_mul_iff multiplicity.finite_mul_iff

theorem finite_pow {p a : α} (hp : Prime p) : ∀ {k : ℕ} (_ : Finite p a), Finite p (a ^ k)
  | 0, _ => ⟨0, by simp [mt isUnit_iff_dvd_one.2 hp.2.1]⟩
  | k + 1, ha => by rw [_root_.pow_succ]; exact finite_mul hp ha (finite_pow hp ha)
#align multiplicity.finite_pow multiplicity.finite_pow

variable [DecidableRel ((· ∣ ·) : α → α → Prop)]

@[simp]
theorem multiplicity_self {a : α} (ha : ¬IsUnit a) (ha0 : a ≠ 0) : multiplicity a a = 1 := by
  rw [← Nat.cast_one]
  exact eq_coe_iff.2 ⟨by simp, fun ⟨b, hb⟩ => ha (isUnit_iff_dvd_one.2
            ⟨b, mul_left_cancel₀ ha0 <| by simpa [_root_.pow_succ, mul_assoc] using hb⟩)⟩
#align multiplicity.multiplicity_self multiplicity.multiplicity_self

@[simp]
theorem get_multiplicity_self {a : α} (ha : Finite a a) : get (multiplicity a a) ha = 1 :=
  PartENat.get_eq_iff_eq_coe.2
    (eq_coe_iff.2
      ⟨by simp, fun ⟨b, hb⟩ => by
        rw [← mul_one a, pow_add, pow_one, mul_assoc, mul_assoc,
            mul_right_inj' (ne_zero_of_finite ha)] at hb;
          exact
            mt isUnit_iff_dvd_one.2 (not_unit_of_finite ha) ⟨b, by simp_all⟩⟩)
#align multiplicity.get_multiplicity_self multiplicity.get_multiplicity_self

protected theorem mul' {p a b : α} (hp : Prime p) (h : (multiplicity p (a * b)).Dom) :
    get (multiplicity p (a * b)) h =
      get (multiplicity p a) ((finite_mul_iff hp).1 h).1 +
        get (multiplicity p b) ((finite_mul_iff hp).1 h).2 := by
  have hdiva : p ^ get (multiplicity p a) ((finite_mul_iff hp).1 h).1 ∣ a := pow_multiplicity_dvd _
  have hdivb : p ^ get (multiplicity p b) ((finite_mul_iff hp).1 h).2 ∣ b := pow_multiplicity_dvd _
  have hpoweq :
    p ^ (get (multiplicity p a) ((finite_mul_iff hp).1 h).1 +
          get (multiplicity p b) ((finite_mul_iff hp).1 h).2) =
      p ^ get (multiplicity p a) ((finite_mul_iff hp).1 h).1 *
        p ^ get (multiplicity p b) ((finite_mul_iff hp).1 h).2 :=
    by simp [pow_add]
  have hdiv :
    p ^ (get (multiplicity p a) ((finite_mul_iff hp).1 h).1 +
          get (multiplicity p b) ((finite_mul_iff hp).1 h).2) ∣
      a * b :=
    by rw [hpoweq]; apply mul_dvd_mul <;> assumption
  have hsucc :
    ¬p ^ (get (multiplicity p a) ((finite_mul_iff hp).1 h).1 +
              get (multiplicity p b) ((finite_mul_iff hp).1 h).2 +
            1) ∣
        a * b :=
    fun h =>
    not_or_of_not (is_greatest' _ (lt_succ_self _)) (is_greatest' _ (lt_succ_self _))
      (_root_.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul hp hdiva hdivb h)
  rw [← PartENat.natCast_inj, PartENat.natCast_get, eq_coe_iff]; exact ⟨hdiv, hsucc⟩
#align multiplicity.mul' multiplicity.mul'

open Classical

protected theorem mul {p a b : α} (hp : Prime p) :
    multiplicity p (a * b) = multiplicity p a + multiplicity p b :=
  if h : Finite p a ∧ Finite p b then by
    rw [← PartENat.natCast_get (finite_iff_dom.1 h.1), ←
        PartENat.natCast_get (finite_iff_dom.1 h.2), ←
        PartENat.natCast_get (finite_iff_dom.1 (finite_mul hp h.1 h.2)), ← Nat.cast_add,
        PartENat.natCast_inj, multiplicity.mul' hp]
  else by
    rw [eq_top_iff_not_finite.2 (mt (finite_mul_iff hp).1 h)]
    cases' not_and_or.1 h with h h <;> simp [eq_top_iff_not_finite.2 h]
#align multiplicity.mul multiplicity.mul

theorem Finset.prod {β : Type _} {p : α} (hp : Prime p) (s : Finset β) (f : β → α) :
    multiplicity p (∏ x in s, f x) = ∑ x in s, multiplicity p (f x) := by
  classical
    induction' s using Finset.induction with a s has ih h
    · simp only [Finset.sum_empty, Finset.prod_empty]
      convert one_right hp.not_unit
    · simp [has, ← ih]
      convert multiplicity.mul hp
#align multiplicity.finset.prod multiplicity.Finset.prod

-- Porting note: with protected could not use pow' k in the succ branch
protected theorem pow' {p a : α} (hp : Prime p) (ha : Finite p a) :
    ∀ {k : ℕ}, get (multiplicity p (a ^ k)) (finite_pow hp ha) = k * get (multiplicity p a) ha :=
  by
  intro k
  induction' k with k hk
  · simp [one_right hp.not_unit]
  · have : multiplicity p (a ^ (k + 1)) = multiplicity p (a * a ^ k) := by rw [_root_.pow_succ]
    rw [succ_eq_add_one, get_eq_get_of_eq _ _ this,
      multiplicity.mul' hp, hk, add_mul, one_mul, add_comm]
#align multiplicity.pow' multiplicity.pow'

theorem pow {p a : α} (hp : Prime p) : ∀ {k : ℕ}, multiplicity p (a ^ k) = k • multiplicity p a
  | 0 => by simp [one_right hp.not_unit]
  | succ k => by simp [_root_.pow_succ, succ_nsmul, pow hp, multiplicity.mul hp]
#align multiplicity.pow multiplicity.pow

theorem multiplicity_pow_self {p : α} (h0 : p ≠ 0) (hu : ¬IsUnit p) (n : ℕ) :
    multiplicity p (p ^ n) = n := by
  rw [eq_coe_iff]
  use dvd_rfl
  rw [pow_dvd_pow_iff h0 hu]
  apply Nat.not_succ_le_self
#align multiplicity.multiplicity_pow_self multiplicity.multiplicity_pow_self

theorem multiplicity_pow_self_of_prime {p : α} (hp : Prime p) (n : ℕ) :
    multiplicity p (p ^ n) = n :=
  multiplicity_pow_self hp.ne_zero hp.not_unit n
#align multiplicity.multiplicity_pow_self_of_prime multiplicity.multiplicity_pow_self_of_prime

end CancelCommMonoidWithZero

section Valuation

variable {R : Type _} [CommRing R] [IsDomain R] {p : R} [DecidableRel (Dvd.dvd : R → R → Prop)]

/-- `multiplicity` of a prime in an integral domain as an additive valuation to `PartENat`. -/
noncomputable def addValuation (hp : Prime p) : AddValuation R PartENat :=
  AddValuation.of (multiplicity p) (multiplicity.zero _) (one_right hp.not_unit)
    (fun _ _ => min_le_multiplicity_add) fun _ _ => multiplicity.mul hp
#align multiplicity.add_valuation multiplicity.addValuation

@[simp]
theorem addValuation_apply {hp : Prime p} {r : R} : addValuation hp r = multiplicity p r :=
  rfl
#align multiplicity.add_valuation_apply multiplicity.addValuation_apply

end Valuation

end multiplicity

section Nat

open multiplicity

theorem multiplicity_eq_zero_of_coprime {p a b : ℕ} (hp : p ≠ 1)
    (hle : multiplicity p a ≤ multiplicity p b) (hab : Nat.coprime a b) : multiplicity p a = 0 := by
  rw [multiplicity_le_multiplicity_iff] at hle
  rw [← nonpos_iff_eq_zero, ← not_lt, PartENat.pos_iff_one_le, ← Nat.cast_one, ←
    pow_dvd_iff_le_multiplicity]
  intro h
  have := Nat.dvd_gcd h (hle _ h)
  rw [coprime.gcd_eq_one hab, Nat.dvd_one, pow_one] at this
  exact hp this
#align multiplicity_eq_zero_of_coprime multiplicity_eq_zero_of_coprime

end Nat