/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Sébastien Gouëzel, Zhouhang Zhou, Reid Barton,
Anatole Dedecker

! This file was ported from Lean 3 source module topology.uniform_space.equiv
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Homeomorph
import Mathlib.Topology.UniformSpace.UniformEmbedding
import Mathlib.Topology.UniformSpace.Pi

/-!
# Uniform isomorphisms

This file defines uniform isomorphisms between two uniform spaces. They are bijections with both
directions uniformly continuous. We denote uniform isomorphisms with the notation `≃ᵤ`.

# Main definitions

* `UniformEquiv α β`: The type of uniform isomorphisms from `α` to `β`.
  This type can be denoted using the following notation: `α ≃ᵤ β`.

-/

open Set Filter

universe u v

variable {α : Type u} {β : Type _} {γ : Type _} {δ : Type _}

-- not all spaces are homeomorphic to each other
/-- Uniform isomorphism between `α` and `β` -/
--@[nolint has_nonempty_instance] -- Porting note: missing linter?
structure UniformEquiv (α : Type _) (β : Type _) [UniformSpace α] [UniformSpace β] extends
  α ≃ β where
  /-- Uniform continuity of the function -/
  uniformContinuous_toFun : UniformContinuous toFun
  /-- Uniform continuity of the inverse -/
  uniformContinuous_invFun : UniformContinuous invFun
#align uniform_equiv UniformEquiv

/-- Uniform isomorphism between `α` and `β` -/
infixl:25 " ≃ᵤ " => UniformEquiv

namespace UniformEquiv

variable [UniformSpace α] [UniformSpace β] [UniformSpace γ] [UniformSpace δ]

theorem toEquiv_injective : Function.Injective (toEquiv : α ≃ᵤ β → α ≃ β)
  | ⟨e, h₁, h₂⟩, ⟨e', h₁', h₂'⟩, h => by simpa only [mk.injEq]
#align uniform_equiv.to_equiv_injective UniformEquiv.toEquiv_injective

instance : EquivLike (α ≃ᵤ β) α β where
  coe := fun h => h.toEquiv
  inv := fun h => h.toEquiv.symm
  left_inv := fun h => h.left_inv
  right_inv := fun h => h.right_inv
  coe_injective' := fun _ _ H _ => toEquiv_injective <| FunLike.ext' H

@[simp]
theorem uniformEquiv_mk_coe (a : Equiv α β) (b c) : (UniformEquiv.mk a b c : α → β) = a :=
  rfl
#align uniform_equiv.uniform_equiv_mk_coe UniformEquiv.uniformEquiv_mk_coe

/-- Inverse of a uniform isomorphism. -/
protected def symm (h : α ≃ᵤ β) : β ≃ᵤ α
    where
  uniformContinuous_toFun := h.uniformContinuous_invFun
  uniformContinuous_invFun := h.uniformContinuous_toFun
  toEquiv := h.toEquiv.symm
#align uniform_equiv.symm UniformEquiv.symm

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def Simps.apply (h : α ≃ᵤ β) : α → β :=
  h
#align uniform_equiv.simps.apply UniformEquiv.Simps.apply

/-- See Note [custom simps projection] -/
def Simps.symm_apply (h : α ≃ᵤ β) : β → α :=
  h.symm
#align uniform_equiv.simps.symm_apply UniformEquiv.Simps.symm_apply

initialize_simps_projections UniformEquiv (toFun → apply, invFun → symm_apply)

@[simp]
theorem coe_toEquiv (h : α ≃ᵤ β) : ⇑h.toEquiv = h :=
  rfl
#align uniform_equiv.coe_to_equiv UniformEquiv.coe_toEquiv

@[simp]
theorem coe_symm_toEquiv (h : α ≃ᵤ β) : ⇑h.toEquiv.symm = h.symm :=
  rfl
#align uniform_equiv.coe_symm_to_equiv UniformEquiv.coe_symm_toEquiv

@[ext]

/-- Identity map as a uniform isomorphism. -/
@[simps! (config := { fullyApplied := false }) apply]
protected def refl (α : Type _) [UniformSpace α] : α ≃ᵤ α
    where
  uniformContinuous_toFun := uniformContinuous_id
  uniformContinuous_invFun := uniformContinuous_id
  toEquiv := Equiv.refl α
#align uniform_equiv.refl UniformEquiv.refl

/-- Composition of two uniform isomorphisms. -/
protected def trans (h₁ : α ≃ᵤ β) (h₂ : β ≃ᵤ γ) : α ≃ᵤ γ
    where
  uniformContinuous_toFun := h₂.uniformContinuous_toFun.comp h₁.uniformContinuous_toFun
  uniformContinuous_invFun := h₁.uniformContinuous_invFun.comp h₂.uniformContinuous_invFun
  toEquiv := Equiv.trans h₁.toEquiv h₂.toEquiv
#align uniform_equiv.trans UniformEquiv.trans

@[simp]
theorem trans_apply (h₁ : α ≃ᵤ β) (h₂ : β ≃ᵤ γ) (a : α) : h₁.trans h₂ a = h₂ (h₁ a) :=
  rfl
#align uniform_equiv.trans_apply UniformEquiv.trans_apply

@[simp]
theorem uniformEquiv_mk_coe_symm (a : Equiv α β) (b c) :
    ((UniformEquiv.mk a b c).symm : β → α) = a.symm :=
  rfl
#align uniform_equiv.uniform_equiv_mk_coe_symm UniformEquiv.uniformEquiv_mk_coe_symm

@[simp]
theorem refl_symm : (UniformEquiv.refl α).symm = UniformEquiv.refl α :=
  rfl
#align uniform_equiv.refl_symm UniformEquiv.refl_symm

protected theorem uniformContinuous (h : α ≃ᵤ β) : UniformContinuous h :=
  h.uniformContinuous_toFun
#align uniform_equiv.uniform_continuous UniformEquiv.uniformContinuous

@[continuity]
protected theorem continuous (h : α ≃ᵤ β) : Continuous h :=
  h.uniformContinuous.continuous
#align uniform_equiv.continuous UniformEquiv.continuous

protected theorem uniformContinuous_symm (h : α ≃ᵤ β) : UniformContinuous h.symm :=
  h.uniformContinuous_invFun
#align uniform_equiv.uniform_continuous_symm UniformEquiv.uniformContinuous_symm

-- otherwise `by continuity` can't prove continuity of `h.to_equiv.symm`
@[continuity]
protected theorem continuous_symm (h : α ≃ᵤ β) : Continuous h.symm :=
  h.uniformContinuous_symm.continuous
#align uniform_equiv.continuous_symm UniformEquiv.continuous_symm

/-- A uniform isomorphism as a homeomorphism. -/
-- @[simps] -- Porting note: removed, `simps?` produced no `simp` lemmas
protected def toHomeomorph (e : α ≃ᵤ β) : α ≃ₜ β :=
  { e.toEquiv with
    continuous_toFun := e.continuous
    continuous_invFun := e.continuous_symm }
#align uniform_equiv.to_homeomorph UniformEquiv.toHomeomorph

lemma toHomeomorph_apply (e : α ≃ᵤ β) : (e.toHomeomorph : α → β) = e := rfl
#align uniform_equiv.to_homeomorph_apply UniformEquiv.toHomeomorph_apply

lemma toHomeomorph_symm_apply (e : α ≃ᵤ β) : (e.toHomeomorph.symm : β → α) = e.symm := rfl
#align uniform_equiv.to_homeomorph_symm_apply UniformEquiv.toHomeomorph_symm_apply

@[simp]
theorem apply_symm_apply (h : α ≃ᵤ β) (x : β) : h (h.symm x) = x :=
  h.toEquiv.apply_symm_apply x
#align uniform_equiv.apply_symm_apply UniformEquiv.apply_symm_apply

@[simp]
theorem symm_apply_apply (h : α ≃ᵤ β) (x : α) : h.symm (h x) = x :=
  h.toEquiv.symm_apply_apply x
#align uniform_equiv.symm_apply_apply UniformEquiv.symm_apply_apply

protected theorem bijective (h : α ≃ᵤ β) : Function.Bijective h :=
  h.toEquiv.bijective
#align uniform_equiv.bijective UniformEquiv.bijective

protected theorem injective (h : α ≃ᵤ β) : Function.Injective h :=
  h.toEquiv.injective
#align uniform_equiv.injective UniformEquiv.injective

protected theorem surjective (h : α ≃ᵤ β) : Function.Surjective h :=
  h.toEquiv.surjective
#align uniform_equiv.surjective UniformEquiv.surjective

/-- Change the uniform equiv `f` to make the inverse function definitionally equal to `g`. -/
def changeInv (f : α ≃ᵤ β) (g : β → α) (hg : Function.RightInverse g f) : α ≃ᵤ β :=
  have : g = f.symm :=
    funext fun x => calc
      g x = f.symm (f (g x)) := (f.left_inv (g x)).symm
      _ = f.symm x := by rw [hg x]
  { toFun := f
    invFun := g
    left_inv := by convert f.left_inv
    right_inv := by convert f.right_inv using 1
    uniformContinuous_toFun := f.uniformContinuous
    uniformContinuous_invFun := by convert f.symm.uniformContinuous }
#align uniform_equiv.change_inv UniformEquiv.changeInv

@[simp]
theorem symm_comp_self (h : α ≃ᵤ β) : (h.symm : β → α) ∘ h = id :=
  funext h.symm_apply_apply
#align uniform_equiv.symm_comp_self UniformEquiv.symm_comp_self

@[simp]
theorem self_comp_symm (h : α ≃ᵤ β) : (h : α → β) ∘ h.symm = id :=
  funext h.apply_symm_apply
#align uniform_equiv.self_comp_symm UniformEquiv.self_comp_symm

-- @[simp] -- Porting note: `simp` can prove this `simp only [Equiv.range_eq_univ]`
theorem range_coe (h : α ≃ᵤ β) : range h = univ :=
  h.surjective.range_eq
#align uniform_equiv.range_coe UniformEquiv.range_coe

theorem image_symm (h : α ≃ᵤ β) : image h.symm = preimage h :=
  funext h.symm.toEquiv.image_eq_preimage
#align uniform_equiv.image_symm UniformEquiv.image_symm

theorem preimage_symm (h : α ≃ᵤ β) : preimage h.symm = image h :=
  (funext h.toEquiv.image_eq_preimage).symm
#align uniform_equiv.preimage_symm UniformEquiv.preimage_symm

