/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.split_coequalizer
import category_theory.limits.preserves.basic

/-!
# Preserving (co)equalizers

Constructions to relate the notions of preserving (co)equalizers and reflecting (co)equalizers
to concrete (co)forks.

In particular, we show that `equalizer_comparison G f` is an isomorphism iff `G` preserves
the limit of `f` as well as the dual.
-/

noncomputable theory

universes v u₁ u₂

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v} C]
variables {D : Type u₂} [category.{v} D]
variables (G : C ⥤ D)

namespace category_theory.limits

section equalizers
variables {X Y Z : C} {f g : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = h ≫ g)

/--
The map of a fork is a limit iff the fork consisting of the mapped morphisms is a limit. This
essentially lets us commute `fork.of_ι` with `functor.map_cone`.
-/
def is_limit_map_cone_fork_equiv :
  is_limit (G.map_cone (fork.of_ι h w)) ≃
  is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g)) :=
(is_limit.postcompose_hom_equiv (diagram_iso_parallel_pair.{v} _) _).symm.trans
  (is_limit.equiv_iso_limit (fork.ext (iso.refl _) (by simp)))

/-- The property of preserving equalizers expressed in terms of forks. -/
def is_limit_fork_map_of_is_limit [preserves_limit (parallel_pair f g) G]
  (l : is_limit (fork.of_ι h w)) :
  is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g)) :=
is_limit_map_cone_fork_equiv G w (preserves_limit.preserves l)

/-- The property of reflecting equalizers expressed in terms of forks. -/
def is_limit_of_is_limit_fork_map [reflects_limit (parallel_pair f g) G]
  (l : is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g))) :
  is_limit (fork.of_ι h w) :=
reflects_limit.reflects ((is_limit_map_cone_fork_equiv G w).symm l)

variables (f g) [has_equalizer f g]

/--
If `G` preserves equalizers and `C` has them, then the fork constructed of the mapped morphisms of
a fork is a limit.
-/
def is_limit_of_has_equalizer_of_preserves_limit
  [preserves_limit (parallel_pair f g) G] :
  is_limit (fork.of_ι (G.map (equalizer.ι f g))
                      (by simp only [←G.map_comp, equalizer.condition])) :=
is_limit_fork_map_of_is_limit G _ (equalizer_is_equalizer f g)

variables [has_equalizer (G.map f) (G.map g)]

/--
If the equalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
equalizer of `(f,g)`.
-/
def preserves_equalizer.of_iso_comparison [i : is_iso (equalizer_comparison f g G)] :
  preserves_limit (parallel_pair f g) G :=
begin
  apply preserves_limit_of_preserves_limit_cone (equalizer_is_equalizer f g),
  apply (is_limit_map_cone_fork_equiv _ _).symm _,
  apply is_limit.of_point_iso (limit.is_limit (parallel_pair (G.map f) (G.map g))),
  apply i,
end

variables [preserves_limit (parallel_pair f g) G]
/--
If `G` preserves the equalizer of `(f,g)`, then the equalizer comparison map for `G` at `(f,g)` is
an isomorphism.
-/
def preserves_equalizer.iso :
  G.obj (equalizer f g) ≅ equalizer (G.map f) (G.map g) :=
is_limit.cone_point_unique_up_to_iso
  (is_limit_of_has_equalizer_of_preserves_limit G f g)
  (limit.is_limit _)

@[simp]
lemma preserves_equalizer.iso_hom :
  (preserves_equalizer.iso G f g).hom = equalizer_comparison f g G :=
rfl

instance : is_iso (equalizer_comparison f g G) :=
begin
  rw ← preserves_equalizer.iso_hom,
  apply_instance
end

end equalizers

section coequalizers

variables {X Y Z : C} {f g : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = g ≫ h)

/--
The map of a cofork is a colimit iff the cofork consisting of the mapped morphisms is a colimit.
This essentially lets us commute `cofork.of_π` with `functor.map_cocone`.
-/
def is_colimit_map_cocone_cofork_equiv :
  is_colimit (G.map_cocone (cofork.of_π h w)) ≃
  is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w]) : cofork (G.map f) (G.map g)) :=
(is_colimit.precompose_inv_equiv (diagram_iso_parallel_pair.{v} _) _).symm.trans
  (is_colimit.equiv_iso_colimit (cofork.ext (iso.refl _) (by { dsimp, simp })))

/-- The property of preserving coequalizers expressed in terms of coforks. -/
def is_colimit_cofork_map_of_is_colimit [preserves_colimit (parallel_pair f g) G]
  (l : is_colimit (cofork.of_π h w)) :
  is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w]) : cofork (G.map f) (G.map g)) :=
is_colimit_map_cocone_cofork_equiv G w (preserves_colimit.preserves l)

/-- The property of reflecting coequalizers expressed in terms of coforks. -/
def is_colimit_of_is_colimit_cofork_map [reflects_colimit (parallel_pair f g) G]
  (l : is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w])
                  : cofork (G.map f) (G.map g))) :
  is_colimit (cofork.of_π h w) :=
reflects_colimit.reflects ((is_colimit_map_cocone_cofork_equiv G w).symm l)

variables (f g) [has_coequalizer f g]

/--
If `G` preserves coequalizers and `C` has them, then the cofork constructed of the mapped morphisms
of a cofork is a colimit.
-/
def is_colimit_of_has_coequalizer_of_preserves_colimit
  [preserves_colimit (parallel_pair f g) G] :
  is_colimit (cofork.of_π (G.map (coequalizer.π f g)) _) :=
is_colimit_cofork_map_of_is_colimit G _ (coequalizer_is_coequalizer f g)

variables [has_coequalizer (G.map f) (G.map g)]

/--
If the coequalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
coequalizer of `(f,g)`.
-/
def of_iso_comparison [i : is_iso (coequalizer_comparison f g G)] :
  preserves_colimit (parallel_pair f g) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (coequalizer_is_coequalizer f g),
  apply (is_colimit_map_cocone_cofork_equiv _ _).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (parallel_pair (G.map f) (G.map g))),
  apply i,
end

variables [preserves_colimit (parallel_pair f g) G]
/--
If `G` preserves the coequalizer of `(f,g)`, then the coequalizer comparison map for `G` at `(f,g)`
is an isomorphism.
-/
def preserves_coequalizer.iso :
  coequalizer (G.map f) (G.map g) ≅ G.obj (coequalizer f g) :=
is_colimit.cocone_point_unique_up_to_iso
  (colimit.is_colimit _)
  (is_colimit_of_has_coequalizer_of_preserves_colimit G f g)

@[simp]
lemma preserves_coequalizer.iso_hom :
  (preserves_coequalizer.iso G f g).hom = coequalizer_comparison f g G :=
rfl

instance : is_iso (coequalizer_comparison f g G) :=
begin
  rw ← preserves_coequalizer.iso_hom,
  apply_instance
end

/-- Any functor preserves coequalizers of split pairs. -/
@[priority 1]
instance preserves_split_coequalizers (f g : X ⟶ Y) [has_split_coequalizer f g] :
  preserves_colimit (parallel_pair f g) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone
            ((has_split_coequalizer.is_split_coequalizer f g).is_coequalizer),
  apply (is_colimit_map_cocone_cofork_equiv G _).symm
            ((has_split_coequalizer.is_split_coequalizer f g).map G).is_coequalizer,
end
end coequalizers

end category_theory.limits


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

! This file was ported from Lean 3 source module topology.algebra.nonarchimedean.bases
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.Nonarchimedean.Basic
import Mathbin.Topology.Algebra.FilterBasis
import Mathbin.Algebra.Module.Submodule.Pointwise

/-!
# Neighborhood bases for non-archimedean rings and modules

This files contains special families of filter bases on rings and modules that give rise to
non-archimedean topologies.

The main definition is `ring_subgroups_basis` which is a predicate on a family of
additive subgroups of a ring. The predicate ensures there is a topology
`ring_subgroups_basis.topology` which is compatible with a ring structure and admits the given
family as a basis of neighborhoods of zero. In particular the given subgroups become open subgroups
(bundled in `ring_subgroups_basis.open_add_subgroup`) and we get a non-archimedean topological ring
(`ring_subgroups_basis.nonarchimedean`).

A special case of this construction is given by `submodules_basis` where the subgroups are
sub-modules in a commutative algebra. This important example gives rises to the adic topology
(studied in its own file).

-/

open Set Filter Function Lattice AddGroupWithZeroNhd

open Topology Filter Pointwise

/-- A family of additive subgroups on a ring `A` is a subgroups basis if it satisfies some
axioms ensuring there is a topology on `A` which is compatible with the ring structure and
admits this family as a basis of neighborhoods of zero. -/
structure RingSubgroupsBasis {A ι : Type _} [Ring A] (B : ι → AddSubgroup A) : Prop where
  inter : ∀ i j, ∃ k, B k ≤ B i ⊓ B j
  mul : ∀ i, ∃ j, (B j : Set A) * B j ⊆ B i
  leftMul : ∀ x : A, ∀ i, ∃ j, (B j : Set A) ⊆ (fun y : A => x * y) ⁻¹' B i
  rightMul : ∀ x : A, ∀ i, ∃ j, (B j : Set A) ⊆ (fun y : A => y * x) ⁻¹' B i
#align ring_subgroups_basis RingSubgroupsBasis

namespace RingSubgroupsBasis

variable {A ι : Type _} [Ring A]

