/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import topology.algebra.constructions
import topology.bases
import topology.uniform_space.basic
/-!
# Theory of Cauchy filters in uniform spaces. Complete uniform spaces. Totally bounded subsets.

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
-/
universes u v

open filter topological_space set classical uniform_space function
open_locale classical uniformity topology filter

variables {α : Type u} {β : Type v} [uniform_space α]

/-- A filter `f` is Cauchy if for every entourage `r`, there exists an
  `s ∈ f` such that `s × s ⊆ r`. This is a generalization of Cauchy
  sequences, because if `a : ℕ → α` then the filter of sets containing
  cofinitely many of the `a n` is Cauchy iff `a` is a Cauchy sequence. -/
def cauchy (f : filter α) := ne_bot f ∧ f ×ᶠ f ≤ (𝓤 α)

/-- A set `s` is called *complete*, if any Cauchy filter `f` such that `s ∈ f`
has a limit in `s` (formally, it satisfies `f ≤ 𝓝 x` for some `x ∈ s`). -/
def is_complete (s : set α) := ∀f, cauchy f → f ≤ 𝓟 s → ∃x∈s, f ≤ 𝓝 x

lemma filter.has_basis.cauchy_iff {ι} {p : ι → Prop} {s : ι → set (α × α)} (h : (𝓤 α).has_basis p s)
  {f : filter α} :
  cauchy f ↔ (ne_bot f ∧ (∀ i, p i → ∃ t ∈ f, ∀ x y ∈ t, (x, y) ∈ s i)) :=
and_congr iff.rfl $ (f.basis_sets.prod_self.le_basis_iff h).trans $
  by simp only [subset_def, prod.forall, mem_prod_eq, and_imp, id, ball_mem_comm]

lemma cauchy_iff' {f : filter α} :
  cauchy f ↔ (ne_bot f ∧ (∀ s ∈ 𝓤 α, ∃t∈f, ∀ x y ∈ t, (x, y) ∈ s)) :=
(𝓤 α).basis_sets.cauchy_iff

lemma cauchy_iff {f : filter α} :
  cauchy f ↔ (ne_bot f ∧ (∀ s ∈ 𝓤 α, ∃t∈f, t ×ˢ t ⊆ s)) :=
cauchy_iff'.trans $ by simp only [subset_def, prod.forall, mem_prod_eq, and_imp, id, ball_mem_comm]

lemma cauchy.ultrafilter_of {l : filter α} (h : cauchy l) :
  cauchy (@ultrafilter.of _ l h.1 : filter α) :=
begin
  haveI := h.1,
  have := ultrafilter.of_le l,
  exact ⟨ultrafilter.ne_bot _, (filter.prod_mono this this).trans h.2⟩
end

lemma cauchy_map_iff {l : filter β} {f : β → α} :
  cauchy (l.map f) ↔ (ne_bot l ∧ tendsto (λp:β×β, (f p.1, f p.2)) (l ×ᶠ l) (𝓤 α)) :=
by rw [cauchy, map_ne_bot_iff, prod_map_map_eq, tendsto]

lemma cauchy_map_iff' {l : filter β} [hl : ne_bot l] {f : β → α} :
  cauchy (l.map f) ↔ tendsto (λp:β×β, (f p.1, f p.2)) (l ×ᶠ l) (𝓤 α) :=
cauchy_map_iff.trans $ and_iff_right hl

lemma cauchy.mono {f g : filter α} [hg : ne_bot g] (h_c : cauchy f) (h_le : g ≤ f) : cauchy g :=
⟨hg, le_trans (filter.prod_mono h_le h_le) h_c.right⟩

lemma cauchy.mono' {f g : filter α} (h_c : cauchy f) (hg : ne_bot g) (h_le : g ≤ f) : cauchy g :=
h_c.mono h_le

lemma cauchy_nhds {a : α} : cauchy (𝓝 a) :=
⟨nhds_ne_bot, nhds_prod_eq.symm.trans_le (nhds_le_uniformity a)⟩

lemma cauchy_pure {a : α} : cauchy (pure a) :=
cauchy_nhds.mono (pure_le_nhds a)

lemma filter.tendsto.cauchy_map {l : filter β} [ne_bot l] {f : β → α} {a : α}
  (h : tendsto f l (𝓝 a)) :
  cauchy (map f l) :=
cauchy_nhds.mono h

lemma cauchy.prod [uniform_space β] {f : filter α} {g : filter β} (hf : cauchy f) (hg : cauchy g) :
  cauchy (f ×ᶠ g) :=
begin
  refine ⟨hf.1.prod hg.1, _⟩,
  simp only [uniformity_prod, le_inf_iff, ← map_le_iff_le_comap, ← prod_map_map_eq],
  exact ⟨le_trans (prod_mono tendsto_fst tendsto_fst) hf.2,
    le_trans (prod_mono tendsto_snd tendsto_snd) hg.2⟩
end

/-- The common part of the proofs of `le_nhds_of_cauchy_adhp` and
`sequentially_complete.le_nhds_of_seq_tendsto_nhds`: if for any entourage `s`
one can choose a set `t ∈ f` of diameter `s` such that it contains a point `y`
with `(x, y) ∈ s`, then `f` converges to `x`. -/
lemma le_nhds_of_cauchy_adhp_aux {f : filter α} {x : α}
  (adhs : ∀ s ∈ 𝓤 α, ∃ t ∈ f, (t ×ˢ t ⊆ s) ∧ ∃ y, (x, y) ∈ s ∧ y ∈ t) :
  f ≤ 𝓝 x :=
begin
  -- Consider a neighborhood `s` of `x`
  assume s hs,
  -- Take an entourage twice smaller than `s`
  rcases comp_mem_uniformity_sets (mem_nhds_uniformity_iff_right.1 hs) with ⟨U, U_mem, hU⟩,
  -- Take a set `t ∈ f`, `t × t ⊆ U`, and a point `y ∈ t` such that `(x, y) ∈ U`
  rcases adhs U U_mem with ⟨t, t_mem, ht, y, hxy, hy⟩,
  apply mem_of_superset t_mem,
  -- Given a point `z ∈ t`, we have `(x, y) ∈ U` and `(y, z) ∈ t × t ⊆ U`, hence `z ∈ s`
  exact (λ z hz, hU (prod_mk_mem_comp_rel hxy (ht $ mk_mem_prod hy hz)) rfl)
end

/-- If `x` is an adherent (cluster) point for a Cauchy filter `f`, then it is a limit point
for `f`. -/
lemma le_nhds_of_cauchy_adhp {f : filter α} {x : α} (hf : cauchy f)
  (adhs : cluster_pt x f) : f ≤ 𝓝 x :=
le_nhds_of_cauchy_adhp_aux
begin
  assume s hs,
  obtain ⟨t, t_mem, ht⟩ : ∃ t ∈ f, t ×ˢ t ⊆ s,
    from (cauchy_iff.1 hf).2 s hs,
  use [t, t_mem, ht],
  exact (forall_mem_nonempty_iff_ne_bot.2 adhs _
    (inter_mem_inf (mem_nhds_left x hs) t_mem ))
end

lemma le_nhds_iff_adhp_of_cauchy {f : filter α} {x : α} (hf : cauchy f) :
  f ≤ 𝓝 x ↔ cluster_pt x f :=
⟨assume h, cluster_pt.of_le_nhds' h hf.1, le_nhds_of_cauchy_adhp hf⟩

lemma cauchy.map [uniform_space β] {f : filter α} {m : α → β}
  (hf : cauchy f) (hm : uniform_continuous m) : cauchy (map m f) :=
⟨hf.1.map _,
  calc map m f ×ᶠ map m f = map (λp:α×α, (m p.1, m p.2)) (f ×ᶠ f) : filter.prod_map_map_eq
    ... ≤ map (λp:α×α, (m p.1, m p.2)) (𝓤 α) : map_mono hf.right
    ... ≤ 𝓤 β : hm⟩

lemma cauchy.comap [uniform_space β] {f : filter β} {m : α → β}
  (hf : cauchy f) (hm : comap (λp:α×α, (m p.1, m p.2)) (𝓤 β) ≤ 𝓤 α)
  [ne_bot (comap m f)] : cauchy (comap m f) :=
⟨‹_›,
  calc comap m f ×ᶠ comap m f = comap (λp:α×α, (m p.1, m p.2)) (f ×ᶠ f) : filter.prod_comap_comap_eq
    ... ≤ comap (λp:α×α, (m p.1, m p.2)) (𝓤 β) : comap_mono hf.right
    ... ≤ 𝓤 α : hm⟩

lemma cauchy.comap' [uniform_space β] {f : filter β} {m : α → β}
  (hf : cauchy f) (hm : comap (λp:α×α, (m p.1, m p.2)) (𝓤 β) ≤ 𝓤 α)
  (hb : ne_bot (comap m f)) : cauchy (comap m f) :=
hf.comap hm

/-- Cauchy sequences. Usually defined on ℕ, but often it is also useful to say that a function
defined on ℝ is Cauchy at +∞ to deduce convergence. Therefore, we define it in a type class that
is general enough to cover both ℕ and ℝ, which are the main motivating examples. -/
def cauchy_seq [semilattice_sup β] (u : β → α) := cauchy (at_top.map u)

lemma cauchy_seq.tendsto_uniformity [semilattice_sup β] {u : β → α} (h : cauchy_seq u) :
  tendsto (prod.map u u) at_top (𝓤 α) :=
