/-
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, Patrick Massot

! This file was ported from Lean 3 source module topology.uniform_space.separation
! leanprover-community/mathlib commit 0c1f285a9f6e608ae2bdffa3f993eafb01eba829
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.ApplyFun
import Mathbin.Topology.UniformSpace.Basic
import Mathbin.Topology.Separation

/-!
# Hausdorff properties of uniform spaces. Separation quotient.

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

This file studies uniform spaces whose underlying topological spaces are separated
(also known as Hausdorff or T₂).
This turns out to be equivalent to asking that the intersection of all entourages
is the diagonal only. This condition actually implies the stronger separation property
that the space is T₃, hence those conditions are equivalent for topologies coming from
a uniform structure.

More generally, the intersection `𝓢 X` of all entourages of `X`, which has type `set (X × X)` is an
equivalence relation on `X`. Points which are equivalent under the relation are basically
undistinguishable from the point of view of the uniform structure. For instance any uniformly
continuous function will send equivalent points to the same value.

The quotient `separation_quotient X` of `X` by `𝓢 X` has a natural uniform structure which is
separated, and satisfies a universal property: every uniformly continuous function
from `X` to a separated uniform space uniquely factors through `separation_quotient X`.
As usual, this allows to turn `separation_quotient` into a functor (but we don't use the
category theory library in this file).

These notions admit relative versions, one can ask that `s : set X` is separated, this
is equivalent to asking that the uniform structure induced on `s` is separated.

## Main definitions

* `separation_relation X : set (X × X)`: the separation relation
* `separated_space X`: a predicate class asserting that `X` is separated
* `separation_quotient X`: the maximal separated quotient of `X`.
* `separation_quotient.lift f`: factors a map `f : X → Y` through the separation quotient of `X`.
* `separation_quotient.map f`: turns a map `f : X → Y` into a map between the separation quotients
  of `X` and `Y`.

## Main results

* `separated_iff_t2`: the equivalence between being separated and being Hausdorff for uniform
  spaces.
* `separation_quotient.uniform_continuous_lift`: factoring a uniformly continuous map through the
  separation quotient gives a uniformly continuous map.
* `separation_quotient.uniform_continuous_map`: maps induced between separation quotients are
  uniformly continuous.

## Notations

Localized in `uniformity`, we have the notation `𝓢 X` for the separation relation
on a uniform space `X`,

## Implementation notes

The separation setoid `separation_setoid` is not declared as a global instance.
It is made a local instance while building the theory of `separation_quotient`.
The factored map `separation_quotient.lift f` is defined without imposing any condition on
`f`, but returns junk if `f` is not uniformly continuous (constant junk hence it is always
uniformly continuous).

-/

open Filter TopologicalSpace Set Classical Function UniformSpace

open Classical Topology uniformity Filter

noncomputable section

/- ./././Mathport/Syntax/Translate/Basic.lean:334:40: warning: unsupported option eqn_compiler.zeta -/
set_option eqn_compiler.zeta true

universe u v w

variable {α : Type u} {β : Type v} {γ : Type w}

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

/-!
### Separated uniform spaces
-/

#print UniformSpace.to_regularSpace /-
instance (priority := 100) UniformSpace.to_regularSpace : RegularSpace α :=
  RegularSpace.ofBasis
    (fun a => by
      rw [nhds_eq_comap_uniformity]
      exact uniformity_has_basis_closed.comap _)
    fun a V hV => hV.2.Preimage <| continuous_const.prod_mk continuous_id
#align uniform_space.to_regular_space UniformSpace.to_regularSpace
-/

#print separationRel /-
/-- The separation relation is the intersection of all entourages.
  Two points which are related by the separation relation are "indistinguishable"
  according to the uniform structure. -/
protected def separationRel (α : Type u) [u : UniformSpace α] :=
  ⋂₀ (𝓤 α).sets
#align separation_rel separationRel
-/

-- mathport name: separation_rel
scoped[uniformity] notation "𝓢" => separationRel

#print separated_equiv /-
theorem separated_equiv : Equivalence fun x y => (x, y) ∈ 𝓢 α :=
  ⟨fun x => fun s => refl_mem_uniformity, fun x y => fun h (s : Set (α × α)) hs =>
    have : preimage Prod.swap s ∈ 𝓤 α := symm_le_uniformity hs
    h _ this,
    fun x y z (hxy : (x, y) ∈ 𝓢 α) (hyz : (y, z) ∈ 𝓢 α) s (hs : s ∈ 𝓤 α) =>
    let ⟨t, ht, (h_ts : compRel t t ⊆ s)⟩ := comp_mem_uniformity_sets hs
    h_ts <| show (x, z) ∈ compRel t t from ⟨y, hxy t ht, hyz t ht⟩⟩
#align separated_equiv separated_equiv
-/

/- warning: filter.has_basis.mem_separation_rel -> Filter.HasBasis.mem_separationRel is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : UniformSpace.{u1} α] {ι : Sort.{u2}} {p : ι -> Prop} {s : ι -> (Set.{u1} (Prod.{u1, u1} α α))}, (Filter.HasBasis.{u1, u2} (Prod.{u1, u1} α α) ι (uniformity.{u1} α _inst_1) p s) -> (forall {a : Prod.{u1, u1} α α}, Iff (Membership.Mem.{u1, u1} (Prod.{u1, u1} α α) (Set.{u1} (Prod.{u1, u1} α α)) (Set.hasMem.{u1} (Prod.{u1, u1} α α)) a (separationRel.{u1} α _inst_1)) (forall (i : ι), (p i) -> (Membership.Mem.{u1, u1} (Prod.{u1, u1} α α) (Set.{u1} (Prod.{u1, u1} α α)) (Set.hasMem.{u1} (Prod.{u1, u1} α α)) a (s i))))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : UniformSpace.{u2} α] {ι : Sort.{u1}} {p : ι -> Prop} {s : ι -> (Set.{u2} (Prod.{u2, u2} α α))}, (Filter.HasBasis.{u2, u1} (Prod.{u2, u2} α α) ι (uniformity.{u2} α _inst_1) p s) -> (forall {a : Prod.{u2, u2} α α}, Iff (Membership.mem.{u2, u2} (Prod.{u2, u2} α α) (Set.{u2} (Prod.{u2, u2} α α)) (Set.instMembershipSet.{u2} (Prod.{u2, u2} α α)) a (separationRel.{u2} α _inst_1)) (forall (i : ι), (p i) -> (Membership.mem.{u2, u2} (Prod.{u2, u2} α α) (Set.{u2} (Prod.{u2, u2} α α)) (Set.instMembershipSet.{u2} (Prod.{u2, u2} α α)) a (s i))))
Case conversion may be inaccurate. Consider using '#align filter.has_basis.mem_separation_rel Filter.HasBasis.mem_separationRelₓ'. -/
theorem Filter.HasBasis.mem_separationRel {ι : Sort _} {p : ι → Prop} {s : ι → Set (α × α)}
    (h : (𝓤 α).HasBasis p s) {a : α × α} : a ∈ 𝓢 α ↔ ∀ i, p i → a ∈ s i :=
  h.forall_mem_mem
#align filter.has_basis.mem_separation_rel Filter.HasBasis.mem_separationRel

#print separationRel_iff_specializes /-
theorem separationRel_iff_specializes {a b : α} : (a, b) ∈ 𝓢 α ↔ a ⤳ b := by
  simp only [(𝓤 α).basis_sets.mem_separationRel, id, mem_set_of_eq,
    (nhds_basis_uniformity (𝓤 α).basis_sets).specializes_iff]
#align separation_rel_iff_specializes separationRel_iff_specializes
-/

#print separationRel_iff_inseparable /-
theorem separationRel_iff_inseparable {a b : α} : (a, b) ∈ 𝓢 α ↔ Inseparable a b :=
  separationRel_iff_specializes.trans specializes_iff_inseparable
#align separation_rel_iff_inseparable separationRel_iff_inseparable
-/

#print SeparatedSpace /-
/-- A uniform space is separated if its separation relation is trivial (each point
is related only to itself). -/
class SeparatedSpace (α : Type u) [UniformSpace α] : Prop where
  out : 𝓢 α = idRel
#align separated_space SeparatedSpace
-/

#print separatedSpace_iff /-
theorem separatedSpace_iff {α : Type u} [UniformSpace α] : SeparatedSpace α ↔ 𝓢 α = idRel :=
  ⟨fun h => h.1, fun h => ⟨h⟩⟩
#align separated_space_iff separatedSpace_iff
-/

#print separated_def /-
theorem separated_def {α : Type u} [UniformSpace α] :
    SeparatedSpace α ↔ ∀ x y, (∀ r ∈ 𝓤 α, (x, y) ∈ r) → x = y := by
  simp [separatedSpace_iff, idRel_subset.2 separated_equiv.1, subset.antisymm_iff] <;>
    simp [subset_def, separationRel]
#align separated_def separated_def
-/

/- warning: separated_def' -> separated_def' is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_4 : UniformSpace.{u1} α], Iff (SeparatedSpace.{u1} α _inst_4) (forall (x : α) (y : α), (Ne.{succ u1} α x y) -> (Exists.{succ u1} (Set.{u1} (Prod.{u1, u1} α α)) (fun (r : Set.{u1} (Prod.{u1, u1} α α)) => Exists.{0} (Membership.Mem.{u1, u1} (Set.{u1} (Prod.{u1, u1} α α)) (Filter.{u1} (Prod.{u1, u1} α α)) (Filter.hasMem.{u1} (Prod.{u1, u1} α α)) r (uniformity.{u1} α _inst_4)) (fun (H : Membership.Mem.{u1, u1} (Set.{u1} (Prod.{u1, u1} α α)) (Filter.{u1} (Prod.{u1, u1} α α)) (Filter.hasMem.{u1} (Prod.{u1, u1} α α)) r (uniformity.{u1} α _inst_4)) => Not (Membership.Mem.{u1, u1} (Prod.{u1, u1} α α) (Set.{u1} (Prod.{u1, u1} α α)) (Set.hasMem.{u1} (Prod.{u1, u1} α α)) (Prod.mk.{u1, u1} α α x y) r)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_4 : UniformSpace.{u1} α], Iff (SeparatedSpace.{u1} α _inst_4) (forall (x : α) (y : α), (Ne.{succ u1} α x y) -> (Exists.{succ u1} (Set.{u1} (Prod.{u1, u1} α α)) (fun (r : Set.{u1} (Prod.{u1, u1} α α)) => And (Membership.mem.{u1, u1} (Set.{u1} (Prod.{u1, u1} α α)) (Filter.{u1} (Prod.{u1, u1} α α)) (instMembershipSetFilter.{u1} (Prod.{u1, u1} α α)) r (uniformity.{u1} α _inst_4)) (Not (Membership.mem.{u1, u1} (Prod.{u1, u1} α α) (Set.{u1} (Prod.{u1, u1} α α)) (Set.instMembershipSet.{u1} (Prod.{u1, u1} α α)) (Prod.mk.{u1, u1} α α x y) r)))))
Case conversion may be inaccurate. Consider using '#align separated_def' separated_def'ₓ'. -/
theorem separated_def' {α : Type u} [UniformSpace α] :
    SeparatedSpace α ↔ ∀ x y, x ≠ y → ∃ r ∈ 𝓤 α, (x, y) ∉ r :=
  separated_def.trans <| forall₂_congr fun x y => by rw [← not_imp_not] <;> simp [not_forall]
#align separated_def' separated_def'

#print eq_of_uniformity /-
theorem eq_of_uniformity {α : Type _} [UniformSpace α] [SeparatedSpace α] {x y : α}
    (h : ∀ {V}, V ∈ 𝓤 α → (x, y) ∈ V) : x = y :=
  separated_def.mp ‹SeparatedSpace α› x y fun _ => h
#align eq_of_uniformity eq_of_uniformity
-/

/- warning: eq_of_uniformity_basis -> eq_of_uniformity_basis is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_4 : UniformSpace.{u1} α] [_inst_5 : SeparatedSpace.{u1} α _inst_4] {ι : Type.{u2}} {p : ι -> Prop} {s : ι -> (Set.{u1} (Prod.{u1, u1} α α))}, (Filter.HasBasis.{u1, succ u2} (Prod.{u1, u1} α α) ι (uniformity.{u1} α _inst_4) p s) -> (forall {x : α} {y : α}, (forall {i : ι}, (p i) -> (Membership.Mem.{u1, u1} (Prod.{u1, u1} α α) (Set.{u1} (Prod.{u1, u1} α α)) (Set.hasMem.{u1} (Prod.{u1, u1} α α)) (Prod.mk.{u1, u1} α α x y) (s i))) -> (Eq.{succ u1} α x y))
but is expected to have type
  forall {α : Type.{u2}} [_inst_4 : UniformSpace.{u2} α] [_inst_5 : SeparatedSpace.{u2} α _inst_4] {ι : Type.{u1}} {p : ι -> Prop} {s : ι -> (Set.{u2} (Prod.{u2, u2} α α))}, (Filter.HasBasis.{u2, succ u1} (Prod.{u2, u2} α α) ι (uniformity.{u2} α _inst_4) p s) -> (forall {x : α} {y : α}, (forall {i : ι}, (p i) -> (Membership.mem.{u2, u2} (Prod.{u2, u2} α α) (Set.{u2} (Prod.{u2, u2} α α)) (Set.instMembershipSet.{u2} (Prod.{u2, u2} α α)) (Prod.mk.{u2, u2} α α x y) (s i))) -> (Eq.{succ u2} α x y))
Case conversion may be inaccurate. Consider using '#align eq_of_uniformity_basis eq_of_uniformity_basisₓ'. -/
theorem eq_of_uniformity_basis {α : Type _} [UniformSpace α] [SeparatedSpace α] {ι : Type _}
    {p : ι → Prop} {s : ι → Set (α × α)} (hs : (𝓤 α).HasBasis p s) {x y : α}
    (h : ∀ {i}, p i → (x, y) ∈ s i) : x = y :=
  eq_of_uniformity fun V V_in =>
    let ⟨i, hi, H⟩ := hs.mem_iff.mp V_in
    H (h hi)
#align eq_of_uniformity_basis eq_of_uniformity_basis

#print eq_of_forall_symmetric /-
theorem eq_of_forall_symmetric {α : Type _} [UniformSpace α] [SeparatedSpace α] {x y : α}
    (h : ∀ {V}, V ∈ 𝓤 α → SymmetricRel V → (x, y) ∈ V) : x = y :=
  eq_of_uniformity_basis hasBasis_symmetric (by simpa [and_imp] using fun _ => h)
#align eq_of_forall_symmetric eq_of_forall_symmetric
-/

/- warning: eq_of_cluster_pt_uniformity -> eq_of_clusterPt_uniformity is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : UniformSpace.{u1} α] [_inst_4 : SeparatedSpace.{u1} α _inst_1] {x : α} {y : α}, (ClusterPt.{u1} (Prod.{u1, u1} α α) (Prod.topologicalSpace.{u1, u1} α α (UniformSpace.toTopologicalSpace.{u1} α _inst_1) (UniformSpace.toTopologicalSpace.{u1} α _inst_1)) (Prod.mk.{u1, u1} α α x y) (uniformity.{u1} α _inst_1)) -> (Eq.{succ u1} α x y)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : UniformSpace.{u1} α] [_inst_4 : SeparatedSpace.{u1} α _inst_1] {x : α} {y : α}, (ClusterPt.{u1} (Prod.{u1, u1} α α) (instTopologicalSpaceProd.{u1, u1} α α (UniformSpace.toTopologicalSpace.{u1} α _inst_1) (UniformSpace.toTopologicalSpace.{u1} α _inst_1)) (Prod.mk.{u1, u1} α α x y) (uniformity.{u1} α _inst_1)) -> (Eq.{succ u1} α x y)
Case conversion may be inaccurate. Consider using '#align eq_of_cluster_pt_uniformity eq_of_clusterPt_uniformityₓ'. -/
theorem eq_of_clusterPt_uniformity [SeparatedSpace α] {x y : α} (h : ClusterPt (x, y) (𝓤 α)) :
    x = y :=
  eq_of_uniformity_basis uniformity_hasBasis_closed fun V ⟨hV, hVc⟩ =>
    isClosed_iff_clusterPt.1 hVc _ <| h.mono <| le_principal_iff.2 hV