theorem of_comm {A ι : Type _} [CommRing A] (B : ι → AddSubgroup A)
    (inter : ∀ i j, ∃ k, B k ≤ B i ⊓ B j) (mul : ∀ i, ∃ j, (B j : Set A) * B j ⊆ B i)
    (left_mul : ∀ x : A, ∀ i, ∃ j, (B j : Set A) ⊆ (fun y : A => x * y) ⁻¹' B i) :
    RingSubgroupsBasis B :=
  { inter
    mul
    leftMul
    rightMul := by
      intro x i
      cases' leftMul x i with j hj
      use j
      simpa [mul_comm] using hj }
#align ring_subgroups_basis.of_comm RingSubgroupsBasis.of_comm

/-- Every subgroups basis on a ring leads to a ring filter basis. -/
def toRingFilterBasis [Nonempty ι] {B : ι → AddSubgroup A} (hB : RingSubgroupsBasis B) :
    RingFilterBasis A where
  sets := { U | ∃ i, U = B i }
  Nonempty := by
    inhabit ι
    exact ⟨B default, default, rfl⟩
  inter_sets := by
    rintro _ _ ⟨i, rfl⟩ ⟨j, rfl⟩
    cases' hB.inter i j with k hk
    use B k, k, rfl, hk
  zero' := by
    rintro _ ⟨i, rfl⟩
    exact (B i).zero_mem
  add' := by
    rintro _ ⟨i, rfl⟩
    use B i, i, rfl
    rintro x ⟨y, z, y_in, z_in, rfl⟩
    exact (B i).add_mem y_in z_in
  neg' := by
    rintro _ ⟨i, rfl⟩
    use B i, i, rfl
    intro x x_in
    exact (B i).neg_mem x_in
  conj' := by
    rintro x₀ _ ⟨i, rfl⟩
    use B i, i, rfl
    simp
  mul' := by
    rintro _ ⟨i, rfl⟩
    cases' hB.mul i with k hk
    use B k, k, rfl, hk
  mul_left' := by
    rintro x₀ _ ⟨i, rfl⟩
    cases' hB.left_mul x₀ i with k hk
    use B k, k, rfl, hk
  mul_right' := by
    rintro x₀ _ ⟨i, rfl⟩
    cases' hB.right_mul x₀ i with k hk
    use B k, k, rfl, hk
#align ring_subgroups_basis.to_ring_filter_basis RingSubgroupsBasis.toRingFilterBasis

variable [Nonempty ι] {B : ι → AddSubgroup A} (hB : RingSubgroupsBasis B)

theorem mem_addGroupFilterBasis_iff {V : Set A} :
    V ∈ hB.toRingFilterBasis.toAddGroupFilterBasis ↔ ∃ i, V = B i :=
  Iff.rfl
#align ring_subgroups_basis.mem_add_group_filter_basis_iff RingSubgroupsBasis.mem_addGroupFilterBasis_iff

theorem mem_addGroupFilterBasis (i) : (B i : Set A) ∈ hB.toRingFilterBasis.toAddGroupFilterBasis :=
  ⟨i, rfl⟩
#align ring_subgroups_basis.mem_add_group_filter_basis RingSubgroupsBasis.mem_addGroupFilterBasis

/-- The topology defined from a subgroups basis, admitting the given subgroups as a basis
of neighborhoods of zero. -/
def topology : TopologicalSpace A :=
  hB.toRingFilterBasis.toAddGroupFilterBasis.topology
#align ring_subgroups_basis.topology RingSubgroupsBasis.topology

theorem hasBasis_nhds_zero : HasBasis (@nhds A hB.topology 0) (fun _ => True) fun i => B i :=
  ⟨by
    intro s
    rw [hB.to_ring_filter_basis.to_add_group_filter_basis.nhds_zero_has_basis.mem_iff]
    constructor
    · rintro ⟨-, ⟨i, rfl⟩, hi⟩
      exact ⟨i, trivial, hi⟩
    · rintro ⟨i, -, hi⟩
      exact ⟨B i, ⟨i, rfl⟩, hi⟩⟩
#align ring_subgroups_basis.has_basis_nhds_zero RingSubgroupsBasis.hasBasis_nhds_zero

theorem hasBasis_nhds (a : A) :
    HasBasis (@nhds A hB.topology a) (fun _ => True) fun i => { b | b - a ∈ B i } :=
  ⟨by
    intro s
    rw [(hB.to_ring_filter_basis.to_add_group_filter_basis.nhds_has_basis a).mem_iff]
    simp only [exists_prop, exists_true_left]
    constructor
    · rintro ⟨-, ⟨i, rfl⟩, hi⟩
      use i
      convert hi
      ext b
      constructor
      · intro h
        use b - a, h
        abel
      · rintro ⟨c, hc, rfl⟩
        simpa using hc
    · rintro ⟨i, hi⟩
      use B i, i, rfl
      rw [image_subset_iff]
      rintro b b_in
      apply hi
      simpa using b_in⟩
#align ring_subgroups_basis.has_basis_nhds RingSubgroupsBasis.hasBasis_nhds

/-- Given a subgroups basis, the basis elements as open additive subgroups in the associated
topology. -/
def openAddSubgroup (i : ι) : @OpenAddSubgroup A _ hB.topology :=
  { B i with
    is_open' := by
      letI := hB.topology
      rw [isOpen_iff_mem_nhds]
      intro a a_in
      rw [(hB.has_basis_nhds a).mem_iff]
      use i, trivial
      rintro b b_in
      simpa using (B i).add_mem a_in b_in }
#align ring_subgroups_basis.open_add_subgroup RingSubgroupsBasis.openAddSubgroup

-- see Note [nonarchimedean non instances]
theorem nonarchimedean : @NonarchimedeanRing A _ hB.topology :=
  by
  letI := hB.topology
  constructor
  intro U hU
  obtain ⟨i, -, hi : (B i : Set A) ⊆ U⟩ := hB.has_basis_nhds_zero.mem_iff.mp hU
  exact ⟨hB.open_add_subgroup i, hi⟩
#align ring_subgroups_basis.nonarchimedean RingSubgroupsBasis.nonarchimedean

end RingSubgroupsBasis

variable {ι R A : Type _} [CommRing R] [CommRing A] [Algebra R A]

/-- A family of submodules in a commutative `R`-algebra `A` is a submodules basis if it satisfies
some axioms ensuring there is a topology on `A` which is compatible with the ring structure and
admits this family as a basis of neighborhoods of zero. -/
structure SubmodulesRingBasis (B : ι → Submodule R A) : Prop where
  inter : ∀ i j, ∃ k, B k ≤ B i ⊓ B j
  leftMul : ∀ (a : A) (i), ∃ j, a • B j ≤ B i
  mul : ∀ i, ∃ j, (B j : Set A) * B j ⊆ B i
#align submodules_ring_basis SubmodulesRingBasis

namespace SubmodulesRingBasis

variable {B : ι → Submodule R A} (hB : SubmodulesRingBasis B)

theorem toRing_subgroups_basis (hB : SubmodulesRingBasis B) :
    RingSubgroupsBasis fun i => (B i).toAddSubgroup :=
  by
  apply RingSubgroupsBasis.of_comm (fun i => (B i).toAddSubgroup) hB.inter hB.mul
  intro a i
  rcases hB.left_mul a i with ⟨j, hj⟩
  use j
  rintro b (b_in : b ∈ B j)
  exact hj ⟨b, b_in, rfl⟩
#align submodules_ring_basis.to_ring_subgroups_basis SubmodulesRingBasis.toRing_subgroups_basis

/-- The topology associated to a basis of submodules in an algebra. -/
def topology [Nonempty ι] (hB : SubmodulesRingBasis B) : TopologicalSpace A :=
  hB.toRing_subgroups_basis.topology
#align submodules_ring_basis.topology SubmodulesRingBasis.topology

end SubmodulesRingBasis

variable {M : Type _} [AddCommGroup M] [Module R M]

/-- A family of submodules in an `R`-module `M` is a submodules basis if it satisfies
some axioms ensuring there is a topology on `M` which is compatible with the module structure and
admits this family as a basis of neighborhoods of zero. -/
structure SubmodulesBasis [TopologicalSpace R] (B : ι → Submodule R M) : Prop where
  inter : ∀ i j, ∃ k, B k ≤ B i ⊓ B j
  smul : ∀ (m : M) (i : ι), ∀ᶠ a in 𝓝 (0 : R), a • m ∈ B i
#align submodules_basis SubmodulesBasis

namespace SubmodulesBasis

variable [TopologicalSpace R] [Nonempty ι] {B : ι → Submodule R M} (hB : SubmodulesBasis B)

include hB

/-- The image of a submodules basis is a module filter basis. -/
def toModuleFilterBasis : ModuleFilterBasis R M
    where
  sets := { U | ∃ i, U = B i }
  Nonempty := by
    inhabit ι
    exact ⟨B default, default, rfl⟩
  inter_sets := by
    rintro _ _ ⟨i, rfl⟩ ⟨j, rfl⟩
    cases' hB.inter i j with k hk
    use B k, k, rfl, hk
  zero' := by
    rintro _ ⟨i, rfl⟩
    exact (B i).zero_mem
  add' := by
    rintro _ ⟨i, rfl⟩
    use B i, i, rfl
    rintro x ⟨y, z, y_in, z_in, rfl⟩
    exact (B i).add_mem y_in z_in
  neg' := by
    rintro _ ⟨i, rfl⟩
    use B i, i, rfl
    intro x x_in
    exact (B i).neg_mem x_in
  conj' := by
    rintro x₀ _ ⟨i, rfl⟩
    use B i, i, rfl
    simp
  smul' := by
    rintro _ ⟨i, rfl⟩
    use univ, univ_mem, B i, i, rfl
    rintro _ ⟨a, m, -, hm, rfl⟩
    exact (B i).smul_mem _ hm
  smul_left' := by
    rintro x₀ _ ⟨i, rfl⟩
    use B i, i, rfl
    intro m
    exact (B i).smul_mem _
  smul_right' := by
    rintro m₀ _ ⟨i, rfl⟩
    exact hB.smul m₀ i
#align submodules_basis.to_module_filter_basis SubmodulesBasis.toModuleFilterBasis

/-- The topology associated to a basis of submodules in a module. -/
def topology : TopologicalSpace M :=
  hB.toModuleFilterBasis.toAddGroupFilterBasis.topology
#align submodules_basis.topology SubmodulesBasis.topology

/-- Given a submodules basis, the basis elements as open additive subgroups in the associated
topology. -/
def openAddSubgroup (i : ι) : @OpenAddSubgroup M _ hB.topology :=
  { (B i).toAddSubgroup with
    is_open' := by
      letI := hB.topology
      rw [isOpen_iff_mem_nhds]
      intro a a_in
      rw [(hB.to_module_filter_basis.to_add_group_filter_basis.nhds_has_basis a).mem_iff]
      use B i, i, rfl
      rintro - ⟨b, b_in, rfl⟩
      exact (B i).add_mem a_in b_in }
#align submodules_basis.open_add_subgroup SubmodulesBasis.openAddSubgroup

-- see Note [nonarchimedean non instances]
theorem nonarchimedean (hB : SubmodulesBasis B) : @NonarchimedeanAddGroup M _ hB.topology :=
  by
  letI := hB.topology
  constructor
  intro U hU
  obtain ⟨-, ⟨i, rfl⟩, hi : (B i : Set M) ⊆ U⟩ :=
    hB.to_module_filter_basis.to_add_group_filter_basis.nhds_zero_has_basis.mem_iff.mp hU
  exact ⟨hB.open_add_subgroup i, hi⟩
#align submodules_basis.nonarchimedean SubmodulesBasis.nonarchimedean

library_note "nonarchimedean non instances"/--
The non archimedean subgroup basis lemmas cannot be instances because some instances
(such as `measure_theory.ae_eq_fun.add_monoid ` or `topological_add_group.to_has_continuous_add`)
cause the search for `@topological_add_group β ?m1 ?m2`, i.e. a search for a topological group where
the topology/group structure are unknown. -/

end SubmodulesBasis

section

/-
In this section, we check that, in a `R`-algebra `A` over a ring equipped with a topology,
a basis of `R`-submodules which is compatible with the topology on `R` is also a submodule basis
in the sense of `R`-modules (forgetting about the ring structure on `A`) and those two points of
view definitionaly gives the same topology on `A`.
-/
variable [TopologicalSpace R] {B : ι → Submodule R A} (hB : SubmodulesRingBasis B)
  (hsmul : ∀ (m : A) (i : ι), ∀ᶠ a : R in 𝓝 0, a • m ∈ B i)

theorem SubmodulesRingBasis.toSubmodulesBasis : SubmodulesBasis B :=
  { inter := hB.inter
    smul := hsmul }
#align submodules_ring_basis.to_submodules_basis SubmodulesRingBasis.toSubmodulesBasis

example [Nonempty ι] : hB.topology = (hB.toSubmodulesBasis hsmul).topology :=
  rfl

end

/-- Given a ring filter basis on a commutative ring `R`, define a compatibility condition
on a family of submodules of a `R`-module `M`. This compatibility condition allows to get
a topological module structure. -/
structure RingFilterBasis.SubmodulesBasis (BR : RingFilterBasis R) (B : ι → Submodule R M) :
  Prop where
  inter : ∀ i j, ∃ k, B k ≤ B i ⊓ B j
  smul : ∀ (m : M) (i : ι), ∃ U ∈ BR, U ⊆ (fun a => a • m) ⁻¹' B i
#align ring_filter_basis.submodules_basis RingFilterBasis.SubmodulesBasis

theorem RingFilterBasis.submodulesBasisIsBasis (BR : RingFilterBasis R) {B : ι → Submodule R M}
    (hB : BR.SubmodulesBasis B) : @SubmodulesBasis ι R _ M _ _ BR.topology B :=
  { inter := hB.inter
    smul := by
      letI := BR.topology
      intro m i
      rcases hB.smul m i with ⟨V, V_in, hV⟩
      exact mem_of_superset (BR.to_add_group_filter_basis.mem_nhds_zero V_in) hV }
#align ring_filter_basis.submodules_basis_is_basis RingFilterBasis.submodulesBasisIsBasis

/-- The module filter basis associated to a ring filter basis and a compatible submodule basis.
This allows to build a topological module structure compatible with the given module structure
and the topology associated to the given ring filter basis. -/
def RingFilterBasis.moduleFilterBasis [Nonempty ι] (BR : RingFilterBasis R) {B : ι → Submodule R M}
    (hB : BR.SubmodulesBasis B) : @ModuleFilterBasis R M _ BR.topology _ _ :=
  @SubmodulesBasis.toModuleFilterBasis ι R _ M _ _ BR.topology _ _ (BR.submodulesBasisIsBasis hB)
#align ring_filter_basis.module_filter_basis RingFilterBasis.moduleFilterBasis


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import tactic.basic

/-!
# Extra facts about `prod`

This file defines `prod.swap : α × β → β × α` and proves various simple lemmas about `prod`.
-/

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

@[simp]

namespace prod

@[simp] theorem «forall» {p : α × β → Prop} : (∀ x, p x) ↔ (∀ a b, p (a, b)) :=
⟨assume h a b, h (a, b), assume h ⟨a, b⟩, h a b⟩

@[simp] theorem «exists» {p : α × β → Prop} : (∃ x, p x) ↔ (∃ a b, p (a, b)) :=
⟨assume ⟨⟨a, b⟩, h⟩, ⟨a, b, h⟩, assume ⟨a, b, h⟩, ⟨⟨a, b⟩, h⟩⟩

theorem forall' {p : α → β → Prop} : (∀ x : α × β, p x.1 x.2) ↔ ∀ a b, p a b :=
prod.forall

theorem exists' {p : α → β → Prop} : (∃ x : α × β, p x.1 x.2) ↔ ∃ a b, p a b :=
prod.exists

@[simp] lemma snd_comp_mk (x : α) : prod.snd ∘ (prod.mk x : β → α × β) = id := rfl

@[simp] lemma fst_comp_mk (x : α) : prod.fst ∘ (prod.mk x : β → α × β) = function.const β x := rfl

@[simp] lemma map_mk (f : α → γ) (g : β → δ) (a : α) (b : β) : map f g (a, b) = (f a, g b) := rfl

lemma map_fst (f : α → γ) (g : β → δ) (p : α × β) : (map f g p).1 = f (p.1) := rfl

lemma map_snd (f : α → γ) (g : β → δ) (p : α × β) : (map f g p).2 = g (p.2) := rfl

lemma map_fst' (f : α → γ) (g : β → δ) : (prod.fst ∘ map f g) = f ∘ prod.fst :=
funext $ map_fst f g

lemma map_snd' (f : α → γ) (g : β → δ) : (prod.snd ∘ map f g) = g ∘ prod.snd :=
funext $ map_snd f g

/--
Composing a `prod.map` with another `prod.map` is equal to
a single `prod.map` of composed functions.
-/
lemma map_comp_map {ε ζ : Type*}
  (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) :
  prod.map g g' ∘ prod.map f f' = prod.map (g ∘ f) (g' ∘ f') :=
rfl

/--
Composing a `prod.map` with another `prod.map` is equal to
a single `prod.map` of composed functions, fully applied.
-/
lemma map_map {ε ζ : Type*}
  (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) (x : α × γ) :
  prod.map g g' (prod.map f f' x) = prod.map (g ∘ f) (g' ∘ f') x :=