-- @[simp] -- Porting note: `simp` can prove this `simp only [Equiv.image_preimage]`
theorem image_preimage (h : α ≃ᵤ β) (s : Set β) : h '' (h ⁻¹' s) = s :=
  h.toEquiv.image_preimage s
#align uniform_equiv.image_preimage UniformEquiv.image_preimage

--@[simp] -- Porting note: `simp` can prove this `simp only [Equiv.preimage_image]`
theorem preimage_image (h : α ≃ᵤ β) (s : Set α) : h ⁻¹' (h '' s) = s :=
  h.toEquiv.preimage_image s
#align uniform_equiv.preimage_image UniformEquiv.preimage_image

protected theorem uniformInducing (h : α ≃ᵤ β) : UniformInducing h :=
  uniformInducing_of_compose h.uniformContinuous h.symm.uniformContinuous <| by
    simp only [symm_comp_self, uniformInducing_id]
#align uniform_equiv.uniform_inducing UniformEquiv.uniformInducing

theorem comap_eq (h : α ≃ᵤ β) : UniformSpace.comap h ‹_› = ‹_› := by
  ext : 1; exact h.uniformInducing.comap_uniformity
#align uniform_equiv.comap_eq UniformEquiv.comap_eq

protected theorem uniformEmbedding (h : α ≃ᵤ β) : UniformEmbedding h :=
  ⟨h.uniformInducing, h.injective⟩
#align uniform_equiv.uniform_embedding UniformEquiv.uniformEmbedding

/-- Uniform equiv given a uniform embedding. -/
noncomputable def ofUniformEmbedding (f : α → β) (hf : UniformEmbedding f) : α ≃ᵤ Set.range f
    where
  uniformContinuous_toFun := hf.toUniformInducing.uniformContinuous.subtype_mk _
  uniformContinuous_invFun := by
    rw [hf.toUniformInducing.uniformContinuous_iff, Equiv.invFun_as_coe,
      Equiv.self_comp_ofInjective_symm]
    exact uniformContinuous_subtype_val
  toEquiv := Equiv.ofInjective f hf.inj
#align uniform_equiv.of_uniform_embedding UniformEquiv.ofUniformEmbedding

/-- If two sets are equal, then they are uniformly equivalent. -/
def setCongr {s t : Set α} (h : s = t) : s ≃ᵤ t
    where
  uniformContinuous_toFun := uniformContinuous_subtype_val.subtype_mk _
  uniformContinuous_invFun := uniformContinuous_subtype_val.subtype_mk _
  toEquiv := Equiv.setCongr h
#align uniform_equiv.set_congr UniformEquiv.setCongr

/-- Product of two uniform isomorphisms. -/
def prodCongr (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) : α × γ ≃ᵤ β × δ
    where
  uniformContinuous_toFun :=
    (h₁.uniformContinuous.comp uniformContinuous_fst).prod_mk
      (h₂.uniformContinuous.comp uniformContinuous_snd)
  uniformContinuous_invFun :=
    (h₁.symm.uniformContinuous.comp uniformContinuous_fst).prod_mk
      (h₂.symm.uniformContinuous.comp uniformContinuous_snd)
  toEquiv := h₁.toEquiv.prodCongr h₂.toEquiv
#align uniform_equiv.prod_congr UniformEquiv.prodCongr

@[simp]
theorem prodCongr_symm (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) :
    (h₁.prodCongr h₂).symm = h₁.symm.prodCongr h₂.symm :=
  rfl
#align uniform_equiv.prod_congr_symm UniformEquiv.prodCongr_symm

@[simp]
theorem coe_prodCongr (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) : ⇑(h₁.prodCongr h₂) = Prod.map h₁ h₂ :=
  rfl
#align uniform_equiv.coe_prod_congr UniformEquiv.coe_prodCongr

section

variable (α β γ)

/-- `α × β` is uniformly isomorphic to `β × α`. -/
def prodComm : α × β ≃ᵤ β × α
    where
  uniformContinuous_toFun := uniformContinuous_snd.prod_mk uniformContinuous_fst
  uniformContinuous_invFun := uniformContinuous_snd.prod_mk uniformContinuous_fst
  toEquiv := Equiv.prodComm α β
#align uniform_equiv.prod_comm UniformEquiv.prodComm

@[simp]
theorem prodComm_symm : (prodComm α β).symm = prodComm β α :=
  rfl
#align uniform_equiv.prod_comm_symm UniformEquiv.prodComm_symm

@[simp]
theorem coe_prodComm : ⇑(prodComm α β) = Prod.swap :=
  rfl
#align uniform_equiv.coe_prod_comm UniformEquiv.coe_prodComm

/-- `(α × β) × γ` is uniformly isomorphic to `α × (β × γ)`. -/
def prodAssoc : (α × β) × γ ≃ᵤ α × β × γ
    where
  uniformContinuous_toFun :=
    (uniformContinuous_fst.comp uniformContinuous_fst).prod_mk
      ((uniformContinuous_snd.comp uniformContinuous_fst).prod_mk uniformContinuous_snd)
  uniformContinuous_invFun := by -- Porting note: the `rw` was not necessary in Lean 3
    rw [Equiv.invFun, Equiv.prodAssoc]
    exact (uniformContinuous_fst.prod_mk (uniformContinuous_fst.comp
    uniformContinuous_snd)).prod_mk (uniformContinuous_snd.comp uniformContinuous_snd)
  toEquiv := Equiv.prodAssoc α β γ
#align uniform_equiv.prod_assoc UniformEquiv.prodAssoc

/-- `α × {*}` is uniformly isomorphic to `α`. -/
@[simps! (config := { fullyApplied := false }) apply]
def prodPunit : α × PUnit ≃ᵤ α where
  toEquiv := Equiv.prodPUnit α
  uniformContinuous_toFun := uniformContinuous_fst
  uniformContinuous_invFun := uniformContinuous_id.prod_mk uniformContinuous_const
#align uniform_equiv.prod_punit UniformEquiv.prodPunit

/-- `{*} × α` is uniformly isomorphic to `α`. -/
def punitProd : PUnit × α ≃ᵤ α :=
  (prodComm _ _).trans (prodPunit _)
#align uniform_equiv.punit_prod UniformEquiv.punitProd

@[simp]
theorem coe_punitProd : ⇑(punitProd α) = Prod.snd :=
  rfl
#align uniform_equiv.coe_punit_prod UniformEquiv.coe_punitProd

/-- Uniform equivalence between `ulift α` and `α`. -/
def ulift : ULift.{v, u} α ≃ᵤ α :=
  { Equiv.ulift with
    uniformContinuous_toFun := uniformContinuous_comap
    uniformContinuous_invFun := by
      have hf : UniformInducing (@Equiv.ulift.{v, u} α).toFun := ⟨rfl⟩
      simp_rw [hf.uniformContinuous_iff]
      exact uniformContinuous_id }
#align uniform_equiv.ulift UniformEquiv.ulift

end

/-- If `ι` has a unique element, then `ι → α` is homeomorphic to `α`. -/
@[simps! (config := { fullyApplied := false })]
def funUnique (ι α : Type _) [Unique ι] [UniformSpace α] : (ι → α) ≃ᵤ α
    where
  toEquiv := Equiv.funUnique ι α
  uniformContinuous_toFun := Pi.uniformContinuous_proj _ _
  uniformContinuous_invFun := uniformContinuous_pi.mpr fun _ => uniformContinuous_id
#align uniform_equiv.fun_unique UniformEquiv.funUnique

/-- Uniform isomorphism between dependent functions `Π i : fin 2, α i` and `α 0 × α 1`. -/
@[simps! (config := { fullyApplied := false })]
def piFinTwo (α : Fin 2 → Type u) [∀ i, UniformSpace (α i)] : (∀ i, α i) ≃ᵤ α 0 × α 1
    where
  toEquiv := piFinTwoEquiv α
  uniformContinuous_toFun := (Pi.uniformContinuous_proj _ 0).prod_mk (Pi.uniformContinuous_proj _ 1)
  uniformContinuous_invFun :=
    uniformContinuous_pi.mpr <| Fin.forall_fin_two.2 ⟨uniformContinuous_fst, uniformContinuous_snd⟩
#align uniform_equiv.pi_fin_two UniformEquiv.piFinTwo

/-- Uniform isomorphism between `α² = fin 2 → α` and `α × α`. -/
-- Porting note: made `α` explicit
@[simps! (config := { fullyApplied := false })]
def finTwoArrow (α : Type _) [UniformSpace α]: (Fin 2 → α) ≃ᵤ α × α :=
  { piFinTwo fun _ => α with toEquiv := finTwoArrowEquiv α }
#align uniform_equiv.fin_two_arrow UniformEquiv.finTwoArrow

/-- A subset of a uniform space is uniformly isomorphic to its image under a uniform isomorphism.
-/
def image (e : α ≃ᵤ β) (s : Set α) : s ≃ᵤ e '' s
    where
  uniformContinuous_toFun := (e.uniformContinuous.comp uniformContinuous_subtype_val).subtype_mk _
  uniformContinuous_invFun :=
    (e.symm.uniformContinuous.comp uniformContinuous_subtype_val).subtype_mk _
  toEquiv := e.toEquiv.image s
#align uniform_equiv.image UniformEquiv.image

end UniformEquiv

/-- A uniform inducing equiv between uniform spaces is a uniform isomorphism. -/
-- @[simps] -- Porting note: removed, `simps?` produced no `simp` lemmas
def Equiv.toUniformEquivOfUniformInducing [UniformSpace α] [UniformSpace β] (f : α ≃ β)
    (hf : UniformInducing f) : α ≃ᵤ β :=
  { f with
    uniformContinuous_toFun := hf.uniformContinuous
    uniformContinuous_invFun := hf.uniformContinuous_iff.2 <| by simpa using uniformContinuous_id }
#align equiv.to_uniform_equiv_of_uniform_inducing Equiv.toUniformEquivOfUniformInducing


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen

! This file was ported from Lean 3 source module ring_theory.localization.integer
! leanprover-community/mathlib commit 9556784a5b84697562e9c6acb40500d4a82e675a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.RingTheory.Localization.Basic

/-!
# Integer elements of a localization

## Main definitions

 * `IsLocalization.IsInteger` is a predicate stating that `x : S` is in the image of `R`

## Implementation notes

See `RingTheory/Localization/Basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/

variable {R : Type _} [CommRing R] {M : Submonoid R} {S : Type _} [CommRing S]

variable [Algebra R S] {P : Type _} [CommRing P]

open Function

open BigOperators

namespace IsLocalization

section

variable (R)

-- TODO: define a subalgebra of `IsInteger`s
/-- Given `a : S`, `S` a localization of `R`, `IsInteger R a` iff `a` is in the image of
the localization map from `R` to `S`. -/
def IsInteger (a : S) : Prop :=
  a ∈ (algebraMap R S).range
#align is_localization.is_integer IsLocalization.IsInteger

end

theorem isInteger_zero : IsInteger R (0 : S) :=
  Subring.zero_mem _
#align is_localization.is_integer_zero IsLocalization.isInteger_zero

theorem isInteger_one : IsInteger R (1 : S) :=
  Subring.one_mem _
#align is_localization.is_integer_one IsLocalization.isInteger_one

theorem isInteger_add {a b : S} (ha : IsInteger R a) (hb : IsInteger R b) : IsInteger R (a + b) :=
  Subring.add_mem _ ha hb
#align is_localization.is_integer_add IsLocalization.isInteger_add

theorem isInteger_mul {a b : S} (ha : IsInteger R a) (hb : IsInteger R b) : IsInteger R (a * b) :=
  Subring.mul_mem _ ha hb
#align is_localization.is_integer_mul IsLocalization.isInteger_mul

variable (M)
variable [IsLocalization M S]

/-- Each element `a : S` has an `M`-multiple which is an integer.

This version multiplies `a` on the right, matching the argument order in `LocalizationMap.surj`.
-/
theorem exists_integer_multiple' (a : S) : ∃ b : M, IsInteger R (a * algebraMap R S b) :=
  let ⟨⟨Num, denom⟩, h⟩ := IsLocalization.surj _ a
  ⟨denom, Set.mem_range.mpr ⟨Num, h.symm⟩⟩
#align is_localization.exists_integer_multiple' IsLocalization.exists_integer_multiple'

/-- Each element `a : S` has an `M`-multiple which is an integer.

This version multiplies `a` on the left, matching the argument order in the `SMul` instance.
-/
theorem exists_integer_multiple (a : S) : ∃ b : M, IsInteger R ((b : R) • a) := by
  simp_rw [Algebra.smul_def, mul_comm _ a]
  apply exists_integer_multiple'
#align is_localization.exists_integer_multiple IsLocalization.exists_integer_multiple

/-- We can clear the denominators of a `Finset`-indexed family of fractions. -/
theorem exist_integer_multiples {ι : Type _} (s : Finset ι) (f : ι → S) :
    ∃ b : M, ∀ i ∈ s, IsLocalization.IsInteger R ((b : R) • f i) := by
  haveI := Classical.propDecidable
  refine' ⟨∏ i in s, (sec M (f i)).2, fun i hi => ⟨_, _⟩⟩
  · exact (∏ j in s.erase i, (sec M (f j)).2) * (sec M (f i)).1
  rw [RingHom.map_mul, sec_spec', ← mul_assoc, ← (algebraMap R S).map_mul, ← Algebra.smul_def]
  congr 2
  refine' _root_.trans _ ((Submonoid.subtype M).map_prod _ _).symm
  rw [mul_comm,Submonoid.coe_finset_prod,
    -- Porting note: explicitly supplied `f`
    ← Finset.prod_insert (f := fun i => ((sec M (f i)).snd : R)) (s.not_mem_erase i),
    Finset.insert_erase hi]
  rfl
#align is_localization.exist_integer_multiples IsLocalization.exist_integer_multiples

/-- We can clear the denominators of a finite indexed family of fractions. -/
theorem exist_integer_multiples_of_finite {ι : Type _} [Finite ι] (f : ι → S) :
    ∃ b : M, ∀ i, IsLocalization.IsInteger R ((b : R) • f i) := by
  cases nonempty_fintype ι
  obtain ⟨b, hb⟩ := exist_integer_multiples M Finset.univ f
  exact ⟨b, fun i => hb i (Finset.mem_univ _)⟩
#align is_localization.exist_integer_multiples_of_finite IsLocalization.exist_integer_multiples_of_finite

/-- We can clear the denominators of a finite set of fractions. -/
theorem exist_integer_multiples_of_finset (s : Finset S) :
    ∃ b : M, ∀ a ∈ s, IsInteger R ((b : R) • a) :=
  exist_integer_multiples M s id
#align is_localization.exist_integer_multiples_of_finset IsLocalization.exist_integer_multiples_of_finset

/-- A choice of a common multiple of the denominators of a `Finset`-indexed family of fractions. -/
noncomputable def commonDenom {ι : Type _} (s : Finset ι) (f : ι → S) : M :=
  (exist_integer_multiples M s f).choose
#align is_localization.common_denom IsLocalization.commonDenom

/-- The numerator of a fraction after clearing the denominators
of a `Finset`-indexed family of fractions. -/
noncomputable def integerMultiple {ι : Type _} (s : Finset ι) (f : ι → S) (i : s) : R :=
  ((exist_integer_multiples M s f).choose_spec i i.prop).choose
#align is_localization.integer_multiple IsLocalization.integerMultiple

@[simp]
theorem map_integerMultiple {ι : Type _} (s : Finset ι) (f : ι → S) (i : s) :
    algebraMap R S (integerMultiple M s f i) = commonDenom M s f • f i :=
  ((exist_integer_multiples M s f).choose_spec _ i.prop).choose_spec
#align is_localization.map_integer_multiple IsLocalization.map_integerMultiple

/-- A choice of a common multiple of the denominators of a finite set of fractions. -/
noncomputable def commonDenomOfFinset (s : Finset S) : M :=
  commonDenom M s id
#align is_localization.common_denom_of_finset IsLocalization.commonDenomOfFinset

/-- The finset of numerators after clearing the denominators of a finite set of fractions. -/
noncomputable def finsetIntegerMultiple [DecidableEq R] (s : Finset S) : Finset R :=
  s.attach.image fun t => integerMultiple M s id t
#align is_localization.finset_integer_multiple IsLocalization.finsetIntegerMultiple

open Pointwise

theorem finsetIntegerMultiple_image [DecidableEq R] (s : Finset S) :
    algebraMap R S '' finsetIntegerMultiple M s = commonDenomOfFinset M s • (s : Set S) := by
  delta finsetIntegerMultiple commonDenom
  rw [Finset.coe_image]
  ext
  constructor
  · rintro ⟨_, ⟨x, -, rfl⟩, rfl⟩
    rw [map_integerMultiple]
    exact Set.mem_image_of_mem _ x.prop
  · rintro ⟨x, hx, rfl⟩
    exact ⟨_, ⟨⟨x, hx⟩, s.mem_attach _, rfl⟩, map_integerMultiple M s id _⟩
#align is_localization.finset_integer_multiple_image IsLocalization.finsetIntegerMultiple_image

end IsLocalization


/-
Copyright (c) 2019 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Mario Carneiro, Isabel Longbottom, Scott Morrison, Apurva Nakade
-/
import set_theory.game.pgame
import tactic.abel

/-!
# Combinatorial games.

In this file we define the quotient of pre-games by the equivalence relation
`p ≈ q ↔ p ≤ q ∧ q ≤ p` (its `antisymmetrization`), and construct an instance `add_comm_group game`,
as well as an instance `partial_order game`.

## Multiplication on pre-games

We define the operations of multiplication and inverse on pre-games, and prove a few basic theorems
about them. Multiplication is not well-behaved under equivalence of pre-games i.e. `x ≈ y` does not
imply `x * z ≈ y * z`. Hence, multiplication is not a well-defined operation on games. Nevertheless,
the abelian group structure on games allows us to simplify many proofs for pre-games.
-/

open function pgame

open_locale pgame

universes u

instance pgame.setoid : setoid pgame :=
⟨(≈), equiv_refl, @pgame.equiv.symm, @pgame.equiv.trans⟩

/-- The type of combinatorial games. In ZFC, a combinatorial game is constructed from
  two sets of combinatorial games that have been constructed at an earlier
  stage. To do this in type theory, we say that a combinatorial pre-game is built
  inductively from two families of combinatorial games indexed over any type
  in Type u. The resulting type `pgame.{u}` lives in `Type (u+1)`,
  reflecting that it is a proper class in ZFC.
  A combinatorial game is then constructed by quotienting by the equivalence
  `x ≈ y ↔ x ≤ y ∧ y ≤ x`. -/
abbreviation game := quotient pgame.setoid

namespace game

instance : add_comm_group_with_one game :=
{ zero := ⟦0⟧,
  one := ⟦1⟧,
  neg := quot.lift (λ x, ⟦-x⟧) (λ x y h, quot.sound ((@neg_equiv_neg_iff x y).2 h)),
  add := quotient.lift₂ (λ x y : pgame, ⟦x + y⟧)
    (λ x₁ y₁ x₂ y₂ hx hy, quot.sound (pgame.add_congr hx hy)),
  add_zero := by { rintro ⟨x⟩, exact quot.sound (add_zero_equiv x) },
  zero_add := by { rintro ⟨x⟩, exact quot.sound (zero_add_equiv x) },
  add_assoc := by { rintros ⟨x⟩ ⟨y⟩ ⟨z⟩, exact quot.sound add_assoc_equiv },
  add_left_neg := by { rintro ⟨x⟩, exact quot.sound (add_left_neg_equiv x) },
  add_comm := by { rintros ⟨x⟩ ⟨y⟩, exact quot.sound add_comm_equiv } }

instance : inhabited game := ⟨0⟩

instance : partial_order game :=
{ le := quotient.lift₂ (≤) (λ x₁ y₁ x₂ y₂ hx hy, propext (le_congr hx hy)),
  le_refl := by { rintro ⟨x⟩, exact le_refl x },
  le_trans := by { rintro ⟨x⟩ ⟨y⟩ ⟨z⟩, exact @le_trans _ _ x y z },
  le_antisymm := by { rintro ⟨x⟩ ⟨y⟩ h₁ h₂, apply quot.sound, exact ⟨h₁, h₂⟩ },
  lt := quotient.lift₂ (<) (λ x₁ y₁ x₂ y₂ hx hy, propext (lt_congr hx hy)),
  lt_iff_le_not_le := by { rintro ⟨x⟩ ⟨y⟩, exact @lt_iff_le_not_le _ _ x y }, }

/-- The less or fuzzy relation on games.

If `0 ⧏ x` (less or fuzzy with), then Left can win `x` as the first player. -/
def lf : game → game → Prop :=
quotient.lift₂ lf (λ x₁ y₁ x₂ y₂ hx hy, propext (lf_congr hx hy))

local infix ` ⧏ `:50 := lf

/-- On `game`, simp-normal inequalities should use as few negations as possible. -/
@[simp] theorem not_le : ∀ {x y : game}, ¬ x ≤ y ↔ y ⧏ x :=
by { rintro ⟨x⟩ ⟨y⟩, exact pgame.not_le }

/-- On `game`, simp-normal inequalities should use as few negations as possible. -/
@[simp] theorem not_lf : ∀ {x y : game}, ¬ x ⧏ y ↔ y ≤ x :=
by { rintro ⟨x⟩ ⟨y⟩, exact not_lf }

instance : is_trichotomous game (⧏) :=
⟨by { rintro ⟨x⟩ ⟨y⟩, change _ ∨ ⟦x⟧ = ⟦y⟧ ∨ _, rw quotient.eq, apply lf_or_equiv_or_gf }⟩

/-! It can be useful to use these lemmas to turn `pgame` inequalities into `game` inequalities, as
the `add_comm_group` structure on `game` often simplifies many proofs. -/

theorem _root_.pgame.le_iff_game_le {x y : pgame} : x ≤ y ↔ ⟦x⟧ ≤ ⟦y⟧ := iff.rfl
theorem _root_.pgame.lf_iff_game_lf {x y : pgame} : pgame.lf x y ↔ ⟦x⟧ ⧏ ⟦y⟧ := iff.rfl
theorem _root_.pgame.lt_iff_game_lt {x y : pgame} : x < y ↔ ⟦x⟧ < ⟦y⟧ := iff.rfl
theorem _root_.pgame.equiv_iff_game_eq {x y : pgame} : x ≈ y ↔ ⟦x⟧ = ⟦y⟧ :=
(@quotient.eq _ _ x y).symm

/-- The fuzzy, confused, or incomparable relation on games.

If `x ‖ 0`, then the first player can always win `x`. -/
def fuzzy : game → game → Prop :=
quotient.lift₂ fuzzy (λ x₁ y₁ x₂ y₂ hx hy, propext (fuzzy_congr hx hy))

local infix ` ‖ `:50 := fuzzy

theorem _root_.pgame.fuzzy_iff_game_fuzzy {x y : pgame} : pgame.fuzzy x y ↔ ⟦x⟧ ‖ ⟦y⟧ := iff.rfl

instance covariant_class_add_le : covariant_class game game (+) (≤) :=
⟨by { rintro ⟨a⟩ ⟨b⟩ ⟨c⟩ h, exact @add_le_add_left _ _ _ _ b c h a }⟩

instance covariant_class_swap_add_le : covariant_class game game (swap (+)) (≤) :=
⟨by { rintro ⟨a⟩ ⟨b⟩ ⟨c⟩ h, exact @add_le_add_right _ _ _ _ b c h a }⟩

instance covariant_class_add_lt : covariant_class game game (+) (<) :=
⟨by { rintro ⟨a⟩ ⟨b⟩ ⟨c⟩ h, exact @add_lt_add_left _ _ _ _ b c h a }⟩

instance covariant_class_swap_add_lt : covariant_class game game (swap (+)) (<) :=
⟨by { rintro ⟨a⟩ ⟨b⟩ ⟨c⟩ h, exact @add_lt_add_right _ _ _ _ b c h a }⟩

theorem add_lf_add_right : ∀ {b c : game} (h : b ⧏ c) (a), b + a ⧏ c + a :=
by { rintro ⟨b⟩ ⟨c⟩ h ⟨a⟩, apply add_lf_add_right h }

theorem add_lf_add_left : ∀ {b c : game} (h : b ⧏ c) (a), a + b ⧏ a + c :=
by { rintro ⟨b⟩ ⟨c⟩ h ⟨a⟩, apply add_lf_add_left h }

instance ordered_add_comm_group : ordered_add_comm_group game :=
{ add_le_add_left := @add_le_add_left _ _ _ game.covariant_class_add_le,
  ..game.add_comm_group_with_one,
  ..game.partial_order }

end game

namespace pgame

@[simp] lemma quot_neg (a : pgame) : ⟦-a⟧ = -⟦a⟧ := rfl

@[simp] lemma quot_add (a b : pgame) : ⟦a + b⟧ = ⟦a⟧ + ⟦b⟧ := rfl

@[simp] lemma quot_sub (a b : pgame) : ⟦a - b⟧ = ⟦a⟧ - ⟦b⟧ := rfl

theorem quot_eq_of_mk_quot_eq {x y : pgame}
  (L : x.left_moves ≃ y.left_moves) (R : x.right_moves ≃ y.right_moves)
  (hl : ∀ i, ⟦x.move_left i⟧ = ⟦y.move_left (L i)⟧)
  (hr : ∀ j, ⟦x.move_right j⟧ = ⟦y.move_right (R j)⟧) : ⟦x⟧ = ⟦y⟧ :=
by { simp_rw [quotient.eq] at hl hr, exact quot.sound (equiv_of_mk_equiv L R hl hr) }

/-! Multiplicative operations can be defined at the level of pre-games,
but to prove their properties we need to use the abelian group structure of games.
Hence we define them here. -/

/-- The product of `x = {xL | xR}` and `y = {yL | yR}` is
`{xL*y + x*yL - xL*yL, xR*y + x*yR - xR*yR | xL*y + x*yR - xL*yR, x*yL + xR*y - xR*yL }`. -/
instance : has_mul pgame.{u} :=
⟨λ x y, begin
  induction x with xl xr xL xR IHxl IHxr generalizing y,
  induction y with yl yr yL yR IHyl IHyr,
  have y := mk yl yr yL yR,
  refine ⟨xl × yl ⊕ xr × yr, xl × yr ⊕ xr × yl, _, _⟩; rintro (⟨i, j⟩ | ⟨i, j⟩),
  { exact IHxl i y + IHyl j - IHxl i (yL j) },
  { exact IHxr i y + IHyr j - IHxr i (yR j) },
  { exact IHxl i y + IHyr j - IHxl i (yR j) },
  { exact IHxr i y + IHyl j - IHxr i (yL j) }
end⟩

theorem left_moves_mul : ∀ (x y : pgame.{u}), (x * y).left_moves
  = (x.left_moves × y.left_moves ⊕ x.right_moves × y.right_moves)
| ⟨_, _, _, _⟩ ⟨_, _, _, _⟩ := rfl

theorem right_moves_mul : ∀ (x y : pgame.{u}), (x * y).right_moves
  = (x.left_moves × y.right_moves ⊕ x.right_moves × y.left_moves)
| ⟨_, _, _, _⟩ ⟨_, _, _, _⟩ := rfl

/-- Turns two left or right moves for `x` and `y` into a left move for `x * y` and vice versa.

Even though these types are the same (not definitionally so), this is the preferred way to convert
between them. -/
def to_left_moves_mul {x y : pgame} :
  x.left_moves × y.left_moves ⊕ x.right_moves × y.right_moves ≃ (x * y).left_moves :=
equiv.cast (left_moves_mul x y).symm

/-- Turns a left and a right move for `x` and `y` into a right move for `x * y` and vice versa.

Even though these types are the same (not definitionally so), this is the preferred way to convert
between them. -/
def to_right_moves_mul {x y : pgame} :
  x.left_moves × y.right_moves ⊕ x.right_moves × y.left_moves ≃ (x * y).right_moves :=
equiv.cast (right_moves_mul x y).symm

@[simp] lemma mk_mul_move_left_inl {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_left (sum.inl (i, j)) =
  xL i * mk yl yr yL yR + mk xl xr xL xR * yL j - xL i * yL j :=
rfl

@[simp] lemma mul_move_left_inl {x y : pgame} {i j} :
   (x * y).move_left (to_left_moves_mul (sum.inl (i, j))) =
   x.move_left i * y + x * y.move_left j - x.move_left i * y.move_left j :=
by { cases x, cases y, refl }

@[simp] lemma mk_mul_move_left_inr {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_left (sum.inr (i, j)) =
  xR i * mk yl yr yL yR + mk xl xr xL xR * yR j - xR i * yR j :=
rfl

@[simp] lemma mul_move_left_inr {x y : pgame} {i j} :
  (x * y).move_left (to_left_moves_mul (sum.inr (i, j))) =
  x.move_right i * y + x * y.move_right j - x.move_right i * y.move_right j :=
by { cases x, cases y, refl }

@[simp] lemma mk_mul_move_right_inl {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_right (sum.inl (i, j)) =
  xL i * mk yl yr yL yR + mk xl xr xL xR * yR j - xL i * yR j :=
rfl

@[simp] lemma mul_move_right_inl {x y : pgame} {i j} :
  (x * y).move_right (to_right_moves_mul (sum.inl (i, j))) =
  x.move_left i * y + x * y.move_right j - x.move_left i * y.move_right j :=
by { cases x, cases y, refl }

@[simp] lemma mk_mul_move_right_inr {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_right (sum.inr (i, j)) =
  xR i * mk yl yr yL yR + mk xl xr xL xR * yL j - xR i * yL j :=
rfl

@[simp] lemma mul_move_right_inr {x y : pgame} {i j} :
  (x * y).move_right (to_right_moves_mul (sum.inr (i, j))) =
  x.move_right i * y + x * y.move_left j - x.move_right i * y.move_left j :=
by { cases x, cases y, refl }

@[simp] lemma neg_mk_mul_move_left_inl {xl xr yl yr} {xL xR yL yR} {i j} :
  (-(mk xl xr xL xR * mk yl yr yL yR)).move_left (sum.inl (i, j)) =
  -(xL i * mk yl yr yL yR + mk xl xr xL xR * yR j - xL i * yR j) :=
rfl

@[simp] lemma neg_mk_mul_move_left_inr {xl xr yl yr} {xL xR yL yR} {i j} :
  (-(mk xl xr xL xR * mk yl yr yL yR)).move_left (sum.inr (i, j)) =
  -(xR i * mk yl yr yL yR + mk xl xr xL xR * yL j - xR i * yL j) :=
rfl

@[simp] lemma neg_mk_mul_move_right_inl {xl xr yl yr} {xL xR yL yR} {i j} :
  (-(mk xl xr xL xR * mk yl yr yL yR)).move_right (sum.inl (i, j)) =
  -(xL i * mk yl yr yL yR + mk xl xr xL xR * yL j - xL i * yL j) :=
rfl

@[simp] lemma neg_mk_mul_move_right_inr {xl xr yl yr} {xL xR yL yR} {i j} :
  (-(mk xl xr xL xR * mk yl yr yL yR)).move_right (sum.inr (i, j)) =
  -(xR i * mk yl yr yL yR + mk xl xr xL xR * yR j - xR i * yR j) :=
rfl

lemma left_moves_mul_cases {x y : pgame} (k) {P : (x * y).left_moves → Prop}
  (hl : ∀ ix iy, P $ to_left_moves_mul (sum.inl ⟨ix, iy⟩))
  (hr : ∀ jx jy, P $ to_left_moves_mul (sum.inr ⟨jx, jy⟩)) : P k :=
begin
  rw ←to_left_moves_mul.apply_symm_apply k,
  rcases to_left_moves_mul.symm k with ⟨ix, iy⟩ | ⟨jx, jy⟩,
  { apply hl },
  { apply hr }
end

lemma right_moves_mul_cases {x y : pgame} (k) {P : (x * y).right_moves → Prop}
  (hl : ∀ ix jy, P $ to_right_moves_mul (sum.inl ⟨ix, jy⟩))
  (hr : ∀ jx iy, P $ to_right_moves_mul (sum.inr ⟨jx, iy⟩)) : P k :=
begin
  rw ←to_right_moves_mul.apply_symm_apply k,
  rcases to_right_moves_mul.symm k with ⟨ix, iy⟩ | ⟨jx, jy⟩,
  { apply hl },
  { apply hr }
end

/-- `x * y` and `y * x` have the same moves. -/
def mul_comm_relabelling : Π (x y : pgame.{u}), x * y ≡r y * x
| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ := begin
  refine ⟨equiv.sum_congr (equiv.prod_comm _ _) (equiv.prod_comm _ _),
    (equiv.sum_comm _ _).trans (equiv.sum_congr (equiv.prod_comm _ _) (equiv.prod_comm _ _)), _, _⟩;
  rintro (⟨i, j⟩ | ⟨i, j⟩);
  dsimp;
  exact ((add_comm_relabelling _ _).trans $ (mul_comm_relabelling _ _).add_congr
    (mul_comm_relabelling _ _)).sub_congr (mul_comm_relabelling _ _)
end
using_well_founded { dec_tac := pgame_wf_tac }

theorem quot_mul_comm (x y : pgame.{u}) : ⟦x * y⟧ = ⟦y * x⟧ :=
quot.sound (mul_comm_relabelling x y).equiv

/-- `x * y` is equivalent to `y * x`. -/
theorem mul_comm_equiv (x y : pgame) : x * y ≈ y * x :=
quotient.exact $ quot_mul_comm _ _

instance is_empty_mul_zero_left_moves (x : pgame.{u}) : is_empty (x * 0).left_moves :=
by { cases x, apply sum.is_empty }
instance is_empty_mul_zero_right_moves (x : pgame.{u}) : is_empty (x * 0).right_moves :=
by { cases x, apply sum.is_empty }
instance is_empty_zero_mul_left_moves (x : pgame.{u}) : is_empty (0 * x).left_moves :=
by { cases x, apply sum.is_empty }
instance is_empty_zero_mul_right_moves (x : pgame.{u}) : is_empty (0 * x).right_moves :=
by { cases x, apply sum.is_empty }

/-- `x * 0` has exactly the same moves as `0`. -/
def mul_zero_relabelling (x : pgame) : x * 0 ≡r 0 := relabelling.is_empty _

/-- `x * 0` is equivalent to `0`. -/
theorem mul_zero_equiv (x : pgame) : x * 0 ≈ 0 := (mul_zero_relabelling x).equiv

@[simp] theorem quot_mul_zero (x : pgame) : ⟦x * 0⟧ = ⟦0⟧ :=
@quotient.sound _ _ (x * 0) _ x.mul_zero_equiv

/-- `0 * x` has exactly the same moves as `0`. -/
def zero_mul_relabelling (x : pgame) : 0 * x ≡r 0 := relabelling.is_empty _

/-- `0 * x` is equivalent to `0`. -/
theorem zero_mul_equiv (x : pgame) : 0 * x ≈ 0 := (zero_mul_relabelling x).equiv

@[simp] theorem quot_zero_mul (x : pgame) : ⟦0 * x⟧ = ⟦0⟧ :=
@quotient.sound _ _ (0 * x) _ x.zero_mul_equiv

/-- `-x * y` and `-(x * y)` have the same moves. -/
def neg_mul_relabelling : Π (x y : pgame.{u}), -x * y ≡r -(x * y)
| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ := begin
  refine ⟨equiv.sum_comm _ _, equiv.sum_comm _ _, _, _⟩;
  rintro (⟨i, j⟩ | ⟨i, j⟩);
  dsimp;
  apply ((neg_add_relabelling _ _).trans _).symm;
  apply ((neg_add_relabelling _ _).trans (relabelling.add_congr _ _)).sub_congr;
  exact (neg_mul_relabelling _ _).symm
end
using_well_founded { dec_tac := pgame_wf_tac }

@[simp] theorem quot_neg_mul (x y : pgame) : ⟦-x * y⟧ = -⟦x * y⟧ :=
quot.sound (neg_mul_relabelling x y).equiv

/-- `x * -y` and `-(x * y)` have the same moves. -/
def mul_neg_relabelling (x y : pgame) : x * -y ≡r -(x * y) :=
(mul_comm_relabelling x _).trans $
  (neg_mul_relabelling _ x).trans (mul_comm_relabelling y x).neg_congr

@[simp] theorem quot_mul_neg (x y : pgame) : ⟦x * -y⟧ = -⟦x * y⟧ :=
quot.sound (mul_neg_relabelling x y).equiv

@[simp] theorem quot_left_distrib : Π (x y z : pgame), ⟦x * (y + z)⟧ = ⟦x * y⟧ + ⟦x * z⟧
| (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR) :=
begin
  let x := mk xl xr xL xR,
  let y := mk yl yr yL yR,
  let z := mk zl zr zL zR,
  refine quot_eq_of_mk_quot_eq _ _ _ _,
  { fsplit,
    { rintro (⟨_, _ | _⟩ | ⟨_, _ | _⟩);
      solve_by_elim [sum.inl, sum.inr, prod.mk] { max_depth := 5 } },
    { rintro (⟨⟨_, _⟩ | ⟨_, _⟩⟩ | ⟨_, _⟩ | ⟨_, _⟩);
      solve_by_elim [sum.inl, sum.inr, prod.mk] { max_depth := 5 } },
    { rintro (⟨_, _ | _⟩ | ⟨_, _ | _⟩); refl },
    { rintro (⟨⟨_, _⟩ | ⟨_, _⟩⟩ | ⟨_, _⟩ | ⟨_, _⟩); refl } },
  { fsplit,
    { rintro (⟨_, _ | _⟩ | ⟨_, _ | _⟩);
      solve_by_elim [sum.inl, sum.inr, prod.mk] { max_depth := 5 } },
    { rintro (⟨⟨_, _⟩ | ⟨_, _⟩⟩ | ⟨_, _⟩ | ⟨_, _⟩);
      solve_by_elim [sum.inl, sum.inr, prod.mk] { max_depth := 5 } },
    { rintro (⟨_, _ | _⟩ | ⟨_, _ | _⟩); refl },
    { rintro (⟨⟨_, _⟩ | ⟨_, _⟩⟩ | ⟨_, _⟩ | ⟨_, _⟩); refl } },
  { rintro (⟨i, j | k⟩ | ⟨i, j | k⟩),
    { change ⟦xL i * (y + z) + x * (yL j + z) - xL i * (yL j + z)⟧
             = ⟦xL i * y + x * yL j - xL i * yL j + x * z⟧,
      simp [quot_left_distrib], abel },
    { change ⟦xL i * (y + z) + x * (y + zL k) - xL i * (y + zL k)⟧
             = ⟦x * y + (xL i * z + x * zL k - xL i * zL k)⟧,
      simp [quot_left_distrib], abel },
    { change ⟦xR i * (y + z) + x * (yR j + z) - xR i * (yR j + z)⟧
             = ⟦xR i * y + x * yR j - xR i * yR j + x * z⟧,
      simp [quot_left_distrib], abel },
    { change ⟦xR i * (y + z) + x * (y + zR k) - xR i * (y + zR k)⟧
             = ⟦x * y + (xR i * z + x * zR k - xR i * zR k)⟧,
      simp [quot_left_distrib], abel } },
  { rintro (⟨i, j | k⟩ | ⟨i, j | k⟩),
    { change ⟦xL i * (y + z) + x * (yR j + z) - xL i * (yR j + z)⟧
             = ⟦xL i * y + x * yR j - xL i * yR j + x * z⟧,
      simp [quot_left_distrib], abel },
    { change ⟦xL i * (y + z) + x * (y + zR k) - xL i * (y + zR k)⟧
             = ⟦x * y + (xL i * z + x * zR k - xL i * zR k)⟧,
      simp [quot_left_distrib], abel },
    { change ⟦xR i * (y + z) + x * (yL j + z) - xR i * (yL j + z)⟧
             = ⟦xR i * y + x * yL j - xR i * yL j + x * z⟧,
      simp [quot_left_distrib], abel },
    { change ⟦xR i * (y + z) + x * (y + zL k) - xR i * (y + zL k)⟧
             = ⟦x * y + (xR i * z + x * zL k - xR i * zL k)⟧,
      simp [quot_left_distrib], abel } }
end
using_well_founded { dec_tac := pgame_wf_tac }

/-- `x * (y + z)` is equivalent to `x * y + x * z.`-/
theorem left_distrib_equiv (x y z : pgame) : x * (y + z) ≈ x * y + x * z :=
quotient.exact $ quot_left_distrib _ _ _

@[simp] theorem quot_left_distrib_sub (x y z : pgame) : ⟦x * (y - z)⟧ = ⟦x * y⟧ - ⟦x * z⟧ :=
by { change  ⟦x * (y + -z)⟧ = ⟦x * y⟧ + -⟦x * z⟧, rw [quot_left_distrib, quot_mul_neg] }

@[simp] theorem quot_right_distrib (x y z : pgame) : ⟦(x + y) * z⟧ = ⟦x * z⟧ + ⟦y * z⟧ :=
by simp only [quot_mul_comm, quot_left_distrib]

/-- `(x + y) * z` is equivalent to `x * z + y * z.`-/
theorem right_distrib_equiv (x y z : pgame) : (x + y) * z ≈ x * z + y * z :=
quotient.exact $ quot_right_distrib _ _ _

@[simp] theorem quot_right_distrib_sub (x y z : pgame) : ⟦(y - z) * x⟧ = ⟦y * x⟧ - ⟦z * x⟧ :=
by { change ⟦(y + -z) * x⟧ = ⟦y * x⟧ + -⟦z * x⟧, rw [quot_right_distrib, quot_neg_mul] }

/-- `x * 1` has the same moves as `x`. -/
def mul_one_relabelling : Π (x : pgame.{u}), x * 1 ≡r x
| ⟨xl, xr, xL, xR⟩ := begin
  unfold has_one.one,
  refine ⟨(equiv.sum_empty _ _).trans (equiv.prod_punit _),
    (equiv.empty_sum _ _).trans (equiv.prod_punit _), _, _⟩;
  try { rintro (⟨i, ⟨ ⟩⟩ | ⟨i, ⟨ ⟩⟩) }; try { intro i };
  dsimp;
  apply (relabelling.sub_congr (relabelling.refl _) (mul_zero_relabelling _)).trans;
  rw sub_zero;
  exact (add_zero_relabelling _).trans (((mul_one_relabelling _).add_congr
    (mul_zero_relabelling _)).trans $ add_zero_relabelling _)
end

@[simp] theorem quot_mul_one (x : pgame) : ⟦x * 1⟧ = ⟦x⟧ := quot.sound $ mul_one_relabelling x

/-- `x * 1` is equivalent to `x`. -/
theorem mul_one_equiv (x : pgame) : x * 1 ≈ x := quotient.exact $ quot_mul_one x

/-- `1 * x` has the same moves as `x`. -/
def one_mul_relabelling (x : pgame) : 1 * x ≡r x :=
(mul_comm_relabelling 1 x).trans $ mul_one_relabelling x

@[simp] theorem quot_one_mul (x : pgame) : ⟦1 * x⟧ = ⟦x⟧ := quot.sound $ one_mul_relabelling x

/-- `1 * x` is equivalent to `x`. -/
theorem one_mul_equiv (x : pgame) : 1 * x ≈ x := quotient.exact $ quot_one_mul x

theorem quot_mul_assoc : Π (x y z : pgame), ⟦x * y * z⟧ = ⟦x * (y * z)⟧
| (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR) :=
begin
  let x := mk xl xr xL xR,
  let y := mk yl yr yL yR,
  let z := mk zl zr zL zR,
  refine quot_eq_of_mk_quot_eq _ _ _ _,
  { fsplit,
    { rintro (⟨⟨_, _⟩ | ⟨_, _⟩, _⟩ | ⟨⟨_, _⟩ | ⟨_, _⟩, _⟩);
      solve_by_elim [sum.inl, sum.inr, prod.mk] { max_depth := 7 } },
    { rintro (⟨_, ⟨_, _⟩ | ⟨_, _⟩⟩ | ⟨_,⟨_, _⟩ | ⟨_, _⟩⟩);
      solve_by_elim [sum.inl, sum.inr, prod.mk] { max_depth := 7 } },
    { rintro (⟨⟨_, _⟩ | ⟨_, _⟩, _⟩ | ⟨⟨_,_⟩ | ⟨_, _⟩,_⟩); refl },
    { rintro (⟨_, ⟨_, _⟩ | ⟨_, _⟩⟩ | ⟨_,⟨_, _⟩ | ⟨_, _⟩⟩); refl } },
  { fsplit,
    { rintro (⟨⟨_, _⟩ | ⟨_, _⟩, _⟩ | ⟨⟨_, _⟩ | ⟨_, _⟩,_⟩);
      solve_by_elim [sum.inl, sum.inr, prod.mk] { max_depth := 7 } },
    { rintro (⟨_, ⟨_, _⟩ | ⟨_, _⟩⟩ | ⟨_, ⟨_, _⟩ | ⟨_, _⟩⟩);
      solve_by_elim [sum.inl, sum.inr, prod.mk] { max_depth := 7 } },
    { rintro (⟨⟨_, _⟩ | ⟨_, _⟩, _⟩ | ⟨⟨_, _⟩ | ⟨_, _⟩,_⟩); refl },
    { rintro (⟨_, ⟨_, _⟩ | ⟨_, _⟩⟩ | ⟨_, ⟨_, _⟩ | ⟨_, _⟩⟩); refl } },
  { rintro (⟨⟨i, j⟩ | ⟨i, j⟩, k⟩ | ⟨⟨i, j⟩ | ⟨i, j⟩, k⟩),
    { change ⟦(xL i * y + x * yL j - xL i * yL j) * z + (x * y) * zL k
               - (xL i * y + x * yL j - xL i * yL j) * zL k⟧
             = ⟦xL i * (y * z) + x * (yL j * z + y * zL k - yL j * zL k)
               - xL i * (yL j * z + y * zL k - yL j * zL k)⟧,
      simp [quot_mul_assoc], abel },
    { change ⟦(xR i * y + x * yR j - xR i * yR j) * z + (x * y) * zL k
               - (xR i * y + x * yR j - xR i * yR j) * zL k⟧
             = ⟦xR i * (y * z) + x * (yR j * z + y * zL k - yR j * zL k)
               - xR i * (yR j * z + y * zL k - yR j * zL k)⟧,
      simp [quot_mul_assoc], abel },
    { change ⟦(xL i * y + x * yR j - xL i * yR j) * z + (x * y) * zR k
               - (xL i * y + x * yR j - xL i * yR j) * zR k⟧
             = ⟦xL i * (y * z) + x * (yR j * z + y * zR k - yR j * zR k)
               - xL i * (yR j * z + y * zR k - yR j * zR k)⟧,
      simp [quot_mul_assoc], abel },
    { change ⟦(xR i * y + x * yL j - xR i * yL j) * z + (x * y) * zR k
               - (xR i * y + x * yL j - xR i * yL j) * zR k⟧
             = ⟦xR i * (y * z) + x * (yL j * z + y * zR k - yL j * zR k)
               - xR i * (yL j * z + y * zR k - yL j * zR k)⟧,
      simp [quot_mul_assoc], abel } },
  { rintro (⟨⟨i, j⟩ | ⟨i, j⟩, k⟩ | ⟨⟨i, j⟩ | ⟨i, j⟩, k⟩),
    { change ⟦(xL i * y + x * yL j - xL i * yL j) * z + (x * y) * zR k
               - (xL i * y + x * yL j - xL i * yL j) * zR k⟧
             = ⟦xL i * (y * z) + x * (yL j * z + y * zR k - yL j * zR k)
               - xL i * (yL j * z + y * zR k - yL j * zR k)⟧,
      simp [quot_mul_assoc], abel },
    { change ⟦(xR i * y + x * yR j - xR i * yR j) * z + (x * y) * zR k
               - (xR i * y + x * yR j - xR i * yR j) * zR k⟧
             = ⟦xR i * (y * z) + x * (yR j * z + y * zR k - yR j * zR k)
               - xR i * (yR j * z + y * zR k - yR j * zR k)⟧,
      simp [quot_mul_assoc], abel },
    { change ⟦(xL i * y + x * yR j - xL i * yR j) * z + (x * y) * zL k
               - (xL i * y + x * yR j - xL i * yR j) * zL k⟧
             = ⟦xL i * (y * z) + x * (yR j * z + y * zL k - yR j * zL k)
               - xL i * (yR j * z + y * zL k - yR j * zL k)⟧,
      simp [quot_mul_assoc], abel },
    { change ⟦(xR i * y + x * yL j - xR i * yL j) * z + (x * y) * zL k
               - (xR i * y + x * yL j - xR i * yL j) * zL k⟧
             = ⟦xR i * (y * z) + x * (yL j * z + y * zL k - yL j * zL k)
               - xR i * (yL j * z + y * zL k - yL j * zL k)⟧,
      simp [quot_mul_assoc], abel } }
end
using_well_founded { dec_tac := pgame_wf_tac }

/-- `x * y * z` is equivalent to `x * (y * z).`-/
theorem mul_assoc_equiv (x y z : pgame) : x * y * z ≈ x * (y * z) :=
quotient.exact $ quot_mul_assoc _ _ _

/-- Because the two halves of the definition of `inv` produce more elements
on each side, we have to define the two families inductively.
This is the indexing set for the function, and `inv_val` is the function part. -/
inductive inv_ty (l r : Type u) : bool → Type u
| zero : inv_ty ff
| left₁ : r → inv_ty ff → inv_ty ff
| left₂ : l → inv_ty tt → inv_ty ff
| right₁ : l → inv_ty ff → inv_ty tt
| right₂ : r → inv_ty tt → inv_ty tt

instance (l r : Type u) [is_empty l] [is_empty r] : is_empty (inv_ty l r tt) :=
⟨by rintro (_|_|_|a|a); exact is_empty_elim a⟩

instance (l r : Type u) : inhabited (inv_ty l r ff) := ⟨inv_ty.zero⟩

instance unique_inv_ty (l r : Type u) [is_empty l] [is_empty r] : unique (inv_ty l r ff) :=
{ uniq := by { rintro (a|a|a), refl, all_goals { exact is_empty_elim a } },
  ..inv_ty.inhabited l r }

/-- Because the two halves of the definition of `inv` produce more elements
of each side, we have to define the two families inductively.
This is the function part, defined by recursion on `inv_ty`. -/
def inv_val {l r} (L : l → pgame) (R : r → pgame)
  (IHl : l → pgame) (IHr : r → pgame) : ∀ {b}, inv_ty l r b → pgame
| _ inv_ty.zero := 0
| _ (inv_ty.left₁ i j) := (1 + (R i - mk l r L R) * inv_val j) * IHr i
| _ (inv_ty.left₂ i j) := (1 + (L i - mk l r L R) * inv_val j) * IHl i
| _ (inv_ty.right₁ i j) := (1 + (L i - mk l r L R) * inv_val j) * IHl i
| _ (inv_ty.right₂ i j) := (1 + (R i - mk l r L R) * inv_val j) * IHr i

@[simp] theorem inv_val_is_empty {l r : Type u} {b} (L R IHl IHr) (i : inv_ty l r b)
  [is_empty l] [is_empty r] : inv_val L R IHl IHr i = 0 :=
begin
  cases i with a _ a _ a _ a,
  { refl },
  all_goals { exact is_empty_elim a }
end

/-- The inverse of a positive surreal number `x = {L | R}` is
given by `x⁻¹ = {0,
  (1 + (R - x) * x⁻¹L) * R, (1 + (L - x) * x⁻¹R) * L |
  (1 + (L - x) * x⁻¹L) * L, (1 + (R - x) * x⁻¹R) * R}`.
Because the two halves `x⁻¹L, x⁻¹R` of `x⁻¹` are used in their own
definition, the sets and elements are inductively generated. -/
def inv' : pgame → pgame
| ⟨l, r, L, R⟩ :=
  let l' := {i // 0 < L i},
      L' : l' → pgame := λ i, L i.1,
      IHl' : l' → pgame := λ i, inv' (L i.1),
      IHr := λ i, inv' (R i) in
  ⟨inv_ty l' r ff, inv_ty l' r tt,
    inv_val L' R IHl' IHr, inv_val L' R IHl' IHr⟩

theorem zero_lf_inv' : ∀ (x : pgame), 0 ⧏ inv' x
| ⟨xl, xr, xL, xR⟩ := by { convert lf_mk _ _ inv_ty.zero, refl }

/-- `inv' 0` has exactly the same moves as `1`. -/
def inv'_zero : inv' 0 ≡r 1 :=
begin
  change mk _ _ _ _ ≡r 1,
  refine ⟨_, _, λ i, _, is_empty.elim _⟩,
  { apply equiv.equiv_punit (inv_ty _ _ _),
    apply_instance },
  { apply equiv.equiv_pempty (inv_ty _ _ _),
    apply_instance },
  { simp },
  { dsimp,
    apply_instance }
end

theorem inv'_zero_equiv : inv' 0 ≈ 1 := inv'_zero.equiv

/-- `inv' 1` has exactly the same moves as `1`. -/
def inv'_one : inv' 1 ≡r (1 : pgame.{u}) :=
begin
  change relabelling (mk _ _ _ _) 1,
  haveI : is_empty {i : punit.{u+1} // (0 : pgame.{u}) < 0},
  { rw lt_self_iff_false, apply_instance },
  refine ⟨_, _, λ i, _, is_empty.elim _⟩; dsimp,
  { apply equiv.equiv_punit },
  { apply equiv.equiv_of_is_empty },
  { simp },
  { apply_instance }
end

theorem inv'_one_equiv : inv' 1 ≈ 1 := inv'_one.equiv

/-- The inverse of a pre-game in terms of the inverse on positive pre-games. -/
noncomputable instance : has_inv pgame :=
⟨by { classical, exact λ x, if x ≈ 0 then 0 else if 0 < x then inv' x else -inv' (-x) }⟩

noncomputable instance : has_div pgame := ⟨λ x y, x * y⁻¹⟩

theorem inv_eq_of_equiv_zero {x : pgame} (h : x ≈ 0) : x⁻¹ = 0 :=
by { classical, exact if_pos h }

@[simp] theorem inv_zero : (0 : pgame)⁻¹ = 0 :=
inv_eq_of_equiv_zero (equiv_refl _)

theorem inv_eq_of_pos {x : pgame} (h : 0 < x) : x⁻¹ = inv' x :=
by { classical, exact (if_neg h.lf.not_equiv').trans (if_pos h) }

theorem inv_eq_of_lf_zero {x : pgame} (h : x ⧏ 0) : x⁻¹ = -inv' (-x) :=
by { classical, exact (if_neg h.not_equiv).trans (if_neg h.not_gt) }

/-- `1⁻¹` has exactly the same moves as `1`. -/
def inv_one : 1⁻¹ ≡r 1 :=
by { rw inv_eq_of_pos pgame.zero_lt_one, exact inv'_one }

theorem inv_one_equiv : 1⁻¹ ≈ 1 := inv_one.equiv

end pgame


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.lattice
import Mathlib.data.multiset.sort
import Mathlib.data.list.nodup_equiv_fin
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Construct a sorted list from a finset.
-/

namespace finset

/-! ### sort -/

/-- `sort s` constructs a sorted list from the unordered set `s`.
  (Uses merge sort algorithm.) -/
def sort {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r] [is_antisymm α r]
    [is_total α r] (s : finset α) : List α :=
  multiset.sort r (val s)

@[simp] theorem sort_sorted {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r]
    [is_antisymm α r] [is_total α r] (s : finset α) : list.sorted r (sort r s) :=
  multiset.sort_sorted r (val s)

@[simp] theorem sort_eq {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r]
    [is_antisymm α r] [is_total α r] (s : finset α) : ↑(sort r s) = val s :=
  multiset.sort_eq r (val s)

@[simp] theorem sort_nodup {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r]
    [is_antisymm α r] [is_total α r] (s : finset α) : list.nodup (sort r s) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (multiset.nodup ↑(sort r s))) (sort_eq r s))) (nodup s)

@[simp] theorem sort_to_finset {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r]
    [is_antisymm α r] [is_total α r] [DecidableEq α] (s : finset α) :
    list.to_finset (sort r s) = s :=
  list.to_finset_eq (sort_nodup r s) ▸ eq_of_veq (sort_eq r s)

@[simp] theorem mem_sort {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r]
    [is_antisymm α r] [is_total α r] {s : finset α} {a : α} : a ∈ sort r s ↔ a ∈ s :=
  multiset.mem_sort r

@[simp] theorem length_sort {α : Type u_1} (r : α → α → Prop) [DecidableRel r] [is_trans α r]
    [is_antisymm α r] [is_total α r] {s : finset α} : list.length (sort r s) = card s :=
  multiset.length_sort r

theorem sort_sorted_lt {α : Type u_1} [linear_order α] (s : finset α) :
    list.sorted Less (sort LessEq s) :=
  list.pairwise.imp₂ lt_of_le_of_ne (sort_sorted LessEq s) (sort_nodup LessEq s)

theorem sorted_zero_eq_min'_aux {α : Type u_1} [linear_order α] (s : finset α)
    (h : 0 < list.length (sort LessEq s)) (H : finset.nonempty s) :
    list.nth_le (sort LessEq s) 0 h = min' s H :=
  sorry

theorem sorted_zero_eq_min' {α : Type u_1} [linear_order α] {s : finset α}
    {h : 0 < list.length (sort LessEq s)} :
    list.nth_le (sort LessEq s) 0 h =
        min' s
          (iff.mp card_pos
            (eq.mp (Eq._oldrec (Eq.refl (0 < list.length (sort LessEq s))) (length_sort LessEq))
              h)) :=
  sorted_zero_eq_min'_aux s h
    (iff.mp card_pos
      (eq.mp (Eq._oldrec (Eq.refl (0 < list.length (sort LessEq s))) (length_sort LessEq)) h))

theorem min'_eq_sorted_zero {α : Type u_1} [linear_order α] {s : finset α} {h : finset.nonempty s} :
    min' s h =
        list.nth_le (sort LessEq s) 0
          (eq.mpr (id (Eq._oldrec (Eq.refl (0 < list.length (sort LessEq s))) (length_sort LessEq)))
            (iff.mpr card_pos h)) :=
  Eq.symm
    (sorted_zero_eq_min'_aux s
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 < list.length (sort LessEq s))) (length_sort LessEq)))
        (iff.mpr card_pos h))
      h)

