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

! This file was ported from Lean 3 source module measure_theory.measure.haar
! leanprover-community/mathlib commit 57ac39bd365c2f80589a700f9fbb664d3a1a30c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.Content
import Mathbin.MeasureTheory.Group.Prod
import Mathbin.GroupTheory.Divisible
import Mathbin.Topology.Algebra.Group.Compact

/-!
# Haar measure

In this file we prove the existence and uniqueness (up to scalar multiples) of Haar measure
for a locally compact Hausdorff topological group.

For the construction, we follow the write-up by Jonathan Gleason,
*Existence and Uniqueness of Haar Measure*.
This is essentially the same argument as in
https://en.wikipedia.org/wiki/Haar_measure#A_construction_using_compact_subsets.

We construct the Haar measure first on compact sets. For this we define `(K : U)` as the (smallest)
number of left-translates of `U` that are needed to cover `K` (`index` in the formalization).
Then we define a function `h` on compact sets as `lim_U (K : U) / (K₀ : U)`,
where `U` becomes a smaller and smaller open neighborhood of `1`, and `K₀` is a fixed compact set
with nonempty interior. This function is `chaar` in the formalization, and we define the limit
formally using Tychonoff's theorem.

This function `h` forms a content, which we can extend to an outer measure and then a measure
(`haar_measure`).
We normalize the Haar measure so that the measure of `K₀` is `1`.
We show that for second countable spaces any left invariant Borel measure is a scalar multiple of
the Haar measure.

Note that `μ` need not coincide with `h` on compact sets, according to
[halmos1950measure, ch. X, §53 p.233]. However, we know that `h(K)` lies between `μ(Kᵒ)` and `μ(K)`,
where `ᵒ` denotes the interior.

## Main Declarations

* `haar_measure`: the Haar measure on a locally compact Hausdorff group. This is a left invariant
  regular measure. It takes as argument a compact set of the group (with non-empty interior),
  and is normalized so that the measure of the given set is 1.
* `haar_measure_self`: the Haar measure is normalized.
* `is_left_invariant_haar_measure`: the Haar measure is left invariant.
* `regular_haar_measure`: the Haar measure is a regular measure.
* `is_haar_measure_haar_measure`: the Haar measure satisfies the `is_haar_measure` typeclass, i.e.,
  it is invariant and gives finite mass to compact sets and positive mass to nonempty open sets.
* `haar` : some choice of a Haar measure, on a locally compact Hausdorff group, constructed as
  `haar_measure K` where `K` is some arbitrary choice of a compact set with nonempty interior.
* `haar_measure_unique`: Every σ-finite left invariant measure on a locally compact Hausdorff group
  is a scalar multiple of the Haar measure.

## References
* Paul Halmos (1950), Measure Theory, §53
* Jonathan Gleason, Existence and Uniqueness of Haar Measure
  - Note: step 9, page 8 contains a mistake: the last defined `μ` does not extend the `μ` on compact
    sets, see Halmos (1950) p. 233, bottom of the page. This makes some other steps (like step 11)
    invalid.
* https://en.wikipedia.org/wiki/Haar_measure
-/

noncomputable section

open Set Inv Function TopologicalSpace MeasurableSpace

open NNReal Classical ENNReal Pointwise Topology

namespace MeasureTheory

namespace Measure

section Group

variable {G : Type _} [Group G]

/-! We put the internal functions in the construction of the Haar measure in a namespace,
  so that the chosen names don't clash with other declarations.
  We first define a couple of the functions before proving the properties (that require that `G`
  is a topological group). -/

namespace Haar

/-- The index or Haar covering number or ratio of `K` w.r.t. `V`, denoted `(K : V)`:
  it is the smallest number of (left) translates of `V` that is necessary to cover `K`.
  It is defined to be 0 if no finite number of translates cover `K`. -/
