/-
Copyright (c) 2022 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz, Junyan Xu, Jack McKoen

! This file was ported from Lean 3 source module ring_theory.valuation.valuation_subring
! leanprover-community/mathlib commit 2196ab363eb097c008d4497125e0dde23fb36db2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Valuation.ValuationRing
import Mathbin.RingTheory.Localization.AsSubring
import Mathbin.RingTheory.Subring.Pointwise
import Mathbin.AlgebraicGeometry.PrimeSpectrum.Basic

/-!

# Valuation subrings of a field

## Projects

The order structure on `valuation_subring K`.

-/

open Classical

noncomputable section

variable (K : Type _) [Field K]

/-- A valuation subring of a field `K` is a subring `A` such that for every `x : K`,
either `x ∈ A` or `x⁻¹ ∈ A`. -/
structure ValuationSubring extends Subring K where
  mem_or_inv_mem' : ∀ x : K, x ∈ carrier ∨ x⁻¹ ∈ carrier
#align valuation_subring ValuationSubring

namespace ValuationSubring

variable {K} (A : ValuationSubring K)

instance : SetLike (ValuationSubring K) K
    where
  coe A := A.toSubring
  coe_injective' := by
    rintro ⟨⟨⟩⟩ ⟨⟨⟩⟩ _
    congr

@[simp]
theorem mem_carrier (x : K) : x ∈ A.carrier ↔ x ∈ A :=
  Iff.refl _
#align valuation_subring.mem_carrier ValuationSubring.mem_carrier

@[simp]
theorem mem_toSubring (x : K) : x ∈ A.toSubring ↔ x ∈ A :=
  Iff.refl _
#align valuation_subring.mem_to_subring ValuationSubring.mem_toSubring

@[ext]
theorem ext (A B : ValuationSubring K) (h : ∀ x, x ∈ A ↔ x ∈ B) : A = B :=
  SetLike.ext h
#align valuation_subring.ext ValuationSubring.ext

theorem zero_mem : (0 : K) ∈ A :=
  A.toSubring.zero_mem
#align valuation_subring.zero_mem ValuationSubring.zero_mem

theorem one_mem : (1 : K) ∈ A :=
  A.toSubring.one_mem
#align valuation_subring.one_mem ValuationSubring.one_mem

theorem add_mem (x y : K) : x ∈ A → y ∈ A → x + y ∈ A :=
  A.toSubring.add_mem
#align valuation_subring.add_mem ValuationSubring.add_mem

theorem mul_mem (x y : K) : x ∈ A → y ∈ A → x * y ∈ A :=
  A.toSubring.mul_mem
#align valuation_subring.mul_mem ValuationSubring.mul_mem

theorem neg_mem (x : K) : x ∈ A → -x ∈ A :=
  A.toSubring.neg_mem
#align valuation_subring.neg_mem ValuationSubring.neg_mem

theorem mem_or_inv_mem (x : K) : x ∈ A ∨ x⁻¹ ∈ A :=
  A.mem_or_inv_mem' _
#align valuation_subring.mem_or_inv_mem ValuationSubring.mem_or_inv_mem

instance : SubringClass (ValuationSubring K) K
    where
  zero_mem := zero_mem
  add_mem := add_mem
  one_mem := one_mem
  mul_mem := mul_mem
  neg_mem := neg_mem

theorem toSubring_injective : Function.Injective (toSubring : ValuationSubring K → Subring K) :=
  fun x y h => by
  cases x
  cases y
  congr
#align valuation_subring.to_subring_injective ValuationSubring.toSubring_injective

instance : CommRing A :=
  show CommRing A.toSubring by infer_instance

instance : IsDomain A :=
  show IsDomain A.toSubring by infer_instance