theorem sorted_last_eq_max'_aux {α : Type u_1} [linear_order α] (s : finset α)
    (h : list.length (sort LessEq s) - 1 < list.length (sort LessEq s)) (H : finset.nonempty s) :
    list.nth_le (sort LessEq s) (list.length (sort LessEq s) - 1) h = max' s H :=
  sorry

theorem sorted_last_eq_max' {α : Type u_1} [linear_order α] {s : finset α}
    {h : list.length (sort LessEq s) - 1 < list.length (sort LessEq s)} :
    list.nth_le (sort LessEq s) (list.length (sort LessEq s) - 1) h =
        max' s
          (iff.mp card_pos
            (lt_of_le_of_lt bot_le
              (eq.mp
                (Eq._oldrec
                  (Eq.refl (list.length (sort LessEq s) - 1 < list.length (sort LessEq s)))
                  (length_sort LessEq))
                h))) :=
  sorry

theorem max'_eq_sorted_last {α : Type u_1} [linear_order α] {s : finset α} {h : finset.nonempty s} :
    max' s h =
        list.nth_le (sort LessEq s) (list.length (sort LessEq s) - 1)
          (eq.mpr
            (id
              ((fun (ᾰ ᾰ_1 : ℕ) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : ℕ) (e_3 : ᾰ_2 = ᾰ_3) =>
                  congr (congr_arg Less e_2) e_3)
                (list.length (sort LessEq s) - 1) (card s - 1)
                ((fun (ᾰ ᾰ_1 : ℕ) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : ℕ) (e_3 : ᾰ_2 = ᾰ_3) =>
                    congr (congr_arg Sub.sub e_2) e_3)
                  (list.length (sort LessEq s)) (card s) (length_sort LessEq) 1 1 (Eq.refl 1))
                (list.length (sort LessEq s)) (card s) (length_sort LessEq)))
            (eq.mp (Eq.refl (card s - 1 < card s))
              (nat.sub_lt (iff.mpr card_pos h) zero_lt_one))) :=
  sorry