#align eq_of_cluster_pt_uniformity eq_of_clusterPt_uniformity

#print idRel_sub_separationRel /-
theorem idRel_sub_separationRel (α : Type _) [UniformSpace α] : idRel ⊆ 𝓢 α :=
  by
  unfold separationRel
  rw [idRel_subset]
  intro x
  suffices ∀ t ∈ 𝓤 α, (x, x) ∈ t by simpa only [refl_mem_uniformity]
  exact fun t => refl_mem_uniformity
#align id_rel_sub_separation_relation idRel_sub_separationRel
-/

#print separationRel_comap /-
theorem separationRel_comap {f : α → β}
    (h : ‹UniformSpace α› = UniformSpace.comap f ‹UniformSpace β›) : 𝓢 α = Prod.map f f ⁻¹' 𝓢 β :=
  by
  subst h
  dsimp [separationRel]
  simp_rw [uniformity_comap, (Filter.comap_hasBasis (Prod.map f f) (𝓤 β)).interₛ_sets, ←
    preimage_Inter, sInter_eq_bInter]
  rfl
#align separation_rel_comap separationRel_comap
-/

/- warning: filter.has_basis.separation_rel -> Filter.HasBasis.separationRel is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : UniformSpace.{u1} α] {ι : Sort.{u2}} {p : ι -> Prop} {s : ι -> (Set.{u1} (Prod.{u1, u1} α α))}, (Filter.HasBasis.{u1, u2} (Prod.{u1, u1} α α) ι (uniformity.{u1} α _inst_1) p s) -> (Eq.{succ u1} (Set.{u1} (Prod.{u1, u1} α α)) (separationRel.{u1} α _inst_1) (Set.interᵢ.{u1, u2} (Prod.{u1, u1} α α) ι (fun (i : ι) => Set.interᵢ.{u1, 0} (Prod.{u1, u1} α α) (p i) (fun (hi : p i) => s i))))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : UniformSpace.{u2} α] {ι : Sort.{u1}} {p : ι -> Prop} {s : ι -> (Set.{u2} (Prod.{u2, u2} α α))}, (Filter.HasBasis.{u2, u1} (Prod.{u2, u2} α α) ι (uniformity.{u2} α _inst_1) p s) -> (Eq.{succ u2} (Set.{u2} (Prod.{u2, u2} α α)) (separationRel.{u2} α _inst_1) (Set.interᵢ.{u2, u1} (Prod.{u2, u2} α α) ι (fun (i : ι) => Set.interᵢ.{u2, 0} (Prod.{u2, u2} α α) (p i) (fun (hi : p i) => s i))))
Case conversion may be inaccurate. Consider using '#align filter.has_basis.separation_rel Filter.HasBasis.separationRelₓ'. -/
protected theorem Filter.HasBasis.separationRel {ι : Sort _} {p : ι → Prop} {s : ι → Set (α × α)}
    (h : HasBasis (𝓤 α) p s) : 𝓢 α = ⋂ (i) (hi : p i), s i :=
  by
  unfold separationRel
  rw [h.sInter_sets]
#align filter.has_basis.separation_rel Filter.HasBasis.separationRel

/- warning: separation_rel_eq_inter_closure -> separationRel_eq_inter_closure is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : UniformSpace.{u1} α], Eq.{succ u1} (Set.{u1} (Prod.{u1, u1} α α)) (separationRel.{u1} α _inst_1) (Set.interₛ.{u1} (Prod.{u1, u1} α α) (Set.image.{u1, u1} (Set.{u1} (Prod.{u1, u1} α α)) (Set.{u1} (Prod.{u1, u1} α α)) (closure.{u1} (Prod.{u1, u1} α α) (Prod.topologicalSpace.{u1, u1} α α (UniformSpace.toTopologicalSpace.{u1} α _inst_1) (UniformSpace.toTopologicalSpace.{u1} α _inst_1))) (Filter.sets.{u1} (Prod.{u1, u1} α α) (uniformity.{u1} α _inst_1))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : UniformSpace.{u1} α], Eq.{succ u1} (Set.{u1} (Prod.{u1, u1} α α)) (separationRel.{u1} α _inst_1) (Set.interₛ.{u1} (Prod.{u1, u1} α α) (Set.image.{u1, u1} (Set.{u1} (Prod.{u1, u1} α α)) (Set.{u1} (Prod.{u1, u1} α α)) (closure.{u1} (Prod.{u1, u1} α α) (instTopologicalSpaceProd.{u1, u1} α α (UniformSpace.toTopologicalSpace.{u1} α _inst_1) (UniformSpace.toTopologicalSpace.{u1} α _inst_1))) (Filter.sets.{u1} (Prod.{u1, u1} α α) (uniformity.{u1} α _inst_1))))
Case conversion may be inaccurate. Consider using '#align separation_rel_eq_inter_closure separationRel_eq_inter_closureₓ'. -/
theorem separationRel_eq_inter_closure : 𝓢 α = ⋂₀ (closure '' (𝓤 α).sets) := by
  simp [uniformity_has_basis_closure.separation_rel]
#align separation_rel_eq_inter_closure separationRel_eq_inter_closure

/- warning: is_closed_separation_rel -> isClosed_separationRel is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : UniformSpace.{u1} α], IsClosed.{u1} (Prod.{u1, u1} α α) (Prod.topologicalSpace.{u1, u1} α α (UniformSpace.toTopologicalSpace.{u1} α _inst_1) (UniformSpace.toTopologicalSpace.{u1} α _inst_1)) (separationRel.{u1} α _inst_1)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : UniformSpace.{u1} α], IsClosed.{u1} (Prod.{u1, u1} α α) (instTopologicalSpaceProd.{u1, u1} α α (UniformSpace.toTopologicalSpace.{u1} α _inst_1) (UniformSpace.toTopologicalSpace.{u1} α _inst_1)) (separationRel.{u1} α _inst_1)
Case conversion may be inaccurate. Consider using '#align is_closed_separation_rel isClosed_separationRelₓ'. -/
theorem isClosed_separationRel : IsClosed (𝓢 α) :=
  by
  rw [separationRel_eq_inter_closure]
  apply isClosed_interₛ
  rintro _ ⟨t, t_in, rfl⟩
  exact isClosed_closure
#align is_closed_separation_rel isClosed_separationRel

#print separated_iff_t2 /-
theorem separated_iff_t2 : SeparatedSpace α ↔ T2Space α := by
  classical
    constructor <;> intro h
    · rw [t2_iff_isClosed_diagonal, ← show 𝓢 α = diagonal α from h.1]
      exact isClosed_separationRel
    · rw [separated_def']
      intro x y hxy
      rcases t2_separation hxy with ⟨u, v, uo, vo, hx, hy, h⟩
      rcases isOpen_iff_ball_subset.1 uo x hx with ⟨r, hrU, hr⟩
      exact ⟨r, hrU, fun H => h.le_bot ⟨hr H, hy⟩⟩
#align separated_iff_t2 separated_iff_t2
-/

#print separated_t3 /-
-- see Note [lower instance priority]
instance (priority := 100) separated_t3 [SeparatedSpace α] : T3Space α :=
  haveI := separated_iff_t2.mp ‹_›
  ⟨⟩
#align separated_t3 separated_t3
-/

#print Subtype.separatedSpace /-
instance Subtype.separatedSpace [SeparatedSpace α] (s : Set α) : SeparatedSpace s :=
  separated_iff_t2.mpr Subtype.t2Space
#align subtype.separated_space Subtype.separatedSpace
-/

#print isClosed_of_spaced_out /-
theorem isClosed_of_spaced_out [SeparatedSpace α] {V₀ : Set (α × α)} (V₀_in : V₀ ∈ 𝓤 α) {s : Set α}
    (hs : s.Pairwise fun x y => (x, y) ∉ V₀) : IsClosed s :=
  by
  rcases comp_symm_mem_uniformity_sets V₀_in with ⟨V₁, V₁_in, V₁_symm, h_comp⟩
  apply isClosed_of_closure_subset
  intro x hx
  rw [mem_closure_iff_ball] at hx
  rcases hx V₁_in with ⟨y, hy, hy'⟩
  suffices x = y by rwa [this]
  apply eq_of_forall_symmetric
  intro V V_in V_symm
  rcases hx (inter_mem V₁_in V_in) with ⟨z, hz, hz'⟩
  obtain rfl : z = y := by
    by_contra hzy
    exact hs hz' hy' hzy (h_comp <| mem_comp_of_mem_ball V₁_symm (ball_inter_left x _ _ hz) hy)
  exact ball_inter_right x _ _ hz
#align is_closed_of_spaced_out isClosed_of_spaced_out
-/

/- warning: is_closed_range_of_spaced_out -> isClosed_range_of_spaced_out is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : UniformSpace.{u1} α] {ι : Type.{u2}} [_inst_4 : SeparatedSpace.{u1} α _inst_1] {V₀ : Set.{u1} (Prod.{u1, u1} α α)}, (Membership.Mem.{u1, u1} (Set.{u1} (Prod.{u1, u1} α α)) (Filter.{u1} (Prod.{u1, u1} α α)) (Filter.hasMem.{u1} (Prod.{u1, u1} α α)) V₀ (uniformity.{u1} α _inst_1)) -> (forall {f : ι -> α}, (Pairwise.{u2} ι (fun (x : ι) (y : ι) => Not (Membership.Mem.{u1, u1} (Prod.{u1, u1} α α) (Set.{u1} (Prod.{u1, u1} α α)) (Set.hasMem.{u1} (Prod.{u1, u1} α α)) (Prod.mk.{u1, u1} α α (f x) (f y)) V₀))) -> (IsClosed.{u1} α (UniformSpace.toTopologicalSpace.{u1} α _inst_1) (Set.range.{u1, succ u2} α ι f)))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : UniformSpace.{u2} α] {ι : Type.{u1}} [_inst_4 : SeparatedSpace.{u2} α _inst_1] {V₀ : Set.{u2} (Prod.{u2, u2} α α)}, (Membership.mem.{u2, u2} (Set.{u2} (Prod.{u2, u2} α α)) (Filter.{u2} (Prod.{u2, u2} α α)) (instMembershipSetFilter.{u2} (Prod.{u2, u2} α α)) V₀ (uniformity.{u2} α _inst_1)) -> (forall {f : ι -> α}, (Pairwise.{u1} ι (fun (x : ι) (y : ι) => Not (Membership.mem.{u2, u2} (Prod.{u2, u2} α α) (Set.{u2} (Prod.{u2, u2} α α)) (Set.instMembershipSet.{u2} (Prod.{u2, u2} α α)) (Prod.mk.{u2, u2} α α (f x) (f y)) V₀))) -> (IsClosed.{u2} α (UniformSpace.toTopologicalSpace.{u2} α _inst_1) (Set.range.{u2, succ u1} α ι f)))
Case conversion may be inaccurate. Consider using '#align is_closed_range_of_spaced_out isClosed_range_of_spaced_outₓ'. -/
theorem isClosed_range_of_spaced_out {ι} [SeparatedSpace α] {V₀ : Set (α × α)} (V₀_in : V₀ ∈ 𝓤 α)
    {f : ι → α} (hf : Pairwise fun x y => (f x, f y) ∉ V₀) : IsClosed (range f) :=
  isClosed_of_spaced_out V₀_in <| by
    rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ h
    exact hf (ne_of_apply_ne f h)
#align is_closed_range_of_spaced_out isClosed_range_of_spaced_out

/-!
### Separation quotient
-/

namespace UniformSpace

#print UniformSpace.separationSetoid /-
/-- The separation relation of a uniform space seen as a setoid. -/
def separationSetoid (α : Type u) [UniformSpace α] : Setoid α :=
  ⟨fun x y => (x, y) ∈ 𝓢 α, separated_equiv⟩
#align uniform_space.separation_setoid UniformSpace.separationSetoid
-/

attribute [local instance] separation_setoid