@[to_additive add_index "additive version of `measure_theory.measure.haar.index`"]
def index (K V : Set G) : ℕ :=
  infₛ <| Finset.card '' { t : Finset G | K ⊆ ⋃ g ∈ t, (fun h => g * h) ⁻¹' V }
#align measure_theory.measure.haar.index MeasureTheory.Measure.Haar.index
#align measure_theory.measure.haar.add_index MeasureTheory.Measure.Haar.addIndex

@[to_additive add_index_empty]
theorem index_empty {V : Set G} : index ∅ V = 0 :=
  by
  simp only [index, Nat.infₛ_eq_zero]; left; use ∅
  simp only [Finset.card_empty, empty_subset, mem_set_of_eq, eq_self_iff_true, and_self_iff]
#align measure_theory.measure.haar.index_empty MeasureTheory.Measure.Haar.index_empty
#align measure_theory.measure.haar.add_index_empty MeasureTheory.Measure.Haar.add_index_empty

variable [TopologicalSpace G]

/-- `prehaar K₀ U K` is a weighted version of the index, defined as `(K : U)/(K₀ : U)`.
  In the applications `K₀` is compact with non-empty interior, `U` is open containing `1`,
  and `K` is any compact set.
  The argument `K` is a (bundled) compact set, so that we can consider `prehaar K₀ U` as an
  element of `haar_product` (below). -/
@[to_additive "additive version of `measure_theory.measure.haar.prehaar`"]
def prehaar (K₀ U : Set G) (K : Compacts G) : ℝ :=
  (index (K : Set G) U : ℝ) / index K₀ U
#align measure_theory.measure.haar.prehaar MeasureTheory.Measure.Haar.prehaar
#align measure_theory.measure.haar.add_prehaar MeasureTheory.Measure.Haar.addPrehaar

@[to_additive]
theorem prehaar_empty (K₀ : PositiveCompacts G) {U : Set G} : prehaar (K₀ : Set G) U ⊥ = 0 := by
  rw [prehaar, compacts.coe_bot, index_empty, Nat.cast_zero, zero_div]
#align measure_theory.measure.haar.prehaar_empty MeasureTheory.Measure.Haar.prehaar_empty
#align measure_theory.measure.haar.add_prehaar_empty MeasureTheory.Measure.Haar.add_prehaar_empty

@[to_additive]
theorem prehaar_nonneg (K₀ : PositiveCompacts G) {U : Set G} (K : Compacts G) :
    0 ≤ prehaar (K₀ : Set G) U K := by apply div_nonneg <;> norm_cast <;> apply zero_le
#align measure_theory.measure.haar.prehaar_nonneg MeasureTheory.Measure.Haar.prehaar_nonneg
#align measure_theory.measure.haar.add_prehaar_nonneg MeasureTheory.Measure.Haar.add_prehaar_nonneg

/-- `haar_product K₀` is the product of intervals `[0, (K : K₀)]`, for all compact sets `K`.
  For all `U`, we can show that `prehaar K₀ U ∈ haar_product K₀`. -/
@[to_additive "additive version of `measure_theory.measure.haar.haar_product`"]
def haarProduct (K₀ : Set G) : Set (Compacts G → ℝ) :=
  pi univ fun K => Icc 0 <| index (K : Set G) K₀
#align measure_theory.measure.haar.haar_product MeasureTheory.Measure.Haar.haarProduct
#align measure_theory.measure.haar.add_haar_product MeasureTheory.Measure.Haar.addHaarProduct

@[simp, to_additive]
theorem mem_prehaar_empty {K₀ : Set G} {f : Compacts G → ℝ} :
    f ∈ haarProduct K₀ ↔ ∀ K : Compacts G, f K ∈ Icc (0 : ℝ) (index (K : Set G) K₀) := by
  simp only [haar_product, pi, forall_prop_of_true, mem_univ, mem_set_of_eq]
#align measure_theory.measure.haar.mem_prehaar_empty MeasureTheory.Measure.Haar.mem_prehaar_empty
#align measure_theory.measure.haar.mem_add_prehaar_empty MeasureTheory.Measure.Haar.mem_add_prehaar_empty

/-- The closure of the collection of elements of the form `prehaar K₀ U`,
  for `U` open neighbourhoods of `1`, contained in `V`. The closure is taken in the space
  `compacts G → ℝ`, with the topology of pointwise convergence.
  We show that the intersection of all these sets is nonempty, and the Haar measure
  on compact sets is defined to be an element in the closure of this intersection. -/
@[to_additive "additive version of `measure_theory.measure.haar.cl_prehaar`"]
def clPrehaar (K₀ : Set G) (V : OpenNhdsOf (1 : G)) : Set (Compacts G → ℝ) :=
  closure <| prehaar K₀ '' { U : Set G | U ⊆ V.1 ∧ IsOpen U ∧ (1 : G) ∈ U }
#align measure_theory.measure.haar.cl_prehaar MeasureTheory.Measure.Haar.clPrehaar
#align measure_theory.measure.haar.cl_add_prehaar MeasureTheory.Measure.Haar.clAddPrehaar

variable [TopologicalGroup G]

/-!
### Lemmas about `index`
-/

/-- If `K` is compact and `V` has nonempty interior, then the index `(K : V)` is well-defined,
  there is a finite set `t` satisfying the desired properties. -/
@[to_additive add_index_defined
      "If `K` is compact and `V` has nonempty interior, then the index\n`(K : V)` is well-defined, there is a finite set `t` satisfying the desired properties."]
theorem index_defined {K V : Set G} (hK : IsCompact K) (hV : (interior V).Nonempty) :
    ∃ n : ℕ, n ∈ Finset.card '' { t : Finset G | K ⊆ ⋃ g ∈ t, (fun h => g * h) ⁻¹' V } :=
  by
  rcases compact_covered_by_mul_left_translates hK hV with ⟨t, ht⟩
  exact ⟨t.card, t, ht, rfl⟩
#align measure_theory.measure.haar.index_defined MeasureTheory.Measure.Haar.index_defined
#align measure_theory.measure.haar.add_index_defined MeasureTheory.Measure.Haar.add_index_defined

@[to_additive add_index_elim]
theorem index_elim {K V : Set G} (hK : IsCompact K) (hV : (interior V).Nonempty) :
    ∃ t : Finset G, (K ⊆ ⋃ g ∈ t, (fun h => g * h) ⁻¹' V) ∧ Finset.card t = index K V :=
  by
  have := Nat.infₛ_mem (index_defined hK hV)
  rwa [mem_image] at this
#align measure_theory.measure.haar.index_elim MeasureTheory.Measure.Haar.index_elim
#align measure_theory.measure.haar.add_index_elim MeasureTheory.Measure.Haar.add_index_elim

@[to_additive le_add_index_mul]
theorem le_index_mul (K₀ : PositiveCompacts G) (K : Compacts G) {V : Set G}
    (hV : (interior V).Nonempty) :
    index (K : Set G) V ≤ index (K : Set G) K₀ * index (K₀ : Set G) V :=
  by
  obtain ⟨s, h1s, h2s⟩ := index_elim K.is_compact K₀.interior_nonempty
  obtain ⟨t, h1t, h2t⟩ := index_elim K₀.is_compact hV
  rw [← h2s, ← h2t, mul_comm]
  refine' le_trans _ Finset.card_mul_le
  apply Nat.infₛ_le; refine' ⟨_, _, rfl⟩; rw [mem_set_of_eq]; refine' subset.trans h1s _
  apply Union₂_subset; intro g₁ hg₁; rw [preimage_subset_iff]; intro g₂ hg₂
  have := h1t hg₂
  rcases this with ⟨_, ⟨g₃, rfl⟩, A, ⟨hg₃, rfl⟩, h2V⟩; rw [mem_preimage, ← mul_assoc] at h2V
  exact mem_bUnion (Finset.mul_mem_mul hg₃ hg₁) h2V
#align measure_theory.measure.haar.le_index_mul MeasureTheory.Measure.Haar.le_index_mul
#align measure_theory.measure.haar.le_add_index_mul MeasureTheory.Measure.Haar.le_add_index_mul

@[to_additive add_index_pos]
theorem index_pos (K : PositiveCompacts G) {V : Set G} (hV : (interior V).Nonempty) :
    0 < index (K : Set G) V := by
  unfold index; rw [Nat.infₛ_def, Nat.find_pos, mem_image]
  · rintro ⟨t, h1t, h2t⟩
    rw [Finset.card_eq_zero] at h2t
    subst h2t
    obtain ⟨g, hg⟩ := K.interior_nonempty
    show g ∈ (∅ : Set G)
    convert h1t (interior_subset hg)
    symm
    apply bUnion_empty
  · exact index_defined K.is_compact hV
#align measure_theory.measure.haar.index_pos MeasureTheory.Measure.Haar.index_pos
#align measure_theory.measure.haar.add_index_pos MeasureTheory.Measure.Haar.add_index_pos

@[to_additive add_index_mono]
theorem index_mono {K K' V : Set G} (hK' : IsCompact K') (h : K ⊆ K') (hV : (interior V).Nonempty) :
    index K V ≤ index K' V :=
  by
  rcases index_elim hK' hV with ⟨s, h1s, h2s⟩
  apply Nat.infₛ_le; rw [mem_image]; refine' ⟨s, subset.trans h h1s, h2s⟩
#align measure_theory.measure.haar.index_mono MeasureTheory.Measure.Haar.index_mono
#align measure_theory.measure.haar.add_index_mono MeasureTheory.Measure.Haar.add_index_mono

@[to_additive add_index_union_le]
theorem index_union_le (K₁ K₂ : Compacts G) {V : Set G} (hV : (interior V).Nonempty) :
    index (K₁.1 ∪ K₂.1) V ≤ index K₁.1 V + index K₂.1 V :=
  by
  rcases index_elim K₁.2 hV with ⟨s, h1s, h2s⟩
  rcases index_elim K₂.2 hV with ⟨t, h1t, h2t⟩
  rw [← h2s, ← h2t]
  refine' le_trans _ (Finset.card_union_le _ _)
  apply Nat.infₛ_le; refine' ⟨_, _, rfl⟩; rw [mem_set_of_eq]
  apply union_subset <;> refine' subset.trans (by assumption) _ <;>
          apply bUnion_subset_bUnion_left <;>
        intro g hg <;>
      simp only [mem_def] at hg <;>
    simp only [mem_def, Multiset.mem_union, Finset.union_val, hg, or_true_iff, true_or_iff]
#align measure_theory.measure.haar.index_union_le MeasureTheory.Measure.Haar.index_union_le
#align measure_theory.measure.haar.add_index_union_le MeasureTheory.Measure.Haar.add_index_union_le

@[to_additive add_index_union_eq]
theorem index_union_eq (K₁ K₂ : Compacts G) {V : Set G} (hV : (interior V).Nonempty)
    (h : Disjoint (K₁.1 * V⁻¹) (K₂.1 * V⁻¹)) :
    index (K₁.1 ∪ K₂.1) V = index K₁.1 V + index K₂.1 V :=
  by
  apply le_antisymm (index_union_le K₁ K₂ hV)
  rcases index_elim (K₁.2.union K₂.2) hV with ⟨s, h1s, h2s⟩
  rw [← h2s]
  have :
    ∀ K : Set G,
      (K ⊆ ⋃ g ∈ s, (fun h => g * h) ⁻¹' V) →
        index K V ≤ (s.filter fun g => ((fun h : G => g * h) ⁻¹' V ∩ K).Nonempty).card :=
    by
    intro K hK
    apply Nat.infₛ_le
    refine' ⟨_, _, rfl⟩
    rw [mem_set_of_eq]
    intro g hg
    rcases hK hg with ⟨_, ⟨g₀, rfl⟩, _, ⟨h1g₀, rfl⟩, h2g₀⟩
    simp only [mem_preimage] at h2g₀
    simp only [mem_Union]
    use g₀
    constructor
    · simp only [Finset.mem_filter, h1g₀, true_and_iff]
      use g
      simp only [hg, h2g₀, mem_inter_iff, mem_preimage, and_self_iff]
    exact h2g₀
  refine'
    le_trans
      (add_le_add (this K₁.1 <| subset.trans (subset_union_left _ _) h1s)
        (this K₂.1 <| subset.trans (subset_union_right _ _) h1s))
      _
  rw [← Finset.card_union_eq, Finset.filter_union_right]
  exact s.card_filter_le _
  apply finset.disjoint_filter.mpr
  rintro g₁ h1g₁ ⟨g₂, h1g₂, h2g₂⟩ ⟨g₃, h1g₃, h2g₃⟩
  simp only [mem_preimage] at h1g₃ h1g₂
  refine' h.le_bot (_ : g₁⁻¹ ∈ _)
  constructor <;> simp only [Set.mem_inv, Set.mem_mul, exists_exists_and_eq_and, exists_and_left]
  · refine' ⟨_, h2g₂, (g₁ * g₂)⁻¹, _, _⟩
    simp only [inv_inv, h1g₂]
    simp only [mul_inv_rev, mul_inv_cancel_left]
  · refine' ⟨_, h2g₃, (g₁ * g₃)⁻¹, _, _⟩
    simp only [inv_inv, h1g₃]
    simp only [mul_inv_rev, mul_inv_cancel_left]
#align measure_theory.measure.haar.index_union_eq MeasureTheory.Measure.Haar.index_union_eq
#align measure_theory.measure.haar.add_index_union_eq MeasureTheory.Measure.Haar.add_index_union_eq

@[to_additive add_left_add_index_le]
theorem mul_left_index_le {K : Set G} (hK : IsCompact K) {V : Set G} (hV : (interior V).Nonempty)
    (g : G) : index ((fun h => g * h) '' K) V ≤ index K V :=
  by
  rcases index_elim hK hV with ⟨s, h1s, h2s⟩; rw [← h2s]
  apply Nat.infₛ_le; rw [mem_image]
  refine' ⟨s.map (Equiv.mulRight g⁻¹).toEmbedding, _, Finset.card_map _⟩
  · simp only [mem_set_of_eq]
    refine' subset.trans (image_subset _ h1s) _
    rintro _ ⟨g₁, ⟨_, ⟨g₂, rfl⟩, ⟨_, ⟨hg₂, rfl⟩, hg₁⟩⟩, rfl⟩
    simp only [mem_preimage] at hg₁
    simp only [exists_prop, mem_Union, Finset.mem_map, Equiv.coe_mulRight, exists_exists_and_eq_and,
      mem_preimage, Equiv.toEmbedding_apply]
    refine' ⟨_, hg₂, _⟩
    simp only [mul_assoc, hg₁, inv_mul_cancel_left]
#align measure_theory.measure.haar.mul_left_index_le MeasureTheory.Measure.Haar.mul_left_index_le
#align measure_theory.measure.haar.add_left_add_index_le MeasureTheory.Measure.Haar.add_left_add_index_le

@[to_additive is_left_invariant_add_index]
theorem is_left_invariant_index {K : Set G} (hK : IsCompact K) (g : G) {V : Set G}
    (hV : (interior V).Nonempty) : index ((fun h => g * h) '' K) V = index K V :=
  by
  refine' le_antisymm (mul_left_index_le hK hV g) _
  convert mul_left_index_le (hK.image <| continuous_mul_left g) hV g⁻¹
  rw [image_image]; symm; convert image_id' _; ext h; apply inv_mul_cancel_left
#align measure_theory.measure.haar.is_left_invariant_index MeasureTheory.Measure.Haar.is_left_invariant_index
#align measure_theory.measure.haar.is_left_invariant_add_index MeasureTheory.Measure.Haar.is_left_invariant_add_index

/-!
### Lemmas about `prehaar`
-/

@[to_additive add_prehaar_le_add_index]
theorem prehaar_le_index (K₀ : PositiveCompacts G) {U : Set G} (K : Compacts G)
    (hU : (interior U).Nonempty) : prehaar (K₀ : Set G) U K ≤ index (K : Set G) K₀ :=
  by
  unfold prehaar; rw [div_le_iff] <;> norm_cast
  · apply le_index_mul K₀ K hU
  · exact index_pos K₀ hU
#align measure_theory.measure.haar.prehaar_le_index MeasureTheory.Measure.Haar.prehaar_le_index
#align measure_theory.measure.haar.add_prehaar_le_add_index MeasureTheory.Measure.Haar.add_prehaar_le_add_index

@[to_additive]
theorem prehaar_pos (K₀ : PositiveCompacts G) {U : Set G} (hU : (interior U).Nonempty) {K : Set G}
    (h1K : IsCompact K) (h2K : (interior K).Nonempty) : 0 < prehaar (K₀ : Set G) U ⟨K, h1K⟩ :=
  by
  apply div_pos <;> norm_cast
  apply index_pos ⟨⟨K, h1K⟩, h2K⟩ hU
  exact index_pos K₀ hU
#align measure_theory.measure.haar.prehaar_pos MeasureTheory.Measure.Haar.prehaar_pos
#align measure_theory.measure.haar.add_prehaar_pos MeasureTheory.Measure.Haar.add_prehaar_pos

@[to_additive]
theorem prehaar_mono {K₀ : PositiveCompacts G} {U : Set G} (hU : (interior U).Nonempty)
    {K₁ K₂ : Compacts G} (h : (K₁ : Set G) ⊆ K₂.1) :
    prehaar (K₀ : Set G) U K₁ ≤ prehaar (K₀ : Set G) U K₂ :=
  by
  simp only [prehaar]; rw [div_le_div_right]; exact_mod_cast index_mono K₂.2 h hU
  exact_mod_cast index_pos K₀ hU
#align measure_theory.measure.haar.prehaar_mono MeasureTheory.Measure.Haar.prehaar_mono
#align measure_theory.measure.haar.add_prehaar_mono MeasureTheory.Measure.Haar.add_prehaar_mono

@[to_additive]
theorem prehaar_self {K₀ : PositiveCompacts G} {U : Set G} (hU : (interior U).Nonempty) :
    prehaar (K₀ : Set G) U K₀.toCompacts = 1 :=
  div_self <| ne_of_gt <| by exact_mod_cast index_pos K₀ hU
#align measure_theory.measure.haar.prehaar_self MeasureTheory.Measure.Haar.prehaar_self
#align measure_theory.measure.haar.add_prehaar_self MeasureTheory.Measure.Haar.add_prehaar_self

@[to_additive]
theorem prehaar_sup_le {K₀ : PositiveCompacts G} {U : Set G} (K₁ K₂ : Compacts G)
    (hU : (interior U).Nonempty) :
    prehaar (K₀ : Set G) U (K₁ ⊔ K₂) ≤ prehaar (K₀ : Set G) U K₁ + prehaar (K₀ : Set G) U K₂ :=
  by
  simp only [prehaar]; rw [div_add_div_same, div_le_div_right]
  exact_mod_cast index_union_le K₁ K₂ hU; exact_mod_cast index_pos K₀ hU
#align measure_theory.measure.haar.prehaar_sup_le MeasureTheory.Measure.Haar.prehaar_sup_le
#align measure_theory.measure.haar.add_prehaar_sup_le MeasureTheory.Measure.Haar.add_prehaar_sup_le

@[to_additive]
theorem prehaar_sup_eq {K₀ : PositiveCompacts G} {U : Set G} {K₁ K₂ : Compacts G}
    (hU : (interior U).Nonempty) (h : Disjoint (K₁.1 * U⁻¹) (K₂.1 * U⁻¹)) :
    prehaar (K₀ : Set G) U (K₁ ⊔ K₂) = prehaar (K₀ : Set G) U K₁ + prehaar (K₀ : Set G) U K₂ :=
  by
  simp only [prehaar]
  rw [div_add_div_same]
  congr
  exact_mod_cast index_union_eq K₁ K₂ hU h
#align measure_theory.measure.haar.prehaar_sup_eq MeasureTheory.Measure.Haar.prehaar_sup_eq
#align measure_theory.measure.haar.add_prehaar_sup_eq MeasureTheory.Measure.Haar.add_prehaar_sup_eq

@[to_additive]
theorem is_left_invariant_prehaar {K₀ : PositiveCompacts G} {U : Set G} (hU : (interior U).Nonempty)
    (g : G) (K : Compacts G) :
    prehaar (K₀ : Set G) U (K.map _ <| continuous_mul_left g) = prehaar (K₀ : Set G) U K := by
  simp only [prehaar, compacts.coe_map, is_left_invariant_index K.is_compact _ hU]
#align measure_theory.measure.haar.is_left_invariant_prehaar MeasureTheory.Measure.Haar.is_left_invariant_prehaar
#align measure_theory.measure.haar.is_left_invariant_add_prehaar MeasureTheory.Measure.Haar.is_left_invariant_add_prehaar

/-!
### Lemmas about `haar_product`
-/

@[to_additive]
theorem prehaar_mem_haarProduct (K₀ : PositiveCompacts G) {U : Set G} (hU : (interior U).Nonempty) :
    prehaar (K₀ : Set G) U ∈ haarProduct (K₀ : Set G) :=
  by
  rintro ⟨K, hK⟩ h2K
  rw [mem_Icc]
  exact ⟨prehaar_nonneg K₀ _, prehaar_le_index K₀ _ hU⟩
#align measure_theory.measure.haar.prehaar_mem_haar_product MeasureTheory.Measure.Haar.prehaar_mem_haarProduct
#align measure_theory.measure.haar.add_prehaar_mem_add_haar_product MeasureTheory.Measure.Haar.add_prehaar_mem_add_haarProduct

@[to_additive]
theorem nonempty_interᵢ_clPrehaar (K₀ : PositiveCompacts G) :
    (haarProduct (K₀ : Set G) ∩ ⋂ V : OpenNhdsOf (1 : G), clPrehaar K₀ V).Nonempty :=
  by
  have : IsCompact (haar_product (K₀ : Set G)) :=
    by
    apply isCompact_univ_pi
    intro K
    apply is_compact_Icc
  refine' this.inter_Inter_nonempty (cl_prehaar K₀) (fun s => isClosed_closure) fun t => _
  let V₀ := ⋂ V ∈ t, (V : open_nhds_of 1).carrier
  have h1V₀ : IsOpen V₀ := by
    apply isOpen_binterᵢ
    apply Finset.finite_toSet
    rintro ⟨⟨V, hV₁⟩, hV₂⟩ h2V
    exact hV₁
  have h2V₀ : (1 : G) ∈ V₀ := by
    simp only [mem_Inter]
    rintro ⟨⟨V, hV₁⟩, hV₂⟩ h2V
    exact hV₂
  refine' ⟨prehaar K₀ V₀, _⟩
  constructor
  · apply prehaar_mem_haar_product K₀
    use 1
    rwa [h1V₀.interior_eq]
  · simp only [mem_Inter]
    rintro ⟨V, hV⟩ h2V
    apply subset_closure
    apply mem_image_of_mem
    rw [mem_set_of_eq]
    exact ⟨subset.trans (Inter_subset _ ⟨V, hV⟩) (Inter_subset _ h2V), h1V₀, h2V₀⟩
#align measure_theory.measure.haar.nonempty_Inter_cl_prehaar MeasureTheory.Measure.Haar.nonempty_interᵢ_clPrehaar
#align measure_theory.measure.haar.nonempty_Inter_cl_add_prehaar MeasureTheory.Measure.Haar.nonempty_interᵢ_cl_add_prehaar

/-!
### Lemmas about `chaar`
-/

/-- This is the "limit" of `prehaar K₀ U K` as `U` becomes a smaller and smaller open
  neighborhood of `(1 : G)`. More precisely, it is defined to be an arbitrary element
  in the intersection of all the sets `cl_prehaar K₀ V` in `haar_product K₀`.
  This is roughly equal to the Haar measure on compact sets,
  but it can differ slightly. We do know that
  `haar_measure K₀ (interior K) ≤ chaar K₀ K ≤ haar_measure K₀ K`. -/
@[to_additive add_chaar "additive version of `measure_theory.measure.haar.chaar`"]
def chaar (K₀ : PositiveCompacts G) (K : Compacts G) : ℝ :=
  Classical.choose (nonempty_interᵢ_clPrehaar K₀) K
#align measure_theory.measure.haar.chaar MeasureTheory.Measure.Haar.chaar
#align measure_theory.measure.haar.add_chaar MeasureTheory.Measure.Haar.addChaar

@[to_additive add_chaar_mem_add_haar_product]
theorem chaar_mem_haarProduct (K₀ : PositiveCompacts G) : chaar K₀ ∈ haarProduct (K₀ : Set G) :=
  (Classical.choose_spec (nonempty_interᵢ_clPrehaar K₀)).1
#align measure_theory.measure.haar.chaar_mem_haar_product MeasureTheory.Measure.Haar.chaar_mem_haarProduct
#align measure_theory.measure.haar.add_chaar_mem_add_haar_product MeasureTheory.Measure.Haar.add_chaar_mem_add_haarProduct

@[to_additive add_chaar_mem_cl_add_prehaar]
theorem chaar_mem_clPrehaar (K₀ : PositiveCompacts G) (V : OpenNhdsOf (1 : G)) :
    chaar K₀ ∈ clPrehaar (K₀ : Set G) V :=
  by
  have := (Classical.choose_spec (nonempty_Inter_cl_prehaar K₀)).2
  rw [mem_Inter] at this
  exact this V
#align measure_theory.measure.haar.chaar_mem_cl_prehaar MeasureTheory.Measure.Haar.chaar_mem_clPrehaar
#align measure_theory.measure.haar.add_chaar_mem_cl_add_prehaar MeasureTheory.Measure.Haar.add_chaar_mem_cl_add_prehaar

@[to_additive add_chaar_nonneg]
theorem chaar_nonneg (K₀ : PositiveCompacts G) (K : Compacts G) : 0 ≤ chaar K₀ K :=
  by
  have := chaar_mem_haar_product K₀ K (mem_univ _)
  rw [mem_Icc] at this
  exact this.1
#align measure_theory.measure.haar.chaar_nonneg MeasureTheory.Measure.Haar.chaar_nonneg
#align measure_theory.measure.haar.add_chaar_nonneg MeasureTheory.Measure.Haar.add_chaar_nonneg

@[to_additive add_chaar_empty]
theorem chaar_empty (K₀ : PositiveCompacts G) : chaar K₀ ⊥ = 0 :=
  by
  let eval : (compacts G → ℝ) → ℝ := fun f => f ⊥
  have : Continuous eval := continuous_apply ⊥
  show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)}
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⊤)
  unfold cl_prehaar; rw [IsClosed.closure_subset_iff]
  · rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩
    apply prehaar_empty
  · apply continuous_iff_is_closed.mp this
    exact isClosed_singleton
#align measure_theory.measure.haar.chaar_empty MeasureTheory.Measure.Haar.chaar_empty
#align measure_theory.measure.haar.add_chaar_empty MeasureTheory.Measure.Haar.add_chaar_empty

@[to_additive add_chaar_self]
theorem chaar_self (K₀ : PositiveCompacts G) : chaar K₀ K₀.toCompacts = 1 :=
  by
  let eval : (compacts G → ℝ) → ℝ := fun f => f K₀.to_compacts
  have : Continuous eval := continuous_apply _
  show chaar K₀ ∈ eval ⁻¹' {(1 : ℝ)}
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⊤)
  unfold cl_prehaar; rw [IsClosed.closure_subset_iff]
  · rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩
    apply prehaar_self
    rw [h2U.interior_eq]
    exact ⟨1, h3U⟩
  · apply continuous_iff_is_closed.mp this
    exact isClosed_singleton
#align measure_theory.measure.haar.chaar_self MeasureTheory.Measure.Haar.chaar_self
#align measure_theory.measure.haar.add_chaar_self MeasureTheory.Measure.Haar.add_chaar_self

@[to_additive add_chaar_mono]
theorem chaar_mono {K₀ : PositiveCompacts G} {K₁ K₂ : Compacts G} (h : (K₁ : Set G) ⊆ K₂) :
    chaar K₀ K₁ ≤ chaar K₀ K₂ :=
  by
  let eval : (compacts G → ℝ) → ℝ := fun f => f K₂ - f K₁
  have : Continuous eval := (continuous_apply K₂).sub (continuous_apply K₁)
  rw [← sub_nonneg]; show chaar K₀ ∈ eval ⁻¹' Ici (0 : ℝ)
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⊤)
  unfold cl_prehaar; rw [IsClosed.closure_subset_iff]
  · rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩
    simp only [mem_preimage, mem_Ici, eval, sub_nonneg]
    apply prehaar_mono _ h
    rw [h2U.interior_eq]
    exact ⟨1, h3U⟩
  · apply continuous_iff_is_closed.mp this
    exact isClosed_Ici
#align measure_theory.measure.haar.chaar_mono MeasureTheory.Measure.Haar.chaar_mono
#align measure_theory.measure.haar.add_chaar_mono MeasureTheory.Measure.Haar.add_chaar_mono

@[to_additive add_chaar_sup_le]
theorem chaar_sup_le {K₀ : PositiveCompacts G} (K₁ K₂ : Compacts G) :
    chaar K₀ (K₁ ⊔ K₂) ≤ chaar K₀ K₁ + chaar K₀ K₂ :=
  by
  let eval : (compacts G → ℝ) → ℝ := fun f => f K₁ + f K₂ - f (K₁ ⊔ K₂)
  have : Continuous eval :=
    ((@continuous_add ℝ _ _ _).comp ((continuous_apply K₁).prod_mk (continuous_apply K₂))).sub
      (continuous_apply (K₁ ⊔ K₂))
  rw [← sub_nonneg]; show chaar K₀ ∈ eval ⁻¹' Ici (0 : ℝ)
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⊤)
  unfold cl_prehaar; rw [IsClosed.closure_subset_iff]
  · rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩
    simp only [mem_preimage, mem_Ici, eval, sub_nonneg]
    apply prehaar_sup_le
    rw [h2U.interior_eq]
    exact ⟨1, h3U⟩
  · apply continuous_iff_is_closed.mp this
    exact isClosed_Ici
