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

! This file was ported from Lean 3 source module category_theory.preadditive.basic
! leanprover-community/mathlib commit 829895f162a1f29d0133f4b3538f4cd1fb5bffd3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Basic
import Mathlib.Algebra.Hom.Group
import Mathlib.Algebra.Module.Basic
import Mathlib.CategoryTheory.Endomorphism
import Mathlib.CategoryTheory.Limits.Shapes.Kernels

/-!
# Preadditive categories

A preadditive category is a category in which `X ⟶ Y` is an abelian group in such a way that
composition of morphisms is linear in both variables.

This file contains a definition of preadditive category that directly encodes the definition given
above. The definition could also be phrased as follows: A preadditive category is a category
enriched over the category of Abelian groups. Once the general framework to state this in Lean is
available, the contents of this file should become obsolete.

## Main results

* Definition of preadditive categories and basic properties
* In a preadditive category, `f : Q ⟶ R` is mono if and only if `g ≫ f = 0 → g = 0` for all
  composable `g`.
* A preadditive category with kernels has equalizers.

## Implementation notes

The simp normal form for negation and composition is to push negations as far as possible to
the outside. For example, `f ≫ (-g)` and `(-f) ≫ g` both become `-(f ≫ g)`, and `(-f) ≫ (-g)`
is simplified to `f ≫ g`.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]

## Tags

additive, preadditive, Hom group, Ab-category, Ab-enriched
-/

universe v u

open CategoryTheory.Limits

open BigOperators

namespace CategoryTheory

variable (C : Type u) [Category.{v} C]

/-- A category is called preadditive if `P ⟶ Q` is an abelian group such that composition is
    linear in both variables. -/
class Preadditive where
  homGroup : ∀ P Q : C, AddCommGroup (P ⟶ Q) := by infer_instance
  add_comp : ∀ (P Q R : C) (f f' : P ⟶ Q) (g : Q ⟶ R), (f + f') ≫ g = f ≫ g + f' ≫ g := by
    aesop_cat
  comp_add : ∀ (P Q R : C) (f : P ⟶ Q) (g g' : Q ⟶ R), f ≫ (g + g') = f ≫ g + f ≫ g' := by
    aesop_cat
#align category_theory.preadditive CategoryTheory.Preadditive
#align category_theory.preadditive.add_comp' CategoryTheory.Preadditive.add_comp
#align category_theory.preadditive.comp_add' CategoryTheory.Preadditive.comp_add

attribute [inherit_doc Preadditive] Preadditive.homGroup Preadditive.add_comp Preadditive.comp_add

attribute [instance] Preadditive.homGroup

-- Porting note: simp can prove reassoc version
attribute [reassoc, simp] Preadditive.add_comp

attribute [reassoc] Preadditive.comp_add