/-- Given a finset `s` of cardinality `k` in a linear order `α`, the map `order_iso_of_fin s h`
is the increasing bijection between `fin k` and `s` as an `order_iso`. Here, `h` is a proof that
the cardinality of `s` is `k`. We use this instead of an iso `fin s.card ≃o s` to avoid
casting issues in further uses of this function. -/
def order_iso_of_fin {α : Type u_1} [linear_order α] (s : finset α) {k : ℕ} (h : card s = k) :
    fin k ≃o ↥↑s :=
  order_iso.trans (fin.cast sorry)
    (order_iso.trans (list.sorted.nth_le_iso (sort LessEq s) (sort_sorted_lt s))
      (order_iso.set_congr (fun (x : α) => list.mem x (sort LessEq s)) ↑s sorry))

/-- Given a finset `s` of cardinality `k` in a linear order `α`, the map `order_emb_of_fin s h` is
the increasing bijection between `fin k` and `s` as an order embedding into `α`. Here, `h` is a
proof that the cardinality of `s` is `k`. We use this instead of an embedding `fin s.card ↪o α` to
avoid casting issues in further uses of this function. -/
def order_emb_of_fin {α : Type u_1} [linear_order α] (s : finset α) {k : ℕ} (h : card s = k) :
    fin k ↪o α :=
  rel_embedding.trans (order_iso.to_order_embedding (order_iso_of_fin s h))
    (order_embedding.subtype fun (x : α) => x ∈ ↑s)