#align measure_theory.measure.haar.chaar_sup_le MeasureTheory.Measure.Haar.chaar_sup_le
#align measure_theory.measure.haar.add_chaar_sup_le MeasureTheory.Measure.Haar.add_chaar_sup_le

@[to_additive add_chaar_sup_eq]
theorem chaar_sup_eq [T2Space G] {K₀ : PositiveCompacts G} {K₁ K₂ : Compacts G}
    (h : Disjoint K₁.1 K₂.1) : chaar K₀ (K₁ ⊔ K₂) = chaar K₀ K₁ + chaar K₀ K₂ :=
  by
  rcases isCompact_isCompact_separated K₁.2 K₂.2 h with ⟨U₁, U₂, h1U₁, h1U₂, h2U₁, h2U₂, hU⟩
  rcases compact_open_separated_mul_right K₁.2 h1U₁ h2U₁ with ⟨L₁, h1L₁, h2L₁⟩
  rcases mem_nhds_iff.mp h1L₁ with ⟨V₁, h1V₁, h2V₁, h3V₁⟩
  replace h2L₁ := subset.trans (mul_subset_mul_left h1V₁) h2L₁
  rcases compact_open_separated_mul_right K₂.2 h1U₂ h2U₂ with ⟨L₂, h1L₂, h2L₂⟩
  rcases mem_nhds_iff.mp h1L₂ with ⟨V₂, h1V₂, h2V₂, h3V₂⟩
  replace h2L₂ := subset.trans (mul_subset_mul_left h1V₂) h2L₂
  let eval : (compacts G → ℝ) → ℝ := fun f => f K₁ + f K₂ - f (K₁ ⊔ K₂)
  have : Continuous eval :=
    ((@continuous_add ℝ _ _ _).comp ((continuous_apply K₁).prod_mk (continuous_apply K₂))).sub
      (continuous_apply (K₁ ⊔ K₂))
  rw [eq_comm, ← sub_eq_zero]; show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)}
  let V := V₁ ∩ V₂
  apply
    mem_of_subset_of_mem _
      (chaar_mem_cl_prehaar K₀
        ⟨⟨V⁻¹, (h2V₁.inter h2V₂).Preimage continuous_inv⟩, by
          simp only [mem_inv, inv_one, h3V₁, h3V₂, V, mem_inter_iff, true_and_iff]⟩)
  unfold cl_prehaar; rw [IsClosed.closure_subset_iff]
  · rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩
    simp only [mem_preimage, eval, sub_eq_zero, mem_singleton_iff]
    rw [eq_comm]
    apply prehaar_sup_eq
    · rw [h2U.interior_eq]
      exact ⟨1, h3U⟩
    · refine' disjoint_of_subset _ _ hU
      · refine' subset.trans (mul_subset_mul subset.rfl _) h2L₁
        exact subset.trans (inv_subset.mpr h1U) (inter_subset_left _ _)
      · refine' subset.trans (mul_subset_mul subset.rfl _) h2L₂
        exact subset.trans (inv_subset.mpr h1U) (inter_subset_right _ _)
  · apply continuous_iff_is_closed.mp this
    exact isClosed_singleton
#align measure_theory.measure.haar.chaar_sup_eq MeasureTheory.Measure.Haar.chaar_sup_eq
#align measure_theory.measure.haar.add_chaar_sup_eq MeasureTheory.Measure.Haar.add_chaar_sup_eq

@[to_additive is_left_invariant_add_chaar]
theorem is_left_invariant_chaar {K₀ : PositiveCompacts G} (g : G) (K : Compacts G) :
    chaar K₀ (K.map _ <| continuous_mul_left g) = chaar K₀ K :=
  by
  let eval : (compacts G → ℝ) → ℝ := fun f => f (K.map _ <| continuous_mul_left g) - f K
  have : Continuous eval := (continuous_apply (K.map _ _)).sub (continuous_apply K)
  rw [← sub_eq_zero]; show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)}
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⊤)
  unfold cl_prehaar; rw [IsClosed.closure_subset_iff]
  · rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩
    simp only [mem_singleton_iff, mem_preimage, eval, sub_eq_zero]
    apply is_left_invariant_prehaar
    rw [h2U.interior_eq]
    exact ⟨1, h3U⟩
  · apply continuous_iff_is_closed.mp this
    exact isClosed_singleton
#align measure_theory.measure.haar.is_left_invariant_chaar MeasureTheory.Measure.Haar.is_left_invariant_chaar
#align measure_theory.measure.haar.is_left_invariant_add_chaar MeasureTheory.Measure.Haar.is_left_invariant_add_chaar

variable [T2Space G]

/-- The function `chaar` interpreted in `ℝ≥0`, as a content -/
@[to_additive "additive version of `measure_theory.measure.haar.haar_content`"]
def haarContent (K₀ : PositiveCompacts G) : Content G
    where
  toFun K := ⟨chaar K₀ K, chaar_nonneg _ _⟩
  mono' K₁ K₂ h := by simp only [← NNReal.coe_le_coe, Subtype.coe_mk, chaar_mono, h]
  sup_disjoint' K₁ K₂ h := by
    simp only [chaar_sup_eq h]
    rfl
  sup_le' K₁ K₂ := by simp only [← NNReal.coe_le_coe, NNReal.coe_add, Subtype.coe_mk, chaar_sup_le]
#align measure_theory.measure.haar.haar_content MeasureTheory.Measure.Haar.haarContent
#align measure_theory.measure.haar.add_haar_content MeasureTheory.Measure.Haar.add_haar_content

/-! We only prove the properties for `haar_content` that we use at least twice below. -/

@[to_additive]
theorem haarContent_apply (K₀ : PositiveCompacts G) (K : Compacts G) :
    haarContent K₀ K = show NNReal from ⟨chaar K₀ K, chaar_nonneg _ _⟩ :=
  rfl
#align measure_theory.measure.haar.haar_content_apply MeasureTheory.Measure.Haar.haarContent_apply
#align measure_theory.measure.haar.add_haar_content_apply MeasureTheory.Measure.Haar.add_haar_content_apply

/-- The variant of `chaar_self` for `haar_content` -/
@[to_additive "The variant of `add_chaar_self` for `add_haar_content`."]
theorem haarContent_self {K₀ : PositiveCompacts G} : haarContent K₀ K₀.toCompacts = 1 :=
  by
  simp_rw [← ENNReal.coe_one, haar_content_apply, ENNReal.coe_eq_coe, chaar_self]
  rfl
#align measure_theory.measure.haar.haar_content_self MeasureTheory.Measure.Haar.haarContent_self
#align measure_theory.measure.haar.add_haar_content_self MeasureTheory.Measure.Haar.add_haar_content_self

/-- The variant of `is_left_invariant_chaar` for `haar_content` -/
@[to_additive "The variant of `is_left_invariant_add_chaar` for `add_haar_content`"]
theorem is_left_invariant_haarContent {K₀ : PositiveCompacts G} (g : G) (K : Compacts G) :
    haarContent K₀ (K.map _ <| continuous_mul_left g) = haarContent K₀ K := by
  simpa only [ENNReal.coe_eq_coe, ← NNReal.coe_eq, haar_content_apply] using
    is_left_invariant_chaar g K
#align measure_theory.measure.haar.is_left_invariant_haar_content MeasureTheory.Measure.Haar.is_left_invariant_haarContent
#align measure_theory.measure.haar.is_left_invariant_add_haar_content MeasureTheory.Measure.Haar.is_left_invariant_add_haar_content

@[to_additive]
theorem haarContent_outerMeasure_self_pos {K₀ : PositiveCompacts G} :
    0 < (haarContent K₀).OuterMeasure K₀ :=
  by
  refine' zero_lt_one.trans_le _
  rw [content.outer_measure_eq_infi]
  refine' le_infᵢ₂ fun U hU => le_infᵢ fun hK₀ => le_trans _ <| le_supᵢ₂ K₀.to_compacts hK₀
  exact haar_content_self.ge
#align measure_theory.measure.haar.haar_content_outer_measure_self_pos MeasureTheory.Measure.Haar.haarContent_outerMeasure_self_pos
#align measure_theory.measure.haar.add_haar_content_outer_measure_self_pos MeasureTheory.Measure.Haar.add_haar_content_outer_measure_self_pos

end Haar

open Haar

/-!
### The Haar measure
-/

variable [TopologicalSpace G] [T2Space G] [TopologicalGroup G] [MeasurableSpace G] [BorelSpace G]

/-- The Haar measure on the locally compact group `G`, scaled so that `haar_measure K₀ K₀ = 1`. -/
@[to_additive
      "The Haar measure on the locally compact additive group `G`,\nscaled so that `add_haar_measure K₀ K₀ = 1`."]
def haarMeasure (K₀ : PositiveCompacts G) : Measure G :=
  ((haarContent K₀).OuterMeasure K₀)⁻¹ • (haarContent K₀).Measure
#align measure_theory.measure.haar_measure MeasureTheory.Measure.haarMeasure
#align measure_theory.measure.add_haar_measure MeasureTheory.Measure.add_haar_measure

@[to_additive]
theorem haarMeasure_apply {K₀ : PositiveCompacts G} {s : Set G} (hs : MeasurableSet s) :
    haarMeasure K₀ s = (haarContent K₀).OuterMeasure s / (haarContent K₀).OuterMeasure K₀ :=
  by
  change ((haar_content K₀).OuterMeasure K₀)⁻¹ * (haar_content K₀).Measure s = _
  simp only [hs, div_eq_mul_inv, mul_comm, content.measure_apply]
#align measure_theory.measure.haar_measure_apply MeasureTheory.Measure.haarMeasure_apply
#align measure_theory.measure.add_haar_measure_apply MeasureTheory.Measure.add_haar_measure_apply

@[to_additive]
instance isMulLeftInvariantHaarMeasure (K₀ : PositiveCompacts G) :
    IsMulLeftInvariant (haarMeasure K₀) :=
  by
  rw [← forall_measure_preimage_mul_iff]
  intro g A hA
  rw [haar_measure_apply hA, haar_measure_apply (measurable_const_mul g hA)]
  congr 1
  apply content.is_mul_left_invariant_outer_measure
  apply is_left_invariant_haar_content
#align measure_theory.measure.is_mul_left_invariant_haar_measure MeasureTheory.Measure.isMulLeftInvariantHaarMeasure
#align measure_theory.measure.is_add_left_invariant_add_haar_measure MeasureTheory.Measure.is_add_left_invariant_add_haar_measure

@[to_additive]
theorem haarMeasure_self {K₀ : PositiveCompacts G} : haarMeasure K₀ K₀ = 1 :=
  by
  haveI : LocallyCompactSpace G := K₀.locally_compact_space_of_group
  rw [haar_measure_apply K₀.is_compact.measurable_set, ENNReal.div_self]
  · rw [← pos_iff_ne_zero]
    exact haar_content_outer_measure_self_pos
  · exact (content.outer_measure_lt_top_of_is_compact _ K₀.is_compact).Ne
#align measure_theory.measure.haar_measure_self MeasureTheory.Measure.haarMeasure_self
#align measure_theory.measure.add_haar_measure_self MeasureTheory.Measure.add_haar_measure_self

/-- The Haar measure is regular. -/
@[to_additive "The additive Haar measure is regular."]
instance regularHaarMeasure {K₀ : PositiveCompacts G} : (haarMeasure K₀).regular :=
  by
  haveI : LocallyCompactSpace G := K₀.locally_compact_space_of_group
  apply regular.smul
  rw [ENNReal.inv_ne_top]
  exact haar_content_outer_measure_self_pos.ne'
#align measure_theory.measure.regular_haar_measure MeasureTheory.Measure.regularHaarMeasure
#align measure_theory.measure.regular_add_haar_measure MeasureTheory.Measure.regular_add_haar_measure

/-- The Haar measure is sigma-finite in a second countable group. -/
@[to_additive "The additive Haar measure is sigma-finite in a second countable group."]
instance sigmaFiniteHaarMeasure [SecondCountableTopology G] {K₀ : PositiveCompacts G} :
    SigmaFinite (haarMeasure K₀) :=
  by
  haveI : LocallyCompactSpace G := K₀.locally_compact_space_of_group
  infer_instance
#align measure_theory.measure.sigma_finite_haar_measure MeasureTheory.Measure.sigmaFiniteHaarMeasure
#align measure_theory.measure.sigma_finite_add_haar_measure MeasureTheory.Measure.sigma_finite_add_haar_measure

/-- The Haar measure is a Haar measure, i.e., it is invariant and gives finite mass to compact
sets and positive mass to nonempty open sets. -/
@[to_additive
      "The additive Haar measure is an additive Haar measure, i.e., it is invariant and\ngives  finite mass to compact sets and positive mass to nonempty open sets."]
instance isHaarMeasureHaarMeasure (K₀ : PositiveCompacts G) : IsHaarMeasure (haarMeasure K₀) :=
  by
  apply
    is_haar_measure_of_is_compact_nonempty_interior (haar_measure K₀) K₀ K₀.is_compact
      K₀.interior_nonempty
  · simp only [haar_measure_self]
    exact one_ne_zero
  · simp only [haar_measure_self]
    exact ENNReal.coe_ne_top
#align measure_theory.measure.is_haar_measure_haar_measure MeasureTheory.Measure.isHaarMeasureHaarMeasure
#align measure_theory.measure.is_add_haar_measure_add_haar_measure MeasureTheory.Measure.is_add_haar_measure_add_haar_measure

/-- `haar` is some choice of a Haar measure, on a locally compact group. -/
@[reducible,
  to_additive "`add_haar` is some choice of a Haar measure, on a locally compact\nadditive group."]
def haar [LocallyCompactSpace G] : Measure G :=
  haarMeasure <| Classical.arbitrary _
#align measure_theory.measure.haar MeasureTheory.Measure.haar
#align measure_theory.measure.add_haar MeasureTheory.Measure.add_haar

section SecondCountable

variable [SecondCountableTopology G]

/-- The Haar measure is unique up to scaling. More precisely: every σ-finite left invariant measure
  is a scalar multiple of the Haar measure.
  This is slightly weaker than assuming that `μ` is a Haar measure (in particular we don't require
  `μ ≠ 0`). -/
@[to_additive
      "The additive Haar measure is unique up to scaling. More precisely: every σ-finite\nleft invariant measure is a scalar multiple of the additive Haar measure. This is slightly weaker\nthan assuming that `μ` is an additive Haar measure (in particular we don't require `μ ≠ 0`)."]
theorem haarMeasure_unique (μ : Measure G) [SigmaFinite μ] [IsMulLeftInvariant μ]
    (K₀ : PositiveCompacts G) : μ = μ K₀ • haarMeasure K₀ :=
  (measure_eq_div_smul μ (haarMeasure K₀) K₀.IsCompact.MeasurableSet
        (measure_pos_of_nonempty_interior _ K₀.interior_nonempty).ne'
        K₀.IsCompact.measure_lt_top.Ne).trans
    (by rw [haar_measure_self, div_one])