-- (the linter doesn't like `simp` on this lemma)
attribute [simp] Preadditive.comp_add

end CategoryTheory

open CategoryTheory

namespace CategoryTheory

namespace Preadditive

section Preadditive

open AddMonoidHom

variable {C : Type u} [Category.{v} C] [Preadditive C]

section InducedCategory

universe u'

variable {D : Type u'} (F : D → C)

instance inducedCategory : Preadditive.{v} (InducedCategory C F) where
  homGroup P Q := @Preadditive.homGroup C _ _ (F P) (F Q)
  add_comp  _ _ _ _ _ _ := add_comp _ _ _ _ _ _
  comp_add  _ _ _ _ _ _ := comp_add _ _ _ _ _ _
#align category_theory.preadditive.induced_category CategoryTheory.Preadditive.inducedCategory

end InducedCategory

instance fullSubcategory (Z : C → Prop) : Preadditive.{v} (FullSubcategory Z) where
  homGroup P Q := @Preadditive.homGroup C _ _ P.obj Q.obj
  add_comp _ _ _ _ _ _ := add_comp _ _ _ _ _ _
  comp_add _ _ _ _ _ _ := comp_add _ _ _ _ _ _
#align category_theory.preadditive.full_subcategory CategoryTheory.Preadditive.fullSubcategory

instance (X : C) : AddCommGroup (End X) := by
  dsimp [End]
  infer_instance

/-- Composition by a fixed left argument as a group homomorphism -/
def leftComp {P Q : C} (R : C) (f : P ⟶ Q) : (Q ⟶ R) →+ (P ⟶ R) :=
  mk' (fun g => f ≫ g) fun g g' => by simp
#align category_theory.preadditive.left_comp CategoryTheory.Preadditive.leftComp

/-- Composition by a fixed right argument as a group homomorphism -/
def rightComp (P : C) {Q R : C} (g : Q ⟶ R) : (P ⟶ Q) →+ (P ⟶ R) :=
  mk' (fun f => f ≫ g) fun f f' => by simp
#align category_theory.preadditive.right_comp CategoryTheory.Preadditive.rightComp

variable {P Q R : C} (f f' : P ⟶ Q) (g g' : Q ⟶ R)

/-- Composition as a bilinear group homomorphism -/
def compHom : (P ⟶ Q) →+ (Q ⟶ R) →+ (P ⟶ R) :=
  AddMonoidHom.mk' (fun f => leftComp _ f) fun f₁ f₂ =>
    AddMonoidHom.ext fun g => (rightComp _ g).map_add f₁ f₂
#align category_theory.preadditive.comp_hom CategoryTheory.Preadditive.compHom

-- Porting note: simp can prove the reassoc version
@[reassoc, simp]

-- The redundant simp lemma linter says that simp can prove the reassoc version of this lemma.
@[reassoc, simp]
theorem comp_sub : f ≫ (g - g') = f ≫ g - f ≫ g' :=
  map_sub (leftComp R f) g g'
#align category_theory.preadditive.comp_sub CategoryTheory.Preadditive.comp_sub

-- Porting note: simp can prove the reassoc version
@[reassoc, simp]
theorem neg_comp : (-f) ≫ g = -f ≫ g :=
  map_neg (rightComp P g) f
#align category_theory.preadditive.neg_comp CategoryTheory.Preadditive.neg_comp

-- The redundant simp lemma linter says that simp can prove the reassoc version of this lemma.
@[reassoc, simp]
theorem comp_neg : f ≫ (-g) = -f ≫ g :=
  map_neg (leftComp R f) g
#align category_theory.preadditive.comp_neg CategoryTheory.Preadditive.comp_neg

@[reassoc]
theorem neg_comp_neg : (-f) ≫ (-g) = f ≫ g := by simp
#align category_theory.preadditive.neg_comp_neg CategoryTheory.Preadditive.neg_comp_neg

theorem nsmul_comp (n : ℕ) : (n • f) ≫ g = n • f ≫ g :=
  map_nsmul (rightComp P g) n f
#align category_theory.preadditive.nsmul_comp CategoryTheory.Preadditive.nsmul_comp

theorem comp_nsmul (n : ℕ) : f ≫ (n • g) = n • f ≫ g :=
  map_nsmul (leftComp R f) n g
#align category_theory.preadditive.comp_nsmul CategoryTheory.Preadditive.comp_nsmul

theorem zsmul_comp (n : ℤ) : (n • f) ≫ g = n • f ≫ g :=
  map_zsmul (rightComp P g) n f
#align category_theory.preadditive.zsmul_comp CategoryTheory.Preadditive.zsmul_comp

theorem comp_zsmul (n : ℤ) : f ≫ (n • g) = n • f ≫ g :=
  map_zsmul (leftComp R f) n g
#align category_theory.preadditive.comp_zsmul CategoryTheory.Preadditive.comp_zsmul

@[reassoc]
theorem comp_sum {P Q R : C} {J : Type _} (s : Finset J) (f : P ⟶ Q) (g : J → (Q ⟶ R)) :
    (f ≫ ∑ j in s, g j) = ∑ j in s, f ≫ g j :=
  map_sum (leftComp R f) _ _
#align category_theory.preadditive.comp_sum CategoryTheory.Preadditive.comp_sum

@[reassoc]
theorem sum_comp {P Q R : C} {J : Type _} (s : Finset J) (f : J → (P ⟶ Q)) (g : Q ⟶ R) :
    (∑ j in s, f j) ≫ g = ∑ j in s, f j ≫ g :=
  map_sum (rightComp P g) _ _
#align category_theory.preadditive.sum_comp CategoryTheory.Preadditive.sum_comp

instance {P Q : C} {f : P ⟶ Q} [Epi f] : Epi (-f) :=
  ⟨fun g g' H => by rwa [neg_comp, neg_comp, ← comp_neg, ← comp_neg, cancel_epi, neg_inj] at H⟩

instance {P Q : C} {f : P ⟶ Q} [Mono f] : Mono (-f) :=
  ⟨fun g g' H => by rwa [comp_neg, comp_neg, ← neg_comp, ← neg_comp, cancel_mono, neg_inj] at H⟩

instance (priority := 100) preadditiveHasZeroMorphisms : HasZeroMorphisms C where
  Zero := inferInstance
  comp_zero f R := show leftComp R f 0 = 0 from map_zero _
  zero_comp P _ _ f := show rightComp P f 0 = 0 from map_zero _
#align category_theory.preadditive.preadditive_has_zero_morphisms CategoryTheory.Preadditive.preadditiveHasZeroMorphisms

/--Porting note: adding this before the ring instance allowed moduleEndRight to find
the correct Monoid structure on End. Moved both down after preadditiveHasZeroMorphisms
to make use of them -/
instance {X : C} : Semiring (End X) :=
  { End.monoid with
    zero_mul := fun f => by dsimp [mul]; exact HasZeroMorphisms.comp_zero f _
    mul_zero := fun f => by dsimp [mul]; exact HasZeroMorphisms.zero_comp _ f
    left_distrib := fun f g h => Preadditive.add_comp X X X g h f
    right_distrib := fun f g h => Preadditive.comp_add X X X h f g }

/-- Porting note: It looks like Ring's parent classes changed in
Lean 4 so the previous instance needed modification. Was following my nose here. -/
instance {X : C} : Ring (End X) :=
  { (inferInstance : Semiring (End X)),
    (inferInstance : AddCommGroup (End X)) with
    add_left_neg := add_left_neg }

instance moduleEndRight {X Y : C} : Module (End Y) (X ⟶ Y) where
  smul_add _ _ _ := add_comp _ _ _ _ _ _
  smul_zero _ := zero_comp
  add_smul _ _ _ := comp_add _ _ _ _ _ _
  zero_smul _ := comp_zero
#align category_theory.preadditive.module_End_right CategoryTheory.Preadditive.moduleEndRight

theorem mono_of_cancel_zero {Q R : C} (f : Q ⟶ R) (h : ∀ {P : C} (g : P ⟶ Q), g ≫ f = 0 → g = 0) :
    Mono f where
  right_cancellation := fun {Z} g₁ g₂ hg =>
    sub_eq_zero.1 <| h _ <| (map_sub (rightComp Z f) g₁ g₂).trans <| sub_eq_zero.2 hg
#align category_theory.preadditive.mono_of_cancel_zero CategoryTheory.Preadditive.mono_of_cancel_zero

theorem mono_iff_cancel_zero {Q R : C} (f : Q ⟶ R) :
    Mono f ↔ ∀ (P : C) (g : P ⟶ Q), g ≫ f = 0 → g = 0 :=
  ⟨fun _ _ _ => zero_of_comp_mono _, mono_of_cancel_zero f⟩
#align category_theory.preadditive.mono_iff_cancel_zero CategoryTheory.Preadditive.mono_iff_cancel_zero

theorem mono_of_kernel_zero {X Y : C} {f : X ⟶ Y} [HasLimit (parallelPair f 0)]
    (w : kernel.ι f = 0) : Mono f :=
  mono_of_cancel_zero f fun g h => by rw [← kernel.lift_ι f g h, w, Limits.comp_zero]
#align category_theory.preadditive.mono_of_kernel_zero CategoryTheory.Preadditive.mono_of_kernel_zero

theorem epi_of_cancel_zero {P Q : C} (f : P ⟶ Q) (h : ∀ {R : C} (g : Q ⟶ R), f ≫ g = 0 → g = 0) :
    Epi f :=
  ⟨fun {Z} g g' hg =>
    sub_eq_zero.1 <| h _ <| (map_sub (leftComp Z f) g g').trans <| sub_eq_zero.2 hg⟩
#align category_theory.preadditive.epi_of_cancel_zero CategoryTheory.Preadditive.epi_of_cancel_zero

theorem epi_iff_cancel_zero {P Q : C} (f : P ⟶ Q) :
    Epi f ↔ ∀ (R : C) (g : Q ⟶ R), f ≫ g = 0 → g = 0 :=
  ⟨fun _ _ _ => zero_of_epi_comp _, epi_of_cancel_zero f⟩
#align category_theory.preadditive.epi_iff_cancel_zero CategoryTheory.Preadditive.epi_iff_cancel_zero

theorem epi_of_cokernel_zero {X Y : C} {f : X ⟶ Y} [HasColimit (parallelPair f 0)]
    (w : cokernel.π f = 0) : Epi f :=
  epi_of_cancel_zero f fun g h => by rw [← cokernel.π_desc f g h, w, Limits.zero_comp]
#align category_theory.preadditive.epi_of_cokernel_zero CategoryTheory.Preadditive.epi_of_cokernel_zero

namespace IsIso

@[simp]
theorem comp_left_eq_zero [IsIso f] : f ≫ g = 0 ↔ g = 0 := by
  rw [← IsIso.eq_inv_comp, Limits.comp_zero]
#align category_theory.preadditive.is_iso.comp_left_eq_zero CategoryTheory.Preadditive.IsIso.comp_left_eq_zero

@[simp]
theorem comp_right_eq_zero [IsIso g] : f ≫ g = 0 ↔ f = 0 := by
  rw [← IsIso.eq_comp_inv, Limits.zero_comp]
#align category_theory.preadditive.is_iso.comp_right_eq_zero CategoryTheory.Preadditive.IsIso.comp_right_eq_zero

end IsIso

open ZeroObject

variable [HasZeroObject C]

theorem mono_of_kernel_iso_zero {X Y : C} {f : X ⟶ Y} [HasLimit (parallelPair f 0)]
    (w : kernel f ≅ 0) : Mono f :=
  mono_of_kernel_zero (zero_of_source_iso_zero _ w)
#align category_theory.preadditive.mono_of_kernel_iso_zero CategoryTheory.Preadditive.mono_of_kernel_iso_zero

theorem epi_of_cokernel_iso_zero {X Y : C} {f : X ⟶ Y} [HasColimit (parallelPair f 0)]
    (w : cokernel f ≅ 0) : Epi f :=
  epi_of_cokernel_zero (zero_of_target_iso_zero _ w)
#align category_theory.preadditive.epi_of_cokernel_iso_zero CategoryTheory.Preadditive.epi_of_cokernel_iso_zero

end Preadditive

section Equalizers

variable {C : Type u} [Category.{v} C] [Preadditive C]

section

variable {X Y : C} {f : X ⟶ Y} {g : X ⟶ Y}

/-- Map a kernel cone on the difference of two morphisms to the equalizer fork. -/
@[simps! pt]
def forkOfKernelFork (c : KernelFork (f - g)) : Fork f g :=
  Fork.ofι c.ι <| by rw [← sub_eq_zero, ← comp_sub, c.condition]
#align category_theory.preadditive.fork_of_kernel_fork CategoryTheory.Preadditive.forkOfKernelFork

@[simp]
theorem forkOfKernelFork_ι (c : KernelFork (f - g)) : (forkOfKernelFork c).ι = c.ι :=
  rfl
#align category_theory.preadditive.fork_of_kernel_fork_ι CategoryTheory.Preadditive.forkOfKernelFork_ι

/-- Map any equalizer fork to a cone on the difference of the two morphisms. -/
def kernelForkOfFork (c : Fork f g) : KernelFork (f - g) :=
  Fork.ofι c.ι <| by rw [comp_sub, comp_zero, sub_eq_zero, c.condition]
#align category_theory.preadditive.kernel_fork_of_fork CategoryTheory.Preadditive.kernelForkOfFork

@[simp]
theorem kernelForkOfFork_ι (c : Fork f g) : (kernelForkOfFork c).ι = c.ι :=
  rfl
#align category_theory.preadditive.kernel_fork_of_fork_ι CategoryTheory.Preadditive.kernelForkOfFork_ι

@[simp]
theorem kernelForkOfFork_ofι {P : C} (ι : P ⟶ X) (w : ι ≫ f = ι ≫ g) :
    kernelForkOfFork (Fork.ofι ι w) = KernelFork.ofι ι (by simp [w]) :=
  rfl
#align category_theory.preadditive.kernel_fork_of_fork_of_ι CategoryTheory.Preadditive.kernelForkOfFork_ofι

/-- A kernel of `f - g` is an equalizer of `f` and `g`. -/
def isLimitForkOfKernelFork {c : KernelFork (f - g)} (i : IsLimit c) :
    IsLimit (forkOfKernelFork c) :=
  Fork.IsLimit.mk' _ fun s =>
    ⟨i.lift (kernelForkOfFork s), i.fac _ _, fun h => by apply Fork.IsLimit.hom_ext i; aesop_cat⟩
#align category_theory.preadditive.is_limit_fork_of_kernel_fork CategoryTheory.Preadditive.isLimitForkOfKernelFork

@[simp]
theorem isLimitForkOfKernelFork_lift {c : KernelFork (f - g)} (i : IsLimit c) (s : Fork f g) :
    (isLimitForkOfKernelFork i).lift s = i.lift (kernelForkOfFork s) :=
  rfl
#align category_theory.preadditive.is_limit_fork_of_kernel_fork_lift CategoryTheory.Preadditive.isLimitForkOfKernelFork_lift

/-- An equalizer of `f` and `g` is a kernel of `f - g`. -/
def isLimitKernelForkOfFork {c : Fork f g} (i : IsLimit c) : IsLimit (kernelForkOfFork c) :=
  Fork.IsLimit.mk' _ fun s =>
    ⟨i.lift (forkOfKernelFork s), i.fac _ _, fun h => by apply Fork.IsLimit.hom_ext i; aesop_cat⟩
#align category_theory.preadditive.is_limit_kernel_fork_of_fork CategoryTheory.Preadditive.isLimitKernelForkOfFork

variable (f g)

/-- A preadditive category has an equalizer for `f` and `g` if it has a kernel for `f - g`. -/
theorem hasEqualizer_of_hasKernel [HasKernel (f - g)] : HasEqualizer f g :=
  HasLimit.mk
    { cone := forkOfKernelFork _
      isLimit := isLimitForkOfKernelFork (equalizerIsEqualizer (f - g) 0) }
#align category_theory.preadditive.has_equalizer_of_has_kernel CategoryTheory.Preadditive.hasEqualizer_of_hasKernel

/-- A preadditive category has a kernel for `f - g` if it has an equalizer for `f` and `g`. -/
theorem hasKernel_of_hasEqualizer [HasEqualizer f g] : HasKernel (f - g) :=
  HasLimit.mk
    { cone := kernelForkOfFork (equalizer.fork f g)
      isLimit := isLimitKernelForkOfFork (limit.isLimit (parallelPair f g)) }
#align category_theory.preadditive.has_kernel_of_has_equalizer CategoryTheory.Preadditive.hasKernel_of_hasEqualizer

variable {f g}

/-- Map a cokernel cocone on the difference of two morphisms to the coequalizer cofork. -/
@[simps! pt]
def coforkOfCokernelCofork (c : CokernelCofork (f - g)) : Cofork f g :=
  Cofork.ofπ c.π <| by rw [← sub_eq_zero, ← sub_comp, c.condition]
#align category_theory.preadditive.cofork_of_cokernel_cofork CategoryTheory.Preadditive.coforkOfCokernelCofork

@[simp]
theorem coforkOfCokernelCofork_π (c : CokernelCofork (f - g)) :
    (coforkOfCokernelCofork c).π = c.π :=
  rfl
#align category_theory.preadditive.cofork_of_cokernel_cofork_π CategoryTheory.Preadditive.coforkOfCokernelCofork_π

/-- Map any coequalizer cofork to a cocone on the difference of the two morphisms. -/
def cokernelCoforkOfCofork (c : Cofork f g) : CokernelCofork (f - g) :=
  Cofork.ofπ c.π <| by rw [sub_comp, zero_comp, sub_eq_zero, c.condition]
#align category_theory.preadditive.cokernel_cofork_of_cofork CategoryTheory.Preadditive.cokernelCoforkOfCofork

@[simp]
theorem cokernelCoforkOfCofork_π (c : Cofork f g) : (cokernelCoforkOfCofork c).π = c.π :=
  rfl
#align category_theory.preadditive.cokernel_cofork_of_cofork_π CategoryTheory.Preadditive.cokernelCoforkOfCofork_π

@[simp]
theorem cokernelCoforkOfCofork_ofπ {P : C} (π : Y ⟶ P) (w : f ≫ π = g ≫ π) :
    cokernelCoforkOfCofork (Cofork.ofπ π w) = CokernelCofork.ofπ π (by simp [w]) :=
  rfl
#align category_theory.preadditive.cokernel_cofork_of_cofork_of_π CategoryTheory.Preadditive.cokernelCoforkOfCofork_ofπ

/-- A cokernel of `f - g` is a coequalizer of `f` and `g`. -/
def isColimitCoforkOfCokernelCofork {c : CokernelCofork (f - g)} (i : IsColimit c) :
    IsColimit (coforkOfCokernelCofork c) :=
  Cofork.IsColimit.mk' _ fun s =>
    ⟨i.desc (cokernelCoforkOfCofork s), i.fac _ _, fun h => by
      apply Cofork.IsColimit.hom_ext i; aesop_cat⟩
#align category_theory.preadditive.is_colimit_cofork_of_cokernel_cofork CategoryTheory.Preadditive.isColimitCoforkOfCokernelCofork

@[simp]
theorem isColimitCoforkOfCokernelCofork_desc {c : CokernelCofork (f - g)} (i : IsColimit c)
    (s : Cofork f g) :
    (isColimitCoforkOfCokernelCofork i).desc s = i.desc (cokernelCoforkOfCofork s) :=
  rfl
#align category_theory.preadditive.is_colimit_cofork_of_cokernel_cofork_desc CategoryTheory.Preadditive.isColimitCoforkOfCokernelCofork_desc

/-- A coequalizer of `f` and `g` is a cokernel of `f - g`. -/
def isColimitCokernelCoforkOfCofork {c : Cofork f g} (i : IsColimit c) :
    IsColimit (cokernelCoforkOfCofork c) :=
  Cofork.IsColimit.mk' _ fun s =>
    ⟨i.desc (coforkOfCokernelCofork s), i.fac _ _, fun h => by
      apply Cofork.IsColimit.hom_ext i; aesop_cat⟩
#align category_theory.preadditive.is_colimit_cokernel_cofork_of_cofork CategoryTheory.Preadditive.isColimitCokernelCoforkOfCofork

variable (f g)

/-- A preadditive category has a coequalizer for `f` and `g` if it has a cokernel for `f - g`. -/
theorem hasCoequalizer_of_hasCokernel [HasCokernel (f - g)] : HasCoequalizer f g :=
  HasColimit.mk
    { cocone := coforkOfCokernelCofork _
      isColimit := isColimitCoforkOfCokernelCofork (coequalizerIsCoequalizer (f - g) 0) }
#align category_theory.preadditive.has_coequalizer_of_has_cokernel CategoryTheory.Preadditive.hasCoequalizer_of_hasCokernel

/-- A preadditive category has a cokernel for `f - g` if it has a coequalizer for `f` and `g`. -/
theorem hasCokernel_of_hasCoequalizer [HasCoequalizer f g] : HasCokernel (f - g) :=
  HasColimit.mk
    { cocone := cokernelCoforkOfCofork (coequalizer.cofork f g)
      isColimit := isColimitCokernelCoforkOfCofork (colimit.isColimit (parallelPair f g)) }
#align category_theory.preadditive.has_cokernel_of_has_coequalizer CategoryTheory.Preadditive.hasCokernel_of_hasCoequalizer

end

/-- If a preadditive category has all kernels, then it also has all equalizers. -/
theorem hasEqualizers_of_hasKernels [HasKernels C] : HasEqualizers C :=
  @hasEqualizers_of_hasLimit_parallelPair _ _ fun {_} {_} f g => hasEqualizer_of_hasKernel f g
#align category_theory.preadditive.has_equalizers_of_has_kernels CategoryTheory.Preadditive.hasEqualizers_of_hasKernels

/-- If a preadditive category has all cokernels, then it also has all coequalizers. -/
theorem hasCoequalizers_of_hasCokernels [HasCokernels C] : HasCoequalizers C :=
  @hasCoequalizers_of_hasColimit_parallelPair _ _ fun {_} {_} f g =>
    hasCoequalizer_of_hasCokernel f g
#align category_theory.preadditive.has_coequalizers_of_has_cokernels CategoryTheory.Preadditive.hasCoequalizers_of_hasCokernels

end Equalizers

end Preadditive

end CategoryTheory


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl

Theory of topological rings.
-/

import topology.algebra.group ring_theory.ideals

open classical set lattice filter topological_space
local attribute [instance] classical.prop_decidable

section topological_ring
universes u v w
variables (α : Type u) [topological_space α]

/-- A topological semiring is a semiring where addition and multiplication are continuous. -/
class topological_semiring [semiring α]
  extends topological_add_monoid α, topological_monoid α : Prop

variables [ring α]

/-- A topological ring is a ring where the ring operations are continuous. -/
class topological_ring extends topological_add_monoid α, topological_monoid α : Prop :=
(continuous_neg : continuous (λa:α, -a))

variables [t : topological_ring α]
instance topological_ring.to_topological_semiring : topological_semiring α := {..t}

instance topological_ring.to_topological_add_group : topological_add_group α := {..t}
end topological_ring

section topological_comm_ring
variables {α : Type*} [topological_space α] [comm_ring α] [topological_ring α]

def ideal.closure (S : ideal α) : ideal α :=
{ carrier := closure S,
  zero := subset_closure S.zero_mem,
  add  := assume x y hx hy,
    mem_closure2 continuous_add' hx hy $ assume a b, S.add_mem,
  smul  := assume c x hx,
    have continuous (λx:α, c * x) := continuous_mul continuous_const continuous_id,
    mem_closure this hx $ assume a, S.mul_mem_left }

@[simp] lemma ideal.coe_closure (S : ideal α) :
  (S.closure : set α) = closure S := rfl

end topological_comm_ring

section topological_ring
variables {α : Type*} [topological_space α] [comm_ring α] [topological_ring α] (N : ideal α)
open ideal.quotient

instance topological_ring_quotient_topology : topological_space N.quotient :=
by dunfold ideal.quotient submodule.quotient; apply_instance

lemma quotient_ring_saturate (s : set α) :
  mk N ⁻¹' (mk N '' s) = (⋃ x : N, (λ y, x.1 + y) '' s) :=
begin
  ext x,
  simp only [mem_preimage_eq, mem_image, mem_Union, ideal.quotient.eq],
  split,
  { exact assume ⟨a, a_in, h⟩, ⟨⟨_, N.neg_mem h⟩, a, a_in, by simp⟩ },
  { exact assume ⟨⟨i, hi⟩, a, ha, eq⟩, ⟨a, ha,
      by rw [← eq, sub_add_eq_sub_sub_swap, sub_self, zero_sub];
      exact N.neg_mem hi⟩ }
end

lemma quotient_ring.is_open_map_coe : is_open_map (mk N) :=
begin
  assume s s_op,
  show is_open (mk N ⁻¹' (mk N '' s)),
  rw quotient_ring_saturate N s,
  exact is_open_Union (assume ⟨n, _⟩, is_open_map_add_left n s s_op)
end

lemma quotient_ring.quotient_map_coe_coe : quotient_map (λ p : α × α, (mk N p.1, mk N p.2)) :=
begin
  apply is_open_map.to_quotient_map,
  { exact is_open_map.prod (quotient_ring.is_open_map_coe N) (quotient_ring.is_open_map_coe N) },
  { apply continuous.prod_mk,
    { exact continuous.comp continuous_fst continuous_quot_mk },
    { exact continuous.comp continuous_snd continuous_quot_mk } },
  { rintro ⟨⟨x⟩, ⟨y⟩⟩,
    exact ⟨(x, y), rfl⟩ }
end

instance topological_ring_quotient : topological_ring N.quotient :=
{ continuous_add :=
    have cont : continuous (mk N ∘ (λ (p : α × α), p.fst + p.snd)) :=
      continuous.comp continuous_add' continuous_quot_mk,
    (quotient_map.continuous_iff (quotient_ring.quotient_map_coe_coe N)).2 cont,
  continuous_neg := continuous_quotient_lift _ (continuous.comp continuous_neg' continuous_quot_mk),
  continuous_mul :=
    have cont : continuous (mk N ∘ (λ (p : α × α), p.fst * p.snd)) :=
      continuous.comp continuous_mul' continuous_quot_mk,
    (quotient_map.continuous_iff (quotient_ring.quotient_map_coe_coe N)).2 cont }

end topological_ring


lemma mul_pow (a b n : mynat) : (a * b) ^ n = a ^ n * b ^ n :=
begin
induction n with h hd,
repeat {rw pow_zero},
rwa mul_one,
repeat {rw pow_succ},
rw hd,
simp,
end


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import data.finset
import topology.metric_space.basic
import formal_ml.finset
import set_theory.cardinal_ordinal

namespace set

def prod_equiv_mul {α β:Type*} (s:set α) (t:set β):
  (s.prod t) ≃ s × t := {
  to_fun := (λ p, (subtype.mk p.val.fst p.property.left, subtype.mk p.val.snd p.property.right) ),
  inv_fun := (λ p, subtype.mk (p.fst.val, p.snd.val) (set.mk_mem_prod p.fst.property
    p.snd.property)) ,
  left_inv :=
  begin
     simp [function.left_inverse],
  end,
  right_inv :=
  begin
    simp [function.right_inverse, function.left_inverse],
  end,
}

lemma mem_of_mem_union_of_not_mem_left {α:Type*} {s:set α} {t:set α} {a:α} (h : a ∉ s)
  (hu : a ∈ s ∪ t) : (a ∈ t) :=
begin
  simp [h] at hu,
  apply hu,
end

noncomputable def disjoint_union_equiv_add {α:Type*} (s:set α) (t:set α) (h:disjoint s t):
  (s ∪ t:set α) ≃ s ⊕ t := {
  to_fun := (λ a, (@dite (a.val ∈ s) (classical.prop_decidable _) (s ⊕ t)
   (λ h,  sum.inl (subtype.mk  a.val  h) ) (λ h, sum.inr (subtype.mk a.val
     (set.mem_of_mem_union_of_not_mem_left h a.property))))),
  inv_fun := (λ a, match a with
  | sum.inl b := subtype.mk b.val (set.mem_union_left t b.property)
  | sum.inr b := subtype.mk b.val (set.mem_union_right s b.property)
  end),
  left_inv :=
  begin
     simp [function.left_inverse],
     intros x h2,
     cases h2,
     simp [h2],
     refl,
     have h3 : x ∉ s := (set.disjoint_right.mp h) h2,
     simp [h3],
     refl,
  end,
  right_inv :=
  begin
    simp [function.right_inverse, function.left_inverse],
    split,
    intros x h2,
    have A1:(disjoint_union_equiv_add._match_1 s t (sum.inl (subtype.mk x h2))).val = x,
    { refl },
    simp [A1,h2], refl,
    intros x h2,
    have A2:(disjoint_union_equiv_add._match_1 s t (sum.inr (subtype.mk x h2))).val = x := rfl,
    have A3:(disjoint_union_equiv_add._match_1 s t (sum.inr (subtype.mk x h2))).val ∉ s,
    { rw A2, apply (set.disjoint_right.mp h) h2},
    simp [A2, A3, h2],
    refl,
  end,
}

def card {α:Type*} (s:set α):cardinal :=
  cardinal.mk s

lemma card_def {α:Type*} (s:set α):s.card = cardinal.mk s := rfl

lemma card_prod {α β:Type*} (s:set α) (t:set β):
 (s.prod t).card = s.card * t.card :=
begin
  unfold set.card,
  rw cardinal.mul_def,
  rw cardinal.eq,
  apply nonempty.intro,
  apply set.prod_equiv_mul,
end

lemma card_union {α:Type*} (s:set α) (t:set α) (h:disjoint s t):
  ((s ∪ t).card) = (s.card + t.card) :=
begin
  have A1:(s.card + t.card) = (cardinal.mk (s ⊕ t)),
  { unfold set.card,  refl },
  rw A1,
  unfold set.card,
  rw cardinal.eq,
  apply nonempty.intro,
  apply disjoint_union_equiv_add s t h,
end

@[simp]
lemma card_empty (α:Type*):
  (∅:set α).card = 0 :=
begin
  unfold set.card,
  simp,
end

@[simp]
lemma card_singleton' (α:Type*) {a:α}:
  ({a}:set α).card = 1 :=
begin
  unfold set.card,
  simp,
end

lemma card_insert' {α:Type*} (s:set α) (a:α) (h:a∉ s):
  (insert a s).card = s.card + 1 :=
begin
  rw set.insert_eq,
  rw card_union,
  rw card_singleton',
  rw add_comm,
  rw set.disjoint_left,
  intros b h2,
  simp at h2,
  subst b,
  apply h,
end

lemma disjoint_inter_diff {α : Type*} {s t : set α} : disjoint (t ∩ s) (t \ s) :=
begin
  rw set.disjoint_left, simp, intros a A2 A3 A4, apply A3
end

lemma card_add_card_diff {α : Type*} (s t : set α) : s.card + (t \ s).card = (s ∪ t).card :=
begin
  rw ← card_union,
  rw set.union_diff_self,
  apply set.disjoint_diff
end

lemma card_diff_add_card_inter {α : Type*} (s t : set α) : t.card = (t ∩ s).card + (t \ s).card :=
begin
  rw ← card_union,
  rw set.inter_union_diff,
  apply set.disjoint_inter_diff,
end

lemma card_union_inter {α : Type*} {s t : set α} :
  s.card + t.card = (s ∪ t).card + (s ∩ t).card :=
begin
  have A1 := card_diff_add_card_inter s t,
  rw add_comm at A1,
  rw A1,
  rw ← add_assoc,
  have A2 := card_add_card_diff s t,
  rw A2,
  rw set.inter_comm,
end

lemma card_subset {α:Type*} {s t : set α}  (h : s ⊆ t) : s.card ≤ t.card :=
begin
  rw card_diff_add_card_inter s t,
  rw set.inter_eq_self_of_subset_right h,
  have A2 : s.card + 0 ≤ s.card + (t \ s).card,
  { apply add_le_add, apply le_refl _, apply zero_le },
  rw add_zero at A2,
  apply A2
end

end set

lemma nat.Iio_zero_eq_empty:set.Iio 0 = ∅ :=
begin
  ext; split; simp
end

lemma nat.Iio_succ_eq_insert (n : ℕ) : set.Iio (n.succ) = insert n (set.Iio n) :=
begin
  ext; split; simp,
  { intros A1,
    have A2:= nat.le_of_lt_succ A1,
    rw le_iff_lt_or_eq at A2,
    cases A2,
    { apply set.mem_insert_of_mem, apply A2 },
    cases A2,
    { apply set.mem_insert } },
  { intros A1,
    have A3 : n < nat.succ n :=  nat.lt_succ_of_le (le_refl _),
    cases A1,
    subst x, apply A3, apply lt_trans A1 A3, },
end

lemma nat.plus_one_eq_succ {n:ℕ} : (n:cardinal) + 1 = (n:cardinal).succ :=
begin
  apply le_antisymm,
  apply cardinal.add_one_le_succ,
  rw cardinal.succ_le,
  have A1:(1:cardinal) = ((1:ℕ):cardinal),
  {  simp  },
  rw A1,
  rw ← nat.cast_add,
  rw cardinal.nat_cast_lt,
  simp,
end

lemma nat.card_Iio (n : ℕ) : (set.Iio n).card = n :=
begin
  induction n,
  { rw nat.Iio_zero_eq_empty, simp },
  { rw nat.Iio_succ_eq_insert,
    have A1 : n_n ∉ (set.Iio n_n),
    { simp },
    rw set.card_insert' (set.Iio n_n) n_n A1, rw n_ih, simp,--rw ← nat.cast_succ,
    rw nat.plus_one_eq_succ },
end

lemma cardinal_eq_of_bijective {α β:Type*} (f:α → β) (h:function.bijective f) : (cardinal.mk α = cardinal.mk β) :=
begin
  haveI E := equiv.of_bijective f h,
  rw cardinal.eq,
  apply nonempty.intro E,
end

lemma card_eq_of_bijective {α β : Type*} {s : set α} {t : set β} (f : s → t) (h : function.bijective f) :
  (s.card = t.card) :=
begin
  unfold set.card,
  apply cardinal_eq_of_bijective f h
end

lemma map_card {α β:Type*} {f:α → β} {s:set α} (h_inj : function.injective f):
   (f '' s).card = s.card :=
begin
  let g:s → (f '' s) := (λ (x:s), subtype.mk (f x.val) begin
    simp,
    apply exists.intro (x.val),
    apply and.intro (x.property),
    refl
  end),
  begin
    symmetry,
    apply card_eq_of_bijective g,
    { simp [g, function.bijective],
      split,
      intros a₁ a₂ A1A,
      simp at A1A,
      apply subtype.eq,
      apply h_inj,
      -- rw A0,
      apply A1A,
      intros x, have A1B := x.property,
      simp at A1B,
      cases A1B with y A1B, existsi  (subtype.mk y (A1B.left)),
      simp, apply subtype.eq, apply A1B.right, },
  end
end

@[simp]
lemma not_lt_refl (c:cardinal) :¬ (c < c)  :=
begin
  simp,
end

lemma equiv_inj {α β : Type*} {s : set α} {t : set β} : s.card = t.card → 0 < t.card →
  ∃ f:α → β, f '' s = t :=
begin
  intros A1 A2,
  have A3 : t ≠ ∅,
  { intro contra, rw contra at A2, simp at A2, apply A2 },
  unfold set.card at A1,
  rw cardinal.eq at A1,
  have A4 := classical.choice A1,
  rw set.ne_empty_iff_nonempty at A3,
  rw set.nonempty_def at A3,
  cases A3 with b A3,
  existsi (λ (a:α), @dite (a ∈ s) (classical.prop_decidable _) β
   (λ h, A4.to_fun (subtype.mk a h))
   (λ h, b) ),
  simp,
  ext,split; intros B1,
  simp at B1,
  cases B1 with a B1,
  cases B1 with B1 B2,
  subst x,
  rw dif_pos,
  simp,
  apply B1,
  simp,
  have B3 := (A4.inv_fun (subtype.mk x B1)).property,
  apply exists.intro (A4.inv_fun (subtype.mk x B1)).val,
  apply and.intro B3,
  rw dif_pos,
  simp,
  apply B3,
end

inductive set.finite' {α:Type*} : set α → Prop
| empty : set.finite' ∅
| insert (a:α) (s:set α) (hs:set.finite' s) : set.finite' (insert a s)

lemma finite'_of_eq_finset {α:Type*} (f : finset α) : ∀ (s:set α), (s = ↑f) → (s.finite') :=
begin
  haveI := classical.decidable_eq α,
  apply finset.induction_on f,
  { intros s A1, simp at A1, subst s,
    apply set.finite'.empty },
  { intros a s B1 B2 t B4, simp at B4,
    subst t,
    apply set.finite'.insert a (↑s), apply B2, refl },
end

lemma finite'_of_finite {α:Type*} (s : set α) (h:s.finite) : (s.finite') :=
begin
  haveI := classical.decidable_eq α,
  unfold set.finite at h,
  haveI A1 := classical.choice h,
  have A2:s = ↑(finset.image subtype.val A1.elems),
  { ext; split; intros A2A,
    { simp, apply exists.intro A2A, apply A1.complete },
    { simp at A2A, cases A2A with A2A A2B, apply A2A } },
  apply finite'_of_eq_finset _ s A2
end

def finset.attach' {α : Type*} [decidable_eq α] (s : finset α) (t : set α) (h : ↑s ⊆ t) :
  finset t := (finset.image (λ (x : {x //  x∈ s}), subtype.mk (x.val)
    (set.subset_def.mp h (x.val) x.property)) s.attach)

noncomputable def fintype_of_insert {α: Type*} [decidable_eq α] (s : set α) (h : s.finite)
  (a : α) : fintype (insert a s:set α) := {
  elems := (insert a h.to_finset).attach' (insert a s) begin
    rw set.subset_def,
    intros x A1,
    simp at A1,
    simp,
    apply A1,
  end,
  complete :=
  begin
    intros x,
    simp [finset.attach', finset.attach],
    existsi x.val,
    split,
    apply subtype.eq,
    refl,
    have A1 := x.property,
    simp at A1,
    simp [A1],
  end
}

lemma finite_of_finite' {α:Type*} (s : set α) (h:s.finite') : (s.finite) :=
begin
  haveI := classical.decidable_eq α,
  induction h,
  { simp },
  { unfold set.finite, apply nonempty.intro,
    apply fintype_of_insert h_s h_ih h_a },
end

lemma nat_cardinal_of_finite' {α : Type*} (s : set α) (h : s.finite') : ∃ (n:ℕ), s.card = n :=
begin
  induction h,
  existsi 0,
  simp,
  cases h_ih with n h_ih,
  cases (classical.em (h_a ∈ h_s)) with A1 A1,
  apply exists.intro n,
  rw set.insert_eq_of_mem A1,
  apply h_ih,
  apply exists.intro n.succ,
  rw set.card_insert' _ _ A1,
  rw h_ih,
  rw nat.plus_one_eq_succ,
  simp,
end

lemma nat_cardinal_of_finite {α : Type*} (s : set α) (h : s.finite) : ∃ (n:ℕ), s.card = n :=
begin
  apply nat_cardinal_of_finite' s (finite'_of_finite s h)
end

lemma empty_iff_card_eq_zero {α : Type*} (s : set α) : (s.card = 0) ↔ s = ∅ :=
begin
  split; intros A1,
  { have A2 : (∅:set α).card = 0,
    { simp },
    rw ← A1 at A2,
    unfold set.card at A2,

    rw cardinal.eq at A2,
    have A3 := classical.choice A2,
    rw ← set.subset_empty_iff,
    rw set.subset_def,
    intros x A4,
    have A5 := (A3.inv_fun (subtype.mk x A4)).property,
    exfalso,
    simp at A5,
    apply A5,
  },
  { subst s, simp }
end

def set.special_image {α β : Type*} (s : set α) (f : Π (a:α) , (a ∈ s) → β) : set β :=
  { b | ∃ (a:α) (h:a ∈ s), b = f a h }

lemma set.mem_special_image {α β : Type*} (s : set α) (f : Π (a : α), (a ∈ s) → β) (a : α) (h : a ∈ s) :
  f a h ∈ (s.special_image f) :=
begin
  unfold set.special_image,
  rw set.mem_set_of_eq,
  existsi [a, h],
  refl,
end

lemma set.special_image_card {α β : Type*} (s : set α) (f : Π (a:α) , (a ∈ s) → β)
  (h_inj : ∀ (a₁  a₂ : α) (h1 : a₁ ∈ s) (h2 : a₂ ∈ s), (f a₁ h1 = f a₂ h2) → (a₁ = a₂)) :
  (s.special_image f).card = s.card :=
begin
  unfold set.special_image,
  let g : s → (s.special_image f) := (λ (a:s), subtype.mk (f a.val a.property) (set.mem_special_image s f a.val a.property)),
  begin
    symmetry,
    apply card_eq_of_bijective g,
    split,
    { intros a₁ a₂ A1,
      simp [g] at A1,
      apply subtype.eq,
      apply h_inj a₁ a₂ a₁.property a₂.property A1 },
    { intros b,
      have B1 := b.property,
      simp [set.special_image] at B1,
      cases B1 with a B1,
      cases B1 with h B1,
      existsi (subtype.mk a h),
      apply subtype.eq,
      simp [g, set.special_image],
      rw B1,
    }
  end
end

def set.attach {α : Type*} (s : set α) : (set s) :=
  s.special_image subtype.mk

lemma set.attach_complete {α : Type*} (s : set α)  (a : s) :
  a ∈ (set.attach s) :=
begin
  simp [set.attach, set.special_image],
  existsi [a.val, a.property],
  apply subtype.eq,
  simp,
end

lemma subtype.val_eq_val {α :Type*} {P : α → Prop} {a b : subtype P} (h : a = b) : a.val = b.val :=
begin
  rw h,
end

lemma set.attach_card {α : Type*} (s : set α) : (s.attach.card = s.card) :=
begin
  unfold set.attach,
  apply set.special_image_card,
  intros a₁ a₂ h1 h2 A1,
  apply subtype.val_eq_val A1,
end

lemma le_cardinal {α : Type*} {s:set α} {c:cardinal} :
  (c ≤ s.card) ↔ (∃ t:set α, t ⊆ s ∧ t.card = c) :=
begin
  rw set.card_def s,
  rw cardinal.le_mk_iff_exists_set,
  --have A2:(∃ (p : set ↥s), cardinal.mk ↥p = c) ↔
  split; intros A1; cases A1 with t A1,
  apply exists.intro ((λ (x:s), (x:α)) '' t),
  split,
  rw set.subset_def,
  intros x B1,
  simp at B1,
  cases B1 with B1 B2,
  apply B1,
  rw map_card,
  simp [set.card, A1],
  intros i j C1,
  apply subtype.eq,
  simp at C1,
  apply C1,
  apply exists.intro (t.special_image (λ (a:α) (h:a ∈ t),
    @subtype.mk α (λ a, a ∈ s) a ((@set.subset_def α t s).mp A1.left a h))),
  cases A1 with A1 A2,
  subst c,
  rw ← set.card_def,
  rw set.special_image_card,
  intros a₁ a₂ h1 h2 h3,
  have h4 := subtype.val_eq_val h3,
  simp at h4,
  apply h4,
end

lemma not_is_some {α : Type*} {a : option α} : (¬(option.is_some a)) ↔ (a = none) :=
begin
  cases a;simp [option.is_some],
end

lemma card_finite_add_one {α β : Type*} {s : set α} {t : set β} (h_finite : s.finite)
(h_card : t.card = s.card + 1) :
  (∃ (a : β) (s' : set β), t = insert a s' ∧ (a ∉ s') ∧ s'.card = s.card) :=
begin
  have A1 : cardinal.mk (option s) = t.card,
  { rw h_card, rw cardinal.mk_option, refl },
  unfold set.card at A1,
  rw cardinal.eq at A1,
  have A2 := classical.choice A1,
  existsi [(A2.to_fun option.none).val, ((λ (a:s), (A2.to_fun (option.some a)).val) '' (s.attach))],
  split,
  ext, split; intros A3,
  simp,
  have A4 := A2.right_inv (subtype.mk x A3),
  cases (classical.em (option.is_some (A2.inv_fun (subtype.mk x A3)))) with A5 A5,
  { right, existsi [(option.get A5).val, (option.get A5).property], split, apply set.attach_complete,
    simp },
  { left, rw not_is_some at A5, rw A5 at A4, have A6 := subtype.val_eq_val A4, simp at A6, rw A6 },
  simp at A3,
  cases A3,
  { subst x, apply (A2 none).property },
  { cases A3 with y A3, cases A3 with A3 A4, cases A4 with A4 A5,
    subst x, apply (A2 (some (subtype.mk y A3))).property, },
  simp,
  split,
  intros x D1 D2,
  cases D2 with D2 D3,
  have D4 := A2.injective,
  have D5 := subtype.eq D3,
  have D6 := A2.injective (subtype.eq D3),
  simp at D6,
  apply D6,
  rw map_card,
  apply set.attach_card,
  intros a₁ a₂ E1,
  simp at E1,
  have E2 := A2.injective (subtype.eq E1),
  simp at E2,
  apply E2,
end

lemma finite'_of_nat_cardinal {α : Type*} (n : ℕ) : ∀ (s : set α), (s.card = n) →
  (s.finite') :=
begin
  induction n,
  { intros s A1,
    simp at A1, rw empty_iff_card_eq_zero at A1, subst s, apply finite'.empty },
  { intros t B1, simp at B1, rw ← nat.plus_one_eq_succ at B1,
    have B2 : ↑n_n ≤ t.card,
    { rw B1,
      have B2A : (n_n:cardinal) + 0 ≤ (n_n:cardinal) + 1,
      { apply add_le_add (le_refl _), simp },
      rw add_zero at B2A,
      apply B2A },
    rw le_cardinal at B2,
    cases B2 with u B2,
    cases B2 with B2 B3,
    have B4 := n_ih u B3,
    have B5 := finite_of_finite' u B4,
    rw  ← B3 at B1,
    have B6 := card_finite_add_one B5 B1,

    --have B6 := card_finite_add_one B2 B5 B1,
    cases B6 with a B6,
    cases B6 with s' B6,
    cases B6 with B6 B7,
    cases B7 with B7 B8,
    rw B3 at B8,
    have B9 := n_ih s' B8,
    subst t,
    apply finite'.insert a s' B9 },
end

lemma finite_of_nat_cardinal {α : Type*} (n : ℕ) (s : set α) (h : s.card = n) :
  (s.finite) :=
begin
  have A1 := finite'_of_nat_cardinal n s h,
  apply finite_of_finite' s A1,
end

lemma set.finite_insert {α:Type*} {s:set α} (a:α) (h:s.finite) : (insert a s).finite :=
begin
  haveI D : decidable_eq α := classical.decidable_eq α,
  cases (classical.em (a ∈ s)) with A1 A1,
  { have A2 : insert a s = s := set.insert_eq_of_mem A1, rw A2,
    apply h },
  { haveI Fs : fintype s := classical.choice h,
    haveI Fas : fintype (insert a s:set α) := set.fintype_insert' s A1,
    apply nonempty.intro Fas },
end

/-
lemma card_add_one {α : Type*} {β : Type*} {s : set α} {t : set β}
(h : t.card = s.card + 1) :
  (∃ (b : β) (f : s → (t \ {b} : set β)), function.bijective f) :=
begin
  sorry
end
-/


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Anne Baanen
-/
import analysis.special_functions.pow
import algebraic_number_theory.class_number.euclidean_absolute_value
import algebraic_number_theory.class_number.finset
import combinatorics.pigeonhole
import field_theory.finite.basic

/-!
# Admissible absolute values

This file defines a structure `admissible_absolute_value` which we use to show the class number
of the ring of integers of a global field is finite.
-/

section admissible

variables {R : Type*} [euclidean_domain R]

/-- An `admissible_absolute_value R` is a Euclidean absolute value `R → ℤ`,
such that a large enough set of elements in `R^n` will contain a pair of elements
whose remainders are pointwise close together. -/
structure admissible_absolute_value (R : Type*) [euclidean_domain R]
  extends euclidean_absolute_value R ℤ :=
(card : ℝ → ℕ)
(exists_partition' : ∀ (n : ℕ) {ε : ℝ} (hε : 0 < ε) (b : R) (hb : b ≠ 0) (A : fin n → R),
                     ∃ (t : fin n → fin (card ε)),
                     ∀ i₀ i₁, t i₀ = t i₁ → (to_fun (A i₁ % b - A i₀ % b) : ℝ) < to_fun b • ε)

variables (abs : admissible_absolute_value R)

namespace admissible_absolute_value

instance : has_coe_to_fun (admissible_absolute_value R) :=
{ F := _,
  coe := λ abs, abs.to_fun }

instance : has_coe (admissible_absolute_value R) (euclidean_absolute_value R ℤ) :=
⟨λ abs, abs.to_euclidean_absolute_value⟩

instance : has_coe (admissible_absolute_value R) (absolute_value R ℤ) :=
⟨λ abs, abs.to_euclidean_absolute_value.to_absolute_value⟩

lemma nonneg (x : R) : 0 ≤ abs x := abs.to_euclidean_absolute_value.nonneg x

@[simp]
lemma eq_zero_iff {x : R} : abs x = 0 ↔ x = 0 :=
abs.to_euclidean_absolute_value.map_eq_zero_iff' x

@[simp]
lemma map_zero : abs 0 = 0 :=
abs.to_euclidean_absolute_value.map_zero

lemma map_ne_zero {x : R} : abs x ≠ 0 ↔ x ≠ 0 :=
abs.to_euclidean_absolute_value.map_ne_zero

lemma pos {x : R} (hx : x ≠ 0) : 0 < abs x :=
abs.to_euclidean_absolute_value.pos hx

@[simp]
lemma map_mul (x y : R) : abs (x * y) = abs x * abs y :=
abs.to_euclidean_absolute_value.map_mul x y

lemma le_add (x y : R) : abs (x + y) ≤ abs x + abs y :=
abs.to_euclidean_absolute_value.le_add x y

@[simp]
lemma map_lt_map_iff {x y : R} : abs x < abs y ↔ euclidean_domain.r x y :=
abs.to_euclidean_absolute_value.map_lt_map_iff

lemma mod_lt (a : R) {b : R} (hb : b ≠ 0) :
  abs (a % b) < abs b :=
abs.to_euclidean_absolute_value.sub_mod_lt a hb

@[simp]
lemma map_sub_eq_zero_iff (a b : R) :
  abs (a - b) = 0 ↔ a = b :=
abs.to_euclidean_absolute_value.map_sub_eq_zero_iff a b

/-- We can partition a finite family into `card ε` sets, such that the remainders
in each set are close together. -/
lemma exists_partition (n : ℕ) {ε : ℝ} (hε : 0 < ε) {b : R} (hb : b ≠ 0) (A : fin n → R) :
  ∃ (t : fin n → fin (abs.card ε)),
  ∀ i₀ i₁, t i₀ = t i₁ → (abs (A i₁ % b - A i₀ % b) : ℝ) < abs b • ε :=
abs.exists_partition' n hε b hb A

/-- Any large enough family of vectors in `R^n` has a pair of elements
whose remainders are close together, pointwise. -/
lemma exists_approx (n : ℕ) :
  ∀ {ε : ℝ} (hε : 0 < ε) {b : R} (hb : b ≠ 0) (A : fin (abs.card ε ^ n).succ → (fin n → R)),
  ∃ (i₀ i₁), (i₀ ≠ i₁) ∧ ∀ k, (abs (A i₁ k % b - A i₀ k % b) : ℝ) < abs b • ε :=
begin
  haveI := classical.dec_eq R,
  induction n with n ih,
  { intros ε hε b hb A,
    refine ⟨0, 1, _, _⟩,
    { simp },
    rintros ⟨i, ⟨⟩⟩ },
  intros ε hε b hb A,
  by_cases hA : ∃ i₀ i₁, i₀ ≠ i₁ ∧ A i₀ = A i₁,
  { obtain ⟨i₀, i₁, h, eq⟩ := hA,
    refine ⟨i₀, i₁, h, λ k, _⟩,
    rw [eq, sub_self, abs.map_zero, algebra.smul_def, int.cast_zero, ring_hom.eq_int_cast],
    exact mul_pos (int.cast_pos.mpr (abs.pos hb)) hε },
  have A_inj : function.injective A,
  { simp only [not_exists, not_and, ne.def, not_imp_not] at hA,
    exact λ x y h, hA x y h },
  set M := abs.card ε with hM,
  -- By the "nicer" pigeonhole principle, we can find a collection `s`
  -- of more than `M^n` elements where the first components lie close together:
  obtain ⟨s, s_inj, hs⟩ : ∃ s : fin (M ^ n).succ → fin (M ^ n.succ).succ,
    function.injective s ∧
    ∀ i₀ i₁, (abs (A (s i₁) 0 % b - A (s i₀) 0 % b) : ℝ) < abs b • ε,
  { -- We can partition the `A`s into `m` subsets where
    -- the first components lie close together:
    obtain ⟨t, ht⟩ : ∃ (t : fin (M ^ n.succ).succ → fin M),
      ∀ i₀ i₁, t i₀ = t i₁ → (abs (A i₁ 0 % b - A i₀ 0 % b) : ℝ) < abs b • ε :=
      abs.exists_partition _ hε hb (λ x, A x 0),
    -- Since the `M` subsets contain more than `M * M^n` elements total,
    -- there must be a subset that contains more than `M^n` elements.
    obtain ⟨s, hs⟩ := @fintype.exists_lt_card_fiber_of_mul_lt_card _ _ _ _ _ t (M ^ n)
      (by simpa only [fintype.card_fin, pow_succ] using nat.lt_succ_self (M ^ n.succ) ),
    refine ⟨finset.to_vec _ hs, finset.to_vec_injective _ hs, λ i₀ i₁, ht _ _ _⟩,
    have := finset.to_vec_mem (finset.univ.filter (λ x, t x = s)) hs,
    obtain ⟨_, h₀⟩ := finset.mem_filter.mp (this i₀),
    obtain ⟨_, h₁⟩ := finset.mem_filter.mp (this i₁),
    exact h₀.trans h₁.symm },
  -- Since `s` is large enough, there are two elements of `A ∘ s`
  -- where the second components lie close together.
  obtain ⟨k₀, k₁, hk, h⟩ := ih hε hb (λ x, fin.tail (A (s x))),
  refine ⟨s k₀, s k₁, λ h, hk (s_inj h), λ i, fin.cases _ (λ i, _) i⟩,
  { exact hs k₀ k₁ },
  { exact h i },
end

end admissible_absolute_value

end admissible

namespace int

/-- We can partition a finite family of integers between `0` and `b` into `partition_card ε` sets,
such that the elements of each set are within `b * ε` of each other.  -/
noncomputable def partition_card (ε : ℝ) : ℕ := nat_ceil (1 / ε)

lemma le_partition_card (ε : ℝ) : 1 / ε ≤ partition_card ε :=
le_nat_ceil _

/-- We can partition a finite family into `partition_card ε` sets, such that the remainders
in each set are close together. -/
lemma exists_partition (n : ℕ) {ε : ℝ} (hε : 0 < ε) {b : ℤ} (hb : b ≠ 0) (A : fin n → ℤ) :
  ∃ (t : fin n → fin (partition_card ε)),
  ∀ i₀ i₁, t i₀ = t i₁ → ↑(abs (A i₁ % b - A i₀ % b)) < abs b • ε :=
begin
  have hb' : (0 : ℝ) < ↑(abs b) := int.cast_pos.mpr (abs_pos.mpr hb),
  have hbε : 0 < abs b • ε,
  { rw algebra.smul_def,
    exact mul_pos hb' hε },
  have hfloor : ∀ i, 0 ≤ floor ((A i % b : ℤ) / (abs b • ε) : ℝ),
  { intro i,
    exact floor_nonneg.mpr (div_nonneg (cast_nonneg.mpr (mod_nonneg _ hb)) hbε.le) },
  refine ⟨λ i, ⟨nat_abs (floor ((A i % b : ℤ) / (abs b • ε) : ℝ)), _⟩, _⟩,
  { rw [← coe_nat_lt, nat_abs_of_nonneg (hfloor i), floor_lt],
    apply lt_of_lt_of_le _ (le_partition_card _),
    rw [algebra.smul_def, ring_hom.eq_int_cast, ← div_div_eq_div_mul, div_lt_div_right hε,
        div_lt_iff hb', one_mul, cast_lt],
    exact mod_lt _ hb },
  intros i₀ i₁ hi,
  have hi : (⌊↑(A i₀ % b) / abs b • ε⌋.nat_abs : ℤ) = ⌊↑(A i₁ % b) / abs b • ε⌋.nat_abs :=
    congr_arg (coe : ℕ → ℤ) (subtype.mk_eq_mk.mp hi),
  rw [nat_abs_of_nonneg (hfloor i₀), nat_abs_of_nonneg (hfloor i₁)] at hi,
  have hi := abs_sub_lt_one_of_floor_eq_floor hi,
  rw [abs_sub, ← sub_div, abs_div, abs_of_nonneg hbε.le, div_lt_iff hbε, one_mul] at hi,
  rwa [int.cast_abs, int.cast_sub]
end

/-- `abs : ℤ → ℤ` is an admissible absolute value -/
noncomputable def admissible_abs : admissible_absolute_value ℤ :=
{ card := partition_card,
  exists_partition' := λ n ε hε b hb, exists_partition n hε hb,
  .. euclidean_absolute_value.abs }

noncomputable instance : inhabited (admissible_absolute_value ℤ) := ⟨admissible_abs⟩

end int

namespace polynomial

open absolute_value real

variables {K : Type*} [field K] {c : ℤ} (hc : 1 < c)

section

variables (K)

lemma one_lt_card [fintype K] : 1 < fintype.card K :=
begin
  obtain ⟨p, n, hp, hpn⟩ : ∃ p n, _ ∧ fintype.card K = _ := finite_field.card',
  rw hpn,
  exact pow_lt_pow hp.one_lt n.2
end

/-- `card_pow_degree` is the absolute value on `𝔽_q[t]` sending `f` to `q ^ deg f`. -/
noncomputable def card_pow_degree [fintype K] [decidable_eq K] :
  absolute_value (polynomial K) ℤ :=
pow_degree (nat.cast_lt.mpr (one_lt_card K))

end

lemma card_pow_degree_apply [fintype K] [decidable_eq K] {f : polynomial K} (hf : f ≠ 0) :
  card_pow_degree K f = fintype.card K ^ nat_degree f :=
by { simp only [card_pow_degree, pow_degree, int.nat_cast_eq_coe_nat], exact if_neg hf }

lemma lt_nat_degree_of_lt_degree {f : polynomial K} {n : ℕ} (h : (n : with_bot ℕ) < degree f) :
  n < nat_degree f :=
with_bot.coe_lt_coe.mp (lt_of_lt_of_le h degree_le_nat_degree)

lemma nat_degree_lt_of_degree_lt {f : polynomial K} (hf : f ≠ 0) {n : ℕ} (h : degree f < n) :
  nat_degree f < n :=
by rwa [← with_bot.coe_lt_coe, ← degree_eq_nat_degree hf]

variables [fintype K]

/-- If `A` is a family of enough elements, there is a pair of equal elements in `A`. -/
lemma exists_eq {d : ℕ} {m : ℕ} (hm : fintype.card K ^ d ≤ m) (b : polynomial K)
  (hb : nat_degree b ≤ d) (A : fin m.succ → polynomial K) (hA : ∀ i, degree (A i) < degree b) :
  ∃ i₀ i₁, i₀ ≠ i₁ ∧ A i₁ = A i₀ :=
begin
  -- Since there are > q^d elements of A, and only q^d choices for the highest `d` coefficients,
  -- there must be two elements of A with the same coefficients at
  -- `0`, ... `degree b - 1` ≤ `d - 1`.
  -- In other words, the following map is not injective:
  set f : fin m.succ → (fin d → K) := λ i j, (A i).coeff j,
  have : fintype.card (fin d → K) < fintype.card (fin m.succ),
  { simpa using lt_of_le_of_lt hm (nat.lt_succ_self m) },
  -- Therefore, the differences have all coefficients higher than `deg b - d` equal.
  obtain ⟨i₀, i₁, i_ne, i_eq⟩ := fintype.exists_ne_map_eq_of_card_lt f this,
  use [i₀, i₁, i_ne],
  ext j,
  -- The coefficients higher than `deg b` are the same because they are equal to 0.
  by_cases hbj : degree b ≤ j,
  { rw [coeff_eq_zero_of_degree_lt (lt_of_lt_of_le (hA _) hbj),
        coeff_eq_zero_of_degree_lt (lt_of_lt_of_le (hA _) hbj)] },
  -- So we only need to look for the coefficients between `0` and `deg b`.
  rw not_le at hbj,
  apply congr_fun i_eq.symm ⟨j, _⟩,
  exact lt_of_lt_of_le (lt_nat_degree_of_lt_degree hbj) hb
end

/-- If `A` is a family of enough elements, there is a pair of elements in `A`
(not necessarily distinct), such that their difference has small degree. -/
lemma exists_approx_aux {d : ℕ} {m : ℕ} (hm : fintype.card K ^ d ≤ m) (b : polynomial K)
  (A : fin m.succ → polynomial K)
  (hA : ∀ i, degree (A i) < degree b):
  ∃ i₀ i₁, i₀ ≠ i₁ ∧ degree (A i₁ - A i₀) < ↑(nat_degree b - d) :=
begin
  have hb : b ≠ 0,
  { rintro rfl,
    specialize hA 0,
    rw degree_zero at hA,
    exact not_lt_of_le bot_le hA },
  -- Since there are > q^d elements of A, and only q^d choices for the highest `d` coefficients,
  -- there must be two elements of A with the same coefficients at
  -- `degree b - 1`, ... `degree b - d`.
  -- In other words, the following map is not injective:
  set f : fin m.succ → (fin d → K) := λ i j, (A i).coeff (nat_degree b - j.succ),
  have : fintype.card (fin d → K) < fintype.card (fin m.succ),
  { simpa using lt_of_le_of_lt hm (nat.lt_succ_self m) },
  -- Therefore, the differences have all coefficients higher than `deg b - d` equal.
  obtain ⟨i₀, i₁, i_ne, i_eq⟩ := fintype.exists_ne_map_eq_of_card_lt f this,
  use [i₀, i₁, i_ne],
  refine (degree_lt_iff_coeff_zero _ _).mpr (λ j hj, _),
  -- The coefficients higher than `deg b` are the same because they are equal to 0.
  by_cases hbj : degree b ≤ j,
  { refine coeff_eq_zero_of_degree_lt (lt_of_lt_of_le _ hbj),
    exact lt_of_le_of_lt (degree_sub_le _ _) (max_lt (hA _) (hA _)) },
  -- So we only need to look for the coefficients between `deg b - d` and `deg b`.
  rw [coeff_sub, sub_eq_zero],
  rw [not_le, degree_eq_nat_degree hb, with_bot.coe_lt_coe] at hbj,
  have hj : nat_degree b - j.succ < d,
  { by_cases hd : nat_degree b < d,
    { exact lt_of_le_of_lt (nat.sub_le_self _ _) hd },
    { rw not_lt at hd,
      have := lt_of_le_of_lt hj (nat.lt_succ_self j),
      rwa [nat.sub_lt_iff hd hbj] at this } },
  have : j = b.nat_degree - (nat_degree b - j.succ).succ,
  { rw [← nat.succ_sub hbj, nat.succ_sub_succ, nat.sub_sub_self hbj.le] },
  convert congr_fun i_eq.symm ⟨nat_degree b - j.succ, hj⟩
end

/-- If `A` is a family of enough elements, there is a pair of elements in `A`
(not necessarily distinct), such that their difference has small degree. -/
lemma exists_approx [decidable_eq K] {b : polynomial K} (hb : b ≠ 0) {ε : ℝ} (hε : 0 < ε)
  (A : fin (fintype.card K ^ (nat_ceil (- log ε / log (fintype.card K)))).succ → polynomial K) :
  ∃ i₀ i₁, i₀ ≠ i₁ ∧ (card_pow_degree K (A i₁ % b - A i₀ % b) : ℝ) < card_pow_degree K b • ε :=
begin
  have hbε : 0 < card_pow_degree K b • ε,
  { rw [algebra.smul_def, ring_hom.eq_int_cast],
    exact mul_pos (int.cast_pos.mpr (absolute_value.pos _ hb)) hε },
  by_cases le_b : b.nat_degree ≤ nat_ceil (-log ε / log ↑(fintype.card K)),
  { obtain ⟨i₀, i₁, i_ne, mod_eq⟩ := exists_eq (le_refl _) b le_b (λ i, A i % b)
      (λ i, euclidean_domain.mod_lt (A i) hb),
    refine ⟨i₀, i₁, i_ne, _⟩,
    simp only at mod_eq,
    rwa [mod_eq, sub_self, absolute_value.map_zero, int.cast_zero] },
  rw not_le at le_b,
  obtain ⟨i₀, i₁, i_ne, deg_lt⟩ := exists_approx_aux (le_refl _) b (λ i, A i % b)
    (λ i, euclidean_domain.mod_lt (A i) hb),
  use [i₀, i₁, i_ne],
  by_cases h : A i₁ % b = A i₀ % b,
  { rwa [h, sub_self, absolute_value.map_zero, int.cast_zero] },
  have h' : A i₁ % b - A i₀ % b ≠ 0 := mt sub_eq_zero.mp h,
  rw [card_pow_degree_apply h', int.cast_pow, int.cast_coe_nat, card_pow_degree_apply hb,
      algebra.smul_def, ring_hom.eq_int_cast, int.cast_pow, int.cast_coe_nat],
  have deg_lt' : (nat_degree (A i₁ % b - A i₀ % b) : ℝ) <
    b.nat_degree + log ε / log (fintype.card K),
  { refine lt_of_lt_of_le (nat.cast_lt.mpr (nat_degree_lt_of_degree_lt h' deg_lt)) _,
    rw [← sub_neg_eq_add, neg_div],
    refine le_trans _ (sub_le_sub_left (le_nat_ceil _) (b.nat_degree : ℝ)),
    rw ← neg_div,
    exact le_of_eq (nat.cast_sub le_b.le) },
  rw [← rpow_nat_cast, ← rpow_nat_cast],
  refine lt_of_lt_of_le (rpow_lt_rpow_of_exponent_lt _ deg_lt') _,
  { simpa using one_lt_card K },
  conv_rhs { rw ← exp_log hε },
  have hK' : (0 : ℝ) < fintype.card K,
  { rw [← @nat.cast_zero ℝ, nat.cast_lt, fintype.card_pos_iff],
    exact ⟨0⟩ },
  rw [rpow_def_of_pos hK', rpow_def_of_pos hK', ← exp_add, mul_add, mul_div_cancel'],
  refine ne_of_gt (log_pos _),
  rw [← nat.cast_one, nat.cast_lt],
  exact one_lt_card K
end

lemma card_pow_degree_anti_archimedean [decidable_eq K] {x y z : polynomial K} {a : ℝ}
  (hxy : (card_pow_degree K (x - y) : ℝ) < a) (hyz : (card_pow_degree K (y - z) : ℝ) < a) :
  (card_pow_degree K (x - z) : ℝ) < a :=
begin
  have ha : 0 < a := lt_of_le_of_lt (int.cast_nonneg.mpr (absolute_value.nonneg _ _)) hxy,
  by_cases hxy' : x = y,
  { rwa hxy' },
  by_cases hyz' : y = z,
  { rwa ← hyz' },
  by_cases hxz' : x = z,
  { rwa [hxz', sub_self, absolute_value.map_zero, int.cast_zero] },
  rw [← ne.def, ← sub_ne_zero] at hxy' hyz' hxz',
  refine lt_of_le_of_lt _ (max_lt hxy hyz),
  rw [card_pow_degree_apply hxz', card_pow_degree_apply hxy', card_pow_degree_apply hyz'],
  have : (1 : ℝ) ≤ fintype.card K := by simpa using (one_lt_card K).le,
  simp only [int.cast_pow, int.cast_coe_nat, le_max_iff],
  refine or.imp (pow_le_pow this) (pow_le_pow this) _,
  rw [nat_degree_le_iff_degree_le, nat_degree_le_iff_degree_le, ← le_max_iff,
      ← degree_eq_nat_degree hxy', ← degree_eq_nat_degree hyz'],
  convert degree_add_le (x - y) (y - z) using 2,
  exact (sub_add_sub_cancel _ _ _).symm
end

/-- A slightly stronger version of `exists_partition` on which we perform induction on `n`. -/
lemma exists_partition_aux [decidable_eq K] (n : ℕ) {ε : ℝ} (hε : 0 < ε)
  {b : polynomial K} (hb : b ≠ 0) (A : fin n → polynomial K) :
  ∃ (t : fin n → fin (fintype.card K ^ nat_ceil (-log ε / log ↑(fintype.card K)))),
  ∀ (i₀ i₁ : fin n),
  t i₀ = t i₁ ↔ (card_pow_degree K (A i₁ % b - A i₀ % b) : ℝ) < card_pow_degree K b • ε :=
begin
  have hbε : 0 < card_pow_degree K b • ε,
  { rw [algebra.smul_def, ring_hom.eq_int_cast],
    exact mul_pos (int.cast_pos.mpr (absolute_value.pos _ hb)) hε },
  induction n with n ih,
  { refine ⟨fin_zero_elim, fin_zero_elim⟩ },
  obtain ⟨t', ht'⟩ := ih (fin.tail A),
  suffices : ∃ j,
    ∀ i, t' i = j ↔ (card_pow_degree K (A 0 % b - A i.succ % b) : ℝ) < card_pow_degree K b • ε,
  { obtain ⟨j, hj⟩ := this,
    refine ⟨fin.cons j t', λ i₀ i₁, _⟩,
    refine fin.cases _ (λ i₀, _) i₀; refine fin.cases _ (λ i₁, _) i₁,
    { simpa using hbε },
    { rw [fin.cons_succ, fin.cons_zero, eq_comm, absolute_value.sub_comm],
      exact hj i₁ },
    { rw [fin.cons_succ, fin.cons_zero],
      exact hj i₀ },
    { rw [fin.cons_succ, fin.cons_succ],
      exact ht' i₀ i₁ } },
  have approx_of_approx : ∀ (i : fin n),
    (card_pow_degree K (A 0 % b - A i.succ % b) : ℝ) < card_pow_degree K b • ε →
    ∀ i', t' i' = t' i →
    (card_pow_degree K (A 0 % b - A i'.succ % b) : ℝ) < card_pow_degree K b • ε,
  { intros i hi i' hi',
    exact card_pow_degree_anti_archimedean hi ((ht' _ _).mp hi') },
  by_cases exists_nonempty_j : ∃ j, (∃ i, t' i = j) ∧
    ∀ i, t' i = j → (card_pow_degree K (A 0 % b - A i.succ % b) : ℝ) < card_pow_degree K b • ε,
  { obtain ⟨j, ⟨i, hi⟩, hj⟩ := exists_nonempty_j,
    refine ⟨j, λ i', ⟨hj i', λ hi', trans ((ht' _ _).mpr _) hi⟩⟩,
    apply card_pow_degree_anti_archimedean _ hi',
    rw absolute_value.sub_comm,
    exact hj _ hi },
  obtain ⟨j, hj⟩ : ∃ j, ∀ (i : fin n), t' i = j →
    (card_pow_degree K (A 0 % b - A i.succ % b) : ℝ) < card_pow_degree K b • ε,
  { by_contra this,
    push_neg at this,
    obtain ⟨j₀, j₁, j_ne, approx⟩ := exists_approx hb hε
      (fin.cons (A 0) (λ j, A (fin.succ (classical.some (this j))))),
    revert j_ne approx,
    refine fin.cases _ (λ j₀, _) j₀; refine fin.cases (λ j_ne approx, _) (λ j₁ j_ne approx, _) j₁,
    { exact absurd rfl j_ne },
    { rw [fin.cons_succ, fin.cons_zero, ← not_le, absolute_value.sub_comm] at approx,
      have := (classical.some_spec (this j₁)).2,
      contradiction },
    { rw [fin.cons_succ, fin.cons_zero, ← not_le] at approx,
      have := (classical.some_spec (this j₀)).2,
      contradiction },
    { rw [fin.cons_succ, fin.cons_succ] at approx,
      rw [ne.def, fin.succ_inj] at j_ne,
      have : j₀ = j₁ :=
      trans (classical.some_spec (this j₀)).1.symm
      (trans ((ht' (classical.some (this j₀)) (classical.some (this j₁))).mpr approx)
      (classical.some_spec (this j₁)).1),
      contradiction } },
  refine ⟨j, λ i, ⟨hj i, λ hi, _⟩⟩,
  have := exists_nonempty_j ⟨t' i, ⟨i, rfl⟩, approx_of_approx _ hi⟩,
  contradiction
end

lemma exists_partition [decidable_eq K] (n : ℕ) {ε : ℝ} (hε : 0 < ε)
  {b : polynomial K} (hb : b ≠ 0) (A : fin n → polynomial K) :
  ∃ (t : fin n → fin (fintype.card K ^ nat_ceil (-log ε / log ↑(fintype.card K)))),
    ∀ (i₀ i₁ : fin n), t i₀ = t i₁ →
      (card_pow_degree K (A i₁ % b - A i₀ % b) : ℝ) < card_pow_degree K b • ε :=
begin
  obtain ⟨t, ht⟩ := exists_partition_aux n hε hb A,
  exact ⟨t, λ i₀ i₁ hi, (ht i₀ i₁).mp hi⟩
end

/-- `λ p, fintype.card K ^ degree p` is an admissible absolute value.

We set `admissible_card_pow_degree 0 = 0`. -/
noncomputable def admissible_card_pow_degree [decidable_eq K] :
  admissible_absolute_value (polynomial K) :=
{ map_lt_map_iff' := λ p q, begin
    by_cases hp : p = 0; by_cases hq : q = 0,
    { simp [hp, hq, euclidean_domain.r] },
    { simp [hp, hq, euclidean_domain.r, absolute_value.pos_iff, bot_lt_iff_ne_bot, degree_eq_bot] },
    { simpa [hp, hq, euclidean_domain.r, absolute_value.pos_iff, bot_lt_iff_ne_bot, degree_eq_bot]
        using (card_pow_degree K).nonneg p },
    { simp only [card_pow_degree_apply hp, card_pow_degree_apply hq, euclidean_domain.r,
                 mul_hom.to_fun_eq_coe, coe_to_mul_hom],
      rw [degree_eq_nat_degree hp, degree_eq_nat_degree hq, with_bot.coe_lt_coe, pow_lt_pow_iff],
      exact_mod_cast one_lt_card K },
  end,
  card := λ ε, fintype.card K ^ (nat_ceil (- log ε / log (fintype.card K))),
  exists_partition' := λ n ε hε b hb, exists_partition n hε hb,
  .. card_pow_degree K }

end polynomial


/-
Copyright (c) 2021 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri

! This file was ported from Lean 3 source module topology.algebra.constructions
! leanprover-community/mathlib commit c10e724be91096453ee3db13862b9fb9a992fef2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Homeomorph

/-!
# Topological space structure on the opposite monoid and on the units group

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

In this file we define `topological_space` structure on `Mᵐᵒᵖ`, `Mᵃᵒᵖ`, `Mˣ`, and `add_units M`.
This file does not import definitions of a topological monoid and/or a continuous multiplicative
action, so we postpone the proofs of `has_continuous_mul Mᵐᵒᵖ` etc till we have these definitions.

## Tags

topological space, opposite monoid, units
-/

variable {M X : Type _}

open Filter

open Topology

namespace MulOpposite

/-- Put the same topological space structure on the opposite monoid as on the original space. -/
@[to_additive
      "Put the same topological space structure on the opposite monoid as on the original\nspace."]
instance [TopologicalSpace M] : TopologicalSpace Mᵐᵒᵖ :=
  TopologicalSpace.induced (unop : Mᵐᵒᵖ → M) ‹_›

variable [TopologicalSpace M]

#print MulOpposite.continuous_unop /-
@[continuity, to_additive]
theorem continuous_unop : Continuous (unop : Mᵐᵒᵖ → M) :=
  continuous_induced_dom
#align mul_opposite.continuous_unop MulOpposite.continuous_unop
#align add_opposite.continuous_unop AddOpposite.continuous_unop
-/

#print MulOpposite.continuous_op /-
@[continuity, to_additive]
theorem continuous_op : Continuous (op : M → Mᵐᵒᵖ) :=
  continuous_induced_rng.2 continuous_id
#align mul_opposite.continuous_op MulOpposite.continuous_op
#align add_opposite.continuous_op AddOpposite.continuous_op
-/

#print MulOpposite.opHomeomorph /-
/-- `mul_opposite.op` as a homeomorphism. -/
@[to_additive "`add_opposite.op` as a homeomorphism.", simps]
def opHomeomorph : M ≃ₜ Mᵐᵒᵖ where
  toEquiv := opEquiv
  continuous_toFun := continuous_op
  continuous_invFun := continuous_unop
#align mul_opposite.op_homeomorph MulOpposite.opHomeomorph
#align add_opposite.op_homeomorph AddOpposite.opHomeomorph
-/

@[to_additive]
instance [T2Space M] : T2Space Mᵐᵒᵖ :=
  opHomeomorph.symm.Embedding.T2Space

#print MulOpposite.map_op_nhds /-
@[simp, to_additive]
theorem map_op_nhds (x : M) : map (op : M → Mᵐᵒᵖ) (𝓝 x) = 𝓝 (op x) :=
  opHomeomorph.map_nhds_eq x
#align mul_opposite.map_op_nhds MulOpposite.map_op_nhds
#align add_opposite.map_op_nhds AddOpposite.map_op_nhds
-/

#print MulOpposite.map_unop_nhds /-
@[simp, to_additive]
theorem map_unop_nhds (x : Mᵐᵒᵖ) : map (unop : Mᵐᵒᵖ → M) (𝓝 x) = 𝓝 (unop x) :=
  opHomeomorph.symm.map_nhds_eq x
#align mul_opposite.map_unop_nhds MulOpposite.map_unop_nhds
#align add_opposite.map_unop_nhds AddOpposite.map_unop_nhds
-/

#print MulOpposite.comap_op_nhds /-
@[simp, to_additive]
theorem comap_op_nhds (x : Mᵐᵒᵖ) : comap (op : M → Mᵐᵒᵖ) (𝓝 x) = 𝓝 (unop x) :=
  opHomeomorph.comap_nhds_eq x
#align mul_opposite.comap_op_nhds MulOpposite.comap_op_nhds
#align add_opposite.comap_op_nhds AddOpposite.comap_op_nhds
-/

#print MulOpposite.comap_unop_nhds /-
@[simp, to_additive]
theorem comap_unop_nhds (x : M) : comap (unop : Mᵐᵒᵖ → M) (𝓝 x) = 𝓝 (op x) :=
  opHomeomorph.symm.comap_nhds_eq x
#align mul_opposite.comap_unop_nhds MulOpposite.comap_unop_nhds
#align add_opposite.comap_unop_nhds AddOpposite.comap_unop_nhds
-/

end MulOpposite

namespace Units

open MulOpposite

variable [TopologicalSpace M] [Monoid M] [TopologicalSpace X]

/-- The units of a monoid are equipped with a topology, via the embedding into `M × M`. -/
@[to_additive
      "The additive units of a monoid are equipped with a topology, via the embedding into\n`M × M`."]
instance : TopologicalSpace Mˣ :=
  Prod.topologicalSpace.induced (embedProduct M)

/- warning: units.inducing_embed_product -> Units.inducing_embedProduct is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Inducing.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.topologicalSpace.{u1} M _inst_1 _inst_2) (Prod.topologicalSpace.{u1, u1} M (MulOpposite.{u1} M) _inst_1 (MulOpposite.topologicalSpace.{u1} M _inst_1)) (coeFn.{succ u1, succ u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.mulOneClass.{u1} M _inst_2) (Prod.mulOneClass.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (fun (_x : MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.mulOneClass.{u1} M _inst_2) (Prod.mulOneClass.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) => (Units.{u1} M _inst_2) -> (Prod.{u1, u1} M (MulOpposite.{u1} M))) (MonoidHom.hasCoeToFun.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.mulOneClass.{u1} M _inst_2) (Prod.mulOneClass.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.embedProduct.{u1} M _inst_2))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Inducing.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instTopologicalSpaceUnits.{u1} M _inst_1 _inst_2) (instTopologicalSpaceProd.{u1, u1} M (MulOpposite.{u1} M) _inst_1 (MulOpposite.instTopologicalSpaceMulOpposite.{u1} M _inst_1)) (FunLike.coe.{succ u1, succ u1, succ u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.{u1} M _inst_2) (fun (_x : Units.{u1} M _inst_2) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Units.{u1} M _inst_2) => Prod.{u1, u1} M (MulOpposite.{u1} M)) _x) (MulHomClass.toFunLike.{u1, u1, u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (MulOneClass.toMul.{u1} (Units.{u1} M _inst_2) (Units.instMulOneClassUnits.{u1} M _inst_2)) (MulOneClass.toMul.{u1} (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (MonoidHomClass.toMulHomClass.{u1, u1, u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2))) (MonoidHom.monoidHomClass.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))))) (Units.embedProduct.{u1} M _inst_2))
Case conversion may be inaccurate. Consider using '#align units.inducing_embed_product Units.inducing_embedProductₓ'. -/
@[to_additive]
theorem inducing_embedProduct : Inducing (embedProduct M) :=
  ⟨rfl⟩
#align units.inducing_embed_product Units.inducing_embedProduct
#align add_units.inducing_embed_product AddUnits.inducing_embedProduct

/- warning: units.embedding_embed_product -> Units.embedding_embedProduct is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Embedding.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.topologicalSpace.{u1} M _inst_1 _inst_2) (Prod.topologicalSpace.{u1, u1} M (MulOpposite.{u1} M) _inst_1 (MulOpposite.topologicalSpace.{u1} M _inst_1)) (coeFn.{succ u1, succ u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.mulOneClass.{u1} M _inst_2) (Prod.mulOneClass.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (fun (_x : MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.mulOneClass.{u1} M _inst_2) (Prod.mulOneClass.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) => (Units.{u1} M _inst_2) -> (Prod.{u1, u1} M (MulOpposite.{u1} M))) (MonoidHom.hasCoeToFun.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.mulOneClass.{u1} M _inst_2) (Prod.mulOneClass.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.embedProduct.{u1} M _inst_2))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Embedding.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instTopologicalSpaceUnits.{u1} M _inst_1 _inst_2) (instTopologicalSpaceProd.{u1, u1} M (MulOpposite.{u1} M) _inst_1 (MulOpposite.instTopologicalSpaceMulOpposite.{u1} M _inst_1)) (FunLike.coe.{succ u1, succ u1, succ u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.{u1} M _inst_2) (fun (_x : Units.{u1} M _inst_2) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Units.{u1} M _inst_2) => Prod.{u1, u1} M (MulOpposite.{u1} M)) _x) (MulHomClass.toFunLike.{u1, u1, u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (MulOneClass.toMul.{u1} (Units.{u1} M _inst_2) (Units.instMulOneClassUnits.{u1} M _inst_2)) (MulOneClass.toMul.{u1} (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (MonoidHomClass.toMulHomClass.{u1, u1, u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2))) (MonoidHom.monoidHomClass.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))))) (Units.embedProduct.{u1} M _inst_2))
Case conversion may be inaccurate. Consider using '#align units.embedding_embed_product Units.embedding_embedProductₓ'. -/
@[to_additive]
theorem embedding_embedProduct : Embedding (embedProduct M) :=
  ⟨inducing_embedProduct, embedProduct_injective M⟩
#align units.embedding_embed_product Units.embedding_embedProduct
#align add_units.embedding_embed_product AddUnits.embedding_embedProduct

/- warning: units.topology_eq_inf -> Units.topology_eq_inf is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Eq.{succ u1} (TopologicalSpace.{u1} (Units.{u1} M _inst_2)) (Units.topologicalSpace.{u1} M _inst_1 _inst_2) (Inf.inf.{u1} (TopologicalSpace.{u1} (Units.{u1} M _inst_2)) (SemilatticeInf.toHasInf.{u1} (TopologicalSpace.{u1} (Units.{u1} M _inst_2)) (Lattice.toSemilatticeInf.{u1} (TopologicalSpace.{u1} (Units.{u1} M _inst_2)) (ConditionallyCompleteLattice.toLattice.{u1} (TopologicalSpace.{u1} (Units.{u1} M _inst_2)) (CompleteLattice.toConditionallyCompleteLattice.{u1} (TopologicalSpace.{u1} (Units.{u1} M _inst_2)) (TopologicalSpace.completeLattice.{u1} (Units.{u1} M _inst_2)))))) (TopologicalSpace.induced.{u1, u1} (Units.{u1} M _inst_2) M ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} M _inst_2) M (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} M _inst_2) M (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} M _inst_2) M (coeBase.{succ u1, succ u1} (Units.{u1} M _inst_2) M (Units.hasCoe.{u1} M _inst_2))))) _inst_1) (TopologicalSpace.induced.{u1, u1} (Units.{u1} M _inst_2) M (fun (u : Units.{u1} M _inst_2) => (fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} M _inst_2) M (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} M _inst_2) M (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} M _inst_2) M (coeBase.{succ u1, succ u1} (Units.{u1} M _inst_2) M (Units.hasCoe.{u1} M _inst_2)))) (Inv.inv.{u1} (Units.{u1} M _inst_2) (Units.hasInv.{u1} M _inst_2) u)) _inst_1))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Eq.{succ u1} (TopologicalSpace.{u1} (Units.{u1} M _inst_2)) (Units.instTopologicalSpaceUnits.{u1} M _inst_1 _inst_2) (Inf.inf.{u1} (TopologicalSpace.{u1} (Units.{u1} M _inst_2)) (Lattice.toInf.{u1} (TopologicalSpace.{u1} (Units.{u1} M _inst_2)) (ConditionallyCompleteLattice.toLattice.{u1} (TopologicalSpace.{u1} (Units.{u1} M _inst_2)) (CompleteLattice.toConditionallyCompleteLattice.{u1} (TopologicalSpace.{u1} (Units.{u1} M _inst_2)) (TopologicalSpace.instCompleteLatticeTopologicalSpace.{u1} (Units.{u1} M _inst_2))))) (TopologicalSpace.induced.{u1, u1} (Units.{u1} M _inst_2) M (Units.val.{u1} M _inst_2) _inst_1) (TopologicalSpace.induced.{u1, u1} (Units.{u1} M _inst_2) M (fun (u : Units.{u1} M _inst_2) => Units.val.{u1} M _inst_2 (Inv.inv.{u1} (Units.{u1} M _inst_2) (Units.instInvUnits.{u1} M _inst_2) u)) _inst_1))
Case conversion may be inaccurate. Consider using '#align units.topology_eq_inf Units.topology_eq_infₓ'. -/
@[to_additive]
theorem topology_eq_inf :
    Units.topologicalSpace =
      TopologicalSpace.induced (coe : Mˣ → M) ‹_› ⊓
        TopologicalSpace.induced (fun u => ↑u⁻¹ : Mˣ → M) ‹_› :=
  by
  simp only [inducing_embed_product.1, Prod.topologicalSpace, induced_inf,
      MulOpposite.topologicalSpace, induced_compose] <;>
    rfl
#align units.topology_eq_inf Units.topology_eq_inf
#align add_units.topology_eq_inf AddUnits.topology_eq_inf

/- warning: units.embedding_coe_mk -> Units.embedding_val_mk is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_4 : DivisionMonoid.{u1} M] [_inst_5 : TopologicalSpace.{u1} M], (ContinuousOn.{u1, u1} M M _inst_5 _inst_5 (Inv.inv.{u1} M (DivInvMonoid.toHasInv.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4))) (setOf.{u1} M (fun (x : M) => IsUnit.{u1} M (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4)) x))) -> (Embedding.{u1, u1} (Units.{u1} M (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4))) M (Units.topologicalSpace.{u1} M _inst_5 (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4))) _inst_5 ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} M (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4))) M (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} M (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4))) M (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} M (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4))) M (coeBase.{succ u1, succ u1} (Units.{u1} M (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4))) M (Units.hasCoe.{u1} M (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4))))))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_4 : DivisionMonoid.{u1} M] [_inst_5 : TopologicalSpace.{u1} M], (ContinuousOn.{u1, u1} M M _inst_5 _inst_5 (Inv.inv.{u1} M (InvOneClass.toInv.{u1} M (DivInvOneMonoid.toInvOneClass.{u1} M (DivisionMonoid.toDivInvOneMonoid.{u1} M _inst_4)))) (setOf.{u1} M (fun (x : M) => IsUnit.{u1} M (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4)) x))) -> (Embedding.{u1, u1} (Units.{u1} M (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4))) M (Units.instTopologicalSpaceUnits.{u1} M _inst_5 (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4))) _inst_5 (Units.val.{u1} M (DivInvMonoid.toMonoid.{u1} M (DivisionMonoid.toDivInvMonoid.{u1} M _inst_4))))
Case conversion may be inaccurate. Consider using '#align units.embedding_coe_mk Units.embedding_val_mkₓ'. -/
/-- An auxiliary lemma that can be used to prove that coercion `Mˣ → M` is a topological embedding.
Use `units.coe_embedding₀`, `units.coe_embedding`, or `to_units_homeomorph` instead. -/
@[to_additive
      "An auxiliary lemma that can be used to prove that coercion `add_units M → M` is a\ntopological embedding. Use `add_units.coe_embedding` or `to_add_units_homeomorph` instead."]