rfl

@[simp] theorem mk.inj_iff {a₁ a₂ : α} {b₁ b₂ : β} : (a₁, b₁) = (a₂, b₂) ↔ (a₁ = a₂ ∧ b₁ = b₂) :=
⟨prod.mk.inj, by cc⟩

lemma mk.inj_left {α β : Type*} (a : α) :
  function.injective (prod.mk a : β → α × β) :=
by { intros b₁ b₂ h, simpa only [true_and, prod.mk.inj_iff, eq_self_iff_true] using h }

lemma mk.inj_right {α β : Type*} (b : β) :
  function.injective (λ a, prod.mk a b : α → α × β) :=
by { intros b₁ b₂ h, by simpa only [and_true, eq_self_iff_true, mk.inj_iff] using h }

lemma ext_iff {p q : α × β} : p = q ↔ p.1 = q.1 ∧ p.2 = q.2 :=
by rw [← @mk.eta _ _ p, ← @mk.eta _ _ q, mk.inj_iff]

@[ext]
lemma ext {α β} {p q : α × β} (h₁ : p.1 = q.1) (h₂ : p.2 = q.2) : p = q :=
ext_iff.2 ⟨h₁, h₂⟩

lemma map_def {f : α → γ} {g : β → δ} : prod.map f g = λ (p : α × β), (f p.1, g p.2) :=
funext (λ p, ext (map_fst f g p) (map_snd f g p))

lemma id_prod : (λ (p : α × β), (p.1, p.2)) = id :=
funext $ λ ⟨a, b⟩, rfl

lemma map_id : (prod.map (@id α) (@id β)) = id :=
id_prod

lemma fst_surjective [h : nonempty β] : function.surjective (@fst α β) :=
λ x, h.elim $ λ y, ⟨⟨x, y⟩, rfl⟩

lemma snd_surjective [h : nonempty α] : function.surjective (@snd α β) :=
λ y, h.elim $ λ x, ⟨⟨x, y⟩, rfl⟩

lemma fst_injective [subsingleton β] : function.injective (@fst α β) :=
λ x y h, ext h (subsingleton.elim _ _)

lemma snd_injective [subsingleton α] : function.injective (@snd α β) :=
λ x y h, ext (subsingleton.elim _ _) h

/-- Swap the factors of a product. `swap (a, b) = (b, a)` -/
def swap : α × β → β × α := λp, (p.2, p.1)

@[simp] lemma swap_swap : ∀ x : α × β, swap (swap x) = x
| ⟨a, b⟩ := rfl

@[simp] lemma fst_swap {p : α × β} : (swap p).1 = p.2 := rfl

@[simp] lemma snd_swap {p : α × β} : (swap p).2 = p.1 := rfl

@[simp] lemma swap_prod_mk {a : α} {b : β} : swap (a, b) = (b, a) := rfl

@[simp] lemma swap_swap_eq : swap ∘ swap = @id (α × β) :=
funext swap_swap

@[simp] lemma swap_left_inverse : function.left_inverse (@swap α β) swap :=
swap_swap

@[simp] lemma swap_right_inverse : function.right_inverse (@swap α β) swap :=
swap_swap

lemma swap_injective : function.injective (@swap α β) :=
swap_left_inverse.injective

lemma swap_surjective : function.surjective (@swap α β) :=
swap_left_inverse.surjective

lemma swap_bijective : function.bijective (@swap α β) :=
⟨swap_injective, swap_surjective⟩

@[simp] lemma swap_inj {p q : α × β} : swap p = swap q ↔ p = q := swap_injective.eq_iff

lemma eq_iff_fst_eq_snd_eq : ∀{p q : α × β}, p = q ↔ (p.1 = q.1 ∧ p.2 = q.2)
| ⟨p₁, p₂⟩ ⟨q₁, q₂⟩ := by simp

lemma fst_eq_iff : ∀ {p : α × β} {x : α}, p.1 = x ↔ p = (x, p.2)
| ⟨a, b⟩ x := by simp

lemma snd_eq_iff : ∀ {p : α × β} {x : β}, p.2 = x ↔ p = (p.1, x)
| ⟨a, b⟩ x := by simp

theorem lex_def (r : α → α → Prop) (s : β → β → Prop)
  {p q : α × β} : prod.lex r s p q ↔ r p.1 q.1 ∨ p.1 = q.1 ∧ s p.2 q.2 :=
