/-
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
-/
import data.set.pairwise

/-!
# Chains

This file defines chains for an arbitrary relation and proves Hausdorff's Maximality Principle.

## Main declarations

* `is_chain s`: A chain `s` is a set of comparable elements.
* `max_chain_spec`: Hausdorff's Maximality Principle.

## Notes

Originally ported from Isabelle/HOL. The
[original file](https://isabelle.in.tum.de/dist/library/HOL/HOL/Zorn.html) was written by Jacques D.
Fleuriot, Tobias Nipkow, Christian Sternagel.
-/

open classical set

variables {α β : Type*} (r : α → α → Prop)

local infix ` ≺ `:50 := r

section chain
variables (r)

/-- A chain is a set `s` satisfying `x ≺ y ∨ x = y ∨ y ≺ x` for all `x y ∈ s`. -/
def is_chain (s : set α) : Prop := s.pairwise (λ x y, x ≺ y ∨ y ≺ x)

/-- `super_chain s t` means that `t` is a chain that strictly includes `s`. -/
def super_chain (s t : set α) : Prop := is_chain r t ∧ s ⊂ t

/-- A chain `s` is a maximal chain if there does not exists a chain strictly including `s`. -/
def is_max_chain (s : set α) : Prop := is_chain r s ∧ ∀ ⦃t⦄, is_chain r t → s ⊆ t → s = t

variables {r} {c c₁ c₂ c₃ s t : set α} {a b x y : α}

lemma is_chain_empty : is_chain r ∅ := set.pairwise_empty _

lemma set.subsingleton.is_chain (hs : s.subsingleton) : is_chain r s := hs.pairwise _

lemma is_chain.mono : s ⊆ t → is_chain r t → is_chain r s := set.pairwise.mono

/-- This can be used to turn `is_chain (≥)` into `is_chain (≤)` and vice-versa. -/
lemma is_chain.symm (h : is_chain r s) : is_chain (flip r) s := h.mono' $ λ _ _, or.symm

lemma is_chain_of_trichotomous [is_trichotomous α r] (s : set α) : is_chain r s :=
λ a _ b _ hab, (trichotomous_of r a b).imp_right $ λ h, h.resolve_left hab

lemma is_chain.insert (hs : is_chain r s) (ha : ∀ b ∈ s, a ≠ b → a ≺ b ∨ b ≺ a) :
  is_chain r (insert a s) :=
hs.insert_of_symmetric (λ _ _, or.symm) ha

lemma is_chain_univ_iff : is_chain r (univ : set α) ↔ is_trichotomous α r :=
begin
  refine ⟨λ h, ⟨λ a b , _⟩, λ h, @is_chain_of_trichotomous _ _ h univ⟩,
  rw [or.left_comm, or_iff_not_imp_left],
  exact h trivial trivial,
end

lemma is_chain.image (r : α → α → Prop) (s : β → β → Prop) (f : α → β)
  (h : ∀ x y, r x y → s (f x) (f y)) {c : set α} (hrc : is_chain r c) :
  is_chain s (f '' c) :=
λ x ⟨a, ha₁, ha₂⟩ y ⟨b, hb₁, hb₂⟩, ha₂ ▸ hb₂ ▸ λ hxy,
  (hrc ha₁ hb₁ $ ne_of_apply_ne f hxy).imp (h _ _) (h _ _)

section total
variables [is_refl α r]

lemma is_chain.total (h : is_chain r s) (hx : x ∈ s) (hy : y ∈ s) : x ≺ y ∨ y ≺ x :=
(eq_or_ne x y).elim (λ e, or.inl $ e ▸ refl _) (h hx hy)

lemma is_chain.directed_on (H : is_chain r s) : directed_on r s :=
λ x hx y hy, (H.total hx hy).elim (λ h, ⟨y, hy, h, refl _⟩) $ λ h, ⟨x, hx, refl _, h⟩

protected lemma is_chain.directed {f : β → α} {c : set β} (h : is_chain (f ⁻¹'o r) c) :
  directed r (λ x : {a : β // a ∈ c}, f x) :=
λ ⟨a, ha⟩ ⟨b, hb⟩, by_cases
  (λ hab : a = b, by simp only [hab, exists_prop, and_self, subtype.exists];
    exact ⟨b, hb, refl _⟩) $
  λ hab, (h ha hb hab).elim (λ h, ⟨⟨b, hb⟩, h, refl _⟩) $ λ h, ⟨⟨a, ha⟩, refl _, h⟩

end total

lemma is_max_chain.is_chain (h : is_max_chain r s) : is_chain r s := h.1
lemma is_max_chain.not_super_chain (h : is_max_chain r s) : ¬super_chain r s t :=
λ ht, ht.2.ne $ h.2 ht.1 ht.2.1

open_locale classical

/-- Given a set `s`, if there exists a chain `t` strictly including `s`, then `succ_chain s`
is one of these chains. Otherwise it is `s`. -/
def succ_chain (r : α → α → Prop) (s : set α) : set α :=
if h : ∃ t, is_chain r s ∧ super_chain r s t then some h else s

lemma succ_chain_spec (h : ∃ t, is_chain r s ∧ super_chain r s t) :
  super_chain r s (succ_chain r s) :=
let ⟨t, hc'⟩ := h in
have is_chain r s ∧ super_chain r s (some h),
  from @some_spec _ (λ t, is_chain r s ∧ super_chain r s t) _,
by simp [succ_chain, dif_pos, h, this.right]

lemma is_chain.succ (hs : is_chain r s) : is_chain r (succ_chain r s) :=
if h : ∃ t, is_chain r s ∧ super_chain r s t then (succ_chain_spec h).1
  else by { simp [succ_chain, dif_neg, h], exact hs }

lemma is_chain.super_chain_succ_chain (hs₁ : is_chain r s) (hs₂ : ¬ is_max_chain r s) :
  super_chain r s (succ_chain r s) :=
begin
  simp [is_max_chain, not_and_distrib, not_forall_not] at hs₂,
  obtain ⟨t, ht, hst⟩ := hs₂.neg_resolve_left hs₁,
  exact succ_chain_spec ⟨t, hs₁, ht, ssubset_iff_subset_ne.2 hst⟩,
end

lemma subset_succ_chain : s ⊆ succ_chain r s :=
if h : ∃ t, is_chain r s ∧ super_chain r s t then (succ_chain_spec h).2.1
  else by simp [succ_chain, dif_neg, h, subset.rfl]

/-- Predicate for whether a set is reachable from `∅` using `succ_chain` and `⋃₀`. -/
inductive chain_closure (r : α → α → Prop) : set α → Prop
| succ : ∀ {s}, chain_closure s → chain_closure (succ_chain r s)
| union : ∀ {s}, (∀ a ∈ s, chain_closure a) → chain_closure (⋃₀ s)

/-- An explicit maximal chain. `max_chain` is taken to be the union of all sets in `chain_closure`.
-/
def max_chain (r : α → α → Prop) := ⋃₀ set_of (chain_closure r)

lemma chain_closure_empty : chain_closure r ∅ :=
have chain_closure r (⋃₀ ∅),
  from chain_closure.union $ λ a h, h.rec _,
by simpa using this

lemma chain_closure_max_chain : chain_closure r (max_chain r) := chain_closure.union $ λ s, id

private lemma chain_closure_succ_total_aux (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂)
  (h : ∀ ⦃c₃⦄, chain_closure r c₃ → c₃ ⊆ c₂ → c₂ = c₃ ∨ succ_chain r c₃ ⊆ c₂) :
  succ_chain r c₂ ⊆ c₁ ∨ c₁ ⊆ c₂ :=
begin
  induction hc₁,
  case succ : c₃ hc₃ ih
  { cases ih with ih ih,
    { exact or.inl (ih.trans subset_succ_chain) },
    { exact (h hc₃ ih).imp_left (λ h, h ▸ subset.rfl) } },
  case union : s hs ih
  { refine (or_iff_not_imp_left.2 $ λ hn, sUnion_subset $ λ a ha, _),
    exact (ih a ha).resolve_left (λ h, hn $ h.trans $ subset_sUnion_of_mem ha) }
end

private lemma chain_closure_succ_total (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂)
  (h : c₁ ⊆ c₂) :
  c₂ = c₁ ∨ succ_chain r c₁ ⊆ c₂ :=
begin
  induction hc₂ generalizing c₁ hc₁ h,
  case succ : c₂ hc₂ ih
  { refine (chain_closure_succ_total_aux hc₁ hc₂ $ λ c₁, ih).imp h.antisymm' (λ h₁, _),
    obtain rfl | h₂ := ih hc₁ h₁,
    { exact subset.rfl },
    { exact h₂.trans subset_succ_chain } },
  case union : s hs ih
  { apply or.imp_left h.antisymm',
    apply classical.by_contradiction,
    simp [not_or_distrib, sUnion_subset_iff, not_forall],
    intros c₃ hc₃ h₁ h₂,
    obtain h | h := chain_closure_succ_total_aux hc₁ (hs c₃ hc₃) (λ c₄, ih _ hc₃),
    { exact h₁ (subset_succ_chain.trans h) },
    obtain h' | h' := ih c₃ hc₃ hc₁ h,
    { exact h₁ h'.subset },
    { exact h₂ (h'.trans $ subset_sUnion_of_mem hc₃) } }
end

lemma chain_closure.total (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂) :
  c₁ ⊆ c₂ ∨ c₂ ⊆ c₁ :=
(chain_closure_succ_total_aux hc₂ hc₁ $ λ c₃ hc₃, chain_closure_succ_total hc₃ hc₁).imp_left
  subset_succ_chain.trans

lemma chain_closure.succ_fixpoint (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂)
  (hc : succ_chain r c₂ = c₂) :
  c₁ ⊆ c₂ :=
begin
  induction hc₁,
  case succ : s₁ hc₁ h
  { exact (chain_closure_succ_total hc₁ hc₂ h).elim (λ h, h ▸ hc.subset) id },
  case union : s hs ih
  { exact sUnion_subset ih }
end

lemma chain_closure.succ_fixpoint_iff (hc : chain_closure r c) :
  succ_chain r c = c ↔ c = max_chain r :=
⟨λ h, (subset_sUnion_of_mem hc).antisymm $ chain_closure_max_chain.succ_fixpoint hc h,
  λ h, subset_succ_chain.antisymm' $ (subset_sUnion_of_mem hc.succ).trans h.symm.subset⟩

lemma chain_closure.is_chain (hc : chain_closure r c) : is_chain r c :=
begin
  induction hc,
  case succ : c hc h
  { exact h.succ },
  case union : s hs h
  { change ∀ c ∈ s, is_chain r c at h,
    exact λ c₁ ⟨t₁, ht₁, (hc₁ : c₁ ∈ t₁)⟩ c₂ ⟨t₂, ht₂, (hc₂ : c₂ ∈ t₂)⟩ hneq,
      ((hs _ ht₁).total $ hs _ ht₂).elim
        (λ ht, h t₂ ht₂ (ht hc₁) hc₂ hneq)
        (λ ht, h t₁ ht₁ hc₁ (ht hc₂) hneq) }
end

/-- **Hausdorff's maximality principle**

There exists a maximal totally ordered set of `α`.
Note that we do not require `α` to be partially ordered by `r`. -/
lemma max_chain_spec : is_max_chain r (max_chain r) :=
classical.by_contradiction $ λ h,
let ⟨h₁, H⟩ := chain_closure_max_chain.is_chain.super_chain_succ_chain h in
  H.ne (chain_closure_max_chain.succ_fixpoint_iff.mpr rfl).symm

end chain


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Frédéric Dupuis, Heather Macbeth
-/
import analysis.normed.group.basic
import topology.algebra.module.basic
import linear_algebra.basis

/-!
# (Semi-)linear isometries

In this file we define `linear_isometry σ₁₂ E E₂` (notation: `E →ₛₗᵢ[σ₁₂] E₂`) to be a semilinear
isometric embedding of `E` into `E₂` and `linear_isometry_equiv` (notation: `E ≃ₛₗᵢ[σ₁₂] E₂`) to be
a semilinear isometric equivalence between `E` and `E₂`.  The notation for the associated purely
linear concepts is `E →ₗᵢ[R] E₂`, `E ≃ₗᵢ[R] E₂`, and `E →ₗᵢ⋆[R] E₂`, `E ≃ₗᵢ⋆[R] E₂` for
the star-linear versions.

We also prove some trivial lemmas and provide convenience constructors.

Since a lot of elementary properties don't require `∥x∥ = 0 → x = 0` we start setting up the
theory for `semi_normed_group` and we specialize to `normed_group` when needed.
-/
open function set

variables {R R₂ R₃ R₄ E E₂ E₃ E₄ F : Type*} [semiring R] [semiring R₂] [semiring R₃] [semiring R₄]
  {σ₁₂ : R →+* R₂} {σ₂₁ : R₂ →+* R} {σ₁₃ : R →+* R₃} {σ₃₁ : R₃ →+* R} {σ₁₄ : R →+* R₄}
  {σ₄₁ : R₄ →+* R} {σ₂₃ : R₂ →+* R₃} {σ₃₂ : R₃ →+* R₂} {σ₂₄ : R₂ →+* R₄} {σ₄₂ : R₄ →+* R₂}
  {σ₃₄ : R₃ →+* R₄} {σ₄₃ : R₄ →+* R₃}
  [ring_hom_inv_pair σ₁₂ σ₂₁] [ring_hom_inv_pair σ₂₁ σ₁₂]
  [ring_hom_inv_pair σ₁₃ σ₃₁] [ring_hom_inv_pair σ₃₁ σ₁₃]
  [ring_hom_inv_pair σ₂₃ σ₃₂] [ring_hom_inv_pair σ₃₂ σ₂₃]
  [ring_hom_inv_pair σ₁₄ σ₄₁] [ring_hom_inv_pair σ₄₁ σ₁₄]
  [ring_hom_inv_pair σ₂₄ σ₄₂] [ring_hom_inv_pair σ₄₂ σ₂₄]
  [ring_hom_inv_pair σ₃₄ σ₄₃] [ring_hom_inv_pair σ₄₃ σ₃₄]
  [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] [ring_hom_comp_triple σ₁₂ σ₂₄ σ₁₄]
  [ring_hom_comp_triple σ₂₃ σ₃₄ σ₂₄] [ring_hom_comp_triple σ₁₃ σ₃₄ σ₁₄]
  [ring_hom_comp_triple σ₃₂ σ₂₁ σ₃₁] [ring_hom_comp_triple σ₄₂ σ₂₁ σ₄₁]
  [ring_hom_comp_triple σ₄₃ σ₃₂ σ₄₂] [ring_hom_comp_triple σ₄₃ σ₃₁ σ₄₁]
  [semi_normed_group E] [semi_normed_group E₂] [semi_normed_group E₃] [semi_normed_group E₄]
  [module R E] [module R₂ E₂] [module R₃ E₃] [module R₄ E₄]
  [normed_group F] [module R F]

/-- A `σ₁₂`-semilinear isometric embedding of a normed `R`-module into an `R₂`-module. -/
structure linear_isometry (σ₁₂ : R →+* R₂) (E E₂ : Type*) [semi_normed_group E]
  [semi_normed_group E₂] [module R E] [module R₂ E₂] extends E →ₛₗ[σ₁₂] E₂ :=
(norm_map' : ∀ x, ∥to_linear_map x∥ = ∥x∥)

notation E ` →ₛₗᵢ[`:25 σ₁₂:25 `] `:0 E₂:0 := linear_isometry σ₁₂ E E₂
notation E ` →ₗᵢ[`:25 R:25 `] `:0 E₂:0 := linear_isometry (ring_hom.id R) E E₂
notation E ` →ₗᵢ⋆[`:25 R:25 `] `:0 E₂:0 := linear_isometry (star_ring_end R) E E₂

namespace linear_isometry

/-- We use `f₁` when we need the domain to be a `normed_space`. -/
variables (f : E →ₛₗᵢ[σ₁₂] E₂) (f₁ : F →ₛₗᵢ[σ₁₂] E₂)

lemma to_linear_map_injective : injective (to_linear_map : (E →ₛₗᵢ[σ₁₂] E₂) → (E →ₛₗ[σ₁₂] E₂))
| ⟨f, _⟩ ⟨g, _⟩ rfl := rfl

@[simp] lemma to_linear_map_inj {f g : E →ₛₗᵢ[σ₁₂] E₂} :
  f.to_linear_map = g.to_linear_map ↔ f = g := to_linear_map_injective.eq_iff

instance : add_monoid_hom_class (E →ₛₗᵢ[σ₁₂] E₂) E E₂ :=
{ coe := λ e, e.to_fun,
  coe_injective' := λ f g h, to_linear_map_injective (fun_like.coe_injective h),
  map_add := λ f, map_add f.to_linear_map,
  map_zero := λ f, map_zero f.to_linear_map }

/-- Helper instance for when there's too many metavariables to apply `to_fun.to_coe_fn` directly.
-/
instance : has_coe_to_fun (E →ₛₗᵢ[σ₁₂] E₂) (λ _, E → E₂) := ⟨λ f, f.to_fun⟩

@[simp] lemma coe_to_linear_map : ⇑f.to_linear_map = f := rfl

lemma coe_injective : @injective (E →ₛₗᵢ[σ₁₂] E₂) (E → E₂) coe_fn :=
fun_like.coe_injective

@[ext] lemma ext {f g : E →ₛₗᵢ[σ₁₂] E₂} (h : ∀ x, f x = g x) : f = g :=
coe_injective $ funext h

protected lemma congr_arg {f : E →ₛₗᵢ[σ₁₂] E₂} : Π {x x' : E}, x = x' → f x = f x'
| _ _ rfl := rfl

protected lemma congr_fun {f g : E →ₛₗᵢ[σ₁₂] E₂} (h : f = g) (x : E) : f x = g x := h ▸ rfl

@[simp] lemma map_zero : f 0 = 0 := f.to_linear_map.map_zero

@[simp] lemma map_add (x y : E) : f (x + y) = f x + f y := f.to_linear_map.map_add x y

@[simp] lemma map_neg (x : E) : f (- x) = - f x := f.to_linear_map.map_neg x

@[simp] lemma map_sub (x y : E) : f (x - y) = f x - f y := f.to_linear_map.map_sub x y

@[simp] lemma map_smulₛₗ (c : R) (x : E) : f (c • x) = σ₁₂ c • f x := f.to_linear_map.map_smulₛₗ c x

@[simp] lemma map_smul [module R E₂] (f : E →ₗᵢ[R] E₂) (c : R) (x : E) : f (c • x) = c • f x :=
f.to_linear_map.map_smul c x

@[simp] lemma norm_map (x : E) : ∥f x∥ = ∥x∥ := f.norm_map' x

@[simp] lemma nnnorm_map (x : E) : nnnorm (f x) = nnnorm x := nnreal.eq $ f.norm_map x

protected lemma isometry : isometry f :=
f.to_linear_map.to_add_monoid_hom.isometry_of_norm f.norm_map

@[simp] lemma is_complete_image_iff {s : set E} : is_complete (f '' s) ↔ is_complete s :=
is_complete_image_iff f.isometry.uniform_inducing

lemma is_complete_map_iff [ring_hom_surjective σ₁₂] {p : submodule R E} :
  is_complete (p.map f.to_linear_map : set E₂) ↔ is_complete (p : set E) :=
f.is_complete_image_iff

instance complete_space_map [ring_hom_surjective σ₁₂] (p : submodule R E) [complete_space p] :
  complete_space (p.map f.to_linear_map) :=
(f.is_complete_map_iff.2 $ complete_space_coe_iff_is_complete.1 ‹_›).complete_space_coe

@[simp] lemma dist_map (x y : E) : dist (f x) (f y) = dist x y := f.isometry.dist_eq x y
@[simp] lemma edist_map (x y : E) : edist (f x) (f y) = edist x y := f.isometry.edist_eq x y

protected lemma injective : injective f₁ := f₁.isometry.injective

@[simp] lemma map_eq_iff {x y : F} : f₁ x = f₁ y ↔ x = y := f₁.injective.eq_iff

lemma map_ne {x y : F} (h : x ≠ y) : f₁ x ≠ f₁ y := f₁.injective.ne h

protected lemma lipschitz : lipschitz_with 1 f := f.isometry.lipschitz

protected lemma antilipschitz : antilipschitz_with 1 f := f.isometry.antilipschitz

@[continuity] protected lemma continuous : continuous f := f.isometry.continuous

lemma ediam_image (s : set E) : emetric.diam (f '' s) = emetric.diam s :=
f.isometry.ediam_image s

lemma ediam_range : emetric.diam (range f) = emetric.diam (univ : set E) :=
f.isometry.ediam_range

lemma diam_image (s : set E) : metric.diam (f '' s) = metric.diam s :=
f.isometry.diam_image s

lemma diam_range : metric.diam (range f) = metric.diam (univ : set E) :=
f.isometry.diam_range

/-- Interpret a linear isometry as a continuous linear map. -/
def to_continuous_linear_map : E →SL[σ₁₂] E₂ := ⟨f.to_linear_map, f.continuous⟩

lemma to_continuous_linear_map_injective :
  function.injective (to_continuous_linear_map : _ → E →SL[σ₁₂] E₂) :=
λ x y h, coe_injective (congr_arg _ h : ⇑x.to_continuous_linear_map = _)

@[simp] lemma to_continuous_linear_map_inj {f g : E →ₛₗᵢ[σ₁₂] E₂} :
  f.to_continuous_linear_map = g.to_continuous_linear_map ↔ f = g :=
to_continuous_linear_map_injective.eq_iff

@[simp] lemma coe_to_continuous_linear_map : ⇑f.to_continuous_linear_map = f := rfl

@[simp] lemma comp_continuous_iff {α : Type*} [topological_space α] {g : α → E} :
  continuous (f ∘ g) ↔ continuous g :=
f.isometry.comp_continuous_iff

/-- The identity linear isometry. -/
def id : E →ₗᵢ[R] E := ⟨linear_map.id, λ x, rfl⟩

@[simp] lemma coe_id : ((id : E →ₗᵢ[R] E) : E → E) = _root_.id := rfl

@[simp] lemma id_apply (x : E) : (id : E →ₗᵢ[R] E) x = x := rfl

@[simp] lemma id_to_linear_map : (id.to_linear_map : E →ₗ[R] E) = linear_map.id := rfl

instance : inhabited (E →ₗᵢ[R] E) := ⟨id⟩

/-- Composition of linear isometries. -/
def comp (g : E₂ →ₛₗᵢ[σ₂₃] E₃) (f : E →ₛₗᵢ[σ₁₂] E₂) : E →ₛₗᵢ[σ₁₃] E₃ :=
⟨g.to_linear_map.comp f.to_linear_map, λ x, (g.norm_map _).trans (f.norm_map _)⟩

include σ₁₃
@[simp] lemma coe_comp (g : E₂ →ₛₗᵢ[σ₂₃] E₃) (f : E →ₛₗᵢ[σ₁₂] E₂) :
  ⇑(g.comp f) = g ∘ f :=
rfl
omit σ₁₃

@[simp] lemma id_comp : (id : E₂ →ₗᵢ[R₂] E₂).comp f = f := ext $ λ x, rfl

@[simp] lemma comp_id : f.comp id = f := ext $ λ x, rfl

include σ₁₃ σ₂₄ σ₁₄
lemma comp_assoc (f : E₃ →ₛₗᵢ[σ₃₄] E₄) (g : E₂ →ₛₗᵢ[σ₂₃] E₃) (h : E →ₛₗᵢ[σ₁₂] E₂) :
  (f.comp g).comp h = f.comp (g.comp h) :=
rfl
omit σ₁₃ σ₂₄ σ₁₄

instance : monoid (E →ₗᵢ[R] E) :=
{ one := id,
  mul := comp,
  mul_assoc := comp_assoc,
  one_mul := id_comp,
  mul_one := comp_id }

@[simp] lemma coe_one : ((1 : E →ₗᵢ[R] E) : E → E) = _root_.id := rfl
@[simp] lemma coe_mul (f g : E →ₗᵢ[R] E) : ⇑(f * g) = f ∘ g := rfl

lemma one_def : (1 : E →ₗᵢ[R] E) = id := rfl
lemma mul_def (f g : E →ₗᵢ[R] E) : (f * g : E →ₗᵢ[R] E) = f.comp g := rfl

end linear_isometry

/-- Construct a `linear_isometry` from a `linear_map` satisfying `isometry`. -/
def linear_map.to_linear_isometry (f : E →ₛₗ[σ₁₂] E₂) (hf : isometry f) : E →ₛₗᵢ[σ₁₂] E₂ :=
{ norm_map' := by { simp_rw [←dist_zero_right, ←f.map_zero], exact λ x, hf.dist_eq x _ },
  .. f }

namespace submodule

variables {R' : Type*} [ring R'] [module R' E] (p : submodule R' E)

/-- `submodule.subtype` as a `linear_isometry`. -/
def subtypeₗᵢ : p →ₗᵢ[R'] E := ⟨p.subtype, λ x, rfl⟩

@[simp] lemma coe_subtypeₗᵢ : ⇑p.subtypeₗᵢ = p.subtype := rfl

@[simp] lemma subtypeₗᵢ_to_linear_map : p.subtypeₗᵢ.to_linear_map = p.subtype := rfl

/-- `submodule.subtype` as a `continuous_linear_map`. -/
def subtypeL : p →L[R'] E := p.subtypeₗᵢ.to_continuous_linear_map

@[simp] lemma coe_subtypeL : (p.subtypeL : p →ₗ[R'] E) = p.subtype := rfl

@[simp] lemma coe_subtypeL' : ⇑p.subtypeL = p.subtype := rfl

@[simp] lemma range_subtypeL : p.subtypeL.range = p :=
range_subtype _

@[simp] lemma ker_subtypeL : p.subtypeL.ker = ⊥ :=
ker_subtype _

end submodule

/-- A semilinear isometric equivalence between two normed vector spaces. -/
structure linear_isometry_equiv (σ₁₂ : R →+* R₂) {σ₂₁ : R₂ →+* R} [ring_hom_inv_pair σ₁₂ σ₂₁]
  [ring_hom_inv_pair σ₂₁ σ₁₂] (E E₂ : Type*) [semi_normed_group E] [semi_normed_group E₂]
  [module R E] [module R₂ E₂] extends E ≃ₛₗ[σ₁₂] E₂ :=
(norm_map' : ∀ x, ∥to_linear_equiv x∥ = ∥x∥)

notation E ` ≃ₛₗᵢ[`:25 σ₁₂:25 `] `:0 E₂:0 := linear_isometry_equiv σ₁₂ E E₂
notation E ` ≃ₗᵢ[`:25 R:25 `] `:0 E₂:0 := linear_isometry_equiv (ring_hom.id R) E E₂
notation E ` ≃ₗᵢ⋆[`:25 R:25 `] `:0 E₂:0 :=
  linear_isometry_equiv (star_ring_end R) E E₂

namespace linear_isometry_equiv

variables (e : E ≃ₛₗᵢ[σ₁₂] E₂)

include σ₂₁

lemma to_linear_equiv_injective : injective (to_linear_equiv : (E ≃ₛₗᵢ[σ₁₂] E₂) → (E ≃ₛₗ[σ₁₂] E₂))
| ⟨e, _⟩ ⟨_, _⟩ rfl := rfl

@[simp] lemma to_linear_equiv_inj {f g : E ≃ₛₗᵢ[σ₁₂] E₂} :
  f.to_linear_equiv = g.to_linear_equiv ↔ f = g :=
to_linear_equiv_injective.eq_iff

instance : add_monoid_hom_class (E ≃ₛₗᵢ[σ₁₂] E₂) E E₂ :=
{ coe := λ e, e.to_fun,
  coe_injective' := λ f g h, to_linear_equiv_injective (fun_like.coe_injective h),
  map_add := λ f, map_add f.to_linear_equiv,
  map_zero := λ f, map_zero f.to_linear_equiv }

/-- Helper instance for when there's too many metavariables to apply `to_fun.to_coe_fn` directly.
-/
instance : has_coe_to_fun (E ≃ₛₗᵢ[σ₁₂] E₂) (λ _, E → E₂) := ⟨λ f, f.to_fun⟩

lemma coe_injective : @function.injective (E ≃ₛₗᵢ[σ₁₂] E₂) (E → E₂) coe_fn :=
fun_like.coe_injective

@[simp] lemma coe_mk (e : E ≃ₛₗ[σ₁₂] E₂) (he : ∀ x, ∥e x∥ = ∥x∥) :
  ⇑(mk e he) = e :=
rfl

@[simp] lemma coe_to_linear_equiv (e : E ≃ₛₗᵢ[σ₁₂] E₂) : ⇑e.to_linear_equiv = e := rfl

@[ext] lemma ext {e e' : E ≃ₛₗᵢ[σ₁₂] E₂} (h : ∀ x, e x = e' x) : e = e' :=
to_linear_equiv_injective $ linear_equiv.ext h

protected lemma congr_arg {f : E ≃ₛₗᵢ[σ₁₂] E₂} : Π {x x' : E}, x = x' → f x = f x'
| _ _ rfl := rfl

protected lemma congr_fun {f g : E ≃ₛₗᵢ[σ₁₂] E₂} (h : f = g) (x : E) : f x = g x := h ▸ rfl

/-- Construct a `linear_isometry_equiv` from a `linear_equiv` and two inequalities:
`∀ x, ∥e x∥ ≤ ∥x∥` and `∀ y, ∥e.symm y∥ ≤ ∥y∥`. -/
def of_bounds (e : E ≃ₛₗ[σ₁₂] E₂) (h₁ : ∀ x, ∥e x∥ ≤ ∥x∥) (h₂ : ∀ y, ∥e.symm y∥ ≤ ∥y∥) :
  E ≃ₛₗᵢ[σ₁₂] E₂ :=
⟨e, λ x, le_antisymm (h₁ x) $ by simpa only [e.symm_apply_apply] using h₂ (e x)⟩

@[simp] lemma norm_map (x : E) : ∥e x∥ = ∥x∥ := e.norm_map' x

/-- Reinterpret a `linear_isometry_equiv` as a `linear_isometry`. -/
def to_linear_isometry : E →ₛₗᵢ[σ₁₂] E₂ := ⟨e.1, e.2⟩

lemma to_linear_isometry_injective :
  function.injective (to_linear_isometry : _ → E →ₛₗᵢ[σ₁₂] E₂) :=
λ x y h, coe_injective (congr_arg _ h : ⇑x.to_linear_isometry = _)

@[simp] lemma to_linear_isometry_inj {f g : E ≃ₛₗᵢ[σ₁₂] E₂} :
  f.to_linear_isometry = g.to_linear_isometry ↔ f = g :=
to_linear_isometry_injective.eq_iff

@[simp] lemma coe_to_linear_isometry : ⇑e.to_linear_isometry = e := rfl

protected lemma isometry : isometry e := e.to_linear_isometry.isometry

/-- Reinterpret a `linear_isometry_equiv` as an `isometric`. -/
def to_isometric : E ≃ᵢ E₂ := ⟨e.to_linear_equiv.to_equiv, e.isometry⟩

lemma to_isometric_injective :
  function.injective (to_isometric : (E ≃ₛₗᵢ[σ₁₂] E₂) → E ≃ᵢ E₂) :=
λ x y h, coe_injective (congr_arg _ h : ⇑x.to_isometric = _)

@[simp] lemma to_isometric_inj {f g : E ≃ₛₗᵢ[σ₁₂] E₂} :
  f.to_isometric = g.to_isometric ↔ f = g :=
to_isometric_injective.eq_iff

@[simp] lemma coe_to_isometric : ⇑e.to_isometric = e := rfl

lemma range_eq_univ (e : E ≃ₛₗᵢ[σ₁₂] E₂) : set.range e = set.univ :=
by { rw ← coe_to_isometric, exact isometric.range_eq_univ _, }

/-- Reinterpret a `linear_isometry_equiv` as an `homeomorph`. -/
def to_homeomorph : E ≃ₜ E₂ := e.to_isometric.to_homeomorph

lemma to_homeomorph_injective :
  function.injective (to_homeomorph : (E ≃ₛₗᵢ[σ₁₂] E₂) → E ≃ₜ E₂) :=
λ x y h, coe_injective (congr_arg _ h : ⇑x.to_homeomorph = _)

@[simp] lemma to_homeomorph_inj {f g : E ≃ₛₗᵢ[σ₁₂] E₂} :
  f.to_homeomorph = g.to_homeomorph ↔ f = g :=
to_homeomorph_injective.eq_iff

@[simp] lemma coe_to_homeomorph : ⇑e.to_homeomorph = e := rfl

protected lemma continuous : continuous e := e.isometry.continuous
protected lemma continuous_at {x} : continuous_at e x := e.continuous.continuous_at
protected lemma continuous_on {s} : continuous_on e s := e.continuous.continuous_on

protected lemma continuous_within_at {s x} : continuous_within_at e s x :=
e.continuous.continuous_within_at

/-- Interpret a `linear_isometry_equiv` as a continuous linear equiv. -/
def to_continuous_linear_equiv : E ≃SL[σ₁₂] E₂ :=
{ .. e.to_linear_isometry.to_continuous_linear_map,
  .. e.to_homeomorph }

lemma to_continuous_linear_equiv_injective :
  function.injective (to_continuous_linear_equiv : _ → E ≃SL[σ₁₂] E₂) :=
λ x y h, coe_injective (congr_arg _ h : ⇑x.to_continuous_linear_equiv = _)

@[simp] lemma to_continuous_linear_equiv_inj {f g : E ≃ₛₗᵢ[σ₁₂] E₂} :
  f.to_continuous_linear_equiv = g.to_continuous_linear_equiv ↔ f = g :=
to_continuous_linear_equiv_injective.eq_iff

@[simp] lemma coe_to_continuous_linear_equiv : ⇑e.to_continuous_linear_equiv = e := rfl

omit σ₂₁

variables (R E)

/-- Identity map as a `linear_isometry_equiv`. -/
def refl : E ≃ₗᵢ[R] E := ⟨linear_equiv.refl R E, λ x, rfl⟩

variables {R E}

instance : inhabited (E ≃ₗᵢ[R] E) := ⟨refl R E⟩

@[simp] lemma coe_refl : ⇑(refl R E) = id := rfl

/-- The inverse `linear_isometry_equiv`. -/
def symm : E₂ ≃ₛₗᵢ[σ₂₁] E :=
⟨e.to_linear_equiv.symm,
  λ x, (e.norm_map _).symm.trans $ congr_arg norm $ e.to_linear_equiv.apply_symm_apply x⟩

@[simp] lemma apply_symm_apply (x : E₂) : e (e.symm x) = x := e.to_linear_equiv.apply_symm_apply x
@[simp] lemma symm_apply_apply (x : E) : e.symm (e x) = x := e.to_linear_equiv.symm_apply_apply x
@[simp] lemma map_eq_zero_iff {x : E} : e x = 0 ↔ x = 0 := e.to_linear_equiv.map_eq_zero_iff
@[simp] lemma symm_symm : e.symm.symm = e := ext $ λ x, rfl

@[simp] lemma to_linear_equiv_symm : e.to_linear_equiv.symm = e.symm.to_linear_equiv := rfl
@[simp] lemma to_isometric_symm : e.to_isometric.symm = e.symm.to_isometric := rfl
@[simp] lemma to_homeomorph_symm : e.to_homeomorph.symm = e.symm.to_homeomorph := rfl

include σ₃₁ σ₃₂
/-- Composition of `linear_isometry_equiv`s as a `linear_isometry_equiv`. -/
def trans (e' : E₂ ≃ₛₗᵢ[σ₂₃] E₃) : E ≃ₛₗᵢ[σ₁₃] E₃ :=
⟨e.to_linear_equiv.trans e'.to_linear_equiv, λ x, (e'.norm_map _).trans (e.norm_map _)⟩

include σ₁₃ σ₂₁
@[simp] lemma coe_trans (e₁ : E ≃ₛₗᵢ[σ₁₂] E₂) (e₂ : E₂ ≃ₛₗᵢ[σ₂₃] E₃) : ⇑(e₁.trans e₂) = e₂ ∘ e₁ :=
rfl

@[simp] lemma to_linear_equiv_trans (e' : E₂ ≃ₛₗᵢ[σ₂₃] E₃) :
  (e.trans e').to_linear_equiv = e.to_linear_equiv.trans e'.to_linear_equiv :=
rfl

omit σ₁₃ σ₂₁ σ₃₁ σ₃₂

@[simp] lemma trans_refl : e.trans (refl R₂ E₂) = e := ext $ λ x, rfl
@[simp] lemma refl_trans : (refl R E).trans e = e := ext $ λ x, rfl
@[simp] lemma self_trans_symm : e.trans e.symm = refl R E := ext e.symm_apply_apply
@[simp] lemma symm_trans_self : e.symm.trans e = refl R₂ E₂ := ext e.apply_symm_apply
@[simp] lemma symm_comp_self : e.symm ∘ e = id := funext e.symm_apply_apply
@[simp] lemma self_comp_symm : e ∘ e.symm = id := e.symm.symm_comp_self

include σ₁₃ σ₂₁ σ₃₂ σ₃₁
@[simp] lemma coe_symm_trans (e₁ : E ≃ₛₗᵢ[σ₁₂] E₂) (e₂ : E₂ ≃ₛₗᵢ[σ₂₃] E₃) :
  ⇑(e₁.trans e₂).symm = e₁.symm ∘ e₂.symm :=
rfl

include σ₁₄ σ₄₁ σ₄₂ σ₄₃ σ₂₄
lemma trans_assoc (eEE₂ : E ≃ₛₗᵢ[σ₁₂] E₂) (eE₂E₃ : E₂ ≃ₛₗᵢ[σ₂₃] E₃) (eE₃E₄ : E₃ ≃ₛₗᵢ[σ₃₄] E₄) :
  eEE₂.trans (eE₂E₃.trans eE₃E₄) = (eEE₂.trans eE₂E₃).trans eE₃E₄ :=
rfl
omit σ₂₁ σ₃₁ σ₄₁ σ₃₂ σ₄₂ σ₄₃ σ₁₃ σ₂₄ σ₁₄

instance : group (E ≃ₗᵢ[R] E) :=
{ mul := λ e₁ e₂, e₂.trans e₁,
  one := refl _ _,
  inv := symm,
  one_mul := trans_refl,
  mul_one := refl_trans,
  mul_assoc := λ _ _ _, trans_assoc _ _ _,
  mul_left_inv := self_trans_symm }

@[simp] lemma coe_one : ⇑(1 : E ≃ₗᵢ[R] E) = id := rfl
@[simp] lemma coe_mul (e e' : E ≃ₗᵢ[R] E) : ⇑(e * e') = e ∘ e' := rfl
@[simp] lemma coe_inv (e : E ≃ₗᵢ[R] E) : ⇑(e⁻¹) = e.symm := rfl

lemma one_def : (1 : E ≃ₗᵢ[R] E) = refl _ _ := rfl
lemma mul_def (e e' : E ≃ₗᵢ[R] E) : (e * e' : E ≃ₗᵢ[R] E) = e'.trans e := rfl
lemma inv_def (e : E ≃ₗᵢ[R] E) : (e⁻¹ : E ≃ₗᵢ[R] E) = e.symm := rfl

include σ₂₁

/-- Reinterpret a `linear_isometry_equiv` as a `continuous_linear_equiv`. -/
instance : has_coe_t (E ≃ₛₗᵢ[σ₁₂] E₂) (E ≃SL[σ₁₂] E₂) :=
⟨λ e, ⟨e.to_linear_equiv, e.continuous, e.to_isometric.symm.continuous⟩⟩

instance : has_coe_t (E ≃ₛₗᵢ[σ₁₂] E₂) (E →SL[σ₁₂] E₂) := ⟨λ e, ↑(e : E ≃SL[σ₁₂] E₂)⟩

@[simp] lemma coe_coe : ⇑(e : E ≃SL[σ₁₂] E₂) = e := rfl

@[simp] lemma coe_coe' : ((e : E ≃SL[σ₁₂] E₂) : E →SL[σ₁₂] E₂) = e := rfl

@[simp] lemma coe_coe'' : ⇑(e : E →SL[σ₁₂] E₂) = e := rfl

omit σ₂₁

@[simp] lemma map_zero : e 0 = 0 := e.1.map_zero

@[simp] lemma map_add (x y : E) : e (x + y) = e x + e y := e.1.map_add x y

@[simp] lemma map_sub (x y : E) : e (x - y) = e x - e y := e.1.map_sub x y

@[simp] lemma map_smulₛₗ (c : R) (x : E) : e (c • x) = σ₁₂ c • e x := e.1.map_smulₛₗ c x

@[simp] lemma map_smul [module R E₂] {e : E ≃ₗᵢ[R] E₂} (c : R) (x : E) : e (c • x) = c • e x :=
e.1.map_smul c x

@[simp] lemma nnnorm_map (x : E) : nnnorm (e x) = nnnorm x := e.to_linear_isometry.nnnorm_map x

@[simp] lemma dist_map (x y : E) : dist (e x) (e y) = dist x y :=
e.to_linear_isometry.dist_map x y

@[simp] lemma edist_map (x y : E) : edist (e x) (e y) = edist x y :=
e.to_linear_isometry.edist_map x y

protected lemma bijective : bijective e := e.1.bijective
protected lemma injective : injective e := e.1.injective
protected lemma surjective : surjective e := e.1.surjective

@[simp] lemma map_eq_iff {x y : E} : e x = e y ↔ x = y := e.injective.eq_iff

lemma map_ne {x y : E} (h : x ≠ y) : e x ≠ e y := e.injective.ne h

protected lemma lipschitz : lipschitz_with 1 e := e.isometry.lipschitz

protected lemma antilipschitz : antilipschitz_with 1 e := e.isometry.antilipschitz

@[simp] lemma ediam_image (s : set E) : emetric.diam (e '' s) = emetric.diam s :=
e.isometry.ediam_image s

@[simp] lemma diam_image (s : set E) : metric.diam (e '' s) = metric.diam s :=
e.isometry.diam_image s

variables {α : Type*} [topological_space α]

@[simp] lemma comp_continuous_on_iff {f : α → E} {s : set α} :
  continuous_on (e ∘ f) s ↔ continuous_on f s :=
e.isometry.comp_continuous_on_iff

@[simp] lemma comp_continuous_iff {f : α → E} :
  continuous (e ∘ f) ↔ continuous f :=
e.isometry.comp_continuous_iff

instance complete_space_map (p : submodule R E) [complete_space p] :
  complete_space (p.map (e.to_linear_equiv : E →ₛₗ[σ₁₂] E₂)) :=
e.to_linear_isometry.complete_space_map p

include σ₂₁
/-- Construct a linear isometry equiv from a surjective linear isometry. -/
noncomputable def of_surjective (f : F →ₛₗᵢ[σ₁₂] E₂)
  (hfr : function.surjective f) :
  F ≃ₛₗᵢ[σ₁₂] E₂ :=
{ norm_map' := f.norm_map,
  .. linear_equiv.of_bijective f.to_linear_map f.injective hfr }

@[simp] lemma coe_of_surjective (f : F →ₛₗᵢ[σ₁₂] E₂) (hfr : function.surjective f) :
  ⇑(linear_isometry_equiv.of_surjective f hfr) = f :=
by { ext, refl }

omit σ₂₁

variables (R)
/-- The negation operation on a normed space `E`, considered as a linear isometry equivalence. -/
def neg : E ≃ₗᵢ[R] E :=
{ norm_map' := norm_neg,
  .. linear_equiv.neg R }

variables {R}
@[simp] lemma coe_neg : (neg R : E → E) = λ x, -x := rfl

@[simp] lemma symm_neg : (neg R : E ≃ₗᵢ[R] E).symm = neg R := rfl

variables (R E E₂ E₃)

/-- The natural equivalence `(E × E₂) × E₃ ≃ E × (E₂ × E₃)` is a linear isometry. -/
noncomputable def prod_assoc [module R E₂] [module R E₃] : (E × E₂) × E₃ ≃ₗᵢ[R] E × E₂ × E₃ :=
{ to_fun    := equiv.prod_assoc E E₂ E₃,
  inv_fun   := (equiv.prod_assoc E E₂ E₃).symm,
  map_add'  := by simp,
  map_smul' := by simp,
  norm_map' :=
    begin
      rintros ⟨⟨e, f⟩, g⟩,
      simp only [linear_equiv.coe_mk, equiv.prod_assoc_apply, prod.norm_def, max_assoc],
    end,
  .. equiv.prod_assoc E E₂ E₃, }

@[simp] lemma coe_prod_assoc [module R E₂] [module R E₃] :
  (prod_assoc R E E₂ E₃ : (E × E₂) × E₃ → E × E₂ × E₃) = equiv.prod_assoc E E₂ E₃ :=
rfl

@[simp] lemma coe_prod_assoc_symm [module R E₂] [module R E₃] :
  ((prod_assoc R E E₂ E₃).symm : E × E₂ × E₃ → (E × E₂) × E₃) = (equiv.prod_assoc E E₂ E₃).symm :=
rfl

end linear_isometry_equiv

/-- Two linear isometries are equal if they are equal on basis vectors. -/
lemma basis.ext_linear_isometry {ι : Type*} (b : basis ι R E) {f₁ f₂ : E →ₛₗᵢ[σ₁₂] E₂}
  (h : ∀ i, f₁ (b i) = f₂ (b i)) : f₁ = f₂ :=
linear_isometry.to_linear_map_injective $ b.ext h

include σ₂₁

/-- Two linear isometric equivalences are equal if they are equal on basis vectors. -/
lemma basis.ext_linear_isometry_equiv {ι : Type*} (b : basis ι R E) {f₁ f₂ : E ≃ₛₗᵢ[σ₁₂] E₂}
  (h : ∀ i, f₁ (b i) = f₂ (b i)) : f₁ = f₂ :=
linear_isometry_equiv.to_linear_equiv_injective $ b.ext' h

omit σ₂₁


/-
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, Kenny Lau, Yury Kudryashov
-/
import dynamics.fixed_points.basic
import order.hom.order

/-!
# Fixed point construction on complete lattices

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

This file sets up the basic theory of fixed points of a monotone function in a complete lattice.

## Main definitions

* `order_hom.lfp`: The least fixed point of a bundled monotone function.
* `order_hom.gfp`: The greatest fixed point of a bundled monotone function.
* `order_hom.prev_fixed`: The greatest fixed point of a bundled monotone function smaller than or
  equal to a given element.
* `order_hom.next_fixed`: The least fixed point of a bundled monotone function greater than or
  equal to a given element.
* `fixed_points.complete_lattice`: The Knaster-Tarski theorem: fixed points of a monotone
  self-map of a complete lattice form themselves a complete lattice.

## Tags

fixed point, complete lattice, monotone function
-/

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

open function (fixed_points is_fixed_pt)

namespace order_hom

section basic

variables [complete_lattice α] (f : α →o α)

/-- Least fixed point of a monotone function -/
def lfp : (α →o α) →o α :=
{ to_fun := λ f, Inf {a | f a ≤ a},
  monotone' := λ f g hle, Inf_le_Inf $ λ a ha, (hle a).trans ha }

/-- Greatest fixed point of a monotone function -/
def gfp : (α →o α) →o α :=
{ to_fun := λ f, Sup {a | a ≤ f a},
  monotone' := λ f g hle, Sup_le_Sup $ λ a ha, le_trans ha (hle a) }

lemma lfp_le {a : α} (h : f a ≤ a) : lfp f ≤ a := Inf_le h

lemma lfp_le_fixed {a : α} (h : f a = a) : lfp f ≤ a := f.lfp_le h.le

lemma le_lfp {a : α} (h : ∀ b, f b ≤ b → a ≤ b) : a ≤ lfp f := le_Inf h

lemma map_le_lfp {a : α} (ha : a ≤ f.lfp) : f a ≤ f.lfp :=
f.le_lfp $ λ b hb, (f.mono $ le_Inf_iff.1 ha _ hb).trans hb

@[simp] lemma map_lfp : f (lfp f) = lfp f :=
have h : f (lfp f) ≤ lfp f, from f.map_le_lfp le_rfl,
h.antisymm $ f.lfp_le $ f.mono h

lemma is_fixed_pt_lfp : is_fixed_pt f f.lfp := f.map_lfp

lemma lfp_le_map {a : α} (ha : lfp f ≤ a) : lfp f ≤ f a :=
calc lfp f = f (lfp f) : f.map_lfp.symm
       ... ≤ f a       : f.mono ha

lemma is_least_lfp_le : is_least {a | f a ≤ a} (lfp f) :=
⟨f.map_lfp.le, λ a, f.lfp_le⟩

lemma is_least_lfp : is_least (fixed_points f) (lfp f) :=
⟨f.is_fixed_pt_lfp, λ a, f.lfp_le_fixed⟩

lemma lfp_induction {p : α → Prop} (step : ∀ a, p a → a ≤ lfp f → p (f a))
  (hSup : ∀ s, (∀ a ∈ s, p a) → p (Sup s)) :
  p (lfp f) :=
begin
  set s := {a | a ≤ lfp f ∧ p a},
  specialize hSup s (λ a, and.right),
  suffices : Sup s = lfp f, from this ▸ hSup,
  have h : Sup s ≤ lfp f := Sup_le (λ b, and.left),
  have hmem : f (Sup s) ∈ s, from ⟨f.map_le_lfp h, step _ hSup h⟩,
  exact h.antisymm (f.lfp_le $ le_Sup hmem)
end

lemma le_gfp {a : α} (h : a ≤ f a) : a ≤ gfp f :=
le_Sup h

lemma gfp_le {a : α} (h : ∀ b, b ≤ f b → b ≤ a) : gfp f ≤ a :=
Sup_le h

lemma is_fixed_pt_gfp : is_fixed_pt f (gfp f) := f.dual.is_fixed_pt_lfp

@[simp] lemma map_gfp : f (gfp f) = gfp f := f.dual.map_lfp

lemma map_le_gfp {a : α} (ha : a ≤ gfp f) : f a ≤ gfp f := f.dual.lfp_le_map ha

lemma gfp_le_map {a : α} (ha : gfp f ≤ a) : gfp f ≤ f a := f.dual.map_le_lfp ha

lemma is_greatest_gfp_le : is_greatest {a | a ≤ f a} (gfp f) :=
f.dual.is_least_lfp_le

lemma is_greatest_gfp : is_greatest (fixed_points f) (gfp f) :=
f.dual.is_least_lfp

lemma gfp_induction {p : α → Prop} (step : ∀ a, p a → gfp f ≤ a → p (f a))
  (hInf : ∀ s, (∀ a ∈ s, p a) → p (Inf s)) :
  p (gfp f) :=
f.dual.lfp_induction step hInf

end basic

section eqn

variables [complete_lattice α] [complete_lattice β] (f : β →o α) (g : α →o β)

-- Rolling rule
lemma map_lfp_comp : f (lfp (g.comp f)) = lfp (f.comp g) :=
le_antisymm ((f.comp g).map_lfp ▸ f.mono (lfp_le_fixed _ $ congr_arg g (f.comp g).map_lfp)) $
  lfp_le _ (congr_arg f (g.comp f).map_lfp).le

lemma map_gfp_comp : f ((g.comp f).gfp) = (f.comp g).gfp :=
f.dual.map_lfp_comp g.dual

-- Diagonal rule
lemma lfp_lfp (h : α →o α →o α) :
  lfp (lfp.comp h) = lfp h.on_diag :=
begin
  let a := lfp (lfp.comp h),
  refine (lfp_le _ _).antisymm (lfp_le _ (eq.le _)),
  { exact lfp_le _ h.on_diag.map_lfp.le },
  have ha : (lfp ∘ h) a = a := (lfp.comp h).map_lfp,
  calc h a a = h a (lfp (h a)) : congr_arg (h a) ha.symm
         ... = lfp (h a)       : (h a).map_lfp
         ... = a               : ha
end

lemma gfp_gfp (h : α →o α →o α) : gfp (gfp.comp h) = gfp h.on_diag :=
@lfp_lfp αᵒᵈ _ $ (order_hom.dual_iso αᵒᵈ αᵒᵈ).symm.to_order_embedding.to_order_hom.comp h.dual

end eqn

section prev_next
variables [complete_lattice α] (f : α →o α)

lemma gfp_const_inf_le (x : α) : gfp (const α x ⊓ f) ≤ x :=
gfp_le _ $ λ b hb, hb.trans inf_le_left

/-- Previous fixed point of a monotone map. If `f` is a monotone self-map of a complete lattice and
`x` is a point such that `f x ≤ x`, then `f.prev_fixed x hx` is the greatest fixed point of `f`
that is less than or equal to `x`. -/
def prev_fixed (x : α) (hx : f x ≤ x) : fixed_points f :=
⟨gfp (const α x ⊓ f),
  calc f (gfp (const α x ⊓ f)) = x ⊓ f (gfp (const α x ⊓ f)) :
    eq.symm $ inf_of_le_right $ (f.mono $ f.gfp_const_inf_le x).trans hx
  ... = gfp (const α x ⊓ f) : (const α x ⊓ f).map_gfp ⟩

/-- Next fixed point of a monotone map. If `f` is a monotone self-map of a complete lattice and
`x` is a point such that `x ≤ f x`, then `f.next_fixed x hx` is the least fixed point of `f`
that is greater than or equal to `x`. -/
def next_fixed (x : α) (hx : x ≤ f x) : fixed_points f :=
{ val := (const α x ⊔ f).lfp,
  .. f.dual.prev_fixed x hx }

lemma prev_fixed_le {x : α} (hx : f x ≤ x) : ↑(f.prev_fixed x hx) ≤ x :=
f.gfp_const_inf_le x

lemma le_next_fixed {x : α} (hx : x ≤ f x) : x ≤ f.next_fixed x hx :=
f.dual.prev_fixed_le hx

lemma next_fixed_le {x : α} (hx : x ≤ f x) {y : fixed_points f} (h : x ≤ y) :
  f.next_fixed x hx ≤ y :=
subtype.coe_le_coe.1 $ lfp_le _ $ sup_le h y.2.le

@[simp] lemma next_fixed_le_iff {x : α} (hx : x ≤ f x) {y : fixed_points f} :
  f.next_fixed x hx ≤ y ↔ x ≤ y :=
⟨λ h, (f.le_next_fixed hx).trans h, f.next_fixed_le hx⟩

@[simp]

lemma le_prev_fixed {x : α} (hx : f x ≤ x) {y : fixed_points f} (h : ↑y ≤ x) :
  y ≤ f.prev_fixed x hx :=
(f.le_prev_fixed_iff hx).2 h

lemma le_map_sup_fixed_points (x y : fixed_points f) : (x ⊔ y : α) ≤ f (x ⊔ y) :=
calc (x ⊔ y : α) = f x ⊔ f y : congr_arg2 (⊔) x.2.symm y.2.symm
             ... ≤ f (x ⊔ y) : f.mono.le_map_sup x y

lemma map_inf_fixed_points_le (x y : fixed_points f) : f (x ⊓ y) ≤ x ⊓ y :=
f.dual.le_map_sup_fixed_points x y

lemma le_map_Sup_subset_fixed_points (A : set α) (hA : A ⊆ fixed_points f) : Sup A ≤ f (Sup A) :=
Sup_le $ λ x hx, hA hx ▸ (f.mono $ le_Sup hx)

lemma map_Inf_subset_fixed_points_le (A : set α) (hA : A ⊆ fixed_points f) : f (Inf A) ≤ Inf A :=
le_Inf $ λ x hx, (hA hx) ▸ (f.mono $ Inf_le hx)

end prev_next

end order_hom

namespace fixed_points

open order_hom

variables [complete_lattice α] (f : α →o α)

instance : semilattice_sup (fixed_points f) :=
{ sup := λ x y, f.next_fixed (x ⊔ y) (f.le_map_sup_fixed_points x y),
  le_sup_left := λ x y, subtype.coe_le_coe.1 $ le_sup_left.trans (f.le_next_fixed _),
  le_sup_right := λ x y, subtype.coe_le_coe.1 $ le_sup_right.trans (f.le_next_fixed _),
  sup_le := λ x y z hxz hyz, f.next_fixed_le _ $ sup_le hxz hyz,
  .. subtype.partial_order _ }

instance : semilattice_inf (fixed_points f) :=
{ inf := λ x y, f.prev_fixed (x ⊓ y) (f.map_inf_fixed_points_le x y),
  .. subtype.partial_order _, .. (order_dual.semilattice_inf (fixed_points f.dual))  }

instance : complete_semilattice_Sup (fixed_points f) :=
{ Sup := λ s, f.next_fixed (Sup (coe '' s))
    (f.le_map_Sup_subset_fixed_points (coe '' s) (λ z ⟨x, hx⟩, hx.2 ▸ x.2)),
  le_Sup := λ s x hx, subtype.coe_le_coe.1 $ le_trans (le_Sup $ set.mem_image_of_mem _ hx)
    (f.le_next_fixed _),
  Sup_le := λ s x hx, f.next_fixed_le _ $ Sup_le $ set.ball_image_iff.2 hx,
  .. subtype.partial_order _ }

instance : complete_semilattice_Inf (fixed_points f) :=
{ Inf := λ s, f.prev_fixed (Inf (coe '' s))
    (f.map_Inf_subset_fixed_points_le (coe '' s) (λ z ⟨x, hx⟩, hx.2 ▸ x.2)),
  le_Inf := λ s x hx, f.le_prev_fixed _ $ le_Inf $ set.ball_image_iff.2 hx,
  Inf_le := λ s x hx, subtype.coe_le_coe.1 $ le_trans (f.prev_fixed_le _)
    (Inf_le $ set.mem_image_of_mem _ hx),
  .. subtype.partial_order _ }

/-- **Knaster-Tarski Theorem**: The fixed points of `f` form a complete lattice. -/
instance : complete_lattice (fixed_points f) :=
{ top := ⟨f.gfp, f.is_fixed_pt_gfp⟩,
  bot := ⟨f.lfp, f.is_fixed_pt_lfp⟩,
  le_top := λ x, f.le_gfp x.2.ge,
  bot_le := λ x, f.lfp_le x.2.le,
  .. subtype.partial_order _,
  .. fixed_points.semilattice_sup f,
  .. fixed_points.semilattice_inf f,
  .. fixed_points.complete_semilattice_Sup f,
  .. fixed_points.complete_semilattice_Inf f }

end fixed_points


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

! This file was ported from Lean 3 source module topology.continuous_function.t0_sierpinski
! leanprover-community/mathlib commit 34ee86e6a59d911a8e4f89b68793ee7577ae79c7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Order
import Mathbin.Topology.Sets.Opens
import Mathbin.Topology.ContinuousFunction.Basic

/-!
# Any T0 space embeds in a product of copies of the Sierpinski space.

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

We consider `Prop` with the Sierpinski topology. If `X` is a topological space, there is a
continuous map `product_of_mem_opens` from `X` to `opens X → Prop` which is the product of the maps
`X → Prop` given by `x ↦ x ∈ u`.

The map `product_of_mem_opens` is always inducing. Whenever `X` is T0, `product_of_mem_opens` is
also injective and therefore an embedding.
-/

noncomputable section

namespace TopologicalSpace

/- warning: topological_space.eq_induced_by_maps_to_sierpinski -> TopologicalSpace.eq_induced_by_maps_to_sierpinski is a dubious translation:
lean 3 declaration is
  forall (X : Type.{u1}) [t : TopologicalSpace.{u1} X], Eq.{succ u1} (TopologicalSpace.{u1} X) t (infᵢ.{u1, succ u1} (TopologicalSpace.{u1} X) (ConditionallyCompleteLattice.toHasInf.{u1} (TopologicalSpace.{u1} X) (CompleteLattice.toConditionallyCompleteLattice.{u1} (TopologicalSpace.{u1} X) (TopologicalSpace.completeLattice.{u1} X))) (TopologicalSpace.Opens.{u1} X t) (fun (u : TopologicalSpace.Opens.{u1} X t) => TopologicalSpace.induced.{u1, 0} X Prop (fun (_x : X) => Membership.Mem.{u1, u1} X (TopologicalSpace.Opens.{u1} X t) (SetLike.hasMem.{u1, u1} (TopologicalSpace.Opens.{u1} X t) X (TopologicalSpace.Opens.setLike.{u1} X t)) _x u) sierpinskiSpace))
but is expected to have type
  forall (X : Type.{u1}) [t : TopologicalSpace.{u1} X], Eq.{succ u1} (TopologicalSpace.{u1} X) t (infᵢ.{u1, succ u1} (TopologicalSpace.{u1} X) (ConditionallyCompleteLattice.toInfSet.{u1} (TopologicalSpace.{u1} X) (CompleteLattice.toConditionallyCompleteLattice.{u1} (TopologicalSpace.{u1} X) (TopologicalSpace.instCompleteLatticeTopologicalSpace.{u1} X))) (TopologicalSpace.Opens.{u1} X t) (fun (u : TopologicalSpace.Opens.{u1} X t) => TopologicalSpace.induced.{u1, 0} X Prop (fun (_x : X) => Membership.mem.{u1, u1} X (TopologicalSpace.Opens.{u1} X t) (SetLike.instMembership.{u1, u1} (TopologicalSpace.Opens.{u1} X t) X (TopologicalSpace.Opens.instSetLikeOpens.{u1} X t)) _x u) sierpinskiSpace))
Case conversion may be inaccurate. Consider using '#align topological_space.eq_induced_by_maps_to_sierpinski TopologicalSpace.eq_induced_by_maps_to_sierpinskiₓ'. -/
theorem eq_induced_by_maps_to_sierpinski (X : Type _) [t : TopologicalSpace X] :
    t = ⨅ u : Opens X, sierpinskiSpace.induced (· ∈ u) :=
  by
  apply le_antisymm
  · rw [le_infᵢ_iff]
    exact fun u => Continuous.le_induced (is_open_iff_continuous_mem.mp u.2)
  · intro u h
    rw [← generateFrom_unionᵢ_isOpen]
    apply is_open_generate_from_of_mem
    simp only [Set.mem_unionᵢ, Set.mem_setOf_eq, isOpen_induced_iff]
    exact ⟨⟨u, h⟩, {True}, isOpen_singleton_true, by simp [Set.preimage]⟩
#align topological_space.eq_induced_by_maps_to_sierpinski TopologicalSpace.eq_induced_by_maps_to_sierpinski

variable (X : Type _) [TopologicalSpace X]

#print TopologicalSpace.productOfMemOpens /-
/-- The continuous map from `X` to the product of copies of the Sierpinski space, (one copy for each
open subset `u` of `X`). The `u` coordinate of `product_of_mem_opens x` is given by `x ∈ u`.
-/
def productOfMemOpens : C(X, Opens X → Prop)
    where
  toFun x u := x ∈ u
  continuous_toFun := continuous_pi_iff.2 fun u => continuous_Prop.2 u.IsOpen
#align topological_space.product_of_mem_opens TopologicalSpace.productOfMemOpens
-/

/- warning: topological_space.product_of_mem_opens_inducing -> TopologicalSpace.productOfMemOpens_inducing is a dubious translation:
lean 3 declaration is
  forall (X : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} X], Inducing.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace)) (coeFn.{succ u1, succ u1} (ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) (fun (_x : ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) => X -> (TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) (ContinuousMap.hasCoeToFun.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) (TopologicalSpace.productOfMemOpens.{u1} X _inst_1))
but is expected to have type
  forall (X : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} X], Inducing.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace)) (FunLike.coe.{succ u1, succ u1, succ u1} (ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) X (fun (_x : X) => (fun (x._@.Mathlib.Topology.ContinuousFunction.Basic._hyg.699 : X) => (TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _x) (ContinuousMapClass.toFunLike.{u1, u1, u1} (ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace)) (ContinuousMap.instContinuousMapClassContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace)))) (TopologicalSpace.productOfMemOpens.{u1} X _inst_1))
Case conversion may be inaccurate. Consider using '#align topological_space.product_of_mem_opens_inducing TopologicalSpace.productOfMemOpens_inducingₓ'. -/
theorem productOfMemOpens_inducing : Inducing (productOfMemOpens X) :=
  by
  convert inducing_infᵢ_to_pi fun (u : opens X) (x : X) => x ∈ u
  apply eq_induced_by_maps_to_sierpinski
#align topological_space.product_of_mem_opens_inducing TopologicalSpace.productOfMemOpens_inducing

/- warning: topological_space.product_of_mem_opens_injective -> TopologicalSpace.productOfMemOpens_injective is a dubious translation:
lean 3 declaration is
  forall (X : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : T0Space.{u1} X _inst_1], Function.Injective.{succ u1, succ u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) (coeFn.{succ u1, succ u1} (ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) (fun (_x : ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) => X -> (TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) (ContinuousMap.hasCoeToFun.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) (TopologicalSpace.productOfMemOpens.{u1} X _inst_1))
but is expected to have type
  forall (X : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : T0Space.{u1} X _inst_1], Function.Injective.{succ u1, succ u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) (FunLike.coe.{succ u1, succ u1, succ u1} (ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) X (fun (_x : X) => (fun (x._@.Mathlib.Topology.ContinuousFunction.Basic._hyg.699 : X) => (TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _x) (ContinuousMapClass.toFunLike.{u1, u1, u1} (ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace)) (ContinuousMap.instContinuousMapClassContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace)))) (TopologicalSpace.productOfMemOpens.{u1} X _inst_1))
Case conversion may be inaccurate. Consider using '#align topological_space.product_of_mem_opens_injective TopologicalSpace.productOfMemOpens_injectiveₓ'. -/
theorem productOfMemOpens_injective [T0Space X] : Function.Injective (productOfMemOpens X) :=
  by
  intro x1 x2 h
  apply Inseparable.eq
  rw [← Inducing.inseparable_iff (product_of_mem_opens_inducing X), h]
#align topological_space.product_of_mem_opens_injective TopologicalSpace.productOfMemOpens_injective

/- warning: topological_space.product_of_mem_opens_embedding -> TopologicalSpace.productOfMemOpens_embedding is a dubious translation:
lean 3 declaration is
  forall (X : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : T0Space.{u1} X _inst_1], Embedding.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace)) (coeFn.{succ u1, succ u1} (ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) (fun (_x : ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) => X -> (TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) (ContinuousMap.hasCoeToFun.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) (TopologicalSpace.productOfMemOpens.{u1} X _inst_1))
but is expected to have type
  forall (X : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : T0Space.{u1} X _inst_1], Embedding.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (ᾰ : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace)) (FunLike.coe.{succ u1, succ u1, succ u1} (ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) X (fun (_x : X) => (fun (x._@.Mathlib.Topology.ContinuousFunction.Basic._hyg.699 : X) => (TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _x) (ContinuousMapClass.toFunLike.{u1, u1, u1} (ContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace))) X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace)) (ContinuousMap.instContinuousMapClassContinuousMap.{u1, u1} X ((TopologicalSpace.Opens.{u1} X _inst_1) -> Prop) _inst_1 (Pi.topologicalSpace.{u1, 0} (TopologicalSpace.Opens.{u1} X _inst_1) (fun (a._@.Mathlib.Topology.ContinuousFunction.T0Sierpinski._hyg.166 : TopologicalSpace.Opens.{u1} X _inst_1) => Prop) (fun (a : TopologicalSpace.Opens.{u1} X _inst_1) => sierpinskiSpace)))) (TopologicalSpace.productOfMemOpens.{u1} X _inst_1))
Case conversion may be inaccurate. Consider using '#align topological_space.product_of_mem_opens_embedding TopologicalSpace.productOfMemOpens_embeddingₓ'. -/
theorem productOfMemOpens_embedding [T0Space X] : Embedding (productOfMemOpens X) :=
  Embedding.mk (productOfMemOpens_inducing X) (productOfMemOpens_injective X)
#align topological_space.product_of_mem_opens_embedding TopologicalSpace.productOfMemOpens_embedding

end TopologicalSpace


/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module data.W.basic
! leanprover-community/mathlib commit 2445c98ae4b87eabebdde552593519b9b6dc350c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Equiv.List

/-!
# W types

Given `α : Type` and `β : α → Type`, the W type determined by this data, `WType β`, is the
inductively defined type of trees where the nodes are labeled by elements of `α` and the children of
a node labeled `a` are indexed by elements of `β a`.

This file is currently a stub, awaiting a full development of the theory. Currently, the main result
is that if `α` is an encodable fintype and `β a` is encodable for every `a : α`, then `WType β` is
encodable. This can be used to show the encodability of other inductive types, such as those that
are commonly used to formalize syntax, e.g. terms and expressions in a given language. The strategy
is illustrated in the example found in the file `prop_encodable` in the `archive/examples` folder of
mathlib.

## Implementation details

While the name `WType` is somewhat verbose, it is preferable to putting a single character
identifier `W` in the root namespace.
-/

-- For "W_type"
set_option linter.uppercaseLean3 false

/--
Given `β : α → Type _`, `WType β` is the type of finitely branching trees where nodes are labeled by
elements of `α` and the children of a node labeled `a` are indexed by elements of `β a`.
-/
inductive WType {α : Type _} (β : α → Type _)
  | mk (a : α) (f : β a → WType β) : WType β
#align W_type WType

instance : Inhabited (WType fun _ : Unit => Empty) :=
  ⟨WType.mk Unit.unit Empty.elim⟩

namespace WType

variable {α : Type _} {β : α → Type _}

/-- The canonical map to the corresponding sigma type, returning the label of a node as an
  element `a` of `α`, and the children of the node as a function `β a → WType β`. -/
def toSigma : WType β → Σa : α, β a → WType β
  | ⟨a, f⟩ => ⟨a, f⟩
#align W_type.to_sigma WType.toSigma

/-- The canonical map from the sigma type into a `WType`. Given a node `a : α`, and
  its children as a function `β a → WType β`, return the corresponding tree. -/
def ofSigma : (Σa : α, β a → WType β) → WType β
  | ⟨a, f⟩ => WType.mk a f
#align W_type.of_sigma WType.ofSigma

@[simp]
theorem ofSigma_toSigma : ∀ w : WType β, ofSigma (toSigma w) = w
  | ⟨_, _⟩ => rfl
#align W_type.of_sigma_to_sigma WType.ofSigma_toSigma

@[simp]
theorem toSigma_ofSigma : ∀ s : Σa : α, β a → WType β, toSigma (ofSigma s) = s
  | ⟨_, _⟩ => rfl
#align W_type.to_sigma_of_sigma WType.toSigma_ofSigma

variable (β)

/-- The canonical bijection with the sigma type, showing that `WType` is a fixed point of
  the polynomial functor `X ↦ Σ a : α, β a → X`. -/
@[simps]
def equivSigma : WType β ≃ Σa : α, β a → WType β
    where
  toFun := toSigma
  invFun := ofSigma
  left_inv := ofSigma_toSigma
  right_inv := toSigma_ofSigma
#align W_type.equiv_sigma WType.equivSigma
#align W_type.equiv_sigma_symm_apply WType.equivSigma_symm_apply
#align W_type.equiv_sigma_apply WType.equivSigma_apply

variable {β}

-- porting note: Universes have a different order than mathlib3 definition
/-- The canonical map from `WType β` into any type `γ` given a map `(Σ a : α, β a → γ) → γ`. -/
def elim (γ : Type _) (fγ : (Σa : α, β a → γ) → γ) : WType β → γ
  | ⟨a, f⟩ => fγ ⟨a, fun b => elim γ fγ (f b)⟩
#align W_type.elim WType.elim

theorem elim_injective (γ : Type _) (fγ : (Σa : α, β a → γ) → γ)
    (fγ_injective : Function.Injective fγ) : Function.Injective (elim γ fγ)
  | ⟨a₁, f₁⟩, ⟨a₂, f₂⟩, h =>
    by
    obtain ⟨rfl, h⟩ := Sigma.mk.inj_iff.mp (fγ_injective h)
    congr with x
    exact elim_injective γ fγ fγ_injective (congr_fun (eq_of_heq h) x : _)
#align W_type.elim_injective WType.elim_injective

instance [hα : IsEmpty α] : IsEmpty (WType β) :=
  ⟨fun w => WType.recOn w (IsEmpty.elim hα)⟩

theorem infinite_of_nonempty_of_isEmpty (a b : α) [ha : Nonempty (β a)] [he : IsEmpty (β b)] :
    Infinite (WType β) :=
  ⟨by
    intro hf
    have hba : b ≠ a := fun h => ha.elim (IsEmpty.elim' (show IsEmpty (β a) from h ▸ he))
    refine'
      not_injective_infinite_finite
        (fun n : ℕ =>
          show WType β from Nat.recOn n ⟨b, IsEmpty.elim' he⟩ fun _ ih => ⟨a, fun _ => ih⟩)
        _
    intro n m h
    induction' n with n ih generalizing m
    · cases' m with m <;> simp_all
    · cases' m with m
      · simp_all
      · refine' congr_arg Nat.succ (ih _)
        simp_all [Function.funext_iff]⟩
#align W_type.infinite_of_nonempty_of_is_empty WType.infinite_of_nonempty_of_isEmpty

variable [∀ a : α, Fintype (β a)]

/-- The depth of a finitely branching tree. -/
def depth : WType β → ℕ
  | ⟨_, f⟩ => (Finset.sup Finset.univ fun n => depth (f n)) + 1
#align W_type.depth WType.depth

theorem depth_pos (t : WType β) : 0 < t.depth := by
  cases t
  apply Nat.succ_pos
#align W_type.depth_pos WType.depth_pos

/-
Show that W types are encodable when `α` is an encodable fintype and for every `a : α`, `β a` is
encodable.

We define an auxiliary type `WType' β n` of trees of depth at most `n`, and then we show by
induction on `n` that these are all encodable. These auxiliary constructions are not interesting in
and of themselves, so we mark them as `private`.
-/
@[reducible]
private def WType' {α : Type _} (β : α → Type _) [∀ a : α, Fintype (β a)]
    [∀ a : α, Encodable (β a)] (n : ℕ) :=
  { t : WType β // t.depth ≤ n }

variable [∀ a : α, Encodable (β a)]

private def encodable_zero : Encodable (WType' β 0) :=
  let f : WType' β 0 → Empty := fun ⟨x, h⟩ => False.elim <| not_lt_of_ge h (WType.depth_pos _)
  let finv : Empty → WType' β 0 := by
    intro x
    cases x
  have : ∀ x, finv (f x) = x := fun ⟨x, h⟩ => False.elim <| not_lt_of_ge h (WType.depth_pos _)
  Encodable.ofLeftInverse f finv this

private def f (n : ℕ) : WType' β (n + 1) → Σa : α, β a → WType' β n
  | ⟨t, h⟩ => by
    cases' t with a f
    have h₀ : ∀ i : β a, WType.depth (f i) ≤ n := fun i =>
      Nat.le_of_lt_succ (lt_of_lt_of_le (WType.depth_lt_depth_mk a f i) h)
    exact ⟨a, fun i : β a => ⟨f i, h₀ i⟩⟩

private def finv (n : ℕ) : (Σa : α, β a → WType' β n) → WType' β (n + 1)
  | ⟨a, f⟩ =>
    let f' := fun i : β a => (f i).val
    have : WType.depth ⟨a, f'⟩ ≤ n + 1 := add_le_add_right (Finset.sup_le fun b _ => (f b).2) 1
    ⟨⟨a, f'⟩, this⟩

variable [Encodable α]

private def encodable_succ (n : Nat) (h : Encodable (WType' β n)) : Encodable (WType' β (n + 1)) :=
  Encodable.ofLeftInverse (f n) (finv n)
    (by
      rintro ⟨⟨_, _⟩, _⟩
      rfl)

/-- `WType` is encodable when `α` is an encodable fintype and for every `a : α`, `β a` is
encodable. -/
instance : Encodable (WType β) := by
  haveI h' : ∀ n, Encodable (WType' β n) := fun n => Nat.recC encodable_zero encodable_succ n
  let f : WType β → Σn, WType' β n := fun t => ⟨t.depth, ⟨t, le_rfl⟩⟩
  let finv : (Σn, WType' β n) → WType β := fun p => p.2.1
  have : ∀ t, finv (f t) = t := fun t => rfl
  exact Encodable.ofLeftInverse f finv this

end WType


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

Natural homomorphism from the natural numbers into a monoid with one.
-/
import algebra.ordered_field
import data.nat.basic

namespace nat
variables {α : Type*}

section
variables [has_zero α] [has_one α] [has_add α]

/-- Canonical homomorphism from `ℕ` to a type `α` with `0`, `1` and `+`. -/
protected def cast : ℕ → α
| 0     := 0
| (n+1) := cast n + 1

/-- Computationally friendlier cast than `nat.cast`, using binary representation. -/
protected def bin_cast (n : ℕ) : α :=
@nat.binary_rec (λ _, α) 0 (λ odd k a, cond odd (a + a + 1) (a + a)) n

/--
Coercions such as `nat.cast_coe` that go from a concrete structure such as
`ℕ` to an arbitrary ring `α` should be set up as follows:
```lean
@[priority 900] instance : has_coe_t ℕ α := ⟨...⟩
```

It needs to be `has_coe_t` instead of `has_coe` because otherwise type-class
inference would loop when constructing the transitive coercion `ℕ → ℕ → ℕ → ...`.
The reduced priority is necessary so that it doesn't conflict with instances
such as `has_coe_t α (option α)`.

For this to work, we reduce the priority of the `coe_base` and `coe_trans`
instances because we want the instances for `has_coe_t` to be tried in the
following order:

 1. `has_coe_t` instances declared in mathlib (such as `has_coe_t α (with_top α)`, etc.)
 2. `coe_base`, which contains instances such as `has_coe (fin n) n`
 3. `nat.cast_coe : has_coe_t ℕ α` etc.
 4. `coe_trans`

If `coe_trans` is tried first, then `nat.cast_coe` doesn't get a chance to apply.
-/
library_note "coercion into rings"
attribute [instance, priority 950] coe_base
attribute [instance, priority 500] coe_trans

-- see note [coercion into rings]
@[priority 900] instance cast_coe : has_coe_t ℕ α := ⟨nat.cast⟩

@[simp, norm_cast] theorem cast_zero : ((0 : ℕ) : α) = 0 := rfl

theorem cast_add_one (n : ℕ) : ((n + 1 : ℕ) : α) = n + 1 := rfl

@[simp, norm_cast, priority 500]
theorem cast_succ (n : ℕ) : ((succ n : ℕ) : α) = n + 1 := rfl

@[simp, norm_cast] theorem cast_ite (P : Prop) [decidable P] (m n : ℕ) :
  (((ite P m n) : ℕ) : α) = ite P (m : α) (n : α) :=
by { split_ifs; refl, }

end

@[simp, norm_cast] theorem cast_one [add_monoid α] [has_one α] : ((1 : ℕ) : α) = 1 := zero_add _

@[simp, norm_cast] theorem cast_add [add_monoid α] [has_one α] (m) : ∀ n, ((m + n : ℕ) : α) = m + n
| 0     := (add_zero _).symm
| (n+1) := show ((m + n : ℕ) : α) + 1 = m + (n + 1), by rw [cast_add n, add_assoc]

@[simp] lemma bin_cast_eq [add_monoid α] [has_one α] (n : ℕ) :
  (nat.bin_cast n : α) = ((n : ℕ) : α) :=
begin
  rw nat.bin_cast,
  apply binary_rec _ _ n,
  { rw [binary_rec_zero, cast_zero] },
  { intros b k h,
    rw [binary_rec_eq, h],
    { cases b; simp [bit, bit0, bit1] },
    { simp } },
end

/-- `coe : ℕ → α` as an `add_monoid_hom`. -/
def cast_add_monoid_hom (α : Type*) [add_monoid α] [has_one α] : ℕ →+ α :=
{ to_fun := coe,
  map_add' := cast_add,
  map_zero' := cast_zero }

@[simp] lemma coe_cast_add_monoid_hom [add_monoid α] [has_one α] :
  (cast_add_monoid_hom α : ℕ → α) = coe := rfl

@[simp, norm_cast] theorem cast_bit0 [add_monoid α] [has_one α] (n : ℕ) :
  ((bit0 n : ℕ) : α) = bit0 n := cast_add _ _

@[simp, norm_cast] theorem cast_bit1 [add_monoid α] [has_one α] (n : ℕ) :
  ((bit1 n : ℕ) : α) = bit1 n :=
by rw [bit1, cast_add_one, cast_bit0]; refl

lemma cast_two {α : Type*} [add_monoid α] [has_one α] : ((2 : ℕ) : α) = 2 := by simp

@[simp, norm_cast] theorem cast_pred [add_group α] [has_one α] :
  ∀ {n}, 0 < n → ((n - 1 : ℕ) : α) = n - 1
| (n+1) h := (add_sub_cancel (n:α) 1).symm

@[simp, norm_cast] theorem cast_sub [add_group α] [has_one α] {m n} (h : m ≤ n) :
  ((n - m : ℕ) : α) = n - m :=
eq_sub_of_add_eq $ by rw [← cast_add, nat.sub_add_cancel h]

@[simp, norm_cast] theorem cast_mul [semiring α] (m) : ∀ n, ((m * n : ℕ) : α) = m * n
| 0     := (mul_zero _).symm
| (n+1) := (cast_add _ _).trans $
show ((m * n : ℕ) : α) + m = m * (n + 1), by rw [cast_mul n, left_distrib, mul_one]

@[simp] theorem cast_dvd {α : Type*} [field α] {m n : ℕ} (n_dvd : n ∣ m) (n_nonzero : (n:α) ≠ 0) :
  ((m / n : ℕ) : α) = m / n :=
begin
  rcases n_dvd with ⟨k, rfl⟩,
  have : n ≠ 0, {rintro rfl, simpa using n_nonzero},
  rw nat.mul_div_cancel_left _ (pos_iff_ne_zero.2 this),
  rw [nat.cast_mul, mul_div_cancel_left _ n_nonzero],
end

/-- `coe : ℕ → α` as a `ring_hom` -/
def cast_ring_hom (α : Type*) [semiring α] : ℕ →+* α :=
{ to_fun := coe,
  map_one' := cast_one,
  map_mul' := cast_mul,
  .. cast_add_monoid_hom α }

@[simp] lemma coe_cast_ring_hom [semiring α] : (cast_ring_hom α : ℕ → α) = coe := rfl

lemma cast_commute [semiring α] (n : ℕ) (x : α) : commute ↑n x :=
nat.rec_on n (commute.zero_left x) $ λ n ihn, ihn.add_left $ commute.one_left x

lemma cast_comm [semiring α] (n : ℕ) (x : α) : (n : α) * x = x * n :=
(cast_commute n x).eq

lemma commute_cast [semiring α] (x : α) (n : ℕ) : commute x n :=
(n.cast_commute x).symm

section

variables [ordered_semiring α]

@[simp] theorem cast_nonneg : ∀ n : ℕ, 0 ≤ (n : α)
| 0     := le_refl _
| (n+1) := add_nonneg (cast_nonneg n) zero_le_one

theorem mono_cast : monotone (coe : ℕ → α) :=
λ m n h, let ⟨k, hk⟩ := le_iff_exists_add.1 h in by simp [hk]

variable [nontrivial α]

theorem strict_mono_cast : strict_mono (coe : ℕ → α) :=
λ m n h, nat.le_induction (lt_add_of_pos_right _ zero_lt_one)
  (λ n _ h, lt_add_of_lt_of_pos h zero_lt_one) _ h

@[simp, norm_cast] theorem cast_le {m n : ℕ} :
  (m : α) ≤ n ↔ m ≤ n :=
strict_mono_cast.le_iff_le

@[simp, norm_cast] theorem cast_lt {m n : ℕ} : (m : α) < n ↔ m < n :=
strict_mono_cast.lt_iff_lt

@[simp] theorem cast_pos {n : ℕ} : (0 : α) < n ↔ 0 < n :=
by rw [← cast_zero, cast_lt]

lemma cast_add_one_pos (n : ℕ) : 0 < (n : α) + 1 :=
  add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one

@[simp, norm_cast] theorem one_lt_cast {n : ℕ} : 1 < (n : α) ↔ 1 < n :=
by rw [← cast_one, cast_lt]

@[simp, norm_cast] theorem one_le_cast {n : ℕ} : 1 ≤ (n : α) ↔ 1 ≤ n :=
by rw [← cast_one, cast_le]

@[simp, norm_cast] theorem cast_lt_one {n : ℕ} : (n : α) < 1 ↔ n = 0 :=
by rw [← cast_one, cast_lt, lt_succ_iff, le_zero_iff]

@[simp, norm_cast] theorem cast_le_one {n : ℕ} : (n : α) ≤ 1 ↔ n ≤ 1 :=
by rw [← cast_one, cast_le]

end

@[simp, norm_cast] theorem cast_min [linear_ordered_semiring α] {a b : ℕ} :
  (↑(min a b) : α) = min a b :=
by by_cases a ≤ b; simp [h, min]

@[simp, norm_cast] theorem cast_max [linear_ordered_semiring α] {a b : ℕ} :
  (↑(max a b) : α) = max a b :=
by by_cases a ≤ b; simp [h, max]

@[simp, norm_cast] theorem abs_cast [linear_ordered_ring α] (a : ℕ) :
  abs (a : α) = a :=
abs_of_nonneg (cast_nonneg a)

lemma coe_nat_dvd [comm_semiring α] {m n : ℕ} (h : m ∣ n) :
  (m : α) ∣ (n : α) :=
ring_hom.map_dvd (nat.cast_ring_hom α) h

alias coe_nat_dvd ← has_dvd.dvd.nat_cast

section linear_ordered_field
variables [linear_ordered_field α]

lemma inv_pos_of_nat {n : ℕ} : 0 < ((n : α) + 1)⁻¹ :=
inv_pos.2 $ add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one

lemma one_div_pos_of_nat {n : ℕ} : 0 < 1 / ((n : α) + 1) :=
by { rw one_div, exact inv_pos_of_nat }

lemma one_div_le_one_div {n m : ℕ} (h : n ≤ m) : 1 / ((m : α) + 1) ≤ 1 / ((n : α) + 1) :=
by { refine one_div_le_one_div_of_le _ _, exact nat.cast_add_one_pos _, simpa }

lemma one_div_lt_one_div {n m : ℕ} (h : n < m) : 1 / ((m : α) + 1) < 1 / ((n : α) + 1) :=
by { refine one_div_lt_one_div_of_lt _ _, exact nat.cast_add_one_pos _, simpa }

end linear_ordered_field

end nat

namespace add_monoid_hom

variables {A B : Type*} [add_monoid A]

@[ext] lemma ext_nat {f g : ℕ →+ A} (h : f 1 = g 1) : f = g :=
ext $ λ n, nat.rec_on n (f.map_zero.trans g.map_zero.symm) $ λ n ihn,
by simp only [nat.succ_eq_add_one, *, map_add]

variables [has_one A] [add_monoid B] [has_one B]

lemma eq_nat_cast (f : ℕ →+ A) (h1 : f 1 = 1) :
  ∀ n : ℕ, f n = n :=
congr_fun $ show f = nat.cast_add_monoid_hom A, from ext_nat (h1.trans nat.cast_one.symm)

lemma map_nat_cast (f : A →+ B) (h1 : f 1 = 1) (n : ℕ) : f n = n :=
(f.comp (nat.cast_add_monoid_hom A)).eq_nat_cast (by simp [h1]) _

end add_monoid_hom

namespace monoid_with_zero_hom

variables {A : Type*} [monoid_with_zero A]

/-- If two `monoid_with_zero_hom`s agree on the positive naturals they are equal. -/
@[ext] theorem ext_nat {f g : monoid_with_zero_hom ℕ A}
  (h_pos : ∀ {n : ℕ}, 0 < n → f n = g n) : f = g :=
begin
  ext (_ | n),
  { rw [f.map_zero, g.map_zero] },
  { exact h_pos n.zero_lt_succ, },
end

end monoid_with_zero_hom

namespace ring_hom

variables {R : Type*} {S : Type*} [semiring R] [semiring S]

@[simp] lemma eq_nat_cast (f : ℕ →+* R) (n : ℕ) : f n = n :=
f.to_add_monoid_hom.eq_nat_cast f.map_one n

@[simp] lemma map_nat_cast (f : R →+* S) (n : ℕ) :
  f n = n :=
(f.comp (nat.cast_ring_hom R)).eq_nat_cast n

lemma ext_nat (f g : ℕ →+* R) : f = g :=
coe_add_monoid_hom_injective $ add_monoid_hom.ext_nat $ f.map_one.trans g.map_one.symm

end ring_hom

@[simp, norm_cast] theorem nat.cast_id (n : ℕ) : ↑n = n :=
((ring_hom.id ℕ).eq_nat_cast n).symm

@[simp] theorem nat.cast_with_bot : ∀ (n : ℕ),
  @coe ℕ (with_bot ℕ) (@coe_to_lift _ _ nat.cast_coe) n = n
| 0     := rfl
| (n+1) := by rw [with_bot.coe_add, nat.cast_add, nat.cast_with_bot n]; refl

instance nat.subsingleton_ring_hom {R : Type*} [semiring R] : subsingleton (ℕ →+* R) :=
⟨ring_hom.ext_nat⟩

namespace with_top
variables {α : Type*}

variables [has_zero α] [has_one α] [has_add α]

@[simp, norm_cast] lemma coe_nat : ∀(n : nat), ((n : α) : with_top α) = n
| 0     := rfl
| (n+1) := by { push_cast, rw [coe_nat n] }

@[simp] lemma nat_ne_top (n : nat) : (n : with_top α) ≠ ⊤ :=
by { rw [←coe_nat n], apply coe_ne_top }

@[simp] lemma top_ne_nat (n : nat) : (⊤ : with_top α) ≠ n :=
by { rw [←coe_nat n], apply top_ne_coe }

lemma add_one_le_of_lt {i n : with_top ℕ} (h : i < n) : i + 1 ≤ n :=
begin
  cases n, { exact le_top },
  cases i, { exact (not_le_of_lt h le_top).elim },
  exact with_top.coe_le_coe.2 (with_top.coe_lt_coe.1 h)
end

lemma one_le_iff_pos {n : with_top ℕ} : 1 ≤ n ↔ 0 < n :=
⟨λ h, (coe_lt_coe.2 zero_lt_one).trans_le h,
  λ h, by simpa only [zero_add] using add_one_le_of_lt h⟩

@[elab_as_eliminator]
lemma nat_induction {P : with_top ℕ → Prop} (a : with_top ℕ)
  (h0 : P 0) (hsuc : ∀n:ℕ, P n → P n.succ) (htop : (∀n : ℕ, P n) → P ⊤) : P a :=
begin
  have A : ∀n:ℕ, P n := λ n, nat.rec_on n h0 hsuc,
  cases a,
  { exact htop A },
  { exact A a }
end

end with_top