@[simp] theorem coe_order_iso_of_fin_apply {α : Type u_1} [linear_order α] (s : finset α) {k : ℕ}
    (h : card s = k) (i : fin k) :
    ↑(coe_fn (order_iso_of_fin s h) i) = coe_fn (order_emb_of_fin s h) i :=
  rfl

theorem order_iso_of_fin_symm_apply {α : Type u_1} [linear_order α] (s : finset α) {k : ℕ}
    (h : card s = k) (x : ↥↑s) :
    ↑(coe_fn (order_iso.symm (order_iso_of_fin s h)) x) = list.index_of (↑x) (sort LessEq s) :=
  rfl

theorem order_emb_of_fin_apply {α : Type u_1} [linear_order α] (s : finset α) {k : ℕ}
    (h : card s = k) (i : fin k) :
    coe_fn (order_emb_of_fin s h) i =
        list.nth_le (sort LessEq s) (↑i)
          (eq.mpr
            (id (Eq._oldrec (Eq.refl (↑i < list.length (sort LessEq s))) (length_sort LessEq)))
            (eq.mpr (id (Eq._oldrec (Eq.refl (↑i < card s)) h)) (subtype.property i))) :=
  rfl

@[simp] theorem order_emb_of_fin_mem {α : Type u_1} [linear_order α] (s : finset α) {k : ℕ}
    (h : card s = k) (i : fin k) : coe_fn (order_emb_of_fin s h) i ∈ s :=
  subtype.property (coe_fn (order_iso_of_fin s h) i)

@[simp] theorem range_order_emb_of_fin {α : Type u_1} [linear_order α] (s : finset α) {k : ℕ}
    (h : card s = k) : set.range ⇑(order_emb_of_fin s h) = ↑s :=
  sorry

/-- The bijection `order_emb_of_fin s h` sends `0` to the minimum of `s`. -/
theorem order_emb_of_fin_zero {α : Type u_1} [linear_order α] {s : finset α} {k : ℕ}
    (h : card s = k) (hz : 0 < k) :
    coe_fn (order_emb_of_fin s h) { val := 0, property := hz } =
        min' s (iff.mp card_pos (Eq.symm h ▸ hz)) :=
  sorry

/-- The bijection `order_emb_of_fin s h` sends `k-1` to the maximum of `s`. -/
theorem order_emb_of_fin_last {α : Type u_1} [linear_order α] {s : finset α} {k : ℕ}
    (h : card s = k) (hz : 0 < k) :
    coe_fn (order_emb_of_fin s h) { val := k - 1, property := buffer.lt_aux_2 hz } =
        max' s (iff.mp card_pos (Eq.symm h ▸ hz)) :=
  sorry

/-- `order_emb_of_fin {a} h` sends any argument to `a`. -/
@[simp] theorem order_emb_of_fin_singleton {α : Type u_1} [linear_order α] (a : α) (i : fin 1) :
    coe_fn (order_emb_of_fin (singleton a) (card_singleton a)) i = a :=
  sorry

/-- Any increasing map `f` from `fin k` to a finset of cardinality `k` has to coincide with
the increasing bijection `order_emb_of_fin s h`. -/
theorem order_emb_of_fin_unique {α : Type u_1} [linear_order α] {s : finset α} {k : ℕ}
    (h : card s = k) {f : fin k → α} (hfs : ∀ (x : fin k), f x ∈ s) (hmono : strict_mono f) :
    f = ⇑(order_emb_of_fin s h) :=
  sorry

/-- An order embedding `f` from `fin k` to a finset of cardinality `k` has to coincide with
the increasing bijection `order_emb_of_fin s h`. -/
theorem order_emb_of_fin_unique' {α : Type u_1} [linear_order α] {s : finset α} {k : ℕ}
    (h : card s = k) {f : fin k ↪o α} (hfs : ∀ (x : fin k), coe_fn f x ∈ s) :
    f = order_emb_of_fin s h :=
  rel_embedding.ext
    (iff.mp function.funext_iff (order_emb_of_fin_unique h hfs (order_embedding.strict_mono f)))