#print UniformSpace.separationSetoid.uniformSpace /-
instance separationSetoid.uniformSpace {α : Type u} [u : UniformSpace α] :
    UniformSpace (Quotient (separationSetoid α))
    where
  toTopologicalSpace := u.toTopologicalSpace.coinduced fun x => ⟦x⟧
  uniformity := map (fun p : α × α => (⟦p.1⟧, ⟦p.2⟧)) u.uniformity
  refl := le_trans (by simp [Quotient.exists_rep]) (Filter.map_mono refl_le_uniformity)
  symm :=
    tendsto_map' <| by simp [Prod.swap, (· ∘ ·)] <;> exact tendsto_map.comp tendsto_swap_uniformity
  comp :=
    calc
      ((map (fun p : α × α => (⟦p.fst⟧, ⟦p.snd⟧)) u.uniformity).lift' fun s => compRel s s) =
          u.uniformity.lift' ((fun s => compRel s s) ∘ image fun p : α × α => (⟦p.fst⟧, ⟦p.snd⟧)) :=
        map_lift'_eq2 <| monotone_id.compRel monotone_id
      _ ≤
          u.uniformity.lift'
            ((image fun p : α × α => (⟦p.fst⟧, ⟦p.snd⟧)) ∘ fun s : Set (α × α) =>
              compRel s (compRel s s)) :=
        (lift'_mono' fun s hs ⟨a, b⟩ ⟨c, ⟨⟨a₁, a₂⟩, ha, a_eq⟩, ⟨⟨b₁, b₂⟩, hb, b_eq⟩⟩ =>
          by
          simp at a_eq
          simp at b_eq
          have h : ⟦a₂⟧ = ⟦b₁⟧ := by rw [a_eq.right, b_eq.left]
          have h : (a₂, b₁) ∈ 𝓢 α := Quotient.exact h
          simp [Function.comp, Set.image, compRel, and_comm, and_left_comm, and_assoc]
          exact ⟨a₁, a_eq.left, b₂, b_eq.right, a₂, ha, b₁, h s hs, hb⟩)
      _ =
          map (fun p : α × α => (⟦p.1⟧, ⟦p.2⟧))
            (u.uniformity.lift' fun s : Set (α × α) => compRel s (compRel s s)) :=
        by rw [map_lift'_eq] <;> exact monotone_id.comp_rel (monotone_id.comp_rel monotone_id)
      _ ≤ map (fun p : α × α => (⟦p.1⟧, ⟦p.2⟧)) u.uniformity := map_mono comp_le_uniformity3

  isOpen_uniformity s :=
    by
    have :
      ∀ a,
        ⟦a⟧ ∈ s →
          ({ p : α × α | p.1 = a → ⟦p.2⟧ ∈ s } ∈ 𝓤 α ↔ { p : α × α | p.1 ≈ a → ⟦p.2⟧ ∈ s } ∈ 𝓤 α) :=
      fun a ha =>
      ⟨fun h =>
        let ⟨t, ht, hts⟩ := comp_mem_uniformity_sets h
        have hts : ∀ {a₁ a₂}, (a, a₁) ∈ t → (a₁, a₂) ∈ t → ⟦a₂⟧ ∈ s := fun a₁ a₂ ha₁ ha₂ =>
          @hts (a, a₂) ⟨a₁, ha₁, ha₂⟩ rfl
        have ht' : ∀ {a₁ a₂}, a₁ ≈ a₂ → (a₁, a₂) ∈ t := fun a₁ a₂ h => interₛ_subset_of_mem ht h
        u.uniformity.sets_of_superset ht fun ⟨a₁, a₂⟩ h₁ h₂ => hts (ht' <| Setoid.symm h₂) h₁,
        fun h => u.uniformity.sets_of_superset h <| by simp (config := { contextual := true })⟩
    simp only [isOpen_coinduced, isOpen_uniformity, uniformity, forall_quotient_iff, mem_preimage,
      mem_map, preimage_set_of_eq, Quotient.eq']
    exact ⟨fun h a ha => (this a ha).mp <| h a ha, fun h a ha => (this a ha).mpr <| h a ha⟩
#align uniform_space.separation_setoid.uniform_space UniformSpace.separationSetoid.uniformSpace
-/

#print UniformSpace.uniformity_quotient /-
theorem uniformity_quotient :
    𝓤 (Quotient (separationSetoid α)) = (𝓤 α).map fun p : α × α => (⟦p.1⟧, ⟦p.2⟧) :=
  rfl
#align uniform_space.uniformity_quotient UniformSpace.uniformity_quotient
-/

#print UniformSpace.uniformContinuous_quotient_mk' /-
theorem uniformContinuous_quotient_mk' :
    UniformContinuous (Quotient.mk' : α → Quotient (separationSetoid α)) :=
  le_rfl
#align uniform_space.uniform_continuous_quotient_mk UniformSpace.uniformContinuous_quotient_mk'
-/

#print UniformSpace.uniformContinuous_quotient /-
theorem uniformContinuous_quotient {f : Quotient (separationSetoid α) → β}
    (hf : UniformContinuous fun x => f ⟦x⟧) : UniformContinuous f :=
  hf
#align uniform_space.uniform_continuous_quotient UniformSpace.uniformContinuous_quotient
-/

#print UniformSpace.uniformContinuous_quotient_lift /-
theorem uniformContinuous_quotient_lift {f : α → β} {h : ∀ a b, (a, b) ∈ 𝓢 α → f a = f b}
    (hf : UniformContinuous f) : UniformContinuous fun a => Quotient.lift f h a :=
  uniformContinuous_quotient hf
#align uniform_space.uniform_continuous_quotient_lift UniformSpace.uniformContinuous_quotient_lift
-/

/- warning: uniform_space.uniform_continuous_quotient_lift₂ -> UniformSpace.uniformContinuous_quotient_lift₂ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} [_inst_1 : UniformSpace.{u1} α] [_inst_2 : UniformSpace.{u2} β] [_inst_3 : UniformSpace.{u3} γ] {f : α -> β -> γ} {h : forall (a : α) (c : β) (b : α) (d : β), (Membership.Mem.{u1, u1} (Prod.{u1, u1} α α) (Set.{u1} (Prod.{u1, u1} α α)) (Set.hasMem.{u1} (Prod.{u1, u1} α α)) (Prod.mk.{u1, u1} α α a b) (separationRel.{u1} α _inst_1)) -> (Membership.Mem.{u2, u2} (Prod.{u2, u2} β β) (Set.{u2} (Prod.{u2, u2} β β)) (Set.hasMem.{u2} (Prod.{u2, u2} β β)) (Prod.mk.{u2, u2} β β c d) (separationRel.{u2} β _inst_2)) -> (Eq.{succ u3} γ (f a c) (f b d))}, (UniformContinuous.{max u1 u2, u3} (Prod.{u1, u2} α β) γ (Prod.uniformSpace.{u1, u2} α β _inst_1 _inst_2) _inst_3 (fun (p : Prod.{u1, u2} α β) => f (Prod.fst.{u1, u2} α β p) (Prod.snd.{u1, u2} α β p))) -> (UniformContinuous.{max u1 u2, u3} (Prod.{u1, u2} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2))) γ (Prod.uniformSpace.{u1, u2} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2)) (UniformSpace.separationSetoid.uniformSpace.{u1} α _inst_1) (UniformSpace.separationSetoid.uniformSpace.{u2} β _inst_2)) _inst_3 (fun (p : Prod.{u1, u2} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2))) => Quotient.lift₂.{succ u1, succ u2, succ u3} α β γ (UniformSpace.separationSetoid.{u1} α _inst_1) (UniformSpace.separationSetoid.{u2} β _inst_2) f h (Prod.fst.{u1, u2} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2)) p) (Prod.snd.{u1, u2} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2)) p)))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} [_inst_1 : UniformSpace.{u1} α] [_inst_2 : UniformSpace.{u2} β] [_inst_3 : UniformSpace.{u3} γ] {f : α -> β -> γ} {h : forall (a : α) (c : β) (b : α) (d : β), (Membership.mem.{u1, u1} (Prod.{u1, u1} α α) (Set.{u1} (Prod.{u1, u1} α α)) (Set.instMembershipSet.{u1} (Prod.{u1, u1} α α)) (Prod.mk.{u1, u1} α α a b) (separationRel.{u1} α _inst_1)) -> (Membership.mem.{u2, u2} (Prod.{u2, u2} β β) (Set.{u2} (Prod.{u2, u2} β β)) (Set.instMembershipSet.{u2} (Prod.{u2, u2} β β)) (Prod.mk.{u2, u2} β β c d) (separationRel.{u2} β _inst_2)) -> (Eq.{succ u3} γ (f a c) (f b d))}, (UniformContinuous.{max u1 u2, u3} (Prod.{u1, u2} α β) γ (instUniformSpaceProd.{u1, u2} α β _inst_1 _inst_2) _inst_3 (fun (p : Prod.{u1, u2} α β) => f (Prod.fst.{u1, u2} α β p) (Prod.snd.{u1, u2} α β p))) -> (UniformContinuous.{max u2 u1, u3} (Prod.{u1, u2} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2))) γ (instUniformSpaceProd.{u1, u2} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2)) (UniformSpace.separationSetoid.uniformSpace.{u1} α _inst_1) (UniformSpace.separationSetoid.uniformSpace.{u2} β _inst_2)) _inst_3 (fun (p : Prod.{u1, u2} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2))) => Quotient.lift₂.{succ u1, succ u2, succ u3} α β γ (UniformSpace.separationSetoid.{u1} α _inst_1) (UniformSpace.separationSetoid.{u2} β _inst_2) f h (Prod.fst.{u1, u2} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2)) p) (Prod.snd.{u1, u2} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2)) p)))
Case conversion may be inaccurate. Consider using '#align uniform_space.uniform_continuous_quotient_lift₂ UniformSpace.uniformContinuous_quotient_lift₂ₓ'. -/
theorem uniformContinuous_quotient_lift₂ {f : α → β → γ}
    {h : ∀ a c b d, (a, b) ∈ 𝓢 α → (c, d) ∈ 𝓢 β → f a c = f b d}
    (hf : UniformContinuous fun p : α × β => f p.1 p.2) :
    UniformContinuous fun p : _ × _ => Quotient.lift₂ f h p.1 p.2 :=
  by
  rw [UniformContinuous, uniformity_prod_eq_prod, uniformity_quotient, uniformity_quotient,
    Filter.prod_map_map_eq, Filter.tendsto_map'_iff, Filter.tendsto_map'_iff]
  rwa [UniformContinuous, uniformity_prod_eq_prod, Filter.tendsto_map'_iff] at hf
#align uniform_space.uniform_continuous_quotient_lift₂ UniformSpace.uniformContinuous_quotient_lift₂

/- warning: uniform_space.comap_quotient_le_uniformity -> UniformSpace.comap_quotient_le_uniformity is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : UniformSpace.{u1} α], LE.le.{u1} (Filter.{u1} (Prod.{u1, u1} α α)) (Preorder.toLE.{u1} (Filter.{u1} (Prod.{u1, u1} α α)) (PartialOrder.toPreorder.{u1} (Filter.{u1} (Prod.{u1, u1} α α)) (Filter.partialOrder.{u1} (Prod.{u1, u1} α α)))) (Filter.comap.{u1, u1} (Prod.{u1, u1} α α) (Prod.{u1, u1} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1))) (fun (p : Prod.{u1, u1} α α) => Prod.mk.{u1, u1} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.mk'.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1) (Prod.fst.{u1, u1} α α p)) (Quotient.mk'.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1) (Prod.snd.{u1, u1} α α p))) (uniformity.{u1} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (UniformSpace.separationSetoid.uniformSpace.{u1} α _inst_1))) (uniformity.{u1} α _inst_1)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : UniformSpace.{u1} α], LE.le.{u1} (Filter.{u1} (Prod.{u1, u1} α α)) (Preorder.toLE.{u1} (Filter.{u1} (Prod.{u1, u1} α α)) (PartialOrder.toPreorder.{u1} (Filter.{u1} (Prod.{u1, u1} α α)) (Filter.instPartialOrderFilter.{u1} (Prod.{u1, u1} α α)))) (Filter.comap.{u1, u1} (Prod.{u1, u1} α α) (Prod.{u1, u1} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1))) (fun (p : Prod.{u1, u1} α α) => Prod.mk.{u1, u1} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (Quotient.mk.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1) (Prod.fst.{u1, u1} α α p)) (Quotient.mk.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1) (Prod.snd.{u1, u1} α α p))) (uniformity.{u1} (Quotient.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) (UniformSpace.separationSetoid.uniformSpace.{u1} α _inst_1))) (uniformity.{u1} α _inst_1)
Case conversion may be inaccurate. Consider using '#align uniform_space.comap_quotient_le_uniformity UniformSpace.comap_quotient_le_uniformityₓ'. -/
theorem comap_quotient_le_uniformity :
    ((𝓤 <| Quotient <| separationSetoid α).comap fun p : α × α => (⟦p.fst⟧, ⟦p.snd⟧)) ≤ 𝓤 α :=
  fun t' ht' =>
  let ⟨t, ht, tt_t'⟩ := comp_mem_uniformity_sets ht'
  let ⟨s, hs, ss_t⟩ := comp_mem_uniformity_sets ht
  ⟨(fun p : α × α => (⟦p.1⟧, ⟦p.2⟧)) '' s, (𝓤 α).sets_of_superset hs fun x hx => ⟨x, hx, rfl⟩,
    fun ⟨a₁, a₂⟩ ⟨⟨b₁, b₂⟩, hb, ab_eq⟩ =>
    have : ⟦b₁⟧ = ⟦a₁⟧ ∧ ⟦b₂⟧ = ⟦a₂⟧ := Prod.mk.inj ab_eq
    have : b₁ ≈ a₁ ∧ b₂ ≈ a₂ := And.imp Quotient.exact Quotient.exact this
    have ab₁ : (a₁, b₁) ∈ t := (Setoid.symm this.left) t ht
    have ba₂ : (b₂, a₂) ∈ s := this.right s hs
    tt_t'
      ⟨b₁, show ((a₁, a₂).1, b₁) ∈ t from ab₁, ss_t ⟨b₂, show ((b₁, a₂).1, b₂) ∈ s from hb, ba₂⟩⟩⟩
#align uniform_space.comap_quotient_le_uniformity UniformSpace.comap_quotient_le_uniformity

#print UniformSpace.comap_quotient_eq_uniformity /-
theorem comap_quotient_eq_uniformity :
    ((𝓤 <| Quotient <| separationSetoid α).comap fun p : α × α => (⟦p.fst⟧, ⟦p.snd⟧)) = 𝓤 α :=
  le_antisymm comap_quotient_le_uniformity le_comap_map
#align uniform_space.comap_quotient_eq_uniformity UniformSpace.comap_quotient_eq_uniformity
-/

#print UniformSpace.separated_separation /-
instance separated_separation : SeparatedSpace (Quotient (separationSetoid α)) :=
  ⟨Set.ext fun ⟨a, b⟩ =>
      Quotient.induction_on₂ a b fun a b =>
        ⟨fun h =>
          have : a ≈ b := fun s hs =>
            have :
              s ∈ (𝓤 <| Quotient <| separationSetoid α).comap fun p : α × α => (⟦p.1⟧, ⟦p.2⟧) :=
              comap_quotient_le_uniformity hs
            let ⟨t, ht, hts⟩ := this
            hts (by dsimp [preimage]; exact h t ht)
          show ⟦a⟧ = ⟦b⟧ from Quotient.sound this,
          fun heq : ⟦a⟧ = ⟦b⟧ => fun h hs => HEq ▸ refl_mem_uniformity hs⟩⟩
#align uniform_space.separated_separation UniformSpace.separated_separation
-/

#print UniformSpace.separated_of_uniformContinuous /-
theorem separated_of_uniformContinuous {f : α → β} {x y : α} (H : UniformContinuous f) (h : x ≈ y) :
    f x ≈ f y := fun _ h' => h _ (H h')
#align uniform_space.separated_of_uniform_continuous UniformSpace.separated_of_uniformContinuous
-/

#print UniformSpace.eq_of_separated_of_uniformContinuous /-
theorem eq_of_separated_of_uniformContinuous [SeparatedSpace β] {f : α → β} {x y : α}
    (H : UniformContinuous f) (h : x ≈ y) : f x = f y :=
  separated_def.1 (by infer_instance) _ _ <| separated_of_uniformContinuous H h
#align uniform_space.eq_of_separated_of_uniform_continuous UniformSpace.eq_of_separated_of_uniformContinuous
-/

#print UniformSpace.SeparationQuotient /-
/-- The maximal separated quotient of a uniform space `α`. -/
def SeparationQuotient (α : Type _) [UniformSpace α] :=
  Quotient (separationSetoid α)
#align uniform_space.separation_quotient UniformSpace.SeparationQuotient
-/

namespace SeparationQuotient

instance : UniformSpace (SeparationQuotient α) :=
  separationSetoid.uniformSpace

instance : SeparatedSpace (SeparationQuotient α) :=
  UniformSpace.separated_separation

instance [Inhabited α] : Inhabited (SeparationQuotient α) :=
  Quotient.inhabited (separationSetoid α)

#print UniformSpace.SeparationQuotient.mk_eq_mk /-
theorem mk_eq_mk {x y : α} : (⟦x⟧ : SeparationQuotient α) = ⟦y⟧ ↔ Inseparable x y :=
  Quotient.eq''.trans separationRel_iff_inseparable
#align uniform_space.separation_quotient.mk_eq_mk UniformSpace.SeparationQuotient.mk_eq_mk
-/

#print UniformSpace.SeparationQuotient.lift /-
/-- Factoring functions to a separated space through the separation quotient. -/
def lift [SeparatedSpace β] (f : α → β) : SeparationQuotient α → β :=
  if h : UniformContinuous f then Quotient.lift f fun x y => eq_of_separated_of_uniformContinuous h
  else fun x => f (Nonempty.some ⟨x.out⟩)
#align uniform_space.separation_quotient.lift UniformSpace.SeparationQuotient.lift
-/

#print UniformSpace.SeparationQuotient.lift_mk /-
theorem lift_mk [SeparatedSpace β] {f : α → β} (h : UniformContinuous f) (a : α) :
    lift f ⟦a⟧ = f a := by rw [lift, dif_pos h] <;> rfl