#align measure_theory.measure.haar_measure_unique MeasureTheory.Measure.haarMeasure_unique
#align measure_theory.measure.add_haar_measure_unique MeasureTheory.Measure.add_haar_measure_unique

example [LocallyCompactSpace G] (μ : Measure G) [IsHaarMeasure μ] (K₀ : PositiveCompacts G) :
    μ = μ K₀.1 • haarMeasure K₀ :=
  haarMeasure_unique μ K₀

/-- To show that an invariant σ-finite measure is regular it is sufficient to show that it is finite
  on some compact set with non-empty interior. -/
@[to_additive
      "To show that an invariant σ-finite measure is regular it is sufficient to show that\nit is finite on some compact set with non-empty interior."]
theorem regularOfIsMulLeftInvariant {μ : Measure G} [SigmaFinite μ] [IsMulLeftInvariant μ]
    {K : Set G} (hK : IsCompact K) (h2K : (interior K).Nonempty) (hμK : μ K ≠ ∞) : Regular μ :=
  by
  rw [haar_measure_unique μ ⟨⟨K, hK⟩, h2K⟩]
  exact regular.smul hμK
#align measure_theory.measure.regular_of_is_mul_left_invariant MeasureTheory.Measure.regularOfIsMulLeftInvariant
#align measure_theory.measure.regular_of_is_add_left_invariant MeasureTheory.Measure.regular_of_is_add_left_invariant