by simpa only [tendsto, prod_map_map_eq', prod_at_top_at_top_eq] using h.right

lemma cauchy_seq.nonempty [semilattice_sup β] {u : β → α} (hu : cauchy_seq u) : nonempty β :=
@nonempty_of_ne_bot _ _ $ (map_ne_bot_iff _).1 hu.1

lemma cauchy_seq.mem_entourage {β : Type*} [semilattice_sup β] {u : β → α}
  (h : cauchy_seq u) {V : set (α × α)} (hV : V ∈ 𝓤 α) :
  ∃ k₀, ∀ i j, k₀ ≤ i → k₀ ≤ j → (u i, u j) ∈ V :=
begin
  haveI := h.nonempty,
  have := h.tendsto_uniformity, rw ← prod_at_top_at_top_eq at this,
  simpa [maps_to] using at_top_basis.prod_self.tendsto_left_iff.1 this V hV
end

lemma filter.tendsto.cauchy_seq [semilattice_sup β] [nonempty β] {f : β → α} {x}
  (hx : tendsto f at_top (𝓝 x)) :
  cauchy_seq f :=
hx.cauchy_map

lemma cauchy_seq_const [semilattice_sup β] [nonempty β] (x : α) : cauchy_seq (λ n : β, x) :=
tendsto_const_nhds.cauchy_seq

lemma cauchy_seq_iff_tendsto [nonempty β] [semilattice_sup β] {u : β → α} :
  cauchy_seq u ↔ tendsto (prod.map u u) at_top (𝓤 α) :=
cauchy_map_iff'.trans $ by simp only [prod_at_top_at_top_eq, prod.map_def]

lemma cauchy_seq.comp_tendsto {γ} [semilattice_sup β] [semilattice_sup γ] [nonempty γ]
  {f : β → α} (hf : cauchy_seq f) {g : γ → β} (hg : tendsto g at_top at_top) :
  cauchy_seq (f ∘ g) :=
cauchy_seq_iff_tendsto.2 $ hf.tendsto_uniformity.comp (hg.prod_at_top hg)

lemma cauchy_seq.comp_injective [semilattice_sup β] [no_max_order β] [nonempty β]
  {u : ℕ → α} (hu : cauchy_seq u) {f : β → ℕ} (hf : injective f) :
  cauchy_seq (u ∘ f) :=
hu.comp_tendsto $ nat.cofinite_eq_at_top ▸ hf.tendsto_cofinite.mono_left at_top_le_cofinite

lemma function.bijective.cauchy_seq_comp_iff {f : ℕ → ℕ} (hf : bijective f) (u : ℕ → α) :
  cauchy_seq (u ∘ f) ↔ cauchy_seq u :=
begin
  refine ⟨λ H, _, λ H, H.comp_injective hf.injective⟩,
  lift f to ℕ ≃ ℕ using hf,
  simpa only [(∘), f.apply_symm_apply] using H.comp_injective f.symm.injective
end

lemma cauchy_seq.subseq_subseq_mem {V : ℕ → set (α × α)} (hV : ∀ n, V n ∈ 𝓤 α)
  {u : ℕ → α} (hu : cauchy_seq u)
  {f g : ℕ → ℕ} (hf : tendsto f at_top at_top) (hg : tendsto g at_top at_top) :
  ∃ φ : ℕ → ℕ, strict_mono φ ∧ ∀ n, ((u ∘ f ∘ φ) n, (u ∘ g ∘ φ) n) ∈ V n :=
begin
  rw cauchy_seq_iff_tendsto at hu,
  exact ((hu.comp $ hf.prod_at_top hg).comp tendsto_at_top_diagonal).subseq_mem hV,
end

lemma cauchy_seq_iff' {u : ℕ → α} :
  cauchy_seq u ↔ ∀ V ∈ 𝓤 α, ∀ᶠ k in at_top, k ∈ (prod.map u u) ⁻¹' V :=
by simpa only [cauchy_seq_iff_tendsto]

lemma cauchy_seq_iff {u : ℕ → α} :
  cauchy_seq u ↔ ∀ V ∈ 𝓤 α, ∃ N, ∀ k ≥ N, ∀ l ≥ N, (u k, u l) ∈ V :=
by simp [cauchy_seq_iff', filter.eventually_at_top_prod_self', prod_map]

lemma cauchy_seq.prod_map {γ δ} [uniform_space β] [semilattice_sup γ] [semilattice_sup δ]
  {u : γ → α} {v : δ → β}
  (hu : cauchy_seq u) (hv : cauchy_seq v) : cauchy_seq (prod.map u v) :=
by simpa only [cauchy_seq, prod_map_map_eq', prod_at_top_at_top_eq] using hu.prod hv

lemma cauchy_seq.prod {γ} [uniform_space β] [semilattice_sup γ] {u : γ → α} {v : γ → β}
  (hu : cauchy_seq u) (hv : cauchy_seq v) : cauchy_seq (λ x, (u x, v x)) :=
begin
  haveI := hu.nonempty,
  exact (hu.prod hv).mono (tendsto.prod_mk le_rfl le_rfl)
end

lemma cauchy_seq.eventually_eventually [semilattice_sup β] {u : β → α} (hu : cauchy_seq u)
  {V : set (α × α)} (hV : V ∈ 𝓤 α) :
  ∀ᶠ k in at_top, ∀ᶠ l in at_top, (u k, u l) ∈ V :=
eventually_at_top_curry $ hu.tendsto_uniformity hV

lemma uniform_continuous.comp_cauchy_seq {γ} [uniform_space β] [semilattice_sup γ]
  {f : α → β} (hf : uniform_continuous f) {u : γ → α} (hu : cauchy_seq u) :
  cauchy_seq (f ∘ u) :=
hu.map hf

lemma cauchy_seq.subseq_mem {V : ℕ → set (α × α)} (hV : ∀ n, V n ∈ 𝓤 α)
  {u : ℕ → α} (hu : cauchy_seq u) :
  ∃ φ : ℕ → ℕ, strict_mono φ ∧ ∀ n, (u $ φ (n + 1), u $ φ n) ∈ V n :=
begin
  have : ∀ n, ∃ N, ∀ k ≥ N, ∀ l ≥ k, (u l, u k) ∈ V n,
  { intro n,
    rw [cauchy_seq_iff] at hu,
    rcases hu _ (hV n) with ⟨N, H⟩,
    exact ⟨N, λ k hk l hl, H _ (le_trans hk hl) _ hk ⟩ },
  obtain ⟨φ : ℕ → ℕ, φ_extr : strict_mono φ, hφ : ∀ n, ∀ l ≥ φ n, (u l, u $ φ n) ∈ V n⟩ :=
    extraction_forall_of_eventually' this,
  exact ⟨φ, φ_extr, λ n, hφ _ _ (φ_extr $ lt_add_one n).le⟩,
end

lemma filter.tendsto.subseq_mem_entourage {V : ℕ → set (α × α)} (hV : ∀ n, V n ∈ 𝓤 α)
  {u : ℕ → α} {a : α} (hu : tendsto u at_top (𝓝 a)) :
  ∃ φ : ℕ → ℕ, strict_mono φ ∧ (u (φ 0), a) ∈ V 0 ∧ ∀ n, (u $ φ (n + 1), u $ φ n) ∈ V (n + 1) :=
begin
  rcases mem_at_top_sets.1 (hu (ball_mem_nhds a (symm_le_uniformity $ hV 0))) with ⟨n, hn⟩,
  rcases (hu.comp (tendsto_add_at_top_nat n)).cauchy_seq.subseq_mem (λ n, hV (n + 1))
    with ⟨φ, φ_mono, hφV⟩,
  exact ⟨λ k, φ k + n, φ_mono.add_const _, hn _ le_add_self, hφV⟩
end

/-- If a Cauchy sequence has a convergent subsequence, then it converges. -/
lemma tendsto_nhds_of_cauchy_seq_of_subseq
  [semilattice_sup β] {u : β → α} (hu : cauchy_seq u)
  {ι : Type*} {f : ι → β} {p : filter ι} [ne_bot p]
  (hf : tendsto f p at_top) {a : α} (ha : tendsto (u ∘ f) p (𝓝 a)) :
  tendsto u at_top (𝓝 a) :=
le_nhds_of_cauchy_adhp hu (map_cluster_pt_of_comp hf ha)

@[nolint ge_or_gt] -- see Note [nolint_ge]
lemma filter.has_basis.cauchy_seq_iff {γ} [nonempty β] [semilattice_sup β] {u : β → α}
  {p : γ → Prop} {s : γ → set (α × α)} (h : (𝓤 α).has_basis p s) :
  cauchy_seq u ↔ ∀ i, p i → ∃N, ∀m n≥N, (u m, u n) ∈ s i :=
begin
  rw [cauchy_seq_iff_tendsto, ← prod_at_top_at_top_eq],
  refine (at_top_basis.prod_self.tendsto_iff h).trans _,
  simp only [exists_prop, true_and, maps_to, preimage, subset_def, prod.forall,
    mem_prod_eq, mem_set_of_eq, mem_Ici, and_imp, prod.map, ge_iff_le, @forall_swap (_ ≤ _) β]
end

lemma filter.has_basis.cauchy_seq_iff' {γ} [nonempty β] [semilattice_sup β] {u : β → α}
  {p : γ → Prop} {s : γ → set (α × α)} (H : (𝓤 α).has_basis p s) :
  cauchy_seq u ↔ ∀ i, p i → ∃N, ∀n≥N, (u n, u N) ∈ s i :=
begin
  refine H.cauchy_seq_iff.trans ⟨λ h i hi, _, λ h i hi, _⟩,
  { exact (h i hi).imp (λ N hN n hn, hN n hn N le_rfl) },
  { rcases comp_symm_of_uniformity (H.mem_of_mem hi) with ⟨t, ht, ht', hts⟩,
    rcases H.mem_iff.1 ht with ⟨j, hj, hjt⟩,
    refine (h j hj).imp (λ N hN m hm n hn, hts ⟨u N, hjt _, ht' $ hjt _⟩),
    { exact hN m hm },
    { exact hN n hn } }
end

lemma cauchy_seq_of_controlled [semilattice_sup β] [nonempty β]
  (U : β → set (α × α)) (hU : ∀ s ∈ 𝓤 α, ∃ n, U n ⊆ s)
  {f : β → α} (hf : ∀ {N m n : β}, N ≤ m → N ≤ n → (f m, f n) ∈ U N) :
  cauchy_seq f :=
cauchy_seq_iff_tendsto.2
begin
  assume s hs,
  rw [mem_map, mem_at_top_sets],
  cases hU s hs with N hN,
  refine ⟨(N, N), λ mn hmn, _⟩,
  cases mn with m n,
  exact hN (hf hmn.1 hmn.2)
end

lemma is_complete_iff_cluster_pt {s : set α} :
  is_complete s ↔ ∀ l, cauchy l → l ≤ 𝓟 s → ∃ x ∈ s, cluster_pt x l :=
forall₃_congr $ λ l hl hls, exists₂_congr $ λ x hx, le_nhds_iff_adhp_of_cauchy hl

lemma is_complete_iff_ultrafilter {s : set α} :
  is_complete s ↔ ∀ l : ultrafilter α, cauchy (l : filter α) → ↑l ≤ 𝓟 s → ∃ x ∈ s, ↑l ≤ 𝓝 x :=
begin
  refine ⟨λ h l, h l, λ H, is_complete_iff_cluster_pt.2 $ λ l hl hls, _⟩,
  haveI := hl.1,
  rcases H (ultrafilter.of l) hl.ultrafilter_of ((ultrafilter.of_le l).trans hls)
    with ⟨x, hxs, hxl⟩,
  exact ⟨x, hxs, (cluster_pt.of_le_nhds hxl).mono (ultrafilter.of_le l)⟩
end

lemma is_complete_iff_ultrafilter' {s : set α} :
  is_complete s ↔ ∀ l : ultrafilter α, cauchy (l : filter α) → s ∈ l → ∃ x ∈ s, ↑l ≤ 𝓝 x :=
is_complete_iff_ultrafilter.trans $ by simp only [le_principal_iff, ultrafilter.mem_coe]

protected lemma is_complete.union {s t : set α} (hs : is_complete s) (ht : is_complete t) :
  is_complete (s ∪ t) :=
begin
  simp only [is_complete_iff_ultrafilter', ultrafilter.union_mem_iff, or_imp_distrib] at *,
  exact λ l hl, ⟨λ hsl, (hs l hl hsl).imp $ λ x hx, ⟨or.inl hx.fst, hx.snd⟩,
    λ htl, (ht l hl htl).imp $ λ x hx, ⟨or.inr hx.fst, hx.snd⟩⟩
end

lemma is_complete_Union_separated {ι : Sort*} {s : ι → set α} (hs : ∀ i, is_complete (s i))
  {U : set (α × α)} (hU : U ∈ 𝓤 α) (hd : ∀ (i j : ι) (x ∈ s i) (y ∈ s j), (x, y) ∈ U → i = j) :
  is_complete (⋃ i, s i) :=
begin
  set S := ⋃ i, s i,
  intros l hl hls,
  rw le_principal_iff at hls,
  casesI cauchy_iff.1 hl with hl_ne hl',
  obtain ⟨t, htS, htl, htU⟩ : ∃ t ⊆ S, t ∈ l ∧ t ×ˢ t ⊆ U,
  { rcases hl' U hU with ⟨t, htl, htU⟩,
    exact ⟨t ∩ S, inter_subset_right _ _, inter_mem htl hls,
      (set.prod_mono (inter_subset_left _ _) (inter_subset_left _ _)).trans htU⟩ },
  obtain ⟨i, hi⟩ : ∃ i, t ⊆ s i,
  { rcases filter.nonempty_of_mem htl with ⟨x, hx⟩,
    rcases mem_Union.1 (htS hx) with ⟨i, hi⟩,
    refine ⟨i, λ y hy, _⟩,
    rcases mem_Union.1 (htS hy) with ⟨j, hj⟩,
    convert hj, exact hd i j x hi y hj (htU $ mk_mem_prod hx hy) },
  rcases hs i l hl (le_principal_iff.2 $ mem_of_superset htl hi) with ⟨x, hxs, hlx⟩,
  exact ⟨x, mem_Union.2 ⟨i, hxs⟩, hlx⟩
end

/-- A complete space is defined here using uniformities. A uniform space
  is complete if every Cauchy filter converges. -/
class complete_space (α : Type u) [uniform_space α] : Prop :=
(complete : ∀{f:filter α}, cauchy f → ∃x, f ≤ 𝓝 x)

lemma complete_univ {α : Type u} [uniform_space α] [complete_space α] :
  is_complete (univ : set α) :=
begin
  assume f hf _,
  rcases complete_space.complete hf with ⟨x, hx⟩,
  exact ⟨x, mem_univ x, hx⟩
end

instance complete_space.prod [uniform_space β] [complete_space α] [complete_space β] :
  complete_space (α × β) :=
{ complete := λ f hf,
    let ⟨x1, hx1⟩ := complete_space.complete $ hf.map uniform_continuous_fst in
    let ⟨x2, hx2⟩ := complete_space.complete $ hf.map uniform_continuous_snd in
    ⟨(x1, x2), by rw [nhds_prod_eq, filter.prod_def];
      from filter.le_lift.2 (λ s hs, filter.le_lift'.2 $ λ t ht,
        inter_mem (hx1 hs) (hx2 ht))⟩ }

@[to_additive]
instance complete_space.mul_opposite [complete_space α] : complete_space αᵐᵒᵖ :=
{ complete := λ f hf, mul_opposite.op_surjective.exists.mpr $
    let ⟨x, hx⟩ := complete_space.complete (hf.map mul_opposite.uniform_continuous_unop) in
    ⟨x, (map_le_iff_le_comap.mp hx).trans_eq $ mul_opposite.comap_unop_nhds _⟩}

/--If `univ` is complete, the space is a complete space -/
lemma complete_space_of_is_complete_univ (h : is_complete (univ : set α)) : complete_space α :=
⟨λ f hf, let ⟨x, _, hx⟩ := h f hf ((@principal_univ α).symm ▸ le_top) in ⟨x, hx⟩⟩

lemma complete_space_iff_is_complete_univ :
  complete_space α ↔ is_complete (univ : set α) :=
⟨@complete_univ α _, complete_space_of_is_complete_univ⟩

lemma complete_space_iff_ultrafilter :
  complete_space α ↔ ∀ l : ultrafilter α, cauchy (l : filter α) → ∃ x : α, ↑l ≤ 𝓝 x :=
by simp [complete_space_iff_is_complete_univ, is_complete_iff_ultrafilter]

lemma cauchy_iff_exists_le_nhds [complete_space α] {l : filter α} [ne_bot l] :
  cauchy l ↔ (∃x, l ≤ 𝓝 x) :=
⟨complete_space.complete, assume ⟨x, hx⟩, cauchy_nhds.mono hx⟩

lemma cauchy_map_iff_exists_tendsto [complete_space α] {l : filter β} {f : β → α} [ne_bot l] :
  cauchy (l.map f) ↔ (∃x, tendsto f l (𝓝 x)) :=
cauchy_iff_exists_le_nhds

/-- A Cauchy sequence in a complete space converges -/
theorem cauchy_seq_tendsto_of_complete [semilattice_sup β] [complete_space α]
  {u : β → α} (H : cauchy_seq u) : ∃x, tendsto u at_top (𝓝 x) :=
complete_space.complete H

/-- If `K` is a complete subset, then any cauchy sequence in `K` converges to a point in `K` -/
lemma cauchy_seq_tendsto_of_is_complete [semilattice_sup β] {K : set α} (h₁ : is_complete K)
  {u : β → α} (h₂ : ∀ n, u n ∈ K) (h₃ : cauchy_seq u) : ∃ v ∈ K, tendsto u at_top (𝓝 v) :=
h₁ _ h₃ $ le_principal_iff.2 $ mem_map_iff_exists_image.2 ⟨univ, univ_mem,
  by { simp only [image_univ], rintros _ ⟨n, rfl⟩, exact h₂ n }⟩

theorem cauchy.le_nhds_Lim [complete_space α] [nonempty α] {f : filter α} (hf : cauchy f) :
  f ≤ 𝓝 (Lim f) :=
le_nhds_Lim (complete_space.complete hf)

theorem cauchy_seq.tendsto_lim [semilattice_sup β] [complete_space α] [nonempty α] {u : β → α}
  (h : cauchy_seq u) :
  tendsto u at_top (𝓝 $ lim at_top u) :=
h.le_nhds_Lim

lemma is_closed.is_complete [complete_space α] {s : set α}
  (h : is_closed s) : is_complete s :=
λ f cf fs, let ⟨x, hx⟩ := complete_space.complete cf in
⟨x, is_closed_iff_cluster_pt.mp h x (cf.left.mono (le_inf hx fs)), hx⟩

/-- A set `s` is totally bounded if for every entourage `d` there is a finite
  set of points `t` such that every element of `s` is `d`-near to some element of `t`. -/
def totally_bounded (s : set α) : Prop :=
∀d ∈ 𝓤 α, ∃t : set α, t.finite ∧ s ⊆ (⋃ y ∈ t, {x | (x, y) ∈ d})

theorem totally_bounded.exists_subset {s : set α} (hs : totally_bounded s) {U : set (α × α)}
  (hU : U ∈ 𝓤 α) :
  ∃ t ⊆ s, set.finite t ∧ s ⊆ ⋃ y ∈ t, {x | (x, y) ∈ U} :=
begin
  rcases comp_symm_of_uniformity hU with ⟨r, hr, rs, rU⟩,
  rcases hs r hr with ⟨k, fk, ks⟩,
  let u := k ∩ {y | ∃ x ∈ s, (x, y) ∈ r},
  choose hk f hfs hfr using λ x : u, x.coe_prop,
  refine ⟨range f, _, _, _⟩,
  { exact range_subset_iff.2 hfs },
  { haveI : fintype u := (fk.inter_of_left _).fintype,
    exact finite_range f },
  { intros x xs,
    obtain ⟨y, hy, xy⟩ : ∃ y ∈ k, (x, y) ∈ r, from mem_Union₂.1 (ks xs),
    rw [bUnion_range, mem_Union],
    set z : ↥u := ⟨y, hy, ⟨x, xs, xy⟩⟩,
    exact ⟨z, rU $ mem_comp_rel.2 ⟨y, xy, rs (hfr z)⟩⟩ }
end

theorem totally_bounded_iff_subset {s : set α} : totally_bounded s ↔
  ∀d ∈ 𝓤 α, ∃t ⊆ s, set.finite t ∧ s ⊆ (⋃y∈t, {x | (x,y) ∈ d}) :=
⟨λ H d hd, H.exists_subset hd, λ H d hd, let ⟨t, _, ht⟩ := H d hd in ⟨t, ht⟩⟩

lemma filter.has_basis.totally_bounded_iff {ι} {p : ι → Prop} {U : ι → set (α × α)}
  (H : (𝓤 α).has_basis p U) {s : set α} :
  totally_bounded s ↔ ∀ i, p i → ∃ t : set α, set.finite t ∧ s ⊆ ⋃ y ∈ t, {x | (x, y) ∈ U i} :=
H.forall_iff $ λ U V hUV h, h.imp $ λ t ht, ⟨ht.1, ht.2.trans $ Union₂_mono $ λ x hx y hy, hUV hy⟩

lemma totally_bounded_of_forall_symm {s : set α}
  (h : ∀ V ∈ 𝓤 α, symmetric_rel V → ∃ t : set α, set.finite t ∧ s ⊆ ⋃ y ∈ t, ball y V) :
  totally_bounded s :=
uniform_space.has_basis_symmetric.totally_bounded_iff.2 $ λ V hV,
  by simpa only [ball_eq_of_symmetry hV.2] using h V hV.1 hV.2

lemma totally_bounded_subset {s₁ s₂ : set α} (hs : s₁ ⊆ s₂)
  (h : totally_bounded s₂) : totally_bounded s₁ :=
assume d hd, let ⟨t, ht₁, ht₂⟩ := h d hd in ⟨t, ht₁, subset.trans hs ht₂⟩

lemma totally_bounded_empty : totally_bounded (∅ : set α) :=
λ d hd, ⟨∅, finite_empty, empty_subset _⟩

/-- The closure of a totally bounded set is totally bounded. -/
lemma totally_bounded.closure {s : set α} (h : totally_bounded s) :
  totally_bounded (closure s) :=
uniformity_has_basis_closed.totally_bounded_iff.2 $ λ V hV, let ⟨t, htf, hst⟩ := h V hV.1
  in ⟨t, htf, closure_minimal hst $ is_closed_bUnion htf $
    λ y hy, hV.2.preimage (continuous_id.prod_mk continuous_const)⟩

/-- The image of a totally bounded set under a uniformly continuous map is totally bounded. -/
lemma totally_bounded.image [uniform_space β] {f : α → β} {s : set α}
  (hs : totally_bounded s) (hf : uniform_continuous f) : totally_bounded (f '' s) :=
assume t ht,
have {p:α×α | (f p.1, f p.2) ∈ t} ∈ 𝓤 α,
  from hf ht,
let ⟨c, hfc, hct⟩ := hs _ this in
⟨f '' c, hfc.image f,
  begin
    simp [image_subset_iff],
    simp [subset_def] at hct,
    intros x hx, simp,
    exact hct x hx
  end⟩

lemma ultrafilter.cauchy_of_totally_bounded {s : set α} (f : ultrafilter α)
  (hs : totally_bounded s) (h : ↑f ≤ 𝓟 s) : cauchy (f : filter α) :=
⟨f.ne_bot', assume t ht,
  let ⟨t', ht'₁, ht'_symm, ht'_t⟩ := comp_symm_of_uniformity ht in
  let ⟨i, hi, hs_union⟩ := hs t' ht'₁ in
  have (⋃y∈i, {x | (x,y) ∈ t'}) ∈ f,
    from mem_of_superset (le_principal_iff.mp h) hs_union,
  have ∃y∈i, {x | (x,y) ∈ t'} ∈ f,
    from (ultrafilter.finite_bUnion_mem_iff hi).1 this,
  let ⟨y, hy, hif⟩ := this in
  have {x | (x,y) ∈ t'} ×ˢ {x | (x,y) ∈ t'} ⊆ comp_rel t' t',
    from assume ⟨x₁, x₂⟩ ⟨(h₁ : (x₁, y) ∈ t'), (h₂ : (x₂, y) ∈ t')⟩,
      ⟨y, h₁, ht'_symm h₂⟩,
  mem_of_superset (prod_mem_prod hif hif) (subset.trans this ht'_t)⟩

lemma totally_bounded_iff_filter {s : set α} :
  totally_bounded s ↔ (∀f, ne_bot f → f ≤ 𝓟 s → ∃c ≤ f, cauchy c) :=
begin
  split,
  { introsI H f hf hfs,
    exact ⟨ultrafilter.of f, ultrafilter.of_le f,
      (ultrafilter.of f).cauchy_of_totally_bounded H ((ultrafilter.of_le f).trans hfs)⟩ },
  { intros H d hd,
    contrapose! H with hd_cover,
    set f := ⨅ t : finset α, 𝓟 (s \ ⋃ y ∈ t, {x | (x, y) ∈ d}),
    have : ne_bot f,
    { refine infi_ne_bot_of_directed' (directed_of_sup _) _,
      { intros t₁ t₂ h,
        exact principal_mono.2 (diff_subset_diff_right $ bUnion_subset_bUnion_left h) },
      { intro t,
        simpa [nonempty_diff] using hd_cover t t.finite_to_set } },
    have : f ≤ 𝓟 s, from infi_le_of_le ∅ (by simp),
    refine ⟨f, ‹_›, ‹_›, λ c hcf hc, _⟩,
    rcases mem_prod_same_iff.1 (hc.2 hd) with ⟨m, hm, hmd⟩,
    have : m ∩ s ∈ c, from inter_mem hm (le_principal_iff.mp (hcf.trans ‹_›)),
    rcases hc.1.nonempty_of_mem this with ⟨y, hym, hys⟩,
    set ys := ⋃ y' ∈ ({y} : finset α), {x | (x, y') ∈ d},
    have : m ⊆ ys, by simpa [ys] using λ x hx, hmd (mk_mem_prod hx hym),
    have : c ≤ 𝓟 (s \ ys) := hcf.trans (infi_le_of_le {y} le_rfl),
    refine hc.1.ne (empty_mem_iff_bot.mp _),
    filter_upwards [le_principal_iff.1 this, hm],
    refine λ x hx hxm, hx.2 _,
    simpa [ys] using hmd (mk_mem_prod hxm hym) }
end

lemma totally_bounded_iff_ultrafilter {s : set α} :
  totally_bounded s ↔ (∀f : ultrafilter α, ↑f ≤ 𝓟 s → cauchy (f : filter α)) :=
begin
  refine ⟨λ hs f, f.cauchy_of_totally_bounded hs, λ H, totally_bounded_iff_filter.2 _⟩,
  introsI f hf hfs,
  exact ⟨ultrafilter.of f, ultrafilter.of_le f, H _ ((ultrafilter.of_le f).trans hfs)⟩
end

lemma is_compact_iff_totally_bounded_is_complete {s : set α} :
  is_compact s ↔ totally_bounded s ∧ is_complete s :=
⟨λ hs, ⟨totally_bounded_iff_ultrafilter.2 (λ f hf,
    let ⟨x, xs, fx⟩ := is_compact_iff_ultrafilter_le_nhds.1 hs f hf in cauchy_nhds.mono fx),
  λ f fc fs,
    let ⟨a, as, fa⟩ := @hs f fc.1 fs in
    ⟨a, as, le_nhds_of_cauchy_adhp fc fa⟩⟩,
 λ ⟨ht, hc⟩, is_compact_iff_ultrafilter_le_nhds.2
   (λf hf, hc _ (totally_bounded_iff_ultrafilter.1 ht f hf) hf)⟩

protected lemma is_compact.totally_bounded {s : set α} (h : is_compact s) : totally_bounded s :=
(is_compact_iff_totally_bounded_is_complete.1 h).1

protected lemma is_compact.is_complete {s : set α} (h : is_compact s) : is_complete s :=
(is_compact_iff_totally_bounded_is_complete.1 h).2

@[priority 100] -- see Note [lower instance priority]
instance complete_of_compact {α : Type u} [uniform_space α] [compact_space α] : complete_space α :=
⟨λf hf, by simpa using (is_compact_iff_totally_bounded_is_complete.1 is_compact_univ).2 f hf⟩

lemma is_compact_of_totally_bounded_is_closed [complete_space α] {s : set α}
  (ht : totally_bounded s) (hc : is_closed s) : is_compact s :=
(@is_compact_iff_totally_bounded_is_complete α _ s).2 ⟨ht, hc.is_complete⟩

/-- Every Cauchy sequence over `ℕ` is totally bounded. -/
lemma cauchy_seq.totally_bounded_range {s : ℕ → α} (hs : cauchy_seq s) :
  totally_bounded (range s) :=
begin
  refine totally_bounded_iff_subset.2 (λ a ha, _),
  cases cauchy_seq_iff.1 hs a ha with n hn,
  refine ⟨s '' {k | k ≤ n}, image_subset_range _ _, (finite_le_nat _).image _, _⟩,
  rw [range_subset_iff, bUnion_image],
  intro m,
  rw [mem_Union₂],
  cases le_total m n with hm hm,
  exacts [⟨m, hm, refl_mem_uniformity ha⟩, ⟨n, le_refl n, hn m hm n le_rfl⟩]
end

/-!
### Sequentially complete space

In this section we prove that a uniform space is complete provided that it is sequentially complete
(i.e., any Cauchy sequence converges) and its uniformity filter admits a countable generating set.
In particular, this applies to (e)metric spaces, see the files `topology/metric_space/emetric_space`
and `topology/metric_space/basic`.

More precisely, we assume that there is a sequence of entourages `U_n` such that any other
entourage includes one of `U_n`. Then any Cauchy filter `f` generates a decreasing sequence of
sets `s_n ∈ f` such that `s_n × s_n ⊆ U_n`. Choose a sequence `x_n∈s_n`. It is easy to show
that this is a Cauchy sequence. If this sequence converges to some `a`, then `f ≤ 𝓝 a`. -/

namespace sequentially_complete

variables {f : filter α} (hf : cauchy f) {U : ℕ → set (α × α)}
  (U_mem : ∀ n, U n ∈ 𝓤 α) (U_le : ∀ s ∈ 𝓤 α, ∃ n, U n ⊆ s)

open set finset

noncomputable theory

/-- An auxiliary sequence of sets approximating a Cauchy filter. -/
def set_seq_aux (n : ℕ) : {s : set α // ∃ (_ : s ∈ f), s ×ˢ s ⊆ U n } :=
indefinite_description _ $ (cauchy_iff.1 hf).2 (U n) (U_mem n)

/-- Given a Cauchy filter `f` and a sequence `U` of entourages, `set_seq` provides
an antitone sequence of sets `s n ∈ f` such that `s n ×ˢ s n ⊆ U`. -/
def set_seq (n : ℕ) : set α :=  ⋂ m ∈ set.Iic n, (set_seq_aux hf U_mem m).val

lemma set_seq_mem (n : ℕ) : set_seq hf U_mem n ∈ f :=
(bInter_mem (finite_le_nat n)).2 (λ m _, (set_seq_aux hf U_mem m).2.fst)

lemma set_seq_mono ⦃m n : ℕ⦄ (h : m ≤ n) : set_seq hf U_mem n ⊆ set_seq hf U_mem m :=
bInter_subset_bInter_left (λ k hk, le_trans hk h)

lemma set_seq_sub_aux (n : ℕ) : set_seq hf U_mem n ⊆ set_seq_aux hf U_mem n :=
bInter_subset_of_mem right_mem_Iic

lemma set_seq_prod_subset {N m n} (hm : N ≤ m) (hn : N ≤ n) :
  set_seq hf U_mem m ×ˢ set_seq hf U_mem n ⊆ U N :=
begin
  assume p hp,
  refine (set_seq_aux hf U_mem N).2.snd ⟨_, _⟩;
    apply set_seq_sub_aux,
  exact set_seq_mono hf U_mem hm hp.1,
  exact set_seq_mono hf U_mem hn hp.2
end

/-- A sequence of points such that `seq n ∈ set_seq n`. Here `set_seq` is an antitone
sequence of sets `set_seq n ∈ f` with diameters controlled by a given sequence
of entourages. -/
def seq (n : ℕ) : α := some $ hf.1.nonempty_of_mem (set_seq_mem hf U_mem n)

lemma seq_mem (n : ℕ) : seq hf U_mem n ∈ set_seq hf U_mem n :=
some_spec $ hf.1.nonempty_of_mem (set_seq_mem hf U_mem n)

lemma seq_pair_mem ⦃N m n : ℕ⦄ (hm : N ≤ m) (hn : N ≤ n) :
  (seq hf U_mem m, seq hf U_mem n) ∈ U N :=
set_seq_prod_subset hf U_mem hm hn ⟨seq_mem hf U_mem m, seq_mem hf U_mem n⟩

include U_le

theorem seq_is_cauchy_seq : cauchy_seq $ seq hf U_mem :=
cauchy_seq_of_controlled U U_le $ seq_pair_mem hf U_mem

/-- If the sequence `sequentially_complete.seq` converges to `a`, then `f ≤ 𝓝 a`. -/
theorem le_nhds_of_seq_tendsto_nhds ⦃a : α⦄ (ha : tendsto (seq hf U_mem) at_top (𝓝 a)) :
  f ≤ 𝓝 a :=
le_nhds_of_cauchy_adhp_aux
begin
  assume s hs,
  rcases U_le s hs with ⟨m, hm⟩,
  rcases tendsto_at_top'.1 ha _ (mem_nhds_left a (U_mem m)) with ⟨n, hn⟩,
  refine ⟨set_seq hf U_mem (max m n), set_seq_mem hf U_mem _, _,
          seq hf U_mem (max m n), _, seq_mem hf U_mem _⟩,
  { have := le_max_left m n,
    exact set.subset.trans (set_seq_prod_subset hf U_mem this this) hm },
  { exact hm (hn _ $ le_max_right m n) }
end

end sequentially_complete

namespace uniform_space

open sequentially_complete

variables [is_countably_generated (𝓤 α)]

/-- A uniform space is complete provided that (a) its uniformity filter has a countable basis;
(b) any sequence satisfying a "controlled" version of the Cauchy condition converges. -/
theorem complete_of_convergent_controlled_sequences (U : ℕ → set (α × α)) (U_mem : ∀ n, U n ∈ 𝓤 α)
  (HU : ∀ u : ℕ → α, (∀ N m n, N ≤ m → N ≤ n → (u m, u n) ∈ U N) → ∃ a, tendsto u at_top (𝓝 a)) :
  complete_space α :=
begin
  obtain ⟨U', U'_mono, hU'⟩ := (𝓤 α).exists_antitone_seq,
  have Hmem : ∀ n, U n ∩ U' n ∈ 𝓤 α,
    from λ n, inter_mem (U_mem n) (hU'.2 ⟨n, subset.refl _⟩),
  refine ⟨λ f hf, (HU (seq hf Hmem) (λ N m n hm hn, _)).imp $
    le_nhds_of_seq_tendsto_nhds _ _ (λ s hs, _)⟩,
  { rcases (hU'.1 hs) with ⟨N, hN⟩,
    exact ⟨N, subset.trans (inter_subset_right _ _) hN⟩ },
  { exact inter_subset_left _ _ (seq_pair_mem hf Hmem hm hn) }
end

/-- A sequentially complete uniform space with a countable basis of the uniformity filter is
complete. -/
theorem complete_of_cauchy_seq_tendsto
  (H' : ∀ u : ℕ → α, cauchy_seq u → ∃a, tendsto u at_top (𝓝 a)) :
  complete_space α :=
let ⟨U', U'_mono, hU'⟩ := (𝓤 α).exists_antitone_seq in
complete_of_convergent_controlled_sequences U' (λ n, hU'.2 ⟨n, subset.refl _⟩)
  (λ u hu, H' u $ cauchy_seq_of_controlled U' (λ s hs, hU'.1 hs) hu)

variable (α)

@[priority 100]
instance first_countable_topology : first_countable_topology α :=
⟨λ a, by { rw nhds_eq_comap_uniformity, apply_instance }⟩

/-- A separable uniform space with countably generated uniformity filter is second countable:
one obtains a countable basis by taking the balls centered at points in a dense subset,
and with rational "radii" from a countable open symmetric antitone basis of `𝓤 α`. We do not
register this as an instance, as there is already an instance going in the other direction
from second countable spaces to separable spaces, and we want to avoid loops. -/
lemma second_countable_of_separable [separable_space α] : second_countable_topology α :=
begin
  rcases exists_countable_dense α with ⟨s, hsc, hsd⟩,
  obtain ⟨t : ℕ → set (α × α),
    hto : ∀ (i : ℕ), t i ∈ (𝓤 α).sets ∧ is_open (t i) ∧ symmetric_rel (t i),
      h_basis : (𝓤 α).has_antitone_basis t⟩ :=
    (@uniformity_has_basis_open_symmetric α _).exists_antitone_subbasis,
  choose ht_mem hto hts using hto,
  refine ⟨⟨⋃ (x ∈ s), range (λ k, ball x (t k)), hsc.bUnion (λ x hx, countable_range _), _⟩⟩,
  refine (is_topological_basis_of_open_of_nhds _ _).eq_generate_from,
  { simp only [mem_Union₂, mem_range],
    rintros _ ⟨x, hxs, k, rfl⟩,
    exact is_open_ball x (hto k) },
  { intros x V hxV hVo,
    simp only [mem_Union₂, mem_range, exists_prop],
    rcases uniform_space.mem_nhds_iff.1 (is_open.mem_nhds hVo hxV) with ⟨U, hU, hUV⟩,
    rcases comp_symm_of_uniformity hU with ⟨U', hU', hsymm, hUU'⟩,
    rcases h_basis.to_has_basis.mem_iff.1 hU' with ⟨k, -, hk⟩,
    rcases hsd.inter_open_nonempty (ball x $ t k) (is_open_ball x (hto k))
      ⟨x, uniform_space.mem_ball_self _ (ht_mem k)⟩ with ⟨y, hxy, hys⟩,
    refine ⟨_, ⟨y, hys, k, rfl⟩, (hts k).subset hxy, λ z hz, _⟩,
    exact hUV (ball_subset_of_comp_subset (hk hxy) hUU' (hk hz)) }
end

end uniform_space


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison, Adam Topaz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.sheaves.sheaf_of_functions
import Mathlib.topology.sheaves.stalks
import Mathlib.PostPort

universes v l

namespace Mathlib

/-!
# Functions satisfying a local predicate form a sheaf.

At this stage, in `topology/sheaves/sheaf_of_functions.lean`
we've proved that not-necessarily-continuous functions from a topological space
into some type (or type family) form a sheaf.

Why do the continuous functions form a sheaf?
The point is just that continuity is a local condition,
so one can use the lifting condition for functions to provide a candidate lift,
then verify that the lift is actually continuous by using the factorisation condition for the lift
(which guarantees that on each open set it agrees with the functions being lifted,
which were assumed to be continuous).

This file abstracts this argument to work for
any collection of dependent functions on a topological space
satisfying a "local predicate".

As an application, we check that continuity is a local predicate in this sense, and provide
* `Top.sheaf_condition.to_Top`: continuous functions into a topological space form a sheaf

A sheaf constructed in this way has a natural map `stalk_to_fiber` from the stalks
to the types in the ambient type family.

We give conditions sufficient to show that this map is injective and/or surjective.
-/

namespace Top

/--
Given a topological space `X : Top` and a type family `T : X → Type`,
a `P : prelocal_predicate T` consists of:
* a family of predicates `P.pred`, one for each `U : opens X`, of the form `(Π x : U, T x) → Prop`
* a proof that if `f : Π x : V, T x` satisfies the predicate on `V : opens X`, then
  the restriction of `f` to any open subset `U` also satisfies the predicate.
-/
structure prelocal_predicate {X : Top} (T : ↥X → Type v)
where
  pred : {U : topological_space.opens ↥X} → ((x : ↥U) → T ↑x) → Prop
  res : ∀ {U V : topological_space.opens ↥X} (i : U ⟶ V) (f : (x : ↥V) → T ↑x), pred f → pred fun (x : ↥U) => f (coe_fn i x)

/--
Continuity is a "prelocal" predicate on functions to a fixed topological space `T`.
-/
@[simp] theorem continuous_prelocal_pred (X : Top) (T : Top) (U : topological_space.opens ↥X) (f : ↥U → ↥T) : prelocal_predicate.pred (continuous_prelocal X T) f = continuous f :=
  Eq.refl (prelocal_predicate.pred (continuous_prelocal X T) f)

/-- Satisfying the inhabited linter. -/
protected instance inhabited_prelocal_predicate (X : Top) (T : Top) : Inhabited (prelocal_predicate fun (x : ↥X) => ↥T) :=
  { default := continuous_prelocal X T }

/--
Given a topological space `X : Top` and a type family `T : X → Type`,
a `P : local_predicate T` consists of:
* a family of predicates `P.pred`, one for each `U : opens X`, of the form `(Π x : U, T x) → Prop`
* a proof that if `f : Π x : V, T x` satisfies the predicate on `V : opens X`, then
  the restriction of `f` to any open subset `U` also satisfies the predicate, and
* a proof that given some `f : Π x : U, T x`,
  if for every `x : U` we can find an open set `x ∈ V ≤ U`
  so that the restriction of `f` to `V` satisfies the predicate,
  then `f` itself satisfies the predicate.
-/
structure local_predicate {X : Top} (T : ↥X → Type v)
extends prelocal_predicate T
where
  locality : ∀ {U : topological_space.opens ↥X} (f : (x : ↥U) → T ↑x),
  (∀ (x : ↥U),
      ∃ (V : topological_space.opens ↥X),
        ∃ (m : subtype.val x ∈ V),
          ∃ (i : V ⟶ U), prelocal_predicate.pred _to_prelocal_predicate fun (x : ↥V) => f (coe_fn i x)) →
    prelocal_predicate.pred _to_prelocal_predicate f

/--
Continuity is a "local" predicate on functions to a fixed topological space `T`.
-/
def continuous_local (X : Top) (T : Top) : local_predicate fun (x : ↥X) => ↥T :=
  local_predicate.mk (prelocal_predicate.mk (prelocal_predicate.pred (continuous_prelocal X T)) sorry) sorry

/-- Satisfying the inhabited linter. -/
protected instance inhabited_local_predicate (X : Top) (T : Top) : Inhabited (local_predicate fun (x : ↥X) => ↥T) :=
  { default := continuous_local X T }

/--
Given a `P : prelocal_predicate`, we can always construct a `local_predicate`
by asking that the condition from `P` holds locally near every point.
-/
def prelocal_predicate.sheafify {X : Top} {T : ↥X → Type v} (P : prelocal_predicate T) : local_predicate T :=
  local_predicate.mk
    (prelocal_predicate.mk
      (fun (U : topological_space.opens ↥X) (f : (x : ↥U) → T ↑x) =>
        ∀ (x : ↥U),
          ∃ (V : topological_space.opens ↥X),
            ∃ (m : subtype.val x ∈ V), ∃ (i : V ⟶ U), prelocal_predicate.pred P fun (x : ↥V) => f (coe_fn i x))
      sorry)
    sorry

theorem prelocal_predicate.sheafify_of {X : Top} {T : ↥X → Type v} {P : prelocal_predicate T} {U : topological_space.opens ↥X} {f : (x : ↥U) → T ↑x} (h : prelocal_predicate.pred P f) : prelocal_predicate.pred (local_predicate.to_prelocal_predicate (prelocal_predicate.sheafify P)) f := sorry

/--
The subpresheaf of dependent functions on `X` satisfying the "pre-local" predicate `P`.
-/
def subpresheaf_to_Types {X : Top} {T : ↥X → Type v} (P : prelocal_predicate T) : presheaf (Type v) X :=
  category_theory.functor.mk
    (fun (U : topological_space.opens ↥Xᵒᵖ) =>
      Subtype fun (f : (x : ↥(opposite.unop U)) → T ↑x) => prelocal_predicate.pred P f)
    fun (U V : topological_space.opens ↥Xᵒᵖ) (i : U ⟶ V)
      (f : Subtype fun (f : (x : ↥(opposite.unop U)) → T ↑x) => prelocal_predicate.pred P f) =>
      { val := fun (x : ↥(opposite.unop V)) => subtype.val f (coe_fn (category_theory.has_hom.hom.unop i) x),
        property := sorry }

namespace subpresheaf_to_Types

/--
The natural transformation including the subpresheaf of functions satisfying a local predicate
into the presheaf of all functions.
-/
def subtype {X : Top} {T : ↥X → Type v} (P : prelocal_predicate T) : subpresheaf_to_Types P ⟶ presheaf_to_Types X T :=
  category_theory.nat_trans.mk
    fun (U : topological_space.opens ↥Xᵒᵖ) (f : category_theory.functor.obj (subpresheaf_to_Types P) U) => subtype.val f

/--
The natural transformation
from the sheaf condition diagram for functions satisfying a local predicate
to the sheaf condition diagram for arbitrary functions,
given by forgetting that the local predicate holds.
-/
def diagram_subtype {X : Top} {T : ↥X → Type v} (P : prelocal_predicate T) {ι : Type v} (U : ι → topological_space.opens ↥X) : presheaf.sheaf_condition_equalizer_products.diagram (subpresheaf_to_Types P) U ⟶
  presheaf.sheaf_condition_equalizer_products.diagram (presheaf_to_Types X T) U :=
  category_theory.nat_trans.mk
    fun (j : category_theory.limits.walking_parallel_pair) =>
      category_theory.limits.walking_parallel_pair.rec_on j
        (category_theory.limits.pi.map
          fun (i : ι) (f : category_theory.functor.obj (subpresheaf_to_Types P) (opposite.op (U i))) => subtype.val f)
        (category_theory.limits.pi.map
          fun (p : ι × ι)
            (f : category_theory.functor.obj (subpresheaf_to_Types P) (opposite.op (U (prod.fst p) ⊓ U (prod.snd p)))) =>
            subtype.val f)

-- auxilliary lemma for `sheaf_condition` below

theorem sheaf_condition_fac {X : Top} {T : ↥X → Type v} {P : local_predicate T} {ι : Type v} {U : ι → topological_space.opens ↥X} {s : category_theory.limits.fork
  (presheaf.sheaf_condition_equalizer_products.left_res (subpresheaf_to_Types (local_predicate.to_prelocal_predicate P))
    U)
  (presheaf.sheaf_condition_equalizer_products.right_res
    (subpresheaf_to_Types (local_predicate.to_prelocal_predicate P)) U)} (i : ι) (f : category_theory.limits.cone.X s) (h : prelocal_predicate.pred (local_predicate.to_prelocal_predicate P)
  (category_theory.limits.is_limit.lift (presheaf.to_Types X T U)
    (category_theory.functor.obj
      (category_theory.limits.cones.postcompose (diagram_subtype (local_predicate.to_prelocal_predicate P) U)) s)
    f)) : category_theory.limits.limit.π
    (category_theory.discrete.functor
      fun (i : ι) =>
        Subtype
          fun (f : (x : ↥(opposite.unop (opposite.op (U i)))) → T ↑x) =>
            prelocal_predicate.pred (local_predicate.to_prelocal_predicate P) f)
    i
    (presheaf.sheaf_condition_equalizer_products.res (subpresheaf_to_Types (local_predicate.to_prelocal_predicate P)) U
      { val :=
          category_theory.limits.is_limit.lift (presheaf.to_Types X T U)
            (category_theory.functor.obj
              (category_theory.limits.cones.postcompose (diagram_subtype (local_predicate.to_prelocal_predicate P) U))
              s)
            f,
        property := h }) =
  category_theory.limits.limit.π
    (category_theory.discrete.functor
      fun (i : ι) =>
        Subtype
          fun (f : (x : ↥(opposite.unop (opposite.op (U i)))) → T ↑x) =>
            prelocal_predicate.pred (local_predicate.to_prelocal_predicate P) f)
    i (category_theory.limits.fork.ι s f) := sorry

-- auxilliary lemma for `sheaf_condition` below

theorem sheaf_condition_uniq {X : Top} {T : ↥X → Type v} {P : local_predicate T} {ι : Type v} {U : ι → topological_space.opens ↥X} {s : category_theory.limits.fork
  (presheaf.sheaf_condition_equalizer_products.left_res (subpresheaf_to_Types (local_predicate.to_prelocal_predicate P))
    U)
  (presheaf.sheaf_condition_equalizer_products.right_res
    (subpresheaf_to_Types (local_predicate.to_prelocal_predicate P)) U)} (m : category_theory.limits.cone.X s ⟶
  category_theory.limits.cone.X
    (presheaf.sheaf_condition_equalizer_products.fork (subpresheaf_to_Types (local_predicate.to_prelocal_predicate P))
      U)) (w : ∀ (j : category_theory.limits.walking_parallel_pair),
  m ≫
      category_theory.nat_trans.app
        (category_theory.limits.cone.π
          (presheaf.sheaf_condition_equalizer_products.fork
            (subpresheaf_to_Types (local_predicate.to_prelocal_predicate P)) U))
        j =
    category_theory.nat_trans.app (category_theory.limits.cone.π s) j) (f : category_theory.limits.cone.X s) (h : prelocal_predicate.pred (local_predicate.to_prelocal_predicate P)
  (category_theory.limits.is_limit.lift (presheaf.to_Types X T U)
    (category_theory.functor.obj
      (category_theory.limits.cones.postcompose (diagram_subtype (local_predicate.to_prelocal_predicate P) U)) s)
    f)) : m f =
  { val :=
      category_theory.limits.is_limit.lift (presheaf.to_Types X T U)
        (category_theory.functor.obj
          (category_theory.limits.cones.postcompose (diagram_subtype (local_predicate.to_prelocal_predicate P) U)) s)
        f,
    property := h } := sorry

/--
The functions satisfying a local predicate satisfy the sheaf condition.
-/
def sheaf_condition {X : Top} {T : ↥X → Type v} (P : local_predicate T) : presheaf.sheaf_condition (subpresheaf_to_Types (local_predicate.to_prelocal_predicate P)) := sorry

end subpresheaf_to_Types

/--
The subsheaf of the sheaf of all dependently typed functions satisfying the local predicate `P`.
-/
def subsheaf_to_Types {X : Top} {T : ↥X → Type v} (P : local_predicate T) : sheaf (Type v) X :=
  sheaf.mk (subpresheaf_to_Types (local_predicate.to_prelocal_predicate P)) (subpresheaf_to_Types.sheaf_condition P)

/--
There is a canonical map from the stalk to the original fiber, given by evaluating sections.
-/
def stalk_to_fiber {X : Top} {T : ↥X → Type v} (P : local_predicate T) (x : ↥X) : presheaf.stalk (sheaf.presheaf (subsheaf_to_Types P)) x ⟶ T x :=
  category_theory.limits.colimit.desc
    (category_theory.functor.obj
      (category_theory.functor.obj
        (category_theory.whiskering_left (topological_space.open_nhds xᵒᵖ) (topological_space.opens ↥Xᵒᵖ) (Type v))
        (category_theory.functor.op (topological_space.open_nhds.inclusion x)))
      (sheaf.presheaf (subsheaf_to_Types P)))
    (category_theory.limits.cocone.mk (T x)
      (category_theory.nat_trans.mk
        fun (U : topological_space.open_nhds xᵒᵖ)
          (f :
          category_theory.functor.obj
            (category_theory.functor.obj
              (category_theory.functor.obj
                (category_theory.whiskering_left (topological_space.open_nhds xᵒᵖ) (topological_space.opens ↥Xᵒᵖ)
                  (Type v))
                (category_theory.functor.op (topological_space.open_nhds.inclusion x)))
              (sheaf.presheaf (subsheaf_to_Types P)))
            U) =>
          subtype.val f { val := x, property := sorry }))

@[simp] theorem stalk_to_fiber_germ {X : Top} {T : ↥X → Type v} (P : local_predicate T) (U : topological_space.opens ↥X) (x : ↥U) (f : category_theory.functor.obj (sheaf.presheaf (subsheaf_to_Types P)) (opposite.op U)) : stalk_to_fiber P (↑x) (presheaf.germ (sheaf.presheaf (subsheaf_to_Types P)) x f) = subtype.val f x := sorry

/--
The `stalk_to_fiber` map is surjective at `x` if
every point in the fiber `T x` has an allowed section passing through it.
-/
theorem stalk_to_fiber_surjective {X : Top} {T : ↥X → Type v} (P : local_predicate T) (x : ↥X) (w : ∀ (t : T x),
  ∃ (U : topological_space.open_nhds x),
    ∃ (f : (y : ↥(subtype.val U)) → T ↑y),
      ∃ (h : prelocal_predicate.pred (local_predicate.to_prelocal_predicate P) f),
        f { val := x, property := subtype.property U } = t) : function.surjective (stalk_to_fiber P x) := sorry

/--
The `stalk_to_fiber` map is injective at `x` if any two allowed sections which agree at `x`
agree on some neighborhood of `x`.
-/
theorem stalk_to_fiber_injective {X : Top} {T : ↥X → Type v} (P : local_predicate T) (x : ↥X) (w : ∀ (U V : topological_space.open_nhds x) (fU : (y : ↥(subtype.val U)) → T ↑y),
  prelocal_predicate.pred (local_predicate.to_prelocal_predicate P) fU →
    ∀ (fV : (y : ↥(subtype.val V)) → T ↑y),
      prelocal_predicate.pred (local_predicate.to_prelocal_predicate P) fV →
        fU { val := x, property := subtype.property U } = fV { val := x, property := subtype.property V } →
          ∃ (W : topological_space.open_nhds x),
            ∃ (iU : W ⟶ U), ∃ (iV : W ⟶ V), ∀ (w : ↥(subtype.val W)), fU (coe_fn iU w) = fV (coe_fn iV w)) : function.injective (stalk_to_fiber P x) := sorry

/--
Some repackaging:
the presheaf of functions satisfying `continuous_prelocal` is just the same thing as
the presheaf of continuous functions.
-/
def subpresheaf_continuous_prelocal_iso_presheaf_to_Top {X : Top} (T : Top) : subpresheaf_to_Types (continuous_prelocal X T) ≅ presheaf_to_Top X T := sorry

/--
The sheaf of continuous functions on `X` with values in a space `T`.
-/
def sheaf_to_Top {X : Top} (T : Top) : sheaf (Type v) X :=
  sheaf.mk (presheaf_to_Top X T)
    (coe_fn (presheaf.sheaf_condition_equiv_of_iso (subpresheaf_continuous_prelocal_iso_presheaf_to_Top T))
      (subpresheaf_to_Types.sheaf_condition (continuous_local X T)))


import tactic

noncomputable theory
open_locale big_operators
open_locale classical

lemma sum_add_induction
  {α M : Type}
  [add_comm_monoid M]
  {p : M → Prop}
  (f : α → M)
  (s : finset α)
  (p_add : ∀ a b, p a → p b → p (a + b))
  (p_zero : p 0)
  (p_s : ∀ x ∈ s, p $ f x)
  : p $ ∑ x in s, f x :=
begin
  induction s using finset.induction with x hx s hs,
  { simpa },
  { rw finset.sum_insert,
    swap,
    { assumption },
    { apply p_add,
      { apply p_s,
        simp },
      { apply hs,
        intros a ha,
        apply p_s,
        simp [ha] }}},
end


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Yury Kudryashov
-/
import algebra.star.basic

/-!
# Free monoid over a given alphabet

## Main definitions

* `free_monoid α`: free monoid over alphabet `α`; defined as a synonym for `list α`
  with multiplication given by `(++)`.
* `free_monoid.of`: embedding `α → free_monoid α` sending each element `x` to `[x]`;
* `free_monoid.lift`: natural equivalence between `α → M` and `free_monoid α →* M`
* `free_monoid.map`: embedding of `α → β` into `free_monoid α →* free_monoid β` given by `list.map`.
-/

variables {α : Type*} {β : Type*} {γ : Type*} {M : Type*} [monoid M] {N : Type*} [monoid N]

/-- Free monoid over a given alphabet. -/
@[to_additive "Free nonabelian additive monoid over a given alphabet"]
def free_monoid (α) := list α

namespace free_monoid

@[to_additive]
instance : monoid (free_monoid α) :=
{ one := [],
  mul := λ x y, (x ++ y : list α),
  mul_one := by intros; apply list.append_nil,
  one_mul := by intros; refl,
  mul_assoc := by intros; apply list.append_assoc }

@[to_additive]
instance : inhabited (free_monoid α) := ⟨1⟩

@[to_additive]
lemma one_def : (1 : free_monoid α) = [] := rfl

@[to_additive]
lemma mul_def (xs ys : list α) : (xs * ys : free_monoid α) = (xs ++ ys : list α) :=
rfl

/-- Embeds an element of `α` into `free_monoid α` as a singleton list. -/
@[to_additive "Embeds an element of `α` into `free_add_monoid α` as a singleton list." ]
def of (x : α) : free_monoid α := [x]

@[to_additive]
lemma of_def (x : α) : of x = [x] := rfl

@[to_additive]
lemma of_injective : function.injective (@of α) :=
λ a b, list.head_eq_of_cons_eq

/-- Recursor for `free_monoid` using `1` and `of x * xs` instead of `[]` and `x :: xs`. -/
@[elab_as_eliminator, to_additive
  "Recursor for `free_add_monoid` using `0` and `of x + xs` instead of `[]` and `x :: xs`."]
def rec_on {C : free_monoid α → Sort*} (xs : free_monoid α) (h0 : C 1)
  (ih : Π x xs, C xs → C (of x * xs)) : C xs := list.rec_on xs h0 ih

@[ext, to_additive]
lemma hom_eq ⦃f g : free_monoid α →* M⦄ (h : ∀ x, f (of x) = g (of x)) :
  f = g :=
monoid_hom.ext $ λ l, rec_on l (f.map_one.trans g.map_one.symm) $
  λ x xs hxs, by simp only [h, hxs, monoid_hom.map_mul]

/-- Equivalence between maps `α → M` and monoid homomorphisms `free_monoid α →* M`. -/
@[to_additive "Equivalence between maps `α → A` and additive monoid homomorphisms
`free_add_monoid α →+ A`."]
def lift : (α → M) ≃ (free_monoid α →* M) :=
{ to_fun := λ f, ⟨λ l, (l.map f).prod, rfl,
    λ l₁ l₂, by simp only [mul_def, list.map_append, list.prod_append]⟩,
  inv_fun := λ f x, f (of x),
  left_inv := λ f, funext $ λ x, one_mul (f x),
  right_inv := λ f, hom_eq $ λ x, one_mul (f (of x)) }

@[simp, to_additive]
lemma lift_symm_apply (f : free_monoid α →* M) : lift.symm f = f ∘ of := rfl

@[to_additive]
lemma lift_apply (f : α → M) (l : free_monoid α) : lift f l = (l.map f).prod := rfl

@[to_additive]
lemma lift_comp_of (f : α → M) : (lift f) ∘ of = f := lift.symm_apply_apply f

@[simp, to_additive]
lemma lift_eval_of (f : α → M) (x : α) : lift f (of x) = f x :=
congr_fun (lift_comp_of f) x

@[simp, to_additive]
lemma lift_restrict (f : free_monoid α →* M) : lift (f ∘ of) = f :=
lift.apply_symm_apply f

@[to_additive]
lemma comp_lift (g : M →* N) (f : α → M) : g.comp (lift f) = lift (g ∘ f) :=
by { ext, simp }

@[to_additive]
lemma hom_map_lift (g : M →* N) (f : α → M) (x : free_monoid α) : g (lift f x) = lift (g ∘ f) x :=
monoid_hom.ext_iff.1 (comp_lift g f) x

/-- The unique monoid homomorphism `free_monoid α →* free_monoid β` that sends
each `of x` to `of (f x)`. -/
@[to_additive "The unique additive monoid homomorphism `free_add_monoid α →+ free_add_monoid β`
that sends each `of x` to `of (f x)`."]
def map (f : α → β) : free_monoid α →* free_monoid β :=
{ to_fun := list.map f,
  map_one' := rfl,
  map_mul' := λ l₁ l₂, list.map_append _ _ _ }

@[simp, to_additive] lemma map_of (f : α → β) (x : α) : map f (of x) = of (f x) := rfl

@[to_additive]
lemma lift_of_comp_eq_map (f : α → β) :
  lift (λ x, of (f x)) = map f :=
hom_eq $ λ x, rfl

@[to_additive]
lemma map_comp (g : β → γ) (f : α → β) : map (g ∘ f) = (map g).comp (map f) :=
hom_eq $ λ x, rfl

instance : star_monoid (free_monoid α) :=
{ star := list.reverse,
  star_involutive := list.reverse_reverse,
  star_mul := list.reverse_append, }

@[simp]
lemma star_of (x : α) : star (of x) = of x := rfl

/-- Note that `star_one` is already a global simp lemma, but this one works with dsimp too -/
@[simp]
lemma star_one : star (1 : free_monoid α) = 1 := rfl

end free_monoid


/-
Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro

! This file was ported from Lean 3 source module data.nat.order.lemmas
! leanprover-community/mathlib commit 2258b40dacd2942571c8ce136215350c702dc78f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Order.Basic
import Mathlib.Data.Set.Basic
import Mathlib.Algebra.Ring.Divisibility
import Mathlib.Algebra.GroupWithZero.Divisibility

/-!
# Further lemmas about the natural numbers

The distinction between this file and `Mathlib.Data.Nat.Order.Basic` is not particularly clear.
They are separated for now to minimize the porting requirements for tactics during the transition to
mathlib4. After `Mathlib.Data.Rat.Order` has been ported,
please feel free to reorganize these two files.
-/

universe u v

variable {m n k : ℕ}

namespace Nat

/-! ### Sets -/

instance Subtype.orderBot (s : Set ℕ) [DecidablePred (· ∈ s)] [h : Nonempty s] : OrderBot s where
  bot := ⟨Nat.find (nonempty_subtype.1 h), Nat.find_spec (nonempty_subtype.1 h)⟩
  bot_le x := Nat.find_min' _ x.2
#align nat.subtype.order_bot Nat.Subtype.orderBot

instance Subtype.semilatticeSup (s : Set ℕ) : SemilatticeSup s :=
  { Subtype.linearOrder s, LinearOrder.toLattice with }
#align nat.subtype.semilattice_sup Nat.Subtype.semilatticeSup

theorem Subtype.coe_bot {s : Set ℕ} [DecidablePred (· ∈ s)] [h : Nonempty s] :
    ((⊥ : s) : ℕ) = Nat.find (nonempty_subtype.1 h) :=
  rfl
#align nat.subtype.coe_bot Nat.Subtype.coe_bot

theorem set_eq_univ {S : Set ℕ} : S = Set.univ ↔ 0 ∈ S ∧ ∀ k : ℕ, k ∈ S → k + 1 ∈ S :=
  ⟨by rintro rfl; simp, fun ⟨h0, hs⟩ => Set.eq_univ_of_forall (set_induction h0 hs)⟩
#align nat.set_eq_univ Nat.set_eq_univ

/-! ### `div` -/

protected theorem lt_div_iff_mul_lt {n d : ℕ} (hnd : d ∣ n) (a : ℕ) : a < n / d ↔ d * a < n := by
  rcases d.eq_zero_or_pos with (rfl | hd0); · simp [zero_dvd_iff.mp hnd]
  rw [← mul_lt_mul_left hd0, ← Nat.eq_mul_of_div_eq_right hnd rfl]
#align nat.lt_div_iff_mul_lt Nat.lt_div_iff_mul_lt

theorem div_eq_iff_eq_of_dvd_dvd {n x y : ℕ} (hn : n ≠ 0) (hx : x ∣ n) (hy : y ∣ n) :
    n / x = n / y ↔ x = y := by
  constructor
  · intro h
    rw [← mul_right_inj' hn]
    apply Nat.eq_mul_of_div_eq_left (dvd_mul_of_dvd_left hy x)
    rw [eq_comm, mul_comm, Nat.mul_div_assoc _ hy]
    exact Nat.eq_mul_of_div_eq_right hx h
  · intro h
    rw [h]
#align nat.div_eq_iff_eq_of_dvd_dvd Nat.div_eq_iff_eq_of_dvd_dvd

protected theorem div_eq_zero_iff {a b : ℕ} (hb : 0 < b) : a / b = 0 ↔ a < b :=
  ⟨fun h => by rw [← mod_add_div a b, h, mul_zero, add_zero]; exact mod_lt _ hb, fun h => by
    rw [← mul_right_inj' hb.ne', ← @add_left_cancel_iff _ _ _ (a % b), mod_add_div, mod_eq_of_lt h,
      mul_zero, add_zero]⟩
#align nat.div_eq_zero_iff Nat.div_eq_zero_iff

protected theorem div_eq_zero {a b : ℕ} (hb : a < b) : a / b = 0 :=
  (Nat.div_eq_zero_iff <| (zero_le a).trans_lt hb).mpr hb
#align nat.div_eq_zero Nat.div_eq_zero

/-! ### `mod`, `dvd` -/

@[simp]
protected theorem dvd_one {n : ℕ} : n ∣ 1 ↔ n = 1 :=
  ⟨eq_one_of_dvd_one, fun e => e.symm ▸ dvd_rfl⟩
#align nat.dvd_one Nat.dvd_one

set_option linter.deprecated false in
@[simp]
protected theorem not_two_dvd_bit1 (n : ℕ) : ¬2 ∣ bit1 n := by
  rw [bit1, Nat.dvd_add_right two_dvd_bit0, Nat.dvd_one]
  -- Porting note: was `cc`
  decide
#align nat.not_two_dvd_bit1 Nat.not_two_dvd_bit1

/-- A natural number `m` divides the sum `m + n` if and only if `m` divides `n`.-/
@[simp]
protected theorem dvd_add_self_left {m n : ℕ} : m ∣ m + n ↔ m ∣ n :=
  Nat.dvd_add_right (dvd_refl m)
#align nat.dvd_add_self_left Nat.dvd_add_self_left

/-- A natural number `m` divides the sum `n + m` if and only if `m` divides `n`.-/
@[simp]
protected theorem dvd_add_self_right {m n : ℕ} : m ∣ n + m ↔ m ∣ n :=
  Nat.dvd_add_left (dvd_refl m)
#align nat.dvd_add_self_right Nat.dvd_add_self_right

-- TODO: update `Nat.dvd_sub` in core
theorem dvd_sub' {k m n : ℕ} (h₁ : k ∣ m) (h₂ : k ∣ n) : k ∣ m - n := by
  cases' le_total n m with H H
  · exact dvd_sub H h₁ h₂
  · rw [tsub_eq_zero_iff_le.mpr H]
    exact dvd_zero k
#align nat.dvd_sub' Nat.dvd_sub'

theorem succ_div : ∀ a b : ℕ, (a + 1) / b = a / b + if b ∣ a + 1 then 1 else 0
  | a, 0 => by simp
  | 0, 1 => by simp
  | 0, b + 2 => by
    have hb2 : b + 2 > 1 := by simp
    simp [ne_of_gt hb2, div_eq_of_lt hb2]
  | a + 1, b + 1 => by
    rw [Nat.div_eq]
    conv_rhs => rw [Nat.div_eq]
    by_cases hb_eq_a : b = a + 1
    · simp [hb_eq_a, le_refl]
    by_cases hb_le_a1 : b ≤ a + 1
    · have hb_le_a : b ≤ a := le_of_lt_succ (lt_of_le_of_ne hb_le_a1 hb_eq_a)
      have h₁ : 0 < b + 1 ∧ b + 1 ≤ a + 1 + 1 := ⟨succ_pos _, (add_le_add_iff_right _).2 hb_le_a1⟩
      have h₂ : 0 < b + 1 ∧ b + 1 ≤ a + 1 := ⟨succ_pos _, (add_le_add_iff_right _).2 hb_le_a⟩
      have dvd_iff : b + 1 ∣ a - b + 1 ↔ b + 1 ∣ a + 1 + 1 := by
        rw [Nat.dvd_add_iff_left (dvd_refl (b + 1)), ← add_tsub_add_eq_tsub_right a 1 b,
          add_comm (_ - _), add_assoc, tsub_add_cancel_of_le (succ_le_succ hb_le_a), add_comm 1]
      have wf : a - b < a + 1 := lt_succ_of_le tsub_le_self
      rw [if_pos h₁, if_pos h₂, @add_tsub_add_eq_tsub_right, ← tsub_add_eq_add_tsub hb_le_a,
        have := wf
        succ_div (a - b),
        @add_tsub_add_eq_tsub_right]
      simp [dvd_iff, succ_eq_add_one, add_comm 1, add_assoc]
    · have hba : ¬b ≤ a := not_le_of_gt (lt_trans (lt_succ_self a) (lt_of_not_ge hb_le_a1))
      have hb_dvd_a : ¬b + 1 ∣ a + 2 := fun h =>
        hb_le_a1 (le_of_succ_le_succ (le_of_dvd (succ_pos _) h))
      simp [hba, hb_le_a1, hb_dvd_a]
#align nat.succ_div Nat.succ_div

theorem succ_div_of_dvd {a b : ℕ} (hba : b ∣ a + 1) : (a + 1) / b = a / b + 1 := by
  rw [succ_div, if_pos hba]
#align nat.succ_div_of_dvd Nat.succ_div_of_dvd

theorem succ_div_of_not_dvd {a b : ℕ} (hba : ¬b ∣ a + 1) : (a + 1) / b = a / b := by
  rw [succ_div, if_neg hba, add_zero]
#align nat.succ_div_of_not_dvd Nat.succ_div_of_not_dvd

theorem dvd_iff_div_mul_eq (n d : ℕ) : d ∣ n ↔ n / d * d = n :=
  ⟨fun h => Nat.div_mul_cancel h, fun h => Dvd.intro_left (n / d) h⟩
#align nat.dvd_iff_div_mul_eq Nat.dvd_iff_div_mul_eq

theorem dvd_iff_le_div_mul (n d : ℕ) : d ∣ n ↔ n ≤ n / d * d :=
  ((dvd_iff_div_mul_eq _ _).trans le_antisymm_iff).trans (and_iff_right (div_mul_le_self n d))
#align nat.dvd_iff_le_div_mul Nat.dvd_iff_le_div_mul

theorem dvd_iff_dvd_dvd (n d : ℕ) : d ∣ n ↔ ∀ k : ℕ, k ∣ d → k ∣ n :=
  ⟨fun h _ hkd => dvd_trans hkd h, fun h => h _ dvd_rfl⟩
#align nat.dvd_iff_dvd_dvd Nat.dvd_iff_dvd_dvd

theorem dvd_div_of_mul_dvd {a b c : ℕ} (h : a * b ∣ c) : b ∣ c / a :=
  if ha : a = 0 then by simp [ha]
  else
    have ha : 0 < a := Nat.pos_of_ne_zero ha
    have h1 : ∃ d, c = a * b * d := h
    let ⟨d, hd⟩ := h1
    have h2 : c / a = b * d := Nat.div_eq_of_eq_mul_right ha (by simpa [mul_assoc] using hd)
    show ∃ d, c / a = b * d from ⟨d, h2⟩
#align nat.dvd_div_of_mul_dvd Nat.dvd_div_of_mul_dvd

@[simp]
theorem dvd_div_iff {a b c : ℕ} (hbc : c ∣ b) : a ∣ b / c ↔ c * a ∣ b :=
  ⟨fun h => mul_dvd_of_dvd_div hbc h, fun h => dvd_div_of_mul_dvd h⟩
#align nat.dvd_div_iff Nat.dvd_div_iff

@[simp]

/-- If a small natural number is divisible by a larger natural number,
the small number is zero. -/
theorem eq_zero_of_dvd_of_lt {a b : ℕ} (w : a ∣ b) (h : b < a) : b = 0 :=
  Nat.eq_zero_of_dvd_of_div_eq_zero w
    ((Nat.div_eq_zero_iff (lt_of_le_of_lt (zero_le b) h)).mpr h)
#align nat.eq_zero_of_dvd_of_lt Nat.eq_zero_of_dvd_of_lt

@[simp]
theorem mod_div_self (m n : ℕ) : m % n / n = 0 := by
  cases n
  · exact (m % 0).div_zero
  · case succ n => exact Nat.div_eq_zero (m.mod_lt n.succ_pos)
#align nat.mod_div_self Nat.mod_div_self

/-- `n` is not divisible by `a` iff it is between `a * k` and `a * (k + 1)` for some `k`. -/
theorem not_dvd_iff_between_consec_multiples (n : ℕ) {a : ℕ} (ha : 0 < a) :
    (∃ k : ℕ, a * k < n ∧ n < a * (k + 1)) ↔ ¬a ∣ n := by
  refine'
    ⟨fun ⟨k, hk1, hk2⟩ => not_dvd_of_between_consec_multiples hk1 hk2, fun han =>
      ⟨n / a, ⟨lt_of_le_of_ne (mul_div_le n a) _, lt_mul_div_succ _ ha⟩⟩⟩
  exact mt (Dvd.intro (n / a)) han
#align nat.not_dvd_iff_between_consec_multiples Nat.not_dvd_iff_between_consec_multiples

/-- Two natural numbers are equal if and only if they have the same multiples. -/
theorem dvd_right_iff_eq {m n : ℕ} : (∀ a : ℕ, m ∣ a ↔ n ∣ a) ↔ m = n :=
  ⟨fun h => dvd_antisymm ((h _).mpr dvd_rfl) ((h _).mp dvd_rfl), fun h n => by rw [h]⟩
#align nat.dvd_right_iff_eq Nat.dvd_right_iff_eq

/-- Two natural numbers are equal if and only if they have the same divisors. -/
theorem dvd_left_iff_eq {m n : ℕ} : (∀ a : ℕ, a ∣ m ↔ a ∣ n) ↔ m = n :=
  ⟨fun h => dvd_antisymm ((h _).mp dvd_rfl) ((h _).mpr dvd_rfl), fun h n => by rw [h]⟩
#align nat.dvd_left_iff_eq Nat.dvd_left_iff_eq

/-- `dvd` is injective in the left argument -/
theorem dvd_left_injective : Function.Injective ((· ∣ ·) : ℕ → ℕ → Prop) := fun _ _ h =>
  dvd_right_iff_eq.mp fun a => iff_of_eq (congr_fun h a)
#align nat.dvd_left_injective Nat.dvd_left_injective

theorem div_lt_div_of_lt_of_dvd {a b d : ℕ} (hdb : d ∣ b) (h : a < b) : a / d < b / d := by
  rw [Nat.lt_div_iff_mul_lt hdb]
  exact lt_of_le_of_lt (mul_div_le a d) h
#align nat.div_lt_div_of_lt_of_dvd Nat.div_lt_div_of_lt_of_dvd

end Nat


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis, Leonardo de Moura, Mario Carneiro, Floris van Doorn
-/
import algebra.field.basic
import algebra.group_power.lemmas
import algebra.group_power.order
import algebra.order.ring
import order.bounds
import tactic.monotonicity.basic

/-!
# Linear ordered fields

A linear ordered field is a field equipped with a linear order such that
* addition respects the order: `a ≤ b → c + a ≤ c + b`;
* multiplication of positives is positive: `0 < a → 0 < b → 0 < a * b`;
* `0 < 1`.

## Main Definitions

* `linear_ordered_field`: the class of linear ordered fields.
-/

set_option old_structure_cmd true

variable {α : Type*}

/-- A linear ordered field is a field with a linear order respecting the operations. -/
@[protect_proj] class linear_ordered_field (α : Type*) extends linear_ordered_comm_ring α, field α

section linear_ordered_field
variables [linear_ordered_field α] {a b c d e : α}

section

/-- `equiv.mul_left₀` as an order_iso. -/
@[simps {simp_rhs := tt}]
def order_iso.mul_left₀ (a : α) (ha : 0 < a) : α ≃o α :=
{ map_rel_iff' := λ _ _, mul_le_mul_left ha, ..equiv.mul_left₀ a ha.ne' }

/-- `equiv.mul_right₀` as an order_iso. -/
@[simps {simp_rhs := tt}]
def order_iso.mul_right₀ (a : α) (ha : 0 < a) : α ≃o α :=
{ map_rel_iff' := λ _ _, mul_le_mul_right ha, ..equiv.mul_right₀ a ha.ne' }

end

/-!
### Lemmas about pos, nonneg, nonpos, neg
-/

@[simp] lemma inv_pos : 0 < a⁻¹ ↔ 0 < a :=
suffices ∀ a : α, 0 < a → 0 < a⁻¹,
from ⟨λ h, inv_inv a ▸ this _ h, this a⟩,
assume a ha, flip lt_of_mul_lt_mul_left ha.le $ by simp [ne_of_gt ha, zero_lt_one]

@[simp] lemma inv_nonneg : 0 ≤ a⁻¹ ↔ 0 ≤ a :=
by simp only [le_iff_eq_or_lt, inv_pos, zero_eq_inv]

@[simp] lemma inv_lt_zero : a⁻¹ < 0 ↔ a < 0 :=
by simp only [← not_le, inv_nonneg]

@[simp] lemma inv_nonpos : a⁻¹ ≤ 0 ↔ a ≤ 0 :=
by simp only [← not_lt, inv_pos]

lemma one_div_pos : 0 < 1 / a ↔ 0 < a :=
inv_eq_one_div a ▸ inv_pos

lemma one_div_neg : 1 / a < 0 ↔ a < 0 :=
inv_eq_one_div a ▸ inv_lt_zero

lemma one_div_nonneg : 0 ≤ 1 / a ↔ 0 ≤ a :=
inv_eq_one_div a ▸ inv_nonneg

lemma one_div_nonpos : 1 / a ≤ 0 ↔ a ≤ 0 :=
inv_eq_one_div a ▸ inv_nonpos

lemma div_pos_iff : 0 < a / b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 :=
by simp [division_def, mul_pos_iff]

lemma div_neg_iff : a / b < 0 ↔ 0 < a ∧ b < 0 ∨ a < 0 ∧ 0 < b :=
by simp [division_def, mul_neg_iff]

lemma div_nonneg_iff : 0 ≤ a / b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 :=
by simp [division_def, mul_nonneg_iff]

lemma div_nonpos_iff : a / b ≤ 0 ↔ 0 ≤ a ∧ b ≤ 0 ∨ a ≤ 0 ∧ 0 ≤ b :=
by simp [division_def, mul_nonpos_iff]

lemma div_pos (ha : 0 < a) (hb : 0 < b) : 0 < a / b :=
div_pos_iff.2 $ or.inl ⟨ha, hb⟩

lemma div_pos_of_neg_of_neg (ha : a < 0) (hb : b < 0) : 0 < a / b :=
div_pos_iff.2 $ or.inr ⟨ha, hb⟩

lemma div_neg_of_neg_of_pos (ha : a < 0) (hb : 0 < b) : a / b < 0 :=
div_neg_iff.2 $ or.inr ⟨ha, hb⟩

lemma div_neg_of_pos_of_neg (ha : 0 < a) (hb : b < 0) : a / b < 0 :=
div_neg_iff.2 $ or.inl ⟨ha, hb⟩

lemma div_nonneg (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a / b :=
div_nonneg_iff.2 $ or.inl ⟨ha, hb⟩

lemma div_nonneg_of_nonpos (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a / b :=
div_nonneg_iff.2 $ or.inr ⟨ha, hb⟩

lemma div_nonpos_of_nonpos_of_nonneg (ha : a ≤ 0) (hb : 0 ≤ b) : a / b ≤ 0 :=
div_nonpos_iff.2 $ or.inr ⟨ha, hb⟩

lemma div_nonpos_of_nonneg_of_nonpos (ha : 0 ≤ a) (hb : b ≤ 0) : a / b ≤ 0 :=
div_nonpos_iff.2 $ or.inl ⟨ha, hb⟩

/-!
### Relating one division with another term.
-/

lemma le_div_iff (hc : 0 < c) : a ≤ b / c ↔ a * c ≤ b :=
⟨λ h, div_mul_cancel b (ne_of_lt hc).symm ▸ mul_le_mul_of_nonneg_right h hc.le,
  λ h, calc
    a   = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc).symm
    ... ≤ b * (1 / c)     : mul_le_mul_of_nonneg_right h (one_div_pos.2 hc).le
    ... = b / c           : (div_eq_mul_one_div b c).symm⟩

lemma le_div_iff' (hc : 0 < c) : a ≤ b / c ↔ c * a ≤ b :=
by rw [mul_comm, le_div_iff hc]

lemma div_le_iff (hb : 0 < b) : a / b ≤ c ↔ a ≤ c * b :=
⟨λ h, calc
  a = a / b * b : by rw (div_mul_cancel _ (ne_of_lt hb).symm)
  ... ≤ c * b     : mul_le_mul_of_nonneg_right h hb.le,
  λ h, calc
  a / b = a * (1 / b)     : div_eq_mul_one_div a b
  ... ≤ (c * b) * (1 / b) : mul_le_mul_of_nonneg_right h (one_div_pos.2 hb).le
  ... = (c * b) / b       : (div_eq_mul_one_div (c * b) b).symm
  ... = c                 : by refine (div_eq_iff (ne_of_gt hb)).mpr rfl⟩

lemma div_le_iff' (hb : 0 < b) : a / b ≤ c ↔ a ≤ b * c :=
by rw [mul_comm, div_le_iff hb]

lemma lt_div_iff (hc : 0 < c) : a < b / c ↔ a * c < b :=
lt_iff_lt_of_le_iff_le $ div_le_iff hc

lemma lt_div_iff' (hc : 0 < c) : a < b / c ↔ c * a < b :=
by rw [mul_comm, lt_div_iff hc]

lemma div_lt_iff (hc : 0 < c) : b / c < a ↔ b < a * c :=
lt_iff_lt_of_le_iff_le (le_div_iff hc)

lemma div_lt_iff' (hc : 0 < c) : b / c < a ↔ b < c * a :=
by rw [mul_comm, div_lt_iff hc]

lemma inv_mul_le_iff (h : 0 < b) : b⁻¹ * a ≤ c ↔ a ≤ b * c :=
begin
  rw [inv_eq_one_div, mul_comm, ← div_eq_mul_one_div],
  exact div_le_iff' h,
end

lemma inv_mul_le_iff' (h : 0 < b) : b⁻¹ * a ≤ c ↔ a ≤ c * b :=
by rw [inv_mul_le_iff h, mul_comm]

lemma mul_inv_le_iff (h : 0 < b) : a * b⁻¹ ≤ c ↔ a ≤ b * c :=
by rw [mul_comm, inv_mul_le_iff h]

lemma mul_inv_le_iff' (h : 0 < b) : a * b⁻¹ ≤ c ↔ a ≤ c * b :=
by rw [mul_comm, inv_mul_le_iff' h]

lemma div_self_le_one (a : α) : a / a ≤ 1 :=
if h : a = 0 then by simp [h] else by simp [h]

lemma inv_mul_lt_iff (h : 0 < b) : b⁻¹ * a < c ↔ a < b * c :=
begin
  rw [inv_eq_one_div, mul_comm, ← div_eq_mul_one_div],
  exact div_lt_iff' h,
end

lemma inv_mul_lt_iff' (h : 0 < b) : b⁻¹ * a < c ↔ a < c * b :=
by rw [inv_mul_lt_iff h, mul_comm]

lemma mul_inv_lt_iff (h : 0 < b) : a * b⁻¹ < c ↔ a < b * c :=
by rw [mul_comm, inv_mul_lt_iff h]

lemma mul_inv_lt_iff' (h : 0 < b) : a * b⁻¹ < c ↔ a < c * b :=
by rw [mul_comm, inv_mul_lt_iff' h]

lemma inv_pos_le_iff_one_le_mul (ha : 0 < a) : a⁻¹ ≤ b ↔ 1 ≤ b * a :=
by { rw [inv_eq_one_div], exact div_le_iff ha }

lemma inv_pos_le_iff_one_le_mul' (ha : 0 < a) : a⁻¹ ≤ b ↔ 1 ≤ a * b :=
by { rw [inv_eq_one_div], exact div_le_iff' ha }

lemma inv_pos_lt_iff_one_lt_mul (ha : 0 < a) : a⁻¹ < b ↔ 1 < b * a :=
by { rw [inv_eq_one_div], exact div_lt_iff ha }

lemma inv_pos_lt_iff_one_lt_mul' (ha : 0 < a) : a⁻¹ < b ↔ 1 < a * b :=
by { rw [inv_eq_one_div], exact div_lt_iff' ha }

lemma div_le_iff_of_neg (hc : c < 0) : b / c ≤ a ↔ a * c ≤ b :=
⟨λ h, div_mul_cancel b (ne_of_lt hc) ▸ mul_le_mul_of_nonpos_right h hc.le,
  λ h, calc
    a = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc)
  ... ≥ b * (1 / c)     : mul_le_mul_of_nonpos_right h (one_div_neg.2 hc).le
  ... = b / c           : (div_eq_mul_one_div b c).symm⟩

lemma div_le_iff_of_neg' (hc : c < 0) : b / c ≤ a ↔ c * a ≤ b :=
by rw [mul_comm, div_le_iff_of_neg hc]

lemma le_div_iff_of_neg (hc : c < 0) : a ≤ b / c ↔ b ≤ a * c :=
by rw [← neg_neg c, mul_neg, div_neg, le_neg,
    div_le_iff (neg_pos.2 hc), neg_mul]

lemma le_div_iff_of_neg' (hc : c < 0) : a ≤ b / c ↔ b ≤ c * a :=
by rw [mul_comm, le_div_iff_of_neg hc]

lemma div_lt_iff_of_neg (hc : c < 0) : b / c < a ↔ a * c < b :=
lt_iff_lt_of_le_iff_le $ le_div_iff_of_neg hc

lemma div_lt_iff_of_neg' (hc : c < 0) : b / c < a ↔ c * a < b :=
by rw [mul_comm, div_lt_iff_of_neg hc]

lemma lt_div_iff_of_neg (hc : c < 0) : a < b / c ↔ b < a * c :=
lt_iff_lt_of_le_iff_le $ div_le_iff_of_neg hc

lemma lt_div_iff_of_neg' (hc : c < 0) : a < b / c ↔ b < c * a :=
by rw [mul_comm, lt_div_iff_of_neg hc]

/-- One direction of `div_le_iff` where `b` is allowed to be `0` (but `c` must be nonnegative) -/
lemma div_le_of_nonneg_of_le_mul (hb : 0 ≤ b) (hc : 0 ≤ c) (h : a ≤ c * b) : a / b ≤ c :=
by { rcases eq_or_lt_of_le hb with rfl|hb', simp [hc], rwa [div_le_iff hb'] }

lemma div_le_one_of_le (h : a ≤ b) (hb : 0 ≤ b) : a / b ≤ 1 :=
div_le_of_nonneg_of_le_mul hb zero_le_one $ by rwa one_mul

/-!
### Bi-implications of inequalities using inversions
-/

lemma inv_le_inv_of_le (ha : 0 < a) (h : a ≤ b) : b⁻¹ ≤ a⁻¹ :=
by rwa [← one_div a, le_div_iff' ha, ← div_eq_mul_inv, div_le_iff (ha.trans_le h), one_mul]

/-- See `inv_le_inv_of_le` for the implication from right-to-left with one fewer assumption. -/
lemma inv_le_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
by rw [← one_div, div_le_iff ha, ← div_eq_inv_mul, le_div_iff hb, one_mul]

/-- In a linear ordered field, for positive `a` and `b` we have `a⁻¹ ≤ b ↔ b⁻¹ ≤ a`.
See also `inv_le_of_inv_le` for a one-sided implication with one fewer assumption. -/
lemma inv_le (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b ↔ b⁻¹ ≤ a :=
by rw [← inv_le_inv hb (inv_pos.2 ha), inv_inv]

lemma inv_le_of_inv_le (ha : 0 < a) (h : a⁻¹ ≤ b) : b⁻¹ ≤ a :=
(inv_le ha ((inv_pos.2 ha).trans_le h)).1 h

lemma le_inv (ha : 0 < a) (hb : 0 < b) : a ≤ b⁻¹ ↔ b ≤ a⁻¹ :=
by rw [← inv_le_inv (inv_pos.2 hb) ha, inv_inv]

/-- See `inv_lt_inv_of_lt` for the implication from right-to-left with one fewer assumption. -/
lemma inv_lt_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b⁻¹ ↔ b < a :=
lt_iff_lt_of_le_iff_le (inv_le_inv hb ha)

lemma inv_lt_inv_of_lt (hb : 0 < b) (h : b < a) : a⁻¹ < b⁻¹ :=
(inv_lt_inv (hb.trans h) hb).2 h

/-- In a linear ordered field, for positive `a` and `b` we have `a⁻¹ < b ↔ b⁻¹ < a`.
See also `inv_lt_of_inv_lt` for a one-sided implication with one fewer assumption. -/
lemma inv_lt (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b ↔ b⁻¹ < a :=
lt_iff_lt_of_le_iff_le (le_inv hb ha)

lemma inv_lt_of_inv_lt (ha : 0 < a) (h : a⁻¹ < b) : b⁻¹ < a :=
(inv_lt ha ((inv_pos.2 ha).trans h)).1 h

lemma lt_inv (ha : 0 < a) (hb : 0 < b) : a < b⁻¹ ↔ b < a⁻¹ :=
lt_iff_lt_of_le_iff_le (inv_le hb ha)

lemma inv_le_inv_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
by rw [← one_div, div_le_iff_of_neg ha, ← div_eq_inv_mul, div_le_iff_of_neg hb, one_mul]

lemma inv_le_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ ≤ b ↔ b⁻¹ ≤ a :=
by rw [← inv_le_inv_of_neg hb (inv_lt_zero.2 ha), inv_inv]

lemma le_inv_of_neg (ha : a < 0) (hb : b < 0) : a ≤ b⁻¹ ↔ b ≤ a⁻¹ :=
by rw [← inv_le_inv_of_neg (inv_lt_zero.2 hb) ha, inv_inv]

lemma inv_lt_inv_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ < b⁻¹ ↔ b < a :=
lt_iff_lt_of_le_iff_le (inv_le_inv_of_neg hb ha)

lemma inv_lt_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ < b ↔ b⁻¹ < a :=
lt_iff_lt_of_le_iff_le (le_inv_of_neg hb ha)

lemma lt_inv_of_neg (ha : a < 0) (hb : b < 0) : a < b⁻¹ ↔ b < a⁻¹ :=
lt_iff_lt_of_le_iff_le (inv_le_of_neg hb ha)

lemma inv_lt_one (ha : 1 < a) : a⁻¹ < 1 :=
by rwa [inv_lt ((@zero_lt_one α _ _).trans ha) zero_lt_one, inv_one]

lemma one_lt_inv (h₁ : 0 < a) (h₂ : a < 1) : 1 < a⁻¹ :=
by rwa [lt_inv (@zero_lt_one α _ _) h₁, inv_one]

lemma inv_le_one (ha : 1 ≤ a) : a⁻¹ ≤ 1 :=
by rwa [inv_le ((@zero_lt_one α _ _).trans_le ha) zero_lt_one, inv_one]

lemma one_le_inv (h₁ : 0 < a) (h₂ : a ≤ 1) : 1 ≤ a⁻¹ :=
by rwa [le_inv (@zero_lt_one α _ _) h₁, inv_one]

lemma inv_lt_one_iff_of_pos (h₀ : 0 < a) : a⁻¹ < 1 ↔ 1 < a :=
⟨λ h₁, inv_inv a ▸ one_lt_inv (inv_pos.2 h₀) h₁, inv_lt_one⟩

lemma inv_lt_one_iff : a⁻¹ < 1 ↔ a ≤ 0 ∨ 1 < a :=
begin
  cases le_or_lt a 0 with ha ha,
  { simp [ha, (inv_nonpos.2 ha).trans_lt zero_lt_one] },
  { simp only [ha.not_le, false_or, inv_lt_one_iff_of_pos ha] }
end

lemma one_lt_inv_iff : 1 < a⁻¹ ↔ 0 < a ∧ a < 1 :=
⟨λ h, ⟨inv_pos.1 (zero_lt_one.trans h), inv_inv a ▸ inv_lt_one h⟩, and_imp.2 one_lt_inv⟩

lemma inv_le_one_iff : a⁻¹ ≤ 1 ↔ a ≤ 0 ∨ 1 ≤ a :=
begin
  rcases em (a = 1) with (rfl|ha),
  { simp [le_rfl] },
  { simp only [ne.le_iff_lt (ne.symm ha), ne.le_iff_lt (mt inv_eq_one.1 ha), inv_lt_one_iff] }
end

lemma one_le_inv_iff : 1 ≤ a⁻¹ ↔ 0 < a ∧ a ≤ 1 :=
⟨λ h, ⟨inv_pos.1 (zero_lt_one.trans_le h), inv_inv a ▸ inv_le_one h⟩, and_imp.2 one_le_inv⟩

/-!
### Relating two divisions.
-/

@[mono] lemma div_le_div_of_le (hc : 0 ≤ c) (h : a ≤ b) : a / c ≤ b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_le_mul_of_nonneg_right h (one_div_nonneg.2 hc)
end

-- Not a `mono` lemma b/c `div_le_div` is strictly more general
lemma div_le_div_of_le_left (ha : 0 ≤ a) (hc : 0 < c) (h : c ≤ b) : a / b ≤ a / c :=
begin
  rw [div_eq_mul_inv, div_eq_mul_inv],
  exact mul_le_mul_of_nonneg_left ((inv_le_inv (hc.trans_le h) hc).mpr h) ha
end

lemma div_le_div_of_le_of_nonneg (hab : a ≤ b) (hc : 0 ≤ c) : a / c ≤ b / c :=
div_le_div_of_le hc hab

lemma div_le_div_of_nonpos_of_le (hc : c ≤ 0) (h : b ≤ a) : a / c ≤ b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_le_mul_of_nonpos_right h (one_div_nonpos.2 hc)
end

lemma div_lt_div_of_lt (hc : 0 < c) (h : a < b) : a / c < b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_lt_mul_of_pos_right h (one_div_pos.2 hc)
end

lemma div_lt_div_of_neg_of_lt (hc : c < 0) (h : b < a) : a / c < b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_lt_mul_of_neg_right h (one_div_neg.2 hc)
end

lemma div_le_div_right (hc : 0 < c) : a / c ≤ b / c ↔ a ≤ b :=
⟨le_imp_le_of_lt_imp_lt $ div_lt_div_of_lt hc, div_le_div_of_le $ hc.le⟩

lemma div_le_div_right_of_neg (hc : c < 0) : a / c ≤ b / c ↔ b ≤ a :=
⟨le_imp_le_of_lt_imp_lt $ div_lt_div_of_neg_of_lt hc, div_le_div_of_nonpos_of_le $ hc.le⟩

lemma div_lt_div_right (hc : 0 < c) : a / c < b / c ↔ a < b :=
lt_iff_lt_of_le_iff_le $ div_le_div_right hc

lemma div_lt_div_right_of_neg (hc : c < 0) : a / c < b / c ↔ b < a :=
lt_iff_lt_of_le_iff_le $ div_le_div_right_of_neg hc

lemma div_lt_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b < a / c ↔ c < b :=
by simp only [div_eq_mul_inv, mul_lt_mul_left ha, inv_lt_inv hb hc]

lemma div_le_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b ≤ a / c ↔ c ≤ b :=
le_iff_le_iff_lt_iff_lt.2 (div_lt_div_left ha hc hb)

lemma div_lt_div_iff (b0 : 0 < b) (d0 : 0 < d) :
  a / b < c / d ↔ a * d < c * b :=
by rw [lt_div_iff d0, div_mul_eq_mul_div, div_lt_iff b0]

lemma div_le_div_iff (b0 : 0 < b) (d0 : 0 < d) : a / b ≤ c / d ↔ a * d ≤ c * b :=
by rw [le_div_iff d0, div_mul_eq_mul_div, div_le_iff b0]

@[mono] lemma div_le_div (hc : 0 ≤ c) (hac : a ≤ c) (hd : 0 < d) (hbd : d ≤ b) : a / b ≤ c / d :=
by { rw div_le_div_iff (hd.trans_le hbd) hd, exact mul_le_mul hac hbd hd.le hc }

lemma div_lt_div (hac : a < c) (hbd : d ≤ b) (c0 : 0 ≤ c) (d0 : 0 < d) :
  a / b < c / d :=
(div_lt_div_iff (d0.trans_le hbd) d0).2 (mul_lt_mul hac hbd d0 c0)

lemma div_lt_div' (hac : a ≤ c) (hbd : d < b) (c0 : 0 < c) (d0 : 0 < d) :
  a / b < c / d :=
(div_lt_div_iff (d0.trans hbd) d0).2 (mul_lt_mul' hac hbd d0.le c0)

lemma div_lt_div_of_lt_left (hc : 0 < c) (hb : 0 < b) (h : b < a) : c / a < c / b :=
(div_lt_div_left hc (hb.trans h) hb).mpr h

/-!
### Relating one division and involving `1`
-/

lemma div_le_self (ha : 0 ≤ a) (hb : 1 ≤ b) : a / b ≤ a :=
by simpa only [div_one] using div_le_div_of_le_left ha zero_lt_one hb

lemma div_lt_self (ha : 0 < a) (hb : 1 < b) : a / b < a :=
by simpa only [div_one] using div_lt_div_of_lt_left ha zero_lt_one hb

lemma le_div_self (ha : 0 ≤ a) (hb₀ : 0 < b) (hb₁ : b ≤ 1) : a ≤ a / b :=
by simpa only [div_one] using div_le_div_of_le_left ha hb₀ hb₁

lemma one_le_div (hb : 0 < b) : 1 ≤ a / b ↔ b ≤ a :=
by rw [le_div_iff hb, one_mul]

lemma div_le_one (hb : 0 < b) : a / b ≤ 1 ↔ a ≤ b :=
by rw [div_le_iff hb, one_mul]

lemma one_lt_div (hb : 0 < b) : 1 < a / b ↔ b < a :=
by rw [lt_div_iff hb, one_mul]

lemma div_lt_one (hb : 0 < b) : a / b < 1 ↔ a < b :=
by rw [div_lt_iff hb, one_mul]

lemma one_le_div_of_neg (hb : b < 0) : 1 ≤ a / b ↔ a ≤ b :=
by rw [le_div_iff_of_neg hb, one_mul]

lemma div_le_one_of_neg (hb : b < 0) : a / b ≤ 1 ↔ b ≤ a :=
by rw [div_le_iff_of_neg hb, one_mul]

lemma one_lt_div_of_neg (hb : b < 0) : 1 < a / b ↔ a < b :=
by rw [lt_div_iff_of_neg hb, one_mul]

lemma div_lt_one_of_neg (hb : b < 0) : a / b < 1 ↔ b < a :=
by rw [div_lt_iff_of_neg hb, one_mul]

lemma one_div_le (ha : 0 < a) (hb : 0 < b) : 1 / a ≤ b ↔ 1 / b ≤ a :=
by simpa using inv_le ha hb

lemma one_div_lt (ha : 0 < a) (hb : 0 < b) : 1 / a < b ↔ 1 / b < a :=
by simpa using inv_lt ha hb

lemma le_one_div (ha : 0 < a) (hb : 0 < b) : a ≤ 1 / b ↔ b ≤ 1 / a :=
by simpa using le_inv ha hb

lemma lt_one_div (ha : 0 < a) (hb : 0 < b) : a < 1 / b ↔ b < 1 / a :=
by simpa using lt_inv ha hb

lemma one_div_le_of_neg (ha : a < 0) (hb : b < 0) : 1 / a ≤ b ↔ 1 / b ≤ a :=
by simpa using inv_le_of_neg ha hb

lemma one_div_lt_of_neg (ha : a < 0) (hb : b < 0) : 1 / a < b ↔ 1 / b < a :=
by simpa using inv_lt_of_neg ha hb

lemma le_one_div_of_neg (ha : a < 0) (hb : b < 0) : a ≤ 1 / b ↔ b ≤ 1 / a :=
by simpa using le_inv_of_neg ha hb

lemma lt_one_div_of_neg (ha : a < 0) (hb : b < 0) : a < 1 / b ↔ b < 1 / a :=
by simpa using lt_inv_of_neg ha hb

lemma one_lt_div_iff : 1 < a / b ↔ 0 < b ∧ b < a ∨ b < 0 ∧ a < b :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, one_lt_div_of_neg] },
  { simp [lt_irrefl, zero_le_one] },
  { simp [hb, hb.not_lt, one_lt_div] }
end

lemma one_le_div_iff : 1 ≤ a / b ↔ 0 < b ∧ b ≤ a ∨ b < 0 ∧ a ≤ b :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, one_le_div_of_neg] },
  { simp [lt_irrefl, zero_lt_one.not_le, zero_lt_one] },
  { simp [hb, hb.not_lt, one_le_div] }
end

lemma div_lt_one_iff : a / b < 1 ↔ 0 < b ∧ a < b ∨ b = 0 ∨ b < 0 ∧ b < a :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, hb.ne, div_lt_one_of_neg] },
  { simp [zero_lt_one], },
  { simp [hb, hb.not_lt, div_lt_one, hb.ne.symm] }
end

lemma div_le_one_iff : a / b ≤ 1 ↔ 0 < b ∧ a ≤ b ∨ b = 0 ∨ b < 0 ∧ b ≤ a :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, hb.ne, div_le_one_of_neg] },
  { simp [zero_le_one], },
  { simp [hb, hb.not_lt, div_le_one, hb.ne.symm] }
end

/-!
### Relating two divisions, involving `1`
-/
lemma one_div_le_one_div_of_le (ha : 0 < a) (h : a ≤ b) : 1 / b ≤ 1 / a :=
by simpa using inv_le_inv_of_le ha h

lemma one_div_lt_one_div_of_lt (ha : 0 < a) (h : a < b) : 1 / b < 1 / a :=
by rwa [lt_div_iff' ha, ← div_eq_mul_one_div, div_lt_one (ha.trans h)]

lemma one_div_le_one_div_of_neg_of_le (hb : b < 0) (h : a ≤ b) : 1 / b ≤ 1 / a :=
by rwa [div_le_iff_of_neg' hb, ← div_eq_mul_one_div, div_le_one_of_neg (h.trans_lt hb)]

lemma one_div_lt_one_div_of_neg_of_lt (hb : b < 0) (h : a < b) : 1 / b < 1 / a :=
by rwa [div_lt_iff_of_neg' hb, ← div_eq_mul_one_div, div_lt_one_of_neg (h.trans hb)]

lemma le_of_one_div_le_one_div (ha : 0 < a) (h : 1 / a ≤ 1 / b) : b ≤ a :=
le_imp_le_of_lt_imp_lt (one_div_lt_one_div_of_lt ha) h

lemma lt_of_one_div_lt_one_div (ha : 0 < a) (h : 1 / a < 1 / b) : b < a :=
lt_imp_lt_of_le_imp_le (one_div_le_one_div_of_le ha) h

lemma le_of_neg_of_one_div_le_one_div (hb : b < 0) (h : 1 / a ≤ 1 / b) : b ≤ a :=
le_imp_le_of_lt_imp_lt (one_div_lt_one_div_of_neg_of_lt hb) h

lemma lt_of_neg_of_one_div_lt_one_div (hb : b < 0) (h : 1 / a < 1 / b) : b < a :=
lt_imp_lt_of_le_imp_le (one_div_le_one_div_of_neg_of_le hb) h

/-- For the single implications with fewer assumptions, see `one_div_le_one_div_of_le` and
  `le_of_one_div_le_one_div` -/
lemma one_div_le_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a ≤ 1 / b ↔ b ≤ a :=
div_le_div_left zero_lt_one ha hb

/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_lt` and
  `lt_of_one_div_lt_one_div` -/
lemma one_div_lt_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a < 1 / b ↔ b < a :=
div_lt_div_left zero_lt_one ha hb

/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_neg_of_lt` and
  `lt_of_one_div_lt_one_div` -/
lemma one_div_le_one_div_of_neg (ha : a < 0) (hb : b < 0) : 1 / a ≤ 1 / b ↔ b ≤ a :=
by simpa [one_div] using inv_le_inv_of_neg ha hb

/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_lt` and
  `lt_of_one_div_lt_one_div` -/
lemma one_div_lt_one_div_of_neg (ha : a < 0) (hb : b < 0) : 1 / a < 1 / b ↔ b < a :=
lt_iff_lt_of_le_iff_le (one_div_le_one_div_of_neg hb ha)

lemma one_lt_one_div (h1 : 0 < a) (h2 : a < 1) : 1 < 1 / a :=
by rwa [lt_one_div (@zero_lt_one α _ _) h1, one_div_one]

lemma one_le_one_div (h1 : 0 < a) (h2 : a ≤ 1) : 1 ≤ 1 / a :=
by rwa [le_one_div (@zero_lt_one α _ _) h1, one_div_one]

lemma one_div_lt_neg_one (h1 : a < 0) (h2 : -1 < a) : 1 / a < -1 :=
suffices 1 / a < 1 / -1, by rwa one_div_neg_one_eq_neg_one at this,
one_div_lt_one_div_of_neg_of_lt h1 h2

lemma one_div_le_neg_one (h1 : a < 0) (h2 : -1 ≤ a) : 1 / a ≤ -1 :=
suffices 1 / a ≤ 1 / -1, by rwa one_div_neg_one_eq_neg_one at this,
one_div_le_one_div_of_neg_of_le h1 h2

/-!
### Results about halving.

The equalities also hold in fields of characteristic `0`. -/
lemma add_halves (a : α) : a / 2 + a / 2 = a :=
by rw [div_add_div_same, ← two_mul, mul_div_cancel_left a two_ne_zero]

lemma sub_self_div_two (a : α) : a - a / 2 = a / 2 :=
suffices a / 2 + a / 2 - a / 2 = a / 2, by rwa add_halves at this,
by rw [add_sub_cancel]

lemma div_two_sub_self (a : α) : a / 2 - a = - (a / 2) :=
suffices a / 2 - (a / 2 + a / 2) = - (a / 2), by rwa add_halves at this,
by rw [sub_add_eq_sub_sub, sub_self, zero_sub]

lemma add_self_div_two (a : α) : (a + a) / 2 = a :=
by rw [← mul_two, mul_div_cancel a two_ne_zero]

lemma half_pos (h : 0 < a) : 0 < a / 2 := div_pos h zero_lt_two

lemma one_half_pos : (0:α) < 1 / 2 := half_pos zero_lt_one

lemma div_two_lt_of_pos (h : 0 < a) : a / 2 < a :=
by { rw [div_lt_iff (@zero_lt_two α _ _)], exact lt_mul_of_one_lt_right h one_lt_two }

lemma half_lt_self : 0 < a → a / 2 < a := div_two_lt_of_pos

lemma half_le_self (ha_nonneg : 0 ≤ a) : a / 2 ≤ a :=
begin
  by_cases h0 : a = 0,
  { simp [h0], },
  { rw ← ne.def at h0,
    exact (half_lt_self (lt_of_le_of_ne ha_nonneg h0.symm)).le, },
end

lemma one_half_lt_one : (1 / 2 : α) < 1 := half_lt_self zero_lt_one

lemma add_sub_div_two_lt (h : a < b) : a + (b - a) / 2 < b :=
begin
  rwa [← div_sub_div_same, sub_eq_add_neg, add_comm (b/2), ← add_assoc, ← sub_eq_add_neg,
    ← lt_sub_iff_add_lt, sub_self_div_two, sub_self_div_two, div_lt_div_right (@zero_lt_two α _ _)]
end

lemma left_lt_add_div_two : a < (a + b) / 2 ↔ a < b := by simp [lt_div_iff, mul_two]

lemma add_div_two_lt_right : (a + b) / 2 < b ↔ a < b := by simp [div_lt_iff, mul_two]

/--  An inequality involving `2`. -/
lemma sub_one_div_inv_le_two (a2 : 2 ≤ a) :
  (1 - 1 / a)⁻¹ ≤ 2 :=
begin
  -- Take inverses on both sides to obtain `2⁻¹ ≤ 1 - 1 / a`
  refine trans (inv_le_inv_of_le (inv_pos.mpr zero_lt_two) _) (inv_inv (2 : α)).le,
  -- move `1 / a` to the left and `1 - 1 / 2 = 1 / 2` to the right to obtain `1 / a ≤ ⅟ 2`
  refine trans ((le_sub_iff_add_le.mpr ((_ : _ + 2⁻¹ = _ ).le))) ((sub_le_sub_iff_left 1).mpr _),
  { -- show 2⁻¹ + 2⁻¹ = 1
    exact trans (two_mul _).symm (mul_inv_cancel two_ne_zero) },
  { -- take inverses on both sides and use the assumption `2 ≤ a`.
    exact (one_div a).le.trans (inv_le_inv_of_le zero_lt_two a2) }
end

/-!
### Miscellaneous lemmas
-/

/-- Pullback a `linear_ordered_field` under an injective map.
See note [reducible non-instances]. -/
@[reducible]
def function.injective.linear_ordered_field {β : Type*}
  [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β]
  [has_pow β ℕ] [has_scalar ℕ β] [has_scalar ℤ β] [has_nat_cast β] [has_int_cast β]
  [has_inv β] [has_div β] [has_pow β ℤ]
  (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y)
  (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y)
  (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x)
  (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n)
  (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) :
  linear_ordered_field β :=
{ .. hf.linear_ordered_ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast,
  .. hf.field f zero one add mul neg sub inv div nsmul zsmul npow zpow nat_cast int_cast }

lemma mul_sub_mul_div_mul_neg_iff (hc : c ≠ 0) (hd : d ≠ 0) :
  (a * d - b * c) / (c * d) < 0 ↔ a / c < b / d :=
by rw [mul_comm b c, ← div_sub_div _ _ hc hd, sub_lt_zero]

alias mul_sub_mul_div_mul_neg_iff ↔ div_lt_div_of_mul_sub_mul_div_neg mul_sub_mul_div_mul_neg

lemma mul_sub_mul_div_mul_nonpos_iff (hc : c ≠ 0) (hd : d ≠ 0) :
      (a * d - b * c) / (c * d) ≤ 0 ↔ a / c ≤ b / d :=
by rw [mul_comm b c, ← div_sub_div _ _ hc hd, sub_nonpos]

alias mul_sub_mul_div_mul_nonpos_iff ↔
  div_le_div_of_mul_sub_mul_div_nonpos mul_sub_mul_div_mul_nonpos

lemma mul_le_mul_of_mul_div_le (h : a * (b / c) ≤ d) (hc : 0 < c) : b * a ≤ d * c :=
begin
  rw [← mul_div_assoc] at h,
  rwa [mul_comm b, ← div_le_iff hc],
end

lemma div_mul_le_div_mul_of_div_le_div (h : a / b ≤ c / d) (he : 0 ≤ e) :
  a / (b * e) ≤ c / (d * e) :=
begin
  rw [div_mul_eq_div_mul_one_div, div_mul_eq_div_mul_one_div],
  exact mul_le_mul_of_nonneg_right h (one_div_nonneg.2 he)
end

lemma exists_add_lt_and_pos_of_lt (h : b < a) : ∃ c : α, b + c < a ∧ 0 < c :=
⟨(a - b) / 2, add_sub_div_two_lt h, div_pos (sub_pos_of_lt h) zero_lt_two⟩

lemma exists_pos_mul_lt {a : α} (h : 0 < a) (b : α) : ∃ c : α, 0 < c ∧ b * c < a :=
begin
  have : 0 < a / max (b + 1) 1, from div_pos h (lt_max_iff.2 (or.inr zero_lt_one)),
  refine ⟨a / max (b + 1) 1, this, _⟩,
  rw [← lt_div_iff this, div_div_cancel' h.ne'],
  exact lt_max_iff.2 (or.inl $ lt_add_one _)
end

lemma le_of_forall_sub_le (h : ∀ ε > 0, b - ε ≤ a) : b ≤ a :=
begin
  contrapose! h,
  simpa only [and_comm ((0 : α) < _), lt_sub_iff_add_lt, gt_iff_lt]
    using exists_add_lt_and_pos_of_lt h,
end

lemma monotone.div_const {β : Type*} [preorder β] {f : β → α} (hf : monotone f)
  {c : α} (hc : 0 ≤ c) : monotone (λ x, (f x) / c) :=
by simpa only [div_eq_mul_inv] using hf.mul_const (inv_nonneg.2 hc)

lemma strict_mono.div_const {β : Type*} [preorder β] {f : β → α} (hf : strict_mono f)
  {c : α} (hc : 0 < c) :
  strict_mono (λ x, (f x) / c) :=
by simpa only [div_eq_mul_inv] using hf.mul_const (inv_pos.2 hc)

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_field.to_densely_ordered : densely_ordered α :=
{ dense := λ a₁ a₂ h, ⟨(a₁ + a₂) / 2,
  calc a₁ = (a₁ + a₁) / 2 : (add_self_div_two a₁).symm
      ... < (a₁ + a₂) / 2 : div_lt_div_of_lt zero_lt_two (add_lt_add_left h _),
  calc (a₁ + a₂) / 2 < (a₂ + a₂) / 2 : div_lt_div_of_lt zero_lt_two (add_lt_add_right h _)
                 ... = a₂            : add_self_div_two a₂⟩ }

lemma mul_self_inj_of_nonneg (a0 : 0 ≤ a) (b0 : 0 ≤ b) : a * a = b * b ↔ a = b :=
mul_self_eq_mul_self_iff.trans $ or_iff_left_of_imp $
  λ h, by { subst a, have : b = 0 := le_antisymm (neg_nonneg.1 a0) b0, rw [this, neg_zero] }

lemma min_div_div_right {c : α} (hc : 0 ≤ c) (a b : α) : min (a / c) (b / c) = (min a b) / c :=
eq.symm $ monotone.map_min (λ x y, div_le_div_of_le hc)

lemma max_div_div_right {c : α} (hc : 0 ≤ c) (a b : α) : max (a / c) (b / c) = (max a b) / c :=
eq.symm $ monotone.map_max (λ x y, div_le_div_of_le hc)

lemma min_div_div_right_of_nonpos {c : α} (hc : c ≤ 0) (a b : α) :
  min (a / c) (b / c) = (max a b) / c :=
eq.symm $ antitone.map_max $ λ x y, div_le_div_of_nonpos_of_le hc

lemma max_div_div_right_of_nonpos {c : α} (hc : c ≤ 0) (a b : α) :
  max (a / c) (b / c) = (min a b) / c :=
eq.symm $ antitone.map_min $ λ x y, div_le_div_of_nonpos_of_le hc

lemma abs_div (a b : α) : |a / b| = |a| / |b| := (abs_hom : α →*₀ α).map_div a b

lemma abs_one_div (a : α) : |1 / a| = 1 / |a| :=
by rw [abs_div, abs_one]

lemma abs_inv (a : α) : |a⁻¹| = (|a|)⁻¹ := (abs_hom : α →*₀ α).map_inv a

lemma one_div_strict_anti_on : strict_anti_on (λ x : α, 1 / x) (set.Ioi 0) :=
λ x x1 y y1 xy, (one_div_lt_one_div (set.mem_Ioi.mp y1) (set.mem_Ioi.mp x1)).mpr xy

lemma one_div_pow_le_one_div_pow_of_le (a1 : 1 ≤ a) {m n : ℕ} (mn : m ≤ n) :
  1 / a ^ n ≤ 1 / a ^ m :=
by refine (one_div_le_one_div _ _).mpr (pow_le_pow a1 mn);
  exact pow_pos (zero_lt_one.trans_le a1) _

lemma one_div_pow_lt_one_div_pow_of_lt (a1 : 1 < a) {m n : ℕ} (mn : m < n) :
  1 / a ^ n < 1 / a ^ m :=
by refine (one_div_lt_one_div _ _).mpr (pow_lt_pow a1 mn);
  exact pow_pos (trans zero_lt_one a1) _

lemma one_div_pow_anti (a1 : 1 ≤ a) : antitone (λ n : ℕ, 1 / a ^ n) :=
λ m n, one_div_pow_le_one_div_pow_of_le a1

lemma one_div_pow_strict_anti (a1 : 1 < a) : strict_anti (λ n : ℕ, 1 / a ^ n) :=
λ m n, one_div_pow_lt_one_div_pow_of_lt a1

lemma inv_strict_anti_on : strict_anti_on (λ x : α, x⁻¹) (set.Ioi 0) :=
λ x hx y hy xy, (inv_lt_inv hy hx).2 xy

lemma inv_pow_le_inv_pow_of_le (a1 : 1 ≤ a) {m n : ℕ} (mn : m ≤ n) :
  (a ^ n)⁻¹ ≤ (a ^ m)⁻¹ :=
by convert one_div_pow_le_one_div_pow_of_le a1 mn; simp

lemma inv_pow_lt_inv_pow_of_lt (a1 : 1 < a) {m n : ℕ} (mn : m < n) :
  (a ^ n)⁻¹ < (a ^ m)⁻¹ :=
by convert one_div_pow_lt_one_div_pow_of_lt a1 mn; simp

lemma inv_pow_anti (a1 : 1 ≤ a) : antitone (λ n : ℕ, (a ^ n)⁻¹) :=
λ m n, inv_pow_le_inv_pow_of_le a1

lemma inv_pow_strict_anti (a1 : 1 < a) : strict_anti (λ n : ℕ, (a ^ n)⁻¹) :=
λ m n, inv_pow_lt_inv_pow_of_lt a1

/-! ### Results about `is_lub` and `is_glb` -/

lemma is_lub.mul_left {s : set α} (ha : 0 ≤ a) (hs : is_lub s b) :
  is_lub ((λ b, a * b) '' s) (a * b) :=
begin
  rcases lt_or_eq_of_le ha with ha | rfl,
  { exact (order_iso.mul_left₀ _ ha).is_lub_image'.2 hs, },
  { simp_rw zero_mul,
    rw hs.nonempty.image_const,
    exact is_lub_singleton },
end

lemma is_lub.mul_right {s : set α} (ha : 0 ≤ a) (hs : is_lub s b) :
  is_lub ((λ b, b * a) '' s) (b * a) :=
by simpa [mul_comm] using hs.mul_left ha

lemma is_glb.mul_left {s : set α} (ha : 0 ≤ a) (hs : is_glb s b) :
  is_glb ((λ b, a * b) '' s) (a * b) :=
begin
  rcases lt_or_eq_of_le ha with ha | rfl,
  { exact (order_iso.mul_left₀ _ ha).is_glb_image'.2 hs, },
  { simp_rw zero_mul,
    rw hs.nonempty.image_const,
    exact is_glb_singleton },
end

lemma is_glb.mul_right {s : set α} (ha : 0 ≤ a) (hs : is_glb s b) :
  is_glb ((λ b, b * a) '' s) (b * a) :=
by simpa [mul_comm] using hs.mul_left ha

end linear_ordered_field

section
variables {R : Type*} [linear_ordered_field R] {a : R}

lemma pow_minus_two_nonneg : 0 ≤ a^(-2 : ℤ) :=
begin
  simp only [inv_nonneg, zpow_neg],
  change 0 ≤ a ^ ((2 : ℕ) : ℤ),
  rw zpow_coe_nat,
  apply sq_nonneg,
end

/-- Bernoulli's inequality reformulated to estimate `(n : K)`. -/
theorem nat.cast_le_pow_sub_div_sub {K : Type*} [linear_ordered_field K] {a : K} (H : 1 < a)
  (n : ℕ) :
  (n : K) ≤ (a ^ n - 1) / (a - 1) :=
(le_div_iff (sub_pos.2 H)).2 $ le_sub_left_of_add_le $
  one_add_mul_sub_le_pow ((neg_le_self zero_le_one).trans H.le) _

/-- For any `a > 1` and a natural `n` we have `n ≤ a ^ n / (a - 1)`. See also
`nat.cast_le_pow_sub_div_sub` for a stronger inequality with `a ^ n - 1` in the numerator. -/
theorem nat.cast_le_pow_div_sub {K : Type*} [linear_ordered_field K] {a : K} (H : 1 < a) (n : ℕ) :
  (n : K) ≤ a ^ n / (a - 1) :=
(n.cast_le_pow_sub_div_sub H).trans $ div_le_div_of_le (sub_nonneg.2 H.le)
  (sub_le_self _ zero_le_one)

end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Floris van Doorn, Sébastien Gouëzel, Alex J. Best
-/
import data.list.big_operators.basic
import algebra.group.opposite
import algebra.group_power.basic
import algebra.group_with_zero.commute
import algebra.group_with_zero.divisibility
import algebra.order.with_zero
import algebra.ring.basic
import algebra.ring.divisibility
import algebra.ring.commute
import data.int.units
import data.set.basic

/-! # Lemmas about `list.sum` and `list.prod` requiring extra algebra imports

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

open mul_opposite list

variables {ι α M N P M₀ G R : Type*}

namespace commute

lemma list_sum_right [non_unital_non_assoc_semiring R] (a : R) (l : list R)
  (h : ∀ b ∈ l, commute a b) :
  commute a l.sum :=
begin
  induction l with x xs ih,
  { exact commute.zero_right _, },
  { rw list.sum_cons,
    exact (h _ $ mem_cons_self _ _).add_right (ih $ λ j hj, h _ $ mem_cons_of_mem _ hj) }
end

lemma list_sum_left [non_unital_non_assoc_semiring R] (b : R) (l : list R)
  (h : ∀ a ∈ l, commute a b) :
  commute l.sum b :=
(commute.list_sum_right _ _ $ λ x hx, (h _ hx).symm).symm

end commute

namespace list

@[to_additive card_nsmul_le_sum]
lemma pow_card_le_prod [monoid M] [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  (l : list M) (n : M) (h : ∀ (x ∈ l), n ≤ x) :
  n ^ l.length ≤ l.prod :=
@prod_le_pow_card Mᵒᵈ _ _ _ _ l n h

@[to_additive] lemma prod_eq_one_iff [canonically_ordered_monoid M] (l : list M) :
  l.prod = 1 ↔ ∀ x ∈ l, x = (1 : M) :=
⟨all_one_of_le_one_le_of_prod_eq_one (λ _ _, one_le _),
  λ h, by rw [eq_replicate.2 ⟨rfl, h⟩, prod_replicate, one_pow]⟩

/-- If a product of integers is `-1`, then at least one factor must be `-1`. -/
lemma neg_one_mem_of_prod_eq_neg_one {l : list ℤ} (h : l.prod = -1) : (-1 : ℤ) ∈ l :=
begin
  obtain ⟨x, h₁, h₂⟩ := exists_mem_ne_one_of_prod_ne_one (ne_of_eq_of_ne h dec_trivial),
  exact or.resolve_left (int.is_unit_iff.mp (prod_is_unit_iff.mp
         (h.symm ▸ is_unit.neg is_unit_one : is_unit l.prod) x h₁)) h₂ ▸ h₁,
end

/-- If all elements in a list are bounded below by `1`, then the length of the list is bounded
by the sum of the elements. -/
lemma length_le_sum_of_one_le (L : list ℕ) (h : ∀ i ∈ L, 1 ≤ i) : L.length ≤ L.sum :=
begin
  induction L with j L IH h, { simp },
  rw [sum_cons, length, add_comm],
  exact add_le_add (h _ (set.mem_insert _ _)) (IH (λ i hi, h i (set.mem_union_right _ hi)))
end

lemma dvd_prod [comm_monoid M] {a} {l : list M} (ha : a ∈ l) : a ∣ l.prod :=
let ⟨s, t, h⟩ := mem_split ha in
by { rw [h, prod_append, prod_cons, mul_left_comm], exact dvd_mul_right _ _ }

lemma dvd_sum [semiring R] {a} {l : list R} (h : ∀ x ∈ l, a ∣ x) : a ∣ l.sum :=
begin
  induction l with x l ih,
  { exact dvd_zero _ },
  { rw [list.sum_cons],
    exact dvd_add (h _ (mem_cons_self _ _)) (ih (λ x hx, h x (mem_cons_of_mem _ hx))) }
end

section alternating
variables [comm_group α]

@[to_additive]
lemma alternating_prod_append : ∀ l₁ l₂ : list α,
  alternating_prod (l₁ ++ l₂) = alternating_prod l₁ * alternating_prod l₂ ^ (-1 : ℤ) ^ length l₁
| [] l₂ := by simp
| (a :: l₁) l₂ := by simp_rw [cons_append, alternating_prod_cons, alternating_prod_append,
  length_cons, pow_succ, neg_mul, one_mul, zpow_neg, ←div_eq_mul_inv, div_div]

@[to_additive]
lemma alternating_prod_reverse :
  ∀ l : list α, alternating_prod (reverse l) = alternating_prod l ^ (-1 : ℤ) ^ (length l + 1)
| [] := by simp only [alternating_prod_nil, one_zpow, reverse_nil]
| (a :: l) :=
begin
  simp_rw [reverse_cons, alternating_prod_append, alternating_prod_reverse,
    alternating_prod_singleton, alternating_prod_cons, length_reverse, length, pow_succ, neg_mul,
    one_mul, zpow_neg, inv_inv],
  rw [mul_comm, ←div_eq_mul_inv, div_zpow],
end

end alternating

lemma sum_map_mul_left [non_unital_non_assoc_semiring R] (L : list ι) (f : ι → R) (r : R) :
  (L.map (λ b, r * f b)).sum = r * (L.map f).sum :=
sum_map_hom L f $ add_monoid_hom.mul_left r

lemma sum_map_mul_right [non_unital_non_assoc_semiring R] (L : list ι) (f : ι → R) (r : R) :
  (L.map (λ b, f b * r)).sum = (L.map f).sum * r :=
sum_map_hom L f $ add_monoid_hom.mul_right r

end list

namespace mul_opposite

open list
variables [monoid M]

lemma op_list_prod : ∀ (l : list M), op (l.prod) = (l.map op).reverse.prod
| [] := rfl
| (x :: xs) := by rw [list.prod_cons, list.map_cons, list.reverse_cons', list.prod_concat, op_mul,
                      op_list_prod]

lemma _root_.mul_opposite.unop_list_prod (l : list Mᵐᵒᵖ) :
  (l.prod).unop = (l.map unop).reverse.prod :=
by rw [← op_inj, op_unop, mul_opposite.op_list_prod, map_reverse, map_map, reverse_reverse,
  op_comp_unop, map_id]

end mul_opposite

section monoid_hom

variables [monoid M] [monoid N]

/-- A morphism into the opposite monoid acts on the product by acting on the reversed elements. -/
lemma unop_map_list_prod {F : Type*} [monoid_hom_class F M Nᵐᵒᵖ] (f : F) (l : list M) :
  (f l.prod).unop = (l.map (mul_opposite.unop ∘ f)).reverse.prod :=
by rw [map_list_prod f l, mul_opposite.unop_list_prod, list.map_map]

namespace monoid_hom

/-- A morphism into the opposite monoid acts on the product by acting on the reversed elements.

Deprecated, use `_root_.unop_map_list_prod` instead. -/
protected lemma unop_map_list_prod (f : M →* Nᵐᵒᵖ) (l : list M) :
  (f l.prod).unop = (l.map (mul_opposite.unop ∘ f)).reverse.prod :=
unop_map_list_prod f l

end monoid_hom
end monoid_hom