theorem embedding_val_mk {M : Type _} [DivisionMonoid M] [TopologicalSpace M]
    (h : ContinuousOn Inv.inv { x : M | IsUnit x }) : Embedding (coe : Mˣ → M) :=
  by
  refine' ⟨⟨_⟩, ext⟩
  rw [topology_eq_inf, inf_eq_left, ← continuous_iff_le_induced, continuous_iff_continuousAt]
  intro u s hs
  simp only [coe_inv, nhds_induced, Filter.mem_map] at hs⊢
  exact ⟨_, mem_inf_principal.1 (h u u.is_unit hs), fun u' hu' => hu' u'.IsUnit⟩
#align units.embedding_coe_mk Units.embedding_val_mk
#align add_units.embedding_coe_mk AddUnits.embedding_val_mk

/- warning: units.continuous_embed_product -> Units.continuous_embedProduct is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Continuous.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.topologicalSpace.{u1} M _inst_1 _inst_2) (Prod.topologicalSpace.{u1, u1} M (MulOpposite.{u1} M) _inst_1 (MulOpposite.topologicalSpace.{u1} M _inst_1)) (coeFn.{succ u1, succ u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.mulOneClass.{u1} M _inst_2) (Prod.mulOneClass.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (fun (_x : MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.mulOneClass.{u1} M _inst_2) (Prod.mulOneClass.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) => (Units.{u1} M _inst_2) -> (Prod.{u1, u1} M (MulOpposite.{u1} M))) (MonoidHom.hasCoeToFun.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.mulOneClass.{u1} M _inst_2) (Prod.mulOneClass.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.embedProduct.{u1} M _inst_2))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Continuous.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instTopologicalSpaceUnits.{u1} M _inst_1 _inst_2) (instTopologicalSpaceProd.{u1, u1} M (MulOpposite.{u1} M) _inst_1 (MulOpposite.instTopologicalSpaceMulOpposite.{u1} M _inst_1)) (FunLike.coe.{succ u1, succ u1, succ u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.{u1} M _inst_2) (fun (_x : Units.{u1} M _inst_2) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Units.{u1} M _inst_2) => Prod.{u1, u1} M (MulOpposite.{u1} M)) _x) (MulHomClass.toFunLike.{u1, u1, u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (MulOneClass.toMul.{u1} (Units.{u1} M _inst_2) (Units.instMulOneClassUnits.{u1} M _inst_2)) (MulOneClass.toMul.{u1} (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (MonoidHomClass.toMulHomClass.{u1, u1, u1} (MonoidHom.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))) (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2))) (MonoidHom.monoidHomClass.{u1, u1} (Units.{u1} M _inst_2) (Prod.{u1, u1} M (MulOpposite.{u1} M)) (Units.instMulOneClassUnits.{u1} M _inst_2) (Prod.instMulOneClassProd.{u1, u1} M (MulOpposite.{u1} M) (Monoid.toMulOneClass.{u1} M _inst_2) (MulOpposite.mulOneClass.{u1} M (Monoid.toMulOneClass.{u1} M _inst_2)))))) (Units.embedProduct.{u1} M _inst_2))
Case conversion may be inaccurate. Consider using '#align units.continuous_embed_product Units.continuous_embedProductₓ'. -/
@[to_additive]
theorem continuous_embedProduct : Continuous (embedProduct M) :=
  continuous_induced_dom