⟨λ h, by cases h; simp *,
 λ h, match p, q, h with
 | (a, b), (c, d), or.inl h := lex.left _ _ h
 | (a, b), (c, d), or.inr ⟨e, h⟩ :=
   by change a = c at e; subst e; exact lex.right _ h
 end⟩

instance lex.decidable [decidable_eq α]
  (r : α → α → Prop) (s : β → β → Prop) [decidable_rel r] [decidable_rel s] :
  decidable_rel (prod.lex r s) :=
λ p q, decidable_of_decidable_of_iff (by apply_instance) (lex_def r s).symm

@[refl] lemma lex.refl_left (r : α → α → Prop) (s : β → β → Prop) [is_refl α r] :
  ∀ x, prod.lex r s x x
| (x₁, x₂) := lex.left _ _ (refl _)

instance is_refl_left {r : α → α → Prop} {s : β → β → Prop} [is_refl α r] :
  is_refl (α × β) (lex r s) :=
⟨lex.refl_left _ _⟩

@[refl] lemma lex.refl_right (r : α → α → Prop) (s : β → β → Prop) [is_refl β s] :
  ∀ x, prod.lex r s x x
| (x₁, x₂) := lex.right _ (refl _)

instance is_refl_right {r : α → α → Prop} {s : β → β → Prop} [is_refl β s] :
  is_refl (α × β) (lex r s) :=
⟨lex.refl_right _ _⟩

@[trans] lemma lex.trans {r : α → α → Prop} {s : β → β → Prop} [is_trans α r] [is_trans β s] :
  ∀ {x y z : α × β}, prod.lex r s x y → prod.lex r s y z → prod.lex r s x z
| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.left _ _ hxy₁) (lex.left _ _ hyz₁) :=
    lex.left _ _ (trans hxy₁ hyz₁)
| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.left _ _ hxy₁) (lex.right _ hyz₂) := lex.left _ _ hxy₁
| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.right _ _) (lex.left _ _ hyz₁) := lex.left _ _ hyz₁
| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.right _ hxy₂) (lex.right _ hyz₂) := lex.right _ (trans hxy₂ hyz₂)

instance {r : α → α → Prop} {s : β → β → Prop} [is_trans α r] [is_trans β s] :
  is_trans (α × β) (lex r s) :=
⟨λ _ _ _, lex.trans⟩

instance {r : α → α → Prop} {s : β → β → Prop} [is_strict_order α r] [is_antisymm β s] :
  is_antisymm (α × β) (lex r s) :=
⟨λ x₁ x₂ h₁₂ h₂₁, match x₁, x₂, h₁₂, h₂₁ with
  | (a₁, b₁), (a₂, b₂), lex.left _ _ hr₁, lex.left _ _ hr₂ := (irrefl a₁ (trans hr₁ hr₂)).elim
  | (a₁, b₁), (a₂, b₂), lex.left _ _ hr₁, lex.right _ _ := (irrefl _ hr₁).elim
  | (a₁, b₁), (a₂, b₂), lex.right _ _, lex.left _ _ hr₂ := (irrefl _ hr₂).elim
  | (a₁, b₁), (a₂, b₂), lex.right _ hs₁, lex.right _ hs₂ := antisymm hs₁ hs₂ ▸ rfl
end⟩

instance is_total_left {r : α → α → Prop} {s : β → β → Prop} [is_total α r] :
  is_total (α × β) (lex r s) :=
⟨λ ⟨a₁, b₁⟩ ⟨a₂, b₂⟩, (is_total.total a₁ a₂).imp (lex.left _ _) (lex.left _ _)⟩

instance is_total_right {r : α → α → Prop} {s : β → β → Prop} [is_trichotomous α r] [is_total β s] :
  is_total (α × β) (lex r s) :=
⟨λ ⟨i, a⟩ ⟨j, b⟩, begin
  obtain hij | rfl | hji := trichotomous_of r i j,
  { exact or.inl (lex.left _ _ hij) },
  { exact (total_of (s) a b).imp (lex.right _) (lex.right _), },
  { exact or.inr (lex.left _ _ hji) }
end⟩

end prod

open prod

namespace function
variables {f : α → γ} {g : β → δ} {f₁ : α → β} {g₁ : γ → δ} {f₂ : β → α} {g₂ : δ → γ}

lemma injective.prod_map (hf : injective f) (hg : injective g) : injective (map f g) :=
λ x y h, ext (hf (ext_iff.1 h).1) (hg $ (ext_iff.1 h).2)

lemma surjective.prod_map (hf : surjective f) (hg : surjective g) : surjective (map f g) :=
λ p, let ⟨x, hx⟩ := hf p.1 in let ⟨y, hy⟩ := hg p.2 in ⟨(x, y), prod.ext hx hy⟩

lemma bijective.prod_map (hf : bijective f) (hg : bijective g) : bijective (map f g) :=
⟨hf.1.prod_map hg.1, hf.2.prod_map hg.2⟩

lemma left_inverse.prod_map (hf : left_inverse f₁ f₂) (hg : left_inverse g₁ g₂) :
  left_inverse (map f₁ g₁) (map f₂ g₂) :=
λ a, by rw [prod.map_map, hf.comp_eq_id, hg.comp_eq_id, map_id, id]

lemma right_inverse.prod_map :
  right_inverse f₁ f₂ → right_inverse g₁ g₂ → right_inverse (map f₁ g₁) (map f₂ g₂) :=
left_inverse.prod_map

lemma involutive.prod_map {f : α → α} {g : β → β} :
  involutive f → involutive g → involutive (map f g) :=
left_inverse.prod_map

end function


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import algebra.add_torsor
import computational_monads.asymptotics.polynomial_time
import computational_monads.asymptotics.negligable
import computational_monads.coercions.sim_oracle

/-!
# Hard Homogeneous Spaces

This file builds up the definition of a hard homogeneous space, an extension of a group action
on some set such that the action of each group element defines a bijection.
We use mathlib's `add_torsor` type class to represent the bijection property,
and further extend this with various assumptions about run times of computations.

`algorithmic_homogeneous_space` requires the group operations to be efficiently computable.
`hard_homogeneous_space` further requires vectorization and parallelization are hard.
-/

open_locale big_operators ennreal
open oracle_comp oracle_spec

/-- An `algorithmic_homogenous_space` is a homogenous space where operations are all `poly_time`.
  Uses mathlib's definition of an `add_torsor`, which is a bijective group action -/
class algorithmic_homogenous_space (G X : Type) [fintype G] [fintype X]
  [decidable_eq G] [decidable_eq X] [add_group G] extends add_torsor G X :=
(poly_time_add : poly_time (λ x, x.1 + x.2 : G × G → G))
(poly_time_inv : poly_time (λ x, -x : G → G))
(poly_time_vadd : poly_time (λ x, x.1 +ᵥ x.2 : G × X → X))
(poly_time_eq_G : poly_time (λ x, x.1 = x.2 : G × G → bool))
(poly_time_eq_X : poly_time (λ x, x.1 = x.2 : X × X → bool))
(poly_time_rnd_G : poly_time_oracle_comp (λ (_ : unit), $ᵗ G))

namespace algorithmic_homogenous_space

variables {G X : Type} [fintype G] [fintype X] [decidable_eq G] [decidable_eq X]
  [add_group G] [algorithmic_homogenous_space G X]

structure vectorization_adversary (G X : Type) : Type 1 :=
(adv : X × X → oracle_comp uniform_selecting G) -- TODO: name `adv` -> `alg`?
-- (adv_poly_time : poly_time_oracle_comp adv)

namespace vectorization_adversary

/-- Analogue of Discrete-logarithm asumption game -/
noncomputable def experiment (adversary : vectorization_adversary G X) :
  oracle_comp uniform_selecting bool :=
do {x₁ ←$ᵗ X, x₂ ←$ᵗ X, g ← adversary.adv (x₁, x₂), return (g = x₁ -ᵥ x₂)}

/-- Vectorization advantage of an adversary in the vectorization experiment. -/
noncomputable def advantage (adversary : vectorization_adversary G X) : ℝ≥0∞ :=
⁅(=) tt | experiment adversary⁆