/-- Two parametrizations `order_emb_of_fin` of the same set take the same value on `i` and `j` if
and only if `i = j`. Since they can be defined on a priori not defeq types `fin k` and `fin l`
(although necessarily `k = l`), the conclusion is rather written `(i : ℕ) = (j : ℕ)`. -/
@[simp] theorem order_emb_of_fin_eq_order_emb_of_fin_iff {α : Type u_1} [linear_order α] {k : ℕ}
    {l : ℕ} {s : finset α} {i : fin k} {j : fin l} {h : card s = k} {h' : card s = l} :
    coe_fn (order_emb_of_fin s h) i = coe_fn (order_emb_of_fin s h') j ↔ ↑i = ↑j :=
  sorry

protected instance has_repr {α : Type u_1} [has_repr α] : has_repr (finset α) :=
  has_repr.mk fun (s : finset α) => repr (val s)

end Mathlib


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

/-!
# The powerset of a finset
-/

namespace finset
open multiset

variables {α : Type*}

/-! ### powerset -/
section powerset

/-- When `s` is a finset, `s.powerset` is the finset of all subsets of `s` (seen as finsets). -/
def powerset (s : finset α) : finset (finset α) :=
⟨s.1.powerset.pmap finset.mk
  (λ t h, nodup_of_le (mem_powerset.1 h) s.2),
 nodup_pmap (λ a ha b hb, congr_arg finset.val)
   (nodup_powerset.2 s.2)⟩

@[simp] theorem mem_powerset {s t : finset α} : s ∈ powerset t ↔ s ⊆ t :=
by cases s; simp only [powerset, mem_mk, mem_pmap, mem_powerset, exists_prop, exists_eq_right];
  rw ← val_le_iff

@[simp] theorem empty_mem_powerset (s : finset α) : ∅ ∈ powerset s :=
mem_powerset.2 (empty_subset _)

@[simp] theorem mem_powerset_self (s : finset α) : s ∈ powerset s :=
mem_powerset.2 (subset.refl _)

@[simp] lemma powerset_empty : finset.powerset (∅ : finset α) = {∅} := rfl

@[simp] theorem powerset_mono {s t : finset α} : powerset s ⊆ powerset t ↔ s ⊆ t :=
⟨λ h, (mem_powerset.1 $ h $ mem_powerset_self _),
 λ st u h, mem_powerset.2 $ subset.trans (mem_powerset.1 h) st⟩

@[simp] theorem card_powerset (s : finset α) :
  card (powerset s) = 2 ^ card s :=
(card_pmap _ _ _).trans (card_powerset s.1)

lemma not_mem_of_mem_powerset_of_not_mem {s t : finset α} {a : α}
  (ht : t ∈ s.powerset) (h : a ∉ s) : a ∉ t :=
by { apply mt _ h, apply mem_powerset.1 ht }

lemma powerset_insert [decidable_eq α] (s : finset α) (a : α) :
  powerset (insert a s) = s.powerset ∪ s.powerset.image (insert a) :=
begin
  ext t,
  simp only [exists_prop, mem_powerset, mem_image, mem_union, subset_insert_iff],
  by_cases h : a ∈ t,
  { split,
    { exact λH, or.inr ⟨_, H, insert_erase h⟩ },
    { intros H,
      cases H,
      { exact subset.trans (erase_subset a t) H },
      { rcases H with ⟨u, hu⟩,
        rw ← hu.2,
        exact subset.trans (erase_insert_subset a u) hu.1 } } },
  { have : ¬ ∃ (u : finset α), u ⊆ s ∧ insert a u = t,
      by simp [ne.symm (ne_insert_of_not_mem _ _ h)],
    simp [finset.erase_eq_of_not_mem h, this] }
end

end powerset

section powerset_len

/-- Given an integer `n` and a finset `s`, then `powerset_len n s` is the finset of subsets of `s`
of cardinality `n`. -/
def powerset_len (n : ℕ) (s : finset α) : finset (finset α) :=
⟨(s.1.powerset_len n).pmap finset.mk
  (λ t h, nodup_of_le (mem_powerset_len.1 h).1 s.2),
 nodup_pmap (λ a ha b hb, congr_arg finset.val)
   (nodup_powerset_len s.2)⟩

theorem mem_powerset_len {n} {s t : finset α} :
  s ∈ powerset_len n t ↔ s ⊆ t ∧ card s = n :=
by cases s; simp [powerset_len, val_le_iff.symm]; refl

@[simp] theorem powerset_len_mono {n} {s t : finset α} (h : s ⊆ t) :
  powerset_len n s ⊆ powerset_len n t :=
λ u h', mem_powerset_len.2 $
  and.imp (λ h₂, subset.trans h₂ h) id (mem_powerset_len.1 h')

@[simp] theorem card_powerset_len (n : ℕ) (s : finset α) :
  card (powerset_len n s) = nat.choose (card s) n :=
(card_pmap _ _ _).trans (card_powerset_len n s.1)

@[simp] lemma powerset_len_zero (s : finset α) : finset.powerset_len 0 s = {∅} :=
begin
  ext, rw [mem_powerset_len, mem_singleton, card_eq_zero],
  refine ⟨λ h, h.2, λ h, by { rw h, exact ⟨empty_subset s, rfl⟩ }⟩,
end

@[simp] theorem powerset_len_empty (n : ℕ) {s : finset α} (h : s.card < n) :
  powerset_len n s = ∅ :=
finset.card_eq_zero.mp (by rw [card_powerset_len, nat.choose_eq_zero_of_lt h])

theorem powerset_len_eq_filter {n} {s : finset α} :
  powerset_len n s = (powerset s).filter (λ x, x.card = n) :=
by { ext, simp [mem_powerset_len] }

lemma powerset_len_succ_insert [decidable_eq α] {x : α} {s : finset α} (h : x ∉ s) (n : ℕ) :
  powerset_len n.succ (insert x s) = powerset_len n.succ s ∪ (powerset_len n s).image (insert x) :=
begin
  rw [powerset_len_eq_filter, powerset_insert, filter_union, ←powerset_len_eq_filter],
  congr,
  rw [powerset_len_eq_filter, image_filter],
  congr' 1,
  ext t,
  simp only [mem_powerset, mem_filter, function.comp_app, and.congr_right_iff],
  intro ht,
  have : x ∉ t := λ H, h (ht H),
  simp [card_insert_of_not_mem this, nat.succ_inj']
end

lemma powerset_len_nonempty {n : ℕ} {s : finset α} (h : n < s.card) :
  (powerset_len n s).nonempty :=
begin
  classical,
  induction s using finset.induction_on with x s hx IH generalizing n,
  { simpa using h },
  { cases n,
    { simp },
    { rw [card_insert_of_not_mem hx, nat.succ_lt_succ_iff] at h,
      rw powerset_len_succ_insert hx,
      refine nonempty.mono _ ((IH h).image (insert x)),
      convert (subset_union_right _ _) } }
end

@[simp] lemma powerset_len_self (s : finset α) :
  powerset_len s.card s = {s} :=
begin
  ext,
  rw [mem_powerset_len, mem_singleton],
  split,
  { exact λ ⟨hs, hc⟩, eq_of_subset_of_card_le hs hc.ge },
  { rintro rfl,
    simp }
end

lemma powerset_card_bUnion [decidable_eq (finset α)] (s : finset α) :
  finset.powerset s = (range (s.card + 1)).bUnion (λ i, powerset_len i s) :=
begin
  refine ext (λ a, ⟨λ ha, _, λ ha, _ ⟩),
  { rw mem_bUnion,
    exact ⟨a.card, mem_range.mpr (nat.lt_succ_of_le (card_le_of_subset (mem_powerset.mp ha))),
      mem_powerset_len.mpr ⟨mem_powerset.mp ha, rfl⟩⟩ },
  { rcases mem_bUnion.mp ha with ⟨i, hi, ha⟩,
    exact mem_powerset.mpr (mem_powerset_len.mp ha).1, }
end

lemma powerset_len_sup [decidable_eq α] (u : finset α) (n : ℕ) (hn : n < u.card) :
  (powerset_len n.succ u).sup id = u :=
begin
  apply le_antisymm,
  { simp_rw [sup_le_iff, mem_powerset_len],
    rintros x ⟨h, -⟩,
    exact h },
  { rw [sup_eq_bUnion, le_iff_subset, subset_iff],
    cases (nat.succ_le_of_lt hn).eq_or_lt with h' h',
    { simp [h'] },
    { intros x hx,
      simp only [mem_bUnion, exists_prop, id.def],
      obtain ⟨t, ht⟩ : ∃ t, t ∈ powerset_len n (u.erase x) := powerset_len_nonempty _,
      { refine ⟨insert x t, _, mem_insert_self _ _⟩,
        rw [←insert_erase hx, powerset_len_succ_insert (not_mem_erase _ _)],
        exact mem_union_right _ (mem_image_of_mem _ ht) },
      { rwa [card_erase_of_mem hx, nat.lt_pred_iff] } } }
end

end powerset_len
end finset


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar si s es una suceción que converge a a y c es un
-- número real, entonces c * s converge a c * a.
-- ----------------------------------------------------------------------

import .Convergencia_de_la_funcion_constante

variables {s : ℕ → ℝ} {a : ℝ}

lemma converges_to_mul_const_l1
  {c ε : ℝ}
  (h : 0 < c)
  : c * (ε / c) = ε :=
begin
  rw mul_comm,
  apply div_mul_cancel ε,
  exact ne_of_gt h,
end

-- Prueba
-- ======

/-
c ε : ℝ,
h : 0 < c
⊢ c * (ε / c) = ε
  >> rw mul_comm,
⊢ ε / c * c = ε
  >> apply div_mul_cancel ε,
⊢ c ≠ 0
  >> exact ne_of_gt h,
no goals
-/

theorem converges_to_mul_const
  {c : ℝ}
  (cs : converges_to s a)
  : converges_to (λ n, c * s n) (c * a) :=
begin
  by_cases h : c = 0,
  { convert converges_to_const 0,
    { ext,
      rw [h, zero_mul] },
    { rw [h, zero_mul] }},
  have acpos : 0 < abs c,
    from abs_pos.mpr h,
  intros ε εpos,
  dsimp,
  have εcpos : 0 < ε / abs c,
    by exact div_pos εpos acpos,
  cases cs (ε / abs c) εcpos with Ns hs,
  use Ns,
  intros n hn,
  specialize hs n hn,
  calc abs (c * s n - c * a)
           = abs (c * (s n - a))   : by { congr, ring }
       ... = abs c * abs (s n - a) : by apply abs_mul
       ... < abs c * (ε / abs c)   : by exact mul_lt_mul_of_pos_left hs acpos
       ... = ε                     : by apply converges_to_mul_const_l1 acpos
end

-- Prueba
-- ======

/-
s : ℕ → ℝ,
a c : ℝ,
cs : converges_to s a
⊢ converges_to (λ (n : ℕ), c * s n) (c * a)
  >> by_cases h : c = 0,
| h : c = 0
| ⊢ converges_to (λ (n : ℕ), c * s n) (c * a)
|   >> { convert converges_to_const 0,
| | ⊢ (λ (n : ℕ), c * s n) = λ (x : ℕ), 0
| |   >>   { ext,
| | x : ℕ
| | ⊢ c * s x = 0
| |   >>     rw [h, zero_mul] },
| s : ℕ → ℝ,
| a c : ℝ,
| cs : converges_to s a,
| h : c = 0
| ⊢ c * a = 0
|   >>   rw [h, zero_mul] },
s : ℕ → ℝ,
a c : ℝ,
cs : converges_to s a,
h : ¬c = 0
⊢ converges_to (λ (n : ℕ), c * s n) (c * a)
  >> have acpos : 0 < abs c,
| ⊢ 0 < abs c
|   >>   from abs_pos_of_ne_zero h,
acpos : 0 < abs c
⊢ converges_to (λ (n : ℕ), c * s n) (c * a)
  >> intros ε εpos,
ε : ℝ,
εpos : ε > 0
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs ((λ (n : ℕ), c * s n) n - c * a) < ε
  >> dsimp,
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (c * s n - c * a) < ε
  >> have εcpos : 0 < ε / abs c,
  >>   by exact div_pos εpos acpos,
εcpos : 0 < ε / abs c
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (c * s n - c * a) < ε
  >> cases cs (ε / abs c) εcpos with Ns hs,
Ns : ℕ,
hs : ∀ (n : ℕ), n ≥ Ns → abs (s n - a) < ε / abs c
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (c * s n - c * a) < ε
  >> use Ns,
⊢ ∀ (n : ℕ), n ≥ Ns → abs (c * s n - c * a) < ε
  >> intros n hn,
n : ℕ,
hn : n ≥ Ns
⊢ abs (c * s n - c * a) < ε
  >> specialize hs n hn,
hs : abs (s n - a) < ε / abs c
⊢ abs (c * s n - c * a) < ε
  >> calc abs (c * s n - c * a)
  >>     = abs (c * (s n - a))   : by { congr, ring }
  >> ... = abs c * abs (s n - a) : by apply abs_mul
  >> ... < abs c * (ε / abs c)   : by exact mul_lt_mul_of_pos_left hs acpos
  >> ... = ε                     : by apply converges_to_mul_const_l1-/
/-acpos,
no goals
-/

-- Comentario: Se han usado los lemas
-- + mul_comm a b : a * b = b * a
-- + ne_of_gt : a > b → a ≠ b
-- + converges_to_const a : converges_to (λ (x : ℕ), a) a
-- + zero_mul a : 0 * a = 0
-- + abs_pos_of_ne_zero : a ≠ 0 → 0 < abs a
-- + div_pos : 0 < a → 0 < b → 0 < a / b
-- + abs_mul a b : abs (a * b) = abs a * abs b
-- + mul_lt_mul_of_pos_left : a < b → 0 < d → d * a < d * b

-- Comprobación:
-- variables (b d : ℝ)
-- #check @mul_comm _ _ a b
-- #check @ne_of_gt _ _ a b
-- #check converges_to_const a
-- #check @zero_mul _ _ a
-- #check @abs_pos_of_ne_zero _ _ a
-- #check @div_pos _ _ a b
-- #check @abs_mul _ _ a b
-- #check @mul_lt_mul_of_pos_left _ _ a b d


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/

import algebra.algebra.basic

/-!
# Subfields

Let `K` be a field. This file defines the "bundled" subfield type `subfield K`, a type
whose terms correspond to subfields of `K`. This is the preferred way to talk
about subfields in mathlib. Unbundled subfields (`s : set K` and `is_subfield s`)
are not in this file, and they will ultimately be deprecated.

We prove that subfields are a complete lattice, and that you can `map` (pushforward) and
`comap` (pull back) them along ring homomorphisms.

We define the `closure` construction from `set R` to `subfield R`, sending a subset of `R`
to the subfield it generates, and prove that it is a Galois insertion.

## Main definitions

Notation used here:

`(K : Type u) [field K] (L : Type u) [field L] (f g : K →+* L)`
`(A : subfield K) (B : subfield L) (s : set K)`

* `subfield R` : the type of subfields of a ring `R`.

* `instance : complete_lattice (subfield R)` : the complete lattice structure on the subfields.

* `subfield.closure` : subfield closure of a set, i.e., the smallest subfield that includes the set.

* `subfield.gi` : `closure : set M → subfield M` and coercion `coe : subfield M → set M`
  form a `galois_insertion`.

* `comap f B : subfield K` : the preimage of a subfield `B` along the ring homomorphism `f`

* `map f A : subfield L` : the image of a subfield `A` along the ring homomorphism `f`.

* `prod A B : subfield (K × L)` : the product of subfields

* `f.field_range : subfield B` : the range of the ring homomorphism `f`.

* `eq_locus_field f g : subfield K` : given ring homomorphisms `f g : K →+* R`,
     the subfield of `K` where `f x = g x`

## Implementation notes

A subfield is implemented as a subring which is is closed under `⁻¹`.

Lattice inclusion (e.g. `≤` and `⊓`) is used rather than set notation (`⊆` and `∩`), although
`∈` is defined as membership of a subfield's underlying set.

## Tags
subfield, subfields
-/

open_locale big_operators
universes u v w

variables {K : Type u} {L : Type v} {M : Type w} [field K] [field L] [field M]

set_option old_structure_cmd true

/-- `subfield R` is the type of subfields of `R`. A subfield of `R` is a subset `s` that is a
  multiplicative submonoid and an additive subgroup. Note in particular that it shares the
  same 0 and 1 as R. -/
structure subfield (K : Type u) [field K] extends subring K :=
(inv_mem' : ∀ x ∈ carrier, x⁻¹ ∈ carrier)

/-- Reinterpret a `subfield` as a `subring`. -/
add_decl_doc subfield.to_subring

namespace subfield

/-- The underlying `add_subgroup` of a subfield. -/
def to_add_subgroup (s : subfield K) : add_subgroup K :=
{ ..s.to_subring.to_add_subgroup }

/-- The underlying submonoid of a subfield. -/
def to_submonoid (s : subfield K) : submonoid K :=
{ ..s.to_subring.to_submonoid }

instance : set_like (subfield K) K :=
⟨subfield.carrier, λ p q h, by cases p; cases q; congr'⟩

@[simp]
lemma mem_carrier {s : subfield K} {x : K} : x ∈ s.carrier ↔ x ∈ s := iff.rfl

/-- Two subfields are equal if they have the same elements. -/
@[ext] theorem ext {S T : subfield K} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T := set_like.ext h

/-- Copy of a submodule with a new `carrier` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (S : subfield K) (s : set K) (hs : s = ↑S) : subfield K :=
{ carrier := s,
  inv_mem' := hs.symm ▸ S.inv_mem',
  ..S.to_subring.copy s hs }

@[simp] lemma coe_to_subring (s : subfield K) : (s.to_subring : set K) = s :=
rfl

@[simp] lemma mem_mk (s : set K) (ho hm hz ha hn hi) (x : K) :
  x ∈ subfield.mk s ho hm hz ha hn hi ↔ x ∈ s := iff.rfl

@[simp] lemma mem_to_subring (s : subfield K) (x : K) :
  x ∈ s.to_subring ↔ x ∈ s := iff.rfl

end subfield

/-- A `subring` containing inverses is a `subfield`. -/
def subring.to_subfield (s : subring K) (hinv : ∀ x ∈ s, x⁻¹ ∈ s) : subfield K :=
{ inv_mem' := hinv
  ..s }

namespace subfield

variables (s t : subfield K)

/-- A subfield contains the ring's 1. -/
theorem one_mem : (1 : K) ∈ s := s.one_mem'

/-- A subfield contains the ring's 0. -/
theorem zero_mem : (0 : K) ∈ s := s.zero_mem'

/-- A subfield is closed under multiplication. -/
theorem mul_mem : ∀ {x y : K}, x ∈ s → y ∈ s → x * y ∈ s := s.mul_mem'

/-- A subfield is closed under addition. -/
theorem add_mem : ∀ {x y : K}, x ∈ s → y ∈ s → x + y ∈ s := s.add_mem'

/-- A subfield is closed under negation. -/
theorem neg_mem : ∀ {x : K}, x ∈ s → -x ∈ s := s.neg_mem'

/-- A subfield is closed under subtraction. -/
theorem sub_mem {x y : K} : x ∈ s → y ∈ s → x - y ∈ s := s.to_subring.sub_mem

/-- A subfield is closed under inverses. -/
theorem inv_mem : ∀ {x : K}, x ∈ s → x⁻¹ ∈ s := s.inv_mem'

/-- A subfield is closed under division. -/
theorem div_mem {x y : K} (hx : x ∈ s) (hy : y ∈ s) : x / y ∈ s :=
by { rw div_eq_mul_inv, exact s.mul_mem hx (s.inv_mem hy) }

/-- Product of a list of elements in a subfield is in the subfield. -/
lemma list_prod_mem {l : list K} : (∀ x ∈ l, x ∈ s) → l.prod ∈ s :=
s.to_submonoid.list_prod_mem

/-- Sum of a list of elements in a subfield is in the subfield. -/
lemma list_sum_mem {l : list K} : (∀ x ∈ l, x ∈ s) → l.sum ∈ s :=
s.to_add_subgroup.list_sum_mem

/-- Product of a multiset of elements in a subfield is in the subfield. -/
lemma multiset_prod_mem (m : multiset K) :
  (∀ a ∈ m, a ∈ s) → m.prod ∈ s :=
s.to_submonoid.multiset_prod_mem m

/-- Sum of a multiset of elements in a `subfield` is in the `subfield`. -/
lemma multiset_sum_mem (m : multiset K) :
  (∀ a ∈ m, a ∈ s) → m.sum ∈ s :=
s.to_add_subgroup.multiset_sum_mem m

/-- Product of elements of a subfield indexed by a `finset` is in the subfield. -/
lemma prod_mem {ι : Type*} {t : finset ι} {f : ι → K} (h : ∀ c ∈ t, f c ∈ s) :
  ∏ i in t, f i ∈ s :=
s.to_submonoid.prod_mem h

/-- Sum of elements in a `subfield` indexed by a `finset` is in the `subfield`. -/
lemma sum_mem {ι : Type*} {t : finset ι} {f : ι → K} (h : ∀ c ∈ t, f c ∈ s) :
  ∑ i in t, f i ∈ s :=
s.to_add_subgroup.sum_mem h

lemma pow_mem {x : K} (hx : x ∈ s) (n : ℕ) : x^n ∈ s := s.to_submonoid.pow_mem hx n

lemma gsmul_mem {x : K} (hx : x ∈ s) (n : ℤ) :
  n • x ∈ s := s.to_add_subgroup.gsmul_mem hx n

lemma coe_int_mem (n : ℤ) : (n : K) ∈ s :=
by simp only [← gsmul_one, gsmul_mem, one_mem]

instance : ring s := s.to_subring.to_ring
instance : has_div s := ⟨λ x y, ⟨x / y, s.div_mem x.2 y.2⟩⟩
instance : has_inv s := ⟨λ x, ⟨x⁻¹, s.inv_mem x.2⟩⟩

/-- A subfield inherits a field structure -/
instance to_field : field s :=
subtype.coe_injective.field coe
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)

/-- A subfield of a `linear_ordered_field` is a `linear_ordered_field`. -/
instance to_linear_ordered_field {K} [linear_ordered_field K] (s : subfield K) :
  linear_ordered_field s :=
subtype.coe_injective.linear_ordered_field coe
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)

@[simp, norm_cast] lemma coe_add (x y : s) : (↑(x + y) : K) = ↑x + ↑y := rfl
@[simp, norm_cast] lemma coe_sub (x y : s) : (↑(x - y) : K) = ↑x - ↑y := rfl
@[simp, norm_cast] lemma coe_neg (x : s) : (↑(-x) : K) = -↑x := rfl
@[simp, norm_cast] lemma coe_mul (x y : s) : (↑(x * y) : K) = ↑x * ↑y := rfl
@[simp, norm_cast] lemma coe_div (x y : s) : (↑(x / y) : K) = ↑x / ↑y := rfl
@[simp, norm_cast] lemma coe_inv (x : s) : (↑(x⁻¹) : K) = (↑x)⁻¹ := rfl
@[simp, norm_cast] lemma coe_zero : ((0 : s) : K) = 0 := rfl
@[simp, norm_cast] lemma coe_one : ((1 : s) : K) = 1 := rfl

/-- The embedding from a subfield of the field `K` to `K`. -/
def subtype (s : subfield K) : s →+* K :=
{ to_fun := coe,
 .. s.to_submonoid.subtype, .. s.to_add_subgroup.subtype }

instance to_algebra : algebra s K := ring_hom.to_algebra s.subtype

@[simp] theorem coe_subtype : ⇑s.subtype = coe := rfl

/-! # Partial order -/

variables (s t)

@[simp] lemma mem_to_submonoid {s : subfield K} {x : K} : x ∈ s.to_submonoid ↔ x ∈ s := iff.rfl
@[simp] lemma coe_to_submonoid : (s.to_submonoid : set K) = s := rfl
@[simp] lemma mem_to_add_subgroup {s : subfield K} {x : K} :
  x ∈ s.to_add_subgroup ↔ x ∈ s := iff.rfl
@[simp] lemma coe_to_add_subgroup : (s.to_add_subgroup : set K) = s := rfl

/-! # top -/

/-- The subfield of `K` containing all elements of `K`. -/
instance : has_top (subfield K) :=
⟨{ inv_mem' := λ x _, subring.mem_top x, .. (⊤ : subring K)}⟩

instance : inhabited (subfield K) := ⟨⊤⟩

@[simp] lemma mem_top (x : K) : x ∈ (⊤ : subfield K) := set.mem_univ x

@[simp] lemma coe_top : ((⊤ : subfield K) : set K) = set.univ := rfl

/-! # comap -/

variables (f : K →+* L)

/-- The preimage of a subfield along a ring homomorphism is a subfield. -/
def comap (s : subfield L) : subfield K :=
{ inv_mem' := λ x hx, show f (x⁻¹) ∈ s, by { rw f.map_inv, exact s.inv_mem hx },
  .. s.to_subring.comap f }

@[simp] lemma coe_comap (s : subfield L) : (s.comap f : set K) = f ⁻¹' s := rfl

@[simp]
lemma mem_comap {s : subfield L} {f : K →+* L} {x : K} : x ∈ s.comap f ↔ f x ∈ s := iff.rfl

lemma comap_comap (s : subfield M) (g : L →+* M) (f : K →+* L) :
  (s.comap g).comap f = s.comap (g.comp f) :=
rfl

/-! # map -/

/-- The image of a subfield along a ring homomorphism is a subfield. -/
def map (s : subfield K) : subfield L :=
{ inv_mem' := by { rintros _ ⟨x, hx, rfl⟩, exact ⟨x⁻¹, s.inv_mem hx, f.map_inv x⟩ },
  .. s.to_subring.map f }

@[simp] lemma coe_map : (s.map f : set L) = f '' s := rfl

@[simp] lemma mem_map {f : K →+* L} {s : subfield K} {y : L} :
  y ∈ s.map f ↔ ∃ x ∈ s, f x = y :=
set.mem_image_iff_bex

lemma map_map (g : L →+* M) (f : K →+* L) : (s.map f).map g = s.map (g.comp f) :=
set_like.ext' $ set.image_image _ _ _

lemma map_le_iff_le_comap {f : K →+* L} {s : subfield K} {t : subfield L} :
  s.map f ≤ t ↔ s ≤ t.comap f :=
set.image_subset_iff

lemma gc_map_comap (f : K →+* L) : galois_connection (map f) (comap f) :=
λ S T, map_le_iff_le_comap

end subfield

namespace ring_hom

variables (g : L →+* M) (f : K →+* L)

/-! # range -/

/-- The range of a ring homomorphism, as a subfield of the target. See Note [range copy pattern]. -/
def field_range : subfield L :=
((⊤ : subfield K).map f).copy (set.range f) set.image_univ.symm

@[simp] lemma coe_field_range : (f.field_range : set L) = set.range f := rfl

@[simp] lemma mem_field_range {f : K →+* L} {y : L} : y ∈ f.field_range ↔ ∃ x, f x = y := iff.rfl

lemma field_range_eq_map : f.field_range = subfield.map f ⊤ :=
by { ext, simp }

lemma map_field_range : f.field_range.map g = (g.comp f).field_range :=
by simpa only [field_range_eq_map] using (⊤ : subfield K).map_map g f

end ring_hom

namespace subfield

/-! # inf -/

/-- The inf of two subfields is their intersection. -/
instance : has_inf (subfield K) :=
⟨λ s t,
  { inv_mem' := λ x hx, subring.mem_inf.mpr
      ⟨s.inv_mem (subring.mem_inf.mp hx).1,
       t.inv_mem (subring.mem_inf.mp hx).2⟩,
    .. s.to_subring ⊓ t.to_subring }⟩

@[simp] lemma coe_inf (p p' : subfield K) : ((p ⊓ p' : subfield K) : set K) = p ∩ p' := rfl

@[simp] lemma mem_inf {p p' : subfield K} {x : K} : x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' := iff.rfl

instance : has_Inf (subfield K) :=
⟨λ S,
  { inv_mem' := begin
      rintros x hx,
      apply subring.mem_Inf.mpr,
      rintro _ ⟨p, p_mem, rfl⟩,
      exact p.inv_mem (subring.mem_Inf.mp hx p.to_subring ⟨p, p_mem, rfl⟩),
    end,
    .. Inf (subfield.to_subring '' S) }⟩

@[simp, norm_cast] lemma coe_Inf (S : set (subfield K)) :
  ((Inf S : subfield K) : set K) = ⋂ s ∈ S, ↑s :=
show ((Inf (subfield.to_subring '' S) : subring K) : set K) = ⋂ s ∈ S, ↑s,
begin
  ext x,
  rw [subring.coe_Inf, set.mem_Inter, set.mem_Inter],
  exact ⟨λ h s s' ⟨s_mem, s'_eq⟩, h s.to_subring _ ⟨⟨s, s_mem, rfl⟩, s'_eq⟩,
         λ h s s' ⟨⟨s'', s''_mem, s_eq⟩, (s'_eq : ↑s = s')⟩,
           h s'' _ ⟨s''_mem, by simp [←s_eq, ← s'_eq]⟩⟩
end

lemma mem_Inf {S : set (subfield K)} {x : K} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p :=
subring.mem_Inf.trans
  ⟨λ h p hp, h p.to_subring ⟨p, hp, rfl⟩,
   λ h p ⟨p', hp', p_eq⟩, p_eq ▸ h p' hp'⟩

@[simp] lemma Inf_to_subring (s : set (subfield K)) :
  (Inf s).to_subring = ⨅ t ∈ s, subfield.to_subring t :=
begin
  ext x,
  rw [mem_to_subring, mem_Inf],
  erw subring.mem_Inf,
  exact ⟨λ h p ⟨p', hp⟩, hp ▸ subring.mem_Inf.mpr (λ p ⟨hp', hp⟩, hp ▸ h _ hp'),
         λ h p hp, h p.to_subring ⟨p, subring.ext (λ x,
           ⟨λ hx, subring.mem_Inf.mp hx _ ⟨hp, rfl⟩,
            λ hx, subring.mem_Inf.mpr (λ p' ⟨hp, p'_eq⟩, p'_eq ▸ hx)⟩)⟩⟩
end

lemma is_glb_Inf (S : set (subfield K)) : is_glb S (Inf S) :=
begin
  refine is_glb.of_image (λ s t, show (s : set K) ≤ t ↔ s ≤ t, from set_like.coe_subset_coe) _,
  convert is_glb_binfi,
  exact coe_Inf _
end

/-- Subfields of a ring form a complete lattice. -/
instance : complete_lattice (subfield K) :=
{ top := ⊤,
  le_top := λ s x hx, trivial,
  inf := (⊓),
  inf_le_left := λ s t x, and.left,
  inf_le_right := λ s t x, and.right,
  le_inf := λ s t₁ t₂ h₁ h₂ x hx, ⟨h₁ hx, h₂ hx⟩,
  .. complete_lattice_of_Inf (subfield K) is_glb_Inf }

/-! # subfield closure of a subset -/

/-- The `subfield` generated by a set. -/
def closure (s : set K) : subfield K :=
{ carrier := { (x / y) | (x ∈ subring.closure s) (y ∈ subring.closure s) },
  zero_mem' := ⟨0, subring.zero_mem _, 1, subring.one_mem _, div_one _⟩,
  one_mem' := ⟨1, subring.one_mem _, 1, subring.one_mem _, div_one _⟩,
  neg_mem' := λ x ⟨y, hy, z, hz, x_eq⟩, ⟨-y, subring.neg_mem _ hy, z, hz, x_eq ▸ neg_div _ _⟩,
  inv_mem' := λ x ⟨y, hy, z, hz, x_eq⟩, ⟨z, hz, y, hy, x_eq ▸ inv_div.symm⟩,
  add_mem' := λ x y x_mem y_mem, begin
    obtain ⟨nx, hnx, dx, hdx, rfl⟩ := id x_mem,
    obtain ⟨ny, hny, dy, hdy, rfl⟩ := id y_mem,
    by_cases hx0 : dx = 0, { rwa [hx0, div_zero, zero_add] },
    by_cases hy0 : dy = 0, { rwa [hy0, div_zero, add_zero] },
    exact ⟨nx * dy + dx * ny,
          subring.add_mem _ (subring.mul_mem _ hnx hdy) (subring.mul_mem _ hdx hny),
          dx * dy, subring.mul_mem _ hdx hdy,
          (div_add_div nx ny hx0 hy0).symm⟩
  end,
  mul_mem' := λ x y x_mem y_mem, begin
    obtain ⟨nx, hnx, dx, hdx, rfl⟩ := id x_mem,
    obtain ⟨ny, hny, dy, hdy, rfl⟩ := id y_mem,
    exact ⟨nx * ny, subring.mul_mem _ hnx hny,
           dx * dy, subring.mul_mem _ hdx hdy,
           (div_mul_div _ _ _ _).symm⟩
  end }

lemma mem_closure_iff {s : set K} {x} :
  x ∈ closure s ↔ ∃ (y ∈ subring.closure s) (z ∈ subring.closure s), y / z = x := iff.rfl

lemma subring_closure_le (s : set K) : subring.closure s ≤ (closure s).to_subring :=
λ x hx, ⟨x, hx, 1, subring.one_mem _, div_one x⟩

/-- The subfield generated by a set includes the set. -/
@[simp] lemma subset_closure {s : set K} : s ⊆ closure s :=
set.subset.trans subring.subset_closure (subring_closure_le s)

lemma mem_closure {x : K} {s : set K} : x ∈ closure s ↔ ∀ S : subfield K, s ⊆ S → x ∈ S :=
⟨λ ⟨y, hy, z, hz, x_eq⟩ t le, x_eq ▸
  t.div_mem
    (subring.mem_closure.mp hy t.to_subring le)
    (subring.mem_closure.mp hz t.to_subring le),
  λ h, h (closure s) subset_closure⟩

/-- A subfield `t` includes `closure s` if and only if it includes `s`. -/
@[simp]
lemma closure_le {s : set K} {t : subfield K} : closure s ≤ t ↔ s ⊆ t :=
⟨set.subset.trans subset_closure, λ h x hx, mem_closure.mp hx t h⟩

/-- Subfield closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`. -/
lemma closure_mono ⦃s t : set K⦄ (h : s ⊆ t) : closure s ≤ closure t :=
closure_le.2 $ set.subset.trans h subset_closure

lemma closure_eq_of_le {s : set K} {t : subfield K} (h₁ : s ⊆ t) (h₂ : t ≤ closure s) :
  closure s = t :=
le_antisymm (closure_le.2 h₁) h₂

/-- An induction principle for closure membership. If `p` holds for `1`, and all elements
of `s`, and is preserved under addition, negation, and multiplication, then `p` holds for all
elements of the closure of `s`. -/
@[elab_as_eliminator]
lemma closure_induction {s : set K} {p : K → Prop} {x} (h : x ∈ closure s)
  (Hs : ∀ x ∈ s, p x) (H1 : p 1)
  (Hadd : ∀ x y, p x → p y → p (x + y))
  (Hneg : ∀ x, p x → p (-x))
  (Hinv : ∀ x, p x → p (x⁻¹))
  (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
(@closure_le _ _ _ ⟨p, H1, Hmul,
  @add_neg_self K _ 1 ▸ Hadd _ _ H1 (Hneg _ H1), Hadd, Hneg, Hinv⟩).2 Hs h

variable (K)
/-- `closure` forms a Galois insertion with the coercion to set. -/
protected def gi : galois_insertion (@closure K _) coe :=
{ choice := λ s _, closure s,
  gc := λ s t, closure_le,
  le_l_u := λ s, subset_closure,
  choice_eq := λ s h, rfl }

variable {K}

/-- Closure of a subfield `S` equals `S`. -/
lemma closure_eq (s : subfield K) : closure (s : set K) = s := (subfield.gi K).l_u_eq s

@[simp] lemma closure_empty : closure (∅ : set K) = ⊥ := (subfield.gi K).gc.l_bot

@[simp] lemma closure_univ : closure (set.univ : set K) = ⊤ := @coe_top K _ ▸ closure_eq ⊤

lemma closure_union (s t : set K) : closure (s ∪ t) = closure s ⊔ closure t :=
(subfield.gi K).gc.l_sup

lemma closure_Union {ι} (s : ι → set K) : closure (⋃ i, s i) = ⨆ i, closure (s i) :=
(subfield.gi K).gc.l_supr

lemma closure_sUnion (s : set (set K)) : closure (⋃₀ s) = ⨆ t ∈ s, closure t :=
(subfield.gi K).gc.l_Sup

lemma map_sup (s t : subfield K) (f : K →+* L) : (s ⊔ t).map f = s.map f ⊔ t.map f :=
(gc_map_comap f).l_sup

lemma map_supr {ι : Sort*} (f : K →+* L) (s : ι → subfield K) :
  (supr s).map f = ⨆ i, (s i).map f :=
(gc_map_comap f).l_supr

lemma comap_inf (s t : subfield L) (f : K →+* L) : (s ⊓ t).comap f = s.comap f ⊓ t.comap f :=
(gc_map_comap f).u_inf

lemma comap_infi {ι : Sort*} (f : K →+* L) (s : ι → subfield L) :
  (infi s).comap f = ⨅ i, (s i).comap f :=
(gc_map_comap f).u_infi

@[simp] lemma map_bot (f : K →+* L) : (⊥ : subfield K).map f = ⊥ :=
(gc_map_comap f).l_bot

@[simp] lemma comap_top (f : K →+* L) : (⊤ : subfield L).comap f = ⊤ :=
(gc_map_comap f).u_top

/-- The underlying set of a non-empty directed Sup of subfields is just a union of the subfields.
  Note that this fails without the directedness assumption (the union of two subfields is
  typically not a subfield) -/
lemma mem_supr_of_directed {ι} [hι : nonempty ι] {S : ι → subfield K} (hS : directed (≤) S)
  {x : K} : x ∈ (⨆ i, S i) ↔ ∃ i, x ∈ S i :=
begin
  refine ⟨_, λ ⟨i, hi⟩, (set_like.le_def.1 $ le_supr S i) hi⟩,
  suffices : x ∈ closure (⋃ i, (S i : set K)) → ∃ i, x ∈ S i,
  by simpa only [closure_Union, closure_eq],
  refine λ hx, closure_induction hx (λ x, set.mem_Union.mp) _ _ _ _ _,
  { exact hι.elim (λ i, ⟨i, (S i).one_mem⟩) },
  { rintros x y ⟨i, hi⟩ ⟨j, hj⟩,
    obtain ⟨k, hki, hkj⟩ := hS i j,
    exact ⟨k, (S k).add_mem (hki hi) (hkj hj)⟩ },
  { rintros x ⟨i, hi⟩,
    exact ⟨i, (S i).neg_mem hi⟩ },
  { rintros x ⟨i, hi⟩,
    exact ⟨i, (S i).inv_mem hi⟩ },
  { rintros x y ⟨i, hi⟩ ⟨j, hj⟩,
    obtain ⟨k, hki, hkj⟩ := hS i j,
    exact ⟨k, (S k).mul_mem (hki hi) (hkj hj)⟩ }
end

lemma coe_supr_of_directed {ι} [hι : nonempty ι] {S : ι → subfield K} (hS : directed (≤) S) :
  ((⨆ i, S i : subfield K) : set K) = ⋃ i, ↑(S i) :=
set.ext $ λ x, by simp [mem_supr_of_directed hS]

lemma mem_Sup_of_directed_on {S : set (subfield K)} (Sne : S.nonempty)
  (hS : directed_on (≤) S) {x : K} :
  x ∈ Sup S ↔ ∃ s ∈ S, x ∈ s :=
begin
  haveI : nonempty S := Sne.to_subtype,
  simp only [Sup_eq_supr', mem_supr_of_directed hS.directed_coe, set_coe.exists, subtype.coe_mk]
end

lemma coe_Sup_of_directed_on {S : set (subfield K)} (Sne : S.nonempty) (hS : directed_on (≤) S) :
  (↑(Sup S) : set K) = ⋃ s ∈ S, ↑s :=
set.ext $ λ x, by simp [mem_Sup_of_directed_on Sne hS]

end subfield

namespace ring_hom

variables {s : subfield K}

open subfield

/-- Restrict the codomain of a ring homomorphism to a subfield that includes the range. -/
def cod_restrict_field (f : K →+* L)
  (s : subfield L) (h : ∀ x, f x ∈ s) : K →+* s :=
{ to_fun := λ x, ⟨f x, h x⟩,
  map_add' := λ x y, subtype.eq $ f.map_add x y,
  map_zero' := subtype.eq f.map_zero,
  map_mul' := λ x y, subtype.eq $ f.map_mul x y,
  map_one' := subtype.eq f.map_one }

/-- Restriction of a ring homomorphism to a subfield of the domain. -/
def restrict_field (f : K →+* L) (s : subfield K) : s →+* L := f.comp s.subtype

@[simp] lemma restrict_field_apply (f : K →+* L) (x : s) : f.restrict_field s x = f x := rfl

/-- Restriction of a ring homomorphism to its range interpreted as a subfield. -/
def range_restrict_field (f : K →+* L) : K →+* f.field_range :=
f.srange_restrict

@[simp] lemma coe_range_restrict_field (f : K →+* L) (x : K) :
  (f.range_restrict_field x : L) = f x := rfl

/-- The subfield of elements `x : R` such that `f x = g x`, i.e.,
the equalizer of f and g as a subfield of R -/
def eq_locus_field (f g : K →+* L) : subfield K :=
{ inv_mem' := λ x (hx : f x = g x), show f x⁻¹ = g x⁻¹, by rw [f.map_inv, g.map_inv, hx],
  carrier := {x | f x = g x}, .. (f : K →+* L).eq_locus g }

/-- If two ring homomorphisms are equal on a set, then they are equal on its subfield closure. -/
lemma eq_on_field_closure {f g : K →+* L} {s : set K} (h : set.eq_on f g s) :
  set.eq_on f g (closure s) :=
show closure s ≤ f.eq_locus_field g, from closure_le.2 h

lemma eq_of_eq_on_subfield_top {f g : K →+* L} (h : set.eq_on f g (⊤ : subfield K)) :
  f = g :=
ext $ λ x, h trivial

lemma eq_of_eq_on_of_field_closure_eq_top {s : set K} (hs : closure s = ⊤) {f g : K →+* L}
  (h : s.eq_on f g) : f = g :=
eq_of_eq_on_subfield_top $ hs ▸ eq_on_field_closure h

lemma field_closure_preimage_le (f : K →+* L) (s : set L) :
  closure (f ⁻¹' s) ≤ (closure s).comap f :=
closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx

/-- The image under a ring homomorphism of the subfield generated by a set equals
the subfield generated by the image of the set. -/
lemma map_field_closure (f : K →+* L) (s : set K) :
  (closure s).map f = closure (f '' s) :=
le_antisymm
  (map_le_iff_le_comap.2 $ le_trans (closure_mono $ set.subset_preimage_image _ _)
    (field_closure_preimage_le _ _))
  (closure_le.2 $ set.image_subset _ subset_closure)

end ring_hom

namespace subfield

open ring_hom

/-- The ring homomorphism associated to an inclusion of subfields. -/
def inclusion {S T : subfield K} (h : S ≤ T) : S →+* T :=
S.subtype.cod_restrict_field _ (λ x, h x.2)

@[simp] lemma field_range_subtype (s : subfield K) : s.subtype.field_range = s :=
set_like.ext' $ (coe_srange _).trans subtype.range_coe

end subfield

namespace ring_equiv

variables {s t : subfield K}

/-- Makes the identity isomorphism from a proof two subfields of a multiplicative
    monoid are equal. -/
def subfield_congr (h : s = t) : s ≃+* t :=
{ map_mul' :=  λ _ _, rfl, map_add' := λ _ _, rfl, ..equiv.set_congr $ set_like.ext'_iff.1 h }

end ring_equiv

namespace subfield

variables {s : set K}

lemma closure_preimage_le (f : K →+* L) (s : set L) :
  closure (f ⁻¹' s) ≤ (closure s).comap f :=
closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx

end subfield


/-
Copyright (c) 2022 Jakob von Raumer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob von Raumer, Kevin Klinge

! This file was ported from Lean 3 source module ring_theory.ore_localization.ore_set
! leanprover-community/mathlib commit 422e70f7ce183d2900c586a8cda8381e788a0c62
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Ring.Regular
import Mathlib.GroupTheory.Submonoid.Basic

/-!

# (Right) Ore sets

This defines right Ore sets on arbitrary monoids.

## References

* https://ncatlab.org/nlab/show/Ore+set

-/

namespace OreLocalization

section Monoid

/-- A submonoid `S` of a monoid `R` is (right) Ore if common factors on the left can be turned
into common factors on the right, and if each pair of `r : R` and `s : S` admits an Ore numerator
`v : R` and an Ore denominator `u : S` such that `r * u = s * v`. -/
class OreSet {R : Type _} [Monoid R] (S : Submonoid R) where
  /-- Common factors on the left can be turned into common factors on the right, a weak form of
cancellability. -/
  ore_left_cancel : ∀ (r₁ r₂ : R) (s : S), ↑s * r₁ = s * r₂ → ∃ s' : S, r₁ * s' = r₂ * s'
  /-- The Ore numerator of a fraction. -/
  oreNum : R → S → R
  /-- The Ore denominator of a fraction. -/
  oreDenom : R → S → S
  /-- The Ore condition of a fraction, expressed in terms of `oreNum` and `oreDenom`. -/
  ore_eq : ∀ (r : R) (s : S), r * oreDenom r s = s * oreNum r s
#align ore_localization.ore_set OreLocalization.OreSet

variable {R : Type _} [Monoid R] {S : Submonoid R} [OreSet S]

/-- Common factors on the left can be turned into common factors on the right, a weak form of
cancellability. -/
theorem ore_left_cancel (r₁ r₂ : R) (s : S) (h : ↑s * r₁ = s * r₂) : ∃ s' : S, r₁ * s' = r₂ * s' :=
  OreSet.ore_left_cancel r₁ r₂ s h
#align ore_localization.ore_left_cancel OreLocalization.ore_left_cancel

/-- The Ore numerator of a fraction. -/
def oreNum (r : R) (s : S) : R :=
  OreSet.oreNum r s
#align ore_localization.ore_num OreLocalization.oreNum

/-- The Ore denominator of a fraction. -/
def oreDenom (r : R) (s : S) : S :=
  OreSet.oreDenom r s
#align ore_localization.ore_denom OreLocalization.oreDenom

/-- The Ore condition of a fraction, expressed in terms of `oreNum` and `oreDenom`. -/
theorem ore_eq (r : R) (s : S) : r * oreDenom r s = s * oreNum r s :=
  OreSet.ore_eq r s
#align ore_localization.ore_eq OreLocalization.ore_eq

/-- The Ore condition bundled in a sigma type. This is useful in situations where we want to obtain
both witnesses and the condition for a given fraction. -/
def oreCondition (r : R) (s : S) : Σ'r' : R, Σ's' : S, r * s' = s * r' :=
  ⟨oreNum r s, oreDenom r s, ore_eq r s⟩
#align ore_localization.ore_condition OreLocalization.oreCondition

/-- The trivial submonoid is an Ore set. -/
instance oreSetBot : OreSet (⊥ : Submonoid R)
    where
  ore_left_cancel _ _ s h :=
    ⟨s, by
      rcases s with ⟨s, hs⟩
      rw [Submonoid.mem_bot] at hs
      subst hs
      rw [one_mul, one_mul] at h
      subst h
      rfl⟩
  oreNum r _ := r
  oreDenom _ s := s
  ore_eq _ s := by
    rcases s with ⟨s, hs⟩
    rw [Submonoid.mem_bot] at hs
    simp [hs]
#align ore_localization.ore_set_bot OreLocalization.oreSetBot

/-- Every submonoid of a commutative monoid is an Ore set. -/
instance (priority := 100) oreSetComm {R} [CommMonoid R] (S : Submonoid R) : OreSet S
    where
  ore_left_cancel m n s h := ⟨s, by rw [mul_comm n s, mul_comm m s, h]⟩
  oreNum r _ := r
  oreDenom _ s := s
  ore_eq r s := by rw [mul_comm]
#align ore_localization.ore_set_comm OreLocalization.oreSetComm

end Monoid

/-- Cancellability in monoids with zeros can act as a replacement for the `ore_left_cancel`
condition of an ore set. -/
def oreSetOfCancelMonoidWithZero {R : Type _} [CancelMonoidWithZero R] {S : Submonoid R}
    (oreNum : R → S → R) (oreDenom : R → S → S)
    (ore_eq : ∀ (r : R) (s : S), r * oreDenom r s = s * oreNum r s) : OreSet S :=
  { ore_left_cancel := fun _ _ s h => ⟨s, mul_eq_mul_right_iff.mpr (mul_eq_mul_left_iff.mp h)⟩
    oreNum
    oreDenom
    ore_eq }
#align ore_localization.ore_set_of_cancel_monoid_with_zero OreLocalization.oreSetOfCancelMonoidWithZero

/-- In rings without zero divisors, the first (cancellability) condition is always fulfilled,
it suffices to give a proof for the Ore condition itself. -/
def oreSetOfNoZeroDivisors {R : Type _} [Ring R] [NoZeroDivisors R] {S : Submonoid R}
    (oreNum : R → S → R) (oreDenom : R → S → S)
    (ore_eq : ∀ (r : R) (s : S), r * oreDenom r s = s * oreNum r s) : OreSet S :=
  letI : CancelMonoidWithZero R := NoZeroDivisors.toCancelMonoidWithZero
  oreSetOfCancelMonoidWithZero oreNum oreDenom ore_eq
#align ore_localization.ore_set_of_no_zero_divisors OreLocalization.oreSetOfNoZeroDivisors

end OreLocalization