#align uniform_space.separation_quotient.lift_mk UniformSpace.SeparationQuotient.lift_mk
-/

#print UniformSpace.SeparationQuotient.uniformContinuous_lift /-
theorem uniformContinuous_lift [SeparatedSpace β] (f : α → β) : UniformContinuous (lift f) :=
  by
  by_cases hf : UniformContinuous f
  · rw [lift, dif_pos hf]
    exact uniform_continuous_quotient_lift hf
  · rw [lift, dif_neg hf]
    exact uniformContinuous_of_const fun a b => rfl
#align uniform_space.separation_quotient.uniform_continuous_lift UniformSpace.SeparationQuotient.uniformContinuous_lift
-/

#print UniformSpace.SeparationQuotient.map /-
/-- The separation quotient functor acting on functions. -/
def map (f : α → β) : SeparationQuotient α → SeparationQuotient β :=
  lift (Quotient.mk' ∘ f)
#align uniform_space.separation_quotient.map UniformSpace.SeparationQuotient.map
-/

#print UniformSpace.SeparationQuotient.map_mk /-
theorem map_mk {f : α → β} (h : UniformContinuous f) (a : α) : map f ⟦a⟧ = ⟦f a⟧ := by
  rw [map, lift_mk (uniform_continuous_quotient_mk.comp h)]
#align uniform_space.separation_quotient.map_mk UniformSpace.SeparationQuotient.map_mk
-/

#print UniformSpace.SeparationQuotient.uniformContinuous_map /-
theorem uniformContinuous_map (f : α → β) : UniformContinuous (map f) :=
  uniformContinuous_lift (Quotient.mk' ∘ f)
#align uniform_space.separation_quotient.uniform_continuous_map UniformSpace.SeparationQuotient.uniformContinuous_map
-/

#print UniformSpace.SeparationQuotient.map_unique /-
theorem map_unique {f : α → β} (hf : UniformContinuous f)
    {g : SeparationQuotient α → SeparationQuotient β} (comm : Quotient.mk' ∘ f = g ∘ Quotient.mk') :
    map f = g := by
  ext ⟨a⟩ <;>
    calc
      map f ⟦a⟧ = ⟦f a⟧ := map_mk hf a
      _ = g ⟦a⟧ := congr_fun comm a

#align uniform_space.separation_quotient.map_unique UniformSpace.SeparationQuotient.map_unique
-/

#print UniformSpace.SeparationQuotient.map_id /-
theorem map_id : map (@id α) = id :=
  map_unique uniformContinuous_id rfl
#align uniform_space.separation_quotient.map_id UniformSpace.SeparationQuotient.map_id
-/

#print UniformSpace.SeparationQuotient.map_comp /-
theorem map_comp {f : α → β} {g : β → γ} (hf : UniformContinuous f) (hg : UniformContinuous g) :
    map g ∘ map f = map (g ∘ f) :=
  (map_unique (hg.comp hf) <| by simp only [(· ∘ ·), map_mk, hf, hg]).symm
#align uniform_space.separation_quotient.map_comp UniformSpace.SeparationQuotient.map_comp
-/

end SeparationQuotient

/- warning: uniform_space.separation_prod -> UniformSpace.separation_prod is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : UniformSpace.{u1} α] [_inst_2 : UniformSpace.{u2} β] {a₁ : α} {a₂ : α} {b₁ : β} {b₂ : β}, Iff (HasEquivₓ.Equiv.{max (succ u1) (succ u2)} (Prod.{u1, u2} α β) (setoidHasEquiv.{max (succ u1) (succ u2)} (Prod.{u1, u2} α β) (UniformSpace.separationSetoid.{max u1 u2} (Prod.{u1, u2} α β) (Prod.uniformSpace.{u1, u2} α β _inst_1 _inst_2))) (Prod.mk.{u1, u2} α β a₁ b₁) (Prod.mk.{u1, u2} α β a₂ b₂)) (And (HasEquivₓ.Equiv.{succ u1} α (setoidHasEquiv.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) a₁ a₂) (HasEquivₓ.Equiv.{succ u2} β (setoidHasEquiv.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2)) b₁ b₂))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : UniformSpace.{u1} α] [_inst_2 : UniformSpace.{u2} β] {a₁ : α} {a₂ : α} {b₁ : β} {b₂ : β}, Iff (HasEquiv.Equiv.{max (succ u2) (succ u1), 0} (Prod.{u1, u2} α β) (instHasEquiv.{max (succ u1) (succ u2)} (Prod.{u1, u2} α β) (UniformSpace.separationSetoid.{max u1 u2} (Prod.{u1, u2} α β) (instUniformSpaceProd.{u1, u2} α β _inst_1 _inst_2))) (Prod.mk.{u1, u2} α β a₁ b₁) (Prod.mk.{u1, u2} α β a₂ b₂)) (And (HasEquiv.Equiv.{succ u1, 0} α (instHasEquiv.{succ u1} α (UniformSpace.separationSetoid.{u1} α _inst_1)) a₁ a₂) (HasEquiv.Equiv.{succ u2, 0} β (instHasEquiv.{succ u2} β (UniformSpace.separationSetoid.{u2} β _inst_2)) b₁ b₂))
Case conversion may be inaccurate. Consider using '#align uniform_space.separation_prod UniformSpace.separation_prodₓ'. -/
theorem separation_prod {a₁ a₂ : α} {b₁ b₂ : β} : (a₁, b₁) ≈ (a₂, b₂) ↔ a₁ ≈ a₂ ∧ b₁ ≈ b₂ :=
  by
  constructor
  · intro h
    exact
      ⟨separated_of_uniform_continuous uniformContinuous_fst h,
        separated_of_uniform_continuous uniformContinuous_snd h⟩
  · rintro ⟨eqv_α, eqv_β⟩ r r_in
    rw [uniformity_prod] at r_in
    rcases r_in with ⟨t_α, ⟨r_α, r_α_in, h_α⟩, t_β, ⟨r_β, r_β_in, h_β⟩, rfl⟩
    let p_α := fun p : (α × β) × α × β => (p.1.1, p.2.1)
    let p_β := fun p : (α × β) × α × β => (p.1.2, p.2.2)
    have key_α : p_α ((a₁, b₁), (a₂, b₂)) ∈ r_α := by simp [p_α, eqv_α r_α r_α_in]
    have key_β : p_β ((a₁, b₁), (a₂, b₂)) ∈ r_β := by simp [p_β, eqv_β r_β r_β_in]
    exact ⟨h_α key_α, h_β key_β⟩
#align uniform_space.separation_prod UniformSpace.separation_prod

/- warning: uniform_space.separated.prod -> UniformSpace.Separated.prod is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : UniformSpace.{u1} α] [_inst_2 : UniformSpace.{u2} β] [_inst_4 : SeparatedSpace.{u1} α _inst_1] [_inst_5 : SeparatedSpace.{u2} β _inst_2], SeparatedSpace.{max u1 u2} (Prod.{u1, u2} α β) (Prod.uniformSpace.{u1, u2} α β _inst_1 _inst_2)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : UniformSpace.{u1} α] [_inst_2 : UniformSpace.{u2} β] [_inst_4 : SeparatedSpace.{u1} α _inst_1] [_inst_5 : SeparatedSpace.{u2} β _inst_2], SeparatedSpace.{max u2 u1} (Prod.{u1, u2} α β) (instUniformSpaceProd.{u1, u2} α β _inst_1 _inst_2)
Case conversion may be inaccurate. Consider using '#align uniform_space.separated.prod UniformSpace.Separated.prodₓ'. -/
instance Separated.prod [SeparatedSpace α] [SeparatedSpace β] : SeparatedSpace (α × β) :=
  separated_def.2 fun x y H =>
    Prod.ext (eq_of_separated_of_uniformContinuous uniformContinuous_fst H)
      (eq_of_separated_of_uniformContinuous uniformContinuous_snd H)
#align uniform_space.separated.prod UniformSpace.Separated.prod

end UniformSpace


import algebra.ordered_ring

variables {R : Type*} [ordered_ring R]
variables a b c : R

example : a ≤ b → 0 ≤ b - a :=
begin
  intro hyp,
  have h₁: a + (- a)  ≤ b + (-a) ,
  exact add_le_add_right hyp (-a),
  have h₂: a + (-a) = 0,
  apply add_neg_self a,
  rw h₂ at h₁,
  have h₃: b + (-a) = b-a,
  apply (sub_eq_add_neg b a).symm,
  rw h₃ at h₁,
  exact h₁,
end


import data.real.basic
#check pow_two_nonneg

variables {x y : ℝ}

-- BEGIN
example (h : y > x^2) : y > 0 ∨ y < -1 :=
begin
  left,
  linarith [pow_two_nonneg x],
end

example (h : -y > x^2 + 1) : y > 0 ∨ y < -1 :=
begin
  right,
  linarith [pow_two_nonneg x],
end

--Alternatively
example (h : y > 0) : y > 0 ∨ y < -1 :=
or.inl h

example (h : y < -1) : y > 0 ∨ y < -1 :=
or.inr h
-- END


import data.real.basic