/-- The adversary's advantage at vectorization is the average over all possible pairs of points
of their advantage at vectorizing those specific points. -/
lemma advantage_eq_tsum (adversary : vectorization_adversary G X) : adversary.advantage =
  (∑' x₁ x₂, ⁅(=) (x₁ -ᵥ x₂) | adversary.adv (x₁, x₂)⁆) / (fintype.card X) ^ 2 :=
calc adversary.advantage = ⁅(=) tt | experiment adversary⁆ : rfl
  ... = ⁅experiment adversary⁆ tt : by rw [prob_event_eq_eq_eval_dist]
  ... = ((fintype.card X)⁻¹ ^ 2) * (∑' x₁ x₂, ⁅adversary.adv (x₁, x₂)⁆ (x₁ -ᵥ x₂)) :
  begin
    simp only [experiment, eval_dist_bind_apply_eq_tsum ($ᵗ X), pow_two, ← mul_assoc,
      eval_dist_uniform_select_fintype_apply, ennreal.tsum_mul_left],
    refine congr_arg (λ x, _ * x) (tsum_congr (λ x₁, tsum_congr (λ x₂, _))),
    refine (eval_dist_bind_return_apply_eq_single (adversary.adv (x₁, x₂)) _ tt (x₁ -ᵥ x₂)) _,
    simp only [set.preimage, set.mem_singleton_iff, to_bool_iff, set.set_of_eq_eq_singleton],
  end
  ... = (∑' x₁ x₂, ⁅adversary.adv (x₁, x₂)⁆ (x₁ -ᵥ x₂)) / (fintype.card X) ^ 2 :
    by rw [div_eq_mul_inv, ennreal.inv_pow, mul_comm]
  ... = (∑' x₁ x₂, ⁅(=) (x₁ -ᵥ x₂) | adversary.adv (x₁, x₂)⁆) / (fintype.card X) ^ 2 :
    by simp_rw [prob_event_eq_eq_eval_dist]

end vectorization_adversary

namespace parallelization

structure adversary (G X : Type) :=
(adv : X × X × X → oracle_comp uniform_selecting X)
(adv_poly_time : poly_time_oracle_comp adv)

/-- Analogue of the decisional Diffie-Helman experiment -/
noncomputable def experiment (adversary : adversary G X) :
  oracle_comp uniform_selecting bool :=
do{ x₁ ←$ᵗ X, x₂ ←$ᵗ X, x₃ ←$ᵗ X, x₄ ← adversary.adv (x₁, x₂, x₃), return (x₂ -ᵥ x₁ = x₄ -ᵥ x₃) }

/-- Parallelization advantage of an adversary in parallelization experiment -/
noncomputable def advantage (adversary : adversary G X) : ℝ≥0∞ :=
⁅ (=) tt | experiment adversary ⁆

end parallelization

end algorithmic_homogenous_space

open algorithmic_homogenous_space

/-- A `hard_homogenous_space` is a -/
class hard_homogenous_space (G X : ℕ → Type) [∀ n, fintype $ G n] [∀ n, fintype $ X n]
  [∀ n, decidable_eq $ G n] [∀ n, decidable_eq $ X n]
  [∀ n, add_group $ G n] [∀ n, algorithmic_homogenous_space (G n) (X n)] :=
(vectorization_hard : ∀ (adversary : Π (sp : ℕ), vectorization_adversary (G sp) (X sp)),
  negligable (λ sp, (adversary sp).advantage ))
(parallelization_hard : ∀ (adversary : Π (sp : ℕ), parallelization.adversary (G sp) (X sp)),
  negligable (λ sp, parallelization.advantage (adversary sp)))


import ..add
import ..transition.alt_seq

open mcrl2

variable {α : Type}
variable [comm_semigroup_with_zero α]

/- This relation is used to prove the seq_assoc rule for the mcrl2' quotient.-/
inductive R_seq_assoc {x y z: mcrl2 α} :
mcrl2 α → mcrl2 α → Prop
| basel : R_seq_assoc (x ⬝ y ⬝ z)   (x ⬝ (y ⬝ z))
| baser : R_seq_assoc (x ⬝ (y ⬝ z)) (x ⬝ y ⬝ z)
| stepl {x a x'} (h_l : R_seq_assoc (x ⬝ y ⬝ z) (x ⬝ (y ⬝ z))) (h_r : R_seq_assoc (x ⬝ (y ⬝ z)) (x ⬝ y ⬝ z))
  (h₂ : transition x a (some x')) :
  R_seq_assoc (x' ⬝ y ⬝ z) (x' ⬝ (y ⬝ z))
| stepr {x a x'} (h_l : R_seq_assoc (x ⬝ y ⬝ z) (x ⬝ (y ⬝ z))) (h_r : R_seq_assoc (x ⬝ (y ⬝ z)) (x ⬝ y ⬝ z) )
  (h₂ : transition x a (some x')) : R_seq_assoc (x' ⬝ (y ⬝ z)) (x' ⬝ y ⬝ z)
| refl {x} : R_seq_assoc x x

lemma R_seq_assoc.symm {x y z : mcrl2 α}:
symmetric (@R_seq_assoc α _ x y z) :=
begin
  intros x₁ y₁ h,
  cases h,
  { exact R_seq_assoc.baser},
  { exact R_seq_assoc.basel},
  { apply R_seq_assoc.stepr, repeat {assumption}},
  { apply R_seq_assoc.stepl, repeat {assumption}},
  { assumption}
end

/- Here we prove the axioms for the mcrl2' quotient.-/
lemma mcrl2.alt_comm {x y : mcrl2 α} : x + y ≈ y + x :=
by exact R_add_congr (transition.alt_comm x y)

lemma mcrl2.alt_assoc {x y z : mcrl2 α} : x + (y + z) ≈ x + y + z :=
by exact R_add_congr (transition.alt_assoc x y z)

lemma mcrl2.alt_idem {x : mcrl2 α} : x + x ≈ x :=
by exact R_add_congr (transition.alt_idem x)

lemma mcrl2.alt_dist {x y z : mcrl2 α} : (x + y) ⬝ z ≈ x ⬝ z + y ⬝ z :=
by exact R_add_congr (transition.alt_dist x y z)

lemma mcrl2.seq_assoc {x y z : mcrl2 α} : (x ⬝ y) ⬝ z ≈ x ⬝ (y ⬝ z) :=
begin
  apply exists.intro R_seq_assoc,
  apply and.intro,
  exact R_seq_assoc.basel,
  apply and.intro,
  { intros x₁ y₁ x₁' a₁ h₁ h₂,
    cases h₁,
    { cases h₂,
      cases h₂_h,
      simp only [transition.seq_iff, ←exists_and_distrib_right, and_assoc, exists_comm, exists_eq_left],
      apply exists.intro h₂_h_z,
      apply and.intro,
      assumption,
      cases h₂_h_z,
      { apply option.rel.some,
        exact R_seq_assoc.refl},
      { apply option.rel.some,
        apply R_seq_assoc.stepl,
        exact h₁,
        exact R_seq_assoc.baser,
        assumption}},
    { cases h₂,
      simp only [transition.seq_iff, ←exists_and_distrib_right, and_assoc, exists_comm, exists_eq_left],
      cases h₂_z,
      { apply exists.intro none,
        apply and.intro,
        assumption,
        apply option.rel.some,
        exact R_seq_assoc.refl},
      { apply exists.intro (some h₂_z),
        apply and.intro,
        assumption,
        apply option.rel.some,
        apply R_seq_assoc.stepr,
        exact R_seq_assoc.basel,
        repeat {assumption}}},
    { cases h₂,
      simp only [transition.seq_iff, ←exists_and_distrib_right, and_assoc, exists_comm, exists_eq_left],
      cases h₂_h,
      apply exists.intro h₂_h_z,
      apply and.intro,
      assumption,
      cases h₂_h_z,
      { apply option.rel.some,
        exact R_seq_assoc.refl},
      { apply option.rel.some,
        apply R_seq_assoc.stepl,
        exact h₁,
        apply R_seq_assoc.stepr,
        exact h₁_h_l,
        repeat {assumption}}},
    { cases h₂,
      simp only [transition.seq_iff, ←exists_and_distrib_right, and_assoc, exists_comm, exists_eq_left],
      apply exists.intro h₂_z,
      apply and.intro,
      assumption,
      cases h₂_z,
      { apply option.rel.some,
        exact R_seq_assoc.refl},
      { apply option.rel.some,
        apply R_seq_assoc.stepr,
        apply R_seq_assoc.stepl,
        exact h₁_h_l,
        repeat {assumption}}},
    { apply exists.intro x₁',
      apply and.intro,
      assumption,
      cases x₁',
      exact option.rel.none,
      apply option.rel.some,
      exact R_seq_assoc.refl}},
  { exact R_seq_assoc.symm}
end


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

! This file was ported from Lean 3 source module topology.algebra.uniform_field
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.UniformRing
import Mathbin.Topology.Algebra.Field
import Mathbin.FieldTheory.Subfield

/-!
# Completion of topological fields

The goal of this file is to prove the main part of Proposition 7 of Bourbaki GT III 6.8 :

The completion `hat K` of a Hausdorff topological field is a field if the image under
the mapping `x ↦ x⁻¹` of every Cauchy filter (with respect to the additive uniform structure)
which does not have a cluster point at `0` is a Cauchy filter
(with respect to the additive uniform structure).

Bourbaki does not give any detail here, he refers to the general discussion of extending
functions defined on a dense subset with values in a complete Hausdorff space. In particular
the subtlety about clustering at zero is totally left to readers.

Note that the separated completion of a non-separated topological field is the zero ring, hence
the separation assumption is needed. Indeed the kernel of the completion map is the closure of
zero which is an ideal. Hence it's either zero (and the field is separated) or the full field,
which implies one is sent to zero and the completion ring is trivial.

The main definition is `completable_top_field` which packages the assumptions as a Prop-valued
type class and the main results are the instances `uniform_space.completion.field` and
`uniform_space.completion.topological_division_ring`.
-/

noncomputable section

open Classical uniformity Topology

open Set UniformSpace UniformSpace.Completion Filter

variable (K : Type _) [Field K] [UniformSpace K]

-- mathport name: exprhat
local notation "hat" => Completion

/-- A topological field is completable if it is separated and the image under
the mapping x ↦ x⁻¹ of every Cauchy filter (with respect to the additive uniform structure)
which does not have a cluster point at 0 is a Cauchy filter
(with respect to the additive uniform structure). This ensures the completion is
a field.
-/
class CompletableTopField extends SeparatedSpace K : Prop where
  nice : ∀ F : Filter K, Cauchy F → 𝓝 0 ⊓ F = ⊥ → Cauchy (map (fun x => x⁻¹) F)
#align completable_top_field CompletableTopField

namespace UniformSpace

namespace Completion

instance (priority := 100) [SeparatedSpace K] : Nontrivial (hat K) :=
  ⟨⟨0, 1, fun h => zero_ne_one <| (uniformEmbedding_coe K).inj h⟩⟩

variable {K}

/-- extension of inversion to the completion of a field. -/
def hatInv : hat K → hat K :=
  denseInducing_coe.extend fun x : K => (coe x⁻¹ : hat K)
#align uniform_space.completion.hat_inv UniformSpace.Completion.hatInv

theorem continuous_hatInv [CompletableTopField K] {x : hat K} (h : x ≠ 0) : ContinuousAt hatInv x :=
  by
  haveI : T3Space (hat K) := completion.t3_space K
  refine' dense_inducing_coe.continuous_at_extend _
  apply mem_of_superset (compl_singleton_mem_nhds h)
  intro y y_ne
  rw [mem_compl_singleton_iff] at y_ne
  apply CompleteSpace.complete
  rw [← Filter.map_map]
  apply Cauchy.map _ (completion.uniform_continuous_coe K)
  apply CompletableTopField.nice
  · haveI := dense_inducing_coe.comap_nhds_ne_bot y
    apply cauchy_nhds.comap
    · rw [completion.comap_coe_eq_uniformity]
      exact le_rfl
  · have eq_bot : 𝓝 (0 : hat K) ⊓ 𝓝 y = ⊥ := by
      by_contra h
      exact y_ne (eq_of_nhds_neBot <| ne_bot_iff.mpr h).symm
    erw [dense_inducing_coe.nhds_eq_comap (0 : K), ← Filter.comap_inf, eq_bot]
    exact comap_bot
#align uniform_space.completion.continuous_hat_inv UniformSpace.Completion.continuous_hatInv

/-
The value of `hat_inv` at zero is not really specified, although it's probably zero.
Here we explicitly enforce the `inv_zero` axiom.
-/
instance : Inv (hat K) :=
  ⟨fun x => if x = 0 then 0 else hatInv x⟩

variable [TopologicalDivisionRing K]

theorem hatInv_extends {x : K} (h : x ≠ 0) : hatInv (x : hat K) = coe (x⁻¹ : K) :=
  denseInducing_coe.extend_eq_at ((continuous_coe K).ContinuousAt.comp (continuousAt_inv₀ h))
#align uniform_space.completion.hat_inv_extends UniformSpace.Completion.hatInv_extends

variable [CompletableTopField K]

@[norm_cast]
theorem coe_inv (x : K) : (x : hat K)⁻¹ = ((x⁻¹ : K) : hat K) :=
  by
  by_cases h : x = 0
  · rw [h, inv_zero]
    dsimp [Inv.inv]
    norm_cast
    simp
  · conv_lhs => dsimp [Inv.inv]
    rw [if_neg]
    · exact hat_inv_extends h
    · exact fun H => h (dense_embedding_coe.inj H)
#align uniform_space.completion.coe_inv UniformSpace.Completion.coe_inv

variable [UniformAddGroup K]

theorem mul_hatInv_cancel {x : hat K} (x_ne : x ≠ 0) : x * hatInv x = 1 :=
  by
  haveI : T1Space (hat K) := T2Space.t1Space
  let f := fun x : hat K => x * hat_inv x
  let c := (coe : K → hat K)
  change f x = 1
  have cont : ContinuousAt f x :=
    by
    letI : TopologicalSpace (hat K × hat K) := Prod.topologicalSpace
    have : ContinuousAt (fun y : hat K => ((y, hat_inv y) : hat K × hat K)) x :=
      continuous_id.continuous_at.prod (continuous_hat_inv x_ne)
    exact (_root_.continuous_mul.continuous_at.comp this : _)
  have clo : x ∈ closure (c '' {0}ᶜ) :=
    by
    have := dense_inducing_coe.dense x
    rw [← image_univ, show (univ : Set K) = {0} ∪ {0}ᶜ from (union_compl_self _).symm,
      image_union] at this
    apply mem_closure_of_mem_closure_union this
    rw [image_singleton]
    exact compl_singleton_mem_nhds x_ne
  have fxclo : f x ∈ closure (f '' (c '' {0}ᶜ)) := mem_closure_image cont clo
  have : f '' (c '' {0}ᶜ) ⊆ {1} := by
    rw [image_image]
    rintro _ ⟨z, z_ne, rfl⟩
    rw [mem_singleton_iff]
    rw [mem_compl_singleton_iff] at z_ne
    dsimp [c, f]
    rw [hat_inv_extends z_ne]
    norm_cast
    rw [mul_inv_cancel z_ne]
  replace fxclo := closure_mono this fxclo
  rwa [closure_singleton, mem_singleton_iff] at fxclo
#align uniform_space.completion.mul_hat_inv_cancel UniformSpace.Completion.mul_hatInv_cancel

instance : Field (hat K) :=
  { Completion.hasInv,
    (by infer_instance :
      CommRing
        (hat
          K)) with
    exists_pair_ne := ⟨0, 1, fun h => zero_ne_one ((uniformEmbedding_coe K).inj h)⟩
    mul_inv_cancel := fun x x_ne => by
      dsimp [Inv.inv]
      simp [if_neg x_ne, mul_hat_inv_cancel x_ne]
    inv_zero := show ((0 : K) : hat K)⁻¹ = ((0 : K) : hat K) by rw [coe_inv, inv_zero] }

instance : TopologicalDivisionRing (hat K) :=
  { Completion.topologicalRing with
    continuousAt_inv₀ := by
      intro x x_ne
      have : { y | hat_inv y = y⁻¹ } ∈ 𝓝 x :=
        haveI : {(0 : hat K)}ᶜ ⊆ { y : hat K | hat_inv y = y⁻¹ } :=
          by
          intro y y_ne
          rw [mem_compl_singleton_iff] at y_ne
          dsimp [Inv.inv]
          rw [if_neg y_ne]
        mem_of_superset (compl_singleton_mem_nhds x_ne) this
      exact ContinuousAt.congr (continuous_hat_inv x_ne) this }

end Completion

end UniformSpace

variable (L : Type _) [Field L] [UniformSpace L] [CompletableTopField L]

instance Subfield.completableTopField (K : Subfield L) : CompletableTopField K :=
  { Subtype.separatedSpace (K : Set L) with
    nice := by
      intro F F_cau inf_F
      let i : K →+* L := K.subtype
      have hi : UniformInducing i := uniform_embedding_subtype_coe.to_uniform_inducing
      rw [← hi.cauchy_map_iff] at F_cau⊢
      rw [map_comm
          (show (i ∘ fun x => x⁻¹) = (fun x => x⁻¹) ∘ i
            by
            ext
            rfl)]
      apply CompletableTopField.nice _ F_cau
      rw [← Filter.push_pull', ← map_zero i, ← hi.inducing.nhds_eq_comap, inf_F, Filter.map_bot] }
#align subfield.completable_top_field Subfield.completableTopField

instance (priority := 100) completableTopField_of_complete (L : Type _) [Field L] [UniformSpace L]
    [TopologicalDivisionRing L] [SeparatedSpace L] [CompleteSpace L] : CompletableTopField L :=
  { ‹SeparatedSpace L› with
    nice := fun F cau_F hF => by
      haveI : ne_bot F := cau_F.1
      rcases CompleteSpace.complete cau_F with ⟨x, hx⟩
      have hx' : x ≠ 0 := by
        rintro rfl
        rw [inf_eq_right.mpr hx] at hF
        exact cau_F.1.Ne hF
      exact
        Filter.Tendsto.cauchy_map
          (calc
            map (fun x => x⁻¹) F ≤ map (fun x => x⁻¹) (𝓝 x) := map_mono hx
            _ ≤ 𝓝 x⁻¹ := continuous_at_inv₀ hx'
            ) }
#align completable_top_field_of_complete completableTopField_of_complete


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

! This file was ported from Lean 3 source module dynamics.minimal
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.GroupAction.Basic
import Mathbin.Topology.Algebra.ConstMulAction

/-!
# Minimal action of a group

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

In this file we define an action of a monoid `M` on a topological space `α` to be *minimal* if the
`M`-orbit of every point `x : α` is dense. We also provide an additive version of this definition
and prove some basic facts about minimal actions.

## TODO

* Define a minimal set of an action.

## Tags

group action, minimal
-/

open Pointwise

#print AddAction.IsMinimal /-
/-- An action of an additive monoid `M` on a topological space is called *minimal* if the `M`-orbit
of every point `x : α` is dense. -/
class AddAction.IsMinimal (M α : Type _) [AddMonoid M] [TopologicalSpace α] [AddAction M α] :
  Prop where
  dense_orbit : ∀ x : α, Dense (AddAction.orbit M x)
#align add_action.is_minimal AddAction.IsMinimal
-/

#print MulAction.IsMinimal /-
/-- An action of a monoid `M` on a topological space is called *minimal* if the `M`-orbit of every
point `x : α` is dense. -/
@[to_additive]
class MulAction.IsMinimal (M α : Type _) [Monoid M] [TopologicalSpace α] [MulAction M α] :
  Prop where
  dense_orbit : ∀ x : α, Dense (MulAction.orbit M x)
#align mul_action.is_minimal MulAction.IsMinimal
#align add_action.is_minimal AddAction.IsMinimal
-/

open MulAction Set

variable (M G : Type _) {α : Type _} [Monoid M] [Group G] [TopologicalSpace α] [MulAction M α]
  [MulAction G α]

/- warning: mul_action.dense_orbit -> MulAction.dense_orbit is a dubious translation:
lean 3 declaration is
  forall (M : Type.{u1}) {α : Type.{u2}} [_inst_1 : Monoid.{u1} M] [_inst_3 : TopologicalSpace.{u2} α] [_inst_4 : MulAction.{u1, u2} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u1, u2} M α _inst_1 _inst_3 _inst_4] (x : α), Dense.{u2} α _inst_3 (MulAction.orbit.{u1, u2} M α _inst_1 _inst_4 x)
but is expected to have type
  forall (M : Type.{u2}) {α : Type.{u1}} [_inst_1 : Monoid.{u2} M] [_inst_3 : TopologicalSpace.{u1} α] [_inst_4 : MulAction.{u2, u1} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u2, u1} M α _inst_1 _inst_3 _inst_4] (x : α), Dense.{u1} α _inst_3 (MulAction.orbit.{u2, u1} M α _inst_1 _inst_4 x)
Case conversion may be inaccurate. Consider using '#align mul_action.dense_orbit MulAction.dense_orbitₓ'. -/
@[to_additive]
theorem MulAction.dense_orbit [IsMinimal M α] (x : α) : Dense (orbit M x) :=
  MulAction.IsMinimal.dense_orbit x
#align mul_action.dense_orbit MulAction.dense_orbit
#align add_action.dense_orbit AddAction.dense_orbit

/- warning: dense_range_smul -> denseRange_smul is a dubious translation:
lean 3 declaration is
  forall (M : Type.{u1}) {α : Type.{u2}} [_inst_1 : Monoid.{u1} M] [_inst_3 : TopologicalSpace.{u2} α] [_inst_4 : MulAction.{u1, u2} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u1, u2} M α _inst_1 _inst_3 _inst_4] (x : α), DenseRange.{u2, u1} α _inst_3 M (fun (c : M) => SMul.smul.{u1, u2} M α (MulAction.toHasSmul.{u1, u2} M α _inst_1 _inst_4) c x)
but is expected to have type
  forall (M : Type.{u2}) {α : Type.{u1}} [_inst_1 : Monoid.{u2} M] [_inst_3 : TopologicalSpace.{u1} α] [_inst_4 : MulAction.{u2, u1} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u2, u1} M α _inst_1 _inst_3 _inst_4] (x : α), DenseRange.{u1, u2} α _inst_3 M (fun (c : M) => HSMul.hSMul.{u2, u1, u1} M α α (instHSMul.{u2, u1} M α (MulAction.toSMul.{u2, u1} M α _inst_1 _inst_4)) c x)
Case conversion may be inaccurate. Consider using '#align dense_range_smul denseRange_smulₓ'. -/
@[to_additive]
theorem denseRange_smul [IsMinimal M α] (x : α) : DenseRange fun c : M => c • x :=
  MulAction.dense_orbit M x
#align dense_range_smul denseRange_smul
#align dense_range_vadd denseRange_vadd

#print MulAction.isMinimal_of_pretransitive /-
@[to_additive]
instance (priority := 100) MulAction.isMinimal_of_pretransitive [IsPretransitive M α] :
    IsMinimal M α :=
  ⟨fun x => (surjective_smul M x).DenseRange⟩
#align mul_action.is_minimal_of_pretransitive MulAction.isMinimal_of_pretransitive
#align add_action.is_minimal_of_pretransitive AddAction.isMinimal_of_pretransitive
-/

/- warning: is_open.exists_smul_mem -> IsOpen.exists_smul_mem is a dubious translation:
lean 3 declaration is
  forall (M : Type.{u1}) {α : Type.{u2}} [_inst_1 : Monoid.{u1} M] [_inst_3 : TopologicalSpace.{u2} α] [_inst_4 : MulAction.{u1, u2} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u1, u2} M α _inst_1 _inst_3 _inst_4] (x : α) {U : Set.{u2} α}, (IsOpen.{u2} α _inst_3 U) -> (Set.Nonempty.{u2} α U) -> (Exists.{succ u1} M (fun (c : M) => Membership.Mem.{u2, u2} α (Set.{u2} α) (Set.hasMem.{u2} α) (SMul.smul.{u1, u2} M α (MulAction.toHasSmul.{u1, u2} M α _inst_1 _inst_4) c x) U))
but is expected to have type
  forall (M : Type.{u2}) {α : Type.{u1}} [_inst_1 : Monoid.{u2} M] [_inst_3 : TopologicalSpace.{u1} α] [_inst_4 : MulAction.{u2, u1} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u2, u1} M α _inst_1 _inst_3 _inst_4] (x : α) {U : Set.{u1} α}, (IsOpen.{u1} α _inst_3 U) -> (Set.Nonempty.{u1} α U) -> (Exists.{succ u2} M (fun (c : M) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) (HSMul.hSMul.{u2, u1, u1} M α α (instHSMul.{u2, u1} M α (MulAction.toSMul.{u2, u1} M α _inst_1 _inst_4)) c x) U))
Case conversion may be inaccurate. Consider using '#align is_open.exists_smul_mem IsOpen.exists_smul_memₓ'. -/
@[to_additive]
theorem IsOpen.exists_smul_mem [IsMinimal M α] (x : α) {U : Set α} (hUo : IsOpen U)
    (hne : U.Nonempty) : ∃ c : M, c • x ∈ U :=
  (denseRange_smul M x).exists_mem_open hUo hne
#align is_open.exists_smul_mem IsOpen.exists_smul_mem
#align is_open.exists_vadd_mem IsOpen.exists_vadd_mem

/- warning: is_open.Union_preimage_smul -> IsOpen.unionᵢ_preimage_smul is a dubious translation:
lean 3 declaration is
  forall (M : Type.{u1}) {α : Type.{u2}} [_inst_1 : Monoid.{u1} M] [_inst_3 : TopologicalSpace.{u2} α] [_inst_4 : MulAction.{u1, u2} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u1, u2} M α _inst_1 _inst_3 _inst_4] {U : Set.{u2} α}, (IsOpen.{u2} α _inst_3 U) -> (Set.Nonempty.{u2} α U) -> (Eq.{succ u2} (Set.{u2} α) (Set.unionᵢ.{u2, succ u1} α M (fun (c : M) => Set.preimage.{u2, u2} α α (SMul.smul.{u1, u2} M α (MulAction.toHasSmul.{u1, u2} M α _inst_1 _inst_4) c) U)) (Set.univ.{u2} α))
but is expected to have type
  forall (M : Type.{u2}) {α : Type.{u1}} [_inst_1 : Monoid.{u2} M] [_inst_3 : TopologicalSpace.{u1} α] [_inst_4 : MulAction.{u2, u1} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u2, u1} M α _inst_1 _inst_3 _inst_4] {U : Set.{u1} α}, (IsOpen.{u1} α _inst_3 U) -> (Set.Nonempty.{u1} α U) -> (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α M (fun (c : M) => Set.preimage.{u1, u1} α α ((fun (x._@.Mathlib.Dynamics.Minimal._hyg.339 : M) (x._@.Mathlib.Dynamics.Minimal._hyg.341 : α) => HSMul.hSMul.{u2, u1, u1} M α α (instHSMul.{u2, u1} M α (MulAction.toSMul.{u2, u1} M α _inst_1 _inst_4)) x._@.Mathlib.Dynamics.Minimal._hyg.339 x._@.Mathlib.Dynamics.Minimal._hyg.341) c) U)) (Set.univ.{u1} α))
Case conversion may be inaccurate. Consider using '#align is_open.Union_preimage_smul IsOpen.unionᵢ_preimage_smulₓ'. -/
@[to_additive]
theorem IsOpen.unionᵢ_preimage_smul [IsMinimal M α] {U : Set α} (hUo : IsOpen U)
    (hne : U.Nonempty) : (⋃ c : M, (· • ·) c ⁻¹' U) = univ :=
  unionᵢ_eq_univ_iff.2 fun x => hUo.exists_smul_mem M x hne
#align is_open.Union_preimage_smul IsOpen.unionᵢ_preimage_smul
#align is_open.Union_preimage_vadd IsOpen.unionᵢ_preimage_vadd

/- warning: is_open.Union_smul -> IsOpen.unionᵢ_smul is a dubious translation:
lean 3 declaration is
  forall (G : Type.{u1}) {α : Type.{u2}} [_inst_2 : Group.{u1} G] [_inst_3 : TopologicalSpace.{u2} α] [_inst_5 : MulAction.{u1, u2} G α (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_2))] [_inst_6 : MulAction.IsMinimal.{u1, u2} G α (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_2)) _inst_3 _inst_5] {U : Set.{u2} α}, (IsOpen.{u2} α _inst_3 U) -> (Set.Nonempty.{u2} α U) -> (Eq.{succ u2} (Set.{u2} α) (Set.unionᵢ.{u2, succ u1} α G (fun (g : G) => SMul.smul.{u1, u2} G (Set.{u2} α) (Set.smulSet.{u1, u2} G α (MulAction.toHasSmul.{u1, u2} G α (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_2)) _inst_5)) g U)) (Set.univ.{u2} α))