#align units.continuous_embed_product Units.continuous_embedProduct
#align add_units.continuous_embed_product AddUnits.continuous_embedProduct

/- warning: units.continuous_coe -> Units.continuous_val is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Continuous.{u1, u1} (Units.{u1} M _inst_2) M (Units.topologicalSpace.{u1} M _inst_1 _inst_2) _inst_1 ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} M _inst_2) M (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} M _inst_2) M (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} M _inst_2) M (coeBase.{succ u1, succ u1} (Units.{u1} M _inst_2) M (Units.hasCoe.{u1} M _inst_2)))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Continuous.{u1, u1} (Units.{u1} M _inst_2) M (Units.instTopologicalSpaceUnits.{u1} M _inst_1 _inst_2) _inst_1 (Units.val.{u1} M _inst_2)
Case conversion may be inaccurate. Consider using '#align units.continuous_coe Units.continuous_valₓ'. -/
@[to_additive]
theorem continuous_val : Continuous (coe : Mˣ → M) :=
  (@continuous_embedProduct M _ _).fst
#align units.continuous_coe Units.continuous_val
#align add_units.continuous_coe AddUnits.continuous_val

/- warning: units.continuous_iff -> Units.continuous_iff is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {X : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M] [_inst_3 : TopologicalSpace.{u2} X] {f : X -> (Units.{u1} M _inst_2)}, Iff (Continuous.{u2, u1} X (Units.{u1} M _inst_2) _inst_3 (Units.topologicalSpace.{u1} M _inst_1 _inst_2) f) (And (Continuous.{u2, u1} X M _inst_3 _inst_1 (Function.comp.{succ u2, succ u1, succ u1} X (Units.{u1} M _inst_2) M ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} M _inst_2) M (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} M _inst_2) M (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} M _inst_2) M (coeBase.{succ u1, succ u1} (Units.{u1} M _inst_2) M (Units.hasCoe.{u1} M _inst_2))))) f)) (Continuous.{u2, u1} X M _inst_3 _inst_1 (fun (x : X) => (fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} M _inst_2) M (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} M _inst_2) M (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} M _inst_2) M (coeBase.{succ u1, succ u1} (Units.{u1} M _inst_2) M (Units.hasCoe.{u1} M _inst_2)))) (Inv.inv.{u1} (Units.{u1} M _inst_2) (Units.hasInv.{u1} M _inst_2) (f x)))))
but is expected to have type
  forall {M : Type.{u2}} {X : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} M] [_inst_2 : Monoid.{u2} M] [_inst_3 : TopologicalSpace.{u1} X] {f : X -> (Units.{u2} M _inst_2)}, Iff (Continuous.{u1, u2} X (Units.{u2} M _inst_2) _inst_3 (Units.instTopologicalSpaceUnits.{u2} M _inst_1 _inst_2) f) (And (Continuous.{u1, u2} X M _inst_3 _inst_1 (Function.comp.{succ u1, succ u2, succ u2} X (Units.{u2} M _inst_2) M (Units.val.{u2} M _inst_2) f)) (Continuous.{u1, u2} X M _inst_3 _inst_1 (fun (x : X) => Units.val.{u2} M _inst_2 (Inv.inv.{u2} (Units.{u2} M _inst_2) (Units.instInvUnits.{u2} M _inst_2) (f x)))))