instance : Top (ValuationSubring K) :=
  Top.mk <| { (⊤ : Subring K) with mem_or_inv_mem' := fun x => Or.inl trivial }

theorem mem_top (x : K) : x ∈ (⊤ : ValuationSubring K) :=
  trivial
#align valuation_subring.mem_top ValuationSubring.mem_top

theorem le_top : A ≤ ⊤ := fun a ha => mem_top _
#align valuation_subring.le_top ValuationSubring.le_top

instance : OrderTop (ValuationSubring K) where
  top := ⊤
  le_top := le_top

instance : Inhabited (ValuationSubring K) :=
  ⟨⊤⟩

instance : ValuationRing A
    where cond a b := by
    by_cases (b : K) = 0;
    · use 0
      left
      ext
      simp [h]
    by_cases (a : K) = 0;
    · use 0
      right
      ext
      simp [h]
    cases' A.mem_or_inv_mem (a / b) with hh hh
    · use ⟨a / b, hh⟩
      right
      ext
      field_simp
      ring
    · rw [show (a / b : K)⁻¹ = b / a by field_simp] at hh
      use ⟨b / a, hh⟩
      left
      ext
      field_simp
      ring

instance : Algebra A K :=
  show Algebra A.toSubring K by infer_instance

@[simp]
theorem algebraMap_apply (a : A) : algebraMap A K a = a :=
  rfl
#align valuation_subring.algebra_map_apply ValuationSubring.algebraMap_apply

instance : IsFractionRing A K
    where
  map_units := fun ⟨y, hy⟩ =>
    (Units.mk0 (y : K) fun c => nonZeroDivisors.ne_zero hy <| Subtype.ext c).IsUnit
  surj z := by
    by_cases z = 0;
    · use (0, 1)
      simp [h]
    cases' A.mem_or_inv_mem z with hh hh
    · use (⟨z, hh⟩, 1)
      simp
    · refine' ⟨⟨1, ⟨⟨_, hh⟩, _⟩⟩, mul_inv_cancel h⟩
      exact mem_nonZeroDivisors_iff_ne_zero.2 fun c => h (inv_eq_zero.mp (congr_arg coe c))
  eq_iff_exists a b :=
    ⟨fun h =>
      ⟨1, by
        ext
        simpa using h⟩,
      fun ⟨c, h⟩ =>
      congr_arg coe ((mul_eq_mul_left_iff.1 h).resolve_right (nonZeroDivisors.ne_zero c.2))⟩

/-- The value group of the valuation associated to `A`. Note: it is actually a group with zero. -/
def ValueGroup :=
  ValuationRing.ValueGroup A K deriving LinearOrderedCommGroupWithZero
#align valuation_subring.value_group ValuationSubring.ValueGroup

/-- Any valuation subring of `K` induces a natural valuation on `K`. -/
def valuation : Valuation K A.ValueGroup :=
  ValuationRing.valuation A K
#align valuation_subring.valuation ValuationSubring.valuation

instance inhabitedValueGroup : Inhabited A.ValueGroup :=
  ⟨A.Valuation 0⟩
#align valuation_subring.inhabited_value_group ValuationSubring.inhabitedValueGroup

theorem valuation_le_one (a : A) : A.Valuation a ≤ 1 :=
  (ValuationRing.mem_integer_iff A K _).2 ⟨a, rfl⟩
#align valuation_subring.valuation_le_one ValuationSubring.valuation_le_one

theorem mem_of_valuation_le_one (x : K) (h : A.Valuation x ≤ 1) : x ∈ A :=
  let ⟨a, ha⟩ := (ValuationRing.mem_integer_iff A K x).1 h
  ha ▸ a.2
#align valuation_subring.mem_of_valuation_le_one ValuationSubring.mem_of_valuation_le_one

theorem valuation_le_one_iff (x : K) : A.Valuation x ≤ 1 ↔ x ∈ A :=
  ⟨mem_of_valuation_le_one _ _, fun ha => A.valuation_le_one ⟨x, ha⟩⟩
#align valuation_subring.valuation_le_one_iff ValuationSubring.valuation_le_one_iff

theorem valuation_eq_iff (x y : K) : A.Valuation x = A.Valuation y ↔ ∃ a : Aˣ, (a : K) * y = x :=
  Quotient.eq''
#align valuation_subring.valuation_eq_iff ValuationSubring.valuation_eq_iff

theorem valuation_le_iff (x y : K) : A.Valuation x ≤ A.Valuation y ↔ ∃ a : A, (a : K) * y = x :=
  Iff.rfl
#align valuation_subring.valuation_le_iff ValuationSubring.valuation_le_iff

theorem valuation_surjective : Function.Surjective A.Valuation :=
  surjective_quot_mk _
#align valuation_subring.valuation_surjective ValuationSubring.valuation_surjective

theorem valuation_unit (a : Aˣ) : A.Valuation a = 1 :=
  by
  rw [← A.valuation.map_one, valuation_eq_iff]
  use a
  simp
#align valuation_subring.valuation_unit ValuationSubring.valuation_unit

theorem valuation_eq_one_iff (a : A) : IsUnit a ↔ A.Valuation a = 1 :=
  ⟨fun h => A.valuation_unit h.Unit, fun h =>
    by
    have ha : (a : K) ≠ 0 := by
      intro c
      rw [c, A.valuation.map_zero] at h
      exact zero_ne_one h
    have ha' : (a : K)⁻¹ ∈ A := by rw [← valuation_le_one_iff, map_inv₀, h, inv_one]
    apply isUnit_of_mul_eq_one a ⟨a⁻¹, ha'⟩
    ext
    field_simp⟩
#align valuation_subring.valuation_eq_one_iff ValuationSubring.valuation_eq_one_iff

theorem valuation_lt_one_or_eq_one (a : A) : A.Valuation a < 1 ∨ A.Valuation a = 1 :=
  lt_or_eq_of_le (A.valuation_le_one a)
#align valuation_subring.valuation_lt_one_or_eq_one ValuationSubring.valuation_lt_one_or_eq_one

theorem valuation_lt_one_iff (a : A) : a ∈ LocalRing.maximalIdeal A ↔ A.Valuation a < 1 :=
  by
  rw [LocalRing.mem_maximalIdeal]
  dsimp [nonunits]; rw [valuation_eq_one_iff]
  exact (A.valuation_le_one a).lt_iff_ne.symm
#align valuation_subring.valuation_lt_one_iff ValuationSubring.valuation_lt_one_iff

/-- A subring `R` of `K` such that for all `x : K` either `x ∈ R` or `x⁻¹ ∈ R` is
  a valuation subring of `K`. -/
def ofSubring (R : Subring K) (hR : ∀ x : K, x ∈ R ∨ x⁻¹ ∈ R) : ValuationSubring K :=
  { R with mem_or_inv_mem' := hR }
#align valuation_subring.of_subring ValuationSubring.ofSubring

@[simp]
theorem mem_ofSubring (R : Subring K) (hR : ∀ x : K, x ∈ R ∨ x⁻¹ ∈ R) (x : K) :
    x ∈ ofSubring R hR ↔ x ∈ R :=
  Iff.refl _
#align valuation_subring.mem_of_subring ValuationSubring.mem_ofSubring

/-- An overring of a valuation ring is a valuation ring. -/
def ofLe (R : ValuationSubring K) (S : Subring K) (h : R.toSubring ≤ S) : ValuationSubring K :=
  { S with mem_or_inv_mem' := fun x => (R.mem_or_inv_mem x).imp (@h x) (@h _) }
#align valuation_subring.of_le ValuationSubring.ofLe

section Order

instance : SemilatticeSup (ValuationSubring K) :=
  {
    (inferInstance :
      PartialOrder
        (ValuationSubring
          K)) with
    sup := fun R S => ofLe R (R.toSubring ⊔ S.toSubring) <| le_sup_left
    le_sup_left := fun R S x hx => (le_sup_left : R.toSubring ≤ R.toSubring ⊔ S.toSubring) hx
    le_sup_right := fun R S x hx => (le_sup_right : S.toSubring ≤ R.toSubring ⊔ S.toSubring) hx
    sup_le := fun R S T hR hT x hx => (sup_le hR hT : R.toSubring ⊔ S.toSubring ≤ T.toSubring) hx }

/-- The ring homomorphism induced by the partial order. -/
def inclusion (R S : ValuationSubring K) (h : R ≤ S) : R →+* S :=
  Subring.inclusion h
#align valuation_subring.inclusion ValuationSubring.inclusion

/-- The canonical ring homomorphism from a valuation ring to its field of fractions. -/
def subtype (R : ValuationSubring K) : R →+* K :=
  Subring.subtype R.toSubring
#align valuation_subring.subtype ValuationSubring.subtype

/-- The canonical map on value groups induced by a coarsening of valuation rings. -/
def mapOfLe (R S : ValuationSubring K) (h : R ≤ S) : R.ValueGroup →*₀ S.ValueGroup
    where
  toFun := Quotient.map' id fun x y ⟨u, hu⟩ => ⟨Units.map (R.inclusion S h).toMonoidHom u, hu⟩
  map_zero' := rfl
  map_one' := rfl
  map_mul' := by
    rintro ⟨⟩ ⟨⟩
    rfl
#align valuation_subring.map_of_le ValuationSubring.mapOfLe

@[mono]
theorem monotone_mapOfLe (R S : ValuationSubring K) (h : R ≤ S) : Monotone (R.mapOfLe S h) :=
  by
  rintro ⟨⟩ ⟨⟩ ⟨a, ha⟩
  exact ⟨R.inclusion S h a, ha⟩
#align valuation_subring.monotone_map_of_le ValuationSubring.monotone_mapOfLe

@[simp]
theorem mapOfLe_comp_valuation (R S : ValuationSubring K) (h : R ≤ S) :
    R.mapOfLe S h ∘ R.Valuation = S.Valuation :=
  by
  ext
  rfl
#align valuation_subring.map_of_le_comp_valuation ValuationSubring.mapOfLe_comp_valuation

@[simp]
theorem mapOfLe_valuation_apply (R S : ValuationSubring K) (h : R ≤ S) (x : K) :
    R.mapOfLe S h (R.Valuation x) = S.Valuation x :=
  rfl
#align valuation_subring.map_of_le_valuation_apply ValuationSubring.mapOfLe_valuation_apply

/-- The ideal corresponding to a coarsening of a valuation ring. -/
def idealOfLe (R S : ValuationSubring K) (h : R ≤ S) : Ideal R :=
  (LocalRing.maximalIdeal S).comap (R.inclusion S h)
#align valuation_subring.ideal_of_le ValuationSubring.idealOfLe

instance prime_idealOfLe (R S : ValuationSubring K) (h : R ≤ S) : (idealOfLe R S h).IsPrime :=
  (LocalRing.maximalIdeal S).comap_isPrime _
#align valuation_subring.prime_ideal_of_le ValuationSubring.prime_idealOfLe

/-- The coarsening of a valuation ring associated to a prime ideal. -/
def ofPrime (A : ValuationSubring K) (P : Ideal A) [P.IsPrime] : ValuationSubring K :=
  ofLe A (Localization.subalgebra.ofField K _ P.primeCompl_le_nonZeroDivisors).toSubring fun a ha =>
    Subalgebra.algebraMap_mem _ (⟨a, ha⟩ : A)
#align valuation_subring.of_prime ValuationSubring.ofPrime

instance ofPrimeAlgebra (A : ValuationSubring K) (P : Ideal A) [P.IsPrime] :
    Algebra A (A.of_prime P) :=
  Subalgebra.algebra _
#align valuation_subring.of_prime_algebra ValuationSubring.ofPrimeAlgebra

instance ofPrime_scalar_tower (A : ValuationSubring K) (P : Ideal A) [P.IsPrime] :
    IsScalarTower A (A.of_prime P) K :=
  IsScalarTower.subalgebra' A K K _
#align valuation_subring.of_prime_scalar_tower ValuationSubring.ofPrime_scalar_tower

instance ofPrime_localization (A : ValuationSubring K) (P : Ideal A) [P.IsPrime] :
    IsLocalization.AtPrime (A.of_prime P) P := by
  apply
    Localization.subalgebra.isLocalization_ofField K P.prime_compl
      P.prime_compl_le_non_zero_divisors
#align valuation_subring.of_prime_localization ValuationSubring.ofPrime_localization

theorem le_ofPrime (A : ValuationSubring K) (P : Ideal A) [P.IsPrime] : A ≤ ofPrime A P :=
  fun a ha => Subalgebra.algebraMap_mem _ (⟨a, ha⟩ : A)
#align valuation_subring.le_of_prime ValuationSubring.le_ofPrime

theorem ofPrime_valuation_eq_one_iff_mem_primeCompl (A : ValuationSubring K) (P : Ideal A)
    [P.IsPrime] (x : A) : (ofPrime A P).Valuation x = 1 ↔ x ∈ P.primeCompl := by
  rw [← IsLocalization.AtPrime.isUnit_to_map_iff (A.of_prime P) P x, valuation_eq_one_iff]; rfl
#align valuation_subring.of_prime_valuation_eq_one_iff_mem_prime_compl ValuationSubring.ofPrime_valuation_eq_one_iff_mem_primeCompl

@[simp]
theorem idealOfLe_ofPrime (A : ValuationSubring K) (P : Ideal A) [P.IsPrime] :
    idealOfLe A (ofPrime A P) (le_ofPrime A P) = P :=
  by
  ext
  apply IsLocalization.AtPrime.to_map_mem_maximal_iff
#align valuation_subring.ideal_of_le_of_prime ValuationSubring.idealOfLe_ofPrime

@[simp]
theorem ofPrime_idealOfLe (R S : ValuationSubring K) (h : R ≤ S) :
    ofPrime R (idealOfLe R S h) = S := by
  ext x; constructor
  · rintro ⟨a, r, hr, rfl⟩
    apply mul_mem
    · exact h a.2
    · rw [← valuation_le_one_iff, map_inv₀, ← inv_one, inv_le_inv₀]
      · exact not_lt.1 ((not_iff_not.2 <| valuation_lt_one_iff S _).1 hr)
      · intro hh
        erw [Valuation.zero_iff, Subring.coe_eq_zero_iff] at hh
        apply hr
        rw [hh]
        apply Ideal.zero_mem (R.ideal_of_le S h)
      · exact one_ne_zero
  · intro hx
    by_cases hr : x ∈ R
    · exact R.le_of_prime _ hr
    have : x ≠ 0 := fun h =>
      hr
        (by
          rw [h]
          exact R.zero_mem)
    replace hr := (R.mem_or_inv_mem x).resolve_left hr
    · use 1, x⁻¹, hr
      constructor
      · change (⟨x⁻¹, h hr⟩ : S) ∉ nonunits S
        erw [mem_nonunits_iff, Classical.not_not]
        apply isUnit_of_mul_eq_one _ (⟨x, hx⟩ : S)
        ext
        field_simp
      · field_simp
#align valuation_subring.of_prime_ideal_of_le ValuationSubring.ofPrime_idealOfLe

theorem ofPrime_le_of_le (P Q : Ideal A) [P.IsPrime] [Q.IsPrime] (h : P ≤ Q) :
    ofPrime A Q ≤ ofPrime A P := fun x ⟨a, s, hs, he⟩ => ⟨a, s, fun c => hs (h c), he⟩
#align valuation_subring.of_prime_le_of_le ValuationSubring.ofPrime_le_of_le

theorem idealOfLe_le_of_le (R S : ValuationSubring K) (hR : A ≤ R) (hS : A ≤ S) (h : R ≤ S) :
    idealOfLe A S hS ≤ idealOfLe A R hR := fun x hx =>
  (valuation_lt_one_iff R _).2
    (by
      by_contra c; push_neg  at c; replace c := monotone_map_of_le R S h c
      rw [(map_of_le _ _ _).map_one, map_of_le_valuation_apply] at c
      apply not_le_of_lt ((valuation_lt_one_iff S _).1 hx) c)
#align valuation_subring.ideal_of_le_le_of_le ValuationSubring.idealOfLe_le_of_le

/-- The equivalence between coarsenings of a valuation ring and its prime ideals.-/
@[simps]
def primeSpectrumEquiv : PrimeSpectrum A ≃ { S | A ≤ S }
    where
  toFun P := ⟨ofPrime A P.asIdeal, le_ofPrime _ _⟩
  invFun S := ⟨idealOfLe _ S S.2, inferInstance⟩
  left_inv P := by
    ext1
    simp
  right_inv S := by
    ext1
    simp
#align valuation_subring.prime_spectrum_equiv ValuationSubring.primeSpectrumEquiv

/-- An ordered variant of `prime_spectrum_equiv`. -/
@[simps]
def primeSpectrumOrderEquiv : (PrimeSpectrum A)ᵒᵈ ≃o { S | A ≤ S } :=
  { primeSpectrumEquiv A with
    map_rel_iff' := fun P Q =>
      ⟨fun h => by
        have := ideal_of_le_le_of_le A _ _ _ _ h
        iterate 2 erw [ideal_of_le_of_prime] at this
        exact this, fun h => by
        apply of_prime_le_of_le
        exact h⟩ }
#align valuation_subring.prime_spectrum_order_equiv ValuationSubring.primeSpectrumOrderEquiv

instance linearOrderOverring : LinearOrder { S | A ≤ S } :=
  {
    (inferInstance :
      PartialOrder
        _) with
    le_total :=
      let i : IsTotal (PrimeSpectrum A) (· ≤ ·) := ⟨fun ⟨x, _⟩ ⟨y, _⟩ => LE.le.isTotal.Total x y⟩
      (prime_spectrum_order_equiv A).symm.toRelEmbedding.IsTotal.Total
    decidableLe := inferInstance }
#align valuation_subring.linear_order_overring ValuationSubring.linearOrderOverring

end Order

end ValuationSubring

namespace Valuation

variable {K} {Γ Γ₁ Γ₂ : Type _} [LinearOrderedCommGroupWithZero Γ]
  [LinearOrderedCommGroupWithZero Γ₁] [LinearOrderedCommGroupWithZero Γ₂] (v : Valuation K Γ)
  (v₁ : Valuation K Γ₁) (v₂ : Valuation K Γ₂)

/-- The valuation subring associated to a valuation. -/
def valuationSubring : ValuationSubring K :=
  { v.integer with
    mem_or_inv_mem' := by
      intro x
      cases le_or_lt (v x) 1
      · left
        exact h
      · right
        change v x⁻¹ ≤ 1
        rw [map_inv₀ v, ← inv_one, inv_le_inv₀]
        · exact le_of_lt h
        · intro c
          simpa [c] using h
        · exact one_ne_zero }
#align valuation.valuation_subring Valuation.valuationSubring

@[simp]
theorem mem_valuationSubring_iff (x : K) : x ∈ v.ValuationSubring ↔ v x ≤ 1 :=
  Iff.refl _
#align valuation.mem_valuation_subring_iff Valuation.mem_valuationSubring_iff

theorem isEquiv_iff_valuationSubring : v₁.IsEquiv v₂ ↔ v₁.ValuationSubring = v₂.ValuationSubring :=
  by
  constructor
  · intro h
    ext x
    specialize h x 1
    simpa using h
  · intro h
    apply is_equiv_of_val_le_one
    intro x
    have : x ∈ v₁.valuation_subring ↔ x ∈ v₂.valuation_subring := by rw [h]
    simpa using this
#align valuation.is_equiv_iff_valuation_subring Valuation.isEquiv_iff_valuationSubring

theorem isEquiv_valuation_valuationSubring : v.IsEquiv v.ValuationSubring.Valuation :=
  by
  rw [is_equiv_iff_val_le_one]
  intro x
  rw [ValuationSubring.valuation_le_one_iff]
  rfl
#align valuation.is_equiv_valuation_valuation_subring Valuation.isEquiv_valuation_valuationSubring

end Valuation

namespace ValuationSubring

variable {K} (A : ValuationSubring K)

@[simp]
theorem valuationSubring_valuation : A.Valuation.ValuationSubring = A :=
  by
  ext
  rw [← A.valuation_le_one_iff]
  rfl
#align valuation_subring.valuation_subring_valuation ValuationSubring.valuationSubring_valuation

section UnitGroup

/-- The unit group of a valuation subring, as a subgroup of `Kˣ`. -/
def unitGroup : Subgroup Kˣ :=
  (A.Valuation.toMonoidWithZeroHom.toMonoidHom.comp (Units.coeHom K)).ker
#align valuation_subring.unit_group ValuationSubring.unitGroup

@[simp]
theorem mem_unitGroup_iff (x : Kˣ) : x ∈ A.unitGroup ↔ A.Valuation x = 1 :=
  Iff.rfl
#align valuation_subring.mem_unit_group_iff ValuationSubring.mem_unitGroup_iff

/-- For a valuation subring `A`, `A.unit_group` agrees with the units of `A`. -/
def unitGroupMulEquiv : A.unitGroup ≃* Aˣ
    where
  toFun x :=
    { val := ⟨x, mem_of_valuation_le_one A _ x.Prop.le⟩
      inv := ⟨↑x⁻¹, mem_of_valuation_le_one _ _ x⁻¹.Prop.le⟩
      val_inv := Subtype.ext (Units.mul_inv x)
      inv_val := Subtype.ext (Units.inv_mul x) }
  invFun x := ⟨Units.map A.Subtype.toMonoidHom x, A.valuation_unit x⟩
  left_inv a := by
    ext
    rfl
  right_inv a := by
    ext
    rfl
  map_mul' a b := by
    ext
    rfl
#align valuation_subring.unit_group_mul_equiv ValuationSubring.unitGroupMulEquiv

@[simp]
theorem coe_unitGroupMulEquiv_apply (a : A.unitGroup) : (A.unitGroupMulEquiv a : K) = a :=
  rfl
#align valuation_subring.coe_unit_group_mul_equiv_apply ValuationSubring.coe_unitGroupMulEquiv_apply

@[simp]
theorem coe_unitGroupMulEquiv_symm_apply (a : Aˣ) : (A.unitGroupMulEquiv.symm a : K) = a :=
  rfl
#align valuation_subring.coe_unit_group_mul_equiv_symm_apply ValuationSubring.coe_unitGroupMulEquiv_symm_apply

theorem unitGroup_le_unitGroup {A B : ValuationSubring K} : A.unitGroup ≤ B.unitGroup ↔ A ≤ B :=
  by
  constructor
  · intro h x hx
    rw [← A.valuation_le_one_iff x, le_iff_lt_or_eq] at hx
    by_cases h_1 : x = 0
    · simp only [h_1, zero_mem]
    by_cases h_2 : 1 + x = 0
    · simp only [← add_eq_zero_iff_neg_eq.1 h_2, neg_mem _ _ (one_mem _)]
    cases hx
    · have := h (show Units.mk0 _ h_2 ∈ A.unit_group from A.valuation.map_one_add_of_lt hx)
      simpa using
        B.add_mem _ _ (show 1 + x ∈ B from SetLike.coe_mem (B.unit_group_mul_equiv ⟨_, this⟩ : B))
          (B.neg_mem _ B.one_mem)
    · have := h (show Units.mk0 x h_1 ∈ A.unit_group from hx)
      refine' SetLike.coe_mem (B.unit_group_mul_equiv ⟨_, this⟩ : B)
  · rintro h x (hx : A.valuation x = 1)
    apply_fun A.map_of_le B h  at hx
    simpa using hx
#align valuation_subring.unit_group_le_unit_group ValuationSubring.unitGroup_le_unitGroup

theorem unitGroup_injective : Function.Injective (unitGroup : ValuationSubring K → Subgroup _) :=
  fun A B h => by simpa only [le_antisymm_iff, unit_group_le_unit_group] using h
#align valuation_subring.unit_group_injective ValuationSubring.unitGroup_injective

theorem eq_iff_unitGroup {A B : ValuationSubring K} : A = B ↔ A.unitGroup = B.unitGroup :=
  unitGroup_injective.eq_iff.symm
#align valuation_subring.eq_iff_unit_group ValuationSubring.eq_iff_unitGroup

/-- The map on valuation subrings to their unit groups is an order embedding. -/
def unitGroupOrderEmbedding : ValuationSubring K ↪o Subgroup Kˣ
    where
  toFun A := A.unitGroup
  inj' := unitGroup_injective
  map_rel_iff' A B := unitGroup_le_unitGroup
#align valuation_subring.unit_group_order_embedding ValuationSubring.unitGroupOrderEmbedding

theorem unitGroup_strictMono : StrictMono (unitGroup : ValuationSubring K → Subgroup _) :=
  unitGroupOrderEmbedding.StrictMono
#align valuation_subring.unit_group_strict_mono ValuationSubring.unitGroup_strictMono

end UnitGroup

section nonunits

/-- The nonunits of a valuation subring of `K`, as a subsemigroup of `K`-/
def nonunits : Subsemigroup K
    where
  carrier := { x | A.Valuation x < 1 }
  mul_mem' a b ha hb := (mul_lt_mul₀ ha hb).trans_eq <| mul_one _
#align valuation_subring.nonunits ValuationSubring.nonunits

theorem mem_nonunits_iff {x : K} : x ∈ A.nonunits ↔ A.Valuation x < 1 :=
  Iff.rfl
#align valuation_subring.mem_nonunits_iff ValuationSubring.mem_nonunits_iff

theorem nonunits_le_nonunits {A B : ValuationSubring K} : B.nonunits ≤ A.nonunits ↔ A ≤ B :=
  by
  constructor
  · intro h x hx
    by_cases h_1 : x = 0
    · simp only [h_1, zero_mem]
    rw [← valuation_le_one_iff, ← not_lt, Valuation.one_lt_val_iff _ h_1] at hx⊢
    by_contra h_2
    exact hx (h h_2)
  · intro h x hx
    by_contra h_1
    exact not_lt.2 (monotone_map_of_le _ _ h (not_lt.1 h_1)) hx
#align valuation_subring.nonunits_le_nonunits ValuationSubring.nonunits_le_nonunits

theorem nonunits_injective : Function.Injective (nonunits : ValuationSubring K → Subsemigroup _) :=
  fun A B h => by simpa only [le_antisymm_iff, nonunits_le_nonunits] using h.symm
#align valuation_subring.nonunits_injective ValuationSubring.nonunits_injective

theorem nonunits_inj {A B : ValuationSubring K} : A.nonunits = B.nonunits ↔ A = B :=
  nonunits_injective.eq_iff
#align valuation_subring.nonunits_inj ValuationSubring.nonunits_inj

/-- The map on valuation subrings to their nonunits is a dual order embedding. -/
def nonunitsOrderEmbedding : ValuationSubring K ↪o (Subsemigroup K)ᵒᵈ
    where
  toFun A := A.nonunits
  inj' := nonunits_injective
  map_rel_iff' A B := nonunits_le_nonunits
#align valuation_subring.nonunits_order_embedding ValuationSubring.nonunitsOrderEmbedding

variable {A}

/-- The elements of `A.nonunits` are those of the maximal ideal of `A` after coercion to `K`.

See also `mem_nonunits_iff_exists_mem_maximal_ideal`, which gets rid of the coercion to `K`,
at the expense of a more complicated right hand side.
 -/
theorem coe_mem_nonunits_iff {a : A} : (a : K) ∈ A.nonunits ↔ a ∈ LocalRing.maximalIdeal A :=
  (valuation_lt_one_iff _ _).symm
#align valuation_subring.coe_mem_nonunits_iff ValuationSubring.coe_mem_nonunits_iff

theorem nonunits_le : A.nonunits ≤ A.toSubring.toSubmonoid.toSubsemigroup := fun a ha =>
  (A.valuation_le_one_iff _).mp (A.mem_nonunits_iff.mp ha).le
#align valuation_subring.nonunits_le ValuationSubring.nonunits_le

theorem nonunits_subset : (A.nonunits : Set K) ⊆ A :=
  nonunits_le
#align valuation_subring.nonunits_subset ValuationSubring.nonunits_subset

/-- The elements of `A.nonunits` are those of the maximal ideal of `A`.

See also `coe_mem_nonunits_iff`, which has a simpler right hand side but requires the element
to be in `A` already.
 -/
theorem mem_nonunits_iff_exists_mem_maximalIdeal {a : K} :
    a ∈ A.nonunits ↔ ∃ ha, (⟨a, ha⟩ : A) ∈ LocalRing.maximalIdeal A :=
  ⟨fun h => ⟨nonunits_subset h, coe_mem_nonunits_iff.mp h⟩, fun ⟨ha, h⟩ =>
    coe_mem_nonunits_iff.mpr h⟩
#align valuation_subring.mem_nonunits_iff_exists_mem_maximal_ideal ValuationSubring.mem_nonunits_iff_exists_mem_maximalIdeal

/-- `A.nonunits` agrees with the maximal ideal of `A`, after taking its image in `K`. -/
theorem image_maximalIdeal : (coe : A → K) '' LocalRing.maximalIdeal A = A.nonunits :=
  by
  ext a
  simp only [Set.mem_image, SetLike.mem_coe, mem_nonunits_iff_exists_mem_maximal_ideal]
  erw [Subtype.exists]
  simp_rw [Subtype.coe_mk, exists_and_right, exists_eq_right]
#align valuation_subring.image_maximal_ideal ValuationSubring.image_maximalIdeal

end nonunits

section PrincipalUnitGroup

/-- The principal unit group of a valuation subring, as a subgroup of `Kˣ`. -/
def principalUnitGroup : Subgroup Kˣ
    where
  carrier := { x | A.Valuation (x - 1) < 1 }
  mul_mem' := by
    intro a b ha hb
    refine' lt_of_le_of_lt _ (max_lt hb ha)
    rw [← one_mul (A.valuation (b - 1)), ← A.valuation.map_one_add_of_lt ha, add_sub_cancel'_right,
      ← Valuation.map_mul, mul_sub_one, ← sub_add_sub_cancel]
    exact A.valuation.map_add _ _
  one_mem' := by simp
  inv_mem' := by
    dsimp
    intro a ha
    conv =>
      lhs
      rw [← mul_one (A.valuation _), ← A.valuation.map_one_add_of_lt ha]
    rwa [add_sub_cancel'_right, ← Valuation.map_mul, sub_mul, Units.inv_mul, ← neg_sub, one_mul,
      Valuation.map_neg]
#align valuation_subring.principal_unit_group ValuationSubring.principalUnitGroup

theorem principal_units_le_units : A.principalUnitGroup ≤ A.unitGroup := fun a h => by
  simpa only [add_sub_cancel'_right] using A.valuation.map_one_add_of_lt h
#align valuation_subring.principal_units_le_units ValuationSubring.principal_units_le_units

theorem mem_principalUnitGroup_iff (x : Kˣ) :
    x ∈ A.principalUnitGroup ↔ A.Valuation ((x : K) - 1) < 1 :=
  Iff.rfl
#align valuation_subring.mem_principal_unit_group_iff ValuationSubring.mem_principalUnitGroup_iff

theorem principalUnitGroup_le_principalUnitGroup {A B : ValuationSubring K} :
    B.principalUnitGroup ≤ A.principalUnitGroup ↔ A ≤ B :=
  by
  constructor
  · intro h x hx
    by_cases h_1 : x = 0
    · simp only [h_1, zero_mem]
    by_cases h_2 : x⁻¹ + 1 = 0
    · rw [add_eq_zero_iff_eq_neg, inv_eq_iff_eq_inv, inv_neg, inv_one] at h_2
      simpa only [h_2] using B.neg_mem _ B.one_mem
    · rw [← valuation_le_one_iff, ← not_lt, Valuation.one_lt_val_iff _ h_1, ← add_sub_cancel x⁻¹, ←
        Units.val_mk0 h_2, ← mem_principal_unit_group_iff] at hx⊢
      simpa only [hx] using @h (Units.mk0 (x⁻¹ + 1) h_2)
  · intro h x hx
    by_contra h_1
    exact not_lt.2 (monotone_map_of_le _ _ h (not_lt.1 h_1)) hx
#align valuation_subring.principal_unit_group_le_principal_unit_group ValuationSubring.principalUnitGroup_le_principalUnitGroup

theorem principalUnitGroup_injective :
    Function.Injective (principalUnitGroup : ValuationSubring K → Subgroup _) := fun A B h => by
  simpa [le_antisymm_iff, principal_unit_group_le_principal_unit_group] using h.symm
#align valuation_subring.principal_unit_group_injective ValuationSubring.principalUnitGroup_injective

theorem eq_iff_principalUnitGroup {A B : ValuationSubring K} :
    A = B ↔ A.principalUnitGroup = B.principalUnitGroup :=
  principalUnitGroup_injective.eq_iff.symm
#align valuation_subring.eq_iff_principal_unit_group ValuationSubring.eq_iff_principalUnitGroup

/-- The map on valuation subrings to their principal unit groups is an order embedding. -/
def principalUnitGroupOrderEmbedding : ValuationSubring K ↪o (Subgroup Kˣ)ᵒᵈ
    where
  toFun A := A.principalUnitGroup
  inj' := principalUnitGroup_injective
  map_rel_iff' A B := principalUnitGroup_le_principalUnitGroup
#align valuation_subring.principal_unit_group_order_embedding ValuationSubring.principalUnitGroupOrderEmbedding

theorem coe_mem_principalUnitGroup_iff {x : A.unitGroup} :
    (x : Kˣ) ∈ A.principalUnitGroup ↔
      A.unitGroupMulEquiv x ∈ (Units.map (LocalRing.residue A).toMonoidHom).ker :=
  by
  rw [MonoidHom.mem_ker, Units.ext_iff]
  let π := Ideal.Quotient.mk (LocalRing.maximalIdeal A); convert_to _ ↔ π _ = 1
  rw [← π.map_one, ← sub_eq_zero, ← π.map_sub, Ideal.Quotient.eq_zero_iff_mem, valuation_lt_one_iff]
  simpa
#align valuation_subring.coe_mem_principal_unit_group_iff ValuationSubring.coe_mem_principalUnitGroup_iff

/-- The principal unit group agrees with the kernel of the canonical map from
the units of `A` to the units of the residue field of `A`. -/
def principalUnitGroupEquiv :
    A.principalUnitGroup ≃* (Units.map (LocalRing.residue A).toMonoidHom).ker
    where
  toFun x :=
    ⟨A.unitGroupMulEquiv ⟨_, A.principal_units_le_units x.2⟩,
      A.coe_mem_principalUnitGroup_iff.1 x.2⟩
  invFun x :=
    ⟨A.unitGroupMulEquiv.symm x,
      by
      rw [A.coe_mem_principal_unit_group_iff]
      simpa using SetLike.coe_mem x⟩
  left_inv x := by simp
  right_inv x := by simp
  map_mul' x y := by rfl
#align valuation_subring.principal_unit_group_equiv ValuationSubring.principalUnitGroupEquiv

@[simp]
theorem principalUnitGroupEquiv_apply (a : A.principalUnitGroup) :
    (principalUnitGroupEquiv A a : K) = a :=
  rfl
#align valuation_subring.principal_unit_group_equiv_apply ValuationSubring.principalUnitGroupEquiv_apply

@[simp]
theorem principalUnitGroup_symm_apply (a : (Units.map (LocalRing.residue A).toMonoidHom).ker) :
    (A.principalUnitGroupEquiv.symm a : K) = a :=
  rfl
#align valuation_subring.principal_unit_group_symm_apply ValuationSubring.principalUnitGroup_symm_apply

/-- The canonical map from the unit group of `A` to the units of the residue field of `A`. -/
def unitGroupToResidueFieldUnits : A.unitGroup →* (LocalRing.ResidueField A)ˣ :=
  MonoidHom.comp (Units.map <| (Ideal.Quotient.mk _).toMonoidHom) A.unitGroupMulEquiv.toMonoidHom
#align valuation_subring.unit_group_to_residue_field_units ValuationSubring.unitGroupToResidueFieldUnits

@[simp]
theorem coe_unitGroupToResidueFieldUnits_apply (x : A.unitGroup) :
    (A.unitGroupToResidueFieldUnits x : LocalRing.ResidueField A) =
      Ideal.Quotient.mk _ (A.unitGroupMulEquiv x : A) :=
  rfl
#align valuation_subring.coe_unit_group_to_residue_field_units_apply ValuationSubring.coe_unitGroupToResidueFieldUnits_apply

theorem ker_unitGroupToResidueFieldUnits :
    A.unitGroupToResidueFieldUnits.ker = A.principalUnitGroup.comap A.unitGroup.Subtype :=
  by
  ext
  simpa only [Subgroup.mem_comap, Subgroup.coeSubtype, coe_mem_principal_unit_group_iff]
#align valuation_subring.ker_unit_group_to_residue_field_units ValuationSubring.ker_unitGroupToResidueFieldUnits

theorem surjective_unitGroupToResidueFieldUnits :
    Function.Surjective A.unitGroupToResidueFieldUnits :=
  (LocalRing.surjective_units_map_of_local_ringHom _ Ideal.Quotient.mk_surjective
        LocalRing.isLocalRingHom_residue).comp
    (MulEquiv.surjective _)
#align valuation_subring.surjective_unit_group_to_residue_field_units ValuationSubring.surjective_unitGroupToResidueFieldUnits

/-- The quotient of the unit group of `A` by the principal unit group of `A` agrees with
the units of the residue field of `A`. -/
def unitsModPrincipalUnitsEquivResidueFieldUnits :
    A.unitGroup ⧸ A.principalUnitGroup.comap A.unitGroup.Subtype ≃* (LocalRing.ResidueField A)ˣ :=
  (QuotientGroup.quotientMulEquivOfEq A.ker_unitGroupToResidueFieldUnits.symm).trans
    (QuotientGroup.quotientKerEquivOfSurjective _ A.surjective_unitGroupToResidueFieldUnits)
#align valuation_subring.units_mod_principal_units_equiv_residue_field_units ValuationSubring.unitsModPrincipalUnitsEquivResidueFieldUnits

@[simp]
theorem unitsModPrincipalUnitsEquivResidueFieldUnits_comp_quotient_group_mk :
    A.unitsModPrincipalUnitsEquivResidueFieldUnits.toMonoidHom.comp (QuotientGroup.mk' _) =
      A.unitGroupToResidueFieldUnits :=
  rfl
#align valuation_subring.units_mod_principal_units_equiv_residue_field_units_comp_quotient_group_mk ValuationSubring.unitsModPrincipalUnitsEquivResidueFieldUnits_comp_quotient_group_mk

@[simp]
theorem unitsModPrincipalUnitsEquivResidueFieldUnits_comp_quotient_group_mk_apply
    (x : A.unitGroup) :
    A.unitsModPrincipalUnitsEquivResidueFieldUnits.toMonoidHom (QuotientGroup.mk x) =
      A.unitGroupToResidueFieldUnits x :=
  rfl
#align valuation_subring.units_mod_principal_units_equiv_residue_field_units_comp_quotient_group_mk_apply ValuationSubring.unitsModPrincipalUnitsEquivResidueFieldUnits_comp_quotient_group_mk_apply

end PrincipalUnitGroup

/-! ### Pointwise actions

This transfers the action from `subring.pointwise_mul_action`, noting that it only applies when
the action is by a group. Notably this provides an instances when `G` is `K ≃+* K`.

These instances are in the `pointwise` locale.

The lemmas in this section are copied from `ring_theory/subring/pointwise.lean`; try to keep these
in sync.
-/

section PointwiseActions

open Pointwise

variable {G : Type _} [Group G] [MulSemiringAction G K]

/-- The action on a valuation subring corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
def pointwiseHasSmul : SMul G (ValuationSubring K)
    where smul g
    S :=-- TODO: if we add `valuation_subring.map` at a later date, we should use it here
    { g • S.toSubring with
      mem_or_inv_mem' := fun x =>
        (mem_or_inv_mem S (g⁻¹ • x)).imp Subring.mem_pointwise_smul_iff_inv_smul_mem.mpr fun h =>
          Subring.mem_pointwise_smul_iff_inv_smul_mem.mpr <| by rwa [smul_inv''] }
#align valuation_subring.pointwise_has_smul ValuationSubring.pointwiseHasSmul

scoped[Pointwise] attribute [instance] ValuationSubring.pointwiseHasSmul

open Pointwise

@[simp]
theorem coe_pointwise_smul (g : G) (S : ValuationSubring K) : ↑(g • S) = g • (S : Set K) :=
  rfl
#align valuation_subring.coe_pointwise_smul ValuationSubring.coe_pointwise_smul

@[simp]
theorem pointwise_smul_toSubring (g : G) (S : ValuationSubring K) :
    (g • S).toSubring = g • S.toSubring :=
  rfl
#align valuation_subring.pointwise_smul_to_subring ValuationSubring.pointwise_smul_toSubring

/-- The action on a valuation subring corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale.

This is a stronger version of `valuation_subring.pointwise_has_smul`. -/
def pointwiseMulAction : MulAction G (ValuationSubring K) :=
  toSubring_injective.MulAction toSubring pointwise_smul_toSubring
#align valuation_subring.pointwise_mul_action ValuationSubring.pointwiseMulAction

scoped[Pointwise] attribute [instance] ValuationSubring.pointwiseMulAction

open Pointwise

theorem smul_mem_pointwise_smul (g : G) (x : K) (S : ValuationSubring K) : x ∈ S → g • x ∈ g • S :=
  (Set.smul_mem_smul_set : _ → _ ∈ g • (S : Set K))
#align valuation_subring.smul_mem_pointwise_smul ValuationSubring.smul_mem_pointwise_smul

theorem mem_smul_pointwise_iff_exists (g : G) (x : K) (S : ValuationSubring K) :
    x ∈ g • S ↔ ∃ s : K, s ∈ S ∧ g • s = x :=
  (Set.mem_smul_set : x ∈ g • (S : Set K) ↔ _)
#align valuation_subring.mem_smul_pointwise_iff_exists ValuationSubring.mem_smul_pointwise_iff_exists

instance pointwise_central_scalar [MulSemiringAction Gᵐᵒᵖ K] [IsCentralScalar G K] :
    IsCentralScalar G (ValuationSubring K) :=
  ⟨fun g S => toSubring_injective <| op_smul_eq_smul g S.to_subring⟩
#align valuation_subring.pointwise_central_scalar ValuationSubring.pointwise_central_scalar

@[simp]
theorem smul_mem_pointwise_smul_iff {g : G} {S : ValuationSubring K} {x : K} :
    g • x ∈ g • S ↔ x ∈ S :=
  Set.smul_mem_smul_set_iff
#align valuation_subring.smul_mem_pointwise_smul_iff ValuationSubring.smul_mem_pointwise_smul_iff

theorem mem_pointwise_smul_iff_inv_smul_mem {g : G} {S : ValuationSubring K} {x : K} :
    x ∈ g • S ↔ g⁻¹ • x ∈ S :=
  Set.mem_smul_set_iff_inv_smul_mem
#align valuation_subring.mem_pointwise_smul_iff_inv_smul_mem ValuationSubring.mem_pointwise_smul_iff_inv_smul_mem

theorem mem_inv_pointwise_smul_iff {g : G} {S : ValuationSubring K} {x : K} :
    x ∈ g⁻¹ • S ↔ g • x ∈ S :=
  Set.mem_inv_smul_set_iff
#align valuation_subring.mem_inv_pointwise_smul_iff ValuationSubring.mem_inv_pointwise_smul_iff

@[simp]
theorem pointwise_smul_le_pointwise_smul_iff {g : G} {S T : ValuationSubring K} :
    g • S ≤ g • T ↔ S ≤ T :=
  Set.set_smul_subset_set_smul_iff
#align valuation_subring.pointwise_smul_le_pointwise_smul_iff ValuationSubring.pointwise_smul_le_pointwise_smul_iff

theorem pointwise_smul_subset_iff {g : G} {S T : ValuationSubring K} : g • S ≤ T ↔ S ≤ g⁻¹ • T :=
  Set.set_smul_subset_iff
#align valuation_subring.pointwise_smul_subset_iff ValuationSubring.pointwise_smul_subset_iff

theorem subset_pointwise_smul_iff {g : G} {S T : ValuationSubring K} : S ≤ g • T ↔ g⁻¹ • S ≤ T :=
  Set.subset_set_smul_iff
#align valuation_subring.subset_pointwise_smul_iff ValuationSubring.subset_pointwise_smul_iff

end PointwiseActions

section

variable {L J : Type _} [Field L] [Field J]

/-- The pullback of a valuation subring `A` along a ring homomorphism `K →+* L`. -/
def comap (A : ValuationSubring L) (f : K →+* L) : ValuationSubring K :=
  { A.toSubring.comap f with mem_or_inv_mem' := fun k => by simp [ValuationSubring.mem_or_inv_mem] }
#align valuation_subring.comap ValuationSubring.comap

@[simp]
theorem coe_comap (A : ValuationSubring L) (f : K →+* L) : (A.comap f : Set K) = f ⁻¹' A :=
  rfl
#align valuation_subring.coe_comap ValuationSubring.coe_comap

@[simp]
theorem mem_comap {A : ValuationSubring L} {f : K →+* L} {x : K} : x ∈ A.comap f ↔ f x ∈ A :=
  Iff.rfl
#align valuation_subring.mem_comap ValuationSubring.mem_comap

theorem comap_comap (A : ValuationSubring J) (g : L →+* J) (f : K →+* L) :
    (A.comap g).comap f = A.comap (g.comp f) :=
  rfl
#align valuation_subring.comap_comap ValuationSubring.comap_comap

end

end ValuationSubring

namespace Valuation

variable {Γ : Type _} [LinearOrderedCommGroupWithZero Γ] (v : Valuation K Γ) (x : Kˣ)

@[simp]
theorem mem_unitGroup_iff : x ∈ v.ValuationSubring.unitGroup ↔ v x = 1 :=
  (Valuation.IsEquiv_iff_val_eq_one _ _).mp (Valuation.isEquiv_valuation_valuationSubring _).symm
#align valuation.mem_unit_group_iff Valuation.mem_unitGroup_iff

end Valuation


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import algebra.algebra.operations
import algebra.algebra.subalgebra.tower
import linear_algebra.prod
import linear_algebra.finsupp

/-!
# Adjoining elements to form subalgebras

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

This file develops the basic theory of subalgebras of an R-algebra generated
by a set of elements. A basic interface for `adjoin` is set up.

## Tags

adjoin, algebra

-/

universes u v w

open_locale pointwise
open submodule subsemiring

variables {R : Type u} {A : Type v} {B : Type w}

namespace algebra

section semiring
variables [comm_semiring R] [semiring A] [semiring B]
variables [algebra R A] [algebra R B] {s t : set A}

theorem subset_adjoin : s ⊆ adjoin R s :=
algebra.gc.le_u_l s

theorem adjoin_le {S : subalgebra R A} (H : s ⊆ S) : adjoin R s ≤ S :=
algebra.gc.l_le H

lemma adjoin_eq_Inf : adjoin R s = Inf {p | s ⊆ p} :=
le_antisymm (le_Inf (λ _ h, adjoin_le h)) (Inf_le subset_adjoin)

theorem adjoin_le_iff {S : subalgebra R A} : adjoin R s ≤ S ↔ s ⊆ S:=
algebra.gc _ _

theorem adjoin_eq_of_le (S : subalgebra R A) (h₁ : s ⊆ S) (h₂ : S ≤ adjoin R s) : adjoin R s = S :=
le_antisymm (adjoin_le h₁) h₂

theorem adjoin_eq (S : subalgebra R A) : adjoin R ↑S = S :=
adjoin_eq_of_le _ (set.subset.refl _) subset_adjoin

lemma adjoin_Union {α : Type*} (s : α → set A) :
  adjoin R (set.Union s) = ⨆ (i : α), adjoin R (s i) :=
(@algebra.gc R A _ _ _).l_supr

lemma adjoin_attach_bUnion [decidable_eq A] {α : Type*} {s : finset α} (f : s → finset A) :
  adjoin R (s.attach.bUnion f : set A) = ⨆ x, adjoin R (f x) :=
by simpa [adjoin_Union]

@[elab_as_eliminator] theorem adjoin_induction {p : A → Prop} {x : A} (h : x ∈ adjoin R s)
  (Hs : ∀ x ∈ s, p x)
  (Halg : ∀ r, p (algebra_map R A r))
  (Hadd : ∀ x y, p x → p y → p (x + y))
  (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
let S : subalgebra R A :=
{ carrier := p, mul_mem' := Hmul, add_mem' := Hadd, algebra_map_mem' := Halg } in
adjoin_le (show s ≤ S, from Hs) h

/-- Induction principle for the algebra generated by a set `s`: show that `p x y` holds for any
`x y ∈ adjoin R s` given that that it holds for `x y ∈ s` and that it satisfies a number of
natural properties. -/
@[elab_as_eliminator]
lemma adjoin_induction₂ {p : A → A → Prop} {a b : A} (ha : a ∈ adjoin R s) (hb : b ∈ adjoin R s)
  (Hs : ∀ (x ∈ s) (y ∈ s), p x y)
  (Halg : ∀ r₁ r₂, p (algebra_map R A r₁) (algebra_map R A r₂))
  (Halg_left : ∀ r (x ∈ s), p (algebra_map R A r) x)
  (Halg_right : ∀ r (x ∈ s), p x (algebra_map R A r))
  (Hadd_left : ∀ x₁ x₂ y, p x₁ y → p x₂ y → p (x₁ + x₂) y)
  (Hadd_right : ∀ x y₁ y₂, p x y₁ → p x y₂ → p x (y₁ + y₂))
  (Hmul_left : ∀ x₁ x₂ y, p x₁ y → p x₂ y → p (x₁ * x₂) y)
  (Hmul_right : ∀ x y₁ y₂, p x y₁ → p x y₂ → p x (y₁ * y₂)) : p a b :=
begin
  refine adjoin_induction hb _ (λ r, _) (Hadd_right a) (Hmul_right a),
  { exact adjoin_induction ha Hs Halg_left (λ x y Hx Hy z hz, Hadd_left x y z (Hx z hz) (Hy z hz))
      (λ x y Hx Hy z hz, Hmul_left x y z (Hx z hz) (Hy z hz)) },
  { exact adjoin_induction ha (Halg_right r) (λ r', Halg r' r)
      (λ x y, Hadd_left x y ((algebra_map R A) r))
      (λ x y, Hmul_left x y ((algebra_map R A) r)) },
end

/-- The difference with `algebra.adjoin_induction` is that this acts on the subtype. -/
lemma adjoin_induction' {p : adjoin R s → Prop} (Hs : ∀ x (h : x ∈ s), p ⟨x, subset_adjoin h⟩)
  (Halg : ∀ r, p (algebra_map R _ r)) (Hadd : ∀ x y, p x → p y → p (x + y))
  (Hmul : ∀ x y, p x → p y → p (x * y)) (x : adjoin R s) : p x :=
subtype.rec_on x $ λ x hx, begin
  refine exists.elim _ (λ (hx : x ∈ adjoin R s) (hc : p ⟨x, hx⟩), hc),
  exact adjoin_induction hx (λ x hx, ⟨subset_adjoin hx, Hs x hx⟩)
    (λ r, ⟨subalgebra.algebra_map_mem _ r, Halg r⟩)
    (λ x y hx hy, exists.elim hx $ λ hx' hx, exists.elim hy $ λ hy' hy,
    ⟨subalgebra.add_mem _ hx' hy', Hadd _ _ hx hy⟩) (λ x y hx hy, exists.elim hx $ λ hx' hx,
    exists.elim hy $ λ hy' hy, ⟨subalgebra.mul_mem _ hx' hy', Hmul _ _ hx hy⟩),
end

@[simp] lemma adjoin_adjoin_coe_preimage {s : set A} :
  adjoin R ((coe : adjoin R s → A) ⁻¹' s) = ⊤ :=
begin
  refine eq_top_iff.2 (λ x, adjoin_induction' (λ a ha, _) (λ r, _) (λ _ _, _) (λ _ _, _) x),
  { exact subset_adjoin ha },
  { exact subalgebra.algebra_map_mem _ r },
  { exact subalgebra.add_mem _ },
  { exact subalgebra.mul_mem _ }
end

lemma adjoin_union (s t : set A) : adjoin R (s ∪ t) = adjoin R s ⊔ adjoin R t :=
(algebra.gc : galois_connection _ (coe : subalgebra R A → set A)).l_sup

variables (R A)
@[simp] theorem adjoin_empty : adjoin R (∅ : set A) = ⊥ :=
show adjoin R ⊥ = ⊥, by { apply galois_connection.l_bot, exact algebra.gc }

@[simp] theorem adjoin_univ : adjoin R (set.univ : set A) = ⊤ :=
eq_top_iff.2 $ λ x, subset_adjoin $ set.mem_univ _

variables (R) {A} (s)

theorem adjoin_eq_span : (adjoin R s).to_submodule = span R (submonoid.closure s) :=
begin
  apply le_antisymm,
  { intros r hr, rcases subsemiring.mem_closure_iff_exists_list.1 hr with ⟨L, HL, rfl⟩, clear hr,
    induction L with hd tl ih, { exact zero_mem _ },
    rw list.forall_mem_cons at HL,
    rw [list.map_cons, list.sum_cons],
    refine submodule.add_mem _ _ (ih HL.2),
    replace HL := HL.1, clear ih tl,
    suffices : ∃ z r (hr : r ∈ submonoid.closure s), has_smul.smul z r = list.prod hd,
    { rcases this with ⟨z, r, hr, hzr⟩, rw ← hzr,
      exact smul_mem _ _ (subset_span hr) },
    induction hd with hd tl ih, { exact ⟨1, 1, (submonoid.closure s).one_mem', one_smul _ _⟩ },
    rw list.forall_mem_cons at HL,
    rcases (ih HL.2) with ⟨z, r, hr, hzr⟩, rw [list.prod_cons, ← hzr],
    rcases HL.1 with ⟨hd, rfl⟩ | hs,
    { refine ⟨hd * z, r, hr, _⟩,
      rw [algebra.smul_def, algebra.smul_def, (algebra_map _ _).map_mul, _root_.mul_assoc] },
    { exact ⟨z, hd * r, submonoid.mul_mem _ (submonoid.subset_closure hs) hr,
        (mul_smul_comm _ _ _).symm⟩ } },
  refine span_le.2 _,
  change submonoid.closure s ≤ (adjoin R s).to_subsemiring.to_submonoid,
  exact submonoid.closure_le.2 subset_adjoin
end

lemma span_le_adjoin (s : set A) : span R s ≤ (adjoin R s).to_submodule :=
span_le.mpr subset_adjoin

lemma adjoin_to_submodule_le {s : set A} {t : submodule R A} :
  (adjoin R s).to_submodule ≤ t ↔ ↑(submonoid.closure s) ⊆ (t : set A) :=
by rw [adjoin_eq_span, span_le]

lemma adjoin_eq_span_of_subset {s : set A} (hs : ↑(submonoid.closure s) ⊆ (span R s : set A)) :
  (adjoin R s).to_submodule = span R s :=
le_antisymm ((adjoin_to_submodule_le R).mpr hs) (span_le_adjoin R s)

@[simp] lemma adjoin_span {s : set A} :
  adjoin R (submodule.span R s : set A) = adjoin R s :=
le_antisymm (adjoin_le (span_le_adjoin _ _)) (adjoin_mono submodule.subset_span)

lemma adjoin_image (f : A →ₐ[R] B) (s : set A) :
  adjoin R (f '' s) = (adjoin R s).map f :=
le_antisymm (adjoin_le $ set.image_subset _ subset_adjoin) $
subalgebra.map_le.2 $ adjoin_le $ set.image_subset_iff.1 subset_adjoin

@[simp] lemma adjoin_insert_adjoin (x : A) :
  adjoin R (insert x ↑(adjoin R s)) = adjoin R (insert x s) :=
le_antisymm
  (adjoin_le (set.insert_subset.mpr
    ⟨subset_adjoin (set.mem_insert _ _), adjoin_mono (set.subset_insert _ _)⟩))
  (algebra.adjoin_mono (set.insert_subset_insert algebra.subset_adjoin))

lemma adjoin_prod_le (s : set A) (t : set B) :
  adjoin R (s ×ˢ t) ≤ (adjoin R s).prod (adjoin R t) :=
adjoin_le $ set.prod_mono subset_adjoin subset_adjoin

lemma mem_adjoin_of_map_mul {s} {x : A} {f : A →ₗ[R] B} (hf : ∀ a₁ a₂, f(a₁ * a₂) = f a₁ * f a₂)
  (h : x ∈ adjoin R s) : f x ∈ adjoin R (f '' (s ∪ {1})) :=
begin
  refine @adjoin_induction R A _ _ _ _ (λ a, f a ∈ adjoin R (f '' (s ∪ {1}))) x h
    (λ a ha, subset_adjoin ⟨a, ⟨set.subset_union_left _ _ ha, rfl⟩⟩)
    (λ r, _)
    (λ y z hy hz, by simpa [hy, hz] using subalgebra.add_mem _ hy hz)
    (λ y z hy hz, by simpa [hy, hz, hf y z] using subalgebra.mul_mem _ hy hz),
  have : f 1 ∈ adjoin R (f '' (s ∪ {1})) :=
  subset_adjoin ⟨1, ⟨set.subset_union_right _ _ $ set.mem_singleton 1, rfl⟩⟩,
  replace this := subalgebra.smul_mem (adjoin R (f '' (s ∪ {1}))) this r,
  convert this,
  rw algebra_map_eq_smul_one,
  exact f.map_smul _ _
end

lemma adjoin_inl_union_inr_eq_prod (s) (t) :
  adjoin R (linear_map.inl R A B '' (s ∪ {1}) ∪ linear_map.inr R A B '' (t ∪ {1})) =
    (adjoin R s).prod (adjoin R t) :=
begin
  apply le_antisymm,
  { simp only [adjoin_le_iff, set.insert_subset, subalgebra.zero_mem, subalgebra.one_mem,
      subset_adjoin, -- the rest comes from `squeeze_simp`
      set.union_subset_iff, linear_map.coe_inl, set.mk_preimage_prod_right,
      set.image_subset_iff, set_like.mem_coe, set.mk_preimage_prod_left, linear_map.coe_inr,
      and_self, set.union_singleton, subalgebra.coe_prod] },
  { rintro ⟨a, b⟩ ⟨ha, hb⟩,
    let P := adjoin R (linear_map.inl R A B '' (s ∪ {1}) ∪ linear_map.inr R A B '' (t ∪ {1})),
    have Ha : (a, (0 : B)) ∈ adjoin R ((linear_map.inl R A B) '' (s ∪ {1})) :=
      mem_adjoin_of_map_mul R (linear_map.inl_map_mul) ha,
    have Hb : ((0 : A), b) ∈ adjoin R ((linear_map.inr R A B) '' (t ∪ {1})) :=
      mem_adjoin_of_map_mul R (linear_map.inr_map_mul) hb,
    replace Ha : (a, (0 : B)) ∈ P := adjoin_mono (set.subset_union_left _ _) Ha,
    replace Hb : ((0 : A), b) ∈ P := adjoin_mono (set.subset_union_right _ _) Hb,
    simpa using subalgebra.add_mem _ Ha Hb }
end

/-- If all elements of `s : set A` commute pairwise, then `adjoin R s` is a commutative
semiring.  -/
def adjoin_comm_semiring_of_comm {s : set A} (hcomm : ∀ (a ∈ s) (b ∈ s), a * b = b * a) :
  comm_semiring (adjoin R s) :=
{ mul_comm := λ x y,
  begin
    ext,
    simp only [subalgebra.coe_mul],
    exact adjoin_induction₂ x.prop y.prop
      hcomm
      (λ _ _, by rw [commutes])
      (λ r x hx, commutes r x) (λ r x hx, (commutes r x).symm)
      (λ _ _ _ h₁ h₂, by simp only [add_mul, mul_add, h₁, h₂])
      (λ _ _ _ h₁ h₂, by simp only [add_mul, mul_add, h₁, h₂])
      (λ x₁ x₂ y₁ h₁ h₂, by rw [mul_assoc, h₂, ←mul_assoc y₁, ←h₁, mul_assoc x₁])
      (λ x₁ x₂ y₁ h₁ h₂, by rw [mul_assoc x₂, ←h₂, ←mul_assoc x₂, ←h₁, ←mul_assoc])
  end,
  ..(adjoin R s).to_semiring }

lemma adjoin_singleton_one : adjoin R ({1} : set A) = ⊥ :=
eq_bot_iff.2 $ adjoin_le $ set.singleton_subset_iff.2 $ set_like.mem_coe.2 $ one_mem _

lemma self_mem_adjoin_singleton (x : A) : x ∈ adjoin R ({x} : set A) :=
algebra.subset_adjoin (set.mem_singleton_iff.mpr rfl)

end semiring

section comm_semiring
variables [comm_semiring R] [comm_semiring A]
variables [algebra R A] {s t : set A}

variables (R s t)
theorem adjoin_union_eq_adjoin_adjoin :
  adjoin R (s ∪ t) = (adjoin (adjoin R s) t).restrict_scalars R :=
le_antisymm
  (closure_mono $ set.union_subset
    (set.range_subset_iff.2 $ λ r, or.inl ⟨algebra_map R (adjoin R s) r, rfl⟩)
    (set.union_subset_union_left _ $ λ x hxs, ⟨⟨_, subset_adjoin hxs⟩, rfl⟩))
  (closure_le.2 $ set.union_subset
    (set.range_subset_iff.2 $ λ x, adjoin_mono (set.subset_union_left _ _) x.2)
    (set.subset.trans (set.subset_union_right _ _) subset_adjoin))

theorem adjoin_union_coe_submodule : (adjoin R (s ∪ t)).to_submodule =
  (adjoin R s).to_submodule * (adjoin R t).to_submodule :=
begin
  rw [adjoin_eq_span, adjoin_eq_span, adjoin_eq_span, span_mul_span],
  congr' 1 with z, simp [submonoid.closure_union, submonoid.mem_sup, set.mem_mul]
end

lemma adjoin_adjoin_of_tower [semiring B] [algebra R B] [algebra A B] [is_scalar_tower R A B]
  (s : set B) : adjoin A (adjoin R s : set B) = adjoin A s :=
begin
  apply le_antisymm (adjoin_le _),
  { exact adjoin_mono subset_adjoin },
  { change adjoin R s ≤ (adjoin A s).restrict_scalars R,
    refine adjoin_le _,
    exact subset_adjoin }
end

variable {R}

lemma pow_smul_mem_of_smul_subset_of_mem_adjoin
  [comm_semiring B] [algebra R B] [algebra A B] [is_scalar_tower R A B]
  (r : A) (s : set B) (B' : subalgebra R B) (hs : r • s ⊆ B') {x : B} (hx : x ∈ adjoin R s)
  (hr : algebra_map A B r ∈ B') :
  ∃ n₀ : ℕ, ∀ n ≥ n₀, r ^ n • x ∈ B' :=
begin
  change x ∈ (adjoin R s).to_submodule at hx,
  rw [adjoin_eq_span, finsupp.mem_span_iff_total] at hx,
  rcases hx with ⟨l, rfl : l.sum (λ (i : submonoid.closure s) (c : R), c • ↑i) = x⟩,
  choose n₁ n₂ using (λ x : submonoid.closure s, submonoid.pow_smul_mem_closure_smul r s x.prop),
  use l.support.sup n₁,
  intros n hn,
  rw finsupp.smul_sum,
  refine B'.to_submodule.sum_mem _,
  intros a ha,
  have : n ≥ n₁ a := le_trans (finset.le_sup ha) hn,
  dsimp only,
  rw [← tsub_add_cancel_of_le this, pow_add, ← smul_smul,
    ← is_scalar_tower.algebra_map_smul A (l a) (a : B), smul_smul (r ^ n₁ a),
    mul_comm, ← smul_smul, smul_def, map_pow, is_scalar_tower.algebra_map_smul],
  apply subalgebra.mul_mem _ (subalgebra.pow_mem _ hr _) _,
  refine subalgebra.smul_mem _ _ _,
  change _ ∈ B'.to_submonoid,
  rw ← submonoid.closure_eq B'.to_submonoid,
  apply submonoid.closure_mono hs (n₂ a),
end

lemma pow_smul_mem_adjoin_smul (r : R) (s : set A) {x : A} (hx : x ∈ adjoin R s) :
  ∃ n₀ : ℕ, ∀ n ≥ n₀, r ^ n • x ∈ adjoin R (r • s) :=
pow_smul_mem_of_smul_subset_of_mem_adjoin r s _ subset_adjoin hx (subalgebra.algebra_map_mem _ _)

end comm_semiring

section ring
variables [comm_ring R] [ring A]
variables [algebra R A] {s t : set A}
variables {R s t}

theorem adjoin_int (s : set R) : adjoin ℤ s = subalgebra_of_subring (subring.closure s) :=
le_antisymm (adjoin_le subring.subset_closure)
  (subring.closure_le.2 subset_adjoin : subring.closure s ≤ (adjoin ℤ s).to_subring)

theorem mem_adjoin_iff {s : set A} {x : A} :
  x ∈ adjoin R s ↔ x ∈ subring.closure (set.range (algebra_map R A) ∪ s) :=
⟨λ hx, subsemiring.closure_induction hx subring.subset_closure (subring.zero_mem _)
  (subring.one_mem _) (λ _ _, subring.add_mem _) ( λ _ _, subring.mul_mem _),
  suffices subring.closure (set.range ⇑(algebra_map R A) ∪ s) ≤ (adjoin R s).to_subring,
    from @this x, subring.closure_le.2 subsemiring.subset_closure⟩

theorem adjoin_eq_ring_closure (s : set A) :
  (adjoin R s).to_subring = subring.closure (set.range (algebra_map R A) ∪ s) :=
subring.ext $ λ x, mem_adjoin_iff

variables (R)

/-- If all elements of `s : set A` commute pairwise, then `adjoin R s` is a commutative
ring.  -/
def adjoin_comm_ring_of_comm {s : set A} (hcomm : ∀ (a ∈ s) (b ∈ s), a * b = b * a) :
  comm_ring (adjoin R s) :=
{ ..(adjoin R s).to_ring,
  ..adjoin_comm_semiring_of_comm R hcomm }

end ring

end algebra

open algebra subalgebra

namespace alg_hom

variables [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]

lemma map_adjoin (φ : A →ₐ[R] B) (s : set A) :
  (adjoin R s).map φ = adjoin R (φ '' s) :=
(adjoin_image _ _ _).symm

lemma adjoin_le_equalizer (φ₁ φ₂ : A →ₐ[R] B) {s : set A} (h : s.eq_on φ₁ φ₂) :
  adjoin R s ≤ φ₁.equalizer φ₂ :=
adjoin_le h

lemma ext_of_adjoin_eq_top {s : set A} (h : adjoin R s = ⊤) ⦃φ₁ φ₂ : A →ₐ[R] B⦄
  (hs : s.eq_on φ₁ φ₂) : φ₁ = φ₂ :=
ext $ λ x, adjoin_le_equalizer φ₁ φ₂ hs $ h.symm ▸ trivial

end alg_hom


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

/-!
# Extending differentiability to the boundary

We investigate how differentiable functions inside a set extend to differentiable functions
on the boundary. For this, it suffices that the function and its derivative admit limits there.
A general version of this statement is given in `has_fderiv_at_boundary_of_tendsto_fderiv`.

One-dimensional versions, in which one wants to obtain differentiability at the left endpoint or
the right endpoint of an interval, are given in
`has_deriv_at_interval_left_endpoint_of_tendsto_deriv` and
`has_deriv_at_interval_right_endpoint_of_tendsto_deriv`. These versions are formulated in terms
of the one-dimensional derivative `deriv ℝ f`.
-/

variables {E : Type*} [normed_group E] [normed_space ℝ E]
          {F : Type*} [normed_group F] [normed_space ℝ F]

open filter set metric continuous_linear_map
open_locale topological_space
local attribute [mono] prod_mono

/-- If a function `f` is differentiable in a convex open set and continuous on its closure, and its
derivative converges to a limit `f'` at a point on the boundary, then `f` is differentiable there
with derivative `f'`. -/
theorem has_fderiv_at_boundary_of_tendsto_fderiv {f : E → F} {s : set E} {x : E} {f' : E →L[ℝ] F}
  (f_diff : differentiable_on ℝ f s) (s_conv : convex ℝ s) (s_open : is_open s)
  (f_cont : ∀y ∈ closure s, continuous_within_at f s y)
  (h : tendsto (λy, fderiv ℝ f y) (𝓝[s] x) (𝓝 f')) :
  has_fderiv_within_at f f' (closure s) x :=
begin
  classical,
  -- one can assume without loss of generality that `x` belongs to the closure of `s`, as the
  -- statement is empty otherwise
  by_cases hx : x ∉ closure s,
  { rw ← closure_closure at hx, exact has_fderiv_within_at_of_not_mem_closure hx },
  push_neg at hx,
  rw [has_fderiv_within_at, has_fderiv_at_filter, asymptotics.is_o_iff],
  /- One needs to show that `∥f y - f x - f' (y - x)∥ ≤ ε ∥y - x∥` for `y` close to `x` in `closure
  s`, where `ε` is an arbitrary positive constant. By continuity of the functions, it suffices to
  prove this for nearby points inside `s`. In a neighborhood of `x`, the derivative of `f` is
  arbitrarily close to `f'` by assumption. The mean value inequality completes the proof. -/
  assume ε ε_pos,
  obtain ⟨δ, δ_pos, hδ⟩ : ∃ δ > 0, ∀ y ∈ s, dist y x < δ → ∥fderiv ℝ f y - f'∥ < ε,
    by simpa [dist_zero_right] using tendsto_nhds_within_nhds.1 h ε ε_pos,
  set B := ball x δ,
  suffices : ∀ y ∈ B ∩ (closure s), ∥f y - f x - (f' y - f' x)∥ ≤ ε * ∥y - x∥,
    from mem_nhds_within_iff.2 ⟨δ, δ_pos, λy hy, by simpa using this y hy⟩,
  suffices : ∀ p : E × E, p ∈ closure ((B ∩ s).prod (B ∩ s)) → ∥f p.2 - f p.1 - (f' p.2 - f' p.1)∥
    ≤ ε * ∥p.2 - p.1∥,
  { rw closure_prod_eq at this,
    intros y y_in,
    apply this ⟨x, y⟩,
    have : B ∩ closure s ⊆ closure (B ∩ s), from closure_inter_open is_open_ball,
    exact ⟨this ⟨mem_ball_self δ_pos, hx⟩, this y_in⟩ },
  have key : ∀ p : E × E, p ∈ (B ∩ s).prod (B ∩ s) → ∥f p.2 - f p.1 - (f' p.2 - f' p.1)∥
    ≤ ε * ∥p.2 - p.1∥,
  { rintros ⟨u, v⟩ ⟨u_in, v_in⟩,
    have conv : convex ℝ (B ∩ s) := (convex_ball _ _).inter s_conv,
    have diff : differentiable_on ℝ f (B ∩ s) := f_diff.mono (inter_subset_right _ _),
    have bound : ∀ z ∈ (B ∩ s), ∥fderiv_within ℝ f (B ∩ s) z - f'∥ ≤ ε,
    { intros z z_in,
      convert le_of_lt (hδ _ z_in.2 z_in.1),
      have op : is_open (B ∩ s) := is_open_ball.inter s_open,
      rw differentiable_at.fderiv_within _ (op.unique_diff_on z z_in),
      exact (diff z z_in).differentiable_at (is_open.mem_nhds op z_in) },
    simpa using conv.norm_image_sub_le_of_norm_fderiv_within_le' diff bound u_in v_in },
  rintros ⟨u, v⟩ uv_in,
  refine continuous_within_at.closure_le uv_in _ _ key,
  have f_cont' : ∀y ∈ closure s, continuous_within_at (f - f') s y,
  { intros y y_in,
    exact tendsto.sub (f_cont y y_in) (f'.cont.continuous_within_at) },
  all_goals { -- common start for both continuity proofs
    have : (B ∩ s).prod (B ∩ s) ⊆ s.prod s, by mono ; exact inter_subset_right _ _,
    obtain ⟨u_in, v_in⟩ : u ∈ closure s ∧ v ∈ closure s,
      by simpa [closure_prod_eq] using closure_mono this uv_in,
    apply continuous_within_at.mono _ this,
    simp only [continuous_within_at] },
  rw nhds_within_prod_eq,
  { have : ∀ u v, f v - f u - (f' v - f' u) = f v - f' v - (f u - f' u) := by { intros, abel },
    simp only [this],
    exact tendsto.comp continuous_norm.continuous_at
      ((tendsto.comp (f_cont' v v_in) tendsto_snd).sub $
        tendsto.comp (f_cont' u u_in) tendsto_fst) },
  { apply tendsto_nhds_within_of_tendsto_nhds,
    rw nhds_prod_eq,
    exact tendsto_const_nhds.mul
      (tendsto.comp continuous_norm.continuous_at $ tendsto_snd.sub tendsto_fst) },
end

/-- If a function is differentiable on the right of a point `a : ℝ`, continuous at `a`, and
its derivative also converges at `a`, then `f` is differentiable on the right at `a`. -/
lemma has_deriv_at_interval_left_endpoint_of_tendsto_deriv {s : set ℝ} {e : E} {a : ℝ} {f : ℝ → E}
  (f_diff : differentiable_on ℝ f s) (f_lim : continuous_within_at f s a)
  (hs : s ∈ 𝓝[Ioi a] a)
  (f_lim' : tendsto (λx, deriv f x) (𝓝[Ioi a] a) (𝓝 e)) :
  has_deriv_within_at f e (Ici a) a :=
begin
  /- This is a specialization of `has_fderiv_at_boundary_of_tendsto_fderiv`. To be in the setting of
  this theorem, we need to work on an open interval with closure contained in `s ∪ {a}`, that we
  call `t = (a, b)`. Then, we check all the assumptions of this theorem and we apply it. -/
  obtain ⟨b, ab, sab⟩ : ∃ b ∈ Ioi a, Ioc a b ⊆ s :=
    mem_nhds_within_Ioi_iff_exists_Ioc_subset.1 hs,
  let t := Ioo a b,
  have ts : t ⊆ s := subset.trans Ioo_subset_Ioc_self sab,
  have t_diff : differentiable_on ℝ f t := f_diff.mono ts,
  have t_conv : convex ℝ t := convex_Ioo a b,
  have t_open : is_open t := is_open_Ioo,
  have t_closure : closure t = Icc a b := closure_Ioo ab,
  have t_cont : ∀y ∈ closure t, continuous_within_at f t y,
  { rw t_closure,
    assume y hy,
    by_cases h : y = a,
    { rw h, exact f_lim.mono ts },
    { have : y ∈ s := sab ⟨lt_of_le_of_ne hy.1 (ne.symm h), hy.2⟩,
      exact (f_diff.continuous_on y this).mono ts } },
  have t_diff' : tendsto (λx, fderiv ℝ f x) (𝓝[t] a) (𝓝 (smul_right 1 e)),
  { simp [deriv_fderiv.symm],
    refine tendsto.comp is_bounded_bilinear_map_smul_right.continuous_right.continuous_at _,
    exact tendsto_nhds_within_mono_left Ioo_subset_Ioi_self f_lim' },
  -- now we can apply `has_fderiv_at_boundary_of_differentiable`
  have : has_deriv_within_at f e (Icc a b) a,
  { rw [has_deriv_within_at_iff_has_fderiv_within_at, ← t_closure],
    exact has_fderiv_at_boundary_of_tendsto_fderiv t_diff t_conv t_open t_cont t_diff' },
  exact this.nhds_within (mem_nhds_within_Ici_iff_exists_Icc_subset.2 ⟨b, ab, subset.refl _⟩)
end

/-- If a function is differentiable on the left of a point `a : ℝ`, continuous at `a`, and
its derivative also converges at `a`, then `f` is differentiable on the left at `a`. -/
lemma has_deriv_at_interval_right_endpoint_of_tendsto_deriv {s : set ℝ} {e : E} {a : ℝ} {f : ℝ → E}
  (f_diff : differentiable_on ℝ f s) (f_lim : continuous_within_at f s a)
  (hs : s ∈ 𝓝[Iio a] a)
  (f_lim' : tendsto (λx, deriv f x) (𝓝[Iio a] a) (𝓝 e)) :
  has_deriv_within_at f e (Iic a) a :=
begin
  /- This is a specialization of `has_fderiv_at_boundary_of_differentiable`. To be in the setting of
  this theorem, we need to work on an open interval with closure contained in `s ∪ {a}`, that we
  call `t = (b, a)`. Then, we check all the assumptions of this theorem and we apply it. -/
  obtain ⟨b, ba, sab⟩ : ∃ b ∈ Iio a, Ico b a ⊆ s :=
    mem_nhds_within_Iio_iff_exists_Ico_subset.1 hs,
  let t := Ioo b a,
  have ts : t ⊆ s := subset.trans Ioo_subset_Ico_self sab,
  have t_diff : differentiable_on ℝ f t := f_diff.mono ts,
  have t_conv : convex ℝ t := convex_Ioo b a,
  have t_open : is_open t := is_open_Ioo,
  have t_closure : closure t = Icc b a := closure_Ioo ba,
  have t_cont : ∀y ∈ closure t, continuous_within_at f t y,
  { rw t_closure,
    assume y hy,
    by_cases h : y = a,
    { rw h, exact f_lim.mono ts },
    { have : y ∈ s := sab ⟨hy.1, lt_of_le_of_ne hy.2 h⟩,
      exact (f_diff.continuous_on y this).mono ts } },
  have t_diff' : tendsto (λx, fderiv ℝ f x) (𝓝[t] a) (𝓝 (smul_right 1 e)),
  { simp [deriv_fderiv.symm],
    refine tendsto.comp is_bounded_bilinear_map_smul_right.continuous_right.continuous_at _,
    exact tendsto_nhds_within_mono_left Ioo_subset_Iio_self f_lim' },
  -- now we can apply `has_fderiv_at_boundary_of_differentiable`
  have : has_deriv_within_at f e (Icc b a) a,
  { rw [has_deriv_within_at_iff_has_fderiv_within_at, ← t_closure],
    exact has_fderiv_at_boundary_of_tendsto_fderiv t_diff t_conv t_open t_cont t_diff' },
  exact this.nhds_within (mem_nhds_within_Iic_iff_exists_Icc_subset.2 ⟨b, ba, subset.refl _⟩)
end

/-- If a real function `f` has a derivative `g` everywhere but at a point, and `f` and `g` are
continuous at this point, then `g` is also the derivative of `f` at this point. -/
lemma has_deriv_at_of_has_deriv_at_of_ne {f g : ℝ → E} {x : ℝ}
  (f_diff : ∀ y ≠ x, has_deriv_at f (g y) y)
  (hf : continuous_at f x) (hg : continuous_at g x) :
  has_deriv_at f (g x) x :=
begin
  have A : has_deriv_within_at f (g x) (Ici x) x,
  { have diff : differentiable_on ℝ f (Ioi x) :=
      λy hy, (f_diff y (ne_of_gt hy)).differentiable_at.differentiable_within_at,
    -- next line is the nontrivial bit of this proof, appealing to differentiability
    -- extension results.
    apply has_deriv_at_interval_left_endpoint_of_tendsto_deriv diff hf.continuous_within_at
      self_mem_nhds_within,
    have : tendsto g (𝓝[Ioi x] x) (𝓝 (g x)) := tendsto_inf_left hg,
    apply this.congr' _,
    apply mem_of_superset self_mem_nhds_within (λy hy, _),
    exact (f_diff y (ne_of_gt hy)).deriv.symm },
  have B : has_deriv_within_at f (g x) (Iic x) x,
  { have diff : differentiable_on ℝ f (Iio x) :=
      λy hy, (f_diff y (ne_of_lt hy)).differentiable_at.differentiable_within_at,
    -- next line is the nontrivial bit of this proof, appealing to differentiability
    -- extension results.
    apply has_deriv_at_interval_right_endpoint_of_tendsto_deriv diff hf.continuous_within_at
      self_mem_nhds_within,
    have : tendsto g (𝓝[Iio x] x) (𝓝 (g x)) := tendsto_inf_left hg,
    apply this.congr' _,
    apply mem_of_superset self_mem_nhds_within (λy hy, _),
    exact (f_diff y (ne_of_lt hy)).deriv.symm },
  simpa using B.union A
end

/-- If a real function `f` has a derivative `g` everywhere but at a point, and `f` and `g` are
continuous at this point, then `g` is the derivative of `f` everywhere. -/
lemma has_deriv_at_of_has_deriv_at_of_ne' {f g : ℝ → E} {x : ℝ}
  (f_diff : ∀ y ≠ x, has_deriv_at f (g y) y)
  (hf : continuous_at f x) (hg : continuous_at g x) (y : ℝ) :
  has_deriv_at f (g y) y :=
begin
  rcases eq_or_ne y x with rfl|hne,
  { exact has_deriv_at_of_has_deriv_at_of_ne f_diff hf hg },
  { exact f_diff y hne }
end