@[to_additive is_add_haar_measure_eq_smul_is_add_haar_measure]
theorem isHaarMeasure_eq_smul_isHaarMeasure [LocallyCompactSpace G] (μ ν : Measure G)
    [IsHaarMeasure μ] [IsHaarMeasure ν] : ∃ c : ℝ≥0∞, c ≠ 0 ∧ c ≠ ∞ ∧ μ = c • ν :=
  by
  have K : positive_compacts G := Classical.arbitrary _
  have νpos : 0 < ν K := measure_pos_of_nonempty_interior _ K.interior_nonempty
  have νne : ν K ≠ ∞ := K.is_compact.measure_lt_top.ne
  refine' ⟨μ K / ν K, _, _, _⟩
  ·
    simp only [νne, (μ.measure_pos_of_nonempty_interior K.interior_nonempty).ne', Ne.def,
      ENNReal.div_eq_zero_iff, not_false_iff, or_self_iff]
  ·
    simp only [div_eq_mul_inv, νpos.ne', K.is_compact.measure_lt_top.Ne, or_self_iff,
      ENNReal.inv_eq_top, WithTop.mul_eq_top_iff, Ne.def, not_false_iff, and_false_iff,
      false_and_iff]
  ·
    calc
      μ = μ K • haar_measure K := haar_measure_unique μ K
      _ = (μ K / ν K) • ν K • haar_measure K := by
        rw [smul_smul, div_eq_mul_inv, mul_assoc, ENNReal.inv_mul_cancel νpos.ne' νne, mul_one]
      _ = (μ K / ν K) • ν := by rw [← haar_measure_unique ν K]

#align measure_theory.measure.is_haar_measure_eq_smul_is_haar_measure MeasureTheory.Measure.isHaarMeasure_eq_smul_isHaarMeasure
#align measure_theory.measure.is_add_haar_measure_eq_smul_is_add_haar_measure MeasureTheory.Measure.is_add_haar_measure_eq_smul_is_add_haar_measure

-- see Note [lower instance priority]
@[to_additive]
instance (priority := 90) regularOfIsHaarMeasure [LocallyCompactSpace G] (μ : Measure G)
    [IsHaarMeasure μ] : Regular μ :=
  by
  have K : positive_compacts G := Classical.arbitrary _
  obtain ⟨c, c0, ctop, hμ⟩ : ∃ c : ℝ≥0∞, c ≠ 0 ∧ c ≠ ∞ ∧ μ = c • haar_measure K :=
    is_haar_measure_eq_smul_is_haar_measure μ _
  rw [hμ]
  exact regular.smul Ctop
#align measure_theory.measure.regular_of_is_haar_measure MeasureTheory.Measure.regularOfIsHaarMeasure
#align measure_theory.measure.regular_of_is_add_haar_measure MeasureTheory.Measure.regular_of_is_add_haar_measure

/-- **Steinhaus Theorem** In any locally compact group `G` with a haar measure `μ`, for any
  measurable set `E` of positive measure, the set `E / E` is a neighbourhood of `1`. -/
@[to_additive
      "**Steinhaus Theorem** In any locally compact group `G` with a haar measure `μ`,\n  for any measurable set `E` of positive measure, the set `E - E` is a neighbourhood of `0`."]
theorem div_mem_nhds_one_of_haar_pos (μ : Measure G) [IsHaarMeasure μ] [LocallyCompactSpace G]
    (E : Set G) (hE : MeasurableSet E) (hEpos : 0 < μ E) : E / E ∈ 𝓝 (1 : G) :=
  by
  /- For any regular measure `μ` and set `E` of positive measure, we can find a compact set `K` of
       positive measure inside `E`. Further, for any outer regular measure `μ` there exists an open
       set `U` containing `K` with measure arbitrarily close to `K` (here `μ U < 2 * μ K` suffices).
       Then, we can pick an open neighborhood of `1`, say `V` such that such that `V * K` is contained
       in `U`. Now note that for any `v` in `V`, the sets `K` and `{v} * K` can not be disjoint
       because they are both of measure `μ K` (since `μ` is left regular) and also contained in `U`,
       yet we have that `μ U < 2 * μ K`. This show that `K / K` contains the neighborhood `V` of `1`,
       and therefore that it is itself such a neighborhood. -/
  obtain ⟨L, hL, hLE, hLpos, hLtop⟩ : ∃ L : Set G, MeasurableSet L ∧ L ⊆ E ∧ 0 < μ L ∧ μ L < ∞
  exact exists_subset_measure_lt_top hE hEpos
  obtain ⟨K, hKL, hK, hKpos⟩ : ∃ (K : Set G)(H : K ⊆ L), IsCompact K ∧ 0 < μ K
  exact MeasurableSet.exists_lt_isCompact_of_ne_top hL (ne_of_lt hLtop) hLpos
  have hKtop : μ K ≠ ∞ := by
    apply ne_top_of_le_ne_top (ne_of_lt hLtop)
    apply measure_mono hKL
  obtain ⟨U, hUK, hU, hμUK⟩ : ∃ (U : Set G)(H : U ⊇ K), IsOpen U ∧ μ U < μ K + μ K
  exact Set.exists_isOpen_lt_add K hKtop hKpos.ne'
  obtain ⟨V, hV1, hVKU⟩ : ∃ V ∈ 𝓝 (1 : G), V * K ⊆ U
  exact compact_open_separated_mul_left hK hU hUK
  have hv : ∀ v : G, v ∈ V → ¬Disjoint ({v} * K) K :=
    by
    intro v hv hKv
    have hKvsub : {v} * K ∪ K ⊆ U := by
      apply Set.union_subset _ hUK
      apply subset_trans _ hVKU
      apply Set.mul_subset_mul _ (Set.Subset.refl K)
      simp only [Set.singleton_subset_iff, hv]
    replace hKvsub := @measure_mono _ _ μ _ _ hKvsub
    have hcontr := lt_of_le_of_lt hKvsub hμUK
    rw [measure_union hKv (IsCompact.measurableSet hK)] at hcontr
    have hKtranslate : μ ({v} * K) = μ K := by
      simp only [singleton_mul, image_mul_left, measure_preimage_mul]
    rw [hKtranslate, lt_self_iff_false] at hcontr
    assumption
  suffices : V ⊆ E / E
  exact Filter.mem_of_superset hV1 this
  intro v hvV
  obtain ⟨x, hxK, hxvK⟩ : ∃ x : G, x ∈ {v} * K ∧ x ∈ K
  exact Set.not_disjoint_iff.1 (hv v hvV)
  refine' ⟨x, v⁻¹ * x, hLE (hKL hxvK), _, _⟩
  · apply hKL.trans hLE
    simpa only [singleton_mul, image_mul_left, mem_preimage] using hxK
  · simp only [div_eq_iff_eq_mul, ← mul_assoc, mul_right_inv, one_mul]
#align measure_theory.measure.div_mem_nhds_one_of_haar_pos MeasureTheory.Measure.div_mem_nhds_one_of_haar_pos
#align measure_theory.measure.sub_mem_nhds_zero_of_add_haar_pos MeasureTheory.Measure.sub_mem_nhds_zero_of_add_haar_pos

end SecondCountable

end Group

section CommGroup

variable {G : Type _} [CommGroup G] [TopologicalSpace G] [TopologicalGroup G] [T2Space G]
  [MeasurableSpace G] [BorelSpace G] [SecondCountableTopology G] (μ : Measure G) [IsHaarMeasure μ]

/-- Any Haar measure is invariant under inversion in an abelian group. -/
@[to_additive "Any additive Haar measure is invariant under negation in an abelian group."]
instance (priority := 100) IsHaarMeasure.isInvInvariant [LocallyCompactSpace G] :
    IsInvInvariant μ :=
  by
  -- the image measure is a Haar measure. By uniqueness up to multiplication, it is of the form
  -- `c μ`. Applying again inversion, one gets the measure `c^2 μ`. But since inversion is an
  -- involution, this is also `μ`. Hence, `c^2 = 1`, which implies `c = 1`.
  constructor
  haveI : is_haar_measure (measure.map Inv.inv μ) :=
    (MulEquiv.inv G).isHaarMeasureMap μ continuous_inv continuous_inv
  obtain ⟨c, cpos, clt, hc⟩ : ∃ c : ℝ≥0∞, c ≠ 0 ∧ c ≠ ∞ ∧ measure.map Inv.inv μ = c • μ :=
    is_haar_measure_eq_smul_is_haar_measure _ _
  have : map Inv.inv (map Inv.inv μ) = c ^ 2 • μ := by
    simp only [hc, smul_smul, pow_two, measure.map_smul]
  have μeq : μ = c ^ 2 • μ :=
    by
    rw [map_map continuous_inv.measurable continuous_inv.measurable] at this
    · simpa only [inv_involutive, involutive.comp_self, map_id]
    all_goals infer_instance
  have K : positive_compacts G := Classical.arbitrary _
  have : c ^ 2 * μ K = 1 ^ 2 * μ K := by
    conv_rhs => rw [μeq]
    simp
  have : c ^ 2 = 1 ^ 2 :=
    (ENNReal.mul_eq_mul_right (measure_pos_of_nonempty_interior _ K.interior_nonempty).ne'
          K.is_compact.measure_lt_top.ne).1
      this
  have : c = 1 := (ENNReal.pow_strictMono two_ne_zero).Injective this
  rw [measure.inv, hc, this, one_smul]
#align measure_theory.measure.is_haar_measure.is_inv_invariant MeasureTheory.Measure.IsHaarMeasure.isInvInvariant
#align measure_theory.measure.is_add_haar_measure.is_neg_invariant MeasureTheory.Measure.IsAddHaarMeasure.is_neg_invariant

@[to_additive]
theorem measurePreservingZpow [CompactSpace G] [RootableBy G ℤ] {n : ℤ} (hn : n ≠ 0) :
    MeasurePreserving (fun g : G => g ^ n) μ μ :=
  { Measurable := (continuous_zpow n).Measurable
    map_eq := by
      let f := @zpowGroupHom G _ n
      have hf : Continuous f := continuous_zpow n
      haveI : (μ.map f).IsHaarMeasure :=
        is_haar_measure_map μ f hf (RootableBy.surjective_pow G ℤ hn) (by simp)
      obtain ⟨C, -, -, hC⟩ := is_haar_measure_eq_smul_is_haar_measure (μ.map f) μ
      suffices C = 1 by rwa [this, one_smul] at hC
      have h_univ : (μ.map f) univ = μ univ := by
        rw [map_apply_of_ae_measurable hf.measurable.ae_measurable MeasurableSet.univ,
          preimage_univ]
      have hμ₀ : μ univ ≠ 0 := is_open_pos_measure.open_pos univ isOpen_univ univ_nonempty
      have hμ₁ : μ univ ≠ ∞ := compact_space.is_finite_measure.measure_univ_lt_top.ne
      rwa [hC, smul_apply, Algebra.id.smul_eq_mul, mul_comm, ← ENNReal.eq_div_iff hμ₀ hμ₁,
        ENNReal.div_self hμ₀ hμ₁] at h_univ }
#align measure_theory.measure.measure_preserving_zpow MeasureTheory.Measure.measurePreservingZpow
#align measure_theory.measure.measure_preserving_zsmul MeasureTheory.Measure.measure_preserving_zsmul

@[to_additive]
theorem MeasurePreserving.zpow [CompactSpace G] [RootableBy G ℤ] {n : ℤ} (hn : n ≠ 0) {X : Type _}
    [MeasurableSpace X] {μ' : Measure X} {f : X → G} (hf : MeasurePreserving f μ' μ) :
    MeasurePreserving (fun x => f x ^ n) μ' μ :=
  (measurePreservingZpow μ hn).comp hf
#align measure_theory.measure.measure_preserving.zpow MeasureTheory.Measure.MeasurePreserving.zpow
#align measure_theory.measure.measure_preserving.zsmul MeasureTheory.Measure.MeasurePreserving.zsmul

end CommGroup

end Measure

end MeasureTheory


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module combinatorics.simple_graph.hasse
! leanprover-community/mathlib commit 8a38a697305292b37a61650e2c3bd3502d98c805
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Combinatorics.SimpleGraph.Prod
import Mathlib.Data.Fin.SuccPred
import Mathlib.Order.SuccPred.Relation

/-!
# The Hasse diagram as a graph

This file defines the Hasse diagram of an order (graph of `Covby`, the covering relation) and the
path graph on `n` vertices.

## Main declarations

* `SimpleGraph.hasse`: Hasse diagram of an order.
* `SimpleGraph.pathGraph`: Path graph on `n` vertices.
-/

open Order OrderDual Relation

namespace SimpleGraph

variable (α β : Type _)

section Preorder

variable [Preorder α] [Preorder β]

/-- The Hasse diagram of an order as a simple graph. The graph of the covering relation. -/
def hasse : SimpleGraph α where
  Adj a b := a ⋖ b ∨ b ⋖ a
  symm _a _b := Or.symm
  loopless _a h := h.elim (irrefl _) (irrefl _)
#align simple_graph.hasse SimpleGraph.hasse

variable {α β} {a b : α}

@[simp]
theorem hasse_adj : (hasse α).Adj a b ↔ a ⋖ b ∨ b ⋖ a :=
  Iff.rfl
#align simple_graph.hasse_adj SimpleGraph.hasse_adj

/-- `αᵒᵈ` and `α` have the same Hasse diagram. -/
def hasseDualIso : hasse αᵒᵈ ≃g hasse α :=
  { ofDual with map_rel_iff' := by simp [or_comm] }
#align simple_graph.hasse_dual_iso SimpleGraph.hasseDualIso

@[simp]
theorem hasseDualIso_apply (a : αᵒᵈ) : hasseDualIso a = ofDual a :=
  rfl
#align simple_graph.hasse_dual_iso_apply SimpleGraph.hasseDualIso_apply

@[simp]
theorem hasseDualIso_symm_apply (a : α) : hasseDualIso.symm a = toDual a :=
  rfl
#align simple_graph.hasse_dual_iso_symm_apply SimpleGraph.hasseDualIso_symm_apply

end Preorder

section PartialOrder

variable [PartialOrder α] [PartialOrder β]

@[simp]
theorem hasse_prod : hasse (α × β) = hasse α □ hasse β := by
  ext (x y)
  simp_rw [boxProd_adj, hasse_adj, Prod.covby_iff, or_and_right, @eq_comm _ y.1, @eq_comm _ y.2,
    or_or_or_comm]
#align simple_graph.hasse_prod SimpleGraph.hasse_prod

end PartialOrder

section LinearOrder

variable [LinearOrder α]

theorem hasse_preconnected_of_succ [SuccOrder α] [IsSuccArchimedean α] : (hasse α).Preconnected :=
  fun a b => by
  rw [reachable_iff_reflTransGen]
  exact
    reflTransGen_of_succ _ (fun c hc => Or.inl <| covby_succ_of_not_isMax hc.2.not_isMax)
      fun c hc => Or.inr <| covby_succ_of_not_isMax hc.2.not_isMax
#align simple_graph.hasse_preconnected_of_succ SimpleGraph.hasse_preconnected_of_succ

theorem hasse_preconnected_of_pred [PredOrder α] [IsPredArchimedean α] : (hasse α).Preconnected :=
  fun a b => by
  rw [reachable_iff_reflTransGen, ← reflTransGen_swap]
  exact
    reflTransGen_of_pred _ (fun c hc => Or.inl <| pred_covby_of_not_isMin hc.1.not_isMin)
      fun c hc => Or.inr <| pred_covby_of_not_isMin hc.1.not_isMin
#align simple_graph.hasse_preconnected_of_pred SimpleGraph.hasse_preconnected_of_pred

end LinearOrder

/-- The path graph on `n` vertices. -/
def pathGraph (n : ℕ) : SimpleGraph (Fin n) :=
  hasse _
#align simple_graph.path_graph SimpleGraph.pathGraph

theorem pathGraph_preconnected (n : ℕ) : (pathGraph n).Preconnected :=
  hasse_preconnected_of_succ _
#align simple_graph.path_graph_preconnected SimpleGraph.pathGraph_preconnected

theorem pathGraph_connected (n : ℕ) : (pathGraph (n + 1)).Connected :=
  ⟨pathGraph_preconnected _⟩
#align simple_graph.path_graph_connected SimpleGraph.pathGraph_connected

end SimpleGraph


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

! This file was ported from Lean 3 source module number_theory.ramification_inertia
! leanprover-community/mathlib commit 71150516f28d9826c7341f8815b31f7d8770c212
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.FreeModule.Finite.Rank
import Mathbin.RingTheory.DedekindDomain.Ideal

/-!
# Ramification index and inertia degree

Given `P : ideal S` lying over `p : ideal R` for the ring extension `f : R →+* S`
(assuming `P` and `p` are prime or maximal where needed),
the **ramification index** `ideal.ramification_idx f p P` is the multiplicity of `P` in `map f p`,
and the **inertia degree** `ideal.inertia_deg f p P` is the degree of the field extension
`(S / P) : (R / p)`.

## Main results

The main theorem `ideal.sum_ramification_inertia` states that for all coprime `P` lying over `p`,
`Σ P, ramification_idx f p P * inertia_deg f p P` equals the degree of the field extension
`Frac(S) : Frac(R)`.

## Implementation notes

Often the above theory is set up in the case where:
 * `R` is the ring of integers of a number field `K`,
 * `L` is a finite separable extension of `K`,
 * `S` is the integral closure of `R` in `L`,
 * `p` and `P` are maximal ideals,
 * `P` is an ideal lying over `p`
We will try to relax the above hypotheses as much as possible.

## Notation

In this file, `e` stands for the ramification index and `f` for the inertia degree of `P` over `p`,
leaving `p` and `P` implicit.

-/

namespace Ideal

universe u v

variable {R : Type u} [CommRing R]

variable {S : Type v} [CommRing S] (f : R →+* S)

variable (p : Ideal R) (P : Ideal S)

open FiniteDimensional

open UniqueFactorizationMonoid

section DecEq

open Classical

/-- The ramification index of `P` over `p` is the largest exponent `n` such that
`p` is contained in `P^n`.

In particular, if `p` is not contained in `P^n`, then the ramification index is 0.

If there is no largest such `n` (e.g. because `p = ⊥`), then `ramification_idx` is
defined to be 0.
-/
noncomputable def ramificationIdx : ℕ :=
  supₛ { n | map f p ≤ P ^ n }
#align ideal.ramification_idx Ideal.ramificationIdx

variable {f p P}

theorem ramificationIdx_eq_find (h : ∃ n, ∀ k, map f p ≤ P ^ k → k ≤ n) :
    ramificationIdx f p P = Nat.find h :=
  Nat.supₛ_def h
#align ideal.ramification_idx_eq_find Ideal.ramificationIdx_eq_find

theorem ramificationIdx_eq_zero (h : ∀ n : ℕ, ∃ k, map f p ≤ P ^ k ∧ n < k) :
    ramificationIdx f p P = 0 :=
  dif_neg (by push_neg <;> exact h)
#align ideal.ramification_idx_eq_zero Ideal.ramificationIdx_eq_zero

theorem ramificationIdx_spec {n : ℕ} (hle : map f p ≤ P ^ n) (hgt : ¬map f p ≤ P ^ (n + 1)) :
    ramificationIdx f p P = n :=
  by
  have : ∀ k : ℕ, map f p ≤ P ^ k → k ≤ n := by
    intro k hk
    refine' le_of_not_lt fun hnk => _
    exact hgt (hk.trans (Ideal.pow_le_pow hnk))
  rw [ramification_idx_eq_find ⟨n, this⟩]
  · refine' le_antisymm (Nat.find_min' _ this) (le_of_not_gt fun h : Nat.find _ < n => _)
    obtain this' := Nat.find_spec ⟨n, this⟩
    exact h.not_le (this' _ hle)
#align ideal.ramification_idx_spec Ideal.ramificationIdx_spec

theorem ramificationIdx_lt {n : ℕ} (hgt : ¬map f p ≤ P ^ n) : ramificationIdx f p P < n :=
  by
  cases n
  · simpa using hgt
  rw [Nat.lt_succ_iff]
  have : ∀ k, map f p ≤ P ^ k → k ≤ n :=
    by
    refine' fun k hk => le_of_not_lt fun hnk => _
    exact hgt (hk.trans (Ideal.pow_le_pow hnk))
  rw [ramification_idx_eq_find ⟨n, this⟩]
  exact Nat.find_min' ⟨n, this⟩ this
#align ideal.ramification_idx_lt Ideal.ramificationIdx_lt

@[simp]
theorem ramificationIdx_bot : ramificationIdx f ⊥ P = 0 :=
  dif_neg <| not_exists.mpr fun n hn => n.lt_succ_self.not_le (hn _ (by simp))
#align ideal.ramification_idx_bot Ideal.ramificationIdx_bot

@[simp]
theorem ramificationIdx_of_not_le (h : ¬map f p ≤ P) : ramificationIdx f p P = 0 :=
  ramificationIdx_spec (by simp) (by simpa using h)
#align ideal.ramification_idx_of_not_le Ideal.ramificationIdx_of_not_le

theorem ramificationIdx_ne_zero {e : ℕ} (he : e ≠ 0) (hle : map f p ≤ P ^ e)
    (hnle : ¬map f p ≤ P ^ (e + 1)) : ramificationIdx f p P ≠ 0 := by
  rwa [ramification_idx_spec hle hnle]
#align ideal.ramification_idx_ne_zero Ideal.ramificationIdx_ne_zero

theorem le_pow_of_le_ramificationIdx {n : ℕ} (hn : n ≤ ramificationIdx f p P) : map f p ≤ P ^ n :=
  by
  contrapose! hn
  exact ramification_idx_lt hn
#align ideal.le_pow_of_le_ramification_idx Ideal.le_pow_of_le_ramificationIdx

theorem le_pow_ramificationIdx : map f p ≤ P ^ ramificationIdx f p P :=
  le_pow_of_le_ramificationIdx (le_refl _)
#align ideal.le_pow_ramification_idx Ideal.le_pow_ramificationIdx

theorem le_comap_pow_ramificationIdx : p ≤ comap f (P ^ ramificationIdx f p P) :=
  map_le_iff_le_comap.mp le_pow_ramificationIdx
#align ideal.le_comap_pow_ramification_idx Ideal.le_comap_pow_ramificationIdx

theorem le_comap_of_ramificationIdx_ne_zero (h : ramificationIdx f p P ≠ 0) : p ≤ comap f P :=
  Ideal.map_le_iff_le_comap.mp <| le_pow_ramificationIdx.trans <| Ideal.pow_le_self <| h
#align ideal.le_comap_of_ramification_idx_ne_zero Ideal.le_comap_of_ramificationIdx_ne_zero

namespace IsDedekindDomain

variable [IsDomain S] [IsDedekindDomain S]

theorem ramificationIdx_eq_normalizedFactors_count (hp0 : map f p ≠ ⊥) (hP : P.IsPrime)
    (hP0 : P ≠ ⊥) : ramificationIdx f p P = (normalizedFactors (map f p)).count P :=
  by
  have hPirr := (Ideal.prime_of_isPrime hP0 hP).Irreducible
  refine' ramification_idx_spec (Ideal.le_of_dvd _) (mt ideal.dvd_iff_le.mpr _) <;>
    rw [dvd_iff_normalized_factors_le_normalized_factors (pow_ne_zero _ hP0) hp0,
      normalized_factors_pow, normalized_factors_irreducible hPirr, normalize_eq,
      Multiset.nsmul_singleton, ← Multiset.le_count_iff_replicate_le]
  · exact (Nat.lt_succ_self _).not_le
#align ideal.is_dedekind_domain.ramification_idx_eq_normalized_factors_count Ideal.IsDedekindDomain.ramificationIdx_eq_normalizedFactors_count

theorem ramificationIdx_eq_factors_count (hp0 : map f p ≠ ⊥) (hP : P.IsPrime) (hP0 : P ≠ ⊥) :
    ramificationIdx f p P = (factors (map f p)).count P := by
  rw [is_dedekind_domain.ramification_idx_eq_normalized_factors_count hp0 hP hP0,
    factors_eq_normalized_factors]
#align ideal.is_dedekind_domain.ramification_idx_eq_factors_count Ideal.IsDedekindDomain.ramificationIdx_eq_factors_count

theorem ramificationIdx_ne_zero (hp0 : map f p ≠ ⊥) (hP : P.IsPrime) (le : map f p ≤ P) :
    ramificationIdx f p P ≠ 0 :=
  by
  have hP0 : P ≠ ⊥ := by
    rintro rfl
    have := le_bot_iff.mp le
    contradiction
  have hPirr := (Ideal.prime_of_isPrime hP0 hP).Irreducible
  rw [is_dedekind_domain.ramification_idx_eq_normalized_factors_count hp0 hP hP0]
  obtain ⟨P', hP', P'_eq⟩ :=
    exists_mem_normalized_factors_of_dvd hp0 hPirr (ideal.dvd_iff_le.mpr le)
  rwa [Multiset.count_ne_zero, associated_iff_eq.mp P'_eq]
#align ideal.is_dedekind_domain.ramification_idx_ne_zero Ideal.IsDedekindDomain.ramificationIdx_ne_zero

end IsDedekindDomain

variable (f p P)

attribute [local instance] Ideal.Quotient.field

/-- The inertia degree of `P : ideal S` lying over `p : ideal R` is the degree of the
extension `(S / P) : (R / p)`.

We do not assume `P` lies over `p` in the definition; we return `0` instead.

See `inertia_deg_algebra_map` for the common case where `f = algebra_map R S`
and there is an algebra structure `R / p → S / P`.
-/
noncomputable def inertiaDeg [hp : p.IsMaximal] : ℕ :=
  if hPp : comap f P = p then
    @finrank (R ⧸ p) (S ⧸ P) _ _ <|
      @Algebra.toModule _ _ _ _ <|
        RingHom.toAlgebra <|
          Ideal.Quotient.lift p (P.Quotient.mk.comp f) fun a ha =>
            Quotient.eq_zero_iff_mem.mpr <| mem_comap.mp <| hPp.symm ▸ ha
  else 0
#align ideal.inertia_deg Ideal.inertiaDeg

-- Useful for the `nontriviality` tactic using `comap_eq_of_scalar_tower_quotient`.
@[simp]
theorem inertiaDeg_of_subsingleton [hp : p.IsMaximal] [hQ : Subsingleton (S ⧸ P)] :
    inertiaDeg f p P = 0 :=
  by
  have := ideal.quotient.subsingleton_iff.mp hQ
  subst this
  exact dif_neg fun h => hp.ne_top <| h.symm.trans comap_top
#align ideal.inertia_deg_of_subsingleton Ideal.inertiaDeg_of_subsingleton

@[simp]
theorem inertiaDeg_algebraMap [Algebra R S] [Algebra (R ⧸ p) (S ⧸ P)]
    [IsScalarTower R (R ⧸ p) (S ⧸ P)] [hp : p.IsMaximal] :
    inertiaDeg (algebraMap R S) p P = finrank (R ⧸ p) (S ⧸ P) :=
  by
  nontriviality S ⧸ P using inertia_deg_of_subsingleton, finrank_zero_of_subsingleton
  have := comap_eq_of_scalar_tower_quotient (algebraMap (R ⧸ p) (S ⧸ P)).Injective
  rw [inertia_deg, dif_pos this]
  congr
  refine' Algebra.algebra_ext _ _ fun x' => Quotient.inductionOn' x' fun x => _
  change Ideal.Quotient.lift p _ _ (Ideal.Quotient.mk p x) = algebraMap _ _ (Ideal.Quotient.mk p x)
  rw [Ideal.Quotient.lift_mk, ← Ideal.Quotient.algebraMap_eq, ← IsScalarTower.algebraMap_eq, ←
    Ideal.Quotient.algebraMap_eq, ← IsScalarTower.algebraMap_apply]
#align ideal.inertia_deg_algebra_map Ideal.inertiaDeg_algebraMap

end DecEq

section FinrankQuotientMap

open BigOperators

open nonZeroDivisors

variable [Algebra R S]

variable {K : Type _} [Field K] [Algebra R K] [hRK : IsFractionRing R K]

variable {L : Type _} [Field L] [Algebra S L] [IsFractionRing S L]

variable {V V' V'' : Type _}

variable [AddCommGroup V] [Module R V] [Module K V] [IsScalarTower R K V]

variable [AddCommGroup V'] [Module R V'] [Module S V'] [IsScalarTower R S V']

variable [AddCommGroup V''] [Module R V'']

variable (K)

include hRK

/-- Let `V` be a vector space over `K = Frac(R)`, `S / R` a ring extension
and `V'` a module over `S`. If `b`, in the intersection `V''` of `V` and `V'`,
is linear independent over `S` in `V'`, then it is linear independent over `R` in `V`.

The statement we prove is actually slightly more general:
 * it suffices that the inclusion `algebra_map R S : R → S` is nontrivial
 * the function `f' : V'' → V'` doesn't need to be injective
-/
theorem FinrankQuotientMap.linearIndependent_of_nontrivial [IsDomain R] [IsDedekindDomain R]
    (hRS : (algebraMap R S).ker ≠ ⊤) (f : V'' →ₗ[R] V) (hf : Function.Injective f)
    (f' : V'' →ₗ[R] V') {ι : Type _} {b : ι → V''} (hb' : LinearIndependent S (f' ∘ b)) :
    LinearIndependent K (f ∘ b) := by
  contrapose! hb' with hb
  -- Informally, if we have a nontrivial linear dependence with coefficients `g` in `K`,
  -- then we can find a linear dependence with coefficients `I.quotient.mk g'` in `R/I`,
  -- where `I = ker (algebra_map R S)`.
  -- We make use of the same principle but stay in `R` everywhere.
  simp only [linearIndependent_iff', not_forall] at hb⊢
  obtain ⟨s, g, eq, j', hj's, hj'g⟩ := hb
  use s
  obtain ⟨a, hag, j, hjs, hgI⟩ := Ideal.exist_integer_multiples_not_mem hRS s g hj's hj'g
  choose g'' hg'' using hag
  letI := Classical.propDecidable
  let g' i := if h : i ∈ s then g'' i h else 0
  have hg' : ∀ i ∈ s, algebraMap _ _ (g' i) = a * g i :=
    by
    intro i hi
    exact (congr_arg _ (dif_pos hi)).trans (hg'' i hi)
  -- Because `R/I` is nontrivial, we can lift `g` to a nontrivial linear dependence in `S`.
  have hgI : algebraMap R S (g' j) ≠ 0 :=
    by
    simp only [FractionalIdeal.mem_coe_ideal, not_exists, not_and'] at hgI
    exact hgI _ (hg' j hjs)
  refine' ⟨fun i => algebraMap R S (g' i), _, j, hjs, hgI⟩
  have eq : f (∑ i in s, g' i • b i) = 0 :=
    by
    rw [LinearMap.map_sum, ← smul_zero a, ← Eq, Finset.smul_sum, Finset.sum_congr rfl]
    intro i hi
    rw [LinearMap.map_smul, ← IsScalarTower.algebraMap_smul K, hg' i hi, ← smul_assoc, smul_eq_mul]
    infer_instance
  simp only [IsScalarTower.algebraMap_smul, ← LinearMap.map_smul, ← LinearMap.map_sum,
    (f.map_eq_zero_iff hf).mp Eq, LinearMap.map_zero]
#align ideal.finrank_quotient_map.linear_independent_of_nontrivial Ideal.FinrankQuotientMap.linearIndependent_of_nontrivial

open Matrix

variable {K}

omit hRK

/-- If `b` mod `p` spans `S/p` as `R/p`-space, then `b` itself spans `Frac(S)` as `K`-space.

Here,
 * `p` is an ideal of `R` such that `R / p` is nontrivial
 * `K` is a field that has an embedding of `R` (in particular we can take `K = Frac(R)`)
 * `L` is a field extension of `K`
 * `S` is the integral closure of `R` in `L`

More precisely, we avoid quotients in this statement and instead require that `b ∪ pS` spans `S`.
-/
theorem FinrankQuotientMap.span_eq_top [IsDomain R] [IsDomain S] [Algebra K L] [IsNoetherian R S]
    [Algebra R L] [IsScalarTower R S L] [IsScalarTower R K L] [IsIntegralClosure S R L]
    [NoZeroSMulDivisors R K] (hp : p ≠ ⊤) (b : Set S)
    (hb' : Submodule.span R b ⊔ (p.map (algebraMap R S)).restrictScalars R = ⊤) :
    Submodule.span K (algebraMap S L '' b) = ⊤ :=
  by
  have hRL : Function.Injective (algebraMap R L) :=
    by
    rw [IsScalarTower.algebraMap_eq R K L]
    exact (algebraMap K L).Injective.comp (NoZeroSMulDivisors.algebraMap_injective R K)
  -- Let `M` be the `R`-module spanned by the proposed basis elements.
  set M : Submodule R S := Submodule.span R b with hM
  -- Then `S / M` is generated by some finite set of `n` vectors `a`.
  letI h : Module.Finite R (S ⧸ M) :=
    Module.Finite.of_surjective (Submodule.mkQ _) (Submodule.Quotient.mk_surjective _)
  obtain ⟨n, a, ha⟩ := @Module.Finite.exists_fin _ _ _ h
  -- Because the image of `p` in `S / M` is `⊤`,
  have smul_top_eq : p • (⊤ : Submodule R (S ⧸ M)) = ⊤ := by
    calc
      p • ⊤ = Submodule.map M.mkq (p • ⊤) := by
        rw [Submodule.map_smul'', Submodule.map_top, M.range_mkq]
      _ = ⊤ := by rw [Ideal.smul_top_eq_map, (Submodule.map_mkQ_eq_top M _).mpr hb']

  -- we can write the elements of `a` as `p`-linear combinations of other elements of `a`.
  have exists_sum : ∀ x : S ⧸ M, ∃ a' : Fin n → R, (∀ i, a' i ∈ p) ∧ (∑ i, a' i • a i) = x :=
    by
    intro x
    obtain ⟨a'', ha'', hx⟩ := (Submodule.mem_ideal_smul_span_iff_exists_sum p a x).1 _
    · refine' ⟨fun i => a'' i, fun i => ha'' _, _⟩
      rw [← hx, Finsupp.sum_fintype]
      exact fun _ => zero_smul _ _
    · rw [ha, smul_top_eq]
      exact Submodule.mem_top
  choose A' hA'p hA' using fun i => exists_sum (a i)
  -- This gives us a(n invertible) matrix `A` such that `det A ∈ (M = span R b)`,
  let A : Matrix (Fin n) (Fin n) R := A' - 1
  let B := A.adjugate
  have A_smul : ∀ i, (∑ j, A i j • a j) = 0 := by
    intros
    simp only [A, Pi.sub_apply, sub_smul, Finset.sum_sub_distrib, hA', Matrix.one_apply, ite_smul,
      one_smul, zero_smul, Finset.sum_ite_eq, Finset.mem_univ, if_true, sub_self]
  -- since `span S {det A} / M = 0`.
  have d_smul : ∀ i, A.det • a i = 0 := by
    intro i
    calc
      A.det • a i = ∑ j, (B ⬝ A) i j • a j := _
      _ = ∑ k, B i k • ∑ j, A k j • a j := _
      _ = 0 := Finset.sum_eq_zero fun k _ => _

    ·
      simp only [Matrix.adjugate_mul, Pi.smul_apply, Matrix.one_apply, mul_ite, ite_smul,
        smul_eq_mul, mul_one, MulZeroClass.mul_zero, one_smul, zero_smul, Finset.sum_ite_eq,
        Finset.mem_univ, if_true]
    · simp only [Matrix.mul_apply, Finset.smul_sum, Finset.sum_smul, smul_smul]
      rw [Finset.sum_comm]
    · rw [A_smul, smul_zero]
  -- In the rings of integers we have the desired inclusion.
  have span_d : (Submodule.span S ({algebraMap R S A.det} : Set S)).restrictScalars R ≤ M :=
    by
    intro x hx
    rw [Submodule.restrictScalars_mem] at hx
    obtain ⟨x', rfl⟩ := submodule.mem_span_singleton.mp hx
    rw [smul_eq_mul, mul_comm, ← Algebra.smul_def] at hx⊢
    rw [← Submodule.Quotient.mk_eq_zero, Submodule.Quotient.mk_smul]
    obtain ⟨a', _, quot_x_eq⟩ := exists_sum (Submodule.Quotient.mk x')
    simp_rw [← quot_x_eq, Finset.smul_sum, smul_comm A.det, d_smul, smul_zero,
      Finset.sum_const_zero]
  -- So now we lift everything to the fraction field.
  refine'
    top_le_iff.mp
      (calc
        ⊤ = (Ideal.span {algebraMap R L A.det}).restrictScalars K := _
        _ ≤ Submodule.span K (algebraMap S L '' b) := _
        )
  -- Because `det A ≠ 0`, we have `span L {det A} = ⊤`.
  · rw [eq_comm, Submodule.restrictScalars_eq_top_iff, Ideal.span_singleton_eq_top]
    refine'
      IsUnit.mk0 _
        ((map_ne_zero_iff (algebraMap R L) hRL).mpr
          (@ne_zero_of_map _ _ _ _ _ _ (Ideal.Quotient.mk p) _ _))
    haveI := Ideal.Quotient.nontrivial hp
    calc
      Ideal.Quotient.mk p A.det = Matrix.det ((Ideal.Quotient.mk p).mapMatrix A) := by
        rw [RingHom.map_det, RingHom.mapMatrix_apply]
      _ = Matrix.det ((Ideal.Quotient.mk p).mapMatrix (A' - 1)) := rfl
      _ =
          Matrix.det fun i j =>
            (Ideal.Quotient.mk p) (A' i j) - (1 : Matrix (Fin n) (Fin n) (R ⧸ p)) i j :=
        _
      _ = Matrix.det (-1 : Matrix (Fin n) (Fin n) (R ⧸ p)) := _
      _ = (-1 : R ⧸ p) ^ n := by rw [Matrix.det_neg, Fintype.card_fin, Matrix.det_one, mul_one]
      _ ≠ 0 := IsUnit.ne_zero (is_unit_one.neg.pow _)

    · refine' congr_arg Matrix.det (Matrix.ext fun i j => _)
      rw [map_sub, RingHom.mapMatrix_apply, map_one]
      rfl
    · refine' congr_arg Matrix.det (Matrix.ext fun i j => _)
      rw [ideal.quotient.eq_zero_iff_mem.mpr (hA'p i j), zero_sub]
      rfl
  -- And we conclude `L = span L {det A} ≤ span K b`, so `span K b` spans everything.
  · intro x hx
    rw [Submodule.restrictScalars_mem, IsScalarTower.algebraMap_apply R S L] at hx
    refine' IsFractionRing.ideal_span_singleton_map_subset R _ hRL span_d hx
    haveI : NoZeroSMulDivisors R L := NoZeroSMulDivisors.of_algebraMap_injective hRL
    rw [← IsFractionRing.isAlgebraic_iff' R S]
    intro x
    exact IsIntegral.isAlgebraic _ (isIntegral_of_noetherian inferInstance _)
#align ideal.finrank_quotient_map.span_eq_top Ideal.FinrankQuotientMap.span_eq_top

include hRK

variable (K L)

/-- If `p` is a maximal ideal of `R`, and `S` is the integral closure of `R` in `L`,
then the dimension `[S/pS : R/p]` is equal to `[Frac(S) : Frac(R)]`. -/
theorem finrank_quotient_map [IsDomain R] [IsDomain S] [IsDedekindDomain R] [Algebra K L]
    [Algebra R L] [IsScalarTower R K L] [IsScalarTower R S L] [IsIntegralClosure S R L]
    [hp : p.IsMaximal] [IsNoetherian R S] :
    finrank (R ⧸ p) (S ⧸ map (algebraMap R S) p) = finrank K L :=
  by
  -- Choose an arbitrary basis `b` for `[S/pS : R/p]`.
  -- We'll use the previous results to turn it into a basis on `[Frac(S) : Frac(R)]`.
  letI : Field (R ⧸ p) := Ideal.Quotient.field _
  let ι := Module.Free.ChooseBasisIndex (R ⧸ p) (S ⧸ map (algebraMap R S) p)
  let b : Basis ι (R ⧸ p) (S ⧸ map (algebraMap R S) p) := Module.Free.chooseBasis _ _
  -- Namely, choose a representative `b' i : S` for each `b i : S / pS`.
  let b' : ι → S := fun i => (Ideal.Quotient.mk_surjective (b i)).some
  have b_eq_b' : ⇑b = (Submodule.mkQ _).restrictScalars R ∘ b' :=
    funext fun i => (Ideal.Quotient.mk_surjective (b i)).choose_spec.symm
  -- We claim `b'` is a basis for `Frac(S)` over `Frac(R)` because it is linear independent
  -- and spans the whole of `Frac(S)`.
  let b'' : ι → L := algebraMap S L ∘ b'
  have b''_li : LinearIndependent _ b'' := _
  have b''_sp : Submodule.span _ (Set.range b'') = ⊤ := _
  -- Since the two bases have the same index set, the spaces have the same dimension.
  let c : Basis ι K L := Basis.mk b''_li b''_sp.ge
  rw [finrank_eq_card_basis b, finrank_eq_card_basis c]
  -- It remains to show that the basis is indeed linear independent and spans the whole space.
  · rw [Set.range_comp]
    refine' finrank_quotient_map.span_eq_top p hp.ne_top _ (top_le_iff.mp _)
    -- The nicest way to show `S ≤ span b' ⊔ pS` is by reducing both sides modulo pS.
    -- However, this would imply distinguishing between `pS` as `S`-ideal,
    -- and `pS` as `R`-submodule, since they have different (non-defeq) quotients.
    -- Instead we'll lift `x mod pS ∈ span b` to `y ∈ span b'` for some `y - x ∈ pS`.
    intro x hx
    have mem_span_b :
      ((Submodule.mkQ (map (algebraMap R S) p)) x : S ⧸ map (algebraMap R S) p) ∈
        Submodule.span (R ⧸ p) (Set.range b) :=
      b.mem_span _
    rw [← @Submodule.restrictScalars_mem R,
      Submodule.restrictScalars_span R (R ⧸ p) Ideal.Quotient.mk_surjective, b_eq_b',
      Set.range_comp, ← Submodule.map_span] at mem_span_b
    obtain ⟨y, y_mem, y_eq⟩ := submodule.mem_map.mp mem_span_b
    suffices y + -(y - x) ∈ _ by simpa
    rw [LinearMap.restrictScalars_apply, Submodule.mkQ_apply, Submodule.mkQ_apply,
      Submodule.Quotient.eq] at y_eq
    exact add_mem (Submodule.mem_sup_left y_mem) (neg_mem <| Submodule.mem_sup_right y_eq)
  · have := b.linear_independent
    rw [b_eq_b'] at this
    convert finrank_quotient_map.linear_independent_of_nontrivial K _
        ((Algebra.linearMap S L).restrictScalars R) _ ((Submodule.mkQ _).restrictScalars R) this
    · rw [quotient.algebra_map_eq, Ideal.mk_ker]
      exact hp.ne_top
    · exact IsFractionRing.injective S L
#align ideal.finrank_quotient_map Ideal.finrank_quotient_map

end FinrankQuotientMap

section FactLeComap

-- mathport name: expre
local notation "e" => ramificationIdx f p P

/-- `R / p` has a canonical map to `S / (P ^ e)`, where `e` is the ramification index
of `P` over `p`. -/
noncomputable instance Quotient.algebraQuotientPowRamificationIdx : Algebra (R ⧸ p) (S ⧸ P ^ e) :=
  Quotient.algebraQuotientOfLeComap (Ideal.map_le_iff_le_comap.mp le_pow_ramificationIdx)
#align ideal.quotient.algebra_quotient_pow_ramification_idx Ideal.Quotient.algebraQuotientPowRamificationIdx

@[simp]
theorem Quotient.algebraMap_quotient_pow_ramificationIdx (x : R) :
    algebraMap (R ⧸ p) (S ⧸ P ^ e) (Ideal.Quotient.mk p x) = Ideal.Quotient.mk _ (f x) :=
  rfl
#align ideal.quotient.algebra_map_quotient_pow_ramification_idx Ideal.Quotient.algebraMap_quotient_pow_ramificationIdx

variable [hfp : NeZero (ramificationIdx f p P)]

include hfp

/-- If `P` lies over `p`, then `R / p` has a canonical map to `S / P`.

This can't be an instance since the map `f : R → S` is generally not inferrable.
-/
def Quotient.algebraQuotientOfRamificationIdxNeZero : Algebra (R ⧸ p) (S ⧸ P) :=
  Quotient.algebraQuotientOfLeComap (le_comap_of_ramificationIdx_ne_zero hfp.out)
#align ideal.quotient.algebra_quotient_of_ramification_idx_ne_zero Ideal.Quotient.algebraQuotientOfRamificationIdxNeZero

-- In this file, the value for `f` can be inferred.
attribute [local instance] Ideal.Quotient.algebraQuotientOfRamificationIdxNeZero

@[simp]
theorem Quotient.algebraMap_quotient_of_ramificationIdx_neZero (x : R) :
    algebraMap (R ⧸ p) (S ⧸ P) (Ideal.Quotient.mk p x) = Ideal.Quotient.mk _ (f x) :=
  rfl
#align ideal.quotient.algebra_map_quotient_of_ramification_idx_ne_zero Ideal.Quotient.algebraMap_quotient_of_ramificationIdx_neZero

omit hfp

/-- The inclusion `(P^(i + 1) / P^e) ⊂ (P^i / P^e)`. -/
@[simps]
def powQuotSuccInclusion (i : ℕ) :
    Ideal.map (P ^ e).Quotient.mk (P ^ (i + 1)) →ₗ[R ⧸ p] Ideal.map (P ^ e).Quotient.mk (P ^ i)
    where
  toFun x := ⟨x, Ideal.map_mono (Ideal.pow_le_pow i.le_succ) x.2⟩
  map_add' x y := rfl
  map_smul' c x := rfl
#align ideal.pow_quot_succ_inclusion Ideal.powQuotSuccInclusion

theorem powQuotSuccInclusion_injective (i : ℕ) :
    Function.Injective (powQuotSuccInclusion f p P i) :=
  by
  rw [← LinearMap.ker_eq_bot, LinearMap.ker_eq_bot']
  rintro ⟨x, hx⟩ hx0
  rw [Subtype.ext_iff] at hx0⊢
  rwa [pow_quot_succ_inclusion_apply_coe] at hx0
#align ideal.pow_quot_succ_inclusion_injective Ideal.powQuotSuccInclusion_injective

/-- `S ⧸ P` embeds into the quotient by `P^(i+1) ⧸ P^e` as a subspace of `P^i ⧸ P^e`.
See `quotient_to_quotient_range_pow_quot_succ` for this as a linear map,
and `quotient_range_pow_quot_succ_inclusion_equiv` for this as a linear equivalence.
-/
noncomputable def quotientToQuotientRangePowQuotSuccAux {i : ℕ} {a : S} (a_mem : a ∈ P ^ i) :
    S ⧸ P → (P ^ i).map (P ^ e).Quotient.mk ⧸ (powQuotSuccInclusion f p P i).range :=
  Quotient.map' (fun x : S => ⟨_, Ideal.mem_map_of_mem _ (Ideal.mul_mem_left _ x a_mem)⟩)
    fun x y h => by
    rw [Submodule.quotientRel_r_def] at h⊢
    simp only [_root_.map_mul, LinearMap.mem_range]
    refine' ⟨⟨_, Ideal.mem_map_of_mem _ (Ideal.mul_mem_mul h a_mem)⟩, _⟩
    ext
    rw [pow_quot_succ_inclusion_apply_coe, Subtype.coe_mk, Submodule.coe_sub, Subtype.coe_mk,
      Subtype.coe_mk, _root_.map_mul, map_sub, sub_mul]
#align ideal.quotient_to_quotient_range_pow_quot_succ_aux Ideal.quotientToQuotientRangePowQuotSuccAux

theorem quotientToQuotientRangePowQuotSuccAux_mk {i : ℕ} {a : S} (a_mem : a ∈ P ^ i) (x : S) :
    quotientToQuotientRangePowQuotSuccAux f p P a_mem (Submodule.Quotient.mk x) =
      Submodule.Quotient.mk ⟨_, Ideal.mem_map_of_mem _ (Ideal.mul_mem_left _ x a_mem)⟩ :=
  by apply Quotient.map'_mk''
#align ideal.quotient_to_quotient_range_pow_quot_succ_aux_mk Ideal.quotientToQuotientRangePowQuotSuccAux_mk

include hfp

/-- `S ⧸ P` embeds into the quotient by `P^(i+1) ⧸ P^e` as a subspace of `P^i ⧸ P^e`. -/
noncomputable def quotientToQuotientRangePowQuotSucc {i : ℕ} {a : S} (a_mem : a ∈ P ^ i) :
    S ⧸ P →ₗ[R ⧸ p] (P ^ i).map (P ^ e).Quotient.mk ⧸ (powQuotSuccInclusion f p P i).range
    where
  toFun := quotientToQuotientRangePowQuotSuccAux f p P a_mem
  map_add' := by
    intro x y; refine' Quotient.inductionOn' x fun x => Quotient.inductionOn' y fun y => _
    simp only [Submodule.Quotient.mk''_eq_mk, ← Submodule.Quotient.mk_add,
      quotient_to_quotient_range_pow_quot_succ_aux_mk, add_mul]
    refine' congr_arg Submodule.Quotient.mk _
    ext
    rfl
  map_smul' := by
    intro x y; refine' Quotient.inductionOn' x fun x => Quotient.inductionOn' y fun y => _
    simp only [Submodule.Quotient.mk''_eq_mk, ← Submodule.Quotient.mk_add,
      quotient_to_quotient_range_pow_quot_succ_aux_mk, RingHom.id_apply]
    refine' congr_arg Submodule.Quotient.mk _
    ext
    simp only [Subtype.coe_mk, _root_.map_mul, Algebra.smul_def, Submodule.coe_mk, mul_assoc,
      Ideal.Quotient.mk_eq_mk, Submodule.coe_smul_of_tower,
      Ideal.Quotient.algebraMap_quotient_pow_ramificationIdx]
#align ideal.quotient_to_quotient_range_pow_quot_succ Ideal.quotientToQuotientRangePowQuotSucc

theorem quotientToQuotientRangePowQuotSucc_mk {i : ℕ} {a : S} (a_mem : a ∈ P ^ i) (x : S) :
    quotientToQuotientRangePowQuotSucc f p P a_mem (Submodule.Quotient.mk x) =
      Submodule.Quotient.mk ⟨_, Ideal.mem_map_of_mem _ (Ideal.mul_mem_left _ x a_mem)⟩ :=
  quotientToQuotientRangePowQuotSuccAux_mk f p P a_mem x
#align ideal.quotient_to_quotient_range_pow_quot_succ_mk Ideal.quotientToQuotientRangePowQuotSucc_mk

theorem quotientToQuotientRangePowQuotSucc_injective [IsDomain S] [IsDedekindDomain S] [P.IsPrime]
    {i : ℕ} (hi : i < e) {a : S} (a_mem : a ∈ P ^ i) (a_not_mem : a ∉ P ^ (i + 1)) :
    Function.Injective (quotientToQuotientRangePowQuotSucc f p P a_mem) := fun x =>
  Quotient.inductionOn' x fun x y =>
    Quotient.inductionOn' y fun y h =>
      by
      have Pe_le_Pi1 : P ^ e ≤ P ^ (i + 1) := Ideal.pow_le_pow hi
      simp only [Submodule.Quotient.mk''_eq_mk, quotient_to_quotient_range_pow_quot_succ_mk,
        Submodule.Quotient.eq, LinearMap.mem_range, Subtype.ext_iff, Subtype.coe_mk,
        Submodule.coe_sub] at h⊢
      rcases h with ⟨⟨⟨z⟩, hz⟩, h⟩
      rw [Submodule.Quotient.quot_mk_eq_mk, Ideal.Quotient.mk_eq_mk, Ideal.mem_quotient_iff_mem_sup,
        sup_eq_left.mpr Pe_le_Pi1] at hz
      rw [pow_quot_succ_inclusion_apply_coe, Subtype.coe_mk, Submodule.Quotient.quot_mk_eq_mk,
        Ideal.Quotient.mk_eq_mk, ← map_sub, Ideal.Quotient.eq, ← sub_mul] at h
      exact
        (Ideal.IsPrime.mul_mem_pow _
              ((Submodule.sub_mem_iff_right _ hz).mp (Pe_le_Pi1 h))).resolve_right
          a_not_mem
#align ideal.quotient_to_quotient_range_pow_quot_succ_injective Ideal.quotientToQuotientRangePowQuotSucc_injective

theorem quotientToQuotientRangePowQuotSucc_surjective [IsDomain S] [IsDedekindDomain S]
    (hP0 : P ≠ ⊥) [hP : P.IsPrime] {i : ℕ} (hi : i < e) {a : S} (a_mem : a ∈ P ^ i)
    (a_not_mem : a ∉ P ^ (i + 1)) :
    Function.Surjective (quotientToQuotientRangePowQuotSucc f p P a_mem) :=
  by
  rintro ⟨⟨⟨x⟩, hx⟩⟩
  have Pe_le_Pi : P ^ e ≤ P ^ i := Ideal.pow_le_pow hi.le
  have Pe_le_Pi1 : P ^ e ≤ P ^ (i + 1) := Ideal.pow_le_pow hi
  rw [Submodule.Quotient.quot_mk_eq_mk, Ideal.Quotient.mk_eq_mk, Ideal.mem_quotient_iff_mem_sup,
    sup_eq_left.mpr Pe_le_Pi] at hx
  suffices hx' : x ∈ Ideal.span {a} ⊔ P ^ (i + 1)
  · obtain ⟨y', hy', z, hz, rfl⟩ := submodule.mem_sup.mp hx'
    obtain ⟨y, rfl⟩ := ideal.mem_span_singleton.mp hy'
    refine' ⟨Submodule.Quotient.mk y, _⟩
    simp only [Submodule.Quotient.quot_mk_eq_mk, quotient_to_quotient_range_pow_quot_succ_mk,
      Submodule.Quotient.eq, LinearMap.mem_range, Subtype.ext_iff, Subtype.coe_mk,
      Submodule.coe_sub]
    refine' ⟨⟨_, Ideal.mem_map_of_mem _ (Submodule.neg_mem _ hz)⟩, _⟩
    rw [pow_quot_succ_inclusion_apply_coe, Subtype.coe_mk, Ideal.Quotient.mk_eq_mk, map_add,
      mul_comm y a, sub_add_cancel', map_neg]
  letI := Classical.decEq (Ideal S)
  rw [sup_eq_prod_inf_factors _ (pow_ne_zero _ hP0), normalized_factors_pow,
    normalized_factors_irreducible ((Ideal.prime_iff_isPrime hP0).mpr hP).Irreducible, normalize_eq,
    Multiset.nsmul_singleton, Multiset.inter_replicate, Multiset.prod_replicate]
  rw [← Submodule.span_singleton_le_iff_mem, Ideal.submodule_span_eq] at a_mem a_not_mem
  rwa [Ideal.count_normalizedFactors_eq a_mem a_not_mem, min_eq_left i.le_succ]
  · intro ha
    rw [ideal.span_singleton_eq_bot.mp ha] at a_not_mem
    have := (P ^ (i + 1)).zero_mem
    contradiction
#align ideal.quotient_to_quotient_range_pow_quot_succ_surjective Ideal.quotientToQuotientRangePowQuotSucc_surjective

/-- Quotienting `P^i / P^e` by its subspace `P^(i+1) ⧸ P^e` is
`R ⧸ p`-linearly isomorphic to `S ⧸ P`. -/
noncomputable def quotientRangePowQuotSuccInclusionEquiv [IsDomain S] [IsDedekindDomain S]
    [P.IsPrime] (hP : P ≠ ⊥) {i : ℕ} (hi : i < e) :
    ((P ^ i).map (P ^ e).Quotient.mk ⧸ (powQuotSuccInclusion f p P i).range) ≃ₗ[R ⧸ p] S ⧸ P :=
  by
  choose a a_mem a_not_mem using
    SetLike.exists_of_lt
      (Ideal.strictAnti_pow P hP (Ideal.IsPrime.ne_top inferInstance) (le_refl i.succ))
  refine' (LinearEquiv.ofBijective _ ⟨_, _⟩).symm
  · exact quotient_to_quotient_range_pow_quot_succ f p P a_mem
  · exact quotient_to_quotient_range_pow_quot_succ_injective f p P hi a_mem a_not_mem
  · exact quotient_to_quotient_range_pow_quot_succ_surjective f p P hP hi a_mem a_not_mem
#align ideal.quotient_range_pow_quot_succ_inclusion_equiv Ideal.quotientRangePowQuotSuccInclusionEquiv

/-- Since the inclusion `(P^(i + 1) / P^e) ⊂ (P^i / P^e)` has a kernel isomorphic to `P / S`,
`[P^i / P^e : R / p] = [P^(i+1) / P^e : R / p] + [P / S : R / p]` -/
theorem dim_pow_quot_aux [IsDomain S] [IsDedekindDomain S] [p.IsMaximal] [P.IsPrime] (hP0 : P ≠ ⊥)
    {i : ℕ} (hi : i < e) :
    Module.rank (R ⧸ p) (Ideal.map (P ^ e).Quotient.mk (P ^ i)) =
      Module.rank (R ⧸ p) (S ⧸ P) +
        Module.rank (R ⧸ p) (Ideal.map (P ^ e).Quotient.mk (P ^ (i + 1))) :=
  by
  letI : Field (R ⧸ p) := Ideal.Quotient.field _
  rw [dim_eq_of_injective _ (pow_quot_succ_inclusion_injective f p P i),
    (quotient_range_pow_quot_succ_inclusion_equiv f p P hP0 hi).symm.dim_eq]
  exact (dim_quotient_add_dim (LinearMap.range (pow_quot_succ_inclusion f p P i))).symm
#align ideal.dim_pow_quot_aux Ideal.dim_pow_quot_aux

theorem dim_pow_quot [IsDomain S] [IsDedekindDomain S] [p.IsMaximal] [P.IsPrime] (hP0 : P ≠ ⊥)
    (i : ℕ) (hi : i ≤ e) :
    Module.rank (R ⧸ p) (Ideal.map (P ^ e).Quotient.mk (P ^ i)) =
      (e - i) • Module.rank (R ⧸ p) (S ⧸ P) :=
  by
  refine' @Nat.decreasingInduction' _ i e (fun j lt_e le_j ih => _) hi _
  · rw [dim_pow_quot_aux f p P _ lt_e, ih, ← succ_nsmul, Nat.sub_succ, ← Nat.succ_eq_add_one,
      Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt lt_e)]
    assumption
  · rw [Nat.sub_self, zero_nsmul, map_quotient_self]
    exact dim_bot (R ⧸ p) (S ⧸ P ^ e)
#align ideal.dim_pow_quot Ideal.dim_pow_quot

omit hfp

/-- If `p` is a maximal ideal of `R`, `S` extends `R` and `P^e` lies over `p`,
then the dimension `[S/(P^e) : R/p]` is equal to `e * [S/P : R/p]`. -/
theorem dim_prime_pow_ramificationIdx [IsDomain S] [IsDedekindDomain S] [p.IsMaximal] [P.IsPrime]
    (hP0 : P ≠ ⊥) (he : e ≠ 0) :
    Module.rank (R ⧸ p) (S ⧸ P ^ e) =
      e •
        @Module.rank (R ⧸ p) (S ⧸ P) _ _
          (@Algebra.toModule _ _ _ _ <|
            @Quotient.algebraQuotientOfRamificationIdxNeZero _ _ _ _ _ ⟨he⟩) :=
  by
  letI : NeZero e := ⟨he⟩
  have := dim_pow_quot f p P hP0 0 (Nat.zero_le e)
  rw [pow_zero, Nat.sub_zero, Ideal.one_eq_top, Ideal.map_top] at this
  exact (dim_top (R ⧸ p) _).symm.trans this
#align ideal.dim_prime_pow_ramification_idx Ideal.dim_prime_pow_ramificationIdx

/-- If `p` is a maximal ideal of `R`, `S` extends `R` and `P^e` lies over `p`,
then the dimension `[S/(P^e) : R/p]`, as a natural number, is equal to `e * [S/P : R/p]`. -/
theorem finrank_prime_pow_ramificationIdx [IsDomain S] [IsDedekindDomain S] (hP0 : P ≠ ⊥)
    [p.IsMaximal] [P.IsPrime] (he : e ≠ 0) :
    finrank (R ⧸ p) (S ⧸ P ^ e) =
      e *
        @finrank (R ⧸ p) (S ⧸ P) _ _
          (@Algebra.toModule _ _ _ _ <|
            @Quotient.algebraQuotientOfRamificationIdxNeZero _ _ _ _ _ ⟨he⟩) :=
  by
  letI : NeZero e := ⟨he⟩
  letI : Algebra (R ⧸ p) (S ⧸ P) := quotient.algebra_quotient_of_ramification_idx_ne_zero f p P
  letI := Ideal.Quotient.field p
  have hdim := dim_prime_pow_ramification_idx _ _ _ hP0 he
  by_cases hP : FiniteDimensional (R ⧸ p) (S ⧸ P)
  · haveI := hP
    haveI := (finite_dimensional_iff_of_rank_eq_nsmul he hdim).mpr hP
    refine' Cardinal.natCast_injective _
    rw [finrank_eq_dim, Nat.cast_mul, finrank_eq_dim, hdim, nsmul_eq_mul]
  have hPe := mt (finite_dimensional_iff_of_rank_eq_nsmul he hdim).mp hP
  simp only [finrank_of_infinite_dimensional hP, finrank_of_infinite_dimensional hPe,
    MulZeroClass.mul_zero]
#align ideal.finrank_prime_pow_ramification_idx Ideal.finrank_prime_pow_ramificationIdx

end FactLeComap

section FactorsMap

open Classical

/-! ## Properties of the factors of `p.map (algebra_map R S)` -/

variable [IsDomain S] [IsDedekindDomain S] [Algebra R S]

theorem Factors.ne_bot (P : (factors (map (algebraMap R S) p)).toFinset) : (P : Ideal S) ≠ ⊥ :=
  (prime_of_factor _ (Multiset.mem_toFinset.mp P.2)).NeZero
#align ideal.factors.ne_bot Ideal.Factors.ne_bot

instance Factors.isPrime (P : (factors (map (algebraMap R S) p)).toFinset) :
    IsPrime (P : Ideal S) :=
  Ideal.isPrime_of_prime (prime_of_factor _ (Multiset.mem_toFinset.mp P.2))
#align ideal.factors.is_prime Ideal.Factors.isPrime

theorem Factors.ramificationIdx_ne_zero (P : (factors (map (algebraMap R S) p)).toFinset) :
    ramificationIdx (algebraMap R S) p P ≠ 0 :=
  IsDedekindDomain.ramificationIdx_ne_zero (ne_zero_of_mem_factors (Multiset.mem_toFinset.mp P.2))
    (Factors.isPrime p P) (Ideal.le_of_dvd (dvd_of_mem_factors (Multiset.mem_toFinset.mp P.2)))
#align ideal.factors.ramification_idx_ne_zero Ideal.Factors.ramificationIdx_ne_zero

instance Factors.fact_ramificationIdx_neZero (P : (factors (map (algebraMap R S) p)).toFinset) :
    NeZero (ramificationIdx (algebraMap R S) p P) :=
  ⟨Factors.ramificationIdx_ne_zero p P⟩
#align ideal.factors.fact_ramification_idx_ne_zero Ideal.Factors.fact_ramificationIdx_neZero

attribute [local instance] quotient.algebra_quotient_of_ramification_idx_ne_zero

instance Factors.isScalarTower (P : (factors (map (algebraMap R S) p)).toFinset) :
    IsScalarTower R (R ⧸ p) (S ⧸ (P : Ideal S)) :=
  IsScalarTower.of_algebraMap_eq fun x => by simp
#align ideal.factors.is_scalar_tower Ideal.Factors.isScalarTower

attribute [local instance] Ideal.Quotient.field

theorem Factors.finrank_pow_ramificationIdx [p.IsMaximal]
    (P : (factors (map (algebraMap R S) p)).toFinset) :
    finrank (R ⧸ p) (S ⧸ (P : Ideal S) ^ ramificationIdx (algebraMap R S) p P) =
      ramificationIdx (algebraMap R S) p P * inertiaDeg (algebraMap R S) p P :=
  by
  rw [finrank_prime_pow_ramification_idx, inertia_deg_algebra_map]
  exact factors.ne_bot p P
#align ideal.factors.finrank_pow_ramification_idx Ideal.Factors.finrank_pow_ramificationIdx

instance Factors.finiteDimensional_quotient [IsNoetherian R S] [p.IsMaximal]
    (P : (factors (map (algebraMap R S) p)).toFinset) :
    FiniteDimensional (R ⧸ p) (S ⧸ (P : Ideal S)) :=
  IsNoetherian.iff_fg.mp <|
    isNoetherian_of_tower R <|
      isNoetherian_of_surjective S (Ideal.Quotient.mkₐ _ _).toLinearMap <|
        LinearMap.range_eq_top.mpr Ideal.Quotient.mk_surjective
#align ideal.factors.finite_dimensional_quotient Ideal.Factors.finiteDimensional_quotient

theorem Factors.inertiaDeg_ne_zero [IsNoetherian R S] [p.IsMaximal]
    (P : (factors (map (algebraMap R S) p)).toFinset) : inertiaDeg (algebraMap R S) p P ≠ 0 :=
  by
  rw [inertia_deg_algebra_map]
  exact (finite_dimensional.finrank_pos_iff.mpr inferInstance).ne'
#align ideal.factors.inertia_deg_ne_zero Ideal.Factors.inertiaDeg_ne_zero

instance Factors.finiteDimensional_quotient_pow [IsNoetherian R S] [p.IsMaximal]
    (P : (factors (map (algebraMap R S) p)).toFinset) :
    FiniteDimensional (R ⧸ p) (S ⧸ (P : Ideal S) ^ ramificationIdx (algebraMap R S) p P) :=
  by
  refine' FiniteDimensional.finiteDimensional_of_finrank _
  rw [pos_iff_ne_zero, factors.finrank_pow_ramification_idx]
  exact mul_ne_zero (factors.ramification_idx_ne_zero p P) (factors.inertia_deg_ne_zero p P)
#align ideal.factors.finite_dimensional_quotient_pow Ideal.Factors.finiteDimensional_quotient_pow

universe w

/-- **Chinese remainder theorem** for a ring of integers: if the prime ideal `p : ideal R`
factors in `S` as `∏ i, P i ^ e i`, then `S ⧸ I` factors as `Π i, R ⧸ (P i ^ e i)`. -/
noncomputable def Factors.piQuotientEquiv (p : Ideal R) (hp : map (algebraMap R S) p ≠ ⊥) :
    S ⧸ map (algebraMap R S) p ≃+*
      ∀ P : (factors (map (algebraMap R S) p)).toFinset,
        S ⧸ (P : Ideal S) ^ ramificationIdx (algebraMap R S) p P :=
  (IsDedekindDomain.quotientEquivPiFactors hp).trans <|
    @RingEquiv.piCongrRight (factors (map (algebraMap R S) p)).toFinset
      (fun P => S ⧸ (P : Ideal S) ^ (factors (map (algebraMap R S) p)).count P)
      (fun P => S ⧸ (P : Ideal S) ^ ramificationIdx (algebraMap R S) p P) _ _
      fun P : (factors (map (algebraMap R S) p)).toFinset =>
      Ideal.quotEquivOfEq <| by
        rw [is_dedekind_domain.ramification_idx_eq_factors_count hp (factors.is_prime p P)
            (factors.ne_bot p P)]
#align ideal.factors.pi_quotient_equiv Ideal.Factors.piQuotientEquiv

@[simp]
theorem Factors.piQuotientEquiv_mk (p : Ideal R) (hp : map (algebraMap R S) p ≠ ⊥) (x : S) :
    Factors.piQuotientEquiv p hp (Ideal.Quotient.mk _ x) = fun P => Ideal.Quotient.mk _ x :=
  rfl
#align ideal.factors.pi_quotient_equiv_mk Ideal.Factors.piQuotientEquiv_mk

@[simp]
theorem Factors.piQuotientEquiv_map (p : Ideal R) (hp : map (algebraMap R S) p ≠ ⊥) (x : R) :
    Factors.piQuotientEquiv p hp (algebraMap _ _ x) = fun P =>
      Ideal.Quotient.mk _ (algebraMap _ _ x) :=
  rfl
#align ideal.factors.pi_quotient_equiv_map Ideal.Factors.piQuotientEquiv_map

variable (S)

/-- **Chinese remainder theorem** for a ring of integers: if the prime ideal `p : ideal R`
factors in `S` as `∏ i, P i ^ e i`,
then `S ⧸ I` factors `R ⧸ I`-linearly as `Π i, R ⧸ (P i ^ e i)`. -/
noncomputable def Factors.piQuotientLinearEquiv (p : Ideal R) (hp : map (algebraMap R S) p ≠ ⊥) :
    (S ⧸ map (algebraMap R S) p) ≃ₗ[R ⧸ p]
      ∀ P : (factors (map (algebraMap R S) p)).toFinset,
        S ⧸ (P : Ideal S) ^ ramificationIdx (algebraMap R S) p P :=
  { Factors.piQuotientEquiv p hp with
    map_smul' := by
      rintro ⟨c⟩ ⟨x⟩; ext P
      simp only [Ideal.Quotient.mk_algebraMap, factors.pi_quotient_equiv_mk,
        factors.pi_quotient_equiv_map, Submodule.Quotient.quot_mk_eq_mk, Pi.algebraMap_apply,
        [anonymous], Pi.mul_apply, Ideal.Quotient.algebraMap_quotient_map_quotient,
        Ideal.Quotient.mk_eq_mk, Algebra.smul_def, _root_.map_mul, RingHomCompTriple.comp_apply]
      congr }
#align ideal.factors.pi_quotient_linear_equiv Ideal.Factors.piQuotientLinearEquiv

variable {S}

open BigOperators

/-- The **fundamental identity** of ramification index `e` and inertia degree `f`:
for `P` ranging over the primes lying over `p`, `∑ P, e P * f P = [Frac(S) : Frac(R)]`;
here `S` is a finite `R`-module (and thus `Frac(S) : Frac(R)` is a finite extension) and `p`
is maximal.
-/
theorem sum_ramification_inertia (K L : Type _) [Field K] [Field L] [IsDomain R]
    [IsDedekindDomain R] [Algebra R K] [IsFractionRing R K] [Algebra S L] [IsFractionRing S L]
    [Algebra K L] [Algebra R L] [IsScalarTower R S L] [IsScalarTower R K L] [IsNoetherian R S]
    [IsIntegralClosure S R L] [p.IsMaximal] (hp0 : p ≠ ⊥) :
    (∑ P in (factors (map (algebraMap R S) p)).toFinset,
        ramificationIdx (algebraMap R S) p P * inertiaDeg (algebraMap R S) p P) =
      finrank K L :=
  by
  set e := ramification_idx (algebraMap R S) p
  set f := inertia_deg (algebraMap R S) p
  have inj_RL : Function.Injective (algebraMap R L) :=
    by
    rw [IsScalarTower.algebraMap_eq R K L, RingHom.coe_comp]
    exact (RingHom.injective _).comp (IsFractionRing.injective R K)
  have inj_RS : Function.Injective (algebraMap R S) :=
    by
    refine' Function.Injective.of_comp (show Function.Injective (algebraMap S L ∘ _) from _)
    rw [← RingHom.coe_comp, ← IsScalarTower.algebraMap_eq]
    exact inj_RL
  calc
    (∑ P in (factors (map (algebraMap R S) p)).toFinset, e P * f P) =
        ∑ P in (factors (map (algebraMap R S) p)).toFinset.attach,
          finrank (R ⧸ p) (S ⧸ (P : Ideal S) ^ e P) :=
      _
    _ =
        finrank (R ⧸ p)
          (∀ P : (factors (map (algebraMap R S) p)).toFinset, S ⧸ (P : Ideal S) ^ e P) :=
      (Module.Free.finrank_pi_fintype (R ⧸ p)).symm
    _ = finrank (R ⧸ p) (S ⧸ map (algebraMap R S) p) := _
    _ = finrank K L := _

  · rw [← Finset.sum_attach]
    refine' Finset.sum_congr rfl fun P _ => _
    rw [factors.finrank_pow_ramification_idx]
  · refine' LinearEquiv.finrank_eq (factors.pi_quotient_linear_equiv S p _).symm
    rwa [Ne.def, Ideal.map_eq_bot_iff_le_ker, (RingHom.injective_iff_ker_eq_bot _).mp inj_RS,
      le_bot_iff]
  · exact finrank_quotient_map p K L
#align ideal.sum_ramification_inertia Ideal.sum_ramification_inertia

end FactorsMap

end Ideal


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import logic.function.basic

/-!
# Semiconjugate and commuting maps

We define the following predicates:

* `function.semiconj`: `f : α → β` semiconjugates `ga : α → α` to `gb : β → β` if `f ∘ ga = gb ∘ f`;
* `function.semiconj₂: `f : α → β` semiconjugates a binary operation `ga : α → α → α`
  to `gb : β → β → β` if `f (ga x y) = gb (f x) (f y)`;
* `f : α → α` commutes with `g : α → α` if `f ∘ g = g ∘ f`, or equivalently `semiconj f g g`.

-/

namespace function

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

/-- We say that `f : α → β` semiconjugates `ga : α → α` to `gb : β → β` if `f ∘ ga = gb ∘ f`.
We use `∀ x, f (ga x) = gb (f x)` as the definition, so given `h : function.semiconj f ga gb` and
`a : α`, we have `h a : f (ga a) = gb (f a)` and `h.comp_eq : f ∘ ga = gb ∘ f`. -/
def semiconj (f : α → β) (ga : α → α) (gb : β → β) : Prop := ∀ x, f (ga x) = gb (f x)

namespace semiconj

variables {f fab : α → β} {fbc : β → γ} {ga ga' : α → α} {gb gb' : β → β} {gc gc' : γ → γ}

protected lemma comp_eq (h : semiconj f ga gb) : f ∘ ga = gb ∘ f := funext h

protected lemma eq (h : semiconj f ga gb) (x : α) : f (ga x) = gb (f x) := h x

lemma comp_right (h : semiconj f ga gb) (h' : semiconj f ga' gb') :
  semiconj f (ga ∘ ga') (gb ∘ gb') :=
λ x, by rw [comp_app, h.eq, h'.eq]

lemma comp_left (hab : semiconj fab ga gb) (hbc : semiconj fbc gb gc) :
  semiconj (fbc ∘ fab) ga gc :=
λ x, by simp only [comp_app, hab.eq, hbc.eq]

lemma id_right : semiconj f id id := λ _, rfl

lemma id_left : semiconj id ga ga := λ _, rfl

lemma inverses_right (h : semiconj f ga gb) (ha : right_inverse ga' ga)
  (hb : left_inverse gb' gb) :
  semiconj f ga' gb' :=
λ x, by rw [← hb (f (ga' x)), ← h.eq, ha x]

end semiconj

/-- Two maps `f g : α → α` commute if `f (g x) = g (f x)` for all `x : α`.
Given `h : function.commute f g` and `a : α`, we have `h a : f (g a) = g (f a)` and
`h.comp_eq : f ∘ g = g ∘ f`. -/
def commute (f g : α → α) : Prop := semiconj f g g

lemma semiconj.commute {f g : α → α} (h : semiconj f g g) : commute f g := h

namespace commute

variables {f f' g g' : α → α}

@[refl] lemma refl (f : α → α) : commute f f := λ _, eq.refl _

@[symm] lemma symm (h : commute f g) : commute g f := λ x, (h x).symm

lemma comp_right (h : commute f g) (h' : commute f g') : commute f (g ∘ g') :=
h.comp_right h'

lemma comp_left (h : commute f g) (h' : commute f' g) : commute (f ∘ f') g :=
(h.symm.comp_right h'.symm).symm

lemma id_right : commute f id := semiconj.id_right

lemma id_left : commute id f := semiconj.id_left

end commute

/-- A map `f` semiconjugates a binary operation `ga` to a binary operation `gb` if
for all `x`, `y` we have `f (ga x y) = gb (f x) (f y)`. E.g., a `monoid_hom`
semiconjugates `(*)` to `(*)`. -/
def semiconj₂ (f : α → β) (ga : α → α → α) (gb : β → β → β) : Prop :=
∀ x y, f (ga x y) = gb (f x) (f y)

namespace semiconj₂

variables {f : α → β} {ga : α → α → α} {gb : β → β → β}

protected lemma eq (h : semiconj₂ f ga gb) (x y : α) : f (ga x y) = gb (f x) (f y) := h x y

protected lemma comp_eq (h : semiconj₂ f ga gb) :
  bicompr f ga = bicompl gb f f :=
funext $ λ x, funext $ h x

lemma id_left (op : α → α → α) : semiconj₂ id op op := λ _ _, rfl

lemma comp {f' : β → γ} {gc : γ → γ → γ} (hf' : semiconj₂ f' gb gc) (hf : semiconj₂ f ga gb) :
  semiconj₂ (f' ∘ f) ga gc :=
λ x y, by simp only [hf'.eq, hf.eq, comp_app]

lemma is_associative_right [is_associative α ga] (h : semiconj₂ f ga gb) (h_surj : surjective f) :
  is_associative β gb :=
⟨h_surj.forall₃.2 $ λ x₁ x₂ x₃, by simp only [← h.eq, @is_associative.assoc _ ga]⟩

lemma is_associative_left [is_associative β gb] (h : semiconj₂ f ga gb) (h_inj : injective f) :
  is_associative α ga :=
⟨λ x₁ x₂ x₃, h_inj $ by simp only [h.eq, @is_associative.assoc _ gb]⟩

lemma is_idempotent_right [is_idempotent α ga] (h : semiconj₂ f ga gb) (h_surj : surjective f) :
  is_idempotent β gb :=
⟨h_surj.forall.2 $ λ x, by simp only [← h.eq, @is_idempotent.idempotent _ ga]⟩

lemma is_idempotent_left [is_idempotent β gb] (h : semiconj₂ f ga gb) (h_inj : injective f) :
  is_idempotent α ga :=
⟨λ x, h_inj $ by rw [h.eq, @is_idempotent.idempotent _ gb]⟩

end semiconj₂

end function