Case conversion may be inaccurate. Consider using '#align units.continuous_iff Units.continuous_iffₓ'. -/
@[to_additive]
protected theorem continuous_iff {f : X → Mˣ} :
    Continuous f ↔ Continuous (coe ∘ f : X → M) ∧ Continuous (fun x => ↑(f x)⁻¹ : X → M) := by
  simp only [inducing_embed_product.continuous_iff, embed_product_apply, (· ∘ ·),
    continuous_prod_mk, op_homeomorph.symm.inducing.continuous_iff, op_homeomorph_symm_apply,
    unop_op]
#align units.continuous_iff Units.continuous_iff
#align add_units.continuous_iff AddUnits.continuous_iff

/- warning: units.continuous_coe_inv -> Units.continuous_coe_inv is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Continuous.{u1, u1} (Units.{u1} M _inst_2) M (Units.topologicalSpace.{u1} M _inst_1 _inst_2) _inst_1 (fun (u : Units.{u1} M _inst_2) => (fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} M _inst_2) M (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} M _inst_2) M (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} M _inst_2) M (coeBase.{succ u1, succ u1} (Units.{u1} M _inst_2) M (Units.hasCoe.{u1} M _inst_2)))) (Inv.inv.{u1} (Units.{u1} M _inst_2) (Units.hasInv.{u1} M _inst_2) u))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : Monoid.{u1} M], Continuous.{u1, u1} (Units.{u1} M _inst_2) M (Units.instTopologicalSpaceUnits.{u1} M _inst_1 _inst_2) _inst_1 (fun (u : Units.{u1} M _inst_2) => Units.val.{u1} M _inst_2 (Inv.inv.{u1} (Units.{u1} M _inst_2) (Units.instInvUnits.{u1} M _inst_2) u))
Case conversion may be inaccurate. Consider using '#align units.continuous_coe_inv Units.continuous_coe_invₓ'. -/
@[to_additive]
theorem continuous_coe_inv : Continuous (fun u => ↑u⁻¹ : Mˣ → M) :=
  (Units.continuous_iff.1 continuous_id).2
#align units.continuous_coe_inv Units.continuous_coe_inv
#align add_units.continuous_coe_neg AddUnits.continuous_coe_neg

end Units