but is expected to have type
  forall (G : Type.{u2}) {α : Type.{u1}} [_inst_2 : Group.{u2} G] [_inst_3 : TopologicalSpace.{u1} α] [_inst_5 : MulAction.{u2, u1} G α (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_2))] [_inst_6 : MulAction.IsMinimal.{u2, u1} G α (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_2)) _inst_3 _inst_5] {U : Set.{u1} α}, (IsOpen.{u1} α _inst_3 U) -> (Set.Nonempty.{u1} α U) -> (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α G (fun (g : G) => HSMul.hSMul.{u2, u1, u1} G (Set.{u1} α) (Set.{u1} α) (instHSMul.{u2, u1} G (Set.{u1} α) (Set.smulSet.{u2, u1} G α (MulAction.toSMul.{u2, u1} G α (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_2)) _inst_5))) g U)) (Set.univ.{u1} α))
Case conversion may be inaccurate. Consider using '#align is_open.Union_smul IsOpen.unionᵢ_smulₓ'. -/
@[to_additive]
theorem IsOpen.unionᵢ_smul [IsMinimal G α] {U : Set α} (hUo : IsOpen U) (hne : U.Nonempty) :
    (⋃ g : G, g • U) = univ :=
  unionᵢ_eq_univ_iff.2 fun x =>
    let ⟨g, hg⟩ := hUo.exists_smul_mem G x hne
    ⟨g⁻¹, _, hg, inv_smul_smul _ _⟩