variables {u v: ℕ → ℝ} {l l' : ℝ}

notation `|`x`|` := abs x

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

lemma ge_max_iff {α : Type*} [linear_order α] {p q r : α} : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q :=
max_le_iff

example (hu : seq_limit u l) (hv : seq_limit v l') :
seq_limit (u + v) (l + l') :=
begin
  intros eps eps_pos,
  cases hu (eps/2) (by linarith) with N1 hN1,
  cases hv (eps/2) (by linarith) with N2 hN2,
  let N0:= max N1 N2,
  use N0,
  intros n hn,
  rw ge_max_iff at hn,
  calc
  |(u + v) n - (l + l')| = |u n + v n - (l + l')|   : rfl
                     ... = |(u n - l) + (v n - l')| : by congr' 1 ; ring
                     ... ≤ |u n - l| + |v n - l'|   : by apply abs_add
                     ... ≤  eps                     : by linarith [hN1 n (by linarith),
                                                                   hN2 n (by linarith)],
end


/-
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, Devon Tuma

! This file was ported from Lean 3 source module probability.probability_mass_function.constructions
! leanprover-community/mathlib commit 4ac69b290818724c159de091daa3acd31da0ee6d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Probability.ProbabilityMassFunction.Monad

/-!
# Specific Constructions of Probability Mass Functions

This file gives a number of different `pmf` constructions for common probability distributions.

`map` and `seq` allow pushing a `pmf α` along a function `f : α → β` (or distribution of
functions `f : pmf (α → β)`) to get a `pmf β`

`of_finset` and `of_fintype` simplify the construction of a `pmf α` from a function `f : α → ℝ≥0∞`,
by allowing the "sum equals 1" constraint to be in terms of `finset.sum` instead of `tsum`.

`normalize` constructs a `pmf α` by normalizing a function `f : α → ℝ≥0∞` by its sum,
and `filter` uses this to filter the support of a `pmf` and re-normalize the new distribution.

`bernoulli` represents the bernoulli distribution on `bool`

-/

namespace Pmf

noncomputable section

variable {α β γ : Type _}

open Classical BigOperators NNReal ENNReal

section Map

/-- The functorial action of a function on a `pmf`. -/
def map (f : α → β) (p : Pmf α) : Pmf β :=
  bind p (pure ∘ f)
#align pmf.map Pmf.map

variable (f : α → β) (p : Pmf α) (b : β)

theorem monad_map_eq_map {α β : Type _} (f : α → β) (p : Pmf α) : f <$> p = p.map f :=
  rfl
#align pmf.monad_map_eq_map Pmf.monad_map_eq_map

@[simp]
theorem map_apply : (map f p) b = ∑' a, if b = f a then p a else 0 := by simp [map]
#align pmf.map_apply Pmf.map_apply

@[simp]
theorem support_map : (map f p).support = f '' p.support :=
  Set.ext fun b => by simp [map, @eq_comm β b]
#align pmf.support_map Pmf.support_map

theorem mem_support_map_iff : b ∈ (map f p).support ↔ ∃ a ∈ p.support, f a = b := by simp
#align pmf.mem_support_map_iff Pmf.mem_support_map_iff

theorem bind_pure_comp : bind p (pure ∘ f) = map f p :=
  rfl
#align pmf.bind_pure_comp Pmf.bind_pure_comp

theorem map_id : map id p = p :=
  bind_pure _
#align pmf.map_id Pmf.map_id

theorem map_comp (g : β → γ) : (p.map f).map g = p.map (g ∘ f) := by simp [map]
#align pmf.map_comp Pmf.map_comp

theorem pure_map (a : α) : (pure a).map f = pure (f a) :=
  pure_bind _ _
#align pmf.pure_map Pmf.pure_map

theorem map_bind (q : α → Pmf β) (f : β → γ) : (p.bind q).map f = p.bind fun a => (q a).map f :=
  bind_bind _ _ _
#align pmf.map_bind Pmf.map_bind

@[simp]
theorem bind_map (p : Pmf α) (f : α → β) (q : β → Pmf γ) : (p.map f).bind q = p.bind (q ∘ f) :=
  (bind_bind _ _ _).trans (congr_arg _ (funext fun a => pure_bind _ _))
#align pmf.bind_map Pmf.bind_map

@[simp]
theorem map_const : p.map (Function.const α b) = pure b := by
  simp only [map, bind_const, Function.comp_const]
#align pmf.map_const Pmf.map_const

section Measure

variable (s : Set β)

@[simp]
theorem toOuterMeasure_map_apply : (p.map f).toOuterMeasure s = p.toOuterMeasure (f ⁻¹' s) := by
  simp [map, Set.indicator, to_outer_measure_apply p (f ⁻¹' s)]
#align pmf.to_outer_measure_map_apply Pmf.toOuterMeasure_map_apply

@[simp]
theorem toMeasure_map_apply [MeasurableSpace α] [MeasurableSpace β] (hf : Measurable f)
    (hs : MeasurableSet s) : (p.map f).toMeasure s = p.toMeasure (f ⁻¹' s) :=
  by
  rw [to_measure_apply_eq_to_outer_measure_apply _ s hs,
    to_measure_apply_eq_to_outer_measure_apply _ (f ⁻¹' s) (measurableSet_preimage hf hs)]
  exact to_outer_measure_map_apply f p s
#align pmf.to_measure_map_apply Pmf.toMeasure_map_apply

end Measure

end Map

section Seq

/-- The monadic sequencing operation for `pmf`. -/
def seq (q : Pmf (α → β)) (p : Pmf α) : Pmf β :=
  q.bind fun m => p.bind fun a => pure (m a)
#align pmf.seq Pmf.seq

variable (q : Pmf (α → β)) (p : Pmf α) (b : β)

theorem monad_seq_eq_seq {α β : Type _} (q : Pmf (α → β)) (p : Pmf α) : q <*> p = q.seq p :=
  rfl
#align pmf.monad_seq_eq_seq Pmf.monad_seq_eq_seq

@[simp]
theorem seq_apply : (seq q p) b = ∑' (f : α → β) (a : α), if b = f a then q f * p a else 0 :=
  by
  simp only [seq, mul_boole, bind_apply, pure_apply]
  refine' tsum_congr fun f => ENNReal.tsum_mul_left.symm.trans (tsum_congr fun a => _)
  simpa only [MulZeroClass.mul_zero] using mul_ite (b = f a) (q f) (p a) 0
#align pmf.seq_apply Pmf.seq_apply

@[simp]
theorem support_seq : (seq q p).support = ⋃ f ∈ q.support, f '' p.support :=
  Set.ext fun b => by simp [-mem_support_iff, seq, @eq_comm β b]
#align pmf.support_seq Pmf.support_seq

theorem mem_support_seq_iff : b ∈ (seq q p).support ↔ ∃ f ∈ q.support, b ∈ f '' p.support := by simp
#align pmf.mem_support_seq_iff Pmf.mem_support_seq_iff

end Seq

instance : LawfulFunctor Pmf where
  mapConst_eq α β := rfl
  id_map α := bind_pure
  comp_map α β γ g h x := (map_comp _ _ _).symm

instance : LawfulMonad Pmf where
  bind_pure_comp_eq_map α β f x := rfl
  bind_map_eq_seq α β f x := rfl
  pure_bind α β := pure_bind
  bind_assoc α β γ := bind_bind

section OfFinset

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (a «expr ∉ » s) -/
/-- Given a finset `s` and a function `f : α → ℝ≥0∞` with sum `1` on `s`,
  such that `f a = 0` for `a ∉ s`, we get a `pmf` -/
def ofFinset (f : α → ℝ≥0∞) (s : Finset α) (h : (∑ a in s, f a) = 1)
    (h' : ∀ (a) (_ : a ∉ s), f a = 0) : Pmf α :=
  ⟨f, h ▸ hasSum_sum_of_ne_finset_zero h'⟩
#align pmf.of_finset Pmf.ofFinset

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (a «expr ∉ » s) -/
variable {f : α → ℝ≥0∞} {s : Finset α} (h : (∑ a in s, f a) = 1) (h' : ∀ (a) (_ : a ∉ s), f a = 0)

@[simp]
theorem ofFinset_apply (a : α) : ofFinset f s h h' a = f a :=
  rfl
#align pmf.of_finset_apply Pmf.ofFinset_apply

@[simp]
theorem support_ofFinset : (ofFinset f s h h').support = s ∩ Function.support f :=
  Set.ext fun a => by simpa [mem_support_iff] using mt (h' a)
#align pmf.support_of_finset Pmf.support_ofFinset

theorem mem_support_ofFinset_iff (a : α) : a ∈ (ofFinset f s h h').support ↔ a ∈ s ∧ f a ≠ 0 := by
  simp
#align pmf.mem_support_of_finset_iff Pmf.mem_support_ofFinset_iff

theorem ofFinset_apply_of_not_mem {a : α} (ha : a ∉ s) : ofFinset f s h h' a = 0 :=
  h' a ha
#align pmf.of_finset_apply_of_not_mem Pmf.ofFinset_apply_of_not_mem

section Measure

variable (t : Set α)

@[simp]
theorem toOuterMeasure_ofFinset_apply :
    (ofFinset f s h h').toOuterMeasure t = ∑' x, t.indicator f x :=
  toOuterMeasure_apply (ofFinset f s h h') t
#align pmf.to_outer_measure_of_finset_apply Pmf.toOuterMeasure_ofFinset_apply

@[simp]
theorem toMeasure_ofFinset_apply [MeasurableSpace α] (ht : MeasurableSet t) :
    (ofFinset f s h h').toMeasure t = ∑' x, t.indicator f x :=
  (toMeasure_apply_eq_toOuterMeasure_apply _ t ht).trans (toOuterMeasure_ofFinset_apply h h' t)
#align pmf.to_measure_of_finset_apply Pmf.toMeasure_ofFinset_apply

end Measure

end OfFinset

section OfFintype

/-- Given a finite type `α` and a function `f : α → ℝ≥0∞` with sum 1, we get a `pmf`. -/
def ofFintype [Fintype α] (f : α → ℝ≥0∞) (h : (∑ a, f a) = 1) : Pmf α :=
  ofFinset f Finset.univ h fun a ha => absurd (Finset.mem_univ a) ha
#align pmf.of_fintype Pmf.ofFintype

variable [Fintype α] {f : α → ℝ≥0∞} (h : (∑ a, f a) = 1)

@[simp]
theorem ofFintype_apply (a : α) : ofFintype f h a = f a :=
  rfl
#align pmf.of_fintype_apply Pmf.ofFintype_apply

@[simp]
theorem support_ofFintype : (ofFintype f h).support = Function.support f :=
  rfl
#align pmf.support_of_fintype Pmf.support_ofFintype

theorem mem_support_ofFintype_iff (a : α) : a ∈ (ofFintype f h).support ↔ f a ≠ 0 :=
  Iff.rfl
#align pmf.mem_support_of_fintype_iff Pmf.mem_support_ofFintype_iff

section Measure

variable (s : Set α)

@[simp]
theorem toOuterMeasure_ofFintype_apply : (ofFintype f h).toOuterMeasure s = ∑' x, s.indicator f x :=
  toOuterMeasure_apply (ofFintype f h) s
#align pmf.to_outer_measure_of_fintype_apply Pmf.toOuterMeasure_ofFintype_apply

@[simp]
theorem toMeasure_ofFintype_apply [MeasurableSpace α] (hs : MeasurableSet s) :
    (ofFintype f h).toMeasure s = ∑' x, s.indicator f x :=
  (toMeasure_apply_eq_toOuterMeasure_apply _ s hs).trans (toOuterMeasure_ofFintype_apply h s)
#align pmf.to_measure_of_fintype_apply Pmf.toMeasure_ofFintype_apply

end Measure

end OfFintype

section normalize

/-- Given a `f` with non-zero and non-infinite sum, get a `pmf` by normalizing `f` by its `tsum` -/
def normalize (f : α → ℝ≥0∞) (hf0 : tsum f ≠ 0) (hf : tsum f ≠ ∞) : Pmf α :=
  ⟨fun a => f a * (∑' x, f x)⁻¹,
    ENNReal.summable.hasSum_iff.2 (ENNReal.tsum_mul_right.trans (ENNReal.mul_inv_cancel hf0 hf))⟩
#align pmf.normalize Pmf.normalize

variable {f : α → ℝ≥0∞} (hf0 : tsum f ≠ 0) (hf : tsum f ≠ ∞)

@[simp]
theorem normalize_apply (a : α) : (normalize f hf0 hf) a = f a * (∑' x, f x)⁻¹ :=
  rfl
#align pmf.normalize_apply Pmf.normalize_apply

@[simp]
theorem support_normalize : (normalize f hf0 hf).support = Function.support f :=
  Set.ext fun a => by simp [hf, mem_support_iff]
#align pmf.support_normalize Pmf.support_normalize

theorem mem_support_normalize_iff (a : α) : a ∈ (normalize f hf0 hf).support ↔ f a ≠ 0 := by simp
#align pmf.mem_support_normalize_iff Pmf.mem_support_normalize_iff

end normalize

section Filter

/-- Create new `pmf` by filtering on a set with non-zero measure and normalizing -/
def filter (p : Pmf α) (s : Set α) (h : ∃ a ∈ s, a ∈ p.support) : Pmf α :=
  Pmf.normalize (s.indicator p) (by simpa using h) (p.tsum_coe_indicator_ne_top s)
#align pmf.filter Pmf.filter

variable {p : Pmf α} {s : Set α} (h : ∃ a ∈ s, a ∈ p.support)

@[simp]
theorem filter_apply (a : α) :
    (p.filterₓ s h) a = s.indicator p a * (∑' a', (s.indicator p) a')⁻¹ := by
  rw [Filter, normalize_apply]
#align pmf.filter_apply Pmf.filter_apply

theorem filter_apply_eq_zero_of_not_mem {a : α} (ha : a ∉ s) : (p.filterₓ s h) a = 0 := by
  rw [filter_apply, set.indicator_apply_eq_zero.mpr fun ha' => absurd ha' ha, MulZeroClass.zero_mul]
#align pmf.filter_apply_eq_zero_of_not_mem Pmf.filter_apply_eq_zero_of_not_mem

theorem mem_support_filter_iff {a : α} : a ∈ (p.filterₓ s h).support ↔ a ∈ s ∧ a ∈ p.support :=
  (mem_support_normalize_iff _ _ _).trans Set.indicator_apply_ne_zero
#align pmf.mem_support_filter_iff Pmf.mem_support_filter_iff

@[simp]
theorem support_filter : (p.filterₓ s h).support = s ∩ p.support :=
  Set.ext fun x => mem_support_filter_iff _
#align pmf.support_filter Pmf.support_filter

theorem filter_apply_eq_zero_iff (a : α) : (p.filterₓ s h) a = 0 ↔ a ∉ s ∨ a ∉ p.support := by
  erw [apply_eq_zero_iff, support_filter, Set.mem_inter_iff, not_and_or]
#align pmf.filter_apply_eq_zero_iff Pmf.filter_apply_eq_zero_iff

theorem filter_apply_ne_zero_iff (a : α) : (p.filterₓ s h) a ≠ 0 ↔ a ∈ s ∧ a ∈ p.support := by
  rw [Ne.def, filter_apply_eq_zero_iff, not_or, Classical.not_not, Classical.not_not]
#align pmf.filter_apply_ne_zero_iff Pmf.filter_apply_ne_zero_iff

end Filter

section Bernoulli

/-- A `pmf` which assigns probability `p` to `tt` and `1 - p` to `ff`. -/
def bernoulli (p : ℝ≥0∞) (h : p ≤ 1) : Pmf Bool :=
  ofFintype (fun b => cond b p (1 - p)) (by simp [h])
#align pmf.bernoulli Pmf.bernoulli

variable {p : ℝ≥0∞} (h : p ≤ 1) (b : Bool)

@[simp]
theorem bernoulli_apply : bernoulli p h b = cond b p (1 - p) :=
  rfl
#align pmf.bernoulli_apply Pmf.bernoulli_apply

@[simp]
theorem support_bernoulli : (bernoulli p h).support = { b | cond b (p ≠ 0) (p ≠ 1) } :=
  by
  refine' Set.ext fun b => _
  induction b
  · simp_rw [mem_support_iff, bernoulli_apply, Bool.cond_false, Ne.def, tsub_eq_zero_iff_le, not_le]
    exact ⟨ne_of_lt, lt_of_le_of_ne h⟩
  · simp only [mem_support_iff, bernoulli_apply, Bool.cond_true, Set.mem_setOf_eq]
#align pmf.support_bernoulli Pmf.support_bernoulli

theorem mem_support_bernoulli_iff : b ∈ (bernoulli p h).support ↔ cond b (p ≠ 0) (p ≠ 1) := by simp
#align pmf.mem_support_bernoulli_iff Pmf.mem_support_bernoulli_iff

end Bernoulli

end Pmf


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad
-/
import Std.Data.Nat.Lemmas
import Mathlib.Init.ZeroOne
import Mathlib.Init.Data.Nat.Basic
import Mathlib.Init.Algebra.Functions

universe u

namespace Nat

/- multiplication -/

theorem eq_zero_of_mul_eq_zero : ∀ {n m : ℕ}, n * m = 0 → n = 0 ∨ m = 0
| 0,        m => fun _ => Or.inl rfl
| (succ n), m => by
    rw [succ_mul]
    intro h
    exact Or.inr (Nat.eq_zero_of_add_eq_zero_left h)

/- properties of inequality -/

instance linearOrder : LinearOrder ℕ where
  le := Nat.le
  le_refl := @Nat.le_refl
  le_trans := @Nat.le_trans
  le_antisymm := @Nat.le_antisymm
  le_total := @Nat.le_total
  lt := Nat.lt
  lt_iff_le_not_le := @Nat.lt_iff_le_not_le
  decidable_lt := inferInstance
  decidable_le := inferInstance
  decidable_eq := inferInstance

/- TODO(Leo): sub + inequalities -/

protected def strong_rec_on {p : ℕ → Sort u}
  (n : ℕ) (H : ∀ n, (∀ m, m < n → p m) → p n) : p n :=
Nat.lt_wfRel.wf.fix' H n

@[elab_as_elim]
protected lemma strong_induction_on {p : Nat → Prop} (n : Nat) (h : ∀ n, (∀ m, m < n → p m) → p n) :
    p n :=
Nat.strong_rec_on n h

protected lemma case_strong_induction_on {p : Nat → Prop} (a : Nat)
  (hz : p 0)
  (hi : ∀ n, (∀ m, m ≤ n → p m) → p (succ n)) : p a :=
Nat.strong_induction_on a $ λ n =>
  match n with
  | 0     => λ _ => hz
  | (n+1) => λ h₁ => hi n (λ _ h₂ => h₁ _ (lt_succ_of_le h₂))

/- mod -/

-- TODO mod_core_congr

#align nat.mod_def Nat.mod_eq

/- div & mod -/

-- TODO div_core_congr

#align nat.div_def Nat.div_eq

/- div -/

def iterate {α : Sort u} (op : α → α) : ℕ → α → α
 | 0,      a => a
 | succ k, a => iterate op k (op a)

notation f "^["n"]" => iterate f n

/-! bit0/bit1 properties -/
section bit
set_option linter.deprecated false

protected theorem bit1_eq_succ_bit0 (n : ℕ) : bit1 n = succ (bit0 n) :=
  rfl
#align nat.bit1_eq_succ_bit0 Nat.bit1_eq_succ_bit0

protected theorem bit1_succ_eq (n : ℕ) : bit1 (succ n) = succ (succ (bit1 n)) :=
  Eq.trans (Nat.bit1_eq_succ_bit0 (succ n)) (congr_arg succ (Nat.bit0_succ_eq n))
#align nat.bit1_succ_eq Nat.bit1_succ_eq

protected theorem bit1_ne_one : ∀ {n : ℕ}, n ≠ 0 → bit1 n ≠ 1
  | 0, h, _ => absurd rfl h
  | _ + 1, _, h1 => Nat.noConfusion h1 fun h2 => absurd h2 (succ_ne_zero _)
#align nat.bit1_ne_one Nat.bit1_ne_one

protected theorem bit0_ne_one : ∀ n : ℕ, bit0 n ≠ 1
  | 0, h => absurd h (Ne.symm Nat.one_ne_zero)
  | n + 1, h =>
    have h1 : succ (succ (n + n)) = 1 := succ_add n n ▸ h
    Nat.noConfusion h1 fun h2 => absurd h2 (succ_ne_zero (n + n))
#align nat.bit0_ne_one Nat.bit0_ne_one

protected theorem bit1_ne_bit0 : ∀ n m : ℕ, bit1 n ≠ bit0 m
  | 0, m, h => absurd h (Ne.symm (Nat.add_self_ne_one m))
  | n + 1, 0, h =>
    have h1 : succ (bit0 (succ n)) = 0 := h
    absurd h1 (Nat.succ_ne_zero _)
  | n + 1, m + 1, h =>
    have h1 : succ (succ (bit1 n)) = succ (succ (bit0 m)) :=
      Nat.bit0_succ_eq m ▸ Nat.bit1_succ_eq n ▸ h
    have h2 : bit1 n = bit0 m := Nat.noConfusion h1 fun h2' => Nat.noConfusion h2' fun h2'' => h2''
    absurd h2 (Nat.bit1_ne_bit0 n m)
#align nat.bit1_ne_bit0 Nat.bit1_ne_bit0

protected theorem bit0_ne_bit1 : ∀ n m : ℕ, bit0 n ≠ bit1 m := fun n m : Nat =>
  Ne.symm (Nat.bit1_ne_bit0 m n)
#align nat.bit0_ne_bit1 Nat.bit0_ne_bit1

protected

protected theorem bit1_inj : ∀ {n m : ℕ}, bit1 n = bit1 m → n = m := @fun n m h =>
  have : succ (bit0 n) = succ (bit0 m) := by simp [Nat.bit1_eq_succ_bit0] at h; rw [h]
  have : bit0 n = bit0 m := by injection this
  Nat.bit0_inj this
#align nat.bit1_inj Nat.bit1_inj

protected theorem bit0_ne {n m : ℕ} : n ≠ m → bit0 n ≠ bit0 m := fun h₁ h₂ =>
  absurd (Nat.bit0_inj h₂) h₁
#align nat.bit0_ne Nat.bit0_ne

protected theorem bit1_ne {n m : ℕ} : n ≠ m → bit1 n ≠ bit1 m := fun h₁ h₂ =>
  absurd (Nat.bit1_inj h₂) h₁
#align nat.bit1_ne Nat.bit1_ne

protected theorem zero_ne_bit0 {n : ℕ} : n ≠ 0 → 0 ≠ bit0 n := fun h => Ne.symm (Nat.bit0_ne_zero h)
#align nat.zero_ne_bit0 Nat.zero_ne_bit0

protected theorem zero_ne_bit1 (n : ℕ) : 0 ≠ bit1 n :=
  Ne.symm (Nat.bit1_ne_zero n)
#align nat.zero_ne_bit1 Nat.zero_ne_bit1

protected theorem one_ne_bit0 (n : ℕ) : 1 ≠ bit0 n :=
  Ne.symm (Nat.bit0_ne_one n)
#align nat.one_ne_bit0 Nat.one_ne_bit0

protected theorem one_ne_bit1 {n : ℕ} : n ≠ 0 → 1 ≠ bit1 n := fun h => Ne.symm (Nat.bit1_ne_one h)
#align nat.one_ne_bit1 Nat.one_ne_bit1

protected theorem one_lt_bit1 : ∀ {n : Nat}, n ≠ 0 → 1 < bit1 n
  | 0, h => by contradiction
  | succ n, _ => by
    rw [Nat.bit1_succ_eq]
    apply succ_lt_succ
    apply zero_lt_succ
#align nat.one_lt_bit1 Nat.one_lt_bit1

protected theorem one_lt_bit0 : ∀ {n : Nat}, n ≠ 0 → 1 < bit0 n
  | 0, h => by contradiction
  | succ n, _ => by
    rw [Nat.bit0_succ_eq]
    apply succ_lt_succ
    apply zero_lt_succ
#align nat.one_lt_bit0 Nat.one_lt_bit0

protected theorem bit0_lt {n m : Nat} (h : n < m) : bit0 n < bit0 m :=
  Nat.add_lt_add h h
#align nat.bit0_lt Nat.bit0_lt

protected theorem bit1_lt {n m : Nat} (h : n < m) : bit1 n < bit1 m :=
  succ_lt_succ (Nat.add_lt_add h h)
#align nat.bit1_lt Nat.bit1_lt

protected theorem bit0_lt_bit1 {n m : Nat} (h : n ≤ m) : bit0 n < bit1 m :=
  lt_succ_of_le (Nat.add_le_add h h)
#align nat.bit0_lt_bit1 Nat.bit0_lt_bit1

protected theorem bit1_lt_bit0 : ∀ {n m : Nat}, n < m → bit1 n < bit0 m
  | n, 0, h => absurd h n.not_lt_zero
  | n, succ m, h =>
    have : n ≤ m := le_of_lt_succ h
    have : succ (n + n) ≤ succ (m + m) := succ_le_succ (Nat.add_le_add this this)
    have : succ (n + n) ≤ succ m + m := by rw [succ_add]; assumption
    show succ (n + n) < succ (succ m + m) from lt_succ_of_le this
#align nat.bit1_lt_bit0 Nat.bit1_lt_bit0

protected theorem one_le_bit1 (n : ℕ) : 1 ≤ bit1 n :=
  show 1 ≤ succ (bit0 n) from succ_le_succ (bit0 n).zero_le
#align nat.one_le_bit1 Nat.one_le_bit1

protected theorem one_le_bit0 : ∀ n : ℕ, n ≠ 0 → 1 ≤ bit0 n
  | 0, h => absurd rfl h
  | n + 1, _ =>
    suffices 1 ≤ succ (succ (bit0 n)) from Eq.symm (Nat.bit0_succ_eq n) ▸ this
    succ_le_succ (bit0 n).succ.zero_le
#align nat.one_le_bit0 Nat.one_le_bit0

end bit

/- successor and predecessor -/

def discriminate (H1 : n = 0 → α) (H2 : ∀m, n = succ m → α) : α :=
  match n with
  | 0 => H1 rfl
  | succ m => H2 m rfl

lemma one_eq_succ_zero : 1 = succ 0 := rfl

def two_step_induction {P : ℕ → Sort u} (H1 : P 0) (H2 : P 1)
    (H3 : ∀ (n : ℕ), P n → P (succ n) → P (succ (succ n))) : (a : ℕ) → P a
| 0   => H1
| 1   => H2
| _+2 => H3 _ (two_step_induction H1 H2 H3 _) (two_step_induction H1 H2 H3 _)

def sub_induction {P : ℕ → ℕ → Sort u} (H1 : ∀m, P 0 m)
   (H2 : ∀n, P (succ n) 0) (H3 : ∀n m, P n m → P (succ n) (succ m)) : (n m : ℕ) → P n m
| 0,   _   => H1 _
| _+1, 0   => H2 _
| n+1, m+1 => H3 _ _ (sub_induction H1 H2 H3 n m)

protected def lt_ge_by_cases {a b : ℕ} {C : Sort u} (h₁ : a < b → C) (h₂ : b ≤ a → C) : C :=
if h : a < b then h₁ h else h₂ (not_lt.1 h)

protected def lt_by_cases {a b : ℕ} {C : Sort u} (h₁ : a < b → C) (h₂ : a = b → C)
  (h₃ : b < a → C) : C :=
Nat.lt_ge_by_cases h₁ fun h₁ ↦
  Nat.lt_ge_by_cases h₃ fun h ↦ h₂ (Nat.le_antisymm h h₁)

/- find -/

section find
variable (p : ℕ → Prop)

private def lbp (m n : ℕ) : Prop := m = n + 1 ∧ ∀ k, k ≤ n → ¬p k

variable [DecidablePred p] (H : ∃ n, p n)

variable {p}

private def wf_lbp : WellFounded (lbp p) := by
  refine ⟨let ⟨n, pn⟩ := H; ?_⟩
  suffices ∀ m k, n ≤ k + m → Acc (lbp p) k from fun a ↦ this _ _ (Nat.le_add_left _ _)
  intro m
  induction m with refine fun k kn ↦ ⟨_, fun | _, ⟨rfl, a⟩ => ?_⟩
  | zero => exact absurd pn (a _ kn)
  | succ m IH => exact IH _ (by rw [Nat.add_right_comm]; exact kn)
/-- Used in the definition of `Nat.find`. Returns the smallest natural satisfying `p`-/
protected def findX : {n // p n ∧ ∀ m, m < n → ¬p m} :=
(wf_lbp H).fix' (C := fun k ↦ (∀n, n < k → ¬p n) → {n // p n ∧ ∀ m, m < n → ¬p m})
  (fun m IH al ↦ if pm : p m then ⟨m, pm, al⟩ else
      have this : ∀ n, n ≤ m → ¬p n := fun n h ↦
        (lt_or_eq_of_le h).elim (al n) fun e ↦ by rw [e]; exact pm
      IH _ ⟨rfl, this⟩ fun n h ↦ this n $ Nat.le_of_succ_le_succ h)
  0 fun n h ↦ absurd h (Nat.not_lt_zero _)

/--
If `p` is a (decidable) predicate on `ℕ` and `hp : ∃ (n : ℕ), p n` is a proof that
there exists some natural number satisfying `p`, then `Nat.find hp` is the
smallest natural number satisfying `p`. Note that `Nat.find` is protected,
meaning that you can't just write `find`, even if the `Nat` namespace is open.

The API for `Nat.find` is:

* `Nat.find_spec` is the proof that `Nat.find hp` satisfies `p`.
* `Nat.find_min` is the proof that if `m < Nat.find hp` then `m` does not satisfy `p`.
* `Nat.find_min'` is the proof that if `m` does satisfy `p` then `Nat.find hp ≤ m`.
-/
protected def find : ℕ := (Nat.findX H).1

protected lemma find_spec : p (Nat.find H) := (Nat.findX H).2.1

protected lemma find_min : ∀ {m : ℕ}, m < Nat.find H → ¬p m := @(Nat.findX H).2.2

protected lemma find_min' {m : ℕ} (h : p m) : Nat.find H ≤ m :=
not_lt.1 fun l ↦ Nat.find_min H l h

end find

theorem cond_decide_mod_two (x : ℕ) [d : Decidable (x % 2 = 1)] :
    cond (@decide (x % 2 = 1) d) 1 0 = x % 2 :=
  by
  by_cases h : x % 2 = 1
  · simp! [*]
  · cases mod_two_eq_zero_or_one x <;> simp! [*, Nat.zero_ne_one]
#align nat.cond_to_bool_mod_two Nat.cond_decide_mod_two

lemma to_digits_core_lens_eq_aux (b f : Nat) :
  ∀ (n : Nat) (l1 l2 : List Char), l1.length = l2.length →
    (Nat.toDigitsCore b f n l1).length = (Nat.toDigitsCore b f n l2).length := by
  induction f with (simp only [Nat.toDigitsCore, List.length]; intro n l1 l2 hlen)
  | zero => assumption
  | succ f ih =>
    by_cases hx : n / b = 0
    case pos => simp only [hx, if_true, List.length, congrArg (fun l ↦ l + 1) hlen]
    case neg =>
      simp only [hx, if_false]
      specialize ih (n / b) (Nat.digitChar (n % b) :: l1) (Nat.digitChar (n % b) :: l2)
      simp only [List.length, congrArg (fun l ↦ l + 1) hlen] at ih
      exact ih trivial

lemma to_digits_core_lens_eq (b f : Nat) : ∀ (n : Nat) (c : Char) (tl : List Char),
    (Nat.toDigitsCore b f n (c :: tl)).length = (Nat.toDigitsCore b f n tl).length + 1 := by
  induction f with (intro n c tl; simp only [Nat.toDigitsCore, List.length])
  | succ f ih =>
    by_cases hnb : (n / b) = 0
    case pos => simp only [hnb, if_true, List.length]
    case neg =>
      generalize hx: Nat.digitChar (n % b) = x
      simp only [hx, hnb, if_false] at ih
      simp only [hnb, if_false]
      specialize ih (n / b) c (x :: tl)
      rw [← ih]
      have lens_eq : (x :: (c :: tl)).length = (c :: x :: tl).length := by simp
      apply to_digits_core_lens_eq_aux
      exact lens_eq

lemma nat_repr_len_aux (n b e : Nat) (h_b_pos : 0 < b) :  n < b ^ e.succ → n / b < b ^ e := by
  simp only [Nat.pow_succ]
  exact (@Nat.div_lt_iff_lt_mul b n (b ^ e) h_b_pos).mpr

/-- The String representation produced by toDigitsCore has the proper length relative to
the number of digits in `n < e` for some base `b`. Since this works with any base greater
than one, it can be used for binary, decimal, and hex. -/
lemma to_digits_core_length (b : Nat) (h : 2 <= b) (f n e : Nat)
    (hlt : n < b ^ e) (h_e_pos: 0 < e) : (Nat.toDigitsCore b f n []).length <= e := by
  induction f generalizing n e hlt h_e_pos with
    simp only [Nat.toDigitsCore, List.length, Nat.zero_le]
  | succ f ih =>
    cases e with
    | zero => exact False.elim (Nat.lt_irrefl 0 h_e_pos)
    | succ e =>
      by_cases h_pred_pos : 0 < e
      case pos =>
        have _ : 0 < b := Nat.lt_trans (by decide) h
        specialize ih (n / b) e (nat_repr_len_aux n b e ‹0 < b› hlt) h_pred_pos
        by_cases hdiv_ten : n / b = 0
        case pos => simp only [hdiv_ten]; exact Nat.le.step h_pred_pos
        case neg =>
          simp only [hdiv_ten,
            to_digits_core_lens_eq b f (n / b) (Nat.digitChar $ n % b), if_false]
          exact Nat.succ_le_succ ih
      case neg =>
        have _ : e = 0 := Nat.eq_zero_of_nonpos e h_pred_pos
        rw [‹e = 0›]
        have _ : b ^ 1 = b := by simp only [pow_succ, pow_zero, Nat.one_mul]
        have _ : n < b := ‹b ^ 1 = b› ▸ (‹e = 0› ▸ hlt : n < b ^ Nat.succ 0)
        simp only [(@Nat.div_eq_of_lt n b ‹n < b› : n / b = 0), if_true, List.length]

/-- The core implementation of `Nat.repr` returns a String with length less than or equal to the
number of digits in the decimal number (represented by `e`). For example, the decimal string
representation of any number less than 1000 (10 ^ 3) has a length less than or equal to 3. -/
lemma repr_length (n e : Nat) : 0 < e → n < 10 ^ e → (Nat.repr n).length <= e := by
  cases n with
    (intro e0 he; simp only [Nat.repr, Nat.toDigits, String.length, List.asString])
  | zero => assumption
  | succ n =>
    by_cases hterm : n.succ / 10 = 0
    case pos => simp only [hterm, Nat.toDigitsCore]; assumption
    case neg =>
      simp only [hterm]
      exact to_digits_core_length 10 (by decide) (Nat.succ n + 1) (Nat.succ n) e he e0

end Nat

#align nat.succ_le_succ_iff Nat.succ_le_succ_iff


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

import algebra.big_operators.order
import data.nat.totient
import group_theory.order_of_element
import tactic.group

/-!
# Cyclic groups

A group `G` is called cyclic if there exists an element `g : G` such that every element of `G` is of
the form `g ^ n` for some `n : ℕ`. This file only deals with the predicate on a group to be cyclic.
For the concrete cyclic group of order `n`, see `data.zmod.basic`.

## Main definitions

* `is_cyclic` is a predicate on a group stating that the group is cyclic.

## Main statements

* `is_cyclic_of_prime_card` proves that a finite group of prime order is cyclic.
* `is_simple_group_of_prime_card`, `is_simple_group.is_cyclic`,
  and `is_simple_group.prime_card` classify finite simple abelian groups.

## Tags

cyclic group
-/

universe u
variables {α : Type u} {a : α}

section cyclic

open_locale big_operators

local attribute [instance] set_fintype

open subgroup

/-- A group is called *cyclic* if it is generated by a single element. -/
class is_add_cyclic (α : Type u) [add_group α] : Prop :=
(exists_generator [] : ∃ g : α, ∀ x, x ∈ add_subgroup.zmultiples g)

/-- A group is called *cyclic* if it is generated by a single element. -/
@[to_additive is_add_cyclic] class is_cyclic (α : Type u) [group α] : Prop :=
(exists_generator [] : ∃ g : α, ∀ x, x ∈ zpowers g)

@[priority 100, to_additive  is_add_cyclic_of_subsingleton]
instance is_cyclic_of_subsingleton [group α] [subsingleton α] : is_cyclic α :=
⟨⟨1, λ x, by { rw subsingleton.elim x 1, exact mem_zpowers 1 }⟩⟩

/-- A cyclic group is always commutative. This is not an `instance` because often we have a better
proof of `comm_group`. -/
@[to_additive "A cyclic group is always commutative. This is not an `instance` because often we have
  a better proof of `add_comm_group`."]
def is_cyclic.comm_group [hg : group α] [is_cyclic α] : comm_group α :=
{ mul_comm := λ x y, show x * y = y * x,
    from let ⟨g, hg⟩ := is_cyclic.exists_generator α in
    let ⟨n, hn⟩ := hg x in let ⟨m, hm⟩ := hg y in
    hm ▸ hn ▸ zpow_mul_comm _ _ _,
  ..hg }

variables [group α]

@[to_additive monoid_add_hom.map_add_cyclic]
lemma monoid_hom.map_cyclic {G : Type*} [group G] [h : is_cyclic G] (σ : G →* G) :
  ∃ m : ℤ, ∀ g : G, σ g = g ^ m :=
begin
  obtain ⟨h, hG⟩ := is_cyclic.exists_generator G,
  obtain ⟨m, hm⟩ := hG (σ h),
  use m,
  intro g,
  obtain ⟨n, rfl⟩ := hG g,
  rw [monoid_hom.map_zpow, ←hm, ←zpow_mul, ←zpow_mul'],
end

@[to_additive is_add_cyclic_of_order_of_eq_card]
lemma is_cyclic_of_order_of_eq_card [fintype α]  (x : α)
   (hx : order_of x = fintype.card α) : is_cyclic α :=
begin
  classical,
  use x,
  simp_rw ← set_like.mem_coe,
  rw ← set.eq_univ_iff_forall,
  apply set.eq_of_subset_of_card_le (set.subset_univ _),
  rw [fintype.card_congr (equiv.set.univ α), ← hx, order_eq_card_zpowers],
end

/-- A finite group of prime order is cyclic. -/
@[to_additive is_add_cyclic_of_prime_card]
lemma is_cyclic_of_prime_card {α : Type u} [group α] [fintype α] {p : ℕ} [hp : fact p.prime]
  (h : fintype.card α = p) : is_cyclic α :=
⟨begin
  obtain ⟨g, hg⟩ : ∃ g : α, g ≠ 1,
  from fintype.exists_ne_of_one_lt_card (by { rw h, exact hp.1.one_lt }) 1,
  classical, -- for fintype (subgroup.zpowers g)
  have : fintype.card (subgroup.zpowers g) ∣ p,
  { rw ←h,
    apply card_subgroup_dvd_card },
  rw nat.dvd_prime hp.1 at this,
  cases this,
  { rw fintype.card_eq_one_iff at this,
    cases this with t ht,
    suffices : g = 1,
    { contradiction },
    have hgt := ht ⟨g, by { change g ∈ subgroup.zpowers g, exact subgroup.mem_zpowers g }⟩,
    rw [←ht 1] at hgt,
    change (⟨_, _⟩ : subgroup.zpowers g) = ⟨_, _⟩ at hgt,
    simpa using hgt },
  { use g,
    intro x,
    rw [←h] at this,
    rw subgroup.eq_top_of_card_eq _ this,
    exact subgroup.mem_top _ }
end⟩

@[to_additive add_order_of_eq_card_of_forall_mem_zmultiples]
lemma order_of_eq_card_of_forall_mem_zpowers [fintype α]
  {g : α} (hx : ∀ x, x ∈ zpowers g) : order_of g = fintype.card α :=
by { classical, rw [← fintype.card_congr (equiv.set.univ α), order_eq_card_zpowers],
  simp [hx], apply fintype.card_of_finset', simp, intro x, exact hx x}

@[to_additive bot.is_add_cyclic]
instance bot.is_cyclic {α : Type u} [group α] : is_cyclic (⊥ : subgroup α) :=
⟨⟨1, λ x, ⟨0, subtype.eq $ eq.symm (subgroup.mem_bot.1 x.2)⟩⟩⟩

@[to_additive add_subgroup.is_add_cyclic]
instance subgroup.is_cyclic {α : Type u} [group α] [is_cyclic α] (H : subgroup α) : is_cyclic H :=
by haveI := classical.prop_decidable; exact
let ⟨g, hg⟩ := is_cyclic.exists_generator α in
if hx : ∃ (x : α), x ∈ H ∧ x ≠ (1 : α) then
  let ⟨x, hx₁, hx₂⟩ := hx in
  let ⟨k, hk⟩ := hg x in
  have hex : ∃ n : ℕ, 0 < n ∧ g ^ n ∈ H,
    from ⟨k.nat_abs, nat.pos_of_ne_zero
      (λ h, hx₂ $ by rw [← hk, int.eq_zero_of_nat_abs_eq_zero h, zpow_zero]),
        match k, hk with
        | (k : ℕ), hk := by rw [int.nat_abs_of_nat, ← zpow_coe_nat, hk]; exact hx₁
        | -[1+ k], hk := by rw [int.nat_abs_of_neg_succ_of_nat,
          ← subgroup.inv_mem_iff H]; simp * at *
        end⟩,
  ⟨⟨⟨g ^ nat.find hex, (nat.find_spec hex).2⟩,
    λ ⟨x, hx⟩, let ⟨k, hk⟩ := hg x in
      have hk₁ : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) ∈ zpowers (g ^ nat.find hex),
        from ⟨k / nat.find hex, by rw [← zpow_coe_nat, zpow_mul]⟩,
      have hk₂ : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) ∈ H,
        by { rw zpow_mul, apply H.zpow_mem, exact_mod_cast (nat.find_spec hex).2 },
      have hk₃ : g ^ (k % nat.find hex) ∈ H,
        from (subgroup.mul_mem_cancel_right H hk₂).1 $
          by rw [← zpow_add, int.mod_add_div, hk]; exact hx,
      have hk₄ : k % nat.find hex = (k % nat.find hex).nat_abs,
        by rw int.nat_abs_of_nonneg (int.mod_nonneg _
          (int.coe_nat_ne_zero_iff_pos.2 (nat.find_spec hex).1)),
      have hk₅ : g ^ (k % nat.find hex ).nat_abs ∈ H,
        by rwa [← zpow_coe_nat, ← hk₄],
      have hk₆ : (k % (nat.find hex : ℤ)).nat_abs = 0,
        from by_contradiction (λ h,
          nat.find_min hex (int.coe_nat_lt.1 $ by rw [← hk₄];
            exact int.mod_lt_of_pos _ (int.coe_nat_pos.2 (nat.find_spec hex).1))
          ⟨nat.pos_of_ne_zero h, hk₅⟩),
      ⟨k / (nat.find hex : ℤ), subtype.ext_iff_val.2 begin
        suffices : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) = x,
        { simpa [zpow_mul] },
        rw [int.mul_div_cancel' (int.dvd_of_mod_eq_zero (int.eq_zero_of_nat_abs_eq_zero hk₆)), hk]
      end⟩⟩⟩
else
  have H = (⊥ : subgroup α), from subgroup.ext $ λ x, ⟨λ h, by simp at *; tauto,
    λ h, by rw [subgroup.mem_bot.1 h]; exact H.one_mem⟩,
  by clear _let_match; substI this; apply_instance

open finset nat

section classical

open_locale classical

@[to_additive is_add_cyclic.card_pow_eq_one_le]
lemma is_cyclic.card_pow_eq_one_le [decidable_eq α] [fintype α] [is_cyclic α] {n : ℕ}
  (hn0 : 0 < n) : (univ.filter (λ a : α, a ^ n = 1)).card ≤ n :=
let ⟨g, hg⟩ := is_cyclic.exists_generator α in
calc (univ.filter (λ a : α, a ^ n = 1)).card
  ≤ ((zpowers (g ^ (fintype.card α / (gcd n (fintype.card α))))) : set α).to_finset.card :
  card_le_of_subset (λ x hx, let ⟨m, hm⟩ := show x ∈ submonoid.powers g,
    from mem_powers_iff_mem_zpowers.2 $ hg x in
    set.mem_to_finset.2 ⟨(m / (fintype.card α / (gcd n (fintype.card α))) : ℕ),
      have hgmn : g ^ (m * gcd n (fintype.card α)) = 1,
        by rw [pow_mul, hm, ← pow_gcd_card_eq_one_iff]; exact (mem_filter.1 hx).2,
      begin
        rw [zpow_coe_nat, ← pow_mul, nat.mul_div_cancel_left', hm],
        refine dvd_of_mul_dvd_mul_right (gcd_pos_of_pos_left (fintype.card α) hn0) _,
        conv {to_lhs,
          rw [nat.div_mul_cancel (gcd_dvd_right _ _), ← order_of_eq_card_of_forall_mem_zpowers hg]},
        exact order_of_dvd_of_pow_eq_one hgmn
      end⟩)
... ≤ n :
  let ⟨m, hm⟩ := gcd_dvd_right n (fintype.card α) in
  have hm0 : 0 < m, from nat.pos_of_ne_zero $
    λ hm0, by { rw [hm0, mul_zero, fintype.card_eq_zero_iff] at hm, exact hm.elim' 1 },
  begin
    rw [← fintype.card_of_finset' _ (λ _, set.mem_to_finset), ← order_eq_card_zpowers,
        order_of_pow g, order_of_eq_card_of_forall_mem_zpowers hg],
    rw [hm] {occs := occurrences.pos [2,3]},
    rw [nat.mul_div_cancel_left _  (gcd_pos_of_pos_left _ hn0), gcd_mul_left_left,
      hm, nat.mul_div_cancel _ hm0],
    exact le_of_dvd hn0 (gcd_dvd_left _ _)
  end

end classical

@[to_additive]
lemma is_cyclic.exists_monoid_generator [fintype α]
[is_cyclic α] : ∃ x : α, ∀ y : α, y ∈ submonoid.powers x :=
by { simp_rw [mem_powers_iff_mem_zpowers], exact is_cyclic.exists_generator α }

section

variables [decidable_eq α] [fintype α]

@[to_additive]
lemma is_cyclic.image_range_order_of (ha : ∀ x : α, x ∈ zpowers a) :
  finset.image (λ i, a ^ i) (range (order_of a)) = univ :=
begin
  simp_rw [←set_like.mem_coe] at ha,
  simp only [image_range_order_of, set.eq_univ_iff_forall.mpr ha],
  convert set.to_finset_univ
end

@[to_additive]
lemma is_cyclic.image_range_card (ha : ∀ x : α, x ∈ zpowers a) :
  finset.image (λ i, a ^ i) (range (fintype.card α)) = univ :=
by rw [← order_of_eq_card_of_forall_mem_zpowers ha, is_cyclic.image_range_order_of ha]

end

section totient

variables [decidable_eq α] [fintype α]
(hn : ∀ n : ℕ, 0 < n → (univ.filter (λ a : α, a ^ n = 1)).card ≤ n)

include hn

private lemma card_pow_eq_one_eq_order_of_aux (a : α) :
  (finset.univ.filter (λ b : α, b ^ order_of a = 1)).card = order_of a :=
le_antisymm
  (hn _ (order_of_pos a))
  (calc order_of a = @fintype.card (zpowers a) (id _) : order_eq_card_zpowers
    ... ≤ @fintype.card (↑(univ.filter (λ b : α, b ^ order_of a = 1)) : set α)
    (fintype.of_finset _ (λ _, iff.rfl)) :
      @fintype.card_le_of_injective (zpowers a)
        (↑(univ.filter (λ b : α, b ^ order_of a = 1)) : set α)
        (id _) (id _) (λ b, ⟨b.1, mem_filter.2 ⟨mem_univ _,
          let ⟨i, hi⟩ := b.2 in
          by rw [← hi, ← zpow_coe_nat, ← zpow_mul, mul_comm, zpow_mul, zpow_coe_nat,
            pow_order_of_eq_one, one_zpow]⟩⟩) (λ _ _ h, subtype.eq (subtype.mk.inj h))
    ... = (univ.filter (λ b : α, b ^ order_of a = 1)).card : fintype.card_of_finset _ _)

open_locale nat -- use φ for nat.totient

private lemma card_order_of_eq_totient_aux₁ :
  ∀ {d : ℕ}, d ∣ fintype.card α → 0 < (univ.filter (λ a : α, order_of a = d)).card →
  (univ.filter (λ a : α, order_of a = d)).card = φ d
| 0     := λ hd hd0,
let ⟨a, ha⟩ := card_pos.1 hd0 in absurd (mem_filter.1 ha).2 $ ne_of_gt $ order_of_pos a
| (d+1) := λ hd hd0,
let ⟨a, ha⟩ := card_pos.1 hd0 in
have ha : order_of a = d.succ, from (mem_filter.1 ha).2,
have h : ∑ m in (range d.succ).filter (∣ d.succ),
    (univ.filter (λ a : α, order_of a = m)).card =
    ∑ m in (range d.succ).filter (∣ d.succ), φ m, from
  finset.sum_congr rfl
    (λ m hm, have hmd : m < d.succ, from mem_range.1 (mem_filter.1 hm).1,
      have hm : m ∣ d.succ, from (mem_filter.1 hm).2,
      card_order_of_eq_totient_aux₁ (hm.trans hd) (finset.card_pos.2
        ⟨a ^ (d.succ / m), mem_filter.2 ⟨mem_univ _,
          by { rw [order_of_pow a, ha, gcd_eq_right (div_dvd_of_dvd hm),
                nat.div_div_self hm (succ_pos _)] }⟩⟩)),
have hinsert : insert d.succ ((range d.succ).filter (∣ d.succ))
    = (range d.succ.succ).filter (∣ d.succ),
  from (finset.ext $ λ x, ⟨λ h, (mem_insert.1 h).elim (λ h, by simp [h, range_succ])
    (by clear _let_match; simp [range_succ]; tauto),
     by clear _let_match; simp [range_succ] {contextual := tt}; tauto⟩),
have hinsert₁ : d.succ ∉ (range d.succ).filter (∣ d.succ),
  by simp [mem_range, zero_le_one, le_succ],
(add_left_inj (∑ m in (range d.succ).filter (∣ d.succ),
  (univ.filter (λ a : α, order_of a = m)).card)).1
  (calc _ = ∑ m in insert d.succ (filter (∣ d.succ) (range d.succ)),
        (univ.filter (λ a : α, order_of a = m)).card :
    eq.symm (finset.sum_insert (by simp [mem_range, zero_le_one, le_succ]))
  ... = ∑ m in (range d.succ.succ).filter (∣ d.succ),
      (univ.filter (λ a : α, order_of a = m)).card :
    sum_congr hinsert (λ _ _, rfl)
  ... = (univ.filter (λ a : α, a ^ d.succ = 1)).card :
    sum_card_order_of_eq_card_pow_eq_one (succ_pos d)
  ... = ∑ m in (range d.succ.succ).filter (∣ d.succ), φ m :
    ha ▸ (card_pow_eq_one_eq_order_of_aux hn a).symm ▸ (sum_totient _).symm
  ... = _ : by rw [h, ← sum_insert hinsert₁];
      exact finset.sum_congr hinsert.symm (λ _ _, rfl))

lemma card_order_of_eq_totient_aux₂ {d : ℕ} (hd : d ∣ fintype.card α) :
  (univ.filter (λ a : α, order_of a = d)).card = φ d :=
by_contradiction $ λ h,
have h0 : (univ.filter (λ a : α , order_of a = d)).card = 0 :=
  not_not.1 (mt pos_iff_ne_zero.2 (mt (card_order_of_eq_totient_aux₁ hn hd) h)),
let c := fintype.card α in
have hc0 : 0 < c, from fintype.card_pos_iff.2 ⟨1⟩,
lt_irrefl c $
  calc c = (univ.filter (λ a : α, a ^ c = 1)).card :
    congr_arg card $ by simp [finset.ext_iff, c]
  ... = ∑ m in (range c.succ).filter (∣ c),
      (univ.filter (λ a : α, order_of a = m)).card :
    (sum_card_order_of_eq_card_pow_eq_one hc0).symm
  ... = ∑ m in ((range c.succ).filter (∣ c)).erase d,
      (univ.filter (λ a : α, order_of a = m)).card :
    eq.symm (sum_subset (erase_subset _ _) (λ m hm₁ hm₂,
      have m = d, by simp at *; cc,
      by simp [*, finset.ext_iff] at *; exact h0))
  ... ≤ ∑ m in ((range c.succ).filter (∣ c)).erase d, φ m :
    sum_le_sum (λ m hm,
      have hmc : m ∣ c, by simp at hm; tauto,
      (imp_iff_not_or.1 (card_order_of_eq_totient_aux₁ hn hmc)).elim
        (λ h, by simp [nat.le_zero_iff.1 (le_of_not_gt h), nat.zero_le])
        (λ h, by rw h))
  ... < φ d + ∑ m in ((range c.succ).filter (∣ c)).erase d, φ m :
    lt_add_of_pos_left _ (totient_pos (nat.pos_of_ne_zero
      (λ h, pos_iff_ne_zero.1 hc0 (eq_zero_of_zero_dvd $ h ▸ hd))))
  ... = ∑ m in insert d (((range c.succ).filter (∣ c)).erase d), φ m :
    eq.symm (sum_insert (by simp))
  ... = ∑ m in (range c.succ).filter (∣ c), φ m : finset.sum_congr
      (finset.insert_erase (mem_filter.2 ⟨mem_range.2 (lt_succ_of_le (le_of_dvd hc0 hd)), hd⟩))
                           (λ _ _, rfl)
  ... = c : sum_totient _

lemma is_cyclic_of_card_pow_eq_one_le : is_cyclic α :=
have (univ.filter (λ a : α, order_of a = fintype.card α)).nonempty,
from (card_pos.1 $
  by rw [card_order_of_eq_totient_aux₂ hn dvd_rfl];
  exact totient_pos (fintype.card_pos_iff.2 ⟨1⟩)),
let ⟨x, hx⟩ := this in
is_cyclic_of_order_of_eq_card x (finset.mem_filter.1 hx).2

lemma is_add_cyclic_of_card_pow_eq_one_le {α} [add_group α] [decidable_eq α] [fintype α]
  (hn : ∀ n : ℕ, 0 < n → (univ.filter (λ a : α, n • a = 0)).card ≤ n) : is_add_cyclic α :=
begin
  obtain ⟨g, hg⟩ := @is_cyclic_of_card_pow_eq_one_le (multiplicative α) _ _ _ hn,
  exact ⟨⟨g, hg⟩⟩
end

attribute [to_additive is_cyclic_of_card_pow_eq_one_le] is_add_cyclic_of_card_pow_eq_one_le

end totient

lemma is_cyclic.card_order_of_eq_totient [is_cyclic α] [fintype α]
  {d : ℕ} (hd : d ∣ fintype.card α) : (univ.filter (λ a : α, order_of a = d)).card = totient d :=
begin
  classical,
  apply card_order_of_eq_totient_aux₂ (λ n, is_cyclic.card_pow_eq_one_le) hd
end

lemma is_add_cyclic.card_order_of_eq_totient {α} [add_group α] [is_add_cyclic α] [fintype α] {d : ℕ}
  (hd : d ∣ fintype.card α) : (univ.filter (λ a : α, add_order_of a = d)).card = totient d :=
begin
  obtain ⟨g, hg⟩ := id ‹is_add_cyclic α›,
  exact @is_cyclic.card_order_of_eq_totient (multiplicative α) _ ⟨⟨g, hg⟩⟩ _ _ hd
end

attribute [to_additive is_cyclic.card_order_of_eq_totient] is_add_cyclic.card_order_of_eq_totient

/-- A finite group of prime order is simple. -/
@[to_additive]
lemma is_simple_group_of_prime_card {α : Type u} [group α] [fintype α] {p : ℕ} [hp : fact p.prime]
  (h : fintype.card α = p) : is_simple_group α :=
⟨begin
  have h' := nat.prime.one_lt (fact.out p.prime),
  rw ← h at h',
  haveI := fintype.one_lt_card_iff_nontrivial.1 h',
  apply exists_pair_ne α,
end, λ H Hn, begin
  classical,
  have hcard := card_subgroup_dvd_card H,
  rw [h, dvd_prime (fact.out p.prime)] at hcard,
  refine hcard.imp (λ h1, _) (λ hp, _),
  { haveI := fintype.card_le_one_iff_subsingleton.1 (le_of_eq h1),
    apply eq_bot_of_subsingleton },
  { exact eq_top_of_card_eq _ (hp.trans h.symm) }
end⟩

end cyclic

section quotient_center

open subgroup

variables {G : Type*} {H : Type*} [group G] [group H]

/-- A group is commutative if the quotient by the center is cyclic.
  Also see `comm_group_of_cycle_center_quotient` for the `comm_group` instance. -/
@[to_additive commutative_of_add_cyclic_center_quotient "A group is commutative if the quotient by
  the center is cyclic. Also see `add_comm_group_of_cycle_center_quotient`
  for the `add_comm_group` instance."]
lemma commutative_of_cyclic_center_quotient [is_cyclic H] (f : G →* H)
  (hf : f.ker ≤ center G) (a b : G) : a * b = b * a :=
let ⟨⟨x, y, (hxy : f y = x)⟩, (hx : ∀ a : f.range, a ∈ zpowers _)⟩ :=
  is_cyclic.exists_generator f.range in
let ⟨m, hm⟩ := hx ⟨f a, a, rfl⟩ in
let ⟨n, hn⟩ := hx ⟨f b, b, rfl⟩ in
have hm : x ^ m = f a, by simpa [subtype.ext_iff] using hm,
have hn : x ^ n = f b, by simpa [subtype.ext_iff] using hn,
have ha : y ^ (-m) * a ∈ center G,
  from hf (by rw [f.mem_ker, f.map_mul, f.map_zpow, hxy, zpow_neg, hm, inv_mul_self]),
have hb : y ^ (-n) * b ∈ center G,
  from hf (by rw [f.mem_ker, f.map_mul, f.map_zpow, hxy, zpow_neg, hn, inv_mul_self]),
calc a * b = y ^ m * ((y ^ (-m) * a) * y ^ n) * (y ^ (-n) * b) : by simp [mul_assoc]
... = y ^ m * (y ^ n * (y ^ (-m) * a)) * (y ^ (-n) * b) : by rw [mem_center_iff.1 ha]
... = y ^ m * y ^ n * y ^ (-m) * (a * (y ^ (-n) * b)) : by simp [mul_assoc]
... = y ^ m * y ^ n * y ^ (-m) * ((y ^ (-n) * b) * a) : by rw [mem_center_iff.1 hb]
... = b * a : by group

/-- A group is commutative if the quotient by the center is cyclic. -/
@[to_additive commutative_of_add_cycle_center_quotient "A group is commutative if the quotient by
  the center is cyclic."]
def comm_group_of_cycle_center_quotient [is_cyclic H] (f : G →* H)
  (hf : f.ker ≤ center G) : comm_group G :=
{ mul_comm := commutative_of_cyclic_center_quotient f hf,
  ..show group G, by apply_instance }

end quotient_center

namespace is_simple_group

section comm_group
variables [comm_group α] [is_simple_group α]

@[priority 100, to_additive is_simple_add_group.is_add_cyclic]
instance : is_cyclic α :=
begin
  cases subsingleton_or_nontrivial α with hi hi; haveI := hi,
  { apply is_cyclic_of_subsingleton },
  { obtain ⟨g, hg⟩ := exists_ne (1 : α),
    refine ⟨⟨g, λ x, _⟩⟩,
    cases is_simple_order.eq_bot_or_eq_top (subgroup.zpowers g) with hb ht,
    { exfalso,
      apply hg,
      rw [← subgroup.mem_bot, ← hb],
      apply subgroup.mem_zpowers },
    { rw ht,
      apply subgroup.mem_top } }
end

@[to_additive]
theorem prime_card [fintype α] : (fintype.card α).prime :=
begin
  have h0 : 0 < fintype.card α := fintype.card_pos_iff.2 (by apply_instance),
  obtain ⟨g, hg⟩ := is_cyclic.exists_generator α,
  refine ⟨fintype.one_lt_card_iff_nontrivial.2 infer_instance, λ n hn, _⟩,
  refine (is_simple_order.eq_bot_or_eq_top (subgroup.zpowers (g ^ n))).symm.imp _ _,
  { intro h,
    have hgo := order_of_pow g,
    rw [order_of_eq_card_of_forall_mem_zpowers hg, nat.gcd_eq_right_iff_dvd.1 hn,
      order_of_eq_card_of_forall_mem_zpowers, eq_comm,
      nat.div_eq_iff_eq_mul_left (nat.pos_of_dvd_of_pos hn h0) hn] at hgo,
    { exact (mul_left_cancel₀ (ne_of_gt h0) ((mul_one (fintype.card α)).trans hgo)).symm },
    { intro x,
      rw h,
      exact subgroup.mem_top _ } },
  { intro h,
    apply le_antisymm (nat.le_of_dvd h0 hn),
    rw ← order_of_eq_card_of_forall_mem_zpowers hg,
    apply order_of_le_of_pow_eq_one (nat.pos_of_dvd_of_pos hn h0),
    rw [← subgroup.mem_bot, ← h],
    exact subgroup.mem_zpowers _ }
end

end comm_group

end is_simple_group

@[to_additive add_comm_group.is_simple_iff_is_add_cyclic_and_prime_card]
theorem comm_group.is_simple_iff_is_cyclic_and_prime_card [fintype α] [comm_group α] :
  is_simple_group α ↔ is_cyclic α ∧ (fintype.card α).prime :=
begin
  split,
  { introI h,
    exact ⟨is_simple_group.is_cyclic, is_simple_group.prime_card⟩ },
  { rintro ⟨hc, hp⟩,
    haveI : fact (fintype.card α).prime := ⟨hp⟩,
    exact is_simple_group_of_prime_card rfl }
end


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang
-/
import analysis.normed_space.conformal_linear_map
import analysis.calculus.fderiv

/-!
# Conformal Maps

A continuous linear map between real normed spaces `X` and `Y` is `conformal_at` some point `x`
if it is real differentiable at that point and its differential `is_conformal_linear_map`.

## Main definitions

* `conformal_at`: the main definition of conformal maps
* `conformal`: maps that are conformal at every point
* `conformal_factor_at`: the conformal factor of a conformal map at some point

## Main results
* The conformality of the composition of two conformal maps, the identity map
  and multiplications by nonzero constants
* `conformal_at_iff_is_conformal_map_fderiv`: an equivalent definition of the conformality of a map

In `analysis.calculus.conformal.inner_product`:
* `conformal_at_iff`: an equivalent definition of the conformality of a map

In `geometry.euclidean.basic`:
* `conformal_at.preserves_angle`: if a map is conformal at `x`, then its differential
                                  preserves all angles at `x`

## Tags

conformal

## Warning

The definition of conformality in this file does NOT require the maps to be orientation-preserving.
Maps such as the complex conjugate are considered to be conformal.
-/

noncomputable theory

variables {X Y Z : Type*} [normed_group X] [normed_group Y] [normed_group Z]
  [normed_space ℝ X] [normed_space ℝ Y] [normed_space ℝ Z]

section loc_conformality

open linear_isometry continuous_linear_map

/-- A map `f` is said to be conformal if it has a conformal differential `f'`. -/
def conformal_at (f : X → Y) (x : X) :=
∃ (f' : X →L[ℝ] Y), has_fderiv_at f f' x ∧ is_conformal_map f'

lemma conformal_at_id (x : X) : conformal_at id x :=
⟨id ℝ X, has_fderiv_at_id _, is_conformal_map_id⟩

lemma conformal_at_const_smul {c : ℝ} (h : c ≠ 0) (x : X) :
  conformal_at (λ (x': X), c • x') x :=
⟨c • continuous_linear_map.id ℝ X,
  (has_fderiv_at_id x).const_smul c, is_conformal_map_const_smul h⟩

/-- A function is a conformal map if and only if its differential is a conformal linear map-/
lemma conformal_at_iff_is_conformal_map_fderiv {f : X → Y} {x : X} :
  conformal_at f x ↔ is_conformal_map (fderiv ℝ f x) :=
begin
  split,
  { rintros ⟨c, hf, hf'⟩,
    rw hf.fderiv,
    exact hf' },
  { intros H,
    by_cases h : differentiable_at ℝ f x,
    { exact ⟨fderiv ℝ f x, h.has_fderiv_at, H⟩, },
    { cases subsingleton_or_nontrivial X with w w; resetI,
      { exact ⟨(0 : X →L[ℝ] Y), has_fderiv_at_of_subsingleton f x,
        is_conformal_map_of_subsingleton 0⟩, },
      { exfalso,
        exact H.ne_zero (fderiv_zero_of_not_differentiable_at h), }, }, },
end

namespace conformal_at

lemma differentiable_at {f : X → Y} {x : X} (h : conformal_at f x) :
  differentiable_at ℝ f x :=
let ⟨_, h₁, _⟩ := h in h₁.differentiable_at

lemma congr {f g : X → Y} {x : X} {u : set X} (hx : x ∈ u) (hu : is_open u)
  (hf : conformal_at f x) (h : ∀ (x : X), x ∈ u → g x = f x) :
  conformal_at g x :=
let ⟨f', hfderiv, hf'⟩ := hf in
  ⟨f', hfderiv.congr_of_eventually_eq ((hu.eventually_mem hx).mono h), hf'⟩

lemma comp {f : X → Y} {g : Y → Z} (x : X)
  (hg : conformal_at g (f x)) (hf : conformal_at f x) : conformal_at (g ∘ f) x :=
begin
  rcases hf with ⟨f', hf₁, cf⟩,
  rcases hg with ⟨g', hg₁, cg⟩,
  exact ⟨g'.comp f', hg₁.comp x hf₁, cg.comp cf⟩,
end

lemma const_smul {f : X → Y} {x : X} {c : ℝ} (hc : c ≠ 0) (hf : conformal_at f x) :
  conformal_at (c • f) x :=
(conformal_at_const_smul hc $ f x).comp x hf

end conformal_at

end loc_conformality

section global_conformality

/-- A map `f` is conformal if it's conformal at every point. -/
def conformal (f : X → Y) :=
∀ (x : X), conformal_at f x

lemma conformal_id : conformal (id : X → X) := λ x, conformal_at_id x

lemma conformal_const_smul {c : ℝ} (h : c ≠ 0) : conformal (λ (x : X), c • x) :=
λ x, conformal_at_const_smul h x

namespace conformal

lemma conformal_at {f : X → Y} (h : conformal f) (x : X) : conformal_at f x := h x

lemma differentiable {f : X → Y} (h : conformal f) : differentiable ℝ f :=
λ x, (h x).differentiable_at

lemma comp {f : X → Y} {g : Y → Z} (hf : conformal f) (hg : conformal g) : conformal (g ∘ f) :=
λ x, (hg $ f x).comp x (hf x)

lemma const_smul {f : X → Y} (hf : conformal f) {c : ℝ} (hc : c ≠ 0) : conformal (c • f) :=
λ x, (hf x).const_smul hc

end conformal

end global_conformality