#align is_open.Union_smul IsOpen.unionᵢ_smul
#align is_open.Union_vadd IsOpen.unionᵢ_vadd

/- warning: is_compact.exists_finite_cover_smul -> IsCompact.exists_finite_cover_smul is a dubious translation:
lean 3 declaration is
  forall (G : Type.{u1}) {α : Type.{u2}} [_inst_2 : Group.{u1} G] [_inst_3 : TopologicalSpace.{u2} α] [_inst_5 : MulAction.{u1, u2} G α (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_2))] [_inst_6 : MulAction.IsMinimal.{u1, u2} G α (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_2)) _inst_3 _inst_5] [_inst_7 : ContinuousConstSMul.{u1, u2} G α _inst_3 (MulAction.toHasSmul.{u1, u2} G α (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_2)) _inst_5)] {K : Set.{u2} α} {U : Set.{u2} α}, (IsCompact.{u2} α _inst_3 K) -> (IsOpen.{u2} α _inst_3 U) -> (Set.Nonempty.{u2} α U) -> (Exists.{succ u1} (Finset.{u1} G) (fun (I : Finset.{u1} G) => HasSubset.Subset.{u2} (Set.{u2} α) (Set.hasSubset.{u2} α) K (Set.unionᵢ.{u2, succ u1} α G (fun (g : G) => Set.unionᵢ.{u2, 0} α (Membership.Mem.{u1, u1} G (Finset.{u1} G) (Finset.hasMem.{u1} G) g I) (fun (H : Membership.Mem.{u1, u1} G (Finset.{u1} G) (Finset.hasMem.{u1} G) g I) => SMul.smul.{u1, u2} G (Set.{u2} α) (Set.smulSet.{u1, u2} G α (MulAction.toHasSmul.{u1, u2} G α (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_2)) _inst_5)) g U)))))
but is expected to have type
  forall (G : Type.{u2}) {α : Type.{u1}} [_inst_2 : Group.{u2} G] [_inst_3 : TopologicalSpace.{u1} α] [_inst_5 : MulAction.{u2, u1} G α (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_2))] [_inst_6 : MulAction.IsMinimal.{u2, u1} G α (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_2)) _inst_3 _inst_5] [_inst_7 : ContinuousConstSMul.{u2, u1} G α _inst_3 (MulAction.toSMul.{u2, u1} G α (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_2)) _inst_5)] {K : Set.{u1} α} {U : Set.{u1} α}, (IsCompact.{u1} α _inst_3 K) -> (IsOpen.{u1} α _inst_3 U) -> (Set.Nonempty.{u1} α U) -> (Exists.{succ u2} (Finset.{u2} G) (fun (I : Finset.{u2} G) => HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) K (Set.unionᵢ.{u1, succ u2} α G (fun (g : G) => Set.unionᵢ.{u1, 0} α (Membership.mem.{u2, u2} G (Finset.{u2} G) (Finset.instMembershipFinset.{u2} G) g I) (fun (H : Membership.mem.{u2, u2} G (Finset.{u2} G) (Finset.instMembershipFinset.{u2} G) g I) => HSMul.hSMul.{u2, u1, u1} G (Set.{u1} α) (Set.{u1} α) (instHSMul.{u2, u1} G (Set.{u1} α) (Set.smulSet.{u2, u1} G α (MulAction.toSMul.{u2, u1} G α (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_2)) _inst_5))) g U)))))
Case conversion may be inaccurate. Consider using '#align is_compact.exists_finite_cover_smul IsCompact.exists_finite_cover_smulₓ'. -/
@[to_additive]
theorem IsCompact.exists_finite_cover_smul [IsMinimal G α] [ContinuousConstSMul G α] {K U : Set α}
    (hK : IsCompact K) (hUo : IsOpen U) (hne : U.Nonempty) : ∃ I : Finset G, K ⊆ ⋃ g ∈ I, g • U :=
  (hK.elim_finite_subcover (fun g : G => g • U) fun g => hUo.smul _) <|
    calc
      K ⊆ univ := subset_univ K
      _ = ⋃ g : G, g • U := (hUo.unionᵢ_smul G hne).symm

#align is_compact.exists_finite_cover_smul IsCompact.exists_finite_cover_smul
#align is_compact.exists_finite_cover_vadd IsCompact.exists_finite_cover_vadd

/- warning: dense_of_nonempty_smul_invariant -> dense_of_nonempty_smul_invariant is a dubious translation:
lean 3 declaration is
  forall (M : Type.{u1}) {α : Type.{u2}} [_inst_1 : Monoid.{u1} M] [_inst_3 : TopologicalSpace.{u2} α] [_inst_4 : MulAction.{u1, u2} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u1, u2} M α _inst_1 _inst_3 _inst_4] {s : Set.{u2} α}, (Set.Nonempty.{u2} α s) -> (forall (c : M), HasSubset.Subset.{u2} (Set.{u2} α) (Set.hasSubset.{u2} α) (SMul.smul.{u1, u2} M (Set.{u2} α) (Set.smulSet.{u1, u2} M α (MulAction.toHasSmul.{u1, u2} M α _inst_1 _inst_4)) c s) s) -> (Dense.{u2} α _inst_3 s)
but is expected to have type
  forall (M : Type.{u2}) {α : Type.{u1}} [_inst_1 : Monoid.{u2} M] [_inst_3 : TopologicalSpace.{u1} α] [_inst_4 : MulAction.{u2, u1} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u2, u1} M α _inst_1 _inst_3 _inst_4] {s : Set.{u1} α}, (Set.Nonempty.{u1} α s) -> (forall (c : M), HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (HSMul.hSMul.{u2, u1, u1} M (Set.{u1} α) (Set.{u1} α) (instHSMul.{u2, u1} M (Set.{u1} α) (Set.smulSet.{u2, u1} M α (MulAction.toSMul.{u2, u1} M α _inst_1 _inst_4))) c s) s) -> (Dense.{u1} α _inst_3 s)
Case conversion may be inaccurate. Consider using '#align dense_of_nonempty_smul_invariant dense_of_nonempty_smul_invariantₓ'. -/
@[to_additive]
theorem dense_of_nonempty_smul_invariant [IsMinimal M α] {s : Set α} (hne : s.Nonempty)
    (hsmul : ∀ c : M, c • s ⊆ s) : Dense s :=
  let ⟨x, hx⟩ := hne
  (MulAction.dense_orbit M x).mono (range_subset_iff.2 fun c => hsmul c <| ⟨x, hx, rfl⟩)
#align dense_of_nonempty_smul_invariant dense_of_nonempty_smul_invariant
#align dense_of_nonempty_vadd_invariant dense_of_nonempty_vadd_invariant

/- warning: eq_empty_or_univ_of_smul_invariant_closed -> eq_empty_or_univ_of_smul_invariant_closed is a dubious translation:
lean 3 declaration is
  forall (M : Type.{u1}) {α : Type.{u2}} [_inst_1 : Monoid.{u1} M] [_inst_3 : TopologicalSpace.{u2} α] [_inst_4 : MulAction.{u1, u2} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u1, u2} M α _inst_1 _inst_3 _inst_4] {s : Set.{u2} α}, (IsClosed.{u2} α _inst_3 s) -> (forall (c : M), HasSubset.Subset.{u2} (Set.{u2} α) (Set.hasSubset.{u2} α) (SMul.smul.{u1, u2} M (Set.{u2} α) (Set.smulSet.{u1, u2} M α (MulAction.toHasSmul.{u1, u2} M α _inst_1 _inst_4)) c s) s) -> (Or (Eq.{succ u2} (Set.{u2} α) s (EmptyCollection.emptyCollection.{u2} (Set.{u2} α) (Set.hasEmptyc.{u2} α))) (Eq.{succ u2} (Set.{u2} α) s (Set.univ.{u2} α)))
but is expected to have type
  forall (M : Type.{u2}) {α : Type.{u1}} [_inst_1 : Monoid.{u2} M] [_inst_3 : TopologicalSpace.{u1} α] [_inst_4 : MulAction.{u2, u1} M α _inst_1] [_inst_6 : MulAction.IsMinimal.{u2, u1} M α _inst_1 _inst_3 _inst_4] {s : Set.{u1} α}, (IsClosed.{u1} α _inst_3 s) -> (forall (c : M), HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (HSMul.hSMul.{u2, u1, u1} M (Set.{u1} α) (Set.{u1} α) (instHSMul.{u2, u1} M (Set.{u1} α) (Set.smulSet.{u2, u1} M α (MulAction.toSMul.{u2, u1} M α _inst_1 _inst_4))) c s) s) -> (Or (Eq.{succ u1} (Set.{u1} α) s (EmptyCollection.emptyCollection.{u1} (Set.{u1} α) (Set.instEmptyCollectionSet.{u1} α))) (Eq.{succ u1} (Set.{u1} α) s (Set.univ.{u1} α)))
Case conversion may be inaccurate. Consider using '#align eq_empty_or_univ_of_smul_invariant_closed eq_empty_or_univ_of_smul_invariant_closedₓ'. -/
@[to_additive]
theorem eq_empty_or_univ_of_smul_invariant_closed [IsMinimal M α] {s : Set α} (hs : IsClosed s)
    (hsmul : ∀ c : M, c • s ⊆ s) : s = ∅ ∨ s = univ :=
  s.eq_empty_or_nonempty.imp_right fun hne =>
    hs.closure_eq ▸ (dense_of_nonempty_smul_invariant M hne hsmul).closure_eq
#align eq_empty_or_univ_of_smul_invariant_closed eq_empty_or_univ_of_smul_invariant_closed
#align eq_empty_or_univ_of_vadd_invariant_closed eq_empty_or_univ_of_vadd_invariant_closed

/- warning: is_minimal_iff_closed_smul_invariant -> isMinimal_iff_closed_smul_invariant is a dubious translation:
lean 3 declaration is
  forall (M : Type.{u1}) {α : Type.{u2}} [_inst_1 : Monoid.{u1} M] [_inst_3 : TopologicalSpace.{u2} α] [_inst_4 : MulAction.{u1, u2} M α _inst_1] [_inst_6 : ContinuousConstSMul.{u1, u2} M α _inst_3 (MulAction.toHasSmul.{u1, u2} M α _inst_1 _inst_4)], Iff (MulAction.IsMinimal.{u1, u2} M α _inst_1 _inst_3 _inst_4) (forall (s : Set.{u2} α), (IsClosed.{u2} α _inst_3 s) -> (forall (c : M), HasSubset.Subset.{u2} (Set.{u2} α) (Set.hasSubset.{u2} α) (SMul.smul.{u1, u2} M (Set.{u2} α) (Set.smulSet.{u1, u2} M α (MulAction.toHasSmul.{u1, u2} M α _inst_1 _inst_4)) c s) s) -> (Or (Eq.{succ u2} (Set.{u2} α) s (EmptyCollection.emptyCollection.{u2} (Set.{u2} α) (Set.hasEmptyc.{u2} α))) (Eq.{succ u2} (Set.{u2} α) s (Set.univ.{u2} α))))
but is expected to have type
  forall (M : Type.{u2}) {α : Type.{u1}} [_inst_1 : Monoid.{u2} M] [_inst_3 : TopologicalSpace.{u1} α] [_inst_4 : MulAction.{u2, u1} M α _inst_1] [_inst_6 : ContinuousConstSMul.{u2, u1} M α _inst_3 (MulAction.toSMul.{u2, u1} M α _inst_1 _inst_4)], Iff (MulAction.IsMinimal.{u2, u1} M α _inst_1 _inst_3 _inst_4) (forall (s : Set.{u1} α), (IsClosed.{u1} α _inst_3 s) -> (forall (c : M), HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (HSMul.hSMul.{u2, u1, u1} M (Set.{u1} α) (Set.{u1} α) (instHSMul.{u2, u1} M (Set.{u1} α) (Set.smulSet.{u2, u1} M α (MulAction.toSMul.{u2, u1} M α _inst_1 _inst_4))) c s) s) -> (Or (Eq.{succ u1} (Set.{u1} α) s (EmptyCollection.emptyCollection.{u1} (Set.{u1} α) (Set.instEmptyCollectionSet.{u1} α))) (Eq.{succ u1} (Set.{u1} α) s (Set.univ.{u1} α))))
Case conversion may be inaccurate. Consider using '#align is_minimal_iff_closed_smul_invariant isMinimal_iff_closed_smul_invariantₓ'. -/
@[to_additive]
theorem isMinimal_iff_closed_smul_invariant [ContinuousConstSMul M α] :
    IsMinimal M α ↔ ∀ s : Set α, IsClosed s → (∀ c : M, c • s ⊆ s) → s = ∅ ∨ s = univ :=
  by
  constructor;
  · intro h s
    exact eq_empty_or_univ_of_smul_invariant_closed M
  refine' fun H => ⟨fun x => dense_iff_closure_eq.2 <| (H _ _ _).resolve_left _⟩
  exacts[isClosed_closure, fun c => smul_closure_orbit_subset _ _,
    (orbit_nonempty _).closure.ne_empty]
#align is_minimal_iff_closed_smul_invariant isMinimal_iff_closed_smul_invariant
#align is_minimal_iff_closed_vadd_invariant isMinimal_iff_closed_vadd_invariant